<***********************************************************************
<* *
<* *
<* CE PROGRAMME PERMET DE COPIER OU D'EDITER DES *
<* FICHIERS CARTES SUR DISQUE. *
<* *
<* LES COMMANDES SONT: *
<* +LP : BASCULE L'UNITE DE SORTIE (VISU <--> LP1) *
<* +BM : BASCULE L'UNITE DE SORTIE (VISU <--> MT1) *
<* +CL : CHANGEMENT DU CARACTERE CLOCHE D'ERREUR...
<* +CO 'N1' (N-M) 'N2' (P) : COPIER LE FICHIER N1 (DE N A M) *
<* SUR LE FICHIER N2 (APRES P) *
<* +ED 'N1' : EDITER LE FICHIER N1 *
<* +FC 'N1''N2' : ENREGISTREMENT DE MODIFICATIONS PORTANT
<* SUR LE FICHIER 'N1' DANS LE FICHIER 'N2' ;
<* CE FICHIER 'N2' EST ENSUITE EXECUTABLE
<* SOUS 'FI' POUR MODIFIER 'N1'...
<* +KO 'N1' : COMPARER LE FICHIER N1 AU FICHIER DE TRAVAIL *
<* +LI 'N1' (N-M) : LISTER LE FICHIER N1 (DE N A M) *
<* +LN 'N1' (N-M) : IDEM AVEC NUMEROTATION *
<* +PU 'N1' (N-M) : PUNCHER LE FICHIER N1 (DE N A M) *
<* +PN 'N1' (N-M) : IDEM AVEC NUMEROTATION *
<* +PC 'N1' : PUNCHER LE FICHIER N1 EN COMPACTE *
<* CS(CARACTERE(N)) :LA CARTE COMPRENANT LE CARACTERE EN COLONNE N SERA
<* CONSIDEREE PAR RL COMME LA SUITE DE LA CARTE
<* PRECEDANTE.RL NE FERA LA RECHERCHE QUE SUR DES
<* PREMIERES CARTES QUI SERONT ALORS EDITEES AVEC LEURS
<* CARTES SUITE.N NON SPECIFIE SERA PRIS A 1.
<* UNE REPONSE VIDE RETABLIT LE MODE NORMAL.
<* +RL 'N1' (N-M) 'CH1','CH2',...,'CHN' AVEC
<* 'CHI'='CHI1''CHI2'...'CHIM'
<* LA VIRGULE "," ETANT L'OPERATEUR
<* "OR", ET LA CONCATENATION, L'OPERA-
<* TEUR "AND" ; CECI N'EST PAS UNE GROSSE
<* CONTRAINTE, CAR "OR" ET "AND" SONT
<* DISTRIBUTIFS L'UN PAR RAPPORT A L'AUTRE,
<* ET TOUTE EXPRESSION LOGIQUE PEUT SE RAMENER
<* A UNE SOMME ("OR") DE PRODUIT ("AND"). 'RL'
<* PROCEDE A UNE RECHERCHE DE CHAINES DANS LE
<* FICHIER 'N1' ENTRE LES LIGNES N ET M.
<* ENFIN LORSQU'UNE CHAINE EST SUIVIE
<* DU SIGNE "-", C'EST ALORS SON ABSENCE
<* QUI EST RECHERCHEE ; "\" SERA UTILISE
<* LORSQUE L'ON DESIRERA RECHERCHER "'"...
<* +RC <MEME SYNTAXE> : FONCTION IDENTIQUE, MAIS AVEC
<* COMPTAGE UNIQUEMENT.
<* +DF 'N1' : DETRUIRE LE FICHIER N1 *
<* +:F : FIN DE TRAITEMENT *
<* +MF 'XX' : MODIFICATION DU ":F" PAR LES 2 PREMIERS *
<* CARACTERES DE "XX" *
<* +MC N : ARRETER LE PUNCH COMPACTE TOUTES LES (N)
<* CARTES (128 IMPLICITEMENT).
<* +JE N : DONNE LE NOMBRE D'ESPACES SITUES AU DEBUT DU
<* MESSAGE A LAISSER INTACT ('JUSTD').
<* +JM N : DONNE LE NOMBRE D'ESPACES MANQUANT AU DELA DU
<* QUEL ON NE FAIT RIEN ('JUSTM').
<* +JI N : DONNE LE NOMBRE DE CARACTERES A NE PAS TESTER
<* AU DEBUT DU MESSAGE ('JUSTF').
<* +JP N : NOMBRE DE LIGNES PAR PAGE SUR 'NVPL' (0=PAS DE
<* SAUT DE PAGE).
<* +NJ : REINITIALISE LES PARAMETRES CI-DESSUS, TEL QUE
<* LE LISTAGE NE JUSTIFIE PAS A DROITE...
<* +MA N : PERMET DE RAZER L'ECRAN, PASSE EN 'ESC-8' SUR UN 4014,
<* DESSINE LA MARGE DROITE (80 CARACTERES), PUIS FAIT
<* HOME...
<* +FI 'N1' (N-M) : EXECUTE LES DIRECTIVES D'EDITS *
<* CONTENU DANS LE FICHIER N1 (DE N A M) *
IF ORDI-"S",XWOR%,,XWOR%
<* +Q1 : QUANTA=1 A L'ECRITURE DES FICHIERS.
<* +Q3 : QUANTA=3 A L'ECRITURE DES FICHIERS.
<* +AL<CARACTERE> : LE ALT-MODE EST REMPLACE PAR LE
<* CARACTERE DONNE EN ARGUMENT ; UNE
<* REPONSE VIDE RETABLIT LE ALT-MODE.
XWOR%: VAL 0
<* +< : EDITION D'UN COMMENTAIRE.
<* *
<* SOUS "ED", LES COMMANDES SONT : *
<* *MA : VOIR '+MA'...
<* *CR : BASCULE L'UNITE D'ENTREE SUR CR1, *
IF ORDI-"S",XWOR%,,XWOR%
<* *C1 : IDENTIQUE A 'CR',
<* *C2 : BASCULE SUR CR2.
<* *MT : BASCULE SUR MT1.
<* *AS : MODE LECTURE 'ASCI' (MODE IMPLICITE),
<* *EB : MODE LECTURE 'EBCDIC' (PRATIQUE POUR 'MT1').
<* *CC : RETOUR TEMPORAIRE AU CCI.
XWOR%: VAL 0
IF ORDI-"T",XWOR%,,XWOR%
<* *CS : IDEM ,MAIS RAPIDE EN SYMBOLIQUE *
XWOR%: VAL 0
<* *IN N : INSERER CE QUI SUIT APRES LA CARTE N *
<* *IF : INSERER A LA FIN DU FICHIER
<* *RE N(-M) P : REMPLACER PAR CE QUI SUIT LA(LES) CARTE(S) *
<* N (A M) (A PARTIR DE LA COLONNE P) *
<* *SU N(-M) : SUPPRIMER LA(ES) CARTE(S) N(A M) *
<* *CM : LES SEQUENCES DE CARTES SUIVANTES SONT EN COMPACTE *
<* *NO : LES SEQUENCES DE CARTES SUIVANTES SONT NORMALES *
<* *ME (N-M) 'CH1' 'CH2' : MODIFIER AVEC ECRASEMENT (DE N A M) *
<* LES OCCURENCES DE "CH1" PAR "CH2" *
<* *MD (N-M) 'CH1' 'CH2' : IDEM AVEC DEPLACEMENT *
<* *NE... IDEM A 'ME', MAIS EN CONSERVANT 'CH1' ET 'CH2' COURANTES,
<* *ND... IDEM A 'MD', MAIS EN CONSERVANT 'CH1' ET 'CH2' COURANTES,
<* *RR (N-M) : MODIFICATION SUR LA LIGNE (DE N A M) *
<* *:F : FIN D'EDITION *
<* :F : TERMINE TOUTE SEQUENCE DE CARTES *
<* POUR RENTRER LE CARACTERE EOT EN T-S, RENTRER CTL-F *
<* *
<* TOUT TRAITEMENT PEUT ETRE INTERROMPU PAR UN ALT-MODE *
<* *
<* *
<***********************************************************************
IDP "EDITEUR DE FICHIERS CARTES"
IDP "RELEASE 15-3 20/08/80"
IDP "J-F COLONNA - B GUERIN - S SOUZEAU"
IF ORDI-"T",X100,,X100
IDP "VERSION T1600"
QUANTA: VAL 1
X100: VAL 0
IF ORDI-"S",X100,,X100
IDP "VERSION SOLAR"
QUANTA: VAL 3
X100: VAL 0
YY7: VAL 1>7
YY8: VAL YY7*2
LBUFVI: VAL 40 < LONGUEUR BUFFER VISU
NSPETA: VAL '74
OTODLN: VAL 8
NCHMAX: VAL 4 < NBRE MAX DE CHAINES POUR RL/RC SUR "AND".
NOR: VAL 4 < NOMBRE MAX DE "OR" POUR RL/RC.
NCARCH: VAL 20 < NBRE + 1 DE CARACTERES
< AUTORISES PAR CHAINES
PAGE
<***********************************************************************
<* *
<* NUMEROS D'UNITES UTILES A EDIT. *
<* *
<***********************************************************************
NVPI: VAL '01 < ENTREE
NVPO: VAL '02 < SORTIE
NVPC: VAL '07 < LECTEUR
NVPL: VAL '07 < IMPRIMANTE
NVPF: VAL '08 < FICHIER
NVPT: VAL '09 < FICHIER
NVPBID: VAL '0B < BIDON
NVPFI: VAL '0A < FICHIER FI
<***********************************************************************
<* *
<* INTERFACE AVEC CMS4. *
<* *
<***********************************************************************
TABLE
ZERO: EQU $
DZS '10
WORD DEBUT
<***********************************************************************
<* *
<* POINT D'ENTREE DU PROGRAMME. *
<* *
<***********************************************************************
WORD EDIT
PROG
DEBUT: EQU $
LRP L
BR -1,L
<***********************************************************************
<* *
<* BUFFERS. *
<* *
<***********************************************************************
BUFCO: DZS '38 < BUFFER POUR NOM INTERNE
BUFNM: EQU BUFCO+6
SGFIN: DZS YY7*QUANTA < BUFFER DE LECTURE DE FICHIER
SGFIIN: DZS YY7*QUANTA < BUFFER LECTURE FICHIER FI
ENTCFI: DZS LBUFVI+1 < BUFFER DECOMPACTATION FI
ENTCOM: DZS LBUFVI+1 < BUFFER DE COMPACTION CARTE
ENTBIN: DZS 80 < CARTE EN BINAIRE ETENDU
BINAIR: EQU ENTBIN < CARTE EN BINAIRE COMPACTE
DZS 10 < MARGE DE SECURITE POUR L'ECLATEMENT
< BENSON (A CAUSE DE '6D --> '0D+'0A...).
BBENS2: EQU ENTBIN < BUFFER DE RECEPTION DE L'ECLATEMENT
< BENSON...
A6D: WORD '6D < CRLF POUR LISTE
< ET ARRET RECHERCHE BLANC
CARTE: DZS LBUFVI*2 < ENTREE COMMANDE ET NON COMPACTEE
BUFSOR: EQU CARTE-1 < BUFFER D'ECRITURE
SGFOUT: DZS YY7*QUANTA < BUFFER DE SORTIE DE FICHIER
PAGE
<***********************************************************************
<* *
<* TABLE DE CODAGE DES CARACTERES POUR LE PUNCH. *
<* *
<***********************************************************************
TABCOD: EQU $-'20+1
WORD '2121 < EOT 4(TRANSPOSE EN '1F)
WORD '0000 < SPACE 20
WORD '4821 < ! 21
WORD '0061 < " 22
WORD '0421 < # 23
WORD '4421 < $ 24
WORD '2222 < % 25
WORD '8001 < & 26
WORD '0121 < ' 27
WORD '8121 < ( 28
WORD '4121 < ) 29
WORD '4222 < * 2A
WORD '80A1 < + 2B
WORD '2421 < , 2C
WORD '4002 < - 2D
WORD '8421 < . 2E
WORD '3002 < / 2F
WORD '2001 < 0 30
WORD '1001 < 1 31
WORD '0801 < 2 32
WORD '0401 < 3 33
WORD '0201 < 4 34
WORD '0101 < 5 35
WORD '0081 < 6 36
WORD '0041 < 7 37
WORD '0021 < 8 38
WORD '0011 < 9 39
WORD '0821 < : 3A
WORD '40A1 < ; 3B
WORD '8222 < < 3C
WORD '00A1 < = 3D
WORD '20A1 < > 3E
WORD '2061 < ? 3F
WORD '0222 < @ 40
WORD '9002 < A 41
WORD '8802 < B 42
WORD '8402 < C 43
WORD '8202 < D 44
WORD '8102 < E 45
WORD '8082 < F 46
WORD '8042 < G 47
WORD '8022 < H 48
WORD '8012 < I 49
WORD '5002 < J 4A
WORD '4802 < K 4B
WORD '4402 < L 4C
WORD '4202 < M 4D
WORD '4102 < N 4E
WORD '4082 < O 4F
WORD '4042 < P 50
WORD '4022 < Q 51
WORD '4012 < R 52
WORD '2802 < S 53
WORD '2402 < T 54
WORD '2202 < U 55
WORD '2102 < V 56
WORD '2082 < W 57
WORD '2042 < X 58
WORD '2022 < Y 59
WORD '2012 < Z 5A
WORD 'C002 < CROC G 5B
WORD '6002 < ANTI / 5C
WORD 'A002 < CROC D 5D
WORD '8062 < CHAPEAU 5E
WORD '4062 < SOULIGN 5F
FTBCOD: EQU $
PAGE
<***********************************************************************
<* *
<* MESSAGES D'ERREURS. *
<* *
<***********************************************************************
MK1: BYTE 11;'6D
ASCI "IDENTIQUES"
MK2: BYTE 43;'6D
ASCI "*************** DIFFERENTS ***************"
ERRSEQ: BYTE 19;'6D
ASCI "ERREUR DE SEQUENCE"
ERRCOM: BYTE 3;'6D
ASCI "??"
ERRFE: BYTE 38;'6D
ASCI "NOM DE FICHIER ERRONNE OU CHAINE VIDE"
ERRFC: BYTE 25;'6D
ASCI "FICHIER FC PRE-EXISTANT!"
ERRFI: BYTE 19;'6D
ASCI "FICHIER INEXISTANT"
ERRFI2: BYTE 20;'6D
ASCI "COMMANDE FI SOUS FI"
ERRFI3: BYTE 21;'6D
ASCI "FICHIER FI INCOMPLET"
ERRFI4: BYTE 23;'6D
ASCI "??"
DZS 10
ERRLIR: BYTE 49;'6D
ASCI "ERREUR DE CHECKSUM OU DE NUMEROTATION : "
ERRLI1: DZS 4 < NUMERO DE LIGNE
ERRQUO: BYTE 17;'6D
ASCI "MANQUE UNE QUOTE"
ERRRLC: BYTE 16;'6D
ASCI "TROP DE CHAINES"
MESRC1: BYTE 23;'6D
ASCI "NOMBRE DE LIGNES ="
DZS 2
MCHAI1: BYTE 5;'6D
ASCI "CH1="
MCHAI2: BYTE 5;'6D
ASCI "CH2="
MPLA: BYTE 25;'6D
ASCI "MANQUE D'ESPACE DISQUE !"
PAGE
<***********************************************************************
<* *
<* CARTES "!ASSIGN". *
<* *
<***********************************************************************
MASSNT: ASCI "!ASSIGN " < !ASSIGN NVPT=N,
BYTE NVPT='FA00('00FF;"="
ASCI "N,"
NOMTN: DZS 10
MASSTO: ASCI "!ASSIGN "
BYTE NVPT='FA00('00FF;"="
ASCI "O,"
NOMOT: DZS 10
MASSOT: ASCI "!ASSIGN " < !ASSIGN NVPBID=O,
BYTE NVPBID='FA00('00FF;"="
MASSD: ASCI "O," < "O," OU "D-"
NOMTO: DZS 10
MASSRT: ASCI "!ASSIGN " < !ASSIGN NVPBID=R
BYTE NVPBID='FA00('00FF;"="
BYTE "R";'04
MASSB: ASCI "!ASSIGN " < !ASSIGN X=CU1
BYTE NVPL='FA00('00FF;"=";"C";"U"
N0CU: BYTE "1";'04
MASSOF: ASCI "!ASSIGN " < !ASSIGN NVPF=O,
BYTE NVPF='FA00('00FF;"="
ASCI "O,"
NOMFO: DZS 10
MASSNF: ASCI "!ASSIGN " < !ASSIGN NVPF=N,
BYTE NVPF='FA00('00FF;"="
ASCI "N,"
NOMFN: DZS 10
MASSSF: ASCI "!ASSIGN " < !ASSIGN NVPF=S
BYTE NVPF='FA00('00FF;"="
BYTE "S";'04
MASSCR: ASCI "!ASSIGN " < !ASSIGN NVPC=CR1
BYTE NVPC='FA00('00FF;"="
MTCR: ASCI "CR"
ADCR1: BYTE "1";'04
MASCRS: ASCI "!ASSIGN " < !ASSIGN NVPC=S
BYTE NVPC='FA00('00FF;"="
BYTE "S";'04
MASSLP: ASCI "!ASSIGN " < !ASSIGN NVPL=LP1
BYTE NVPL='FA00('00FF;"="
MTLP: ASCI "LP"
MTLP1: BYTE "1";'04
MCLF: ASCI "!ASSIGN "
BYTE NVPF='FA00('00FF;"=";"S";'04
MCLT: ASCI "!ASSIGN "
BYTE NVPT='FA00('00FF;"=";"S";'04
MCLL: ASCI "!ASSIGN "
BYTE NVPL='FA00('00FF;"=";"S";'04
MCLC: ASCI "!ASSIGN "
BYTE NVPC='FA00('00FF;"=";"S";'04
MCLB: ASCI "!ASSIGN "
BYTE NVPBID='FA00('00FF;"=";"S";'04
MASSFI: ASCI "!ASSIGN " < !ASSIGN NVPFI = ,O
BYTE NVPFI='FA00('00FF;"="
ASCI "O,"
NOMFI1: DZS 10
MCLFI: ASCI "!ASSIGN " < !ASSIGN NVPFI=S
BYTE NVPFI='FA00('00FF;"=";"S";'04
PAGE
<***********************************************************************
<* *
<* COMMANDES. *
<* *
<***********************************************************************
LISCOM: ASCI "IN"
ASCI "IF"
ASCI "RE"
ASCI "RR"
ASCI "SU"
ASCI "NE"
ASCI "ND"
ASCI "ME"
ASCI "MD"
ASCI "CM"
ASCI "NO"
ASCI "CR"
IF ORDI-"S",XWOR%,,XWOR%
ASCI "C1"
ASCI "C2"
ASCI "MT"
COMEB: ASCI "EB"
COMAS: ASCI "AS"
ASCI "CC"
XWOR%: VAL 0
IF ORDI-"T",XWOR%,,XWOR%
ASCI "CS"
XWOR%: VAL 0
COMEND: EQU $
ASCI ":F"
COMMA: ASCI "MA"
COEDIT: EQU $
ASCI "MF"
ASCI "MC"
ASCI "JE"
ASCI "JM"
ASCI "JI"
ASCI "NJ"
ASCI "JP"
ASCI "ED"
ASCI "FC"
ASCI "RL"
ASCI "RC"
ASCI "LN"
ASCI "LI"
ASCI "PC"
ASCI "PN"
ASCI "PU"
ASCI "CO"
ASCI "LP"
ASCI "BM"
ASCI "BE"
ASCI "CL"
ASCI "DF"
ASCI "KO"
ASCI "FI"
IF ORDI-"S",XWOR%,,XWOR%
ASCI "Q1"
ASCI "Q3"
ASCI "AL"
ASCI "CS"
XWOR%: VAL 0
ASCI "< "
FINCOM: EQU $
TABCOM: WORD INSERE < ADRESSE DES COMMANDES
WORD IFSERE
WORD REMPLA
WORD REMINS
WORD SUPPRI
WORD MODIFI
WORD MODIFI
WORD MODIFI
WORD MODIFI
NEUT1: WORD COMPAC
WORD NORMAL
NEUT2: WORD READER
IF ORDI-"S",XWOR%,,XWOR%
NEUT3: WORD READE1
NEUT4: WORD READE2
NEUT5: WORD MTAPE
WORD MODEE
WORD MODEA
WORD GOCCI
XWOR%: VAL 0
IF ORDI-"T",XWOR%,,XWOR%
WORD LECTE
XWOR%: VAL 0
WORD FIN
WORD MARGE
WORD MODFIN
WORD MODCA
WORD JUSTID
WORD JUSTIM
WORD JUSTIF
WORD JUSTIN
WORD JUSTIP
WORD EDITER
WORD FICOM
WORD RECHER
WORD COMPTE
WORD LISTER
WORD LISTER
NEUT6: WORD PUNCHE
NEUT7: WORD PUNCHE
NEUT8: WORD PUNCHE
WORD COPY
NEUT9: WORD PRINLP
NEUTA: WORD PRINMT
NEUTB: WORD PRINBE
WORD CLOCHT
WORD DELF
WORD KOMP
WORD EXECFI
IF ORDI-"S",XWOR%,,XWOR%
WORD EXEQ1
WORD EXEQ3
WORD MODALT
WORD CSUITE
XWOR%: VAL 0
WORD EXECOM
FINADC: EQU $
NMFICH: DZS 10 < NOM DES FICHIERS
NOMTIC: DZS 10
NOMFI: DZS 10 < ZONE PROPRE A FI
MESRC2: DZS 2 < NOMBRE A EDITER (<10000)
CHAI1: DZS 40 < CHAINE RECHERCHEE POUR 'ME' ET 'MD'.
BYTE '04;0
CHAI2: DZS 40 < CHAINE DE REMPLACEMENT POUR 'ME'/'MD'.
BYTE '04;0
LARGRL: VAL NCHMAX*NCARCH/2+1 < LONGUEUR SAUVEGARDE CHAINES SOUS "AND".
ARGRL: EQU $ < SAUVEGARDE DES ARGUMENTS RL/RC.
DO NOR
DZS LARGRL < UNE ZONE PAR "OR" POSSIBLE.
PAGE
<***********************************************************************
<* *
<* COMMON. *
<* *
<***********************************************************************
COMMON
DEBCOM: EQU $ < DEBUT DU COMMON
RETCCI: WORD 1 < RETOUR MONITEUR
SSEDIT: DZS 1 < SOUS-EDIT
COMNOR: DZS 1 < INDICATEUR COMPACTE-NORMAL
NOCAR: DZS 1 < N0 CARTE EN EDIT
PAFIRC:: VAL -1 < INDICATEUR DE 'FIRCAR' VIDE...
FIRCAR: WORD PAFIRC < PREMIERE CARTE RENCONTREE LORS D'UNE
< COMMANDE "LN", "LI",... ET SURTOUT "RL".
LASCAR: WORD 0 < DE MEME DERNIERE CARTE...
CR1: DZS 1 < LECTEUR
LP1: DZS 1 < IMPRIMANTE
MODIF: DZS 1 < PAS DE MODIF. EFFECTUEE
LSRE: DZS 1 < INDICATEUR DE RECHERCHE
REBM: DZS 1 < INDICATEUR DE CHAINE
NBCHA: DZS 1 < NOMBRE DE CHAINES
LLCH1: WORD 0 < LONGUEUR CHAINE 1 POUR 'ME'/'MD'.
LLCH2: WORD 0 < LONGUEUR CHAINE 2 POUR 'ME'/'MD'.
DPF: ASCI ":F" < RETOUR AU ":F"
LSPF: DZS 1 < LISTE OU PERFORATION
LISNO: DZS 1 < LISTE AVEC NUMEROTATION
BATCH: WORD 1 < ENTREE EN BATCH
N: DZS 1
M: DZS 1
P: DZS 1 < P
UTILP: DZS 1 < UTILISATION DE P
DIX: WORD 10 < POUR LA CONVERSION DES NOMBRES
SETFFF: WORD '7FFF < VALEUR POUR M ET P SI ABSENTS
NOLIST: DZS 4 < NUMEROTATION DES CARTES
PLACT: DZS 1 < PLACE DANS SGFOUT
INDIN: DZS 1 < INDEX IN
TNOM: ASCI "??ED"
IDESC: BYTE 0;'04
PUCCOM: DZS 1 < PUNCH COMPACTE
NOCCP: DZS 1 < NO CARTE COMPACTEE
CHEKSM: DZS 1 < CHECKSUM POUR PUNCH COMPACTE
CRLF: BYTE '6D;"+" < CRLF
CRLFPL: BYTE '6D;"+" < CRLF-PLUS
CRLFET: BYTE '6D;"*" < CRLF-ETOILE
CRLFSU: BYTE '6D;">" < CRLF SUP
BLANC: WORD '2020 < BLANCS
DEUXPT: WORD '0820 < CODE PUNCH :
CARACF: WORD '8080 < CODE PUNCH F
RETOUR: WORD '0D20 < RETOUR A LA LIGNE
B6D: BYTE '6D;0 < POUR ENVOYER '6D...
SAUVX: DZS 1 < ZONE SAUVEGARDE POUR RL/RC
LUTBUF: WORD YY8*QUANTA-2 < LONGUEUR UTILE BUFFER FICHIER
PAGE
<***********************************************************************
<* *
<* OPEN, CLOSE, READ, WRITE SUR FICHIERS. *
<* *
<***********************************************************************
OPENOT: BYTE NVPT;'05 < OPEN OLD FICHIER TRAVAIL.
WORD 2
WORD 0
OPENTN: BYTE NVPT;'04 < OPEN NVPT NEW
WORD 2
WORD 0
OPENFO: BYTE NVPF;'05 < OPEN NVPF OLD
WORD 2
WORD 0
OPENFN: BYTE NVPF;'04 < OPEN NVPF NEW
WORD 2
WORD 0
READF: BYTE NVPF;'08 < LECTURE SUR NVPF
WORD 0
WORD YY8*QUANTA
READOT: BYTE NVPT;'08 < LECTURE FICHIER DE TRAVAIL.
WORD SGFOUT-ZERO*2
WORD YY8*QUANTA
WRITET: BYTE NVPT;'02 < ECRITURE SUR NVPT
WORD 0
WORD YY8*QUANTA
LECENT: BYTE NVPI;'01 < LECTURE COMMANDE ET NORMAL
WORD CARTE-ZERO*2
WORD LBUFVI*2
LCHAI1: BYTE NVPI;'01 < LECTURE DE LA CHAINE RECHERCHEE.
WORD CHAI1-ZERO*2
WORD 80
LCHAI2: BYTE NVPI;'01 < LECTURE DE LA CHAINE DE REMPLACEMENT.
WORD CHAI2-ZERO*2
WORD 80
LECCOM: BYTE NVPI;'08 < LECTURE EN COMPACTE
WORD ENTBIN-ZERO*2
WORD 160
LECPPC: BYTE NVPI;'01 < LECTURE D'UN CARACTERE
WORD SGFOUT-ZERO*2 < POUR LE PUNCH COMPACTE
WORD 1
ECRERR: BYTE NVPO;'02 < ECRITURE ERREURS SUR NVPO
DZS 2
WRITEO: BYTE NVPO;'02 < ECRITURE SUR NVPO
WORD BUFSOR-ZERO*2+1
WORD LBUFVI*2+1
ECCRLF: BYTE NVPO;'02 < DEMANDE D'UNE COMMANDE
WORD CRLF-ZERO*2
WORD 2
DEM6D: BYTE NVPO;'02 < SORTIE D'UN '6D...
WORD B6D-ZERO*2
WORD 1
DEMDFT: WORD '8302 < DELETE DE NVPT
WORD NOMTO-ZERO*2
WORD 38 < LG MAX
WORD -1
CCII: WORD '0002 < CCI INTERPRETATIF
WORD 0
WORD 80
LECVIS: BYTE NVPI;'0A < BOTCH OU VISU
WORD 0
WORD 1
DEMPCH: BYTE NVPL;'02 < PUNCH DE UN CARACTERE
DZS 1
WORD 2
SLEEP: WORD '0005 < TEMPORISATION PUNCH 4 SECONDES
ENFILE: WORD 0 < FIN DE FICHIER
DZS 1
DEMSGF: WORD '0008 < DEMANDE NOM INTERNE
WORD BUFCO-ZERO*2
WORD '38*2
WORD 0
DEMCOP: WORD '8402 < STORE D'UN NOM
WORD BUFNM-ZERO*2
WORD '38-6*2
WORD -1
ABUFNM: WORD BUFNM
LGENT: DZS 1 < POUR COMMANDE CS
PAGE
<***********************************************************************
<* *
<* RELAIS. *
<* *
<***********************************************************************
DELT: WORD SPDELT < SP DE DELETE FILE NVPT
RNOM: WORD SPRNOM < SP DE RELEVE D'UN NOM DE FICHIER
RCAR: WORD SPRCAR < SP DE RELEVE D'UNE CHAINE DE CAR
DEP: WORD SPDEP < SP DE DEPLACEMENT SUR UNE LIGNE
MOVT: WORD SPMOVT < SP DE MOVE NOM DANS ASSIGN NVPT
MOVF: WORD SPMOVF < SP DE MOVE NOM DANS ASSIGN NVPF
OPTN: WORD SPOPTN < SP DE OPEN NVPT NEW
OPTO: WORD SPOPTO < SP DE OPEN NVPT OLD
OPFO: WORD SPOPFO < SP DE OPEN NVPF OLD
OPFN: WORD SPOPFN < SP DE OPEN NVPF NEW
OPFX: WORD SPOPFX < SP DE OPEN NVPF OLD OU NEW
DECO: WORD SPDECO < SP DE DECOMPACTION
COMP: WORD SPCOMP < SP DE COMPACTION
AWRITE: WORD WRITE < SP D'ECRITURE SGF.
PLCO: WORD SPPLCO < SP DE PLACEMENT D'UN CARAC. COMP.
AMINUS: WORD MINUS < TRAITEMENT DES MINUSCULES...
LIST: WORD SPLIST < SP DE LISTE D'UNE CARTE
PERF: WORD SPPERF < SP DE PUNCH D'UNE CARTE
RECN: WORD SPRECN < SP DE RECOPIE JUSQU'A N
SUNM: WORD SPSUNM < SP DE SUPPRESSION DE N A M
AJOU: WORD SPAJOU < SP D'AJOUT APRES CARTE COURANTE
AJCK: WORD SPAJCK < SP DE CHECKSUM POUR COMPACTE
RENI: WORD SPRENI < SP DE LIBERATION LECTEUR
LINM: WORD SPLINM < SP LECTURE N ET M SI PRESENTS
RCOP: WORD SPRCOP < SP DE RECOPIE DE W CARTES
RLIR: WORD SPRLIR < SP DE LECTURE JUSQU'A N
POSB: WORD SPPOSB < SP POSIT. @ BUFFERS
RELN: WORD SPRELN < SP DE RELEVE DE N
RE1N: WORD SPRE1N < IDEM POUR INSERER
RELM: WORD SPRELM < SP DE RELEVE DE M
LECF: WORD SPLECF < SP DE LECTURE SUR NVPF (ERREUR)
RLCT: WORD SPRLCT < SP DE LECTURE SUR SGF
ECRT: WORD SPECRT < SP D'ECRITURE SUR NVPT
ININ: WORD SPININ < SP D'INITIALISATION NUMEROTATION
INCN: WORD SPINCN < SP D'INCREMENTATION NUMEROTATION
NOMB: WORD SPNOMB < SP DE RELEVE D'UN NOMBRE AVEC PRISE
< PAR DEFAUT DU NOMBRE PRECEDENT...
NOMC: WORD SPNOMC < RELEVE D'UN NOMBRE AVEC PRISE DE 0
< PAR DEFAUT...
LECB: WORD SPLECB < SP DE LECTURE UN BYTE
NMPC: WORD SPNMPC < SP DE NUMEROTATION ET PUNCH
PUPC: WORD SPPUPC < OBLIGE LE PUNCH
EXFI: WORD SPEXFI < SP D'EXECUTION DE FI
PUPU: WORD PUPUCO < PUNCH SANS NUMEROTATION
ASPCCI: WORD SPCCI < SP APPEL CCI INTERPRETATIF
MERR: WORD MSGERR < SP DE TRAITEMENT D'ERREURS
APRINT: WORD PRINT < EDITION D'UN MESSAGE.
AFINMD: WORD FINMOD < FIN DU EDIT
ADCOM: WORD COMMAN < AD. DE RELEVE D'UNE COMMANDE
ADNOLS: WORD NOLIST,X < RELAI VERS NOLIST
ABFSGI: WORD SGFIN
ABSGII: WORD SGFIN+1,X
ABFSGO: WORD SGFOUT
ABSGOF: WORD YY7*QUANTA+SGFOUT,X
XCHAI1: WORD CHAI1,X
XCHAI2: WORD CHAI2,X
ABFEN0: WORD CARTE < POINTEURS SUR LES BUFFERS
ADBFEN: WORD CARTE+LBUFVI,X
ABFECO: WORD ENTCOM
ADBFCO: WORD ENTCOM,X
ABFSO0: EQU ABFEN0
AA6D: WORD A6D < POUR ECHANGER '6D ET '20...
ABFSO1: WORD BUFSOR+1
ABFSO4: WORD BUFSOR+4
ABFSO5: WORD BUFSOR+5
ABINED: WORD ENTBIN
ABINEN: WORD ENTBIN+76,X
ABINEF: WORD ENTBIN+80,X
ABINPC: WORD ENTBIN+40,X
ABINAR: WORD BINAIR+57,X
ACOD: WORD TABCOD,X
AMK1: WORD MK1
AMK2: WORD MK2
ADRSEQ: WORD ERRSEQ < ADRESSE MESSAGES ERREUR
ADRCOM: WORD ERRCOM
ADRFE: WORD ERRFE
ADRFI: WORD ERRFI
ADRLIR: WORD ERRLIR
ADRLI1: WORD ERRLI1
ADRQUO: WORD ERRQUO
ADRRLC: WORD ERRRLC
ADRRC1: WORD MESRC1
ACHAI1: WORD MCHAI1
ACHAI2: WORD MCHAI2
AMPLA: WORD MPLA
ANOMTO: WORD NOMTO < NOM FICHIER NVPT
ANOMTN: WORD NOMTN
ANOMOT: WORD NOMOT
ANOMFO: WORD NOMFO < NOM FICHIER NVPF
ANOMFN: WORD NOMFN
AASSNT: WORD MASSNT < MESSAGE AU CCI
AASSTO: WORD MASSTO
AASSOT: WORD MASSOT
AASSRT: WORD MASSRT
AASSB: WORD MASSB
AASSOF: WORD MASSOF
AASSNF: WORD MASSNF
AASSSF: WORD MASSSF
AASSCR: WORD MASSCR
AASCRS: WORD MASCRS
AASSLP: WORD MASSLP
ACLOSE: WORD CLOSE < S/P DE CLOSE NVPC/NVPL/NVPF/NVPT.
ACLL: WORD MCLL
ACLC: WORD MCLC
ACLF: WORD MCLF
ACLT: WORD MCLT
ACLB: WORD MCLB
AN0CU: WORD N0CU
COMNB: VAL FINCOM-LISCOM < NB COMMANDE
NBCOM: VAL -COMNB
NEDNB: VAL FINCOM-COMEND < NB COMMANDES NON SOUS EDIT
NBNED: VAL -NEDNB
SEDNB: VAL FINCOM-COEDIT < NB COMMANDES SOUS EDIT
NBSED: VAL -SEDNB
ALISCO: WORD FINCOM,X < RELAI VERS LES COMMANDES
AADCOM: WORD FINADC,X < RELAI VERS LES ADRESSES
ACMEND: WORD COMEND
ANMFIC: WORD NMFICH,X
ANOMFI: WORD NOMFI,X
ANMFID: WORD NMFICH
ANMTID: WORD NOMTIC
ANMTIC: WORD NOMTIC,X
ARC2: WORD MESRC2,X
ABENS1: WORD 0 < RELAI VERS LE BUFFER EMETTEUR D'ECLATE-
< MENT BENSON,
ABENS2: WORD BBENS2,X < ET BUFFER RECEPTEUR...
ABUFCL: WORD 0 < RELAI DE CLEAR D'UN BUFFER...
<
< CONSTANTES DE RETOUR A L'ASSEMBLEUR :
<
ACCCI: WORD '0007 < ADRESSE DE LA FONCTION D'APPEL 'CCI'.
ALOAD: WORD '0008 < ENTRY POINT DU MODULE DE CHARGEMENT
< DES OVERLAYS (CELUI DE !CALL).
AJNE: WORD '0009 < ADRESSE DU 'JNE $' IMPLEMENTE PAR !CALL.
ALAI: WORD '000A < ADRESSE DU 'LAI 7',
ASVC: WORD '000B < ADRESSE DU 'SVC 0'.
LAILAI: WORD '1007 < 'LAI 7',
SVCSVC: WORD '1C00 < 'SVC 0',
RSRRSR: WORD '1E02 < 'RSR'.
DITEM: VAL '000C < ADRESSE DE CHARGEMENT DES PROCESSEURS.
NOMA: ASCI "ASSY" < NOM DU MODULE EN RETOUR DE
BYTE 0;'04 < L'ASSEMBLEUR; L'OCTET A 0 CONTIEN-
< DRA L'<IDESC> DE L'UTILISATEUR.
LOADA: WORD '8502 < DEMANDE DE RAPPEL DE L'ASSEMBLEUR.
WORD DITEM*2
WORD SIZED < IL SUFFIT DE RECHARGER LA MEME TAILLE
< TAILLE QUE 'EDITS', MAIS LEGEREMENT
< MAJOREE (PUISQUE CALCULEE A PARTIR
< DE 'ZERO'...).
WORD -1
PAGE
<***********************************************************************
<* *
<* LOCAL *
<* *
<***********************************************************************
LOCAL
DEBLOC: EQU $
RIDGE: WORD 1 < VA-T'ON GENERER DES BANDES POUR
< TRANSFERER AU RIDGE :
< =0 : NON,
< #0 : OUI, IL FAUT ALORS RAJOUTER EN
< QUEUE DE LIGNE UN <LINE-FEED>, ET
< NE PAS CALCULER LA PARITE...
OPENFI: BYTE NVPFI;'05 < OPEN NVPFI OLD
WORD 2
WORD 0
READFI: BYTE NVPFI;'08 < LECTURE SUR NVPFI
WORD 0
WORD YY8*QUANTA
ANOMF1: WORD NOMFI1 < RELAI VERS !ASSIGN
ANOMFX: WORD NOMFI1,X
ABFFII: WORD SGFIIN < RELAI BUFFER LECTURE FICHIER FI
ASGFII: WORD SGFIIN+1,X
ADECFI: WORD ENTCFI,X < RELAI BUFFER DECOMPACTAGE FICHIER FI
AASSFI: WORD MASSFI < RELAI VERS !ASSIGN NVPFI=O,
ACLFI: WORD MCLFI < RELAI VERS !ASSIGN NVPFI=S
ADRFI2: WORD ERRFI2 < RELAI MESSAGE ERREUR FI
ADRFI3: WORD ERRFI3
ADRFI4: WORD ERRFI4
INDFI: WORD 0 < INDICATEUR FI
INDIFI: DZS 1 < INDICATEUR FIN DE SECTEUR FICHIER FI
ENDFI: WORD 0 < INDICATEUR FIN DE FICHIER FI
NCARFI: DZS 1 < NUMERO DE CARTE FI
NFI: WORD 0 < N POUR FI
MFI: WORD 0 < M POUR FI
VATRA1: DZS 1 < VARIABLE DE TRAVAIL (L)
VATRA2: DZS 1 < SAUVEGARDE VATRA1
VATRA3: DZS 1
NPREC: WORD 0 < NOMBRE RECONNU PRECEDEMMENT :
< - REMIS A 0 PAR CHAQUE APPEL 'SPRNOM',
< - MIS A JOUR A CHAQUE APPEL 'SPNOMB'.
INDED: WORD 0 < 0 : ON EST SOUS 'ED',
< 1 : ON EST SOUS 'FC'.
NOMED: WORD "ED" < POUR REMPLACER 'FC' PAR 'ED'.
TRAV1: WORD 0 < MOT DE TRAVAIL...
AERRFC: WORD ERRFC < "FICHIER FC PRE-EXISTANT!".
IF ORDI-"S",XWOR%,,XWOR%
XWOR%1: VAL 1 < CONSTANTE DE TEMPORISATION EN
< UNITE 2 MICRO-SECONDES.
DEMPCK: BYTE NVPL;'02 < DEMANDE DE PUNCH D'UNE CARTE BINAIRE.
WORD 0
WORD 80*2
CTPUSY: WORD XWOR%1 < TEMPORISATION PUNCH SYMBOLIQUE.
AADCR1: WORD ADCR1 < POUR CHANGER DE LECTEUR DE CARTES.
AMTCR: WORD MTCR < POUR COMMUTER MT <--> CR :
ACR: ASCI "CR" < CR1 OU CR2,
AMT: ASCI "MT" < MT1.
ACU: WORD "CU" < CU2.
AMTLP: WORD MTLP < POUR COMMUTER MT <--> LP :
AMTLP1: WORD MTLP1
ALP: ASCI "LP" < LP1.
CARALT: BYTE '7D < CARACTERE ALT-MODE INITIAL (AU CHARGE-
< MENT; IL POURRA ENSUITE ETRE CHANGE
< EN UTILISANT LA COMMANDE ADEQUATE).
TAPEMK: BYTE NVPL;'04 < ECRITURE D'UN TAPE-MARK...
ABFSOR: WORD BUFSOR+1,X
PCLOSE: ASCI "!CLOSE"
BYTE '04;0
CLOCHE: WORD '07 < CARACTERE D'ERREUR INSERE DANS UN
< BUFFER A LA PLACE DE CARACTERES
< INCONNUS...
ADEM6D: WORD DEM6D
XWOR%: VAL 0
NUMCA: WORD YY7 < NOMBRE DE CARTES COMPACTEES ENTRE
< CHAQUE PAUSE LORS D'UN 'PC'.
TARGRL: EQU $ < CONTEXTES DE CHACUN DES "OR".
XARGRL: MOT 0 < RELAI INDEXE COURANT,
NCHRL: MOT XARGRL+1 < NOMBRE DE "AND" PAR "OR".
DO NOR
WORD 0='F800*LARGRL+ARGRL,X;0
MARGRL: WORD 0 < NOMBRE DE "OR" A RECHERCHER,
NARGRL: WORD 0 < DECOMPTEUR DE "OR" POUR CHAQUE CARTE.
RARGRL: WORD TARGRL < POUR INITIALISER 'W'.
NEGATE: WORD 0 < 0=RECHERCHE PRESENCE D'UNE CHAINE,
< 1=RECHERCHE ABSENCE D'UNE CHAINE.
SAVEX: WORD 0 < SAUVEGARDE DU REGISTRE X DE 'EOT'.
JUSTM: WORD 2*LBUFVI < MARGE : S'IL Y A PLUS DE (JUSTM) ESPACES
< MANQUANT, ON NE FAIT RIEN...
JUSTS: WORD 0 < VARIABLE DE MANOEUVRE...
JUSTD: WORD 2*LBUFVI < NOMBRE D'ESPACES A LAISSER INTACTS
< EN TETE DE CHAQUE MESSAGE.
JUSTF: WORD -2*LBUFVI < DONNE L'INDEX DU DERNIER CARACTERE A
< TESTER : 2*LBUFVI<=JUSTF<=-1.
JUSTP: WORD 0 < 0=PAS DE SAUT DE PAGE,
< N=N LIGNES PAR PAGE.
KJUSTP: WORD 0 < DECOMPTEUR DES LIGNES PAR PAGE.
BUFP: BYTE '0D;'40 < POUR FAIRE LE SAUT DE PAGE...
DEMP: BYTE NVPL;'02 < LE SAUT DE PAGE N'EXISTE QUE SUR 'NVPL'.
WORD BUFP-ZERO*2
WORD 2
ACOMMA: WORD COMMA
ACOMEB: WORD COMEB
ACOMAS: WORD COMAS
DERASE: BYTE NVPO;'05 < EFFACEMENT DE L'ECRAN.
BHOME: BYTE '60;0
DHOME: BYTE NVPO;'02 < ENVOI HOME DU CURSEUR.
WORD BHOME-ZERO*2
WORD 1
DOG: BYTE NVPO;'03 < MISE EN GRAPHIQUE.
DCG: BYTE NVPO;'04 < RETOUR EN ALPHANUMERIQUE.
XWOR%2: VAL 108
XWOR%3: VAL 14
XWOR%1: VAL 2*LBUFVI+1*XWOR%2/XWOR%3
C108: WORD XWOR%2 < POUR LA LARGEUR
C14: WORD XWOR%3 < TOTALE D'UN CARACTERE.
BUFG: WORD 767;XWOR%1
WORD 0;XWOR%1
DWG: BYTE NVPO;'0A < TRACE DE LA MARGE DROITE.
WORD BUFG-ZERO*2
WORD 4*2
DESC: BYTE NVPO;'07 < MISE EN 'ESC;'.
BYTE '1B;";";'04;0
IF ORDI-"S",XWOR%,,XWOR%
AMASSD: WORD MASSD < POUR METTRE "O," OU "D-" :
XASSO: ASCI "O,"
XASSD: ASCI "D-"
CARSUI: WORD 0
COLSUI: WORD 0
FLASUI: WORD 0
<
< TRANSCODEAGE EBCDIC --> ASCI :
<
FIRSTE:: VAL '40 < PREMIER CARACTERE EBCDIC RECONNU.
MODE: WORD 0 < MODE=0 : LECTURE ASCI,
< =1 : LECTURE EBCDIC --> ASCI.
ATRANS: WORD TRANS,X < RELAI VERS LA TABLE DE TRANSCODAGE :
XWOR%1: VAL FIRSTE/2
TRANS: EQU $-XWOR%1
UNDEFA:: VAL '00 < CARACTERE ASCI UNDEFINI...
ASCI " ABCDEFGHI"
BYTE UNDEFA;".";"<";"(";"+";UNDEFA
UNDEFE:: VAL $-TRANS*2-1 < CARACTERE EBCDIC UNDEFINI...
ASCI "&JKLMNOPQR!$*)"
BYTE ";";UNDEFA
ASCI "-/STUVWXYZ"
BYTE UNDEFA;",";'25;UNDEFA
ASCI ">?0123456789:#"
BYTE '40;"'";"=";'22
LASTE:: VAL $-TRANS*2-1 < DERNIER CARACTERE EBCDIC...
XWOR%: VAL 0
<
< SIMULATION DES LECTURES/ECRITURES 'NVPI'/'NVPO' :
<
XSIML: WORD 1 < INDEX DU BUFFER DE SIMULATION DE
< LECTURE; LE 1ER OCTET CONTIENT LA
< DEFINITION DU CARACTERE EQUIVALENT
< AU 'R/C'...
XSIME: WORD 0 < INDEX DU BUFFER DE SIMULATION
< D'ECRITURE.
ASIML: WORD 0 < RELAI INDEX BUFFER DE LECTURE.
ASIME: WORD 0 < RELAI INDEX BUFFER D'ECRITURE.
BSIML: VAL 1 < ADRESSE DU MOT TRANSMETTANT
< L'ADRESSE DU BUFFER DE LECTURE.
BSIME: VAL 2 < ADRESSE DU MOT TRANSMETTANT
< L'ADRESSE DU BUFFER D'ECRITURE.
ALSIM: WORD 0 < ADRESSE DU MOT DONNANT LA LONGUEUR
< DE CHACUN DES BUFFERS ; SI CETTE
< LONGUEUR EST NULLE, ALORS, LES
< ENTREES-SORTIES NE SONT PAS SIMULEES.
ABUF: WORD 0 < RELAI VERS LE BUFFER D'E/S.
SIMLIM: WORD 0 < CARACTERE EQUIVALENT AU 'R/C'.
SIMBOX: WORD 0 < POUR SIMULER '1E35...
ASPSIM: WORD SPSIM < SOUS-PROGRAMME DE SIMULATION...
ASPSMC: WORD SPSIMC < RELAI...
ASPBOX: WORD SPBOX < DONNE LE NOMBRE DE CARACTERES LUS.
<
< NEUTRALISATION DE CERTAINES
< COMMANDES EN INTERPRETATIF :
<
ANEUT1: WORD NEUT1 < "CM",
ANEUT2: WORD NEUT2 < "CR",
ANEUT3: WORD NEUT3 < "C1",
ANEUT4: WORD NEUT4 < "C2",
ANEUT5: WORD NEUT5 < "MT",
ANEUT6: WORD NEUT6 < "PC",
ANEUT7: WORD NEUT7 < "PN",
ANEUT8: WORD NEUT8 < "PU",
ANEUT9: WORD NEUT9 < "LP",
ANEUTA: WORD NEUTA < "BM",
ANEUTB: WORD NEUTB < "BE".
<
< PILE DE TRAVAIL :
<
KSTORE: DZS 10 < PILE POUR K
PAGE
<***********************************************************************
<* *
<* INITIALISATIONS DU PROGRAMME. *
<* *
<***********************************************************************
PROG
WORD ALTMOD
WORD KSTORE-1
WORD DEBCOM+YY7
WORD DEBLOC+YY7
EDIT: EQU $
LRP K < INITIALISATION DE C ET K,
PLR A,B,C,L,W
LR B,K < DU ALT-MODE
WORD '1EB5
LAI '85 < LA DEMANDE 'LOADA' EST MISE
STBY LOADA < A PRIORI EN 'LOAD-NAME'.
STZ INDED < ON NE SAIT JAMAIS (ALT-MODE...).
<***********************************************************************
<* *
<* RELEVER IDESC. *
<* *
<***********************************************************************
WORD '1E45 < ACTD - IDESC
ORI '30
STBY IDESC
STBY NOMA+2 < MISE A JOUR DU NOM DE L'ASSEMBLEUR
LAD TNOM
BSR DELT < DESTRUCTION A PRIORI DU FICHIER DE
< TRAVAIL...
<***********************************************************************
<* *
<* BATCH OU TIME-SHARING? *
<* *
<***********************************************************************
STZ BATCH
IC BATCH < BATCH=1 A PRIORI (BATCH).
LAD LECVIS < VISU OU CARTE?
SVC 0
LR X,A
CPI '03
JNE PALCIM
DC BATCH < TS : BATCH=-1 ; BATCH : BATCH=0.
<***********************************************************************
<* *
<* PAS DE LECTEUR/IMPRIMANTE. *
<* *
<***********************************************************************
PALCIM: EQU $
LAI NVPO
STBY ECCRLF < RESTAURATION A PRIORI...
LRM A
WORD BUFSOR-ZERO*2+1
STA WRITEO+1
STZ CR1
STZ LP1
<
< INITIALISATION DES EVENTUELLES SIMULATIONS :
<
LB &ALSIM
CPZR B
JLE SIM1 < LA LONGUEUR DES BUFFERS ETANT NEGATIVE
< OU NULLE, ON NE SIMULE PAS...
EORR W,W < POUR BASER LE 'ZERO' DU PROGRAMME.
LA BSIML,W < ADRESSE DU BUFFER DE LECTURE.
SBT 0 < INDEXATION...
STA ASIML < RELAI DU BUFFER DE LECTURE.
LA BSIME,W < ADRESSE DU BUFFER D'ECRITURE.
SBT 0 < INDEXATION...
STA ASIME < RELAI DU BUFFER D'ECRITURE.
LXI 0
LBY &ASIML < ACCES AU 1ER OCTET DU BUFFER DE
< LECTURE,
STA SIMLIM < IL DONNE L'EQUIVALENT DU 'R/C'.
LAI " "
SIM2: EQU $
STBY &ASIME < NETTOYAGE DU BUFFER D'ECRITURE.
ADRI 1,X
ADRI -1,B
CPZR B < EST-CE FINI ???
JG SIM2 < NON...
LRM A
BYTE " ";'0D < (A)=CARTE AU 'CCI' DU TYPE "!GO"...
STA PCLOSE < NEUTRALISATION DE "!CLOSE",
STA &ACLL < DU CLOSE DE 'NVPL',
STA &ACLC < ET DU CLOSE DE 'NVPC'...
LA ADCOM < NEUTRALISATION DES COMMANDES :
STA &ANEUT1 < "CM",
STA &ANEUT2 < "CR",
STA &ANEUT3 < "C1",
STA &ANEUT4 < "C2",
STA &ANEUT5 < "MT",
STA &ANEUT6 < "PC",
STA &ANEUT7 < "PN",
STA &ANEUT8 < "PU",
STA &ANEUT9 < "LP",
STA &ANEUTA < "BM",
STA &ANEUTB < "BE".
SIM1: EQU $
LAD PCLOSE
BSR ASPCCI < "!CLOSE" GENERAL"...
PAGE
<***********************************************************************
<* *
<* RELEVER UNE COMMANDE. *
<* *
<***********************************************************************
COMMAN: EQU $
STZ UTILP < PAS D'UTILISATION DE P A PRIORI
STZ LSRE < PAS RL OU RC A PRIORI
LAI " " < METTRE LA LIGNE A BLANC
LXI -LBUFVI*2
STBY &ADBFEN
JIX $-1
CPZ INDFI < SOUS FI?
JE COMAN1 < NON
BSR EXFI < OUI,LIRE UNE LIGNE FICHIER FI
CPZ ENDFI < FIN DE FICHIER FI?
JE ENTBON < NON
LA CRLF
CP CRLFPL < = + ?
JE COMAN1 < OUI
LA CRLFPL < NON ERREUR
STA CRLF < RESTAURATION DU +
BSR ACLOSE < FERMETURE FICHIERS
LA ACLFI
BSR ASPCCI < FERMETURE FICHIER FI
STZ SSEDIT
STZ CR1
LA ADRFI3
BR MERR
COMAN1: EQU $
LAD ECCRLF
BSR ASPSIM
LAI LBUFVI*2 < LG ENTREE NORMALE
STA LECENT+2
LAD LECENT < LIRE UNE COMMANDE
BSR ASPSIM
JE ENTBON
LAD RETCCI
SVC 0
JMP $-1
ENTBON: EQU $
LA &ABFEN0 < RELEVER LA COMMANDE
LXI NBCOM
REVCOM: EQU $
CP &ALISCO
JE VUCOM
JIX REVCOM
COMERR: EQU $
LA ADRCOM < COMMANDE INEXISTANTE
CPZ INDFI < SOUS FI ?
JE COMER1 < NON
LA ABFEN0 < OUI
LB ADRFI4
ADRI 2,B
LXI 10
MOVE
LA ADRFI4
COMER1: EQU $
BR MERR
VUCOM: EQU $
LYI NBNED <EST-CE UNE COMMANDE AUTORISEE?
CPZ SSEDIT
JNE SOUSED
CPR Y,X
JL COMERR
BR &AADCOM
SOUSED: EQU $
LYI NBSED
CPR Y,X
JGE COMERR
BR &AADCOM
PAGE
<
<
< S I M U L A T I O N E V E N T U E L L E
< D E S L E C T U R E S / E C R I T U R E S
< S U R ' N V P I ' E T ' N V P O ' :
<
<
< ARGUMENTS :
< A=ADRESSE DE LA DEMANDE,
< DIVERSES INFORMATIONS DE SIMULATION...
<
<
SPSIM: EQU $
CP ADEM6D < EST-CE 'DEM6D' ???
JNE SPSIMD < NON...
PSR A
LA WRITEO < OUI, ON
STA DEM6D < REGENERE SON 'NVP' A PRIORI...
PLR A
SPSIMD: EQU $
CPZ &ALSIM < SIMULATION ???
JG ASPSI1 < OUI...
SPSIMC: EQU $
PSR A,B,W
LR A,W < (W)=ADRESSE DE LA DEMANDE COURANTE,
LRM A
BYTE NVPI;'01
CP 0,W < EST-CE UNE ENTREE ???
JNE SPSIMN < NON...
<
< CAS DES ENTREES : CLEAR
< DU BUFFER ARGUMENT :
<
PSR X,Y < SAVE...
LA 1,W < (A)=ADRESSE-OCTET DU BUFFER,
LXI 0
SLRS 1
ADCR X < (X)=INDEX DE CLEAR,
SBT 0
STA ABUFCL < ET GENERATION D'UN RELAI D'ACCES...
LY 2,W < (Y)=DECOMPTEUR DE CLEAR.
LAI " " < (A)=VALEUR DE CLEAR.
SPSIMO: EQU $
STBY &ABUFCL < REMISE A BLANC DU BUFFER,
ADRI 1,X < PASSAGE AU CARACTERE SUIVANT,
ADRI -1,Y
CPZR Y
JG SPSIMO < S'IL EXISTE...
PLR X,Y < RESTAURE...
SPSIMN: EQU $
LRM A
BYTE NVPL;'0A
CP 0,W < EST-CE LA SORTIE 'NVPO' ???
JNE SPSIN1 < NON, RIEN A FAIRE...
LA LP1 < OUI :
TBT 15 < VISU OU AUTRES ???
JNC SPSIN1 < VISU, RIEN A FAIRE...
<
< TRAITEMENT SPECIAL DE LA BENSON :
<
LA &AMTLP < (ON A DEJA TESTE LP1(15))
CP ACU < EST-CE LA BENSON ???
JNE BENS1 < NON, RIEN A FAIRE...
LA 1,W
LB 2,W
PSR A,B < OUI, SAUVEGARDES...
LA 1,W < ON VA S'ECLATER...
LXI 0
SLRS 1
ADCR X < (X)=INDEX D'EMISSION,
LR X,B < (B)=INDEX DU PREMIER CARACTERE...
SBT 0
STA ABENS1 < GENERATION DU RELAI D'EMISSION,
LA 2,W
ADR X,A
STA 2,W < INDEX DE FIN...
LYI 0 < (Y)=INDEX DE RECEPTION.
MOCD:: VAL '00FF < POUR INVERSER LES OCTETS...
BENS2: EQU $
LBY &ABENS1 < (A)=OCTET COURANT,
XR X,Y
CPR Y,B < EST-CE LE PREMIER CARACTERE DU BUFFER ???
JNE BENS3 < NON, DONC LES '6D DOIVENT RESTES
< INCHANGES ("M" MINUSCULE)...
CPI '6D < OUI, ALORS EST-CE "R/C-L/F" ???
JNE BENS3 < NON...
LAI '0D)MOCD < OUI, ON LE CONVERTIT EN UN "R/C",
STA &ABENS2 < QUE L'ON ECLATE,
ADRI 1,X
LAI '0A < PUIS UN "L/F"...
BENS3: EQU $
EORI MOCD < ON INVERSE LES BITS...
STA &ABENS2 < ET ON ECLATE...
ADRI 1,X
XR X,Y
ADRI 1,X
LR X,A
CP 2,W < EST-CE FINI ???
JL BENS2 < NON...
ADR Y,Y
STY 2,W < OUI, ON MODIFIE LE COMPTE D'OCTETS,
LA ABENS2
SLLS 1
STA 1,W < ET L'ADRESSE DU BUFFER...
LR W,A
SVC 0 < EXECUTION DE LA BENSON...
PLR A,B < RESTAURATIONS...
STB 2,W
STA 1,W
PLR A,B,W
JMP SPSIM2 < VERS LE RETOUR DES 'SVC'...
ASPSI1: JMP SPSIM1 < RELAI...
BENS1: EQU $
<
< OPERATION REELLE :
<
SPSIN1: EQU $
PLR A,B,W
SVC 0 < NON, E/S NORMALE...
<
< RETOUR DE SPSIM :
<
SPSIM2: EQU $
CPZ INDED < 'FC' OU 'ED' ???
JE ETI4 < 'ED', RIEN A FAIRE...
PSR A,B,X,W < 'FC',
LR A,W < ALORS, W=ADRESSE DE LA DEMANDE,
LBY 0,W < A='NVP' DE L'ENTREE-SORTIE,
CPI NVPI < EST-CE UN ENTREE ???
JNE ETI5 < NON, UNE SORTIE...
LA 2,W
ADRI 1,A
SLRS 1
LR A,X < X=NOMBRE DE MOTS ENTIERS DU MESSAGE.
LA 1,W
SLRS 1 < A=ADRESSE MOT DU BUFFER,
JC $ < E R R E U R...
CP ABFEN0 < EST-CE LE BUFFER 'CARTE' ???
JE ETI6 < OUI, C'EST BON...
LB ABFEN0 < B=ADRESSE DU RECEPTEUR...
MOVE < LE MESSAGE LU EST MIS DANS 'CARTE'.
ETI6: EQU $
BSR ASPBOX < B=NOMBRE DE CARACTERES ENTRES...
LR B,X
ADRI -2*LBUFVI-1,X < X=INDEX DU DERNIER CARACTERE.
LAD LCHAI1
CPR A,W < EST-CE L'ENTREE 1ERE CHAINE DE 'MD' ???
JE ETI7 < OUI, ON L'INSERE...
LAD LCHAI2
CPR A,W < EST-CE L'ENTREE 2EME CHAINE DE 'MD' ???
JE ETI7 < OUI, ON L'INSERE...
LBY &ADBFEN < A=DERNIER CARACTERE...
CPI '0D < EST-CE UN 'R/C' ???
JNE ETI5 < NON, LE MESSAGE EST IGNORE...
LA &ABFEN0
CP &ACOMMA
JE ETI5 < "MA", ETANT UNE COMMANDE DE SERVICE
< IMMEDIAT N'EST JAMAIS INSEREE !!!
CP &ACOMEB
JE ETI5 < DE MEME "EB",
CP &ACOMAS
JE ETI5 < ET "AS"...
CP &ACMEND
JE ETI7 < LE CODE DE FIN (:F...) EST TOUJOURS PRIS.
LA CRLF < LE CARACTERE D'INVITATION COURANT
CP CRLFSU < EST-IL CELUI DES CARTES ???
JE ETI5 < OUI, PAS D'INSERTION, ELLE
< SERA FAITE PAR LES S/P DE MISE A JOUR.
CP RETOUR
JE ETI5 < IDEM...
ETI7: EQU $
BSR COMP < OUI, ON MET LA
BSR ECRT < COMMANDE DANS LE FICHIER...
ETI5: EQU $
PLR A,B,X,W
ETI4: EQU $
XR A,X
CPI '7D < NE SERAIT-CE PAS EN FAIT UN DOUBLE
< ALT-MODE, SUIVI DE "!D" ET "G" ???
JNE ETI20 < NON...
LAI 0 < OUI, ON FAIT COMME SI TOUT S'ETAIT
< BIEN PASSE...
ETI20: EQU $
XR A,X < RESTAURE 'A' ET 'X'...
CPZR X < TEST DES CONDITIONS DE RETOUR...
RSR
<
< E/S NON SIMULES :
<
SPSIMB: EQU $
PLR A,B,Y,W < A=ADRESSE DE LA DEMANDE.
BR ASPSMC < VERS L'EXECUTION REELLE...
<
< SIMULATIONS :
<
SPSIM1: EQU $
PSR A,B,Y,W
LR A,W < W=ADRESSE DE LA DEMANDE...
LB 2,W < B=NOMBRE D'OCTETS DEMANDES.
LA 1,W
SLRS 1 < ADRESSE MOT DU BUFFER,
SBT 0 < INDEXATION...
STA ABUF < RELAI VERS LE BUFFER REEL.
LXI 0
ADCR X < X=INDEX BUFFER REEL.
LBY 0,W < A=NVP DEMANDE.
CPI NVPO < OUT ???
JE SPSIM3 < C'EST UNE ECRITURE...
<
< SIMULATION D'UNE LECTURE :
<
CPI NVPI < IN ???
JNE SPSIMB < NON, ALORS VRAIE E/S...
LY XSIML < Y=INDEX DU BUFFER DE LECTURE.
SPSIM4: EQU $
LR Y,A < VALIDATION INDEX DE LECTURE...
CP &ALSIM
JGE SPSIM8 < SIMULATION REFUSEE...
XR X,Y
LBY &ASIML < SIMULATION LECTURE...
XR X,Y
STBY &ABUF
ADRI 1,X < PROGRESSION
ADRI 1,Y < DES INDEX.
ADRI -1,B < DECOMPTE DES CARACTERES.
CPI '04 < EST-CE UN VRAI 'EOT' ???
JE SPSIM5 < OUI, ON ARRETE...
CPI '0D < EST-CE UN VRAI 'R/C' ???
JE SPSIM5 < OUI, ON ARRETE LA...
CP SIMLIM < EST-CE L'EQUIVALENT DU 'R/C' ???
JNE SPSIMA < NON...
LAI '0D < OUI, ON LE REMPLACE
ADRI -1,X < PAR
STBY &ABUF < UN VRAI 'R/C',
JMP SPSIM5 < ET ON ARRETE LA...
SPSIMA: EQU $
CPZR B < A-T'ON FINI ???
JG SPSIM4 < NON, ON CONTINUE...
SPSIM5: EQU $
LR Y,A
SB XSIML
STA SIMBOX < NOMBRE DE CARACTERES "LUS"...
STY XSIML < MISE A JOUR DE L'INDEX DE LECTURE.
SPSIM7: EQU $
LXI 0 < AFIN D'ASSURER UN RETOUR OK...
SPSIM9: EQU $
PLR A,B,Y,W
JMP SPSIM2 < ET C'EST FINI...
<
< SIMULATION D'UNE ECRITURE :
<
SPSIM3: EQU $
LY XSIME < Y=INDEX DU BUFFER D'ECRITURE.
SPSIM6: EQU $
LR Y,A < VALIDATION INDEX D'ECRITURE.
CP &ALSIM
JGE SPSIM8 < SIMULATION REFUSEE...
LBY &ABUF < SIMULATION ECRITURE...
XR X,Y
STBY &ASIME
XR X,Y
ADRI 1,X < PROGRESSION
ADRI 1,Y < DES INDEX.
ADRI -1,B < DECOMPTE DES CARACTERES.
CPZR B < EST-CE FINI ???
JG SPSIM6 < NON...
STY XSIME < OUI, ON MET A JOUR L'INDEX D'ECRITURE.
JMP SPSIM7 < ET ON SORT...
<
< ERREURS DE SIMULATIONS :
<
SPSIM8: EQU $
LXI 1 < POUR UN RETOUR EN ERREUR...
JMP SPSIM9
<
<
< E X E C U T I O N D E ' 1 E 3 5 :
<
<
< RESULTAT :
< B=NOMBRE DE CARACTERES LUS.
<
<
SPBOX: EQU $
LB SIMBOX < A PRIORI...
CPZ &ALSIM < SIMULATION ???
JG SPBOX1 < OUI, (B) EST BON...
CPZ INDFI < SOUS 'FI' ???
JNE SPBOX1 < OUI, (B) EST BON...
WORD '1E35 < NON, B <-- (BOXESC).
SPBOX1: EQU $
RSR
PAGE
<***********************************************************************
<* *
<* COMMANDE DELETE FICHIER. *
<* *
<***********************************************************************
DELF: EQU $
LXI -2*LBUFVI+2
BSR RNOM < RELEVER LE NOM DU FICHIER,
LA ANMFID < A=@ DE SON NOM.
BSR DELT < ET DELETE SUR 'NVPBID'.
BR ADCOM < VERS LA COMMANDE SUIVANTE...
PAGE
<***********************************************************************
<* *
<* COMMANDE LECTEUR. *
<* *
<***********************************************************************
IF ORDI-"S",XWOR%,,XWOR%
MTAPE: EQU $
LAI "1"
STBY &AADCR1 < POUR ATTEINDRE 'MT1'...
LA AMT < SELECTION DE "MT"...
JMP READET
READE2: EQU $
LAI "2" < POUR CR2...
JMP READES
XWOR%: VAL 0
READER: EQU $
IF ORDI-"S",XWOR%,,XWOR%
READE1: EQU READER
LAI "1" < POUR CR1...
READES: EQU $
STBY &AADCR1 < CHOIX DU LECTEUR...
LA ACR < SELECTION DE "CR"...
READET: EQU $
STA &AMTCR < SELECTION MT/CR...
XWOR%: VAL 0
LBI 80
JMP LECREA
LECTE: EQU $
LBI 160
LECREA: EQU $
STB LGENT
LA CR1
IBT 15
STA CR1
BR ADCOM
<***********************************************************************
<* *
<* COMMANDE IMPRIMANTE. *
<* *
<***********************************************************************
PRINBE: EQU $
LA ACU
LBI "2"
LYI '0A < FONCTION ECRITURE EN CANAL...
JMP PRINTE < VERS "CU2"...
PRINMT: EQU $
LA AMT
LBI "1"
LYI '02
JMP PRINTE < VERS "MT1"...
PRINLP: EQU $
LA ALP
LBI "1"
LYI '02
PRINTE: EQU $
STA &AMTLP < SELECTION "LP1"/"MT1"...
LR B,A
STBY &AMTLP1
LBY WRITEO < SAUVEGARDE DU 'NVP',
STY WRITEO < MISE EN PLACE DE LA FONCTION,
STBY WRITEO < ET REMISE DU 'NVP'...
STZ LP1
IC LP1
LA ACLL
BSR ASPCCI < CLOSE A PRIORI 'NVPL'...
BR ADCOM
PAGE
IF ORDI-"S",XWOR%,,XWOR%
<
<
< S E L E C T I O N A S C I - E B C D I C :
<
<
MODEA: EQU $
STZ MODE < MODE=0 : ASCI...
BR ADCOM
MODEE: EQU $
STZ MODE
IC MODE < MODE=1 : EBCDIC...
BR ADCOM
XWOR%: VAL 0
PAGE
<
<
< R E T O U R T E M P O R A I R E A U C C I :
<
<
GOCCI: EQU $
LAD RETCCI
SVC 0 < N'OUBLIONS PAS QUE L'ON EST SOUS "*"...
BR ADCOM < VERS LA COMMANDE SUIVANTE...
PAGE
<***********************************************************************
<* *
<* COMMANDE MODIFICATION :F *
<* *
<***********************************************************************
MODFIN: EQU $
LXI -2*LBUFVI+2
MODF01: EQU $
LBY &ADBFEN
CPI "'" < Y-A-T-IL UNE CHAINE ?
JE MODF02 < OUI
JIX MODF01
LA DPF < NON,RESTAURATION DU :F
JMP MODF4
MODF02: EQU $
LXI -2*LBUFVI+2
BSR RNOM < RELEVE CHAINE CARACTERES
LR B,A
CPI 2 < AU MOINS 2 CARACTERES ?
JGE MODF2 < OUI
MODF1: EQU $
LA ADRCOM < NON ERREUR
BR MERR
MODF2: EQU $
LXI NBCOM
LA &ANMFID
MODF3: EQU $
CP &ALISCO < COMMANDE DEJA DEFINIE?
JE MODF1 < OUI ERREUR
JIX MODF3
MODF4: EQU $
STA &ACMEND < SAUVEGARDE CARACTERES DE FIN
BR ADCOM
PAGE
<
<
< M O D I F I C A T I O N N O M B R E D E
< C A R T E S P U N C H E E S ' P C ' :
<
<
MODCA: EQU $
LXI -2*LBUFVI+2-1 < POUR RECHERCHER 'N'.
BSR NOMC < RELEVE DU NOMBRE 'N'.
JALE MODF1 < ERREUR...
STA NUMCA
BR ADCOM < VERS LA COMMANDE SUIVANTE...
PAGE
IF ORDI-"S",XWOR%,,XWOR%
<
< M O D I F I C A T I O N D U C A R A C T E R E J O U A N T
< L E R O L E D E ' A L T - M O D E '.
<
MODALT: EQU $
LXI -2*LBUFVI+2 < POUR RECHERCHER LE CARACTERE.
LBY &ADBFEN < A=CARACTERE ARGUMENT :
CPI "Z" < VALIDATION :
JG MODF1 < ERREUR...
CPI '04 < VIDE ???
JE MODAL2 < OUI : RETABLISSEMENT DU ALT-MODE...
CPI '0D < VIDE ???
JNE MODAL1 < NON...
MODAL2: EQU $
LAI '7D < RETABLISSEMENT DU ALT-MODE...
MODAL1: EQU $
STBY CARALT
WORD '1EA5 < 'A' BITS 8-15 EST LE CARACTERE SERVANT
< DE ALT-MODE.
BR ADCOM < VERS LA COMMANDE SUIVANTE...
PAGE
<
<
< M O D I F I C A T I O N D U C A R A C T E R E J O U A N T
< L E R O L E D E L A C L O C H E :
<
<
CLOCHT: EQU $
LXI -2*LBUFVI+2 < POUR RECHERCHER LE CARACTERE.
LBY &ADBFEN < A=CARACTERE ARGUMENT :
CPI "Z" < VALIDATION :
JG MODF1 < ERREUR...
CPI '04 < VIDE ???
JE CLOCH2 < OUI : RETABLISSEMENT DU CLOCHE...
CPI '0D < VIDE ???
JNE CLOCH1 < NON...
CLOCH2: EQU $
LAI '07 < RETABLISSEMENT DU CLOCHE...
CLOCH1: EQU $
STA CLOCHE
BR ADCOM < VERS LA COMMANDE SUIVANTE...
XWOR%: VAL 0
PAGE
<
< INTRODUCTION DE CARTES "SUITE" DANS LA RECHERCHE DE CHAINES
< DE CARACTERES
<
CSUITE: EQU $
LXI -2*LBUFVI+2 < RECHERCHE DU CARACTERE DE CARTE SUITE
LBY &ADBFEN
CPI '04
JE CSUIT1 < VIDE?
CPI '0D
JE CSUIT1 < VIDE?
CPI "Z" <
JG MODF1 < TEST DE VALIDITE
CPI " " < DU CARACTERE ENTRE
JL MODF1 <
JMP CSUIT2
CSUIT1: EQU $
STZ CARSUI < CARSUI=0 :MODE NORMAL
JMP CSUIT4
CSUIT2: EQU $
STA CARSUI < CHARGEMENT DU CARACTERE
LXI -2*LBUFVI+3-1 < LECTURE DU NUMERO DE COLONNE
BSR NOMC < RELEVE DU NOMBRE
JAL MODF1 < ERREUR
CPI 2*LBUFVI
JG MODF1 < ERREUR
JAG CSUIT3
ADRI 1,A < MISE A 1 SI COLONNE NON SPECIFIEE
CSUIT3: EQU $
ADRI -2*LBUFVI-1,A <
STA COLSUI < CHARGEMENT DU NUMERO DE COLONNE
CSUIT4: EQU $
BR ADCOM < VERS LA COMMANDE SUIVANTE..
PAGE
<
<
< J U S T I F I C A T I O N :
<
<
JUST: EQU $
<
< COMMANDE 'JE' : DEFINIE LE NOMBRE D'ESPACES
< A LAISSER INTACTS AU DEBUT DU MESSAGE :
<
JUSTID: EQU $
LXI -2*LBUFVI+2-1 < POUR RECHERCHER 'N' :
BSR NOMC < NOMBRE 'N'.
JAL MODF1 < ERREUR !!!
CPI 2*LBUFVI
JG MODF1 < ERREUR...
STA JUSTD
BR ADCOM
<
< COMMANDE 'JM' : DEFINIE LE NOMBRE D'ESPACES MANQUANT
< AU DELA DUQUEL ON JUSTIFIE PLUS...
<
JUSTIM: EQU $
LXI -2*LBUFVI+2-1
BSR NOMC < RELEVE DU NOMBRE 'N'.
JAL MODF1 < ERREUR...
CPI 2*LBUFVI
JG MODF1 < ERREUR...
STA JUSTM
BR ADCOM
<
< COMMANDE 'JI' : DEFINIE LE NOMBRE DE CARACTERES
< A NE PAS TESTER EN TETE DU MESSAGE :
<
JUSTIF: EQU $
LXI -2*LBUFVI+2-1
BSR NOMC < RELEVE DU NOMBRE 'N'.
JAL MODF1 < ERREUR...
CPI 2*LBUFVI
JG MODF1 < ERREUR...
ADRI -2*LBUFVI,A < EN FAIT C'EST UN INDEX DE BUFFER.
STA JUSTF
BR ADCOM
<
< COMMANDE 'NJ' : INITIALISE TEL QU'IL N'Y AIT
< PAS DE JUSTIFICATION.
<
JUSTIN: EQU $
LAI 2*LBUFVI
STA JUSTD
STA JUSTM
NGR A,A
STA JUSTF
STZ JUSTP < INITAILISATION A PRIORI DU COMPTEUR
< DE LIGNES PAR PAGE.
BR ADCOM
<
< COMMANDE 'MA' :
<
MARGE: EQU $
LXI -2*LBUFVI+2-1
BSR NOMC
JAL MODF1 < ERREUR...
CPI 2*LBUFVI
JG MODF1 < ERREUR...
ADRI 1,A < POUR LE ">" DE DEBUT DE LIGNE...
MP C108
DV C14
STA BUFG+1 < DANS LE BUFFER
STA BUFG+3 < GRAPHIQUE...
LAD DERASE
BSR ASPSIM < EFFACEMENT DE L'ECRAN.
LAD DOG
BSR ASPSIM < MISE EN GRAPHIQUE.
LAD DWG
BSR ASPSIM < TRACE DE LA MARGE DROITE.
LAD DCG
BSR ASPSIM < RETOUR EN ALPHA-NUMERQUE.
LAD DHOME
BSR ASPSIM < CURSEUR HOME.
LAD DESC
BSR ASPSIM < MISE EN 'ESC;'.
BR ADCOM < COMMANDE SUIVANTE...
<
< COMMANDE 'JP' :
<
JUSTIP: EQU $
LXI -2*LBUFVI+2-1
BSR NOMC
STA JUSTP < NOMBRE DE LIGNES PAR PAGE,
BR ADCOM < VERS LA COMMANDE SUIVANTE.
PAGE
IF ORDI-"S",XWOR%,,XWOR%
<
<
< M O D I F I C A T I O N D E Q U A N T A :
<
<
EXEQ1: EQU $
LRM A,B
WORD YY8*1-2 < QUANTA=1,
WORD YY7*1+SGFOUT,X < QUANTA=1.
EXEQ: EQU $
STA LUTBUF < LONGUEUR DU BUFFER DE SORTIE,
STB ABSGOF < RELAI VERS LE BUFFER DE SORTIE.
BR ADCOM < COMMANDE SUIVANTE...
EXEQ3: EQU $
LRM A,B
WORD YY8*QUANTA-2 < QUANTA=3.
WORD YY7*QUANTA+SGFOUT,X
JMP EXEQ
XWOR%: VAL 0
PAGE
<
<
< E D I T I O N C O M M E N T A I R E :
<
<
EXECOM: EQU $
BSR ASPBOX < B=LONGUEUR DU COMMENTAIRE...
LAD ECCRLF
SVC 0 < ENVOI EN-TETE SANS SIMULATION !!!
STB ECRERR+2 < LONGUEUR DU MESSAGE...
LA LECENT+1
STA ECRERR+1 < ADRESSE DU MESSAGE...
LAD ECRERR
SVC 0 < ENVOI COMMENTAITRE SANS SIMULATION !!!
BR ADCOM < COMMANDE SUIVANTE...
PAGE
<***********************************************************************
<* *
<* COMMANDE D'EXECUTION D'UN FICHIER *
<* *
<***********************************************************************
EXECFI: EQU $
CPZ INDFI < EST-ON DEJA SOUS FI?
JE EXECF1 < NON ON CONTINUE
LA ADRFI2 < OUI ERREUR
BR MERR
EXECF1: EQU $
STZ NCARFI < NOMBRE DE LIGNE LUE = 0
LAI 1
STA INDFI < ON EST SOUS FI
LXI -2*LBUFVI+2
BSR RNOM < RELEVER NOM DE FICHIER
BSR LINM < RELEVER N ET M
LA N
STA NFI < SAUVEGARDE DANS NFI
LA M
STA MFI < SAUVEGARDE DANS MFI
LXI 0
EXECF2: EQU $
LBY &ANMFIC < NOM DE FICHIER DANS NMFICH
STBY &ANOMFX < NOM DE FICHIER DANS NOMFI
ADRI 1,X
LR X,A
CPI 20
JNE EXECF2
BR ADCOM
PAGE
<***********************************************************************
<* *
<* COMMANDE COPY. *
<* *
<***********************************************************************
COPY: EQU $
LAD TNOM < DETRUIRE FICHIER TRAVAIL
BSR DELT
LXI -2*LBUFVI+2 < RELEVER LE NOM DU FICHIER
BSR RNOM
LR X,Y
LA ANMFID < LE SAUVER
LB ANMTID
LXI 10
MOVE
LR Y,X
BSR LINM < RELEVER LA SEQUENCE A COPIER
BSR RNOM < RELEVER LE 2EME NOM
BSR NOMB < NUMERO DE LIGNE OU COPIER
CPZ VATRA1 < SI ABSENT,FIN DE FICHIER
JE COPY1
LA SETFFF
ADRI -1,A
COPY1: EQU $
LR A,W
BSR POSB < POSIT. @ BUFFERS
LA ANMFID < OUVRIR LE 2EME FICHIER
BSR MOVF
BSR OPFX
LAD TNOM < OUVRIR LE FICHIER TRAVAIL
BSR MOVT
BSR OPTN
PSR W < LIRE FICHIER JUSQU'A BONNE LIGNE
BSR RCOP
LA VATRA1 < SAUVEGARDE VARIABLE DE TRAVAIL
STA VATRA2
LA AASSSF < FERMER LE FICHIER
BSR ASPCCI
LA ANMTID < OUVRIR LE 1ER FICHIER
BSR MOVF
BSR OPFO
JNE ERCOP
LA M < NOMBRE DE CARTES A COPIER
SB N
LR A,W
ADRI 1,W
BSR RLIR < LIRE JUSQU'A N
BSR RCOP < COPIER LES CARTES
LA AASSSF < FERMER LE FICHIER
BSR ASPCCI
LA ANMFID < ROUVRIR LE 2EME FICHIER
BSR MOVF
BSR OPFO
JE COPY3
ERCOP: EQU $
BSR ACLOSE < ERREUR - CLOSE PARTIEL
LAD TNOM < DETRUIRE FICHIER TEMPORAIRE
BSR DELT
LA ADRFI
BR MERR
COPY3: EQU $
LA VATRA2 < RESTAURATION VARIABLE DE TRAVAIL
STA VATRA1
PLR A
ADRI 1,A
CPZ VATRA1 < EN RESTE-T-IL?
JNE COPY2
STA N
BSR RLIR
LA SETFFF
LR A,W
BSR RCOP
COPY2: EQU $
IC SSEDIT < FAIRE COMME UNE FIN DE EDIT
BR AFINMD
PAGE
<
<
< E N R E G I S T R E M E N T D E S U P D A T E S
< S U R U N F I C H I E R :
<
<
FICOM: EQU $
STZ INDED
IC INDED < INDED=1 : COMMANDE 'FC'.
JMP ETI1 < PUIS TRAITEMENT IDENTIQUE A 'ED'.
<*****************************************************************
<* *
<* COMMANDE KOMPARER *
<* *
<*****************************************************************
KOMP: EQU $
DC SSEDIT < SSEDIT VAUDRA 2 POUR 'KO',
< ET 1 POUR 'ED'...
< MAIS JUSQU'A CE QUE LA COMMANDE ENTIERE
< AIT ETE ANALYSEE, ON LE MOET A -1 POUR
< "KO" AFIN DE RAZER 'SSEDIT' SUR ERREUR !!
<***********************************************************************
<* *
<* COMMANDE EDITER. *
<* *
<***********************************************************************
EDITER: EQU $
STZ INDED < INDED=0 : COMMANDE 'ED'.
ETI1: EQU $ < TRONC COMMUN 'FC' ET 'ED'.
IF ORDI-"S",XWOR%,,XWOR%
STZ MODE < MODE=0 : ASCI A PRIORI...
XWOR%: VAL 0
LAD TNOM < DETRUIRE LE FICHIER DE TRAVAIL
BSR DELT
LAD TNOM < PLACER SON NOM DANS LES ASSIGN
BSR MOVT
BSR OPTN < L'OUVRIR NEW
LXI -2*LBUFVI+2 < RELEVER LE NOM DU FICHIER
BSR RNOM
STX TRAV1 < POUR LE DEUXIEME NOM DE FICHIER
< SI L'ON EST SOUS 'FC'.
BSR MOVF < LE PLACER DANS LES ASSIGN
BSR OPFX < L'OUVRIR OLD OU NEW
IC SSEDIT < ON EST SOUS EDIT
JG ETI99 < 'ED' OU 'FC'...
IC SSEDIT < 'KO' :
IC SSEDIT < SSEDIT=2.
ETI99: EQU $
LA CRLFET < CARACTERE DE DEMANDE DE COMMANDE
STA CRLF
STZ NOCAR < METTRE NO DE CARTE A 1
IC NOCAR
BSR POSB < POSIT. @ BUFFERS
STZ MODIF
STZ COMNOR
CPZ INDED < 'ED' OU 'FC' ???
JE ETI2 < 'ED'...
<
< CAS DE 'FC' : INSERTION DE "ED 'FICHIER'" :
<
IC TRAV1
LX TRAV1 < TRAV1=INDEX DU DEUXIEME NOM DE FICHIER.
BSR RNOM < RELEVE DU NOM DE FICHIER D'UPDATES A
< CREER, ET MISE DANS 'NMFICH'.
LA ANMFID
LB ANOMTO
LXI 10
MOVE < LE FICHIER D'UPDATES VA SUR NVPBID.
LA AASSOT
BSR ASPCCI < ESSAYONS DE L'OUVRIR EN OLD...
JNE ETI17 < IL N'EXISTE PAS ENCORE, C'EST BON...
BSR ACLOSE < IL EXISTE DEJA, ON NE FAIT RIEN...
STZ SSEDIT < ET ON
STZ INDED < REINITIALISE
LA CRLFPL < TOUT
STA CRLF < LES INDICATEURS...
LA AERRFC
BR MERR < ET UN MESSAGE D'ERREUR...
ETI17: EQU $
LAI " "
ETI13: EQU $
STBY &ADBFEN < ET ON L'EFFACE...
ADRI -1,X
XR A,X
CP TRAV1 < TOUT EFFACE ???
XR A,X
JGE ETI13 < NON...
LA NOMED
STA &ABFEN0 < 'ED' REMPLACE 'FC' DANS LA COMMANDE.
BSR COMP < ON COMPACTE,
BSR ECRT < ET ON ECRIT...
ETI2: EQU $
BR ADCOM
PAGE
<***********************************************************************
<* *
<* COMMANDE LISTER. *
<* *
<***********************************************************************
LISTER: EQU $
STZ LSPF
JMP LSTPCH
<***********************************************************************
<* *
<* COMMANDE RECHERCHE D'UNE CHAINE DE CARACTERES *
<* *
<***********************************************************************
RECHER: EQU $
STZ FIRCAR
DC FIRCAR < MEMORISONS QUE L'ON N'A PAS ENCORE REN-
< CONTRE LA PREMIERE CARTE...
STZ LSRE
IC LSRE
STZ LISNO
IC LISNO
STZ LSPF
JMP NOPUCC
<***********************************************************************
<* *
<* COMMANDE COMPTER CHAINE DE CARACTERES *
<* *
<***********************************************************************
COMPTE: EQU $
STZ NBCHA
LAI 2
STA LSRE
STZ LSPF
JMP NOPUCC
<***********************************************************************
<* *
<* COMMANDE PUNCHER. *
<* *
<***********************************************************************
PUNCHE: EQU $
STZ LSPF
IC LSPF
STZ PUCCOM
<***********************************************************************
<* *
<* LISTE OU PUNCH NUMEROTE OU NON. *
<* *
<***********************************************************************
LSTPCH: EQU $
STZ LSRE
STZ LISNO < NUMEROTATION?
ANDI 'FF
CPI "N"
JNE PASNUM
IC LISNO
PASNUM: EQU $
CPI "C" < PUNCH COMPACTE?
JNE NOPUCC
IC PUCCOM
NOPUCC: EQU $
LXI -2*LBUFVI+2 < RELEVER LE NOM DU FICHIER
BSR RNOM
LR X,Y
BSR MOVF
LR Y,X < RELEVER N ET M S'ILS EXISTENT
BSR LINM
CPZ LSRE
JE PASNZ2
BSR RCAR < RECHERCHE CHAINE CARACTERES
PASNZ2: EQU $
BSR OPFO < OUVRIR LE FICHIER
JE PASNZ3
BSR ACLOSE < CLOSE PARTIEL
LA ADRFI < FICHIER INEXISTANT
BR MERR
PASNZ3: EQU $
LA ABFSGI < INITIALISATION ADRESSE BUFFER
SLLS 1
STA READF+1
CPZ LSPF < LISTE OU PUNCH?
JNE VOIPUN
STZ KJUSTP < INITIALISATION A PRIORI DU
< COMPTEUR DE LIGNES PAR PAGE.
LA LP1 < LISTE - SUR IMPRIMANTE?
TBT 15
JNC PASNZ1
LA AASSLP < OUI - L'ASSIGNER SI POSSIBLE
BSR ASPCCI
JE ASOK1 < OK...
LA &AMTLP
CP AMT < EST-CE "MT1" ???
JNE QADERL < NON...
ASOK1: EQU $
LAI NVPL < NUMERO D'UNITE
STBY WRITEO
JMP PASNZ1
VOIPUN: EQU $
LAI "1" < PUNCH
STBY &AN0CU
LA AASSB < ESSAI DE !ASSIGN B=CU1
BSR ASPCCI
JE ASSICU
LAI "2" < ESSAI DE !ASSIGN B=CU2
STBY &AN0CU
LA AASSB
BSR ASPCCI
JNE QADERL
ASSICU: EQU $
LA ABFSGO < ADRESSE BUFFER
SLLS 1
STA DEMPCH+1
CPZ PUCCOM < PUNCH COMPACTE?
JNE QUNCCO < OUI - LE FAIRE
LAI 4 < NON - ATTENTE
STA SLEEP+2
PASNZ1: EQU $
BSR RLCT < LIRE LE FICHIER JUSQU'A N
JANE FINLIS
IC NOCAR
LA NOCAR
CP N
JL PASNZ1
BSR ININ < INITIALISER LA NUMEROTATION
RELIS: EQU $
BSR DECO < DECOMPACTER
CPZ LSRE < LISTE, PUNCH OU RECHERCHE?
JE LIS3
LA RARGRL
LR A,W < INITIALISATION DE 'W'.
LA MARGRL
STA NARGRL < INITIALISATION DU DECOMPTEUR.
LIS73: EQU $ < ITERATION SUR LES "OR".
STZ SAUVX
LXI -2*LBUFVI-1 < POSITIONNEMENT DEBUT DE CARTE
LIS02: EQU $
STZ NEGATE < "PRESENCE" A PRIORI...
STZ REBM
LB SAUVX < B=NOMBRE DE CHAINES TRAITEES
LIS1: EQU $ < RECHERCHE CHAINE 1
JIX LIS11
CPZ NEGATE < "ABSENCE" ???
JNE LIS3 < OUI, ON LISTE...
LX COLSUI <
LBY &ADBFEN <
CP CARSUI < LA CARTE SUITE SERA LISTEE
JNE LIS82 < SI LA CARTE PRECEDANTE VIENT
LA FLASUI < D'ETRE LISTEE (FLASUI=1).
CPI 1 <
JE LIS4 <
LIS82: EQU $
STZ FLASUI < RAZ SI LA CARTE N'EST PAS UNE CARTE SUITE
DC NARGRL < DECOMPTAGE DES "OR",
JE NWCART < RIEN TROUVE, PASSONS A LA CARTE
< SUIVANTE...
ADRI 2,W < IL RESTE ENCORE AU MOINS UN "OR",
JMP LIS73 < ALLONS L'ESSAYER...
LIS11: EQU $
LBY &ADBFEN
BITPAR:: VAL 8 < BIT DE PARITE...
RBT BITPAR < A PRIORI (CAS DES MINUSCULES)...
LR A,Y < Y=CARACTERE CARTE COURANT.
XR X,B
LBY &XARGRL,W
TBT 8 < "ABSENCE" ???
JNC LIS81 < "PRESENCE"...
RBT 8 < RAZ DU DISCRIMINATEUR SI "ABSENCE"...
IC NEGATE < ET MISE EN PLACE INDICATEUR.
LIS81: EQU $
CPI "_"
JE LIS2
CPR A,Y < CARAC CARTE=CARAC CHAINE I?
JE LIS2 < OUI
LX SAUVX < NON,REPOSITIONNEMENT DEBUT CHAINE I
XR X,B
LR X,A
SB REBM
LR A,X < RESTAURATION X
STZ REBM
JMP LIS1
LIS2: EQU $
IC REBM
ADRI 1,X
LBY &XARGRL,W < A=CARAC SUIVANT CHAINE I
XR X,B
CPI '04 < FIN DE CHAINE I ?
JNE LIS1
CPZ NEGATE < "ABSENCE" ???
JNE LIS82 < OUI, "OR" SUIVANT SI LA CHAINE
< EST PRESENTE...
LA SAUVX
ADRI NCARCH,A < NOMBRE DE CHAINES TRAITEES + 1
CP NCHRL,W < = NOMBRE DE CHAINES TOTAL?
JE LIS3 < OUI,LISTER LA CARTE
STA SAUVX
JMP LIS02
LIS3: EQU $
IC NBCHA < COMPTAGE
LA LSRE < PAS DE LISTE SI COMPTAGE
CPI 2
JE NWCART
CPI 1
JE LIS4
CPZ LSPF < LISTE OU PUNCH
JNE CESPUN
LIS4: EQU $
LA LSRE <
CPI 1 < CS QUE POUR RL
JNE CSLIST
LA CARSUI < DOIT-ON TENIR COMPTE DES CARTES SUITE?
JAE CSLIST < NON
LX COLSUI < LA CARTE LUE EST-ELLE UNE
CPBY &ADBFEN < CARTE SUITE ?
JNE CSLIST
LA FLASUI < N'EDITER QUE LES CARTES SUITE QUI SONT LA
CPI 1 < SUITE DE LA CARTE PRECEDANTE (FLASUI=1)
JNE NWCART
CSLIST: EQU $
BSR LIST < LISTAGE DE LA CARTE 'NOCAR'...
LA NOCAR < (A)=NUMERO DE LA CARTE COURANTE,
STA LASCAR < C'EST PROVISOIREMENT LA DERNIERE
< RENCONTREE.
CPZ FIRCAR < Y-A-T'IL UNE PREMIERE CARTE ???
JGE LIS90 < OUI...
STA FIRCAR < NON, C'EST DONC ELLE LA PREMIERE...
LIS90: EQU $
LA LSRE
CPI 1
JNE NWCART
STA FLASUI < FLASUI=1 SI LA CARTE A ETE LISTEE PAR RL
JMP NWCART
JMP NWCART
QUNCCO: JMP PUNCCO < RELAI...
QADERL: JMP PADERL < RELAI...
CESPUN: EQU $
LXI -40 < DEPLACEMENT DANS LA ZONE
LAD &ABINPC < DE PUNCH
LR A,B
LXI -LBUFVI
LAD &ADBFEN
LXI 40
MOVE
BSR PERF
NWCART: EQU $ < CARTE SUIVANTE
LA NOCAR < EST-ON RENDU A M?
CP M
JGE FINLIS
BSR INCN < INCREMENTER LA NUMEROTATION
IC NOCAR
BSR RLCT < RELIRE
JAE RELIS
FINLIS: EQU $
CPZ LSPF < LISTE?
JNE PADERL
LAI 2 < ECRIRE LA DERNIERE LIGNE
STA WRITEO+2
LAI '0D < METTRE UN R/C
SLLS 8
STA &ABFSO1
LAD WRITEO
BSR ASPSIM
LAI NVPO
STBY WRITEO
PADERL: EQU $
LA LSRE
CPI 2 < SI RC,EDITION DE NBCHA
JNE LIS6
LXI 3
LB NBCHA < CODAGE NBCHA POUR EDITION
LIS5: EQU $
LAI 0
DV DIX
ADRI '30,B
XR A,B
STBY &ARC2 < &ARC2 NOMBRE EDITABLE
JDX LIS5
XR A,B
ADRI '30,A
STBY &ARC2
LA ARC2 < TRANSMISSION NBCHA POUR EDITION
RBT 0
LB ADRRC1
ADRI 10,B
LXI 2
MOVE
BSR ACLOSE
IC LSRE < LSRE=3 (POUR MERR)
LA ADRRC1
BR MERR < EDITION NBCHA
LIS6: EQU $
STZ FLASUI < RAZ EN FIN DE RL
LA ACLF < CLOSE PARTIEL :
BSR ASPCCI
LA ACLT
BSR ASPCCI
LA ACLB
BSR ASPCCI
LA &AMTLP
CP AMT < EST-CE "MT1" ???
JE LIS6X < OUI, PAS DE CLOSE...
LA ACLL
BSR ASPCCI
JMP LIS7X
LIS6X: EQU $
LAD TAPEMK
SVC 0 < ET ON ENVOIE UN "TAPE-MARK"...
LIS7X: EQU $
BR ADCOM
PAGE
<***********************************************************************
<* *
<* PUNCH DE CARTES EN COMPACTE. *
<* *
<***********************************************************************
PUNCCO: EQU $
STZ PUCCOM < PUNCH EFFECTIF
LA CRLFSU < POUR LECTURE COMMANDE PUNCH
STA CRLF
LAI 3 < ATTENTE
STA SLEEP+2
LYI -76 < INDEX OUT
LXI 0 < INDEX IN
STZ NOCCP < NUMEROTATION=0
AUTCB1: EQU $
BSR LECB < LIRE UN BYTE
JANE FINLC1
PSR B
AUTCB2: EQU $
BSR LECB < LIRE UN DEUXIEME BYTE
JANE FINLC2
LR B,A < EST-CE 'FX
CPI 'F0
JL PAFIF1
PLR A < OUI - METTRE UN NULL
SLLS 8
PSR B
BSR NMPC
PLR A
SLLS 4 < LE PLACER
BSR NMPC
JMP AUTCB1
PAFIF1: EQU $
PLR A < CALCUL PREMIER MOT
SLLD 8
SLRS 8
SLLD 4
SLLS 4
PSR B < LIRE TROISIEME BYTE
BSR NMPC
BSR LECB
JANE FINLC3
LR B,A < EST-CE 'XF?
ANDI 'F
CPI '0F
JE PAFIF3
LR B,A < OU REPETITION ET FIN DE CARTE
CPI '80+80
JL PAFIF2
LR Y,A
CPI -1
JNE PAFIF2
PAFIF3: EQU $
PLR A < OUI METTRE UN NNULL
PSR B
BSR NMPC
JMP AUTCB2
PAFIF2: EQU $
PLR A < CALCUL DEUXIEME MOT
SLRS 12
SLLD 8
SLRS 8
SLLD 12
BSR NMPC
JMP AUTCB1
FINLC1: EQU $
LAI 'FF < PLACER 'FF00
SLLS 8
LR Y,X < OBLIGER LE PUNCH
STA &ABINEN
LAI 0 < RESTE DE LA CARTE A ZERO
ADRI 1,X
STA &ABINEN
JIX $-1
BSR PUPC
LXI -80 < PUNCH DE ":F"
LA DEUXPT
STA &ABINEF
ADRI 1,X
LA CARACF
STA &ABINEF
ADRI 1,X
STZ &ABINEF
JIX $-1
BSR PUPU
LA CRLFPL
STA CRLF
BSR ACLOSE < CLOSE PARTIEL
BR ADCOM
FINLC2: EQU $
PLR A < PLACER 'XX00,'0000,'FF00
SLLS 8
BSR NMPC
LAI 0
BSR NMPC
JMP FINLC1
FINLC3: EQU $
PLR A < PLACER 'X000,'FF00
BSR NMPC
JMP FINLC1
PAGE
<***********************************************************************
<* *
<* COMMANDE SUPPRIMER. *
<* *
<***********************************************************************
SUPPRI: EQU $
LXI -2*LBUFVI+1
IC MODIF < MODIF=1
BSR RELN < RELEVE N
BSR RELM < RELEVE M
BSR SUNM < SUPPRESSION DE N A M
BR ADCOM
PAGE
<***********************************************************************
<* *
<* COMMANDE MODIFIER. *
<* *
<* ATTENTION: SOUS FI,SI ON VEUT INCLURE DES BLANCS EN FIN DE *
<* CH1 OU CH2,ON LES REMPLACE PAR DES SHIFT O. *
<* *
<***********************************************************************
MODIFI: EQU $
LA &ABFEN0
STZ LSRE < SI ME,LSRE=0
ANDI 'FF
CPI "D"
JE MOD01
JMP MOD02
MOD01: EQU $
IC LSRE < SI MD,LSRE=1
MOD02: EQU $
LXI -2*LBUFVI+1
IC MODIF < MODIF=1
BSR RELN < RELEVE N
BSR RELM < RELEVE M
LBY &ABFEN0
CPI "M" < ETAIT-CE "ME"/"MD" ???
JNE MOD61 < NON, ON GARDE DONC LES 2 CHAINES
< COURANTES...
CPZ INDFI < EST-ON SOUS FI?
JE MOD03 < NON
BSR EXFI < OUI,LIRE UNE CARTE
CPZ ENDFI < FIN DU FICHIER FI?
JE MOD021 < NON
LA ADRFI3 < OUI,ERREUR
BR MERR
MOD021: EQU $
LXI -2*LBUFVI-1
LY VATRA2 < Y = LONGUEUR CHAINE1
LBI 0
MOD04: EQU $
ADRI 1,X
LBY &ADBFEN < TRANSFERT DE LA CHAINE1
XR X,B
STBY &XCHAI1 < DANS LA ZONE ADEQUATE
CPR Y,X
JE MOD05
ADRI 1,X
XR X,B
CPI '0D < ETAIT-CE UN 'R/C' ???
JNE MOD04 < NON, AU CARACTERE SUIVANT...
STB VATRA2 < OUI, ON ARRETE SUR LUI...
MOD05: EQU $
LB VATRA2 < B = LONGUEUR CHAINE1
JMP MOD06
MOD03: EQU $
LA ACHAI1
BSR APRINT
LAD LCHAI1
BSR ASPSIM < ENTREE DE LA PREMIERE CHAINE.
BSR ASPBOX < B=NOMBRE DE CARACTERES ENTRES.
MOD06: EQU $
STB LLCH1 < LONGUEUR DE LA CHAINE 1.
LR B,A
CPI 1 < EST-ELLE = 1 ???
JG MOD60 < NON...
LXI 0 < OUI
LBY &XCHAI1
CPI '04 < EST-CE UNEOT
JE MOD07 < OUI,ERREUR
CPI " " < EST-CE UN BLANC
JNE MOD60 < NON,OK
MOD07: EQU $
LA ADRFE < OUI,
BR MERR < ERREUR...
MOD60: EQU $
LR B,X
ADRI -1,X
LBY &XCHAI1 < DERNIER CARACTERE,
CPI '0D < EST-CE UN RETURN ???
JNE MOD62 < NON...
LAI '04 < OUI, ON LE
STBY &XCHAI1 < REMPLACE PAR UN 'EOT'.
MOD62: EQU $
LBY &XCHAI1
CPI '04 < EST-CE UN 'EOT' ???
JNE MOD63 < NON...
DC LLCH1 < OUI, ON DECREMENTE LA LONGUEUR.
MOD63: EQU $
CPZ INDFI < EST-ON SOUS FI?
JE MOD630 < NON
BSR EXFI < OUI
CPZ ENDFI < FIN DE FICHIER FI?
JE MOD634 < NON
LA ADRFI3 < OUI,ERREUR
BR MERR
MOD634: EQU $
LXI -2*LBUFVI-1
LY VATRA2 < Y = LONGUEUR CHAINE2
LBI 0
MOD631: EQU $
ADRI 1,X
LBY &ADBFEN < TRANSFERT DE LA CHAINE2
XR X,B
STBY &XCHAI2 < DANS LA ZONE ADEQUATE
CPR Y,X
JE MOD632
ADRI 1,X
XR X,B
CPI '0D < ETAIT-CE UN 'R/C' ???
JNE MOD631 < NON, AU CARACTERE SUIVANT...
STB VATRA2 < OUI, ON ARRETE SUR LUI...
MOD632: EQU $
LB VATRA2 < B = LONGUEUR CHAINE2
JMP MOD633
MOD630: EQU $
LA ACHAI2
BSR APRINT
LAD LCHAI2
BSR ASPSIM < ENTREE DE LA DEUXIEME CHAINE.
BSR ASPBOX < B=NOMBRE DE CARACTERES ENTRES.
MOD633: EQU $
STB LLCH2
LR B,X
ADRI -1,X
LBY &XCHAI2 < DERNIER CARACTERE,
CPI '0D < EST-CE UN RETURN ???
JNE MOD64 < NON...
LAI '04 < OUI, ON LE
STBY &XCHAI2 < REMPLACE PAR UN 'EOT'...
MOD64: EQU $
LBY &XCHAI2
CPI '04 < EST-CE UN 'EOT' ???
JNE MOD65 < NON...
DC LLCH2 < OUI, ON DECREMENTE LA LONGUEUR.
MOD65: EQU $
MOD61: EQU $
CPZ LSRE
JNE MOD2
LA LLCH1
CP LLCH2
JLE MOD2
LX LLCH2
MOD1: EQU $ <ALLONGEMENT CHAINE 2
LAI " "
STBY &XCHAI2
ADRI 1,X
LR X,A
CP LLCH1
JL MOD1
LAI '04
STBY &XCHAI2
MOD2: EQU $
BSR RECN < RECOPIE JUSQU'A N
MOD3: EQU $
BSR RLCT < LECTURE
JANE MOD5
BSR DECO < DECOMPACTAGE
STZ REBM
LBI 0
LXI -2*LBUFVI-1
MOD31: EQU $ < RECHERCHE CHAINE 1
JIX MOD32
JMP MOD4 < FIN DE LA CARTE
MOD32: EQU $
LBY &ADBFEN
RBT BITPAR < CAS DES MINUSCULES...
XR X,B
CPBY &XCHAI1
JE MOD33 < CARAC CARTE = CARAC CHAINE 1
LXI 0
XR X,B
LA REBM < RESTAURATION X
SBR A,X
STZ REBM
JMP MOD31
MOD33: EQU $
IC REBM
ADRI 1,X
LA LLCH1
CP REBM < FIN DE CHAINE 1 ?
XR X,B
JE MOD34
JMP MOD31
MOD34: EQU $
CPZ LSRE < SI ME,MOD349
JE MOD349
LA LLCH2 < CALCUL DIFFERENCE CHAINES
SB LLCH1
LR A,B < DIFFERENCE DANS B
LR X,Y
JAE MOD348 < DIFFERENCE =0
JAL MOD345
LXI 0 < CAS OU LLCH2> LLCH1
MOD341: EQU $
ADRI -1,X
CPR Y,X < IL NE FAUT PAS QUE L'ON REVIENNE PLUS
< EN ARRIERE (X) DANS LE BUFFER QUE LA
< DERNIERE COINCIDENCE (Y) QUE L'ON A
< TROUVE, ET CE A CAUSE DES CHAINES
< NE CONTENANT QUE DES " ", QUE L'ON NE
< PEUT DISTINGUER DES " " QUE L'ON TESTE
< QUAND ON CHERCHE LE DERNIER CARACTERE
< NON " " DU BUFFER...
JLE MOD34A < ON ARRETE SI (X)<=(Y)...
LBY &ADBFEN < RECHERCHE DERNIER
CPI " " < CARACTERE # BLANC
JE MOD341
MOD34A: EQU $
LR X,A
ADR B,A
JALE MOD342
NGR B,X < PERTE DES (B+X) DERNIERS CARACTERES
MOD342: EQU $
LBY &ADBFEN < DECALAGE DE B CARACTERES
ADR B,X < A DROITE
STBY &ADBFEN
SBR B,X
ADRI -1,X
CPR X,Y
JGE MOD348
JMP MOD342
MOD345: EQU $ < CAS OU LLCH2< LLCH1
ADRI 1,X
MOD346: EQU $ < DECALAGE DE B CARACTERES
LBY &ADBFEN < A GAUCHE
CPZR X < EST-ON EN BOUT DE CARTE ???
JL MOD343 < NON...
LAI " " < OUI, ON RAJOUTE DES 'SPACE'...
MOD343: EQU $
ADR B,X
STBY &ADBFEN
SBR B,X
JIX MOD346
ADR B,X
LA BLANC
MOD347: EQU $ < MISE A BLANC DE LA FIN DE LA
STBY &ADBFEN < CARTE (CARACTERES B A -1)
JIX MOD347
MOD348: EQU $
LR Y,X
MOD349: EQU $
DC REBM < REMISE X VALEUR DEBUT
LA REBM < DE LA CHAINE 1
SBR A,X
LBI 0
STZ REBM
MOD35: EQU $
XR X,B < MODIFICATION DE LA CHAINE 1
IC REBM
LA LLCH2
CP REBM
LBY &XCHAI2
JGE MOD36
XR X,B < FIN MODIFICATION
ADRI -1,X
LBI 0
STZ REBM
JMP MOD31 < RECHERCHE CHAINE 1
MOD36: EQU $
ADRI 1,X
XR X,B
STBY &ADBFEN < ECRITURE CHAINE 2
JIX MOD35
MOD4: EQU $
CPZ INDED < 'ED' OU 'FC' ???
JNE ETI3 < 'FC' : PAS D'ECRITURE FICHIER...
BSR COMP < COMPACTAGE
BSR ECRT < ECRITURE
ETI3: EQU $
IC NOCAR
LA NOCAR
CP M < DEPASSE M ?
JLE MOD3 < NON
MOD5: EQU $
BR ADCOM
PAGE
<***********************************************************************
<* *
<* COMMANDE REMPLACER. *
<* *
<***********************************************************************
REMPLA: EQU $
LXI -2*LBUFVI+1
IC MODIF < MODIF=1
BSR RELN < RELEVE N
BSR RELM < RELEVE M
STZ UTILP < DOIT-ON UTILISER P?
CPZ BATCH < PAS EN BATCH
JNE REMPL2
ADRI -1,X < LE RELEVER
BSR NOMC
JAE REMPL2 < SI = 0,NE RIEN FAIRE
CPI 81
JLE REMPL1 < SI > 81,LE RAMENER
LAI 81 < A CETTE VALEUR
REMPL1: EQU $
STA P < LE STORER
IC UTILP < DIRE QU'ON L'UTILISE
STZ LISNO < SANS NUMEROTATION
BSR RECN < LIRE JUSQU'A N
JMP REMPL3
REMPL2: EQU $
BSR SUNM < SUPPRESSION DE N A M
REMPL3: EQU $
BSR AJOU < AJOUTER
BR ADCOM
PAGE
<***********************************************************************
<* *
<* COMMANDE REMPLACER-REECRIRE *
<* *
<***********************************************************************
REMINS: EQU $
CPZ INDFI < EST-ON SOUS 'FI' ???
JNE REMPLA < OUI, ALORS 'RR'=='RE'...
STZ LISNO
LXI -2*LBUFVI+1
IC MODIF
BSR RELN < RELEVE N
BSR RELM < RELEVE M
BSR RECN < RECOPIE JUSQU'A N
LA RETOUR
STA CRLF
REM1: EQU $
BSR RLCT < LECTURE
JAE REM01
LA CRLFET
STA CRLF
LA ADRSEQ
BR MERR
REM01: EQU $
BSR DECO < DECOMPACTAGE
BSR DEP < TRAITEMENT MODIFICATIONS
BSR COMP < COMPACTAGE
BSR ECRT < ECRITURE
IC NOCAR
LA NOCAR
CP M
JLE REM1
LA CRLFET
STA CRLF
CPZ INDED < 'EC' OU 'FC' ???
JE ETI9 < 'ED'...
LXI -2*LBUFVI < 'FC' : DANS CE CAS,
LAI " " < ON MET LA CARTE
ETI10: EQU $
STBY &ADBFEN < A BLANC,
JIX ETI10
LA &ACMEND < ET ON MET L'EQUIVALENT
STA &ABFEN0 < DE ":F" EN TETE...
BSR COMP < ET DANS
BSR ECRT < LE FICHIER...
ETI9: EQU $
BR ADCOM
PAGE
<***********************************************************************
<* *
<* COMMANDE INSERER. *
<* *
<***********************************************************************
INSERE: EQU $
LXI -2*LBUFVI+1
IC MODIF < MODIF=1
BSR RE1N < RELEVER N
BSR RECN < RECOPIE JUSQU'A N
BSR AJOU < AJOUTER
BR ADCOM
PAGE
<
<
< I N S E R T I O N E N F I N D E F I C H I E R :
<
<
IFSERE: EQU $
LXI -2*LBUFVI+1
STX N < N<0 POUR LA FIN DE FICHIER.
IC MODIF
BSR RECN < POSITIONNEMENT EN FIN DE FICHIER.
BSR AJOU < AJOUT...
BR ADCOM < VERS LA COMMANDE SUIVANTE.
PAGE
<***********************************************************************
<* *
<* COMMANDE COMPACTE. *
<* *
<***********************************************************************
COMPAC: EQU $
IC COMNOR
BR ADCOM
<***********************************************************************
<* *
<* COMMANDE NORMAL. *
<* *
<***********************************************************************
NORMAL: EQU $
STZ COMNOR
BR ADCOM
PAGE
<***********************************************************************
<* *
<* COMMANDE FIN. *
<* *
<***********************************************************************
FIN: EQU $
CPZ SSEDIT < FIN DE EDIT?
JE VRAIF2
CPZ MODIF < Y-A-T'IL EU MODIFICATIONS
JE ALTMO1 < SIMULER UN ALT-MODE
LIREFF: EQU $
LA SSEDIT
CPI 2
JE FINMOD < PAS DE RECOPIE POUR 'KO'...
CPZ INDED < EST-ON SOUS 'FC' ???
JNE FINMOD < OUI, PAS DE RECOPIE...
BSR RLCT < OUI - FINIR LA RECOPIE
JANE FINMOD
BSR ECRT
JMP LIREFF
FINMOD: EQU $
LA PLACT < METTRE INDIC FIN SECTEUR
CP LUTBUF < SI NON VIDE
JE PASDRB
NGR A,X
LAI 'FF
STBY &ABSGOF
BSR AWRITE < ECRITURE SGF.
<***********************************************************************
<* *
<* RECOPIE DE NVPT SUR NVPF. *
<* *
<***********************************************************************
PASDRB: EQU $
LA SSEDIT
CPI 2
JE KOMP1 < VERS LA COMPARAISON DE 'KO'...
LAI '1F < CHANGER LE ALT-MODE (CTRL-SHIFT-O).
WORD '1EA5
LA AASSSF < CLOSE NVPF
BSR ASPCCI
CPZ INDED < EST-ON SOUS 'FC' ???
JNE ETI11 < OUI, ON NE DETRUIT PAS 'NVPF'...
LA ANOMFO < LE DETRUIRE
BSR DELT
ETI11: EQU $
IF ORDI-"S",PASDR1,,PASDR1
LAI NSPETA
SBT 0
WORD '1E15
LR B,A
WORD '1E15
TBT 16+OTODLN < SI LE BIT OTODLN EST A 1
JC PASDR1 < CHANGEMENT DE NOM
LA ACLT < SINON RECOPIER LE FICHIER DE
BSR ASPCCI < TRAVAIL SUR LE FICHIER
LA ABFSGI < POSITIONNEMENT @ BUFFER
SLLS 1
STA READF+1
STA WRITET+1
LA ANOMFO < OPEN NEW FICHIER
CPZ INDED < EST-ON SOUS 'ED' OU 'FC' ???
JE ETI16 < 'ED'...
LA ANMFID < 'FC' :
BSR DELT < ON VA DETRUIRE LE FICHIER D'UPDATES...
LA ANMFID < PUIS, L'OUVRIR EN NEW...
ETI16: EQU $
BSR MOVF
BSR OPFN
BSR OPTO < OPEN OLD FICHIER DE TRAVAIL
LAI NVPT
STBY READF < LECTURE SUR NVPT
LAI NVPF
STBY WRITET < ECRITURE SUR NVPF
PASDR4: EQU $ < RECOPIE DE NVPT SUR NVPF
LAD READF
SVC 0 < LECTURE NVPT
JNE PASDR3
CPZ &ABFSGI
JL PASDR3
BSR AWRITE < ECRITURE SGF.
JMP PASDR4
PASDR3: EQU $
LAI NVPF
STBY READF < RESTAURATION LECTURE SUR NVPF
LAI NVPT
STBY WRITET < RESTAURATION ECRITURE SUR NVPT
LA ACLF
BSR ASPCCI
LAD TNOM
BSR DELT
JMP PASDR2
PASDR1: EQU $
LA ANOMFO < CHANGER LE NOM
CPZ INDED < EST-ON SOUS 'FC' ???
JE ETI12 < NON, 'ED' LE NOM EST CELUI DU
< FICHIER EDITE : "ED'N1'"...
LA ANMFID < OUI, 'FC' LE NOM EST CELUI DU
< FICHIER D'UPDATES' : "FC'N1''N2'"...
BSR DELT < QUE L'ON DELETE D'ABORD...
LA ANMFID < ET RESTAURE (A)...
ETI12: EQU $
LB ABUFNM
LXI 10
MOVE
LAD DEMCOP
SVC 0
LA ANOMTN < DETRUIRE L'ANCIEN
LB ANOMTO
LXI 10
MOVE
LAD DEMDFT
SVC 0
PASDR2: EQU $
BSR ACLOSE < CLOSE PARTIEL
LBY CARALT < RESTAURER LE ALT-MODE
WORD '1EA5
PAGE
<***********************************************************************
<* *
<* FIN DU EDIT *
<* *
<***********************************************************************
FINED: EQU $
STZ INDED < REINITIALISATION...
LA CRLFPL < REINITIALISATION
STA CRLF
STZ SSEDIT
STZ CR1
BR ADCOM
VRAIF2: JMP VRAIFI
ALTMO1: JMP ALTMOD
<
<
< C O M P A R A I S O N D U F I C H I E R
< A R G U M E N T E T D U F I C H I E R
< D E T R A V A I L :
<
<
KOMP1: EQU $
BSR ACLOSE < ON FERME TOUT...
LAD TNOM
LB ANOMOT
LXI 10
MOVE < NOM DU FICHIER DE TRAVAIL.
LA AASSTO
BSR ASPCCI < OUVERTURE OLD DU FICHIER DE TRAVAIL.
LAD OPENOT
SVC 0 < OUVERTURE DE LA CLEF 2.0.
LX LUTBUF
NGR X
LAI 'FF
STBY &ABSGOF < INITIALISATION DU BUFFER.
LA ANMFID
BSR MOVF < PREPARATION NOM ARGUMENT.
BSR OPFO < OUVERTURE OLD DU FICHIER ARGUMENT.
<
< COMPARAISON DES 2 FICHIERS :
<
KOMP5: EQU $
LAD READF
SVC 0 < LECTURE FICHIER ARGUMENT.
JNE KOMP2 < FIN...
CPZ &ABFSGI
JL KOMP2 < FIN...
LAD READOT
SVC 0 < LECTURE FICHIER DE TRAVAIL.
JNE KOMP3 < FIN, DONC DIFFERENTS...
CPZ &ABFSGO
JL KOMP3 < FIN, DONC DIFFERENTS...
LX LUTBUF
NGR X
LYI 0 < 2 INDEXES.
KOMP4: EQU $
LBY &ABSGOF
XR X,Y
CPBY &ABSGII < ALORS ???
XR X,Y
JNE KOMP3 < DIFFERENTS...
CPI 'FF
JE KOMP5 < FIN DE SECTEUR, AU SUIVANT...
ADRI 1,Y < CARACTERES
JIX KOMP4 < SUIVANTS...
KOMP2: EQU $
LAD READOT
SVC 0 < FICHIER DE TRAVAIL...
JNE KOMP6 < FIN, DONC IDENTIQUES...
CPZ &ABFSGO
JL KOMP6 < FIN, DONC IDENTIQUES...
<
< FICHIERS DIFFERENTS :
<
KOMP3: EQU $
LA AMK2 < A=ADRESSE MESSAGE.
JMP KOMP7 < ENVOI DU MESSAGE.
<
< FICHIERS IDENTIQUES :
<
KOMP6: EQU $
LA AMK1 < A=ADRESSE MESSAGE.
<
< ENVOI DU MESSAGE :
<
KOMP7: EQU $
LR A,W
ADR A,A
ADRI 1,A
STA ECRERR+1 < ADRESSE OCTET DU MESSAGE.
LBY 0,W
STA ECRERR+2 < LONGUEUR DU MESSAGE.
LAD ECRERR
SVC 0 < ENVOI DU MESSAGE.
BSR ACLOSE < ON FERME TOUT...
LAD TNOM
BSR DELT < ON DELETE LE FICHIER DE TRAVAIL...
JMP FINED < ET C'EST FINI...
<***********************************************************************
<* *
<* ALT-MODE. *
<* *
<***********************************************************************
ALTMOD: EQU $
LAD KSTORE-1 < REINITIALISATION
LR A,K
LA &ALSIM < MAIS NE SEAIT-CE PAS UN DOUBLE ALT-MODE ?
CP SVCSVC < SI OUI, (0)='SVC 0'...
JNE ETI14 < NON, ALT-MODE SIMPLE...
ETI15: EQU $
LAD RETCCI < ET OUI,
SVC 0 < RETOUR AU CCI
JMP ETI15 < DEFINITIF !!!
ETI14: EQU $
IF ORDI-"S",XWOR%,,XWOR%
LA XASSO
STA &AMASSD < A CAUSE DES ALT-MODES MALHEUREUX...
XWOR%: VAL 0
LAI NVPI
STBY LECENT
STBY LECCOM
LAI '02
STA WRITEO < REMISE DE L'ECRITURE NORMALE...
< (A CAUSE DE LA BENSON...)
LAI NVPO
STBY WRITEO
STBY ECCRLF
LRM A,B
WORD BUFSOR-ZERO*2+1
BYTE NVPI;'01
STA WRITEO+1
STB LECENT < LECTURE AVEC ECHO...
LAD PCLOSE
BSR ASPCCI
STZ LP1
LAD TNOM
BSR DELT < DELETE FICHIER DE TRAVAIL
JMP FINED
<***********************************************************************
<* *
<* TRAITEMENT DU FICHIER SUIVANT. *
<* *
<***********************************************************************
VRAIFI: EQU $
CPZ INDFI < EST-ON SOUS FI?
JE VRAIF1 < NON
STZ INDFI < OUI,CE N'EST PAS LA VRAI FIN
LA ACLFI < CLOSE FICHIER FI
BSR ASPCCI
BR ADCOM
VRAIF1: EQU $
STZ LP1
LAD TNOM
BSR DELT < DESTRUCTION DU FICHIER DE TRAVAIL...
LA &ALAI
CP RSRRSR < DOIT-ON RETOURNER A 'ASSYS' ???
JE KOMP11 < OUI...
LAI '83 < NON, PROFITONS-EN POUR
STBY LOADA < DETRUIRE LE NOM 'ASSYS'<IDESC>...
LAI 1
STA &ACCCI
LA LAILAI
STA &AJNE < A LA SUITE DU 'SVC' D'APPEL
LA SVCSVC
STA &ALAI < DE L'OVERLAY, ON MET UN RETOUR
LA RSRRSR
STA &ASVC < AU CCI, ET UN ENTRY 'EDITS'.
KOMP11: EQU $
LBI DITEM
LAD NOMA
LXI 3
MOVE < MISE EN PLACE DE 'ASSY'<IDESC>.
LAI 2
LR A,K < MISE EN PLACE D'UNE PILE
< SPECIALE OVERLAY...
LAI DEBUT-ZERO
WORD '1EB5 < RESTAURATION DU 'PRESC'.
PSR A < EMPILEMENT (POUR RSR) DE L'ENTRY
< DANS L'ASSEMBLEUR.
LAD LOADA < A=@DEMANDE DE RAPPEL ASSEMBLEUR.
BR ALOAD < RETOUR A L'ASSEMBLEUR...
<***********************************************************************
<* *
<* CLOSE NVPC/NVPL/NVPF/NVPT. *
<* *
<***********************************************************************
CLOSE: EQU $
PSR A,X
LA ACLL
BSR ASPCCI < CLOSE NVPL.
LA ACLC
BSR ASPCCI < CLOSE NVPC.
LA ACLF
BSR ASPCCI < CLOSE NVPF.
LA ACLT
BSR ASPCCI < CLOSE NVPT.
LA ACLB
BSR ASPCCI < CLOSE NVPBID.
PLR A,X
RSR
PAGE
<
<
< E C R I T U R E S G F :
<
<
WRITE: EQU $
LAD WRITET
SVC 0 < ECRITURE SGF...
JNE WRITE1 < ERREUR : EN FAIT LE SEUL CAS POSSIBLE
< EST LE MANQUE DE PLACE SUR 'DKM'...
RSR < OK, RETOUR NORMAL...
WRITE1: EQU $
LA AMPLA
BSR APRINT < ON LE DIT A L'UTILISATEUR...
JMP ALTMOD < ET ON FAIT COMME SI UN ALT-MODE ETAIT
< APPARU AFIN DE NE PAS PERDRE LE FICHIER
< SOURCE...
PAGE
<***********************************************************************
<* *
<* SP DE DELETE DU FICHIER POINTE PAR NVPBID *
<* *
<***********************************************************************
SPDELT: EQU $
LB ANOMTO < MOVE NOM
LXI 10
MOVE
IF ORDI-"T",XWOR%,,XWOR%
LA AASSOT < !ASSIGN NVPBID=O,
BSR ASPCCI
LA AASSRT < !ASSIGN NVPBID=R
BSR ASPCCI
LAD DEMDFT < DELETE FICHIER NVPT
SVC 0
XWOR%: VAL 0
IF ORDI-"S",XWOR%,,XWOR%
LA XASSD
STA &AMASSD
LA AASSOT < !ASSIGN NVPBID=D-
BSR ASPCCI
LA XASSO
STA &AMASSD < RESTAURE...
XWOR%: VAL 0
RSR
PAGE
<***********************************************************************
<* *
<* SP DE RELEVE D'UN NOM DE FICHIER. *
<* *
<***********************************************************************
SPRNOM: EQU $
STZ NPREC < RAZ DU NOMBRE PRECEDENT...
LBY &ADBFEN < CHERCHER LE CARACTERE '
CPI "'"
JE VUDNOM
CPI " " < SAUTER LES BLANCS
JNE NOMR
JIX SPRNOM
NOMR: EQU $
LA ADRFE < NOM DE FICHIER ERRONNE
BR MERR
VUDNOM: EQU $
ADRI 1,X < RELEVE L'ADRESSE DE DEBUT
LBI 0
AUTQUO: EQU $
LBY &ADBFEN < CHERCHER L'AUTRE CARACTERE '
CPI "'"
JE VUFNOM
XR X,B < RELEVER LE NOM
STBY &ANMFIC
ADRI 1,X
LR X,A
CPI 19
JG NOMR
XR X,B
JIX AUTQUO
JMP NOMR
VUFNOM: EQU $
XR X,B
LAI '04 < PLACER EOT EN FIN
STBY &ANMFIC
XR X,B
LA ANMFID < RENDRE L'ADRESSE DANS A
RSR
PAGE
<
<
< T R A I T E M E N T D E S M I N U S C U L E S :
<
<
< ARGUMENT :
< (A)=CODE ASCI, OU CODE DE CONTROLE DU COMPACTAGE.
<
<
< RESULTAT :
< (A)=CODE DE CONTROLE DU COMPACTAGE, OU
< =CODE DE MAJUSCULE (SI MAJUSCULE ARGUMENT, OU
< BIEN UNE MINUSCULE ALORS QUE L'IMPRIMANTE EST
< ACTIVE), OU
< =CODE DE MINUSCULE AVEC LE BIT DE PARITE...
<
<
MINUS: EQU $
TBT BITPAR < EST-CE UN CODE DE COMPACTAGE ???
JC MINUS1 < OUI, RIEN A FAIRE...
KMINUS:: VAL '60 < PREMIERE MINUSCULE...
KARO:: VAL '40 < CARACTERE "A-ROND"...
CPI KMINUS < EST-CE UNE MINUSCULE ???
JL MINUS1 < NON, UNE MAJUSCULE, RIEN A FAIRE...
CPZ LP1 < OUI, EST-ON SUR L'IMPRIMANTE ???
JE MINUS2 < NON, LA VISU, OK...
<
< CAS DE L'IMPRIMANTE :
<
PSR A
LA &AMTLP
CP ALP < MAIS EST-CE BIEN L'IMPRIMANTE ???
PLR A
JNE MINUS1 < NON, C'EST 'MT1', ON LAISSE LES
< MINUSCULES...
ADRI -KMINUS+KARO,A < OUI, SUR 'LP1' PAS DE MINUSCULES, ON
< PASSE EN MAJUSCULES...
JMP MINUS1 < VERS LA SORTIE...
<
< CAS DE LA VISU :
<
MINUS2: EQU $
SBT BITPAR < AFIN QUE LA VISU NE PRENNE PAS CE CODE
< COMME UNE EXTENSION...
<
< SORTIE :
<
MINUS1: EQU $
RSR
PAGE
<***********************************************************************
<* *
<* SP DE RELEVE DE CHAINE DE CARACTERES *
<* *
<***********************************************************************
SPRCAR: EQU $
STZ MARGRL < INITIALISATION DU
IC MARGRL < COMPTAGE DES "OR".
PSR W
LA RARGRL
LR A,W < INITIALISATION DE 'W' SUR LES
< CONTEXTES DES "OR".
RCAR3: EQU $
STZ NCHRL,W
LBY &ADBFEN < CHERCHER LE CARACTERE '
CPI "'"
JE VUDNAM
CPI " " < SAUTER LES BLANCS
JNE NAMR
JIX RCAR3
NAMR: EQU $
LA ADRQUO < MANQUE UNE QUOTE
BR MERR
VUDNAM: EQU $
ADRI 1,X < RELEVE L'ADRESSE DE DEBUT
LBI 0
LA NCHRL,W
STA SAVEX < AU CAS OU "-" SUIVRAIT...
CPI NCHMAX*NCARCH < PLUS QUE NCHMAX CHAINES?
JL AUTQUA < NON
RCAR2: EQU $
LA ADRRLC
BR MERR
AUTQUA: EQU $
LBY &ADBFEN < CHERCHER L'AUTRE CARACTERE '
CPI "'"
JE VUFNAM
CPI "\" < "'" DEMANDE ???
JNE VUFNA5 < NON...
LAI "'" < OUI...
VUFNA5: EQU $
XR X,B < RELEVER LA CHAINE
LY NCHRL,W
ADR Y,X
STBY &XARGRL,W < STORER LE CARACTERE
ADRI 1,X
LAI '04 < A PRIORI,FIN DE CHAINE
STBY &XARGRL,W
SBR Y,X
LR X,A
CPI NCARCH < A < NBRE CARAC MAX PAR CHAINE?
JG NAMR < NON,ERREUR
XR X,B
JIX AUTQUA
JMP NAMR
VUFNAM: EQU $ < FIN DE LA CHAINE I
LA NCHRL,W
ADRI NCARCH,A < INCREMENTER LE NOMBRE
STA NCHRL,W < DE CHAINES RELEVEES
CPZR B < AU MOINS UN CARACTERE?
JNE VUFNA2 < OUI
LA ADRFE < NON,ERREUR
BR MERR
VUFNA2: EQU $
ADRI 1,X
VUFNA3: EQU $
LBY &ADBFEN < CHERCHER LE CARACTERE '
CPI "'"
JE VUDNAM < RELEVER LA CHAINE I + 1
LBY &ADBFEN < ACCES AU CARACTERE COURANT,
CPI "-" < NEGATE ???
JNE VUFNA4 < NON...
PSR X
LX SAVEX < OUI, X=INDEX DE L'EOT DE FIN...
LBY &XARGRL,W
SBT 8 < BIT DE PARITE :
STBY &XARGRL,W < AFIN DE DISCRIMINER NEGATE...
PLR X
JMP RCAR1 < VERS LE CARACTERE SUIVANT.
VUFNA4: EQU $
CPI "," < EST-CE UN LIMITEUR DE "OR" ???
JNE RCAR1 < NON...
IC MARGRL < OUI, COMPTAGE...
LA MARGRL < ET VALIDATION,
CPI NOR
JG RCAR2 < TROP...
ADRI 2,W < OK, PASSAGE AU CONTEXTE SUIVANT.
ADRI 1,X < PASSAGE AU CARACTERE SUIVANT.
JMP RCAR3
RCAR1: EQU $
JIX VUFNA3
STZ NEGATE < CLEAR...
PLR W
RSR
PAGE
<***********************************************************************
<* *
<* SP DE DEPLACEMENT SUR UNE LIGNE *
<* *
<***********************************************************************
SPDEP: EQU $
BSR LIST < LISTE CARTE
LAD ECCRLF
BSR ASPSIM
LXI 0 < SAUVEGARDE DE LA CARTE
LAD &ADBFEN
LR A,B
LA ABFEN0
LXI LBUFVI
MOVE
LAD LECENT
BSR ASPSIM
LXI -2*LBUFVI
LBI 0
REM2: EQU $
LBY &ADBFEN
CPI '06 < CTRL-F IGNORE
JE REM23
CPI '0A
JE REM23 < 'LF' ('CTRL-J') IGNORE...
CPI '0B
JE REM23 < 'CTRL-K' IGNORE...
CPI '09 < CTRL-I ?
JNE REM21
ADRI 1,B
JMP REM23
REM21: EQU $
CPI '08 < CTRL-H ?
JNE REM22
ADRI -1,B
CPZR B
JGE REM210
LBI 0
REM210: EQU $
JMP REM23
REM22: EQU $
CPI '04 < CTRL-D ?
JE REM8
CPI '0D < RETURN ?
JE REM8
CPI '20
JGE REM225
LA CLOCHE < ERREUR:BELL
REM225: EQU $
XR X,B
BSR AMINUS < TRAITEMENT DES MINUSCULES...
STBY &ADBFEN
ADRI 1,X
XR X,B
REM23: EQU $
JIX REM2
REM8: EQU $
PSR A
LXI 0 < RANGEMENT CARTE ZONE DEBUT
LAD &ADBFEN
LB ABFEN0
LXI LBUFVI
MOVE
PLR A
CPI '04
JE SPDEP < SI CTRL-D,MEME LIGNE
RSR
PAGE
<***********************************************************************
<* *
<* SP D'EXECUTION COMMANDE FI *
<* *
<***********************************************************************
SPEXFI: EQU $
LA INDFI
CPI 1 < 1ERE COMMANDE DU FICHIER FI
JNE SPEX1 < NON
IC INDFI < OUI,OUVRIR LE FICHIER
STZ INDIFI < INITIALISATION DE LA LECTURE
LXI 0
LAI 'FF
STBY &ASGFII
LA ACLFI
BSR ASPCCI
LA AASSFI < !ASSIGN
BSR ASPCCI
LAD OPENFI < OPEN FICHIER FI
SVC 0
STZ ENDFI < FIN DE FICHIER = FAUX
JE SPEX1
LA ACLFI < CLOSE DU FICHIER FI
BSR ASPCCI
STZ INDFI < FIN DE FI
LA ADRFI
BR MERR < ERREUR
SPEX1: EQU $
< A CE NIVEAU LE FICHIER FI EST OUVERT
LA ABFFII < INITIALISATION ADRESSE BUFFER
SLLS 1 < EN OCTET
STA READFI+1
SPEX2: EQU $
< LECTURE FICHIER
CPZ ENDFI < FIN DE FICHIER DEJA TROUVE
JNE SPEX3 < OUI
LX INDIFI < FIN DE SECTEUR
LBY &ASGFII
CPI 'FF
JNE SPEX21
LAD READFI < OUI RELIRE UN SECTEUR
SVC 0
JNE SPEX3
CPZ &ABFFII
JL SPEX3
LXI 0
SPEX21: EQU $
LR X,Y < INDEX DEBUT DE CARTE
LBI 0
SPEX22: EQU $
LBY &ASGFII < TRANSFERER LE CARACTERE
XR X,B
STBY &ADECFI
ADRI 1,X
XR X,B
ADRI 1,X
CPI 'FE
JNE SPEX22
SBR X,Y
NGR Y
STX INDIFI < SAUVER L'INDEX DANS BUFFER
LAI 0 < PAS FIN DE FICHIER FI
LR Y,B
JMP SPEX31
SPEX3: EQU $
LAI 1 < FIN DE FICHIER FI
SPEX31: EQU $
JANE SPEX8
IC NCARFI < NBRE DE CARTES LUES + 1
LA NCARFI
CP NFI < INFERIEUR A NFI?
JL SPEX2 < OUI,RELIRE UNE CARTE
CP MFI < SUPERIEUR A MFI?
JG SPEX8 < OUI,FIN DE FICHIER FI
< DECOMPACTION DE LA CARTE
LXI -LBUFVI < METTRE LA C@ARTE A BLANC
LA BLANC
STA &ADBFEN
JIX $-1
LXI -1 < INDICE IN
LBI -2*LBUFVI < INDICE OUT
SPEX40: EQU $
ADRI 1,X < FIN DE CARTE
LBY &ADECFI
CPI 'FE
JE SPEX49
TBT 8 < REPETITION/TABULATION?
JC SPEX41
XR X,B < NON-PLACER LE CARACTERE
STBY &ADBFEN
ADRI 1,X
XR X,B
JMP SPEX40
SPEX41: EQU $
RBT 8
CPI 80 < TABULATION OU REPETITION
JGE SPEX42
ADRI -80,A < TABULATION
LR A,B
JMP SPEX40
SPEX42: EQU $
ADRI -80,A
LR A,Y
ADRI 1,X < CARACTERE A REPETER
LBY &ADECFI
XR X,B
SPEX43: EQU $
STBY &ADBFEN < LE PLACER
ADRI 1,X
CPZR Y < EST-CE FINI?
JE SPEX44
ADRI -1,Y
JMP SPEX43
SPEX44: EQU $
XR X,B
JMP SPEX40
SPEX49: EQU $
LXI 0
SPEX5: EQU $
ADRI -1,X
LBY &ADBFEN
CPI " "
JE SPEX5
CPI '04 < EOT ?
JNE SPEX6
LAI " "
STBY &ADBFEN < EFFACEMENT DE L'EOT
ADRI -1,X
SPEX6: EQU $
ADRI 2*LBUFVI+1,X
STX VATRA2 < LONGUEUR REELLE EN OCTETS
STX SIMBOX < A CAUSE DE "<...".
ADRI -2*LBUFVI+1,X
SPEX61: EQU $
LBY &ADBFEN
CPI '5F
JNE SPEX62
LA BLANC
STBY &ADBFEN
ADRI -1,X
JMP SPEX61
SPEX62: EQU $
RSR
SPEX8: EQU $
IC ENDFI < FIN DE FICHIER FI
PSR A,X
LA ACLFI < CLOSE DU FICHIER FI
BSR ASPCCI
STZ INDFI < FIN DE FI
PLR A,X
JMP SPEX62
PAGE
<***********************************************************************
<* *
<* SP DE MOVE DU NOM DANS LES ASSIGN DE NVPT. *
<* *
<***********************************************************************
SPMOVT: EQU $
LB ANOMTN < MOVE DANS ASSIGN NEW
LXI 10
MOVE
RSR
<***********************************************************************
<* *
<* SP DE MOVE DU NOM DANS LES ASSIGN DE NVPF. *
<* *
<***********************************************************************
SPMOVF: EQU $
LB ANOMFO < MOVE DANS ASSIGN OLD
LXI 10
MOVE
LB ANOMFN < MOVE DANS ASSIGN NEW
LXI 10
MOVE
RSR
PAGE
<***********************************************************************
<* *
<* SP D'OPEN NVPT NEW. *
<* *
<***********************************************************************
SPOPTN: EQU $
LA LUTBUF < PLACE DANS SGFOUT
STA PLACT
LA AASSNT < !ASSIGN
BSR ASPCCI
LAD DEMSGF < RELEVER LE NOM INTERNE
SVC 0
LAD OPENTN < OPEN
SVC 0
RSR
<***********************************************************************
<* *
<* SP D'OPEN NVPT OLD *
<* *
<***********************************************************************
SPOPTO: EQU $
LAD TNOM
LB ANOMOT
LXI 10
MOVE
LA AASSTO
BSR ASPCCI
LAD OPENOT
SVC 0
RSR
PAGE
<***********************************************************************
<* *
<* SP OPEN NVPF OLD. *
<* *
<***********************************************************************
SPOPFO: EQU $
STZ INDIN < INITIALISATION DE LA LECTURE
LXI 0
LAI 'FF
STBY &ABSGII
LA AASSOF < !ASSIGN
BSR ASPCCI
LAD OPENFO < OPEN
SVC 0
STZ ENFILE < FIN DE FICHIER=FAUX
RSR
<***********************************************************************
<* *
<* SP OPEN NVPF NEW. *
<* *
<***********************************************************************
SPOPFN: EQU $
LA AASSNF < !ASSIGN
BSR ASPCCI
LAD OPENFN < OPEN
SVC 0
STZ ENFILE < FIN DE FICHIER=FAUX
RSR
<***********************************************************************
<* *
<* SP OPEN NVPF OLD OU NEW. *
<* *
<***********************************************************************
SPOPFX: EQU $
BSR OPFO < OPEN OLD
JE FOUV
BSR OPFN < SINON, OPEN NEW
JNE EROPFX
FOUV: EQU $
RSR
EROPFX: EQU $
BSR ACLOSE < CLOSE PARTIEL
LA ADRFE < NOM DE FICHIER ERRONNE
BR MERR
PAGE
<***********************************************************************
<* *
<* SP DE DECOMPACTION D'UNE CARTE. *
<* *
<***********************************************************************
SPDECO: EQU $
LXI -LBUFVI < METTRE LA CARTE A BLANC
LA BLANC
STA &ADBFEN
JIX $-1
LXI -1 < INDICE IN
LBI -2*LBUFVI < INDICE OUT
AUTDEC: EQU $
ADRI 1,X < FIN DE CARTE
LBY &ADBFCO
CPI 'FE
JE VUFINC
TBT 8 < REPETETION/TABULATION?
JC TABUL
XR X,B < NON - PLACER LE CARACTERE
BSR AMINUS < TRAITEMENT DES MINUSCULES...
STBY &ADBFEN
ADRI 1,X
XR X,B
JMP AUTDEC
TABUL: EQU $
RBT 8
CPI 80 < TABULATION OU REPETITION?
JGE REPET
ADRI -2*LBUFVI,A < TABULATION
LR A,B
JMP AUTDEC
REPET: EQU $
ADRI -80,A < REPETITION
LR A,Y
ADRI 1,X < CARACTERE A REPETER
LBY &ADBFCO
XR X,B
REPLEN: EQU $
BSR AMINUS < TRAITEMENT DES MINUSCULES...
STBY &ADBFEN < LE PLACER
ADRI 1,X
CPZR Y < EST-CE FINI?
JE FINREP
ADRI -1,Y < NON - CONTINUER
JMP REPLEN
FINREP: EQU $
XR X,B
JMP AUTDEC
VUFINC: EQU $
RSR
PAGE
<***********************************************************************
<* *
<* SP DE COMPACTAGE D'UNE CARTE. *
<* *
<***********************************************************************
SPCOMP: EQU $
LXI -LBUFVI*2
RZPAR1: EQU $
LBY &ADBFEN
RBT BITPAR < ON NETTOIE A PRIORI LES PARITES (CAS DE
< BANDES MAGNETIQUES "EXTERIEURES").
STBY &ADBFEN
JIX RZPAR1
LXI 0 < ELIMINER LES BLANCS DE FIN
REVBLA: EQU $
ADRI -1,X
LBY &ADBFEN
CPI " "
JE REVBLA
ADRI 1,X < METTRE FIN DE CARTE
LAI 'FE
STBY &ADBFEN
LXI -2*LBUFVI < INDEX IN
LBI 0 < INDEX OUT
AUTCAR: EQU $
LYI 0 < COMPTE DE REPETITION
NEWCAR: EQU $
LBY &ADBFEN < CARACTERE PRECEDENT
CPI 'FE < FIN DE CARTE?
JE FINCAR
REVCAR: EQU $
ADRI 1,X < CARACTERE SUIVANT
CPBY &ADBFEN
JNE CARDIF
ADRI 1,Y < MEME
JMP REVCAR
CARDIF: EQU $
CPZR Y < EST-CE UNE REPETITION?
JG REPCAR
BSR PLCO < NON - LE PLACER
JMP NEWCAR
REPCAR: EQU $
CPI " " < TABULATION?
JNE PATAB
LR X,A < OUI - LA PLACER
CPI -2*LBUFVI+80
JLE REPCA1
LAI " "
JMP PATAB
REPCA1: EQU $
ADRI 2*LBUFVI,A
SBT 8
BSR PLCO
JMP AUTCAR
PATAB: EQU $
XR A,Y < REPETITION
CPI 40 < SUPERIEUR A 40?
JGE PLUS40
ADRI 80,A < NON - LA PLACER
SBT 8
BSR PLCO
LR Y,A
BSR PLCO
JMP AUTCAR
PLUS40: EQU $
LR A,W < PLUS DE 40
LAI 119 < PLACER 40
SBT 8
BSR PLCO
LR Y,A
BSR PLCO
LR W,A < PLACER LE RESTE
CPI 80
JGE PLUS80
ADRI 40,A
SBT 8
BSR PLCO
LR Y,A
BSR PLCO
JMP AUTCAR
PLUS80: EQU $
LAI 119
SBT 8
BSR PLCO
LR Y,A
BSR PLCO
LR W,A
SBT 8
BSR PLCO
LR Y,A
BSR PLCO
JMP AUTCAR
FINCAR: EQU $
BSR PLCO < PLACER 'FE
RSR
PAGE
<***********************************************************************
<* *
<* SP DE PLACEMENT D'UN CARACTERE COMPACTE. *
<* *
<***********************************************************************
SPPLCO: EQU $
XR X,B
STBY &ADBFCO
ADRI 1,X
XR X,B
RSR
PAGE
<***********************************************************************
<* *
<* SP DE LISTE D'UNE CARTE *
<* *
<***********************************************************************
SPLIST: EQU $
CPZ UTILP < SI ON UTILISE P
JE LIST11
LX P < PRENDRE LA BONNE LONGUEUR
JMP LIST22
LIST11: EQU $
LXI -1 < SINON CALCULER LA LONGUEUR
REVBL: EQU $
LBY &ADBFEN
CPI " "
JNE LGEFF
ADRI -1,X
JMP REVBL
LGEFF: EQU $
STX SAVEX < SAVEX=INDEX DE FIN DE MESSAGE.
STZ JUSTS < JUSTS=COMPTEUR D'ESPACES EXISTANTS.
LIST56: EQU $
LBY &ADBFEN
CPI " "
JNE LIST57
IC JUSTS < COMPTAGE DES ESPACES EXISTANTS.
LIST57: EQU $
ADRI -1,X
LR X,A
CP JUSTF < EST-CE FINI ???
JGE LIST56 < NON...
LA JUSTS
SB JUSTD < ON IGNORE DES ESPACES EN TETE...
STA JUSTS
LX SAVEX < OUI, RESTAURE X=INDEX DE FIN...
ADRI 2*LBUFVI+2,X
LIST22: EQU $
STX WRITEO+2
CPZ JUSTS
JLE LIST51 < LE MESSAGE NE CONTENANT AUCUN ESPACE,
< ON NE PEUT EN RAJOUTER...
LAI 2*LBUFVI+1 < OUI :
SB WRITEO+2 < A=NOMBRE D'ESPACES A DROITE,
JAE LIST51 < RIEN A RAJOUTER, C'EST FINI...
CP JUSTM < TROP ???
JG LIST51 < OUI, ON NE FAIT RIEN...
LR A,Y < OK, Y=NOMBRE D'ESPACES A RAJOUTER...
LIST54: EQU $
LXI -1 < X=INDEX DE BOUT DE BUFFER,
AD JUSTS < POUR FAIRE UNE DIVISION
ADRI -1,A < PAR EXCES.
SARD 16
DV JUSTS
STA JUSTS < JUSTS=NOMBRE D'ESPACES A RAJOUTER
< PAR ESPACE EXISTANT.
LB SAVEX < B=INDEX DE FIN DE MESSAGE.
LIST52: EQU $
XR B,X
LBY &ADBFEN < A=CARACTERE COURANT DU MESSAGE.
XR B,X
CPI " " < ESPACE ???
JNE LIST53 < NON, ON RANGE...
PSR B
LB JUSTS < NOMBRE D'ESPACE A RAJOUTER.
LIST59: EQU $
CPZR Y < RESTENT'ILS DES BLANCS ???
JE LIST58 < NON...
ADRI -1,Y < OUI, ON LES DECOMPTE...
STBY &ADBFEN < ON LE DUPLIQUE...
ADRI -1,X
ADRI -1,B < ENCORE ???
CPZR B
JG LIST59 < OUI...
LIST58: EQU $
PLR B
LIST53: EQU $
STBY &ADBFEN < RANGEMENT DU CARACTERE COURANT,
ADRI -1,X < ET REGRESSION
ADRI -1,B < DES INDEX.
LR B,A
CP JUSTF < EST-CE FINI ???
JGE LIST52 < NON, AU CARACTERE SUIVANT...
LAI 2*LBUFVI+1
STA WRITEO+2 < MAJ DE LA DEMANDE...
LR A,X < POUR LA LONGUEUR DE LA CARTE.
LIST51: EQU $
CPZ LISNO
JNE NUMERL
LA ABFEN0 < PAS DE NUMEROTATION
LB ABFSO1
LXI LBUFVI
MOVE
LAI " "
STA &AA6D < AFIN DE CADRER CORRECTEMENT...
LAD DEM6D
BSR ASPSIM < ET ON SIMULE LE '6D ECRASE...
LA LP1
TBT 15 < "MT1"/"LP1" ???
JNC ECRCAR < NON, LA VISU...
LA &AMTLP
CP AMT < EST-CE "MT1" ???
JNE ECRCAR < NON...
IC WRITEO+1 < OUI, ON ENLEVE LE PREMIER OCTET,
< AFIN D'AVOIR DES ARGUMENTS PAIRS...
LA WRITEO+2
TBT 15 < LA LONGUEUR EST-ELLE PAIRE ???
JNC ECRKAR < OUI, OK...
LR A,X < NON :
IC WRITEO+2 < ON LA REND PAIE...
LAI " "
STBY &ABFSOR < ET ON COMPLETE...
ECRKAR: EQU $
CPZ RIDGE < GENERE-T'ON UNE BANDE RIDGE ???
JE ECRCAR < NON...
LX WRITEO+2 < OUI,
LAI " "
STBY &ABFSOR
ADRI 1,X
LAI '0A
STBY &ABFSOR < ON IMPLANTE UN <LINE-FEED> AU BOUT DU
< BUFFER (ET UN <SPACE> POUR LA PARITE DE
< LA LONGUEUR...
IC WRITEO+2
IC WRITEO+2
JMP ECRCAR
NUMERL: EQU $
LR X,A < SUPPRIMER 8 CARACTERES DE FIN
LGNORM: EQU $
ADRI 8,X
STX WRITEO+2
LB ABFSO5 < PLACER LA CARTE
LA ABFEN0
LXI LBUFVI
MOVE
LB ABFSO1 < METTRE LE NUMERO DE CARTE
LAD NOLIST+1
LXI 3
MOVE
LA BLANC < METTRE 2 BLANC
STA &ABFSO4
ECRCAR: EQU $
CPZ JUSTP < SAUT DE PAGE ???
JE ECRCAS < NON...
CPZ KJUSTP < OUI, A FAIRE MAINTENANT ???
JNE ECRCAT < NON...
LA JUSTP < OUI,
STA KJUSTP < REINITIALISATION DU COMPTEUR...
LAD DEMP < ET
BSR ASPSIM < SAUT DE PAGE...
ECRCAT: EQU $
DC KJUSTP < DECOMPTAGE DES LIGNES...
ECRCAS: EQU $
<
< MISE EN PLACE DU BIT DE PARITE (AU
< CAS OU ON GENERERAIT UNE BANDE
< MAGNETIQUE "EXTERIEURE") :
<
LA LP1 < EST-CE LA VISU ???
TBT 15
JNC PPAR3 < OUI, RIEN A FAIRE...
LA &AMTLP
CP AMT < EST-CE "MT1" ???
JNE PPAR3 < NON, PARITES INUTILES...
LA WRITEO+1
PSR A,B,X < SAVE L'ADDRESSE DU BUFFER.
LXI 0 < X=INDEX DU BUFFER,
SLRS 1 < CONVERSION EN UNE ADRESSE MOT,
ADCR X < X=INDEX INITIAL DU BUFFER.
LR X,B < SAVE L'INDEX DU PREMIER CARACTERE...
SBT 0
STA WRITEO+1 < GENERATION D'UN RELAI TEMPORAIRE VERS
< LE BUFFER.
PPAR: EQU $
LBY &WRITEO+1 < ACCES A UN CARACTERE :
CPR X,B < EST-CE LE PREMIER ???
JNE PPAR4 < NON, ON NE TESTE PAS '6D ("M" MINUS-
< CULE)...
CPI '6D < EST-ON SUR VISU ???
JE PPAR2 < OUI, ON NE MODIFIE PAR '6D...
PPAR4: EQU $
CPZ RIDGE < GENERE-T'ON UNE BANDE RIDGE ???
JNE PPAR1 < OUI, PAS DE PARITE...
PTY < CALCUL DE LA PARITE :
JNC PPAR1 < PAIRE,
SBT BITPAR < IMPAIRE...
PPAR1: EQU $
STBY &WRITEO+1 < MISE A JOUR DU BUFFER...
PPAR2: EQU $
ADRI 1,X < PROGRESSION DE L'INDEX,
LR X,A
CP WRITEO+2 < EST-CE FINI ???
JL PPAR < NON...
PLR A,B,X < OUI,
STA WRITEO+1 < ON RESTAURE...
PPAR3: EQU $
<
< ENVOI DU BUFFER :
<
LAD WRITEO < ECRIRE LA LIGNE
BSR ASPSIM
LRM A
WORD BUFSOR-ZERO*2+1
STA WRITEO+1 < ON RESTAURE AU CAS DE "MT1"...
LAI '6D
STA &AA6D < RESTAURATION DU '6D A PRIORI...
RSR
PAGE
<***********************************************************************
<* *
<* SP DE PERFORATION D'UNE CARTE. *
<* *
<***********************************************************************
SPPERF: EQU $
CPZ LISNO
JE PERCAR
LXI -4 < PERFO AVEC NUMEROTATION
LAD &ABINPC
LR A,B
LAD NOLIST
LXI 4
MOVE
PERCAR: EQU $
LXI -80
AUTPC: EQU $
LBY &ABINPC < RELEVER LE CARACTERE
ANDI '7F
CPI '20
JGE VOISUP
CPI '04 < EOT - SPECIAL
JNE VUEOT
LAI '1F
JMP BONCAR
VOISUP: EQU $
CPI '5F
JLE BONCAR
VUEOT: EQU $
LAI "?" < CARACTERE NON RECONNU
BONCAR: EQU $
PSR X < PERFORER LE CARACTERE
LR A,X
LA &ACOD
STA &ABFSGO
LAD DEMPCH
SVC 0
IF ORDI-"S",X102,,X102
LX CTPUSY
TEMPO1: EQU $
HALT
CPZR X < ATTENTE TERMINEE ???
JNE TEMPO1 < NON, ON ATTEND...
X102: VAL 0
PLR X
JIX AUTPC < PASSER AU SUIVANT
LAD SLEEP < ATTENDRE 4 SECONDES
SVC 0
RSR
PAGE
<***********************************************************************
<* *
<* SP DE RECOPIE DE NVPF SUR NVPT JUSQU'A LA CARTE N. *
<* *
<***********************************************************************
SPRECN: EQU $
LA NOCAR
CP N < EST-ON RENDU A N?
JNE LIRF
RSR < OUI - RETOUR
LIRF: EQU $
BSR LECF < NON - RECOPIER UNE CARTE
JANE SPRECN < FIN DE FICHIER...
CPZ INDED < EST-ON SOUS 'FC' ???
JNE SPRECN < OUI, PAS DE RECOPIE...
BSR ECRT
JMP SPRECN < PASSER A LA CARTE SUIVANTE
PAGE
<***********************************************************************
<* *
<* SP DE SUPPRESSION DES CARTES N A M. *
<* *
<***********************************************************************
SPSUNM: EQU $
BSR RECN < RECOPIE JUSQU'A N
LIRVID: EQU $
LA NOCAR
CP M < EST-ON RENDU A M?
JLE PASM
RSR < OUI - RETOUR
PASM: EQU $
BSR LECF < NON - LIRE UNE CARTE
JMP LIRVID < ET PASSER A LA SUIVANTE
PAGE
<***********************************************************************
<* *
<* SP D'AJOUT DE CARTES JUSQU'A ":F". *
<* *
<***********************************************************************
SPAJOU: EQU $
STZ LISNO < PAS DE NUMEROTATION...
CPZ CR1 < ASSIGN CR1?
JE PASCR1
LA AASSCR
BSR ASPCCI
JE PASCR1
IF ORDI-"S",XWOR%,,XWOR%
LA &AMTCR
CP AMT < SI C'EST 'MT1', ON ACCEPTE L'ERREUR,
< AU CAS OU ON AURAIT DEJA 'MT1' PAR
< UNE ASSIGNATION ANTERIEURE, SINON,
< LA PREMIERE E/S DESSUS FAUTERA...
JE PASCR1 < OUI, 'MT1'...
XWOR%: VAL 0
RSR
PASCR1: EQU $
CPZ COMNOR < COMPACTE OU NORMAL?
JNE AJCOM1 < EN FAIT AJCOMP MAIS > YY7
CPZ CR1 < NORMAL - CR1?
JE PASCR2
LAI NVPC < OUI - UNITE NVPC
STBY LECENT
LA LGENT < LG E/S
STA LECENT+2
CPZ BATCH < CR ET VISU,PAS D'ECHO
JNE PASCR2
LA LECENT
RBT 15
STA LECENT
LAI NVPBID < DEMANDE BIDON
STBY ECCRLF
PASCR2: EQU $
LA CRLFSU < NORMAL
STA CRLF
LA LECENT+1
LB LECENT+2
PSR A,B
AJSYMB: EQU $
CPZ UTILP < SI ON TIENT COMPTE DE P
JE VOIRP2
LA NOCAR < A-T-ON FINI
CP M
JG PASLUN < OUI-FIN
IC NOCAR < NON-COMPTER LA CARTE
BSR RLCT < LA LIRE
JANE PASLUN < SI FIN DE FICHIER,RETOUR
BSR DECO < LA DECOMPACTER
LAI -2*LBUFVI-1
AD P
LR A,X
NGR A
STA LECENT+2 < LONGUEUR A LIRE
LA ABFEN0 < MODIFIER L'ADRESSE D'ENTREE
SLLS 1
AD P
ADRI -1,A
STA LECENT+1
LAI " " < MISE A BLANC DE LA FIN DE LIGNE
VOIRP1: EQU $
STBY &ADBFEN
JIX VOIRP1
BSR LIST < LISTE DU DEBUT DE LA LIGNE
JMP VOIRP3
VOIRP2: EQU $
LXI -2*LBUFVI
LAI " "
ETI8: EQU $
STBY &ADBFEN < MISE DE LA CARTE A BLANC.
JIX ETI8
CPZ INDFI < EST-ON SOUS FI?
JE VORP21 < NON
BSR EXFI < OUI,LIRE UNE CARTE SUR FICHIER FI
CPZ ENDFI < FIN DE FICHIER FI?
JE VORP20 < NON
IC INDFI < CAR RAZER DANS EXFI
LA ADRFI3 < OUI ERREUR
BR MERR
VORP20: EQU $
JMP VOIRP5
VORP21: EQU $
LAD ECCRLF < LIRE UNE CARTE
BSR ASPSIM
VOIRP3: EQU $
CPZ LECENT+2 < SI LONGUEUR VIDE
JLE VOIRP5
LAD LECENT
BSR ASPSIM < LECTURE
BSR ASPBOX
STB VATRA2 < LONGUEUR REELLE EN OCTETS
CPZR X
JNE PASLUN
VOIRP5: EQU $
CPZ UTILP < TEST DE FIN
JNE SUITAJ
LA &ABFEN0 < EST-CE LA FIN DE SEQUENCE?
CP &ACMEND
JNE SUITAJ
PASLUN: EQU $
LA CRLFET < OUI - RESTAURER ETOILE
STA CRLF
LAI NVPI < RESTAURER NVPI
STBY LECENT
LA LECENT < RESTAURER L'ECHO
SBT 15
STA LECENT
LAI NVPO < RESTAURER NVPO
STBY ECCRLF
IF ORDI-"S",XWOR%,,XWOR%
LA &AMTCR
CP AMT < ETAIT-CE 'MT1' ???
JE PRELMT < OUI, DONC IL NE FAUT PAS DESASSIGNER,
< AU CAS OU ON LIRAIT ENCORE, AFIN D'EVITER
< UN REMBOBINAGE LORS DE LA REASSIGNATION.
XWOR%: VAL 0
LA AASCRS < CLOSE LECTEUR
BSR ASPCCI
IF ORDI-"S",XWOR%,,XWOR%
PRELMT: EQU $
XWOR%: VAL 0
PLR A,B
STA LECENT+1
STB LECENT+2
RSR < OUI - RETOUR
AJCOM1: EQU $
JMP AJCOMP
AJSYM1: JMP AJSYMB
SUITAJ: EQU $
CPZ UTILP
JNE PADEP
LB VATRA2
LR B,X
ADRI -2*LBUFVI,X
LAI " "
STBY &ADBFEN
JIX $-1
LXI -2*LBUFVI
SUIT1: EQU $
LBY &ADBFEN
RBT 8 < ELIMINATION DE LA PARITE A PRIRI...
IF ORDI-"S",XWOR%,,XWOR%
CPZ MODE < Y-A-T'IL UN TRANSCODAGE A FAIRE ???
JE SUIT3 < NON, ASCI...
CPI " " < SERAIT-CE 'BLANC' ASCI ???
JE SUIT3 < OUI, ON LE LAISSE...
PSR X < OUI : EBCDIC --> ASCI...
LXI UNDEFE < A PRIORI UNDEFINI...
CPI FIRSTE
JL SUIT4 < UNDEFINI...
CPI LASTE
JG SUIT4 < UNDEFINI...
LR A,X < OK, L'INDEX DE TRANSCODAGE EST LE CODE
< EBCDIC DU CARACTERE :
SUIT4: EQU $
LBY &ATRANS < CE QUI DONNE LE CODE ASCI :
PLR X
SUIT3: EQU $
XWOR%: VAL 0
PSR A
LA &AMTCR
CP AMT < EST-ON SUR 'MT1' ???
PLR A
JE SUITMT < OUI, ON VA SUPPRIMER TOUS LES 'CTRL-XX',
< Y COMPRIS 'RC', 'EOT'...
CPI '06
JE SUIT2
CPI '09
JE SUIT2
CPI '08
JE SUIT2
CPI '04
JE SUIT2
CPI '0D
JE SUIT2
SUITMT: EQU $
CPI '20
JGE SUIT2
LA CLOCHE < ERREUR : BELL...
SUIT2: EQU $
BSR AMINUS < TRAITEMENT DES MINUSCULES...
STBY &ADBFEN
JIX SUIT1
LR B,X
ADRI -2*LBUFVI-1,X
LBY &ADBFEN
CPI '04
JNE PADEP
LAI " "
STBY &ADBFEN < ON LE REMPLACE PAR UN BLANC.
LA RETOUR
STA CRLF
BSR DEP
LA CRLFSU
STA CRLF
PADEP: EQU $
CPZ BATCH < SI BATCH, PAS DE EOT
JNE PASEOT
BSR ASPBOX < RELEVER LA LONGUEUR DE LA CARTE
LR B,A
CPZ UTILP
JE VOIRP4
AD P
ADRI -1,A
VOIRP4: EQU $
LR A,X
ADRI -2*LBUFVI-1,X
LBY &ADBFEN < CARTE FINIE PAR EOT?
CPI '04 < EOT ???
JE TREOT < OUI, SUPPRIME...
CPI '0D < OU RETURN?
JNE PASEOT
TREOT: EQU $
ADRI -1,X < OUI - L'EFFACER
LAI " " < COMPLETER AVEC DES BLANCS
REBLAN: EQU $
JIX PLBL
PASEOT: EQU $
LXI -2*LBUFVI < ELIMINER LES CTL-H
LBI -2*LBUFVI
RECTLH: EQU $
LBY &ADBFEN
CPI '08 < CTL-H?
JNE PACTLH
ADRI -1,B < OUI - RECULER
LR B,A < VERIFIER LIMITE RECUL
CPI -2*LBUFVI
JGE AUCTLH
LBI -2*LBUFVI
JMP AUCTLH
PACTLH: EQU $
XR X,B < PAS CTL-H - PLACER LE CARAC.
BSR AMINUS < TRAITEMENT DES MINUSCULES...
STBY &ADBFEN
ADRI 1,X
XR X,B
AUCTLH: EQU $
JIX RECTLH
LR B,X < COMPLETER AVEC DES BLANCS
LAI " "
STBY &ADBFEN
JIX $-1
BSR COMP < COMPACTER ET ECRIRE
BSR ECRT
JMP AJSYM1
PLBL: EQU $
STBY &ADBFEN
JMP REBLAN
PAGE
<***********************************************************************
<* *
<* AJOUT DE CARTES COMPACTEES. *
<* *
<***********************************************************************
AJCOMP: EQU $
CPZ CR1 < CR1?
JE PASCR3
LAI NVPC < OUI - UNITE NVPC
STBY LECCOM
PASCR3: EQU $
LA BATCH < COMPACTE AUTORISE?
OR CR1
JAE NOCOMP
NWFIBI: EQU $
STZ NOCCP < NO CARTE=0
LYI 0 < INDEX SUR BINAIR
LBI 0 < INDEX SUR ENTCOM
LXI -1 < INDEX SUR BINAIR
RELCOM: EQU $
ADRI 1,X < CARACTERE SUIVANT
CPR Y,X
JL PALICM
PSR B < LIRE UNE CARTE
IC NOCCP
RETER1: EQU $
LAD LECCOM
SVC 0
JNE PASLUC
LXI -76 < INDEX SUR ENTBIN
LA &ABINEN < FIN?
CP DEUXPT
JNE PAFAJC
LXI -75
LA &ABINEN
CP CARACF
JNE PAFAJC
PASLUC: EQU $
BSR RENI < LIBERER LE LECTEUR
PLR B
RSR
PAFAJC: EQU $
STZ CHEKSM < INIT CHECKSUM
LYI -114 < INDEX SUR BINAIR
LXI -75
AUTBNR: EQU $
LA &ABINEN < RELEVER 2 PREMIERS MOTS
LR A,B
ADRI -1,X
LA &ABINEN
SLRS 4 < PLACER LES 3 CARACTERES UTILES
SLRD 4
XR X,Y
BSR AJCK
LAI 0
SLLD 8
BSR AJCK
LAI 0
SLLD 8
BSR AJCK
XR X,Y
ADRI 2,X < PASSER AUX DEUX MOTS SUIVANTS
JIX AUTBNR
LAI 0 < CALCUL NUMEROTATION+CHECKSUM
LBI 0
LR A,W
LXI -4
RECNMT: EQU $
LA &ABINEF < CARACTERE SUIVANT
SCLD 2
PSR X
DBT
JANE PANULL < COLONNE BLANCHE
LXI 0
PANULL: EQU $
LR X,A < LE RAJOUTER SUR LE NOMBRE
XR A,W
PSR B
MP DIX
ADR B,W
PLR B
PLR X
JIX RECNMT < CARACTERE SUIVANT
LA CHEKSM < SI CHECKSUM=0 , ALORS =1
JANE CHEKNN
IC CHEKSM
CHEKNN: EQU $
LR B,A < VERIFIER CHECKSUM
JAE VERNUM < CHECKSUM=0, PAS DE VERIF.
EOR CHEKSM
JANE ERNUM
VERNUM: EQU $
LR W,A < VERIFIER NUMEROTATION
CP NOCCP
JNE ERNUM
RETERN: EQU $
LXI -114 < INDEX SUR BINAIR
PLR B
PALICM: EQU $
LBY &ABINAR < TRANSFERER CARACTERE SUIVANT
XR X,B
STBY &ADBFCO
ADRI 1,X
XR X,B
CPI 'FE < FIN DE CARTE?
JL RELCOM
CPI 'FF < FIN DE SECTEUR
JE NWFIBI
PSR X,Y < FIN DE CARTE
BSR ECRT < L'ECRIRE
PLR X,Y
LBI 0
JMP RELCOM
ERNUM: EQU $
LR W,A < ERREUR - METTRE LE NUMERO
BSR ININ < DE LA CARTE DANS LE MESSAGE
LAD NOLIST
LB ADRLI1
LXI 4
MOVE
LA ADRLIR < SORTIR LE MESSAGE
BSR MERR
<<<< CPZ BATCH
<<<< JNE RETERN
LAD RETCCI
SVC 0
JMP RETER1
NOCOMP: EQU $
BSR RENI < LIBERER LECTEUR
LA ADRCOM
BR MERR
PAGE
<***********************************************************************
<* *
<* PLACEMENT D'UN CARACTERE EN LECTURE COMPACTE + CHECKSUM. *
<* *
<***********************************************************************
SPAJCK: EQU $
JAE AJCK1 < CARACTERE NUL
STBY &ABINAR < PLACER
EOR CHEKSM < CHECKSUM
STA CHEKSM
ADRI 1,X
AJCK1: EQU $
RSR
<***********************************************************************
<* *
<* RESTAURER NVPI ET LIBERER LE LECTEUR *
<* *
<***********************************************************************
SPRENI: EQU $
LAI NVPI < RESTAURER NVPI
STBY LECCOM
LA AASCRS < LIBERER LECTEUR
BSR ASPCCI
RSR
<***********************************************************************
<* *
<* RELEVER DE N ET M S'ILS EXISTENT *
<* *
<***********************************************************************
SPLINM: EQU $
STZ NOCAR
BSR RELN
LA VATRA1
PSR A < SAVE L'INDICATEUR DE PRESENCE DE 'N'...
BSR RELM
LA M < SI M=N, M='7FFF
CP N
JNE PASLF
LA SETFFF
STA M
PASLF: EQU $
PLR A < RESTAURE : (A)='VATRA1'...
CPZ N < 'N' EST-IL NUL ???
JNE PASNZ < NON...
CPZ INDFI < OUI, EST-ON SOUS 'FI' ???
JE AUTOF1 < NON, ON FAIT DONC (N)=1.
JANE AUTOF1 < OUI, MAIS 'N' ETAIT ABSENT...
LA FIRCAR < OUI, ON VA FAIRE :
< (N)='FIRCAR', ET
< (M)='LASCAR'...
JAGE AUTOF2 < OK, IL Y A UNE PREMIERE CARTE...
LA ADRSEQ < ERREUR, ELLE N'EXISTE PAS...
BR MERR
AUTOF2: EQU $
STA N < (N)='FIRCAR',
LA LASCAR
STA M < (M)='LASCAR'.
JMP PASNZ
AUTOF1: EQU $
IC N < ON N'EST PAS SOUS 'FI' : (N)=1...
PASNZ: EQU $
LA M < (A)='M' ON NE SAIT JAMAIS...
RSR
PAGE
<***********************************************************************
<* *
<* RECOPIE DE NVPF SUR NVPT DE W CARTES *
<* *
<***********************************************************************
SPRCOP: EQU $
STZ VATRA1
RCOP2: EQU $
CPZR W < FIN DE COPIE?
JLE RCOP3
BSR RLCT < NON - LIRE
JANE RCOP1 < FIN DE FICHIER?
BSR ECRT < NON - ECRIRE
ADRI -1,W < CARTE SUIVANTE
JMP RCOP2
RCOP1: EQU $
IC VATRA1
RCOP3: EQU $
RSR
<***********************************************************************
<* *
<* LECTURE DE NVPF JUSQU'A N *
<* *
<***********************************************************************
SPRLIR: EQU $
DC N < RENDU A N?
CPZ N
JLE RLIR1
BSR RLCT < NON - LIRE
JAE SPRLIR
RLIR1: EQU $
RSR
<***********************************************************************
<* *
<* POSITIONNEMENT DES ADRESSES DE BUFFERS *
<* *
<***********************************************************************
SPPOSB: EQU $
LA ABFSGI < @ BUFFER ENTREE
SLLS 1
STA READF+1
LA ABFSGO < @ BUFFER SORTIE
SLLS 1
STA WRITET+1
RSR
PAGE
<***********************************************************************
<* *
<* SP DE RELEVE DE N. *
<* *
<***********************************************************************
SPRE1N: EQU $
BSR NOMB < RELEVER N+1 POUR INSERER
ADRI 1,A
JMP CPNC
SPRELN: EQU $
BSR NOMB < RELEVE LE NOMBRE EN POSITION 2
CPNC: EQU $
CP NOCAR < ERREUR SI NOCAR>N
JGE RETN
KOMP10: EQU $
LA ADRSEQ
BR MERR
RETN: EQU $
STA N
CPI 1
JE KOMP9 < '0' DEMANDE...
LA SSEDIT
CPI 2 < SI SUPERIEUR A '0', ON REGARDE
< ALORS S'IL S'AGIT DE 'KO' ???
JE KOMP10 < OUI, REFUSE...
LA N < RESTAURE 'A'...
KOMP9: EQU $
RSR
PAGE
<***********************************************************************
<* *
<* SP DE RELEVE DE M. *
<* *
<***********************************************************************
SPRELM: EQU $
LBY &ADBFEN < CHERCHER LE TIRET
CPI "-"
JE RELEVM
CPI " " < SAUTER LES BLANCS
JNE PASVM
JIX SPRELM
PASVM: EQU $
LA N < PAS DE TIRET, M=N
STA M
RSR
RELEVM: EQU $
BSR NOMB < RELEVER LE NOMBRE
CP N < ERREUR SI N>M
JGE RETM
LA ADRSEQ
BR MERR
RETM: EQU $
STA M
RSR
PAGE
<***********************************************************************
<* *
<* SP DE LECTURE DU FICHIER NVPF. *
<* *
<***********************************************************************
SPLECF: EQU $
BSR RLCT < LIRE UNE CARTE
JANE ERLECF < FIN DE LECTURE
IC NOCAR < NOCAR=NOCAR+U
RSR < A=0 : PAS FIN DE FICHIER.
ERLECF: EQU $
CPZ N < POSITIONNEMENT EN FIN DE FICHIER ???
JGE ZZ001 < NON, DONC ERREUR...
LY NOCAR < OUI, DONC NOCAR
STY N < REMPLACE N (ASTUCE...).
RSR < A#0 : FIN DE FICHIER.
ZZ001: EQU $
LA ADRSEQ < ERREUR SI MANQUE DE CARTES
BR MERR
PAGE
<***********************************************************************
<* *
<* SP DE LECTURE D'UNE CARTE SUR NVPF. *
<* *
<***********************************************************************
SPRLCT: EQU $
CPZ ENFILE < FIN DE FICHIER DEJA TROUVEE?
JNE ENDF < OUI
LX INDIN < FIN DE SECTEUR
LBY &ABSGII
CPI 'FF
JNE PLDSF
LAD READF < OUI - RELIRE UN SECTEUR
SVC 0
JNE ENDF
CPZ &ABFSGI
JL ENDF
LXI 0
PLDSF: EQU $
LR X,Y < INDEX DEBUT CARTE
LBI 0
REVFE: EQU $
LBY &ABSGII < TRANSFERER LE CARACTERE
XR X,B
STBY &ADBFCO
ADRI 1,X
XR X,B
ADRI 1,X
CPI 'FE
JE FINLEC
JMP REVFE
FINLEC: EQU $
SBR X,Y
NGR Y
STX INDIN < SAUVER L'INDEX DANS BUFFER
LAI 0 < PAS FIN DE FICHIER
LR Y,B < LONGUEUR CARTE DANS B
RSR
ENDF: EQU $
IC ENFILE
LAI 1 < FIN DE FICHIER
RSR
PAGE
<***********************************************************************
<* *
<* SP D'ECRITURE D'UNE CARTE SUR NVPT. *
<* *
<***********************************************************************
SPECRT: EQU $
LX PLACT < Y-A-T'IL DE LA PLACE DANS BUFFER
CPR X,B
JL PLDST
NGR X < NON - PLACER FIN DE SECTEUR
LAI 'FF
STBY &ABSGOF
BSR AWRITE < ECRITURE SGF.
LX LUTBUF
PLDST: EQU $
LR X,Y < CALCUL DE LA NOUVELLE PLACE
SBR B,Y
STY PLACT
NGR X < DEPLACER LA CARTE
LYI 0
ATPLCM: EQU $
XR X,Y
LBY &ADBFCO
ADRI 1,X
XR X,Y
STBY &ABSGOF
ADRI 1,X
ADRI -1,B
CPZR B
JG ATPLCM
RSR
PAGE
<***********************************************************************
<* *
<* SP D'INITIALISATION DE LA NUMEROTATION. *
<* *
<***********************************************************************
SPININ: EQU $
LXI 7 < LE NOMBRE EST DANS A
LR A,B
NEWCHF: EQU $
LAI 0 < DIVISER PAR DIX
DV DIX
XR A,B
ORI '30 < PLACER LE CARACTERE
STBY &ADNOLS
CPZR B < EST-CE FINI?
JE FINCHF
JDX NEWCHF
FINCHF: EQU $
LAI " " < COMPLETER AVEC DES BLANCS
RECHF: EQU $
JDX NWBL
STBY &ADNOLS
RSR
NWBL: EQU $
STBY &ADNOLS
JMP RECHF
<***********************************************************************
<* *
<* SP D'INCREMENTATION DE LA NUMEROTATION. *
<* *
<***********************************************************************
SPINCN: EQU $
LXI 7
REPSUI: EQU $
LBY &ADNOLS
CPI " "
JNE NOBLAN
LAI "1"
JMP PASREP
NOBLAN: EQU $
ADRI 1,A
CPI "9"
JLE PASREP
LAI "0"
STBY &ADNOLS
ADRI -1,X
JMP REPSUI
PASREP: EQU $
STBY &ADNOLS
RSR
PAGE
<***********************************************************************
<* *
<* SP DE RELEVE D'UN NOMBRE. *
<* *
<***********************************************************************
SPNOMB: EQU $
EORR W < NOMBRE=0
LBI 1 < ET ABSENT A PRIORI
STB VATRA1
DEBNB: EQU $
JIX VOICHI
FINCH: EQU $
XR A,W < RESULTAT DANS A
CPZ VATRA1 < NOMBRE TROUVE ???
JE FINCHR < OUI...
LA NPREC < NON, ON PREND LE PRECEDENT...
FINCHR: EQU $
STA NPREC < ET SAVE LE NOMBRE COURANT...
RSR
VOICHI: EQU $
LBY &ADBFEN < CHERCHER LE 1ER CHIFFRE
CPI " " < SAUTER LES BLANCS
JE DEBNB
NEWCH: EQU $
LBY &ADBFEN
CPI "0"
JL FINCH
CPI "9"
JG FINCH
STZ VATRA1 < PRESENT
ANDI 'F < RELEVER LE CHIFFRE ET PASSER
XR A,W < AU SUIVANT
MP DIX
ADR B,W
JIX NEWCH
JMP FINCH
<
< IDEM AVEC 0 PAR DEFAUT :
<
SPNOMC: EQU $
BSR NOMB < RECUPERATION DU NOMBRE :
CPZ VATRA1 < EST-IL PRESENT ???
JE NOMC1 < OUI...
LAI 0 < NON, 0 PAR DEFAUT...
NOMC1: EQU $
RSR
PAGE
<***********************************************************************
<* *
<* SP DE LECTURE D'UN BYTE POUR LE PUNCH COMPACTE. *
<* *
<***********************************************************************
SPLECB: EQU $
LBY &ABSGII
CPI 'FF < FIN DE SECTEUR?
JNE RETB
LAD READF < OUI - RELIRE UN SECTEUR
SVC 0
JNE FINLCB
CPZ &ABFSGI
JL FINLCB
LXI 0
JMP SPLECB
RETB: EQU $
ADRI 1,X
LR A,B < B=CARACTERE
LAI 0 < A=0 - OK
RSR
FINLCB: EQU $
LAI 1 < A=1 - FIN DE FICHIER
RSR
PAGE
<***********************************************************************
<* *
<* NUMEROTATION ET PUNCH D'UNE CARTE COMPACTEE. *
<* *
<***********************************************************************
SPNMPC: EQU $
XR X,Y < PLACER LE CARACTERE
STA &ABINEN
JIX PASECC
SPPUPC: EQU $
LA NOCCP < SI LE NUMERO DE LA CARTE EST
SARD 16
DV NUMCA
CPZR B < 'NOCCP' DIVISIBLE PAR 'NUMCA' ???
JNE PASSPC < NON, ON PUNCHE...
STZ PUCCOM
CPZ BATCH < BATCH OU VISU ???
JNE PASSPC < BATCH...
CPZ INDFI < EST-ON SOUS FI?
JNE PASSPC < OUI,NE PAS ATTENDRE
LAD ECCRLF < LIRE UN CARACTERE
BSR ASPSIM
LAD LECPPC
BSR ASPSIM
LBY &ABFSGO < SI "S", SAUTER
CPI "S"
JNE PASSPC
IC PUCCOM
PASSPC: EQU $
IC NOCCP < INCREMENTER LA NUMEROTATION
CPZ PUCCOM < SAUTER EVENTUELLEMENT
JNE PASPCO
LXI -4 < MISE A ZERO ZONE NUMEROTATION
STZ &ABINEF
JIX $-1
LAI -1 < INDEX NUMEROTATION
LR A,W
LB NOCCP
NWNUMC: EQU $
LAI 0 < RELEVER LE DERNIER CHIFFRE
DV DIX
LR B,X
LR A,B
LAI 1 < CARACTERE A PERFORER
SLLS 13
SLRS 0,X
LR W,X < LE PLACER
STA &ABINEF
ADRI -1,X
LR X,W
CPZR B < FIN?
JNE NWNUMC
STZ CHEKSM < OUI - CALCUL DU CHECKSUM
LXI -76
RECHEK: EQU $
LA &ABINEN
ADRI 1,X
LB &ABINEN
SLRS 4
SLRD 4
EOR CHEKSM
EORR B,A
SWBR B
EORR B,A
STA CHEKSM
JIX RECHEK
LXI -4 < LE PLACER
LA CHEKSM < SI CHECKSUM=0 , ALORS =1
ANDI 'FF
JANE NNCHEK
ADRI 1,A
NNCHEK: EQU $
LR A,B
SLLD 8
RECK1: EQU $
LAI 0
SLLD 2
SLLS 14
OR &ABINEF
STA &ABINEF
JIX RECK1
PUPUCO: EQU $
LA ABINED < PUNCH DE LA CARTE
SLLS 1
IF ORDI-"S",X103,,X103
STA DEMPCK+1 < ADRESSE DE LA CARTE EN BINAIRE,
LAD DEMPCK
SVC 0 < QUE L'ON PUNCHE D'UN COUP...
X103: VAL 0
IF ORDI-"T",X103,,X103
LR A,B
LXI 80
NWPCCO: EQU $
STB DEMPCH+1
PSR X
LAD DEMPCH
SVC 0
PLR X
ADRI 2,B
JDX NWPCCO
X103: VAL 0
LAD SLEEP
SVC 0
PASPCO: EQU $
LXI -76
PASECC: EQU $
XR X,Y
RSR
PAGE
<***********************************************************************
<* *
<* SP D'APPEL AU CCI. *
<* *
<***********************************************************************
SPCCI: EQU $
SLLS 1 < @ OCTET DU MESSAGE
STA CCII+1
LAD CCII
SVC 0
RSR
PAGE
<***********************************************************************
<* *
<* SP D'ECRITURE D'UN MESSAGE D'ERREUR. *
<* *
<***********************************************************************
MSGERR: EQU $
LR A,W < @ OCTETS DU MESSAGE
ADR A,A
ADRI 1,A
STA ECRERR+1
LBY 0,W < LONGUEUR DU MESSAGE
STA ECRERR+2
LAD ECRERR < ECRIRE LE MESSAGE
SVC 0
LR W,A < RETOUR SI ERREUR EN COMPACTE
CP ADRLIR
JNE ERRNOR
RSR
ERRNOR: EQU $
LAD KSTORE-1 < RESTAURER L'INDEX DE PILE
LR A,K
CPZ SSEDIT < NE SERAIT-CE PAS UN "KO" EN COURS
< D'ANALYSE ("KO'FICHIER'") ???
JGE MSGER2 < NON...
STZ SSEDIT < ET OUI, ON ANNULE 'ED'...
MSGER2: EQU $
CPZ INDFI < EST-ON SOUS FI
JE MSGER1 < NON
LA LSRE < EDITION MESSAGE RC?
CPI 3
JE MSGER1 < OUI
STZ SSEDIT < OUI,SORTIE DE ED
STZ INDFI < SORTIE DE FI
STZ CR1
BSR ACLOSE < FERMETURE FICHIER
LA ACLFI < FERMETURE FICHIER FI
BSR ASPCCI
LA CRLFPL
STA CRLF < RESTAURATION DU +
MSGER1: EQU $
BR ADCOM < AUTRE COMMANDE
<
<
< E D I T I O N D ' U N M E S S A G E :
<
<
PRINT: EQU $
LR A,W < W=BASE DU MESSAGE.
SLLS 1
ADRI 1,A < A=ADRESSE OCTETS DU MESSAGE.
STA ECRERR+1
LBY 0,W < A=LONGUEUR DU MESSAGE.
STA ECRERR+2
LAD ECRERR
SVC 0 < EDITION DU MESSAGE...
RSR
PAGE
<
<
< T A I L L E :
<
<
XWOR%1: VAL $-ZERO*2
SIZED: EQU ZERO+XWOR%1
NDS
END
Copyright © Jean-François COLONNA, 2022-2024.
Copyright © CMAP (Centre de Mathématiques APpliquées) UMR CNRS 7641 / École polytechnique, Institut Polytechnique de Paris, 2022-2024.