LEX    'PRINTLEX'
**************************************************
* Le but de ce lex est de fournir toutes les
* fonctions indispensables È la gestion d'une
* imprimante (HP82905B ou HP2225B).
*
* Fonctions:
* BELL           actionne la sonnerie (HP82905B)
* BOLD ON/OFF    caractÉres gras (HP2225B)
*                caractÉres alternÅs  (HP82905B)
* CR             envoie un retour-chariot
* ESC$           retourne le code 27 (Escape)
* FF             avance le papier d'une page
* LF             avance le papier d'une ligne
* MODE n         choix des caractÉres (0 È 9)
* PERF ON/OFF    valide le saut de perforations
* PL [n1 [,n2]]  rÉgle la taille d'une page
* UNDERLINE ON/OFF soulignement (HP2225B)
* WRAP ON/OFF    valide les lignes trop longues
*                (HP2225B)
**************************************************
        ID     #71
        MSG    0        
        POLL   0

t       EQU    39       Le Token de dÅpart

        ENTRY  BELLe
        CHAR   #D
        ENTRY  BOLDe
        CHAR   #D
        ENTRY  CRe
        CHAR   #D
        ENTRY  ESCe
        CHAR   #F       Fonction !
        ENTRY  FFe
        CHAR   #D
        ENTRY  LFe
        CHAR   #D
        ENTRY  MODEe
        CHAR   #D
        ENTRY  PERFe
        CHAR   #D
        ENTRY  PLe
        CHAR   #D
        ENTRY  UNDERe
        CHAR   #D
        ENTRY  WRAPe
        CHAR   #D
*                       Syntaxe:
        KEY    'BELL'   BELL
        TOKEN  t
        KEY    'BOLD'   BOLD ON|OFF
        TOKEN  1+t
        KEY    'CR'     CR
        TOKEN  2+t
        KEY    'ESC$'   ESC$
        TOKEN  3+t
        KEY    'FF'     FF
        TOKEN  4+t
        KEY    'LF'     LF
        TOKEN  5+t
        KEY    'MODE'   MODE <expression num.>
        TOKEN  6+t
        KEY    'PERF'   PERF ON|OFF
        TOKEN  7+t
        KEY    'PL'     PL [<num.> [ , <num.> ] ]
        TOKEN  8+t
        KEY    'UNDERLIN'    UNDERLINE ON|OFF
        TOKEN  9+t
        KEY    'WRAP'   WRAP ON|OFF
        TOKEN  10+t

        ENDTXT

POLL    EQU    #12337
pPRTIS  EQU    #0F      Le poll pour imprimer.
MFERR   EQU    #09393   Main-Frame Error
NXTSTM  EQU    #08A48   Retour È Basic
PPOS    EQU    #2F956   Printer-Position (<=> TAB)
tON     EQU    #E0      Token de ON
EXPEX-  EQU    #0F178   Evaluation de l'expression
         *              pointÅe par D0
POP1R   EQU    #0E8FD   Obtention du rÅsultat.
RJUST   EQU    #12AE2   conversion en entier dÅc.
D0=AVS  EQU    #09B2C
ADHEAD  EQU    #181B7   Ajoute une en-tÁte È la
         *              chaÑne sur la math-stack.
OUTELA  EQU    #05303   DÅcompilation simple.
TRACDC  EQU    #052FC   DÅcompile de TRACE
WRDSCN  EQU    #02C2A   Recherche du Token
REST*   EQU    #03035   RÅinitialisation de
         *              l'analyse (parse)
EOLCK   EQU    #02A7E   Fin de ligne ?
DELAYp  EQU    #02AC6   Analyse de DELAY
RESPTR  EQU    #03172   Utilitaire d'analyse
DROPDC  EQU    #05470   DÅcompilation de DROP
FIXP    EQU    #02A6E   Analyse de FIX
ARGERR  EQU    #0BF19   "Argument non valide"
FORSTK  EQU    #2F59E   DÅbut de la math-stack
ASLW3   EQU    #0ED21   Utilitaire
ASLW4   EQU    #0ED1E    "      "
OUT2TC  EQU    #02CFD    "      "
CNVWUC  EQU    #03FB8   Conversion en majuscules
SYNTXe  EQU    #02E2B   "Erreur de syntaxe"
D=AVMS  EQU    #1A460   Utilitaire
EOLXCK  EQU    #05405   Fin de ligne ?


**************************************************
* PRINT
* But: Cette routine imprime la chaÑne 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.
*
* SchÅma de l'appel:
*       GOSUB  PR-BAS (ou PR-RTN)
*       CON(1) n
*       CON(2) C1
*        :
*       CON(2) Cn
**************************************************
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 dÅjÈ
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)  64       Non: "UnitÅ non trouvÅe"
        GOVLNG MFERR
noerr   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  ici      Pour avoir la position du
ici     C=RSTK          pointeur programme.
        B=C    A
        LC(5)  (retour)-(ici)
        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
        P=     0
        A=DAT1 WP       A(A)= nb de caractÉres.
        RTN             <=> GOTO A(A)
retour  ?ST=1  4
        RTNYES          Retour È l'appelant
nxtstm  GOVLNG NXTSTM   sinon retour È Basic


**************************************************
* 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

* Ici, aprÉs le test, nous savons que Carry=0.
* Puisqu'une routine d'analyse (parse) simple doit
* Átre RTNCC, il Åtait tentant de profiter de la
* situation actuelle pour faire un RTN avec mise È
* zÅro de la Carry. 
* Bilan: 2 quartets ÅconomisÅs. Eh oui, un octet, 
* c'est toujours 8 bits !

parse   RTNCC           Avec Cy=0




**************************************************
**************************************************
**
**  Routines d'analyse et de dÅcompilation
**  (ou encore: dÅcomparse)
**
**************************************************
**************************************************


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)

**************************************************
* ONOFFd
* But: dÅcompiler une alternative ON|OFF
**************************************************
ONOFFd  GOVLNG TRACDC   DÅcompilation du token

**************************************************
* 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

**************************************************
* 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 arivÅs lÈ, c'est que le token
* n'Åtait ni tON, ni tOFF. Alors, on ne reconnait 
* pas l'ordre, et on repasse la main au systÉme
* d'exploitation.

rest*   GOVLNG REST*    Reprendre l'analyse

syntax  GOVLNG SYNTXe   "Erreur de syntaxe"

**************************************************
* 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 È Basic
        GOSUB  resptr   Oui: on branche sur
        GOVLNG DELAYp   DELAY num [, num]

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

**************************************************
* PLd, NUMd
* But: dÅcompiler un ordre suivi d'une suite
* d'expressions numÅriques.
**************************************************
PLd
NUMd    GOVLNG DROPDC   Aucun param.: autorisÅ

resptr  GOVLNG RESPTR



**************************************************
*                     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     RTN             ...ici

**************************************************
*                    ESC$                        *
**************************************************
        NIBHEX 00       Fonction sans paramÉtre
ESCe    CD1EX           D1=pointeur de pile math.
        R1=C            dans R1 pour ADHEA
        D1=C
        D1=D1- 2
        P=     0
        LC(2)  27       ESC
        DAT1=C B
        GOSBVL D=AVMS   recquis par Basic
        ST=0   0        Pas de retour
        GOVLNG ADHEAD   Ajout de l'en-tÁte

**************************************************
*                     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

**************************************************
*                     LF                         *
**************************************************
        REL(5) decomp
        REL(5) parse
LFe     GOSUB  cr       MÁme principe que FF
        GOSUB  PR-BAS
        CON(1) 1
        CON(2) 10


d0=avs  GOVLNG D0=AVS


**************************************************
*                 MODE <num>                     *
**************************************************
        REL(5) NUMd
        REL(5) NUMp     Un param. num. obligatoire
MODEe   GOSUB  evalex   Evaluation 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
        GOSUB  d0=avs   D0 reµoit 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   perfoff
        A=A+1  A        1=perf on
perfoff GOSUB  escseq
        GOTO   nxtstm   retour È Basic

**************************************************
* evalex, trad
* But:
*  - evalex: Åvaluer la chaÑne 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 È 128.
**************************************************
evalex  SETHEX          recquis par EXPEX-
        GOSBVL EXPEX-   Åvaluation...
trad    GOSBVL RJUST    Traduction en entier dÅc.
        SETHEX          aprÉs RJUST
        GOC    argerr   Inf
        C=0    W
        LCHEX  128      C=00...00128
        ?A<C   W
        RTNYES          Retour autorisÅ si < 128
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 # $, oË:
*   # 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Åeistique
* 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 est È 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
        GOSUB  d0=avs
        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
        C=D    B        caractÉre final
        DAT0=C B
        D0=D0+ 2
        LCHEX  01       code de RTN
        DAT0=C B
        D0=D0- 15       D0=dÅbut de la table
        GOSUB  la
la      C=RSTK          C(A)=pointeur programme
        A=C    A
        LC(5)  (rtn)-(la) adresse d'un RTN
        C=C+A  A
        RSTK=C          empilÅe...
        CD0EX
        RSTK=C          puis l'adresse de la table
        GOTO   PR-RTN   Envoi...

argerR  GOTO   argerr
        
**************************************************
*           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
        GOSUB  evalex   Evaluation des paramÉtres
        D1=D1+ 16       DÅpilement
        AD1EX
        R1=A            Sauvegarde de D1
        D0=(5) FORSTK
        C=DAT0 A
        ?A>=C  A        Un seul paramÉtre ?
        GOYES  unique   Oui: longueur de la page
        AD1EX
        LCASC  'F'      Longueur du texte
        GOSUB  escseq
        A=R1
        D1=A
        GOSBVL POP1R
        GOSUB  trad
        AD1EX           Contorsions abominables !
unique  AD1EX
        LCASC  'P'      Longueur de la page
        GOSUB  escseq
nxtstM  GOTO   nxtstm   Retour È Basic

**************************************************
*              UNDERLINE ON|OFF                  *
**************************************************
        REL(5) UNDERd
        REL(5) UNDERp
UNDERe  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 !!!