LEX    'DESASLEX'
* (c) Copyright PPC Paris 1986

        ID     #E1
        MSG    0
        POLL   0

        ENTRY  ADBUF
        CHAR   15
        ENTRY  ASCII
        CHAR   15
        ENTRY  ATH
        CHAR   15
        ENTRY  HTA
        CHAR   15
        ENTRY  RED
        CHAR   15

        KEY    'ADBUF$' syntaxe: ADBUF$("BFC") ==> Adresse du buffer BFC
        TOKEN  1
        KEY    'ASC$'   Syntaxe: ASC$("asd"&chr$(27)&"fg") ==> "asd.fg"
        TOKEN  2
        KEY    'ATH$'   Syntaxe: ATH$("ABCDE") ==> "1424344454"
        TOKEN  3
        KEY    'HTA$'   syntaxe: HTA$("14243444") ==> "ABCD"
        TOKEN  4
        KEY    'RED$'   Syntaxe: RED$("   a  b   ") ==> "a  b"
        TOKEN  5

        ENDTXT

**************************************************
ADHEAD  EQU    #181B7   Fin de la fonction: retour È BASIC.
ARGERR  EQU    #0BF19   Renvoie "Invalid Arg."
CONVUC  EQU    #152AA   Conversion de A(B) en majuscule.
D=AVMS  EQU    #1A460   Place la valeur de AVMEMS dans D(A).
DRANGE  EQU    #1B076   VÅrifie que la valeur de A(B) est comprise entre 0 et 9.
EXPR    EQU    #0F23C   Retour È BASIC.
FNRTN4  EQU    #0F238   Fin de la fonction HTA$: retour È BASIC
HEXASC  EQU    #17148   Transforme un ou plusieurs quartets en leurs Åquivalents
          *             ASCII.
IOFNDO  EQU    #118C1   Place l'adresse du buffer dont l'"ID" se trouve dans
          *             C(X) dans D1-7 (D1 ^ 7 quartets aprÉs).
MEMERR  EQU    #0944D   Renvoie "I. Memory"
POP1S   EQU    #0BD38   Teste une expression alphanumÅrique sur la Math Stack
RANGE   EQU    #1B07C   VÅrifie si A(B) est dans une certaine "Åchelle".
REV$    EQU    #1B38E   Renverse une chaÑne sur la Math Stack.
REVPOP  EQU    #0BD31   "Pop" teste et renverse la chaÑne sur la Math Stack.
**************************************************

* H T A $ ****************************************

        NIBHEX 411      La fonction n'admet qu'un seul paramÉtre alphanumÅrique
HTA     GOSBVL POP1S    Teste le paramÉtre de la fonction et renvoie la longueur
          *             de la chaÑne alpha en quartets dans A(A)
        C=A    A        On transfert cette longueur dans C(A)
        ST=C            puis dans ST 
        ?ST#0  1        pour tester si le nombre de quartets est un multiple de
          *             quatre (la chaÑne est alors constituÅe d'un nombre pair 
          *             de caractÉres)
        GOYES  Argerr   Si le nombre est impair: erreur
        CD0EX           Sauvegarde du compteur programme (PC)
        RSTK=C          dans RSTK
        CD1EX           Addition de la longueur de
        C=C+A  A        la chaÑne È D1
        D0=C            et on place D0 et 
        D1=C            D1 sur la fin de la chaÑne
        C=0    M        Division de la longueur
        C=A    A        de la chaÑne
        CSRB            par
        CSRB            4: deux dÅplacement de 1 bit vers la droite
        D=C    A        et sauvegarde de N/4 dans D(A) qui servira de compteur
        C=C+C  A        Multiplication par 2 pour
        CSL    W        reconstitution de l'entÁte
        CSL    W        de la nouvelle
        C=C-1  P        chaÑne 
        R1=C            et sauvegarde dans le registre R1

Boucle  D=D-1  A        On commence la boucle par dÅcrÅmenter D 
        GOC    HTAFIN   S'il ne reste plus de caractÉres on branche en HTAFIN.
        D0=D0- 4        Autrement on dÅcrÅmente D0 de 4 pour
        A=DAT0 4        lire la valeur HEXA
        P=     1        P= #-1 chr È convertir
        GOSUB  CONVAH   Voir encart
        D1=D1- 2        On dÅcrÅmente D1 pour
        DAT1=A B        placer le caractÉre ASCII
        GONC   Boucle   Branchement inconditionnel

HTAFIN  C=RSTK          Fin: restitution du
        D0=C            compteur programme sauvegardÅ dans RSTK plus haut
        D1=D1- 16       DÅcrÅmentation de D1 pour placer
        C=R1            l'entÁte de la nouvelle chaÑne sur la Math Stack et
        GOVLNG FNRTN4   Retour È BASIC

Argerr  GOVLNG ARGERR

********************************************************************************
********************************************************************************
*
* CONVAH : CONvertit de l'Ascii en Hexa
*
* Objet: convertir une expression ASCII en HEXA
*
* EntrÅe: 
*    P= Nombre de caractÉre È convertir moins 1 (de 0 È 7)
*    HEX
*    A: valeurs HEXA correspondant au caractÉres ASCII
*       Ex:    313445
*               -----
*               E 4 1        avec P= 2 en entrÅe.
*
* Sortie: 
*    P=0
*    HEX
*    Carry=0
*    A(W) = B(W) = valeur HEXA
*
* Utilise: A(W), B(W), C(S), C(A), P
*
* Niveaux de pile des retours: 2
*
********************************************************************************
********************************************************************************

CONVAH  C=P    15       Sauvegarde du nombre de caractÉres dans C(S)
        P=     0
BCL1    GOSBVL DRANGE   A(B) ? compris entre 30 et 39
        GONC   CVH10    Si oui: CVH10
        GOSBVL CONVUC   Convertit A(B) en majuscule
        LCASC  'FA'     Bornes test pour l'appel de RANGE
        GOSBVL RANGE    VÅrifie si A(B) est entre A et F
        GOC    Argerr   Si non: ERREUR
        LC(1)  9        On aditionne 9 au quartet de poids
        A=A+C  P        faible de A(B)
CVH10   BSL    W        Sauvegarde
        B=A    P        dans B(0)
        ASR    W        On passe
        ASR    W        au caractÉre suivant
        C=C-1  S        C(S) = compteur
        GONC   BCL1     B.E.T.
        A=B    W        A = B pour la sortie de routine 
        RTNCC           Retour avec Carry = 0

* A D B U F $ ************************************

        NIBHEX 411      La fonction n'admet qu'un seul paramÉtre alphanumÅrique
ADBUF   GOSBVL REVPOP   Teste le paramÉtre de la fonction et renvoie la longueur
          *             de la chaÑne alpha en quartets dans A(A). La chaÑne est 
          *             renversÅe sur la Math Stack.
        C=0    A        ) On charge 6
        LC(1)  6        ) dans C(A) pour
        ?A#C   A        ) tester si la longueur de la chaÑne est bonne.
        GOYES  Argerr   Si elle est mauvaise: ERREUR.
        A=DAT1 6        On charge la longueur de la chaÑne dans A(5-0)
        D1=D1+ 6        D1 ^ maintenant la fin de la chaÑne. 
        CD1EX           Sauvegarde de D1
        RSTK=C          dans RSTK.
        P=     2        P= nombre de caractÉres de A(W) È convertir en HEXA.
        GOSUB  CONVAH   Conversion !
        C=A    A        C(X) = valeur HEXA de la chaÑne introduite.
        GOSBVL IOFNDO   Recherche du Buffer.
        GONC   FIN      Si Carry=0 : le buffer n'existe pas: FIN
        D1=D1- 7        On rÅajuste l'adresse pour pointer le dÅbut du buffer.
        AD1EX           On charge l'adresse du buffer dans A(A)
        P=     4        PrÅparation (comme pour CONVAH) pour l'appel de HEXASC.
        C=0    S        ) La routine HEXASC demande que le nombre de 
        CPEX   15       ) quartets È convertir soit dans C(S). (de 0 È 7)
        GOSBVL HEXASC   Convertion de l'adresse en ASCII.

FIN     C=RSTK          ) Restitution
        D1=C            ) de D1.
        GONC   Adh      Si l'on vient de "GONC   FIN" on branche en Adh.
        D1=D1- 10       Autrement on place le paramÉtre de retour sur 
        DAT1=A 10       la Math Stack.
Adh     R1=C            Indispensable avant l'appel de la routine ADHEAD.
        ST=1   0        On veut un retour aprÉs l'appel de ADHEAD.
        GOSBVL D=AVMS   D(A) = AVMEMS
        GOSBVL ADHEAD   Construction de l'en-tÁte de la nouvelle chaÑne.
        GOSBVL REV$     On renberse le tout
        GOVLNG EXPR     et retour È BASIC.

* A S C $ ****************************************

        NIBHEX 411      Un paramÉtre alpha.
ASCII   CD1EX           )
        D1=C            ) Sauvegarde de D1
        RSTK=C          ) dans RSTK. (opcode=1oct)
        GOSBVL POP1S
        B=0    M        ) Division de la longueur
        B=A    A        ) de la chaÑne par
        BSRB            ) 2. B=compteur de CHR.
        LCASC  '.'
        ST=C            ST(B)='.'
        LCASC  '~ '
        D=C    A        D(3-0)='~ '

BOUCLE  B=B-1  A        Reste-t-il des CHR ?
        GOC    SORTIE   Si non: SORTIE.
        A=DAT1 B        A(B)=CHR È tester.
        C=D    A        C(3-0)='~ '
        GOSBVL RANGE    31<CHR<127 ?
        GONC   ^D1      Si oui: B.E.T.
        C=ST            Autrement C(B)='.'
        DAT1=C B        Le CHR devient '.'
^D1     D1=D1+ 2        Ajuste Carry.
        GONC   BOUCLE   B.E.T.

SORTIE  C=RSTK          Restitution de 
        D1=C            D1.
        GOVLNG EXPR     et retour È BASIC.

* A T H $ ****************************************

        NIBHEX 411      Un seul paramÉtre alphanumÅrique pour la fonction ATH$
ATH     GOSBVL POP1S
        CD0EX           Sauvegarde de la valeur de
        RSTK=C          D0 dans RSTK pour rendre le pointeur D0 disponible
        CD1EX           On place
        D1=C            le pointeur D0 È la
        D0=C            valeur de D1
        GOSBVL D=AVMS   D(A) = AVMEMS
        D1=D1- 16       D1 pointe maintenant le dÅbut du paramÉtre de ATH$
        CD1EX           Calcul de la longueur
        C=C-A  A        de la future chaÑne
        ?C<D   A        comparaison avec AVMEMS pour savoir s'il y a
        GOYES  Memerr   suffisamment de place en mÅmoire. Si non: "In. Memory"
        D1=C            D1 ^ maintenant le futur paramÉtre
        RSTK=C          Sauvegarde dans RSTK
        C=A    A        Multiplication de la longueur
        C=C+C  A        de la chaÑne par 2 (N+N)
        CSL    W        et contruction de l'en-tÁte
        CSL    W        de la
        LC(1)  15       future chaÑne
        DAT1=C W        et mise en place sur la Math Stack
        D1=D1+ 16       D1 pointe maintenant la fin de la future chaÑne
        C=0    W        Mise È 0 pour permettre des dÅcalages et des opÅrations
          *             dans C(S)
        C=A    A        Division de la longueur de la chaÑne par 2
        CSRB            pour initialiser le 
        D=C    A        compteur de boucle D(A)
        C=C-1  S        C(S)= 15

ATH10   D=D-1  A        Reste-t-il encore des caractÉres È tester ?
        GOC    Fin      Non: branchement au label "Fin"
        A=DAT0 B        A(B) = caractÉre ASCII È transformer en HEXA
        C=-C   S        Au retour de la routine HEXASC C(S) = 15 . A l'appel de 
        GOSBVL HEXASC   cette routine C(S) = Nb. de quartets È transformer: #-1
        DAT1=A 4        On place le rÅsultat de la transformation sur la M.S.
        D0=D0+ 2        IncrÅmentation des 
        D1=D1+ 4        compteurs D0 et D1
        GONC   ATH10    Branchement inconditionnel (B.E.T.)

Memerr  GOVLNG MEMERR

Fin     C=RSTK          Restitution
        D1=C            des compteurs
        C=RSTK          D0 et
        D0=C            D1
        GOVLNG EXPR     et retour È BASIC.

* R E D $ ****************************************

        NIBHEX 411
RED     GOSUB  CNTBL    Suppression des blancs en dÅbut de chaÑne.
        GOSUB  ENTETE   Construction de l'en-tÁte de la chaÑne avant inversion.
        GOSUB  CNTBL    Suppression des blancs en fin de chaÑne.
        GOC    FiN      On branche en: FiN

CNTBL   GOSBVL REVPOP   "Pop" et renverse la chaÑne.
        B=0    M        ) Division de la longueur de la chaÑne
        B=A    A        ) par 2 pour avoir un compteur de
        BSRB            ) caractÉres dans B(A).
        LCASC  ' '      On charge le CHR$(32) dans C(B).
BLCOUT  B=B-1  A        Reste-t-il encore des caractÉres dans la chaÑne ?
        GOC    CHNULL   Si non: on branche en chaÑne nulle !
        A=DAT1 B        ) Le caractÉre suivant est-il
        ?A#C   B        ) diffÅrent de CHR$(32) ?
        RTNYES          Si oui: fin de routine.
        D1=D1+ 2        Autrement on incrÅmente D1 pour pointer de CHR$ suivant.
        GONC   BLCOUT   B.E.T.

ENTETE  A=B    A        Longueur de la chaÑne restante -1    ) en
        A=A+1  A        longueur de la chaÑne                ) octets
        A=A+A  A        Longueur de la chaÑne en quartets.
        ASL    W        A = .....lllll0          ) avec lllll =
        ASL    W        A = ....lllll00          ) longueur de la chaÑne.
        A=A-1  P        A = ....lllll0F       
        D1=D1- 16       DÅcrÅmentation de D1 pour
        DAT1=A W        placer l'en-tÁte de la nouvelle chaÑne
        RTN             Retour 

CHNULL  C=RSTK          Suppresssion d'un niveau de sous-programme si l'on vient
          *             de CNTBL.
FiN     GOSUB  ENTETE   Construction de l'en-tÁte de la nouvelle chaÑne.
        GOVLNG EXPR     Retour È BASIC.

        END             Fin du LEX.