Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/25/sutlod.alg
There is 1 other file named sutlod.alg in the archive. Click here to see a list.
BEGIN
CHECKON 1;

!CONTENTS OF CURRENT RELOCATION WORD, SIZE OF LOADED PROGRAM, UTILITY WORD FOR EDITING;
INTEGER RELWORD,SIZE,DEPTH;
	BOOLEAN DFIX,DLOAD,DALL;
BOOLEAN NEGATIVE;
! LAST INPUT DATA WORD, CURRENT LOAD ADDRESS, BLOCK CODE;
INTEGER WORD,ADDRESS,CODE,ENDOFCHAIN,VALU,T1,T2,T3,BLOCKNO,LEFTINBLOCK,LEFTINGROUP;
STRING FILE;
WRITE("SIZE OF LOADED REL FILE?");BREAKOUTPUT;
READ(SIZE);
WRITE("REL FILE TO LOAD?");BREAKOUTPUT;
READ (FILE);
BEGIN
	INTEGER ARRAY CORE[0:SIZE];
	BOOLEAN ARRAY SET,FIXED[0:SIZE];
	FORWARD PROCEDURE MSG;
	PROCEDURE CHECKR(AD); VALUE AD; INTEGER AD;
	BEGIN IF AD<0 OR AD>SIZE THEN MSG("ADDRESS RANGE");
	END;
	PROCEDURE SPLITWORD(LEFT,RIGHT);
		INTEGER LEFT,RIGHT;
	BEGIN	IF WORD<0 THEN WRITE(" NEG WORD SPLIT");
		!DOES THIS WORK FOR NEGATIVE WORDS?;
		RIGHT:=INT(BOOL(WORD) AND %777777);
		LEFT:=(WORD-RIGHT) DIV (2^18) ;

	END;
	BOOLEAN PROCEDURE ENDFILE;
	BEGIN	BOOLEAN B;
		B:=IOCHAN(1) AND %100;
		IF INT(B)=0 THEN ENDFILE:=FALSE ELSE ENDFILE:=TRUE;
	END;
	BOOLEAN PROCEDURE ASK(S); STRING S;
	BEGIN	INTEGER ANS;
		SELECTINPUT(-1);
		! ASK QUESTION S AND RETURN TRUE IF Y TYPED, FALSE IF N;
		NEWLINE;
		WRITE(S);BREAKOUTPUT;
		ANS:=0;
		WHILE ANS # $/Y/ AND ANS # $/N/ DO INSYMBOL(ANS);
		IF ANS=$/Y/ THEN ASK:=TRUE ELSE ASK:=FALSE;
	END ASK;
	PROCEDURE HEADERIN;
	BEGIN	BLOCKNO:=BLOCKNO+1;
		INSYMBOL(WORD);
		SPLITWORD(CODE,LEFTINBLOCK);
		LEFTINGROUP:=0;
	END;
	
	PROCEDURE WORDIN;
	BEGIN	IF LEFTINGROUP=0 THEN
		BEGIN	LEFTINGROUP:=18;
			INSYMBOL(RELWORD);
		END;
		LEFTINBLOCK:=LEFTINBLOCK-1;
		LEFTINGROUP:=LEFTINGROUP-1;
		INSYMBOL(WORD);
	END;
	
	PROCEDURE OCTO(N);
		VALUE N; INTEGER N;
	BEGIN	INTEGER N1;
		IF DEPTH=0 THEN
		BEGIN	IF N<0 THEN
			BEGIN	NEGATIVE:=TRUE;
				N:=INT(BOOL(N) AND %377777777777);
			END ELSE NEGATIVE:=FALSE;
		END;
		DEPTH:=DEPTH+1;
		IF DEPTH<12 THEN OCTO(N DIV 8);
		N1:=N REM 8;
		IF DEPTH=6 AND N>7 THEN OUTSYMBOL($/,/);
		IF DEPTH=6 AND N<8 THEN OUTSYMBOL($/ /);
		IF NEGATIVE AND DEPTH=12 THEN OUTSYMBOL(N1+$/4/) ELSE
		IF N=0 THEN OUTSYMBOL($/ /) ELSE OUTSYMBOL($/0/+N1);
		DEPTH:=DEPTH-1;
	END;
	PROCEDURE OC(S,N);STRING S; INTEGER N;
	BEGIN NEWLINE;
		WRITE(S);TAB;
		OCTO(N);
	END;
	PROCEDURE MAP;
	BEGIN BOOLEAN SKP;
		NEWLINE;
		WRITE("SUPPLY DUMP INFO,ANSWERS Y<CR> OR N<CR> ");
		NEWLINE;
		DFIX:=ASK("INTERNAL REQUESTS?");
		DLOAD:=ASK("LOADED CORE?");
		DALL:=ASK("ALL?");
		SKP:=FALSE;
		FOR T1:=0 STEP 1 UNTIL SIZE DO
		BEGIN IF ((FIXED[T1] AND DFIX) OR (SET[T1] AND DLOAD) OR DALL) THEN
			BEGIN NEWLINE; IF INT(BOOL(T1) AND %7)=0 THEN SKP:=TRUE;

				IF SKP THEN OCTO(T1) ELSE WRITE(" ");

				SKP:=FALSE;
				TAB;
				OCTO(CORE[T1]); IF FIXED[T1] THEN
					WRITE("*");

			END ELSE SKP:=TRUE;
		END;
	END;
	PROCEDURE MSG(S);
		STRING S;
	BEGIN	NEWLINE;
		WRITE(S);
		NEWLINE;
		OC("WORD",WORD);
		OC("CODE",CODE);
		OC("LEFTINBLOCK",LEFTINBLOCK);
		OC("BLOCKNO",BLOCKNO);
		OC("ENDOFCHAIN",ENDOFCHAIN);
		OC("VALU",VALU);
		OC("LEFTINGROUP",LEFTINGROUP);
		MAP;
		ENDOFCHAIN:=0;
		IF NOT ENDFILE THEN
		BEGIN IF NOT ASK("CONTINUE?")  THEN GOTO EXIT; END ELSE
		GOTO EXIT;
	END;
	
PROCEDURE INITCORE;
	BEGIN	FOR T1:=0 STEP 1 UNTIL SIZE DO
		BEGIN CORE[T1]:=0;
			SET[T1]:=FIXED[T1]:=FALSE;
		END;
	END;

	WORD:=ADDRESS:=CODE:=ENDOFCHAIN:=VALU:=T1:=T2:=T3:=DEPTH:=0;
	BLOCKNO:=LEFTINBLOCK:=LEFTINGROUP:=0;
	INPUT(1,"DSK",11);
	OPENFILE(1,FILE);
	SELECTINPUT(1);
	INITCORE;
	WHILE NOT ENDFILE DO
	BEGIN	HEADERIN;
		IF CODE=1 THEN
		BEGIN	! CODE LOAD;
			WORDIN;
			ADDRESS:=WORD;
			CHECKR(ADDRESS);
			WHILE LEFTINBLOCK>0 DO
			BEGIN	WORDIN; CORE[ADDRESS]:=WORD;
				IF SET[ADDRESS] THEN MSG("DOUBLE LOAD");
				SET[ADDRESS]:=TRUE;
				ADDRESS:=ADDRESS+1;
			END
		END ELSE
		IF CODE=8 THEN
		BEGIN	!INTERNAL FIXUP REQUSTS;
			WHILE LEFTINBLOCK>0 DO
			BEGIN	WORDIN;
				SPLITWORD(ENDOFCHAIN,VALU);
				CHECKR(ENDOFCHAIN);
				WHILE ENDOFCHAIN # 0 DO
				BEGIN	IF FIXED[ENDOFCHAIN] THEN MSG("FIX LOOP")
					ELSE IF NOT SET[ENDOFCHAIN] THEN MSG("OUT OF BOUNDS FIX")ELSE
					BEGIN
					T1:=CORE[ENDOFCHAIN];
		FIXED[ENDOFCHAIN]:=TRUE;
					ENDOFCHAIN:=INT(BOOL(T1) AND %777777);
					CHECKR(ENDOFCHAIN);
					END
				END
			END;
		END ELSE
		IF CODE=6 OR CODE=2 OR CODE=7 OR CODE=5 OR CODE=4  THEN
		BEGIN
		WHILE LEFTINBLOCK>0 DO WORDIN
		END ELSE MSG("FUNNY BLOCK CODE");
	END;
	NEWLINE;WRITE("PROPER END OF REL FILE");
	IF ASK("DUMP?") THEN MSG("DUMP REQUESTED");
	EXIT:
END;
END;