perm filename GLOBE.SAI[PUB,TES]1 blob
sn#129317 filedate 1974-11-07 generic text, type T, neo UTF8
00200 REQUIRE "[]<>" DELIMITERS ;
00250 REQUIRE "SITE" SOURCE!FILE;
00300 REQUIRE "COMMON" SOURCE!FILE ;
00400 DEFINE
00500 PASSONE = [TRUE], PASSTWO = [FALSE],
00600
00700 INITSIZES = [ISIZE←1000; SSIZE←200; ITSIZE←200; STSIZE←300; SIZE←100],
00800 REGULAR!SIZE = [1021], COMMENT Must be a prime ;
00900 BIG!SIZE = [2999],
01000 HUGE!SIZE = [8191], COMMENT can't exceed 2↑13-1 ;
01100
01200 COMMENT All the output lines tentatively placed in the current frame are
01300 stored in .PUI files and referenced by sequential number from
01400 the integer array OWLS (OWtput LineS). Its length is sufficient
01500 to hold every line of every column of every area in it. The
01600 general form of a string referenced from OWLS is:
01700 {<chars><cr>}...<lf> . One of the <chars> (the last) may be a
01800 line that needs to be justified in Pass Two. Each word break in
01900 such a substring is represented by a '13 (vert-tab) -- these
02000 mark the places that extra spaces may be added. Pass Two also
02100 needs to know about FONT changes -- in the present version, this
02200 is limited to underlining, superscripts, and subscripts. A FONT
02300 change is signalled by the character pair '177 <code>. Finally,
02400 Pass Two will fill in forward references marked ALTMODE.
02500
02600 Other information must be known about each string in OWLS. There
02700 must be an indication of how many spaces to add to a
02800 justify-line during Pass Two, and there must be mobility
02900 restrictions to assure that groups stay together and that
03000 section titles stay at tops of pages. This information is kept
03100 in an integer array MOLES (MObility of LinES) of the same size
03200 as OWLS. MOLES[J] is the descriptor for OWLS[J]. To access
03300 these entries, the value J is stored in an "area array"
03400 associated with the area the line was placed in, at element
03500 [C,L] for the C'th column and L'th line.
03600
03700 A Moles descriptor looks like this:
03800
03900 --------------------------------------------------
04000 | | |L|H|L|R|A|B| | |
04100 | | |O|O|E|I|B|E| | |
04200 | | FOOT |C|R|F|G|O|L| LABEL | LEAD |
04300 | | |K|I|T|H|V|O| | |
04400 | | | |Z| |T|E|W| | |
04500 --------------------------------------------------
04600 0.....6 7.....11-2-3-4-5-6-7-18..........31 32..35 ;
00100 COMMENT To avoid calling POINT to generate byte pointers, we use
00200 Swinehart's BBPP and our own BP. BBPP(N,GLOBAL,N) is like POINT
00300 but usually it will compile constants instead of procedure
00400 calls. BP is a macro which creates a byte pointer as the sum of
00500 a constant and two variables or expressions. Instead of
00600 POINT(6,ARR[J+4],35), say: BP(6,ARRIDA,J,+4,35). The first,
00700 fourth, and fifth arguments will be ROTed and LORed into a
00800 constant at compile time, and the second and third will be added
00900 to it at execution time. Be sure that ARRIDA points to ARR[0]
01000 at all times, and that the fourth argument either is absent or
01100 is a signed integer. ;
01200
01300 BP(S,A0,J,SIGNED!CONSTANT,P) = [(((35-(P)) ROT 6 LOR S) ROT 24 SIGNED!CONSTANT) +
01400 (A0) + (J)],
01500
01600 H1(WD) = [POINT(18,WD,17)], COMMENT, POINT can make constant byte pointers;
01700 H2(WD) = [POINT(18,WD,35)],
01800 Q1(WD) = [POINT(9,WD,8)],
01900 Q2(WD) = [POINT(9,WD,17)],
02000 Q3(WD) = [POINT(9,WD,26)],
02100 Q4(WD) = [POINT(9,WD,35)],
02200
02300 COMMENT Fields of MOLES ;
02400
02700 FOOTM(J) = [BP(5, MOLESIDA,<J>,, 11)], COMMENT,
02800 If this line has footnotes, then this field is nonzero and
02900 matches the value in the corresponding field of the last
03000 line of its last footnote (a value of 31 means that footnote
03100 ends in a subsequent column);
03200 LOCKM(J) = [BP(1,MOLESIDA,<J>,,12)], COMMENT, This line can not be moved;
03300 HORIZM(J) = [BP(1,MOLESIDA,<J>,,13)], COMMENT, Only move to same line no. in another column;
03400 LEFTM(J) = [BP(1,MOLESIDA,<J>,,14)], COMMENT, If moved, also move line on my left;
03500 RIGHTM(J) = [BP(1,MOLESIDA,<J>,,15)], COMMENT, ... also line on my right;
03600 ABOVEM(J) = [BP(1,MOLESIDA,<J>,,16)], COMMENT, ... also line above me;
03700 BELOWM(J) = [BP(1,MOLESIDA,<J>,,17)], COMMENT, ... also line below me;
03800 ABV = ['2000000], BLW= ['1000000], ABV!BLW= ['3000000],
03900 LABELM(J) = [BP(14,MOLESIDA,<J>,,31)], COMMENT,
04000 Position in ITBL of head of L.L. of page labels of this line;
04100 LEADM(J) = [BP(4,MOLESIDA,<J>,,35)], COMMENT, Number of lead lines to assure if
04200 moved -- this is necessary because blank lines that happen
04300 to show up at the top of a column are deleted, but if the
04400 paragraph they lead is moved down, they must be restored;
04500
04600 COMMENT The last subscript used in MOLES and OWLS is stored in MOLES[0];
00100 COMMENT The symbol table method is hashed strings using quadratic
00200 search. Swinehart's "SYMSER.SAI[1,DCS]" has been used. That
00300 package declares two arrays [-1:SYMNO], where SYMNO+1 is prime.
00400 One array, SYM, holds the strings, and the other, NUMBER, holds
00500 their descriptors. The procedure SETSYM initializes the
00600 package. FLAG←LOOKSYM(STRING A) tells whether the string is in
00700 the table and sets SYMBOL to its index (or the index of where to
00800 enter it if not there). ENTERSYM(STRING A, INTEGER NUM) enters
00900 it in the table at SYMBOL and makes its descriptor be NUM (and
01000 sets ERRFLAG to TRUE and prints a message if the table is full).
01100
01200 The compiler requires that all symbols be unique at any block
01300 level, however, labels are totally global and although each
01400 label must have a different name from every other label, it may
01500 have the same name as another whatsit. Therefore, before a
01600 label is looked up or entered in the symbol table, a colon is
01700 appended to its name to guarantee its distinction. Furthermore,
01800 all lower case letters of every identifier are changed to upper
01900 case for symbol table purposes.
02000
02100 The fields of a descriptor D = NUMBER[SYMBOL] are:
02200 --------------------------------------------
02300 | DEPTH | SYMBOL | TYPE | IX |
02400 --------------------------------------------
02500 0.....4 5...........17 18..21 22..........35 ;
02600
02700 DEPTHWD(DESC) = [POINT(5,DESC,4)], COMMENT, the block depth;
02800 DEPTHN(S) = [BP(5,NUMBIDA,<S>,+1,4)],
02900 SYMBOLWD(DESC) = [POINT(13,DESC,17)],
03000 SYMBOLN(S) = [BP(13,NUMBIDA,<S>,+1,17)], COMMENT, This field always equals
03100 s, its subscript in NUMBER. When a local declaration in an
03200 inner block forces an outer definition to be stacked, this
03300 field of the descriptor tells where to restore it;
03400 TYPEWD(DESC) = [POINT(4,DESC,21)],
03500 TYPEN(S) = [BP(4,NUMBIDA,<S>,+1,21)], COMMENT, The symbol type (listed below);
03600 IXWD(DESC) = [POINT(14,DESC,35)], COMMENT, depending on TYPE, this may be a
03700 case index or a 14-bit pointer to the definition in some array;
03800 IXN(S) = [BP(14,NUMBIDA,<S>,+1,35)],
03900
04000 COMMENT The descriptor of a label, however, is:
04100 ---------------------------------------
04200 | PLIGHT | zeroes or ones | IX |
04300 ---------------------------------------
04400 0..1 2 ......... 21 22 ..... 35 ;
04500
04600 PLIGHTWD(DESC) = [POINT(2, DESC, 1)], COMMENT,
04700 1: Referenced but not yet defined. IX is the NUMBER posn of the mentioned COUNTER (or 0).
04800 2: Defined as the string in STBL[IX].
04900 0|3: Defined as a page label, but the exact page is still uncertain--
05000 DESC is a link to another label in the same plight:
05100 >0--ITBL[DESC], <0--NUMBER[-DESC], =-(2↑13)--end L.L. ;
00100 COMMENT Symbol Type → IX array conversion ;
00200
00300 COMMENT Type IX points to
00400 ---- ------------ ;
00500 GLOBALTYPE= [1], COMMENT, Global Variable STBL ;
00600 LOCALTYPE= [2], COMMENT, Local Variable SSTK ;
00700 INTERNTYPE= [3], COMMENT, Internal Variable none (this is a case index);
00800 CMDTYPE= [6], COMMENT, ALGOL Command Word none (this is a case index);
00900 PORTYPE= [10], COMMENT, Portion ITBL ;
01000 PCOUNTERTYPE= [11], COMMENT, Print Value of COUNTER ISTK (same IX as Counter Value) ;
01100 AREATYPE= [12], COMMENT, Area ISTK ;
01200 COUNTERTYPE= [13], COMMENT, COUNTER ISTK ;
01300 MACROTYPE= [14], COMMENT, Macro ISTK ;
01400
01500 COMMENT Now the STKs, TBLs, and NESTs will be introduced.
01600
01700 ISTK....
01800
01900 In ISTK are stored:
02000 (a) Modes and Variable Values to be restored upon block exit.
02100 (b) AREA, COUNTER, MACRO, and Response Declarations local to this block.
02200 (c) Former margin positions in a NARROW/WIDEN nest.
02300 To push an m-word entry of type T onto ISTK, increment IHED by (m+1),
02400 check for stack overflow, and put the following descriptor
02500 at ISTK(IHED):
02600
02700 ---------------------------------------
02800 | T | SYM subscript | old value of IHED |
02900 ---------------------------------------
03000 0..8 9............21 22...............35
03100
03200 Now store the entries at IHED-1 to IHED-m. The header word at IHED is the
03300 one that IX points to. Note that it is in a linked list which is scanned at
03400 block exit to restore former conditions.
03500
03600 The types T are as follows: ;
03700 COMMENT AREATYPE = [12], COMMENT, Local Area Declaration;
03800 COMMENT COUNTERTYPE = [13], COMMENT, Local COUNTER Declaration;
03900 COMMENT MACROTYPE = [14], COMMENT, Local Macro Declaration;
04000 RESPTYPE = [15], COMMENT, Local Response Declaration;
04100 MARGTYPE = [16], COMMENT, Former margin positions in a NARROW//WIDEN Nest;
04200 TURNTYPE = [17], COMMENT, Former <chars><function> pair;
04300 MODETYPE = [18], COMMENT, Mode Words before block entry;
04400 NUMTYPE = [19], COMMENT, Former NUMBER descriptor;
04500 TABTYPE = [20], COMMENT, tab stops ;
04600 MIDTYPE = [21], COMMENT, saved paragraph params for BEFORE|AFTER|footnotes in mid-pgph ;
04700 FONTYPE = [22], COMMENT, Former font settings TES 11/15/73;
04800 PITYPE = [23], COMMENT, Former PiCHAR definitions TES 11/29/73 ;
04900
05000 IXTYPE(ANYIX) = [(ISTK[ANYIX] ROT 9 LAND '777)],
05100 BIXNUM(NAMED) = [BP(13, ISTKIDA, <NAMED>, , 21)],
05200 IXOLD(ANYIX) = [(ISTK[ANYIX] LAND '37777)],
00100 COMMENT Fields of Entries in ISTK ;
00200
00300 PIWDS = [2],
00400 PIKEY(PI) = [ISTK[(PI)-1]], COMMENT the char after pi;
00500 PIVAL(PI) = [ISTK[(PI)-2]], COMMENT the string in SSTK that it emits;
00600
00700 MARGWDS = [4],
00800 LMARGX(MARG) = [ISTK[(MARG)-1]],
00900 RMARGX(MARG) = [ISTK[(MARG)-2]],
01000 OLD!MARGX(MARG) = [ISTK[(MARG)-3]],
01100 AREAX(MARG) = [ISTK[(MARG)-4]], COMMENT, ISTK IX of AREA with these margins ;
01200
01300 FONTWDS = [4], COMMENT TES 11/15/73 ;
01400 THISFONTX(FONT) = [ISTK[(FONT)-1]], COMMENT OF OUTER BLOCK ;
01500 OLDFONTX(FONT) = [ISTK[(FONT)-2]],
01600 OUTERX(FONT) = [ISTK[(FONT)-3]],
01700 COMMENT TES same as for MARG: AREAX(FONT) = [ISTK[(FONT)-4]];
01800
01900 TURNWDS = [1], COMMENT, CHR, FUN 7 bits each, to TURN back ON previous meaning;
02000
02100 NUMWDS = [1],
02200 OLD!NUMBER(SYM) = [ISTK[(SYM)-1]],
02300
02400 AREAWDS = [19],
02500 DISD(AREA!COUNTER) = [ISTK[(AREA!COUNTER)-1]], COMMENT, TRUE if disdeclared ;
02600 FULHIGH(AREA) = [ISTK[(AREA)-2]], COMMENT, 1 iff no LINES clause ;
02700 LINE1(AREA) = [ISTK[(AREA)-3]], COMMENT, Top line number used;
02800 LINECT(AREA) = [ISTK[(AREA)-4]], COMMENT, Number of lines used;
02900 FULWIDE(AREA) = [ISTK[(AREA)-5]], COMMENT, 1 iff no CHARS clause ;
03000 CHAR1(AREA) = [ISTK[(AREA)-6]], COMMENT, Leftmost character position;
03100 CHARCT(AREA) = [ISTK[(AREA)-7]], COMMENT, Width of whole area;
03200 TEXTAR(AREA) = [ISTK[(AREA)-8]], COMMENT, 1=TEXT AREA, 0=TITLE AREA;
03300 COLCT(AREA) = [ISTK[(AREA)-9]], COMMENT, Number of columns;
03400 COLWID(AREA) = [ISTK[(AREA)-10]], COMMENT, Width of each column;
03500 OLD!ACTIVE(AREA) = [ISTK[(AREA)-11]], COMMENT, If Open, array descriptor of active area in OLDPAGE;
03600 NEW!ACTIVE(AREA) = [ISTK[(AREA)-12]], COMMENT, If Open, array descriptor of active area in NEWPAGE;
03700 OPEN!ACTIVE(AREA) = [ISTK[(AREA)-
03800 (IF FRAMEIDA = NEWPGIDA NEQ 0 THEN 12 ELSE 11)]],
03900 COMMENT "NEQ 0" ABOVE ADDED APRIL 22, 1973 BY TES ;
04000 FOOTSTR(AREA) = [ISTK[(AREA)-13]], COMMENT, SSTK subscript of SEND FOOT string ;
04100 MARGINS(AREA) = [ISTK[(AREA)-14]], COMMENT, ISTK IX of MARGTYPE entry ;
04200 FONTSIX(AREA) = [ISTK[(AREA)-15]], COMMENT TES 11/15/73 ISTK IX of FONTTYPE entry ;
04300 TFONT(AREA) = [ISTK[(AREA)-16]], COMMENT TES 11/15/73 THISFONT;
04400 OFONT(AREA) = [ISTK[(AREA)-17]], COMMENT TES 11/15/73 OLDFONT ;
04440 MILLSKIP(AREA) = [ISTK[(AREA)-18]], COMMENT TES 11/7/74 SKIP N MILLS ;
04480 MILLGSKIP(AREA) = [ISTK[(AREA)-19]], COMMENT TES 11/7/74 GROUP SKIP N MILLS ;
04500
04600 COUNTERWDS = [12],
04700 COMMENT DISD(AREA!COUNTER) = [ISTK[(AREA!COUNTER)-1]], COMMENT, see area def above;
04800 CTR!INIT(COUNTER) = [ISTK[(COUNTER)-2]], COMMENT, FROM initial value + 2↑14 ;
04900 CTR!STEP(COUNTER) = [ISTK[(COUNTER)-3]], COMMENT, BY step-value + 2↑6 ;
05000 PATT!CHRS(COUNTER) = [ISTK[(COUNTER)-4]], COMMENT, estimate based on chars in patterned TO value;
05100 CTR!CHRS(COUNTER) = [ISTK[(COUNTER)-5]], COMMENT, estimate based on unpatterned TO value;
05200 PARENT(COUNTER) = [ISTK[(COUNTER)-6]], COMMENT, IX of parent COUNTER;
05300 PATT!PARENT(COUNTER) = [ISTK[(COUNTER)-7]], COMMENT, whether ! occurs in pattern;
05400 PATT!ALF(COUNTER) = [ISTK[(COUNTER)-8]], COMMENT, alphabet to convert CTR!VAL to:
05500 PATT!ALF... 0 1 2 3 4 5
05600 alphabet... template 1 i I a A ;
05700
05800 PATT!STRS(COUNTER) = [ISTK[(COUNTER)-9]], COMMENT, pointer to strings in SSTK;
05900 SON(COUNTER) = [ISTK[(COUNTER)-10]], COMMENT, IX of youngest son COUNTER ;
06000 BROTHER(COUNTER) = [ISTK[(COUNTER)-11]], COMMENT, IX of brother COUNTER ;
06100 IN!LINE(COUNTER) = [ISTK[(COUNTER)-12]], COMMENT, TRUE if INLINE option present ;
00100 MACROWDS = [4], RESPWDS = [7], SIGWDS = [9],
00200 BODY(DEF) = [ISTK[(DEF)-1]], COMMENT, points to body string in SSTK;
00300 NAMEPAR(MACRO) = [ISTK[(MACRO)-3]], COMMENT, LAND 2↑(ARGS-n) says n'th arg is by name;
00400 NUMARGS(DEF) = [ISTK[(DEF)-2]], COMMENT, no. of formal parameters;
00500 ODDMAC(MACRO) = [ISTK[(MACRO)-4]], COMMENT, 1 for ODD MACRO, 0 for [EVEN] MACRO;
00600 OLD!RESP(RESP) = [ISTK[(RESP)-3]], COMMENT, former response+200 or (<200) breaktable value;
00700 DEPTH!RESP(RESP) = [ISTK[(RESP)-4]], COMMENT, block level (unimplemented) ;
00800 NEXT!RESP(RESP) = [ISTK[(RESP)-5]], COMMENT, another resp. with similar recognizer;
00900 CLUE(RESP) = [ISTK[(RESP)-6]], COMMENT, encoding of the recognizer;
01000 VARIETY(RESP) = [ISTK[(RESP)-7]], COMMENT, see Table below ;
01100 SIGNAL(RESP) = [ISTK[(RESP)-8]], COMMENT, ASCII of Signal;
01200 RESP!SEP(RESP) = [ISTK[(RESP)-9]], COMMENT, ASCII of seps (up to 5), right byte=last sep;
01300
01400 COMMENT NEXT!RESP and CLUE for each VARIETY of response declaration:
01500
01600 Declaration VARIETY CLUE NEXT!RESP with
01700 ----------- ------- ---------------------- --------------
01800 AT <e> 0 Pointer to <e> in SSTK Same 1st letter & 2d letter|non-letter-ness
01900 AT <n> 1 n Next larger n
02000 AT <signal> 2 Number of characters Same first char
02100 AFTER <area|counter> 3 Symb. no. of area|counter (WAITRESP link only)
02200 BEFORE ... 4 " "
02300
02400 ITBL....
02500
02600 Has (1) Labels generated by {PAGE}. The entry looks like a
02700 NUMBER entry for a label, except PLIGHT is never 1.
02800 (2) Portion declarations--NOTE: no word may have left half = '400000;
02900 PORCH(PORT) = [ITBL[PORT]], COMMENT, 0-15: channel SENDing to,
03000 -1: FOOT, -2: declared but never SENT to, -3: sent to & declared but not RECEIVEd,
03100 -4: already RECEIVEd, -5: only mentioned in INSERT, -6: RECEIVEd AND Alphabetized ;
03200 PORSEQ(PORT) = [ITBL[(PORT)-1]], COMMENT, pointer to next PORTION in collating sequence ;
03300 PORSTR(PORT) = [ITBL[(PORT)-2]], COMMENT, pointer to STBL ;
03400 COMMENT
03500 SSTK....
03600 Has (1) Values of Local Variables
03700 (2) Macro, Response, and Prepare Bodies
03800 (3) counter PATT!STRS; PATT!VAL(PS) = [SSTK[PS]], COMMENT, current printing value;
03900 CTR!VAL(PS) = [SSTK[(PS)-1]], COMMENT, current counter value ;
04000 PREFIX(PS) = [SSTK[(PS)-2]], COMMENT, before ! OR template;
04100 INFIX(PS) = [SSTK[(PS)-3]], COMMENT, between ! and alphabet;
04200 SUFFIX(PS) = [SSTK[(PS)-4]], COMMENT, after alphabet .
04300 (4) SEND FOOT Strings for each declared AREA.
04400 (5) PICHAR Old values. (see PIVAL)
04500
04600 STBL....
04700 Has (1) Values of Global Variables
04800 (2) Values of Labels (set to '0&<last counter specified--SYMBOL no.>
04900 if undefined, so ALGOL can check consistency of use)
05000 (3) Current file-block for every generated file getting sent to;
05100 PORFIL(SPORT) = [STBL[(SPORT)]], COMMENT, generated file name ;
05200 PORINT(SPORT) = [STBL[(SPORT)+1]], COMMENT, intermed. file name ;
00100 COMMENT
00200
00300 SNEST...
00400 Has (1) Input strings to scan. They nest due to macro calls,
00500 responses, argument substitutions, RECEIVEs, and
00600 REQUIREs. This nesting is not synchronized with that
00700 of blocks, because a macro or argument body or a source
00800 file may have unmatched BEGINs, etc., so a separate
00900 stack is required.
01000 (2) Saved line number for previous source:
01100 The first six characters are the file name ;
01200 STRSCAN(S) = [SNEST[(S)-1]], COMMENT, a string to scan (STRSCAN(LAST)
01300 is the current one);
01400 LINESCAN(S) = [SNEST[S]], COMMENT, MACLINE or SRCLINE ;
01500
01600 COMMENT
01700
01800 INEST...
01900 Has (1) Input channels to scan. When reading from a file,
02000 just its channel number is kept instead of the whole
02100 string of course. However, a whole line at a time is
02200 stripped and scanned as if it were an input string.
02300 (2) Saved SOS page number for previous input file;
02400 CHANSCAN(S) = [INEST[(S)-1]], COMMENT, the channel number of a file to
02500 scan (CHANSCAN(LAST) is the current one or -1 if none)
02600 TECO files: channel no. stored here excess 100 ;
02700 PAGESCAN(S) = [INEST[S]], COMMENT, LH=PAGEMARKS RH=PAGEWAS Negated by RECEIVE if GEN-file;
02800
02900 COMMENT These are our DEVICE numbers;
03000 LPT = [1],
03100 TTY = [2],
03200 MIC = [3],
03300 XGP = [4],
03400
03500 COMMENT These are definctions to compare strings;
03600 NULSTR(S) = [(LENGTH(S) = 0)],
03700 FULSTR(S) = [(LENGTH(S) NEQ 0)],
03800 FALSTR(S) = [EQU(S, "0")],
03900 TRUESTR(S) = [NOT EQU(S, "0")],
00100 COMMENT A record of each active frame and area is kept in a dynamically
00200 created array. Swinehart's ARRSER.SAI package creates such
00300 arrays. The array may be represented by an integer descriptor
00400 (we'll call it the array's IDA) which can be assigned to any array
00500 of variable upper bound (the array's ALIAS). Frame and area
00600 records contain IDAs of other records and of dynamic MOLES, OWLS,
00700 and area-arrays. All these arrays must be dynamically created
00800 because their existence is independent of block nests and even of
00900 their declarations -- for example, a BOX and its areas may be held
01000 over for several pages before insertion. THE FIRST ELEMENT OF EACH
01100 SUCH STRING ARRAY IS NOT A STRING BUT A GARBAGE-COLLECT LINK!!!
01200
01300 Two pages may be open at once, due to group overflow or to closing
01400 of one text area while others are still open. ;
01500
01600 COMMENT Here are the Aliases of the dynamic arrays:
01700
01800 IDA ALIAS Represents
01900 --- ----- --------------------------------------
02000 OLDPGIDA OLDPAGE Partly completed open page.
02100 NEWPGIDA NEWPAGE Overflow from OLDPAGE.
02200 FRAMEIDA THISFRAME Record of Frame we're PLACing in (PAGE or BOX).
02300 MOLESIDA MOLES Its MOLES array.
02400 OWLSIDA OWLS Its OWLS array.
02500 AREAIDA THISAREA Record of Area we're placing in.
02600 AA Its Area-Array.
02700 WBOXIDA WAITBOX Head of L.L. of Boxes held over.
02800
02900 A Frame Record is an integer array symbolized THISFRAME[0:PFREC|BFREC]: ;
03000 PFREC = [6], BFREC = [22],
03100 ARF = [THISFRAME[0]], COMMENT, head of LL of its area records;
03200 OWLSF = [THISFRAME[1]], COMMENT, IDA of its OWLS array;
03300 MOLESF = [THISFRAME[2]], COMMENT, IDA of its MOLES array;
03400 HIGHF = [THISFRAME[3]], COMMENT, n HIGH;
03500 WIDEF = [THISFRAME[4]], COMMENT, v WIDE;
03600 SHORTF = [THISFRAME[5]], COMMENT, how far line is short of right just;
03650 MLEADF = [THISFRAME[6]], COMMENT TES 11/2/74 excess mill leading of line ;
03700 COMMENT The rest apply only to a BOX FRAME;
03800 ULLB = [THISFRAME[7]], COMMENT, Upper Left Line covered in containing area INB;
03900 ULCB = [THISFRAME[8]], COMMENT, Upper Left Char covered;
04000 INB = [THISFRAME[9]], COMMENT, symbol no. of containing area;
04100 NEXTB = [THISFRAME[10]], COMMENT, link to next BOX -- two cases:
04200 If this box is held over → next such box in WAITBOX L.L.
04300 Otherwise → next box in this area (BOXA L.L.) ;
04400 comment, NEAR <where> encoded: about 12 words ;
00100 COMMENT An Area Record is an integer array symbolized THISAREA[0:AREC] -- ;
00200 AREC = [13],
00300 AAA = [THISAREA[0]], COMMENT, IDA of Area-Array (a 2-D array);
00400 ARA = [THISAREA[1]], COMMENT, IDA of next area record in this frame (ARF L.L.);
00500 OLD!ACTA = [THISAREA[2]], COMMENT, IDA of area record in up-level frame ;
00600 BOXA = [THISAREA[3]], COMMENT, IDA of first BOX in this area;
00700 INA = [THISAREA[4]], COMMENT, IDA of containing frame;
00800 STATA = [THISAREA[5]], COMMENT, Status:
00900 Unopened=0 Open=1 Closed=2 Dis-Declared=3 ;
01000 DEFA = [THISAREA[6]], COMMENT, ptr to definition in ISTK (or 0 if none);
01100 COMMENT If the area is open-- ;
01200 NBOXA = [THISAREA[7]], COMMENT, number of BOXes in the BOXA L.L.;
01300 COLA = [THISAREA[8]], COMMENT, column we're PLACing in;
01400 COMMENT If the area is closed or dis-declared-- ;
01500 LINECA = [THISAREA[9]], COMMENT, LINECT copied from ISTK ;
01600 COLCA = [THISAREA[10]], COMMENT, COLCT copied from ISTK ;
01700 ULLA = [THISAREA[11]], COMMENT, LINE1(AREA) copied from ISTK;
01800 COMMENT and AA[i,0] tells upper left character posn of column i ;
01900 XGENA= [THISAREA[12]], COMMENT, XGENLINES FOR AREA;COMMENT RKJ;
02000 OVERA= [THISAREA[13]], COMMENT TES 11/14/73 OVEREST for col-1 of area;
02100
02200 COMMENT The Area-Array of a D-column M-line area is an integer array AA[1:2*D,0:M].
02300
02400 Column 1 Column 2 Column 3 ...
02500 "Leg" Foot Leg Foot Leg Foot ...
02600 lines already used * AA[1,0] AA[D+1,0] AA[2,0] AA[D+2,0] AA[3,0] AA[D+3,0] ...
02700 J'th line AA[1,J] AA[D+1,J] AA[2,J] AA[D+2,J] AA[3,J] AA[D+3,J] ...
02800 (*): H2=last placed line, H1=lines beneath covered by BOXes;
00100 COMMENT These "mode words" are BLT'ed to ISTK upon block entry ;
00200
00300 MODEWDS = [23];
00400
00500 TERNAL INTEGER BREAKM ; comment Break Mode ; DEFINE
00600 FILL= [(BREAKM=0)], NOFILL = [(BREAKM NEQ 0)], JUSTJUST= [(BREAKM=1)], FLUSHL= [(BREAKM=2)],
00700 FLUSHR= [(BREAKM=3)], CENTER= [(BREAKM=4)], IMPOSE= [(BREAKM=5)], VERBATIM= [(BREAKM=6)],
00800 REGNOFILL = [(BREAKM=7)];
00900 TERNAL INTEGER JUSTM ; DEFINE ADJUST= [(JUSTM=1)], NOJUST= [(JUSTM=0)];
01000 TERNAL INTEGER SPACEM ; DEFINE COMPACT= [(SPACEM=2 OR FILL AND SPACEM=1)], RETAIN= [(NOT COMPACT)];
01100 TERNAL INTEGER CRBM ; DEFINE CRBREAK= [(CRBM=1)], CRSPACE= [(CRBM=0)];
01200 TERNAL INTEGER TWEENLFM, comment, N-1 from SUPERIMPOSE N;
01300 SINCELFM, comment, count no-LF lines;
01400 FIRSTIM, comment, f from INDENT f,r ;
01500 RESTIM, comment, r from INDENT f,r ;
01600 RIGHTIM, comment, g from INDENT f, r, g ;
01700
01800 GROUPM, comment, GROUP=1 APART=0;
01900 GLINEM, comment, MOLES Posn of 1st output line in the group;
02000 AREAIXM, comment, ISTK posn of Place Area;
02100
02200 TABTAB, comment either 0 or what TAB is TURNed ON as ;
02300
02400 LEADFM, comment, PREFACE in FILL mode ;
02500 LEADNM, comment, PREFACE in NOFILL mode ;
02600 SPREADM, comment, SPREAD=LINESPACING+1, e.g., SINGLE SPACE → 1;
02610 MLEADFM, comment extra mill PREFACE in FILL TES 11/2/74 ;
02620 MLEADNM, comment extra mill PREFACE in NOFILL TES 11/2/74 ;
02630 MSPREADM, comment extra mill spacing TES 11/2/74 ;
02640
02700 ENDCASE, comment, how this block began: BEGIN=1 ONCE=2 BEFORE|AFTER|FOOTNOTES=3 ;
02800 STARTS, comment, clump depth in this block ;
02900 SHED , comment, Top of SSTK ;
03000 OLDIHED; COMMENT TES 11/15/73 OLD ISTK TOP ;
03100
03200 COMMENT TES 11/15/73 OLDFONT + THISFONT moved to last page ;
00100 COMMENT These are for scanners;
00200 DEFINE
00300 LETTS = ["!_QWERTYUIOPLKJHGFDSAZXCVBNMzxcvbnmlkjhgfdsaqwertyuiop"],
00400 DIGS = ["0123456789"],
00500 CR = ['15], LF = ['12], SP = ['40], TB = ['11], FF = ['14], CRLF = [(CR&LF)],
00600 RUBOUT = "'177", VT = "'13", EOL = "'37",
00700 BAR = IFCR ITSVER THENC "'137" ELSEC "'30" ENDC,
00800 CTLA = 1, CTLQ = 17, CTLS = 19, CTLV = 22,
00900 ALTMODE=IFCR TENEX THENC "'33" ELSEC
01000 IFCR SAILVER THENC "'175" ELSEC "'176" ENDC
01100 ENDC,
01200 RCBRAK=IFCR SAILVER THENC "'176" ELSEC "'175" ENDC,
01300 LCBRAK= ['174], COMMENT TES 8/14/74 ;
01400
01500 COMMENT For the parser;
01600 SPASS(X) = [((X&NULL)&PASS)],
01700 IPASS(X) = [((X+0)+PASS)],
01800 DPASS = [BEGIN DCLR!ID←TRUE ; PASS; DCLR!ID←FALSE END],
01900 EMPTYTHIS = [BEGIN THISTYPE ← -EMPTYQ ; THISWD ← NULL END],
02000 EMPTYTHAT = [BEGIN THATTYPE ← -EMPTYQ ; THATWD ← NULL END],
02100 THISISFULL = [(THISTYPE NEQ -EMPTYQ)], THATISFULL = [(THATTYPE NEQ -EMPTYQ)],
02200 THISISID = [(THISTYPE GEQ 0)], THATISID = [(THATTYPE GEQ 0)],
02300 THISISCON = [(THISTYPE = -1)], THATISCON = [(THATTYPE = -1)],
02400 COMMENT ITS(IDENT), ITSCH($), ITSCH(<]>) ;
02500 ITS(LIT) = [EQU(THISWD,"LIT")], ITSV(EX) = [EQU(THISWD,EX)],
02600 NEXTS(LIT) = [EQU(THATWD,"LIT")], NEXTSV(EX) = [EQU(THATWD,EX)],
02700 ITSCH(CHR) = [(THISWD = "CHR")], NEXTSCH(CHR) = [(THATWD = "CHR")],
02800 ITSBRACK(CHR) = [(THISWD = CHR)], NEXTSBRACK(CHR) = [(THATWD = CHR)],
02900
03000 COMMENT The character Table CHARTBL categorizes each of the 128 ASCII
03100 characters for both the Parser and the Filler. SPCODE is a
03200 variable field set by TURN ON (and reset by TURN OFF) to a value
03300 fetched from the constant field SPCHAR.;
03400
03500 UPCASE(CH) = [BBPP(7, CHARTBL[0], 6) + (CH)],
03600 FAMILY(CH) = [BBPP(5, CHARTBL[0], 11) + (CH)],
03700 SPECIES(CH) = [BBPP(5, CHARTBL[0], 17) + (CH)],
03800 SPCODE(CH) = [BBPP(6, CHARTBL[0], 35) + (CH)],
03900 SPCHAR(CH) = [BBPP(6, CHARTBL[0], 26) + (CH)],
04000 COMMENT and Bit 29 is set for Invisibles ;
04100
04200 COMMENT Table of Character Families and Species
04300
04400 S P E C I E S
04500 F A M I L Y 0 1 2 3 4 5 6 ..... 26
04600 ---------------- ----- ------- ------- -------- ----- ----- ----- ---- ;
04700 LETTQ = [ 0],COMMENT Aa Bb Cc Dd Ee Ff Gg .... !_ ;
04800 DIGQ = [ 1],COMMENT 0 1 2 3 4 5 6 ... ;
04900 EMPTYQ = [ 2],
05000 TERQ = [ 3],COMMENT } ; COMMENT ) , ] ⊂ ;
05100 QUOTEQ = [ 4],COMMENT " ' ;
05200 DOLLARQ = [ 5],COMMENT $ ;
05300 BROKQ = [ 6],COMMENT [ ;
05400 MULQ = [ 7],COMMENT * / DIV % MOD & ;
05500 ADDQ = [ 8],COMMENT + - EQV≡ABS ↑ XOR⊗LENGTH XLENGTH ;
05600 BOUNDQ = [ 9],COMMENT MAX MIN ;
05700 ODDQ = [10],COMMENT EVEN ODD ;
05800 RELQ = [11],COMMENT < > = ≤ LEQ ≥ GEQ ≠ NEQ ;
05900 NOTQ = [12],COMMENT¬ NOT ;
06000 ANDQ = [13],COMMENT∧ AND ;
06100 ORQ = [14],COMMENT∨ OR ;
06200 MISCQ = [15],COMMENT rest : ← ( ∞ @ | ε ;
06300 MISCMAX = [7], COMMENT, Highest numbered species in MISCQ ;
00100 COMMENT Run-of-mill defines;
00200 TWO(X) = [(1 LSH (X))],
00300 TABLIMIT = [30], COMMENT TES 8/26/74 ;
00400 THRU = [STEP 1 UNTIL],
00500 DOWN = [STEP -1 UNTIL],
00600 FALSE = [0], TRUE = [-1],
00700 LOPP(STR) = [DUMMY ← LOP(STR)],
00800 COPY(STR) = [BEGIN STR ← 0&STR ; LOPP(STR) END],
00900 LH(X) = [((X) LSH -18 LAND '777777)],
01000 RH(X) = [((X) LAND '777777)],
01100 LHRH(X,Y) = [((X) LSH 18 LOR (Y))],
01200 WDBRK = [ALTMODE], FONTCHAR = ['177],
01300 CVSR(N) = [CVS(N) & ALTMODE],
01400
01500 COMMENT Break Tables;
01600 TO!VT!SKIP = [15],
01700 TO!COMMA!RPAR = [14],
01800 TO!TERQ!CR = [13],
01900 TO!SEMI!SKIP = [12], COMMENT, for COMMENT comments;
02000 NO!CHARS = [11],
02100 ONE!CHAR = [10], COMMENT, break on aything and append;
02200 LOCAL!TABLE = [9], COMMENT, Do a SETBREAK before using this one;
02300 TO!TB!FF!SKIP = [8], COMMENT, to scan a line number (ignores line feed);
02400 TO!LF!TB!VT!SKIP = [7], COMMENT, to swallow a whole line;
02500 TO!VISIBLE = [6],
02600 ALPHA = [5],
02700 DIGITA = [4],
02800 TO!QUOTE!APPD = [3],
02900 TO!NON!SP = [2],
03000 TEXT!TBL = [1],
03100 TO!CR!SKIP = [16], COMMENT for VERBATIM text lines ;
03200 TO!VBAR!SKIP = [17],
03300 DEFN!TABLE = [18],
03400
03500 COMMENT Buggy Printout ;
03600 DARN = [WARN],
03700 λ = [& "," &],
03800 VS(SVAR) = [ " SVAR=" & SVAR ],
03900 VI(IVAR) = [ " IVAR=" & CVS(IVAR) ],
04000 MESSMAX = [3],
04100
04200 VIRGIN = [NULL]; COMMENT End DEFINE ;
00200 TERNAL THAFE INTEGER ARRAY
00300 COMMENT PHRASED ARRAY REMOVED TES 11/15/73;
00400 SIGNALD[0:127], COMMENT, detect last character of signal to trigger response search;
00500 CHARTBL[0:150], COMMENT, current classification and mapping of characters;
00600 INPG[0:10], COMMENT, 1 to 10 mTnP options;
00700 TABSORT[1:TABLIMIT+1], COMMENT, tab stops in increasing order;
00800 ETCIARRAYS[0:0];
00900
01000 DEFINE MAXBLNMS = IFCR CMUVER THENC "180" ELSEC "40" ENDC ; TES 11/20/73 ;
01100 RKJ: 5-30-74 - Newcomer does much recursion with blocknames ;
01200
01300 PRELOAD "MONTH TABLE", "January ", "February ", "March ", "April ",
01400 "May ", "June ", "July ", "August ", "September ", "October ",
01500 "November ", "December " ;
01600 TERNAL STRING ARRAY
01700 MONTH[0:12], COMMENT MUST BE FIRST!! To compute DATE for macros to print ;
01800 BLKNAMES[0:MAXBLNMS], COMMENT, clump and block names ;
01900 PICHAR[0:127], COMMENT, Current meanings of PI CHARacters,
02000 in the form: F N k B1 ... Bk TES 11/29/73
02100 where WIDTH = if F='177 then CW[N] else FN ;
02200 MESGSARR[1:MESSMAX], COMMENT, Short error messages to print on document in D mode. ;
02300 NULLS[0:10], COMMENT, always NULLs;
02400 ETCSARRAYS[0:0] ;
02500
02600 PRELOAD NULL, " ", " ", " ", " ", " ", " ",
02700 " ", " ", " ", " " ;
02800 TERNAL THAFE STRING ARRAY SPSARR[0:10] ;
00100 DEFINE IDASSIGN(EX,ALIAS)=[BEGIN DUMMY←EX;
00200 IF DUMMY LEQ 0 THEN WARN(NULL,<"NEGATIVE ALIAS FOR INTEGER ARRAY">) ELSE comment ************* ;
00300 MAKEBE(DUMMY, ALIAS) END] ;
00400
00500 DEFINE SMAKEBE(I, A) = [START!CODE HRRO TEMPO,I ; MOVEM TEMPO, A ; END],
00600 SIDASSIGN(EX, ALIAS) = [BEGIN DUMMY←EX ; SMAKEBE(DUMMY, ALIAS) END] ;
00700
00800 DEFINE ERRCOUNT = 1 ;
00900 DEFINE ERRNAME = [] ;
01000 DEFINE WARN(SH, LG) = [
01100 BEGIN
01200 REDEFINE ERRNAME = [ERR!] & CVS(ERRCOUNT);
01300 REDEFINE ERRCOUNT = ERRCOUNT + 1 ;
01400 OWN BOOLEAN ERRNAME ;
01500 WARNN(ERRNAME, SH, LG) ;
01600 END
01700 ] ;
01800 COMMENT ONLY USABLE AT STATEMENT LEVEL -- OTHERWISE CALL
01900 WARNN(NAME!YOU!DECLARE!INTEGER, SH, LG) ;
02000
02100 COMMENT Several linked list scans use these macros to generate code.
02200 LLHEAD symbolizes a variable pointing to the first element.
02300 LLNEXT(x) would determine the successor to x. The global variables
02400 LLPREV, LLTHIS, and LLPOST display the result of the scan. ;
02500
02600 DEFINE LLSCAN(LLHEAD, LLNEXT, LLSTOP) = [
02700 BEGIN LLTHIS ← LLHEAD MAX 0 ; LLPREV ← -1 ;
02800 WHILE LLTHIS AND NOT(LLSTOP) DO
02900 BEGIN
03000 LLPREV ← LLTHIS ; LLTHIS ← LLNEXT(<LLTHIS>) ;
03100 END ;
03200 LLPOST ← IF LLTHIS THEN LLNEXT(<LLTHIS>) ELSE 0 ;
03300 END],
03400 LLSKIP(LLHEAD, LLNEXT) = [
03500 IF LLPREV LEQ -1 THEN LLHEAD ← LLPOST
03600 ELSE LLNEXT(<LLPREV>) ← LLPOST ],
03700 LLINS(LLHEAD, LLNEXT, LLNEW) = [
03800 BEGIN
03900 IF LLPREV LEQ -1 THEN LLHEAD ← LLNEW ELSE LLNEXT(<LLPREV>) ← LLNEW ;
04000 LLNEXT(<LLNEW>) ← LLTHIS ;
04100 END];
00100 TERNAL INTEGER
00200 SYMNO, comment, size of hashed SYMBOL Table;
00300 XSYMNO, comment, size of SYM and NUMBER--first SYMNO elemts hash-searched, rest linear- searched;
00400 ISIZE, SSIZE, ITSIZE, STSIZE, SIZE, comment of ISTK,SSTK,ITBL,STBL,NESTs;
00500 IHED, IHIGH, SHIGH, LAST, comment last used (highest unavailable) subscript;
00600 OLX,NOLX,GRPOLX,GRPTOP, OLXX, OLMAX, comment,
00700 used words of OWLS, LENGTH(OWLS), total of all declared areas;
00800 EOF, BRC, FLAG, comment, I/O control variables;
00900 CONTENTS, DEBUG, DEVICE, comment, RPG-derived switches;
01000 LMARG, RMARG, comment, margin settings in this area;
01100 ODDLEFTBORDER, EVENLEFTBORDER, comment, TES 6/11/74 XGP side margins in mills ;
01200 OAKS,POSN, BRKPT,BRKPOSN,BRKXPOSN,BRKFAKE, BRKABX, BRKBLX,
01300 BRKSPCS, JUSTIFY, LASTWDBRK, BRKPLBL, TABI,RBOUND,
01400 MAXIM,FMAXIM,NMAXIM, comment, Line-Filler (OWL) variables;
01500 STANDARD, comment, ptr to def in ISTK of MACRO !STANDARD;
01600 INSETS, comment, ptr to AT <n> of smallest n (ISTK ptr);
01700 INPUTCHAN, TECOFILE, comment, current input channel ;
01800 INPGS, INPGX,comment, last and current subscript in array INPG of mTnP options;
01900 SWDBACK, comment, -1=just SWICHBACKed from a file, +1=just WARNed ;
02000 PUBSTD, comment, whether compiling PUBSTD.DFS (suppress pgno display) ;
02100 ONE, comment, 1 for variable upper bound of ALIAS arrays;
02200 TAG, comment, STBL address of variable TAG;
02300 SAIL!SKIP!, comment, !SKIP! value after execution of SAIL substring operation;
02400 INF, comment, ∞ value for current ALGOL substring spec;
02500 I, J, K, L, M, N, DUMMY, comment, short-term loan currency ;
02600 DEPTH, comment, block depth -- CMDNAMES are at 0, main program at 1;
02700 ON, comment, FALSE if parsing false part of conditional or if defining a response body;
02800 FHIGH, FWIDE, PHIGH, PWIDE, comment, Dimensions of the current Frame and Page Frame;
02900 EPSCHAR, comment, char serving { function ;
03000 PAGEMARKS, PAGEWAS, comment, no. of PM's on this page: passed, responded to ;
03100 RESP!BODY, comment, TRUE if defining a response body;
03200 DCLR!LET, comment, TRUE if scanning after = of `LET X=..';
03300 DCLR!ID, comment, TRUE if in a declaration scanning an identifier that is to be declared;
03400 DEFINING, comment TRUE if reading [definition] ;
03500 WAITRESP, comment, head of LL of Responses to undeclared areas and counters;
03600 LEADRESPS, comment, head of LL of "AT n" responses, in ascending order by n ;
03700 !COMMAND!CHARACTER!, !TAB!CHARACTER!,
03800 NPORTS, THISPORT, SEQPORT, PORTLL, comment, Portions: # of, last declared, last in seq, seq LL;
03900 INTER, SINTER, INTERS, comment Intermediate output channel, no. of intermediate output files ;
04000 STATUS, comment, Current place area UNOPENED (0), OPEN (1), CLOSED (2), GONE (3) ;
04100 OLDPGIDA, NEWPGIDA, FRAMEIDA,
04150 MOLESIDA, MLEADIDA, SHORTIDA, OWLSIDA,
04175 AREAIDA, WBOXIDA,
04200 SYMIDA, NUMBIDA, ISTKIDA, SSTKIDA, ITBLIDA, STBLIDA, INESTIDA, SNESTIDA,
04300 BYTEWD, comment, lots of byte pointers point here ;
04400 COLS, COL, PAL, LINES, LINE, PINE, COVERED, UNDEAD, comment, Current position in place area ;
04500 NULLAREAS, comment, LL of Made but Unopened areas (Status=0) ;
04600 PREFMODE, comment, n from nS option ;
04700 BLNMS, comment, top of BLKNAMES stack ;
04800 MYEND, comment flag for END routines (see TOEND in MAN.SAI) ;
04900 FOOTTOP, comment TRUE iff expecting 1st line of 1st footnote belonging to a body line;
05000 OWLSEQ, comment, counts total output lines red'd by OWLS arrays ;
05100 WISTK, WITBL, WINEST, WSSTK, WSTBL, WSNEST, WSYM, WNUMBER,
05200 WOLDPAGE, WNEWPAGE, WTHISFRAME, WMOLES, WNMOLES,
05300 WOWLS, WNOWLS, WTHISAREA, WWAITBOX, WAVAILREC,
05400 WAA, WNAA, WSHORT, WNSHORT, WMLEAD, WNMLEAD, comment, WHATIS(dummy arrays) ;
05500 SWFLG, comment, used only in SWICHF TES 12/3/73 ;
05600 INPICHAR, comment for DPICHAR and RDENTITY/OCTAL TES 12/6/73 ;
05700 INCHAN, COMMENT CHANNEL INFILE OPENED ON ;
05800 AGENFILE, COMMENT BOOLEAN FOR SWICHFILE ;
05900 DEEPREPEATS, COMMENT DEPTH OF REPEAT NEST -- MAINLY CARE IF 0 ;
06000 DEEPPROCEDURES, COMMENT DEPTH OF PROCEDURE NEST -- MAINLY CARE IF 0 ;
06100 MAXTEMPLATE, COMMENT LONGEST ALLOWABLE TEMPLATE (NCHARS) ;
06200 ERRLF, COMMENT BOOLEAN FOR LF RESPONSE TO ERROR WARNING ;
06300 GENREXT, COMMENT BOOLEAN FOR DOC EXTENSION ;
06400 DEBUGFLAG, COMMENT WHETHER DEBUG("HERALD") IS ARMED ;
06600 MINCHARW, COMMENT SMALLEST LEGAL WIDTH IN FONT ;
06610 MILLVERTI, COMMENT "NORMAL" VALUE OF INTER-LINE SPACING, INIT. IN OWLPLACE();
06655 NEEDMILLVERTI, COMMENT TRUE IFF ANY SPACING IS NON-MILLVERTI ;
06700 LOCATIONOFERROR, COMMENT CIRCUMVENT SAIL FIXUP BUG ;
06800 FTGP2, comment 11/2/74 TES ;
06900 FTGP, comment 11/30/73 TES ;
07000 FSFONT, comment 11/30/73 TES ;
00100 UPCAS3, UPCAS5, UPCAS6, comment, byte pointers for CAPITALIZE,STRLSS;
00200 SYMTYPE, SYMIX, comment, fields of a descr. looked up by SIMLOOK or SIMNUM;
00300 LONG, comment TRUE in a LONG etc. command;
00400 SYMPAGE, IXPAGE, PATPAGE, comment, SYM subscript, IX field, counter subscript for PAGE;
00500 IXCOMMENT, IXEND, IXFOOT, IXTAG, comment, IX fields for reserved words;
00600 SYMTEXT, IXTEXT,
00700 LLPREV, LLTHIS, LLPOST, comment, results of LLSCAN (a macro) ;
00800 AMSAND, LBRACK, UARROW, DARROW, UNDERBAR, LCURLY, DOLLAR,
00900 comment SPCHAR codes of & [ ↑ ↓ _ { $ ;
01000 EXNEXTPAGE, comment TRUE while executing NEXT PAGE (prevents recursion) ;
01100 MESGS, comment, how many messages in MESGSARR[] ;
01200 LDEFN!BRC, comment, initial LENGTH(DEFN!BRC) ;
01300 GENSYM ;
01400
01500 TERNAL STRING
01600 C!, !, comment C and P-values of incremented counter after NEXT statement;
01700 INPUTSTR, comment, current input string;
01800 LIT!ENTITY, LIT!TRAIL, comment,
01900 for the entity in THATWD: its literal input form & trailing spaces;
02000 TEXT!BRC, comment, break characters (always including CR LF SP ALTMODE RUBOUT -.?! );
02100 DEFN!BRC, comment, break characters (char serving as {, also }, LF, [, ], ∃, letters) ;
02200 SIG!BRC, comment, break characters for Signals (first char of each signal) ;
02300 PAGEVAL, comment, the P-value of this PAGE when it was opened ;
02400 SRCPAGE, SRCLINE, MACLINE, comment, input file line nos.;
02500 INFILE, OUTFILE, TMPFILE, comment, RPG-determined file names;
02550 FULLFILE, comment, includes extension and directory in name ;
02600 IFILENAME, comment first name of INFILE for TENEX ;
02700 MAINFILE, comment first name of INFILE, filled out with colons to 6 chars ;
02800 THISFILE, comment, the first name of the file being read now, colon-filled ;
02900 LIBPPN, comment usually [1,TES], but [2,TES] if logged in as [2,TES] ;
03000 OWL, LBF, OLBF, comment, Line-Filler variables ;
03100 DUMMYSTR, S, comment, just strings to throw around;
03200 THISWD,THATWD, comment, this (ITS) and sometimes next entity from scanner;
03300 CHARSP, comment, SPCHAR to character convert table ;
03400 FOOTSEP, comment, line to draw above footnotes ;
03600 STR1, STR2, STR3, comment temporaries ;
03700 DELINT, comment, Delete Intermediate Files Option Y/N/A ;
03800 JOBNO, CONDIR, comment, job number & connected dir (TENEX only--else NULL) TES 10/25/73;
03900 VUNDERLINE, COMMENT TES 10/22/73 The UNDERLINE character ;
04100 PROCVALUE, TES 8/19/74 RETURN VALUE OF PROCEDURE ;
04200 SPSSTR, COMMENT TES 9/30/74 FOR FASTER SPS(N) ;
04300 ETCS;
04310
04320 IFC TENEX THENC STRING ELSEC INTEGER ENDC TES 10/20/74 ;
04330 INPPN; COMMENT DIRECTORY INFILE IS ON ;
04400
04500 EXTERNAL INTEGER RPGSW, !SKIP! ;
04600
04700 TERNAL INTEGER
04800 comment, BEGINBLOCK BLT's these to ISTK (keep them together): ;
04900 THISTYPE,THATTYPE, comment, THATTYPE is parser type of THATWD:
05000 -2=EMPTYQ GEQ 0=IDENTIFIER(exact value is no. of trailing spaces)
05100 THISTYPE is parser type of THISWD:
05200 1..15=TYPEN(ID symbol) 0=Undeclared ID
05300 -1=CONSTANT -2=EMPTYQ LEQ -3=SP.CHAR.(-FAMILY no.);
05400 SYMB, comment, the SYM subscript of THISWD, if THISISID;
05500 IX, comment, the IX field of NUMBER for THISWD, if THISISID;
05600 STARPOSN, RIPTPOSNS, AMPPOSN, TEXTMODE,
05700 PLBL,FIRST,NOPGPH,SPCS,ABOVEX,BELOWX,HEIGHT,SUPERSUB,
05800 UNDERLINING,FAKE,MIDWORD,PUNC,INDENT,LBP,XLBP,LBO,LBK,ILBF,
05900 BRKFONT, BRKUNDER ; TES 11/20/73, 12/28/73 ;
06000 DEFINE SOMEWDS= [4],MIDWDS= [28]; comment, how many variables in above list ;
00100 TERNAL INTEGER
00200 OLDFONT , comment last XGP font ;
00300 THISFONT, comment current XGP font ;
00400 KSETCON, COMMENT KSET OFFSET IN CW;
00500 XGENLINES, COMMENT NUMBER OF LINES GENERATED BY LDX MACROS;
00600 XPOSN, COMMENT LDX EQUIV OF POSN;
00700 XCMDCHR, COMMENT SPCHAR CODE FOR ⊗;
00800 XNJB, COMMENT SPCHAR CODE FOR #;
00900 KSETSWAP, COMMENT SPCHAR CODE FOR %;
01000 FSHORT; COMMENT FAKE SHORT FOR XCRIBL MODE SPACES;
01100
01200
01300 DEFINE XMAXIM= [(MAXIM*CHARW)]; RKJ: 1-5-74;
01400 TERNAL INTEGER OVEREST; COMMENT SHORT FONT KLUDGE! ;
01500
01600 TERNAL STRING XGPCMD , comment XGP commands to go on next line ;
01700 CMDFILE; COMMENT TEXT OF XGP COMMAND FILE ;
01800
01900 DEFINE CHARTORAST(VAL)= [IF XCRIBL THEN CHARW*(VAL) ELSE VAL];
02000
02100 COMMENT INSTALLATION DEPENDENT DEFAULTS ;
02200
02300 TES 8/24/74 FOR XLOOKUP ;
02400
02500 DEFINE
02600 PUBEXT = IFCR TENEX THENC [".PUB"] ELSEC CVSIX("PUB") ENDC,
02700 REQEXT = IFCR TENEX THENC [".DFS"] ELSEC CVSIX("DFS") ENDC;
02800
02900 TES AND FOR ENTER ;
03000
03100 PJ 5/28/74 ; DEFINE
03200 EXTSEP = IFCR ITSVER THENC [" "] ELSEC ["."] ENDC,
03300 PUIEXT = IFCR ITSVER THENC [" PUI"] ELSEC [".PUI"] ENDC,
03400 PUZEXT = IFCR ITSVER THENC [" PUZ"] ELSEC [".PUZ"] ENDC,
03500 PUGEXT = IFCR ITSVER THENC [" PUG"] ELSEC [".PUG"] ENDC,
03600 DFSEXT = IFCR ITSVER THENC [" DFS"] ELSEC [".DFS"] ENDC,
03700 DOCEXT = IFCR ITSVER THENC [" DOC"] ELSEC [".DOC"] ENDC,
03800 OCTEXT = IFCR ITSVER THENC [" OCT"] ELSEC [".OCT"] ENDC,
03900 RPGEXT = IFCR ITSVER THENC [" RPG"] ELSEC [".RPG"] ENDC,
04000 TXTEXT = IFCR ITSVER THENC [" ASC"] ELSEC [".ASC"] ENDC;
04100
04200 IFCR ITSVER THENC
04300 DEFINE
04400 MILLVERTIDEFAULT = [30],
04500 ODDLEFTBORDERDEFAULT = [1300],
04600 EVENLEFTBORDERDEFAULT = [1300],
04700 VBPIMIC = [0], HBPIMIC = [0],
04800 VBPIXGP = [200], HBPIXGP = [200],
04900 MICMINLFTMAR = [0], XGPMINLFTMAR = [0],
05000 FONTEXT = ['536364000000], COMMENT KST ;
05100 FONTPPN= ['465756646300], COMMENT FONTS ;
05200 REQPPN = [0];
05300 ENDC
05400 IFCR SAILVER THENC
05500 DEFINE FONTPPN = ['704760637163], COMMENT [XGP,SYS];
05600 REQPPN = [0],
05700 MILLVERTIDEFAULT = [15],
05800 ODDLEFTBORDERDEFAULT = [1300],
05900 EVENLEFTBORDERDEFAULT = [1300],
06000 VBPIMIC = [0], HBPIMIC = [0],
06100 VBPIXGP = [200], HBPIXGP = [200],
06200 MICMINLFTMAR = [0], XGPMINLFTMAR = [0],
06300 FONTEXT = ['465664000000]; COMMENT FNT ;
06400 ENDC
06500 IFCR CMUVER THENC
06600 DEFINE FONTPPN = ['001343303360], COMMENT [A730KS00] ;
06700 REQPPN = [0],
06800 MILLVERTIDEFAULT = [35],
06900 ODDLEFTBORDERDEFAULT = [0],
07000 EVENLEFTBORDERDEFAULT = [0],
07100 VBPIMIC = [0], HBPIMIC = [0],
07200 VBPIXGP = [183], HBPIXGP = [183],
07300 MICMINLFTMAR = [0], XGPMINLFTMAR = [0],
07400 FONTEXT = ['536364000000]; COMMENT KST ;
07500 DEFINE LIBDEV = ["DSK"];
07600 ENDC
07700 IFCR PARCVER THENC
07800 DEFINE
07900 MILLVERTIDEFAULT = [15],
08000 ODDLEFTBORDERDEFAULT = [1300],
08100 EVENLEFTBORDERDEFAULT = [1300],
08200 VBPIMIC = [500], HBPIMIC = [500],
08300 VBPIXGP = [198], HBPIXGP = [188],
08400 MICMINLFTMAR = [0], XGPMINLFTMAR = [94],
08500 FONTPPN=["<FONTS>"],
08600 REQPPN = ["<PARCPUB>"],
08700 FONTEXT=[(IF ABS(DEVICE)=MIC THEN ".EP" ELSE ".XH")],
08800 GENEXT= [".GEN"],
08900 ALFEXT= [".ALF"];
09000 ENDC
09100
09200 IFCR ISIVER THENC
09300 DEFINE
09400 FONTPPN = ["<XGP>"],
09500 REQPPN = ["<PUB>"],
09600 MILLVERTIDEFAULT = [35],
09700 ODDLEFTBORDERDEFAULT = [0],
09800 EVENLEFTBORDERDEFAULT = [0],
09900 VBPIMIC = [0], HBPIMIC = [0],
10000 VBPIXGP = [183], HBPIXGP = [183],
10100 MICMINLFTMAR = [0], XGPMINLFTMAR = [0],
10200 FONTEXT = [".KST"],
10250 ALFEXT = [".ALF"],
10275 GENEXT = [".GEN"],
10300 LIBDEV = ["DSK"];
10400 ENDC
00300 ONE ← 1 ;
00400
00500 BEGIN "VARIAB"
00600
00700 TERNAL INTEGER ARRAY ISTK[0:ONE], ITBL[0:ONE], INEST[0:ONE] ;
00800 TERNAL STRING ARRAY SSTK[0:ONE], STBL[0:ONE], SNEST[0:ONE] ;
00900
01000 TERNAL SAFE INTEGER ARRAY CW[0:ONE];
01100
01200 TERNAL INTEGER ARRAY COMMENT "ALIASES" for Dynamic Arrays ;
01300 OLDPAGE, NEWPAGE, THISFRAME,
01350 MOLES,NMOLES, SHORT,NSHORT, MLEAD,NMLEAD, OWLS,NOWLS,
01375 THISAREA, WAITBOX, AVAILREC[0:ONE],
01400 AA,NAA[0:ONE, 0:ONE] ;
01500
01600 TERNAL INTEGER SYMBOL,ERRFLAG;
01700
01800 TERNAL STRING ARRAY SYM[-1:ONE];
01900 TERNAL INTEGER ARRAY NUMBER[-1:ONE];
02000
02100 COMMENT AVAILREC AND WAITBOX ARE FOR UNIMPLEMENTED
02200 BOX FRAMES ;