Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/maint/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;