LEX 'NLOOPLEX' * TITLE NLOOP LEX, Ver, Jean-Francois Garnier * *********************************************************** * ID #E1 Paris Chapter LEX ID 113 MSG 0 POLL 0 ENTRY NLOOP CHAR #F ENTRY PPOLL CHAR #F ENTRY Sleep CHAR #D ENTRY SRQ CHAR #F KEY 'NLOOP' TOKEN 62 KEY 'PPOLL' TOKEN 63 KEY 'SLEEP' TOKEN 64 KEY 'SRQ' TOKEN 65 ENDTXT * *********************************************************** * EQUATES * * GET EQU #06751 ERRORX EQU #0342C AVMEMS EQU #2F594 GETD EQU #067C8 DEVPAR EQU #01BF0 EXPEXC EQU #0F186 the expression execution controller XYEX EQU #0C697 exchange AB/CD uRES12 EQU #0C994 pack 15 form in AB to 12 form in C MP2-15 EQU #0C43A multiply two 15s BF2STK EQU #18663 push string to stack FNRTN1 EQU #0F216 push C(W) to stack at bottom TRFMBF EQU #2F8C5 REV$ EQU #1B38E reverse string on stack VAL00 EQU #1AD8F convert string to number, ST10=1 for rtn GETMBX EQU #03B62 set D0 to ^MBOX value SCRTCH EQU #2F901 scratch ram, 64d nibs FNRTN4 EQU #0F238 pushes C(W) at D1, assumes D1 ready SPLITA EQU #0C6BF split A(W) to AB SPLITC EQU #0C940 split C(W) to CD DV2-15 EQU #0C4AC divide two 15s, AB=AB/CD LGT15 EQU #0D1AE AB=LOGbase10(AB) POP1N EQU #0BD1C pop number to A(W) FLTDH EQU #1B223 convert 12 form to hex integer FUNCD0 EQU #2F8BB GETLPs EQU #01D15 PUTC EQU #06B1C SNAPBF EQU #2F7F0 the snapshot buffer bLEX EQU #00BFC the LEX buffer ID # HDFLT EQU #1B31B 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 WRDSCN EQU #02C2A scan table for token match & output tON EQU #000E0 the ON token tOFF EQU #000E1 the OFF token MSPARe EQU #02E5C parse error for missing parm TRACDC EQU #052FC decompile for ON/OFF OUTELA EQU #05303 keyword only decompile eIVARG EQU #0000B Invalid Argument error START EQU #007E8 searchs the loop for a device MTYL EQU #00C83 make me talk, device listen PRASCI EQU #00FEA send bytes to setup device UTLEND EQU #007CC untalk, unlisten the loop SLEEP EQU #006C2 CKSREQ EQU #00721 NXTSTM EQU #08A48 BASIC Statement return EXPR EQU #0F23C expression execution reentry READSU EQU #0663D read bytes from loop, sends sot frame FUNCR0 EQU #2F89B Function scratch RAM YTML EQU #00C9B make device talk, 71 listen NUMCK EQU #0369D parse numeric expression RESPTR EQU #03172 restore parse input pointer FIXDC EQU #05493 decompile numeric expression PUTE EQU #06AC0 put a frame to the mailbox from C 5:0 POP1S EQU #0BD38 pop a string on stack STRGCK EQU #036BA parse a string expression REVPOP EQU #0BD31 reverse a string then pop * * *********************************************************** NIBHEX 801 NLOOP GOSUB JUMPER CON(5) GETLPs Search for HP-IL mailbox GOC err Error? LC(4) #0100 Ask for # of peripherals on loop GOSUB SEND A=C A result GONC SRQ1 B.E.T. NIBHEX 801 PPOLL GOSUB SIDY Send IDY 00 A=C B Result GONC SRQ1 B.E.T. NIBHEX 801 SRQ GOSUB SIDY Send IDY 0 CSR A CSR A A=C P (P=0) LC(1) 1 A=A&C P Isolate the SRQ bit * SRQ1 GOSBVL HDFLT Floating point conversion D0=(5) FUNCD0 C=DAT0 A CD0EX restore D0 C=A W Result GOVLNG FNRTN1 end SIDY GOSUB JUMPER Find mailbox CON(5) GETLPs GOC err LC(4) #1E00 SEND GOSUB JUMPER CON(5) PUTC GOC err GOSUB JUMPER CON(5) GET GOC err A=0 A RTNCC err GOSUB JUMPER CON(5) ERRORX REL(5) Sleepd REL(5) Sleepp Sleep CD0EX Save D0 R0=C CD1EX R1=C GOSBVL SLEEP GOSBVL CKSREQ C=R1 D1=C C=R0 D0=C GOVLNG NXTSTM Sleepp RTNCC Sleepd GOVLNG OUTELA *********************************************************** * STITLE HPIL JUMPER * * * JUMPER: a routine for accessing the HPIL ROM * * * 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