LEX 'KEYWORD'* A LEX file to return a keyword, given ID & token # ID #EC * J.Elhay, 25/12/87. MSG MSGTBL * message exists POLL 0 * no poll-handler ENTRY keywd * argument is in same form as for MSG$ CHAR #F * a function KEY 'KEYWORD$' * Syntax: KEYWORD$(iiittt); returns keyword if it TOKEN 57 * exists, else null string and displays: ENDTXT * "ID,Token Available.". iii is ID, ttt is token # ARGERR EQU #0BF19 * invalid argument error exit BSERR EQU #0939A * BASIC System error driver RNDAHX EQU #136CB * pop, test, round & convert to HEX integer R3=D10 EQU #03526 * save pointers in R3 IDIVA EQU #0EC6E * integer divide, preserves arithmetic mode I/OFND EQU #118BA * find buffer nominated in C(2,0) A-MULT EQU #1B349 * multiply two 20 bit integers D1C=R3 EQU #03047 * restore pointers from R3 D=AVMS EQU #1A460 * needed by ADHEAD ADHEAD EQU #181B7 * add header to string on stack BF2DSP EQU #01C0E * send string in a buffer to display EXPR EQU #0F23C * general function exit for item on stack REV$ EQU #1B38E * reverse string on stack bLEX EQU #BFC * LEX buffer ID Nobuff P= 0 * error exit if no LEX buffer LC(4) #EC1A * message # is 236026, found at end of this file GOVLNG BSERR * ERR:NoBuf & CHIRP ERR GOVLNG ARGERR * ID or token # not between 0 & 255 NIBHEX 811 * one obligatoiry numeric parameter keywd GOSBVL RNDAHX * pop it as a HEX integer GONC ERR * no negatives R0=A * save it in R0 D1=D1+ 16 * clean up stack for string O/P GOSBVL R3=D10 * save pointers A=R0 * recover argument C=0 W * clean up argument C=A A * for IDIVA A=0 W * otherwise may get funny answers ACEX A * argument back in A(A), with A(15,5) all 0's LC(5) #3E8 * this is 1000 dec GOSBVL IDIVA * DIVIDE ! P= 0 * P=15 on return from IDIVA C=0 W * clear C(W) to prepare for tests C=C-1 B * C(B)=FF ?C 255? GOYES ERR * then ERR ?C 255? GOYES ERR * also ERR C=B B * all is fine, copy remainder into C(B) R0=A * save ID in R0 R1=C * token # in R1 LC(5) bLEX * now load LEX buffer ID GOSBVL I/OFND * and find this buffer GONC Nobuff * carry clear if not found. Send out error. C=R0 * recover LEX ID B=C B * copy into B(B) for search A=R1 * recover token # for search NEXTID C=DAT1 6 * start of search: C(5,0) holds ID,low tok,high tok ?C=0 B * is the ID 00? GOYES AVAIL * end search. ID,Token available. ?B#C B * our ID not match this entry in the LEX buffer? GOYES SKIP * skip on to next entry CSR W * two right shifts to bring low token into C(B) CSR W * for comparison with our token ?AC, ie our token out of range GONC FOUND * carry clear means in range; end of search SKIP D1=D1+ 11 * 11 nibbles per entry in LEX buffer for each 'file' GONC NEXTID *BET* resume search, carry cleared by previous line AVAIL GOSUB POP * get address of next nibble NIBASC 'ID,Token' * this is to be displayed NIBASC ' Availab' NIBASC 'le.' NIBHEX D0A0FF * followed by CR/LF & FF byte to terminate buffer POP C=RSTK * pop return address off return stack D1=C * set D1 to this- ie D1 points to the NIBASC, etc. GOSBVL BF2DSP * send to the display GOSBVL D1C=R3 * restore pointers D0=C CD1EX * swap D1 into C(A) R1=C * to put 'start' of null string into R1(for ADHEAD) CD1EX * swap back GOTO NULL * O/P null string FOUND D1=D1+ 6 * still in buffer, move to Main Table Address C=DAT1 A * read the address D1=C * set D1 there R0=C * and save the address in R0 C=R1 * recover our token A=R2 * recover low token C=C-A B * # of tokens -1 A=0 W * clear A for multiply A=C B * 9*(# tokens-1)=offset into MainTable for our keyword LC(5) 9 * load 9 GOSBVL A-MULT * multiply to get offset C=R0 * recover MainTable address C=C+A A * address of our keyword's MainTable entry D1=C * set D1 to this A=0 W * clear A again A=DAT1 3 * read offset from start of TextTable R1=A * save this offset C=0 A * prepare C to find TextTable offset P= 13 * which is found 13 nibbles back CPEX 0 * now P=0, C(0)=D A=R0 * MainTable address again A=A-C A * A(A) set at TextTable offset address D1=A * set D1 to this to read the offset C=DAT1 4 * read the four nibbles A=A+C A * add the offset to the current address=TxTbStart C=R1 * recover offset from TextTable Start A=A+C A * add to address of text for our keyword D1=A * set D1 to this D1=D1- 1 * back 1 nibble: this is nibblecount nibble C=0 W * nibblecount=2*(# of bytes)-1 C=DAT1 1 * read nibblecount R2=C * save in R2 CPEX 0 * swap nibblecount into P D1=A * reset D1 to address of text A=0 W * prepare A to take text A=DAT1 WP * write text to A(WP) R0=A * save text in R0 GOSBVL D1C=R3 * restore pointers D0=C CD1EX * swap D1 & C(A) R1=C * copy D1 into R1; start of string: reqd.by ADHEAD A=R2 * nibblecount in A(0) C=C-A A * deduct from top of mathstack C=C-1 A * one more to get whole # of bytes D1=C * D1 at end of string's intended place A=R0 * recover text C=R2 * recover nibble count P=C 0 * copy count into P DAT1=A WP * write string to stack NULL P= 0 * re-entry for null-string GOSBVL D=AVMS * needed by ADHEAD ST=1 0 * force return by setting ST0 GOSBVL ADHEAD * add header GOSBVL REV$ * string has to be reversed GOVLNG EXPR * output the string MSGTBL CON(2) 26 * low message # CON(2) 26 * high message # CON(2) (END)-(*) CON(2) 26 * this message #,236026 CON(1) 4 * len-1=4, 1st message must have len=5 NIBASC 'NoBuf' * the message CON(1) 12 * end of this message END NIBHEX FF * end of message table.