PROCS
IDENT PROCS PROCS 1
TITLE RUN - TIME FUNCTIONS PROCS 2
* FOR A LISTING OF THE SNODEF COMDECK, CALLED BELOW, SEE MAINLUP. PROCS 3
LIST -L PROCS 4
*CALL,SNODEF PROCS 5
LIST L PROCS 6
* PROCS 7
* ERROR PROCS 8
EXT RTERROR PROCS 9
EXT ERR14 PROCS 10
EXT ERR27,ERR29 PROCS 11
EXT ERR30,ERR31,ERR32,ERR35,ERR39 PROCS 12
EXT ERR40,ERR42,ERR44,ERR48,ERR49 PROCS 13
EXT ERR50,ERR53,ERR56,ERR57,ERR59 PROCS 14
* MAINLUP PROCS 15
EXT NEXTMIC,SNDMIC,FAIL PROCS 16
EXT CHEK,SCATS,MCOPTBL,JPB1,SKIPONE PROCS 17
EXT CTSFSS0,CALLA PROCS 18
EXT ITYWD,SSTYWD PROCS 19
EXT LUNDF,LRET,LFRET,LNRET PROCS 20
EXT ERR47 PROCS 21
EXT NULL0,STAK2,SELSTR PROCS 22
EXT SACHEK,PMSF,TENTO10 PROCS 23
EXT END,END. PROCS 24
* UTILITY PROCS 25
EXT ITOS,SSTOS,STOSFX6,PTOPX4,ICX1X6,ZROX7,SSTOSF,ITOSF PROCS 26
EXT ITOSFTP,SOPERND,X1VALUE,FREESVD,SASSIGN,INDRCT,INDRX PROCS 27
EXT SEARCH,UCAT PROCS 28
EXT RTOSF,TEN,TENTH PROCS 29
EXT RTOSF0 PROCS 30
* STORMAN PROCS 31
EXT PUSHSTK,RESERVE,MORFREE,GETSTAK,GRBCOLL,RESHB PROCS 32
EXT FREEHB PROCS 33
EXT HBC,SELFCHK PROCS 34
EXT TOFHBL PROCS 35
* PATMAT PROCS 36
EXT PRDPM,DOLPM,ENDEXPM,ALTPM,EXPPM,ARBPM,LENPM,POSPM PROCS 37
EXT RPOSPM,TABPM,RTABPM,REMPM,BALPM,FAILPM,FENCEPM,ABORTPM PROCS 38
EXT ARBNOPM,STARPM,LITPM,ANYPM,NTANYPM,SPANPM,BREAKPM PROCS 39
* IO PROCS 40
EXT INPUT,OUTPUT,CLOSE1,CLOSALL PROCS 41
EXT OPEN PROCS 42
* PROCS PROCS 43
ENTRY SKIPTOP PROCS 44
ENTRY VALID PROCS 45
ENTRY CALENDR,TOD PROCS 46
ENTRY QALPHA,QANCHOR,QANY,QAPPLY,QARBNO PROCS 47
ENTRY QARRAY,QBREAK,QCLOCK,QDATA,QDATE,QDEFINE PROCS 48
ENTRY QCNVT,QDT,QEOI,QEORL PROCS 49
ENTRY QDETACH,QDIFFER,QENDFIL,QEQ,QFREEZE,QFLV PROCS 50
ENTRY QGE,QGRAB,QGT,QHBC,QIDENT,QIF,QINPUT PROCS 51
ENTRY QLE,QLEN,QLGT,QLT PROCS 52
ENTRY QMAXLN PROCS 53
ENTRY QNE,QNEXTV,QNOTANY PROCS 54
ENTRY QOUTPUT PROCS 55
ENTRY QPOS PROCS 56
ENTRY QREMARK,QREWIND,QRPOS,QRTAB PROCS 57
ENTRY QSIZE,QSPAN,QSTCNT,QSTLIM PROCS 58
ENTRY QTAB,QTIME,QTRIM PROCS 59
ENTRY QITEM,QBASE,QSELCT,QRIGHT,QLEFT,QPARAM,QREST,QFIRST PROCS 60
ENTRY QPROT,QTYPE PROCS 61
ENTRY PROTQ,ITEMQ,SELCTQ,PARAMQ,RIGHTQ,RESTQ PROCS 62
ENTRY NEXTVQ PROCS 63
ENTRY FREEZEQ,ALPHAQ,MAXLNQ,DATAQ,LGTQ PROCS 64
ENTRY FLVQ,DTQ,EORLQ,EFRWQ,IOQ,EOIQ,TDCQ PROCS 65
ENTRY REMARKQ PROCS 66
ENTRY ARRAYQ,CNVTQ,COMPQ,DEFINEQ,ARBNOQ PROCS 67
ENTRY ANCHORQ,TRIMQ,ANYQ,EQQ,PATQ,SIZEQ,IFQ PROCS 68
ENTRY LUNDFWD PROCS 69
ENTRY OPENALL PROCS 70
ENTRY WROVLAY PROCS 71
* INIT PROCS 72
EXT STNDREL PROCS 73
* PROCS 74
* MACRO TO GUARANTEE NUMBER OF PARAMS LE X, GE 1 UNLESS X=0 PROCS 75
* PARAM: X5 CURRENT NUMBER OF PARAMS PROCS 76
* X4 RETURN ADDRESS PROCS 77
* RESULT: B5 = X5-X PROCS 78
* PROCS 79
PARAM MACRO X PROCS 80
SB5 X5-X PROCS 81
LT B0,B5,SKIPTOP PROCS 82
ENDM PROCS 83
* PROCS 84
TITLE STANDARD PROCEDURES PROCS 85
* PROCS 86
* STANDARD PROCEDURES... PROCS 87
* ENTRIES ARE LABELLED WITH QNAMES, AND NAMEQ-S LABEL PROCS 88
* THE LAST LOCATION USED +1. SOMETIMES QNAMES ARE PROCS 89
* ABBREVIATED. PROCS 90
* UPON ENTRY X5 CONTAINS THE NUMBER OF ACTUALS IN THE PROCS 91
* STACK. PROCS 92
* PROCS 93
* THE FOLLOWING CODE IS USED BY THE PARAM MACRO: PROCS 94
* X0,X1,X2,X3,X7,B3,B4,B5 PROCS 95
* PROCS 96
SKIPTOP SX5 X5-1 . DECREMENT NUMBER OF ACTUALS PROCS 97
CALL SKIPONE,B5 PROCS 98
SB5 X4 . X4 STILL CONTAINS THE FUD PROCS 99
JP B5 PROCS 100
* PROCS 101
* PROCS 102
* PROCS 103
* TEST PROCEDURE HBC PERFORMS A HEAP BLOCK PROCS 104
* COMPACTION PROCS 105
QHBC PARAM 0 PROCS 106
RJ HBC PROCS 107
JP RETNULL . VALUE IS THE NULL STRING PROCS 108
* PROCS 109
* TEST PROCEDURE GRAB. TAKES ALL AVAILABLE SPACE PROCS 110
* EXCEPT X WORDS IN STACK STORAGE, BY BUILDING A LARGE PROCS 111
* DUMMY DOPE VECTOR PROCS 112
QGRAB PARAM 1 PROCS 113
SA1 B6 PROCS 114
AX1 55 PROCS 115
SX1 X1-ITY . PARAMETER MUST BE ITY PROCS 116
NZ X1,ERR29 . (DON'T BOTHER WITH SACHEK) PROCS 117
SA2 B6-1 PROCS 118
SA0 X2+5 . 5 IS FOR SAFETY (2 IS NEEDED) PROCS 119
RJ RESERVE PROCS 120
SB1 A0 PROCS 121
SB6 B6-B1 . RESET THE STACK PROCS 122
RJ GRBCOLL . DIMISH LS SUPPLY PROCS 123
* CODE BELOW IS SIMILAR TO QCOMPL: PROCS 124
SA3 MAXSTAK PROCS 125
SA4 B6-1 PROCS 126
IX3 X3+X4 . B3=-MAXSTAK-1-X-B6 PROCS 127
SB3 X3+1 PROCS 128
SX5 DOPTYP . PREPARE DUMMY HSTYP PROCS 129
SB3 B3+B6 PROCS 130
SB3 B0-B3 PROCS 131
LT B3,B0,ERR29 PROCS 132
RJ PUSHSTK PROCS 133
* GRAB HS SPACE BETWEEN OLD MAXHS AND MINSTAK-1 PROCS 134
SA1 MINHS PROCS 135
SA2 MAXHS PROCS 136
SA3 MINSTAK PROCS 137
SA4 X1+2 . DUMMY FREE BLOCK HAS MARK BIT PROCS 138
MX0 1 PROCS 139
BX7 X3 PROCS 140
LX0 60-5 PROCS 141
SA7 A2 . MAXHS=MINSTAK PROCS 142
BX6 -X0*X4 PROCS 143
SA6 A4 PROCS 144
BX0 X0*X4 PROCS 145
SB1 X2 PROCS 146
SB2 X3 PROCS 147
ZR X0,QGRAB1 . BRANCH IF LAST BLOCK IN HS NOT FREEPROCS 148
SA2 X2-1 . GRAB LAST FREE BLOCK TOO PROCS 149
AX2 18 PROCS 150
SB3 X2 PROCS 151
SB1 B1-B3 PROCS 152
SA1 B1 PROCS 153
RJ TOFHBL PROCS 154
QGRAB1 SX3 B2-B1 . BYPASS PROCS 155
LX5 55 PROCS 156
LX3 18 PROCS 157
BX7 X5+X3 PROCS 158
SA7 B1 . STORE WORD 0 OF DUMMY DOPE HB PROCS 159
SB2 B2-1 PROCS 160
MX0 1 PROCS 161
MX1 1 PROCS 162
LX0 60-1 PROCS 163
LX1 37 PROCS 164
BX6 X0+X1 . DUMMY DIMENSION WORD TO X6 PROCS 165
QGRAB2 SB1 B1+1 . LOOP TO FILL UP DOPE VECTOR PROCS 166
SA6 B1+0 PROCS 167
LT B1,B2,QGRAB2 PROCS 168
MX7 1 PROCS 169
BX6 X6+X7 . MARK THE LAST WORD PROCS 170
SA6 B1 PROCS 171
JP NEXTMIC . RETURN THE INTEGER PARAMETER PROCS 172
* PROCS 173
* QSUCC FREES (X5) PARAMETERS, THEN RETURNS THE NULL STRING PROCS 174
* PROCS 175
QSUCC SX4 QIF . SET RETURN POINT FOR PARAM MACRO PROCS 176
QIF PARAM 0 . STANDARD PROCEDURE IF PROCS 177
RETNULL RJ ZROX7 . NOW STACK A NULL AND GOTO NEXTMIC PROCS 178
CALL NULL0,,NEXTMIC PROCS 179
* PROCS 180
* STACK A TWO WORD ENTRY AND RETURN PROCS 181
* PARAM: X2 TYPE OF THE ENTRY (LX 55) PROCS 182
* X7 WORD 0 OF THE ENTRY PROCS 183
QSTAKR CALL STAK2,,NEXTMIC PROCS 184
* PROCS 185
IFQ BSS 0 PROCS 186
* PROCS 187
* PROCS 188
QSIZE PARAM 1 PROCS 189
SA2 B6 PROCS 190
AX2 55 PROCS 191
SA1 B6-1 PROCS 192
BX6 X1 PROCS 193
ZR X2,QSIZE1 . PARAM IS SF TYPE PROCS 194
SX2 X2-ITY PROCS 195
NZ X2,ERR29 . NOT STRING TYPE PROCS 196
RJ ITOSF PROCS 197
QSIZE1 SX7 B7 PROCS 198
SB7 X6 PROCS 199
AX6 18 PROCS 200
SA7 X6 . LINK PARAM TO FREE CHAIN PROCS 201
SA2 ITYWD PROCS 202
BX7 X2 PROCS 203
AX6 18 PROCS 204
SA6 B6-1 . LENGTH PROCS 205
SA7 B6 PROCS 206
EQ NEXTMIC PROCS 207
SIZEQ BSS 0 PROCS 208
* PROCS 209
* PROCS 210
QLEN SB1 LENPM PROCS 211
EQ QPAT PROCS 212
QPOS SB1 POSPM PROCS 213
EQ QPAT PROCS 214
QRPOS SB1 RPOSPM PROCS 215
EQ QPAT PROCS 216
QTAB SB1 TABPM PROCS 217
EQ QPAT PROCS 218
QRTAB SB1 RTABPM PROCS 219
QPAT PARAM 1 PROCS 220
SA0 10 PROCS 221
SA1 TENTO10 PROCS 222
BX0 X1 PROCS 223
SX5 B1 . SAVE PATTERN TYPE PROCS 224
RJ SACHEK PROCS 225
LX7 3 PROCS 226
PL X7,ERR42 . NOT ITY PROCS 227
MX0 43 PROCS 228
SA1 B6-1 PROCS 229
NG X1,ERR42 . NEGATIVE NOT LEGAL PROCS 230
BX0 X0*X1 PROCS 231
NZ X0,ERR42 . TOO LARGE PROCS 232
LX5 48 PROCS 233
BX6 X1+X5 PROCS 234
SX7 PSTY PROCS 235
SA6 A1 PROCS 236
LX7 55 PROCS 237
SX6 2 PROCS 238
BX6 X6+X7 PROCS 239
SA6 B6 PROCS 240
EQ NEXTMIC PROCS 241
PATQ BSS 0 PROCS 242
* PROCS 243
* . - + 0 PROCS 244
QEQ SB1 6B . 1 1 0 PROCS 245
EQ QEQ1 PROCS 246
QNE SB1 1 . 0 0 1 PROCS 247
EQ QEQ1 PROCS 248
QGT SB1 5 . 1 0 1 PROCS 249
EQ QEQ1 PROCS 250
QGE SB1 4 . 1 0 0 PROCS 251
EQ QEQ1 PROCS 252
QLT SB1 3 . 0 1 1 PROCS 253
EQ QEQ1 PROCS 254
QLE SB1 2 . 0 1 0 PROCS 255
QEQ1 PARAM 2 PROCS 256
LT B5,B0,QEQ8 . BRANCH IF SINGLE PARAM PROCS 257
SA1 B6 PROCS 258
SX5 B1 PROCS 259
SB1 X1 PROCS 260
SA2 B6-B1 PROCS 261
AX1 55 . RIGHT PARAM TYPE PROCS 262
AX2 55 . LEFT PARAM TYPE PROCS 263
SX3 X1-ITY PROCS 264
SX4 X2-ITY PROCS 265
NZ X3,QEQ5 . BRANCH IF NOT BOTH ARE PROCS 266
NZ X4,QEQ5 . INTEGERS PROCS 267
QEQ2 SA1 B6-1 . COMPARE INTEGERS PROCS 268
SA2 B6-3 PROCS 269
SB6 B6-2 PROCS 270
IX1 X2-X1 PROCS 271
QEQ3 SX4 1 . TEST ON X1 - + 0 PROCS 272
ZR X1,QEQ4 PROCS 273
LX4 1 PROCS 274
PL X1,QEQ4 PROCS 275
LX4 1 PROCS 276
QEQ4 BX5 X4*X5 . MASK BY BIT PATTERN OF THE PROCS 277
NZ X5,FAIL . RELATION PROCS 278
MX0 5 PROCS 279
RJ ZROX7 . NULL STRING IS RETURNED IF PROCS 280
SX6 2 . SUCCESS PROCS 281
BX7 -X0*X7 PROCS 282
SA6 B6 . CLEAR SS TYPE PROCS 283
SA7 B6-1 PROCS 284
EQ NEXTMIC PROCS 285
QEQ5 SX6 X1-RTY . IF ONE PARAM IS REAL THEN PROCS 286
SX4 X2-RTY . BOTH HAVE TO BE REAL PROCS 287
ZR X6,QEQ7 PROCS 288
ZR X4,ERR47 PROCS 289
SA4 B6-1 PROCS 290
ZR X3,QEQ5A . BRANCH IF RIGHT OP IS INTEGER PROCS 291
NZ X1,ERR47 . ERROR IF NOT SF PROCS 292
SA2 MINHS PROCS 293
BX6 X4 PROCS 294
SA6 X2 . IF SF STORE IN XWRD PROCS 295
EQ QEQ5B PROCS 296
QEQ5A BX6 X4 . ELSE IN SAVE LOCATION PROCS 297
SA6 QEQSV PROCS 298
QEQ5B SB6 B6-2 PROCS 299
SA1 TENTO10 PROCS 300
BX0 X1 PROCS 301
SA0 10 PROCS 302
RJ SACHEK . CHECK LEFT PARAM PROCS 303
SA0 2 PROCS 304
RJ RESERVE PROCS 305
SA2 MINHS PROCS 306
SA2 X2 PROCS 307
BX6 X2 PROCS 308
NZ X2,QEQ5C . RESTORE RIGHT PARAM PROCS 309
SA2 ITYWD PROCS 310
SA1 QEQSV . CUT IT SHORT IF INTEGER PROCS 311
BX7 X2 PROCS 312
BX6 X1 PROCS 313
SA6 B6-1 PROCS 314
EQ QEQ5D PROCS 315
QEQ5C SX7 A0 . SACHEK DOES NOT CARE IF THE PROCS 316
SA6 B6-1 . SS BITS ARE ON PROCS 317
SA7 B6 PROCS 318
BX7 X7-X7 . CLEAR XWRD PROCS 319
SA7 A2 PROCS 320
SA1 TENTO10 PROCS 321
BX0 X1 PROCS 322
SA0 10 PROCS 323
RJ SACHEK . CHECK RIGHT PARAM PROCS 324
QEQ5D SB1 X7 PROCS 325
SA1 B6-B1 PROCS 326
SA7 B6 . UPDATE TOP OF STACK IN CASE PROCS 327
* . OF ERROR PROCS 328
LX7 3 PROCS 329
LX1 3 PROCS 330
PL X7,ERR32 PROCS 331
NG X1,QEQ2 . BRANCH IF BOTH ARE INTEGERS PROCS 332
JP ERR32 . STRING ARITHMETIC NOT YET IMPL. PROCS 333
* PROCS 334
* PROCS 335
QEQ7 NZ X4,ERR47 PROCS 336
SB6 B6-2 PROCS 337
SA1 B6+1 PROCS 338
SA2 B6-1 PROCS 339
FX1 X2-X1 . COMPARE REAL VALUES PROCS 340
NX1 X1 . TAKE CARE OF ZERO RESULT PROCS 341
EQ QEQ3 PROCS 342
* PROCS 343
QEQ8 SA1 TENTO10 . CHECK SIMGLE PARAM PROCS 344
SA0 10 PROCS 345
BX0 X1 PROCS 346
SX5 B1 PROCS 347
RJ SACHEK PROCS 348
LX7 3 PROCS 349
SA1 B6-1 PROCS 350
NG X7,QEQ3 . BRANCH IF INTEGER TYPE PROCS 351
ERROR 32 PROCS 352
* PROCS 353
EQQ BSS 0 PROCS 354
* PROCS 355
* PROCS 356
QSPAN SB1 SPANPM . STANDARD PROCEDURES SPAN, PROCS 357
EQ QANY1 PROCS 358
QBREAK SB1 BREAKPM . BREAK, PROCS 359
EQ QANY1 PROCS 360
QNOTANY SB1 NTANYPM . NOTANY, PROCS 361
EQ QANY1 PROCS 362
QANY SB1 ANYPM . ANY PROCS 363
QANY1 PARAM 1 PROCS 364
SA1 B6 PROCS 365
AX1 55 . TYPE OF PARAMETER PROCS 366
NZ X1,QANY3 . BRANCH IF NOT SF PROCS 367
QANY2 SA1 B6-1 . FETCH SVD PROCS 368
MX6 1 . INITIALIZE BIT TABLE WORDS PROCS 369
MX7 1 PROCS 370
QANY4 ZR X1,QANY7 . GET NEXT LIST WORD PROCS 371
SA2 X1 PROCS 372
SX1 X2 PROCS 373
SB3 1 . CONSTANT, USED BELOW PROCS 374
BX2 X2-X1 PROCS 375
MX3 54 PROCS 376
YANY5 LX2 6 . GET NEXT CHARACTER PROCS 377
BX4 -X3*X2 PROCS 378
ZR X4,QANY4 PROCS 379
LX4 60-1 PROCS 380
MX5 1 PROCS 381
SB4 X4+0 PROCS 382
LX5 60-1 PROCS 383
AX5 B4,X5 PROCS 384
PL X4,YANY6 PROCS 385
BX7 X7+X5 . MERGE INTO ODD PROCS 386
EQ YANY5 PROCS 387
YANY6 BX6 X6+X5 . OR EVEN TABLE WORD PROCS 388
EQ YANY5 PROCS 389
QANY7 SA0 2 PROCS 390
RJ RESERVE PROCS 391
LX6 18 PROCS 392
LX7 18 PROCS 393
SA6 B6-2 . STORE BIT TABLE PROCS 394
SA7 B6-1 PROCS 395
SA1 A6-B3 PROCS 396
SX6 B7 . FREE SF ARGUMENT PROCS 397
SB7 X1 PROCS 398
AX1 18 PROCS 399
SA6 X1 PROCS 400
SX7 A0+B3 . FORM PM OPERATION BYPASS=3 PROCS 401
SX6 B1 PROCS 402
LX6 48 PROCS 403
BX6 X6+X7 PROCS 404
SA6 A1 PROCS 405
SX7 X7+B3 . BYPASS OF STACK ENTRY=4 PROCS 406
SX6 PSTY PROCS 407
LX6 55 PROCS 408
BX7 X6+X7 PROCS 409
SA7 B6 . FORM STACK HEADING PROCS 410
EQ NEXTMIC PROCS 411
QANY3 SX1 X1-ITY PROCS 412
NZ X1,ERR29 . ERROR IF NOT INTEGER PROCS 413
SA1 B6-1 PROCS 414
RJ ITOSF . CONVERT I TO SF PROCS 415
SA6 B6-1 PROCS 416
EQ QANY2 PROCS 417
* PROCS 418
ANYQ BSS 0 PROCS 419
* PROCS 420
QTRIM PARAM 1 PROCS 421
SA1 B6 PROCS 422
AX1 55 PROCS 423
ZR X1,QTRIM1 . BRANCH IF STRING PARAM PROCS 424
SX1 X1-ITY PROCS 425
NZ X1,ERR29 . ERROR IF NOT INTEGER PROCS 426
EQ NEXTMIC . INTEGERS ARE TRIMMED ANYWAY PROCS 427
QTRIM1 SA2 B6-1 . SVD OF OPERAND PROCS 428
BX6 X6-X6 . CHARACTER COUNT PROCS 429
BX5 X2 PROCS 430
SA1 X2+0 . TO INITIALIZE X3 PROCS 431
MX0 54 PROCS 432
SX4 1R . BLANK TO X4 PROCS 433
SB1 0 . NO SKIP MODE PROCS 434
QTRIM2 ZR X2,QTRIM5 . FINIS IF LINK IS ZERO PROCS 435
SX3 A1 . LAST REFERENCE PROCS 436
SA1 X2 . NEXT WORD PROCS 437
SX2 X1 PROCS 438
BX1 X1-X2 . REMOVE LINK PROCS 439
SB2 -6 . INITIALIZE POSITION COUNT PROCS 440
QTRIM3 LX1 6 . NEXT CHAR TO X7 PROCS 441
SB2 B2+6 PROCS 442
BX7 -X0*X1 PROCS 443
ZR X7,QTRIM2 . NEXT WORD IF IT IS ZERO PROCS 444
SX6 X6+1 . BUMP CHARACTER COUNT PROCS 445
BX7 X7-X4 . COMPARE IT WITH A BLANK PROCS 446
EQ B1,B0,QTRIM4 . BRANCH IF NO SKIP PROCS 447
ZR X7,QTRIM3 . NEXTCHAR IF BLANK PROCS 448
SB1 B0 . END SKIP MODE IF NOT BLANK PROCS 449
EQ QTRIM3 PROCS 450
QTRIM4 NZ X7,QTRIM3 . NOT BLANK IN NO SKIP PROCS 451
SB1 A1 . BLANK IN NO SKIP PROCS 452
SA0 X6 PROCS 453
SB3 B2 PROCS 454
SB5 X3 PROCS 455
EQ QTRIM3 PROCS 456
QTRIM5 EQ B1,B0,NEXTMIC . RETURN IF NO SKIP PROCS 457
NE B3,B0,QTRIM6 PROCS 458
SA3 B1+0 . CASE OF ALL BLANKS PROCS 459
SX6 X3 PROCS 460
SA6 A3 PROCS 461
SA2 B5 . FIRST BLANK WAS THE FIRST PROCS 462
SX1 B1 . CHARACTER IN A WORD PROCS 463
* CHECK CASE OF ALL BLANKS MORE CAREFULLY PROCS 464
SX7 X5 PROCS 465
IX7 X1-X7 PROCS 466
NZ X7,QTRIM5A . NOT ALL BLANKS PROCS 467
SA1 B1 . MAKE X1 POINT TO WORDS TO BE PROCS 468
* . DELETED PROCS 469
QTRIM5A SX7 X2 PROCS 470
BX7 X2-X7 PROCS 471
SA7 A2 PROCS 472
EQ QTRIM7 PROCS 473
QTRIM6 SA1 B1 . FIRST BLANK WAS NOT THE FIRST PROCS 474
MX0 6 . CHARACTER IN A WORD PROCS 475
SB3 B3-6 PROCS 476
AX0 X0,B3 . MASK THE BLANKS OFF PROCS 477
BX7 X0*X1 PROCS 478
SA7 A1 PROCS 479
SB5 A1 PROCS 480
QTRIM7 SX7 X5 . FIRST PROCS 481
SX6 B5 . LAST PROCS 482
SX3 X5 PROCS 483
AX5 18 PROCS 484
LX6 18 PROCS 485
SX0 A0-1 . LENGTH IN CHARACTERS PROCS 486
LX0 36 PROCS 487
BX7 X6+X7 PROCS 488
BX7 X7+X0 . FORM SVD IN X7 PROCS 489
SA7 B6-1 . RESULT PROCS 490
SX1 X1 . RETURN IF NOTHING IS THERE PROCS 491
BX3 X3-X1 . TO BE FREED PROCS 492
ZR X1,NEXTMIC PROCS 493
ZR X3,NEXTMIC PROCS 494
SX7 B7 . FREE WORDS CONTAINING TRAILING PROCS 495
SB7 X1 . BLANKS PROCS 496
SA7 X5 PROCS 497
EQ NEXTMIC PROCS 498
* PROCS 499
TRIMQ BSS 0 PROCS 500
* PROCS 501
QANCHOR SB1 ANCHOR . STANDARD PROCEDURE ANCHOR PROCS 502
QANCHOR1 PARAM 1 PROCS 503
SA1 B6 PROCS 504
AX1 55 PROCS 505
NZ X1,QANCHOR2 . BRANCH IF PARAM IS NOT A STRING PROCS 506
SA2 B6-1 PROCS 507
SA1 X2 . FETCH FIRST WORD OF STRING PROCS 508
QANCHOR2 BX7 X1 . SET KEYWORD TO ZERO IF PARAM PROCS 509
SA7 B1 . IS A NULL STRING ELSE PROCS 510
* . SET IT TO NOT ZERO PROCS 511
JP QSUCC . FREE (X5) PARAMS, RETURN NULL PROCS 512
* PROCS 513
ANCHORQ BSS 0 PROCS 514
* PROCS 515
* PROCS 516
QARBNO PARAM 1 PROCS 517
SA1 B6 PROCS 518
AX1 55 PROCS 519
ZR X1,QARBN1 . BRANCH IF STRING PROCS 520
SX1 X1-ITY PROCS 521
NG X1,QARBN2 . BRANCH IF PATTERN PROCS 522
NZ X1,ERR29 . ERROR IF NOT INTEGER PROCS 523
SB1 QARBN1 PROCS 524
EQ ITOSFTP . CONVERT INTEGER TO STRING PROCS 525
QARBN1 SB1 QARBN2 . CONVERT STRING TO PATTERN PROCS 526
SX4 B6-1 PROCS 527
SB4 B0 . SIGNAL SF TYPE PROCS 528
EQ PMSF PROCS 529
QARBN2 SA4 B6 PROCS 530
SB2 X4 PROCS 531
SA0 3 PROCS 532
SB3 B6 PROCS 533
SX6 A0+B2 . NEW BYPASS PROCS 534
RJ RESERVE . RESERVE THREE LOCATIONS PROCS 535
QARBN3 SA1 B3-1 . PUSH PATTERN TOWARD HIGH CORE PROCS 536
SB2 B2-1 . TO MAKE ROOM FOR ARBNO HEADING PROCS 537
BX7 X1 PROCS 538
SB3 A1 PROCS 539
SA7 A1+2 PROCS 540
NE B2,B0,QARBN3 PROCS 541
SX0 ARBNOPM PROCS 542
SX1 PETY PROCS 543
SX2 ENDEXPM PROCS 544
SB1 -1 PROCS 545
LX0 48 . PREPARE ARBNOPM OPERATION PROCS 546
LX1 55 . PREPARE PS TYPE HEADING PROCS 547
LX2 48 . PREPARE END EXPRESSION PROCS 548
SX7 X6+B1 . BYPASS FOR ARBNOPM PROCS 549
BX6 X6+X1 . FORM HEADING IN X6 PROCS 550
BX7 X7+X0 PROCS 551
SA7 B3-B1 PROCS 552
SA6 B6 PROCS 553
BX7 X2 PROCS 554
SX6 377777B . PART OF THE ARBNO OPERATION PROCS 555
SA6 A7-B1 PROCS 556
SA7 B6+B1 PROCS 557
EQ NEXTMIC PROCS 558
* PROCS 559
ARBNOQ BSS 0 PROCS 560
* PROCS 561
* SUBROUTINE TO READ THE NEXT IDENTIFIER IN A STRING PROCS 562
* PARAM: X2 CURRENT STRING WORD PROCS 563
* X4 SOURCE STRING LINK PROCS 564
* X0 MX0 54 PROCS 565
* X6 =X0 PROCS 566
* RESULTS: X3 TERMINATOR CHARACTER PROCS 567
* X6 SVD OF THE IDENTIFIER STRING PROCS 568
* B2 CLENGTH FIELD OF X6 PROCS 569
* PROCS 570
QNXID6 LX5 12 . LEFT JUSTIFY LAST WORD PROCS 571
LX7 X5,B3 PROCS 572
SA1 B7 PROCS 573
EQ B2,B0,QNXID7A .RETURN IF NO RESULT AND FREE WORDS PROCS 574
NZ X1,QNXID7 PROCS 575
RJ MORFREE PROCS 576
QNXID7 SA7 A1 . STORE LAST WORD PROCS 577
SB7 X1 PROCS 578
QNXID7A NG X6,QNXID8 . BYPASS IF NOTHING TO BE FREED PROCS 579
SX7 B7 PROCS 580
SB7 B4 . FREE USED INPUT WORDS PROCS 581
SA7 X6 PROCS 582
QNXID8 EQ B2,B0,QNXID . RETURN IF NO RESULT PROCS 583
SX6 A1 . LAST PROCS 584
SX7 B2 . LENGTH PROCS 585
LX6 18 PROCS 586
LX7 36 PROCS 587
SX1 B5 . FIRST PROCS 588
BX6 X7+X6 . FORM SVD IN X6 AND RETURN PROCS 589
BX6 X1+X6 PROCS 590
QNXID NO . ENTRY POINT PROCS 591
+ SB4 X4 . FIRST TO BE FREED PROCS 592
SB5 B7 . FIRST PROCS 593
SB2 B0 . FIRST SYMBOL = TRUE PROCS 594
BX5 X5-X5 . CLEAR OUTPUT WORD PROCS 595
SB3 48 . OUTPUT POSITION PROCS 596
EQ QNXID2 PROCS 597
QNXID1 ZR X4,QNXID6 . END OF INPUT PROCS 598
SA2 X4 . TAKE NEXT WORD PROCS 599
SX4 X2 PROCS 600
SX6 A2 . LAST TO BE FREED PROCS 601
BX2 X2-X4 PROCS 602
QNXID2 LX2 6 PROCS 603
BX3 -X0*X2 . NEXT INPUT CHARACTER TO X3 PROCS 604
ZR X3,QNXID1 . END OF WORD PROCS 605
SX7 X3-1RZ-1 PROCS 606
NG X7,QNXID3 . BRANCH IF ALPHABETIC PROCS 607
SX7 X3-1R9-1 PROCS 608
EQ B2,B0,QNXID6 PROCS 609
NG X7,QNXID3 . BRANCH IF DIGIT PROCS 610
SX7 X3-1R. PROCS 611
NZ X7,QNXID6 . BRANCH IF TERMINATOR PROCS 612
QNXID3 SB2 B2+1 . FIRST SYMBOL = FALSE PROCS 613
SB3 B3-6 PROCS 614
NE B3,B0,QNXID5 . BYPASS IF OUTPUT WORD NOT FULL PROCS 615
LX5 18 PROCS 616
SA1 B7 PROCS 617
NZ X1,QNXID4 . GET FREE WORD PROCS 618
RJ MORFREE PROCS 619
QNXID4 SX1 X1 PROCS 620
SB7 X1 . ADD LINK PROCS 621
BX7 X5+X1 PROCS 622
BX5 X5-X5 PROCS 623
SA7 A1+0 . STORE OUTPUT WORD PROCS 624
SB3 42 PROCS 625
QNXID5 LX5 6 . PACK NEXT OUTPUT CHARACTER PROCS 626
BX5 X5+X3 PROCS 627
EQ QNXID2 PROCS 628
* PROCS 629
* FIND FUNCTION WITH THE NAME AT THE TOP OF THE STACK PROCS 630
* RELEASE FUD IF PROCTYP PROCS 631
* RESULT: X1 POINTS TO AN FUD PROCS 632
SRCH0 LX0 55 PROCS 633
BX7 X0 PROCS 634
SA7 X1 . INITIALIZE TO UNDEF PROCS 635
BX3 X3-X3 PROCS 636
SRCHCLL DATA 0 PROCS 637
+ SX0 CALLTYP . SEARCH FOR A CALL TYPE ENTRY PROCS 638
RJ INDRX . IN STATIC PROCS 639
SX0 UNDFTYP PROCS 640
EQ B3,B0,SRCH0 . BRANCH IF NEW ENTRY PROCS 641
SA2 X1 PROCS 642
BX3 X2 PROCS 643
AX3 55 PROCS 644
SX7 B7 PROCS 645
NZ X3,SRCHCLL . RETURN IF NOT PROCEDURE PROCS 646
RJ RELL PROCS 647
JP SRCHCLL PROCS 648
* PROCS 649
* RELEASE LIST WITH HEADER IN X2 (MAY BE EMPTY) X7 = B7 PROCS 650
* X2 PROCS 651
RELL DATA 0 PROCS 652
SX2 X2 PROCS 653
ZR X2,RELL . RETURN IF EMPTY PROCS 654
SB7 X2 PROCS 655
RELL1 SA2 X2 . LOOP TO FIND LAST WORD PROCS 656
SX2 X2 PROCS 657
NZ X2,RELL1 PROCS 658
SA7 A2 PROCS 659
EQ RELL PROCS 660
* PROCS 661
* PROCS 662
QDEFINE PARAM 2 . STANDARD PROCEDURE DEFINE PROCS 663
QDEFA SA1 B6 PROCS 664
SA4 B6-1 PROCS 665
MX7 1 PROCS 666
SB1 1 . SET FLAG, ONE PARAM PROCS 667
LT B5,B0,QDEF1 . BYPASS IF ONE PARAMETER PROCS 668
LX7 54 PROCS 669
BX7 X7+X1 PROCS 670
SA7 A1 . SET BIT A ON TOP STACK ENTRY PROCS 671
AX1 55 PROCS 672
NZ X1,ERR29 . ERROR IF NOT SF PROCS 673
SA2 X4 . FIRST WORD OF STRING PROCS 674
NZ X2,QDEF0 . SECOND ARGUMENT NOT NULL PROCS 675
SX7 B7 . DESTROY 2ND PARAM PROCS 676
SA7 A2 PROCS 677
SB7 A2 PROCS 678
SB6 B6-2 PROCS 679
SB5 -1 PROCS 680
JP QDEFA . TRY AGAIN PROCS 681
* PROCS 682
QDEF0 MX0 54 . =HOLE 6 PROCS 683
BX2 X2-X2 PROCS 684
BX6 X0 PROCS 685
RJ QNXID . GET IDENTIFIER PROCS 686
NZ X4,ERR44 . ERROR IF TERMINATOR IS NOT END PROCS 687
NZ X3,ERR44 PROCS 688
SA6 B6-1 PROCS 689
SB1 0 . SET A FLAG, TWO PARAMS PROCS 690
SA1 B6-2 PROCS 691
SA4 B6-3 PROCS 692
QDEF1 AX1 55 PROCS 693
MX0 54 PROCS 694
NZ X1,ERR29 . ERROR, FIRST PARAM NOT SF PROCS 695
BX2 X2-X2 PROCS 696
BX6 X0 PROCS 697
RJ QNXID . GET FIRST IDENTIFIER PROCS 698
EQ B2,B0,ERR44 . ERROR, PROC NAME MISSING PROCS 699
SX7 X3-1R( PROCS 700
NZ X7,ERR44 . TERMINATOR IS NOT ( PROCS 701
NE B1,B0,QDEF2 PROCS 702
SA6 B6-3 PROCS 703
EQ QDEF3 PROCS 704
QDEF2 SA6 B6-1 . IF IT IS ALSO THE ENTRY LABEL, PROCS 705
SA1 B6 . SET BITS A AND B IT TOP STACK ENTRYPROCS 706
MX7 2 PROCS 707
LX7 54 PROCS 708
BX7 X7+X1 PROCS 709
SA7 A1 PROCS 710
QDEF3 MX6 1 . IN FORMAL PART = TRUE PROCS 711
SB1 B0 . NO OF PARAMS = 0 PROCS 712
SA6 QDEFSV2 PROCS 713
QDEF4 BX6 X0 PROCS 714
RJ QNXID . GET NEXT IDENTIFIER PROCS 715
NZ X3,QDEF5 PROCS 716
EQ B2,B0,QDEF6 PROCS 717
QDEF5 EQ B2,B0,QDEF5A . BRANCH IF NO NAME PROCS 718
SA1 MINHS PROCS 719
SB1 B1+1 . BUMP NO OF PARAMS PROCS 720
BX7 X4 . SAVE LINK IN XWRD PROCS 721
SA7 X1 PROCS 722
SA4 MINHS . USE SPECIAL LOCATION FOR POINTER PROCS 723
SA6 X4+1 . DON'T KEEP POINTER IN YOUR PROCS 724
* . HOT LITTLE HAND PROCS 725
SA0 2 PROCS 726
RJ RESERVE . STORE NAME AS A SF TYPE STACK PROCS 727
SA4 X4+1 PROCS 728
BX6 X4 . RESTORE POINTER PROCS 729
BX7 X7-X7 PROCS 730
SA7 A4 . CLEAR SPECIAL LOCATION PROCS 731
SA4 MINHS . ENTRY PROCS 732
SA6 B6-1 PROCS 733
SA4 X4+0 . RESTORE LINK PROCS 734
SX7 A0 PROCS 735
SA7 B6 PROCS 736
ZR X3,QDEF6 PROCS 737
SX7 X3-1R, PROCS 738
ZR X7,QDEF4 PROCS 739
QDEF5A SX7 X3-1R) . ) DELIMITS FORMALS AND LOCALS PROCS 740
NZ X7,ERR44 PROCS 741
SA1 QDEFSV2 PROCS 742
SX7 B1 PROCS 743
SA7 A1 PROCS 744
PL X1,ERR44 . TWO ) -S IN PROTOTYPE PROCS 745
EQ QDEF4 PROCS 746
QDEF6 SA1 QDEFSV2 PROCS 747
NG X1,ERR44 . ERROR, NO ) IN PROTOTYPE PROCS 748
SX7 B1+B1 PROCS 749
SX7 X7+3 . APPETITE=2*(LOCALS+FORMALS+1)+1 PROCS 750
LX7 36 PROCS 751
LX1 18 PROCS 752
BX7 X7+X1 . NO OF FORMALS IS IN X1 PROCS 753
SA7 A1 PROCS 754
SB4 B0 PROCS 755
ZR B1,QDEF10A . NO FORMALS OR LOCALS PROCS 756
QDEF7 RJ INDRCT . FIND ADDRESS OF NEXT FORMAL PROCS 757
SA2 MINHS . PARAM OR LOCAL VARIABLE PROCS 758
EQ QDEF9 PROCS 759
QDEF8 SA2 B1+0 PROCS 760
QDEF9 SB1 X2 PROCS 761
NE B1,B0,QDEF8 PROCS 762
SX7 B7 PROCS 763
BX7 X2+X7 . PUT THE ADDRESS ON A LIST PROCS 764
SA7 A2 PROCS 765
SX6 X1 PROCS 766
SA1 B7 PROCS 767
NZ X1,QDEF10 PROCS 768
RJ MORFREE PROCS 769
QDEF10 SB7 X1 PROCS 770
LX6 18 PROCS 771
SA3 B6 PROCS 772
SA6 A1 PROCS 773
LX3 6 PROCS 774
PL X3,QDEF7 . JUMP BACK IF BIT A IS NOT SET PROCS 775
SB4 B0 . SIGNAL SF TYPE FOR INDRX PROCS 776
QDEF10A SA4 B6-1 PROCS 777
SX0 LBLTYP . FIND STATIC ADDRESS OF THE PROCS 778
RJ INDRX . ENTRY LABEL PROCS 779
SX6 X1 PROCS 780
SA1 B6 PROCS 781
NE B3,B0,QDEF11 PROCS 782
SA2 LUNDFWD . INITIALIZE LABEL IF NEW RECORD PROCS 783
BX7 X2 PROCS 784
SA7 X6 PROCS 785
QDEF11 SA6 QDEFSV1 PROCS 786
LX1 7 PROCS 787
NG X1,QDEF12 PROCS 788
SA1 B6-1 . RELEASE THE STRING CONTAINING PROCS 789
SX7 B7 . THE ENTRY NAME IF BIT B IS NOT PROCS 790
SB7 X1 . SET PROCS 791
AX1 18 PROCS 792
SA7 X1 PROCS 793
SB6 B6-2 PROCS 794
QDEF12 SA4 B6-1 . FIND STATIC ADDRESS OF THE PROCS 795
RJ SRCHCLL . PROCEDURE PROCS 796
LX3 55+1 PROCS 797
SX7 B7 PROCS 798
PL X3,QDEF12A PROCS 799
RJ RELL . RELEASE FLDTYP FUD PROCS 800
QDEF12A SX7 X1+0 PROCS 801
SA7 QDEFSV3 PROCS 802
RJ INDRCT . LOOK UF VARIABLE HAVING PROCS 803
SX6 B7 . THE SAME NAME AS THE PROCEDURE PROCS 804
SB6 B6+2 . RESET STACK POINTER PROCS 805
LX1 18 . FORM PARAMETER LIST BY CONCATE- PROCS 806
SA2 QDEFSV3 . NATING THE REVERSED LIST OF PROCS 807
BX6 X6+X1 . STATIC ADDRESSES AND THE PROCS 808
SB2 X2 . ADDRESS OF THE ENTRY LABEL PROCS 809
SA1 B7 PROCS 810
SA2 QDEFSV1 PROCS 811
MX0 1 . THIS BIT SIGNALS THE END OF LIST PROCS 812
NZ X1,QDEF13A PROCS 813
RJ MORFREE PROCS 814
QDEF13A SB7 X1 PROCS 815
LX2 18 PROCS 816
BX7 X2+X0 PROCS 817
SA7 A1 PROCS 818
SA1 B7 PROCS 819
SA4 MINHS PROCS 820
SB1 B7 PROCS 821
NZ X1,QDEF13B PROCS 822
RJ MORFREE PROCS 823
QDEF13B SB7 X1 PROCS 824
SA6 A1+0 PROCS 825
SA2 X4 PROCS 826
BX6 X6-X6 PROCS 827
SA6 X4 . CLEAR XWRD PROCS 828
SB3 X2 PROCS 829
ZR X2,QDEF16 . NO FORMALS OR LOCALS PROCS 830
* LOOP TO BUILD REST OF FORMALS LIST (BACKWARD) PROCS 831
QDEF14 SA3 X2 . NEXT WORD FROM ADDRESS LIST PROCS 832
SX2 X3 PROCS 833
BX3 X3-X2 PROCS 834
SB4 A3 PROCS 835
SA1 B7 PROCS 836
NZ X1,QDEF15 PROCS 837
RJ MORFREE PROCS 838
QDEF15 SB7 X1 PROCS 839
SX1 X1 PROCS 840
SX7 B1 PROCS 841
SB1 A1 PROCS 842
BX7 X3+X7 PROCS 843
SA7 A1 . NEXT WORD TO PARAM LIST PROCS 844
NZ X2,QDEF14 PROCS 845
SX6 B7 . FREE PROCS 846
SB7 B3 . WORKING PROCS 847
SA6 B4 . LIST PROCS 848
QDEF16 SA2 QDEFSV2 PROCS 849
SX1 B1 PROCS 850
BX7 X1+X2 PROCS 851
SA7 B2 . ASSIGN THE FORMAL LIST PROCS 852
MX0 5 PROCS 853
RJ ZROX7 . RESULT OF DEFINE IS A NULL STRING PROCS 854
SX6 2 PROCS 855
BX7 -X0*X7 . CLEAR SS TYPE PROCS 856
SA6 B6 PROCS 857
SA7 B6-1 PROCS 858
EQ NEXTMIC PROCS 859
* PROCS 860
LUNDFWD VFD 5/UNDFTYP,55/LUNDF . UNDEFINED CPD PROCS 861
DEFINEQ BSS 0 PROCS 862
* PROCS 863
* IDENT,DIFFER(X,Y) "PREDICATES! PROCS 864
* PROCS 865
* X AND Y ARE 'IDENT'-ICAL IF THERE IS NO WAY FOR A SNOBOL PROCS 866
* PROGRAM TO TELL THEM APART, AND THEY ARE 'DIFFER'-ENT OTHERWISE. PROCS 867
* PROCS 868
QDIFFER SB2 1 PROCS 869
JP QID PROCS 870
QIDENT SB2 0 PROCS 871
QID PARAM 2 PROCS 872
NG B5,QID4 . CALLED WITH ONE PARAMETER PROCS 873
SA1 B6 . HEADER OF SECOND PARAMETER PROCS 874
SB1 X1 . BYPASS PROCS 875
BX0 X1 . SAVE HEADER (USED AT QID6) PROCS 876
AX1 55 . RIGHT JUSTIFY THE TYPE PROCS 877
NZ X1,QID5 . INTEGER, OR NOT STRING AT ALL PROCS 878
QID1 SA2 B6-B1 . HEADER OF FIRST PARAMETER PROCS 879
AX2 55 PROCS 880
NZ X2,QID7 . INTEGER, OR NOT STRING PROCS 881
QID2 SA1 B6-1 . SECOND SVD PROCS 882
SA2 B6-3 . FIRST SVD PROCS 883
SX3 X1 . SAVE PTRS PROCS 884
SX4 X2 . TO STRINGS PROCS 885
MX0 60-18 PROCS 886
BX1 X1-X2 . COMPARE PROCS 887
AX1 18+18 . CLENGTH PROCS 888
BX1 -X0*X1 . FIELDS PROCS 889
NZ X1,QIDDIF . NOT THE SAME PROCS 890
QID2L SA1 X3 . FETCH NEXT PAIR PROCS 891
SA2 X4 . OF LIST WORDS PROCS 892
SX3 X1 PROCS 893
SX4 X2 PROCS 894
BX1 X1-X2 . COMPARE PROCS 895
BX1 X0*X1 . LIST WORDS PROCS 896
NZ X1,QIDDIF . NOT THE SAME PROCS 897
NZ X3,QID2L . NOT TO END YET(RECALL LNGTHS ARE =)PROCS 898
QIDSAME NZ B2,FAIL . ENTRY WAS THROUGH DIFFER PROCS 899
JP QSUCC . FREE PARAMETERS AND RETURN NULL PROCS 900
* PROCS 901
* SECOND PARAMETER IS IMPLICITLY NULL. PROCS 902
* PROCS 903
QID4 SA1 B6 . HEADER OF (THE ONLY) PARAMETER PROCS 904
AX1 55 . RIGHT JUSTIFY TYPE FIELD PROCS 905
NZ X1,QIDDIF . NOT SF, CAN NOT BE NULL PROCS 906
SA2 B6-1 . FETCH SVD PROCS 907
AX2 18+18 . RIGHT JUSTIFY CLENGTH FIELD PROCS 908
SB1 X2 PROCS 909
ZR B1,QIDSAME PROCS 910
JP QIDDIF PROCS 911
* PROCS 912
* SECOND PARAMETER WAS NOT SF TYPE. PROCS 913
* PROCS 914
QID5 SX2 X1-ITY PROCS 915
NZ X2,QID6 PROCS 916
CALL ITOSFTP . CONVRT INTGER ON STACK TO SF TYPEPROCS 917
SB1 2 . RESET B1 = BYPASS (B2 WAS SAVED) PROCS 918
JP QID1 . NOW CHECK THE FIRST PARAMETER PROCS 919
* PROCS 920
* SECOND PARAMETER WAS NOT CONVERTIBLE TO STRING TYPE. PROCS 921
* PROCS 922
QID6 SA2 B6-B1 . HEADER OF FIRST PARAMETER PROCS 923
BX1 X0 . SAVED HEADER OF SECOND PARAMETER PROCS 924
SB3 1 PROCS 925
QID6L BX1 X1-X2 PROCS 926
NZ X1,QIDDIF PROCS 927
SA1 A1-B3 PROCS 928
SA2 A2-B3 PROCS 929
SB1 B1-B3 PROCS 930
NZ B1,QID6L PROCS 931
JP QIDSAME PROCS 932
* PROCS 933
* FIRST PARAMETER WAS NOT SF TYPE. PROCS 934
* PROCS 935
QID7 SX3 X2-ITY PROCS 936
NZ X3,QIDDIF . (RECALL SECOND PARAM. IS A STRING) PROCS 937
SA1 A2-1 . FETCH INTEGER PROCS 938
RJ ITOSF . (SAVES B2) PROCS 939
SA6 B6-3 . STORE SVD PROCS 940
SX7 2 . AND SF TYPE PROCS 941
SA7 B6-2 . STACK HEADER PROCS 942
JP QID2 . NOW COMPARE STRINGS PROCS 943
* PROCS 944
* HERE WE HAVE FOUND THE PARAMETERS ARE NOT THE SAME. PROCS 945
* PROCS 946
QIDDIF NZ B2,QSUCC . ENTRY WAS THROUGH DIFFER PROCS 947
JP FAIL . FRETURN PROCS 948
* PROCS 949
COMPQ BSS 0 PROCS 950
* PROCS 951
* PROCS 952
* CONVERT(X), X A REAL, INTEGER, OR STRING PROCS 953
* PROCS 954
QCNVT PARAM 1 PROCS 955
SA1 B6 PROCS 956
AX1 55 . EXAMINE TYPE PROCS 957
ZR X1,QCNVT3 . SFTY PROCS 958
SX1 X1-RTY PROCS 959
NZ X1,QCNVT1 . INTEGER OR WHAT PROCS 960
SA1 B6-1 PROCS 961
RJ RTOSF PROCS 962
SA6 B6-1 PROCS 963
SX7 2 PROCS 964
SA7 B6 PROCS 965
EQ NEXTMIC PROCS 966
QCNVT1 SX1 X1+RTY-ITY PROCS 967
NZ X1,ERR29 . PARAMETER TYPE ERROR PROCS 968
SA1 B6-1 PROCS 969
PX6 X1 PROCS 970
NX6 X6 PROCS 971
QCNVT2 SA6 B6-1 PROCS 972
SX7 RTY PROCS 973
LX7 55 PROCS 974
SX1 2 PROCS 975
BX7 X1+X7 PROCS 976
SA7 B6 PROCS 977
EQ NEXTMIC PROCS 978
QCNVT3 BX7 X7-X7 . SIGN ASSUMED POSITIVE PROCS 979
BX6 X6-X6 . NUMBER STARTS AT ZERO PROCS 980
SA1 B6-1 . SVD PROCS 981
SX0 77B PROCS 982
SB4 0 . STATE := BEFORE POINT PROCS 983
SB5 1R--1R- . STATE := BEFORE SIGN PROCS 984
SA4 TEN PROCS 985
QCNVT4 ZR X1,QCNVT9 . END OF STRING PROCS 986
SA2 X1+0 . NEXT STRING WORD PROCS 987
SX1 X2+0 . LINK PROCS 988
BX2 X2-X1 . CLEAR LOWER 18 BITS PROCS 989
QCNVT5 LX2 6 PROCS 990
BX3 X0*X2 PROCS 991
ZR X3,QCNVT4 PROCS 992
SX3 X3-1R0 PROCS 993
NG X3,ERR53 . ILLEGAL CHARACTER IN REAL NUMBER PROCS 994
SB2 X3-1R++1R0 PROCS 995
GE B2,B0,QCNVT7 . NOT DIGIT PROCS 996
PX3 X3 PROCS 997
NX3 X3 PROCS 998
NZ B4,QCNVT6 . STATE IS AFTER POINT PROCS 999
FX6 X6*X4 . NUMBER := NUMBER * 10 PROCS 1000
FX6 X3+X6 . NUMBER := NUMBER + NEW DIGIT PROCS 1001
SB5 1R9-1R- . STATE := AFTER SIGN PROCS 1002
EQ QCNVT5 PROCS 1003
QCNVT6 FX3 X3*X5 . SCALE NEW DIGIT PROCS 1004
FX5 X5*X4 PROCS 1005
FX6 X3+X6 PROCS 1006
EQ QCNVT5 PROCS 1007
QCNVT7 SB2 X3-1R.+1R0 PROCS 1008
EQ B2,B4,QCNVT8 . POINT, IN -BEFORE POINT- STATE PROCS 1009
SB2 X3-1R-+1R0 PROCS 1010
GT B2,B5,ERR53 . ILLEGAL CHARACTER (INCLUDING PROCS 1011
* POINT OR SIGN IN WRONG STATE) PROCS 1012
SB5 1R9-1R- . STATE :=AFTER SIGN PROCS 1013
NG B2,QCNVT5 . SIGN WAS + PROCS 1014
MX7 60 . NEGATIVE PROCS 1015
EQ QCNVT5 PROCS 1016
QCNVT8 SA4 TENTH PROCS 1017
SB4 77B-1R.+1 . STATE := AFTER POINT (77B IS CODE PROCS 1018
* FOR SEMICOLON - SEE TEST AT QCNVT7)PROCS 1019
BX5 X4 PROCS 1020
EQ QCNVT5 PROCS 1021
QCNVT9 SA1 B6-1 PROCS 1022
BX6 X6-X7 . GIVE RESULT PROPER SIGN PROCS 1023
SX7 B7 PROCS 1024
SB7 X1 PROCS 1025
AX1 18 PROCS 1026
SA7 X1+0 . FREE SF STRING PROCS 1027
EQ QCNVT2 PROCS 1028
CNVTQ BSS 0 PROCS 1029
* PROCS 1030
* PROCS 1031
* PROCS 1032
* ARRAY( ", ! ) PROCS 1033
* PROCS 1034
* THIS FUNCTION CREATES AN ARRAY, WHICH INTERNALLY CONSISTS OF A PROCS 1035
* STRTYP BLOCK CONTAINING A SEQUENCE OF SVD-S (ONE PER ARRAY ELEMENT) PROCS 1036
* AS WELL AS A POINTER TO A DOPTYP BLOCK WITH ONE DOPEWORD FOR EACH PROCS 1037
* DIMENSION OF THE ARRAY. PROCS 1038
* THE SYNTAX FOR THE IS REGULAR (SEE BELOW) AND A PROCS 1039
* SIMPLE FINITE STATE MACHINE IS USED TO PARSE IT. AS THE STRING IS PROCS 1040
* PARSED, DOPEWORDS ARE FABRICATED AND PLACED ON TOP OF THE STACK IN A PROCS 1041
* SPECTY ENTRY. AFTER PARSING, A DOPE BLOCK IS ALLOCATED TO HOLD THESEPROCS 1042
* WORDS, AND AN ARRAY BLOCK IS ALLOCATED. THE ARRAY ELEMENTS ARE PROCS 1043
* INITIALIZED TO IF SPECIFIED, OTHERWISE TO THE NULL PROCS 1044
* STRING. (THROUGHOUT THE CODE, B5, WHICH SAVES THE NUMBER OF ACTUAL PROCS 1045
* PARAMETERS LESS 2, IS PRESERVED.) PROCS 1046
* PROCS 1047
* HERE IS THE SYNTAX FOR THE : PROCS 1048
* PROCS 1049
* BOUND = NULL ] '+' ] '-' ] *BOUND ANY( '0123456789' ) PROCS 1050
* BDPAIR = BOUND ] BOUND ANY( '/:' ) BOUND PROCS 1051
* PROTOTYPE = BOUND ARBNO( ',' BOUND ) PROCS 1052
* PROCS 1053
* PROCS 1054
QAR3 SX1 X1-ITY PROCS 1055
NZ X1,ERR29 . WRONG TYPE OF PARAMETER PROCS 1056
SA3 A1-1 . FETCH INTEGER PROCS 1057
NG X3,ERR48 . LOWER BOUND (IMPLICITLY=1) > UPPER PROCS 1058
ZR X3,ERR48 . (DITTO) PROCS 1059
BX4 X3 PROCS 1060
AX4 17 . DIVIDE BY 2**17 (RECALL X3 > 0) PROCS 1061
NZ X4,ERR50 . U - L + 1 TOO BIG PROCS 1062
SX7 SPECTY PROCS 1063
LX7 1+18 PROCS 1064
BX7 X7+X3 . F3 = PRODUCT( U-L+1 ) = (X3) PROCS 1065
LX7 18+18 PROCS 1066
SX5 B1 . = 2 = BYPASS PROCS 1067
BX7 X7+X5 PROCS 1068
SA7 B6 . STORE STACK HEADER PROCS 1069
* PROCS 1070
* NOW WE'LL SHIFT X5 TO GET AN ARRAY DOPEWORD FLAG (BIT 1). PROCS 1071
* PROCS 1072
LX5 57 . BIT 58 TO BIT 1 PROCS 1073
BX5 X5+X3 . DOPEWORD F1 CONTAINS UPPER BOUND PROCS 1074
MX6 59 . =-1 PROCS 1075
LX3 18 . F3 WILL CONTAIN U-L+1 = UPPER PROCS 1076
BX3 -X6+X3 . F2 WILL CONTAIN LOWER = 1 PROCS 1077
LX3 18 PROCS 1078
BX7 X5+X3 . ADD F3,F2 TO DOPEWORD PROCS 1079
SA7 B6+X6 . = B6-1 PROCS 1080
JP QARRSDOP . RESERVE DOPE VECTOR ET CETERA PROCS 1081
* PROCS 1082
QARRAY PARAM 1 . (SECOND PARAMETER NOT YET IMPLEMENTPROCS 1083
SA1 B6 . HEADER OF LAST PARAMETER PROCS 1084
SB1 X1 PROCS 1085
QAR1 AX1 55 PROCS 1086
NZ X1,QAR3 . NOT SF TYPE PROCS 1087
SB6 B6-B1 . POP (THE) PARAMETER PROCS 1088
SA1 A1-1 . FETCH SVD PROCS 1089
SX6 X1 . -FIRST- POINTER PROCS 1090
AX1 18+18 PROCS 1091
SA2 MINHS . C(MINHS) = LOC(XWRD) PROCS 1092
SB1 X1 . LENGTH OF PROTOTYPE STRING PROCS 1093
ZR B1,ERR43 . NULL NOT LEGAL PROCS 1094
SA6 X2 . XWRD WILL POINT TO REST OF PROTOTYPPROCS 1095
SX0 CHMASK . ONE-CHARACTER MASK PROCS 1096
SB3 0 . INITIALIZE FSM STATE TO 0 PROCS 1097
SA0 1 . RESERVE SPACE FOR PROCS 1098
RJ RESERVE . SPECTY BLOCK OF LENGTH 1 (JUST HEADER) PROCS 1099
SX7 SPECTY PROCS 1100
LX7 1+18 PROCS 1101
SX6 1 PROCS 1102
BX7 X7+X6 . F3 CONTAINS PRODUCT (I,U"I!-L"I!+1)PROCS 1103
LX7 18+18 PROCS 1104
BX7 X7+X6 . F1=BYPASS=1 PROCS 1105
SA7 B6 PROCS 1106
* PROCS 1107
* IN THE FSM, REGISTER USAGE IS AS FOLLOWS: PROCS 1108
* X0 CONTAINS A ONE-CHARACTER MASK, RIGHT JUSTIFIED ZERO FILLED PROCS 1109
* X2 CONTAINS PROTOTYPE STRING WORD PROCS 1110
* X3 CONTAINS CURRENT BOUND BEING COMPUTED PROCS 1111
* X4 CONTAINS SIGN FOR X3 - +0/-0 FOR +/- RESPECTIVELY PROCS 1112
* X7 CONTAINS THE LOWER BOUND WHILE THE UPPER BOUND BEING COMPUTED PROCS 1113
* B1 = LENGTH OF STRING POINTED TO BY XWRD PROCS 1114
* B2 = NUMBER OF CHARACTERS IN X2 PROCS 1115
* B3 = FSM STATE - 0 = BEFORE SIGN, BEFORE COLON PROCS 1116
* 1 = AFTER SIGN, ... PROCS 1117
* 2 = BEFORE SIGN, AFTER COLON PROCS 1118
* 3 = AFTER SIGN, ... PROCS 1119
* PROCS 1120
* B4 = CLASS OF CURRENT CHARACTER - 0 = END 36 = DIGIT PROCS 1121
* 12 = COMMA 48 = SIGN PROCS 1122
* 24 = COLON PROCS 1123
* PROCS 1124
QARSCAN1 ZR B1,QAR.EOS . END OF PROTOTYPE CLASS PROCS 1125
SA1 MINHS . RECALL C(MINHS) = LOC(XWRD) PROCS 1126
SA1 X1 PROCS 1127
SA2 X1 . FETCH NEXT STRING WORD PROCS 1128
SX6 B7 . AND PROCS 1129
SA6 X1 . FREE PROCS 1130
SB7 X1 . IT PROCS 1131
SX6 X2 PROCS 1132
SB2 CHPWD . NUMBER OF CHARACTERS PER WORD PROCS 1133
SA6 A1 . UPDATE XWRD PROCS 1134
SB1 B1-B2 PROCS 1135
PL B1,QARSCAN . X2 CONTAINS -CHPWD- CHARACTERS PROCS 1136
SB2 B2+B1 PROCS 1137
SB1 0 . X2 IS THE LAST WORD OF THE PROTOTYPPROCS 1138
* PROCS 1139
* HERE WE FETCH THE NEXT CHARACTER AND CLASSIFY IT AS A SIGN, PROCS 1140
* DIGIT, COLON, COMMA, OR END OF STRING. PROCS 1141
* PROCS 1142
QARSCAN ZR B2,QARSCAN1 . X2 IS EMPTY PROCS 1143
SB2 B2-1 PROCS 1144
LX2 CHSIZ PROCS 1145
BX6 X0*X2 . EXTRACT NEXT CHARACTER PROCS 1146
* PROCS 1147
* (THE FOLLOWING SECTION OF CODE IS HIGHLY CHARACTER CODE DEPENDENT.) PROCS 1148
* PROCS 1149
SX6 X6-1R0 . (SEQUENCE IS LETTERS DIGITS +-*/...) PROCS 1150
NG X6,ERR39 . ALPHABETIC - ERROR PROCS 1151
SX5 X6+1R0-1R+ PROCS 1152
NG X5,QAR.DIG . DIGIT - BINARY IS IN X6 PROCS 1153
SX6 X5+1R+-1R* PROCS 1154
NG X6,QAR.SGN . SIGN - 0 OR 1 (FOR + OR -) IS IN X5PROCS 1155
SX6 X6+1R*-1R/ PROCS 1156
ZR X6,QAR.CLN . SLASH - SUBSTITUTE FOR COLON PROCS 1157
SX6 X6+1R/-1R, PROCS 1158
ZR X6,QAR.COM . COMMA PROCS 1159
SX6 X6+1R,-1R: PROCS 1160
NZ X6,ERR39 . OTHER - ERROR PROCS 1161
* PROCS 1162
QAR.CLN SB4 24 . SET CHARACTER CLASS PROCS 1163
JP QARFSM . PERFORM FSM TRANSFORMATION PROCS 1164
* PROCS 1165
QAR.DIG SB4 36 PROCS 1166
JP QARFSM PROCS 1167
* PROCS 1168
QAR.SGN LX5 59 PROCS 1169
AX5 59 PROCS 1170
SB4 48 PROCS 1171
BX4 X5 . SIGN FILLED PROCS 1172
JP QARFSM PROCS 1173
* PROCS 1174
QAR.COM SB4 12 PROCS 1175
JP QARFSM PROCS 1176
* PROCS 1177
QAR.EOS SB4 0 PROCS 1178
* PROCS 1179
* NOW, BASED ON THE STATE AND CURRENT CHARACTER CLASS (B3 AND B4), PROCS 1180
* PERFORM A FSM ACTION AND, IF B1+B2=0 (EOS), EXIT PROCS 1181
* THE PROTOTYPE SCANNER. PROCS 1182
* PROCS 1183
QARFSM SA1 QARST+B3 PROCS 1184
AX1 B4,X1 PROCS 1185
MX5 60-2 . EXTRACT PROCS 1186
BX5 -X5*X1 . NEXT PROCS 1187
SB3 X5 . STATE PROCS 1188
AX1 2 PROCS 1189
MX5 60-10 . EXTRACT PROCS 1190
BX5 -X5*X1 . ACTION PROCS 1191
SB4 X5 . ADDRESS PROCS 1192
JP QARACTS+B4 PROCS 1193
* PROCS 1194
* PROCS 1195
STWD MACRO ACTA,STA,ACTB,STB,ACTC,STC,ACTD,STD,ACTE,STE PROCS 1196
+ VFD 10/QAR_ACTA-QARACTS,2/STA PROCS 1197
VFD 10/QAR_ACTB-QARACTS,2/STB PROCS 1198
VFD 10/QAR_ACTC-QARACTS,2/STC PROCS 1199
VFD 10/QAR_ACTD-QARACTS,2/STD PROCS 1200
VFD 10/QAR_ACTE-QARACTS,2/STE PROCS 1201
ENDM PROCS 1202
* PROCS 1203
* CLASS _ SIGN, DIGIT, COLON, COMMA, END / STATE ? PROCS 1204
QARST STWD INITR,1,STPLS,1,STLB0,2,ERR2,,ERR2, . STATE 0 PROCS 1205
STWD ERR2,,ACCR,1,STLBR,2,SL1UR,0,SL1UR, . STATE 1 PROCS 1206
STWD INITR,3,STPLS,3,ERR2,,STUB0,0,STUB0, . STATE 2 PROCS 1207
STWD ERR2,,ACCR,3,ERR2,,STUBR,0,STUBR, . STATE 3 PROCS 1208
* PROCS 1209
* PROCS 1210
QARACTS BSS 0 PROCS 1211
* PROCS 1212
QARERR2 BSS 0 . SYNTAX ERROR PROCS 1213
ERR43 ERROR 43 . IN ARRAY PROTOTYPE PROCS 1214
* PROCS 1215
QARINITR SX3 0 . INITIALIZE R = 0 PROCS 1216
JP QARSCAN PROCS 1217
* PROCS 1218
QARSTPLS SX3 X6 . SET R = FIRST DIGIT PROCS 1219
SX4 B0 . (SIGN = +) PROCS 1220
JP QARSCAN PROCS 1221
* PROCS 1222
QARACCR LX3 1 . SET R TO R*10 + NEW DIGIT PROCS 1223
BX5 X3 PROCS 1224
LX5 2 . R*8 PROCS 1225
IX3 X3+X5 . R*2 + R*8 = R*10 PROCS 1226
IX3 X3+X6 . ADD NEW DIGIT PROCS 1227
SX5 377777B . LARGEST 18 BIT POSITIVE QUANTITY PROCS 1228
IX5 X5-X3 PROCS 1229
NG X5,ERR49 . ABS(BOUND) TOO LARGE PROCS 1230
JP QARSCAN PROCS 1231
* PROCS 1232
QARSTLB0 SX7 0 . SET LOWER BOUND = 0 PROCS 1233
JP QARSCAN PROCS 1234
* PROCS 1235
QARSTLBR BX7 X3-X4 . SET LOWER BOUND TO R*SIGN(R) PROCS 1236
JP QARSCAN PROCS 1237
* PROCS 1238
QARSTUB0 BX3 X3-X3 . SET UPPER BOUND = 0 PROCS 1239
BX4 X4-X4 . (SIGN = +) PROCS 1240
JP QARSTUBR PROCS 1241
* PROCS 1242
QARSL1UR SX7 1 . SET LOWER BOUND = 1, PROCS 1243
QARSTUBR BX3 X3-X4 . SET UPPER BOUND = R*SIGN(R) PROCS 1244
IX4 X3-X7 . UPPER-LOWER PROCS 1245
NG X4,ERR48 . UPPER < LOWER PROCS 1246
MX5 60-18 PROCS 1247
BX7 -X5*X7 . TRIM BOUNDS PROCS 1248
BX3 -X5*X3 . TO 18 BITS PROCS 1249
MX5 59 . = -1 PROCS 1250
IX4 X4-X5 . U-L+1 PROCS 1251
SX6 377777B . LARGEST 18 BIT PROCS 1252
IX1 X6-X4 PROCS 1253
NG X1,ERR50 . U-L+1 TOO LARGE PROCS 1254
LX5 4+18 . BIT 1 OF DOPEWORD IS ARRAY FLAG PROCS 1255
BX5 -X5+X4 . F3 CONTAINS U-L+1 PROCS 1256
LX5 18 PROCS 1257
BX7 X5+X7 . F2 CONTAINS L PROCS 1258
LX7 18 PROCS 1259
BX7 X7+X3 . F1 CONTAINS U PROCS 1260
* PROCS 1261
* NOW RESERVE ANOTHER WORD ON TOP OF THE STACK, AND INCREASE PROCS 1262
* THE TOP SPECTY ENTRY SIZE TO INCLUDE THE NEW DOPEWORD. PROCS 1263
* PROCS 1264
SA1 B6+0 . FETCH HEADER PROCS 1265
SX3 1 PROCS 1266
IX3 X1+X3 . INCREASE THE BYPASS PROCS 1267
LX3 6+18 . RIGHT JUSTIFY F3 OF STACK HEADER PROCS 1268
SX5 X3 PROCS 1269
PX5 X5 . PACK C(F3) = PRODUCT(J X7 PROCS 1360
JP QSTAKR . STACKS X2,X7 AND EXITS PROCS 1361
* PROCS 1362
ARRAYQ BSS 0 . END OF ARRAY() CODE PROCS 1363
* PROCS 1364
* PROCS 1365
* REMARK PUTS A MESSAGE ON THE DAYFILE, USING THE SCOPE FUNCTION MSG. PROCS 1366
* UNDER PSEUDO-SCOPE (TSS), MSG-S GO TO THE TELETYPE, AND THUS WE HAVE PROCS 1367
* THE PROCEDURE OUT. THE ARGUMENT IS A SINGLE STRING OR INTEGER. PROCS 1368
* PROCS 1369
* PROCS 1370
QREMARK PARAM 1 PROCS 1371
SA2 B6 PROCS 1372
AX2 55 PROCS 1373
SA1 B6-1 PROCS 1374
BX6 X1 PROCS 1375
ZR X2,QREMARK1 . PARAMETER IS STRING PROCS 1376
SX2 X2-ITY PROCS 1377
NZ X2,ERR29 . NOT INTEGER, TYPE ERROR PROCS 1378
RJ ITOSF INTEGER IN X1 TO SVD IN X6 PROCS 1379
SX7 2 PROCS 1380
SA6 B6-1 . STORE NEWLY MADE SVD PROCS 1381
NO PROCS 1382
NO PROCS 1383
SA7 B6+0 . STORE STACK BYPASS PROCS 1384
QREMARK1 SX7 B6-1 . ADDRESS OF STRING SVD PROCS 1385
SX5 QRMKFET-FI.FET PROCS 1386
LX5 18 PROCS 1387
AX6 36 PROCS 1388
SX6 X6-81 PROCS 1389
PL X6,ERR56 . MESSAGE TOO LONG PROCS 1390
SX6 QRMKBUF PROCS 1391
BX7 X5+X7 PROCS 1392
SA7 QRMKSVD PROCS 1393
SB3 A7 . PARAM FOR OUTPUT ROUTINE PROCS 1394
SA6 QRMKFET+1 . PSEUDO FIRST POINTER PROCS 1395
SA6 A6+1 . IN PROCS 1396
SA6 A6+1 . OUT PROCS 1397
SX6 X6+QRMKBUFL PROCS 1398
SA6 A6+1 . LIMIT PROCS 1399
RJ OUTPUT PROCS 1400
SA1 QRMKCALL . MSG CALL PROCS 1402
BX7 X1 PROCS 1404
SA7 1 PROCS 1406
+ SA1 1 PROCS 1407
NZ X1,* . WAIT FOR RA+1 TO CLEAR PROCS 1408
CALL SKIPONE,B5 . REMOVE PARAMETER PROCS 1409
JP RETNULL . RETURN NULL VALUE PROCS 1410
* PROCS 1411
QRMKCALL VFD 24/0LMSGP,18/0,18/QRMKBUF ******* 1
* PROCS 1413
QRMKSVD EQU PMASX3 PROCS 1414
QRMKSTAT EQU PMASX3 PROCS 1415
QRMKFET EQU 2 PROCS 1416
QRMKBUF EQU 2+5 PROCS 1417
QRMKBUFL EQU 3*8 . LONG ENOUGH SO BUFFER WILL NEVER BEPROCS 1418
. MORE THAN 1/2 FULL, SO OUTPUT WILL PROCS 1419
. NOT TRY TO ISSUE A WRITE PROCS 1420
* PROCS 1421
REMARKQ BSS 0 PROCS 1422
* PROCS 1423
IN IFNE TSS,0 PROCS 1424
* PROCS 1425
* IN IS THE PROCEDURE USED TO COLLECT THE NEXT LINE FROM THE TELETYPE. PROCS 1426
* IT CALLS THE PSEUDO-SCOPE (TSS) FUNCTION GSM (MSG BACKWARDS), WHICH PROCS 1427
* RETURNS A LIST OF CHARACTERS IN R1 FORMAT. THE COMPILER STACK SPACE INPROCS 1428
* LOW CORE, 2 THROUGH 2+STAKSP-1, IS USED AS THE BUFFER SPACE. IN PROCS 1429
* ADDITION, RTOSF0, PART OF THE REAL-TO-STRING CONVERSION ROUTINE, IS PROCS 1430
* USED TO BUILD A SNOBOL STRING FROM THE INDIVIDUAL CHARACTERS. IN TAKESPROCS 1431
* A SINGLE, ARBITRARY ARGUMENT. PROCS 1432
* PROCS 1433
QIN PARAM 0 PROCS 1434
SA1 QINCALL PROCS 1435
BX7 X1 PROCS 1436
BX6 X6-X6 . INITIALIZE CHARACTER BUFFER PROCS 1437
SA7 1 PROCS 1438
SB5 42 . INITIALIZE BIT COUNT PROCS 1439
+ SA1 A7 PROCS 1440
NZ X1,* . WAIT FOR RA+1 TO CLEAR PROCS 1441
SA0 B0 . INITIALIZE CHARACTER COUNT PROCS 1442
SB4 QINE . @RETURN@ FROM RTOSF0 PROCS 1443
SA3 MINHS PROCS 1444
SA4 QINBUFF PROCS 1445
SX7 B7 PROCS 1446
BX0 X4 PROCS 1447
SA7 X3 . SAVE START OF NEW STRING PROCS 1448
NZ X4,RTOSF0 PROCS 1449
QINB SX5 A0 PROCS 1450
LX5 36 . POSITION CHARACTER COUNT PROCS 1451
SB5 B5+18 PROCS 1452
LX6 B5,X6 . LEFT JUSTIFY LAST WORD PROCS 1453
SA1 B7 PROCS 1454
NZ X1,QINC PROCS 1455
RJ MORFREE PROCS 1456
QINC SA6 A1+0 PROCS 1457
SB7 X1+0 PROCS 1458
SX6 A6 . LWA PROCS 1459
LX6 18 PROCS 1460
BX6 X6+X7 . FWA PROCS 1461
BX6 X5+X6 . CHARACTER SOUNT PROCS 1462
SX7 2 PROCS 1463
SB6 B6+X7 . BUMP STACK POINTER PROCS 1464
SA7 B6 PROCS 1465
SA6 B6-1 PROCS 1466
BX6 X6-X6 PROCS 1467
SA6 X3 PROCS 1468
EQ NEXTMIC PROCS 1469
* PROCS 1470
QINE SA4 A4+1 PROCS 1471
ZR X4,QINB . END OF LINE PROCS 1472
BX0 X4 PROCS 1473
EQ RTOSF0 PROCS 1474
* PROCS 1475
QINCALL VFD 18/3LGSM,42/QINBUFF PROCS 1476
* PROCS 1477
QINBUFF EQU 2 . (LENGTH IS STAKSP) PROCS 1478
* PROCS 1479
INQ BSS 0 PROCS 1480
* PROCS 1481
IN ENDIF PROCS 1482
* PROCS 1483
* PROCS 1484
* TIME() = 'HH:MM:SS' PROCS 1485
* PROCS 1486
* THIS FUNCTION RETURNS THE CURRENT TIME OF DAY IN THE FORMAT SHOWN ABVPROCS 1487
* PROCS 1488
QTIME SB1 QTD . RETURN PROCS 1489
SB2 8 . LENGTH OF VALUE STRING PROCS 1490
MX3 6 . 1 CHARACTER MASK PROCS 1491
PROCS 1492
* TOD RETURNS THE CURRENT TIME-OF-DAY IN X6, FORMATTED AS 23:59:59, PROCS 1493
* LEFT-JUSTIFIED, BLANK FILLED. TOD USES A1-X1,X2,A6-X6, AND RETURNS TO PROCS 1494
* THE ADDRESS PASSED TO IT IN B1. PROCS 1495
PROCS 1496
TOD SA1 TODCALL . SCOPE RA+1 REQUEST WORD PROCS 1497
SX6 0 PROCS 1498
SA6 TODWD . THE LOW ORDER BIT OF THE RESPONS PROCS 1499
* WORD IS NON-ZERO WHEN THE REQUEST PROCS 1500
* PROCESSING IS COMPLETE PROCS 1501
BX6 X1 PROCS 1502
SA6 1 . ISSUE REQUEST PROCS 1503
TOD1 SA1 1 PROCS 1504
NZ X1,TOD1 . WAIT FOR COMPLETION PROCS 1505
SA1 TODWD . TIME, IN BHH.MM.SS. FORMAT PROCS 1506
SA2 TODMASK PROCS 1507
BX6 X1-X2 . CHANGE DOTS TO COLONS AND BLANK PROCS 1508
LX6 6 . LEFT JUSTIFY PROCS 1509
JP B1 . RETURN PROCS 1510
PROCS 1511
TODCALL VFD 18/3LTIM . PP ROUTINE PROCS 1512
VFD 2/1 . RECALL DESIRED PROCS 1513
VFD 16/2 . TIM FUNCTION FOR T-O-D PROCS 1514
VFD 24/TODWD . ADDRESS FOR RESPONSE PROCS 1515
TODWD EQU PMASX3 PROCS 1516
TODMASK VFD 24/34B,18/34B,18/2 PROCS 1517
PROCS 1518
* DATE IS LIKE TIME, EXCEPT IT RETURNS A 9 CHARACTER STRING, AS PROCS 1519
* 10 JUL 70. PROCS 1520
PROCS 1521
QDATE SB1 QTD PROCS 1522
SB2 9 . LENGTH OF RESULT STRING PROCS 1523
MX3 2*6 PROCS 1524
PROCS 1525
* CALENDR RETURNS THE CURRENT DATE IN X6, FORMATTED AS 10 JUL 70, LEFT PROCS 1526
* JUSTIFIED, BLANK FILLED. CALENDR USES X0,A1-X1,X2,A6-X6. IT RETURNS TOPROCS 1527
* THE ADDRESS PASSED TO IT IN B1. PROCS 1528
PROCS 1529
CALENDR SA1 DATCALL PROCS 1530
SX6 0 PROCS 1531
SA6 DATWD . CLEAR RESPONS WORD PROCS 1532
BX6 X1 PROCS 1533
SA6 1 . ISSUE REQUEST PROCS 1534
CAL1 SA1 A6 PROCS 1535
NZ X1,CAL1 . WAIT FOR COMPLETION PROCS 1536
SA1 DATWD ******* 2
BX6 X1 ******* 3
LX6 6 ******* 4
JP B1 ******* 5
DATCALL VFD 24/0LTIMP,12/1,24/DATWD ******* 6
DATWD = PMASX3 ******* 7
PROCS 1570
M MACRO E,O PROCS 1571
VFD 6/1R ,18/3R_E,12/2R ,18/3R_O,6/1R PROCS 1572
ENDM PROCS 1573
PROCS 1574
MONTHS M JAN,FEB PROCS 1575
M MAR,APR PROCS 1576
M MAY,JUN PROCS 1577
M JUL,AUG PROCS 1578
M SEP,OCT PROCS 1579
M NOV,DEC PROCS 1580
PROCS 1581
GETL MACRO PROCS 1582
LOCAL NEXT PROCS 1583
SA1 B7 PROCS 1584
NZ X1,NEXT PROCS 1585
RJ MORFREE PROCS 1586
NEXT SB7 X1 PROCS 1587
SX1 X1 PROCS 1588
ENDM PROCS 1589
PROCS 1590
QTD MX0 7*6 PROCS 1591
BX7 X0*X6 . FIRST 7 CHARACTERS PROCS 1592
LX6 7*6 PROCS 1593
GETL . GET A (CLEARED) FREELIST WORD IN X1PROCS 1594
SX2 A1 . SAVE ADDRESS OF THIS FREE WORD PROCS 1595
BX7 X7+X1 PROCS 1596
SA7 A1 PROCS 1597
BX6 X3*X6 PROCS 1598
SX3 B2 . LENGTH OF STRING PROCS 1599
LX3 18+18 PROCS 1600
GETL PROCS 1601
SA6 A1 PROCS 1602
SX6 A6 . LWA FOR SVD TO BE CONSTRUCTED PROCS 1603
LX6 18 PROCS 1604
BX6 X3+X6 . F3 IS LENGTH PROCS 1605
BX6 X6+X2 PROCS 1606
SB2 B0 . STACK HEADER TYPE OF RESULT PROCS 1607
QTDC SX4 * . SET RETURN POINT FOR PARAM MACRO PROCS 1608
PARAM 0 . (X5 STILL CONTAINS THE AP COUNT) PROCS 1609
SX2 B2 PROCS 1610
LX2 55 . POSITION STACK HEADER TYPE PROCS 1611
BX7 X6 PROCS 1612
JP QSTAKR . STACKS X2,X7 AND EXITS PROCS 1613
PROCS 1614
* CLOCK IS SIMILAR TO DATE AND TIME, BUT IT RETURNS AN INTEGER PROCS 1615
* REPRESENTING THE NUMBER OF MILLISECONDS OF CPU TIME THE JOB HAS PROCS 1616
* CONSUMED SO FAR. PROCS 1617
PROCS 1618
QCLOCK SA1 CLKCALL PROCS 1619
BX6 X1 PROCS 1620
BX7 X7-X7 PROCS 1621
SA7 CLKWD . CLEAR RESPONSE WORD PROCS 1622
SA6 1 . ISSUE REQUEST PROCS 1623
QCLK1 SA1 A6 PROCS 1624
NZ X1,QCLK1 . WAIT FOR COMPLETION PROCS 1625
MX0 48 PROCS 1626
SA1 CLKWD . 24/WHO KNOWS,24/SECS,12/MILLISECS PROCS 1627
BX6 -X0*X1 PROCS 1628
AX1 12 PROCS 1629
MX0 60-24 PROCS 1630
BX1 -X0*X1 PROCS 1631
LX1 3 . 8 * SECONDS PROCS 1632
BX2 X1 PROCS 1633
LX1 1 . 16 * SECONDS PROCS 1634
IX2 X2+X1 . 24 * SECONDS PROCS 1635
LX1 6 . 1024 * SECONDS PROCS 1636
IX1 X1-X2 . 1000 * SECONDS PROCS 1637
SB2 ITY . SET B2 = TYPE OF RESULT PROCS 1638
IX6 X1+X6 PROCS 1639
JP QTDC PROCS 1640
PROCS 1641
CLKCALL VFD 18/3LTIM . PP ROUTINE PROCS 1642
VFD 2/1 . RECALL DESIRED PROCS 1643
VFD 16/0 . TIM FUNCTION FOR ELAPSED TIME PROCS 1644
VFD 24/CLKWD . RESPONSE ADDRESS PROCS 1645
CLKWD EQU PMASX3 PROCS 1646
PROCS 1647
TDCQ BSS 0 . END OF TIME, DATE, CLOCK PROCS 1648
* PROCS 1649
* PROCS 1650
* EOI( ) "PREDICATE! PROCS 1651
* PROCS 1652
* THIS PROCEDURE RETURNS THE NULL STRING IF IS POSITIONED ATPROCS 1653
* END-OF-INFORMATION, AND FAILS OTHERWISE. PROCS 1654
* PROCS 1655
QEOI PARAM 1 PROCS 1656
CALL FINDFIL . CONVERT SF ON STACK TO FILE PTR IN PROCS 1657
NZ X4,ERR35 . X3 ... RETURNS X4.NE.0 IFF NO SUCHPROCS 1658
SA3 X3+FI.RFC . WORD WITH EOR,EOI FLAGS, REF. COUNTPROCS 1659
LX3 59-36 . LOOK AT EOI FLAG PROCS 1660
PL X3,FAIL . NOT EOI PROCS 1661
JP RETNULL . RETURN NULL VALUE PROCS 1662
* PROCS 1663
* PROCS 1664
* THIS ROUTINE SEARCHES FILLIST FOR A FILE WITH A SPECIFIED PROCS 1665
* FILENAME. TWO ENTRIES EXIST: FINDFIL IS CALLED WITH AN PROCS 1666
* SFTY SVD ON TOP OF THE STACK, WHICH IT REMOVES; FFILX3 PROCS 1667
* IS CALLED WITH AN SFTY SVD IN X3. IN EITHER CASE, THE SF PROCS 1668
* STRING IS FREED. PROCS 1669
* PROCS 1670
* RESULT: X4=0 IFF FILE FOUND, IN WHICH CASE X3=ADDRESS PROCS 1671
* OF FILE BLOCK. PROCS 1672
* PROCS 1673
* USES: A2-X2, A3-X3, A4-X4, A7-X7, B2 PROCS 1674
* PROCS 1675
FINDFIL SA2 B6 . HEADER OF TOP STACK ENTRY PROCS 1676
AX2 55 PROCS 1677
NZ X2,ERR40 . TYPE ERROR, MUST BE STRING PROCS 1678
SB6 B6-2 . POP STACK ENTRY PROCS 1679
SA3 A2-1 . FETCH SVD PROCS 1680
FFILX3 SA2 X3 . (FIRST WORD OF) STRING PROCS 1681
SX7 B7 . FREE PROCS 1682
SB7 X3 . THE PROCS 1683
AX3 18 . PARAMETER PROCS 1684
SA7 X3 . STRING PROCS 1685
MX0 42 PROCS 1686
SA3 FILLIST . HEAD OF FILE BLOCK LIST PROCS 1687
FINDFILL SA4 X3+FI.FET+FET.LFN . FETCH FILENAME WORD FROM FET PROCS 1688
BX4 X0*X4 . CLEAR OUT CODE AND STATUS FIELD PROCS 1689
BX4 X2-X4 PROCS 1690
ZR X4,JPB1 . FILE FOUND, RETURN X4=0 AND X3=FILE PTRPROCS 1691
SA3 X3 . FETCH THIS FILE BLOCK HEADER PROCS 1692
SX3 X3 . LINK FIELD PROCS 1693
NZ X3,FINDFILL . KEEP LOOKING PROCS 1694
JP B1 . NOT FOUND, RETURN X4.NE.0 PROCS 1695
* PROCS 1696
EOIQ BSS 0 . EOI NEEDS FETLOOK PROCS 1697
* PROCS 1698
* PROCS 1699
* VALID CHECKS THE FILENAME IN X6. IF IT IS INVALID, X6 IS SET TO ZERO. PROCS 1700
* X2, X3, X4, X5, AND X7 ARE USED. PROCS 1701
* PROCS 1702
VALID PROCS 1703
SA2 MASK PROCS 1704
SA3 MAX PROCS 1705
BX4 -X2*X3 . MAX(2,4,6,8-10) PROCS 1706
BX3 X2*X3 . MAX(1,3,5,7) PROCS 1707
BX5 X2*X6 . LFN(1,3,5,7) PROCS 1708
BX7 -X2*X6 . LFN(2,4,6,8-10) PROCS 1709
IX3 X3-X5 PROCS 1710
IX4 X4-X7 PROCS 1711
BX3 -X2*X3 PROCS 1712
BX4 X2*X4 PROCS 1713
BX3 X3+X4 PROCS 1714
ZR X3,VALID . FILENAME OK PROCS 1715
BX6 X6-X6 PROCS 1716
EQ VALID PROCS 1717
MASK VFD 12/7700B,12/7700B,12/7700B,12/7700B,12/0000B PROCS 1718
MAX DATA 7LZ999999 . MAXIMUM ALLOWABLE FILENAME PROCS 1719
* PROCS 1720
* DETACH( )= NULL PROCS 1721
* PROCS 1722
* CALLING DETACH REMOVES THE INPUT/OUTPUT ASSOCIATION, IF ANY, PROCS 1723
* FROM THE VARIABLE NAMED BY , WHICH MUST BE PROCS 1724
* A STRING OR NAME OBJECT. PROCS 1725
* PROCS 1726
QDETACH PARAM 1 . NAME OF VARIABLE TO DETACH PROCS 1727
RJ INDRCT . POP PARAM, RETURN SVD ADDRESS IN X1PROCS 1728
CALL DETACH,,RETNULL . DO THE WORK (AND RETURN NULL) PROCS 1729
* PROCS 1730
* PROCS 1731
* DETACH IS CALLED WITH THE ADDRESS OF AN SVD IN X1. IF IT IS PROCS 1732
* INTY OR OUTTY , THE VALUE SVD IS WRITTEN OVER THE ORIGINAL PROCS 1733
* SVD, THE LISTWORD OCCUPIED BY THE VALUE SVD IS FREED, AND THE PROCS 1734
* ASSOCIATED FILE BLOCK REFERENCE COUNT IS DECREMENTED. IF THIS COUNT PROCS 1735
* GOES TO ZERO, THE FILE IS CLOSED, THE BLOCK IS RELEASED, AND PROCS 1736
* FILLIST IS UPDATED. (RETURNS TO ADDRESS IN B1.) PROCS 1737
* PROCS 1738
* USES: X0, A1-X1, A2-X2, A3-X3, A7-X7, B2, B3, B4 PROCS 1739
* PROCS 1740
DETACH SA2 X1+0 . FETCH (POSSIBLY I/O ASSOCIATED) SVDPROCS 1741
BX3 X2 PROCS 1742
AX3 55 . RIGHT JUSTIFY TYPE FIELD PROCS 1743
SX7 X3-INTY PROCS 1744
ZR X7,DETACH1 . INPUT ASSOCIATED PROCS 1745
SX7 X3-OUTTY PROCS 1746
NZ X7,DETACHR . NOT ASSOCIATED, RETURN PROCS 1747
DETACH1 SA3 X2 . FETCH THE VALUE SVD PROCS 1748
BX7 X3 . AND WRITE IT OVER PROCS 1749
SA7 A2 . THE ACTUAL SVD PROCS 1750
SX7 B7 . FREE THE PROCS 1751
SA7 A3 . OLD SVD PROCS 1752
SB7 A3 . LIST WORD PROCS 1753
AX2 18 . RIGHT JUSTIFY THE FILE BLOCK POINTERPROCS 1754
MX7 59 . =-1 PROCS 1755
SA3 X2+FI.RFC . REFERENCE COUNT WORD PROCS 1756
IX7 X3+X7 PROCS 1757
SX3 X7 PROCS 1758
SA7 A3 PROCS 1759
NZ X3,DETACHR . COUNT IS POSITIVE, RETURN PROCS 1760
* PROCS 1761
* THE FILE BLOCK IS TO BE DELETED. WE REMOVE IT FROM FILLIST AND PROCS 1762
* CLOSE IT, THEN RELEASE THE HEAP BLOCK. PROCS 1763
* PROCS 1764
MX7 60-18 PROCS 1765
SA3 FILLIST PROCS 1766
SA1 X2 . EXTRACT LINK FIELD OF HEADER PROCS 1767
BX1 -X7*X1 . OF BLOCK TO BE DELETED PROCS 1768
DETACHL BX0 X2-X3 PROCS 1769
BX0 -X7*X0 PROCS 1770
ZR X0,DETACHF . X3 POINTS TO BLOCK TO GO PROCS 1771
SA3 X3 PROCS 1772
EQ DETACHL PROCS 1773
DETACHF BX3 X7*X3 . CLEAR OLD LINK FIELD PROCS 1774
BX7 X3+X1 PROCS 1775
SA7 A3 PROCS 1776
SB2 X2 . FILE BLOCK ADDRESS FOR CLOSE1 PROCS 1777
RJ CLOSE1 . CLOSE FILE (SAVES B2) PROCS 1778
SB3 B2 PROCS 1779
SA1 B3 . HEADER OF BLOCK TO BE DELETED PROCS 1780
AX1 18 . RIGHT ADJUST BYPASS FIELD PROCS 1781
SB4 B3+X1 . SET B4 = LWA+1 OF BLOCK PROCS 1782
RJ FREEHB . RELEASE THE BLOCK PROCS 1783
DETACHR JP B1 . RETURN PROCS 1784
* PROCS 1785
* INPUT(, , ) PROCS 1786
* PROCS 1787
* CALLING INPUT GIVES THE AN INPUT ASSOCIATION WITH THE FILE PROCS 1788
* TO THE VARIABLE , WHICH MUST BE A STRING ORPROCS 1789
* NAME OBJECT. IS AN INTEGER IN THE INTERVAL PROCS 1790
* "0, 2@17-1!. PROCS 1791
* PROCS 1792
QINPUT PARAM 3 PROCS 1793
SX1 X5-2 . LESS THAN 2 PARAMETERS MEANS PROCS 1794
NG X1,ERR40 . IS NULL - ILLEGAL PROCS 1795
ZR X1,QIN1 . IS NULL = ZERO = C(X1) PROCS 1796
SA0 10 . GUARANTEE NUMBER PROCS 1797
SA1 TENTO10 . (ITY, STY, OR RTY) PROCS 1798
BX0 X1 . ON TOP OF STACK, PROCS 1799
RJ SACHEK . WITH BIT 3 OF X7=1 IFF ITY PROCS 1800
LX7 3 PROCS 1801
PL X7,ERR29 . TYPE ERROR, TOO BIG OR FLOATINGPROCS 1802
MX0 60-17 PROCS 1803
SA1 B6-1 . SET X1 = INTEGER PROCS 1804
BX0 X0*X1 PROCS 1805
NZ X0,ERR29 . TYPE ERROR, TOO BIG OR NEGATIVEPROCS 1806
SB6 B6-2 . POP INTEGER FROM STACK PROCS 1807
QIN1 SX6 INTY . CONSTRUCT PROCS 1808
LX6 1+18 . PARTIAL SVD PROCS 1809
BX6 X6+X1 . INSERT (SEE TRICK WITH X1 ABOVE)PROCS 1810
* PROCS 1811
QIO SA1 B6 . HEADER OF PARAMETER PROCS 1812
LX6 18+18 PROCS 1813
SA6 QIOSV . SAVE UNFINISHED SVD PROCS 1814
AX1 55 PROCS 1815
NZ X1,ERR40 . PARAM NOT SF, COULD NOT BE FILENAMEPROCS 1816
SB6 B6-2 PROCS 1817
SA1 A1-1 . FETCH SVD PROCS 1818
SA2 MINHS PROCS 1819
BX6 X1 PROCS 1820
SA6 X2 . SAVE SVD IN XWRD PROCS 1821
SA1 X1 . (FIRST WORD OF) FILENAME PROCS 1822
BX6 X1 PROCS 1823
RJ VALID . CHECK FOR GOOD SCOPE FILENAME PROCS 1824
ZR X6,ERR40 . ERROR - ILLEGAL FILENAME PROCS 1825
RJ INDRCT . RETURN PTR IN X1 TO VARIABLE PROCS 1826
* . WITH NAME ON STACK PROCS 1827
SB5 X1 . SAVE PTR DURING FFILX3, DETACH CALLPROCS 1828
CALL DETACH PROCS 1829
SA2 MINHS PROCS 1830
SA3 X2 . SAVE FILENAME SVD PROCS 1831
BX6 X6-X6 . CLEAR PROCS 1832
SA6 X2 . XWRD PROCS 1833
CALL FFILX3 . RETURNS X4=0, X3=FILE BLOCK PTR IF PROCS 1834
ZR X4,QIO1 . FILENAME WITH SVD IN X3 FOUND. PROCS 1835
* . SAVES B5 PROCS 1836
* PROCS 1837
* CREATE A NEW FILE BLOCK, WITH , WHICH THE ROUTINE FFILX3 PROCS 1838
* LEFT IN X2. PROCS 1839
* PROCS 1840
SA3 BUFFSIZ PROCS 1841
SB1 1+1+FET.LEN+X3 . FILE BLOCK LENGTH PROCS 1842
BX5 X2 . SAVE FILENAME PROCS 1843
SX4 B1 PROCS 1844
RJ RESHB . RESERVE HEAP BLOCK (SAVES B3,B5,X3,PROCS 1845
* . X4,X5) PROCS 1846
SX7 FILTYP . STORAGE TYPE PROCS 1847
LX7 1+18+18 PROCS 1848
BX7 X7+X4 . BYPASS PROCS 1849
LX7 18 PROCS 1850
SA1 FILLIST PROCS 1851
BX7 X7+X1 . LINK PROCS 1852
SA7 B3 . STORE HEADER INTO WORD 0 OF BLOCK PROCS 1853
SX6 B3 PROCS 1854
SA6 A1 . UPDATE FILLIST PROCS 1855
MX7 0 . REF COUNT AND WRITE ARE ZERO PROCS 1856
SA7 B3+FI.RFC . INITIALIZE FILE REF. COUNT = 0 PROCS 1857
BX6 X5 PROCS 1858
SA6 B3+FI.FET+FET.LFN PROCS 1859
SX7 B3+FI.BUF PROCS 1860
SA7 B3+FI.FET+FET.IN PROCS 1861
SA7 B3+FI.FET+FET.OUT PROCS 1862
SX5 FET.SZ PROCS 1863
LX5 18 PROCS 1864
BX6 X5+X7 PROCS 1865
SA6 B3+FI.FET+FET.FRST PROCS 1866
SX7 B3+X4 . LAST WORD OF BUFFER IS LAST WORD OFPROCS 1867
* FILE BLOCK PROCS 1868
SX3 B3 PROCS 1869
SA7 B3+FI.FET+FET.LIM PROCS 1870
SB2 B3+0 PROCS 1871
RJ OPEN . OPEN THE FILE (SAVES B5=VARIABLE PTR)PROCS 1872
QIO1 SA1 B7 . GET A PROCS 1873
NZ X1,QIO2 . FREE PROCS 1874
RJ MORFREE . LIST WORD PROCS 1875
QIO2 SB7 X1 . UPDATE FREE LIST POINTER PROCS 1876
SA2 QIOSV . INCOMPLETE (IN/OUT)TY SVD PROCS 1877
SA4 B5 . VARIABLE VALUE PROCS 1878
BX6 X4 PROCS 1879
SA6 A1 . MOVE OLD SVD TO LIST WORD PROCS 1880
SX7 A1 PROCS 1881
BX7 X2+X7 . NEW SVD POINTS TO OLD PROCS 1882
SX3 X3 PROCS 1883
SA1 X3+FI.RFC PROCS 1884
MX6 59 PROCS 1885
IX6 X1-X6 PROCS 1886
SA6 A1 . INCREMENT FILE REF. COUNT PROCS 1887
LX3 18 PROCS 1888
BX7 X7+X3 . FILE BLOCK PTR PROCS 1889
SA7 A4 PROCS 1890
JP RETNULL PROCS 1891
* PROCS 1892
* OUTPUT( , , ) PROCS 1893
* PROCS 1894
* THIS PROCEDURE GIVES THE VARIABLE AN OUTPUT PROCS 1895
* ASSOCIATION WITH THE FILE , AND OVERIDES A PREVIOUS PROCS 1896
* ASSOCIATION OF THIS VARIABLE. MUST BE A PROCS 1897
* STRING OF LENGTH 0 OR 1, OR AN INTEGER BETWEEN 0 AND 9 INCLUSIVE. PROCS 1898
* PROCS 1899
QOUTPUT PARAM 3 PROCS 1900
SX1 X5-2 PROCS 1901
NG X1,ERR40 PROCS 1902
ZR X1,QOUT2 . IS NULL = ZERO = C(X1) PROCS 1903
SA1 B6 . STACK HEADER OF PARAM PROCS 1904
AX1 55 PROCS 1905
SA2 B6-1 PROCS 1906
NZ X1,QOUT1 . NOT SF TYPE PROCS 1907
SB6 B6-2 . POP STACK ENTRY PROCS 1908
SA1 X2 . X2 CONTAINS SVD, FETCH (FIRST) PROCS 1909
* . STRING WORD PROCS 1910
SX7 B7 . FREE PROCS 1911
SB7 X2 . THE PROCS 1912
AX2 18 . STRING PROCS 1913
SA7 X2 . WORDS PROCS 1914
MX0 6 PROCS 1915
BX0 -X0*X1 PROCS 1916
NZ X0,ERR29 . TYPE ERROR, NOT A SINGLE CHARACTER PROCS 1917
LX1 6 . RIGHT JUSTIFY CHARACTER PROCS 1918
JP QOUT2 PROCS 1919
* PROCS 1920
QOUT1 SX1 X1-ITY PROCS 1921
NZ X1,ERR29 . TYPE ERROR, NOT STRING OR INTEGER PROCS 1922
NG X2,ERR29 . TYPE ERROR, MUST BE IN RANGE "0,9! PROCS 1923
SX1 10 PROCS 1924
IX1 X2-X1 PROCS 1925
PL X1,ERR29 PROCS 1926
SX1 X2+1R0 . CONVERT INTEGER TO NUMERAL PROCS 1927
SB6 B6-2 . POP PARAMETER FROM STACK PROCS 1928
* PROCS 1929
QOUT2 SX6 OUTTY . CONSTRUCT PARTIAL PROCS 1930
LX6 1+18 . SVD WITH TYPE AND PROCS 1931
BX6 X6+X1 . CHARACTER PROCS 1932
JP QIO . (SEE TRICK WITH X1 ABOVE) PROCS 1933
* PROCS 1934
IOQ BSS 0 PROCS 1935
* PROCS 1936
* REWIND( ) = NULL PROCS 1937
* PROCS 1938
* THIS PROCEDURE RETURNS THE NULL STRING AND REWINDS THE FILE NAMED PROCS 1939
* , WHICH MUST BE CURRENTLY ATTACHED TO A VARIABLE, EITHER PROCS 1940
* FOR INPUT OR FOR OUTPUT. PROCS 1941
* PROCS 1942
QREWIND PARAM 1 PROCS 1943
CALL FINDFIL . FIND FILE WITH THE NAME ON STACK, PROCS 1944
NZ X4,ERR35 . RETURN X4.NE.0 IFF FILE NOT FOUND PROCS 1945
SB2 X3 . FINDFIL SETS X3 = FILE BLOCK PTR PROCS 1946
RJ CLOSE1 . @CLOSE@ FILE PROCS 1947
SA2 B2+FI.RFC . WORD WITH FLAGS, REFERENCE COUNT PROCS 1948
MX6 2 PROCS 1949
LX6 2+18+18 PROCS 1950
BX6 -X6*X2 . CLEAR EOR,EOI FLAGS PROCS 1951
SA6 A2 PROCS 1952
SA1 B2+FI.FET+FET.IN PROCS 1953
BX6 X1 PROCS 1954
SA6 B2+FI.FET+FET.OUT PROCS 1955
CIO CIO.RWND,RECALL . NOW REWIND THE FILE PROCS 1956
JP RETNULL . RETURN NULL VALUE PROCS 1957
* PROCS 1958
* ENDGROUP( , ) = NULL PROCS 1959
* PROCS 1960
* THIS PROCEDURE WRITES AN END-OF-RECORD, LEVEL ON THE PROCS 1961
* NAMED FILE AND RETURNS THE NULL STRING. PROCS 1962
* PROCS 1963
* PROCS 1964
QENDFIL PARAM 2 . STANDARD PROCEDURE ENDGROUP PROCS 1965
BX5 X5-X5 . =0, THE DEFAULT LEVEL NUMBER PROCS 1966
NG B5,QEOR1 . USE THE DEFAULT SECOND PARAMETER PROCS 1967
SA0 10 PROCS 1968
SA1 TENTO10 PROCS 1969
BX0 X1 PROCS 1970
RJ SACHEK . GET INTEGER ON TOP OF STACK PROCS 1971
LX7 3 . X7 CONTAINS TYPE OF STACK TOP PROCS 1972
PL X7,ERR29 . TYPE ERROR (TOO LARGE) PROCS 1973
MX0 60-4 PROCS 1974
SA1 B6-1 PROCS 1975
BX0 X0*X1 PROCS 1976
BX5 X1 PROCS 1977
NZ X0,ERR29 . LEVEL NUMBER MUST BE BETWEEN "0,15!PROCS 1978
SB6 B6-2 . POP STACK PROCS 1979
QEOR1 CALL FINDFIL . RETURNS (X3) = FILE BLOCK WD 0, PROCS 1980
NZ X4,ERR35 . (X4) .NE. 0 IFF FILE NOT FOUND PROCS 1981
SB2 X3 PROCS 1982
WARTAUF . ENSURE COMPLETION OF LAST FILE ACT PROCS 1983
MX0 60-1 . RECALL FLAG PROCS 1984
SX7 CIO.WEOR . FUNCTION CODE PROCS 1985
LX5 18-4 . FUNCTION CODE MODIFIER PROCS 1986
BX7 X5+X7 . IS RECORD LEVEL NUMBER PROCS 1987
RJ =XCALLCIO . ISSUE REQUEST PROCS 1988
JP RETNULL . RETURN NULL VALUE PROCS 1989
EFRWQ BSS 0 PROCS 1990
* PROCS 1991
* PROCS 1992
* EORLEVEL( ) = I PROCS 1993
* PROCS 1994
* EORLEVEL RETURNS THE END-OF-RECORD LEVEL, 0 [ I [ 15, IF THE LAST PROCS 1995
* REFERENCE TO A VARIABLE INPUT ASSOCIATED WITH FAILED, BUT PROCS 1996
* RETURNS I = -1 IF THE FILE IS AT END-OF-INFORMATION. EORLEVEL FAILSPROCS 1997
* OTHERWISE (IF THE FILE IS NOT AT AN EOR.) PROCS 1998
* PROCS 1999
QEORL PARAM 1 PROCS 2000
CALL FINDFIL . FIND FILE AND SET X3 = FILE PTR, PROCS 2001
NZ X4,ERR35 . RETURN X4 .NE. 0 IFF FILE NOT FOUNPROCS 2002
SA3 X3+FI.RFC . WORD WITH EOR,EOI FLAGS, REF. COUNTPROCS 2003
LX3 59-36 . LEFT JUSTIFY EOI FLAGS PROCS 2004
PL X3,QEORL3 . EOI FLAG WAS NOT SET PROCS 2005
MX7 59 . =-1, PSEUDO LEVEL FOR EOI PROCS 2006
QEORL2 SX2 ITY . POSITION STACK HEADER TYPE PROCS 2007
LX2 55 . FOR QSTACKR, WHICH PROCS 2008
JP QSTAKR . STACKS X2,X7 AND EXITS PROCS 2009
* PROCS 2010
QEORL3 LX3 60-1 . LEFT JUSTIFY EOR FLAG PROCS 2011
PL X3,FAIL . THE FILE IS NOT AT AN ENDGROUP PROCS 2012
SA4 A4 . LFN AND CODE AND STATUS PROCS 2013
AX4 18-4 . RIGHT JUSTIFY LEVEL NUMBER PROCS 2014
SX6 17B PROCS 2015
BX7 X6*X4 . LEVEL NUMBER -> X7 PROCS 2016
JP QEORL2 PROCS 2017
PROCS 2018
EORLQ BSS 0 . END OF EORLEVEL PROCS 2019
* PROCS 2020
* TYPE,DATATYPE( X ) = STRING PROCS 2021
* PROCS 2022
* THESE PROCEDURES RETURN A STRING INDICATING WHAT TYPE THE OBJECT X PROCS 2023
* IS. BOTH PROCEDURES RETURN 'STRING', 'INTEGER', 'PATTERN', 'REAL', PROCS 2024
* 'NAME', 'CODE', OR 'ARRAY' FOR SUITABLE X . BUT IF THE ARGUMENT IS PROCS 2025
* AN OBJECT OF PROGRAMMER-DEFINED DATATYPE, THE PROCEDURE TYPE PROCS 2026
* RETURNS 'DATA' WHILE THE PROCEDURE DATATYPE RETURNS THE SPECIFIC PROCS 2027
* DATA NAME. THUS: DATA( 'NODE(L,R,VAL)' ) PROCS 2028
* A = NODE( ) PROCS 2029
* OUTPUT = DATATYPE( A ) PROCS 2030
* PRINTS 'NODE'. PROCS 2031
* PROCS 2032
QTYPE CALL QDT0 . RETURNS IF TYPE() = -DATA- PROCS 2033
SB2 QDTD PROCS 2034
JP QDT7A . SKIP PARAM. AND COPY RESULT STRING PROCS 2035
* PROCS 2036
QDT CALL QDT0,,QDT8 . IF TYPE() = -DATA-, RETURN DATA NAMPROCS 2037
QDT0 PARAM 1 PROCS 2038
SA1 B6 PROCS 2039
AX1 55 PROCS 2040
NZ X1,QDT7 . FOR SURE NOT STRING PROCS 2041
SA2 B6-1 PROCS 2042
SB1 B0 . SET STATE TO BEFORE SIGN PROCS 2043
SX7 77B PROCS 2044
SB2 QDTS . INNOCENT UNTIL PROVEN GUILTY PROCS 2045
QDT1 LX1 6 PROCS 2046
BX3 X7*X1 . NEXT CHARACTER PROCS 2047
NZ X3,QDT2 . NOT END OF WORD PROCS 2048
ZR X2,QDT4 . GUILTY OF INTEGERISM PROCS 2049
SA1 X2 . NEXT STRING WORD PROCS 2050
SX2 X1 . LINK PROCS 2051
BX1 X1-X2 . CLEAR LOWER 18 BITS PROCS 2052
EQ QDT1 . TRY AGAIN PROCS 2053
QDT2 SX3 X3-1R0 PROCS 2054
NG X3,QDT7A . LETTER - NOT AN INTEGER PROCS 2055
SX3 X3-1R++1R0 PROCS 2056
NG X3,QDT3 . DIGIT PROCS 2057
SX3 X3-1R*+1R+ PROCS 2058
PL X3,QDT7A . PUNCTUATION - NOT AN INTEGER PROCS 2059
NZ B1,QDT7A . SECOND SIGN - NOT AN INTEGER PROCS 2060
QDT3 SB1 1 PROCS 2061
EQ QDT1 PROCS 2062
QDT4 SB2 QDTI PROCS 2063
JP QDT7A . RELEASE PARAM., RETURN TYPE STRING PROCS 2064
* PROCS 2065
* THE POSSIBLE TYPES OF THE PARAMETER (BESICES SF, TREATED ABOVE) ARE: PROCS 2066
* PS, PA, PE, I, R, A, D, N, C, IN THAT ORDER. PROCS 2067
* PROCS 2068
QDT7 SX1 X1-ITY PROCS 2069
SB2 QDTP PROCS 2070
NG X1,QDT7A . PARAM IS PS, PA, OR PE PROCS 2071
SX2 X1-DTY+ITY PROCS 2072
ZR X2,JPB1 . DATATYPE() AND TYPE() DIFFER HEREPROCS 2073
LX1 1 PROCS 2074
SB2 QDTI+X1 . SET B2 = ADDRESS OF PARTIAL SSTY SVPROCS 2075
QDT7A CALL SKIPONE,B5 . REMOVE PARAM. FROM STACK (SAVES B2)PROCS 2076
* PROCS 2077
* FIXSS CONVERTS A PSEUDO SSTY SVD INTO AN ACTUAL SFTY SVD BY PROCS 2078
* DERELATIVIZING F2 = 'LAST' OF THE SS SVD, AND COPYING IT TO SF . PROCS 2079
* PROCS 2080
* PARAMETER: B2 = ADDRESS OF SS SVD (WITH F2 = WORDLENGTH-1) PROCS 2081
* PROCS 2082
* RESULT IS STACKED, EXIT IS TO 'NEXTMIC'. PROCS 2083
* PROCS 2084
FIXSS SA2 B2 . FETCH SVD AND PROCS 2085
SX6 X2 . EXTRACT F1=-FIRST- PROCS 2086
LX6 18 . OF (PARTIAL) SS SVD PROCS 2087
IX2 X2+X6 . SET LAST=FIRST+RELATIVE LAST PROCS 2088
* PROCS 2089
* COPYSS COPIES AN SS STRING INTO AN SF STRING, STACKS IT, AND PROCS 2090
* EXITS TO NEXTMIC. PROCS 2091
* PROCS 2092
* PARAMETER: X2 = SSTY SVD PROCS 2093
* PROCS 2094
COPYSS RJ SSTOSF . SVD RETURNED IN X6 PROCS 2095
BX2 X2-X2 . SFTY TO X2 PROCS 2096
BX7 X6 PROCS 2097
JP QSTAKR . STACK SF RESULT AND RETURN PROCS 2098
* PROCS 2099
* THE PARAMETER IS OF PROGRAMMER-DEFINED DATATYPE; RETURN THE DATA NAMEPROCS 2100
* PROCS 2101
QDT8 SA1 B6-1 . FETCH DTY SVD PROCS 2102
SA1 X1+1 . FETCH WORD 1 OF THE DOPE BLOCK PROCS 2103
CALL QPHBN . RETUNS SS SVD IN X6 FOR THE NAME PROCS 2104
CALL SKIPONE,B5 . RELEASE PARAM. (SAVES X6) PROCS 2105
BX2 X6 PROCS 2106
JP COPYSS . CONVERT SS TO SF AND RETURN IT PROCS 2107
* PROCS 2108
QDTS PERMSS STRING PROCS 2109
QDTP PERMSS PATTERN PROCS 2110
* PROCS 2111
QDTI PERMSS INTEGER PROCS 2112
QDTR PERMSS REAL PROCS 2113
QDTA PERMSS ARRAY PROCS 2114
QDTD PERMSS DATA . "USED ONLY BY TYPE()! PROCS 2115
QDTN PERMSS NAME PROCS 2116
QDTC PERMSS CODE PROCS 2117
PROCS 2118
* PROCS 2119
* QPHBN PROCS 2120
* PROCS 2121
* PARAMETERS: X1 = ADDRESS OF VALUE WORD OF A HBWN PROCS 2122
* B1 = RETURN ADDRESS PROCS 2123
* PROCS 2124
* RESULT: X6 = SSTY SVD OF THE NAME OF THE HB PROCS 2125
* PROCS 2126
* USES: B5, X0, A2-X2, X3, X6 PROCS 2127
* PROCS 2128
QPHBN SA2 X1-1 . SET X2 = WORD 0 OF THE HBWN PROCS 2129
AX2 18 PROCS 2130
SB5 X2 . SET B5 = BYPASS PROCS 2131
AX2 18 PROCS 2132
SX6 X2 . SET X6 = CLENGTH OF NAME PROCS 2133
SX2 A2+B5 . LWA+1 OF HB (AND OF NAME) PROCS 2134
SX3 X1+1 . SET X3 = FIRST OF NAME PROCS 2135
SX2 X2-1 . SET X2 = LAST OF NAME PROCS 2136
SX0 SSTY . SET X0 = TYPE PROCS 2137
LX6 18+18 . F3 = CLENGTH PROCS 2138
LX2 18 . F2 = LAST PROCS 2139
LX0 55 PROCS 2140
BX6 X6+X3 . ASSEMBLE PROCS 2141
BX6 X6+X2 . THE PROCS 2142
BX6 X6+X0 . SVD PROCS 2143
JP B1 . RETURN PROCS 2144
DTQ BSS 0 PROCS 2145
* PROCS 2146
* PROCS 2147
* FNCLEVEL() = (NO. OF CALLS. - (NO. OF RETURNS) PROCS 2148
* PROCS 2149
QFLV PARAM 0 . IGNORE ANY PARAMETERS PROCS 2150
SA2 B6 . TOP STACK HEADER PROCS 2151
SX7 B0 . INITIALIZE LEVEL = 0 PROCS 2152
ZR X2,QFLVBTTM . FNCLEVEL() = 0 PROCS 2153
QFLVLOOP PL X2,QFLVSTEP . THIS ENTRY NOT A CALL PROCS 2154
SX7 X7+1 . LEVEL INCREASES BY ONE PROCS 2155
QFLVSTEP SB1 X2 . BYPASS OF THIS ENTRY PROCS 2156
SA2 A2-B1 . NEXT LOWER HEADER PROCS 2157
NZ X2,QFLVLOOP . NOT TO BOTTOM YET PROCS 2158
QFLVBTTM SX2 ITY . RETURN PROCS 2159
LX2 55 . INTEGER PROCS 2160
JP QSTAKR . RESULT PROCS 2161
* PROCS 2162
FLVQ BSS 0 PROCS 2163
* PROCS 2164
* PROCS 2165
* LGT( X, Y ) "PREDICATE! X, Y ARE STRINGS PROCS 2166
* PROCS 2167
QLGT PARAM 2 PROCS 2168
LT B5,B0,QLGT6 . SECOND PARAM. IS NULL PROCS 2169
SA1 B6 PROCS 2170
AX1 55 PROCS 2171
NZ X1,QLGT7 . SECOND PARAM NOT SF TYPE PROCS 2172
QLGT1 SA1 B6-2 PROCS 2173
AX1 55 PROCS 2174
NZ X1,QLGT8 . FIRST PARM NOT SF PROCS 2175
SA1 B6-3 . FIRST SVD PROCS 2176
QLGT2 SA2 B6-1 . SECOND SVD PROCS 2177
QLGT3 SA3 X1 . WORD OF FIRST STRING PROCS 2178
SA4 X2 PROCS 2179
SX1 X3 . LINK PROCS 2180
SX2 X4 PROCS 2181
BX3 X1-X3 . CLEAR LOWER 18 BITS OF STRING WORD PROCS 2182
BX4 X2-X4 PROCS 2183
IX3 X4-X3 PROCS 2184
LX3 59 . LOOK AT BIT 0 PROCS 2185
NG X3,QSUCC . FIRST > SECOND PROCS 2186
NZ X3,FAIL . FIRST < SECOND PROCS 2187
ZR X1,FAIL . FIRST [ SECOND PROCS 2188
NZ X2,QLGT3 PROCS 2189
JP QSUCC . FIRST > SECOND PROCS 2190
QLGT6 SA0 2 PROCS 2191
RJ RESERVE . RESERVE STACK SPACE FOR NULL PROCS 2192
SX6 2 PROCS 2193
RJ ZROX7 PROCS 2194
LX7 5 PROCS 2195
AX7 5 . CLEAR SS TYPE, GIVING SF PROCS 2196
SA7 B6-1 . NULL SECOND PARAM PROCS 2197
SA6 B6 PROCS 2198
EQ QLGT1 . GO CHECK FIRST PARAM PROCS 2199
QLGT7 SX1 X1-ITY PROCS 2200
NZ X1,ERR29 . TYPE ERROR PROCS 2201
SA1 B6-1 PROCS 2202
RJ ITOSF PROCS 2203
SA6 B6-1 PROCS 2204
SX7 2 . CHANGE HEADER PROCS 2205
SA7 B6 . TO SF TYPE PROCS 2206
EQ QLGT1 . GO CHECK FIRST PARAM PROCS 2207
QLGT8 SX1 X1-ITY PROCS 2208
NZ X1,ERR29 . TYPE ERROR PROCS 2209
SA1 B6-3 PROCS 2210
RJ ITOSF PROCS 2211
SA6 B6-3 PROCS 2212
SX7 2 PROCS 2213
SA7 B6-2 PROCS 2214
BX1 X6 . FIRST SVD PROCS 2215
JP QLGT2 . NOW COMPARE THE STRINGS PROCS 2216
* PROCS 2217
LGTQ BSS 0 PROCS 2218
* PROCS 2219
* PROCS 2220
QDATA PARAM 1 PROCS 2221
SA1 B6 PROCS 2222
MX3 1 PROCS 2223
BX6 X1 PROCS 2224
AX1 55 PROCS 2225
NZ X1,ERR29 . PARAM MUST BE A STRING PROCS 2226
SA4 B6-1 PROCS 2227
SB1 B0 . INITIALIZE FIELD COUNT PROCS 2228
MX0 54 . PREPARE QNXTID PROCS 2229
BX2 X2-X2 PROCS 2230
LX3 54 PROCS 2231
BX6 X6+X3 PROCS 2232
SA6 B6 . MARK TOP OPERAND IN STACK PROCS 2233
QDAT1 BX6 X0 PROCS 2234
RJ QNXID . NEXT IDENTIFIER IN PROTOTYPE PROCS 2235
SA1 MINHS . SAVE LINK IN XWRD PROCS 2236
BX7 X4 PROCS 2237
SA7 X1 PROCS 2238
ZR X3,QDAT5 . BRANCH IF END OF PROTOTYPE PROCS 2239
EQ B2,B0,QDAT2A . BRANCH IF NO IDENTIFIER E.G.A() PROCS 2240
SX7 X3-1R( PROCS 2241
NZ X7,QDAT2 PROCS 2242
NE B1,B0,ERR30 . SYNTAX ERROR E. G. A(B( PROCS 2243
QDAT3 SB1 B1-1 . BUMP FIELD COUNT PROCS 2244
QDAT4 SA6 B6-1 . STORE SVD OF THE IDENTIFIER PROCS 2245
EQ QDAT1 PROCS 2246
QDAT2 GE B1,B0,ERR30 . SNYTAX ERROR E.G.A, PROCS 2247
SA0 2 PROCS 2248
SA4 MINHS PROCS 2249
SA6 X4+1 . DON'T KEEP POINTER IN YOUR PROCS 2250
* . HOT LITTLE HAND PROCS 2251
RJ RESERVE PROCS 2252
SA4 X4+1 PROCS 2253
BX6 X4 . RESTORE POINTER PROCS 2254
BX7 X7-X7 PROCS 2255
SA7 A4 . CLEAR SPECIAL LOCATION PROCS 2256
SA4 MINHS . RESTORE LINK PROCS 2257
SA4 X4 . RESTORE LINK PROCS 2258
SX7 A0 PROCS 2259
SA7 B6 PROCS 2260
SX1 X3-1R, PROCS 2261
ZR X1,QDAT3 PROCS 2262
SX1 X3-1R) PROCS 2263
NZ X1,ERR30 . SYNTAX ERROR E. G. A(B. PROCS 2264
SB1 A0-B1 . B1 WILL BE THE TRUE FIELD COUNT +1 PROCS 2265
EQ QDAT3 . DIRTIEST TRICK THERE IS PROCS 2266
QDAT2A SX1 X3-1R) . MUST BE THE 0 PARAM CASE PROCS 2267
NZ X1,ERR30 PROCS 2268
SB2 1 PROCS 2269
SB1 B0-B1 PROCS 2270
EQ B1,B2,QDAT1 PROCS 2271
JP ERR30 PROCS 2272
* END OF PROTOTYPE REACHED: PROCS 2273
QDAT5 GE B0,B1,ERR30 . SYNTAX ERROR E. G. A PROCS 2274
NE B2,B0,ERR30 . OR A(B PROCS 2275
SX7 B1 . SAVE NUMBER OF FIELDS PROCS 2276
SA7 QDATSV1 PROCS 2277
SB4 B0 . SIGNAL SF FOR INDRX PROCS 2278
QDAT6 SA4 B6-1 PROCS 2279
RJ SRCHCLL . LOOK UP NEXT FUNCTION PROCS 2280
SA2 B6-1 PROCS 2281
SX7 B7 . FREE THE IDENTIFIER PROCS 2282
SB7 X2 PROCS 2283
AX2 18 PROCS 2284
SA7 X2 PROCS 2285
SA2 B6 PROCS 2286
LX2 6 . END OF LOOP IF TOPOPERAND IS MARKEDPROCS 2287
SB6 B6-2 PROCS 2288
NG X2,QDAT10 PROCS 2289
BX7 X1 PROCS 2290
SA1 B7 PROCS 2291
NZ X1,QDAT7 . PUT ADDRESS ON A LIST PROCS 2292
RJ MORFREE PROCS 2293
QDAT7 SB7 X1 PROCS 2294
LX7 18 PROCS 2295
SA2 MINHS . BEGINNING OF THE LIST IS IN XWRD PROCS 2296
SA3 X2 . CHECK IF ADDRESS IN NOT PROCS 2297
BX7 X3+X7 . REPEATED IN THE LIST PROCS 2298
SX6 A1 PROCS 2299
SA7 A1 PROCS 2300
QDAT8 ZR X3,QDAT9 PROCS 2301
SA3 X3 PROCS 2302
BX1 X7-X3 PROCS 2303
SX3 X3 PROCS 2304
AX1 18 PROCS 2305
NZ X1,QDAT8 PROCS 2306
EQ ERR31 PROCS 2307
QDAT9 SA6 X2 PROCS 2308
EQ QDAT6 PROCS 2309
QDAT10 BX5 X1 . POINTER TO THE DATA CONSTRUCTOR PROCS 2310
LX3 55+1 PROCS 2311
SX7 B7+0 PROCS 2312
PL X3,QDAT11 . RELEASE FLDTYP FUD PROCS 2313
RJ RELL PROCS 2314
QDAT11 SA3 QDATSV1 PROCS 2315
SB1 X3+1 . SIZE OF DOPE VECTOR TO B1 PROCS 2316
SX4 B1 PROCS 2317
LX4 18 . BYPASS TO X4 PROCS 2318
RJ RESHB . RESERVE HEAP BLOCK PROCS 2319
SX0 DOPTYP PROCS 2320
BX7 X3+X4 PROCS 2321
LX0 55 PROCS 2322
SX3 X3-1 . NUMBER OF FIELDS TO X3 PROCS 2323
LX3 18 PROCS 2324
BX7 X7+X0 PROCS 2325
SX4 B3 PROCS 2326
SA7 B3 . STORE WORD 0 OF DOPE VECTOR PROCS 2327
SX0 DATATYP PROCS 2328
BX6 X3+X4 PROCS 2329
LX0 55 PROCS 2330
BX7 X6+X0 . DATATYP FUD IN X7 PROCS 2331
BX6 X5 PROCS 2332
SB1 B3+1 PROCS 2333
SA7 X5 PROCS 2334
SA6 B1 . FIRST WORD IN DOPE VECTOR PROCS 2335
SA2 MINHS PROCS 2336
SA2 X2 PROCS 2337
BX7 X7-X7 PROCS 2338
SA7 A2 . CLEAR XWRD PROCS 2339
SB2 X2 PROCS 2340
QDAT12 EQ B2,B0,QDAT16 . MARK LAST WORD AND RETURN PROCS 2341
SA2 B2 . LOOP TO FILL DOPE VECTOR PROCS 2342
SX7 B7 . WITH POINTERS TO FIELDS TAKEN PROCS 2343
SB7 A2 . FROM B2 LIST PROCS 2344
SA7 A2 PROCS 2345
SB2 X2 PROCS 2346
AX2 18 PROCS 2347
BX1 X2-X5 . CHECK IF FIELD IS NOT THE SAME PROCS 2348
ZR X1,ERR31 . AS THE DATA CONSTRUCTOR PROCS 2349
BX7 X2 PROCS 2350
QDAT13 SA7 B1+1 . STORE FIELD IN DOPE VECTOR PROCS 2351
SA1 X2 . FETCH OLD FUD PROCS 2352
NG X1,QDAT15 . STANDARD PROCEDURE FUD, OVERWRITEITPROCS 2353
LX1 1 PROCS 2354
PL X1,QDAT15 . BRANCH IF NOT FIELD ALREADY PROCS 2355
LX1 59 . REPOSITION FUD PROCS 2356
SX2 X1 . NEXT PROCS 2357
NZ X2,QDAT13 . FIND END OF FIELD LIST PROCS 2358
SX2 B7 PROCS 2359
BX7 X1+X2 . MERGE LINK PROCS 2360
SA7 A1 PROCS 2361
SA1 B7 PROCS 2362
NZ X1,QDAT14 . GET A FREE WORD PROCS 2363
RJ MORFREE PROCS 2364
QDAT14 SB7 X1+0 PROCS 2365
QDAT15 SX0 FLDTYP . BUILD FLDTYP FUD FOR THE PROCS 2366
SX1 B1-B3 . FIELD AND STORE IT AT A1 PROCS 2367
SX7 B3 . DOPE POINTER PROCS 2368
LX1 36 PROCS 2369
LX7 18 PROCS 2370
LX0 55 PROCS 2371
BX7 X7+X1 PROCS 2372
BX7 X7+X0 PROCS 2373
SA7 A1 PROCS 2374
SB1 B1+1 . GO, PROCESS THE NEXT FIELD PROCS 2375
EQ QDAT12 PROCS 2376
* PROCS 2377
QDAT16 SA1 B1 . MARK LAST DOPE WORD AND RETURN PROCS 2378
MX0 1 . NULL VALUE PROCS 2379
BX7 X1+X0 PROCS 2380
SA7 A1 PROCS 2381
JP RETNULL PROCS 2382
* PROCS 2383
DATAQ BSS 0 PROCS 2384
* PROCS 2385
* STANDARD PROCEDURE: PROTOTYPE PROCS 2386
* PROCS 2387
QPROT PARAM 1 PROCS 2388
SA2 QPROTWD . DISPATCH ON TOP OPERAND TYPE PROCS 2389
SB1 QPROT2 . RETURN, USED AT QPROT11 PROCS 2390
CALL CHEK,B3,QPROTSW PROCS 2391
* PROCS 2392
QPROTWD SWITCH QPROTSW,0,0,0,0,1,2,3,0,0,4,5,6,0,0,0 PROCS 2393
+ JP ERR29 . 0, SF,I,R,C PROCS 2394
+ JP QPROT7 . 1, PS PROCS 2395
+ SA1 QPALT . 2, PA PROCS 2396
JP QPROT1 PROCS 2397
+ JP QPROT0 . 3, PE PROCS 2398
+ CALL QPROT13,,QPROT12 . 4, A PROCS 2399
+ CALL QPROT13,,QPROT14 . 5, D PROCS 2400
+ SA2 B6-1 . 6, N PROCS 2401
JP QPROT11 PROCS 2402
* PROCS 2403
* SET A0 POINTING TO THE DOPE VECTOR, INITIALIZE XWRD PROCS 2404
QPROT13 SA2 B6-1 PROCS 2405
BX1 X1-X1 PROCS 2406
SA0 X2 PROCS 2407
JP QPROT5 PROCS 2408
* PROCS 2409
* CREATE ARRAY PROTOTYPE PROCS 2410
QPROT12 SA1 A0+1 . FETCH NEXT DIMENSION WORD PROCS 2411
SA0 A1 PROCS 2412
AX1 18 PROCS 2413
SX1 X1+0 PROCS 2414
RJ ITOSF . CONVERT LOWER BOUND PROCS 2415
RJ UCAT PROCS 2416
SX7 1R: . COLON TO SEPARATE UPPER BOUND PROCS 2417
RJ QPSCON PROCS 2418
BX6 X0+X6 PROCS 2419
RJ UCAT PROCS 2420
SA1 A0 PROCS 2421
SX1 X1 PROCS 2422
RJ ITOSF . CONVERT UPPER BOUND PROCS 2423
RJ UCAT PROCS 2424
SA1 A0+0 PROCS 2425
NG X1,QPROT15 . BRANCH IF LAST DIMENSION PROCS 2426
SX7 1R, . COMMA TO SEPARATE DIMENSIONS PROCS 2427
RJ QPSCON PROCS 2428
BX6 X0+X6 PROCS 2429
RJ UCAT PROCS 2430
JP QPROT12 PROCS 2431
* PROCS 2432
* CREATE DATA STRUCTURE PROTOTYPE PROCS 2433
QPROT14 SA1 A0+1 PROCS 2434
SA0 A1+0 PROCS 2435
CALL QPHBN . GET DATA CONSTRUCTOR NAME PROCS 2436
RJ UCAT PROCS 2437
SX7 1R( . ( TO SEPARATE FIELDS PROCS 2438
QPROT17 RJ QPSCON PROCS 2439
BX6 X0+X6 PROCS 2440
RJ UCAT . , OR ( SEPARATOR PROCS 2441
SA1 A0+0 PROCS 2442
NG X1,QPROT19 . BRANCH IF NO FIELDS PROCS 2443
SA1 A0+1 PROCS 2444
SB1 QPROT18 PROCS 2445
SA0 A1 PROCS 2446
JP QPHBN . GET NEXT FIELD SELECTOR NAME PROCS 2447
QPROT18 RJ UCAT PROCS 2448
SX7 1R, PROCS 2449
SA1 A0+0 PROCS 2450
PL X1,QPROT17 . BRANCH IF NOT LAST FIELD PROCS 2451
QPROT19 SX7 1R) . ) TO TERMINATE LIST OF FIELDS PROCS 2452
RJ QPSCON PROCS 2453
BX6 X0+X6 PROCS 2454
RJ UCAT PROCS 2455
* PROCS 2456
* DISPOSE OF THE DTY OR ATY SVD AND RETURN THE PROTOTYPE PROCS 2457
QPROT15 CALL SKIPONE,B5,QPROT4 PROCS 2458
* PROCS 2459
* PE TYPE - CONCATENATED OR ARBNO OR STAR PROCS 2460
* TREAT EITHER OF THE LATTER TWO AS PS PROCS 2461
QPROT0 SA1 B6 PROCS 2462
SB1 X1-1 PROCS 2463
SB3 B6-B1 . B3 POINTS TO WORD 0 OF THE TOP ENTRPROCS 2464
RJ QPNEXT . SKIP NEXT PS PROCS 2465
EQ B3,B6,QPROT7 . SOME PE SHOULD REALLY BE PS PROCS 2466
SA1 QPCAT PROCS 2467
* PROCS 2468
* PE OR PA TYPE, X1 CONTAINS CAT OR ALT PROCS 2469
* CONCATENATE (FIRST,REST) AND RETURN PROCS 2470
QPROT1 SB3 QPTYP3 . POINTS TO FIRST, REST) PROCS 2471
CALL QPROT5 PROCS 2472
* CONCATENATE STRING CONSTANT AT B3 TO THE PROCS 2473
* RESULT AND RETURN PROCS 2474
QPROT2 SA2 B3 . FETCH CONSTANT SVD PROCS 2475
SX6 X2 PROCS 2476
LX6 18 PROCS 2477
IX6 X6+X2 . FIX UP LAST PROCS 2478
RJ UCAT . CONCATENATE CONSTANT PROCS 2479
* RETURN THE STRING AT MINHS AS A RESULT PROCS 2480
QPROT3 SA1 B6 PROCS 2481
SB1 X1+0 . IGNORE TOP OPERAND IN STACK PROCS 2482
SB6 B6-B1 PROCS 2483
QPROT4 SA2 MINHS PROCS 2484
SX7 2 PROCS 2485
SA1 X2 . FETCH SVD OF RESULT PROCS 2486
BX6 X6-X6 PROCS 2487
SB6 B6+X7 . NO NEED TO CALL RESERVE PROCS 2488
SA6 X2 . CLEAR XWRD PROCS 2489
SA7 B6 . STORE SF TYPE HEADING PROCS 2490
SA6 X2+1 PROCS 2491
BX7 X1 PROCS 2492
SA7 B6-1 . STORE RESULT PROCS 2493
JP NEXTMIC PROCS 2494
* PROCS 2495
* X1 CONTAINS A TEXT WORD. CREATE AN PROCS 2496
* SF TYPE COPY AND LEAVE THE SVD AT MINHS PROCS 2497
* X1=0 IS A NULL TEXT USED TO INITIALIZE UCAT PROCS 2498
* RETURN: B1 PROCS 2499
QPROT5 MX0 42 PROCS 2500
BX2 X1 PROCS 2501
BX7 X0*X1 . STRING PART TO X7 PROCS 2502
MX0 60-3 PROCS 2503
AX2 15 PROCS 2504
SX6 B7 . FIRST PROCS 2505
SX3 B7 . LAST PROCS 2506
BX2 -X0*X2 . CLENGTH PROCS 2507
LX3 18 PROCS 2508
SA1 B7 PROCS 2509
LX2 36 PROCS 2510
BX6 X6+X3 PROCS 2511
NZ X1,QPROT6 . GET FREE WORD PROCS 2512
RJ MORFREE PROCS 2513
QPROT6 SB7 X1 PROCS 2514
SA7 A1 . STORE STRING INTO FREE WORD PROCS 2515
SA1 MINHS PROCS 2516
BX6 X6+X2 PROCS 2517
SA6 X1 . STORE SVD AT MINHS PROCS 2518
JP B1 PROCS 2519
* PROCS 2520
* N TYPE, RESULT IS: PROCS 2521
* 'INDIRECT(RIGHT)' IF SIMPLE PROCS 2522
* 'ITEM(BASE,SELECTOR)' IF ARRAY ELEMENT PROCS 2523
* 'APPLY(SELECTOR,BASE)' IF DATA STRUCTURE FIELD PROCS 2524
* X2 = NTY SVD PROCS 2525
QPROT11 SB3 QPTYP5 . POINTS TO INDIRECT(RIGHT) PROCS 2526
AX2 18 PROCS 2527
BX1 X1-X1 . DUMMY TEXT IN X0 PROCS 2528
SX2 X2 PROCS 2529
ZR X2,QPROT5 . BRANCH IF SIMPLE PROCS 2530
SA2 X2 . FETCH WORD 0 OF STRUCTURE PROCS 2531
AX2 18 PROCS 2532
SA2 X2+1 . FETCH WORD 1 OF DOPE VECTOR PROCS 2533
LX2 1 PROCS 2534
SB3 QPTYP6 . POINTS TO ITEM( ETC. PROCS 2535
NG X2,QPROT5 . BRANCH IF ARRAY PROCS 2536
SB3 QPTYP7 . POINTS TO APPLY( ETC. PROCS 2537
JP QPROT5 . BRANCH IF DATA STRUCTURE PROCS 2538
* PS TYPE, CHECK LAST WORD FOR PRD OR DOL PROCS 2539
QPROT7 SA4 B6-1 . LAST WORD TO X1 PROCS 2540
SX2 X4 PROCS 2541
SA3 B6 PROCS 2542
NG X2,QPROT8 . BRANCH IF BIT TABLE PROCS 2543
ID X4,QPROT10 . BRANCH IF PRD OR DOL PROCS 2544
QPROT8 SB1 X3 PROCS 2545
SB1 B6-B1 PROCS 2546
SA2 B1+1 . FETCH FIRST WORD PROCS 2547
CALL QFINDPS PROCS 2548
BX2 X1 . RESULT IS THE TEXT IN X1 PROCS 2549
AX2 12 . CONCATENATED WITH THE CONSTANT PROCS 2550
MX0 60-3 . INDICATED IN THE TYPE FIELD PROCS 2551
BX2 -X0*X2 PROCS 2552
SB3 X2+QPTYP0 PROCS 2553
CALL QPROT5,,QPROT2 PROCS 2554
* PRD OR DOL. SIMILAR TO ALT OR CAT ABOVE PROCS 2555
QPROT10 SB3 QPTYP4 . POINTS TO (LEFT,RIGHT) PROCS 2556
SB1 QPROT2 PROCS 2557
SA1 QPPRD PROCS 2558
PL X4,QPROT5 . BRANCH IF PRD PROCS 2559
SA1 QPDOL PROCS 2560
JP QPROT5 . BRANCH IF DOL PROCS 2561
* PROCS 2562
* QFINDPS PROCS 2563
* PARAM: X2 PS WORD 0 PROCS 2564
* RESULT: X1 TEXT WORD WITH OPCODE MATCHING X2 PROCS 2565
* RETURN B1 PROCS 2566
* X0,X1,X2,X3,X7,B1,B3,B4 PROCS 2567
* PROCS 2568
QFINDPS LX2 12 PROCS 2569
MX0 60-12 . OPC MASK PROCS 2570
BX7 -X0*X2 PROCS 2571
SB4 QPENDT . LAST TEXT+1 TO B4 PROCS 2572
SB3 QPFRSTT . FIRST TEXT PROCS 2573
QFPS1 SA1 B3+0 . GET NEXT TEXT WORD PROCS 2574
BX3 -X0*X1 PROCS 2575
BX3 X7-X3 PROCS 2576
ZR X3,JPB1 . RETURN IF FOUND PROCS 2577
SB3 B3+1 PROCS 2578
LT B3,B4,QFPS1 PROCS 2579
JP 400000B+* . SYSTEM ERROR PROCS 2580
* PROCS 2581
* QPSCON PROCS 2582
* PARAM: X7 CONTAINS A CHARACTER PROCS 2583
* RESULT: X0+X6 IS AN SFTY SVD OF THE 1 CHAR STRING PROCS 2584
* PROCS 2585
QPSCON DATA 0 PROCS 2586
LX7 60-6 PROCS 2587
SX6 B7 . FIRST PROCS 2588
SX3 B7 . LAST PROCS 2589
MX0 1 . CLENGTH=1 PROCS 2590
LX3 18 PROCS 2591
LX0 1+36 PROCS 2592
SA1 B7 . GET A FREE LS WORD PROCS 2593
BX6 X6+X3 PROCS 2594
NZ X1,QPSC1 PROCS 2595
RJ MORFREE PROCS 2596
QPSC1 SB7 X1 PROCS 2597
SA7 A1 . STORE CHARACTER PROCS 2598
EQ QPSCON PROCS 2599
* PROCS 2600
* CONSTANTS FOR BUILDING PROTOTYPES PROCS 2601
* PROCS 2602
TEXT MACRO PN,LEN,TYP,OPC PROCS 2603
VFD 42/0L_PN,18/OPC+LEN*100000B+TYP*10000B PROCS 2604
ENDM PROCS 2605
* PROCS 2606
QPFRSTT TEXT ARB,3,0,ARBPM PROCS 2607
TEXT ABORT,5,0,ABORTPM PROCS 2608
TEXT ARBNO,5,2,ARBNOPM PROCS 2609
TEXT ANY,3,2,ANYPM PROCS 2610
TEXT BREAK,5,2,BREAKPM PROCS 2611
TEXT BAL,3,0,BALPM PROCS 2612
TEXT FAIL,4,0,FAILPM PROCS 2613
TEXT FENCE,5,0,FENCEPM PROCS 2614
TEXT LEN,3,2,LENPM PROCS 2615
TEXT POS,3,2,POSPM PROCS 2616
TEXT REM,3,0,REMPM PROCS 2617
TEXT RPOS,4,2,RPOSPM PROCS 2618
TEXT RTAB,4,2,RTABPM PROCS 2619
TEXT SPAN,4,2,SPANPM PROCS 2620
TEXT TAB,3,2,TABPM PROCS 2621
TEXT NOTANY,6,2,NTANYPM PROCS 2622
TEXT STAR,4,1,STARPM PROCS 2623
QPENDT BSS 0 PROCS 2624
* PROCS 2625
QPCAT TEXT CAT,3,0,0 PROCS 2626
QPALT TEXT ALT,3,0,0 PROCS 2627
QPPRD TEXT PRD,3,0,0 PROCS 2628
QPDOL TEXT DOL,3,0,0 PROCS 2629
* PROCS 2630
MACRO QPTYP,N,STR PROCS 2631
QPTYP_N VFD 5/SSTY,1/0,18/QPTYP_N_CL,18/QPTYP_N_L-QPTYP_N_F,18/QPTYP_PROCS 2632
,N_F PROCS 2633
RMT PROCS 2634
PERMSTR (STR),QPTYP_N_F,QPTYP_N_L,QPTYP_N_CL PROCS 2635
RMT PROCS 2636
ENDM PROCS 2637
* PROCS 2638
0 QPTYP (()) PROCS 2639
1 QPTYP ((RIGHT)) PROCS 2640
2 QPTYP ((PARAM)) PROCS 2641
3 QPTYP ((FIRST,REST)) PROCS 2642
4 QPTYP ((LEFT,RIGHT)) PROCS 2643
5 QPTYP (INDIRECT(RIGHT)) PROCS 2644
6 QPTYP (ITEM(FAMILY,SELECTOR)) PROCS 2645
7 QPTYP (APPLY(SELECTOR,FAMILY)) PROCS 2646
* PROCS 2647
* NOW ASSEMBLE THE PERMSTR CALLS. PROCS 2648
HERE PROCS 2649
* PROCS 2650
* QPNEXT PROCS 2651
* PROCS 2652
* PARAMETER: B3 = ADDRESS OF WORD 0 OF A PATTERN PROCS 2653
* PROCS 2654
* RESULT: B3 = LAST WORD ADDRESS + 1 OF THE PATTERN PROCS 2655
* PROCS 2656
* USES: B3, B4, B5, A1-X1, X7 PROCS 2657
* PROCS 2658
QPNEXT2 SA1 B3+0 . TRAILING PRD,DOL WORDS PROCS 2659
DF X1,QPNEXT . BELONG TO THIS PATTERN ELEMENT PROCS 2660
SB5 B0 . MARK TYPE AS SURELY NOT LITPM PROCS 2661
JP QPNEXT3 PROCS 2662
QPNEXT BSSZ 1 . ENTRY/EXIT PROCS 2663
SA1 B3 . UNPACK PROCS 2664
UX7 B5,X1 . WORD 0 PROCS 2665
LT B0,B5,QPNEXT1 . LIT, ANY, ETC. PROCS 2666
SB4 EXPPM-1777B PROCS 2667
EQ B4,B5,QPNEXT1 . EXP PROCS 2668
SB4 ARBNOPM-1777B PROCS 2669
EQ B4,B5,QPNEXT1 . ARBNO PROCS 2670
SB4 ALTPM-1777B PROCS 2671
EQ B4,B5,QPNEXT1 . ALT PROCS 2672
QPNEXT3 SB3 B3+1 . PS IS 1 WORD LONG(ER) PROCS 2673
EQ QPNEXT2 . CHECK FOR FOLLOWING PRD,DOL WORDS PROCS 2674
* PROCS 2675
QPNEXT1 SB3 B3+X1 . PS IS (X1) WORDS LONG PROCS 2676
JP QPNEXT2 . OR MAYBE LONGER PROCS 2677
* PROCS 2678
PROTQ BSS 0 PROCS 2679
* PROCS 2680
QSTLIM SB1 STLIM . STANDARD PROCEDURE STLIMIT PROCS 2681
JP QMAXLN1 PROCS 2682
* PROCS 2683
QSTCNT PARAM 0 . STANDARD PROCEDURE STCOUNT() PROCS 2684
SA1 STCOUNT PROCS 2685
SB6 B6+2 . WE NEED NOT CALL RESERVE HERE PROCS 2686
BX6 X1 PROCS 2687
JP QMAXLN4 . STACK INTEGER RESULT AND RETURN PROCS 2688
* PROCS 2689
QMAXLN SB1 MXLNGTH . STANDARD PROCEDURE MAXLNGTH PROCS 2690
QMAXLN1 PARAM 1 PROCS 2691
SA1 B6 PROCS 2692
AX1 55 PROCS 2693
NZ X1,QMAXLN2 . BRANCH IF NOT STRING PARAM PROCS 2694
SA1 B6-1 PROCS 2695
SA1 X1 PROCS 2696
SX7 B7 PROCS 2697
ZR X1,QMAXLN3 . BRANCH IF NULL STRING PROCS 2698
QMAXLN2 SA1 TENTO10 PROCS 2699
SA0 10 PROCS 2700
SX5 B1 PROCS 2701
BX0 X1 PROCS 2702
RJ SACHEK . CONVERT PARAM INTO INTEGER FORM PROCS 2703
LX7 4 PROCS 2704
PL X7,ERR29 . VALUE TOO BIG PROCS 2705
SA1 B6-1 PROCS 2706
BX7 X1 PROCS 2707
SA7 X5 . ASSIGN VALUE TO KEYWORD PROCS 2708
SB6 B6-2 . POP THE INTEGER PROCS 2709
JP RETNULL . RETURN NULL VALUE PROCS 2710
* PROCS 2711
QMAXLN3 SB7 A1 . RETURN THE VALUE OF THE KEYWORD PROCS 2712
SA7 A1 . FREE THE NULL STRING PROCS 2713
SA1 B1 PROCS 2714
BX6 X1 PROCS 2715
QMAXLN4 SA6 B6-1 PROCS 2716
SA1 ITYWD PROCS 2717
BX6 X1 PROCS 2718
SA6 B6 PROCS 2719
EQ NEXTMIC PROCS 2720
* PROCS 2721
MAXLNQ BSS 0 PROCS 2722
* PROCS 2723
* PROCS 2724
* ALPHABET() PROCS 2725
* PROCS 2726
QALPHA PARAM 0 . IGNORES ALL ARGUMENTS PROCS 2727
SB2 ABC PROCS 2728
JP FIXSS . FILL IN LAST FIELD AND COPY STRING PROCS 2729
* PROCS 2730
ABC VFD 5/SSTY,1/0,18/63,18/ABC2-ABC1,18/ABC1 . NOTE REL LAST PROCS 2731
* PROCS 2732
ABC1 VFD 42/01020304050607B,18/*+1 PROCS 2733
VFD 42/10111213141516B,18/*+1 PROCS 2734
VFD 42/17202122232425B,18/*+1 PROCS 2735
VFD 42/26273031323334B,18/*+1 PROCS 2736
VFD 42/35363740414243B,18/*+1 PROCS 2737
VFD 42/44454647505152B,18/*+1 PROCS 2738
VFD 42/53545556576061B,18/*+1 PROCS 2739
VFD 42/62636465666770B,18/*+1 PROCS 2740
ABC2 VFD 42/71727374757677B,18/0 PROCS 2741
* PROCS 2742
ALPHAQ BSS 0 PROCS 2743
* PROCS 2744
* PROCS 2745
* FREEZE( ) = PROCS 2746
* PROCS 2747
* FREEZE SAVES THE STATE OF THE SNOBOL SYSTEM BY WRITING OUT AN PROCS 2748
* ABSOLUTE OVERLAY. FIRST IT FLUSHES THE OUTPUT BUFFERS, THEN IT WRITESPROCS 2749
* THE OVERLAY, THEN IT TERMINATES EXECUTION. THE OVERLAY IS CONSTRUCTEPROCS 2750
* SO AS TO CAUSE FREEZE TO BE CONTINUED WHEN TEH OVERLAY IS LOADED, ANDPROCS 2751
* AT THAT TIME FREEZE TIDIES UP AND RETURNS. PROCS 2752
* PROCS 2753
QFREEZE PARAM 2 PROCS 2754
NG B5,QFRZ1 . USE ICE AS OVERLAY NAME PROCS 2755
SA1 B6 . SVD PROCS 2756
AX1 55 PROCS 2757
NZ X1,ERR29 . MUST BE STRING PROCS 2758
SA1 B6-1 . SVD PROCS 2759
SA1 X1 . FIRST (AND HOPEFULLY LAST) WORD PROCS 2760
BX6 X1 PROCS 2761
RJ VALID . CHECK FOR GOOD FILENAME PROCS 2762
ZR X6,ERR40 . NO PROCS 2763
SA6 QFRZNAME PROCS 2764
SB6 B6-2 . POP OVERLAY NAME FROM STACK PROCS 2765
SX6 B7 . FREE THE ONE WORD PROCS 2766
SA6 A1 . STRING WHICH IS PROCS 2767
SB7 A1 . THE OVERLAY NAME PROCS 2768
EQ QFRZ2 PROCS 2769
QFRZICE DATA 0LICE PROCS 2770
QFRZ1 SA1 QFRZICE PROCS 2771
BX6 X1 PROCS 2772
SA6 QFRZNAME PROCS 2773
* PROCESS THE FILE NAME PARAMETER PROCS 2774
QFRZ2 SA1 B6 . SVD PROCS 2775
AX1 55 PROCS 2776
NZ X1,ERR29 . MUST BE STRING PROCS 2777
SA1 B6-1 . SVD PROCS 2778
SA1 X1 . FIRST WORD PROCS 2779
BX6 X1 PROCS 2780
RJ VALID . CHECK FOR GOOD FILENAME PROCS 2781
ZR X6,ERR40 . NAME NOT GOOD PROCS 2782
BX4 X6 . FILE NAME FOR WROVLAY PROCS 2783
RJ CLOSALL . CLOSE FILES (SAVES X4) PROCS 2784
* SAVE SNOBOL MACHINE STATE COMPONENTS WHICH ARE REGISTER-RESIDENT. PROCS 2785
SX5 A5 . MICOP LOCATION COUNTER PROCS 2786
SX6 B6 . STACK POINTER PROCS 2787
SX7 B7 . FREE LIST POINTER PROCS 2788
LX7 18 PROCS 2789
BX7 X7+X6 PROCS 2790
LX7 18 PROCS 2791
BX7 X7+X5 PROCS 2792
SA7 QFRZSV PROCS 2793
BX2 X4 ******* 8
SX3 QFREEZE1 . ENTRY POINT PROCS 2795
SA1 FIELDLN PROCS 2796
BX5 X1 . LWA+1 TO WRITE PROCS 2797
RJ WROVLAY . WRITE IT PROCS 2798
JP END. . JUST ISSUE -END- REQUEST PROCS 2799
* PROCS 2800
QFREEZE1 SA1 QFRZSV PROCS 2801
SA5 X1 PROCS 2802
AX1 18 PROCS 2803
SB6 X1 PROCS 2804
AX1 18 PROCS 2805
SA2 FIELDLN PROCS 2806
BX2 -X2 PROCS 2807
SB7 X1 PROCS 2808
SB1 A0 PROCS 2809
SX3 X2+B1 PROCS 2810
SX7 A0 PROCS 2811
SA7 A2 PROCS 2812
ZR X3,QFREEZE3 . NEW FL = OLD FL PROCS 2813
QFREEZE2 SB1 B1-1 PROCS 2814
SX6 B1-1 PROCS 2815
SB2 X2+B1 PROCS 2816
SA6 B1 PROCS 2817
NE B2,B0,QFREEZE2 PROCS 2818
SX6 B7 PROCS 2819
SB7 X7-1 PROCS 2820
SA6 B1 PROCS 2821
QFREEZE3 SB1 NEXTMIC . OPEN ALL ATTACHED FILES PROCS 2822
* PROCS 2823
* CALL OPENALL PROCS 2824
* OPEN ALL THE FILES ON FILLIST (USED BY INIT, FREEZE(), ETC.). PROCS 2825
* PROCS 2826
* USES: A1/X1, X2, A7/X7, B2 PROCS 2827
OPENALL STREAM FILLIST . SET B2 TO FIRST STREAM PROCS 2828
OALOOP RJ OPEN PROCS 2829
STREAM B2 . SET B2 TO NEXT STREAM PROCS 2830
NZ B2,OALOOP PROCS 2831
JP B1 . OR TO END-OF-LIST MARKER PROCS 2832
* PROCS 2833
QFRZNAME DATA 0LICE . (FROZEN SNOW) PROCS 2834
* PROCS 2835
* PROCS 2836
* WROVLAY: WRITE OUT AN OVERLAY OF THE CURRENT SNOBOL STATE. PROCS 2837
* PROCS 2838
* PARAMETERS: X2 = PROGRAM NAME (FOR LOADER ID TABLE) PROCS 2839
* X3 = ENTRY POINT TO PLACE IN OVERLAY PROCS 2840
* X4 = FILE NAME ON WHICH TO WRITE PROCS 2841
* X5 = LAST.WORD.ADDRESS+1 TO WRITE (FWA = WV.IDTAB) PROCS 2842
* PROCS 2843
WV.OVTAB EQU 100B . START OF OVERLAY TABLE PROCS 2844
WV.IDTAB EQU WV.OVTAB-14-1 . START OF ID TABLE PROCS 2845
WV.FIRST EQU WV.IDTAB-1 . START OF @BUFFER@ BEING WRITTEN OUTPROCS 2846
WV.FET EQU WV.FIRST-5 . START OF FET USED TO WRITE OVERLAY PROCS 2847
WV.FILE EQU WV.FET-FI.FET . START OF PSEUDO FILE PROCS 2848
* PROCS 2849
IDTABHDR VFD 12/7700B,12/14,36/0 . NOTE: 14 IS LENGTH W/O HEADER PROCS 2850
OVTABHDR VFD 12/5000B,12/0,18/WV.OVTAB,18/0 . NOTE: F1 IS FOR ENT. PT.PROCS 2851
* PROCS 2852
PROCNAME DATA 10LCAL SNOBOL PROCS 2853
* PROCS 2854
WROVLAY BSSZ 1 . ENTRY/EXIT PROCS 2855
* PROCS 2856
* SET UP WV.IDTAB, THE LOADER IDENTIFICATION TABLE PRECEDING THE OVER- PROCS 2857
* LAY. PROCS 2858
SA1 IDTABHDR PROCS 2859
BX6 X1 PROCS 2860
BX7 X2 PROCS 2861
SA6 WV.IDTAB . TABLE HEADER = WV.IDTAB"0! PROCS 2862
SA7 WV.IDTAB+1 . PROGRAM NAME = -- "1! PROCS 2863
CALL CALENDR . (SAVES X3,X4,X5) PROCS 2864
NO PROCS 2865
LX6 60-6 PROCS 2866
SA6 WV.IDTAB+3 . DATE (@BDDBMMMBYY@) = WV.IDTAB"3! PROCS 2867
CALL TOD . (SAVES X3,X4,X5) PROCS 2868
SA1 PROCNAME PROCS 2869
BX7 X1 PROCS 2870
LX6 60-6 PROCS 2871
SA6 WV.IDTAB+4 . TIME (@BHH:MM:SSB@) = WV.IDTAB"4! PROCS 2872
SA7 WV.IDTAB+5 . PROCESSOR NAME = WV.IDTAB"5! PROCS 2873
* WV.IDTAB"2! (LIBRARY CONTROL) AND "6:14! (RESERVED) SHOULD BE ZEROED.PROCS 2874
SX7 0 PROCS 2875
SB1 14-6+1 PROCS 2876
WVLOOP SA7 A7+1 . SET WV.IDTAB"I! := 0 PROCS 2877
SB1 B1-1 . FOR I = 6, 7, ..., 14 PROCS 2878
NZ B1,WVLOOP PROCS 2879
SA7 WV.IDTAB+2 . (SIMILARLY FOR I = 2) PROCS 2880
* PROCS 2881
* SET UP WV.OVTAB (I.E. PLACE A HEADER IN FRONT OF THE SNOBOL CODE). PROCS 2882
SA1 OVTABHDR PROCS 2883
BX6 X4 PROCS 2884
BX7 X1+X3 PROCS 2885
SA7 WV.OVTAB . TABLE HEADER, WITH F1 = ENTRY POINTPROCS 2886
* PROCS 2887
* SET UP WV.FET. PROCS 2888
SA6 WV.FET+FET.LFN . FILE NAME PROCS 2889
SX7 WV.FIRST PROCS 2890
SA7 WV.FET+FET.FRST . THE CIRCULAR BUFFER POINTERS PROCS 2891
SA7 WV.FET+FET.IN . ARE SET SO THAT WORDS PROCS 2892
SX6 WV.IDTAB . WITH ADDRESSES PROCS 2893
SA6 WV.FET+FET.OUT . WV.IDTAB TO C(X5) PROCS 2894
SX7 X5+0 . WILL BE WRITTEN PROCS 2895
SA7 WV.FET+FET.LIM . ONTO THE OVERLAY FILE PROCS 2896
* PROCS 2897
* WRITE THE OVERLAY. PROCS 2898
SB2 WV.FILE . STREAM POINTER PROCS 2899
CIO CIO.BWRR,RECALL . (B)INARY MODE (WR)ITE (R)ECORD PROCS 2900
* PROCS 2901
* ALL DONE. PROCS 2902
JP WROVLAY . RETURN PROCS 2903
* PROCS 2904
FREEZEQ BSS 0 PROCS 2905
* PROCS 2906
* NEXTVAR( N ), N A NAME OR STRING PROCS 2907
* PROCS 2908
* THE NAME OF THE NEXT VARIABLE AFTER $N IS RETURNED: PROCS 2909
* THE NEXT VARIABLE IN HEAP STORAGE IF $N IS SIMPLE, PROCS 2910
* THE NEXT STRUCTURE ELEMENT IF $N IS IN A STRUCTURE (ARRAY OR DATA)PROCS 2911
* THUS IDENT( PROTOTYPE( N ), PROTOTYPE( NEXTVAR( N ) ) ALWAYS PROCS 2912
* SUCCEEDS. IF $N IS THE LAST VARIABLE IN HS OR A STRUCTURE, THEN PROCS 2913
* NEXTVAR( N ) RETURNS THE FIRST VARIABLE IN HS OR THE STRUCTURE, PROCS 2914
* RESPECTIVELY. PROCS 2915
* PROCS 2916
QNEXTV PARAM 1 . RELEASE EXTRA PARAMETERS PROCS 2917
SA1 B6 . CHECK PROCS 2918
AX1 55 . TYPE PROCS 2919
SX2 X1-NTY . OF PARAMETER PROCS 2920
ZR X2,QNVNAME . NAME PROCS 2921
RJ INDRCT . STRING (ELSE ERROR) PROCS 2922
QNVSIMP SA2 X1-1 . FETCH VARTYP HBWN HEADER WORD PROCS 2923
SX4 VARTYP-37B-STRTYP+37B . NOT EQUAL TO ZERO PROCS 2924
* LOOP UNTIL ANOTHER (OR THE SAME) VARTYP HBWN IS FOUND. PROCS 2925
QNVNXTHB AX2 18 . F2 OF HB HEADER IS BYPASS -- PROCS 2926
NZ X4,QNVXX . EXCEPT STRUCTURE TYPE BLOCK, PROCS 2927
AX2 18 . WHICH USES F3 PROCS 2928
QNVXX SB1 X2 PROCS 2929
SA2 A2+B1 . FETCH NEXT HB HEADER PROCS 2930
ZR X2,QNVWRAP . ZERO WORD IS LIMIT OF HEAP STORAGE PROCS 2931
QNVYY BX3 X2 PROCS 2932
AX3 55 . RIGHT JUSTIFY THE HS TYPE PROCS 2933
SX5 X3-VARTYP+37B PROCS 2934
SX4 X3-STRTYP+37B PROCS 2935
NZ X5,QNVNXTHB PROCS 2936
* A SIMPLE VARIABLE WAS FOUND; RETURN AN NTY SVD POINTING TO IT. PROCS 2937
SX2 NTY PROCS 2938
SX7 A2+1 . F1 IS POINTER TO VALUE CELL PROCS 2939
LX2 55 PROCS 2940
BX7 X2+X7 . (F2=BASE=0) PROCS 2941
JP QSTAKR . STACK X2,X7 AND RETURN PROCS 2942
* THE END OF HEAP STORAGE WAS REACHED; START AGAIN AT THE BEGINNING. PROCS 2943
QNVWRAP SA4 MINHS PROCS 2944
SA2 X4+STNDREL . FETCH FIRST (REAL) HB HEADER PROCS 2945
JP QNVYY PROCS 2946
* IF NAMED VARIABLE LIES IN A STRUCTURE, TAKE NEXT STRUCTURE ELEMENT. PROCS 2947
QNVNAME SA3 B6-1 . FETCH NTY SVD PROCS 2948
SX1 X3 . F1 IS POINTER TO VALUE CELL OF VAR.PROCS 2949
AX3 18 PROCS 2950
SB2 X3 . F2 IS STRUCTURE BASE, PROCS 2951
ZR B2,QNVPOPSV . OR ZERO FOR SIMPLE VARIABLE PROCS 2952
SA4 X3 . FETCH STRUCTURE BLOCK HEADER WORD PROCS 2953
AX4 18+18 . F3 OF HEADER IS BYPASS PROCS 2954
SB1 X1+1 . PTR TO NEXT VALUE CELL, OR LWA+1 PROCS 2955
SB3 B2+X4 . POINTER TO STRUCTURE LWA+1 PROCS 2956
LT B1,B3,QNVZZ . B1 POINTS WITHIN THE STRUCTURE PROCS 2957
SB1 B2+1 . SET B1 = ADDRESS OF FIRST ELEMENT PROCS 2958
QNVZZ LX3 18 . REPOSITION SVD, WITH F1=0 PROCS 2959
SX7 B1 . NEW F1 PROCS 2960
BX7 X3+X7 . NOTE THAT STACK HEADING AND PROCS 2961
SA7 A3 . STRUCTURE REFERENCE COUNT PROCS 2962
JP NEXTMIC . ARE STILL CORRECT PROCS 2963
* PARAMETER NAMED A SIMPLE VARIABLE; TO SIMULATE INDRCT WE MUST POP IT.PROCS 2964
QNVPOPSV SB6 B6-2 . BYPASS = 1+1 PROCS 2965
JP QNVSIMP . NOTE X1 CONTAINS VALUE CELL POINTERPROCS 2966
* PROCS 2967
NEXTVQ BSS 0 . LWA+1 OF CODE FOR NEXTVAR() PROCS 2968
* PROCS 2969
* B1 POINTS TO THE FIRST WORD, B2 POINTS TO THE PROCS 2970
* LAST WORD+1 OF A PATTERN. (SUBSET OF THE TOP ENTRY PROCS 2971
* IN THE STACK) PUT PATTERN INTO CANONICAL FORM AND PROCS 2972
* RETURN IT AS THE RESULT IN PLACE OF THE SUPERSET PROCS 2973
* TOP ENTRY. PROCS 2974
* PROCS 2975
QPSIMP SA1 B1 PROCS 2976
UX7 B5,X1 . OPC OF WORD 0 TO B5 PROCS 2977
SB4 EXPPM-1777B PROCS 2978
SB3 B1 . COPY START OF SUBPATTERN PROCS 2979
NE B4,B5,QPSIMP1 . BRANCH IF NOT EXP PROCS 2980
SB4 B1+X1 . LWA+1 OF THE EXP PROCS 2981
NE B4,B2,QPSIMP2 . EXP IS NOT WHOLE PATTERN PROCS 2982
SB1 B1+1 PROCS 2983
SB2 B2-1 . SKIP BRACKETS PROCS 2984
EQ QPSIMP PROCS 2985
QPSIMP1 SB4 ARBNOPM-1777B PROCS 2986
EQ B4,B5,QPSIMP3 . BRANCH IF ARBNO PROCS 2987
ZR B5,QPSIMP3 . OR STAR PROCS 2988
SB4 ALTPM-1777B PROCS 2989
EQ B4,B5,QPSIMP4A . BRANCH IF ALTERNATED PROCS 2990
* DECIDE IF PS OR PE PROCS 2991
QPSIMP2 RJ QPNEXT . SKIP NEXT PS PROCS 2992
LE B2,B3,QPSIMP7 . PS IF END IS REACHED PROCS 2993
QPSIMP3 SX0 PETY RETURN PE TYPE PROCS 2994
JP QPSIMP8 PROCS 2995
* DECIDE IF PE OR PA PROCS 2996
QPSIMP4A SB4 B1+X1 . PA ONLY IF LWA+1 = END PROCS 2997
NE B4,B2,QPSIMP3 PROCS 2998
* GENERATE PARAM FOR PA PROCS 2999
QPSIMP4 SB3 B3+1 . SKIP ALTPM PROCS 3000
RJ QPNEXT . SKIP NEXT PS PROCS 3001
QPSIMP5 SA1 B3 PROCS 3002
UX7 B5,X1 PROCS 3003
SB4 ALTPM-1777B PROCS 3004
EQ B4,B5,QPSIMP4 . BRANCH IF NOT LAST TERM PROCS 3005
SX1 B2-B3 . SIZE OF LAST TERM IS PROCS 3006
SX0 PATY . THE PARAM FOR PATY PROCS 3007
LX1 60-55+18 . PREPARE FOR SHIFT TO F2 PROCS 3008
BX0 X0+X1 PROCS 3009
JP QPSIMP8 PROCS 3010
* CHECK IF PS IS IN FACT A STRING PROCS 3011
QPSIMP7 SB4 LITPM-2000B PROCS 3012
SX0 PSTY PROCS 3013
NE B4,B5,QPSIMP8 . PS IF NOT A SINGLE LITERAL PROCS 3014
SB3 B2-1 . LAST CHARACTER PROCS 3015
SB2 B1+1 . FIRST CHARACTER PROCS 3016
RJ STOSFX6 . CONVERT INTO SF FORMAT PROCS 3017
SA1 B6 . SKIP TOP ENTRY PROCS 3018
BX2 X2-X2 . SFTY TO X2 PROCS 3019
SB1 X1+0 PROCS 3020
SB6 B6-B1 PROCS 3021
BX7 X6 . SVD TO BE STACKED PROCS 3022
JP QSTAKR . RETURN SF ENTRY PROCS 3023
* PROCS 3024
* RETURN PATTERN BETWEEN B1 AND B2 WITH HEADING IN X0 PROCS 3025
QPSIMP8 SA1 B6 PROCS 3026
LX0 55 . SHIFT X0 TO PLACE PROCS 3027
SX6 B2-B1 PROCS 3028
SB5 X1 . BYPASS OF OLD ENTRY TO B5 PROCS 3029
SB4 1 PROCS 3030
SX6 X6+B4 . BYPASS OF THE NEW ENTRY TO X6 PROCS 3031
SB5 B6-B5 . SKIP OLD ENTRY PROCS 3032
QPSIMP9 SA1 B1 . MOVE PATTERN PROCS 3033
SB5 B5+B4 PROCS 3034
SB1 B1+B4 PROCS 3035
BX7 X1 PROCS 3036
SA7 B5 PROCS 3037
LT B1,B2,QPSIMP9 PROCS 3038
SB6 B5+B4 PROCS 3039
BX6 X6+X0 . MERGE BYPASS INTO HEADING PROCS 3040
SA6 B6 . STORE HEADING PROCS 3041
JP NEXTMIC PROCS 3042
* PROCS 3043
* STANDARD PROCEDURES: FIRST, REST PROCS 3044
* PROCS 3045
QFIRST CALL QREST1,B2,QPSIMP PROCS 3046
* PROCS 3047
QREST SB2 QREST3 PROCS 3048
QREST1 PARAM 1 PROCS 3049
SA1 B6 PROCS 3050
SB1 X1-1 . B6-B1 WILL POINT TO WORD 0 PROCS 3051
AX1 55 . OF THE FIRST () TERM PROCS 3052
SX0 X1-PETY PROCS 3053
ZR X0,QREST2 PROCS 3054
SX0 X1-PATY PROCS 3055
NZ X0,ERR59 . ARGUMENT MUST BE PE OR PA PROCS 3056
SB1 B1-1 PROCS 3057
QREST2 SB3 B6-B1 PROCS 3058
SB1 B6-B1 PROCS 3059
RJ QPNEXT . FIND WORD 0 OF THE REST() PROCS 3060
EQ B3,B6,ERR59 . ERROR IF REST IS NULL PROCS 3061
SB5 B2 PROCS 3062
SB2 B3 PROCS 3063
JP B5 . "BRANCH IF FIRST()! PROCS 3064
QREST3 SB1 B2 PROCS 3065
SB2 B6 PROCS 3066
JP QPSIMP . BRANCH TO RETURN REST() PROCS 3067
RESTQ BSS 0 PROCS 3068
* PROCS 3069
* STANDARD PROCEDURES: LEFT, RIGHT PROCS 3070
* PROCS 3071
QRIGHT SB4 0 PROCS 3072
JP QRIGHT1 PROCS 3073
QLEFT SB4 -1 . LEFT( P . V ) = P, WHERE PROCS 3074
* P IS A SIMPLE PATTERN (PSTY) PROCS 3075
QRIGHT1 PARAM 1 PROCS 3076
SA2 B6 PROCS 3077
SB1 X2-1 PROCS 3078
AX2 55 PROCS 3079
SB1 B6-B1 . B1 POINTS TO WORD 0 OF LEFT() PROCS 3080
SA1 B6-1 . FETCH WORD 0 OF RIGHT PROCS 3081
SB2 A1 PROCS 3082
SX3 X2-PSTY PROCS 3083
NZ X3,QRIGHT5 . BRANCH IF NOT PS PROCS 3084
SX2 X1 PROCS 3085
NG X2,ERR59 . RIGHT() PRIMARY MUST PROCS 3086
BX6 X6-X6 . BE THE OPERAND OF PRD OR PROCS 3087
DF X1,ERR59 . DOL PROCS 3088
NG B4,QPSIMP . BRANCH FOR LEFT PROCS 3089
* CREATE NTY SVD FROM VARIABLE REFERENCE IN X1 PROCS 3090
QRIGHT2 SA3 X1 PROCS 3091
BX6 X6-X6 PROCS 3092
SX2 NTY PROCS 3093
QRIGHT3 SA3 A3-1 . FIND WORD 0 OF REFERENCED PROCS 3094
PL X3,QRIGHT3 . HB PROCS 3095
AX3 55 PROCS 3096
SX1 X1 PROCS 3097
SX3 X3-STRTYP+37B PROCS 3098
LX2 55 PROCS 3099
NZ X3,QRIGHT4 . BRANCH IF SIMPLE VARIABLE PROCS 3100
SX6 A3 . BASE TO X6 PROCS 3101
QRIGHT4 LX6 18 PROCS 3102
BX7 X1+X2 PROCS 3103
SB6 B1-1 PROCS 3104
BX7 X7+X6 . NTY+BASE+REF TO X7 PROCS 3105
JP QSTAKR . STACK NTY ENTRY AND RETURN PROCS 3106
* A SINGLE PE TYPE STAR ENTRY IS ACCEPTABLE PROCS 3107
QRIGHT5 LT B4,B0,ERR59 . ERROR IF LEFT() PROCS 3108
SX0 X2-PETY PROCS 3109
NZ X0,QRIGHT6 . BRANCH IF NOT PE PROCS 3110
NE B2,B1,ERR59 . BRANCH IF NOT STAR (IT IS PROCS 3111
JP QRIGHT2 . STAR IFF ENTRY IS 1 WORD LONG) PROCS 3112
* RETURN THE NAME OF THE VARIABLE REFERENCED IN A SIMPLE NTY PROCS 3113
QRIGHT6 SX0 X2-NTY PROCS 3114
NZ X0,ERR59 . ERROR IF NOT NTY PROCS 3115
BX2 X1 PROCS 3116
SB6 B1-1 PROCS 3117
AX2 18 PROCS 3118
SX2 X2+0 PROCS 3119
NZ X2,ERR59 . ERROR IF NOT SIMPLE NTY PROCS 3120
QRIGHT7 CALL QPHBN . GET NAME OF THE VARIABLE PROCS 3121
BX2 X6 . (OR FUNCTION IF CALLED FROM SELECTOR)PROCS 3122
JP COPYSS . COPY STRING TO SF AND RETURN IT PROCS 3123
* PROCS 3124
RIGHTQ BSS 0 PROCS 3125
* PROCS 3126
* STANDARD PROCEDURE: PARAM PROCS 3127
* PROCS 3128
QPARAM PARAM 1 PROCS 3129
SA4 B6 PROCS 3130
SB1 X4-1 PROCS 3131
AX4 55 PROCS 3132
SA2 B6-B1 . WORD 0 OF ENTRY PROCS 3133
UX7 B5,X2 PROCS 3134
SB2 X2+0 . F1 OF WORD 0 TO B2 PROCS 3135
SX0 X4-PETY PROCS 3136
ZR X0,QPARAM6 . BRANCH IF PE PROCS 3137
SX0 X4-PSTY PROCS 3138
NZ X0,ERR59 . ERROR IF NOT PS PROCS 3139
SA1 B6-1 PROCS 3140
SX3 X1+0 PROCS 3141
NG X3,QPARAM1 . ERROR IF PRD OR DOL PROCS 3142
ID X1,ERR59 . IN THE LAST WORD PROCS 3143
QPARAM1 CALL QFINDPS . FIND TEXT TO CHECK TYPE PROCS 3144
LX1 60-12-2 PROCS 3145
PL X1,ERR59 . ERROR IF TYPE NOT EQUAL 2 PROCS 3146
LT B0,B5,QPARAM2 . BRANCH IF ANY, SPAN ETC. PROCS 3147
* RETURN THE INTEGER PARAMETER PROCS 3148
SB6 B6-2 PROCS 3149
SX2 ITY PROCS 3150
SX7 B2 . RETURN F1 PROCS 3151
LX2 55 PROCS 3152
JP QSTAKR PROCS 3153
* RE-CREATE THE STRING OPERAND OF ANY ETC. PROCS 3154
QPARAM2 SB1 1 PROCS 3155
SA3 B6-B1 . FETCH ODD BIT-TABLE PROCS 3156
SA4 A3-B1 . FETCH EVEN BIT-TABLE PROCS 3157
CX7 X3 PROCS 3158
SB6 A4-2 PROCS 3159
CX6 X4 PROCS 3160
IX7 X7+X6 . TOTAL NUMBER OF BITS SET PROCS 3161
SA0 X7 PROCS 3162
RJ RESERVE . RESERVE THAT MANY WORDS PROCS 3163
SA7 B6 . INITIALIZE A7 PROCS 3164
SB5 A0 PROCS 3165
SX7 CHMASK+1 PROCS 3166
QPARAM3 SX7 X7-1 . LOOP THROUGH ALL CHARACTERS PROCS 3167
SX2 X7 PROCS 3168
SB2 A7 PROCS 3169
ZR X7,QPARAM5 PROCS 3170
LX2 60-1 . SELECT CORRESPONDING BIT PROCS 3171
BX1 X3 . TABLE WORD (SEE ANY PROCS 3172
SB2 X2 . IN PATMAT) PROCS 3173
NG X2,QPARAM4 PROCS 3174
BX1 X4 PROCS 3175
QPARAM4 LX1 43 PROCS 3176
LX1 X1,B2 PROCS 3177
PL X1,QPARAM3 . BRANCH IF BIT IS NOT SET PROCS 3178
SA7 A7-B1 . STORE NEXT SELECTED PROCS 3179
EQ QPARAM3 . CHARACTER PROCS 3180
* RETURN THE CHARACTERS BETWEEN B2 AND B6-1 PROCS 3181
QPARAM5 SB3 B6-B1 PROCS 3182
RJ STOSFX6 . CONVERT INTO SF FORMAT PROCS 3183
SB6 B6-B5 . SKIP TEMPORARY ENTRY PROCS 3184
BX7 X6 PROCS 3185
SX2 SFTY PROCS 3186
CALL STAK2,,NEXTMIC PROCS 3187
* RETURN THE ARGUMENT OF ARBNO PROCS 3188
QPARAM6 SB4 ARBNOPM-1777B PROCS 3189
NE B4,B5,ERR59 . ERROR IF NOT ARBNO PROCS 3190
SB2 A2+B2 PROCS 3191
NE B2,B6,ERR59 . OR NOT ONLY ARBNO PROCS 3192
SB1 A2+2 . WORD 0 OF ARGUMENT PROCS 3193
SB2 B6-1 . LAST WORD OF ARGUMENT+1 PROCS 3194
JP QPSIMP PROCS 3195
* PROCS 3196
PARAMQ BSS 0 PROCS 3197
* PROCS 3198
* STANDARD PROCEDURES: SELECTOR, BASE PROCS 3199
* PROCS 3200
* PROCS 3201
QBASEV1 EQU QDEFSV1 PROCS 3202
QBASEV2 EQU QDEFSV2 PROCS 3203
* PROCS 3204
QBASE SB4 0 PROCS 3205
JP QSELCT1 PROCS 3206
QSELCT SB4 -1 PROCS 3207
QSELCT1 PARAM 1 PROCS 3208
SA1 B6 PROCS 3209
SA2 B6-1 PROCS 3210
AX1 55 PROCS 3211
SX0 X1-NTY PROCS 3212
NZ X0,ERR59 . ERROR IF NOT NTY PROCS 3213
SB1 X2 . VARIABLE REFERENCE TO B1 PROCS 3214
AX2 18 PROCS 3215
SB2 X2 . STRUCTURE BASE TO B2 PROCS 3216
SA2 X2 PROCS 3217
EQ B2,B0,ERR59 . ERROR IF SIMPLE NTY PROCS 3218
AX2 18 PROCS 3219
SX7 X2 . DOPE POINTER TO X7 PROCS 3220
SA4 X2+1 . WORD 1 OF DOPE VECTOR TO X4 PROCS 3221
SX6 B2 PROCS 3222
LX4 1 . X4 LT 0 IFF ARRAY PROCS 3223
LT B4,B0,QSELCT2 . BRANCH IF SELECTOR PROCS 3224
SX2 ATY PROCS 3225
NG X4,QBASE1 PROCS 3226
SX2 DTY PROCS 3227
* NOTE THAT THE REFERENCE COUNT OF THE STRUCTURE DOES PROCS 3228
* NOT CHANGE PROCS 3229
QBASE1 SB6 B6-2 PROCS 3230
LX6 18 PROCS 3231
LX2 55 PROCS 3232
BX7 X7+X6 . RETURN ATY OR DTY PROCS 3233
BX7 X7+X2 . REFERENCE PROCS 3234
JP QSTAKR PROCS 3235
* COMPUTE THE SELECTOR SELECTING WORD B1-B2 PROCS 3236
QSELCT2 CALL SKIPONE,B5 . DESTROY THE NTY ENTRY PROCS 3237
SX7 B1-B2 PROCS 3238
SB2 B1-B2 PROCS 3239
NG X4,QSELCT3 . BRANCH IF ARRAY PROCS 3240
SA1 A4+B2 . FETCH POINTER TO THE SELECTOR PROCS 3241
JP QRIGHT7 . FUD AND RETURN ITS NAME. PROCS 3242
* COMPUTE SUBSCRIPT LIST PROCS 3243
QSELCT3 SA1 A4-1 PROCS 3244
SX7 X7-1 . SELECTORS START AT 0 PROCS 3245
SX6 X1-1 PROCS 3246
SA7 QBASEV1 . SEL = SELECTOR PROCS 3247
SA6 QBASEV2 . DIM = SIZE OF THE ARRAY PROCS 3248
SA0 A4 PROCS 3249
BX1 X1-X1 PROCS 3250
CALL QPROT5 . INITIALIZE UCAT PROCS 3251
QSELCT4 SA4 QBASEV2 PROCS 3252
SA3 A0 . NEXT DOPE WORD TO X3 PROCS 3253
PX4 X4 PROCS 3254
LX3 60-36 PROCS 3255
SX7 X3 . X7 = UPPER-LOWER+1 PROCS 3256
PX7 X7 PROCS 3257
NX7 X7 PROCS 3258
FX7 X4/X7 . DIM = DIM/X7 PROCS 3259
UX7 X7,B1 PROCS 3260
SA2 QBASEV1 PROCS 3261
LX7 X7,B1 PROCS 3262
SA7 A4 PROCS 3263
PX2 X2 PROCS 3264
LX3 18 PROCS 3265
SX0 X3 PROCS 3266
PX7 X7 PROCS 3267
NX7 X7 PROCS 3268
FX6 X2/X7 . INDEX = SEL/DIM+LOWER PROCS 3269
UX6 X6,B1 PROCS 3270
LX6 X6,B1 PROCS 3271
IX1 X6+X0 PROCS 3272
PX6 X6 PROCS 3273
NX6 X6 PROCS 3274
FX6 X6*X7 . SEL = SEL MOD DIM PROCS 3275
FX6 X2-X6 PROCS 3276
UX6 X6,B1 PROCS 3277
LX6 X6,B1 PROCS 3278
SA6 A2 PROCS 3279
RJ ITOSF . CONVERT INDEX PROCS 3280
RJ UCAT PROCS 3281
SA1 A0+0 PROCS 3282
NG X1,QPROT4 . FINISHED IF LAST DIMENSION PROCS 3283
SX7 1R, PROCS 3284
RJ QPSCON . INSERT COMMA PROCS 3285
BX6 X0+X6 PROCS 3286
RJ UCAT PROCS 3287
SA0 A0+1 PROCS 3288
JP QSELCT4 PROCS 3289
* PROCS 3290
SELCTQ BSS 0 PROCS 3291
* PROCS 3292
* STANDARD PROCEDURE: ITEM PROCS 3293
* ITEM WILL ACCEPT ANY NUMBER OF PARAMETERS PROCS 3294
* PROCS 3295
QITEM SB1 X5 PROCS 3296
SB5 B6 PROCS 3297
BX7 X7-X7 PROCS 3298
BX6 X6-X6 . SEL = 0 PROCS 3299
QITEM1 LX7 36 . LOOP TO LINK TOGETHER ACTUAL PROCS 3300
SA3 B5 . PARAMETERS VIA F3 OF WORD 0. PROCS 3301
BX7 X7+X3 . CODE IS SIMILAR TO CALL1 IN PROCS 3302
SA7 A3 . MAINLUP PROCS 3303
SB2 X3 PROCS 3304
SX7 X3 PROCS 3305
SB5 B5-B2 PROCS 3306
SB1 B1-1 PROCS 3307
NE B1,B0,QITEM1 PROCS 3308
* B5+B2 POINTS TO THE FIRST PARAMETER, IT MUST BE AN PROCS 3309
* ARRAY REFERENCE. PROCS 3310
* (N+1)TH ARGUMENT IS AT NTH+F3(CONTENTS(NTH)) PROCS 3311
SB1 1 . THE CONSTANT 1 PROCS 3312
SA1 B5+B2 . WORD 0 OF FIRST PARAM PROCS 3313
SA2 A1-B1 . FETCH ATY SVD PROCS 3314
AX1 55 PROCS 3315
SX0 X1-ATY PROCS 3316
SA0 X2 . DOPE POINTER TO A0 PROCS 3317
NZ X0,ERR29 . ERROR IF NOT ATY PROCS 3318
SB2 B0 . STATE: AFTER PARAM PROCS 3319
SB5 A1 PROCS 3320
* GET NEXT INDEX VALUE TO X2 FROM THE NEXT PARAMETER PROCS 3321
* IF B2 = 0, OTHERWISE FROM THE CURRENT STRING PROCS 3322
QITEM2 NE B2,B0,QITEM4 PROCS 3323
BX7 X7-X7 PROCS 3324
BX2 X2-X2 . INDEX IS 0 IF NO MORE ACTUAL PROCS 3325
SA1 B5 PROCS 3326
EQ B5,B6,QITEM9 . PARAMETERS PROCS 3327
AX1 36 PROCS 3328
SA1 B5+X1 . WORD 0 OF NEXT PARAM TO X1 PROCS 3329
SB5 A1 . B5 POINTS TO THE CURRENT PARAM PROCS 3330
SA2 A1-B1 . VALUE OR SVD TO X2 PROCS 3331
AX1 55 PROCS 3332
ZR X1,QITEM3 . BRANCH IF STRING, X2 IS SVD PROCS 3333
SX1 X1-ITY PROCS 3334
ZR X1,QITEM9 . BRANCH IF INTEGER, VALUE IS IN X2 PROCS 3335
JP ERR29 PROCS 3336
* INITIALIZE STRING DESCRIPTION: X3 CONTAINS PROCS 3337
* THE CURRENT WORD AND THE POINTER TO THE NEXT WORD PROCS 3338
* IS IN X4. PROCS 3339
QITEM3 SA3 X2+0 PROCS 3340
SX4 X3 PROCS 3341
BX3 X3-X4 . REMOVE POINTER FROM X3 PROCS 3342
* GET THE NEXT NUMBER FROM THE CURRENT STRING. B2 CONTAINS PROCS 3343
* THE STATE: PROCS 3344
* 0 IN FRONT OF THE NUMBER PROCS 3345
* 1 AFTER SIGN PROCS 3346
* 2 AMONG DIGITS PROCS 3347
* A COMMA OR THE END OF STRING MAY TERMINATE A NUMBER PROCS 3348
QITEM4 BX2 X2-X2 . VALUE = 0 PROCS 3349
BX7 X7-X7 . SIGN = POSITIVE PROCS 3350
SB2 0 . STATE = IN FRONT PROCS 3351
* GET THE NEXT CHARACTER INTO X1 PROCS 3352
QITEM5 LX3 CHSIZ PROCS 3353
MX0 60-CHSIZ PROCS 3354
BX1 -X0*X3 PROCS 3355
ZR X1,QITEM7 . BRANCH IF END OF WORD PROCS 3356
SX1 X1-1R0 PROCS 3357
NG X1,ERR60 . ERROR IF LETTER PROCS 3358
SX0 X1+1R0-1R+ PROCS 3359
PL X0,QITEM6 . BRANCH IF NOT DIGIT PROCS 3360
SB2 B1+B1 . STATE = AMONG DIGITS PROCS 3361
BX0 X2 PROCS 3362
LX2 2 PROCS 3363
IX2 X2+X0 PROCS 3364
LX2 1 PROCS 3365
IX2 X2+X1 . VALUE = VALUE*5*2+DIGIT PROCS 3366
MX0 60-17 . ABS( INDEX ) MUST BE LESS THAN 2@17PROCS 3367
BX0 X0*X2 PROCS 3368
ZR X0,QITEM5 . NEXT CHAR IF NO OVERFLOW PROCS 3369
JP FAIL PROCS 3370
QITEM6 SB4 1 . PREPARE AFTER COMMA STATE PROCS 3371
SB3 X1+1R0-1R, PROCS 3372
EQ B3,B0,QITEM8 . BRANCH IF COMMA PROCS 3373
NE B2,B0,ERR60 . MUST BE IN FRONT OF NUMBER PROCS 3374
SB2 B1 . STATE = AFTER SIGN PROCS 3375
ZR X0,QITEM5 . IGNORE + SIGN PROCS 3376
MX7 60 . SIGN = NEGATIVE PROCS 3377
SB3 X1+1R0-1R- PROCS 3378
EQ B3,B0,QITEM5 . BRANCH IF - SIGN PROCS 3379
ERR60 ERROR 60 . SYNTAX ERROR IN SELECTOR PROCS 3380
* GET NEXT WORD PROCS 3381
QITEM7 SB4 B0 . PREPARE AFTER PARAM STATE PROCS 3382
ZR X4,QITEM8 . BRANCH IF END OF STRING PROCS 3383
SA3 X4 PROCS 3384
SX4 X3 PROCS 3385
BX3 X3-X4 PROCS 3386
EQ QITEM5 PROCS 3387
* TERMINATOR REACHED, OUTER STATE IS IN B4 PROCS 3388
QITEM8 SB2 B4 . SET OUTER STATE PROCS 3389
* NEXT INDEX IS IN X2 (SIGN IS IN X7) PROCS 3390
QITEM9 SA1 A0+B1 . NEXT DOPE WORD TO X1 PROCS 3391
BX2 X2-X7 . VALUE = VALUE*SIGN(X7) PROCS 3392
SA0 A0+B1 PROCS 3393
SX7 X1 . UPPER BOUND TO X7 PROCS 3394
IX0 X7-X2 PROCS 3395
AX1 18 PROCS 3396
NG X0,FAIL . FAIL IF BOUND IS EXCEEDED PROCS 3397
SX7 X1 . LOWER BOUND TO X7 PROCS 3398
IX0 X2-X7 PROCS 3399
NG X0,FAIL PROCS 3400
AX1 18 PROCS 3401
* SET SEL := SEL * (L-U+1) + INDEX PROCS 3402
SX7 X1 . (U-L+1) TO X7 PROCS 3403
PX7 X7 PROCS 3404
PX6 X6 PROCS 3405
DX6 X7*X6 PROCS 3406
UX6 X6 PROCS 3407
IX6 X6+X0 PROCS 3408
PL X1,QITEM2 . PEPEAT IF NOT LAST DOPE WORD PROCS 3409
* SELECTOR IS IN X6, SKIP ALL ARGUMENTS, EXCEPT THE FIRST ONE. PROCS 3410
SX4 QITEM11 . NOTE: X5 CONTAINS NO. OF PROCS 3411
QITEM11 PARAM 1 . ACTUAL PARAMETERS PROCS 3412
SA1 B6-B1 . FETCH ATY SVD PROCS 3413
SB6 B6-2 . SKIP THE FIRST ARG NOW PROCS 3414
SA5 A5 . FETCH CALL MICOP PROCS 3415
AX1 18 . STRUCTURE BASE TO X1 PROCS 3416
LX5 1 PROCS 3417
CALL SELSTR,,NEXTMIC . RETURN VALUE OR NAME PROCS 3418
* PROCS 3419
ITEMQ BSS 0 PROCS 3420
* PROCS 3421
* PROCS 3422
* PROCS 3423
* STANDARD PROCEDURE: APPLY PROCS 3424
* PROCS 3425
QAPPLY SB3 X5-1 . NUMBER OF PARAMS-1 PROCS 3426
SB2 B6 . PTR TO (B3+1)TH = LAST PARAMETER PROCS 3427
SX5 B3 PROCS 3428
NE B3,B0,QAPPR PROCS 3429
SX5 1 . CREATE A NULL 2ND PARAM PROCS 3430
* NOTE B2,B3 ARE STILL SET SO FOLLOWING LOOP WILL FIND FIRST PARAMETER.PROCS 3431
RJ ZROX7 PROCS 3432
CALL NULL0 PROCS 3433
QAPPR SA1 B2 . LOOP TO FIND 1ST PARAM PROCS 3434
SB3 B3-1 . IN THE STACK PROCS 3435
SB4 X1 PROCS 3436
SB2 B2-B4 PROCS 3437
GE B3,B0,QAPPR PROCS 3438
AX1 55 . TYPE OF FIRST PARAM PROCS 3439
SX0 CALLTYP PROCS 3440
NZ X1,ERR29 . ERROR: IT MUST BE A STRING PROCS 3441
SB2 B2+B4 PROCS 3442
SA4 B2-1 PROCS 3443
LX0 55 PROCS 3444
SB1 B2 PROCS 3445
SB5 X4 . SET UP SEARCH CALL FOR PROCS 3446
AX4 36 . THE FUNCTION PROCS 3447
SB3 X4 PROCS 3448
EQ B3,B0,ERR27 . ERROR: NAME IS NULL PROCS 3449
RJ SEARCH PROCS 3450
ZR X1,ERR14 . ERROR: NOT FOUND PROCS 3451
SA2 B1-1 . FREE THE FIRST PARAM STRING PROCS 3452
SX7 B7 PROCS 3453
SB7 X2 PROCS 3454
AX2 18 PROCS 3455
SA7 X2 PROCS 3456
QAPPL1 SA2 B1+1 . MOVE 2ND THRU LAST PARAM PROCS 3457
BX7 X2 PROCS 3458
SB1 A2 PROCS 3459
SA7 A2-2 PROCS 3460
LT B1,B6,QAPPL1 PROCS 3461
SB6 A7 . WE HAVE ONE LESS PARAMS NOW PROCS 3462
* WE SIMULATE A CALL MICOP WORD IN X5, AS SEEN BY THE CODE AT CALL IN PROCS 3463
* MAINLUP. RECALL THAT THERE, AX5 18 HAS ALREADY BEEN DONE. PROCS 3464
LX5 18 . NO. OF ACTUALS IS NOW F2, PROCS 3465
BX5 X5+X1 . ADDR. OF FUD IS F1 PROCS 3466
SA1 A5 . FETCH CURRENT (CALL) MICOP WORD PROCS 3467
MX0 1 . AND PROPAGATE ITS PROCS 3468
LX0 60-1 . N-BIT (=NRETURN EXPECTED) PROCS 3469
BX1 X0*X1 . TO THE SIMULATED PROCS 3470
AX1 18 . CALL PROCS 3471
BX5 X5+X1 . ENTER CALL JUST AFTER PROCS 3472
JP CALLA . IT DOES SPARAM() PROCS 3473
* PROCS 3474
* PROCS 3475
* PROCS 3476
END PROCS 3477