* IMPROVED ID, HITOKEN, LOTOKEN * (with LINKS for added value! and including KEYWORD$) * Previously, I offered a file, LEXLEX, with the keywords, ID, LOTOKEN and * HITOKEN, and separately, KEYWORD. A limitation on the words of LEXLEX was * that it could not return a result for secondary LEX files linked to a primary * LEX file. Applying ID to, say, EDLEX, would not reveal the presence of * the secondary file containing SCROLL and MSG$. At the suggestion of Rob * Sanderson, I added the optional numeric parameter for ID, LOTOKEN and * HITOKEN. When no 2nd parameter is given, or is given as 0, the output * is for the primary LEX table; when it is given as 1, then the 1st linked * LEX table is used, etc. If this parameter is greater than the number of * linked LEX files, an error is reported. * It then occurred to me that it would be useful to know how many files have * been linked to the primary file. Unfortunately, I could not include the * new keyword LINKS in with the rest of the file, since the next token had * already been used. And yet it was desirable that I should, in order to take * advantage of common code. The only solution was to add the necessary code * to improve ID, LOTOKEN and HITOKEN and work in the execution code of LINKS, * and follow this with the LEX table for LINKS. So we have the strange * situation of a file written as a linked file, for the express purpose of * including a keyword that determines the number of links (ironic, no?). * For convenience, the code for KEYWORD$ has been included; it did not need * linking, as its token was contiguous with those of LEXLEX. * Also, a 3 line BASIC program, LISTLEX7, is listed. It will list all the * keywords of a LEX file with links (not as good as LISTLEX$, though). * For me the value of this exercise has been a preparation for applying * the changes to NEWID and NEWTOKS. I expect that to be a much more difficult * job, considering that these are statements. If I get into too much strife, * I may make functions of them, where they would return the old ID or low * token. * * 0010 INPUT "LEX Filename?";F$ @ FOR L=0 TO LINKS(F$) * 0020 I=1000*ID(F$,L) @ FOR T=LOTOKEN(F$,L) TO HITOKEN(F$,L) * 0030 DISP KEYWORD$(I+T);I+T @ NEXT T @ NEXT L LEX 'KEYWORDS' * Improved LEXLEX & KEYWORD with added LINKS CON(2) #EC * ID 236; J.Elhay, 14/8/88, PPPM.(not allocated ID) CON(2) #39 * low token (choose your own ID & tokens) CON(2) #3C * high token REL(5) LINKS * link to next LEX Table (this worked right 1st time!) NIBHEX F * no speed table CON(4) (TxTbSt)+1-(*) * offset to text table start REL(4) MSGTBL * offset to message table REL(5) POLHND * offset to poll-handler (version) CON(3) (TxEn03)-(TxTbSt) * start of main table & offset into txtble REL(5) keywd * relative offset to execution code of KEYWORD$ NIBHEX F * a function CON(3) (TxEn01)-(TxTbSt) * offset into text table for HITOKEN REL(5) HIT * rel. offset to code for HITOKEN NIBHEX F * a function CON(3) (TxEn02)-(TxTbSt) * os into txtble for ID REL(5) ID * rel. offset for ID NIBHEX F * a function CON(3) (TxEn04)-(TxTbSt) * os into txtble for LOTOKEN REL(5) LOT * rel. os for LOTOKEN NIBHEX F * again a function TxTbSt * start of text table TxEn01 * in alphabetic order CON(1) (TxEn02)-(*)-4 * (# characters)*2-1: nibble count nibble NIBASC 'HITOKEN' * Syntax: HITOKEN([,]) CON(2) #3A * token is 58 TxEn02 CON(1) (TxEn03)-(*)-4 NIBASC 'ID' * Syntax as for HITOKEN CON(2) #3B * 59 TxEn03 CON(1) (TxEn04)-(*)-4 NIBASC 'KEYWORD$' * Syntax: KEYWORD$(iiittt), iii is ID, ttt is token CON(2) #39 * 57 (leading 0's can be omitted only for iii) TxEn04 * eg: ID=40, token=27 iiittt=40027 CON(1) (TxTbEn)-(*)-4 NIBASC 'LOTOKEN' * Syntax as for HITOKEN CON(2) #3C * 60 TxTbEn * end of text table NIBHEX 1FF * marker for this POLHND ?B=0 B * VER poll? GOYES VER$P * yes RTNSXM * no, allow polling to continue VER$P A=R2 * AVMS => A(A) C=R3 * mathstack address => C(A) D1=C * to set D1 D1=D1- (VER$en)-(VER$st)-2 * make room on stack to add our bit CD1EX * swap D1 into C ?A>C A * memory end crashing into memory start? GOYES VER$Pe * don't handle, leave with carry set D1=C * restore D1 R3=C * next VER poll-handler will need new D1 in R3 VER$st LCASC ' KEYWD:c' * version c, what will appear VER$en DAT1=C (VER$en)-(VER$st)-2 * write to stack VER$Pe * carry cleared RTNSXM * go on to next file as if not handled, XM=1 MFERR EQU #09393 * sets error message ID to 00 then falls into BSERR INVFSP EQU #066FC * invalid file specifier error exit FILXQ$ EQU #09B95 * filename execute (includes pop1s etc.) FINDF+ EQU #09F63 * finds file, sets D1 to start of file HDFLT EQU #1B31B * hex to floating point number conversion FNRTN1 EQU #0F216 * function return F-R0-0 EQU #2F89B * functtion scratch ARGERR EQU #0BF19 * invalid argument error exit BSERR EQU #0939A * BASIC system error, error # in C(3,0) RNDAHX EQU #136CB * pop, test round & convert # to hex R3=D10 EQU #03526 * save D0,D1 in R3 IDIVA EQU #0EC6E * address field integer divide I/OFND EQU #118BA * buffer find routine A-MULT EQU #1B349 * multiply 2 five-nib hex numbers D1C=R3 EQU #03047 * recover pointers from R3 D=AVMS EQU #1A460 * needed by adhead ADHEAD EQU #181B7 * add header to string on stack BF2DSP EQU #01C0E * send a 'buffer' to the display EXPR EQU #0F23C * expression evaluate, a function return REV$ EQU #1B38E * reverse a string on the stack bLEX EQU #BFC * LEX buffer ID number Nobuff P= 0 * error exit if bLEX is missing LC(4) #EC1A * 'EC' will have to be changed to match your choice ID GOVLNG BSERR * exit in error ERR GOVLNG ARGERR NIBHEX 811 * 1 numeric parameter only keywd GOSBVL RNDAHX * pop it as a hex integer GONC ERR * no negatives R0=A * save in R0 D1=D1+ 16 * step over the number on the stack GOSBVL R3=D10 * save the pointers A=R0 * recover our input C=0 W * clean up C C=A A * copy argument to C A=0 W * clean up A ACEX A LC(5) #3E8 * 1000d=3E8h GOSBVL IDIVA * divide, quotient in A, remainder in B & C P= 0 * exits with P=15 (annoying!) C=0 W C=C-1 B * C(B)=FF ?C255? GOYES ERR * invalid argument ?C255? GOYES ERR C=B B * token to C R0=A * save ID in R0 R1=C * and token in R1 LC(5) bLEX * now let's get into the LEX buffer GOSBVL I/OFND * find it GONC Nobuff * not found, ouch! C=R0 * recover ID B=C B * put it into B for comparison test A=R1 * put token into A NEXTID C=DAT1 6 * read 6 nibs from the buffer(ID,LOT,HIT) ?C=0 B * is the ID=00? GOYES AVAIL * entire buffer has been checked (all 00 used) ?B#C B * not matching? GOYES SKIP * must at next entry in the buffer CSR W * matched ID! CSR W * shift low token byte into C(B) ?A high token SKIP D1=D1+ 11 * step on to next bLEX entry GONC NEXTID *BET* carry cleared by previous instruction AVAIL GOSUB POP * collect a return address NIBASC 'ID,Token' * for this buffer (different usage!) NIBASC ' Availab' * which must end in FF NIBASC 'le.' * CR/LF omitted so that the message is not pushed NIBHEX FF * off the display by the null string output POP C=RSTK * pick up return address D1=C * point D1 to buffer GOSBVL BF2DSP * send it to the display GOSBVL D1C=R3 * restore the pointers D0=C CD1EX R1=C * address of start of string in R1 CD1EX * address of end of string in D1 GOTO NULL * GOTO common exit routine FOUND D1=D1+ 6 * we are at the right entry in bLEX C=DAT1 A * collect main table address D1=C * point there R0=C * save this address C=R1 * ---- A=R2 * I C=C-A B * I A=0 W * I A=C B * I LC(5) 9 * I-- calculate position in main table GOSBVL A-MULT * I for our keyword C=R0 * I C=C+A A * I D1=C * ---- D1 set A=0 W A=DAT1 3 * read the offset into the text table R1=A * and save it C=0 A * ---- P= 13 * I CPEX 0 * I A=R0 * I-- get text table offset A=A-C A * I D1=A * ---- D1 set at offset to text table C=DAT1 4 * read offset A=A+C A * go there C=R1 * this the offset INTO the table A=A+C A * almost there D1=A * D1 points to our keyword! D1=D1- 1 * back up, how long is it? C=0 W C=DAT1 1 * # of characters=2*(this nib+1) R2=C CPEX 0 * copy nibble count into P D1=A * re-point D1 to start of text A=0 W * we want A clean A=DAT1 WP * our key word is in A R0=A * and R0 GOSBVL D1C=R3 * restore the pointers D0=C CD1EX * start of string in R1 R1=C * for adhead A=R2 * the nib count again C=C-A A * step D1 low by the length of our word C=C-1 A * but nib count was 1 nib short D1=C * D1 is right now A=R0 * recover the text C=R2 * haven't finished with nib count P=C 0 * put into P DAT1=A WP * write text to the stack NULL P= 0 * required by adhead GOSBVL D=AVMS * ditto ST=1 0 * we shall return! GOSBVL ADHEAD * after adding the header GOSBVL REV$ * because the text is reversed GOVLNG EXPR * and finally send out our result! MSGTBL CON(2) 26 * low message number CON(2) 26 * high message number CON(2) (END)-(*) * offset to next(?) message CON(2) 26 * this message's number CON(1) 4 * length in bytes-1 (must be 5 bytes for 1st msg) NIBASC 'NoBuf' * the message CON(1) 12 * end of this mesage END NIBHEX FF * end of message table mFERR GOVLNG MFERR iNVFSP GOVLNG INVFSP NONEG GOTO ERR FIND0 A=0 A * A(A) is precleared to receive the optional parameter C=C-1 S * parameter count in C(S) C=C-1 S * decrement twice, carry set if count was 1 GOC LBLA * don't pop non-existent numeric GOSBVL RNDAHX * pop as a hex integer if present GONC NONEG * no negatives D1=D1+ 16 * step past the numeric LBLA CD1EX * save the numeric in F-R1-0 D1=(5) (F-R0-0)+16 DAT1=A A D1=C * restore D1 ST=0 0 * ST=0 indicates ID, LOT or HIT FIND1 CD0EX * save D0 D0=(5) F-R0-0 * set D0 to function scratch DAT0=C A * write PC value GOSBVL FILXQ$ * pop and test filename GONC iNVFSP * carry clear= invalid file specifier ?A=0 W * we don't want null specifier (eg. ":PORT") GOYES iNVFSP * filename is in A(W) CD1EX * D1 => C(A) D1=C * but restore D1 immediately D0=(5) (F-R0-0)+5 * because we want the file start address DAT0=C A * put D1 in scratch GOSBVL FINDF+ * now find the file start GOC mFERR * carry set = not found A=0 A C=0 A D1=D1+ 16 * point to filetype nibs A=DAT1 4 * read filetype LC(4) #E208 * lowest value for LEX filetype ?AC A * is ours greater? GOYES TYPE? * invalid D1=D1+ 16 * add 27 to D1 to point to link to next LEX table D1=D1+ 11 ?ST=1 0 * ST=1 indicates that sub was called by LINKS RTNYES * in which case we return C=DAT1 A * read the offset D0=(5) (F-R0-0)+16 A=DAT0 A * recover the numeric parameter, link count NXTLNK ?A=0 A * is the link count now 0? RTNYES * we are @ correct LEX table, we can return ?C#0 A * is the offset non-zero? GOYES OK * yes, good. GOTO ERR * no, we asked for a link count>available OK AD1EX * now we can add the offset to D1 A=A+C A * which wil place us @ the start of the next LEX table AD1EX * ( the count is saved in D1 while that is done) A=A-1 A * decrement the count D1=D1+ 6 * point D1 @ link in this table to next LEX table C=DAT1 A * read the offset GONC NXTLNK * try again *BET* TYPE? C=0 W * error exit for bad file type LC(2) #3F * ERRN=63 GOVLNG BSERR NIBHEX 8412 * (min,max) param count=(1,2) HIT GOSUB FIND0 * find the file, etc., D1 @ link offset D1=D1- 2 * HIT byte is 2 nibs back GONC FINISH *BET* exit with common code NIBHEX 8412 * (min,max)=(1,2),oblig.str.,opt.num. ID GOSUB FIND0 * as above D1=D1- 6 * ID byte 6 nibs back GONC FINISH *BET* NIBHEX 8412 * (1,2) LOT GOSUB FIND0 * as above D1=D1- 4 * LOT byte is 4 nibs back FINISH A=0 A * common exit for ID,LTOKEN and HITOKEN A=DAT1 B * read the appropriate byte OUT2 GOSBVL HDFLT * float (LINKS joins the exit here) D0=(5) (F-R0-0)+5 * restore pointers C=DAT0 A D1=C * D1 restored D0=D0- 5 C=DAT0 A D0=C * D0 restored C=A W * copy result into C(W) GOVLNG FNRTN1 * return result NIBHEX 411 * one string obligatory LINK ST=1 0 * flag for LINKS to return early from FIND1 GOSUB FIND1 * D1 pointing at link offset primary LEX table C=DAT1 A * read offset A=0 A * A(A) will contain the count of links NEXT ?C=0 A * is the offset 0? GOYES OUT2 * exit AD1EX * add the offset A=A+C A AD1EX * restore count, with D1 @ next LEX table A=A+1 A * increment the count D1=D1+ 6 * point @ link offset C=DAT1 A * read the offset GONC NEXT * back up for more *BET* LINKS CON(2) #EE * linked LEX table, ID=238(choose another if you wish) CON(2) #EE * low token=238(choose another if you wish) CON(2) #EE * high token=238( MUST be same as low token) CON(5) 0 * no LEX table linked to this table NIBHEX F * no speed table CON(4) (TXTBST)+1-(*) * offset to start of text table CON(4) 0 * no message table CON(5) 0 * no poll-handler CON(3) 0 * start of main table REL(5) LINK * entry for this keyword, relative offset NIBHEX F * a function TXTBST CON(1) (TXTBEN)-4-(*) * text table start, nibble count nibble NIBASC 'LINKS' * syntax: LINKS() CON(2) #EE * token=238(must match with token range) TXTBEN NIBHEX 1FF * end of text table