LEX    'ENDUPLEX' 
       TITLE  ENDUPLEX - J.J. MOREAU JPC#31
       CON(2) #E1      Id
       CON(2) 16       Low token
       CON(2) 19       high token
       CON(5) 0
       NIBHEX F        no speed table
       REL(4) 1+TxTbSt Text table offset
       CON(4) 0        Message table offset
       REL(5) Polhnd   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
*
* EXECUTE was writen to help make non-programmable functions programmable.
*
* Sample use: (in a BASIC program)
* 10 DISP "Running..."
* 20 EXECUTE "FREE:PORT(.01) @ PURGE ABC @ CONTRAST 7 @ RUN DOIT,30"
* 30 DISP 'Done'
*
AHEAD  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        is the system being reconfigured?
       GOYES  savebf

       LC(2)  pPWROF
       ?B=C   B        is the 71 trying to go to sleep?
       GOYES  xeq      yes, execute ENDUP$
       RTNSXM          none of the above, not our business

out    C=B    A        these lines restore D(A) so loved by FPOLLs
       D=C    A

savebf LC(3)  bENDUP
       GOSBVL I/ORES   prevent the destruction of bENDUP (ENDUP buffer) come
       LC(3)  bXEQ     next reconfiguration time
       GOSBVL I/ORES   same for bXEQ
rtncc  A=-A-1 A        clear carry
       RTNSXM
xeq    LC(3)  bENDUP
       GOSBVL I/OFND   puts D1 to start of buffer, just after the header
       GONC   rtncc    ..if it exists.
       C=D    A
       B=C    A        save D(A) in B(A)
       LC(2)  flPWDN
       GOSBVL SFLAG?   is flPWDN off?
       GONC   out
       LC(2)  flTNOF
       GOSBVL SFLAG?   is flTNOF set?
       GOC    out
       LC(2)  flTNOF
       GOSBVL SFLAGS   set flTNOF so that we do not intercept pPWROF a 2nd
*                      time
linep  CD1EX           D1 --> C(A) - D(A) is unchanged since I/OFND
       GOVLNG LINEP+   Compile the string and execute it

strngp GOVLNG STRNGP
delayd GOVLNG DELAYd
       REL(5) delayd
       REL(5) strngp   --- ENDUP "BASIC line"
endup  GOSBVL EXPEXC   put the string on the stack
       C=0    A
       LC(2)  2*95+2   max length for this string +2 nibs for OD
       R3=C
       LC(3)  bENDUP
       GOSUB  end007   store string in bENDUP
nxtstm GOVLNG NXTSTM

       REL(5) delayd
       REL(5) strngp   --- EXECUTE "BASIC line"  ---
exec   GOSBVL EXPEXC   put string on stack
       C=0    A
       C=C-1  A        max length of string (65536) --> C(A)
       R3=C            --> R3
       LC(3)  bXEQ
       GOSUB end007    stuff said line in bXEQ
       GONC   nxtstm   go if there are no instructions
       LC(3)  bXEQ
       GOSBVL I/OFND   put D1 to start of string
       GOTO  linep     execute it
end007 R2=C            save the id of the buffer
       GOSBVL XXHEAD   remove header of string on stack
       LCHEX  0D
       D1=D1- 2
       DAT1=C B        add CR at end of string - remember it is not tokenized
       ST=1   0
       GOSUB ahead     add a new header
       GOSBVL REVPOP   reverse order of characters
       CD1EX           stack pointer to C(A)
       R0=C            --> R0
       C=0    A
       C=C+1  A
       C=C+1  A        2 --> C(A)
       ?A>C   A        does the line have anything more than CR?
       GOYES  end010
       C=R2            no; Id -->  C(A)
       GOSBVL I/ODAL   delete buffer with Id given in C(A)
       RTNCC           indicate buffer does not exist
end010 B=A    A        lenght of line to B(A)
       C=R3            max allowed length
       ?A<=C  A        is it too long?
       GOYES  end040   no
       GOVLNG STROVF   yes; error out with string overflow
end040 R1=A            length of line to R1
       C=R2            Id --> C(A)
       GOSBVL I/OALL   shrink or grow buffer to match A(A)
       GOC    end050
       GOVLNG MEMERR   mem error if there is no room
end050 A=R0
       D0=A            D0 @ start of string
       C=R1            length of line
       GOSBVL MOVEU3   move string from stack to buffer
       RTNSC           indicate the buffer exists

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

       NIBHEX 00       --- ENDUP$ ---
endst  LC(3)  bENDUP
run    AD1EX           save D1 in R1
       R1=A
       GOSBVL I/OFND
       CD1EX
       CD0EX           D0 --> stuff following header
       B=C    A        save in B(A)
       GOSBVL D=AVMS   put AVMEMS in D(A)
       A=R1
       D1=A            D1=(FORSTK)
       GONC   bf2s20   go is string is null length
bf2s10 A=DAT0 B
       LCHEX  0D
       ?A=C   B        have we reached the end?
       GOYES  bf2s20   no
       C=A    B        yes
       GOSBVL STKCHR
       D0=D0+ 2
       GONC   bf2s10   (B.E.T.)

bf2s20 C=B    A
       D0=C
ahead  GOVLNG AHEAD    add header to string
       END

*
* NDLR: some strings cannot be used with EXECUTE. For example,
* try EXECUTE "BEEP"