%EXTERNALROUTINE CHECKINNER(%INTEGER FSTART,FSIZE %INTEGERNAME PARM)
%EXTERNALLONGREALFNSPEC CPUTIME
%LONGREAL TIME1,TIME2
!
!DECLARATION CODES
%CONSTINTEGER STRINGBIT=X'80', REALBITS=X'30', INTBIT=X'40'
%CONSTINTEGER NUMBITS=X'70'
%CONSTINTEGER APPMASK=X'FF00'
%CONSTINTEGER EXP=1, FN=2
%CONSTINTEGER RECFORMAT=4, ROUTINE=6
%CONSTINTEGER REF=8, VAR=9, MAP=10
%CONSTINTEGER LAB=12, JUMPLAB=13
%CONSTINTEGER SWITCH=X'10C'
%CONSTINTEGER IMP1MODES=B'01000011111111000000000000000000'
%CONSTINTEGER IMPMODES =B'01000011111100000000000000000000'
%CONSTINTEGER DESTMODES=B'00000000111100000000000000000000'
%CONSTINTEGER ADRMODES =B'01000000111100000000000000000000'
%CONSTINTEGER EXPMODES =B'11110000111100000000000000000000'
%CONSTINTEGER FMATMODES=B'00001000000000000000000000000000'
!SYMBOL INIT CODES
! USED EXPLICITLY
! SPACE=0, DIGIT:ISO, LETTER:ISO, QUOTE=127
! PC=128, PCLET OR PUNCT: 128 + KEYDICT INDEX
! KEYDICT INDEX >= PUNCTMIN FOR PUNCT
! KEYDICT INDEX >= SKIP1MIN FOR ! * SEMICOLON NL
%CONSTINTEGER NLCODE=127; !MASKED FROM 255 ACTUAL
!ATOM CODES
%CONSTINTEGER IDENT=1, CONST=2, LB=11, COMMA=10, RB=12
%CONSTINTEGER TERMINATOR=13, JUMP=15
%CONSTINTEGER OP3=6, START=53, CYCLE=54
!VERTICAL BAR
%CONSTINTEGER MARKER=124
%OWNINTEGER STATS=0, ATOMS=-54, IDENTIFIERS=-54, NUMBERS=0, LOOPS=0
%OWNINTEGER LOOKS=1, TIMES=1
%INTEGER I,J
%INTEGER LINEBASE; !BASE FOR SOURCE LINE (POINTER)
%INTEGER FPOS; !CURRENT POSITION IN SOURCE (POINTER)
%INTEGER FPOS1; !START OF CURRENT ATOM (POINTER)
%INTEGER PRINTPOS; !'LINE-ALREADY-PRINTED' INDIC
%INTEGER LINE; !CURRENT LINE NUMBER
%INTEGER NEXTLINE
%INTEGER FMAX; !LAST BYTE IN SOURCE (POINTER)
%INTEGER FAULTNUM; !FAULT NUMBER
%INTEGER FAULTPOS; !FAULTY ATOM POSITION (POINTER)
%INTEGER SYMCODE; !SYMBOL CODE FOR CURRENT SYMBOL
%INTEGER SKIPMIN; !=SKIP1MIN OR NLCODE
!%INTEGER GG; !=GRAM(G)
%INTEGER CLASS; !GRAMMAR CLASS
%INTEGER G; !INDEX TO GRAM
%INTEGER ATOM; !ATOM CODE FOR CURRENT ATOM
%INTEGER ATOMTYPE; !TYPE FOR CURRENT ATOM
%INTEGER ATOMVAL; !'VALUE' FOR CURRENT ATOM
%INTEGER DECLTYPE; !DECLARATION TYPE
%INTEGER MODES; !BIT VECTOR FOR PERMISSIBLE IDENT MODES
%INTEGER DIMCOUNT; !DIMENSION COUNT
%INTEGER CONSTCOUNT; !CONSTANT COUNT (DOWN)
%INTEGER STRINGSIZE
%INTEGER PRECISION
%INTEGER LASTTYPE,LASTVAL
%INTEGER TYPE,VAL
%INTEGER NP; !NEST POINTER (INDEX TO NTYPE,NVAL)
%INTEGERARRAY NTYPE,NVAL({1}0:50); !NEST
%INTEGER LINKMAX; !GRAMMAR STACK MAX (INDEX TO LINK)
%INTEGERARRAY LINK({1}0:20); !GRAMMAR CONTROL STACK
%RECORDFORMAT BLOCKINF(%INTEGER STACK,LOCAL,BTYPE)
%INTEGER LEVEL; !CURRENT BLOCK LEVEL (MAIN=1)
%RECORD C(BLOCKINF); !INFO FOR CURRENT BLOCK
%RECORDARRAY HOLD({1}0:12) (BLOCKINF); !INFO FOR GLOBAL BLOCKS
%INTEGERARRAY INDEX(0:255); !HASH INDEX TO IDENT DICT
%INTEGERNAME HEAD; !HEAD OF IDENT SEARCH LIST
%INTEGER DPOS; !DICT SEARCH POSITION (POINTER)
%INTEGER DLIM; !DICT LIMIT (POINTER)
%INTEGER NEWDLIM
%INTEGER DBOUND; !DICT UPPER LIMIT (POINTER)
%INTEGER IDENTS; !POS OF FIRST IDENT IN DECL LIST (POINTER)
%INTEGER RECIDENTS; !POS OF FIRST IDENT IN RECORD LIST (POINTER)
%INTEGER PIDENTPOS; !POS OF PROCEDURE IDENT (POINTER)
%INTEGER FIDENTPOS; !POS OF FORMAT IDENT (POINTER)
%INTEGER EXTIND; !SET BY %EXTERNAL
%INTEGER CONDIND; !FOR START,CYCLE
%INTEGER PARMAX; !CURRENT MAX IN PARTYPE
%INTEGER ADGRAM0, LINK1; !PRE-COMPUTED GRAMMAR VALUES
%INTEGER APPCONT
%OWNINTEGERARRAY PARTYPE(0:255) = 0,
X'00000069', X'01000069', X'02000069', X'03000069',
X'04000069', X'05000069', X'00000029', X'01000029',
X'00000089', X'00000088', X'000000F8', X'02000029',
X'07000029', X'01000088', X'02000088', 0(236),
X'FD000069', X'FE0001F8', X'00000000', X'FF000069'
%INTEGERARRAY DICT({1}0:4000)
!* GRAMMAR AND KEYWORD DICTIONARY GENERATED BY TAKEON PROGRAM
%CONSTINTEGER PUNCTMIN = 43, SKIP1MIN = 86
%CONSTBYTEINTEGERARRAY SYMINIT( 0: 255) = %C
129, 129, 129, 129, 129, 129, 129, 129,
129, 129, 255, 129, 129, 129, 129, 129,
129, 129, 129, 129, 129, 129, 129, 129,
129, 129, 129, 129, 129, 129, 129, 129,
0, 217, 127, 171, 129, 128, 173, 127,
175, 178, 214, 180, 182, 184, 187, 189,
48, 49, 50, 51, 52, 53, 54, 55,
56, 57, 192, 221, 194, 200, 203, 129,
129, 65, 66, 67, 68, 69, 70, 71,
72, 73, 74, 75, 76, 77, 78, 79,
80, 81, 82, 83, 84, 85, 86, 87,
88, 89, 90, 129, 207, 129, 210, 212,
129, 65, 66, 67, 68, 69, 70, 71,
72, 73, 74, 75, 76, 77, 78, 79,
80, 81, 82, 83, 84, 85, 86, 87,
88, 89, 90, 129, 207, 129, 210, 212,
129, 129, 129, 129, 129, 129, 129, 129,
129, 129, 255, 129, 129, 129, 129, 129,
129, 129, 129, 129, 129, 129, 129, 129,
129, 129, 129, 129, 129, 129, 129, 129,
0, 217, 127, 171, 129, 128, 173, 127,
175, 178, 214, 180, 182, 184, 187, 189,
48, 49, 50, 51, 52, 53, 54, 55,
56, 57, 192, 221, 194, 200, 203, 129,
129, 130, 132, 134, 138, 139, 142, 129,
129, 146, 129, 129, 148, 150, 152, 154,
157, 158, 159, 161, 167, 169, 129, 170,
129, 129, 129, 129, 207, 129, 210, 212,
129, 130, 132, 134, 138, 139, 142, 129,
129, 146, 129, 129, 148, 150, 152, 154,
157, 158, 159, 161, 167, 169, 129, 170,
129, 129, 129, 129, 207, 129, 210, 212
%CONSTSHORTINTEGERARRAY KEYDICT( 0: 487) = %C
0, 5,-26642, 6194,-26523, 6329,-26385,-26247, 0, 0,
6585,-26132,-26066, 6776,-25887,-25815,-25746, 7151,-25562, 7342,
-25367, 7471,-25247, 7599,-25119, 7727,-24978,-24782, 8119, 8178,
8245,-24475, 8687,-24024,-23959,-23888,-23820,-23625, 9209,-23512,
9330, 9390, 9512, 512, 240, 320, 64,-23231, 704, 0,
786, 0, 384, 113, 640, 0,-23074, 384, 114, 384,
128,-22961, 320, 48, 1600, 1,-22835,-22692,-22563,-22434,
512, 240,-22307, 576, 240,-22179,-22050, 512, 240,-21923,
448, 68, 448, 68, 192, 0,-21814, 320, 112,-21695,
-21559, 384, 67, 832, 1, 11364, 11506, 11559, 11636,-21075,
11758, 11875, 11950, 12019, 12068,-20503, 12340, 12469, 12526, 2496,
11, 12594, 1664, 3, 12788, 12851, 12910, 12976, 13102, 13165,
13236,-19419, 3264, 1, 2816, 0, 13422, 13545, 13601,-19103,
-19037,-18969,-18896,-18829, 14004, 14069, 14127, 14183, 14245,-18463,
-18385, 14450, 14505, 14579, 14629, 14709,-18004, 14836, 14889, 3008,
0, 960, 0, 320, 64, 576, 0, 256, 64, 512,
240, 256, 64, 896, 0, 512, 240, 256, 64, 512,
240, 256, 112, 384, 68, 3072, 0, 2752, 0, 14945,
15017, 15077, 15149,-17549, 15284, 15340, 15393, 15461,-17169, 3712,
0, 15668,-16987, 15858, 15916, 15977,-16723, 3136, 0, 16101,
16180, 16295, 2496, 3, 16425, 16485, 2880, 0, 16630, 2048,
0, 16686, 16740, 16812, 17007, 17065, 17125, 17205, 17269, 17332,
17394, 17454, 17507, 17650, 17712, 17833, 17908, 17972, 18030, 18163,
18213, 18281, 18348, 18425, 18606, 18729, 18789, 18868, 18994, 19045,
19181, 3328, 1, 19238, 1024, 2, 19442, 19497, 19572, 19699,
19745, 19815, 1280, 0,-12887, 19954, 20020, 2240, 1, 20069,
20148, 20210,-12493, 1984, 25, 20402, 20467, 20513, 20588, 20658,
20713, 20788, 20897, 2624, 1, 20980, 1024, 0, 21102, 21155,
21221, 3200, 0, 21300, 21363, 21420, 21541,-11090, 2112, 256,
3648, 0, 21742, 21806, 2048, 8, 21871, 3456, 2, 21929,
-10778,-10708, 22128, 22190, 22254, 1472, 0, 22312, 22452, 22565,
22638, 22693, 22767, 22830, 22900, 22949, -9748, 23086, 23140, 23284,
23348, 23476, 23598, 23726, -8983, 23858, 23916, 3392, 1, 24039,
24168, 24301, 24421, 24499, 1728, 0, 1728, 0, 24609, 24692,
24756, 24876, 24995, 25129, 25193, 25266, 25313, 25395, 3520, 1,
2368, 0, 25458, 25588, 25633, 25714, 25908, 26021, 26081, 26159,
26223, 2304, 9, 26277, 3584, 0, 1088, 0, 1024, 1,
26341, 26478, 26543, 1152, 0, 2176, 137, 1920, 268, 2688,
0, 26596, 1664, 3, 26669, 26725, 0, 2, 1344, 0,
2688, 0, 26796, 26867, 26927, 26988, 27113, 1984, 105, 27173,
27244, -5389, 1152, 0, 3264, 1, 27448, 27500, 27630, 27698,
27762, 2560, 6, 27892, 27957, 28016, 28069, 28199, 28261, 28404,
28519, 2432, 0, 28579, 28711, 1984, 41, 28788, 28852, 1984,
57, 28967, 29101, 1856, 121, 29157, 29236, 29298, 2240, -255,
29349, 3776, 0, 1280, 0, 29426, 2048, 0, 29477, 29551,
1216, 0, 1408, 32, 29601, 29671, 29737, 29807, 29874, 29985,
30066, 30192, 30316, 30437, 30510, 30567, 1984, 73, 30637, 1984,
121, 1024, 0, 1408, 0, 30770, 30885, 31026, 3776, 1,
1984, 89, 1280, 0, 31073, 31149, 1280, 0
%CONSTSHORTINTEGERARRAY PHRASE( {109}0: 126) = 0, %C
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,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,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,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
257, 249, 368, 430, 264, 269, 286, 298, 335, 345,
0, 452, 237, 374, 381, 0, 420, 437
%CONSTINTEGER INITBASE = 472
%CONSTSHORTINTEGERARRAY GRAM( 0: 531) = %C
66, 4084, 4511, 4898, 5028, 6440, 64, 7071, 7330, 5028,
64, 11553, 1955, 11685, 11945, 12273, 12321, 2467, 6439, 5617,
12429, 2996, 64, 5786, 5557, 5620, 2157, 12575, 12834, 6440,
64, 12954, 12955, 6961, 64, 13089, 6439, 5489, 4589, 13345,
1955, 12273, 7433, 12429, 64, 6005, 7602, 5557, 64, 7925,
13569, 13737, 64, 12429, 5630, 13089, 5489, 7149, 8257, 5557,
14068, 3250, 5558, 64, 8442, 8538, 4746, 12429, 64, 9042,
9200, 8963, 14217, 14350, 14479, 14617, 9927, 12429, 14763, 66,
14970, 15098, 15489, 64, 15729, 16129, 64, 8062, 16378, 5576,
12274, 16769, 64, 16897, 64, 5614, 5618, 69, 6439, 64,
12653, 5621, 17281, 64, 17409, 64, 17612, 13569, 64, 3124,
64, 18154, 18287, 9976, 9956, 116, 5599, 15199, 10378, 18319,
64, 18636, 15859, 10762, 12429, 64, 18897, 16479, 11274, 5557,
64, 19021, 17105, 17155, 12239, 19276, 19788, 17736, 19851, 19981,
64, 20218, 9964, 20225, 64, 20363, 64, 17616, 20619, 64,
19443, 22409, 12429, 64, 12275, 22905, 89, 9963, 23126, 23554,
64, 20806, 21279, 22306, 21796, 64, 23809, 24609, 24867, 64,
25089, 25889, 24867, 64, 21357, 22593, 26125, 26362, 26881, 64,
23242, 10378, 12429, 64, 5516, 64, 24014, 24330, 5516, 64,
23809, 20806, 27649, 64, 23809, 64, 25294, 28682, 25582, 20618,
5516, 64, 28929, 64, 22724, 26458, 22538, 29067, 29197, 64,
27084, 27402, 17804, 22905, 26881, 22905, 27854, 24586, 28147, 28426,
5516, 64, 27649, 20806, 25089, 64, 29390, 29562, 91, 25459,
29663, 29836, 64, 30046, 22538, 29197, 64, 30534, 31135, 31522,
31652, 40, 31691, 35, 39, 66, 31213, 35, 64, 32139,
64, 32385, 64, 32597, 32780, 64, 88, 33163, 66, 33402,
33503, 33676, 64, 98, 34049, 64, 34252, 33802, 66, 34597,
34801, 34955, 64, 35194, 35296, 35481, 64, 35677, 35834, 35936,
34954, 36236, 64, 36444, 34570, 66, 36875, 64, 37114, 37215,
37401, 64, 37608, 37754, 37855, 38028, 64, 99, 39937, 40847,
41104, 39569, 39058, 41363, 64, 41602, 12429, 14763, 66, 41737,
41870, 64, 40147, 40304, 40067, 14217, 14350, 14479, 9927, 41985,
64, 12429, 66, 42114, 64, 41184, 42346, 42479, 42582, 9953,
42746, 41196, 42864, 41195, 41162, 43126, 43520, 43691, 43820, 66,
67, 44022, 43382, 43691, 66, 44939, 44538, 45448, 45577, 45711,
67, 45173, 45824, 12, 64, 46202, 45544, 120, 46604, 64,
46313, 46728, 46857, 66, 44539, 47098, 46824, 105, 47361, 64,
47569, 47728, 47491, 66, 49281, 48770, 50182, 50311, 50443, 50607,
64, 50308, 50693, 51078, 66, 49492, 49648, 49411, 50308, 50693,
51078, 66, 51302, 51453, 51578, 51834, 50941, 51972, 49001, 52200,
52733, 48873, 48780, 64, 48816, 64, 52861, 52349, 52868, 52997,
49129, 52327, 50921, 53501, 53245, 53508, 52457, 52329, 53757, 53225,
54401, 2, 54539, 54703, 64, 47572, 45306, 54906, 48, 64,
55307, 66, 55546, 55615, 55306, 12, 64, 56175, 56288, 56457,
64, 56641, 56826, 56928, 57098, 64, 57338, 57440, 57610, 64,
57850, 96, 58057, 58251, 58479, 58618, 58721, 58977, 59142, 64,
59276, 64, 59621, 59782, 64, 58251, 64, 60005, 60143, 60257,
59142, 66, 0, 8833, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 40847, 41104, 39569,
39058, 41363, 5524, 10261, 5526, 10391, 0, 0, 5786, 6299,
0, 10525, 10782, 2079, 928, 0, 3362, 0, 1444, 0,
294, 0, 6440, 10921, 3498, 0, 0, 0, 0, 0,
0, 11185, 0, 11315, 0, 0, 6838, 2615, 5560, 11449,
5562, 59
!!END OF GENERATED SECTION
%CONSTBYTEINTEGERARRAY PERM({1}0:518) = 0, %C
'A','D','D','R',':',X'0B',X'62',
'A','R','C','C','O','S',':',X'07',X'22',
'A','R','C','S','I','N',':',X'07',X'22',
'A','R','R','A','Y',':',X'FC',X'F8',
'A','R','C','T','A','N',':',X'0D',X'22',
'B','Y','T','E','I','N','T','E','G','E','R',':',X'01',X'4A',
'C','H','A','R','N','O',':',X'0E',X'4A',
'C','L','O','S','E','S','T','R','E','A','M',':',X'01',X'06',
'C','O','S',':',X'07',X'22',
'E','X','P',':',X'07',X'22',
'F','R','A','C','P','T',':',X'07',X'22',
'F','R','O','M','S','T','R','I','N','G',':',X'0F',X'82',
'I','M','O','D',':',X'01',X'62',
'I','N','T',':',X'07',X'62',
'I','N','T','P','T',':',X'07',X'62',
'I','N','T','E','G','E','R',':',X'01',X'6A',
'L','E','N','G','T','H',':',X'0A',X'4A',
'L','O','G',':',X'07',X'22',
'L','O','N','G','R','E','A','L',':',X'01',X'1A',
'M','O','D',':',X'07',X'22',
'N','E','W','L','I','N','E',':',X'00',X'06',
'N','E','W','L','I','N','E','S',':',X'01',X'06',
'N','E','W','P','A','G','E',':',X'00',X'06',
'N','E','X','T','I','T','E','M',':',X'00',X'82',
'N','E','X','T','C','H',':',X'00',X'62',
'N','E','X','T','S','Y','M','B','O','L',':',X'00',X'62',
'N','L',':',X'00',X'62',
'P','I',':',X'00',X'22',
'P','R','I','N','T',':',X'0C',X'06',
'P','R','I','N','T','C','H',':',X'01',X'06',
'P','R','I','N','T','F','L',':',X'08',X'06',
'P','R','I','N','T','S','T','R','I','N','G',':',X'09',X'06',
'P','R','I','N','T','S','Y','M','B','O','L',':',X'01',X'06',
'R','A','D','I','U','S',':',X'0D',X'22',
'R','E','A','D',':',X'0B',X'06',
'R','E','A','D','C','H',':',X'0B',X'06',
'R','E','A','D','I','T','E','M',':',X'0A',X'06',
'R','E','A','D','S','T','R','I','N','G',':',X'0A',X'06',
'R','E','A','D','S','Y','M','B','O','L',':',X'0B',X'06',
'R','E','A','L',':',X'01',X'1A',
'R','E','C','O','R','D',':',X'01',X'0A',
'S','E','L','E','C','T','I','N','P','U','T',':',X'01',X'06',
'S','E','L','E','C','T','O','U','T','P','U','T',':',X'01',X'06',
'S','E','T','M','A','R','G','I','N','S',':',X'03',X'06',
'S','H','O','R','T','I','N','T','E','G','E','R',':',X'01',X'5A',
'S','I','N',':',X'07',X'22',
'S','K','I','P','S','Y','M','B','O','L',':',X'00',X'06',
'S','P','A','C','E',':',X'00',X'06',
'S','P','A','C','E','S',':',X'01',X'06',
'S','Q','R','T',':',X'07',X'22',
'S','T','R','I','N','G',':',X'01',X'8A',
'T','A','N',':',X'07',X'22',
'T','O','S','T','R','I','N','G',':',X'01',X'82',
'W','R','I','T','E',':',X'02',X'06'
%ROUTINESPEC PRINT SS
%ROUTINESPEC REPORT(%INTEGER N)
%ROUTINESPEC CODE ATOM
%ROUTINESPEC POP CONTEXT
%ROUTINESPEC DEFINE(%INTEGER DISP, VAL)
%ROUTINE FAULT(%INTEGER N)
FAULTNUM = N %AND FAULTPOS = FPOS1 %IF FAULTNUM < 0
%END
! GRAM LAYOUT: LINK<9> CLASS<7>
%SWITCH A(0:127)
%SWITCH X(0:4)
TIME1 = CPUTIME
%CYCLE I = 0,1,255
INDEX(I) = 0
%REPEAT
C = 0
IDENTS = 0
PRINTPOS = 0; PRECISION = 0; LEVEL = 0
NEXTLINE = 1; FAULTNUM = -1; PARMAX = 15
ADGRAM0 = ADDR(GRAM(0)); LINK1 = GRAM(1)>>6&1022+ADGRAM0
APPCONT = GRAM(GRAM(PHRASE(112))>>7&511)>>6&1022+ADGRAM0
DLIM = ADDR(DICT(1)); DBOUND = ADDR(DICT(4000))
FPOS = ADDR(PERM(1))-1; FMAX = ADDR(PERM(518))
%CYCLE I = 1,1,54
SYMCODE = 0
CODE ATOM; %MONITORSTOP %IF ATOM # IDENT
INTEGER(DLIM) = BYTEINTEGER(FPOS+1)<<8+BYTEINTEGER(FPOS+2)
FPOS = FPOS+2
INTEGER(DLIM+4) = 0
INTEGER(DLIM+8) = HEAD; HEAD = DLIM
DLIM = NEWDLIM
%REPEAT
C_LOCAL = DLIM
FPOS = FSTART-1; FMAX = FPOS+FSIZE
SYMCODE = 0
L1: ->ENDED %IF FPOS >= FMAX
LINEBASE = FPOS; LINE = NEXTLINE
L3: ATOM = JUMP; !FOR NUMERIC LABEL DETECTION
SKIPMIN = SKIP1MIN; !TO IGNORE NULL STATEMENTS AND COMMENTS
CODE ATOM
SKIPMIN = NLCODE
STATS = STATS+1
EXTIND = 0; DECLTYPE = 0
CONSTCOUNT = 0; DIMCOUNT = 0
NP = 51
LINKMAX = 1; LINK(1) = LINK1; !FOR GRATUITOUS PHRASE EXIT
I = GRAM(INITBASE+ATOM)
->ERR %IF I = 0
G = I>>6&1022+ADGRAM0
->A(ATOM)
A(1): !IDENT
A(6): !OP3
A(9): !EQ
A(13): !NL
A(25): !COLON
I = SHORTINTEGER(G); G = I>>6&1022+ADGRAM0
->A(I&127)
A(10): A(11): A(12): A(15): A(18): A(19): A(20):
A(21): A(23): A(27): A(37):
A(43): A(44): A(45):
A(47): A(48): A(50): A(57): A(65):
CODE:
CODE ATOM
ON:
REP:%CYCLE
! LOOPS = LOOPS+1
CLASS = SHORTINTEGER(G)&127
%EXIT %IF CLASS >= 60 %OR CLASS = ATOM
G = G+2
%REPEAT
G = SHORTINTEGER(G)>>6&1022+ADGRAM0
->A(CLASS)
A(109): A(110): A(111): A(113): A(114):
A(115): A(116): A(117): A(118): A(119):
A(120): A(121): A(122): A(123): A(124):
A(125): A(126):
ENTER:
LINKMAX = LINKMAX+1; ->ERR %IF LINKMAX > 20
LINK(LINKMAX) = G
G = PHRASE(CLASS)<<1+ADGRAM0
->REP
A(66):
EXIT:
G = LINK(LINKMAX); LINKMAX = LINKMAX-1
->REP
A(67): !ALT (ALTERNATIVE PHRASE RECOGNISED)
I = SHORTINTEGER(LINK(LINKMAX)); LINKMAX = LINKMAX-1
->ERR %IF I&127 # 0; !NO ALTERNATIVE
G = I>>6&1022+ADGRAM0
->ON
A(68): !BREAK (TERMINATOR WITHIN CONST LIST)
REPORT(FAULTNUM) %IF FAULTNUM >= 0
%IF ATOMTYPE = 0 %START; !NL
LINEBASE = FPOS; LINE = NEXTLINE
%FINISH
->CODE
UNKNOWN:
%WHILE DPOS < 0 %CYCLE
->IGNORE %IF STRING(-DPOS+4) = STRING(DLIM+12)
DPOS = INTEGER(-DPOS)
%REPEAT
FAULT(2)
%CYCLE
DBOUND = DBOUND-4; NEWDLIM = NEWDLIM-4
%EXIT %IF NEWDLIM = DLIM+8
INTEGER(DBOUND) = INTEGER(NEWDLIM)
%REPEAT
HEAD == INTEGER(HEAD+8) %WHILE HEAD > 0
INTEGER(DBOUND) = HEAD; HEAD = -DBOUND
->IGNORE
MODERR:
FAULT(3)
->IGNORE
A(0): A(64):
ERR:FAULTNUM = 0; FAULTNUM = ATOMTYPE %IF ATOM = 0
->DISASTER %IF FAULTNUM = 99
FAULTPOS = FPOS1
IGNORE:
I=ATOM %AND CODE ATOM %WHILE ATOM # TERMINATOR
C_STACK = C_STACK<<2+3 %IF I = START
C_STACK = C_STACK<<2+2 %IF I = CYCLE
REPORT(FAULTNUM) %IF FAULTNUM >= 0
%WHILE I = COMMA %AND ATOMTYPE = 0 %CYCLE
I=ATOM %AND CODE ATOM %UNTIL ATOM = TERMINATOR
%REPEAT
A(69): !FIN
FIN:REPORT(FAULTNUM) %IF FAULTNUM >= 0
%IF C_BTYPE&1 # 0 %START; !PSEUDO BLOCK ENTRY FOR SPEC
DLIM = C_LOCAL
C = HOLD(LEVEL); LEVEL = LEVEL-1
%FINISH
->L3 %IF ATOMTYPE # 0; !COLON OR SEMI-COLON
->L1; !NEWLINE
DISASTER:
%PRINTTEXT '** SPACE EXHAUSTED AT LINE'; WRITE(NEXTLINE,1)
NEWLINE
%RETURN
A(74):
NAPP:
->ON %IF TYPE&APPMASK = 0
->ERR
ER20:
FAULT(20)
->NAPP
ER22:
FAULT(22)
->NAPP
A(22): !PREC
PRECISION = ATOMTYPE
->CODE
A(38): !EXTERNAL
A(42): !SYSTEM,DYNAMIC
EXTIND = 1
->CODE
A(70): !RESET
DECLTYPE = 0
->ON
A(36): !RECORD
RECIDENTS = DLIM
A(29): !REG
A(30): !SWITCH
A(31): !NTYPE
A(32): !OWN
A(33): !ARRAY
A(34): !STRING
A(35): !NAME
A(39): !FM
A(40): !ROUTINE
A(41): !SPEC
DECLTYPE = DECLTYPE!!ATOMTYPE
DECLTYPE = DECLTYPE!PRECISION %IF DECLTYPE&X'F0' = X'10'
IDENTS = DLIM
MODES = \0; !FOR SPEC LOOKS
->CODE
A(75): !NOTYPE
DECLTYPE = X'F9'; ! '?' VAR
->ON
A(78): !IDENT: DC (DECLARE RECORD COMPONENT)
HEAD == INTEGER(FIDENTPOS+4); DPOS = HEAD; !ALTER SEARCH LIST
A(76): !IDENT: D (DECLARE)
D1: ->ADD %IF C_BTYPE&1 # 0; !WITHIN SPEC PARAMS
D2: %CYCLE
->NEW %IF DPOS < C_LOCAL
%EXIT %IF STRING(DPOS+12) = STRING(DLIM+12)
DPOS = INTEGER(DPOS+8)
%REPEAT
->D5 %IF INTEGER(DPOS)&X'FF'-1 = DECLTYPE %C
%AND DECLTYPE&6 # 0 %AND DECLTYPE&1 = 0
FAULT(5); !DUPLICATE
NEW:INTEGER(DLIM+8) = HEAD; HEAD = DLIM
ADD:INTEGER(DLIM) = DECLTYPE; INTEGER(DLIM+4) = 0
DLIM = NEWDLIM
->CODE
!PROCEDURE BODY AFTER SPEC, LABEL AFTER JUMP
D5: INTEGER(DPOS) = DECLTYPE %IF DECLTYPE = LAB
IDENTS = DPOS
->CODE
A(77): !IDENT: DF (DECLARE RECORD FORMAT)
DECLTYPE = RECFORMAT; FIDENTPOS = DLIM
->D1
A(2): !CONST
TYPE = ATOMTYPE; VAL = ATOMVAL
->CODE
A(3): !SUB (ABSORBS FOLLOWING IDENT)
->ERR %IF TYPE&X'FFF4' # 0 %AND TYPE # RECFORMAT; !NOT RECORD
CODE ATOM; ->ERR %IF ATOM # IDENT
->IGNORE %IF VAL = 0
DPOS = VAL; HEAD == VAL
A(81): !IDENT: LOOK
LOOK:
LOOKS = LOOKS+1
%CYCLE
TIMES = TIMES+1
->UNKNOWN %IF DPOS <= 0
%EXIT %IF STRING(DPOS+12) = STRING(DLIM+12)
DPOS = INTEGER(DPOS+8)
%REPEAT
TYPE = INTEGER(DPOS); VAL = INTEGER(DPOS+4)
->CODE %IF MODES<<(TYPE&15) < 0
->MODERR
A(82): !IDENT: IMP1LOOK
MODES = IMP1MODES
->LOOK %IF BYTEINTEGER(FPOS) # ':'
DECLTYPE = LAB
->D2
A(83): !IDENT: IMPLOOK
MODES = IMPMODES
->LOOK
A(84): !IDENT: EXPLOOK
MODES = EXPMODES
->LOOK
A(85): !IDENT: FLOOK
MODES = FMATMODES
->LOOK
A(86): !IDENT: JLOOK
%WHILE DPOS >= C_LOCAL %CYCLE
->JL1 %IF STRING(DPOS+12) = STRING(DLIM+12)
DPOS = INTEGER(DPOS+8)
%REPEAT
INTEGER(DLIM+8) = HEAD; HEAD = DLIM
INTEGER(DLIM) = JUMPLAB; INTEGER(DLIM+4) = 0
DPOS = DLIM; DLIM = NEWDLIM
JL1:TYPE = INTEGER(DPOS)
->CODE %IF TYPE&14 = LAB
->MODERR
A(79): !RECSPEC
->MODERR %IF TYPE&X'F4' # 0 %OR VAL # 0 %OR DPOS < C_LOCAL
RECIDENTS = -DPOS
->ON
A(88): !FSET
IDENTS = RECIDENTS
%IF IDENTS >= 0 %THEN DEFINE(4,INTEGER(DPOS+4)) %C
%ELSE INTEGER(-IDENTS+4) = INTEGER(DPOS+4)
->ON
A(80): !PROCSPEC
->MODERR %IF TYPE&X'FF03' # FN %OR DPOS < C_LOCAL
IDENTS = DPOS
->ON
A(72): !BEG
PIDENTPOS = IDENTS
LEVEL = LEVEL+1; ->DISASTER %IF LEVEL > 12
HOLD(LEVEL) = C
C_BTYPE = DECLTYPE
C_STACK = 0
C_LOCAL = DLIM
->ON
A(89): !NL: PARSET
IDENTS = C_LOCAL; NP = 51
%WHILE IDENTS # DLIM %CYCLE
NP = NP-1; NTYPE(NP) = INTEGER(IDENTS)
IDENTS = BYTEINTEGER(IDENTS+12)&(\3)+IDENTS+16
%REPEAT
I = 0
%WHILE NP # 51 %CYCLE
J = I<<24+NTYPE(NP); NP = NP+1
I = I+1 %UNTIL I > PARMAX %OR PARTYPE(I) = J
%IF I > PARMAX %START
->DISASTER %IF I = 252
PARMAX = I
PARTYPE(I) = J
%FINISH
%REPEAT
%IF C_BTYPE&1 = 0 %AND INTEGER(PIDENTPOS)&1 # 0 %START
FAULT(18) %IF BYTEINTEGER(PIDENTPOS+2) # I
INTEGER(PIDENTPOS) = C_BTYPE
%FINISH
BYTEINTEGER(PIDENTPOS+2) = I
INTEGER(PIDENTPOS) = INTEGER(PIDENTPOS)&(\EXTIND)
->FIN
A(90): !INIT
CONSTCOUNT = CONSTCOUNT-1
->ER20 %IF TYPE&15 # 0
->ER22 %IF TYPE&DECLTYPE = 0
!RANGE CHECK
DEFINE(4,VAL) %IF DECLTYPE&15 = 0
->ON
A(91): !NL: INITFIN
FAULT(21) %IF CONSTCOUNT # 0 %AND CONSTCOUNT < 1000000
->FIN
A(92): !DIMSET
DEFINE(0,DIMCOUNT)
DIMCOUNT = 0
->ON
A(93): !COLON: COUNT
%IF DIMCOUNT = 6 %THEN FAULT(23) %ELSE DIMCOUNT = DIMCOUNT+1
->CODE
A(94): !REP
CONSTCOUNT = CONSTCOUNT-VAL+1
->ON
A(95): !LITINT
->ER20 %IF TYPE&15 # 0
A(96): !INT
->ER22 %IF TYPE&INTBIT = 0
->NAPP
A(97): !STR
->ER22 %IF TYPE&STRINGBIT = 0
->NAPP
A(98): !SIZESET
STRINGSIZE = VAL
->ON %IF 0 < VAL <= 255
FAULT(19); STRINGSIZE = 255
->ON
A(99): !CBSET
LASTVAL = NVAL(NP); NP = NP+1
->CBERR %UNLESS -32768 <= LASTVAL <= 32767
CONSTCOUNT = VAL-LASTVAL+1
->CBERR %UNLESS 0 < CONSTCOUNT <= 32767
%IF DECLTYPE = SWITCH %START
%UNTIL IDENTS = DLIM %CYCLE
J = DBOUND
DBOUND = J-(CONSTCOUNT+63)>>5<<2
->DISASTER %IF DBOUND <= DLIM
INTEGER(IDENTS+4) = DBOUND
INTEGER(DBOUND) = LASTVAL<<16+CONSTCOUNT
%CYCLE
J = J-4
%EXIT %IF J = DBOUND
INTEGER(J) = 0
%REPEAT
IDENTS = BYTEINTEGER(IDENTS+12)&(\3)+IDENTS+16
%REPEAT
%FINISH
CB1:IDENTS = DLIM
->ON
CBERR:
FAULT(23); CONSTCOUNT = 2000000
->CB1
A(100): !COLON: LAB
->FIN %IF DECLTYPE # 0; !SIMPLE LABEL
->ERR %IF TYPE # JUMPLAB; !IE SWITCH + APP
FAULT(20) %AND ->FIN %IF LASTTYPE&15 # 0
->FIN %IF VAL = 0
J = LASTVAL-SHORTINTEGER(VAL)
FAULT(19) %AND ->FIN %UNLESS 0 <= J < SHORTINTEGER(VAL+2)
I = VAL+J>>5<<2; J = X'80000000'>>(J&31)
FAULT(16) %IF INTEGER(I+4)&J # 0
INTEGER(I+4) = INTEGER(I+4)!J
->FIN
A(101): !OP3: DOT
->ERR %IF ATOMTYPE # STRINGBIT; !IE OP3 # '.'
A(60): !FOR
MODES = DESTMODES
->CODE
A(73): !RESOL
->ER22 %IF TYPE&STRINGBIT = 0
MODES = DESTMODES
->ON
A(102): !OP3: SIGN
->ERR %IF ATOMTYPE&3 = 0; !IE OP3 # '+', '-', '!'
TYPE = ATOMTYPE; VAL = 0
->OP1
A(7): !UOP
TYPE = ATOMTYPE; VAL = -1
->OP1
A(8): !COP
A(4): !OP1
A(5): !OP2
A(104):!OP3 OR EQ: OP
->ERR %IF TYPE&APPMASK # 0
%IF TYPE&X'FF4F' = INTBIT %THEN TYPE=TYPE!15 %ELSE TYPE=TYPE&(\15)
TYPE = TYPE!REALBITS %IF TYPE&NUMBITS # 0
OP1:NP = NP-1; NTYPE(NP) = TYPE&ATOMTYPE; NVAL(NP) = VAL
->CODE
A(105): !EVAL
->ERR %IF TYPE&APPMASK # 0
TYPE = TYPE!REALBITS %IF TYPE&NUMBITS # 0
I = NTYPE(NP); NP = NP+1
J = I&TYPE&X'F0'
->ER22 %IF J = 0
->X(I&15) %IF TYPE&X'FF4F' = INTBIT
X(0):
TYPE = J+EXP
->ON
X(1): VAL = NVAL(NP-1)+VAL
X1: TYPE = NUMBITS
->ON
X(2): VAL = NVAL(NP-1)-VAL
->X1
X(3): VAL = NVAL(NP-1)!VAL
->X1
X(4): VAL = NVAL(NP-1)!!VAL
->X1
A(103): !BAR (FIDDLE FOR MOD-SIGN)
->ON %UNLESS NTYPE(NP) = X'43'
->ERR %UNLESS ATOM = OP3 %AND ATOMTYPE = X'43'
NP = NP+1; CODE ATOM
->EXIT
A(106): !EQ: ASSOP
->ERR %IF TYPE&X'FF0C' # 8
SAVE:
NP = NP-1; NTYPE(NP) = TYPE; NVAL(NP) = VAL
->CODE
A(14): !EQEQ
MODES = ADRMODES
->SAVE %IF TYPE&15 = REF
->ERR
A(107): !ASS
I = NTYPE(NP); NP = NP+1
AS1:%IF I&TYPE&X'C0' = 0 %START
I = I&X'F0'
%IF I = 0 %START; !RECORD
->ER22 %UNLESS TYPE&X'F0' = 0 %OR %C
(TYPE&X'FF4F'=INTBIT %AND VAL=0)
%FINISH %ELSE %START
->ER22 %UNLESS I <= X'30' %AND TYPE&NUMBITS # 0
%FINISH
%FINISH
->NAPP
A(108): !REFASS
I = NTYPE(NP); NP = NP+1
RA1:FAULT(22) %IF (I!!TYPE)&X'F0' # 0 %C
%AND I&X'F0' # X'F0' %AND TYPE&X'F0' # X'F0'
->NAPP %IF I&APPMASK = 0; !SCALAR
FAULT(22) %IF TYPE&APPMASK = 0 %OR TYPE&14 = MAP
->ON
A(17): !RESULT
FAULT(25) %IF C_BTYPE&7 # FN
TYPE = C_BTYPE&X'F8'; TYPE = TYPE+VAR %IF TYPE&8 = 0
VAL = 0
->CODE
A(71): !RCALL
->ON %IF TYPE&X'FFFC' = 4
->ERR
A(112): !APP
->ON %IF ATOM # LB
LINKMAX = LINKMAX+1; ->ERR %IF LINKMAX > 20
LINK(LINKMAX) = G
NP = NP-1; NVAL(NP) = VAL
AP: ->ERR %IF TYPE&APPMASK = 0
NTYPE(NP) = TYPE
G = APPCONT
CODE ATOM
J = PARTYPE(TYPE>>8)&15
CLASS = 122; !EXP
->ENTER %IF J = VAR
CLASS = 111; MODES = ADRMODES
->ENTER %IF J = REF
MODES = X'C0000000'>>J
->ENTER
A(63): !AP
J = NTYPE(NP); I = PARTYPE(J>>8)
LASTTYPE = TYPE; LASTVAL = VAL
TYPE = I>>16+J&X'FF'
->AP %IF ATOM = COMMA
->ERR %IF ATOM # RB
VAL = NVAL(NP); NP = NP+1
%IF TYPE&APPMASK # 0 %START
TYPE = TYPE!!APPMASK
->ERR %IF TYPE&X'FE00' # 0
%FINISH
TYPE = TYPE&X'FFFC'!1
CODE ATOM
->EXIT
A(16): !SIMP: STOP(0), RETURN(1), EXIT(2)
FAULT(25) %IF (ATOMTYPE = 1 %AND C_BTYPE&15 # ROUTINE) %C
%OR (ATOMTYPE = 2 %AND (C_STACK!!X'55555555')<<1&C_STACK = 0)
->CODE
A(54): !CYCLE
CONDIND = 2
A(53): !START
C_STACK = C_STACK<<2+CONDIND
->CODE
A(55): !FINISH(1)
A(56): !REPEAT(0)
CONDIND = C_STACK&3
%IF CONDIND = 0 %OR (CONDIND!!ATOMTYPE)&1 # 0 %C
%THEN FAULT(12+ATOMTYPE) %C
%ELSE C_STACK = C_STACK>>2
->CODE
A(52): !ELSE(1)
FAULT(25) %IF CONDIND = 1
A(26): !CWORD(3)
A(51): !ON(1)
CONDIND = ATOMTYPE
->CODE
A(58): !END
%IF LEVEL = 0 %OR (LEVEL=1 %AND C_BTYPE=0) %THEN FAULT(11) %C
%ELSE POP CONTEXT
->CODE
A(59): !ENDPROG
FPOS1 = FPOS
REPORT(8) %IF LEVEL > ATOMTYPE
REPORT(11) %IF LEVEL < ATOMTYPE
POP CONTEXT %WHILE LEVEL > 0
TIME2 = CPUTIME
->ENDOK
ENDED:
TIME2 = CPUTIME
%PRINTTEXT '** END OF FILE AT LINE'; WRITE(NEXTLINE,1)
NEWLINE
ENDOK:
%IF PARM&4 # 0 %START
WRITE(LINE,4); PRINTSYMBOL('L')
WRITE(STATS,4); PRINT SYMBOL('S')
STATS = 1 %IF STATS = 0
PRINT(ATOMS/STATS,2,1); PRINT SYMBOL('A')
PRINT(NUMBERS/STATS,2,1); PRINT SYMBOL('N')
PRINT(IDENTIFIERS/STATS,2,1); PRINT SYMBOL('I')
PRINT(LOOPS/STATS,3{2},1); PRINT SYMBOL('C')
PRINT(TIMES/LOOKS,2,2{1}); PRINT SYMBOL('H')
PRINT((TIME2-TIME1)*1000/STATS,3,3); PRINT SYMBOL('M')
NEWLINE
%FINISH
%IF PARM&8 # 0 %START
%CYCLE I = 0,1,255
J = INDEX(I)
%IF J > 0 %START
WRITE(I,3); PRINT SYMBOL(':')
%WHILE J > 0 %CYCLE
SPACE; PRINT STRING(STRING(J+12))
J = INTEGER(J+8)
%REPEAT
NEWLINE
%FINISH
%REPEAT
%FINISH
%RETURN
!
%ROUTINE PRINT SS
%SHORTROUTINE
%INTEGER K
%ROUTINE WRITE(%INTEGER V,P)
%IF V >= 10 %START
WRITE(V//10,P-1); V = V-10*(V//10)
%FINISH %ELSE SPACES(P-1)
PRINT SYMBOL(V+'0')
%END
WRITE(LINE,4); SPACE
PRINTPOS = LINEBASE
%UNTIL PRINTPOS = FPOS1 %CYCLE
PRINTPOS = PRINTPOS+1
PRINT SYMBOL(MARKER) %IF PRINTPOS = FAULTPOS
K = BYTEINTEGER(PRINTPOS)
%IF K = NL %OR 32 <= K <= 126 %THEN PRINT SYMBOL(K) %C
%ELSE PRINT SYMBOL('[') %AND WRITE(K,0) %AND PRINT SYMBOL(']')
%REPEAT
NEWLINE %IF K # NL
%END
%ROUTINE REPORT(%INTEGER N)
%SHORTROUTINE
%SWITCH S(0:25)
FAULTPOS = 0 %IF N > 7
PRINT SS %IF PRINTPOS # FPOS1
PRINT SYMBOL('*')
->S(N)
S(0): %PRINTTEXT 'FORM?'; ->F
S(1): %PRINTTEXT 'ATOM?'; ->F
S(2): %PRINTTEXT 'NAME?'; ->F
S(3): %PRINTTEXT 'MODE?'; ->F
S(4): %PRINTTEXT 'SIZE?'; ->F
S(11): %PRINTTEXT '%BEGIN'; ->M
S(12): %PRINTTEXT '%CYCLE'; ->M
S(13): %PRINTTEXT '%START'; ->M
S(8): %PRINTTEXT '%END'; ->M
S(9): %PRINTTEXT '%REPEAT'; ->M
S(10): %PRINTTEXT '%FINISH'; ->M
S(15): PRINT SYMBOL('''')
PRINT STRING(STRING(DPOS+12))
PRINT SYMBOL('''')
M: %PRINTTEXT ' MISSING'; ->F
S(23): %PRINTTEXT 'BOUNDS?'; ->F
S(25): %PRINTTEXT 'CONTEXT?'; ->F
S(5):
S(16): %PRINTTEXT 'DUPLICATE'; ->F
S(17): %PRINTTEXT 'ORDER?'; ->F
S(18): %PRINTTEXT 'MATCH?'; ->F
S(19): %PRINTTEXT 'RANGE?'; ->F
S(20): %PRINTTEXT 'LITERAL?'; ->F
S(21): %IF CONSTCOUNT < 0 %START
WRITE(-CONSTCOUNT,1); %PRINTTEXT ' EXTRA'
%FINISH %ELSE %START
WRITE(CONSTCOUNT,1); %PRINTTEXT ' MISSING'
%FINISH
%PRINTTEXT ' VALUE(S)'; ->F
S(22): %PRINTTEXT 'TYPE?'; ->F
F: NEWLINE
FAULTNUM = -1; PARM = PARM!X'80000000'
%END
%ROUTINE CODE ATOM
%SHORTROUTINE
%REGISTER FP(5); !FILE POS
%REGISTER SC(6); !SYMCODE OR SYM
%INTEGER I,J,K,L
%INTEGER HASH
ATOMS = ATOMS+1
FP = FPOS; SC = SYMCODE
->C2 %IF SC # 0
C1: %UNTIL SC # ' ' %CYCLE
FP = FP+1; SC = BYTEINTEGER(FP)
%REPEAT
SC = SYMINIT(SC)
C2: FPOS1 = FP
->NAMENUM %IF SC < 127
SC = SC-128
->KEYWORD %IF SC > 0
->QUOTEMARK %IF SC # 0
!PERCENT
FP = FP+1; SC = SYMINIT(BYTEINTEGER(FP)!128)
->C2 %IF SC # 0
->C1
!LOCATE ATOM IN FIXED DICT
!KEYDICT := MORE<5> : LINK<9> : SYM-32<6>
! OR CLASS<7> : 0<6>
! THEN SUBCLASS<16>
KEYWORD:
->NLQ %IF SC >= SKIPMIN; !NL OR EQUIVALENT
I = SC; L = 0; L = 128 %IF SC < PUNCTMIN
%CYCLE
%CYCLE
FP = FP+1; K = BYTEINTEGER(FP)
SC = SYMINIT(K!L)
%EXIT %IF SC&127 # 0
L = SC
%REPEAT
K = K-32 %IF SC&128 # 0
%CYCLE
J = KEYDICT(I)
%EXIT %IF J >= 0 %OR J&63 = K
I = I+1
%REPEAT
%EXIT %IF J&63 # K
I = J>>6&511
%REPEAT
->ERR %IF J&63 # 0
ATOMTYPE = KEYDICT(I+1)&X'FFFF'
ATOM = J>>6
->KEY5 %IF ATOM = 0
FIN:FPOS = FP; SYMCODE = SC
%RETURN
KEY5:
%IF ATOMTYPE # 0 %START; !%COMMENT
->FIN %IF SKIPMIN # SKIP1MIN
->SKP
%FINISH
->ERR %UNLESS BYTEINTEGER(FP) = NL
NEXTLINE = NEXTLINE+1
->TERM %IF FP >= FMAX
->C1
NLQ:
->TERM %IF SKIPMIN # SKIP1MIN; !NOT LEADING ATOM
SKP:
FP = FP-1
%UNTIL SC = NL %OR SC = ';' %CYCLE
FP = FP+1; SC = BYTEINTEGER(FP)
%REPEAT
%IF SC = NL %START
->TERM %IF FP >= FMAX
LINEBASE = FP; NEXTLINE = NEXTLINE+1; LINE = NEXTLINE
%FINISH
->C1
TERM:
ATOM = TERMINATOR; ATOMTYPE = 0
NEXTLINE = NEXTLINE+1; SC = 0
SC = 255 %IF FP >= FMAX
->FIN
DISASTER:
ATOMTYPE = 99
->ER1
STRINGERR:
ATOMTYPE = 4; NEXTLINE = L
ER1:FP = FPOS1; SC = 0
->ER2
ERR:ATOMTYPE = 1
ER2:ATOM = 0
->FIN
NAMENUM:
->NUMBER %IF SC <= '9' %AND ATOM # JUMP
%IF BYTEINTEGER(FP+1) = '''' %START
->HEX %IF SC = 'X'
->OCT %IF SC = 'K'
->BIN %IF SC = 'B'
->MULTI %IF SC = 'M'
%FINISH
J = DLIM; ->DISASTER %IF J+84 >= DBOUND
HASH = 0
%UNTIL SC > 'Z' %CYCLE
%IF SC # 0 %START
J = J+1; BYTEINTEGER(J+12) = SC
HASH = HASH<<1!!SC
%FINISH
FP = FP+1; SC = SYMINIT(BYTEINTEGER(FP))
%REPEAT
BYTEINTEGER(DLIM+12) = J-DLIM
NEWDLIM = J&(\3)+16
HEAD == INDEX(HASH&255); DPOS = HEAD;
ATOM = IDENT;
IDENTIFIERS = IDENTIFIERS+1
->FIN
NUMBER:
ATOMTYPE = NUMBITS
ATOMVAL = SC-'0'
%CYCLE
FP = FP+1; SC = SYMINIT(BYTEINTEGER(FP))
%EXIT %IF SC > '9'
ATOMVAL = (ATOMVAL<<2+ATOMVAL)<<1+SC-'0' %C
%IF SC # 0 %AND ATOMVAL < 1000000
%REPEAT
%IF BYTEINTEGER(FP) = '.' %START
%UNTIL SC > '9' %CYCLE
FP = FP+1; SC = SYMINIT(BYTEINTEGER(FP))
%REPEAT
ATOMTYPE = REALBITS
%FINISH
%IF BYTEINTEGER(FP) = '@' %START
%UNTIL SC # ' ' %CYCLE
FP = FP+1; SC = BYTEINTEGER(FP)
%REPEAT
%IF SC = '-' %START
%UNTIL SC # ' ' %CYCLE
FP = FP+1; SC = BYTEINTEGER(FP)
%REPEAT
%FINISH
SC = SYMINIT(SC)
->ERR %UNLESS SC <= '9'
%UNTIL SC > '9' %CYCLE
FP = FP+1; SC = SYMINIT(BYTEINTEGER(FP))
%REPEAT
ATOMTYPE = REALBITS
%FINISH
NN: ATOM = CONST
NUMBERS = NUMBERS+1
->FIN
MULTI:
FP = FP+1
ATOMTYPE = NUMBITS
->Q1
QUOTEMARK:
ATOMTYPE = STRINGBIT
Q1: K = BYTEINTEGER(FP); J = -1; L = NEXTLINE
ATOMVAL = 0
%CYCLE
FP = FP+1; SC = BYTEINTEGER(FP)
%IF SC = NL %START
NEXTLINE = NEXTLINE+1
->TERM %IF FP >= FMAX
%FINISH
%IF SC = K %START
%EXIT %IF SC # BYTEINTEGER(FP+1)
FP = FP+1
%FINISH
ATOMVAL = ATOMVAL<<8+SC
J = J+1; ->STRINGERR %IF J = 255
%REPEAT
%IF ATOMTYPE = STRINGBIT %START; !IE NOT MULTI
ATOMVAL = J<<8+ATOMVAL&255
ATOMTYPE = STRINGBIT+NUMBITS %IF J = 0
%FINISH
SC = 0
->NN
HEX:J = 4; ->RAD
OCT:J = 3; ->RAD
BIN:J = 1
RAD:FP = FP+1
ATOMTYPE = NUMBITS; ATOMVAL = 0
%CYCLE
FP = FP+1; SC = BYTEINTEGER(FP)
%EXIT %IF SC = ''''
K = SC-'0'
K = K+('0'-'A'+10) %IF K >= 'A'-'0'
->ERR %IF K>>J # 0
ATOMVAL = ATOMVAL<<J+K
%REPEAT
SC = 0
->NN
%END; !CODE ATOM
%ROUTINE POP CONTEXT
%SHORTROUTINE
%INTEGER I
DPOS = C_LOCAL; FPOS1 = FPOS
%WHILE DPOS # DLIM %CYCLE
I = INTEGER(DPOS)
%IF I # RECFORMAT %START
REPORT(15) %IF I&1 # 0 %AND I&6 # 0
%FINISH %ELSE %START
DPOS = INTEGER(DPOS+4) %IF INTEGER(DPOS+4) # 0
%FINISH
DPOS = BYTEINTEGER(DPOS+12)&(\3)+DPOS+16
%REPEAT
REPORT(C_STACK&1+9) %AND C_STACK=C_STACK>>2 %WHILE C_STACK # 0
DLIM = C_LOCAL
C = HOLD(LEVEL); LEVEL = LEVEL-1
%CYCLE I = ADDR(INDEX(0)),4,ADDR(INDEX(255))
INTEGER(I) = INTEGER(INTEGER(I)+8) %WHILE INTEGER(I) >= DLIM
%REPEAT
%END
%ROUTINE DEFINE(%INTEGER DISP,VAL)
%SHORTROUTINE
%WHILE IDENTS # DLIM %CYCLE
%IF DISP # 0 %THEN INTEGER(IDENTS+4) = VAL %C
%ELSE BYTEINTEGER(IDENTS+2) = VAL
IDENTS = BYTEINTEGER(IDENTS+12)&(\3)+IDENTS+16
%REPEAT
%END
%END; !CHECKINNER
%EXTERNALROUTINE CHECK(%STRING(63) PARAM)
%EXTERNALROUTINESPEC DEFINE(%STRING(63) S)
%SYSTEMROUTINESPEC CONNECT(%STRING(15) S %INTEGER A,M,P %C
%RECORDNAME R %INTEGERNAME F)
%EXTERNALSTRINGFNSPEC SSFMESSAGE
%RECORDFORMAT FINF(%INTEGER CONAD,FILESIZE, %BYTEINTEGER RUP, %C
EEP,MODE,CONS,ARCH, %STRING(6) TRAN, %C
%SHORTINTEGER FILETYPE,NUMIPERMS, %C
%INTEGER DATASTART,DATAEND, PLISTPTR)
%RECORD R(FINF)
%INTEGER I,J,FLAG
%STRING(63) OPTIONS,OUT
OUT = '' %UNLESS PARAM -> PARAM.('/').OUT
OPTIONS = '' %UNLESS PARAM -> PARAM.(',').OPTIONS
CONNECT(PARAM,0,0,0,R,FLAG)
PRINTSTRING(SSFMESSAGE) %AND %RETURN %IF FLAG # 0
%IF OUT # '' %START
DEFINE('ST19,'.OUT)
SELECT OUTPUT(19)
%FINISH
I = 0
%WHILE I < LENGTH(OPTIONS) %CYCLE
I = I+1; J = CHARNO(OPTIONS,I)
FLAG = FLAG!8 %IF J = 'D'
FLAG = FLAG!4 %IF J = 'S'
%REPEAT
CHECKINNER(R_CONAD+R_DATASTART,R_DATAEND-R_DATASTART,FLAG)
%PRINTTEXT ' OK' %AND NEWLINE %IF FLAG >= 0
%END; !CHECK
%ENDOFFILE
ÿÿ