<
< D U M P
<
IDP "DUMP"
IDP "P. FRANCONNET"
ORDI: VAL "@"
IF ORDI-" ",XWOR%1,,XWOR%1
ORDI: VAL "T"
XWOR%1: VAL 0
IF ORDI-"T",XWOR%1,,XWOR%1
IDP "VERSION T1600"
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
IDP "VERSION SOLAR"
XWOR%1: VAL 0
IDP "RELEASE 13 - 16/12/80"
PAGE
TABLE
ZERO: EQU $
DZS '10 < POUR CMS4
DIALOG: VAL 0 < DIALOGUE DUMP/REST POUR SORTIE VISU.
< CETTE VARIABLE INDIQUE SI LE PROGRAMME
< A OU NON L'INITIATIVE DU DIALOGUE.
< POUR L'INSTANT, C'EST LE PROGRAMME
< EXECUTE SUR LE SOLAR QUI A L'INITIATIVE.
< DONC DIALOG EST FONCTION DE 'ORDI'.
<
< DIALOG=1 LE PROGRAMME A L'INITIATIVE.
< DIALOG=0 LE PROGRAMME N'A PAS L'INI-
< TIATIVE.
IF ORDI-"S",XWOR%1,,XWOR%1
DIALOG: VAL 1
XWOR%1: VAL 0
IF ORDI-"T",XWOR%1,,XWOR%1
QUANTA: VAL 1 < NOMBRE DE SECTEURS PHYSIQUES
< POUR 1 SECTEUR LOGIQUE (SGF)
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
QUANTA: VAL 3 < NOMBRE DE SECTEURS PHYSIQUES
< POUR 1 SECTEUR LOGIQUE (SGF)
XWOR%1: VAL 0
<
LPAP: VAL 128 < LONG PAGE VIRTUELLE SI PUNCH
<
LPAF: VAL QUANTA*128-1 < LONGUEUR PAGE VIRTUELLE SI FICHIER
IF ORDI-"S",XWOR%1,,XWOR%1
LPAD: VAL QUANTA*128-1 < LONGUEUR PAGE VIRTUELLE SI DKU
< LE 1ER MOT SERT A NUMEROTER LES BLOCS
< S'IL VAUT -1,LE BLOC EST INVALIDE
< ET LE DUMP EST FINI
< S'IL VAUT -2,LE BLOC EST INVALIDE
< ET LE DUMP CONTINUE SUR LE SUIVANT
<
< PARAMETRES "MEMOIRE COMMUNE" (CDA).
<
ADDCDA: VAL 0 < ADRESSE DEBUT DE LA ZONE CDA
< A UTILISER.
LCDAD: VAL '8000-1-ADDCDA+1 < LONGUEUR (MOTS) DE LA ZONE CDA
< DISPONIBLE.
LPAM: VAL 512-1 < LONGUEUR MOTS PAGE VIRTUELLE SI
< MEMOIRE COMMUNE (CDA); UN VERROU + UNE
< PAGE VIRTUELLE FERONT DONC UN COMPTE
< ROND...
XWORK: VAL LPAM+1 < LONGUEUR PAGE VIRTUELLE + VERROU ASSOCIE.
XWORK: VAL LCDAD/XWORK
IF XWORK,,XWOR%2,XWOR%2
XWORK: VAL -XWORK < RENDRE XWORK POSITIF.
XWOR%2: VAL 0
IF XWORK-1,,,XWOR%2
IF ERREUR : IL FAUT AU MOINS DEUX BUFFERS EN CDA.
XWOR%2: VAL 0
NBVER: VAL XWORK < NOMBRE DE VERROUS ( = NOMBRE DE BUFFERS
< EN CDA).
XWOR%1: VAL 0
LBUFV: VAL 50 < LONGUEUR MOTS BUFFER VISU
LPAV: VAL LBUFV*8 < LONGUEUR MOTS PAGE VIRTUELLE SI DUMP
< SUR LIGNE VISU. IL Y AURA DONC 16 BUFFERS
< VISU PAR PAGE VIRTUELLE.
NBCOL: VAL 80 < NOMBRE DE COLONNES CARTE
< ATTENTION,CE N'EST PAS UN PARAMETRE
NBPAUS: VAL 128 < NB DE CARTES AVANT PAUSE POUR
< RECHARGEMENT EVENTUEL
IF NBPAUS-255,XWOR%1,XWOR%1,
IF E R R E U R !!!
IF NBPAUS STANDARD EST EXPLOITE PAR LOAD IMMEDIAT,
IF DONC, IL DOIT ETRE <= 255.
IF POUR UN NOMBRE PLUS GRAND, L'UTILISATEUR A LA
IF POSSIBILITE D'UTILISER L'OPTION NON-STANDARD
IF A L'EXECUTION.
XWOR%1: VAL 0
ACK: VAL "K" < 'OK' : CARACTERE DE SYNCHRONISATION
< AVEC LA VISU RECEPTRICE
SYNC: VAL "S" < CARACTERE DE RE-SYNCHRONISATION
< EN CAS DE "REPRISE" VISU.
NSPDAT: VAL '6A < NSP D'ACCES A LA DATE.
NSPESC: VAL '57
NSPSTN: VAL '13
X123X: VAL '15-NSPSTN
NSPDK1: VAL '23
IF ORDI-"S",XWOR%1,,XWOR%1
NSPDKA: VAL '22 < DISQUE VIRTUEL FIXE
NSPDKB: VAL NSPDKA-1 < DISQUE VIRTUEL AMOVIBLE
XWOR%1: VAL 0
LNOM: VAL 27 < LONGUEUR MAX NOM EN MOTS
VAR: VAL '33
IF ORDI-"S",XWOR%1,,XWOR%1
VAR: VAL '35
XWOR%1: VAL 0
CLEFS: VAL '10
IF ORDI-"S",XWOR%1,,XWOR%1
NB1DKU: VAL '1000+3-1/3*0 < NUMERO DU 1ER BLOC POSSIBLE SUR DKU
< (ON SE RESERVE DE QUOI STOCKER LE
< CONTENU DU DK FIXE, SOIT '1000 SECTEURS
< EN QUANTA 1);
< MAIS ATTENTION : PLUS UTILISE !!!
NBFDKU: VAL 'FA00-1 < ET DU DERNIER
IF NBFDKU,,XWOR%2,XWOR%2 < LE DERNIER DOIT ETRE<'FA00
IF NBFDKU-'FA00,XWOR%2,,
IF LE DERNIER BLOC POSSIBLE SUR DKU
IF DEPASSE LA LIMITE PHYSIQUE DU DISQUE
XWOR%2: VAL 0
IF NB1DKU)NBFDKU,XWOR%2,, < SI LE DEBUT ET LA FIN SONT
< DE MEME SIGNE
IF NBFDKU-NB1DKU,,XWOR%2,XWOR%2 < IL FAUT DERNIER>=1ER
IF LE NUMERO DU DERNIER BLOC
IF EST INFERIEUR AU NUMERO DU PREMIER
XWOR%2: VAL 0
IF NB1DKU)NBFDKU,,XWOR%2,XWOR%2 < S'ILS SONT DE SIGNE
< DIFFERENT
IF NBFDKU,XWOR%2,, < LE DERNIER DOIT ETRE NEGATIF
IF LE NUMERO DU DERNIER BLOC
IF EST INFERIEUR AU NUMERO DU PREMIER
XWOR%2: VAL 0
XWOR%1: VAL 0
PAGE
WORD DEB1
WORD DEB2
PROG
DEB1: EQU $
LRP L
BR -1,L
<
TABLE
PILE: DZS 40 < PILE POUR K
<
IF ORDI-"S",XWOR%1,,XWOR%1
BFDKU: DZS 128*QUANTA < BUFFER DKU DE RELECTURE
XWOR%1: VAL 0
<
BFI: EQU $ < BUFFER IMPRIMANTE
BFI1: DZS 2 < ADRESSE COURANTE
ASCI " " < 4 ESPACES.
BFIH: DZS 8+1*8/2 < CARACTERES HEXA CODES ASCI:
< 8 MOTS PAR LIGNE,
< 8 CARACTERES PAR MOT,
< PLUS LES ESPACES.
WORK: EQU BFIH < ZONE DE TRAVAIL EN RECOUVREMENT
< SUR BFIH ! ATTENTION...
BFIFCH: EQU $ < FIN DES CARACTERES HEXA CODES ASCI.
ASCI " " < 8 ESPACES.
BFIASC: DZS 4+0*8/2 < CARACTERES ASCI, IMAGE DES CARACTERES
< HEXADECIMAUX.
< (+0 AFIN DE NE PAS LAISSER DE "SPACE"
< ENTRE CHAQUE MOT...)
BFIF: EQU $ < BFI FIN
WORD '0D0A < RETURN / LINE FEED.
<
BP: DZS NBCOL < BUFFER PUNCH
BPF: EQU $ < FIN BP
<
XWOR%1: VAL BP-ZERO
XWOR%2: VAL $-ZERO
$EQU ZERO+XWOR%1
BV: DZS LBUFV < BUFFER VISU RECEPTRICE: IL RECOIT
< DES CARATERES ASCI.
BVF: EQU $ < FIN BUFFER VISU
LBV: VAL BVF-BV < LONGUEUR MOTS BUFFER VISU
$EQU ZERO+XWOR%2
BYTE '0;'6D
NOM: DZS LNOM+1 < NOM EN COURS (PRUDENCE)
BYTE '04 < POUR RECHERCHE EOT
IF ORDI-"S",XWOR%1,,XWOR%1
BYTE 0;"!";0;'6D
ACN: DZS 2 < ACN COURANT.
ACNF: EQU $
BYTE '04;'04 < POUR RECHERCHE EOT (LE 1ER EOT PEUT
< ETRE ECRASE A LA SAISIE DE LA RACINE).
XWOR%1: VAL 0
<
<
< MESSAGES A ENVOYER PAR LE S/P 'ENVOI'
<
M: EQU $+256
MSTAND: BYTE '6D;"S"
ASCI "TANDARD?"
WORD 0
MDSB: BYTE '6D;"D"
ASCI "/S/E/B/X?"
WORD 0
MDEL: BYTE '6D;'07;'07;'07
ASCI "DUMP & DELETE !"
WORD 0
MDPF: BYTE '6D;'07;'07;"D"
ASCI "K,PARC,FIN ?"
WORD 0
MHEXA: BYTE '6D;"H"
ASCI "EXA?"
WORD 0
MQDK: BYTE '6D;"D"
BYTE "K";0
MAS: BYTE '6D;"A"
BYTE "S";0
MNS: BYTE '6D;"N"
BYTE "S";0
MPAS: BYTE '6D;"P"
ASCI "AS A PAS ?"
WORD 0
MRAC: BYTE '6D;"R"
ASCI "ACINE>"
WORD 0
IF ORDI-"S",XWOR%1,,XWOR%1
MFIN: BYTE '6D;"F";"I";"N";"?";0
MRACA: BYTE '6D;"R"
ASCI "AC.ACN>"
WORD 0
XWOR%1: VAL 0
MAPD: BYTE '6D;"A"
ASCI " PARTIR DE "
WORD 0
MPBAS: BYTE '6D;" "
ASCI "DEJA ASSIGNE!"
WORD 0
MQ: BYTE " ";" ";"?";0
IF ORDI-"T",XWOR%1,,XWOR%1
MULB: BYTE '6D;"S"
ASCI "UR IMP,OUTPUT,CARTES,FICH,VISU (I/O/C/F/V)?"
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
MULB: BYTE '6D;"S"
ASCI "UR I/O/C/F/V/D/M/T ?"
WORD 0
MINIT: BYTE '6D;"I"
ASCI "NITIALISER?"
XWOR%1: VAL 0
WORD 0
MFICH: ASCI " FICHIER="
WORD 0
MQV: ASCI " VI"
WORD 0
IF ORDI-"S",XWOR%1,,XWOR%1
MASD: BYTE '6D;"A" < ADRESSE DEBUT DKU
ASCI "DEB="
WORD 0
MASF: BYTE '6D;"A" < ADRESSE FIN DKU
ASCI "FIN="
WORD 0
MCLEF2: BYTE '6D;"C"
ASCI "LEF ON"
WORD 0
MCLEF1: BYTE '6D;"C"
ASCI "CLEF="
WORD 0
MERDK: BYTE '6D;"F" < ERREUR DKU
ASCI "IN ZONE DKU"
WORD 0
MSTDKU: BYTE '6D;"C"
ASCI "ONTINU?"
WORD 0
XWOR%1: VAL 0
MIMP: BYTE " ";"?";"?";0
MNBOCT: BYTE '6D;"N";"B";"O";"C";"T";"=";0
< PROPOSITION NOMBRE D'OCTETS EN MODE
< NON-STANDARD.
<
MNBPAU: BYTE '6D;"P" < PROPOSITION NOMBRE DE CARTES PAR
ASCI "AQUET=" < PAQUET EN MODE NON-STANDARD.
WORD 0
MCART: BYTE '6D;">"
WORD 0
MDEBUG: BYTE '6D;"D" < PROPOSITIONS DE DEBUG DK
ASCI "EBUG?"
WORD 0
MRECHE: BYTE '6D;"R"
ASCI "ECHERCHE?"
WORD 0
MPASEC: BYTE '6D;"P"
ASCI "AS AD DK="
WORD 0
MCHAIN: BYTE '6D;"C"
ASCI "HAINE="
WORD 0
MCHAIX: BYTE '6D;"H"
ASCI "EXA="
WORD 0
MPBACK: BYTE '6D;"E"
ASCI "RREUR SYNCHRO"
WORD 0
MTMPO: BYTE '07;'0D;'07;0 < MESSAGE DE TEMPORISATION
< (CLOCHE ET RETURN...)
IF ORDI-"S",XWOR%1,,XWOR%1
MTOUS: BYTE '6D;"V"
ASCI "ERS T OU S ?"
WORD 0
MQFS: BYTE '6D;"Q";"F";"S";"=";0
< QUANTA DU FICHIER DE SAUVEGARDE ?
MQDK2: BYTE '6D;"Q";"D";"K";"=";0
< QUANTA A UTILISER SUR DK2
XWOR%1: VAL 0
MCOMPA: BYTE '6D;"C"
ASCI "OMPACTAGE?"
WORD 0
MDATE: BYTE '6D;"D"
ASCI "ATE?"
WORD 0
MACN: BYTE '6D;"A";"C";"N";"?";0
<
< MESSAGES AUTRES
<
MSKIP: BYTE "@";'0D < SAUT DE PAGE
MSPI: WORD '0D0A < SAUT DE LIGNE
MACK: BYTE ACK+'80;0 < 'ACK' VERS VISU RECEPTRICE
MNI: WORD '0D0A
ASCI "NOM INT= '"
MNI1: DZS 2
MNIF: WORD '0D0A < FIN MNI.
<
MTIK: WORD '0D0A < TITRE KEY SUR IMPRIMANTE/VISU
ASCI "K:"
ASCI " N1'"
MTIK1: DZS 2 < N1 EN ETENDU
ASCI " N2'"
MTIK2: DZS 2 < N2 EN ETENDU
MTIKF: WORD '0D0A < FIN MTIK.
<
MDBG: BYTE '6D;"A";"S";"'" < MESSAGE DE DEBUG BUFFERS DK.
MDBGAS: DZS 2 < ADRESSE DU SECTEUR COURANT
ASCI " ABUF'"
MDBGAB: DZS 2 < ADRESSE DU BUFFER DK
MDBGF: EQU $ < FIN DU MESSAGE
IF ORDI-"S",XWOR%1,,XWOR%1
MDRBL: BYTE '6D;'84;" ";"L"
ASCI "AST USED BLOCK= "
DRBL: DZS 2
WORD 0
MDKUP: BYTE '6D;"W"
ASCI "RITE PROTECTED!"
WORD 0
MCDA: ASCI "!CDA"
BYTE '04
FMCDA: EQU $
XWOR%1: VAL 0
MNHE: BYTE '6D;00
NHE: DZS LNOM+1*2 < NOM EN HEXA CODE ASCI.
<
<
< TABLES POUR PUNCH
<
MSK1: BYTE 'FF;'E0;'FC;'FF;'80;'F0;'FE;'FF;'C0;'F8;'FF
SHF1: BYTE 8;0;16-3;16-6;2;16-1;16-4;16-7;1;16-2;16-5
SHF2: BYTE 0;5;2;0;7;4;1;0;6;3;0
IF ORDI-"S",XWOR%1,,XWOR%1
LOGSY: ASCI "!L :SY"
BYTE "S";'04
LOGSYF: EQU $
XWOR%1: VAL 0
ASS: ASCI "!ASSIGN " < ASSIGNATION/DESASSIGNATION
COMMON < ATTENTION ! NE PAS INSERER EN TETE DU
< DU COMMON SANS PRECAUTIONS...(CF:
< 'ASS', 'ASSUL', 'ASS1', ETC...)
COM: EQU $
ASSUL: ASCI "0=" < UL
ASS1: DZS 1
ASS2: DZS LNOM+1
BYTE '04
ASS3: BYTE "S";'04
ASS4: ASCI "O,"
IF ORDI-"T",XWOR%1,,XWOR%1
ASS5: BYTE "R";'04
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
ASSMT: BYTE "M";"T";"1";'04
ASSD: ASCI "D-"
XWOR%1: VAL 0
ASSN: ASCI "N,"
ASS6: BYTE "L";"P";"1";'04
ASS7: BYTE "O";'04
ASS8: ASCI "CU"
ASS81: BYTE "1";'04
ASS82: BYTE "2";'04
ASS9: ASCI "VI"
ASS91: BYTE "0";'04
SASS1: WORD 0 < SAUVEGARDE DE 'ASS1'...
ISTAND: WORD 0 < INDICATEUR MODE STANDARD :
< =0 MODE STANDARD.
< =1 MODE NON STANDARD.
DMSUBO: DZS 1 < DUMP/SUPPRESSION/BOF
< =0 BOF
< =1 DUMP
< =-1 SUPPRESSION
< =-2 EDITION.
IF ORDI-"T",XWOR%1,,XWOR%1
PASPAS: DZS 1 < INDICATEUR DE PAS A PAS
< =0 AUTOMATIQUE
< =1 PAS A PAS
XWOR%1: VAL 0
TYPDMP: DZS 1 < TYPE DE DUMP
< =0 IMPRIMANTE/OUTPUT
< =-1 PERFORATEUR
< =1 FICHIER
< =2 LIGNE VISU
IHEXA: DZS 1 < INDICATEUR HEXADECIMAL (EDITION DES
< NOMS EN HEXA) :
< = 0 : NON,
< = 1 : OUI.
< ATTENTION: CET INDICATEUR EST "RECOUVERT" PAR 'IDEBUG'.
IF ORDI-"S",XWOR%1,,XWOR%1
< =3 DKU
IACN: DZS 1 < INDICATEUR ACN'S / NOMS :
< = 0 : ON TRAVAILLE SUR L'ACN COURANT
< = 1 : ON EXPLORE LES ACN'S.
INACN: DZS 1 < INDICATEUR "NOUVEL ACN": ON VIENT DE
< PASSER D'UN ACN A UN AUTRE (QUI PEUT
< ETRE LE MEME...):
< = 0 : ACN COURANT,
< = 1 : "NOUVEL" ACN.
IAUTOM: DZS 1 < INDICATEUR DUMP ACN'S AUTOMATIQUE :
< = 0 : NON AUTOMATIQUE.
< = 1 : AUTOMATIQUE, C'EST-A-DIRE QUE
< POUR CHAQUE ACN, ON FERA UN DUMP DE
< TOUT SON SOUS-CATALOGUE SYSTEMATIQUE-
< MENT. CET INDICATEUR EST POSITIONNE
< A CHAQUE FOIS QU'EST POSEE LA QUESTION
< "PAS A PAS" CONCERNANT LE PARCOURS DES
< ACN'S (REPONSE "A" = AUTOMATIQUE).
IDSC: DZS 1 < INDICATEUR DUMP SOUS-CATALOGUE EFFECTUE
< = 0 : NON EFFECTUE.
< = 1 : EFFECTUE.
< N'EST UTILISE QUE SI 'IAUTOM' EST A 1
< (CF CI-DESSUS).
XWOR%1: VAL 0
LNC: DZS 1 < LONGUEUR OCTETES NOM EN COURS (EOT
< INCLUS)
IQNOM: DZS 1 < QUOI FAIRE SUR LE NOM?
< =0 RIEN
< =1 DUMP
< =-1 SUPPRESSION
IDEL: WORD 0 < 0 : DUMP SI DUMP,
< 1 : DUMP & DELETE SI DUMP.
INDFI: DZS 1 < INDICATEUR FICHIER OU ITEM
< =0 ITEM
< =1 FICHIER (ASSIGNE A L'UL 3)
< =-1 FICHIER NON ASSIGNABLE
IF ORDI-"S",XWOR%1,,XWOR%1
IDMPNC: WORD 0 < INDICATEUR DE DUMP DU NOM EN COURS:
< = 0 : IL N'Y A PAS EU DE DUMP.
< = 1 : IL Y A EU DUMP.
< (UTILISE EN CAS DE DUMP DKU MULTIPLE
< SUR SOLAR)
XWOR%1: VAL 0
IDEBUG: EQU IHEXA < INDICATEUR DEBUG DEMANDE SUR LES
< BUFFERS DK:
< = 1 : DEBUG DEMANDE
< = 0 : SINON.
< (NOTER LE RECOUVREMENT AVEX 'IHEXA').
IPRDM: DZS 1 < INDICATEUR 1ER DUMP
< =0 OUI =1 NON
IPRW1P: DZS 1 < INDIC 1ER WRITE 1 CAR SUR PAGE VIRT
< =0 : OUI / =1 : NON
IPRWPG: DZS 1 < INDIC PREMIER WRITE DE PAGE
< =0 : OUI
< =1 : NEME WRITE
< =-1: DERNIER WRITE
IF ORDI-"T",XWOR%1,,XWOR%1
STOP: DZS 1 < STOP PARCOURS DEMANDE PAR
< L'UTILISATEUR
XWOR%1: VAL 0
IPCH: DZS 1 < INDICATEUR PUNCH ACTIF
< =0 ACTIF #0 INACTIF
<
MT: WORD '0D0A < TITRE SUR IMPRIMANTE/VISU
MTFI: DZS 4 < ITEM/FICHIER
MTN: DZS LNOM+1 < NOM EN COURS (PRUDENT)
MTI: ASCI "ITM:" < "ITEM"
MTF: ASCI "FIC:" < "FICHIER"
<
IF ORDI-"T",XWOR%1,,XWOR%1
XRAC: DZS 1 < INDEX INITIAL (PARCOURS)
SXRAC: DZS 1 < AUTRE X INITIAL
XWOR%1: VAL 0
NINT: DZS 1 < NOM INTERNE FICHIER
IF ORDI-"S",XWOR%1,,XWOR%1
ADKU1: WORD NB1DKU < 1ER BLOC POSSIBLE SUR DKU
ADKU2: WORD NBFDKU < ET DERNIER
ADKUD: DZS 1 < 1ER BLOC OU DUMPER SUR DKU
ADKUF: DZS 1 < ET DERNIER
N0BDKU: DZS 1 < NUMERO DU BLOC DUMPE SUR DKU
ADRBL: WORD DRBL-ZERO*2 < ADRESSE DERNIER BLOC UTILISE
<
< ATTENTION AU RECOUVREMENT 'NVC' / 'ADKUD'.
<
NBV: WORD NBVER < NOMBRE DE VERROUS.
NVC: EQU ADKUD < NUMERO DU VERROU COURANT (DE 0 A 'NBV'-1)
XWOR%1: VAL 0
LPP: WORD LPAP*2 < LONGUEUR PAGE VIRT SI PUNCH
IF LPAP-LPAV,,XWOR%1,
LPV: WORD LPAV*2 < LONGUEUR PAGE VIRT. SI LIGNE VISU
XWOR%1: VAL 0
LPF: WORD LPAF*2 < LONGUEUR PAGE VIRT. SI FICHIER
IF ORDI-"S",XWOR%1,,XWOR%1
LPD: WORD LPAD*2 < LONGUEUR PAGE VIRT. SI DKU
ADCDA: WORD ADDCDA < ADRESSE DEBUT ZONE CDA DISPONIBLE.
LPM: WORD LPAM*2 < LONGUEUR PAGE VIRT. SI MEM. COM.
< COMMUNE.
LMPM: WORD LPAM < LONGUEUR MOTS PAGE VIRTUELLE SI MEM. COM.
XWOR%1: VAL 0
NBSECT: WORD 0 < NOMBRE DE SECTEURS A DUMPER (DK)
<
NBOCT: WORD 0 < NOMBRE D'OCTETS A IMPRIMER POUR CHAQUE
< APPEL A 'EDI' ; UTILISE SI ON EST EN
< MODE NON STANDARD.
<
< RELAIS DIVERS
<
APILM1: WORD PILE-1 < PILE POUR K
AM: WORD M < POUR S/P ENVOI
AXNOM: WORD NOM,X < NOM EN COURS
IF ORDI-"T",XWOR%1,,XWOR%1
AXRAC: EQU AXNOM
XWOR%1: VAL 0
ANOM: WORD NOM < RELAI MOT SUR NOM COURANT.
AONHE: WORD NHE-ZERO*2 < RELAI OCTET SUR NOM COURANT
< EN HEXA CODE ASCI.
AXVAL: DZS 1 < NOM+VALEUR
AXASS2: WORD ASS2,X < POUR MOUVMT NOM
AXMTN: WORD MTN,X < IDEM
ALT: DZS 1 < POUR INFOS DEVANT VALEUR
AXMTFI: WORD MTFI+4,X < POUR TITRE SUR LP1
AXTRAV: WORD ZERO,X
AXBFI: WORD BFI,X < BUFFER IMPRIMANTE
AOBFI1: WORD BFI1-ZERO*2 < POUR EDITION IMPRIMANTE
AOFCH: WORD BFIFCH-ZERO*2 < FIN DES CARACTERES HEXA CODES ASCI
< DANS LE BUFFER IMPRIMANTE.
AOBUFF: DZS 1 < ADR OCTET BUFFER FICHIER
ABUFF: DZS 1 < ADR MOT BUFFER FICH
PBFI: DZS 1 < POINTEUR OCTET SUR BFI :
< POUR LES CARACTERES HEXA CODES ASCI.
PBFI2: DZS 1 < POINTEUR OCTET SUR BFI :
< POUR LES CARACTERES ASCI "IMAGE"
< DES CARACTERES HEXA CODES ASCI.
ADRC: DZS 1 < ADRESSE COURANTE (POUR
< EDITION IMPRIMANTE)
AOPAG: DZS 1 < ADRESSE OCTETS PAGE VIRTUELLE
AOFPAG: DZS 1 < ADR OCT FIN PAGE VIRTUELLE
AOCRIT: DZS 1 < ADRESSE CRITIQE POUR COMPACTAGE (FIN
< DE PAGE-2)
AOPAG2: WORD PAG2 < ADR OCT DEB PAGE SI FICHIER
AOPAG0: WORD PAG0 < ADR OCT DEB PAGE SI AUTRE
IF ORDI-"S",XWOR%1,,XWOR%1
ADPAG0: WORD FIN < ADR MOT DEB PAGE VIRTUELLE
XWOR%1: VAL 0
PPG: DZS 1 < POINTEUR OCT PAGE VIRTUELLE
CCMP: DZS 1 < COMPTEUR DE COMPACTAGE
PCMP: DZS 1 < "POINTEUR" DE COMPACTAGE(=ADR OCT
< DE STOCKAGE DE CCMP(8-15)
< EN PAGE VIRTUELLE)
AXBP: WORD BP,X < POUR BUFFER PUNCH
ABP: WORD BP < IDEM
AXBPM1: WORD BP-1,X < IDEM
ABPF: WORD BPF < FIN 72 1ERES COL BUFFER PUNCH
ACHECK: WORD BP+75 < ADRESSE CHECK CARTE
PBP: DZS 1 < POINTEUR BUFFER PUNCH
<
< ATTENTION AU RECOUVREMENT PBV/PBP
<
PBV: EQU PBP < POINTEUR BUFFER VISU
NBM11: DZS 1 < NUMERO MODULO 11
NUMC: DZS 1 < NUMERO CARTE EN COURS
NBMNP: DZS 1 < NUMERO CARTE MODULO NP PAUSE
< (CF: NBPAUS)
NPAUSE: WORD 0 < NOMBRE DE CARTES A PERFORER
< ENTRE CHAQUE PAUSE.
AXMSK1: WORD MSK1,X < TABLE PUNCH
AXSHF1: WORD SHF1,X < IDEM
AXSHF2: WORD SHF2,X < IDEM
SUI: WORD '6EC0 < INDICATEURS MOT SUIVANT BUFFER
< PUNCH
DIX: WORD 10
DIXMIL: WORD 10000 < POUR NUM CARTES MODULO 10000
IF ORDI-"S",XWOR%1,,XWOR%1
ACNSYS: ASCI ":SYS"
XWOR%1: VAL 0
IF ORDI-"T",XWOR%1,,XWOR%1
AWORK: WORD WORK < RELAI SUR ZONE DE TRAVAIL.
XWOR%1: VAL 0
<
< DEMANDES PAR SVC
<
DMGETM: WORD '0004 < GET MEMOIRE
REP: WORD 0 < REPONSE UTILISATEUR; ON LA MET
< DANS CE MOT INUTILISE PAR LE SVC
ESPACE: DZS 1 < ESPACE MEMOIRE
DMASS: WORD '0002 < ASSIGNATION/DESASSIGNATION
WORD ASS-ZERO*2
WORD ASS3-ASS*2
DMASDK: WORD '0003 < CONNEXION DKI
WORD '0300 < NVP ; NSPDKI
IF ORDI-"T",XWOR%1,,XWOR%1
DMRDK: WORD '0300 < READ DKI
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
DMRDK: WORD '0000 < EN SOLAR ON AURA UNE ASSIGNATION IMPLI-
< CITE OU EXPLICITE DE DK A DUMPER.
XWOR%1: VAL 0
WORD 0 < ADRESSE OCTET BUFFER
WORD 0 < LONGUEUR OCTET BUFFER
WORD 0 < ADRESSE SECTEUR
PASSEC: WORD 1 < PAS DE L'ADRESSE SECTEUR.
DMASNS: WORD '0101 < DEMANDE ADRESSE SECTEUR OU NB SECT
WORD BFIF-ZERO-2*2
WORD 4 < SUR 4 OCTETS
DMNBOC: EQU DMASNS < DEMANDE NOMBRE D'OCTETS A IMPRIMER
< EN MODE NON STANDARD.
DMNBPA: EQU DMASNS < DEMANDE DU NOMBRE DE CARTES PAR
< PAQUET EN MODE NON STANDARD.
DMREP: WORD '0101 < REPONSE UTILISATEUR
WORD REP-ZERO*2
WORD 1
DMREPF: WORD '0101 < NOM FICHIER POU DUMP
WORD ASS2-ZERO*2
WORD LNOM*2
DMOUT: WORD '0202 < ENVOI MESSAGE
DZS 1
DZS 1
IF ORDI-"T",XWOR%1,,XWOR%1
DMRAC: WORD '0101 < ENTREE RACINE
WORD NOM-ZERO*2
WORD 2*LNOM
SCATAL: BYTE 0;'02 < SGN
WORD NOM-ZERO*2
DZS 1
WORD -1 < DELTA=-1
XWOR%1: VAL 0
DMLON: WORD '8502 < SGN LOAD NAME
DZS 1
DZS 1
WORD -1 < DELTA=-1
DMCCI: WORD '0001 < RETOUR CCI
DMTI: WORD '0B02 < EDIT TITRE (IMPRIM/OUTPUT)
WORD MT-ZERO*2
DZS 1
DMNINT: WORD '0B02 < EDITION NOM INTERNE (IMPRIM/OUTPUT)
WORD MNI-ZERO*2
WORD MNIF-MNI*2+2
DMTIK: WORD '0B02 < EDIT TITRE-KEY (IMPRIM/OUTPUT)
WORD MTIK-ZERO*2
WORD MTIKF-MTIK*2+2
<
DMSKIP: WORD '0B02 < SAUT DE PAGE SUR LP1
WORD MSKIP-ZERO*2
WORD 2
DMSPI: WORD '0B02 < SAUT DE LIGNE LP1
< ENTRE 2 ITEMS 2 BLOCS...
WORD MSPI-ZERO*2
WORD 2
LOCAL
LOC: EQU $
DMIDK1: ASCI "DK"
BYTE " ";'0D
DMIDK: WORD '0B02 < SORTIR 'DKI'
WORD DMIDK1-ZERO*2
WORD 4
DMIAS: WORD '0B02 < SORTIR ADRESSE SECTEUR
WORD BFIF-ZERO-2*2
WORD 4+2 < +2 A CAUSE DE RETURN/LINE FEED
DMDBG: WORD '0202 < MESSAGE DE DEBUG BUFFER DK.
WORD MDBG-ZERO*2
WORD MDBGF-MDBG*2
DMLIG1: WORD '0B02 < EDITION PREMIERE PARTIE DE LA LIGNE
WORD BFI-ZERO*2 < SUR "OUTPUT" OU "LP1".
WORD BFIFCH-BFI*2
DMLIG2: WORD '0B02 < EDITION SECONDE PARTIE DE CETTE LIGNE.
WORD BFIFCH-ZERO*2
WORD BFIF-BFIFCH*2+2
DMOPN: WORD '0303 < SGF OPEN NEXT
DMCLS: WORD '0307 < SGF CLOSE SAVE
IF ORDI-"S",XWOR%1,,XWOR%1
DMOPOK: WORD '0305 < OPEN OLD KEY.
XWOR%1: VAL 0
KN1: WORD 0 < CLE EN COURS : N1.
KN2: WORD 0 < CLE EN COURS : N2.
DMREAD: WORD '0308 < SGF READ BLOC
DZS 1 < BUFFER FICHIER (FRONTIERE MOT!!)
WORD QUANTA*128*2
DMPCH: WORD '0B02 < PUNCH CARTE
DZS 1
WORD 2
DMTMPO: WORD '0005 < TEMPORISATION N SECONDES
BOX: WORD 0 < 'BOX'; ON LA MET DANS CE MOT INUTILISE
< PAR LE SVC
WORD 0
DMOPNK: WORD '0B04 < OPEN NEW KEY
WORD '0003 < N1
WORD '0000 < N2
DMWBLC: WORD '0B02 < WRITE BLOC
WORD PAG0
WORD QUANTA*128*2
DMCLSK: WORD '0B07 < CLOSE SAVE KEY
DMLVI: WORD '0B02 < ENVOI SUR LIGNE VISU
AOBV: WORD BV-ZERO*2
WORD LBV*2
DMRACK: WORD '0B00 < LECTURE DE L'ACK VISU RECEPTRICE
< (SANS ECHO)
WORD REP-ZERO*2
WORD 1
IF ORDI-"S",XWOR%1,,XWOR%1
DMWDKU: WORD '8A02 < WRITE SUR DKU
WORD PAG0
WORD QUANTA*128*2
DZS 1 < NUMERO DU BLOC
DMRDKU: WORD '8A00 < RELECTURE DE DKU
WORD BFDKU-ZERO*2
WORD QUANTA*128*2
DZS 1
STDKU: WORD 0 < 0 : LE DUMP SUR DKU EST FAIT EN CONTINU,
< 1 : CHAQUE ENTITE FAIT L'OBJET D'UN
< DUMP PARTICULIER.
DMOUTA: WORD '0202 < EDITION DE L'ACN.
WORD ACN-ZERO*2-1
WORD ACNF-ACN*2+1
DMLGN: WORD '0002 < DEMANDE DE LOGON.
WORD ACN-ZERO*2-3
WORD ACNF-ACN*2+4
DMLGSY: WORD '0002 < DEMANDE DE LOGON SOUS :SYS.
WORD LOGSY-ZERO*2
WORD LOGSYF-LOGSY*2
BYTE 0;"!";"L";" " < POUR LOGON SOUS ACN COURANT.
ACNC: DZS 2 < ACN COURANT.
BYTE '04 < EOT.
DMLGNC: WORD '0002 < LOGON SOUS ACN COURANT.
WORD ACNC-ZERO*2-3
WORD 8
DMCDA: WORD '0002 < !CDA
WORD MCDA-ZERO*2
WORD FMCDA-MCDA*2
XWOR%1: VAL 0
<
< RELAIS SOUS-PROGRAMMES
<
ADEB2: WORD DEB2 < ENTREE DANS DUMP
ARTCCI: WORD RTCCI < RETOUR CCI
ADESAS: WORD DESAS < DESASSIGNATION
AQUOI: WORD QUOI < QUOI FAIRE? (DUMP,SUPP,BOF)
IF ORDI-"S",XWOR%1,,XWOR%1
APARC: WORD PARC < PARCOURS ACN'S / NOMS.
ATSTAC: WORD TSTAC < TEST ACN DE LOGON INITIAL.
XWOR%1: VAL 0
AGOSGN: WORD GOSGN < ACCES SGN
IF ORDI-"T",XWOR%1,,XWOR%1
ATRNC: WORD TRNC < TRAITEMENT NOM EN COURS
XWOR%1: VAL 0
AQNOM: WORD QNOM < QUOI FAIRE SUR LE NOM
ADUMP: WORD DUMP < DUMP
ASUPP: WORD SUPP < SUPPRESSION
AULB: WORD ULB < VERIF UL 'B
ATSTFI: WORD TSTFI < TEST ITEM/FICHIER
ADITEM: WORD DITEM < DUMP ITEM
ADFICH: WORD DFICH < DUMP FICHIER
AEDI: WORD EDI < EDITION SUR IMPRIMANTE
ATI: WORD TI < EDITION TITRE SUR IMPRIMANTE
ATIK: WORD TIK < EDITION TITRE-KEY SUR IMPRIMANTE
AEDC: WORD EDC < CONVERSION/EDITION SUR IMPRIMANTE
ABLOC: WORD BLOC < TRAITEMENT BLOC (DE FICHIER)
ARCUPK: WORD RCUPK < RECUPERATION KEY EN COURS
AW1PG: WORD W1PG < WRITE 1 CARACTERE SUR PAGE VIRT
AWNPG: WORD WNPG < WRITE N CARACTERES SUR PAGE VIRT
AWPG: WORD WPG < WRITE PAGE VIRTUELLE
ASTC: WORD STC < STORE CARACTERE EN PAGE VIRT
AEDPG: WORD EDPG < EDITION PAGE SUR SUPPORT EXTERNE
APC1: WORD PC1 < "PUNCH" UN CARACTERE
APCARD: WORD PCARD < PUNCH D'UNE CARTE
AENVOI: WORD ENVOI < ENVOI D'UN MESSAGE "STANDARD"
AQREP: WORD QREP < ENVOI QUESTION ET DEMANDE REPONSE
ACHOIX: WORD CHOIX < CHOIX D'UNE OPTION EN NON STANDARD.
ACHXX: WORD CHXX < CHOIX UN PEU DIFFERENT DU PRECEDENT.
AGESTM: WORD GESTM < GESTION ESPACE MEMOIRE
APAR50: WORD PAR50 < POUR DEROUTEMENT SI ALT-MOD
ACONVH: WORD CONVH < CONVERSION ASCI-->HEXADECIMAL INTERNE
ACONVA: WORD CONVA < CONVERSION HEXADECIMAL INTERNE-->ASCI
ADMPDK: WORD DMPDK < DUMP DIRECT DISQUE
ADMPDA: WORD DMPDA < ACQUISITION ET DUMP DE LA DATE.
ASP1: WORD SP1 < FIN DE PARCOURS DE L'ARBRE.
IF ORDI-"S",XWOR%1,,XWOR%1
ADVAS: WORD DVAS < DEMANDE ET VERIF ADRESSE DKU
ASP2: WORD SP2 < INITIALISATION DKU.
ASETV: WORD SETV < SET VERROU CDA.
ARSETV: WORD RSETV < RESET VERROU CDA.
ATESTV: WORD TESTV < TEST VERROU CDA.
<
< DONNEES DE CODAGE :
<
ICOMPA: WORD 0 < 0=COMPACTER L'INFORMATION,
< 1=NE PAS LA COMPACTER.
LCLEF:: VAL 16 < LONGUEUR DES CLEFS.
CLEF: DZS LCLEF/2
ACLEF: WORD CLEF,X < RELAI D'ACCES A LA CLEF.
CLEFB: DZS LCLEF/2
ACLEFB: WORD CLEFB,X < POUR LES RE-DECODAGES EN CAS D'ERREUR...
DMCLEF: WORD '0101 < DEMANDE D'ENTREE DE LA CLEF.
WORD CLEF-ZERO*2
WORD LCLEF
ABUF: WORD 0 < RELAI VARIABLE D'ACCES A LA PAGE
< VIRTUELLE DKU.
ACOMP: WORD COMP < SOUS-PROGRAMME DE CODAGE...
ADCOMP: WORD DCOMP < DECODAGE SI ERREUR D'ECRITURE...
ICLEF: WORD 0 < 0 : PAS DE CODAGE...
<
< DONNEES DE PROTECTION DE 'DKU' :
<
EMQ: BYTE '6D;"?"
MPQ: ASCI "!Q"
MQFFFF: ASCI "XXXX"
MQEOT: BYTE '04;0
MDKS0: ASCI "!DK S0 OFF"
BYTE '04;0
QIN: WORD '0101 < ENTREE DES GROUPES DE CYLINDES A PROTEGER
WORD MQFFFF-ZERO*2
WORD MQEOT-MQFFFF*2
QOUT: WORD '0202 < EDITION DE LA QUESTION "!Q".
WORD EMQ-ZERO*2
WORD MQFFFF-EMQ*2
QCCI: WORD '0002 < ENVOI DE "!Q" AU CCI.
WORD MPQ-ZERO*2
WORD 80
DKCCI: WORD '0002 < ENVOI DE "!DK S0 OFF" AU CCI.
WORD MDKS0-ZERO*2
WORD 80
<
< DONNEES POUR UNE RECHERCHE DE CHAINE
< LORS DES DUMPS DISQUES :
<
IRECHE: WORD 0 < 0 : PAS DE RECHERCHE,
< 1 : RECHERCHE DEMANDEE (EN MODE NON
< STANDARD).
ABUFDK: WORD 0 < RELAI INDEXE VERS LE BUFFER DISQUE.
ARECHE: WORD BRECHE,X < RELAI VERS LA CHAINE CHERCHEE...
LRECHE:: VAL 16 < LONGUEUR MAX DE LA CHAINE.
BRECHE: DZS LRECHE+1/2 < CHAINE CHERCHEE...
DRECHE: WORD '0101 < ENTREE DE LA CHAINE.
WORD BRECHE-ZERO*2
WORD LRECHE
NBRHEX:: VAL 4 < NOMBRE DE CHIFFRES HEXAS PAR MOT...
DRECHX: WORD '0101 < ENTREE D'UNE CHAINE HEXA...
WORD BRECHE-ZERO*2
WORD NBRHEX
MASKRE: WORD 0 < MASQUE POUR LA RECHERCHE...
XWOR%1: VAL 0
PAGE
IF ORDI-"S",XWOR%1,,XWOR%1
DSEC
DSPAR: EQU $
<
< D S E C D U S / P ' P A R C '.
<
ICONTX: DZS 1 < INDICATEUR CONTEXTE :
< = 0 : C'EST LE CONTEXTE ACN'S.
< = 1 : C'EST LE CONTEXTE "NOMS".
STOP: DZS 1 < INDICATEUR STOP PARCOURS DEMANDE :
< = 0 : CONTINUER.
< = 1 : STOP DEMANDE.
PASPAS: DZS 1 < INDICATEUR DE PAS A PAS :
< = 0 : PARCOURS EN MODE AUTOMATIQUE.
< = 1 : PARCOURS EN PAS A PAS.
MRACIN: DZS 1 < POUR MESSAGE DE DEMANDE DE RACINE.
DMRAC: DZS 3 < DEMANDE RACINE (D'ACN OU DE NOM).
AXRAC: DZS 1 < RELAI INDEXE SUR RACINE.
XRAC: DZS 1 < INDEX INITIAL DE PARCOURS.
SXRAC: DZS 1 < AUTRE INDEX INITIAL.
SCATAL: DZS 4 < DEMANDE SGN POUR LE S/P 'GOSGN'.
ATRNC: DZS 1 < S/P DE TRAITEMENT ACN OU NOM COURANT.
DSPARF: EQU $ < FIN DE LA DSEC.
LDSPAR: VAL DSPARF-DSPAR < LONGUEUR DE LA DSEC.
PROG
USE W,DSPAR < 'W' BASE LA DSEC 'DSPAR'.
XWORK: VAL $-ZERO
CONTXA: EQU $
<
< C O N T E X T E A C N ' S.
<
$EQU CONTXA+ICONTX-DSPAR
WORD 1 < 'ICONTX' = ACN'S.
$EQU CONTXA+STOP-DSPAR
DZS 1 < 'STOP'.
$EQU CONTXA+PASPAS-DSPAR
DZS 1 < 'PASPAS'.
$EQU CONTXA+MRACIN-DSPAR
WORD MRACA-M < 'MRACIN'.
$EQU CONTXA+DMRAC-DSPAR
WORD '0101 < ENTREE RACINE DES ACN'S.
WORD ACN-ZERO*2
WORD ACNF-ACN*2+1
$EQU CONTXA+AXRAC-DSPAR
WORD ACN,X < RELAI INDEXE SUR RACINE COURANTE ACN.
$EQU CONTXA+XRAC-DSPAR
DZS 1 < 'XRAC'.
$EQU CONTXA+SXRAC-DSPAR
DZS 1 < 'SXRAC'.
$EQU CONTXA+SCATAL-DSPAR
WORD '000A < DEMANDE SGN SOUS ACN.
WORD ACN-ZERO*2
DZS 1
WORD -1
$EQU CONTXA+ATRNC-DSPAR
WORD TRACNC < S/P DE TRAITEMENT ACN COURANT.
$EQU ZERO+XWORK+LDSPAR < POSITIONNEMENT SUR SECOND CONTEXTE.
CONTXN: EQU $
<
< C O N T E X T E N O M S.
<
$EQU CONTXN+ICONTX-DSPAR
WORD 0 < 'ICONTX' = NOMS.
$EQU CONTXN+STOP-DSPAR
DZS 1 < 'STOP'.
$EQU CONTXN+PASPAS-DSPAR
DZS 1 < 'PASPAS'.
$EQU CONTXN+MRACIN-DSPAR
WORD MRAC-M < 'MRACIN'.
$EQU CONTXN+DMRAC-DSPAR
WORD '0101 < ENTREE RACINE DES NOMS.
WORD NOM-ZERO*2
WORD LNOM*2
$EQU CONTXN+AXRAC-DSPAR
WORD NOM,X < RELAI INDEXE SUR RACINE COURANTE NOM.
$EQU CONTXN+XRAC-DSPAR
DZS 1 < 'XRAC'.
$EQU CONTXN+SXRAC-DSPAR
DZS 1 < 'SXRAC'.
$EQU CONTXN+SCATAL-DSPAR
WORD '0002 < DEMANDE SGN.
WORD NOM-ZERO*2
DZS 1
WORD -1
$EQU CONTXN+ATRNC-DSPAR
WORD TRNC < S/P DE TRAITEMENT NOM COURANT.
<
$EQU LDSPAR*2+XWORK+ZERO < REPOSITIONNEMENT COMPTEUR ORDINAL.
XWOR%1: VAL 0
PAGE
PROG
WORD COM+128
IF ORDI-"S",XWOR%1,,XWOR%1
WORD LOC+128
WORD PILE-1
XWOR%1: VAL 0
DEB2: EQU $
<
< E N T R Y D A N S D U M P
<
< INITIALISATIONS
<
IF ORDI-"T",XWOR%1,,XWOR%1
LRP C
LA -1,C
LR A,C
LA APILM1
LR A,K
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
LRP K
ADRI -1,K
PLR C,L,W
LR W,K
LAD DMLGSY
SVC 0 < ON ESSAYE ":SYS" A PRIORI...
XWOR%1: VAL 0
WORD '1E35
SLLS 1 < ESPACE EN OCTETS
STA ESPACE < ESPACE ACTUELLEMENT ALLOUE
BSR AQUOI < QUOI FAIRE? (DUMP,SUPPRESS,BOF)
< CE S/P POSITIONNE LES INDICATEURS:
< 'ISTAND' : STANDARD/NON STANDARD.
< 'DMSUBO' : DUMP/SUPPRESSION/BOF.
< ET, DE PLUS, EN SOLAR :
< 'IACN' : INDICATEUR ACN'S / NOMS.
STZ IPRDM < INDIC 1ER DUMP
LA AOPAG0
STA DMLON+1 < ADR OCT NOM+VALEUR
SLRS 1
SBT 0
STA AXVAL < RELAI INDEXE NOM+VALEUR
IF ORDI-"S",XWOR%1,,XWOR%1
LRM A < FIXATION TAILLE DES BUFFERS
WORD QUANTA*128*2 < FICHIERS A DUMPER; QUANTA=3
STA DMREAD+2 < A PRIORI
STA DMWBLC+2 < POUR LE FICHIER DE SAUVEGARDE EGALEMENT
CPZ IACN
JE PAR4
<
< IL FAUT EXPLORER LES ACN'S.
<
PAR7: EQU $
STZ IAUTOM < INITIALISATION OU REINITIALISATION
< DE L'INDICATEUR DE DUMP AUTOMATIQUE
< DES SOUS CATALOGUES D'ACN'S.
LRM W < 'W' = BASE DU CONTEXE ACN'S
WORD CONTXA < POUR LE S/P 'PARC'.
BSR APARC < PARCOURS DES ACN'S.
PAR6: EQU $
LAI MFIN-M < PROPOSER LA FIN.
BSR AQREP
CPI "O"
JE PAR5 < C'EST FINI.
CPI "N"
JE PAR7 < CE N'EST PAS LA FIN.
JMP PAR6 < REPONSE NON RECONNUE.
<
PAR4: EQU $
<
< IL NE FAUT TRAVAILLER QUE SOUS L'ACN COURANT.
<
LRM W < 'W' = BASE DU CONTEXTE "NOMS"
WORD CONTXN < POUR LE S/P 'PARC'.
BSR APARC < PARCOURS DU CATALOGUE ETC...
PAR5: EQU $
<
< F I N D E T R A V A I L
<
XWOR%1: VAL 0
IF ORDI-"T",XWOR%1,,XWOR%1
LA APAR50 < SI ALT-MODE ---> PROPOSITION DISQUE
WORD '1EB5 < PARCOURS OU FIN
<
< D U M P D I R E C T D I S Q U E O U P A R C O U R S
<
< D E L ' A R B R E O U F I N D E T R A V A I L
<
DKPAR: EQU $
LAI MDPF-M < PROPOSITION DUMP-DK, PARCOURS,
< OU FIN DE TRAVAIL
BSR AQREP < ENVOI QUESTION, DEMANDE REPONSE.
< SI ON EST EN SUPPRESSION
CPZ DMSUBO < OU EDITION, ON NE PROPOSE PAS DE DUMP
< D'ESPACE DISQUE.
JL DKPAR2
CPI "D"
JE DKPAR1 < VERS DUMP DISQUE
DKPAR2: EQU $
CPI "P"
JE PAR0 < VERS PARCOURS
CPI "F"
JE PAR90 < VERS FIN DE TRAVAIL
JMP DKPAR < REPONSE NON RECONNUE
<
DKPAR1: EQU $ < DUMP DISQUE
BSR ADMPDK
JMP DKPAR < VERS NOUVELLE PROPOSITION
<
<
< ENTREE DE LA RACINE DE PARCOURS
<
PAR0: EQU $
STZ IHEXA < HEXADECIMAL = NON A PRIORI.
LAI MHEXA-M < POUR LE S/P 'CHOIXX'.
BSR ACHXX < CHOIX DE L'OPTION.
JANE PARH
IC IHEXA < OPTION HEXADECIMAL = OUI.
PARH: EQU $
STZ STOP < STOP PARCOURS=NON A PRIORI
STZ PASPAS
IC PASPAS < PAS A PAS = OUI A PRIORI
CPZ DMSUBO < EST-CE 'BOF' ?
JE PAR01 < OUI, DONC PAS A PAS SYSTEMATIQUE
PAR02: EQU $
LAI MPAS-M < DUMP OU SUPPRESSION, ON
BSR AQREP < PROPOSE LE 'PAS A PAS'.
CPI "O"
JE PAR01
CPI "N"
JNE PAR02
STZ PASPAS < PAS A PAS = NON
PAR01: EQU $
LAI MRAC-M < INVITATION
BSR AENVOI
LAD DMRAC < DEMANDE REPONSE
SVC 0
LXI 0 < INIT COUNT
PAR1: EQU $
LBY &AXNOM < CARACTERE DE RACINE
CPI '04 < EOT ?
JE PAR2
ADRI 1,X < NON, IDEX+1
JMP PAR1
PAR2: EQU $
STX XRAC < INDEX INITIAL
CPZR X < RACINE DE LONGUEUR NULLE?
JE PAR3 < OUI, X RESTE=0
ADRI -1,X < NON, ON FAIT X=X-1 POUR
< REVENIR SUR CAR PRECEDENT
PAR3: EQU $
STX SXRAC < VALEUR X INITIAL
<
CPZ ISTAND
JE PAR93 < MODE STANDARD.
LA DMSUBO
CPI -1 < EN MODE SUPPRESSION ON NE PROPOSE
JE PAR93 < PAS DE "A PARTIR DE".
<
< EN MODE DUMP, EDITION ET BOF, ET SEULEMENT EN MODE NON-STANDARD,
< ON PROPOSE LE 'A PARTIR DE'.
<
PAR32: EQU $
LAI MAPD-M < ENVOI MESSAGE
BSR AENVOI
LAD DMREP < DEMANDE REPONSE.
SVC 0
LBY REP < 'A' = REPONSE.
<
< REPONSES RECONNUES: RETURN, EOT, 0,1,...9,A,...F
<
CPI '0D
JE PAR33
CPI '04
JE PAR33
CPI "0"
JL PAR32 < REPONSE INCORRECTE.
CPI "9"
JG PAR34
ADRI -'30,A < 0 ... 9
JMP PAR35
PAR34: EQU $
ADRI -'41+10,A
CPI 10
JL PAR32 < REPONSE INCORRECTE.
CPI 15
JG PAR32
PAR35: EQU $ < REPONSE CORRECTE, 'A' VAUT 1 .. 15.
STA XRAC < INDEX.
PAR33: EQU $
LX SXRAC < RESTAURATION INDEX INITIAL.
<
< BOUCLE DE RECUPERATION NOM SGN
<
PAR93: EQU $
LAI '89 < NEXT-SERIE
BSR AGOSGN < CODE RETOUR NXS DANS A
CPI 5 < IL Y A UN NXS?
JE PAR94 < NON
JAE PAR500 < OUI,LE NXS EXISTE
LR X,A
CP XRAC < ON EST DE RETOUR SUR RACINE?
JL PAR50 < OUI, FIN DE PARCOURS
ADRI -1,X < AUTRES CAS D'ERREUR,ON NE SAIT PLUS
< OU ON EN EST (A CAUSE DES DELETE)
JMP PAR93 < ON CONTINUE
<
< IL Y A UN NEXT-SERIE
<
PAR500: EQU $
ADRI 1,X
LBY &AXNOM < RECUP DU NEXT-SERIE
CPI '04 < FIN DE NOM?
JNE PAR93 < NON, CONTINUER LA RECUP
<
< TRAITEMENT DU NOM COURANT
<
STX LNC < LONGUEUR NOM EN COURS...
IC LNC < +1 (EOT)
PSR X
BSR ATRNC < TRAITEMENT NOM EN COURS
PLR X
CPZ STOP < STOP PARCOURS?
JNE PAR50 < OUI
<
< RECHERCHE DU NEXT-PARALLELE
<
PAR94: EQU $
LAI '88 < NXP
BSR AGOSGN < CODE RETOUR DANS A
CPI 5 < NXP EXISTE?
JE PAR97 < NON
JAE PAR330 < OUI
JMP PAR93 < AUTRES CAS ERREURS DUES A DELETE
< ON CONTINUE
<
< IL Y A UN NEXT-PARALLELE
<
PAR330: EQU $
ADRI 1,X
LBY &AXNOM < RECUP DU NXP
ADRI -1,X
STBY &AXNOM < ON LE MET A LA BONNE PLACE
JMP PAR93 < ON CONTINUE
<
< PAS DE NEXT-PARALLELE
<
PAR97: EQU $
ADRI -1,X < RETOUR ARRIERE DANS LE NOM
LR X,A
CP XRAC < RETOUR SUR RACINE?
JGE PAR94 < NON, ON CONTINUE
PAR50: EQU $
<
< F I N D E D U M P D I S Q U E O U
<
< F I N D ' U N P A R C O U R S D E L ' A R B R E
<
LA APILM1 < ADRESSE DE LA PILE - 1.
LR A,K < AU CAS OU ON ARRIVE ICI PAR 'ALT-MODE'.
< ON PROPOSE UN NOUVEAU DUMP DK OU UN NOUVEAU
< PARCOURS DE L'ARBRE, OU LA FIN
<
JMP DKPAR
PAR90: EQU $
XWOR%1: VAL 0
BSR ASP1 < FIN DE TRAVAIL...
BR ARTCCI
PAGE
QUOI: EQU $
<
< Q U O I F A I R E ? C H O I X D ' U N E F O N C T I O N
<
< D U M P ? S U P P R E S S I O N ? B O F ?
<
< CE S/P DEMANDE A L'UTILISATEUR :
< - S'IL VEUT TRAVAILLER EN MODE STANDARD OU NON.
< - QUELLES FONCTIONS IL VEUT UTILISER ( DUMP,
< SUPPRESSION,BOF)
< ET IL POSITIONNE EN CONSEQUENCE ET RESPECTIVEMENT
< LES INDICATEURS :
< - 'ISTAND'
< - 'DMSUBO'
<
< RESULTAT:
< 'ISTAND' = 0 MODE STANDARD
< = 1 MODE NON-STANDARD.
< 'DMSUBO' = 0 BOF
< = 1 DUMP SEULEMENT
< =-1 SUPPRESSION SEULEMENT
< =-2 EDITION.
< 'IDEL' = 0 DUMP SEUL SI DUMP,
< 1 DUMP & DELETE SI DUMP.
<
<
< DE PLUS, EN SOLAR, CE S/P DEMANDE SI L'ON VEUT
< EXPLORER LES ACN'S ET POSITIONNE EN CONSEQUENCE
< L'INDICATEUR 'IACN' :
< 'IACN' = 0 ACN COURANT SEULEMENT
< = 1 EXPLORER LES ACN'S.
< ( SOUS :SYS SEULEMENT !!! )
< NOTA:
< EN MODE SUPPRESSION, LES DUMP DISQUE NE
< SERONT PAS ACCEPTES.
<
STZ ISTAND < MODE STANDARD A PRIORI.
LAI MSTAND-M < PROPOSITION MODE STANDARD.
BSR AQREP < QUESTION ET REPONSE.
CPI "F" < FIN ???
JNE QUOINX < NON...
BR ARTCCI < OUI, VERS LE RETOUR CCI, ET EVEN-
< TUELLEMENT 'DEB2' SI !GO...
QUOINX: EQU $
CPI "O" < STANDARD ?
JE QUOI1
CPI "N" < NON STANDARD ?
JNE QUOI < REPONSE NON RECONNUE.
IC ISTAND < MODE NON STANDARD.
QUOI1: EQU $
STZ IDEL < DUMP SEUL SI DUMP A PRIORI...
STZ DMSUBO < BOF A PRIORI
LAI MDSB-M < ENVOI QUESTION
BSR AQREP < QUESTION, REPONSE.
CPI "X" < DUMP & DELETE ???
JE QDX
CPI "D" < DUMP ?
JE QD
CPI "S" < SUPPRESSION ?
JE QS
CPI "B" < LES DEUX ?
JE QUOIF
CPI "E" < EDITION ?
JNE QUOI1 < REPONSE NON RECONNUE
LAI -2
STA DMSUBO < DMSUBO=-2 : EDITION.
QUOIF: EQU $
IF ORDI-"S",XWOR%1,,XWOR%1
STZ IACN < A PRIORI.
BSR ATSTAC < TEST ACN DE LOGON INITIAL.
JNE QUOIF1 < # DE :SYS.
QUOIF2: EQU $
LAI MACN-M < POUR DEMANDER SI L'ON VEUT PARCOURIR
< LES ACN'S.
BSR AQREP < QUESTION, REPONSE.
CPI "N"
JE QUOIF1 < NON.
CPI "O"
JNE QUOIF2 < REPONSE NON RECONNUE.
IC IACN < SET INDICATEUR PARCOURS ACN'S.
STZ INACN < NOUVEL ACN=NON A PRIORI.
LAD DMLGSY < ACN DEMANDE, DONC LOGON SOUS :SYS
SVC 0 < (POUR POUVOIR EXPLORER LES ACN'S).
QUOIF1: EQU $
XWOR%1: VAL 0
RSR
QDX: EQU $
LAI MDEL-M
BSR AENVOI < ON AVERTIT "DUMP & DELETE"...
IC IDEL < IDEL=1... (DUMP & DELETE)
QD: EQU $
IC DMSUBO < DMSUBO=1 : DUMP SEUL
JMP QUOIF
QS: EQU $
DC DMSUBO < DMSUBO=-1: SUPPRESSION SEULE
JMP QUOIF
IF ORDI-"S",XWOR%1,,XWOR%1
PAGE
PARC: EQU $
<
<
< P A R C O U R S D E L ' A R B R E D E S N O M S :
<
< - S O I T D E S D I F F E R E N T S A C N ' S
<
< - S O I T D E S N O M S D ' U N S O U S - C A T A L O G U E
< S O U S L ' A C N C O U R A N T.
<
< CE S/P REENTRANT UTILISE UN CONTEXTE BASE PAR 'W' QUI EST
< UN ARGUMENT D'APPEL.
<
< - ARGUMENTS: 'W' BASANT LE CONTEXTE, ET LE CONTEXTE LUI-MEME.
<
< - NOTA: LE CONTEXTE EST DECRIT PAR LA DSEC 'DSPAR'.
<
CPZ ICONTX
JNE PAR0
<
< ON TRAVAILLE SOUS ACN COURANT.
<
<
< D U M P D I R E C T D I S Q U E O U P A R C O U R S
<
< D E L ' A R B R E O U F I N D E T R A V A I L
<
DKPAR: EQU $
CPZ IAUTOM
JE PARD < CAS NORMAL.
CPZ IDSC < CAS AUTOMATIQUE, LE DUMP DU SOUS
< CATALOGUE A-T-IL ETE EFFECTUE ?
JNE PAR61B < OUI, TERMINE.
IC IDSC < NON, C'EST COMME SI C'ETAIT FAIT...
JMP PAR0 < ALLONS-Y.
PARD: EQU $
LAI MDPF-M < PROPOSITION DUMP-DK, PARCOURS,
< OU FIN DE TRAVAIL
BSR AQREP < ENVOI QUESTION, DEMANDE REPONSE.
< SI ON EST EN SUPPRESSION OU EN MODE
CPZ DMSUBO < EDITION, ON NE PROPOSE PAS DE DUMP-DK.
JL DKPAR2
CPI "D"
JE DKPAR1 < VERS DUMP DISQUE
DKPAR2: EQU $
CPI "P"
JE PAR0 < VERS PARCOURS
CPI "F"
JE PAR61B < RETOUR A L'APPELANT.
JMP DKPAR < REPONSE NON RECONNUE
<
DKPAR1: EQU $ < DUMP DISQUE
BSR ADMPDK
JMP DKPAR < VERS NOUVELLE PROPOSITION
<
<
< ENTREE DE LA RACINE DE PARCOURS (D'ACN'S OU DE NOMS).
<
PAR0: EQU $
STZ IHEXA < OPTION HEXADECIMAL = NON A PRIORI.
CPZ ICONTX
JNE PARH
LAI MHEXA-M < POUR LE S/P 'CHOIXX'.
BSR ACHXX < CHOIX DE L'OPTION.
JANE PARH
IC IHEXA < OPTION HEXADECIMAL ACTIVE.
PARH: EQU $
STZ STOP < STOP PARCOURS=NON A PRIORI
STZ PASPAS
IC PASPAS < PAS A PAS = OUI A PRIORI
CPZ DMSUBO < EST-CE BOF ?
JE PAR01 < OUI, DONC PAS A PAS SYSTEMATIQUE
PAR02: EQU $
LAI MPAS-M < DUMP OU SUPPRESSION, ON VA PEUT-ETRE
< PROPOSER LE "PAS A PAS".
CPZ ICONTX
JE PAR8 < CAS DES NOMS SOUS L'ACN COURANT.
BSR AQREP < CAS DES ACN'S, PROPOSER LE PAS A PAS.
CPI "A" < AUTOMATIQUE ?
JNE PARE < NON, VOYONS SI OUI OU NON.
IC IAUTOM < AUTOMATIQUE : SET INDICATEUR.
JMP PAR9
PAR8: EQU $ < CAS DES NOMS.
CPZ IAUTOM < AUTOMATIQUE ?
JNE PAR9 < SI OUI, PAS A PAS = NON.
BSR AQREP < QUESTION ET REPONSE.
PARE: EQU $
CPI "O"
JE PAR01
CPI "N"
JNE PAR02
PAR9: EQU $
STZ PASPAS < PAS A PAS = NON.
PAR01: EQU $
LA MRACIN < INVITATION
BSR AENVOI
LAD DMRAC < DEMANDE REPONSE
CPZ ICONTX
JNE PARA < CAS DES ACN'S, DEMANDER LA RACINE.
CPZ IAUTOM < CAS DES NOMS , FAUT-IL DEMANDER
< LA RACINE ?
JE PARA < OUI.
LAI '04 < ICI, RACINE VIDE SYSTEMATIQUEMENT.
LXI 0
STBY &AXRAC < ET VOILA ...
JMP PAR1
PARA: EQU $
SVC 0
LXI 0 < INIT COUNT
PAR1: EQU $
LBY &AXRAC < CARACTERE DE RACINE
CPI '04 < EOT ?
JE PAR2
ADRI 1,X < NON, IDEX+1
JMP PAR1
PAR2: EQU $
STX XRAC < INDEX INITIAL
CPZR X < RACINE DE LONGUEUR NULLE?
JE PAR3 < OUI, X RESTE=0
ADRI -1,X < NON, ON FAIT X=X-1 POUR
< REVENIR SUR CAR PRECEDENT
PAR3: EQU $
STX SXRAC < VALEUR X INITIAL
<
CPZ ISTAND
JE PAR93 < MODE STANDARD.
LA DMSUBO
CPI -1
JE PAR93 < MODE SUPPRESSION.
<
< EN MODE DUMP, BOF ET EDITION, ET SEULEMENT EN MODE NON-STANDARD,
< ON PROPOSE LE "A PARTIR DE".
<
PAR32: EQU $
LAI MAPD-M < ENVOI MESSAGE
BSR AENVOI
LAD DMREP < DEMANDE REPONSE.
SVC 0
LBY REP < 'A' = REPONSE.
<
< REPONSES RECONNUES: RETURN, EOT, 0,1,...9,A,...F
<
CPI '0D
JE PAR33
CPI '04
JE PAR33
CPI "0"
JL PAR32 < REPONSE INCORRECTE.
CPI "9"
JG PAR34
ADRI -'30,A < 0 ... 9
JMP PAR35
PAR34: EQU $
ADRI -'41+10,A
CPI 10
JL PAR32 < REPONSE INCORRECTE.
CPI 15
JG PAR32
PAR35: EQU $ < REPONSE CORRECTE, 'A' VAUT 1 .. 15.
STA XRAC < INDEX.
PAR33: EQU $
LX SXRAC < RESTAURATION INDEX INITIAL.
<
< BOUCLE DE RECUPERATION ACN'S OU NOMS SGN.
<
PAR93: EQU $
LAI '89 < NEXT-SERIE
BSR AGOSGN < CODE RETOUR NXS DANS A
CPI 5 < IL Y A UN NXS?
JE PAR94 < NON
JAE PAR500 < OUI,LE NXS EXISTE
LR X,A
CP XRAC < ON EST DE RETOUR SUR RACINE?
JL PAR50 < OUI, FIN DE PARCOURS
ADRI -1,X < AUTRES CAS D'ERREUR,ON NE SAIT PLUS
< OU ON EN EST (A CAUSE DES DELETE)
JMP PAR93 < ON CONTINUE
<
DKPARB: JMP DKPAR < SANS COMMENTAIRE.
PAR61B: JMP PAR61 < SANS COMMENTAIRE.
<
<
< IL Y A UN NEXT-SERIE
<
PAR500: EQU $
ADRI 1,X
LBY &AXRAC < RECUP DU NEXT-SERIE
CPI '04 < FIN DE NOM?
JNE PAR93 < NON, CONTINUER LA RECUP
<
< TRAITEMENT DU NOM COURANT
<
STX LNC < LONGUEUR NOM EN COURS...
IC LNC < +1 (EOT)
PSR X
BSR ATRNC < TRAITEMENT NOM EN COURS
PLR X
CPZ STOP < STOP PARCOURS?
JNE PAR50 < OUI
CPZ ICONTX
JNE PAR600
< ON TRAITE UN MOM.
CPZ STDKU < QUEL MODE ???
JE PAR600 < #DKU, OU DKU EN CONTINU...
CPZ IDMPNC < Y A-T-IL EU DUMP DU NOM COURANT?
JE PAR600
PSR X
BSR ASP1 < DKU EN DISCONTINU, ON FAIT SEMBLANT
BSR ASP2 < D'AVOIR FINI, ET DE RECOMMENCER...
STZ IPRW1P < ET OUI CELA
STZ IPRWPG < MANQUAIT...
PLR X
PAR600: EQU $
<
< RECHERCHE DU NEXT-PARALLELE
<
PAR94: EQU $
LAI '88 < NXP
BSR AGOSGN < CODE RETOUR DANS A
CPI 5 < NXP EXISTE?
JE PAR97 < NON
JAE PAR330 < OUI
JMP PAR93 < AUTRES CAS ERREURS DUES A DELETE
< ON CONTINUE
<
< IL Y A UN NEXT-PARALLELE
<
PAR330: EQU $
ADRI 1,X
LBY &AXRAC < RECUP DU NXP
ADRI -1,X
STBY &AXRAC < ON LE MET A LA BONNE PLACE
JMP PAR93 < ON CONTINUE
<
< PAS DE NEXT-PARALLELE
<
PAR97: EQU $
ADRI -1,X < RETOUR ARRIERE DANS LE NOM
LR X,A
CP XRAC < RETOUR SUR RACINE?
JGE PAR94 < NON, ON CONTINUE
PAR50: EQU $
<
< FIN DE PARCOURS DES ACN'S OU ( FIN DE PARCOURS DE L'ARBRE DES NOMS
< SOUS ACN COURANT OU FIN DE DUMP D'ESPACE DISQUE).
<
CPZ ICONTX
JNE PAR90
<
< FIN DE PARCOURS NOMS OU DE DUMP D'ESPACE DISQUE.
<
JMP DKPARB < VERS PROPOSITION NOUVEAU PARCOURS
< OU DUMP DISQUE OU FIN.
PAR61: EQU $
<
< FIN DEMANDEE SOUS L'ACN COURANT.
<
LAI '12 < RESTAURATION ADRESSE DE DEROUTEMENT
WORD '1EB5 < SUR 'ALT-MODE'.
RSR
PAR90: EQU $
<
< FIN DE PARCOURS DES ACN'S, DONC FIN DE TRAVAIL.
<
LAD DMLGSY < LOGON SOUS :SYS BIEN QUE DEJA FAIT
SVC 0 < AU SORTIR DE 'TRACNC'. ON NE SAIT JAMAIS!
JE $+2
ACTD
RSR
PAGE
TRACNC: EQU $
<
< T R A I T E M E N T D E L ' A C N C O U R A N T.
<
PSR A,B,X,W
<
LAD DMOUTA < EDITION ACN COURANT.
SVC 0
CPZ PASPAS < TEST AUTOMATIQUE/PAS A PAS.
JE TRAC4 < SI AUTOMATIQUE.
TRAC1: EQU $
<
< MODE PAS A PAS, PROPOSER DUMP...
<
LAI MQ-M < QUESTION.
BSR AQREP < REPONSE...
<
< REPONSES POSSIBLES:
<
< - F : FIN DE PARCOURS DES ACN'S.
< - N : NON; NE RIEN FAIRE SUR L'ACN COURANT (PASSER
< AU SUIVANT).
< - O : OUI; TRAITER LE SOUS-CATALOGUE.
< - RETURN,EOT : MEME CHOSE QUE "NON".
<
CPI "O"
JE TRAC4 < TRAITER LE SOUS-CATALOGUE ACN COURANT.
CPI "N"
JE TRACF < NE RIEN FAIRE.
CPI '0D
JE TRACF < NE RIEN FAIRE.
CPI '04
JE TRACF < NE RIEN FAIRE.
CPI "F" < STOP DEMANDE ?
JNE TRAC1 < REPONSE INCORRECTE.
TRAC2: EQU $
<
< STOP PARCOURS DES ACN'S DEMANDE.
<
IC STOP < POSITIONNEMENT DE L'INDICATEUR 'STOP'.
JMP TRACF
TRAC4: EQU $
<
< TRAITER LE SOUS-CATALOGUE DE L'ACN COURANT.
<
LRM A,W < POUR PREPARER LE LOGON.
WORD "L "
WORD ACN-1
XM 0,W
LR A,B
LAD DMLGN < LOGON.
SVC 0
STB 0,W
JE $+2
ACTD < LOGON REFUSE.
STZ IDSC < DUMP NON ENCORE EFFECTUE.
IC INACN < NOUVEL ACN = OUI.
LRM W < BASE DU CONTEXTE "NOMS" POUR LE
WORD CONTXN < S/P 'PARC'.
BSR APARC < TRAITEMENT DU SOUS-ARBRE, ETC...
STZ INACN < NOUVEL ACN = NON.
<
< ET ICI, NE PAS OUBLIER DE REPASSER SOUS :SYS !!!
< SINON, LA SUITE DU PARCOURS DES ACN'S NE DONNERA PAS LE RESULTAT...
< ESCOMPTE (COMME DISENT LES DIPLOMATES).
<
LAD DMLGSY < LOGON SOUS :SYS.
SVC 0
JE $+2
ACTD < PREOCCUPANT...
TRACF: EQU $
<
PLR A,B,X,W
RSR
XWOR%1: VAL 0
PAGE
QNOM: EQU $
<
< Q U O I F A I R E S U R L E N O M E N C O U R S ?
<
< CE S/P DETERMINE CE QU'IL CONVIENT DE FAIRE
< SUR LE NOM EN COURS C-A-D RIEN/SUPPRESSION/DUMP,
< ET POSITIONNE EN CONSEQUENCE L'INDICATEUR 'IQNOM'.
<
< RESULTAT:
< IQNOM = 0 : NE RIEN FAIRE...
< 1 : FAIRE UN DUMP
< -1 : FAIRE UNE SUPPRESSION
STZ IQNOM < A PRIORI, RIEN (IQNOM=0)
<
< EDITION NOM EN COURS
<
CPZ IHEXA < TEST OPTION "HEXADECIMAL".
JE QNOM1
<
< EDITION EN HEXADECIMAL REQUISE DU NOM COURANT.
<
PSR A,X,Y,W
<
LA ANOM
LR A,W < ADRESSE MOT NOM COURANT.
LXI LNOM+1
LY AONHE < ADRESSE OCTET NOM EN HEXA. CODE ASCI.
QNOM3: EQU $
LA 0,W
BSR ACONVA < CONVERSION ASCI (CF: S/P 'CONVA').
ADRI 1,W < MOT SUIVANT.
ADRI 4,Y < 4 OCTETS A LA FOIS EN EDITION...
JDX QNOM3
<
LA AONHE
ADRI -2,A
STA DMOUT+1 < ADRESSE MESSAGE.
LA LNC
SLLS 1
STA DMOUT+2 < LONGUEUR MESSAGE.
LAD DMOUT
SVC 0
<
PLR A,X,Y,W
<
QNOM1: EQU $
LA AXNOM
SLLS 1
ADRI -1,A < A=@OCTET DE NOM - 1
STA DMOUT+1 < @ MESSAGE
LAI '6D < R/C - LF.
CPZ IHEXA
JE $+2 < PAS D'EDITION HEXA PRECEDEMMENT.
LAI "-" < IL Y A EU EDITION HEXA.
LX DMOUT+1
STBY &AXTRAV < R/C - LF OU ESPACE EN TETE DE MESSAGE.
LA LNC
ADRI 1,A
STA DMOUT+2 < LONG MESSAGE
LAD DMOUT
SVC 0
LX DMOUT+1
LAI '6D < RESTAURATION DE R/C - LF.
STBY &AXTRAV
LA DMSUBO < FONCTION DEMANDEE :
JAGE QN03 < CE N'EST NI EDITION, NI SUPPRESSION...
BSR ATSTFI < DANS LE CAS DE L'EDITION ET DE LA
< SUPPRESSION, ON TESTE ITEM/FICHIER :
CPZ INDFI < ALORS ???
JE QNIT < ITEM...
JG QNFI < FICHIER...
LAI MPBAS-M < FICHIER NON ASSIGNABLE,
BSR AENVOI < ON LE DIT...
JMP QN03
QNIT: EQU $
LAD MTI
BSR ATI < TYPE "ITEM"...
JMP QN03
QNFI: EQU $
LAD MTF
BSR ATI < TYPE "FICHIER", ET NOM INTERNE...
QN03: EQU $
CPZ PASPAS < AUTOMATIQUE?
JE QN360 < OUI, ON NE PROPOSE RIEN
<
QN320: EQU $
LAI MQ-M < QUESTION
BSR AQREP < QUESTION, REPONSE.
<
< REPONSES POSSIBLES:
<
<
< SI REPONSE=F (STOP PARCOURS), ALORS
< NE RIEN FAIRE SUR LE NOM ET POSITIONNER
< LA VARIABLE STOP
<
<
< SI DMSUBO=0 (BOF)
< + N R/C EOT NE RIEN FAIRE
< O DUMP
< - SUPPRESSION
<
< SI DMSUBO=1 (DUMP)
< O DUMP
< N R/C EOT NE RIEN FAIRE
<
< SI DMSUBO=-1(SUPPRESSION)
< - SUPPRESSION
< + R/C EOT NE RIEN FAIRE
<
< SI DMSUBO=-2 (EDITION)
< R/C EOT SONT SEULS ADMIS, ET PROVOQUENT LE PASSAGE AU NOM SUIVANT.
CPI "F" < STOP PARCOURS
JNE QN080
IC STOP < OUI, STOP PARCOURS
JMP QN321 < ET NE RIEN FAIRE
QN080: EQU $
CPI '0D < R/C NE RIEN FAIRE
JE QN321
CPI '04 < EOT NE RIEN FAIRE
JE QN321
PSR A
LA DMSUBO
CPI -2 < TEST MODE "EDITION".
PLR A
JE QN320 < MODE EDITION, ET REPONSE DIFFERENTE
< DE RETURN OU EOT : REPONSE NON RECONNUE
CPZ DMSUBO
JL QN010 < VERS SUPPRESSION
<
< BOF OU DUMP
<
CPI "N" < NE RIEN FAIRE
JE QN321
CPI "O" < FAIRE DUMP
JE QN015
CPZ DMSUBO
JNE QN320 < REPONSE NON-RECONNUE
<
< BOF OU SUPPRESSION
<
QN010: EQU $
CPI "+" < NE RIEN FAIRE
JE QN321
CPI "-" < FAIRE SUPPRESSION
JE QN020
JMP QN320 < REPONSE NON RECONNUE
QN360: EQU $
<
< MODE AUTOMATIQUE ("PAS A PAS" = NON).
<
LA DMSUBO
CPI -2 < TEST MODE EDITION.
JE QN321 < EDITION : NE RIEN FAIRE...
JAG QN015 < DUMP.
JAL QN020 < SUPPRESSION.
ACTD < IMPOSSIBLE !!
QN015: EQU $
IC IQNOM < FAIRE DUMP
JMP QN321
QN020: EQU $
DC IQNOM < FAIRE SUPPRESSION
QN321: EQU $
RSR < RETOUR
PAGE
TRNC: EQU $
<
< T R A I T E M E N T D U N O M E N C O U R S
<
IF ORDI-"S",XWOR%1,,XWOR%1
STZ IDMPNC < A PRIORI : IL N'Y A PAS EU DUMP
< DU NOM COURANT. (UTILISE EN CAS DE
< DUMP SOLAR SUR DKU, MULTIPLE)
XWOR%1: VAL 0
BSR AQNOM < QOUI FAIRE SUR CE NOM?
< QNOM POSITIONNE IQNOM
CPZ IQNOM
JNE TRNC2
STZ BOX < AU CAS OU IL Y AURAIT DE
BSR AGESTM < L'ESPACE A RELACHER
JMP TRNCF < NE RIEN FAIRE
TRNC2: EQU $
LAI '1B < CTRL-SHIFT-K
WORD '1EA5 < REMPLACE ALT-MODE
CPZ IQNOM < RETEST
JG TRNCD < FAIRE UN DUMP
JL TRNCS < FAIRE SUPPRESSION
TRNCD: EQU $
BSR ADUMP
CPZ IDEL < DUMP & DELETE ???
JE TRNC1 < NON, DUMP SEUL...
TRNCS: EQU $ < "DELETE" OU "DUMP & DELETE"...
BSR ASUPP
TRNC1: EQU $
LAI '7D < ALT-MODE
WORD '1EA5 < REDEVIENT ALT-MODE
TRNCF: EQU $
RSR
PAGE
SUPP: EQU $
<
< S U P P R E S S I O N F I C H I E R O U I T E M
<
< E N C O U R S
<
BSR ATSTFI < TEST SI FICHIER OU ITEM
< POSITIONNE INDFI
< =0 ITEM
< =1 FICHIER ASSIGNE A L'UL 3
< =-1 FICHIER NON-ASSIGNABLR
CPZ INDFI
JE SUPI < ITEM
JG SUPF < FICHIER ASSIGNABLE
< FICHIER NON-ASSIGNABLE
LAI MPBAS-M < PREVENIR L'UTILISATEUR
BSR AENVOI
JMP SUPFIN
SUPF: EQU $ < SUPPRESSION FICHIER
IF ORDI-"T",XWOR%1,,XWOR%1
< ASSIGNATION EN RELEASE
< !ASSIGN 3=R
LA ASS5
STA ASS1
LAI "3"
STBY ASSUL
LAD DMASS
SVC 0
< IL NE RESTE PLUS QU'A DELETER
< AUSSI SON NOM
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
LAI "3"
BSR ADESAS < DESASSIGNATION.
LA ASSD
STA ASS1
LAD DMASS < !ASSIGN 3=D-NOM FICHIER.
SVC 0 < DELETE FICHIER.
JE $+2
ACTD
JMP SUPFIN
XWOR%1: VAL 0
SUPI: EQU $ < SUPPRESSION ITEM
< DELETE NOM+VALEUR
LAI '83
LX LNC < LONGUEUR NOM ...
ADRI -1,X < ...SANS EOT POUR GOSGN
BSR AGOSGN
JAE SUPFIN
ACTD
SUPFIN: EQU $
RSR
PAGE
DUMP: EQU $
<
< D U M P F I C H I E R O U I T E M E N C O U R S
<
CPZ IPRDM < 1ER DUMP?
JNE DM1
< OUI
IC IPRDM < BASCULEMENT
BSR AULB < ASSIGNATION DE L'UL 'B.
DM1: EQU $
BSR ATSTFI < TEST SI FICHIER OU ITEM
< POSITIONNE INDFI
< =0 ITEM
< =1 FICHIER, ASSIGNE A UL 3
< =-1 FICHIER NON-ASSIGNABLE
CPZ INDFI
JE DMI < ITEM
JG DMF < FICHIER ASSIGNE A L'UL 3
LAI MPBAS-M < FICHIER NON-ASSIGNABLE,
BSR AENVOI < PREVENIR UTILISATEUR
JMP DMFIN
DMI: EQU $ < ITEM
BSR AGESTM
LAD DMLON
SVC 0
JE $+2
ACTD
BSR ADITEM < DUMP ITEM
JMP DMFIN2
DMF: EQU $ < FICHIER
BSR AGESTM < GESTION ESPACE MEMOIRE
BSR ADFICH < DUMP FICHIER
LAI "3"
BSR ADESAS < DESASSIGNATION SYSTEMATIQUE UL 3
DMFIN2: EQU $
IF ORDI-"S",XWOR%1,,XWOR%1
IC IDMPNC < IL Y A EU DUMP DU NOM COURANT (UTILISE
< SUR SOLAR, DUMP DKU MULTIPLE).
XWOR%1: VAL 0
DMFIN: EQU $
RSR
PAGE
DITEM: EQU $
<
< D U M P I T E M E N C O U R S
<
LA BOX < "BOX"
AD LNC < +LONG. EOT INCLUS
ADRI 2,A < +2
STA &ALT < LONG. TOTALE
CPZ TYPDMP < TYPE DUMP
JNE DMPIV < DUMP VIRTUEL
DMPII: EQU $ < IMPRIMANTE/OUTPUT
LAD MTI
BSR ATI < TITRE
LX &ALT
IVALEX:: VAL 0 < BIT INDIQUANT DANS LA LONGUEUR D'UN
< ITEM, S'IL S'AGIT D'UN ITEM D'EXTENSION
< SUR VOLUME (CF. 'BOX').
XR A,X
RBT IVALEX < CAS DES EXTENSIONS SUR VOLUME...
XR A,X
ADRI -2,X < LONGUEUR A EDITER
LA AXVAL
SLLS 1
LR A,Y < ADR OCT DEBUT
BSR AEDI < EDITION
DMPIV: EQU $ < DUMP VIRTUEL
IF ORDI-"S",XWOR%1,,XWOR%1
< EN SOLAR, POUR UN DUMP DKU, MODE MULTIPLE, ON FAIT
< LE DUMP (EVENTUEL, VOIR OPTION STANDARD) DE DATE ET ACN
< AVANT DE FAIRE CELUI DE L'ITEM.
<
CPZ STDKU
JE DMPI1
BSR ADMPDA < DUMP DATE ET/OU ACN.
JMP DMPI2
DMPI1: EQU $
<
< DE PLUS, EN SOLAR, ON REGARDE SI L'ACN DE DUMP A CHANGE,
< ET SI OUI, ON FAIT UN DUMP DE DATE ET ACN.
<
CPZ INACN < "NOUVEL" ACN ?
JE DMPI2
STZ INACN < RAZ INDICATEUR.
BSR ADMPDA < ET DUMP DATE, ACN.
DMPI2: EQU $
XWOR%1: VAL 0
LA ALT
SLLS 1 < ADR OCT DEBUT
LX &ALT < LONGUEUR TOTALE
BSR AWNPG < WRITE N CAR SUR PGE VIRT
RSR
PAGE
DFICH: EQU $
<
< D U M P F I C H I E R E N C O U R S
<
IF ORDI-"S",XWOR%1,,XWOR%1
<
< EN SOLAR, POUR UN DUMP SUR DKU EN MODE MULTIPLE, ON FAIT LE DUMP
< (EVENTUEL, VOIR OPTION STANDARD) DE DATE ET ACN AVANT DE FAIRE
< CELUI DU FICHIER.
<
CPZ STDKU
JE DMPF7
BSR ADMPDA < DUMP DATE ET/OU ACN.
JMP DMPF8
DMPF7: EQU $
<
< DE PLUS, EN SOLAR, ON REGARDE SI L'ACN DE DUMP A CHANGE,
< ET SI OUI, ON FAIT UN DUMP DE DATE ET ACN.
<
CPZ INACN < "NOUVEL" ACN ?
JE DMPF8
STZ INACN < RAZ INDICATEUR.
BSR ADMPDA < ET DUMP DATE, ACN.
DMPF8: EQU $
XWOR%1: VAL 0
LAI 'DF < DELIM DEB FICHIER
BSR AW1PG
LA AXNOM
SLLS 1 < ADR DEB NOM
LX LNC < LONGUEUR NOM
BSR AWNPG < WRITE NOM VIRT
<
< EDITION EVENTUELLE TITRE
<
CPZ TYPDMP < TYPE DUMP
JNE DMPF1
DMPFI: EQU $ < IMPRIMANTE/OUTPUT
LAD MTF
BSR ATI < TITRE SUR IMPRIM. OU VISU
DMPF1: EQU $
<
< PARCOURS DU FICHIER
<
SBR B,B < FIN FICHIER=NON
DMPF2: EQU $ < TRAITEMENT FICHIER
CPZR B < FIN ?
JNE DMPF9
< NON, TRAITEMENT ENREGISTREMENT
LAD DMOPN < OPEN NEXT
SVC 0
JE DMPF3
ADRI 1,B < PAS DE NEXT, FIN FICH=OUI
JMP DMPF2
DMPF3: EQU $
LAI 'DE < DELIMITEUR DEBUT ENR
BSR ARCUPK < RECUPERATION DE LA CLE
BSR AW1PG
SBR Y,Y < FIN ENREGISTREMENT=NON
LAD KN1
SLLS 1 < ADR OCT DEB KEY
LXI 4 < LONG OCT
BSR AWNPG < WRITE PVIRT
CPZ TYPDMP < TYPE DUMP=IMPRIM/OUTPUT ?
JNE DMPF4
BSR ATIK < OUI, TITRE-KEY IMPR/OUTPUT
DMPF4: EQU $ < TRAITEMENT ENR
CPZR Y < FIN ENR ?
JNE DMPF5
< NON,LIRE & STOCKER BLOC SUIV
LAD DMREAD < LECTURE BLOC
SVC 0
JE DMPF6
DMPF41: EQU $ < PAS DE BLOC SUIVANT
ADRI 1,Y < FIN ENREGISTREMENT=OUI
JMP DMPF4
DMPF6: EQU $ < TRAITEMENT BLOC EN COURS
CPZ &ABUFF < FIN ENR?
JL DMPF41 < OUI, FAIRE FIN ENR
LAI 'DB < NON, DELIM DEBUT BLOC
BSR AW1PG
BSR ABLOC
LAI 'FB < DELIMITEUR FIN BLOC
BSR AW1PG
JMP DMPF4 < BLOC SUIVANT
DMPF5: EQU $ < PIN ENREGISTREMENT
LAD DMCLS < CLOSE SAVE ENR
SVC 0
JE $+2
ACTD
LAI 'FE < DELIMITEUR FIN ENR
BSR AW1PG
JMP DMPF2 < ENR SUIVANT
DMPF9: EQU $
LAI 'FF < DELIMITEUR FIN FICHIER
BSR AW1PG
RSR
PAGE
BLOC: EQU $
<
< D U M P D ' U N B L O C D E F I C H I E R
<
<
< TRAITEMENT DU BLOC QU'ON VIENT DE LIRE
< ON EDITE LE BLOC SUR PAGE VIRTUELLE ET, EVENTUELLEMENT, ON
< L'ENVOIE AUSSI SUR IMPRIMANTE/OUTPUT
< NOTA: B Y SONT A SAUVEGARDER
<
PSR B,Y < SAUVEGARDE
CPZ TYPDMP < TYPE DUMP=IMPRIM/OUTPUT
JNE BLOCV
BLOCI: EQU $ < IMPRIMANTE/OUTPUT
LY AOBUFF < ADR OCTET DEBUT BLOC A EDITER
LX DMREAD+2 < LONGUEUR OCT A EDITER
BSR AEDI < EDITION
< PAS DE REINIT DE PFICH
BLOCV: EQU $ < EDITION SUR PAGE VIRTUELLE
LA AOBUFF < ADR DEBUT
LX DMREAD+2 < LONGUEUR
BSR AWNPG < WRITE
<
PLR B,Y < RESTAURATION
RSR
PAGE
EDI: EQU $
<
< E D I T I O N S U R I M P R I M A N T E / O U T P U T
<
< EN ENTREE Y ADR OCTET DEBUT ZONE A EDITER
< X LONGUEUR OCTETS ZONE A EDITER
<
< ON EDITE N LIGNES CONTENANT : ADRESSE / CARACTERES HEXA / CARACTERES
< ASCI "IMAGE" DES CARACTERES HEXA; LE TOUT ETANT EDITE DANS LE
< BUFFER IMPRIMANTE 'BFI'.
<
< NOTA:
< EN MODE NON STANDARD, ON N'EDITE QUE 'NBOCT' OCTETS
< SI 'NBOCT' <= 'NOMBRE D'OCTETS DEMANDES' (X).
<
CPZ ISTAND < MODE STANDARD ?
JE EDI14 < OUI, ON PREND (X) OCTETS.
LR X,A
CP NBOCT
JLE EDI14
LX NBOCT < ON FORCE LE NOMBRE D'OCTETS.
EDI14: EQU $
PSR X < SVG X POUR 1ERE ENTRY
LAD DMSPI < ESPACEMENT (SAUT LIGNE)
SVC 0
STZ ADRC < ADRESSE COURANTE=0
JMP EDI10 < 1ERE ENTREE DANS BOUCLE
EDI1: EQU $ < BOUCLE
PSR X < SVG COUNT (LONG RESTANTE)
LA PBFI
CP AOFCH < FIN D'EDITION DES CARACTERES ?
JL EDI11
< OUI
LAD DMLIG1 < EDITION PREMIERE PARTIE DE
SVC 0 < LA LIGNE.
LAD DMLIG2 < EDITION SECONDE PARTIE DE
SVC 0 < LA LIGNE.
EDI10: EQU $ < REINITIALISATIONS
LXI BFIF-BFI-1 < R A BLANCS BFI
LAI " "
SWBR A,A
ORI " "
EDI100: EQU $
STA &AXBFI
JDX EDI100
PSR Y
LY AOBFI1 < ADRESSE OCTET EDITION DE
< L'ADRESSE COURANTE.
LA ADRC < ADRESSE COURANTE
BSR ACONVA < CONVERSION ASCI
ADRI BFIH-BFI1*2,Y < POUR ADRESSE COURANTE ET ESPACES.
STY PBFI < MISE A JOUR PBFI.
ADRI BFIASC-BFIH*2,Y < POUR CARACTERES ASCI "IMAGE" DES
< CARACTERES HEXA CODES ASCI.
STY PBFI2 < MISE A JOUR 'PBFI2'.
PLR Y
EDI11: EQU $
< EDITION DE 1 OCT (2 CAR.
< SUIVIS EVENTUELLEMENT DE 1 BLANC)
LR Y,X
LBY &AXTRAV < OCTET EN COURS
BSR AEDC < EDITION DE 2 CARACTERES HEXA CODE ASCI.
RBT 8 < AU CAS OU LE CARACTERE DE PARITE SERAIT
< UTILISE SUR DE L'ASCI...
CPI " "
JL EDI13
CPI "_"
JLE EDI200 < CARACTERE IMPRIMABLE.
PSR A
LA SASS1
CP ASS7 < EST-CE "OUTPUT" (EN GENERAL VISU) ???
PLR A
JE EDI201 < OUI...
ADRI -'20,A < NON, "LP1", ON CONVERTIT LES MINUS-
< CULES EN MAJUSCULES...
JMP EDI200 < VERS L'EDITION...
EDI201: EQU $
SBT 8 < CAS DE LA VISU (EN GENERAL) : ON FORCE
< L'EDITION DES MINUSCULES...
JMP EDI200 < VERS L'EDITION...
EDI13: EQU $ < CARACTERE NON IMPRIMABLE :
LAI "_" < ON REMPLACE PAR "_"
EDI200: EQU $ < CARACTERE IMPRIMABLE...
LX PBFI2 < INDEX CARACTERE ASCI.
STBY &AXTRAV < STORE CARACTERE.
IC PBFI2 < MISE A JOUR 'PBFI2'.
ADRI 1,Y < OCTET SUIVANT
IC ADRC < ADRESSE COURANTE
LA ADRC
ANDI '03 < ADRC MULTIPLE DE 4?
JANE EDI12
IC PBFI < OUI,ON PASSE 1 BLANC
<<<< IC PBFI2 < AINSI QUE DANS LA ZONE "IMAGE".
< (CE QUE L'ON SUPPRIME...)
EDI12: EQU $
PLR X < RECUP COUNT
JDX EDI1 < BOUCLE
LAD DMLIG1 < NE PAS OUBLIER L'EDITION, EN
SVC 0 < DEUX FOIS, DE LA LIGNE EN
LAD DMLIG2 < COURS....
SVC 0
RSR
PAGE
EDC: EQU $
<
< E D I T I O N D E 2 C A R A C T E R E S
<
< S U R I M P R I M A N T E / O U T P U T
<
< ARGUMENT:
< 'A' (BITS 8-15) = OCTET A EDITER
<
< EDITION DE 2 CARACTERES DANS LE BUFFER IMPRIMANTE BUFI
< EN ENTREE A CONTIENT 1 OCTET, CET OCTET EST CONVERTI
< POUR DONNER 2 CARACTERES HEXA
<
< PBFI, POINTEUR COURANT BUFFER IMPRIMANTE EST INCREMENTE
<
PSR A,B,X < SAUVEGARDES.
SLRD 4
SLLS 12 < A(0-3)=1ER DIGIT
< B(0-3)=2ND DIGIT
LXI 2
EDC2: EQU $ < BOUCLE D'EDITION
PSR X < SAUVEGARDE COUNT
SLRS 12 < A(12-15)=DIGIT COURANT
CPI '9 < CHIFFRE > '9 ?
JLE EDC1
ADRI '7,A < OUI,LUI AJOUTER '7 (PUIS '30)
EDC1: EQU $
ADRI '30,A < AJOUTER '30 -->CAR HEXA EDITABLE
LX PBFI
STBY &AXTRAV < STOCKAGE CARACTERE
IC PBFI < POINTEUR='+1
LR B,A < SECOND DIGIT
PLR X < RECUP COUNT
JDX EDC2 < BOUCLE
PLR A,B,X < RESTAURATIONS.
RSR
PAGE
TI: EQU $
<
< E D I T I O N T I T R E S U R I M P R I M A N T E / O U T P U T
<
< CE TITRE EST DE LA FORME :
<
< ITEM:<NOM DE L'ITEM>
< OU
< FICHIER:<NOM DU FICHIER>
<
IF ORDI-"S",XWOR%1,,XWOR%1
PSR W
XWOR%1: VAL 0
LXI -2
LR A,W < ADRESSE "FICHIER"/"ITEM"
TI1: EQU $
LA 0,W
STA &AXMTFI
ADRI 1,W
JIX TI1
<
LX LNC
LAI '0D
STBY &AXMTN < 'OD DERRIERE LE NOM
<
LAI MTN-MT*2+1
ADR X,A
STA DMTI+2 < LONGUEUR
LAD DMTI < WRITE TITRE
SVC 0
LAD DMSPI < ESPACEMENT.
SVC 0
< EDITION NOM INTERNE SI FICHIER
CPZ INDFI < FICHIER ?
JE TIF
< OUI, EDITER NOM INTERNE
LA NINT < NOM INTERNE A EDITER.
LY DMNINT+1
ADRI MNI1-MNI*2,Y < ADRESSE OCTET EDITION NOM INTERNE
BSR ACONVA < PLACE LE NOM INTERNE EN ASCI.
LAD DMNINT < EDITION NOM
SVC 0
TIF: EQU $
IF ORDI-"S",XWOR%1,,XWOR%1
PLR W
XWOR%1: VAL 0
RSR
PAGE
TIK: EQU $
<
< E D I T I O N T I T R E - K E Y S U R I M P R I M A N T E /
<
< O U T P U T
<
PSR A,X,Y < SAUVEGARDES.
<
LA KN1 < N1 DE LA CLE.
LY DMTIK+1
ADRI MTIK1-MTIK*2,Y < ADRESSE OCTET EDITION DE N1.
BSR ACONVA < QUI PLACE N1.
<
LA KN2 < N2 DE LA CLE.
ADRI MTIK2-MTIK1*2,Y < ADRESSE OCTET EDITION DE N2.
BSR ACONVA < QUI EDITE N2.
<
LAD DMTIK < EDITION DU TITRE - KEY.
SVC 0
PLR A,X,Y < RESTAURATIONS.
RSR
PAGE
TSTFI: EQU $
<
< T E S T I T E M O U F I C H I E R
<
< TEST: LE NOM EN COURS DESIGNE-T-IL UN FICHIER OU UN ITEM ?
<ON FAIT UN LON AVEC DELTA=-1 ET LONGUEUR > ('7F-'48-'6+1)*2 QUI MET
<VALEUR DERRIERE NOM DANS ZONE VALEUR, ON RECUPERE "BOX" DANS BOX
<
< C'EST UN FICHIER SI:
<
<1: BOX=(('7F-'48-'6+1)*2)-LONGUEUR.DU.NOM.EN.COURS.EOT.INCLUS (CF: LNC)><2: LE
<2: LE MOT D'ADRESSE ('7E-'48-'6) DE LA ZONE NOM-VALEUR = NSPTN+X123X
<3: LE MOT D'ADRESSE ('7F-'48-'6) DE LA ZONE NOM-VALEUR =N AVEC
< 0<=N<=511
<
< POURQUOI? PARCE QUE LE SYSTEME A UN BUFFER DANS LEQUEL IL A:
< EN '48 !A SS IG N N= X, SUIVI DE NOM-VALEUR
< ------ 6 MOTS --
< DE PLUS ON A TOUJOURS POUR UN FICHIER: NOM+VALEUR
< SUR '64 OCTETS DONT ON REGARDE CI-DESSUS (ET CI-DESSOUS)
< US) LES DEUX DERNIERS
<
<
< ENSUITE SI C'EST UN FICHIER, ONFAIT !ASSIGN 3=S PUIS
< !ASSIGN 3=O,NOM-EN-COURS; SI CETTE ASSIGNATION N'EST PAS POSSIBLE
<ON EN CONCLUT QUE LE FICHIER EST DEJA ASSIGNE AILLEURS
<
< AVANT DE REVENIR A L'APPELANT, ON POSITIONNE L'INDICATEUR INDFI
<=0 C'EST UN ITEM
<=1 C'EST UN FICHIER ET IL EST ASSIGNE A L'UL 3
<=-1 C'EST UN FICHIER MAIS ON N'A PAS PU L'ASSIGNER A L'UL 3
<
<
<
< IL FAUT ETRE SUR DE POUVOIR UTILISER LA ZONE NOM+VALEUR
< SANS DEPASSER L'ESPACE ACTUELLEMENT ALLOUE
<
LAI '70 < CELA SUFFIT
STA BOX < POUR LE S/P GESTM
BSR AGESTM < AJUSTEMENT MEMOIRE
<
< MOUVEMENT DU NOM-EN-COURS ET LON
<
LX LNC < LONG NOM-EN-COURS (EOT INCLUS)
TS1: EQU $ < BOUCLE
PSR X < SVG COUNT
ADRI -1,X
LBY &AXNOM
STBY &AXVAL
STBY &AXASS2
STBY &AXMTN
PLR X < RECUP COUNT
JDX TS1 < BOUCLE
<
LAI '7F-'48-6+1*2+1
STA DMLON+2 < LONGUEUR
LAD DMLON < SGN LOAD NAME
SVC 0
JE $+2
ACTD
WORD '1E35
STB BOX < "BOX"=LONGUEUR VALEUR
RBT 16+IVALEX
LA LNC < LONG NOM EN COURS (EOT INCLUS)
ADR B,A < + "BOX"
STA DMLON+2 < POUR LOAD NAME SGN
<
STZ INDFI < INDFI=ITEM A PRIORI
<
< TEST 1
<
LAI '7F-'48-6+1*2
SB LNC
CP BOX
JNE TS2
<
< TEST 2
<
LXI '7E-'48-6
LA &AXVAL
CPI NSPSTN+X123X
JNE TS2
<
< TEST 3
<
LXI '7F-'48-6
LA &AXVAL
STA NINT < AU PASSAGE, STOCK NOM-INTERNE
< DU FICHIER (SI C'EN EST UN ! )
SLRS 8
CPI 1
JG TS2
<
< TESTS 1 2 3 REUSSIS: C'EST DONC UN FICHIER
<
IF ORDI-"T",XWOR%1,,XWOR%1
LAI 128-1
SLLS 1 < A = 128-1*2
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
LRM A
WORD QUANTA*128-1*2
XWOR%1: VAL 0
< CECI POUR LA GESTION MEMOIRE;
< EN EFFET, UN FICHIER UTILISANT
STA BOX < UTILISANT EN RECOUVREMENT LES ZONES
< LT ET VALEUR, IL PREND QUANTA*128-1
< MOTS SUR NOM+VALEUR D'OU LE POSITIONNEMEN
< POSITIONNEMENT DE 'BOX' POUR
< LE S/P GESTM.
<
< TENTATIVE D'ASSIGNATION
<
LAI "3"
BSR ADESAS < DESASSIGNATION UL 3
< ASSIGNATION UL 3
LA ASS4
STA ASS1
LAD DMASS
SVC 0
JNE TS3
IC INDFI < INDFI=1
JMP TS2
TS3: EQU $
DC INDFI < INDFI=-1(ASSIGNATION IMPOSSIBLE)
TS2: EQU $
RSR
IF ORDI-"S",XWOR%1,,XWOR%1
PAGE
TSTAC: EQU $
<
< T E S T A C N D E L O G O N " I N I T I A L ".
<
< RESULTAT:
< - 'ACNC' RECOIT L'ACN COURANT.
< - TESTER AU RETOUR COMME CECI:
<
< JE ACN INITIAL = :SYS
< JNE ACN INITIAL # :SYS.
<
PSR A,B,X
<
WORD '1E25 < 'A' ET 'B' RECOIVENT L'ACN COURANT.
STA ACNC < QU'ON STOCKE.
STB ACNC+1
<
LAD DMLGSY < ESSAYONS LOGON :SYS.
SVC 0
LR X,B < 'B' = CODE RETOUR.
LAD DMLGNC < RELOGON SOUS ACN COURANT.
SVC 0 < ET ICI, PEU IMPORTE LE CODE RETOUR.
CPZR B < POUR TEST EN RETOUR.
<
PLR A,B,X
RSR
XWOR%1: VAL 0
PAGE
ULB: EQU $
<
< C H O I X D ' U N S U P P O R T D E
<
< D U M P A A S S I G N E R A L ' U L ' B
<
< IL S'AGIT DE DEMANDER A L'UTILISATEUR SUR QUEL SUPPORT
< EXTERNE IL VEUT SORTIR SES DUMP, LE SACHANT:
< 1-ON ASSIGNE L'UL B AU BON SUPPORT, ET SI CA N'EST
< PAS POSSIBLE, ON LE DIT ET ON BOUCLE
< 2-ON INITIALISE L'INDICATEUR TYPDMP A LA BONNE VALEUR
< 0 IMPRIMANTE/OUTPUT
< 1 FICHIER
< 2 LIGNE VISU
IF ORDI-"S",XWOR%1,,XWOR%1
< 3 DKU
< 4 CDA
XWOR%1: VAL 0
< -1 PERFORATEUR DE CARTES
< 3-ON FIXE LA TAILLE DE LA PAGE VIRTUELLE ET TOUT CE
< QUI EN RESULTE CAR ON A EN MEMOIRE:
< DEBUT PAGE
< FIN PAGE
< ZONE LT (1 MOT) LONG TOTALE NOM+VAL ITEM
< VALEUR NOM+VALEUR ITEM
<
< BUFF BUFFER FICHIER EN RECOUVREMENT AVEC LT
<
<
< D'OU IL SUIT QUE LA TAILLE DE PAGE ETANT FIXEE,
< ON DOIT FIXER AUSSI LES ADRESSES DE TOUT CE QUI SUIT
<
<
IF ORDI-"S",XWOR%,,XWOR%
STZ STDKU < MODE CONTINU A PRIORI (CF. DKU).
XWOR%: VAL 0
STZ IPRW1P < PREMIER APPEL 'W1P' = OUI.
STZ IPRWPG < PREMIER APPEL 'WPG' = OUI.
LAI "B"
BSR ADESAS < DESASSIGNATION UL 'B
STZ TYPDMP < TYPE DUMP=IMPRIM/VISU A PRIORI
LA AOPAG0
STA AOPAG < ADR DEB PAGE A PRIORI
AD LPP
STA AOFPAG < ADR FIN PAGE A PRIORI
LAI MULB-M
BSR AQREP < QUESTION, REPONSE.
<
< ANALYSE REPONSE UTILISATEUR
<
CPI "I" < IMPRIMANTE
JE ULBI
CPI "O" < OUTPUT
JE ULBO
CPI "C" < CARTES
JE ULBC
CPI "F" < FICHIER
JE ULBF
CPI "V" < LIGNE VISU
JE ULBV
IF ORDI-"S",XWOR%1,,XWOR%1
CPI "D" < DKU
JE ULBD
CPI "M" < MEMOIRE COMMUNE
JE ULBM
CPI "T"
JE ULBT < MT1
XWOR%1: VAL 0
<
JMP ULB < REPONSE NON RECONNUE
ULBI: EQU $ < IMPRIMANTE
LA ASS6
STA ASS1
LA ASS6+1
STA ASS1+1 < ON PREPARE ASSIGN "LP1"
JMP ULBAS
ULBO: EQU $ < ORGANE D'OUTPUT
LA ASS7
STA ASS1 < POR ASSIGN B=O
JMP ULBAS
ULBC: EQU $ < PERFORATEUR CI1 OU CU2
DC TYPDMP < TYPE DUMP=-1
LAI 3
STA DMTMPO+2 < CARTES : TEMPO DE 3 SECONDES.
LA ASS8
STA ASS1
LA ASS81
STA ASS1+1
LAI "B"
STBY ASSUL
LAD DMASS < ESSAI ASSIGN CU1
SVC 0
JE ULBOK
LA ASS82
STA ASS1+1 < ESSAI ASSIGN CU2
JMP ULBAS
ULBF: EQU $ < FICHIER
IC TYPDMP < TYPDUMP=1
LA AOPAG2
STA AOPAG < FIXATION ADR DEB PAGE
AD LPF
STA AOFPAG < FIXATION ADR FIN PAGE
LAI MFICH-M
BSR AENVOI < ENVOI INVITATION POUR NOM FICH
LAD DMREPF < DEMANDE NOM
SVC 0
LA ASSN
STA ASS1
JMP ULBAS
ULBV: EQU $ < LIGNE VISU
LAI 2
STA TYPDMP < TYPDMP=2
LA ASS9 < PREPARATION ASSIGNATION
STA ASS1
LA ASS91
STA ASS1+1
LAI MQV-M < ENVOI DEMANDE...
BSR AQREP < ...QUELLE VISU?
< AU RETOUR A=NUMERO DE VISU DEMANDE.
STBY ASS1+1 < POUR L'ASSIGNATION
IF LPAP-LPAV,,XWOR%1,
LA AOPAG0
AD LPV
STA AOFPAG < FIXATION ADRESSE FIN DE PAGE
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
JMP ULBAS
ULBT: EQU $
LA ASSMT
LB ASSMT+1
STA ASS1 < GENERATION DE LA CARTE !ASSIGN...
STB ASS1+1
XWOR%1: VAL '0B
LAI XWOR%1='FA00('00FF
STBY ASSUL < POUR FAIRE !ASSIGN B=MT1...
LAD DMASS
SVC 0 < ASSIGNATION DE '0B A 'MT1'...
JNE ULBNOK < CE QUI EST IMPOSSIBLE !!!
LRM A,B
BYTE XWOR%1;'0A < ECRITURE SUR MT1,
BYTE XWOR%1;'08 < LECTURE SUR MT1.
JMP ULBDT < OK, ON FAIT COMME POUR DKU...
ULBD: EQU $ < DKU
ULBDQ: EQU $
LAD QOUT
SVC 0 < EDITION DE "!Q",
LAD QIN
SVC 0 < ENTREE DES GROUPES A PROTEGER,
LAD QCCI
SVC 0 < ENVOI DE "!QXXXX" AU CCI,
JNE ULBDQ < ???!?!
LAD DKCCI
SVC 0 < MISE OFF DE LA SYNCHRONISATION SUR
< LKE SECTEUR 0 DE DKU...
LRM A,B
WORD '8A02 < ECRITURE SUR DKU,
WORD '8A00 < LECTURE SUR DKU.
ULBDT: EQU $
STA DMWDKU < GENERATION DES DEMANDES DE
STB DMRDKU < ECRITURE ET DE LECTURE...
LAI 3 < TYPDMP=3
STA TYPDMP
BSR ASP2 < INITIALISATION DE DKU.
JMP ULBOK < PAS BESOIN D'ASSIGNATION EXPLICITE.
<
ULBM: EQU $ < MEMOIRE COMMUNE.
LAI 4
STA TYPDMP < TYPDMP=4.
LA AOPAG0
AD LPM
STA AOFPAG < ADRESSE FIN DE PAGE VIRTUELLE.
ULBM1: EQU $
< ON PROPOSE D'INITIALISER LES VERROUS EN CDA.
LAI MINIT-M
BSR AQREP < QUESTION / REPONSE.
CPI "N"
JE ULBM2 < NE PAS INITIALISER.
CPI "O"
JNE ULBM1 < REPONSE INCORRECTE.
< INITIALISER LES 'NBV' VERROUS A LA VALEUR 'SETV'.
STZ NVC < NUMERO VERROU COURANT.
LX NBV < NOMBRE DE VERROUS.
ULBM3: EQU $
BSR ASETV < SET VERROU COURANT 'NVC'.
IC NVC < INCREMENTATION 'NVC' MODULO 'NBV'.
LA NVC
CP NBV
JL $+2
STZ NVC
JDX ULBM3
ULBM2: EQU $
< INITIALISATIONS.
STZ NVC < VERROU COURANT INITIAL.
LAD DMCDA < !CDA.
SVC 0
JE $+2
ACTD
JMP ULBOK
XWOR%1: VAL 0
ULBAS: EQU $ < ESSAI ASSIGNATION
LA ASS1
STA SASS1 < SAUVEGARDE DE 'ASS1' POUR UNE DISTINC-
< TION EVENTUELLE ENTRE "O" ET "LP1"...
LAI "B"
STBY ASSUL
IF ORDI-"S",XWOR%1,,XWOR%1
BSR ATSTAC < TEST ACN DE LOGON INITIAL (CE S/P
< VA AUSSI POSITIONNER 'ACNC' CE QUI
< PERMETTRA CI-DESSOUS UNE DEMANDE DE
< LOGON ACN COURANT...).
JNE ULBE
LAD DMLGSY < ICI, ON SAIT QUE L'ACN DE LOGON
SVC 0 < INITIAL EST :SYS. ON SE MET DONC SOUS
< :SYS POUR ASSIGNER L'UL 'B, CETTE
< ASSIGNATION NE RISQUE DONC PAS DE
< ETRE REFUSEE POUR DES RAISONS D'HA-
< BILITATION.
ULBE: EQU $
XWOR%1: VAL 0
LAD DMASS
SVC 0
IF ORDI-"S",XWOR%1,,XWOR%1
PSR X < SAVE CODE RETOUR.
LAD DMLGNC < LOGON SOUS ACN COURANT (ET TANT PIS
SVC 0 < POUR CE CODE RETOUR-LA).
PLR X < RESTAURATION CODE RETOUR.
CPZR X
XWOR%1: VAL 0
JE ULBOK < ASSIGNATION OK
ULBNOK: EQU $
LAI MIMP-M < ASSIGNATION IMPOSSIBLE
BSR AENVOI < ON LE SIGNALE...
BR AULB < ...ET ON BOUCLE
ULBOK: EQU $
CPZ TYPDMP < IMPRIMANTE/VISU?
JNE ULB2
ULB7: EQU $
CPZ ISTAND < MODE STANDARD ?
JE ULB6
LAI MNBOCT-M < INVITATION.
BSR AENVOI
LAD DMNBOC < DEMANDE NOMBRE D'OCTETS.
SVC 0
LA DMNBOC+1 < ADRESSE OCTET REPONSE
BSR ACONVH < CONVERSION HEXA
JNE ULB7 < REPONSE INCORRECTE.
JALE ULB7 < REPONSE INACCEPTABLE
STA NBOCT < NOMBRE D'OCTETS.
ULB6: EQU $
LAD DMSKIP < SAUT DE PAGE TOUT DE SUITE
SVC 0
ULB2: EQU $
<
< FIXATION ADRESSES DE: LT (ET BUFF EN RECOUVREMENT)
< VALEUR (NOM+VAL)
<
LA AOFPAG < ADRESSE FIN PAGE VIRTUELLE
ADRI 2,A
STA DMLON+1 < --->ADR NOM+VALEUR
ADRI -2,A
STA AOBUFF < --->ADR OCT BUFFER FICH
STA DMREAD+1 < IDEM
STA DMRDK+1 < ADRESSE OCTET BUFFER DISQUE
SLRS 1 < EN MOTS
STA ABUFF < ADR MOT BUFFER FICH
STA ALT < ADR LONGUEUR TOTALE
ADRI 1,A
SBT 0
STA AXVAL < RELAI INDEXE NOM+VALEUR
IF ORDI-"S",XWOR%1,,XWOR%1
<
< SI LE DUMP EST SUR CARTES OU SUR VISU, ON
< DEMANDE S'IL EST DESTINE A UN SOLAR OU A UN T1600
<
< SI LE DUMP EST SUR FICHIER, ON DONNE A CHOISIR LE QUANTA
< DU FICHIER DE SAUVEGARDE, CELUI-CI VALANT 'QUANTA' A PRIORI.
<
<
< SI LE DUMP EST SUR DKU, ON DEMANDE LES ADRESSES DE DEBUT ET DE FIN
<
LA TYPDMP < TYPE DE DUMP
JAL ULB3 < CARTES
CPI 2
JE ULB3 < VISU
CPI 3
JE ULB1 < DKU
CPI 1
JNE ULB4
ULB5: EQU $ < DUMP SUR FICHIER
LAI MQFS-M < QUANTA DU FICHIER DE SAUVEGARDE ?
BSR AQREP < QUESTION, REPONSE. AU RETOUR LA
< REPONSE EST DANS 'A'.
XWORK1: VAL QUANTA='FA00('00FF
CPI XWORK1 < Q DEMANDE = Q UTILISE ?
JE ULB4 < OUI, RIEN A FAIRE.
CPI "1" < QUANTA 1 DEMANDE ?
JNE ULB5 < REPONSE NON RECONNUE
LRM A,B
WORD 128-1*2 < TAILLE PAGE VIRTUELLE
WORD 128*2 < TAILLE BUFFER POUR DEMANDE SGF
STB DMWBLC+2
AD AOPAG2 < ADRESSE DE FIN DE PAGE VIRTUELLE
STA AOFPAG < ET TANT PIS POUR LES
< (QUANTA-1*128) MOTS RESERVES
< ET DEVENUS INUTILES !!!
JMP ULB4
ULB3: EQU $ < DUMP CARTES OU VISU
LAI MTOUS-M < ENVOI DEMANDE
BSR AQREP < QUESTION, REPONSE.
CPI "S"
JE ULB4 < SOLAR: LA TAILLE BUFFERS FICHIERS
< A DUMPER A ETE CORRECTEMENT
< INITIALISEE
CPI "T" < T1600 ?
JNE ULB3
LRM A < VERS T1600
WORD 128*2 < D'OU LA TAILLE BUFFER
STA DMREAD+2 < DANS LA DEMANDE SGF
JMP ULB4
ULB1: EQU $ < CAS DKU
LAI MASD-M < DEMANDE ADRESSE DEBUT
BSR ADVAS
STA ADKUD
ADRI -1,A
STA DMWDKU+3
LAI MASF-M < DEMANDE ADRESSE FIN
BSR ADVAS
STA ADKUF
EOR ADKUD < VERIFICATION DE FIN>=DEBUT
JAGE ULB8
CPZ ADKUF
JGE ULB1
JMP ULB9
ULB8: EQU $
LA ADKUD
CP ADKUF
JG ULB1
ULB9: EQU $
<
< DEFINITION DU SYSTEME DE CODAGE :
<
STZ ICLEF < PAS DE CODAGE A PRIORI...
LAI MCLEF1-M
BSR AENVOI
LAD DMCLEF
SVC 0 < ENTREE DE LA CLEF DE CODAGE :
LXI 0 < X=INDEX DES CLEFS,
LBI 0 < POUR DETECTER LES CLEFS IDENTIQUES.
CLEF1: EQU $
LBY &ACLEF < A=CLEF COURANTE :
ADRI -"0",A < CONVERSION BINAIRE :
JAL CLEF9 < ERREUR ==> PAS DE CODAGE !!!
CPI 10
JL CLEF2 < C'EST UN CHIFFRE DECIMAL...
ADRI -"A"+"9"+1,A
CPI 10
JL CLEF9 < ERREUR ==> PAS DE CODAGE...
CPI 16
JGE CLEF9 < ERREUR ==> PAS DE CODAGE...
CLEF2: EQU $
STBY &ACLEF < SAUVEGARDE DE LA CLEF EN BINAIRE...
XR A,X
STBY &ACLEFB < POUR LES ERREURS EVENTUELLES...
< (IL FAUT REDECODER...)
TBT 16,X < EXISTE-T'ELLE DEJA ???
SBT 16,X
XR A,X
JC CLEF9 < OUI ==> PAS DE CODAGE...
ADRI 1,X < A LA SUIVANTE...
LR X,A
CPI LCLEF
JL CLEF1 < OK, IL Y EN A UNE...
LAI MCLEF2-M
BSR AENVOI < C'EST FINI, TOUT EST BON, ON
< LE DIT,
IC ICLEF < ET ON LE MEMORISE...
CLEF9: EQU $
ULB9X: EQU $
LAI MSTDKU-M
BSR AQREP < CONTINU OU DISCONTINU ???
CPI "O"
JE ULB9Y < CONTINU : STDKU=0...
ULBD2: EQU $
CPI "N"
JNE ULB9X < ???
IC STDKU < DISCONTINU : STDKU=1...
ULB9Y: EQU $
ULB4: EQU $
XWOR%1: VAL 0
LA AOFPAG < CALCUL ET STOCKAGE DE
ADRI -2,A < L'ADRESSE CRITIQUE POUR L'ALGORITHME
STA AOCRIT < DE COMPACTAGE
<
< ICI, ON PEUT DEJA ENVOYER DATE DUMP ET ACN DUMP EN PAGE VIRTUELLE,
< MAIS ON NE LE FERA QUE SI L'ON N'EST PAS EN DUMP SOLAR SUR DKU.
< EN EFFET, DANS CE DERNIER CAS, DATE ET ACN SERONT ENVOYES A CHAQUE
< FOIS QUE L'ON FERA LE DUMP D'UNE ENTITE (FICHIER, ITEM, ESPACE DISQUE).
<
IF ORDI-"T",XWOR%1,,XWOR%1
BSR ADMPDA < DUMP DATE ET ACN.
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
CPZ STDKU
JNE ULBA
BSR ADMPDA < DUMP DATE ET ACN.
ULBA: EQU $
XWOR%1: VAL 0
RSR
PAGE
DMPDA: EQU $
<
< A C Q U I S I T I O N E T D U M P D E L A D A T E
<
< E T D E L ' A C N . S Y S T E M A T I Q U E M E N T
<
< S I L ' O N E S T E N M O D E S T A N D A R D ;
<
< O P T I O N N E L L E M E N T S I N O N.
<
< LA DATE SERA ENVOYEE EN PAGE VIRTUELLE SOUS FORME
< DE 12 CHIFFRES ASCI (AA MM JJ HH MM SS) PRECEDES DU
< DELIMITEUR 'DA.
< L'ACN SERA ENVOYE PRECEDE DU DELIMITEUR 'AC.
<
PSR A,B,X,Y < SAUVEGARDES
PSR W < SUITE SAUVEGARDES
<
< FAUT-IL COMPACTER ???
<
LAI MCOMPA-M
BSR ACHOIX
STA ICOMPA < ICOMPA=0 : COMPACTER,
< #0 : NE PAS COMPACTER...
<
< DUMP EVENTUEL DE LA DATE (PRECEDEE DU DELIMITEUR 'DA)
< EN PAGE VIRTUELLE.
<
LAI MDATE-M < MESSAGE POUR PROPOSITION EVENTUELLE.
BSR ACHOIX < CHOIX DE L'OPTION.
JANE DMPDA3 < PAS DE DUMP DATE.
<
< ACQUISITION ET DUMP DE LA DATE.
<
LAI 'DA < DELIMITEUR SIGNIFIANT "DATE".
BSR AW1PG < ON L'ECRIT EN PAGE VIRTUELLE.
LAI NSPDAT
SBT 0
WORD '1E15 < 'B' <--- ADRESSE MOT DES 6 MOTS
< CONTENANT LA DATE ET L'HEURE
< DANS L'ORDRE HABITUEL ET EN BINAIRE
< DANS LEUR OCTET DROIT.
LR B,Y < 'Y' = ADRESSE MOT COURANT.
LXI 6 < 6 MOTS (AA MM JJ HH MM SS).
IF ORDI-"T",XWOR%1,,XWOR%1
LA AWORK
LR A,W < ADRESSE ZONE DE STOCKAGE DATE.
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
LRM W
WORD WORK < ZONE DE STOCKAGE DATE OBTENUE.
XWOR%1: VAL 0
DMPDA1: EQU $
LR Y,A
ADRI 1,Y < C'EST FAIT.
WORD '1E15 < ACCES AU MOT COURANT.
STB 0,W < STOCKAGE EN ZONE DE TRAVAIL.
ADRI 1,W < POUR MOT SUIVANT.
JDX DMPDA1 < AU SUIVANT.
<
< IL FAUT INVERSER ANNEE ET JOUR POUR METTRE LA DATE DANS L'ORDRE
< HABITUEL.
<
ADRI -6,W < 'W' POINTE LE PREMIER MOT DE 'WORK'.
LA 0,W
IF ORDI-"T",XWOR%1,,XWOR%1
LB 2,W
STB 0,W
STA 2,W < ECHANGE ANNEE/JOUR EFFECTUE.
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
XM 2,W
STA 0,W < ECHANGE ANNEE/JOUR EFFECTUE.
XWOR%1: VAL 0
LXI 6 < 6 MOTS (JJ MM AA HH MM SS).
DMPDA5: EQU $
LB 0,W < ACCES AU MOT COURANT.
ADRI 1,W < C'EST FAIT.
SLLD 16+8 < ON RAZE 'A' ET 'B'(0-7).
SLRD 16+8
DV DIX < 'A'=QUOTIENT; 'B'=RESTE.
ORI '30 < CONVERSION ASCI.
BSR AW1PG < ECRITURE EN PAGE VIRTUELLE.
LR B,A
ORI '30 < CONVERSION ASCI SECOND CHIFFRE.
BSR AW1PG < ET SON ECRITURE EN PAGE VIRTUELLE.
JDX DMPDA5
<
DMPDA3: EQU $
<
< DUMP EVENTUEL DE L'ACN (PRECEDE DU DELIMITEUR 'AC) EN PAGE VIRTUELLE.
<
LAI MACN-M < MESSAGE POUR PROPOSITION EVENTUELLE.
BSR ACHOIX < CHOIX DE L'OPTION.
JANE DMPDA2 < PAS DE DUMP DE L'ACN.
<
< ACQUISITION ET DUMP DE L'ACN.
<
LAI 'AC < DELIMITEUR SIGNIFIANT "ACN".
BSR AW1PG < ON L'ECRIT EN PAGE VIRTUELLE.
WORD '1E25 < 'A' ET 'B' RECOIVENT L'ACN.
LR B,Y < ON PROTEGE 'B'.
LXI 2
DMPDA4: EQU $
SLRD 8 < PREMIER OCTET.
BSR AW1PG < WRITE.
SLLD 8 < SECOND OCTET.
BSR AW1PG < WRITE.
LR Y,A < AUX DEUX OCTETS SUIVANTS.
JDX DMPDA4
DMPDA2: EQU $
PLR W < RESTAURATIONS...
PLR A,B,X,Y < FIN RESTAURATIONS.
RSR
PAGE
SP1: EQU $
<
< F I N D E T R A V A I L - O P E R A T I O N S D E F I N
<
< SI L'ON A FAIT AU MOINS UN DUMP,
< ON ENVOIE DELIMITEUR DE FIN
< SUR PAGE VIRTUELLE, ET ON L'ECRIT
< DELIM DE FIN = '0000
CPZ IPRDM < AU MOINS 1 DUMP ?
JE PAR51
< OUI
< ENVOYER '0000
LAI 0
BSR AW1PG
LAI 0
BSR AW1PG
IF ORDI-"S",XWOR%1,,XWOR%1
<
< CELA ETANT FAIT, IL NOUS FAUT PRENDRE UNE PRECAUTION. EN SUPPOSANT
< QUE NOUS SOYONS EN DUMP DKU MULTIPLE ET QUE NOUS REMPLISSIONS
< COMPLETEMENT LA PAGE COURANTE, NOUS PROVOQUERONS UN PLANTAGE DE REST
< LORS DE LA RESTAURATION. EN EFFET, CELUI-CI, LORSQU'IL A EXPLOITE
< LE DERNIER OCTET D'UNE PAGE VIRTUELLE, DEMANDE LA LECTURE DE LA
< PAGE SUIVANTE (CF: REST S/P 'LDC'). EN DKU MULTIPLE, IL TROUVERA
< SUR LA DITE PAGE UN CHAINAGE = 0, ALORS QU'IL ATTEND AUTRE CHOSE
< (CF: LECTURE PAGE VIRTUELLE DKU DANS REST).
< SOLUTION: EN DUMP DKU MULTIPLE, IL SUFFIT D'ENVOYER EN PAGE VIRTUELLE
< NON PAS DEUX MAIS TROIS DELIMITEURS '0. LE DERNIER DE CEUX-CI NE SERA
< JAMAIS EXPLOITE PAR REST, MAIS DANS LE CAS PRECITE, REST TROUVERA UN
< BLOC CORRECTEMENT CHAINE, INUTILE CERTES, MAIS IL EST TOUJOURS
< DANGEREUX DE CONTRARIER UN PROGRAMME...
<
CPZ STDKU < ALORS, ON EST EN MODE DKU MULTIPLE?
JE SP11
< OUI, FAISONS NOTRE PETITE CUISINE...
LAI 0 < VOICI NOTRE TROISIEME DELIMITEUR.
BSR AW1PG < ET VOILA...
SP11: EQU $
XWOR%1: VAL 0
<
< STORER LE COMPTEUR DE COMPACTAGE
< EN COURS
LX PCMP
LA CCMP
STBY &AXTRAV
< WRITE DERNIERE PAGE
CPZ IPRWPG < Y-A-T-IL DEJA EU 1 WRITE
< PAGE VIRTUELL?
JNE PAR52 < OUI
BSR AWPG < NON,FAIRE UN APPEL
PAR52: EQU $
LAI -1
STA IPRWPG < IPRWPG=DERNIER APPEL
BSR AWPG < WRITE PAGE VIRTUELLE
< LE S/P WPG SE DEBROILLE POUR
< NE PAS FAIRE DE WRITE INUTILES
PAR51: EQU $
STZ BOX
BSR AGESTM < ON RELACHE L'ESPACE
< INUTILE
RSR
IF ORDI-"S",XWOR%,,XWOR%
PAGE
SP2: EQU $
<
< I N I T I A L I S A T I O N D K U :
<
LA AOPAG2 < DEBUT PAGE VIRTUELLE
STA AOPAG
AD LPD < FIN DE CETTE PAGE
STA AOFPAG
STZ N0BDKU < INIT. DU NUMERO DE BLOC
RSR
XWOR%: VAL 0
PAGE
RCUPK: EQU $
<
< R E C U P E R A T I O N D E L A C L E D E
<
< L ' E N R E G I S T R E M E N T E N C O U R S
<
<
< RESULTAT:
< 'KN1' ET 'KN2' RECOIVENT (N1,N2).
<
<
< NOTA:
< ----
<
< EN T1600, ON VA CHERCHER N1 ET N2 PAR UNE SERIE
< DE '1E15. EN SOLAR, ON UTILISE LES POSSIBILITES DU
< SYSTEME QUI RENVOIE DANS LA 'BOX':
< - N1 SUITE A UN OPEN NEW/NEXT/OLD KEY.
< - N2 SUITE A UN CLOSE SAVE/RELEASE KEY.
<
IF ORDI-"T",XWOR%1,,XWOR%1
PSR A,B,X
WORD '1E45 < A <--- SYSID
ADRI NSPESC,A
SBT 0
WORD '1E15 < B <--- A(CONTEXTE UTILISATEUR)
LR B,A
ADRI '3/2+'39,A
WORD '1E15 < B <--- A(UL '2 & '3)
LR B,A
ANDI 'FF < A=NSP FICHIER
SBT 0
RBT 8
WORD '1E15 < B <--- A(CONTEXTE FICHIER)
LR B,A
ADRI CLEFS+VAR,A < A POINTE N1
PSR A
ADRI 1,A < A POINTE SUR N2
WORD '1E15 < B RECOIT N2
STB KN2
PLR A
WORD '1E15 < B RECOIT N1
STB KN1
PLR A,B,X
RSR
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
<
< NOUS SOMMES EN SOLAR; NOUS VENONS DE FAIRE UN OPEN NEXT KEY;
< DONC UN '1E35 DONNERA DANS 'B':
< - BIT 0 : = 1 N2 EST NON NUL.
< = 0 N2 EST NUL.
< - BITS 3-15 : N1.
<
PSR A,B,X < SAUVEGARDES.
WORD '1E35
TBT 16+0 < N2 NUL OU PAS ?
RBT 16+0 < ON RAZE...
STB KN1 < ... AVANT DE STOCKER N1.
STZ KN2 < N2 EST NUL A PRIORI.
JNC RCUP1 < SI N2 EST BIEN NUL.
<
< N2 N'ETANT PAS NUL, IL FAUT POUR LE RECUPERER FAIRE UN CLOSE SAVE
< KEY, LIRE N2 DANS LA 'BOX', PUIS FAIRE UN OPEN OLD KEY POUR
< FAIRE COMME SI RIEN NE S'ETAIT PASSE...
<
LAD DMCLS < CLOSE SAVE KEY.
SVC 0
WORD '1E35 < 'B' RECOIT 'BOX'.
STB KN2 < ON A LE N2 DE LA CLE.
LAD DMOPOK < OPEN OLD KEY...
SVC 0
RCUP1: EQU $
PLR A,B,X < RESTAURATIONS.
RSR
XWOR%1: VAL 0
PAGE
DMPDK: EQU $
<
< D U M P D I S Q U E
<
IF ORDI-"S",XWOR%1,,XWOR%1
PSR W
<
< EN SOLAR, A PRIORI, ON LIT LE DISQUE A DUMPER EN UTILISANT UNE
< ASSIGNATION EXPLICITE.
<
LAI 3
STBY DMRDK
LAI 1
STA PASSEC < PAS DE 1 A PRIORI...
DMPDKQ: EQU $
XWOR%1: VAL 0
LAI "3" < DESASSIGNATION UL 3
BSR ADESAS
LBY DMASDK+1
STZ DMASDK+1
STBY DMASDK+1
LAD DMASDK < DECONNEXION UL 3
SVC 0
IF ORDI-"S",XWOR%1,,XWOR%1
LA DMRDK < IL FAUT "RAZER" SYSTEMATIQUEMENT
RBT 12 < LE BIT 12 DE LA DEMANDE DK.
STA DMRDK
<
< PROPOSITION DE RECHERCHE :
<
DMQDKA: EQU $
STZ IRECHE < NON A PRIORI...
CPZ ISTAND < EST-CE LE MODE STANDARD ???
JE DMQDKB < OUI, PAS DE RECHERCHE...
LAI MRECHE-M < NON,
BSR AQREP < VEUT-ON UNE RECHERCHE ???
CPI "N"
JE DMQDKC < VERS LE PAS DES ADRESSES...
CPI "O"
JNE DMQDKA < ??!!?!?
IC IRECHE < OUI :
LAI MCHAIN-M
BSR AENVOI
LAD DRECHE
SVC 0 < ENTREE DE LA CHAINE RECHERCHEE...
LAI '7F
STA MASKRE <POUR L'ASCI, ON IGNORE LA PARITE...
LXI 0
LBY &ARECHE < (A)=PREMIER CARACTERE DE LA CHAINE :
CPI '04 < EST-ELLE VIDE ???
JE DMPDKX < OUI...
CPI '0D < EST-ELLE VIDE ??
JNE DMPDK2 < NON...
DMPDKX: EQU $ < OUI, ENTREE HEXA-DECIMALE :
LAI MCHAIX-M
BSR AENVOI
LAD DRECHX
SVC 0
LA DRECHX+1
BSR ACONVH < CONVERSION BINAIRE DES 4 CARACTERES :
JNE DMPDKX < ERREUR, ON REDEMANDE...
LXI 0 < OK :
STA &ARECHE < ET ON MET LES 4 CHIFFRES HEXA-DECIMAUX
< EN TETE DU BUFFER,
LXI 2
LAI '04
STBY &ARECHE < SUIVI D'UNE FIN DE MESSAGE...
LAI 'FF
STA MASKRE < POUR L'HEXA, ON PREND LES 8 BITS...
DMPDK2: EQU $
<
< ENTREE DU PAS DES ADRESSES DISQUES :
<
DMQDKC: EQU $
LAI MPASEC-M
BSR AENVOI < ENOI DE L'INVITATION :
LAD DMASNS
SVC 0 < ENTREE DU PAS,
LA DMASNS+1
BSR ACONVH < CONVERSION BINAIRE :
JNE DMQDKC < FAUTE DE SYNTAXE...
JALE DMQDKC < LE PAS DOIT ETRE POSITIF STRICTEMENT...
STA PASSEC < OK...
DMQDKB: EQU $
XWOR%1: VAL 0
<
< PROPOSITION DE DEBUG DES BUFFERS DK
<
DMPDKG: EQU $
STZ IDEBUG < PAS DE DEBUG A PRIORI
CPZ ISTAND < MODE STANDARD ?
JE DMPDKH < ALORS PAS DE DEBUG DK.
LAI MDEBUG-M
BSR AQREP < INVITATION ET REPONSE
CPI "N"
JE DMPDKH < PAS DE DEBUG DEMANDE
CPI "O"
JNE DMPDKG < REPONSE NON RECONNUE
IC IDEBUG < DEBUG DEMANDE
<
< PROPOSITION D'UN NUMERO DE DISQUE
<
DMPDKH: EQU $
LAI MQDK-M
BSR AQREP < QUESTION, REPONSE: AU RETOUR LE
< NUMERO DE DK DEMANDE EST DANS 'A'.
STBY DMIDK1+1 < POUR EDITION EVENTUELLE
CPI "3" < DK3 ?
JE DMPDK3 < EN T1600 ET EN SOLAR,
< ON A QUANTA(DK3)=1
CPI "2" < DK2 ?
IF ORDI-"T",XWOR%1,,XWOR%1
JNE DMPDKH < T1600 REPONSE NON RECONNUE
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
JE DMPDKK
CPI "1"
JE DMPDKK < VERS LE QUANTA POUR DK1...
CPI "A" < SOLARD DKA (FIXE) ?
JE DMPDK3
CPI "B"
JNE DMPDKH < SOLAR REPONSE NON RECONNUE
JMP DMPDKJ < QUANTA=3 OBLIGATOIRE...
DMPDK0: EQU $
XWOR%1: VAL 0
<
< DK2 (T1600-SOLAR) OU DKB-DK1 (SOLAR) : QUANTA=F(ORDINATEUR) :
<
IF ORDI-"S",XWOR%1,,XWOR%1
<
< ON DONNE LE CHOIX DU QUANTA SUR DK1 ET DK2 SOLAR :
<
DMPDKK: EQU $
PSR A < OUI, SAUVER LA REPONSE...
DMPDKE: EQU $
LB DMRDK < DEMANDE DE READ DK
LAI MQDK2-M < DEMANDE DU QUANTA
BSR AQREP < QUESTION ET REPONSE
CPI QUANTA='FA00('00FF < C'EST LE Q UTILISE ?
JE DMPDKF < OUI
CPI "1" < QUANTA 1 ?
JNE DMPDKE < REPONSE NON RECONNUE
SBT 16+12 < QUANTA 1 : IL FAUT POSITIONNER
< LE BIT 12 DE LA DEMANDE.
DMPDKF: EQU $
STB DMRDK < PREMIER MOT DE LA DEMANDE
PLR A < RESTAURATION REPONSE (DK I)
TBT 16+12
JC DMPDK3 < PUISQU'ON A UN QUANTA 1.
DMPDKJ: EQU $
LRM B < SOLAR ET QUANTA = 3
WORD QUANTA*128*2
JMP DMPDK4
XWOR%1: VAL 0
DMPDK3: EQU $
<
< QUANTA=1 (T1600 DK2-DK3 ; SOLAR DK3-DKA)
<
LBI 128
ADR B,B
DMPDK4: EQU $
STB DMRDK+2 < LONGUEUR OCTETS DEMANDE DK
IF ORDI-"S",XWOR%1,,XWOR%1
LBI NSPDKA < POUR CALCUL DU NSPDKX
CPI "A"
JL DMPDK1 < DK2 OU DK3 DEMANDE
JE $+2 < B=NSPDKA
ADRI -1,B < B=NSPDKB
LR B,A
ADRI +'30-NSPDK1+1,A
DMPDK1: EQU $
XWOR%1: VAL 0
ADRI -'30+NSPDK1-1,A < NSPDKI
SWBR A,B
LBY DMASDK+1
SLLD 8
STA DMASDK+1
IF ORDI-"S",XWOR%1,,XWOR%1
LA DMASDK+1
ANDI 'FF
CPI NSPDK1 < EST-CE DK1 (DKU, ASSIGNATION IMPLICITE).
JNE DMPDKR
< DK1 (DKU), ON UTILISERA UNE ASSIGNAION IMPLICITE, CE QUI EVITERA DES
< PROBLEMES D'HABILITATION ET DE PROTECTION.
LAI '8A
STBY DMRDK
JMP DMPDK5
DMPDKR: EQU $
XWOR%1: VAL 0
LAD DMASDK < CONNEXION UL 3 <--> NSPDKI
SVC 0
JE DMPDK5
LAI MIMP-M < CONNEXION IMPOSSIBLE
BSR AENVOI < ON PREVIENT
IF ORDI-"T",XWOR%1,,XWOR%1
JMP DMPDK < ET ON BOUCLE
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
JMP DMPDKQ < ET ON BOUCLE.
XWOR%1: VAL 0
<
< PROPOSITION ADRESSE SECTEUR
<
DMPDK5: EQU $
LAI MAS-M
BSR AENVOI < ENVOI DEMANDE
LAD DMASNS < DEMANDE ADRESSE
SVC 0
LA DMASNS+1 < A=ADRESSE OCTET ADRESSE SECTEUR
BSR ACONVH < CONVERSION DANS A
JNE DMPDK5 < ADRESSE INCORRECTE
STA DMRDK+3 < STORE ADRESSE SECTEUR DANS LA DEMANDE
<
< PROPOSITION NOMBRE DE SECTEURS
<
DMPDK6: EQU $
LAI MNS-M
BSR AENVOI < ENVOI DEMANDE
LAD DMASNS < DEMANDE NOMBRE DE SECTEURS
SVC 0
LA DMASNS+1 < A=ADRESSE OCTET COMPTE DE SECTEURS
BSR ACONVH < CONVERSION
JNE DMPDK6 < NOMBRE INCORRECT
JAE DMPDK6 < NOMBRE INACCEPTABLE
SARD 16
DV PASSEC < ON TIENT COMPTE DU PAS...
STA NBSECT < STORE NOMBRE DE SECTEURS
<
< ASSIGNATION EVENTUELLE DE L'UL 'B
<
CPZ IPRDM < PREMIER DUMP ?
JNE DMPDK7 < NON
IC IPRDM < OUI, BASCULEMENT
BSR AULB < ET ASSIGNATION DE L'UL 'B
< ET TOUT CE QUI S'EN SUIT
< (IMPLANTATIONS ETC..)
DMPDK7: EQU $
<
< DUMP DISQUE PROPREMENT DIT
<
LAI '1B < CTRL-SHIFT-K
WORD '1EA5 < REMPLACE ALT-MODE
LA DMRDK+2 < TAILLE OCTET BUFFER DISQUE
STA BOX < POUR LE S/P GESTM
BSR AGESTM < AJUSTEMENT MEMOIRE
<
IF ORDI-"S",XWOR%1,,XWOR%1
< EN SOLAR, IL FAUT ICI, SI ET SEULEMENT SI ON FAIT UN DUMP
< SUR DKU EN MODE MULTIPLE, FAIRE LE DUMP DE LA DATE ET DE L'ACN
< AVANT DE FAIRE CELUI DE L'ESPACE DISQUE.
<
CPZ STDKU
JE DMPDKL
BSR ADMPDA < DUMP DATE ET ACN.
JMP DMPDKP
DMPDKL: EQU $
<
< DE PLUS, EN SOLAR, ON REGARDE SI L'ACN DE DUMP A CHANGE,
< ET SI OUI, ON FAIT UN DUMP DE DATE ET ACN.
<
CPZ INACN < "NOUVEL" ACN ?
JE DMPDKP
STZ INACN < RAZ INDICATEUR.
BSR ADMPDA < ET DUMP DATE, ACN.
DMPDKP: EQU $
XWOR%1: VAL 0
<
LAI 'DD
BSR AW1PG < WRITE DELIMITEUR DEBUT DISQUE
LA DMRDK+2 < TAILLE OCTET BUFFER
SLRS 1 < EN MOTS
CPI 128 < EST-CE 128 MOTS/SECTEUR ?
LAI 1 < OUI A PRIORI
JE $+2
ADRI 2,A < QUANTA = 3
BSR AW1PG < WRITE QUANTA
LA DMASDK+1
ANDI 'FF < A=NSPDKI
BSR AW1PG < WRITE NSPDKI
LAD DMRDK+3 < ADRESSE(ADRESSE(1ER SECTEUR))
SLLS 1 < ADRESSE OCTET
LXI 2 < 2OCTETS
BSR AWNPG < WRITE ADRESSE 1ER SECTEUR
LAD NBSECT < ADRESSE(NOMBRE DE SECTEURS)
SLLS 1 < ADRESSE OCTETS
LXI 2 < 2 OCTETS
BSR AWNPG < WRITE COMPTE DE SECTEURS
<
CPZ TYPDMP < DUMP IMPRIMANTE/OUTPUT ?
JNE DMPDK8
LAD DMSPI < SAUTS DE LIGNES
SVC 0
LAD DMIDK < IDENTIFICATION DISQUE
SVC 0
DMPDK8: EQU $
LX NBSECT < NOMBRE DE SECTEURS
DMPDK9: EQU $
PSR X < SAUVEGARDE COUNT
LAD DMRDK < READ 1 SECTEUR
SVC 0
JE $+2
ACTD
<
< RECHERCHE ???
<
IF ORDI-"S",XWOR%1,,XWOR%1
CPZ IRECHE < UNE RECHERCHE EST-ELLE DEMANDEE ???
JE DMQDKJ < NON...
LA DMRDK+1 < OUI,
SLRS 1
SBT 0
STA ABUFDK < GENERATION D'UN REALI D'ACCES AU BUFFER
< DISQUE COURANT...
LXI -1 < (X)=INDEX D'EXPLORATION DU BUFFER...
DMQDKL: EQU $
LYI 0 < (Y)=INDEX D'EXPLORATION DE LA CHAINE...
DMQDKM: EQU $
ADRI 1,X < INDEX DU CARACTERE SUIVANT DANS LE BUFFER
LR X,A
CP DMRDK+2 < EST-ON AU BOUT DU BUFFER ???
JGE DMQDKN < OUI, ON IGNORE LE SECTEUR COURANT, CAR
< LA CHANE CHERCHEE N'Y FIGURE PAS...
XR X,Y
LBY &ARECHE < (A)=CARACTERE COURANT CHERCHEE,
XR X,Y
CPI '04 < FIN DE CHAINE ???
JE DMQDKJ < OUI, ON EDITE LE SECTEUR COURANT...
CPI '0D < FIN DE CHAINE ???
JE DMQDKJ < OUI, ON EDITE LE SECTEUR COURANT...
LR A,B < (B)=CARACTERE CHERCHE,
LBY &ABUFDK
AND MASKRE < (A)=CARACTERE COURANT DU BUFFER (AVEC OU
< SANS PARITE, SUIVANT ASCI/HEXA...).
CPR A,B < ALORS, COINCIDENCE ???
JE DMQDKO < OUI, AU SUIVANT...
CPZR Y < NON, EST-CE LE PREMIER DE LA CHAINE ???
JE DMQDKL < OUI...
ADRI -1,X < NON, AFIN DE RETESTER LE CARACTERE
< COURANT AVEC LE DEBUT DE CHAINE...
JMP DMQDKL
DMQDKO: EQU $
ADRI 1,Y < AU SUIVANT DANS LA CHAINE...
LR Y,A
CPI LRECHE < SI EXISTE...
JL DMQDKM < ET OUI...
DMQDKJ: EQU $ < EDITION DE CE SECTEUR COURANT...
XWOR%1: VAL 0
CPZ IDEBUG < DEBUG DEMANDE ?
JE DMPDKI < NON.
<
< DEBUG DEMANDE : ON VA SORTIR SUR L'UL 2 L'ADRESSE DU SECTEUR
< EN COURS ET L'ADRESSE DU BUFFER QUI LE CONTIENT, PUIS
< REVENIR AU CCI POUR QUE L'UTILISATEUR FASSE SON DEBUG.
<
LY DMDBG+1 < ADRESSE OCTET A LAQUELLE DOIT
ADRI MDBGAS-MDBG*2,Y < ETRE PLACEE L'ADRESSE SECTEUR
< EN CLAIR (C-A-D EN ASCI !)
LA DMRDK+3 < ADRESSE SECTEUR COURANT
BSR ACONVA < CONVERSION EN ASCI
ADRI MDBGAB-MDBGAS*2,Y < ADRESSE OCTET A LAQUELLE DOIT
< ETRE PLACEE L'ADR BUFFER DK EN CLAIR
LA DMRDK+1
SLRS 1 < ADRESSE MOT DU BUFFER DK
BSR ACONVA < CONVERSION EN ASCI
LAD DMDBG < MESSAGE DE DEBUG
SVC 0
LAD DMCCI < RETOUR CCI
SVC 0
DMPDKI: EQU $
CPZ TYPDMP < DUMP IMPRIMANTE/OUTPUT ?
JNE DMPDKA
LAD DMSPI < ESPACEMENTS
SVC 0
SVC 0
LA DMRDK+3 < ADRESSE SECTEUR
LY DMIAS+1 < ADRESSE OCTET EDITION ADRESSE SECTEUR
BSR ACONVA < QUI PLACE L'ADRESSE SECTEUR EN ASCI.
LAD DMIAS < EDITION ADRESSE SECTEUR
SVC 0
LY DMRDK+1 < ADRESSE OCTET BUFFER A EDITER
LX DMRDK+2 < LONGUEUR OCTETS
BSR AEDI < EDITION BUFFER
<
DMPDKA: EQU $
LA DMRDK+1 < ADRESSE OCTET BUFFER
LX DMRDK+2 < NOMBRE D'OCTETS
BSR AWNPG < WRITE BUFFER EN PAGE VIRTUELLE
<
DMQDKN: EQU $
LA DMRDK+3 < ADRESSE SECTEUR SUIVANT
AD PASSEC
STA DMRDK+3
PLR X < RECUPERATION COUNT
JDX DMPDK9
<
LAI 'FD < DELIMITEUR FIN DE DISQUE
BSR AW1PG < WRITE DELIMITEUR FIN DE DISQUE
IF ORDI-"S",XWOR%1,,XWOR%1
CPZ STDKU < SI L'ON EST EN DUMP DKU, MODE MULTIPLE
JE DMPDKN
BSR ASP1 < ON FAIT SEMBLANT D'AVOIR TERMINE
BSR ASP2 < LE DUMP ET ON EN RECOMMENCE
STZ IPRW1P < UN NOUVEAU.
STZ IPRWPG
DMPDKN: EQU $
XWOR%1: VAL 0
<
< DECONNEXION UL 3 <--> NSPDKI
<
LBY DMASDK+1
STZ DMASDK+1
STBY DMASDK+1
LAD DMASDK
SVC 0
<
LAI '7D < ALT-MODE
WORD '1EA5 < EST RESTAURE
<
IF ORDI-"S",XWOR%1,,XWOR%1
PLR W
XWOR%1: VAL 0
RSR
PAGE
CONVH: EQU $
<
< CONVERSION EN BINAIRE D'UN NOMBRE HEXADECIMAL SAISI
< EN ASCI (PAR EXEMPLE, NUMERO DE SECTEUR)
<
< ARGUMENTS:
< 'A' = ADRESSE OCTET DES 4 CARACTERES ASCI
<
< RESULTAT:
< 'A' = NOMBRE EN BINAIRE, A VALIDER EN FAISANT AU RETOUR:
< JE OK OU
< JNE ERREUR
<
PSR B,X,Y,W < SAUVEGARDES
LR A,Y < Y = ADRESSE CARACTERE EN COURS
LXI 4 < INIT COUNT
CONVH1: EQU $
LR X,W < SAUVEGARDE COUNT
LR Y,X < INDEX CARACTERE
LBY &AXTRAV < CARACTERE
CPI "0"
JL CONVH3 < ERREUR
CPI "9"
JLE CONVH2
CPI "A"
JL CONVH3 < ERREUR
CPI "F"
JG CONVH3 < ERREUR
ADRI -7,A
CONVH2: EQU $
ADRI -'30,A
SLLS 12
SCLD 4 < CHIFFRE HEXA DANS 'B'
ADRI 1,Y < CARACTERE SUIVANT
LR W,X < RESTAURATION COUNT
JDX CONVH1 < AU SUIVANT
<
SLLD 16 < CONVERSION OK
JMP CONVH9
<
CONVH3: EQU $
LBI 1 < ERREUR
CONVH9: EQU $
CPZR B < POUR TEST AU RETOUR.
PLR B,X,Y,W < RESTAURATIONS
RSR
PAGE
DESAS: EQU $
<
< D E S A S S I G N A T I O N D ' U N E U L
<
< ARGUMENT:
< 'A' (BITS 8-15) = NUMERO D'UL EN ASCI
<
STBY ASSUL < STORE NUMERO UL
LA ASS3
STA ASS1
LAD DMASS
SVC 0
RSR
PAGE
CONVA: EQU $
<
< S/P DE CONVERSION D'UN MOT EN ASCI
<
< ARGUMENT:
< A = MOT A TRADUIRE
< Y = ADRESSE OCTET DE RANGEMENT DU RESULTAT
<
PSR A,B,X,Y < SAUVEGARDES
<
ADRI 3,Y < ADRESSE OCTET DERNIER CHIFFRE
PSR A
LXI 4 < INIT COUNT
CONVA1: EQU $
PLR A
SLRD 4
PSR A
SLLD 4
ANDI 'F < RECUPERATION CHIFFRE HEXA
CPI '9
JLE $+2
ADRI 7,A
ADRI '30,A < CARACTERE ASCI
PSR X < SVG COUNT
LR Y,X < INDEX CHIFFRE EN COURS
STBY &AXTRAV
ADRI -1,Y < INDEX CHIFFRE SUIVANT
PLR X < RECUPERATION COUNT
JDX CONVA1
<
PLR A < A NE PAS OUBLIER !
PLR A,B,X,Y < RESTAURATIONS
RSR
PAGE
RTCCI: EQU $
<
< R E T O U R A U C C I A P R E S D E S A S S I G N T I O N
<
< D E S U N I T E S L O G I Q U E S 3 E T ' B
<
LAI "B"
BSR ADESAS
LAI "3"
BSR ADESAS
LB DMWDKU+3 < (B)=ADRESSE DE FIN DE DUMP, AFIN DE
< POUVOIR LA CONNAITRE FACILEMENT
< SOUS 'DEBUG'...
LAD DMCCI
SVC 0 < F I N D E D U M P ...
< (B)=ADRESSE DE FIN, SI DUMP 'DKU'...
BR ADEB2
PAGE
QREP: EQU $
<
< E N V O I Q U E S T I O N E T D E M A N D E R E P O N S E
<
< LA REPONSE EST DE 1 CARACTERE (PAR EXEMPLE
< OUI/NON).
<
< ARGUMENT:
< 'A' = ARGUMENT D'APPEL DU S/P ENVOI POUR
< POSER UNE QUESTION.
<
< RESULTAT:
< 'A' ( 8-15 ) = REPONSE.
<
PSR X < SAUVEGARDE.
BSR AENVOI < ENVOI QUESTION
LAD DMREP < DEMANDE REPONSE
SVC 0
LBY REP < CHARGEMENT REPONSE DANS 'A'.
PLR X < RESTAURATION.
RSR
PAGE
CHOIX: EQU $
<
< C H O I X D ' U N E O P T I O N E N M O D E
<
< N O N S T A N D A R D.
<
< IL S'AGIT DU CHOIX D'UNE OPTION TELLE QUE:
< -OUI A PRIORI SI L'ON TRAVAILLE EN MODE STANDARD.
< -OUI OU NON SELON LE VOEU DE L'UTILISATEUR
< SI L'ON TRAVAILLE EN MODE NON STANDARD.
< -NON A PRIORI SI L'ON EST EN DUMP SUR IMPRIMANTE
< OU VISU.
<
< ARGUMENT: 'A' = ARGUMENT D'PPEL AU S/P QREP (MESSAGE DE
< PROPOSITION).
<
< RESULTAT: 'A' = 0 OPTION ACTIVE ("OUI")
< 'A' = 1 OPTION INACTIVE ("NON").
<
PSR B
LR A,B < SAUVER L'ARGUMENT.
CPZ TYPDMP
JE CHOIX1 < NON A PRIORI POUR IMPRIMANTE/VISU.
CPZ ISTAND
JE CHOIX0 < OUI A PRIORI SI MODE STANDARD.
<
< CHOIX DE L'UTILISATEUR.
<
CHOIX2: EQU $
LR B,A < RECUPERATION DE L'ARGUMENT.
BSR AQREP < ENVOI QUESTION ET DEMANDE REPONSE.
CPI "O"
JE CHOIX0 < OUI.
CPI "N"
JNE CHOIX2
CHOIX1: EQU $ < NON.
LAI 1
JMP CHOIXF
CHOIX0: EQU $ < OUI.
LAI 0
CHOIXF: EQU $
PLR B
RSR
RSR
<
CHXX: EQU $
<
< C H O I X D ' U N E O P T I O N
<
< (CF: S/P 'CHOIX' A QUELQUES VARIANTES PRES).
<
PSR B
LR A,B < SAUVER L'ARGUMENT.
CPZ ISTAND
JE CHOIX1 < SI MODE STANDARD, NON A PRIORI.
JMP CHOIX2 < MODE NON-STANDARD : PROPOSITION.
PAGE
ENVOI: EQU $
<
< E N V O I D ' U N M E S S A G E S T A N D A R D
<
< S U R L ' O R G A N E D E S O R T I E ( U L 2 )
<
< EN ENTREE
<
< A=DEPLACEMENT MOTS DU MESSAGE A ENVOYER PAR RAPPORT
< A M. TOUT MESSAGE EST DELIMITE PAR '00
<
<
< NOTA: ON A
< EN TABLE: M: EQU $+256
< MES1: ASCI "TEXTE..."
< WORD 0
< EN COMMON: AM: WORD M
< APPEL PAR: LAI MESI-M
< BSR AENVOI
<
PSR A,X
AD AM < @ MOT MESSAGE
ADR A,A < @ OCT MESSAGE
STA DMOUT+1
STZ DMOUT+2
LR A,X
ENV1: EQU $ < BOUCLE JUSQU'A DELIM '00
LBY &AXTRAV
JAE ENV2
IC DMOUT+2 < LONGUEUR='+1
ADRI 1,X
JMP ENV1
ENV2: EQU $
LAD DMOUT
SVC 0
PLR A,X
RSR
PAGE
GOSGN: EQU $
<
< A C C E S A U S G N :
<
<
< ARGUMENT :
< A=NVP D'ACCES AU SGN.
<
<
< RESULTAT :
< A=CONDITIONS DE RETOUR DU SGN ,
< INDICATEURS POSITIONNES SUR ERREUR.
<
<
CPZR X < RACINE DE LONGUEUR NEGATIVE ?
JGE GOSGN1
LXI 0 < IL FAUT METTRE RACINE VIDE (CAS DES
< SUPPRESSIONS TOTALES).
PSR A
LAI '04 < EOT.
STBY &AXRAC
PLR A
GOSGN1: EQU $
PSR X < SAVE X COURANT.
STBY SCATAL < MISE EN PLACE DU NVP D'ACCES.
LR X,A
ADRI 1,A
STA SCATAL+2 < MISE EN PLACE DE LA LONGUEU
< COURANTE.
LAD SCATAL
SVC 0 < APPEL DU SGN.
LR X,A < A=CONDITIONS DE RETOUR.
PLR X < RESTAURE X COURANT.
RSR
PAGE
GESTM: EQU $
<
< G E S T I O N M E M O I R E ( A J U S T E M E N T )
<
<
< GESTION MEMOIRE: SE S/P EST APPELE A CHAQUE FOIS QU'ON
< S'APPRETE A FAIRE UN DUMP FICHIER OU ITEM.
< CE S/P AJUSTE L'ESPACE MEMOIRE: IL FAUT EN EFFET QUE
< ADR OCT(NOM+VALEUR)+ BOX TIENNE DANS L'ESPACE MEMOIRE
< SANS QUE CELUI-CI SOIT SURDIMENSIONNE.
<
< NOTA: QUAND IL S'AGIT D'UN FICHIER, LE BUFFER FICHIER A
< DUMPER EST EN RECOUVREMENT AVEC LA ZONE LT CELLE-CI ETANT
< D'ADRESSE: ADRESSE(NOM-VALEUR) - 1 --> DONC LE BUFFER
< FICHIER EST EN RECOUVREMENT AVEC LA ZONE NOM+VALEUR SUR
< 127 MOTS;DANS LE S/P TSTFI ON A MIS DANS "BOX" LE NOMBRE
< 127*2
< NOTA2:QUAND IL S'AGIT D'UN ITEM, ON A DANS "BOX" LA BOX
< OBTENUE PAR '1E35
<
LA BOX < BOX,
RBT IVALEX < A PRIORI...
AD DMLON+1 < +ADR OCT NOM+VAL...
ADRI LNOM+'10*2+1,A < LNOM+'1O MOTS NON ATTEIGNABLES
SLRS 12
ADRI 1,A
SLLS 12 < A=ESPACE NECESSAIRE
CP ESPACE < ESPACE ACTUEL CORRECT?
JE GESTMF
STA ESPACE
LAD DMGETM < NON,DEMANDE D'ALLOCATION
SVC 0
JE $+2
ACTD
GESTMF: EQU $
RSR
PAGE
W1PG: EQU $
<
< W R I T E 1 C A R A C T E R E S U R P A G E V I R T U E L L E
<
< A V E C C O M P A C T A G E S Y S T E M A T I Q U E
<
PSR B,X,Y,W < SAUVEGARDES.
PSR A < CARACTERE A STOCKER
CPZ IPRW1P < PREMIER APPEL?
JNE W1PG0
< OUI
IC IPRW1P < BASCULEMENT INDIC
LAI -1
STA CCMP < INIT COMPT COMPACTAGE BIT 0=1
< SIGNIFIE 1ER APPEL PAGE EN COURS
LA AOPAG
STA PPG < INIT POINTEUR DE PAGE
W1PG0: EQU $
LA CCMP
LR A,W < COMPTEUR COMPACTAGE
LY PPG < POINTEUR DE PAGE
TBT 0 < 1ER APPEL DANS LA PAGE?
JNC W1PG1
<
< OUI, ALORS RAZ PAGE , ET
< REINITIALISATION COMPACTAGE.
LA AOFPAG < ADRESSE OCTET FIN DE PAGE.
SB AOPAG < A = LONGUEUR OCTET PAGE
LR A,X < NOMBRE D'OCTETS PAGE VIRTUELLE.
LAI 0 < POUR REINIT A 0.
< ON SAIT QU'ICI, PPG = AOPAG.
W1PG01: EQU $
PSR X < SAUVEGARDE COUNT
LX PPG < ADRESSE OCTET COURANTE.
STBY &AXTRAV < RAZ OCTET.
IC PPG < AU SUIVANT
PLR X < RECUPERATION COUNT.
JDX W1PG01 < ET ON BOUCLE...
LA AOPAG < REINITIALISATION DU POINTEUR
STA PPG < DE PAGE...PAR PRECAUTION.
STY PCMP < POINTEUR COMPACTAGE
SBR W,W < COUNT COMPACT
ADRI 1,Y < PPG+1
BSR ASTC < STORE CAR
JMP W1PGF
<
W1PG1: EQU $
LR Y,A
CP AOCRIT < ADR CRITIQUE ATTEINTE?
JL W1PG2
< OUI,FORCER LE COMPACTAGE
LR W,A
LX PCMP
STBY &AXTRAV < STORE CCMP
SBR W,W < RAZ CCMP
PSR W < POUR STC
BSR ASTC < STORE CCMP
BSR ASTC < STORE CARACTERE EN COURS
< ON EST SUR QUE L'ON SORT DE LA
< PAGE EN COURS PAR L'UN DES 2
< DERNIERS STC CI-DESSUS==>CCMP(0)
< SERA MIS A 1
JMP W1PGF
<
W1PG2: EQU $ < ADR CRITIQUE NON ENCORE ATTEINTE
LR W,A
ANDI '7F
CPI '7F < CCMP A ATTEINT '7F(128 CA)
JE W1RUPT < OUI, RUPTURE DE COMPACTAGE
< NON,TEST EGALITE CAR EN COURS#
< CAR-1 ETC...
LR Y,X
ADRI -1,X
LBY &AXTRAV < CAR PRECEDENT(CAR-1)
PLR B < CAR EN COURS
PSR B
CPZ ICOMPA < FAUT-IL COMPACTER ???
JNE W1PG3 < NON (UTILE POUR LES DUMPS DE CMS5...).
CPR A,B < EGALITE?
JNE W1PG3
< OUI
LR W,A
TBT 8 < COUNT DE CAR REPETITIFS?
JNC W1PG4
< OUI, IL SUFFIT D'INCREMENTER CCMP
ADRI 1,W
PLR A < DEPILER LE CAR INUTILE
JMP W1PGF
<
W1PG4: EQU $ < CE N'EST PAS UN CONT DE CAR REPETI
< TIFS (C'EST DONC UN COUNT DE CAR #)
JALE W1PG5 < COUNT NON>0 DONC 1 SEUL
< CAR DEJA STOCKE ON NE CHERCHE PAS
< ENCORE A COMPACTER(ON NE COMPACTE
< QU'A PARTIR DE 3 CAR IDENTIQ)
<
ADRI -1,X < COUNT>O DONC AU MOINS 2 CAR
< DEJA STOCKES ON TENTE CMPTAGE
LBY &AXTRAV < CAR-2
CPR A,B < EGALITE?
JNE W1PG5
< OUI, INTRODUIRE UN COUNT DE COMPACTAGE
< REPETITIF
LR W,A
CPI 1 < SEULEMENT 2 CAR DEJA STOCKES?
JG W1PG60
< OUI,FAIRE PPG='-1
ADRI -1,Y
JMP W1PG6
W1PG60: EQU $ < NON,IL FAUT FAIRE:
ADRI -2,W < CCMP='-2
LR W,A
LX PCMP
STBY &AXTRAV < STORE CCMP PRECEDENT
LR Y,A
ADRI -2,A
STA PCMP < NOUVEAU POINT DE COMPACT
W1PG6: EQU $ < ET MAINTENANT IL SUFFIT DE
< DE ...
LAI '82
LR A,W < ..REINITIALISER CCMP
PLR A < ..DEPILER LE CAR EN COURS(INUTILE)
JMP W1PGF
<
W1PG3: EQU $ < PAS D'EGALITE AVEC CAR-1
LR W,A
TBT 8 < CCMP REPETITIF?
JNC W1PG5
< OUI,RUPTURE DE COUNT
W1RUPT: EQU $ < RUPTURE DE COUNT
LX PCMP
LR W,A
STBY &AXTRAV < STORE CCMP PRECEDENT
SBR W,W < RAZ CCMP
STY PCMP < POINTEUR DE CMP RECOIT PPG
ADRI 1,Y
BSR ASTC < STORE CAR EN COURS
JMP W1PGF
<
W1PG5: EQU $ < PAS DE COMPACTAGE ET PAS DE
< RUPTURE
ADRI 1,W < CCMP='+1
BSR ASTC < STORE CAR EN COURS
<
<
W1PGF: EQU $ < FIN
STY PPG < POINTEUR DE PAGE
LR W,A
STA CCMP < COMPTEUR COMPACTAGE
PLR B,X,Y,W < RESTAURATIONS.
RSR
PAGE
STC: EQU $
<
< S T O R E 1 O C T E T E N P A G E V I R T U E L L E
<
< I L S ' A G I T D ' U N ' C O U N T ' O U D ' U N
<
< C A R A C T E R E
<
< CE S/P QUI SE VEUT RAPIDE:
< -DEPILE LE CAR A STOCKER
< -LE STOCKE EN (Y)
< -INCREMENTE (Y) ET REGARDE SI ON DEPASSE DE LA PAGE
< VIRTUELLE,AUQUEL CAS:
< -IL ECRIT LA PAGE ET REINITIALISE PPG,
< Y,ET W(=CCMP)
<
PLR A,X
PSR X
LR Y,X
STBY &AXTRAV < STORE CAR
ADRI 1,Y < PPG='+1
LX AOFPAG
CPR X,Y < ON DEPASSE?
JL STCF
< OUI
STY PPG < MAJ PPG(POUR EDPG!)
BSR AWPG < WRITE PAGE VIRTUELLE
LY PPG
LAI -1
LR A,W < CCMP BIT 0=1 CE QUI
< SIGNIFIE 1ER APPEL PAGE EN COURS
< (POUR W1PG)
STCF: EQU $
RSR
PAGE
WNPG: EQU $
<
< W R I T E N C A R A C T E R E S E N P A G E V I R T U E L L E
<
< EN ENTREE A=ADRESSE OCTET 1ER CARACTERE
< X=NOMBRE DE CARACTERES A ECRIRE
<
< NOTA ON UTILISE LE S/P W1PG
<
PSR A,X,Y
XR A,X
RBT IVALEX < A PRIORI, AU CAS OU IL S'AGIRAIT D'UN
< ITEM D'EXTENSION SUR VOLUME...
XR A,X
LR A,Y
WNPG1: EQU $
PSR X < SVG COUNT
LR Y,X
LBY &AXTRAV < CHARGEMENT CARACTERE
BSR AW1PG < WRITE CARACTERE
ADRI 1,Y < AU SUIVANT
PLR X < RECUP COUNT
JDX WNPG1
<
PLR A,X,Y
RSR
PAGE
WPG: EQU $
<
< W R I T E U N E P A G E V I R T U E L L E
<
PSR A,X
CPZ IPRWPG < PREMIER/DERNIER/N EME APPEL?
JL WPGD < DERNIER
JG WPGN < N EME
< PREMIER APPEL
IC IPRWPG < BASCULEMENT
<
LA TYPDMP < INITIALISATIONS EN FONCTION
< DU TYPE DE DUMP
JAL WPG0P < PUNCH
JAE WPGN < IMPRIMANTE / OUTPUT
CPI 1
JE WPG0F < FICHIER
IF ORDI-"S",XWOR%1,,XWOR%1
CPI 2
JNE WPGN < DKU OU MEM. COMMUNE.
XWOR%1: VAL 0
< INIT SPECIFIQUES A VISU
IF DIALOG,XWOR%1,XWOR%1,
LRM A
WORD '8B02 < ON DEMANDE TIME OUT = 2
WORD '1EA5 < SUR VISU RECEPTRICE
LAI 1
STA DMTMPO+2 < TEMPORISATION 1 SECONDE (AVANT
< L'ENVOI D'UN BUFFER)
XWOR%1: VAL 0
JMP WPGN
WPG0P: EQU $ < INITIALISATIONS SPCIFIQUES AU PUNCH
< RAZ BUFFER PUNCH
LXI NBCOL
LAI 0
WPGP1: EQU $
STA &AXBPM1
JDX WPGP1
STZ NBM11 < NOMBRE MODULO 11
STZ NBMNP < NO CARTE MOD NBPAUS
STZ NUMC < NUMERO CARTE EN COURS
LA ABP
STA PBP < POINTEUR BUFFER PUNCH
LAI NBPAUS < NOMBRE DE PAUSE STANDARD A PRIORI.
WPG11: EQU $
CPZ ISTAND < MODE STANDARD ?
JE WPG12
LAI MNBPAU-M < PROPOSITION TAILLE PAQUET.
BSR AENVOI
LAD DMNBPA < DEMANDE REPONSE
SVC 0
LA DMNBPA+1 < ADRESSE OCTET REPONSE
BSR ACONVH < CONVERSION HEXA.
JNE WPG11 < REPONSE INCORRECTE.
JALE WPG11 < REPONSE INACCEPTABLE.
WPG12: EQU $
STA NPAUSE < NOMBRE DE CARTES ENTRE CHAQUE PAUSE.
STZ IPCH < PUNCH ACTIF A PRIORI
LAI MCART-M < DEMANDE UTILISATEUR
BSR AQREP < AU RETOUR LA REPONSE EST DANS 'A'.
CPI "S" < ...=SUPPRIMER?
JNE $+2
IC IPCH < OUI, PUNCH INACTIF
JMP WPGN
<
WPG0F: EQU $ < INITIALISATIONS SPECIFIQUES A FICHIER
LAD DMOPNK < OPEN NEW KEY
SVC 0
JE WPGN
ACTD
WPGN: EQU $ < N EME APPEL
BSR AEDPG < EDIT PAGE SUR SUPPORT EXTERNE
JMP WPGF
WPGD: EQU $ < DERNIER APPEL
LA PPG
CP AOPAG < EDITION NECESSAIRE?
JE WPGD1
< OUI, EDITER LE RESTE
BSR AEDPG
WPGD1: EQU $
< OPERATIONS DE FIN LIEES
< AUX SUPPORTS EXTERNES
LA TYPDMP < TYPE DUMP?
JAL WPGD2 < PUNCH
CPI 1 < FICHIER?
JE WPGDH < OUI, FIC H IER
IF ORDI-"S",XWOR%1,,XWOR%1
CPI 3
JE WPGDD < DKU
XWOR%1: VAL 0
JMP WPGDF
WPGD2: EQU $ < PUNCH
BSR APCARD < VIDAGE CARTE EN COURS
< PUNCHER UNE CARTE "FIN"
LAI '70
STA &ABP
BSR APCARD
JMP WPGDF
WPGDH: EQU $ < FIC H IER
LAD DMCLSK < CLOSE KEY
SVC 0
JE $+2
ACTD
WPGDF: EQU $
IF ORDI-"S",XWOR%1,,XWOR%1
JMP WPGF
WPGDD: EQU $ < DKU
LA DMWDKU+3 < EDITION DU DERNIER BLOC UTILISE
LY ADRBL
BSR ACONVA
LAI MDRBL-M
BSR AENVOI
XWOR%1: VAL 0
WPGF: EQU $ < FIN WPG
LA AOPAG
STA PPG < REINIT POINTEUR PAGE
PLR A,X
RSR
PAGE
EDPG: EQU $
<
< W R I T E P R O P R E M E N T D I T D ' U N E P A G E
<
< V I R T U E L L E S U R S U P P O R T E X T E R N E
<
< ( O U " E D I T I O N " P A G E )
<
PSR A,B,X,Y < SAUVEGARDES
LA TYPDMP < TYPE DUMP?
IF ORDI-"S",XWOR%1,,XWOR%1
CPI 4
JE EDPGM < MEMOIRE COMMUNE.
XWOR%1: VAL 0
JAL EDPGP < PERFORATEUR
ADRI -1,A
JAE EDPGH < FIC H IER
IF ORDI-"T",XWOR%1,,XWOR%1
JAG EDPGV < LIGNE VISU
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
ADRI -1,A
JAE EDPGV < LIGNE VISU
JAG EDPGD < DKU
XWOR%1: VAL 0
JMP EDPGF
EDPGP: EQU $ < PERFORATEUR
LA PPG
SB AOPAG < LONGUEUR A EDITER
LR A,X
LA AOPAG
STA PPG < INIT POINTEUR PAGE
EDPG1: EQU $
PSR X < SVG COUNT
LX PPG
LBY &AXTRAV < CAR EN COURS
BSR APC1 < PUNCH 1 CARACTERE
IC PPG < AU SUIVANT
PLR X < RECUP COUNT
JDX EDPG1
JMP EDPGF
EDPGH: EQU $ < FIC H IER
LAD DMWBLC < WRITE BLOC
SVC 0
JE $+2
ACTD
JMP EDPGF
EDPGV: EQU $ < LIGNE VISU
LA PBFI < POUR ECHANGER 'PBFI' ET
LX PBV < 'PBV' CAR LE S/P 'EDC'
XR A,X < UTILISE 'PBFI' !
STA PBFI
STX PBV
LA AOPAG
STA PPG < REINITIALISATION POINTEUR DE
< PAGE SUR DEBUT DE PAGE
<
XWOR%1: VAL LPAV*2*2 < NOMBRE DE 'DIGITS' DANS 1 PAGE
XWOR%2: VAL LBV*2 < NOMBRE DE 'BYTES' DANS LE BUFFER
< VISU
LXI XWOR%1/XWOR%2 < INIT BOUCLE SUR N ECHANGES VISU
<
EDPG2: EQU $
LA AOBV
STA PBFI < INIT 'PBFI' (CF. CI-DESSUS)
PSR X
LXI LBV < INIT BOUCLE SUR LE BUFFER VISU
< (FORMATAGE BINAIRE-->ASCI)
EDPG3: EQU $
PSR X
LX PPG < POINTEUR DE PAGE
LBY &AXTRAV < LOAD 1 OCTET
BSR AEDC < 'EDITION' DE 2 CAR ASCI DANS 'BV'
IC PPG < OCTET SUIVANT
PLR X
JDX EDPG3
IF DIALOG,XWOR%1,XWOR%1,
LAD DMTMPO < TEMPO DE 1 SECONDE AVANT ENVOI BUFFER
SVC 0
XWOR%1: VAL 0
IF DIALOG,,,XWOR%1
LXI 4
LAI MTMPO-M < MESSAGE DE TEMPO
BSR AENVOI
JDX $-1
XWOR%1: VAL 0
LAD DMLVI < DEMANDE ECRITURE SUR LIGNE VISU
SVC 0
IF DIALOG,,,XWOR%1
EDPGC: EQU $
LAD DMRACK < LECTURE 'ACK' OU 'SYNCHRO'
SVC 0
LBY REP < CARACTERE RECU...
RBT 8
CPI ACK < EST-CE 'ACK' ?
JE EDPGB < OUI, ALLONS ENVOYER LE BUFFER SUIVANT.
CPI SYNC < EST-CE UNE RESYNCHRONISATION ?
JE $+2 < OUI
ACTD
LAD DMLVI < ALORS, IL FAUT RENVOYER LE DERNIER BUFFER
SVC 0
JMP EDPGC < VERS NOUVELLE ATTENTE 'ACK'.
EDPGB: EQU $
XWOR%1: VAL 0
IF DIALOG,XWOR%1,XWOR%1,
LAD DMRACK < ON ATTEND 1 CARACTERE AVANT
SVC 0 < D'ENVOYER LE BUFFER SUIVANT
LBY REP < UN 'ACK' EN L'OCCURRENCE
RBT 8
CPI ACK < 'ACK' ?
JE EDPG8
CPI '7D < TIME OUT ?
JNE EDPG9
< TIME OUT, DONC IL FAUT REFAIRE
< L'ENVOI DU DERNIER BUFFER !
LA PPG < POINTEUR DE PAGE
ADRI -LBUFV,A < ON LE REMET A JOUR...
STA PPG
< POUR DEBLOQUER LA VISU RECEPTRICE
< AVANT DE LUI RENVOYER LE DERNIER BUFFER,
< LE MIEUX EST DE LUI ENVOYER UN
< BUFFER PLEIN COMME UN OEUF DE CARACTERES
< 'SYNC'; AINSI, LA VISU RECEPTRICE
< (QUI EST VRAISSEMBLABLEMENT EN LECTURE)
< COMPRENDRA CE QUI LUI ARRIVE...
LY AOBV < INDEX BUFFER VISU
LXI LBV*2 < COUNT OCTET BUFFER VISU
LAI SYNC+'80 < CARACTERE DE SYNCHRO
EDPGA: EQU $
XR X,Y < RECUP INDEX ET SVG COUNT
STBY &AXTRAV < STORE 'SYNC'
XR X,Y < RECUP COUNT ET INDEX
ADRI 1,Y < CARACTERE SUIVANT
JDX EDPGA
LAD DMLVI < ON ENVOIE CE BUFFER...
SVC 0
LAD DMTMPO < ET, CETTE FOIS ON TEMPORISE UN PEU
SVC 0 < PLUS....
SVC 0 < ...
JMP $+1 < REMPLACER EVENTUELLEMENT PAR UN
< 'SVC 0' SUPPLEMENTAIRE
PLR X < RECUPERATION DU COUNT DE BOUCLE
JMP EDPG2 < ET ON REPART.
EDPG9: EQU $ < "VRAIE" ERREUR DE SYNCHRO
LAI MPBACK-M < CE N'EST PAS 'ACK', ON PREVIENT
BSR AENVOI
ACTD < ET ON TRAPPE.
EDPG8: EQU $
XWOR%1: VAL 0
PLR X
JDX EDPG2 < BUFFER SUIVANT
<
LA PBFI < ON RE-INVERSE
LX PBV < LES POINTEURS 'PBV' ET 'PBFI'
XR A,X < POUR LES RAISONS QUE L'ON SAIT
STA PBFI
STX PBV
<
JMP EDPGF
EDPGF: EQU $ < FIN
PLR A,B,X,Y < RESTAURATIONS
RSR
IF ORDI-"S",XWOR%1,,XWOR%1
EDPGM: EQU $ < MEMOIRE COMMUNE.
<
< L'ALGORITHME D'EMISSION D'UNE PAGE VIRTUELLE EN CDA EST LE SUIVANT:
< - TEST VERROU COURANT 'NVC'.
< - S'IL EST A 0, IL APPARTIENT A REST, DONC ATTENDRE.
< - S'IL EST A 1, IL APPARTIENT A DUMP, DONC ON PEUT FAIRE UN WCDA
< APRES QUOI ON LE FAIT PASSER A 0, ON INCREMENTE 'NVC' ETC...
<
BSR ATESTV < TEST VERROU COURANT 'NVC'.
JNE EDPGM1 < VERROU = 1 : ALLONS-Y...
< VERROU = 0 : ATTENDRE.
LAI 2 < 2 SECONDES DE TEMPORISATION.
STA DMTMPO+2
LAD DMTMPO < TEMPORISATION.
SVC 0
JMP EDPGM < NOUVELLE TENTATIVE.
EDPGM1: EQU $
< VERROU = 1 : ON PEUT FAIRE LE WCDA.
LA AOPAG
SLRS 1
PSR A < ADRESSE MOT PAGE VIRTUELLE.
LA NVC < NUMERO VERROU COURANT.
MP LMPM < * NB DE MOTS PAR PAGE.
LR B,A
AD NBV < + NB DE VERROUS (CAR LES VERROUS SONT
< EN TETE DE LA ZONE CDA UTILISEE).
AD ADCDA < + ADRESSE DEBUT ZONE CDA UTILISEE.
< 'A' = ADRESSE CDA.
PLR B < 'B' = ADRESSE PAGE VIRTUELLE.
LX LMPM < 'X' = LONGUEUR.
WCDA
< DEVERROUILLER POUR REST.
BSR ARSETV
< INCREMENTER NUMERO DE VERROU COURANT 'NVC' MODULO 'NBV'.
IC NVC
LA NVC
CP NBV
JL $+2
STZ NVC
JMP EDPGF < C'EST FINI.
EDPGD: EQU $ < DKU
<
< PASSAGE AU BLOC SUIVANT
<
LA DMWDKU+3 < ADRESSE SECTEUR COURANTE.
ADRI 1,A < VRAIE ADRESSE SECTEUR COURANTE.
LR A,B
EOR ADKUF
JAL EDPGD2 < AS ET ASF SONT DE SIGNES DIFFERENTS,
< DONC C'EST OK COMPTE TENU DES VALIDATIONS
< INITIALES.
<
< ADRESSES AS ET ASF DE MEME SIGNE
<
LA ADKUF
JAL EDPGD4
<
< POSITIVES...
<
SBR B,A
JAGE EDPGD2 < OK.
JMP EDPGD1 < ERREUR.
<
< NEGATIVES...
<
EDPGD4: EQU $
SBR A,B
JG EDPGD1 < ERREUR.
EDPGD2: EQU $
IC DMWDKU+3 < OUI - INCREMENTER SON NUMERO
LA N0BDKU < PLACER SON NUMERO
STA &ADPAG0
IC N0BDKU < PASSER AU SUIVANT
EDPGD6: EQU $
BSR ACOMP < CODAGE EVENTUEL ET ECRITURE DKU...
LBY DMWDKU
CPI '8A < QUI EST LA MT1 OU DKU ???
LR X,A < A=CODE D'ERREUR,
JNE EDPGD7 < 'MT1'...
TBT 3 < 'DKU', EST-CE LA VIOLATION ???
JNC EDPGD5 < NON...
JMP EDPGD8 < OUI, IL FAUT AVERTIR !!!
EDPGD7: EQU $
CPI '44 < 'MT1', EST-CE LA VIOLATION ???
JNE EDPGD5 < NON...
EDPGD8: EQU $
LAI MDKUP-M < OUI, PREVENIR.
BSR AENVOI
WORD '1E16 < A L'UTILISATEUR DE JOUER...
JMP EDPGD6 < ET ON RECOMMENCE.
EDPGD5: EQU $
CPZR X < TEST CODE RETOUR...
JNE EDPGD3 < MAUVAISE ECRITURE-ESSAYER D'INVALIDER
LA DMWDKU+3 < RELIRE LE BLOC POUR VERIFICATION
STA DMRDKU+3
LAD DMRDKU
SVC 0
JE EDPGF < CA S'EST BIEN PASSE - FIN
EDPGD3: EQU $
BSR ADCOMP < ON REDECODE...
LAI -2 < INVALIDER CE BLOC
STA &ADPAG0
BSR ACOMP < ON RECODE, AFIN QUE 'REST' TROUVE
< BIEN LE MOT0 D'INVALIDATION (=-2)...
BSR ADCOMP < ET ON REDECODE AFIN D'ITERER L'ECRITURE
< CORRECTEMENT SUR LE SECTEUR SUIVANT...
JMP EDPGD < ET REESSAYER SUR LE SUIVANT
EDPGD1: EQU $ < FIN DE ZONE SUR DKU
LAI MERDK-M < SORTIE DU MESSAGE D'ERREUR
BSR AENVOI
IC DMWDKU+3 < INVALIDER LE DERNIER SECTEUR.
LAI -1
STA &ADPAG0
BSR ACOMP < CODAGE EVENTUEL ET ECRITURE DKU...
JE $+2
ACTD
STZ BOX < RELACHER LA MEMOIRE
BSR AGESTM
LA APILM1 < RESTAURER LA PILE
LR A,K
BR ARTCCI < ET FIN
PAGE
<
<
< C O D A G E D K U :
<
<
COMP: EQU $
CPZ ICLEF < Y-A-T'IL CODAGE ???
JE COMP2 < NON...
<
< OUI, CODAGE :
<
PSR Y
LA DMWDKU+1
SLRS 1
SBT 0
STA ABUF < GENERATION D'UN RELAI D'ACCES A LA PAGE
< VIRTUELLE COURANTE...
LX DMWDKU+2 < X=NOMBRE D'OCTETS A CODER...
COMP1: EQU $
ADRI -1,X
LBY &ABUF < A=OCTET COURANT A CODER :
SLRD 4 < DECONCATENATION...
PSR X
LR A,X
LBY &ACLEF < CODAGE DES 4 PREMIERS BITS...
SLLS 4
LR A,Y
LAI 0
SLLD 4
LR A,X
LBY &ACLEF < CODAGE DES 4 DERNIERS BITS...
ORR Y,A
PLR X
STBY &ABUF < ET MISE A JOUR DE LA PAGE VIRTUELLE...
CPZR X < EST-CE FINI ???
JG COMP1 < NON...
PLR Y < OUI...
COMP2: EQU $
LAD DMWDKU
SVC 0 < ECRITURE DE LA PAGE CODEE...
RSR
PAGE
<
<
< R E D E C O D A G E S I E R R E U R :
<
<
DCOMP: EQU $
PSR A,X,Y
LX DMWDKU+2 < X=NOMBRE D'OCTETS A CODER...
KOMP1: EQU $
ADRI -1,X
LBY &ABUF < A=OCTET COURANT A CODER :
SLRD 4 < DECONCATENATION...
PSR X
LR A,X
LBY &ACLEFB < DECODAGE DES 4 PREMIERS BITS...
SLLS 4
LR A,Y
LAI 0
SLLD 4
LR A,X
LBY &ACLEFB < DECODAGE DES 4 DERNIERS BITS...
ORR Y,A
PLR X
STBY &ABUF < ET MISE A JOUR DE LA PAGE VIRTUELLE...
CPZR X < EST-CE FINI ???
JG KOMP1 < NON...
PLR A,X,Y
RSR
XWOR%1: VAL 0
PAGE
PC1: EQU $
<
< P R E P A R A T I O N P U N C H D E 1 O C T E T
<
< ON RANGE CET OCTET DANS LE BUFFER DE PUNCH
< SACHANT QU'ON PLACE 11 BITS UTILES PAR COLONNE.
<
< ARGUMENT:
< 'A' (BITS 8-15) = OCTET A PUNCHER
<
PSR A < CAR EN COURS
LR A,Y < SVG CAR EN COURS
LR A,B < IDEM
LX NBM11 < INDEX SUR MSK1,SHF1
LBY &AXMSK1 < MASQUE 1
ANDR A,Y
LBY &AXSHF1 < SHIFT1
LR A,X
LR Y,A
SCRS 0,X < SHIFT 1
LX PBP
OR &AXTRAV < MAJ MOT EN COURS BUFF PUNCH
STA &AXTRAV
LX NBM11 < INDEX SUI MSK1 SHF2
LA SUI < INDICATEURS MOT SUIVANT
TBT 0,X < PASSER AU SUIVANT?
JNC PC12
IC PBP < OUI
LA PBP
CP ACHECK < ON DEPASSE?
JL PC12
BSR APCARD < OUI,PUNCH CARTE
PC12: EQU $
LBY &AXMSK1 < ON PREND L'INVERSE DE MSK1:
CMR A,A
ANDR A,B < ON APPLIQUE CE MSK
LBY &AXSHF2 < SHIFT 2
LR A,X
LR B,A
SCRS 0,X
LX PBP
OR &AXTRAV
STA &AXTRAV
<
IC NBM11 < +1 SUR NB MODULO 11 (ON TRAVAILLE
< 11 OCTETS PAR 11 OCTETS)
LA NBM11
CPI 11
JL PC11
STZ NBM11 < RAZ NB MODULO 11
IC PBP < MOT SUIVANT BUFFER PUNCH
LA PBP
CP ACHECK < ON DEPASSE?
JL PC11
BSR APCARD < OUI,PUNCH CARD
PC11: EQU $
PLR A
RSR
PAGE
PCARD: EQU $
<
< P U N C H C A R T E
<
< CE S/P INTRODUIT LA NUMEROTATION ET LE CHECKSUM
< ET PUNCHE LA CARTE. IL GERE LES PAUSES ET L'INHIBITION/
< ACTIVATION DU PUNCH.
<
PSR A,B,X,W
IC NUMC < NUMERO DE CARTE (1 A 9999)
LA NUMC
CP DIXMIL < ON ATTEINT 10000 CARTES?
JL PCARD5
LAI 1
STA NUMC < OUI,ON REPASSE A 1
PCARD5: EQU $
LXI 0
LB NUMC
PCARD2: EQU $ < BOUCLE DE CONVERSION DU NUMERO
< DE CARTE
LAI 0
DV DIX
JNV $+2
ACTD
PSR B < ON ENPILE LE RESTE
ADRI 1,X < COUNT
JAE PCARD1 < QUTIENT NUL?
< SI NON, ON CONTINUE
XR A,B
JMP PCARD2
<
PCARD1: EQU $ < STOCKAGE DU NUMERO DANS
< BUFFER PUNCH
LA ABPF
NGR X,Y
ADR A,Y < ADRESSE 1ER MOT DE STOCKAGE
<
PCARD3: EQU $ < STOCKAGE
PLR A
PSR X
LR A,X
LAI 0
SBT 2,X
LR Y,X
STA &AXTRAV
ADRI 1,Y
PLR X
JDX PCARD3 < AU SUIVANT
<
<
< < CALCUL DU CHECK
<
LXI NBCOL
LAI 0 < INIT CHECK
PCARD4: EQU $ < ON BOUCLE NBCOL(80) FOIS
EOR &AXBPM1
JDX PCARD4
ANDI 'FFE0 < POUR NETTOYER BITS 11-15
< DU CHECK
STA &ACHECK < STORE CHECK
<
< PUNCH PROPREMENT DIT, AVEC RAZ DU BUFFER DE PUNCH
< AU FUR ET A MESURE PUISQU'ON Y EST
<
LXI NBCOL*2
STX DMPCH+2
LY ABP
LR Y,W
ADR Y,Y
LAD DMPCH < DEMANDE PUNCH POUR SVC
STY DMPCH+1 < ADR OCT MOT EN COURS
CPZ IPCH < SSI PUNCH ACTIF
JNE PCD3 < PUNCH INACTIF...
SVC 0
PCD3: EQU $
LXI NBCOL
PCD4: EQU $
STZ 0,W < RAZ DU BUFFER...
ADRI 1,W
JDX PCD4
LAD DMTMPO < TEMPORISATION
CPZ IPCH < SSI PUNCH ACTIF
JNE $+2
SVC 0
< REINIT PBP
LA ABP
STA PBP
< < INCREMENTATION NBMNP
IC NBMNP
LA NBMNP
CP NPAUSE < FAUT-IL FAIRE UNE PAUSE ?
JL PCD2
STZ NBMNP < OUI, RAZ
STZ IPCH < PUNCH ACTIF A PRIORI
LAI MCART-M < INVITATION UTILISATEUR
BSR AQREP < QUESTION, REPONSE...
CPI "S" < ...SIGNIFIE SUPPRESSION?
JNE $+2
IC IPCH < OUI,PUNCH DEVIENT INACTIF
PCD2: EQU $
<
PLR A,B,X,W
RSR
IF ORDI-"S",XWOR%1,,XWOR%1
PAGE
DVAS: EQU $
<
< LECTURE ET VERIFICATION ADRESSE DKU
<
< PARAM : A = ADRESSE DU MESSAGE
< RESUL : A = ADRESSE DKU
<
PSR W
LR A,W < PROTEGER L'ADRESSE DU MESSAGE
DVAS1: EQU $
LR W,A < RESTAURER L'ADRESSE DU MESSAGE
BSR AENVOI < L'ENVOYER
LAD DMASNS < LIRE LA REPONSE
SVC 0
LA DMASNS+1 < LA CONVERTIR
BSR ACONVH
JNE DVAS1 < NOMBRE INCORRECT
LR A,B < VERIFIER LA COMPATIBILITE
EOR ADKU1 < AVEC LE 1ER BLOC POSSIBLE
JAGE DVAS2
CPZR B
JGE DVAS1
JMP DVAS3
DVAS2: EQU $
LBY DMWDKU
CPI '8A
JNE DVAS3 < LA VERIFICATION QUI SUIT N'A LIEU QUE
< POUR 'DKU'...
< (ET NON PAS POUR 'MT1')
LR B,A
CP ADKU1
JL DVAS1
DVAS3: EQU $
LR B,A < ET AVEC LE DERNIER
EOR ADKU2
JAGE DVAS4
CPZ ADKU2
JGE DVAS1
JMP DVAS5
DVAS4: EQU $
LA ADKU2
CPR B,A
JL DVAS1
DVAS5: EQU $
LR B,A < RESULTAT
PLR W
RSR
PAGE
SETV: EQU $
<
< S E T V E R R O U C O U R A N T ' N V C ' E N C D A.
<
PSR A,B,X
LRM B < ADRESSE DE LA VALEUR DE SET.
WORD VSET
SRSET: EQU $
LA NVC < NUMERO VERROU COURANT.
AD ADCDA < ADRESSE CDA VERROU COURANT.
LXI 1 < LONGUEUR.
WCDA
PLR A,B,X
RSR
RSETV: EQU $
<
< R E S E T V E R R O U C O U R A N T ' N V C ' E N C D A.
<
PSR A,B,X
LRM B < ADRESSE DE LA VALEUR DE RESET.
WORD VRSET
JMP SRSET < VERS LE WCDA.
TESTV: EQU $
<
< T E S T V E R R O U C O U R A N T ' N V C ' E N C D A.
<
PSR A,B,X,W
LRM B < ADRESSE DE STOCKAGE DE LA VALEUR LUE.
WORD VTEST
LR B,W < POUR TEST ULTERIEUR.
LA NVC < NUMERO VERROU VOURANT.
AD ADCDA < ADRESSE DU VERROU EN CDA.
LXI 1 < LONGUEUR.
RCDA
CPZ 0,W < POUR TEST EN RETOUR.
PLR A,B,X,W
RSR
VSET: WORD 1 < VALEUR DU SET.
VRSET: WORD 0 < VALEUR DU RESET.
VTEST: DZS 1 < VALEUR A TESTER.
XWOR%1: VAL 0
FIN: EQU $ < FIN DU PROGRAMME
TOTO: VAL FIN-ZERO*2
PAG0: EQU ZERO+TOTO
PAG2: EQU ZERO+TOTO+2
LST
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.