LEX    'HMSDLEX'
* (c) PPC Paris et l'Auteur, 1988
       ID     #5D
       MSG    0
       POLL   0
EXPR   EQU    #0F23C
STRHDR EQU    #0F09A

       ENTRY  xHMS
       CHAR   #F
       KEY    'HMS$'
       TOKEN  1
       ENDTXT

       NIBHEX 811
xHMS   A=DAT1 W        Lecture opÅrande dans A
       ST=0   0        Initialisation du marqueur
         *             de nombre nÅgatif
       GOSUB  FORMAT   VÅrifie format de l'opÅrande
       GOSUB  TRANSF   Effectue la transformation
         *             proprement dite
SORTIE GOVLNG EXPR     Termine la fonction
*
* Si opÅrande hors norme alors rendre "-??-"
*
PASBON SETHEX
       P=     0        PrÅparation d'un en-tÁte
       C=0    W        de chaine alpha
       LC(2)  #10      de la longueur
       D1=D1+ 16       voulue pour placer
       GOSBVL STRHDR   le message rÅponse:
       LCASC  '    -??-'
       DAT1=C W        Ecrit message dans la pile
       C=RSTK          on saute un RTN
       D1=D1- 16       on pointe le haut de pile
       GOTO   SORTIE   et on sort

* Formattage de l'opÅrande et Åjection des donnÅes
* invalides: INF, NaN et hors normes donnent "-??-"

FORMAT P=     2        vÅrification
       LC(1)  #F       NaN et INF
       ?A=C   P        d'aprÉs l'octet #2
       GOYES  PASBON   Åjecte les Nan et INF
       SETDEC
       A=A+1  X        Multiplication par 100
       A=A+1  X        pour avoir des centiÉmes de
       P=     0        seconde
       ?A=0   S        DÅtection des positifs
       GOYES  POSITI   Si oui on saute È la suite,
         *             sinon...
       ST=1   0        CaractÅrise un opÅrande
         *             nÅgatif
       A=0    S        annule le signe pour la
         *             routine DIV
POSITI LC(3)  #006     Åjection des temps > 10^4
       ?C<A   X
       GOYES  PASBON
       LC(2)  #13      Annulation des chiffres
         *             aprÉs la virgule
       C=C-A  X        C(X)= nbre de 0 È placer
       P=C    0
       A=0    WP       annulation de ces chiffres
         *             en trop
BCLE   ASR    W        puis dÅcalage du nombre
       C=C-1  X        qui ressortira cadrÅ È droite
       GONC   BCLE
       RTN             terminÅ pour le formattage
*
* transformation proprement dite
*
TRANSF P=     4        calcul des heures
       C=0    W        par
       LC(2)  #36      division entiÉre par 3600
       GOSUB  DIV
       BCEX   A        DIV rend le rÅsultat en B(A)
       R0=C            et on le met en R0
       C=0    W
       P=     3        division par 60
       LC(1)  #6
       GOSUB  DIV
       C=R0            lecture des heures
       CSL    W        dÅcalage d'un
       CSL    W        octet :
       BCEX   B        placer les minutes aprÉs
       CSL    W        puis nouveau dÅcalage pour
       CSL    W        prÅparer place des secondes
       CSL    W        et des
       CSL    W        centiÉmes
       P=     3
       ACEX   WP       Ce que l'on fait ici
       R0=C            Mise È l'abri de HHMMSSCC
       SETHEX          dans R0
       P=     0
       C=0    W
       LC(2)  #16      Longueur de l'en-tÁte de la
         *             chaine È sortir = 22
       ?ST=0  0        Nombre positif?
       GOYES  SUITE0
       LC(2)  #18      Non lg de chaine = 24 nibs
SUITE0 D1=D1+ 16       On Åcrase l'opÅrande
       GOSBVL STRHDR   CrÅation de l'en-tÁte
       GOSUB  NCHR     Conversions ASCII des
         *             centiÉmes de seconde
       LCASC  '"'      Marque les secondes
       DAT1=C B        Ajout È la chaine en
         *             construction
       D1=D1+ 2        Pointage sur la suite pour...
       GOSUB  NCHR     conversion ASCII des secondes
       LC(2)  #27      le caract. ' marque les min.
       DAT1=C B        Ajout È la chaine
       D1=D1+ 2        pointage sur la suite pour...
       GOSUB  NCHR     Conversion ASCII des minutes
       LCASC  ':'      Suivies du marqueur heures
       DAT1=C B        AjoutÅ È la chaine
       D1=D1+ 2        On pointe la suite pour...
       GOSUB  NCHR     Conversion ASCII des heures
       ?ST=0  0        Nombre positif?
       GOYES  SUITE1
       LCASC  '-'      Non, on rajoute un '-' devant
       DAT1=C B        la chaine
SUITE1 D1=D1- 6        puis on
       D1=D1- 16       repointe le sommet
       D1=D1- 16       de la pile
       RTN             et c'est terminÅ
*
* Sous-routine de division entiÉre par soustractions
* successives.
* nombre formattÅ en A, diviseur formattÅ en C
* rÅsultat en B(B)
*
DIV    B=0    W
DIV0   ?A<C   W
       RTNYES
       A=A-C  W
       B=B+1  B
       GOTO   DIV0
*
* Prend un nombre de 2 chiffres en R0, dÅcale R0, et
* range les codes ASCII des chiffres È l'adresse D1
*
NCHR   A=0    A
       C=R0
       A=C    B        000XY en A(A)
       CSR    W        dÅcalage pour Åliminer
       CSR    W        ce qu'on vient de lire
       R0=C
       ASL    A        000XY devient 00XY0
       ASR    B        puis 00X0Y
       LC(4)  #3030
       A=A+C  A        ?3X3Y (on se fiche de A[4])
       DAT1=A 4        ce qu'on Åcrit dans la chaine
       D1=D1+ 4        avant de pointer la suite
       RTN             et de retourner

       END