![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to gpmdoc.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 gpmdoc.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('SET(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_SET(TS,AL2)) ! 337: SETTRAP[H['LINELENGTH']] = *(SET('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']] = *SET(AL1,AL2) ! 375: MACROS[H['SETQ']] = MACROS['SET'] ! 376: AEPROP[H['SETQ']] = 1 ! 377: MACROS[H['SETV']] = *(?SET(AL1,AL2) AL2) ! 378: MACROS[H['SKIPTEXT']] = *?SKIPTEXT(AL1) ! 379: MACROS[H['SPACING']] = 1 ! 380: SETTRAP[H['SPACING']] = GT0EXP ! 381: MACROS[H['TSET']] = *SET(AL1,AL2,'T') ! 382: MACROS[H['TSETQ']] = MACROS[H['TSET']] ! 383: AEPROP[H['TSETQ']] = 1 ! 384: MACROS[H['TSETV']] = *(?SET(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 = 999999 ! 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_SET(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: SET(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: SET(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 (SET('NEWLINE',,'T') ?SET('SPACING',1,'T') ! 960: + ?SET('LMG',10,'T') ?SET('RMG',75,'T')) ! 961: NOPAGE = 1 ! 962: (GPMPRINT(MACROS[T],NULLARGS) ?PUTBREAK(0)) ! 963: $LINENUM = IDENT(T,'ENDPAGE') 1 ! 964: (SET('NEWLINE',,'R') ?SET('SPACING',,'R') ! 965: + ?SET('LMG',,'R') ?SET('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 SET(DIFFER(AL[T = T + 1]) AL[T],,'R') :S(RESTORE)F(RETURN) ! 1077: -STITL "SET(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: SET 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.