(********************************) (* LRCCETT.PAS *) (* LOLITA V03.0 *) (* le 10/06/91 *) (********************************) (*----------------------------------------------------------------------*) (* VERSION MS-PASCAL, JUILLET 1986, P.CHOUR. (c) SUPELEC - SOREFI *) (* ACCES AU LECTEUR DE CARTE, GESTION DE LA PROCEDURE DE TRANSMISSION *) (* Version LRCCETT Juin 1991 *) (* Version LOLITA V02.0 : mars 1988 *) (*----------------------------------------------------------------------*) unit LRCCETT; interface uses DOS,CAMvars,LOLIIO; (********* Procédures publiques **********) procedure T6_ENTREE_SORTIE(CC: integer; var XDATA:PDU; var STAT:integer); procedure T6_INIT_UART(AD : word); (***********************) implementation const ACK = $60; (* acquitement *) NACK = $E0; (* non acquitement *) ETX = 3; (* fin de texte *) (***********************) (* Initialisation UART *) (***********************) procedure T6_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 T6_EMIREC(var XDATA : PDU;UART:word;TMAX : integer; var STAT : integer); var EDATA : PDU; (* 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 : integer; LRC : integer; begin LRC := 0; for I := 1 to EDATA[1] do begin XDATA[I-1] := EDATA[I+1]; LRC := LRC xor XDATA[I-1]; end; XDATA[EDATA[1]] := LRC; { writeln; writeln('Prep Ebuffer : Emission'); for I:=0 to (EDATA[1]) do write(XDATA[I]:2:16,' '); readln; } end; (********************) (* EMISSION->LECTEUR*) (********************) procedure EMISSION; begin SEND(UART,EDATA[1]+1,XDATA,STAT); end; (***********************) (* RECEPTION<--LECTEUR *) (***********************) procedure RECEPTION; var I : integer; XBUFFER : PDU; begin CLEAR_BUF(UART); LG := 2; RECEIVE(UART,LG,ETX,TMAX,XDATA,STAT); { write(' Re‡u : ', LG ,' octets '); for I:= 1 to 2 do write(XDATA[I-1]:2:16,' '); writeln; } if ((STAT=0) and (LG=2)) then begin LG := XDATA[0]*256 + XDATA[1] - 2; RECEIVE(UART,LG,ETX,TMAX,XBUFFER,STAT); { write(' Re‡u : ', LG ,' octets '); for I:= 0 to LG-1 do write(XBUFFER[I]:2:16,' '); writeln; } if STAT=0 then begin NR := (LG + 2); for I:=2 to LG+1 do XDATA[I] := XBUFFER[I-2]; end; end; end; (************************************) (* TEST LA VALIDITE DE LA RECEPTION *) (************************************) procedure TEST_REC; var I : integer; LRC : integer; begin LRC := 0; for I := 0 to NR-1 do LRC := LRC xor XDATA[I]; if LRC <> 0 then STAT := -5; end; begin (* EMIREC *) VALIDATION_IT(UART,true); for I := 1 to XDATA[1]+1 do EDATA[I] := XDATA[I]; (* sauvegarde *) STAT := 0; NR := 0; (* nombre d'octets recus *) PREP_EBUFFER; EMISSION; if STAT = 0 then begin RECEPTION; { writeln; writeln('Après reception, stat = ',STAT,' nb octets re‡us : ',NR); for I:=0 to NR-1 do write(XDATA[I]:2:16,' '); readln; } if STAT = 0 then TEST_REC; end; VALIDATION_IT(UART,false); end; (******************* ORDRES ELEMENTAIRES ***********************) (***************** pour toutes les cartes *********************) (********************************************) (* INTERPRETATION DU STATUS DU LECTEUR *) (* En entree : COMD : commande LEC. en cours*) (* STATUS : STATUS LECTEUR *) (* STAT : Status E/S *) (* En sortie : si STAT < 0 (erreur E/S) *) (* ou code transcode ou *) (* code d'erreur LECTEUR *) (* 3 = carte absente, 5 = carte *) (* arrachée, 12 = carte muette, *) (* 7 = erreur de parite. *) (********************************************) procedure T6_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 $FF : STAT := 5; (* carte absente *) $FE : STAT := 3; (* carte arrachée *) $FA : STAT := 36; (* erreur dans la reponse carte *) $FB : STAT := 42; (* erreur de syntaxe *) $F9 : STAT := 7; (* erreur parité *) $F8 : STAT := 12; (* carte muette *) $F7 : STAT := 8; (* carte non reconnue *) $F6 : STAT := 39; (* carte hors tension *) $F5 : STAT := 41; (* quartz interdit *) $F3 : STAT := 43; (* défaut d'accès à la RAM *) $F2 : STAT := 37; (* probleme de longueur des donnees *) end; if ((STAT=3) or (STAT=5) or (STAT=39)) then INIT_CTX := true; (* contexte carte a reinitialiser *) end; end; (*********************************) procedure T6_P_XDATAentrant(APPLIC,A1,A2 : integer;L:integer); begin XDATA[1] := L+6; (* nombre d'octets du bloc *) XDATA[2] := $0B; (* ordre entrant *) XDATA[3] := APPLIC; (* numero application *) XDATA[5] := A1; XDATA[6] := A2; XDATA[7] := L; (* longueur *) end; (*********************************) procedure T6_P_XDATAsortant(APPLIC,A1,A2 : integer;L:integer); begin XDATA[1] := 6; (* nombre d'octets du bloc *) XDATA[2] := $0C; (* ordre sortant *) XDATA[3] := APPLIC; (* numero application *) XDATA[5] := A1; XDATA[6] := A2; XDATA[7] := L; (* longueur *) end; (* decodage trame standard : XDATA *) procedure T6_ENTREE_SORTIE(CC: integer; var XDATA:PDU; var STAT:integer); var YDATA : PDU; I : integer; LG : 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]:=$0A; T6_EMIREC(XDATA,ADRUART,TCOURT,STAT); T6_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); YDATA[2]:= STAT; end; OMST : begin (* mise sous tension de la carte *) XDATA[1]:=1; XDATA[2]:=$09; T6_EMIREC(XDATA,ADRUART,TCOURT,STAT); T6_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); YDATA[2]:=STAT; if STAT=0 then begin (* pas de pb *) YDATA[5]:= ASYNCH; (* type de carte *) YDATA[6]:= XDATA[1]-6; (* récupération longueur données moins ME1,ME2,*) (* LG1, LG2, STATUS et LRC *) YDATA[3]:= XDATA[XDATA[1]-3]; (* ME1 avant dernier octet des donnees *) YDATA[4]:= XDATA[XDATA[3]-2]; (* ME2 dernier octet des données *) for I:=0 to YDATA[6]-1 do YDATA[7+I+2]:=XDATA[3+I]; (* données recupérees *) YDATA[6] := YDATA[6] + 2; YDATA[7] := $00; YDATA[8] := $05; end; end; OS : begin T6_P_XDATAsortant(APPLIC,XDATA[3],XDATA[4],XDATA[5]); XDATA[4] := YDATA[2]; T6_EMIREC(XDATA,ADRUART,TCOURT,STAT); LG := XDATA[0]*256 + XDATA[1]; YDATA[3]:= XDATA[LG-3]; (* ME1 aprés les données*) YDATA[4]:= XDATA[LG-2]; (* ME2 2ème octet après les données *) YDATA[5]:= LG-6; (* récupération longueur données moins ME1,ME2, *) (* LG1, LG2, STATUS et LRC *) if YDATA[5]>0 then for I:=0 to YDATA[5]-1 do YDATA[6+I]:=XDATA[3+I]; (* données recupérees *) T6_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); YDATA[2]:=STAT; (* status *) end; OE : begin T6_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]; T6_EMIREC(XDATA,ADRUART,TCOURT,STAT); YDATA[3] := XDATA[3]; (* ME1 *) YDATA[4] := XDATA[4]; (* ME2 *) YDATA[5] := 0; (* pas de donnée en entrant *) T6_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); YDATA[2]:=STAT; (* status *) end; OCDF : begin XDATA[1]:=2; XDATA[2]:=$0D; XDATA[3]:=YDATA[2]; T6_EMIREC(XDATA,ADRUART,TCOURT,STAT); T6_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); YDATA[2]:= STAT; end; OTDR : begin XDATA[1]:=1; XDATA[2]:=$0E; T6_EMIREC(XDATA,ADRUART,TCOURT,STAT); T6_INTSTATUS(CONTEXT[CC],XDATA[2],STAT); YDATA[2]:= STAT; if STAT=0 then begin YDATA[3] := XDATA[3]; (* dimension de la *) YDATA[4] := XDATA[4]; (* RAM externe *) end; end; end (* case *); for I:=0 to 255 do XDATA[I]:=YDATA[I]; end; end (* T6_ENTREE_SORTIE *); end. (**************************** FIN FICHIER ****************************)