LEX    'PRINTLEX'
* (c) Copyright PPC Paris, 1986

t      EQU    39       Le Token de dÅpart

       ID     #E1
       MSG    0
       POLL   0

       ENTRY  BELLe
       CHAR   #D
       ENTRY  BOLDe
       CHAR   #D
       ENTRY  CRe
       CHAR   #D
       ENTRY  ESCe
       CHAR   #F
       ENTRY  FFe
       CHAR   #D
       ENTRY  LFe
       CHAR   #D
       ENTRY  MODEe
       CHAR   #D
       ENTRY  PERFe
       CHAR   #D
       ENTRY  PLe
       CHAR   #D
       ENTRY  UNDERLINEe
       CHAR   #D
       ENTRY  WRAPe
       CHAR   #D

*                      Syntaxes :

       KEY    'BELL'      BELL
       TOKEN  t
       KEY    'BOLD'      BOLD ON | OFF
       TOKEN  1+t
       KEY    'CR'        CR
       TOKEN  2+t
       KEY    'ESC$'      ESC$ [ ( <str> ) ]
       TOKEN  3+t
       KEY    'FF'        FF
       TOKEN  4+t
       KEY    'LF'        LF [ <num> ]
       TOKEN  5+t
       KEY    'MODE'      MODE <num>
       TOKEN  6+t
       KEY    'PERF'      PERF ON | OFF
       TOKEN  7+t
       KEY    'PL'        PL [ <num1> [, <num2> ]]
       TOKEN  8+t
       KEY    'UNDERLIN'  UNDERLINE ON | OFF
       TOKEN  9+t
       KEY    'WRAP'      WRAP ON | OFF
       TOKEN  10+t

       ENDTXT

**************************************************
*                                                *
* T A B L E    D E S    E Q U I V A L E N C E S  *
*                                                *
**************************************************

ADHEAD EQU    #181B7
ARGERR EQU    #0BF19
ASLW3  EQU    #0ED21
ASLW4  EQU    #0ED1E
CNVWUC EQU    #03FB8
D0=AVS EQU    #09B2C
D=AVMS EQU    #1A460
DELAYp EQU    #02AC6
DROPDC EQU    #05470
EOLCK  EQU    #02A7E
EOLXCK EQU    #05405
EXPEX- EQU    #0F178
FIXP   EQU    #02A6E
FORSTK EQU    #2F59E
MFERR  EQU    #09393
MOVEU0 EQU    #1B162
NXTSTM EQU    #08A48
OUT2TC EQU    #02CFD
OUTELA EQU    #05303
POLL   EQU    #12337
POP1R  EQU    #0E8FD
POP1S  EQU    #0BD38
PPOS   EQU    #2F956
RESPTR EQU    #03172
RJUST  EQU    #12AE2
RNDAHX EQU    #136CB
STMTR0 EQU    #2F871
SYNTXe EQU    #02E2B
TRACDC EQU    #052FC
WRDSCN EQU    #02C2A
eDVCNF EQU    #00040
pPRTIS EQU    #0000F
tON    EQU    #000E0


**************************************************
*                                                *
* R O U T I N E S    D E    D E C O M P A R S E  *
*                                                *
**************************************************




**************************************************
*
* Routines de parse :
*
* Dans ce qui suit, ORDRE reprÅsente l'ordre en
* cours d'analyse. Par exemple, pour LF [ <num>],
* ORDRE est : LF.
*
* DÅtail des syntaxes admises par les routines :
*
* parse  : ORDRE
* UNDERp : ORDREE ON | OFF
* ONOFFp : ORDRE ON | OFF
* LFp    : ORDRE [ <num> ]
* PLp    : ORDRE [ <num> [, <num>]]
* NUMp   : ORDRE <num>
*
**************************************************

parse  RTNCC           Retour avec Cy=0

**************************************************
* UNDERp
* But: analyser UNDERLINE ON|OFF
**************************************************

UNDERp GOSBVL =CNVWUC  Conversion en majuscule
       LCASC  'E'
       ?A#C   B        Est-ce "E" ?
       GOYES  syntax   Non: "Erreur de syntaxe"
       D1=D1+ 2        Oui: caractÉre suivant
*
* Le code de UNDERp se poursuit dans ONOFFp
*

**************************************************
* ONOFFp
* But: analyser ON|OFF
**************************************************

ONOFFp GOSBVL =WRDSCN  Token suivant
       CON(2) =tON     Est-ce ON ?
       REL(3) =parse   Oui: retour
       CON(2) 1+=tON   (<==> =tOFF)
       REL(3) =parse
       NIBHEX 00       Fin de la table
*
* Si nous sommes arrivÅs lÈ, c'est que le token
* n'Åtait ni tON, ni tOFF. Alors, on ne reconnaÑt
* pas l'ordre, et on repasse la main au systÉme
* d'exploitation :
*
syntax GOVLNG =SYNTXe  "Erreur de syntaxe"

resptr GOVLNG =RESPTR

**************************************************
* LFp
* But: analyser LF [ <num> ]
**************************************************

LFp    GOSBVL =EOLCK   Fin de ligne ?
       GOC    resptr
       GOSUB  resptr   Non : il y a donc un nb
       GOTO   =NUMp    alors parsons-le.

**************************************************
* PLp
* But: analyser PL [num [, num] ]
* Principe: on teste le premier paramÉtre, et s'il
* existe, on continue sur DELAYp
**************************************************

PLp    GOSBVL =EOLCK   Premier param. existe ?
       GOC    resptr   Non: on revient a Basic
       GOSUB  resptr   Oui: on branche sur
       GOVLNG =DELAYp  DELAY num [, num]

**************************************************
* NUMp
* But: analyser un ordre de type ORDRE <num>
**************************************************

NUMp   GOVLNG =FIXP


**************************************************
*
* Routines de decompilation :
*
* DÅtail des entitÅs decompilÅes :
*
* decomp : ORDRE
* UNDERd : ORDREE ON | OFF
* ONOFFd : ORDRE ON | OFF
* LFd    : ORDRE [ <num> [, <num> [, <num> ...]]]]
*
**************************************************

decomp GOVLNG =OUTELA

**************************************************
* UNDERd
* But: dÅcompiler UNDERLINE ON|OFF
**************************************************

UNDERd LCASC  ' E'
       D0=D0- 2        Retour sur l'espace
       GOSBVL =OUT2TC  Affichage de "E"
       A=DAT1 B        Token suivant (ON/OFF)
*
* le code se poursuit dans ONOFFd
*

**************************************************
* ONOFFd
* But: decompiler une alternative ON|OFF
**************************************************

ONOFFd GOVLNG =TRACDC  DÅcompilation du token

**************************************************
* PLd, NUMd, LFd
* But: dÅcompiler un ordre suivi d'une suite
* d'expressions numÅriques.
**************************************************

PLd
LFd
NUMd   GOVLNG =DROPDC  Aucun param.: autorisÅ


**************************************************
*                                                *
* U T I L I T A I R E    D ' I M P R E S S I O N *
*                                                *
**************************************************


**************************************************
* PRINT
*
* But: Cette routine imprime la chaine pointÅe par
* la premiÉre adresse de la pile de retours.
* Le retour peut s'effectuer de deux maniÉres:
* - PR-BAS: retour È Basic
* - PR-RTN: retour È la routine appelante.
*
* Principe:
* Le poll pPRTIS est envoyÅ, pour Átre interceptÅ
* par l'HPIL. Celui-ci renvoie l'adresse de la
* routine PRASC qui se chargera de l'impression.
*
* Schema de l'appel:
*       GOSUB  PR-BAS (ou PR-RTN)
*       CON(1) n
*       CON(2) C1
*        :
*       CON(2) Cn
* NB: utilise R0, R2, R3
**************************************************

PR-BAS ST=0   4        Le retour se fera selon
       GOTO   print    l'Åtat du flag 4 (4 parce
PR-RTN ST=1   4        les autres Åtaient deja
print  P=     0        utilisÅs...)
       SETHEX
       GOSBVL =POLL
       CON(2) =pPRTIS  Envoi du Poll
       ?XM=0           A-t-il ÅtÅ interceptÅ ?
       GOYES  noerr    Oui: pas d'erreur
       LC(2)  =eDVCNF  Non: "UnitÅ non trouvÅe"
       GOVLNG =MFERR
noerr
*************************
* Modification du <861023.2238>
*
* nettoyage de la boucle aprÉs l'envoi des ordres
* par appel È la routine PREND, dont l'adresse est
* donnÅe par un REL(5) avant le code de PRASCI.
*
       D1=A            D1 := ^ code de PRASCI
       D1=D1- 5        D1 := ^ (REL(5) =PREND)
       C=DAT1 A        C(A) := REL(5)
       B=C    A        B(A) := REL(5)
       CD1EX           C(A) := ^ #F107A
       C=C+B  A        C(A) := ^ code de PREND
       R0=C
*
* Fin de la modification
*************************
       C=RSTK          Adresse de la table
       D1=C            dans D1
       C=C+1  A        C: ^ premier caractÉre
       D=C    A        D=ad. du premier caractÉre
       GOSUB  ici1     Pour avoir la position du
ici1   C=RSTK          pointeur programme.
       B=C    A
       LC(5)  (ret1)-(ici1)
       C=C+B  A        C=adresse de retour
       RSTK=C          empilÅe
*
* AprÉs le poll pPRTIS, si celui-ci est interceptÅ
* par l'HPIL, nous avons l'adresse de la routine
* qui se chargera de l'impression dans A(A).
*
* Le seul moyen, È ma connaissance, pour faire un
* GOTO È une adresse variable est d'empiler cette
* adresse  dans la pile de retour,  puis de faire
* un RTN.
*
       C=A    A
       RSTK=C
       A=0    A
       A=DAT1 1        A(A)= nb de caractÉres.
       RTN             <=> GOTO A(A)
ret1
*************************
* Modification du <861023.2240>
*
* nettoyage effectif :
*
       GOSUB  ici2
ici2   C=RSTK
       A=C    A
       LC(5)  (ret2)-(ici2)
       C=C+A  A
       RSTK=C          RSTK := ^ ret2
       C=R0
       RSTK=C          RSTK := ^ PREND
       CD1EX
       R0=C
       RTN             <==> GOVLNG =PREND

ret2   P=     0        # 0 en sortie de PREND
       ?ST=0  4        PR-BAS ?
       GOYES  nxtstm   GOYES retour È Basic
       C=R0
       RSTK=C
       RTN             retour È l'appelant
nxtstm GOVLNG =NXTSTM  sinon retour È Basic
*
* Fin de la modification
*************************


**************************************************
* onoff?
* But: tester le token suivant:
* Sortie: Cy=1 si tON, Cy=0 sinon
**************************************************

onoff? A=DAT0 B
       LC(2)  =tON
       ?A=C   B
       RTNYES         Retour avec Carry=1
       RTN            Avec Cy=0


**************************************************
*                    BELL                        *
**************************************************

       REL(5) decomp
       REL(5) parse
BELLe  GOSUB  PR-BAS
       CON(1) 1       1 seul caractÉre
       CON(2) 7       code 7

**************************************************
*                  BOLD ON|OFF                   *
**************************************************

       REL(5) ONOFFd
       REL(5) ONOFFp
BOLDe  GOSUB  onoff?   ON ou OFF ?
       GOC    boldon   -> ON
       GOSUB  PR-BAS   -> OFF
       CON(1) 1        1 seul caractÉre
       CON(2) 15       SI (Shift In)
boldon GOSUB  PR-BAS
       CON(1) 1
       CON(2) 14       SO (Shift Out)

**************************************************
*                     CR                         *
**************************************************

       REL(5) decomp
       REL(5) parse
CRe    GOSUB  cr       CR est aussi utilisÅ dans
       GOTO   nxtstm   LF et FF

**************************************************
* cr
*
* But: envoyer un retour-chariot, et remettre la
* position de la tÁte d'Åcriture È 0.
* Note: la position de la tÁte d'Åcriture est
* gardÅe en mÅmoire par le HP71. Elle est utilisÅe
* par TAB.
**************************************************

cr     D1=(5) =PPOS    Printer POSition
       C=0    B
       DAT1=C B        PPOS=0 (TAB=0)
       GOSUB  PR-RTN   Impression avec retour...
       CON(1) 1
       CON(2) 13
       RTN

**************************************************
*                    ESC$                        *
**************************************************

       NIBHEX 4
       NIBHEX 01       0 mini, 1 maxi
ESCe   ?C#0   S
       GOYES  ESC20
       CD1EX           D1=pointeur de pile math.
       R1=C            dans R1 pour ADHEAD
       D1=C
       D1=D1- 2
       P=     0
       LC(2)  27       ESC
       DAT1=C B
ESC10  GOSBVL =D=AVMS  requis par Basic
       ST=0   0        Pas de retour
       GOVLNG =ADHEAD  Ajout de l'en-tÁte

ESC20  CD0EX
       RSTK=C
       GOSBVL =POP1S
       CD1EX           D1 := ^ fin de 1Ére chaÑne

       D0=C            Start of source

       D1=C
       D1=D1- 2        Start of dest

       R2=C            R2 := ^ fin de 1Ére chaÑne
       C=C+A  A        C(A) := ^ dÅbut de chaÑne
       B=A    A        B(A) := block length
       R1=C            R1 := ^ dÅbut de chaÑne
       GOSBVL =MOVEU0

       C=R2
       D1=C
       D1=D1- 2        Top of Math-Stack
       C=R1
       D0=C
       D0=D0- 2
       LC(2)  27
       DAT0=C B

       C=RSTK
       D0=C
       GONC   ESC10    B.E.T.



**************************************************
*                     FF                         *
**************************************************

       REL(5) decomp
       REL(5) parse
FFe    GOSUB  cr       On remet d'abord PPOS È 0
       GOSUB  PR-BAS   et on envoie...
       CON(1) 1        ...un caractÉre...
       CON(2) 12       ...de code 12

Argerr GOTO   argerr

**************************************************
*                  LF [ <num> ]                  *
**************************************************

       REL(5) LFd
       REL(5) LFp
LFe    A=DAT0 B
       GOSBVL =EOLXCK
*************************
* Modification du <861023.2000>
*
*
       A=0    A
       GONC   lf05
       A=A+1  A
       GONC   noexpr   B.E.T.

lf05   GOSBVL =EXPEX-
       GOSBVL =RNDAHX
       GONC   Argerr   paramÉtre < 0

noexpr R1=A
       GOSUB  cr       une seule fois !
       GOTO   lf20
*
* Boucle d'envoi des LF.
* La boucle peut ne pas Átre exÅcutÅe (LF 0), µa
* ne doit pas gÅnÅrer d'erreur.
*
lf10   R1=A
       GOSUB  PR-RTN
       CON(1) 1
       CON(2) 10
lf20   A=R1
       A=A-1  A
       GONC   lf10
       GOTO   nxtstM
*
* Fin de la modification
***************************

ARgerr GOTO   argerr

**************************************************
*                 MODE <num>                     *
**************************************************

       REL(5) NUMd
       REL(5) NUMp     Un param. num. obligatoire
MODEe  GOSUB  evalex   Åvaluation de ce paramÉtre
       C=0    W
       C=A    WP       Ici, on a P=0
       ?A#C   W        nb > 9 ?
       GOYES  ARgerr
       SETHEX
       LCASC  '0'      Conversion en Ascii
       A=A+C  B
       GOSBVL =ASLW4   DÅcalage È gauche de 7
       GOSBVL =ASLW3   quartets
       LCHEX  53006B261B5    ESC '&k_S'
*
* A ce niveau, il est bien important de voir ce
* que l'on a dans les registres:
*
* C(W)= x x x x x 5 3 0 0 6 B 2 6 1 B 5
* A(W)= 0 0 0 0 0 0 0 3 n 0 0 0 0 0 0 0 (MODE n)
*
* L'addition de A et C nous donne bien Åvidemment
* la bonne sÅquence d'Åchappement.
*
* C va alors Átre transfÅrÅ en mÅmoire (AVMEMS),
* afin d'Átre envoyÅ È PRASC.
*
       C=C+A  W
       GOSBVL =D0=AVS  D0 := AVMEMS
       DAT0=C 11       La table est crÅÅe È cet
       CD0EX           endroit, pointÅ par D0.
       RSTK=C          On simule un GOSUB.
       GOTO   PR-BAS

**************************************************
*                 PERF ON|OFF                    *
**************************************************
       REL(5) =ONOFFd
       REL(5) =ONOFFp
PERFe  GOSUB  onoff?
       A=0    A
       LCASC  'L'      Fin de sÅquence
       GONC   prfoff
       A=A+1  A        1=perf on
prfoff GOSUB  escseq
       GOTO   nxtstm   retour È Basic

**************************************************
* evalex, trad
*
* But:
*  - evalex: Åvaluer la chaine de tokens pointÅe
*    par D0, et...
*  - trad: dÅpiler le sommet de la pile-maths,
*    convertir le nombre en dÅcimal, et vÅrifier
*    qu'il est infÅrieur È 999.
**************************************************

evalex SETHEX          requis par EXPEX-
       GOSBVL =EXPEX-  Evaluation...
trad   GOSBVL =RJUST   Traduction en entier dÅc.
       SETHEX          aprÉs RJUST
       GOC    argerr   Inf
       C=0    W
       LCHEX  999      C=00...00999
       ?A<C   W
       RTNYES          Retour autorisÅ si < 999
argerr GOVLNG =ARGERR  sinon: "invalid argument"

**************************************************
* escseq
*
* But: Envoyer une sÅquence du type: ESC & l ### $
* ou ### est dans A(A), et $ dans C(B)
*
* Note:
* Beaucoup de sÅquences d'Åchappement sont de la
* forme ESC & l # $, ou:
*   # est un nombre entier
*   $ est un caractÉre (f/F, p/P, l/L ou d/D)
* Il est È noter que les zÅros de tÁte dans # ne
* sont pas pris en compte. Cette caractÅristique
* est trÉs intÅressante...
*
* Principe:
*  - La table est construite È partir de AVMEMS:
*    Les caractÉres ESC, & et l sont d'abord
*    placÅs, puis on calcule # sur 3 chiffres
*    (octets), et enfin, on place le caractÉre $
*    È la fin. Il faut noter que cette  sÅquence
*    d'Åchappement est de longueur fixe.
*  - La table est suivie en mÅmoire d'un code RTN
*    (#01). Le retour de PR-RTN se fera lÈ, d'oË
*    retour final È la routine appelante...
*    Simple, non ?
**************************************************

escseq D=C    B        Sauvegarde du caractÉre
       B=A    A        et du nombre
       D0=(5) =STMTR0
       LCHEX  6C261B7  7 caractÉres, dont: ESC & l
       DAT0=C 7
       D0=D0+ 7
       BSRC
       BSRC            B(0-0)=premier nombre
       LCASC  '0'      C(B)=#30
       P=     2        3 boucles au total
boucle A=B    A        A(A)=0000x
       B=0    A        B=xx0000...0000
       A=A+C  B        A(B)=3x
       DAT0=A B
       D0=D0+ 2
       BSLC            B=x0000...0000x
       P=P-1
       GONC   boucle   Boucle si P>=0
************************
* Je m'avais gourÅ tout plein...
*
       P=     0
*
************************
       C=D    B        caractÉre final
       DAT0=C B
       D0=D0+ 2
       LCHEX  10       code de RTN
       DAT0=C B
       CD0EX           } C=D0
       D0=C            }
       RSTK=C          RSTK := ^ RTN dans la table

       D0=D0- 15       D0=dÅbut de la table
       CD0EX
       RSTK=C          puis l'adresse de la table
       GOTO   PR-RTN   Envoi...

**************************************************
*           PL [ <num> [ , <num> ] ]             *
**************************************************

       REL(5) PLd
       REL(5) PLp
PLe    A=DAT0 B        A(B)=token suivant
       GOSBVL =EOLXCK  Fin de ligne ?
       GONC   parametres
       GOSUB  PR-BAS   Oui: chaÑne par dÅfaut
       CON(1) 11       11 caractÉres
       CON(2) 27
       CON(2) '&'
       CON(2) 'l'
       CON(2) '7'
       CON(2) '2'
       CON(2) 'p'
       CON(2) '6'
       CON(2) '6'
       CON(2) 'f'
       CON(2) '1'
       CON(2) 'L'
parametres
*************************
* Deux cas :
*  PL 72
*  -> ESC &l72P
*     Sommet Math Stack : 72
*  PL 72,66
*  -> ESC &l72P ESC &l66L
*     Sommet Math Stack : 66
*************************
       GOSUB  evalex   Evaluation des paramÉtres
* D1 = ^ 72 (66)
       R1=A            R1 := dernier paramÉtre
       D1=D1+ 16       DÅpilement
       AD1EX
*************************
* Modification du <861023.2257>
*
* Inversion de l'ordre d'envoi des deux paramÉtres
*
       D0=(5) =FORSTK
       C=DAT0 A
       ST=1   9
       ?A>=C  A        Un seul paramÉtre ?
       GOYES  unique   Oui: longueur de la page
       ST=0   9        pas qu'un seul paramÉtre
       D1=A
       GOSBVL =POP1R
       GOSUB  trad     A = premier paramÉtre
       AD1EX
unique
       AD1EX
       LCASC  'P'
       GOSUB  escseq
       ?ST=1  9
       GOYES  nxtstM
       A=R1
       LCASC  'F'
       GOSUB  escseq

nxtstM GOTO   nxtstm   Retour È Basic
*
* Fin de la modification
*************************

**************************************************
*              UNDERLINE ON|OFF                  *
**************************************************

       REL(5) UNDERd
       REL(5) UNDERp
UNDERLINEe
       GOSUB  onoff?
       GOC    UNDon
       GOSUB  PR-BAS   SÅquence d'Åchappement
       CON(1) 4        difficile È paramÅtrer
       CON(2) 27
       CON(2) '&'
       CON(2) 'd'
       CON(2) '@'
UNDon  GOSUB  PR-BAS
       CON(1) 4
       CON(2) 27
       CON(2) '&'
       CON(2) 'd'
       CON(2) 'D'

**************************************************
*                 WRAP ON|OFF                    *
**************************************************

       REL(5) ONOFFd
       REL(5) ONOFFp
WRAPe  GOSUB  onoff?
       GOC    wrapon
       GOSUB  PR-BAS
       CON(1) 5
       CON(2) 27
       CON(2) '&'
       CON(2) 's'
       CON(2) '1'
       CON(2) 'C'
wrapon GOSUB  PR-BAS
       CON(1) 5
       CON(2) 27
       CON(2) '&'
       CON(2) 's'
       CON(2) '0'
       CON(2) 'C'

       END             Ouf !!!