LEX 'LENTERL1' * * NIBASC 'LENTERL1' * NIBHEX 802E LEX type * CON(2) 0 flags=0 * NIBHEX 0000 Mn/Hr * NIBHEX 000068 Dy/Mo/Yr * REL(5) FILEND * TITLE Line Enter from PIL Ver<861219> J Baker * CON(2) #5E last scratch CON(2) #4C see JRBTOKEN for assignment CON(2) #4C CON(5) 0 no link NIBHEX F no speed CON(4) (TxTbSt)+1-(*) CON(4) 0 no message CON(5) 0 no poll * * MAIN TABLE * CON(3) (TxEn01)-(TxTbSt) REL(5) RS232 NIBHEX D fully programmable * * TEXT TABLE * TxTbSt TxEn01 CON(1) (TxEnTm)-(*)-4 NIBASC 'LENTER' CON(2) #4C see JRBTOKEN for assignment * TxEnTm NIBHEX 1FF table end * * EQUATE TABLE * SFLAG? EQU #1364C STKVCT EQU #1470C process array dope vector D1MSTK EQU #1954E set stack, uses C(A),D1 NXTADR EQU #147E8 process next array address GETDID EQU #06D84 fetch device info eNORDY EQU #0FF22 some arbitrary error msg eMEM EQU #00018 memory error eDATTY EQU #0001F data type error REVPOP EQU #0BD31 FORSTK EQU #2F59E forstack pointer STMTR0 EQU #2F871 statement scratch FUNCR0 EQU #2F89B function scratch FUNCD0 EQU (FUNCR0)+32 EXPEXC EQU #0F186 expression execution DEST EQU #0F7B0 save variable info DVCSPp EQU #07925 parse device spec NTOKEN EQU #0493B get next token t@ EQU #000F4 tSEMIC EQU #000F2 tCOMMA EQU #000F1 SYNTXe EQU #02E2B parse error OUT1TK EQU #02CEB OUTBYT EQU #02CE8 output byte READP5 EQU #0323B parse variable list FILDC* EQU #05759 decompile device DROPDC EQU #05470 decompile variable NXTSTM EQU #08A48 execution exit STORE EQU #0F5F8 store to a variable AVMEMS EQU #2F594 mem start GETDev EQU #00B5B fetch con/dev mode GETMBX EQU #03B62 set D0 to mbx PUTE EQU #06AC0 put opcode YTML EQU #00C9B dev T/dia L GETX EQU #066B0 get DOE FRAME- EQU #0073B decode opcode STRNGP EQU #0379D * ************************************************************ * * * JUMPER: a routine for accessing the HPIL ROM * SNAPBF EQU #2F7F0 the snapshot buffer bLEX EQU #00BFC the LEX buffer ID # I/OFND EQU #118BA finds an I/O buffer given the ID # LEXPIL EQU #000FF the HPIL ROM ID # eXWORD EQU #00023 mainframe error # for XWORD BSERR EQU #0939A the BASIC error reporting routine * * this routine is transparent to the CPU except for SB * * (assembly code) * (setup CPU for call) * GOSUB JUMPER * CON(5) (target routine offset) * (resume assembly code) * *********************************************************** * JUMPER RSTK=C CD1EX D1=(5) SNAPBF DAT1=C A write D1 @ SNAPBF D1=(2) (SNAPBF)+5 C=RSTK DAT1=C W write C(W) @ SNAPBF + 5 D1=(4) (SNAPBF)+21 DAT1=A W write A(W) @ SNAPBF + 21 D1=(2) (SNAPBF)+37 C=B A CPEX 5 save P @ SNAPBF + 42 P= 6 C=0 P GONC JUMP05 C:6='0' means carry clear C=C-1 P C:6#'0' means carry set JUMP05 P= 7 C=0 P C=C-1 P C:7='9' means decimal mode DAT1=C 8 write B(A),P,Carry,mode @ SNAPBF + 37 SETHEX set hex mode for I/OFND ************ * now A(W), B(A), C(W), and D1 are available for use * P= 0 LC(3) bLEX find the LEX buffer GOSBVL I/OFND GONC JUMP90 if not there, error exit ************ * LEX buffer found; D1 points to it * search the LEX buffer for the HPIL ROM entry * LC(2) LEXPIL C(B)=HPIL ROM ID # B=C A A=0 A A=A+1 A A(B)=Token # within HPIL ROM JUMP10 C=DAT1 6 ?C=0 B is this the end of the LEX buffer ? GOYES JUMP90 yes, then error exit ?B#C B is this the right ID ? GOYES JUMP20 no, try the next one ************ * LEX ID matches; see if token # is in range * CSR W CSR A C 3:0 is now the token range ?A ** STKVCT, NXTADR ** ** Uses: everything available to expressions, STMTxx ** ** Levels: 7 ** ** Notes: ** ** Syntax... ** LENTER ;[,[,]] ** ** is a standard HPIL device specifier ** ** is a string variable or string array used ** as the input list. This variable must exist ** prior to entry or an error occurs. ** ** is an optional terminating character. The ** code always terminates on EOT or ENDs ** see below for further description ** ** is a list of up to 2 characters to be ** 'stripped' from the end of an input string ** typically used to strip trailing CRs & LFs ** ** System Flag -23 is used in the following manner by this ** code. This use is not totally out of line... ** there are two cases to be handled, Scalar & Array ** ** When the input is to a scalar String variable then ** EOT and END frames will always close entry & exit. ** Likewise, if a is given, it also closes. ** naturally, overflow closes ** Flag -23 is ignored ** chars are stripped by ** ** Input to an Array String is another story... ** EOTs close entry and exit to NXTSTM or BSERR. ** ENDs, s, or element overflows simply close ** entry to that element and go to next element. ** Naturally, when all elements are done, we exit! ** Flag -23 works as follows... ** ** Clear = ENDs, or s terminate all ** entry and exit to NXTSTM/BSERR ** this is like scalar operation ** ** Set = ENDs or only close element ** entry. EOT or all elements full is ** needed to exit to NXTSTM/BSERR. ** ** This should allow LENTER to handle most all entry ** situations encountered. Notice that Flag -23 must ** be set to allow array elements after the first to ** be filled. This allows flexibility of input. ** ** what may not be obvious is that if you want to ** specify s but have no active ** then specify a null string for , i.e. "" ** NOTE WELL..., CHR$(0) is NOT null... ** ** NOTE... I provide NO indication as to the last element ** which was filled in an array. ** If such indication is needed, I suggest dedicating ** element 0 (1) as the count. ** ** Statement Scratch Layout... ** ** 5 STMTR0 = Variable address ** 5 5+(STMTR0)= sub 1 ** 5 10+(STMTR0)= sub 2 ** 1 15+(STMTR0)= type ** 5 16+(STMTR0)= array element # ** 5 21+(STMTR0)= max length ** 5 26+(STMTR0)= trace address ** 1 31+(STMTR0)= sub count ** 2 32+(STMTR0)= ** 2 34+(STMTR0)= 1 ** 2 36+(STMTR0)= 2 ** 3 38+(STMTR0)= my ST save ** ** ST layout... ** ** 0= --+ ** 1= +--->> these used by HPIL ROM ** 2= | ** 3= --+ ** 4= 1 given ** 5= 2 given ** 6= Flag -23 status ** 7= Array Variable ** 8= given ** 9= ** 10= ** 11= ** *********************************************************** * parse code pGETRS ST=0 10 disallow * GOSUB JUMPER CON(5) DVCSPp parse device specifier GOSBVL NTOKEN fetch next token LC(2) tSEMIC ?A=C B is it semicolon ? GOYES pGETR1 yes GOVLNG SYNTXe no, error pGETR1 LC(2) t@ GOSBVL OUTBYT write an @ token to terminate device LC(2) tSEMIC GOSBVL OUTBYT now write a semicolon token ST=1 8 disallow stupid (dummy) arrays ST=1 9 parse only a single string variable GOSBVL READP5 parse input variable GOSBVL NTOKEN fetch next token LC(2) tCOMMA ?A=C B comma ? GOYES pGETR2 yes, parse terminator character RTN no, exit pGETR2 GOSBVL OUT1TK output comma GOSBVL STRNGP parse term char GOSBVL NTOKEN LC(2) tCOMMA ?A=C B comma ? GOYES pGETR3 yes, parse strip list RTN no, exit pGETR3 GOSBVL OUT1TK output comma GOVLNG STRNGP parse strip characters * * decompile code * dGETRS GOSBVL FILDC* decompile device D1=D1+ 2 step past @ token GOVLNG DROPDC decompile variable & list * *********************************************************** * REL(5) dGETRS decompile REL(5) pGETRS parse RS232 GOSUB JUMPER CON(5) GETDID fetch device GONC RS01 Rerror P= 0 error if bad LC(4) eNORDY use some convenient error message GOTO bserr RS01 ?D#0 B address given ? GOYES RS04 yes C=D S no P=C 15 ?P# 5 LOOP ? GOYES Rerror no P= 0 yes RS04 GOSUB JUMPER CON(5) GETDev GOC Rerror error if not controller D1=(5) FORSTK A=DAT1 A read FORSTK pointer D1=D1- 5 point to MTHSTK pointer AD1EX D1=D1- 3 allow for device AD1EX DAT1=A A write new stack bottom D1=A point there C=D X DAT1=C X save device D0=(5) FUNCD0 C=DAT0 A D0=C restore D0 D0=D0+ 4 skip t@ and tSEMIC CD0EX swap out pc D0=(5) (STMTR0)+26 DAT0=C A save variable trace address CD0EX restore pc GOSBVL EXPEXC evaluate variable GOSBVL DEST save variable stuff for STORE P= 13 C=P 15 load scalar string type P= 0 ?C=B S is this a string variable ? GOYES RS03 yes C=C-1 S ?C=B S is it a string array ? GOYES RS03 yeah, ok..., I guess that'll do... RS02 LC(4) eDATTY GOTO bserr nope..!!, el tougho de luck pal... RS03 CLRST GOSUB RSD1ST set D1 to allow for info DAT1=A W save variable info for later C=A A copy variable info CSR A shift off type ?C=0 P is it scalar ? GOYES RS12 yes ST=1 7 no, set array status RS12 C=ST AD0EX swap out pc D0=(5) (STMTR0)+38 DAT0=C X save ST D0=A restore pc GOSUB RSD1ST collapse stack to save area top A=DAT0 B read next token LC(2) tCOMMA ?A=C B given ? GOYES RS13 yes GOTO RS16 no RS13 D0=D0+ 2 step over terminator GOSBVL EXPEXC evaluate GOSBVL REVPOP pop A=0 M ASRB convert to bytes B=A A AD0EX swap out pc D0=(5) (STMTR0)+38 C=DAT0 X ST=C restore ST ?B=0 A given ? GOYES RS14 no ST=1 8 yes D0=(2) (STMTR0)+32 C=DAT1 B read DAT0=C B save it D0=(2) (STMTR0)+38 RS14 C=ST DAT0=C X save ST D0=A restore pc GOSUB RSD1ST collapse stack to save top A=DAT0 B read next token LC(2) tCOMMA ?A=C B s given ? GOYES RS15 yes GOTO RS16 no, go test Flag -23 RS15 D0=D0+ 2 step past tCOMMA GOSBVL EXPEXC evaluate s GOSBVL REVPOP pop A=0 M ASRB convert length to bytes D0=(5) (STMTR0)+38 C=DAT0 X ST=C restore ST ?A=0 A null list ? GOYES RS16 yes, go test Flag -23 ST=1 4 no, set 1 D0=(2) (STMTR0)+34 C=DAT1 B read byte DAT0=C B save D1=D1+ 2 D0=D0+ 2 A=A-1 A decrement length ?A=0 A 2 given ? GOYES RS16 no ST=1 5 yes C=DAT1 B read it DAT0=C B save RS16 D0=(5) (STMTR0)+38 LC(2) #E9 load Flag -23 GOSBVL SFLAG? test it GONC RS17 jump if clear ST=1 6 show set RS17 C=ST DAT0=C X save ST ?ST=0 7 array ? GOYES RSPROC no GOSUB RSD1ST collapse stack to info CLRST ST=1 8 set for first time GOSBVL STKVCT setup pointers GOSBVL NXTADR setup element D1=(5) (STMTR0)+21 C=0 A C=DAT1 4 fetch dimensioned length ?C#0 A null ? GOYES RSPROC no GOTO RS02 yes, error RSPROC D1=(5) FORSTK A=DAT1 A read FORSTK pointer D1=D1- 5 point to MTHSTK AD1EX A(A)=MTHSTK, D1=ptr D1=D1- 3 go to device C=DAT1 X read D=C X restore device D1=D1- 16 skip variable info AD1EX swap back D1=A restore R0=A save stack bottom D0=(5) AVMEMS A=DAT0 A read memory start D0=A D0=D0+ 16 allow for a future string header AD0EX C=R0 fetch stack bottom ?A provided ? GOYES RS18 no AD0EX yes, swap out mbx D0=(5) (STMTR0)+32 C=DAT0 B read P= 2 LCHEX F5 create opcode P= 0 CSL W CSL W AD0EX restore mbx GOSUB pute set terminating character LCHEX F40100 GOSUB pute set term on char match mode on GOTO RS19 continue RS18 LCHEX F40000 GOSUB pute set term on char match mode off RS19 LCHEX F40C00 GOSUB pute set terminate on END frame on ?D=0 B LOOP ? GOYES RS07 yes GOSUB ytml no, set device to talk, me to listen RS07 ?B#0 A count finished ? GOYES RS09 no RS08 GOTO RSEND yes, exit * RS21 GOTO RS06 * RS09 C=B A P= 5 LCHEX 8 P= 0 GOSUB pute send SDA SOT frame A=R2 fetch memory start RS10 ?B=0 A count finished ? GOYES RS08 yes, exit GOSUB JUMPER no CON(5) GETX fetch I/O processor message GOC RS20 exit if not DOE frame RS11 B=B-1 A decrement count D1=D1- 2 allow for byte CD1EX ?A>=C A collision ? GOYES RS21 yes, give memory error CD1EX no, restore D1 DAT1=C B write byte ?P= 0 single DOE ? GOYES RS10 yes, loop P=P-1 no, must be 3 DOE transfer, dec count CSR W CSR A shift in next to C(B) ?B#0 A count overflow ? GOYES RS11 no LCHEX 154200 yes GOSUB pute send NRD frame GOTO RSEND terminate, may lose 2 frames!!!!! RS20 ?P# 0 ON key abort ? GOYES RSEND yes, keep previously read bytes GOSUB frame- no, see why we stopped ?P= 6 EOT frame ? GOYES RSEND yes ?P= 8 Terminator match ? GOYES RSEND yes P= 0 no, must be an error ?D=0 B LOOP ? GOYES RS22 yes LCHEX 145F00 no GOSUB pute send UNT frame RS22 GOTO Rerror error out RSEND P= 0 ?D=0 B LOOP ? GOYES RS30 yes LCHEX 145F00 no GOSUB pute send UNT RS30 LCHEX F50A00 GOSUB pute restore LF term char LCHEX F40000 GOSUB pute clear char match mode LCHEX F40800 GOSUB pute clear END mode C=R0 fetch stack bottom AD1EX D1=A swap out stack pointer C=C-A A compute length ACEX A ?A=0 A null ? GOYES RS32 yes ?ST=0 4 no, 1 given ? GOYES RS32 no D0=(5) (STMTR0)+34 yes C=DAT0 B read it D=C B save it C=DAT1 B read last char from loop ?D#C B match ? GOYES RS31 no D1=D1+ 2 yes, eliminate A=A-1 A A=A-1 A alter count RS31 ?ST=0 5 2 given ? GOYES RS32 no D0=(2) (STMTR0)+36 yes C=DAT0 B read it D=C B save it C=DAT1 B read loop char ?D#C B match ? GOYES RS32 no D1=D1+ 2 yes, skip A=A-1 A A=A-1 A alter count RS32 C=0 W C=A A copy in count CSLC CSLC LCHEX F makeup string header D1=D1- 16 D1=C W write it out A=C W also copy to A(W) for use by STORE GOSBVL STORE write to variable GOSUB RSD1ST restore stack D0=(5) (STMTR0)+38 C=DAT0 X ST=C restore ST ?ST=0 7 array ? GOYES RS33 no, exit ?ST=0 6 Flag -23 ? GOYES RS33 no CLRST yup, now lets do array junk ST=1 2 set string GOSBVL NXTADR get next element address GOSBVL STKVCT see if we're done GONC RS33 yup, quittin time... GOTO RSPROC nope, another round please...! RS33 GOVLNG NXTSTM exit, exeunt for arrays * RSD1ST D1=(5) FORSTK C=DAT1 A read forstack D1=D1- 5 point to MTHSTK CD1EX D1=D1- 3 allow for device address D1=D1- 16 allow for Variable information CD1EX DAT1=C A write MTHSTK to protect info D1=C point to stack RTN * END