<
< R E S T A U R A T I O N
<
IDP "RESTAURATION"
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 09 - 22/12/80"
TABLE
ZERO: EQU $
DZS '10 < POUR CMS.
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 < QUANTA=NB SECTEURS PHYSIQUES
< POUR 1 SECTEUR LOGIQUE (SGF)
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
QUANTA: VAL 3 < QUANTA=NB SRCTEURS PHYSIQUES
< POUR 1 SECTEUR LOGIQUE (SGF)
XWOR%1: VAL 0
LNOM: VAL 17 < LONG MAX NOM (EN MOTS)
LMAXV: VAL '1500 < LONGUEUR MAXIMUM EN MOTS DE
< NOM+VALEUR SUR T1600
IF ORDI-"S",XWOR%1,,XWOR%1
LMAXV: VAL '7FFF-2/2 < LONGUEUR MAX EN MOTS DE NOM+VALEUR
< ON FAIT -2 SUR LA LONGUEUR OCTETS
< ADMISSIBLE, CAR LORS DU DUMP, LE NOM
< ET LA VALEUR SONT PRECEDES D'UN COUNT
< SUR 1 MOT CONTENANT 2+L(NOM+VAL).
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
LPAD: VAL 128*QUANTA-1 < LONG PAGE VIRT SI DKU
< LE PREMIER MOT SERT A NUMEROTER LES BLOCS
< S'IL VAUT -1,LE BLOC EST INVALIDE
< ET LA RESTAURATION EST FINIE
< S'IL VAUT -2,LE BLOC EST INVALIDE
< ET LA RESTAURATION PASSE AU BLOC 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
LPAF: VAL 128*QUANTA-1 < LONG PAGE VIRT SI FICHIER (MOTS)
LPAC: VAL 128 < LONG PAGE VIRT SI CARTES
LBUFV: VAL 50 < LONGUEUR MOT 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: CECI N'EST PAS UN PARAMETRE
ACK: VAL "K" < CARACTERE DE SYNCHRONISATION
SYNC: VAL "S" < CARACTERE DE RESYNCHRONISATION
< EN CAS DE REPRISE VISU.
IF ORDI-"S",XWOR%1,,XWOR%1
NB1DKU: VAL '0000 < NUMERO DU 1ER BLOC POSSIBLE SUR DKU
NBFDKU: VAL 'FA00-1 < ET DU DERNIER
NBTRY: VAL 10 < NOMBRE DE TENTATIVES DE LECTURES
< SUR DKU.
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
WORD DEB1
WORD ENTRY1
PROG
DEB1: EQU $
LRP L
BR -1,L
<
NSPESC: VAL '58
NSPSTN: VAL '15
NSPDK1: VAL '23
NSPDK2: VAL NSPDK1+1
IF ORDI-"S",XWOR%1,,XWOR%1
NSPDKA: VAL '22 < DISQUE VIRTUEL FIXE
NSPDKB: VAL NSPDKA-1 < DISQUE VIRTUEL AMOVIBLE
NSPSTN: VAL '13
X123X: VAL '15-NSPSTN
XWOR%1: VAL 0
TABLE
PILE: DZS 35 < PILE POUR 'K'.
BYTE '0;'6D
NOM: DZS LNOM+1 < NOM EN COURS (PRUDENCE)
NOMFS: DZS LNOM+1 < NOM DU FICHIER DE SAUVEGARDE
< POUR UN !ASSIGN RELEASE ET UN
< DLN EVENTUELS EN FIN DE TRAVAIL
BYTE '04 < CTRL-D
IF ORDI-"S",XWOR%1,,XWOR%1
NOMR: DZS LNOM+1 < NOM A RECHERCHER (MODE RECHERCHE).
XWOR%1: VAL 0
<
BC: DZS 80 < BUFFER CARTE
FBC: EQU $ < FIN BUFFER CARTE
<
XWOR%1: VAL BC-ZERO
XWOR%2: VAL $-ZERO
$EQU ZERO+XWOR%1 < RECOUVREMENT DU BUFFER 'BC' PAR 'BV'
BV: DZS LBUFV < BUFFER VISU: IL RECOIT DES CARACT.
< ASCI
BVF: EQU $ < FIN BUFFER VISU
LBV: VAL BVF-BV < LONGUEUR MOTS BUFFER VISU
$EQU ZERO+XWOR%2
<
<
< MESSAGES A ENVOYER PAR S/P ENVOI
<
M: EQU $+256
MFI: ASCI " (FICHIER)"
WORD 0
MIT: ASCI " (ITEM)"
WORD 0
MIMP: BYTE " ";"?";"?";0
MPBSTN: EQU MIMP
MPBAS: EQU MIMP
MCONEX: EQU MIMP
IF ORDI-"T",XWOR%1,,XWOR%1
MREST: BYTE '6D;"R"
ASCI "ESTAURATION CARTES,FICHIER,VISU (C/F/V)?"
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
MREST: BYTE '6D;"R"
ASCI "EST C/1/2/F/X/V/D/M/T?"
WORD 0
MDELAR: BYTE '6D;"D"
ASCI "ELETE & REST?"
WORD 0
MDR: BYTE '6D;'83;"*";" "
ASCI "DELETE & REST!"
WORD 0
MDD: BYTE '6D;'83;"*";" "
ASCI "DELETE!"
WORD 0
MINIT: BYTE '6D;"I"
ASCI "NITIALISER?"
XWOR%1: VAL 0
WORD 0
MQV: BYTE " ";"V";"I";0
MFICH: ASCI " FICHIER="
WORD 0
MSAUV: BYTE '6D;"S"
ASCI "AUVEGARDE?"
WORD 0
MCHN: BYTE '6D;"C"
ASCI "HANGEMENTS?"
WORD 0
IF ORDI-"S",XWOR%1,,XWOR%1
MSRAC: BYTE '6D;"S"
ASCI "UR RACINE?"
WORD 0
MRAC0: BYTE '6D;"R"
ASCI "AC1>"
WORD 0
MRAC2: BYTE " ";"-";"-";">";0
MCHA: BYTE '6D;"C"
ASCI "HANGEMENT D'ACN'S ?"
WORD 0
MACNR: BYTE '6D;"A";"C";"N";"=";0
XWOR%1: VAL 0
MNOM: BYTE " ";"N";"O";"M";">";0
MSEQ: BYTE '6D;"E"
ASCI "RR. SEQ."
WORD 0
MCHECK: BYTE '6D;"E"
ASCI "RR. CHECK"
WORD 0
MRELIR: ASCI " RELIRE CARTE"
WORD 0
MASCI: BYTE '6D;"A"
ASCI "SCI INCORRECT..."
WORD 0
IF ORDI-"S",XWOR%1,,XWOR%1
MRETAR: BYTE '6D;'84;" ";"R"
ASCI "ETOUR ARRIERE"
WORD 0
MSSARA: BYTE '6D;"S"
ASCI "ORTIE ZONE DE RECH SUITE A RETOUR ARRIERE"
WORD 0
MDEF: BYTE '6D;0
ASCI " EN DEFAUT" < BLOC DKU EN DEFAUT.
WORD 0
MRECH: BYTE '6D;"R"
ASCI "ECHERCHE?"
WORD 0
MNTR: BYTE '07;" ";'6D;"N"
ASCI "OM NON TROUVE"
BYTE '07;0
MNOMR: BYTE '6D;"N";"O";"M";"=";0
MPDR: ASCI " NON RESTAURE"
WORD 0
XWOR%1: VAL 0
IF DIALOG,,,XWOR%1
MTMPO: BYTE '07;'0D;'07;0 < MESSAGE DE TEMPORISATION
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
MTOUS: BYTE '6D;"D"
ASCI "E T OU S ?"
WORD 0
MQFR: BYTE '6D;"Q";"F";"R";"=";0
< QUANTA DU FICHIER DE RESTAURATION ?
MQDKD: BYTE '6D;"Q";"D";"="
QDKD: BYTE 0;0 < QUANTA DE DUMP EN ASCI
MQDKR: BYTE '6D;"Q";"R";"="
QDKR: BYTE 0;0 < QUANTA DE RESTAURATION EN ASCI
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
MASD: BYTE '6D;"A" < ADRESSE DEBUT DKU
ASCI "S DEB="
WORD 0
MASFIN: BYTE '6D;"A"
ASCI "S FIN="
WORD 0
MCLEF2: BYTE '6D;"C"
ASCI "LEF ON"
WORD 0
MCLEF1: BYTE '6D;"C"
ASCI "CLEF="
WORD 0
MSTDKU: BYTE '6D;"M"
ASCI "ULTIPLE?"
WORD 0
XWOR%1: VAL 0
MINHD: BYTE '6D;"R"
ASCI "EST DK INHIBEE"
WORD 0
MACTD: BYTE '6D;"R"
ASCI "EST DK ACTIVE"
WORD 0
MOK: BYTE " ";" ";"O";"K";"?";0
MTRS: BYTE '6D;"T"
ASCI "ROP DE SECTEURS"
WORD 0
IF ORDI-"T",XWOR%1,,XWOR%1
MDATE: BYTE '6D;'84;" ";"D"
ASCI "ATE DUMP= "
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
MDATE: BYTE '6D;'83;" ";" "
XWOR%1: VAL 0
DATE: ASCI " / / / / "
$EQU $-1
BYTE " ";0
MACN: BYTE '6D;"A"
ASCI "CN DIFFERENTS, CONTINUER?"
WORD 0
IF ORDI-"S",XWOR%1,,XWOR%1
MACNC: BYTE '6D;"A"
ASCI "CNC="
WORD 0
MQACN: BYTE '6D;"A";"C";"N";"=";0
MPACN: BYTE '6D;'84;" ";"P"
ASCI "AS D'ACN, ACN COURANT SUPPOSE"
WORD 0
MERC: BYTE '6D;"E"
ASCI "RREUR CHAINAGE"
WORD 0
MERDMI: BYTE '6D;"D"
ASCI "UMP INCOMPLET"
WORD 0
MPERD: BYTE '6D;"P"
ASCI "ERDUS "
MPERDD: DZS 2 < NOMBRE DE DUMPS.
ASCI " DUMPS, "
MPERDF: DZS 2 < NOMBRE DE FICHIERS.
ASCI " FICHIERS"
WORD 0
XWOR%1: VAL 0
<
< AUTRES MESSAGES
<
MACK: BYTE "K"+'80 < MESSAGE DE SYNCHRO 'ACK'. BIEN RECU.
MSYNC: BYTE "S"+'80 < MESSAGE DE RESYNCHRO.MAL RECU.
IF ORDI-"S",XWOR%1,,XWOR%1
MLGSYS: ASCI "!L :SY" < POUR LOGON :SYS.
BYTE "S";'04
MLGSYF: EQU $
MCDA: ASCI "!CDA"
BYTE '04
FMCDA: EQU $
XWOR%1: VAL 0
<
< 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
<
COMMON
COM: EQU $
ASS: ASCI "!ASSIGN " < ASSIGNATION/DESASSIGNATION
ASSUL: ASCI "0=" < UL
ASS1: DZS 1
ASS2: DZS LNOM+1
BYTE '04 < EOT
ASS3: ASCI "O,"
ASS4: ASCI "N,"
ASS5: BYTE "C";"R";"1";'04
ASS6: ASCI "VI"
ASS61: BYTE 0;'04
ASS7: BYTE "I";'04
ASSS: BYTE "S";'04
IF ORDI-"S",XWOR%1,,XWOR%1
ASSD: ASCI "D-"
ASST: BYTE "M";"T";"1";'04
XWOR%1: VAL 0
IF ORDI-"T",XWOR%1,,XWOR%1
ASSR: BYTE "R";'04
XWOR%1: VAL 0
CCMP: DZS 1 < COMPTEUR DE COMPACTAGE (EN
< L'OCCURRENCE DECOMPACTAGE)
TYPRST: DZS 1 < TYPE DE RESTAURATION
< =0 LIGNE VISU
< =-1 CARTES
< =1 FICHIER
IF ORDI-"S",XWOR%1,,XWOR%1
< =2 DKU
IDELAR: DZS 1 < INDICATEUR "DELETE AND REST":
< = 0 : NON,
< =+1 : OUI, OPTION 'DELETE & REST' ACTIVE,
< =-1 : OUI, OPTION 'DELETE SEUL'...
NBEND: DZS 1 < NOMBRE D'ENTITES N'AYANT PU ETRE DELETEES
< L'OPTION "DELETE AND REST" ETANT ACTIVE.
TRAV: DZS 1
IRESTF: WORD 0 < INDICATEUR DE RESTAURATION FICHIER:
< A 1 IL INDIQUE QUE L'ON EST EN TRAIN
< DE RESTAURER UN FICHIER. EXPLOITE EN
< CAS DE SECTEUR ILLISIBLE SUR DKU
< LORS D'UNE RESTAURATION MULTIPLE.
IRETAR: WORD 0 < INDICATEUR DE RETOUR ARRIERE POUR
< RESTAURATION DKU
< =0 : RETOUR ARRIERE AUTORISE
< (PREMIER RETOUR ARRIERE)
< #0 : RETOUR ARRIERE NON AUTORISE.
IRECH: WORD 0 < INDICATEUR DE MODE RECHERCHE:
< = 0 : MODE HABITUEL.
< # 0 : MODE RECHERCHE.
< NOTA: LE MODE RECHERCHE N'EST POSSIBLE
< QU'EN RESTAURATION DKU MULTIPLE.
IF ORDI-"S",XWOR%1,,XWOR%1
IACN: DZS 1 < INDICATEUR "ACN RENCONTRE". UTILISE
< EN CAS DE MODE RECHERCHE:
< = 0 : ACN NON RENCONTRE,
< = 1 : ACN RENCONTRE. DANS CE DERNIER
< CAS, L'INDICATEUR 'IEGACN' EST
< POSITIONNE (CF. CI-DESSOUS).
IEGACN: DZS 1 < INDICATEUR "EGALITE ACN'S" ENTRE ACN
< COURANT ET ACN RENCONTRE ('IACN'=1):
< = 0 : EGAUX,
< < 0 : ACN COURANT < ACN RENCONTRE,
< > 0 : ACN COURANT > ACN RENCONTRE.
ICHACN: DZS 1 < INDICATEUR DE CHANGEMENT D'ACN'S :
< = 0 : CHANGEMENT AUTOMATIQUE,
< = 1 : CHANGEMENT (A CHAQUE RUPTURE SUR
< ACN SERA PROPOSE DE PRCISER UN
< NOUVEL ACN DE RESTAURATION).
XWOR%1: VAL 0
IFINR: WORD 0 < INDICATEUR FIN DE RECHERCHE
< = 0 : CE N'EST PAS LA FIN,
< # 0 : C'EST LA FIN DE RECHERCHE.
< CET INDICATEUR N'A DE SENS QU'EN MODE
< RECHERCHE.
IEXEC: WORD 0 < INDICATEUR DE MODE 'EXECUTE' (EXECUTION
< D'IEM-PROGRAMME RESTAURE)
XWOR%1: VAL 0
IPRR1: DZS 1 < INDICATEUR 1ER READ DE 1 CAR SUR
< PAGE VIRTUELLE
ICHN: DZS 1 < INDICATEUR DE CHANGEMENTS:
< = 0 : PAS DE CHANGEMENTS,
< = 1 : CHANGEMENTS,
< =-1 : CHANGEMENTS DE NOMS SUR RACINE.
IRCARD: DZS 1 < INDICATEUR READ ACTIF/INACTIF
< SUR CARTES
< =0 ACTIF #0 INACTIF
ISGFO: DZS 1 < INDICATEUR SGF OUTPUT ACTF/
< INACTIF
< =0 ACTIF #0 INACTIF
IDKO: EQU ISGFO < INDICATEUR DK OUTPUT ACTIF/INACTIF
< =0 ACTIF #0 INACTIF
<
< ATTENTION AU RECOUVREMENT ISGFO/IDKO
<
QUANDP: WORD 0 < QUANTA UTILISE LORS DU DUMP DK
QUANRS: WORD 0 < QUANTA A UTILISER LORS DE LA
< RESTAURATION DK
NBSECD: WORD 0 < NOMBRE DE SECTEURS AU DUMP DK
NBSECR: WORD 0 < NOMBRE DE SECTEURS A LA RESTAURATION DK
NBREST: WORD 0 < NOMBRE DE SECTEURS DE 128 MOTS RESTANT
< A RESTAURER (DE 0 A 2)
< DIFFERENT DE 0 DANS LE CAS SUIVANT:
< RESTE DE ( NBSECD / QUANRS ) # 0
REP: DZS 1 < REPONSE
LPC: WORD LPAC*2 < LONG OCT PAGE SI CARTES
LPF: WORD LPAF*2 < LONG OCT PAGE SI FICHIER
IF LPAC-LPAV,,XWOR%1,
LPV: WORD LPAV*2 < LONG OCT PAGE SI VISU
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
LPD: WORD LPAD*2 < LONG OCT PAGE SI DKU
LPM: WORD LPAM*2 < LONGUEUR OCT. PAGE VIRT. SI CDA.
LMPM: WORD LPAM < LONGUEUR MOTS PAGE VIRT. SI CDA.
ADCDA: WORD ADDCDA < ADRESSE DEBUT ZONE CDA UTILISEE.
STDKU: WORD 0 < 0 : RESTAURATION NORMAL DKU,
< 1 : RESTAURATION MULTIPLE SUR DKU,
< VOIR A CE SUJET 'DUMP'...
NERDKU: WORD 0 < NOMBRE D'ERREURS IRRECUPERABLES DKU.
< EN RESTAURATION DKU MULTIPLE, DONNE
< LE NOMBRE DE DUMPS PERDUS, C'EST-A-
< DIRE N'AYANT PU ETRE EXPLOITES.
NBDELF: WORD 0 < NOMBRE DE DELETE DE FICHIERS EN COURS
< DE RESTAURATION, SUITE A ERREURS DKU
< LORS DE RESTAURATION MULTIPLE.
BYTE 0;"!";"L";" " < POUR LOGON SOUS ACN COURANT.
ACNC: DZS 2 < ACN COURANT.
BYTE '04;'04 < DEUX EOT CAR L'UTILISATEUR PEUT
< ECRASER LE PREMIER (CF: DEMANDE
< D'ACN).
BYTE 0;"!";"L";" " < POUR LOGON SOUS ACN D'ENTREE.
ACNENT: DZS 2 < ACN D'ENTREE.
BYTE '04
XWOR%1: VAL 0
LGN: DZS 1 < LONGUEUR DU NOM FICHIER OU ITEM
< A RESTAURER
LGN1: DZS 1 < LONGUEUR DU NOUVEAU NOM FICHIER
< OU ITEM SOUS LEQUEL IL DOIT
< ETRE RESTAURE
<
< 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-"S",XWOR%1,,XWOR%1
AONOM: WORD NOM-ZERO*2
AXNOMR: WORD NOMR,X < RELAI D'ACCES AUX CARACTERES DE
< 'NOMR' (NOM RECHERCHE).
LGNR: WORD 0 < LONGUEUR DE 'NOMR', EOT INCLUS.
XWOR%1: VAL 0
AXASS2: WORD ASS2,X < POUR MOUVMT NOM
ALT: DZS 1 < POUR INFOS DEVANT VALEUR
< (LONGUEUR TOTALE)
AOVAL: DZS 1 < NOM+VALEUR
AXVAL: DZS 1 < RELAI INDEXE MOT NOM+VALEUR
AXTRAV: WORD ZERO,X
AOPAG: DZS 1 < ADR OCT DEB PAGE VIRT
AOFPAG: DZS 1 < ADR OCT FIN PAGE VIRT
AOPAG0: WORD PAG0 < ADR OCT DEB PAG VIRT SI CARTES
AOPAG2: WORD PAG2 < IDEM SI FICHIER
IF ORDI-"S",XWOR%1,,XWOR%1
ADPAG0: WORD FIN < ADRESSE MOT DEBUT PAGE VIRTUELLE
ADKU1: WORD NB1DKU < 1ER BLOC POSSIBLE SUR DKU
ADKU2: WORD NBFDKU < ET DERNIER
N0BDKU: WORD 0 < NUMERO DU BLOC COURANT SUR DKU
DEBDIC: WORD 0 < 'DEBDIC' ET 'FINDIC' DEFINISSENT
FINDIC: WORD 0 < L'ESPACE DKU SUR LEQUEL ON DEVRA FAIRE
< LA RECHERCHE DICHOTOMIQUE (EN MODE
< RECHERCHE, VOIR 'IRECH')
DICHO1: WORD 0 < 'DICHO1' ET 'DICHO2' DEFINISSENT
DICHO2: WORD 0 < L'ESPACE COURANT SUR LEQUEL S'EFFECTUE
< CETTE RECHERCHE DICHOTOMIQUE.
DICHOM: WORD 0 < 'MILIEU' DE LA ZONE DE RECHERCHE
< DICHOTOMIQUE.
DICHM1: WORD 0 < 'DICHOM'-1 ('DICHOM PRECEDENT)
< PERMET DE DETECTER UNE RECHERCHE
< DICHOTOMIQUE INFRUCTUEUSE.
<
< ATTENTION AU RECOUVREMENT 'NVC' / 'N0BDKU'.
<
NBV: WORD NBVER < NOMBRE DE VERROUS EN CDA.
NVC: EQU N0BDKU < NUMERO DU VERROU COURANT ( DE 0 A ...).
XWOR%1: VAL 0
PPG: DZS 1 < POINTEUR OCT PAGE VIRTUELLE
ANOMFS: WORD NOMFS < ADRESSE DU NOM DU FICHIER DE
< RESTAURATION
IF ORDI-"S",XWOR%1,,XWOR%1
ADMM2: WORD DMMEM+2 < ADRESSE TAILLE OCTETS DANS DEMANDE
< DE MEMOIRE DU 'RUNNER'.
T800: WORD '800 < 2K OCTETS.
T1000: WORD '1000 < 4K OCTETS.
XWOR%1: VAL 0
ABC: WORD BC < ADR BUFFER CARTE
AXBC: WORD BC,X < ADR X BUFFER CARTE
AFBC: WORD FBC < ADR FIN BUFFER CARTE
AXBCM1: WORD BC-1,X < RELAI INDEXE BC-1
ACHECK: WORD BC+75 < ADRESSE CHECK CARTE
PBC: DZS 1 < POINTEUR BUFFER CARTE
NUMC: DZS 1 < NUMERO CARTE EN COURS
NBM11: DZS 1 < INDEX MODULO 11 POUR LECTURE
< CARACTERE SUR CARTE
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
SAVK: WORD 0 < SAUVEGARDE DE 'K' POUR CERTAINES
< REPRISES DELICATES
AODATE: WORD DATE-ZERO*2 < ADRESSE OCTET DATE POUR SON EDITION.
IF ORDI-"S",XWOR%1,,XWOR%1
AOQDKD: WORD QDKD-ZERO*2 < ADRESSE OCTET QUANTA DUMP ASCI.
AOQDKR: WORD QDKR-ZERO*2 < ADRESSE OCTET QUANTA REST ASCI.
< (POUR RESTAURATION DK)
XWOR%1: VAL 0
<
< ATTENTION AUX RECOUVREMENTS PBV/PBC ABV/ABC
<
ABV: EQU ABC < ADRESSE MOT BUFFER VISU
PBV: EQU PBC < POINTEUR BUFFER VISU
<
< DEMANDES PAR SVC
<
IF ORDI-"S",XWOR%1,,XWOR%1
REPOUI: DZS 2
OUI: ASCI "OU"
DMOUI: WORD '0101 < DEMANDE REPONSE.
WORD REPOUI-ZERO*2
WORD 3
XWOR%1: VAL 0
DMASS: WORD '0002 < ASSIGNATION/DESASSIGNATION
WORD ASS-ZERO*2
WORD ASS3-ASS*2
DMOUT: WORD '0202 < ENVOI MESSAGE
DZS 1
DZS 1
IF ORDI-"T",XWOR%1,,XWOR%1
MACN1: BYTE '6D;'84;" ";"A"
ASCI "CN DUMP="
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
MACN1: ASCI " "
XWOR%1: VAL 0
ACND: DZS 2 < ACN DE DUMP.
MACNF: EQU $
DMAFAC: WORD '0202 < AFFICHAGE DE L'ACN DE DUMP.
WORD MACN1-ZERO*2
WORD MACNF-MACN1*2
AOACND: WORD ACND-ZERO*2 < RELAI OCTET SUR L'ACN DE DUMP.
IF ORDI-"S",XWOR%1,,XWOR%1
DMOUTA: WORD '0202 < AFFICHAGE ACN COURANT.
WORD ACNC-ZERO*2
WORD 4
DMACN: WORD '0101 < DEMANDE ACN.
WORD ACNC-ZERO*2
WORD 5
DMLGN: WORD '0002 < DEMANDE DE LOGON.
WORD ACNC-ZERO*2-3
WORD 8
DMLGSY: WORD '0002 < DEMANDE DE LOGON :SYS.
WORD MLGSYS-ZERO*2
WORD MLGSYF-MLGSYS*2
DMLGE: WORD '0002 < LOGON SOUS ACN D'ENTREE.
WORD ACNENT-ZERO*2-3
WORD 8
XWOR%1: VAL 0
DMREP: WORD '0101 < DEMANDE REPONSE 1 CAR
WORD REP-ZERO*2
WORD 1
DMREPF: WORD '0101 < DEMANDE NOM FICHIER
AOASS2: WORD ASS2-ZERO*2
WORD LNOM*2
<
DMGETM: WORD '0004 < GET MEMOIRE
WORD 0
ESPACE: DZS 1 < ESPACE ACTUELLEMENT ALLOUE
DMSTN: WORD '8402 < SGN STORE NAME
DZS 1
DZS 1
WORD -1
DMCCI: WORD '0001 < RETOUR CCI
DMOPNK: WORD '0304 < SGF OPEN NEW KEY
KEYN1: DZS 1
KEYN2: DZS 1
DMCLSK: WORD '0307 < SGF CLOSE SAVE KEY
DMWBLC: WORD '0302 < SGF WRITE BLOC
AOBUFF: DZS 1 < BUFFER FICHIER OUTPUT
WORD 128*2*QUANTA
DMRDC: WORD '0B08 < READ CARTE BINAIRE
WORD BC-ZERO*2
WORD NBCOL*2
DMOPNX: WORD '0B03 < OPEN NEXT KEY
DMCLSB: WORD '0B07 < CLOSE SAVE
DMRBLF: WORD '0B00 < READ BLOC AVEC OU SANS DELETE
WORD PAG0 < BUFFER FICHIER INPUT
WORD 128*2*QUANTA
DMLVI: WORD '0B00 < LECTURE SANS ECHO SUR LIGNE
< VISU
AOBV: WORD BV-ZERO*2
WORD LBV*2
DMWACK: WORD '0B02 < ENVOI 'ACK' VERS VISU EMETTRICE
WORD MACK-ZERO*2
WORD 1
DMRACK: WORD '0B00 < READ 'ACK' DE VISU EMETTRICE
WORD REP-ZERO*2
WORD 1
DMWSYN: WORD '0B02 < ENVOI DU CARACTERE DE RESYNCHRONISATION
WORD MSYNC-ZERO*2 < VERS LA VISU EMETTRICE SI LE DERNIER
WORD 1 < BUFFER A ETE MAL RECU.
DMTMPO: WORD '0005 < TEMPORISATION.
IF ORDI-"T",XWOR%1,,XWOR%1
WORD 0 < MOT UTILISABLE...
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
DMTMP2: WORD '0005 < TEMPORISATION 2 SECONDES.
XWOR%1: VAL 0
WORD 1 < 1 SECONDE.
IF ORDI-"S",XWOR%1,,XWOR%1
WORD 2 < 2 SECONDES.
DMRDKU: WORD '8A00 < LECTURE SUR DKU.
WORD PAG0
WORD 128*2*QUANTA
DZS 1 < NUMERO DU BLOC
DMRAZ: WORD '0205 < ERASE ECRAN VISU.
DMNOMR: WORD '0101 < DEMANDE DU NOM A RECHERCHER (CF 'NOMR')
WORD NOMR-ZERO*2
WORD LNOM*2
XWOR%1: VAL 0
DMBHTP: WORD '010A < POUR DISCRIMINER BATCH/TP
WORD 0
WORD 1
IF ORDI-"T",XWOR%1,,XWOR%1
DMDLN: WORD '8302 < DELETE NOM+VALEUR DU FICHIER DE
< RESTAURATION
WORD NOMFS-ZERO*2
WORD LNOM+1*2+1
WORD -1
XWOR%1: VAL 0
MDKI: BYTE '6D;"D"
ASCI "K "
MAS: BYTE '6D;"A"
MASDR: WORD 0 < "SD" / "SR"
MASAS: WORD 0;0 < ADRESSE SECTEUR EN ASCI.
MASF: EQU $ < FIN ZONE 'MAS'.
DMDKI: WORD '0202 < AFFICHAGE NUMERO DE DISQUE
WORD MDKI-ZERO*2
WORD 0
DMWAS: WORD '0202 < AFFICHAGE ADRESSE SECTEUR
WORD MAS-ZERO*2
WORD 0
DMRAS: WORD '0101 < READ ADRESSE SECTEUR DEMANDEE
WORD MASAS-ZERO*2
WORD 4
MNSDR: BYTE '6D;"N"
WORD 0 < "SD" / "SR"
WORD 0
WORD 0
MNSD: ASCI "SD"
MNSR: ASCI "SR"
DMWNS: WORD '0202 < AFFICHAGE NOMBRE DE SECTEURS
WORD MNSDR-ZERO*2
WORD 8
IF ORDI-"T",XWOR%1,,XWOR%1
DMWDK: WORD '0302 < WRITE 1 SECTEUR SUR DK
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
DMWDK: WORD '0002 < EN SOLAR, ON S'ASSIGNERA LE DK A
< RESTAURER SOIT EN ASSIGNATION EXPLICITE
< SOIT EN ASSIGNATION IMPLICITE (DK1/DKU).
XWOR%1: VAL 0
WORD 0 < ADRESSE OCTET BUFFER DK
WORD 0 < LONGUEUR OCTET BUFFER DK
WORD 0 < ADRESSE SECTEUR
DMASDK: WORD '0003 < CONNEXION/DECONNEXION DK<-->UL 3
WORD '0300 < UL ; NSPDKI
IF ORDI-"S",XWOR%1,,XWOR%1
XIMPL: VAL 3 < ADRESSE D'IMPLANTATION DU RUNNER.
ARUN: WORD XIMPL < ADRESSE DU RUNNER.
< DANS LE MODE "X" (EXECUTION ITEM-
< PROGRAMME)
< ATTENTION! CE RELAI D'ACCES AU RUNNER DOIT ETRE BASE PAR 'C' !
< (CF LE S/P 'EXEC').
<
LOCAL
LOC: EQU $
DMCDA: WORD '0002 < !CDA
WORD MCDA-ZERO*2
WORD FMCDA-MCDA*2
< CHANGEMENTS DE NOMS SUR RACINE.
LMRAC: VAL 10*2 < LONGUEUR OCTETS MAX RACINE.
RAC0: DZS LMRAC+1/2 < RACINE A MODIFIER (+1: EOT).
RAC2: DZS LMRAC+1/2 < NOUVELLE RACINE (+1: EOT).
LRAC0: DZS 1 < LONGUEUR OCTETS RAC0.
LRAC2: DZS 1 < LONGUEUR OCTETS RAC2.
DMRAC0: WORD '0101 < GET RAC0.
WORD RAC0-ZERO*2
WORD LMRAC
DMRAC2: WORD '0101 < GET RAC2.
WORD RAC2-ZERO*2
WORD LMRAC
DMENN: WORD '0202 < EDITION NOUVEAU NOM.
WORD ASS2-ZERO*2
DZS 1
AXRAC0: WORD RAC0,X
AXRAC2: WORD RAC2,X
XWOR%1: VAL 0
<
< RELAIS SOUS-PROGRAMMES
<
AENTR1: WORD ENTRY1 < ENTREE 1 DANS REST.
IF ORDI-"S",XWOR%1,,XWOR%1
AENTR2: WORD ENTRY2 < ENTREE 2 DANS REST (REPRISE SUR
< DEFAUT DKU EN RESTAURATION MULTIPLE).
XWOR%1: VAL 0
ARTCCI: WORD RTCCI < RETOUR CCI
ADESAS: WORD DESAS < DESASSIGNATION
IF ORDI-"S",XWOR%1,,XWOR%1
ATAD: WORD TAD < TEST AND DELETE (MODE "DELETE
< AND REST).
ADFPR: WORD DFPR < DELETE (EVENTUEL) FICHIER PARTIEL-
< LEMENT RESTAURE.
AARDLN: WORD ARDLN < ASSIGN RELEASE ET DLN.
AEXEC: WORD EXEC < PROGRAMME DE PREPARATION AU RUN,
ARVAS: WORD RVAS < READ ET VALIDATION ADRESSE SECTEUR DKU.
AVALID: WORD VALID < VALIDATION ADRESSE SECTEUR DKU PAR
< RAPPORT AUX BORNES 'ADKU1' ET 'ADKU2'
< DEFINISSANT L'ESPACE DKU ACCESSIBLE.
ACOMP: WORD COMP < COMPARAISON NOM COURANT ('NOM') ET
< NOM RECHERCHE ('NOMR') DANS LE CAS
< DU MODE 'RECHERCHE'.
ATSTAC: WORD TSTAC < TEST ACN DE LOGON INITIAL.
ASETV: WORD SETV < SET VERROU COURANT 'NVC' EN CDA.
ARSETV: WORD RSETV < RESET VERROU VOURANT 'NVC' EN CDA.
ATESTV: WORD TESTV < TEST VERROU COURANT 'NVC' EN CDA.
XWOR%1: VAL 0
AULB: WORD ULB < VERIF UL 'B
ARITEM: WORD RITEM < RESTAURATION ITEM
ARFICH: WORD RFICH < RESTAURATION FICHIER
ARSTDK: WORD RSTDK < RESTAURATION DISQUE
ARSTDA: WORD RSTDA < RESTAURATION DE LA DATE DU DUMP.
ARSTAC: WORD RSTAC < RESTAURATION DE L'ACN DU DUMP.
AEDN: WORD EDN < EDITION NOM SUR VISU
AR1: WORD R1 < READ 1 CAR SUR PAGE VIRTUELLE
ALDC: WORD LDC < LOAD CARACTERE PAGE VIRTUELLE
ARN: WORD RN < READ N CAR SUR PAGE VIRTUELLE
ARPAGE: WORD RPAGE < READ 1 PAGE VIRTUELLE
AGESTM: WORD GESTM < GESTION ESPACE MEMOIRE
APRCH: WORD PRCH < PROPOSITION CHANGEMENT NOMS
ACHN: WORD CHN < CHANGEMENT DE NOM
ARCARD: WORD RCARD < READ CARTE
AR1C: WORD R1C < READ 1 CARACTERE SUR CARTE
AENVOI: WORD ENVOI < ENVOI MESSAGE
AQREP: WORD QREP < ENVOI QUESTION ET DEMANDE REPONSE
ACONVH: WORD CONVH < CONVERSION ASCI --> BINAIRE
ACONVA: WORD CONVA < CONVERSION BINAIRE --> ASCI
IF ORDI-"S",XWOR%1,,XWOR%1
<
< DONNEES DE DECODAGE :
<
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 < ACCES A LA CLEF DE DECODAGE.
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.
AKOMP: WORD KOMP < SOUS-PROGRAMME DE DECODAGE...
ICLEF: WORD 0 < 0 : PAS DE DECODAGE...
<
< DONNEES D'ARRET :
<
CARALT: WORD 0 < =0 : PAS DE CARACTERE D'ARRET,
< =CODE ASCI ENTRE " " ET "@", ALORS
< LORSQU'UN CARACTERE IDENTIQUE EST REN-
< CONTRE DANS UN NOM (ITEM OU FICHIER),
< EN COURS DE RESTAURATION, ON SIMULE UN
< ALT-MODE AFIN D'ARRETER LA RESTAURA-
< TION...
PAGE
PROG
<
< RUNNER A IMPLANTER EN ADRESSES BASSES ET QUI SE CHARGERA DE
< 'MOVER' ET LANCER L'ITEM-PROGRAMME A EXECUTER.
<
RUNNER: EQU $
LB 0,W < LOAD MOT.
STB 0,L < STORE MOT.
ADRI 1,W < AU SUIVANT.
ADRI 1,L < ...
JDX RUNNER
SVC 0 < DEMANDE MEMOIRE.
LRM W
WORD '10 < ADRESSE DE RUN.
BR 0,W
DMMEM: WORD '0004 < DEMANDE MEMOIRE.
WORD 0 < INUTILISE.
WORD 0 < TAILLE OCTETS (VALORISEE PAR 'EXEC')
RUNF: EQU $ < FIN DU RUNNER.
XWORK: VAL DMMEM-RUNNER
XMEM: EQU ZERO+XIMPL+XWORK< ADRESSE DEMANDE DE MEMOIRE.
XWOR%1: VAL 0
PAGE
PAGE
PROG
WORD COM+128
ENTRY1: EQU $
<
< E N T R Y 1 D A N S R E S T ( I N I T I A L E . . . )
<
< INITIALISATIONS
<
LRP C
LA -1,C
LR A,C
LA APILM1
LR A,K
IF ORDI-"S",XWOR%1,,XWOR%1
LRM L
WORD LOC+'80 < 'L' BASE LE 'LOCAL'.
WORD '1E25 < POUR SAUVER L'ACN D'ENTREE.
STA ACNENT
STB ACNENT+1
XWOR%1: VAL 0
IF ORDI-"T",XWOR%1,,XWOR%1
LA ARTCCI < SI ALT-MODE --->CCI
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
< EN SOLAR: INITIALISATION DE L'INDICATEUR "DELETE AND REST"...
REST0: EQU $
STZ NBEND < NOMBRE D'ENTITES N'AYANT PU ETRE DELETEES
< RECOIT 0 A PRIORI.
STZ IDELAR < MODE NON DELETE A PRIORI.
STZ CARALT < PAS DE CARACTERE D'ARRET A PRIORI...
LAI MDELAR-M
BSR AENVOI < ENVOI QUESTION.
LAD DMOUI < LA REPONSE DOIT ETRE "OUI"/"OUD" EN TOUTE
SVC 0 < LETTRES, SINON C'EST NON.
LA REPOUI
CP OUI
JNE REST1
LBY REPOUI+1
CPI "D" < EST-CE LE DELETE SEUL ???
JE REST2X < OUI...
CPI " " < EST-CE UN CODE D'ARRET ???
JL REST1X < NON...
CPI '40 < EST-CE UN CODE D'ARRET ???
JG REST1X < NON...
STA CARALT < OUI, ON LE MEMORISE...
JMP REST1 < ET C'EST TOUT...
REST2X: EQU $
DC IDELAR < OUI : IDELAR=-1 (DELETE EUL).
LAI MDD-M
JMP REST1Y < ET ON VA LE DIRE...
REST1X: EQU $
CPI "I" < "OUI" ???
JNE REST1 < NON...
IC IDELAR < OUI : IDELAR=+1 (DELETE & REST).
LAI MDR-M < ON PREVIENT !
REST1Y: EQU $
BSR AENVOI
REST1: EQU $
LRM A < SI ALT-MODE --> 'RFINF'.
WORD RFINF
XWOR%1: VAL 0
WORD '1EB5
WORD '1E35
STA ESPACE < ESPACE ACTUELLEMENT ALLOUE
IF ORDI-"S",XWOR%1,,XWOR%1
LRM A
WORD 128*2*QUANTA < EN SOLAR, LONGUEUR BLOC SGF
STA DMWBLC+2 < A PRIORI POUR LES FICHIER
< A RESTAURER
STA DMRBLF+2 < AINSI QUE POUR LE FICHIER DE RESTAURATION
XWOR%1: VAL 0
BSR AULB < ASSIGNATION UL RESTAURA
< TION ET POSITIONNEMENT
< TYPRST ET FIXATION EN CONSEQU
< ENCE DE LA LONGUEUR DE PAGE
< VIRTUELLE ET DONC DES ADRESSES
< DES ZONES IMPLANTEES DERRIERE
LAI 0
BSR AGESTM < ALLOCATION MEMOIRE POUR COMMENCER
BSR APRCH < PROPOSITION CHANGEMENTS DE NOMS
< CE S/P POSITIONNE ICHN
RBCLX: EQU $ < BOUCLE EN MODE MULTIPLE...
STZ IPRR1 < PREMIER READ=OUI
IF ORDI-"S",XWOR%,,XWOR%
STZ IACN < INDICATEUR "ACN RENCONTRE" = NON;
< UTILISE EN CAS DE MODE "RECHERCHE".
CPZ IRECH < TEST MODE RECHERCHE.
JE RBCL1
CPZ IFINR < EST-CE UNE FIN DE RECHERCHE, AUTREMENT
< DIT, FAUT-IL PROPOSER UNE NOUVELLE
< RECHERCHE OU POURSUIVRE CELLE EN COURS?
JE RBCL3 < POURSUIVRE LA RECHERCHE EN COURS.
RBCL6: EQU $
<
< PROPOSER UNE NOUVELLE RECHERCHE.
<
CPZ ICHACN < TEST CHANGEMENT ACN DEMANDE ?
JE RBCL7
BSR ATSTAC < TEST ACN DE LOGON INITIAL,
JE $+2 < QUI DOIT ETRE :SYS, SINON...
ACTD
RBCL8: EQU $
LAI MACNR-M < DEMANDE D'ACN DE RECHERCHE.
BSR AENVOI
LAD DMACN
SVC 0
LAD DMLGN < SOUS LEQUEL ON FAIT LOGON.
SVC 0
JNE RBCL8 < ACN INCORRECT.
RBCL7: EQU $
LAI MNOMR-M < DEMANDER LE NOM A RECHERCHER.
BSR AENVOI
LAD DMNOMR
SVC 0
WORD '1E35 < 'B' <-- 'BOX'; 'A' DETRUIT.
STB LGNR < LONGUEUR NOM A RECHERCHER, EOT INCLUS.
LR B,A
CPI 1 < TEST NOM VIDE.
JE RBCL2 < C'EST FINI, FIN DE TRAVAIL.
<
< NOUVELLE RECHERCHE, REINITIALISER DICHO1' ET 'DICHO2', BORNES COURANTES
< DE LA RECHERCHE DICHOTOMIQUE, AINSI QUE 'IFINR', L'INDICATEUR DE FIN
< DE RECHERCHE.
<
LA DEBDIC
STA DICHO1
LA FINDIC
STA DICHO2
STZ IFINR < FIN DE RECHERCHE = NON.
LAI -1
STA DICHM1 < ADRESSE SECTEUR "IMPOSSIBLE"; VALEUR
< D'INITIALISATION DE 'DICHM1' QUI
< CONTIENT LE 'DICHOM' "PECEDENT". CECI
< PERMET DE SAVOIR SI UNE RECHERCHE
< EST INFRUCTUEUSE ("PATINAGE!").
RBCL3: EQU $
<
< POURSUITE DE LA RECHERCHE COURANTE.
<
LA DICHO1 < POSITIONNEMENT DE 'DMRDKU+3' (ADRESSE
SLRD 16+1 < DKU COURANTE) A ENVIRON DICHO1+DICO2/2.
LA DICHO2
SLRS 1
ADR B,A
STA DICHOM < ON VA AJOUTER 1 A CETTE ADRESSE
LA DICHO1 < SI DICHO1 ET DICHO2 SONT IMPAIRES.
AND DICHO2
TBT 15
JNC RBCL4
IC DICHOM < + 1.
RBCL4: EQU $
LA DICHOM
CP DICHM1 < 'DICHOM' EST-IL EGAL AU 'DICHOM' PRCEDENT
< SI C'EST LE CAS, C'EST QUE LA RECHERCHE
< COURANTE EST INFRUCTUEUSE...
JNE RBCL5
LAI MNTR-M < LA RECHERCHE COURANTE EST INFRUCTUEUSE,
BSR AENVOI < ON LE SIGNALE.
JMP RBCL6 < VERS PROPOSITION D'UNE NOUVELLE
< RECHERCHE.
RBCL5: EQU $
STA DICHM1 < POUR LE PROCHAIN TEST...
STA DMRDKU+3 < ADRESSE SECTEUR COURANTE DKU.
STZ IRETAR < RE-AUTORISATION RETOUR ARRIERE.
STZ NERDKU < RE-INITIALISATION NB ERREURS DKU.
STZ NBDELF < RE-INITIALISATION NOMBRE DE FICHIERS
< PARTIELLEMENT RESTAURES DELETES SUITE
< AUX ERREURS DKU IRRECUPERABLES.
RBCL1: EQU $
BSR AR1
JANE RCBLX1
STZ TRAV
BSR AR1
JANE RCBLX2
RBCL2: EQU $
STZ STDKU < DUMP VIDE, ON ARRETE LE MODE MULTIPLE...
LAD DMRAZ < ERASE ECRAN.
SVC 0
LA NERDKU < NOMBRE DE DUMPS PERDUS.
LRM Y
WORD MPERDD-ZERO*2
BSR ACONVA < EDITION ASCI.
LA NBDELF < DONT NOMBRE DE FICHIERS PERDUS.
ADRI MPERDF-MPERDD*2,Y
BSR ACONVA < EDITION ASCI.
LAI MPERD-M < ENVOI DU MESSAGE.
BSR AENVOI
JMP RFIN < C'EST FINI...
XWOR%: VAL 0
RBCL: EQU $
<
< BOUCLE DE RESTAURATION
<
BSR AR1
RCBLX1: EQU $
CPI 'DA < DATE ?
JE RDA1
CPI 'AC
JE RAC1
CPI 'DF < DEBUT FICHIER ?
JE RF1
CPI 'DD < DEBUT DISQUE ?
JE RD1
IF ORDI-"T",XWOR%1,,XWOR%1
SWBR A,L
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
SWBR A
STA TRAV
XWOR%1: VAL 0
BSR AR1
RCBLX2: EQU $
IF ORDI-"T",XWOR%1,,XWOR%1
ORR L,A
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
OR TRAV
XWOR%1: VAL 0
JAE RFIN < SI '0000 --> FIN
BSR ARITEM < RESTAUR ITEM
JMP RBCLF
RF1: EQU $
BSR ARFICH < RESTAUR FICH
IF ORDI-"S",XWOR%1,,XWOR%1
CPZ IRECH < TEST MODE RECHERCHE
JNE RFIN < EN EFFET, EN MODE 'RECHERCHE',
< ON PEUT AVOIR ABANDONNE
< BRUTALEMENT UNE RESTAURATION FICHIER
< (SI NOM RENCONTRE # NOM RECHERCHE).
< IL FAUT DONC SORTIR TOUT DE SUITE
< DE LA BOUCLE DE RESTAURATION DANS
< LAQUELLE NOUS SOMMES.
XWOR%1: VAL 0
JMP RBCLF
RDA1: EQU $
BSR ARSTDA < RESTAURATION DATE.
JMP RBCLF
RAC1: EQU $ < RESTAURATION DE L'ACN DU DUMP.
BSR ARSTAC
JMP RBCLF
RD1: EQU $
BSR ARSTDK < RESTAURATION DISQUE
RBCLF: EQU $
JMP RBCL < AU SUIVANT
IF ORDI-"S",XWOR%1,,XWOR%1
RBCLXX: JMP RBCLX < SAUT > 128 !
XWOR%1: VAL 0
<
< FIN DU PROGRAMME
<
RFIN: EQU $
CPZ TYPRST < OPERATIONS DE FIN, EN FONCTION
< DU TYPE DE RESTAURATION
JE RFIN9 < RESTAURATION VISU: RIEN A FAIRE
JL RFINC < RESTAURATION CARTES
IF ORDI-"S",XWOR%1,,XWOR%1
LA TYPRST
CPI 1
JNE RFIN9 < DKU OU CDA, RIEN A FAIRE.
XWOR%1: VAL 0
< RESTAURATION FICHIER: IL FAUT
< EVENTUELLEMENT FAIRE UN ASSIGN
< RELEASE ET UN DLN SUR LE FICHIER
< DE RESTAURATION
LA DMRBLF < DEMANDE DE READ BLOC
TBT 15 < C'ETAIT LECTURE-DELETE ?
JNC RFIN9 < NON, RIEN A FAIRE
IF ORDI-"T",XWOR%1,,XWOR%1
LAI "B" < OUI, FAIRE ASSIGN B=R.
STBY ASSUL
LA ASSR
STA ASS1
LAD DMASS < !ASSIGN B=R
SVC 0
JE $+2
ACTD
LAD DMDLN < SGN: DELETE NOM+VALEUR
SVC 0
JE $+2
ACTD
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
LRM A,B,X
WORD NOMFS < NOM DU FICHIER DE RESTAURATION A DELETER.
WORD ASS2 < POUR LE S/P 'ARDLN'.
WORD LNOM+1
MOVE < 'ASS2' CONTIENT LE NOM.
LAD DMLGSY
SVC 0 < ON TENTE A PRIORI DE PASSER SOUS
< :SYS, CAR EN EFFET SI CELA EST POSSI-
< BLE, LE FICHIER A DETRUIRE LUI APPAR-
< TIENT...
LAI "B" < UNITE LOGIQUE.
BSR AARDLN < DELETE DU FICHIER.
XWOR%1: VAL 0
JMP RFIN9
RFINC: EQU $ < RESTAURATION CARTES
< ON S'ASSURE QUE TOUTES
< LES CARTES ONT BIEN ETE LUES
< (ENCHAINEMENTS EVENTUELS DE
< RESTAURATIONS)
RFIN1: EQU $
BSR ARCARD < READ CARD
CPZ IRCARD < READ CARD TOUJOURS ACTIF?
JE RFIN1 < OUI, CONTINUER
RFIN9: EQU $
IF ORDI-"S",XWOR%,,XWOR%
CPZ STDKU < MULTIPLE ???
JNE RBCLXX < OUI, ON RECOMMENCE...
XWOR%: VAL 0
LAI 0
BSR AGESTM < ON RELACHE L'ESPACE INUTILE
IF ORDI-"S",XWOR%1,,XWOR%1
RFINF: LAD DMLGE < LOGON SOUS ACN INITIAL,
SVC 0 < SYSTEMATIQUE, ET TANT PIS POUR
< LE CODE RETOUR...
XWOR%1: VAL 0
BR ARTCCI
PAGE
IF ORDI-"S",XWOR%1,,XWOR%1
<
< E N T R Y 2 D A N S R E S T ( S U I T E A E R R E U R
<
< I R R E C U P E R A B L E S U R D K U E N R E S T A U R A -
<
< T I O N M U L T I P L E.
<
ENTRY2: EQU $
LRM C,L,K
WORD COM+'80
WORD LOC+'80
WORD PILE-1
JMP RBCLXX < ET VOILA...
XWOR%1: VAL 0
PAGE
RITEM: EQU $
<
< R E S T A U R A T I O N I T E M
<
< EN ENTREE A=LONGUEUR TOTALE
< C-A-D L(NOM+VAL+2)
<
IVALEX:: VAL 0 < BIT DISCRIMINANT LES ITEMS D'EXTENSION
< SUR VOLUME DES AUTRES...
TBT IVALEX < S'AGIT D'UN ITEM D'EXTENSION ???
RBT IVALEX < A PRIORI...
STA &ALT < LONGUEUR TOTALE
PSR A
LAI -1
STA DMSTN+3 < NON, PAS D'EXTENSION A PRIORI...
JNC RITEM1 < EFFECTIVEMENT...
NSPDKU:: VAL 'A3 < VALEUR DE DISCRIMINATION ENTRE LES ITEMS
< D'EXTENSION ET LES AUTRES...
LAI NSPDKU
STBY DMSTN+3 < QUE L'ON MET DANS LA DEMANDE...
RITEM1: EQU $
PLR A
ADRI -2,A < LONGUEUR "NETTE" NOM+VALEUR
BSR AGESTM < AJUSTEMENT MEMOIRE
LR A,X < LONGUEUR A LIRE
LA AOVAL < @ OCT STOCKAGE
BSR ARN < READ NOM+VAL
STX DMSTN+2 < LONGUEUR NOM+VAL
BSR AEDN < EDITION NOM
LAI MIT-M < ON SIGNALE QUE C'EST UN ITEM
BSR AENVOI
IF ORDI-"S",XWOR%1,,XWOR%1
CPZ IEXEC < TEST INDICATEUR 'EXECUTE'.
JE RI2
BR AEXEC < IL FAUT EXECUTER L'ITEM PROGRAMME
< DONT ON VIENT DE RECUPERER LE NOM ET LA
< VALEUR...
RI2: EQU $
BSR ACOMP < COMPARAISON NOM COURANT :: NOM RECHERCHE
< SI L'ON N'EST PAS EN MODE 'RECHERCHE'
< ON OBTIENDRA 'EGALITE'.
JE RI3
<
< MODE RECHERCHE ET NOM COURANT # NOM RECHERCHE.
<
LAI MPDR-M < MESSAGE "PAS DE RESTAURATION".
BSR AENVOI
JMP RI1 < ET VOILA.
RI3: EQU $
XWOR%1: VAL 0
BSR ACHN < CHANGEMENT DE NOM (EVENTUEL)
IF ORDI-"S",XWOR%1,,XWOR%1
RI4: EQU $
XWOR%1: VAL 0
LAD DMSTN < SGN STORE NAME
SVC 0
JE RI1 < OK?
IF ORDI-"S",XWOR%1,,XWOR%1
LA DMSTN+1 < 'A' = ADRESSE OCTET DU NOM COURANT.
BSR ATAD < TEST AND DELETE EVENTUEL.
JNE RI4X1 < LE NOM N'A PAS ETE DETRUIT...
CPZ IDELAR < LE NOM A ETE DETRUIT, EST-CE TOUT ???
JL RI1 < OUI (DELETE SEUL)...
JMP RI4 < NON (DELETE & REST) ...
RI4X1: EQU $
< ICI, DE DEUX CHOSES L'UNE: OU LE NOM N'A PU ETRE DETRUIT,
< OU BIEN L'OPTION DELETE AND REST N'EST PAS ACTIVE.
XWOR%1: VAL 0
LAI MPBSTN-M < ON PREVIENT
BSR AENVOI
RI1: EQU $
RSR
PAGE
RFICH: EQU $
<
< R E S T A U R A T I O N F I C H I E R
<
<
< AJUSTEMENT ESPACE MEMOIRE, ON MET DANS A LA LONGUEUR
< OCTETS NECESSAIRE DANS VALEUR POUR LE BUFFER FICHIER
< INPUT, CELUI-CI ETANT EN RECOUVREMENT DE VALEUR
< A PARTIR DU 2ND MOT,IL NOUS FAUT DONC QUANTA*128-1*2
< OCTETS EN RECOUVREMENT DANS VALEUR
<
IF ORDI-"T",XWOR%1,,XWOR%1
LAI 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
BSR AGESTM < AJUSTEMENT MEMOIRE
<
< ACQUISITION ET EDITION NOM FICHIER
<
LXI 0 < INIT COUNT
RF2: EQU $
BSR AR1 < READ 1 CAR
STBY &AXVAL < STORE CARACTERE
CPI '04 < EOT ?
JE RFET
ADRI 1,X < NON, AU SUIVANT
JMP RF2
RFET: EQU $
BSR AEDN < EDIT NOM...
LAI MFI-M
BSR AENVOI < ...ET ON SIGNALE QUE C'EST
< UN FICHIER
IF ORDI-"S",XWOR%1,,XWOR%1
BSR ACOMP < COMPARAISON NOM COURANT :: NOM RECHERCHE.
< SI L'ON N'EST PAS EN MODE 'RECHERCHE',
< ON OBTIENDRA 'EGALITE'.
JE RF8
<
< MODE RECHERCHE ET NOM COURANT # NOM RECHERCHE.
<
LAI MPDR-M < MESSAGE "PAS DE RESTAURATION".
BSR AENVOI
JMP RFF < CARREMENT !
RF8: EQU $
XWOR%1: VAL 0
BSR ACHN < CHANGEMENT DE NOM(EVENTUEL)
<
< RESTAURATION FICHIER
< -ACTIVATION OPERATIONS SGF OUT (INDIC SGFO)
< -DESASSIGNATION DE L'UL '3
< -ASSIGNATION A L'UL '3 EN NEW DU FICH EN COURS
< SI ELLE N'EST PAS POSSIBLE, ON LE SIGNALE ET ON
< INHIBE LES OPERATIONS SGF JUSQU'A LA FIN DE TRAITE
< MENT DE CE FICHIER
< -LA RESTAURATION SE FAIT CLE PAR CLE ET BLOC PAR
< BLOC DANS LA CLE
<
IF ORDI-"S",XWOR%1,,XWOR%1
RF9: EQU $
XWOR%1: VAL 0
STZ ISGFO < ACTIVATION SGF OUTPUT
LAI "3"
BSR ADESAS < DESASS UL '3
LA ASS4
STA ASS1
LAD DMASS < ASSIGNATION EN NEW
SVC 0
JE RF3 < OK?
IF ORDI-"T",XWOR%1,,XWOR%1
< NON,LE SIGNALER
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
LAD ASS2
SLLS 1 < ADRESSE OCTET DU NOM COURANT.
BSR ATAD < TEST AND DELETE EVENTUEL.
JNE RF9X1 < LE NOM N'A PAS ETE DETRUIT...
CPZ IDELAR < LE NOM A ETE DETRUIT, EST-CE TOUT ???
JL RF7X1 < OUI (DELETE SEUL)...
JMP RF9 < NON (DELETE & REST)...
RF9X1: EQU $
< ICI, LE NOM N'A PU ETRE DETRUIT, OU ALORS L'OPTION DELETE AND REST N'EST PAS
< ACTIVE.
XWOR%1: VAL 0
LAI MPBAS-M
BSR AENVOI
RF7X1: EQU $
IC ISGFO < ET INHIBER OPERATIONS SGF OUTPUT
IF ORDI-"S",XWOR%1,,XWOR%1
JMP RF7 < CE FICHIER N'A PU ETRE ASSIGNE EN NEW,
< IL NE SERA DONC PAS RESTAURE.
XWOR%1: VAL 0
RF3: EQU $
IF ORDI-"S",XWOR%1,,XWOR%1
<
< ICI, LE FICHIER VIENT D'ETRE ASSIGNE EN NEW: IL FAUT DONC
< POSITIONNER L'INDICATEUR 'IRESTF' DE RESTAURATION FICHIER POUR LE
< CAS D'UN DEFAUT IRRECUPERABLE SUR DKU EN CAS DE DUMP DKU MULTIPLE
<
STZ IRESTF
IC IRESTF
RF7: EQU $
XWOR%1: VAL 0
BSR AR1
CPI 'FF < FIN FICHIER?
JE RFF
CPI 'DE < NON, DEBUT ENR?
JE $+2
ACTD
LXI 4
LAD KEYN1
SLLS 1
BSR ARN < ACQUISITION KEY (READ 4 CAR)
LAD DMOPNK < OPEN NEW KEY
CPZ ISGFO < SSI SGF OUTPUT ACTIF
JNE RF4
SVC 0
JE $+2
ACTD
RF4: EQU $
BSR AR1
CPI 'FE < FIN D'ENREGISTREMENT?
JE RFFE
CPI 'DB < NON, ALORS DEBUT BLOC?
JE $+2
ACTD
LA DMWBLC+1 < @ OCT ZONE STOCK
LX DMWBLC+2 < LONGUEUR A LIRE
BSR ARN < READ BLOC
LAD DMWBLC < WRITE BLOC
CPZ ISGFO < SSI SGF OUTPUT ACTIF
JNE RF5
SVC 0
JE $+2
ACTD
RF5: EQU $
BSR AR1
CPI 'FB < FIN DE BLOC?
JE $+2
ACTD
JMP RF4 < ON CONTINUE
RFFE: EQU $ < FIN D'ENR
LAD DMCLSK < CLOSE SAVE KEY
CPZ ISGFO < SSI SGF OUTPUT ACTIF
JNE RF6
SVC 0
JE $+2
ACTD
RF6: EQU $
JMP RF3 < AU SUIVANT
RFF: EQU $ < FIN RESTAUR FICHIER
IF ORDI-"S",XWOR%1,,XWOR%1
STZ IRESTF < RESTAURATION FICHIER TERMINEE.
XWOR%1: VAL 0
RSR
PAGE
RSTDK: EQU $
<
< R E S T A U R A T I O N D ' U N D I S Q U E
<
PSR X,Y < SAUVEGARDES
<
STZ IDKO < RESTAURATION DK ACTIVE A PRIORI
<
IF ORDI-"S",XWOR%1,,XWOR%1
<
< EN SOLAR, ON UTILISERA LE DK A RESTAURER SEN ASSIGNATION EXPLICITE
< A PRIORI.
<
LAI 3
STBY DMWDK
LA DMWDK < ON "RAZE" SYSTEMATIQUEMENT LE
RBT 12 < BIT 12 DE LA DEMANDE D'ECRITURE
STA DMWDK < SUR DISQUE.
XWOR%1: VAL 0
BSR AR1 < READ QUANTA DE DUMP
STA QUANDP < QUANTA DUMP
<
BSR AR1 < READ NSP DU DK DE DUMP
PSR A
IF ORDI-"S",XWOR%1,,XWOR%1
CPI NSPDK1
JGE RSTDKG < DK1, DK2 OU DK3.
LBI "A" < DKA A PRIORI
CPI NSPDKA
JE $+2 < B="A"
LBI "B" < B="B"
LR B,A
ADRI +NSPDK1-1-'30,A
RSTDKG: EQU $
XWOR%1: VAL 0
ADRI -NSPDK1+1+'30,A
LB MDKI+1
SLLD 8
SWBR A,A
STA MDKI+1 < STORE NSPDKI EN ASCI POUR EDITION
PLR A
LB DMASDK+1 < PREPARATION ASSIGNATION
SLRD 8
SWBR B,B
STB DMASDK+1 < POUR ASSIGNATION
<
LAD DMWDK+3
SLLS 1 < ADRESSE OCTETE ADRESSE SECTEUR
< DE LA DEMANDE DK
LXI 2 < 2 OCTETS
BSR ARN < READ ADRESSE SECTEUR
<
LAD NBSECD
SLLS 1 < ADRESSE OCTETS NOMBRE DE SECTEURS
LXI 2
BSR ARN < READ NOMBRE DE SECTEURS
<
RSTDK2: EQU $
<
< AFFICHAGE DU NUMERO DE DISQUE ET DEMANDE EVENTUELLE DE
< CHANGEMENT DE DISQUE (!!!)
<
LAI 128 < QUANTA = 1 A PRIORI
SLLS 1
STA DMWDK+2
STZ QUANRS
IC QUANRS < QUANTA = 1 A PRIORI
<
LAI 4
STA DMDKI+2
LAD DMDKI < AFFICHAGE : "DKI"
SVC 0
CPZ ICHN < CHANGEMENT DEMANDE ?
JE RSTDK5 < NON
DC DMDKI+2 < AFFICHAGE : "DK"
SVC 0
LAD DMREP < DEMANDE REPONSE
SVC 0
LBY REP < REPONSE
RSTDK0: EQU $
CPI '04 < EOT ?
JE RSTDK5
CPI '0D < RETURN ?
JE RSTDK5
CPI "3" < DK3 ?
JE RSTDK3
CPI "2" < DK2 ?
IF ORDI-"T",XWOR%1,,XWOR%1
JNE RSTDK2 < T1600 REPONSE NON RECONNUE
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
JE RSTDKH
CPI "1" < DK1 ?
JE RSTDKH
CPI "A"
JE RSTDK3
CPI "B"
JE RSTDK4
JMP RSTDK2 < SOLAR REPONSE NON RECONNUE
RSTDKH: EQU $ < DK2 DEMANDE SUR SOLAR...
LR A,B < SAUVER LA REPONSE
LA DMASDK+1
ANDI '00FF < LE DUMP ETAIT-IL SUR DK2?
CPI NSPDK1
JE RSTDXX < DK1 : DEMANDER LE QUANTA...
CPI NSPDK2 < SI OUI...
JNE RSTDKS
RSTDXX: EQU $
LA QUANDP < ...IL FAUT REGARDER LE QUANTA
CPI QUANTA < DE DUMP: ET PRENDRE LE MEME
JE RSTDKS < A PRIORI POUR LA RESTAURATION.
LA DMWDK < C'ETAIT QUANTA 1 ! IL FAUT DONC
SBT 12 < TRAVAILLER A PRIORI AVEC QUANTA 1
STA DMWDK < (BIT 12 DEMANDE DISQUE)
LR B,A < RECUPERATION REPONSE
JMP RSTDK3
RSTDKS: EQU $
LR B,A < RECUPERATION REPONSE
RSTDK4: EQU $ < QUANTA 3.
LRM B
WORD QUANTA*128*2 < ON A QUANTA RESTAURATION=3
STB DMWDK+2 < TAILLE BUFFER DEMANDE DISQUE
LBI 3 < QUANTA RESTAURATION
STB QUANRS < QUANTA RESTAURATION = 3.
XWOR%1: VAL 0
RSTDK3: EQU $
<
IF ORDI-"S",XWOR%1,,XWOR%1
LBI NSPDKA
CPI "A"
JL RSTDKI < DK2 OU DK3
JE $+2 < B=NSPDKA
ADRI -1,B < B=NSPDKB
LR B,A
ADRI +'30-NSPDK1+1,A
RSTDKI: EQU $
XWOR%1: VAL 0
ADRI -'30+NSPDK1-1,A
SWBR A,B
LBY DMASDK+1
SLLD 8
STA DMASDK+1 < PREPARATION ASSIGNATION
JMP RSTDK6
RSTDK5: EQU $ < PAS DE CHANGEMENT DEMANDE, ON
LA MDKI+1 < VA FAIRE COMME SI !
ANDI 'FF < A=PSEUDO-REPONSE
JMP RSTDK0 < LE TOUR EST JOUE
< NOTA: EN SUPPOSANT QUE L'ON VEUILLE
< RESTAURER DU DKA OU DU DKB EN T1600,
< UN CHANGEMENT DE NSP VA ETRE
< AUTOMATIQUEMENT DEMANDE, FABULEUX !
RSTDK6: EQU $
IF ORDI-"S",XWOR%1,,XWOR%1
<
< AFFICHAGE DU QUANTA DE DUMP ET DU QUANTA DE RESTAURATION.
< EN CAS DE RESTAURATION AVEC CHANGEMENTS ET SUR DK2, ALORS
< ON PROPOSE DE CHANGER DE QUANTA.
<
LA QUANDP < QUANTA DE DUMP
ADRI '30,A
LX AOQDKD
STBY &AXTRAV
LAI MQDKD-M < AFFICHAGE DU QUANTA DE DUMP...
BSR AENVOI
<
LA QUANRS < QUANTA DE RESTAURATION
ADRI '30,A
LX AOQDKR
STBY &AXTRAV
LAI MQDKR-M < AFFICHAGE DU QUANTA DE RESTAURATION
BSR AENVOI < UTILISE A PRIORI.
<
LA DMASDK+1 < S'AGIT-IL D'UNE RESTAURATION
ANDI '00FF < SUR DK2 ?
CPI NSPDK1
JE RSTDKX < DK1 : ON PEUT CHANGER LE QUANTA...
CPI NSPDK2
JNE RSTDKP
RSTDKX: EQU $
CPZ ICHN < OUI, CHANGEMENTS DEMANDES ?
JE RSTDKP
RSTDKQ: EQU $ < ON VA PROPOSER UN CHANGEMENT DE
< QUANTA...
LX AOQDKR
LAI 0
STBY &AXTRAV < RAZ QUANTA RESTAURATION D'EDITION
LAI MQDKR-M
BSR AQREP < CHOIX DU QUANTA: QUESTION REPONSE.
CPI QUANTA='FA00('00FF < QUANTA NORMAL DEMANDE?
JE RSTDKT < DONC QUANTA 3.
CPI "1" < QUANTA 1 ?
JNE RSTDKQ < REPONSE NON RECONNUE
LAI 1 < FIXER QUANTA = 1
STA QUANRS < QUANTA RESTAURATION
SLLS 8
STA DMWDK+2 < TAILLE BUFFER
LA DMWDK
SBT 12
STA DMWDK < BIT 12 DE LA DEMANDE
JMP RSTDKP
RSTDKT: EQU $ < FIXER QUANTA 3 ( CAR ON PEUT
< TRES BIEN AVOIR 1 EN SUPPOSANT
< QU'ON AIT EU UN DUMP DK2 QUANTA 1
< ET QUE L'ON DOIVE RESTAURER EN
< DK2 QUANTA 3)
LAI 3
STA QUANRS < QUANTA RESTAURATION
LRM A
WORD QUANTA*128*2
STA DMWDK+2 < TAILLE BUFFER
LA DMWDK
RBT 12
STA DMWDK < RAZ BIT 12 DE LA DEMANDE.
XWOR%1: VAL 0
RSTDKP: EQU $
<
< AFFICHAGE DE L'ADRESSE SECTEUR AU DUMP ET DE L'ADRESSE
< SECTEUR A LA RESTAURATION, AVEC CHANGEMENT EVENTUEL).
<
LA DMWDK+3 < ADRESSE SECTEUR AU DUMP
LY DMRAS+1 < ADRESSE OCTET RANGEMENT DE L'ASCI
BSR ACONVA < POU LE S/P CONVA
LAI MASF-MAS*2 < POUR L'AFFICHAGE DE
STA DMWAS+2 < L'ADRESSE SECTEUR AU DUMP
LA MNSD
STA MASDR
LAD DMWAS < WRITE ADRESSE SECTEUR DUMP
SVC 0
<
LA MNSR
STA MASDR
CPZ ICHN < CHANGEMENT DEMANDE ?
JE RSTDKU < NON...AFFICHER LA MEME.
LAI MASAS-MAS*2 < LONGUEUR.
STA DMWAS+2
LAD DMWAS < PROPOSITION ADRESSE SECTEUR RESTAURATION.
SVC 0
LAD DMRAS < READ ADRESSE SECTEUR DEMANDEE
SVC 0
WORD '1E35 < BOX --> B
LR B,A
CPI 1 < REPONSE SUR 1 CARACTERE: DONC
JE RSTDK7 < C'EST RETURN OU EOT
LA DMRAS+1 < ADRESSE OCTET AS EN ASCI
BSR ACONVH < CONVERSION EN HEXA DANS A
JNE RSTDKP < B#0 : ADRESSE INCORRECTE
STA DMWDK+3 < STOCKAGE AS DANS LA DEMANDE DK
JMP RSTDK7
RSTDKU: EQU $ < PAS DE CHANGEMENT, AFFICHER L'ADRESSE
LAD DMWAS < SECTEUR RESTAURATION QUI
SVC 0 < EST LA MEME QU'AU DUMP.
<
< AFFICHAGE DU NOMBRE DE SECTEURS AU DUMP
<
RSTDK7: EQU $
LA NBSECD < NOMBRE DE SECTEURS DUMP
LY DMWNS+1
ADRI 4,Y < ADRESSE OCTET STOCKAGE NBSECD EN ASCI
BSR ACONVA
LA MNSD < POU AFFICHAGE NB SECT AU DUMP
STA MNSDR+1
LAD DMWNS < AFFICHAGE NB SECT AU DUMP
SVC 0
<
< CALCUL ET AFFICHAGE DU NB DE SECTEURS A LA RESTAURATION
<
LA NBSECD < A PRIORI, ON A :
STA NBSECR < NBSECR = NBSECA
STZ NBREST < PAS DE SECTEURS RESTANT A PRIORI
LA QUANDP < QUANTA AU DUMP
CP QUANRS < QUANTA A LA RESTAURATION
JE RSTDK8 < IDENTIQUES
<
< QUANTA DUMP # QUANTA RESTAURATION
<
CPI 1 < QUANTA DUMP
JE RSTDK9
CPI 3 < QUANTA DUMP
JE RSTDKA
ACTD < QUANTA INCORRECT
<
RSTDK9: EQU $ < QUANDP=1 ET QUANRS=3
LB NBSECD
LAI 0
DV QUANRS
JNV $+2
ACTD
STA NBSECR < NOMBRE DE SECTEURS DE QUANTA 3
< A RESTAURER
STA NBSECD < POUR AFFICHAGE : ON AJOUTERA 1 SI
< NBREST EST # 0
STB NBREST < NOMBRE DE SECTEURS DE 128 MOTS RESTANT
JMP RSTDK8 < VERS AFFICHAGE
<
RSTDKA: EQU $ < QUANDP=3 ET QUANRS=1
LA NBSECD < NOMBRE DE SECTEURS AU DUMP
MP QUANDP < NB DE SECTEURS DE 128 MOTS
STB NBSECR < A RESTAURER
STB NBSECD < POUR AFFICHAGE
JAE RSTDK8 < VALIDATION...
LAI MTRS-M < TROP DE SECTEURS
BSR AENVOI < ON PREVIENT
ACTD < ET ON TRAPPE
<
RSTDK8: EQU $
LA MNSR
STA MNSDR+1 < MESSAGE A AFFICHER
CPZ NBREST < SECTEURS RESTANT ?
JE $+2
IC NBSECD < +1 A AFFICHER
LA NBSECD < NOMBRE A AFFICHER
LY DMWNS+1
ADRI 4,Y < ADRESSE OCTET RANGEMENT POUR S/P CONVA
BSR ACONVA
LAD DMWNS < AFFICHAGE NB SECTEURS RESTAURATION
SVC 0
<
< AVANT D'ALLER PLUS LOIN, ON DEMANDE A L'UTILISATEUR S'IL EST
< BIEN D'ACCORD...CELA VAUT MIEUX
<
RSTDKJ: EQU $
LAI MOK-M
BSR AQREP < ENVOI QUESTION ' OK? ' ET DEMANDE
< REPONSE.
CPI "O" < OUI ?
JE RSTDKK < ALLONS-Y DONC...
CPI "N" < NON ?
JNE RSTDKJ < REPONSE NON-RECONNUE
IC IDKO < INHIBITION OPERATIONS DK
LAI MINHD-M < ON SIGNALE QUE LA RESTAURATION DK
< EST INHIBEE
JMP RSTDKL
RSTDKK: EQU $
LAI MACTD-M < ON SIGNALE QUE LA RESTAURATION DK
< EST ACTIVE
RSTDKL: EQU $
BSR AENVOI < ENVOI MESSAGE
<
< DECONNEXION UL 3 ET CONNEXION UL3<-->DKI
<
LAI "3" < DESASSIGNATION DE L'UL 3 ...
BSR ADESAS < ...AU CAS OU...
LB DMASDK+1
LBY DMASDK+1
STZ DMASDK+1
STBY DMASDK+1
LAD DMASDK
SVC 0 < DECONNEXION DISQUE
STB DMASDK+1
IF ORDI-"S",XWOR%1,,XWOR%1
LA DMASDK+1
ANDI 'FF
CPI NSPDK1 < EST-CE DK1 (DKU) ?
JNE RSTDKW
< C'EST DK1, ON VA UTILISER L'ASSIGNATION IMPLICITE.
LAI '8A
STBY DMWDK
JMP RSTDKN
RSTDKW: EQU $
LAD DMASDK < ASSIGNATION DK.
XWOR%1: VAL 0
SVC 0 < CONNEXION DISQUE
JE RSTDKN < OK
LAI MCONEX-M < MESSAGE CONNEXION IMPOSSIBLE
CPZ IDKO < INUTILE DE L'ENVOYER SI LA RESTAU
JNE RSTDKN < RATION DK EST DEJA INHIBEE
BSR AENVOI < ON PREVIENT...
IC IDKO < ET ON INHIBE LA RESTAURATION DK
RSTDKN: EQU $
<
< AJUSTEMENT MEMOIRE
<
LA DMWDK+2 < NOMBRE D'OCTETS BUFFER DK
BSR AGESTM < IL NOUS LES FAUT
<
< BOUCLE DE WRITE DE N SECTEURS SUR DKI
< ON DOIT RESTAURER 'NBSECR' SECTEURS + 1 SECTEUR
< SI 'NBREST'#0
<
RSTDKF: EQU $ < BOUCLE DE RESTAURATION DK
CPZ NBSECR < NOMBRE DE SECTEURS RESTANT A
< RESTAURER
JE RSTDKB
RSTDKE: EQU $
LA DMWDK+1 < ADRESSE BUFFER DK
LX DMWDK+2 < LONGUEUR OCTET
BSR ARN < READ N OCTETS EN PAGE VIRTUELLE
JMP RSTDKC < VERS WRITE D'UN SECTEUR DK
RSTDKB: EQU $ < ON DOIT ENCORE RESTAURER
< 'NBREST' * 128 OCTETS
LA NBREST
JAE RSTDKD < C'EST FINI
STZ NBREST < CE SERA BIENTOT FINI...
SLLS 8 < NOMBRE D'OCTETS
STA DMWDK+2 < COMPTE D'OCTETS DE LA DEMANDE DK
IC NBSECR < POUR SE RAMENER AU CAS PRECEDENT
JMP RSTDKF < ON EST RAMENE AU CAS PRECEDENT
RSTDKC: EQU $ < WRITE 1 SECTEUR
LAD DMWDK < DEMANDE DE WRITE DK
WORD 1 < POUR '1E16 EVENTUEL
CPZ IDKO < RESTAURATION DK ACTIVE ?
JNE RSTDKM < NON
SVC 0
JE $+2
ACTD
RSTDKM: EQU $
IC DMWDK+3 < ADRESSE SECTEUR SUIVANT
DC NBSECR < -1 SUR NOMBRE DE SECTEURS RESTANT
JMP RSTDKF
RSTDKD: EQU $
BSR AR1 < READ DELIMITEUR 'FD
CPI 'FD < QUI SIGNIFIE 'FIN DUMP DISQUE'
JE $+2
ACTD
LBY DMASDK+1
STZ DMASDK+1
STBY DMASDK+1
LAD DMASDK < DECONNEXION DK
SVC 0
<
PLR X,Y < RESTAURATIONS
RSR
PAGE
RSTDA: EQU $
<
< R E S T A U R A T I O N D E L A D A T E D U D U M P
<
< CELLE-CI EST EMISE SUR L'ORGANE DE SORTIE
< A TITRE D'INFORMATION.
<
PSR A,X < SAUVEGARDES
LA AODATE < ADRESSE OCTET DATE A EDITER.
LXI 6 < ANNEE,MOIS,JOUR,HEURE,MIN,SEC.
RSTDA1: EQU $
PSR X
LXI 2 < DEUX CHIFFRES PAR RUBRIQUE.
BSR ARN < READ CES 2 CHIFFRES EN PAGE VIRTUELLE.
ADRI 3,A < NOUVELLE ADRESSE D'EDITION.
PLR X
JDX RSTDA1
<
LAI MDATE-M < EDITION DE LA DATE DU DUMP.
BSR AENVOI
<
PLR A,X < RESTAURATIONS.
RSR
PAGE
RSTAC: EQU $
<
< R E S T A U R A T I O N D E L ' A C N D U D U M P
<
< SI CET ACN EST DIFFERENT DE L'ACN DE L'UTILISATEUR
< EFFECTUANT LA RESTAURATION, ON LE SIGNALE ET ON
< LUI DEMANDE DE DECIDER S'IL VEUT EFFECTUER OU NON
< LA RESTAURATION, QUI SE FERA SOUS SON ACN.
<
PSR A,B,X < SAUVEGARDES.
IF ORDI-"S",XWOR%1,,XWOR%1
CPZ IRECH < TEST MODE RECHERCHE.
JE RSTAC5
IC IACN < MODE RECHERCHE: SIGNALER "ACN RENCONTRE"
STZ IEGACN < A PRIORI ACN COURANT=ACN RENCONTRE.
RSTAC5: EQU $
XWOR%1: VAL 0
LA AOACND < ADRESSE OCTET ACN U DUMP.
LXI 4 < 4 CARACTERES.
BSR ARN < LECTURE DE L'ACN EN PAGE VIRTUELLE.
LAD DMAFAC < AFFICHAGE DE L'ACN DE DUMP.
SVC 0
WORD '1E25 < 'A' ET 'B' RECOIVENT L'ACN COURANT.
CP ACND
JNE RSTAC1 < DIFFERENTS.
LR B,A
CP ACND+1
JE RSTAC2 < EGAUX.
RSTAC1: EQU $
IF ORDI-"S",XWOR%1,,XWOR%1
CPZ IRECH < TEST MODE RECHERCHE.
JE RSTAC6
WORD '1E25 < ON SAIT QUE ACN DIFFERENTS, IL
< FAUT VOIR DANS QUEL SENS.
CP ACND
JG RSTAC7 < COURANT > RENCONTRE.
JL RSTAC8 < COURANT < RENCONTRE.
LR B,A
CP ACND+1
JG RSTAC7 < COURANT > RENCONTRE.
RSTAC8: EQU $ < ACN COURANT < ACN RENCONTRE.
DC IEGACN < C'EST NOTE.
JMP RSTAC9
RSTAC7: EQU $ < ACN COURANT > ACN RENCONTRE.
IC IEGACN < C'EST NOTE.
RSTAC9: EQU $
JMP RSTAC2
RSTAC6: EQU $
BSR ATSTAC < TEST ACN DE LOGON INITIAL.
JNE RSTAC3 < # :SYS, FAUDRA-IL CONTINUER A RESTAURER?
CPZ ICHACN < CHANGEMENT D'ACN'S MANUEL ?
JNE RSTACA < OUI.
< ICI, LE CHANGEMENT D'ACN EST FAIT AUTOMATIQUEMENT.
LA ACND < ACN COURANT DEVIENT ACN DE DUMP.
STA ACNC
LA ACND+1
STA ACNC+1
LAI '04
STBY ACNC+2
LAD DMLGN < LOGON SOUS NOUVEL ACN.
SVC 0
RSTACA: EQU $
LAI MACNC-M < AFFICHAGE ACN COURANT...
BSR AENVOI
LAD DMOUTA
SVC 0
CPZ ICHACN
JE RSTAC2 < SI LE CHANGEMENT D'ACN EST AUTOMATIQUE,
< ON SE SERA CONTENTE D'AFFICHER LE NOUVEL
< ACN COURANT.
RSTAC4: EQU $
LAI MQACN-M < ... ET PROPOSER UN ACN DE RESTAURATION.
BSR AENVOI
LAD DMACN
SVC 0
LAD DMLGN < LOGON SOUS CET ACN...
SVC 0
JNE RSTAC4
JMP RSTAC2 < ET VOILA.
RSTAC3: EQU $
XWOR%1: VAL 0
LAI MACN-M < PROPOSITION
BSR AQREP < ET DEMANDE REPONSE.
CPI "O"
JE RSTAC2 < ON CONTINUE LA RESTAURATION.
CPI "N"
JNE RSTAC1 < REPONSE NON RECONNUE.
LAD DMCCI < ON NE RESTAURE PAS, RETOUR CCI.
SVC 0
JMP RSTAC1
RSTAC2: EQU $ < ON CONTINUE.
PLR A,B,X < RESTAURATIONS.
RSR
PAGE
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 DMLGN < RELOGON SOUS ACN COURANT.
SVC 0 < ET ICI, PEU IMPORTE LE CODE RETOUR.
CPZR B < POUR TEST EN RETOUR.
<
PLR A,B,X
RSR
COMP: EQU $
<
< C O M P A R A I S O N N O M C O U R A N T - N O M
<
< R E C H E R C H E.
<
< CE S/P COMPARE LE NOM COURANT (QUI EST CELUI DE L'ITEM OU DU
< FICHIER EN COURS DE RESTAURATION) AVEC LE NOM RECHERCHE; CECI
< LORS D'UNE RESTAURATION EN MODE RECHERCHE ('IRECH'#0).
<
< SI L'ON N'EST PAS EN MODE RECHERCHE, ALORS CE S/P RENVOIE TOUJOURS
< LE RESULTAT 'EGALITE'. (... CE S/P EST APPELE EN EFFET SYSTEMATIQUE-
< MENT...)
<
< SI L'ON EST EN MODE RECHERCHE, IL RENVOIE 'EGALITE' OU 'INEGALITE' :
< - EGALITE : DANS CE CAS 'IFINR' (INDICATEUR DE FIN
< DE RECHERCHE) EST POSITIONNE, CE QUI PROVOQUERA PAR
< LA SUITE LA PROPOSITION D'UNE NOUVELLE RECHERCHE.
< - INEGALITE : DANS CE CAS, SUIVANT QUE NOM COURANT EST
< SUPEIEUR OU INFERIEUR AU NOM RECHERCHE, LES BORNES
< DE RECHERCHE DICHOTOMIQUE ('DICHO1' ET 'DICHO2') SONT
< MODIFIEES POUR LA SUITE DE LA RECHERCHE.
<
< ARGUMENTS:
< - 'NOM' : NOM COURANT.
< - 'LGN' : LONGUEUR NOM COURANT.
< - 'NOMR' : NOM RECHERCHE.
< - 'LGNR' : LONGUEUR NOM RECHERCHE.
< - 'LGN' ET 'LGNR' SONT DES LONGUEURS DE NOMS <EOT>
< INCLUS.
< - 'IACN' : INDICATEUR "ACN RENCONTRE"
< - 'IEGACN':INDICATEUR "EGALITE/INEGALITE" ENTRE ACN
< COURANT ET ACN RENCONTRE :
< = 0 : ACN COURANT = ACN RENCONTRE
< < 0 : ACN COURANT < ACN RENCONTRE
< > 0 : ACN COURANT > ACN RENCONTRE.
<
<
< RESULTATS:
< - AU RETOUR, FAIRE :
< JE EGAUX OU
< JNE DIFFERENTS
< - SI MODE = RECHERCHE, 'DICHO1' ET 'DICHO2' ONT ETE
< RECALCULES (EN CAS D'INEGALITE SEULEMENT).
<
PSR A,B,X,Y < SAUVEGARDES.
<
LYI 1 < INEGALITE A PRIORI.
CPZ IRECH < TEST MODE RECHERCHE.
JE COMPE1 < ON N'EST PAS EN MODE RECHERCHE, DONC
< ON REPOND SYSTEMATIQUEMENT 'EGALITE'.
CPZ IACN < TEST ACN RENCONTRE?
JNE COMP6
LAI MPACN-M < ON PREVIENT QUE "ACN COURANT SUPPOSE".
BSR AENVOI
STZ IEGACN < ET ON SUPPOSE ACN COURANT = ACN
< RENCONTRE.
COMP6: EQU $
CPZ IEGACN < TEST ACN COURANT :: ACN RENCONTRE.
JL COMP4 < PLUS PETIT.
JG COMP3 < PLUS GRAND.
< SI EGALITE, ALORS IL FAUT BIEN COMPARER LES NOMS.
<
< FAIRE LA COMPARAISON.
<
LA LGNR < LONGUEUR NOM RECHERCHE.
CP LGN < COMPARAISON AVEC LONGUEUR NOM COURANT.
JLE COMP1
LA LGN
COMP1: EQU $
LR A,X < ON VA FAIRE LA COMPARAISON SUR UNE
< LONGUEUR = MIN (LGN , LGNR).
LBI 0 < INDEX COURANT.
COMP2: EQU $
PSR X < SAUVEGARDE COUNT.
LR B,X < INDEX COURANT.
LBY &AXNOM < CARACTERE DE 'NOM COURANT'.
CPBY &AXNOMR < TEST :: CARACTERE DE 'NOM RECHERCHE'.
PLR X < RESTAURATION COUNT.
JL COMP3 < PLUS PETIT.
JG COMP4 < PLUS GRAND.
ADRI 1,B < INDEX COURANT.
JDX COMP2
<
< EGALITE DES DEUX NOMS SUR LE MIN DES LONGUEURS.
<
<
LA LGN
CP LGNR
JE COMPE < ET LONGUEURS EGALES: DONC EGALITE.
JG COMP4 < ET 'LGN' > 'LGNR' DONC NOM COURANT
< EST SUPERIEUR A NOM RECHERCHE.
COMP3: EQU $
<
< NOM COURANT < NOM RECHERCHE : DONC IL FAUDRA RECHERCHER PLUS HAUT.
<
LA DICHOM
STA DICHO1 < DEPLACEMENT BORNE INFERIEURE.
JMP COMP5
COMP4: EQU $
<
< NOM COURANT > NOM RECHERCHE : DONC IL FAUDRA RECHERCHER PLUS BAS.
<
LA DICHOM
STA DICHO2 < DEPLACEMENT BORNE SUPERIEURE.
JMP COMP5
COMPE: EQU $
<
< EGALITE : RENVOYER INDICATEUR 'IFINR' (FIN DE RECHERCHE) POSITIONNE.
<
IC IFINR
COMPE1: EQU $ < MODE NON-RECHERCHE.
LYI 0 < EGALITE.
COMP5: EQU $
CPZR Y < POUR TEST AU RETOUR.
PLR A,B,X,Y < RESTAURATIONS.
RSR
PAGE
RVAS: EQU $
<
< R E A D E T V A L I D A T I O N A D R E S S E S E C T E U R
<
< D K U ( R E S T D K U ).
<
< ARGUMENT:
< - 'A'=ARGUMENT D'APPEL DU S/P 'ENVOI' POUR LA DEMANDE
< DE L'ADRESSE SECTEUR A L'UTILISATEUR.
<
< RESULTAT:
< - 'A'=ADRESSE SECTEUR VALIDEE.
<
PSR B,X < SAUVEGARDES.
<
LR A,B < MESSAGE ARGUMENT POUR S/P 'ENVOI'.
RVAS1: EQU $
LR B,A < ARGUMENT D'APPEL DU S/P 'ENVOI'.
BSR AENVOI < ENVOI DEMANDE.
LAD DMRAS < READ ADRESSE SECTEUR.
SVC 0
LA DMRAS+1 < ADRESSE OCTET ADRESSE SECTEUR SERVIE.
BSR ACONVH < CONVERSION HEXA.
JNE RVAS1 < ADRESSE INCORRECTE.
<
BSR AVALID < ADRESSE CORRECTE, IL FAUT ENCORE
< LA VALIDER PAR RAPPORT AUX BORNES
< DEFINISSANT L'ESPACE DKU ACCESSIBLE.
JNE RVAS1 < ADRESSE INVALIDE, ON RECOMMENCE...
<
PLR B,X < RESTAURATIONS.
RSR
PAGE
VALID: EQU $
<
< V A L I D A T I N A D R E S S E S E C T E U R P A R
<
< R A P P O R T A U X B O R N E S ' A D K U 1 ' E T
<
< ' A D K U 2 ' D E F I N I S S A N T L ' E S P A C E D K U
<
< A C E S S I B L E.
<
<
< ARGUMENT:
< - 'A' = ADRESSE SECTEUR.
<
< RESULTAT:
< - AU RETOUR, FAIRE :
< JE OK OU
< JNE ERREUR
<
PSR A,B,Y < SAUVEGARDES.
<
LBI 0 < OK A PRIORI.
LR A,Y < SAUVEGARDE ADRESSE SECTEUR.
<
< TESTS PAR RAPPORT A 'ADKU1' (DEBUT ESPACE ACCESSIBLE).
<
EOR ADKU1
JAGE VALID2
< DE SIGNES DIFFERENTS: AS DOIT DONC ETRE < 0.
CPZR Y
JL VALID3
JMP VALIDR < ERREUR.
VALID2: EQU $
< DE MEME SIGNE: AS DOIT ETRE >= 'ADKU1'.
LR Y,A
CP ADKU1
JL VALIDR < ERREUR.
VALID3: EQU $
<
< TESTS PAR RAPPORT A 'ADKU2' (FIN ESPACE ACCESSIBLE).
<
LR Y,A
EOR ADKU2
JAGE VALID4
< DE SIGNES DIFFERENTS: AS DOIT DONC ETRE >= 0.
CPZR Y
JGE VALID5
JMP VALIDR
VALID4: EQU $
< DE MEME SIGNE: AS DOIT DONC ETRE <= 'ADKU2'.
LR Y,A
CP ADKU2
JLE VALID5
<
VALIDR: EQU $ < ERREUR.
LBI 1
VALID5: EQU $
CPZR B < POUR TEST AU RETOUR.
<
PLR A,B,Y < RESTAURATIONS.
RSR
XWOR%1: VAL 0
PAGE
R1: EQU $
<
< R E A D 1 C A R A C T E R E E N P A G E V I R T U E L L E
<
< CE S/P ASSURE LE DECOMPACTAGE, ET RENVOIE LE
< CARACTERE LU DANS LE REGISTRE 'A' (BITS 8-15)
<
PSR X,Y
CPZ IPRR1 < PREMIER APPEL?
JNE R11
< OUI,
IC IPRR1 < BASCULEMENT
LAI -1
STA CCMP < INIT COMPT DE COMPACTAGE
< BIT 0=1 SIGNIFIE EPUISE
<
< INIT SPECIFIQUES AUX
< DIFFERENTS SUPPORTS UTILISES
CPZ TYPRST < TYPE DE RESTAURATION ?
JL R10C < CARTES
IF ORDI-"T",XWOR%1,,XWOR%1
JG R10F < FICHIER
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
STZ N0BDKU < INIT. NUMERO DU BLOC A LIRE
LA TYPRST
CPI 1
JE R10F < FICHIER
XWOR%1: VAL 0
JMP R10
<
R10C: EQU $ < INITIALISATIONS SPECIFIQUES CARTES
STZ NUMC < NUMERO CARTE EN COURS
STZ NBM11 < INDEX MODULO 11
STZ IRCARD < READ CARTE ACTIF A PRIORI
LA ACHECK
STA PBC < POINTEUR BUFF CARTES (PROVOQUERA
< APPEL A READ CARD)
JMP R10
<
R10F: EQU $ < INITIALISATIONS SPECIFIQUES FICHIER
LAD DMOPNX < OPEN NEXT
SVC 0
JE R10
ACTD
R10: EQU $
BSR ARPAGE < READ 1ERE PAGE
<
<
<
R11: EQU $ < N EME APPEL
LB CCMP < COMPTEUR COMPACTAGE
LY PPG < POINTEUR DE PAGE
<
TBT 16+0 < CONT INVALIDE?
JNC R101
< OUI,REINIT CCMP
BSR ALDC < LOAD COUNT
LR A,B
<
R101: EQU $
TBT 16+8 < COUNT DE CAR REPETITIFS?
JNC R102
< OUI,ON RESTE SUR LE CAR
< ACTERE EN COURS
LR Y,X
LBY &AXTRAV < CAR EN COURS
JMP R103
<
R102: EQU $ < COUNT DE CAR NON-REPETITIFS
BSR ALDC < LOAD CARACTERE SUIVANT
<
R103: EQU $ < MAJ COUNT DE COMPACTAGE
ADRI -1,B
XR A,B
PSR A
ANDI '7F
CPI '7F < EPUISE?
PLR A
JNE R1F
< OUI,FAUT-IL AVANCER D'1 CAR
< IL LE FAUT SI LE COUNT EN
< COURS ETAIT UN COUNT DE CAR
< REPETITIFS
TBT 0
JC R1F
< C'ETAIT UN REPETITIF
PSR A
BSR ALDC < POUR PASSER AU COUNT SUIVANT
PLR A
SBT 0 < SET CCMP EPUISE
<
R1F: EQU $
XR A,B
STB CCMP < CCMP MIS A JOUR
STY PPG < PPG MIS A JOUR
<
PLR X,Y
RSR
<
PAGE
LDC: EQU $
<
< L O A D 1 O C T E T D E P A G E V I R T U E L L E
<
< D A N S 'A' (BITS 8-15)
<
< CE S/P EST APPELE PAR LE S/P 'R1' ET IL LIT BRUTALEMENT
< UN OCTET QUI PEUT ETRE UN COUNT OU UN CARACTERE.
<
LR Y,X
LBY &AXTRAV
ADRI 1,Y
LX AOFPAG
CPR X,Y < ON DEPASSE?
JL LDCF
< OUI, LIRE PAGE SUIVANTE
BSR ARPAGE
LY PPG < REINIT Y POUR R1
LDCF: EQU $
RSR
<
PAGE
RN: EQU $
<
< R E A D 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
<
< ARGUMENTS:
< 'A' = ADRESSE OCTET ZONE DE STOCKAGE DES
< CARACTERES LUS
< 'X' = NOMBRE DE CARACTERES A LIRE
<
< NOTA:
< CE S/P UTILISE LE S/P 'R1'(READ 1 CARACT)
<
XR A,X
RBT IVALEX < A PRIORI...
XR A,X
PSR A,X,Y
CPZR X < LONGUEUR NULLE?
JNE $+2
ACTD < OUI,PROBLEME!
LR A,Y
RN1: EQU $ < BOUCLR DE READ 1 CAR
PSR X < SVG COUNT
BSR AR1 < READ 1 CAR
LR Y,X
STBY &AXTRAV < STOCKAGE CAR
ADRI 1,Y
PLR X
JDX RN1 < BOUCLE
<
PLR A,X,Y
RSR
PAGE
RPAGE: EQU $
<
< R E A D U N E P A G E V I R T U E L L E
<
< S U R U N S U P P O R T E X T E R N E Q U E L C O N Q U E :
<
PSR A,B,X
LA AOPAG
STA PPG < INIT POINTEUR PAGE
<
CPZ TYPRST < TYPE RESTAUR?
JL RPGC < CARTES
JG RPGH < FICHIER
RPGV: EQU $ < LIGNE VISU
<
PSR B,Y < SAUVEGARDES
LA AOPAG
SLRS 1
LR A,Y < Y=POINTEUR MOT SUR PAGE VIRTUELLE
<
XWOR%1: VAL LPAV*2*2 < NOMBRE DE 'DIGITS' DANS LA PAGE VIRTUELLE
XWOR%2: VAL LBV*2 < NOMBRE D'OCTETS DANS LE BUFFER VISU
LXI XWOR%1/XWOR%2 < INIT COMPTEUR DE BOUCLE SUR N ECHANGES
< VISU POUR REMPLIR LA PAGE VIRTUELLE
<
RPGV1: EQU $ < BOUCLE SUR LECTURE ET CONVERSION
< D'UN BUFFER VISU EN PAGE VIRTUELLE
PSR X
STY PPG < ON SAUVE LE POINTEUR DE PAGE
< POUR LE CAS D'UNE "REPRISE"
LAD DMLVI < LECTURE SUR VISU EMETTRICE
SVC 0
LA AOBV
STA PBV < POINTEUR OCTET BUFFER VISU
LXI LBV*2/4 < INIT BOUCLE SUR CONVERSION
< ASCI-->BINAIRE DE BV--->PAGE
RPGV2: EQU $
PSR X
LXI 4 < ON TRAITE 4 OCTETS BV POUR OBTENIR
< 1 MOT PAGE VIRTUELLE
<
RPGV3: EQU $
PSR X
LX PBV < POINTEUR 'BV'
LBY &AXTRAV < 1 CARACTERE ASCI
RBT 8 < RAZ BIT DE PARITE
< VALIDATION DU CARACTERE ASCI
CPI "0"
JL RPGV4 < ERREUR
CPI "F"
JG RPGV4 < ERREUR
CPI "9"
JLE RPGV5 < OK
CPI "A"
JGE RPGV5 < OK
RPGV4: EQU $ < CARACTERE ASCI INCORRECT:
IF DIALOG,XWOR%1,XWOR%1,
CPI '7D < Y A-T-IL EU UN TIME OUT ?
JNE RPGV6 < NON, DONC ERREUR ASCI...
< OUI, DONC IL FAUT ENVOYER A LA VISU
< EMETTRICE LE CARACTERE DE RESYNCHRO-
< SATION ET ALLER RELIRE LE DERNIER BUFFER.
LAD DMTMPO < TEMPORISATION DE 1 SECONDE...
SVC 0
LAD DMWSYN < WRITE CARACTERE DE RESYNCHRONISATION.
SVC 0
PLR X,Y < PLR "BIDON" POUR QUE LA PILE SOIT INTEGRE
PLR X < RECUPERATION DE L'INDEX DE BOUCLE.
LY PPG < REPOSITIONNEMENT DU POINTEUR DE PAGE
< POUR ETRE PROPRE.
JMP RPGV1 < ON PEUT MAINTENANT ALLER RELIRE LE
< DERNIER BUFFER.
RPGV6: EQU $
XWOR%1: VAL 0
IF DIALOG,,,XWOR%1
CPI SYNC < CRACTERE DE "RESYNCHRONISATION" ?
JNE RPGV8
< IL FAUT DONC RECOMMENCER LA LECTURE DU
< DERNIER BUFFER ...
PLR X,Y < PLR "BIDON" POUR QUE LA PILE
< SOIT INTEGRE!
PLR X < RECUPERATION DU COUNT DE BOUCLE
LY PPG < RECUPERATION DU POINTEUR DE PAGE
JMP RPGV1 < ET ON REPART !
RPGV8: EQU $ < "VRAIE" ERREUR !
XWOR%1: VAL 0
LAI MASCI-M < ON PREVIENT...
BSR AENVOI
ACTD < ...ET ON TRAPPE
RPGV5: EQU $
CPI '39
JLE $+2
ADRI -7,A
ADRI -'30,A
SLLS 12 < STOCKAGE D'UN DIGIT...
SCLD 4 < ... DANS B
IC PBV < CARACTERE SUIVANT
PLR X
JDX RPGV3 < BOUCLE SUR CONVERSION 4 OCTETS
<
LR Y,X < POINTEUR MOT PAGE
STB &AXTRAV < STOCKAGE MOT
ADRI 1,Y < MOT SUIVANT
PLR X
JDX RPGV2 < BOUCLE SUR CONVERSION-STOCKAGEF
< D'UN BUFFER VISU
<
IF DIALOG,XWOR%1,XWOR%1,
LAD DMTMPO < TEMPORISATION DE 1 SECONDE AVANT
SVC 0 < L'ENVOI D'UN 'ACK'
LAD DMWACK < ENVOI 'ACK'
SVC 0
XWOR%1: VAL 0
IF DIALOG,,,XWOR%1
LXI 4
LAI MTMPO-M < ON TEMPORISE UN PEU...
BSR AENVOI
JDX $-1
LAD DMWACK < ON ENVOIE UN 'ACK' POUR DIRE
SVC 0 < QU'ON EST PRET POUR LE BUFFER
< SUIVANT.
XWOR%1: VAL 0
PLR X
JDX RPGV1 < BOUCLE SUR N BUFFERS VISU
< LA PAGE VIRTUELLE EST PLEINE
PLR B,Y < RESTAURATIONS
IF ORDI-"T",XWOR%1,,XWOR%1
JMP RPGF < FIN
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
JMP RPGFXX < FIN.
XWOR%1: VAL 0
RPGC: EQU $ < LECTEUR DE CARTES
BSR AR1C < LIRE 1 CARACT SUR CARTE
LX PPG
STBY &AXTRAV < STORE CAR EN PAGE
IC PPG < +1 SUR POINT PAGE
LA PPG
CP AOFPAG < ON DEPASSE?
JL RPGC < NON,CONTINUER,C'EST BIEN
IF ORDI-"T",XWOR%1,,XWOR%1
JMP RPGF < NON,FIN
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
RPGFXX: JMP RPGF < NON, FIN.
XWOR%1: VAL 0
<
RPGH: EQU $ < FICHIER
IF ORDI-"S",XWOR%1,,XWOR%1
LA TYPRST < PEUT-ETRE DKU?
CPI 2
JE RPGD < DKU
CPI 3
JE RPGM < CDA.
XWOR%1: VAL 0
LAD DMRBLF < READ BLOC
SVC 0
JE RPGF
ACTD
IF ORDI-"S",XWOR%1,,XWOR%1
JMP RPGF
RPGD: EQU $ < DKU.
LXI NBTRY < NOMBRE DE TENTATIVES DE LECTURE.
RPGD2: EQU $
PSR X
BSR AKOMP < LECTURE DKU ET DECODAGE EVENTUEL...
PLR X
LA &ADPAG0 < PREMIER MOT DU BLOC.
JNE RPGD1 < CODE RETOUR DU READ NON OK.
CPI -1 < DUMP INCOMPLET ?
JE RPGD8
CPI -2 < BLOC INVALIDE ?
JNE RPGD5 < BLOC VALIDE.
<
< CAS D'UN BLOC INVALIDE PAR DUMP OU PRESUME TEL.
<
RPGD3: EQU $
IC N0BDKU < COMPTAGE.
IC DMRDKU+3 < ADRESSE BLOC SUIVANT.
JMP RPGD < LECTURE BLOC SUIVANT.
RPGD1: EQU $
JDX RPGD2 < NOUVELLES TENTATIVES.
<
< TOUTES LES TENTATIVES ON ECHOUE.
<
CPI -2
JE RPGD3 < BLOC PRESUME AVOIR ETE INVALIDE
< PAR DUMP.
CPI -1
JE RPGD8 < DUMP PRESUME ETRE INCOMPLET.
LAD DMRAZ < ERASE ECRAN VISU.
SVC 0
<
LA DMRDKU+3 < ADRESSE BLOC.
LRM Y
WORD MDEF-ZERO*2+1 < ADRESSE OCTET EDITION ADRESSE BLOC.
BSR ACONVA < CONVERSION ASCI, EDITION.
LAI MDEF-M
BSR AENVOI < ENVOI MESSAGE.
<
BSR ADFPR < DELETE DU FICHIER EN COURS DE
< RESTAURATION, S'IL EXISTE (CF: COMMENTS
< DE CE SOUS-PROGRAMME).
CPZ STDKU
JNE RPGD4
WORD '1E16 < EN MODE CONTINU, PROBLEME...
JMP $-1
<
RPGD4: EQU $
<
< BLOC ILLISIBLE EN MODE MULTIPLE. CHERCHONS LE PREMIER BLOC
< DU DUMP SUIVANT.
<
IC DMRDKU+3 < ADRESSE BLOC.
LXI NBTRY < NOMBRE DE TENTATIVES MAXIMUM.
RPGD6: EQU $
PSR X
BSR AKOMP < LECTURE DKU ET DECODAGE EVENTUEL...
PLR X
JE RPGD7 < LECTURE REUSSIE.
JDX RPGD6
JMP RPGD4 < AU SUIVANT, C'EST RISQUE MAIS TANT PIS.
RPGD7: EQU $
LA &ADPAG0
CPI -1
JE RPGDA < DUMP INCOMPLET...
JANE RPGD4 < BLOC SUIVANT.
<
< ICI, ON EST SUR UN BLOC DE DEBUT DE DUMP. IL RESTE A RESTAURER
< LE CONTEXTE PERMETTANT DE RELANCER LA RESTAURATION MULTIPLE
< A PARTIR DU SECTEUR COURANT, SACHANT QU'ON A PERDU UN DUMP.
< POUR RELANCER, IL SUFFIT DE REENTRER DANS REST AU POINT D'ENTREE
< 'ENTRY2'.
<
IC NERDKU < COMPTABLISATION NOMBRE DE DUMPS PERDUS.
<
BR AENTR2 < VERS 'ENTRY2' DE 'REST'.
RPGD5: EQU $
<
< BLOC LU AVEC SUCCES ET VALIDE.
<
IC DMRDKU+3 < ADRESSE BLOC SUIVANT.
LA N0BDKU
IC N0BDKU < COMPTAGE.
CP &ADPAG0
JE RPGF < BLOC BIEN NUMEROTE.
<
< LE BLOC POSSEDE UNE NUMEROTATION INATTENDUE... C'EST QU'IL
< DOIT FALLOIR REVENIR EN DEBUT DE CHAINE.
<
LA IRETAR < INDICATEUR 'RETOUR ARRIERE AUTORISE'
IC IRETAR < NON AUTORISE DESORMAIS.
JANE RPGD9
LAI MRETAR-M < ON SIGNALE A L'UTILISATEUR QU'ON
BSR AENVOI < FAIT UN RETOUR ARRIERE.
STZ N0BDKU
LA DMRDKU+3 < ON REVIENT
SB &ADPAG0 < EN DEBUT DE CHAINE.
ADRI -1,A
STA DMRDKU+3
< ON VIENT DE FAIRE UN RETOUR ARRIERE. IL FAUT DONC ICI, SI L'ON
< EST EN MODE RECHERCHE, S'ASSURER QUE L'ARESSE SECTEUR OBTENUE
< N'EST PAS EN-DECA DE L'ADRESSE DE DEBUT DE LA ZONE DE RECHERCHE
< DICHOTOMIQUE RENTREE PAR L'UTILISATEUR ('DEBDIC').
CPZ IRECH < TEST MODE RECHERCHE.
JE RPGDC
EOR DEBDIC
JAGE RPGDB
< ADRESSE SECTEUR COURANTE ET 'DEBDIC' DE SIGNES DIFFERENTS.
CPZ DEBDIC < IL FAUT DONC QUE 'DEBDIC' SOIT >= 0.
JGE RPGDC
JMP RPGDD
RPGDB: EQU $
< ADRESSE SECTEUR COURANTE ET 'DEBDIC' DE MEME SIGNE.
LA DMRDKU+3 < ADRESSE SECTEUR COURANTE.
CP DEBDIC < DOIT ETRE >= 'DEBDIC'.
JGE RPGDC
< ICI, L'ADRESSE SECTEUR COURANTE EST EN-DECA DE 'DEBDIC'...
RPGDD: EQU $
LAI MSSARA-M < ON PREVIENT...
BSR AENVOI
BR ARTCCI < ... ET FIN DE TRAVAIL.
RPGDC: EQU $
JMP RPGD
RPGD9: EQU $
<
< ON N'ACCEPTE QU'UNE SEULE FOIS LE RETOUR ARRIERE (EN DEBUT DE CHAINE)
< AU SECOND RETOUR ARRIERE, ON PREVIENT L'UTILISATEUR QU'IL Y A ERREUR
< DE CHAINAGE, ET ON ARRETE LE TRAVAIL.
<
LAI MERC-M
BSR AENVOI
BR ARTCCI < FIN DE TRAVAIL.
<
< CAS D'UN DUMP INCOMPLET OU PRESUME TEL.
<
RPGD8: EQU $
BSR ADFPR < DELETE EVENTUEL FICHIER PARTIELLEMENT
< RESTAURE (VOIR COMMENTAIRES DE CE S/P).
LAD DMRAZ < ERASE ECRAN VISU.
SVC 0
RPGDA: EQU $ < ICI, S/P 'DFPR' ET ERASE ONT ETE DEJA
< FAITS.
LAI MERDMI-M < MESSAGE "DUMP INCOMPLET".
BSR AENVOI
WORD '1E16 < RIEN D'AUTRE A FAIRE...
JMP $-1
RPGM: EQU $ < MEMOIRE COMMUNE (CDA).
<
< L'ALGORITHME D'ACQUISITION D'UNE PAGE EN CDA EST LE SUIVANT :
< - TEST VERROU COURANT 'NVC'.
< - S'IL EST A 1, IL APPARTIENT A DUMP, DONC ATTENDRE.
< - S'IL EST A 0, IL APPARTIENT A REST, DONC ON PEUT FAIRE UN RCDA
< APRES QUOI ON LE FAIT PASSER A 1, ON INCREMENTE 'NVC' ETC...
<
BSR ATESTV < TEST VERROU COURANT 'NVC'.
JE RPGM1 < VERROU = 0 : ALLONS-Y...
< VERROU = 1 : ATTENDRE...
LAD DMTMP2 < ON ATTEND DEUX SECONDES.
SVC 0
JMP RPGM < VERS NOUVELLE TENTATIVE.
RPGM1: EQU $
< VERROU = 0 : ON PEUT FAIRE LE RCDA.
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.
RCDA
< DEVERROUILLER POUR DUMP.
BSR ASETV
< INCREMENTER NUMERO DE VERROU COURANT 'NVC' MODULO 'NBV'.
IC NVC
LA NVC
CP NBV
JL $+2
STZ NVC
JMP RPGF < C'EST FINI.
XWOR%1: VAL 0
<
RPGF: EQU $ < FIN,REINIT PPG ET RETOUR
LA AOPAG
STA PPG
<
PLR A,B,X
RSR
PAGE
IF ORDI-"S",XWOR%1,,XWOR%1
<
<
< D E C O D A G E D K U :
<
<
KOMP: EQU $
LAD DMRDKU
SVC 0 < LECTURE DE LA PAGE...
<
< NOTA : S'IL Y A ERREUR,
< ON DECODE MALGRE TOUT,
< AU CAS OU IL Y AURAIT
< -2 DANS LE MOT0 :
<
PSR X
CPZ ICLEF < Y-A-T'IL DECODAGE ???
JE KOMP2 < NON...
<
< OUI, DECODAGE :
<
PSR Y
LA DMRDKU+1
SLRS 1
SBT 0
STA ABUF < GENERATION D'UN RELAI D'ACCES A LA PAGE
< VIRTUELLE COURANTE...
LX DMRDKU+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 Y < OUI...
KOMP2: EQU $
PLR X
CPZR X
KOMP9: EQU $
RSR
PAGE
EDN: EQU $
<
< E D I T I O N D U N O M E N C O U R S S U R
<
< L ' U N I T E D E S O R T I E
<
< NOTA:
< LE NOM EST RECUPERE DANS LA ZONE
< 'NOM+VALEUR' (VAL)
<
PSR A,X
LXI 0
EDN1: EQU $
LBY &AXVAL
CP CARALT < EST-CE LA CARACTERE D'ARRET (RAPPELONS
< QUE L'ABSENCE DE CE TEST EST REPRESENTE
< PAR (CARALT)=0) ???
JNE EDN3 < NON...
LRM A < OUI :
WORD RFINF
PSR A
RSR < ON SIMULE UN ALT-MODE RECU...
EDN3: EQU $
CPI '04 < EOT?
JE EDN2
< NON,STOCKER CAR
STBY &AXNOM
STBY &AXASS2
ADRI 1,X
JMP EDN1
EDN2: EQU $
STBY &AXASS2 < IL FAUT L'EOT
IF ORDI-"S",XWOR%1,,XWOR%1
STBY &AXNOM < ET LA AUSSI EN CAS DE 'RECHERCHE'.
XWOR%1: VAL 0
ADRI 1,X
STX LGN < LONGUEUR NOM FICH/ITEM EN COURS
STX DMOUT+2 < LONG ('6D DE DEBUT INCLUS)
LA AXNOM
SLLS 1
ADRI -1,A
STA DMOUT+1
LAD DMOUT
SVC 0
PLR A,X
RSR
PAGE
R1C: EQU $
<
< R E A D 1 C A R A C T E R E S U R C A R T E
<
< CE SOUS-PROGRAMME PREND 8 BITS A CHAQUE
< APPEL, QU'IL REND DANS 'A' (BITS 8-15),
< SACHANT QU'UNE CARTE CONTIENT 11 BITS UTILES
< PAR COLONNE.
< POUR RECONSTITUER UN CARACTERE QUI PEUT
< ETRE "A CHEVAL" SUR DEUX COLONNES OU MEME
< SUR DEUX CARTES, IL UTILISE LES TABLES
< 'MSK1', 'SHF1', 'SHF2' ET LES BITS PLACES
< DANS 'SUI'.
< LORSQUE LE S/P A BESOIN DE LIRE LA CARTE
< SUIVANTE, IL APPELLE LE S/P 'RCARD'.
<
LA PBC < POINTEUR BUFFER CARTE
CP ACHECK < ON DEPASSE?
JL R1C1
BSR ARCARD < OUI, LIRE UNE CARTE
R1C1: EQU $
LX PBC
LA &AXTRAV < MOT EN COURS BUFFER CARTE
LR A,Y
LX NBM11 < INDEX MODULO 11 EN COURS
LBY &AXSHF1 < SHIFT1
LR A,X
LR Y,A
SCLS 0,X
LR A,Y < Y=MOT.SHIFT1
LX NBM11 < INDEX
LBY &AXMSK1 < MASQUE 1
ANDR A,Y < Y=MOT.SHIFT1.MASK1
LA SUI < INDICATEUR DE PASSAGE AU MOT
< SUIVANT DU BUFFER CARTE
TBT 0,X < PASSER AU MOT SUIVANT?
JNC R1C3
< OUI,
IC PBC < POINTEUR BUFFER CARTE='+1
LA PBC
CP ACHECK < ON DEPASSE?
JL R1C3
BSR ARCARD < OUI, LIRE UNE CARTE
R1C3: EQU $
LX PBC
LB &AXTRAV < MOT BUFFER CARTE
LX NBM11 < INDEX EN COURS MODULO 11
LBY &AXSHF2 < SHIFT2
LR A,X
LR B,A
SCLS 0,X
LR A,B < B=MOT.SHIFT2
LX NBM11
LBY &AXMSK1 < MASK1...
CMR A,A < ...INVERSE...
ANDI '00FF < ...ET NETTOYE
ANDR A,B < B=MOT.SHIFT2.MASK1-INVERSE
ORR Y,B < B=OCTET COMPLET
<
IC NBM11 < INDEX MODULO 11 = '+1
LA NBM11
CPI 11 < ON DEPASSE?
JL R1C2
< OUI,
STZ NBM11 < RAZ NBM11
IC PBC < MOT SUIVANT BUFFER CARTE
R1C2: EQU $
LR B,A
RSR < RETOUR, A(8-15)=OCTET LU
PAGE
RCARD: EQU $
<
< R E A D C A R D
<
< CE SOUS-PROGRAMME LIT UNE CARTE, ET
< ASSURE LES CONTROLES DE "CHECK" ET DE
< SEQUENCE, AINSI QU'UNE REPRISE EVENTUELLE
< DE LA LECTURE SI UNE CARTE EST ERRONEE.
< IL ASSURE LES INITIALISATIONS ET REINITIALISATIONS
< NECESSAIRES ET LA GESTION DE FIN DE DECK.
<
PSR A,Y
LR K,A < ON SAUVE LE K ACTUEL AU
STA SAVK < IL Y AURAIT UNE RELECTURE SUITE
< A ERREUR DE CHECKSUM OU DE
< NUMEROTATION
RCD0: EQU $ < POINT D'ENTREE DE RELECTURE
LAD DMRDC < READ CARTE
CPZ IRCARD < SSI LECTURE ACTIVE
JNE $+2
SVC 0
LA &ABC < 1ER MOT BUFFER
ANDI 'F0 < NETTOYAGE
CPI '70 < FIN PHYSIQUE?
JNE RCD1
< OUI,
IC IRCARD < INHIBITION LECTURE PHYSIQUE
JMP RCDFIN
<
RCD1: EQU $
<
< CONTROLE DU CHECK
<
LA &ACHECK
ANDI 'FFE0 < CHECK NETTOYE
LR A,Y
LXI NBCOL < INIT COUNT
LAI 0
STA &ACHECK < RAZ CHECK
RCD2: EQU $ < BOUCLE DE RECALCUL CHECK
EOR &AXBCM1
JDX RCD2 < BOUCLE
ANDI 'FFE0 < NETTOYAGE CHECK RECALCULE
CPR A,Y < CHECK CORRECT?
JE RCD3
< NON,PREVENIR ET TRAPPER
LAI MCHECK-M
BSR AENVOI
JMP RCDER < VERS RELECTURE
RCD3: EQU $
<
< CONTROLE DE SEQUENCE
<
IC NUMC < NUMERO CARTE EN COURS
LA NUMC
CP DIXMIL < ON ATTEINT 10000 CARTES?
JL RCD8
LAI 1 < OUI,ON REPART A 1
STA NUMC
RCD8: EQU $
<
< CONVERSION DECIMALE DE NUMC
LXI 0
LB NUMC
RCD4: EQU $ < BOUCLE CONVERSION
LAI 0
DV DIX < DIVISION PAR 10
JNV $+2
ACTD
PSR B < ON EMPILE LE RESTE
ADRI 1,X < COUNT NB CHIFFRES DECIMAUX
JAE RCD5 < QUOTIENT NUL?
< NON, ON CONTINUE
XR A,B
JMP RCD4
RCD5: EQU $
< COMPARAISON DU NB DECIMAL RECALCULE
< AVEC CELUI DU BUFFER CARTE
LA AFBC
NGR X,Y
ADR A,Y < ADRESSE 1ER MOT DE STOCKAGE DE
< LA NUMEROTATION SUR BUFFER CARTE
<
RCD6: EQU $ < BOUCLE COMPAR CHIFFRE PAR CHIFFRE
PLR A < CHIFFRE DECIMAL
PSR X < SVG COUNT
LR A,X
LAI 0
SBT 2,X < SET BIT
LR Y,X
LB &AXTRAV < MOT DU BUFFER
XR A,B
ANDI 'FFF0 < NETTOYAGE
CPR A,B < EGALITE CHIFFRE?
JE RCD7
< NON,PREVENIR ET TRAPPER
LAI MSEQ-M
BSR AENVOI
LA NUMC < NUMERO ATTENDU
CPI 1
JNE $+2
LA DIXMIL
ADRI -1,A
STA NUMC < MISE A JOUR DE 'NUMC'
RCDER: EQU $ < ERREUR DE CHECK OU DE NUMEROTATION
LAI MRELIR-M < MESSAGE DE RELECTURE
BSR AENVOI
LAD DMCCI < RETOUR CCI
SVC 0
LA SAVK < ON RECUPERE 'K' POUR REBOUCLER
LR A,K < SUR LA LECTURE
JMP RCD0 < RELECTURE
RCD7: EQU $
ADRI 1,Y < CHIFFRE SUIVANT
PLR X < RECUP COUNT
JDX RCD6 < AU SUIVANT
<
< CHECK ET NUMEROTATION SONT CORRECTS
< REINITS NECESSAIRES, RESTAURATIONS ET RETOUR
<
RCDFIN: EQU $
LA ABC
STA PBC < POINTEUR BUFFER CARTE
PLR A,Y
RSR
PAGE
RTCCI: EQU $
<
< R E T O U R A U C C I A V E C D E S A S S I G N A T I O N
< D E S U L 3 ET 'B.
<
LAI "3"
BSR ADESAS
LAI "B"
BSR ADESAS
LAD DMCCI
SVC 0
BR AENTR1 < VERS ENTRY1 DE REST.
PAGE
DESAS: EQU $
<
< D E S A S S I G N A T I O N ( !ASSIGN <UL>=S )
<
< ARGUMENT:
< 'A' (BITS 8-15) = UL EN ASCI
<
STBY ASSUL < STORE NUMERO UL
LA ASSS
STA ASS1
LAD DMASS
SVC 0
RSR
PAGE
IF ORDI-"S",XWOR%1,,XWOR%1
DFPR: EQU $
<
< D E L E T E F I C H I E R P A R T I E L L E M E N T
<
< R E S T A U R E.
<
< C'EST UN DELETE EVENTUEL.
< EN EFFET, ON VIENT DE SUBIR UN DEFAUT DKU, ET 3 CAS SONT
< POSSIBLES :
< - SI L'ON RESTAURAIT DE L'ESPACE DISQUE, RIEN A FAIRE, C'EST
< DESESPERE, ET CE QUI EST FAIT EST FAIT...
< - SI L'ON RESTAURAIT UN ITEM, IL N'Y A RIEN A FAIRE NON PLUS, CAR
< UN ITEM N'EST RESTAURE QUE LORSQU'IL EST COMPLET, ET DONC ON
< EST SUR D'ETRE PROPRE QUOI QU'IL ARRIVE.
< - SI L'ON RESTAURAIT UN FICHIER, ALORS CETTE RESTAURATION
< PEUT AVOIR ETE PARTIELLE. ELLE L'AURA ETE SI L'INDICATEUR
< 'IRESTF' EST A 1. DANS CE CAS IL FAUT:
< 1- FAIRE UN !ASSIGN 3=R
< 2- FAIRE UN 'DLN' SUR LE NOM DU FICHIER.
<
< L'INDICATEUR EN QUESTION N'EST POSITIONNE QU'A
< BON ESCIENT, ON NE RISQUE PAS DE DETRUIRE UN FICHIER
< QUI N'AURAIT PAS A L'ETRE (CAS D'UN FICHIER A RESTAURER
< N'AYANT PU ETRE ASSIGNE : DANS CE CAS 'IRESTF' VAUT BIEN 0)
<
< LE DELETE EVENTUEL D'UN FICHIER PARTIELLEMENT RESTAURE
< EST FAIT QUE L'ON SOIT EN RESTAURATION DKU MULTIPLE OU CONTINUE.
< MAIS DANS CE DERNIER CAS ON NE TENTERA PAS DE RELANCER LE DUMP
< ENSUITE.
<
PSR A,B
CPZ IRESTF < FICHIER EN COURS DE RESTAURATION?
JE DFPR1 < RIEN A FAIRE.
<
< 'ASS2' CONTIENT DEJA LE NOM DU FICHIER
< A DETRUIRE.
LAI "3" < 'A' = UNITE LOGIQUE.
BSR AARDLN < ASSIGN RELEASE ET DLN.
STZ IRESTF < C'EST FINI.
<
IC NBDELF < COMPTABILISATION FICHIERS DELETES,
< CE COMPTEUR N'EST EXPLOITE QU'EN CAS
< DE RESTAURATION MULTIPLE.
DFPR1: EQU $
PLR A,B
RSR
PAGE
ARDLN: EQU $
<
< A S S I G N R E L E A S E E T D L N
<
< ARGUMENTS:
< 'A' (BITS 8-15) = UNITE LOGIQUE EN ASCI.
< 'ASS2' CONTIENT LE NOM DU FICHIER A DELETER.
< RESULTAT:
< OK OU 'ACTD' SI CELA SE PASSE MAL.
<
PSR X
BSR ADESAS < DESASSIGNATION UNITE LOGIQUE.
LA ASSD
STA ASS1
LAD DMASS < !ASSIGN X=D-NOM FICHIER
SVC 0
JE $+2
ACTD
PLR X
RSR
XWOR%1: VAL 0
PAGE
ULB: EQU $
<
< C H O I X E T A S S I G N A T I O N D E L ' U L ' B
<
< ( S U P P O R T A P A R T I R D U Q U E L D O I T
<
< S E F A I R E L A R E S T A U R A T I O N )
<
<
< IL S'AGIT DE DEMANDER A L'UTILISATEUR A PARTIR DE QUEL
< SUPPORT EXTERNE IL VEUT FAIRE LA RESTAURATION; LE SACHANT
< ON TENTE D'ASSIGNER ET SI CE N'EST PAS POSSIBLE, ON LE DIT ET ON BOU
< ET ON BOUCLE
< DANS CE SP ON FIXE LA TAILLE DE
< PAGE VIRTUELLE QUI EST FONCTION DU SUPPORT CHOISI ET
< ON POSITIONNE TYPRST
<
< NOTA: DE LA TAILLE DE PAGE CHOISIE DEPENDRONT
< LES ADRESSES D'IMPLANTATION DE
< LT (LOGUEUR TOTALE) ET VALEUR (NOM+VALEUR);
< ON AURA:
<
< PAGE
< FIN PAGE
< ZONE DE TRAVAIL LNOM+1 MOTS (POUR FAIRE
< LES CHANGEMENTS DE NOMS)
< LT 1 MOT LONGUEUR (EN RECOUVREMENT
< ON A BUFF BUFFER FICHIER OUTPUT)
< VALEUR N MOTS NOM+VALEUR
<
IF ORDI-"S",XWWOR%,,XWOR%
STZ STDKU < EN CONTINU A PRIORI...
STZ IRECH < MODE RECHERCHE = NON A PRIORI.
STZ NERDKU < RAZ NOMBRE D'ERREURS IRRECUPERABLES DKU.
< (RESTAURATION MULTIPLE DKU).
STZ IRETAR < RAZ INDICATEUR 'RETOUR ARRIERE AUTORISE'
< (POUR RESTAURATION DKU).
STZ IEXEC < MODE # 'EXECUTE' A PRIORI.
XWOR%: VAL 0
LAI "B"
BSR ADESAS < DESASSIGNATION UL 'B
STZ TYPRST < TYPE RESTAUR = 0 A PRIORI
< TAILLE PAGE VIRTUELLE
< A PRIORI
LA AOPAG0
STA AOPAG
AD LPC
STA AOFPAG
<
LAI MREST-M < PROPOSITION SUPPORT
BSR AQREP < ENVOI QUESTION, DEMANDE REPONSE
<
< ANALYSE REPONSE
<
CPI "C" < CARTES?
JE ULBC
IF ORDI-"S",XWOR%1,,XWOR%1
CPI "1" < CR1 ?
JE ULBC
CPI "2" < CR2 ?
JE ULBC2
XWOR%1: VAL 0
CPI "F" < FICHIER?
JE ULBF
IF ORDI-"S",XWOR%1,,XWOR%1
CPI "X" < EXECUTE?
JE ULBX
XWOR%1: VAL 0
CPI "V" < VISU?
JE ULBV
IF ORDI-"S",XWOR%1,,XWOR%1
CPI "D" < DKU?
JE ULBD
CPI "M"
JE AULBM < MEMOIRE COMMUNE.
CPI "T"
JE ULBT < MT1...
XWOR%1: VAL 0
JMP ULB < REPONSE NON RECONNUE
<
ULBC: EQU $ < SUPPORT CARTES
IF ORDI-"S",XWOR%1,,XWOR%1
LAI "1" < ASSIGNER CR1.
ULBC2: EQU $
STBY ASS5+1 < POUR ASSIGNER CR1 OU CR2.
XWOR%1: VAL 0
DC TYPRST < TYPE RESTAUR=CARTES
LA ASS5
STA ASS1
LA ASS5+1
STA ASS1+1
LAD DMBHTP < DISCRIMINATION BATCH/TP
SVC 0
ADRI -3,X < 3=FONCTION INACCESSIBLE
CPZR X
JE AULBAS < C'EST 'FONCTION INACCESSIBLE',
< DONC NOUS SOMMES EN TP
LA ASS7 < ICI, NOUS SOMMES EN BATCH, DONC
STA ASS1 < IL FAUT ASSIGNER "I" ET NON "CR1"
JMP AULBAS < VERS ASSIGNATION
<
ULBV: EQU $ < LIGNE VISU, ON A DEJE TYPRST=0
IF LPAC-LPAV,,XWOR%1,
LA AOPAG0
AD LPV
STA AOFPAG < FIXATION TAILLE PAGE VIRTUELLE
XWOR%1: VAL 0
LA ASS6 < PREPARATION ASSIGNATION
STA ASS1
LA ASS61
STA ASS1+1
LAI MQV-M < PROPOSITION: QUELLE VISU?
BSR AQREP < QUESTION, REPONSE. AU RETOUR
< LA REPONSE EST DANS 'A'.
STBY ASS1+1 < STOCKAGE POUR ASSIGNATION
JMP AULBAS < VERS ASSIGNATION
<
IF ORDI-"S",XWOR%1,,XWOR%1
ULBX: EQU $ < 'EXECUTE' DEMANDE.
IC IEXEC < SET INDICATEUR 'EXECUTE'.
JMP ULBF < ON FAIT MAINTENANT COMME POUR FICHIER.
XWOR%1: VAL 0
<
ULBF: EQU $ < SUPPORT FICHIER
IC TYPRST < TYPE RESTAUR.=FICHIER
< FIXATION PAGE VIRT
LA AOPAG2
STA AOPAG
AD LPF
STA AOFPAG
LAI MFICH-M < DEMANDE NOM FICHIER
BSR AENVOI
LAD DMREPF
SVC 0
< CE NOM EST LU EN ASS2,
< POUR PREPARER ASSIGNATION
LA ASS3
STA ASS1
IF ORDI-"S",XWOR%1,,XWOR%1
AULBAS: JMP ULBAS
ULBT: EQU $ < MT1.
XWOR%1: VAL '0B
LAI XWOR%1='FA00('00FF
STBY ASSUL
LA ASST
LB ASST+1
STA ASS1
STB ASS1+1
LAD DMASS
SVC 0 < TENTATIVE DE !ASSIGN B=MT1.
JNE ULBNOK < IMPOSSIBLE !!!
LRM A
BYTE XWOR%1;'08 < POUR LIRE SUR MT1...
JMP ULBDT
AULBM: JMP ULBM < RELAI...
ULBD: EQU $ < DKU
LRM A
WORD '8A00 < POUR LIRE SUR DKU...
ULBDT: EQU $
STA DMRDKU < POUR LIRE SUR MT1 OU DKU...
LAI 2 < TYPRST=2
STA TYPRST
LA AOPAG2 <FIXATION DE LA PAGE VIRTUELLE
STA AOPAG
AD LPD
STA AOFPAG
<
< DEFINITION DU SYSTEME DE DECODAGE :
<
STZ ICLEF < PAS DE DECODAGE A PRIORI...
LAI MCLEF1-M
BSR AENVOI
LAD DMCLEF
SVC 0 < ENTREE DE LA CLEF DE DECODAGE :
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 DECODAGE !!!
CPI 10
JL CLEF2 < C'EST UN CHIFFRE DECIMAL...
ADRI -"A"+"9"+1,A
CPI 10
JL CLEF9 < ERREUR ==> PAS DE DECODAGE...
CPI 16
JGE CLEF9 < ERREUR ==> PAS DE DECODAGE...
CLEF2: EQU $
XR A,X
STBY &ACLEFB < SAUVEGARDE DE LA CLEF EN BINAIRE...
TBT 16,X < EXISTE-T'ELLE DEJA ???
SBT 16,X
XR A,X
JC CLEF9 < OUI ==> PAS DE DECODAGE...
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 $
ULBDX: EQU $
LAI MSTDKU-M
BSR AQREP < ENVOI INTERROGATION...
CPI "N"
JE ULBDY < MODE NORMAL : STDKU=0...
CPI "O"
JNE ULBDX < ???
IC STDKU < MODE MULTIPLE : STDKU=1...
STZ NBDELF < RAZ NOMBRE DE FICHIERS PERDUS
< (POUR RESTAURATION DKU MULTIPLE).
ULBDY: EQU $
ULBD1: EQU $
LAI MASD-M < DEMANDE ADRESSE 1ER BLOC
BSR ARVAS < READ ET VALIDATION ADRESSE SECTEUR
< DKU.
STA DMRDKU+3
CPZ STDKU < RESTAURATION DKU MULTIPLE?
JE ULBD5
<
< RESTAURATION DKU MULTIPLE : ON VA PROPOSER LE MODE 'RECHERCHE'.
<
STA DEBDIC < BORNE INFERIEURE DE RECHERCHE
< DICHOTOMIQUE POUR LE MODE RECHERCHE
< EVENTUEL.
ULBD2: EQU $
LAI MRECH-M < PROPOSITION RECHERCHE.
BSR AQREP < ENVOI QUESTION ET DEMANDE REPONSE.
CPI "N"
JE ULBD5 < NON.
CPI "O"
JNE ULBD2 < REPONSE NON RECONNUE.
IC IRECH < POSITIONNEMENT INDICATEUR MODE
< 'RECHERCHE'.
STZ IFINR < POSITIONNEMENT DE ...
IC IFINR < ... L'INDICATEUR 'FIN DE RECHERCHE'
< POUR PROVOQUER PAR LA SUITE L'INITIALI-
< SATION D'UN RECHERCHE.
LAI -1
STA DICHM1 < INITIALISATION 'DICHOM' PRECEDENT
< (CF RECHERCHE INFRUCTUEUSE).
ULBD4: EQU $
<
< MODE RECHERCHE DEMANDE, IL NOUS FAUT L'ADRESSE SECTEUR FIN DE ZONE
< DKU POUR DEFINIR LA ZONE DE RECHERCHE.
<
LAI MASFIN-M < DEMANDE ADRESSE SECTEUR DE FIN.
BSR ARVAS < READ ET VALIDATION ADRESSE SECTEUR DKU.
STA FINDIC < BORNE DE FIN DE ZONE POUR LA RECHERCHE
< DICHOTOMIQUE.
EOR DEBDIC < POUR VALIDATION 'FINDIC' PAR RAPPORT
< A 'DEBDIC'.
JAGE ULBD3
< 'DEBDIC' ET 'FINDIC' DE SIGNES DIFFERENTS.
CPZ DEBDIC < DONC 'DEBDIC' DOIT >= 0.
JL ULBD4 < INACCEPTABLE.
JMP ULBD5 < OK.
< 'DEBDIC' ET 'FINDIC' DE MEME SIGNE.
ULBD3: EQU $
LA DEBDIC
CP FINDIC < DONC IL FAUT 'DEBDIC' <= 'FINDIC'.
JG ULBD4 < INACCEPTABLE
ULBD5: EQU $
JMP ULBOK < PAS D'ASSIGNATION EXLICITE DE DKU...
ULBM: EQU $ < MEMOIRE COMMUNE (CDA).
LAI 3
STA TYPRST < TYPRST=3.
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 $ < TENTATIVE D'ASSIGNATION
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 ULB1
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.
ULB1: EQU $
XWOR%1: VAL 0
LAD DMASS
SVC 0
IF ORDI-"S",XWOR%1,,XWOR%1
PSR X < SAVE CODE RETOUR.
LAD DMLGN < 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
< ASIGNATION NON OK, ON LE
< DIT ET ON BOUCLE
ULBNOK: EQU $
LAI MIMP-M
BSR AENVOI
IF ORDI-"T",XWOR%1,,XWOR%1
JMP ULB
XWOR%1: VAL 0
IF ORDI-"S",XWOR%1,,XWOR%1
BR AULB
XWOR%1: VAL 0
ULBOK: EQU $
<
< SI ON FAIT UNE RESTAURATION FICHIER, ON PROPOSE
< LA SAUVEGARDE DU FICHIER DE RESTAURATION
< C E QUI PERMET DE LE DELETER OU NON AU FIR ET A MESURE
< DE SON EXPLOITATION
<
< DE PLUS, ON DEMANDE DE PRECISER SON QUANTA (EN
< SOLAR SEULEMENT)
<
CPZ TYPRST < TYPE RESTAURATION ?
JE ULBOK4 < VISU.
JL ULBOK2 < CARTES.
IF ORDI-"S",XWOR%1,,XWOR%1
LA TYPRST
CPI 1
JNE ULBOK1 < DKU OU MEMOIRE COMMUNE.
XWOR%1: VAL 0
< RESTAURATION FICHIER:
ULBF2: EQU $ < POUR UN FICHIER, ON DEMANDE S'IL Y A
< LIEU DE FAIRE UNE RECHERCHE, ET S'IL
< FAUT LE SAUVEGARDER...
ULBF6: EQU $
LAI MRECH-M < PROPOSITION RECHERCHE.
BSR AQREP < ENVOI QUESTION ET DEMANDE REPONSE.
CPI "N"
JE ULBF5 < NON.
CPI "O"
JNE ULBF6 < REPONSE NON RECONNUE.
IC IRECH < POSITIONNEMENT INDICATEUR MODE
< 'RECHERCHE'.
STZ IFINR < POSITIONNEMENT DE ...
IC IFINR < ... L'INDICATEUR 'FIN DE RECHERCHE'
< POUR PROVOQUER PAR LA SUITE L'INITIALI-
< SATION D'UN RECHERCHE.
ULBF5: EQU $
ULBF9: EQU $ < FAUT-IL SAUVEGARDER LE FICHIER ???
LBI 8 < FONCTION READ BLOC
LAI MSAUV-M < PROPOSITION SAUVEGARDE
BSR AQREP < QUESTION, REPONSE.
CPI "O" < SAUVEGARDER?
JE ULBF1
CPI "N" < NE PAS SAUVEGARDER?
JNE ULBF9 < REPONSE NON RECONNUE
<
< NOTA : LORSQU'ON REPOND "N" A "SAUVEGARDE?",
< LA QUESTION EST REPOSEE UNE DEUXIEME FOIS
< PAR MESURE DE SECURITE...
<
LAI MSAUV-M
BSR AQREP < ON REDEMANDE...
CPI "O"
JE ULBF1 < SAUVEGARDE...
CPI "N"
JNE ULBF9 < ??!?!
<
< PAS DE SAUVEGARDE :
<
ADRI 1,B < POUR AVOIR READ-DELETE
PSR B < PUISQUE C'EST READ-DELETE,ON STOCKE
LAD ASS2 < LE NOM DU FICHIER DE RESTAURATION
LB ANOMFS < POUR SUPPRIMER CE FICHIER EN FIN
LXI LNOM+1 < DE TRAVAIL
MOVE < STOCKAGE
PLR B
ULBF1: EQU $
LAI '0B < UL
SWBR A,A
ORR A,B
STB DMRBLF < UL,FONCTION(8 OU 9)
IF ORDI-"S",XWOR%1,,XWOR%1
ULBF3: EQU $
LAI MQFR-M < QUANTA DU FICHIER DE RESTAURATION?
BSR AQREP < QUESTION, REPONSE. AU RETOUR LA
< REPONSE EST DANS 'A'.
XWORK1: VAL QUANTA='FA00('00FF
CPI XWORK1 < Q (FICH REST) = Q A PRIORI ?
JE ULBF4 < OUI, RIEN D'AUTRE A FAIRE
CPI "1" < QUANTA 1 SPECIFIE ?
JNE ULBF3 < REPONSE NON RECONNUE
LRM A,B
WORD 128-1*2 < TAILLE PAGE VIRTUELLE
WORD 128*2 < TAILLE BUFFER DEMANDE SGF
STB DMRBLF+2 < DEMANDE SGF
AD AOPAG2 < ADRESSE DE FIN DE PAGE VIRTUELLE
STA AOFPAG < NOUVELLE ADRESSE FIN DE PAGE
ULBF4: EQU $
XWOR%1: VAL 0
JMP ULBOK1
ULBOK4: EQU $
IF DIALOG,XWOR%1,XWOR%1,
<
< SI ON FAIT UNE RESTAURATION A PARTIR D'UN LIGNE VISU, ON SPECIFIE
< UN TIME-OUT SUR LA VISU EMETTRICE.
<
LRM A
WORD '8B02 < SUR UL 'B, TIME-OUT DE 2.
WORD '1EA5
XWOR%1: VAL 0
ULBOK2: EQU $
IF ORDI-"S",XWOR%1,,XWOR%1
<
< SI ON FAIT UNE RESTAURATION CARTES OU VISU,
< ON DEMANDE SI C'EST A PARTIR D'UN T1600 OU D'UN SOLAR
< POUR FIXER LA TAILLE D'UN BUFFER FICHIER A RETAURER
<
LAI MTOUS-M < ENVOI DEMANDE
BSR AQREP < QUESTION, REPONSE.
CPI "S"
JE ULBOK3 < LA TAILLE EST DEJA CORRECTEMENT
< INITIALISEE
CPI "T" < T1600 ?
JNE ULBOK2
LRM A < TAILLE DES BUFFERS FICHIERS
WORD 128*2 < A RESTAURER
STA DMWBLC+2 < LONGUEUR BUFFER DE LA DEMANDE SGF
ULBOK3: EQU $
XWOR%1: VAL 0
<
ULBOK1: EQU $
<
< LA TAILLE DE PAGE VIRTUELLE ETANT FIXEE ON POSITIONNE
< LES ADRESSES D'IMPLANTATION DE LT,BUFF,VALEUR
<
LA AOFPAG < ADR OCT FIN PAGE VIRTUELLE
ADRI LNOM+1*2+2,A
STA AOVAL < NOM+VALEUR
STA DMSTN+1 < POUR STORE NAME,=AOVAL
< POUR L'INSTANT MAIS PEUT
< EVOLUER AVEC LES CHAN-
< GEMENTS DE NOMS
SLRS 1
SBT 0
STA AXVAL < RELAI INDEXE MOT NOM+VALEUR
RBT 0
ADRI -1,A < MOT PRECEDENT
STA ALT < RELAI MOT LONG TOTALE
SLLS 1
STA AOBUFF < BUFFER FICHIER OUTPUT
STA DMWDK+1 < BUFFER DK OUTPUT
RSR
PAGE
PRCH: EQU $
<
< P R O P O S I T I O N D E C H A N G E M E N T S
<
< ON DEMANDE A L'UTILISATEUR S'IL VEUT FAIRE
< DES CHANGEMENTS (LES FRANCAIS AIMENT LE
< CHANGEMENT).
< CE SERONT DES CHANGEMENTS :
< - DE NOMS POUR LES FICHIERS ET ITEMS
< (ON POURRA AUSSI CHANGER LES NOMS SUR RACINE).
< - DE NUMEROS ET ADRESSES DISQUES POUR LES DISQUES
< - DE PLUS, EN SOLAR, ON POURRA CHANGER LES ACN'S A
< LA RESTAURATION, SOIT "MANUELLEMENT" ('ICHACN=1)
< SOIT AUTOMATIQUEMENT ('ICHACN'=0).
<
< RESULTAT :
< L'INDICATEUR 'ICHN' RECOIT :
< 0 PAS DE CHANGEMENTS
< 1 CHANGEMENTS EVENTUELS (REST-
< AURATION EN "PAS A PAS").
< L'INDICATEUR 'ICHACN' RECOIT (SI SOLAR ET SI
< ACN DE LOGON INITIAL=:SYS):
< 0 CHANGEMENT AUTOMATIQUE,
< 1 CHANGEMENT MANUEL.
<
STZ ICHN < NON A PRIORI
LAI MCHN-M < PROPOSITION
BSR AQREP < QUESTION, REPONSE.
IF ORDI-"T",XWOR%1,,XWOR%1
CPI '04 < EOT
JE PRCHF
CPI '0D < R/C
JE PRCHF
XWOR%1: VAL 0
CPI "N" < NON
JE PRCHF
CPI "O" < OUI
JNE PRCH < REPONSE NON RECONNUE
IC ICHN < SET INDICATEUR
< PROPOSITION DE CHANGEMENTS "SUR RACINE".
PRCH1: EQU $
LAI MSRAC-M
BSR AQREP
CPI "N"
JE PRCHF < NON.
CPI "O"
JNE PRCH1 < REPONSE INCORRECTE.
< CHANGEMENT SUR RACINE, DEMANDER 'RAC0' ET 'RAC2'.
LAI MRAC0-M < DEMANDE DE RAC0.
BSR AENVOI
LAD DMRAC0
SVC 0
WORD '1E35 < 'B' <-- BOX.
ADRI -1,B < A CAUSE DE L'EOT.
STB LRAC0 < LONGUEUR DE RAC0.
LAI MRAC2-M < DEMANDE DE RAC2.
BSR AENVOI
LAD DMRAC2
SVC 0
WORD '1E35 < 'B' <-- BOX.
ADRI -1,B < A CAUSE DE L'EOT.
STB LRAC2 < LONGUEUR DE RAC2.
LAI -1
STA ICHN < SET INDICATEUR.
PRCHF: EQU $
IF ORDI-"S",XWOR%1,,XWOR%1
BSR ATSTAC < TEST ACN DE LOGON INITIAL.
JNE PRCHF2 < CE N'ETAIT PAS :SYS...
PRCHF1: EQU $
LAI MCHA-M < PROPOSITION.
BSR AQREP
STZ ICHACN < A PRIORI.
CPI "N"
JE PRCHF2
CPI "O"
JNE PRCHF1 < REPONSE NON RECONNUE.
IC ICHACN < CHANGEMENT "MANUEL" DEMANDE.
PRCHF2: EQU $
XWOR%1: VAL 0
RSR
<
PAGE
CHN: EQU $
<
< C H A N G E M E N T E V E N T U E L D E N O M
<
< P O U R L ' I T E M O U L E F I C H I E R E N C O U R S
<
< CHANGEMENT DE NOM POR L'ITEM OU LE FICHIER
< EN COURS, LE TRAITEMENT EST LE MEME DANS CES 2 CAS
<
< EN ENTREE:
< VALEUR: NOM EN COURS
< ASS2: IDEM
< LGN: LONGUEUR NOM EN COURS EOT INCLUS
< ICHN: =1 SI CHANGEMENT EVENTUEL
< =0 SI PAS DE CHANGEMENT A FAIRE
< =-1 SI CHANGEMENT SUR RACINE (RAC2 REMPLACE RAC0).
<
< TRAITEMENT
< SI ICHN=0 RIEN A FAIRE
< SI ICHN=1, ON PROPOSE UN NOUVEAU
< NOM, SI L'UTILISATEUR REPOND EOT OU R/C ON GARDE LE
< NOM EN COURS, S'IL FOURNIT UN NOUVEAU NOM, ON PREND LES
< DISPOSITIONS NECESSAIRES POUR QUE LA RESTAURATION SE
< FASSE NORMALEMENT, QUE L'ON TRAITE UN FICHIER
< OU UN ITEM
< SI ICHN=-1, ON REGARDE SI LE NOM COURANT COMMENCE PAR RAC0,
< AUQUEL CAS ON SUBSTITUE RAC2 A RAC0.
<
CPZ ICHN < CHANGEMENT EVENTUEL?
JE CHNF
JL CHNR < CHANGEMENT SUR RACINE.
< OUI
LAI MNOM-M < PROPOSITION
BSR AENVOI
LAD DMREPF < DEMDE REPONSE DANS ASS2
SVC 0
WORD '1E35 < BOX-->B
CHN4: EQU $
LR B,A
CPI 1
JLE CHN2 < REPONSE DE 1 CAR DONC C'EST EOT OU
< R/C, LE NOM EST A CONSERVER MAIS IL
< FAUT RESTAURER LE 1ER CAR DE ASS2 QUI
< QUI A ETE ECRASE,AINSI QUE
< L'ADRESSE NOM+VALEUR POUR LE
< STORE NAME EVENTUELLEMENT A
< RESTAURER
STB LGN1 < LONG NOUVEAU NOM
SB LGN < DELTA LONGUEUR
LR A,Y
LB DMSTN+2
ADR B,A
STA DMSTN+2 < NOUVELLE LONGUEUR STN
LB AOVAL
SBR Y,B
STB DMSTN+1 < NOUVELLE ADR POUR STN
<
LA AOVAL
AD LGN
LR A,Y
ADRI -1,Y < Y-->ZONE RECEPTRICE
<
LA AXASS2
SLLS 1
AD LGN1
LR A,B
ADRI -1,B < B-->ZONE EMETTRICE
<
LX LGN1 < INIT COUNT
CHN1: EQU $ < BOUCLE MOVE
PSR X < SVG COUNT
LR B,X
LBY &AXTRAV
LR Y,X
STBY &AXTRAV
ADRI -1,B
ADRI -1,Y
PLR X < RECUP COUNT
JDX CHN1
JMP CHNF
CHN2: EQU $ < RESTAURER 1ER CAR DE ASS2
< AINSI QUE L'ADRESSE NOM+VALEUR
< POUR LE STORE NAME QUI EST
< EVENTUELLEMENT A RESTAURER
LXI 0
LBY &AXVAL
STBY &AXASS2
CHN3: EQU $
LA AOVAL
STA DMSTN+1
CHNF: EQU $
RSR
<
< C H A N G E M E N T D E R A C I N E (RAC2 REMPLACE RAC0).
<
CHNR: EQU $
< COMPARER LE DEBUT DU NOM COURANT A RAC0.
LX LRAC0
CPZR X
JE CHNR3 < CAS RAC0 VIDE, EGALITE.
CHNR2: EQU $
PSR X
LB LRAC0
SBR X,B < INDEX COURANT.
LR B,X
LBY &AXASS2 < CARACTERE NOM COURANT.
CPBY &AXRAC0 < COMPARAISON CARACTERE DE RAC0.
PLR X
JNE CHN3 < INEGALITE.
JDX CHNR2
CHNR3: EQU $
< EGALITE, SUBSTITUER RAC2 A RAC0.
< (ON CONSTRUIT LE NOUVEAU NOM DANS 'ASS2')
LX LRAC2
CPZR X
JE CHNR4 < RAC2 VIDE.
CHNR5: EQU $
PSR X
LB LRAC2
SBR X,B < INDEX COURANT.
LR B,X
LBY &AXRAC2
STBY &AXASS2
PLR X
JDX CHNR5
CHNR4: EQU $
< IL NE RESTE PLUS QU'A CONSTRUIRE LA FIN DU NOUVEAU NOM.
LA LGN < LONGUEUR NOM COURANT EOT INCLUS.
SB LRAC0
JAG $+2
ACTD < PARCE QUE L'ON DOIT AVOIR AU MOINS 1
< CARACTERE: L'EOT DE FIN DE NOM.
LR A,X < NB DE CARACTERES CONSTITUANT LA FIN DU
< NOUVEAU NOM.
AD LRAC2
PSR A < LONGUEUR TOTALE NOUVEAU NOM.
STA DMENN+2 < POUR EDITION NOUVEAU NOM.
LA AOVAL
AD LRAC0
LR A,Y < ADRESSE EMETTRICE.
LA AOASS2
AD LRAC2
LR A,B < ADRESSE RECEPTRICE.
CHNR6: EQU $
PSR X
LR Y,X
LBY &AXTRAV
LR B,X
STBY &AXTRAV
ADRI 1,Y
ADRI 1,B
PLR X
JDX CHNR6
< EDITER LE NOUVEAU NOM, C'EST LA MOINDRE DES CHOSES...
LAI MNOM-M
BSR AENVOI
LAD DMENN
SVC 0
<
PLR B < FAUSSE BOX!
JMP CHN4
PAGE
IF ORDI-"S",XWOR%1,,XWOR%1
EXEC: EQU $
<
< P R O G R A M M E ' E X E C ' :
<
< IL EST CHARGE DE :
<
< - DESASSIGNER L'UL 3 (EN LAISSANT L'UL B ASSIGNEE
< DE FACON QUE LE FICHIER DE RESTAURATION RESTE INACESS-
< IBLE...
< - PREPARER L'EXECUTION DU 'RUNNER'.
< - IMPLANTER CELUI-CI.
< - LANCER CELUI-CI QUI LANCERA LE PROGRAMME A EXECUTER.
<
LAI "3"
BSR ADESAS < DESASSIGNATION UL 3.
<
LA AOVAL < ADRESSE OCTET NOM+VALEUR.
AD LGN < + LONGUEUR DU NOM (EOT INCLUS).
LR A,W < POUR TOUT A L'HEURE.
TBT 15 < L'ADRESSE VALEUR EST-ELLE PAIRE???
JNC EXEC1
<
< L'ADRESSE VALEUR EST IMPAIRE, IL FAUT DONC LA DECALER DE 1 OCTET VERS LE HAUT.
<
LR A,Y < ADRESSE OCTET EMETTEUR.
LR A,B
ADRI -1,B < ADRESSE OCTET RECEPTEUR.
LA &ALT < LONGUEUR NOM+VALEUR + 2.
ADRI -2,A < LONGUEUR NOM+VALEUR.
SB LGN < LONGUEUR (OCTETS) A DECALER.
LR A,X < DANS 'X'.
EXEC2: EQU $
PSR X < SAVE COUNT.
LR Y,X < INDEX EMETTEUR.
LBY &AXTRAV < LOAD OCTET.
LR B,X < INDEX RECEPTEUR.
STBY &AXTRAV < STORE OCTET.
ADRI 1,Y < SUIVANT...
ADRI 1,B < SUIVANT...
PLR X < RESTAURATION COUNT
JDX EXEC2
<
EXEC1: EQU $
LA &ALT < LONGUEUR OCTETS NOM+VALEUR+2...
ADRI -2,A < LONGUEUR NOM+VALEUR.
SB LGN < MOINS LONGUEUR DU NOM, EOT INCLUS.
ADRI 1,A < A CAUSE DES FRONTIERE D'OCTETS...
SLRS 1 < LONGUEUR MOTS DU 'MOVE' POUR LE RUNNER,
LR A,X < ET VOILA.
<
LR W,A
SLRS 1 < ADRESSE EMETTEUR POUR LE MOVE DU RUNNER.
LR A,W < W=ADRESSE EMETTEUR...
<
< CALCUL DE LA TAILLE MEMOIRE A DEMANDER PAR LE RUNNER AVANT LE
< LANCEMENT DU PROGRAMME.
<
PSR X,W < SAUVEGARDES.
LA T800
STA &ADMM2 < 2 K OCTETS A PRIORI.
LR A,W < ADRESSE MOT DE LA LONGUEUR REELLE
< DU PROGRAMME.
LA 0,W < LONGUEUR OCTETS DU PROGRAMME.
LYI 0 < Y=CONSTANTE ADDITIVE NULLE A PRIORI.
JAGE EXEC12 < OK, TAILLE>=0.
NGR A,A < A=VALEUR ABSOLUE(TAILLE).
LY T1000 < ET Y = CONSTANTE ADDITIVE 2K MOTS.
EXEC12: EQU $
STA &ADMM2 < NOUVEAU COMPTE D'OCTETS DE LA DEMANDE MEM
ADR Y,A < TAILLE REELLE DU PROGRAMME.
ADRI '10+'F+1*2,A < POUR PRENDRE EN COMPTE LES '10 MOTS
< RESERVES DEVANT 'SLO' PAR LE SYSTEME, LES
< 'F MOTS RESERVES POUR !CALL, ET LE
< MOT INACCESSIBLE AUX E/S EN FIN D'ESPACE
< MEMOIRE.
JALE EXECB < ERREUR DE TAILLE.
CP T800 < 1K MOTS ?
JLE EXEC3 < C'EST FAIT.
LY T1000 < NON,ALLONS VOIR 2K ET LA SUITE...
LXI 6 < 6 TAILLES SONT RECONNUES:
< 2,4,6,8,10 ET 12K.
EXEC11: EQU $
CPR Y,A < LA TAILLE COURANTE SUFFIT?
JLE EXEC10 < OUI.
XR A,Y < NON,
AD T1000 < ON PASSE 2K AU-DESSUS.
XR A,Y
JDX EXEC11 < AU SUIVANT...
JMP EXECB < ERREUR, NON DISPONIBLE!
EXEC10: EQU $
STY &ADMM2 < STOCKAGE TAILLE DANS LA DEMANDE
< POUR LE RUNNER.
JMP EXEC3
EXECB: EQU $ < ERREUR FATALE.
ACTD
EXEC3: EQU $
<
<
< MOVE DU RUNNER VERS LA MEMOIRE BASSE.
<
LRM A,B,X
WORD RUNNER < EMETTEUR.
WORD XIMPL < RECEPTEUR (ADRESSE D'IMPLANTATION).
WORD RUNF-RUNNER < LONGUEUR DU RUNNER.
MOVE
< RUN DU RUNNER.
PLR X,W < RESTAURE LONGUEUR PROGRAMME.
LRM A,L,K
WORD XMEM < ADRESSE DEMANDE MEMOIRE.
WORD 'F < ADRESSE RECEPTEUR POUR LE MOVE DU RUNNER.
WORD XIMPL-2 < PILE K AU DEBUT DE L'ESPACE...
WORD '0001 < POUR '1E16 EVENTUEL.
BR ARUN
XWOR%1: VAL 0
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 UNE RESTAURATION FICHIER OU ITEM
< CE S/P AJUSTE L'ESPACE MEMOIRE: IL FAUT EN EFFET QUE
< ADR OCT(NOM+VALEUR)+ (A) 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
< QUANTA*128-1 MOTS; DANS LE S/P 'DFICH' ON A MIS
< DANS LE REGISTRE 'A' LE NOMBRE QUANTA*128-1
< NOTA2:QUAND IL S'AGIT D'UN ITEM, ON A DANS (A) LA LONGUEUR
< EQUIVALENTE A UNE "BOX"
<
PSR A
LR A,B
LA AOVAL
ADR B,A
ADRI '10*2-1,A < '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 $
PLR A
RSR
IF ORDI-"S",XWOR%1,,XWOR%1
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
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
<
< 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
<
CONVH: EQU $
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
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.
<
< ATTENTION:
< DETRUIT 'X'.
<
BSR AENVOI < ENVOI QUESTION
LAD DMREP < DEMANDE REPONSE
SVC 0
LBY REP < CHARGEMENT REPONSE DANS 'A'.
RSR
PAGE
ENVOI: EQU $
<
< ENVOI D'UN MESSAGE SUR UL '02
<
< 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
IF ORDI-"S",XWOR%1,,XWOR%1
PAGE
<
< T E S T A N D D E L E T E.
<
< - ARGUMENTS:
<
< - 'IDELAR', INDICATEUR OPTION "DELETE AND REST":
< = 0 : OPTION INACTIVE,
< # 0 : OPTION ACTIVE.
< - 'A' = ADRESSE O C T E T DU NOM COURANT TERMINE
< PAR CTRL-D.
< - 'C' BASE LE COMMON.
< - 'L' BASE LE LOCAL.
<
< - RESULTAT:
< - AU RETOUR, FAIRE:
< JE L'ENTITE COURANTE A ETE DETRUITE.
< JNE L'ENTITE COURANTE N'A PAS ETE DETRUITE.
< - 'NBEND', NOMBRE D'ENTITES NON DELETEES A RECU +1 SI
< ET SEULEMENT SI L'OPTION "DELETE AND REST" ETAIT
< ACTIVE, QU'IL EXISTAIT UNE ENTITE PORTANT LE
< NOM COURANT ET QUE L'ON N'A PAS PU DELETER CETTE
< ENTITE (CAS D'UN FICHIER DEJA ASSIGNE PAR EXEMPLE).
<
TDMDS: ASCI "!ASSIGN 4="
BYTE "S";'04
FTDMDS: EQU $
TDMASD: ASCI "!ASSIGN 4=D-" < LE NOM EST EN TETE DE 'TDBUF' !
TDBUF: DZS '7F-'48-6+1+1
<
< LOCAL DU S/P 'TAD'.
<
LOCAL
TDLOC: EQU $
< EOT INCLUS.
AXTDBU: WORD TDBUF,X
TDDSAS: WORD '0002 < DESASSIGNATION..
WORD TDMDS-ZERO*2
WORD FTDMDS-TDMDS*2
TDASD: WORD '0002 < ASSIGNATION DELETE.
WORD TDMASD-ZERO*2
WORD 80
TDLON: WORD '8502 < SGN LOAD NAME.
WORD TDBUF-ZERO*2
WORD '7F-'48-6+1*2+1
WORD -1
TDDLN: WORD '8302 < SGN DELETE NAME.
WORD TDBUF-ZERO*2
WORD '7F-'48-6+1*2+1
WORD -1
PROG
TAD: EQU $
PSR A,B,X,Y
PSR W
<
CPZ IDELAR < DELETE DEMANDE ?
JE TADF1
<
< INITIALISATIONS.
<
LRM W < BASE DU LOCAL DE 'TAD'.
WORD TDLOC+'80
USE W,TDLOC+'80
<
< DETERMINATION DE LA LONGUEUR DU NOM COURANT ET, EN MEME TEMPS, STOCKAGE
< DE CE NOM EN TETE DU BUFFER DE 'TAD'.
<
LR A,X < ADRESSE OCTET EMETTRICE.
LYI 0 < LONGUEUR COURANTE.
LB TDLON+1 < ADRESSE OCTET RECEPTRICE.
TAD1: EQU $
PSR X
LBY &AXTRAV
LR B,X
STBY &AXTRAV
ADRI 1,Y < NOUVELLE LONGUEUR COURANTE.
ADRI 1,B < NOUVELLE ADRESSE RECEPTRICE.
PLR X
ADRI 1,X < NOUVELLE ADRESSE EMETTRICE.
CPI '04 < EOT ?
JNE TAD1
<
< SGN LOAD NAME.
<
LAD TDLON
SVC 0
JE $+2
ACTD
<
< TESTS POUR SAVOIR SI CE NOM DESIGNE UN FICHIER OU UN ITEM (CF LE S/P 'TSTFI'
< DE DUMP QUI FAIT AUSSI CE TRAVAIL). IL S'AGIRA D'UN FICHIER SI LES 3 TESTS
< CI-DESSOUS SONT POSITIFS.
<
WORD '1E35 < 'B' RECOIT LA 'BOX'.
<
< TEST 1.
<
LAI '7F-'48-6+1*2
SBR Y,A
CPR B,A
JNE TAD2
<
< TEST 2.
<
LXI '7E-'48-6
LA &AXTDBU
CPI NSPSTN+X123X
JNE TAD2
<
< TEST 3.
<
LXI '7F-'48-6
LA &AXTDBU
SLRS 8
CPI 1
JG TAD2
<
< C'EST PROBABLEMENT UN FICHIER: TENTER UN ASSIGN DELETE.
<
LAD TDDSAS < DESASSIGNATION UL 4.
SVC 0
LAD TDASD < !ASSIGN DELETE.
SVC 0
JNE TAD3 < DELETE REFUSE.
JMP TAD4 < DELETE ACCEPTE.
TAD2: EQU $
<
< C'EST UN ITEM, FAIRE UN DLN.
<
LAD TDDLN
SVC 0
JE $+2
ACTD
TAD4: EQU $
LBI 0 < DELETE ACCEPTE.
JMP TADF2
TAD3: EQU $
IC NBEND < NOMBRE D'ENTITES NON DELETABLES RECOIT
< + 1.
TADF1: EQU $
LBI 1 < DELETE NON DEMANDE OU IMPOSSIBLE.
TADF2: EQU $
CPZR B < POUR TEST EN RETOUR.
<
PLR W
PLR A,B,X,Y
RSR
XWOR%1: VAL 0
FIN: EQU $ < FIN DU PROGRAMME
TOTO: VAL FIN-ZERO*2
PAG0: EQU ZERO+TOTO
PAG2: EQU ZERO+TOTO+2
LST
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.