![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to newgpm.spt CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / spitbol|
Return to newgpm.spt CVS log | Up to [Research Unix] / researchv10no / cmd / spitbol |
1.1 root 1: -IN132
2: -TITLE MACRO TEXT PROCESSOR V780-6.12
3: * This program is a document processor based on the principles of
4: * C. Strachey's GPM. All text processor commands consist
5: * of macro calls embedded in the string of text.
6: * There is a reference document which should be consulted for
7: * detailed explanation.
8: *
9: * Neither the author nor any institution which the author may represent
10: * assumes any liability with respect to the use of this program,
11: * or makes any representations as to its fitness or merchantability
12: * for a particular purpose.
13: *
14: * Steven G. Duff
15: * Santa Fe Engineering Services Co.
16: * Research and Development Ax/1
17: * 505 South Main Street
18: * Orange, California 92668 USA
19: * (714) 558-1300
20: *
21: -STITL REVISION HISTORY
22: *
23: * o Rev. 6.12 28-APR-1982 [SGD]:
24: * o Made some rearrangements to startup processing and messages.
25: *
26: * o Rev. 6.11 26-APR-1982 [SGD]:
27: * o Startup command line now processed differently, also errors in
28: * built-in function file now reported.
29: *
30: * o Rev. 6.10 18-JAN-1982 [SGD]:
31: * o Changed interpretation of {D mname}, where mname is a system
32: * macro. This now is the same as {Mname} (rather than "SYSTEM").
33: *
34: * o Rev. 6.02 13-NOV-1981 [SGD]:
35: * o Added BIAS macro.
36: *
37: * o Rev. 6.01 22-SEP-1981 [SGD]:
38: * o Added SKIPTEXT function and macro.
39: * o Modified READ() to use SKIPTEXT() for BEGINTEXT operation.
40: * o Added QUERY output association for prompting.
41: *
42: -STITL PATTERN DEFINITION AND INITIALIZATION
43: * !!!WARNING!!! Note that this initializing code must not contain
44: * any labels, as they would prevent the code blocks from being
45: * garbage collected later.
46: *
47: * To tailor for an individual system, the following initializations
48: * are especially important. The READ function will have to be
49: * modified, and the startup code which contains some I/O
50: * associations will have to be changed.
51: *
52: &TRIM = 1; &ANCHOR = 1; &STLIMIT = 999999999
53: &ALPHABET BREAK('A') LEN(26) . UPLETS BREAK('a') LEN(26) . LOWLETS
54: *
55: * MINLU and MAXLU set the limits on the input logical unit stack.
56: * OUTUNIT is the lun used for output.
57: * QUERYUNIT is the lun used for prompts.
58: *
59: MINLU = 2
60: MAXLU = 15
61: OUTUNIT = 1
62: QUERYUNIT = 16
63: *
64: * BIFFILE is the filespec of the Built-in Function File, read in at startup.
65: * USERSTART gives the spec for the user's autoload library (no error is
66: * issued if this is not found at startup.
67: * The INITIAL... files are the filespecs initially assigned for I/O.
68: * INITIAL_INPUT should be the pre-association for TERMINAL. If not, the
69: * startup message section will have to be patched up.
70: *
71: BIFFILE = 'GPMBIF.GPM'
72: USERSTART = 'GPMSTART'
73: INITIAL_INPUT = '/dev/tty'
74: INITIAL_OUTPUT = '/dev/tty'
75: -EJECT
76: *
77: * BS is the backspace character. It should only be possible to generate
78: * this character with the system function OVER, as other routines assume
79: * a certain 'normalized' distribution of backspaces (see OVER). If no
80: * 'non-normal' characters exist in the host machine character set to be
81: * used for BS, then it should be translated out in GETLINE.
82: *
83: * CS is the control sequence character. It should only be possible to
84: * generate this character with the system function CONTROL_SEQ, as
85: * there is a standard 'normalized' form for these also. A control sequence
86: * is a string that is emitted to the device, but does not figure in
87: * line size computations.
88: *
89: BS = SUBSTR(&ALPHABET,255,1)
90: CS = SUBSTR(&ALPHABET,254,1)
91: BSPATT = BREAK(BS)
92: *
93: * CR is the character used to move to the beginning of a line image, and
94: * LF is used to move to the next physical print line.
95: *
96: &ALPHABET LEN(10) LEN(1) . LF LEN(2) LEN(1) . CR
97: CRLF = CR LF
98: *
99: * COMPLEXLIM is used to compare against &FNCLEVEL in the macro call circuit.
100: * When the function nesting reaches this limit, GPMDOC signals an error
101: * It should be set so that a SPITBOL stack overflow with its attendant
102: * unplesantness cannot occur.
103: *
104: COMPLEXLIM = 1000
105: *
106: * NCSW is the string which, when appended to filenames on OUTPUT calls
107: * will suppress implied carriage control. GPMDOC instead uses
108: * CR, and CRLF combinations at the end of output records explicitly.
109: * This is necessary to support overstrikes.
110: *
111: NCSW = ;* this used to be '/NOCR'
112: -STITL COMMON STRING INITIALIZATION
113: * The reason for the table below is to provide a common string value for
114: * strings referenced within the interpreter. As SPITBOL does not hash
115: * strings, if this were not done, space in dynamic would be lost to multiple
116: * copies of the same strings. At the end of initialization, we set H to
117: * null, effectively losing the table, and as all the initialization code
118: * is also garbage collected away, all string indexes in H are discarded too.
119: * Thus we are left with a single copy of the string. For strings which have
120: * name with the same text (either functions or variables), we use a CONVERT
121: * of the name to string to gain access to the string referenced by the name.
122: * This may seem involved, but it reclaims a substantial amount of space that
123: * would otherwise be wasted, and space is at a premium in some versions.
124: *
125: H = TABLE(31)
126: H['BEGINTEXT'] = CONVERT(.BEGINTEXT,.STRING)
127: H['BIAS'] = CONVERT(.BIAS,.STRING)
128: H['BSLACK'] = CONVERT(.BSLACK,.STRING)
129: H['CODE'] = CONVERT(.CODE,.STRING)
130: H['COND'] = CONVERT(.COND,.STRING)
131: H['DIFFER'] = CONVERT(.DIFFER,.STRING)
132: H['DOPROP'] = CONVERT(.DOPROP,.STRING)
133: H['DOWHILE'] = CONVERT(.DOWHILE,.STRING)
134: H['END'] = CONVERT(.END,.STRING)
135: H['ENDTEXT'] = CONVERT(.ENDTEXT,.STRING)
136: H['FILL'] = CONVERT(.FILL,.STRING)
137: H['HS'] = CONVERT(.HS,.STRING)
138: H['IDENT'] = CONVERT(.IDENT,.STRING)
139: H['INFORMAT'] = CONVERT(.INFORMAT,.STRING)
140: H['INPUT'] = CONVERT(.INPUT,.STRING)
141: H['JUST'] = CONVERT(.JUST,.STRING)
142: H['LINELENGTH'] = CONVERT(.LINELENGTH,.STRING)
143: H['LINENUM'] = CONVERT(.LINENUM,.STRING)
144: H['LMG'] = CONVERT(.LMG,.STRING)
145: H['NEWLINE'] = CONVERT(.NEWLINE,.STRING)
146: H['OUTOS'] = CONVERT(.OUTOS,.STRING)
147: H['OUTPUT'] = CONVERT(.OUTPUT,.STRING)
148: H['PAGELENGTH'] = CONVERT(.PAGELENGTH,.STRING)
149: H['PRINT'] = 'PRINT'
150: H['RESTORE'] = CONVERT(.RESTORE,.STRING)
151: H['RMG'] = CONVERT(.RMG,.STRING)
152: H['SET'] = CONVERT(.SET,.STRING)
153: H['SETQ'] = 'SETQ'
154: H['SETV'] = 'SETV'
155: H['SKIPTEXT'] = CONVERT(.SKIPTEXT,.STRING)
156: H['SPACING'] = CONVERT(.SPACING,.STRING)
157: H['TSET'] = CONVERT(.TSET,.STRING)
158: H['TSETQ'] = 'TSETQ'
159: H['TSETV'] = 'TSETV'
160: H['{'] = '{'
161: H['}'] = '}'
162: H['<'] = '<'
163: H['>'] = '>'
164: *
165: * The blank is referenced frequently outside of the initializing code,
166: * so we give it permanent status
167: *
168: SP = ' '
169: -STITL FUNCTION DEFINITION AND FUNCTION DATA
170: DEFINE('COND()T')
171: *
172: DEFINE('CONTROL_SEQ(STR)T')
173: *
174: DEFINE('DIAG(FNAME,TAG)OLDEXIT,CARD')
175: *
176: DEFINE('DOPROP(PROP,BODY,ORDER)T,I,ARGLIST')
177: *
178: DEFINE('DOWHILE(PRED,BODY)')
179: *
180: DEFINE('DUMPTEXT(STR)IMAGES,I')
181: *
182: DEFINE('END()')
183: *
184: DEFINE('GETLINE()T')
185: GL.P1 = RTAB(1) . GETLINE '-'
186: GL.P2 = SPAN(SP ' ')
187: *
188: DEFINE('GPMIFY(MSTR,ARGLIST)POS,PREFIX,QS')
189: QSPOS = ((H['<'] *QBAL $ QS H['>']) | H['<'] $ QS) @POS
190: QBAL = BREAK('<>') ((H['<'] *QBAL H['>'] *QBAL) | '')
191: NULLARGS = TABLE(3)
192: GPMSTRING = TAB(*POS) BREAKX('{<') $ PREFIX
193: + ((H['{'] @POS *?(GPMIFY = GPMIFY PREFIX MACCALL())) |
194: + (*QSPOS *?(GPMIFY = GPMIFY PREFIX QS)))
195: + *GPMSTRING |
196: + *?(GPMIFY = GPMIFY SUBSTR(MSTR,POS + 1,SIZE(MSTR) - POS))
197: *
198: DEFINE('GPMPRINT(MSTR,ARGLIST)POS,PREFIX,QS')
199: GPMSTRPNT = TAB(*POS) BREAK('{<') $ PREFIX
200: + *(IDENT(PREFIX),PUTCHARS(PREFIX))
201: + ((H['{'] @POS *MACCALL(1)) | (*QSPOS *PUTCHARS(QS)))
202: + *GPMSTRPNT |
203: + *PUTCHARS(SUBSTR(MSTR,POS + 1,SIZE(MSTR) - POS))
204: -EJECT
205: DEFINE('IMAGES(STR)I,T,POS,COUNT')
206: IM.P1 = TAB(*POS)
207: + ((BREAK(BS CS) $ T *?(COUNT = COUNT + SIZE(T))
208: + *?(IMAGES[0] = IMAGES[0] T)
209: + ((BS ('' $ I) *IM.P2) | (CS BS *IM.P3)) @POS *IM.P1) | '')
210: IM.P2 = LEN(1) $ T
211: + *?(IMAGES[I = I + 1] = RPAD(IMAGES[I],COUNT - 1) T)
212: + ((BS *IM.P2) | '')
213: IM.P3 = (NOTANY(CS) $ T BS *?(IMAGES[0] = IMAGES[0] T) *IM.P3) | ''
214: *
215: DEFINE('IN_SET(TS,INNAME)NEW_INUNIT,ISNAME,ISVALUE,ISINDEX')
216: IS_ALPATT = BREAK('=') . ISNAME LEN(1) REM . ISVALUE
217: *
218: DEFINE('IN_READ(INUNIT,INNAME)INSET_PEND')
219: *
220: DEFINE('JUST(JUST,LEN,T)POS,PREFIX')
221: JU.P1 = *GE(LEN = LEN - 1) ((TAB(*POS) | TAB(POS = 0)) LEN(1)
222: + BREAK(SP) SPAN(SP)) . PREFIX @POS
223: *
224: DEFINE('LSIZE(STR)T')
225: *
226: DEFINE('LSUBSTR(STR,N,LEN)T')
227: LS.P1 = LEN(1) ((BS (*LS.P1 | '')) | *?(T = T + 1))
228: LS.P2 = ARBNO(LS.P1) *EQ(T,N - 1) *?(T = 0) ARBNO(LS.P1) . LSUBSTR
229: + *EQ(T,LEN)
230: *
231: DEFINE('MACCALL(PFLG)AL1,AL2,AL,T,MACNAME,MACRO,STPOS,SETNAME'
232: + ',SETTYPE,QN,ARG')
233: MC.P1 = TAB(*POS) *MBAL H['}'] @POS
234: MBAL = BREAK('{}<') ((H['{'] *MBAL H['}'] *MBAL) |
235: + (H['<'] *QBAL H['>'] *MBAL) | '')
236: GPMNAME = TAB(*POS) BREAK('{< }') $ PREFIX
237: + ((((H['{'] @POS *?(MACNAME = MACNAME PREFIX MACCALL())) |
238: + (*QSPOS *?(MACNAME = MACNAME PREFIX QS)))
239: + *GPMNAME) |
240: + *?(MACNAME = REPLACE(MACNAME PREFIX,LOWLETS,UPLETS)))
241: GPMARG = TAB(*POS) BREAK('{<,}') $ PREFIX
242: + ((((H['{'] @POS ((*IDENT(QN) *?(ARG = ARG PREFIX MACCALL())) |
243: + (*DIFFER(QN) (*MBAL H['}']) $ QS @POS
244: + *?(ARG = ARG PREFIX '{' QS)))) |
245: + (*QSPOS *?(ARG = ARG PREFIX
246: + (IDENT(QN) QS, '<' QS '>'))))
247: + *GPMARG) | *?(ARG = ARG PREFIX))
248: GPMARG1 = ('@' @POS *GPMARG *?(ARG = MACDEF(ARG))) | *GPMARG
249: GPMARGS = H['}'] | ',' @POS '' $ ARG *GPMARG1
250: + *?(AL[T = T + 1] = ARG) *GPMARGS
251: GPMCALL = *GPMNAME *?(AL = TABLE(3))
252: + *?(MACNAME ? MC.DOTNAME = '', '') (H['}'] | SPAN(SP)
253: + @POS FENCE *?(QN = AEPROP[MACNAME])
254: + *GPMARG1 *?(AL[T = 1] = ARG) *GPMARGS) @POS
255: MC.DOTNAME = (('SET' | 'TSET') ('V' | '')) . SETTYPE '.'
256: *
257: DEFINE('MACDEF(MNAME)PROP,T')
258: PROPPATT = BREAK('\') . MNAME LEN(1) REM . PROP
259: *
260: DEFINE('OVER(STR,STR2)P,P2,T,T2')
261: OV.P0 = LEN(1) ((BS *OV.P0) | '')
262: OV.P1 = TAB(*P) (*OV.P0 | '') $ T @P
263: OV.P2 = TAB(*P2) (*OV.P0 | *DIFFER(T)) $ T2 @P2
264: *
265: DEFINE('PAGEIT(T)LINE,NOPAGE')
266: *
267: DEFINE('PUTBLANK(T)')
268: *
269: DEFINE('PUTBREAK(T)')
270: *
271: DEFINE('PUTCHARS(STR)T,P,CNT')
272: PC.P0 = *(PC.BS = ) BREAK(BS) *?(PC.BS = 1)
273: PC.P1 = TAB(*$LINELENGTH) $ T (*IDENT(PC.BS) | *?(CNT = LSIZE(T))
274: + (*EQ(CNT,$LINELENGTH) |
275: + ARB LEN(1) $ T *EQ(CNT = CNT + (IDENT(T,BS) -1,1),
276: + $LINELENGTH))) @P
277: PC.P2 = (TAB(*(SIZE(LINE) - P)) (BREAK(SP) | '')) $ LINE
278: + (SPAN(SP) | '') REM $ STR
279: *
280: DEFINE('PUTLINE(LINE)')
281: *
282: DEFINE('READ()T')
283: *
284: DEFINE('RESTORE()T')
285: *
286: DEFINE('STT(MNAME,VAL,TS)PROP,T')
287: PROPVALS = TABLE()
288: PROPSTKS = TABLE()
289: DATA('STKITM(VAL,NEXT)')
290: TSETSTK = TABLE(31)
291: PROPSTKS[''] = TSETSTK
292: *
293: DEFINE('SKIPTEXT(STR)T')
294: -STITL DEFINE THE BASE MACROS
295: SETTRAP = TABLE(17)
296: FAILEXP = *EQ(1,0)
297: GT0EXP = *((VAL = CONVERT(VAL,.INTEGER)) GT(VAL,0))
298: GE0EXP = *((VAL = CONVERT(VAL,.INTEGER)) GE(VAL,0))
299: PRED = *(APPLY(MACNAME,AL1,AL2),'1')
300: MACROS = TABLE(181)
301: AEPROP = TABLE(81)
302: PROPVALS[''] = MACROS
303: PROPVALS['*'] = AEPROP
304: SETTRAP[H['BIAS']] = *(INTEGER(VAL) GE($LMG - 1 + VAL,0)
305: + (LMGCHARS = DUPL(SP,$LMG - 1 + VAL)))
306: MACROS['BRK'] = *PUTBREAK(0)
307: SETTRAP[H['BSLACK']] = GE0EXP
308: MACROS['CAB'] = H['>']
309: MACROS[H['CODE']] = *?(MACROS[REPLACE(AL1,LOWLETS,UPLETS)] =
310: + CONVERT(AL2,.EXPRESSION))
311: MACROS[H['COND']] = *COND()
312: AEPROP[H['COND']] = 1
313: MACROS['CREPROP'] = *?(DIFFER(AL1) (PROPVALS[AL1] = TABLE(AL2)),
314: + &ERRTYPE = 307)
315: MACROS['CS'] = *CONTROL_SEQ(AL1)
316: MACROS['D'] = *(CONVERT(MACDEF(AL1),.STRING),
317: + APPLY((DIFFER(PFLG) .GPMPRINT, .GPMIFY), '{' AL1 '}',
318: + NULLARGS))
319: MACROS['DELPROP'] = *?(DIFFER(AL1) (PROPVALS[AL1] = ),
320: + &ERRTYPE = 307)
321: MACROS['DIAG'] = *DIAG()
322: MACROS[H['DIFFER']] = PRED
323: MACROS[H['DOPROP']] = *DOPROP(GPMIFY(AL1),AL2,GPMIFY(AL[3]))
324: AEPROP[H['DOPROP']] = 1
325: MACROS[H['DOWHILE']] = *DOWHILE(AL1,AL2)
326: AEPROP[H['DOWHILE']] = 1
327: MACROS[H['END']] = *END()
328: MACROS['EQ'] = PRED
329: MACROS['EVEN'] = *(EQ(REMDR(AL1,2),0), 1)
330: MACROS['GE'] = PRED
331: MACROS['GT'] = PRED
332: MACROS[H['HS']] = '~'
333: SETTRAP[H['HS']] = *(HS = SUBSTR(VAL,1,1))
334: MACROS[H['IDENT']] = PRED
335: SETTRAP[H['INPUT']] = *(?(T[MNAME] = VAL) ?(MNAME = FAILEXP)
336: + ?IN_STT(TS,AL2))
337: SETTRAP[H['LINELENGTH']] = *(STT('RMG',CONVERT(VAL,.INTEGER) +
338: + $LMG - 1) ?(MNAME = FAILEXP))
339: MACROS['LE'] = PRED
340: MACROS['LEQ'] = PRED
341: MACROS['LGE'] = PRED
342: MACROS['LGT'] = PRED
343: MACROS['OUTSTREAM'] = *LINE
344: SETTRAP['OUTSTREAM'] = *(?(LINE = VAL) ?(MNAME = FAILEXP))
345: MACROS[H['LINENUM']] = 1
346: SETTRAP[H['LINENUM']] = *(?PUTBREAK(0)
347: + (GE(VAL,$LINENUM), PUTBREAK(30000))
348: + ?PUTBREAK(VAL - $LINENUM)
349: + ?(MNAME = FAILEXP))
350: SETTRAP[H['LMG']] = *(INTEGER(VAL) GT(VAL + $BIAS,0)
351: + LE(VAL,$RMG)
352: + ?($LINELENGTH = $RMG - VAL + 1)
353: + (LMGCHARS = DUPL(SP,VAL - 1 + $BIAS)))
354: -EJECT
355: MACROS['LLE'] = PRED
356: MACROS['LLT'] = PRED
357: MACROS['LNE'] = PRED
358: MACROS['LS'] = *PUTBREAK((CONVERT(AL1,.INTEGER), &ERRTYPE = 303))
359: MACROS['LT'] = PRED
360: MACROS['NE'] = PRED
361: MACROS['OAB'] = H['<']
362: MACROS['ODD'] = *(NE(REMDR(AL1,2),0), 1)
363: SETTRAP[H['OUTPUT']] = *(ENDFILE(1)
364: + OUTPUT(.OUTVAR,1,REPLACE(VAL,LOWLETS,UPLETS)
365: + (DIFFER($OUTOS), NCSW)))
366: MACROS['OS'] = *OVER(AL1,AL2)
367: SETTRAP[H['PAGELENGTH']] = GT0EXP
368: SETTRAP['PAGENUM'] = GE0EXP
369: MACROS[H['PRINT']] = *GPMPRINT(AL1,ARGLIST)
370: AEPROP[H['PRINT']] = 1
371: MACROS[H['RESTORE']] = *RESTORE()
372: SETTRAP[H['RMG']] = *(INTEGER(VAL) GE(VAL,$LMG)
373: + ($LINELENGTH = VAL - $LMG + 1))
374: MACROS[H['SET']] = *STT(AL1,AL2)
375: MACROS[H['SETQ']] = MACROS['SET']
376: AEPROP[H['SETQ']] = 1
377: MACROS[H['SETV']] = *(?STT(AL1,AL2) AL2)
378: MACROS[H['SKIPTEXT']] = *?SKIPTEXT(AL1)
379: MACROS[H['SPACING']] = 1
380: SETTRAP[H['SPACING']] = GT0EXP
381: MACROS[H['TSET']] = *STT(AL1,AL2,'T')
382: MACROS[H['TSETQ']] = MACROS[H['TSET']]
383: AEPROP[H['TSETQ']] = 1
384: MACROS[H['TSETV']] = *(?STT(AL1,AL2,'T') AL2)
385: SETTRAP[H['TSETV']] = FAILEXP
386: -EJECT
387: * Define some names for fast access.
388: *
389: BEGINTEXT = .MACROS[H['BEGINTEXT']]
390: BIAS = .MACROS[H['BIAS']]
391: BSLACK = .MACROS[H['BSLACK']]
392: ENDTEXT = .MACROS[H['ENDTEXT']]
393: FILL = .MACROS[H['FILL']]
394: INFORMAT = .MACROS[H['INFORMAT']]
395: JUST = .MACROS[H['JUST']]
396: LINELENGTH = .MACROS[H['LINELENGTH']]
397: LINENUM = .MACROS[H['LINENUM']]
398: LMG = .MACROS[H['LMG']]
399: NEWLINE = .MACROS[H['NEWLINE']]
400: OUTOS = .MACROS[H['OUTOS']]
401: PAGELENGTH = .MACROS[H['PAGELENGTH']]
402: RMG = .MACROS[H['RMG']]
403: SPACING = .MACROS[H['SPACING']]
404: -STITL INITIALIZING CODE...
405: H =
406: &ERRLIMIT = 9999
407: SETEXIT(.ERROR)
408: *
409: * This defines the GPMDOC-specific errors. They can be nulled if
410: * space is critical.
411: *
412: ERRMSGS = ARRAY('300:310')
413: ERRMSGS[300] = 'No Such File'
414: ERRMSGS[301] = 'Undefined Property'
415: ERRMSGS[302] = 'Too Many Nested Calls (Over ' COMPLEXLIM ')'
416: ERRMSGS[303] = 'Value Must Be Numeric'
417: ERRMSGS[304] = 'Too Many Open Files (Over ' MAXLU - MINLU + 1 ')'
418: ERRMSGS[305] = 'Illegal Value'
419: ERRMSGS[306] = 'No Value To RESTORE'
420: ERRMSGS[307] = 'Illegal Property'
421: *
422: * Set the free LUN stack
423: *
424: GPMIFY('{SET RMG,75}{SET LMG,10}{SET BSLACK,0}{SET PAGELENGTH,55}'
425: + '{SET BIAS,0}{SET SPACING,1}{SET PAGENUM,1}{SET HS,~}'
426: + ,NULLARGS)
427: CURRLU = MAXLU
428: INIT00 CURRLU = GT(CURRLU,MINLU) CURRLU - 1 :F(INIT00A)
429: TSETSTK[.FREELUNS] = STKITM(CURRLU + 1,TSETSTK[.FREELUNS]) :(INIT00)
430: *
431: * Try to read the startup built-in function file
432: *
433: INIT00A IN_READ(CURRLU,BIFFILE) :F(INIT01)
434: GPMIFY('{RESET}',NULLARGS) :(INIT02)
435: *
436: * Here if the startup function file can't be found - Just set essentials
437: *
438: INIT01 TERMINAL = "Warning - Can't Load Startup File " BIFFILE
439: *
440: * Merge from above to try to read the GPMSTART file if it is there
441: *
442: INIT02
443: * EXIT(-2)
444: CMD_LINE = &ERRTEXT
445: *
446: * Try to get in the justify external function
447: *
448: SETEXIT()
449: JUSTIFY_AVAIL = LOAD('JUSTIFY(STRING,STRING,STRING,INTEGER,INTEGER,'
450: + 'STRING)STRING','SYS$LIBRARY:JUSTIFY') 1
451: JUSTIFY_BUFF = DIFFER(JUSTIFY_AVAIL) DUPL(' ',250)
452: SETEXIT(.ERROR)
453: *
454: * Error handling set up. Ready to do initial I/O
455: *
456: OUTPUT(.OUTVAR, OUTUNIT, (MACROS['OUTPUT'] = INITIAL_OUTPUT) NCSW)
457: OUTPUT(.QUERY,QUERYUNIT,INITIAL_OUTPUT NCSW)
458: OUTVAR = CRLF 'GPMDOC V780-6.12/' COLLECT() SP
459: IN_READ(CURRLU,USERSTART)
460: *
461: * We try to pick up the command line text in double quotes,
462: * or failing that, issue a read to the terminal.
463: *
464: CMD_LINE (BREAK('"') LEN(1) SPAN(' ')
465: + (LEN(1) REM) . CMD) :F(INIT04)
466: OUTVAR = ' Processing...'
467: GPMPRINT(CMD,NULLARGS)
468: EOF_FLAG =
469: IN_READ(CURRLU,INSET_PEND) :F(INIT04B)
470: *
471: * Here when finished processing
472: *
473: INIT03 PUTBREAK(0) :(END)
474: *
475: * Come here when there is no initial command to process
476: *
477: INIT04 OUTVAR = ' Ready.'
478: OUTVAR = CRLF
479: *
480: * Loop here until READ cycle completes normally
481: *
482: INIT04A INPUT(.INFILE,CURRLU,INITIAL_INPUT) :F(INIT04C)
483: IN_READ(CURRLU) :S(INIT05)
484: *
485: * Merge here on SET chain failure
486: *
487: INIT04B TERMINAL = 'Requested File Is Not Available'
488: TERMINAL = 'Command Input Established'
489: PUTBREAK(0) :(INIT04A)
490: *
491: * Here when attachment to initial file fails
492: *
493: INIT04C TERMINAL = '* Cannot Read From Command Input *'
494: TERMINAL = ' * Dying in Shame *'
495: INIT05 :(END)
496: -STITL "COND()" - SUPPORT FOR COND MACRO
497: * The COND macro takes the form {COND p1,v1,p2,v2,...,pn,vn} .
498: * Evaluation of COND consists of evaluating each p(i) (predicate) until one
499: * is found that evaluates null. The evaluation of the following v(i) (value)
500: * is then returned as the value of COND . COND is a special form
501: * and thus it is not necessary to quote the predicates or values under normal
502: * circumstances.
503: *
504: COND T = DIFFER(GPMIFY(AL[T + 1],ARGLIST)) T + 2 :S(COND)
505: COND = (DIFFER(PFLG) GPMPRINT(AL[T + 2],ARGLIST),
506: + GPMIFY(AL[T + 2],ARGLIST)) :(RETURN)
507: -STITL "CONTROL_SEQ(STR)" - TURN STR INTO A CONTROL SEQUENCE
508: * A control sequence from STR consists of <BS> characters placed after
509: * each character of STR, making a normalized overstrike sequence , and this
510: * is then preceeded by a <CS><BS> sequence.
511: * The <CS> is to identify a control sequence to the IMAGES routine,
512: * and the backspaces are to force the LSIZE length of the control
513: * sequence to be effectively zero.
514: *
515: CONTROL_SEQ STR (ARB LEN(1) $ T *?(CONTROL_SEQ = CONTROL_SEQ T BS) FAIL)
516: CONTROL_SEQ = (CS BS) CONTROL_SEQ :(RETURN)
517: -STITL "DOWHILE(PRED,BODY)" - SUPPORT FOR DOWHILE MACRO
518: * This routine is called to evaluate BODY repeatedly. The given predicate
519: * PRED is evaluated repeatedly prior to the evaluation of BODY.
520: * The loop continues as long as the predicate evaluates true (null).
521: * The value of DOWHILE is the successive right-concatenations of the
522: * results.
523: *
524: DOWHILE IDENT(GPMIFY(PRED,ARGLIST)) :F(RETURN)
525: DOWHILE = DOWHILE (IDENT(PFLG) GPMIFY(BODY,ARGLIST),
526: + GPMPRINT(BODY,ARGLIST)) :(DOWHILE)
527: -STITL "DOPROP(PROP,BODY,ORDER)" - SUPPORT FOR DOPROP MACRO
528: * o This routine is called to apply the entries in the property
529: * table for property PROP to the macro BODY one at a time.
530: * The body is evaluated in a context where the first argument
531: * is the index name for the property, and the second argument
532: * is the corresponding value.
533: *
534: * o ORDER gives the order in which the entries are presented to
535: * BODY. If, when evaluated, ORDER gives "UP", the entries
536: * are presented in ascending order. Similar remarks apply for
537: * "DOWN". Anything else implies no order.
538: *
539: * o Note that DOPROP should be defined with the AE property, and
540: * PROP and ORDER evaluated before entering this routine.
541: *
542: * o As with DOWHILE, this routine returns the successive concatenations
543: * of the repeated evaluations. (This will be null in the context of
544: * non-null PFLG, since the evaluation is done by GPMPRINT which
545: * returns null.)
546: *
547: DOPROP T = PROPVALS[PROP]
548: *
549: * The null property (MACROS) is illegal (it contains funny stuff),
550: * and so is an undefined property.
551: *
552: (DIFFER(PROP) DIFFER(T), &ERRTYPE = 307)
553: *
554: * A-OK. Convert to an array and sort if necessary.
555: *
556: ORDER = REPLACE(ORDER,LOWLETS,UPLETS)
557: T = CONVERT(T,.ARRAY) :F(RETURN)
558: T = (IDENT(ORDER,'UP') SORT(T,1),
559: + IDENT(ORDER,'DOWN') RSORT(T,1))
560: *
561: * Loop to invoke the body.
562: *
563: I =
564: ARGLIST = TABLE(3)
565: DOP01 I = I + 1
566: ARGLIST[1] = T[I,1] :F(RETURN)
567: ARGLIST[2] = T[I,2]
568: DOPROP = DOPROP (IDENT(PFLG) GPMIFY(BODY,ARGLIST),
569: + GPMPRINT(BODY,ARGLIST)) :(DOP01)
570: -STITL "DUMPTEXT(STR)" - PUT LINE ON OUTPUT FILE
571: * This module puts out a line on the unit attached to OUTVAR. It
572: * checks for begin/end page and handles the multiple printing of
573: * overstruck images.
574: *
575: * First, check for a NEWPAGE condition.
576: *
577: DUMPTEXT (EQ($LINENUM,1) IDENT(NOPAGE) PAGEIT('NEWPAGE'))
578: *
579: * Get rid of hard spaces
580: *
581: STR = REPLACE(STR,HS,SP)
582: *
583: * Check for overstrikes in STR. If so, IMAGES is called to generate
584: * a table containing all the overstrike images of the line (IMAGES[0]=
585: * Principal image). Note that the principal image is always output last.
586: * This is so CRT's will show something reasonable.
587: *
588: STR BSPATT :F(DT02)
589: *
590: * Overstrikes in line. Get all the print images in IMAGES table.
591: *
592: IMAGES = IMAGES(STR)
593: STR = IMAGES[0]
594: *
595: * Loop to dump out the overstrike images (unless OUTOS is disabled)
596: *
597: DT01 OUTVAR = IDENT($OUTOS) DIFFER(IMAGES[I = I + 1])
598: + IMAGES[I] CR :S(DT01)
599: *
600: * Merge here to print the principal image in STR, and force a new line.
601: *
602: DT02 OUTVAR = STR (DIFFER($OUTOS),CRLF)
603: *
604: * Bump LINENUM. If we have reached the end of a page (and paging is
605: * permitted via NOPAGE) then flag and process an endpage condition.
606: *
607: $LINENUM = $LINENUM + 1
608: (LE($LINENUM,$PAGELENGTH), DIFFER(NOPAGE)) :S(RETURN)
609: MACROS['PAGENUM'] = ?PAGEIT('ENDPAGE')
610: + MACROS['PAGENUM'] + 1 :(RETURN)
611: -STITL "GETLINE()" - READ A LOGICAL LINE OF INPUT
612: * o This module returns a single line of GPMDOC input from the unit attached
613: * to INFILE. Logical lines are equivalent to physical lines unless the
614: * physical lines are 'continued' with hyphens at the end. In such cases,
615: * the returned logical lines are the physical lines concatenated together
616: * without the hyphens, and with leading blanks and tabs at the beginning
617: * of continuation lines removed. Logical lines beginning with "!" are
618: * presumed to be comments, and are discarded. If the line read is null,
619: * a single hard space is returned so that no-fill works correctly.
620: *
621: * o The code here also translates tabs to blanks under the fixed assumption
622: * that tabs are set at (input) columns 9, 9+8, 9+2*8, ...
623: *
624: * o The global EOF_FLAG can be set non-null to force a simulated endfile.
625: * If this is done, it will be reset before FRETURNing.
626: *
627: * o If the ENDTEXT macro is non-null, and GETLINE sees the line, it
628: * simulates an end-of-file (FRETURNs)
629: *
630: * o If the INFORMAT macro is non-null (false) then the line is returned as
631: * read, without logical line processing.
632: *
633: * Read the first input line, and fail if no more exist.
634: *
635: GETLINE EOF_FLAG = DIFFER(EOF_FLAG) :S(FRETURN)
636: GETLINE = INFILE :F(FRETURN)
637: *
638: * If the endtext macro is non-null, and this is it, then fail.
639: * Endtext is toggled null when this happens.
640: *
641: $ENDTEXT = DIFFER($ENDTEXT) IDENT(GETLINE,$ENDTEXT) :S(FRETURN)
642: *
643: * If the line is empty, set it to a hard space and return
644: *
645: GETLINE = IDENT(GETLINE) HS :S(RETURN)
646: *
647: * If INFORMAT is non-null, then return the line.
648: *
649: DIFFER($INFORMAT) :S(RETURN)
650: *
651: * Examine the line for a continuation hyphen at the end, and go to the
652: * exit point if not there. If it is, this pattern removes it, and
653: * we merge into the continuation line loop.
654: *
655: GETLINE GL.P1 :F(GL02)
656: *
657: * Loop here on successive continuation lines.
658: *
659: GL01 T = INFILE :F(FRETURN)
660: T GL.P2 =
661: GETLINE = GETLINE T
662: GETLINE GL.P1 :S(GL01)
663: *
664: * Return unless this is a comment line, in which case get the next line.
665: *
666: GL02 GETLINE ANY('!') :S(GETLINE)
667: *
668: * Merge to change tabs to blanks and return
669: *
670: GL03 GETLINE (BREAK(' ') . T LEN(1)) =
671: + RPAD(T,(SIZE(T) / 8) * 8 + 8) :S(GL03)F(RETURN)
672: -STITL "GPMIFY(MSTR,ARGLIST)"
673: * o This routine evaluates MSTR according to GPMDOC rules. They are:
674: * o Ordinary text stands for itself.
675: * o {name arg,arg,...} is a macro call. The actual processing
676: * of the macro call is handled by the pattern calling MACCALL,
677: * with POS pointing past the open brace. The text returned by
678: * MACCALL is appended to the result, with POS having been set
679: * past the close brace, so the scan can continue uninterrupted
680: * inside the same pattern match.
681: * o Material in quotes as: <...material...> is not examined further,
682: * but the outer quotes "<>" are stripped away before material is
683: * appended to the result.
684: * All of this takes place inside of a single pattern match, which is
685: * forming the result in GPMIFY as it goes, by using embedded assignments.
686: * o Note that this whole process is recursive, since the pattern can call
687: * MACCALL, which in turn can call for a GPMIFY, etc.
688: * o ARGLIST is the table of arguments passed through, to be handed to
689: * MACCALL in case a macro call is seen.
690: *
691: GPMIFY MSTR GPMSTRING :(RETURN)
692: -STITL "GPMPRINT(MSTR,ARGLIST)"
693: * o GPMPRINT is just like GPMIFY, except that the result is null, all
694: * evaluations are sent to PUTCHARS as they are scanned out. It is called
695: * when the result of the evaluation is to be printed, and not used further.
696: *
697: GPMPRINT MSTR GPMSTRPNT :(RETURN)
698: -STITL "IMAGES(STR)" - GENERATE TABLE OF OVERSTRIKE IMAGES OF STR
699: * This module returns a TABLE indexed numerically starting from zero (integer).
700: * Each element contains one overstrike image of STR. If STR contains no
701: * overstrikes, element 0 would contain just the given STR. If there were
702: * overstrikes, then element 0 would contain the 'principal image' of STR,
703: * and successively higher table elements would contain the higher orders
704: * of overstrikes. The first null value in element "i" marks the end
705: * of the images. Note that the images are not right padded to the same
706: * lengths.
707: *
708: IMAGES IMAGES = TABLE(1)
709: IM01 STR IM.P1
710: IMAGES[0] = IMAGES[0] SUBSTR(STR,POS + 1) :(RETURN)
711: -STITL "IN_READ(INUNIT,INNAME)" - Access initial input files
712: * o This module provides access to the READ routine given a unit (INUNIT)
713: * and file (INNAME). If INNAME is null, the current binding is assumed,
714: * and no initial association is set.
715: *
716: * o INSET_PEND is set by IN_SET when a "real" input SET is performed to
717: * give the name of the next file to associate. This routine
718: * handles it by looping on input associations until it is null.
719: *
720: * o This routine fails if an association cannot be made because of
721: * association failure. No error is flagged.
722: *
723: IN_READ (IDENT(INNAME), INPUT(.INFILE,INUNIT,INNAME)) :F(FRETURN)
724: INSET_PEND =
725: READ()
726: INNAME = DIFFER(INSET_PEND) INSET_PEND :S(IN_READ)F(RETURN)
727: -STITL "IN_STT(TS,INNAME)" - SET INPUT FILE
728: * o This routine is called as a result of the SETTRAP on INPUT.
729: * It will be called for SET, TSET or RESTORE on the INPUT macro.
730: *
731: * o TS provides the type of set (ref. routine SET).
732: *
733: * o INNAME is the second argument of the set (filename). If it is
734: * null, then this is a "pseudo-read", implying no new association
735: * is to be made.
736: *
737: * o There are three globals used by this routine:
738: *
739: * o INUNIT is the current logical unit number. NEW_INUNIT is a
740: * local which is assigned INUNIT (again) if this is a pseudo-read
741: * and passed to IN_READ.
742: *
743: * o INSET_PEND is used for SETs to communicate the SET filename
744: * to IN_READ.
745: *
746: * o EOF_FLAG is used to signal GETLINE to force an EOF on the
747: * next call.
748: *
749: * First, set the error return point, and check for TSETs and RESTOREs
750: * A forced RESTORE is handled by simply setting the EOF_FLAG to tell
751: * GETLINE to simulate an EOF on the next read.
752: *
753: IN_SET EOF_FLAG = IDENT(TS,'R') 1 :S(RETURN)
754: IDENT(TS,'T') :S(IS01)
755: *
756: * This is a standard SET. The way this is handled is to set EOF_FLAG
757: * to force close-out of the current read, and to save the SET filename
758: * in INSET_PEND. When the current READ returns (below), INSET_PEND
759: * is checked, and if there is a SET pending, the TSET logic is
760: * followed to open the new file instead of reverting to the old one.
761: * Of course, if the SET filename is null, we are just setting
762: * the current file (stupid) and a simple return is sufficient.
763: *
764: EOF_FLAG = DIFFER(INNAME) 1
765: INSET_PEND = INNAME :(RETURN)
766: -EJECT
767: *
768: * This is a TSET. Arguments (3,4,...) are now processed until a null
769: * argument is found. These arguments are of the form NAME=VALUE and
770: * cause an automatic TSET of the given macro name with the indicated value.
771: * The corresponding RESTORE is also automatic when the READ finishes.
772: *
773: IS01 ISINDEX = 3
774: IS00 IDENT(AL[ISINDEX]) :S(IS02)
775: AL[ISINDEX] IS_ALPATT :F(IS00A)
776: STT(ISNAME,ISVALUE,'T')
777: IS00A ISINDEX = ISINDEX + 1 :(IS00)
778: *
779: * Here for TSET. The process is essentially just to call IN_READ.
780: * If this is not a pseudo-read, then we unstack a free unit to give
781: * it, otherwise, its a pseudo-read, and we give it the one being
782: * used now.
783: *
784: IS02 NEW_INUNIT = IDENT(INNAME) INUNIT :S(IS03)
785: (DIFFER(TSETSTK[.FREELUNS]), &ERRTYPE = 304) :F(RETURN)
786: NEW_INUNIT = VAL(TSETSTK[.FREELUNS])
787: TSETSTK[.FREELUNS] = NEXT(TSETSTK[.FREELUNS])
788: *
789: * Merge here for pseudo-read to issue the call to IN_READ.
790: *
791: IS03 (IN_READ(NEW_INUNIT, INNAME), &ERRTYPE = 305) :F(IS04)
792: (DIFFER(INNAME) ENDFILE(NEW_INUNIT))
793: *
794: * Merge here after read error to restack the old lun if not pseudo-read,
795: * then restore the old environment.
796: *
797: IS04 TSETSTK[.FREELUNS] = DIFFER(INNAME)
798: + STKITM(NEW_INUNIT,TSETSTK[.FREELUNS])
799: INPUT(.INFILE,INUNIT)
800: *
801: * Now the entry keyword arguments are restored
802: *
803: IS05 ISINDEX = GE(ISINDEX,3) ISINDEX - 1 :F(RETURN)
804: AL[ISINDEX] IS_ALPATT :F(IS05)
805: STT(ISNAME,,'R') :(IS05)
806: -STITL "JUST(JUST,LEN,T)"
807: * o JUST is called to justify a string JUST with LEN additional
808: * blanks.
809: *
810: * o If T is non-zero, then the 'odd' blanks are padded on the right.
811: * Otherwise they are jammed in from the left.
812: *
813: JUST JUST = NE(T,0) REVERSE(JUST)
814: JU01 JUST JU.P1 = PREFIX SP :S(JU01)
815: JUST = NE(T,0) REVERSE(JUST) :(RETURN)
816: -STITL "LSIZE(STR)"
817: * o LSIZE returns the number of the final print position of STR (including
818: * backspace characters). If there are no backspace characters in STR,
819: * then this is the same as SIZE(STR). If there are no trailing backspaces
820: * and STR is normalized, then LSIZE gives the number of print positions
821: *
822: LSIZE STR BREAKX(BS) *?(T = T + 1) FAIL
823: LSIZE = SIZE(STR) - 2 * T :(RETURN)
824: -STITL "LSUBSTR(STR,N,LEN)" - TAKE SUBSTRING WITH BACKSPACING
825: * o LSUBSTR semantics are the same as SPITBOL's SUBSTR function,
826: * except that it accounts for backspace characters.
827: *
828: LSUBSTR LEN = EQ(LEN,0) LSIZE(STR) - N + 1
829: STR LS.P2 :S(RETURN)F(FRETURN)
830: -STITL "MACCALL(PFLG)" - EVALUATE A MACRO CALL
831: * This is the heart of the GPMDOC interpreter in that it processes macro
832: * calls ({Name Arg1,Arg2,...}). PFLG is the stream indicator. If it is
833: * null, the result is to be returned as a string. If PFLG is nonnull, then
834: * the results are going to the PUTCHARS output stream and null is returned.
835: * This module is entered from GPMIFY or GPMPRINT when they encounter a macro
836: * call open brace. The global (to MACCALL) variable POS is set to the
837: * character index in the global STR where the macro call begins. MACCALL
838: * returns with POS set to the index in MSTR past the macro call.
839: *
840: * Save the starting index in case a error occurs in any of the evaluations
841: * or scans, then check to be sure we haven't exceeded the recursion limit
842: * in COMPLEXLIM. If so, then we scan for a matching close brace for this
843: * call, which sets POS for the error routine, and then flag an error 302.
844: *
845: MACCALL STPOS = POS - 1
846: LT(&FNCLEVEL, COMPLEXLIM) :S(MC01)
847: MSTR MC.P1
848: &ERRTYPE = 302
849: *
850: * Here we match out the name and arguments. If the scan fails then we
851: * get out. Note that this pattern can recurse on MACCALL if the macro
852: * call being scanned contains embedded macro calls.
853: * This pattern also processes extended SETs by placing the type of
854: * extended set (SET,TSET,SETV or TSETV) in SETTYPE and the extension
855: * in MACNAME. Later on we switch things around and loop back to do the
856: * set.
857: *
858: MC01 MSTR GPMCALL :F(MC07)
859: *
860: * Check for an extended SET.
861: SETNAME = DIFFER(SETTYPE) AL[1] :F(MC02)
862: *
863: * Got one. Look up the definition of the first arg to be applied
864: * in the macro call, and evaluate it in case it turns out to be expression-
865: * valued.
866: *
867: AL[1] = MACDEF(AL[1])
868: AL[1] = IDENT(DATATYPE(AL[1]),'EXPRESSION') EVAL(AL[1])
869: *
870: * Merge here when the arguments and macro name are correctly set for
871: * evaluation. Look up the definition of MACNAME, and if it is not
872: * a system macro (datatype Expression), go evaluate the string.
873: *
874: MC02 IDENT(DATATYPE(MACRO = MACDEF(MACNAME)),'EXPRESSION') :F(MC04)
875: *
876: * Come here to evaluate a macro that is an expression (merge from extended
877: * set looping back to do the final set). We set AL1 and AL2 to the first
878: * and second arguments in order to save some time and space since they are
879: * so frequently referenced in the system macros. Then we evaluate the
880: * expression and if results are going to the output stream (PFLG=nonnull) then
881: * we send them there.
882: *
883: MC03 AL1 = AL[1]; AL2 = AL[2]
884: MACCALL = EVAL(MACRO)
885: (DIFFER(PFLG) DIFFER(MACCALL) IDENT(SETTYPE) PUTCHARS(MACCALL))
886: + :(MC05)
887: -EJECT
888: *
889: * Come here when MACRO is set to a string to be evaluated. We call either
890: * GPMIFY or GPMPRINT depending on where the output is to go.
891: *
892: MC04 MACCALL = ((IDENT(PFLG), DIFFER(SETTYPE))
893: + GPMIFY(MACRO,AL), GPMPRINT(MACRO,AL))
894: *
895: * Merge here to check for an extended set in progress. If we don't need
896: * to process the second part of an extended set, we just go to the exit
897: * point.
898: *
899: MC05 MACRO = DIFFER(SETTYPE) MACROS[SETTYPE] :F(MC06)
900: *
901: * We need to loop back to process the SET part of an extended set.
902: * Switch around the arguments to make things work out. Then loop back.
903: *
904: SETTYPE = ; AL[1] = SETNAME ; AL[2] = MACCALL :(MC03)
905: *
906: * Come here to exit, setting the result null if the result was printed.
907: *
908: MC06 MACCALL = DIFFER(PFLG) :(RETURN)
909: *
910: * Come here when the macro scan fails. We reset the scan pointer and FRETURN.
911: *
912: MC07 POS = STPOS :(FRETURN)
913: -STITL "MACDEF(MNAME)" - RETURN DEFINITION OF A MACRO.
914: * o This routine is invoked by MACCALL and some of the system macros to
915: * look up the definition of a given macro name MNAME.
916: *
917: * Try for an argument, and if not that then get the definition from the
918: * MACROS table.
919: *
920: MACDEF MNAME PROPPATT
921: T = PROPVALS[PROP]
922: (DIFFER(T), &ERRTYPE = 301) :F(FRETURN)
923: MACDEF = (IDENT(PROP) INTEGER(MNAME) ARGLIST[CONVERT(MNAME,.INTEGER)],
924: + T[REPLACE(MNAME,LOWLETS,UPLETS)]) :(RETURN)
925: -STITL "OVER(STR,STR2)" - OVERSTRIKE TWO STRINGS
926: * This module returns STR overstruck by STR2. It insures that the result
927: * string is properly aligned on the right if STR and STR2 are of different
928: * lengths. It also insures that no two backspace characters appear
929: * consecutively, and that no overstruck blanks are introduced into the
930: * result image. This is the form assumed by the other system routines,
931: * so this should be the only routine capable of introducing backspace
932: * characters into the text.
933: *
934: * Since STR and STR2 may contain backspaces themselves, we loop
935: * here to match out the next run of characters from STR and STR2
936: * that 'map' visually into a single character. If the STR2 match
937: * fails, then we have reached the end of both strings and we return.
938: * Otherwise, we append the characters, checking for nulls (end of string),
939: * and blanks.
940: *
941: OVER STR OV.P1
942: STR2 OV.P2 :F(RETURN)
943: OVER = OVER (IDENT(T) T2, IDENT(T2) T, IDENT(T,SP) T2,
944: + IDENT(T2,SP) T, T BS T2) :(OVER)
945: -STITL "PAGEIT(T)" - PROCESS NEWPAGE/ENDPAGE CONDITIONS
946: * o This module is entered to process a page event in GPMDOC.
947: *
948: * o "T" is either to "NEWPAGE" or "ENDPAGE" as appropriate.
949: *
950: * o The routine stacks NEWLINE, SPACING, LMG and RMG, and sets
951: * NOPAGE to a non-null value to prevent recursive page conditions
952: * from occurring. $LINENUM is set to one both before
953: * and after the page condition. Processing the
954: * condition itself consists of evaluating the appropriate macro.
955: *
956: * o LINE is local here, since we need a separate output stream for
957: * the page evaluation.
958: *
959: PAGEIT (STT('NEWLINE',,'T') ?STT('SPACING',1,'T')
960: + ?STT('LMG',10,'T') ?STT('RMG',75,'T'))
961: NOPAGE = 1
962: (GPMPRINT(MACROS[T],NULLARGS) ?PUTBREAK(0))
963: $LINENUM = IDENT(T,'ENDPAGE') 1
964: (STT('NEWLINE',,'R') ?STT('SPACING',,'R')
965: + ?STT('LMG',,'R') ?STT('RMG',,'R')) :(RETURN)
966: -STITL "PUTBLANK(T)" - EMIT BLANK LINES
967: * This module is entered to send "T" blank lines to the document.
968: * It performs checking to see when a new page has occurred ($LINENUM = 1),
969: * and stops there, regardless.
970: *
971: PUTBLANK T = GT(T,0) GT($LINENUM,1) ?DUMPTEXT() T - 1 :F(RETURN)S(PUTBLANK)
972: -STITL "PUTBREAK(T)" - PERFORM A LINE BREAK WITH SPACING
973: * This module will break the current text in "LINE" to the output, and
974: * if T is greater than zero, will put out "T" additional blank lines.
975: * If blank lines are emitted, the BSLACK condition is checked after the
976: * spacing is performed, and if less than $BSLACK lines remain, the page
977: * is run out. Note that if T>0, at least one blank line is emitted -
978: * this is so spacing can occur at the top of a page which would otherwise
979: * be defeated by PUTBLANK.
980: *
981: PUTBREAK LINE = TRIM(LINE)
982: (DIFFER(LINE) PUTLINE(LINE) ?(LINE = ))
983: (GT(T,0) ?DUMPTEXT() ?PUTBLANK(T - 1)
984: + ?(GE($PAGELENGTH - $LINENUM, $BSLACK), DIFFER(NOPAGE),
985: + PUTBLANK(30000)))
986: + :(RETURN)
987: -STITL "PUTCHARS(STR)" - APPEND CHARACTERS TO OUTPUT STREAM
988: * This module suffixes STR to the current LINE, and breaks off a chunk for
989: * printing if its LSIZE becomes greater than $LINESIZE.
990: *
991: * First, suffix on the characters
992: *
993: PUTCHARS LINE = DIFFER(STR) LINE STR :F(RETURN)
994: *
995: * Check to see if LINE could possibly (ignoring possible backspaces) be too big
996: *
997: PC01 LE(SIZE(LINE), $LINELENGTH) :S(RETURN)
998: *
999: * Set the BS flag (PC.BS) according to whether LINE contains any
1000: * backspace characters
1001: *
1002: LINE PC.P0 :F(PC02)
1003: *
1004: * LINE contains backspace characters, check the LSIZE to see if it is
1005: * really too big.
1006: *
1007: LE(LSIZE(LINE), $LINELENGTH) :S(RETURN)
1008: *
1009: * Merge here to print a chunk. Locate a suitable breakpoint (preferably at
1010: * the closest blank). First set P to be the position of the first
1011: * printing character at line position $LINELENGTH.
1012: *
1013: PC02 LINE PC.P1
1014: *
1015: * OK. Now find the suitable breakpoint by scanning backwards in the
1016: * LINE for a blank, starting at P. (We can't really scan backwards,
1017: * so we reverse LINE instead.
1018: *
1019: REVERSE(LINE) PC.P2
1020: LINE = REVERSE(TRIM(LINE))
1021: STR = TRIM(REVERSE(STR))
1022: *
1023: * STR now has the text for printing that was split off from LINE. Justify
1024: * if called for.
1025: *
1026: STR = IDENT($JUST)
1027: + (DIFFER(JUSTIFY_AVAIL)
1028: + JUSTIFY(STR,JUSTIFY_BUFF,
1029: + JUSTIFY_BUFF,$LINELENGTH,
1030: + PC.FLIP = 1 - PC.FLIP,BS),
1031: + JUST(STR,
1032: + $LINELENGTH - APPLY((DIFFER(PC.BS) .LSIZE, .SIZE),STR),
1033: + PC.FLIP = 1 - PC.FLIP))
1034: *
1035: * Now print the text
1036: *
1037: PUTLINE(STR) :(PC01)
1038: -STITL "PUTLINE(LINE)" - EMIT TEXT.
1039: * o This module sends "LINE" to DUMPTEXT after appending the left margin and
1040: * evaluating any NEWLINE event that exists. It also handles SPACING if
1041: * if it is greater than 1.
1042: *
1043: PUTLINE (DIFFER(LINE) DUMPTEXT(LMGCHARS (IDENT($NEWLINE),
1044: + ?GPMIFY($NEWLINE,NULLARGS)) LINE)
1045: + ?(LE($SPACING,1), PUTBLANK($SPACING - 1))) :(RETURN)
1046: -STITL "READ()" - READ FROM A FILE
1047: * o This routine reads from the current input file, and ships the text
1048: * to the macro evaluator. (If the INFORMAT macro is non-null, then
1049: * the text is sent straight to PUTCHARS withou processing.)
1050: * It returns when GETLINE signals an EOF.
1051: *
1052: * o The data read is passed to the evaluator for printing. The line
1053: * fill macro is examined here, and a space or a line break given
1054: * at the end of each line depending on its setting.
1055: *
1056: * o If the BEGINTEXT macro is non-null, then text is skipped to the
1057: * line following. When this happens, STARTTEXT is toggled null.
1058: *
1059: READ
1060: *
1061: * If BEGINTEXT is non-null, read lines until we have it.
1062: *
1063: (DIFFER($BEGINTEXT) SKIPTEXT($BEGINTEXT))
1064: *
1065: * Loop here on input lines
1066: *
1067: RE01 T = GETLINE() :F(RETURN)
1068: (DIFFER($INFORMAT) PUTCHARS(T) PUTBREAK(0),
1069: + GPMPRINT(T,NULLARGS)
1070: + ?(IDENT(LINE), IDENT($FILL) PUTCHARS(SP),
1071: + PUTBREAK(0))) :(RE01)
1072: -STITL "RESTORE()" - SUPPORT FOR THE RESTORE MACRO
1073: * o This routine will call for a restore-type set for each argument
1074: * mname until a null one is encountered.
1075: *
1076: RESTORE STT(DIFFER(AL[T = T + 1]) AL[T],,'R') :S(RESTORE)F(RETURN)
1077: -STITL "STT(MNAME,VAL,TS)" - SET MACRO VALUE
1078: * o This is the central logic for all SET, TSET and RESTORE macro forms.
1079: *
1080: * o MNAME is the name of the macro, which is translated to upper case.
1081: *
1082: * o VAL is the value to be set; it is ignored for RESTORE.
1083: *
1084: * o TS is the Type-of-Set-FLAG. It is null for regular SETs, or 'T' or
1085: * 'R' respectively. The flag is used to control processing within
1086: * this routine, and also can be used by code executed by SETTRAPs.
1087: *
1088: * o If a SETTRAP entry is defined for the macro, it is evaluated before
1089: * the value is set. This evaluation must succeed or a bad value error
1090: * is signalled.
1091: *
1092: STT MNAME = REPLACE(MNAME,LOWLETS,UPLETS)
1093: MNAME PROPPATT
1094: T = PROPVALS[PROP]
1095: (DIFFER(T), &ERRTYPE = 301) :F(RETURN)
1096: DIFFER(TS,'T') :S(SET01)
1097: PROPSTKS[PROP] = IDENT(PROPSTKS[PROP]) TABLE()
1098: PROPSTKS[PROP][MNAME] = STKITM(T[MNAME],PROPSTKS[PROP][MNAME])
1099: *
1100: * Merge after TSET (if any) has been pushed.
1101: *
1102: SET01 DIFFER(TS,'R') :S(SET02)
1103: (DIFFER(PROPSTKS[PROP][MNAME]), &ERRTYPE = 306) :F(RETURN)
1104: VAL = VAL(PROPSTKS[PROP][MNAME])
1105: PROPSTKS[PROP][MNAME] = NEXT(PROPSTKS[PROP][MNAME])
1106: *
1107: * Here after RESTORE (if any) has been popped.
1108: *
1109: SET02 (DIFFER(PROP), IDENT(SETTRAP[MNAME]),
1110: + EVAL(SETTRAP[MNAME]), &ERRTYPE = 305) :F(RETURN)
1111: T[MNAME] = VAL :(RETURN)
1112: -STITL "SKIPTEXT(STR)" - SKIP INPUT LINES
1113: * o This routine is called to read and skip input text lines until
1114: * one is found that matches STR.
1115: *
1116: SKIPTEXT T = INFILE :F(RETURN)
1117: IDENT(T,STR) :S(RETURN)F(SKIPTEXT)
1118: -STITL ERROR PROCESSING APPENDAGE
1119: * o This error appendage is always executed in the local context of whatever
1120: * procedure caused it to be invoked
1121: *
1122: ERROR LAST = &LASTNO :(TRAP)
1123: TRAP &ERRTEXT = GT(&ERRTYPE,300) ERRMSGS[&ERRTYPE]
1124: TERMINAL = 'Error on Page: ' MACROS['PAGENUM'] ', Line: '
1125: + $LINENUM ' [' LAST ']' ' ... '
1126: PUTCHARS(TERMINAL = SUBSTR(MSTR, STPOS + 1, POS - STPOS) '-'
1127: + &ERRTEXT)
1128: SETEXIT(.ERROR)
1129: :(CONTINUE)
1130: *
1131: * This appendage is useful for debugging purposes
1132: *
1133: DIAG TERMINAL = 'Debugger (From: ' FNAME '; Tag: ' TAG
1134: + ') - Control-Z to continue'
1135: OLDEXIT = SETEXIT(.DIAG03)
1136: DIAG01 SETEXIT(.DIAG03)
1137: CARD = TERMINAL :F(DIAG02)
1138: TERMINAL = EVAL(CARD) :(DIAG01)
1139: DIAG02 SETEXIT(OLDEXIT) :(RETURN)
1140: DIAG03 TERMINAL = &ERRTEXT :(DIAG01)
1141: *
1142: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.