*
*
*    MATRIX EXPRESSION EVALUATOR
*
*
*     Some statements in this file have been changed
*     so that the code produced will be exactly the same
*     as that in the released and running version.  This
*     was done for Proteus by Charles L. Athey, III (CLA III)
*     See the comments at the start of BSM:MCT.
*
SMATER LDA MENT  GET MATRIX ENTRY FLAG
 ORA A  SET?
*
*     The following line was changed from JZ CSERR to match
*     the previous versions by CLA III
*
 JNZ CSERR  YES, MATRIX FUN'S NOT RECURSIVE!!!
 CMA .  SET FLAG; MAT HAS BEEN ENTERED
 STA MENT
*
 LXI H,MR  ADDR OF RESULT STATIC PARAMETER BLOCK
 CALL MVAR  LOOK UP VAR
*
 MVI B,EQRW  SYNTAX
 CALL EATC
*
 XRA A  SET MODE...
 STA MODE  ...TO 'NON-SCALOR'
*
 CALL GC  GET NEXT BYTE
 ORA A  IS IT A TOKEN?
 JM SMATF  YES, IT IS
*
 LXI H,MA  ADDR OF 'A' MAT STATIC BLOCK
 CALL MVAR
*
 CALL GC  TEST FOR CR OR EOS
 CPI CR
 JZ MCOPY  COPY MATRIX
 CPI EOSRW
 JZ MCOPY  COPY MATRIX
*
 CALL GCI
 CPI ASKRW  CHECK FOR LEGAL TOKEN
 JC BSERR
 CPI SLARW+1
 JNC BSERR
 PUSH PSW  SAVE FOR LATER
*
 MVI A,LPARRW  TEST FOR SCALAR
 CALL SCANC
 JC SMATV  NOT SCALAR, MUST BE VAR
 CALL EXPRB  EVALUATE EXPRESSION
 CALL EATRP
 CALL TOPFP  HL:= ADDR OF RESULT
 SHLD MB  ADDR OF RESULT
 SHLD TSTKA  POP!
 MVI A,1
 STA MODE  MODE := 'SCALAR' MODE
 JMP SMAT1
*
SMATV LXI H,MB  ADDR OF 'B' MAT STATIC BLOCK
 CALL MVAR
*
SMAT1 POP PSW  GET OP CODE
 MOV B,A
 LDA MODE
 ORA A  TEST MODE FOR SCALAR
 MOV A,B
 JNZ SMATS  IT IS SCALAR MODE, BYE...BYE
*
 LXI H,MEXIT  SETUP RETURN FOR MAT MATH PACKAGE
 PUSH H
*
 LHLD MR  SET UP ARGS FOR MAT MATH PACKAGE
 INX H
 INX H
 MOV B,H
 MOV C,L  BC
*
 LHLD MB
 INX H
 INX H
 XCHG .   DE
*
 LHLD MA
 INX H
 INX H  HL
*
 CPI ASKRW  DISPATCH ON OPERATOR
 JZ MMUL
 CPI PLSRW
 JZ MADD
 CPI MINRW
 JZ MSUB
 JMP BSERR  NO MAT DIVIDE
*
*   THIS CODE HANDLES SCALAR OPERATIONS
*
SMATS STA MODE  OPPERATOR BECOMES MODE
 LXI B,FPSIZ-1  FIRST TIME
*
SMSL LXI H,SMSR  PLACE RETURN ON STACK
 PUSH H
 LHLD MADB
 DAD B
 SHLD MADB  NEXT ELEMENT IN A
 XCHG .  SETUP ARGS (MADB TO DE)
 LHLD MRDB
 DAD B
 SHLD MRDB  NEXT ELE IN RESULT
 MOV B,H
 MOV C,L
 LHLD MB  ARGS NOW: BC = DE $ HL (HL:= ADDR OF SCALOR)
*
 LDA MODE  GET THE OPPERATOR
 CPI ASKRW
 JZ FMUL
 CPI PLSRW
 JZ FADD
 CPI MINRW
 JZ FSUB
 JMP FDIV
*
SMSR LHLD MRBZ  R'S SIZE IN BYTES
 LXI B,-FPSIZ
 DAD B  ONE LESS ELEMENT
 SHLD MRBZ
 MOV A,H
 ORA L  DONE?
 LXI B,FPSIZ
 JNZ SMSL  NO, REITERATE
 JMP MEXIT  ALL DONE
*
*    MATRIX COPY
*       WILL COPY ANY SIZE MAT TO ANY SIZE MAT
*
MCOPY LHLD MRCOL  FIND DISPLACEMENT TO NEXT ROW IN RESULT MAT
 XCHG
 LXI B,FPSIZE
 CALL IMUL  HL:=DE*BC FIND COL SIZE IN BYTES
 SHLD XS  ROW SIZE
*
 LHLD MACOL  FIND DISPLACEMENT TO NEXT ROW IN SOURCE MAT
 XCHG
 LXI B,FPSIZE
 CALL IMUL
 SHLD XA  ROW SIZE
*
 XCHG .
 LHLD XS
 CALL HDCMP
 JC MUC1
 XCHG .
MUC1 SHLD XC  SMALLEST NUMBER OF BYTES PER ROW
*
 LHLD MRROW  FIND SMALLEST NUMBER OF ROWS
 XCHG
 LHLD MAROW
 CALL HDCMP
 JNC MUC4
 XCHG
MUC4 PUSH D
 JMP MUC3  DE:=SMALLEST NUMBER OF ROWS
*
MUC2 PUSH D  NUMBER OF TIMES TO COPY (# OF ROWS)
 LHLD MADB  MOVE TO NEXT ROW IN BOTH MATS
 XCHG
 LHLD XA  DISPLACEMENT TO NEXT ROW
 DAD D
 SHLD MADB
*
 LHLD MRDB
 XCHG
 LHLD XS  DISP TO NEXT ROW
 DAD D
 SHLD MRDB
*
MUC3 LHLD XC  LOAD ARGS FOR COPY
 MOV B,H
 MOV C,L
 LHLD MRDB
 XCHG
 LHLD MADB
 CALL COPYX  COPY A ROW
 POP D  # OF ROWS
 DCX D
 MOV A,D
 ORA E  ANY MORE ROWS TO COPY?
 JNZ MUC2
 JMP MEXIT  ALL DONE
*
*   PROCESS A MATRIX FUNCTION
*
SMATF CALL GCI
 CPI ZERRW  ZERO MATRIX?
 JNZ SMATC  NO
*
*     The next 2 lines were added to change this file back
*     to the way it was in previous versions.  It looks as
*     though these changed would probably work.  CLA III
*
 CALL MZERO
 JMP MEXIT
*
*
*
MZERO LHLD MRBZ  RESULT'S SIZE IN BYTES
 XCHG .  TO DE
 LHLD MRDB  DATA BASE ADDRESS
 CALL CLRM  CLEAR MEMORY
*
*     Added for compatability by CLA III
*
 RET .
*JMP MEXIT  ALL DONE       Removed by CLA III for compatability
*
*
SMATC CPI CONRW  A '1' MATRIX?
 JNZ SMATD
*
*
 LXI B,FPSIZ-1  FIRST TIME
*
MATC0 LHLD MRDB
 DAD B  NEXT ELE
 SHLD MRDB
 XCHG .  SETUP FOR VCOPY
 CALL VCPY1
 LHLD MRBZ  R'S SIZE IN BYTES
 LXI B,-FPSIZ
 DAD B  LESS ONE ELE
 SHLD MRBZ
 LXI B,FPSIZ
 MOV A,H
 ORA L
 JNZ MATC0  MORE...
 JMP MEXIT  ALL DONE
*
*
SMATD CPI IDNRW  MAT IDENTITY
 JNZ SMATI  NO
*
*
 LHLD MRCOL
 XCHG
 LHLD MRROW
 CALL HDCMP
 JNZ MDERR  MUST BE SQUARE
*
 CALL MZERO  FIRST ZERO IT OUT
*
 LHLD MRCOL  NEXT PLACE ONES ON THE MAJOR DIAGONAL
 XCHG .  TO FIND THE BYTES PER ROW
 INX D  ADD ONE FOR OFFEST INTO ROW
 LXI B,FPSIZ  ELEMENT SIZE
 CALL IMUL
 PUSH H  HL:= DISPLACEMENT TO NEXT ROW/COL
 LXI B,FPSIZ-1  FIRST TIME
 JMP MATD1
*
MATD0 PUSH B  SAVE DISPLACEMENT
MATD1 LHLD MRDB  MOVE TO NEXT ROW/COL
 DAD B
 SHLD MRDB
 XCHG .  FOR VCOPY
 CALL VCPY1
 POP B  GET DISPLACEMENT
 LHLD MRROW  TEST IF ALL ROWS DONE
 DCX H
 SHLD MRROW
 MOV A,H
 ORA L
 JNZ MATD0  MORE
 JMP MEXIT  ALL DONE
*
*
SMATI CPI INVRW
 JNZ SMATT  NO, TRY TRN
*
*
 CALL EATLP  GET ARGUMENT
 LXI H,MA
 CALL MVAR
 CALL EATRP
*
 LHLD MABZ  MAKE A TEMP MAT
 LXI B,6
 DAD B
 MOV B,H
 MOV C,L
 LHLD STA  SYM TAB ADDRESS
 PUSH H  SAVE IT FOR RESTORING
 DAD B  ADD MAT SIZE
 CALL STOV  WILL IT FIT?
*
 POP D  ADDR OF DEST
 PUSH D
 LHLD MA
 INX H
 INX H  ADDR OS SOURCE, BC HAS LENGTH
 CALL COPYX
*
 LHLD MR  SETUP TO CALL MINV
 INX H
 INX H
 MOV B,H
 MOV C,L
 POP H  BC=RESULT, HL=SOURCE
 CALL MINV  FIND INVERSE
 JMP MEXIT  ALL DONE
*
*
SMATT CPI TRNRW  TRN?
 JNZ BSERR  THEN WHAT????
*
*
 CALL EATLP
 LXI H,MA
 CALL MVAR
 CALL EATRP
*
 LHLD MRROW  TEST MATS FOR SHAPE CONFORMABILITY
 XCHG
 LHLD MACOL
 CALL HDCMP
 JNZ MDERR
*
 LHLD MRCOL
 XCHG
 LHLD MAROW
 CALL HDCMP
 JNZ MDERR
*
 LHLD MRCOL  COMPUTE ROW SIZE IN BYTES
 XCHG
 LXI B,FPSIZ
 CALL IMUL
 SHLD TEMP1  INCREMENT TO NEXT ROW/COL IN RESULT
*
 LHLD MADB  MOVE TO INITIAL POSITION IN MATS
 LXI B,FPSIZ-1
 DAD B
 SHLD MADB
*
 LHLD MRDB
 DAD B
 SHLD MRDB
 SHLD TEMP3  ROOT FOR RESULT'S COLUMNS
*
 LHLD MACOL  SET NUMBER OF ELEMENTS TO COPY PER COLUMN
 SHLD TEMP2
 JMP MATT0  INITIAL ENTRY
*
MATT1 LHLD MRDB  MOVE TO NEXT COLUMN/ROW
 LXI B,FPSIZE
 DAD B  NEXT COLUMN IN RESULT
 SHLD MRDB
 SHLD TEMP3  ROOT OF COLUMN
*
 LHLD MACOL  NUMBER OF ELEMENTS PER COLUMN
 SHLD TEMP2
 JMP MATT2  INITIAL ENTRY FOR EACH COLUMN
*
MATT3 LHLD TEMP3  MOVE TO NEXT ELEMENT
 XCHG
 LHLD TEMP1  DISP TO NEXT ELEMENT OF THIS COLUMN
 DAD D
 SHLD TEMP3  NEW ROOT
*
MATT2 LHLD MADB  MOVE TO NEXT ELEMENT IN SOURCE
 LXI B,FPSIZE
 DAD B
 SHLD MADB
*
MATT0 LHLD TEMP3  LOAD DEST
 XCHG
 LHLD MADB  AND SOURCE
 CALL VCOPY  MOVE ELEMENT
*
 LHLD TEMP2  NUMBER OF ELEMENTS PER COL
 DCX H
 SHLD TEMP2
 MOV A,H
 ORA L
 JNZ MATT3  NEX ELE
*
 LHLD MAROW  NUMBER OF ROWS
 DCX H
 SHLD MAROW
 MOV A,H
 ORA L
 JNZ MATT1  NEX ROW/COL
* FALL THRU, ALL DONE
*
*   EXIT FROM THE MATRIX EXPRESSION EVALUATOR
*
MEXIT LDA MENT
 CMA .  CLEAR FLAG (THIS WAY TO CATCH BUGS!)
 STA MENT  UPDATE TO SHOW WE'R OUT
 RET
*
*
*
*   LOOK UP AND SETUP FOR A MATRIX VARIABLE
*      HL --> STATIC AREA
*   
MVAR PUSH H  SAVE STATIC POINTER
 CALL NAME
 JC BSERR
 CALL SNAME
 JNC BSERR
*   
 MVI A,MTYPE  LOOKUP AS MATRIX TYPE VAR
 ORA C
 MOV C,A
 CALL STLK
 JC UNERR  UNDEFINED!
*   
*  TEST FOR TWO DIMENSIONS
*   
 PUSH H  SAVE VAR POINTER
 INX H  PASS SIZE WORD
 INX H
 INX H  PASS FIRST DIMENTION (IT CAN'T BE ZERO)
 INX H
 CALL DLOAD
 MOV A,D
 ORA E
 JZ MDERR  ONE DIMENSIONAL
 CALL DLOAD
 MOV A,D
 ORA E
 JNZ MDERR  MORE THAN TWO
 POP H
*   
*  TEST FOR RE-DIMENSION
*   
 SHLD TEMP1
 MVI A,LPARRW
 CALL SCANC
 JNC MVAR2  REDIMENSION
*   
 LHLD TEMP1  USE OLD SIZE
 CALL DLOAD  GET SIZE IN BYTES
 XCHG
 SHLD TEMP2
 JMP MVAR0
*   
*  DO RE-DIM
*   
MVAR2 CALL PFIXE  GET NEW ROW DIMENSION
 JZ OBERR
 PUSH D  ONCE FOR TEST
 PUSH D  AND AGAIN FOR STORING
 MVI B,','
 CALL EATC
*   
 CALL PFIXE  GET NEW COL DIM
 JZ OBERR
 POP H  GET ROW
 PUSH D  SAVE COL
*   
*  FIND NUMBER OF ELEMENTS IN NEW MATRIX
*   
 MOV B,H  ROW TO BC
 MOV C,L
 CALL IMUL  FIND NUMBER OF BYTES NEEDED
 XCHG
 LXI B,FPSIZE
 CALL IMUL
*   
 SHLD TEMP2
 XCHG .  RESULT IN HL TO DE
 LHLD TEMP1  ADDR OF BYTES IN MAT
 CALL DCMP  (DE)-((HL))
 JZ MVAR1
 JNC OBERR  TOO BIG FOR ORIGINAL DIMENSIONS
*   
*  SET NEW DIMENSIONS
*   
MVAR1 LHLD TEMP1
 INX H  PASS BYTES IN MAT
 INX H
 POP B  MOVE COL
 POP D  GET ROW INTO DE
 PUSH B
 CALL DSTORE
 POP D  GET COL INTO DE
 CALL DSTORE
*   
 CALL EATRP
MVAR0 LHLD TEMP1  VAR DEFINITION ADDR
*   
*   
*  SAVE VAR INFO IN STATIC AREA
*   
 XCHG .  VAR DEFINITION ADDRESS TO DE, SHIT TO HL
 XTHL .  ADDR OF STATIC AREA, SHIT TO STACK
 CALL DSTORE
 XTHL .  SHIT TO HL, ADDR OF STATIC TO STACK
 LHLD TEMP2  GET SIZE IN BYTES
 XCHG .  VAR ADDR TO HL, SIZE TO DE
 INX H  SKIP SIZE IN VAR DEFINITION
 INX H
 XTHL .  ADDR OF STATIC AREA
 CALL DSTORE  SAVE SIZE
 XTHL .  ADDR OF VAR
 CALL DLOAD  GET FIRST INDEX
 XTHL .  ADDR OF STATIC
 CALL DSTORE
 XTHL .  ADDR OF VAR
 CALL DLOAD  GET SECOND INDEX
 XTHL .  ADDR OF STATIC
 CALL DSTORE
 XTHL .  ADDR OF VAR
 CALL DLOAD  MUST BE ZERO FOR END OF INDEX LIST
 MOV A,D
 ORA E
 JNZ MDERR  MAT DIM ERROR
 XCHG .  ADDR OF DATA TO DE
 XTHL .  ADDR OF STATIC
 CALL DSTORE
 POP D  CLEAN STACK OFF
 RET
*   
*   
MA DS 2  ADDR OF DEFINITION
MABZ DS 2  SIZE IN BYTES
MAROW DS 2  ROW SIZE IN ELEMENTS
MACOL DS 2  COL SIZE IN ELEMENTS
MADB DS 2  DATA BASE ADDRESS
*   
MR DS 2
MRBZ DS 2
MRROW DS 2
MRCOL DS 2
MRDB DS 2
*   
MB DS 2
MBBZ DS 2
MBROW DS 2
MBCOL DS 2
MBDB DS 2
*   
*