github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-03-06 18:51:39 +00:00
Code Issues Releases Wiki Activity

Commit Burroughs KRUNCH and UNKRNCH utilities from CUBE library.

Browse Source
This commit is contained in:
Paul Kimpel
2016-05-30 13:12:33 -07:00
parent db57a9b4fd
commit 9266d9b3c1
7 changed files with 2315 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

46
KRUNCH-UNKRNCH/KRUNCH-As-Krunched.card Normal file
View File

@@ -0,0 +1,46 @@
KRUNCH 000104AA*********************************************************00000010
***************PLEASE NOTE THAT THE BURROUGHS CORPORATION ASSUMES NO RES00000020
PONSIBILITY FOR THE USE OR MAINTENANCE OF THIS PROGRAM.*****************00000030
*******************************************************BEGIN ALPHA CH,T,00000040
IDENT,CHAR,SAVE1,TUF1,TUF2;BOOLEAN ID,ID1,ID2,FIRSTCARD,EOF;INTEGER I,WI00000050
N,WOUT,CIN,COUT,SQ;LABEL K,L,M,N,ENDIT,N1;ALPHA ARRAY BUFIMG[0:9];DEFINE00000060
CR=BUFIMG#;FILE IN KRUCARD(1,10);FILE OUT KRUPNCH 0(1,10);DEFINE CP=KRU00000070
PNCH#;STREAM PROCEDURE SEQUENCE(FO,SQ,IDENT);BEGIN DI~FO;SI~IDENT;SI~SI+00000080
5;DS~3CHR;SI~SQ;DS~5DEC END;BOOLEAN STREAM PROCEDURE ALPHACHECK(T);BEGIN00000090
SI~T;SI~SI+7;DI~LOC ALPHACHECK;DS~8LIT"0";DI~DI-1;SKIP 5DB;IF SC=ALPHA 00000100
THEN DS~1SET;END;ALPHA STREAM PROCEDURE GNCH(FI,CIN);VALUE CIN;BEGIN SI~00000110
FI;SI~SI+CIN;DI~LOC GNCH;DI~DI+7;DS~CHR;END GNCH;ALPHA PROCEDURE GETCHAR00000120
;BEGIN IF WIN}9THEN BEGIN LABEL L1,L2;FORMAT FMT(13A6,A2);ALPHA ARRAY IN00000130
FO[0:13];STREAM PROCEDURE CONCAT(INBUF,OUTBUF);BEGIN SI~INBUF;DI~OUTBUF;00000140
13(SI~SI+2;DS~6CHR);SI~SI+6;DS~2CHR;END;STREAM PROCEDURE GETIDENT(IDENT,00000150
BUFIMG);BEGIN SI~BUFIMG;DI~IDENT;DI~DI+5;DS~3CHR END;INTEGER I;READ(KRUC00000160
ARD,FMT,FOR I~0STEP 1UNTIL 13DO INFO[I])[L1];CONCAT(INFO[0],BUFIMG[0]);I00000170
F FIRSTCARD THEN BEGIN GETIDENT(IDENT,BUFIMG[9]);FIRSTCARD~FALSE;END;GO 00000180
TO L2;L1:EOF~TRUE;L2:CIN~WIN~0;END;TUF1~TUF2;GETCHAR~TUF2~GNCH(CR[WIN],C00000190
IN);ID1~ID;ID~ALPHACHECK(TUF2)AND(ID OR TUF2}10);CIN~CIN+1;IF CIN}8THEN 00000200
BEGIN WIN~WIN+1;CIN~CIN-8END;END CHAR;STREAM PROCEDURE PPCH(FO,COUT,CH);00000210
VALUE COUT;BEGIN SI~CH;SI~SI+7;DI~FO;DI~DI+COUT;DS~CHR;END;PROCEDURE CHA00000220
ROUT(CH);VALUE CH;ALPHA CH;BEGIN IF WOUT}9THEN BEGIN SEQUENCE(CP(9),SQ,I00000230
DENT);SQ~SQ+10;RELEASE(CP);COUT~WOUT~0;END;PPCH(CP(WOUT),COUT,CH);COUT~C00000240
OUT+1;IF COUT}8THEN BEGIN WOUT~WOUT+1;COUT~COUT-8;END;END CHAROUT;PROCED00000250
URE CLEAR;BEGIN INTEGER I;FOR I~0WHILE WOUT<9DO CHAROUT(" ");END;PROCEDU00000260
RE COMMENTCHECK(L);LABEL L;BEGIN LABEL NOPE;INTEGER PTR,PWD;PTR~CIN;PWD~00000270
WIN;SAVE1~T;FOR CH~"O","M","M","E","N","T"DO BEGIN IF WIN}9THEN GO TO NO00000280
PE;CHAR~GETCHAR;IF EOF THEN GO TO ENDIT;IF CH!CHAR THEN GO TO NOPE;END;C00000290
HAR~GETCHAR;IF EOF THEN GO TO ENDIT;T~CHAR;IF NOT ALPHACHECK(T)THEN FOR 00000300
CH~T WHILE CHAR!";"DO BEGIN CHAR~GETCHAR;IF EOF THEN GO TO ENDIT;T~CHAR;00000310
END ELSE GO TO NOPE;GO TO L;NOPE:WIN~PWD;CIN~PTR;ID~ID1~TRUE;T~SAVE1;END00000320
;WIN~10;FIRSTCARD~TRUE;EOF~FALSE;TUF1~TUF2~";";SQ~10;L:CHAR~GETCHAR;IF E00000330
OF THEN GO TO ENDIT;T~CHAR;IF T="""THEN BEGIN N:CHAR~GETCHAR;IF EOF THEN00000340
GO TO ENDIT;T~CHAR;IF T="""THEN BEGIN CHAR~GETCHAR;IF EOF THEN GO TO EN00000350
DIT;IF CHAR!"""THEN BEGIN ENDIT:CLEAR;SEQUENCE(CP(9),SQ,IDENT);RELEASE(C00000360
P);GO TO N1;END;FOR I~1,2,3DO CHAROUT(""");GO TO L;END;CHAROUT(""");CHAR00000370
OUT(T);K:CHAR~GETCHAR;IF EOF THEN GO TO ENDIT;T~CHAR;CHAROUT(T);IF T!"""00000380
THEN GO TO K;CHAR~GETCHAR;IF EOF THEN GO TO ENDIT;T~CHAR;END;IF T=" "THE00000390
N BEGIN ID2~ID1;M:CHAR~GETCHAR;IF EOF THEN GO TO ENDIT;T~CHAR;IF T=" "TH00000400
EN GO TO M;IF ID2 AND ALPHACHECK(T)THEN CHAROUT(" ");IF T="""THEN GO TO 00000410
N;END;IF T="%"THEN BEGIN WIN~10;GO TO L;END;IF T="$"AND 8|WIN+CIN=1THEN 00000420
BEGIN IF 8|WOUT+COUT!0THEN BEGIN CLEAR;WOUT~10;END;CHAROUT("$");FOR I~1S00000430
TEP 1UNTIL 71DO BEGIN CHAR~GETCHAR;IF EOF THEN GO TO ENDIT;CHAROUT((T~CH00000440
AR));END;GO TO L;END;IF T="C"AND NOT ALPHACHECK(TUF1)THEN COMMENTCHECK(L00000450
);CHAROUT(T);GO TO L;N1:END.END;END.LAST CARD ON 0CRDING TAPE 00000460

271
KRUNCH-UNKRNCH/KRUNCH-Compile.lst Normal file
View File

@@ -0,0 +1,271 @@
LABEL 000000000LINE 00186145?COMPILE KRUNCH/UTILITY ALGOL LIBRARY ALGOL /KRUNCH
BURROUGHS B-5700 ALGOL COMPILER MARK XIII.0 SUNDAY, 05/25/86, 10:07 AM.
KRUNCH 000104AA 00000100 0000
00000200 0000
************************************************************************ 00000300 0000
PLEASE NOTE THAT THE BURROUGHS CORPORATION ASSUMES 00000400 0000
NO RESPONSIBILITY FOR THE USE OR MAINTENANCE OF THIS PROGRAM. 00000500 0000
************************************************************************ 00000600 0000
% 00000700 0000
COMMENT KRUNCH/UTILITY PACKS AN ALGOL SOURCE PROGRAM SO THAT IT FILLS 00000800 0000
72 COLUMNS OF EACH CARD COMPRISING THE KRUNCHED SOURCE DECK. ; 00000900 0000
BEGIN 00001000 0000
START OF SEGMENT ********** 2
ALPHA CH, T, IDENT, CHAR, SAVE1, TUF1, TUF2; 00001100 0000
BOOLEAN ID, ID1, ID2, FIRSTCARD, EOF; 00001200 0000
INTEGER I, WIN, WOUT, CIN, COUT, SQ; 00001300 0000
LABEL K, L, M, N,ENDIT, N1; 00001400 0000
ALPHA ARRAY BUFIMG[0:9]; 00001500 0000
DEFINE CR = BUFIMG #; 00001600 0001
FILE IN KRUCARD (1,10); 00001700 0001
FILE OUT KRUPNCH 0 (1,10); 00001800 0005
DEFINE CP = KRUPNCH #; 00001900 0008
STREAM PROCEDURE SEQUENCE (FO, SQ, IDENT); 00002000 0008
BEGIN 00002100 0008
DI ← FO; 00002200 0010
SI ← IDENT; 00002300 0010
SI ← SI + 5; 00002400 0010
DS ← 3 CHR; 00002500 0010
SI ← SQ; 00002600 0011
DS ← 5 DEC 00002700 0011
END; 00002800 0011
BOOLEAN STREAM PROCEDURE ALPHACHECK (T); 00002900 0011
BEGIN 00003000 0011
SI ← T; 00003100 0012
SI ← SI + 7; 00003200 0012
DI ← LOC ALPHACHECK; 00003300 0012
DS ← 8 LIT "0"; 00003400 0012
DI ← DI - 1; 00003500 0014
SKIP 5 DB; 00003600 0014
IF SC = ALPHA THEN DS ← 1 SET; 00003700 0014
END; 00003800 0015
ALPHA STREAM PROCEDURE GNCH (FI, CIN); 00003900 0016
VALUE CIN; 00004000 0016
BEGIN 00004100 0016
SI ← FI; 00004200 0017
SI ← SI + CIN; 00004300 0017
DI ← LOC GNCH; 00004400 0017
DI ← DI + 7; 00004500 0018
DS ← CHR; 00004600 0018
END GNCH; 00004700 0018
ALPHA PROCEDURE GETCHAR; 00004800 0019
BEGIN 00004900 0019
IF WIN ≥ 9 THEN 00005000 0019
BEGIN 00005100 0020
LABEL L1, L2; 00005200 0021
START OF SEGMENT ********** 3
FORMAT FMT (13A6,A2); 00005300 0000
START OF SEGMENT ********** 4
4 IS 5 LONG, NEXT SEG 3
ALPHA ARRAY INFO[0:13]; 00005400 0000
STREAM PROCEDURE CONCAT (INBUF, OUTBUF); 00005500 0001
BEGIN 00005600 0001
SI ← INBUF; 00005700 0003
DI ← OUTBUF; 00005800 0003
13 (SI ← SI + 2; 00005900 0003
DS ← 6 CHR); 00006000 0004
SI ← SI + 6; 00006100 0004
DS ← 2 CHR; 00006200 0004
END; 00006300 0005
STREAM PROCEDURE GETIDENT (IDENT, BUFIMG); 00006400 0005
BEGIN 00006500 0005
SI ← BUFIMG; 00006600 0006
DI ← IDENT; 00006700 0006
DI ← DI + 5; 00006800 0006
DS ← 3 CHR 00006900 0006
END; 00007000 0007
INTEGER I; 00007100 0007
READ (KRUCARD, FMT, FOR I ← 0 STEP 1 UNTIL 13 DO INFO[I]) [ 00007200 0007
L1]; 00007300 0019
CONCAT (INFO[0], BUFIMG[0]); 00007400 0020
IF FIRSTCARD THEN 00007500 0022
BEGIN 00007600 0022
GETIDENT (IDENT, BUFIMG[9]); 00007700 0023
FIRSTCARD ← FALSE; 00007800 0024
END; 00007900 0025
GO TO L2; 00008000 0025
L1:EOF ← TRUE; 00008100 0025
L2:CIN ← WIN ← 0; 00008200 0026
END; 00008300 0028
3 IS 32 LONG, NEXT SEG 2
TUF1 ← TUF2; 00008400 0022
GETCHAR ← TUF2 ← GNCH (CR[WIN], CIN); 00008500 0022
ID1 ← ID; 00008600 0025
ID ← ALPHACHECK (TUF2) AND (ID OR TUF2 ≥ 10); 00008700 0026
CIN ← CIN + 1; 00008800 0029
IF CIN ≥ 8 THEN 00008900 0030
BEGIN 00009000 0031
WIN ← WIN + 1; 00009100 0032
CIN ← CIN - 8 00009200 0033
END; 00009300 0033
END CHAR; 00009400 0034
STREAM PROCEDURE PPCH (FO, COUT, CH); 00009500 0037
VALUE COUT; 00009600 0037
BEGIN 00009700 0037
SI ← CH; 00009800 0038
SI ← SI + 7; 00009900 0038
DI ← FO; 00010000 0038
DI ← DI + COUT; 00010100 0038
DS ← CHR; 00010200 0039
END; 00010300 0039
PROCEDURE CHAROUT (CH); 00010400 0039
VALUE CH; 00010500 0039
ALPHA CH; 00010600 0039
BEGIN 00010700 0039
IF WOUT ≥ 9 THEN 00010800 0039
BEGIN 00010900 0040
SEQUENCE (CP (9), SQ, IDENT); 00011000 0041
SQ ← SQ + 10; 00011100 0045
RELEASE (CP); 00011200 0046
COUT ← WOUT ← 0; 00011300 0049
END; 00011400 0050
PPCH (CP (WOUT), COUT, CH); 00011500 0050
COUT ← COUT + 1; 00011600 0054
IF COUT ≥ 8 THEN 00011700 0056
BEGIN 00011800 0056
WOUT ← WOUT + 1; 00011900 0057
COUT ← COUT - 8; 00012000 0058
END; 00012100 0059
END CHAROUT; 00012200 0059
PROCEDURE CLEAR; 00012300 0060
BEGIN 00012400 0060
INTEGER I; 00012500 0060
START OF SEGMENT ********** 5
FOR I ← 0 WHILE WOUT < 9 DO CHAROUT (" "); 00012600 0000
END; 00012700 0004
5 IS 7 LONG, NEXT SEG 2
PROCEDURE COMMENTCHECK (L); 00012800 0060
LABEL L; 00012900 0060
BEGIN 00013000 0060
LABEL NOPE; 00013100 0060
START OF SEGMENT ********** 6
INTEGER PTR, PWD; 00013200 0000
PTR ← CIN; 00013300 0000
PWD ← WIN; 00013400 0000
SAVE1 ← T; 00013500 0001
FOR CH ← "O", "M", "M", "E", "N", "T" DO 00013600 0002
BEGIN 00013700 0014
IF WIN ≥ 9 THEN GO TO NOPE; 00013800 0014
CHAR ← GETCHAR; 00013900 0016
IF EOF THEN GO TO ENDIT; 00014000 0017
IF CH ≠ CHAR THEN GO TO NOPE; 00014100 0020
END; 00014200 0021
CHAR ← GETCHAR; 00014300 0021
IF EOF THEN GO TO ENDIT; 00014400 0022
T ← CHAR; 00014500 0025
IF NOT ALPHACHECK (T) THEN FOR CH ← T WHILE CHAR ≠ ";" DO 00014600 0026
BEGIN 00014700 0031
CHAR ← GETCHAR; 00014800 0031
IF EOF THEN GO TO ENDIT; 00014900 0032
T ← CHAR; 00015000 0035
END 00015100 0036
ELSE GO TO NOPE; 00015200 0036
GO TO L; 00015300 0036
NOPE:WIN ← PWD; 00015400 0037
CIN ← PTR; 00015500 0038
ID ← ID1 ← TRUE; 00015600 0039
T ← SAVE1; 00015700 0040
END; 00015800 0041
6 IS 44 LONG, NEXT SEG 2
WIN ← 10; 00015900 0060
FIRSTCARD ← TRUE; 00016000 0060
EOF ← FALSE; 00016100 0061
TUF1 ← TUF2 ← ";"; 00016200 0062
SQ ← 10; 00016300 0063
L:CHAR ← GETCHAR; 00016400 0064
IF EOF THEN GO TO ENDIT; 00016500 0066
T ← CHAR; 00016600 0067
IF T = """ THEN 00016700 0067
BEGIN 00016800 0068
N:CHAR ← GETCHAR; 00016900 0069
IF EOF THEN GO TO ENDIT; 00017000 0070
T ← CHAR; 00017100 0071
IF T = """ THEN 00017200 0071
BEGIN 00017300 0072
CHAR ← GETCHAR; 00017400 0073
IF EOF THEN GO TO ENDIT; 00017500 0074
IF CHAR ≠ """ THEN 00017600 0075
BEGIN 00017700 0075
ENDIT:CLEAR; 00017800 0076
SEQUENCE (CP (9), SQ, IDENT); 00017900 0077
RELEASE (CP); 00018000 0081
GO TO N1; 00018100 0084
END; 00018200 0085
FOR I ← 1,2,3 DO CHAROUT ("""); 00018300 0085
GO TO L; 00018400 0093
END; 00018500 0094
CHAROUT ("""); 00018600 0094
CHAROUT (T); 00018700 0094
K:CHAR ← GETCHAR; 00018800 0095
IF EOF THEN GO TO ENDIT; 00018900 0097
T ← CHAR; 00019000 0098
CHAROUT (T); 00019100 0098
IF T ≠ """ THEN GO TO K; 00019200 0099
CHAR ← GETCHAR; 00019300 0100
IF EOF THEN GO TO ENDIT; 00019400 0101
T ← CHAR; 00019500 0102
END; 00019600 0103
IF T = " " THEN 00019700 0103
BEGIN 00019800 0104
ID2 ← ID1; 00019900 0104
M:CHAR ← GETCHAR; 00020000 0105
IF EOF THEN GO TO ENDIT; 00020100 0107
T ← CHAR; 00020200 0108
IF T = " " THEN GO TO M; 00020300 0108
IF ID2 AND ALPHACHECK (T) THEN CHAROUT (" "); 00020400 0110
IF T = """ THEN GO TO N; 00020500 0113
END; 00020600 0114
IF T = "%" THEN BEGIN WIN ← 10; GO TO L; END; 00020650 0114
IF T = "$" AND 8 × WIN + CIN = 1 THEN 00020700 0116
BEGIN 00020800 0119
IF 8 × WOUT + COUT ≠ 0 THEN 00020900 0120
BEGIN 00021000 0121
CLEAR; 00021100 0122
WOUT ← 10; 00021200 0122
END; 00021300 0123
CHAROUT ("$"); 00021400 0123
FOR I ← 1 STEP 1 UNTIL 71 DO 00021500 0124
BEGIN 00021600 0125
CHAR ← GETCHAR; 00021700 0125
IF EOF THEN GO TO ENDIT; 00021800 0126
CHAROUT ((T ← CHAR)); 00021900 0127
END; 00022000 0128
GO TO L; 00022100 0130
END; 00022200 0131
IF T = "C" AND NOT ALPHACHECK (TUF1) THEN COMMENTCHECK (L); 00022300 0131
CHAROUT (T); 00022400 0135
GO TO L; 00022500 0136
N1:END. 00022600 0137
2 IS 140 LONG, NEXT SEG 1
PRT(5) = BLOCK CONTROL INTRINSIC, SEGMENT NUMBER = 7.
PRT(66) = INPUT(W) INTRINSIC, SEGMENT NUMBER = 8.
PRT(65) = GO TO SOLVER INTRINSIC, SEGMENT NUMBER = 9.
PRT(14) = ALGOL WRITE INTRINSIC, SEGMENT NUMBER = 10.
PRT(15) = ALGOL READ INTRINSIC, SEGMENT NUMBER = 11.
PRT(16) = ALGOL SELECT INTRINSIC, SEGMENT NUMBER = 12.
1 IS 2 LONG, NEXT SEG 0
13 IS 69 LONG, NEXT SEG 0
NUMBER OF ERRORS DETECTED = 0. COMPILATION TIME = 29 SECONDS.
PRT SIZE = 63; TOTAL SEGMENT SIZE = 299 WORDS; DISK SIZE = 21 SEGS; NO. PGM. SEGS = 13
ESTIMATED CORE STORAGE REQUIRED = 3007 WORDS.
ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS.
LABEL 000000000LINE 00186145?COMPILE KRUNCH/UTILITY ALGOL LIBRARY ALGOL /KRUNCH

228
KRUNCH-UNKRNCH/KRUNCH.UTILITY.alg_m Normal file
View File

@@ -0,0 +1,228 @@
KRUNCH 000104AA 00000100
00000200
************************************************************************00000300
PLEASE NOTE THAT THE BURROUGHS CORPORATION ASSUMES 00000400
NO RESPONSIBILITY FOR THE USE OR MAINTENANCE OF THIS PROGRAM. 00000500
************************************************************************00000600
% 00000700
COMMENT KRUNCH/UTILITY PACKS AN ALGOL SOURCE PROGRAM SO THAT IT FILLS00000800
72 COLUMNS OF EACH CARD COMPRISING THE KRUNCHED SOURCE DECK. ;00000900
BEGIN 00001000
ALPHA CH, T, IDENT, CHAR, SAVE1, TUF1, TUF2; 00001100
BOOLEAN ID, ID1, ID2, FIRSTCARD, EOF; 00001200
INTEGER I, WIN, WOUT, CIN, COUT, SQ; 00001300
LABEL K, L, M, N,ENDIT, N1; 00001400
ALPHA ARRAY BUFIMG[0:9]; 00001500
DEFINE CR = BUFIMG #; 00001600
FILE IN KRUCARD (1,10); 00001700
FILE OUT KRUPNCH 0 (1,10); 00001800
DEFINE CP = KRUPNCH #; 00001900
STREAM PROCEDURE SEQUENCE (FO, SQ, IDENT); 00002000
BEGIN 00002100
DI ~ FO; 00002200
SI ~ IDENT; 00002300
SI ~ SI + 5; 00002400
DS ~ 3 CHR; 00002500
SI ~ SQ; 00002600
DS ~ 5 DEC 00002700
END; 00002800
BOOLEAN STREAM PROCEDURE ALPHACHECK (T); 00002900
BEGIN 00003000
SI ~ T; 00003100
SI ~ SI + 7; 00003200
DI ~ LOC ALPHACHECK; 00003300
DS ~ 8 LIT "0"; 00003400
DI ~ DI - 1; 00003500
SKIP 5 DB; 00003600
IF SC = ALPHA THEN DS ~ 1 SET; 00003700
END; 00003800
ALPHA STREAM PROCEDURE GNCH (FI, CIN); 00003900
VALUE CIN; 00004000
BEGIN 00004100
SI ~ FI; 00004200
SI ~ SI + CIN; 00004300
DI ~ LOC GNCH; 00004400
DI ~ DI + 7; 00004500
DS ~ CHR; 00004600
END GNCH; 00004700
ALPHA PROCEDURE GETCHAR; 00004800
BEGIN 00004900
IF WIN } 9 THEN 00005000
BEGIN 00005100
LABEL L1, L2; 00005200
FORMAT FMT (13A6,A2); 00005300
ALPHA ARRAY INFO[0:13]; 00005400
STREAM PROCEDURE CONCAT (INBUF, OUTBUF); 00005500
BEGIN 00005600
SI ~ INBUF; 00005700
DI ~ OUTBUF; 00005800
13 (SI ~ SI + 2; 00005900
DS ~ 6 CHR); 00006000
SI ~ SI + 6; 00006100
DS ~ 2 CHR; 00006200
END; 00006300
STREAM PROCEDURE GETIDENT (IDENT, BUFIMG); 00006400
BEGIN 00006500
SI ~ BUFIMG; 00006600
DI ~ IDENT; 00006700
DI ~ DI + 5; 00006800
DS ~ 3 CHR 00006900
END; 00007000
INTEGER I; 00007100
READ (KRUCARD, FMT, FOR I ~ 0 STEP 1 UNTIL 13 DO INFO[I]) [ 00007200
L1]; 00007300
CONCAT (INFO[0], BUFIMG[0]); 00007400
IF FIRSTCARD THEN 00007500
BEGIN 00007600
GETIDENT (IDENT, BUFIMG[9]); 00007700
FIRSTCARD ~ FALSE; 00007800
END; 00007900
GO TO L2; 00008000
L1:EOF ~ TRUE; 00008100
L2:CIN ~ WIN ~ 0; 00008200
END; 00008300
TUF1 ~ TUF2; 00008400
GETCHAR ~ TUF2 ~ GNCH (CR[WIN], CIN); 00008500
ID1 ~ ID; 00008600
ID ~ ALPHACHECK (TUF2) AND (ID OR TUF2 } 10); 00008700
CIN ~ CIN + 1; 00008800
IF CIN } 8 THEN 00008900
BEGIN 00009000
WIN ~ WIN + 1; 00009100
CIN ~ CIN - 8 00009200
END; 00009300
END CHAR; 00009400
STREAM PROCEDURE PPCH (FO, COUT, CH); 00009500
VALUE COUT; 00009600
BEGIN 00009700
SI ~ CH; 00009800
SI ~ SI + 7; 00009900
DI ~ FO; 00010000
DI ~ DI + COUT; 00010100
DS ~ CHR; 00010200
END; 00010300
PROCEDURE CHAROUT (CH); 00010400
VALUE CH; 00010500
ALPHA CH; 00010600
BEGIN 00010700
IF WOUT } 9 THEN 00010800
BEGIN 00010900
SEQUENCE (CP (9), SQ, IDENT); 00011000
SQ ~ SQ + 10; 00011100
RELEASE (CP); 00011200
COUT ~ WOUT ~ 0; 00011300
END; 00011400
PPCH (CP (WOUT), COUT, CH); 00011500
COUT ~ COUT + 1; 00011600
IF COUT } 8 THEN 00011700
BEGIN 00011800
WOUT ~ WOUT + 1; 00011900
COUT ~ COUT - 8; 00012000
END; 00012100
END CHAROUT; 00012200
PROCEDURE CLEAR; 00012300
BEGIN 00012400
INTEGER I; 00012500
FOR I ~ 0 WHILE WOUT < 9 DO CHAROUT (" "); 00012600
END; 00012700
PROCEDURE COMMENTCHECK (L); 00012800
LABEL L; 00012900
BEGIN 00013000
LABEL NOPE; 00013100
INTEGER PTR, PWD; 00013200
PTR ~ CIN; 00013300
PWD ~ WIN; 00013400
SAVE1 ~ T; 00013500
FOR CH ~ "O", "M", "M", "E", "N", "T" DO 00013600
BEGIN 00013700
IF WIN } 9 THEN GO TO NOPE; 00013800
CHAR ~ GETCHAR; 00013900
IF EOF THEN GO TO ENDIT; 00014000
IF CH ! CHAR THEN GO TO NOPE; 00014100
END; 00014200
CHAR ~ GETCHAR; 00014300
IF EOF THEN GO TO ENDIT; 00014400
T ~ CHAR; 00014500
IF NOT ALPHACHECK (T) THEN FOR CH ~ T WHILE CHAR ! ";" DO 00014600
BEGIN 00014700
CHAR ~ GETCHAR; 00014800
IF EOF THEN GO TO ENDIT; 00014900
T ~ CHAR; 00015000
END 00015100
ELSE GO TO NOPE; 00015200
GO TO L; 00015300
NOPE:WIN ~ PWD; 00015400
CIN ~ PTR; 00015500
ID ~ ID1 ~ TRUE; 00015600
T ~ SAVE1; 00015700
END; 00015800
WIN ~ 10; 00015900
FIRSTCARD ~ TRUE; 00016000
EOF ~ FALSE; 00016100
TUF1 ~ TUF2 ~ ";"; 00016200
SQ ~ 10; 00016300
L:CHAR ~ GETCHAR; 00016400
IF EOF THEN GO TO ENDIT; 00016500
T ~ CHAR; 00016600
IF T = """ THEN 00016700
BEGIN 00016800
N:CHAR ~ GETCHAR; 00016900
IF EOF THEN GO TO ENDIT; 00017000
T ~ CHAR; 00017100
IF T = """ THEN 00017200
BEGIN 00017300
CHAR ~ GETCHAR; 00017400
IF EOF THEN GO TO ENDIT; 00017500
IF CHAR ! """ THEN 00017600
BEGIN 00017700
ENDIT:CLEAR; 00017800
SEQUENCE (CP (9), SQ, IDENT); 00017900
RELEASE (CP); 00018000
GO TO N1; 00018100
END; 00018200
FOR I ~ 1,2,3 DO CHAROUT ("""); 00018300
GO TO L; 00018400
END; 00018500
CHAROUT ("""); 00018600
CHAROUT (T); 00018700
K:CHAR ~ GETCHAR; 00018800
IF EOF THEN GO TO ENDIT; 00018900
T ~ CHAR; 00019000
CHAROUT (T); 00019100
IF T ! """ THEN GO TO K; 00019200
CHAR ~ GETCHAR; 00019300
IF EOF THEN GO TO ENDIT; 00019400
T ~ CHAR; 00019500
END; 00019600
IF T = " " THEN 00019700
BEGIN 00019800
ID2 ~ ID1; 00019900
M:CHAR ~ GETCHAR; 00020000
IF EOF THEN GO TO ENDIT; 00020100
T ~ CHAR; 00020200
IF T = " " THEN GO TO M; 00020300
IF ID2 AND ALPHACHECK (T) THEN CHAROUT (" "); 00020400
IF T = """ THEN GO TO N; 00020500
END; 00020600
IF T = "%" THEN BEGIN WIN ~ 10; GO TO L; END; 00020650
IF T = "$" AND 8 | WIN + CIN = 1 THEN 00020700
BEGIN 00020800
IF 8 | WOUT + COUT ! 0 THEN 00020900
BEGIN 00021000
CLEAR; 00021100
WOUT ~ 10; 00021200
END; 00021300
CHAROUT ("$"); 00021400
FOR I ~ 1 STEP 1 UNTIL 71 DO 00021500
BEGIN 00021600
CHAR ~ GETCHAR; 00021700
IF EOF THEN GO TO ENDIT; 00021800
CHAROUT ((T ~ CHAR)); 00021900
END; 00022000
GO TO L; 00022100
END; 00022200
IF T = "C" AND NOT ALPHACHECK (TUF1) THEN COMMENTCHECK (L); 00022300
CHAROUT (T); 00022400
GO TO L; 00022500
N1:END. 00022600
END;END. LAST CARD ON 0CRDING TAPE 99999999

71
KRUNCH-UNKRNCH/README.txt Normal file
View File

@@ -0,0 +1,71 @@
KRUNCH and UNKRNCH Utilities for the Burroughs B5500
KRUNCH reads a card deck containing a B5500 Algol source program,
removing all extraneous spaces and reducing the source to the minimum
number of card images, writing the filtered source to the card punch.
All comments are also removed from the source, and the output deck is
resequenced 10+10. The source program is still compilable, but it is not
very readable. A sample run deck would be:
?EXECUTE KRUNCH/UTILITY
?DATA CARD
: :
: Algol source deck :
: :
?END
UNKRNCH reads a B5500 Algol source program and reformats it, applying
standard spacing and indentation to it. It was probably written
originally to reverse what KRUNCH does, but it will work on any Algol
source to function as a primitive "pretty print" formatter. It preserves
comments in the input, but of course cannot reinsert comments that were
stripped out by KRUNCH.
Input can be from a card deck or a "0CRDIMG" library tape. Output can be
to a new punched card deck, another "0CRDIMG" tape, or the line printer.
The reformatted program is resequenced 100+100. The program reads a
parameter card in free-field format with two integers that define the
modes of input and output. The values of these integers are defined in a
comment at the beginning of the source. A sample run deck to read the
original program from cards and output to the line printer would be
(note the trailing comma on the parameter card):
?EXECUTE UNKRNCH/UTILITY
?DATA CARD
0,2,
: :
: Algol source deck :
: :
?END
These programs appear to have been written by someone at Burroughs. They
were donated by Burroughs to the CUBE (user association) library in
1968. I encountered them at the University of Delaware in 1970 and saved
compile listings of them. The source files below were transcribed from
those listing.
KRUNCH.UTILITY.alg_m
Algol source for the KRUNCH utility.
KRUNCH-As-krunched.card
Card deck resulting from running the source for KRUNCH through
KRUNCH itself.
KRUNCH-Compile.lst
Algol compile listing for KRUNCH generated using the retro-B5500
emulator running Mark XIII software.
UNKRNCH.UTILITY.alg_m
Algol source for the UNKRNCH utility.
UNKRNCH-Compile-Run.lst
Algol file listing for UNKRNCH generated using the retro-B5500
emulator running Mark XIII software, followed by an execution of
UNKRNCH that read the KRUNCH-As-krunched.card file and output the
reformatted source to the line printer.
Paul Kimpel
May 2016

895
KRUNCH-UNKRNCH/UNKRNCH-Compile-Run.lst Normal file
View File

@@ -0,0 +1,895 @@
LABEL 000000000LINE 00186150?COMPILE UNKRNCH/UTILITY ALGOL LIBRARY ALGOL /UNKRNCH
BURROUGHS B-5700 ALGOL COMPILER MARK XIII.0 FRIDAY, 05/30/86, 1:06 PM.
LABEL 000000000PUNCH 001701410170141000000000000000000000001000010000 00000000 0000
UNKRUNCH 000107AA 00000100 0000
00000200 0000
00000300 0000
************************************************************************ 00000400 0000
PLEASE NOTE THAT THE BURROUGHS CORPORATION ASSUMES 00000500 0000
NO RESPONSIBILITY FOR THE USE OR MAINTENANCE OF THIS PROGRAM. 00000600 0000
***********************************************************************; 00000700 0000
% UNKRUNCH/UTILITY PRODUCES A NEW SOURCE DECK OF ALGOL, REFORMATTED 00000800 0000
% FOR BETTER READABILITY. 00000900 0000
% THE CONTROL CARD FOR THIS PROGRAM IS FREE FIELD AND SETS THE 00001000 0000
% SWITCH FILES FOR THE INPUT AND OUTPUT. 00001100 0000
% THE FIRST NUMBER IS FOR THE INPUT. 00001200 0000
% INPUT = 0 THEN A CARD DECK IS EXPECTED AFTER THE CONTROL CARD 00001300 0000
% INPUT = 1 THEN A 0CRDIMG TAPE IS EXPECTED 00001400 0000
% OUTPUT = 0 THEN THE CARD PUNCH WILL MAKE A NEW SEQUENCED DECK 00001500 0000
% OUTPUT = 1 THEN A NEW RESEQUENCED 0CRDIMG TAPE IS MADE 00001600 0000
% OUTPUT = 2 THE OUTPUT APPEARS ON THE LINE PRINTER. 00001700 0000
% 00001800 0000
BEGIN 00001900 0000
START OF SEGMENT ********** 2
FILE CARD(5,10,30), 00002000 0000
TAPE "0CRDIMG" (2,56,10), 00002100 0003
LINE 18(2,15), 00002200 0007
PUNCH 0(5,10), 00002300 0010
NEWTAPE "0CRDIMG" (2,56,10,SAVE 1); 00002400 0014
INTEGER I, J, PAREN, WIN, CIN, WBUF, CBUF, WOUT, COUT, SQ, SCOL, 00002500 0020
TEMP; 00002600 0020
ALPHA PARM, T, FILER, CHAR, BLKBGN, BLKEND, ELSER, SEMICO, COMMA, 00002700 0020
RTPAREN, LISTR, FRMATR, LFPAREN; 00002800 0020
ARRAY BUFIMG [0 : 9], CP [0 : 9], BUF [0 : 9]; 00002900 0020
BOOLEAN COMA, DECL, NUMSW, FLORMAT, SEMI, ENDR; 00003000 0025
SWITCH FILE INPUT := CARD, 00003100 0025
TAPE; 00003200 0028
SWITCH FILE OUTPUT := PUNCH, 00003300 0029
NEWTAPE, 00003400 0032
LINE; 00003500 0034
LABEL ENDIT, ST; 00003600 0035
BOOLEAN STREAM PROCEDURE BLANK (CP); 00003700 0035
BEGIN 00003800 0037
LABEL L7; 00003900 0037
TALLY ← 0; 00004000 0037
SI ← CP; 00004100 0037
2 (36 (IF SC ≠ " " THEN JUMP OUT 2 TO L7; 00004200 0037
SI ← SI + 1)); 00004300 0039
TALLY ← 1; 00004400 0040
L7: BLANK ← TALLY; 00004500 0040
END BLANK; 00004600 0041
ALPHA STREAM PROCEDURE GNCH (CR, CIN); 00004700 0042
VALUE CIN; 00004800 0042
BEGIN 00004900 0042
SI ← CR; 00005000 0043
SI ← SI + CIN; 00005100 0043
DI ← LOC GNCH; 00005200 0043
DI ← DI + 7; 00005300 0044
DS ← CHR; 00005400 0044
END GNCH; 00005500 0044
ALPHA PROCEDURE GETCHAR; 00005600 0045
BEGIN 00005700 0045
IF CIN < 0 THEN 00005800 0045
BEGIN 00005900 0046
CIN ← CIN + 8; 00006000 0047
WIN ← WIN - 1 00006100 0048
END; 00006200 0048
IF WIN > 8 THEN 00006300 0049
BEGIN 00006400 0050
READ (INPUT [I], 10, BUFIMG [*]) [ENDIT]; 00006500 0051
WIN ← CIN ← 0; 00006600 0056
END; 00006700 0057
GETCHAR ← GNCH (BUFIMG [WIN], CIN); 00006800 0057
CIN ← CIN + 1; 00006900 0060
IF CIN > 7 THEN 00007000 0061
BEGIN 00007100 0062
WIN ← WIN + 1; 00007200 0062
CIN ← CIN - 8; 00007300 0063
END; 00007400 0065
END GETCHAR; 00007500 0065
STREAM PROCEDURE BUFTOOUT (BUF, TEMP, CP, COUT); 00007600 0067
VALUE TEMP, COUT; 00007700 0067
BEGIN 00007800 0067
SI ← BUF; 00007900 0068
DI ← CP; 00008000 0068
DI ← DI + COUT; 00008100 0068
DS ← TEMP CHR; 00008200 0069
END BUFTOOUT; 00008300 0069
BOOLEAN STREAM PROCEDURE COMEQUAL (BUF); 00008400 0069
BEGIN 00008500 0069
LOCAL NIC; 00008600 0070
TALLY ← 0; 00008700 0070
SI ← BUF; 00008800 0070
DI ← LOC NIC; 00008900 0070
DS ← 8 LIT "COMMENT "; 00009000 0070
DI ← DI - 8; 00009100 0072
IF 8 SC = DC THEN TALLY ← 1; 00009200 0072
COMEQUAL ← TALLY; 00009300 0073
END COMEQUAL; 00009400 0073
BOOLEAN STREAM PROCEDURE EQUAL (BUF, COUNT, T); 00009500 0074
VALUE COUNT; 00009600 0074
BEGIN 00009700 0074
LABEL L1; 00009800 0075
TALLY ← 0; 00009900 0075
SI ← BUF; 00010000 0075
DI ← T; 00010100 0075
DI ← DI + 2; 00010200 0075
COUNT (IF SC ≠ DC THEN JUMP OUT 1 TO L1); 00010300 0076
TALLY ← 1; 00010400 0078
L1: EQUAL ← TALLY; 00010500 0078
END EQUAL; 00010600 0079
STREAM PROCEDURE CB (T, BUF, CBUF); 00010700 0080
VALUE CBUF; 00010800 0080
BEGIN 00010900 0080
SI ← T; 00011000 0081
SI ← SI + 7; 00011100 0081
DI ← BUF; 00011200 0081
DI ← DI + CBUF; 00011300 0081
DS ← CHR; 00011400 0082
END CR; 00011500 0082
PROCEDURE CHARTOBUF (T); 00011600 0082
VALUE T; 00011700 0082
ALPHA T; 00011800 0082
BEGIN 00011900 0082
CB (T, BUF [WBUF], CBUF); 00012000 0082
CBUF ← CBUF + 1; 00012100 0084
IF CBUF > 7 THEN 00012200 0085
BEGIN 00012300 0086
WBUF ← WBUF + 1; 00012400 0087
CBUF ← CBUF - 8; 00012500 0088
END; 00012600 0089
END CHARTOBUF; 00012700 0089
BOOLEAN STREAM PROCEDURE ALPHACHECK (T); 00012800 0089
BEGIN 00012900 0089
SI ← T; 00013000 0090
SI ← SI + 7; 00013100 0090
IF SC = ALPHA THEN TALLY ← 1 ELSE TALLY ← 0; 00013200 0090
ALPHACHECK ← TALLY; 00013300 0091
END ALPHACHECK; 00013400 0092
STREAM PROCEDURE CLEARBUF (BUF); 00013500 0093
BEGIN 00013600 0093
DI ← BUF; 00013700 0093
2 (DS ← 40 LIT " "); 00013800 0093
END CLEARBUF; 00013900 0099
STREAM PROCEDURE SEQUENCE (FO, SQ); 00014000 0099
BEGIN 00014100 0099
DI ← FO; 00014200 0100
2 (DI ← DI + 36); 00014300 0100
SI ← SQ; 00014400 0101
DS ← 8 DEC; 00014500 0101
END SEQUENCE; 00014600 0101
PROCEDURE DROP; 00014700 0101
BEGIN 00014800 0101
IF NOT BLANK (CP[0]) THEN 00014900 0101
BEGIN 00015000 0103
SEQUENCE (CP [0], SQ); 00015100 0104
SQ ← SQ + 100; 00015200 0105
WRITE (OUTPUT[J] [DBL], 10, CP[ *]); 00015300 0106
CLEARBUF (CP); 00015400 0111
END; 00015500 0112
WOUT ← SCOL DIV 8; 00015600 0112
COUT ← SCOL MOD 8; 00015700 0113
END DROP; 00015800 0114
PROCEDURE PERCENT; 00015900 0115
BEGIN 00016000 0115
INTEGER NUMCHAR, REMCHAR; 00016100 0115
START OF SEGMENT ********** 3
STREAM PROCEDURE MVCHAR (NUMB, SOURCE, SSKIP, DEST, DSKIP); 00016200 0000
VALUE NUMB, SSKIP, DSKIP; 00016300 0000
BEGIN 00016400 0000
SI ← SOURCE; 00016500 0000
SI ← SI + SSKIP; 00016600 0000
DI ← DEST; 00016700 0000
DI ← DI + DSKIP; 00016800 0001
DS ← NUMB CHR; 00016900 0001
END MVCHAR; 00017000 0002
IF (CIN ← CIN - 1) < 0 THEN 00017100 0002
BEGIN 00017200 0004
CIN ← CIN + 8; 00017300 0005
WIN ← WIN - 1; 00017400 0006
END; 00017500 0007
DROP; 00017600 0007
NUMCHAR ← 72 - (8 × WIN + CIN); 00017700 0008
IF (REMCHAR ← NUMCHAR - 40) > 0 THEN 00017800 0010
BEGIN 00017900 0012
MVCHAR (40, BUFIMG [WIN], CIN, CP [WIN], CIN); 00018000 0012
MVCHAR (REMCHAR, BUFIMG [WIN + 5], CIN, CP [WIN + 5], CIN); 00018100 0015
END 00018200 0018
ELSE MVCHAR (NUMCHAR, BUFIMG [WIN], CIN, CP[WIN], CIN); 00018300 0018
DROP; 00018400 0021
WIN ← 9; 00018500 0021
T ← " "; 00018600 0022
END PERCENT; 00018700 0023
3 IS 26 LONG, NEXT SEG 2
PROCEDURE COMSCAN; 00018800 0115
COMMENT THIS PROCEDURE HANDLES THE OUTPUTTING OF COMMENTS THAT 00018900 0115
APPEAR IN THE PROGRAM, PLACING THEM IN THE SAME POSITION 00019000 0115
THAT THEY HAD IN THE ORIGINAL CARD; 00019100 0115
BEGIN 00019200 0115
LABEL FOO; 00019300 0115
START OF SEGMENT ********** 4
INTEGER COL; 00019400 0000
COL ← SCOL; 00019500 0000
SCOL ← 0; 00019600 0000
CLEARBUF (CP); 00019700 0001
WIN ← WIN - 1; 00019800 0002
COUT ← CIN; 00019900 0003
WOUT ← WIN; 00020000 0004
FOO:T ← GETCHAR; 00020100 0005
IF WOUT > 8 THEN DROP; 00020200 0007
CB (T, CP [WOUT], COUT); 00020300 0008
COUT ← COUT + 1; 00020400 0010
WOUT ← WOUT + COUT DIV 8; 00020500 0011
COUT ← COUT MOD 8; 00020600 0013
IF T ≠ ";" THEN GO TO FOO; 00020700 0014
T ← GETCHAR; 00020800 0015
SCOL ← COL; 00020900 0016
DROP; 00021000 0017
END COMSCAN; 00021100 0018
4 IS 21 LONG, NEXT SEG 2
PROCEDURE CREAD; 00021200 0115
BEGIN 00021300 0115
LABEL N1, N2, DONE, C1, Q1, ST; 00021400 0115
START OF SEGMENT ********** 5
CBUF ← WBUF ← 0; 00021500 0000
CLEARBUF (BUF); 00021600 0001
CIN ← CIN - 1; 00021700 0002
ST: T ← GETCHAR; 00021800 0003
IF ALPHACHECK (T) THEN 00021900 0005
BEGIN 00022000 0006
IF T < 10 THEN 00022100 0006
BEGIN 00022200 0007
NUMSW ← TRUE; 00022300 0008
N1: CHARTOBUF (T); 00022400 0008
T ← GETCHAR; 00022500 0009
IF ALPHACHECK (T) AND T > 9 AND NUMSW AND NOT FLORMAT THEN 00022600 0010
BEGIN 00022700 0014
NUMSW ← FALSE; 00022800 0014
GO TO DONE; 00022900 0015
END; 00023000 0016
IF ALPHACHECK (T) THEN GO TO N1; 00023100 0016
IF T = "." OR T = ":" OR T = "," THEN GO TO N1; 00023200 0018
IF T = "@" THEN 00023300 0021
BEGIN 00023400 0022
CHARTOBUF (T); 00023500 0022
T ← GETCHAR; 00023600 0023
N2: CHARTOBUF (T); 00023700 0024
T ← GETCHAR; 00023800 0025
IF T < 10 THEN GO TO N2; 00023900 0026
END; 00024000 0028
GO TO DONE; 00024100 0028
END; 00024200 0028
C1:CHARTOBUF (T); 00024300 0028
T ← GETCHAR; 00024400 0029
IF ALPHACHECK (T) OR T = "." OR T = "[" OR T = ":" THEN GO TO 00024500 0030
C1; 00024600 0035
IF T = " " THEN GO TO DONE; 00024700 0035
IF T = "." THEN 00024800 0037
BEGIN 00024900 0037
CHARTOBUF ("."); 00025000 0038
T ← GETCHAR; 00025100 0039
END; 00025200 0040
IF T = ":" THEN 00025300 0040
BEGIN 00025400 0040
CHARTOBUF (":"); 00025500 0041
T ← GETCHAR; 00025600 0042
END; 00025700 0043
GO TO DONE; 00025800 0043
END; 00025900 0043
IF T = """ THEN 00026000 0043
BEGIN 00026100 0044
T ← GETCHAR; 00026200 0044
IF T = """ THEN 00026300 0045
BEGIN 00026400 0046
T ← GETCHAR; 00026500 0047
IF T ≠ """ THEN GO TO ENDIT; 00026600 0048
CHARTOBUF ("""); 00026700 0051
CHARTOBUF ("""); 00026800 0052
CHARTOBUF ("""); 00026900 0053
T ← GETCHAR; 00027000 0053
GO TO DONE; 00027100 0054
END; 00027200 0055
CHARTOBUF ("""); 00027300 0055
Q1: CHARTOBUF (T); 00027400 0056
T ← GETCHAR; 00027500 0056
IF T ≠ """ THEN GO TO Q1; 00027600 0057
CHARTOBUF ("""); 00027700 0059
T ← GETCHAR; 00027800 0059
GO TO DONE; 00027900 0060
END; 00028000 0061
IF T = "%" THEN PERCENT; 00028100 0061
IF T = " " THEN GO TO ST; 00028200 0063
IF T = "," OR T = ";" OR T = ")" OR T = "]" THEN COUT ← COUT - 1; 00028300 0064
IF COUT < 0 THEN 00028400 0069
BEGIN 00028500 0070
COUT ← COUT + 8; 00028600 0071
WOUT ← WOUT - 1; 00028700 0072
END; 00028800 0073
CHARTOBUF (T); 00028900 0073
PARM ← GETCHAR; 00029000 0074
IF T = ";" THEN FLORMAT ← FALSE; 00029100 0075
IF T ≠ "." AND T ≠ "[" AND T ≠ "(" THEN DONE : CHARTOBUF (" "); 00029200 0077
END CREAD; 00029300 0081
5 IS 82 LONG, NEXT SEG 2
%*********************************************************************** 00029400 0115
READ (CARD, /, I, J); 00029500 0115
IF I = 1 THEN CLOSE (CARD, RELEASE); 00029600 0124
FILER ← "FILE "; 00029700 0127
BLKBGN ← "BEGIN "; 00029800 0128
BLKEND ← "END . "; 00029900 0129
ELSER ← "ELSE "; 00030000 0130
SEMICO ← "; "; 00030100 0130
COMMA ← ", "; 00030200 0131
RTPAREN ← ") "; 00030300 0132
LFPAREN ← "( "; 00030400 0133
LISTR ← "LIST "; 00030500 0133
FRMATR ← "FORMAT"; 00030600 0134
SEMI ← COMA ← DECL ← FALSE; 00030700 0135
PAREN ← 0; 00030800 0137
WOUT ← WBUF ← CBUF ← 0; 00030900 0137
CIN ← 1; 00031000 0139
WIN ← 10; 00031100 0140
CLEARBUF (CP); 00031200 0141
CLEARBUF (BUF); 00031300 0142
SQ ← 100; 00031400 0143
ST: CREAD; 00031500 0143
TEMP ← 8 × WBUF + CBUF; 00031600 0144
IF EQUAL (BUF, 6, BLKBGN) THEN 00031700 0146
BEGIN 00031800 0148
DROP; 00031900 0148
IF SEMI THEN SCOL ← SCOL - 2 ELSE SCOL ← SCOL + 3; 00032000 0149
SEMI ← FALSE; 00032100 0163
END; 00032200 0164
IF EQUAL (BUF, TEMP, BLKEND) THEN 00032300 0164
BEGIN 00032400 0166
IF SEMI THEN SCOL ← SCOL - 5; 00032500 0166
SCOL ← SCOL - 3; 00032600 0168
DROP; 00032700 0169
SEMI ← FALSE; 00032800 0170
ENDR ← TRUE; 00032900 0171
END; 00033000 0171
IF ENDR AND EQUAL (BUF, TEMP, ELSER) THEN DROP; 00033100 0171
IF TEMP + COUT + 8 × WOUT > 72 THEN 00033200 0175
BEGIN 00033300 0177
IF NOT SEMI THEN SCOL ← SCOL + 5; 00033400 0178
SEMI ← TRUE; 00033500 0180
DROP; 00033600 0181
END; 00033700 0181
BUFTOOUT (BUF, TEMP, CP [WOUT], COUT); 00033800 0181
COUT ← COUT + TEMP; 00033900 0183
WOUT ← WOUT + COUT DIV 8; 00034000 0184
COUT ← COUT MOD 8; 00034100 0186
IF COMEQUAL (BUF) THEN COMSCAN; 00034200 0187
IF EQUAL (BUF, TEMP, LISTR) THEN DECL ← TRUE; 00034300 0190
IF EQUAL (BUF, 6, FRMATR) THEN DECL ← FLORMAT ← TRUE; 00034400 0193
IF EQUAL (BUF, TEMP, FILER) THEN DECL ← TRUE; 00034500 0197
IF DECL THEN 00034600 0200
BEGIN 00034700 0201
IF NOT SEMI THEN SCOL ← SCOL + 5; 00034800 0201
SEMI ← TRUE; 00034900 0203
IF NOT COMA THEN SCOL ← SCOL + 3; 00035000 0204
COMA ← TRUE; 00035100 0206
IF EQUAL (BUF, TEMP, LFPAREN) THEN PAREN ← PAREN + 1; 00035200 0207
IF EQUAL (BUF, TEMP, RTPAREN) THEN PAREN ← PAREN - 1; 00035300 0211
IF PAREN = 0 AND EQUAL (BUF, TEMP, COMMA) THEN 00035400 0215
BEGIN 00035500 0218
SCOL ← SCOL - 3; 00035600 0218
COMA ← FALSE; 00035700 0219
DROP; 00035800 0220
END; 00035900 0221
END; 00036000 0221
IF EQUAL (BUF, TEMP, SEMICO) THEN 00036100 0221
BEGIN 00036200 0223
IF SEMI THEN SCOL ← SCOL - 5; 00036300 0223
IF COMA THEN SCOL ← SCOL - 3; 00036400 0225
COMA ← DECL ← FLORMAT ← ENDR ← SEMI ← FALSE; 00036500 0227
DROP; 00036600 0230
END; 00036700 0230
IF EQUAL (BUF, 6, BLKBGN) THEN DROP; 00036800 0230
GO TO ST; 00036900 0233
ENDIT: DROP; 00037000 0234
END . 00037100 0235
2 IS 239 LONG, NEXT SEG 1
PRT(5) = BLOCK CONTROL INTRINSIC, SEGMENT NUMBER = 6.
PRT(123) = INPUT(W) INTRINSIC, SEGMENT NUMBER = 7.
PRT(104) = GO TO SOLVER INTRINSIC, SEGMENT NUMBER = 8.
PRT(14) = ALGOL WRITE INTRINSIC, SEGMENT NUMBER = 9.
PRT(15) = ALGOL READ INTRINSIC, SEGMENT NUMBER = 10.
PRT(16) = ALGOL SELECT INTRINSIC, SEGMENT NUMBER = 11.
PRT(33) = FILE ATTRBUTS INTRINSIC, SEGMENT NUMBER = 12.
1 IS 2 LONG, NEXT SEG 0
13 IS 69 LONG, NEXT SEG 0
NUMBER OF ERRORS DETECTED = 0. COMPILATION TIME = 20 SECONDS.
PRT SIZE = 84; TOTAL SEGMENT SIZE = 439 WORDS; DISK SIZE = 36 SEGS; NO. PGM. SEGS = 13
ESTIMATED CORE STORAGE REQUIRED = 3333 WORDS.
ESTIMATED AUXILIARY MEMORY REQUIRED = 0 WORDS.
LABEL 000000000LINE 00186150?COMPILE UNKRNCH/UTILITY ALGOL LIBRARY ALGOL /UNKRNCH
LABEL 000000000LINE 00186150?EXECUTE UNKRNCH/UTILITY UNKRNCH/UTILITY
KRUNCH 000104 AA * * * * * * * * * * * * * * * * * * * * * * * * * * * 00000100
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00000200
* * * * * * * * * * * * PLEASE NOTE THAT THE BURROUGHS CORPORATION 00000300
ASSUMES NO RESPONSIBILITY FOR THE USE OR MAINTENANCE OF THIS 00000400
PROGRAM. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00000500
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00000600
* * * * * * * * * * 00000700
BEGIN 00000800
ALPHA CH, T, IDENT, CHAR, SAVE1, TUF1, TUF2; 00000900
BOOLEAN ID, ID1, ID2, FIRSTCARD, EOF; 00001000
INTEGER I, WIN, WOUT, CIN, COUT, SQ; 00001100
LABEL K, L, M, N, ENDIT, N1; 00001200
ALPHA ARRAY BUFIMG[0:9]; 00001300
DEFINE CR = BUFIMG #; 00001400
FILE IN KRUCARD (1,10); 00001500
FILE OUT KRUPNCH 0 (1,10); 00001600
DEFINE CP = KRUPNCH #; 00001700
STREAM PROCEDURE SEQUENCE (FO, SQ, IDENT); 00001800
BEGIN 00001900
DI ← FO; 00002000
SI ← IDENT; 00002100
SI ← SI + 5; 00002200
DS ← 3 CHR; 00002300
SI ← SQ; 00002400
DS ← 5 DEC 00002500
END; 00002600
BOOLEAN STREAM PROCEDURE ALPHACHECK (T); 00002700
BEGIN 00002800
SI ← T; 00002900
SI ← SI + 7; 00003000
DI ← LOC ALPHACHECK; 00003100
DS ← 8 LIT "0"; 00003200
DI ← DI - 1; 00003300
SKIP 5 DB; 00003400
IF SC = ALPHA THEN DS ← 1 SET; 00003500
END; 00003600
ALPHA STREAM PROCEDURE GNCH (FI, CIN); 00003700
VALUE CIN; 00003800
BEGIN 00003900
SI ← FI; 00004000
SI ← SI + CIN; 00004100
DI ← LOC GNCH; 00004200
DI ← DI + 7; 00004300
DS ← CHR; 00004400
END GNCH; 00004500
ALPHA PROCEDURE GETCHAR; 00004600
BEGIN 00004700
IF WIN ≥ 9 THEN 00004800
BEGIN 00004900
LABEL L1, L2; 00005000
FORMAT FMT (13A6,A2); 00005100
ALPHA ARRAY INFO[0:13]; 00005200
STREAM PROCEDURE CONCAT (INBUF, OUTBUF); 00005300
BEGIN 00005400
SI ← INBUF; 00005500
DI ← OUTBUF; 00005600
13 (SI ← SI + 2; 00005700
DS ← 6 CHR); 00005800
SI ← SI + 6; 00005900
DS ← 2 CHR; 00006000
END; 00006100
STREAM PROCEDURE GETIDENT (IDENT, BUFIMG); 00006200
BEGIN 00006300
SI ← BUFIMG; 00006400
DI ← IDENT; 00006500
DI ← DI + 5; 00006600
DS ← 3 CHR 00006700
END; 00006800
INTEGER I; 00006900
READ (KRUCARD, FMT, FOR I ← 0 STEP 1 UNTIL 13 DO INFO[I]) [L1] 00007000
; 00007100
CONCAT (INFO[0], BUFIMG[0]); 00007200
IF FIRSTCARD THEN 00007300
BEGIN 00007400
GETIDENT (IDENT, BUFIMG[9]); 00007500
FIRSTCARD ← FALSE; 00007600
END; 00007700
GO TO L2; 00007800
L1:EOF ← TRUE; 00007900
L2:CIN ← WIN ← 0; 00008000
END; 00008100
TUF1 ← TUF2; 00008200
GETCHAR ← TUF2 ← GNCH (CR[WIN], CIN); 00008300
ID1 ← ID; 00008400
ID ← ALPHACHECK (TUF2) AND (ID OR TUF2 ≥ 10); 00008500
CIN ← CIN + 1; 00008600
IF CIN ≥ 8 THEN 00008700
BEGIN 00008800
WIN ← WIN + 1; 00008900
CIN ← CIN - 8 00009000
END; 00009100
END CHAR; 00009200
STREAM PROCEDURE PPCH (FO, COUT, CH); 00009300
VALUE COUT; 00009400
BEGIN 00009500
SI ← CH; 00009600
SI ← SI + 7; 00009700
DI ← FO; 00009800
DI ← DI + COUT; 00009900
DS ← CHR; 00010000
END; 00010100
PROCEDURE CHAROUT (CH); 00010200
VALUE CH; 00010300
ALPHA CH; 00010400
BEGIN 00010500
IF WOUT ≥ 9 THEN 00010600
BEGIN 00010700
SEQUENCE (CP (9), SQ, IDENT); 00010800
SQ ← SQ + 10; 00010900
RELEASE (CP); 00011000
COUT ← WOUT ← 0; 00011100
END; 00011200
PPCH (CP (WOUT), COUT, CH); 00011300
COUT ← COUT + 1; 00011400
IF COUT ≥ 8 THEN 00011500
BEGIN 00011600
WOUT ← WOUT + 1; 00011700
COUT ← COUT - 8; 00011800
END; 00011900
END CHAROUT; 00012000
PROCEDURE CLEAR; 00012100
BEGIN 00012200
INTEGER I; 00012300
FOR I ← 0 WHILE WOUT < 9 DO CHAROUT (" "); 00012400
END; 00012500
PROCEDURE COMMENTCHECK (L); 00012600
LABEL L; 00012700
BEGIN 00012800
LABEL NOPE; 00012900
INTEGER PTR, PWD; 00013000
PTR ← CIN; 00013100
PWD ← WIN; 00013200
SAVE1 ← T; 00013300
FOR CH ← "O", "M", "M", "E", "N", "T" DO 00013400
BEGIN 00013500
IF WIN ≥ 9 THEN GO TO NOPE; 00013600
CHAR ← GETCHAR; 00013700
IF EOF THEN GO TO ENDIT; 00013800
IF CH ≠ CHAR THEN GO TO NOPE; 00013900
END; 00014000
CHAR ← GETCHAR; 00014100
IF EOF THEN GO TO ENDIT; 00014200
T ← CHAR; 00014300
IF NOT ALPHACHECK (T) THEN FOR CH ← T WHILE CHAR ≠ ";" DO 00014400
BEGIN 00014500
CHAR ← GETCHAR; 00014600
IF EOF THEN GO TO ENDIT; 00014700
T ← CHAR; 00014800
END 00014900
ELSE GO TO NOPE; 00015000
GO TO L; 00015100
NOPE:WIN ← PWD; 00015200
CIN ← PTR; 00015300
ID ← ID1 ← TRUE; 00015400
T ← SAVE1; 00015500
END; 00015600
WIN ← 10; 00015700
FIRSTCARD ← TRUE; 00015800
EOF ← FALSE; 00015900
TUF1 ← TUF2 ← ";"; 00016000
SQ ← 10; 00016100
L:CHAR ← GETCHAR; 00016200
IF EOF THEN GO TO ENDIT; 00016300
T ← CHAR; 00016400
IF T = """ THEN 00016500
BEGIN 00016600
N:CHAR ← GETCHAR; 00016700
IF EOF THEN GO TO ENDIT; 00016800
T ← CHAR; 00016900
IF T = """ THEN 00017000
BEGIN 00017100
CHAR ← GETCHAR; 00017200
IF EOF THEN GO TO ENDIT; 00017300
IF CHAR ≠ """ THEN 00017400
BEGIN 00017500
ENDIT:CLEAR; 00017600
SEQUENCE (CP (9), SQ, IDENT); 00017700
RELEASE (CP); 00017800
GO TO N1; 00017900
END; 00018000
FOR I ← 1,2,3 DO CHAROUT ("""); 00018100
GO TO L; 00018200
END; 00018300
CHAROUT ("""); 00018400
CHAROUT (T); 00018500
K:CHAR ← GETCHAR; 00018600
IF EOF THEN GO TO ENDIT; 00018700
T ← CHAR; 00018800
CHAROUT (T); 00018900
IF T ≠ """ THEN GO TO K; 00019000
CHAR ← GETCHAR; 00019100
IF EOF THEN GO TO ENDIT; 00019200
T ← CHAR; 00019300
END; 00019400
IF T = " " THEN 00019500
BEGIN 00019600
ID2 ← ID1; 00019700
M:CHAR ← GETCHAR; 00019800
IF EOF THEN GO TO ENDIT; 00019900
T ← CHAR; 00020000
IF T = " " THEN GO TO M; 00020100
IF ID2 AND ALPHACHECK (T) THEN CHAROUT (" "); 00020200
IF T = """ THEN GO TO N; 00020300
END; 00020400
IF T = "%" THEN 00020500
BEGIN 00020600
WIN ← 10; 00020700
GO TO L; 00020800
END; 00020900
IF T = "$" AND 8 × WIN + CIN = 1 THEN 00021000
BEGIN 00021100
IF 8 × WOUT + COUT ≠ 0 THEN 00021200
BEGIN 00021300
CLEAR; 00021400
WOUT ← 10; 00021500
END; 00021600
CHAROUT ("$"); 00021700
FOR I ← 1 STEP 1 UNTIL 71 DO 00021800
BEGIN 00021900
CHAR ← GETCHAR; 00022000
IF EOF THEN GO TO ENDIT; 00022100
CHAROUT ((T ← CHAR)); 00022200
END; 00022300
GO TO L; 00022400
END; 00022500
IF T = "C" AND NOT ALPHACHECK (TUF1) THEN COMMENTCHECK (L); 00022600
CHAROUT (T); 00022700
GO TO L; 00022800
N1:END.END; 00022900
END.LAST CARD ON 0 CRDING TAPE 00023000
LABEL 000000000LINE 00186150?EXECUTE UNKRNCH/UTILITY UNKRNCH/UTILITY

431
KRUNCH-UNKRNCH/UNKRNCH.DEBUG.alg_m Normal file
View File

@@ -0,0 +1,431 @@
?COMPILE UNKRNCH/DEBUG ALGOL GO 00000010
?DATA CARD 00000020
$ CARD LIST SINGLE PRT DEBUGN 00000080160530PK
LABEL 000000000PUNCH 00170141017014100000000000000000000000100001000000000090
UNKRUNCH 000107AA 00000100
00000200
00000300
************************************************************************00000400
PLEASE NOTE THAT THE BURROUGHS CORPORATION ASSUMES 00000500
NO RESPONSIBILITY FOR THE USE OR MAINTENANCE OF THIS PROGRAM. 00000600
***********************************************************************;00000700
% UNKRUNCH/UTILITY PRODUCES A NEW SOURCE DECK OF ALGOL, REFORMATTED 00000800
% FOR BETTER READABILITY. 00000900
% THE CONTROL CARD FOR THIS PROGRAM IS FREE FIELD AND SETS THE 00001000
% SWITCH FILES FOR THE INPUT AND OUTPUT. 00001100
% THE FIRST NUMBER IS FOR THE INPUT. 00001200
% INPUT = 0 THEN A CARD DECK IS EXPECTED AFTER THE CONTROL CARD 00001300
% INPUT = 1 THEN A 0CRDIMG TAPE IS EXPECTED 00001400
% OUTPUT = 0 THEN THE CARD PUNCH WILL MAKE A NEW SEQUENCED DECK 00001500
% OUTPUT = 1 THEN A NEW RESEQUENCED 0CRDIMG TAPE IS MADE 00001600
% OUTPUT = 2 THE OUTPUT APPEARS ON THE LINE PRINTER. 00001700
% 00001800
BEGIN 00001900
FILE CARD(5,10,30), 00002000
TAPE "0CRDIMG" (2,56,10), 00002100
LINE 18(2,15), 00002200
PUNCH 0(5,10), 00002300
NEWTAPE "0CRDIMG" (2,56,10,SAVE 1); 00002400
INTEGER I, J, PAREN, WIN, CIN, WBUF, CBUF, WOUT, COUT, SQ, SCOL, 00002500
TEMP; 00002600
ALPHA PARM, T, FILER, CHAR, BLKBGN, BLKEND, ELSER, SEMICO, COMMA, 00002700
RTPAREN, LISTR, FRMATR, LFPAREN; 00002800
ARRAY BUFIMG [0 : 9], CP [0 : 9], BUF [0 : 9]; 00002900
BOOLEAN COMA, DECL, NUMSW, FLORMAT, SEMI, ENDR; 00003000
SWITCH FILE INPUT := CARD, 00003100
TAPE; 00003200
SWITCH FILE OUTPUT := PUNCH, 00003300
NEWTAPE, 00003400
LINE; 00003500
LABEL ENDIT, ST; 00003600
BOOLEAN STREAM PROCEDURE BLANK (CP); 00003700
BEGIN 00003800
LABEL L7; 00003900
TALLY ~ 0; 00004000
SI ~ CP; 00004100
2 (36 (IF SC ! " " THEN JUMP OUT 2 TO L7; 00004200
SI ~ SI + 1)); 00004300
TALLY ~ 1; 00004400
L7: BLANK ~ TALLY; 00004500
END BLANK; 00004600
ALPHA STREAM PROCEDURE GNCH (CR, CIN); 00004700
VALUE CIN; 00004800
BEGIN 00004900
SI ~ CR; 00005000
SI ~ SI + CIN; 00005100
DI ~ LOC GNCH; 00005200
DI ~ DI + 7; 00005300
DS ~ CHR; 00005400
END GNCH; 00005500
ALPHA PROCEDURE GETCHAR; 00005600
BEGIN 00005700
ALPHA GC; 00005750160530PK
IF CIN < 0 THEN 00005800
BEGIN 00005900
CIN ~ CIN + 8; 00006000
WIN ~ WIN - 1 00006100
END; 00006200
IF WIN > 8 THEN 00006300
BEGIN 00006400
READ (INPUT [I], 10, BUFIMG [*]) [ENDIT]; 00006500
WIN ~ CIN ~ 0; 00006600
END; 00006700
GETCHAR ~ GC ~ GNCH (BUFIMG [WIN], CIN); 00006800160530PK
WRITE(LINE, <"GETCHAR: ",2I4,X1,A1>, WIN, CIN, GC); 00006850160530PK
CIN ~ CIN + 1; 00006900
IF CIN > 7 THEN 00007000
BEGIN 00007100
WIN ~ WIN + 1; 00007200
CIN ~ CIN - 8; 00007300
END; 00007400
END GETCHAR; 00007500
STREAM PROCEDURE BUFTOOUT (BUF, TEMP, CP, COUT); 00007600
VALUE TEMP, COUT; 00007700
BEGIN 00007800
SI ~ BUF; 00007900
DI ~ CP; 00008000
DI ~ DI + COUT; 00008100
DS ~ TEMP CHR; 00008200
END BUFTOOUT; 00008300
BOOLEAN STREAM PROCEDURE COMEQUAL (BUF); 00008400
BEGIN 00008500
LOCAL NIC; 00008600
TALLY ~ 0; 00008700
SI ~ BUF; 00008800
DI ~ LOC NIC; 00008900
DS ~ 8 LIT "COMMENT "; 00009000
DI ~ DI - 8; 00009100
IF 8 SC = DC THEN TALLY ~ 1; 00009200
COMEQUAL ~ TALLY; 00009300
END COMEQUAL; 00009400
BOOLEAN STREAM PROCEDURE EQUAL (BUF, COUNT, T); 00009500
VALUE COUNT; 00009600
BEGIN 00009700
LABEL L1; 00009800
TALLY ~ 0; 00009900
SI ~ BUF; 00010000
DI ~ T; 00010100
DI ~ DI + 2; 00010200
COUNT (IF SC ! DC THEN JUMP OUT 1 TO L1); 00010300
TALLY ~ 1; 00010400
L1: EQUAL ~ TALLY; 00010500
END EQUAL; 00010600
STREAM PROCEDURE CB (T, BUF, CBUF); 00010700
VALUE CBUF; 00010800
BEGIN 00010900
SI ~ T; 00011000
SI ~ SI + 7; 00011100
DI ~ BUF; 00011200
DI ~ DI + CBUF; 00011300
DS ~ CHR; 00011400
END CR; 00011500
PROCEDURE CHARTOBUF (T); 00011600
VALUE T; 00011700
ALPHA T; 00011800
BEGIN 00011900
CB (T, BUF [WBUF], CBUF); 00012000
WRITE(LINE, <"CHARTOBUF: ",2I4,X1,A1>, WBUF, CBUF, T); 00012050160530PK
CBUF ~ CBUF + 1; 00012100
IF CBUF > 7 THEN 00012200
BEGIN 00012300
WBUF ~ WBUF + 1; 00012400
CBUF ~ CBUF - 8; 00012500
END; 00012600
END CHARTOBUF; 00012700
BOOLEAN STREAM PROCEDURE ALPHACHECK (T); 00012800
BEGIN 00012900
SI ~ T; 00013000
SI ~ SI + 7; 00013100
IF SC = ALPHA THEN TALLY ~ 1 ELSE TALLY ~ 0; 00013200
ALPHACHECK ~ TALLY; 00013300
END ALPHACHECK; 00013400
STREAM PROCEDURE CLEARBUF (BUF); 00013500
BEGIN 00013600
DI ~ BUF; 00013700
2 (DS ~ 40 LIT " "); 00013800
END CLEARBUF; 00013900
STREAM PROCEDURE SEQUENCE (FO, SQ); 00014000
BEGIN 00014100
DI ~ FO; 00014200
2 (DI ~ DI + 36); 00014300
SI ~ SQ; 00014400
DS ~ 8 DEC; 00014500
END SEQUENCE; 00014600
PROCEDURE DROP; 00014700
BEGIN 00014800
IF NOT BLANK (CP[0]) THEN 00014900
BEGIN 00015000
SEQUENCE (CP [0], SQ); 00015100
SQ ~ SQ + 100; 00015200
WRITE (OUTPUT[J] [DBL], 10, CP[ *]); 00015300
CLEARBUF (CP); 00015400
END; 00015500
WOUT ~ SCOL DIV 8; 00015600
COUT ~ SCOL MOD 8; 00015700
END DROP; 00015800
PROCEDURE PERCENT; 00015900
BEGIN 00016000
INTEGER NUMCHAR, REMCHAR; 00016100
STREAM PROCEDURE MVCHAR (NUMB, SOURCE, SSKIP, DEST, DSKIP); 00016200
VALUE NUMB, SSKIP, DSKIP; 00016300
BEGIN 00016400
SI ~ SOURCE; 00016500
SI ~ SI + SSKIP; 00016600
DI ~ DEST; 00016700
DI ~ DI + DSKIP; 00016800
DS ~ NUMB CHR; 00016900
END MVCHAR; 00017000
IF (CIN ~ CIN - 1) < 0 THEN 00017100
BEGIN 00017200
CIN ~ CIN + 8; 00017300
WIN ~ WIN - 1; 00017400
END; 00017500
DROP; 00017600
NUMCHAR ~ 72 - (8 | WIN + CIN); 00017700
IF (REMCHAR ~ NUMCHAR - 40) > 0 THEN 00017800
BEGIN 00017900
MVCHAR (40, BUFIMG [WIN], CIN, CP [WIN], CIN); 00018000
MVCHAR (REMCHAR, BUFIMG [WIN + 5], CIN, CP [WIN + 5], CIN); 00018100
END 00018200
ELSE MVCHAR (NUMCHAR, BUFIMG [WIN], CIN, CP[WIN], CIN); 00018300
DROP; 00018400
WIN ~ 9; 00018500
T ~ " "; 00018600
END PERCENT; 00018700
PROCEDURE COMSCAN; 00018800
COMMENT THIS PROCEDURE HANDLES THE OUTPUTTING OF COMMENTS THAT 00018900
APPEAR IN THE PROGRAM, PLACING THEM IN THE SAME POSITION 00019000
THAT THEY HAD IN THE ORIGINAL CARD; 00019100
BEGIN 00019200
LABEL FOO; 00019300
INTEGER COL; 00019400
COL ~ SCOL; 00019500
SCOL ~ 0; 00019600
CLEARBUF (CP); 00019700
WIN ~ WIN - 1; 00019800
COUT ~ CIN; 00019900
WOUT ~ WIN; 00020000
FOO:T ~ GETCHAR; 00020100
IF WOUT > 8 THEN DROP; 00020200
CB (T, CP [WOUT], COUT); 00020300
COUT ~ COUT + 1; 00020400
WOUT ~ WOUT + COUT DIV 8; 00020500
COUT ~ COUT MOD 8; 00020600
IF T ! ";" THEN GO TO FOO; 00020700
T ~ GETCHAR; 00020800
SCOL ~ COL; 00020900
DROP; 00021000
END COMSCAN; 00021100
PROCEDURE CREAD; 00021200
BEGIN 00021300
LABEL N1, N2, DONE, C1, Q1, ST; 00021400
MONITOR LINE (N1, N2, DONE,C1, Q1, ST, T, CIN, WIN); 00021450160530PK
CBUF ~ WBUF ~ 0; 00021500
CLEARBUF (BUF); 00021600
CIN ~ CIN - 1; 00021700
ST: T ~ GETCHAR; 00021800
IF ALPHACHECK (T) THEN 00021900
BEGIN 00022000
IF T < 10 THEN 00022100
BEGIN 00022200
NUMSW ~ TRUE; 00022300
N1: CHARTOBUF (T); 00022400
T ~ GETCHAR; 00022500
IF ALPHACHECK (T) AND T > 9 AND NUMSW AND NOT FLORMAT THEN 00022600
BEGIN 00022700
NUMSW ~ FALSE; 00022800
GO TO DONE; 00022900
END; 00023000
IF ALPHACHECK (T) THEN GO TO N1; 00023100
IF T = "." OR T = ":" OR T = "," THEN GO TO N1; 00023200
IF T = "@" THEN 00023300
BEGIN 00023400
CHARTOBUF (T); 00023500
T ~ GETCHAR; 00023600
N2: CHARTOBUF (T); 00023700
T ~ GETCHAR; 00023800
IF T < 10 THEN GO TO N2; 00023900
END; 00024000
GO TO DONE; 00024100
END; 00024200
C1:CHARTOBUF (T); 00024300
T ~ GETCHAR; 00024400
IF ALPHACHECK (T) OR T = "." OR T = "[" OR T = ":" THEN GO TO 00024500
C1; 00024600
IF T = " " THEN GO TO DONE; 00024700
IF T = "." THEN 00024800
BEGIN 00024900
CHARTOBUF ("."); 00025000
T ~ GETCHAR; 00025100
END; 00025200
IF T = ":" THEN 00025300
BEGIN 00025400
CHARTOBUF (":"); 00025500
T ~ GETCHAR; 00025600
END; 00025700
GO TO DONE; 00025800
END; 00025900
IF T = """ THEN 00026000
BEGIN 00026100
T ~ GETCHAR; 00026200
IF T = """ THEN 00026300
BEGIN 00026400
T ~ GETCHAR; 00026500
IF T ! """ THEN GO TO ENDIT; 00026600
CHARTOBUF ("""); 00026700
CHARTOBUF ("""); 00026800
CHARTOBUF ("""); 00026900
T ~ GETCHAR; 00027000
GO TO DONE; 00027100
END; 00027200
CHARTOBUF ("""); 00027300
Q1: CHARTOBUF (T); 00027400
T ~ GETCHAR; 00027500
IF T ! """ THEN GO TO Q1; 00027600
CHARTOBUF ("""); 00027700
T ~ GETCHAR; 00027800
GO TO DONE; 00027900
END; 00028000
IF T = "%" THEN PERCENT; 00028100
IF T = " " THEN GO TO ST; 00028200
IF T = "," OR T = ";" OR T = ")" OR T = "]" THEN COUT ~ COUT - 1; 00028300
IF COUT < 0 THEN 00028400
BEGIN 00028500
COUT ~ COUT + 8; 00028600
WOUT ~ WOUT - 1; 00028700
END; 00028800
CHARTOBUF (T); 00028900
PARM ~ GETCHAR; 00029000
IF T = ";" THEN FLORMAT ~ FALSE; 00029100
IF T ! "." AND T ! "[" AND T ! "(" THEN DONE : CHARTOBUF (" "); 00029200
WRITE(LINE, <"CREAD: ",2I4,X1,A1>, WOUT, COUT, T); 00029250160530PK
WRITE(LINE, 10, BUF[*]); 00029260160530PK
END CREAD; 00029300
%***********************************************************************00029400
READ (CARD, /, I, J); 00029500
IF I = 1 THEN CLOSE (CARD, RELEASE); 00029600
FILER ~ "FILE "; 00029700
BLKBGN ~ "BEGIN "; 00029800
BLKEND ~ "END . "; 00029900
ELSER ~ "ELSE "; 00030000
SEMICO ~ "; "; 00030100
COMMA ~ ", "; 00030200
RTPAREN ~ ") "; 00030300
LFPAREN ~ "( "; 00030400
LISTR ~ "LIST "; 00030500
FRMATR ~ "FORMAT"; 00030600
SEMI ~ COMA ~ DECL ~ FALSE; 00030700
PAREN ~ 0; 00030800
WOUT ~ WBUF ~ CBUF ~ 0; 00030900
CIN ~ 1; 00031000
WIN ~ 10; 00031100
CLEARBUF (CP); 00031200
CLEARBUF (BUF); 00031300
SQ ~ 100; 00031400
ST: CREAD; 00031500
TEMP ~ 8 | WBUF + CBUF; 00031600
IF EQUAL (BUF, 6, BLKBGN) THEN 00031700
BEGIN 00031800
DROP; 00031900
IF SEMI THEN SCOL ~ SCOL - 2 ELSE SCOL ~ SCOL + 3; 00032000
SEMI ~ FALSE; 00032100
END; 00032200
IF EQUAL (BUF, TEMP, BLKEND) THEN 00032300
BEGIN 00032400
IF SEMI THEN SCOL ~ SCOL - 5; 00032500
SCOL ~ SCOL - 3; 00032600
DROP; 00032700
SEMI ~ FALSE; 00032800
ENDR ~ TRUE; 00032900
END; 00033000
IF ENDR AND EQUAL (BUF, TEMP, ELSER) THEN DROP; 00033100
IF TEMP + COUT + 8 | WOUT > 72 THEN 00033200
BEGIN 00033300
IF NOT SEMI THEN SCOL ~ SCOL + 5; 00033400
SEMI ~ TRUE; 00033500
DROP; 00033600
END; 00033700
BUFTOOUT (BUF, TEMP, CP [WOUT], COUT); 00033800
COUT ~ COUT + TEMP; 00033900
WOUT ~ WOUT + COUT DIV 8; 00034000
COUT ~ COUT MOD 8; 00034100
IF COMEQUAL (BUF) THEN COMSCAN; 00034200
IF EQUAL (BUF, TEMP, LISTR) THEN DECL ~ TRUE; 00034300
IF EQUAL (BUF, 6, FRMATR) THEN DECL ~ FLORMAT ~ TRUE; 00034400
IF EQUAL (BUF, TEMP, FILER) THEN DECL ~ TRUE; 00034500
IF DECL THEN 00034600
BEGIN 00034700
IF NOT SEMI THEN SCOL ~ SCOL + 5; 00034800
SEMI ~ TRUE; 00034900
IF NOT COMA THEN SCOL ~ SCOL + 3; 00035000
COMA ~ TRUE; 00035100
IF EQUAL (BUF, TEMP, LFPAREN) THEN PAREN ~ PAREN + 1; 00035200
IF EQUAL (BUF, TEMP, RTPAREN) THEN PAREN ~ PAREN - 1; 00035300
IF PAREN = 0 AND EQUAL (BUF, TEMP, COMMA) THEN 00035400
BEGIN 00035500
SCOL ~ SCOL - 3; 00035600
COMA ~ FALSE; 00035700
DROP; 00035800
END; 00035900
END; 00036000
IF EQUAL (BUF, TEMP, SEMICO) THEN 00036100
BEGIN 00036200
IF SEMI THEN SCOL ~ SCOL - 5; 00036300
IF COMA THEN SCOL ~ SCOL - 3; 00036400
COMA ~ DECL ~ FLORMAT ~ ENDR ~ SEMI ~ FALSE; 00036500
DROP; 00036600
END; 00036700
IF EQUAL (BUF, 6, BLKBGN) THEN DROP; 00036800
GO TO ST; 00036900
ENDIT: DROP; 00037000
END . 00037100
?DATA CARD 00100000
0,2, 00100100160530PK
KRUNCH 000104AA*********************************************************00100200
***************PLEASE NOTE THAT THE BURROUGHS CORPORATION ASSUMES NO RES00100300
PONSIBILITY FOR THE USE OR MAINTENANCE OF THIS PROGRAM.*****************00100400
*******************************************************BEGIN ALPHA CH,T,00100500
IDENT,CHAR,SAVE1,TUF1,TUF2;BOOLEAN ID,ID1,ID2,FIRSTCARD,EOF;INTEGER I,WI00100600
N,WOUT,CIN,COUT,SQ;LABEL K,L,M,N,ENDIT,N1;ALPHA ARRAY BUFIMG[0:9];DEFINE00100700
CR=BUFIMG#;FILE IN KRUCARD(1,10);FILE OUT KRUPNCH 0(1,10);DEFINE CP=KRU00100800
PNCH#;STREAM PROCEDURE SEQUENCE(FO,SQ,IDENT);BEGIN DI~FO;SI~IDENT;SI~SI+00100900
5;DS~3CHR;SI~SQ;DS~5DEC END;BOOLEAN STREAM PROCEDURE ALPHACHECK(T);BEGIN00101000
SI~T;SI~SI+7;DI~LOC ALPHACHECK;DS~8LIT"0";DI~DI-1;SKIP 5DB;IF SC=ALPHA 00101100
THEN DS~1SET;END;ALPHA STREAM PROCEDURE GNCH(FI,CIN);VALUE CIN;BEGIN SI~00101200
FI;SI~SI+CIN;DI~LOC GNCH;DI~DI+7;DS~CHR;END GNCH;ALPHA PROCEDURE GETCHAR00101300
;BEGIN IF WIN}9THEN BEGIN LABEL L1,L2;FORMAT FMT(13A6,A2);ALPHA ARRAY IN00101400
FO[0:13];STREAM PROCEDURE CONCAT(INBUF,OUTBUF);BEGIN SI~INBUF;DI~OUTBUF;00101500
13(SI~SI+2;DS~6CHR);SI~SI+6;DS~2CHR;END;STREAM PROCEDURE GETIDENT(IDENT,00101600
BUFIMG);BEGIN SI~BUFIMG;DI~IDENT;DI~DI+5;DS~3CHR END;INTEGER I;READ(KRUC00101700
ARD,FMT,FOR I~0STEP 1UNTIL 13DO INFO[I])[L1];CONCAT(INFO[0],BUFIMG[0]);I00101800
F FIRSTCARD THEN BEGIN GETIDENT(IDENT,BUFIMG[9]);FIRSTCARD~FALSE;END;GO 00101900
TO L2;L1:EOF~TRUE;L2:CIN~WIN~0;END;TUF1~TUF2;GETCHAR~TUF2~GNCH(CR[WIN],C00102000
IN);ID1~ID;ID~ALPHACHECK(TUF2)AND(ID OR TUF2}10);CIN~CIN+1;IF CIN}8THEN 00102100
BEGIN WIN~WIN+1;CIN~CIN-8END;END CHAR;STREAM PROCEDURE PPCH(FO,COUT,CH);00102200
VALUE COUT;BEGIN SI~CH;SI~SI+7;DI~FO;DI~DI+COUT;DS~CHR;END;PROCEDURE CHA00102300
ROUT(CH);VALUE CH;ALPHA CH;BEGIN IF WOUT}9THEN BEGIN SEQUENCE(CP(9),SQ,I00102400
DENT);SQ~SQ+10;RELEASE(CP);COUT~WOUT~0;END;PPCH(CP(WOUT),COUT,CH);COUT~C00102500
OUT+1;IF COUT}8THEN BEGIN WOUT~WOUT+1;COUT~COUT-8;END;END CHAROUT;PROCED00102600
URE CLEAR;BEGIN INTEGER I;FOR I~0WHILE WOUT<9DO CHAROUT(" ");END;PROCEDU00102700
RE COMMENTCHECK(L);LABEL L;BEGIN LABEL NOPE;INTEGER PTR,PWD;PTR~CIN;PWD~00102800
WIN;SAVE1~T;FOR CH~"O","M","M","E","N","T"DO BEGIN IF WIN}9THEN GO TO NO00102900
PE;CHAR~GETCHAR;IF EOF THEN GO TO ENDIT;IF CH!CHAR THEN GO TO NOPE;END;C00103000
HAR~GETCHAR;IF EOF THEN GO TO ENDIT;T~CHAR;IF NOT ALPHACHECK(T)THEN FOR 00103100
CH~T WHILE CHAR!";"DO BEGIN CHAR~GETCHAR;IF EOF THEN GO TO ENDIT;T~CHAR;00103200
END ELSE GO TO NOPE;GO TO L;NOPE:WIN~PWD;CIN~PTR;ID~ID1~TRUE;T~SAVE1;END00103300
;WIN~10;FIRSTCARD~TRUE;EOF~FALSE;TUF1~TUF2~";";SQ~10;L:CHAR~GETCHAR;IF E00103400
OF THEN GO TO ENDIT;T~CHAR;IF T="""THEN BEGIN N:CHAR~GETCHAR;IF EOF THEN00103500
GO TO ENDIT;T~CHAR;IF T="""THEN BEGIN CHAR~GETCHAR;IF EOF THEN GO TO EN00103600
DIT;IF CHAR!"""THEN BEGIN ENDIT:CLEAR;SEQUENCE(CP(9),SQ,IDENT);RELEASE(C00103700
P);GO TO N1;END;FOR I~1,2,3DO CHAROUT(""");GO TO L;END;CHAROUT(""");CHAR00103800
OUT(T);K:CHAR~GETCHAR;IF EOF THEN GO TO ENDIT;T~CHAR;CHAROUT(T);IF T!"""00103900
THEN GO TO K;CHAR~GETCHAR;IF EOF THEN GO TO ENDIT;T~CHAR;END;IF T=" "THE00104000
N BEGIN ID2~ID1;M:CHAR~GETCHAR;IF EOF THEN GO TO ENDIT;T~CHAR;IF T=" "TH00104100
EN GO TO M;IF ID2 AND ALPHACHECK(T)THEN CHAROUT(" ");IF T="""THEN GO TO 00104200
N;END;IF T="%"THEN BEGIN WIN~10;GO TO L;END;IF T="$"AND 8|WIN+CIN=1THEN 00104300
BEGIN IF 8|WOUT+COUT!0THEN BEGIN CLEAR;WOUT~10;END;CHAROUT("$");FOR I~1S00104400
TEP 1UNTIL 71DO BEGIN CHAR~GETCHAR;IF EOF THEN GO TO ENDIT;CHAROUT((T~CH00104500
AR));END;GO TO L;END;IF T="C"AND NOT ALPHACHECK(TUF1)THEN COMMENTCHECK(L00104600
);CHAROUT(T);GO TO L;N1:END.END;END.LAST CARD ON 0CRDING TAPE 00104700
00104800
?END 99999999

373
KRUNCH-UNKRNCH/UNKRNCH.UTILITY.alg_m Normal file
View File

@@ -0,0 +1,373 @@
LABEL 000000000PUNCH 00170141017014100000000000000000000000100001000000000000
UNKRUNCH 000107AA 00000100
00000200
00000300
************************************************************************00000400
PLEASE NOTE THAT THE BURROUGHS CORPORATION ASSUMES 00000500
NO RESPONSIBILITY FOR THE USE OR MAINTENANCE OF THIS PROGRAM. 00000600
***********************************************************************;00000700
% UNKRUNCH/UTILITY PRODUCES A NEW SOURCE DECK OF ALGOL, REFORMATTED 00000800
% FOR BETTER READABILITY. 00000900
% THE CONTROL CARD FOR THIS PROGRAM IS FREE FIELD AND SETS THE 00001000
% SWITCH FILES FOR THE INPUT AND OUTPUT. 00001100
% THE FIRST NUMBER IS FOR THE INPUT. 00001200
% INPUT = 0 THEN A CARD DECK IS EXPECTED AFTER THE CONTROL CARD 00001300
% INPUT = 1 THEN A 0CRDIMG TAPE IS EXPECTED 00001400
% OUTPUT = 0 THEN THE CARD PUNCH WILL MAKE A NEW SEQUENCED DECK 00001500
% OUTPUT = 1 THEN A NEW RESEQUENCED 0CRDIMG TAPE IS MADE 00001600
% OUTPUT = 2 THE OUTPUT APPEARS ON THE LINE PRINTER. 00001700
% 00001800
BEGIN 00001900
FILE CARD(5,10,30), 00002000
TAPE "0CRDIMG" (2,56,10), 00002100
LINE 18(2,15), 00002200
PUNCH 0(5,10), 00002300
NEWTAPE "0CRDIMG" (2,56,10,SAVE 1); 00002400
INTEGER I, J, PAREN, WIN, CIN, WBUF, CBUF, WOUT, COUT, SQ, SCOL, 00002500
TEMP; 00002600
ALPHA PARM, T, FILER, CHAR, BLKBGN, BLKEND, ELSER, SEMICO, COMMA, 00002700
RTPAREN, LISTR, FRMATR, LFPAREN; 00002800
ARRAY BUFIMG [0 : 9], CP [0 : 9], BUF [0 : 9]; 00002900
BOOLEAN COMA, DECL, NUMSW, FLORMAT, SEMI, ENDR; 00003000
SWITCH FILE INPUT := CARD, 00003100
TAPE; 00003200
SWITCH FILE OUTPUT := PUNCH, 00003300
NEWTAPE, 00003400
LINE; 00003500
LABEL ENDIT, ST; 00003600
BOOLEAN STREAM PROCEDURE BLANK (CP); 00003700
BEGIN 00003800
LABEL L7; 00003900
TALLY ~ 0; 00004000
SI ~ CP; 00004100
2 (36 (IF SC ! " " THEN JUMP OUT 2 TO L7; 00004200
SI ~ SI + 1)); 00004300
TALLY ~ 1; 00004400
L7: BLANK ~ TALLY; 00004500
END BLANK; 00004600
ALPHA STREAM PROCEDURE GNCH (CR, CIN); 00004700
VALUE CIN; 00004800
BEGIN 00004900
SI ~ CR; 00005000
SI ~ SI + CIN; 00005100
DI ~ LOC GNCH; 00005200
DI ~ DI + 7; 00005300
DS ~ CHR; 00005400
END GNCH; 00005500
ALPHA PROCEDURE GETCHAR; 00005600
BEGIN 00005700
IF CIN < 0 THEN 00005800
BEGIN 00005900
CIN ~ CIN + 8; 00006000
WIN ~ WIN - 1 00006100
END; 00006200
IF WIN > 8 THEN 00006300
BEGIN 00006400
READ (INPUT [I], 10, BUFIMG [*]) [ENDIT]; 00006500
WIN ~ CIN ~ 0; 00006600
END; 00006700
GETCHAR ~ GNCH (BUFIMG [WIN], CIN); 00006800
CIN ~ CIN + 1; 00006900
IF CIN > 7 THEN 00007000
BEGIN 00007100
WIN ~ WIN + 1; 00007200
CIN ~ CIN - 8; 00007300
END; 00007400
END GETCHAR; 00007500
STREAM PROCEDURE BUFTOOUT (BUF, TEMP, CP, COUT); 00007600
VALUE TEMP, COUT; 00007700
BEGIN 00007800
SI ~ BUF; 00007900
DI ~ CP; 00008000
DI ~ DI + COUT; 00008100
DS ~ TEMP CHR; 00008200
END BUFTOOUT; 00008300
BOOLEAN STREAM PROCEDURE COMEQUAL (BUF); 00008400
BEGIN 00008500
LOCAL NIC; 00008600
TALLY ~ 0; 00008700
SI ~ BUF; 00008800
DI ~ LOC NIC; 00008900
DS ~ 8 LIT "COMMENT "; 00009000
DI ~ DI - 8; 00009100
IF 8 SC = DC THEN TALLY ~ 1; 00009200
COMEQUAL ~ TALLY; 00009300
END COMEQUAL; 00009400
BOOLEAN STREAM PROCEDURE EQUAL (BUF, COUNT, T); 00009500
VALUE COUNT; 00009600
BEGIN 00009700
LABEL L1; 00009800
TALLY ~ 0; 00009900
SI ~ BUF; 00010000
DI ~ T; 00010100
DI ~ DI + 2; 00010200
COUNT (IF SC ! DC THEN JUMP OUT 1 TO L1); 00010300
TALLY ~ 1; 00010400
L1: EQUAL ~ TALLY; 00010500
END EQUAL; 00010600
STREAM PROCEDURE CB (T, BUF, CBUF); 00010700
VALUE CBUF; 00010800
BEGIN 00010900
SI ~ T; 00011000
SI ~ SI + 7; 00011100
DI ~ BUF; 00011200
DI ~ DI + CBUF; 00011300
DS ~ CHR; 00011400
END CR; 00011500
PROCEDURE CHARTOBUF (T); 00011600
VALUE T; 00011700
ALPHA T; 00011800
BEGIN 00011900
CB (T, BUF [WBUF], CBUF); 00012000
CBUF ~ CBUF + 1; 00012100
IF CBUF > 7 THEN 00012200
BEGIN 00012300
WBUF ~ WBUF + 1; 00012400
CBUF ~ CBUF - 8; 00012500
END; 00012600
END CHARTOBUF; 00012700
BOOLEAN STREAM PROCEDURE ALPHACHECK (T); 00012800
BEGIN 00012900
SI ~ T; 00013000
SI ~ SI + 7; 00013100
IF SC = ALPHA THEN TALLY ~ 1 ELSE TALLY ~ 0; 00013200
ALPHACHECK ~ TALLY; 00013300
END ALPHACHECK; 00013400
STREAM PROCEDURE CLEARBUF (BUF); 00013500
BEGIN 00013600
DI ~ BUF; 00013700
2 (DS ~ 40 LIT " "); 00013800
END CLEARBUF; 00013900
STREAM PROCEDURE SEQUENCE (FO, SQ); 00014000
BEGIN 00014100
DI ~ FO; 00014200
2 (DI ~ DI + 36); 00014300
SI ~ SQ; 00014400
DS ~ 8 DEC; 00014500
END SEQUENCE; 00014600
PROCEDURE DROP; 00014700
BEGIN 00014800
IF NOT BLANK (CP[0]) THEN 00014900
BEGIN 00015000
SEQUENCE (CP [0], SQ); 00015100
SQ ~ SQ + 100; 00015200
WRITE (OUTPUT[J] [DBL], 10, CP[ *]); 00015300
CLEARBUF (CP); 00015400
END; 00015500
WOUT ~ SCOL DIV 8; 00015600
COUT ~ SCOL MOD 8; 00015700
END DROP; 00015800
PROCEDURE PERCENT; 00015900
BEGIN 00016000
INTEGER NUMCHAR, REMCHAR; 00016100
STREAM PROCEDURE MVCHAR (NUMB, SOURCE, SSKIP, DEST, DSKIP); 00016200
VALUE NUMB, SSKIP, DSKIP; 00016300
BEGIN 00016400
SI ~ SOURCE; 00016500
SI ~ SI + SSKIP; 00016600
DI ~ DEST; 00016700
DI ~ DI + DSKIP; 00016800
DS ~ NUMB CHR; 00016900
END MVCHAR; 00017000
IF (CIN ~ CIN - 1) < 0 THEN 00017100
BEGIN 00017200
CIN ~ CIN + 8; 00017300
WIN ~ WIN - 1; 00017400
END; 00017500
DROP; 00017600
NUMCHAR ~ 72 - (8 | WIN + CIN); 00017700
IF (REMCHAR ~ NUMCHAR - 40) > 0 THEN 00017800
BEGIN 00017900
MVCHAR (40, BUFIMG [WIN], CIN, CP [WIN], CIN); 00018000
MVCHAR (REMCHAR, BUFIMG [WIN + 5], CIN, CP [WIN + 5], CIN); 00018100
END 00018200
ELSE MVCHAR (NUMCHAR, BUFIMG [WIN], CIN, CP[WIN], CIN); 00018300
DROP; 00018400
WIN ~ 9; 00018500
T ~ " "; 00018600
END PERCENT; 00018700
PROCEDURE COMSCAN; 00018800
COMMENT THIS PROCEDURE HANDLES THE OUTPUTTING OF COMMENTS THAT 00018900
APPEAR IN THE PROGRAM, PLACING THEM IN THE SAME POSITION 00019000
THAT THEY HAD IN THE ORIGINAL CARD; 00019100
BEGIN 00019200
LABEL FOO; 00019300
INTEGER COL; 00019400
COL ~ SCOL; 00019500
SCOL ~ 0; 00019600
CLEARBUF (CP); 00019700
WIN ~ WIN - 1; 00019800
COUT ~ CIN; 00019900
WOUT ~ WIN; 00020000
FOO:T ~ GETCHAR; 00020100
IF WOUT > 8 THEN DROP; 00020200
CB (T, CP [WOUT], COUT); 00020300
COUT ~ COUT + 1; 00020400
WOUT ~ WOUT + COUT DIV 8; 00020500
COUT ~ COUT MOD 8; 00020600
IF T ! ";" THEN GO TO FOO; 00020700
T ~ GETCHAR; 00020800
SCOL ~ COL; 00020900
DROP; 00021000
END COMSCAN; 00021100
PROCEDURE CREAD; 00021200
BEGIN 00021300
LABEL N1, N2, DONE, C1, Q1, ST; 00021400
CBUF ~ WBUF ~ 0; 00021500
CLEARBUF (BUF); 00021600
CIN ~ CIN - 1; 00021700
ST: T ~ GETCHAR; 00021800
IF ALPHACHECK (T) THEN 00021900
BEGIN 00022000
IF T < 10 THEN 00022100
BEGIN 00022200
NUMSW ~ TRUE; 00022300
N1: CHARTOBUF (T); 00022400
T ~ GETCHAR; 00022500
IF ALPHACHECK (T) AND T > 9 AND NUMSW AND NOT FLORMAT THEN 00022600
BEGIN 00022700
NUMSW ~ FALSE; 00022800
GO TO DONE; 00022900
END; 00023000
IF ALPHACHECK (T) THEN GO TO N1; 00023100
IF T = "." OR T = ":" OR T = "," THEN GO TO N1; 00023200
IF T = "@" THEN 00023300
BEGIN 00023400
CHARTOBUF (T); 00023500
T ~ GETCHAR; 00023600
N2: CHARTOBUF (T); 00023700
T ~ GETCHAR; 00023800
IF T < 10 THEN GO TO N2; 00023900
END; 00024000
GO TO DONE; 00024100
END; 00024200
C1:CHARTOBUF (T); 00024300
T ~ GETCHAR; 00024400
IF ALPHACHECK (T) OR T = "." OR T = "[" OR T = ":" THEN GO TO 00024500
C1; 00024600
IF T = " " THEN GO TO DONE; 00024700
IF T = "." THEN 00024800
BEGIN 00024900
CHARTOBUF ("."); 00025000
T ~ GETCHAR; 00025100
END; 00025200
IF T = ":" THEN 00025300
BEGIN 00025400
CHARTOBUF (":"); 00025500
T ~ GETCHAR; 00025600
END; 00025700
GO TO DONE; 00025800
END; 00025900
IF T = """ THEN 00026000
BEGIN 00026100
T ~ GETCHAR; 00026200
IF T = """ THEN 00026300
BEGIN 00026400
T ~ GETCHAR; 00026500
IF T ! """ THEN GO TO ENDIT; 00026600
CHARTOBUF ("""); 00026700
CHARTOBUF ("""); 00026800
CHARTOBUF ("""); 00026900
T ~ GETCHAR; 00027000
GO TO DONE; 00027100
END; 00027200
CHARTOBUF ("""); 00027300
Q1: CHARTOBUF (T); 00027400
T ~ GETCHAR; 00027500
IF T ! """ THEN GO TO Q1; 00027600
CHARTOBUF ("""); 00027700
T ~ GETCHAR; 00027800
GO TO DONE; 00027900
END; 00028000
IF T = "%" THEN PERCENT; 00028100
IF T = " " THEN GO TO ST; 00028200
IF T = "," OR T = ";" OR T = ")" OR T = "]" THEN COUT ~ COUT - 1; 00028300
IF COUT < 0 THEN 00028400
BEGIN 00028500
COUT ~ COUT + 8; 00028600
WOUT ~ WOUT - 1; 00028700
END; 00028800
CHARTOBUF (T); 00028900
PARM ~ GETCHAR; 00029000
IF T = ";" THEN FLORMAT ~ FALSE; 00029100
IF T ! "." AND T ! "[" AND T ! "(" THEN DONE : CHARTOBUF (" "); 00029200
END CREAD; 00029300
%***********************************************************************00029400
READ (CARD, /, I, J); 00029500
IF I = 1 THEN CLOSE (CARD, RELEASE); 00029600
FILER ~ "FILE "; 00029700
BLKBGN ~ "BEGIN "; 00029800
BLKEND ~ "END . "; 00029900
ELSER ~ "ELSE "; 00030000
SEMICO ~ "; "; 00030100
COMMA ~ ", "; 00030200
RTPAREN ~ ") "; 00030300
LFPAREN ~ "( "; 00030400
LISTR ~ "LIST "; 00030500
FRMATR ~ "FORMAT"; 00030600
SEMI ~ COMA ~ DECL ~ FALSE; 00030700
PAREN ~ 0; 00030800
WOUT ~ WBUF ~ CBUF ~ 0; 00030900
CIN ~ 1; 00031000
WIN ~ 10; 00031100
CLEARBUF (CP); 00031200
CLEARBUF (BUF); 00031300
SQ ~ 100; 00031400
ST: CREAD; 00031500
TEMP ~ 8 | WBUF + CBUF; 00031600
IF EQUAL (BUF, 6, BLKBGN) THEN 00031700
BEGIN 00031800
DROP; 00031900
IF SEMI THEN SCOL ~ SCOL - 2 ELSE SCOL ~ SCOL + 3; 00032000
SEMI ~ FALSE; 00032100
END; 00032200
IF EQUAL (BUF, TEMP, BLKEND) THEN 00032300
BEGIN 00032400
IF SEMI THEN SCOL ~ SCOL - 5; 00032500
SCOL ~ SCOL - 3; 00032600
DROP; 00032700
SEMI ~ FALSE; 00032800
ENDR ~ TRUE; 00032900
END; 00033000
IF ENDR AND EQUAL (BUF, TEMP, ELSER) THEN DROP; 00033100
IF TEMP + COUT + 8 | WOUT > 72 THEN 00033200
BEGIN 00033300
IF NOT SEMI THEN SCOL ~ SCOL + 5; 00033400
SEMI ~ TRUE; 00033500
DROP; 00033600
END; 00033700
BUFTOOUT (BUF, TEMP, CP [WOUT], COUT); 00033800
COUT ~ COUT + TEMP; 00033900
WOUT ~ WOUT + COUT DIV 8; 00034000
COUT ~ COUT MOD 8; 00034100
IF COMEQUAL (BUF) THEN COMSCAN; 00034200
IF EQUAL (BUF, TEMP, LISTR) THEN DECL ~ TRUE; 00034300
IF EQUAL (BUF, 6, FRMATR) THEN DECL ~ FLORMAT ~ TRUE; 00034400
IF EQUAL (BUF, TEMP, FILER) THEN DECL ~ TRUE; 00034500
IF DECL THEN 00034600
BEGIN 00034700
IF NOT SEMI THEN SCOL ~ SCOL + 5; 00034800
SEMI ~ TRUE; 00034900
IF NOT COMA THEN SCOL ~ SCOL + 3; 00035000
COMA ~ TRUE; 00035100
IF EQUAL (BUF, TEMP, LFPAREN) THEN PAREN ~ PAREN + 1; 00035200
IF EQUAL (BUF, TEMP, RTPAREN) THEN PAREN ~ PAREN - 1; 00035300
IF PAREN = 0 AND EQUAL (BUF, TEMP, COMMA) THEN 00035400
BEGIN 00035500
SCOL ~ SCOL - 3; 00035600
COMA ~ FALSE; 00035700
DROP; 00035800
END; 00035900
END; 00036000
IF EQUAL (BUF, TEMP, SEMICO) THEN 00036100
BEGIN 00036200
IF SEMI THEN SCOL ~ SCOL - 5; 00036300
IF COMA THEN SCOL ~ SCOL - 3; 00036400
COMA ~ DECL ~ FLORMAT ~ ENDR ~ SEMI ~ FALSE; 00036500
DROP; 00036600
END; 00036700
IF EQUAL (BUF, 6, BLKBGN) THEN DROP; 00036800
GO TO ST; 00036900
ENDIT: DROP; 00037000
END . 00037100
END;END. LAST CARD ON 0CRDING TAPE 99999999