#include "perms.h"
#include <ctype.h>
#include <errno.h>
// This is Hamish Dewar's syntax checker for the subset of Imp80 and Imp77 agreed upon
// by the ERCC and the Department of Computer Science.
// Note the small differences between chimps.imp77 and chimps.imp80 - the latter allows
// the X'nnnn' style of constants, whereas this and chimps.imp77 do not.
// Unfortunately the current Imp to C converter loses comments. That will be fixed
// eventually, the underlying parser does preserve them. I've added them manually
// for now, but not the many comments which comprised of commented-out Imp code...
// This translation is now almost all automatic. The small manual tweaks needed were
// for arrays with non-0 lower bounds, and treating %name parameters to procedures
// properly. See the chimps77.c.PENDING-DIFF file for all changes.
// Obviously a main() harness had to be added as we are not calling this from Vecce or EMAS.
// I'm not entirely sure I know what the params should be. This is just a guess.
// -GT
// IMP syntax checker - based on M68000 IMP compiler
// (qv for fuller annotation)
// Hamish Dewar Computer Science Edinburgh University 1983
//
const int Maxname = 127;
typedef struct Edfile {
int Start1;
int Lim1;
int Start2;
int Lim2;
int Lim;
int Lbeg;
int Fp;
int Change;
int Flag;
int Line;
int Diff;
int Shift;
unsigned char Top;
unsigned char Win;
unsigned char Bot;
unsigned char Min;
unsigned char Row;
unsigned char Col;
_imp_string Name;
} Edfile;
#ifdef EDITOR_SUPPORT
void Edi(Edfile *Main, Edfile *Sec, _imp_string Message); // <---- TO DO!
#endif
void Connectedfile(Edfile *F); // <----
void Disconnectedfile(Edfile *F); /* (unused) */
const _imp_string Permfile = _imp_str_literal("ECCE_PERM");
const int Logbit = 0x00040000; // print log
const int Warnbit = 0x00020000; // print warnings
const int Nonsbit = 0x00010000; // print nonstandard reports
const int Dictlist = 0x00001000; // list dict entries
const int Explist = 0x00000800; // list EXP entries
static int Control;// = Warnbit + Nonsbit; // Had to move initialisation of statics to entry point. C doesn't consider a "const int" to be a constant.
/////////////////////////////////////////////////
void Ecceci(Edfile *Main) {
/////////////////////////////////////////////////
static _imp_string Extraname;
static Edfile Extra = {0};
static Edfile Null = {0};
int Curstart;
int Curlim;
int Nonstop;
static int Change = 0;
// Fault numbers
const int Formerr = 0;
const int Atomerr = 1;
const int Namerr = 2;
const int Caterr = 3;
const int Sizerr = 4;
const int Asserr = 5;
const int Typerr = 6;
const int Duperr = 7;
const int Nostart = 8;
const int Nocycle = 9;
const int Ordererr = 10;
const int Matcherr = 11;
const int Rangerr = 12;
const int Nonliteral = 13;
const int Boundserr = 14;
const int Accesserr = 15;
const int Notinloop = 16;
const int Notinrout = 17;
const int Notinfun = 18;
const int Notinpred = 19;
const int Plexerr = 20;
const int Noif = 21;
const int Nonstand = 22;
const int Notin = 23;
const int Indexerr = 24;
const int Moperr = 27;
const int Noterm = 28;
const int Nonstarter = 29;
const int Nonvar = 30;
const int Nonref = 31;
const int Toomany = 32;
const int Toofew = 33;
const int Unwanted = 34;
const int Noparm = 35;
const int Unending = 37;
const int Selfref = 38;
const int Noend = 40;
const int Nobegin = 41;
const int Idmissing = 42;
const int Nofinish = 43;
const int Norepeat = 44;
const int Counterr = 45;
const int Noresult = 46;
const int Errmax = 46;
const int Point = 64;
const int Warn = 128;
static int Faultnum = 0;
static int Faults = 0; //fault count
const int Maxint = 0x7FFFFFFF;
const int Minint = ~Maxint;
const int Max10 = Maxint / 10;
const int Maxdig = Maxint - Max10 * 10;
const int False = 0;
const int True = 1;
int I;
static int Statements = 0;
//
// Program statistics
//!!!!!!!!!!!!!!!! Operand Representation !!!!!!!!!!!!!!!!!!!
const int Smallmin = -1000;
const int Smallmax = 1000;
const int Litmin = Smallmax + 1;
const int Litmax = Smallmax + 1000;
const int D0 = Litmax + 1;
const int D1 = D0 + 1;
const int D2 = D0 + 2;
const int D6 = D0 + 6;
const int D7 = D0 + 7;
const int A0 = D0 + 8;
const int A1 = A0 + 1;
const int A6 = A0 + 6;
const int A7 = A0 + 7;
const int Inda0 = A0 + 8;
const int Posta0 = Inda0 + 8;
const int Posta7 = Posta0 + 7;
const int Prea0 = Posta0 + 8;
const int Prea7 = Prea0 + 7;
const int Dictmin = Prea0 + 8;
const int Dictmax = Prea0 + 1200;
const int Labmin = Dictmax + 1;
const int Lab1 = Labmin + 1;
const int Labmax = Labmin + 20;
const int Expmin = Labmax + 1;
const int Expmax = Labmax + 300;
const int Undef = Expmax + 1;
const int Ad = 0x4000;
const int Maxdreg = D0 + 4;
const int Maxareg = A0 + 3;
const int D0b = 1;
const int D1b = 2;
const int D2b = 4;
const int A0b = 0x100;
const int A1b = 0x200;
const int A2b = 0x400;
const int Allregs = 0b0000111100011111; //a3:a0 & d4:d0
static int Free;// = Allregs;
const int Nulltype = Dictmin;
const int Recy = Nulltype + 1;
const int Arry = Recy + 1;
const int Stringy = Arry + 1;
const int Realy = Stringy + 1;
const int Inty = Realy + 1;
const int Chartype = Inty + 1;
const int Booltype = Chartype + 1;
const int Falseconst = Booltype + 1;
const int Trueconst = Booltype + 2;
const int Inttype = Trueconst + 1;
const int Shorttype = Inttype + 1;
const int Halftype = Shorttype + 1;
const int Bytetype = Halftype + 1;
const int Mitetype = Bytetype + 1;
const int Bittype = Mitetype + 1;
const int Longinttype = Bittype + 1;
const int Realtype = Longinttype + 1;
const int Longrealtype = Realtype + 1;
const int Puretype = 8191;
const int Direct = 8192;
const int Indirect = 16384;
const int Anyint = Inty + Direct;
const int Anyintvar = Inty + Indirect;
const int Anystring = Stringy + Direct;
const int Anystringvar = Stringy + Indirect;
const int Anyname = Nulltype + Indirect;
static int Dictshown;// = Dictmin;
//!!!!!!!!!!!!!!!!!!!!!!! Big Literals !!!!!!!!!!!!!!!!!!!!!!!
static int Litpos;// = Litmin;
static int Slitpos;// = Litmax;
int Litstore[1001+ 1000 /*1001:2000*/];
//
//!!!!!!!!!!!!!!!!!!!!!!!!!! MODE VALUES !!!!!!!!!!!!!!!!!!!!!!!!!
//Size codes:
const int Bytesize = 1;
const int Wordsize = 2;
const int Longsize = 3;
const int Sizemask = 0xC0;
const int Sizeshift = 6;
//Address modes:
const int Dmode = 0;
const int Amode = 0b001000;
const int Indmode = 0b010000;
const int Postmode = 0b011000;
const int Premode = 0b100000;
const int Dispmode = 0b101000;
const int Indexmode = 0b110000;
const int Absmode = 0b111000;
const int Pcmode = 0b111010;
const int Litmode = 0b111100;
const int Ownmode = Dispmode + 6;
// I may not have got these variants correct, however I don't
// think they are ever used to convert data from one form to
// another - rather they're used to save space, which we don't
// care about for now.
/*
%recordformat OBJINFO %C
(%integer flags,type,
(%integer extra, %byteinteger spare,mode %or %integer low),
%integer val) */
//
//!!!!!!!!!!!!!!!!!!!!!!!! Identifiers !!!!!!!!!!!!!!!!!!!!!!!!
//
typedef struct Objinfo {
int Flags;
int Type;
union {
int Extra;
int Low;
};
unsigned char Spare, Mode;
int Val;
} Objinfo;
/*
%recordformat IDENTINFO %C
((%integer flags,type,
(%integer extra, %byteinteger spare,mode %or %integer low),
%integer val %or %record(objinfo) details),
%integer text,link)
*/
typedef struct Identinfo {
union {
struct {
int Flags;
int Type;
union {
int Extra;
int Low;
};
unsigned char Spare, Mode;
int Val;
};
Objinfo Details;
};
int Text;
int Link;
} Identinfo;
//
// Significance of FLAGS:
const int Var = 0x0001;
const int Lab = 0x0002;
const int Proc = 0x0004;
const int Static = 0x0008;
const int Spec = 0x0010;
const int Ext = 0x0020;
const int Parm = 0x0040;
const int More = 0x0080;
const int Typeid = 0x0100;
const int Okflag = 0x0200;
const int Alt = 0x0800;
const int Rflag = 0x1000;
const int Wflag = 0x2000;
//
// Significance of VAL:
// for literal : the actual value
// for variable : machine address (displacement)
// for undefined label : reference chain
// for undefined procedure : "
// for base type : (index to) range
// for record type : size of record in bytes
//
// Identifier dictionary:
Identinfo Dict[2001+ 1254 /*2001:3254*/];
// indexing DICT:
static int Dlim;// = Trueconst + 1; //dict limit (up)
static int Dlim0;
static int Permlim;// = Dictmin;
static int Dmin;// = Dictmax - 1; //dict upper limit (down)
// Text of identifiers (indexed by _TEXT):
const int Charbound = 6000;
unsigned char Char[6001 /*0:6000*/];
int Charbase;
int Charlim;
int Charmin; //pointers
int Newlen;
// Hash index to DICT:
int Hashindex[256 /*0:255*/];
int *Head; //head of ident search list
//
//!!!!!!!!!!!!!!!!!!!! Complex operands !!!!!!!!!!!!!!!!!!!!!!!
static int Explo;// = Expmax + 1;
static int Oldexplo;// = Expmax + 1;
const int Np0;// = Expmin;
static int Np;
static int Condnp;
static int Instnp;
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!! Keywords and operators !!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//!*!!!!!!! Keyword codes -- used by KEYGEN to produce tables !!
const int End = 1; //end
const int Repeat = 2; //repeat
const int Finish = 3; //finish
const int Else = 4; //else
const int Begin = 5; //begin
const int Exit = 6; //exit_1,continue_0
const int Return = 7; //return
const int Tf = 8; //true_1,false_0
const int Result = 9; //result
const int Stop = 10; //stop
const int Goto = 11; //goto
const int Signal = 12; //signal
const int Monitor = 13; //monitor
const int On = 15; //on
const int Iu = 16; //if_0,unless_1
const int While = 17; //while
const int Until = 18; //until_1
const int For = 19; //for
const int Then = 20; //then
const int Start = 21; //start
const int Cycle = 22; //cycle
const int Keylabel = 23; //label
const int Prefix = 24; //const_9,constant_9,own_8,external_40,system_40,dynamic_40
const int Krange = 25; //short_1,half_2,byte_3,mite_4,bit_5
const int Keylong = 26; //long
const int Keyinteger = 27; //integer
const int Keyreal = 28; //real
const int Keystring = 29; //string
const int Keyrecord = 30; //record
const int Keyformat = 31; //format
const int Fnmap = 32; //fn_0,function_0,map_1
const int Rpred = 33; //routine_0,predicate_1
const int Keyspec = 34; //spec
const int Keyarray = 35; //array
const int Keyname = 36; //name
const int Keyswitch = 37; //switch
const int Of = 38; //of
const int Keyfile = 39; //file
const int Program = 40; //program
const int Keylist = 41; //list
const int Keycontrol = 42; //control
const int Comment = 43; //comment
const int Keyevent = 44; //event
const int Include = 45; //include
const int Alias = 46; //alias
const int Keynot = 47; //not
const int Keyand = 64; //and
const int Keyor = 65; //or
const int Syminit[97+ 26 /*97:122*/] = { [0 ... 96 ] = 0,
2, 15, 27, 57, 64, 87, 118, 122, 126, 1, 1, 141, 154,
168, 175, 184, 1, 199, 230, 270, 278, 1, 288, 1, 1, 1};
const unsigned char Symbol[1+ 292 /*1:292*/] = { 0,
128, 114, 114, 97, 121, 163, 108, 105, 97, 115, 174, 110, 100, 192, 101,
103, 105, 110, 133, 121, 116, 101, 153, 105, 116, 153, 111, 110, 116, 105,
110, 117, 101, 134, 121, 99, 108, 101, 150, 109, 109, 101, 110, 116, 171,
115, 116, 97, 110, 116, 152, 152, 114, 111, 108, 170, 121, 110, 97, 109,
105, 99, 152, 110, 100, 129, 108, 115, 101, 132, 120, 105, 116, 134, 118,
101, 110, 116, 172, 116, 101, 114, 110, 97, 108, 152, 105, 110, 105, 115,
104, 131, 97, 108, 115, 101, 136, 111, 114, 109, 97, 116, 159, 110, 160,
117, 110, 99, 116, 105, 111, 110, 160, 147, 108, 101, 167, 111, 116, 111,
139, 97, 108, 102, 153, 102, 144, 110, 116, 101, 103, 101, 114, 155, 99,
108, 117, 100, 101, 173, 97, 98, 101, 108, 151, 111, 110, 103, 154, 105,
115, 116, 169, 111, 110, 105, 116, 111, 114, 141, 105, 116, 101, 153, 97,
112, 160, 97, 109, 101, 164, 111, 116, 175, 110, 143, 119, 110, 152, 102,
166, 114, 193, 114, 101, 100, 105, 99, 97, 116, 101, 161, 111, 103, 114,
97, 109, 168, 101, 112, 101, 97, 116, 130, 111, 117, 116, 105, 110, 101,
161, 116, 117, 114, 110, 135, 115, 117, 108, 116, 137, 97, 108, 156, 99,
111, 114, 100, 158, 116, 111, 112, 138, 105, 103, 110, 97, 108, 140, 121,
115, 116, 101, 109, 152, 104, 111, 114, 116, 153, 112, 101, 99, 162, 119,
105, 116, 99, 104, 165, 97, 114, 116, 149, 114, 105, 110, 103, 157, 114,
117, 101, 136, 104, 101, 110, 148, 110, 108, 101, 115, 115, 144, 116, 105,
108, 146, 104, 105, 108, 101, 145};
const unsigned char Altdisp[1+ 292 /*1:292*/] = { 0,
0, 5, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 4, 0,
0, 3, 0, 0, 5, 8, 12, 17, 23, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 4, 0, 0, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 40,
3, 0, 0, 4, 0, 0, 0, 4, 8, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 40, 6, 27, 0, 0, 0, 0, 5, 0, 0, 0, 0, 6, 0, 14, 0, 0, 0, 2, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2,
0, 0, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 4, 0,
0, 0, 0, 0, 0, 0, 7, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 1, 4,
0, 0, 0, 0, 0, 0, 2, 0, 3, 0, 8, 2, 0, 0, 0, 0, 8, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 0, 0, 6, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 5, 0, 0, 0, 0, 5, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 4, 30,
0, 0, 6, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 40, 5, 0, 0, 0, 1, 4, 0,
0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 1,
0, 0, 0, 0, 0, 5, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0};
//*!!!!!! end of generated tables !!!!!!!!!!!!!!!!!!!!!!!!!!!
//
const int Terminator = 52;
const int Const = 53;
const int Ident = 54;
const int Aref = 55;
const int Recref = 56;
const int Modsign = 57;
const int Colon = 58;
const int Comma = 59;
const int Right = 60;
const int Rightbracket = 61;
const int Dud = 63;
//Operators (in banks of 8 acc to rank)
const int Booland = 64;
const int Boolor = 65;
const int Boolnot = 66;
const int Float = 67;
const int Imod = 68;
const int Fmod = 69;
const int Equals = 70;
const int Noteq = 71;
const int Lesseq = 72;
const int Less = 73;
const int Greateq = 74;
const int Greater = 75;
const int Eqeq = 76;
const int Noteqeq = 77;
const int Resolve = 79;
const int Plus = 80;
const int Minus = 81;
const int Logor = 82;
const int Logxor = 83;
const int Concat = 84;
const int Mult = 88;
const int Fdiv = 89;
const int Idiv = 90;
const int Logand = 91;
const int Fpower = 96;
const int Ipower = 97;
const int Lshift = 100;
const int Rshift = 101;
const int Lognot = 102;
const int Fcall = 106;
const int Mcall = 107;
const int Atommax = 107;
// Instruction actions:
const int Swgoto = 35;
const int Rcall = Mcall + 2;
const int Assign = 41;
const int Jamassign = 42;
const int Plusass = 43;
const int Compare = 44;
const int Jump = 45;
const int Label = 46;
const int Adecl = 47;
const int Actmax = 49;
//
//Branch cases ( = machine condition-code)
const int Eq = 0b0111;
const int Ne = 0b0110;
const int Gt = 0b1110;
const int Le = 0b1111;
const int Lt = 0b1101;
const int Ge = 0b1100;
const int Cc = 0b0100;
const int Cs = 0b0101;
const int Double = 16;
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// Perm procedure identifiers which are recognised explicitly and
// either implemented in-line or mapped to system entry-point
const int Dshort = Dictmin + 6;
const int Dlength = Dshort + 1;
const int Dcharno = Dlength + 1;
const int Daddr = Dcharno + 1;
const int Dtostr = Daddr + 1;
const int Drem = Dtostr + 1;
const int Dnextsym = Drem + 1;
const int Dreadsym = Dnextsym + 1;
const int Dprintstr = Dreadsym + 3;
const int Dread = Dictmin + 27;
const int Dnewline = Dictmin + 41;
//System entry-points used explicitly
const int Sigentry = 0x1114;
const int Scompentry = 0x1128;
const int Boundentry = 0x1134;
const int Agetentry = 0x1138;
const int Indexentry = 0x113C;
const int Ireadentry = 0x1118;
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
static int Starts = 0;
static int Cycles = 0;
static int Looplab = 0;
static int Curlab;// = Lab1;
//
typedef struct Blockinf {
int Sp;
int Delta;
int Fortemps;
int Flags;
int Type;
int Localdpos;
int Parlim;
int Localtext;
int Localpc;
int Localspc;
int Pidpos;
int Access;
int Forward;
int Events;
int Eventpc;
int Faults;
int Return;
int Shorts;
} Blockinf;
//Flag bits (VAR=1 from D_FLAGS)
const int Wrongcc = 2;
const int Nonlocalref = 4;
const int Dynarray = 8;
const int Hadon = 0x10;
const int Hadinst = 0x20;
const int Outerlevel = 0;
const int Maxlevel = 16;
static int Level;// = Outerlevel; //current block level
Blockinf C; //info for current block
Blockinf Hold[16 /*0:15*/]; //info for global blocks
// Final core image
const int Purebound = 0;
const int Ownbase = Purebound + 1;
const int Finalbound = Ownbase + 8191;
unsigned char Final[8193 /*0:8192*/]; //for switch info only
static int Finalad = 2;
static int Ownad;// = Ownbase;
static int Pc = 0;
static int Spc;// = Finalbound;
//Recognition:-
const int Casemask = 95;
const int Casebit = 32;
//Memo variables for current statement:-
static int Item = 0; //current operand
Objinfo T; //full typeinfo for ITEM
Identinfo *Ditem;
static int Elements; //range details
static int Hash;
static int Speccing = 0;
static int Mcoding = 0;
static int Declmode;
static int Dsize;
static Identinfo D; //declaration details
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// Source file input and listing
static int Atom = 0; //current lexical atom
static int Matched = 1; //indic that atom has been matched
static int Sym = '\n'; //current input symbol
static int Line = 0; //current line number
static int Mainline = 0;
static int Diagline = -9999;
static int Proline = 0;
static int Modesym = '&'; //space or '+' or '&' or '"'
// Pointers to source file:
static int Linestart = 0;
static int Fp = 0; //(file pointer) current position
static int Chars = 0;
static int Atomp = 0; //start of current atom
static int Faultp = 0; //fault position
static int Mainfp;
static int Stringp;
static int Expp;
static int Listout = 0;
//
// Listing, diagnostic and report routines
//
static _imp_string Rep = _imp_str_literal("");
//
#undef Newline // current prims suffer from a small degree of namespace pollution :-(
void Newline(void) {
Printstring(Rep);
Printsymbol('\n');
#ifdef NEVER
Rep = _imp_str_literal("");
#else
*Length(Rep) = 0; *Charno(Rep,1) = '\0';
#endif
}
void Putsym(int K) {
// We can do this a lot more efficiently...
if (*Length(Rep) < 132)
#ifdef NEVER
Rep = _imp_join(Rep, Tostring(K));
#else
{ *Charno(Rep, *Length(Rep)+1) = K&255; *Length(Rep) += 1; *Charno(Rep, *Length(Rep)+1) = '\0'; }
#endif
}
#undef Printstring
void Printstring(_imp_string S) {
if (*Length(Rep) < 132)
Rep = _imp_join(Rep, S);
}
#undef Spaces
void Spaces(int N) {
while (N > 0) {
// These are all really inefficient :-/
Rep = _imp_join(Rep, _imp_str_literal(" "));
N--;
}
}
#undef Write
void Write(int Val, int P) {
void Pd(int V) {
P--;
if (V <= -10) {
Pd(V / 10);
V -= V / 10 * 10;
}
if (P > 0) {
Spaces(P);
P = 0;
}
Putsym('0' - V);
}
if (Val < 0) {
Putsym('-');
Pd(Val);
} else
Pd(-Val);
}
void Report(int N, int Joker) {
int Mark;
int Start;
int Errline;
int K;
int Editfp;
void Printident(int X) {
Putsym('"');
Printstring(*String(Dict[X].Text + Charbase));
Putsym('"');
}
void Printtext(int X, int Stream) {
const int Esc = 27;
int K;
int P;
static int S_sw;
static void *S[47 /*0:46*/] = {
&&S_0, &&S_1, &&S_2, &&S_3, &&S_4, &&S_5, &&S_6,
&&S_7, &&S_8, &&S_9, &&S_10, &&S_11, &&S_12, &&S_13,
&&S_14, &&S_15, &&S_16, &&S_17, &&S_18, &&S_19, &&S_20,
&&S_21, &&S_22, &&S_23, &&S_24, &&S_default, &&S_default, &&S_27,
&&S_28, &&S_29, &&S_30, &&S_31, &&S_32, &&S_33, &&S_34,
&&S_35, &&S_default, &&S_37, &&S_38, &&S_default, &&S_40, &&S_41,
&&S_42, &&S_43, &&S_44, &&S_45, &&S_46,
};
Putsym(Mark);
Write(Line, 4);
Putsym(Modesym);
Putsym(' ');
goto *S[S_sw = N & 63];
S_0: /*formerr*/
Printstring(_imp_str_literal("Faulty form"));
goto Print;
S_1: /*atomerr*/
Printstring(_imp_str_literal("Unknown atom"));
goto Print;
S_2: /*namerr*/
Printstring(_imp_str_literal("Unknown name"));
goto Print;
S_3: /*caterr*/
Printstring(_imp_str_literal("Unsuitable"));
goto Print;
S_4: /*sizerr*/
Printstring(_imp_str_literal("Size"));
goto Print;
S_6: /*typerr*/
Printstring(_imp_str_literal("Wrong type"));
goto Print;
S_14: /*boundserr*/
Printstring(_imp_str_literal("Inside out"));
goto Print;
S_37: /*unending*/
Printstring(_imp_str_literal("Endless loop"));
goto Print;
S_24: /*indexerr*/
Printstring(_imp_str_literal("Index"));
goto Print;
S_15: /*accesserr*/
Printstring(_imp_str_literal("Not accessible"));
goto Print;
S_16: /*notinloop*/
Printstring(_imp_str_literal("Not in loop"));
goto Print;
S_17: /*notinrout*/
Printstring(_imp_str_literal("Not in routine"));
goto Print;
S_18: /*notinfun*/
Printstring(_imp_str_literal("Not in fn/map"));
goto Print;
S_19: /*notinpred*/
Printstring(_imp_str_literal("Not in pred"));
goto Print;
S_20: /*plexerr*/
Printstring(_imp_str_literal("Too complex!"));
goto Print;
S_7: /*duperr*/
Printstring(_imp_str_literal("Duplicate"));
goto Print;
S_10: /*ordererr*/
Printstring(_imp_str_literal("Out of order"));
goto Print;
S_11: /*matcherr*/
Printstring(_imp_str_literal("Mismatch"));
goto Print;
S_12: /*rangerr*/
Printstring(_imp_str_literal("Out of range"));
goto Print;
S_13: /*nonliteral*/
Printstring(_imp_str_literal("Not literal"));
goto Print;
S_22: /*nonstand*/
Printstring(_imp_str_literal("Nonstandard"));
goto Print;
S_23: /*notin*/
Printstring(_imp_str_literal("Not in yet"));
goto Print;
S_27: /*moperr*/
Printstring(_imp_str_literal("Faulty operand"));
goto Print;
S_9: /*nocycle*/
Printstring(_imp_str_literal("Missing %CYCLE"));
goto Print;
S_8: /*nostart*/
Printstring(_imp_str_literal("Missing %START"));
goto Print;
S_21: /*noif*/
Printstring(_imp_str_literal("Missing %IF"));
goto Print;
S_28: /*noterm*/
Printstring(_imp_str_literal("';' missing"));
goto Print;
S_29: /*nonstarter*/
Printstring(_imp_str_literal("Non-starter"));
goto Print;
S_30: /*nonvar*/
Printstring(_imp_str_literal("Not variable"));
goto Print;
S_31: /*nonref*/
Printstring(_imp_str_literal("Not reference"));
goto Print;
S_35: /*noparm*/
Printstring(_imp_str_literal("No parameters"));
goto Print;
S_33: /*toofew*/
Printstring(_imp_str_literal("Too few"));
goto Print;
S_34: /*unwanted*/
Printstring(_imp_str_literal("Unwanted"));
goto Print;
S_32: /*toomany*/
Printstring(_imp_str_literal("Too many"));
goto Print;
S_38: /*selfref*/
Printstring(_imp_str_literal("Self-reference"));
goto Print;
S_41: /*nobegin*/
Printstring(_imp_str_literal("Extra %END"));
goto Print;
Print:;
Spaces(21 - *Length(Rep));
P = Start;
if (P < Faultp - 50) {
P = Faultp - 47;
Printstring(_imp_str_literal("..."));
} else
Putsym(' ');
for (;;) {
K = *Byteinteger(P);
P++;
if (P == Faultp) {
// Highlighting:
//if (!Stream) {
// Putsym(Esc);
// Putsym('F');
//}
Putsym('~');
//if (!Stream) {
// Putsym(Esc);
// Putsym('G');
//}
}
if (K == '\n')
break;
if (' ' <= K && K <= '~')
Putsym(K);
else {
// Non-printable characters:
Putsym('[');
Write(K, -1);
Putsym(']');
}
}
return;
S_40: /*noend*/
Printstring(_imp_str_literal("%END"));
goto Mend;
S_46: /*noresult*/
Printstring(_imp_str_literal("Result"));
goto Mend;
S_43: /*nofinish*/
Printstring(_imp_str_literal("%FINISH"));
goto Mend0;
S_44: /*norepeat*/
Printstring(_imp_str_literal("%REPEAT"));
Mend0:
if (Curlab > Lab1 + 2)
Printstring(_imp_str_literal(" etc"));
goto Mend;
S_42:; /*idmissing*/
do {
Putsym(' ');
Printident(X);
if (!(Dict[X].Flags & Spec))
Printstring(_imp_str_literal("(?)"));
X = Dict[X].Val;
} while (X);
Mend:;
Printstring(_imp_str_literal(" missing"));
if (C.Type) {
Printstring(_imp_str_literal(" at END of "));
Printident(C.Pidpos);
} else
N = 0;
return;
S_45:; /*counterr*/
if (Elements < 0) {
Write(-Elements, 0);
Printstring(_imp_str_literal(" extra"));
} else {
Write(Elements, 0);
Printstring(_imp_str_literal(" missing"));
}
Printstring(_imp_str_literal(" value(s) for "));
Printident(X);
return;
S_5:; /*asserr*/
Printident(X);
Printstring(_imp_str_literal(" void"));
goto S_skip;
S_default:
fprintf(stderr, "Switch label 'S(%d):' not set in %s", S_sw,
__PRETTY_FUNCTION__);
exit(1) /* or %signal ... */;
S_skip:;
}
//fprintf(stderr, "Report %d\n", __LINE__);
//Warning or error
Mark = '?';
if (!(N & Warn)) {
Mark = '*';
C.Faults = C.Faults + 1;
Faults++;
}
Faultnum = 0;
C.Access = -1;
//Ignore uncorrected earlier error
if (Main->Start1 <= Fp && Fp < Change)
return;
//fprintf(stderr, "Report %d\n", __LINE__);
//Track back if before current line
Start = Linestart;
Errline = Line;
if (!(N & Point))
Faultp = 0;
else {
if (Joker > 0)
Faultp = Joker;
while (Faultp <= Start) {
Start--;
if (*Byteinteger(Start) == '\n')
Errline--;
}
while (Start != Curstart && *Byteinteger(Start - 1) != '\n')
Start--;
}
//fprintf(stderr, "Report %d\n", __LINE__);
Editfp = Start;
if (Faultp > Start)
Editfp = Faultp - 1;
if (Curlim == Extra.Lim2)
Editfp = Mainfp;
while (*Byteinteger(Start) == ' ')
Start++;
Printtext(Joker, 0);
//fprintf(stderr, "Report %d\n", __LINE__);
if ((N & Warn) != 0 || Nonstop != 0) {
Newline();
return;
}
Newline();
return;
//#ifdef EDITOR_SUPPORT
Main->Fp = Editfp;
Main->Line = Line;
if (Change)
Main->Change = 0x7FFFFFFE;
//Edi(Main, &Null, Rep);
Rep = _imp_str_literal("");
if (Main->Flag == 'I')
Nonstop = 1;
//fprintf(stderr, "Report %d\n", __LINE__);
if (Main->Flag < 0)
exit(0);
//fprintf(stderr, "Report %d\n", __LINE__);
if (Main->Change < 0x7FFFFFFE) { // change made
//fprintf(stderr, "skip %%SIGNAL 12 at line %d\n", __LINE__); // this is causing ECCE_PERM to be read again! Screw-up in %on %event I think.
_imp_signal(12, 0, 0, _imp_str_literal(""));
}
//#endif
//fprintf(stderr, "Report %d\n", __LINE__);
} // report
void Croak(_imp_string S) {
Printstring(_imp_join(
_imp_str_literal("** "),
_imp_join(S, _imp_str_literal(". Checking abandoned at line "))));
Write(Line, 0);
Newline();
Nonstop = -999;
fprintf(stderr, "%%SIGNAL 12 at line %d\n", __LINE__);
_imp_signal(12, 0, 0, _imp_str_literal(""));
}
void Fault(int N) {
//Note fault number and position of (earliest) fault
// for subsequent reporting (warnings and weak errors)
if (!Faultnum) {
Faultnum = N;
Faultp = Atomp;
}
}
void Expfault(int N) {
if (Faultnum == 0 || Expp < Faultp) {
Faultnum = N | Point;
Faultp = Expp;
}
}
const int Pred = 1;
const int Uparr = 1 << 1;
const int Nocomma = 1 << 2;
const int Overload = 1 << 3;
const int Ranges = 1 << 4;
const int Nolength = 1 << 5;
const int Initass = 1 << 6;
const int Kgoto = 1 << 7;
const int Hyphen = 1 << 8;
const int Naming = 1 << 9;
const int Klabel = 1 << 10;
const int Ibmhex = 1 << 11;
const int Oldcycle = 1 << 12;
const int Loop2 = 1 << 13;
void Nonstandard(int Case) {
static int Hadit = 0;
if ((Control & Nonsbit) != 0 && (Case & Hadit) == 0) {
Hadit += Case;
Fault(Nonstand + Point + Warn);
}
}
void Error(int Case) {
Report(Case, Atomp);
fprintf(stderr, "%%SIGNAL 14 at line %d\n", __LINE__);
_imp_signal(14, 0, __LINE__, _imp_str_literal(""));
}
void Nameerror(void) {
//check if the culprit has occurred before
//and, if not, add it to the pool of unknowns stored at the
//far end of the dictionary.
while (Item < 0
&& _imp_strcmp(*String(Dict[-Item].Text + Charbase), *String(Charlim)) != 0)
Item = Dict[-Item].Link;
if (Item >= 0) { //first time
Report(Namerr + Point, Atomp);
if (Charmin - Newlen - 80 >= Charlim) {
Dmin--;
Charmin = Charmin - Newlen - 1;
*String(Charmin) = *String(Charlim);
Dict[Dmin].Text = Charmin - Charbase;
while (*Head > 0)
Head = &Dict[*Head].Link; //find last link
Dict[Dmin].Link = *Head;
*Head = -Dmin;
}
}
//fprintf(stderr, "%%SIGNAL 14 at line %d\n", __LINE__);
_imp_signal(14, 0, __LINE__, _imp_str_literal(""));
}
void Syntaxerror(void) {
int E;
E = Formerr + Point;
if (Atom == Dud)
E = Atomerr + Point;
Report(E, Atomp);
//fprintf(stderr, "%%SIGNAL 14 at line %d\n", __LINE__);
_imp_signal(14, 0, __LINE__, _imp_str_literal(""));
}
//!!!!!!!!!!!!!!!!!!! CELL CONSTRUCTORS !!!!!!!!!!!!!!!!!!!
int Floated(int Item) {
if (!Item)
return (0);
return (Explo);
}
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!! CODE GENERATION !!!!!!!!!!!!!!!!!!!!!!!!
void Forget(void) {}
void Forgetall(void) {
int I;
int J;
Litpos = Litmin;
Explo = Expmax + 1;
Oldexplo = Explo;
}
//
void Setlabel(int B) {
} //set label
void Setuserlabel(int Dpos) {
}
void Compile(int From, int To) {
Np = Np0;
}
void Compileentry(void) {
}
void Compileend(void) {
} //compile end
//!!!!!!!!!!!!!! end of Code Generation !!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
void Put3(int Act, int X, int Y) {
}
//
void Put2(int Act, int X) {
}
//
int Tempvar(void) {
return (Dlim);
}
void Openblock(int Pidpos) {
Forget(); //a bit extreme
if (Level == Maxlevel)
Croak(_imp_str_literal("Too many levels"));
Hold[Level] = C;
Level++;
C = (Blockinf){0};
Starts = 0;
Cycles = 0;
Curlab = Lab1;
Looplab = 0;
Forgetall();
C.Flags = 0;
C.Type = D.Type;
C.Pidpos = Pidpos;
C.Localdpos = Dlim;
C.Parlim = Dlim;
C.Localtext = Charlim;
C.Localpc = Pc;
C.Localspc = Spc;
C.Access = 1;
} //OPEN BLOCK
void Closeblock(void) {
int I;
int Miss;
int Dpos;
int *P;
Identinfo *Dp;
Miss = 0;
P = &Miss;
Dpos = C.Localdpos;
while (Dpos != Dlim) {
Dp = &Dict[Dpos];
if ((Dp->Flags & (Proc + Lab)) != 0 &&
(Dp->Flags & (Ext + Spec)) == Spec) {
*P = Dpos;
P = &Dp->Val;
*P = 0;
}
Dpos++;
}
if (Miss)
Report(Idmissing, Miss);
Compileend();
Pc = C.Localpc;
Spc = C.Localspc;
Dlim = C.Parlim;
Charlim = C.Localtext;
for (I = 0; I <= 255; I++)
while (Hashindex[I] >= C.Localdpos)
Hashindex[I] = Dict[Hashindex[I]].Link;
Level--;
C = Hold[Level];
Starts = 0;
Cycles = 0;
} //CLOSE BLOCK
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!! Source input !!!!!!!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//
void Switchinput(void) {
if (Fp == Main->Lim2) {
fprintf(stderr, "%%SIGNAL 12 at line %d\n", __LINE__);
_imp_signal(12, 0, 0, _imp_str_literal(""));
}
if (Nonstop < 0) { //perming
Nonstop += 3;
Permlim = Dlim;
C.Localdpos = Dlim;
C.Parlim = Dlim;
Statements = 0;
}
if (Fp != Main->Lim1) {
Nonstop--;
Fp = Mainfp;
Line = Mainline;
Curstart = Main->Start1;
Curlim = Main->Lim1;
} else
Fp = Main->Start2;
if (Main->Start2 <= Fp && Fp <= Main->Lim2) {
Curstart = Main->Start2;
Curlim = Main->Lim2;
}
Modesym = ' ';
Sym = '\n';
}
void Readline(void) {
if (Faultnum)
Report(Faultnum, Faultp);
while (Sym != '\n') {
Sym = *Byteinteger(Fp);
Fp++;
}
while (Fp == Curlim)
Switchinput();
Line++;
Linestart = Fp;
Sym = 0;
} //READ LINE
//
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!! Lexical processing !!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
static int Percent = 0;
static int Subatom = 0;
//
//Aliases:
const int Arrow = Resolve;
const int Exclam = Logor;
const int Exclam2 = Logxor;
const int Dot = Concat;
const int Star = Mult;
const int Slash = Fdiv;
const int Slash2 = Idiv;
const int Ampersand = Logand;
const int Backslash = Fpower;
const int Backslash2 = Ipower;
const int Uparrow = Fpower;
const int Uparrow2 = Ipower;
const int Tilde = Lognot;
const int Left = Aref;
const int Underline = Recref;
const int Leftbracket = 106;
const int Simple = 104;
const int Major = Plus;
const int Scond = Equals;
const int Cond = Keyand;
//
// Type compatibility vectors:
const int Recok = 1 << 0;
const int Arrok = 1 << 1;
const int Stringok = 1 << 2;
const int Realok = 1 << 3;
const int Intok = 1 << 4;
const int Charok = 1 << 5;
const int Boolok = 1 << 6;
const int Enumok = 1 << 7;
const int Setok = 1 << 8;
const int Znop = 1 << 9;
const int Refonly = 1 << 10;
const int Varonly = 1 << 11;
const int Arithok = Intok + Realok;
const int Ordok = Intok + Charok + Boolok + Enumok;
const int Any = Realok + Ordok + Stringok + Arrok + Recok;
//
const int Opbits[64+ 44 /*64:107*/] = { [ 0 ... 63 ] = 0,
/*BOOLAND*/ 64,
/*BOOLOR*/ 64,
/**/ 0, 0, 0, 0,
/*EQUALS*/ 255,
/*NOTEQ*/ 255,
/*LESSEQ*/ 508,
/*LESS*/ 252,
/*GREATEQ*/ 508,
/*GREATER*/ 252,
/**/ 255,
/**/ 255,
/**/ 0,
/*RESOLVE*/ 4,
/*PLUS*/ 792,
/*MINUS*/ 792,
/*LOGOR*/ 528,
/*LOGXOR*/ 528,
/*CONCAT*/ 4,
/**/ 0, 0, 0,
/*MULT*/ 24,
/*FDIV*/ 24,
/*IDIV*/ 16,
/*LOGAND*/ 16,
/**/ 0, 0, 0, 0,
/*FPOWER*/ 24,
/*IPOWER*/ 16,
/**/ 0, 0,
/*LSHIFT*/ 528,
/*RSHIFT*/ 528,
/*LOGNOT*/ 16,
/**/ 0,
/*AREF*/ 2,
/*RECREF*/ 1,
/**/ 0, 0};
//
int Nextatom(void) {
//Encode next atom from source fileEncode next atom from source file
//[Time-critical]
static int S_sw;
static void *S[256 /*0:255*/] = {
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_9,
&&S_10, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_33, &&S_34,
&&S_35, &&S_default, &&S_37, &&S_38, &&S_39,
&&S_40, &&S_41, &&S_42, &&S_43, &&S_44,
&&S_45, &&S_46, &&S_47, &&S_48, &&S_49,
&&S_50, &&S_51, &&S_52, &&S_53, &&S_54,
&&S_55, &&S_56, &&S_57, &&S_58, &&S_59,
&&S_60, &&S_61, &&S_62, &&S_default, &&S_default,
&&S_65, &&S_66, &&S_67, &&S_68, &&S_69,
&&S_70, &&S_71, &&S_72, &&S_73, &&S_74,
&&S_75, &&S_76, &&S_77, &&S_78, &&S_79,
&&S_80, &&S_81, &&S_82, &&S_83, &&S_84,
&&S_85, &&S_86, &&S_87, &&S_88, &&S_89,
&&S_90, &&S_default, &&S_92, &&S_default, &&S_94,
&&S_95, &&S_default, &&S_97, &&S_98, &&S_99,
&&S_100, &&S_101, &&S_102, &&S_103, &&S_104,
&&S_105, &&S_106, &&S_107, &&S_108, &&S_109,
&&S_110, &&S_111, &&S_112, &&S_113, &&S_114,
&&S_115, &&S_116, &&S_117, &&S_118, &&S_119,
&&S_120, &&S_121, &&S_122, &&S_123, &&S_124,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default, &&S_default, &&S_default, &&S_default, &&S_default,
&&S_default,
};
const int Tab = 9;
int I;
int J;
int P;
int Radix;
int Digits;
float Rval;
const unsigned char Map[128 /*0:127*/] = {[0 ... 47] = 0,
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
0, 0, 0, 0, 0, 0, 0,
'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
0, 0, 0, 0, 0, 0,
'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
0, 0, 0, 0, 0};
void Assemblereal(void) {
J = 0;
for (;;) {
do {
Sym = *Byteinteger(Fp);
Fp++;
} while (Sym == ' ');
I = Sym - '0';
if (0 > I || I >= Radix)
return;
Rval = Rval * Radix + I;
J++;
}
}
if (0) {
char *s = (char *)(Fp);
fprintf(stderr, "FP=%d: ", Fp);
while (isalnum(*s)) {
fprintf(stderr, "%c", *s++);
}
fprintf(stderr, "\n");
}
Matched = 0;
Again:
S_9:; /*tab*/
if (Sym == '\n')
Readline();
do {
Sym = *Byteinteger(Fp);
Fp++;
} while (Sym == ' ');
Atomp = Fp; //(actually one after)
goto *S[S_sw = Sym];
Linebreak:
S_10:; /*nl*/
if (Atom != Comma)
return (Terminator);
goto Again;
S_123:; /*{*/
do {
Sym = *Byteinteger(Fp);
Fp++;
if (Sym == '\n')
goto Linebreak;
} while (Sym != '}');
goto Again;
S_43: /*+*/
return (Plus);
S_45: /*-*/
if (*Byteinteger(Fp) == '>') {
Fp++;
return (Arrow);
}
if (*Byteinteger(Fp) == '\n')
goto Again;
return (Minus);
S_42: /* * */
return (Star);
S_47: /* / */
if (*Byteinteger(Fp) == '/') {
Fp++;
return (Slash2);
}
return (Slash);
S_92: /* \ */
if (*Byteinteger(Fp) == '\\') {
Fp++;
return (Backslash2);
}
return (Backslash);
S_94: /*^*/
Nonstandard(Uparr);
if (*Byteinteger(Fp) == '^') {
Fp++;
return (Uparrow2);
}
return (Uparrow);
S_33: /*!*/
if (*Byteinteger(Fp) == '!') {
Fp++;
return (Exclam2);
}
return (Exclam);
S_38: /*&*/
return (Ampersand);
S_46: /*.*/
return (Dot);
S_61: /*=*/
if (*Byteinteger(Fp) == '=') {
Fp++;
return (Eqeq);
}
return (Equals);
S_35: /*#*/
if (*Byteinteger(Fp) == '#') {
Fp++;
return (Noteqeq);
}
return (Noteq);
S_60: /*<*/
if (*Byteinteger(Fp) == '=') {
Fp++;
return (Lesseq);
}
if (*Byteinteger(Fp) == '>') {
Fp++;
return (Noteq);
}
if (*Byteinteger(Fp) == '<') {
Fp++;
return (Lshift);
}
return (Less);
S_62: /*>*/
if (*Byteinteger(Fp) == '=') {
Fp++;
return (Greateq);
}
if (*Byteinteger(Fp) == '>') {
Fp++;
return (Rshift);
}
return (Greater);
S_95: /*_*/
return (Underline);
S_58: /*:*/
return (Colon);
S_44: /*,*/
return (Comma);
S_59: /*;*/
return (Terminator);
S_40: /*(*/
return (Left);
S_41: /*)*/
return (Right);
S_124: /*|*/
return (Modsign);
S_69: /*E*/
S_101:; /*e*/
if (*Byteinteger(Fp) == '"') {
Fp++;
goto Stringconst;
}
S_77: /*M*/
S_109: /*m*/
S_67: /*C*/
S_99:; /*c*/
if (*Byteinteger(Fp) == '\'') {
Fp++;
goto Charconst;
}
S_65: /*A*/
S_66: /*B*/
S_68: /*D*/
S_70: /*F*/
S_71: /*G*/
S_72:; /*H*/
S_73: /*I*/
S_74: /*J*/
S_75: /*K*/
S_76: /*K*/
S_78: /*N*/
S_79: /*O*/
S_80:; /*P*/
S_81: /*Q*/
S_82: /*R*/
S_83: /*S*/
S_84: /*T*/
S_85: /*U*/
S_86: /*V*/
S_87: /*W*/
S_88:; /*X*/
S_89: /*Y*/
S_90: /*Z*/
S_97: /*a*/
S_98: /*b*/
S_100: /*d*/
S_102:; /*f*/
S_103: /*g*/
S_104: /*h*/
S_105: /*i*/
S_106: /*j*/
S_107: /*k*/
S_108: /*l*/
S_110:; /*n*/
S_111: /*o*/
S_112: /*p*/
S_113: /*q*/
S_114: /*r*/
S_115: /*s*/
S_116: /*t*/
S_117: /*u*/
S_118:; /*v*/
S_119: /*w*/
S_120: /*x*/
S_121: /*y*/
S_122:; /*z*/
if (Percent)
goto Keyword;
Newlen = Charlim + 1;
Hash = Sym | Casebit; //lower-case (if letter)
*Byteinteger(Newlen) = Hash;
do {
Sym = *Byteinteger(Fp);
Fp++;
} while (Sym == ' ');
Sym = Map[Sym];
if (Sym)
do {
Newlen++;
*Byteinteger(Newlen) = Sym;
Hash = Hash << 1 ^ Sym;
do {
Sym = *Byteinteger(Fp);
Fp++;
} while (Sym == ' ');
Sym = Map[Sym];
} while (Sym);
Fp--;
Newlen -= Charlim;
*Byteinteger(Charlim) = Newlen;
Head = &Hashindex[Hash & 255];
Item = *Head;
if (Item > 0)
do {
//fprintf(stderr, "do;\n");
if (Item <= 0) {
//fprintf(stderr, "return;\n");
return (Ident);
}
Ditem = &Dict[Item];
#ifdef NEVER
fprintf(stderr, "strcmp(\"");
PRINTSTRING(*String(Ditem->Text + Charbase));
fprintf(stderr, "\", \"");
PRINTSTRING(*String(Charlim));
fprintf(stderr, "\")\n");
#endif
if (_imp_strcmp(*String(Ditem->Text + Charbase), *String(Charlim)) == 0) {
//fprintf(stderr, "cmp-break;\n");
break;
}
Item = Ditem->Link;
} while (Item > 0);
//fprintf(stderr, "break;\n");
return (Ident);
S_37:; /*%*/
Sym = *Byteinteger(Fp);
if ('a' > (Sym | Casebit) || (Sym | Casebit) > 'z')
goto Again;
Fp++;
Keyword:;
Percent = 0;
P = Syminit[Sym | Casebit];
for (;;) {
while (Symbol[P] == (*Byteinteger(Fp) | Casebit)) {
P++;
Fp++;
}
if (Symbol[P] >= 128)
break;
Atom = Altdisp[P];
if (!Atom) {
if ((Sym | Casebit) != 'c' || *Byteinteger(Fp) != '\n')
return (Dud);
Readline();
goto Again;
}
P += Atom;
}
if ('a' <= (*Byteinteger(Fp) | Casebit) &&
(*Byteinteger(Fp) | Casebit) <= 'z')
Percent = 1;
Subatom = Altdisp[P];
Atom = Symbol[P] - 128;
if (!Atom)
return (Dud);
return (Atom);
S_48: /*0*/
S_49: /*1*/
S_50: /*2*/
S_51: /*3*/
S_52: /*4*/
S_53: /*5*/
S_54: /*6*/
S_55: /*7*/
S_56: /*8*/
S_57:; /*9*/
Item = 0;
T.Type = Inty;
Radix = 10;
T.Val = Sym - '0';
Ibm1:;
for (;;) {
for (;;) {
do {
Sym = *Byteinteger(Fp);
Fp++;
} while (Sym == ' ');
I = Sym - '0';
if (Radix == 10) {
if (I < 0 || I >= 10)
break;
if (T.Val > Max10 || (T.Val == Max10 && I > Maxdig)) {
T.Type = Realy;
Rval = T.Val;
Assemblereal();
break;
}
T.Val = T.Val * 10 + I;
} else {
if (I >= 10)
I = (Sym | Casebit) - 'a' + 10;
if (I < 0 || I >= Radix)
break;
J = Radix;
do {
if (J & 1)
I += T.Val;
T.Val = T.Val << 1;
J = J >> 1;
} while (J);
T.Val = I;
}
}
if (Sym != '_')
break;
Radix = T.Val;
if (!Radix)
return (Dud);
T.Val = 0;
}
if (Sym == '.') {
if (T.Type == Inty) {
T.Type = Realy;
Rval = T.Val;
}
Assemblereal();
if (!J)
return (Dud);
Rval = Rval / REXP(Radix, J);
}
Fp--;
Sym = 0;
return (Const);
S_39:; /*'*/
Charconst:;
Item = 0;
T.Type = Inty;
T.Val = 0;
for (;;) {
Sym = *Byteinteger(Fp);
Fp++;
if (Sym == '\n')
return (Dud);
if (Sym == '\'') {
if (*Byteinteger(Fp) != '\'')
break;
Fp++;
}
T.Val = (T.Val << 8) + Sym;
}
if (T.Val)
return (Const);
return (Dud);
S_34:; /*"*/
Stringconst:;
Item = 0;
T.Type = Stringy;
Stringp = Atomp;
T.Val = 0;
I = Line;
J = Linestart;
for (;;) {
Sym = *Byteinteger(Fp);
Fp++;
if (Sym == '"') {
if (*Byteinteger(Fp) != '"')
break;
Fp++;
}
T.Val = T.Val + 1;
if (T.Val > 255) {
Sym = 0;
Fp = Atomp;
Linestart = J;
return (Dud);
}
if (Sym == '\n')
Readline();
}
return (Const);
S_default:;
return (Dud);
} //NEXT ATOM
void Lookupfieldident(int List) {
Item = List;
if (!Item)
return;
for (;;) {
Ditem = &Dict[Item];
if (!(Ditem->Flags & Typeid)) {
fprintf(stderr, "Compare %s vs %s\n", (char *)(Ditem->Text + Charbase + 1), (char *)(Charlim + 1));
if (_imp_strcmp(*String(Ditem->Text + Charbase), *String(Charlim)) == 0)
return;
if (!(Ditem->Flags & More))
break;
}
Item++;
}
Item = 0;
}
int /* boolean */ A(int K) {
//Basic atom-testing predicate
if (Matched)
Atom = Nextatom();
if (K != Atom)
return (0);
Matched = 1;
return (1);
}
void Get(int K) {
if (Matched)
Atom = Nextatom();
Matched = 1;
if (Atom == K)
return;
if (Atom == Dud)
Syntaxerror();
Faultp = Atomp;
Report(Formerr + Point, -K);
fprintf(stderr, "%%SIGNAL 14 at line %d\n", __LINE__);
_imp_signal(14, 0, __LINE__, _imp_str_literal(""));
}
void Allow(int K) {
if (A(K))
;
}
void Declare(void) {
if (!Speccing) { //not within spec params
if (Item >= C.Localdpos) { //there already
if ((D.Flags & Spec) == 0 && D.Flags + Spec == Ditem->Flags &&
Ditem->Type == D.Type) {
Ditem->Flags = Ditem->Flags - Spec;
return;
}
Fault(Duperr + Point);
}
D.Link = *Head;
*Head = Dlim;
if (Item > 0)
D.Text = Ditem->Text;
else {
D.Text = Charlim - Charbase;
Charlim = Charlim + Newlen + 1;
if (Charlim + 80 >= Charmin)
Croak(_imp_str_literal("Identifier space exhausted"));
}
} else
D.Text = 0;
Item = Dlim;
Ditem = &Dict[Item];
*Ditem = D;
Dlim++;
if (Dlim >= Dmin)
Croak(_imp_str_literal("Too many identifiers"));
} //DECLARE
void Declareanon(void) {
D.Text = 0;
D.Link = 0;
Dict[Dlim] = D;
Dlim++;
if (Dlim >= Dmin)
Croak(_imp_str_literal("Too many identifiers"));
}
static int Jammy;
int /* boolean */ Aassop(void) {
if (Matched)
Atom = Nextatom();
if (Atom != Equals && Atom != Eqeq) {
if (Atom != Less || *Byteinteger(Fp) != '-')
return (0);
Jammy = 2;
Fp++;
} else
Jammy = 0;
Matched = 1;
return (1);
}
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!! Expressions !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
static int Literal = 0;
auto void Getexpression(int Rank, int Control);
int Compat(int Control) {
if (T.Type == Inty) {
if ((Control & Intok) == 0 && (Control & Realok) != 0) {
Item = Floated(Item);
T.Type = Realy;
}
return (Control & (Intok + Realok));
}
if (T.Type <= Booltype)
return (Control & (Boolok >> (Booltype - T.Type)));
if (T.Type < Direct)
return (Control & Enumok);
return (Control & Arrok);
}
//
int Listmatch(int Alist, int Blist) {
Identinfo *Ap;
Identinfo *Bp;
if (Alist == Blist)
return (1);
if (Alist < Dictmin || Blist < Dictmin)
return (0);
do {
Ap = &Dict[Alist];
Bp = &Dict[Blist];
if (Ap->Type != Bp->Type)
return (0);
Alist++;
Blist++;
} while (Ap->Flags & Bp->Flags & More);
if ((Ap->Flags & More) != 0 || (Bp->Flags & More) != 0)
return (0);
return (1);
}
//
void Getreference(int Reftype) {
int Type;
int Temp;
Getexpression(Simple, Refonly + Any);
Type = Ditem->Type & Puretype;
Reftype = Reftype & Puretype;
if (Reftype == Type)
return;
if (Type < Reftype) {
Temp = Type;
Type = Reftype;
Reftype = Temp;
}
if (Reftype == Nulltype)
return;
Type = Dict[Type].Type;
if (Type <= Inty && Type == Reftype)
return;
if (Type >= Direct && Type == Dict[Reftype].Type)
return;
Expfault(Typerr + Point);
}
//
void Getvalue(int Valtype) {
Identinfo *Dp;
Identinfo *P;
Getexpression(Major, Any);
Valtype = Valtype & Puretype;
Dp = &Dict[Valtype];
if (T.Type != Dp->Type) { //base types differ
if (Item == 0 && 0 == T.Val) //zero
return;
if (Dp->Type == Realy && T.Type == Inty) {
//float
T.Type = Realy;
return;
}
} else if (T.Type >= Inty) { //scalar
if (!Item) {
if (Dp->Low <= T.Val && T.Val <= Dp->Val)
return;
if (Jammy >= 0)
Jammy = Jammy | 1;
} else { // Damn! Another dangling else situation.
if (T.Low >= Dp->Low) {
if (T.Val <= Dp->Val)
return;
if (Jammy >= 0)
Jammy = Jammy | 1;
if (T.Low <= Dp->Val)
return;
} else {
if (Jammy >= 0)
Jammy = Jammy | 1;
if (T.Val >= Dp->Low)
return;
}
}
if (Jammy < 2)
Expfault(Rangerr + Point);
return;
} else if (T.Type == Stringy) { //VALUE = LENGTH*
if (T.Val > Dp->Val) {
if (Jammy >= 0)
Jammy = Jammy | 1;
if (Item == 0 && Jammy < 2)
Expfault(Rangerr + Point);
}
return;
} else if (T.Type == Recy) {
if (T.Extra == Dp->Extra)
return;
if (Jammy >= 2) {
Jammy = Jammy | 1;
return;
}
} else if (T.Type == Realy)
return;
Expfault(Typerr + Point);
} //GET VALUE
//
void Getliteral(int Littype) {
Literal++;
Getvalue(Littype);
Literal--;
}
//
void Getlitint(void) {
Literal++;
Getexpression(Major, Intok);
Literal--;
}
//
void Getlitstring(void) {
int Holditem;
Holditem = Item; //preserve
Get(Const);
if (T.Type != Stringy)
Error(Typerr + Point);
Item = Holditem; //restore
}
//
void Getparmlist(void) {
Identinfo *Hp;
Identinfo *Dp;
int I;
int J;
int Headitem;
int Headact;
int Dpos;
int Case;
int Procnp;
int First;
Headitem = Item;
Hp = Ditem;
Headact = Rcall;
//stack procedure ident
I = 0;
First = 1;
Dpos = Headitem;
Dp = Hp;
do {
//Set up expression state from formal param details
if (!(Dp->Flags & More))
Error(Toomany + Point);
do {
Dpos++;
Dp = &Dict[Dpos];
} while (!(Dp->Flags & Parm));
if (Dp->Flags & Proc) {
Get(Ident);
if (Item <= 0)
Nameerror();
if (!(Ditem->Flags & Proc))
Fault(Typerr + Point); //for now
if (Item > Headitem)
Fault(Caterr + Point);
} else if (Dp->Type < Indirect) {
Case = I & 7;
I++;
Getvalue(Dp->Type);
} else { //name or proc
Case = (I >> 3) + 8;
I += 8;
Getreference(Dp->Type);
}
} while (A(Comma));
Item = Explo;
} //get PARMLIST
//
void Getresolution(void) {
if (!A(Left)) {
Getreference(Anystringvar);
Get(Dot);
Get(Left);
}
Getvalue(Anystring);
Get(Right);
if (A(Dot))
Getreference(Anystringvar);
}
//
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//
void Getexpression(int Rank, int Control) {
//Main expression recognition routine
//To bring together the treatment of all binary operators
// and ensure fast recognition of simple expressions,
// expressions of different levels are handled by
// precedence techniques rather than syntactically
//CONTROL defines acceptability
int Type;
int F;
int Opok;
int C1;
int Op;
int Atomp1;
int Item1;
Objinfo T1;
Identinfo *Dp;
int Litval(void) {
static int Lit_sw;
static void *Lit[44 /*64:107*/] = {
&&Lit_64, &&Lit_65, &&Lit_66, &&Lit_default,
&&Lit_default, &&Lit_default, &&Lit_70, &&Lit_71,
&&Lit_72, &&Lit_73, &&Lit_74, &&Lit_75,
&&Lit_default, &&Lit_default, &&Lit_default, &&Lit_default,
&&Lit_80, &&Lit_81, &&Lit_82, &&Lit_83,
&&Lit_84, &&Lit_default, &&Lit_default, &&Lit_default,
&&Lit_88, &&Lit_default, &&Lit_90, &&Lit_91,
&&Lit_default, &&Lit_default, &&Lit_default, &&Lit_default,
&&Lit_default, &&Lit_default, &&Lit_default, &&Lit_default,
&&Lit_100, &&Lit_101, &&Lit_102, &&Lit_default,
&&Lit_default, &&Lit_default, &&Lit_default, &&Lit_default,
};
goto *Lit[Lit_sw = (Op)-64];
Lit_80: /*plus*/
return (T1.Val + T.Val);
Lit_81: /*minus*/
return (T1.Val - T.Val);
Lit_88: /*mult*/
return (T1.Val * T.Val);
Lit_90: /*idiv*/
if (T.Val)
return (T1.Val / T.Val);
Fault(Rangerr);
return (0);
Lit_91:; /*logand*/
Lit_64: /*booland*/
return (T1.Val & T.Val);
Lit_82:; /*logor*/
Lit_65: /*boolor*/
return (T1.Val | T.Val);
Lit_83: /*logxor*/
return (T1.Val ^ T.Val);
Lit_100: /*lshift*/
return (T1.Val << T.Val);
Lit_101: /*rshift*/
return (T1.Val >> T.Val);
Lit_66: /*boolnot*/
return (T.Val ^ True);
Lit_102: /*lognot*/
return (~T.Val);
Lit_70: /*equals*/
if (T1.Val == T.Val)
return (True);
return (False);
Lit_71: /*noteq*/
if (T1.Val != T.Val)
return (True);
return (False);
Lit_72: /*lesseq*/
if (T1.Val <= T.Val)
return (True);
return (False);
Lit_73: /*less*/
if (T1.Val < T.Val)
return (True);
return (False);
Lit_74: /*greateq*/
if (T1.Val >= T.Val)
return (True);
return (False);
Lit_75: /*greater*/
if (T1.Val > T.Val)
return (True);
return (False);
Lit_84: /*concat*/
return (T1.Val + T.Val);
Lit_default:;
return (1);
}
//Get leading operand
if (Matched)
Atom = Nextatom();
Atomp1 = Atomp; //note position for reports
if (Atom == Ident) {
Matched = 1;
if (Item <= 0)
Nameerror();
if (Item >= Dlim0)
Fault(Selfref + Point);
Type = Ditem->Type;
if (Control & (Refonly + Varonly)) {
if ((Control & Varonly) != 0 && (F & Var) == 0)
Error(Nonvar + Point);
if (Type < Direct)
Error(Nonref + Point);
}
F = Ditem->Flags;
if (Inty <= Type && Type <= Booltype && (F & Proc) == 0) { //literal
Item = 0;
T = Ditem->Details;
} else {
if (Literal > 0)
Fault(Nonliteral + Point);
if (F & Proc) {
if (F & Parm) {
Ditem = &Dict[Type];
Type = Ditem->Type;
}
if (Type == Nulltype)
Error(Caterr + Point); //routine
if (A(Left)) {
Dp = Ditem;
Getparmlist();
Get(Right);
Ditem = Dp;
} else {
if (Ditem->Flags & More)
Error(Toofew + Point);
Item = Explo;
}
}
for (;;) {
Dp = &Dict[Type & Puretype];
T = Dp->Details;
if (Matched)
Atom = Nextatom();
if (Atom != Underline && Atom != Left)
break;
Matched = 1;
Item1 = Item;
if (Atom == Left) {
for (;;) {
if (T.Type < Direct)
Syntaxerror(); //element type
Type = T.Type;
Getvalue(T.Val); //index
Item = Explo;
Ditem = Dp;
if (!A(Comma))
break;
Dp = &Dict[Type & Puretype];
T = Dp->Details;
Item1 = Item;
}
Get(Right);
} else { //rec subfield
if (T.Type != Recy)
Syntaxerror();
Get(Ident);
Lookupfieldident(T.Extra);
if (Item <= 0)
Error(Namerr + Point);
Type = Ditem->Type;
Item = Explo;
}
}
if (Control & (Varonly + Refonly))
goto Final;
}
} else {
if (Control & Varonly)
Error(Nonvar + Point);
if (Control & Refonly)
Error(Nonref + Point);
if (A(Const))
;
else if (Atom == Minus) { //leave unmatched
Item = 0;
T = (Objinfo){0};
T.Type = Inty;
} else if (A(Left)) {
if (Rank < Major) //condition
Getexpression(Cond, Any);
else {
Jammy -= 4;
C1 = Control;
if (C1 & Realok)
C1 = C1 | Intok;
Getexpression(Major, C1);
Jammy += 4;
}
Get(Right);
} else if (A(Keynot)) {
if (Rank >= Major)
Syntaxerror();
Getexpression(Scond, Any);
if (!Item)
T.Val = T.Val ^ True;
else
Item = Explo;//expref(boolnot,item,0)
} else if (Atom == Backslash) {
Item = 0;
T = (Objinfo){0};
T.Type = Inty;
Atom = Tilde;
} else if (A(Modsign)) {
if (!(Control & Arithok))
Fault(Typerr + Point);
Getexpression(Major, Arithok);
Get(Modsign);
if (!Item) { // another dangling else
if (T.Val < 0) {
if (T.Val != Minint)
T.Val = -T.Val;
else
Expfault(Rangerr);
}
} else if (T.Type == Inty) { // check for dangling else against Imp source
Item = Explo;
} else if (T.Type == Realy) {
Item = Explo;
} else
Error(Typerr);
} else
Syntaxerror();
}
if (Matched)
Atom = Nextatom();
while (Atom >= Rank) {
Op = Atom;
Matched = 1;
Opok = Opbits[Op];
C1 = Compat(Opok); //[may change ITEM,T_TYPE]
if (!C1)
Fault(Typerr + Point);
Item1 = Item;
T1 = T;
if (Op >= Major) { //non-conditional
if (Op == Dot)
Getexpression(Dot, Stringok); /*right-associate*/
else
Getexpression((Op & (~7)) + 8, C1);
if (T.Type == Realy && T1.Type == Inty) {
Item1 = Floated(Item1);
T1.Type = Realy;
}
} else {
if (Op == Resolve)
Getresolution();
else if (Op >= Eqeq)
Getexpression(Simple, Any + Refonly);
else if (Op >= Equals) {
Getexpression(Major, C1);
if (Equals <= Atom && Atom < Eqeq) {
Op = Atom;
Matched = 1;
Getexpression(Major, C1);
}
if (T.Type == Realy && T1.Type == Inty) {
Item1 = Floated(Item1);
T1.Type = Realy;
}
} else {
Getexpression(Scond, Any);
if (Atom >= Cond)
if (Atom != Op)
Syntaxerror();
}
T.Type = Booltype;
if (Item) {
T.Low = 0;
T.Val = 1;
}
}
if (!Item1) //first operand literal
if (!Item) { //both literal
T.Val = Litval();
if (!Item)
continue;
}
if (!Item) { //second operand literal
if (Op == Minus && T.Type == Inty) { //standardise
if (T.Val != Minint)
T.Val = -T.Val;
Op = Plus;
}
if (T.Val == 0 && (Opok & Znop) != 0) {
Item = Item1;
continue;
}
}
Item = Explo;//expref(op,item1,item,t_val)
T.Low = Minint;
T.Val = Maxint;
}
Final:;
Expp = Atomp1;
if (!Compat(Control))
Expfault(Typerr);
} //get EXPRESSION
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!! Conditions and loops !!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//
void Getcondition(void) {
int Polarity;
Polarity = Subatom;
Condnp = Np;
Getexpression(Cond, Any);
} //get CONDITION
void Getstatements(int Stopper) {
int Holdnp;
int Holdlooplab;
static int Initial_sw;
static void *Initial[108 /*0:107*/] = {
&&Initial_default, &&Initial_1, &&Initial_2,
&&Initial_3, &&Initial_4, &&Initial_5,
&&Initial_6, &&Initial_7, &&Initial_8,
&&Initial_9, &&Initial_10, &&Initial_11,
&&Initial_12, &&Initial_13, &&Initial_default,
&&Initial_15, &&Initial_16, &&Initial_17,
&&Initial_default, &&Initial_19, &&Initial_default,
&&Initial_default, &&Initial_22, &&Initial_23,
&&Initial_24, &&Initial_25, &&Initial_26,
&&Initial_27, &&Initial_28, &&Initial_29,
&&Initial_30, &&Initial_default, &&Initial_default,
&&Initial_33, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_37, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_41,
&&Initial_42, &&Initial_default, &&Initial_default,
&&Initial_45, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_52, &&Initial_default,
&&Initial_54, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_63, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_79, &&Initial_default,
&&Initial_default, &&Initial_82, &&Initial_83,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_88, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
&&Initial_default, &&Initial_default, &&Initial_default,
};
void Getinstruction(void) {
int Item1;
int Hold;
int Act;
Identinfo *Ditem1;
void Putact(void) {
}
//
if (C.Flags < Hadinst) { //first in block
C.Flags = C.Flags + Hadinst;
if (Level <= Outerlevel)
Fault(Ordererr);
}
Instnp = Np;
do
if (A(Ident)) {
if (Item <= 0)
Nameerror();
if (Ditem->Flags & Var) {
Matched = 0;
Getexpression(Simple, Any);
Item1 = Item;
Ditem1 = Ditem;
if (A(Equals)) {
Getvalue(Ditem1->Type);
} else if (A(Eqeq)) {
if (Ditem1->Type < Indirect)
Syntaxerror();
Getreference(Ditem1->Type);
if (Item)
Item += Ad;
} else if (Atom == Less && *Byteinteger(Fp) == '-') {
Fp++;
Matched = 1;
Jammy = 2;
Getvalue(Ditem1->Type);
} else {
if (!A(Arrow))
Syntaxerror();
Getresolution();
}
} else {
if (!(Ditem->Flags & Proc))
Error(Caterr + Point);
if (Ditem->Flags & Parm)
Ditem = &Dict[Ditem->Type];
if (Ditem->Type != Nulltype)
Error(Caterr + Point);
if (A(Left)) {
Getparmlist();
Get(Right);
} else { //parameterless routine
if (Ditem->Flags & More)
Error(Toofew + Point);
}
}
} else {
Act = Atom;
Hold = Subatom;
T.Val = 0;
C.Access = 0;
if (A(Monitor)) {
C.Access = 1;
} else if (A(Exit)) {
if (!Looplab)
Fault(Notinloop + Point);
else {
T.Val = Looplab;
Putact();
}
break;
} else if (A(Return)) {
if (C.Type != Nulltype)
Fault(Notinrout + Point);
else
Putact();
break;
} else if (A(Result)) {
if (C.Type <= Nulltype)
Error(Notinfun + Point);
if (!Aassop())
Syntaxerror();
if (C.Type < Direct) { //function
if (Atom == Eqeq)
Fault(Caterr + Point);
Getvalue(C.Type);
} else { //map
if (Atom != Eqeq)
Fault(Caterr + Point);
Getreference(C.Type + (Indirect - Direct));
}
break;
} else if (A(Tf)) { //%true, %false
if (C.Type != Booltype)
Fault(Notinpred + Point);
else
Putact();
break;
} else if (A(Arrow) || A(Goto)) {
if (Atom == Goto)
Nonstandard(Kgoto);
Get(Ident);
if (*Byteinteger(Fp) != '(') {
if (Item < C.Localdpos || (Ditem->Flags & Lab) == 0 ||
Ditem->Type != Nulltype) {
D.Flags = Spec + Lab;
D.Type = Nulltype;
Declare();
}
} else {
if (Item < C.Localdpos)
Nameerror();
if ((Ditem->Flags & Lab) == 0 || Ditem->Type == Nulltype)
Syntaxerror();
Get(Left);
Getvalue(Ditem->Type);
Get(Right);
}
break;
} else if (A(Stop)) {
Putact();
break;
} else if (A(Signal)) {
C.Access = 1;
Allow(Keyevent);
Getlitint();
if (0 > T.Val || T.Val > 15)
Expfault(Rangerr + Point);
Hold = T.Val;
T.Val = 0;
if (A(Comma))
Getlitint();
Hold += T.Val << 4;
Item = 0;
T.Val = 0;
if (A(Comma))
Getvalue(Anyint);
break;
} else
Syntaxerror();
}
while (A(Keyand));
} //GET INSTRUCTION
void Getforclause(void) {
int Loopvar;
int K;
int S;
int Start;
int Sval;
int I;
int Inc;
int Ival;
int E;
int N;
int Temp;
int Eval;
Identinfo *Dp;
Holdnp = Np;
Temp = 0;
Dict[Curlab].Val = 1;
Condnp = Np;
Get(Ident);
if (Item <= 0)
Nameerror();
if (Dict[Ditem->Type & Puretype].Type != Inty)
Fault(Typerr + Point);
if (Ditem->Type != Direct + Inttype)
Fault(Caterr + Point + Warn);
Loopvar = Item;
Dp = Ditem;
Get(Equals);
Getvalue(Ditem->Type);
Start = Item;
Sval = T.Val;
Get(Comma);
Getvalue(Anyint);
Inc = Item;
Ival = T.Val;
if (Inc == 0 && 0 == Ival) {
Expfault(Rangerr + Point);
Ival = 1;
}
Get(Comma);
Getvalue(Ditem->Type);
//Deal with INC and replace START by START-INC
if (!Inc) { //literal increment
I = 1; //litref(ival)
if (!Start) { //START and INC both literal
Sval -= Ival;
S = 1; //litref(sval)
} else {
S = Explo;//expref(plus,start,litref(-ival))
}
} else { //allocate temp var
S = Explo;//expref(minus,s,i)
}
if (!(Start | Inc | Item)) { //all literal
K = T.Val - Sval;
N = K / Ival;
if (N < 0)
Fault(Boundserr);
if (N * Ival != K)
Fault(Unending);
}
} //get FORCLAUSE
void Getswitchindex(void) {
int Item1;
Identinfo *Dp;
Item1 = Item;
Dp = Ditem;
Get(Left);
Item = 1;
if (A(Star)) {
if (Dp->Spare)
Fault(Duperr + Point);
Dp->Spare = 1;
} else {
Getliteral(Dp->Type);
if (Dp->Type > Inttype && Faultnum == 0) {
T.Val = T.Val - Dict[Dp->Type].Low + Dp->Val;
if (Final[T.Val])
Expfault(Duperr + Point);
Final[T.Val] = 1;
}
}
Get(Right);
C.Access = 1;
}
//[unsure of efficiency implications of trapping overflow lower down]
if (_imp_on_event(1, 14)) {
_reset:
// if (_imp_on_event(1, 14)) goto _reset; /* previously, trapping an event once removed the event handler! */
//fprintf(stderr, "%%ON %%EVENT 1, 14 at line %d\n", __LINE__);
if (EVENT.EVENT == 1)
Report(Rangerr, 0);
goto Skip;
}
//!!!!!!!!!!!!!!!!!! Start of new statement !!!!!!!!!!!!!!!!!!!
Next:;
Statements++;
Next1:;
if (Faultnum)
Report(Faultnum, Faultp);
D = (Identinfo){0};
Declmode = 0;
Dsize = 0;
Dlim0 = Dlim;
Elements = 0;
Speccing = 0;
Mcoding = 0;
Literal = 0;
Jammy = 0;
Dict[Curlab].Val = 0;
Dict[Curlab + 1].Val = 0;
Np = Np0;
Instnp = Np0;
Condnp = Np0;
if (Explo < Expmin + 50 || Litpos > Litmax - 50)
Forgetall();
T.Val = 0;
//
Initial_52:; /*terminator*/
Atom = Nextatom();
Matched = 1;
goto *Initial[Initial_sw = Atom];
Initial_88: /*star*/
Initial_82: /*exclam*/
Initial_83:; /*exclam2*/
Readline();
goto Next1;
Term:;
Get(Terminator);
goto Next;
Skip:;
C.Access = -1;
if (Atom != Terminator) {
do {
Subatom = Atom;
Atom = Nextatom();
} while (Atom != Terminator);
if (Subatom == Start)
Starts++;
if (Subatom == Cycle)
Cycles++;
}
goto Next;
Initial_63:; /*dud*/
Syntaxerror(); //ie atom error
Initial_default:;
Error(Nonstarter + Point);
Initial_54:; /*ident*/
if (*Byteinteger(Fp) == ':') { //simple label
Fp++;
D.Flags = Lab;
D.Type = Nulltype;
Declare();
Setuserlabel(Item);
goto Next;
}
if (Item <= 0)
Nameerror();
if (Ditem->Flags & Lab) {
Getswitchindex();
Get(Colon);
goto Next;
}
Initial_7: /*return*/ Initial_9: /*result*/ Initial_8:; /*tf*/
Initial_10: /*stop*/ Initial_12: /*signal*/ Initial_13:; /*monitor*/
Initial_6: /*exit*/ Initial_11: /*goto*/ Initial_79:; /*arrowarrow*/
Matched = 0;
Getinstruction();
if (A(Terminator))
goto Next;
C.Access = 1;
if (A(Iu)) {
Holdnp = Np;
Getcondition();
} else if (A(While)) {
Holdnp = Np;
Getcondition();
} else if (A(For)) {
Getforclause();
} else {
if (!A(Until))
Syntaxerror();
Getcondition();
}
goto Term;
Initial_16:; /*iu*/ //%if, %unless
for (;;) {
Holdnp = Np;
Getcondition();
if (A(Then)) {
if (A(Start))
goto Fudge;
Getinstruction();
} else {
Get(Start);
Fudge:;
for (;;) {
Get(Terminator);
Curlab += 2;
Getstatements(Else);
Curlab -= 2;
if (Atom != Else)
break;
if (A(Iu))
Getcondition();
}
if (Atom != Finish)
return;
}
if (!A(Else))
break;
if (A(Start))
goto Fudge;
if (!A(Iu)) {
Getinstruction();
break;
}
}
goto Term;
Initial_22:; /*cycle*/
if (A(Terminator)) {
Holdlooplab = Looplab;
Looplab = Curlab;
Curlab += 2;
Getstatements(Repeat);
Curlab -= 2;
Looplab = Holdlooplab;
if (Atom != Repeat)
return;
if (A(Until))
Getcondition();
goto Term;
}
Nonstandard(Oldcycle);
Getforclause();
goto For1;
Initial_17:; /*while*/
Holdnp = Np;
Getcondition();
Get(Cycle);
Get(Terminator);
Holdlooplab = Looplab;
Looplab = Curlab;
Curlab += 2;
Getstatements(Repeat);
Curlab -= 2;
Looplab = Holdlooplab;
if (Atom != Repeat)
return;
if (A(Until)) {
Nonstandard(Loop2);
Getcondition();
}
goto Term;
Initial_19:; /*for*/
Getforclause();
Get(Cycle);
For1:;
Get(Terminator);
Holdlooplab = Looplab;
Looplab = Curlab;
Curlab += 2;
Getstatements(Repeat);
Curlab -= 2;
Looplab = Holdlooplab;
if (Atom != Repeat)
return;
goto Term;
Initial_15:; /*on*/
if (C.Flags >= Hadon || Level <= Outerlevel)
Fault(Ordererr + Point);
C.Flags = C.Flags | Hadon;
Matched = 1;
Allow(Keyevent);
do {
Getlitint();
if (0 > T.Val || T.Val > 15)
Expfault(Rangerr + Point);
C.Events = C.Events | 1 << T.Val;
} while (A(Comma));
Get(Start);
Curlab += 2;
Getstatements(Finish);
Curlab -= 2;
if (Atom != Finish)
return;
goto Term;
//
Initial_4:; /*else*/
if (Starts)
goto Skip;
if (Stopper == Else)
return;
if (Stopper == Finish)
Error(Noif);
Initial_3:; /*finish*/
if (Starts) {
Starts--;
goto Skip;
}
if (Stopper == Finish || Stopper == Else)
return;
Error(Nostart);
Initial_2:; /*repeat*/
if (Cycles) {
Cycles--;
goto Skip;
}
if (Stopper == Repeat)
return;
Error(Nocycle);
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!! Declarations !!!!!!!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//
int Newatype(int Eltype, int Xtype) {
int Dpos;
Identinfo *Dp;
static Identinfo D = {0};
Dpos = Dictmin;
do {
Dp = &Dict[Dpos];
if ((Dp->Flags & Typeid) != 0 && Dp->Type == Eltype && Dp->Val == Xtype)
return (Dpos + Direct);
Dpos++;
} while (Dpos != Dlim);
D.Flags = Typeid;
D.Type = Eltype;
D.Val = Xtype;
Dict[Dpos] = D;
Dlim++;
if (Dlim >= Dmin)
Croak(_imp_str_literal("Too many identifers"));
return (Dpos + Direct);
}
//
int Newstype(int Max) {
int Dpos;
Identinfo *Dp;
static Identinfo D = {0};
Dpos = Dictmin;
do {
Dp = &Dict[Dpos];
if (Dp->Type == Stringy && Dp->Val == Max)
return (Dpos);
Dpos++;
} while (Dpos != Dlim);
D.Flags = Typeid;
D.Type = Stringy;
D.Val = Max;
Dict[Dpos] = D;
Dlim++;
if (Dlim >= Dmin)
Croak(_imp_str_literal("Too many identifers"));
return (Dpos);
}
//
int Newrange(int Type, int Lower, int Upper) {
int Dpos;
Identinfo *Dp;
static Identinfo D = {0};
if (Lower > Upper) {
Fault(Boundserr);
Upper = Lower;
}
Elements = Maxint;
if ((Upper ^ Lower) >= 0 || Minint + Upper - Lower < 0)
Elements = Upper - Lower;
if (Elements != Maxint)
Elements++;
Dpos = Dictmin;
do {
Dp = &Dict[Dpos];
if (Dp->Flags == Typeid && Dp->Type == Type && Dp->Low == Lower &&
Dp->Val == Upper)
return (Dpos);
Dpos++;
} while (Dpos == Dlim);
D.Flags = Typeid;
D.Type = Type;
D.Low = Lower;
D.Val = Upper;
Dict[Dpos] = D;
Dlim++;
if (Dlim >= Dmin)
Croak(_imp_str_literal("Too many identifers"));
return (Dpos);
}
void Getlitbounds(void) {
int Lower;
Get(Left);
Getlitint();
Lower = T.Val;
Get(Colon);
Getlitint();
Get(Right);
T.Low = Lower; //always integer at present
Item = Newrange(Inty, T.Low, T.Val);
}
void Getident(void) {
Dlim0 = Dlim;
Get(Ident);
Declare();
if ((D.Flags & Ext) != 0 && A(Alias))
Getlitstring();
}
void Getidentlist(void) {
Dlim0 = Dlim;
do {
Get(Ident);
Declare();
if ((D.Flags & Ext) != 0 && A(Alias))
Getlitstring();
} while (A(Comma));
}
void Gettype(int Flags) {
static int Fbase;
static Identinfo *Formp;
static Identinfo *Fieldp;
//
void Getformatdef(void) {
int Disp;
int Max;
int Base;
void Getfieldident(void) {
Get(Ident);
if (Item > 0)
D.Text = Ditem->Text;
else {
D.Text = Charlim - Charbase;
Charlim = Charlim + Newlen + 1;
if (Charlim + 80 >= Charmin)
Croak(_imp_str_literal("Identifier space exhausted"));
}
Ditem = &Dict[Dlim];
Fieldp = Ditem;
*Ditem = D;
if (!Formp->Extra)
Formp->Extra = Dlim;
Dlim++;
if (Dlim >= Dmin)
Croak(_imp_str_literal("Too many identifiers"));
}
void Getunit(void) {
for (;;)
if (A(Left)) {
Getformatdef();
Get(Right);
if (!A(Comma))
return;
} else {
Gettype(Static + More);
if (!(D.Flags & Parm))
do {
if ((Disp & 1) != 0 && Dsize != 1)
Disp++;
D.Val = Disp;
Disp += Dsize;
Getfieldident();
if (!A(Comma))
return;
Atom = Nextatom();
} while (Atom == Ident);
else { // check for dangling else here too.
D.Flags = D.Flags - Parm;
if (Disp & 1)
Disp++;
D.Val = Disp;
Getfieldident();
Getlitbounds();
Fieldp->Type = Newatype(D.Type, Item);
Disp += Dsize * Elements;
if (!A(Comma))
return;
}
}
}
Max = 0;
Base = 0;
do {
Disp = Base;
Getunit();
if (Max < Disp)
Max = Disp;
} while (A(Keyor));
Base = Max;
} //get FORMATDEF
Dsize = 0;
D.Mode = 0;
D.Val = 0;
D.Type = Nulltype;
if (A(Rpred)) { //%routine,(%integerfn)
if (Flags & Ext)
Flags = Flags & (~Static);
if (Flags & Static)
Syntaxerror();
if (Subatom) {
Nonstandard(Pred);
D.Type = Booltype;
}
D.Flags = Flags + Proc;
Declmode += Pcmode;
return;
}
if (A(Krange)) { //%byte,%short,%half,%mite
D.Type = Inttype + Subatom;
Dsize = 1;
if (D.Type == Shorttype || D.Type == Halftype)
Dsize = 2;
if (D.Type >= Mitetype)
Nonstandard(Ranges);
Allow(Keyinteger);
} else if (A(Keyinteger)) { //%integer
D.Type = Inttype;
Dsize = 4;
Atom = Nextatom();
if (Atom == Left) {
Getlitbounds();
D.Type = Item;
if (Elements <= 65536 && T.Low >= -32768)
Dsize = 2;
if (Elements <= 256 && T.Low >= -128)
Dsize = 1;
}
} else if (A(Keylong)) { //%long
D.Type = Longinttype;
Dsize = 8;
if (!A(Keyinteger)) {
D.Type = Longrealtype;
Get(Keyreal);
}
} else if (A(Keyreal)) { //%real
D.Type = Realtype;
Dsize = 4;
} else if (A(Keystring)) { //%string
D.Type = Stringy;
T.Val = 255;
Dsize = 256;
if (A(Left)) {
T.Val = 0;
if (!A(Star)) {
Getlitint();
if (0 >= T.Val || T.Val > 255) {
Expfault(Rangerr + Point);
T.Val = 255;
}
}
Get(Right);
} else
Nonstandard(Nolength);
if (T.Val) {
D.Type = Newstype(T.Val);
Dsize = (T.Val + 2) & (~1);
}
} else if (A(Keyrecord)) { //%record
D.Type = Recy;
if (A(Keyformat)) {
if (Flags & (Static + Ext))
Syntaxerror();
if (A(Keyspec)) {
D.Flags = Typeid + Spec;
Getident();
} else {
D.Flags = Typeid;
Getident();
Formp = Ditem;
Get(Left);
Fbase = 0;
Getformatdef();
Fieldp->Flags = Fieldp->Flags - More;
Get(Right);
}
D.Flags = Typeid;
return;
}
Get(Left);
if (!A(Star)) {
if (!A(Ident)) {
Getformatdef();
Fieldp->Flags = Fieldp->Flags - More;
Get(Right);
D.Flags = Typeid;
Declareanon();
}
if (Item <= 0)
Nameerror();
if (Ditem->Type != Recy)
Syntaxerror();
D.Type = Item;
Dsize = Ditem->Val;
}
Get(Right);
} else {
if (Atom != Keyname)
Syntaxerror(); //untyped %name
}
//End of basic type info: set item size in DECLMODE
if (Dsize <= 4)
if (Dsize <= 2)
Declmode = Dsize << Sizeshift;
else
Declmode = Longsize << Sizeshift;
//Appendages
if (A(Fnmap)) { //%fn, %map
if (Flags & Ext)
Flags = Flags & (~Static);
if (Flags & Static)
Syntaxerror();
if (Subatom) {
Flags++; /*flags = flags+var*/
D.Type = D.Type + Direct; //map
}
D.Flags = Flags + Proc;
Declmode += Pcmode;
return;
}
D.Type = D.Type + Direct;
while (A(Keyarray) || A(Keyname)) {
if (Atom == Keyarray) { //%array
if (D.Type >= Indirect)
Nonstandard(Naming);
if (!A(Keyname)) {
if (Flags & Parm)
Syntaxerror();
Flags += Parm; //as indic
break;
}
D.Type = Newatype(D.Type, Inty);
}
if (D.Type >= Indirect)
Syntaxerror();
D.Type = D.Type + (Indirect - Direct);
Dsize = 4;
}
D.Flags = Flags ^ Var;
} //GET TYPE
//
void Getownarraydeclaration(void) {
int Holdval;
int Dpos;
Identinfo *Dp;
Getident();
Dpos = Item;
Dp = Ditem;
Getlitbounds();
Dp->Type = Newatype(D.Type, Item);
if (Aassop()) {
Allow(Terminator);
do {
Getliteral(D.Type);
if (Faultnum == Rangerr + Point)
Faultnum = Rangerr + Point + Warn;
Holdval = T.Val;
T.Val = 1;
if (A(Left)) {
T.Val = Elements;
if (!A(Star))
Getlitint();
Get(Right);
}
Elements -= T.Val;
} while (A(Comma));
if (Elements != 0 && Faultnum == 0)
Report(Counterr, Dpos);
}
} //get OWN ADECL
void Getarraydeclaration(void) {
//ie get IDENTLISTS and BOUNDS
int I;
int Dlim1;
int Hold;
int Holdval;
int Type;
void Getbounds(void) {
int Range;
Getvalue(Anyint);
Hold = Item;
if (Hold)
T.Val = Minint;
Holdval = T.Val;
Get(Colon);
Getvalue(Anyint);
if (Item)
T.Val = Maxint;
Range = Newrange(Inty, Holdval, T.Val);
if (A(Comma))
Getbounds();
Type = Newatype(Type, Range);
}
do {
Type = D.Type;
Getidentlist();
Dlim1 = Dlim;
Get(Left);
Getbounds();
Get(Right);
while (Dlim0 != Dlim1) {
Dict[Dlim0].Type = Type;
Dlim0++;
}
} while (A(Comma));
} //get BOUNDS
void Getparmdef(void) {
int Headitem;
int Dpos;
int Dlim1;
Identinfo *Headditem;
Identinfo *Dp;
int Parmmatch(int Apos) {
int Bpos;
Identinfo *Ap;
Identinfo *Bp;
Bpos = Dlim1;
Ap = &Dict[Apos];
while (Bpos != Dlim) {
if (!(Ap->Flags & More))
return (0);
do {
Apos++;
Ap = &Dict[Apos];
} while (!(Ap->Flags & Parm));
Bp = &Dict[Bpos];
if (Ap->Type != Bp->Type)
return (0);
Bpos++;
}
if (!(Ap->Flags & More))
return (1);
return (0);
}
//
Headitem = Item;
Headditem = Ditem;
Dlim1 = Dlim;
if (A(Left)) {
for (;;) {
if (Atom != Ident)
Gettype(Parm | More);
if (!(D.Flags & Proc)) {
Getident();
if (!A(Comma) && Atom == Right)
break;
if (Atom != Comma)
Nonstandard(Nocomma);
else
Atom = Nextatom();
} else {
Getident();
Speccing += 2;
Getparmdef();
Speccing -= 2;
if (!A(Comma))
break;
}
}
Dict[Dlim - 1].Flags = Dict[Dlim - 1].Flags - More;
Get(Right);
}
if (Speccing >= 2) {
Dpos = Dictmin;
do {
Dp = &Dict[Dpos];
if ((Dp->Flags & Proc) != 0 && Dp->Type == Headditem->Type)
if (Parmmatch(Dpos)) {
Headditem->Type = Dpos;
Dlim = Dlim1;
return;
}
Dpos++;
} while (Dpos < Headitem);
Fault(Caterr);
Dlim = Dlim1;
return;
}
if (Speccing == 0 && (Headditem->Flags & Spec) != 0) {
Headditem->Flags = Headditem->Flags - Spec;
if (!Parmmatch(Headitem))
Fault(Matcherr);
} else if (Dlim != Dlim1)
Headditem->Flags = Headditem->Flags | More;
} //get PARMDEF
Initial_23: /*keylabel*/
Nonstandard(Klabel);
D.Flags = Lab + Spec;
D.Type = Nulltype;
Getidentlist();
goto Term;
Initial_24:; /*prefix*/
D.Flags = Subatom;
Atom = Nextatom();
Initial_25: /*krange*/ Initial_26:; /*keylong*/
Initial_27: /*keyinteger*/ Initial_28:; /*keyreal*/
Initial_29: /*keystring*/ Initial_30:; /*keyrecord*/
Initial_33:; /*rpred*/
Matched = 0;
Gettype(D.Flags);
if (A(Keyspec)) {
if (A(Left)) {
Getlitint();
Get(Right);
Declmode = (Declmode & Sizemask) + Absmode;
D.Val = T.Val;
Getident();
if (D.Flags & Proc) {
Speccing = 1;
Getparmdef();
}
goto Term;
}
D.Flags = D.Flags + Spec;
if (!(D.Flags & Proc)) {
Getidentlist();
goto Term;
}
}
if (D.Flags & Proc) {
Get(Ident);
if (Item >= C.Localdpos && Ditem->Type == D.Type &&
(Ditem->Flags & Proc) != 0) {
if ((Ditem->Flags & Spec) == 0 || (D.Flags & Spec) != 0) {
Item = 0;
D.Flags = D.Flags + Alt;
Declare();
}
} else
Declare();
if ((D.Flags & Ext) != 0 && A(Alias))
Getlitstring();
if (D.Flags & Spec) {
Speccing = 1;
Getparmdef();
} else {
Openblock(Item);
Getparmdef();
C.Parlim = Dlim;
Compileentry();
Get(Terminator);
Getstatements(End);
Closeblock();
}
} else if (D.Flags == Typeid)
;
else if (D.Flags & Parm) {
D.Flags = D.Flags - Parm;
if (D.Flags & Static)
Getownarraydeclaration();
else {
if ((D.Flags & Static) == 0 && C.Flags >= Hadon) {
Fault(Ordererr);
C.Flags = C.Flags & (~(Hadon + Hadinst));
}
Getarraydeclaration();
}
} else if (D.Flags == Static) {
D.Type = Dict[D.Type & Puretype].Type;
if (D.Type == Recy || D.Type == Stringy)
D.Type = D.Type + Direct;
do {
Getident();
if (!Aassop())
Syntaxerror();
Getliteral(D.Type);
if (Faultnum == Rangerr + Point)
Faultnum = Rangerr + Point + Warn;
Dict[Dlim - 1].Val = T.Val;
} while (A(Comma));
} else if (D.Flags & Static) {
Declmode += Ownmode;
do {
Getident();
T.Val = 0;
if (Aassop()) {
Getliteral(D.Type);
if (Faultnum == Rangerr + Point)
Faultnum = Rangerr + Point + Warn;
}
Elements = 1;
} while (A(Comma));
} else { //dynamic variable
if ((D.Flags & Static) == 0 && C.Flags >= Hadon) {
Fault(Ordererr);
C.Flags = C.Flags & (~(Hadon + Hadinst));
}
do {
C.Delta = C.Delta - Dsize;
if (C.Delta & 1)
C.Delta = C.Delta - 1;
T.Val = C.Sp + C.Delta;
Getident();
if (Aassop()) {
Nonstandard(Initass);
if (D.Type >= Indirect) {
if (Atom != Eqeq)
Fault(Caterr + Point);
Getreference(D.Type);
if (Item)
Item += Ad;
} else {
if (Atom == Eqeq)
Fault(Caterr + Point);
Getvalue(D.Type);
}
}
} while (A(Comma));
}
goto Term;
void Getswitchdeclaration(void) {
int I;
int J;
int Dlim1;
Matched = 1;
do {
D.Flags = Lab;
D.Type = Nulltype;
Declmode = Pcmode + (Wordsize << Sizeshift);
Getidentlist();
Dlim1 = Dlim;
Getlitbounds();
do { //For each ident in group
if (Spc - Elements <= 0)
break; //ignore if too many
for (I = 1; I <= Elements; I++) {
Spc--;
Final[Spc] = 0;
}
Dict[Dlim0].Val = Spc;
Dict[Dlim0].Type = Item;
Dlim0++;
} while (Dlim0 != Dlim1);
} while (A(Comma));
}
Initial_37:; /*keyswitch*/
Getswitchdeclaration();
goto Term;
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!! Control statements !!!!!!!!!!!!!!!!!!!!!!!!!!!
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//
Initial_42:; /*keycontrol*/
Getlitint();
if (!T.Val)
Control = 0;
Control = Control ^ T.Val;
goto Term;
Initial_45:; /*include*/
Getlitstring();
Extra.Name = _imp_str_literal("");
while (T.Val > 0) {
Extra.Name = _imp_join(Extra.Name, Tostring(*Byteinteger(Atomp)));
Atomp++;
T.Val = T.Val - 1;
}
Curlim = Extra.Lim2;
Get(Terminator);
if (!Faultnum) {
Connectedfile(&Extra); // <--- load %include file?
if (Extra.Flag) {
Nonstop = -999;
fprintf(stderr, "%%SIGNAL 12 at line %d\n", __LINE__);
_imp_signal(12, 0, 0, _imp_str_literal(""));
}
Mainfp = Fp;
Mainline = Line;
Line = 0;
Sym = '\n';
Fp = Extra.Start2;
Curstart = Fp;
Curlim = Extra.Lim2;
Modesym = '&';
Nonstop++;
}
goto Next;
Initial_41:; /*keylist*/
goto Term;
Initial_5:; /*begin*/
C.Sp = -8;
Get(Terminator);
Openblock(0);
Getstatements(0);
Closeblock();
if (Stopper >= 0)
goto Term;
return;
Initial_1:; /*end*/
if (!A(Of)) {
if (Stopper == Else || Stopper == Finish)
Fault(Nofinish);
if (Stopper == Repeat)
Fault(Norepeat);
if (Stopper >= 0)
return;
Fault(Nobegin);
goto Term;
}
if (A(Keylist))
goto Term;
if (A(Keyfile)) { /* dangling-else ambiguity fixed here manually */
if (Curlim == Extra.Lim2) {
Switchinput();
goto Next;
}
} else
Get(Program);
} //GET STATEMENTS
void Init(int T, int L, int H) {
D.Flags = Typeid;
D.Type = T;
D.Low = L;
D.Val = H;
Dict[Dlim] = D;
Dlim++;
}
// Ex-bedded static initializers:
Control = Warnbit + Nonsbit;
Free = Allregs;
Dictshown = Dictmin;
Litpos = Litmin;
Slitpos = Litmax;
Dlim = Trueconst + 1;
Permlim = Dictmin;
Dmin = Dictmax - 1;
Explo = Expmax + 1;
Oldexplo = Expmax + 1;
Curlab = Lab1;
Level = Outerlevel;
Ownad = Ownbase;
Spc = Finalbound;
if (_imp_on_event(12)) {
_reset:
if (_imp_on_event(12)) goto _reset; /* reset for next time, although this would cause a problem if %signal 12 raised in this block! */
//fprintf(stderr, "%%ON %%EVENT 12 at line %d\n", __LINE__);
if (Fp == Main->Lim2)
goto Printout;
if (Main->Flag < 0 || Nonstop == -999)
goto Ended; //abandon or CROAK
Change = Main->Change;
}
Printstring(_imp_str_literal(" IMP Checker "));
Newline();
for (I = 0; I <= 255; I++)
Hashindex[I] = 0; //hash table empty
Charbase = Addr(Char[0]);
*Byteinteger(Charbase) = 0; //for anon ident
Charlim = Charbase + 1;
Charmin = Charlim + Charbound; //(1 over top)
for (I = D0; I <= Labmax; I++)
Dict[I].Val = 0;
D.Flags = Typeid;
D.Low = Minint;
D.Val = Maxint;
Dmin = Dictmax - 1;
Dlim = Dictmin;
do {
D.Type = Dlim;
Dict[Dlim] = D;
Dlim++;
} while (Dlim <= Booltype);
D.Flags = 0;
Init(Booltype, 0, 0);
Init(Booltype, 0, 1);
D.Flags = Typeid;
Init(Inty, Minint, Maxint);
Init(Inty, -32768, 32767);
Init(Inty, 0, 65535);
Init(Inty, 0, 255);
Init(Inty, -128, 127);
Init(Inty, 0, 1);
Init(Inty, Minint, Maxint);
Init(Realy, Minint, Maxint);
Init(Realy, Minint, Maxint);
C = (Blockinf){0};
C.Localdpos = Dlim;
C.Parlim = Dlim;
Level = Outerlevel;
Spc = Finalbound;
Faults = 0;
Line = 0;
Mainline = 0;
//
Mainfp = Main->Start1;
Extra.Name = Permfile;
Connectedfile(&Extra); // <--- load ECCE_PERM
if (Extra.Flag) {
Nonstop = -999;
fprintf(stderr, "%%SIGNAL 12 at line %d\n", __LINE__);
_imp_signal(12, 0, 0, _imp_str_literal(""));
}
Fp = Extra.Start2;
Curstart = Fp;
Curlim = Extra.Lim2;
Nonstop = -2;
if (Main->Flag == 'I')
Nonstop = -1;
Sym = '\n';
Getstatements(-1);
Printout:;
if (!Faults) {
Write(Statements, 1);
Printstring(_imp_str_literal(" statements checked "));
} else {
Write(Faults, 1);
Printstring(_imp_str_literal(" fault"));
if (Faults > 1)
Putsym('s');
Printstring(_imp_str_literal(" reported "));
}
Newline();
Ended:;
Newline(); //*for now to ensure message not erased*
} //of ECCECI
#ifdef EDITOR_SUPPORT
void Edi(Edfile *Main, Edfile *Sec, _imp_string Message) {
/*
This is the procedure used to call the editor itself.
MAIN identifies the file being edited and SEC any secondary input file
supplied at the outset (a dummy edfile record set to zero will suffice
if not relevant). Message provides text to be printed at the bottom
of the screen at the outset.
Apart from the fields set up by CONNECT EDFILE (and subsequently modified by
the editor or, compatibly, by other programs), the following fields are
relevant:
FP : the current position in the file, which must always satisfy
either START1 <= FP < LIM1
or START2 <= FP <= LIM2
LINE : the line number of the current line (if known)
If zero, the editor will establish the line number afresh
On return from the editor, any of the pointer values may have changed
and the field CHANGE will identify the earliest position in the file
modified during the last edit. LIM1 is guaranteed to co-incide with
a line break. (Programs which cannot cope with a file split in two,
even at a guaranteed line break, are free to consolidate the file
by copying part 1 DOWN to be adjacent to part2 and adjusting all
pointers accordingly).
FLAG will be negative if the user has abandoned the edit.
*/
}
#endif
void Connectedfile(Edfile *F) { // CONNECT EDFILE - Load included file F->Name here?
/*
This routine is used to connect (ie read into store) a file to be edited.
Before the call, the field NAME should be set to the name of the file,
and the field FLAG should be set to the number of extra bytes to be
allowed for expansion (32k is a typical figure).
On successful return, the file specified will have been read into store
at a system-selected position, the field LIM1 will be equal to START1,
and the fields START2 and LIM2 will delimit the whole of the file.
The fields LINE, CHANGE and FLAG will be zero.
If FLAG is non-zero, this indicates a failure to connect; a report
will already have been made.
*/
char buff[1000000]; // space on stack large enough for file.
FILE *src = fopen(F->Name.cstr.s, "r");
int i, size = 0;
if (src == NULL) {
F->Flag = errno;
fprintf(stderr, "chimps: %s - %s\n", F->Name.cstr.s, strerror(errno));
return;
}
for (;;) {
int c = fgetc(src);
if (c == EOF) break;
buff[size++] = c&255;
}
// Now we know the size, transfer from stack to heap.
F->Start1 = (int)malloc(size+2)+1;
*(char *)(F->Start1-1) = '\n'; // add an extra NL before and after buffer (for Ecce to bounce off)
for (i = 0; i < size; i++) *(char *)(F->Start1+i) = buff[i];
*(char *)(F->Start1+size) = '\n';
F->Lbeg = F->Start1;
F->Lim1 = F->Start1+size;
F->Lim = F->Lim1;
F->Fp = F->Start1;
F->Start2 = F->Lim1;
F->Lim2 = F->Lim1;
//fprintf(stderr, "Checking %s - %d bytes from %d to %d\n", F->Name.cstr.s, size, F->Start1, F->Lim1);
/*
F->Change;
F->Flag;
F->Line;
F->Diff;
F->Shift;
F->Top;
F->Win;
F->Bot;
F->Min;
F->Row;
F->Col;
*/
}
void Disconnectedfile(Edfile *F) { // DISCONNECT EDFILE - Unstack?
/*
This routine is used to close off an edited file. It is particularly
important to ensure that this procedure is called in all cases, even
if the associated program is being abandoned, since otherwise changes
made to the file are all lost.
On return, NAME will indicate the name under which the file was actually
written (maybe different from that originally specified).
*/
free((char *)(F->Start1-1));
}
int _imp_mainep(int _imp_argc, char **_imp_argv) {
Edfile Source = { 0 };
if (_imp_argc != 2) {
fprintf(stderr, "syntax: chimps file.imp\n");
exit(1);
}
Source.Name = _imp_c2istr(_imp_argv[1]);
Connectedfile(&Source);
if (Source.Flag) {
exit(Source.Flag);
}
Ecceci(&Source);
Disconnectedfile(&Source);
exit(0);
}