LEX 'ESCAPELX' TITLE Escape LEX, Ver<850630> John R Baker ID #5E MSG 0 POLL 0 ******************************** 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 the decompile reentry point START EQU #007E8 this sets-up the loop MTYL EQU #00C83 this makes 71 talk and device 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 DVCSPp EQU #07925 this parses a device specifier GETDID EQU #06D84 this extracts device info at execution tCOLON EQU #000E2 colon token tCOMMA EQU #000F1 comma token PILDC EQU #07D13 NOTE WELL!!!, unsupported entry point OUTBYT EQU #02CE8 outputs a token during decompile EXPRDC EQU #05922 decompiles an expression ******************************** decomp A=DAT1 B read token LC(2) tCOLON load colon token ?A#C B is it a colon ? GOYES decom1 no, try for an expression, not literal GOSUB JUMPER yes CON(5) PILDC decompile device specifier A=DAT1 B read next token LC(2) tCOMMA load comma token ?A#C B is it a comma ? GOYES decom2 no D1=D1+ 2 yes, step over LCASC ',' GOSBVL OUTBYT output a comma GOTO decomp loop again * decom1 GOSBVL EXPRDC decompile expression decom2 GOVLNG OUTELA return to decompile driver ******************************** parse GOSUB JUMPER CON(5) DVCSPp parse a device specifier RTNCC return w/carry clear ******************************** 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 SETHEX set mode P= 0 set P GOSUB JUMPER CON(5) GETDID get device info from memory GOC errorx error out if trouble GOSUB JUMPER CON(5) START find device, return address in D(X) GOC errorx error if trouble GOSUB JUMPER CON(5) MTYL make 71 talk, device 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 device 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