github.com/pkimpel.retro-220
1
0
Fork 0
mirror of https://github.com/pkimpel/retro-220.git synced 2026-02-27 00:59:55 +00:00
Code Issues Releases Wiki Activity

1. Commit proofing updates to BALGOL-Main and BALGOL-Overlay transcriptions.

Browse Source 
2. Correct and reorder op code table in BAC-Assembler.
3. Commit tools/BAC-DeckGen.cmd script to generate card deck files from transcription files.
4. Add /Q (quiet mode) switch to BAC-Xscript-Reformatter.wsf, correct problem with output of last card.
5. Commit examples 2, 3, and 4 from BALGOL manual; commit corrections to example 1.
This commit is contained in:
Paul Kimpel
2017-03-12 08:15:16 -07:00
parent af47e574af
commit cf932d5c85
11 changed files with 517 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
software/BALGOL/BALGOL-Examples/Example-1-BALGOL-Typos.card
View File

@@ -18,7 +18,7 @@
2 BRESULTS (FOR I=(1,1,N); FOR J=(1,1,N); B(I,J)),
2 COEFFS (FOR NU=(4,4,N-1); HA(2NU-1)),
2 HFNRES (FOR K=(1,1,29); HFN(K)),
2 CRES(CONST), HFCNRES (TH, FOR K=(115); HFNC(K)), <<TYPOS
2 CRES(CONST), HFCNRES (TH, FOR K=(115); HFNC(K)), <<TYPOS
2 HFCENRES(TH, FOR K=(1,1,6); HFCEN(K));
2 FORMAT VECTOR (B8,6F16.8,W0),
2 FTITLE (B48,*FRESULTS,FA(I,J)*,W3,W2),
@@ -50,12 +50,12 @@
2 END;
2 WRITE (;; FTITLE);
2 WRITE (;; FRESULTS, VECTOR);
2 FOR J - (1,1,N); <<TYPO
2 FOR J - (1,1,N); <<TYPO
2 B(1,J) = FA(1,J);
2 FOR I = (2,1,N);
2 BEGIN
2 FOR J = (1,1,I-1);
2 B(I,J = -B(J,I)/B(J,J); <<TYPO
2 B(I,J = -B(J,I)/B(J,J); <<TYPO
2 FOR J = (I,1,N);
2 BEGIN
2 B(I,J) = FA(I,J);
@@ -67,7 +67,7 @@
2 END;
2 FOR I = (1,1,N);
2 B(I,I) = 1.0/(SQRT(B(I,I)).I);
2 WRITE (;; BTITLE); <<UNDEC
2 WRITE (;; BTITLE); <<UNDEC
2 WRITE (;; BRESULTS, VECTOR);
2 FOR I = (1,1,N);
2 FOR J = (1,1,N);
@@ -84,7 +84,7 @@
2 A(I,I) = B(I,I)
2 END;
2 WRITE (;; ATITLE);
2 WRITE (;; ARESULT, VECTOR); <<TYPO
2 WRITE (;; ARESULT, VECTOR); <<TYPO
2
2 COMMENT NOW CONSTRUCT THE APROXIMATION TO THE SOLUTION;
2
@@ -115,7 +115,7 @@
2 HAA(J) = 0;
2 FOR NU = (J,4,N-1);
2 HAA(J) = HAA(J) + HA(2NU-1).A(NU,J)
2 END <<SEMI
2 END <<SEMI
2 FOR M = (1,1,18);
2 BEGIN
2 HFN(M) = 0;
@@ -162,11 +162,11 @@
2 BEGIN
2 HFCEN(J) = CONST;
2 FOR M = (4,4,N-1);
2 HFCEN(J) = FHCEN(J) + HAA(M).(0.5.J)*M. <<TYPO
2 HFCEN(J) = FHCEN(J) + HAA(M).(0.5.J)*M. <<TYPO
2 COS((I-1).0.087266463.M)
2 END;
2 WRITE (;; HFCNRES, TABLE)
2 END;
2 STOP 1234;
2 GO TO RDIM;
2 FINISH;
2 FINISH;

6
software/BALGOL/BALGOL-Examples/Example-1-BALGOL.card
View File

@@ -18,11 +18,11 @@
2 BRESULTS (FOR I=(1,1,N); FOR J=(1,1,N); B(I,J)),
2 COEFFS (FOR NU=(4,4,N-1); HA(2NU-1)),
2 HFNRES (FOR K=(1,1,29); HFN(K)),
2 CRES(CONST), HFCNRES (TH, FOR K=(1,1,5); HFCN(K)),
2 CRES(CONST), HFCNRES (TH, FOR K=(1,1,5); HFCN(K)), *WAS HFNC*
2 HFCENRES(TH, FOR K=(1,1,6); HFCEN(K));
2 FORMAT VECTOR (B8,6F16.8,W0),
2 FTITLE (B48,*FRESULTS,FA(I,J)*,W3,W2),
2 BTITLE (B48,*BRESULTS,B(I,J)*,W3,W2), *ADDED*
2 BTITLE (B48,*BRESULTS,B(I,J)*,W3,W2), *ADDED*
2 ATITLE (B48,*ARESULTS,A(I,J)*,W3,W2),
2 COEFTITLE (B30,*HA(8NU-1)*,W2),
2 BDYVALUES (B42,*PRELIMINARY BOUNDARY VALUES*,W3,W2),
@@ -170,4 +170,4 @@
2 END;
2 STOP 1234;
2 GO TO RDIM;
2 FINISH;
2 FINISH;

77
software/BALGOL/BALGOL-Examples/Example-2-BALGOL.card Normal file
View File

@@ -0,0 +1,77 @@
2 COMMENT SECOND EXAMPLE PROGRAM FROM BALGOL MANUAL, MARCH 1963.
2 THE PROGRAM WHICH FOLLOWS IS ONE FOR SURVEY TRAVERSE CALCULATIONS;
2
2 COMMENT SURVEY TRAVERSE CALCULATIONS;
2 TRACE ANGLE;
2 DUMP EW, NSC, CD;
2 INTEGER I, J, K, SURVEY, D(), M(), S(), Q(), N;
2 FUNCTION LENGTH(X,Y) = SQRT(X*2 + Y*2);
2 ARRAY D(200), M(200), S(200), Q(200), MD(200), NS(200),
2 EW(200), CNS(201), CEW(201);
2
2 START..
2 READ(;; IDENT);
2 TMD = 0; TNS = 0; TEW = 0;
2 FOR I= (1,1,N);
2 BEGIN
2 READ (;; STATION);
2 IF I NEQ K;
2 STOP K;
2 Z = (60(60D(I) + M(I)) + S(I))/6.48**5;
2 SWITCH Q(I), (QUAD1, QUAD2, QUAD3, QUAD4);
2 QUAD1.. Z = 0.5 - Z; GO TO ANGLE;
2 QUAD2.. Z = 1.5 + Z; GO TO ANGLE;
2 QUAD3.. Z = 0.5 + Z; GO TO ANGLE;
2 QUAD4.. Z = 1.5 - Z;
2 ANGLE..
2 ALPHA = 3.1415927Z;
2 NS(I) = MD(I)SIN(ALPHA);
2 TNS = TNS + NS(I);
2 EW(I) = MD(I)COS(ALPHA);
2 TEW = TEW + EW(I);
2 TMD = TMD + MD(I)
2 END;
2
2 ERROR = LENGTH(TNS, TEW);
2 WRITE (;; TITLE, F1);
2 NSC = -TNS/TMD;
2 EWCF = -TEW/TMD;
2 TCD = 0; TCNS = 0; TCEW = 0;
2 FOR I = (1,1,N);
2 BEGIN
2 CNS(I) = NS(I) + MD(I).NSCF;
2 TCNS = TCNS + CNS(I);
2 CEW(I) = EW(I) + MD(I).EWCF;
2 TCEW = TCEW + CEW(I);
2 CD = LENGTH(CNS(I), CEW(I));
2 TCD = TCD + CD;
2 WRITE (;; ANSWERS, F2)
2 END;
2
2 CNS(N+1) = CNS(1);
2 CEW(N+1) = CEW(1);
2 SUM = 0;
2 FOR I=(1,1,N);
2 SUM = SUM + (CNS(I+1) - CNS(I)) (CEW(I+1) + CEW(I));
2 SQFT = ABS(SUM)/2;
2 ACRES = SQFT/43560;
2 WRITE (;; TOTALS, F3);
2 GO TO START;
2
2 INPUT
2 IDENT (SURVEY, N, ERROR),
2 STATION (K, D(I), M(K), S(I), Q(I), MD(I));
2 OUTPUT
2 TITLE (SURVEY, N, ERROR),
2 ANSWERS (I, D(I), M(I), S(I), Q(I), MD(I), CD, CNS(I), CEW(I)),
2 TOTALS (TMD, TCD, TCNS, TCEW, SQFT, ACRES);
2 FORMAT
2 F1 (*SURVEY*, I8, B5, *NUMBER OF LEGS*, I5, *CLOSURE ERROR*, X9.2,
2 W1, *LEG*, B5, *ANGLE*, B7, *MEASURED*, B5, *CORRECTED*, B3,
2 *NORTH-SOUTH EAST-WEST*, W6,
2 *NO. DD MM SS Q DISTANCE DISTANCE DISPLACEMENT DISPLACEMENT*,
2 2W),
2 F2,(I3, I5, 2I3, I2, 4X13.2, W), *WAS F2,(*
2 F3 (B6, *TOTALS*, B4, 4X13.2, W4, *AREA OF TRAVERSE*, X13.2,
2 *SQUARE FEET*, X13.2, *ACRES*, W6);
2 FINISH;

61
software/BALGOL/BALGOL-Examples/Example-3-BALGOL.card Normal file
View File

@@ -0,0 +1,61 @@
2 COMMENT THIRD EXAMPLE PROGRAM FROM BALGOL MANUAL, MARCH 1963.
2 THE SHORT PROGRAM WHICH FOLLOWS IS FOR A REDUCTION OF A SQUARE MATRIX
2 TO TRIDIAGONAL FORM, USING THE METHOD OF HOUSEHOLDER;
2
2 COMMENT HOUSEHOLDER REDUCTION TO TRIDIAGONAL FORM;
2 INTEGER I, J, K, L, R, N;
2 ARRAY A(50,50), X(50), P(50);
2 INPUT
2 ELEMENT (I, J, Q);
2 OUTPUT
2 AOUT (A(R,R)),
2 BOUT (-0.5/S);
2 FORMAT
2 AF (B10, X10.5, W),
2 BF (B40, X10.5, W);
2
2 N = 5;
2 IN..
2 READ (;; ELEMENT);
2 IF I NEQ 0;
2 BEGIN
2 A(I,J) = Q;
2 GO TO IN
2 END;
2
2 FOR R = (1,1,N-1);
2 BEGIN
2 WRITE (;; AOUT, AF);
2 L = R+1;
2 S = 0;
2 FOR J = (L,1,N);
2 S = S + A(R,J)*2;
2
2 S = SIGN(A(R,L))/2SQRT(S);
2 WRITE (;; BOUT, BF);
2 X(L) = SQRT(0.5 + A(R,L).S);
2 S = S/X(L);
2 FOR J = (R+2,1,N);
2 X(J) = S.A(R,J);
2 FOR J = (R,1,N);
2 BEGIN
2 S = 0;
2 FOR K = (L,1,N);
2 S = S + A(MIN(J,K), MAX(J,K)).X(K);
2 P(J) = S
2 END;
2
2 S = 0;
2 FOR J = (L,1,N);
2 S = S + K(J).P(J);
2 FOR J = (L,1,N);
2 P(J) = P(J) - S.X(J);
2 FOR J = (L,1,N);
2 FOR K = (J,1,N);
2 A(J,K) = A(J,K) - 2(X(J).P(K) + X(K).P(J))
2 END;
2
2 WRITE (;; AOUT, AF);
2 STOP;
2 GO TO IN;
2 FINISH;

211
software/BALGOL/BALGOL-Examples/Example-4-BALGOL.card Normal file
View File

@@ -0,0 +1,211 @@
2 COMMENT FOURTH EXAMPLE PROGRAM FROM BALGOL MANUAL, MARCH 1963.
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 + 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 NOT
2 BEEN PROCESSED. SOLV2() SOLVES
2 THE SYSTEM BZ = C. AN INNERPRODUCT PROCEDURE MUST BE USED WITH
2 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 FMTFX (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;

14
software/BALGOL/BALGOL-Main.baca
View File

@@ -1,10 +1,10 @@
ASMBL 1
REORD 1.00
THE BURROUGHS ALGEBRAIC COMPILER
ERDWINN, MERNER, CROWDER, SPERONI, KNUTH
DAHM, OLIPHINT, LOGEMANN, SCHUMAN
FEBRUARY 1,1962
01 0 ASMBL 1
02 0 REORD 1.00
10 0
11 0 THE BURROUGHS ALGEBRAIC COMPILER
12 0 ERDWINN, MERNER, CROWDER, SPERONI, KNUTH
13 0 DAHM, OLIPHINT, LOGEMANN, SCHUMAN
14 0 FEBRUARY 1,1962
15 0 0000 OT DEFN 1 OUTPUT TAPE UNIT
16 0 0000 T DEFN 2 PROGRAM TAPE UNIT
17 0 0000 PNTR DEFN 2 PRINTER UNIT

36
software/BALGOL/BALGOL-Overlay.baca
View File

@@ -1,5 +1,5 @@
ASMBL 2
REORD 100.0
01 0 ASMBL 2
02 0 REORD 100.0
01 00 0 0000 BUF DEFN 0002 TAPE OUTPUT BUFFER
01 01 0 0000 OT DEFN 1 OUTPUT TAPE
01 02 0 0000 T DEFN 2 COMPILER TAPE UNIT
@@ -15,7 +15,7 @@
001 12 0 0000 HALT1 DEFN 208 ERROR FLAG(SIGN IS 8 IF NO ERRORS)
001 13 0 0000 VARB DEFN 251 LAST LOCATION USED FOR VARIABLES, ECT
01 14 0 0000 EPSLN DEFN 258 NUMBER OF EXTERNAL PROGRAMS
01 15 0 0000 AVAIL DEFN 275 FREED-UP LOCATIONS
01 15 0 0000 AVAIL DEFN 273 FREED-UP LOCATIONS
01 16 0 0000 OP DEFN 275 OPERATOR STACK
01 17 0 0000 DUMBS DEFN 292 DUMP STACK
01 18 0 0000 SX DEFN 400 MAG TAPE BUFFER
@@ -126,12 +126,12 @@
02 23 0 0078 EXT V-
02 24 0 0079 SLA 4
02 25 0 0080 STA SECT,00 GET SEGMENT NUMBER
02 26 0 0081 IFL LODOX,04,I ADVANCE EXIT LINE BY ONE
02 26 0 0081 IFL LODOX,04,1 ADVANCE EXIT LINE BY ONE
02 27 0 0082 CLB
02 28 0 0083 *B MTS 4 SECT,OT SEARCH FOR SEGMENT
02 29 0 0084 MRD 4 100,OT,1
02 30 0 0085 CAD 100
02 31 0 0086 CFA SECT,100 DID THE MACHINE WORK
02 31 0 0086 CFA SECT,00 DID THE MACHINE WORK
02 32 0 0087 BCE LOADP+1 IF YES,LOAD THE SEGMENT
02 33 0 0088 SPO Q2+,3 IF NOT PRINT THE MESSAGE
02 34 0 0089 F424 9669,0,9669 SEGMENT ERROR
@@ -393,7 +393,7 @@
04 90 0 0892 BUN *-1
04 91 0 0893 MRW 4 T
04 92 0 0894 CLA EMIT AN END OF
004 93 0 0895 LSA 8
004 93 0 0895 LSA 8 PROGRAM SIGNAL FOR LOADER
04 94 0 0896 STP FXUPX
04 95 0 0897 BUN FXUP
04 96 0 0898 CAD BUF+98
@@ -598,7 +598,7 @@
06 95 0 1072 SRA 7
06 96 0 1073 ADD T+
06 97 0 1074 SLA 4
06 98 0 1075 CFA HOLD,64 IS THE FIX-UP IN THE GROUP
06 98 0 1075 CFA HOLD,64 IS THE FIX-UP IN THIS GROUP
06 99 0 1076 BCH F+
07 00 0 1077 BUN W- NO
@@ -771,7 +771,7 @@
08 68 0 1235 SLA 4 IT WAS -- SO ENTER
08 69 0 1236 ADD LOCN LL XXXX YYYY
08 70 0 1237 SLA 6 WHERE LL= SEGMENT NUMBER
008 71 0 1238 STA HOLD XXXX= LOCATIN TO BE FIXED UP
008 71 0 1238 STA HOLD XXXX= LOCATION TO BE FIXED UP
08 72 0 1239 LDB AVALE YYYY= FIX-UP
08 73 0 1240 STP INSX
08 74 0 1241 BUN INS
@@ -790,7 +790,7 @@
08 87 0 1254 DLB L,64,0
08 88 0 1255 BUN E-
08 89 0 1256 *T STA HOLD
08 90 0 1257 DLB L,74,0
08 90 0 1257 DLB L,64,0
08 91 0 1258 STP REMX
08 92 0 1259 BUN REM
08 93 0 1260 HLT
@@ -918,7 +918,7 @@
010 15 0 1375 BFA R+,91,6
010 16 0 1376 BUN B+ IGNORE ALL OTHER CHARACTERS
010 17 0 1377 *C IFL SYMBL,12,20
010 18 0 1378 *B IBB A-,9840
010 18 0 1378 *B IBB A-,9840 DID WE FINISH THE CARD
010 19 0 1379 *D STP WEMX
010 20 0 1380 BUN WEM
010 21 0 1381 CNST 30628295809 MISSING FIELD ON SYMBOLIC CARD
@@ -1113,7 +1113,7 @@
012 10 0 1550 BSA Z+,5 SCAN AND SCEARCH(90,91 SPECIAL OPS)
012 11 0 1551 DFL INSTR,12,20 S=4,5 ADDRESS ABSOLUTE
012 12 0 1552 BSA K-,6 S=6,7 ADDRESS RELATIVE TO IDENTIFIER
012 13 0 1553 BSA K-,7 S-8,9 ADDRESS RELATIVE TO PROGRAM
012 13 0 1553 BSA K-,7 S=8,9 ADDRESS RELATIVE TO PROGRAM
012 14 0 1554 DFL INSTR,12,20
012 15 0 1555 BUN L-
@@ -1142,7 +1142,7 @@
012 39 0 1575 ADA MADIT
012 40 0 1576 STA INSTR,44
012 41 0 1577 CLL MADIT
012 42 0 1578 STP WRITX OUTPUT PROCESSED INSTRUCTOIN
012 42 0 1578 STP WRITX OUTPUT PROCESSED INSTRUCTION
012 43 0 1579 BUN WRIT2
012 44 0 1580 *X LDB LBSBX INCREMENTED EXIT
012 45 0 1581 BUN - 1 INDICATES NO FINISH PSEUDO-OP WAS HERE
@@ -1417,7 +1417,7 @@
015 14 0 1829 *C CLA MSG+1
015 15 0 1830 LBC TEMP
015 16 0 1831 SLT 2 TRANSFER CHARACTERS
015 17 0 1832 BFA B+,00,00
015 17 0 1832 BFA B+,00,00 ONE AT A TIME INTO
015 18 0 1833 SLA - 8 BUFFER AREA
015 19 0 1834 DLB TEMP,94,00
015 20 0 1835 LSA 0
@@ -1747,7 +1747,7 @@
018 44 0 2673 BUN YES
018 47 0 2674 NUMLB BZA A+ CONVERT PUBLIC NUMERIC LABELS
018 47 0 2674 NUMLB BZA A+ CONVERT NUMERIC LABELS
018 48 0 2675 SRT 10 TO ALFANUMERIC FORM
018 49 0 2676 CLL VECTR+1 WITH LEADING ZEROES
018 50 0 2677 BFR B+,55,0 SUPPRESSED
@@ -1920,7 +1920,7 @@
020 17 0 2854 NOP 8 I++6 - -
020 18 0 2855 LDB 8 *-1
020 19 0 2856 ASSGZ RTF 8 NONE,4 VARIABLE IN PROGRAM VALUE
020 20 0 2857 CAD 8 I++6
020 20 0 2857 CAA 8 I++6
020 21 0 2858 ADA 8 I++7 V N
020 22 0 2859 BOF 8 *+1 - -
020 23 0 2860 BZA 8 *+2 - -
@@ -2075,7 +2075,7 @@
021 72 0 3080 BFA *+2,04,0 IF IT IS NOT EMPTY
021 73 0 3081 MOW 4 0,OT,1
021 74 0 3082 CLR
021 75 0 3083 STR STOX,04 INITIALIZE STORE ROUTINE
021 75 0 3083 STR STOX,04 INITIALIZE STORE ROUTINE
021 76 0 3084 MOW 4 Q+,OT,3
021 77 0 3085 LDB IDEX
021 78 0 3086 CAD - TBL+100
@@ -2314,7 +2314,7 @@
024 11 0 3394 BUN LDBG
024 14 0 3395 LOD4 DEFN 4
024 14 0 3395 LOD4 DEFN *
024 15 0 3395 *Q MRW 4 OT+10
024 16 0 3396 BCS *+3-LOD4+100,9
024 17 0 3397 *Z25 STP *,2418
@@ -2365,7 +2365,7 @@
024 62 0 3499 IDEX CNST 0 LEVEL OF PROCEDURE
024 63 0 3500 DIM CNST 0 NUMBER OF DIMENSIONS
024 64 0 3501 J CNST 0 COUNTER USED IN CONNECTION WITH LBRT
024 65 0 3502 TST CNST 0 COUNT OF ROUTINES ASSIGNED INDIRECTLY
024 65 0 3502 TST CNST 0 COUNT OF ROUTINES ASSIGNED INDIREDTLY
024 66 0 3503 ADDIT CNST 0
024 67 0 3504 MADIT CNST 0
024 68 0 3505 DIMS LOCN *+20 DIMENSION LIST

98
software/tools/BAC-Assembler.html
View File

@@ -268,50 +268,42 @@ window.addEventListener("load", function() {
var pseudoFINI = -9;
var opTab = {
"HLT": [ 0, 1, 0, 3, 0],
"NOP": [ 1, 1, 0, 3, 0],
"PRD": [ 3, 1, -1, 4, -1, 8, -1, 5, 0],
"PRB": [ 4, 1, -1, 4, -1, 5, 0, 8, 0],
"PRI": [ 5, 1, -1, 4, -1, 8, -1, 5, 0],
"PWR": [ 6, 1, -1, 4, -1, 8, -1],
"PWI": [ 7, 1, -1, 4, -1],
"KAD": [ 8, 1, 0, 3, 0],
"SPO": [ 9, 1, -1, 8, -1, 15, 0],
"CAD": [ 10, 1, -1, 2, 0],
"CAA": [110, 1, -1, 2, 0],
"ADD": [ 12, 1, -1, 2, 0],
"ADA": [112, 1, -1, 2, 0],
"ADL": [ 10, 1, -1, 3, 0],
"CSU": [ 11, 1, -1, 2, 0],
"CSA": [111, 1, -1, 2, 0],
"ADD": [ 12, 1, -1, 2, 0],
"ADA": [112, 1, -1, 2, 0],
"SUB": [ 13, 1, -1, 2, 0],
"SUA": [113, 1, -1, 2, 0],
"MUL": [ 14, 1, -1, 3, 0],
"DIV": [ 15, 1, -1, 3, 0],
"RND": [ 16, 1, 0, 3, 0],
"EXT": [ 17, 1, -1, 3, 0],
"CFA": [ 18, 1, -1, 6, 0],
"CFR": [118, 1, -1, 2, 0],
"ADL": [ 19, 1, -1, 3, 0],
"IBB": [ 20, 1, -1, 3, -1],
"DBB": [ 21, 1, -1, 3, -1],
"FAD": [ 22, 1, -1, 2, 0, 4, 0],
"FAA": [122, 1, -1, 2, 0, 4, 0],
"FSU": [ 23, 1, -1, 2, 0, 4, 0],
"FSA": [123, 1, -1, 2, 0, 4, 0],
"FMU": [ 24, 1, -1, 3, 0],
"FDV": [ 25, 1, -1, 3, 0],
"SRA": [ 48, 1, -1, 2, 0],
"SRT": [148, 1, -1, 2, 0],
"SRS": [248, 1, -1, 2, 0],
"SLA": [ 49, 1, -1, 2, 0],
"SLT": [149, 1, -1, 2, 0],
"SLS": [249, 1, -1, 2, 0],
"LDR": [ 41, 1, -1, 3, 0],
"LDB": [ 42, 1, -1, 2, 0],
"LBC": [142, 1, -1, 2, 0],
"LSA": [ 43, 5, -1, 1, 0, 2, 0],
"STA": [ 40, 1, -1, 6, 0],
"STR": [140, 1, -1, 6, 0],
"STB": [240, 1, -1, 6, 0],
"STP": [ 44, 1, -1, 3, 0],
"IFL": [ 26, 1, -1, 7, -1, 9, -1],
"DFL": [ 27, 1, -1, 7, -1, 9, -1],
"DLB": [ 28, 1, -1, 7, -1, 9, -1],
"RTF": [ 29, 1, -1, 8, -1],
"CLA": [145, 1, 0, 2, 0],
"CLR": [245, 1, 0, 2, 0],
"CAR": [345, 1, 0, 2, 0],
"CLB": [445, 1, 0, 2, 0],
"CAB": [545, 1, 0, 2, 0],
"CRB": [645, 1, 0, 2, 0],
"CLT": [745, 1, 0, 2, 0],
"CLL": [ 46, 1, -1, 3, 0],
"EXT": [ 17, 1, -1, 3, 0],
"CFA": [ 18, 1, -1, 6, 0],
"CFR": [118, 1, -1, 2, 0],
"BUN": [ 30, 1, -1, 3, 0],
"BOF": [ 31, 1, -1, 3, 0],
"BRP": [ 32, 1, -1, 3, 0],
@@ -330,16 +322,34 @@ window.addEventListener("load", function() {
"SOR": [ 39, 1, 0, 2, 0],
"SOH": [139, 1, 0, 2, 0],
"IOM": [239, 1, -1, 2, 0],
"HLT": [ 0, 1, 0, 3, 0],
"NOP": [ 1, 1, 0, 3, 0],
"IBB": [ 20, 1, -1, 3, -1],
"DBB": [ 21, 1, -1, 3, -1],
"IFL": [ 26, 1, -1, 7, -1, 9, -1],
"DFL": [ 27, 1, -1, 7, -1, 9, -1],
"DLB": [ 28, 1, -1, 7, -1, 9, -1],
"STA": [ 40, 1, -1, 6, 0],
"STR": [140, 1, -1, 6, 0],
"STB": [240, 1, -1, 6, 0],
"LDR": [ 41, 1, -1, 3, 0],
"LDB": [ 42, 1, -1, 2, 0],
"LBC": [142, 1, -1, 2, 0],
"LSA": [ 43, 5, -1, 1, 0, 2, 0],
"STP": [ 44, 1, -1, 3, 0],
"CLA": [145, 1, 0, 2, 0],
"CLR": [245, 1, 0, 2, 0],
"CAR": [345, 1, 0, 2, 0],
"CLB": [445, 1, 0, 2, 0],
"CAB": [545, 1, 0, 2, 0],
"CRB": [645, 1, 0, 2, 0],
"CLT": [745, 1, 0, 2, 0],
"CLL": [ 46, 1, -1, 3, 0],
"SRA": [ 48, 1, -1, 2, 0],
"SRT": [148, 1, -1, 2, 0],
"SRS": [248, 1, -1, 2, 0],
"SLA": [ 49, 1, -1, 2, 0],
"SLT": [149, 1, -1, 2, 0],
"SLS": [249, 1, -1, 2, 0],
"MTS": [ 50, 1, -1, 4, -1, 8, 0],
"MFS": [4000050,
1, -1, 4, -1, 8, 0],
"MLS": [450, 4, -1, 8, 0, 1, 0],
"MRW": [850, 4, -1, 8, 0, 1, 0],
"MDA": [950, 4, -1, 8, -1, 1, 0],
"MTC": [ 51, 1, -1, 4, -1, 8, -1, 5, -1],
"MFC": [4000051,
1, -1, 4, -1, 8, -1, 5, -1],
@@ -349,28 +359,20 @@ window.addEventListener("load", function() {
"MIW": [ 54, 1, -1, 4, -1, 10, -1, 9, 0],
"MIR": [ 55, 1, -1, 4, -1, 10, -1, 9, 0],
"MOW": [ 56, 1, -1, 4, -1, 10, -1, 9, 0],
"MIR": [ 57, 1, -1, 4, -1, 10, -1, 9, 0],
"MOR": [ 57, 1, -1, 4, -1, 10, -1, 9, 0],
"MPF": [ 58, 4, -1, 10, -1, 1, 0],
"MPB": [158, 4, -1, 10, -1, 1, 0],
"MPE": [258, 4, -1, 1, 0],
"MLS": [450, 4, -1, 8, 0, 1, 0],
"MRW": [850, 4, -1, 8, 0, 1, 0],
"MDA": [950, 4, -1, 8, -1, 1, 0],
"MIB": [ 59, 1, -1, 4, -1, 8, 0],
"MIE": [159, 1, -1, 4, -1, 8, 0],
"PRD": [ 3, 1, -1, 4, -1, 8, -1, 5, 0],
"PRB": [ 4, 1, -1, 4, -1, 5, 0, 8, 0],
"PRI": [ 5, 1, -1, 4, -1, 8, -1, 5, 0],
"PWR": [ 6, 1, -1, 4, -1, 8, -1],
"PWI": [ 7, 1, -1, 4, -1],
"CRD": [ 60, 1, -1, 4, -1, 5, 0, 8, 0],
"CWR": [ 61, 1, -1, 4, -1, 13, -1, 8, 0],
"CRF": [ 62, 1, -1, 13, -1, 14, 0],
"CWF": [ 63, 1, -1, 13, -1, 14, 0],
"CRI": [ 64, 1, -1, 4, -1],
"CWI": [ 65, 1, -1, 4, -1],
"KAD": [ 8, 1, 0, 3, 0],
"SPO": [ 9, 1, -1, 8, -1, 15, 0],
"HPW": [ 66, 1, -1, 8, -1],
"HPI": [ 67, 1, 0, 3, 0],
// Pseudo-ops
"DEFN": [pseudoDEFN, // define symbol
@@ -1702,8 +1704,12 @@ window.addEventListener("load", function() {
opCode = cardData.text.substring(opCodeIndex, opCodeIndex+5).trim();
switch (opCode) {
case "ASMBL":
printLine(padRight("", 8+5+4+3+8+4+6) +
cardData.text.substring(opCodeIndex, operandIndex+operandLength).trim();
break;
case "REORD":
printLine(padRight("", 8+5+4+3+8+4+6) +
cardData.text.substring(opCodeIndex, operandIndex+operandLength).trim();
break;
default:
done = true;

34
software/tools/BAC-DeckGen.cmd Normal file
View File

@@ -0,0 +1,34 @@
rem Generate BAC-Assembler card decks from BALGOL transcription files.
pushd ..\BALGOL
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Main.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Overlay.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\ACOS.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\ASIN.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\ATAN.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\COS.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\COSH.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\ENTIR.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\ERROR.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\EXP.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\FIX.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\FLFL.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\FLFX.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\FLOAT.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\FXFL.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\FXFX.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\LABEL.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\LOG.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\MONTR.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\READ.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\REED.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\RITE.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\ROMXX.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\SIN.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\SINH.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\SQRT.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\TAN.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\TANH.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\TRACE.baca
..\tools\BAC-Xscript-Reformatter.wsf /q BALGOL-Intrinsics\WRITE.baca
rem Finish BALGOL deck generation.
popd

69
software/tools/BAC-Xscript-Reformatter.wsf
View File

@@ -15,33 +15,31 @@ Option Explicit
' VBScript to extract source from the BALGOL assembly listing transcriptions.
' It reads an assembly transcription file and outputs a BAC-Assembler
' card deck.
' 2. An assembler card deck for the second movement's source.
' 3. A tape image containing the loadable object code for the assembler.
' Note that the assembler object code is placed on lane 1 of the tape
' starting at block 120.
'
' This script should be executed in the current path of the transcription
' files. Output files will be written to that path as well.
'
' Uses Scripting Runtime FileSystemObject.
' Parameters:
' None.
' 1. Name of the transcription file.
' 2. Optional started card sequence string.
' 3. Optional /Q = quiet mode (no MsgBox at end), can be in any position.
'-----------------------------------------------------------------------
' Modification Log.
' 2017-01-06 P.Kimpel
' Original version, cloned from retro-205/software/tools/
' Shell-Xscript-Reformatter.wsf.
' 2017-03-05 P.Kimpel
' Add /Q switch and more flexible parameter ordering; correct EOF problem
' on last card.
'-----------------------------------------------------------------------
Const xScript1 = "BALGOL-Main.baca"
Const xScript2 = "BALGOL-Overlay.baca"
Const xFloat = "BALGOL-FLOAT.baca"
Dim args
Dim deckName
Dim fileName
Dim fso
Dim lastSeq
Dim quietMode
'---------------------------------------
Function PicZn(ByVal s, ByVal chars)
@@ -125,6 +123,7 @@ Sub ExtractCode(byVal xScriptName, byVal deckName)
Dim address
Dim card
Dim cardFile
Dim eof
Dim label
Dim lastAddr
Dim line
@@ -156,7 +155,8 @@ Sub ExtractCode(byVal xScriptName, byVal deckName)
End If
End If
Do While Not xFile.AtEndOfStream
eof = xFile.AtEndOfStream
Do While Not eof
lineNr = lineNr+1
address = RTrim(Mid(line, addrCol, 4))
label = RTrim(Mid(line, labelCol, 5))
@@ -174,7 +174,11 @@ Sub ExtractCode(byVal xScriptName, byVal deckName)
PicXn(label, 6) & PicXn(opCode, 6) & operand
End If
line = xFile.ReadLine
If xFile.AtEndOfStream Then
eof = True
Else
line = xFile.ReadLine
End If
Loop
cardFile.Close
@@ -186,36 +190,43 @@ End Sub
'---------------------------------------------------------------
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
quietMode = False
lastSeq = "01 0"
Set args = WScript.Arguments
If args.Count < 1 Then
For Each deckName In args
If UCase(Trim(deckName)) = "/Q" Then
quietMode = True
ElseIf Len(fileName) = 0 Then
fileName = Trim(deckName)
Else
lastSeq = Trim(deckName)
End If
Next
Set args = Nothing
If Len(fileName) = 0 Then
MsgBox "Must supply the name of the transcription file."
WScript.Quit 9
Else
fileName = Trim(args.Item(0))
If args.Count > 1 Then
lastSeq = Trim(args.Item(1))
'-- Main Line --
If Not fso.FileExists(fileName) Then
MsgBox "Transcription file does not exist: " & vbCrLf & fileName
WScript.Quit 8
Else
lastSeq = "09 0"
deckName = fso.BuildPath(fso.GetParentFolderName(fileName), fso.GetBaseName(fileName)) & ".card"
ExtractCode fileName, deckName
If not quietMode Then
MsgBox "BAC Assembler card deck created: " & vbCrLf & deckName
End If
WScript.Quit 0
End If
End If
Set args = Nothing
'-- Main Line --
If Not fso.FileExists(fileName) Then
MsgBox "Transcription file does not exist: " & vbCrLf & fileName
Else
deckName = fso.BuildPath(fso.GetParentFolderName(fileName), fso.GetBaseName(fileName)) & ".card"
ExtractCode fileName, deckName
MsgBox "BAC Assembler card deck created: " & vbCrLf & deckName
End If
Set fso = Nothing
WScript.Quit 0
]]>
</script>
</job>

7
software/tools/README.txt
View File

@@ -18,5 +18,10 @@ BAC-XScript-Reformatter.wsf
assembly listing transcriptions and reformat them into card decks
for use by BAC-Assembler.html
BAC-DeckGen.cmd
Windows command-line script to generate card decks for BAC-Assembler
from the transcribed *.baca files for the BALGOL compiler.
Paul Kimpel
January 2017
March 2017