LEX 'LISTLEX' * A LEX file that performs as the BASIC program ID #EC * LISTLEX & continues through linked LEX files. MSG 0 * no message table POLL 0 * no pollhandler ENTRY LIST * the parameter has to be a valid LEX filename CHAR #F * ":PORT[(n)]" not accepted KEY 'LISTLEX$' * Syntax: LISTLEX$() TOKEN 56 * suggestion: [P]WIDTH INF to avoid breaking the O/P ENDTXT * may produce quite a long string O/P. ADHEAD EQU #181B7 * add header to string on stack AVMEMS EQU #2F594 * available memory start address stored here BSERR EQU #0939A * BASIC system error driver CSLC6 EQU #1B432 * 6 circular left shifts of CPU register C D=AVMS EQU #1A460 * set D to AVMEMS (here needed by ADHEAD) F-R0-0 EQU #2F89B * scratch RAM for functions FILXQ$ EQU #09B95 * special filename popping routine FINDF+ EQU #09F63 * set D1 to start of file named in A(W) FUNCD0 EQU #2F8BB * scratch for storing D0 FUNCD1 EQU #2F8C0 * ditto for D1 HEXDEC EQU #0ECAF * hex integer to dec integer conversion INVFSP EQU #066FC * invalid file specifier error exit MEMERR EQU #0944D * insufficient memory error exit MFERR EQU #09393 * mainframe error driver MPY EQU #0ECBB * hex*hex or hex*dec multiply mFERR GOVLNG MFERR iNVFSP GOVLNG INVFSP NIBHEX 411 * 1 obligatory string parameter LIST CD0EX * swap D0 into C D0=(5) FUNCD0 * so that we can save it DAT0=C A * by writing it to scratch GOSBVL FILXQ$ * pop the filename GONC iNVFSP * invalid filename or device specifier ?A=0 W * error if filename given as ":PORT[(n)]" GOYES iNVFSP * naughty! CD1EX * now we have to save D1 D1=C D0=(5) FUNCD1 * in scratch - needed for mathstack DAT0=C A GOSBVL FINDF+ * find the file GOC mFERR * not found, FIND+ puts errn into C(3,0) A=0 A * clean up A and C=0 A * C for filetype test D1=D1+ 16 * point to filetype nibs A=DAT1 4 * read them LCHEX E208 * minimum valid value for LEX ?A=A A * is ours less? GOYES OK * yes, it's OK fTYPER C=0 A * no - wrong filetype LCHEX 3F * ERRN=63 GOVLNG BSERR * ERR: Invalid File Type (chirp!) OK D0=(5) FUNCD1 * D0 will be used to write to the stack C=DAT0 A * while D1 will read info from our file D0=C * D0 @ stack D1=D1- 16 * point to start of file C=DAT1 W * read 1st 8 bytes P= 7 * loop counter LOOPN D0=D0- 2 * make room for a byte on the stack DAT0=C B * write a byte (character) to the stack CSRC * shift to next CSRC * byte P=P-1 * decrement loop counter GONC LOOPN * continue until done; name written to stack P= 0 * don't want P=15 GOSUB CRLF * add carriage return & line feed D1=D1+ 5 * ID byte is 37 nibs further on D1=D1+ 16 D1=D1+ 16 Nxtlnk B=0 A * check for enough room to write header GOSUB MEMCK * for each link LCASC '* LEX ' * LEX ID o/p line GOSUB STK12 * write (with memcheck) 6 characters to stack LCASC 'ID ' * continue line D0=D0- 6 DAT0=C 6 * write 'ID ' GOSUB HEXdec * read next byte,conv to dec int & write with CR/LF LCASC 'LO' * repeat for low token GOSUB TOKEN * write previous 2 bytes + 'token' R2=A * save low token in R2 GOSUB hexdec * as for HEXdec, w/o read LCASC 'HI' * repeat for high token GOSUB TOKEN R3=A * save high token in R3 GOSUB hexdec D1=D1+ 2 * step past high token byte A=DAT1 A * offset to next linked file (0 if no file linked) CD1EX D1=C C=C+A A * add offset to current position R0=C * temp store in R0 CD0EX R1=C * temp store present position of stack pointer D0=(5) F-R0-0 * to save in scratch C=R0 * address of next linked file DAT0=C A * write D0=D0+ 5 * 20 bits further DAT0=A A * write actual offset C=R1 D0=C * restore stack pointer D1=D1+ 5 * point past offset C=0 A * clean up C(A) C=DAT1 1 * speed table nib=F for no speed table,0 if present ?C#0 A * not 0? GOYES Nospd * yes no speed table LCHEX 4F * no, there is one, step 79 nibs AD1EX * actually 78 nibs for table with 1 zero nib A=A+C A * at each end AD1EX * but only 1 nib if no table LCASC 'Speed ' * 2 12 nib bits to send to stack GOSUB STK12 * the 1st LCASC ' Table' * and GOSUB TAB12 * the 2nd Nospd D1=D1+ 1 * that single nib A=0 A A=DAT1 4 * relative offset to text table CD1EX D1=C A=A+C A * absolute address of 1st keyword's text A=A-1 A * 1 nib back to its length nib R0=A * SAVE! D1=D1+ 4 * past the offset A=0 A A=DAT1 4 * message table offset ?A=0 A * no msg table? GOYES NoMSG * yes, say nothing LCASC 'Messag' * no there is one, say so GOSUB STK12 * in 12 bytes LCASC 'e Tble' * note that GOSUB TAB12 * this adds CR/LF to STK12 NoMSG D1=D1+ 4 * past offset A=0 A A=DAT1 A * read pollhandler offset ?A=0 A * is there none? GOYES NoPOLL * yes, say noting LCASC 'Poll H' * no, there is one, say so GOSUB STK12 * in same way as above LCASC 'andler' GOSUB TAB12 NoPOLL C=R0 * point to alleged text table D1=C C=R3 * recall high token ?C#0 A * not zero? GOYES WORDS * yes, there are keywords GOTO NOWORD * no keywords WORDS A=R2 * low token C=C-A A * high-low D=C A * save in D A=0 W * clean up A A=C A * token range C=0 W * should do A=A+1 A, but there is some slack earlier LCHEX 1C * 28 nibs per keyword GOSBVL MPY * room for the keyword list GOSUB MEMCK * now checked LCASC 'Keywor' GOSUB STK12 LCASC 'd List' GOSUB TAB12 LOOP C=0 W * loop for output of the keywords C=DAT1 1 * nibblecount (=2*bytes-1) P=C 0 * copy to P A=0 W * prepare A to take keyword text D1=D1+ 1 * step past nibblecount nibble C=C+1 A * C(A)=length in nibs A=DAT1 WP * copy text to A AD1EX A=A+C A * move D1 past text AD1EX CSRB * length in bytes B=C A * save in B C=C-1 A * counter for word length WDLOOP D0=D0- 2 * loop to write keyword to stack DAT0=A B * byte-by-byte ASRC * rotating A a byte ASRC C=C-1 A * decrement word-loop counter GONC WDLOOP * continue until word is done P= 0 * prepare to pad out with spaces LCHEX 9 * to a length of 9 B=B-C A * the number of spaces actually needed(negative) LCASC ' ' * load a space SPLOOP D0=D0- 2 * loop to write spaces DAT0=C B B=B+1 P * increment space counter GONC SPLOOP * to make up 9 GOSUB HEXdec * next byte in file is token, write as 3 dec bytes D1=D1+ 2 * past token D=D-1 A * decrement keyword loop counter GONC LOOP * continue if more keywords are available NEXT CD0EX * stash D0 in scratch register R0=C D0=(5) (F-R0-0)+5 C=DAT0 A * recall rel offset to next file ?C=0 A * was it 0? GOYES FIN * yes, no further links D0=D0- 5 * no, collect absolute address C=DAT0 A * into c D1=C * point D1 there C=R0 * recover stack pointer D0=C * set D0 there GOTO Nxtlnk * start again for another LEX table FIN C=R0 * recover end of string o/p D1=C * set D1 D0=(5) FUNCD1 * recover bottom of mathstack C=DAT0 A R1=C * ADHEAD needs R1 set there D0=(5) FUNCD0 * now recover D0 C=DAT0 A D0=C D1=D1+ 4 * afterthought: remove terminal CR/LF P= 0 * for ADHEAD ST=0 0 * no return GOSBVL D=AVMS GOVLNG ADHEAD * add header and exit via EXPR NOWORD LCASC 'No Ke' * routine used when there are no keywords GOSUB STK12 LCASC 'ywords' GOSUB TAB12 GOTO NEXT * re-enter TAB12 GOSUB STK12 CRLF LCHEX 0A0D * 0A=10 & chr$(10)=LF, 0D=13 & chr$(13)=CR D0=D0- 4 * make room on stack for two bytes DAT0=C 4 * write 'em RTN STK12 D0=D0- 12 * routine to write 6 characters to stack DAT0=C 12 RTN TOKEN D0=D0- 4 * routine to read token byte DAT0=C 4 * and write LO Token LCASC ' Token ' * or HI Token D0=D0- 14 DAT0=C 14 D1=D1+ 2 A=0 A A=DAT1 B * read the byte RTN HEXdec A=0 W A=DAT1 B * read a byte to convert to decimal hexdec GOSBVL HEXDEC * now a hex innteger SETHEX * restore hexmode LCHEX 303030 * the three digits will replace the zeros GOSUB NUMBYT * each 1 nib integer is copied to cover its 0 GOSUB NUMBYT GOSUB NUMBYT GOSBVL CSLC6 * rotate back 6 nibs D0=D0- 6 DAT0=C 6 * copy the 3 bytes to the stack GOTO CRLF * add CR/LF NUMBYT C=B P * C(5,0)=30303x, 1st call CSRC * C(5,0)=03030, C(S)=x CSRC * C(5,0)=003030, C(15,14)=3x BSRC * x is rotated into B(S) RTN * similarly for 2nd & 3rd calls MEMCK C=0 A LCHEX D8 * 216 nibs for name,ID, token info etc at maximum B=B+C A * B contains memory needs due to number of keywords CD0EX D0=(5) AVMEMS * don't want to overwrite memory start A=DAT0 A A=A+B A D0=C ?A