summaryrefslogtreecommitdiff
path: root/src/bin/embryo_cc_sc4.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/bin/embryo_cc_sc4.c')
-rw-r--r--src/bin/embryo_cc_sc4.c1308
1 files changed, 1308 insertions, 0 deletions
diff --git a/src/bin/embryo_cc_sc4.c b/src/bin/embryo_cc_sc4.c
new file mode 100644
index 0000000..258d714
--- /dev/null
+++ b/src/bin/embryo_cc_sc4.c
@@ -0,0 +1,1308 @@
+/* Small compiler - code generation (unoptimized "assembler" code)
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <ctype.h>
+#include <stdio.h>
+#include <limits.h> /* for PATH_MAX */
+#include <string.h>
+
+#include "embryo_cc_sc.h"
+
+/* When a subroutine returns to address 0, the AMX must halt. In earlier
+ * releases, the RET and RETN opcodes checked for the special case 0 address.
+ * Today, the compiler simply generates a HALT instruction at address 0. So
+ * a subroutine can savely return to 0, and then encounter a HALT.
+ */
+void
+writeleader(void)
+{
+ assert(code_idx == 0);
+ stgwrite(";program exit point\n");
+ stgwrite("\thalt 0\n");
+ /* calculate code length */
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* writetrailer
+ * Not much left of this once important function.
+ *
+ * Global references: sc_stksize (referred to only)
+ * sc_dataalign (referred to only)
+ * code_idx (altered)
+ * glb_declared (altered)
+ */
+void
+writetrailer(void)
+{
+ assert(sc_dataalign % opcodes(1) == 0); /* alignment must be a multiple of
+ * the opcode size */
+ assert(sc_dataalign != 0);
+
+ /* pad code to align data segment */
+ if ((code_idx % sc_dataalign) != 0)
+ {
+ begcseg();
+ while ((code_idx % sc_dataalign) != 0)
+ nooperation();
+ } /* if */
+
+ /* pad data segment to align the stack and the heap */
+ assert(litidx == 0); /* literal queue should have been emptied */
+ assert(sc_dataalign % sizeof(cell) == 0);
+ if (((glb_declared * sizeof(cell)) % sc_dataalign) != 0)
+ {
+ begdseg();
+ defstorage();
+ while (((glb_declared * sizeof(cell)) % sc_dataalign) != 0)
+ {
+ stgwrite("0 ");
+ glb_declared++;
+ } /* while */
+ } /* if */
+
+ stgwrite("\nSTKSIZE "); /* write stack size (align stack top) */
+ outval(sc_stksize - (sc_stksize % sc_dataalign), TRUE);
+}
+
+/*
+ * Start (or restart) the CODE segment.
+ *
+ * In fact, the code and data segment specifiers are purely informational;
+ * the "DUMP" instruction itself already specifies that the following values
+ * should go to the data segment. All otherinstructions go to the code
+ * segment.
+ *
+ * Global references: curseg
+ */
+void
+begcseg(void)
+{
+ if (curseg != sIN_CSEG)
+ {
+ stgwrite("\n");
+ stgwrite("CODE\t; ");
+ outval(code_idx, TRUE);
+ curseg = sIN_CSEG;
+ } /* endif */
+}
+
+/*
+ * Start (or restart) the DATA segment.
+ *
+ * Global references: curseg
+ */
+void
+begdseg(void)
+{
+ if (curseg != sIN_DSEG)
+ {
+ stgwrite("\n");
+ stgwrite("DATA\t; ");
+ outval(glb_declared - litidx, TRUE);
+ curseg = sIN_DSEG;
+ } /* if */
+}
+
+void
+setactivefile(int fnumber)
+{
+ stgwrite("curfile ");
+ outval(fnumber, TRUE);
+}
+
+cell
+nameincells(char *name)
+{
+ cell clen =
+ (strlen(name) + sizeof(cell)) & ~(sizeof(cell) - 1);
+ return clen;
+}
+
+void
+setfile(char *name, int fileno)
+{
+ if ((sc_debug & sSYMBOLIC) != 0)
+ {
+ begcseg();
+ stgwrite("file ");
+ outval(fileno, FALSE);
+ stgwrite(" ");
+ stgwrite(name);
+ stgwrite("\n");
+ /* calculate code length */
+ code_idx += opcodes(1) + opargs(2) + nameincells(name);
+ } /* if */
+}
+
+void
+setline(int line, int fileno)
+{
+ if ((sc_debug & (sSYMBOLIC | sCHKBOUNDS)) != 0)
+ {
+ stgwrite("line ");
+ outval(line, FALSE);
+ stgwrite(" ");
+ outval(fileno, FALSE);
+ stgwrite("\t; ");
+ outval(code_idx, TRUE);
+ code_idx += opcodes(1) + opargs(2);
+ } /* if */
+}
+
+/* setlabel
+ *
+ * Post a code label (specified as a number), on a new line.
+ */
+void
+setlabel(int number)
+{
+ assert(number >= 0);
+ stgwrite("l.");
+ stgwrite((char *)itoh(number));
+ /* To assist verification of the assembled code, put the address of the
+ * label as a comment. However, labels that occur inside an expression
+ * may move (through optimization or through re-ordering). So write the
+ * address only if it is known to accurate.
+ */
+ if (!staging)
+ {
+ stgwrite("\t\t; ");
+ outval(code_idx, FALSE);
+ } /* if */
+ stgwrite("\n");
+}
+
+/* Write a token that signifies the end of an expression, or the end of a
+ * function parameter. This allows several simple optimizations by the peephole
+ * optimizer.
+ */
+void
+endexpr(int fullexpr)
+{
+ if (fullexpr)
+ stgwrite("\t;$exp\n");
+ else
+ stgwrite("\t;$par\n");
+}
+
+/* startfunc - declare a CODE entry point (function start)
+ *
+ * Global references: funcstatus (referred to only)
+ */
+void
+startfunc(char *fname __UNUSED__)
+{
+ stgwrite("\tproc");
+ stgwrite("\n");
+ code_idx += opcodes(1);
+}
+
+/* endfunc
+ *
+ * Declare a CODE ending point (function end)
+ */
+void
+endfunc(void)
+{
+ stgwrite("\n"); /* skip a line */
+}
+
+/* alignframe
+ *
+ * Aligns the frame (and the stack) of the current function to a multiple
+ * of the specified byte count. Two caveats: the alignment ("numbytes") should
+ * be a power of 2, and this alignment must be done right after the frame
+ * is set up (before the first variable is declared)
+ */
+void
+alignframe(int numbytes)
+{
+#if !defined NDEBUG
+ /* "numbytes" should be a power of 2 for this code to work */
+ int i, count = 0;
+
+ for (i = 0; i < (int)(sizeof(numbytes) * 8); i++)
+ if (numbytes & (1 << i))
+ count++;
+ assert(count == 1);
+#endif
+
+ stgwrite("\tlctrl 4\n"); /* get STK in PRI */
+ stgwrite("\tconst.alt "); /* get ~(numbytes-1) in ALT */
+ outval(~(numbytes - 1), TRUE);
+ stgwrite("\tand\n"); /* PRI = STK "and" ~(numbytes-1) */
+ stgwrite("\tsctrl 4\n"); /* set the new value of STK ... */
+ stgwrite("\tsctrl 5\n"); /* ... and FRM */
+ code_idx += opcodes(5) + opargs(4);
+}
+
+/* Define a variable or function
+ */
+void
+defsymbol(char *name, int ident, int vclass, cell offset, int tag)
+{
+ if ((sc_debug & sSYMBOLIC) != 0)
+ {
+ begcseg(); /* symbol definition in code segment */
+ stgwrite("symbol ");
+
+ stgwrite(name);
+ stgwrite(" ");
+
+ outval(offset, FALSE);
+ stgwrite(" ");
+
+ outval(vclass, FALSE);
+ stgwrite(" ");
+
+ outval(ident, TRUE);
+
+ code_idx += opcodes(1) + opargs(3) + nameincells(name); /* class and ident encoded in "flags" */
+
+ /* also write the optional tag */
+ if (tag != 0)
+ {
+ assert((tag & TAGMASK) != 0);
+ stgwrite("symtag ");
+ outval(tag & TAGMASK, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+ } /* if */
+}
+
+void
+symbolrange(int level, cell size)
+{
+ if ((sc_debug & sSYMBOLIC) != 0)
+ {
+ begcseg(); /* symbol definition in code segment */
+ stgwrite("srange ");
+ outval(level, FALSE);
+ stgwrite(" ");
+ outval(size, TRUE);
+ code_idx += opcodes(1) + opargs(2);
+ } /* if */
+}
+
+/* rvalue
+ *
+ * Generate code to get the value of a symbol into "primary".
+ */
+void
+rvalue(value * lval)
+{
+ symbol *sym;
+
+ sym = lval->sym;
+ if (lval->ident == iARRAYCELL)
+ {
+ /* indirect fetch, address already in PRI */
+ stgwrite("\tload.i\n");
+ code_idx += opcodes(1);
+ }
+ else if (lval->ident == iARRAYCHAR)
+ {
+ /* indirect fetch of a character from a pack, address already in PRI */
+ stgwrite("\tlodb.i ");
+ outval(charbits / 8, TRUE); /* read one or two bytes */
+ code_idx += opcodes(1) + opargs(1);
+ }
+ else if (lval->ident == iREFERENCE)
+ {
+ /* indirect fetch, but address not yet in PRI */
+ assert(sym != NULL);
+ assert(sym->vclass == sLOCAL); /* global references don't exist in Small */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tlref.s.pri ");
+ else
+ stgwrite("\tlref.pri ");
+ outval(sym->addr, TRUE);
+ markusage(sym, uREAD);
+ code_idx += opcodes(1) + opargs(1);
+ }
+ else
+ {
+ /* direct or stack relative fetch */
+ assert(sym != NULL);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tload.s.pri ");
+ else
+ stgwrite("\tload.pri ");
+ outval(sym->addr, TRUE);
+ markusage(sym, uREAD);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * Get the address of a symbol into the primary register (used for arrays,
+ * and for passing arguments by reference).
+ */
+void
+address(symbol * sym)
+{
+ assert(sym != NULL);
+ /* the symbol can be a local array, a global array, or an array
+ * that is passed by reference.
+ */
+ if (sym->ident == iREFARRAY || sym->ident == iREFERENCE)
+ {
+ /* reference to a variable or to an array; currently this is
+ * always a local variable */
+ stgwrite("\tload.s.pri ");
+ }
+ else
+ {
+ /* a local array or local variable */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\taddr.pri ");
+ else
+ stgwrite("\tconst.pri ");
+ } /* if */
+ outval(sym->addr, TRUE);
+ markusage(sym, uREAD);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* store
+ *
+ * Saves the contents of "primary" into a memory cell, either directly
+ * or indirectly (at the address given in the alternate register).
+ */
+void
+store(value * lval)
+{
+ symbol *sym;
+
+ sym = lval->sym;
+ if (lval->ident == iARRAYCELL)
+ {
+ /* store at address in ALT */
+ stgwrite("\tstor.i\n");
+ code_idx += opcodes(1);
+ }
+ else if (lval->ident == iARRAYCHAR)
+ {
+ /* store at address in ALT */
+ stgwrite("\tstrb.i ");
+ outval(charbits / 8, TRUE); /* write one or two bytes */
+ code_idx += opcodes(1) + opargs(1);
+ }
+ else if (lval->ident == iREFERENCE)
+ {
+ assert(sym != NULL);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tsref.s.pri ");
+ else
+ stgwrite("\tsref.pri ");
+ outval(sym->addr, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ }
+ else
+ {
+ assert(sym != NULL);
+ markusage(sym, uWRITTEN);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tstor.s.pri ");
+ else
+ stgwrite("\tstor.pri ");
+ outval(sym->addr, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* source must in PRI, destination address in ALT. The "size"
+ * parameter is in bytes, not cells.
+ */
+void
+memcopy(cell size)
+{
+ stgwrite("\tmovs ");
+ outval(size, TRUE);
+
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* Address of the source must already have been loaded in PRI
+ * "size" is the size in bytes (not cells).
+ */
+void
+copyarray(symbol * sym, cell size)
+{
+ assert(sym != NULL);
+ /* the symbol can be a local array, a global array, or an array
+ * that is passed by reference.
+ */
+ if (sym->ident == iREFARRAY)
+ {
+ /* reference to an array; currently this is always a local variable */
+ assert(sym->vclass == sLOCAL); /* symbol must be stack relative */
+ stgwrite("\tload.s.alt ");
+ }
+ else
+ {
+ /* a local or global array */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\taddr.alt ");
+ else
+ stgwrite("\tconst.alt ");
+ } /* if */
+ outval(sym->addr, TRUE);
+ markusage(sym, uWRITTEN);
+
+ code_idx += opcodes(1) + opargs(1);
+ memcopy(size);
+}
+
+void
+fillarray(symbol * sym, cell size, cell val)
+{
+ const1(val); /* load val in PRI */
+
+ assert(sym != NULL);
+ /* the symbol can be a local array, a global array, or an array
+ * that is passed by reference.
+ */
+ if (sym->ident == iREFARRAY)
+ {
+ /* reference to an array; currently this is always a local variable */
+ assert(sym->vclass == sLOCAL); /* symbol must be stack relative */
+ stgwrite("\tload.s.alt ");
+ }
+ else
+ {
+ /* a local or global array */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\taddr.alt ");
+ else
+ stgwrite("\tconst.alt ");
+ } /* if */
+ outval(sym->addr, TRUE);
+ markusage(sym, uWRITTEN);
+
+ stgwrite("\tfill ");
+ outval(size, TRUE);
+
+ code_idx += opcodes(2) + opargs(2);
+}
+
+/*
+ * Instruction to get an immediate value into the primary register
+ */
+void
+const1(cell val)
+{
+ if (val == 0)
+ {
+ stgwrite("\tzero.pri\n");
+ code_idx += opcodes(1);
+ }
+ else
+ {
+ stgwrite("\tconst.pri ");
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * Instruction to get an immediate value into the secondary register
+ */
+void
+const2(cell val)
+{
+ if (val == 0)
+ {
+ stgwrite("\tzero.alt\n");
+ code_idx += opcodes(1);
+ }
+ else
+ {
+ stgwrite("\tconst.alt ");
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* Copy value in secondary register to the primary register */
+void
+moveto1(void)
+{
+ stgwrite("\tmove.pri\n");
+ code_idx += opcodes(1) + opargs(0);
+}
+
+/*
+ * Push primary register onto the stack
+ */
+void
+push1(void)
+{
+ stgwrite("\tpush.pri\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * Push alternate register onto the stack
+ */
+void
+push2(void)
+{
+ stgwrite("\tpush.alt\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * Push a constant value onto the stack
+ */
+void
+pushval(cell val)
+{
+ stgwrite("\tpush.c ");
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * pop stack to the primary register
+ */
+void
+pop1(void)
+{
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * pop stack to the secondary register
+ */
+void
+pop2(void)
+{
+ stgwrite("\tpop.alt\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * swap the top-of-stack with the value in primary register
+ */
+void
+swap1(void)
+{
+ stgwrite("\tswap.pri\n");
+ code_idx += opcodes(1);
+}
+
+/* Switch statements
+ * The "switch" statement generates a "case" table using the "CASE" opcode.
+ * The case table contains a list of records, each record holds a comparison
+ * value and a label to branch to on a match. The very first record is an
+ * exception: it holds the size of the table (excluding the first record) and
+ * the label to branch to when none of the values in the case table match.
+ * The case table is sorted on the comparison value. This allows more advanced
+ * abstract machines to sift the case table with a binary search.
+ */
+void
+ffswitch(int label)
+{
+ stgwrite("\tswitch ");
+ outval(label, TRUE); /* the label is the address of the case table */
+ code_idx += opcodes(1) + opargs(1);
+}
+
+void
+ffcase(cell val, char *labelname, int newtable)
+{
+ if (newtable)
+ {
+ stgwrite("\tcasetbl\n");
+ code_idx += opcodes(1);
+ } /* if */
+ stgwrite("\tcase ");
+ outval(val, FALSE);
+ stgwrite(" ");
+ stgwrite(labelname);
+ stgwrite("\n");
+ code_idx += opcodes(0) + opargs(2);
+}
+
+/*
+ * Call specified function
+ */
+void
+ffcall(symbol * sym, int numargs)
+{
+ assert(sym != NULL);
+ assert(sym->ident == iFUNCTN);
+ if ((sym->usage & uNATIVE) != 0)
+ {
+ /* reserve a SYSREQ id if called for the first time */
+ if (sc_status == statWRITE && (sym->usage & uREAD) == 0
+ && sym->addr >= 0)
+ sym->addr = ntv_funcid++;
+ stgwrite("\tsysreq.c ");
+ outval(sym->addr, FALSE);
+ stgwrite("\n\tstack ");
+ outval((numargs + 1) * sizeof(cell), TRUE);
+ code_idx += opcodes(2) + opargs(2);
+ }
+ else
+ {
+ /* normal function */
+ stgwrite("\tcall ");
+ stgwrite(sym->name);
+ stgwrite("\n");
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* Return from function
+ *
+ * Global references: funcstatus (referred to only)
+ */
+void
+ffret(void)
+{
+ stgwrite("\tretn\n");
+ code_idx += opcodes(1);
+}
+
+void
+ffabort(int reason)
+{
+ stgwrite("\thalt ");
+ outval(reason, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+void
+ffbounds(cell size)
+{
+ if ((sc_debug & sCHKBOUNDS) != 0)
+ {
+ stgwrite("\tbounds ");
+ outval(size, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * Jump to local label number (the number is converted to a name)
+ */
+void
+jumplabel(int number)
+{
+ stgwrite("\tjump ");
+ outval(number, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Define storage (global and static variables)
+ */
+void
+defstorage(void)
+{
+ stgwrite("dump ");
+}
+
+/*
+ * Inclrement/decrement stack pointer. Note that this routine does
+ * nothing if the delta is zero.
+ */
+void
+modstk(int delta)
+{
+ if (delta)
+ {
+ stgwrite("\tstack ");
+ outval(delta, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* set the stack to a hard offset from the frame */
+void
+setstk(cell val)
+{
+ stgwrite("\tlctrl 5\n"); /* get FRM */
+ assert(val <= 0); /* STK should always become <= FRM */
+ if (val < 0)
+ {
+ stgwrite("\tadd.c ");
+ outval(val, TRUE); /* add (negative) offset */
+ code_idx += opcodes(1) + opargs(1);
+ // ??? write zeros in the space between STK and the val in PRI (the new stk)
+ // get val of STK in ALT
+ // zero PRI
+ // need new FILL opcode that takes a variable size
+ } /* if */
+ stgwrite("\tsctrl 4\n"); /* store in STK */
+ code_idx += opcodes(2) + opargs(2);
+}
+
+void
+modheap(int delta)
+{
+ if (delta)
+ {
+ stgwrite("\theap ");
+ outval(delta, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+void
+setheap_pri(void)
+{
+ stgwrite("\theap "); /* ALT = HEA++ */
+ outval(sizeof(cell), TRUE);
+ stgwrite("\tstor.i\n"); /* store PRI (default value) at address ALT */
+ stgwrite("\tmove.pri\n"); /* move ALT to PRI: PRI contains the address */
+ code_idx += opcodes(3) + opargs(1);
+}
+
+void
+setheap(cell val)
+{
+ stgwrite("\tconst.pri "); /* load default val in PRI */
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ setheap_pri();
+}
+
+/*
+ * Convert a cell number to a "byte" address; i.e. double or quadruple
+ * the primary register.
+ */
+void
+cell2addr(void)
+{
+#if defined(BIT16)
+ stgwrite("\tshl.c.pri 1\n");
+#else
+ stgwrite("\tshl.c.pri 2\n");
+#endif
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Double or quadruple the alternate register.
+ */
+void
+cell2addr_alt(void)
+{
+#if defined(BIT16)
+ stgwrite("\tshl.c.alt 1\n");
+#else
+ stgwrite("\tshl.c.alt 2\n");
+#endif
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Convert "distance of addresses" to "number of cells" in between.
+ * Or convert a number of packed characters to the number of cells (with
+ * truncation).
+ */
+void
+addr2cell(void)
+{
+#if defined(BIT16)
+ stgwrite("\tshr.c.pri 1\n");
+#else
+ stgwrite("\tshr.c.pri 2\n");
+#endif
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* Convert from character index to byte address. This routine does
+ * nothing if a character has the size of a byte.
+ */
+void
+char2addr(void)
+{
+ if (charbits == 16)
+ {
+ stgwrite("\tshl.c.pri 1\n");
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* Align PRI (which should hold a character index) to an address.
+ * The first character in a "pack" occupies the highest bits of
+ * the cell. This is at the lower memory address on Big Endian
+ * computers and on the higher address on Little Endian computers.
+ * The ALIGN.pri/alt instructions must solve this machine dependence;
+ * that is, on Big Endian computers, ALIGN.pri/alt shuold do nothing
+ * and on Little Endian computers they should toggle the address.
+ */
+void
+charalign(void)
+{
+ stgwrite("\talign.pri ");
+ outval(charbits / 8, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Add a constant to the primary register.
+ */
+void
+addconst(cell val)
+{
+ if (val != 0)
+ {
+ stgwrite("\tadd.c ");
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * signed multiply of primary and secundairy registers (result in primary)
+ */
+void
+os_mult(void)
+{
+ stgwrite("\tsmul\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * signed divide of alternate register by primary register (quotient in
+ * primary; remainder in alternate)
+ */
+void
+os_div(void)
+{
+ stgwrite("\tsdiv.alt\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * modulus of (alternate % primary), result in primary (signed)
+ */
+void
+os_mod(void)
+{
+ stgwrite("\tsdiv.alt\n");
+ stgwrite("\tmove.pri\n"); /* move ALT to PRI */
+ code_idx += opcodes(2);
+}
+
+/*
+ * Add primary and alternate registers (result in primary).
+ */
+void
+ob_add(void)
+{
+ stgwrite("\tadd\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * subtract primary register from alternate register (result in primary)
+ */
+void
+ob_sub(void)
+{
+ stgwrite("\tsub.alt\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * arithmic shift left alternate register the number of bits
+ * given in the primary register (result in primary).
+ * There is no need for a "logical shift left" routine, since
+ * logical shift left is identical to arithmic shift left.
+ */
+void
+ob_sal(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tshl\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * arithmic shift right alternate register the number of bits
+ * given in the primary register (result in primary).
+ */
+void
+os_sar(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsshr\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * logical (unsigned) shift right of the alternate register by the
+ * number of bits given in the primary register (result in primary).
+ */
+void
+ou_sar(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tshr\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * inclusive "or" of primary and secondary registers (result in primary)
+ */
+void
+ob_or(void)
+{
+ stgwrite("\tor\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * "exclusive or" of primary and alternate registers (result in primary)
+ */
+void
+ob_xor(void)
+{
+ stgwrite("\txor\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * "and" of primary and secundairy registers (result in primary)
+ */
+void
+ob_and(void)
+{
+ stgwrite("\tand\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * test ALT==PRI; result in primary register (1 or 0).
+ */
+void
+ob_eq(void)
+{
+ stgwrite("\teq\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * test ALT!=PRI
+ */
+void
+ob_ne(void)
+{
+ stgwrite("\tneq\n");
+ code_idx += opcodes(1);
+}
+
+/* The abstract machine defines the relational instructions so that PRI is
+ * on the left side and ALT on the right side of the operator. For example,
+ * SLESS sets PRI to either 1 or 0 depending on whether the expression
+ * "PRI < ALT" is true.
+ *
+ * The compiler generates comparisons with ALT on the left side of the
+ * relational operator and PRI on the right side. The XCHG instruction
+ * prefixing the relational operators resets this. We leave it to the
+ * peephole optimizer to choose more compact instructions where possible.
+ */
+
+/* Relational operator prefix for chained relational expressions. The
+ * "suffix" code restores the stack.
+ * For chained relational operators, the goal is to keep the comparison
+ * result "so far" in PRI and the value of the most recent operand in
+ * ALT, ready for a next comparison.
+ * The "prefix" instruction pushed the comparison result (PRI) onto the
+ * stack and moves the value of ALT into PRI. If there is a next comparison,
+ * PRI can now serve as the "left" operand of the relational operator.
+ */
+void
+relop_prefix(void)
+{
+ stgwrite("\tpush.pri\n");
+ stgwrite("\tmove.pri\n");
+ code_idx += opcodes(2);
+}
+
+void
+relop_suffix(void)
+{
+ stgwrite("\tswap.alt\n");
+ stgwrite("\tand\n");
+ stgwrite("\tpop.alt\n");
+ code_idx += opcodes(3);
+}
+
+/*
+ * test ALT<PRI (signed)
+ */
+void
+os_lt(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsless\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * test ALT<=PRI (signed)
+ */
+void
+os_le(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsleq\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * test ALT>PRI (signed)
+ */
+void
+os_gt(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsgrtr\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * test ALT>=PRI (signed)
+ */
+void
+os_ge(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsgeq\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * logical negation of primary register
+ */
+void
+lneg(void)
+{
+ stgwrite("\tnot\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * two's complement primary register
+ */
+void
+neg(void)
+{
+ stgwrite("\tneg\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * one's complement of primary register
+ */
+void
+invert(void)
+{
+ stgwrite("\tinvert\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * nop
+ */
+void
+nooperation(void)
+{
+ stgwrite("\tnop\n");
+ code_idx += opcodes(1);
+}
+
+/* increment symbol
+ */
+void
+inc(value * lval)
+{
+ symbol *sym;
+
+ sym = lval->sym;
+ if (lval->ident == iARRAYCELL)
+ {
+ /* indirect increment, address already in PRI */
+ stgwrite("\tinc.i\n");
+ code_idx += opcodes(1);
+ }
+ else if (lval->ident == iARRAYCHAR)
+ {
+ /* indirect increment of single character, address already in PRI */
+ stgwrite("\tpush.pri\n");
+ stgwrite("\tpush.alt\n");
+ stgwrite("\tmove.alt\n"); /* copy address */
+ stgwrite("\tlodb.i "); /* read from PRI into PRI */
+ outval(charbits / 8, TRUE); /* read one or two bytes */
+ stgwrite("\tinc.pri\n");
+ stgwrite("\tstrb.i "); /* write PRI to ALT */
+ outval(charbits / 8, TRUE); /* write one or two bytes */
+ stgwrite("\tpop.alt\n");
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(8) + opargs(2);
+ }
+ else if (lval->ident == iREFERENCE)
+ {
+ assert(sym != NULL);
+ stgwrite("\tpush.pri\n");
+ /* load dereferenced value */
+ assert(sym->vclass == sLOCAL); /* global references don't exist in Small */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tlref.s.pri ");
+ else
+ stgwrite("\tlref.pri ");
+ outval(sym->addr, TRUE);
+ /* increment */
+ stgwrite("\tinc.pri\n");
+ /* store dereferenced value */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tsref.s.pri ");
+ else
+ stgwrite("\tsref.pri ");
+ outval(sym->addr, TRUE);
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(5) + opargs(2);
+ }
+ else
+ {
+ /* local or global variable */
+ assert(sym != NULL);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tinc.s ");
+ else
+ stgwrite("\tinc ");
+ outval(sym->addr, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* decrement symbol
+ *
+ * in case of an integer pointer, the symbol must be incremented by 2.
+ */
+void
+dec(value * lval)
+{
+ symbol *sym;
+
+ sym = lval->sym;
+ if (lval->ident == iARRAYCELL)
+ {
+ /* indirect decrement, address already in PRI */
+ stgwrite("\tdec.i\n");
+ code_idx += opcodes(1);
+ }
+ else if (lval->ident == iARRAYCHAR)
+ {
+ /* indirect decrement of single character, address already in PRI */
+ stgwrite("\tpush.pri\n");
+ stgwrite("\tpush.alt\n");
+ stgwrite("\tmove.alt\n"); /* copy address */
+ stgwrite("\tlodb.i "); /* read from PRI into PRI */
+ outval(charbits / 8, TRUE); /* read one or two bytes */
+ stgwrite("\tdec.pri\n");
+ stgwrite("\tstrb.i "); /* write PRI to ALT */
+ outval(charbits / 8, TRUE); /* write one or two bytes */
+ stgwrite("\tpop.alt\n");
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(8) + opargs(2);
+ }
+ else if (lval->ident == iREFERENCE)
+ {
+ assert(sym != NULL);
+ stgwrite("\tpush.pri\n");
+ /* load dereferenced value */
+ assert(sym->vclass == sLOCAL); /* global references don't exist in Small */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tlref.s.pri ");
+ else
+ stgwrite("\tlref.pri ");
+ outval(sym->addr, TRUE);
+ /* decrement */
+ stgwrite("\tdec.pri\n");
+ /* store dereferenced value */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tsref.s.pri ");
+ else
+ stgwrite("\tsref.pri ");
+ outval(sym->addr, TRUE);
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(5) + opargs(2);
+ }
+ else
+ {
+ /* local or global variable */
+ assert(sym != NULL);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tdec.s ");
+ else
+ stgwrite("\tdec ");
+ outval(sym->addr, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * Jumps to "label" if PRI != 0
+ */
+void
+jmp_ne0(int number)
+{
+ stgwrite("\tjnz ");
+ outval(number, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Jumps to "label" if PRI == 0
+ */
+void
+jmp_eq0(int number)
+{
+ stgwrite("\tjzer ");
+ outval(number, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* write a value in hexadecimal; optionally adds a newline */
+void
+outval(cell val, int newline)
+{
+ stgwrite(itoh(val));
+ if (newline)
+ stgwrite("\n");
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-24 02:30:51 +0000