LEX 'LISTLEX' * A file to list info on LEX files. J.Elhay, 14/2/88. ID #EC * Suggestion: set PWIDTH INF, then PRINT LISTLEX$ MSG 0 * and restore PIWDTH POLL 0 ENTRY LIST CHAR #F * a function KEY 'LISTLEX$' * Syntax: LISTLEX$() TOKEN 56 ENDTXT FUNCD0 EQU #2F8BB * temporary storage for D0 FUNCD1 EQU #2F8C0 * temporary storage for D1 F-R0-0 EQU #2F89B * function scratch RAM FILXQ$ EQU #09B95 * filename execute FINDF+ EQU #09F63 * find file INVFSP EQU #066FC * invalid file specifier error exit MFERR EQU #09393 * mainframe BASIC error driver BSERR EQU #0939A * BASIC system error driver HEXDEC EQU #0ECAF * HEX integer to DEC integer conversion CSLC6 EQU #1B432 * 6 circular left shifts of CPU register C D=AVMS EQU #1A460 * needed by ADHEAD ADHEAD EQU #181B7 * add header to string on stack mFERR GOVLNG MFERR iNVFSP GOVLNG INVFSP NIBHEX 411 * 1 & only 1 string parameter LIST CD0EX * save D0 D0=(5) FUNCD0 DAT0=C A GOSBVL FILXQ$ * filename execute GONC iNVFSP * error on invalid file specifier ?A=0 W * is name a null string default? GOYES iNVFSP * no good to us CD1EX * save D1 D1=C * without changing it D0=(5) FUNCD1 DAT0=C A GOSBVL FINDF+ * now find the file GOC mFERR * exit if not found A=0 A * clear A(A) and C(A) for filetype test C=0 A D1=D1+ 16 * move D1 to filetype nibs A=DAT1 4 * read filetype nibs LC(4) #E208 * smallest valid value for our LEX ?A=A A * in range? GOYES OK * we can proceed fTYPER C=0 A * else exit with invalid file type error LC(2) #3F * for which the ERRN is 63 GOVLNG BSERR * exit in shame! CRLF C=0 A * sub to add a CR and LF to the stack LC(3) #A0D D0=D0- 4 DAT0=C 4 RTN hexdec GOSBVL HEXDEC * sub to convert 2 HEX nibs to 3 dec characters P= 0 * ensure P=0 prior to loading C(B) C=0 A LC(2) #30 * which converts a dec int nib to corresponding A=0 A * ASCII for that digit GOSUB NUMBYT * one nib at a time GOSUB NUMBYT GOSUB NUMBYT C=A W * copy to C GOSBVL CSLC6 * rotate to C(5,0) SETHEX * restore HEX mode after HEXDEC D0=D0- 6 * make room on stack DAT0=C 6 * write the 3 bytes to stack GOSUB CRLF RTN NUMBYT P= 0 * needed by next line A=B P * result from HEXDEC in B, copy B(0) to A(0) A=A+C B * add #30 to get ASCII ASRC * 2 right shifts for A ASRC BSRC * move least significant digit out of way RTN OK D0=(5) FUNCD1 * set D0 to stack C=DAT0 A D0=C D1=D1- 16 * move D1 to start of file C=DAT1 W * read the filename frm the LEX file itself P= 7 * set P as a counter to write filename to stack LOOPN D0=D0- 2 * make room for a byte DAT0=C B * write a byte ( doing DAT0=C W would give the name CSRC * reversed) CSRC * shift off one byte of name P=P-1 * decrement pointer-counter GONC LOOPN * continue looping while P>=0 P= 0 * exits with P=F C=0 A * clear C(A) to load LC(2) #25 * the offset to the ID byte AD1EX * swap D1 & A(A) to A=A+C A * add the offset and AD1EX * set D1 to that byte Nxtlnk LCASC ' ID=' * write this to stack; also re-entry point after link D0=D0- 8 * make room to DAT0=C 8 * write A=0 A * clear A(A) to pick up ID byte A=DAT1 B * pick it up GOSUB hexdec * convert and write to stack C=0 W * 'Low Token=' is now written LCASC 'Low' D0=D0- 6 DAT0=C 6 LCASC ' Token=' R1=C * ' Token' is saved to obviate another LCASC D0=D0- 14 DAT0=C 14 D1=D1+ 2 * move past ID byte, point to low token byte A=0 A A=DAT1 B * read low token byte R2=A * save in R2, we will need it later GOSUB hexdec * convert and write LCASC 'High' * now for high token D0=D0- 8 DAT0=C 8 C=R1 * this contains ' Token' D0=D0- 14 DAT0=C 14 D1=D1+ 2 * past low token, point to high token byte A=0 A A=DAT1 B * read the byte R3=A * save it also, we will need this too GOSUB hexdec * convert and write D1=D1+ 2 * past byte, point to offset to next LEX table A=DAT1 A * read the offset CD1EX * swap current address into C D1=C * reset D1 to current address C=C+A A * add offset to get absolute address of next LEX table R0=C * save in R0 CD0EX * save D0 in R1 R1=C D0=(5) F-R0-0 * save the address in function scratch C=R0 DAT0=C A D0=D0+ 5 * D0 @ F-R0-1 DAT0=A A * save the offset itself in scratch C=R1 * recover D0's value and D0=C * restore it D1=D1+ 5 * move D1 past offset LCASC ' Exists'* save this for up to 3 possible cases to use R1=C C=0 A * clear C(A) C=DAT1 1 * F means 'speed table', 0 'no speed table' ?C#0 A * if not 0, then skip some code GOYES Nospd LC(2) #4F * 79 extra nibs for speed table AD1EX A=A+C A * increase D1 by 79 AD1EX LCASC 'Speed Ta' * add this to show presence of speed table D0=D0- 16 DAT0=C W LCASC 'ble' D0=D0- 6 DAT0=C 6 C=R1 * R1 contains ' Exists' D0=D0- 14 DAT0=C 14 GOSUB CRLF Nospd D1=D1+ 1 * past the speed table nib A=0 A * next 4 nibs contain the offset to the text table A=DAT1 4 * read the offset CD1EX * current address in C D1=C * reset D1 to current address A=A+C A * add to absolute address of text of 1st keyword A=A-1 A * back 1 nib for nibblecount of 1st keyword R0=A * save address in R0 D1=D1+ 4 * past offset, point to message table offset A=0 A A=DAT1 4 * read offset ?A=0 A * is offset=0? GOYES NoMSG * then no messages, skip some code LCASC 'MSGTBL' * 'MSGTBL Exists' is added to stack here D0=D0- 12 DAT0=C 12 C=R1 D0=D0- 14 DAT0=C 14 GOSUB CRLF NoMSG D1=D1+ 4 * past msgtbl offset, point to pollhandler offset A=0 A A=DAT1 A * read the offset ?A=0 A * is the offset=0? GOYES NoPOLL * no pollhandler, skip some code LCASC 'POLHND' * 'POLHND Exists' is added to stack here D0=D0- 12 DAT0=C 12 C=R1 D0=D0- 14 DAT0=C 14 GOSUB CRLF NoPOLL C=R0 * set D1 to text table D1=C C=R3 * high token ?C#0 A * is it not 0? GOYES WORDS * then there are keywords GOTO NOWORD * otherwise goto no keyword routine WORDS A=R2 * low token C=C-A A * difference hi-lo D=C A * to be used as loop counter for # of keywords LOOP C=0 W * loop to generate all the keywords in this file C=DAT1 1 * read 1st keyword's nibblecount P=C 0 * set P pointer to this value A=0 W * prepare A to accept keyword text D1=D1+ 1 * past nibblecount nib C=C+1 A * # of nibs in keyword A=DAT1 WP * copy text to A AD1EX * must update D1 past keyword text A=A+C A * by adding length in nibs AD1EX CSRB * nibs to bytes C=C-1 A * we will use C as counter to write keyword to stack WDLOOP D0=D0- 2 * with this loop DAT0=A B * byte by byte to avoid reversal ASRC ASRC C=C-1 A GONC WDLOOP * loop back while C>=0 D0=D0- 2 P= 0 * now add a LCASC ' ' * space before tacking on the word's token # DAT0=C B A=0 W A=DAT1 B * next byte is this token # GOSUB hexdec * which is converted and written to stack D1=D1+ 2 * past token # byte D=D-1 A * any more keywords? GONC LOOP * loop back if yes NEXT CD0EX * otherwise save D0's value in R0 R0=C D0=(5) (F-R0-0)+5 * F-R0-1 holds link offset C=DAT0 A * read into C(A) ?C=0 A * is it 0? GOYES END * nothing more linked, goto output routine D0=D0- 5 * otherwise back to F-R0-0 C=DAT0 A * and collect address of next LEX table D1=C * and set D1 to this C=R0 * pick up current position of stack D0=C * reset D0 to this GOTO Nxtlnk * loop back for next LEX table info END C=R0 * 'end' of stack D1=C * set D1 to end of stack D0=(5) FUNCD1 * here is stored D1's value at 'start' of string C=DAT0 A * recover R1=C * set R1 to this for ADHEAD D0=(5) FUNCD0 * now recover D0 C=DAT0 A D0=C D1=D1+ 4 * wipe out superfluous CR/LF from end of string P= 0 * needed by ADHEAD ST=0 0 * no return GOSBVL D=AVMS * also needed by ADHEAD GOVLNG ADHEAD * output the string after adding the header NOWORD P= 0 * no keyword routine LCASC 'No ' * 'No Keywords' written to stack D0=D0- 6 DAT0=C 6 LCASC 'Keywords' D0=D0- 16 DAT0=C W GOSUB CRLF GOTO NEXT * jump back, check for another link, etc.