(********************************) (* GCR200.pas *) (* LOLITA V03.0 *) (* le 22/03/91 *) (********************************) (*----------------------------------------------------------------------*) (* VERSION MS-PASCAL, JUILLET 1986, P.CHOUR. (c) SUPELEC - SOREFI *) (* ACCES AU LECTEUR DE CARTE, GESTION DE LA PROCEDURE DE TRANSMISSION *) (* Version GCR200 Mars 1991 *) (* Version LOLITA V02.0 : mars 1988 *) (*----------------------------------------------------------------------*) unit LGCR200; interface uses DOS,CAMvars,LOLIIO; (********* Procédures publiques **********) procedure T5_ENTREE_SORTIE(CC: integer; var XDATA:PDU; var STAT:integer); procedure T5_INIT_UART(AD : word); (***********************) implementation const ACK = $60; (* acquitement tlp *) NACK = $E0; (* non acquitement *) ETX = 3; (* fin de texte *) (***********************) (* Initialisation UART *) (***********************) procedure T5_INIT_UART(AD : word); var REGS : registers; begin with REGS do begin DX := AD; AX := UART_9600 or UART_8bits or UART_1Stop or UART_None; INTR($14,REGS); end; end; (**************************************************) (* Procedure d'emission/reception *) (* En entree : XDATA : buffer emission/reception *) (* NE : nombre d'octets EDATA *) (* XDATA[1] = longueur bloc *) (* Le bloc commence en XDATA[2] *) (* En sortie : STAT = -1, pb lecteur *) (* = 0, pas d'erreur *) (**************************************************) procedure T5_EMIREC(var XDATA : PDU;UART:word;TMAX : integer; var STAT : integer); var REPET : integer; (* compteur de repetitions *) XBUFFER,EDATA : PDU; NACKE,NACKR:boolean; (* NACK a emettre , NACK recu *) (* variables pour RECEPTION et EMISSION *) N,NR : integer; LG : integer; I,J : integer; (***********************************) (* CALCUL DU LRC D'UNE TRAME *) (***********************************) function LRC(var BLOC : PDU;NBOCT:integer):integer; var VAR_LRC:integer; I : integer; begin VAR_LRC:=BLOC[0]; for I:=1 to NBOCT-1 do VAR_LRC:=VAR_LRC xor BLOC[I]; LRC:=VAR_LRC; end; (*****************************) (* CONVERSION A LA MODE BULL *) (*****************************) procedure PREP_EBUFFER; var I,J : integer; begin if NACKE then EDATA[0]:=NACK else EDATA[0]:=ACK; EDATA[EDATA[1]+2]:=LRC(EDATA,2+EDATA[1]); for I:=0 to EDATA[1]+2 do begin J:=2*I; XBUFFER[J] := (EDATA[I] div 16)+ord('0'); if XBUFFER[J] > ord('9') then XBUFFER[J] := XBUFFER[J]+7; XBUFFER[J+1] := (EDATA[I] mod 16)+ord('0'); if XBUFFER[J+1] > ord('9') then XBUFFER[J+1] := XBUFFER[J+1]+7; end; XBUFFER[J+2] := ETX; { writeln; writeln('Emission'); for I:=0 to (EDATA[1]+2) do begin J := 2*I; write(chr(XBUFFER[J]),chr(XBUFFER[J+1]),'-'); end; write(chr(XBUFFER[J+2])); readln; } end; (********************) (* EMISSION -> TLP *) (********************) procedure EMISSION; begin SEND(UART,2*(EDATA[1]+3)+1,XBUFFER,STAT); end; (***********************) (* RECEPTION <-- TLP *) (***********************) procedure RECEPTION; var I : integer; begin CLEAR_BUF(UART); LG := ord(sizeof(XBUFFER)) div 2; RECEIVE(UART,LG,ETX,TMAX,XBUFFER,STAT); if STAT=0 then NR := (LG-1) div 2; (* nombre d'octets recus sans le ETX *) end; (************************************) (* TEST LA VALIDITE DE LA RECEPTION *) (************************************) procedure TEST_REC; var I,J : integer; I1,I2 : integer; begin for I:=0 to NR-1 do begin J:=2*I; I1 := XBUFFER[J]-ord('0'); if I1 > 9 then I1 := I1-7; I2 := XBUFFER[J+1]-ord('0'); if I2 > 9 then I2 := I2-7; XDATA[I] := I1*16+I2; end; NACKR := XDATA[0] = NACK; NACKE := XDATA[NR-1] <> LRC(XDATA,NR-1); end; begin (* EMIREC *) VALIDATION_IT(UART,true); for I := 1 to XDATA[1]+1 do EDATA[I] := XDATA[I]; (* sauvegarde *) REPET := 0; (* nombre de repetitions *) NACKE:=false; NACKR:= false; repeat STAT := 0; NR := 0; (* nombre d'octets recus *) PREP_EBUFFER; EMISSION; if STAT = 0 then begin RECEPTION; { writeln; write('Reception STAT=',STAT:2); writeln(' Nb octets : ',NR:2); for I:=0 to NR-1 do begin J := 2*I; write(chr(XBUFFER[J]),chr(XBUFFER[J+1]),'-'); end; write(chr(XBUFFER[J+2])); readln; } if STAT = 0 then TEST_REC; end; REPET := REPET+1; if REPET = REPETMAX then STAT := -1; (* erreur repet. *) until (STAT <> 0) or (not (NACKE or NACKR)); VALIDATION_IT(UART,false); end; (******************* ORDRES ELEMENTAIRES ***********************) (***************** pour toutes les cartes *********************) (********************************************) (* INTERPRETATION DU STATUS DU TLP *) (* En entree : COMD : commande TLP en cours *) (* STATUS : STATUS TLP *) (* STAT : Status E/S *) (* En sortie : si STAT < 0 (erreur E/S) *) (* ou code transcode ou *) (* code d'erreur TLP *) (* 3 = carte absente, 5 = carte *) (* arrachée, 12 = carte muette, *) (* 7 = erreur de parite. *) (********************************************) procedure T5_INTSTATUS(var CC : CONTEXTE_CARTE; STATUS : integer; var STAT : integer); begin if STAT=0 then with CC^ do begin STAT := STATUS; if STATUS > 0 then (* ce n'est pas une erreur procedure *) case STATUS of $FB : STAT := 5; (* carte absente *) $F7 : STAT := 3; (* carte arrachée *) $A2 : STAT := 12; (* carte muette *) $A3 : STAT := 7; (* erreur parité *) $A0 : STAT := 8; (* carte non reconnue *) $E7 : STAT := 0; (* erreur signalee par la carte *) $10, $E4, $1D : STAT := 36; (* erreur dans la reponse carte *) $12, $1A : STAT := 37; (* probleme de longueur des donnees *) $13 : STAT := 38; (* probleme lecture avec carte asynchrone *) $15 : STAT := 39; (* carte hors tension *) $E5 : STAT := 40; (* rupture de sequence par la carte *) end; if ((STAT=3) or (STAT=5) or (STAT=39)) then INIT_CTX := true; (* contexte carte a reinitialiser *) end; end; (*********************************) procedure T5_P_XDATAentrant(APPLIC,A1,A2 : integer;L:integer); begin XDATA[1] := L+6; (* nombre d'octets du bloc *) XDATA[2] := $DA; (* ordre entrant *) XDATA[3] := APPLIC; (* numero application *) XDATA[5] := A1; XDATA[6] := A2; XDATA[7] := L; (* longueur *) end; (*********************************) procedure T5_P_XDATAsortant(APPLIC,A1,A2 : integer;L:integer); begin XDATA[1] := 6; (* nombre d'octets du bloc *) XDATA[2] := $DB; (* ordre sortant *) XDATA[3] := APPLIC; (* numero application *) XDATA[5] := A1; XDATA[6] := A2; XDATA[7] := L; (* longueur *) end; (*******************************************) (* procedure de configuration en mode *) (* GCR et definition du type de la carte : *) (* recherche parmi les trois type de *) (* cartes reconnues *) (* LECT_ASYNCH = 2 -> asynchrone *) (* = 3 -> synchrone "256" *) (* = 4 -> synchrone "416" *) (*******************************************) procedure DEF_CARTE_MST (CC: integer; var XDATA:PDU; var STAT:integer); var I : integer; OK : boolean; begin with CONTEXT[CC]^ do begin XDATA[1]:=3; (* Configuration en mode GCR *) XDATA[2]:=$01; XDATA[3]:=0; XDATA[4]:=$C1; T5_EMIREC(XDATA,ADRUART,TCOURT,STAT); (* longueur ??? *) T5_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); if (STAT = 0) then begin if ((CTYPE <> XXX) and (CTYPE <> CAM)) then begin case CTYPE of M64, M4, D1, MP : begin XDATA[1]:=3; (* definition de type carte asynchrone *) XDATA[2]:=$02; XDATA[3]:=2; LECT_ASYNCH := 2; XDATA[4]:=0; T5_EMIREC(XDATA,ADRUART,TCOURT,STAT); T5_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); end; F256 : begin XDATA[1]:=3; (* definition de type carte synchrone "256" *) XDATA[2]:=$02; XDATA[3]:=3; LECT_ASYNCH := 3; XDATA[4]:=0; T5_EMIREC(XDATA,ADRUART,TCOURT,STAT); T5_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); end; G416 : begin XDATA[1]:=3; (* definition de type carte synchrone "416" *) XDATA[2]:=$02; XDATA[3]:=4; LECT_ASYNCH := 4; XDATA[4]:=0; T5_EMIREC(XDATA,ADRUART,TCOURT,STAT); T5_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); end; else ; end; XDATA[1]:=4; (* mise sous tension *) XDATA[2]:=$6E; XDATA[3]:=1; (* watch dog en secondes *) XDATA[4]:=0; XDATA[5]:=0; T5_EMIREC(XDATA,ADRUART,TCOURT,STAT); T5_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); end else begin (* type de carte non defini ou inconnu *) I:=2; OK:=false; repeat XDATA[1]:=3; (* definition de type carte courante *) XDATA[2]:=$02; XDATA[3]:=I; LECT_ASYNCH := I; XDATA[4]:=0; T5_EMIREC(XDATA,ADRUART,TCOURT,STAT); T5_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); if (STAT = 0) then begin XDATA[1]:=4; XDATA[2]:=$6E; XDATA[3]:=1; (* watch dog en secondes *) XDATA[4]:=0; XDATA[5]:=0; T5_EMIREC(XDATA,ADRUART,TCOURT,STAT); T5_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); if ((STAT=12) or (STAT=8) or (STAT=36)) then I := I+1 (* carte non supportée par le coupleur *) else begin OK:=true; (* carte reconnue *) LECT_ASYNCH:=I; end; end else OK := true; until ((OK = true) or (I > 4)); end; end; end; end; (* decodage trame standard : XDATA *) procedure T5_ENTREE_SORTIE(CC: integer; var XDATA:PDU; var STAT:integer); var YDATA: PDU; I:integer; begin for I:=0 to 255 do YDATA[I]:=XDATA[I]; with CONTEXT[CC]^ do begin case XDATA[1] of OMHT : begin XDATA[1]:=1; XDATA[2]:=$4D; T5_EMIREC(XDATA,ADRUART,TCOURT,STAT); T5_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); end; OMST : begin (* mise sous tension de la carte *) DEF_CARTE_MST(CC,XDATA,STAT); (* definition du type de la carte et *) (* envoi de l'ordre "mst" *) if STAT=0 then begin (* pas de pb *) if (LECT_ASYNCH=2) then begin YDATA[5]:= ASYNCH; (* type de carte *) YDATA[6]:= XDATA[5]-2; (* récupération longueur données moins ME1&ME2 *) YDATA[3]:= XDATA[5+XDATA[5]-1]; (* ME1 avant dernier octet des donnees *) YDATA[4]:= XDATA[5+XDATA[5]]; (* ME2 dernier octet des données *) (* WARNING VOIRE LA DOC SUR LES COUPLEURS TLP : *) (* ILS RAJOUTTENT UN TA1 ET TD1 DANS LES DONNEES SYSTEMES *) (* Cf DOC CARTE M4, PAGE 51 *) (* IL FAUT DONC MODIFIER T0 (TD0) EN CONSEQUENCE *) (* IL FAUT EGALEMENT COMPLEMENTER TS *) YDATA[7] := not YDATA[7]; (* TS *) YDATA[8] := YDATA[8] or $90; (* T0 *) end else begin YDATA[5]:=SYNCH; YDATA[3]:= $90; YDATA[4]:= 0; YDATA[6]:= XDATA[5]; (* EN MODE GCR, LE COUPLEUR EST COMPLETEMENT TRANSPARENT *) (* ET NE RENVOIE DONC QUE LES OCTETS EMIS PAR LA CARTE; *) (* IL N'Y A DONC PAS DE ME1, ME2 ET MCH POUR LES CARTES *) (* SYNCHRONES *) (* DE PLUS T0 = 0 *) end; for I:=0 to YDATA[6]-1 do YDATA[7+I]:=XDATA[6+I]; (* données recupérees *) end; end; OS : begin T5_P_XDATAsortant(APPLIC,XDATA[3],XDATA[4],XDATA[5]); XDATA[4] := YDATA[2]; T5_EMIREC(XDATA,ADRUART,TCOURT,STAT); YDATA[3]:= XDATA[XDATA[1]]; (* ME1 aprés les données*) YDATA[4]:= XDATA[XDATA[1]+1]; (* ME2 2ème octet après les données *) T5_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); if (STAT = 0) then begin YDATA[5]:= XDATA[1]-3; if YDATA[5]>0 then for I:=0 to YDATA[5]-1 do YDATA[6+I]:=XDATA[3+I]; (* données recupérees *) end; end; OE : begin T5_P_XDATAentrant(APPLIC,XDATA[3],XDATA[4],XDATA[5]); XDATA[4] := YDATA[2]; if YDATA[5]> 0 then for I:=0 TO YDATA[5]-1 do XDATA[8+I]:=YDATA[6+I]; T5_EMIREC(XDATA,ADRUART,TCOURT,STAT); YDATA[3] := XDATA[3]; (* ME1 *) YDATA[4] := XDATA[4]; (* ME2 *) YDATA[5] := 0; (* pas de donnée en entrant *) T5_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); end; end{case}; for I:=0 to 255 do XDATA[I]:=YDATA[I]; end; end{DECOD}; end. (**************************** FIN FICHIER ****************************)