// OUTSTANDING BUG: behaves differently if all memcpy's are exchanged for memmove's.
//./pass2c impcore-adef.icd,impcore-adef.imp impcore-adef.ibj-c,pass1.lst-c 2>&1 | head -10
// "pass2.c", Line 6946: Opcode MOV is attempting to operate on unexpected location %V7
// (Caused by line 39 of source file impcore-adef.imp)
// - the 'unexpected location' changes on each compilation - so unassigned variable problem...
// Intel 80386 IMP77 compiler second pass
// Copyright 2002 NB Information Limited. From an original
// version probably Copyright The University of Edinburgh and
// various contributions Copyright many other individuals, but
// most particularly Copyright 1977-1980 Peter Robertson
// applied: https://github.com/siliconsam/imp2021/commit/ddd8173fcd3bc799f79d9659edc481f090f95f9d
// Version 2.00 - February 2021
// * Enabled machine code to be embedded (NO floating point implemented)
//
// Version 1.03 - October 2003
// * Properly cleaned up GP TAG list at end of a block
// * Tidied up some constant tables with names (a hangover from the SKIMP version)
// * Corrected ISWORK to only be true for full-size string work blocks
#include "imptoc.h"
#include "impsig.h" // until signals are moved into imptoc.h ...
#ifdef BACKTRACE
// A little experiment to add IMP-style backtracing. Currently only on assertions.
#include "idec-bt.c"
struct backtrace_state *state;
#else
#define bt(x,err) fprintf(stderr, "%s\n", err);
#endif
#ifdef USE_GDB_FOR_BACKTRACE
static int crash1, crash2; // implicitly 0
#endif
char thesourcefilename[255 + 1]; // %string
int rangecheck(int index, int low, int high, char *arrayname, int line, char *file) {
if (index < low || index > high) {
static char errmess[256];
fprintf(stderr, "\"%s\", Line %d: ", file, line);
sprintf(errmess, "Array bound error: %s(%d) outside range %s(%d:%d)\n", arrayname, index, arrayname, low, high);
bt(state, errmess); // this will exit if BACKTRACE is enabled.
#ifdef USE_GDB_FOR_BACKTRACE
crash1 /= crash2;
#else
exit(1); // or force a real error such as divide by zero, to invoke gdb?
#endif
}
return index;
}
#define RANGECHECK(arrayname, idx, line, file) rangecheck(idx, arrayname##_low, arrayname##_high, #arrayname, line, file)
#define DECLARE(type, arrayname, low, high) \
const int arrayname##_base = low; \
const int arrayname##_low = low; \
const int arrayname##_high = high; \
type arrayname[(high)-(low)+1]
#define DECLARE0(type, arrayname, high) \
const int arrayname##_base = 0; \
const int arrayname##_low = 0; \
const int arrayname##_high = high; \
type arrayname[(high)+1]
#define DECLARE1(type, arrayname, high) \
const int arrayname##_base = 0; \
const int arrayname##_low = 1; \
const int arrayname##_high = high; \
type arrayname[(high)+1]
#define ACCESS(arrayname, index) arrayname[RANGECHECK(arrayname, index, __LINE__, __FILE__)-arrayname##_base]
#include "crc32.c" // Could link crc32.o but this is simpler.
int main (int argc, char **argv) { ENTER();
// checksum is a debugging tool to compare the internal state of the program at various
// points with that of what is hoped to be an indentical program (in this case, a C
// version and an Imp version, but equally it could be used to verify before and after
// consistency when making internal changes to a single program.)
#ifdef BACKTRACE
state = backtrace_create_state (argv[0], BACKTRACE_SUPPORTS_THREADS, error_callback, NULL);
#endif
auto void checksum(char *which);
// SIZE CONSTANTS
const int maxvars = 1024;
const int maxstack = 16;
const int maxlabs = 50;
const int maxlevel = 16;
// Some constants had to be made into '#define's so that they could be used in
// array declarations without the C compiler claiming that they were not really constants.
#define maxgp 120
// SOME WEE ENVIRONMENTAL THINGS
const char *programip = "Main Program"; // Main program internal name
const char *programep = "__impmain";
// Main program external name
const char *systemprefix = "_imp_"; // prefixed to %system routine idents
// It *might* be useful to prefix *all* external imp procedures with something and
// rely on %alias "..." to get the unmodified name, so that we can write shims
// that map the standard C library calls to imp procedures of the same name,
// eg. an Imp function "fopen" would be name-mangled to "_imp_fopen" and would
// call the regular "fopen" that is in stdio, which would handle both string
// conversion (Imp style to C) and the necessary reversing of the order of parameters.
// Alternatively %systemroutine could be the unmangled version of the code following
// the unix parameter convention.
// I have to say I'm *awful* tempted to redefine %string in Imp to be C strings
// (for the Imp to C converter, so that the C is more like native C and more maintainable)
// and just live with the few incompatibilities in legacy software. Most of the
// problems can be worked around, eg "length(s) = 4" => "s[4] = '\0'" on writing,
// but "x = length(s)" => "x = strlen(s)" on reading. Like Pop2's setters and getters
// rather than a true %map.
// I/O file handles
// input streams
const int icode = 1;
const int source = 2;
// output streams
const int report = 0;
const int objout = 1;
const int listout = 2;
// DIAGNOSE BITS
const int passid = 2;
// JDM Identify which IMP pass this is
const int mcodeleveld = (1 << 13); // JDM peak level D debug diagnostics of Machine Code
//const int mcodelevelc = (1 << 12); // JDM next level C debug diagnostics of Machine Code UNUSED?
//const int mcodelevelb = (1 << 11); // JDM next level B debug diagnostics of Machine Code UNUSED?
const int mcodelevela = (1 << 10); // JDM base level A debug diagnostics of Machine Code
// CONTROL BITS
const int checkcapacity = 1;
//const int checkunass = 2; UNUSED?
const int checkarray = 4;
const int checkbits = checkarray; // The only one that does anything so far
// NOTE: imp2c: A whole lot of the constants in this code could be replaced by enums.
// (C now allows you to set the value of any element of the enum,
// eg typedef enum { ax = 1, cx, dx, bx, sp, bp, si, di } registers; )
// - just don't use enums that are equal to 0 if you can help it, as
// uninitialised data matches enums that aree 0.
// REGISTERS - basic register number = actual value + 1
const int ax = 1;
const int cx = 2;
const int dx = 3;
const int bx = 4;
const int sp = 5;
const int bp = 6;
const int si = 7;
const int di = 8;
// Floating point coprocessor stack registers
const int fr0 = 9;
// const int fr1 = 10;
// const int fr2 = 11;
// const int fr3 = 12;
// const int fr4 = 13;
// const int fr5 = 14;
// const int fr6 = 15;
const int fr7 = 16;
// 8 bit registers - actual value + 17
#define al 17
const int cl = 18;
//const int dl = 19; UNUSED?
//const int bl = 20; UNUSED?
//const int ah = 21; UNUSED?
//const int ch = 22; UNUSED?
//const int dh = 23; UNUSED?
#define bh 24
// Pseudo Registers
const int any = 25; // Truly any register
const int anyg = 26; // A "General Purpose" byte accessible register (AX, BX, CX, DX)
const int anyp = 27; // A pointing register (BX, SI, DI)
const int anyf = 28; // Generally means the top of the 8087 stack
// DATA FORMS
// EXTERNAL FORM
const int simple = 1;
const int name = 2;
const int _label_ = 3;
const int recordformat = 4;
const int switch_ = 6;
const int array = 11;
const int arrayname = 12;
const int namearray = 13;
const int namearrayname = 14;
// I haven't converted *all* the const ints to #defines because some of the names
// are reused and #defines don't follow the scoping rules, so when the compiler
// sees "#define inc 6" and later "stackfm *inc;" it's just too messy to be worth
// fixing with #undef etc. There's more than just that one example that cause problems.
// INTERNAL
#define constant 0
#define vinr 1
#define avinr 2
#define ainr 3
#define vins 4
#define avins 5
#define ains 6
#define vinrec 7
#define avinrec 8
#define ainrec 9
#define pgmlabel 10
// DATA TYPES
const int general = 0;
const int integer = 1;
const int real = 2;
const int string = 3;
const int record = 4;
// Private internal derived types
const int byte = 5;
const int lreal = 6;
// SIZE OF EACH OF THOSE TYPES IN BYTES
// base value, general, is 0
// This is the sort of expression that requires a '#define' rather than a const int.
// If we ever change any of these constants, we'll need to be careful with places
// like this where the raw numbers are used :-(
DECLARE0(const unsigned char, vsize, 7 /* lreal - general + 1 */) = { 0,4,4,0,0,1,8 }; // zero-based array
#define vsize(r) ACCESS(vsize,r)
// Define type codes known externally (to pass 3 and user):
DECLARE0(const unsigned char, genmap, 7 /* lreal - general + 1 */ ) = { // zero-based array
// base is 'general' which is 0
0, 1, 2, 3, 4, 6, 8
};
#define genmap(r) ACCESS(genmap,r)
// GENERIC STORE ALIGNMENT - ASSUME 80386
const int align = 3;
const int wordsize = 4; // in bytes
// OWN INFO
//const int own = 1; UNUSED?
const int con = 2;
const int external = 3;
const int system = 4;
const int dynamic = 5;
const int primrt = 6;
//const int permrt = 7; UNUSED?
// Procedure end codes
const int map = -2,
fn = -1, // negative implies stacked result
routine = 0,
true = 1,
false = 2;
// PERM ROUTINE INDEXES
const int iexp = 1; // Integer Exponent
const int fexp = 2; // floating exponent
const int smove = 3; // string copy (length checked)
const int sjam = 4; // string copy (whatever fits)
const int sconc = 5; // string concatenate (length checked)
const int sjconc = 6; // concatenate whatever fits
const int sresln = 7; // string resolution
const int scomp = 8; // string compare
const int aref = 9; // array access
const int adef = 10; // array definition
const int signal = 11; // %signal
const int stop = 12; // %stop
const int lastperm = stop;
// and the corresponding linkage names for the perms
DECLARE1(const char *, permname, 13 /* lastperm + 1 */ ) = {
#define permname(r) ACCESS(permname,r)
"*** seriously broken ***", // re-based at 0 for efficiency
"_IMPIEXP",
"_IMPFEXP",
"_IMPSTRCPY",
"_IMPSTRJAM",
"_IMPSTRCAT",
"_IMPSTRJCAT",
"_IMPSTRRES",
"_IMPSTRCMP",
"_IMPAREF",
"_IMPADEF",
"_IMPSIGNAL",
"_IMPSTOP"
};
// Compiler Internal Operations (not to be confused with OpCodes)
#define addx 1
#define subx 2
#define mulx 3
#define divx 4
#define concx 5
#define andx 6
#define orx 7
#define xorx 8
#define lshx 9
#define rshx 10
#define remx 11
#define expx 12
#define rexpx 13
#define rdivx 14
#define notx 15
#define negx 16
#define absx 17
#define unaries 15
// opcode indexes...
// simple (no operand) ones first
#define nop 0
#define cwd 1
#define ret 2
#define sahf 3
#define leave 4
// simple unary math functions
#define dec 5
#define inc_ 6
#define neg 7
#define not 8
// simple unary moves
#define pop 9
#define push 10
// two operand moves
#define lea 11
#define mov 12
#define xchg 13
// simple two operand math functions
#define adc 14
#define add 15
#define and 16
#define cmp 17
#define or 18
#define sub 19
#define xor 20
// slightly more complicated two operand math
#define shl 21
#define shr 22
#define idiv 23
#define imul 24
// calls and jumps
#define call 25
#define je 26
#define jne 27
#define jg 28
#define jge 29
#define jl 30
#define jle 31
#define ja 32
#define jae 33
#define jb 34
#define jbe 35
#define jmp 36
// Floating point instructions - note that these map directly onto
// 8087 sequences, unlike the generic MOV, ADD style of the base
// operations for the 8086
const int fild = 37;
const int fldd = 38;
const int fldq = 39;
const int fsti = 40;
const int fstd = 41;
const int fstq = 42;
const int fadd = 43;
const int fsub = 44;
//const int fsubr = 45; UNUSED?
const int fmul = 46;
const int fdiv = 47;
//const int fdivr = 48; UNUSED?
const int fcmp = 49;
const int fchs = 50;
const int fabs = 51;
// Special floating point things
const int fstsw = 52;
const int fldz = 53;
//const int fldpi = 54; UNUSED?
// modifiers to memory base for accessing global memory
const int data = 0x10;
const int cot = 0x20;
//const int bss = 0x30; UNUSED?
//const int display = 0x40; UNUSED?
const int ext = 0x50;
const int swt = 0x60;
const int code = 0x70;
// Condition codes
// The "Never" test should never! be used. The others are all used
const int eq = 1, lt = 2, gt = 4, tt = 8, always = 7, ne = 6, le = 3, ge = 5, ff = 9, never = 0;
// NOTE: ff is Not Imp's FormFeed character 12!
// ( tt and ff are true/false )
// Base is 'never' which is 0
DECLARE0(const unsigned char, reverse, 10 /* ff - never + 1 */ ) = {
#define reverse(r) ACCESS(reverse,r)
never /* Never */,
eq /* EQ */,
gt /* LT */,
ge /* LE */,
lt /* GT */,
le /* GE */,
ne /* NE */,
always /* Always */,
tt /* TT */,
ff /* FF */
};
#ifdef USE_UNUSED
// Base is 'never' which is 0
DECLARE0(const unsigned char, negated, 10 /* ff - never + 1 */ ) = { // UNUSED?
#define negated(r) ACCESS(negated,r)
always /* Never */,
ne /* EQ */,
ge /* LT */,
gt /* LE */,
le /* GT */,
lt /* GE */,
eq /* NE */,
never /* Always */,
ff /* TT */,
tt /* FF */
};
#endif
// Base is 'never' which is 0
DECLARE0(const unsigned char, testtoop, 10 /* ff - never + 1 */ ) = {
#define testtoop(r) ACCESS(testtoop,r)
jmp /* Never - This is added for completeness */,
je /* EQ */,
jl /* LT */,
jle /* LE */,
jg /* GT */,
jge /* GE */,
jne /* NE */,
jmp /* Always */,
jne /* TT */,
je /* FF */
};
// Base is 'never' which is 0
DECLARE0(const unsigned char, testtounsignedop, 10 /* ff - never + 1 */ ) = {
#define testtounsignedop(r) ACCESS(testtounsignedop,r)
jmp /* Never - This is added for completeness */,
je /* EQ */,
jb /* LT */,
jbe /* LE */,
ja /* GT */,
jae /* GE */,
jne /* NE */,
jmp /* Always */,
jne /* TT */,
je /* FF */
};
// Standard IMPish data structures
// Variables are declared here
// JDM added idname to remember the IMP variable names
typedef struct varfm
{
//char *idname;
char idname[256];
unsigned char type, form, level, scope, dim;
int disp, format, size, pbase, extra, extdisp;
} varfm;
DECLARE0(varfm, var, maxvars + 1); // zero-based array
#define var(r) ACCESS(var,r)
varfm *decvar;
varfm begin;
// The compiler is stack based
// JDM JDM added idname to remember the IMP variable name
typedef struct stackfm
{
//char *idname;
char idname[256];
unsigned char type, form, aform, base, scope, dim;
int disp, format, size, pbase, extra, extdisp, varno;
} stackfm;
DECLARE1(stackfm, stack, maxstack + 1); // re-based at 0 for efficiency
#define stack(r) ACCESS(stack,r)
stackfm null;
stackfm *top;
// Pass 1 uses a lame label redefinition that forces us to map
// label ID's into unique labels for pass 3, using this database
typedef struct labelfm
{ int id, tag; } labelfm;
DECLARE1(labelfm, labels, maxlabs + 1); // re-based at 0 for efficiency
#define labels(r) ACCESS(labels,r)
int jtag; // most recent Jump tag translation - needed when planting event blocks
// NOTE: Imp to C translation: all top-level statics in main() can be safely converted to auto variables,
// which in turn will allow them to be initialised.
// Status of registers
DECLARE0(auto /* static */ int, activity, 16 /* fr7 */ + 1) = { 0, 0, 0, 0, 0, -1, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; // zero-based array
#define activity(r) ACCESS(activity,r)
auto /* static */ int claimed = 0;
// Pointer registers may be pointing to non-local display - we remember
// them for future use
DECLARE(static int, displayhint, /*di*/1, /*ax*/8);
#define displayhint(r) ACCESS(displayhint,r)
// Math Co-processor uses a stack - we remember where it should be
// with this pointer
auto /* static */ int fpustack = 0;
// A general purpose workspace resource
typedef struct gptag { int info, addr, flags, link; } gptag;
DECLARE0(static gptag, gptags, maxgp + 1); // zero-based array gptags(0:maxgp)
#define gptags(r) ACCESS(gptags,r)
int gpasl;
/* static */ int control = checkbits; // Current compiler flags (set by %control statement)
auto /* static */ int diagnose = 0; // Current diagnostic flags (set by %diagnose statement)
//static int languageflags = 0; UNUSED? // Special directive flags for languages (other than standard imp)
// variable 'languageflags' set but not used
auto /* static */ int nextcad = 0; // notional code address (not real - pass3 shuffles stuff)
auto /* static */ int level = 0; // current contextual level
int sym, pending; // CODE SYMBOL, NEXT SYMBOL
int vlb, vub; // VECTOR LOWER/UPPER BOUND
auto /* static */ int currentline = 0; // SOURCE LINE NUMBER
auto /* static */ int stp = 0; // STACK POINTER
int datasize; // CURRENT DATA ITEM SIZE
auto /* static */ int frame = 0; // LOCAL STACK FRAME EXTENT
int parms; // START OF PARAMETER STACK
auto /* static */ int invert = 0; // CONDITION INVERSION FLAG
auto /* static */ int compareunsign = 0;// CONDITION WAS NON-STANDARD (GENERALLY FPU COMPARE)
auto /* static */ int uncondjump = 0; // ADDRESS OF CODE HOLE
auto /* static */ int blocktype = 1; // -1 = RECORDS, 1 = PROCEDURE, 2 = SPEC
auto /* static */ int inparams = 0; // NON-ZERO INSIDE PARAMETER LISTS
int otype, owntype, ownform; // Information about OWNs currently being declared
int spec, potype; // More about current declaration
int i; // used in the initialisation loops only
//int j; UNUSED? // variable 'j' set but not used
//auto /* static */ int fpresultloc = -1; UNUSED? // Place to store Real and LReal function results
const int maxswitch = 1000; // Size in WORDS of switch segment table
DECLARE0(int, swtab, maxswitch + 1); // zero-based array
#define swtab(r) ACCESS(swtab,r)
auto /* static */ int swtp = 0; // pointer to next switch segment entry
DECLARE0(auto /* static */ char, externalid, 256) = { 0 };
#define externalid(r) ACCESS(externalid,r)
DECLARE0(auto /* static */ char, alias, 256) = { 0 };
#define alias(r) ACCESS(alias,r)
DECLARE0(auto /* static */ char, blockname, 256) = { 0 }; // imp2c bug - missing * on all but first entry in the list of declared variables
#define blockname(r) ACCESS(blockname,r)
DECLARE0(unsigned char, currentstring, 255 + 1); // current string literal // zero-based array
#define currentstring(r) ACCESS(currentstring,r)
int xlen;
DECLARE0(unsigned char, xsymbuff, 255 + 1); // current external string name // zero-based array
#define xsymbuff(r) ACCESS(xsymbuff,r)
// WORK List - used to optimise use of temporary storage
// There is a head of list for each contextual level
DECLARE1(/* static */ int, worklist, maxlevel + 1); // re-based at 0 for efficiency
#define worklist(r) ACCESS(worklist,r)
double rvalue; // floating point value for constants and initialisers
auto /* static */ int ownval = 0; // value to use when initialising OWNs
// -----------------------------------------------------------
// Start with machine independent utility functions and stack
// manipulation and debug
// -----------------------------------------------------------
// >> SHOW <<
auto void show (stackfm * v) { ENTER();
// JDM The field widths have been tweaked to align columns
write (v->varno, 4);
printstring (" : Typ="); write (v->type, 1);
printstring (" Frm="); write (v->form, 1);
printstring (" Bse="); write (v->base, 3);
printstring (" Dsp="); write (v->disp, 5);
printstring (" ExtDsp="); write (v->extdisp, 4);
printstring (" Siz="); write (v->size, 3);
printstring (" Xtr="); write (v->extra, 3);
printstring (" Fmt="); write (v->format, 2);
printstring (" Dim="); write (v->dim, 1);
printstring (" Pba="); write (v->pbase, 4);
if (strlen (v->idname) != 0) {
printstring (concat (" Name='", concat (v->idname, "'")));
}
newline ();
}
// Simple ABORT routine
auto void abort_ (char *message, int line, char *file) { ENTER();
#define abort(s) abort_(s, __LINE__, __FILE__)
// at some point, modify this to be "abortf(...)" to allow printf-style parameters...
static int force_gdb;
int j;
selectoutput (report);
#ifdef OLD_ABORT
printstring ("Pass 2 abandoned at line ");
write (currentline, 1);
printstring (" : ");
printstring (message);
newline ();
#else
fflush(stderr); fprintf(stderr, "\"%s\", Line %d: %s\n", file, line, message);
fprintf(stderr, "(Caused by line %d of source file %s)\n", currentline, thesourcefilename);
#endif
if (stp != 0) {
printstring ("STACK: "); write(stp,0); newline ();
for (j = 1; j <= stp; j += 1) { spaces (11); show (&stack(j)); }
}
fflush(stderr); // we were not seeing the output on 'report'
exit (0/force_gdb);
}
// >> WARN <<
auto void warn (int n) { ENTER();
static void *w[ 9 ] = { &&w_default, &&w_1, &&w_2, &&w_3, &&w_4, &&w_5, &&w_6, &&w_7, &&w_8, }; // re-based at 0 for efficiency
selectoutput (report);
printstring ("*WARNING: line");
write (currentline, 1);
printstring (": ");
if (n < 1 || n > 8) goto w_default;
goto *w[n];
w_default: BADSWITCH(n,__LINE__,__FILE__);
w_1: printstring ("division by zero"); goto at;
w_2: printstring ("Illegal FOR"); goto at;
w_3: printstring ("Non-local control variable?"); goto at;
w_4: printstring ("Invalid parameter for READ SYMBOL"); goto at;
w_5: printstring ("String constant too long"); goto at;
w_6: printstring ("No. of shifts outwith 0..31"); goto at;
w_7: printstring ("Illegal constant exponent"); goto at;
w_8: printstring ("Numerical constant too big"); goto at;
at: newline ();
selectoutput (objout);
}
// >> MONITOR <<
auto void monitor (stackfm * v, char *text) { ENTER();
selectoutput (report);
printstring (text); printsymbol (':');
spaces (10 - strlen (text));
show (v);
selectoutput (objout);
}
// >> GET GP TAG <<
auto int getgptag (void) { ENTER();
int l;
if (gpasl == 0) abort ("GP Tags");
l = gpasl;
gpasl = gptags[l].link;
return (l);
}
// >> RET GP TAG <<
auto int retgptag (int index) { ENTER();
int link;
link = gptags[index].link;
gptags[index].link = gpasl;
gpasl = index;
return (link);
}
// ------------------------------------------------------
// Machine dependent utility routines
// ------------------------------------------------------
// Routines to write the intermediate file
// Record format is:
// <type><length><data>
// For debug purposes, the elements are all written as ascii
// characters, where <type> is a single letter, <length> is a single
// hex digit, length refers to the number of bytes (2 chars) of data.
// Intermediate file types:
const int ifobj = 0; // A - plain object code
const int ifdata = 1; // B - dataseg offset code word
const int ifconst = 2; // C - const seg offset code word
const int ifdisplay = 3; // D - display seg offset code word
const int ifjump = 4; // E - unconditional jump to label
const int ifjcond = 5; // F - cond jump to label JE, JNE, JLE, JL, JGE, JG
//const int ifcall = 6; UNUSED? // G - call a label
const int iflabel = 7; // H - define a label
const int iffixup = 8; // I - define location for stack fixup instruction
const int ifsetfix = 9; // J - stack fixup <location> <amount>
const int ifreqext = 10; // K - external name spec
const int ifreflabel = 11; // L - relative address of label (JDM JDM added new IBJ command)
const int ifrefext = 12; // M - external name relative offset code word (call external)
const int ifbss = 13; // N - BSS segment offset code word
const int ifcotword = 14; // O - Constant table word
const int ifdatword = 15; // P - Data segment word
const int ifswtword = 16; // Q - switch table entry - actually a label ID
const int ifsource = 17; // R - name of the source file
const int ifdefextcode = 18; // S - define a code label that is external
const int ifdefextdata = 19; // T - define a data label that is external
const int ifswt = 20; // U - switch table offset code word
const int ifline = 21; // V - line number info for debugger
const int ifabsext = 22; // W - external name absolute offset code word (data external)
auto void writenibble (int n) { ENTER();
n = n & 0xF;
if ((0 <= n && n <= 9)) {
printsymbol (n + '0');
} else {
printsymbol (n + ('A' - 10));
}
}
// print a number in hexadecimal, to "places" size
auto void writehex (int n, int places) { ENTER();
int p, shift;
shift = (places - 1) * 4;
while (shift > 0) {
p = (unsigned int)n >> (unsigned int)shift;
writenibble (p);
shift -= 4;
}
writenibble (n);
}
auto void writeifrecord (int type, int length, unsigned char *buffer) { ENTER(); // make sure that parameter is an array based at 0
int c1, c2, i;
selectoutput (objout);
printsymbol ('A' + type);
if (length > 255) abort ("Intermediate file record too long");
writenibble (length >> 4);
writenibble (length & 15);
i = 0;
while (length > 0) {
c1 = buffer[i] >> 4;
c2 = buffer[i] & 15;
writenibble (c1);
writenibble (c2);
i += 1;
length -= 1;
}
newline ();
}
// Simple buffered output of code bytes...
auto /* static */ int objectptr = 0;
#define objbufmax 20
DECLARE0(static unsigned char, objectbytes, objbufmax + 1 ); // zero-based array // initialised to all 0
#define objectbytes(r) ACCESS(objectbytes,r)
// And corresponding bytes for the listing (not always the same for fudged opcodes)
auto /* static */ int listptr = 0;
#define lstbufmax 11
DECLARE0(static unsigned char, listbytes, lstbufmax + 1 ); // initialised to all 0 // zero-based array
#define listbytes(r) ACCESS(listbytes,r)
// routine to clean to object buffer
auto void clearobjectbuffer (void) { ENTER();
int i;
for (i = 0; i <= objbufmax; i += 1) {
objectbytes(i) = 0;
}
objectptr = 0;
}
// Routine to provide the address and hex opcode listing in the
// diagnostic output
auto void listpreamble (void) { ENTER();
int i;
selectoutput (listout);
space (); writehex (nextcad, 4); space ();
for (i = 0; i <= 7; i += 1) {
if (i < listptr) {
writehex (listbytes(i), 2);
space ();
} else {
spaces (3);
}
}
spaces (8);
nextcad += listptr;
listptr = 0;
}
// flush the code buffer
auto void flushcode (void) { ENTER();
if (objectptr != 0) {
writeifrecord (ifobj, objectptr, objectbytes);
clearobjectbuffer (); // clear the output pipe
}
}
// puts a normal code byte into the listing and code pipes
auto void putcodebyte (int b) { ENTER();
objectbytes(objectptr) = b;
objectptr += 1;
}
// puts a normal code byte into the listing and code pipes
auto void putlistbyte (int b) { ENTER();
listbytes(listptr) = b;
listptr += 1;
}
// puts a normal code byte into the listing and code pipes
auto void putbyte (int b) { ENTER();
putlistbyte (b);
putcodebyte (b);
}
// A very handy little boolean function, used for instructions
// with variable size immediate operands
auto int issmall (int i) { ENTER();
if ((i < 128 && i > -128))
return (1);
return (0);
}
// And aide-memoire of intel 80386 address modes...
// -------------------------
// [EAX]
// [ECX]
// [EDX]
// [EBX]
// [][]
// [disp32]
// [ESI]
// [EDI]
// -------------------------
// [EAX+disp8]
// [ECX+disp8]
// [EDX+disp8]
// [EBX+disp8]
// [][]
// [EBP+disp8]
// [ESI+disp8]
// [EDI+disp8]
// -------------------------
// [EAX+disp32]
// [ECX+disp32]
// [EDX+disp32]
// [EBX+disp32]
// [][]
// [EBP+disp32]
// [ESI+disp32]
// [EDI+disp32]
// -------------------------
// mod r/m format is:
// mod LHREG R/M
// where mod = 11 for rh registers
// plant a modrm reference where the rh operand is a register
// Both parameters are actual register numbers, not internal ID's
auto void modrmreg (int reg1, int reg2) { ENTER();
putbyte (0xC0 | (reg1 << 3) | (reg2));
}
// tags corresponding to linker directives...
DECLARE0(const int, reltag, 6 + 1) = { // zero-based array
#define reltag(r) ACCESS(reltag,r)
0, /* no relocation */
ifdata, /* dataseg offset code word */
ifconst, /* const seg offset code word */
ifbss, /* BSS relative code word */
ifdisplay, /* display seg offset code word */
ifabsext, /* external name absolute offset code word */
ifswt /* switch table offset code word */
};
// plant code for a relocated (DATA/BSS/DISPLAY/EXTERNAL) code word
auto void norelocateoffset (int offset) { ENTER();
int i;
for (i = 1; i <= wordsize; i += 1) {
putbyte (offset & 255);
offset = offset >> 8;
}
}
// plant code for a relocated (DATA/BSS/DISPLAY/EXTERNAL) code word
auto void relocateoffset (int reloc, int offset, int extdisp) { ENTER();
int tag, i;
if (reloc == 0) {
norelocateoffset (offset);
} else {
flushcode (); // so that only the offset is going into the queue
tag = reltag(reloc);
if (tag == ifabsext) {
putbyte (offset & 255); offset = offset >> 8;
putbyte (offset & 255); offset = offset >> 8;
putbyte (extdisp & 255); extdisp = extdisp >> 8;
putbyte (extdisp & 255); extdisp = extdisp >> 8;
writeifrecord (tag, wordsize, objectbytes);
clearobjectbuffer (); // clear the queue
} else {
for (i = 1; i <= wordsize; i += 1) {
putbyte (offset & 255); offset = offset >> 8;
}
writeifrecord (tag, wordsize, objectbytes);
clearobjectbuffer (); // clear the queue
}
}
}
// plant a modrm reference where the rh operand is in memory
// Parameter REG1 is an actual register number, but BASE is an internal ID
auto void modrmmem (int reg1, int base, int disp, int extdisp) { ENTER();
int mod, reloc;
reloc = base >> 4;
base = base & 15;
if (base == 0) { // no register, just a displacement
// mod = 000, rm = 101
putbyte ((reg1 << 3) | 5);
relocateoffset (reloc, disp, extdisp);
} else {
if ((disp == 0 && base != bp)) {
mod = 0;
} else {
if (issmall (disp) != 0) {
// fits in one byte
mod = 1;
} else {
mod = 2;
}
}
// unfortunately displacement (even zero) must be output in full if
// the offset is relocatable
if (reloc != 0) mod = 2;
if ((base > di || base == sp)) {
abort ("Internal address mode error");
}
// Note - base-1 maps internal ID to real register
putbyte ((mod << 6) | (reg1 << 3) | (base - 1));
if (mod == 1) {
putbyte (disp);
} else {
if (mod == 2) relocateoffset (reloc, disp, extdisp);
}
}
}
DECLARE(const char *, regname, /*di*/1, /*ax*/8) = {
"EAX", "ECX", "EDX", "EBX", "ESP", "EBP", "ESI", "EDI"
};
#define regname(r) ACCESS(regname,r)
DECLARE(const char *, reg8name, al, bh) = {
"AL", "CL", "DL", "BL", "AH", "CH", "DH", "BH"
};
#define reg8name(r) ACCESS(reg8name,r)
DECLARE0(const char *, relocname, 6 - 0 + 1) = { // zero-based array
#define relocname(r) ACCESS(relocname,r)
"", "DATA", "COT", "BSS", "DISPLAY", "EXTERN", "SWTAB"
};
// Print the corresponding memory access string
// BASE is an internal ID, not an actual register number
auto void printmemref (int base, int disp) { ENTER();
int reloc;
reloc = base >> 4;
base = base & 15;
selectoutput (listout);
printsymbol ('[');
if (base != 0) {
printstring (regname(base));
if (reloc != 0) {
printsymbol ('+'); printstring (relocname(reloc));
}
if (disp != 0) {
if (disp > 0)
printsymbol ('+');
write (disp, 1);
}
} else {
if (reloc != 0) {
printstring (relocname(reloc));
printsymbol ('+');
}
writehex (disp, 4);
}
printsymbol (']');
}
// I didnt notice until after I was done that nop has the value 0
// and therefore I could have left these as opname[] etc rather
// than using a macro opname().
// opcodes
DECLARE(const char *, opname, nop, jmp) = { // zero-based array
"NOP", "CWD", "RET", "SAHF", "LEAVE",
"DEC", "INC", "NEG", "NOT",
"POP", "PUSH",
"LEA", "MOV", "XCHG",
"ADC", "ADD", "AND", "CMP", "OR", "SUB", "XOR",
"SHL", "SHR", "IDIV", "IMUL",
"CALL", "JE", "JNE",
"JG", "JGE", "JL", "JLE",
"JA", "JAE", "JB", "JBE", "JMP"
};
#define opname(r) ACCESS(opname,r)
DECLARE(const unsigned char, opvalue, nop, jmp) = { // zero-based array
0x90, 0x99, 0xC3, 0x9E, 0xC9,
0xFF, 0xFF, 0xF7, 0xF7,
0x8F, 0xFF,
0x8B, 0x89, 0x87, /* LEA is fudged as if it were m <- r, to allow the flip */
0x11, 0x01, 0x21, 0x39, 0x09, 0x29, 0x31,
0xD1, 0xD1, 0xF7, 0xF7,
0xE8, 0x74, 0x75,
0x7F, 0x7D, 0x7C, 0x7E,
0x77, 0x73, 0x72, 0x76, 0xEB
};
#define opvalue(op) ACCESS(opvalue,op)
// 8 bit equivalent opcodes
DECLARE(const unsigned char, op8value, nop, jmp) = { // zero-based array
0x90, 0x99, 0xC3, 0x9E, 0xC9, /* not 8 bit, included for completeness */
0xFE, 0xFE, 0xF6, 0xF6,
0x8F, 0xFF, /* not 8 bit, included for completeness */
0x8B, 0x88, 0x86, /* LEA is not applicable for 8 bit */
0x10, 0x00, 0x20, 0x38, 0x08, 0x28, 0x30,
0xD0, 0xD0, 0xF6, 0xF6,
0xE8, 0x74, 0x75,
0x7F, 0x7D, 0x7C, 0x7E,
0x77, 0x73, 0x72, 0x76, 0xEB /* not 8 bit, included for completeness */
};
#define op8value(op) ACCESS(op8value,op)
// An opcode with no operands (eg RET)
auto void dumpsimple (int opn) { ENTER();
putbyte (opvalue(opn));
listpreamble ();
printstring (opname(opn));
newline ();
flushcode ();
}
// A special bit of magic, used in record assignment
auto void dumprepmovsb (void) { ENTER();
putbyte (0xF3); // rep
putbyte (0xA4); // movsb
listpreamble ();
printstring ("REP MOVSB");
newline ();
flushcode ();
}
// Used in record = 0 assignment
auto void dumprepstosb (void) { ENTER();
putbyte (0xF3); // rep
putbyte (0xAA); // stosb
listpreamble ();
printstring ("REP STOSB");
newline ();
flushcode ();
}
// unary register operation - DEC, INC, NEG, NOT, POP, PUSH, IDIV, IMUL
// REG is an internal ID, not an actual register number
auto void dumpur (int opn, int reg) { ENTER();
static void *ops[256] = { // imp2c: experimenting with a better construct for sparse switches...
[dec] = &&ops_dec,
[inc_] = &&ops_inc,
[neg] = &&ops_neg,
[not] = &&ops_not,
[pop] = &&ops_pop,
[push] = &&ops_push,
[idiv] = &&ops_idiv,
[imul] = &&ops_imul,
};
displayhint(reg) = 0;
if ((opn < 0) || (opn >= 256) || (ops[opn] == 0)) goto ops_default;
goto *ops[opn];
ops_default: BADSWITCH(opn,__LINE__,__FILE__);
ops_dec: putbyte (0x48 + reg - ax); goto break_;
ops_inc: putbyte (0x40 + reg - ax); goto break_;
ops_neg: putbyte (0xF7); modrmreg (3, reg - ax); goto break_;
ops_not: putbyte (0xF7); modrmreg (2, reg - ax); goto break_;
ops_pop: putbyte (0x58 + reg - ax); goto break_;
ops_push: putbyte (0x50 + reg - ax); goto break_;
ops_idiv: putbyte (0xF7); modrmreg (7, reg - ax); goto break_;
ops_imul: putbyte (0xF7); modrmreg (5, reg - ax); goto break_;
break_:
listpreamble ();
printstring (opname(opn));
space ();
printstring (regname(reg));
newline ();
flushcode ();
}
// Plant code for a unary operation on memory
// BASE is an internal ID, not the actual register number
auto void dumpum (int opn, int base, int disp, int extdisp) { ENTER();
static void *ops[ 256 ] = {
[dec] = &&ops_dec,
[inc_] = &&ops_inc,
[neg] = &&ops_neg,
[not] = &&ops_not,
[pop] = &&ops_pop,
[push] = &&ops_push,
[idiv] = &&ops_idiv,
[imul] = &&ops_imul,
[jmp] = &&ops_jmp,
[call] = &&ops_call,
};
if ((opn < 0) || (opn >= 256) || (ops[opn] == 0)) goto ops_default;
goto *ops[opn];
ops_default: BADSWITCH(opn,__LINE__,__FILE__);
ops_dec: putbyte (0xFF); modrmmem (1, base, disp, extdisp); goto break_;
ops_inc: putbyte (0xFF); modrmmem (0, base, disp, extdisp); goto break_;
ops_neg: putbyte (0xF7); modrmmem (3, base, disp, extdisp); goto break_;
ops_not: putbyte (0xF7); modrmmem (2, base, disp, extdisp); goto break_;
ops_pop: putbyte (0x8F); modrmmem (0, base, disp, extdisp); goto break_;
ops_push: putbyte (0xFF); modrmmem (6, base, disp, extdisp); goto break_;
ops_idiv: putbyte (0xF7); modrmmem (7, base, disp, extdisp); goto break_;
ops_imul: putbyte (0xF7); modrmmem (5, base, disp, extdisp); goto break_;
ops_jmp: putbyte (0xFF); modrmmem (4, base, disp, extdisp); goto break_;
ops_call: putbyte (0xFF); modrmmem (2, base, disp, extdisp); goto break_;
break_:
listpreamble ();
printstring (opname(opn));
printstring (" WORD "); // otherwise it's ambiguous for the reader
printmemref (base, disp);
newline ();
flushcode ();
}
// Plant code for a unary operation on an 8 bit memory location
// Not all of the possible unary ops make sense as 8 bit destinations
// BASE is an internal ID, not the actual register number
auto void dumpum8 (int opn, int base, int disp, int extdisp) { ENTER();
int baseop, index;
if ((opn == dec || opn == inc_)) {
baseop = 0xFE;
if (opn == dec) index = 1; else index = 0;
} else {
if ((opn == not || opn == neg)) {
baseop = 0xF6;
if (opn == not) index = 2; else index = 3;
} else {
abort ("Invalid UM8");
}
}
putbyte (baseop);
modrmmem (index, base, disp, extdisp);
listpreamble ();
printstring (opname(opn));
printstring (" BYTE "); // otherwise it's ambiguous for the reader
printmemref (base, disp);
newline ();
flushcode ();
}
// Plant a Memory <- Reg operation
// Both BASE and REG are internal ID's, not actual register numbers
auto void dumpmr (int opn, int base, int disp, int extdisp, int reg) { ENTER();
if (opn == shl) { // special "shift by CL"
putbyte (0xD3);
modrmmem (4, base, disp, extdisp);
} else {
if (opn == shr) {
putbyte (0xD3);
modrmmem (5, base, disp, extdisp);
} else { // normal stuff
putbyte (opvalue(opn));
modrmmem (reg - ax, base, disp, extdisp);
}
}
listpreamble ();
printstring (opname(opn));
space ();
printmemref (base, disp);
printsymbol (',');
if (reg == 0) {
fprintf(stderr, "************************ reg = 0 at line %d *************************\n",currentline);
}
printstring (regname(reg)); // <------------------------------- Array bound error: regname(0) outside range regname(1:8)
/* Only when compiling on an ARM processor...
#3 0x00015060 in dumpmr (opn=12, base=6, disp=-8, extdisp=-8, reg=0) at pass2.c:1212
1212 printstring (regname(reg)); // <------------------------------- Array bound error: regname(0) outside range regname(1:8)
(gdb) up
#4 0x00020f18 in storereg (lhs=0xbefb4284, reg=0) at pass2.c:4233
4233 dumpmr (mov, lhs->base | lhs->scope, lhs->disp, lhs->extdisp, reg);
(gdb) up
#5 0x0002d8f0 in machinecode (code_impstr=0x50dd8 "\rMOV_ ") at pass2.c:6960
6960 storereg (top, params(2).paramvalue);
(gdb) up
#6 0x0001c8b4 in assemble () at pass2.c:7522
7522 machinecode (getascii_impstring (';'));
(gdb) up
#7 0x0001c934 in assemble () at pass2.c:7537
7537 assemble (blocktype, labs, names);
(gdb) up
#8 0x000134b4 in main (argc=3, argv=0xbefff274) at pass2.c:7725
7725 assemble (-3, 0, 0);
*/
newline ();
flushcode ();
}
// Plant an 8 bit Memory <- Reg operation
// Both BASE and REG are internal ID's, not actual register numbers
auto void dumpmr8 (int opn, int base, int disp, int extdisp, int reg) { ENTER();
if (opn == shl) { // special "shift by CL"
putbyte (0xD2);
modrmmem (4, base, disp, extdisp);
} else {
if (opn == shr) {
putbyte (0xD2);
modrmmem (5, base, disp, extdisp);
} else { // normal stuff
putbyte (op8value(opn));
modrmmem (reg - al, base, disp, extdisp);
}
}
listpreamble ();
printstring (opname(opn));
space ();
printmemref (base, disp);
printsymbol (',');
printstring (reg8name(reg));
newline ();
flushcode ();
}
// Plant a 16 bit Reg <- Memory operation
// Both BASE and REG are internal ID's, not actual register numbers
auto void dumprm (int opn, int reg, int base, int disp, int extdisp) { ENTER();
// We optimise the fairly common instruction MOV AX,[disp] with
// the special short-form quirk of the 8086...
if (reg == ax && opn == mov && ((base & 15) == 0)) {
putbyte (0xA1);
relocateoffset (base >> 4, disp, extdisp);
} else {
if (reg == 0) {
fprintf(stderr, "************************ reg = 0 at line %d *************************\n",currentline);
}
displayhint(reg) = 0; // <-- Array bound error: displayhint(0) outside range displayhint(1:8)
/*
#3 0x00015370 in dumprm (opn=12, reg=0, base=6, disp=-36, extdisp=-36) at pass2.c:1273
1273 displayhint(reg) = 0; // <-- Array bound error: displayhint(0) outside range displayhint(1:8)
(gdb) up
#4 0x00020b14 in loadreg (v=0xbefb4284, r=0) at pass2.c:4159
4159 dumprm (mov, r, v->base | v->scope, v->disp, v->extdisp);
(gdb) up
#5 0x0002e690 in machinecode (code_impstr=0x50df0 "\rMOV_N") at pass2.c:7003
7003 loadreg (top, params(1).paramvalue);
(gdb) up
#6 0x0001c8c0 in assemble () at pass2.c:7505
7505 machinecode (getascii_impstring (';'));
(gdb) up
#7 0x0001c940 in assemble () at pass2.c:7520
7520 assemble (blocktype, labs, names);
(gdb) up
#8 0x000134b4 in main (argc=3, argv=0xbefff274) at pass2.c:7708
7708 assemble (-3, 0, 0);
*/
putbyte (opvalue(opn) + 2);
modrmmem (reg - ax, base, disp, extdisp);
}
listpreamble ();
printstring (opname(opn));
space ();
printstring (regname(reg));
printsymbol (',');
printmemref (base, disp);
newline ();
flushcode ();
}
// Plant an 8 bit Reg <- Memory operation
// Both BASE and REG are internal ID's, not actual register numbers
auto void dumprm8 (int opn, int reg, int base, int disp, int extdisp) { ENTER();
putbyte (op8value(opn) + 2);
modrmmem (reg - al, base, disp, extdisp);
listpreamble ();
printstring (opname(opn));
space ();
printstring (reg8name(reg));
printsymbol (',');
printmemref (base, disp);
newline ();
flushcode ();
}
// Plant a word Reg <- Reg operation
// Both register parameters are internal ID's
auto void dumprr (int opn, int reg1, int reg2) { ENTER();
displayhint(reg1) = 0;
if (opn == shl) { // special "shift by CL"
putbyte (0xD3);
modrmreg (4, reg1 - ax);
} else {
if (opn == shr) {
putbyte (0xD3);
modrmreg (5, reg1 - ax);
} else { // normal stuff
putbyte (opvalue(opn));
modrmreg (reg2 - ax, reg1 - ax);
}
}
listpreamble ();
printstring (opname(opn));
space ();
printstring (regname(reg1));
printsymbol (',');
printstring (regname(reg2));
newline ();
flushcode ();
}
#ifdef USE_UNUSED
auto void dumprr8 (int opn, int reg1, int reg2) { ENTER(); // WARNING: Apparently not used?
if (opn == shl) { // special "shift by CL"
putbyte (0xD2);
modrmreg (4, reg1 - al);
} else {
if (opn == shr) {
putbyte (0xD2);
modrmreg (5, reg1 - al);
} else {
putbyte (op8value(opn));
modrmreg (reg2 - al, reg1 - al);
}
}
listpreamble ();
printstring (opname(opn));
space ();
printstring (reg8name(reg1));
printsymbol (',');
printstring (reg8name(reg2));
newline ();
flushcode ();
}
#endif // UNUSED?
DECLARE(const unsigned char, aximmediatevalue, nop, xor) = { // zero-based array
0, 0, 0, 0, 0,
0, 0, 0, 0,
0, 0,
0, 0xB8, 0,
0x15, 0x05, 0x25, 0x3D, 0x0D, 0x2D, 0x35
};
#define aximmediatevalue(op) ACCESS(aximmediatevalue,op)
// Register immediate operations - can be MOV, Math, or Shift
// The immediate operand may be a relocated offset as part of
// an address calculation
auto void dumprioffset (int opn, int reg, int reloc, int immed, int extdisp) { ENTER();
int subop;
static void *ops[ 256 ] = {
[mov] = &&ops_mov, /* mov */
[add] = &&ops_add, /* add */
[adc] = &&ops_adc, /* adc */
[cmp] = &&ops_cmp, /* cmp */
[sub] = &&ops_sub, /* sub */
[and] = &&ops_and, /* and */
[or] = &&ops_or, /* or */
[xor] = &&ops_xor, /* xor */
[shl] = &&ops_shl, /* shl */
[shr] = &&ops_shr, /* shr */
};
displayhint(reg) = 0;
reloc = reloc >> 4; // because we pass around the or-able version
if ((reg == ax && opn <= xor)) {
putbyte (aximmediatevalue(opn));
relocateoffset (reloc, immed, extdisp);
goto break_;
} else {
if ((opn < 0) || (opn >= 256) || (ops[opn] == 0)) goto ops_default;
goto *ops[opn];
ops_default: BADSWITCH(opn, __LINE__, __FILE__);
}
ops_mov: putbyte (0xB8 + reg - ax); relocateoffset (reloc, immed, extdisp); goto break_;
ops_add: /* add */
subop = 0;
if ((issmall (immed) != 0 && reloc == 0)) {
putbyte (0x83);
modrmreg (subop, reg - ax);
putbyte (immed & 255);
} else {
putbyte (0x81);
modrmreg (subop, reg - ax);
relocateoffset (reloc, immed, extdisp);
}
goto break_;
ops_adc: /* adc */
subop = 2;
if ((issmall (immed) != 0 && reloc == 0)) {
putbyte (0x83);
modrmreg (subop, reg - ax);
putbyte (immed & 255);
} else {
putbyte (0x81);
modrmreg (subop, reg - ax);
relocateoffset (reloc, immed, extdisp);
}
goto break_;
ops_cmp: /* cmp */
subop = 7;
if ((issmall (immed) != 0 && reloc == 0)) {
putbyte (0x83);
modrmreg (subop, reg - ax);
putbyte (immed & 255);
} else {
putbyte (0x81);
modrmreg (subop, reg - ax);
relocateoffset (reloc, immed, extdisp);
}
goto break_;
ops_sub: /* sub */
subop = 5;
if ((issmall (immed) != 0 && reloc == 0)) {
putbyte (0x83);
modrmreg (subop, reg - ax);
putbyte (immed & 255);
} else {
putbyte (0x81);
modrmreg (subop, reg - ax);
relocateoffset (reloc, immed, extdisp);
}
goto break_;
ops_and: /* and */
subop = 4;
putbyte (0x81);
modrmreg (subop, reg - ax);
relocateoffset (reloc, immed, extdisp); goto break_;
ops_or: /* or */
subop = 1;
putbyte (0x81);
modrmreg (subop, reg - ax);
relocateoffset (reloc, immed, extdisp); goto break_;
ops_xor: /* xor */
subop = 6;
putbyte (0x81);
modrmreg (subop, reg - ax);
relocateoffset (reloc, immed, extdisp); goto break_;
ops_shl: /* shl */
subop = 4;
if (immed == 1) { // special shift-by-one instruction
putbyte (0xD1);
modrmreg (subop, reg - ax);
} else {
putbyte (0xC1);
modrmreg (subop, reg - ax);
putbyte (immed);
}
goto break_;
ops_shr: /* shr */
subop = 5;
if (immed == 1) { // special shift-by-one instruction
putbyte (0xD1);
modrmreg (subop, reg - ax);
} else {
putbyte (0xC1);
modrmreg (subop, reg - ax);
putbyte (immed);
}
goto break_;
break_:
listpreamble ();
printstring (opname(opn));
space ();
printstring (regname(reg));
printsymbol (',');
if (reloc != 0) {
printstring (relocname(reloc)); printsymbol ('+');
}
write (immed, 1);
newline ();
flushcode ();
}
// Register immediate operations - can be MOV, Math, or Shift
auto void dumpri (int opn, int reg, int immed) { ENTER();
int subop;
static void *ops[ 256 ] = {
[mov] = &&ops_mov, /* mov */
[add] = &&ops_add, /* add */
[adc] = &&ops_adc, /* adc */
[cmp] = &&ops_cmp, /* cmp */
[sub] = &&ops_sub, /* sub */
[and] = &&ops_and, /* and */
[or] = &&ops_or, /* or */
[xor] = &&ops_xor, /* xor */
[shl] = &&ops_shl, /* shl */
[shr] = &&ops_shr, /* shr */
};
displayhint(reg) = 0;
if ((reg == ax && opn <= xor)) {
putbyte (aximmediatevalue(opn));
norelocateoffset (immed);
goto break_;
} else {
if ((opn < 0) || (opn >= 256) || (ops[opn] == 0)) goto ops_default;
goto *ops[opn];
ops_default: BADSWITCH(opn,__LINE__,__FILE__);
}
ops_mov:
putbyte (0xB8 + reg - ax); norelocateoffset (immed); goto break_;
ops_add: /* add */
subop = 0;
if (issmall (immed) != 0) {
putbyte (0x83);
modrmreg (subop, reg - ax);
putbyte (immed & 255);
} else {
putbyte (0x81);
modrmreg (subop, reg - ax);
norelocateoffset (immed);
}
goto break_;
ops_adc: /* adc */
subop = 2;
if (issmall (immed) != 0) {
putbyte (0x83);
modrmreg (subop, reg - ax);
putbyte (immed & 255);
} else {
putbyte (0x81);
modrmreg (subop, reg - ax);
norelocateoffset (immed);
}
goto break_;
ops_cmp: /* cmp */
subop = 7;
if (issmall (immed) != 0) {
putbyte (0x83);
modrmreg (subop, reg - ax);
putbyte (immed & 255);
} else {
putbyte (0x81);
modrmreg (subop, reg - ax);
norelocateoffset (immed);
}
goto break_;
ops_sub: /* sub */
subop = 5;
if (issmall (immed) != 0) {
putbyte (0x83);
modrmreg (subop, reg - ax);
putbyte (immed & 255);
} else {
putbyte (0x81);
modrmreg (subop, reg - ax);
norelocateoffset (immed);
}
goto break_;
ops_and: /* and */
subop = 4;
putbyte (0x81);
modrmreg (subop, reg - ax);
norelocateoffset (immed);
goto break_;
ops_or: /* or */
subop = 1;
putbyte (0x81);
modrmreg (subop, reg - ax);
norelocateoffset (immed);
goto break_;
ops_xor: /* xor */
subop = 6;
putbyte (0x81);
modrmreg (subop, reg - ax);
norelocateoffset (immed);
goto break_;
ops_shl: /* shl */
subop = 4;
if (immed == 1) {
// special shift-by-one instruction
putbyte (0xD1);
modrmreg (subop, reg - ax);
} else {
putbyte (0xC1);
modrmreg (subop, reg - ax);
putbyte (immed);
}
goto break_;
ops_shr: /* shr */
subop = 5;
if (immed == 1) {
// special shift-by-one instruction
putbyte (0xD1);
modrmreg (subop, reg - ax);
} else {
putbyte (0xC1);
modrmreg (subop, reg - ax);
putbyte (immed);
}
goto break_;
break_:
listpreamble ();
printstring (opname(opn));
space ();
printstring (regname(reg));
printsymbol (',');
write (immed, 1);
newline ();
flushcode ();
}
// Memory (word) immediate operations - can be MOV, Math, or Shift
auto void dumpmi (int opn, int base, int disp, int extdisp, int immed) { ENTER();
int subop;
static void *ops[ 256 ] = {
[mov] = &&ops_mov, /* mov */
[add] = &&ops_add, /* add */
[adc] = &&ops_adc, /* adc */
[cmp] = &&ops_cmp, /* cmp */
[sub] = &&ops_sub, /* sub */
[and] = &&ops_and, /* and */
[or] = &&ops_or, /* or */
[xor] = &&ops_xor, /* xor */
[shl] = &&ops_shl, /* shl */
[shr] = &&ops_shr, /* shr */
};
if ((opn < 0) || (opn >= 256) || (ops[opn] == 0)) goto ops_default;
goto *ops[opn];
ops_default: BADSWITCH(opn,__LINE__,__FILE__);
ops_mov: /* mov */
putbyte (0xC7);
modrmmem (0, base, disp, extdisp);
norelocateoffset (immed);
goto break_;
ops_add: /* add */
subop = 0;
if (issmall (immed) != 0) {
putbyte (0x83);
modrmmem (subop, base, disp, extdisp);
putbyte (immed & 255);
} else {
putbyte (0x81);
modrmmem (subop, base, disp, extdisp);
norelocateoffset (immed);
}
goto break_;
ops_adc: /* adc */
subop = 2;
if (issmall (immed) != 0) {
putbyte (0x83);
modrmmem (subop, base, disp, extdisp);
putbyte (immed & 255);
} else {
putbyte (0x81);
modrmmem (subop, base, disp, extdisp);
norelocateoffset (immed);
}
goto break_;
ops_cmp: /* cmp */
subop = 7;
if (issmall (immed) != 0) {
putbyte (0x83);
modrmmem (subop, base, disp, extdisp);
putbyte (immed & 255);
} else {
putbyte (0x81);
modrmmem (subop, base, disp, extdisp);
norelocateoffset (immed);
}
goto break_;
ops_sub: /* sub */
subop = 5;
if (issmall (immed) != 0) {
putbyte (0x83);
modrmmem (subop, base, disp, extdisp);
putbyte (immed & 255);
} else {
putbyte (0x81);
modrmmem (subop, base, disp, extdisp);
norelocateoffset (immed);
}
goto break_;
ops_and: /* and */
subop = 4;
putbyte (0x81);
modrmmem (subop, base, disp, extdisp);
norelocateoffset (immed);
goto break_;
ops_or: /* or */
subop = 1;
putbyte (0x81);
modrmmem (subop, base, disp, extdisp);
norelocateoffset (immed);
goto break_;
ops_xor: /* xor */
subop = 6;
putbyte (0x81);
modrmmem (subop, base, disp, extdisp);
norelocateoffset (immed);
goto break_;
ops_shl: /* shl */
subop = 4;
if (immed == 1) {
// special shift-by-one instruction
putbyte (0xD1);
modrmmem (subop, base, disp, extdisp);
} else {
putbyte (0xC1);
modrmmem (subop, base, disp, extdisp);
putbyte (immed);
}
goto break_;
ops_shr: /* shr */
subop = 5;
if (immed == 1) {
// special shift-by-one instruction
putbyte (0xD1);
modrmmem (subop, base, disp, extdisp);
} else {
putbyte (0xC1);
modrmmem (subop, base, disp, extdisp);
putbyte (immed);
}
goto break_;
break_:
listpreamble ();
printstring (opname(opn));
printstring (" WORD "); // otherwise it's ambiguous for the reader
printmemref (base, disp);
printsymbol (',');
write (immed, 1);
newline ();
flushcode ();
}
// Memory (8 bit) immediate operations - can be MOV, Math, or Shift
auto void dumpmi8 (int opn, int base, int disp, int extdisp, int immed) { ENTER();
int subop;
static void *ops[ 256 ] = {
[mov] = &&ops_mov, /* mov */
[add] = &&ops_add, /* add */
[adc] = &&ops_adc, /* adc */
[cmp] = &&ops_cmp, /* cmp */
[sub] = &&ops_sub, /* sub */
[and] = &&ops_and, /* and */
[or] = &&ops_or, /* or */
[xor] = &&ops_xor, /* xor */
[shl] = &&ops_shl, /* shl */
[shr] = &&ops_shr, /* shr */
};
if ((opn < 0) || (opn >= 256) || (ops[opn] == 0)) goto ops_default;
goto *ops[opn];
ops_default: BADSWITCH(opn,__LINE__,__FILE__);
ops_mov: /* mov */
subop = 0;
putbyte (0xC6);
modrmmem (subop, base, disp, extdisp);
putbyte (immed & 255); goto break_;
ops_add: /* add */
subop = 0;
putbyte (0x80);
modrmmem (subop, base, disp, extdisp);
putbyte (immed & 255); goto break_;
ops_adc: /* adc */
subop = 2;
putbyte (0x80);
modrmmem (subop, base, disp, extdisp);
putbyte (immed & 255); goto break_;
ops_cmp: /* cmp */
subop = 7;
putbyte (0x80);
modrmmem (subop, base, disp, extdisp);
putbyte (immed & 255);
goto break_;
ops_sub: /* sub */
subop = 5;
putbyte (0x80);
modrmmem (subop, base, disp, extdisp);
putbyte (immed & 255);
goto break_;
ops_and: /* and */
subop = 4;
putbyte (0x80);
modrmmem (subop, base, disp, extdisp);
putbyte (immed & 255);
goto break_;
ops_or: /* or */
subop = 1;
putbyte (0x80);
modrmmem (subop, base, disp, extdisp);
putbyte (immed & 255);
goto break_;
ops_xor: /* xor */
subop = 6;
putbyte (0x80);
modrmmem (subop, base, disp, extdisp);
putbyte (immed & 255);
goto break_;
ops_shl: /* shl */
subop = 4;
if (immed == 1) {
// special shift-by-one instruction
putbyte (0xD0);
modrmmem (subop, base, disp, extdisp);
} else {
putbyte (0xC0);
modrmmem (subop, base, disp, extdisp);
putbyte (immed);
}
goto break_;
ops_shr: /* shr */
subop = 5;
if (immed == 1) {
// special shift-by-one instruction
putbyte (0xD0);
modrmmem (subop, base, disp, extdisp);
} else {
putbyte (0xC0);
modrmmem (subop, base, disp, extdisp);
putbyte (immed);
}
goto break_;
break_:
listpreamble ();
printstring (opname(opn));
printstring (" BYTE "); // otherwise it's ambiguous for the reader
printmemref (base, disp);
printsymbol (',');
write (immed, 1);
newline ();
flushcode ();
}
// Finally, a catch-all that recasts operations using generic
// Var Stack structures
// Plant a 16 bit Reg <- Var operation
auto void dumprv (int opn, int reg, stackfm * v) { ENTER();
if (v->form == vinr) {
dumprr (opn, reg, v->base);
} else {
if (v->form == vins) {
dumprm (opn, reg, v->base | v->scope, v->disp, v->extdisp);
} else {
if (v->form == constant) {
dumprioffset (opn, reg, v->scope, v->disp, v->extdisp);
} else {
abort ("Address Mode");
}
}
}
}
// Another special dumper - the only "Unary" operation that
// takes an immediate operand is PUSH
auto void dumppushi (int reloc, int immed, int extdisp) { ENTER();
reloc = reloc >> 4; // because we pass around the or-able version
if ((reloc == 0 && issmall (immed) != 0)) {
putbyte (0x6A);
putbyte (immed & 255);
} else {
putbyte (0x68);
relocateoffset (reloc, immed, extdisp);
}
listpreamble ();
printstring ("PUSH");
space ();
if (reloc != 0) {
printstring (relocname(reloc)); printsymbol ('+');
}
write (immed, 1);
newline ();
flushcode ();
}
auto void dumpvpush (stackfm * v) { ENTER();
if (v->form == vinr) {
dumpur (push, v->base);
} else {
if (v->form == vins) {
dumpum (push, v->base | v->scope, v->disp, v->extdisp);
} else {
if (v->form == constant) {
dumppushi (v->scope, v->disp, v->extdisp);
} else {
abort ("Push Mode");
}
}
}
}
// ----------------------------------------------------------
// Floating point instructions - much simpler since there are
// only two forms - RR and RM
DECLARE(const char *, flopname, /*fild*/37, /*fldpi*/54) = {
"FILD", "FLD DWORD", "FLD QWORD", "FISTP",
"FSTP DWORD", "FSTP QWORD", "FADDP", "FSUBP",
"FSUBRP", "FMULP", "FDIVP", "FDIVRP",
"FCOMPP", "FCHS", "FABS",
"FSTSW AX", "FLDZ", "FLDPI"
};
#define flopname(op) ACCESS(flopname,op)
// The prefix opcode
DECLARE(const unsigned char, flprefix, /*fild*/37, /*fldpi*/54) = {
0xDB, 0xD9, 0xDD, 0xDB,
0xD9, 0xDD, 0xDE, 0xDE,
0xDE, 0xDE, 0xDE, 0xDE,
0xDE, 0xD9, 0xD9,
0xDF, 0xD9, 0xD9
};
#define flprefix(op) ACCESS(flprefix,op)
// The function selector to put in the field in the second byte
// (or the second byte)
DECLARE(const unsigned char, flindex, /*fild*/37, /*fldpi*/54) = {
0x00, 0x00, 0x00, 0x03,
0x03, 0x03, 0xC0, 0xE8,
0xE0, 0xC8, 0xF8, 0xF0,
0xD8, 0xE0, 0xE1,
0xE0, 0xEE, 0xEB
};
#define flindex(op) ACCESS(flindex,op)
// Plant a Floating Point Reg <- Memory operation
// BASE is an internal ID, not actual register number
// Destination register is implicitly the stack top
auto void dumpfloprm (int opn, int base, int disp, int extdisp) { ENTER();
if (opn <= fldq) { // a load type
fpustack += 1;
if (fpustack > 8) abort ("FPU Stack Overflow");
} else {
fpustack -= 1;
if (fpustack < 0) abort ("FPU Stack Underflow");
}
// putbyte(16_9B); ! we prepend a WAIT to everything
putbyte (flprefix(opn));
modrmmem (flindex(opn), base, disp, extdisp);
listpreamble ();
printstring (flopname(opn));
space ();
printmemref (base, disp);
newline ();
flushcode ();
}
// Plant a Floating Point Reg <- Reg operation
// Both register parameters are internal ID's that we
// convert to stack offsets
auto void dumpfloprr (int opn, int reg1, int reg2) { ENTER();
int top;
top = fpustack + (fr0 - 1);
if (reg2 != top) abort ("FPU Stack Address");
if (opn < fchs) { // two operands - will pop one
fpustack -= 1;
if (opn == fcmp) fpustack -= 1; // COMPP pops both registers
if (fpustack < 0) abort ("FPU Stack Underflow");
}
// putbyte(16_9B); ! we prepend a WAIT to everything
putbyte (flprefix(opn));
putbyte (flindex(opn) | (top - reg1));
listpreamble ();
printstring (flopname(opn));
space ();
printstring ("ST(");
write (top - reg1, 1);
printstring ("),ST");
newline ();
flushcode ();
}
// Plant a "special" floating point operation
auto void dumpflopspec (int opn) { ENTER();
if (opn >= fldz) { // load a constant
fpustack += 1;
if (fpustack > 8) abort ("FPU Stack Overflow");
}
// putbyte(16_9B); ! we prepend a WAIT to everything
putbyte (flprefix(opn));
putbyte (flindex(opn));
listpreamble ();
printstring (flopname(opn));
newline ();
flushcode ();
}
auto void dumpjump (int opn, int labelid) { ENTER();
// we put conventional assembler into the pipe for the listing
// (with a zero jump offset) but then re-use the pipe for the
// pseudo-code for the jump
putbyte (opvalue(opn));
putbyte (0);
if (opn == call) putbyte (0);
listpreamble ();
printstring (opname(opn));
space ();
if (opn == call) {
// See if we can show the routine name
printstring (concat ("'", concat (top->idname, "' (INTERNAL "))); // this will be fixed when I change idname to a string instead of a pointer
printsymbol ('L');
write (labelid, 1);
printstring (" )");
} else {
printsymbol ('L');
write (labelid, 1);
}
newline ();
clearobjectbuffer (); // zap the current contents of the pipe
if (opn == jmp) {
putcodebyte (labelid & 255);
putcodebyte (labelid >> 8);
writeifrecord (ifjump, 2, objectbytes);
clearobjectbuffer (); // zap the current contents of the pipe
} else if (opn == call) {
// JDM replaced use of IF CALL command by IF REFLABEL command
// ! Generated code using IF CALL ibj command
// putcodebyte(labelid & 255)
// putcodebyte(labelid >> 8)
// writeifrecord(IF CALL, 2, objectbytes)
// ClearObjectBuffer; ! zap the current contents of the pipe
// JDM JDM Generated code using IF REFLABEL ibj command
// plant the CALL code
putcodebyte (0xE8); // call with relative address
writeifrecord (ifobj, 1, objectbytes);
clearobjectbuffer (); // zap the current contents of the pipe
// plant the relative address of the label
putcodebyte (labelid & 255);
putcodebyte (labelid >> 8);
putcodebyte (0); // JDM set offset to zero
putcodebyte (0);
writeifrecord (ifreflabel, 4, objectbytes);
clearobjectbuffer (); // zap the current contents of the pipe
} else {
// not an unconditional JMP or a CALL
// assume it is a conditional JMP (i.e. JE,JNE, etc.)
putcodebyte (opn - je);
putcodebyte (labelid & 255);
putcodebyte (labelid >> 8);
writeifrecord (ifjcond, 3, objectbytes);
clearobjectbuffer (); // zap the current contents of the pipe
}
// finally, calls may trash registers...
if (opn == call) {
displayhint(bx) = 0;
displayhint(si) = 0;
displayhint(di) = 0;
}
}
// call the n'th external routine we've spec'ed
auto void dumpextcall (int labelid) { ENTER();
displayhint(bx) = 0;
displayhint(si) = 0;
displayhint(di) = 0;
putbyte (opvalue(call));
flushcode (); // plant the "CALL" instruction
putbyte (labelid & 255);
putbyte (labelid >> 8);
listpreamble ();
// JDM JDM attempt to show external routine name
printstring ("CALL ");
if (labelid <= lastperm) {
// This is an internal "perm" routine
// So, show the name
printstring (concat ("'", concat (permname(labelid), "'")));
} else {
// this is an external routine
printstring (concat ("'", concat (top->idname, "'")));
}
printstring (" (EXTERN ");
write (labelid, 1);
printstring (")");
newline ();
// JDM JDM
writeifrecord (ifrefext, wordsize, objectbytes);
// writeifrecord(IF REFEXT, 2, objectbytes);
clearobjectbuffer (); // zap the current contents of the pipe
}
auto void dumplabel (int labelid) { ENTER();
selectoutput (listout);
space (); writehex (nextcad, 4); spaces (22);
printsymbol ('L');
write (labelid, 1);
printstring (" EQU $");
newline ();
clearobjectbuffer (); // zap the current contents of the pipe
putcodebyte (labelid & 255);
putcodebyte (labelid >> 8);
writeifrecord (iflabel, 2, objectbytes);
clearobjectbuffer (); // zap the current contents of the pipe
displayhint(bx) = 0;
displayhint(si) = 0;
displayhint(di) = 0;
}
auto void dumpstaticalloc (int which, int level, char *name) { ENTER();
int i, len;
// we pretend to dump "C8 00 00 lev ENTER 0000,lev" but we actually plant a special pass 2 directive
putbyte (0xC8);
putbyte (0x00);
putbyte (0x00);
putbyte (level);
listpreamble ();
printstring ("ENTER 0000,"); write (level, 1);
newline ();
clearobjectbuffer (); // zap the current contents of the pipe
putcodebyte (which & 255);
putcodebyte (which >> 8);
putcodebyte (level);
// we also pass the (truncated) name of the routine for pass3 diagnostic use
len = strlen (name);
if (len > 16) len = 16;
for (i = 1; i <= len; i += 1) {
putcodebyte (name[(i) - 1]); // imp2c: depends whether stored as Imp or C strings
}
writeifrecord (iffixup, len + 3, objectbytes);
clearobjectbuffer (); // zap the current contents of the pipe
}
// Pass 3 goes back and plants the correct preamble code for
// the static allocation based on this directive, and also fills
// in the event trap block as appropriate
auto void dumpstaticfill (int which, int size, int events, int evep, int evfrom) { ENTER();
clearobjectbuffer (); // zap the current contents of the pipe
putcodebyte (which & 255); putcodebyte (which >> 8);
putcodebyte (size & 255); putcodebyte (size >> 8);
putcodebyte (events & 255); putcodebyte (events >> 8);
putcodebyte (evep & 255); putcodebyte (evep >> 8);
putcodebyte (evfrom & 255); putcodebyte (evfrom >> 8);
writeifrecord (ifsetfix, 10, objectbytes);
clearobjectbuffer (); // zap the current contents of the pipe
}
// dump words for the constant segment or the data segment
// Adjusts CAD so that the diagnostic listing looks sensible
auto void dumpcdword (int word, int which) { ENTER();
int tag, tmpcad, hi, lo;
static int cptr = 0;
static int dptr = 0;
static int sptr = 0;
tmpcad = nextcad;
if (which == 2) {
tag = ifswtword;
nextcad = sptr;
sptr += 2;
} else {
if (which == 1) {
tag = ifcotword;
nextcad = cptr;
cptr += 2;
} else {
tag = ifdatword;
nextcad = dptr;
dptr += 2;
}
}
hi = word >> 8;
lo = word & 255;
putbyte (lo);
putbyte (hi);
listpreamble ();
printstring ("db ");
writehex (lo, 2); printsymbol (','); writehex (hi, 2);
printstring (" ; ");
if ((lo > 32 && lo < 127)) printsymbol (lo); else printsymbol ('.');
if ((hi > 32 && hi < 127)) printsymbol (hi); else printsymbol ('.');
newline ();
writeifrecord (tag, 2, objectbytes);
clearobjectbuffer (); // clear the pipe
nextcad = tmpcad; // restore the real CAD
}
// tell the object file maker what source line we are on
DECLARE0(unsigned char, buffer, 1 + 1); // zero-based array Moved outside dumplinenumber to allow checksum() to see it...
#define buffer(r) ACCESS(buffer,r)
auto void dumplinenumber (int line) { ENTER();
buffer[0] = (line & 255);
buffer[1] = (line >> 8);
writeifrecord (ifline, 2, buffer);
}
// utility to copy an IMP string into a simple buffer to
// pass to the IF Record routine
auto void strtoxsym (const char *s) { ENTER();
int l;
l = strlen (s); // imp2c need to check the format of strings being passed to us
xlen = 0;
while (xlen < l) {
xsymbuff(xlen) = s[(xlen + 1) - 1];
xlen += 1;
}
}
// tell the object maker the source file name
auto void dumpsourcename (const char *filename) { ENTER();
strtoxsym (filename);
writeifrecord (ifsource, xlen, xsymbuff);
}
// Plant a request to the linker for the external name, and
// return an index number to refer to it with in future
auto int externalref (const char *extname) { ENTER();
static int nextextref = 1;
strtoxsym (extname);
writeifrecord (ifreqext, xlen, xsymbuff);
nextextref += 1;
return (nextextref - 1);
}
// tell the linker about an external definition
auto void fillexternal (int seg, int offset, const char *extname) { ENTER();
strtoxsym (extname);
if (seg == code) {
writeifrecord (ifdefextcode, xlen, xsymbuff);
} else {
writeifrecord (ifdefextdata, xlen, xsymbuff);
// er, this doesn't actually work yet!
}
}
// ------------------------------------------------------
// Constant table utility routines
//
// Rather than dump literal constants as they occur, we
// collect them in a table. Whenever the compiler wants
// any kind of literal, we look to see if we already
// have it. Note this automatically solves re-use of
// things like floating point constants, string newline,
// and fixed array dope vectors. When the table starts
// to get fairly full, we flush it. Obviously that means
// in a large program we might not actually get full re-use
// of constants after we've flushed, but the idea is sound.
//
// For the convenience of the caller, several versions of
// pretty much the same thing are provided.
// ------------------------------------------------------
const int cotsize = 2000;
DECLARE0(static unsigned char, contable, 2000 /* cotsize */ + 1); // zero-based array // initialise to all 0
#define contable(r) ACCESS(contable,r)
auto /* static */ int cotp = 0;
auto /* static */ int cotoffset = 0; // updated on a flush
auto void flushcot (void) { ENTER();
int i;
// We output a position hint to the diagnostic stream
// Note that although this is intended to look like
// 8086 assembly directives the real work is done by
// pass 3 - this is only to guide the human reader as
// to what is going on
selectoutput (listout);
printstring (" _TEXT ENDS"); newline ();
printstring (" CONST SEGMENT WORD PUBLIC 'CONST'"); newline ();
i = 0;
while (i < cotp) {
dumpcdword ((contable(i + 1) << 8) | contable(i), 1);
i += 2;
}
// Update the pointers
cotp = 0;
cotoffset += i;
// and send another hint
selectoutput (listout);
printstring (" CONST ENDS"); newline ();
printstring (" _TEXT SEGMENT WORD PUBLIC 'CODE'"); newline ();
}
// return the offset in the const segment of a byte
// with value b
auto int getcotb (unsigned char b) { ENTER();
int i;
i = 0;
while (i < cotp) {
if (contable(i) == b) return (i + cotoffset);
i += 1;
}
// value wasn't there
if (cotp == cotsize) flushcot ();
contable(cotp) = b;
cotp += 1;
return ((cotp - 1) + cotoffset);
}
// return the offset in the const segment of a word
// with value w
auto int getcotw (int w) { ENTER();
int i, cw;
i = 0;
while (i < cotp - 3) {
// NOTE: the line below would not be compatible with a 16-bit host!
cw = contable(i) | (contable(i + 1) << 8) | (contable(i + 2) << 16) | (contable(i + 3) << 24);
if (cw == w) return (i + cotoffset);
i += wordsize;
}
// value wasn't there - first make sure there is space
if (cotp > cotsize - wordsize) flushcot ();
// now round off the COT
cotp = (cotp + align) & (~align);
for (i = 1; i <= wordsize; i += 1) {
contable(cotp) = w & 255;
w = w >> 8;
cotp += 1;
}
return ((cotp - wordsize) + cotoffset);
}
// return the offset in the const segment of double precision real number
auto int getcotdouble (double _double_) { ENTER();
int i;
i = 0;
while (i < cotp - 7) {
if ((contable(i ) == byteinteger (addr (_double_) )
&& (contable(i + 1) == byteinteger (addr (_double_) + 1)
&& (contable(i + 2) == byteinteger (addr (_double_) + 2)
&& (contable(i + 3) == byteinteger (addr (_double_) + 3)
&& (contable(i + 4) == byteinteger (addr (_double_) + 4)
&& (contable(i + 5) == byteinteger (addr (_double_) + 5)
&& (contable(i + 6) == byteinteger (addr (_double_) + 6)
&& (contable(i + 7) == byteinteger (addr (_double_) + 7))))))))))
// I trust the above is OK on byte sex.
// I guess there's a small chance the x86 code generator could be
// called as a cross-compiler from another architecture such as ARM
// so byte sex *could* be an issue though it's very unlikely.
return (i + cotoffset);
i += 4;
}
// value wasn't there - first make sure there is space
if (cotp > cotsize - 8) flushcot ();
// now round off the COT
cotp = (cotp + align) & (~align);
for (i = 0; i <= 7; i += 1) {
contable(cotp) = byteinteger (addr (_double_) + i);
cotp += 1;
}
return ((cotp - 8) + cotoffset);
}
// return the offset in the const segment of a quad word
// with value q0:q1:q2:q3 (lo to hi)
auto int getcot4 (int q0, int q1, int q2, int q3) { ENTER();
int i, cw0, cw1, cw2, cw3;
i = 0;
// NOTE: the lines below would not be compatible with a 16-bit host!
cw0 = contable(i) | (contable(i + 1) << 8) | (contable(i + 2) << 16) | (contable(i + 3) << 24);
cw1 = contable(i + 4) | (contable(i + 5) << 8) | (contable(i + 6) << 16) | (contable(i + 7) << 24);
cw2 = contable(i + 8) | (contable(i + 9) << 8) | (contable(i + 10) << 16) | (contable(i + 11) << 24);
while (i < cotp - 15) {
cw3 = contable(i + 12) | (contable(i + 13) << 8) | (contable(i + 14) << 16) | (contable(i + 15) << 24);
if (cw0 == q0 && cw1 == q1 && cw2 == q2 && cw3 == q3) return (i + cotoffset);
i += wordsize;
cw0 = cw1;
cw1 = cw2;
cw2 = cw3;
}
// value wasn't there - first make sure there is space
if (cotp > cotsize - 16) flushcot ();
// now round off the COT
cotp = (cotp + align) & (~align);
for (i = 1; i <= wordsize; i += 1) {
contable(cotp) = q0 & 255;
q0 = q0 >> 8;
cotp += 1;
}
for (i = 1; i <= wordsize; i += 1) {
contable(cotp) = q1 & 255;
q1 = q1 >> 8;
cotp += 1;
}
for (i = 1; i <= wordsize; i += 1) {
contable(cotp) = q2 & 255;
q2 = q2 >> 8;
cotp += 1;
}
for (i = 1; i <= wordsize; i += 1) {
contable(cotp) = q3 & 255;
q3 = q3 >> 8;
cotp += 1;
}
return ((cotp - 16) + cotoffset);
}
auto /* static */ int nullstring = -1;
// get an index into the constant table for the string literal
// in the array s
auto int getcots (unsigned char *b) { ENTER();
int i, first, slen, match;
slen = b[0]; // imp2c WARNING! IMP-STYLE STRING. May need to use strlen(b) instead.
// maybe not - what we are passed is 'currentstring' and it is
// assembled as an IMP string.
// We optimise the Null String "" in comparisons, so we remember
// the location here
if (slen == 0) {
nullstring = getcotb (0);
return (nullstring);
}
first = 0; // offset to search in contable
while (first + slen < cotp) { // so long as there are that many bytes left
match = 1;
// Simple check of string lengths
if (slen != contable(first)) {
match = 0;
break;
}
// ok, so lengths match but do the contents
for (i = 1; i <= slen; i += 1) {
if (b[i] != contable(first + i)) {
match = 0;
break;
}
}
if (match == 1) return (first + cotoffset);
first += 1; // try the next solution
}
// if we get here, it wasn't already in the constant table
// Ok, so will we overflow the buffer
if ((cotp + slen + 1) >= cotsize) flushcot ();
// dump the string length
first = cotp;
contable(cotp) = slen;
cotp += 1;
// Now, dump the string contents
for (i = 1; i <= slen; i += 1) {
contable(cotp) = b[i];
cotp += 1;
}
return (first + cotoffset);
}
// ------------------------------------------------------
// Data segment utility routines
//
// Unlike constants, we can't re-use data segment items,
// which makes this much simpler. We still accumulate
// the bytes in a table because (1) we can make life
// more efficient for Pass 3 that way and (2) by collecting
// the bytes together we can produce more convincing debug
// code listings, especially for programs that don't need
// to flush the table in the middle of the code.
// Note that because data segment offsets are used directly
// as variable displacements, our pointer DATATP doesn't
// wrap like the COTP does, and instead we subtract the
// offset before we use it...
// ------------------------------------------------------
const int datatlimit = 1999; // Size in bytes of data segment table
DECLARE0(unsigned char, datat, datatlimit - 0 + 1); // zero-based array
#define datat(r) ACCESS(datat,r)
auto /* static */ int datatp = 0; // pointer to next data segment byte
auto /* static */ int datatoffset = 0; // updated on a flush
// Flush the accumulated data table
auto void flushdata (void) { ENTER();
int i, limit;
// We output a position hint to the diagnostic stream
selectoutput (listout);
printstring (" ENDS"); newline ();
printstring (" DATA SEGMENT WORD PUBLIC 'DATA'"); newline ();
i = 0;
limit = datatp - datatoffset;
while (i < limit) {
dumpcdword ((datat(i + 1) << 8) | datat(i), 0);
i += 2;
}
datatoffset = datatp;
// and send another hint
selectoutput (listout);
printstring (" DATA ENDS"); newline ();
}
// >> GBYTE <<
// Simple byte in data segment
auto void gbyte (int n) { ENTER();
if ((datatp - datatoffset) > datatlimit) flushdata ();
datat(datatp - datatoffset) = n & 255;
datatp += 1;
}
// >> GPUT <<
// Put a word into data segment
auto void gput (int n) { ENTER();
int i;
for (i = 1; i <= wordsize; i += 1) {
gbyte (n);
n = n >> 8;
}
}
// >> GFIX <<
// round off the datasegment pointer for alignment
auto void gfix (int align) { ENTER();
while ((datatp & align) != 0) gbyte (0);
}
// -----------------------------------------------------
// The last table we collect as we go along is the switch
// table. We don't provide individual routines to fill
// it in, but for tidyness we provide this routine to send
// the contents to pass 3
auto void flushswitch (void) { ENTER();
int i;
selectoutput (listout);
printstring (" ENDS"); newline ();
printstring (" _SWTAB SEGMENT WORD PUBLIC '_SWTAB'"); newline ();
i = 0;
while (i < swtp) {
dumpcdword (swtab(i), 2);
i += 1;
}
// and send another hint
selectoutput (listout);
printstring (" _SWTAB ENDS"); newline ();
}
// -------------------------------------------------------------
// Print the source code lines up to the indicated line
// number - these will interleave with the diagnostic assembly
// output
auto /* static */ int echoline = 0;
auto void echosourceline (void) { ENTER();
int ch;
static int sourceeof = 0;
echoline += 1; // update the count even if there's no input
if (sourceeof != 0) return; // silently ignore lack of source file
selectinput (source);
selectoutput (listout);
for (;;) {
readsymbol (ch);
printsymbol (ch);
if ((ch == 10 || ch < 0)) break;
}
if (ch < 0) sourceeof = 1;
selectinput (icode);
selectoutput (objout);
}
// -----------------------------------------------------------
// General descriptor and register manipulation routines
// -----------------------------------------------------------
// >> FLOATING <<
auto int floating (stackfm * v) { ENTER();
// check descriptor for floating point quantity
if ((v->type == real || v->type == lreal)) return (1);
return (0);
}
// >> ZERO <<
auto int zero (stackfm * v) { ENTER();
// CHECK DESCRIPTOR FOR (INTEGER) ZERO
if ((v->disp != 0 || (v->base != 0 || (v->form != constant && v->form != avins)))) return (0);
return (1);
}
// >> CONST <<
auto int _const_ (stackfm * v) { ENTER();
// CHECK DESCRIPTOR FOR CONSTANT (INTEGER) VALUE
if (!(v->form == constant)) return (0);
if (v->type > byte) return (0);
return (1);
}
auto int minrecordsize (stackfm * a, stackfm * b) { ENTER();
int n, m;
n = a->format; if (n != 0) n = var(n).size & 0x7FFF;
m = b->format; if (m != 0) m = var(m).size & 0x7FFF;
if ((n == 0 || (m != 0 && m < n))) n = m;
if (n > 0) return (n);
abort ("Min Rec Size");
return 0;
}
// >> MULSHIFT <<
auto int mulshift (int n) { ENTER();
int shift, ref;
ref = 1;
for (shift = 1; shift <= 14; shift += 1) {
ref = ref << 1;
if (ref >= n) {
if (ref == n) return (shift); else return -1;
}
}
return -1;
}
// >> SAME <<
auto int same (stackfm * v, stackfm * w) { ENTER();
// Test whether or not V and W describe the same object.
if ((v->disp != w->disp || v->base != w->base)) return (0);
if ((v->type != w->type || v->form != w->form)) return (0);
if ((v->extra != w->extra || v->scope != w->scope)) return (0);
return (1);
}
// grab a slab of working store in the local stack
auto int getwork (int size) { ENTER();
int cell;
cell = worklist(level);
while (cell != 0) {
if ((gptags[cell].info == size) && (gptags[cell].flags == 0)) { // suitable candidate?
gptags[cell].flags = 1; // mark it as in use
return (gptags[cell].addr);
}
cell = gptags[cell].link;
}
// no space available already - make more
cell = getgptag ();
frame = (frame - size) & (~align); // make them all even boundaries
gptags[cell].addr = frame;
gptags[cell].info = size;
gptags[cell].link = worklist(level);
worklist(level) = cell;
gptags[cell].flags = 1; // in use
return (frame);
}
// Return a slab of working store to the free pool. Note that
// ReturnWork is cautious about what it accepts - it only takes
// in items it has previously given out, so we can call it
// fairly liberally with any old rubbish and it will do the
// right thing
auto void returnwork (int addr) { ENTER();
int cell;
cell = worklist(level);
while (cell != 0) {
if (gptags[cell].addr == addr) {
if (gptags[cell].flags == 0) abort ("Return Work");
gptags[cell].flags = 0; // mark it as free
return;
}
cell = gptags[cell].link;
}
// Here, work area was not found - it probably wasn't a work area!
}
// Check to see if a variable is in a work list assigned block. Used
// in string expression compilation to avoid un-necessary copying, hence
// only marked true for 256 byte chunks
auto int iswork (stackfm * v) { ENTER();
int cell;
if (v->base != bp || v->disp >= 0 || v->scope != 0 || v->form != vins) return (0);
cell = worklist(level);
while (cell != 0) {
if (gptags[cell].addr == v->disp) {
if (gptags[cell].flags == 0) abort ("Is Work");
if (gptags[cell].info != 256) return (0);
return (1);
}
cell = gptags[cell].link;
}
return (0);
}
// >> RELEASE <<
auto void release (int reg) { ENTER();
// Hazard the value in a register
// abort("Release bad register") %if reg > fr7
if (reg == 0 || reg > fr7 || activity[reg] < 0) return; // LOCKED
activity[reg] = activity[reg] - 1;
if (activity[reg] < 0) abort ("Release inactive");
claimed -= 1;
}
// >> CLAIM <<
auto void claim (int reg) { ENTER();
// Cherish the value in a register
if (reg > fr7) abort ("Claim bad register");
if (reg == 0 || activity[reg] < 0) return;
activity[reg] = activity[reg] + 1;
claimed += 1;
}
// >> HAZARD <<
// Protect any value in register REG by storing in a temporary.
auto void hazard (int reg) { ENTER();
int i, n, t, type;
auto void mod (stackfm * v) { ENTER();
static void *sw[ 10 /*pgmlabel*/ ] = { // zero-based array
[ainrec] = &&sw_ainrec,
[avinrec] = &&sw_avinrec,
[vinrec] = &&sw_vinrec,
[constant] = &&sw_constant,
[vins] = &&sw_vins,
[ains] = &&sw_ains,
[avins] = &&sw_avins,
[vinr] = &&sw_vinr,
};
v->base = bp;
n -= 1;
if (v->form < 0 || v->form >= pgmlabel || sw[v->form] == 0) goto sw_default;
goto *sw[v->form];
sw_default: BADSWITCH(v->form,__LINE__,__FILE__);
sw_ainrec: /* ainrec */
sw_avinrec: /* avinrec */
sw_vinrec: /* vinrec */
sw_constant: /* constant */
abort ("Mod");
sw_vins: /* vins */
if ((v->disp == 0) && (v->scope == 0)) {
v->disp = t;
v->form = ains;
} else {
// change (X in S) to (X in REC)
v->form = v->form + 3;
v->extra = t;
}
goto out1;
sw_ains: /* ains */
sw_avins: /* avins */
v->form = v->form + 3;
v->extra = t;
goto out1; // change (X in S) to (X in REC)
sw_vinr: /* vinr */
v->form = vins;
v->disp = t;
v->type = type;
goto out1;
out1:
;
}
n = activity[reg]; if (n <= 0) return; // NOT IN USE OR CLAIMED
claimed -= n;
activity[reg] = 0;
if (reg >= fr0) {
// Note that the FPU can only save the top of the stack.
// If we need to save something lower down, we need to pop
// the things above me first...
if (reg - fr0 >= fpustack) hazard (reg + 1); // and recurse as required
type = lreal;
t = getwork (8);
dumpfloprm (fstq, bp, t, 0);
} else {
type = integer;
t = getwork (wordsize);
dumpmr (mov, bp, t, 0, reg);
}
for (i = 1; i <= stp; i += 1) {
if (stack(i).base == reg) mod (&stack(i));
}
if (n != 0) abort ("Usage Outstanding"); // USE STILL OUTSTANDING
}
// >> HAZARD ALL <<
auto void hazardall (void) { ENTER();
int j;
if (claimed != 0) { // at least one register claimed
for (j = ax; j <= fr7; j += 1) hazard (j);
}
}
// >> GP REG <<
// Get a general (integer) register
// Note that registers AX, CX, DX, BX are, in order
// numbers 1, 2, 3 and 4 (which is convenient)
auto int gpreg (void) { ENTER();
int r;
// look for an empty one
for (r = ax; r <= bx; r += 1) {
if (activity[r] == 0) return (r);
}
// look for an unlocked one
for (r = ax; r <= bx; r += 1) {
if (activity[r] > 0) {
hazard (r);
return (r);
}
}
abort ("Get Reg");
return 0;
}
// >> PT REG <<
auto int ptreg (void) { ENTER();
// Get a register we can use as a pointer. We deliberately rotate
// around the candidates to make re-use more likely
DECLARE0(const unsigned char, ptpref, 2 + 1) = { // zero-based array
#define ptpref(r) ACCESS(ptpref,r)
7, 8, 4
// SI, DI, BX
};
static int next = 0;
int r, j;
// look for an empty one
for (j = 1; j <= 3; j += 1) {
r = ptpref(next);
next += 1;
if (next == 3)
next = 0;
if (activity[r] == 0)
return (r);
}
// look for an unlocked one
for (j = 1; j <= 3; j += 1) {
r = ptpref(j);
if (activity[r] > 0) {
hazard (r);
return (r);
}
}
abort ("Get PT Reg");
return 0;
}
// >> GET DISPLAY <<
// return the register to use to access display level <n>
auto int getdisplay (int l) { ENTER();
int r, lev;
lev = l & 15; // get rid of any relocation info
if (lev == 0) return (l); // global
if (lev == level) return (bp); // local
// We now try the 3 pointer register - they are not contiguously
// numbered, which is why this is unrolled!
if (displayhint(bx) == lev) return (bx);
if (displayhint(si) == lev) return (si);
if (displayhint(di) == lev) return (di);
r = ptreg ();
dumprm (mov, r, bp, -(lev * wordsize), 0); // displays are first words in frame
displayhint(r) = lev;
return (r);
}
// >> SET DOPE VECTOR <<
// Plants a dope vector for a 1-D constant bound array (usually
// OWN or CONST arrays) in the CONST segment, returns the offset
// Note that it also modifies the vlb and vub variables - after
// the call, VLB contains the byte offset for the first member
// and VUB contains the size to allocate for the array in bytes.
auto int setdopevector (void) { ENTER();
int t, dv;
t = vub - vlb + 1;
dv = getcot4 (1, vlb, vub, datasize);
vub = t * datasize; vlb = vlb * datasize;
return (dv);
}
// >> PERM <<
// calls a PERM and adjusts the stack by SPACE words afterwards
auto void perm (int n, int space) { ENTER();
// PERM routines are written in MS C, and they preserve SI and DI,
// but trash the general purpose registers
hazard (ax);
hazard (cx);
hazard (dx);
hazard (bx);
// JDM perm routines now implemented as IMP routines
// so be more careful and hazard the SI,DI registers as well
hazard (si);
hazard (di);
dumpextcall (n);
if (space != 0) dumpri (add, sp, space * wordsize);
}
// >> ASSEMBLE <<
// AMODE:
// -3: initial call
// -2: alternate record format
// -1: record format
// 0: begin block
// 1: procedure
// 2: %spec
auto void assemble (int amode, int labs, int names) { ENTER();
// WOW! JUST 'WOW'!!! The body of this switch statement is literally thousands of lines away,
// *AND* there is a nested procedure between here and there that also contains a switch named 'c'.
// *SO* DANGEROUS. I've renamed the nested c switch to 'c_inner'.
static void *c[ /* bounds */ ] = { // zero-based array
['!'] = &&c_EXCLAM,
['"'] = &&c_DOUBLE_QUOTE,
['#'] = &&c_HASH,
['$'] = &&c_DOLLAR,
['%'] = &&c_PERCENT,
['&'] = &&c_AMPERSAND,
['\''] = &&c_SINGLE_QUOTE,
['('] = &&c_OPEN_ROUND_BRACKET,
[')'] = &&c_CLOSE_ROUND_BRACKET,
['*'] = &&c_STAR,
['+'] = &&c_PLUS,
['-'] = &&c_MINUS,
['.'] = &&c_PERIOD,
['/'] = &&c_SLASH,
[':'] = &&c_COLON,
[';'] = &&c_SEMICOLON,
['<'] = &&c_OPEN_ANGLE_BRACKET,
['='] = &&c_EQUALS,
['>'] = &&c_CLOSE_ANGLE_BRACKET,
['?'] = &&c_QUERY,
['@'] = &&c_ATSIGN,
['A'] = &&c_UPPER_A,
['B'] = &&c_UPPER_B,
['C'] = &&c_UPPER_C,
['D'] = &&c_UPPER_D,
['E'] = &&c_UPPER_E,
['F'] = &&c_UPPER_F,
['G'] = &&c_UPPER_G,
['H'] = &&c_UPPER_H,
['I'] = &&c_UPPER_I,
['J'] = &&c_UPPER_J,
['K'] = &&c_UPPER_K,
['L'] = &&c_UPPER_L,
['M'] = &&c_UPPER_M,
['N'] = &&c_UPPER_N,
['O'] = &&c_UPPER_O,
['P'] = &&c_UPPER_P,
['Q'] = &&c_UPPER_Q,
['R'] = &&c_UPPER_R,
['S'] = &&c_UPPER_S,
['T'] = &&c_UPPER_T,
['U'] = &&c_UPPER_U,
['V'] = &&c_UPPER_V,
['W'] = &&c_UPPER_W,
['X'] = &&c_UPPER_X,
['Z'] = &&c_UPPER_Z,
['['] = &&c_OPEN_SQUARE_PARENTHESIS,
['\\'] = &&c_BACKSLASH,
[']'] = &&c_CLOSE_SQUARE_PARENTHESIS,
['^'] = &&c_CARET,
['_'] = &&c_UNDERSCORE,
['a'] = &&c_LOWER_a,
['b'] = &&c_LOWER_b,
['d'] = &&c_LOWER_d,
['e'] = &&c_LOWER_e,
['f'] = &&c_LOWER_f,
['g'] = &&c_LOWER_g,
['h'] = &&c_LOWER_h,
['i'] = &&c_LOWER_i,
['j'] = &&c_LOWER_j,
['k'] = &&c_LOWER_k,
['l'] = &&c_LOWER_l,
['m'] = &&c_LOWER_m,
['n'] = &&c_LOWER_n,
['o'] = &&c_LOWER_o,
['p'] = &&c_LOWER_p,
['q'] = &&c_LOWER_q,
['r'] = &&c_LOWER_r,
['s'] = &&c_LOWER_s,
['t'] = &&c_LOWER_t,
['u'] = &&c_LOWER_u,
['v'] = &&c_LOWER_v,
['w'] = &&c_LOWER_w,
['x'] = &&c_LOWER_x,
['y'] = &&c_LOWER_y,
['z'] = &&c_LOWER_z,
['{'] = &&c_OPEN_CURLY_BRACKET,
['}'] = &&c_CLOSE_CURLY_BRACKET,
['~'] = &&c_TILDE,
};
varfm *v; // General purpose pointer
varfm *procvar; // Var of the current procedure we're compiling
varfm *ap; // Actual parameter ptr, used to copy parms to parm area
varfm *fp; // formal parameter ptr, used to copy parms to parm area
stackfm *lhs; // General stack pointer
stackfm *rhs; // General stack pointers
int maxframe; // Used for alternate records to find the largest alternate
int firstname; // First descriptor at this level
int staticalloc; // Tag used by pass 3 to fix up this level's stack allocation
int skipproc;
int lastskip; // Used to jump around routines
int events;
int evep;
int evfrom; // Event info (mask, entry point, block start)
int firstlabel; // First label at this level
int oldframe;
// Previous level's static allocation
int j, t;
int dv;
auto void compiletostring (stackfm * v);
auto void loadreg (stackfm * v, int reg); // JDM change name from load()
auto void storereg (stackfm * v, int reg); // JDM new code
auto void assign (int assop);
auto void arrayref (int mode);
auto void operation (int n);
auto void compare (stackfm * l, stackfm * r);
auto void testzero (stackfm * v);
auto int newtag (void);
// Actual code for Assemble is down around label NEXT
// The following functions "parse" the parameters attached to an iCode instruction
// It is intended that these functions are the only places where the iCode stream is read
// >> READ TAG, and COMMA, INTEGER, REAL <<
auto int readtag (void) { ENTER();
int s1, s2;
s1 = pending;
readsymbol (s2);
readsymbol (pending);
return ((s1 << 8) | s2);
}
auto int readtagcomma (void) { ENTER();
int t;
t = readtag ();
readsymbol (pending);
return (t);
}
auto int readinteger (void) { ENTER();
int s1, s2, s3, s4;
s1 = pending;
readsymbol (s2);
readsymbol (s3);
readsymbol (s4);
readsymbol (pending);
//fprintf(stderr, "Line %0d: s1=%02x s2=%02x s3=%02x s4=%02x, n=%08x\n", __LINE__, s1,s2,s3,s4,((s1 << 24) | (s2 << 16) | (s3 << 8) | s4));
// NOTE: the line below would not be compatible with a 16-bit host!
return ((s1 << 24) | (s2 << 16) | (s3 << 8) | s4);
}
auto int readbyte (void) { ENTER();
int s1;
s1 = pending;
readsymbol (pending);
return (s1);
}
// >> READ REAL <<
// Read a floating point literal. Pass 1 treats these as strings
// and leaves it up to us to make a floating point number out of it
// We therefore expect [COUNT]NNN.NNN@NN
auto double readreal (void) { ENTER();
int n;
double p, r;
n = readtagcomma (); // char count, skip comma
r = 0;
// Start with the bit ahead of the decimal point
for (;;) {
sym = pending; readsymbol (pending);
if (sym == '.') break;
n -= 1;
if (sym == '@') goto power;
r = r * 10 + (sym - '0');
if (n == 0) goto sign;
}
p = 1;
for (;;) {
n -= 1;
if (n == 0) goto sign;
sym = pending; readsymbol (pending);
if (sym == '@') goto power;
p = p / 10.0; // imp2c NOTE: p = p / 10 ... p is a %longreal
r = r + (sym - '0') * p;
}
power:
n = readtag ();
// Tag is unsigned 16-bit integer (0..65535) // All this stuff is so much easier in C using casts!
// but is read into a 32-bit signed integer
// and so 0 < n < 65535
// BUT - tag is to be regarded as a 16-bit signed integer
// So 0 < n < 32768 is to be regarded as a positive integer
// and 32767 < n < 65536 is a negative integer
// n => correct n
// 65536 => 0
// 65535 => -1 (65536 - n)
// 65534 => -2 (65536 - n)
// ..
// 32768 => -32768 (65536 - n)
// Now to tweak the floating point value. This method is
// somewhat clunky so that we can be portable to a system that
// doesn't do exponents
// This version of the pass2 code generator targets the 8087
// and later versions as the numeric processor for floating
// point arithmetic
// e.g. double real (== %longreal)
// Double real uses an 11-bit exponent so we should ensure
// that the tag represents an exponent in the range
// -1023 <= exp <= 1023
// -1024 is omitted to ensure no overflow for reciprocals
// The exponent however, has a bias of 1023 so the actual
// 8087 exponent is in the range 0 <= exp <= 2046
// Currently don't bother to check that the exponent is in
// the range -1023 < exp < 1023
if (n != 0) {
// ok, non-zero exponent
if ((0 < n && n < 32768)) {
// positive exponent
while (n > 0) {
r = r * 10;
n -= 1;
}
} else {
// a negative exponent
// So, convert to negative value
n -= 65536;
// Now, attempt to update the float value
// imp2c: ARE WE GOOD WITH "float" HERE RATHER THAN DOUBLE???
while (n < 0) {
// r = ((float) (r) / (float) (10));
r = r / 10.0;
n += 1;
}
}
}
sign:
// sign of whole value
if (pending == 'U') {
readsymbol (pending);
r = -r;
}
return (r);
}
auto char *readstring (void) { ENTER();
int j, sym, limit;
char s[255 + 1]; // %string
limit = (sizeof (s)) - 1;
strcpy (s, "");
for (j = pending; j >= 1; j -= 1) { // imp2c BUG FIXED
readsymbol (sym);
if (strlen (s) < limit) strcat (s, tostring (sym));
}
readsymbol (pending);
return (strdup(s)); // imp2c: imp returns a copy of the string on the stack, not a pointer to the string.
}
auto char *getascii_cstring (int terminator) { ENTER();
char a[255 + 1]; // %string
int sym;
int ap;
//strcpy (a, "");
ap = 0; a[0] = '\0';
for (;;) {
sym = pending; readsymbol (pending); if (sym == terminator) break;
if (ap < 255) {
a[ap++] = sym; a[ap] = '\0';
}
}
char *result = malloc(ap+1);
memmove(result, a, ap+1);
return (result);
}
auto char *getascii_impstring (int terminator) { ENTER();
char a[255 + 1]; // %string
int sym;
int ap;
//strcpy (a, "");
ap = 1;
for (;;) {
sym = pending; readsymbol (pending); if (sym == terminator) break;
if (ap < 255) {
a[ap++] = sym; a[ap] = '\0';
}
}
a[0] = ap-1;
char *result = malloc(ap+1);
memmove(result, a, ap+1);
return (result);
}
// End of parsing routines
// >> DEFINE VAR <<
auto void definevar (int decl, char *internalid, int tf, int size, int scope) { ENTER();
int type, form, format, s, new, round, dimension;
int dv; // dope vector offset
static int primno = 0;
new = 0;
round = align;
// Get the var index
if (decl == 0) {
// RECORD FORMAT ELEMENT NAME
parms -= 1;
if (parms <= names) abort ("Def Var Parms");
decvar = &var(parms);
//decvar = 0;
//memset(decvar, 0, sizeof(*decvar)); // decvar = 0; // imp2c
decvar->idname[0] = '\0';
decvar->type = 0; decvar->form = 0; decvar->level = 0; decvar->scope = 0; decvar->dim = 0;
decvar->disp = 0; decvar->format = 0; decvar->size = 0; decvar->pbase = 0; decvar->extra = 0; decvar->extdisp = 0;
} else {
if (decl >= parms) abort (concat ("Def Var Names (decl=", concat (itos (decl, 0), concat (" parms=", concat (itos (parms, 0), ")")))));
decvar = &var(decl);
if (decl > names) {
names = decl;
new = 1;
//decvar = 0;
// memset(decvar, 0, sizeof(*decvar)); // decvar = 0; // imp2c
decvar->idname[0] = '\0';
decvar->type = 0; decvar->form = 0; decvar->level = 0; decvar->scope = 0; decvar->dim = 0;
decvar->disp = 0; decvar->format = 0; decvar->size = 0; decvar->pbase = 0; decvar->extra = 0; decvar->extdisp = 0;
}
}
// Now parse the type and form word
type = tf >> 4;
form = tf & 15;
// Map external type numbers into internal equivalents,
// and adjust for short/byte/long things
if ((type == integer && size != 1)) {
// INTEGER
if (size == 2) { type = byte; round = 0; }
size = vsize(type);
} else if (type == real) {
// REAL
if (size == 4) type = lreal; // LONG REAL
size = vsize(type);
} else if (type == record) {
// record
format = size;
decvar->format = format;
if (format <= names) size = var(format).size;
} else if (type == string) {
// string
round = 0;
decvar->size = size;
size += 1;
} else {
size = vsize(type);
}
// JDM JDM remember the variable name
// Needed should an embedded code fragment refer to an IMP variable
strcpy(var(decl).idname, internalid);
if (type != string) decvar->size = size;
decvar->type = type;
decvar->form = form;
// Now analyse the Scope word
spec = (scope >> 3) & 1;
dimension = (scope >> 8) & 255;
otype = scope & 7;
if (otype != 0) {
// Set external linkage name if appropriate
if (otype >= external) {
if (strlen (alias) != 0) {
strcpy(externalid, alias);
} else if (otype == system) {
strcpy(externalid, concat (systemprefix, internalid));
} else {
strcpy(externalid, concat ("_", internalid));
}
if (otype <= dynamic) otype = external;
// external, system, dynamic
}
}
strcpy (alias, "");
// JDM: Ensure the external displacement is zero
decvar->extdisp = 0;
if ((switch_ < form && form < array)) {
// PROCEDURE
blocktype = 1 + spec; // 1 for normal proc, 2 for spec
if ((otype != 0 && spec != 0)) {
// external spec
if (otype == primrt) {
primno += 1;
decvar->level = 128;
decvar->disp = primno;
return;
}
decvar->disp = externalref (externalid);
decvar->extdisp = decvar->disp; // JDM: Remember the base external displacement
decvar->level = 0;
decvar->scope = ext;
return;
}
if (inparams == 0) {
// NOT A PARAMETER
potype = otype;
if (new != 0) {
// NEW NAME
decvar->disp = newtag ();
// Procedure ID
}
if (spec == 0) strcpy(blockname, internalid);
return;
}
otype = 0;
size = wordsize;
datasize = wordsize;
// procedure parameter
} else {
// This is not a procedure declaration
datasize = size;
if (form != simple) {
round = align;
if (type == general) {
// General %name
decvar->extra = inparams; // FOR LABELS
size = wordsize * 2;
} else if (form == array || form == namearray) {
// We will fill in dimensions and allocate space when
// we are told the bounds later
size = 0;
if (form == namearray) datasize = wordsize;
} else if ((form == arrayname || form == namearrayname)) {
decvar->dim = dimension;
size = wordsize * 2;
round = align; // array header
} else {
size = wordsize; // integer (etc) %name
}
}
}
// Now deal with OWN (or const/extern/etc) data items
if (otype != 0) {
// OWN DATA
if (otype == con) {
// CONST INTEGER ETC.
if ((type == string && form == simple)) datasize = 0; // use actual size for plain strings
if (form == name || form == arrayname || form == namearrayname) {
otype = 0; // Treat as special later
}
} else {
// OWN, not CONST
gfix (round); // so make it even if needed
}
// set globals used by our data collection utilities
owntype = type;
ownform = form;
if (form == 2) { owntype = integer; datasize = wordsize; } // %name's are really integers
if (spec == 0) {
if (form == array || form == namearray) {
gfix (align);
dv = setdopevector (); // N.B. changes vlb, vub
// We treat OWN and CONST arrays identically - both are in data segment
gfix (align);
decvar->disp = datatp - vlb;
decvar->level = 0;
decvar->scope = data;
decvar->pbase = dv; // save the dope vector pointer here
decvar->dim = 1; // own arrays are always 1-D
}
if (otype == external) fillexternal (data, decvar->disp, externalid);
} else {
decvar->level = 0;
decvar->scope = ext;
decvar->disp = externalref (externalid);
// JDM: We have a reference to external data so note the external ref id
// inside the _extdisp field
// _extdisp will NEVER be modified unlike _disp
// Eventually it will be used when generating ABSEXT ibj records
// The difference between _disp and _extdisp represents the offset
// from the location specified by _disp
// offset == _extdisp - _disp
decvar->extdisp = decvar->disp;
}
} else if (form == _label_) {
// %label
decvar->disp = newtag ();
} else if (form == switch_) {
size = vub - vlb;
if (swtp + size > maxswitch) abort ("Switch Table Full");
decvar->scope = swt;
decvar->disp = swtp - vlb;
decvar->extra = setdopevector ();
for (s = swtp; s <= swtp + size; s += 1) {
swtab(s) = 0;
// should really deal with undefined switch entries
}
swtp = swtp + size + 1;
} else if (form == recordformat) {
if (inparams != 0) {
if (decvar->size > frame) frame = decvar->size;
} else {
blocktype = -1; spec = -1;
}
} else {
// Here we've got an ordinary local variable, parameter or record entry
decvar->level = level;
if (inparams == 0) {
// local variable
frame = (frame - size) & (~round);
decvar->disp = frame;
} else if (blocktype > 0) {
// procedure parameters
frame = (frame + size + align) & (~align);
// parameters are always word aligned
decvar->disp = frame;
// offset will be adjusted at '}'
} else {
// records
frame = (frame + round) & (~round);
decvar->disp = frame;
frame += size;
decvar->level = 0; // no base register
}
}
} // Define Var
// ---------------------------------------------------------------------
// Stack manipulation routines
// ---------------------------------------------------------------------
// >> POP STACK <<
// Pop the top of the stack
auto void popstack (void) { ENTER();
if (stp == 0) abort ("Pop");
if ((diagnose & 1) != 0) monitor (top, "Pop");
stp -= 1;
if (stp != 0) top = &stack(stp); else top = &null;
}
// >> POP REL <<
// Pop the top of the stack, and release its' register
auto void poprel (void) { ENTER();
release (top->base);
popstack ();
}
DECLARE0(const unsigned char, fmap, 15 + 1) = { // zero-based array
#define fmap(r) ACCESS(fmap,r)
0, vins, ains, pgmlabel, recordformat, 0, switch_, 0,
/* void, simple, name, label, recordformat, ?, switch, routine, */
vinr, vins, vinr, vins, ains, vins, ains, 0
/* function, map, predicate, array, arrayname, namearray, namearrayname, ? */
};
// >> STACK VAR <<
// Push a descriptor on the stack corresponding to Var "var no"
// We map the variable form to a stack form, and assign a register
// for the base if it is non local. Finally, we absorb the scope
// into the base register.
auto void stackvar (int varno) { ENTER();
varfm *w;
if (!((0 <= varno && varno <= maxvars)))
abort ("Stack Var Idx");
w = &var(varno);
stp += 1;
if (stp > maxstack)
abort ("Push V Stack Overflow");
top = &stack(stp);
// top = 0;
memset(top, 0, sizeof(stackfm));
// Translate "level" into "base register" - if it is non local
// we flag it by adding 16 to the desired level, which later will
// force us to pick up a pointer register
if (w->level != 0) {
if (w->level == level) top->base = bp; else top->base = w->level + 16;
} else {
top->base = 0;
}
// AFORM contains the real original declared form, while
// FORM contains the on-the-stack subset of possible forms
strcpy(top->idname, w->idname); // JDM remember variable name
top->aform = w->form;
top->form = fmap(w->form);
top->dim = w->dim;
top->type = w->type;
top->disp = w->disp;
top->extdisp = w->disp;
top->scope = w->scope;
top->format = w->format;
top->size = w->size;
top->extra = w->extra;
top->pbase = w->pbase;
top->varno = varno;
if ((diagnose & 1) != 0) monitor (top, "Var stack");
}
// >> PUSH COPY <<
// Push a duplicate of a stack record onto the stack
auto void pushcopy (stackfm * v) { ENTER();
stp += 1;
if (stp > maxstack) abort ("Stack Copy");
top = &stack(stp);
//top = v;
memmove(top, v, sizeof(stackfm)); // top = v; // another one missed by imp2c
if ((diagnose & 1) != 0) monitor (top, "Stack Copy");
}
// >> PUSH CONST <<
// Push a constant on the stack
auto void pushconst (int n) { ENTER();
stp += 1;
if (stp > maxstack) abort ("Stack Const");
top = &stack(stp);
//top = 0;
memset(top, 0, sizeof(stackfm));
top->disp = n;
top->extdisp = 0;
top->type = integer;
top->form = constant;
if ((diagnose & 1) != 0) monitor (top, "push const");
}
// ---------------------------------------------------------------------
// STRING PROCESSING
// ---------------------------------------------------------------------
// >> INPUT STRING VALUE<<
// Read a string literal from the iCode stream
auto void inputstringvalue (char *s) { ENTER();
int i;
currentstring(0) = strlen (s); // imp2c: imp format string here
for (i = 1; i <= strlen (s); i += 1) {
currentstring(i) = s[(i) - 1];
}
// if this is about to be used as a literal, put it straight into
// the CONST segment and stack it, otherwise leave it in curr string to see
// what comes next and stack a dummy zero
if ((pending != 'A' && pending != '$')) {
otype = con; // anonymous %const
pushconst (getcots (currentstring));
top->type = string;
top->base = 0;
top->scope = cot;
top->form = vins;
top->format = currentstring(0) + 1;
} else {
pushconst (0); // explicit string initialisation coming next
}
}
auto void getaliasvalue (char *s) { ENTER();
strcpy(alias, s);
}
auto void inputrealvalue (double r) { ENTER();
if (r == 0) {
pushconst (0);
} else {
if (pending != 'A') {
otype = con; // anonymous %const
pushconst (0);
top->type = lreal;
top->scope = cot;
top->disp = getcotdouble (r); // N.B. ** %fn + side-effect **
top->extdisp = 0;
top->form = vins;
}
}
rvalue = r;
}
// -------------------------------------------------------
// LABEL PROCESSING
//
// Labels fixups are handled by pass 3 - we just plant
// numerical labels for code locations, and then jump to or call
// those labels. Pass 3 turns them into real locations.
// Unfortunately Pass 3 needs unique label numbers whereas
// Pass 1 produces lame local label numbers that can
// be reused once they've been defined. We therefore
// maintain an indirect database to map Pass 1 label numbers
// into unique tags
// >> NEW TAG <<
// Get the next consecutive Pass 3 label ID
auto int newtag (void) { ENTER();
static int freetag = 999;
freetag += 1;
return (freetag);
}
// >> NEW LABEL <<
// Get the next available label database index
auto int newlabel (void) { ENTER();
labs += 1; if (labs > maxlabs) abort ("Labels");
return (labs);
}
// >> FIND LABEL<<
// return the index in our label table of the Pass 1 label
auto int findlabel (int _label_) { ENTER();
int lp;
lp = labs;
while (lp != firstlabel) {
if (labels(lp).id == _label_) return (lp);
lp -= 1;
}
return (0);
}
// >> DEFINE LABEL <<
// This label is "here"
auto void definelabel (int _label_) { ENTER();
int lp;
labelfm *l;
lp = findlabel (_label_);
if (lp == 0) { // Not yet been used
lp = newlabel ();
l = &labels(lp);
l->id = _label_;
l->tag = newtag ();
} else {
l = &labels(lp);
if (((l->tag & 0x8000) != 0 && _label_ > 0)) l->tag = newtag ();
}
dumplabel (l->tag);
l->tag = l->tag | 0x8000;
uncondjump = 0; // You can get here
} // define label
// >> JUMP TO <<
// A wrapper for conditional jumps to labels that we're going
// to map into tags
auto void jumpto (int _label_, int op, int flag) { ENTER();
labelfm *l;
int lp;
lp = findlabel (_label_);
if (lp == 0) {
lp = newlabel ();
l = &labels(lp);
l->id = _label_;
l->tag = newtag ();
} else {
l = &labels(lp);
if ((flag != 0 && (l->tag & 0x8000) != 0)) l->tag = newtag ();
}
// As a side effect, we also set the global J Tag, which is used
// in planting Event block information (a bit hacky, but a PSR feature)
jtag = l->tag & 0x7FFF;
dumpjump (op, jtag);
if (op == jmp) uncondjump = nextcad;
} // jump to
auto void jumpforward (int val, int test) { ENTER();
int opr;
// FF,TT tests need a value to compare
// TT == TRUE (#0)
// FF == FALSE (=0)
if ((test == ff) || (test == tt)) dumpri (cmp, ax, 0);
// Get the required operator for the test
// We may need to amend the choice of operator
// depending on the invert/compare unsign "flags"
opr = testtoop(test);
if (val == 0) {
if (lastskip != nextcad) {
skipproc = newtag ();
dumpjump (opr, skipproc);
}
} else {
// Check if we need to reverse the test
// So, re-choose the operator
if (invert != 0) test = reverse(test);
invert = 0;
// convert the operators to unsigned versions if needed
if (compareunsign != 0) opr = testtounsignedop(test); else opr = testtoop(test);
compareunsign = 0;
jumpto (val, opr, 1);
}
} // Jump Forward
auto void jumpbackward (int val) { ENTER();
jumpto (val, jmp, 0);
}
// -------------------------------------------------------
// Stack variable transformations
// -------------------------------------------------------
// >> REDUCE <<
// Convert a variable which is addressed in a Rec into a simple variable
// by loading the indirect value into a register and changing the form
auto void reduce (stackfm * v) { ENTER();
int type, form, disp, scope, extdisp;
form = v->form - 3; // X in REC => X in S
type = v->type;
disp = v->disp;
extdisp = v->extdisp;
// Here's a trick - we've got two displacements, DISP and EXTRA, but only
// one SCOPE hint. Which does it belong to? If the REC form came from
// a HAZARD then the scope belongs to the DISP, but for all other cases
// the scope belongs to the EXTRA. If we got here through HAZARD then
// the BASE will be BP - for all other cases it will be either a different
// register, or zero.
if (v->base == bp) {
scope = v->scope;
v->scope = 0;
} else {
scope = 0;
}
v->disp = v->extra;
v->type = integer;
v->form = vins;
loadreg (v, anyp);
v->type = type;
v->form = form;
v->disp = disp;
v->extdisp = extdisp;
v->scope = scope;
}
// >> AMAP <<
// convert V into a descriptor for the address of V
auto void amap (stackfm * v) { ENTER();
int f;
DECLARE0(const int, addrmap, 15 + 1) = { // zero-based array
#define addrmap(r) ACCESS(addrmap,r)
/* 0, 1, 2, 3, 4, 5, 6, 7, */
-1, -2, -3, -4, avins, -5, vins, avinrec,
/* 8, 9, 10, 11, 12, 13, 14, 15 */
-6, vinrec, -7, -8, -9, -10, /*pgm label*/ -11, /*record format*/ -12
};
// ABD - should be code here to deal with ADDR(pgm label)
f = addrmap(v->form);
if (f < 0) {
monitor (v, "AMAP target");
abort ("AMAP");
}
// Try to simplify some forms...
if ((v->disp == 0 && v->scope == 0)) {
if (f == avins) {
if (v->base == 0) f = constant; else f = vinr;
} else if ((f == vinrec) || (f == avinrec)) {
// eliminate redundant LOAD
if (f == vinrec) f = ains; else f = vins;
v->disp = v->extra;
}
}
v->type = integer;
v->form = f;
}
// >> VMAP <<
// The inverse of AMAP: i.e. vmap(amap(x)) => x
auto void vmap (stackfm * v) { ENTER();
int f, t;
DECLARE0(const int, varmap, 8 + 1) = { // zero-based array
#define varmap(r) ACCESS(varmap,r)
/* 0, 1, 2, 3, 4, 5, 6, 7, 8 */
vins, vins, -1, -2, ains, vins, -3, ainrec, vinrec
};
if ((v->form == ains || v->form == ainrec)) {
t = v->type;
amap (v);
loadreg (v, anyp);
v->type = t;
v->form = vins;
}
f = varmap(v->form);
v->form = f;
if (f < 0) abort ("VMap");
} // v map
// >> ADDRESS <<
// convert V into a form in which it is directly addressable
// that means either V in R, V in S or Constant
auto void address (stackfm * v) { ENTER();
int type, form;
if ((diagnose & 2) != 0) monitor (v, "ADDRESS");
form = v->form;
type = v->type;
if (form >= vinrec) {
reduce (v);
form = v->form;
}
// Now pick up a base register if we needed one...
if (v->base > 16) {
v->base = getdisplay (v->base - 16);
claim (v->base);
}
if ((form == vinr || form == constant)) return;
if (form == avins) {
if (v->base == 0) {
v->form = constant;
} else {
if ((v->disp == 0) && (v->scope == 0)) {
v->form = vinr;
} else {
loadreg (v, any);
}
}
return;
}
if (form == vins) return;
if (form == ains) {
v->form = vins;
v->type = integer;
loadreg (v, anyp);
v->type = type;
v->form = vins;
v->disp = 0;
}
} // address
// >> LOAD REG <<
// Load variable V into register R
// Along the way any register the variable owned is released, and
// the new register is claimed.
auto void loadreg (stackfm * v, int r) { ENTER();
static void *f[ 10 /*pgmlabel*/ ] = { // zero-based array
[avins] = &&f_avins,
[vins] = &&f_vins,
[ains] = &&f_ains,
[vinr] = &&f_vinr,
[constant] = &&f_constant,
[ainr] = &&f_ainr,
[avinr] = &&f_avinr,
[ainrec] = &&f_ainrec,
[avinrec] = &&f_avinrec,
[vinrec] = &&f_vinrec,
};
int ptr, op;
if ((diagnose & 2) != 0) monitor (v, "LOAD");
if (r == anyf) {
// Equivalents for real numbers...
// because there's very little clever we can do, we first simplify somewhat...
address (v);
// Now it's either Constant, V in R or V in S - we now turn them
// all into V in S - the only thing we can load
// Start with one we have no instructions for, and promote it to
// something we know how to handle...
if (v->type == byte) loadreg (v, any);
if (v->form == vinr) {
if (v->base >= fr0) return;
// This must be an integer in a CPU register - we need to store it
// before we can use it
v->disp = getwork (wordsize);
dumpmr (mov, bp, v->disp, v->extdisp, v->base);
release (v->base);
v->base = bp;
v->scope = 0;
v->form = vins;
// Now it looks like an integer V in S
}
if (v->form == constant) { // This is an integer constant
if (v->disp == 0) { // We have a special instruction for zero
r = fr0 + fpustack;
dumpflopspec (fldz);
v->base = r;
claim (r);
v->disp = 0;
v->form = vinr;
v->type = real;
return;
}
// Otherwise, we need it in store
v->disp = getcotw (v->disp);
v->form = vins;
v->base = 0;
v->scope = cot;
}
// Now everything that's left is a V in S
if (v->type == integer) {
op = fild;
} else {
if (v->type == real) {
op = fldd;
} else {
op = fldq;
}
}
// register is going to be the top of stack
r = fr0 + fpustack;
dumpfloprm (op, v->base | v->scope, v->disp, v->extdisp);
release (v->base);
v->base = r;
claim (r);
v->disp = 0;
v->form = vinr;
v->type = real;
return;
}
// If the request is one of the variations on "any" then we need
// to first allocate a target register. First, we make a local
// adjustment because we can't load bytes into "any" register,
// only into the GP registers...
if (v->type == byte) {
if (r == any) r = anyg;
// What's more, there is only one register that is both a pointer
// and a legal byte destination
if (r == anyp) r = bx;
}
// We also map the virtual display into a real register if we
// need to. Also, it is possible that an in-store form may
// be derived from a non-pointer register, so we fix that too.
if (v->base > 16) {
v->base = getdisplay (v->base - 16);
claim (v->base);
}
// Now go ahead and allocate a register
if (r == any) {
// If we've got a base,
// it's not in use by anyone else,
// and isn't a display register,
// then use it
if (v->base != 0 && activity[v->base] == 1 && displayhint(v->base) == 0) {
r = v->base;
} else {
r = gpreg ();
}
} else {
if (r == anyg) {
if (0 < v->base && v->base <= bx && activity[v->base] == 1) {
r = v->base;
} else {
r = gpreg ();
}
} else {
if (r == anyp) {
if (activity[v->base] == 1 && (v->base == bx || v->base == si || v->base == di)) {
r = v->base;
} else {
r = ptreg ();
}
} else {
if (v->base == r) {
if (activity[r] > 1) { // protect other uses
release (r); v->base = 0; // Hide my ownership for the moment
hazard (r); // Zap everybody else
claim (r); v->base = r; // Get it back
}
} else {
hazard (r);
}
}
}
}
if (v->form < 0 || v->form >= pgmlabel || f[v->form] == 0) goto f_default;
goto *f[v->form];
f_default: BADSWITCH(v->form, __LINE__, __FILE__);
f_vinrec: /* vinrec */
reduce (v);
if (v->form < 0 || v->form >= pgmlabel || f[v->form] == 0) goto f_default;
goto *f[v->form];
f_avinrec: /* avinrec */
reduce (v);
if (v->form < 0 || v->form >= pgmlabel || f[v->form] == 0) goto f_default;
goto *f[v->form];
f_ainrec: /* ainrec */
reduce (v);
if (v->form < 0 || v->form >= pgmlabel || f[v->form] == 0) goto f_default;
goto *f[v->form];
f_avinr: /* avinr */
abort ("Unexpected Stack Form");
f_ainr: /* ainr */
abort ("Unexpected Stack Form");
f_constant: /* constant */
if ((v->disp == 0 && v->scope == 0)) {
dumprr (xor, r, r);
} else {
dumprioffset (mov, r, v->scope, v->disp, v->extdisp);
}
v->base = r;
v->disp = 0;
v->scope = 0;
v->form = vinr;
claim (r);
return;
f_vinr: /* vinr */
if (v->base == r) return;
dumprr (mov, r, v->base);
release (v->base);
v->base = r;
v->disp = 0;
v->scope = 0;
v->form = vinr;
claim (r);
return;
f_ains: /* ains */
// is the register a pointer?
if (r == bx || r == si || r == di) {
ptr = r;
} else {
ptr = ptreg ();
}
dumprm (mov, ptr, v->base | v->scope, v->disp, v->extdisp);
release (v->base); claim (ptr);
v->base = ptr;
v->disp = 0;
v->scope = 0;
if (v->type == integer) {
dumprm (mov, r, v->base | v->scope, v->disp, v->extdisp);
} else {
if (v->type == byte) {
// watch out for register re-use here...
if (r != v->base) dumprr (xor, r, r); // clear it, but only if it isn't needed
dumprm8 (mov, r + 16, v->base | v->scope, v->disp, v->extdisp);
if (r == v->base) dumpri (and, r, 255);
// otherwise a more expensive clear later
v->type = integer;
} else {
// reals
abort ("Load Real");
}
}
release (v->base);
v->base = r;
v->disp = 0;
v->scope = 0;
v->form = vinr;
claim (r);
return;
f_vins: /* vins */
if (v->type == integer) {
dumprm (mov, r, v->base | v->scope, v->disp, v->extdisp);
} else {
if (v->type == byte) {
// watch out for register re-use here...
if (r != v->base) dumprr (xor, r, r); // clear it, but only if it isn't needed
dumprm8 (mov, r + 16, v->base | v->scope, v->disp, v->extdisp);
if (r == v->base) dumpri (and, r, 255);
// otherwise a more expensive clear later
v->type = integer;
} else { // reals
abort ("Load Real");
}
}
release (v->base);
v->base = r;
v->disp = 0;
v->scope = 0;
v->form = vinr;
claim (r);
return;
f_avins: /* avins */
if (v->base != 0) {
dumprm (lea, r, v->base | v->scope, v->disp, v->extdisp);
release (v->base);
v->type = integer;
} else {
// else
if ((v->disp == 0 && v->scope == 0)) {
dumprr (xor, r, r);
} else {
dumprioffset (mov, r, v->scope, v->disp, v->extdisp);
}
}
v->base = r;
v->disp = 0;
v->scope = 0;
v->form = vinr;
claim (r);
return;
} // LOAD REG
// JDM JDM Adapted from Store routine in Assign
// Store the register item reg in location given by LHS stackfm.
// This only deals with the integer registers.
// Store Reg does NOT cater for floating point registers.
// The destination can be one of:
// 1) Integer
// 2) Byte
// 3) Name/Pointer
auto void storereg (stackfm * lhs, int reg) { ENTER();
if (lhs->base == sp) { // it's a push
if ((lhs->type == integer) || (lhs->type == byte)) {
dumpur (push, reg);
}
} else if (lhs->type == integer) {
dumpmr (mov, lhs->base | lhs->scope, lhs->disp, lhs->extdisp, reg);
} else if (lhs->type == byte) {
dumpmr8 (mov, lhs->base | lhs->scope, lhs->disp, lhs->extdisp, reg + 16);
} else if (lhs->type == record) {
dumpmr (mov, lhs->base | lhs->scope, lhs->disp, lhs->extdisp, reg);
}
} // STORE REG
// >> OPERATION <<
// perform the operation OP on the top two elements of the stack.
// (single element for unary operators)
auto void operation (int op) { ENTER();
stackfm *lhs, *rhs;
int assignpending, work, value, s;
static void *oper[ 256 ] = { // re-based at 0 for efficiency
[concx] = &&oper_concx, /* concx */
[rexpx] = &&oper_rexpx, /* rexpx */
[rdivx] = &&oper_rdivx, /* rdivx */
[expx] = &&oper_expx, /* expx */
[lshx] = &&oper_lshx, /* lshx */
[rshx] = &&oper_rshx, /* rshx */
[divx] = &&oper_divx, /* divx */
[remx] = &&oper_remx, /* remx */
[mulx] = &&oper_mulx, /* mulx */
[andx] = &&oper_andx, /* andx */
[subx] = &&oper_subx, /* subx */
[addx] = &&oper_addx, /* addx */
[absx] = &&oper_absx, /* absx */
[notx] = &&oper_notx, /* notx */
[negx] = &&oper_negx, /* negx */
[orx] = &&oper_orx, /* orx */
[xorx] = &&oper_xorx, /* xorx */
};
static void *roper[ 256 ] = { // re-based at 0 for efficiency
[notx] = &&roper_notx, /* notx */
[andx] = &&roper_andx, /* andx */
[orx] = &&roper_orx, /* orx */
[xorx] = &&roper_xorx, /* xorx */
[remx] = &&roper_remx, /* remx */
[lshx] = &&roper_lshx, /* lshx */
[rshx] = &&roper_rshx, /* rshx */
[expx] = &&roper_expx, /* expx */
[rexpx] = &&roper_rexpx, /* rexpx */
[subx] = &&roper_subx, /* subx */
[divx] = &&roper_divx, /* divx */
[rdivx] = &&roper_rdivx, /* rdivx */
[addx] = &&roper_addx, /* addx */
[mulx] = &&roper_mulx, /* mulx */
[negx] = &&roper_negx, /* negx */
[absx] = &&roper_absx, /* absx */
}; // not generated by imp2c
static void *fold[ 256 ] = { // re-based at 0 for efficiency
[negx] = &&fold_negx, /* negx */
[notx] = &&fold_notx, /* notx */
[absx] = &&fold_absx, /* absx */
[addx] = &&fold_addx, /* addx */
[subx] = &&fold_subx, /* subx */
[orx] = &&fold_orx, /* orx */
[andx] = &&fold_andx, /* andx */
[xorx] = &&fold_xorx, /* xorx */
[lshx] = &&fold_lshx, /* lshx */
[mulx] = &&fold_mulx, /* mulx */
[rshx] = &&fold_rshx, /* rshx */
[expx] = &&fold_expx, /* expx */
[remx] = &&fold_remx, /* remx */
[divx] = &&fold_divx, /* divx */
[rexpx] = &&fold_rexpx, /* rexpx */
[rdivx] = &&fold_rdivx, /* rdivx */
[concx] = &&fold_concx, /* concx */
}; // not generated by imp2c :-(
DECLARE1(const int, opmap, 17 + 1) = { 0, // re-based at 0 for efficiency
#define opmap(r) ACCESS(opmap,r)
add, sub, imul, idiv, 0, and, or, xor, shl, shr, idiv, 0, 0, 0, not, neg, 0
};
DECLARE1(const int, flopmap, 17 + 1) = { 0, // re-based at 0 for efficiency
#define flopmap(r) ACCESS(flopmap,r)
fadd, fsub, fmul, fdiv, 0, 0, 0, 0, 0, 0, 0, 0, 0, fdiv, 0, fchs, fabs
};
DECLARE(const int, indec, -1, 1) = { dec, 0, inc_ }; // decrement, and increment opcodes
#define indec(n) ACCESS(indec,n)
auto void swap (void) { ENTER();
stackfm temp;
memmove(&temp, lhs, sizeof(stackfm));
//temp = lhs; // imp2c: this should be a swap of record contents, not of pointers! Now fixed.
memmove(lhs, rhs, sizeof(stackfm));
//lhs = rhs;
memmove(rhs, &temp, sizeof(stackfm));
//rhs = temp;
}
assignpending = 0;
rhs = top;
if (op < unaries) {
lhs = &stack(stp - 1);
if (lhs->type == real || lhs->type == lreal || op >= rexpx) goto reals;
}
if ((rhs->type == real || rhs->type == lreal)) goto reals;
if (rhs->form == constant && (op >= unaries || lhs->form == constant)) {
if (op < 0 || op >= 256 || fold[op] == 0) goto fold_default;
goto *fold[op];
fold_default: BADSWITCH(op, __LINE__, __FILE__);
}
// now look for optimisations for x = x <op> whatever
if ((pending == 'S') || (pending == 'j')) { // the next task is an assignment
if (op >= unaries) {
if (same (top, &stack(stp - 1)) != 0) assignpending = 1;
} else {
if (same (lhs, &stack(stp - 2)) != 0) assignpending = 1;
}
}
if (op < 0 || op >= 256 || oper[op] == 0) goto oper_default;
goto *oper[op];
oper_default: BADSWITCH(op, __LINE__, __FILE__);
oper_notx: /* notx */
oper_negx: /* negx */
// we optimise for e.g. fred = -fred as one instruction
if (assignpending != 0) {
readsymbol (pending);
address (rhs);
if (rhs->type == byte) {
dumpum8 (opmap(op), rhs->base | rhs->scope, rhs->disp, rhs->extdisp);
} else {
dumpum (opmap(op), rhs->base | rhs->scope, rhs->disp, rhs->extdisp);
}
poprel ();
poprel ();
return;
}
loadreg (rhs, any);
dumpur (opmap(op), rhs->base);
return;
// 8086 has no "abs" instructions, so we do a test and jump
oper_absx: /* absx */
loadreg (rhs, any);
dumpri (cmp, rhs->base, 0);
work = newtag ();
dumpjump (jge, work);
dumpur (neg, rhs->base);
dumplabel (work);
return;
oper_addx: /* addx */
if (lhs->form == constant) swap ();
// and fall through to minus
oper_subx: /* subx */
// First look for fred = fred + <whatever>
// We can only safely do this for bytes if we're jamming or ignoring overflow
if ((assignpending != 0 &&
(lhs->type == integer || (control & checkcapacity) == 0 || pending == 'j'))) {
readsymbol (pending); // we will do the assignment ourselves
address (lhs); // make LHS accessible
if (rhs->form == constant) {
value = rhs->disp;
if (value != 0) {
if (op == subx) value = -value;
// look for increment or decrement instructions
if ((value < 2) && (value > -2)) {
if (lhs->type == byte) {
dumpum8 (indec(value), lhs->base | lhs->scope, lhs->disp, lhs->extdisp);
} else {
dumpum (indec(value), lhs->base | lhs->scope, lhs->disp, lhs->extdisp);
}
} else {
if (lhs->type == byte) {
dumpmi8 (opmap(op), lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->disp);
} else {
dumpmi (opmap(op), lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->disp);
}
}
}
} else { // RHS not a constant
loadreg (rhs, any);
if (lhs->type == byte) {
dumpmr8 (opmap(op), lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->base + 16);
} else {
dumpmr (opmap(op), lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->base);
}
}
poprel ();
poprel ();
poprel ();
return;
}
// So, there is no assign pending
if (rhs->form == constant) {
value = rhs->disp;
if (op == subx) value = -value;
// If it is already an address, do the math on the address offset
if ((lhs->form == avins) || (lhs->form == avinrec)) {
lhs->disp = lhs->disp + value;
} else {
loadreg (lhs, any);
// We don't particulary try for it, but if we ended up with a pointer
// register, we might as well convert this to use the address form...
if (lhs->base == bx) { // BX is the only GP reg that's also a pointer
lhs->form = avins;
lhs->disp = value;
} else {
// otherwise, don't bother deferring the operation
// look for increment or decrement instructions
if ((value < 2) && (value > -2)) {
if (value != 0) dumpur (indec(value), lhs->base);
} else {
dumpri (opmap(op), lhs->base, rhs->disp);
}
}
}
} else { // not a constant
if ((op == addx && rhs->form == vinr)) swap (); // commutative, so flip it
loadreg (lhs, any);
if (rhs->type == byte) {
loadreg (rhs, any);
} else {
address (rhs);
}
dumprv (opmap(op), lhs->base, rhs);
}
poprel (); // the RHS
return;
oper_andx: /* andx */
oper_orx: /* orx */
oper_xorx: /* xorx */
// Logical ops are a subset of ADD - similar behaviour, but no inc/dec/addr short forms
if (lhs->form == constant) swap ();
// First look for fred = fred <op> <whatever>
if (assignpending != 0) {
readsymbol (pending); // we will do the assignment ourselves
address (lhs); // make LHS accessible
if (rhs->form == constant) {
value = rhs->disp;
if (lhs->type == byte) {
if ((rhs->disp & (~255)) != 0) warn (8);
dumpmi8 (opmap(op), lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->disp);
} else {
dumpmi (opmap(op), lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->disp);
}
} else { // RHS not a constant
loadreg (rhs, any);
if (lhs->type == byte) {
dumpmr8 (opmap(op), lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->base + 16);
} else {
dumpmr (opmap(op), lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->base);
}
}
poprel (); // RHS
poprel (); // LHS
poprel (); // Assignment destination
return;
}
// So, there is no assign pending
if (rhs->form == constant) {
value = rhs->disp;
loadreg (lhs, any);
dumpri (opmap(op), lhs->base, value);
} else { // not a constant
if (rhs->form == vinr) swap (); // all these are commutative, so flip it to make it easier
loadreg (lhs, any);
if ((rhs->type == byte) && (op == andx)) { // AND needs all the bits to make sense
loadreg (rhs, any); // NB Load changes type to Integer
} else {
address (rhs);
}
if (rhs->type == byte) { // must be V in S - everything else would be Integer
dumprm8 (opmap(op), lhs->base + 16, rhs->scope | rhs->base, rhs->disp, rhs->extdisp);
} else {
dumprv (opmap(op), lhs->base, rhs);
}
}
poprel (); // the RHS
return;
oper_mulx: /* mulx */
if ((lhs->form == constant) || (rhs->base == ax)) swap ();
if (rhs->form == constant) {
value = rhs->disp;
if (value == 0) { // mul by zero is zero
release (lhs->base);
lhs = rhs;
popstack ();
return;
}
if (value == 1) { // mul by 1 is the identity
popstack ();
return;
}
s = mulshift (value); // find a shift factor
if (s > 0) {
rhs->disp = s;
op = lshx;
goto shiftit;
}
// 8086 multiply instruction doesn't have an immediate operand form
// so we use an entry in the constant table...
rhs->base = 0; rhs->scope = cot; rhs->disp = getcotw (value);
rhs->form = vins;
// and fall through to the not-a-constant path
}
domul:
loadreg (lhs, ax);
address (rhs);
hazard (dx);
if (rhs->form == vinr) {
dumpur (imul, rhs->base);
} else {
dumpum (imul, rhs->base | rhs->scope, rhs->disp, rhs->extdisp);
}
poprel ();
return;
oper_divx: /* divx */
oper_remx: /* remx */
loadreg (lhs, ax);
address (rhs);
hazard (dx);
dumpsimple (cwd);
// Plain 8086 Divide instruction also has no immediate operand form, so
// we move constants to the COT
if (rhs->form == constant) {
if (rhs->disp == 0) warn (1);
rhs->base = 0; rhs->scope = cot; rhs->disp = getcotw (rhs->disp);
rhs->form = vins;
}
if (rhs->form == vinr) {
dumpur (idiv, rhs->base);
} else {
dumpum (idiv, rhs->base | rhs->scope, rhs->disp, rhs->extdisp);
}
poprel ();
if (op == divx) {
lhs->base = ax;
} else {
lhs->base = dx;
release (ax);
claim (dx);
}
return;
oper_lshx: /* lshx */
oper_rshx: /* rshx */
shiftit:
if (((assignpending != 0) &&
(op == rshx || lhs->type == integer || (control & checkcapacity) == 0 || pending == 'j'))) {
readsymbol (pending); // we will do the assignment ourselves
address (lhs); // make LHS accessible
if (rhs->form == constant) {
if (!((0 <= rhs->disp) && (rhs->disp <= 31))) warn (6);
if (rhs->disp != 0) { // shift by zero is a no-op
if (lhs->type == byte) {
dumpmi8 (opmap(op), lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->disp);
} else {
dumpmi (opmap(op), lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->disp);
}
}
} else { // RHS not a constant
// Since the shift instruction only uses the bottom 5 bits of the
// value in CX, the value is "byte safe". Rather than do a full
// "loadreg(rhs,CX)" we therefore fiddle about and do it the hard way
// to save redundant coding
if (rhs->type == byte) {
hazard (cx);
address (rhs);
dumprm8 (mov, cl, rhs->scope | rhs->base, rhs->disp, rhs->extdisp);
} else {
loadreg (rhs, cx);
}
if (lhs->type == byte) {
dumpmr8 (opmap(op), lhs->base | lhs->scope, lhs->disp, lhs->extdisp, cl);
} else {
dumpmr (opmap(op), lhs->base | lhs->scope, lhs->disp, lhs->extdisp, cx);
}
}
poprel (); // RHS
poprel (); // LHS
poprel (); // Assignment destination
return;
}
// deal with constant shifts first...
if (rhs->form == constant) {
value = rhs->disp;
if (!((0 <= value) && (value <= 31))) warn (6);
if (value != 0) {
loadreg (lhs, any);
dumpri (opmap(op), lhs->base, value);
}
} else { // RHS variable
// Since the shift instruction only uses the bottom 4 bits of the
// value in CX, the value is "byte safe". Rather than do a full
// "loadreg(rhs,CX)" we therefore fiddle about and do it the hard way
// to save redundant coding
if (rhs->type == byte) {
hazard (cx);
address (rhs);
dumprm8 (mov, cl, rhs->scope | rhs->base, rhs->disp, rhs->extdisp);
release (rhs->base);
rhs->base = cx;
claim (cx);
} else {
loadreg (rhs, cx);
}
loadreg (lhs, any);
dumprr (opmap(op), lhs->base, cx);
}
poprel ();
return;
oper_expx: /* expx */
if (rhs->form == constant) {
if (rhs->disp == 0) {
poprel ();
poprel ();
pushconst (1);
return;
}
if (rhs->disp == 1) {
poprel ();
return;
}
if (rhs->disp == 2) {
rhs = lhs;
claim (rhs->base);
goto domul;
}
}
loadreg (rhs, any);
dumpur (push, rhs->base);
poprel ();
loadreg (lhs, any);
dumpur (push, lhs->base);
release (lhs->base);
perm (iexp, 2);
lhs->base = ax; claim (ax);
lhs->form = vinr;
return;
oper_rexpx: /* rexpx */
oper_rdivx: /* rdivx */
abort ("Oper unexpected op");
// -----------------------------------------------
// Fold constant expressions at compile time
fold_negx: /* negx */
value = (-(rhs->disp)); goto setunary;
fold_notx: /* notx */
value = (~(rhs->disp)); goto setunary;
fold_absx: /* absx */
value = rhs->disp;
if (value < 0) value = -value;
goto setvalue;
fold_addx: /* addx */
value = lhs->disp + rhs->disp; goto setvalue;
fold_subx: /* subx */
value = lhs->disp - rhs->disp; goto setvalue;
fold_orx: /* orx */
value = lhs->disp | rhs->disp; goto setvalue;
fold_andx: /* andx */
value = lhs->disp & rhs->disp; goto setvalue;
fold_xorx: /* xorx */
value = lhs->disp ^ rhs->disp; goto setvalue;
fold_lshx: /* lshx */
value = lhs->disp << rhs->disp; goto setvalue;
fold_mulx: /* mulx */
value = lhs->disp * rhs->disp; goto setvalue;
fold_rshx: /* rshx */
value = (unsigned int)lhs->disp >> (unsigned int)rhs->disp; goto setvalue;
fold_expx: /* expx */
if (rhs->disp < 0) abort ("Fold -ve Exp");
value = 1;
for (op = 1; op <= rhs->disp; op += 1) {
value = value * lhs->disp;
}
goto setvalue;
fold_remx: /* remx */
fold_divx: /* divx */
value = rhs->disp;
if (value == 0) { warn (1); value = 1; }
value = (int)((int)(lhs->disp) / (int)(value)); // integer divide
if (op == divx) goto setvalue;
value = lhs->disp - (rhs->disp * value);
goto setvalue;
fold_rexpx: /* rexpx */
abort ("Fold REXPx - Not implemented");
fold_rdivx: /* rdivx */
abort ("Fold RDIVx - Not implemented");
setvalue:
popstack ();
setunary:
top->disp = value;
return;
fold_concx: /* concx */
abort ("Fold CONCx - Not implemented");
// --------------------------------------------------------------------
// String operations - the only one is concatenate...
oper_concx: /* concx */
if (assignpending != 0) {
// It's S = S.T
amap (lhs);
loadreg (lhs, any);
dumpur (push, lhs->base);
amap (rhs);
loadreg (rhs, any);
dumpur (push, rhs->base);
poprel ();
poprel ();
dumppushi (0, lhs->size, 0);
if (pending == 'S') perm (sconc, 3); else perm (sjconc, 3);
// and finally, skip the pending assignment, and drop the LHS
readsymbol (pending);
poprel ();
return;
}
// here we've got T.U - if T is already in a WORK location
// we've got a simple append. If it is a user variable, we've
// got to both copy it to a temp area and do the append
if (iswork (lhs) == 0) { // Not a work area
work = getwork (256);
pushconst (work);
top->form = avins;
top->base = bp;
loadreg (top, any);
dumpur (push, top->base);
poprel ();
amap (lhs);
loadreg (lhs, any);
dumpur (push, lhs->base);
release (lhs->base);
dumppushi (0, 255, 0);
perm (smove, 3);
// Now we need to redefine the LHS as our temporary area
//lhs = 0; // gratuitous clear-it-all-out
memset(lhs, 0, sizeof(*lhs));
lhs->type = string;
lhs->form = vins;
lhs->base = bp;
lhs->disp = work;
lhs->size = 255;
}
// Here we are doing an in-situ concatenation
// We want to leave the result as a normal variable, so we
// suck up a copy for the AMAP fiddling
pushcopy (lhs);
amap (top);
loadreg (top, any);
dumpur (push, top->base);
poprel ();
amap (rhs);
loadreg (rhs, any);
dumpur (push, rhs->base);
poprel ();
dumppushi (0, lhs->size, 0);
perm (sconc, 3);
return;
reals:
if (op < unaries) loadreg (lhs, anyf);
if (op != rexpx) loadreg (rhs, anyf);
if (op < 0 || op >= 256 || roper[op] == 0) goto roper_default;
goto *roper[op];
roper_default: BADSWITCH(op, __LINE__, __FILE__);
roper_negx: /* negx */
roper_absx: /* absx */
dumpfloprr (flopmap(op), rhs->base, rhs->base);
return;
roper_addx: /* addx */
roper_mulx: /* mulx */
// Commutative, so we don't care
if (lhs->base > rhs->base) swap ();
dumpfloprr (flopmap(op), lhs->base, rhs->base);
poprel ();
return;
roper_subx: /* subx */
roper_divx: /* divx */
roper_rdivx: /* rdivx */
// We can't swap these, so we use the reverse form of
// the opcode (which in our internal form is always one
// more than the basic opcode index)
op = flopmap(op);
if (lhs->base > rhs->base) {
swap ();
op += 1;
}
dumpfloprr (op, lhs->base, rhs->base);
poprel ();
return;
roper_rexpx: /* rexpx */
// This is implemented as a PERM routine
loadreg (rhs, any);
dumpur (push, rhs->base);
poprel ();
// The usual slightly clunky floating point "push"
work = ptreg ();
dumpri (sub, sp, 8);
dumprr (mov, work, sp);
dumpfloprm (fstq, work, 0, 0);
release (lhs->base);
perm (fexp, 1 + (int)(((int) (8) / (int) (wordsize)))); // integer divide
// Since rexp is actually a standard C routine, the result will
// be on the FPU stack
lhs->base = fr0; claim (fr0);
fpustack = 1;
lhs->form = vinr;
lhs->type = lreal;
return;
roper_notx: /* notx */
abort ("NOTx: Unsupported Real Operation");
roper_andx: /* andx */
abort ("ANDx: Unsupported Real Operation");
roper_orx: /* orx */
abort ("ORx: Unsupported Real Operation");
roper_xorx: /* xorx */
abort ("XORx: Unsupported Real Operation");
roper_remx: /* remx */
abort ("REMx: Unsupported Real Operation");
roper_lshx: /* lshx */
abort ("LSHx: Unsupported Real Operation");
roper_rshx: /* rshx */
abort ("RSHx: Unsupported Real Operation");
roper_expx: /* expx */
abort ("EXPx: Unsupported Real Operation");
} // Operation
// >> ASSIGN <<
// ASSOP = -1: parameter assignment
// 0: == assignment
// 1: = assignment
// 2: <- assignment
auto void assign (int assop) { ENTER();
stackfm *lh, *rh;
stackfm temp;
int n, p;
#ifdef USE_UNUSED
int form; // variable 'form' set but not used UNUSED?
#endif
int r;
// Store the item in RHS to LHS. Encapsulates the dificulties
// of variable length items and pushing things on the stack to
// keep the rest of "Assign" looking tidy
auto void store (stackfm * lhs, stackfm * rhs) { ENTER();
int pt, s, op;
if (lhs->base == sp) { // it's a push
if ((lhs->type == integer) || (lhs->type == byte)) {
if (rhs->type == byte) {
loadreg (rhs, any);
} else {
address (rhs);
}
dumpvpush (rhs);
} else { // must be a real
if (lhs->type == real) {
s = 4;
op = fstd;
} else {
s = 8;
op = fstq;
}
loadreg (rhs, anyf);
pt = ptreg ();
dumpri (sub, sp, s);
dumprr (mov, pt, sp);
dumpfloprm (op, pt, 0, 0);
}
return;
}
if (lhs->type == integer) {
if ((rhs->form == constant) && (rhs->scope == 0)) {
dumpmi (mov, lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->disp);
} else {
loadreg (rhs, any);
dumpmr (mov, lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->base);
}
} else {
if (lhs->type == byte) {
if ((rhs->form == constant && rhs->scope == 0)) {
dumpmi8 (mov, lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->disp);
} else {
if (rhs->type == byte) { // try to avoid pointless promoting to an int
// We will reproduce a "Load" but without the word extension
address (rhs);
pt = gpreg ();
dumprm8 (mov, pt + 16, rhs->base | rhs->scope, rhs->disp, rhs->extdisp);
release (rhs->base);
rhs->base = pt; rhs->form = vinr; rhs->type = integer;
claim (pt);
} else {
loadreg (rhs, any);
// ABD - should add a capacity check here
}
dumpmr8 (mov, lhs->base | lhs->scope, lhs->disp, lhs->extdisp, rhs->base + 16);
}
} else {
loadreg (rhs, anyf);
if (lhs->type == real) {
op = fstd;
} else { // long real
op = fstq;
}
dumpfloprm (op, lhs->base | lhs->scope, lhs->disp, lhs->extdisp);
}
}
}
if (stp < 2) abort ("Assign Stack");
rh = top;
// OK, so monitoring stack() *ought* to catch this v->form == 0 problem...
lh = &stack(stp - 1);
//form = lh->form; UNUSED? // variable 'form' set but not used
// to avoid the ravages of amap, load etc
if ((diagnose & 4) != 0) {
monitor (lh, "ASS LH");
monitor (rh, "ASS RH");
}
if (same (lh, rh) != 0) {
poprel ();
poprel ();
return;
}
if (assop < 0) { // Parameter
if (lh->base >= 128) { // Special - prim routine
memmove(&temp, lh, sizeof(stackfm));
//temp = lh; // imp2c: this should be a swap of record contents, not of pointers! Now fixed.
memmove(lh, rh, sizeof(stackfm));
//lh = rh;
memmove(rh, &temp, sizeof(stackfm));
//rh = temp;
return;
}
// Extract the next formal parameter and make it our target
lh->pbase = lh->pbase - 1;
stackvar (lh->pbase);
// Now make our destination look reasonable
lh = top;
lh->base = sp; // target is the stack
if (lh->form != vins) assop = 0; // %name parameter is '=='
// We need special treatment for procedure parameters
if ((7 <= lh->aform && lh->aform <= 10)) { // this is a procedure
assop = 1; // we will treat it as a value assignment
rh->type = integer; // of an integer
lh->type = integer; lh->form = vins;
if (rh->base != 0) { // RH is already a parameter
rh->form = vins;
} else {
if (rh->scope == ext) { // it is an external procedure
rh->form = avins; // pick up the addres
} else {
// it is a local procedure
// HACK: local procedures are Tags until Pass3 fixes them up. The
// only way we have of converting tags to addresses is with the switch
// table - so we'll plant a fake switch entry for the label of the
// local routine, and then load that value!
if (swtp >= maxswitch) abort ("Proc - Switch Table Full");
swtab(swtp) = rh->disp; rh->disp = swtp * wordsize; swtp += 1;
rh->scope = swt;
rh->form = vins;
}
}
}
}
if ((array <= rh->aform) && (rh->aform <= namearrayname)) { // Arrayname
// An array name is two words - a pointer to the data and a
// pointer to the dope vector. If the RHS is already one of these
// then we just want to copy the two words. If it is a static
// array, we need to map the data to make a pointer, and its' dope
// vector will be in the constant table, so we fetch that.
amap (lh);
address (lh);
amap (rh); // This works because arrays are stacked as V in S, arraynames are A in S
address (rh);
// We do the dope vector first - that makes it easier when we're parameter passing
if ((rh->aform == array || rh->aform == namearray)) { // simple static - DV in COT
// We will rustle up a dummy record for the DV address
memset(&temp, 0, sizeof(temp)); // temp = 0; // imp2c
temp.form = avins;
temp.type = integer;
temp.disp = rh->pbase;
temp.scope = cot;
} else { // already an array name
memmove(&temp, rh, sizeof(stackfm)); // temp = rh;
claim (temp.base);
temp.disp = temp.disp + wordsize;
}
lh->disp = lh->disp + wordsize;
store (lh, &temp);
release (temp.base);
lh->disp = lh->disp - wordsize;
store (lh, rh);
poprel ();
poprel ();
return;
}
if (lh->type == general) { // IF general is 0, then may be cleared lh is the problem? Should NEVER have enums that start at 0 ...
// general %name parameter
if (!(assop == 0)) abort ("Assign GenName"); // Only '==' is allowed
// A general name pointer is two words - the pointer itself
// and a second word to convey type information. If the RHS
// is already one of thse guys it's easy - just copy the two
// words. Otherwise, we need to rustle up the second word at
// compile time.
amap (lh);
address (lh);
// temp is a struct, lh and rh are pointers...
if (rh->type == general) { // imp2c: TO DO: compare this section against imp code
//temp = *rh; // make a copy for the second word
memmove(&temp, rh, sizeof(stackfm)); // temp = rh
claim (temp.base); temp.disp = temp.disp + wordsize;
amap (&temp);
} else {
memset(&temp, 0, sizeof(temp)); // temp = 0; // imp2c
temp.type = integer;
temp.disp = (rh->size << 4) + genmap(rh->type);
}
// We do the words backwards, so that parameter push works
lh->disp = lh->disp + wordsize;
store (lh, (&temp));
release ((&temp)->base);
lh->disp = lh->disp - wordsize;
amap (rh);
store (lh, rh);
poprel ();
poprel ();
return;
}
if (assop == 0) { // ==
amap (lh); // destination
amap (rh); // ABD %string(*)%name NOT handled special here - should be?
}
if (lh->type == record) {
if (lh->base == sp) { // pass record by value - destination is the stack
n = lh->size;
hazard (di);
dumpri (sub, sp, lh->size);
dumprr (mov, di, sp);
claim (di);
lh->base = di;
} else {
n = minrecordsize (lh, rh);
amap (lh);
loadreg (lh, di);
}
hazard (cx);
dumpri (mov, cx, n);
if (rh->form == constant) {
hazard (ax);
dumprr (xor, ax, ax); // get a zero
dumprepstosb ();
} else {
amap (rh);
loadreg (rh, si);
dumprepmovsb ();
}
poprel ();
poprel ();
return;
}
if (lh->type == string) {
if ((assop > 0) && (rh->format == 1)) {
// null string as zero byte ?
lh->type = byte;
poprel (); // zap current RHS
pushconst (0); // get a zero
assign (assop); // and assign it
return;
}
// our copy routines expect DEST then SOURCE then LENGTH on the stack
if (lh->base == sp) { // pass string by value - destination is the stack
// space is string size, plus one for length, plus make it even
p = lh->size + 1; p = (p + align) & (~align);
dumpri (sub, sp, p);
// we want to Push SP here - sadly different versions of x86
// architecture have different interpretations of "PUSH SP", so...
r = gpreg ();
dumprr (mov, r, sp);
dumpur (push, r);
} else {
amap (lh);
loadreg (lh, any);
dumpur (push, lh->base);
}
// It is likely that the RH variable is a temporary work area
// Before we trash the information, we try to release it
returnwork (rh->disp);
amap (rh);
loadreg (rh, any);
dumpur (push, rh->base);
poprel ();
poprel ();
dumppushi (0, lh->size, 0);
if (assop == 2) perm (sjam, 3); else perm (smove, 3);
return;
}
address (lh);
store (lh, rh);
poprel ();
poprel ();
} // assign
// >> ARRAY REF <<
// Array references always use the PERM
// unless they are 1 dimensional,
// AND the %control bit has been turned off
auto void arrayref (int mode) { ENTER();
stackfm *av;
int type, form, size, format;
if (mode != 0) {
// Put non-terminal index onto stack for PERM
if (top->type == byte) {
loadreg (top, any);
} else {
address (top);
}
dumpvpush (top);
poprel ();
return;
}
av = &stack(stp - 1);
size = av->size;
if (av->type == string) size += 1;
form = av->aform;
if ((form == namearray) || (form == namearrayname)) size = wordsize;
if (((control & checkarray) == 0) && (av->dim == 1)) {
// This will be unchecked, the top of the stack is the only index (1D),
// so we can do a cheap multiplication here
if (size != 1) { // multiply offset by var size
pushconst (size);
operation (mulx);
}
} else {
// This is the final (and perhaps only) subscript for a checked array,
// so we are going to use the Perm - therefore pass this as a parameter
if (top->type == byte) {
loadreg (top, any);
} else {
address (top);
}
dumpvpush (top);
poprel ();
}
// How we do the rest of the access depends on whether this is a simple
// static array, or an array name...
if ((form == arrayname) || (form == namearrayname)) { // array is a "name"
// We will AMAP the name, so we remember the info and then put it all back later
type = av->type;
format = av->format;
size = av->size;
if (form == arrayname) form = vins; else form = ains;
amap (av);
if (((control & checkarray) != 0) || (av->dim > 1)) { // do the rest of the check
// This is a bit clunky, because we may load registers in order
// to access AV, only to Hazard them for the PERM
address (av);
pushcopy (av); claim (top->base);
top->disp = top->disp + wordsize; // Dope Vector address follows A(0)
dumpvpush (top);
poprel ();
perm (aref, av->dim + 1); // DV word, plus a word for every subscript
pushconst (0);
top->form = vinr; top->base = ax; claim (ax);
}
loadreg (top, anyp); // make sure index is in a pointer register
operation (addx);
top->type = type;
top->form = form;
top->format = format;
top->size = size;
top->disp = 0;
} else { // simple arrays are always 1D, but can still be checked
if ((control & checkarray) != 0) {
// Pass a pointer to the Dope Vector
dumppushi (cot, av->pbase, 0); // simple arrays have compile-time DV's in the COT
perm (aref, 2);
pushconst (0);
top->form = vinr; top->base = ax; claim (ax);
}
address (av);
if (av->form != vins) abort ("Aref Form");
if (top->form == constant) { // simple constant a(k)
av->disp = av->disp + top->disp; // just add it to the offset
} else {
loadreg (top, anyp); // pick up index in a pointer
if (av->base != 0) { // add the base we've already got
dumprr (add, top->base, av->base);
release (av->base);
}
av->base = top->base;
}
if (form == array) av->form = vins; else av->form = ains;
popstack ();
}
top->aform = 0; // not an array any more
} // array ref
// >> TEST ZERO <<
// test a real/integer/byte variable against zero
auto void testzero (stackfm * v) { ENTER();
if ((v->type == integer) || (v->type == byte)) {
loadreg (v, any);
dumpri (cmp, v->base, 0);
} else {
abort ("Test Zero");
}
} // test zero
auto void comparerecords (stackfm * l, stackfm * r, int n) { ENTER();
// JDM eventually compare the byte values of each record
// in the interim, barf
abort ("Compare Records");
}
// >> COMPARE REALS <<
auto void comparereals (stackfm * l, stackfm * r) { ENTER();
loadreg (l, anyf);
loadreg (r, anyf);
hazard (ax);
// who's ended up on top?
if (l->base > r->base) { // l_base is the top of the FPU stack
dumpfloprr (fcmp, r->base, l->base);
} else {
dumpfloprr (fcmp, l->base, r->base);
invert = invert ^ 1;
}
dumpflopspec (fstsw); // puts status into AX
dumpsimple (sahf); // and move it to flags
compareunsign = 1; // because FPU reports as if operands were unsigned
} // compare reals
// >> COMPARE STRINGS <<
auto void comparestrings (stackfm * l, stackfm * r) { ENTER();
stackfm *temp;
if ((l->base == cot && l->disp == nullstring)) {
temp = r; // TO DO: imp2c: checked
r = l;
l = temp;
invert = invert ^ 1;
}
if ((r->base == cot) && (r->disp == nullstring)) {
l->type = byte;
testzero (l);
} else {
amap (l);
loadreg (l, any);
dumpur (push, l->base);
amap (r);
loadreg (r, any);
dumpur (push, r->base);
perm (scomp, 2);
dumpri (cmp, ax, 0);
}
}
// compare strings
// >> COMPARE <<
auto void compare (stackfm * l, stackfm * r) { ENTER();
if ((l->type == 0 || l->type == string)) {
comparestrings (l, r); return;
}
if ((floating (l) != 0 || floating (r) != 0)) {
comparereals (l, r); return;
}
if (zero (r) != 0) {
testzero (l); return;
}
if (zero (l) != 0) {
testzero (r); invert = invert ^ 1;
return;
}
if (l->type == record) {
comparerecords (l, r, minrecordsize (l, r)); // currently aborts?
return;
}
loadreg (l, any);
if (r->type == byte) {
loadreg (r, anyg);
} else {
address (r);
}
dumprv (cmp, l->base, r);
} // compare
// >> RESOLVE <<
auto void resolve (int flag) { ENTER();
// S -> A.(B).C
if ((flag & 1) == 0) pushconst (0); else amap (top); // C missing?
loadreg (top, any);
dumpur (push, top->base);
poprel ();
amap (top); // B
loadreg (top, any);
dumpur (push, top->base);
poprel ();
if ((flag & 2) == 0) pushconst (0); else {
amap (top); // A missing?
}
loadreg (top, any);
dumpur (push, top->base);
poprel ();
amap (top); // S
loadreg (top, any);
dumpur (push, top->base);
poprel ();
perm (sresln, 4);
if ((flag & 4) != 0) dumpri (cmp, ax, 0);
} // resolve
auto int enter (void) { ENTER();
int cad;
uncondjump = -1; // can get here
// This is a convenient place to include external definitions if needed
if (potype >= external) {
fillexternal (code, nextcad, externalid);
}
cad = nextcad;
dumpstaticalloc (cad, level, blockname); // plant dummy ENTER instruction and pass marker to pass 3
return (cad);
}
// >> DUMP RETURN <<
auto void dumpreturn (void) { ENTER();
if (uncondjump == nextcad) return; // can't get here ?
// Pure 8086 would need these two
// dumprr(MOV, SP, BP)
// dumpur(POP, BP)
// but now we use this instead...
dumpsimple (leave);
dumpsimple (ret);
uncondjump = nextcad;
} // return
// Routine to do "to string" as an in-line, either by making
// a constant string in the CONST area, or putting one onto
// the current workspace
auto void compiletostring (stackfm * v) { ENTER();
int tmp;
if (_const_ (v) != 0) {
currentstring(0) = 1; currentstring(1) = v->disp & 255;
v->base = 0; v->scope = cot; v->disp = getcots (currentstring);
} else {
tmp = getwork (wordsize);
loadreg (v, anyg); // Must be a byte-addressable register
dumpmi (mov, bp, tmp, 0, 1);
dumpmr8 (mov, bp, tmp + 1, 0, v->base + 16);
release (v->base);
v->base = bp; v->scope = 0; v->disp = tmp;
}
v->type = string; v->form = vins; v->size = 1;
}
// >> COMPILE CALL <<
// Call the routine on the top of the stack. Note - the parameters
// are all hidden underneath the routine, so we need to push them
// here
auto void compilecall (stackfm * v) { ENTER();
static void *b[ 16 ] = { // re-based at 0 for efficiency
&&b_default,
&&b_1,
&&b_2,
&&b_3,
&&b_4,
&&b_5,
&&b_6,
&&b_7,
&&b_8,
&&b_9,
&&b_10,
&&b_11,
&&b_12,
&&b_13,
&&b_14,
&&b_15,
};
// 1 = rem
// 2 = float
// 3 = to string
// 4 = addr
// 5 = integer
// 6 = byte integer
// 7 = string
// 8 = record
// 9 = real
// 10 = long real
// 11 = length
// 12 = charno
// 13 = type of ( type of general name parameter )
// 14 = size of ( physical length in bytes )
// 15 = int (from real)
DECLARE(const unsigned char, newtype, 5, 12) = {
1, 5, 3, 4, 2, 6, 5, 5
// integer, byte, string, record, real, lreal, byte, byte
};
#define newtype(n) ACCESS(newtype,n)
int t;
//int l; UNUSED? // variable 'l' set but not used
int p;
if (v->base >= 128) { // built-in primitive
//l = 0; UNUSED? // variable 'l' set but not used
t = v->disp; sym = 0; // 'sym=0' used as flag elsewhere
poprel ();
if ((t < 0) || (t >= 16) || (b[t] == 0)) goto b_default;
goto *b[t];
b_default: BADSWITCH(t, __LINE__, __FILE__);
b_1: /* 1 */
operation (remx); goto esac; // REM
b_2: /* 2 */
loadreg (top, anyf); goto esac; // FLOAT
b_3: /* 3 */
compiletostring (top); goto esac; // TO STRING
b_4: /* 4 */
amap (top); goto esac; // ADDR
b_5: /* 5 */
// INTEGER
b_6: /* 6 */
// BYTE
b_7: /* 7 */
// STRING
b_8: /* 8 */
// RECORD
b_9: /* 9 */
// REAL
b_10: /* 10 */
// LONGREAL
vmap (top); top->type = newtype(t);
top->size = vsize(top->type);
goto esac;
b_11: /* 11 */
// LENGTH
pushconst (0);
// length is charno zero
amap (&stack(stp - 1));
operation (addx); // LHS&RHS reversed in Operation??
vmap (top); top->type = newtype(t);
top->size = vsize(top->type);
goto esac;
b_12: /* 12 */
// CHARNO
amap (&stack(stp - 1));
operation (addx); // LHS&RHS reversed in Operation??
vmap (top); top->type = newtype(t);
top->size = vsize(top->type);
goto esac;
b_13: /* 13 */
// TYPEOF(..)
b_14: /* 14 */
// SIZEOF(..)
if (top->type != general) { // type explicitly specified
if (t == 13) { // type of
p = genmap(top->type);
} else {
p = top->size; if (top->type == string) p += 1;
}
release (top->base);
top->type = integer; top->form = constant;
top->base = 0; top->disp = p;
} else {
top->disp = top->disp + wordsize; // reference property-word
top->form = vins; top->type = integer;
if (t == 13) { // type of
pushconst (15); operation (andx);
} else { // size of
pushconst (4); operation (rshx);
}
}
goto esac;
b_15: /* 15 */
// INT(REAL)
loadreg (top, anyf);
release (top->base);
p = getwork (wordsize);
dumpfloprm (fsti, bp, p, 0);
top->type = integer;
top->form = vins;
top->base = bp;
top->disp = p;
goto esac;
esac:
;
} else {
// -- normal routine calls --
// String functions have a hidden last parameter to point
// to the result area
if ((v->type == string) && (v->aform == 8)) {
t = getwork (v->size + 1);
p = gpreg ();
dumprm (lea, p, bp, t, 0);
dumpur (push, p);
}
hazardall ();
if (v->scope == ext) { // external
dumpextcall (v->disp);
} else {
if (v->base != 0) { // procedure-as-parameter
dumpum (call, v->base, v->disp, v->extdisp); // plants call indirect through variable
} else { // local routine
dumpjump (call, v->disp); // plants fixup for the tag
}
}
// adjust the stack
if (v->extra != 0) dumpri (add, sp, v->extra);
if (v->type == 0) { // not function or map
poprel ();
} else { // Here we've got a result
v->scope = 0; // Result is local, even if the function wasn't
if ((v->type == string) && (v->aform == 8)) {
v->base = bp; // String result will have been copied back here
v->disp = t;
v->form = vins;
} else {
if (((v->type == real || v->type == lreal) && v->aform == 8)) {
// Floating result will be on the FPU stack
v->form = vinr;
v->base = fr0; claim (fr0);
fpustack = 1;
} else {
v->base = ax; // Result is always in AX
v->disp = 0; // Clear this for MAP results
claim (ax);
}
}
}
}
} // Compile Call
// >> COMPILE FOR <<
auto void compilefor (int lab) { ENTER();
stackfm *cv, *iv, *inc, *fv;
int n;
// Lock a value into a temporary to make sure it is invariant
auto void stab (stackfm * v, int type) { ENTER();
int t, r;
if (_const_ (v) != 0) return;
loadreg (v, any);
r = v->base;
t = getwork (wordsize);
dumpmr (mov, bp, t, 0, r);
v->base = bp; v->disp = t; v->scope = 0;
v->type = type; v->form = vins;
release (r);
}
iv = top;
fv = &stack(stp - 1);
inc = &stack(stp - 2);
cv = &stack(stp - 3);
stab (fv, integer);
stab (inc, integer);
// Check control variable is a plain value - otherwise save a pointer to it
// in case it changes
if ((cv->form != vins || (((0 < cv->base && cv->base <= di) && (cv->base != bp))))) {
n = cv->type;
amap (cv);
stab (cv, n);
cv->form = ains;
}
pushcopy (cv);
pushcopy (iv);
pushcopy (inc);
operation (subx);
assign (1); // cv = iv - inc
definelabel (lab);
popstack (); // zap unwanted copy of IV
// Stack is now top->[FV[INC[CV
pushcopy (cv); // in case compare alters it
compare (top, fv);
jumpto (lab + 1, je, 1);
invert = 0; // because the compare might have flipped this (N/A for JE)
// Stack is now top->[CV'[FV[INC[CV where CV' is a register copy of CV
release (fv->base);
//fv = top; // trash FV and make a copy of CV' in that slot zxcv another memcpy or memmove!
memmove(fv, top, sizeof(stackfm)); // fv = top; *fv = *top should work!
popstack (); // discard the top copy
// stack is now top->[CV'[INC[CV
operation (addx);
assign (1);
} // for
auto void endofblock (void) { ENTER();
if (amode >= 0) { // No return code for %endoffile
dumpreturn ();
dumpstaticfill (staticalloc, frame + (level * wordsize), events, evep, evfrom); // don't include the display
}
}
auto void compilebegin (void) { ENTER();
decvar = &begin;
decvar->disp = newtag ();
otype = 0;
spec = 0;
potype = 0;
if (level != 0) { // not outermost %begin
pushconst (decvar->disp);
top->type = 0; // it's not a function!
compilecall (top);
skipproc = newtag ();
dumpjump (jmp, skipproc);
dumplabel (decvar->disp); // this is where to call
}
assemble (0, labs, names);
if (level != 0) {
dumplabel (skipproc);
lastskip = nextcad;
uncondjump = 0;
}
}
// Utility routine used when dumping initialisers for OWNs
// Note non-portable use of real values
auto void adump (void) { ENTER();
int i;
float rv32; // NOTE: This *is a %real, not a %longreal
static void *ot[ 7 /* lreal + 1 */ ] = { // zero-based array
&&ot_general, /* general 0 */
&&ot_integer, /* integer 1 */
&&ot_real, /* real 2 */
&&ot_string, /* string 3 */
&&ot_record, /* record 4 */
&&ot_byte, /* byte 5 */
&&ot_lreal, /* lreal 6 */
};
if ((owntype < general) || (owntype > lreal)) goto ot_default;
goto *ot[owntype];
ot_default: BADSWITCH(owntype, __LINE__, __FILE__);
ot_general: /* general */
abort ("General Own?");
ot_integer: /* integer */
gput (ownval); goto done;
ot_real: /* real */
rv32 = rvalue; // because our default variable is a 64 bit long real
for (i = 0; i <= 3; i += 1) {
gbyte (byteinteger (addr (rv32) + i));
}
goto done;
ot_string: /* string */
if (currentstring(0) + 1 > datasize) { // check for overflow
// String constant too long - warn and truncate
warn (5); currentstring(0) = datasize - 1;
}
for (i = 0; i <= datasize - 1; i += 1) {
gbyte (currentstring(i));
}
goto done;
ot_record: /* record */
for (i = 1; i <= datasize; i += 1) {
gbyte (0);
}
goto done;
ot_byte: /* byte */
gbyte (ownval);
goto done;
ot_lreal: /* lreal */
for (i = 0; i <= 7; i += 1) {
gbyte (byteinteger (addr (rvalue) + i));
}
goto done;
done:
;
}
auto int userlabel (int lab) { ENTER();
varfm *v;
if (lab > names) {
names = lab;
v = &var(lab);
memset(v, 0, sizeof(*v)); // v = 0; // imp2c
v->form = pgmlabel;
v->disp = newtag ();
return (v->disp);
}
return (var(lab).disp);
}
auto void comparedouble (void) { ENTER();
//checksum(">comparedouble");
lhs = &stack(stp - 1);
rhs = top;
loadreg (rhs, any);
//checksum("comparedouble1");
// We happen to know that Compare loads the left parameter in a register.
// We've already got RHS in a register, so we flip the LHS and RHS to the
// comparison and set Invert accordingly
compare (rhs, lhs);
//checksum("comparedouble2");
invert = 1;
// release LH and then overwrite it with RH
release (lhs->base);
//checksum("comparedouble3");
*lhs = *rhs;
popstack ();
//checksum("<comparedouble");
}
auto void comparevalues (void) { ENTER();
lhs = &stack(stp - 1);
rhs = top;
compare (lhs, rhs);
poprel ();
poprel ();
}
auto void compareaddresses (void) { ENTER();
amap (top);
amap (&stack(stp - 1)); // Now do same as compare values
comparevalues ();
}
auto void definecompilerlabel (int _label_) { ENTER();
if (_label_ == 0) {
dumplabel (skipproc);
lastskip = nextcad;
uncondjump = 0;
} else {
definelabel (_label_);
}
}
auto void init (int n) { ENTER();
// N = Number of values to assign
int j;
if (stp != 0) { // Value supplied?
ownval = top->disp;
if ((owntype == real || owntype == lreal)) {
if (top->type == integer) rvalue = ownval; // copy integer supplied into floater
}
popstack ();
} else { // initialise to default pattern
ownval = 0;
currentstring(0) = 0; // in case it's a string
}
if ((ownform == array || ownform == namearray)) {
for (j = 1; j <= n; j += 1) adump ();
} else {
if (otype == 0) { // %const .... %name
// Abort("Constant Name");
// JDM attempt to allow assignment of %const ... %name
decvar->scope = cot;
decvar->level = 0;
decvar->disp = ownval;
} else {
// non-array normal variables
decvar->level = 0;
if (otype == con) {
// constant - must be string or real type, because
// const integers are substituted by value in Pass 1
// Constant strings and reals are treated as literals
decvar->scope = cot;
if (owntype == string) {
decvar->disp = getcots (currentstring);
} else {
if ((owntype == real || owntype == lreal)) {
// constant reals are put in the COT. Depending on how
// the value was formed, ReadReal may have already planted this.
// Not to worry, because "real constant" will find it again.
decvar->disp = getcotdouble (rvalue);
} else {
abort ("Init?");
}
}
} else {
// must be %own or %external - use adump to put it in DATA segment
decvar->scope = data;
decvar->disp = datatp;
adump ();
}
}
}
}
auto void userjump (int _label_) { ENTER();
dumpjump (jmp, userlabel (_label_));
}
auto void defineuserlabel (int _label_) { ENTER();
dumplabel (userlabel (_label_));
}
auto void return_ (int mode) { ENTER();
//int i; UNUSED?
if (mode == false) {
dumpri (mov, ax, 0);
}
if (mode == true) {
dumpri (mov, ax, (-(1)));
}
if (mode == map) {
amap (top);
loadreg (top, ax);
poprel ();
}
if (mode == fn) {
if (procvar->type == integer) {
loadreg (top, ax);
poprel ();
} else {
if ((procvar->type == real || procvar->type == lreal)) {
// Floating point results are put into store, and AX contains
// the address
// JDM - No, not for 32-bit code for IA-32 architecture ABI
// JDM - floating point results go onto the floating point stack in ST(0)
// JDM - that is the returned floating point stack should only be 1 deep
// JDM: loadreg(top,anyf) should push the result onto the floating point stack
loadreg (top, anyf);
poprel ();
} else { // string or record - pass back through the hidden parameter
pushcopy (top); // Make a copy of the thing on top
lhs = &stack(stp - 1); // point to the (now spare) next item
lhs->type = procvar->type; // and make it look like a destination
lhs->size = procvar->size;
lhs->format = procvar->format;
lhs->base = bp;
lhs->disp = wordsize * 2; // At the offset of the last parameter
lhs->form = ains;
assign (1);
}
}
}
if (mode == routine) {
// no need to do anything special
}
dumpreturn ();
}
auto void dimension (int dim, int n) { ENTER();
int i, j;
// Validate the ICODE Parameters
if (!((0 < dim) && (dim < 6))) abort ("Array Dim");
if (inparams != 0) { // Array in record
parms += n;
vub = top->disp; popstack ();
vlb = top->disp; popstack ();
if (vlb > vub) abort ("Array Bounds");
dv = setdopevector ();
} else {
names -= n;
// Now we need to plant code to manufacture a dope vector
frame = (frame - ((dim * (2 * wordsize)) + (2 * wordsize))) & (~align); // space for :Dim:<bound pairs>:DataSize:
dv = frame;
// First store the dimension
dumpmi (mov, bp, dv, 0, dim);
// And the data size is also constant
dumpmi (mov, bp, dv + (dim * (2 * wordsize)) + wordsize, 0, datasize);
// Now the bounds
j = 0; // points to before the first stack value
for (i = 1; i <= dim * 2; i += 1) {
j += 1; lhs = &stack(j);
if (lhs->form == constant) {
dumpmi (mov, bp, dv + (i * wordsize), 0, lhs->disp);
} else {
loadreg (lhs, any);
dumpmr (mov, bp, dv + (i * wordsize), 0, lhs->base);
}
}
// Now we need to allocate the space for the array
if ((dim > 1 || (control & checkarray) != 0)) {
// Do it with the PERM
while (stp != 0) {
poprel (); // get rid of all the bounds - they are in the DV already
}
dumprm (lea, ax, bp, dv, 0);
dumpur (push, ax);
perm (adef, 1);
// We now need to make our result match the inline version
// by putting AX and DX into stacklike variables
pushconst (0); lhs = top;
pushconst (0); rhs = top;
lhs->base = ax; lhs->form = vinr; claim (ax);
rhs->base = dx; rhs->form = vinr; claim (dx);
popstack ();
popstack ();
} else {
pushconst (1);
operation (addx);
pushconst (datasize);
operation (mulx);
pushcopy (&stack(stp - 1)); // suck up the lower bound
pushconst (datasize);
operation (mulx);
// top is now the lower bound, next is the upper, and a bogus copy of lb is next
loadreg (top, any); // Make sure this is in a register
lhs = top; // Point to it
popstack (); // and drop (without release) this copy
loadreg (top, any); // This is now UB - load it in a register as well
rhs = top; // Point to it
popstack (); // and keep RHS (Upper)
popstack (); // dump the bogus lb
}
// Note - there are 4 GP registers, and we're going to need them ALL here
t = gpreg (); // get a working register for the dope vector address
dumprm (lea, t, bp, dv, 0); // load it
dv = t; claim (dv); // use this to hold the register number
t = gpreg (); // the last one! (which we don't claim, 'cos we can't lose it)
dumprr (mov, t, sp); // working copy of SP so that real SP is always "OK"
}
for (i = 1; i <= n; i += 1) {
decvar->dim = dim;
if (inparams == 0) { // array not in record
names += 1; decvar = &var(names);
decvar->level = level;
frame -= (wordsize * 2); // 2-word header
decvar->disp = frame;
if ((decvar->form == array || decvar->form == namearray)) decvar->form = decvar->form + 1; // force arrayname
dumprr (sub, t, rhs->base);
dumpmr (mov, bp, frame, 0, t); // store a(0) address
dumpmr (mov, bp, frame + wordsize, 0, dv); // store dope vector pointer
dumprr (add, t, lhs->base);
} else { // array-in-record
parms -= 1; decvar = &var(parms);
decvar->disp = frame - vlb;
frame += vub; // noting that Set Dope Vector has changed VUB to the array size
decvar->pbase = dv;
}
}
if (inparams == 0) {
// We need to keep the stack pointer word aligned - 8086's run faster that way,
// and more importantly, Pentiums throw an exception if you don't!
if ((datasize & align) != 0) dumpri (and, t, (~(align)));
dumprr (mov, sp, t);
release (lhs->base);
release (rhs->base);
release (dv);
}
}
auto void updateline (int line) { ENTER();
currentline = line;
if (stp != 0) abort ("Stack?");
if (claimed != 0) abort ("Claimed");
// Pass1 sends the line number multiple times if there's more than
// one statement per line - for debugging we only want "real" line numbers
if (echoline < currentline) {
dumplinenumber (currentline);
while (echoline < currentline) {
echosourceline ();
}
}
}
auto void switchjump (int switchid) { ENTER();
v = &var(switchid);
pushconst (wordsize); operation (mulx); // subscript X WordSize
loadreg (top, anyp);
dumpum (jmp, swt | top->base, v->disp * wordsize, 0); // swtab is word-size
poprel ();
uncondjump = nextcad;
}
auto void setrecordformat (int formatid) { ENTER();
top->format = formatid;
top->type = record;
}
auto void switchlabel (int switchlabel) { ENTER();
v = &var(switchlabel);
uncondjump = 0;
j = top->disp; popstack ();
t = newtag ();
dumplabel (t);
swtab(v->disp + j) = t;
}
auto void constantbounds (void) { ENTER();
vub = top->disp; popstack ();
vlb = top->disp; popstack ();
}
auto void internalhandler (int id) { ENTER();
while (stp < 2) pushconst (0);
pushconst (id);
loadreg (top, any); dumpur (push, top->base); poprel ();
loadreg (top, any); dumpur (push, top->base); poprel ();
loadreg (top, any); dumpur (push, top->base); poprel ();
perm (signal, 3);
if (id != -1) uncondjump = nextcad; // %monitor will return
}
auto void signalevent (int eventid) { ENTER();
internalhandler (eventid);
}
auto void monitor (void) { ENTER();
internalhandler (-1);
}
auto void selectfield (int fieldindex) { ENTER();
// Contrary to earlier iCode versions, this one seems to use 'n' for
// both normal record member access and alternate formats?
lhs = top;
// Points to the base record
stackvar (var(top->format).pbase - fieldindex); // Push descriptor for the i-th member
if (top->aform != recordformat) { // not record format - must be a member
if ((lhs->form == vins || lhs->form == vinrec)) {
top->disp = top->disp + lhs->disp;
lhs->form = lhs->form - vins + top->form;
} else {
if (lhs->form == ainrec) {
lhs->form = vinrec; lhs->type = integer;
loadreg (lhs, any);
lhs->form = top->form;
} else {
if (lhs->form <= vinr) {
lhs->form = top->form;
// ????
} else {
// A in S
lhs->extra = lhs->disp;
lhs->form = top->form + 3;
}
}
}
lhs->disp = top->disp;
lhs->type = top->type;
lhs->aform = top->aform;
lhs->dim = top->dim;
}
lhs->size = top->size; lhs->format = top->format;
popstack ();
}
auto void eventtrap (int anevent, int evfrom) { ENTER();
// events: Events to trap (then comma)
// evfrom: Label to skip to
int temp;
events = anevent;
temp = getwork (wordsize); // get a temp location for SP
dumpmr (mov, bp, temp, 0, sp); // because our signaller doesn't restore it
jumpto (evfrom, jmp, 1); // go there now
// We need to make EVFROM into a label ID that pass 3 will recognise
// to build the trap table, so Jump To sets a variable we pick up here...
evfrom = jtag;
evep = newtag (); // tag for the event body entry point
dumplabel (evep); // which is here
dumprm (mov, sp, bp, temp, 0); // First thing we do is restore SP
}
auto void doubleop (int opr) { ENTER();
int j, t;
lhs = &stack(stp - 1);
t = lhs->type;
j = lhs->size;
if (t == string) j += 1;
amap (lhs);
if (j == 0) abort ("++/-- size");
pushconst (j);
operation (mulx);
operation (opr);
vmap (top); top->type = t;
}
auto void setcd (int value, int *cd) { ENTER();
// JDM set value for the appropriate compiler pass
// In this case we are in pass2
//fprintf(stderr, "setcd: value = %08x\n", value);
if ((value & 0xC000) == ((passid & 3) << 14)) {
*cd = value & 0x3FFF;
//fprintf(stderr, "setcd: set parameter to = %08x\n", *cd);
} else {
//fprintf(stderr, "setcd: (value & 0xC000) == ((passid & 3) << 14) was false, so parameter was not set to = %08x\n", *cd);
}
}
auto int finishparams (void) { ENTER();
int j;
if (amode < 0) return (0 == 0); // end of %record %format defn.
if (procvar->level == 128) return (0 == 0); // prim routine reference
// Here it's a real subroutine - copy any parameters to the PARM area
if (names > firstname) {
procvar->pbase = parms; // Point one beyond the first parameter
frame = (frame + align) & (~align); // Even up the stack size
if ((procvar->type == string && procvar->form == 8)) {
frame += wordsize; // string functions have a hidden result parameter
}
procvar->extra = frame; // Remember the stack offset
procvar->dim = names - firstname; // and the number of parameters
frame += (2 * wordsize); // leave space for return linkage (IP + BP)
for (j = firstname + 1; j <= names; j += 1) {
ap = &var(j);
parms -= 1; fp = &var(parms);
//fp = ap; // imp2c: copy, not pointer copy! Another bug fixed... zxcv
memmove(fp, ap, sizeof(varfm)); // fp = ap; try *fp = *ap?
// formal parameter base and displacement is implicit (on the stack)
fp->level = 0;
// we also need to adjust the offsets of the actual parameters, because
// they were allocated going "forwards", but will be pushed on the stack
// "backwards" - that is, the first item passed will end up with the
// highest address. DefineVar has done part of the work for us by tagging
// the displacements in the right style, but it can't tell the whole frame
// offset, so we calculate the final offsets here...
ap->disp = frame - ap->disp;
}
if (parms < names) abort ("Params");
}
if (amode == 2) return (0 == 0); // this was just a spec
dumplabel (procvar->disp);
staticalloc = enter ();
frame = -(level * wordsize); // one word for each display entry
return (0 != 0);
}
auto int alternateformat (int n) { ENTER();
// Check the ICODE for faults
// and abort for any faulty intermediate code
if (!(n == 'A' || n == 'B' || n == 'C')) abort (concat ("Alt Record '", concat (tostring (sym), "'.")));
if (n == 'B') return (0 == 0); // alt end
if (n == 'A') { // alt start
decvar = procvar;
assemble ((-(2)), labs, names);
}
if (n == 'C') {
// Compile the next alternate - update limit and set frame back to where we started
if (frame > maxframe) maxframe = frame;
frame = oldframe;
}
return (0 != 0);
}
// ******************************************
// JDM JDM attempt to include the plant icode and machine code icode
auto void plant (void) { ENTER();
// Plant in-line code values (from "*=constant")
int j;
// We only expect one item on the stack
if (stp != 1) abort ("Machine Literal");
for (j = 1; j <= stp; j += 1) {
// JDM JDM not sure what next 3 lines do, so commented out
// lhs == stacked(j)
// word (lhs_disp)
// drop (lhs)
}
// JDM empty the icode stack
stp = 0;
}
auto char *gettypename (int f) { ENTER();
char name[8 + 1]; // %string
strcpy (name, "????");
if (f == 0) strcpy (name, "general");
if (f == 1) strcpy (name, "integer");
if (f == 2) strcpy (name, "real");
if (f == 3) strcpy (name, "string");
if (f == 4) strcpy (name, "record");
if (f == 5) strcpy (name, "byte");
if (f == 6) strcpy (name, "lreal");
return (strdup(name)); // imp2c: imp returns a copy of the string on the stack, not a pointer to the string.
}
auto char *getformname (int f) { ENTER();
char name[24 + 1]; // %string
strcpy (name, "????");
static void *n[ 15 + 1 ] = { // zero-based array
&&n_0, /* 0 */
&&n_1, /* 1 */
&&n_2, /* 2 */
&&n_3, /* 3 */
&&n_4, /* 4 */
&&n_5, /* 5 */
&&n_6, /* 6 */
&&n_7, /* 7 */
&&n_8, /* 8 */
&&n_9, /* 9 */
&&n_10, /* 10 */
&&n_11, /* 11 */
&&n_12, /* 12 */
&&n_13, /* 13 */
&&n_14, /* 14 */
&&n_15, /* 15 */
};
//unsigned char esac; UNUSED?
goto *n[f & 15];
n_0: /* 0 */
strcpy (name, "void"); goto esac;
n_1: /* 1 */
strcpy (name, "simple"); goto esac;
n_2: /* 2 */
strcpy (name, "name"); goto esac;
n_3: /* 3 */
strcpy (name, "_label_"); goto esac;
n_4:
strcpy (name, "recordformat"); goto esac;
n_5: /* 5 */
strcpy (name, "?????"); goto esac;
n_6: /* 6 */
strcpy (name, "switch"); goto esac;
n_7: /* 7 */
strcpy (name, "routine"); goto esac;
n_8: /* 8 */
strcpy (name, "function"); goto esac;
n_9: /* 9 */
strcpy (name, "map"); goto esac;
n_10: /* 10 */
strcpy (name, "predicate"); goto esac;
n_11: /* 11 */
strcpy (name, "array"); goto esac;
n_12: /* 12 */
strcpy (name, "arrayname"); goto esac;
n_13: /* 13 */
strcpy (name, "namearray"); goto esac;
n_14: /* 14 */
strcpy (name, "namearrayname"); goto esac;
n_15: /* 15 */
strcpy (name, "?????????????"); goto esac;
esac:
return (strdup(name)); // imp2c: imp returns a copy of the string on the stack, not a pointer to the string.
}
// classify the type of the machine code instruction parameter
const int unknown = 0, variable = 1, register_ = 2, number = 3, mask = 4, name = 5, pointer = 6;
// param type is one of unknown, variable, register, number, mask, name, pointer
// param value is ???, tag, reg id, number, 32-bit mask, integer, reg id,
// param data is ???, tag name, reg name, N/A, N/A, name, reg name
// param offset is N/A, N/A, N/A, N/A, N/A, N/A, offset
//
auto void dumptagvar (int tag, char *prefix) { ENTER();
printstring (concat (" ", concat (prefix, concat (" tag=", itos (tag, 0)))));
newline ();
printstring (concat (" ", concat (prefix, concat (" name=", var(tag).idname))));
newline ();
printstring (concat (" ", concat (prefix, concat (" type=", concat (itos (var(tag).type, 0), concat (" ", gettypename (var(tag).type)))))));
newline ();
printstring (concat (" ", concat (prefix, concat (" form=", concat (itos (var(tag).form, 0), concat (" ", getformname (var(tag).form)))))));
newline ();
printstring (concat (" ", concat (prefix, concat (" level=", itos (var(tag).level, 0)))));
newline ();
printstring (concat (" ", concat (prefix, concat (" scope=", itos (var(tag).scope, 0)))));
printstring (concat (" ", relocname(var(tag).scope >> 4)));
newline ();
printstring (concat (" ", concat (prefix, concat (" disp=", itos (var(tag).disp, 0)))));
newline ();
printstring (concat (" ", concat (prefix, concat (" extdisp=", itos (var(tag).extdisp, 0)))));
newline ();
printstring (concat (" ", concat (prefix, concat (" size=", itos (var(tag).size, 0)))));
newline ();
printstring (concat (" ", concat (prefix, concat (" extra=", itos (var(tag).extra, 0)))));
newline ();
printstring (concat (" ", concat (prefix, concat (" format=", itos (var(tag).format, 0)))));
newline ();
printstring (concat (" ", concat (prefix, concat (" dim=", itos (var(tag).dim, 0)))));
newline ();
printstring (concat (" ", concat (prefix, concat (" pbase=", itos (var(tag).pbase, 0)))));
newlines (2);
}
auto void dumpparameter (int paramindex, int paramtype, char *paramname, int paramvalue, int paramoffset) { ENTER();
//char t[255 + 1]; UNUSED? // %string
//int tag, n; UNUSED?
printstring (concat ("Parameter(", concat (itos (paramindex, 0), concat (")='", concat (paramname, "'"))))); newline ();
if (paramtype == pointer) {
// dump the pointer data
if (paramoffset == 0) {
printstring (concat (" PTR id=", itos (paramvalue, 0))); newline ();
printstring (concat (" PTR name=[", concat (paramname, "]"))); newline ();
printstring (" PTR offset=0"); newlines (2);
} else {
printstring (concat (" PTR id=", itos (paramvalue, 0))); newline ();
printstring (concat (" PTR name=[", concat (paramname, concat (itos (paramoffset, 0), "]")))); newline ();
printstring (concat (" PTR offset=", itos (paramoffset, 0)));
newlines (2);
}
} else if (paramtype == variable) {
// dump the variable data
dumptagvar (paramvalue, "VAR");
} else if (paramtype == register_) {
// dump the register data
printstring (concat (" REG id=", itos (paramvalue, 0))); newline ();
printstring (concat (" REG name=", paramname)); newlines (2);
} else if (paramtype == number) {
// dump the number data
printstring (concat (" NUMBER value=", itos (paramvalue, 0))); newlines (2);
} else if (paramtype == mask) {
// dump the mask data
printstring (concat (" MASK value=2_", int2ascii (paramvalue, 2, 0))); newlines (2);
} else if (paramtype == name) {
// dump the name data
printstring (concat (" NAME name=", paramname)); newline ();
printstring (concat (" NAME value=2_", int2ascii (paramvalue, 2, 0))); newlines (2);
}
}
// >> MACHINE CODE <<
auto void machinecode (char *code_impstr) { ENTER();
// This is meant to insert a machine code fragment into the code stream
// For now do nothing with the machine code text
// JDM JDM JDM
// ok, lets go
// 1) need to parse the machine code text
char s[255 + 1], t[255 + 1]; // %string
//char rname[255 + 1]; UNUSED?
// char instruction[5 + 1]; // %string - using C format
// THIS FIXES A BUG IN MY SINGLE EXAMPLE OF STRING RESOLUTION
char instruction[255 + 1]; // %string - using C format
char parameters_impstr[255 + 1]; // Imp %string format
int paramscount;
// ass-u-me that a machine code instruction has at most 8 parameters
const int paramlimit = 8;
// Remember number of CPU registers (1..register limit)
const int registerlimit = 8;
// A machine code string has the form *op_ item*
// where op is an instruction name (a sequence of alphanumeric chars terminated by '_')
// An item has one of the forms:
// 1) varname == ' ' BB (where 0 <= B <= 255 and BB represent a definition tag)
// 2) constant == 'N' BBBB (where 0 <= B <= 255 and BBBB represents a 32-bit signed integer)
// 3) text == B+ (where 128 <= B <= 255 and then convert b = B - 128, so text is an ASCII sequence b+)
// and the code string can include the ASCII chars (excluding any varname,constant,text format)
// 4) chars == c* (where c is one of '<','>','[',']','(',')','#',',')
//
// An instruction can have 0,1,2 parameters separated by a ','
// One parameter type is a register mask of form '<' number (',' number)* '>'
// This is the ONLY other legal use of a ','
// The following defines the legal opcode parameters
// 1) register == constant (a register index, beware register range)
// 2) number == # constant (a 32-bit signed integer)
// 3) mask == '<' register (',' register)* '>' (a bit set of registers, beware limit on count of registers)
// 4) modifier == text number
// 5) variable == varname, pointer
// 6) pointer == '[' register ']', '[' register '+' offset ']', '{ register '-' offset ']'
// 7) offset == constant (a 32-bit signed integer)
//
// N.B. a variable could be the value held in varname or the address of varname.
// N.B. register always refers to its value, but pointer becomes an address
//
// Legal Intel 386 instruction formats
// The modifier, mask parameters are unused
// No-op instruction
// *op_
//
// One-op instruction
// *op_ register
// *op_ number
// *op_ variable
//
// Two-op MOV instruction
// *op_ register ',' register2 == register := register2
// *op_ register ',' number == register := number
// *op_ register ',' variable == register := variable
// *op_ variable ',' register == variable := register
// *op_ variable ',' number == variable := number
//
// Two-op instruction (non-MOV instruction)
// *op_ register ',' register2 == register := register op register2
// *op_ register ',' number == register := register op number
// *op_ register ',' variable == register := register op variable
// *op_ variable ',' register == variable := variable op register
// *op_ variable ',' number == variable := variable op number
typedef struct paramfm
{
char data[256];
//char *data;
int scomma, pcomma, start, end;
char paramname[256];
int paramtype, paramvalue, paramoffset;
} paramfm;
DECLARE1(paramfm, params, paramlimit + 1); // re-based to 0 for efficiency
#define params(r) ACCESS(params,r)
{int i;
for (i = params_low; i <= params_high; i++) {
params(i).data[0] = '\0';
params(i).scomma = 0;
params(i).pcomma = 0;
params(i).start = 0;
params(i).end = 0;
params(i).paramname[0] = '\0';
params(i).paramtype = 0;
params(i).paramvalue = 0;
params(i).paramoffset = 0;
}
}
// JDM being lazy I created a dual purpose list to map
// op (NOP:JMP) to a corresponding opX
// op (NOP:JMP) to a text version of opX
// This list maps opId to internal opX
DECLARE(const int, opgenericid, nop, jmp) = { // zero-based array
-1, -1, -1, -1, -1, -1, -1, negx,
/* NOP, CWD, RET, SAHF, LEAVE, DEC, INC, NEG, */
notx, pop, push, -1, -1, -1, -1, addx,
/* NOT, POP, PUSH, LEA, MOV, XCHG, ADC, ADD, */
andx, -1, orx, subx, xorx, lshx, rshx, divx,
/* AND, CMP, OR, SUB, XOR, SHL, SHR, IDIV, */
mulx, -1, -1, -1, -1, -1, -1, -1,
/* IMUL, CALL, JE, JNE, JG, JGE, JL, JLE, */
-1, -1, -1, -1, -1
/* JA, JAE, JB, JBE, JMP */
};
#define opgenericid(op) ACCESS(opgenericid,op)
// This list maps opId to internal opX name
DECLARE(const char *, opgenericname, nop, jmp) = { // zero-based array
"NOP", "CWD", "RET", "SAHF", "LEAVE", "DEC", "INC", "NEGx",
"NOT", "POP", "PUSH", "LEA", "MOV", "XCHG", "ADC", "ADD",
"AND", "CMP", "OR", "SUB", "XOR", "SHL", "SHR", "IDIV",
"IMUL", "CALL", "JE", "JNE", "JG", "JGE", "JL", "JLE",
"JA", "JAE", "JB", "JBE", "JMP"
};
#define opgenericname(op) ACCESS(opgenericname,op)
//char varname[255 + 1]; UNUSED? // %string
unsigned char ch;
char opnamex[5 + 1]; // %string
int i=0, j=0, k=0, n=0, plen=0; // GT: initialising all to 0 to be safe...
//int tag; UNUSED?
//int rval; UNUSED?
int opid, opidx;
unsigned char inrbflag=0, insbflag=0, inabflag=0, hashflag=0, plusflag=0, minusflag=0; // uninitialised minusflag caused problems on ARM
static void *inner_c[ 256 ] = { // zero-based array
[' '] = &&inner_c_SPACE, /* ' ' */
['N'] = &&inner_c_UPPER_N, /* 'N' */
['#'] = &&inner_c_HASH, /* '#' */
[','] = &&inner_c_COMMA, /* ',' */
['+'] = &&inner_c_PLUS, /* '+' */
['-'] = &&inner_c_MINUS, /* '-' */
['('] = &&inner_c_OPEN_ROUND_BRACKET, /* '(' */
[')'] = &&inner_c_CLOSE_ROUND_BRACKET, /* ')' */
['['] = &&inner_c_OPEN_SQUARE_PARENTHESIS, /* '[' */
[']'] = &&inner_c_CLOSE_SQUARE_PARENTHESIS, /* ']' */
['<'] = &&inner_c_OPEN_ANGLE_BRACKET, /* '<' */
['>'] = &&inner_c_CLOSE_ANGLE_BRACKET, /* '>' */
};
//unsigned char esac; UNUSED?
//unsigned char default_; UNUSED?
//int start; UNUSED?
//int end; UNUSED?
if ((diagnose & mcodelevela) != 0) {
selectoutput (listout);
newline ();
}
// BUG!!!! imp_resolve does not work when the imp string contained
// (void) imp_resolve (code, instruction, "_", parameters); /* temp */
{ // IMP-format string!
char *ptr;
int code_len, inst_len, param_len;
code_len = code_impstr[0]; // code is an IMP string. Containing NULs ! :-(
memmove(instruction, code_impstr+1, sizeof(instruction));// instruction is a C string of 5+1 bytes
ptr = strchr(instruction, '_');
*ptr = '\0';
inst_len = strlen(instruction);
param_len = code_len - 1 - inst_len;
memmove(parameters_impstr+1, ptr+1, param_len);
parameters_impstr[0] = param_len; // parameters is an IMP string
//{int i;
// fprintf(stderr, "A: parameters: ");
// for (i = 0; i <= param_len; i++) fprintf(stderr, " %0d", parameters_impstr[i]);
// fprintf(stderr, "\n");
//}
}
strcpy (s, "");
//if (strcmp (parameters_impstr, "")) {
if (parameters_impstr[0] != 0) {
// parameters is a non-empty string so we ass-u-me at least one parameter
paramscount = 1;
plen = parameters_impstr[0]; // IMP STRING!!! not strlen (parameters);
inrbflag = 0;
// not inside round bracket sequence
insbflag = 0;
// not inside square bracket sequence
inabflag = 0;
// not inside angle bracket sequence
hashflag = 0;
// not expecting a number to follow
i = 1;
while (i <= plen) {
ch = parameters_impstr[(i) - 1]; // TO DO: imp2c: watch for signedness -
// parameters had better be unsigned but is declared as char...
// maybe better use the gcc flag to ensure that.
if (ch < 128) {
if (inner_c[ch] == 0) goto inner_c_default;
goto *inner_c[ch];
}
// this is an ordinary ASCII char
// So, ch > 127, thus this "char" starts a tweaked "name"
strcpy (t, "%");
while ((unsigned char)parameters_impstr[(i) - 1] > 127) { // TO DO: imp2c: THIS DEFINITELY NEEDS SOME THOUGHT!
// Append the converted char
t[strlen (t) + 1] = '\0'; // tweak appended "char" to be a legal 7-bit ASCII char
t[strlen (t)] = parameters_impstr[(i) - 1] - 128; // TESTING zxcv
i += 1;
}
params(paramscount).paramtype = name;
params(paramscount).paramvalue = 0;
// value acquired by next N section
memmove(params(paramscount).paramname, t, 256);;
strcat (s, concat (t, " "));
goto esac;
inner_c_SPACE: /* ' ' */
// a variable/pointer reference is prefixed by a space.
n = (parameters_impstr[(i + 1) - 1] << 8) + parameters_impstr[(i + 2) - 1];
// now determine the variable name
strcpy(t, var(n).idname);
// remember this parameter is a variable/pointer (and its tag)
if (insbflag == 1) {
params(paramscount).paramtype = pointer;
} else {
params(paramscount).paramtype = variable;
}
params(paramscount).paramvalue = n;
memmove(params(paramscount).paramname, t, 256);
strcat (s, t);
i += 3;
goto esac;
inner_c_UPPER_N: /* 'N' */
// A number is prefixed by an ASCII 'N'
{
/*
Imp version returns:
Pop: 111 : Typ= 1 Frm= 4 Bse= 6 Dsp= -36 ExtDsp= -36 Siz= 4 Xtr= 0 Fmt= 0 Dim= 0 Pba= 0 Name='LIMIT'
charno( parameters, i+1 ) = 0
charno( parameters, i+2 ) = 0
charno( parameters, i+3 ) = 0
charno( parameters, i+4 ) = 3
N: n = 3
whereas this C code is returning:
Line 6647: N: c1=00000000
Line 6649: N: c2=ffffffff
Line 6651: N: c3=ffffffff
Line 6653: N: c4=00000000
Line 6661: N: n=fffeff00
Line 6936: params(1).paramvalue = fffeff00
Line 6946: params(1).paramvalue = fffeff00
Line 6955: params(1).paramvalue = fffeff00
Line 6969: params(1).paramvalue = fffeff00
Line 6974: params(1).paramvalue = fffeff00
"pass2.c", Line 1103:
*** Monitor entered from C - Array bound error: displayhint(-65792) outside range displayhint(1:8)
*/
int c1, c2, c3, c4;
//{int i;
// fprintf(stderr, "B parameters: ");
// for (i = 0; i <= parameters_impstr[0]; i++) fprintf(stderr, " %0d", parameters_impstr[i]);
// fprintf(stderr, "\n");
//}
/*
B parameters: 9 78 0 -1 -1 0 0 0 0 37
Line 6687: N: c1=00000000
Line 6689: N: c2=ffffffff
Line 6691: N: c3=ffffffff
Line 6693: N: c4=00000000
Line 6701: N: n=fffeff00
*/
//fprintf(stderr, "i = %0d\n", i);
c1 = parameters_impstr[(i + 1)-1];
//fprintf(stderr, "Line %0d: N: c1=%08x\n", __LINE__, (unsigned int)c1);
c2 = parameters_impstr[(i + 2)-1];
//fprintf(stderr, "Line %0d: N: c2=%08x\n", __LINE__, (unsigned int)c2);
c3 = parameters_impstr[(i + 3)-1];
//fprintf(stderr, "Line %0d: N: c3=%08x\n", __LINE__, (unsigned int)c3);
c4 = parameters_impstr[(i + 4)-1];
//fprintf(stderr, "Line %0d: N: c4=%08x\n", __LINE__, (unsigned int)c4);
n = 0;
n += parameters_impstr[(i + 1) - 1]; n = n << 8;
n += parameters_impstr[(i + 2) - 1]; n = n << 8;
n += parameters_impstr[(i + 3) - 1]; n = n << 8;
n += parameters_impstr[(i + 4) - 1];
}
//fprintf(stderr, "Line %0d: N: n=%08x\n", __LINE__, (unsigned int)n);
if (params(paramscount).paramtype == name) {
//fprintf(stderr, "if (params(paramscount).paramtype == name) {\n");
// this number is associated with a "name" (i.e. %shl 4)
hashflag = 0;
// we have the "name" (i.e %shl)
// but now to get the associated numeric value
params(paramscount).paramvalue = n;
// convert number to text
if (n > 127) {
strcpy(t, concat ("16_", int2ascii (n, 16, 0)));
} else {
strcpy(t, itos (n, 0));
}
// now to add the associated number to the s string
strcat (s, t);
} else if ((hashflag != 0 && params(paramscount).paramtype == unknown)) {
//fprintf(stderr, "} else if ((hashflag != 0 && params(paramscount).paramtype == unknown)) {\n");
// hashflag indicates this is a genuine integer
hashflag = 0;
// remember this parameter is a number
params(paramscount).paramtype = number;
params(paramscount).paramvalue = n;
params(paramscount).paramname[0] = 0;
if (n > 127) {
strcpy(t, concat ("16_", int2ascii (n, 16, 0)));
} else {
strcpy(t, itos (n, 0));
}
strcat (s, t);
memmove(params(paramscount).paramname, t, 256);
} else if (params(paramscount).paramtype == mask) {
//fprintf(stderr, "} else if (params(paramscount).paramtype == mask) {\n");
// Ah, we are between <> == mask
// So we need to update the mask
if ((0 < n) && (n <= registerlimit)) {
// ok, legal register mask range
k = 1 << (n - 1);
} else if ((0 < n) && (n <= 32)) {
// oops, bad mask specifier for this CPU
k = 1 << (n - 1);
} else {
// oops, even worse! Is this a CPU with > 32 registers.
// we can't fit this mask into a 32-bit integer
// so, we won't try
k = 0;
}
// add the register flag to the mask
params(paramscount).paramvalue = params(paramscount).paramvalue | k;
// remember N represents the register number but add the reg name
// Ensure we are referencing a valid register
// Adjust register limit for a specific CPU
if ((0 < n) && (n <= registerlimit)) {
strcat (s, regname(n));
} else {
strcat (s, "R??");
//fprintf(stderr, "Line %0d: n = %d\n", __LINE__, (int)n);
}
} else {
// ok this came from a constant integer in the IMP program
// ASS-U-ME that this constant represents a register
// So, replace the number with the register name
// Register name is specific to a processor architecture
// IMP code with embedded assembler should reference a
// register by number.
// The IMP pass2 for that processor should store a mapping
// between "register" number and register name.
// eg Intel eax or ebp
// remember this parameter is a variable/pointer (and its tag)
if (insbflag == 1) {
params(paramscount).paramtype = pointer;
} else {
params(paramscount).paramtype = register_;
}
if (plusflag == 1) {
// remember this "parameter" is a positives pointer offset
params(paramscount).paramoffset = n;
strcpy(t, itos (n, 0));
} else if (minusflag == 1) {
// remember this "parameter" is a negative pointer offset
params(paramscount).paramoffset = (-(n));
// however, negative sign (and or #) already output
strcpy(t, itos (n, 0));
} else {
// remember this parameter is a register
params(paramscount).paramvalue = n;
// Ensure we are referencing a valid register
// Adjust register limit for a specific CPU
if ((0 < n && n <= registerlimit)) {
strcpy(t, regname(n));
} else {
strcpy (t, "R??");
}
memmove(params(paramscount).paramname, t, 256);
}
strcat (s, t);
}
i += 5;
goto esac;
inner_c_HASH: /* '#' */
// let this char through
// BUT remember # is assumed to prefix a positive number
hashflag = 1;
goto default_;
inner_c_COMMA: /* ',' */
// let this char through
// comma separates instruction parameters
// (or values between brackets)
if ((inabflag + inrbflag + insbflag) == 0) {
// REMEMBER, the parameter type and value should have been
// determined previously
// note comma location in the s string
params(paramscount).scomma = strlen (s) + 1;
// note comma location in the parameters string
params(paramscount).pcomma = i;
// beware fence post error
// we are counting fence posts (,)
// and their locations
// So "last" fence post at end of parameters string
// we have an additional parameter
paramscount += 1;
// BUT set the param type appropriately
params(paramscount).paramtype = unknown;
params(paramscount).paramoffset = 0;
}
goto default_;
inner_c_PLUS: /* '+' */
// pass this char( only allowed between [] brackets
plusflag = 1;
minusflag = 0;
goto default_;
inner_c_MINUS: /* '-' */
// pass this char( only allowed between [] brackets
plusflag = 0;
minusflag = 1;
goto default_;
inner_c_OPEN_ROUND_BRACKET: /* '(' */
// pass this char (opening round brackets)
inrbflag = 1;
goto default_;
inner_c_CLOSE_ROUND_BRACKET: /* ')' */
// pass this char (closing round brackets)
inrbflag = 0;
goto default_;
inner_c_OPEN_SQUARE_PARENTHESIS: /* '[' */
// we are referencing an indirect variable
params(paramscount).paramtype = pointer;
// initialise the name,value and offset
params(paramscount).paramname[0] = '\0';
params(paramscount).paramvalue = 0;
params(paramscount).paramoffset = 0;
// pass this char (opening square brackets)
insbflag = 1;
goto default_;
inner_c_CLOSE_SQUARE_PARENTHESIS: /* ']' */
// pass this char (closing square brackets)
plusflag = 0;
minusflag = 0;
insbflag = 0;
goto default_;
inner_c_OPEN_ANGLE_BRACKET: /* '<' */
// We are starting a mask parameter
params(paramscount).paramtype = mask;
// initialise the value and name
params(paramscount).paramname[0] = '\0';
params(paramscount).paramvalue = 0;
params(paramscount).paramoffset = 0;
// pass this char (opening angle brackets)
inabflag = 1;
goto default_;
inner_c_CLOSE_ANGLE_BRACKET: /* '>' */
// pass this char (closing angle brackets)
inabflag = 0;
goto default_;
default_: ;
inner_c_default: ; // imp2c: c(*):
// pass these chars
// chars > 127 are already dealt with
// So, this deals with remaining chars
strcat (s, tostring (parameters_impstr[(i) - 1]));
i += 1;
goto esac;
esac:
;
}
} else {
// Oh, this instruction has no parameters
paramscount = 0;
}
if (paramscount != 0) {//zxcv
// now to identify each instruction parameter inside the s string
for (i = 1; i <= paramscount; i += 1) {
if (i == 1)
params(i).start = 1;
else
params(i).start = params(i - 1).scomma + 1;
if (i == paramscount)
params(i).end = strlen (s);
else
params(i).end = params(i).scomma - 1;
strcpy (params(i).data, "");
for (j = params(i).start; j <= params(i).end; j += 1) {
strcpy(params(i).data, concat (params(i).data, tostring (s[(j) - 1])));
}
}
}
// determine the opId for this instruction
// set a default "ILLEGAL" value for the opId
// Although Intel 386 has opCodes 0..255
// the count of opCode names is much less than 255
// so, we are safe to set opId and opIdx = 255
opid = -1;
opidx = -1;
for (i = nop; i <= jmp; i += 1) {
if (strcmp(instruction, opgenericname(i)) == 0) {
opid = i;
opidx = opgenericid(opid);
if (opidx != -1) {
#ifdef NEVER
// hand coded for now until I check this
assert (sizeof(opnamex) == 5 + 1);
assert (sizeof(instruction) == 5 + 1);
memmove(opnamex, instruction, 5 + 1);
#endif
memmove(opnamex, instruction, sizeof(opnamex)); // safety: change to strncpy or memove. 5+1
} else {
strcpy(opnamex, itos (opid, 0) /*, sizeof(opnamex)*/); // as above
}
//break; // imp version should %exit here.
}
}
// We are NOT allowing any floating point instructions
// %for i = FILD,1,FLDPI %cycle
// %if instruction = flopname(i) %then opId = i
// %repeat
// %if (opId < FILD) %then instruction = opName(opId) %else instruction = flopName(opId)
// use short form of %if statement (as an example)
if (opid == -1)
abort ("MCODE has illegal/unknown instruction name");
if ((diagnose & mcodelevela) != 0) {
selectoutput (listout);
printstring ("**** START MCODE ****");
newline ();
if ((diagnose & mcodeleveld) != 0) {
printstring (concat (" Raw Instruction text: '", concat (instruction, concat ("'_", parameters_impstr))));
newline ();
}
printstring (concat ("Translated Instruction: '", concat (instruction, concat ("' ", s))));
newline ();
printstring (concat (" Instruction: '", concat (instruction, concat ("' has ", concat (itos (paramscount, 0), " parameter")))));
if (paramscount != 1)
printsymbol ('s');
newline ();
printstring (concat (" Instruction OpId: ", itos (opid, 0)));
newline ();
printstring (concat (" Instruction OpIdx: ", itos (opidx, 0)));
newline ();
// now to identify each instruction parameter inside the s string
printstring ("*** start parameters ****");
newline ();
// Dump any parameters specified
for (i = 1; i <= paramscount; i += 1) {
dumpparameter (i, params(i).paramtype, params(i).paramname, params(i).paramvalue, params(i).paramoffset);
//fprintf(stderr, "Line %d: params(1).paramvalue = %08x\n", __LINE__, (unsigned int)params(1).paramvalue);
}
printstring ("*** end parameters ****");
newline ();
// Add an extra newline to split the above debug code from
// the following code generation code
newline ();
printstring ("**** START CODE GEN **********");
newline ();
}
//fprintf(stderr, "Line %d: params(1).paramvalue = %08x\n", __LINE__, (unsigned int)params(1).paramvalue);
// 2) need to interpret parsed code
if (paramscount == 0) {
selectoutput (listout);
printstring ("**** Instructions with no parameters not yet implemented");
newline ();
} else if (paramscount == 1) {
if (opid != -1) {
//fprintf(stderr, "Line %d: params(1).paramvalue = %08x\n", __LINE__, (unsigned int)params(1).paramvalue);
if (params(1).paramtype == variable) {
if ((diagnose & mcodelevela) != 0) {
printstring (concat (instruction, concat (" ", params(1).paramname)));
newline ();
}
stackvar (params(1).paramvalue);
operation (opidx);
} else if (params(1).paramtype == pointer) {
selectoutput (listout);
printstring (concat ("Opcode ", concat (instruction, concat (" with one parameter can only operate on an address/register ", params(1).paramname))));
newline ();
abort (concat ("Opcode ", concat (instruction, concat (" with one parameter can only operate on an address/register ", params(1).paramname))));
} else if (params(1).paramtype == register_) {
//fprintf(stderr, "Line %d: params(1).paramvalue = %08x\n", __LINE__, (unsigned int)params(1).paramvalue);
if ((diagnose & mcodelevela) != 0) {
printstring (concat (instruction, concat (" ", params(1).paramname)));
newline ();
}
//fprintf(stderr, "Line %d: params(1).paramvalue = %08x\n", __LINE__, (unsigned int)params(1).paramvalue);
dumpur (opid, params(1).paramvalue);
} else {
abort (concat ("Opcode ", concat (instruction, concat (" is attempting to operate on unexpected location ", params(1).paramname))));
}
} else {
abort (concat ("Attempting to apply unknown opcode ", instruction));
}
} else if (paramscount == 2) {
// 3) output the implied code fragment
if (opid == mov) {
if (params(1).paramtype == variable) {
if ((params(2).paramtype == variable || params(2).paramtype == pointer)) {
selectoutput (listout);
printstring (" ILLEGAL PARAMETER COMBINATION");
newline ();
printstring (" ILLEGAL ADDRESSING MODE for Intel assembler");
newline ();
printstring (" No INTEL instruction can have indirect pointers for both source and destination");
newline ();
} else if (params(2).paramtype == register_) {
if ((diagnose & mcodelevela) != 0) {
printstring ("We have a ASSIGN var1,reg2 scenario");
newline ();
printstring (concat (params(1).paramname, concat (" := ", params(2).paramname)));
newline ();
}
stackvar (params(1).paramvalue);
if ((top->type == general || (top->type == integer || (top->type == byte || top->type == record)))) {
storereg (top, params(2).paramvalue);
} else {
abort (concat ("Attempting to store reg ", concat (params(2).paramname, " in a non-integer variable")));
}
poprel ();
} else if (params(2).paramtype == number) {
if ((diagnose & mcodelevela) != 0) {
printstring ("We have an ASSIGN var1,#const2 scenario");
newline ();
printstring (concat (params(1).paramname, concat (" := #", itos (params(2).paramvalue, 0))));
newline ();
}
stackvar (params(1).paramvalue);
pushconst (params(2).paramvalue);
assign (1);
} else {
abort (concat ("Attempting to store unexpected type in variable ", params(1).paramname));
}
} else if (params(1).paramtype == pointer) {
if ((params(2).paramtype == variable || params(2).paramtype == pointer)) {
selectoutput (listout);
printstring (" ILLEGAL PARAMETER COMBINATION");
newline ();
printstring (" ILLEGAL ADDRESSING MODE for Intel assembler");
newline ();
printstring (" No INTEL instruction can have indirect pointers for both source and destination");
newline ();
} else if (params(2).paramtype == register_) {
if ((diagnose & mcodelevela) != 0) {
printstring ("We have a STORE [reg ((+,-) offset)?],reg2 scenario");
newline ();
printstring (concat (params(1).paramname, concat (" := &", params(2).paramname)));
newline ();
}
dumpmr (opid, params(1).paramvalue, params(1).paramoffset, 0, params(2).paramvalue);
} else if (params(2).paramtype == number) {
if ((diagnose & mcodelevela) != 0) {
printstring ("We have a STORE [reg ((+,-) offset)?],const2 scenario");
newline ();
printstring (concat (params(1).paramname, concat (" := &", params(2).paramname)));
newline ();
}
selectoutput (listout);
printstring (" EXPERIMENTAL IMPLEMENTATION");
newline ();
dumpmi (opid, params(1).paramvalue, params(1).paramoffset, 0, params(2).paramvalue);
printstring (" NOT YET IMPLEMENTED");
newline ();
} else {
abort (concat ("Attempting to store unexpected type in variable ", params(1).paramname));
}
} else if (params(1).paramtype == register_) {
if (params(2).paramtype == variable) {
if ((diagnose & mcodelevela) != 0) {
printstring ("We have a LOAD reg1,var2 scenario");
newline ();
printstring (concat (params(1).paramname, concat (" := ", params(2).paramname)));
newline ();
}
stackvar (params(2).paramvalue);
loadreg (top, params(1).paramvalue);
poprel ();
} else if (params(2).paramtype == pointer) {
if ((diagnose & mcodelevela) != 0) {
printstring ("We have a LOAD reg1,[reg2 ((+,-) offset)?] scenario");
newline ();
if (params(2).paramoffset == 0) {
printstring (concat (params(1).paramname, concat (" := [", concat (params(2).paramname, "]"))));
newline ();
} else {
printstring (concat (params(1).paramname, concat (" := [", concat (params(2).paramname, concat (itos (params(2).paramoffset, 0), "]")))));
newline ();
}
}
dumprm (opid, params(1).paramvalue, params(2).paramvalue, params(2).paramoffset, 0);
} else if (params(2).paramtype == register_) {
if ((diagnose & mcodelevela) != 0) {
printstring ("We have a MOVE reg1,reg2 scenario");
newline ();
printstring (concat (params(1).paramname, concat (" := ", params(2).paramname)));
newline ();
}
dumprr (opid, params(1).paramvalue, params(2).paramvalue);
} else if (params(2).paramtype == number) {
if ((diagnose & mcodelevela) != 0) {
printstring ("We have a LOAD reg1,#const2 scenario");
newline ();
printstring (concat (params(1).paramname, concat (" := #", itos (params(2).paramvalue, 0))));
newline ();
}
pushconst (params(2).paramvalue);
loadreg (top, params(1).paramvalue);
poprel ();
} else {
abort (concat ("Attempting to store unexpected type in register ", params(1).paramname));
}
} else {
abort (concat ("Attempting to ", concat (instruction, " into non-variable/register location")));
}
} else if (opidx != -1) {
if (params(1).paramtype == variable) {
if ((params(2).paramtype == variable || params(2).paramtype == pointer)) {
selectoutput (listout);
printstring (" ILLEGAL PARAMETER COMBINATION");
newline ();
printstring (" ILLEGAL ADDRESSING MODE for Intel assembler");
newline ();
printstring (" No INTEL instruction can have indirect pointers for both source and destination");
newline ();
} else if (params(2).paramtype == register_) {
if ((diagnose & mcodelevela) != 0) {
printstring (concat ("We have a ", concat (instruction, " var1,reg2 scenario")));
newline ();
printstring (concat (params(1).paramname, " := "));
printstring (concat (params(1).paramname, concat (" ", concat (opnamex, concat (" ", params(2).paramname)))));
}
stackvar (params(1).paramvalue);
dumpmr (opid, top->base | top->scope, top->disp, top->extdisp, top->base);
poprel ();
} else if (params(2).paramtype == number) {
if ((diagnose & mcodelevela) != 0) {
printstring (concat ("We have a ", concat (instruction, " var1,#const2 scenario")));
newline ();
printstring (concat (params(1).paramname, " := "));
printstring (concat (params(1).paramname, concat (" ", concat (opnamex, concat (" #", itos (params(2).paramvalue, 0))))));
newline ();
}
stackvar (params(1).paramvalue);
stackvar (params(1).paramvalue);
pushconst (params(2).paramvalue);
operation (opidx);
assign (1);
} else {
abort (concat ("Opcode ", concat (instruction, concat (" is attempting to store unexpected type in variable ", params(1).paramname))));
}
} else if (params(1).paramtype == pointer) {
if ((params(2).paramtype == variable || params(2).paramtype == pointer)) {
selectoutput (listout);
printstring (" ILLEGAL PARAMETER COMBINATION");
newline ();
printstring (" ILLEGAL ADDRESSING MODE for Intel assembler");
newline ();
printstring (" No INTEL instruction can have indirect pointers for both source and destination");
newline ();
} else if (params(2).paramtype == register_) {
if ((diagnose & mcodelevela) != 0) {
printstring (concat ("We have a ", concat (instruction, " [reg1 ((+,-) offset)?],reg2 scenario")));
newline ();
if (params(1).paramoffset == 0) {
printstring (concat ("[", concat (params(1).paramname, "] := ")));
printstring (concat ("[", concat (params(1).paramname, concat ("] ", concat (opnamex, concat (" ", params(2).paramname))))));
} else {
printstring (concat ("[", concat (params(1).paramname, concat (itos (params(1).paramoffset, 0), "] := "))));
printstring (concat ("[", concat (params(1).paramname, concat (itos (params(1).paramoffset, 0), concat ("] ", concat (opnamex, concat (" ", params(2).paramname)))))));
}
newline ();
}
dumpmr (opid, params(1).paramvalue, params(1).paramoffset, 0, params(2).paramvalue);
} else if (params(2).paramtype == number) {
if ((diagnose & mcodelevela) != 0) {
printstring (concat ("We have a ", concat (instruction, " [reg1 ((+,-) offset)?],const2 scenario")));
newline ();
if (params(1).paramoffset == 0) {
printstring (concat ("[", concat (params(1).paramname, "] := ")));
printstring (concat ("[", concat (params(1).paramname, concat ("] ", concat (opnamex, concat (" ", params(2).paramname))))));
} else {
printstring (concat ("[", concat (params(1).paramname, concat (itos (params(1).paramoffset, 0), "] := "))));
printstring (concat ("[", concat (params(1).paramname, concat (itos (params(1).paramoffset, 0), concat ("] ", concat (opnamex, concat (" ", params(2).paramname)))))));
}
newline ();
}
selectoutput (listout);
printstring (" EXPERIMENTAL IMPLEMENTATION");
newline ();
dumpmi (opid, params(1).paramvalue, params(1).paramoffset, 0, params(2).paramvalue);
printstring (" NOT YET IMPLEMENTED");
newline ();
} else {
abort (concat ("Attempting to store unexpected type in variable ", params(1).paramname));
}
} else if (params(1).paramtype == register_) {
if (params(2).paramtype == variable) {
if ((diagnose & mcodelevela) != 0) {
printstring (concat ("We have a ", concat (instruction, " reg1,var2 scenario")));
newline ();
printstring (concat (params(1).paramname, " := "));
printstring (concat (params(1).paramname, concat (" ", concat (opnamex, concat (" ", params(2).paramname)))));
newline ();
}
stackvar (params(2).paramvalue);
dumprv (opid, params(1).paramvalue, top);
poprel ();
} else if (params(2).paramtype == pointer) {
if ((diagnose & mcodelevela) != 0) {
printstring (concat ("We have a ", concat (instruction, " reg1,[reg2 (('+','-')offset)?] scenario")));
newline ();
printstring (concat (params(1).paramname, " := "));
printstring (concat (params(1).paramname, concat (" ", concat (opnamex, concat (" ", params(2).paramname)))));
newline ();
}
selectoutput (listout);
printstring (" EXPERIMENTAL IMPLEMENTATION");
newline ();
dumprm (opid, params(1).paramvalue, params(2).paramvalue, params(1).paramoffset, 0);
printstring (" NOT YET IMPLEMENTED");
newline ();
} else if (params(2).paramtype == register_) {
if ((diagnose & mcodelevela) != 0) {
printstring (concat ("We have a ", concat (instruction, " reg1,reg2 scenario")));
newline ();
printstring (concat (params(1).paramname, " := "));
printstring (concat (params(1).paramname, concat (" ", concat (opnamex, concat (" ", params(2).paramname)))));
newline ();
}
dumprr (opid, params(1).paramvalue, params(2).paramvalue);
} else if (params(2).paramtype == number) {
if ((diagnose & mcodelevela) != 0) {
printstring (concat ("We have a ", concat (instruction, " reg1,const2 scenario")));
newline ();
printstring (concat (params(1).paramname, " := "));
printstring (concat (params(1).paramname, concat (" ", concat (opnamex, concat (" #", itos (params(2).paramvalue, 0))))));
newline ();
}
dumpri (opid, params(1).paramvalue, params(2).paramvalue);
} else {
abort (concat ("Opcode ", concat (instruction, concat (" is attempting to store unexpected type in register ", params(1).paramname))));
}
} else {
abort (concat ("Opcode ", concat (instruction, concat (" is attempting to store in unexpected location ", params(1).paramname))));
}
} else {
abort (concat ("Attempting to apply unknown opcode ", instruction));
}
} else {
abort (concat ("Opcode ", concat (instruction, concat (" has unexpected number ", concat (itos (paramscount, 0), "of parameters.")))));
}
if ((diagnose & mcodelevela) != 0) {
selectoutput (listout);
newline ();
printstring ("**** END CODE GEN ********");
newline ();
printstring ("**** END MCODE ****");
newlines (2);
}
}
// ******************************************
// --------------------------------------------------------------
// I believe this is the long lost body of assemble() that was declared about 6 miles above.
firstname = names;
firstlabel = labs;
procvar = decvar;
lastskip = -1;
oldframe = frame;
frame = 0;
events = 0;
evep = 0;
evfrom = 0;
if (amode >= 0) {
// NOT A RECORDFORMAT
level += 1;
if ((level > maxlevel && spec == 0))
abort ("Level");
worklist(level) = 0;
if (amode == 0) {
// %begin block
if (level == 1) {
// Initial %begin ?
strcpy(blockname, (char *)programip);
// For stack traceback readability
strcpy(externalid, (char *)programep);
// linkage to program entry
otype = external;
potype = otype;
} else {
strcpy (blockname, "%begin block");
}
staticalloc = enter ();
frame = (-((level * wordsize)));
// 1 word for every display entry
}
} else {
if (amode == (-(1))) {
// normal record format
procvar->pbase = parms;
// where our members start
} else {
if (amode == (-(2)))
frame = oldframe;
// alternates start at the current offset
}
maxframe = frame;
// start counting space here
}
// --- main compilation loop ---
for (;;) {
sym = pending;
readsymbol (pending);
if ((sym < 33 || sym > 127)) {
selectoutput (0);
printsymbol ('(');
write (sym, 1);
printsymbol (',');
write (pending, 1);
printsymbol (')');
abort ("Bad I Code - out of range");
/*
When running on ARM:
#2 0x00013600 in abort (message=0x344e0 "Bad I Code") at pass2.c:613
613 exit (0/force_gdb);
*/
}
if ((sym < 0) || (sym >= 256) || (c[sym] == 0)) goto c_default;
goto *c[sym];
c_EXCLAM: /* '!' */
operation (orx);
continue;
c_DOUBLE_QUOTE: /* '"' */
comparedouble ();
continue;
c_HASH: /* '#' */
jumpforward (readtag (), ne);
continue;
c_DOLLAR: /* '$' */
{
int rt0, rt1, rt2, rt3;
char *ga; // GOTCHA! Imp vs C - left to right order of evaluating parameters!!!!
rt0=readtag ();
ga=getascii_cstring (',');
rt1=readtagcomma ();
rt2=readtagcomma ();
rt3=readtag ();
definevar (rt0, ga, rt1, rt2, rt3);
}
continue;
c_PERCENT: /* '%' */
operation (xorx);
continue;
c_AMPERSAND: /* '&' */
operation (andx);
continue;
c_SINGLE_QUOTE: /* '\'' */
inputstringvalue (readstring ());
continue; // Stack string constant
c_OPEN_ROUND_BRACKET: /* '(' */
jumpforward (readtag (), le);
continue;
c_CLOSE_ROUND_BRACKET: /* ')' */
jumpforward (readtag (), ge);
continue;
c_STAR: /* '*' */
operation (mulx);
continue;
c_PLUS: /* '+' */
operation (addx);
continue;
c_MINUS: /* '-' */
operation (subx);
continue;
c_PERIOD: /* '.' */
operation (concx);
continue;
c_SLASH: /* '/' */
operation (divx);
continue;
c_COLON: /* ':' */
definecompilerlabel (readtag ());
continue; // Define compiler label
c_SEMICOLON: /* ';' */
endofblock ();
break;
c_OPEN_ANGLE_BRACKET: /* '<' */
jumpforward (readtag (), lt);
continue;
c_EQUALS: /* '=' */
jumpforward (readtag (), eq);
continue;
c_CLOSE_ANGLE_BRACKET: /* '>' */
jumpforward (readtag (), gt);
continue;
c_QUERY: /* '?' */
comparevalues ();
continue; // Compare values
c_ATSIGN: /* '@' */
stackvar (readtag ());
continue; // Stack variable descriptor
c_UPPER_A: /* 'A' */
init (readtag ());
continue; // Initialise OWN variable
c_UPPER_B: /* 'B' */
jumpbackward (readtag ());
continue; // Backward Jump
c_UPPER_C: /* 'C' */
compareaddresses ();
continue; // Compare addresses
c_UPPER_D: /* 'D' */
inputrealvalue (readreal ());
continue; // Stack real constant
c_UPPER_E: /* 'E' */
compilecall (top);
continue;
c_UPPER_F: /* 'F' */
jumpforward (readtag (), always);
continue; // Forward Jump
c_UPPER_G: /* 'G' */
getaliasvalue (readstring ());
continue; // Alias for item about to be declared
c_UPPER_H: /* 'H' */
compilebegin ();
continue; // Start of BEGIN block
c_UPPER_I: /* 'I' */
abort ("Pascal?");
// %continue; ! {ESCAPE for Pascal etc.}
c_UPPER_J: /* 'J' */
userjump (readtag ());
continue; // Jump to user label
c_UPPER_K: /* 'K' */
return_ (false);
continue; // %false
c_UPPER_L: /* 'L' */
defineuserlabel (readtag ());
continue; // Define user label
c_UPPER_M: /* 'M' */
return_ (map);
continue; // MAP result
c_UPPER_N: /* 'N' */
pushconst (readinteger ());
continue; // Stack integer constant
c_UPPER_O: /* 'O' */
updateline (readtag ());
continue; // Set line number
c_UPPER_P: /* 'P' */
plant ();
continue; // Machine code literal
c_UPPER_Q: /* 'Q' */
operation (rdivx);
continue;
c_UPPER_R: /* 'R' */
return_ (routine);
continue; // RETURN
c_UPPER_S: /* 'S' */
assign (1);
continue; // Normal value assignment
c_UPPER_T: /* 'T' */
return_ (true);
continue; // %true
c_UPPER_U: /* 'U' */
operation (negx);
continue;
c_UPPER_V: /* 'V' */
return_ (fn);
continue; // FN result
c_UPPER_W: /* 'W' */
switchjump (readtag ());
continue; // Jump to switch
c_UPPER_X: /* 'X' */
operation (expx);
continue; // 'Y' - UNUSED
c_UPPER_Z: /* 'Z' */
assign (0);
continue; // Assign address '=='
c_OPEN_SQUARE_PARENTHESIS: /* '[' */
operation (lshx);
continue;
c_BACKSLASH: /* '\\' */
operation (notx);
continue;
c_CLOSE_SQUARE_PARENTHESIS: /* ']' */
operation (rshx);
continue;
c_CARET: /* '^' */
setrecordformat (readtag ());
continue; // {Set Format}
c_UNDERSCORE: /* '_' */
switchlabel (readtag ());
continue; // Define switch label
c_LOWER_a: /* 'a' */
arrayref (0);
continue;
c_LOWER_b: /* 'b' */
constantbounds ();
continue; // Define constant bounded Dope Vector
// 'c' NOT IMPLEMENTED
c_LOWER_d: /* 'd' */
{
int rt0, rt1;
rt0=readtagcomma ();
rt1=readtag ();
dimension (rt0, rt1);
}
continue; // dimensions, count of variables - NB in params: =0 -> simple array, # 0 -> array-in-record
c_LOWER_e: /* 'e' */
signalevent (readtag ());
continue; // %signal event
c_LOWER_f: /* 'f' */
compilefor (readtag ());
continue;
c_LOWER_g: /* 'g' */
{
int rt0, rt1;
rt0=readtagcomma ();
rt1=readtag ();
dimension (rt0, rt1);
}
continue; // (different to PSR) dimensions, count of variables - NB in params: =0 -> simple array, # 0 -> array-in-record
c_LOWER_h: /* 'h' */
// compiler op(n)
// compiler op(ReadTag)
continue;
c_LOWER_i: /* 'i' */
arrayref (1);
continue;
c_LOWER_j: /* 'j' */
assign (2);
continue; // JAM transfer
c_LOWER_k: /* 'k' */
jumpforward (readtag (), ff);
continue; // Branch on FALSE (= 0)
c_LOWER_l: /* 'l' */
/*languageflags =*/ (void)readtag ();
continue; // We currently only support standard IMP - who knows the future
c_LOWER_m: /* 'm' */
monitor ();
continue; // %monitor
c_LOWER_n: /* 'n' */
selectfield (readtag ());
continue; // Select member from record format
c_LOWER_o: /* 'o' */
{
int rt0, rt1;
rt0=readtagcomma ();
rt1=readtag ();
eventtrap (rt0, rt1);
}
continue; // %on %event block
c_LOWER_p: /* 'p' */
assign (-1);
continue; // Pass a parameter
c_LOWER_q: /* 'q' */
doubleop (subx);
continue; // --
c_LOWER_r: /* 'r' */
resolve (readtag ());
continue;
c_LOWER_s: /* 's' */
perm (stop, 0);
continue; // %stop
c_LOWER_t: /* 't' */
#ifdef I_THINK_THIS_IS_A_BUG
jumpforward (readtag (), jne);
#else
jumpforward (readtag (), tt);
#endif
continue; // Branch on TRUE (# 0)
c_LOWER_u: /* 'u' */
doubleop (addx);
continue; // ++
c_LOWER_v: /* 'v' */
operation (absx);
continue;
c_LOWER_w: /* 'w' */
machinecode (getascii_impstring (';'));
continue; // JDM: allowed call to Machine code
c_LOWER_x: /* 'x' */
operation (rexpx);
continue;
c_LOWER_y: /* 'y' */
{int d;
d = readtag();
//fprintf(stderr, "readtag() -> %08x\n", (unsigned int)d);
//fprintf(stderr, "diagnose before: %d\n", diagnose);
setcd (d, &diagnose); // auto int diagnose
//fprintf(stderr, "diagnose after: %d\n", diagnose);
}
//fprintf(stderr, " --> %%diagnose %8x\n", (unsigned int)diagnose);
//assert(sizeof(diagnose) == sizeof(int));
continue; // %diagnose n (what about pass3? how do we send to pass3)
c_LOWER_z: /* 'z' */
setcd (readtag (), &control);
continue; // %control n
c_OPEN_CURLY_BRACKET: /* '{' */
inparams = -1;
// this is either a record format, a procedure, or a proc spec;
// - block type was set by decvar to tell us which
assemble (blocktype, labs, names);
continue; // Start of formal parameters
c_CLOSE_CURLY_BRACKET: /* '}' */
inparams = 0;
if (finishparams ())
break;
continue; // End of formal parameters
c_TILDE: /* '~' */
if (alternateformat (readbyte ()))
break;
continue; // alternate record format
c_default: ; // imp2c: c(*):
abort ("Bad I Code - bad switch");
/*
When running on ARM:
#2 0x00013600 in abort (message=0x344e0 "Bad I Code") at pass2.c:613
613 exit (0/force_gdb);
*/
// %continue; ! To catch the sinners!! (that is - an unimplemented iCode)
}
if (amode >= 0) {
// end of declarative block
while (worklist(level) != 0) {
worklist(level) = retgptag (worklist(level));
}
level -= 1;
} else {
// end of record format defn
if (amode == (-(2))) {
// end of alternative only
if (maxframe > frame)
frame = maxframe;
// use the longest alternative
oldframe = frame;
} else {
frame = (frame + align) & ((~(align)));
// **** temporary ****
procvar->size = frame;
}
}
frame = oldframe;
} // assemble
// -------- it all starts here ---------
// JDM - Before we do any file I/O we need to set up the Imp streams
// from the command-line parameters.
// Currently a small difference from the Imp version - inputs and
// outputs are separated by ' ', not '='. Pending revision.
{
char *icode, *source, *object, *list;
if (argv[1] == NULL || !strchr(argv[1], ',')) {
exit(1);
}
if (on_event(9)) {
fprintf(stderr, "I/O error while setting up stream %d - %s\n", EVENT.extra, strerror(errno));
exit(0);
}
icode = strdup(argv[1]);
source = strchr(icode, ',');
*source++ = '\0';
openinput(1, icode); // icode from pass1
openinput(2, source); // source (used in disassembly listing)
strcpy(thesourcefilename, source);
if (argv[2] == NULL || !strchr(argv[2], ',')) {
exit(1);
}
object = strdup(argv[2]);
list = strchr(object, ',');
*list++ = '\0';
openoutput(0, "/dev/stderr"); // console report
openoutput(1, object); // object (ibj) file
openoutput(2, list); // listing (lst) file
}
if (on_event(9)) {
fprintf(stderr, "Read error while reading icode - empty or truncated file perhaps?\n");
exit(0);
}
// ********* START OF INITIALISATION *********
// Initialise some arrays that are not declared as static. Complete initialisation
// is required so that full memory checksums can be calculated for both the
// original Imp version of this program and this translation into C.
for (i = 1; i <= maxlevel; i += 1) worklist(i) = 0;
for (i = 1; i <= lstbufmax; i += 1) listbytes(i) = 0;
for (i = 1; i <= cotsize; i += 1) contable(i) = 0;
for (i = 0; i <= 255; i += 1) xsymbuff(i) = 0;
for (i = 0; i <= 255; i += 1) currentstring(i) = 0;
for (i = 0; i <= maxswitch; i += 1) swtab(i) = 0;
for (i = 0; i <= maxgp; i += 1) { gptags[i].info = 0; gptags[i].addr = 0; gptags[i].flags = 0; gptags[i].link = 0; }
for (i = 1; i <= maxstack; i++) {
// int j;
// for (j = 0; j <= 255; j++) idname[j] = 0;
// char *idname; - not a ptr in Imp version...
stack(i).idname[0] = '\0';
stack(i).type = 0;
stack(i).form = 0;
stack(i).aform = 0;
stack(i).base = 0;
stack(i).scope = 0;
stack(i).dim = 0;
stack(i).disp = 0;
stack(i).format = 0;
stack(i).size = 0;
stack(i).pbase = 0;
stack(i).extra = 0;
stack(i).extdisp = 0;
stack(i).varno = 0;
}
null.idname[0] = '\0'; // maybe...
null.type = 0;
null.form = 0;
null.aform = 0;
null.base = 0;
null.scope = 0;
null.dim = 0;
null.disp = 0;
null.format = 0;
null.size = 0;
null.pbase = 0;
null.extra = 0;
null.extdisp = 0;
null.varno = 0;
top = &null;
for (i = 1; i <= maxlabs; i++) {
labels(i).id = 0;
labels(i).tag = 0;
}
for (i = 0; i <= maxvars; i++) {
// ignore *idname for now
var(i).idname[0] = '\0';
var(i).type = 0;
var(i).form = 0;
var(i).level = 0;
var(i).scope = 0;
var(i).dim = 0;
var(i).disp = 0;
var(i).format = 0;
var(i).size = 0;
var(i).pbase = 0;
var(i).extra = 0;
var(i).extdisp = 0;
}
buffer[0] = 0; buffer[1] = 0;
// %byteintegerarray datat(0:datat limit)
for (i = 0; i <= datatlimit; i++) datat(i) = 0;
pending = 0;
for (i = displayhint_low; i <= displayhint_high; i++) displayhint(i) = 0;
// ********* END OF INITIALISATION *********
// JDM - ok, now we can really start
selectinput (icode);
selectoutput (objout);
memset(&var, 0, sizeof(var)); // var(0) = 0; // imp2c
// for %RECORD(*) . . . . .
parms = maxvars;
// Initialise the GP Tag ASL
for (i = 1; i <= maxgp; i += 1) {
gptags[i].link = i - 1;
}
gpasl = maxgp;
// Tell the linker our source file name
dumpsourcename (thesourcefilename);
// JDM - hopefully not so bogus now!
// predefine the perms for the linker. We ignore
// the number (j) because we know they are in sequence
for (i = 1; i <= lastperm; i += 1) {
/*j =*/ (void)externalref (permname(i));
}
readsymbol (pending);
// Prime SYM/NEXT pair
spec = 0;
decvar = &begin;
assemble (-3, 0, 0);
// We flush constants
flushcot ();
flushdata ();
flushswitch ();
checksum("at exit"); // we can afford to calculate *one* checksum even in production,
// to confirm that the Imp and C versions are both still in synch.
exit(0);
return 1;
// print a checksum of 'interesting' memory locations. Can be done at any location
// in the code. Each checksum is accompanied by a sequence number. As long as the
// program behaves consistently, you can re-run it with the same inputs, and turn
// on more detailed debugging just before the checksums diverge from the Imp77 version.
auto void checksum(char *which) { ENTER();
long test = 0x89AB0123, crc = 0UL;
static int sequence = 0;
int i;
//return;
sequence++;
crc = crc32mem(crc, &test, 4 /* sizeof(test) */); // before we start, check a known quantity and confirm CRC code is good.
crc = crc32mem(crc, &pending, 4 /* sizeof(Pending) */);
crc = crc32mem(crc, &stp, 4 /* sizeof(stp) */);
// can add more global scalars here. Be sure to keep pass2.imp in exact synch.
// Safer to explicitly crc struct members, due to compiler alignment padding.
// stackfm stack(maxstack + 1); // re-based at 0 for efficiency
//crc = crc32mem(crc, &stack(1), maxstack*sizeof(stackfm));
for (i = 1; i <= maxstack; i++) {
// char *idname;
crc = crc32mem(crc, &stack(i).type, sizeof(unsigned char));
crc = crc32mem(crc, &stack(i).form, sizeof(unsigned char));
crc = crc32mem(crc, &stack(i).aform, sizeof(unsigned char));
crc = crc32mem(crc, &stack(i).base, sizeof(unsigned char));
crc = crc32mem(crc, &stack(i).scope, sizeof(unsigned char));
crc = crc32mem(crc, &stack(i).dim, sizeof(unsigned char));
crc = crc32mem(crc, &stack(i).disp, sizeof(int));
crc = crc32mem(crc, &stack(i).format, sizeof(int));
crc = crc32mem(crc, &stack(i).size, sizeof(int));
crc = crc32mem(crc, &stack(i).pbase, sizeof(int));
crc = crc32mem(crc, &stack(i).extra, sizeof(int));
crc = crc32mem(crc, &stack(i).extdisp, sizeof(int));
crc = crc32mem(crc, &stack(i).varno, sizeof(int));
}
// typedef struct labelfm { int id, tag; } labelfm;
// labelfm labels(maxlabs + 1); // re-based at 0 for efficiency
for (i = 1; i <= maxlabs; i++) {
crc = crc32mem(crc, &labels(i).id, sizeof(int));
crc = crc32mem(crc, &labels(i).tag, sizeof(int));
}
// /* static */ int worklist(maxlevel + 1); // re-based at 0 for efficiency
for (i = 1; i <= maxlevel; i++) crc = crc32mem(crc, &worklist(i), sizeof(int));
// varfm var(maxvars + 1); // zero-based array
// removed: crc = crc32mem(crc, var, (maxvars+1)*sizeof(varfm));
for (i = 0; i <= maxvars; i++) {
// ignore *idname for now
crc = crc32mem(crc, &var(i).type, 1);
crc = crc32mem(crc, &var(i).form, 1);
crc = crc32mem(crc, &var(i).level, 1);
crc = crc32mem(crc, &var(i).scope, 1);
crc = crc32mem(crc, &var(i).dim, 1);
crc = crc32mem(crc, &var(i).disp, 4);
crc = crc32mem(crc, &var(i).format, 4);
crc = crc32mem(crc, &var(i).size, 4);
crc = crc32mem(crc, &var(i).pbase, 4);
crc = crc32mem(crc, &var(i).extra, 4);
crc = crc32mem(crc, &var(i).extdisp, 4);
}
// auto /* static */ int activity[ 16 /* fr7 */ + 1] = { 0, 0, 0, 0, 0, -1, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; // zero-based array
crc = crc32mem(crc, activity, (16+1)*sizeof(int));
// gptag gptags[maxgp + 1]; // zero-based array
// removed: crc = crc32mem(crc, &gptags[0], sizeof(gptag)*121);
for (i = 0; i <= maxgp; i++) crc = crc32mem(crc, &gptags[i], sizeof(gptag));
// int swtab(maxswitch + 1); // zero-based array
crc = crc32mem(crc, swtab, (maxswitch+1)*sizeof(int));
// unsigned char currentstring(255 + 1); // current string literal // zero-based array
crc = crc32mem(crc, currentstring, 256);
// unsigned char xsymbuff[255 - 0 + 1]; // current external string name // zero-based array
crc = crc32mem(crc, xsymbuff, 256);
// static unsigned char objectbytes( objbufmax + 1 ); // zero-based array // initialised to all 0
crc = crc32mem(crc, objectbytes, objbufmax+1);
// static unsigned char listbytes( lstbufmax + 1 ); // initialised to all 0 // zero-based array
crc = crc32mem(crc, listbytes, lstbufmax+1);
// unsigned char buffer[1 + 1]; // zero-based array
crc = crc32mem(crc, &buffer[0], 2);
// static unsigned char contable( 2000 /* cotsize */ - 0 + 1); // zero-based array // initialise to all 0
crc = crc32mem(crc, contable, 2001);
// unsigned char datat[datatlimit - 0 + 1]; // zero-based array
for (i = 0; i <= datatlimit; i++) crc = crc32mem(crc, &datat[i], 1);
if (strcmp(which, "at exit")==0) {
fprintf(stderr, "C executable post-execution checksum %0ld\n", crc);
} else {
fprintf(stderr, "%s %0ld\n", which, crc);
}
}
}