<***********************************************************************
<* *
<* *
<* C H A R G E U R T R A N S L A T E U R *
<* A U T O T R A N S L A T A B L E L O A D. *
<* *
<* CE CHARGEUR CHARGE UN PROGRAMME DANS UNE PARTITION *
<* MINIMUM DE LONGUEUR 'LGINI' (MOINS SA LONGUEUR 'LGCHGM'). *
<* SI LE PROGRAMME EST TROP GROS, IL SE DEPLACE DE 'LGDEPL'. *
<* LE MAXIMUM ACTUEL IMPOSE PAR LE SYSTEME EST DE 8K. *
<* L'UNITE DE LECTURE DU BINAIRE PORTE LE NUMERO 'NOUNIT'. *
<* LA VERSION LDDK CHARGE EN ABSOLU SUR DISQUE *
<* ELLE DEMANDE LE NUMERO DE DISQUE(2 OU 3), *
<* L'ADRESSE DE DEBUT DE CHARGEMENT, L'ADRESSE DE FIN *
<* POUR VERIFICATION, ET UNE ADRESSE DE TRANSLATION *
<* PERMETTANT UN CHARGEMENT DECALE. *
<* *
<* MESSAGES D'ERREURS : *
<* - 0X : ERREUR SYSTEME OU ASSEMBLEUR *
<* - '01 : ERREUR LORS DE LA LECTURE DU BINAIRE *
<* - 1X : ERREURS DUES A L'ASSEMBLEUR *
<* - '11 : NUMERO DE COMMANDE ERRONNEE *
<* - '12 : COMMANDE ABSOLUE EN TRANSLATABLE *
<* - '13 : ERREUR DE CHECKSUM *
<* - 2X : ERREUR DE PROGRAMMATION *
<* -'21 : ADRESSE GENEREE DANS UNE INSTRUCTION > 32K *
<* - '22 : ADRESSE DE CHARGEMENT > 32K *
<* - '23 : PROGRAMME DEPASSANT LA PARTITION MEMOIRE MAXI *
<* - 3X : ERREUR CHARGEMENT DISQUE *
<* -'31 : DEPASSEMENT @ FIN CHARGEMENT *
<* *
<* *
<***********************************************************************
PAGE
MEMDSK: VAL 1 < CHARGEMENT SUR DISQUE
< MEMDSK,M100,M100,
MEMDSK: VAL 0 < CHARGEMENT EN MEMOIRE
< MEMDSK,,,M100
IF MEMDSK,,,M100
IDP "LOAD - RELEASE 15/05/1977"
M100: VAL 0
IF MEMDSK,M100,M100,
IDP "LDDK - RELEASE 15/05/1977"
M100: VAL 0
IDP "SERGE SOUZEAU"
PAGE
<***********************************************************************
<* *
<* RESERVATION DE PLACE POUR LE PROGRAMME A CHARGER. *
<* *
<***********************************************************************
TABLE
<***********************************************************************
<* *
<* VALEURS IMPORTANTES. *
<* *
<***********************************************************************
NOUNIT: VAL '03 < UNITE DE LECTURE BINAIRE
IF MEMDSK,,,M100
LGINI: VAL '800 < LONGUEUR INITIALE PARTITION
LGDEPL: VAL '800 < LONGUEUR DU DEPLACEMENT
LGCHGM: VAL '22A < LONGUEUR DU CHARGEUR
SPROG: VAL LGINI-LGCHGM-'15 < PLACE INITIALEMENT LIBRE
M100: VAL 0
<***********************************************************************
<* *
<* INTERFACE AVEC CMS4. *
<* *
<***********************************************************************
ZERO: EQU $ < ZERO TRANSLATABLE DU PROGRAMME
DZS 'C
DITEM: EQU $
IF MEMDSK,,,M100
ASCI "LOAD"
M100: VAL 0
IF MEMDSK,M100,M100,
ASCI "LDDK"
M100: VAL 0
BYTE '04;'D0
DBCHIT: EQU $
WORD SIZE
WORD PLOAD
<***********************************************************************
<* *
<* ENTREE DANS LE PROCESSEUR. *
<* *
<***********************************************************************
WORD LOAD
PROG
PLOAD: EQU $
LRP L
BR -1,L
IF MEMDSK,,,M100
<***********************************************************************
<* *
<* ZONE RESERVEE POUR CHARGER LE PROGRAMME. *
<* *
<***********************************************************************
DZS SPROG
M100: VAL 0
IF MEMDSK,M100,M100,
BUFSOR: DZS 128
M100: VAL 0
PAGE
<***********************************************************************
<* *
<* COMMON. *
<* *
<***********************************************************************
COMMON
TOUDEB: EQU $
BUFFER: DZS 40 < BUFFER D'ECRITURE DES MESSAGES
BUFBIN: DZS 41 < BUFFER D'ENTREE DU BINAIRE
< (+1 A CAUSE DE L'INTERFACE SGF)
INDEX: WORD 80 < INDEX BUFFER BINAIRE
KSTORE: DZS 20 < PILE POUR K
CHKSUM: DZS 1 < CHECKSUM
ABSMOD: WORD -1 < INDICATEUR TRANSLATABLE-ABSOLU
ADSTOC: DZS 2 < QUADRUPLET 'AU FRAIS'
PAFINI: DZS 1 < RELAI POUR SUITE DE COMMANDE
FINMOD: DZS 1 < INDICATEUR DE FIN DE MODULE
CPTLOD: DZS 1 < COMPTEUR DE REPEAT LOAD
OPNBO: BYTE NOUNIT;'05 < OPEN-OLD ENREGISTREMENT
WORD 1 < CLE=1.0
WORD 0
CCI: WORD 1 < RETOUR AU CCI SI ERREUR
IOCBIN: BYTE NOUNIT;'08 < LECTURE MODE SAVE
DZS 1
WORD 82 < (+2 RESERVES POUR LE SGF)
IOCBL: WORD '0202 < SORTIE LISTING
DZS 1
WORD 0
IF MEMDSK,M100,M100,
MESDSK: BYTE '6D;"D" < MESSAGE N0 DISQUE
ASCI "K="
MESAD1: BYTE '6D;"@" < MESSAGE @ DEBUT
ASCI " DEBUT ="
MESAD2: BYTE '6D;"@" < MESSAGE @ FIN
ASCI " FIN ="
MESTRA: BYTE '6D;"T" < @ TRANS
ASCI "RANS ="
DSKMES: WORD '0202 < ENVOI DES MESSAGES
WORD MESDSK-ZERO*2
WORD 4
AD1MES: WORD '0202
WORD MESAD1-ZERO*2
WORD 10
AD2MES: WORD '0202
WORD MESAD2-ZERO*2
WORD 8
TRAMES: WORD '0202
WORD MESTRA-ZERO*2
WORD 8
RELBEN: WORD BUFFER+2,X
HEXDEC: WORD SPHEXA < SP CONVERSION CARAC.-BINAIRE
DEMDSK: WORD '0101 < DEMANDE N0 DISQUE
WORD BUFFER-ZERO*2
WORD 1
DEMADR: WORD '0101 < DEMANDE ADRESSE DISQUE
WORD BUFFER-ZERO*2
WORD 4
ASSDSK: WORD '0003 < DEMANDE ASSIGNATION DISQUE
WORD '0400
DSKDEB: WORD 0 < @ DEBUT
DSKFIN: WORD 0 < @ FIN
ADDTRA: WORD 0 < @ TRANS
UNFFF: WORD '1FFF
LIRDSK: WORD '0400 < LECTURE DISQUE
WORD BUFSOR-ZERO*2
WORD 256
WORD 0
ECRDSK: WORD '0402 < ECRITURE DISQUE
WORD BUFSOR-ZERO*2
WORD 256
WORD 0
ADISK: WORD BUFSOR,X < RELAI VERS BUFFER
LIRMOT: WORD LECMOT < SP DE LECTURE(DISQUE)
ECRMOT: WORD PLAMOT < SP D'ECRITURE UN MOT(DISQUE)
SWRITE: WORD WRITED < SP D'ECRITURE DISQUE
M100: VAL 0
IF MEMDSK,,,M100
<***********************************************************************
<* *
<* ZONE COMPRENANT DES ADRESSES RELATIVES A INCREMENTER *
<* LORS DE LA TRANSLATION DU CHARGEUR. *
<* ACCMOD DOIT TOUJOURS ETRE LE DERNIER. *
<* *
<***********************************************************************
ADEBCM: EQU $ < DEBUT ZONE A TRANSLATER
MAXMEM: WORD TOUDEB < LIMITE DU PROGRAMME
M100: VAL 0
ADLANC: WORD DEBPG < DEBUT DU PROGRAMME CHARGE
RELBUF: WORD BUFBIN+1,X < RELAI BUFFER BINAIRE BIT INDEX
SORMES: WORD ENTMOT < SP DE SORTIE QUESTIONS
MERCLF: WORD MSGRC < SP DE SORTIE DE CR-LF
MESER: WORD MSGERR < SP DE SORTIE D'ERREURS
BANDEF: WORD FINBAN
LITQ: WORD SPLITQ < SP DE LECTURE 1 QUADRUPLET
AUFRAI: WORD ADSTOC+2,X < QUADRUPLET 'AU FRAIS'
TABCDE: WORD TABAIG,X < AIGUILLAGE SUIVANT COMMANDE
TABAIG: WORD DEBUT < CHARGER EN
WORD SUITE < CHARGER A LA SUITE SANS TRANSL.
WORD LANCT < ADRESSE DE LANCEMENT
WORD REPEAT < REPEAT LOAD
WORD CHECK < FIN BANDE ET CHECKSUM
WORD COMENT < COMMENTAIRE
WORD PACDE < SUITE DE COMMANDE
WORD TRANSL < CHARGER A LA SUITE EN TRANS.
WORD REMADR < REMONTER CHAINE ADRESSES
WORD DEPADR < DEPLACEMENT SUR ADRESSE
WORD LECTUR < DEBUT DE PST
WORD NSECT < NOM DE SECTION
WORD ENT < ENTRY
WORD REMJMP < DEF. DE REF. AVANT RELATIVE
TRANSB: WORD BTRANS < SP DE TRANSLATION DE B
RANGB: WORD VERIFW < SP RANGE B EN VERIFIANT ADRESSE
NEWCHG: WORD AUTMOD < RELANCE DU MODULE
AREMA2: WORD REMAD2 < SUITE DE COMMANDE CHAINE
ADEPA2: WORD DEPAD2 < SUITE DE COMMANDE DEPLACEMENT
ADRFAT: WORD RFATAL < TRAITEMENT ERREUR FATALE
ADLECT: WORD LECTUR < LECTURE DE QUADRUPLETS
ASECT2: WORD SECT2 < SUITE DE COMMANDE NOM
ARJMP2: WORD REMJM2 < SUITE DE COM. REF. AVANT REL.
SORCAR: WORD PRECAR < SORTIE DE 3 CARACTERES
SORADR: WORD ECRADR < SORTIE ADRESSE
SORHEX: WORD BUFFER+3,X < POUR ADRESSE RELATIVE
IF MEMDSK,,,M100
AZERCH: WORD ZEROCH < ADRESSE DE MISE A ZERO CHARGEUR
ADDEBX: WORD TOUDEB,X < DEBUT DE MISE A ZERO
AFINZ: WORD FINZER < FIN DE MISE A ZERO DU CHARGEUR
ACCMOD: WORD AFINCM,X < FIN DE MODIFICATION
< LORS DU DEPLACEMENT DU CHARGEUR
AFINCM: EQU $ < FIN DE ZONE A TRANSLATER
<***********************************************************************
<* *
<* FIN DE ZONE D'ADRESSES A TRANSLATER. *
<* *
<***********************************************************************
ADDEB: WORD TOUDEB < DEBUT DU CHARGEUR
NBCMOD: VAL AFINCM-ADEBCM < NB D'ADRESSES A MODIFIER
DEUXK: WORD LGDEPL < LONGUEUR DU DEPLACEMENT
DEBCHG: VAL TOUDEB-ZERO
LGLOAD: WORD LGINI-DEBCHG-16 < LONGUEUR DU CHARGEUR
LGZERO: DZS 1 < LONGUEUR A METTRE A ZERO
M100: VAL 0
ADINIT: DZS 1 < DEBUT CHARGEMENT D'UN MODULE
IF MEMDSK,,,M100
LGPART: WORD LGINI < LONGUEUR DE LA PARTITION
ALLOC: WORD '0004 < RESERVATION INITIALE
WORD 0
DZS 1
M100: VAL 0
RCLF: WORD '0D0A < CR-LF
ERREUR: ASCI "ERU " < MESSAGE D'ERREUR
START: ASCI "RUN " < MESSAGE RUN
TRENTE: WORD '3030
NB7FFF: WORD '7FFF
BLQ: ASCI " '"
MCLOS: ASCI "!CLOSE" < !CLOSE
BYTE '04;0
DEMCLO: WORD '0002 < DEMANDE DE "!CLOSE"
DZS 1
WORD 80
PAGE
<***********************************************************************
<* *
<* C H A R G E U R . *
<* *
<* INITIALISATION DU CHARGEUR. *
<* *
<***********************************************************************
PROG
WORD TOUDEB+128
LOAD: EQU $
LRP C < INITIALISATION DE LA BASE C
LA -1,C
LR A,C
IF MEMDSK,,,M100
LAI -1 < RENDRE ALT-MODE INEFFECTIF
WORD '1EB5
M100: VAL 0
LAD KSTORE-1 < INITIALISATION DE K
LR A,K
LAD MCLOS < INITIALISATION ADRESSE CLOSE
SLLS 1
STA DEMCLO+1
LAD BUFBIN < INIT. ADRESSES BUFFERS
SLLS 1
STA IOCBIN+1
LAD BUFFER
SLLS 1
STA IOCBL+1
IF MEMDSK,,,M100
LA LGPART < INIT. DEMANDE MEMOIRE
SLLS 1
STA ALLOC+2
LA AFINZ < INIT. LGZERO
SB MAXMEM
STA LGZERO
M100: VAL 0
EORR W < ADRESSE DEBUT CHARGEMENT
BSR MERCLF < ENVOI DE CRT CHARGEMENT
LAD DEMCLO < !CLOSE
SVC 0
BR BANDEF
<***********************************************************************
<* *
<* OUVERTURE DU FICHIER CONTENANT LE MODULE A CHARGER. *
<* *
<***********************************************************************
AUTMOD: EQU $
IF MEMDSK,M100,M100,
DDSK1: EQU $
LBY ASSDSK+1 < N0 DISQUE=0
STZ ASSDSK+1
STBY ASSDSK+1
LAD DSKMES < N0 DISQUE
SVC 0
LAD DEMDSK
SVC 0
LA BUFFER < VERIFICATION
SLRS 8
ADRI -'30,A
CPI 2
JE DDSK2
CPI 3
JNE DDSK1
DDSK2: EQU $
ADRI '22,A < PLACER
AD ASSDSK+1 < DANS ASSIGN DISQUE
STA ASSDSK+1
LAD AD1MES < @ DEBUT
SVC 0
LAD DEMADR
SVC 0
BSR HEXDEC
JANE DDSK1
LR B,A < VERIFICATION
JAL DDSK1
CP UNFFF
JG DDSK1
STB DSKDEB < PLACER
STB LIRDSK+3
STB ECRDSK+3
LAD AD2MES < @ FIN
SVC 0
LAD DEMADR
SVC 0
BSR HEXDEC
JANE DDSK1
LR B,A < VERIFICATION
JAL DDSK1
CP UNFFF
JG DDSK1
STB DSKFIN
LR B,A < VERIFICATION
CP DSKDEB
JLE DDSK1
LAD TRAMES < @ TRANS
SVC 0
LAD DEMADR
SVC 0
BSR HEXDEC
JANE DDSK1
STB ADDTRA
LAI '1B < CHANGER LE ALT-MODE
WORD '1EA5
LAD ASSDSK < ASSIGNER LE DISQUE
SVC 0
LA DSKDEB < MISE A ZERO ESPACE DISQUE
STA ECRDSK+3
ECRZER: EQU $
LAD ECRDSK
SVC 0
IC ECRDSK+3
LA ECRDSK+3
CP DSKFIN
JL ECRZER
M100: VAL 0
LAD OPNBO < OUVERTURE DU FICHIER BINAIRE
SVC 0 < DANS LE MODE OPEN-OLD-ENREGIS-
< TREMENT
JE RELANS < GO ON SI OPEN OK
<***********************************************************************
<* *
<* SORTIE EN ERREUR DU LOAD. *
<* *
<***********************************************************************
HORTEN: EQU $
IF MEMDSK,M100,M100,
LBY ASSDSK+1 < DESASSIGNER LE DISQUE
STZ ASSDSK+1
STBY ASSDSK+1
LAD ASSDSK
SVC 0
M100: VAL 0
LAD CCI < RETOUR AU CCI
SVC 0
JMP $-1
<***********************************************************************
<* *
<* ERREUR FATALE. *
<* *
<***********************************************************************
RFATAL: EQU $
XR A,K < REINITIALISATION DE K
LAD KSTORE-1
XR A,K
BSR MESER < SORTIE DU MESSAGE D'ERREUR
JMP HORTEN
PAGE
<***********************************************************************
<* *
<* DEBUT DU CHARGEMENT. *
<* COMMANDE 'A3 POUR TRANSLATABLE, *
<* SINON, C'EST EN ABSOLU. *
<* *
<***********************************************************************
RELANS: EQU $
BSR LITQ < LECTURE 1ER QUADRUPLET
CPI 'A3 < MODULE TRANSLATABLE ?
JNE ANALIZ < SI ABSOLU, ABSMOD=-1
IC ABSMOD < SI TRANSLATABLE, ABSMOD=0
<***********************************************************************
<* *
<* LECTURE DES QUADRUPLETS ET ANALYSE D'UNE COMMANDE. *
<* *
<***********************************************************************
LECTUR: EQU $
BSR LITQ < LECTURE D'UN QUADRUPLET
ANALIZ: EQU $
ANDI 3 < COMMANDE ABSOLU OU TRANSLATABLE
JAE ABSOL
CPI 2 < COMMANDE TRANSLATABLE
JNE ERCMDE
CPZ ABSMOD
JL PATRAN
LBY ADSTOC < NUMERO DE LA COMMANDE
ANDI '1C
ADRI '18,A
NUMCDE: EQU $ < AIGUILLAGE SUIVANT COMMANDE
SLRS 2
LR A,X
BR &TABCDE
ABSOL: EQU $ < COMMANDE ABSOLUE
LBY ADSTOC
ANDI '1C
CPI '14
JLE NUMCDE
ERCMDE: EQU $ < NUMERO COMMANDE ERRONNE
LAI '11
BR ADRFAT
PATRAN: EQU $ < COMMANDE ABSOLUE EN TRANSLATAB.
LAI '12
BR ADRFAT
PAGE
<***********************************************************************
<* *
<* 'A0 - CHARGER EN. *
<* POSITIONNER W. *
<* *
<***********************************************************************
DEBUT: EQU $
BSR TRANSB < ADRESSE RELATIVE DEBUT PARTITIO
LR B,W
JMP LECTUR
PAGE
<***********************************************************************
<* *
<* '24 - CHARGER A LA SUITE SANS TRANSLATER. *
<* RANGER A LA SUITE EN TENANT COMPTE DU REPEAT LOAD. *
<* *
<***********************************************************************
SUITE: EQU $
BSR RANGB < RANGEMENT DE L'INFORMATION
ADRI 1,W
DC CPTLOD < REPEAT LOAD?
JG SUITE
STZ CPTLOD < REMISE A ZERO DU REPEAT LOAD
JMP LECTUR
PAGE
<***********************************************************************
<* *
<* '28 - ADRESSE DE LANCEMENT. *
<* RELEVER L'ADRESSE. *
<* *
<***********************************************************************
LANCT: EQU $
BSR TRANSB < ADRESSE RELATIVE DEBUT PARTITIO
STB &ADLANC
IC FINMOD < FIN DE MODULE=1
JMP LECTUR
PAGE
<***********************************************************************
<* *
<* 'AC - REPEAT LOAD. *
<* POSITIONNER LE COMPTEUR. *
<* *
<***********************************************************************
REPEAT: EQU $
STB CPTLOD
BR ADLECT
PAGE
<***********************************************************************
<* *
<* '30 - CHECKSUM ET FIN DE BANDE. *
<* VERIFICATION DU CHECKSUM ET FIN DE CHARGEMENT. *
<* *
<***********************************************************************
CHECK: EQU $
LA CHKSUM < VERIFICATION
CPR B,A
JNE FAUSUM
IF MEMDSK,M100,M100,
BSR SWRITE < ECRIRE DERNIER SECTEUR
LBY ASSDSK+1 < DESASSIGNER LE DISQUE
STZ ASSDSK+1
STBY ASSDSK+1
LAD ASSDSK
SVC 0
M100: VAL 0
LA OPNBO < MISE EN MODE CLOSE-SAVE DE LE
LR A,Y < SAUVER L'ETAT ACTUEL
ORI 2 < DEMANDE 'OPNBO'
STA OPNBO
LAD OPNBO < FERMETURE EN SAVE DE
SVC 0 < L'ENREGISTREMENT
STY OPNBO < RESTAURER L'ETAT INITIAL
LAD DEMCLO < !CLOSE
SVC 0
CPZ FINMOD < FIN DE MODULE?
JE FINBAN < FIN DE BANDE UNIQUEMENT
LA &ADLANC
JAL FINBAN < FIN DE MODULE SANS LANCEMENT
LAD START < IMPRESSION ADRESSE LANCEMENT
BSR SORMES
LA &ADLANC
BSR SORADR
IF MEMDSK,,,M100
BR AZERCH < REMETTRE LE CHARGEUR A ZERO
M100: VAL 0
IF MEMDSK,M100,M100,
LAD CCI < RETOUR CCI
SVC 0
JMP $-1
M100: VAL 0
<***********************************************************************
<* *
<* FIN DE BANDE - RETOUR AU MONITEUR. *
<* *
<***********************************************************************
FINBAN: EQU $
LR W,A < DEBUT MODULE SUIVANT
STA ADINIT
LAD CCI < RETOUR MONITEUR
SVC 0
STZ CHKSUM < REINITIALISER LES VALEURS DE
LAI 80 < DEPART DES VARIABLES
STA INDEX
LAI -1
STA ABSMOD
STZ FINMOD
STZ CPTLOD
BR NEWCHG < TRAITER LE MODULE SUIVANT
<***********************************************************************
<* *
<* ERREUR DANS LE CHECKSUM. *
<* *
<***********************************************************************
FAUSUM: EQU $
LAI '13
BR ADRFAT
PAGE
<***********************************************************************
<* *
<* 'B4 - COMMENTAIRE. *
<* L'ECRIRE. *
<* *
<***********************************************************************
COMENT: EQU $
BSR SORCAR
BR ADLECT
PAGE
<***********************************************************************
<* *
<* '22 - SUITE DE COMMANDE. *
<* SE REBRANCHER A LA COMMANDE CONCERNEE. *
<* *
<***********************************************************************
PACDE: EQU $
BR PAFINI
PAGE
<***********************************************************************
<* *
<* 'A6 - CHARGER A LA SUITE EN TRANSLATANT. *
<* TRANSLATER ET ALLER CHARGER. *
<* *
<***********************************************************************
TRANSL: EQU $
BSR TRANSB < ADRESSE RELATIVE DEBUT PARTITIO
JMP SUITE
PAGE
<***********************************************************************
<* *
<* 'AA - REMONTER UNE CHAINE D'ADRESSES. *
<* MEMORISATION DE L'ADRESSE DE DEBUT DE CHAINE. *
<* *
<***********************************************************************
REMADR: EQU $
PSR W < PROTEGER W
BSR TRANSB < ADRESSE RELATIVE DEBUT PARTITIO
LR B,W < MEMORISER L'ADRESSE
LA AREMA2 < PREPARER LA SUITE DE COMMANDE
STAPAF: EQU $
STA PAFINI
BR ADLECT
<***********************************************************************
<* *
<* SUITE DE COMMANDE CHAINE. *
<* REMONTER LA CHAINE POUR Y PLACER LA VALEUR. *
<* *
<***********************************************************************
REMAD2: EQU $
BSR TRANSB < ADRESSE RELATIVE DEBUT PARTITIO
IF MEMDSK,,,M100
LA 0,W < PRELEVER LE 1ER MAILLON
M100: VAL 0
IF MEMDSK,M100,M100,
BSR LIRMOT
M100: VAL 0
JAL BIT01 < PRELEVER SON BIT D'INDEX
RBT 16
JMP BIT00
BIT01: EQU $
SBT 16
RBT 0
BIT00: EQU $
IF MEMDSK,,,M100
STB 0,W < PLACER LA VALEUR D'ADRESSE
M100: VAL 0
IF MEMDSK,M100,M100,
BSR ECRMOT
M100: VAL 0
CP NB7FFF < FIN DE CHAINE?
JE PLRW
LR A,W < NON - POURSUIVRE
JMP REMAD2
PAGE
<***********************************************************************
<* *
<* '2E - DEPLACEMENT SUR ADRESSE. *
<* MEMORISATION DE L'ADRESSE. *
<* *
<***********************************************************************
DEPADR: EQU $
PSR W < PROTEGER W
BSR TRANSB < ADRESSE RELATIVE DEBUT PARTITIO
LR B,W < PRELEVER L'ADRESSE A MODIFIER
LA ADEPA2 < PREPARER LA SUITE DE COMMANDE
JMP STAPAF
<***********************************************************************
<* *
<* SUITE DE COMMANDE DEPLACEMENT. *
<* MODIFICATION DE LA VALEUR. *
<* *
<***********************************************************************
DEPAD2: EQU $
IF MEMDSK,,,M100
LA 0,W < PRELEVER L'ADRESSE A MODIFIER
M100: VAL 0
IF MEMDSK,M100,M100,
BSR LIRMOT
M100: VAL 0
LR A,Y < LA PRESERVER POUR BIT D'INDEX
RBT 0
ADR A,B < MODIFICATION
JNV ADNORM
LAI '21 < ADRESSE GENEREE > 32K
BR ADRFAT
ADNORM: EQU $
CPR Y,A < RESTAURER LE BIT D'INDEX
JE $+2
SBT 16
IF MEMDSK,,,M100
STB 0,W < RANGER LA VALEUR MODIFIEE
M100: VAL 0
IF MEMDSK,M100,M100,
BSR ECRMOT
M100: VAL 0
<***********************************************************************
<* *
<* RESTAURER W. *
<* *
<***********************************************************************
PLRW: EQU $
PLR W
BR ADLECT
PAGE
<***********************************************************************
<* *
<* '36 - NOM DE SECTION. *
<* IMPRESSION DU DEBUT DU NOM. *
<* *
<***********************************************************************
NSECT: EQU $
BSR MERCLF < IMPRESSION DE CR-LF
BSR SORCAR < IMPRESSION DES TROIS PREMIERS
< CARACTERES DU NOM
LA ASECT2 < PREPARER LA SUITE DE NOM
JMP STAPAF
<***********************************************************************
<* *
<* SUITE DE COMMANDE NOM. *
<* IMPRESSION DE LA FIN DE NOM ET DE L'ADRESSE DE DEBUT. *
<* *
<***********************************************************************
SECT2: EQU $
BSR SORCAR < IMPRESSION DE FIN DE NOM
LR W,A < IMPRESSION DE ADRESSE IMPLANTA.
BSR SORADR
BR ADLECT
PAGE
<***********************************************************************
<* *
<* '3A - COMMANDE ENT. *
<* COMMANDE INUTILISEE. *
<* *
<***********************************************************************
ENT: EQU $
LA ADLECT
JMP STAPAF
PAGE
<***********************************************************************
<* *
<* 'BE - REFERENCE EN AVANT RELATIVE. *
<* PRELEVER LE PREMIER MAILLON. *
<* *
<***********************************************************************
REMJMP: EQU $
PSR W < PROTEGER W
BSR TRANSB < ADRESSE RELATIVE DEBUT PARTITIO
LR B,W < RELEVER LE 1ER MAILLON
LA ARJMP2 < PREPARER LA SUITE DE COMMANDE
JMP STAPAF
<***********************************************************************
<* *
<* SUITE DE REFERENCE AVANT RELATIVE. *
<* MODIFICATION SUR LA CHAINE. *
<* *
<***********************************************************************
REMJM2: EQU $
BSR TRANSB < ADRESSE RELATIVE DEBUT PARTITIO
LR B,A < A=REF. EN AVANT
SBR W,A < DIFFERENCE D'ADRESSE
IF MEMDSK,,,M100
LB 0,W < PRELEVER MAILLON SUIVANT
M100: VAL 0
IF MEMDSK,M100,M100,
PSR A
BSR LIRMOT
LR A,B
PLR A
M100: VAL 0
SCRD 8 < FABRICATION DU MOT DEFINITIF
SWBR B
IF MEMDSK,,,M100
STB 0,W < RANGEMENT DE LA VALEUR
M100: VAL 0
IF MEMDSK,M100,M100,
BSR ECRMOT
M100: VAL 0
SWBR A < AD. RELATIVE MAILLON SUIVANT
SBR A,W < AD. ABSOLUE DU MAILLON SUIVANT
JANE REMJM2 < CHAINE FINIE PAR 0
JMP PLRW
PAGE
<***********************************************************************
<* *
<* LECTURE D'UN QUADRUPLET. *
<* FORME D'UN QUADRUPLET : *
<* ----------------------------------------- *
<* I P I . I + I X I X I X I X I X I *
<* ----------------------------------------- *
<* I P I + I 12 I 13 I 14 I 15 I + I . I *
<* ----------------------------------------- *
<* I P I + I 6 I 7 I 8 I 9 I 10 I 11 I *
<* ----------------------------------------- *
<* I P I + I 0 I 1 I 2 I 3 I 4 I 5 I *
<* ----------------------------------------- *
<* AVEC : - P PARITE DE L'OCTET *
<* - . BIT A 0 *
<* - + BIT A 1 *
<* - XXXXX VALEUR DE LA COMMANDE *
<* - 15,14,ETC BIT DE LA VALEUR. *
<* *
<***********************************************************************
SPLITQ: EQU $
LYI 0 < POUR SIGNALER 1ER CARACTERE
LXI -4 < NB CARACTERE
PSR B,X,Y < PROTEGER LES REGISTRES DE TRAV.
LAI 80 < DOIT-ON RELIRE?
CP INDEX
JNE PAVID
LAD IOCBIN < LECTURE
SVC 0
JNE NOPAIR < ERREUR DANS LE SGF
STZ INDEX
PAVID: EQU $
LX INDEX < PRELEVER LE BYTE SUIVANT
LBY &RELBUF
IC INDEX
PLR B,X,Y < RESTAURER LES REGISTRES
STBY &AUFRAI
CPZR Y < 1ER CARACTERE(COMMANDE)?
JNE STOCK
ANDI '60 < SI BLANC, RELIRE
CPI '20
JNE SPLITQ+2
ADRI 1,Y < 1ER CARACTERE TROUVE
STOCK: EQU $
JIX SPLITQ+2 < PRELEVER LES 3 AUTRES CARAC.
LBY ADSTOC
CPI '30 < DOIT-ON LE RENTRER DANS CHECKSU
JE PACHEK
LA CHKSUM < CALCUL CHECKSUM
AD ADSTOC
ADCR A
AD ADSTOC+1
ADCR A
STA CHKSUM
PACHEK: EQU $
LXI -3 < A=COMMANDE, B=INFO
LBY &AUFRAI
SLRD 6
JIX $-2
LBY ADSTOC
RSR
NOPAIR: EQU $ < ERREUR DE PARITE
LAI '01
BR ADRFAT
PAGE
<***********************************************************************
<* *
<* TRANSLATION DE L'ADRESSE CONTENUE DANS B. *
<* *
<***********************************************************************
BTRANS: EQU $
LR B,A
AD ADINIT < TRANSLATION
LR A,B
RSR
PAGE
<***********************************************************************
<* *
<* RANGEMENT DE B AVEC DEPLACEMENT DU CHARGEUR SI NECESSAIRE. *
<* *
<***********************************************************************
VERIFW: EQU $
LR W,A < ADRESSE>32K?
JAGE WNORM
LAI '22
BR ADRFAT
WNORM: EQU $ < ADRESSE DANS LE CHARGEUR?
IF MEMDSK,,,M100
CP MAXMEM
JGE DEPLAC
STB 0,W < NORMAL. PLACER LA VALEUR
M100: VAL 0
IF MEMDSK,M100,M100,
BSR ECRMOT
M100: VAL 0
RSR
IF MEMDSK,,,M100
<***********************************************************************
<* *
<* DEPLACEMENT DU CHARGEUR. *
<* *
<***********************************************************************
DEPLAC: EQU $
PSR B,X,Y < PROTEGER LES REGISTRES DE TRAV.
LA DEUXK < MODIF DE LA TAILLE DE LA DEMAND
SLLS 1
AD ALLOC+2
STA ALLOC+2
LAD ALLOC < DEMANDER 2K
SVC 0
JE PAGOBT
LAI '23 < MEMOIRE NON OBTENUE
BR ADRFAT
PAGOBT: EQU $
LXI -NBCMOD < NB ADRESSES A MODIFIER
< DANS LE COMMON
MODCOM: EQU $
LA &ACCMOD < MODIFICATION
AD DEUXK
STA &ACCMOD
JIX MODCOM
LA DEUXK < MODIFIER LES ADRESSES DE BYTES
SLLS 1
AD IOCBIN+1
STA IOCBIN+1
LA DEUXK
SLLS 1
AD IOCBL+1
STA IOCBL+1
LA DEUXK
SLLS 1
AD DEMCLO+1
STA DEMCLO+1
LA ADDEB < RECOPIE DU CHARGEUR
AD DEUXK
LR A,B
LA ADDEB
LX LGLOAD
MOVE
LA DEUXK < MODIFIER LES REGISTRES DE BASE
ADR A,K
ADR A,L
ADR A,C
ADRI 1,A
ADRP A < ALLER DANS LE NOUVEAU CHARGEUR
LX DEUXK < MISE A 0 DES 2K LIBERES
NGR X
MEMZER: EQU $
STZ &ADDEBX
JIX MEMZER
LA ADDEB < MODIF. DE ADRESSE DEBUT CHARG.
AD DEUXK
STA ADDEB
PLR B,X,Y < RESTAURER LES REGISTRES
STB 0,W < PLACER LA VALEUR
PLR A < MODIFIER ADRESSE DE RETOUR
AD DEUXK
PSR A
RSR
M100: VAL 0
PAGE
IF MEMDSK,M100,M100,
<***********************************************************************
<* *
<* LECTURE D'UN MOT POINTE PAR W DANS A. *
<* *
<***********************************************************************
LECMOT: EQU $
LR W,A < @ DANS SECTEUR
AD ADDTRA
ANDI '7F
LR A,X
LR W,A < N0 SECTEUR
AD ADDTRA
SLRS 7
AD DSKDEB < VERIFICATION LIMITE
CP DSKFIN
JGE ERRDSK
CP LIRDSK+3 < RESIDENT?
JNE LRMT1
LA &ADISK < OUI - LIRE LE MOT
RSR
LRMT1: EQU $
PSR X < NON - ECRIRE SECTEUR COURANT
PSR A
BSR SWRITE
PLR A < LIRE BON SECTEUR
STA LIRDSK+3
LAD LIRDSK
SVC 0
PLR X < LIRE LE MOT
LA &ADISK
RSR
<***********************************************************************
<* *
<* ECRITURE D'UN MOT POINTE PAR W CONTENU DANS B. *
<* *
<***********************************************************************
PLAMOT: EQU $
PSR A < @ DANS SECTEUR
LR W,A
AD ADDTRA
ANDI '7F
LR A,X
LR W,A < N0 SECTEUR
AD ADDTRA
SLRS 7
AD DSKDEB < VERIFICATION LIMITE
CP DSKFIN
JGE ERRDSK
CP LIRDSK+3 < RESIDENT?
JNE PLMT1
STB &ADISK < OUI - PLACER LE MOT
PLR A
RSR
PLMT1: EQU $
PSR X < NON - ECRIRE SECTEUR COURANT
PSR A
BSR SWRITE
PLR A < LIRE BON SECTEUR
STA LIRDSK+3
LAD LIRDSK
SVC 0
PLR X < PLACER LE MOT
STB &ADISK
PLR A
RSR
ERRDSK: EQU $
LAI '31 < ERREUR DISQUE
BR ADRFAT
<***********************************************************************
<* *
<* CONVERSION DE 4 CARACTERES EN BINAIRE(DANS B) *
<* *
<***********************************************************************
SPHEXA: EQU $
LXI -4
HEXA1: EQU $
LBY &RELBEN < TRAITER UN CARACTERE
ADRI -'30,A
CPI 9
JLE HEXA2
ADRI -7,A
HEXA2: EQU $
JAL HEXA3 < VERIFIC@ATION
CPI 'F
JG HEXA3
SLLS 12
SCLD 4
JIX HEXA1
LAI 0
RSR
HEXA3: EQU $
LAI 1
RSR
<***********************************************************************
<* *
<* SP D'ECRITURE SUR DISQUE *
<* *
<***********************************************************************
WRITED: EQU $
LA LIRDSK+3
STA ECRDSK+3
LAD ECRDSK
SVC 0
RSR
M100: VAL 0
PAGE
<***********************************************************************
<* *
<* IMPRESSION DU CONTENU DE A. *
<* *
<***********************************************************************
ECRADR: EQU $
SLRD 16 < PREPARER LE DECOUPAGE PAR 4 BIT
LXI -4
CARSUI: EQU $
SLLD 4 < ISOLER 4 BITS
ADRI '30,A < CARACTERE IMPRIMABLE
CPI '39
JLE $+2
ADRI 7,A
STBY &SORHEX < MISE DANS LE BUFFER
LAI 0
JIX CARSUI
STZ &SORHEX
LA BLQ < METTRE '
STA BUFFER
JMP SORTI6
<***********************************************************************
<* *
<* SORTIE DE TROIS CARACTERES. *
<* *
<***********************************************************************
PRECAR: EQU $
LA ADSTOC < PLACER 3 CARAC. DANS LE BUFFER
LB ADSTOC+1
SLLD 8
STA BUFFER
STB BUFFER+1
JMP SORTI3
<***********************************************************************
<* *
<* SORTIE D'UN MESSAGE SUIVANT LE NOMBRE DE CARACTERES. *
<* *
<***********************************************************************
SORTI6: EQU $
LXI 6 < 6 CARACTERES
JMP $+2
SORTI3: EQU $
LXI 3 < 3 CARACTERES
STX IOCBL+2
LXI 0 < X=0 LOG LISTING
JMP APIOCS
MSGRC: EQU $ < SORTIE DE RC-LF
LXI 2
STX IOCBL+2
LXI 0
JMP RETLF
MSGERR: EQU $ < SORTIE D'UN MESSAGE
LXI 8
STX IOCBL+2
LXI 1 < X=1 ERROR LISTING
SLRD 4 < NUMERO ERREUR
SLLS 4
SLLD 4
AD TRENTE
STA BUFFER+3
LAD ERREUR
JMP INBUF4
ENTMOT: EQU $ < PREPARATION DU MESSAGE
LXI 6
STX IOCBL+2
LXI 0
INBUF4: EQU $
XR A,W
LB 0,W
STB BUFFER+1
LB 1,W
STB BUFFER+2
XR A,W
RETLF: EQU $ < CR-LF
LA RCLF
STA BUFFER
APIOCS: EQU $ < IMPRESSION
LAD IOCBL
SVC 0
RSR
PAGE
IF MEMDSK,,,M100
<***********************************************************************
<* *
<* MISE A ZERO DU CHARGEUR EN FIN DE TRAITEMENT. *
<* *
<***********************************************************************
ZEROCH: EQU $
LA ADLANC <EMPILER L'ADRESSE DE LANCEMENT
LR A,K
LA ADDEB < MISE A ZERO
LR A,B
ADRI 1,A
LX LGZERO
FINZER: EQU $
STZ &AFINZ
MOVE
LAI '12 < RESTAURER LE ALT-MODE
WORD '1EB5
ADRI 1,K < RETOUR AU CCI POUR
LR K,A < DEBUG EVENTUEL
SVC 0
ADRI -1,K
RSR < LANCEMENT DU PROGRAMME
M100: VAL 0
DEBPG: WORD 0
WORD 1 < RETOUR AU CCI
FITEM: EQU $
LGIT: VAL FITEM-DBCHIT*2
SIZE: EQU ZERO+LGIT
PAGE
<***********************************************************************
<* *
<* GENERATION DU CHARGEUR EN TANT QUE ITEM. *
<* *
<***********************************************************************
LOCAL
LONGR: VAL FITEM-DITEM
DEMSGN: WORD '8402 < DEMANDE GENERATION
WORD DITEM-ZERO*2
WORD LONGR*2
WORD 6
PROG
WORD DEMSGN+128
WORD TOUDEB+128
GENERE: EQU $
LRP L < INITIALISATIONS DES BASES
LR L,C
LA -2,L
LR A,L
LA -1,C
LR A,C
LAD KSTORE-1
LR A,K
DEM: EQU $
LAD DEMSGN
SVC 0
JE FIN
LAD CCI
SVC 0
JMP DEM
FIN: EQU $
LAD CCI
SVC 0
JMP FIN
END GENERE
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.