;;; 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 ")" character of subscript) LLI 203 ;@@ Load L with address of LET pointer LMB ;@@ Place ARRAY pointer value as new LET pointer JMP LET4 ;@@ Continue to look for = sign in statement line LET3: LLI 144 ;Reset L to start of AUX SYMBOL BUFFER LHI \HB\OLDPG26 ;** Load H with page of AUX SYMBOL BUFFER CAL CONCT1 ;Concatenate character to the AUX SYMBOL BUFFER LET4: LLI 203 ;Load L with address of LET pointer storage location CAL LOOP ;Add one to pointer and test for end of line input buffer JFZ LET2 ;If not end of line, continue looking for the equal sign LETERR: LAI 314 ;If do not find an equal sign in the LET statement line LCI 305 ;Then have a LE (Let Error). Load the code for L and E JMP ERROR ;Into registers ACC and C and go display the error msg. LET5: LLI 203 ;When find the equal sign, reset L to point to the LET LHI \HB\OLDPG26 ;** Pointer and H to the proper page. Fetch the pointer LBM ;Value into register B and add one to advance pointer INB ;Over the equal sign to first char in the expression. LLI 276 ;Set L to point to the address of the EVAL pointer LMB ;Set EVAL pointer to start evaluating right after the LLI 000 ;Equal sign. Now change L to start of line input buffer. LBM ;Fetch the (cc) value into register B. (Length of line.) LLI 277 ;Load L with EVAL FINISH pointer storage location. LMB ;Set it to stop evaluating at end of the line. CAL EVAL ;Call the subroutine to evaluate the expression. CAL RESTSY ;Restore the name of the variable to receive new value. CAL STOSYM ;Store the new value for the variable in variables table. JMP NXTLIN ;Go process next line of the program. GOTO: LLI 350 ;Load L with start of AUX LINE NR BUFFER LHI \HB\OLDPG26 ;** Load H with page of AUX LINE NR BUFFER LMI 000 ;Initialize the AUX LINE NR BUFFER to zero LLI 202 ;Load L with address of SCAN pointer storage location LBM ;Fetch pointer value (last char scanned by SYNTAX) INB ;Add one to skip over the last 0 in GOTO keyword LLI 203 ;Change pointer to GOTO pointer (formerly TOKEN) LMB ;Store the updated SCAN pointer as the GOTO pointer GOTO1: LLI 203 ;Load L with address of GOTO pointer CAL GETCHR ;Fetch the character pointed to by the GOTO pointer JTZ GOTO2 ;If character was a space, ignore it CPI 260 ;See if character is in the range of a decimal digit JTS GOTO3 ;If not, must have end of the line number digit string CPI 272 ;Continue to test for decitnal digit JFS GOTO3 ;If not, mugt have end of the line number digit string LLI 350 ;If valid decimal digit, load L with addr of AUX LINE CAL CONCT1 ;NR BUFFER and concatenate digit to the buffer. GOTO2: LLI 203 ;Reset pointer to GOTO pointer storage location CAL LOOP ;Advance the pointer value and test for end of line JFZ GOTO1 ;If not end of line, fetch next digit in GOTO line number GOTO3: LLI 360 ;Set L to user program buffer pointer storage location LHI \HB\OLDPG26 ;** Set H to page of program buffer pointer LMI BGNPGRAM ;Initialize high part of pointer to start of pgm buffer INL ;Advance the memory point LMI 000 ;Initialize the low part of pointer to start of pgm buffer GOTO4: CAL CLESYM ;Clear the SYMBOL BUFFER LLI 204 ;Load L with address of GOTO SEARCH pointer LMI 001 ;Initialize to one for first char of line GOTO5: LLI 204 ;Load L with address of GOTO SEARCH pointer CAL GETCHP ;Fetch character pointed to by GOTO SEARCH pointer JTZ GOTO6 ;From line pointed to in user program buffer. Ignore CPI 260 ;Spaces. Check to see if character is a decirnal digit. JTS GOTO7 ;If not, then have processed line number at the start of CPI 272 ;The current line. Continue the check for a valid decimal JFS GOTO7 ;Digit. If have a decirnal digit then concatenate the digit CAL CONCTS ;Onto the current string in the SYMBOL BUFFER, GOTO6: LLI 204 ;Change L to the address of the GOTO SEARCH pointer LHI \HB\OLDPG26 ;** And H to the proper page of the pointer LBM ;Fetch the GOTO SEARCH pointer value INB ;Increment the GOTO SEARCH pointer LMB ;And restore it back to memory LLI 360 ;Change L to address of user program buffer pointer LCM ;Save the high part of this pointer value in register C INL ;Advance L to the low part of the pgrn buffer pointer LLM ;Now load it into L LHC ;And transfer C into H to point to start of the line LAM ;Fetch the (cc) of the current line being pointed to in the DCB ;User pgm buff. Decrernent B to previous value. Compare CPB ;GOTO SEARCH pointer value to length of current line. JFZ GOTO5 ;If not end of line then continue getting current line nr. GOTO7: LLI 120 ;Load L with address of start of the SYMBOL BUFFER LHI \HB\OLDPG26 ;Set H to the page of the SYMBOL BUFFER LDI \HB\OLDPG26 ;Set D to the page of the AUX LINE NR BUFFER LEI 350 ;Set E to the start of the AUX LINE NR BUFFER CAL STRCP ;Compare GOTO line number against current line nr. JTZ SAMLIN ;If they match, found GOTO line. Pick up ops there! LLI 360 ;Else, set L to user program buffer pntr storage location LHI \HB\OLDPG26 ;** Set H to page of user program buffer pointer LDM ;Fetch the high part of this pointer into register D INL ;Advance the memory pointer LEM ;Fetch the low part into register E LHD ;Transfer the pointer to H LLE ;And L. Fetch the (cc) of the current line into register LBM ;B and then add one to account for the (cc) byte to get INB ;Total length of the current line in the user pgm buffer CAL ADBDE ;Add the total length to the pointer value in D & E LLI 360 ;To get the starting address of the next line in the user LHI \HB\OLDPG26 ;** User program buffer. Place the new value for the user LMD ;Program buffer pointer back into the user program INL ;Buffer pointer storage locations so that it points to the LME ;Next line to be processed in the user program buffer. LLI 364 ;Load L with address of end of user pgm buffer storage LAD ;Location (page address) and fetch end of buffer page. CPM ;Compare this with next line pointer (updated). JFZ GOTO4 ;If not end of buffer, keep looking for the specified line INL ;If have same page addresses, check the low address LAE ;Portions to see if CPM ;Have reached end of user program buffer JFZ GOTO4 ;If not, continue looking. If end of buffer without GOTOER: LAI 325 ;Finding specified line, then have an error condition. LCI 316 ;Load ACC and register C with code for "UN" and go JMP ERROR ;Display "Undefined Line" error message. IF: LLI 202 ;Set L to SCAN pointer storage location. LHI \HB\OLDPG26 ;** Load H to page of SCAN pointer storage location. LBM ;Fetch the SCAN pointer value to register B. INB ;Add one to advance pointer over last char scanned. LLI 276 ;Change L to address of EVAL pointer. Set up EVAL LMB ;Pointer to begin evaluation with next char in the line. CAL CLESYM ;Clear the SYMBOL BUFFER. LLI 320 ;Set L to starting address of THEN in look-up table. LHI \HB\OLDPG1 ;** Set H to page of the look-up table. CAL INSTR ;Search for occurrence of THEN in the line input buffer. LAE ;Transfer register E to ACC. If THEN not found NDA ;The value in E will be zero. JFZ IF1 ;If THEN found, can evaluate the IF expression. LLI 013 ;If THEN not found, set L to Auting address of GOTO LHI \HB\OLDPG27 ;** In the KEYWORD look-up table. Set H to table CAL INSTR ;Search for occurrence of GOTO in the line input buffer. LAE ;Transfer E to ACC. If GOTO not found NDA ;The value in E will be zero. JFZ IF1 ;If GOTO found, can evaluate the IF expression. IFERR: LAI 311 ;Set ASCII code for letter I in ACC LCI 306 ;And code for letter F in register C JMP ERROR ;Go display the IF error message IF1: LLI 277 ;Load L with addr of EVAL FINISH pointer storage loc LHI \HB\OLDPG26 ;** Load H with page of storage location DCE ;Subtract one from pointer in E and set the EVAL LME ;FINISH pointer so that it will evaluate up to the THEN CAL EVAL ;Or GOTO directive. Evaluate the expression. LLI 126 ;Load L with address of FPACC Most Significant Word LHI \HB\OLDPG1 ;** Load H with page of FPACC MSW LAM ;Fetch the FPACC MSW into the accumulator NDA ;Test the value of the FPACC MSW JTZ NXTLIN ;If it is zero, IF condition failed, ignore rest of line. LLI 277 ;If not, load L with addr of EVAL FINISH pointer LHI \HB\OLDPG26 ;** Set H to the appmpriate page LAM ;Fetch the value in the EVAL FINISH pointer ADI 005 ;Add five to skip over THEN or GOTO directive LLI 202 ;Change L to SCAN pointer stomge location LMA ;Set up the SCAN pointer to location after THEN or LBA ;GOTO directive. Also put this value in register B. INB ;Add one to the value in B to point to next character LLI 204 ;After THEN or GOTO. Change L to addr of THEN pntr LMB ;Storage location and store the pointer value. IF2: LLI 204 ;Load L with the address of the THEN pointer CAL GETCHR ;Fetch the character pointed to by the THEN pointer JFZ IF3 ;If character is not a space, exit this loop LLI 204 ;If fetch a space, ignore. Reset L to the THEN pointer CAL LOOP ;Add one to the THEN pointer and test for end of line JFZ IF2 ;If not end of line, keep looking for a character other JMP IFERR ;Than a space. If reach end of line first, then error IF3: CPI 260 ;When find a character see if it is numeric. JTS IF4 ;If not numeric, then should have a new type of CPI 272 ;Statement. If numeric, then should have a line number. JTS GOTO ;So process as though have a GOTO statement! IF4: LLI 000 ;Load L with addr of start of line input buffer. LAM ;Fetch the (cc) byte to get length of line value. LLI 204 ;Change L to current value of THEN pointer (where first SUM ;Non-space char. found after THEN or GOTO). Subtract LBA ;This value from length of line to get remainder. Now INB ;Have length of second statement portion. Add one for LCM ;(cc) count. Save THEN pointer value in register C. LLI 000 ;Reset L to start of line input buffer. Now put length of LMB ;Second statement into (cc) position of input buffer. LLC ;Set L to where second statement starts. LDI \HB\OLDPG26 ;** Set D to page of line input buffer. LEI 001 ;Set E to first character position of line input buffer. CAL MOVEIT ;Move the second statement up in line to become first! LLI 202 ;Load L with address of new SCAN pointer. Load LMI 001 ;It with starting position for SYNTAX scan. CAL SYNTX4 ;Use special entry to SYNTAX to get new TOKEN value. JMP DIRECT ;Process the second statement in the original line. GOSUB: LLI 340 ;Load L with start of LINE NUMBER BUFFER LHI \HB\OLDPG26 ;Fetch (cc) of cuffent line number into register D LDM ;Fetch high value (page) of pgm line pointer to D IND ;Test contents of register by first incrementing DCD ;And then decrementing the value in the register JTZ GOSUB1 ;If no line number, then processing a DIRECT statement LLI 360 ;Else, load L with address of user pgm buff line pointer LDM ;Fetch high value (page) of pgm line pointer to D INL ;Advance the memory pointer LEM ;Fetch the low part of pgm line pointer to E GOSUB1: LLI 073 ;Set L to address of GOSUB STACK POINTER LHI \HB\OLDPG27 ;** Set H to page of GOSUB STACK POINTER LAM ;Fetch value in GOSUB stack pointer to ACC ADI 002 ;Add two to current stack pointer for new data to be CPI 021 ;Placed on the stack and see if stack overflows JFS GOSERR ;If stack filled, have an error condition LMA ;Else, store updated stack pointer LLI 076 ;Load L with address of start of stack less offset (2) ADL ;Add GOSUB stack pointer to base address LLA ;To get pointer to top of stack (page byte) LMD ;Store page part of pgm buffer line pointer in stack INL ;Advance pointer to next byte in stack LME ;Store low part of pgm buffer line pointer in stack JMP GOTO ;Proceed from here as though processing a GOTO RETURN: LLI 073 ;Set L to address of GOSUB STACK POINTER LHI \HB\OLDPG27 ;** Set H to page of GOSUB STACK POINTER LAM ;Fetch the value of GOSUB stack pointer to ACC SUI 002 ;Subtract two for data to be removed from stack JTS RETERR ;If stack underflow, then have an error condition LMA ;Restore new stack pointer to memory ADI 002 ;Add two to point to previous top of stack LLI 076 ;Load L with address of start of GOSUB stack less two ADL ;Add address of previous top of stack to base value LLA ;Set pointer to high address value in the stack LDM ;Fetch the high address value from stack to register D IND ;Exercise the register contents to see if high address DCD ;Obtained is zero. If so, original GOSUB statement was JTZ EXEC ;A DIRECT statement. Must return to Executive! INL ;Else, advance pointer to get low address value from the LEM ;Stack into CPU register E. LLI 360 ;Load L with address of user pgm line pointer storage LHI \HB\OLDPG26 ;** Location. Load H with page of user pgm line pntr. LMD ;Put high address from stack into pgm line pointer. INL ;Advance the memory pointer LME ;Put low address from stack into pgrn line pointer. JMP NXTLIN ;Execute the next line after originating GOSUB line! GOSERR: LAI 307 ;Load ASCII code for letter G into accumulator LCI 323 ;Load ASCII code for letter S into register C JMP ERROR ;Go display GoSub (GS) error message. RETERR: LAI 322 ;Load ASCII code for letter R into accumulator LCI 324 ;Load ASCII code for letter T into register C JMP ERROR ;Go display ReTurn (RT) error message. INPUT: CAL CLESYM ;Clear the SYMBOL BUFFER LLI 202 ;Load L with address of SCAN pointer storage location LBM ;Fetch value of SCAN pointer to register B INB ;Increment value to point to next chamcter LLI 203 ;Change L to point to INPUT pointer (formerly TOKEN) LMB ;Updated SCAN pointer becomes INPUT pointer INPUT1: LLI 203 ;Load L with address of INPUT pointer CAL GETCHR ;Fetch a character from the line input buffer JTZ INPUT3 ;If character is a space, ignore it. Else, CPI 254 ;See if character is a comma. If so, process the JTZ INPUT4 ;Variable that preceeds the comma. CPI 250 ;If not, see if character is a left parenthesis. JFZ INPUT2 ;If not, continue processing to build up symbolic variable CAL ARRAY2 ;@@ If so, call array subscripting subroutine LLI 206 ;@@ Load L with address of array set up pointer LHI \HB\OLDPG26 ;@@ ** Load H with page of array set up pointer LBM ;@@ Fetch pointer value (point to ")" of subscript) LLI 203 ;@@ Change pointer to address of INPUT pointer LMB ;@@ Update INPUT pointer JMP INPUT3 ;@@ Jump over concatenate instruction below INPUT2: CAL CONCTS ;Concatenate character to SYMBOL BUFFER INPUT3: LLI 203 ;Load L with address of INPUT pointer CAL LOOP ;Increment INPUT pointer and test for end of line JFZ INPUT1 ;If not end of line, go get next character CAL INPUTX ;If end of buffer, get input for variable in the SYMBOL CAL STOSYM ;BUFFER and store the value in the VARIABLES table JMP NXTLIN ;Then continue to interpret next statement line INPUT4: CAL INPUTX ;Get input from user for variable in SYMBOL BUFFER CAL STOSYM ;Store the inputted value in the VARIABLES table LHI \HB\OLDPG26 ;** Set H to page of INPUT pointer LLI 203 ;Set L to location of INPUT pointer LBM ;Fetch pointer value for last character examined LLI 202 ;Change L to point to SCAN pointer storage location LMB ;Update the SCAN pointer JMP INPUT ;Continue processing statement line for next variable INPUTX: LLI 120 ;Load L with start of SYMBOL BUFFER (contains cc) LAM ;Fetch the (cc) (length of symbol in the buffer) to ACC ADL ;Add (cc) to base address to set up LLA ;Pointer to last character in the SYMBOL BUFFER LAM ;Fetch the last character in the SYMBOL BUFFER CPI 244 ;See if the last chamcter was a $ sign JFZ INPUTN ;If not a $ sign, get variable value as a numerical entry LLI 120 ;If $ sign, reset L to start of the SYMBOL BUFFER LBM ;Fetch the (cc) for the variable in the SYMBOL BUFF DCB ;Subtract one from (cc) to chop off the $ sign LMB ;Restore the new (cc) for the SYMBOL BUFFER CAL FP0 ;Call subroutine to zero the floating point accumulator CAL CINPUT ;Input one character from system input device LLI 124 ;Load L with address of the LSW of the FPACC LMA ;Place the ASCII code for the character inputted there JMP FPFLT ;Convert value to floating point format in FPACC INPUTN: LLI 144 ;Load L with address of start of AUX SYMBOL BUFF LHI \HB\OLDPG26 ;** Load H with page of AUX SYMBOL BUFFER LAI 277 ;Load accumulator with ASCII code for ? mark CAL ECHO ;Call output subroutine to display the ? mark CAL STRIN ;Input string of characters (number) fm input device JMP DINPUT ;Convert decimal string into binary floating point nr. FP0: LHI \HB\OLDPG1 ;** Load H with floating point working registers page JMP CFALSE ;Zero the floating point accumulator & exit to caller FOR: LLI 144 ;Load L with address of AUX SYMBOL BUFFER LHI \HB\OLDPG26 ;** Load H with page of AUX SYMBOL BUFFER LMI 000 ;Initialize buffer by clearing first byte LLI 146 ;Load L with location of second character in buffer LMI 000 ;Clear that location in case of single character variable LLI 205 ;Load L with address of FOR/NEXT STACK pointer LHI \HB\OLDPG27 ;** Load H with page of FOR/NEXT STACK pointer LBM ;Fetch the FOR/NEXT STACK pointer INB ;Increment it in preparation for pushing operation LMB ;Restore it back to its storage location LLI 360 ;Load L with address of user pgrn buffer line pointer LHI \HB\OLDPG26 ;** Set H to page of line pointer LDM ;Fetch page address of pgm buffer line pntr into D INL ;Advance the memory pointer to pick up low part LEM ;Fetch low address of pgm buffer line pntr into E LAB ;Restore updated FOR/NEXT STACK pointer to ACC RLC ;Rotate it left to multiply by two, then rotate it again to RLC ;Multiply by four. Add this value to the base address of ADI 134 ;The FOR/NEXT STACK to point to the new top of LLA ;The FOR/NEXT STACK and set up to point to stack LHI \HB\OLDPG27 ;** Set H for page of the FOR/NEXT STACK LMD ;Store the page portion of the user pgrn buffer line pntr INL ;In the FORINEXT STACK, advance register 4 then LME ;Store the low portion of the pgrn line pntr on the stack LLI 325 ;Change L to point to start of TO string which is stored LHI \HB\OLDPG1 ;** In a text strings storage area on this page CAL INSTR ;Search the statement line for the occurrence of TO LAE ;Register E wiU be zero if TO not found. Move E to ACC NDA ;To make a test JFZ FOR1 ;If TO found then proceed with FOR statement FORERR: LAI 306 ;Else have a For Error. Load ACC with ASCII code for LCI 305 ;Letter F and register C with code for letter E. JMP ERROR ;Then go display the FE message. FOR1: LLI 202 ;Load L with address of SCAN pointer storage location LHI \HB\OLDPG26 ;** Set H to page of the SCAN pointer LBM ;Fetch pointer value to ACC (points to letter R in the INB ;For directive). Increment it to point to next character LLI 204 ;In the line. Change register L and set this value up LMB ;As an updated FOR pointer. LLI 203 ;Set L to address of TO pointer (formerly TOKEN) LME ;Save pointer to TO in the TO pointer! FOR2: LLI 204 ;Load L with address of the FOR pointer CAL GETCHR ;Fetch a character from the statement line JTZ FOR3 ;If it is a space, ignore it CPI 275 ;Test to see if character is the "=" sign JTZ FOR4 ;If so, variable name is in the AUX SYMBOLBUFFER LLI 144 ;If not, then set L to point to start of the AUX SYMBOL CAL CONCT1 ;BUFFER and concatenate the character onto the buffer FOR3: LLI 204 ;Reset L to address of the FOR pointer CAL LOOP ;Increment the pointer and see if end of line JFZ FOR2 ;If not end of line, continue looking for the "=" sign JMP FORERR ;If reach end of line before "=" sign, then have error FOR4: LLI 204 ;Set L with address of the FOR pointer LBM ;Fetch pointer value to ACC (pointing to sign) INB ;Increment it to skip over the "=" sign LLI 276 ;Set L to address of the EVAL pointer LMB ;Restore the updated pointer to storage LLI 203 ;Set L to the address of the TO pointer LBM ;Fetch pointer value to ACC (pointing to letter T in TO) DCB ;Decrement it to point to character before the T in TO LLI 277 ;Set L to EVAL FINISH pointer storage location LMB ;Store the EVAL FINISH pointer value CAL EVAL ;Evaluate the expression between the "=" sign and TO CAL RESTSY ;Directive. Place the variable name in the variables table. LLI 144 ;Load L with starting address of the AUX SYMBOL BF LHI \HB\OLDPG26 ;** Load H with the page of the AUX SYMBOL BUFF LAM ;Fetch the (cc) for the name in the buffer CPI 001 ;See if the symbol (name) length is just one character JFZ FOR5 ;If not, go directly to place name in FOR/NEXT STACK LLI 146 ;If so, set L to point to second character location in the LMI 000 ;AUX SYMBOL BUFFER and set it equal to zero. JMP FOR5 ;This jump directs program over ontrs/cntrs/table area ;;; LAST LINE SHOULD START AT 17 365 ;;; PATCH AREA FOLLOWS THIS ORG 020#000 FPFIX: LLI 126 ;Set L to point to MSW of FPACC LHI \HB\OLDPG1 ;** Set H to point to page of FPACC LAM ;Fetch MSW of FPACC LLI 100 ;Change pointer to SIGN indicator on same page LMA ;Place MSW of FPACC into SIGN indicator NDA ;Now test sign bit of MSW of FPACC CTS FPCOMP ;Two's complement value in FPACC if negative LLI 127 ;Change pointer to FPACC Exponent register LAI 027 ;Set accumulator to 23 (decimal) for number of bits LBM ;Load FPACC Exponent into CPU register B INB ;Exercise the value in register B DCB ;To set CPU flags JTS FPZERO ;If FPACC Exponent is negative set FPACC to zero SUB ;Subtract value of FPACC Exponent from 23 decimal JTS FIXERR ;If Exp larger than 23 decimal cannot convert LCA ;Else place result in register C as counter for number FPFIXL: LLI 126 ;Of rotate ops. Set pointer to MSW of FPACC LBI 003 ;Set precision counter (number of bytes in mantissa) CAL ROTATR ;Rotate FPACC right the number of places indicated DCC ;By count in register C to effectively rotate all the JFZ FPFIXL ;Significant bits to the left of the floating point decimal JMP RESIGN ;Point. Go check original sign & negate answer if req'd. ;Following subroutine clears the FPACC to the zero ;condition. FPZERO: LLI 126 ;Set L to point to MSW of FPACC XRA ;Clear the accumulator LMA ;Set the MSW of FPACC to zero DCL ;Decrement the pointer LMA ;Set the next significant word of FPACC to zero DCL ;Decrement the pointer LMA ;Set the LSW of FPACC to zero DCL ;Decrement the pointer LMA ;Set the auxiliary FPACC byte to zero RET ;Exit to calling routine ;The next instruction is a special entry point to ;the FPNORM subroutine that is used when a number is ;converted from fixed to floating point. The FPNORM ;label is the entry point when a number already in float- ;ing point fonnat is to be normalized. FPFLT: LBI 027 ;For fixed to float set CPU register B to 23 decimal FPNORM: LAB ;Get CPU register B into ACC to check for special case LHI \HB\OLDPG1 ;** Set H to page of FPACC LLI 127 ;Set L to FPACC Exponent byte NDA ;Set CPU flags to test what was in CPU register B JTZ NOEXC0 ;If B was zero then do standard normalization LMB ;Else set Exponent of FPACC to 23 decimal NOEXC0: DCL ;Change pointer to MSW of FPACC LAM ;Fetch MSW of FPACC into accumulator LLI 100 ;Change pointer to SIGN indicator storage location LMA ;Place the MSW of FPACC there for future reference NDA ;Set CPU flags to test MSW of FPACC JFS ACZERT ;If sign bit not set then jump ahead to do next test LBI 004 ;If sign bit set, number in FPACC is negative. Set up LLI 123 ;For two's complement operation CAL COMPLM ;And negate the value in the FPACC to make it positive ACZERT: LLI 126 ;Reset pointer to MSW of FPACC LBI 004 ;Set precision counter to number of bytes in FPACC LOOK0: LAM ;Plus one. Fetch a byte of the FPACC. NDA ;Set CPU flags JFZ ACNONZ ;If find anything then FPACC is not zero DCL ;Else decrement pointer to NSW of FPACC DCB ;Decrement precision counter JFZ LOOK0 ;Continue checking to see if FPACC contains anything LLI 127 ;Until precision counter is zero. If reach here then XRA ;Reset pointer to FPACC Exponent. Clear the ACC and LMA ;Clear out the FPACC Exponent. Value of FPACC is zip! RET ;Exit to calling routine ACNONZ: LLI 123 ;If FPACC has any value set pointer to LSW minus one LBI 004 ;Set precision counter to number of bytes in FPACC CAL ROTATL ;Plus one for special cases. Rotate the contents of the LAM ;FPACC to the LEFT. Pointer will be set to MSW after NDA ;Rotate ops. Fetch MSW and see if have anything in JTS ACCSET ;Most significant bit position. If so, have rotated enough INL ;If not, advance pointer to FPACC Exponent. Fetch LBM ;The value of the Exponent and decrement it by one DCB ;To compensate for the rotate left of the mantissa LMB ;Restore the new value of the Exponent JMP ACNONZ ;Continue rotating ops to normalize the FPACC ACCSET: LLI 126 ;Set pntr to FPACC MSW. Now must provide room for LBI 003 ;Sign bit in nonnalized FPACC. Set precision counter. CAL ROTATR ;Rotate the FPACC once to the right now. RESIGN: LLI 100 ;Set the pointer to SIGN indicator storage location LAM ;Fetch the original sign of the FPACC NDA ;Set CPU flags RFS ;If original sign of FPACC was positive, can exit now. FPCOMP: LLI 124 ; However, if original sign was negative, must now restore LBI 003 ;The FPACC to negative by performing two's comple- JMP COMPLM ;Ment on FPACC. Return to caring rtn via COMPLM. ;Floating point ADDITION. Adds contents of FPACC to ;FPOP and leaves result in FPACC. Routine first checks ;to see if either register contains zero. If so addition ;result is already present! FPADD: LLI 126 ;Set L to point to MSW of FPACC LHI \HB\OLDPG1 ;** Do same for register H LAM ;Fetch MSW of FPACC to accumulator NDA ;Set CPU flags after loading op JFZ NONZAC ;If accumulator non-zero then FPACC has some value MOVOP: LLI 124 ;But, if accumulator was zero then normalized FPACC LDH ;Must also be zero. Thus answer to addition is simply the LEL ;Value in FPOP. Set up pointers to transfer contents of LLI 134 ;FPOP to FPACC by pointing to the LSW of both LBI 004 ;Registers and perform the transfer. Then exit to calling JMP MOVEIT ;Routine with answer in FPACC via MOVEIT. NONZAC: LLI 136 ;If FPACC was non-zero then check to see if FPOP has LAM ;Some value by obtaining MSW of FPOP NDA ;Set CPU flags after loading op. If MSW zero then RTZ ;Normalized FPOP must be zero. Answer is in FPACC! ;If neither FPACC or FPOP was zero then must perform ;addition operation. Must first check to see if two num- ;bers are within significant mnge. If not, largest number ;is answer. If numbers within range, then must align ex- ;ponents before perforrning the addition of the man- ;tissa. CKEQEX: LLI 127 ;Set pointer to FPACC Exponent storage location. LAM ;Fetch the Exponent value to the accumulator. LLI 137 ;Change the pointer to the FPOP Exponent CPM ;Compare the values of the exponents. If they are the JTZ SHACOP ;Same then can immediately proceed to add operations. LBA ;If not the same, store FPACC Exponent size in regis B LAM ;Fetch the FPOP Exponent size into the ACC SBB ;Subtract the FPACC Exponent from the FPOP Exp. JFS SKPNEG ;If result is positive jump over the next few instructions LBA ;If result was negative, store the result in B XRA ;Clear the accumulator SBB ;Subtract register B to negate the original value SKPNEG: CPI 030 ;See if difference is less than 24 decimal. JTS LINEUP ;If so, can align exponents. Go do it. LAM ;If not, find out which number is largest. Fetch FPOP LLI 127 ;Exponent into ACC. Change pointer to FPACC Exp. SUM ;Subtract FPACC from FPOP. If result is negative then RTS ;was larger. Return with answer in FPACC. LLI 124 ;If result was positive, larger value in FPOP. Set pointers JMP MOVOP ;To transfer FPOP into FPACC and then exit to caller. LINEUP: LAM ;Fetch FPOP Exponent into accumulator. LLI 127 ;Change pointer to FPACC Exponent. SUM ;Subtract FPACC Exponent from FPOP Exponent. If JTS SHIFT0 ;Result is negative FPACC is larger. Go shift FPOP. LCA ;If result positive FPOP larger, must shift FPACC. Store MORACC: LLI 127 ;Difference count in C. Reset pointer to FPACC Exp CAL SHLOOP ;Call the SHift LOOP to rotate FPACC mantissa RIGHT DCC ;And INCREMENT Exponent. Decr difference counter JFZ MORACC ;Continue rotate operations until diff counter is zero JMP SHACOP ;Go do final alignment and perform addition process SHIFT0: LCA ;Routine to shift FPOP. Set difference count into reg. C MOROP: LLI 137 ;Set pointer to FPOP Exponent. CAL SHLOOP ;Call the SHift LOOP to rotate FPOP mantissa RIGHT INC ;And INCREMENT Exponent. Then incr difference cntr JFZ MOROP ;Continue rotate opemtions until diff counter is zero ;;; The below two instructions are changed by PATCH NR.1 ;;;SHACOP: LLI 123 ;Set pointer to FPACC LSW minus one to provide extra ;;; LMI 000 ;Byte for addition ops. Clear that location to zero. SHACOP: CAL PATCH1 ; patch 1 inserts a few lines at 30-000 LAA ;;; LLI 133 ;;; LMI 000 ;THIS IS PATCH #1 LLI 127 ;Change pointer to FPACC Exponent CAL SHLOOP ;Rotate FPACC mantissa RIGHT & Increment Exponent LLI 137 ;Change pointer to FPOP Exponent CAL SHLOOP ;Rotate FPOP mantissa RIGHT & Increment Exponent LDH ;Rotate ops provide room for overflow. Now set up LEI 123 ;Pointers to LSW minus one for both FPACC & FPOP LBI 004 ;(FPOP already set after SHLOOP). Set precision counter CAL ADDER ;Call quad precision ADDITION subroutine. LBI 000 ;Set CPU register B to indicate standard normalization JMP FPNORM ;Go normalize the result and exit to caller. SHLOOP: LBM ;Shifting loop. First fetch Exponent currently being INB ;Pointed to and Increment the value by one. LMB ;Return the updated Exponent value to memory. DCL ;Decrement the pointer to mantissa portion MSW LBI 004 ;Set precision counter FSHIFT: LAM ;Fetch MSW of mantissa NDA ;Set CPU flags after load ops JFS ROTATR ;If MSB not a one can do normal rotate ops BRING1: RAL ;If MSB is a one need to set up carrv bit for the negative JMP ROTR ;Number case. Then make special entry to ROTATR sub ;The following subroutine moves the contents of a string ;of memory locations from the address pointed to by ;CPU registers H & L to the address specified by the con- ;tents of registers D & E when the routine is entered. The ;process continues until the counter in register B is zero. MOVEIT: LAM ;Fetch a word from memory string A INL ;Advance A string pointer CAL SWITCH ;Switch pointer to string B LMA ;Put word from string A into string B INL ;Advance B string pointer CAL SWITCH ;Switch pointer back to string A DCB ;Decrement loop counter RTZ ;Return to calling routine when counter reaches zero JMP MOVEIT ;Else continue transfer operations ;The following subroutine SUBTRACTS the ;contents of the FLOATING POINT ACCUMULATOR from the ;contents of the FLOATING POINT OPERAND and ;leaves the result in the FPACC. The routine merely ;negates the value in the FPACC and then goes to the ;FPADD subroutine just presented. FPSUB: LLI 124 ;Set L to address of LSW of FPACC LHI \HB\OLDPG1 ;** Set H to page of FPACC LBI 003 ;Set precision counter CAL COMPLM ;Two's complement the value in the FPACC JMP FPADD ;Now go add the negated value to perform subtraction! ;The first part of the FLOATING POINT MULTIPLI- ;CATION subroutine calls a subroutine to check the ;original signs of the numbers that are to be multi- ;plied and perform working register clearing functions. ;Next the exponents of the numbers to be multiplied ;are added together. FPMULT: CAL CKSIGN ;Call routine to set up registers & ck signs of numbers ADDEXP: LLI 137 ;Set pointer to FPOP Exponent LAM ;Fetch FPOP Exponent into the accumulator LLI 127 ;Change pointer to FPACC Exponent ADM ;Add FPACC Exponent to FPOP Exponent ADI 001 ;Add one more to total for algorithm compensation LMA ;Store result in FPACC Exponent location SETMCT: LLI 102 ;Change pointer to bit counter storage location LMI 027 ;Initialize bit counter to 23 decimal ;Next portion of the FPMULT routine is the iinplernen- ;tation of the algorithm illustrated in the flow chart ;above. This portion multiplies the values of the two ;mantissas. The final value is rounded off to leave the ;23 most significant bits as the answer that is stored ;back in the FPACC. MULTIP: LLI 126 ;Set pointer to MSW of FPACC mantissa LBI 003 ;Set precision counter CAL ROTATR ;Rotate FPACC (multiplier) RIGHT into carry bit CTC ADOPPP ;If carry is a one, add multiplicand to partial-product LLI 146 ;Set pointer to partial-product most significant byte LBI 006 ;Set precision counter (p-p register is double length) CAL ROTATR ;Shift partial-product RIGHT LLI 102 ;Set pointer to bit counter storage location LCM ;Fetch current value of bit counter DCC ;Decrement the value of the bit counter LMC ;Restore the updated bit counter to its storage location JFZ MULTIP ;If have not multiplied for 23 (deciinal) bits, keep going LLI 146 ;If have done 23 (decimal) bits, set pntr to p-p MSW LBI 006 ;Set precision counter (for double length) CAL ROTATR ;Shift partial-product once more to the RIGHT LLI 143 ;Set pointer to access 24'th bit in partial-product LAM ;Fetch the byte containing the 24'th bit RAL ;Position the 24'th bit to be MSB in the accumulator NDA ;Set the CPU flags after to rotate operation and test to CTS MROUND ;See if 24'th bit of p-p is a ONE. If so, must round-off LLI 123 ;Now set up pointers LEL ;To perform transfer LDH ;Of the multiplication results LLI 143 ;From the partial-product location LBI 004 ;To the FPACC EXMLDV: CAL MOVEIT ;Perform the transfer from p-p to FPACC LBI 000 ;Set up CPU register B to indicate regular normalization CAL FPNORM ;Normalize the result of multiplication LLI 101 ;Now set the pointer to the original SIGNS indicator LAM ;Fetch the indicator NDA ;Exercise the CPU flags RFZ ;If indicator is non-zero, answer is positive, can exit her JMP FPCOMP ;If not, answer must be negated, exit via 2's complement. ;The following portions of the FPMULT ;routine set up working locations in memory by clearing ;locations for an expanded FPOP area and the partial-produc ;area. Next, the signs of the two numbers to be multiplied ;are examined. Negative numbers are negated ;in preparation for the multiplication ;algorithm. A SIGNS indicator register is set up during ;this process to indicate whether the final result of the ;multiplication should be positive or negative. (Negative ;if original signs of the two numbers to be multiplied are ;different.) CKSIGN: LLI 140 ;Set pointer to start of partial-product working area LHI \HB\OLDPG1 ;** Set H to proper page LBI 010 ;Set up a loop counter in CPU register B XRA ;Clear the accumulator CLRNEX: LMA ;Now clear out locations for the partial-product INL ;Working registers DCB ;Until the loop counter JFZ CLRNEX ;Is zero CLROPL: LBI 004 ;Set a loop counter LLI 130 ;Set up pointer CLRNX1: LMA ;Clear out some extra registers so that the INL ;FPOP may be extended in length DCB ;Perform clearing ops until loop counter JFZ CLRNX1 ;Is zero LLI 101 ;Set pointer to M/D SIGNS indicator storage location LMI 001 ;Set initial value of SIGNS indicator to plus one LLI 126 ;Change pointer to MSW of FPACC LAM ;Fetch MSW of mantissa into accumulator NDA ;Test flags JTS NEGFPA ;If MSB in MSW of FPACC is a one, number is negative OPSGNT: LLI 136 ;Set pointer to MSW of FPOP LAM ;Fetch MSW of mantissa into accumulator NDA ;Test flags RFS ;Return to caller if number in FPOP is positive LLI 101 ;Else change pointer to M/D SIGNS indicator LCM ;Fetch the value in the SIGNS indicator DCC ;Decrement the value by one LMC ;Restore the new value back to storage location LLI 134 ;Set pointer to LSW of FPOP LBI 003 ;Set precision counter JMP COMPLM ;Two's complement value of FPOP & return to caller NEGFPA: LLI 101 ;Set pointer to M/D SIGNS indicator LCM ;Fetch the value in the SIGNS indicator DCC ;Decrement the value by one LMC ;Restore the new value back to storage location LLI 124 ;Set pointer to LSW of FPACC LBI 003 ;Set precision counter CAL COMPLM ;Two's complement value of FPACC JMP OPSGNT ;Proceed to check sign of FPOP ;The following subroutine adds the double length (six regis ;multiplicand in FPOP to the partial-product register when ;called on by the multiplication algorithm. ADOPPP: LEI 141 ;Pointer to LSW of partial-product LDH ;On same page as FPOP LLI 131 ;LSIV of FPOP which contains extended multiplicand LBI 006 ;Set precision counter (double length working registers) JMP ADDER ;Add multiplicand to partial-product & return to caller MROUND: LBI 003 ;Set up precision counter LAI 100 ;Prepare to add one to 24'th bit of partial-product ADM ;Add one to the 24'th bit of the partial-product CROUND: LMA ;Restore the updated byte to memory INL ;Advance the memory pointer to next most significant LAI 000 ;Byte of partial-product, then clear ACC without ACM ;Disturbing carry bit. Now perform add with carry to DCB ;Propagate any rounding in the partial-product registers. JFZ CROUND ;If cotinter is not zero continue propagating any carry LMA ;Restore final byte to memory RET ;Exit to calling routine FPDIV: CAL CKSIGN ;Call routine to set up registers & ck signs of numbers LLI 126 ;Set pointer to MSW of FPACC (divisor) LAM ;Fetch MSW of FPACC to accumulator NDA ;Exercise CPU flags JTZ DVERR ;If MSW of FPACC is zero go display 'DZ' error message SUBEXP: LLI 137 ;Set pointer to FPOP (dividend) Exponent LAM ;Get FPOP Exponent into accumulator LLI 127 ;Change pointer to FPACC (divisor) Exponent SUM ;Subtract divisor exponent from dividend exponent ADI 001 ;Add one for algorithm compensation LMA ;Place result in FPACC Exponent SETDCT: LLI 102 ;Set pointer to bit counter storage location LMI 027 ;Initialize bit counter to 23 decimal ;Main division algorithm for mantissas DIVIDE: CAL SETSUB ;Go subtmct divisor from dividend JTS NOGO ;If result is negative then place a zero bit in quotient LEI 134 ;If result zero or positive then move remainder after LLI 131 ;Subtraction from working area to become new dividend LBI 003 ;Set up moving pointers and initialize precision counter CAL MOVEIT ;Perform the transfer LAI 001 ;Place a one into least significant bit of accumulator RAR ;And rotate it out into the carry bit JMP QUOROT ;Proceed to rotate the carry bit into the current quotient NOGO: XRA ;When result is negative, put a zero in the carry bit, then QUOROT: LLI 144 ;Set up pointer to LSW of quotient register LBI 003 ;Set precision counter CAL ROTL ;Rotate carry bit into quotient by using special entry to LLI 134 ;ROTATL subroutine. Now set up pointer to dividend LBI 003 ;LSW and set precision counter CAL ROTATL ;Rotate the current dividend to the left LLI 102 ;Set pointer to bit counter storage location LCM ;Fetch the value of the bit counter DCC ;Decrement the value by one LMC ;Restore the new counter value to storage JFZ DIVIDE ;If bit counter is not zero, continue division process CAL SETSUB ;After 23 (decimal) bits, do subtraction once more for JTS DVEXIT ;Possible rounding. Jump ahead if no rounding required. LLI 144 ;If rounding required set pointer to LSW of quotient LAM ;Fetch LSW of quotient to accumulator ADI 001 ;Add one to 23rd bit of quotient LMA ;Restore updated LSW of quotient LAI 000 ;Clear accumulator without disturbing carry bit INL ;Advance pointer to next significant byte of quotient ACM ;Propagate any carry as part of rounding process LMA ;Restore the updated byte of quotient LAI 000 ;Clear ACC again without disturbing carry bit INL ;Advance pointer to MSW of quotient ACM ;Propagate any carry to finish rounding process LMA ;Restore the updated byte of quotient JFS DVEXIT ;If most significant bit of quotient is zero, go finish up LBI 003 ;If not, set precision counter CAL ROTATR ;And rotate quotient to the right to clear the sign bit LLI 127 ;Set pointer to FPACC Exponent LBM ;Fetch FPACC exponent INB ;Increment the value to compensate for the rotate right LMB ;Restore the updated exponent value DVEXIT: LLI 143 ;Set up pointers LEI 123 ;To transfer the quotient into the FPACC LBI 004 ;Set precision counter ;THIS IS A CORRECTION FOUND IN THE NOTES JMP EXMLDV ;And exit through FPMULT routine at EXMLDV ;Subroutine to subtract divisor from dividend. Used by ;main DIVIDE subroutine. SETSUB: LEI 131 ;Set pointer to LSW of working area LDH ;On same page as FPACC LLI 124 ;Set pointer to LSW of FPACC (divisor) LBI 003 ;Set precision counter CAL MOVEIT ;Perform transfer LEI 131 ;Reset pointer to LSW of working area (now divisor) LLI 134 ;Reset pointer to LSW of FPOP (dividend) LBI 003 ;Set precision counter CAL SUBBER ;Subtract divisor from dividend LAM ;Get MSW of the result of the subtraction operations NDA ;Exercise CPU flags RET ;Return to caller with status ADDER: NDA ;Initialize the carry bit to zero upon entry ADDMOR: LAM ;Fetch byte from register group A CAL SWITCH ;Switch memory pointer to register group B ACM ;Add byte from A to byte from B with carry LMA ;Leave result in register group B DCB ;Decrement number of bytes (precision) counter RTZ ;Return to caller when all bytes in group processed INL ;Else advance pointer for register group B CAL SWITCH ;Switch memory pointer back to register group A INL ;Advance the pointer for register group A JMP ADDMOR ;Continue the multi-byte addition operation ;N'th precision two's complement (negate) ;subroutine. Performs a two's complement on the multi-byte ;registers tarting at the address pointed ; to by H & L (least significant byte) upon entry. COMPLM: LAM ;Fetch the least significant byte of the number to ACC XRI 377 ;Exclusive OR to complement the byte ADI 001 ;Add one to form two's complement of byte MORCOM: LMA ;Restore the negated byte to memory RAR ;Save the carry bit LDA ;In CPU register D DCB ;Decrement number of bytes (precision) counter RTZ ;Return to caller when all bytes in number processed INL ;Else advance the pointer LAM ;Fetch the next byte of the number to ACC XRI 377 ;Exclusive OR to complement the byte LEA ;Save complemented value in register E temporarily LAD ;Restore previous carry status to ACC RAL ;And rotate it out to the carry bit LAI 000 ;Clear ACC without disturbing carry status ACE ;Add in any carry to complemented value JMP MORCOM ;Continue the two's complement procedure as req'd ;N'th precision rotate left subroutine. Rotates a multi- ;byte number left starting at the address initially ;specified by the contents of CPU registers H & L upon ;subroutine entry (LSW). First entry point will clear ;the carry bit before beginning rotate operations. Second ;entry point does not clear the carry bit. ROTATL: NDA ;Clear the carry bit at this entry point ROTL: LAM ;Fetch a byte from memory RAL ;Rotate it left (bring carry into LSB, push MSB to carry) LMA ;Restore rotated word to memory DCB ;Decrement precision counter RTZ ;Exit to caller when finished INL ;Else advance pointer to next byte JMP ROTL ;Continue rotate left operations ;N'th precision rotate ;right subroutine. Opposite of ;above subroutine. ROTATR: NDA ;Clear the carry bit at this entry point ROTR: LAM ;Fetch a byte from memory RAR ;Rotate it right (carry into MSB, LSB to carry) LMA ;Restore rotated word to memory DCB ;Decrement precision counter RTZ ;Exit to caller when finished DCL ;Else decrement pointer to next byte JMP ROTR ;Continue rotate right operations ;N'th precision subtraction subroutine. ;Number starting at location pointed to by D & E (least ;significant byte) is subtracted from number starting at ;address specified by contents of H & L. SUBBER: NDA ;Initialize the carry bit to zero upon entry SUBTRA: LAM ;Fetch byte from register group A CAL SWITCH ;Switch memory pointer to register group B SBM ;Subtract byte from group B ftom that in group A LMA ;Leave result in register group B DCB ;Decrement number of bytes (precision) counter RTZ ;Return to caller when all bytes in group processed INL ;Else advance pointer for register group B CAL SWITCH ;Switch memory pointer back to register group A INL ;Advance the pointer for register group A JMP SUBTRA ;Continue the multi-byte subtraction operation ;The next subroutine will transfer the four byte ;register string (generally a number in floating point ;format) from the starting address pointed to by CPU ;registers H & L when the subroutine is entered to ;the FPACC (floating point accumulator registers). FLOAD: LDI \HB\OLDPG1 ;** Set page address of FPACC LEI 124 ;Set address of least signficant byte of FPACC LBI 004 ;Set precision counter to four bytes (mantissa bytes JMP MOVEIT ;Plus Exponent) and exit via the transfer routine ;The next several subroutines are used to perform ;floating pojnt register loading and transfer operations. FSTORE: LEL ;Transfer contents of register L to E LDH ;Transfer contents of register H to D LLI 124 ;Set L to least significant byte of FPACC mantissa LHI \HB\OLDPG1 ;** Set page to FPACC storage area JMP SETIT ;Go transfer FPACC contents to area pointed to by D&E OPLOAD: LDI \HB\OLDPG1 ;** Set page to FPOP storage area LEI 134 ;Set pointer to least significant byte of FPOP SETIT: LBI 004 ;Set precision counter. Transfer from H & L area to JMP MOVEIT ;Locations pointed to by D & E ;The next subroutine perforins a double transfer opera- ;tion. It first transfers the contents of the FPACC into ;the FPOP. It then transfers new data (as pointed to by ;H & L upon entry to the subroutine) into the FPACC. FACXOP: CAL SAVEHL ;Save contents of H & L upon entry to subroutine LLI 124 ;Set pointer to FPACC LSW LHI \HB\OLDPG1 ;** Set pointer to page of FPACC CAL OPLOAD ;Transfer FPACC to FPOP CAL RESTHL ;Recover original subroutine entry values for H & L JMP FLOAD ;Transfer registers pointed to by H & L into the FPACC ;Subroutine to save the contents of CPU registers D, E, H ;and L in a temporary storage area in memory. SAVEHL: LAH ;Transfer value in H to ACC LBL ;And value in L to B LLI 200 ;Now set L to start of tempomry storage locations LHI \HB\OLDPG1 ;** And set H to storage area page LMA ;Save A (entry value of H) in memory INL ;Advance pointer LMB ;Save B (entry value of L) in memory INL ;Advance pointer LMD ;Save D in memory INL ;Advance pointer LME ;Save E in memory LHA ;Restore entry value of H LLB ;Restore entry value of L RET ;Exit to calling routine ;Subroutine to restore the contents of CPU registers D, ;E, H and L from temporary storage in memory. RESTHL: LLI 200 ;Set L to start of temporary storage locations LHI \HB\OLDPG1 ;** Set H to storage area page LAM ;Fetch stored value for li iii ACC INL ;Advance pointer LBM ;Fetch stored value for L into B INL ;Advance pointer LDM ;Fetch stored value for T.) INL ;Advance pointer LEM ;Fetch stored value for LHA ;Restore saved value for H LLB ;Restore saved value for L LAM ;Leave stored value for E in ACC RET ;Exit to calling routine ;Subroutine to exchange the contents of H & L with ;D & E. SWITCH: LCH ;Transfer register H to C temporarily LHD ;Place value of D into H LDC ;Now put former H from C into D LCL ;Transfer register L to C temporarily LLE ;Place value of E into L LEC ;Now put former L from C into E RET ;Exit to calling routine GETINP: LHI \HB\OLDPG1 ;** Set H to page of GETINP character counter LLI 220 ;Set L to address of GETINP character counter LCM ;Load counter value into CPU register C INC ;Exercise the counter in order DCC ;To set CPU flags. If counter is non-zero, then indexing JFZ NOT0 ;Register (GETINP counter) is all set so jump ahead. LLE ;But, if counter zero, then starting to process a new LHD ;Character string. Transfer char string buffer pointer into LCM ;H & L and fetch the string's character count value (cc) INC ;Increment the (cc) by one to take account of (cc) byte CAL INDEXC ;Add contents of regis C to H & L to point to end of the LMI 000 ;Character string in buffer and place a zero byte marker NOT0: LLI 220 ;Set L back to address of GETINP counter which is used LHI \HB\OLDPG1 ;** As an indexing value. Set H to correct page. LCM ;Fetch the value of GETINP counter into register C INC ;Increment the value in C LMC ;Restore the updated value for future use LLE ;Bring the base address of the character string buffer into LHD ;CPU registers H & L CAL INDEXC ;Add contents of register C to form indexed address of LAM ;Next character to be fetched as input. Fetch the next NDA ;Character. Exercise the CPU flags. LHI \HB\OLDPG1 ;** Restore page pointer to floating point working area RFZ ;If character is non-zero, not end of string, exit to calle LLI 220 ;If zero character, must reset GETINP counter for next LMI 000 ;String. Reset pointer and clear GETINP counter to zero RET ;Then exit to calling routine ;Following subroutine causes register C to be used as an ;indexing register. Value in C is added to address in H ;and L to form new address. INDEXC: LAL ;Place value from register L into accumulator ADC ;Add quantity in register C LLA ;Restore updated value back to L RFC ;Exit to caller if no carry from addition INH ;But, if have carry then must increment register H RET ;Before returning to calling routine ;Main Decimal INPUT subroutine to convert strings of ;ASCII characters representing decimal fixed or floating ;point numbers to binary floating point numbers. DINPUT: LEL ;Save entry value of register L in E. (Pointer to buffer LDH ;Containing ASCII character string.) Do same for H to D. LHI \HB\OLDPG1 ;** Set H to page of floating point working registers LLI 150 ;Set L to start of decirnal-to-binary working area XRA ;Clear the accumulator LBI 010 ;Set up a loop counter CLRNX2: LMA ;Deposit zero in working area to initialize INL ;Advance the memory pointer DCB ;Decrement the loop counter JFZ CLRNX2 ;Clear working area until loop counter is zero LLI 103 ;Set pointer to floating point temporary registers and LBI 004 ;Indicators working area. Set up a loop counter. CLRNX3: LMA ;Deposit zero in working area to initialize INL ;Advance the memory pointer DCB ;Decrement the loop counter JFZ CLRNX3 ;Clear working area until loop counter is zero CAL GETINP ;Fetch a character from the ASCII chax string buffer CPI 253 ;(Typically the SYMBOL/TOKEN buffer). See if it is JTZ NINPUT ;Code for + sign. Jump ahead if code for + sign. CPI 255 ;See if code for minus (-) sign. JFZ NOTPLM ;Jump ahead if not code for minus sign. If code for LLI 103 ;Minus sign, set pointer to MINUS flag storage location. LMA ;Set the MINUS flag to indicate a minus number NINPUT: CAL GETINP ;Fetch another character from the ASCII char string NOTPLM: CPI 256 ;See if character represents a period (decimal point) in JTZ PERIOD ;Input string. Jump ahead if yes. CPI 305 ;If not period, see if code for E as in Exponent JTZ FNDEXP ;Jump ahead if yes. CPI 240 ;Else see if code for space. JTZ NINPUT ;Ignore space character, go fetch another character. NDA ;If none of the above see if zero byte JTZ ENDINP ;Indicating end of input char string. If yes, jumn ahead. CPI 260 ;If not end of string, check to see JTS NUMERR ;If character represents CPI 272 ;A valid decimal number (0 to 9) JFS NUMERR ;Display error message if not a valid digit at this point! LLI 156 ;For valid digit, set pointer to MSW of temporary LCA ;Decimal to binary holding registers. Save character in C. LAI 370 ;Form mask for sizing in accumulator. Now see if NDM ;Holding register has enough room for the conversion of JFZ NINPUT ;Another digit. Ignore the input if no more room. LLI 105 ;If have room in register then set pointer to input digit LBM ;Counter location. Fetch the present value. INB ;Increment it to account for incoming digit. LMB ;Restore updated count to storage location. CAL DECBIN ;Call the DECimal to BINary conversion routine to add JMP NINPUT ;In the new digit in holding registers. Continue inputting. PERIOD: LBA ;Save character code in register B LLI 106 ;Set pointer to PERIOD indicator storage location LAM ;Fetch value in PERIOD indicator NDA ;Exercise CPU flags JFZ NUMERR ;If already have a period then display error message LLI 105 ;If not, change pointer to digit counter storage location LMA ;Clear the digit counter back to zero INL ;Advance pointer to PERIOD indicator LMB ;Set the PERIOD indicator JMP NINPUT ;Continue processing the input character string FNDEXP: CAL GETINP ;Get next character in Exponent CPI 253 ;See if it is code for + sign JTZ EXPINP ;Jump ahead if yes. CPI 255 ;If not + sign, see if minus sign JFZ NOEXPS ;If not minus sign then jump ahead LLI 104 ;For minus sign, set pointer to EXP SIGN indicator LMA ;Set the EXP SIGN indicator for a minus exponent EXPINP: CAL GETINP ;Fetch the next character in the decimal exponent NOEXPS: NDA ;Exercise the CPU flags JTZ ENDINP ;If character inputted was zero, then end of input string CPI 260 ;If not end of string, check to see JTS NUMERR ;If character represents CPI 272 ;A valid decimal number (0 to 9) JFS NUMERR ;Display error message if not a valid digit at this point! NDI 017 ;Else trim the ASCII code to BCD LBA ;And save in register B LLI 157 ;Set pointer to input exponent storage location LAI 003 ;Set accumulator equal to three CPM ;See if any previous digit in exponent greater than three JTS NUMERR ;Display error message if yes LCM ;Else save any previous value in register C LAM ;And also place any previous value in accumulator NDA ;Clear the carry bit with this instruction RAL ;Single precision multiply by ten algorithm RAL ;Two rotate lefts equals times four ADC ;Adding in the digit makes total times five RAL ;Rotating left again equals times ten ADB ;now add in digit just inputted LMA ;Restore the value to exponent storage location JMP EXPINP ;Go get any additional exponent int)ut ENDINP: LLI 103 ;Set pointer to mantissa SIGN indicator LAM ;Fetch the SIGN indicator to the acclimulator NDA ;Exercise the CPU flags JTZ FININP ;If SIGN indicator is zero, go finish up as nr is positive LLI 154 ;But, if indicator is non-zero, number is negative LBI 003 ;Set pntr to LSW of storage registers, set precision entr CAL COMPLM ;Negate the triple-precision number in holding registers FININP: LLI 153 ;Set pointer to input storage LS~V minus one XRA ;Clear the accumulator LMA ;Clear the LSW minus one location LDH ;Set register D to floating point working page LEI 123 ;Set E to address of FPACC LSW minus one LBI 004 ;Set precision counter CAL MOVEIT ;Move number from input register to FPACC CAL FPFLT ;Now convert the binary fixed point to floating point LLI 104 ;Set pointer to Exponent SIGN indicator location LAM ;Fetch the value of the EXP SIGN indicator NDA ;Exercise the CPU flags LLI 157 ;Reset pointer to input exponent storage location JTZ POSEXP ;If EXP SIGN indicator zero, exponent is positive LAM ;Else, exponent is negative so must negate XRI 377 ;The value in the input exponent storage location ADI 001 ;By performing this two's complement LMA ;Restore the negated value to exponent storage location POSEXP: LLI 106 ;Set pointer to PERIOD indicator storage location LAM ;Fetch the contents of the PERIOD indicator NDA ;Exercise the CPU flags JTZ EXPOK ;If PERIOD indicator clear, no decimal point involved LLI 105 ;If have a decimal point, set pointer to digit counter XRA ;Storage location. Clear the accumulator. SUM ;And get a negated value of the digit counter in ACC EXPOK: LLI 157 ;Change pointer to input exponent storage location ADM ;Add this value to negated digit counter value LMA ;Restore new value to storage location JTS MINEXP ;If new value is minus, skip over next subroutine RTZ ;If new value is zero, no further processing required ;Following subroutine will multiply the floating point ;binary number stored in FPACC by ten tirnes the ;value stored in the deciinal exponent storage location. FPX10: LLI 210 ;Set pointer to registers containing floating point LHI \HB\OLDPG1 ;** Binary representation of 10 (decimal). CAL FACXOP ;Transfer FPACC to FPOP and 10 (dec) to FPACC CAL FPMULT ;Multiply FPOP (formerly FPACC) by 10 (decimal) LLI 157 ;Set pointer to decimal exponent storage location LCM ;Fetch the exponent value DCC ;Decrement LMC ;Restore to storage JFZ FPX10 ;If exponent value is not zero, continue multiplication RET ;When exponent is zero can exit. Conversion completed. ;Following subroutine will multiply the floating point ;binary number stored in PPACC by 0.1 times the value ;(negative) stored in the decimal exponent storage location MINEXP: FPD10: LLI 214 ;Set pointer to registers containing floating point LHI \HB\OLDPG1 ;** Binary representation of 0.1 (decimal). CAL FACXOP ;Transfer FPACC to FPOP and 0.1 (dec) to FPACC CAL FPMULT ;Multitply FPOP (formerly FPACC) by 0.1 (decimal) LLI 157 ;Set pointer to decimal exponent storage location LBM ;Fetch the exponent value INB ;Increment LMB ;Restore to storage JFZ FPD10 ;If exponent value is not zero, continue multiplication RET ;When exponent is zero can exit. Conversion completed. ;Following subroutine is used ;to convert decimal charac- ;ters to binary fixed point forinat ;in a triple-precision format. DECBIN: CAL SAVEHL ;Save entry value of D, E, H and L in memory LLI 153 ;Set pointer to temporary storage location LAC ;Restore character inputted to accumulator NDI 017 ;Trim ASCII code to BCD LMA ;Store temporarily LEI 150 ;Set pointer to working area LSW of multi-byte register LLI 154 ;Set another pointer to LSW of conversion register LDH ;Make sure D set to page of working area LBI 003 ;Set precision counter CAL MOVEIT ;Move original value of conversion register to working LLI 154 ;Register. Reset pointer to LSW of conversion register. LBI 003 ;Set precision counter CAL ROTATL ;Rotate register left, (Multiplies value by two.) LLI 154 ;Reset pointer to LSW. LBI 003 ;Set precision counter CAL ROTATL ;Multiply by two again (total now times four). LEI 154 ;Set pointer to LSW of conversion register. LLI 150 ;Set pointer to LSW of working register (original value). LBI 003 ;Set precision counter. CAL ADDER ;Add original value to rotated value (now times five). LLI 154 ;Reset pointer to LSW LBI 003 ;Set precision counter CAL ROTATL ;Multiply by two once more (total now times ten). LLI 152 ;Set pointer to clear working register locatiotis XRA ;Clear the accumulator LMA ;Clear MSW of working register DCL ;Decrement pointer LMA ;Clear next byte LLI 153 ;Set pointer to current digit storage location LAM ;Fetch the current digit LLI 150 ;Change pointer to LSW of working register LMA ;Deposit the current digit in LSW of working register LEI 154 ;Set pointer to conversion register LSW LBI 003 ;Set precision counter CAL ADDER ;Add current digit to conversion register to complete JMP RESTHL ;Conversion. Exit to caller by restoring CPU registers. FPOUT: LHI \HB\OLDPG1 ;** Set H to working area for floating point routines LLI 157 ;Set pointer to decimal exponent storage location LMI 000 ;Initialize storage location to zero LLI 126 ;Change pointer to FPACC (number to be outputted) LAM ;And fetch MSW of FPACC NDA ;Test the contents of MSW of FPACC JTS OUTNEG ;If most significant bit of MSW is a one, have a minus nr. LAI 240 ;Else number is positive, set ASCII code for space for a JMP AHEAD1 ;Positive number and go display a space OUTNEG: LLI 124 ;If number in FPACC is negative must negate in order LBI 003 ;To display. Set pntr to LSW of FPACC & set prec. cntr. CAL COMPLM ;Negate the number in the FPACC to make it positive LAI 255 ;But load ACC with ASCII code for minus sign AHEAD1: CAL ECHO ;Call user display driver to output space or minus sign LLI 110 ;Set pointer to FIXED/FLOAT indicator LAM ;Fetch value of FIXED/FLOAT indicator NDA ;Test contents of indicator. If contents are zero, calling JTZ OUTFLT ;Routine has directed floating point output format. LLI 127 ;If indicator non-zero, fixed point fonnat requested if LAI 027 ;Possible. Point to FPACC Exponent. Put 23 decimal in LBM ;Accumulator. Fetch FPACC Exponent into register B INB ;And exercise the register to test its DCB ;Original contents. If FPACC Exponent is negative in JTS OUTFLT ;Value then go to floating point output forrnat. If value SUB ;Is positive, subtract value from 23 (decimal). If result JTS OUTFLT ;Negative, number is too big to use fixed format. JMP OUTFIX ;Else, can use fixed format so skip next routine OUTFLT: LLI 110 ;Set pointer to FIXED/FLOAT indicator. LMI 000 ;Clear indicator to indicate floating point output format LAI 260 ;Load ASCII code for '0' into accumulator CAL ECHO ;Call user display driver to output '0' as first character LAI 256 ;Number string. Now load ASCII code for decimal point. CAL ECHO ;Call user display driver to output '.'as second character. OUTFIX: LLI 127 ;Set pointer to FPACC Exponent LAI 377 ;Load accumulator with minus one ADM ;Add value in FPACC Exponent LMA ;Restore compensated exponent value ;Next portion of routine establishes the value for the ;decimal exponent that will be outputted by processing ;the binary exponent value in the FPACC. DECEXT: JFS DECEXD ;If compensated exponent value is zero or positive LAI 004 ;Then go multiply FPACC by 0.1 (decimal). Else, ADM ;Add four to the exponent value. JFS DECOUT ;If exponent now zero or positive, ready to output LLI 210 ;If exponent negative, multiply FPACC by 10 (decimal) LHI \HB\OLDPG1 ;** Set pointer to registers holding 10 (dec) in binary CAL FACXOP ;Floating point format. Set up for multiplication. CAL FPMULT ;Perform the multiplication. Answer in FPACC. LLI 157 ;Set pointer to decimal exponent storage location. LCM ;Each time the FPACC is multiplied by ten, need to DCC ;Decrement the value in the decinial exponent storage LMC ;Location. (This establishes decimal exponent value!) DECREP: LLI 127 ;Reset pointer to FPACC Exponent LAM ;Fetch value in exponent NDA ;Test value JMP DECEXT ;Repeat process as required DECEXD: LLI 214 ;If exponent is positive, multiply FPACC by 0.1 LHI \HB\OLDPG1 ;** Set pointer to registers holding 0.1 dec in binary CAL FACXOP ;Floating point format. Set up for multipli(-ation. CAL FPMULT ;Perform the multiplication. Answer in FPACC. LLI 157 ;Set pointer to decimal exponent storage location. LBM ;Each time the FPACC is multiplied by one tenth, need INB ;To increment the value in the decimal exponent storage LMB ;Location. (This establishes decimal exponent value!) JMP DECREP ;Repeat process as required ;The next section outputs the mantissa ;(or fixed point number) by converting the value remaining ;in the FPACC (after the decimal exponent equivalent has ;been extracted from the original value if required by the ;previous routines) to a string of decirnal digits. DECOUT: LEI 164 ;Set pointer to LSW of output working register LDH ;Set D to same page value as H LLI 124 ;Set pointer to LSW of FPACC LBI 003 ;Set precision counter CAL MOVEIT ;Move value in FPACC to output working register LLI 167 ;Set pointer to MSW plus one of output working register LMI 000 ;Clear that location to 0 LLI 164 ;Set pointer to LSW of output working register LBI 003 ;Set precision counter CAL ROTATL ;Rotate register left once to compensate for sign bit CAL OUTX10 ;Multiply output register by 10, overflow into N4SW+ 1 COMPEN: LLI 127 ;Set pointer back to FPACC Exponent LBM ;Compensate for any remainder in the binary exponent INB ;By performing a rotate right on the output working LMB ;Register until the binary exponent becomes zero JTZ OUTDIG ;Go output decimal digits when this loop is finished LLI 167 ;Binary exponent compensating loop. Setpointe'r to LBI 004 ;Working register MSW+L. Set precision counter. CAL ROTATR ;Rotate working register to the right. JMP COMPEN ;Repeat loop as required. OUTDIG: LLI 107 ;Set pointer to output digit counter storage location LMI 007 ;Initialize to value of seven LLI 167 ;Change pointer to output working register MSW+L LAM ;Fetch MSW+L byte containing BCD of digit to be NDA ;Displayed. Test the contents of this byte. JTZ ZERODG ;If zero jump to ZERODG routine. OUTDGS: LLI 167 ;Reset pointer to working register MSW+L LAM ;Fetch BCD of digit to be outputted NDA ;Exercise CPU flags JFZ OUTDGX ;If not zero, go display the digit LLI 110 ;If zero, change pointer to FIXED/FLOAT indicator LAM ;Fetch the indicator into the accumulator NDA ;Test value of indicator JTZ OUTZER ;If in floating point mode, go display the digit LLI 157 ;Else change pointer to decimal exponent storage LCM ;Location, which, for fixed point, will have a positive DCC ;Value for all digits before the decimal point. Decrement INC ;And increment to exercise flags. See if count is positive. JFS OUTZER ;If positive, must display any zero digit. LLI 166 ;If not, change pointer to MSW of working register LAM ;And test to see if any significant digits coming up NDI 340 ;By forming a mask and testing for presence of bits JFZ OUTZER ;If more significant digits coming up soon, display the RET ;Zero digit. Else, exit to calling routine. Finished. OUTZER: XRA ;Clear the accumulator to restore zero digit value OUTDGX: ADI 260 ;Add 260 (octal) to BCD code in ACC to form ASCII CAL ECHO ;Code and call the user's display driver subroutine DECRDG: LLI 110 ;Set pointer to FIXED/FLOAT indicator storage LAM ;Fetch the indicator to the accumulator NDA ;Exercise the CPU flags JFZ CKDECP ;If indicator non-zero, doing fixed point output LLI 107 ;Else, get output digit counter LCM DCC ;Decrement the digit counter & restore to storage LMC JTZ EXPOUT ;When digit counter is zero, go take care of exponent PUSHIT: CAL OUTX10 ;Else push next BCD digit out of working register JMP OUTDGS ;And continue the outputting process CKDECP: LLI 157 ;For fixed point output, decimal exponent serves as LCM ;Counter for number of digits before decimal point DCC ;Fetch the counter and decrement it to account for LMC ;Current digit being processed. Restore to storage. JFZ NODECP ;If count does not go to zero, jump ahead. LAI 256 ;When count reaches zero, load ASCII code for period CAL ECHO ;And call user's display driver to display decimal point NODECP: LLI 107 ;Set pointer to output digit counter storage location LCM ;Fetch the digit counter DCC ;Decrement the value LMC ;Restore to storage RTZ ;If counter reaches zero, exit to caller. Finished. JMP PUSHIT ;Else continue to output the number. ZERODG: LLI 157 ;If first digit of floating point number is a zero, set LCM ;Pointer to decimal exponent storage location. DCC ;Decrement the value to compensate for skipping LMC ;Display of first digit. Restore to storage. LLI 166 ;Change pointer to MSW of output working register LAM ;Fetch MSW of output working register NDA ;Test the contents JFZ DECRDG ;If non-zero, continue outputting DCL ;Else decrement pointer to next byte in working register LAM ;Fetch its contents NDA ;Test JFZ DECRDG ;If non-zero, continue outputting DCL ;Else decrement pointer to LSW of working register LAM ;Fetch its contents NDA ;Test JFZ DECRDG ;If non-zero, continue outputting LLI 157 ;If decimal mantissa is zero, set pointer to decirnal LMA ;Exponent storage and clear it JMP DECRDG ;Finish outputting ;Following routine multiplies the binary number in the ;output working register by ten to push the most signifi- ;cant digit out to the MSW+L byte. OUTX10: LLI 167 ;Set pointer to work ing register M SW+ 1 LMI 000 ;Clear it in preparation for receiving next digit pushed LLI 164 ;Into it. Change pointer to working register LSW. LDH ;Set up register D to same page as H. LEI 160 ;Set second pointer to LSW of second working register LBI 004 ;Set precision counter CAL MOVEIT ;Move first working register into second LLI 164 ;Reset pointer to LSW of first working register LBI 004 ;Set precision counter CAL ROTATL ;Rotate contents of first working register left (X 2) LLI 164 ;Reset pointer to LSW LBI 004 ;Reset precision counter CAL ROTATL ;Rotate contents left again (X 4) LLI 160 ;Set pointer to LSW of original value in 2'nd register LEI 164 ;Set pointer to LSW of rotated value LBI 004 ;Set precision counter CAL ADDER ;Add rotated value to original value (X 5) LLI 164 ;Reset pointer to LSW of first working register LBI 004 ;Set precision counter CAL ROTATL ;Rotate contents left again (X 10) RET ;Exit to calling routine ;The final group of routines in the floating point output ;section take care of outputting the decimal exponent ;portion of floating point numbers. EXPOUT: LLI 157 ;Set pointer to decimal exponent storage location LAM ;Fetch value to the accumulator NDA ;Test the value RTZ ;If zero, then no exponent portion. Exit to caller. LAI 305 ;Else, load ACC with ASCII code for letter E. CAL ECHO ;Display E for Exponent via user's display driver rtn LAM ;Get decimal exponent value back into ACC NDA ;Test again JTS EXOUTN ;If value is negative, skip ahead LAI 253 ;If positive, load ASCII code for + sign JMP AHEAD2 ;Jump to display the + sign EXOUTN: XRI 377 ;When decimal exponent is negative, must negate ADI 001 ;Value for display purposes. Perform two's complement LMA ;And restore the negated value to storage location LAI 255 ;Load ASCII code for minus sign AHEAD2: CAL ECHO ;Display the ASCII character in ACC LBI 000 ;Clear register B LAM ;Fetch the decimal exponent value back into ACC SUB12: SUI 012 ;Subtract 10 (decimal) from value in ACC JTS TOMUCH ;Break out of loop when accumulator goes negative LMA ;Else restore value to storage location INB ;Increment register B as a counter JMP SUB12 ;Repeat loop to form tens value of decimal exponent TOMUCH: LAI 260 ;Load base ASCII value for digit into the accumulator ADB ;Add to the count in B to forin tens digit of decimal CAL ECHO ;Exponent. Display via user's driver subroutine LAM ;Fetch remainder of decimal exponent value ADI 260 ;Add in ASCII base value to form final digit CAL ECHO ;Display second digit of decirnal exponent RET ;Finished outputting. Return to caller. ;;; The above RETURN SHOULD BE AT 25 367 ;;; NOW OPEN AREA UP TO 26 000 CAN BE USED FOR PATCHING... ORG 026#000 DATA 000 ; CC FOR INPUT LINE BUFFER DATA *79 ; THE INPUT LINE BUFFER DATA 000,000,000,000 ; THESE ARE SYMBOL BUFFER STORAGE DATA 000,000,000,000 DATA 000,000,000,000 ; SHOULD BE 26-120 TO 26 143 DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000,000,000 ; THESE LOCATIONS ARE AUXILIARY SYMBOL BUFFER DATA 000,000,000,000 DATA 000,000,000,000 ; SHOULD BE 26 144 TO 26 175 DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000 DATA 000 ; TEMP SCAN STORAGE REGISTER DATA 000 ; TAB FLAG DATA 000 ; EVAL CURRENT TEMP REG. DATA 000 ; SYNTAX LINE NUMBER DATA 000 ; SCAN TEMPORARY REGISTER DATA 000 ; STATEMENT TOKEN DATA 000,000 ; TEMPORARY WORKING REGISTERS DATA 000,000 ; ARRAY POINTERS ;;; NOW WE SHOULD BE UP TO 26 210 DATA 000 ; OPERATOR STACK POINTER DATA *15 ; OPERATOR STACK DATA 000 ; FUN/ARRAY STACK POINTER DATA *7 ; FUNCTION/ARRAY STACK ;;; THE LAST BYTE SHOULD HAVE BEEN 26 237 ;; HEIRARCHY TABLE (FOR OUT OF STACK OPS) ;; USED BY PARSER ROUTINE. ;;; This SHOULD START AT 26 240 DATA 000 ; EOS DATA 003 ; PLUS SIGN DATA 003 ; MINUS SIGN DATA 004 ; MULTIPLICATION SIGN DATA 004 ; DIVISION SIGN DATA 005 ; EXPONENT SIGN DATA 006 ; LEFT PARENTHESIS DATA 001 ; RIGHT PARENTHESIS DATA 002 ; NOT ASSIGNED DATA 002 ; LESS THAN SIGN DATA 002 ; Equal sign DATA 002 ; GREATER THAN SIGN DATA 002 ; LESS THAN OR EQUAL COMBO DATA 002 ; EQUAL OR GREATER THAN DATA 002 ; LESS THAN OR GREATER THAN ;; HEIRARCHY TABLE (FOR INTO STACK OPS) ;; USED BY PARSER ROUTINE. ;;; This SHOULD START AT 26 257 DATA 000 ; EOS DATA 003 ; PLUS SIGN DATA 003 ; MINUS SIGN DATA 004 ; MULTIPLICATION SIGN DATA 004 ; DIVISION SIGN DATA 005 ; EXPONENTIATION SIGN DATA 001 ; LEFT PARENTHESIS DATA 001 ; RIGHT PARENTHESIS DATA 002 ; NOT ASSIGNED DATA 002 ; LESS THAN SIGN DATA 002 ; EQUAL SIGN DATA 002 ; GREATER THAN SIGN DATA 002 ; LESS THAN OR EQUAL SIGN DATA 002 ; EQUAL TO OR GREATER THAN DATA 002 ; LESS THAN OR GREATER THAN DATA 000 ; EVAL START POINTER DATA 000 ; EVAL FINISH POINTER ;; FUNCTION NAMES TABLE ;;; This SHOULD START AT 26 300 DATA 3 DATA "INT" DATA 3 DATA "SGN" DATA 3 DATA "ABS" DATA 3 DATA "SQR" DATA 3 DATA "TAB" DATA 3 DATA "RND" DATA 3 DATA "CHR" DATA 3 DATA "UDF" DATA 000,000,000,000 ; LINE NUMBER BUFFER STORAGE DATA 000,000,000,000 ; (SHOULD BE 340-347) DATA 000,000,000,000 ; AUX LINE NUMBER BUFFER DATA 000,000,000,000 ; (SHOULD BE 350-357) ;;; The following data is a change in page 3 of Scelbal update issue 4 ;;; which apparently makes the "INSERT" command work correctly, the ;;; first time (later SCR commands load 33 into this spot) DATA 033 ; USER PGM LINE PTR (PG) DATA 000 ; USER PGM LINE PTR (LOW) DATA 000 ; AUX PGM LINE PTR (PG) DATA 000 ; AUX PGM LINE PTR (LOW) DATA 000 ; END OF USER PGM BUFFER PTR (PG) DATA 000 ; END OF USER PGM BUFFER PTR (LOW) DATA 000 ; PARENTHESIS COUNTER (366) DATA 000 ; QUOTE INDICATOR DATA 000 ; TABLE COUNTER (370) ;;; locations 371-377 NOT ASSIGNED ORG 027#000 DATA 3 DATA "REM" DATA 2 DATA "IF" DATA 3 DATA "LET" DATA 4 DATA "GOTO" DATA 5 DATA "PRINT" DATA 5 DATA "INPUT" DATA 3 DATA "FOR" DATA 4 DATA "NEXT" DATA 5 DATA "GOSUB" DATA 5 DATA "RETURN" DATA 3 DATA "DIM" DATA 3 DATA "END" DATA 0 ; END OF TABLE, SHOULD BE 072 DATA 000 ; GOSUB STACK POINTER DATA *1 ; NOT ASSIGNED; DATA 000 ; NUMBER OF ARRAYS COUNTER DATA 000 ; ARRAY POINTER DATA 000 ; VARIABLES COUNTER SHOULD BE 077 DATA 000,000,000,000 ; USED AS THE GOSUB STACK 100-117 DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000,000,000 ; USED AS ARRAY VARIABLES TABLE DATA 000,000,000,000 ; SHOULD BE 120-137 DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000,000,000 ; USED FOR FOR/NEXT STACK STORAGE DATA 000,000,000,000 ; SHOULD BE 140 TO 177 DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000,000,000 DATA 000,000,000,000 DATA 000 ; FOR/NEXT STACK POINTER DATA 000 ; ARRAY/VARIABLE FLAG DATA 000 ; STOSYM COUNTER DATA 000 ; FUN/ARRAY STACK POINTER (203 DATA 000 ; ARRAY VALUES POINTER DATA *3 ; NOT USED (SHOULD BE 205-207) DATA 000 ; USED AS VARIABLES SYMBOL TABLE DATA *119 ; (SHOULD BE 211-377 RESERVED) ;;; The above should cover 211 to 377 ;; THERE ARE NOW ADDRESSES AT START OF PAGE 30, NOT ASSIGNED; ;;; The following is PATCH NR.1 ORG 030#000 PATCH1: LLI 123 LMI 000 LLI 133 LMI 000 RET ORG 030#013 NEXT: LLI 144 ;Load L with start of AUX SYMBOL BUFFER LHI \HB\OLDPG26 ;** Set H to page of AUX SYMBOL BUFFER LMI 000 ;Initialize AUX SYMBOL BUFFER by clearing first byte LLI 202 ;Change L to address of SCAN pointer LBM ;Fetch pointer value to CPU register B INB ;Add one to the current pointer value LLI 201 ;Load L with address of NEXT pointer storage location LMB ;Place the updated SCAN pointer as the NEXT pointer NEXT1: LLI 201 ;Reset L to address of NEXT pointer storage location CAL GETCHR ;Fetch the character pointed to by the NEXT pointer JTZ NEXT2 ;If the character is a space, ignore it LLI 144 ;Else, load L with start of AUX SYMBOL BUFFER CAL CONCT1 ;Concatenate the character onto the AUX SYMBOL BF NEXT2: LLI 201 ;Reset L to address of NEXT pointer storage location CAL LOOP ;Advance the NEXT pointer and see if end of line JFZ NEXT1 ;Fetch next character in line if not end of line LLI 144 ;When reach end of line, should have variable name LAM ;In the AUX SYMBOL BUFFER. Fetch the (cc) for CPI 001 ;The buffer and see if variable name is just one letter JFZ NEXT3 ;If more than one proceed directly to look for name LLI 146 ;In FOR/NEXT STACK. If have just a one letter name LMI 000 ;Then set second character in buffer to zero NEXT3: LLI 205 ;Load L with address of FOR/NEXT STACK pointer LHI \HB\OLDPG27 ;** Set H to page of FOR/NEXT STACK pointer LAM ;Fetch the FOR/NEXT STACK pointer value to ACC RLC ;Rotate value left to multiply by two. Then rotate it RLC ;Left again to multiply by four. Add base address plus ADI 136 ;Two to form pointer to variable name in top of stack LHI \HB\OLDPG27 ;** Set H to page of FOR/NEXT STACK LLA ;Move pointer value from ACC to CPU register L LDI \HB\OLDPG26 ;** Set register D to page of AUX SYMBOL BUFFER LEI 145 ;Set register E to first character in the buffer LBI 002 ;Set B to serve as a character counter CAL STRCPC ;See if variable name in the NEXT statement same as JTZ NEXT4 ;That stored in the top of the FOR/NEXT STACK FORNXT: LAI 306 ;Load ACC with ASCII code for letter F LCI 316 ;Load register C with ASCII code for letter N JMP ERROR ;Display For/Next (FN) error message if required NEXT4: LLI 360 ;Load L with address of user program line pointer LHI \HB\OLDPG26 ;** Load H with page of user pgm line pntr storage loc. LDM ;Fetch the page portion of the line pointer into D INL ;Advance the memory pointer LEM ;Fetch the low portion of the line pointer into E INL ;Advance pntr to AUXILIARY LINE POINTER storage LMD ;Location and store value of line pointer there too (page) INL ;Advance pointer to second byte of AUXILIARY line LME ;Pointer and store value of line pointer (low portion) LLI 205 ;Load L with address of FOR/NEXT STACK pointer LHI \HB\OLDPG27 ;** Set H to page of FOR/NEXT STACK pointer LAM ;Fetch the FOR/NEXT STACK pointer value to ACC RLC ;Rotate value left to multiply by two. Then rotate it RLC ;Left again to multiply by four. Add base address to ADI 134 ;Form pointer to top of FOR/NEXT STACK and place LLA ;The pointer value into CPU register L. Fetch the page LDM ;Address of the associated FOR statement line pointer INL ;Into register D. Advance the pointer and fetch the low LEM ;Address value into register E. Prepare to change user LLI 360 ;Program line pointer to the FOR statement line by LHI \HB\OLDPG26 ;** Setting H & L to the user pgrn line pntr storage loc. LMD ;Place the page value in the pointer storage location INL ;Advance the memory pointer LME ;Place the low value in the pointer storage location LHD ;Now set up H and L to point to the start of the LLE ;Associated FOR statement line in the user pgm buffer LDI \HB\OLDPG26 ;** Change D to point to the line input buffer LEI 000 ;And set L to the gtart of the line input buffer CAL MOVEC ;Move the associated FOR statement line into the input LLI 325 ;Line buffer. Set L to point to start of TO string which is LHI \HB\OLDPG1 ;** Stored in a text strings storage area on this page CAL INSTR ;Search the statement line for the occurrence of TO LAE ;Register E will be zero if TO not found. Move E to ACC NDA ;To make a test. If TO found then proceed to set up for JTZ FORNXT ;Evaluation. If TO not found, then have error condition. ADI 002 ;Advance the pointer over the characters in TO string LLI 276 ;Change L to point to EVAL pointer storage location LHI \HB\OLDPG26 ;** Set H to page of EVAL pointer. Set up the starting LMA ;Position for the EVAL subroutine (after TO string) LLI 330 ;Set L to point to start of STEP string which is stored LHI \HB\OLDPG1 ;** In text stxings storage area on this page. Search the CAL INSTR ;Statement line for the occurrence of STEP LAE ;Register E will be zero if STEP not found. Move E to NDA ;The accumulator to make a test. If STEP found must JFZ NEXT5 ;Evaluate expression after STEP to get STEP SIZE. LLI 004 ;Else, have an IMPLIED STEP SIZE of 1.0. Set pointer LHI \HB\OLDPG1 ;** To start of storage area for 1.0 in floating point CAL FLOAD ;Format and call subroutine to load FPACC with 1.0 LLI 304 ;Set L to start of FOR/NEXT STEP SIZE storage loc. CAL FSTORE ;Store the value 1.0 in the F/N STEP SIZE registers LLI 000 ;Change L to the start of the input line buffer LHI \HB\OLDPG26 ;** Set H to the page of the input line buffer LBM ;Fetch the (cc) into CPU register B (length of FOR line) LLI 277 ;Change L to EVAL FINISH pointer stomge location LMB ;Set the EVAL FINISH pointer to the end of the line CAL EVAL ;Evaluate the LIMIT expression to obtain FOR LIMIT LLI 310 ;Load L with address of start of F/N LIMIT registers LHI \HB\OLDPG1 ;** Load H with page of FOR/NEXT LIMIT registers NEXT5: CAL FSTORE ;Store the FOR/NEXT LIMIT value JMP NEXT6 ;Since have IMPLIED STEP jump ahead DCE ;When have STEP directive, subtract one from pointer LLI 277 ;To get to character before S in STEP. Save this value in LHI \HB\OLDPG26 ;** The EVAL FINISH pointer stomge location to serve LME ;As evaluation end location when obtaining TO Iiinit CAL EVAL ;Evaluate the LIMIT expression to obtain FOR LIMIT LLI 310 ;Load L with address of start of FIN LIMIT registers LHI \HB\OLDPG1 ;** Load H with page of FORINEXT LIMIT registers CAL FSTORE ;Store the FOR/NEXT LIMIT value LLI 277 ;Reset L to EVAL FINISH pointer storage location LHI \HB\OLDPG26 ;** Set H to page of EVAL FINISH pointer storage loc. LAM ;Fetch the pointer value (character before S in STEP) ADI 005 ;Add five to change pointer to character after P in STEP DCL ;Decrement L to point to EVAL (start) pointer LMA ;Set up the starting position for the EVAL subroutine LLI 000 ; Load L with starting address of the line input buffer LBM ;Fetch the (cc) for the line input buffer (line length) LLI 277 ;Change L to the EVAL FINISH storage location LMB ;Set the EVAL FINISH pointer CAL EVAL ;Evaluate the STEP SIZE expression LLI 304 ;Load L with address of start of F/N STEP registers LHI \HB\OLDPG1 ;** Set H to page of FIN STEP registers CAL FSTORE ;Store the FOR/NEXT STEP SIZE value NEXT6: LLI 144 ;Load L with address of AUX SYMBOL BUFFER LHI \HB\OLDPG26 ;** Set H to page of the AUX SYMBOL BUFFER LMI 000 ;Initialize AUX SUMBOL BUFFER with a zero byte LLI 034 ;Set L to start of FOR string which is stored in the LHI \HB\OLDPG27 ;** KEYWORD look-up table on this page CAL INSTR ;Search the statement line for the FOR directive LAE ;Register E will be zero if FOR not found. Move E to NDA ;ACC and -make test to see if FOR directive located LLI 202 ;Load L with address of SCAN pointer LHI \HB\OLDPG26 ;** Load H with page of SCAN pointer LMA ;Set up pointer to occurrence of FOR directive in line JTZ FORNXT ;If FOR not found, have an error condition ADI 003 ;If have FOR, add three to advance pointer over FOR LLI 203 ;Set L to point to F/N pointer storage location LMA ;Set F/N pointer to character after FOR directive NEXT7: LLI 203 ;Set L to point to FIN pointer storage location CAL GETCHR ;Fetch a character from position pointed to by FIN pntr JTZ NEXT8 ;If character is a space, ignore it CPI 275 ;Else, test to see if character is "=" sign JTZ NEXT9 ;If yes, have picked up variable name, jump ahead LLI 144 ;If not, set L to the start of the AUX SYMBOL BUFFER CAL CONCT1 ;And store the character in the AUX SYMBOL BUFFER NEXT8: LLI 203 ;Load L with address of the F/N pointer CAL LOOP ;Increment the pointer and see if end of the line JFZ NEXT7 ;If not, continue fetching characters JMP FORNXT ;If end of line before "=" sign then have error condx NEXT9: LLI 202 ;Load L with address of SCAN pointer LHI \HB\OLDPG26 ;** Load H with page of SCAN pointer LAM ;Fetch pointer value to ACC (points to start of FOR ADI 003 ;Directive) and add three to move pointer over FOR LLI 276 ;Directive. Change L to EVAL pointer storage location LMA ;Set EVAL pointer to character after FOR in line LLI 203 ;Load L with address of FIN pointer storage location LBM ;Fetch pointer to register B (points to "=" sign) and DCB ;Decrement the pointer (to character before "=" sign) LLI 277 ;Load L with address of EVAL FINISH pointer LMB ;Set EVAL FINISH pointer CAL EVAL ;Call subroutine to obtain current value of the variable LLI 304 ;Load L with address of start of F/N STEP registers LHI \HB\OLDPG1 ;** Set H to page of F/N STEP registers CAL FACXOP ;Call subroutine to set up FP registers for addition CAL FPADD ;Add FIN STEP size to current VARIABLE value LLI 314 ;Load L with address of FIN TEMP storage registers LHI \HB\OLDPG1 ;**Set H to page of FIN TEMP storage registers CAL FSTORE ;Save the result of the addition in F/N TEMP registers LLI 310 ;Load L with starting address of F/N LIMIT registers CAL FACXOP ;Call subroutine to set up FP registers for subtraction CAL FPSUB ;Subtract F/N LIMIT value from VARIABLE value LLI 306 ;Set pointer to MSW of F/N STEP registers LAM ;Fetch this value into the ACC NDA ;Test to see if STEP value might be zero LLI 126 ;Load L with address of MSW of FPACC LAM ;Fetch this value into the ACC JTZ FORNXT ;If STEP size was zero, then endless loop, an error condx JTS NEXT11 ;If STEP size less than zero make alternate test on limit NDA ;Test the contents of the MSW of the FPACC JTS NEXT12 ;Continue FORINEXT loop if current variable value is JTZ NEXT12 ;Less than or equal to the F/N LIMIT value NEXT10: LLI 363 ;If out of LIMIT range, load L with address of the AUX LHI \HB\OLDPG26 ;** PGM LINE pointer. (Contains pointer to the NEXT LEM ;Statement line that initiated this routine.) Fetch the DCL ;Low part of the address into E, decrement the memory LDM ;And get the page part of the address into CPU register DCL ;Decrement memory pointer to the low portion of the LME ;User pgm buffer line pointer (regular pointer) and set it DCL ;With the value from the AUX line pntr, decrement the LMD ;Pointer and do the same for the page portion LLI 205 ;Set L to address of FOR/NEXT STACK pointer LHI \HB\OLDPG27 ;** Set H to page of FOR/NEXT STACK pointer LBM ;Fetch and decrement the DCB ;FOR/NEXT STACK pointer value LMB ;To perform effective popping operation JMP NXTLIN ;Statement line after NEXT statement is done next NEXT11: NDA ;When F/N STEP is negative, reverse test so that if the JFS NEXT12 ;Variable value is greater than or equal to the F/N LIMIT JMP NEXT10 ;The FOR/NEXT loop continues. Else it is finished. NEXT12: LLI 314 ;Load L with address of FIN TEMP storage registers LHI \HB\OLDPG1 ;** Set H to FIN TEMP storage registers page CAL FLOAD ;Transfer the updated variable value to the FPACC CAL RESTSY ;Restore the variable name and value CAL STOSYM ;In the VARIABLES table. Exit routine so that JMP NXTLIN ;Statement line after FOR statement is done next ;;; The label BACKSP SHOULD BE AT 31 217 BACKSP: LAI 215 ;Load ASCII code for carriage-return into the ACC CAL ECHO ;Display the carriage-return CAL ECHO ;Repeat to provide extra time if TTY LLI 043 ;Load L with address of COLUMN COUNTER LHI \HB\OLDPG1 ;** Set H to page of COLUMN COUNTER LMI 001 ;Set COLUMN COUNTER to first column LLI 124 ;Set L to address containing desired TAB position LAM ;Fetch the desired TAB position value NDA ;Test to see if it is RTS ;Negative or zero RTZ ;In which case return to caller JMP TAB1 ;Else, proceed to perform the TAB operation. ;;; The label FOR5 SHOULD START AT 31 246 FOR5: LLI 205 ;Load L with address of the FOR/NEXT STACK pointer LHI \HB\OLDPG27 ;** Load H with page of the FOR/NEXT STACK pntr LAM ;Fetch the stack pointer to the ACC. RLC ;Rotate it left to multiply by two, then rotate it again to RLC ;Multiply by four. Add this value to the base address ADI 136 ;Plus two of the base address to point to the next part of LEA ;The FOR/NEXT STACK. Place this value in register E. LDH ;Set D to the FORINEXT STACK area page. LLI 145 ;Load L with the address of the first character in the LHI \HB\OLDPG26 ;** AUX SYMBOL BUFFER and set up H to this page. LBI 002 ;Set up register B as a number of bytes to move counter. CAL MOVEIT ;Move the variable name into the FOR/NEXT STACK. CAL STOSYM ;Store initial variable value in the VARIABLES TABLE. JMP NXTLIN ;Continue with next line in user program buffer. ;;; The label PARSEP SHOULD START AT 31 300 PARSEP: LLI 176 ;Load L with PARSER TOKEN storage location. Set LMI 000 ;The value indicating end of expression. Call the CAL PARSER ;PARSER subroutine for final time for the expression. LLI 227 ;Change L to point to the ARITH STACK pointer. LHI \HB\OLDPG1 ;** Set H to the page of the ARITH STACK pointer. LAM ;Fetch the ARITH STACK pointer value. CPI 230 ;Should indicate only one value (answer) in stack. RTZ ;Exit with answer in FPACC if ARITH STACK is O.K. JMP SYNERR ;Else have a syntax error! ;;; THERE IS SOME BLANK ADDRESSES HERE 317-NEXT PAGE ORG 032#000 SQRX: LLI 014 ;Load L with address of FP TEMP registers LHI \HB\OLDPG1 ;** Set H to page of FP TEMP. Move contents of FPACC CAL FSTORE ;[Argument of SQR(X)] into FP TEMP for storage. LLI 126 ;Load L with MSW of FPACC LAM ;Fetch the MSW into the accumulator NDA ;Check the sign of the number in the FPACC JTS SQRERR ;If number negative, cannot take square root JTZ CFALSE ;If number is zero, return with zero value in FPACC LLI 017 ;Load L with address of FP TEMP Exponent register LAM ;Fetch the Exponent value into the ACC NDA ;Check sign of the Fxponent JTS NEGEXP ;If Exponent less than zero, process negative Exponent RAR ;If Exponent positive, rotate right to divide by two LBA ;And save the result in CPU register B LAI 000 ;Clear the accumulator without disturbing Carry bit RAL ;Rotate Carry bit into the ACC to save remainder LMA ;Store the remainder back in FP TEMP Exponent reg. JMP SQREXP ;Jump to continue processing NEGEXP: LBA ;For negative Exponent, form two Is complement by XRA ;Placing the positive value in CPU register B, clearing SUB ;The accumulator, and then subtracting B from the ACC NDA ;Clear the Carry bit after the complementing operation RAR ;Rotate the value right to divide by two LBA ;Save the result in CPU register B LAI 000 ;Clear the accumulator without disturbing Carry bit ACA ;Add Carry bit to the accumulator as remainder LMA ;Store the remainder back in FP TEMP Exponent reg JTZ NOREMD ;If remainder was zero skip ahead. If not, increment the INB ;Result of the divide by two ops to compen for negative NOREMD: XRA ;Clear the accumulator SUB ;Subtract the quotient of the divide by two op to LBA ;Form two's complement and save the result in register B SQREXP: LLI 013 ;Load L with address of TEMP register LMB ;Store Fxponent quotient from above ops in TEMP LLI 004 ;Load L with address of FP registers containing +1.0 LEI 034 ;Load E with address of SQR APPROX working registers LDH ;Set D to same page as H LBI 004 ;Set up register B as a number of bytes to move counter CAL MOVEIT ;Transfer value +1.0 into SQR APPROX registers CAL CFALSE ;Now clear the FPACC registers LLI 044 ;Load L with address of LAST SQR APPROX temp regs. CAL FSTORE ;Initialize the LAST SQR APPROX regs to value of zero SQRLOP: LLI 034 ;Load L with address of SQR APPROX working registers CAL FLOAD ;Transfer SQR APPROX into the FPACC LLI 014 ;Load L with address of SQR ARG storage registers CAL OPLOAD ;Transfer SQR ARG into the FPOP CAL FPDIV ;Divde SQR ARG by SQR APPROX (Fon-n X/A) LLI 034 ;Load L with address of SQR APPROX registers CAL OPLOAD ;Transfer SQR APPROX into the FPOP CAL FPADD ;Add to form value (X/A + A) LLI 127 ;Load L with address of FPACC Exponent register LBM ;Fetch Exponent value into CPU register B DCB ;Subtract one to effectively divide FPACC by two LMB ;Restore to memory. (Now have ((X/A + A) /2) LLI 034 ;Load L with address of SQR APPROX registers CAL FSTORE ;Store contents of FPACC as new SQR APPROX LLI 044 ;Load L with address of LAST SQR APPROX registers CAL OPLOAD ;Transfer LAST SQR APPROX into the FPOP CAL FPSUB ;Subtract (LAST SQR APPROX - SQR APPROX) LLI 127 ;Load L with address of FPACC Exponent LAM ;Fetch the Exponent into the accumulator CPI 367 ;See if difference less than 2 to the minus ninth ;;; The below is changed for PATCH 2 ;;; following is the original code ;;; JTS SQRCNV ;If so, approximation has converged ;;; Now is the new line JMP PATCH2 ;;;; DCL ;;;; LAM ;;;; NDA ;;;; JTZ SQRCNV ;THIS IS PATCH #2 SQR1: LLI 034 ;Else, load L with address of SQR APPROX LDH ;Set D to same page as H LEI 044 ;And E with address of LAST SQR APPROX LBI 004 ;Set up register B as a number of bytes to move counter CAL MOVEIT ;Transfer SQR APPROX into LAST SQR APPROX JMP SQRLOP ;Continue ops until approximation converges SQRCNV: LLI 013 ;Load L with address of TEMP register. Fetch the LAM ;Exponenent quotient store there into accumulator. LLI 037 ;Change L to point to SQR APPROX exponent. ADM ;Add SQR APPROX exponent to quotient value. LMA ;Store sum back in SQR APPROX Exponent register. LLI 034 ;Load L with address of SQR APPROX. Transfer the JMP FLOAD ;SQR APPROX into FPACC as answer and exit. SQRERR: LAI 323 ;Load ASCII code for letter S into the accumulator. LCI 321 ;Load ASCII code for letter Q into CPU register C. JMP ERROR ;Display the SQuare root (SQ) error message. ;;; above instruction starts at 223 ;;; some blank addresses available here. ORG 032#240 RNDX: LLI 064 ;Load L with address of SEED storage registers LHI \HB\OLDPG1 ;** Set H to page for floating point working registers CAL FLOAD ;Transfer SEED into the FPACC LLI 050 ;Load L with address of random constant A CAL OPLOAD ;Transfer random constant A into the FPOP CAL FPMULT ;Multiply to form (SEED * A) LLI 060 ;Load L with address of random constant C CAL OPLOAD ;Transfer random constant C into the FPOP CAL FPADD ;Add to fom (SEED * A) + C LLI 064 ;Load L with address of SEED storage registers CAL FSTORE ;Store I (SEED * A) + C] in former SEED registers LLI 127 ;Load L with address of FPACC Exponent register LAM ;Fetch Exponent value into the accumulator SUI 020 ;Subtract 16 (decimal) to effectively divide by 65,536 LMA ;Now FPACC = [((SEED * A) + C)/65,536] CAL FPFIX ;Convert floating to fixed point to obtain integer part LLI 123 ;Load L with address of FPACC Extension register LMI 000 ;Clear the FPACC Extension register LLI 127 ;Load L with address of FPACC Exponent LMI 000 ;Clear the FPACC Exponent register CAL FPFLT ;Fetch INT(((SEED * A) + C)/65,536) into the FPACC LLI 127 ;Load L with address of FPACC Exponent LAM ;Fetch FPACC Exponent into the accumulator ADI 020 ;Add 16 (decimal) to effectively multiply by 65,536 LMA ;(65,536 * INT[ ((SEED * A) + C)/65,5361) in FPACC LLI 064 ;Load L with address of [(SEED * A) + C] CAL OPLOAD ;Transfer it into FPOP. Subtract FPACC to form CAL FPSUB ;[(SEED * A) + C] MOD 65,536 LLI 064 ;Load L with address of former SEED registers CAL FSTORE ;Store SEED MOD 65,536 in place of [(SEED * A) + Cl LLI 127 ;Load L with address of FPACC Exponent LAM ;Fetch FPACC Exponent into the ACC and subtract SUI 020 ;16 (decimal) to form (SEED MOD 65,536)/65,536 LMA ;So that random number in FPACC is between RET ;0.0 and +1.0 and exit to calling routine ;;; THE ABOVE RETURN SHOULD BE 32 351 ;;; NOTE OPEN ADDRESSES TO END OF PAGE 32 ;;; following is PATCH 2 ORG 032#364 PATCH2: JTS SQRCNV DCL LAM NDA JTZ SQRCNV JMP SQR1 ;;; The above jump should start at 32 375 ;; PAGES 33 TO REMAINDER OF MEMORY ;; OR START OF OPTIONAL ARRAY HANDLING ;; ROUTINES USED AS USER PROGRAM BUFFER ;; OPTIONAL ARRAY ROUTINES ASSEMBLED FOR OPERATION ;; IN THE UPPER 3 PAGES OF A 12K SYSTEM ARE LISTED HERE. ORG 055#000 PRIGH1: LLI 126 ;Load L with address of the MSW in the FPACC LHI \HB\OLDPG1 ;** Set H to page of FPACC LAM ;Fetch MSW of FPACC into the ACC. NDA ;Test to see if value in FPACC is positive. JTS OUTRNG ;If not, go display error message. CAL FPFIX ;If O.K. then convert floating point to fixed point LLI 124 ;Load L with address of LSAL of converted value LAM ;Fetch the LSW of the value into the ACC SUI 001 ;Subtract one from the value to establish proper RLC ;Origin for future ops. Now rotate the value twice RLC ;To effectively multiply by four. Save the LCA ;Calculated result in CPU register C LLI 203 ;Load L with address of F/A STACK TEMP LHI \HB\OLDPG27 ;** Load H with page of F/A STACK TEMP LAM ;Fetch the value into the accumulator XRI 377 ;Complement the value RLC ;Rotate the value twice to multiply by four (the number RLC ;Of bytes per entry in the ARRAY VARIABLES table). ADI 120 ;Add the starting address of the ARRAY VARIABLES LHI \HB\OLDPG27 ;** TABLE to forin pointer. Set page address in H. LLA ;Point to the name in the ARRAY VARIABLES INL ;Increment the pointer value twice to move over the INL ;Name in the table and point to starting address for the LAM ;Array values in the ARRAY VALUES table. Fetch this ADC ;Address to the ACC. Now add in the figure calculated LLA ;To reach desired subscripted data storage location. Set LHI \HB\OLDPG57 ;tt The pointer to that location. Load the floating point JMP FLOAD ;Value stored there into the FPACC and exit to caller. ;;; The label FUNAR2 SHOULD START AT 55-054 FUNAR2: LLI 202 ;Load L with address of TEMP COUNTER LHI \HB\OLDPG27 ;** Load H with page of counter LBM ;Fetch the counter value INB ;Increment the value LMB ;Restore the value to memory LCI 002 ;Initialize register C to a value of two for future ops LLI 114 ;Load L with address of start of ARRAY VARIABLES LHI \HB\OLDPG27 ;** TABLE (less four). Set H to page of the table. CAL TABADR ;Calculate address of start of next narne in table. LDI \HB\OLDPG26 ;** Load D with page of the SYMBOL BUFFER LEI 120 ;Set E to starting address of the SYMBOL BUFFER CAL STRCP ;Compare name in ARRAY VARIABLES table to the JTZ FUNAR3 ;Contents of the SYMBOL BUFFER. If match, go set up LLI 202 ;Array token value. Else, reset L to address of TEMP LHI \HB\OLDPG27 ;** COUNTER. Set H to page of TEMP COUNTER. LAM ;Fetch the counter value into the accumulator. LLI 075 ;Change L to number of arrays storage location. CPM ;Compare number of entries checked against number JFZ FUNAR2 ;Possible. Keep searching table if not finished. JMP FAERR ;If finished and no match than have F/A error condx. FUNAR3: LLI 202 ;Load L with address of TEMP COUNTER LHI \HB\OLDPG27 ;** Load H with page of counter. XRA ;Clear the accumulator. Subtract the value in the TEMP SBM ;COUNTER from zero to obtain two's complement. LMA ;Place this back in counter location as ARRAY TOKEN JMP FUNAR4 ;VALUE (negative). Go place the value on F/A STACK. ;;; The label OUTRNG STARTS AT 55 136 OUTRNG: LAI 317 ;Load the ASCII code for letter 0 into the accumulator LCI 322 ;Load the ASCII code for letter R into register C JMP ERROR ;Go display Out of Range (OR) error message. ARRAY: CAL RESTSY ;Transfer contents of AUX SYMBOL BUFFER into the JMP ARRAY2 ;SYMBOL BUFFER. (Entry when have actual LET) ARRAY1: LLI 202 ;Load L with address of SCAN pointer JMP ARRAY3 ;Proceed to process. (Entry point for IMPLIED LET) ARRAY2: LLI 203 ;Load L with address of LET pointer ARRAY3: LHI \HB\OLDPG26 ;** Set H to pointer page LBM ;Fetch pointer to location where "(" found in statement INB ;Line. Increment it to point to next character in the line. LLI 276 ;Load L with address of EVAL pointer and load it with LMB ;The starting address for the EVAL routine LLI 206 ;Change L to address of ARRAY SETUP pointer LMB ;And also store address in that location ARRAY4: LLI 206 ;Load L with address of ARRAY SETUP pointer CAL GETCHR ;Fetch character pointed to by ARRAY SETUP pntr CPI 251 ;See if character is ")" ? If so, then have located JTZ ARRAY5 ;End of the subscript. If not, reset LLI 206 ;to the ARRAY SETUP pointer. Increment the CAL LOOP ;Pointer and test for the end of the statement line. JFZ ARRAY4 ;If not end of line, continue looking for right paren. LAI 301 ;If reach end of line before right parenthesis than load LCI 306 ;ASCII code for letters A and F and display message JMP ERROR ;Indicating Array Forrnat (AF) error condition ARRAY5: LLI 206 ;Load L with address of ARRAY SETUP pointer LBM ;Fetch pointer (pointing to ")"sign) into register B DCB ;Decrement it to move back to end of subscript number LLI 277 ;Load L with address of EVAL FINISH pointer location LMB ;Place the pointer value in the EVAL FINISH pointer LLI 207 ;Load L with address of LOOP COUNTER LMI 000 ;Initialize LOOP COUNTER to value of zero ARRAY6: LLI 207 ;Load L with address of LOOP COUNTER LHI \HB\OLDPG26 ;** Load H with page of LOOP COUNTER LBM ;Fetch the counter value INB ;Increment it LMB ;Restore the counter value to memory LCI 002 ;Set up counter in register C for future ops LLI 114 ;Load L with address of start of ARRAY VARIABLES LHI \HB\OLDPG27 ;** Table less four). Set H to page of the table. CAL TABADR ;Calculate the address of next entry in the table LEI 120 ;Load register E with starting address of SYMBOL BUFF LDI \HB\OLDPG26 ;** Set D to page of SYMBOL BUFFER CAL STRCP ;Compare entry in table against contents of SYMBOL BF JTZ ARRAY7 ;If match, have found array naine in the table. LLI 207 ;Else, set L to address of the LOOP COUNTER LHI \HB\OLDPG26 ;** Set H to page of the LOOP COUNTER LAM ;Fetch the counter value to the ACC LLI 075 ;Change L to the counter containing number of arrays LHI \HB\OLDPG27 ;** Set H to the proper page CPM ;Compare number of arrays to count in LOOP CNTR JFZ ARRAY6 ;If more entries in the table, continue looking for match JMP FAERR ;If no matching name in table then have an error condx. ARRAY7: CAL EVAL ;Call subroutine to evaluate subscript expression CAL FPFIX ;Convert the subscript value obtained to fixed forrnat LLI 207 ;Load L with address of LOOP COUNTER LHI \HB\OLDPG26 ;** Set H to page of the LOOP COUNTER LBM ;Fetch the value in the LOOP COUNTER into the ACC LCI 002 ;Set up counter in register C future ops LLI 114 ;Load L with address of ARRAY VARIABLES LHI \HB\OLDPG27 ;** Table less four). Set H to page of the table. CAL TABADR ;Calculate the address of entry in the table INL ;Advance the ARRAY VARIABLES table pointer twice INL ;To advance pointer over array name. LCM ;Fetch array base address in ARRAY VALUES table LLI 124 ;Load L with address of subscript value LHI \HB\OLDPG1 ;** Set H to page of subscript value LAM ;Fetch the subscript value into the accumulator SUI 001 ;Subtract one from subscript value to allow for zero RLC ;Origin. Now multiply by four RLC ;Using rotates (number of bytes required for each entry ADC ;In the ARRAY VALUES table). Add in base address to LLI 204 ;The calculated value to form final address in the LHI \HB\OLDPG27 ;** ARRAY VALUES table. Now set H & L to TEMP LMA ;ARRAY ELEMENT storage location & store the addr. LLI 201 ;Change L to point to ARRAY FLAG LMI 377 ;Set the ARRAY FLAG for future use RET ;Exit to calling routine ;;; The label DIM SHOULD START AT 55 365 DIM: CAL CLESYM ;Initialize the SYMBOL BUFFER to cleared condition LLI 202 ;Load L with address of SCAN pointer LBM ;Fetch SCAN pointer value into register B INB ;Add one to the SCAN pointer value LLI 203 ;Change L to DIM pointer (formerly TOKEN) storage LMB ;Store the updated SCAN pointer as the DIM pointer DIM1: LLI 203 ;Load L with the address of DIM pointer storage location CAL GETCHR ;Fetch a character from the line input buffer JTZ DIM2 ;If character fetched is a space, ignore it CPI 250 ;Else see if character is "(" left parenthesis JTZ DIM3 ;If so, should have ARRAY VARIABLE naine in buffer CAL CONCTS ;If not, append the character to the SYMBOL BUFFER DIM2: LLI 203 ;Load L with the address of DIM pointer stomge location CAL LOOP ;Increment the pointer and see if end of line JFZ DIM1 ;If not end of line, fetch next character JMP DIMERR ;Else have a DIMension error condition DIM3: LLI 206 ;Load L with address of ARRAY pointer storage loc LMI 000 ;Initialize ARRAY pointer to starting value of zero DIM4: LLI 206 ;Load L with address of ARRAY pointer storage loc LHI \HB\OLDPG26 ;** Set H to page of ARRAY pointer storage location LAM ;Fetch value in ARRAY pointer to ACC (effectively RLC ;Represents number of arrays defined in pgm). Rotate RLC ;Left twice to multiply by four (niunber of bytes per ADI 114 ;entry in ARRAY VARIABLES table). Add to base LHI \HB\OLDPG27 ;** Address to form pointer to ARRAY VARIA.BLES LLA ;Table and set up H & L as the memory pointer. LEI 120 ;Load E with starting address of the SYMBOL BUFFER LDI \HB\OLDPG26 ;** Load D with the page address of the SYMBOL BUFF CAL STRCP ;Compare contents of SYMBOL BF to entry in ARRAY JTZ DIM9 ;VARIABLES table. If same, have duplicate array name. LLI 206 ;Else, load L with address of ARRAY pointer storage LHI \HB\OLDPG26 ;** Load H with page of ARRAY pointer storage LBM ;Fetch the ARRAY pointer value to register B INB ;Increment the value LMB ;Restore it to ARRAY pointer storage location LLI 075 ;Change L to number of arrays storage location LHI \HB\OLDPG27 ;** Set H to page of the number of arrays stomge loc LAM ;Fetch the number of arrays value to the ACC DCB ;Restore B to previous count CPB ;Compare number of arrays tested against nr defined JFZ DIM4 ;If not equal, continue searching ARRAY VARIABLES LLI 075 ;Table. When table searched with no match, then must LHI \HB\OLDPG27 ;** Append naine to table. First set pointer to number LBM ;Of arrays storage location. Fetch that value and INB ;Add one to account for new name being added. LMB ;Restore the updated value back to memory. LLI 076 ;Change pointer to ARRAY TEMP pointer storage LMB ;Store pointer to current array in ARRAY TEMP too. LLI 206 ;Load L with address of ARRAY pointer stomge loc. LHI \HB\OLDPG26 ;** Set H to page of ARRAY pointer storage location LMB ;And update it also for new array being added. LAM ;Fetch the current ARRAY pointer value to the ACC RLC ;Multiply it times four by performing two rotate left RLC ;Operations and add it to base value to form address in ADI 114 ;The ARRAY VARIABLES table. Place the low part LEA ;Of this calculated address value into register E. LDI \HB\OLDPG27 ;** Set register D to the page of the table. LLI 120 ;Load L with the start of the SYMBOL BUFFER LHI \HB\OLDPG26 ;** Load H with the page of the SYMBOL BUFFER CAL MOVEC ;Move the array name from the SYMBOL BUFFER to CAL CLESYM ;The ARRAY VARIABLES table. Then clear the LLI 203 ;SYMBOL BUFFER. Reset L to the DIM pointer storage LHI \HB\OLDPG26 ;** Location. Set H to the DIM pointer page. LBM ;Fetch the pointer value (points to "(" part of DIM INB ;Statement). Increment the pointer to next character in LLI 204 ;The line input buffer. Cbange L to DIMEN pointer. LMB ;Store the updated DIM pointer in DIMEN storage loc. DIM5: LLI 204 ;Set L to DIMEN pointer storage location CAL GETCHR ;Fetch character in line input buffer JTZ DIM6 ;Ignore character for space CPI 251 ;If not space, see if character is right parenthesis JTZ DIM7 ;If yes, process DIMension size (array length) CPI 260 ;If not, see if character is a valid decimal number JTS DIMERR ;If not valid number, have DIMension error condition CPI 272 ;Continue testing for valid decitnal number JFS DIMERR ;If not valid number, then DIMension error condition CAL CONCTS ;If valid decirnal number, append digit to SYMBOL BF DIM6: LLI 204 ;Set L to DIMEN pointer storage location CAL LOOP ;Advance the pointer value and check for end of the line JFZ DIM5 ;If not end of line, continue fetching DIMension size JMP DIMERR ;If end of line before right parenthesis, have error condx. DIM7: LLI 120 ;Load L with address of start of SYMBOL BUFFER LHI \HB\OLDPG26 ;** Load H with page of SYMBOL BUFFER. (Now CAL DINPUT ;Contains DIMension size.) Convert buffer to floating CAL FPFIX ;Point number and then reformat to fixed point. LLI 124 ;Load L with address of LSW of fixed point number LAM ; And fetch the low order byte of the nr into the ACC RLC ;Rotate it left two tirnes to multiply it by four (the RLC ;Number of bytes required to store a floating point nr). LCA ;Store this value in CPU register C temporarily LLI 076 ;Set L to ARRAY TEMP storage location. LHI \HB\OLDPG27 ;** Set H to ARRAY TEMP pointer page. LAM ;Fetch the value in ARRAY TEMP (points to ARRAY SUI 001 ;VARIABLES table). Subtract one from the pointer RLC ;Value and multiply the result by four using rotate left RLC ;Instructions. Add this value to a base address ADI 122 ;(Augmented by two) to point to ARRAY VALUES LLA ;Pointer storage location in the ARRAY VARIABLES LHI \HB\OLDPG27 ;Table and set the pointer up in registers H & L. LBM ;Fetch the starting address in the ARRAY VALUES ADI 004 ;Table for the previous array into register B. Now add LLA ;Four to the ARRAY VARIABLES table pointer to LAB ;Point to curront ARRAY VALUES starting address. ADC ;Add the previous array starting address plus number of LMA ;Bytes required and store as starting loc for next array DIM8: LLI 204 ;Set L to address of DIMEN pointer storage location LHI \HB\OLDPG26 ;** Set H to page of DIMEN pointer LBM ;Fetch pointer value (points to ") " in line) LLI 203 ;Change L to DIM pointer storage location LMB ;Store former DIMEN value back in DIM pointer DIM9: LLI 203 ;Load L with address of DIM pointer storage location CAL GETCHR ;Fetch a character from the line input buffer CPI 254 ;See if character is a comma (,) sign JTZ DIM10 ;If yes, have another array being defined on the line LLI 203 ;If not, reset L to the DIM pointer CAL LOOP ;Increment the pointer and see if end of the line JFZ DIM9 ;If not end of the line, keep looking for a comma JMP NXTLIN ;Else exit the DIM statement routine to continue pgm DIM10: LLI 203 ;Set L to DIM pointer storage location LBM ;Fetch pointer value (points to comma sign just found) LLI 202 ;Load L with address of SCAN pointer storage location LMB ;Place DIM pointer into the-SCAN pointer JMP DIM ;Continue processing DIM statement line for next array DIMERR: LAI 304 ;On error condition, load ASCII code for letter D in ACC LCI 305 ;And ASCII code for letter E in CPU register C JMP ERROR ;Go display the Dirnension Error (DE) message.