Trailing-Edge
-
PDP-10 Archives
-
BB-5255D-BM
-
language-sources/lolstp.bli
There are 18 other files named lolstp.bli in the archive. Click here to see a list.
!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