      SKP *                                  ***  SET UP MATRIX INITIALIZATION  ***                                  *      LDB TEMP1       INB       CPB PRGCT     REDIMENSIONING?       RSS           NO      JSB REDIM     YES INVL  LDA BS1,I     COMPUTE       STA ID1         NUMBER      ISZ BS1           OF ELEMENTS       MPY BS1,I           IN 2'S      CMA,INA               COMPLEMENT      STA MCNT      SAVE IT       ISZ ID0       'IDN' ?       JMP EMAT7     NO      LDA BS1,I     YES       CPA ID1       SQUARE MATRIX?      CMA,RSS       YES       JSB RERRS+24,I  NO      STA ID0       SET       CCA             DIAGONAL      STA ID1           COUNTER       LDA IDNA      LOAD OPERATION JUMP       JMP *+4 EMAT7 LDA MLP3A     RECORD      LDB F1.0A       CORRECT CONSTANT:       ISZ ID0           0.0 FOR 'ZER'       LDB F0.0A         1.0 FOR 'CON'       STB BS2           0.0 FOR 'IDN'       STA MOP       RECORD OPERATION JUMP       JMP MLOOP-1 * EMAT8 ISZ TEMP1     COMPUTE       LDA TEMP1,I       AND OPDMK       POINTER       ALS       ADA SYMTB         TO      ADA .-1       LDB 0,I             SOURCE      ADB .-2       STB BS2               MATRIX      JSB VCHK      VALIDATE IT       LDB BS1,I     LOAD DESTINATION ROW DIMENSION      BLS           SAVE COLUMN       STB MMT3        ADVANCE AMOUNT      BRS       ISZ BS1       LDA BS1,I     ARE COLUMNS OF DESTINATION      CPA BS2,I       AND ROWS OF SOURCE EQUAL?       CMA,INA,RSS   YES       JSB RERRS+11,I  NO      STA MMT1      SAVE DESTINATION MATRIX       STA MMT2        COLUMN COUNTERS       ISZ BS2       ARE ROWS OF DESTINATION AND       CPB BS2,I       COLUMNS OF SOURCE EQUAL?      CMB,INB,RSS   YES       JSB RERRS+11,I  NO      STB MMT0      SAVE ROW COUNTER      MPY MMT3      SAVE COLUMN BACK UP       ISZ BS2       LDB ID0       SZB,RSS       'TRN' ?       JMP INV       NO      ADA .+2       YES, SAVE COLUMN      STA MMT4        BACK UP AMOUNT      ISZ BS1           FOR SOURCE MATRIX       JMP TRN TRN1  LDB MMT1      RESET       STB MMT2        COUNTER       LDB BS2       BACK UP TO      ADB MMT4        FIRST ELEMENT       STB BS2           OF NEXT COLUMN*                        ***  TRANSPOSE A MATRIX  ***                        *TRN   DLD BS2,I     TRANSFER      DST BS1,I       ELEMENT       ISZ BS1       ISZ BS1       LDB BS2       ADVANCE TO      ADB MMT3        NEXT ELEMENT      STB BS2           OF COLUMN       ISZ MMT2      COLUMN TRANSFERRED?       JMP TRN       NO      ISZ MMT0      YES, DONE?      JMP TRN1      NO      JMP XEC1A,I   YES *                     * **  INVERT A MATRIX  ** *                     * INV   LDB 0         SAVE 2'S COMPLEMENT       ARS             OF NUMBER OF      STA MCNT          ELEMENTS IN MATRIX      LDA BS1       SAVE ADDRESS OF       STA BS3         DESTINATION MATRIX      LDA TMPST     SET ADDRESS       ADA .+2         OF FREE CORE      STA BS1           AS BASE ADDRESS       CMA,INA       SUFFICIENT      ADA LWAUS       FREE CORE       ADA 1             TO COPY       CMA,SSA,RSS         SOURCE MATRIX?      JSB RERRS+10,I  NO      ADA LWAUS     YES, INCLUDE IT       STA PBPTR       IN SWAP AREA      CLB           SET 'MAXIMUM ELEMENT'       STB MAXE        VALUE TO      STB MAXE+1        ZERO      LDA MCPYA     SET UP TO       STA MOP         COPY MATRIX,      LDA INV1          FIND MAXIMUM (ABSOLUTE      STA MEXIT           VALUE) ELEMENT,       JMP MLOOP             AND RETURNINV1  DEF *+1       DLD MAXE      COMPUTE       JSB .FMP        RELATIVE      DEF TOLC          TOLERANCE       DST TOL       CCA       STA ID0       RESTORE       ADA BS3         DESTINATION       STA BS1           BASE ADDRESS      CMA,INA       COMPUTE DIFFERENCE      ADA TMPST       BETWEEN BASE ADDRESSES      CMA,INA           OF SOURCE (COPIED)      STA BS3             AND DESTINATION       LDA INV2              MATRICES      STA MEXIT     SET DESTINATION MATRIX      JMP INVL        TO IDENTITY AND RETURNINV2  DEF *+1       LDB TMPST     SAVE      ADB .+2         BASE ADDRESS      LDA 1             OF SOURCE       STB BS2             MATRIX      ADB BS3       SAVE BASE ADDRESS OF      STB BS1         DESTINATION MATRIX      CLB           SET PIVOT ELEMENT       STB ID0         BIAS TO ZERO      JMP INV4INV3  LDA ID0       SET BIAS      ADA .-2         FOR NEXT      STA ID0           PIVOT ELEMENT       LDA MMT0      INITIALIZE COUNTER TO       STA MMT2        2'S COMPLEMENT OF COLUMNS       LDA PIVEL     UPDATE PIVOT      ADA MMT3        ADDRESS       ADA .+2           TO NEXT INV4  STA PIVEL           DIAGONAL ELEMENT      STA MMT4      INITIALIZE      CLB             PIVOT ELEMENT       STB MAXE          AS MAXIMUM      STB MAXE+1          IN COLUMN       LDB MMT1      SET COUNTER TO SEARCH       STB MMT5        REMAINDER OF COLUMN INV5  STA MMT6      LOAD      DLD MMT6,I      ELEMENT       SSA           GET       JSB ARINV       ABSOLUTE      DST SCALR         VALUE       JSB .FSB      SUBTRACT      DEF MAXE        PREVIOUS MAXIMUM      SZA           RESULT      SSA             POSITIVE?       JMP INV6      NO      DLD SCALR     YES, RECORD       DST MAXE        NEW MAXIMUM       LDA MMT6          AND ITS       STA MMT4            LOCATIONINV6  LDA MMT6      MOVE TO NEXT      ADA MMT3        ELEMENT OF COLUMN       ISZ MMT5      COLUMN DONE?      JMP INV5      NO      LDB PIVEL     YES       ADB ID0       SET POINTERS      STB MMT7        TO OLD      ADB BS3           PIVOT ROWS OF       STB MMT5            BOTH MATRICES       STB ID1       LDA MMT4      NEED TO       CPA PIVEL       SWAP ROWS?      JMP INV8      NO      ADA ID0      YES, SET POINTERS      STA MMT8        TO NEW      ADA BS3           PIVOT ROWS OF       STA MMT6            BOTH MATRICES INV7  DLD MMT5,I    SWAP      DST SCALR       DLD MMT6,I      ROW       DST MMT5,I      DLD SCALR         ELEMENT       DST MMT6,I      DLD MMT7,I          OF      DST SCALR       DLD MMT8,I            EACH      DST MMT7,I      DLD SCALR               MATRIX      DST MMT8,I      ISZ MMT5      BUMP      ISZ MMT5      ISZ MMT6        ALL       ISZ MMT6      ISZ MMT7          FOUR      ISZ MMT7      ISZ MMT8            POINTERS      ISZ MMT8      ISZ MMT2      ROW SWAPPED?      JMP INV7      NOINV8  DLD MAXE      YES       JSB .FSB      PIVOT ELEMENT       DEF TOL         SMALLER THAN      SSA               TOLERANCE?      JSB RERRS+26,I  YES       DLD F1.0      NO      JSB .FDV      COMPUTE       DEF PIVEL,I     INVERSE OF      DST MAXE          PIVOT ELEMENT       LDA MMT1      LAST      INA,SZA,RSS     PIVOT?      JMP INV10     YES       STA MMT5      NO, PREPARE       LDA PIVEL       TO SCALE      STA MMT6          PIVOT ROW INV9  ISZ MMT6      MOVE TO NEXT      ISZ MMT6        ELEMENT OF ROW      DLD MMT6,I    MULTIPLY      JSB .FMP        BY 1/PIVOT      DEF MAXE          AND STORE       DST MMT6,I          NEW VALUE       ISZ MMT5      ROW DONE?       JMP INV9      NOINV10 LDA ID1       YES       STA MMT6      LDA MMT0      SET       STA MMT2      STA MMT5        COUNTERSINV11 DLD MMT6,I    SCALE ELEMENTS OF       SZA,RSS       JMP INV12       PIVOT ROW       JSB .FMP      DEF MAXE          OF DESTINATION      DST MMT6,IINV12 ISZ MMT6           MATRIX       ISZ MMT6      ISZ MMT5      ROW DONE?       JMP INV11     NO      LDB BS1       YES, SET POINTER TO       STB VT0         DESTINATION ARRAY       LDA BS2       SET POINTER       CMA,INA         TO PIVOT COLUMN       ADA ID0           IN FIRST ROW      CMA,INA             OF SOURCE INV13 STA MMT8              MATRIX      CPA PIVEL     PIVOT ROW?      JMP INV19     YES       STA MMT7      NO      DLD MMT7,I    LOAD MULTIPLIER FOR PIVOT ROW       SZA,RSS       ZERO?       JMP INV19     YES       DST SCALR     NO, SAVE MULTIPLIER       LDA MMT1      LAST      INA,SZA,RSS     ROW?      JMP INV15     YES       STA MMT5      NO, SET POINTER TO      LDA PIVEL       PIVOT ELEMENT IN      STA MMT6          SOURCE MATRIX INV14 ISZ MMT6      MOVE      ISZ MMT6        TO      ISZ MMT7          NEXT      ISZ MMT7            COLUMN      DLD SCALR     COMPUTE       JSB .FMP      DEF MMT6,I      DST MAXE        TRANSFORMED       DLD MMT7,I      JSB .FSB      DEF MAXE          ELEMENT       DST MMT7,I      ISZ MMT5      ROW DONE?       JMP INV14     NOINV15 LDA ID1       YES, SET POINTER TO PIVOT       STA MMT6        ROW OF DESTINATION MATRIX       LDA MMT0      SET       STA MMT4        COUNTER INV16 DLD MMT6,I    COMPUTE       SZA,RSS       JMP INV17       JSB .FMP      DEF SCALR       TRANSFORMED       DST MAXE      DLD VT0,I       JSB .FSB      DEF MAXE          ELEMENT       DST VT0,I INV17 ISZ VT0       MOVE      ISZ VT0         TO      ISZ MMT6          NEXT      ISZ MMT6            COLUMN      ISZ MMT4      ROW DONE?       JMP INV16     NOINV18 LDA MMT8      YES, MOVE TO NEXT       ADA MMT3        ROW IN SOURCE MATRIX      ISZ MMT2      ALL ROWS TRANSFORMED?       JMP INV13     NO      ISZ MMT1      YES, MATRIX INVERTED?       JMP INV3      NO      LDA TMPST     YES       ADA .+23      RELEASE EXTRA       STA PBPTR       CORE      JMP XEC1A,I INV19 LDA VT0       ADVANCE TO      ADA MMT3        NEXT ROW OF       STA VT0           DESTINATION       JMP INV18           MATRIX*                                ***  CODE TO COMPUTE AN ELEMENT  ***                                *MADD  JSB .FAD      ADD       DEF BS3,I       SOURCE      JMP MLOP1         ELEMENTS* MSUB  JSB .FSB      SUBTRACT      DEF BS3,I       SOURCE      JMP MLOP1         ELEMENTS* IDN   ISZ ID1       DIAGONAL ELEMENT?       JMP MLOP3     NO      LDA ID0       YES, RESET      STA ID1         DIAGONAL COUNTER      DLD F1.0      LOAD      JMP MLOP3       1.0 * SMULT JSB .FMP      MULTIPLY      DEF SCALR       SOURCE ELEMENT      JMP MLOP2         BY SCALAR * MCPY  SSA           GET       JSB ARINV       ABSOLUTE      DST SCALR         VALUE       JSB .FSB      SUBTRACT      DEF MAXE        PREVIOUS      SZA               MAXIMUM       SSA           POSITIVE RESULT?      JMP MCPY1     NO      DLD SCALR     YES, RECORD       DST MAXE        NEW MAXIMUM MCPY1 DLD BS2,I     RELOAD VALUE      JMP MLP2A,I **                              *****  CHECK VALIDITY OF MATRIX  *****                              *** *  ENTER WITH (B) POINTING TO THE DYNAMIC ARRAY DIMENSIONS. *  COMPUTE THE NUMBER OF ELEMENTS AND CHECK EACH ONE.  EXIT *  TO ERROR IF ANY ELEMENT HAS VALUE 'UNDEFINED'. * #VCHK LDA 1,I       LOAD ROW DIMENSION      INB       STB VT0       MPY VT0,I     MULTIPLY BY       LDB VT0         COLUMN DIMENSION      CMA           SAVE 1'S COMPLEMENT       STA VT0         OF MATRIX SIZE      LDA MNEGVCHK1 ISZ VT0       DONE?       INB,RSS       NO, MOVE TO NEXT ELEMENT      JMP VCHK,I    YES       CPA 1,I       HIGH WORD MATCH?      JMP *+3       YES       INB           NO, BUMP      JMP VCHK1       POINTER       INB       LDA MNEG+1    LOW WORD      CPA 1,I         MATCH?      JSB RERRS+23,I  YES       JMP VCHK1-1   NO**                          *****  REDIMENSION A MATRIX  *****                          *** *  UPON ENTRY (TEMP1)+1 POINTS TO THE REDIMENSION SUBSCRIPT IN*  THE PROGRAM AND SBPTR POINTS TO THE CURRENT DYNAMIC DIMENSIONS *  OF THE ARRAY.  THE SUBSCRIPT BOUNDS ARE EVALUATED, ROUNDED,*  AND RECORDED.  IF THE NUMBER OF ELEMENTS IS WITHIN THE *  PHYSICAL ARRAY ALLOWANCE, EXIT WITH TEMP1 POINTING TO THE*  WORD FOLLOWING THE SUBSCRIPT AND SBPTR AS UPON ENTRY, ELSE *  EXIT TO ERROR. * #RDIM ISZ TEMP1     COMPUTE NEW       JSB FETCH       ROW DIMENSION       JSB SBFIX     15 BIT INTEGER > 0?       JSB RERRS+17,I  NO      INB           YES, SAVE       STB SBPTR,I     TRUE VALUE      STB RD0           IN ARRAY      ISZ SBPTR           ENTRY       LDB TEMP1,I   EXPLICIT NEW      SZB,RSS         COLUMN DIMENSION?       JMP RDIM1     NO      JSB FETCH     YES,      JSB SBFIX       COMPUTE       JSB RERRS+17,I    ITRDIM1 INB           SAVE TRUE VALUE       STB SBPTR,I     IN ARRAY ENTRY      LDA RD0       COMPUTE       MPY SBPTR,I     NUMBER OF       SZB,RSS           ELEMENTS SPECIFIED       [F]      CMA,SSA,INA,RSS     AND CHECK FOR >        [F]      JSB RERRS+25,I        32767.               [F]      STA RD0                                    [F]      LDB SBPTR     RESET       ADB .-3         ARRAY POINTER       LDA 1,I           AND COMPUTE       INB                 NUMBER OF       STB SBPTR             ELEMENTS      MPY SBPTR,I             AVAILABLE       ISZ SBPTR                 FOR ARRAY       ADA RD0       SUFFICIENT      SSA            PHYSICAL SPACE?      JSB RERRS+25,I  NO      ISZ TEMP1     YES       JMP REDIM,I * MLP2A DEF MLOP2 MLP3A DEF MLOP3 MADDA DEF MADDMSUBA DEF MSUBSMULA DEF SMULT IDNA  DEF IDN MCPYA DEF MCPYTOLC  DEC +1E-6 F0.0A DEF F0.0F0.0  DEC 0.0 F1.0A DEF F1.0F1.0  DEC 1.0 