      HED MATRIX ROUTINES
*               *****************************
*               MATRIX STMT EXECUTION CONTROL
*               *****************************
EMAT  LDA TEMPS,I
      ISZ TEMPS     MAT READ
      AND MSK1        OR
      SZA               MAT PRINT?
      JMP EMAT7     NO
      LDA TEMPS,I   YES
      AND OPMSK     SAVE
      STA MLBX1       TYPE
      CPA RDOP      PRINT?
      RSS           NO
      JSB PRNIA,I   YES
*
EMAT1 LDA TEMPS,I   LOAD
      AND MSK1        OPERAND
      SZA,RSS       NULL? (END OF MAT PRINT)
      JMP XEC4A,I   YES
      JSB SSYMA,I   NO, SEARCH SYMBOL TABLE
      INB,SZB,RSS   FOUND?
      JMP E8M1A,I   NO
      ISZ TEMPS     YES
      LDA 1,I       SAVE ARRAY
      STA B1          BASE ADDRESS
      LDA MLBX1
      CPA RDOP      READ?
      JMP EMAT5     YES
      ADB .2        NO
      LDA 1,I       SAVE
      STA B1+1        DIMENSIONS
      AND MSK0      SET
      CMA,INA         COLUMN
      STA B2            COUNTERS
      STA B2+1
      LDA 1,I       SET
      ALF,ALF
      AND MSK0        ROW
      CMA,INA
      STA B3            COUNTER
      JSB LCK2A,I   ENSURE ARRAY IS DEFINED
      CLA           SET DELIMITER
      STA MCKS        AS COMMA
      LDA TEMPS     MORE
      CPA PRADD       STATEMENT?
      JMP EMAT3     NO
      LDA TEMPS,I   YES
      AND OPMSK     EXTRACT DELIMITER
      CPA B3000     SEMICOLON?
      ISZ MCKS      YES
      JMP EMAT3
EMAT2 CLB           COMMA
      CPB MCKS        DELIMETER?
      JSB EDELM     YES
EMAT3 LDA B1,I      LOAD
      ISZ B1          NEXT
      LDB B1,I          ELEMENT
      ISZ B1
      JSB ENOUT     OUTPUT IT
      ISZ B2        ROW COMPLETE?
      JMP EMAT2     NO
      JSB OUTLN     YES, DO
      JSB OUTLN       SPACING
      LDA B2+1      RESET
      STA B2          COLUMN COUNTER
      ISZ B3        ARRAY EXHAUSTED?
      JMP EMAT3     NO
EMAT4 LDB TEMPS     YES, MORE
      CPB PRADD       STATEMENT?
      JMP XEC4A,I   NO
      JMP EMAT1     YES
*
EMAT5 STB B2        SAVE SYMBOL TABLE POINTER
      LDA TEMPS,I   EXTRACT
      AND OPMSK       NEXT OPERATOR
      LDB TEMPS     STATEMENT
      CPB PRADD       EXHAUSTED?
      CLA           YES
      CPA B2200     'I' ?
      JSB REDIM     YES, REDIMENSION ARRAY
      LDA B2        LOAD
      ADA .2          ARRAY
      LDA 0,I           DIMENSIONS
      JSB MDIM      SET
      ARS             ARRAY
      CMA,INA           ELEMENT
      STA B3              COUNTER
EMAT6 JSB FDAT,I    FETCH VALUE
      STA B1,I      STORE
      ISZ B1
      STB B1,I        IT
      ISZ B1
      ISZ B3        ARRAY EXHAUSTED?
      JMP EMAT6     NO
      JMP EMAT4     YES
*
EMAT7 JSB SSYMA,I   SAVE
      INB             BASE ADDRESS
      LDA 1,I           OF DESTINATION
      STA B3              ARRAY
      STB B2        SAVE SYMBOL TABLE ADDRESS
      ADB .2        SAVE
      LDA 1,I         ITS
      STA B3+1          DIMENSIONS
      CLA,INA       ASSUME MAT
      STA EDELM       REPLACEMENT
EMAT0 LDA TEMPS,I   LOAD NEXT
      ISZ TEMPS       OPERAND
      SSA           ARRAY FUNCTION?
      JMP EMA11     YES
EMAT8 AND MSK1      NO
      SZA,RSS       SCALAR MULTIPLICATION?
      JMP EMA10     YES
      JSB SSYMA,I   NO
      INB           SAVE
      LDA 1,I         BASE
      STA B1            ADDRESS AND
      ADB .2              DIMENSIONS
      LDA 1,I               OF FIRST
      STA B1+1                SOURCE ARRAY
      LDB TEMPS     STATEMENT
      CPB PRADD       EXHAUSTED?
      JMP EMAT9     YES
      LDA TEMPS,I   NO
      ARS           EXTRACT
      ALF,ALF         AND
      AND .63           RECORD
      ADA M6              EMAT
      STA EDELM             OPERATOR
      LDA TEMPS,I   SAVE
      AND MSK1
      JSB SSYMA,I     BASE ADDRESS
      INB
      LDA 1,I           AND DIMENSIONS
      STA B2
      ADB .2              OF SECOND
      LDA 1,I
      STA B2+1              SOURCE ARRAY
*
EMAT9 LDA EDELM     TRANSFER TO
      ADA LMAP        APPROPRIATE
      JSB 0,I           ROUTINE
      JMP XEC4A,I
*
LMAP  DEF LBASE-1,I
LBASE DEF REPLC
      DEF ADD
      DEF SUB
      DEF MULT
      DEF SZER
      DEF LCON
      DEF LIDN
      DEF LINV
      DEF TRAN
      DEF SMULT
*
EMA10 LDA .10       SET 8MULT
      STA EDELM       OPERATOR
      JSB FETCA,I   EVALUATE
      STA MLBX1       AND SAVE
      STB MLBX1+1       SCALAR
      ISZ TEMPS     GO TO
      ISZ TEMPS       PROCESS
      JMP EMAT0         SOURCE ARRAY
*
EMA11 ALF,ALF       EXTRACT
      ALF
      AND .31         TYPE
      ADA M8        RECORD EMAT
      STA EDELM       OFERATOR TYPE
      ADA M8        INV OR
      SSA             TRN?
      JMP EMA12     NO
      LDA TEMPS,I   YES, LOAD
      ISZ TEMPS       SOURCE
      ISZ TEMPS         ARRAY
      JMP EMAT8           SYMBOL
*
EMA12 LDB TEMPS     REDIMENSIONING
      CPB PRADD       PART?
      JMP EMAT9     NO
      JSB REDIM     YES
      JMP EMAT9
      SPC 5
*               *******************************
*               SUBROUTINE TO REDIMENSION ARRAY
*               *******************************
REDIM NOP
      JSB MCKS      EVALUATE
      BLF,BLF         AND SAVE
      STB B3+1          ROW COUNT
      CLB,INB       LOAD DEFAULT COLUMN COUNT
      ISZ TEMPS     SINGLE
      LDA TEMPS,I     DIMENSION
      AND OPMSK         ARRAY?
      CPA LF
      JMP REDI1     YES
      JSB MCKS      NO, EVALUATE COLUMN COUNT
      ISZ TEMPS     MOVE PAST
REDI1 ISZ TEMPS       RIGHT BRACKET
      ADB B3+1      PACK
      STB B3+1        DIMENSIONS
      LDA B2        STORE IN
      ADA .2          SYMBOL
      STB 0,I           TABLE
      ADA M1        COMPUTE
      LDA 0,I         PHYSICAL
      JSB MDIM          ARRAY SPACE
      STA MLBX1+1         SIZE
      LDA B3+1      COMPUTE
      JSB MDIM        NEW SIZE
      CMA,INA       NEW
      ADA MLBX1+1     SIZE
      SSA               ACCEPTABLE?
      JSB ERROR     NO
E7    JMP REDIM,I   YES
      SKP
*               ******************************************
*               SUBROUTINE TO EVALUATE & CHECK A SUBSCRIPT
*               ******************************************
MCKS  NOP
      JSB FETCA,I   CALL FOR EVALUATION
      JSB SBFIX     CONVERT TO INTEGER (ROUNDED)
      INB           UNBIAS SUBSCRIPT
      LDA 1         PUT INTO (A)
      ADA M256      LESS THAN
      SSA,RSS         256?
      JMP E6M1A,I   NO
      JMP MCKS,I    YES, RETURN SUBSCRIPT IN (B)
      SKP
      ORG 12000B
*
*********************************************
******      MATRIX   ROUTINES        ********
*********************************************
*CALL FOR MATRIX OPERATION IS MADE WITH FOUR*
*PARAMETERS,ROUTINE NUMBER AND ADDRESS OF   *
*SYMBOL TABLE OF THREE MATRICES. FOR SCALAR *
*MULT,LAST IS ADDRESS OF SCALAR VALUE       *
*OPERATION IS OF FORM  B3=B1 OP B2          *
*THE ADDRESS OF THE BASE ADDRESS OF MATRICES*
*IS GIVEN IN B1,B2,B3. THE DIMENSIONS OF A  *
*MATRIX IS GIVEN IN B(I)+1, ROWS IN MOST SIG*
*PART(MSP) AND COLUMN IN LEAST SIG PART(LSP)*
*********************************************
*
*
*
*********************************************
***       SUBROUTINE  GENERAL             ***
*********************************************
*B3=B1 OP B2  SUBROUTINE COMPUTES AN ELEMENT*
*OF B3 AND INCREMENTS TO NEXT ELEMENT. THE  *
*OPERATION THAT IS PERFORMED AND            *
* THE MATRICES INCREMENTED ARE              *
*  MODIFIED BY ROUTINES ADD, SUB, REPL      *
*SCALAR MULT, CON,ZERO,IDN. ROUTINE CHECKS  *
*COMPATIBILITY OF THREE MATRICES USING SUB  *
*COMPARE (PARAMETERS SUPPLIED IN REG A,B)   *
*********************************************
*
GENER NOP           SUBROUTINE GENERAL
      LDA B2+1      LOAD DIM FOR MATRIX 2
      LDB B1+1      LOAD DIM FOR MATRIX 1
      JSB COMPR     CHECKS ROW AND COL DIM
*                                   ARE COMPATIBLE
GEN2  LDA B1+1      LOAD DIM FOR MATRIX 1
      LDB B3+1      LOAD DIM FOR MATRIX 3
      JSB COMPR     CHECK ROW AND COL DIM
      JSB MPY       COLUMNS IN (A)
      DEF T3        ROWS IN T3
      CMA,INA
      STA LPIV      -ROWS*COLUMNS
*                                   COMPUTES B3=B1 OP B2
LOOP  LDA B1,I      LOAD
      ISZ B1          NEXT
      LDB B1,I          SOURCE
      ISZ B1              ELEMENT
MOD1  NOP           USUALLY A JSB
      NOP           USUALLY DEF B2,I
      STA B3,I      STORE
      ISZ B3          NEXT
      STB B3,I          DESTINATION
      ISZ B3              ELEMENT
MOD2  NOP           ISZ B2 FOR
      NOP             MAT ADD OR SUB
      ISZ LPIV
      JMP LOOP      COMPUTE NEXT ELEMENT
      JMP GENER,I
*
*
*********************************************
****      SUBROUTINE COMPARE             ****
*********************************************
*ROUTINE COMPARES DIM OF TWO MATRICES GIVEN *
*THEIR DIM IN REGISTERS A,B                 *
*DIMENSIONS ARE GIVEN IN B(I)+2             *
*********************************************
*
COMPR NOP
      CPA 1         EQUAL?
      RSS           YES
LERR  JSB ERROR     NO
      ALF,ALF       SAVE
      AND MSK0        # OF
      STA T3            ROWS
      LDA 1
      AND MSK0      SAVE #
      STA T4          OF COLUMNS
      JMP COMPR,I
*
*
*********************************************
******     SUBROUTINE   LCHK           ******
*********************************************
*TESTS THAT NO ELEMENT IN A MATRIX IS       *
*UNASSIGNED. ENTRY1 CHECKS MATRICES GIVEN BY*
*B1 AND B2 AND ENTRY 2 CHECKS ONLY B1       *
*********************************************
*
LCHK2 NOP
      LDA LCHK2
      STA LCHK1
      JMP *+5
LCHK1 NOP
      LDB B2        BASE ADDR
      LDA B2+1      ROW AND COL DIM.
      JSB LCHK4     TEST EACH TERM OF B2
      LDB B1        BASE ADDR
      LDA B1+1      ROW AND COL DIM.
      JSB LCHK4     TEST EACH TERM OF B1
      JMP LCHK1,I
*
LCHK4 NOP           SUBROUTINE TO TEST TERMS
      STB T6        SAVE
      JSB MDIM      COMPUTE SIZE OF MATRIX
      ARS           SET NEGATIVE
      CMA,INA
      STA T7        COUNTER FOR ELEMENTS
LCHK6 LDA T6,I      LOAD
      ISZ T6
      LDB T6,I        ELEMENT
      ISZ T6
      CPA MNEG      COMPARE WITH PRESET QTY.
      JMP *+2
      JMP LCHK5
      CPB MNEG+1
      JSB ERROR     ERROR 'MAT UNASSIGNED'
LCHK5 ISZ T7        DONE?
      JMP LCHK6     NO
      JMP LCHK4,I   YES
*
*
*********************************************
****  SUBROUTINE  MAIRIX  ADD            ****
*********************************************
*B1,B2,B3 CONTAIN ADDRESS OF BASE ADDRESS OF*
*THREE MATRICES. ROUTINE EXECUTES B3=B1+B2  *
*BY MODIFYING INSTR IN ROUTINE GENERAL      *
*********************************************
*
ADD   NOP
      LDA LPLUS     JSB .FAD
ADD1  STA MOD1      SET IN GENER
      LDA LPLUS+1   DEF OF B2,I
      STA MOD1+1    MODIFY ROUTINE GENERAL
      LDA INCB2     ISZ B2
      STA MOD2
      STA MOD2+1
      JSB LCHK1     TEST B1,B2 FOR UNASSIGNED TERMS
      JSB GENER     ROUTINE GENERAL
      JMP ADD,I     EXIT TO MAIN PROGRAM
*
*
*********************************************
****  SUBROUTINE  MATRIX  SUBTRACT       ****
*********************************************
*B1,B2,B3 CONTAIN ADDRESS OF BASE ADDRESS OF*
*THREE MATRICES. ROUTINE EXECUTES B3=B1-B2  *
*BY MODIFYING INSTR IN ROUTINE GENERAL      *
*********************************************
*
SUB   NOP           LET
      LDA SUB         ADD DO
      STA ADD           RETURN
      LDA LMIN      JSB .FSB
      JMP ADD1
      SKP
*
*********************************************
****   SUBROUTINE  MATRIX  REPLACE       ****
*********************************************
*B1,B3 GIVE ADDRESS OF BASE ADDRESS OF GIVEN*
*MATRIX AND RECEIVING MATRIX RESPECTIVELY   *
*********************************************
REPLC NOP           LET
      LDA REPLC       GENER DO
      STA GENER         RETURN
      CLA           NO
      CLB             OPERATION
REPL1 STA MOD1      SET
      STB MOD1+1      OPERATION
      CLA           B2
      STA MOD2        NOT
      STA MOD2+1        USED
      JSB LCHK2     TEST B1 FOR UNASSIGNED ELEMENTS
      JMP GEN2
*
*
*********************************************
****  SUBROUTINE MATRIX SCALAR MULT      ****
*********************************************
*B1,B3 GIVE ADDRESS OF BASE ADDRESS OF GIVEN*
*MATRIX AND RECEIVING MATRIX RESPECTIVELY   *
*MBXL HOLDS ADDRESS OF SCALAR VALUE         *
*********************************************
*
SMULT NOP           LET
      LDA SMULT       GENER DO
      STA GENER         RETURN
      LDA LTIME     SET FOR
      LDB MBXL        MULTIPLY
      JMP REPL1
*
*
*********************************************
****    SUBROUTINE  MATRIX  CON          ****
*********************************************
*SETS MATRIX TO ALL ONES.  B3 IS ADDRESS OF *
*BASE ADDRESS OF MATRIX.                    *
*********************************************
*
LCON  NOP
      LDA HONE
      LDB .2
LCON1 STA MLBX1     SET
      STB MLBX1+1     CONSTANT
      LDA B3+1
      JSB MDIM      SET
      ARS             ELEMENT
      CMA,INA           COUNTER
      STA LPIV
      LDA MLBX1     LOAD
      LDB MLBX1+1     CONSTANT
LCON2 STA B3,I      STORE
      ISZ B3          IN
      STB B3,I          NEXT
      ISZ B3              ELEMENT
      ISZ LPIV      DONE?
      JMP LCON2     NO
      JMP LCON,I    YES
*
*
*********************************************
****    SUBROUTINE  MATRIX  ZERO         ****
*********************************************
*SETS MATRIX TO ZERO. B3 IS ADDRESS OF BASE *
*ADDRESS OF MATRIX.  B1,B2 ARE REDUNDANT    *
*SET B1=0 AND USE SUBROUTINE CON,ENTRY2     *
*********************************************
*
SZER  NOP
      LDA SZER      CONVERT
      STA LCON
      CLA             LCON
      CLB
      JMP LCON1         TO SZER
*
*
*********************************************
****    SUBROUTINE  MATRIX  IDN          ****
*********************************************
*ROUTINE SETS UP IDENTITY MATRIX            *
*B3 IS ADDRESS OF BASE ADDRESS OF MATRIX    *
*USE SZER TO SET MATRIX TO ALL ZEROS.  ON   *
*RETURN CHECK FOR SQUARE MATRIX.            *
*********************************************
*
LIDN  NOP
      LDA B3
      STA T9        SAVE BASE ADDRESS
      JSB SZER      SET ALL MATRIX TO ZERO
      LDA B3+1      IS
      ALF,ALF         ARRAY
      CPA B3+1          SQUARE?
      ALS,SLA       YES
      JMP LERR      NO
      AND MSK1      SAVE ROW
      STA MLBX1       LENGTH
      ARS           SAVE
      CMA,INA         ROW
      STA MLBX1+1       COUNTER
      LDB T9        RESTORE
      STB B3          B3
LIDN1 LDA HONE      STORE
      STA 1,I
      INB             1.0 ON
      LDA .2
      STA 1,I           DIAGONAL
      INB
      ADB MLBX1     MOVE TO NEXT DIAGONAL ELEMENT
      ISZ MLBX1+1   DONE?
      JMP LIDN1     NO
      JMP LIDN,I    YES
*
*
*********************************************
*****     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
      SKP
*
*********************************************
****      SUBROUTINE  TRANSPOSE         *****
*********************************************
*TRANSPOSE OF FORM B3(M,N)=T(B1(N,M))       *
*B1,B3 GIVE ADDRESS OF BASE ADDRESS OF GIVEN*
*AND RECEIVING MATRICES RESPECTIVELY.       *
*********************************************
*
TRAN  NOP
      JSB LCHK2     TEST B1 FOR UNASSIGNED TERMS
*                                   CHECK DIMENSIONS
      LDA B3+1      PARAMETERS OF B3
      ALF,ALF       INTERCHANGE ROW AND COLUMN
      LDB B1+1      PARAMETERS OF B1
      JSB COMPR     SUBROUTINE COMPARE
*                                   DIMENSIONS COMPATIBLE
      JSB MPY       # OF COLUMNS IN (A)
      DEF T3        # OF ROWS IN T3
      STA LPIV      PRODUCT OF ROW*COL
      LDA T4        SET
      CMA,INA         COLUMN
      STA T5            COUNTER
*                                   T6 IS INDICATOR TO SELECT
*                                   WHICH ELEMENT IN A COL OF
*                                   B1 IS TO BE TRANSPOSED
TRAN1 CLA
      STA T6        SET T6=0
LNEXT LDB T6        LOAD
      BLS
      ADB B1          NEXT ELEMENT
      LDA 1,I
      INB               OF COLUMN
      LDB 1,I
      STA B3,I      STORE
      ISZ B3          IN
      STB B3,I          ROW
      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
*                                   SET BASE ADDRESS TO FIRST
*                                   TERM IN NEXT COLUMN
      ISZ B1
      ISZ B1
      ISZ T5
      JMP TRAN1     TRANSPOSE NEXT COL
      JMP TRAN,I    EXIT TO MAIN PROGRAM
