mirror of
https://github.com/pkimpel/retro-220.git
synced 2026-03-03 01:58:17 +00:00
2d06034237
1. Supply runnable examples for all five sample programs in the BALGOL reference manual. 2. Regenerate the Generator and Compiler listings and tape images. 3. Fix assembler bugs with "S" format code on input. 4. Fix BAC-Assembler bug generating a machine-language deck for the LABEL intrinsic. 5. Note that some of these changes require retro-220 version 0.08 in order to work properly.
220 lines
5.7 KiB
Plaintext
220 lines
5.7 KiB
Plaintext
2 COMMENT FOURTH EXAMPLE PROGRAM FROM BALGOL MANUAL, MARCH 1963.
|
|
2 NOTE THAT THIS REQUIRES A SYSTEM WITH AT LEAST 8000 WORDS.
|
|
2
|
|
2 THE PROGRAM BELOW HAS BEEN WRITTEN BY G. FORSYTHE, OF STANFORD
|
|
2 UNIVERSITY. IT SOLVES A SET OF LINEAR EQUATIONS OF THE FORM AY = B,
|
|
2 USING CROUT'S METHOD WITH INTERCHANGES;
|
|
2
|
|
2 COMMENT FORSYTHE PROGRAM;
|
|
2 PROCEDURE PRODUCT (; N, A(), P, E);
|
|
2 BEGIN COMMENT THIS FORMS THE PRODUCT OF ARBITRARY FLOATING NUMBERS
|
|
2 A(I), FOR I=(1,1,N). EXPONENT OVERFLOW OR UNDERFLOW IS
|
|
2 PREVENTED. THE ANSWER IS P TIMES 10*E WHERE E IS 0 IF POSSIBLE.
|
|
2 IF E NEQ 0, THEN WE NORMALIZE P SO THAT 0.1 LEQ ABS(P) LSS 1.0;
|
|
2 INTEGER E, F, I, K, N;
|
|
2
|
|
2 Q = 1.0**-10; F = 10;
|
|
2 FOR I = (1,1,N);
|
|
2 BEGIN
|
|
2 IF A(I) EQL 0.0;
|
|
2 BEGIN
|
|
2 P = 0.0;
|
|
2 E = 0;
|
|
2 RETURN
|
|
2 END;
|
|
2
|
|
2 IF ABS(A(I)) LEQ 1.0;
|
|
2 BEGIN
|
|
2 F = F-20;
|
|
2 Q = Q.(10.0*20)
|
|
2 END;
|
|
2
|
|
2 Q = Q.A(I);
|
|
2 X = ABS(Q);
|
|
2 FOR K = (-10,1,10), (-11,-1,-41), (11,1,41);
|
|
2 IF ((10.0*K LEQ X) AND (X LSS 10.0*(K+1)));
|
|
2 BEGIN
|
|
2 Q = Q.(10.0*(-10-K));
|
|
2 F = F + K + 10;
|
|
2 GO TO 1
|
|
2 END;
|
|
2 1.. END;
|
|
2
|
|
2 IF (((-40) LEQ F) AND (F LEQ 58));
|
|
2 BEGIN
|
|
2 P = (Q.(10.0*9)).(10.0*(F-9));
|
|
2 E = 0;
|
|
2 RETURN
|
|
2 END;
|
|
2
|
|
2 P = Q.(10.0*9);
|
|
2 E = F - 9;
|
|
2 RETURN
|
|
2 END PRODUCT();
|
|
2
|
|
2 PROCEDURE INNERPRODUCT (S, F, U(), V());
|
|
2 BEGIN COMMENT THIS FORMS THE INNER PRODUCT OF THE VECTORS
|
|
2 U(I) AND V(I) FOR I = (S,1,F);
|
|
2 INTEGER I, S, F;
|
|
2
|
|
2 SUM = 0.0;
|
|
2 FOR I = (S,1,F);
|
|
2 SUM = SUM + U(I).V(I);
|
|
2 INNERPRODUCT() = SUM;
|
|
2 RETURN
|
|
2 END INNERPRODUCT();
|
|
2
|
|
2 PROCEDURE CROUT4 (; N, A(,), B(), Y(), PIVOT(), DET, EX7;
|
|
2 SINGULAR, IP());
|
|
2 BEGIN COMMENT THIS IS CROUTS METHOD WITH INTERCHANGES, TO SOLVE
|
|
2 AY = B AND OBTAIN THE TRIANGULAR DECOMPOSITION. IP() STANDS FOR
|
|
2 AN INNERPRODUCT ROUTINE THAT MUST BE AVAILABLE WHEN CROUT4() IS
|
|
2 CALLED. ALSO, PRODUCT() MUST BE AVAILABLE. THE DETERMINANT OF A
|
|
2 IS COMPUTED IN THE FORM DET TIMES 10*EX7, WHERE EX7 IS 0 IF
|
|
2 POSSIBLE. IF EX7 NEQ 0, THEN WE NORMALIZE DET WITH 0.1 LEQ
|
|
2 ABS(DET) LSS 1;
|
|
2 INTEGER K, I, J, IMAX, N, PIVOT;
|
|
2 INTEGER EX7;
|
|
2
|
|
2 INT = 1.0;
|
|
2 FOR K = (1,1,N);
|
|
2 BEGIN
|
|
2 TEMP = 0;
|
|
2 FOR I = (K,1,N);
|
|
2 BEGIN
|
|
2 A(I,K) = A(I,K) - IP(1, K-1, A(I,), A(,K));
|
|
2 IF ABS(A(I,K)) GTR TEMP;
|
|
2 BEGIN
|
|
2 TEMP = ABS(A(I,K));
|
|
2 IMAX = I
|
|
2 END
|
|
2 END;
|
|
2
|
|
2 PIVOT(K) = IMAX;
|
|
2 COMMENT WE HAVE FOUND THAT A(IMAX,K) IS THE LARGEST PIVOT IN COL
|
|
2 K. NOW WE INTERCHANGE ROWS K AND IMAX;
|
|
2 IF IMAX NEQ K;
|
|
2 BEGIN
|
|
2 INT = -INT;
|
|
2 FOR J = (1,1,N);
|
|
2 BEGIN
|
|
2 TEMP = A(K,J);
|
|
2 A(K,J) = A(IMAX,J);
|
|
2 A(IMAX,J) = TEMP
|
|
2 END;
|
|
2
|
|
2 TEMP = B(K);
|
|
2 B(K) = B(IMAX);
|
|
2 B(IMAX) = TEMP
|
|
2 END;
|
|
2
|
|
2 COMMENT NOW FOR THE ELIMINATION;
|
|
2 IF A(K,K) EQL 0;
|
|
2 BEGIN
|
|
2 DET = 0.0;
|
|
2 EX7 = 0;
|
|
2 GO TO SINGULAR;
|
|
2 END;
|
|
2
|
|
2 FOR I = (K+1,1,N);
|
|
2 BEGIN
|
|
2 XX = A(I,K);
|
|
2 XY = A(K,K);
|
|
2 X = 1.0;
|
|
2 X = X.X;
|
|
2 A(I,K) = XX/XY
|
|
2 END;
|
|
2
|
|
2 FOR J = (K+1,1,N);
|
|
2 A(K,J) = A(K,J) - IP(1, K-1, A(K,), A(,J));
|
|
2
|
|
2 B(K) = B(K) - IP(1, K-1, A(K,), B())
|
|
2 END;
|
|
2
|
|
2 FOR I = (1,1,N);
|
|
2 Y(I) = A(I,I);
|
|
2 PRODUCT (; N, Y(), DET, EX7);
|
|
2 DET = INT.DET;
|
|
2
|
|
2 COMMENT NOW FOR THE BACK SUBSTITUTION;
|
|
2 FOR K = (N,-1,1);
|
|
2 BEGIN
|
|
2 XX = B(K) - IP(K+1, N, A(K,), Y());
|
|
2 XY = A(K,K);
|
|
2 X = 1.0;
|
|
2 X = X.X;
|
|
2 Y(K) = XX/XY
|
|
2 END;
|
|
2
|
|
2 RETURN;
|
|
2 END CROUT4();
|
|
2
|
|
2 PROCEDURE SOLV2 (; N, B(,), C(), PIVOT(), Z(); IP());
|
|
2 BEGIN COMMENT IT IS ASSUMED THAT A MATRIX A HAS ALREADY BEEN
|
|
2 TRANSFORMED INTO B BY CROUT, BUT THAT A NEW COLUMN C HAS
|
|
2 NOT BEEN PROCESSED. SOLV2() SOLVES THE SYSTEM BZ = C.
|
|
2 AN INNERPRODUCT PROCEDURE MUST BE USED WITH SOLV2();
|
|
2 INTEGER K, N, PIVOT;
|
|
2
|
|
2 FOR K = (1,1,N);
|
|
2 BEGIN
|
|
2 TEMP = C(PIVOT(K));
|
|
2 C(PIVOT(K)) = C(K);
|
|
2 C(K) = TEMP;
|
|
2 C(K) = C(K) - IP(1, K-1, B(K,), C())
|
|
2 END;
|
|
2
|
|
2 FOR K = (N,-1,1);
|
|
2 Z(K) = (C(K) - IP(K+1, N, B(K,), Z()))/B(K,K); *WAS N,B(K), *
|
|
2 RETURN
|
|
2 END SOLV2();
|
|
2
|
|
2 COMMENT FORSYTHE TEST CROUT US169 EXT 2274;
|
|
2 FORMAT FRMTFL (W0, (6F19.8, W0));
|
|
2 FORMAT FRMTFX (W0, (6I19, W0));
|
|
2 INTEGER PIVOT();
|
|
2 INTEGER EX;
|
|
2 INTEGER I, J, N;
|
|
2 ARRAY A(70,70), B(70), Y(70), C(70), PIVOT(70); *WAS A(70,70, B(*
|
|
2 INPUT DATA (N, FOR I=(1,1,N); (FOR J=(1,1,N); A(I,J), B(I)));
|
|
2 INPUT VECTOR (N, FOR I=(1,1,N); C(I));
|
|
2
|
|
2 START..
|
|
2 READ (;; DATA);
|
|
2 READ (;; VECTOR);
|
|
2 OUTPUT ORDER (N);
|
|
2 OUTPUT DATAO (FOR I=(1,1,N); (FOR J=(1,1,N); A(I,J), B(I)));
|
|
2 OUTPUT VECTORO (FOR I=(1,1,N); C(I));
|
|
2 WRITE (;; ORDER, FRMTFX);
|
|
2 WRITE (;; DATAO, FRMTFL);
|
|
2 WRITE (;; ORDER, FRMTFX);
|
|
2 WRITE (;; VECTORO, FRMTFL);
|
|
2 CROUT4 (; N, A(,), B(), Y(), PIVOT(), DET, EX;
|
|
2 SINGULAR, INNERPRODUCT());
|
|
2 WRITE (;; DATAO, FRMTFL);
|
|
2 OUTPUT ANSWER (FOR I=(1,1,N); Y(I));
|
|
2 OUTPUT PIVOTO (N, FOR I=(1,1,N); PIVOT(I));
|
|
2 OUTPUT DETO (DET);
|
|
2 OUTPUT EXPO (EX);
|
|
2 WRITE (;; PIVOTO, FRMTFX);
|
|
2 WRITE (;; ANSWER, FRMTFL);
|
|
2 WRITE (;; DETO, FRMTFL);
|
|
2 WRITE (;; EXPO, FRMTFX);
|
|
2 SOLV2 (; N, A(,), C(), PIVOT(), Y(); INNERPRODUCT());
|
|
2 WRITE (;; VECTORO, FRMTFL);
|
|
2 WRITE (;; ANSWER, FRMTFL);
|
|
2 GO TO START;
|
|
2
|
|
2 SINGULAR..
|
|
2 WRITE (;; FRMTSI);
|
|
2 FORMAT FRMTSI (W0, *SINGULAR*, W0);
|
|
2 GO TO START;
|
|
2 FINISH;
|
|
5 4
|
|
5 9. 3. 3. 3. 24.
|
|
5 3. 10. -2. -2. 17.
|
|
5 3. -2. 18. 10. 45.
|
|
5 3. -2. 10. 10. 29.
|
|
5 4
|
|
5 24. 17. 45. 29.
|