// cc -I../.. imp9-check.c -o imp9-check /* EPC Imp to C Translation Release 4 Version Apr 95 */ #include "imptoc.h" extern void selectoutput(int stream); void checkinner(int fstart, int fsize, int *parm) { extern double cputime(void); double time1, time2; /**/ /*DECLARATION CODES*/ static const int stringbit = 0x80; static const int realbits = 0x30; static const int intbit = 0x40; static const int numbits = 0x70; static const int appmask = 0xFF00; static const int exp = 1; static const int fn = 2; static const int recformat = 4; static const int routine = 6; static const int ref = 8; static const int var = 9; static const int map = 10; static const int lab = 12; static const int jumplab = 13; static const int Switch = 0x10C; static const int imp1modes = 0x43FC0000; static const int impmodes = 0x43F00000; static const int destmodes = 0xF00000; static const int adrmodes = 0x40F00000; static const int expmodes = 0xF0F00000; static const int fmatmodes = 0x8000000; /*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*/ static const int nlcode = 127; /*MASKED FROM 255 ACTUAL*/ /*ATOM CODES*/ static const int ident = 1; static const int Const = 2; static const int lb = 11; static const int comma = 10; static const int rb = 12; static const int terminator = 13; static const int jump = 15; static const int op3 = 6; static const int start = 53; static const int cycle = 54; /* VERTICAL BAR*/ static const int marker = 124; static int stats = 0; static int atoms = -54; static int identifiers = -54; static int numbers = 0; static int loops = 0; static int looks = 1; static int times = 1; int i, j; int linebase; /*BASE FOR SOURCE LINE (POINTER)*/ int fpos; /*CURRENT POSITION IN SOURCE (POINTER)*/ int fpos1; /*START OF CURRENT ATOM (POINTER)*/ int printpos; /*'LINE-ALREADY-PRINTED' INDIC*/ int line; /*CURRENT LINE NUMBER*/ int nextline; int fmax; /*LAST BYTE IN SOURCE (POINTER)*/ int faultnum; /*FAULTY NUMBER*/ int faultpos; /*FAULTY ATOM POSITION (POINTER)*/ int symcode; /*SYMBOL CODE FOR CURRENT SYMBOL*/ int skipmin; /*=SKIP1MIN OR NLCODE*/ /*%INTEGER GG; !=GRAM(G)*/ int class; /*GRAMMAR CLASS*/ int g; /*INDEX TO GRAM*/ int atom; /*ATOM CODE FOR CURRENT ATOM*/ int atomtype; /*TYPE FOR CURREMT ATOM*/ int atomval; /*'VALUE' FOR CURRENT ATOM*/ int decltype; /*DECLARATION TYPE*/ int modes; /*BIT VECTOR FOR PERMISSIBLE IDENT MODES*/ int dimcount; /*DIMENSION COUNT*/ int constcount; /*CONSTANT COUNT (DOWN)*/ int stringsize; int precision; int lasttype, lastval; int type, val; int np; /*NEST POINTER (INDEX TO NTYPE,NVAL)*/ int ntype[50 + 1]; int nval /*1*/[50 + 1]; /*NEST*/ int linkmax; /*GRAMMAR STACK MAX (INDEX TO LINK)*/ int link[20 + 1]; /*1*/ /*GRAMMAR CONTROL STACK*/ struct blockinf { int stack; int local; int btype; }; int level; /*CURRENT BLOCK LEVEL (MAIN=1)*/ struct blockinf c; /*INFO FOR CURRENT BLOCK*/ struct blockinf hold[12 + 1]; /*1*/ /*INFO FOR GLOBAL BLOCKS*/ int index[255 + 1]; /*HASH INDEX TO IDENT DICT*/ int *head; /*HEAD OF IDENT SEARCH LIST*/ int dpos; /*DICT SEARCH POSITION (POINTER)*/ int dlim; /*DICT LIMIT (POINTER)*/ int newdlim; int dbound; /*DICT UPPER LIMIT (POINTER);*/ int idents; /*POS OF FIRST IDENT IN DECL LIST (POINTER)*/ int recidents; /*POS OF FIRST IDENT IN RECORD LIST (POINTER)*/ int pidentpos; /*POS OF PROCEDURE IDENT (POINTER)*/ int fidentpos; /*POS OF FORMAT IDENT (POINTER)*/ int extind; /*SET BY %EXTERNAL*/ int condind; /*SET FOR START,CYCLE*/ int parmax; /*CURRENT MAX IN PARTYPE*/ int adgram0, link1; /*PRE-COMPUTED GRAMMAR VALUES*/ int appcont; int partype[255 + 1]; /*%OWN*/ /* = 0,*/ /* 0x00000069, 0x01000069, 0x02000069, 0x03000069,*/ /* 0x04000069, 0x05000069, 0x00000029, 0x01000029,*/ /* 0x00000089, 0x00000088, 0x000000F8, 0x02000029,*/ /* 0x07000029, 0x01000088, 0x02000088, 0(236),*/ /* 0xFD000069, 0xFE0001F8, 0x00000000, 0xFF000069*/ int dict[4000 + 1]; /*1*/ /** GRAMMAR AND KEYWORD DICTIONARY GENERATED BY TAKEON PROGRAM*/ static const int punctmin = 43; static const int skip1min = 86; const unsigned char syminit[255 + 1] = { 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 }; short int keydict[487 + 1] = { 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 }; const short int phrase[126 + 1] /*109*/ = { //0(109), 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,0, 257, 249, 368, 430, 264, 269, 286, 298, 335, 345, 0, 452, 237, 374, 381, 0, 420, 437 }; static const int initbase = 472; short int gram[531 + 1] = { 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*/ unsigned char perm[518 + 1] = { 0, 'A','D','D','R',':',0x0B,0x62, 'A','R','C','C','O','S',':',0x07,0x22, 'A','R','C','S','I','N',':',0x07,0x22, 'A','R','R','A','Y',':',0xFC,0xF8, 'A','R','C','T','A','N',':',0x0D,0x22, 'B','Y','T','E','I','N','T','E','G','E','R',':',0x01,0x4A, 'C','H','A','R','N','O',':',0x0E,0x4A, 'C','L','O','S','E','S','T','R','E','A','M',':',0x01,0x06, 'C','O','S',':',0x07,0x22, 'E','X','P',':',0x07,0x22, 'F','R','A','C','P','T',':',0x07,0x22, 'F','R','O','M','S','T','R','I','N','G',':',0x0F,0x82, 'I','M','O','D',':',0x01,0x62, 'I','N','T',':',0x07,0x62, 'I','N','T','P','T',':',0x07,0x62, 'I','N','T','E','G','E','R',':',0x01,0x6A, 'L','E','N','G','T','H',':',0x0A,0x4A, 'L','O','G',':',0x07,0x22, 'L','O','N','G','R','E','A','L',':',0x01,0x1A, 'M','O','D',':',0x07,0x22, 'N','E','W','L','I','N','E',':',0x00,0x06, 'N','E','W','L','I','N','E','S',':',0x01,0x06, 'N','E','W','P','A','G','E',':',0x00,0x06, 'N','E','X','T','I','T','E','M',':',0x00,0x82, 'N','E','X','T','C','H',':',0x00,0x62, 'N','E','X','T','S','Y','M','B','O','L',':',0x00,0x62, 'N','L',':',0x00,0x62, 'P','I',':',0x00,0x22, 'P','R','I','N','T',':',0x0C,0x06, 'P','R','I','N','T','C','H',':',0x01,0x06, 'P','R','I','N','T','F','L',':',0x08,0x06, 'P','R','I','N','T','S','T','R','I','N','G',':',0x09,0x06, 'P','R','I','N','T','S','Y','M','B','O','L',':',0x01,0x06, 'R','A','D','I','U','S',':',0x0D,0x22, 'R','E','A','D',':',0x0B,0x06, 'R','E','A','D','C','H',':',0x0B,0x06, 'R','E','A','D','I','T','E','M',':',0x0A,0x06, 'R','E','A','D','S','T','R','I','N','G',':',0x0A,0x06, 'R','E','A','D','S','Y','M','B','O','L',':',0x0B,0x06, 'R','E','A','L',':',0x01,0x1A, 'R','E','C','O','R','D',':',0x01,0x0A, 'S','E','L','E','C','T','I','N','P','U','T',':',0x01,0x06, 'S','E','L','E','C','T','O','U','T','P','U','T',':',0x01,0x06, 'S','E','T','M','A','R','G','I','N','S',':',0x03,0x06, 'S','H','O','R','T','I','N','T','E','G','E','R',':',0x01,0x5A, 'S','I','N',':',0x07,0x22, 'S','K','I','P','S','Y','M','B','O','L',':',0x00,0x06, 'S','P','A','C','E',':',0x00,0x06, 'S','P','A','C','E','S',':',0x01,0x06, 'S','Q','R','T',':',0x07,0x22, 'S','T','R','I','N','G',':',0x01,0x8A, 'T','A','N',':',0x07,0x22, 'T','O','S','T','R','I','N','G',':',0x01,0x82, 'W','R','I','T','E',':',0x02,0x06 }; auto void printss(void); auto void report(int n); auto void codeatom(void); auto void popcontext(void); auto void define(int disp, int val); auto void fault(int n) { if (faultnum < 0) { faultnum = n; faultpos = fpos1; } } /* GRAM LAYOUT: LINK<9> CLASS<7>*/ int a_value; int a_line; char *a_file; int x_value; int x_line; char *x_file; time1 = cputime(); for (i = 0; i <= 255; i++) { index[i] = 0; } memset(&c, 0, sizeof(struct blockinf)); idents = 0; printpos = 0; precision = 0; level = 0; nextline = 1; faultnum = -1; parmax = 15; adgram0 = (int)&gram[0]; link1 = (((unsigned)gram[1] >> 6) & 1022) + adgram0; appcont = (((unsigned)gram[((unsigned)gram[phrase[112]] >> 7) & 511] >> 6) & 1022) + adgram0; dlim = (int)&dict[1]; dbound = (int)&dict[4000]; fpos = (int)&perm[1] - 1; fmax = (int)&perm[518]; for (i = 1; i <= 54; i++) { symcode = 0; codeatom(); if (atom != ident) { assert(_IMP_MONITOR_); exit(0); } (*(int *)(dlim)) = ((*(unsigned char *)(fpos + 1)) << 8) + (*(unsigned char *)(fpos + 2)); fpos += 2; (*(int *)(dlim + 4)) = 0; (*(int *)(dlim + 8)) = *head; *head = dlim; dlim = newdlim; } c.local = dlim; fpos = fstart - 1; fmax = fpos + fsize; symcode = 0; l1: if (fpos >= fmax) goto ended; linebase = fpos; line = nextline; l3: atom = jump; /*FOR NUMERIC LABEL DETECTION*/ skipmin = skip1min; /*TO IGNORE NULL STATEMENTS AND COMMENTS*/ codeatom(); skipmin = nlcode; stats++; extind = 0; decltype = 0; constcount = 0; dimcount = 0; np = 51; linkmax = 1; link[1] = link1; /*FOR GRATUITOUS PHRASE EXIT*/ i = gram[initbase + atom]; if (i == 0) goto err; g = (((unsigned)i >> 6) & 1022) + adgram0; { a_value = atom; a_line = __LINE__; a_file = __FILE__; goto a_despatch; } a_1: /*IDENT*/ a_6: /*OP3*/ a_9: /*EQ*/ a_13: /*NL*/ a_25: /*COLON*/ i = (*(short int *)(g)); g = (((unsigned)i >> 6) & 1022) + adgram0; { a_value = i & 127; a_line = __LINE__; a_file = __FILE__; goto a_despatch; } 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: codeatom(); on: rep: for (;;) { /* LOOPS = LOOPS+1*/ class = (*(short int *)(g)) & 127; if (class >= 60 || class == atom) break; g += 2; } g = (((unsigned)(*(short int *)(g)) >> 6) & 1022) + adgram0; { a_value = class; a_line = __LINE__; a_file = __FILE__; goto a_despatch; } 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++; if (linkmax > 20) goto err; link[linkmax] = g; g = (phrase[class] << 1) + adgram0; goto rep; a_66: Exit: g = link[linkmax]; linkmax--; goto rep; a_67: /*ALT (ALTERNATIVE PHRASE RECOGNISED)*/ i = (*(short int *)(link[linkmax])); linkmax--; if ((i & 127) != 0) goto err; /*NO ALTERNATIVE*/ g = (((unsigned)i >> 6) & 1022) + adgram0; goto on; a_68: /*BREAK (TERMINATOR WITHIN CONST LIST)*/ if (faultnum >= 0) report(faultnum); if (atomtype == 0) { /*NL*/ linebase = fpos; line = nextline; } goto code; unknown: while (dpos < 0) { if (strcmp(((char *)(-dpos) + 4), ((char *)dlim + 12)) == 0) goto ignore; dpos = (*(int *)(-dpos)); } fault(2); for (;;) { dbound -= 4; newdlim -= 4; if (newdlim == (dlim + 8)) break; (*(int *)(dbound)) = (*(int *)(newdlim)); } // while (*head > 0) head = (*(int *)(*head + 8)); while (*head > 0) head = (int *)(*head + 8); (*(int *)(dbound)) = *head; *head = -dbound; goto ignore; moderr: fault(3); goto ignore; a_0: a_64: err: faultnum = 0; if (atom == 0) faultnum = atomtype; if (faultnum == 99) goto disaster; faultpos = fpos1; ignore: while (atom != terminator) { i = atom; codeatom(); } if (i == start) c.stack = (c.stack << 2) + 3; if (i == cycle) c.stack = (c.stack << 2) + 2; if (faultnum >= 0) report(faultnum); while (i == comma && atomtype == 0) { do { i = atom; codeatom(); } while (atom != terminator); } a_69: /*FIN*/ fin: if (faultnum >= 0) report(faultnum); if ((c.btype & 1) != 0) { /*PSEUDO BLOCK ENTRY FOR SPEC*/ dlim = c.local; c = hold[level]; level--; } if (atomtype != 0) goto l3; /*COLON OR SEMI-COLON*/ goto l1; /*NEWLINE*/ disaster: fprintf(out_file, "%s", "** SPACE EXHAUSTED AT LINE"); fprintf(out_file, "%2d", nextline); fprintf(out_file, "%s", "\n"); return; a_74: napp: if ((type & appmask) == 0) goto on; goto err; er20: fault(20); goto napp; er22: fault(22); goto napp; a_22: /*PREC*/ precision = atomtype; goto code; a_38: /*EXTERNAL*/ a_42: /*SYSTEM,DYNAMIC*/ extind = 1; goto code; a_70: /*RESET*/ decltype = 0; goto 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 ^= atomtype; if ((decltype & 0xF0) == 0x10) decltype |= precision; idents = dlim; modes = ~0; /*FOR SPEC LOOKS*/ goto code; a_75: /*NOTYPE*/ decltype = 0xF9; /* '?' VAR*/ goto on; a_78: /*IDENT: DC (DECLARE RECORD COMPONENT)*/ //head = (*(int *)(fidentpos + 4)); head = (int *)(fidentpos + 4); dpos = *head; /*ALTER SEARCH LIST*/ a_76: /*IDENT: D (DECLARE)*/ d1: if ((c.btype & 1) != 0) goto add; /*WITHIN SPEC PARAMS*/ d2: for (;;) { if (dpos < c.local) goto new; if (strcmp(((char *)dpos + 12), ((char *)dlim + 12)) == 0) break; dpos = (*(int *)(dpos + 8)); } if ((((*(int *)(dpos)) & 0xFF) - 1) == decltype && (decltype & 6) != 0 && (decltype & 1) == 0) goto d5; fault(5); /*DUPLICATE*/ new : (*(int *)(dlim + 8)) = *head; *head = dlim; add: (*(int *)(dlim)) = decltype; (*(int *)(dlim + 4)) = 0; dlim = newdlim; goto code; /*PROCEDURE BODY AFTER SPEC, LABEL AFTER JUMP*/ d5: if (decltype == lab) (*(int *)(dpos)) = decltype; idents = dpos; goto code; a_77: /*IDENT: DF (DECLARE RECORD FORMAT)*/ decltype = recformat; fidentpos = dlim; goto d1; a_2: /*CONST*/ type = atomtype; val = atomval; goto code; a_3: /*SUB (ABSORBS FOLLOWING IDENT)*/ if ((type & 0xFFF4) != 0 && type != recformat) goto err; /*NOT RECORD*/ codeatom(); if (atom != ident) goto err; if (val == 0) goto ignore; dpos = val; head = &val; a_81: /*IDENT: LOOK*/ look: looks++; for (;;) { times++; if (dpos <= 0) goto unknown; if (strcmp(((char *)dpos + 12), ((char *)dlim + 12)) == 0) break; dpos = (*(int *)(dpos + 8)); } type = (*(int *)(dpos)); val = (*(int *)(dpos + 4)); if ((modes << (type & 15)) < 0) goto code; goto moderr; a_82: /*IDENT: IMP1LOOK*/ modes = imp1modes; if ((*(unsigned char *)(fpos)) != ':') goto look; decltype = lab; goto d2; a_83: /*IDENT: IMPLOOK*/ modes = impmodes; goto look; a_84: /*IDENT: EXPLOOK*/ modes = expmodes; goto look; a_85: /*IDENT: FLOOK*/ modes = fmatmodes; goto look; a_86: /*IDENT: JLOOK*/ while (dpos >= c.local) { if (strcmp(((char *)dpos + 12), ((char *)dlim + 12)) == 0) goto jl1; dpos = (*(int *)(dpos + 8)); } (*(int *)(dlim + 8)) = *head; *head = dlim; (*(int *)(dlim)) = jumplab; (*(int *)(dlim + 4)) = 0; dpos = dlim; dlim = newdlim; jl1: type = (*(int *)(dpos)); if ((type & 14) == lab) goto code; goto moderr; a_79: /*RECSPEC*/ if ((type & 0xF4) != 0 || val != 0 || dpos < c.local) goto moderr; recidents = -dpos; goto on; a_88: /*FSET*/ idents = recidents; if (idents >= 0) define(4, (*(int *)(dpos + 4))); else (*(int *)((-idents) + 4)) = (*(int *)(dpos + 4)); goto on; a_80: /*PROCSPEC*/ if ((type & 0xFF03) != fn || dpos < c.local) goto moderr; idents = dpos; goto on; a_72: /*BEG*/ pidentpos = idents; level++; if (level > 12) goto disaster; hold[level] = c; c.btype = decltype; c.stack = 0; c.local = dlim; goto on; a_89: /*NL: PARSET*/ idents = c.local; np = 51; while (idents != dlim) { np--; ntype[np] = (*(int *)(idents)); idents = (((*(unsigned char *)(idents + 12)) & (~3)) + idents) + 16; } i = 0; while (np != 51) { j = (i << 24) + ntype[np]; np++; do i++; while (i <= parmax && partype[i] != j); if (i > parmax) { if (i == 252) goto disaster; parmax = i; partype[i] = j; } } if ((c.btype & 1) == 0 && ((*(int *)(pidentpos)) & 1) != 0) { if ((*(unsigned char *)(pidentpos + 2)) != i) fault(18); (*(int *)(pidentpos)) = c.btype; } (*(unsigned char *)(pidentpos + 2)) = i; (*(int *)(pidentpos)) = (*(int *)(pidentpos)) & (~extind); goto fin; a_90: /*INIT*/ constcount--; if ((type & 15) != 0) goto er20; if ((type & decltype) == 0) goto er22; /*RANGE CHECK*/ if ((decltype & 15) == 0) define(4, val); goto on; a_91: /*NL: INITFIN*/ if (constcount != 0 && constcount < 1000000) fault(21); goto fin; a_92: /*DIMSET*/ define(0, dimcount); dimcount = 0; goto on; a_93: /*COLON: COUNT*/ if (dimcount == 6) fault(23); else dimcount++; goto code; a_94: /*REP*/ constcount = (constcount - val) + 1; goto on; a_95: /*LITINT*/ if ((type & 15) != 0) goto er20; a_96: /*INT*/ if ((type & intbit) == 0) goto er22; goto napp; a_97: /*STR*/ if ((type & stringbit) == 0) goto er22; goto napp; a_98: /*SIZESET*/ stringsize = val; if ((0 < val) && (val <= 255)) goto on; fault(19); stringsize = 255; goto on; a_99: /*CBSET*/ lastval = nval[np]; np++; if ((-32768 > lastval) || (lastval > 32767)) goto cberr; constcount = (val - lastval) + 1; if ((0 >= constcount) || (constcount >= 32767)) goto cberr; if (decltype == Switch) { do { j = dbound; dbound = j - (((unsigned)(constcount + 63) >> 5) << 2); if (dbound <= dlim) goto disaster; (*(int *)(idents + 4)) = dbound; (*(int *)(dbound)) = (lastval << 16) + constcount; for (;;) { j -= 4; if (j == dbound) break; (*(int *)(j)) = 0; } idents = (((*(unsigned char *)(idents + 12)) & (~3)) + idents) + 16; } while (idents != dlim); } cb1: idents = dlim; goto on; cberr: fault(23); constcount = 2000000; goto cb1; a_100: /*COLON: LAB*/ if (decltype != 0) goto fin; /*SIMPLE LABEL*/ if (type != jumplab) goto err; /*IE SWITCH + APP*/ if ((lasttype & 15) != 0) { fault(20); goto fin; } if (val == 0) goto fin; j = lastval - (*(short int *)(val)); if ((0 > j) || (j > (*(short int *)(val + 2)))) { fault(19); goto fin; } i = val + (((unsigned)j >> 5) << 2); j = (unsigned)0x80000000 >> (j & 31); if (((*(int *)(i + 4)) & j) != 0) fault(16); (*(int *)(i + 4)) = (*(int *)(i + 4)) | j; goto fin; a_101: /*OP3: DOT*/ if (atomtype != stringbit) goto err; /*IE OP3 # '.'*/ a_60: /*FOR*/ modes = destmodes; goto code; a_73: /*RESOL*/ if ((type & stringbit) == 0) goto er22; modes = destmodes; goto on; a_102: /*OP3: SIGN*/ if ((atomtype & 3) == 0) goto err; /*IE OP3 # '+', '-', '!'*/ type = atomtype; val = 0; goto op1; a_7: /*UOP*/ type = atomtype; val = -1; goto op1; a_8: /*COP*/ a_4: /*OP1*/ a_5: /*OP2*/ a_104: /*OP3 OR EQ: OP*/ if ((type & appmask) != 0) goto err; if ((type & 0xFF4F) == intbit) type |= 15; else type &= ~15; if ((type & numbits) != 0) type |= realbits; op1: np--; ntype[np] = type & atomtype; nval[np] = val; goto code; a_105: /*EVAL*/ if ((type & appmask) != 0) goto err; if ((type & numbits) != 0) type |= realbits; i = ntype[np]; np++; j = (i & type) & 0xF0; if (j == 0) goto er22; if ((type & 0xFF4F) == intbit) { x_value = i & 15; x_line = __LINE__; x_file = __FILE__; goto x_despatch; } x_0: type = j + exp; goto on; x_1: val += nval[np - 1]; x1: type = numbits; goto on; x_2: val = nval[np - 1] - val; goto x1; x_3: val |= nval[np - 1]; goto x1; x_4: val ^= nval[np - 1]; goto x1; a_103: /*BAR (FIDDLE FOR MOD-SIGN)*/ if (ntype[np] != 0x43) goto on; if (atom != op3 || atomtype != 0x43) goto err; np++; codeatom(); goto Exit; a_106: /*EQ: ASSOP*/ if ((type & 0xFF0C) != 8) goto err; save: np--; ntype[np] = type; nval[np] = val; goto code; a_14: /*EQEQ*/ modes = adrmodes; if ((type & 15) == ref) goto save; goto err; a_107: /*ASS*/ i = ntype[np]; np++; as1: if (((i & type) & 0xC0) == 0) { i &= 0xF0; if (i == 0) { /*RECORD*/ if ((type & 0xF0) != 0 && ((type & 0xFF4F) != intbit || val != 0)) goto er22; } else { if (i > 0x30 || (type & numbits) == 0) goto er22; } } goto napp; a_108: /*REFASS*/ i = ntype[np]; np++; ra1: if ((((i ^ type) & 0xF0)) != 0 && (i & 0xF0) != 0xF0 && (type & 0xF0) != 0xF0) fault(22); if ((i & appmask) == 0) goto napp; /*SCALAR*/ if ((type & appmask) == 0 || (type & 14) == map) fault(22); goto on; a_17: /*RESULT*/ if ((c.btype & 7) != fn) fault(25); type = c.btype & 0xF8; if ((type & 8) == 0) type += var; val = 0; goto code; a_71: /*RCALL*/ if ((type & 0xFFFC) == 4) goto on; goto err; a_112: /*APP*/ if (atom != lb) goto on; linkmax++; if (linkmax > 20) goto err; link[linkmax] = g; np--; nval[np] = val; ap: if ((type & appmask) == 0) goto err; ntype[np] = type; g = appcont; codeatom(); j = partype[(unsigned)type >> 8] & 15; class = 122; /*EXP*/ if (j == var) goto enter; class = 111; modes = adrmodes; if (j == ref) goto enter; modes = (unsigned)0xC0000000 >> j; goto enter; a_63: /*AP*/ j = ntype[np]; i = partype[(unsigned)j >> 8]; lasttype = type; lastval = val; type = ((unsigned)i >> 16) + (j & 0xFF); if (atom == comma) goto ap; if (atom != rb) goto err; val = nval[np]; np++; if ((type & appmask) != 0) { type ^= appmask; if ((type & 0xFE00) != 0) goto err; } type = (type & 0xFFFC) | 1; codeatom(); goto Exit; a_16: /*SIMP: STOP(0), RETURN(1), EXIT(2)*/ if ((atomtype == 1 && (c.btype & 15) != routine) || (atomtype == 2 && ((((c.stack ^ 0x55555555) << 1) & c.stack)) == 0)) fault(25); goto code; a_54: /*CYCLE*/ condind = 2; a_53: /*START*/ c.stack = (c.stack << 2) + condind; goto code; a_55: /*FINISH(1)*/ a_56: /*REPEAT(0)*/ condind = c.stack & 3; if (condind == 0 || (((condind ^ atomtype) & 1)) != 0) fault(12 + atomtype); else c.stack = (unsigned)c.stack >> 2; goto code; a_52: /*ELSE(1)*/ if (condind == 1) fault(25); a_26: /*CWORD(3)*/ a_51: /*ON(1)*/ condind = atomtype; goto code; a_58: /*END*/ if (level == 0 || (level == 1 && c.btype == 0)) fault(11); else popcontext(); goto code; a_59: /*ENDPROG*/ fpos1 = fpos; if (level > atomtype) report(8); if (level < atomtype) report(11); while (level > 0) popcontext(); time2 = cputime(); goto endok; ended: time2 = cputime(); fprintf(out_file, "%s", "** END OF FILE AT LINE"); fprintf(out_file, "%2d", nextline); fprintf(out_file, "%s", "\n"); endok: if ((*parm & 4) != 0) { fprintf(out_file, "%5d", line); fprintf(out_file, "%c", 'L'); fprintf(out_file, "%5d", stats); fprintf(out_file, "%c", 'S'); if (stats == 0) stats = 1; fprintf(out_file, " %f", ((double)atoms) / ((double)stats)); fprintf(out_file, "%c", 'A'); fprintf(out_file, " %f", ((double)numbers) / ((double)stats)); fprintf(out_file, "%c", 'N'); fprintf(out_file, " %f", ((double)identifiers) / ((double)stats)); fprintf(out_file, "%c", 'I'); fprintf(out_file, " %f", ((double)loops) / ((double)stats)); fprintf(out_file, "%c", 'C'); fprintf(out_file, " %f", ((double)times) / ((double)looks)); fprintf(out_file, "%c", 'H'); fprintf(out_file, " %f", (((time2 - time1) * ((double)1000)) / ((double)stats))); fprintf(out_file, "%c", 'M'); fprintf(out_file, "%s", "\n"); } if ((*parm & 8) != 0) { for (i = 0; i <= 255; i++) { j = index[i]; if (j > 0) { fprintf(out_file, "%4d", i); fprintf(out_file, "%c", ':'); while (j > 0) { fprintf(out_file, "%s", " "); fprintf(out_file, "%s", ((char *)j + 12)); j = (*(int *)(j + 8)); } fprintf(out_file, "%s", "\n"); } } } return; /**/ auto void printss(void) { int k; auto void write(int v, int p) { if (v >= 10) { write(v / 10, p - 1); v -= 10 * (v / 10); } else { for (_imptempint = 1; _imptempint <= p - 1; _imptempint++) fprintf(out_file, " "); } fprintf(out_file, "%c", v + '0'); } write(line, 4); fprintf(out_file, "%s", " "); printpos = linebase; do { printpos++; if (printpos == faultpos) fprintf(out_file, "%c", marker); k = (*(unsigned char *)(printpos)); if (k == nl || (32 <= k) && (k <= 126)) fprintf(out_file, "%c", k); else { fprintf(out_file, "%c", '['); write(k, 0); fprintf(out_file, "%c", ']'); } } while (printpos != fpos1); if (k != nl) fprintf(out_file, "%s", "\n"); } auto void report(int n) { int s_value; int s_line; char *s_file; if (n > 7) faultpos = 0; if (printpos != fpos1) printss(); fprintf(out_file, "%c", '*'); { s_value = n; s_line = __LINE__; s_file = __FILE__; goto s_despatch; } s_0: fprintf(out_file, "%s", "FORM?"); goto f; s_1: fprintf(out_file, "%s", "ATOM?"); goto f; s_2: fprintf(out_file, "%s", "NAME?"); goto f; s_3: fprintf(out_file, "%s", "MODE?"); goto f; s_4: fprintf(out_file, "%s", "SIZE?"); goto f; s_11: fprintf(out_file, "%s", "%BEGIN"); goto m; s_12: fprintf(out_file, "%s", "%CYCLE"); goto m; s_13: fprintf(out_file, "%s", "%START"); goto m; s_8: fprintf(out_file, "%s", "%END"); goto m; s_9: fprintf(out_file, "%s", "%REPEAT"); goto m; s_10: fprintf(out_file, "%s", "%FINISH"); goto m; s_15: fprintf(out_file, "%c", '\''); fprintf(out_file, "%s", ((char *)dpos + 12)); fprintf(out_file, "%c", '\''); m: fprintf(out_file, "%s", " MISSING"); goto f; s_23: fprintf(out_file, "%s", "BOUNDS?"); goto f; s_25: fprintf(out_file, "%s", "CONTEXT?"); goto f; s_5: s_16: fprintf(out_file, "%s", "DUPLICATE"); goto f; s_17: fprintf(out_file, "%s", "ORDER?"); goto f; s_18: fprintf(out_file, "%s", "MATCH?"); goto f; s_19: fprintf(out_file, "%s", "RANGE?"); goto f; s_20: fprintf(out_file, "%s", "LITERAL?"); goto f; s_21: if (constcount < 0) { fprintf(out_file, "%2d", -constcount); fprintf(out_file, "%s", " EXTRA"); } else { fprintf(out_file, "%2d", constcount); fprintf(out_file, "%s", " MISSING"); } fprintf(out_file, "%s", " VALUE(S)"); goto f; s_22: fprintf(out_file, "%s", "TYPE?"); goto f; f: fprintf(out_file, "%s", "\n"); faultnum = -1; *parm |= 0x80000000; goto s_skip; s_despatch: switch (s_value) { case 0: goto s_0; case 1: goto s_1; case 2: goto s_2; case 3: goto s_3; case 4: goto s_4; case 11: goto s_11; case 12: goto s_12; case 13: goto s_13; case 8: goto s_8; case 9: goto s_9; case 10: goto s_10; case 15: goto s_15; case 23: goto s_23; case 25: goto s_25; case 5: goto s_5; case 16: goto s_16; case 17: goto s_17; case 18: goto s_18; case 19: goto s_19; case 20: goto s_20; case 21: goto s_21; case 22: goto s_22; default: BADSWITCH(s_value, s_line, s_file); } s_skip:; } auto void codeatom(void) { /*%REGISTER FP(5); !FILE POS*/ int fp; /*%REGISTER SC(6); !SYMCODE OR SYM*/ int sc; int i, j, k, l; int hash; atoms++; fp = fpos; sc = symcode; if (sc != 0) goto c2; c1: do { fp++; sc = (*(unsigned char *)(fp)); } while (sc == ' '); sc = syminit[sc]; c2: fpos1 = fp; if (sc < 127) goto namenum; sc -= 128; if (sc > 0) goto keyword; if (sc != 0) goto quotemark; /*PERCENT*/ fp++; sc = syminit[(*(unsigned char *)(fp)) | 128]; if (sc != 0) goto c2; goto c1; /*LOCATE ATOM IN FIXED DICT*/ /*KEYDICT := MORE<5> : LINK<9> : SYM-32<6>*/ /* OR CLASS<7> : 0<6>*/ /* THEN SUBCLASS<16>*/ keyword: if (sc >= skipmin) goto nlq; /*NL OR EQUIVALENT*/ i = sc; l = 0; if (sc < punctmin) l = 128; for (;;) { for (;;) { fp++; k = (*(unsigned char *)(fp)); sc = syminit[k | l]; if ((sc & 127) != 0) break; l = sc; } if ((sc & 128) != 0) k -= 32; for (;;) { j = keydict[i]; if (j >= 0 || (j & 63) == k) break; i++; } if ((j & 63) != k) break; i = ((unsigned)j >> 6) & 511; } if ((j & 63) != 0) goto err; atomtype = keydict[i + 1] & 0xFFFF; atom = (unsigned)j >> 6; if (atom == 0) goto key5; fin: fpos = fp; symcode = sc; return; key5: if (atomtype != 0) { /*%COMMENT*/ if (skipmin != skip1min) goto fin; goto skp; } if ((*(unsigned char *)(fp)) != nl) goto err; nextline++; if (fp >= fmax) goto term; goto c1; nlq: if (skipmin != skip1min) goto term; /*NOT LEADING ATOM*/ skp: fp--; do { fp++; sc = (*(unsigned char *)(fp)); } while (sc != nl && sc != ';'); if (sc == nl) { if (fp >= fmax) goto term; linebase = fp; nextline++; line = nextline; } goto c1; term: atom = terminator; atomtype = 0; nextline++; sc = 0; if (fp >= fmax) sc = 255; goto fin; disaster: atomtype = 99; goto er1; stringerr: atomtype = 4; nextline = l; er1: fp = fpos1; sc = 0; goto er2; err: atomtype = 1; er2: atom = 0; goto fin; namenum: if (sc <= '9' && atom != jump) goto number; if ((*(unsigned char *)(fp + 1)) == '\'') { if (sc == 'X') goto hex; if (sc == 'K') goto oct; if (sc == 'B') goto bin; if (sc == 'M') goto multi; } j = dlim; if ((j + 84) >= dbound) goto disaster; hash = 0; do { if (sc != 0) { j++; (*(unsigned char *)(j + 12)) = sc; hash = (hash << 1) ^ sc; } fp++; sc = syminit[(*(unsigned char *)(fp))]; } while (sc <= 'Z'); (*(unsigned char *)(dlim + 12)) = j - dlim; newdlim = (j & (~3)) + 16; head = &index[hash & 255]; dpos = *head; atom = ident; identifiers++; goto fin; number: atomtype = numbits; atomval = sc - '0'; for (;;) { fp++; sc = syminit[(*(unsigned char *)(fp))]; if (sc > '9') break; if (sc != 0 && atomval < 1000000) atomval = ((((atomval << 2) + atomval) << 1) + sc) - '0'; } if ((*(unsigned char *)(fp)) == '.') { do { fp++; sc = syminit[(*(unsigned char *)(fp))]; } while (sc <= '9'); atomtype = realbits; } if ((*(unsigned char *)(fp)) == '@') { do { fp++; sc = (*(unsigned char *)(fp)); } while (sc == ' '); if (sc == '-') { do { fp++; sc = (*(unsigned char *)(fp)); } while (sc == ' '); } sc = syminit[sc]; if (sc > '9') goto err; do { fp++; sc = syminit[(*(unsigned char *)(fp))]; } while (sc <= '9'); atomtype = realbits; } nn: atom = Const; numbers++; goto fin; multi: fp++; atomtype = numbits; goto q1; quotemark: atomtype = stringbit; q1: k = (*(unsigned char *)(fp)); j = -1; l = nextline; atomval = 0; for (;;) { fp++; sc = (*(unsigned char *)(fp)); if (sc == nl) { nextline++; if (fp >= fmax) goto term; } if (sc == k) { if (sc != (*(unsigned char *)(fp + 1))) break; fp++; } atomval = (atomval << 8) + sc; j++; if (j == 255) goto stringerr; } if (atomtype == stringbit) { /*IE NOT MULTI*/ atomval = (j << 8) + (atomval & 255); if (j == 0) atomtype = stringbit + numbits; } sc = 0; goto nn; hex: j = 4; goto rad; oct: j = 3; goto rad; bin: j = 1; rad: fp++; atomtype = numbits; atomval = 0; for (;;) { fp++; sc = (*(unsigned char *)(fp)); if (sc == '\'') break; k = sc - '0'; if (k >= ('A' - '0')) k += ('0' - 'A') + 10; if (((unsigned)k >> j) != 0) goto err; atomval = (atomval << j) + k; } sc = 0; goto nn; } /*CODE ATOM*/ auto void popcontext(void) { int i; dpos = c.local; fpos1 = fpos; while (dpos != dlim) { i = (*(int *)(dpos)); if (i != recformat) { if ((i & 1) != 0 && (i & 6) != 0) report(15); } else { if ((*(int *)(dpos + 4)) != 0) dpos = (*(int *)(dpos + 4)); } dpos = (((*(unsigned char *)(dpos + 12)) & (~3)) + dpos) + 16; } while (c.stack != 0) { report((c.stack & 1) + 9); c.stack = (unsigned)c.stack >> 2; } dlim = c.local; c = hold[level]; level--; for (i = (int)&index[0]; i <= (int)&index[255]; i += 4) { while ((*(int *)(i)) >= dlim) (*(int *)(i)) = (*(int *)((*(int *)(i)) + 8)); } } auto void define(int disp, int val) { while (idents != dlim) { if (disp != 0) (*(int *)(idents + 4)) = val; else (*(unsigned char *)(idents + 2)) = val; idents = (((*(unsigned char *)(idents + 12)) & (~3)) + idents) + 16; } } goto x_skip; x_despatch: switch (x_value) { case 0: goto x_0; case 1: goto x_1; case 2: goto x_2; case 3: goto x_3; case 4: goto x_4; default: BADSWITCH(x_value, x_line, x_file); } x_skip:; goto a_skip; a_despatch: switch (a_value) { case 1: goto a_1; case 6: goto a_6; case 9: goto a_9; case 13: goto a_13; case 25: goto a_25; case 10: goto a_10; case 11: goto a_11; case 12: goto a_12; case 15: goto a_15; case 18: goto a_18; case 19: goto a_19; case 20: goto a_20; case 21: goto a_21; case 23: goto a_23; case 27: goto a_27; case 37: goto a_37; case 43: goto a_43; case 44: goto a_44; case 45: goto a_45; case 47: goto a_47; case 48: goto a_48; case 50: goto a_50; case 57: goto a_57; case 65: goto a_65; case 109: goto a_109; case 110: goto a_110; case 111: goto a_111; case 113: goto a_113; case 114: goto a_114; case 115: goto a_115; case 116: goto a_116; case 117: goto a_117; case 118: goto a_118; case 119: goto a_119; case 120: goto a_120; case 121: goto a_121; case 122: goto a_122; case 123: goto a_123; case 124: goto a_124; case 125: goto a_125; case 126: goto a_126; case 66: goto a_66; case 67: goto a_67; case 68: goto a_68; case 0: goto a_0; case 64: goto a_64; case 69: goto a_69; case 74: goto a_74; case 22: goto a_22; case 38: goto a_38; case 42: goto a_42; case 70: goto a_70; case 36: goto a_36; case 29: goto a_29; case 30: goto a_30; case 31: goto a_31; case 32: goto a_32; case 33: goto a_33; case 34: goto a_34; case 35: goto a_35; case 39: goto a_39; case 40: goto a_40; case 41: goto a_41; case 75: goto a_75; case 78: goto a_78; case 76: goto a_76; case 77: goto a_77; case 2: goto a_2; case 3: goto a_3; case 81: goto a_81; case 82: goto a_82; case 83: goto a_83; case 84: goto a_84; case 85: goto a_85; case 86: goto a_86; case 79: goto a_79; case 88: goto a_88; case 80: goto a_80; case 72: goto a_72; case 89: goto a_89; case 90: goto a_90; case 91: goto a_91; case 92: goto a_92; case 93: goto a_93; case 94: goto a_94; case 95: goto a_95; case 96: goto a_96; case 97: goto a_97; case 98: goto a_98; case 99: goto a_99; case 100: goto a_100; case 101: goto a_101; case 60: goto a_60; case 73: goto a_73; case 102: goto a_102; case 7: goto a_7; case 8: goto a_8; case 4: goto a_4; case 5: goto a_5; case 104: goto a_104; case 105: goto a_105; case 103: goto a_103; case 106: goto a_106; case 14: goto a_14; case 107: goto a_107; case 108: goto a_108; case 17: goto a_17; case 71: goto a_71; case 112: goto a_112; case 63: goto a_63; case 16: goto a_16; case 54: goto a_54; case 53: goto a_53; case 55: goto a_55; case 56: goto a_56; case 52: goto a_52; case 26: goto a_26; case 51: goto a_51; case 58: goto a_58; case 59: goto a_59; default: BADSWITCH(a_value, a_line, a_file); } a_skip:; } /*CHECKINNER*/ void check(char *param) { extern void define(char *s); extern char *ssfmessage(void); struct finf { int conad, filesize; char rup, eep, mode, cons, arch; char tran[7]; short filetype, numiperms; int datastart, dataend, pliststr; }; /*%RECORDFORMAT FINF(%INTEGER CONAD,FILESIZE, %BYTEINTEGER RUP, ! EEP,MODE,CONS,ARCH, %STRING(6) TRAN, ! %SHORTINTEGER FILETYPE,NUMIPERMS, ! %INTEGER DATASTART, DATAEND, PLISTPTR)*/ extern void connect(char s[16], int a, int m, int p, struct finf *r, int *f); /*%SYSTEM*/ struct finf r; int i, j, flag; char options[64], out[64]; if (imp_resolve(param, param, "/", out) != 0) strcpy(out, ""); if (imp_resolve(param, param, ",", options) != 0) strcpy(options, ""); connect(param, 0, 0, 0, &r, &flag); if (flag != 0) { fprintf(out_file, "%s", ssfmessage()); return; } if (strcmp(out, "") != 0) { define(imp_concat("ST19,", out)); selectoutput(19); } i = 0; while (i < strlen(options)) { i++; j = options[i - 1]; if (j == 'D') flag |= 8; if (j == 'S') flag |= 4; } checkinner(r.conad + r.datastart, r.dataend - r.datastart, &flag); if (flag >= 0) { fprintf(out_file, "%s", " OK"); fprintf(out_file, "%s", "\n"); } } /*CHECK*/ /* end of automatic translation */