.TITLE EQSZ ; .MACRO .EQSZ A,B,N ;A=ADDRESS OF NxN MATRIX ;B=ADDRESS OF B-MATRIX OF DIMENSION N ;SOLVES MATRIX EQ. A*X = B A0=R0 ;ANSWER IS PUT INTO B; A-MATRIX IS DESTROYED A1=R1 ;SEE EQSM.PAS .MCALL .TLQ,.MOVM,.MOVZ,.EQSZ,.ADDZ,.SUBZ,.MULZ,.DIVZ,.ABSZ,.MOVZ .GLOBL .EQSZ,.CALL,EQSZ,EQSZF .MACRO OFFSET N,I,DI,J,DJ ;CALCULATES (I*DJ+J)*8. FOR ARRAYS .ENABL LSB MOV I,65$ MOV J,65$+2 MOV DJ,65$+4 MOV R1,-(SP) MOV 65$,R1 MUL 65$+4,R1 ADD 65$+2,R1 ASH #3,R1 MOV R1,65$ BR 66$ 65$: .BLKW 1 ;I OR N .BLKW 1 ;J .BLKW 1 ;DJ 66$: MOV (SP)+,R1 MOV 65$,N .DSABL LSB .ENDM EQSZ: .EQSZ 2(R5),4(R5),@6(R5) ;EQSZ(A,B,N) FOR PASCAL RETURN ;CALL EQSZF(A,B,N) FOR FORTRAN ;TRANSPOSE A-MATRIX BECAUSE ARRAY ADDRESSING IS BACKWARDS EQSZF: MOV R0,-(SP) ;I MOV R1,-(SP) ;ADDR A[I,J] MOV R2,-(SP) ;J MOV R3,-(SP) ;ADDR A[J,I] CLR R0 ;I LL1: MOV R0,R2 LL2: INC R2 CMP R2,@6(R5) BGE NEX OFFSET R1,R0,@6(R5),R2,@6(R5) ADD 2(R5),R1 ;ADDR A[I,J] OFFSET R3,R2,@6(R5),R0,@6(R5) ADD 2(R5),R3 ;ADDR A[J,I] .MOVZ (R1),Z0 .MOVZ (R3),(R1) .MOVZ Z0,(R3) BR LL2 NEX: INC R0 CMP R0,@6(R5) BLT LL1 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 .EQSZ 2(R5),4(R5),@6(R5) RETURN ;------------------ N: .BLKW 1 B: .BLKW 1 A: .BLKW 1 .EQSZ: TST N BLE ERR CMP N,#50. BLE OKAY ERR: .TLQ <.EQSZ DIMENSION ERROR> JMP .CALL OKAY: MOV R0,-(SP) ;R0=I MOV R1,-(SP) ;ADDRESS CALCULATION MOV R2,-(SP) ;J MOV R3,-(SP) ;ROWMAX MOV R4,-(SP) ;K MOV R5,-(SP) ;ADDRESS CALCULATION STFPS -(SP) ;ENABLE FLOATING-PT ERROR REPORTING MOV 244,-(SP) ;SAVE OLD INTERRUPT VECTOR MOV #INTRPT,244 LDFPS #0 ;ENABLE FP INTERRUPT MOV N,R0 ;FOR I=1 TO N DO MOV #USED,R1 L1: CLRB (R1)+ ;USED[I]= FALSE HAS THIS ROW BEEN USED YET? SOB R0,L1 ;----------------------- CLR R0 ;FOR I=1 TO N DO I=R0=COLUMN TO BE CLEARED LI: CLRF A0 ;MAX=0 CLR R2 ;DO J=1 TO N TO FIND MAX ELEMENT A[J,I] LJ: TSTB USED(R2) ;IF (NOT USED[J]) AND (ABS(A[J,I])>=MAX) BGT NEXTJ ;THIS ROW ALREADY USED? ; .OFSET R1,R2,N,R0,N ;A1=ABS(A[J,I]) MOV R2,R1 MUL N,R1 ADD R0,R1 ASH #3,R1 ADD A,R1 ; ABSF A1 .ABSZ (R1),A1 CMPF A1,A0 CFCC BLT NEXTJ LDF A1,A0 ;MAX=A1 MOV R2,R3 ;R3=ROWMAX=J NEXTJ: INC R2 CMP R2,N BLT LJ MOVB R3,ROW(R0) ;ROW[I]=ROWMAX INCB USED(R3) ;USED[ROWMAX]=TRUE ;NORMALIZE ROWMAXth ROW SO THAT ITS Ith COLUMN ELEMENT=1 ; .OFSET R1,R3,N,R0,N ;Q=A[ROWMAX,I] MOV R3,R1 MUL N,R1 ADD R0,R1 ASH #3,R1 ADD A,R1 .MOVZ (R1),Z0 ;Q ; .OFSET R1,R3,N,#0,N MOV R3,R1 MUL N,R1 ASH #3,R1 ADD A,R1 ;ADDRESS OF A[ROWMAX,1] MOV N,R4 ;K; FOR K=1 TO N DO LK: .DIVZ (R1),Z0,(R1)+ ;A[ROWMAX,K]=A[ROWMAX,K]/Q SOB R4,LK ; .OFSET R1,R3,N ;B[ROWMAX]=B[ROWMAX]/Q DO SAME THING TO B MOV R3,R1 ASH #3,R1 ADD B,R1 .DIVZ (R1),Z0,(R1) ;PUT ZEROS IN Ith COLUMN CLR R2 ;FOR J=1 TO N DO DO Jth ROW LJJ: CMP R2,R3 ;IF J=ROWMAX, SKIP ROWMAX BNE S1 JMP NEXTJJ ; .OFSET R1,R2,N,R0,N ;A0=Q=A[J,I] S1: MOV R2,R1 MUL N,R1 ADD R0,R1 ASH #3,R1 ADD A,R1 .MOVZ (R1),Z0 ;Q ; .OFSET R1,R2,N,#0,N MOV R2,R1 MUL N,R1 ASH #3,R1 ADD A,R1 ;ADDR OF A[J,1] ; .OFSET R5,R3,N,#0,N MOV R3,R5 MUL N,R5 ASH #3,R5 ADD A,R5 ;ADDR OF A[ROWMAX,1] MOV N,R4 ;K LKK: .MULZ (R5)+,Z0,Z1 ;FOR K=1 TO N DO DO ALL COLUMNS OF Jth ROW .SUBZ (R1),Z1,(R1)+ ;A[J,K]=A[J,K]-Q*A[ROWMAX,K] DEC R4 BGT LKK ;DO SAME THING TO B ; .OFSET R5,R3,N ;B[J]=B[J]-Q*B[ROWMAX] MOV R3,R5 ASH #3,R5 ADD B,R5 ; .OFSET R1,R2,N MOV R2,R1 ASH #3,R1 ADD B,R1 .MULZ (R5),Z0,Z1 .SUBZ (R1),Z1,(R1) NEXTJJ: INC R2 CMP R2,N BGE S2 JMP LJJ S2: INC R0 CMP R0,N BGE COPY JMP LI ;-------------------------COPY B-MATRIX INTO B-MATRIX IN CORRECT ORDER COPY: .MOVM B,A,N,#2 ;USE A-MATRIX TEMPORARILY CLR R0 ;FOR I=1 TO N DO B[I]=A[ROW[I]] MOV B,R1 LII: MOVB ROW(R0),R2 ASH #3,R2 ADD A,R2 .MOVZ (R2),(R1)+ INC R0 CMP R0,N BLT LII MOV (SP)+,244 ;RESTORE PREVIOUS FLOATING PT INTERRUPTS LDFPS (SP)+ MOV (SP)+,R5 MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RETURN INTRPT: .TLQ <.EQSZ FLOATING POINT OVERFLOW OR DIVF 0> JMP .CALL Z0: .BLKB 8. ;COMPLEX "ACCUMULATORS" Z1: .BLKB 8. ROW: .BLKB 50. USED: .BLKB 50. .END