IDP         "CALL - RELEASE 15/04/1982"
         IDP         "JOHN F. COLONNA"
         EOT         #SIP DEFINITION CMS5#
NMPROC:  VAL         "XX"            < ????!!! (A CAUSE DE #CTE ITEM#)
         EOT         #SIP DEFINITION ITEM#
NOCMO::  VAL         2               < NOMBRE D'OCTETS PAR MOT.
         IDP         "VERSION SOLAR SOUS CMS5"
<
<
<        P R O C E S S E U R   D E   C A L L
<        D ' A P P E L   D E   P R O C E S S E U R S  :
<
<
<        FONCTION :
<                      CE PROCESSEUR EST UN PROCESSEUR DE BASE DE
<                    CMS5 . IL EST PAPPELE PAR LE CCI.
<                    IL IDENTIFIE LE PROCESSEUR DEMANDE
<                    PAR L'UTILISATEUR , ET EVENTUELLEMENT
<                    UN NUMERO DE COMPTE SI NECESSAIRE.
<                    IL RECUPERE LA TAILLE REELLE DU PROCESSEUR
<                    FAIT UNE DEMANDE D'ALLOCATION MEMOIRE ,
<                    DEMANDE LE CHARGEMENT A MSP , ET
<                    ENFIN LUI PASSE LA MAIN.
<
<
<        FORMAT D'UN PROCESSEUR :
<                    SLO A SLO+'E : RESERVES POUR LE CHRAGEMENT ,
<                    SLO+'F : TAILLE EN OCTETS DU PROCESSEUR ,
<                             A T T E N T I O N  : SI CETTE TAILLE EST
<                              NEGATIVE, ALORS LA TAILLE RELLE UTILISEE
<                              EST SA VALEUR ABSOLUE, A LAQUELLE ON
<                              AJOUTE 2K MOTS...
<                    SLO+'10 : P TRANSLATABLE DE LANCEMENT DU
<                              PROCESSEUR.
<        LA PARTIE CHARGEE VA DE SLO+'F A ......
<
<
         PROG
ZERO:    EQU         $
         DZS         2               < POUR L'INTEGRITE DE CALLP
                                     < LORS DE SON RUN PAR CCI.
<
< PILE DU PROCESSEUR CALLP :
<
PILCAL:  DZS         5               < LA PILE DOIT ETRE AVANT LE
                                     < BIAS , SINON GARE AU CHARGEMENT.
CALCCI:  WORD        '0001           < APPEL AUU CCI APRES LE LOAD.
LOAD:    EQU         $
<
<
<        E N T R Y   D E   C H A R G E M E N T  :
<
<
<        ON A ICI :
<                    A=@TABLE DES ARGUMENTS DE CHARGEMENT POUR MSP.
         SVC         0               < CHARGEMENT.
AJNE:    JNE         $               < S'IL Y A ERREUR , C'EST QUE
                                     < LE PROCESSEUR A ETE DELETE
                                     < ENTRE LE MOMENT DE LA RECUPERATION
                                     < DE SA TAILLE , ET MAINTENANT ;
                                     < ON FAIT UN 'JMP $' DONT ON SORTIRA P
                                     < PAR UN 'ALT-MODE'.
         LAI         CALCCI-ZERO
         SVC         0               < D E B U G   FACULTATIF DU
                                     < PROCESSEUR AVANT SON ENTRY.
LJE::    VAL         $-AJNE          < AMPLITUDE DU SAUT...
         RSR                         < DEPILEMENT DU P TRANSLATABLE
                                     < DE LANCEMENT DU PROCESSEUR.
                                     < ET RUN ......
X2:      VAL         $-ZERO
X2:      VAL         '0F-X2          < NBRE DE MOTS A RAZER POUR
                                     < ARRIVER AU 'BUAS'.
         DZS         X2
<
<
<        1 E R E   A D R E S S E   D E   C H A R G E M E N T  :
<
<
BIAS:    EQU         $
         WORD        LCALLP+'80      < @DU LOCAL DE CALLP.
<
<
<        E N T R Y   D E   C A L L P   P O U R   C C I  :
<
<
DEBUT:   EQU         $+2
         LRP         L
         LA          -1,L
         LR          A,L             < L=@LOCAL DE CALLP.
         WORD        '8580           < BRANCHEMENT AUX INITIALISATIONS.
         PAGE
<
<
<        L O C A L   D E   C A L L P  :
<
         TABLE
COMAND:  DZS         LCCI/NOCMO      < MEMORISATION DE LA COMMANDE D'APPEL
                                     < DE "!CALL"...
         BYTE        '04;0           < POUR LE TRANSFERT VERS LA ZONE DE
                                     < CODAGE DES NOMS D'ITEMS...
         LOCAL
LCALLP:  EQU         $
         WORD        CALLP           < @DE DEBUT DE CALLP.
         DZS         10              < POUR IMPLANTER LA FIN DES
                                     < NOMS DES PROCESSEURS A
                                     < CHARGER.
VALEUR:  DZS         2               < DESTINE A CONTENIR LA TAILLE
                                     < OCTETS REELLE DU PROCESSEUR.
                                     < ET SON P DE LANCEMENT.
X1:      VAL         VALEUR-BIAS     < DEPLACEMENT OCTET DU BIAS AUX
                                     < 2 MOTS DE VALEUR.
ACALLP:  WORD        CALLP           < ENTRY POINT DE !CALL POUR LES
                                     < ALT-MODES.
ALOAD:   WORD        LOAD            < @ DU MODULE EXECUTANT LE
                                     < CHARGEMENT DU PROCESSEUR PAR
                                     < MSP , ET LE LANCEMENT DU PRO-
                                     < CESSEUR.
ABIAS:   WORD        BIAS            < BIAS DE CHARGEMENT DU PROCESSEUR.
AXBIAS:  WORD        BIAS,X          < POUR LE MODE 'Q' AUTOMATIQUE.
ACCCI:   WORD        CALCCI          < ADRESSE DE L'ARGUMENT DU 'SVC' SUIVANT
                                     < LE CHARGEMENT DU PROCESSEUR.
APIL:    WORD        PILCAL          < @PILE DU PROCESSEUR.
APRINT:  WORD        PRINT           < ROUTINE D'EMISSION MESSAGE.
<
< CONSTANTES :
<
T800:    WORD        '800            < '800 OCTETS,
T1000:   WORD        '1000           < '1000 OCTETS (2K MOTS).
KIN:     WORD        -1              < COMPTAGE DES RE-ENTREES...
<
< MESSAGES :
<
M1:      BYTE        '0D;'0A
         ASCI        " LOAD AND RUN "
M2:      BYTE        '0D;'0A
         ASCI        "MODE= "
M3:      BYTE        '0D;'0A
         ASCI        "ACN="
M4:      BYTE        '0D;'0A
         ASCI        "NOM="
M5:      BYTE        '07;"?"
         BYTE        '0D;'0A
HELP:    BYTE        '6D;" "
         ASCI        "F=FICHIER DE COMMANDE,"
         BYTE        '6D;" "
         ASCI        "P=PRIVE,"
         BYTE        '6D;" "
         ASCI        "Q=SYSTEME,"
         BYTE        '6D;" "
         ASCI        "R=ACN,"
         BYTE        '6D;" "
         ASCI        "S=CCI."
LHELP::  VAL         $-HELP*NOCMO
<
< DEMANDES A CMS4 :
<
DEMH:    WORD        '0202           < EMISSION DU MESSAGE HELP.
         WORD        HELP-ZERO*NOCMO
         WORD        LHELP
MESGI:   WORD        '0101           < LECTURE AVEC ECHO SUR IN.
         WORD        0               < @OCTET DU MESSAGE.
         WORD        0               < COMPTE OCTETS.
MESGO:   WORD        '0202           < ECRITURE SUR OUT.
         WORD        0               < @OCTETS DU MESSAGE.
         WORD        0               < COMPTE OCTETS.
CCI:     WORD        '0001           < RETOUR AU CCI.
MEM:     WORD        '0004           < DEMANDE D'ALLOCATION MEMOIRE.
         WORD        0
         WORD        0               < TAILLE OCTETS DEMANDEE.
DEMLV:   WORD        '0002           < DEMANDE AU SYSTEME DE GESTION
                                     < DES NOMS.
         WORD        BIAS-ZERO*NOCMO < @OCTETS DU NOM ET DE LA VALEUR.
         WORD        0               < COMPTE OCTETS.
         WORD        0               < DEPLACEMENT DE LA VALEUR
                                     < PAR RAPPORT A L'ORIGINE DU NOM.
DEMOUT:  WORD        '0202           < DEMANDE D'EMISSION MESSAGES.
         WORD        0
         WORD        0
DEMTS:   WORD        '010A           < POUR DISCRIMINER BATCH ET TS.
         WORD        0
         WORD        1
LCOM::   VAL         LBUFES*NOCMO    < LONGUEUR DES COMMANDES.
LEOT::   VAL         1+1             < EN EFFET LE FICHIER DE COMMANDE EST
                                     < ENCADRE PAR UN LIMITEUR, CE QUI FAIT
                                     < DONC 1+1 CARACTERES EN PLUS...
DEMCOM:  WORD        '0008           < RECUPERATION DE LA COMMANDE D'APPEL.
         WORD        COMAND-ZERO*NOCMO
         WORD        LCCI
         WORD        0               < (PAS DE 'ZDC'...)
<
<
<        I T E M   C O U R A N T  :
<
<
NITEM:   WORD        0;0;0           < PAS D'ITEM COURANT.
         BYTE        '04;0
LNITEM:  VAL         $-NITEM
         DZS         LTN-LNITEM
ITEM:    DZS         LCOM+LEOT/NOCMO
         COMMON
KOM:     EQU         $
<
< MESSAGE COURANT :
<
ABUF:    WORD        0               < RELAI RELATIF MESSAGE COURANT.
ABUFX:   WORD        BUF,X           < POUR LE TRANSFERT DES NOMS D'ITEMS.
ABUFA:   WORD        0               < RELAI ABSOLU MESSAGE COURANT.
XBUF:    WORD        0               < INDEX COURANT MESSAGE COURANT.
ACOMAN:  WORD        COMAND,X        < ANALYSE DE LA COMMANDE D'APPEL...
BUF:     DZS         LCOM/NOCMO
         BYTE        '04;0           < PAR PRUDENCE : CAS DES
                                     < MESSAGES SANS 'EOT'.
MITEM:   BYTE        6;" "
         ASCI        "ITEM="
MERRC:   BYTE        13;'6D
         ASCI        "ERREUR CCI !"
NOMIT:   DZS         LNITEM
<
< RELAIS DIVERS :
<
ATEOT:   WORD        TEOT            < TEST FIN DE MESSAGE.
AGTCAR:  WORD        GTCAR           < ACCES CARACTERE POUR LES
                                     < CODAGES DE NOMS D'ITEM.
ACOD:    WORD        CODAGE          < CODAGE DES NOMS D'ITEM.
ANIT0:   WORD        NITEM+0
ANIT1:   WORD        NITEM+1
ANIT2:   WORD        NITEM+2
ANITEM:  EQU         ANIT0           < RELAI VERS LE NOM DE
                                     < L'ITEM COURANT.
LIMIT:   WORD        0               < CONTIENT EN TEMPORAIRE
                                     < LE CARACTERE COURANT DE FIN DE
                                     < MESSAGE EQUIVALENT A 'EOT'
                                     < POUR CHAQUE ITEM.
C10:     WORD        10
CFFF:    WORD        '0FFF           < RAZ DES BITS 0 A 3.
F3:      WORD        0               < FONCTION DE CODAGE NOMIT.
KCAR:    WORD        0               < COMPTEUR DES CARACTERES MESSAGES.
<
< DEMANDES A CMS4 :
<
CCINT:   WORD        '0002           < APPEL CCI NON INTERACTIF.
         WORD        BUF-ZERO*NOCMO  < SUR LE MESSAGE COURANT.
         WORD        LCOM
DEMIN:   WORD        '0101           < LECTURE ASCI AVEC ECHO.
         WORD        BUF-ZERO*NOCMO
         WORD        LCCI
<
< ACCES A L'ITEM COURANT :
<
IEG:     WORD        0               < INDEX COURANT DE L'ITEM.
AITEM:   WORD        ITEM,X          < RELAI D'ACCES A L'ITEM.
ANOMC:   WORD        0               < RELAI TEMPORAIRE VERS LE
                                     < NOMIT EN COURS DE CODAGE.
NCP:     WORD        LCOM+LEOT       < NBRE D'OCTETS D'UN ITEM.
DEMSGN:  WORD        '8502           < ACCES A UN ITEM.
         WORD        NITEM-ZERO*NOCMO
         WORD        LTN*NOCMO+LCOM+LEOT
         WORD        -1
         PAGE
<
<
<        P R O C E S S E U R   D E   C A L L  :
<
<
         PROG
CALLP:   EQU         $
         LRM         C,L,K
         WORD        KOM+128
         WORD        LCALLP+128
         WORD        PILCAL
         LA          ACALLP
         WORD        '1EB5           < POSITIONNEMENT DU PRESC SUR
                                     < L'ENTRY POINT DE !CALL.
         IC          KIN             < PREMIERE ENTREE ???
         JG          CALLP1          < NON...
<
< CAS DE LA PREMIERE ENTREE :
<
         LAD         DEMCOM
         SVC         0               < RECUPERATION DE LA COMMANDE D'APPEL :
         LXI         0
         LBY         &ACOMAN         < (A)=PREMIER CARACTERE :
         CPI         "!"             < VALIDATION...
         JNE         $               < ???!?!???!
         ADRI        1,X
         LBY         &ACOMAN         < (A)=DEUXIEME CARACTERE :
         CPI         "C"             < VALIDATION...
         JNE         $               < ??!??!
         ADRI        1,X
         LBY         &ACOMAN         < (A)=TROISIEME CARACTERE :
         CPI         "."             < EST-CE LA COMMANDE ABREGEE "!C." ???
         JNE         CALLP1          < NON...
<
< CAS DE LA COMMANDE ABREGEE "!C.,
< ELLE VA PROVOQUER UN MODE "F"
< AUTOMATIQUE :
<
         LYI         0               < (Y)=INDEX DE 'BUF',
                                     < (X)=INDEX DE 'COMAND'.
CALLP3:  EQU         $
         ADRI        1,X
         LBY         &ACOMAN         < TRANSFERT DU
         CPI         '0D
         JNE         CALLP4
         LAI         '04             < TOUT 'R/C' EST TRANSFORME EN 'EOT'...
CALLP4:  EQU         $
         XR          X,Y
         STBY        &ABUFX          <              NOM D'ITEM...
         ADRI        1,X
         XR          X,Y
         CPI         '04             < EST-CE FINI ???
         JNE         CALLP3          < NON, AU CARACTERE SUIVANT...
CALLP2:  EQU         $
         JMP         FCAUTO          < VERS LE CODAGE DU NOM DE L'ITEM...
<
< CAS DES APPELS NORMAUX :
<
CALLP1:  EQU         $
<
< ENVOI D'UN MESSAGE D'INTRODUCTION :
<
         LBI         23              < 23 OCTETS DE LONG.
         LAD         M1              < @MOT DU MESSAGE D'INTODUCTION.
<
< BOUCLE D'INTERROGATION :
<
E1:      EQU         $
         SLLS        1               < A=@OCTET DU MESSAGE A ENVOYER.
         STA         MESGO+1         < MISE EN PLACE @OCTETS MESSAGE.
         STB         MESGO+2         < MISE EN PLACE COMPTE OCTETS.
E1X1:    EQU         $
         LAD         MESGO
         SVC         0               < ENVOI DU MESSAGE A L'UTILISATEUR.
<
< LECTURE DU MODE DEMANDE PAR L'UTILISATEUR :
<
         LA          ABIAS           < A=@MOT OU METTRE LA REPONSE.
         SLLS        1               < CONVERSION OCTETS.
         STA         MESGI+1
         STA         DEMLV+1         < MISE EN PLACE DE L'@OCTET BIAS.
         LAI         1               < DEMANDE 1 OCTETS.
         STA         MESGI+2
         LAD         MESGI
         SVC         0               < LECTURE DU MODE.
<
< ANALYSE DE LA REPONSE :
<
<        LISTE DES REPONSES POSSIBLES :
<                    ? : ENVOI DU MESSAGE HELP DES MODES,
<                    - F : APPEL D'UN FICHIER DE COMMANDE,
<                    - P : MODE PRIVE : ACN=ACN CONTENU DANS LA DCT ,
<                    - Q : ACCES A UN NOM SYSTEME ,
<                    - R : ACCES A UN NOM SOUS UN AUTRE ACN ,
<                    - S : RETOUR AU CCI.
<
         LBY         &ABIAS          < A=REPONSE.
         CPI         "?"             < EST-CE LE HELP ???
         JNE         E1X2            < NON...
         LAD         DEMH            < OUI,
         SVC         0               < ON L'ENVOIE...
         JMP         E1X1            < ET ON RE-INTERROGE...
E1X2:    EQU         $
         CPI         "F"             < EST-CE UN FICHIER DE COMMANDE ???
         JE          FC1             < OUI...
         ADRI        -'50,A          < TRANSLATION.
         JAL         E2              < ERREUR : CARACTERE NON RECONNU.
         CPI         3
         JG          E2              < ERREUR : CARACTERE NON RECONNU.
         JE          E3              < A=3 : DEMANDE DE RETOUR AU CCI.
<
< CAS D'UNE COMMANDE RECONNUE :
<
         ADRI        5,A             < A=NVP D'ACCES AU NOM :
                                     < NVP=5 : ACCES A HDLLON ,
                                     < NVP=6 : ACCES A HDLLNS ,
                                     < NVP=7 : ACCES A HDLLNU.
         SBT         8               < AFIN DE FAIRE UN APPEL IMPLICITE
                                     < AUX ASSIGNATIONS SYSTEME.
         STBY        DEMLV           < MISE EN PLACE DU NVP DANS DEMLV.
         RBT         8               < RESTAURE A=NVP DEMANDE.
         LYI         6               < POUR MISE EN PL,ACE DE COMPTE
                                     < OCTETS.
         LBI         0               < B=0 A PRIORI.
         CPI         7
         JNE         E4              < DANS LES CAS NVP=5/6 , LE NUMERO
                                     < DE COMPTE EST CONNU : C'EST
                                     < CELUI DU DEMANDEUR , OU :SYS.
<
< CAS NVP=7 : IL FAUT DEMANDER L'ACN DESIRE :
<
         LBI         5               < B=5=DEPLACEMENT DU NOM A
                                     < LA SUITE DE L'ACN.
         STB         MESGI+2         < C'EST AUSSI LA LONGUEUR DE
                                     < L'ACN A LIRE.
         LAD         M3
         SLLS        1
         STA         MESGO+1         < MISE EN PLACE @OCTETS D'UN MESSAGE
                                     < DE DEMANDE ACN.
         STY         MESGO+2         < Y=6=LONGUEUR DU MESSAGE.
         LAD         MESGO
         SVC         0               < ENVOI MESSAGE 'ACN='.
         LAD         MESGI
         SVC         0               < LECTURE DE L'ACN : ON DEMANDE
                                     < 5 OCTETS  LE DERNIER DOIT
                                     < ETRE UN EOT , SOUS PEINE
                                     < DE RETOUR EN ERREUR , TANT
                                     < PIS POUR LE DEMANDEUR.
<
< DEMANDE DU NOM DU PROCESSEUR :
<
E4:      EQU         $
<        ON A ICI :
<                    Y=6 ,
<                    B=0 SI ACN NON DEMANDE ,
<                     =5 SI ACN DEMANDE.
         LA          MESGI+1         < @OCTET DU MESSAGE ENTRE.
         ADR         B,A             < TRANSLATION EVENTUELLE SUIVANT
                                     < QU'IL Y A OU PAS UN ACN.
         STA         MESGI+1
         LAI         20
         STA         MESGI+2         < MISE EN PLACE DE LA LONGUEUR
                                     < MAX DU NOM DU PROCESSEUR.
         LAD         M4
         SLLS        1
         STA         MESGO+1         < @OCTET DU MESSAGE DE DEMANDE
                                     < DU NOM.
         STY         MESGO+2         < LONGUEUR DU MESSAGE D'INVITATION.
         LAD         MESGO
         SVC         0               < ENVOI DU MESSAGE : 'NOM='.
<
< LECTURE DU NOM DU PROCESSEUR :
<
         LAD         MESGI
         SVC         0               < LECTURE DU NOM : CELUI CI DOIT
                                     < SE TERMINER PAR 'EOT' SOUS
                                     < PEINE DE RETOUR EN ERREEUR.
<        NOTA :
<                    ON A MAINTENANT A PARTIR DE 'BIAS' ,
<                    LE NOM DU PROCESSEUR DESIRE , AVEC
<                    EVENTUELLEMENT DEVANT LE NUMERO
<                    DE COMPTE.
<
         LAI         1               < (A)=FONCTION D'APPEL DU 'CCI'...
PROCOT:  EQU         $               < POINT D'ENTREE MODE 'Q' IMPLICITE...
         STA         &ACCCI          < DANS LE CAS D'UN APPEL EXPLICITE, ON
                                     < DEVRA FAIRE "!GO" POUR ENTRER DANS LE
                                     < PROCESSEUR...
         LAI         -1
         WORD        '1EB5           < INHIBITION DES ALT-MODES
                                     < SOLITAIRES...
<
< ACCES A LA TAILLE REELLE DU PROCESSEUR :
<
         LAI         2*X1+4          < COMPTE OCTETS=ZONE DE
                                     < RANGEMENT DU NOM (+ACN) , PLUS
                                     < 2 MOTS POUR LA TAILLE REELLE , ET
                                     < LE P DE LANCEMENT.
         STA         DEMLV+2
         LAI         2*X1            < DEPLACEMENT DE LA VALEUR PAR
                                     < RAPPORT A L'ORIGINE DU NOM.
         STA         DEMLV+3
         LAD         DEMLV
         SVC         0               < DEMANDE TAILLE REELLE.
         JNE         E2              < ERREUR : LE NOM N'EXISTE PAS , OU
                                     < LE SGN N'A PAS ETE ASSIGNE ....
<
< CAS OU ON POSSEDE LA TAILLE REELLE
< DANS VALEUR ET LE P DE LANCEMENT
< DANS VALEUR+1 :
<
<
< DEMANDE D'ALLOCATION MEMOIRE :
<
         LA          VALEUR          < A=TAILLE OCTETS REELLE DU
                                     < PROCESSEUR.
         LYI         0               < Y=CONSTANTE ADDITIVE NULLE A PRIORI.
         JAGE        EE12            < OK, TAILLE>=0.
         NGR         A,A             < NON, A=VALEUR ABSOLUE (TAILLE),
         LY          T1000           < ET Y=CONSTANTE ADDITIVE 2K MOTS.
EE12:    EQU         $
         STA         DEMLV+2         < NOUVEAU COMPTE OCTETS DE DEMLV.
         ADR         Y,A             < TAILLE RELLE DU PROCESSEUR.
         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        E2              < ERREUR DE TAILLE...
         CP          T800            < 1K MOT ???
         JLE         E5              < OUI, ON LES A DEJA...
         LY          T1000           < NON, ALLONS VOIR 2K, ET LA SUITE...
         LXI         6               < 6 TAILLES SONT RECONNUES (2K,
                                     < 4K, 6K, 8K, 10K ET 12K).
EE11:    EQU         $
         CPR         Y,A             < LA TAILLE COURANTE SUFFIT-ELLE ???
         JLE         EE10            < OUI...
         XR          A,Y             < NON,
         AD          T1000           < ON PASSE 2K AU DESSUS...
         XR          A,Y
         JDX         EE11            < AU SUIVANT,
         JMP         E2              < ERREUR, NON DISPONIBLE !!!
EE10:    EQU         $
         STY         MEM+2           < Y=TAILLE MEMOIRE NECESSAIRE.
         LAD         MEM
         SVC         0               < DEMANDE D'ALLOCATION 2K OU 4K.
         JE          $+2             < OK.
         ACTD                        < E R R E U R   S Y S T E M E ....
E5:      EQU         $
<
< PREPARATION DU CHARGEMENT :
<
         STZ         DEMLV+3         < LA VALEUR (PROCESSEUR) COMMENCERA
                                     < AU BIAS ET VA DONC RECOUVRIR
                                     < LE NOM (+ACN).
         LA          VALEUR+1        < RECUPERATION DU P DE LANCEMENT.
         PSR         A               < ET EMPILEMENT EN VUE DU RSR.
         LAI         DEBUT-ZERO
         WORD        '1EB5           < REINITIALISATION DU PRESC.
         LAD         DEMLV
         BR          ALOAD           < VERS LE CHARGEMENT QUI EST
                                     < IMPLANTE EN TETE A FIN QUE
                                     < SON CODE NE SOIT PAS ECRASE
                                     < LORS DU CHARGEMENT.
<
<
<        E R R E U R S   U T I L I S A T E U R  :
<
<
E2:      EQU         $
         LAD         M5              < MESSAGE D'ERREUR.
         SLLS        1
         STA         MESGO+1
         LAI         4               < LONGUEUR DU MESSAGE D'ERREUR.
         STA         MESGO+2
         LAD         MESGO
         SVC         0               < ENVOI D'UN MESSAGE D'ERREUR
                                     < A L'UTILISATEUR.
         LAD         M2              < A=@MOT DU MESSAGE DE DEMANDE
                                     < DU MODE , EN EFFET , ON
                                     < RECOMMENCE L'INTERROGATION.
         LBI         7               < B=7=LONGUEUR DU MESSAGE DE MODE.
         JMP         E1              < TRY AGAIN.
<
<
<        S O R T I E   D E   C A L L P  :
<
<
E3:      EQU         $
         LAD         CCI
         SVC         0               < RETOUR AU CCI.
         BR          ACALLP          < EN CAS D'UNE COMMANDE DE
                                     < PROCEED.
         PAGE
<
<
<        F I C H I E R   D E   C O M M A N D E  :
<
<
<        FORMAT :
<                      ON TROUVE EN PREMIER CARACTERE DE
<                    L'ITEM, LE CARACTERE UTILISE COMME
<                    LIMITEUR DE FIN ; DE PLUS TOUT CA-
<                    RACTERE EN EXPOSANT (VOIR 'ED') EST
<                    CONVERTI EN UN 'CTRL'.
<                    D'OU LE FORMAT :
<                    <LIM>!M<SUITE DE COMMANDES DE !M><LIM>
<                    (POUR "!M" VOIR 'CMS5'...)
<
<
FC1:     EQU         $
<
<
<        E N T R E E   D U   N O M   D E   L ' I T E M  :
<
<
TASK:    EQU         $
NOK:     EQU         $
         LAD         MITEM
         BSR         APRINT          < POUR DEMANDER LE NOM DE L'ITEM...
         LAD         DEMIN
         SVC         0               < ENTREE D'UN NOM PRESUME.
FCAUTO:  EQU         $               < CAS DE L'APPEL AUTOMATIQUE "!C."...
         LAD         BUF
         ADRI        -1,A            < PAR COMPATIBILITE AVEC CODAGE.
         SBT         0
         STA         ABUF            < RELAI VERS LE BUFFER D'ENTREE.
         BSR         ACOD            < CODAGE SUR 6 CARACTERES.
LOADI:   EQU         $               < CHARGEMENT DE L'ITEM ASSOCIE.
         LAD         NOMIT           < A=@EMETTEUR,
         LB          ANITEM          < B=@RECEPTEUR,
         LXI         3               < X=3 CARACTERES A DEPLACER,
         MOVE                        < MISE EN PLACE DU NOM DE
                                     < L'ITEM COURANT.
         LAI         '85
         STBY        DEMSGN          < MISE EN MODE PRIVE (<ACN>)...
         LAD         DEMSGN
         SVC         0               < TENTATIVE DE LECTURE DE
                                     < L'ITEM ASSOCIE A LA VISU
                                     < ASSIGNEE A CE NVP.
         JE          NLOAD           < OK, IL EXISTE SOUS <ACN>...
         LAI         '86
         STBY        DEMSGN          < NON, MISE SOUS :SYS,
         LAD         DEMSGN
         SVC         0               < TENTATIVE DE LECTURE DE L'ITEM
                                     < SOUS :SYS...
         JE          NLOAD           < OK, L'ITEM EXISTE...
<
< CAS OU L'ITEM N'EXISTE PAS :
<
         LXI         0
MOV1:    EQU         $
         LA          &ABUFX          < TRANSFERT DU NOM
         STA         &AXBIAS         <                  DU PROCESSEUR SYSTEME.
         ADRI        1,X
         LR          X,A
         CPI         LCCI/NOCMO
         JL          MOV1            < AUX CARACTERES SUIVANTS...
         LAI         '86
         STBY        DEMLV           < MISE EN MODE DE CHARGEMENT DES PROCESSEUR
                                     < SYSTEME...
         LAI         6               < AFIN DE NE PLUS AVOIR A FAIRE "!GO"
                                     < POUR RENTRER DANS UN PROCESSEUR LORS
                                     < DES APPELS IMPLICITES...
                                     < (A)=FONCTION NEUTRE DES 'SVC'.
         JMP         PROCOT          < VERS LE CHARGEMENT AUTOMATIQUE...
<
< CAS OU L'ITEM EXISTE :
<
NLOAD:   EQU         $               < L'ITEM ASSOCIE EST LA...
         LXI         0
         LBY         &AITEM          < RECUPERATION DU 1ER CARACTERE
                                     < DE L'ITEM COURANT,
         STA         LIMIT           < QUI DEFINIT, POUR CET ITEM
                                     < LE CARACTERE DE FIN DE MESSAGE
                                     < EQUIVALENT A 'EOT'.
SENDV:   EQU         $
LOOP2:   EQU         $
         LAD         BUF
         SBT         0
         STA         ABUF            < ABUF RELAYE BUF A PRIORI.
         STZ         XBUF
         IC          XBUF            < XBUF=1 A PRIORI.
<
< ENTREE DU MESSAGE COURANT :
<
LOOP3:   EQU         $
         LYI         LCOM            < NBRE D'OCTETS PAR CARTE.
         LXI         0               < INDEX INITIAL BUFFER.
         STZ         KCAR            < RAZ COMPTEUR DES CARACTERES
                                     < DU MESSAGE COURANT (NON
                                     < COMPRIS L'EOT).
         LAI         1               < INDEX COURANT DE L'ITEM,
         STA         IEG             < QUE L'ON MET EN TEMPORAIRE.
GETCAR:  EQU         $
         LA          IEG
         CP          NCP             < VALIDATION DE 'IEG'...
         JL          F1              < OK...
         QUIT        1               < ?!???!?!?!
         JMP         TASK
<
< ACCES AU CARACTERE COURANT :
<
F1:      EQU         $
         PSR         X
         LR          A,X
         LBY         &AITEM          < A=OCTET COURANT DE L'ITEM.
         CP          LIMIT           < EST-CE LE CARACTERE DE FIN
                                     < DE MESSAGE COURANT ???
         JNE         GET3            < NON.
         LAI         '04             < OUI, ON LE REMPLACE PAR 'EOT'.
GET3:    EQU         $
         IC          IEG             < PROGRESSION IEG.
         PLR         X
         TBT         8               < EST-CE UN CTRL-XXX ???
         JNC         GET1            < NON, CARACTERE NORMAL.
         RBT         8               < OUI, A=CTRL-XXX.
         ADRI        -'40,A
GET1:    EQU         $
         STBY        &ABUF
         CPI         '04             < EST-CE UN 'EOT' ???
         JE          GET2            < OUI, FIN DE MESSAGE.
         IC          KCAR            < COMPTAGE DES CARACTERES
                                     < DIFFERENTS DE 'LIMIT'.
         ADRI        1,X             < PROGRESSION INDEX BUFFER.
         CPR         X,Y             < 80 OCTETS ???
         JNE         GETCAR          < NON, AU SUIVANT.
GET2:    EQU         $
<
<        A P P E L   C C I   L O C A L   I N T E R P R E T A T I F  :
<
CARTC:   EQU         $
         LAD         CCINT
         SVC         0               < APPEL DU CCI NON INTERACTIF.
         JE          F8              < OK...
         LAD         MERRC
         BSR         APRINT          < EREUR DE CARTE CONTROLE...
F8:      EQU         $
         QUIT        1               < RETOUR AU CCI, AFIN D'INTERPRETER CE
                                     < QUI EST DANS LE BUFFER...
         JMP         TASK            < ET RETOUR A 'TASK'...
<
<
<        C O D A G E   < N O M >   E N   < N O M C >  :
<
<
<        FONCTION :
<                      CETTE ROUTINE CODE SUR 6 CARACTERES
<                    <NOMC> LES 'N' CARACTERES <NOM>
<                    D'UN NOEUD.
<                      CECI EST FAIT SUIVANT UN SUPERBE
<                    ALGORITHME DE COMPACTAGE PAS MAL
<                    UNIVOQUE ...
<
<
<        ARGUMENT :
<                    C=@DESCRIPTEUR ASSOCIE AU NVP COURANT.
<
<
<        RESULTAT :
<                    X=0 (OK).
<
<
CODAGE:  EQU         $
<
< INITIALISATION DU CODEUR :
<
         LAD         NOMIT           < A=@NOMIT COURANT.
         SBT         0               < BIT D'INDEX.
         STA         ANOMC           < GENERATION D'UN RELAI TEMPORAIRE
                                     < VERS LE NOM CODE COURANT.
         STZ         F3              < RAZ DE LA FONCTION F3.
         LYI         3               < 2*3 CARACTERES A METTRE A BLANC.
         LXI         0               < INDEX DE MISE A BLANC.
         LAI         '20
         SBT         2               < A='SPACE''SPACE'.
ETI1:    EQU         $
         STA         &ANOMC          < MISE DE <NOMC> A 'SPACE'.
         ADRI        1,X             < INDEX DE RAZ.
         CPR         X,Y
         JNE         ETI1            < NEXT...
         LYI         -1              < Y=LONGUEUR COURANTE.
                                     <   =F1=LONGUEUR DU MOT ENTRE.
         LBI         0               < B=F2.
<
<        UTILISATION DES REGISTRES :
<
<                    B=F2=EOR(K(I)) : EOR SUR TOUS LES
<                      CARACTERES DE K(4) A K(L).
<                      F2=EOR(K(4),K(5),...,K(L)) ,
<                    Y=LONGUEUR COURANTE DU NOM ,
<                     =F1=LONGUEUR COURANTE DU MOT ENTRE (NBRE DE
<                      CARACTERES NON COMPRIS 'EOT') ,
<                    F3=CF. F2  , MAIS A CHAQUE EOR , LE
<                       RESULTAT INTERMEDIAIRE EST DECALE
<                       CIRCULAIREMENT.
<
<
< RECUPERATION DES 3 PREMIERS CARACTERES :
<
         BSR         AGTCAR          < A=K(1).
         JE          ETI2            < MOT VIDE, C'EST FINI.
         STBY        &ANOMC          < STORE : C(1)=K(1).
         BSR         AGTCAR          < A=K(2).
         JE          ETI2            < LE MOT N'A QU'UNE LETTRE.
         STBY        &ANOMC          < C(2)=K(2).
         BSR         AGTCAR          < A=K(3).
         JE          ETI2            < LE MOT N'A QUE 2 LETTRES.
         STBY        &ANOMC          < C(3)=K(3).
<
< CODAGE DES CARACTERES K(4),...,K(L) :
<
ETI3:    EQU         $
         BSR         AGTCAR          < A=K(I) , I=4,...,L.
                                     < (L DESIGNANT LA LONGUER DU
                                     < MOT A CODER).
         JE          ETI4            < ARRET DU CODAGE SUR 'EOT'.
         ADR         Y,A             < LE CARACTERE COURANT (A) EST
                                     < PONDERE PAR SA POSITION (X).
                                     < DANS LE MOT.
                                     < K(I)=K(I)+I.
         EORR        A,B             < CALCUL DE F2 :
                                     < F2=EOR(F2,K(I)).
         ADR         A,B             < F2=F2+K(I).
         EOR         F3              < CALCUL DE F3 :
                                     < A=EOR(F3,K(I)).
         SCLS        1               < DECALAGE CIRCULAIRE.
         STA         F3              < F3=SCLS(EOR(F3,K(I)),1).
         JMP         ETI3            < CODAGE DU CARACTERE SUIVANT.
<
< MISE SOUS FORME ASCI DES FONCTIONS F2 & F3 :
<
ETI4:    EQU         $
         LBY         F3              < A=OCTET0(F3).
         AD          F3              < A=F3+OCTET0(F3).
         ANDI        '7F             < A=OCTET0(F3)+OCTET1(F3).
                                     < (SUR 7 BITS).
         CPI         "Z"
         JLE         ETI5
         ADRI        -'30,A          < F3 EST MIS SOUS LA FORME D'UN
                                     < CODE INFERIEUR AU 'Z'.
ETI5:    EQU         $
         CPI         " "
         JG          ETI6
         ADRI        '30,A           < F3 EST DONC ENTRE LE 'Z'
                                     < (COMPRIS) ET LE 'SPACE' (NON
                                     < COMPRIS).
ETI6:    EQU         $
<        ON A ICI :
<                    A=F3=CARACTERE ASCI DE '!' (='21) A 'Z' (='5A) ;
<                          L'AMBIGUITE EST DONC POUR F3 DE '5A-'21.
         XR          A,B             < B=F3 , A=F2 A METTRE EN FORME.
         ANDI        '7F             < MISE SUR 7 BITS.
         CPI         "Z"
         JLE         ETI7
         ADRI        -'30,A          < ON RAMENE F2 A UN CODE INFERIEUR
                                     < A CELUI DU 'Z'.
ETI7:    EQU         $
         CPI         "0"
         JGE         ETI8
         ADRI        '20,A           < ON TENTE DE RAMENER F2 APRES
                                     < LE CODE DU '0' (ZERO).
         JMP         ETI7            < POURSUIVONS LA TENTATIVE...
ETI8:    EQU         $
<        ON A ICI :
<                    A=F2=CARACTERE ASCI ALLANT DU '0' (COMPRIS)
<                          AU 'Z' (COMPRIS) ; L'AMBIGUITE DE F2 EST DONC
<                          DE '30-'5A :
<                                    AMBIGUITE(F2)<AMBIGUITE(F3).
         SWBR        A,A
         ORR         B,A             < A=F2.F3.
         STA         NOMIT+2         < STORE : C(5)=F2, C(6)=F3.
<
< CODAGE DE LA LONGUEUR DU MOT :
<
ETI2:    EQU         $
<        ON A ICI :
<                    Y=LONGUEUR DU MOT ENTRE (NON COMPRIS 'EOT').
         LR          Y,A
         ADRI        '30,A           < ON MET LA LONGUEUR SOUS FORME
                                     < D'UN CARACTERE ASCI QUI NOUS
                                     < DONNE F1 DONT L'AMBIGUITE EST
                                     < DE '30-.... , MAIS INFERIEUR A
                                     < CELLE DE F2 , ET DONC A CELLE
                                     < DE F3 A FORTIORI.
         LXI         3               < INDEX DE C(4).
         STBY        &ANOMC          < STORE : C(4)=F1.
         LXI         6               < INDEX DE C(7).
         LAI         '04             < 'EON' DE FIN DE NOM CODE.
         STBY        &ANOMC          < STORE : C(7)='EON'.
         LXI         0               < RETOUR OK.
         RSR
         PAGE
<
<
<        A C C E S   A   U N   C A R A C T E R E  :
<
<
<        FONCTION :
<                      CETTE ROUTINE FAIT PROGRESSER L'INDEX
<                    CARACTERE COURANT (X) , LA LONGUEUR COURANTE
<                    DU MOT (X) ET ACCEDE LE CARACTERE COURANT ,
<                    APRES INCREMENTATION DE X ; ENFIN
<                    ELLE DIT SI LE CARACTERE ACCEDE EST
<                    OU N'EST PAS 'EOT'.
<
<
<        NOTA :
<                      UNE REPONSE EQUIVALENTE EST DONNEE
<                    DANS LE CAS OU LA LONGUEUR COURANTE
<                    ATTEINTE EST LA LONGUEUR MAX QUE
<                    PEUT ATTEINDRE UN <NOM>.
<
<
GTCAR:   EQU         $
         ADRI        1,Y             < PROGRESSION LONGUEUR SUIVANTE.
         LR          Y,X
         ADRI        2,X             < X=INDEX CARACTERE DANS 'BUF'.
         BSR         ATEOT           < ACCES CARACTERE COURANT, ET
                                     < TEST DE FIN DE MESSAGE...
         LR          Y,X             < POUR LE STOCKAGE DES 3
                                     < PREMIERS CARACTERES.
         RSR
         PAGE
<
<
<        T E S T   F I N   D E   M E S S A G E  :
<
<
<        ARGUMENT :
<                    X=INDEX DE BUF, DONNE LE
<                      RANG DU CARACTERE A TESTER.
<
<
<        RESULTAT :
<                    A=CARACTERE TESTE (SI CELUI-CI
<                      ETAIT R/C, IL EST REMPLACE
<                      PAR 'EOT'),
<                    CODE DE CONDITIONS POSITION-
<                    NES POUR TEST EN RETOUR JE/JNE...
<
<
TEOT:    EQU         $
         LBY         &ABUF           < A=CARACTERE A TESTER.
         ANDI        '7F             < CARACTERE SUR 7 BITS.
         CPI         '04
         JE          TEOT1           < C'EST EOT...
         CPI         '0D
         JNE         TEOT1           < CE N'EST PAS R/C...
         LAI         '04             < C'EST R/C, ON LE
         STBY        &ABUF           < REMPLACE PAR 'EOT'.
TEOT1:   EQU         $
         RSR
         PAGE
<
<
<        I M P R E S S I O N   D ' U N   M E S S A G E  :
<
<
<        ARGUMENT :
<                    A=@DU MESSAGE A EMETTRE.
<
<
PRINT:   EQU         $
         PSR         X,C
         LR          A,C             < C=@MOT MESSAGE.
         ADR         A,A
         ADRI        1,A             < A=@OCTET DU MESSAGE.
         STA         DEMOUT+1
         LBY         0,C             < A=LONGUEUR MESSAGE.
         STA         DEMOUT+2
         LAD         DEMOUT
         SVC         0               < EMISSION MESSAGE.
         PLR         X,C
         RSR
         PAGE
<
<
<        V A L I D A T I O N   I M P L A N T A T I O N  :
<
<
X120:    VAL         $-ZERO          < LONGUEUR DE !CALL.
X120:    VAL         '3EF-X120       < LONGUEUR DISPONIBLE JUSQU'A 1K.
ZEROV:   EQU         ZERO+X120       < ERREUR VOLONTAIRE D'ASSEM-
                                     < BLAGE SI MAUVAISE IMPLANTATION.
         END         DEBUT



Copyright © Jean-François Colonna, 2022-2022.
Copyright © CMAP (Centre de Mathématiques APpliquées) UMR CNRS 7641 / École polytechnique, Institut Polytechnique de Paris, 2022-2022.