Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

OPTIONS(/E/C/-W);
EXTERNAL TEXT PROCEDURE upcase,conc,today,daytime;
CLASS zimset;
!;PROTECTED traceon_zimset,traceoff_zimset;
!;HIDDEN PROTECTED trace;
!;VIRTUAL: TEXT PROCEDURE now;
BEGIN

    CLASS linkage;
    PROTECTED i_suc,i_pred;
    VIRTUAL: TEXT PROCEDURE title;
    BEGIN
	REF (linkage) i_suc,i_pred;

	TEXT PROCEDURE title;;

	REF (link) PROCEDURE suc;
	IF i_suc IN link THEN suc:- i_suc;

	REF (link) PROCEDURE pred;
	IF i_pred IN link THEN pred:- i_pred;

	REF (linkage) PROCEDURE prev;
	prev:- i_pred;

    END of linkage;

    linkage CLASS link;
    HIDDEN i_suc,i_pred;
    BEGIN
	REF (Head) PROCEDURE sethead;
	! Test if last;
	INSPECT i_suc WHEN head DO
	sethead:- THIS head 
	OTHERWISE ! Move forward;
	BEGIN   REF (linkage) x;
	    x:- THIS link.i_pred;
	    WHILE x IN link DO x:- x.i_pred;
	    INSPECT x WHEN head DO
	    sethead:- THIS head;
	END of sethead;

	PROCEDURE out;
	IF i_suc =/= NONE THEN
	BEGIN
!;	    TEXT t;
!;	    t:- title;
!;	    IF (IF trace[1] THEN t =/= NOTEXT ELSE FALSE) THEN
!;	    report(' ',t,conc(" Leaving Set  ",sethead.title));
	    i_suc.i_pred:- i_pred;
	    i_pred.i_suc:- i_suc;
	    i_suc:- i_pred:- NONE
	END of out;

	PROCEDURE follow(x);  REF (linkage) x;
	BEGIN   out;
	    IF x =/= NONE THEN
	    BEGIN
		IF x.i_suc =/= NONE THEN
		BEGIN
		    i_pred:- x;
		    i_suc:- x.i_suc;
		    i_suc.i_pred:- x.i_suc:- THIS linkage;
!;		    IF (IF trace[2] THEN title =/= NOTEXT ELSE FALSE) THEN
!;		    report(' ',title,
!;		    IF x IN head THEN
!;		    conc(" Into (First in)  Set  ",x.title) ELSE
!;		    conc(" Follows  ",x.title," of Set  ",
!;		    x QUA link.sethead.title));
		END
		ELSE	!;
!;		report('?',title,conc(" Couldn't Follow  Non-Set member ",x.title));
	    END
	    ELSE report('?',title," Couldn't Follow NONE");	!;
	END of follow;

	PROCEDURE precede(x);   REF (linkage) x;
	BEGIN   out;
	    IF x =/= NONE THEN
	    BEGIN
		IF x.i_suc =/= NONE THEN
		BEGIN
!;		    TEXT t;
		    i_suc:- x;
		    i_pred:- x.i_pred;
		    i_pred.i_suc:- x.i_pred:- THIS linkage;
!;		    t:- title;
!;		    IF (IF trace[3] THEN t =/= NOTEXT ELSE FALSE) THEN
!;		    report(' ',t,
!;		    IF x IN head THEN
!;		    conc(" Into (Last in)   Set  ",x.title) ELSE
!;		    conc(" Precedes ",x.title," of Set  ",
!;		    x QUA link.sethead.title));
		END
		ELSE	!;
!;		report('?',title,conc(" Couldn't Precede Non-Set member ",x.title));
	    END
	    ELSE report('?',title," Couldn't Precede NONE");	!;
	END of precede;

	PROCEDURE into(s);   REF (head) s;
!;	IF s == NONE THEN
!;	BEGIN   out;
!;	    report('?',title," Couldn't move Into NONE")
!;	END ELSE
	precede(s);

    END of link;

    linkage CLASS head;
    HIDDEN i_suc,i_pred;
    BEGIN
	REF (link) PROCEDURE first;   first:- suc;

	REF (link) PROCEDURE last;   last:- pred;

	BOOLEAN PROCEDURE empty;   empty:= i_suc == THIS linkage;

	INTEGER PROCEDURE cardinal;
	BEGIN   INTEGER i;   REF (linkage) x;
	    x:- THIS linkage;
	    FOR x:- x.suc WHILE x =/= NONE DO i:= i + 1;
	    cardinal:= i;
!;	    IF (IF trace[4] THEN title =/= NOTEXT ELSE FALSE) THEN
!;	    BEGIN   TEXT t;   t:- Blanks(5);   t.Putint(i);
!;		report(' ',title,conc(" Cardinal ",t));
!;	    END trace;
	END of cardinal;

	PROCEDURE clear;
	BEGIN   REF (link) x;
	    FOR x:- first WHILE x =/= NONE DO x.out;
!;	    IF (IF trace[4] THEN title =/= NOTEXT ELSE FALSE) THEN
!;	    report(' ',title," Cleared");
	END of clear;

	i_suc:- i_pred:- THIS linkage

    END of head;

!;  PROCEDURE setlist(s);   REF (head) s;
!;  IF tracefile =/= NONE THEN
!;  BEGIN
!;	tracefile.Outimage;
!;	IF s == NONE THEN
!;	report('?',NOTEXT," SETLIST Called for NONE") ELSE
!;	BEGIN   REF (link) x;   INTEGER p;   TEXT t;
!;	    report(':',s.title," Set Member List  ----");
!;	    x:- s.first;
!;	    WHILE x =/= NONE DO
!;	    BEGIN   t:- x.title;
!;		report(':',IF t == NOTEXT THEN Copy("Link Object") ELSE t,NOTEXT);
!;		x:- x.suc
!;	    END loop;
!;	    report(':',Copy("-----------")," End of List      ----");
!;	END s not none;
!;	tracefile.Outimage;
!;  END of setlist;
!;
!;  PROCEDURE traceon(filespec,dotrace);
!;  VALUE filespec,dotrace;   TEXT filespec,dotrace;
!;  BEGIN   CHARACTER c;
!;	INSPECT tracefile DO
!;	BEGIN   Outimage;   Close   END;
!;	IF filespec == NOTEXT THEN tracefile:- Sysout ELSE
!;	IF upcase(filespec) = "SYSOUT" THEN
!;	tracefile:- Sysout ELSE
!;	BEGIN
!;	    tracefile:- NEW Outfile(conc(filespec,"/ACCESS:APPEND"));
!;	    tracefile.Open(Blanks(80));
!;	END not Sysout;
!;	IF dotrace = "*" THEN
!;	BEGIN   dotrace.Setpos(0);   ! Inhibit WHILE loop on dotrace;
!;	    trace[1]:= trace[2]:= trace[3]:= trace[4]:= TRUE
!;	END set all ELSE upcase(dotrace);
!;	WHILE dotrace.More DO
!;	BEGIN   c:= dotrace.Getchar;
!;	    IF c = 'O' THEN trace[1]:= TRUE ELSE
!;	    IF c = 'F' THEN trace[2]:= TRUE ELSE
!;	    IF c = 'I' THEN trace[3]:= TRUE ELSE
!;	    IF c = 'Q' THEN trace[4]:= TRUE;
!;	END loop;
!;
!;	INSPECT tracefile DO
!;	BEGIN   Outimage;
!;	    Outtext("*** Trace generated ");
!;	    Outtext(today);   Outtext(" at ");
!;	    Outtext(daytime);   Outtext(" ***");
!;	    Outtext("  Trace Codes: ");
!;	    Outtext(IF dotrace = "*" THEN Copy("All") ELSE dotrace);
!;	    Outimage;   Outimage
!;	END inspect tracefile;
!;  END trace on;
!;
!;  PROCEDURE traceon_zimset(t1,t2);   TEXT t1,t2;
!;  traceon(t1,t2);
!;
!;  PROCEDURE traceoff;
!;  BEGIN   INTEGER i;
!;	IF tracefile =/= Sysout THEN
!;	INSPECT tracefile DO Close;
!;	tracefile:- NONE;
!;	FOR i:= 1 STEP 1 UNTIL 4 DO
!;	trace[i]:= FALSE;
!;  END of trace off;
!;
!;  PROCEDURE traceoff_zimset;
!;  traceoff;
!;
!;  BOOLEAN ARRAY trace[1:4];
!;
!;  PROCEDURE report(warn,objtitle,t);   NAME t;   TEXT t,objtitle;
!;  CHARACTER warn;
!;  INSPECT tracefile DO
!;  BEGIN   INTEGER p;
!;	Outchar(warn);   Outtext(now);
!;	p:= Pos;   Outtext(objtitle);
!;	Setpos(p+12);
!;	Outtext(t);   Outimage;
!;  END of report;
!;
!;  TEXT PROCEDURE now; ;
!;
!;  REF (Outfile) tracefile;

END of zimset;