IDP         "FORMATU: FORMATAGE DKU"
         IDP         "RELEASE 03/09/80"
         IDP         "P. FRANCONNET"
         PROG
ZERO:    EQU         $
         DZS         '10             < INTERFACE AVEC LE SYSTEME.
         WORD        RUN
         WORD        ENTRY
RUN:     EQU         $
         LRP         L
         BR          -1,L
<
<          CE PROGRAMME FORMATE LE DISPACK PLACE SUR L'UNITE DE DISQUE 'DKU'
<        EN FAISANT DES DEMANDES D'ECRITURE, PISTE PAR PISTE.
<
<        CHAQUE  ECRITURE SE FAIT AVEC LA FONCTION '6 ,  C'EST-A-DIRE
<        "SYNCHRONISATION SECTEUR 0" ET ECRITURE.
<
<          ERREURS POSSIBLES:
<
<        - ERREUR D'ECRITURE.
<        - ERREUR DE LECTURE ( CAR ON RELIT POUR VERIFICATION).
<        - ERREUR VALIDITE PISTE (PISTE RELUE # PISTE ECRITE).
<
QUANTA:  VAL         3               < QUANTA UTILISE.
NBMPS:   VAL         128             < NOMBRE DE MOTS PAR SECTEUR.
NBSPP:   VAL         24              < NOMBRE DE SECTEURS PAR PISTE.
PILE:    DZS         10              < PILE POUR 'K'
BUDKU:   DZS         NBMPS*NBSPP     < BUFFER DKU (UNE PISTE ENTIERE)
BUDKUF:  EQU         $               < FIN BUFFER DKU
<
<        MESSAGES A ENVOYER PAR LE S/P 'ENVOI'
<
M:       EQU         $
MIMP:    BYTE        '6D;"D"
         ASCI        "KU INACCESSIBLE !!!"
         WORD        0
MDEBF:   BYTE        '6D;"D"
         ASCI        "EBUT FORMATAGE DKU"
         WORD        0
MFINF:   BYTE        '6D;"F"
         ASCI        "IN FORMATAGE DKU"
         WORD        0
MABC:    BYTE        '6D;"B"
         ASCI        "LOC COURANT="
MABC1:   DZS         2
         WORD        0
MERRE:   BYTE        '6D;"E"
         ASCI        "RREUR ECRITURE DKU"
         WORD        0
MERRL:   BYTE        '6D;"E"
         ASCI        "RREUR LECTURE DKU"
         WORD        0
MERRV:   BYTE        '6D;"E"
         ASCI        "RREUR VALIDITE PISTE DKU"
         WORD        0
         COMMON
COM:     EQU         $
AM:      WORD        M               < POUR LE S/P 'ENVOI'.
AXTRAV:  WORD        '8000           < RELAI DE TRAVAIL.
ABUDKU:  WORD        BUDKU           < ADRESSE MOT BUFFER DKU.
AXBUDK:  WORD        BUDKU-1,X       < RELAI INDEXE MOT SUR BUFFER DKU.
LBUDKU:  WORD        BUDKUF-BUDKU    < LONGUEUR MOTS BUFFER DKU.
<
AENVOI:  WORD        ENVOI           < ENVOI D'UN MESSAGE STANDARD.
ACONVA:  WORD        CONVA           < CONVERSION HEXADECIMAL --> ASCI.
<
DMOUT:   WORD        '0202           < ENVOI MESSAGE.
         WORD        0
         WORD        0
DMCCI:   WORD        '0001           < RETOUR CCI.
DMWDKU:  WORD        '8A02           < WRITE DKU AVEC SYNCHRO SECTEUR 0.
         WORD        BUDKU-ZERO*2
         WORD        BUDKUF-BUDKU*2
ABC:     WORD        0               < ADRESSE BLOC COURANT.
ABCD:    WORD        '0000           < ADRESSE BLOC DEBUT.
ABCF:    WORD        'FA00-1         < ADRESSE BLOC FIN.
DMRDKU:  WORD        '8A00           < READ DKU.
         WORD        BUDKU-ZERO*2
         WORD        BUDKUF-BUDKU*2
         WORD        0
<
< DEMANDES CCI :
<
MON:     ASCI        "!DK S0 O"
         BYTE        "N";'04
MOFF:    ASCI        "!DK S0 OFF"
         BYTE        '04;0
MASS:    ASCI        "!ASSIGN A=DK"
         BYTE        "U";'04
MDASS:   ASCI        "!ASSIGN A="
         BYTE        "S";'04
DON:     WORD        '0002           < "!DK S0 ON"
         WORD        MON-ZERO*2
         WORD        80
DOFF:    WORD        '0002           < "!DK S0 OFF"
         WORD        MOFF-ZERO*2
         WORD        80
DASS:    WORD        '0002           < "!ASSIGN A=DKU"
         WORD        MASS-ZERO*2
         WORD        80
DDASS:   WORD        '0002           < "!ASSIGN A=S"
         WORD        MDASS-ZERO*2
         WORD        80
         PROG
         PAGE
ENTRY:   EQU         $
<
<        INITIALISATIONS
<
         LRM         C,K
         WORD        COM+'80         < COMMON.
         WORD        PILE-1          < PILE.
         LA          ABCD            < ADRESSE BLOC DEBUT.
         STA         ABC             < ADRESSE BLOC COURANT.
         LAD         DASS
         SVC         0               < "!ASSIGN A=DKU"...
         JE          E1              < OK, ON L'A...
         LAI         MIMP-M
         BSR         AENVOI          < ET BIEN NON, ON LE DIT...
         JMP         E2              < ET ON SORT...
E1:      EQU         $
         LAD         DON             < OK,
         SVC         0               < "!DK S0 ON"...
         JNE         $               < !?!???!
         LAI         MDEBF-M         < MESSAGE 'DEBUT DE FORMATAGE'.
         BSR         AENVOI
<
<        BOUCLE DE LECTURE-ECRITURE-VALIDATION-INCREMENTATION.
<
FU1:     EQU         $
         LA          ABC
         STA         DMRDKU+3        < ADRESSE BLOC POUR LECTURE FUTURE.
         LRM         Y
         WORD        MABC1-ZERO*2
         BSR         ACONVA          < CONVERSION ASCI BLOC COURANT.
         SLLS        8               < ON N'EDITERA LE NUMERO DE BLOC COURANT
         JANE        FU11            < QUE DE TEMPS EN TEMPS.
         LAI         MABC-M          < EDITION NUMERO BLOC COURANT.
         BSR         AENVOI
FU11:    EQU         $
<
< RAZ BUFFER DKU.
<
         LX          LBUDKU          < LONGUEUR MOTS BUFFER DKU.
         STZ         &AXBUDK         < RAZ MOT COURANT.
         JDX         $-1
<
<        WRITE AVEC SYNCHRONISATION SECTEUR 0.
<
         LAD         DMWDKU
         JMP         $+1             < POUR '1E16 EVENTUEL.
         SVC         0
         JE          FU2
         LAI         MERRE-M         < MESSAGE ERREUR LECTURE.
         JMP         FUER            < VERS TRAITEMENT D'ERREUR.
<
<        LECTURE.
<
FU2:     EQU         $
         LAD         DMRDKU
         JMP         $+1             < POUR '1E16 EVENTUEL.
         SVC         0
         JE          FU3
         LAI         MERRL-M         < MESSAGE ERREUR LECTURE.
         JMP         FUER            < VERS TRAITEMENT D'ERREUR.
<
<        VALIDATION.
<
FU3:     EQU         $
         LAI         0
         LX          LBUDKU          < LONGUEUR BUFFER.
FU4:     EQU         $
         OR          &AXBUDK
         JDX         FU4
         JAE         FU5
         LAI         MERRV-M         < MESSAGE ERREUR VALIDATION PISTE.
         JMP         FUER            < VERS TRAITEMENT D'ERREUR.
<
<        INCREMENTATION.
<
FU5:     EQU         $
         LAI         NBSPP/QUANTA    < PAS D'INCREMENTATION ADRESSE SECTEUR.
         AD          ABC
         STA         ABC             < NOUVEAU BLOC COURANT.
         EOR         ABCF
         TBT         0
         LA          ABC
         JC          FU7
< DE MEME SIGNE.
         JAL         FU6
< TOUS DEUX POSITIFS.
         CP          ABCF
         JLE         FU1             < OK.
         JMP         FUF             < FIN.
FU6:     EQU         $
< TOUS DEUX NEGATIFS.
         CP          ABCF
         JLE         FU1             < OK.
         JMP         FUF             < FIN.
FU7:     EQU         $
< DE SIGNES DIFFERENTS.
         JAGE        FU1             < OK.
<
FUF:     EQU         $
<
<        FIN DE FORMATAGE.
<
         LAI         MFINF-M         < MESSAGE DE FIN DE FORMATAGE.
         BSR         AENVOI
         LAD         DOFF
         SVC         0               < "!DK S0 OFF"...
         JNE         $               < ??!???!
         LAD         DDASS
         SVC         0               < "!ASSIGN A=S"...
         JNE         $               < ??!??!
E2:      EQU         $
         LAD         DMCCI           < RETOUR CCI
         SVC         0
         JMP         ENTRY           < VERS NOUVELLE EXECUTION.
FUER:    EQU         $
< TRAITEMENT D'ERREUR; ICI 'A' = ARGMENT D'APPEL S/P 'ENVOI' (MESSAGE).
         BSR         AENVOI          < MESSAGE D'ERREUR.
         LAI         MABC-M          < ENVOI NUMERO BLOC COURANT.
         BSR         AENVOI
         WORD        '1E16           < POUR DEBUGGING...
         JMP         FU1             < VERS NOUVELLE TENTATIVE.
         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
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    $+128
<                                  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
         LST
         NDS
         END