From 9266d9b3c1c8bd428397b924e86a3b12d2cdc351 Mon Sep 17 00:00:00 2001 From: Paul Kimpel Date: Mon, 30 May 2016 13:12:33 -0700 Subject: [PATCH] Commit Burroughs KRUNCH and UNKRNCH utilities from CUBE library. --- KRUNCH-UNKRNCH/KRUNCH-As-Krunched.card | 46 ++ KRUNCH-UNKRNCH/KRUNCH-Compile.lst | 271 ++++++++ KRUNCH-UNKRNCH/KRUNCH.UTILITY.alg_m | 228 +++++++ KRUNCH-UNKRNCH/README.txt | 71 ++ KRUNCH-UNKRNCH/UNKRNCH-Compile-Run.lst | 895 +++++++++++++++++++++++++ KRUNCH-UNKRNCH/UNKRNCH.DEBUG.alg_m | 431 ++++++++++++ KRUNCH-UNKRNCH/UNKRNCH.UTILITY.alg_m | 373 +++++++++++ 7 files changed, 2315 insertions(+) create mode 100644 KRUNCH-UNKRNCH/KRUNCH-As-Krunched.card create mode 100644 KRUNCH-UNKRNCH/KRUNCH-Compile.lst create mode 100644 KRUNCH-UNKRNCH/KRUNCH.UTILITY.alg_m create mode 100644 KRUNCH-UNKRNCH/README.txt create mode 100644 KRUNCH-UNKRNCH/UNKRNCH-Compile-Run.lst create mode 100644 KRUNCH-UNKRNCH/UNKRNCH.DEBUG.alg_m create mode 100644 KRUNCH-UNKRNCH/UNKRNCH.UTILITY.alg_m diff --git a/KRUNCH-UNKRNCH/KRUNCH-As-Krunched.card b/KRUNCH-UNKRNCH/KRUNCH-As-Krunched.card new file mode 100644 index 0000000..73677fb --- /dev/null +++ b/KRUNCH-UNKRNCH/KRUNCH-As-Krunched.card @@ -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 diff --git a/KRUNCH-UNKRNCH/KRUNCH-Compile.lst b/KRUNCH-UNKRNCH/KRUNCH-Compile.lst new file mode 100644 index 0000000..d0f3079 --- /dev/null +++ b/KRUNCH-UNKRNCH/KRUNCH-Compile.lst @@ -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 diff --git a/KRUNCH-UNKRNCH/KRUNCH.UTILITY.alg_m b/KRUNCH-UNKRNCH/KRUNCH.UTILITY.alg_m new file mode 100644 index 0000000..5a98621 --- /dev/null +++ b/KRUNCH-UNKRNCH/KRUNCH.UTILITY.alg_m @@ -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 diff --git a/KRUNCH-UNKRNCH/README.txt b/KRUNCH-UNKRNCH/README.txt new file mode 100644 index 0000000..e34324b --- /dev/null +++ b/KRUNCH-UNKRNCH/README.txt @@ -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 + + diff --git a/KRUNCH-UNKRNCH/UNKRNCH-Compile-Run.lst b/KRUNCH-UNKRNCH/UNKRNCH-Compile-Run.lst new file mode 100644 index 0000000..f5f6e9c --- /dev/null +++ b/KRUNCH-UNKRNCH/UNKRNCH-Compile-Run.lst @@ -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 diff --git a/KRUNCH-UNKRNCH/UNKRNCH.DEBUG.alg_m b/KRUNCH-UNKRNCH/UNKRNCH.DEBUG.alg_m new file mode 100644 index 0000000..a81bb40 --- /dev/null +++ b/KRUNCH-UNKRNCH/UNKRNCH.DEBUG.alg_m @@ -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 diff --git a/KRUNCH-UNKRNCH/UNKRNCH.UTILITY.alg_m b/KRUNCH-UNKRNCH/UNKRNCH.UTILITY.alg_m new file mode 100644 index 0000000..430c945 --- /dev/null +++ b/KRUNCH-UNKRNCH/UNKRNCH.UTILITY.alg_m @@ -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