* *** SUBROUTINE MATRIX REPLACE * REPLC NOP LDA REPLC STA GENER CLA CLB REPL1 STA MOD1 STB MOD1+1 CLA STA MOD2 STA MOD2+1 JSB LCHK2 JMP GEN2 SKP * *** SUBROUTINE MATRIX SCALAR MULTIPLY * SMULT NOP LDA SMULT STA GENER LDA LTIME LDB MBXL JMP REPL1 * *** SUBROUTINE MATRIX CON * LCON NOP LDA HONE LDB .2 LCON1 STA MLBX1 STB MLBX1+1 LDA B3+1 JSB MDIM ARS CMA,INA STA LPIV LDA MLBX1 LDB MLBX1+1 LCON2 STA B3,I ISZ B3 STB B3,I ISZ B3 ISZ LPIV JMP LCON2 JMP LCON,I * *** SUBROUTINE MATRIX ZERO * SZER NOP LDA SZER STA LCON CLA CLB JMP LCON1 * *** SUBROUTINE MATRIX IDN * LIDN NOP LDA B3 STA T9 JSB SZER LDA B3+1 ALF,ALF CPA B3+1 ALS,SLA JMP LERR AND MSK1 STA MLBX1 ARS CMA,INA STA MLBX1+1 LDB T9 STB B3 LIDN1 LDA HONE STA 1,I INB LDA .2 STA 1,I INB ADB MLBX1 ISZ MLBX1+1 JMP LIDN1 JMP LIDN,I * *** SUBROUTINES DLD AND DST * .DLD NOP JSB GETAD GET ADDRESS DEF .DLD,I ISZ .DLD BUMP RETURN ADDRESS LDA ADRES,I LOAD HIGH PART. ISZ ADRES LDB ADRES,I LOAD LOW PART. JMP .DLD,I .DST NOP JSB GETAD GET ADDRESS. DEF .DST,I ISZ .DST BUMP RETURN ADDRESS. STA ADRES,I STORE HIGH PART. ISZ ADRES STB ADRES,I STORE LOW PART. JMP .DST,I GETAD NOP COMPUTES EFFECTIVE ADDRESS. STA TINY SAVE A REGISTER. LDA GETAD,I GET POINTER TO ADDRESS. GET STA ADRES STORE IN ADRES. LDA TINY RESTORE A REGISTER. LDA ADRES,I RAL,CLE,SLA,ERA TEST FOR INDIRECT JMP GET IT IS INDIRECT. STA ADRES EFFECTIVE ADDRESS. LDA TINY ISZ GETAD RETURN JMP GETAD,I ADRES BSS 1 TINY BSS 1 * *** SUBROUTINE TRANSPOSE * TRAN NOP JSB LCHK2 TEST B1 FOR UNASSIGNED TERMS LDA B3+1 PARAMETERS OF B3 ALF,ALF INTERCHANGE ROW AND COLUMN LDB B1+1 PARAMETERS OF B1 JSB COMPR SUBROUTINE COMPARE JSB MPY DEF T3 STA LPIV PRODUCT OF ROW*COL LDA T4 CMA,INA STA T5 TRAN1 CLA STA T6 SET T6=0 LNEXT LDB T6 BLS ADB B1 LDA 1,I INB LDB 1,I STA B3,I ISZ B3 STB B3,I ISZ B3 LDA T6 SET T6=T6+T4 ADA T4 T6 POINTS TO NEXT TERM IN STA T6 A COLUMN TO BE TRANSPOSED CPA LPIV TEST FOR LAST IN COL JMP *+2 JMP LNEXT ISZ B1 ISZ B1 ISZ T5 JMP TRAN1 TRANSPOSE NEXT COL JMP TRAN,I EXIT TO MAIN PROGRAM * *** SUBROUTINE MATRIX MULTIPLY * MULT NOP JSB LCHK1 TEST B1,B2 FOR UNASSIGNED TERMS LDA B3+1 PARAMETERS OF B3 AND MSK0 STA T6 LDA B2+1 AND MSK0 CPA T6 RSS JMP LERR LDA B3+1 PARAMETERS OF B3 AND M256 STA 1 STORE ROW IN MSP OF B LDA B2+1 PARAMETERS OF B2 ALF,ALF AND MSK0 ADA 1 COMBINE A AND B LDB B1+1 PARAMETERS OF B1 JSB COMPR COMPARE ROW AND COL LDA B2 MULT STA T5 LDA T3 CMA,INA STA T9 MULT4 LDA T6 CMA,INA STA T10 LDA T5 STA B2 RESTORE BASE ADDRESS B2 MULT3 CLA STA T11 COUNTER FOR B2. INCR BY STA T12 COUNTER FOR B1. INCR BY 2 CLB JSB .DST CLEAR TO ZERO DEF B3,I MULT2 LDB B1 COMPUTE PROD OF ONE TERM ADB T12 IN ROW BY ONE TERM IN COL STB T18 LDB B2 ADB T11 JSB .DLD DEF 1,I JSB .FMPA,I DEF T18,I JSB .FADA,I COMPUTES RUNNING SUM DEF B3,I JSB .DST DEF B3,I ISZ T12 SELECT NEXT TERM IN ROW ISZ T12 LDA T6 SELECT NEXT TERM IN COL ALS ADA T11 STA T11 LDA T4 ALS CPA T12 JMP *+2 JMP MULT2 MULT AND ADD IN NEXT TERM ISZ B3 INCR RECEIVING MAT ISZ B3 ISZ B2 BASE ADDRESS OF NEXT COL ISZ B2 ISZ T10 JMP MULT3 COMPUTE SAME ROW*NEXT COL LDA T4 ALS ADA B1 STA B1 ADDRESS OF NEXT ROW ISZ T9 COUNTER FOR ROW IN B1 JMP MULT4 MULT ROW BY ALL COLUMNS JMP MULT,I EXIT TO MAIN PROGRAM SKP * *** SUBROUTINE MATRIX INVERT * LINV NOP SUBROUTINE MATRIX INVERT JSB LCHK2 TEST B1 FOR UNASSIGNED TERMS LDA B1+1 DIMENSIONS OF MATRIX B1 LDB B3+1 DIMENSIONS OF MATRIX B3 JSB COMPR CHECK DIMENSIONS LDA B3 STA T13 LDA B1+1 JSB MDIM CMA,INA ARS STA T2 ALS LDB LSTPT INB STB B2 STB B3 CMB,INB ADB HSTPT ADA 1 SSA SKIP IF SUFFICIENT CORE JMP E1 PRINT 'OUT OF CORE' JSB REPLC COPY B1 INTO B3 (B2) LDA T13 STA B3 RESTORE ADDRESS JSB LIDN SET B3 TO IDENTITY MATRIX LDA T13 STA B3 LSTPT+1 CLA STA T12 T12,T13 IS STORE STA T13 FOR GREATEST VALUE LDA B2 COPY B2 INTO B1 AS STA B1 B2 NEEDED LATER LIN11 LDA B1,I ISZ B1 LDB B1,I ISZ B1 SSA GET ABSOLUTE VALUE JSB ARINV IF NUMBER IS NEGATIVE STA T18 SAVE NUMBER STB T19 JSB .FSBA,I SUBTRACT EXISTING MAX. DEF T12 VALUE SSA SKIP AND SWAP IF POSITIVE JMP LIN10 LDA T18 SWAP LDB T19 STA T12 STB T13 LIN10 ISZ T2 JMP LIN11 LDA T12 COMPUTE RELATIVE TOLERANCE LDB T13 TOL=ABSOLUTE TOL * MAX VALUE JSB .FMPA,I DEF T16 ABSOLUTE TOLERANCE STA MLBX1 STB MLBX1+1 CLA STA LPIV ISZ T4 REQUIRE CONSTANT (ROW+1) LINV1 ISZ LPIV SELECT NEXT PIVOT LDA LPIV TEST IF HAVE PROCESSED CPA T4 LAST PIVOT JMP LINV,I NORMAL EXIT TO MAIN PROG LDA LPIV COMPUTE ADDRESS OF PIVOT LDB LPIV COLUMN USING ROUTINE LWHR STA T2 ROW COUNTER JSB LWHR ON RETURN, ADDRESS IN A STA T1 CLA STA T12 T12,T13 IS STORE STA T13 FOR GREATEST VALUE LINV2 JSB .DLD LOAD FP NUMBER DEF T1,I SSA OBTAIN ABSOLUTE VALUE JSB ARINV IF NUMBER IS NEGATIVE STA T18 STORE VALUE OF FP NUMBER STB T19 JSB .FSBA,I SUBTR EXISTING LARGEST VALUE DEF T12 SSA SKIP AND SWAP IF POSITIVE JMP LINV7 T12 STILL CONTAINS MAX VALUE LDA T18 STORE NEW MAX VALUE LDB T19 STA T12 STB T13 LDA T2 SET T5 TO POSITION IN STA T5 COLUMN OF MAX VALUE LINV7 ISZ T2 LDA T2 TEST FOR LAST TERM IN COL CPA T4 JMP LINV8 SWAP ROWS LDA T3 COMPUTE ALS NEXT ADDRESS ADA T1 IN PIVOT STA T1 COLUMN JMP LINV2 SELECT NEXT TERM LINV8 LDA LPIV COMPUTE ADDRESS CLB,INB JSB LWHR STA T1 ADDRESS OF PIVOTAL ROW LDA T5 CLB,INB JSB LWHR STA T2 ADDR OF ROW TO BE SWAPPED LDA LPIV CLB,INB JSB LWHR2 PIVOTAL ROW IN I-MATRIX STA T9 STA T10 KEEP COPY LDA T5 CLB,INB JSB LWHR2 BE SWAPPED IN I-MATRIX STA T11 LDA T3 CMA,INA STA T12 COUNTER FOR TERMS IN A ROW LINV3 JSB .DLD SWAP ONE ELEMENT OF ROW DEF T1,I STA T18 STB T19 JSB .DLD DEF T2,I STA T1,I ISZ T1 STB T1,I ISZ T1 LDA T18 LDB T19 STA T2,I ISZ T2 STB T2,I ISZ T2 JSB .DLD SWAP ONE ELEMENT IN A ROW DEF T9,I OF I-MATRIX STA T18 STB T19 JSB .DLD DEF T11,I STA T9,I ISZ T9 STB T9,I ISZ T9 LDA T18 LDB T19 STA T11,I ISZ T11 STB T11,I ISZ T11 ISZ T12 INCREMENT COUNTER JMP LINV3 SWAP NEXT ELEMENT LDA LPIV COMPUTE LDB LPIV ADDRESS OF JSB LWHR PIVOT STA T1 ELEMENT JSB .DLD PIVOT VALUE DEF T1,I SSA OBTAIN ABSOLUTE VALUE JSB ARINV IF NUMBER IS NEGATIVE JSB .FSBA,I SUBTRACT TOLERANCE AND DEF MLBX1 SSA COMPARE TO ZERO JSB ERROR PRINT-NEARLY SING MATRIX' LDUM1 LDA T1 ADDRESS OF PIOT ELEMENT STA T2 LDA HONE LDB .2 JSB .FDVA,I DEF T1,I STA T18 INVERSE OF PIVOT STB T19 LDA LPIV STA T11 COUNTER FOR ROW LINV6 ISZ T11 INCREMENT COUNTER LDA T11 CPA T4 TEST FOR END OF ROW JMP LIN12 ISZ T2 ADDRESS OF NEXT ELEMENT ISZ T2 JSB .DLD DEF T2,I JSB .FMPA,I DEF T18 JSB .DST DEF T2,I JMP LINV6 LIN12 LDA T10 STA T5 IN I-MATRIX LDA T3 CMA,INA STA T11 ROW COUNTER LIN13 JSB .DLD DEF T5,I SZA,RSS SKIP MULTIPLICATION IF ZERO SZB JMP *+2 NOT ZERO JMP LIN14 ZERO JSB .FMPA,I DEF T18 JSB .DST DEF T5,I LIN14 ISZ T5 NEXT ELEMENT IN I-MATRIX ISZ T5 ISZ T11 INCREMENT COUNTER JMP LIN13 NO CLA STA B1 LINV4 ISZ B1 LDA B1 CPA T4 TEST FOR LAST ROW JMP LINV1 SELECT NEXT PIVOT CPA LPIV TEST TO SKIP PIVOTAL ROW JMP LINV4 SKIP PIVOTAL ROW LDA B1 CLB,INB JSB LWHR2 ADDRESSOF ROW TO BE TRANSFORMED STA T11 IN I-MATRIX LDA B1 LDB LPIV JSB LWHR STA T9 SAVE ADDRESS JSB .DLD DEF 0,I STA T7 VALUE OF MULTIPLIER STB T8 LDA LPIV STA T13 COUNTER LDA T1 STA T2 LINV5 ISZ T13 LDA T13 CPA T4 TEST FOR LAST TERM IN ROW JMP LIN15 ISZ T9 T9 IS ADDRESS OF ISZ T9 ELEMENT TO BE CHANGED ISZ T2 T2 IS ADDR OF CORRESPONDING ISZ T2 ELEMENT IN PIVOTAL ROW LDA T7 LDB T8 JSB .FMPA,I DEF T2,I STA T18 MULTIPLIER*VALUE IN STB T19 PIVOT ROW JSB .DLD DEF T9,I JSB .FSBA,I DEF T18 JSB .DST TRANSFORMED ELEMENT DEF T9,I JMP LINV5 SELECT NEXT TERM LIN15 LDA T10 ADDRESS OF STA T5 PIVOTAL ROW LDA T3 CMA,INA STA T13 COUNTER LIN18 LDA T5,I ISZ T5 LDB T5,I ISZ T5 SZA,RSS SKIP IF ZERO SZB JMP *+2 NOT ZERO JMP LIN17 ZERO JSB .FMPA,I MULTIPLY BY DEF T7 MULTIPLIER STA T18 STB T19 JSB .DLD DEF T11,I JSB .FSBA,I DEF T18 JSB .DST DEF T11,I LIN17 ISZ T11 ISZ T11 ISZ T13 JMP LIN18 SELECT NEXT TERM JMP LINV4 ELIMINATE NEXT ROW SKP * *** SUBROUTINE LWHR * LWHR NOP STB T7 ADA M1 JSB MPY DEF T3 ADA T7 ADA M1 ALS ADA B2 JMP LWHR,I LWHR2 NOP STB T7 ADA M1 JSB MPY ADDR=LWHR3+2((A-1)*T3+B-1) DEF T3 ADA T7 ADA M1 ALS ADA B3 JMP LWHR2,I * *** CONSTANTS * T1 BSS 1 TEMPORARY CONSTANTS T2 BSS 1 T3 BSS 1 T4 BSS 1 T5 BSS 1 T6 BSS 1 T7 BSS 1 T8 BSS 1 T9 BSS 1 T10 BSS 1 T11 BSS 1 T12 BSS 1 T13 BSS 1 T16 DEC +1E-6 ABSOLUTE TOLERANCE T18 BSS 1 T19 BSS 1 LPIV BSS 1 LPLUS JSB .FADA,I GENERATES CODE DEF B2,I LMIN JSB .FSBA,I GENERATES CODE LTIME JSB .FMPA,I GENERATES CODE INCB2 ISZ B2 GENERATES CODE ** *** FETCH MAT STATEMENT SUBSCRIPT ** ** MATSB NOP LDB M2 LEFT PARENTHESIS JSB SYMCK OR DEF LBRAC-1 LEFT BRACKET? JMP MATSB,I NO ISZ MATSB YES, SET RETURN ADDRESS LDA B2200 STA SBPTR,I BRACKET JSB FSC&,I CCB JSB SYMCK COMMA? DEF COMMA-1 RSS NO JSB FSC&,I LDB M2 RIGHT PARENTHESIS JSB SYMCK OR DEF RPARN-1 RIGHT BRACKET JMP FSCA&,I LDA LF STA SBPTR,I BRACKET ISZ SBPTR JSB GETCR END-OF-STATEMENT? JMP ACCST,I YES JMP MATSB,I FSCA& DEF FSCE2 FSC& DEF FSC FINIS EQU * END 22255-80017 D