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

tENDW  EQU    66
tWHILE EQU    67
tREPT  EQU    68
tUNTIL EQU    69
tLEAVE EQU    70

       CON(2) LEXID    ID equivalent
       CON(2) tENDW
       CON(2) tLEAVE
       CON(5) 0
       NIBHEX F
       REL(4) 1+TxTbSt
       MSG    ermsgs
       POLL   0

*
* M A I N   T A B L E
*

       CON(3) (TxEn01)-(TxTbSt)
       REL(5) ENDW
       CON(1) 13

       CON(3) (TxEn02)-(TxTbSt)
       REL(5) WHILE
       CON(1) 13

       CON(3) (TxEn03)-(TxTbSt)
       REL(5) REPT
       CON(1) 13

       CON(3) (TxEn04)-(TxTbSt)
       REL(5) UNTIL
       CON(1) 13

       CON(3) (TxEn05)-(TxTbSt)
       REL(5) LEAVE
       CON(1) 13

*
* T E X T   T A B L E
*

TxTbSt
TxEn01
       CON(1) 5
       NIBASC 'END'
       CON(2) tENDW

TxEn05
       CON(1) 9
       NIBASC 'LEAVE'
       CON(2) tLEAVE

TxEn03 
       CON(1) 11
       NIBASC 'REPEAT'
       CON(2) tREPT

TxEn04 
       CON(1) 9
       NIBASC 'UNTIL'

       CON(2) tUNTIL
TxEn02
       CON(1) 9
       NIBASC 'WHILE'
       CON(2) tWHILE

       NIBHEX 1FF

LEXID  EQU    #E1
tXWORD EQU    #EF
WHILEt EQU    9
REPTt  EQU    10
eNOWHL EQU    3
eNORPT EQU    4
eLEAVE EQU    5
eNOENW EQU    6
eINVLD EQU    236
oFTYPh EQU    #10
fBASIC EQU    #0E214
eSYSER EQU    #17
bSTMT  EQU    #801

STMTD0 EQU    #2F891
STMTD1 EQU    #2F896
PRGMEN EQU    #2F567
TRACEM EQU    #2F7B0
CURRST EQU    #2F55D

WRDSCN EQU    #02C2A
FIXP   EQU    #02A6E
TKSCN7 EQU    #08A99
FIXDC  EQU    #05493
REST*  EQU    #03035
EOLXC* EQU    #052EC
OUTNBC EQU    #05423
POPUPD EQU    #08F3E
EXPEXC EQU    #0F186
POP1N+ EQU    #0BD91
PSHGSB EQU    #08F13
NXTSTM EQU    #08A48
BSERR  EQU    #0939A
MFERR  EQU    #09393
RUNRT1 EQU    #074E7
STOPDC EQU    #05303
TRFROM EQU    #0FE59
TRTO+  EQU    #0FE7B
I/OFND EQU    #118BA
EOLSCN EQU    #08AA7

ermsgs CON(2) eNOWHL
       CON(2) eNOENW
       
bNOWHL CON(2) (fNOWHL)-(bNOWHL)
       CON(2) eNOWHL
       CON(1) 4
       NIBASC 'WHILE'
       CON(1) #C
fNOWHL
bNORPT CON(2) (fNORPT)-(bNORPT)
       CON(2) eNORPT
       CON(1) 8
       NIBASC 'no REPEA'
       NIBASC 'T'
       CON(1) #C
fNORPT

bLEAVE CON(2) (fLEAVE)-(bLEAVE)
       CON(2) eLEAVE
       CON(1) 14
       CON(2) eINVLD   'Invalid ' building block
       CON(1) 4
       NIBASC 'LEAVE'
       CON(1) #C
fLEAVE

bNOENW CON(2) (fNOENW)-(bNOENW)
       CON(2) eNOENW
       CON(1) 11
       CON(1) 11
       NIBASC 'no END W'
       NIBASC 'HILE'
       CON(1) #C
fNOENW

       NIBHEX FF

*
* END WHILE
*

       REL(5) ENDWd
       REL(5) ENDWp
ENDW   CD0EX
       D0=(5) (=STMTD1)
       DAT0=C A
       CD0EX
       GOSUB  popupd
       GOC    ENDW01
       P=     15
       LC(1)  WHILEt
       P=     0
       ?C=D   S        compare avec notre type
       GOYES  ENDW02   Ok
ENDW01 P=     0
       LC(2)  eNOWHL
myerr  P=     2
       LC(2)  LEXID
       P=     0
       GOVLNG =BSERR
ENDW02 ?ST=1  13
       GOYES  ENDW04   depuis un programme
       P=     0
       LC(3)  bSTMT    depuis le clavier
       GOSBVL =I/OFND
       B=A    A        longueur du buffer
       CD1EX           C[A] dÅbut du buffer
       ?D<C   A        addr < dÅbut du buffer
       GOYES  ENDW01
       C=C+B  A        C[A] È fin du buffer
       ?D>=C  A
       GOYES  ENDW01
ENDW04 C=D    A        adresse de l'expression
       D0=(5) (STMTD0)
       DAT0=C A        STMTD0 ^ avant expression
       CD0EX
       GOSUB  eval
       GOC    ENDW10
       D0=(5) (STMTD1)
       C=DAT0 A
       CD0EX
       GOTO   runrt1

ENDW10 CD0EX
       R2=C            sauve D0 aprÅs l'expression dans R2
       D0=(5) (=STMTD0) push addresse sur GOSUB stack
       A=DAT0 A        .
       P=     15       .
       LC(1)  WHILEt   .
ENDW11 GOSUB  pshgsb   .
       C=R2            restaure D0 aprÉs expression
       CD0EX
ENDW15 ?ST=0  15       en mode TRACE
       GOYES  runrt1   non
       GOSUB  trflck   trace active ?
       GOC    runrt1   non
       CD0EX
       R2=C
       GOSBVL =TRFROM  exÅcute la partie FROM de trace
       C=R2
       D0=C
       GOSBVL =TRTO+   partie TO de trace
       A=R2
       D0=A            restaure D0 et fin
runrt1 GOVLNG =RUNRT1

trflck ST=0   10       pompÅ sans vergogne (#0FE18)
       ?ST=0  15
       RTNYES
       ?ST=0  13
       RTNYES
       ?ST=1  10
       RTNYES
       D1=(5) TRACEM
       P=     0
       LCHEX  2
       A=DAT1 B
       A=A&C  P
       A=A-1  P
       D1=(5) =CURRST
       C=DAT1 A
       D1=C
       D1=D1+ (oFTYPh)-1
       A=DAT1 A
       ASR    A
       LC(5)  =fBASIC
       ?A=C   A
       GOYES  clrcy
       RTNSC
clrcy  RTNCC

* WHILE <expression>
*

       REL(5) WHILEd
       REL(5) WHILEp
WHILE  GOSUB  saveD0   sauve D0 dans STMTD0
       CD0EX
       GOSUB  eval
       GONC   WHIL20   condition fausse
       CD0EX
       R2=C
       D0=(5) (STMTD0) adresse du dÅbut d'expression
       A=DAT0 A
       P=     15
       LC(1)  WHILEt
       GOSUB  pshgsb
       C=R2            restaure D0
       CD0EX
nxtstm GOVLNG =NXTSTM

* La condition est fausse, on doit trouver le END WHILE 
* correspondant È notre WHILE. On utilise un compteur
* dans R2[A] incrÅmentÅ par un WHILE
* et decrementÅ par END WHILE.

WHIL20 C=0    A        prepare compteur
       C=C+1  A        R2[A] incrementÅ par notre WHILE
       R2=C
       ?ST=0  13
       GOYES  WHIL05
       D1=(5) PRGMEN   fin du programme
       C=DAT1 A
       GOTO   WHIL06
WHIL05 P=     0
       LC(3)  bSTMT    clavier: cherche la fin du buffer
       GOSBVL =I/OFND
       CD1EX
       C=C+A  A
WHIL06 D=C    A        fin de recherche dans D[A]
WHIL21 P=     0
       LC(2)  tXWORD
       GOSBVL =TKSCN7
       GOC    WHIL22   trouvÅ
       LC(2)  eNOENW
       GOTO   myerr    'no END WHILE'
WHIL22 D0=D0+ 2
       LC(4)  (tWHILE)*#100+(LEXID)
       P=     3
       A=DAT0 WP
       ?A#C   WP
       GOYES  WHIL23   ce n'est pas un WHILE
       C=R2
       C=C+1  A        compte un WHILE
       R2=C
       GOTO   WHIL30
WHIL23 P=     2
       LC(2)  tENDW
       P=     3
       ?A#C   WP
       GOYES  WHIL30   ce n'est pas END WHILE
       C=R2
       C=C-1  A        compte un END WHILE
       ?C=0   A        terminÅ ?
       GOYES  WHIL40   oui !
       R2=C
WHIL30 GOSUB  eol      va È tEOL ou t@
       GOTO   WHIL21   retourne chercher
       
WHIL40 D0=D0+ 4
       GOTO   ENDW15   TRACE s'il y a lieu

* Evalue l'expression pointÅe par D0, retour avec carry clear
* si 0
* D0 ^ fin d'expression au retour

eval   GOSBVL =EXPEXC
       GOSBVL =POP1N+
       SETHEX
       P=     14
       GONC   eval01
       ?A#0   WP
       GOYES  eval02
       A=R0
eval01 ?A#0   WP
       GOYES  eval02
       RTNCC
eval02 RTNSC

* va en fin de ligne si D0 ^ tXWORD

eol    D0=D0- 4        retour È l'octet longueur
       A=0    A
       A=DAT0 B        longueur de ligne
       B=A    A
       AD0EX
       A=A+B  A        A[A] ^ tEOL ou t@
       D0=A
       RTN

pshgsb GOVLNG =PSHGSB
popupd GOVLNG =POPUPD

saveD0 CD0EX
       D0=(5) (STMTD0)
       DAT0=C A
       RTN

*
* WHILE <expression>
*

       REL(5) WHILEd   parse & decompile = WHILE 
       REL(5) WHILEp
UNTIL  CD0EX
       D0=(5) (=STMTD1)
       DAT0=C A
       GOSUB  popupd
       GOC    UNTI01
       P=     15
       LC(1)  REPTt
       P=     0
       ?C=D   S        compare avec notre type
       GOYES  UNTI02   Ok
UNTI01 LC(2)  eNORPT
       GOTO   myerr
UNTI02 ?ST=1  13
       GOYES  UNTI04   depuis un programme
       P=     0
       LC(3)  bSTMT    depuis le clavier, trouve le buffer
       GOSBVL =I/OFND
       B=A    A        longueur du buffer
       CD1EX           D1 buffer start
       ?D<C   A        addr < buffer start
       GOYES  UNTI01
       C=C+B  A        C[A] end of buffer
       ?D>=C  A
       GOYES  UNTI01
UNTI04 C=D    A        adresse de l'expression
       D0=(5) (STMTD0)
       DAT0=C A        sauve adresse aprÉs REPEAT
       D0=D0+ 5        D0 ^ STMTD1
       C=DAT0 A
       CD0EX           D0 ^ expression
       GOSUB  eval
       GONC   UNTI10
       GOTO   runrt1
UNTI10 D0=(5) (STMTD0) adresse aprÉs REPEAT
       A=DAT0 A
       R2=A
       P=     15
       LC(1)  REPTt
       GOTO   ENDW11   trace s'il y a lieu

*
* REPEAT
*

       REL(5) REPTd
       REL(5) REPTp
REPT   AD0EX
       P=     15
       LC(1)  REPTt
       GOSUB  pshgsb
       CSRC
       CD0EX
       GOTO   nxtstm

*
* LEAVE
*
       REL(5) REPTd
       REL(5) REPTp
LEAVE  GOSUB  saveD0   sauve D0 dans STMTD0
       GOSUB  popupd
       GOC    LEAV01
       P=     15
       LC(1)  REPTt
       ?C=D   S
       GOYES  LEAV02
       LC(1)  WHILEt
       ?C=D   S
       GOYES  LEAV02
LEAV01 LC(2)  eLEAVE
       GOTO   myerr

* On utilise R2[A] comme compteur, incremente par REPEAT ou WHILE
* decremente par UNTIL ou END WHILE

LEAV02 C=0    A        initialialise compteur
       C=C+1  A
       R2=C
       ?ST=0  13       depuis le clavier ?
       GOYES  LEAV05   oui
       D1=(5) PRGMEN   fin du programme
       C=DAT1 A
       GOTO   LEAV06
LEAV05 P=     0        depuis le clavier, cherche le buffer
       LC(3)  bSTMT
       GOSBVL =I/OFND
       CD1EX
       C=C+A  A
LEAV06 D=C    A        adr. de fin d'analyse dans D[A]
       D0=(5) (=STMTD0)
       C=DAT0 A
       CD0EX           restitue D0
LEAV21 P=     0
       LC(2)  tXWORD
       GOSBVL =TKSCN7
       GOC    LEAV22   si trouvÅ
       LC(2)  eLEAVE
       GOTO   myerr
LEAV22 D0=D0+ 2
       LC(4)  (tENDW)*#100+(LEXID)
       P=     3
       A=DAT0 WP
       ?A=C   WP
       GOYES  LEAV30   c'est END WHILE
       P=     2
       LC(2)  tUNTIL
       P=     3
       ?A=C   WP
       GOYES  LEAV30   c'est UNTIL
       P=     2
       LC(2)  tREPT
       P=     3
       ?A=C   WP
       GOYES  LEAV33   c'est REPEAT
       P=     2
       LC(2)  tWHILE
       P=     3
       ?A=C   WP
       GOYES  LEAV33   c'est WHILE
LEAV32 GOSUB  eol      retourne chercher
       GOTO   LEAV21
LEAV33 C=R2
       C=C+1  A
       R2=C            met a jour le compteur
       GOTO   LEAV32
LEAV30 C=R2
       C=C-1  A
       R2=C            met a jour le compteur
       ?C#0   A
       GOYES  LEAV32   pas termine
       GOSUB  eol      D0 ^ tEOL ou t@
       GOTO   ENDW15   TRACE s'il y a lieu

REPTd  GOVLNG =STOPDC
REPTp  RTNCC

ENDWp  GOSBVL =WRDSCN
       CON(2) =tXWORD  essayer WHILE aprÉs END
       CON(2) =LEXID
       CON(2) tWHILE   
       REL(3) ENDWp1   si ok
       CON(2) 00
       P=     0        sinon on essaie d'autres END
       GOVLNG =REST*
ENDWp1 D0=D0- 6        si END WHILE on ne stocke pas tWHILE
       RTNCC
ENDWd  LCASC  'ELIHW' display WHILE
       P=     9
       GOSBVL =OUTNBC
       GOSBVL =EOLXC*  on doit Átre È EOL

WHILEp GOVLNG =FIXP    merci HP
WHILEd GOVLNG =FIXDC
       END