perm filename BLOCK.SAI[PUB,TES]1 blob
sn#129294 filedate 1974-11-03 generic text, type T, neo UTF8
00100 BEGOF("BLOCK")
00200
00300 COMMENT
00400
00500 Block structure is implemented by various methods. The principle
00600 data structure is ISTK which is an integer stack of declaration
00700 records, each linked to the record below. An associated data
00800 structure is SSTK, which is a string stack whose records are
00900 referenced from corresponding entries in ISTK.
01000
01100 At block BEGIN, the mode-state of PUB is BLockTransferred onto ISTK
01200 in a MODETYPE record. Each declaration in the block causes another
01300 record to be stacked on top. At block END, records are peeled off
01400 top-down, usually with the side effect of resetting global
01500 parameters. Finally, the MODETYPE record is unstacked, and its
01600 contents BLockTransferred back to the mode-state.
01700
01800 ;
01900
02000 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE BLOCK! ;$"#
00200 BEGIN "BLOCK!"
00300 ENDCASE ← STARTS ← 0 ;
00400 BLNMS ← -1 ;
00500 IXEND ← LDB(IXN(<SYMNUM("END")>)) ;
00600 END "BLOCK!" ;
00100 PUBLIC RECURSIVE PROCEDURE BEGINBLOCK(BOOLEAN MIDPGPH; INTEGER ECASE ; STRING NAME) ;$"#
00200 BEGIN "BEGINBLOCK"
00300 INTEGER MIX, I, X ;
00400 IF ECASE = 0 THEN STARTS ← STARTS + 1 comment START...END ;
00500 ELSE IF ECASE=-1 THEN ENDCASE←1 comment, ONCE merging with BEGIN ;
00600 ELSE BEGIN "NOT CLUMP"
00700 I←ENDCASE; ENDCASE←0; DBREAK; ENDCASE←I; RKJ: 7/15/74;
00800 DEPTH ← DEPTH + 1 ; MIX ← PUSHI(MODEWDS, MODETYPE) ;
00900 ARRBLT(ISTK[MIX-MODEWDS], BREAKM, MODEWDS) ;
01000 PUSHI(TABLIMIT+1, TABTYPE) ; I ← 0 ;
01100 DO ISTK[MIX←MIX+1] ← X ← TABSORT[I←I+1] UNTIL X>TWO(32) ;
01200 ISTK[MIX+1] ← ISTK[IHED] ; OLDIHED ← IHED;TES 11/15/73; IHED ← MIX + 1 ;
01300 IF MIDPGPH THEN
01400 BEGIN "SAVE FILL PARAMS"
01500 X ← MIDWDS + 1 ; PUSHI(X, MIDTYPE) ;
01600 ILBF ← CVASC(LBF) ; ARRBLT(ISTK[IHED-X], THISTYPE, X-1) ;
01700 ISTK[IHED-1]←PUSHS(1, THISWD) ; NOPGPH ← TRUE ; PLBL←BRKPLBL←-TWO(13) ;
01800 END "SAVE FILL PARAMS" ;
01900 ENDCASE ← ECASE ; STARTS ← 0 ;
02000 END "NOT CLUMP" ;
02100 IF BLNMS=MAXBLNMS THEN WARN(NULL, "Deep block nest/possibly infinite recursion");
02200 RKJ: 5-10-74 - added CAPITALIZE below ;
02300 IF NAME NEQ ALTMODE THEN BLKNAMES[BLNMS←BLNMS+1] ← CAPITALIZE(NAME) ; comment not for ONCE! ;
02400 END "BEGINBLOCK" ;
00100 PUBLIC SIMPLE PROCEDURE ENDANY(BOOLEAN CHECK) ;$"#
00200 BEGIN "ENDANY"
00300 STRING BLOCKNAME ;
00400 BLOCKNAME ← IF BLNMS<0 THEN "!MISSING!" ELSE BLKNAMES[BLNMS] ;
00500 BLNMS ← (BLNMS MAX 0) - 1 ;
00600 IF CHECK AND THATISCON THEN
00700 BEGIN
00800 PASS ;
00900 LOPP(THISWD) ;
01000 RKJ: 5-10-74 - added CAPITALIZE below ;
01100 IF NOT EQU(CAPITALIZE(THISWD),BLOCKNAME) THEN WARN("Mismatched BEGIN-END",<"BEGIN """&BLOCKNAME&""" but END """&THISWD&"""">) ;
01200 END
01300 ELSE IF FULSTR(BLOCKNAME) THEN WARN("Mismatched BEGIN-END",<"BEGIN """&BLOCKNAME&""" but END <blank>">) ;
01400 END "ENDANY" ;
01500
01600 PUBLIC RECURSIVE PROCEDURE ENDBEGIN ;$"#
01700 BEGIN ENDANY(TRUE) ; IF ENDBLOCK THEN WARN("=","Missed END in Response|Footnote") ELSE PASS END ;
01800
01900 PUBLIC RECURSIVE PROCEDURE ENDONCE ;$"#
02000 IF ENDBLOCK THEN WARN("=","Missing END in Response|Footnote") ELSE ENDBEGIN ;
02100
02200 PUBLIC RECURSIVE PROCEDURE ENDRESP ;$"#
02300 BEGIN ENDANY(TRUE) ; PASS ; IF ENDBLOCK THEN MYEND←TRUE ELSE WARN("=","Extra END") ; END ;
02400
02500 PUBLIC RECURSIVE PROCEDURE ENDSTART ;$"#
02600 BEGIN ENDANY(TRUE) ; STARTS ← STARTS - 1 ; PASS ; END ;
00100 PUBLIC RECURSIVE BOOLEAN PROCEDURE ENDBLOCK ;$"#
00200 IF BLNMS<0 AND LAST>2 THEN BEGIN WARN("=","Extra END ignored"); BLNMS←0; RETURN(FALSE) END ELSE
00300 BEGIN "ENDBLOCK"
00400 INTEGER TYP, OLD, MIX, I, X, L1, L2, PASSED, NARROWED ; STRING S ;
00500 I←ENDCASE; ENDCASE←0; DBREAK; ENDCASE←I; RKJ: 7/11/74;
00600 NARROWED ← PASSED ← FALSE ;
00700 DO COMMENT Skip through ISTK restoring former state and terminating INDENT etc. ;
00800 BEGIN "ISTK ENTRY"
00900 TYP ← IXTYPE(IHED) ;
01000 CASE TYP - 12 OF
01100 BEGIN COMMENT BY TYPE ;
01200 [AREATYPE-12] IF NOT DISD(IHED) THEN BEGIN CLOSEAREA(IHED,TRUE) ; NUMBER[LDB(BIXNUM(IHED))]←0 END;
01300 [COUNTERTYPE-12] IF NOT DISD(IHED) THEN BEGIN CLOSECOUNTER(IHED,TRUE) ; NUMBER[LDB(BIXNUM(IHED))]←0 END;
01400 [MACROTYPE-12] BEGIN SSTK[BODY(IHED)]←NULL;TES 11/15/73; NUMBER[LDB(BIXNUM(IHED))] ← 0 END;
01500 [RESPTYPE-12] BEGIN "POP RESP"
01600 X ← CLUE(IHED) ; I ← VARIETY(IHED) ; OLD ← OLD!RESP(IHED) ;
01700 SSTK[BODY(IHED)] ← NULL ; TES 11/15/73 ;
01800 CASE I-1 MIN 2 OF
01900 BEGIN "BY VARIETY"
02000 COMMENT 0 ... Phrase ;
02100 TES 11/15/73 removed this case ;
02200 COMMENT 1 ... Inset ;
02300 IF FINDINSET(X) THEN
02400 IF NOT OLD THEN LLSKIP(LEADRESPS, <NEXT!RESP>)
02500 ELSE BEGIN
02600 NEXT!RESP(OLD) ← LLPOST ;
02700 IF LLPREV<0 THEN LEADRESPS←OLD ELSE NEXT!RESP(LLPREV) ← OLD ;
02800 END ;
02900 COMMENT 2 ... Signal ;
03000 BEGIN "SIGNAL"
03100 X ← SIGNAL(IHED) ; L1 ← X LSH -29 ;
03200 IF FINDSIGNAL(X) THEN
03300 IF NOT OLD THEN BEGIN
03400 S ← NULL ;
03500 WHILE FULSTR(SIG!BRC) AND (L2←LOP(SIG!BRC)) NEQ L1 DO S←S&L2;
03600 SIG!BRC ← S & SIG!BRC ;
03700 LLSKIP(<SIGNALD[L1]>, <NEXT!RESP>) ; COMMENT JAN 8 1973 ;
03800 END
03900 ELSE BEGIN
04000 NEXT!RESP(OLD) ← LLPOST ;
04100 IF LLPREV<0 THEN SIGNALD[L1]←OLD ELSE NEXT!RESP(LLPREV) ← OLD ;
04200 END ;
04300 END "SIGNAL" ;
04400 COMMENT 3, 4 ... After, Before ;
04500 IF FINDTRAN(X,I) THEN
04600 IF NOT OLD THEN LLSKIP(WAITRESP, <NEXT!RESP>)
04700 ELSE BEGIN
04800 NEXT!RESP(OLD) ← LLPOST ;
04900 IF LLPREV<0 THEN WAITRESP←OLD ELSE NEXT!RESP(LLPREV) ← OLD ;
05000 END ;
05100 END "BY VARIETY" ;
05200 END "POP RESP" ;
05300 [MARGTYPE-12] IF OLD←AREAX(IHED) THEN
05400 BEGIN NARROWED ← TRUE ; MARGINS(OLD) ← X ← OLD!MARGX(IHED) ;
05500 LMARG ← IF X THEN LMARGX(X) ELSE 0 ;
05600 RMARG ← IF X THEN RMARGX(X) ELSE COLWID(OLD) ;
05700 END ;
05800 [TURNTYPE-12] IF (OLD←ISTK[IHED-1]) GEQ 0 THEN TURN(OLD LSH -7 , OLD LAND '177 , 1 ) ;
05900 [MODETYPE-12] BEGIN
06000 I ← GROUPM ; OLD ← AREAIXM ; X ← GLINEM ; TES 11/15/73 REMOVED J ← THISFONT ;
06100 ARRBLT(BREAKM, ISTK[IHED-MODEWDS], MODEWDS) ; OLD SWAP AREAIXM ;
06200 TES 11/14/73 removed IF J NEQ THISFONT THEN SELECTFONT(THISFONT);
06300 IF I THEN IF NOT GROUPM THEN DAPART
06400 ELSE IF GLINEM=0 THEN GLINEM ← X ;
06500 COMMENT ADDED THIS ↑ LINE 2/20/73 ;
06600 IF NOT PASSED AND NARROWED THEN NOPGPH ← 1 ;
06700 JUSTIFY ← FILL AND ADJUST OR JUSTJUST ;
06800 PLACE(IF OLD THEN OLD ELSE IXTEXT);
06900 COMPMAXIMS ;
07000 END ;
07100 [NUMTYPE-12] BEGIN
07200 OLD ← OLD!NUMBER(IHED) ;
07300 NUMBER[X ← LDB(SYMBOLWD(OLD))] ← OLD ;
07400 IF X = SYMPAGE THEN BEGIN IXPAGE ← LDB(IXN(X)) ; PATPAGE ← PATT!STRS(IXPAGE) END
07500 ELSE IF X = SYMTEXT THEN IXTEXT ← LDB(IXN(X)) ;
07600 END ;
07700 [TABTYPE-12] BEGIN
07800 MIX ← IXOLD(IHED) ; I ← 0 ;
07900 DO TABSORT[I←I+1] ← X ← ISTK[MIX←MIX+1] UNTIL X>TWO(32) ;
08000 END ;
08100 [MIDTYPE-12] BEGIN
08200 IF LENGTH(INPUTSTR)>1 THEN WARN("Imbalance","Unbalanced Response|Footnote! "&SOMEINPUT) ;
08300 THISWD←SSTK[ISTK[IHED-1]] ; OLD←PLBL ;
08400 ARRBLT(THISTYPE,ISTK[X←IXOLD(IHED)+1],IHED-X-1) ;
08500 LBF ← CVSTR(ILBF) ;
08600 WHILE FULSTR(LBF) AND LBF[∞ FOR 1]=0 DO LBF←LBF[1 TO ∞-1] ;
08700 IF OLD NEQ -TWO(13) THEN
08800 BEGIN COMMENT UNDEFINED PAGE LABELS -- PASS UP TO OUTER BLOCK ;
08900 X ← OLD ;
09000 DO BEGIN L1←X ; X←IF X<0 THEN NUMBER[-X] ELSE ITBL[X] END UNTIL X=-TWO(13) ;
09100 IF L1<0 THEN NUMBER[-L1] ← PLBL ELSE ITBL[L1] ← PLBL ;
09200 PLBL ← OLD ;
09300 END ;
09400 INPUTSTR←NULL ; IF THATISFULL THEN RDENTITY ELSE INPUTSTR←SWICHBACK ; PASSED←TRUE ;
09500 END ;
09600 [FONTYPE-12] IF (OLD←AREAX(IHED)) AND XCRIBL THEN TES 11/15/73 ;
09700 BEGIN
09800 FONTSIX(OLD) ← OUTERX(IHED) ;
09900 TFONT(OLD) ← THISFONTX(IHED) ;
10000 OFONT(OLD) ← OLDFONTX(IHED) ;
10100 IF OLD = AREAIXM THEN
10200 BEGIN
10300 THISFONT ← TFONT(OLD) ;
10400 OLDFONT ← OFONT(OLD) ;
10500 IDASSIGN(FNTFIL[THISFONT], CW) ;
10600 END ;
10700 END ;
10800 [PITYPE-12] PICHAR[PIKEY(IHED)] ← SSTK[PIVAL(IHED)] TES 11/29/73;
10900 END ; COMMENT BY TYPE ;
11000 IHED ← IXOLD(IHED) ;
11100 END "ISTK ENTRY"
11200 UNTIL TYP=MODETYPE OR IHED=0 ;
11300 DEPTH ← DEPTH - 1 ;
11400 RETURN(PASSED) ;
11500 END "ENDBLOCK" ;
00100 PUBLIC RECURSIVE PROCEDURE TOEND ;$"#
00200 BEGIN "TOEND"
00300 BOOLEAN VALID ;
00400 VALID ← TRUE ;
00500 DO VALID ← CHUNK(VALID) UNTIL MYEND ;
00600 MYEND ← FALSE ;
00700 END "TOEND" ;
00100 FINISHED
00200
00300 ENDOF("BLOCK")