CONSTSHORTINTEGERARRAY MAIN(1 : 217) = C
1, 5, 14, 20, 26, 38, 43, 48, 54, 61, 68, 74,
79, 82, 84, 89, 96, 102, 108, 115, 122, 126, 0, 129,
133, 137, 142, 145, 152, 156, 161, 164, 168, 0, 171, 0,
178, 184, 185, 189, 190, 193, 196, 199, 0, 202, 205, 206,
208, 0, 211, 213, 215, 216, 219, 222, 225, 0, 228, 231,
236, 241, 244, 249, 0, 253, 259, 260, 264, 266, 267, 270,
271, 274, 277, 279, 280, 283, 286, 289, 292, 295, 298, 302,
305, 308, 311, 314, 317, 320, 324, 328, 332, 336, 340, 344,
348, 352, 355, 358, 0, 361, 363, 365, 373, 0, 381, 0,
385, 392, 393, 396, 397, 400, 403, 405, 406, 410, 0, 413,
418, 425, 432, 0, 435, 437, 0, 440, 445, 446, 450, 453,
456, 0, 459, 462, 463, 0, 469, 472, 473, 475, 0, 477,
489, 499, 506, 0, 509, 511, 512, 517, 0, 520, 0, 530,
534, 535, 538, 539, 0, 543, 546, 547, 0, 558, 565, 566,
571, 572, 576, 579, 0, 585, 587, 588, 591, 0, 594, 597,
0, 600, 602, 603, 608, 609, 614, 615, 618, 0, 620, 622,
623, 627, 628, 631, 634, 637, 0, 640, 646, 0, 651, 656,
657, 660, 661, 665, 0, 667, 0, 670, 674, 675, 678, 681,
683
CONSTSHORTINTEGERARRAY SUB(2 : 684) = C
4119, 4288, -8192, 0, 4149, 4168, 4197, 4166, 4286,
4119, 4230, -8192, 0, 1, 8200, 24576, 4230, -8192,
0, 8, 8221, 24576, 16384, -8192, 0, 15, 8204,
20480, 16384, 4202, 21, 8244, 4168, 4197, 4166, -8192,
0, 4154, 4246,-20480, -8192, 0, 4290, 4154, 4295,
-20480, 0, 23, 8223, 4255, -8192,-20480, 0, 4208,
4271, 4212, -4096, 4261, -8192, 0, 30, 8197, -4096,
4261, -8192,-20480, 0, 35, 8196, 20480, -8192,-16384,
0, 41, 8198, 4215, -8192, 0, 4130, 4096, 0,
4225, 0, 45, 8199, -8192,-20480, 0, 4309, 50,
8201, 4239, -8192,-20480, 0, 57,-20480, 8202, 12288,
-8192, 0, 65, 8203, 4232, -8192,-20480, 0, 71,
77, 8193, 8205, -8192,-20480, 0, 85, 93, 8206,
8207, -8192,-20480, 0, 101, 8257,-32768, 0,-12288,
-8192, 0, 4202, 4134, 4141, 0, 103, 8246, 4143,
0, 106, 8208, 12288, 4141, 0, 116, 8209, 0,
123, 8210, 4136, 4168, 4197, 4166, 0, 130, 8211,
20480, 0, 15, 8204, 20480, 16384, 0, 136, 8212,
0, 141, 8213, 4146, 0, 149, 8214, 0, 8292,
4220, 154, 8245, 8192, 4132, 0, 8292, 4220, 154,
8245, 8192, 4132, 0, 4136, 4168, 4197, 4166, 0,
156, 8247, 0, 21, 8244, 0, 159, 8248, 0,
103, 8246, 0, 162, 8215, 4119, 0, 12288, 0,
-4096, 4204, 0, 12288, 0, 136, 8212, 0, 166,
8216, 0, 169, 8218, 0, 175, 8217, 0, 182,
8219, 0, 188, 8220, 0, 196, 188, 8194, 8220,
0, 71, 188, 8193, 8220, 0, 201, 8222, 0,
206, 201, 8195, 8222, 0, 211, 8224, 4161, 0,
218, 8249, 12288, 220, 8250, 8271, 0, 222, 8225,
8226, 0, 232, 8226, 0, 4172, 4197, 4166, 0,
237, 8251, 0, 239, 8252, 0, 241, 8253, 0,
237, 8251, 0, 103, 8246, 0, 239, 8252, 0,
243, 8254, 0, 245, 8255, 0, 248, 8256, 0,
250, 8257, 8257, 0, 101, 8257, 0, 253, 8258,
0, 256, 8259, 0, 258, 8260, 0, 260, 8261,
0, 263, 8262, 0, 21, 8244, 4168, 0, 266,
8263, 4168, 0, 269, 8264, 4168, 0, 271, 8267,
4168, 0, 273, 8265, 4168, 0, 276, 8266, 4168,
0, 278, 8268, 4168, 0, 281, 8272, 4168, 0,
162, 8215, 0, 283, 8227, 0, 154, 8245, 0,
12288, 0, 4202, 0, 218, 8249, 4168, 4197, 4166,
220, 8250, 0, 248, 8256, 4168, 4197, 4166, 248,
8256, 0, -4096, 4204, 4206, 0, 218, 8249, 4168,
4197, 4166, 220, 8250, 0, 286, 8270, 4202, 0,
288, 8231, 0, 297, 8232, 0, 304, 8233, 0,
30, 8197,-20480, 0, 20480,-16384, 0, 312, 8234,
8199,-20480, 0, 319, 8234, 8207, 28672, 24576, 20480,
0, 329, 8234, 8235, 28672, 24576, 20480, 0, 24576,
28672, 0, 12288, 0, -4096, 4223, 0, 218, 8249,
12288, 220, 8250, 0, 248, -8191,-28672, 0, 336,
-24576, 0, 248,-28672, 0, 339,-28672, 0, 347,
8237, 4119, 0, 12288, 103, 8246, 4236, 4234, 0,
281, 8269, 4232, 0, 12288, 0, -4096, 0, 352,
8238, -4096, 218, 8249, 4283, 4246, 4279, 4281, 220,
8250, 0, 30, 8197, -4096, 4253, 218, 8249, -4096,
220, 8250, 0, 4246, 218, 8249, -4096, 220, 8250,
0, 232, 8226, 0, 352, 8238, 0, 359, 8225,
4244, 4249, 0, 4163, 4305, 0, 4305, 218, 8249,
4168, 4197, 4166, 220, 8250, 4251, 0, 281, 8269,
4249, 4251, 0, 286, 8270, -4096, 0, 4305, 4259,
4257, 0, 281, 8269, 4255, 0, 218, 8249, 4168,
12288, 154, 8245, 4168, 12288, 220, 8250, 0, 218,
8249, 4265, 4305, 4263, 220, 8250, 0, 281, 8269,
4265, 4305, 4263, 0, 4271, 232, 8226, 0, 4154,
4163, 0, 50, 8201, 4269, 232, 8226, 0, 359,
8225, 0, 77, 8205, 0, 4154, 4274, 0, 365,
8239, 0, 368, 8240, 0, 281, 8269, 0, 218,
8249, -4096, 220, 8250, 0, 4277, 4283, 4246, 4279,
4281, 0, 50, 8201, 0, 4154, 0, 372, 8241,
0, 4149, 4168, 4197, 4166, 0, 377, 8228, 0,
381, 8229, 0, 387, 8230, 0, 288, 8231, 0,
359, 8225, -4096, 4259, 4302, 0, 4305, 4300, 4298,
-8192, 0, 281, 8269, 4305, 4300, 4298, 0, 21,
8244, 12288, 0, 21, 8244,-32768, 0, -8192, 0,
-4096, 4307, 0, 281, 8269, -4096, 4307, 0, 377,
8228, 0, 288, 8231, 0, 387, 8230, 0
CONSTBYTEINTEGERARRAY LITERAL(1 : 396) = C
6, 102, 105, 110, 105, 115, 104, 6, 114, 101, 112, 101,
97, 116, 5, 99, 121, 99, 108, 101, 1, 61, 6, 115,
119, 105, 116, 99, 104, 4, 115, 112, 101, 99, 5, 98,
101, 103, 105, 110, 3, 101, 110, 100, 4, 108, 105, 115,
116, 6, 114, 101, 99, 111, 114, 100, 7, 99, 111, 110,
116, 114, 111, 108, 5, 102, 97, 117, 108, 116, 5, 115,
104, 111, 114, 116, 7, 114, 111, 117, 116, 105, 110, 101,
7, 116, 114, 117, 115, 116, 101, 100, 7, 112, 114, 111,
103, 114, 97, 109, 1, 42, 2, 45, 62, 9, 112, 114,
105, 110, 116, 116, 101, 120, 116, 6, 114, 101, 116, 117,
114, 110, 6, 114, 101, 115, 117, 108, 116, 5, 115, 116,
97, 114, 116, 4, 115, 116, 111, 112, 7, 109, 111, 110,
105, 116, 111, 114, 4, 101, 120, 105, 116, 1, 58, 2,
61, 61, 2, 60, 45, 3, 97, 110, 100, 2, 105, 102,
5, 119, 104, 105, 108, 101, 6, 117, 110, 108, 101, 115,
115, 5, 117, 110, 116, 105, 108, 7, 105, 110, 116, 101,
103, 101, 114, 4, 98, 121, 116, 101, 4, 114, 101, 97,
108, 4, 108, 111, 110, 103, 6, 115, 116, 114, 105, 110,
103, 1, 40, 1, 41, 9, 97, 114, 114, 97, 121, 110,
97, 109, 101, 4, 110, 97, 109, 101, 1, 43, 1, 45,
1, 92, 1, 38, 2, 33, 33, 1, 33, 2, 42, 42,
2, 47, 47, 1, 47, 1, 46, 2, 60, 60, 2, 62,
62, 2, 60, 61, 1, 60, 1, 35, 2, 62, 61, 1,
62, 2, 92, 61, 1, 44, 2, 111, 114, 1, 95, 8,
101, 120, 116, 101, 114, 110, 97, 108, 6, 115, 121, 115,
116, 101, 109, 7, 100, 121, 110, 97, 109, 105, 99, 6,
111, 102, 108, 105, 115, 116, 9, 111, 102, 112, 114, 111,
103, 114, 97, 109, 6, 111, 102, 102, 105, 108, 101, 2,
33, 42, 7, 99, 111, 109, 109, 101, 110, 116, 4, 101,
108, 115, 101, 6, 102, 111, 114, 109, 97, 116, 5, 97,
114, 114, 97, 121, 2, 102, 110, 3, 109, 97, 112, 4,
116, 104, 101, 110, 3, 111, 119, 110, 5, 99, 111, 110,
115, 116, 9, 101, 120, 116, 114, 105, 110, 115, 105, 99
CONSTBYTEINTEGERARRAY SFLAGS(1 : 80) = C
3, 3, 3, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 1,
1, 1, 1, 4, 0, 4, 0, 4, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0,
2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0
CONSTBYTEINTEGERARRAY KEYSYMS(1 : 381) = C
5, 83, 72, 79, 82, 84, 4, 66, 89, 84, 69, 4, 76, 79, 78, 71, 5, 66,
69, 71, 73, 78, 4, 83, 80, 69, 67, 3, 69, 78, 68, 4, 76, 73, 83, 84,
6, 70, 73, 78, 73, 83, 72, 6, 82, 69, 67, 79, 82, 68, 7, 67, 79, 78,
84, 82, 79, 76, 5, 70, 65, 85, 76, 84, 5, 67, 89, 67, 76, 69, 7, 82,
79, 85, 84, 73, 78, 69, 7, 84, 82, 85, 83, 84, 69, 68, 7, 80, 82, 79,
71, 82, 65, 77, 9, 80, 82, 73, 78, 84, 84, 69, 88, 84, 6, 82, 69, 84,
85, 82, 78, 6, 82, 69, 83, 85, 76, 84, 5, 83, 84, 65, 82, 84, 4, 83,
84, 79, 80, 7, 77, 79, 78, 73, 84, 79, 82, 4, 69, 88, 73, 84, 3, 65,
78, 68, 2, 73, 70, 6, 85, 78, 76, 69, 83, 83, 5, 87, 72, 73, 76, 69,
5, 85, 78, 84, 73, 76, 7, 73, 78, 84, 69, 71, 69, 82, 6, 82, 69, 80,
69, 65, 84, 4, 82, 69, 65, 76, 6, 83, 87, 73, 84, 67, 72, 6, 83, 84,
82, 73, 78, 71, 5, 65, 82, 82, 65, 89, 4, 78, 65, 77, 69, 2, 79, 82,
3, 79, 87, 78, 5, 67, 79, 78, 83, 84, 9, 69, 88, 84, 82, 73, 78, 83,
73, 67, 8, 69, 88, 84, 69, 82, 78, 65, 76, 6, 83, 89, 83, 84, 69, 77,
7, 68, 89, 78, 65, 77, 73, 67, 2, 79, 70, 4, 70, 73, 76, 69, 7, 67,
79, 77, 77, 69, 78, 84, 4, 69, 76, 83, 69, 6, 70, 79, 82, 77, 65, 84,
2, 70, 78, 3, 77, 65, 80, 4, 84, 72, 69, 78, 5, 82, 69, 65, 76, 83,
6, 78, 79, 82, 77, 65, 76, 1, 61, 1, 58, 2, 45, 62, 2, 61, 61, 2,
60, 45, 1, 40, 1, 41, 1, 43, 1, 45, 1, 92, 1, 38, 2, 33, 33, 1,
33, 1, 42, 2, 47, 47, 1, 47, 1, 46, 2, 60, 60, 2, 62, 62, 2, 60,
61, 1, 60, 2, 62, 61, 1, 62, 1, 35, 2, 92, 61, 1, 44, 1, 95, 1,
32, 1, 44
CONSTSHORTINTEGERARRAY KEYWORD(1 : 80) = C
0, 6, 11, 16, 22, 27, 31, 36, 43, 50, 58, 64, 70, 78,
86, 94, 104, 111, 118, 124, 129, 137, 142, 146, 149, 156, 162, 168,
176, 183, 188, 195, 202, 208, 213, 216, 220, 226, 236, 245, 252, 260,
263, 268, 276, 281, 288, 291, 295, 300, 306, 313, 315, 317, 320, 323,
326, 328, 330, 332, 334, 336, 338, 341, 343, 345, 348, 350, 352, 355,
358, 361, 363, 366, 368, 370, 373, 375, 377, 379
CONSTBYTEINTEGERARRAY KFLAGS(1 : 80) = C
144, 144, 144, 128, 129, 128, 128, 128, 128, 128, 128, 128, 128, 144,
128, 128, 128, 128, 128, 128, 144, 128, 160, 130, 130, 130, 130, 128,
128, 128, 128, 128, 145, 129, 128, 144, 144, 144, 144, 144, 144, 145,
128, 128, 162, 129, 129, 129, 160, 144, 128, 8, 8, 8, 8, 8,
4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
8, 8, 8, 8, 8, 8, 64, 0, 0, 0
OWNBYTEINTEGER ISOLATE BRACKETS = 0; ! 'IB'
OWNBYTEINTEGER LEAVE BLANKS = 0; ! 'LB'
OWNBYTEINTEGER SEP BLOCKS = 1; ! 'SB'
OWNBYTEINTEGER INDENT BLOCKS = 1; ! 'TB'
OWNBYTEINTEGER SPLIT KEYWORDS = 0; ! 'SK'
OWNBYTEINTEGER PACK NAMES = 0; ! 'PN'
OWNBYTEINTEGER SPLIT STATS = 0; ! 'SS'
OWNBYTEINTEGER COMMENTS NORMAL = 0; ! 'CN'
OWNBYTEINTEGER BREAK COMMENTS = 1; ! 'BC'
OWNBYTEINTEGER LEAVE STARS = 1; ! 'LS'
OWNBYTEINTEGER JUSTIFY ALL = 0; ! 'JA'
OWNBYTEINTEGER LABELS RELATIVE = 0; ! 'LR'
OWNBYTEINTEGER SPLIT CONDS = 1; ! 'SC'
OWNBYTEINTEGER DECS RELATIVE = 1; ! 'DR'
OWNBYTEINTEGER SPACE LISTS = 1; ! 'SL'
OWNBYTEINTEGER SPACE EQUALS = 1; ! 'SE'
OWNBYTEINTEGER ISOLATE LOOPS = 1; ! 'IL'
OWNBYTEINTEGER EXTRA MARGIN = 0; ! 'EM'
OWNBYTEINTEGER LEAVE OWNS = 0; ! 'LO'
OWNBYTEINTEGER COMMENTS RELATIVE = 1; ! 'CR'
OWNBYTEINTEGER EXTEND COMMENTS = 1; ! 'EC'
OWNBYTEINTEGER MI = 3; ! MARGIN INCREMENT
OWNBYTEINTEGER LL = 72; ! LINE LENGTH
OWNBYTEINTEGER CT = 40; ! COMMENT TAB
OWNBYTEINTEGER ML = 40; ! MARGIN LIMIT
OWNBYTEINTEGER COMMENT EXTENSION = 5; ! 'CE'
OWNBYTEINTEGER EXT NUM = 2; ! 'XN'
OWNBYTEINTEGER INITIAL MARGIN = 7; ! 'IM'
OWNBYTEINTEGER SECONDARY MARGIN = 3; ! 'SM'
OWNBYTEINTEGER COMMENT LIMIT = 20; ! 'CL'
OWNBYTEINTEGER COMMENT LINE = 120; ! 'LC'
OWNSHORTINTEGER SAFETY FACTOR = 5
OWNINTEGER DELTA MARGIN = 3
OWNINTEGER LINE LENGTH = 70
OWNINTEGER COMMENT TAB = 40
OWNINTEGER LEVEL = 1, MLIMIT = 0, SEC MARGIN = 3
OWNBYTEINTEGER COMMENT FLAG
OWNBYTEINTEGER CMODE, LOOP FLAG
OWNINTEGER LINESIZE, CS, DISP, D, RMARGIN, FIRST DISP
OWNINTEGER SIZE, CSTART, LINE BASE, FULL LINE
EXTERNALROUTINESPEC PROMPT(STRING (63) S)
EXTERNALROUTINESPEC DEFINE(STRING (63) S)
EXTERNALROUTINESPEC SEND(STRING (63) S)
EXTERNALROUTINESPEC LIST(STRING (63) S)
EXTERNALROUTINESPEC DESTROY(STRING (63) S)
EXTERNALROUTINESPEC RENAME(STRING (63) S)
INTEGERFNSPEC PARSE(INTEGER EP)
OWNSTRING (255) INPUT, OUTPUT, OPTION FILE, ST, OPLIST
OWNINTEGER SPT, SAD, S
OWNBYTEINTEGER SPACES, MODE
OWNBYTEINTEGER OK, THIS SEP
CONSTINTEGER LAST TEXT = 51
OWNINTEGER HEADER, SEGS
OWNINTEGERARRAY STRINGS(-100 : -1)
OWNINTEGER COMMENT LENGTH
OWNSHORTINTEGERARRAY REM(1 : 4)
OWNBYTEINTEGERARRAY SYMFILE(0 : 300)
OWNBYTEINTEGERARRAY TLENGTH(-100 : -1)
OWNINTEGERARRAY REC(1 : 100)
OWNBYTEINTEGER STATUS, OPTIONS, LAST SEP, FLAG, PMODE
OWNBYTEINTEGER QUOTES = 0, OWNFLAG = ';'
OWNINTEGER NVAL
REGISTER CURRIN(14)
OWNINTEGER CURROUT, SLENGTH, LIMIT, MARGIN, INBASE, STATSIZE
OWNINTEGER STAT, KEYBASE, TEXTBASE, J, SN, RP, RPLIM, RPINC
OWNINTEGER MAXMARGIN, ENDOFFILE
CONSTINTEGER CCC = X'2025430A'
CONSTINTEGER CONNEKTEP = 1
CONSTINTEGER CREATEEP = 162
CONSTINTEGER READEP = 7
CONSTINTEGER INFOEP = 5
CONSTINTEGER CHANGEEP = 6
ROUTINESPEC SET UP FILES(STRINGNAME S)
ROUTINESPEC CLOSE FILES
ROUTINESPEC SET OPTIONS
DYNAMICROUTINESPEC CHERISH(STRING(63) S)
ROUTINE FDP(INTEGER EP,STRING(17) NAME,INTEGER P1,P2,C
INTEGERNAME FLAG)
SYSTEMROUTINESPEC AGENCY(INTEGER P1,P2)
*OI_4(13),5
AGENCY(1,ADDR(EP))
END
ROUTINE CONTINUE
SHORTROUTINE
ROUTINESPEC ADJUST
INTEGERARRAY HOLD(1 : 4)
INTEGER J, K, L, M, N, Z, LIM, XES
BYTEINTEGERARRAYFORMAT NFM(1 : 4)
BYTEINTEGERARRAYNAME NEST
BYTEINTEGER S, CFLAG
NEST == ARRAY(ADDR(NVAL),NFM)
THIS SEP = NL; LIM = MARGIN+SAFETY FACTOR+SEC MARGIN
Z = SLENGTH+CURROUT
RETURN IF Z < LIMIT OR (Z-SAFETY FACTOR-LIMIT < -4 C
AND REC(RP+1) = 0)
! LEAVE TWO SPACES FOR ' %' IF NESC.
XES = Z-LIMIT; ! EXCESS LINE LENGTH
CYCLE J = 1,1,4; HOLD(J) = NEST(J)+CURROUT-LINE BASE
REPEAT
IF LAST SEP = ';' THEN START
N = CURROUT; QUOTES = 0
UNTIL S = ';' AND QUOTES = 0 CYCLE
N = N-1; S = BYTEINTEGER(N)
QUOTES = QUOTES!!1 IF S = ''''
REPEAT
BYTEINTEGER(N) = NL; LIMIT = N+LINELENGTH
LINE BASE = N
K = CURROUT+80; M = K
CYCLE L = N+3,1,CURROUT
K = K+1; BYTEINTEGER(K) = BYTEINTEGER(L)
REPEAT
CYCLE L = 1,1,MARGIN
N = N+1; BYTEINTEGER(N) = ' '
REPEAT
CYCLE L = M+1,1,K
N = N+1; BYTEINTEGER(N) = BYTEINTEGER(L)
REPEAT
CURROUT = N
LAST SEP = NL
ADJUST
RETURN IF CURROUT+SLENGTH < LIMIT
FINISH
NEST(3) = 0 IF NEST(4) # 0 AND REC(REM(4)-1) >= 4
CFLAG = 0
CYCLE J = 1,1,4
N = NEST(J)
IF N > LIM START
N = N+LINE BASE
CFLAG = 1 AND EXIT IF N < CURROUT
FINISH
REPEAT
IF CFLAG # 0 START
IF NEST(J)-MARGIN-SEC MARGIN-SAFETY FACTOR < XES START
K = J
WHILE K < 4 CYCLE
K = K+1
CFLAG = 0 AND EXIT IF NEST(K) # 0
REPEAT
IF CFLAG = 0 START
L = NEST(K)+LINE BASE
J = K AND N = L C
IF NEST(K) > LIM AND L < CURROUT
FINISH
FINISH
J = 3 AND N = NEST(3)+LINE BASE C
IF J = 4 AND REM(3) = REM(4)-1
LIM = NEST(J)+SAFETY FACTOR+SEC MARGIN
K = CURROUT+80; M = K
CYCLE L = N+1,1,CURROUT
K = K+1; BYTEINTEGER(K) = BYTEINTEGER(L)
REPEAT
*L_1,N
*MVC_1(4,1),CCC
*LA_1,4(1)
*ST_1,CURROUT
*ST_1,LINEBASE
CYCLE J = 1,1,MARGIN+SEC MARGIN
CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = ' '
REPEAT
M = M+1 IF BYTEINTEGER(M+1) = ' '
IF BYTEINTEGER(M+1) # '%' START
CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = '%'
FINISH
CYCLE L = M+1,1,K
CURROUT = CURROUT+1
BYTEINTEGER(CURROUT) = BYTEINTEGER(L)
REPEAT
!?? ADJUST
FINISH ELSE START
LIM = CURROUT-LINEBASE+SAFETY FACTOR
*L_1,CURROUT
*MVC_1(4,1),CCC
*LA_1,4(1)
*ST_1,CURROUT
*ST_1,LINE BASE
CYCLE J = 1,1,MARGIN+SEC MARGIN
CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = ' '
REPEAT
PMODE = 128; ! NO LONGER IN RANGE OF '%'
FINISH
LIMIT = LINEBASE+LINE LENGTH
STATSIZE = STATSIZE-LINELENGTH+MARGIN
RPLIM = RPLIM+RPINC IF STATSIZE+MARGIN >= LINE LENGTH
NVAL = 0
ROUTINE ADJUST
CYCLE J = 1,1,4
IF NEST(J) <= LIM THEN NEST(J) = 0 C
ELSE NEST(J) = HOLD(J)-CURROUT+LINE BASE
REPEAT
END
END
ROUTINE BREAK
SHORTROUTINE
CURROUT = CURROUT-2 UNLESS BYTEINTEGER(CURROUT) = ';'
BYTEINTEGER(CURROUT) = NL
SIZE = 0; LINE BASE = CURROUT
LIMIT = LINE BASE+LINE SIZE
NVAL = 0
END
EXTERNALROUTINE SOAP(STRING (128) FILES)
SHORTROUTINE
OWNINTEGER MOVEX = X'D2002001', MOVEY = X'10010000'
ROUTINESPEC PERCENT
ROUTINESPEC SPACE
INTEGERNAME MID MARGIN
INTEGER N, P, K, M, Z
BYTEINTEGERARRAYFORMAT NFM(1 : 4)
BYTEINTEGERARRAYNAME NEST
PRINTTEXT 'SOAP'; PRINTCH(7); NEWLINE
NEST == ARRAY(ADDR(NVAL),NFM)
SET UP FILES(FILES); RETURN IF OK = 0
SET OPTIONS; RETURN IF OK = 0
MID MARGIN == MARGIN
MID MARGIN == RMARGIN IF COMMENTS RELATIVE = 0
!* 32 16 8 4 2 1
!* STATUS: SPECIAL COMMENT : COMMENT : OWN : END : DOWN : UP
TOP: ! HEAD OF MAIN LOOP
CYCLE
NVAL = 0
LOOP FLAG = 0
RP = 0; SPT = 0; MODE = 0; STATUS = 0
SAD = TEXTBASE
LIMIT = CURROUT+LINELENGTH IF LAST SEP # ';'
INBASE = CURRIN
IF PARSE(0) # 0 THEN START
! SYNTAX ??
OWNS: J = CURRIN; QUOTES = 0; K = 0
UNTIL (S = NL OR S = ';') AND (QUOTES = 0 C
OR K > 300) CYCLE
K = K+1
J = J+1; S = BYTEINTEGER(J)
QUOTES = QUOTES!!1 IF S = ''''
REPEAT
SLENGTH = J-CURRIN
IF CURROUT+SLENGTH > LIMIT AND LAST SEP = ';' C
THEN START
BREAK
STAT = CURROUT+MARGIN
CYCLE J = 1,1,MARGIN
CURROUT = CURROUT+1
BYTEINTEGER(CURROUT) = ' '
REPEAT
FINISH
IF OWNFLAG = 0 THEN START
OWNFLAG = ';'
IF CURROUT+SLENGTH+SAFETY FACTOR > LIMIT C
THEN START
*L_1,CURROUT
*MVC_1(4,1),CCC; ! PUSH IN CONTINUATION
*LA_1,4(1)
*ST_1,CURROUT
*ST_1,LINE BASE
FINISH
FINISH
CYCLE J = 1,1,SLENGTH
CURRIN = CURRIN+1; CURROUT = CURROUT+1
BYTEINTEGER(CURROUT) = BYTEINTEGER(CURRIN)
REPEAT
LAST SEP = BYTEINTEGER(CURRIN)
IF LAST SEP = ';' THEN START
BYTEINTEGER(CURROUT+1) = ' '
BYTEINTEGER(CURROUT+2) = ' '
CURROUT = CURROUT+2
FINISH ELSE LINE BASE = CURROUT
FINISH ELSE START
PMODE = 128
STATSIZE = CURRIN-INBASE
IF STATSIZE+MARGIN > LINE LENGTH START
RPINC = RP//(STATSIZE//(LINE LENGTH-MARGIN))
RPLIM = RPINC
FINISH ELSE RPLIM = RP
IF STATUS&11 # 0 AND LAST SEP = ';' THEN START
LAST SEP = NL
BREAK
FINISH
IF STATUS&136 # 0 THEN START
! BLANK LINE OR BLOCK
IF (LEAVE BLANKS # 0 AND THIS SEP # ';') C
OR (STATUS&128 # 0 AND SEP BLOCKS # 0) C
THEN START
NULL:
CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = NL
LINE BASE = CURROUT
FINISH
-> TOP IF STATUS&8 # 0 AND RP <= 1
! IN CASE OF LONELY LABELS
FINISH
RP = 0
IF LOOP FLAG # 0 AND STATUS&1 # 0 C
AND BYTEINTEGER(CURROUT-1) # NL START
CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = NL
LINE BASE = CURROUT
LIMIT = LIMIT+1
FINISH
IF STATUS&2 # 0 THEN START
! DOWN
STATUS = STATUS!64 C
IF EXTRA MARGIN # 0 AND STATUS&4 # 0
LEVEL = LEVEL>>1
LEVEL = 1 IF LEVEL = 0
MARGIN = MARGIN-DELTA MARGIN IF MLIMIT&1 = 0
MLIMIT = MLIMIT>>1
MARGIN = 0 IF MARGIN < 0
FINISH
STAT = CURROUT+MARGIN IF LAST SEP # ';'
WHILE REC(RP+1) = 100 CYCLE
! DEAL WITH LABELS
RP = RP+1
IF LAST SEP = ';' OR LAST SEP = ':' THEN START
N = -2; N = 1 IF LAST SEP = ':'
CURROUT = CURROUT+N; BYTEINTEGER(CURROUT) = NL
LINE BASE = CURROUT
LIMIT = CURROUT+LINELENGTH
STAT = CURROUT+MARGIN
LAST SEP = NL
FINISH
IF LABELS RELATIVE # 0 AND LAST SEP # ':' C
THEN START
N = LEVEL; M = MARGIN
M = M+FIRST DISP C
IF EXTRA MARGIN # 0 AND LEVEL = 1
CYCLE
M = M-DELTA MARGIN
EXIT IF N&1 # 0
N = N>>1
REPEAT
WHILE M > 0 CYCLE
M = M-1
CURROUT = CURROUT+1
BYTEINTEGER(CURROUT) = ' '
REPEAT
FINISH
CYCLE
RP = RP+1; N = REC(RP); EXIT IF N = 0
IF N < 0 THEN SN = STRINGS(N) C
ELSE SN = KEYWORD(N)+KEYBASE
CYCLE J = SN+1,1,SN+BYTEINTEGER(SN)
CURROUT = CURROUT+1
BYTEINTEGER(CURROUT) = BYTEINTEGER(J)
REPEAT
REPEAT
IF CURROUT > STAT AND STATUS&16 = 0 THEN START
CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = NL
LINE BASE = CURROUT
LIMIT = CURROUT+LINELENGTH
STAT = CURROUT+MARGIN
FINISH
LAST SEP = ':'
REPEAT
RP = 0 AND -> NULL IF STATUS&8 # 0
! NOW DEAL WITH COMMENTS
IF STATUS&16 # 0 THEN START
RP = RP+1; DISP = REC(RP)
! STARTING DISP OF INPUT
! COMMENT
D = 0; CMODE = 0
J = CURRIN; ! FIND THE END OF THE COMMENT
J = J+1 WHILE BYTEINTEGER(J) # NL C
AND BYTEINTEGER(J) # ';'
CS = J-CURRIN; ! COMMENT SIZE
IF COMMENT FLAG = 0 C
THEN CSTART = COMMENT TAB ELSE START
IF COMMENTS NORMAL # 0 START
CMODE = 1; CSTART = MARGIN
FINISH ELSE START
IF LAST SEP = ';' C
THEN CSTART = COMMENT TAB ELSE START
IF DISP = 0 THEN CSTART = 0 ELSE START
IF DISP <= MID MARGIN C
AND STATUS&32 = 0 C
THEN CSTART = MARGIN C
ELSE CSTART = COMMENT TAB
FINISH
FINISH
FINISH
FINISH
CSTART = 0 IF STATUS&32 # 0 AND LEAVE STARS # 0
SIZE = CURROUT-LINE BASE
IF LAST SEP = ';' START
IF BYTEINTEGER(CURROUT) = NL START
! COMMENT AFTER REPEAT+NL
LOOP FLAG = 1
LINE BASE = LINE BASE-1 C
UNTIL BYTEINTEGER(LINE BASE) = NL
SIZE = CURROUT-LINE BASE
FINISH
CURROUT = CURROUT-2; SIZE = SIZE-2
! TO REMOVE SPACES AFTER SEMI'S
IF EXTEND COMMENTS # 0 AND CSTART < SIZE START
P = CSTART; ! REMEMBER IT JUST IN CASE
N = EXT NUM; ! NUMBER OF EXTENSION TRIES
CYCLE
EXIT IF N <= 0
CSTART = CSTART+COMMENT EXTENSION
EXIT IF CSTART >= SIZE
N = N-1
REPEAT
CSTART = P IF N <= 0 C
OR CS+CSTART > COMMENT LINE
! RESTORE IT IF TOO LONG
FINISH
IF CSTART < SIZE START
IF CMODE # 0 THEN CSTART = 0 ELSE BREAK
FINISH ELSE START
D = COMMENT LINE-CSTART-CS
IF D < 0 AND BREAK COMMENTS = 0 START
CSTART = LINE SIZE-CS
BREAK
D = 0
FINISH
FINISH
FINISH ELSE START
D = COMMENT LINE-CSTART-CS
IF D < 0 AND BREAKCOMMENTS = 0 THEN START
CSTART = COMMENT LINE-CS
D = 0
FINISH
FINISH
CYCLE
N = CSTART-SIZE
WHILE N > 0 CYCLE
N = N-1; CURROUT = CURROUT+1
BYTEINTEGER(CURROUT) = ' '
REPEAT
CURROUT = CURROUT+1
BYTEINTEGER(CURROUT) = '!'
CURROUT = CURROUT+1 C
AND BYTEINTEGER(CURROUT) = '*' C
IF STATUS&32 # 0
P = J
IF D < 0 START
P = J+D
P = P-1 WHILE BYTEINTEGER(P) # ' ' C
AND BYTEINTEGER(P) # ',' C
AND BYTEINTEGER(P) # '.' AND P > CURRIN
P = P-1
P = J+D IF P = CURRIN
FINISH
CYCLE K = CURRIN+1,1,P
CURROUT = CURROUT+1
BYTEINTEGER(CURROUT) = BYTEINTEGER(K)
REPEAT
CURRIN = P
EXIT IF D >= 0
CURROUT = CURROUT+1
BYTEINTEGER(CURROUT) = NL
SIZE = 0; D = LINE LENGTH-MARGIN+D
REPEAT
BYTEINTEGER(CURROUT) = NL
IF LOOP FLAG # 0 START
LOOP FLAG = 0
CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = NL
FINISH
SIZE = 0; LINE BASE = CURROUT; LAST SEP = NL
! END OF COMMENT HANDLING
FINISH ELSE START
N = 0
IF STATUS&64 # 0 START
N = DELTA MARGIN
N = MARGIN IF EXTRA MARGIN # 0
FINISH
STAT = STAT-N
CURROUT = CURROUT+1 C
AND BYTEINTEGER(CURROUT) = ' ' C
WHILE CURROUT < STAT
LIMIT = CURROUT+LINELENGTH-MARGIN+N C
IF LAST SEP # ';'
CYCLE
RP = RP+1; N = REC(RP); EXIT IF N = 0
IF N > 0 THEN START
SN = KEYWORD(N)+KEYBASE
FLAG = KFLAGS(N)
Z = SFLAGS(N)
SLENGTH = BYTEINTEGER(SN)
FINISH ELSE START
SN = STRINGS(N)
FLAG = 0; Z = 0
SLENGTH = TLENGTH(N)
FINISH
IF RP >= RPLIM C
OR (SLENGTH+CURROUT > LIMIT C
AND N <= LAST TEXT) THEN CONTINUE
IF Z # 0 START
NEST(Z) = CURROUT-LINE BASE
REM(Z) = RP
FINISH
SPACE IF FLAG&OPTIONS&15 # 0 C
OR (PMODE!!FLAG)&128 = 0
PERCENT IF FLAG&PMODE # 0
!* %CYCLE J=SN+1, 1, SN+BYTEINTEGER(SN)
!* CURROUT=CURROUT+1
!* BYTEINTEGER(CURROUT)=BYTEINTEGER(J)
!* %REPEAT
*L_1,SN
*L_2,CURROUT
*SLR_3,3
*IC_3,0(1)
*EX_3,MOVEX
*AR_2,3
*ST_2,CURROUT
SPACE IF FLAG&OPTIONS&120 # 0
PMODE = 128 UNLESS 0 < N <= LAST TEXT
REPEAT
-> OWNS IF OWNFLAG = 0
CURROUT = CURROUT+1
BYTEINTEGER(CURROUT) = THIS SEP
LAST SEP = THIS SEP
IF LOOP FLAG # 0 AND STATUS&2 # 0 START
CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = NL
FINISH
IF STATUS&1 # 0 THEN START
! UP
LEVEL = LEVEL<<1
LEVEL = LEVEL!1 IF STATUS&128 # 0
MLIMIT = MLIMIT<<1
MLIMIT = MLIMIT!1 C
IF MARGIN >= MAX MARGIN OR ( C
INDENT BLOCKS = 0 AND STATUS&128 # 0)
IF MARGIN = 0 AND EXTRA MARGIN # 0 C
THEN MARGIN = INITIAL MARGIN ELSE START
MARGIN = MARGIN+DELTA MARGIN IF MLIMIT&1 = 0
FINISH
FINISH
IF LAST SEP = ';' THEN START
BYTEINTEGER(CURROUT+1) = ' '
CURROUT = CURROUT+2
BYTEINTEGER(CURROUT) = ' '
FINISH ELSE LINE BASE = CURROUT
EXIT IF CURRIN >= ENDOFFILE OR STATUS&7 = 7
FINISH
FINISH
REPEAT
CLOSE FILES
RETURN
ROUTINE SPACE
IF ' ' # BYTEINTEGER(CURROUT) # NL C
AND BYTEINTEGER(CURROUT) # '(' THEN START
CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = ' '
PMODE = 128
FINISH
END
ROUTINE PERCENT
IF PMODE # 0 THEN START
IF ' ' # BYTEINTEGER(CURROUT) # NL C
AND BYTEINTEGER(CURROUT) # '(' THEN START
CURROUT = CURROUT+1; BYTEINTEGER(CURROUT) = ' '
FINISH
CURROUT = CURROUT+1
BYTEINTEGER(CURROUT) = '%'
PMODE = 0
FINISH
END
END
ROUTINE CONNEKT(STRING (17) FILE, INTEGERNAME MODE, FLAG)
INTEGER J
J = 0
FDP(CONNEKTEP,FILE,MODE,ADDR(J),FLAG)
MODE = J
FLAG = 0 IF FLAG = 5
END
INTEGERFN PARSE(INTEGER ENTRY)
SHORTROUTINE
INTEGER SS, SP, TRP, TPT, L
BYTEINTEGER MODES
INTEGERFN PUT
SPT = SPT-1
RP = RP+1
REC(RP) = SPT
TLENGTH(SPT) = SLENGTH
STRINGS(SPT) = SAD
STRING(SAD) = ST
SAD = SAD+1+BYTEINTEGER(ADDR(ST))
RESULT = SPT
END
ROUTINE SYM
CYCLE
CURRIN = CURRIN+1; S = BYTEINTEGER(CURRIN)
MODE = 0 UNLESS 'A' <= S <= 'Z'
IF S = '%' THEN MODE = 32 ELSE START
IF S # ' ' THEN START
S = S+MODE
RETURN IF S # 'C'+32 C
OR BYTEINTEGER(CURRIN+1) # NL
CURRIN = CURRIN+1
MODE = 0
FINISH
SPACES = PACK NAMES
FINISH
REPEAT
END
INTEGERFN CONSTANT
INTEGER T, LIM
INTEGER CS
SLENGTH = 0
ST = ''
SYM
CS = CURRIN AND ST = ST.TOSTRING(S) AND SYM C
WHILE '0' <= S <= '9' OR S = '.' OR S = '@'
CURRIN = CS AND RESULT = PUT IF ST # ''
IF S = 'M' OR S = 'X' OR S = 'B' THEN START
ST = TOSTRING(S)
T = CURRIN
SYM
CURRIN = T AND RESULT = 0 IF S # ''''
FINISH
LIM = CURRIN+255
WHILE S = '''' CYCLE
UNTIL S = '''' OR CURRIN > LIM CYCLE
SLENGTH = BYTEINTEGER(ADDR(ST)) C
IF S = NL AND SLENGTH = 0
ST = ST.TOSTRING(S)
CURRIN = CURRIN+1
S = BYTEINTEGER(CURRIN)
REPEAT
ST = ST.''''
CS = CURRIN
SYM
REPEAT
SLENGTH = BYTEINTEGER(ADDR(ST)) IF SLENGTH = 0
CURRIN = CS AND RESULT = PUT IF ST # ''
RESULT = 0
END
INTEGERFN NAME
INTEGER Z
SYM
RESULT = 0 UNLESS 'A' <= S <= 'Z'
ST = ''
CYCLE
SPACES = 1
ST = ST.TOSTRING(S)
Z = CURRIN
SYM
SLENGTH = BYTEINTEGER(ADDR(ST)) AND CURRIN = Z C
AND RESULT = PUT C
UNLESS 'A' <= S <= 'Z' OR '0' <= S <= '9'
ST = ST.' ' IF SPACES = 0
REPEAT
END
SWITCH BIP(0 : 15)
!
TRP = RP
TPT = CURRIN
MODES = MODE
FAILURE:
RP = TRP
CURRIN = TPT
MODE = MODES
ENTRY = ENTRY+1
SP = MAIN(ENTRY)
RESULT = 1 IF SP = 0
SUCCESS:
SP = SP+1
SS = SUB(SP)
RESULT = 0 IF S S = 0
-> BIP(SS>>12&15)
BIP(1): ! SUB-PHRASE
-> SUCCESS IF PARSE(SS&X'FFF') = 0
-> FAILURE
BIP(0): ! LITERAL
SS = SS&X'FFF'
L = LITERAL(SS); ! LENGTH
CYCLE SS = SS+1,1,SS+L
SYM
-> FAILURE UNLESS S = LITERAL(SS)
REPEAT
-> SUCCESS
BIP(15): ! (NAME)
-> SUCCESS IF NAME # 0
-> FAILURE
BIP(3): ! CONSTANT
-> SUCCESS IF CONSTANT # 0
-> FAILURE
BIP(4): ! (*LOOP)
LOOP FLAG = 1 IF ISOLATE LOOPS # 0
-> SUCCESS
BIP(5): ! (UP)
STATUS = STATUS!1; -> SUCCESS
BIP(6): ! (DOWN)
STATUS = STATUS!2; -> SUCCESS
BIP(7): ! (END)
STATUS = STATUS!4; -> SUCCESS
BIP(8): ! (OWN)
-> FAILURE IF LEAVE OWNS # 0 C
AND BYTEINTEGER(CURRIN) # '*'
! MACHINE CODE
OWN FLAG = 0
RP = RP+1; REC(RP) = 0
! TO FIDDLE THE END OF STAT.
THIS SEP = NL
-> SUCCESS
BIP(10): ! (SPECIAL COMMENT)
INBASE = INBASE+1; ! TO SET DISP PROPERLY
STATUS = STATUS!32
BIP(9): ! (COMMENT)
STATUS = STATUS!16
RP = RP+1; REC(RP) = CURRIN-INBASE-1
-> SUCCESS
BIP(11): ! (*DEC)
STATUS = STATUS!64 IF DECS RELATIVE # 0; -> SUCCESS
BIP(12): ! (*BLOCK)
STATUS = STATUS!64 IF EXTRA MARGIN # 0
STATUS = STATUS!128; -> SUCCESS
BIP(13): ! (*NULL)
STATUS = STATUS!8; -> SUCCESS
BIP(14): ! (S)
SYM
-> FAILURE UNLESS S = NL OR S = ';'
THIS SEP = S
THISSEP = NL IF SPLIT STATS # 0
RP = RP+1
REC(RP) = 0
-> SUCCESS
BIP(2): ! <>
RP = RP+1
REC(RP) = SS&X'FFF'
-> SUCCESS
END
ROUTINE CREATE(STRING (8) FILE, INTEGERNAME SIZE, FLAG)
FDP(CREATEEP,FILE,SIZE,0,FLAG)
SIZE = 3
IF FLAG = 0 OR FLAG = 3 THEN CONNEKT(FILE,SIZE,FLAG)
END
ROUTINE COMPRESS(STRING (8) FILE)
INTEGER P, F, S, W, X, Y, Z
FDP(READEP,FILE,0,ADDR(P),F)
IF F # 0 THEN RETURN
FDP(INFOEP,FILE,ADDR(W),0,F)
S = INTEGER(P); ! SIZE OF FILE
S = (S+4095)>>12
FDP(CHANGEEP,FILE,S-X,ADDR(S),F)
END
ROUTINE SET UP FILES(STRINGNAME S)
SHORTROUTINE
INTEGER FLAG, SIZE
OK = 0
INPUT = ''
OUTPUT = ''
OPTION FILE = ''
INPUT = S UNLESS S -> INPUT.('/').OUTPUT
OPTION FILE = '' UNLESS INPUT -> INPUT.(',').OPTION FILE
OUTPUT = INPUT IF OUTPUT = ''
SIZE = 0
FDP(7, INPUT, 0, ADDR(SIZE), FLAG)
CURRIN = SIZE
IF FLAG # 0 THEN START
PRINTSTRING('CANNOT CONNECT '.INPUT); WRITE(FLAG,1)
NEWLINE
RETURN
FINISH
IF INTEGER(CURRIN+12) # 0 THEN START
PRINTSTRING(INPUT.' IS NOT A SOURCE FILE
')
RETURN
FINISH
SIZE = INTEGER(CURRIN)
IF SIZE < 10 THEN START
PRINTSTRING(INPUT.' IS A NULL FILE
')
RETURN
FINISH
ENDOFFILE = CURRIN+SIZE
ENDOFFILE = ENDOFFILE-1 WHILE BYTEINTEGER(ENDOFFILE) # NL
CURROUT = ((SIZE*6)+4095)>>12;! I HOPE IT'S BIG ENOUGH
SEGS = (CURROUT+15)>>4
CREATE('SP#WORK',CURROUT,FLAG)
IF FLAG # 0 THEN START
PRINTTEXT 'CANNOT CREATE WORK FILE'; WRITE(FLAG,1)
NEWLINE
RETURN
FINISH
HEADER = CURROUT
CURROUT = CURROUT+16
BYTEINTEGER(CURROUT) = NL
CURRIN = CURRIN+15
INTEGER(HEADER) = 1<<16; ! JUST FOR TESTING
INTEGER(HEADER+4) = 16
INTEGER(HEADER+8) = SEGS
INTEGER(HEADER+12) = 0
OK = 1
END
ROUTINE CLOSE FILES
ROUTINE NEWGENS
RECORDFORMAT RFM(INTEGER X, Y, Z, REPLY)
RECORDFORMAT NFM( C
SHORTINTEGER DSNO, DACT, SSNO, SACT, X1, X2, FLAG, C
STRING (8) OLD FILE, NEW FILE, LONGREAL DUMMY)
RECORD P(NFM)
RECORDNAME R(RFM)
INTEGER FLAG
FDP(2,'SP#WORK',0,0,FLAG); ! DISCON. WORK FILE
R == P; ! FOR REPLIES
CYCLE
P = 0; ! CLEAR THE RECORD
P_DSNO = 164
P_OLD FILE = 'SP#WORK'; ! OLF FILE NAME
P_NEW FILE = OUTPUT; ! NEW FILE NAME
! SVC(P); ! CALL THE SERVICE
**1,@P;! ADDRESS OF P TO R1
*LD_0,0(1)
*LD_2,8(1)
*LD_4,16(1)
*LD_6,24(1)
*SVC_254
**1,@P
*STD_0,0(1)
*STD_2,8(1)
*STD_4,16(1)
*STD_6,24(1)
!
EXIT UNLESS R_REPLY = 6 AND FLAG = 0; ! FILE2 STILL CONNECTED
FDP(2,OUTPUT,0,0,FLAG)
FLAG = 1
REPEAT
IF R_REPLY = 5 START; ! FILE2 DOES NOT EXIST
R_REPLY = 0
RENAME('SP#WORK,'.OUTPUT)
FINISH
IF R_REPLY # 0 START
PRINTSTRING('RENAME SP#WORK FAILS ')
WRITE(R_REPLY,1)
NEWLINE
FINISH ELSE CHERISH(OUTPUT); ! CHERISH OUTPUT FILE
FDP(2,INPUT,0,0,FLAG); ! DISCONNECT INPUT FILE
END
BYTEINTEGER(CURROUT) = NL
INTEGER(HEADER) = CURROUT-HEADER+1
INTEGER(HEADER+4) = 16
INTEGER(HEADER+8) = SEGS
INTEGER(HEADER+12) = 0
IF CHARNO(OUTPUT,1) = '.' THEN START
IF OUTPUT = '.TT' THEN START
LIST('SP#WORK,.TT')
DESTROY('SP#WORK')
FINISH ELSE SEND('SP#WORK,'.OUTPUT)
FINISH ELSE START
COMPRESS('SP#WORK')
NEWGENS
FINISH
PRINTCH(7); NEWLINE
END
ROUTINE SET OPTIONS
SHORTROUTINE
STRING (255) S, T
INTEGER J
BYTEINTEGER OPT FLAG
BYTEINTEGERARRAYFORMAT FM(1 : 31)
BYTEINTEGERARRAYNAME WORD
ROUTINE LINE(STRINGNAME S)
INTEGER J
RETURN IF OPT FLAG = 0
S = ''
UNTIL S # '' CYCLE
CYCLE
READSYMBOL(J) UNTIL J # ' '
EXIT IF J = NL
S = S.TOSTRING(J)
REPEAT
REPEAT
END
ROUTINE SET(STRINGNAME S)
STRING (255) N, OPT
INTEGER V, K, C, NUM
BYTEINTEGER NOT
CONSTSTRING (2) ARRAY PARAM(1 : 31) = C
'IB', 'LB', 'SB', 'TB', 'SK', 'PN', 'SS', 'CN', 'BC',
'LS','JA', 'LR', 'SC',
'DR', 'SL', 'SE', 'IL', 'EM',
'LO', 'CR', 'EC',
'MI', 'LL', 'CT', 'ML',
'CE', 'XN', 'IM', 'SM',
'CL', 'LC'
OWNINTEGER PARAMS = 31, BOOLS = 21
OPT = S
NOT = 1; NUM = 0
IF S -> S.('=').N THEN START
NUM = -1; V = 0; J = ADDR(N)
CYCLE J = J+1,1,J+LENGTH(N)
C = BYTEINTEGER(J)-'0'
UNLESS 0 <= C <= 9 THEN START
PRINTSTRING(N.' ?
')
RETURN
FINISH
V = V*10+C
REPEAT
IF V > 255 THEN START
PRINTSTRING(N.' ?
')
RETURN
FINISH
FINISH
NOT = 0 IF NUM = 0 AND S -> ('¬').S
CYCLE J = 1,1,PARAMS
IF PARAM(J) = S THEN START
IF (BOOLS-J)!!NUM < 0 THEN START
PRINTSTRING(S.'= ?
')
RETURN
FINISH
K = NOT; K = V IF NUM < 0
WORD(J) = K
OPLIST = OPLIST.' '.OPT
RETURN
FINISH
REPEAT
PRINTSTRING(S.' ?
')
END
OPLIST = '
!! OPTIONS:'
WORD == ARRAY(ADDR(ISOLATE BRACKETS),FM)
OK = 1
IF OPTIONFILE # '' THEN START
OK = 0
OPT FLAG = 0
IF OPTIONFILE -> ('[').S THEN START
OPT FLAG = 0 IF S -> S.(']')
S = S.',*'
FINISH ELSE START
OPT FLAG = 1
PROMPT('OPTIONS:')
DEFINE('ST76,'.OPTION FILE)
SELECTINPUT(76)
FINISH
CYCLE
LINE(S)
SET(T) WHILE S -> T.(',').S
EXIT IF S = '*'
SET(S)
REPEAT
IF CHARNO(OUTPUT,1) = '.' START
! SHOW OPTIONS
STRING(CURROUT) = OPLIST.'
'
BYTEINTEGER(CURROUT) = NL
CURROUT = CURROUT+LENGTH(OPLIST)+2
FINISH
FINISH
DELTA MARGIN = MI
LINE LENGTH = LL
COMMENT TAB = CT
MAXMARGIN = ML
SEC MARGIN = SECONDARY MARGIN
UNLESS 40 < LINELENGTH < 133 THEN START
PRINTTEXT 'INVALID LINE LENGTH
'
RETURN
FINISH
UNLESS 0 < COMMENT TAB < LINE LENGTH-20 THEN START
PRINTTEXT 'INVALID COMMENT MARGIN
'
RETURN
FINISH
UNLESS MAX MARGIN < LINE LENGTH-20 THEN START
PRINTTEXT 'INVALID MAX MARGIN
'
RETURN
FINISH
UNLESS DELTA MARGIN <= MAX MARGIN<<1 START
PRINTTEXT 'INVALID MARGIN INCREMENT
'
RETURN
FINISH
IF SEC MARGIN > DELTA MARGIN<<1+SAFETY FACTOR START
PRINTTEXT 'INVALID SECONDARY MARGIN
'
RETURN
FINISH
IF INITIAL MARGIN > 30 THEN START
PRINTTEXT 'INVALID INITIAL MARGIN
'
RETURN
FINISH
MARGIN = 1 IF DELTA MARGIN = 0 AND SEC MARGIN = 0 C
AND INITIAL MARGIN = 0
MARGIN = INITIAL MARGIN IF EXTRA MARGIN # 0
SPLIT CONDS = 1 IF SPLIT KEYWORDS # 0
COMMENT LENGTH = LINE LENGTH-COMMENT TAB
TEXTBASE = ADDR(SYMFILE(0))
KEYBASE = ADDR(KEYSYMS(1))
RMARGIN = COMMENT LIMIT
FULL LINE = LINE LENGTH
LINE LENGTH = LINE LENGTH-SAFETY FACTOR
OPTIONS = 17*SPLIT KEYWORDS+34*SPLIT CONDS+SPACE LISTS<<6 C
+ISOLATE BRACKETS<<2+SPACE EQUALS<<3+128
LINE BASE = CURROUT; SIZE = 0
COMMENT FLAG = JUSTIFY ALL<<1!COMMENTSNORMAL
COMMENT FLAG = COMMENT FLAG!!B'010'
FIRST DISP = DELTA MARGIN-INITIAL MARGIN
COMMENT LINE = FULL LINE IF COMMENT LINE = 0
OK = 1
END
ENDOFFILE