!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!
!COPYRIGHT (C) 1972,1973,1974,1977,1978 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 01754
!FILENAME:	LOLSTP.BLI
!DATE:		13 JUNE 73	MGM/FLD

%3.2%	GLOBAL BIND LOLSV=2;	!MODULE VERSION NUMBER
!			GENERAL DOCUMENTATION FOR LSTPKG.BLI
!	
!		THIS MODULE CONTAINS THE ROUTINES WHICH CREATE, MANIPULATE,
!	AND DELETE THE LIST USED FOR BUILDING CODE.  THESE LISTS ARE DOUBLY-
!	LINKED.  THE HEADER OF A LIST (SUBLIST) LOOKS LIKE:
!	
!	
!............................................................................................................
!  !              !                                            !                                            !
! H!              !                                            !                                            !
! D!              !                                            !                                            !
! R!    CLASSF    !                  P R E V F                 !                  N E X T F                 !
! F!              !                                            !                                            !
!  !              !                                            !                                            !
!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!
!  !              !                                            !                                            !
! H!              !                                            !                                            !
! D!              !                                            !                                            !
! R!    CLASSF    !                  P R E V F                 !                  N E X T F                 !
! F!              !                                            !                                            !
!  !              !                                            !                                            !
!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!
!                30                24                18                12                 6
!	
!	
!	
!		A HEADER ELEMENT (INDEX H) OF A CODE SKELETON IS DEFINED:
!	
!			CT[.H,0]<HDRF>=CT[.H,1]<HDRF>=1
!			CT[.H,0]<CLASSF>= CLASS OF CONTROL EXPRESSION
!			CT[.H,1]<CLASSF>= # OF CELLS IN THIS HEADER 
!					  (NOTE: ATOM=CELL=2 WORDS)
!			CT[.H,0]<PREVF>,CT[.H,0]<NEXTF>: BACKWARD AND FORWARD
!					  (RESPECTIVELY) LINKS TO SAME LEVEL OR
!					  ABOVE
!			CT[.H,1]<PREVF>: LINK TO LAST ELEMENT (SUBHEADER) ON
!					 H'S SUBLIST
!			CT[.H,1]<NEXTF>: LINK TO FIRST ELEMENT ON H'S SUBLIST
!	
!		A SUBHEADER ELEMENT OF A CODE SKELETON IS DEFINED:
!	
!			CT[.H,0]<HDRF>=1
!			CT[.H,1]<HDRF>=0
!			CT[.H,0]<CLASSF>= CLASS OF CONTROL EXPRESSION
!			CT[.H,1]<CLASSF>= SUBCLASS # OF SUBHEADER
!			LINK-FIELDS ARE THE SAME AS THE HEADER CASE.
!	
!		A NON-HEADER ELEMENT OF A LIST IS DISTINGUISHED FROM A HEADER
!	OR SUB-HEADER BY CT[.H,0]<HDRF> BEING ZERO.  A HEADER IS EMPTY (I.E.
!	NO ELEMENTS HANGING FROM IT) WHEN CT[.H,1]<PREVF>=CT[.H,1]<NEXTF>=H.
!	A HEADER IS DETATCHED (NOT AN ELEMENT OF ANY LIST) WHEN CT[.H,0]<PREVF>=
!	CT[.H,0]<NEXTF>=H.
FORWARD ACPDB,ACPDT,ACPR1,ACPR2,ADVDB,ADVDT,ADVR1,ADVR2,ADVR3,AFTER;
FORWARD ALLNOS,BEFORE,CLASSLAB,CLASSP,CODELESS,DROP;
FORWARD ERASEBOT,ERASETOP,FIRST,FOLLCPH,FOLLOW;
FORWARD FRONT,HEADER,LOSECONV,NEWBOT,NONCLASSP,PCIVR;
FORWARD POPBOT,POPTOP,PRECEDE,PREVCODE,PROMOTE,PUSHBOT,PUSHCODE;
FORWARD PUSHCPH,PUSHTOP,SCAN,SCAN0,SKELETON,SWALABEL,SYPHON;
FORWARD TEMPLATE,UNTEMPLATE,UNSKELETON;
	


%3.1%	GLOBAL ROUTINE TEMPLATE(H,C,N)=

  %   FOLLOW CODEPTR WITH SKELETON AND UPDATE CODEPTR.   %

  CODEPTR_FOLLOW(.CODEPTR,SKELETON(.H,.C,.N));



GLOBAL ROUTINE SKELETON(H,C,N)=

  %   OBTAIN A NEW HEADER OF H CELLS AND GIVE IT CLASS C.
    HANG N HEADER CELLS OF 1 CELL EACH FROM THE NEW HEADER WITH
    CLASS C AND SUBCLASSES 1 THROUGH N.   RETURN THE INDEX TO
    THE NEW HEADER.   %

  BEGIN
    LOCAL I;
    I_HEADER(.H,.C,1);
    INCR J FROM 1 TO .N DO PUSHBOT(.I,HEADER(.J,.C,0));
    .I
  END;



GLOBAL ROUTINE HEADER(H,C,N)=

  %   OBTAIN A NEW HEADER.   IF N=1 GET H CELLS OTHERWISE 1.
    GIVE THE HEADER CLASS C AND IF N=0 SUBCLASS H.   %

  BEGIN
    REGISTER I;
    I_GETSPACE(IF .N THEN .H ELSE 1);
    CT[.I,0]<HDRF>_1;
    CT[.I,0]<CLASSF>_.C;
    CT[.I,0]<PREVF>_CT[.I,0]<NEXTF>_.I;
    CT[.I,1]<HDRF>_.N;
    CT[.I,1]<CLASSF>_.H;
    CT[.I,1]<PREVF>_CT[.I,1]<NEXTF>_.I;
    .I
  END;
%3.1%	GLOBAL ROUTINE UNTEMPLATE=
  BEGIN
    CODEPTR_UNSKELETON(.CODEPTR);
    IF .CT[.CODEPTR,0]<CLASSF> NEQ CODEC THEN FOLLCPH(0,CODEC,0);
  END;



%3.1%	GLOBAL ROUTINE UNSKELETON(H)=

  %   H IS A HEADER FORMERLY GENERATED BY SKELETON.   ALL
    SUBHEADERS OTHER THAN LABELS GET FLATTENED.   THIS
    REDUCES ALL SUBHEADERS TO BE LABELC, CODEC, CNVEYC,
    BREAKC OR EXITC.   THESE SUBHEADERS ARE THEN SYPHONED OFF
    AND H IS ERASED.   THE VALUE OF UNSKELETON IS THE INDEX
    OF THE LAST CELL TO BE SYPHONED.   %

  BEGIN
    REGISTER V;
    SCAN(.H,LABELC,NONCLASSP,FLATTEN);
    SYPHON(.H);
    V_.CT[.H,0]<PREVF>;
    ERASE(.H);
    .V
  END;



%3.1%	GLOBAL ROUTINE SYPHON(H)=

  %   SYPHON EXPECTS THE HEADER H TO HAVE HANGING FROM IT
    A SUBLIST OF SUBHEADERS OF CLASS LABELC, CODEC, ETC..
    THESE SUBHEADERS ARE SYPHONED OFF TO THE LEFT OF H AND IN
    THE PROCESS ADJACENT CODEC'S ARE CONCATENATED.   %

  BEGIN REGISTER TOP,CLASS,PREV,PREVCLASS;
  UNTIL NULL(.H) DO
    BEGIN
      TOP_POPTOP(.H);
      CLASS_.CT[.TOP,0]<CLASSF>;
      IF NULL(.TOP) THEN
	IF .CLASS NEQ LABELC THEN
	  EXITCOMP ERASE(.TOP);
      IF ALLNOS(.TOP) THEN EXITCOMP ERASE(.TOP);
      PREV_.CT[.H,0]<PREVF>;
      PREVCLASS_.CT[.PREV,0]<CLASSF>;
      IF .CLASS EQL CODEC THEN
	IF .PREVCLASS EQL CODEC THEN
	  IF NOT FIRST(.H) THEN FRONT(.TOP,TAKE(.PREV));
      PRECEDE(.H,.TOP)
    END;
  END;
ROUTINE FIRST(X)=
  BEGIN
    REGISTER P;
    P_.CT[.X,0]<PREVF>;
    IF .CT[.P,0]<HDRF> THEN
      .CT[.P,1]<NEXTF> EQL .X
    ELSE 0
  END;



%3.1%	GLOBAL ROUTINE LAST(X)=
  BEGIN REGISTER N;
    N_.CT[.X,0]<NEXTF>;
    IF .CT[.N,0]<HDRF> THEN
      .CT[.N,1]<PREVF> EQL .X
    ELSE 0
  END;



ROUTINE FRONT(H,D)=

  %   H,D ARE TWO HEADERS.   THE SUBLIST HANGING FROM D IS
    TAKEN AND CONCATENATED AT THE FRONT OF THE SUBLIST
    HANGING FROM H.   D IS ERASED.   FRONT HAS THE
    VALUE H.   %

  BEGIN
    IF NOT NULL(.D) THEN
      BEGIN
        REGISTER F,L;
	L_.CT[.D,1]<PREVF>;
	F_.CT[.H,1]<NEXTF>;
	CT[.F,.F EQL .H]<PREVF>_.L;
	CT[.L,0]<NEXTF>_.F;
	F_.CT[.D,1]<NEXTF>;
	CT[.F,0]<PREVF>_.H;
	CT[.H,1]<NEXTF>_.F;
	CT[.D,1]<NEXTF>_CT[.D,1]<PREVF>_.D
      END;
    ERASE(.D);
    .H
  END;
%3.1%	GLOBAL ROUTINE SWALABEL=
 %USED IN DWUC AND WUDC WHERE FIRST SUBHEADER IS A LABEL.
  SEARCHES BACK FOR THE FIRST CELL WHICH IS A LABEL OR
  CONTAINS CODE.  IF IT ENCOUNTERS A LABEL THEN THE INITIAL
  CELL OF THE PRESENT SKELETON IS DISCARDED AND BACKWARD
  JUMPS ARE TO THE ENCOUNTERED LABEL.%

  BEGIN REGISTER CLASS,P,SUBCLASS;
    P_.CODEPTR;
    DO P_.CT[.P,0]<PREVF>
      UNTIL
	BEGIN
	  CLASS_.CT[.P,0]<CLASSF>;
	  IF .P EQL .PROGRAM THEN EXITCOMP 1;
	  IF .CLASS GTR LABELC THEN
	    IF NOT .CT[.P,1]<HDRF> THEN
	      IF NOT CODELESS(.P) THEN
		EXITCOMP 1;
	  NOT (NULL(.P) OR ALLNOS(.P))
	END;
    IF .CLASS EQL LABELC THEN
      IF (SUBCLASS_.CT[.P,1]<CLASSF>) NEQ 1 THEN
        BEGIN
          CT[.CODEPTR,3]_CT[.P,0]<0,0>;
          CT[.CODEPTR,3]<LEFTF>_.SUBCLASS;
          CT[.P,1]<CLASSF>_1;
	END;
    ACPDT();
    IF .CLASS EQL LABELC THEN
      BEGIN
        ACPR1();
        ERASE(.CT[.CODEPTR,0]<PREVF>);
      END
    ELSE CLASSLAB()
  END;
ROUTINE CODELESS(H)=
  ! PREDICATE: LIST HANGING FROM H CONTAINS NO INSTRUCTIONS

  BEGIN REGISTER N;
    N_.CT[.H,1]<NEXTF>;
    UNTIL .N EQL .H DO
      BEGIN
      IF .CT[.N,0]<CLASSF> EQL CODEC THEN
	IF NOT NULL(.N) THEN
	  IF NOT ALLNOS(.N) THEN
	        RETURN(0);
      N_.CT[.N,0]<NEXTF>
      END
  END;



%3.1%	GLOBAL ROUTINE CLASSP(H,C)=
  ! PREDICATE: CLASS OF HEADER H IS EQUAL TO C

  .CT[.H,0]<CLASSF> EQL .C;



ROUTINE NONCLASSP(H,C)=
  ! PREDICATE: CLASS OF HEADER H IS NOT EQUAL TO C

  .CT[.H,0]<CLASSF> NEQ .C;



%3.1%	GLOBAL ROUTINE CLASSLAB=

  %   GIVE HEADER POINTED AT BY CODEPTR NEW CLASS LABELC.   %

  BEGIN
    CT[.CODEPTR,0]<CLASSF>_LABELC;
    ACPR1()
  END;
%3.1%	GLOBAL ROUTINE ACPR1=
  ! (ADVANCE-CODEPTR-RIGHT-ONE)

  CODEPTR_.CT[.CODEPTR,0] AND NEXTM;



%3.1%	GLOBAL ROUTINE ACPR2=
  ! (ADVANCE-CODEPTR-RIGHT-TWO)

  CODEPTR_.CT[.CT[.CODEPTR,0] AND NEXTM,0] AND NEXTM;



%3.1%	GLOBAL ROUTINE ACPR3=
  ! (ADVANCE-CODEPTR-RIGHT-THREE)

  CODEPTR_.CT[.CT[.CT[.CODEPTR,0] AND NEXTM,0] AND NEXTM,0] AND NEXTM;


%3.1%	GLOBAL ROUTINE ACPDT=
  ! (ADVANCE-CODEPTR-DOWN-FORWARD)

 CODEPTR_.CT[.CODEPTR,1] AND NEXTM;



%3.1%	GLOBAL ROUTINE ACPDB=
  ! (ADVANCE-CODEPTR-DOWN-BACKWARD)

  CODEPTR_.CT[.CODEPTR,1]<PREVF>;



%3.1%	GLOBAL ROUTINE ADVR1(I)=
  ! MOVE THE POINTER AT ADDR .I ONE CELL TO THE RIGHT
  WORD(.I)_.CT[@.I,0] AND NEXTM;



%3.1%	GLOBAL ROUTINE ADVR2(I)=
  ! MOVE THE POINTER AT ADDR .I TWO CELLS TO THE RIGHT

  WORD(.I)_.CT[.CT[@.I,0] AND NEXTM,0] AND NEXTM;



%3.1%	GLOBAL ROUTINE ADVR3(I)=
  ! MOVE THE POINTER AT ADDR .I THREE CELLS TO THE RIGHT

  WORD(.I)_.CT[.CT[.CT[@.I,0] AND NEXTM,0] AND NEXTM,0] AND NEXTM;
ROUTINE ADVDT(I)=
  ! MOVE THE POINTER AT ADDR .I DOWN AND FORWARD

  WORD(.I)_.CT[@.I,1] AND NEXTM;



ROUTINE ADVDB(I)=
  ! MOVE THE POINTER AT ADDR .I DOWN AND BACKWARD

  WORD(.I)_.CT[@.I,1]<PREVF>;



%3.1%	GLOBAL ROUTINE PUSHCODE=
  ! PUSHES NEW CODEC HEADER ON LIST POINT TO BY CODEPTR AND UPDATES CODEPTR

  PUSHCPH(CODEC);



%3.1%	GLOBAL ROUTINE PUSHCPH(C)=
  ! CREATE NEW HEADER AND PUSH IT ON BOTTOM OF LIST HANGING FROM CODEPTR
  ! AND POINT CODEPTR TO IT

  CODEPTR_PUSHBOT(.CODEPTR,HEADER(0,.C,0));



%3.1%	GLOBAL ROUTINE FOLLCPH(H,C,N)=
  ! CREATE A NEW HEADER ON SAME LEVEL AS CODEPTR AND AFTER IT. UPDATE CODEPTR

  CODEPTR_FOLLOW(.CODEPTR,HEADER(.H,.C,.N));



%3.1%	GLOBAL ROUTINE LOSECONV=
  %   ERASE ALL ELEMENTS OF CLASS CNVEYC FROM THE SUBLIST HANGING
    FROM THE HEADER H.   %
  SCAN(.CODEPTR,CNVEYC,CLASSP,ERASE);
%3.1%	GLOBAL ROUTINE PROMOTE(N)=
    !OPERATES ON ELEMENTS OF SUBLIST HANGING FROM CODEPTR
    !  BIT    ACTION
    !	0	CNVEYC --> CODEC
    !	1	RELC --> CODEC
    !	2	XBLOCKC --> CNVEYC -\
    !	3	XLOOPC --> CNVEYC    \
    !	4	XCMPEXC --> CNVEYC    \  CONDITIONAL ON COUNT IN SUBCLASSF
    !	5	XCONDC --> CNVEYC     / GOING TO ZERO. SEE GXEXIT.
    !	6	XCOSTC --> CNVEYC    /
    !	7	XSELECTC --> CNVEYC-/

  BEGIN REGISTER I,CLASS;
    I_.CT[.CODEPTR,1]<NEXTF>;
    UNTIL .I EQL .CODEPTR DO
      BEGIN
	CLASS_.CT[.I,0]<CLASSF>;
	CT[.I,0]<CLASSF>_
	  IF (1^.CLASS AND .N) NEQ 0 THEN
	    IF .CLASS LEQ RELC THEN CODEC ELSE
	    IF (CT[.I,1]<HDRCLASSF>_.CT[.I,1]<HDRCLASSF>-1) EQL 0 THEN CNVEYC
	    ELSE .CLASS
	  ELSE .CLASS;
	I_.CT[.I,0]<NEXTF>
      END
  END;



%3.1%	GLOBAL ROUTINE DROP(N)=

  %   ERASE CELLS INDICATED BY BITS IN N FROM SUBLIST
    HANGING FROM HEADER POINTED TO BY CODEPTR.   %

  BEGIN
    REGISTER J,I;
    J_.(CT[.CODEPTR,1])<NEXTF>;
    UNTIL (I_.J) EQL .CODEPTR DO
      BEGIN
        J_.CT[.I,0]<NEXTF>;
        IF .N^(-.CT[.I,1]<CLASSF>) THEN ERASE(.I);
      END;
  END;
%3.1%	GLOBAL ROUTINE SCAN(H,Y,P,F)=

  %   SCANS A CIRCULAR LIST WHOSE HEADER IS H AND UPON
    SATISFACTION OF PREDICATE P, THE ROUTINE F IS EXECUTED.
    Y IS A PARAMETER PASSED TO P.   %

  BEGIN
    REGISTER I,J;
    I_.CT[.H,1]<NEXTF>;
    UNTIL .I EQL .H DO
      BEGIN
        J_.CT[.I,0]<NEXTF>;
        IF (.P)(.I,.Y) THEN (.F)(.I);
        I_.J
      END;
  END;



%3.1%	GLOBAL ROUTINE SCAN0(H,F)=

  %   SAME AS SCAN EXCEPT FOR MISSING PARAMETER Y.   %

  BEGIN
    REGISTER I,J;
    I_.CT[.H,1]<NEXTF>;
    UNTIL .I EQL .H DO
      BEGIN
        J_.CT[.I,0]<NEXTF>;
        (.F)(.I);
        I_.J
      END;
  END;



%3.1%	GLOBAL ROUTINE ERASETOP(H)=

  %   H IS A HEADER.   ERASE THE FIRST ITEM ON ITS SUBLIST.   %

  ERASE(.CT[.H,1]<NEXTF>);



%3.1%	GLOBAL ROUTINE ERASEBOT(H)=

  %   H IS A HEADER.   ERASE THE LAST ITEM ON ITS SUBLIST.   %

  ERASE(.CT[.H,1]<PREVF>);
%3.1%	GLOBAL ROUTINE NEWBOT(H,N)=

  %   H IS A HEADER, N IS AN INTEGER.   NEWBOT PUSHES A NEW BLOCK OF
    N CELLS AT THE BOTTOM OF THE SUBLIST HANGING FROM H.   %

  PUSHBOT(.H,GETSPACE(.N));



%3.1%	GLOBAL ROUTINE PUSHTOP(H,D)=

  %   H IS A HEADER;  D IS A DETACHED CELL.   D IS PUSHED AT
    THE TOP OF THE SUBLIST HANGING FROM H.   %

  AFTER(.H,CT[.H,1]<0,0>,.D);



ROUTINE FOLLOW(A,D)=

  %   A IS A CELL, POSSIBLY ATTACHED;  D IS A DETACHED CELL.
    D IS INSERTED FOLLOWING A.   %

  AFTER(.A,CT[.A,0]<0,0>,.D);



ROUTINE AFTER(A,A1,D)=

  %   WORKHORSE FOR PUSHTOP AND FOLLOW.   %

  BEGIN
    REGISTER N;
    N_.(.A1)<NEXTF>;
    (IF .N EQL .A THEN .A1
     ELSE CT[.N,0]<0,0> + (.CT[.N,0]<PREVF> NEQ .A))<PREVF>_.D;
    (.A1)<NEXTF>_.D;
    CT[.D,0]<PREVF>_.A;
    CT[.D,0]<NEXTF>_.N;
    .D
  END;



GLOBAL ROUTINE PUSHBOT(H,D)=

  %   H IS A HEADER;  D IS A DETACHED CELL.   D IS PUSHED AT
    THE BOTTOM OF THE SUBLIST HANGING FROM H.   %

  BEFORE(.H,CT[.H,1]<0,0>,.D);
%3.1%	GLOBAL ROUTINE PRECEDE(A,D)=

  %   A IS A CELL, POSSIBLY ATTACHED;  D IS A DETACHED CELL.
    D IS INSERTED PRECEDING A.   %

  BEFORE(.A,CT[.A,0]<0,0>,.D);



ROUTINE BEFORE(A,A1,D)=

  %   WORKHORSE FOR PUSHBOT AND PRECEDE.   %

  BEGIN
    REGISTER P;
    P_.(.A1)<PREVF>;
    (IF .P EQL .A THEN .A1
     ELSE CT[.P,0]<0,0> + (.CT[.P,0]<NEXTF> NEQ .A))<NEXTF>_.D;
    (.A1)<PREVF>_.D;
    CT[.D,0]<PREVF>_.P;
    CT[.D,0]<NEXTF>_.A;
    .D
  END;



ROUTINE POPTOP(H)=

  %   H IS A HEADER.   POP UP THE FIRST ITEM ON ITS SUBLIST.   %

  TAKE(.CT[.H,1]<NEXTF>);



ROUTINE POPBOT(H)=

  %   H IS A HEADER.   POP UP THE LAST ITEM ON ITS SUBLIST.   %

  TAKE(.CT[.H,1]<PREVF>);
%3.1%	GLOBAL ROUTINE ALLNOS(T)=
  ! PREDICATE: ALL THE ELEMENTS HANGING FROM HEADER T ARE LINE NOS

  BEGIN REGISTER H;
    H_.CT[.T,1]<NEXTF>;
    IF .H EQL .T THEN RETURN(0);
    UNTIL .H EQL .T DO
      IF .CT[.H,1]<FUNCF> NEQ 0 THEN EXITLOOP 0
      ELSE H_.CT[.H,0]<NEXTF>
  END;



%3.1%	GLOBAL ROUTINE PREVCODE(C,P)=
  ! SEARCH LIST HEADED BY CT[.P,0] BACKWARDS STARTING FROM ELEMENT
  ! CT[.C,0] FOR THE FIRST INSTRUCTION AND RETURNS ITS INDEX.

  BEGIN
  UNTIL .C EQL .P DO
    IF .CT[.C,1]<FUNCF> NEQ 0 THEN RETURN(.C)
    ELSE C_.CT[.C,0]<PREVF>;
  .C
  END;



%3.1%	GLOBAL ROUTINE PCIVR(X,Y)=
  ! (PROMOTE-CONVEY-IF-VALUE-REGISTER)
  ! INSURES THAT IF A CONTROL EXPRESSION'S VALUE IS NEEDED (E.G. ARITHMETIC
  ! OPERAND) THE CONVEYC CELLS OF THAT EXPRESSION GET PROMOTED
  ! TO CODE

  BEGIN REGISTER C;
    IF .RT[.X<RTEF>]<ARTEF> EQL .VREG OR
      .RT[.Y<RTEF>]<ARTEF> EQL .VREG THEN
      IF .CODEPTR NEQ .FREEVHEADER THEN
      BEGIN
	C_.CODEPTR;
	CODEPTR_.CT[.C,0]<NEXTF>;
        PROMOTE(1^CNVEYC OR 1^RELC);
	CODEPTR_.C
      END;
  END;
%3.1%	GLOBAL ROUTINE LOCATE(C,S)=
  %   SCAN THE CODE TABLE RIGHTWARDS (AND HENCE UPWARDS) FROM
    CODEPTR UNTIL CLASS C IS FOUND.   THEN SCAN LEFT OR RIGHT
    AS APPROPRIATE FOR SUBCLASS S.   %
  BEGIN
    REGISTER P,CLASS,W,N; LOCAL COPYOFP;
    P_.CODEPTR;
    UNTIL .CT[.P,0]<CLASSF> EQL .C
      DO P_.CT[.P,0]<NEXTF>;
    IF .S EQL 0 THEN (COPYOFP_.P; SURFACE(COPYOFP<0,0>); RETURN .COPYOFP);
    N_.S-.CT[.P,1]<CLASSF>;
    IF .N EQL 0 THEN RETURN(.P);
    W_
      IF .N GTR 0 THEN CT[.P,0]<NEXTF>
      ELSE CT[.P,0]<PREVF>;
      DO W<RIGHTF>_CT[P_..W,0]<0,0>
	UNTIL
	  BEGIN
	    CLASS_.(.W+1)<CLASSF>;
	    IF .CLASS EQL .S THEN
	      IF .SFORLABEL THEN
		.(.W)<CLASSF> EQL LABELC
	      ELSE 1
	    ELSE 0
	  END;
    .P
  END;






%3.1%	GLOBAL ROUTINE SURFACE(I)=
%   I REFERS TO A CODE TABLE INDEX POINTING IN TO A LIST OF
  HEADERS.   THE INDEX IS MOVED TO THE RIGHT UNTIL THE MASTER
  HEADER IS REACHED.   %
  BEGIN
    UNTIL .CT[@.I,1]<HDRF> DO WORD(.I)_.CT[@.I,0]<NEXTF>;
    0
  END;
FORWARD
    DELCELL,
    DETCELL,
    EMPTY,
    EMPTYDET,
    ERASE,
    ERASEDET,
    FLATTEN,
    LNKARND,
    TAKE;







GLOBAL ROUTINE DELCELL(IND)=
  ! DELETE (RELEASE) CELL IWTH INDEX IND

  BEGIN
    LOCAL VAL;
    VAL _ .CTPREV[.IND];
    RELEASESPACE
     (
        .IND
     ,
        IF
            NOT HEADERP(.IND) OR CURRENTP(.IND) OR NOT HEADER1P(.IND)
         THEN
            1
         ELSE
            .CTCLASS1[.IND]
      );
    .VAL
   END;




GLOBAL ROUTINE DETCELL(IND)=
  ! DETACHES CELL IND FROM LIST

  BEGIN
    IF
        .CTPREV[.IND] NEQ .IND
     THEN
        LNKARND(.IND,0);
    .IND
  END;
GLOBAL ROUTINE EMPTY(H)=
  ! EMPTIES (ERASE) LIST HANGING FROM H BUT LEAVES H

  BEGIN
    EMPTYDET(.H);
    CTPREV1[.H] _ CTNEXT1[.H] _ .H
   END;




GLOBAL ROUTINE EMPTYDET(H)=
  ! WORKHORSE FOR EMPTY

  BEGIN
    LOCAL CURS;
    CURS _ .CTPREV1[.H];
    WHILE
        .CURS NEQ .H
     DO
        CURS _ (IF HEADERP(.CURS) THEN ERASEDET ELSE DELCELL)(.CURS);
    .H
   END;





GLOBAL ROUTINE ERASE(IND) =
  ! ERASE CELL INDEX IND

    ERASEDET(DETCELL(.IND));






GLOBAL ROUTINE ERASEDET(IND)=
  ! WORKHORSE FOR ERASE

  BEGIN
    IF
        HEADERP(.IND)
     THEN
        EMPTYDET(.IND);
    DELCELL(.IND)
   END;
GLOBAL ROUTINE FLATTEN(H)=
  ! REMOVE NON-LABEL SUBHEADER AND LINK ITS SUBLIST ONTO LIST TO
  ! THE LEFT OF IT

  BEGIN
    IF
        .CTNEXT1[.H] NEQ .H
     THEN
      BEGIN
        LNKARND(.H,1);
        CTPREV[.CTNEXT1[.H]] _ .CTPREV[.H];
        CTNEXT[.CTPREV1[.H]] _ .CTNEXT[.H]
       END
     ELSE
        DETCELL(.H);
    DELCELL(.H)
   END;




GLOBAL ROUTINE LNKARND(IND,WD)=
  ! RELINKS LIST "AROUND" ABOUT-TO-BE-DETACHED CELL

  BEGIN
    NEXTOFPREV(.IND) _ .CT[.IND,.WD]<NEXTF>;
    PREVOFNEXT(.IND) _ .CT[.IND,.WD]<PREVF>;
    .IND
   END;





GLOBAL ROUTINE TAKE(IND)=
  ! DETATCHS CELL IND FROM LIST

  BEGIN
    DETCELL(.IND);
    CTPREV[.IND] _ CTNEXT[.IND] _ .IND
  END;     !TAKE



!END OF LOLSTP.BLI