;;; This is the Scelbi Basic Program from 1974 known as ;;; SCELBAL. This version is modified to assemble with the ;;; as8 assembler for the intel 8008 by Thomas E. Jones ;;; This current form is made up non-relocatable so that ;;; locations of all code and data is identical to the ;;; original SCELBAL documents and patches. It should be ;;; reasonable after debugging code to convert this to a ;;; relocatable and ROMable code with variables in RAM. ;;; This code originates from a version made by Steve ;;; Loboco. ;;; ;;; This version has all 3 patches for Scelbal (the two ;;; pasted in the original manual, and a third which was ;;; written in SCELBAL UPDATE publication, as well as ;;; a couple changes to constants which didn't actually ;;; require a patch, just changes to bytes of data or ;;; arguments to an instruction.) ;;; ENDPGRAM: EQU 077 [077] BGNPGRAM: EQU 044 [044] ;;; Here are labels originally attempting to make the code ;;; relocatable. These 4 pages contain variable data ;;; which needs to be relocated from ROM to RAM. ;;; I can't vouch for ALL references to these pages in ;;; the code being switched to these labels, but they ;;; seem to be. OLDPG1: EQU 001#000 OLDPG26: EQU 026#000 OLDPG27: EQU 027#000 OLDPG57: EQU 057#000 ;;; Page zero will contain the I/O Routines. These are actually ;;; just as suggested by Scelbal Manual for Serial I/O. ORG 000#100 ; save a bit of space before this save: load: JMP EXEC ; By default, save and load isn't implemented. INPORT: EQU 2 OUTPORT: EQU 2 ;;; HERE IS THE USER DEFINED CHARACTER INPUT TO READ FROM SERIAL PORT CINP: INP INPORT NDA JTS CINP XRA LBI 104 MORE1: DCB JFZ MORE1 OUT OUTPORT CAL TIMER CAL NEXBIT CAL NEXBIT CAL NEXBIT CAL NEXBIT CAL NEXBIT CAL NEXBIT CAL NEXBIT CAL NEXBIT STOP: LAI 001 OUT OUTPORT LAB RLC LBI 314 MORE3: DCB JFZ MORE3 RET NEXBIT: INP INPORT NDI 200 RLC OUT OUTPORT RRC ADB RRC TIMER: LBI 213 MORE2: DCB JFZ MORE2 LBA RET ;;; no user defined functions yet, stop here if we see one. UDEFX: HLT ;;; HERE IS THE USER DEFINED PRINT ROUTINE FOR A SERIAL PORT CPRINT: NDA RAL OUT OUTPORT RAR CAL TIMER CAL BITOUT CAL BITOUT CAL BITOUT CAL BITOUT CAL BITOUT CAL BITOUT CAL BITOUT CAL BITOUT LBA LAI 001 OUT OUTPORT LAB CAL TIMER LBI 103 JMP MORE3 BITOUT: OUT OUTPORT RRC CAL TIMER RET ;;; THE ABOVE MUST CONCLUDE BEFORE BY PAGE 1 STARTS ;;; Page one has many constants and variables. ORG 001#000 DATA *4 DATA 000,000,100,001 ; STORES FLOATING POINT CONSTANT +1.0 DATA *3 DATA 000 ; EXPONENT COUNTER DATA 000,000,000,000 ; STORES FLOATING POINT NUMBER TEMPORARILLY DATA *4 DATA 000,000,300,001 ; STORES FLOATING POINT CONSTANT -1.0 DATA 000,000,000,000 ; SCRATCH PAD AREA (16 BYTES) DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000,000,000 DATA 001,120,162,002 ; STORES RANDOM NUMBER GENERATOR CONSTANT VALUE DATA *4 DATA 003,150,157,014 ; STORES RANDOM NUMBER GENERATOR CONSTANT VALUE DATA 000,000,000,000 ; SCRATCH PAD AREA (12 BYTES) (01 064-077) DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000 ; SIGN INDICATOR DATA 000 ; BITS COUNTER DATA 000,000 ; SIGN INDICATOR DATA 000 ; INPUT DIGIT COUNTER DATA 000 ; TEMP STORATE DATA 000 ; OUTPUT DIGIT COUNTER DATA 000 ; FP MODE INDICATOR DATA *7 ; NOT ASSIGNED (SHOULD BE 01 111-117) DATA 000,000,000,000 ; FPACC EXTENSION DATA 000,000,000,000 ; FPACC LSW, NSW, MSW, EXPONENT DATA 000,000,000,000 ; FPOP Extension DATA 000,000,000,000 ; FPOP LSW, NSW, MSW, EXPONENT DATA 000,000,000,000 ; FLOATING POINT WORKING AREA DATA 000,000,000,000 ; (SHOULD BE AT 01 140-01-167) DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000,000,000 DATA *8 ; NOT ASSIGNED (SHOULD BE 01 170-01 177) DATA 000,000,000,000 ; TEMPORARY REGISTER STORAGE AREA (D,E,H&L) DATA *4 ; NOT ASSIGNED (01 204-01 207) DATA 000,000,120,004 ; STORES FLOATING POINT CONSTANT +10.0 DATA 147,146,146,375 ; STORES FLOATING POINT CONSTANT +0.1 DATA 000 ; GETINP COUNTER DATA *6 ; NOT ASSIGNED (01 221-01 226) DATA 000 ; ARITHMETIC STACK POINTER (01 227) DATA 000 ; ARITHMETIC STACK (NOT CLEAR HOW LONG) ORG 001#272 DATA 004 ; CC FOR SAVE DATA "SAVE" DATA 004 ; CC FOR LOAD DATA "LOAD" DATA 000,000,000,000 ; UNCLEAR WHAT THIS IS (01 304-01 317) ZEROS DATA 000,000,000,000 ; (PROBABLY STEP, FOR/NEXT, AND ARRAY PTR TEMP) DATA 000,000,000,000 ;; AT THIS POINT WE SHOULD BE AT LOCATION 01 320 DATA 4 DATA "THEN" DATA 2 DATA "TO" DATA 4 DATA "STEP" DATA 4 DATA "LIST" DATA 3 DATA "RUN" DATA 3 DATA "SCR DATA 013 ; CC FOR "READY" MESSAGE DATA 224,215,212 ; CTRL-T, CARRIAGE RETURN, LINE FEED DATA "READY" DATA 215,212,212 ; CARRIAGE RETURN, LINE FEED, LINE FEED; DATA 011 DATA " AT LINE " ;; THIS SHOULD BE THE END OF PAGE 01 ORG 002#000 ; START PAGE 02, THE CODE SYNTAX: CAL CLESYM ;Clear the SYMBOL BUFFER area LLI 340 ;Set L to start of LINE NUMBER BUFFER LHI \HB\OLDPG26 ;** Set H to page of LINE NUMBER BUFFER LMI 000 ;Initialize line number buff by placing zero as (cc) LLI 201 ;Change pointer to syntax counter/pointer storage loc. LMI 001 ;Set pointer to first character (after cc) in line buffer SYNTX1: LLI 201 ;Set pointer to syntax cntr/pntr storage location CAL GETCHR ;Fetch the character pointed to by contents of syntax JTZ SYNTX2 ;Cntr/pntr from the line input buffer. If character was CPI 260 ;A space, ignore. Else, test to see if character was ASCII JTS SYNTX3 ;Code for a decimal digit. If not a decimal digit, consider CPI 272 ;Line number to have been processed by jumping JFS SYNTX3 ;Over the remainder of this SYNTX1 section. LLI 340 ;If have decimal digit, set pointer to start of LINE CAL CONCT1 ;NUMBER BUFFER and append incoming digit there. SYNTX2: LLI 201 ;Reset L to syntax cntr/pntr storage location. Call sub- CAL LOOP ;Routine to advance pntr and test for end of inr)ut buffer JFZ SYNTX1 ;If not end of input buffer, go back for next digit LLI 203 ;If end of buffer, only had a line number in the line. LMI 000 ;Set pntr to TOKEN storage location. Set TOKEN = 000. RET ;Return to caller. SYNTX3: LLI 201 ;Reset pointer to syntax cntr/pntr and fetch LBM ;Position of next character after the line number LLI 202 ;Change pntr to SCAN pntr storage location LMB ;Store address when SCAN takes up after line number SYNTX4: LLI 202 ;Set pntr to SCAN pntr stomge location CAL GETCHR ;Fetch the character pointed to by contents of the SCAN JTZ SYNTX6 ;Pointer storage location. If character was ASCII code CPI 275 ;For space, ignore. Else, compare character with "=" sign JTZ SYNTX7 ;If is an equal sign, go set TOKEN for IMPLIED LET. CPI 250 ;Else, compare character with left parenthesis " ( " JTZ SYNTX8 ;If left parenthesis, go set TOKEN for implied array LET CAL CONCTS ;Otherwise, concatenate the character onto the string LLI 203 ;Being constructed in the SYMBOL BUFFER. Now set LMI 001 ;Up TOKEN storage location to an initial value of 001. LHI \HB\OLDPG27 ;** Set H to point to start of KEYWORD TABLE. LLI 000 ;Set L to point to start of KEYWORD TABLE. SYNTX5: LDI \HB\OLDPG26 ;** Set D to page of SYMBOL BUFFER LEI 120 ;Set E to start of SYMBOL BUFFER CAL STRCP ;Compare char string presently in SYMBOL BUFFER RTZ ;With entry in KEYWORD TABLE. Exit if match. CAL SWITCH ;TOKEN will be set to keyword found. Else, switch SYNTXL: INL ;Pointers to get table address back and advance pntr to LAM ;KEYWORD TABLE. Now look for start of next entry NDI 300 ;In KEYWORD TABLE by looking for (cc) byte which JFZ SYNTXL ;Will NOT have a one in the two most sig. bits. Advance CAL SWITCH ;Pntr til next entry found. Then switch pointers apin so LLI 203 ;Table pointer is in D&E. Put addr of TOKEN in L. LHI \HB\OLDPG26 ;** And page of TOKEN in H. Fetch the value currently LBM ;In TOKEN and advance it to account for going on to INB ;The next entry in the KEYWORD TABLE. LMB ;Restore the updated TOKEN value back to storage. CAL SWITCH ;Restore the keyword table pointer back to H&L. LAB ;Put TOKEN count in ACC. CPI 015 ;See if have tested all entries in the keyword table. JFZ SYNTX5 ;If not, continue checking the keyword table. SYNTX6: LLI 202 ;Set L to SCAN pointer storage location LHI \HB\OLDPG26 ;** Set H to page of SCAN pointer stomge location CAL LOOP ;Call routine to advance pntr & test for end of In buffer JFZ SYNTX4 ;Go back and add another character to SYMBOL BUFF LLI 203 ;And search table for KEYWORD again. Unless reach LMI 377 ;End of line input buffer. In which case set TOKEN=377 RET ;As an error indicator and exit to calling routine. SYNTX7: LLI 203 ;Set pointer to TOKEN storage register. Set TOKEN LMI 015 ;Equal to 015 when "=" sign found for IMPLIED LET. RET ;Exit to calling routine. SYNTX8: LLI 203 ;Set pointer to TOKEN storage register. Set TOKEN LMI 016 ;Equal to 016 when "(" found for IMPLIED array LET. RET ;Exit to calling routine. ;The following are subroutines used by SYNTAX and ;other routines in SCELBAL. BIGERR: LAI 302 ;Load ASCII code for letters B and G to indicate BIG LCI 307 ;ERROR (for when buffer, stack,etc., overflows). ERROR: CAL ECHO ;Call user provided display routine to print ASCII code LAC ;In accumulator. Transfer ASCII code from C to ACC CAL ECHO ;And repeat to display error codes. JMP FINERR ;Go cpmplete error message (AT LINE) as required. GETCHR: LAM ;Get pointer from memory location pointed to by H&L CPI 120 ;See if within range of line input buffer. JFS BIGERR ;If not then have an overflow condition = error. LLA ;Else can use it as addr of character to fetch from the LHI \HB\OLDPG26 ;** LINE INPUT BUFFER by setting up H too. LAM ;Fetch the character from the line input buffer. CPI 240 ;See if it is ASCII code for space. RET ;Return to caller with flags set according to comparison. CLESYM: LLI 120 ;Set L to start of SYMBOL BUFFER. LHI \HB\OLDPG26 ;** Set H to page of SYMBOL BUFFER. LMI 000 ;Place a zero byte at start of SYMBOL BUFFER. RET ;To effectively clear the buffer. Then exit to caller. ;Subroutine to concatenate (append) a character to the ;SYMBOL BUFFER. Character must be alphanumeric. CONCTA: CPI 301 ;See if character code less than that for letter A. JTS CONCTN ;If so, go see if it is numeric. CPI 333 ;See if character code greater than that for letter Z. JTS CONCTS ;If not, have valid alphabetical character. CONCTN: CPI 260 ;Else, see if character in valid numeric range. JTS CONCTE ;If not, have an error condition. CPI 272 ;Continue to check for valid number. JFS CONCTE ;If not, have an error condition. CONCTS: LLI 120 ;If character alphanumeric, can concatenate. Set pointer LHI \HB\OLDPG26 ;** To starting address of SYMBOL BUFFER. CONCT1: LCM ;Fetch old character count in SYMBOL BUFFER. INC ;Increment the value to account for adding new LMC ;Character to the buffer. Restore updated (cc). LBA ;Save character to be appended in register B. CAL INDEXC ;Add (cc) to address in H & L to get new end of buffer LMB ;Address and append the new character to buffer LAI 000 ;Clear the accumulator RET ;Exit to caller CONCTE: JMP SYNERR ;If character to be appended not alphanumeric, ERROR! ;Subroutine to compare ;character strings pointed to by ;register pairs D & E and H & L. STRCP: LAM ;Fetch (cc) of first string. CAL SWITCH ;Switch pointers and fetch length of second string (cc) LBM ;Into register B. Compare the lengths of the two strings. CPB ;If they are not the same RFZ ;Return to caller with flags set to non-zero condition CAL SWITCH ;Else, exchange the pointers back to first string. STRCPL: CAL ADV ;Advance the pointer to string number 1 and fetch a LAM ;Character from that string into the accumulator. CAL SWITCH ;Now switch the pointers to string number 2. CAL ADV ;Advance the pointer in line number 2. STRCPE: CPM ;Compare char in stxing 1 (ACC) to string 2 (memory) RFZ ;If not equal, return to cauer with flags set to non-zero CAL SWITCH ;Else, exchange pointers to restore pntr to string 1 DCB ;Decrement the string length counter in register B JFZ STRCPL ;If not finiahed, continue testing entire string RET ;If complete match, return with flag in zero condition STRCPC: LAM ;Fetch character pointed to by pointer to string 1 CAL SWITCH ;Exchange pointer to examine string 2 JMP STRCPE ;Continue the string comparison loop ;Subroutine to advance the two byte ;value in CPU registers H and L. ADV: INL ;Advance value in register L. RFZ ;If new value not zero, return to caller. INH ;Else must increment value in H RET ;Before retuming to caller ;Subroutine to advance a buffer pointer ;and test to see if the end of the buffer ;has been reached. LOOP: LBM ;Fetch memory location pointed to by H & L into B. INB ;Increment the value. LMB ;Restore it back to memory. LLI 000 ;Change pointer to start of INPUT LINE BUFFER LAM ;Fetch buffer length (cc) value into the accumulator DCB ;Make value in B original value CPB ;See if buffer length same as that in B RET ;Return with flags yielding results of the comparison ;The following subroutine is used to ;input characters from the system's ;input device (such as a keyboard) ;into the LINE INPUT BUFFER. Routine has limited ;editing capability included. ;(Rubout = delete previous character(s) entered.) ;;; This label, STRIN: should be location 03 014 STRIN: LCI 000 ;Initialize register C to zero. STRIN1: CAL CINPUT ;Call user provided device input subroutine to fetch one CPI 377 ;Character from the input device. Is it ASCII code for JFZ NOTDEL ;Rubout? Skip to next section if not rubout. LAI 334 ;Else, load ASCII code for backslash into ACC. CAL ECHO ;Call user display driver to present backslash as a delete DCC ;Indicator. Now decrement the input character counter. JTS STRIN ;If at beginning of line do NOT decrement H and L. CAL DEC ;Else, decrement H & L line pointer to erase previous JMP STRIN1 ;Entry, then go back for a new input. NOTDEL: CPI 203 ;See if character inputted was'CONTROL C' JTZ CTRLC ;If so, stop inputting and go back to the EXECutive CPI 215 ;If not, see if character was carriage-return JTZ STRINF ;If so, have end of line of input CPI 212 ;If not, see if character was line-feed JTZ STRIN1 ;If so, ignore the input, get another character CAL ADV ;If none of the above, advance contents of H & L INC ;Increment the character counter LMA ;Store the new character in the line input buffer LAC ;Put new character count in the accumulator CPI 120 ;Make sure maximum buffer size not exceeded JFS BIGERR ;If buffer size exceeded, go display BG error message JMP STRIN1 ;Else can go back to look for next input STRINF: LBC ;Transfer character count from C to B CAL SUBHL ;Subtract B from H & L to get starting address of LMC ;The string and place the character count (cc) there CAL CRLF ;Provide a line ending CR & LF combination on the RET ;Display device. Then exit to caller. ;Subroutine to subtract contents of CPU register B from ;the two byte value in CPU registers H & L. SUBHL: LAL ;Load contents of register L into the accumulator SUB ;Subtract the contents of register B LLA ;Restore the new value back to L RFC ;If no carry, then no underflow. Exit to caller. DCH ;Else must also decrement contents of H. RET ;Before retuming to caller. ;Subroutine to display a character string on the system's ;display device. TEXTC: LCM ;Fetch (cc) from the first location in the buffer (H & L LAM ;Pointing there upon entry) into register B and ACC. NDA ;Test the character count value. RTZ ;No display if (cc) is zero. TEXTCL: CAL ADV ;Advance pointer to next location in buffer LAM ;Fetch a character from the buffer into ACC CAL ECHO ;Call the user's display driver subroutine DCC ;Decrement the (cc) JFZ TEXTCL ;If character counter not zero, continue display RET ;Exit to caller when (cc) is zero. ;Subroutine to provide carriage-return and line-feed ;combination to system's display device. Routine also ;initializes a column counter to zero. Column counter ;is used by selected output routines to count the num- ;ber of characters that have been displayed on a line. CRLF: LAI 215 ;Load ASCII code for carriage-return into ACC CAL ECHO ;Call user provided display driver subroutine LAI 212 ;Load ASCII code for line-feed into ACC CAL ECHO ;Call user provided display driver subroutine LLI 043 ;Set L to point to COLUMN COUNTER storage location LHI \HB\OLDPG1 ;** Set H to page of COLUMN COUNTER LMI 001 ;Initialize COLUMN COUNTER to a value of one LHD ;Restore H from D (saved by ECHO subroutine) LLE ;Restore L from E (saved by ECHO subroutine) RET ;Then exit to calling routine ;Subroutine to decrement double-byte value in CPU ;registers H and L. DEC: DCL ;Decrement contents of L INL ;Now increment to exercise CPU flags JFZ DECNO ;If L not presently zero, skip decrementing H DCH ;Else decrement H DECNO: DCL ;Do the actual decrement of L RET ;Return to caller ;Subroutine to index the value in CPU registers H and L ;by the contents of CPU register B. INDEXB: LAL ;Load L into the accumulator ADB ;Add B to that value LLA ;Restore the new value to L RFC ;If no carry, return to caller INH ;Else, increment value in H RET ;Before returning to caller ;The following subroutine is used to ;display the ASCII encoded character in the ACC on the ;system's display device. This routine calls a routine ;labeled CINPUT which must be provided by the user to ;actually drive the system's output device. The subroutine ;below also increments an output column counter each time ;it is used. ECHO: LDH ;Save entry value of H in register D LEL ;And save entry value of L in register E LLI 043 ;Set L to point to COLUMN COUNTER storage location LHI \HB\OLDPG1 ;** Set H to page of COLUMN COUNTER LBM ;Fetch the value in the COLUMN COUNTER INB ;And increment it for each character displayed LMB ;Restore the updated count in memory CAL CPRINT ;tt Call the user's device driver subroutine LHD ;Restore entry value of H from D LLE ;Restore entry value of L from E RET ;Return to calling routine CINPUT: JMP CINP ;Reference to user defined input subroutine ;;; The label EVAL: SHOULD BE AT 03 224 EVAL: LLI 227 ;Load L with address of ARITHMETIC STACK pointer LHI \HB\OLDPG1 ;** Set H to page of ARITHMETIC STACK pointer LMI 224 ;Initialize ARITH STACK pointer value to addr minus 4 INL ;Advance memory pointer to FUN/ARRAY STACK pntr LHI \HB\OLDPG26 ;** Set H to page of FUN/ARRAY STACK pointer LMI 000 ;Initialize FUNIARRAY STACK pointer to start of stack CAL CLESYM ;Initialize the SYMBOL BUFFER to empty condition LLI 210 ;Load L with address of OPERATOR STACK pointer LMI 000 ;Initialize OPERATOR STACK pointer value LLI 276 ;Set L to address of EVAL pointer (start of expression) LBM ;Fetch the EVAL pointer value into register B LLI 200 ;Set up a working pointer register in this location LMB ;And initialize EVAL CURRENT pointer SCAN1: LLI 200 ;Load L with address of EVAL CURRENT pointer CAL GETCHR ;Fetch a character in the expression being evaluated JTZ SCAN10 ;If character is a space, jump out of this section CPI 253 ;See if character is a "+" sign JFZ SCAN2 ;If not, continue checking for an operator LLI 176 ;If yes, set pointer to PARSER TOKEN storage location LMI 001 ;Place TOKEN value for "+" sign in PARSER TOKEN JMP SCANFN ;Go to PARSER subroutine entry point SCAN2: CPI 255 ;See if character is a minus ("-") sign JFZ SCAN4 ;If not, continue checking for an operator LLI 120 ;If yes, check the length of the symbol stored in the LAM ;SYMBOL BUFFER by fetching the (cc) byte NDA ;And testing to see if (cc) is zero JFZ SCAN3 ;If length not zero, then not a unary minus indicator LLI 176 ;Else, check to see if last operator was a right parenthesi LAM ;By fetching the value in the PARSER TOKEN storage CPI 007 ;Location and seeing if it is token value for ")" JTZ SCAN3 ;If last operator was I')" then do not have a unary minus CPI 003 ;Check to see if last operator was C4*~2 JTZ SYNERR ;If yes, then have a syntax error CPI 005 ;Check to see if last operator was exponentiation JTZ SYNERR ;If yes, then have a syntax error LLI 120 ;If none of the above, then minus sign is unary, put LMI 001 ;Character string representing the INL ;Value zero in the SYMBOL BUFFER in string format LMI 260 ;(Character count (cc) followed by ASCII code for zero) SCAN3: LLI 176 ;Set L to address of PARSER TOKEN storage location LMI 002 ;Set PARSER TOKEN value for minus operator SCANFN: CAL PARSER ;Call the PARSER subroutine to process current symbol JMP SCAN10 ;And operator. Then jump to continue processing. SCAN4: CPI 252 ;See if character fetched from expression is JFZ SCAN5 ;If not, continue checking for an operator LLI 176 ;If yes, set pointer to PARSER TOKEN storage location LMI 003 ;Place TOKEN value for "*" (multiplication) operator in JMP SCANFN ;PARSER TOKEN and go to PARSER subroutine entry SCAN5: CPI 257 ;See if character fetched from expression is JFZ SCAN6 ;If not, continue checking for an operator LLI 176 ;If yes, set pointer to PARSER TOKEN storage location LMI 004 ;Place TOKEN value for "/" (division) operator in JMP SCANFN ;PARSER TOKEN and go to PARSER subroutine entry SCAN6: CPI 250 ;See if character fetched from expression is JFZ SCAN7 ;If not, continue checking for an operator LLI 230 ;If yes, load L with address of FUN/ARRAY STACK LBM ;Pointer. Fetch the value in the stack pointer. Increment INB ;It to indicate number of "(" operators encountered. LMB ;Restore the updated stack pointer back to memory CAL FUNARR ;Call subroutine to process possible FUNCTION or LLI 176 ;ARRAY variable subscript. Ihen set pointer to LMI 006 ;PARSER TOKEN storage and set value for operator JMP SCANFN ;Go to PARSER subroutine entry point. SCAN7: CPI 251 ;See if character fetched from expression is JFZ SCAN8 ;If not, continue checking for an operator LLI 176 ;If yes, load L with address of PARSER TOKEN LMI 007 ;Set PARSER TOKEN value to reflect ")" CAL PARSER ;Call the PARSER subroutine to process current symbol CAL PRIGHT ;Call subroutine to handle FUNCTION or ARRAY LLI 230 ;Load L with address of FUN/ARRAY STACK pointer LHI \HB\OLDPG26 ;** Set H to page of FUN/ARRAY STACK pointer LBM ;Fetch the value in the stack pointer. Decrement it DCB ;To account for left parenthesis just processed. LMB ;Restore the updated value back to memory. JMP SCAN10 ;Jump to continue processing expression. SCAN8: CPI 336 ;See if character fetched from expression is " t JFZ SCAN9 ;If not, continue checking for an operator LLI 176 ;If yes, load L with address of PARSER TOKEN LMI 005 ;Put in value for exponentiation JMP SCANFN ;Go to PARSER subroutine entry point. SCAN9: CPI 274 ;See if character fetched is the "less than" sign JFZ SCAN11 ;If not, continue checking for an operator LLI 200 ;If yes, set L to the EVAL CURRENT pointer LBM ;Fetch the pointer INB ;Increment it to point to the next character LMB ;Restore the updated pointer value CAL GETCHR ;Fetch the next character in the expression CPI 275 ;Is the character the "= 9 $ sign? JTZ SCAN13 ;If so, have 'less than or equal" combination CPI 276 ;Is the character the "greater than" sign? JTZ SCAN15 ;If so, have "less than or greater than" combination LLI 200 ;Else character is not part of the operator. Set L back LBM ;To the EVAL CURRENT pointer. Fetch the pointer DCB ;Value and decriment it back one character in the LMB ;Expression. Restore the original pointer value. LLI 176 ;Have just the 'less than" operator. Set L to the LMI 011 ;PARSER TOKEN storage location and set the value for JMP SCANFN ;The 'less than" sign then go to PARSER entry point. SCAN11: CPI 275 ;See if character fetched is the "= " sign JFZ SCAN12 ;If not, continue checking for an operator LLI 200 ;If yes, set L to the EVAL CURRENT pointer LBM ;Fetch the pointer INB ;Increment it to point to the next character LMB ;Restore the updated pointer value CAL GETCHR ;Fetch the next character in the expression CPI 274 ;Is the character the "less than" sign? JTZ SCAN13 ;If so, have "less than or equal" combination CPI 276 ;Is the character the "greater than" sign? JTZ SCAN14 ;If so, have "equal or greater than" combination LLI 200 ;Else character is not part of the operator. Set L back LBM ;To the EVAL CURRENT pointer. Fetch the pointer DCB ;Value and decrement it back one character in the LMB ;Expression. Restore the original pointer value. LLI 176 ;Just have '~-- " operator. Set L to the PARSER TOKEN LMI 012 ;Storage location and set the value for the sign. JMP SCANFN ;Go to the PARSER entry point. SCAN12: CPI 276 ;See if character fetched is the "greater than" sign JFZ SCAN16 ;If not, go append the character to the SYMBOL BUFF LLI 200 ;If so, set L to the EVAL CURRENT pointer LBM ;Fetch the pointer INB ;Increment it to point to the next character LMB ;Restore the updated pointer value CAL GETCHR ;Fetch the next character in the expression CPI 274 ;Is the character the "less than" sign? JTZ SCAN15 ;If so, have "less than or greater than" combination CPI 275 ;Is the character the "= " sign? JTZ SCAN14 ;If so, have the "equal to or greater than " combination LLI 200 ;Else character is not part of the operator. Set L back LBM ;To the EVAL CURRENT pointer. Fetch the pointer DCB ;Value and decrement it back one character in the LMB ;Expression. Restore the original pointer value. LLI 176 ;Have just the "greater than" operator. Set L to the LMI 013 ;PARSER TOKEN storage location and set the value for JMP SCANFN ;The "greater than" sign then go to PARSER entry SCAN13: LLI 176 ;When have 'less than or equal" combination set L to LMI 014 ;PARSER TOKEN storage location and set the value. JMP SCANFN ;Then go to the PARSER entry point. SCAN14: LLI 176 ;When have "equal to or greater than" combination set L LMI 015 ;To PARSER TOKEN storage location and set the value. JMP SCANFN ;Then go to the PARSER entry point. SCAN15: LLI 176 ;When have 'less than or greater than" combination set LMI 016 ;L to PARSER TOKEN storage location and set value. JMP SCANFN ;Then go to the PARSER entry point. SCAN16: CAL CONCTS ;Concatenate the character to the SYMBOL BUFFER SCAN10: LLI 200 ;Set L to the EVAL CURRENT pointer storage location LHI \HB\OLDPG26 ;** Set H to page of EVAL CURRENT pointer LBM ;Fetch the EVAL CURRENT pointer value into B INB ;Increment the pointer value to point to next character LMB ;In the expression and restore the updated value. LLI 277 ;Set L to EVAL FINISH storage location. LAM ;Fetch the EVAL FINISH value into the accumulator. DCB ;Set B to last character processed in the expression. CPB ;See if last character was at EVAL FINISH location. JFZ SCAN1 ;If not, continue processing the expression. Else, jump JMP PARSEP ;To final evaluation procedure and test. (Directs routine HLT ;To a dislocated section.) Safety Halt in unused byte. PARSER: LLI 120 ;Load L with starting address of SYMBOL BUFFER LHI \HB\OLDPG26 ;** Load H with page of SYMBOL BUFFER LAM ;Fetch the (cc) for contents of SYMBOL BUFFER NDA ;Into the ACC and see if buffer is empty JTZ PARSE ;If empty then no need to convert contents INL ;If not empty, advance buffer pointer LAM ;Fetch the first character in the buffer CPI 256 ;See if it is ASCII code for decimal sign JTZ PARNUM ;If yes, consider contents of buffer to be a number CPI 260 ;If not decimal sign, see if first character represents JTS LOOKUP ;A deciinal digit, if not, should have a variable CPI 272 ;Continue to test for a decimal digit JFS LOOKUP ;If not, go look up the variable nwne PARNUM: DCL ;If SYMBOL BUFFER contains number, decrement LAM ;Buffer pointer back to (cc) and fetch it to ACC CPI 001 ;See if length of string in buffer is just one JTZ NOEXPO ;If so, cannot have number with scientific notation ADL ;If not, add length to buffer pointer to LLA ;Point to last character in the buffer LAM ;Fetch the last character in buffer and see if it CPI 305 ;Represents letter E for Exponent JFZ NOEXPO ;If not, cannot have number with scientific notation LLI 200 ;If yes, have part of a scientific number, set pointer to CAL GETCHR ;Get the operator that follows the E and append it to JMP CONCTS ;The SYMBOL BUFFER and return to EVAL routine NOEXPO: LLI 227 ;Load L with address of ARITHMETIC STACK pointer LHI \HB\OLDPG1 ;** Load H with page of ARITHMETIC STACK pointer LAM ;Fetch AS pointer value to ACC and add four to account ADI 004 ;For the number of bytes required to store a number in LMA ;Floating point format. Restore pointer to mernory. LLA ;Then, change L to point to entry position in the AS CAL FSTORE ;Place contents of the FPACC onto top of the AS LLI 120 ;Change L to point to start of the SYMBOL BUFFER LHI \HB\OLDPG26 ;** Set H to page of the SYMBOL BUFFER CAL DINPUT ;Convert number in the buffer to floating point format JMP PARSE ;In the FPACC then jump to check operator sign. LOOKUP: LLI 370 ;Load L with address of LOOK-UP COUNTER LHI \HB\OLDPG26 ;** Load H with page of the counter LMI 000 ;Initialize the counter to zero LLI 120 ;Load L with starting address of the SYMBOL BUFFER LDI \HB\OLDPG27 ;** Load D with page of the VARIABLES TABLE LEI 210 ;Load E with start of the VARL433LES TABLE LAM ;Fetch the (cc) for the string in the SYMBOL BUFFER CPI 001 ;See if the name length is just one character. If not, JFZ LOOKU1 ;Should be two so proceed to look-up routine. Else, LLI 122 ;Change L to second character byte in the buffer and set LMI 000 ;It to zero to provide compatibility with entries in table LOOKU1: LLI 121 ;Load L with addr of first character in the SYMBOL LHI \HB\OLDPG26 ;** BUFFER. Set H to page of the SYMBOL BUFFER. CAL SWITCH ;Exchange contents of D&E with H&L so that can LAM ;Fetch the first character of a name in the VARIABLES INL ;TABLE. Advance the table pointer and save the LBM ;Second byte of name in B. Then advance the pointer INL ;Again to reach first bvte of floating point forrnatted CAL SWITCH ;Number in table. Now exchange D&E with H&L and CPM ;Compare first byte in table against first char in buffer JFZ LOOKU2 ;If not the same, go try next entry in table. If same, INL ;Advance pointer to next char in buffer. Transfer the LAB ;Character in B (second byte in table entry) to the ACC CPM ;Compare it against second character in the buffer. JTZ LOOKU4 ;If match, have found the name in the VARIABLES tbl. LOOKU2: CAL AD4DE ;Call subroutine to add four to the pointer in D&E to LLI 370 ;Advance the table pointer over value bytes. Then set LHI \HB\OLDPG26 ;** Up H and L to point to LOOK-UP COUNTER. LBM ;Fetch counter value (counts number of entries tested INB ;In the VARIABLES TABLE), increment it LMB ;And restore it back to meynory LLI 077 ;Load L with address of SYMBOL VARIABLES counter LHI \HB\OLDPG27 ;** Do same for H. (Counts number of names in table.) LAB ;Place LOOK-UP COUNTER value in the accumulator. CPM ;Compare it with number of entries in the table. JFZ LOOKU1 ;If have not reached end of table, keep looking for name. LLI 077 ;If reach end of table without match, need to add name LHI \HB\OLDPG27 ;** To table. First set H & L to the SYMBOL LBM ;VARIABLES counter. Fetch the counter value and INB ;Increment to account for new name being added to the LMB ;Table. Restore the updated count to meinory. Also, LAB ;Move the new counter value to the accumulator and CPI 025 ;Check to see that table size is not exceeded. If try to JFS BIGERR ;Go over 20 (decirnal) entries then have BIG error. LLI 121 ;Else, set L to point to first character in the SYMBOL LHI \HB\OLDPG26 ;** BUFFER and set H to proper page. Set the number LBI 002 ;Of bytes to be transferred into register B as a counter. CAL MOVEIT ;Move the symbol name from the buffer to the LLE ;VARIABLES TABLE. Now set up H & L with value LHD ;Contained in D & E after moving ops (points to first XRA ;Byte of the value to be associated with the symbol LMA ;Name.) Clear the accumulator and place zero in all four INL ;Bytes associated with the variable name entered LMA ;In the VARIABLES TABLE INL ;In order to LMA ;Assign an INL ;Initial value LMA ;To the variable narne LAL ;Then transfer the address in L to the acc'umulator SUI 004 ;Subtract four to reset the pointer to start of zeroing ops LEA ;Restore the address in D & E to be in same state as if LDH ;Name was found in the table in the LOOKUP routine LOOKU4: CAL SAVEHL ;Save current address to VARIABLES TABLE LLI 227 ;Load L with address of ARITHMETIC STACK pointer LHI \HB\OLDPG1 ;** Load H with page of the pointer LAM ;Fetch the AS pointer value to the accumulator ADI 004 ;Add four to account for next floating point forrnatted LMA ;Number to be stored in the stack. Restore the stack LLA ;Pointer to memory and set it up in register L too. CAL FSTORE ;Place the value in the FPACC on the top of the CAL RESTHL ;ARITHMETIC STACK. Restore the VARIABLES CAL SWITCH ;TABLE pointer to H&L and move it to D&E. Now load CAL FLOAD ;The VARIABLE value from the table to the FPACC. PARSE: CAL CLESYM ;Clear the SYMBOL BUFFER LLI 176 ;Load L with address of PARSER TOKEN VALUE LAM ;And fetch the token value into the accumulator CPI 007 ;Is it token value for right parenthesis ")" ? If so, have JTZ PARSE2 ;Special case where must perforin ops til find a "(" ! ADI 240 ;Else, fon-n address to HEIRARCHY IN table and LLA ;Set L to point to HEIRARCHY IN VALUE in the table LBM ;Fetch the heirarchy value from the table to register B LLI 210 ;Set L to OPERATOR STACK pointer storage location LCM ;Fetch the OS pointer into CPU register C CAL INDEXC ;Add OS pointer to address of OS pointer storage loc LAM ;Fetch the token value for the operator at top of the OS ADI 257 ;And form address to HEIRARCHY OUT table LLA ;Set L to point to HEIRARCHY OUT VALUE in the LAB ;Table. Move the HEIRARCHY IN value to the ACC. CPM ;Compare the HEIRARCHY IN with the HEIRARCHY JTZ PARSE1 ;OUT value. If heirarchy of current operator equal to or JTS PARSE1 ;Less than operator on top of OS stack, perfo LLI 176 ;Operation indicated in top of OS stack. Else, fetch the LBM ;Current operator token value into register B. LLI 210 ;Load L with address of the OPERATOR STACK pntr LCM ;Fetch the stack pointer value INC ;Increment it to account for new entry on the stack LMC ;Restore the stack pointer value to memory CAL INDEXC ;For in pointer to next entry in OPERATOR STACK LMB ;Place the current operator token value on top of the OS RET ;Exit back to the EVAL routine. PARSE1: LLI 210 ;Load L with address of the OPERATOR STACK pntr LAM ;Fetch the stack pointer value to the accumulator ADL ;Add in the value of the stack pointer address to form LLA ;Address that points to top entry in the OS LAM ;Fetch the token value at the top of the OS to the ACC NDA ;Check to see if the token value is zero for end of stack RTZ ;Exit back to the EVAL routine if stack empty LLI 210 ;Else, reset L to the OS pointer storage location LCM ;Fetch the pointer value DCC ;Decrement it to account for operator rernoved from LMC ;The OPERATOR STACK and restore the pointer value CAL FPOPER ;Perform the operation obtained from the top of the OS JMP PARSE ;Continue to compare current operator against top of OS PARSE2: LLI 210 ;Load L with address of the OPERATOR STACK pntr LHI \HB\OLDPG26 ;** Load H with page of the pointer LAM ;Fetch the stack pointer value to the accumulator ADL ;Add in the value of the stack pointer address to form LLA ;Address that points to top entry in the OS LAM ;Fetch the token value at the top of the 0 S to the ACC NDA ;Check to see if the token value is zero for end of stack JTZ PARNER ;If end of stack, then have a parenthesis error condx LLI 210 ;Else, reset L to the OS pointer storage location LCM ;Fetch the pointer value DCC ;Decrement it to account for operator removed from LMC ;The OPERATOR STACK and restore the pointer value CPI 006 ;Check to see if token value is "(" to close parenthesis RTZ ;If so, exit back to EVAL routine. CAL FPOPER ;Else, perforin the op obtained from the top of the OS JMP PARSE2 ;Continue to process data in parenthesis FPOPER: LLI 371 ;Load L with address of TEMP OP storage location LHI \HB\OLDPG26 ;** Load H with page of TEMP OP storage location LMA ;Store OP (from top of OPERATOR STACK) LLI 227 ;Change L to address of ARff HMETIC STACK pointer LHI \HB\OLDPG1 ;** Load H with page of AS pointer LAM ;Fetch AS pointer value into ACC LLA ;Set L to top of ARITHMETIC STACK CAL OPLOAD ;Transfer number from ARffHMETIC STACK to FPOP LLI 227 ;Restore pointer to AS pointer LAM ;Fetch the pointer value to the ACC and subtract four SUI 004 ;To remove top value from the ARITHMETIC STACK LMA ;Restore the updated AS pointer to memory LLI 371 ;Set L to address of TEMP OP storage location LHI \HB\OLDPG26 ;** Set H to page of TEMP OP storage location LAM ;Fetch the operator token value to the ACC CPI 001 ;Find out which kind of operation indicated JTZ FPADD ;Perforn addition if have plus operator CPI 002 ;If not plus, see if minus JTZ FPSUB ;Perform subtraction if have minus operator CPI 003 ;If not minus, see if multiplication JTZ FPMULT ;Perform multiplication if have multiplication operator CPI 004 ;If not multiplication, see if division JTZ FPDIV ;Perform division if have division operator CPI 005 ;If not division, see if exponentiation JTZ INTEXP ;Perform exponentiation if have exponentiation operator CPI 011 ;If not exponentiation, see if "less than" operator JTZ LT ;Perform compaison for "less than" op if indicated CPI 012 ;If not 'less than" see if have "equal" operator JTZ EQ ;Perforin comparison for "equal" op if indicated CPI 013 ;If not "equal" see if have "greater than" operator JTZ GT ;Perform comparison for "greater than" op if indicated CPI 014 ;If not "'greater than" see if have 'less than or equal" op JTZ LE ;Perform comparison for the combination op if indicated CPI 015 ;See if have "equal to or greater than" operator JTZ GE ;Perform comparison for the combination op if indicated CPI 016 ;See if have "less than or greater than" operator JTZ NE ;Perform comparison for the combination op if indicated PARNER: LLI 230 ;If cannot find operator, expression is not balanced LHI \HB\OLDPG26 ;** Set H and L to address of F/A STACK pointer LMI 000 ;Clear the F/A STACK pointer to re-initialize LAI 311 ;Load ASCII code for letter I into the accumulator LCI 250 ;And code for "(" character into register C JMP ERROR ;Go display 1( for "Imbalanced Parenthesis") error msg LT: CAL FPSUB ;Subtract contents of FPACC from FPOP to compare LLI 126 ;Set L to point to the MSW of the FPACC (Contains LAM ;Result of the subtraction.) Fetch the MSW of the NDA ;FPACC to the accumulator and test to see if result is JTS CTRUE ;Positive or negative. Set up the FPACC as a function JMP CFALSE ;Of the result obtained. EQ: CAL FPSUB ;Subtract contents of FPACC from FPOP to compare LLI 126 ;Set L to point to the MSW of the FPACC (Contains LAM ;Result of the subtraction.) Fetch the MSW of the NDA ;FPACC to the accumulator and test to see if result is JTZ CTRUE ;Equal. Set up the FPACC as a function JMP CFALSE ;Of the result obtained. GT: CAL FPSUB ;Subtract contents of FPACC from FPOP to compare LLI 126 ;Set L to point to the MSW of the FPACC (Contains LAM ;Result of the subtraction.) Fetch the MSW of the NDA ;FPACC to the accumulator and test to see if result is JTZ CFALSE ;Positive, Negative, or Equal. Set up the FPACC JFS CTRUE ;As a function JMP CFALSE ;Of the result obtained. LE: CAL FPSUB ;Subtract contents of FPACC from FPOP to compare LLI 126 ;Set L to point to the MSW of the FPACC (Contains LAM ;Result of the subtraction.) Fetch the MSW of the NDA ;FPACC to the accumulator and test to see if result is JTZ CTRUE ;Positive, Negative, or Equal. Set up the FPACC JTS CTRUE ;As a function JMP CFALSE ;Of the result obtained GE: CAL FPSUB ;Submit contents of FPACC from FPOP to compare LLI 126 ;Set L to point to the MSW of the FPACC (Contains LAM ;Result of the subtraction.) Fetch the MSW of the NDA ;FPACC to the accumulator and test to see if result is JFS CTRUE ;Positive or Negative. Set up the FPACC JMP CFALSE ;As a function of the result obtained NE: CAL FPSUB ;Subtract contents of FPACC from FPOP to compare LLI 126 ;Set L to point to the MSW of the FPACC (Contains LAM ;Result of the subtraction.) Fetch the MSW of the NDA ;FPACC to the accumulator and test to see if result is JTZ CFALSE ;Equal. Set up the FPACC as a function of the result. CTRUE: FPONE: LLI 004 ;Load L with address of floating point value +1.0 JMP FLOAD ;Load FPACC with value +1.0 and exit to caller CFALSE: LLI 127 ;Load L with address of FPACC Exponent register LMI 000 ;Set the FPACC Exponent to zero and then set the JMP FPZERO ;Mantissa portion of the FPACC to zero. Exit to caller. AD4DE: LAE ;Subroutine to add four to the value in register E. ADI 004 ;Move contents of E to the ACC and add four. LEA ;Restore the updated value back to register E. RET ;Return to the calling routine. INTEXP: LLI 126 ;Load L with address of WSW of FPACC (Floating Point LHI \HB\OLDPG1 ;** ACCumulator). Load H with page of FPACC. LAM ;Fetch MSW of the FPACC into the accumulator. LLI 003 ;Load L with address of EXP TEMP storage location LMA ;Store the FPACC MSW value in EXP TEMP location NDA ;Test contents of the MSW of the FPACC. ff zero, then JTZ FPONE ;Set FPACC equal to +1.0 (any nr to zero power = 1.0!) CTS FPCOMP ;If MSW indicates negative number, complement CAL FPFIX ;The FPACC. Then convert floating point number to LLI 124 ;Fixed point. Load L with address of LSW of fixed nr LBM ;Fetch the LSW into CPU register B. LLI 013 ;Set L to address of EXPONENT COUNTER LMB ;Place the fixed value in the EXP CNTR to indicate LLI 134 ;Number of multiplications needed (power). Now set L LEI 014 ;To LSW of FPOP and E to address of FP TEMP (LSW) LHI \HB\OLDPG1 ;** Set H to floating point working area page. LDH ;Set D to same page address. LBI 004 ;Set transfer (precision) counter. Call subroutine to move CAL MOVEIT ;Contents of FPOP into FP TEMP registers to save CAL FPONE ;Original value of FPOP. Now set FPACC to +1.0. LLI 003 ;Load L with pointer to original value of FPACC LAM ;(Stored in FP TEMP) MSW and fetch contents to ACC. NDA ;Test to see if raising to a negative power. If so, divide JTS DVLOOP ;Instead of multiply! MULOOP: LLI 014 ;Load L with address of LSW of FP TEMP (original CAL FACXOP ;Value in FPOP). Move FP TEMP into FPOP. CAL FPMULT ;Multiply FPACC by FPOP. Result left in FPACC. LLI 013 ;Load L with address of EXPONENT COUNTER. LBM ;Fetch the counter value DCB ;Decrement it LMB ;Restore it to memory JFZ MULOOP ;If counter not zero, continue exponentiation process RET ;When have raised to proper power, return to caller. DVLOOP: LLI 014 ;Load L with address of LSW of FP TEMP (original CAL FACXOP ;Value in FPOP). Move FP TEMP into FPOP. CAL FPDIV ;Divide FPACC by FPOP. Result left in FPACC. LLI 013 ;Load L with address of EXPONENT COUNTER LBM ;Fetch the counter value DCB ;Decrement it LMB ;Restore to memory JFZ DVLOOP ;If counter not zero, continue exponentiation process RET ;When have raised to proper power, return to caller. ;;; The label PRIGHT: SHOULD BE UP TO 07 003 PRIGHT: LLI 230 ;Load L with address of F/A STACK pointer LHI \HB\OLDPG26 ;** Load H with page of F/A STACK pointer LAM ;Fetch the pointer value into the ACC ADL ;Form pointer to top of the F/A STACK LLA ;Set L to point to top of the F/A STACK LAM ;Fetch the contents of the top of the F/A STACK into LMI 000 ;The ACC then clear the top of the F/A STACK LLI 203 ;Load L with address of F /A STACK TEMP storage LHI \HB\OLDPG27 ;** Location. Set H to page of F/A STACK TEMP LMA ;Store value from top of F/A STACK into temp loc. NDA ;Test to see if token value in top of stack was zero RTZ ;If so, just had simple grouping parenthesis! JTS PRIGH1 ;@@ If token value minus, indicates array subscript CPI 001 ;For positive token value, look for appropriate function JTZ INTX ;If token value for INTeger function, go do it. CPI 002 ;Else, see if token value for SIGN function. JTZ SGNX ;If so, go do it. CPI 003 ;Else, see if token value for ABSolute function JTZ ABSX ;If so, go do it. CPI 004 ;If not, see if token value for SQuare Root function JTZ SQRX ;If so, go do it. CPI 005 ;If not, see if token value for TAB function JTZ TABX ;If so, go do it. CPI 006 ;If not, see if token value for RaNDom function JTZ RNDX ;If so, go find a random number. CPI 007 ;If not, see if token value for CHaRacter function JTZ CHRX ;If so, go perform the function. CPI 010 ;Else, see if token for user defined machine language JTZ UDEFX ;# Function. If so, perform the User DEfined Function HLT ;Safety halt. Program should not reach this location! ;;; The label FUNARR SHOULD BE AT 07 100 FUNARR: LLI 120 ;Load L with starting address of SYMBOL BUFFER LHI \HB\OLDPG26 ;** Load H with page of SYMBOL BUFFER LAM ;Fetch the (cc) for contents of buffer to the ACC NDA ;See if (cc) is zero, if so buffer is empty, return to RTZ ;Caller as have simple grouping parenthesis sign LLI 202 ;Else set L to TEMP COUNTER location LHI \HB\OLDPG27 ;** Set H to TEMP COUNTER page LMI 000 ;Initialize TEMP COUNTER to zero FUNAR1: LLI 202 ;Load L with address of TEMP COUNTER LHI \HB\OLDPG27 ;** Load H with page of TEMP COUNTER LBM ;Fetch the counter value to register B INB ;Increment the counter LMB ;Restore the updated value to memory LCI 002 ;Initialize C to a value of two for future ops LLI 274 ;Load L with starting address (less four) of FUNCTION LHI \HB\OLDPG26 ;** LOOK-UP TABLE. Set H to table page. CAL TABADR ;Find address of next entry in the table LDI \HB\OLDPG26 ;** Load D with page of SYMBOL BUFFER LEI 120 ;Load E with starting address of SYMBOL BUFFER CAL STRCP ;Compare entry in FUNCTION LOOK-UP TABLE with JTZ FUNAR4 ;Contents of SYMBOL BUFFER. If find match, go set LLI 202 ;Up the function token value. Else, set L to the TEMP LHI \HB\OLDPG27 ;** COUNTER and set H to the proper page. Fetch the LAM ;Current counter value and see if have tried all eight CPI 010 ;Possible functions in the table. JFZ FUNAR1 ;If not, go back and check the next entry. LLI 202 ;If have tried all of the entries in the table, set L LHI \HB\OLDPG27 ;** As well as H to the address of the TEMP COUI,.7ER LMI 000 ;And reset it to zero. Now go see if have subscripted JMP FUNAR2 ;@@ Array (unless array capability not in program). FAERR: LLI 230 ;Load L with address of F/A STACK pointer LHI \HB\OLDPG26 ;** Load H with page of F/A STACK pointer LMI 000 ;Clear the F/A STACK pointer to reset on an error LAI 306 ;Load the ASCII code for letter F into the ACC LCI 301 ;Load the ASCII code for letter A into register C JMP ERROR ;Go display the FA error message FUNAR4: LLI 202 ;Load L with address of TEMP COUNTER LHI \HB\OLDPG27 ;** Set H to page of TEMP COUNTER LBM ;Load value in counter to register B. This is FUNCTION LLI 230 ;TOKEN VALUE. Cbange- L to F/A STACK pointer. LHI \HB\OLDPG26 ;** Load H with page of F/A STACK pointer. LCM ;Fetch the F/A STACK pointer value into register C. CAL INDEXC ;Form the address to the top of the F/A STACK. LMB ;Store the FUNCTION TOKEN VALUE in the F/A JMP CLESYM ;STACK. Then exit by clearing the SYMBOL BUFFER. TABADR: LAB ;Move the TEMP COUNTER value from B to ACC TABAD1: RLC ;Multiply by four using this loop to form value equal DCC ;To number of bytes per entry (4) times current entry JFZ TABAD1 ;In the FUNCTION LOOK-UP TABLE. ADL ;Add this value to the starting address of the table. LLA ;Form pointer to next entry in table RFC ;If no carry return to caller INH ;Else, increment H before RET ;Returning to caller ;;; The label INTX SHOULD BE AT 07 243 INTX: LLI 126 ;Load L with address of MSW of the FPACC LHI \HB\OLDPG1 ;** Load H with the page of the PPACC LAM ;Fetch the MSW of the FPACC into the accumulator NDA ;Test the sign of the number in the FPACC. If JFS INT1 ;Positive jump ahead to integerize LLI 014 ;If negative, load L with address of FP TEMP registers CAL FSTORE ;Store the value in the FPACC in FP TEMP CAL FPFIX ;Convert the value in FPACC from floating point to LLI 123 ;Fixed point. Load L with address of FPACC LMI 000 ;Extension register and clear it. CAL FPFLT ;Convert fixed binary back to FP to integerize LLI 014 ;Load L with address of FP TEMP registers CAL OPLOAD ;Load the value in FP TEMP into FPOP CAL FPSUB ;Subtract integerized value from original LLI 126 ;Set L to address of MSW of FPACC LAM ;Fetch the MSW of the FPACC into the accumulator NDA ;See if original value and integerized value the same JTZ INT2 ;If so, have integer value in FP TEMP LLI 014 ;Else, load L with address of FP TEMP registers CAL FLOAD ;Restore FPACC to original (non-integerized) value LLI 024 ;Set L to register containing small value CAL FACXOP ;Set up to add small value to original value in FPACC CAL FPADD ;Perform the addition INT1: CAL FPFIX ;Convert the number in FPACC from floating point LLI 123 ;To fixed point. Load L with address of FPACC LMI 000 ;Extension register and clear it. Now convert the number JMP FPFLT ;Back to floating point to integerize it and exit to caller INT2: LLI 014 ;Load L with address of FP TEMP registers. Transfer JMP FLOAD ;Number from FP TEMP (orig) to FPACC and return. ABSX: LLI 126 ;Load L with address of MSW of the FPACC LHI \HB\OLDPG1 ;** Set H to page of the FPACC LAM ;Fetch the MSW of the FPACC into the accumulator NDA ;Test the sign of the number to see if it is positive. JTS FPCOMP ;If negative, complement the number before returning. RET ;Else, just return with absolute value in the FPACC. SGNX: LLI 126 ;Load L with address of MSW of the FPACC LHI \HB\OLDPG1 ;** Load H with the page of the FPACC LAM ;Fetch the MSW of the FPACC into the accumulator NDA ;Test to see if the FPACC is zero RTZ ;Return to caller if FPACC is zero JFS FPONE ;If FPACC is positive, load +1.0 into FPACC and exit LLI 024 ;If FPACC is negative, set up to load -1.0 into the JMP FLOAD ;FPACC and exit to caller CHRX: CAL FPFIX ;Convert contents of FPACC from floating point to LLI 124 ;Fixed point. Load L with address of LSW of fixed LAM ;Value. Fetch this byte into the accumulator. CAL ECHO ;Display the value. LLI 177 ;Set L to address of the TAB FLAG LHI \HB\OLDPG26 ;** Set H to page of the TAB FLAG LMI 377 ;Set TAB FLAG (to inhibit display of FP value) RET ;Exit to caller. TABX: CAL FPFIX ;Convert contents of FPACC from floating point to TAB1: LLI 124 ;Fixed point. Load L with address of 1,SW of fixed LAM ;Value. Fetch this byte into the accumulator. LLI 043 ;Load L with address of COLUMN COUNTER SUM ;Subtract value in C-OLUMN COUNTER from desired LLI 177 ;TAB position. Load L with address of the TAB FLAG. LHI \HB\OLDPG26 ;** Set H to page of the TAB FLAG. LMI 377 ;Set TAB FLAG (to inhibit display of FP value) JTS BACKSP ;If beyond TAB point desired, simulate back spacing RTZ ;Return to caller if at desired TAB location TABC: LCA ;Else, put difference count in register C LAI 240 ;Place ASCII code for space in ACC TABLOP: CAL ECHO ;Display space on output device DCC ;Decrement displacement counter JFZ TABLOP ;If have not reached TAB position, continue to space RET ;Else, return to calling routine. ;;; The label STOSYM should be AT 10 055 STOSYM: LLI 201 ;Load L with address of ARRAY FLAG LHI \HB\OLDPG27 ;** Load H with page of ARRAY FLAG LAM ;Fetch the value of the ARRAY FLAG into the ACC NDA ;Check to see if the flag is set indicating processing an JTZ STOSY1 ;Array variable value. Jump ahead if flag not set. LMI 000 ;If ARRAY FLAG was set, clear it for next time. LLI 204 ;Then load L with address of array address storage loc LLM ;Fetch the array storage address as new pointer LHI \HB\OLDPG57 ;tt Set H to ARRAY VALUES page **************** JMP FSTORE ;Store the array variable value and exit to caller. STOSY1: LLI 370 ;Load L with address of TEMP CNTR LHI \HB\OLDPG26 ;** Load H with page of TEMP CNTR LMI 000 ;Initialize the TEMP CNTR by clearing it LLI 120 ;Load L with starting address of SYMBOL BUFFER LDI \HB\OLDPG27 ;** Load D with page of VARIABLES LOOK-UP table LEI 210 ;Load E with starting addr of VARIABLES LOOK-UP LAM ;Table. Fetch the (cc) for the SYMBOL BUFFER into CPI 001 ;The ACC and see if length of variable name is just one JFZ STOSY2 ;Character. If not, skip next couple of instructions. LLI 122 ;Else, set pointer to second character location in the LMI 000 ;SYMBOL BUFFER and set it to zero STOSY2: LLI 121 ;load L with address of first character in the SYMBOL LHI \HB\OLDPG26 ;** BUFFER. Load H with page of the buffer. CAL SWITCH ;Exchange pointer to buffer for pointer to VARIABLES LAM ;LOOK-UP table. Fetch first char in a name from the INL ;Table. Advance the pointer to second char in a name. LBM ;Fetch the second character into register B. INL ;Advance the pointer to first byte of a value in the table. CAL SWITCH ;Exchange table pointer for pointer to SYMBOL BUFF CPM ;Compare first character in buffer against first character JFZ STOSY3 ;In table entry. If no match, try next entry in the table. INL ;If match, advance pointer to second character in buffer. LAB ;Move second character obtained from table into ACC. CPM ;Compare second characters in table and buffer. JTZ STOSY5 ;If same, have found the variable name in the table. STOSY3: CAL AD4DE ;Add four to pointer in registers D&E to skip over value LLI 370 ;Portion of entry in table. Load L with address of TEMP LHI \HB\OLDPG26 ;** CNTR. Load H with page of TEMP CNTR. LBM ;Fetch the counter INB ;Increment the counter LMB ;Restore it to storage LLI 077 ;Set L to address of VARIABLES CNTR (indicates LHI \HB\OLDPG27 ;** Number of variables currently in table.) Set H too LAB ;Move the TEMP CNTR value into the ACC. (Number of CPM ;Entries checked.) Compare with number of entries in JFZ STOSY2 ;The table. If have not checked all entries, try next one. LLI 077 ;If have checked all entries, load L with address of the LHI \HB\OLDPG27 ;** VARIABLES CNTR. Set H too. Fetch the counter LBM ;Value and incrernent it to account for INB ;New variable nwne that will now be LMB ;Added to the table. Save the new value. LAB ;Place the new counter value into the accumulator CPI 025 ;And check to see that adding new variable name to the JFS BIGERR ;Table will not cause table overflow. Big Error if it does! LLI 121 ;If room available in table, set L to address of first LHI \HB\OLDPG26 ;** Caracter in the SYMBOL BUFFER. Set H too. LBI 002 ;Set a counter for number of characters to transfer. CAL MOVEIT ;Move the variable name from buffer to table. STOSY5: CAL SWITCH ;Exchange buffer pointer for table pointer. CAL FSTORE ;Transfer new mathematical value into the table. JMP CLESYM ;Clear the SYMBOL BUFFER and exit to calling routine. ;The subroutines below are used by some of the routines ;in this chapter as well as other parts of the program. SAVESY: LLI 120 ;Load L with the address of the start of the SYMBOL LHI \HB\OLDPG26 ;** BUFFER. Load H with the page of the buffer. LDH ;Load register D with the page of the AUX SYMBOL LEI 144 ;BUFFER and set register E to start of that buffer. JMP MOVECP ;Transfer SYMBOL BF contents to AUX SYMBOL BF RESTSY: LLI 144 ;Load L with address of start of AUX SYMBOL BUFF LHI \HB\OLDPG26 ;** Load H with page of AUX SYMBOL BUFFER LDH ;Set D to page of SYMBOL BUFFER (same as H) LEI 120 ;Load E with start of SYMBOL BUFFER MOVECP: LBM ;Load (cc) for source string (first byte in source buffer) INB ;Add one to (cc) to include (cc) byte itself JMP MOVEIT ;Move the source string to destination buffer ;;; The label Exec SHOULD BE AT 10 266 (This is the start of the code) EXEC: LLI 352 ;Load L with address of READY message LHI \HB\OLDPG1 ;** Load H with page of READY message CAL TEXTC ;Call subroutine to display the READY message EXEC1: LLI 000 ;Load L with starting address of INPUT LINE BUFFER LHI \HB\OLDPG26 ;** Load H with page of INPUT LINE BUFFER CAL STRIN ;Call subroutine to input a line into the buffer LAM ;The STRIN subroutine will exit with pointer set to the NDA ;CHARACTER COUNT for the line inputted. Fetch the JTZ EXEC1 ;Value of the counter, if it is zero then line was blank. LLI 335 ;Load L with address of LIST in look up table LHI \HB\OLDPG1 ;Load H with address of LIST in look up table LDI \HB\OLDPG26 ;Load D with page of line input buffer LEI 000 ;Load E with start of line input buffer CAL STRCP ;Call string compare subroutine to see if first word in JFZ NOLIST ;Input buffer is LIST. Jump 3 ahead if not LIST. LLI 000 ;If LIST, set up pointers to start of USER PROGRAM LHI BGNPGRAM ;BUFFER. (Note user could alter this starting addr) ***** ;Next portion of program will LIST the contents of the ;USER PROGRAM BUFFER until an end of buffer ;(zero byte) indicator is detected. LIST: LAM ;Fetch the first byte of a line in the USER PROGRAM NDA ;BUFFER and see if it is zero. If so, have finished LIST JTZ EXEC ;So go back to start of Executive and display READY. CAL TEXTC ;Else call subroutine to display a line of information CAL ADV ;Now call subroutine to advance buffer pointer to CAL CRLF ;Character count in next line. Also display a CR & LF. JMP LIST ;Continue LISTing process ;If line inputted by operator did not contain a LIST comman ;continue program to see if RUN or SCRatch command. NOLIST: LLI 342 ;Load L with address of RUN in look up table LHI \HB\OLDPG1 ;** Load H with address of RUN in look up table LEI 000 ;Load E with start of line input buffer LDI \HB\OLDPG26 ;** Load D with page of line input buffer LEI 000 ;(Reserve 2 locs in case of patching by duplicating above) CAL STRCP ;Call string compare subroutine to see if first word in JTZ RUN ;Input buffer is RUN. Go to RUN routine if match. LDI \HB\OLDPG26 ;** If not RUN command, reset address pointers back LEI 000 ;To the start of the line input buffer LLI 346 ;Load L with address of SCR in look up table LHI \HB\OLDPG1 ;** Load H with page of SCR in look up table CAL STRCP ;Call string compare subroutine to see if first word in JFZ NOSCR ;Input buffer is SCR. If not then jump ahead. LHI \HB\OLDPG26 ;** If found SCR command then load memory pointer LLI 364 ;With address of a pointer storage location. Set that LMI BGNPGRAM ;tt Storage location to page of start of USER PRO- ******* INL ;GRAM BUFFER. (Buffer start loc may be altered). LMI 000 ;Then adv pntr and do same for low addr portion of pntr LLI 077 ;Now set pointer to address of VARIABLES counter LHI \HB\OLDPG27 ;** Storage location. Initialize this counter by placing LMI 001 ;The count of one into it. Now change the memory pntr ;;; LMI 001 ;The count of one into it. Now change the memory pntr ;;; Apparently, in Page 3 of Issue 4 of Scelbal update (1/77) they say the above should change. ;;; This makes the SCR command clear the whole variable space, otherwise one space is lost. LMI 000 LLI 075 ;To storage location for number of dimensioned arrays LMI 000 ;@@ And initialize to zero. (@@ = Substitute NOPs if LLI 120 ;@@ DIMension capability not used in package.) Also LMI 000 ;@@ Initialize l'st byte of array name table to zero. LLI 210 ;Set pointer to storage location for the first byte of the LMI 000 ;VARIABLES symbol table. Initialize it to zero too. INL ;Advance the pointer and zero the second location LMI 000 ;In the Variables table also. LHI BGNPGRAM ;tt Load H with page of start of USER PROGRAM ********** LLI 000 ;BUFFER. (Buffer start location could be altered.) LMI 000 ;Clear first location to indicate end of user program. LHI \HB\OLDPG57 ;@@ Load H with page of ARRAYS storage SCRLOP: LMI 000 ;@@ And form a loop to clear out all the locations INL ;@@ On the ARRAYS storage page. (@@ These become JFZ SCRLOP ;@@ NOPs if DIMension capability deleted fm package.) JMP EXEC ;SCRatch operations completed, go back to EXEC. ;If line inputted did not contain RUN or SCRatch com- ;mand, program continues by testing for SAVE or LOAD ;commands. If it does not find either of these com- ;mands, then operator did not input an executive com- ;mand. Program then sets up to see if the first entry in ;the line inputted is a LINE NUMBER. NOSCR: LEI 272 ;Load E with address of SAVE in look up table LDI \HB\OLDPG1 ;Load D with page of look up table LHI \HB\OLDPG26 ;Load H with page of input line buffer LLI 000 ;Set L to start of input line buffer CAL STRCP ;Call string compare subroutine to see if first word in JTZ SAVE ;tt Input buffer is SAVE. If so, go to user's SAVE rtn LLI 277 ;If not SAVE then load L with address of LOAD in look LHI \HB\OLDPG1 ;Up table and load H with page of look up table LDI \HB\OLDPG26 ;Load D with page of input line buffer LEI 000 ;And L to start of input line buffer CAL STRCP ;Call string compare subroutine to see if first word in JTZ LOAD ;tt Input buffer is LOAD. If so, go to user's LOAD rtn LLI 360 ;If not LOAD then set pointer to address of storage loc LHI \HB\OLDPG26 ;** For USER PROGRAM BUFFER pointer. Initialize this LMI BGNPGRAM ;tt Pointer to the starting address of the program buffer. INL ;Advance memory pntr. Since pointer storage requires LMI 000 ;Two locations, initialize the low addr portion also. CAL SYNTAX ;Call the SYNTAX subroutine to obtain a TOKEN indi- LLI 203 ;Cator which will be stored in this location. Upon return LHI \HB\OLDPG26 ;** From SYNTAX subroutine set memory pointer to LAM ;The TOKEN indicator storage location and fetch the NDA ;Value of the TOKEN. If the value of the syntax TOKEN JFS SYNTOK ;Is positive then have a valid entry. SYNERR: LAI 323 ;However, if SYNTAX returns a negative value TOKEN LCI 331 ;Then have an error condition. Set up the letters SY in JMP ERROR ;ASCII code and go to display error message to operator. SYNTOK: LLI 340 ;Set pointer to start of LINE NUMBER storage area LAM ;First byte there will contain the length of the line NDA ;Number character string. Fetch that value (cc). JTZ DIRECT ;DIRECT If line number blank, have a DIRECT statement! LLI 360 ;If have a line number must get line in input buffer into LMI BGNPGRAM ;tt User program buffer. Initialize pointer to user buffer. INL ;This is a two byte pointer so after initializing page addr LMI 000 ;Advance pointer and initialize location on page address ;If the line in the LINE INPUT BUFFER has a line num- ;ber then the line is to be placed in the USER PRO- ;GRAM BUFFER. It is now necessary to determine ;where the new line is to be placed in the USER PRO- ;GRAM BUFFER. This is dictated by the value of the ;new line number in relation to the line numbers cur- ;rently in the program buffer. The next portion of the ;program goes through the contents of the USER PRO- ;GRAM BUFFER comparing the values of the line num- ;bers already stored against the value of the line number ;currently being held in the LINE INPUT BUFFER. ;Appropriate action is then taken to Insert or Append, ;Change, or Delete a line in the program buffer. GETAUX: LLI 201 ;Set memory pointer to line character pointer storage LHI \HB\OLDPG26 ;** Location and then initialize that storage location LMI 001 ;To point to the 1'st character in a line LLI 350 ;Set memory pointer to addr of start of auxiliary line LMI 000 ;Number storage area and initialize first byte to zero GETAU0: LLI 201 ;Set memory pointer to line character pointer storage loc CAL GETCHP ;Fetch a char in line pointed to by line pointer JTZ GETAU1 ;If character is a space, skip it by going to advance pntrs CPI 260 ;If not a space check to see if character represents a JTS GETAU2 ;Valid decimal digit in the range 0 to 9 by testing the CPI 272 ;ASCII code value obtained. If not a deciznal digit then JFS GETAU2 ;Assume have obtained the line number. Go process. LLI 350 ;If valid decimal digit want to append the digit to the LHI \HB\OLDPG26 ;** Current string being built up in the auxiliary line CAL CONCT1 ;Number storage area so call sub to concat a character. GETAU1: LLI 201 ;Reset memory pointer to line character pntr storage loc LHI \HB\OLDPG26 ;On the appropriate page. LBM INB ;Fetch the pointer, increment it, and restore new value LMB LLI 360 ;Set memory pointer to pgm buff line pntr storage loc LHI \HB\OLDPG26 LCM ;Bring the high order byte of this double byte pointer INL ;Into CPU register C. Then advance the memory pntr LLM ;And bring the low order byte into register L. Now trans- LHC ;Fer the higher order portion into memory pointer H. LAM ;Obtain the char cntr (cc) which indicates the length of DCB ;The line being pointed to by the user program line pntr CPB ;Compare this with the value of the chars processed so JFZ GETAU0 ;Far in current line. If not equal, continue getting line n GETAU2: LLI 360 ;Reset mem pntr to pgm buffer line pntr storage LHI \HB\OLDPG26 ;** On this page and place the high order byte LDM ;Of this pointer into CPU register D INL ;Advance the memory pointer, fetch the second LLM ;Byte of the pgm buffer line pointer into register L LHD ;Now make the memory pointer equal to this value LAM ;Fetch the first byte of a line in the program buffer NDA ;Test to see if end of contents of pgm buff (zero byte) JFZ NOTEND ;If not zero continue processing. If zero have reached JMP NOSAME ;End of buffer contents so go APPEND line to buffer. ;;; there are some open addresses here. Above JUMP starts at 11-304; ;;; The below label patch3 should start at 11 307 PATCH3: LLI 201 ; ptr to A/V storage LHI 027 LMI 000 ; clear A/V flag JMP EXEC ORG 011#336 NOTEND: LLI 350 ;Load L with addr of auxiliary line number storage loc LHI \HB\OLDPG26 ;Load H with addr of aux line number storage loc LDI \HB\OLDPG26 ;Load D with addr of line number buffer location LEI 340 ;Load E with address of line number buffer location CAL STRCP ;Compare line nr in input buffer with line number in JTS CONTIN ;User program buffer. If lesser in value keep looking. JFZ NOSAME ;If greater in value then go to Insert line in pgm buffer LLI 360 ;If same values then must remove the line with the same LHI \HB\OLDPG26 ;** Line number from the user program buffer. Set up LCM ;The CPU memory pointer to point to the current INL ;Position in the user program buffer by retrieving that LLM ;Pointer from its storage location. Then obtain the first LHC ;Byte of data pointed to which will be the character LBM ;Count for that line (cc). Add one to the cc value to take INB ;Account of the (cc) byte itself and then remove that CAL REMOVE ;Many bytes to effectively delete the line fm the user LLI 203 ;Program buffer. Now see if line in input buffer consists LHI \HB\OLDPG26 ;** Only of a line number by checking SYNTAX LAM ;TOKEN value. Fetch the TOKEN value from its NDA ;Storage location. If it is zero then input buffer only JTZ EXEC ;Contains a line number. Action is a pure Delete. NOSAME: LLI 360 ;Reset memory pointer to program buffer LHI \HB\OLDPG26 ;Line pointer storage location LDM ;Load high order byte into CPU register D INL ;Advance memory pointer LEM ;Load low order byte into CPU register E LLI 000 ;Load L with address of start of line input buffer LHI \HB\OLDPG26 ;** Do same for CPU register H LBM ;Get length of line input buffer INB ;Advance length by one to include (cc) byte CAL INSERT ;Go make room to insert line into user program buffer LLI 360 ;Reset memory pointer to program buffer LHI \HB\OLDPG26 ;** Line pointer storage location LDM ;Load higher byte into CPU register D INL ;Advance memory pointer LEM ;Load low order byte into CPU register E LLI 000 ;Load L with address of start of line input buffer LHI \HB\OLDPG26 ;** Do same for CPU register H CAL MOVEC ;Call subroutine to Insert line in input buffer into the JMP EXEC1 ;User program buffer then go back to start of EXEC. MOVEC: LBM ;Fetch length of string in line input buffer INB ;Increment that value to provide for (cc) MOVEPG: LAM ;Fetch character from line input buffer CAL ADV ;Advance pointer for line input buffer CAL SWITCH ;Switch memory pointer to point to user pgm buffer LMA ;Deposit character fm input buff into user pgm buff CAL ADV ;Advance pointer for user program buffer CAL SWITCH ;Switch memory pntr back to point to input buffer DCB ;Decrement character counter stored in CPU register B JFZ MOVEPG ;If counter does not go to zero continue transfer ops RET ;When counter equals zero return to calling routine CONTIN: LLI 360 ;Reset memory pointer to program buffer LHI \HB\OLDPG26 ;** Line pointer storage location LDM ;Load high order byte into CPU register D INL ;Advance memory pointer LEM ;Load low order byte into CPU register E LHD ;Now set CPU register H to high part of address LLE ;And set CPU register L to low part of address LBM ;Fetch the character counter (cc) byte fm line in INB ;Program buffer and add one to compensate for (cc) CAL ADBDE ;Add length of line value to old value to get new pointer LLI 360 ;Reset memory pointer to program buffer LHI \HB\OLDPG26 ;** Line pointer storage location LMD ;Restore new high portion INL ;Advance memory pointer LME ;And restore new low portion JMP GETAUX ;Continue til find point at which to enter new line GETCHP: LHI \HB\OLDPG26 ;** Load H with pointer page (low portion set upon LBM ;Entry). Now fetch pointer into CPU register B. LLI 360 ;Reset pntr to pgm buffer line pointer storage location LDM ;Load high order byte into CPU register D INL ;Advance memory pointer LEM ;Load low order byte into CPU register E CAL ADBDE ;Add pointer to pgm buffer pointer to obtain address of LHD ;Desired character. Place high part of new addr in H. LLE ;And low part of new address in E. LAM ;Fetch character from position in line in user pgm buffer CPI 240 ;See if it is the ASCII code for space RET ;Return to caller with flags set to indicate result REMOVE: CAL INDEXB ;Add (cc) plus one to addr of start of line LCM ;Obtain byte from indexed location and CAL SUBHL ;Subtract character count to obtain old location LMC ;Put new byte in old location LAC ;As well as in the Accumulator NDA ;Test to see if zero byte to indicate end of user pgm buff JTZ REMOV1 ;If it is end of user pgm buffer, go complete process CAL ADV ;Otherwise add one to the present pointer value JMP REMOVE ;And continue removing chamcters from the user pgm bf REMOV1: LLI 364 ;Load L with end of user pgm buffer pointer storage loc LHI \HB\OLDPG26 ;** Load H with page of that pointer storage location LDM ;Get page portion of end of pgm buffer address INL ;Advance memory pointer LAM ;And get low portion of end of pgm buffer address into SUB ;Accumulator then subtract displacement value in B LMA ;Restore new low portion of end of pgm buffer address RFC ;If subtract did not cause carry can return now DCL ;Otherwise decrement memory pointer back to page DCD ;Storage location, decrement page value to give new page LMD ;And store new page value back in buffer pntr storage loc RET ;Then return to calling routine INSERT: LLI 364 ;Load L with end of user pgm buffer pointer storage loc LHI \HB\OLDPG26 ;** Load H with page of that pointer storage location LAM ; Get page portion of end of program buffer address INL ;Advance memory pointer LLM ;Load low portion of end of program buffer address LHA ;Into L and finish setting up memory pointer CAL INDEXB ;Add (cc) of line in input buffer to form new end of LAH ;Program buffer address. Fetch new end of buffer page CPI ENDPGRAM ;tt Address and see if this value would exceed user's JFS BIGERR ;System capabilit'y. Go display error message if so! CAL SUBHL ;Else restore original value of end of buffer address INSER1: LCM ;Bring byte pointed to by H & L into CPU register C CAL INDEXB ;Add displacement value to current memory pointer LMC ;Store the byte in the new location CAL SUBHL ;Now subtract displacement value from H & L CAL CPHLDE ;Compare this with the address stored in D & E JTZ INSER3 ;If same then go finish up Insert operation CAL DEC ;Else set pointer to the byte before the byte just JMP INSER1 ;Processed and continue the Insert operation INSER3: INCLIN: LLI 000 ;Load L with start of line input buffer LHI \HB\OLDPG26 ;** Load H with page of start of line input buffer LBM ;Fetch length of the line in line input buffer INB ;Increment value by one to include (cc) byte LLI 364 ;Set memory pointer to end of user pgrn buffer pointer LDM ;Storage location on same page and fetch page address INL ;Of this pointer into D. Then advance memory pointer LEM ;And get low part of this pointer into CPU register E. CAL ADBDE ;Now add displacement (cc) of line in input buffer to LME ;The end of program buffer pointer. Replace the updated DCL ;Low portion of the new pointer value back in stomge LMD ;And restore the new page value back into storage RET ;Then return to calling routine CPHLDE: LAH ;Subroutine to compare if the contents of CPU registers CPD ;H & L are equal to registers D & E. First compare RFZ ;Register H to D. Return with flags set if not equal. If LAL ;Equal continue by comparing register L to E. CPE ;IF L equals E then H & L equal to D & E so return to RET ;Calling routines with flags set to equality status ADBDE: LAE ;Subroutine to add the contents of CPU register B (single ADB ;Byte value) to the double byte value in registers D & E. LEA ;First add B to E to form new least significant byte RFC ;Restore new value to E and exit if no carry resulted IND ;If had a carry then must increment most significant byte RET ;In register D before returning to calling routine CTRLC: LAI 336 ;Set up ASCII code for t (up arrow) in Accumulator. LCI 303 ;Set up ASCII code for letter 'C' in CPU register C. JMP ERROR ;Go display the 'Control C' condition message. FINERR: LLI 340 ;Load L with starting address of line number storage area LHI \HB\OLDPG26 ;** Load H with page of line number storage area LAM ;Get (cc) for line number string. If length is zero meaning NDA ;There is no line number stored in the buffer then jump JTZ FINER1 ;Ahead to avoid displaying "AT LINE" message LLI 366 ;Else load L with address of start of "AT LINE" message LHI \HB\OLDPG1 ;** Stored on this page CAL TEXTC ;Call subroutine to display the "AT LINE" message LLI 340 ;Now reset L to starting address of line number storage LHI \HB\OLDPG26 ;** Area and do same for CPU register H CAL TEXTC ;Call subroutine to display the line number FINER1: CAL CRLF ;Call subroutine to provide a carriage-return and line-feed JMP PATCH3 ;;; The following is the old code, before patch 3 ;;; JMP EXEC ;To the display device then return to EXECUTIVE. DVERR: LAI 304 ;Set up ASCII code for letter 'D' in Accumulator LCI 332 ;Set up ASCII code for letter 'Z' in CPU register C JMP ERROR ;Go display the 'DZ' (divide by zero) error message FIXERR: LAI 306 ;Set up ASCII code for letter 'F' in Accumulator LCI 330 ;Set up ASCII code for letter 'X' in CPU register C JMP ERROR ;Go display the 'FX' (FiX) error message NUMERR: LAI 311 ;Set up ASCII code for letter 'I' in Accumulator LCI 316 ;Set up ASCII code for letter 'N' in CPU register C LLI 220 ;Load L with address of pointer used by DINPUT LHI \HB\OLDPG1 ;** Routine. Do same for register H. LMI 000 ;Clear the location JMP ERROR ;Go display the'IN'(Illegal Number) error message ;The following subroutine, used by various sections of ;SCELBAL, will search the LINE INPUT BUGGER for ;a character string which is contained in a buffer starting ;at the address pointed to by CPU registers H & L when ;the subroutine is entered. INSTR: LDI \HB\OLDPG26 ;**Set D to starting page of LINE INPUT BUFFER LEI 000 ;Load E with starting location of LINE INPUT BUFFER INSTR1: CAL ADVDE ;Advancer D & E pointer to the next location (input CAL SAVEHL ;Buffer). Now save contents of d, E, H & L vefore the LBM ;Compare operations. Get length of TEST buffer in B. CAL ADV ;Advance H & L buffer to first char in TEST buffer. CAL STRCPC ;Compare contents of TEST buffer against input buffer JTZ RESTHL ;For length B. If match, restore pntrs and exit to caller. CAL RESTHL ;If no match, restore pointers for loop test. LLI 000 ;Load L with start of input buffer (to get the char cntr). LHI \HB\OLDPG26 ;**Load H with page of input buffer. LAM ;Get length of buffer (cc) into the accumulator. CPE ;Compare with current input buffer pointer value. JTZ INSTR2 ;If at end of buffer, jump ahead. CAL RESTHL ;Else restore test string address (H&L) and input buffer JMP INSTR1 ;Address (D&E). Look gor occurrence of test string in ln. HLT ;Safety halt. If program reaches here have system failure. INSTR2: LEI 000 ;If reach end of input buffer without finding a match RET ;Load E with 000 as an indicator and return to caller. ADVDE: INE ;Subroutine to advance the pointer in the register RFZ ;Pair D & E. Advance contents of E. Return if not zero. IND ;If register E goes to 0 when advanced, then advance RET ;Register D too. Exit to calling routine. ;;; The label RUN should start at 13-170 RUN: LLI 073 ;Load L with addr of GOSUB/RETURN stack pointer LHI \HB\OLDPG27 ;** Load H with page of same pointer LMI 000 ;Initialize the GOSUB/RETURN stack pointer to zero LLI 205 ;Load L with addr of FOR/NEXT stack pointer LMI 000 ;Initialize the FOR/NEXT stack pointer to zero LLI 360 ;Load L with addr of user pgm buffer line pointer LHI \HB\OLDPG26 ;** Load H with page of user pgm buffer line pointer LMI BGNPGRAM ;tt Initialize pointer (may be altered by user) ******* INL ;Advance memory pointer to low portion of user pgm LMI 000 ;Buffer pointer and initialize to start of buffer JMP SAMLIN ;Start executing user program with first line in buffer NXTLIN: LLI 360 ;Load L with addr of user program buffer line pointer LHI \HB\OLDPG26 ;** Load H with page of user pgm buffer line pointer LDM ;Place page addr of pgm buffer line pointer in D INL ;Advance the memory pointer LEM ;Place low addr of pgm buffer line pointer in E LHD ;Also put page addr of pgm buffer line pointer in H LLE ;And low addr of pgm buffer line pointer in L LBM ;Now fetch the (cc) of current line into register B INB ;Add one to account for (cc) byte itself CAL ADBDE ;Add value in B to D&E to point to next line in LLI 360 ;User program buffer. Reset L to addr of user logrn LHI \HB\OLDPG26 ;** Buffer pointer storage location. Store the new LMD ;Updated user pgm line pointer in pointer storage INL ;Location. Store both the high portion LME ;And low portion. (Now points to next line to be LLI 340 ;Processed from user program buffer.) Change pointer LHI \HB\OLDPG26 ;** To address of line number buffer. Fetch the last LAM ;Line number (length) processed. Test to see if it was NDA ;Blank. If it was blank JTZ EXEC ;Then stop processing and return to the Executive LAA ;Insert two effective NOPs here LAA ;In case of patching SAMLIN: LLI 360 ;Load L with addr of user program buffer line pointer LHI \HB\OLDPG26 ;** Load H with page of same pointer LCM ;Fetch the high portion of the pointer into register C INL ;Advance the memory pointer LLM ;Fetch the low portion of the pointer into register L LHC ;Now move the high portion into register H LDI \HB\OLDPG26 ;** Set D to page of line input buffer LEI 000 ;Set E to address of start of line input buffer CAL MOVEC ;Move the line ftom the user program buffer into the LLI 000 ;Line input buffer. Now reset the pointer to the start LHI \HB\OLDPG26 ;** Of the line input buffer. LAM ;Fetch the first byte of the line input buffer (cc) NDA ;Test (cc) value to see if fetched a blank line JTZ EXEC ;If fetched a blank line, return to the Executive CAL SYNTAX ;Else call subrtn to strip off line nr & set statement toke DIRECT: LLI 203 ;Load L with address of syntax TOKEN storage location LHI \HB\OLDPG26 ;** Load H with page of syntax TOKEN location LAM ;Fetch the TOKEN value into the accumulator CPI 001 ;Is it token value for REM statement? If so, ignore the JTZ NXTLIN ;Current line and go on to the next line in pgm buffer. CPI 002 ;Is it token value for IF statement? JTZ IF ;If yes, then go to the IF statement routine. CPI 003 ;Is it token value for LET statement? (Using keyword) JTZ LET ;If yes, then go to the LET statement routine. CPI 004 ;Is it token value for GOTO statement? JTZ GOTO ;If yes, then go to the GOTO statement routine. CPI 005 ;Is it token value for PRINT statement? JTZ PRINT ;If yes, then go to the PRINT statement routine. CPI 006 ;Is it token value for INPUT statement? JTZ INPUT ;If yes, then go to the INPUT statement routine. CPI 007 ;Is it token value for FOR statement? JTZ FOR ;If yes, then go to the FOR statement routine. CPI 010 ;Is it token value for NEXT statement? JTZ NEXT ;If yes, then go to the NEXT statement routine. CPI 011 ;Is it token value for GOSUB statement? JTZ GOSUB ;If yes, then go to the GOSUB statement routine. CPI 012 ;Is it token value for RETURN statement? JTZ RETURN ;If yes, then go to the RETURN statement routine. CPI 013 ;Is it token value for DIM statement? JTZ DIM ;If yes, then go to the DIM statement routine. CPI 014 ;Is it token value for END statement? JTZ EXEC ;If yes, then go back to the Executive, user pgm finished! CPI 015 ;Is it token value for IMPLIED LET statement? JTZ LET0 ;If yes, then go to special LET entry point. CPI 016 ;@@ Is it token value for ARRAY IMPLIED LET? JFZ SYNERR ;If not, then assume a syntax error condition. CAL ARRAY1 ;@@ Else, perform array storage set up subroutine. LLI 206 ;@@ Set L to array pointer storage location. LHI \HB\OLDPG26 ;@@ * * Set H to array pointer storage location. LBM ;@@ Fetch array pointer to register B. LLI 202 ;@@ Change memory pointer to syntax pntr storage loc. LMB ;@@ Save array pointer value there. CAL SAVESY ;@@ Save array name in auxiliary symbol buffer JMP LET1 PRINT: LLI 202 ;Load L with address of SCAN pointer storage location LHI \HB\OLDPG26 ;** Load H with page of SCAN pointer LAM ;Fetch the pointer value (last character scanned by the LLI 000 ;SYNTAX routine). Change pointer to line buffer (cc). CPM ;Compare pointer value to buffer length. If not equal JTS PRINT1 ;Then line contains more than stand alone PRINT state- CAL CRLF ;Ment. However, if just have PRINT statement then issue JMP NXTLIN ;A carriage-return & line-feed combination, then exit. PRINT1: CAL CLESYM ;Initialize the SYMBOL buffer for new entry. LLI 202 ;Load L with address of SCAN buffer pointer LHI \HB\OLDPG26 ;** Load H with page of SCAN pointer LBM ;Pointer points to last char scanned by SYNTAX. Need INB ;To increment it to point to next char in statement line. LLI 203 ;Load L with address of former TOKEN value. Use it as LMB ;Storage location for a PRINT statement pointer. PRINT2: LLI 203 ;Set memory pointer to PRINT pointer storage location CAL GETCHR ;Fetch character in input buffer pointed to by PRINT CPI 247 ;Pointer. See if it is ASCII code for single quote mark. JTZ QUOTE ;If so, go to QUOTE section to process text string. CPI 242 ;If not, see if it is ASCII code for double quote mark. JTZ QUOTE ;If so, go to QUOTE section to process text string. CPI 254 ;If not, see if it is ASCII code for comma sign. JTZ PRINT3 ;If so, go evaluate expression. CPI 273 ;If not, see if it is ASCII code for semi-colon sign. JTZ PRINT3 ;If so, go evaluate expression. LLI 203 ;Load L with address of PRINT pointer storage location. CAL LOOP ;Increment pointer and test for end of line. JFZ PRINT2 ;If not end of line, fetch the next character. PRINT3: LLI 202 ;Load L with address of SCAN pointer storage location LBM ;Fetch value of the pointer (last letter of KEYWORD) INB ;Add one to point to first character of expression LLI 276 ;Load L with addr of EVAL pointer storage location LMB ;Store addr at which EVAL should start scanning LLI 203 ;Load L with address of PRINT pointer LBM ;Which points to field terminator DCB ;Decrement pointer value to last character of expression LLI 277 ;Load L with address of EVAL FINISH pntr storage loc. LMB ;Place address value of last char in PRINT field there LLI 367 ;Load L with address of QUOTE flag LAM ;Fetch the value of the QUOTE flag into the ACC NDA ;Test the QUOTE flag status JTZ PRINT4 ;If field not quoted, proceed to evaluate expression LMI 000 ;If field quoted, then clear the QUOTE flag for next field JMP PRINT6 ;And skip the evaluation procedure PRINT4: CAL EVAL ;Evaluate the current PRINT field LLI 177 ;Then load L,with address of the TAB flag LHI \HB\OLDPG26 ;** Load H with the page of the TAB flag LAM ;Fetch the value of the TAB flag into the accumulator NDA ;Test the TAB flag LLI 110 ;Change L to the FIXED/FLOAT flag location LHI \HB\OLDPG1 ;** Change H to the FIXED/FLOAT flag page LMI 377 ;Set FIXED/FLOAT flag to fixed point PRINT5: CTZ PFPOUT ;If TAB flag not set, display value of expression LLI 177 ;Load L with address of TAB flag LHI \HB\OLDPG26 ;** Load H with page of TAB flag LMI 000 ;Reset TAB flag for next PRINT field PRINT6: LLI 203 ;Load L with address of PRINT pointer stomge location CAL GETCHR ;Fetch the character pointed to by the PRINT pointer CPI 254 ;See if the last character scanned was a comma sign CTZ PCOMMA ;If so, then display spaces to next TA.B location LLI 203 ;Reset L to address of PRINT pointer storage location LHI \HB\OLDPG26 ;** Reset H to page of PRINT pointer stomge location LBM ;Fetch the value of the pointer into register B LLI 202 ;Change L to SCAN pointer storage location LMB ;Place end of last field processed into SCAN pointer LLI 000 ;Change pointer to start of line input buffer LAB ;Place pntr to last char scanned into the accumulator CPM ;Compare this value to the (cc) for the line buffer JTS PRINT1 ;If not end of line, continue to process next field LLI 000 ;If end of line, fetch the last character in the line CAL GETCHR ;And check to see if it CPI 254 ;Was a comma. If it was, go on to the next line in the JTZ NXTLIN ;User program buffer without displaying a CR & LF. CPI 273 ;If not a comma, check to see if it was a semi-colon. JTZ NXTLIN ;If so, do not provide a CR & LF combination. CAL CRLF ;If not comma or semi-colon, provide CR & LF at end JMP NXTLIN ;Of a PRINT statement. Go process next line of pgrm. QUOTE: LLI 367 ;Load L with address of QUOTE flag LMA ;Store type of quote in flag storage location CAL CLESYM ;Initialize the SYMBOL buffer for new entry LLI 203 ;Load L with address of PRINT pointer LBM ;Fetch the PRINT pointer into register B INB ;Add one to advance over quote character LLI 204 ;Load L with address of QUOTE pointer LMB ;Store the beginning of the QUOTE field pointer QUOTE1: LLI 204 ;Load L with address of QUOTE pointer CAL GETCHR ;Fetch the next character in the TEXT field LLI 367 ;Load L with the QUOTE flag (type of quote) CPM ;Compare to see if latest character this quote mark JTZ QUOTE2 ;If so, finish up this quote field CAL ECHO ;If not, display the character as part of TEXT LLI 204 ;Reset L to QUOTE pointer storage location CAL LOOP ;Increment QUOTE pointer and test for end of line JFZ QUOTE1 ;If not end of line, continue processing TEXT field QUOTER: LAI 311 ;If end of line before closing quote mark have an error LCI 321 ;So load ACC with I and register C with Q LLI 367 ;Load L with the address of the QUOTE flag LHI \HB\OLDPG26 ;** Load H with the page of the QUOTE flag LMI 000 ;Clear the QUOTE flag for future use JMP ERROR ;Go display the IQ (Illegal Quote) error message QUOTE2: LLI 204 ;Load L with address of QUOTE pointer LBM ;Fetch the QUOTE pointer into register B LLI 202 ;Load L with address of SCAN pointer storage location LMB ;Store former QUOTE vointer as start of next field LAB ;Place QUOTE pointer into the accumulator LLI 000 ;Change L to point to start of the input line buffer CPM ;Compare QUOTE pointer value with (cc) value JFZ PRINT1 ;If not end of line, process next PRINT field CAL CRLF ;Else display a CR & LF combination at the end of line LLI 367 ;Load L with the address of the TAB flag LHI \HB\OLDPG26 ;** Load H with the page of the TAB flag LMI 000 ;Clear the TAB flag for future use JMP NXTLIN ;Go process next line of the program. ;The following subroutines are utilized by the PRINT ;routine. ;;; The label PFPOUT SHOULD BE AT 14 314 PFPOUT: LLI 126 ;Load L with the address of the FPACC MSW (Floating LHI \HB\OLDPG1 ;** Point ACC). Load H with page of the FPACC MSW. LAM ;Fetch the FPACC MSW into the accumulator. Test to NDA ;See if the FPACC MSW is zero. If so, then simply go and JTZ ZERO ;Display the value "0" INL ;Else advance the pointer to the FPACC Exponent LAM ;Fetch the FPACC Exponent into the accumulator NDA ;See if any exponent value. If not, mantissa is in range JTZ FRAC ;0.5 to 1.0. Treat number as a fraction. JMP FPOUT ;Else perform regular numerical output routine. ZERO: LAI 240 ;Load ASCII code for space into the ACC CAL ECHO ;Display the space LAI 260 ;Load ASCII code for 0 into the ACC JMP ECHO ;Display 0 and exit to calling routine FRAC: LLI 110 ;Load L with address of FIXED/FLOAT flag LMI 000 ;Reset it to indicate floating point mode JMP FPOUT ;Display floating point number and return to caller PCOMMA: LLI 000 ;Load L with address of (cc) in line input buffer LAM ;Fetch the (cc) for the line into the ACC LLI 203 ;Change pointer to PRINT pointer storage location SUM ;Subtract value of PRINT pointer from line (cc) RTS ;If at end of buffer, do not TAB LLI 043 ;If not end, load L with address of COLUMN COUNTER LHI \HB\OLDPG1 ;** Set H to page of COLUMN COUNTER LAM ;Fetch COLUMN COUNTER into the accumulator NDI 360 ;Find the last TAB position (multiple of 16 decimal) ADI 020 ;Add 16 (decimal) to get new TAB position SUM ;Subtract current position from next TAB position LCA ;Store this value in register C as a counter LAI 240 ;Load the ACC with the ASCII code for space PCOM1: CAL ECHO ;Display the space DCC ;Decrement the loop counter JFZ PCOM1 ;Continue displaying spaces until loop counter is zero RET ;Then return to calling routine LET0: CAL SAVESY ;Entry point for IMPLIED LET statement. Save the LLI 202 ;Variable (to left of the equal sign). Set L to the SCAN LHI \HB\OLDPG26 ;** Pointer. Set H to the page of the SCAN pointer. LBM ;Fetch value of SCAN pointer. (Points to = sign in In bf) LLI 203 ;Change pointer to LET pointer (was TOKEN value) LMB ;Place the SCAN pointer value into the LET pointer JMP LET5 ;Continue processing the LET statement line LET: CAL CLESYM ;Initialize the SYMBOL BUFFER for new entry LLI 144 ;Load L with address of start of AUX SYMBOL BUFF LHI \HB\OLDPG26 ;** Load H with page of AUX SYMBOL BUFFER LMI 000 ;Initialize AUX SYMBOL BUFFER LET1: LLI 202 ;Entry point for ARRAY IMPLIED LET statement. LHI \HB\OLDPG26 ;** Set pointer to SCAN pointer storage location LBM ;Fetch the SCAN pointer value (last letter scanned by INB ;SYNTAX subroutine) and add one to next character LLI 203 ;Change L to LET pointer storage location LMB ;Store former SCAN value (updated) in LET pointer LET2: LLI 203 ;Set L to gtorage location of LET pointer CAL GETCHR ;Fetch the character pointed to by the LET pointer JTZ LET4 ;If character is a space, ignore it CPI 275 ;See if character is the equal (=) sign JTZ LET5 ;If so, go process other side of the statement (after CPI 250 ;@@ If not, see if character is a right parenthesis JFZ LET3 ;If not, continue looking for equal sign CAL ARRAY ;@@ If so, have subscript. Call array set up subroutine. LLI 206 ;@@ Load L with address of ARRAY pointer LHI \HB\OLDPG26 ;@@ ** Load H with page of ARRAY pointer LBM ;@@ Fetch value (points to ")" ch