mirror of
https://github.com/retro-software/B5500-software.git
synced 2026-03-05 18:29:15 +00:00
2c72f7fd1d
1. Commit library tape images, directories, and extracted text files. 2. Commit additional utilities under Unisys-Emode-Tools.
228 lines
18 KiB
Plaintext
228 lines
18 KiB
Plaintext
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 = "$" 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
|