LEX 'ESCAPELX' * *********************************************************** TITLE ESCAPELX, Ver<850927>, John R Baker CON(2) #5E LEX ID, last scratch CON(2) 60 low token 60 (dec) CON(2) 71 high token 71 (dec) CON(5) 0 chain length zero NIBHEX F no speed table REL(4) (TxTbSt)+1 offset to TEXT table CON(4) 0 no Message table CON(5) 0 no Poll handler * *********************************************************** * ENTRY BLDOFF CHAR #D ENTRY BLDON CHAR #D ENTRY CMPRSS CHAR #D ENTRY EIGHT CHAR #D ENTRY EXPAND CHAR #D ENTRY EXPCMP CHAR #D ENTRY NORMAL CHAR #D ENTRY PEROFF CHAR #D ENTRY PERON CHAR #D ENTRY SIXLIN CHAR #D ENTRY UNDOFF CHAR #D ENTRY UNDON CHAR #D * *********************************************************** * KEY 'BOLDOFF' this turns off BOLD mode TOKEN 60 KEY 'BOLDON' this turns on BOLD mode TOKEN 61 KEY 'COMPRESS' this sets COMPRESSED print mode TOKEN 62 KEY 'EIGHTLIN' this sets eight lines/inch TOKEN 63 KEY 'EXPAND' this sets EXPANDED print mode TOKEN 64 KEY 'EXPCMP' this sets EXPANDED-COMPRESSED mode TOKEN 65 KEY 'NORMAL' this sets NORMAL print mode TOKEN 66 KEY 'PERFOFF' this turns off perforation-skip TOKEN 67 KEY 'PERFON' this turns on perforation-skip TOKEN 68 KEY 'SIXLIN' this sets six lines/inch TOKEN 69 KEY 'UNDEROFF' this turns off underlining TOKEN 70 KEY 'UNDERON' this turns on underlining TOKEN 71 ENDTXT end of the TEXT table * *********************************************************** * OUTELA EQU #05303 this decompiles the Keywords IS-PRT EQU #2F794 CHKASN EQU #03C57 START EQU #007E8 this sets-up the loop MTYL EQU #00C83 this makes 71 talk and 2225 listen PRASCI EQU #00FEA this sends ASCII to a setup device UTLEND EQU #007CC this cleans-up the loop when done NXTSTM EQU #08A48 this is the BASIC interpreter reentry * *********************************************************** * decomp GOVLNG OUTELA * parse RTNCC * *********************************************************** * REL(5) decomp REL(5) parse CMPRSS GOSUB setup GOSUB getadr NIBHEX B1 this is escape (27, or 1B) NIBHEX 62B62335 this is &k2S, nib reversed ******************************** REL(5) decomp REL(5) parse EIGHT GOSUB setup GOSUB getadr NIBHEX B1 escape NIBHEX 62C68344 &l8D ******************************** REL(5) decomp REL(5) parse EXPCMP GOSUB setup GOSUB getadr NIBHEX B1 escape NIBHEX 62B63335 &k3S ******************************** REL(5) decomp REL(5) parse NORMAL GOSUB setup GOSUB getadr NIBHEX B1 escape NIBHEX 62B60335 &k0S ******************************** REL(5) decomp REL(5) parse PEROFF GOSUB setup GOSUB getadr NIBHEX B1 escape NIBHEX 62C603C4 &l0L ******************************** REL(5) decomp REL(5) parse PERON GOSUB setup GOSUB getadr NIBHEX B1 escape NIBHEX 62C613C4 &l1L ******************************** REL(5) decomp REL(5) parse SIXLIN GOSUB setup GOSUB getadr NIBHEX B1 escape NIBHEX 62C66344 &l6D ******************************** REL(5) decomp REL(5) parse UNDOFF GOSUB setup GOSUB getad4 NIBHEX B1 escape NIBHEX 624604 &d@ * getad4 C=RSTK pop address of escape sequence D=C A put in D(A) C=0 A preclear C(A) LC(1) 4 number of bytes to send GOTO more continue with common code ******************************** REL(5) decomp REL(5) parse UNDON GOSUB setup GOSUB getad4 NIBHEX B1 escape NIBHEX 624644 &dD ******************************** REL(5) decomp REL(5) parse BLDOFF GOSUB setup GOSUB getad1 CON(2) 15 hex F * getad1 C=RSTK pop address of code D=C A put in D(A) C=0 A preclear C(A) upper nibs need clearing LC(1) 1 number of bytes to send GOTO more ******************************** REL(5) decomp REL(5) parse BLDON GOSUB setup GOSUB getad1 CON(2) 14 hex E ******************************** REL(5) decomp REL(5) parse EXPAND GOSUB setup GOSUB getadr NIBHEX B1 escape NIBHEX 62B61335 &k1S * *********************************************************** * setup D1=(5) IS-PRT C=DAT1 7 read PRINTER IS assignment GOSUB JUMPER CON(5) CHKASN check PRINTER IS assignment GOC errorx error if OFFed, or not valid HPIL D=C A set D for search GOSUB JUMPER CON(5) START find printer, return address in D(X) GOC errorx error if no printer GOSUB JUMPER CON(5) MTYL make 71 talk, printer listen GOC errorx error if trouble in setup procedure RTN ******************************** getadr C=RSTK pop address of object code D=C A put in D(A) C=0 A preclear high nibs of C(A) LC(1) 5 set to send five bytes more A=C A put in A(A) GOSUB JUMPER CON(5) PRASCI send code to printer GOSUB JUMPER CON(5) UTLEND clean-up loop, unlisten/untalk etc. GOC errorx error if a problem occured GOVLNG NXTSTM return to BASIC interpreter * *********************************************************** * errorx P= 0 LC(4) #FF20 load 'no device' error GOVLNG BSERR take BASIC error exit path * *********************************************************** * 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