** *** FORMULA OPERATOR JUMP TABLE ** ** AROTB DEF ESCMA SUBSCRIPT SEPARATOR DEF ESTR ASSIGNMENT OPERATOR DEF EFAD '+' DEF EFSB '-' DEF EFMP '*' DEF EFDV '/' DEF EPWR '^' DEF EGTRT '>' DEF ELST '<' DEF ENEQL '#' DEF EEQL '=' DEF EUMIN UNARY '-' DEF ELBRC '[' DEF FOR1A,I '(' DEF FOR0B,I UNARY '+' DEF EOR OR DEF EAND AND DEF ENOT NOT DEF EGORE '>=' DEF ELORE '<=' ** *** EXECUTE A BINARY OPERATOR ** ** BINOP NOP SAVE LDA BINOP,I SUBROUTINE STA BINO1 CALL ISZ BINOP SET RETURN ADDRESS JSB OPCHK SAVE ADDRESS OF STB BINO2 TOP OPERAND ISZ HSTPT UNSTACK ADDRESS JSB STTOP LOAD SECOND OPERAND BINO1 NOP PERFORM OPERATION BINO2 NOP ADDRESS OF SECOND OPERAND JMP BINOP,I SKP ** *** EXECUTE SUBSCRIPT COMMA ** ** ESCMA JSB ESBS INTEGERIZE COLUMN SUBSCRIPT ISZ LSTPT JSB ESBS INTEGERIZE ROW SUBSCRIPT LDB HSTPT,I FETCH ADB .2 SUBSCRIPT LDA 1,I ROUNDS AND MSK0 SAVE STA OUTLN COLUMN BOUND LDA 1,I EXTRACT ALF,ALF ROW AND MSK0 BOUND CMA,INA ACTUAL ADA LSTPT,I ROW SUBSCRIPT SSA,RSS LEGAL? JMP E6-1 NO LDA OUTLN YES CPA .1 COLUMN MATRIX? JMP ESCM1 YES JSB MPY NO, COMPUTE ADDRESS DEF LSTPT,I DISPLACEMENT RSS DUE TO ROWS ESCM1 LDA LSTPT,I CCB UNSTACK ADB LSTPT ROW STB LSTPT SUBSCRIPT LDB OUTLN ACTUAL CMB,INB COLUMN ADB LSTPT,I SUBSCRIPT SSB,RSS LEGAL? JSB ERROR NO E6 ADA LSTPT,I YES, ADD IN COLUMN DISPLACEMENT ALS DOUBLE DISPLACEMENT LDB HSTPT,I COMPUTE ADA 1,I ACTUAL STA HSTPT,I ADDRESS LDB LSTPT UNSTACK ADB M1 STB LSTPT ( JMP FOR1A,I ** *** INTEGERIZE A SUBSCRIPT ** ** ESBS NOP JSB OPCHK VALIDATE SUBSCRIPT LDA 1,I FETCH INB SUBSCRIPT LDB 1,I JSB SBFIX INTEGERIZE STB LSTPT,I SAVE IN OPERATOR STACK ISZ HSTPT POP OPERAND STACK JMP ESBS,I SKP ** *** EXECUTE STORE ** ** ESTR LDB TEMPS+7 IS NEXT OPERATOR SZB AN END-OF-FORMULA? JMP FOR1B,I NO, DEFER STORE CPB TEMPS+6 YES, FIRST STORE OPERATOR USED? JMP ESTR2 YES ESTR1 LDA HSTPT,I SET STA TEMPS+9 DESTINATION LDA TEMPS+6 SOURCE ADDRESS IN (A) LDB 0,I TRANSFER HIGH STB TEMPS+9,I PART OF SOURCE ISZ TEMPS+9 UPDATE INA POINTERS LDB 0,I TRANSFER LOW STB TEMPS+9,I PART OF SOURCE ISZ HSTPT POP STACK JMP FOR0B,I ESTR2 JSB OPCHK SAVE ADDRESS STB TEMPS+6 OF QUANTITY ISZ HSTPT YES, POP HIGH-CORE JMP ESTR1 STACK AND EXECUTE STORE ** *** CALL ADD ** ** EFAD JSB BINOP JSB .FAD JMP FOR0A,I ** *** CALL SUBTRACT ** ** EFSB JSB BINOP JSB .FSB JMP FOR0A,I ** *** CALL MULTIPLY ** ** EFMP JSB BINOP JSB .FMP JMP FOR0A,I ** *** CALL DIVIDE ** ** EFDV JSB BINOP JSB .FDV JMP FOR0A,I ** *** EXECUTE ^ ** ** EPWR LDB HSTPT,I LOAD LDA 1,I INB POWER LDB 1,I JSB IFIX JMP *+3 SOS INTEGER? JMP EPWR1 YES JSB BINOP NO JMP RPWR RPWR JSB PCHK CHECK ARGUMENTS SSA NEGATIVE BASE? JSB ERROR YES BASER EQU * LDB BINO1 NO, LOAD BASE JSB .LOGA,I TAKE NATURAL LOG JSB .FMP MULTIPLY DEF BINO2,I BY POWER JSB .EXPA,I EXPONENTIATE JMP FOR0A,I RESULT EPWR1 STB TT1 SAVE SIGN SSB SAVE CMB,INB ABSOLUTE VALUE STB TT2 OF POWER JSB BINOP JMP IPWR IPWR JSB PCHK CHECK ARGUMENTS LDB BINO1 STORE STA BINO1 STB BINO2 BASE LDA HONE INITIALIZE STA TT3 RESULT LDA .2 TO STA TT4 1.0 IPWR1 LDB TT2 DIVIDE POWER SLB,BRS BY 2 JMP IPWR3 WAS ODD STB TT2 WAS EVEN IPWR2 SZB ZERO? JMP IPWR4 NO LDA TT1 YES SSA POSITIVE POWER? JMP IPWR5 NO LDA TT3 YES,LOAD LDB TT4 RESULT JMP FOR0A,I IPWR5 LDA HONE LOAD LDB .2 1.0 JSB .FDV DIVIDE BY DEF TT3 RESULT JMP FOR0A,I IPWR3 STB TT2 SAVE POWER LDA BINO1 LOAD LDB BINO2 BASE JSB .FMP MULTIPLY BY DEF TT3 RESULT-SO-FAR STA TT3 SAVE PARTIAL STB TT4 RESULT LDB TT2 LOAD POWER JMP IPWR2 IPWR4 LDA BINO1 LOAD LDB BINO2 BASE JSB .FMP SQUARE DEF BINO1 IT STA BINO1 SAVE STB BINO2 RESULT JMP IPWR1 ** *** INSURE VALID OPERATION ** ** PCHK NOP STB BINO1 LOAD LDB BINO2,I POWER SZA BASE ZERO? JMP PCHK1 NO SZB,RSS YES, POWER ZERO? JSB ERROR YES POWER EQU * SSB,RSS NO, POWER POSITIVE? JMP FALSE YES JSB ERROR NO ZRTNG LDA INF USE POSITIVE LDB M2 INFINITY JMP FOR0A,I PCHK1 SZB,RSS POWER ZERO? JMP TRUE YES, RETURN 1.0 JMP PCHK,I NO ** *** EXECUTE > ** ** EGTRT JSB BINOP COMPUTE OPERAND JSB .FSB DIFFERENCE SSA NEGATIVE? JMP FALSE YES JMP ENEQ1 NO ** *** EXECUTE < ** ** ELST JSB BINOP COMPUTE OPERAND JSB .FSB DIFFERENCE SSA NEGATIVE? JMP TRUE YES JMP FALSE NO ** *** EXECUTE = ** ** EEQL JSB BINOP COMPUTE OPERAND JSB .FSB DIFFERENCE EEQL1 SZA ZERO? JMP FALSE NO JMP TRUE YES SKP ** *** EXECUTE >= ** ** EGORE JSB BINOP COMPUTE OPERAND JSB .FSB DIFFERENCE SSA POSITIVE? JMP FALSE NO JMP TRUE YES ** *** EXECUTE <= ** ** ELORE JSB BINOP COMPUTE OPERAND JSB .FSB DIFFERENCE SSA NEGATIVE? JMP TRUE YES JMP EEQL1 NO ** *** EXECUTE # ** ** ENEQL JSB BINOP COMPUTE OPERAND JSB .FSB DIFFERENCE ENEQ1 SZA NON-ZERO? JMP TRUE YES ** *** SET LOGICAL VALUES ** ** FALSE CLA LOAD CLB ZERO JMP FOR0A,I TRUE LDA HONE LOAD LDB .2 ONE JMP FOR0A,I ** *** EXECUTE UNARY - ** ** EUMIN JSB STTOP LOAD NUMBER JSB ARINV NEGATE NUMBER JMP FOR0A,I ** *** EXECUTE LEFT BRACKET ** ** ELBRC ISZ LSTPT LOAD SUBSCRIPT COMMA LDB SCCNT INFORMATION WORD JSB SLWST STACK IT JSB BHSTP STACK JSB RSCHK JMP TRUE 1 ** *** EXECUTE OR ** ** EOR JSB BINOP VALIDATE JMP ORS OPERANDS ORS SZA SECOND OPERAND NON-ZERO? JMP TRUE YES ORS1 LDA BINO2,I NO, CHECK SECOND JMP ENEQ1 OPERAND ** *** EXECUTE AND ** ** EAND JSB BINOP VALIDATE JMP ANDS OPERANDS ANDS SZA,RSS SECOND OPERAND ZERO? JMP FALSE YES JMP ORS1 NO ** *** EXECUTE NOT ** ** ENOT JSB STTOP LOAD OPERAND SZA ZERO? JMP FALSE NO JMP TRUE YES ** *** ADD TWO FLOATING POINT QUANTITIES ** ** ADMUP NOP LDA OUTLN COMPUTE ADMU1 CMA,INA EXPONENT ADA EXP DIFFERENCE SSA,RSS ARG 1 LARGER? JMP ADMU2 YES LDA A1 NO, LDB A2 SWAP STA A2 ARGUMENTS STB A1 LDA C1 LDB C2 STA C2 STB C1 LDA EXP LDB OUTLN STA OUTLN STB EXP JMP ADMU1 ADMU2 ADA M25 SHIFT COUNT >= LDB C1 SSA,RSS 25 ? JMP ADMU4 YES, IGNORE SMALLER ARGUMENT CMA,CLE NO, COMPUTE ADA M25 SHIFT COUNT STA OUTLN AS NEGATIVE LDA A2 LOAD SMALLER LDB C2 MANTISSA ADMU3 ISZ OUTLN MORE SHIFTS? JMP ADMU5 YES ADB C1 NO, ADD LOW MANTISSAS CLO RBR,ELB SAVE (E) IN B(0) CLE ADA A1 ADD HIGH MANTISSAS SLB OVERFLOW FROM LOWER MANTISSA? INA YES, ADD IT IN ERB,CLE,ELB ERASE B(0) SOS OVERFLOW? JMP ADMU4+1 NO ERA YES, SHIFT ERB MANTISSA DOWN AND ISZ EXP CORRECT EXPONENT JMP ADMU4+1 RSS ADMU4 LDA A1 RETRIEVE HIGH MANTISSA JSB .PACK NORMALIZE AND PACK JMP ADMUP,I ADMU5 CLE,SLA,ARS ARITHMETIC CME DOUBLE ERB,CLE SHIFT JMP ADMU3 ** *** ADD TWO FLOATING POINT NUMBERS ** ** .FAD NOP JSB UNPAK UNPACK THE ARGUMENTS JSB ADMUP ADD THEM UP JMP .FAD,I ** *** SUBTRACT TWO FLOATING POINT NUMBERS ** ** .FSB NOP JSB UNPAK UNPACK THE ARGUMENTS LDA A2 TWO'S COMPLEMENT CMA THE SECOND ARGUMENT CMB,INB,SZB LOW PART ZERO? JMP .FSB1 NO SSA,INA,RSS YES, ORIGINAL NUMBER NEGATIVE? SSA,RSS YES, STILL NEGATIVE? JMP .FSB1 NO RAR YES, SHIFT DOWN AND ISZ OUTLN CORRECT EXPONENT .FSB1 STB C2 SAVE COMPLEMENTED STA A2 NUMBER JSB ADMUP ADD ARGUMENTS JMP .FSB,I ** *** UNPACK ARGUMENTS FOR ARITHMETIC OPERATIONS ** ** UNPAK NOP STA A1 SAVE HIGH PART OF ARG 1 SZA,RSS UNPACK CLB,INB SECOND JSB .FLUN WORD STB C1 SAVE LOW PART OF ARG 1 STA EXP SAVE EXPONENT OF ARG 1 LDA UNPAK COMPUTE ADDRESS OF ADA M2 CALLING ROUTINE LDB 0,I ISZ 0,I SET CALLING ROUTINE'S RETURN LDB 1,I LOAD RBL,CLE,SLB,ERB ADDRESS OF JMP *-2 ARG 2 LDA 1,I LOAD INB ARG 2 LDB 1,I STA A2 SAVE HIGH PART OF ARG 2 SZA,RSS UNPACK CLB,INB SECOND JSB .FLUN WORD STB C2 SAVE LOW PART OF ARG 2 STA OUTLN SAVE EXPONENT OF ARG 2 JMP UNPAK,I ** *** MULTIPLY TWO FLOATING POINT NUMBERS ** ** .FMP NOP UNPACK THE JSB UNPAK ARGUMENTS ADA EXP ADD EXPONENTS INA PLUS 1 FOR STA EXP NORMALIZATION RBR POSITION LOW PART OF ARG 2 LDA 1 COMPUTE A JSB MPY CROSS PRODUCT DEF A1 STA C2 SAVE RESULT LDA C1 LOAD AND POSITION RAR LOW PART OF ARG 1 STB C1 SAVE REST OF PRIOR RESULT JSB MPY COMPUTE SECOND DEF A2 CROSS PRODUCT ADB C1 ADD CLE CROSS ADA C2 PRODUCTS SEZ CORRECT INB FOR CARRY STB C2 SAVE RESULT LDA A1 COMPUTE JSB MPY HIGH PART DEF A2 OF PRODUCT CLE,ERA POSITION LOW PART ADA C2 ADD IN CROSS TERMS CLE,ELA REPOSITION SEZ,RSS CARRY FROM LOW PART? JMP *+4 NO SOC YES, POSITIVE CARRY? INB,RSS YES ADB M1 NO STA A1 EXCHANGE LDA 1 LDB A1 REGISTERS JSB .PACK NORMALIZE AND PACK JMP .FMP,I SKP ** *** PERFORM FLOATING DIVIDE ** ** .FDV NOP JSB UNPAK UNPACK ARGUMENTS LDB A2 DIVISOR SZB,RSS ZERO? JMP .FDV2 YES LDB A1 NO, DIVIDEND SZB,RSS ZERO? JMP .FDV1 YES CMA,INA NO, COMPUTE INA EXPONENT ADA EXP DIFFERENCE STA EXP PLUS 1 LDA C1 LOAD DIVIDEND CLE,SLB,BRS ARITHMETIC CME RIGHT SHIFT ERA TWICE TO CLE,SLB,BRS PREVENT CME DIVISION ERA OVERFLOW JSB IDIV DIVIDE STA OUTLN SAVE QUOTIENT BRS DIVIDE REMAINDER BY 2 TO CLA PREVENT DIVISION OVERFLOW JSB IDIV DIVIDE REMAINDER AND STA NUMCK SAVE LOW PART OF QUOTIENT LDB C2 CLA,CLE SCALE TO ERB,BRS PREVENT BRS OVERFLOW JSB IDIV COMPUTE B2/A2 = Q CMA,INA COMPUTE JSB MPY -HIGH QUOTIENT*Q DEF OUTLN BLS,CLE,ELB SHIFT SIGN TO (E) LDA NUMCK LOW QUOTIENT SSA NEGATIVE? CCA,RSS YES, SET (A)=-1 (EXTEND CLA NO, SET (A)=0 SIGN) CMA,SEZ IF (E)=1 SUBTRACT INA 1 AS EXTENSION CMA,CLE OF PRODUCT ADB NUMCK ADD IN LOW QUOTIENT SEZ CARRY INA INTO (A) CLE,ELB POSITION ELA REGISTERS ADA OUTLN ADD IN HIGH QUOTIENT RSS .FDV1 CLA SET MANTISSA TO ZERO JSB .PACK NORMALIZE AND PACK JMP .FDV,I .FDV2 JSB ERROR DIVIDE-BY-ZERO DBYZR LDA A1 JSB OVFLW RETURN INFINITY JMP .FDV,I ** *** INTEGER DIVIDE ** ** IDIV NOP DIVIDEND IN (B) AND (A) STB A1 SAVE HIGH DIVIDEND LDB A2 CLE,SSB SET (B) TO ABS(B) CMB,CME,INB AND (E) TO SIGN(B) STB .FAD SAVE POSITIVE DIVISOR CMB,INB SAVE STB .FSB NEGATIVE DIVISOR LDB M16 SET STB C1 COUNTER LDB M2 SET STB SIGN STB .FMP SIGNS LDB A1 RETRIEVE HIGH DIVIDENED SSB,RSS POSITIVE? JMP IDIV1 YES ISZ .FMP NO, SET REMAINDER SIGN CMB,CME NEGATIVE AND COMPLEMENT SZA THE DIVISOR CMA,INA,RSS AND (E) INB IDIV1 SEZ QUOTIENT POSITIVE? ISZ SIGN NO IDIV2 CLE,ELA SHIFT ELB DIVIDEND ADB .FSB SUBTRACT DIVISOR SSB,RSS OK? INA,RSS YES ADB .FAD NO, RESTORE DIVIDEND ISZ C1 DONE? JMP IDIV2 NO CMA,INA YES, NEGATE QUOTIENT ISZ SIGN RESULT TO BE POSITIVE? CMA,INA YES ISZ .FMP NO, REMAINDER POSITIVE? JMP IDIV,I YES CMB,INB NO JMP IDIV,I SKP * ****************************** * SYMBOL TABLE SEARCH SUBROUTINE * ****************************** * * THE SUBROUTINE IS CALLED WITH THE IDENTIFIER TO BE * SEARCHED FOR IN A . THE SUBROUTINE RETURNS WITH * THE ADDRESS OF THE MATCHING ENTRY IN B OR -1 IN * B IF THERE IS NO MATCHING ENTRY * THE FOLLOWING RULES APPLY WHEN SEARCHING FOR ARRAYS * * TYPE 1 (1 DIMENSION) SEARCH FOR CORRESPONDING TYPE 1 * OR TYPE 3 ARRAY. IF TYPE 3 IS FOUND CHANGE THE ENTRY * TYPE TO TYPE 1 * * TYPE 2 (2 DIMENSIONS) SEARCH FOR CORRESPONDING TYPES * OR TYPE 3 ARRAY. IF TYPE 3 IS FORND CHANGE THE ENTRY * TYPE TO TYPE 2 * * TYPE 3 (UNDIMENSIONED) SEARCH FOR CORRESPONDING * TYPE 3 OR TYPE 1 OR TYPE 2 ARRAY * SSYMT NOP STA STEMP STORE IDENTIFIER AND .15 ISOLATE IDENTIFIER TYPE ADA M4 SSA,INA JMP *+4 JUMP IF ARRAY TYPE LDA STEMP RESTORE A STA 1 STORE IN B JMP SYMT1+3 SSA SKIP IF UNDIMENSIONED JMP SYMT1 LDA STEMP RESTORE A AND MSK3 177771B SET TYPE TO 1 STA 1 INB SET TYPE IN B TO 2 JMP *+4 SYMT1 CCB SET DIMENSIONED FLAG IN B LDA .3 IOR STEMP SET TYPE TO UNDEFINED STA STEMP+1 STORE A STB STEMP+2 STORE B LDB SYMTF START OF SYMBOL TABLE JMP SYMT4 SYMT2 LDA 1,I PICK UP 1ST WORD OF ENTRY CPA STEMP COMPARE WITH IDENTIFIER JMP SSYMT,I MATCH ? RETURN CPA STEMP+1 COMPARE WITH DIFFERENT DIM. JMP SYMT3 CPA STEMP+2 COMPARE WITH DIFFERENT DIM. JMP SYMT3 LDA 1,I AND .15 ISOLATE ENTRY TYPE CPA .15 FUNCTION ? JMP *+5 YES ADA M4 SSA ARRAY ? INB YES INCREMENT POINTER INB INCREMENT POINTER ADB .2 ADD 2 TO POINTER SYMT4 CPB SYMTA SYMBOL TABLE EXHAUSTED? CCB,RSS YES JMP SYMT2 NO, CHECK NEXT ENTRY FOR MATCH LDA STEMP RETRIEVE SYMBOL JMP SSYMT,I RETURN WITH B NEGATIVE SYMT3 LDA STEMP RESTORE A ISZ STEMP+2 DIMENSIONED IDENTIFIER? RSS NO, SKIP STA 1,I YES CHANGE 1ST WORD OF ENTRY TO JMP SSYMT,I APPROPRIATE DIMENSION TYPE