COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "PRES"
C00008 00003	ARRYIN(FILE,DATA[1],NWORDS)
C00012 ENDMK
C⊗;
BEGIN "PRES"
DEFINE SU = "STEP 1 UNTIL";
DEFINE CRLF = "'15&'12";
DEFINE RH(I) = "DATA[(I)] LAND '777777";
DEFINE LH(I) = "DATA[(I)] LSH -18";
DEFINE NDEV = "7";
DEFINE LPNHED = "2";		COMMENT PTR TO PTR TO PN HEADER LIST;
DEFINE LDATHED= "3";		COMMENT PTR TO PTR TO DAT HEADER LIST;
DEFINE LDATA = "4";
DEFINE NFREE = "DATA[5]";	COMMENT # OF FREE BLOCKS LEFT IN DATA;
DEFINE FCDATE = "DATA[6]";
DEFINE NLIMBO = "DATA[7]";	COMMENT NUMBER OF BLOCKS IN LIMBO;
DEFINE WINFO = "8";		COMMENT PTR TO PTR TO WORD INFORMATION;
DEFINE LHEDLEN = "8";		COMMENT # OF WORDS IN DATA HEADER BLOCK;
DEFINE LIMBIT = "'400000";
BOOLEAN TTY;
EXTERNAL INTEGER PROCEDURE REG(INTEGER DATE);
	REQUIRE "RSL2.REL" LOAD_MODULE;
INTEGER FILE,EOF,C,B,I,F,OFILNUM;
STRING S20,OFILNAME,IFILE;
INTEGER DATALEN,NWORDS,X,W,DATE0,T,BLOCKI;
INTEGER ARRAY WABA[1:3];	INTEGER ARRAY SIX[1:6];

EOF ← 1;
FILE ← GETCHAN;
F ← 0;	C←200;
S20 ← "              ";
OPEN(FILE,"DSK",'17,2,2,C,B,EOF);
OUTSTR(CRLF & "INPUT FILE? ");
IFILE ← INCHWL;
IF EQU(IFILE,NULL) THEN IFILE ← "GSLRES";
LOOKUP(FILE,IFILE,F);
FILEINFO(SIX);
OUTSTR(CVOS(SIX[4]));
DATALEN ← NWORDS ← -(SIX[4] ROT 18);
OUTSTR(" NWORDS=");	OUTSTR(CVOS(NWORDS));	OUTSTR(CRLF);
OFILNUM ← GETCHAN;
OUTSTR(CRLF & " OUTPUT FILE? ");
OFILNAME ← INCHWL;
TTY ← EQU(NULL,OFILNAME);
IF ¬TTY THEN BEGIN	OPEN (OFILNUM,"DSK",0,2,2,C,B,EOF);
			ENTER(OFILNUM,OFILNAME,F);
	     END;
DATE0 ← ((1971-1964)*12+11)*31+0;
COMMENT: DATE0 IS DEFINED ALSO IN RSL.SAI AND SL.SAI;

BEGIN "DYNAMIC ALLOCATION"

PRELOAD_WITH ",III0",",III1",",III2",",III3",",III4",",III5",",AD";
	STRING ARRAY DEVRES[1:NDEV];

INTEGER ARRAY DATA[1:DATALEN];

PROCEDURE O(STRING S);
	IF TTY THEN OUTSTR(S) ELSE OUT(OFILNUM,S);

PROCEDURE DATSTR(INTEGER DATE); COMMENT: IN GSLMON FORMAT;
BEGIN	INTEGER DOW,HOUR,DAY,MONTH,YEAR;
	O(" ");
	HOUR  ← DATE MOD 24;	DATE ← DATE DIV 24 + DATE0;
	DOW   ← REG(DATE);
	DAY   ← DATE MOD 31 +1;	DATE ← DATE DIV 31;
	MONTH ← DATE MOD 12;	YEAR ← DATE DIV 12 + 1964;
	COMMENT ( (IF HOUR=0 THEN "000" ELSE IF HOUR≤9 THEN "0" ELSE NULL) & CVS(HOUR*100) & " " &
		(CASE DOW OF ("  Sun","  Mon"," Tues","Wed's","Thurs",
		"  Fri","Satur","  Sun")) & "day, " & (IF DAY≤9 THEN " " ELSE NULL) & CVS(DAY) &
		"-" & (CASE MONTH OF ("JAN","FEB","MAR","APR","MAY",
		"JUN","JLY","AUG","SEP","OCT","NOV","DEC")) &
		(", " & CVS(YEAR)) );
	SETFORMAT(2,0);
	O(CVS(HOUR));	O("00: ");	O(CVS(DAY));	O("-");
	O(CVS(MONTH));	O("-");		O(CVS(YEAR));	SETFORMAT(4,0);
END;

PROCEDURE PNS(INTEGER X);
IF X=0 THEN O("  *0*") ELSE O("  "&CVXSTR(X)[4 TO 6]);

PROCEDURE RESTR(INTEGER X);
BEGIN	"RESTR"	INTEGER R;
	IF X='400000 THEN BEGIN O(" BARE-TIME"); RETURN END;
	SETFORMAT(3,0); O(CVS(X LAND '177)); O("%");
	FOR I←1 SU NDEV DO IF (('400000 LSH -I) LAND X)≠0 
		THEN O(DEVRES[I]);
END "RESTR";

PROCEDURE WABAS(INTEGER X);
BEGIN	"WABAS"	INTEGER I;
	I ← X LAND '3777;	SETFORMAT(4,0);	O(CVS(I));
	O(" BAMS,");	SETFORMAT(2,0);
	I ← (X LAND '774000) LSH -11;
	O(CVS(I));	O(" WHAMS");	RETURN
END;

PROCEDURE DH4S(INTEGER X);
	IF X LAND LIMBIT = 0
	THEN O("   COSTF: "&CVS(X))
	ELSE O("  LIMBO DATES AT "&CVOS(X - LIMBIT));

INTEGER PROCEDURE WHICH(INTEGER I);
COMMENT: DETERMIE WHICH TYPE OF BLOCK IS AT DATA[I]
	1 - PN HEADER
	2 - DATE HEADER
	3 - RESERVATION BLOCK
	4 - RESERVATION BLOCK IN LIMBO
	5 - LIMBO DATE CHECKOFF BLOCK
	6 - FREE BLOCK
	;
BEGIN	"WHICH"	INTEGER X,J;	LABEL L0;
	IF LH(I) = '777777 THEN RETURN(4);
	IF RH(I) = '777777 THEN RETURN(5);
	IF DATA[I+1] = 0 THEN RETURN(6);
	X ← LH(I+1);
	FOR J ← 1 SU 3 DO IF X=WABA[J] THEN RETURN(1);
  L0:	IF (X←LH(I))≠0 ∧ X≤DATALEN ∧ RH(X)=I THEN RETURN(2);
	RETURN(3)
END	"WHICH";
WABA[1] ← 10 LSH 11 + 100;
WABA[2] ← 20 LSH 11 + 200;
WABA[3] ← 40 LSH 11 + 400;
ARRYIN(FILE,DATA[1],NWORDS);
SETFORMAT(6,0);
W ← WINFO LSH -18;
O("FIRST PN HEADER AT   ");	O(CVOS(DATA[LPNHED]));	O(CRLF);
O("FIRST DATE HEADER AT ");	O(CVOS(DATA[LDATHED]));	O(CRLF);
O("FIRST FREE BLOCK AT  ");	O(CVOS(DATA[LDATA]));	O(CRLF);
O(CVS(NFREE));	O(" FREE BLOCKS REMAINING");	O(CRLF);
O("FORECAST DATE: ");	DATSTR(FCDATE);	O(CRLF);
O(CVS(NLIMBO));	O(" LIMBO BLOCKS");	O(CRLF);
O(CVS(LH(WINFO)));	O(" WORDS USED(DATALEN)");
O("  LAST WORD USED IS #");	O(CVS(RH(WINFO)));	O(CRLF);

W ← RH(WINFO);
FOR BLOCKI ← LHEDLEN+1 STEP 3 UNTIL W DO
BEGIN	SETFORMAT(4,0);	O(CRLF); SETFORMAT(7,0); O(CVOS(BLOCKI)); O(":");
	FOR T←0 SU 2 DO
	BEGIN	O(CVOS(LH(BLOCKI+T))); O(CVOS(RH(BLOCKI+T)));
	END;
	T ← WHICH(BLOCKI);	O(" ");
	CASE(T-1) OF
	BEGIN
	BEGIN "PNHED" O("PNHED"); SETFORMAT(4,0);
		O(CVOS(LH(BLOCKI)));	O(CVOS(RH(BLOCKI)));
		WABAS(LH(BLOCKI+1));	PNS(RH(BLOCKI+1));
		WABAS(LH(BLOCKI+2)); O("  "); O(CVOS(RH(BLOCKI+2)))
	END;
	BEGIN "DATHED" O("DATHED"); SETFORMAT(4,0);
		O(CVOS(LH(BLOCKI)));	O(CVOS(RH(BLOCKI)));
		DATSTR(LH(BLOCKI+1));	DH4S(RH(BLOCKI+1));
		RESTR(LH(BLOCKI+2));
	END;
	BEGIN "RESERVATION BLOCK"
		INTEGER TEMP;
		O("RESBLK"); SETFORMAT(4,0);
		O(CVOS(LH(BLOCKI)));	O(CVOS(RH(BLOCKI)));
		RESTR(LH(BLOCKI+1));	PNS(RH(BLOCKI+1));
       		PNS(RH(1+LH(BLOCKI+2)));
		TEMP←LH(BLOCKI+2)+1;
		PNS(RH(TEMP));
		O(CVOS(RH(BLOCKI+2)));
	END;
	BEGIN "RES LIM BLK" O("RESLIM"); SETFORMAT(4,0);
		O(CVOS(RH(BLOCKI)));
		RESTR(LH(BLOCKI+1));	PNS(RH(BLOCKI+1));
		PNS(LH(BLOCKI+2));	O(CVOS(RH(BLOCKI+2)));
	END;
	BEGIN "CHECKOFF" O("CHCKFF"); SETFORMAT(2,0);
		O(CVOS(LH(BLOCKI)));
		DATSTR(LH(BLOCKI+1));	DATSTR(RH(BLOCKI+1));
		DATSTR(LH(BLOCKI+2));	DATSTR(RH(BLOCKI+2));
	END;
	BEGIN "FREE" O("FREEBK"); SETFORMAT(4,0);
		O(CVOS(RH(BLOCKI)));
	END
	END;
END;
IF ¬TTY THEN RELEASE(OFILNUM);
END "DYNAMIC ALLOCATION"
END "PRES"