LEX    'MMLEX'
* (c) Copyright PPC Paris 1986
       ID     #E1
       MSG    0
       POLL   0
       ENTRY  MXD
       CHAR   #F
       ENTRY  MXM
       CHAR   #F
       ENTRY  MDIR
       CHAR   #F
       ENTRY  MEM
       CHAR   #F
       KEY    'MAXD'
       TOKEN  57
       KEY    'MAXM'
       TOKEN  58
       KEY    'MEMD'
       TOKEN  59
       KEY    'MEMM'
       TOKEN  60
       ENDTXT

A-MULT EQU    #1B349
ATNFLG EQU    #2F442
Attn   EQU    12
BSERR  EQU    #0939A
CHKMAS EQU    #425C
CSRW5  EQU    #0ED2C
D=AVMS EQU    #1A460
DEVPAR EQU    #1BF0
ENDTAP EQU    #44D9
FNRTN4 EQU    #0F238
Flg    EQU    11
GDIRST EQU    #4843
GETERR EQU    #6791
GETMBX EQU    #3B62
HDFLT  EQU    #1B31B
I/OFND EQU    #118BA
LEXPIL EQU    #FF
MEMERR EQU    #0944D
R<RSTK EQU    #014DD
READR# EQU    #44FF
RSTK<R EQU    #014A8
SNAPBF EQU    #2F7F0
bLEX   EQU    #BFC
eABORT EQU    4
eNODEF EQU    3
ePIL   EQU    2
eTAPE  EQU    1
eXWORD EQU    #23
memflg EQU    10

**************************************************
* La routine VERTAP verifie si le paramÉtre 
* pointÅ par D1 correspond bien È une mÅmoire
* de masse d'identificateur appareil 16.
**************************************************

Dvnfnd P=     ePIL     Classe d'erreur 32 È 47
       C=0    A        Erreur 32.
       GOC    erreur   B.E.T.

VERTAP GOSUB  JUMPER
       CON(5) DEVPAR   Routine d'analyse du
        *              spÅcificateur d' appareil
        *              de la fonction. En sortie
        *              D1 ^ Math Stack - 16 pour
        *              un paramÉtre numÅrique.
       GOC    erreur   Si carry: ERREUR
       ?D=0   X        D[X] contient l'adresse du
        *              pÅriphÅrique. Si D[X] = 0,
       GOYES  Dvnfnd   le pÅriphÅrique n'est pas  
        *              prÅsent. On renvoie
        *              "Device Not Found"
       CD1EX           ) Sauvegarde de D1 pour
       R0=C            ) le retour È BASIC (fin).
       GOSUB  JUMPER   VÅrification de l'AID du
       CON(5) CHKMAS   pÅriphÅrique (16).
       RTNNC           Cy=0 : OK, Cy=1 : ERREUR

**************************************************
* Traitement des erreurs HPIL. P indique la 
* classe d'erreur (mÅmoire de masse... etc.) et
* C[0] le numÅro de l'erreur. Le retour È la 
* main loop se fait via BSERR.
**************************************************

erreur ?P=    eTAPE
       GOYES  ERROR1
       ?P=    ePIL
       GOYES  ERROR1
       ?P#    eABORT
       GOYES  ERROR0
       GOSUB  JUMPER   
       CON(5) GETMBX
       GOSUB  atnchk
       GOC    ERROR0
       GOSUB  JUMPER
       CON(5) GETERR
       GONC   ERROR-
       ?P#    eABORT
       GOYES  ERROR1
ERROR- P=     eABORT
ERROR0 C=P    0
       P=     eNODEF
ERROR1 C=P    1
       P=     2
       LCHEX  FF
       A=C    A
       C=A    A
       P=     0
bserr  GOVLNG BSERR    Envoyez l'erreur !

**************************************************
* M A X D
**************************************************

       NIBHEX C11      Alpha ou un numÅrique.
MXD    CD0EX
       RSTK=C
       GOSUB  r<rstk
       GOSUB  VERTAP
       GOSUB  JUMPER
       CON(5) GDIRST   Get DIRectory STart
       GOC    erreur   Erreur si carry
       C=D    W        D[5:8] = l. du dir. (enr.)
       GOSBVL CSRW5    C[A] = longueur du dir.
       A=C    A        A[A] = longueur du dir.
       ASL    A        A[A] = 16 fois l. du dir.
       ASRB            A[A] = l. du dir. * 8

**************************************************
* SORTIE: commune, RETOUR A BASIC : Replace
* 4 niveaux de pile des retours, le compteur
* programme dans D0, transforme A[A] en nombre
* flottant dans A[W], replace D1 È sa place
* sur la Math-Stack puis retour È Basic via
* FNRTN4. (Rembobine le support)
**************************************************

SORTIE GOSUB  JUMPER   Rembobine le support
       CON(5) ENDTAP   de mÅmoire de masse
       GOC    Erreur
       P=     4        ) Restitution de 5 niveaux
       GOSBVL RSTK<R   ) de pile
       C=RSTK          ) puis de
       D0=C            ) D0  (4 niveaux & PC)
       GOSBVL HDFLT    A[W] = longueur 
       C=R0            R0 = D1 (MS-16)
       D1=C            D1 = MS-16
       C=A    W        C[W] = longueur
       GOVLNG FNRTN4   retour È BASIC

Erreur GOTO   erreur   Ralonge

memerr GOVLNG MEMERR

**************************************************
* M E M M
**************************************************

       NIBHEX C11
MEM    ST=0   memflg
       ST=1   Flg
       GONC   MXMC

**************************************************
* M E M D
**************************************************

       NIBHEX C11
MDIR   ST=1   memflg
       ST=0   Flg
       GONC   MXMC

**************************************************
* M A X M
**************************************************

       NIBHEX C11      Alpha ou un numÅrique
MXM    CLRST           Ni memflg ni Flg
MXMC   CD0EX
       RSTK=C
       GOSUB  r<rstk
       GOSUB  VERTAP
       A=R0            R0 = MS-16
       C=D    A        ) D[X] = device address
       RSTK=C          ) RSTK = D[X]
       C=0    A        
       LC(3)  #1F0     1F0 = 512-16 = 496
       A=A-C  A        A[A] = MS-512
       GOSBVL D=AVMS
       C=A    A        C[A] = AVMEMS
       ?C<D   A        Y a-t-il assez de mem. ?
       GOYES  memerr   Non: Erreur 
       R1=C            Sauvegarde de MS-512
       D1=C            D1 = Math Stack - 512
       A=0    A        A[A] = # enreg. È lire
       C=RSTK          ) Restitution de
       D=C    A        ) dev. add. dans D[X]
       GOSUB  JUMPER   ) Lecture de l'enreg. A[A]
       CON(5) READR#   ) en commencant È D1 ^
       GOC    Erreur
       A=R1            A[A] = MS-512
       ?ST=1  memflg   Est-on entrÅ via MEMDIR ?
       GOYES  MDIRXQ
       C=0    A
       LC(2)  48
       C=C+A  A
       D1=C            ^ pointe ^ l. max support
       P=     4        ) Calcul de
       GOSUB  GETALR   ) la longueur maximale
       GOSUB  getA*    ) du support
       GOSUB  getA*    ) de mÅmoire de masse
       ?ST=0  Flg      Est-on entrÅ via MAXMEM
       GOYES  MXM10
       GOSUB  MEM00    Autrement exÅcution de MEMM
MXM10  ASL    A        ) multiplication de A[A]
       ASL    A        ) par 256 (dclg. d'1 octet)
       GOTO   SORTIE   prÅ retour È BASIC

MEM00  B=A    A        B[A] = # enreg. maxi
       A=R1
MDIRXQ D1=A            D1^ MS-512
       D1=D1+ 16       D1^ codage # Rec. Start DIR
       P=     4
       GOSUB  GETALR   => A[A]= 00002 dir. start
       B=B-A  A        B[A] = # maxrec - vol.label
       R2=A            R2= dir. start
       D1=D1+ 8        D1^ code long. directory
       P=     4
       GOSUB  GETALR   => A[A]= 0xxxx Dir.Len
       B=B-A  A        B[A]=maxmem aprÉs format.
       ?ST=1  Flg      Est-on entrÅ via MEMM
       GOYES  MEM10    
       C=A    A        Sauvegarde de DirLen dans C
MEM10  A=A-1  A        ) A => R2 = compteur
       AR2EX           ) A[A] = DIR START
       ABEX   A        A[A]=Maxmem aprÉs format.
       R3=A            R3=compteur mem :tape
       ?ST=1  Flg      Est-on entrÅ via MEMM
       GOYES  MEM20    
       CSL    A        ) Non: division de C[A] par
       CSRB            ) 8 pour obtenir le max dir
       R3=C            ) R3 compteur mem dir
MEM20  GOSUB  GET#FL   Routine commune de comptage
       A=R3            A= rÅsulat GET#FL
       ?ST=1  Flg      Est-on entrÅ via MEMM ?
       RTNYES          Retour de MEMM
       GOTO   SORTIE   Retour de MEMDIR

GET#FL A=R1
       D1=A            D1^ MS-512
       A=B    A        A[A] = # enregis. È lire
       GOSUB  JUMPER
       CON(5) READR#
       GOC    ERReur
       B=B+1  A        B[A] = prochain # enr.
       A=R1
       D1=A            D1 ^ MS - 512
       GOSUB  GET#E    Routine de comptage des 8
        *              entrÅes directory d'un enr.
       A=R2            ) DÅcrÅmentation de R2
       A=A-1  A        ) # d'enregistrements du 
       RTNC            ) dir & retour si fin
       R2=A            Autrement sauvegarde
       GONC   GET#FL   B.E.T

ERReur GOTO   erreur

GET#E  LC(5)  #FFFF    C[3:0]=FFFF, masque de com-
        *              paraison du rideau de fin d
        *              de directory
       P=     8        8 = 8 entrÅes / enregist.
       A=0    A
get#e  P=P-1           Compteur
       RTNC            Sortie si fin
       D1=D1+ 16
       D1=D1+ 4        D1^ type de fichier
       A=DAT1 4        A[3:0] =type de fichier
       ?A=C   A        Est-ce le rideau (FFFF)
       GOYES  R3=OK    Oui: fin du s.prog.
       ?A#0   A        A=0 => fichier purgÅ !
       GOYES  R3-1
incrÅ  D1=D1+ 12       ) On passe È l'entrÅe
       D1=D1+ 16       ) suivante
MEM30  D1=D1+ 16       )
       GONC   get#e    B.E.T

R3-1   ?ST=1  Flg      MEMM ??
       GOYES  R3-M     Oui => R3- long fichier
       A=R3            )autrement R3
       A=A-1  A        ) -1 seulement pour 
       R3=A            ) MEMDIR
       GONC   incrÅ    B.E.T.

R3-M   D1=D1+ 12       D1^ long. du fich. en #rec.
       C=P    4        Sauveg. pointeur # dir
       RSTK=C
       P=     4        
       GOSUB  GETALR   A[A] long. # rec. du fich.
       C=RSTK
       CPEX   4        Restitution
       CR3EX           )
       C=C-A  A        ) R3 = R3 - # rec 
       CR3EX           )
       D1=D1+ 8        Ajustement
       GONC   MEM30    B.E.T

R3=OK  C=RSTK          Fin pop et retour
       RTN

**************************************************
* Cette routine sauvegarde 5 niveaux de pile
**************************************************

r<rstk P=     4
       GOVLNG R<RSTK   I N D I P E N S A B L E !!

**************************************************
* Cette routine a ÅtÅ pompÅe dans les IDS V, elle
* n'est pas supportÅe. Elle permet la sortie
* de l'erreur Aborted lorsque l'on arrÁte l'exÅcu-
* tion des routines HPIL en appuyant deux fois sur
* la touche ATTN.
**************************************************

atnchk ?ST=0  Attn
       GOYES  ATNCHc
       RSTK=C
       CD0EX
       D0=(5) ATNFLG
       C=DAT0 S
       D0=C
       C=RSTK
       ?C=0   S
       GOYES  ATNCHc
       C=C+1  S
       GOC    ATNCHc
       P=     eABORT
       RTNSC

ATNCHc RTNCC

**************************************************
* Routine de calcul de la longueur maxi
* du support (multiplication)
**************************************************

getA*  R2=A
       P=     4
       GOSUB  GETALR
       C=R2
       GOSBVL A-MULT
       RTN

**************************************************
* GETALR: GET A Left-Right. 
* Cette routine permet de charger dans le registre
* A n octets. Les octets sont dÅcalÅs vers la gau-
* che È chaque nouvel arrivant. 
* 
* EntrÅe: D1^ premier octet È charger dans A
*         P= Nombre d'octets È charger
*
* Sortie: A[2*(PentrÅe):0] = octets, le dernier 
*           Åtant toujours dans A[B].
*         P=0
*         D1 ^ aprÉs dernier octet
* 
* Utilise : C[B], A[W], P , D1
*
**************************************************

GETALR C=DAT1 B
       D1=D1+ 2
       ASL    W
       ASL    W
       A=C    B
       P=P-1
       ?P#    0
       GOYES  GETALR
       RTN

**************************************************
* ROUTINE JUMPER
* Cette routine permet l'accÉs aux points d'entrÅe
* supportÅs du module HPIL. Elle peut en rÅalitÅ
* servir È n'importe quelque fichier Lex.
**************************************************

JUMPER RSTK=C
       CD1EX
       D1=(5) SNAPBF
       DAT1=C A
       D1=(2) (SNAPBF)+5
       C=RSTK
       DAT1=C W
       D1=(4) (SNAPBF)+21
       DAT1=A W
       D1=(2) (SNAPBF)+37
       C=B    A
       CPEX   5
       P=     6
       C=0    P
       GONC   JUMP05
       C=C-1  P
JUMP05 P=     7
       C=0    P
       C=C-1  P
       DAT1=C 8
       SETHEX
       P=     0
       LC(3)  bLEX
       GOSBVL I/OFND
       GONC   JUMP90
       LC(2)  LEXPIL
       B=C    A
       A=0    A
       A=A+1  A
JUMP10 C=DAT1 6
       ?C=0   B
       GOYES  JUMP90
       ?B#C   B
       GOYES  JUMP20
       CSR    W
       CSR    A
       ?A<C   B
       GOYES  JUMP20
       CSR    A
       CSR    A
       C=C-A  B
       GONC   JUMP30
JUMP20 D1=D1+ 11
       GONC   JUMP10
JUMP90 LC(4)  eXWORD
       GOTO   bserr
JUMP30 D1=D1+ 6
       C=DAT1 A
       B=C    A
       C=RSTK
       D1=C
       D1=D1+ 5
       CD1EX
       RSTK=C
       C=DAT1 A
       C=C+B  A
       RSTK=C
       D1=(5) (SNAPBF)+21
       A=DAT1 W
       D1=D1+ 16
       C=DAT1 8
       B=C    A
       P=     7
       C=C+1  P
       GOC    JUMP50
       SETDEC
JUMP50 P=     6
       ?C#0   P
       GOYES  JUMP60
JUMP60 P=C    5
       D1=(4) (SNAPBF)+5
       C=DAT1 W
       D1=(2) SNAPBF
       RSTK=C
       C=DAT1 A
       D1=C
       C=RSTK
       RTN

       END