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

       CON(2) #E1      Id
       CON(2) 16       Lowest Token
       CON(2) 19       Highest Token
       CON(5) 0
       NIBHEX F        No speed table
       REL(4) 1+TxTbSt Text table offset
       CON(4) 0        Message table offset
       CON(5) 0        Poll handler offset

* Main table

       CON(3) (TxEn01)-(TxTbSt)
       REL(5) endst
       NIBHEX F
       
       CON(3) (TxEn02)-(TxTbSt)
       REL(5) endup
       NIBHEX D

       CON(3) (TxEn04)-(TxTbSt)
       REL(5) start
       NIBHEX F

       CON(3) (TxEn03)-(TxTbSt)
       REL(5) exec
       NIBHEX D

* Text table

TxTbSt
TxEn01 NIBHEX B
       NIBASC 'ENDUP$'
       CON(2) 16
TxEn02 NIBHEX 9
       NIBASC 'ENDUP'
       CON(2) 17
TxEn03 NIBHEX D
       NIBASC 'EXECUTE'
       CON(2) 19
TxEn04 NIBHEX F
       NIBASC 'STARTUP$'
       CON(2) 18

       NIBHEX 1FF      End of text table


*
* ExÅcute une ligne BASIC. EXECUTE fut Åcrit pr
* rendre programmable des
* fonctions non programmables.

* Exemple d'utilisation:
*   EDIT TOTO
*     10 DISP 'Running...'
*     20 EXECUTE "FREE:PORT(.01) @ PURGE ABC
*                  CONTRAST 7 @ RUN TOTO,30"
*     30 DISP 'Done'
*



=ADHEAD EQU   #181B7
=D=AVMS EQU   #1A460
=DELAYd EQU   #05493
=EXPEXC EQU   #0F186
=I/OALL EQU   #1197D
=I/ODAL EQU   #11A41
=I/OFND EQU   #118BA
=I/ORES EQU   #118FF
=LINEP+ EQU   #02626
=MEMERR EQU   #0944D
=MOVEU3 EQU   #1B177
=NXTSTM EQU   #08A48
=REVPOP EQU   #0BD31
=SFLAG? EQU   #1364C
=SFLAGS EQU   #135FA
=STKCHR EQU   #18504
=STRNGP EQU   #0379D
=STROVF EQU   #1411A
=XXHEAD EQU   #1A44E
=bSTART EQU   #00808
=flPWDN EQU   #000CF
=flTNOF EQU   #000CD
=pCONFG EQU   #000FB
=pPWROF EQU   #000FC
bENDUP  EQU   #00A00
bXEQ    EQU   #00A01


Polhnd LC(2)  =pCONFG
       ?B=C   B        Une reconfiguration
*                      est-elle en cours?
       GOYES  savebf
       LC(2)  =pPWROF
       ?B=C   B        La machine souhaite-elle
*                      s'endormir?
       GOYES  xeq
       RTNSXM          Non, rien de tout cela

out    C=B    A        Ces lignes, placÅes ici pr
*                      gagner de la place,
       D=C    A        restaurent le registre
*                      D(A) si chers aux FPOLL
savebf LC(3)  bENDUP
       GOSBVL =I/ORES  Evite È bENDUP d'Átre
*              dÅtruit È la prochaine reconfigu.
       LC(3)  bXEQ
       GOSBVL =I/ORES  Idem pr bXEQ
rtncc  A=-A-1 A        DÅsarme carry
       RTNSXM

xeq    LC(3)  bENDUP
       GOSBVL =I/OFND  Mets D1 @ le dÅbut du
*                      buffer (aprÉs l'en-tÁte)
       GONC   rtncc    (Du moins s'il existe)
       C=D    A        D(A)
       B=C    A          -> B(A);
       LC(2)  =flPWDN
       GOSBVL =SFLAG?  flPWDN est-il Åteint?
       GONC   out
       LC(2)  =flTNOF
       GOSBVL =SFLAG?  flTNOF est-il allumÅ?
       GOC    out
       LC(2)  =flTNOF
       GOSBVL =SFLAGS  Allumons flTNOF que l'on
*               n'intercepte pas pPWROF 1 2nd *
linep  CD1EX           D1 -> C(A) (D1 est
*                      inchangÅ depuis =I/OFND)
       GOVLNG =LINEP+  Compile la ligne BASIC @
*                      par C(A), puis l'ÅxÅcute


strngp GOVLNG =STRNGP
delayd GOVLNG =DELAYd
       REL(5) delayd
       REL(5) strngp    --- ENDUP "BASIC line" ---
endup  GOSBVL =EXPEXC  Mets la ligne È ÅxÅcuter
*                      sur la pile
       C=0    A
       LC(2)  2*95+2   Longueur max de cette
*                      ligne + 2 quartets pr 0D
       R3=C              -> R3;
       LC(3)  bENDUP
       GOSUB  end007   Stocke la ligne BASIC ds
*                      bENDUP
nxtstm GOVLNG =NXTSTM

       REL(5) delayd
       REL(5) strngp    --- EXECUTE "BASIC line"
exec   GOSBVL =EXPEXC  Mets la ligne sur la pile
       C=0    A
       C=C-1  A        Longueur max de la ligne
*                      (65536) -> C(A)
       R3=C              -> R3;
       LC(3)  bXEQ
       GOSUB  end007   Stocke la dite ligne ds
*                      bXEQ
       GONC   nxtstm   Va lÈ-bas si elle ne
*                      contient aucune instruction
       LC(3)  bXEQ
       GOSBVL =I/OFND  Mets D1 @ dÅbut de la ligne
       GOTO   linep    ExÅcute lÈ


end007 R2=C            Sauvegarde l'ID du buffer
*                      de stockage
       GOSBVL =XXHEAD  EnlÉve l'en tÁte de la
*                      chaÑne placÅe sur la pile
       LCHEX  0D
       D1=D1- 2
       DAT1=C B        Ajoute 1 CR derriÉre la
*                   ligne (il faudra se rappeller
       ST=1   0        qu'elle n'est pas
*                      tokenizÅe)
       GOSUB  adhead   Ajoute un nouvel en tÁte
       GOSBVL =REVPOP  Puis inverse l'ordre des
*                      caractÉres de la chaÑne
       CD1EX           Pointeur de pile -> C(A)
       R0=C              -> R0;
       C=0    A
       C=C+1  A
       C=C+1  A        2 -> C(A);
       ?A>C   A        La ligne est-elle composÅe
*                      d'autre chose que d'un CR?
       GOYES  end010
       C=R2            Non; ID -> C(A);
       GOSBVL =I/ODAL  DÅtruit le buffer dont
*                      l'ID est ds C(A)
       RTNCC           Indique que le buffer
*                      n'existe plus

end010 B=A    A        Longueur de la ligne ->
*                      B(A);
       C=R3            Longueur max autorisÅe ->
*                      C(A);
       ?A<=C  A        La ligne n'est-elle pas
*                      trop longue?
       GOYES  end040   Non;
       GOVLNG =STROVF  Si.
end040 R1=A            Longueur de la ligne -> R1;
       C=R2            ID -> C(A);
       GOSBVL =I/OALL  Contracte ou agrandit le
*                    buffer pr qu'il ait la taille
       GOC    end050   spÅcifiÅe en A(A)
       GOVLNG =MEMERR  Erreur s'il n'y a pas
*                      suffisemment de place
end050 A=R0
       D0=A            D0 @ dÅbut de la ligne (ss
*                      forme tokenizÅe)
       C=R1            Longueur de la ligne -> R1;
       GOSBVL =MOVEU3  DÅplace la ligne de la
*                      pile ds le buffer 
       RTNSC           Indique que le buffer
*                      existe


       NIBHEX 00        --- STARTUP$ ---
start  LC(3)  =bSTART
       GONC   run      (B.E.T.)

       NIBHEX 00        --- ENDUP$ ---
endst  LC(3)  bENDUP
run    AD1EX           Sauvegarde D1 ds R1
       R1=A
       GOSBVL =I/OFND
       CD1EX
       CD0EX           D0 @ ce qui suit l'en-tÁte
       B=C    A        Sauvegarde ce pointeur ds
*                      B(A)
       GOSBVL =D=AVMS  Mets (AVMEMS) ds D(A)
       A=R1
       D1=A            D1 = (FORSTK)
       GONC   bf2s20   Va si la chaÑne contenue
*                  ds le buffer a 1 longueur nulle
bf2s10 A=DAT0 B        Prends 1 char. ds le buffer
       LCHEX  0D
       ?A=C   B        En a-t-on atteint la fin?
       GOYES  bf2s20   Non
       C=A    B        Oui
       GOSBVL =STKCHR  Mets le car. sur la pile;
*                 vÅrifie qu'il y a suf de place
       D0=D0+ 2        Passe au char. suivant
       GONC   bf2s10   (B.E.T.)

bf2s20 C=B    A
       D0=C
adhead GOVLNG =ADHEAD  Ajoute un en-tÁte a la
*                      chaÑne.
       END