LEX 'NIDTLEX' * A LEX file to change ID or tokens for LEX files ID #EC * Jack Elhay, 10th July 1988, PPPM. MSG 0 * no MSGTBL POLL 0 * no POLHND ENTRY NID * entry for NEWID CHAR #D * a statement ENTRY NTOK * entry for NEWTOKS CHAR #D * also a statement ENTRY CONFIG * entry for CONF CHAR #D * another statement KEY 'CONF' * Syntax: CONF to configure system (as at turn on) TOKEN 146 * No parameters KEY 'NEWID' * Syntax: NEWID , TOKEN 144 * valid filename & new ID required KEY 'NEWTOKS' * Syntax: NEWTOKS , TOKEN 145 * checks for valid new high token (not>255) ENDTXT ARGERR EQU #0BF19 * invalid argument error exit BF2DSP EQU #01C0E * send a buffer pointed at by D1 to display BSERR EQU #0939A * BASIC system error driver COMCKO EQU #032AA * output next token & check that it is tCOMMA MFERR EQU #09393 * mainframe error driver DISPDC EQU #05450 * display decompile EXPEXC EQU #0F186 * expression execute FILDC* EQU #05759 * filename decompile FINDF EQU #09F77 * find a file for which name is on the mathstack FIXP EQU #02A6E * fix parse, parses a numerical expression FSPECe EQU #02F02 * file specifier error exit FSPECp EQU #03CC5 * file specifier parse FSPECx EQU #09F2D * file specifier execute OUTELA EQU #05303 * decompile for parameterless statements STMTD1 EQU #2F896 * temporary storage RAM for D1 CONF EQU #10212 * configure TITAN (saves turning off then on) NXTSTM EQU #08A48 * re-enter main loop RNDAHX EQU #136CB * pop round test & convert to hex integer SYNTXe EQU #02E2B * syntax parse error exit IDTd GOSBVL FILDC* * decompile for both statements GOVLNG DISPDC IDTp GOSBVL FSPECp * parse for both statements GONC comcko * carry set if file spec. parse error GOVLNG FSPECe * carry set comcko GOSBVL COMCKO * carry clear GOC fixp * carry clear if error on comma check GOVLNG SYNTXe * exit with syntax error fixp GOVLNG FIXP * otherwise parse for a numeric parameter ARGS GOSBVL FSPECx * a subroutine which is common code, both statements GOC ERR * 1st execute the filename, ok=carry clear GOSBVL FINDF * filename now on stack, set D1 to start of file GONC OK * carry clear=found ERR GOVLNG MFERR * find puts ERRN into C(3,0) OK D1=D1+ 16 * move D1 past filename in file (not stack) A=0 A * clean up C(A) & A(A) C=0 A * for file type test A=DAT1 4 * read file type nibs LCHEX E208 * valid range: E208 to E20B ?AC A * is our value greater? GOYES Argerr * not valid R0=A * otherwise save in R0 D1=(5) STMTD1 * prepare to recover our position in the file RTN * return to the caller REL(5) IDTd REL(5) IDTp NID GOSUB ARGS * code for new ID starts here LCHEX 15 * offset from our current position to ID byte A=DAT1 A * read current position [ADDR$+16] A=A+C A * add the offset D1=A * D1 now @ ID byte C=R0 * recall the input ID wanted DAT1=C B * poke it in GOTO CONFIG * GOTO finish ArgerR GOTO Argerr * jump extender REL(5) IDTd REL(5) IDTp NTOK GOSUB ARGS * we must not only change low token, but also high * token & individual tokens for all keywords in the file. LCHEX 17 * offset to low token byte A=DAT1 A * read [ADDR$+16] A=A+C A * add the offset D1=A * D1 @ LOT (low token byte) A=0 A C=0 A A=DAT1 B * read LOT R1=A * and save in R1 D1=D1+ 2 * D1 @ HIT (high token byte) C=DAT1 B * read HIT ?C#0 B * if not zero then there are keywords GOYES KWDS * handle GOTO NOKWDS * no keywords exit KWDS R2=C * save old HIT in R2 C=C-A A * difference HIT-LOT R3=C * saved in R3 A=R0 * recover new LOT A=A+C A * add difference to get new HIT LCHEX FF * will this be valid? ?A>C A * is new HIT>255? GOYES ArgerR * no good to us DAT1=A B * ok, poke it in D1=D1- 2 * D1 @ LOT A=R0 * recall new LOT value DAT1=A B * poke that in D1=D1+ 9 * step past LOT,HIT & link offset A=0 A A=DAT1 1 * D1 @ speed table nib ?A#0 A * not zero? GOYES NOSPD * yes, no speed table, text table offset is 1 nib on C=0 A * no, there is a speed table LCHEX 4F * text table offset is 80 nibs on AD1EX * so add 79 A=A+C A * here AD1EX NOSPD D1=D1+ 1 * add 1 here C=DAT1 4 * read text table offset AD1EX * swap D1 into A A=A+C A * add the offset AD1EX * swap back, D1 @ text of 1st keyword D1=D1- 1 * back up to nibblecount nibble LCHEX FF1 * load text table terminator (reversed) into C(X) B=C X * copy into B(X); we will use as exit criterion LOOP A=DAT1 3 * read 3 nibs ?A=B X * end of text table? GOYES CONFIG * yes, time to finish A=0 A * no, there is more to do A=DAT1 1 * read the nibble count (1 less than # nibs in text) CD1EX * swap D1 into C C=C+A A * add nibble count CD1EX * swap back D1=D1+ 2 * 1 more for nibcount & another for nibcount nib A=DAT1 B * D1 @ token byte for this individual keyword C=R1 * R1 is old LOT A=A-C B * difference for this keyword C=R0 * new LOT A=A+C B * new value for this token DAT1=A B * poke it in D1=D1+ 2 * step past the new token byte GONC LOOP *BET* go back up for more REL(5) CONFd REL(5) CONFp CONFIG CD0EX * save D0 on the return stack (entry for CONF here) RSTK=C * we want to come out clean ST=0 0 * ensure we do not configure for a cold start GOSBVL CONF * configure the system (saves turning OFF/ON) C=RSTK * restore D0 from return stack D0=C * now we are ok nxtstm GOVLNG NXTSTM * and we can exit to the main loop NOKWDS GOSUB C=RSTK * no keywords exit NIBASC 'No ' * put a little message NIBASC 'Keywords' * in the display NIBHEX D0A0FF * CR/LF and buffer terminator bytes C=RSTK C=RSTK * pick address of the message D1=C * D1 @ the address GOSBVL BF2DSP * send to the display GOC nxtstm *BET* exit from BF2DSP always has carry set CONFd GOVLNG OUTELA CONFp RTNCC END * CONF was added as an after-thought. It just goes to show a few things. * (1) Another keyword at a cost of some 20 bytes! * (2) Entry points for the keywords must be in token order, but keywords * are in alphabetic order (with the usual caution on common early characters). * (3) And an after-thought to the after-thought: * Next time you are assembling with HP's FORTH Assembler, PURGE the old * FORTHRAM, enter FORTH and key in the following - 3600 SHRINK (ENDLINE) * : ASS ASSEMBLE " BEEP @ CLD @ CONF" BASICX BYE ; * This assumes you have the above file and CLDISP in your machine. If you * don't have CLDISP, then replace that statement with PUT '#43'. * When you need to assemble a file from source code, just enter FORTH * key in the source code's name as usual and key in ASS (ENDLINE) * E.g., " NIDT71" ASS. The assembly will proceed as expected, and at the * finish, TITAN will beep, the display will clear, the system will be * reconfigured and you will find yourself back in BASIC and ready to go * without the need to turn OFF then ON. Note that BEEP in the string * argument of BASICX is preceeded by a space, just as ASSEMBLE's arguments * have a leading space. Note the space after : and before ; in the definition. * Lots of fun! Regards and Happy Programming, * Jack Elhay.