/************************************************************************ * File: machine.c * * Author: Karl Abrahamson * * Written: Februray 2002 * * Description: * * This implements the abstract machine described in the accompanying * * file machine.html. * * Tab stops: Every 8 characters * ************************************************************************/ /************************************************************************* * Copyright 2002 Karl Abrahamson. All rights reserved. * * * * This software is provided by the author "as is" and any * * express or implied warranties, including, but not limited to, the * * implied warranties of merchantability and fitness for a particular * * purpose are disclaimed. In no event shall the author be liable * * for any direct, indirect, incidental, special, exemplary, or * * consequential damages (including, but not limited to, procurement * * of substitute goods or services; loss of use, data, or profits; or * * business interruption) however caused and on any theory of liability, * * whether in contract, strict liability, or tort (including negligence * * or otherwise) arising in any way out of the use of this software, * * even if advised of the possibility of such damage. * *************************************************************************/ /************************************************* * Define DEBUG to get tracing code compiled in. * *************************************************/ #define DEBUG #include #include #include #include #include #include "machinedefs.h" #include "machinetypes.h" #define USE_INSTRUCTION_CLASS #ifdef DEBUG # define USE_INSTRUCTION_NAME # define USE_INSTRUCTION_TRACE_KIND #endif #include "instinfo.c" #ifndef PATHMAX # define PATHMAX 1024 #endif /****************************************************************** * M_MAPCELL * ****************************************************************** * Each cell in the code array map holds a name of a function and * * an index where that function's code starts in the code array. * ******************************************************************/ typedef struct { CSTRING function_name; long index; } M_MAPCELL; /***************************************************************** * FRAME BOOKKEEPING * ***************************************************************** * The following tell where parts of the current stack frame are * * relative to the frame pointer. * * * * LOCAL_OFFSET The start of the local variables. * * * * NUM_PARAMS_OFFSET The location of the number of parameter * * words. * * * * DYNAMIC_LINK_OFFSET The location of the dynamic link. * * * * RETURN_ADDRESS_OFFSET The location of the return address. * ******************************************************************/ #define RETURN_ADDRESS_OFFSET 0 #define NUM_PARAMS_OFFSET M_SIZE_LONG #define DYNAMIC_LINK_OFFSET (2*M_SIZE_LONG) #define LOCAL_OFFSET (3*M_SIZE_LONG) /****************************************************************** * LABEL_BACKPATCH_RECORD * * FUNCTION_BACKPATCH_RECORD * * ARRAY_BACKPATCH_RECORD * ****************************************************************** * These are used to store requests for backpatching information * * that is not yet available. * ******************************************************************/ typedef struct { int lbl; /* The label number whose location needs to be stored. */ long index; /* The index where it needs to be put. */ } LABEL_BACKPATCH_RECORD; typedef struct { CSTRING name; /* The name of a function. */ long index; /* The index where the location of this function needs to be stored. */ } FUNCTION_BACKPATCH_RECORD; typedef struct { int instr; /* Instruction that created the array. */ int size_index; /* Index of the constant that indicates the size */ /* of this array. */ int where; /* Offset in the global table where this array */ /* should be placed. */ } ARRAY_BACKPATCH_RECORD; /************************************************************************ * COMPILED-IN LIMITS * ************************************************************************ * Limits that are marked with a * are limited by the form of the * * byte code, and cannot be increased arbitrarily. * * * * Limits that are marked with a + are limited by the form of the * * internal representation of the byte code. * *----------------------------------------------------------------------* * *MAX_GLOBAL_WORDS is the maximum number of words used in the * * table of global variables. * * * * *MAX_GLOBAL_ARRAYS is the maximum number of global arrays allowed. * * * * *MAX_INT_CONSTANTS is the maximun number of integer constants * * that can be stored in the integer constant * * table. * * * * *MAX_REAL_CONSTANTS is the maximum number of real constants that * * can be stored in the real constant table. * * * * *MAX_LABELS is the maximum number of labels that one * * function can have. * * * * MAX_STACK is the number of words in the stack. It limits * * the call depth and number of local variables * * and temporaries. * * * * +MAX_CODE is the maximum number of bytes in the array * * that holds the byte codes of the program that * * is being interpreted. * * * * MAX_ARRAY_SIZE is the maximum number of items allowed in one * * array. * * * * MAX_FUNCTIONS is the maximum number of different functions * * that a program can have. * * * * MAX_CONSTANT_SIZE is the largest number of bytes that can be used * * in an integer or real constant. * * * * MAX_NAME_SIZE is the largest number of characters that * * a function name can have. * * * * MAX_LABEL_BACKPATCHES is the largest number of label backpatches * * that can be done in one function definition. * ************************************************************************/ #define MAX_GLOBAL_WORDS 256 #define MAX_GLOBAL_ARRAYS 256 #define MAX_INT_CONSTANTS 256 #define MAX_REAL_CONSTANTS 256 #define MAX_LABELS 256 #define MAX_STACK 100000 #define MAX_CODE 20000 #define MAX_ARRAY_SIZE 100000 #define MAX_FUNCTIONS 200 #define MAX_CONSTANT_SIZE 25 #define MAX_NAME_SIZE 64 #define MAX_LABEL_BACKPATCHES 256 /************************************************************************ * MACHINE DATA STRUCTURES * ************************************************************************ * These are global tables that hold constants and global variables. * * The run-time stack is also here, as is the array that holds the * * code. * * * * global_table holds the values of global variables. It * * is an array of words. Each variable is * * stored in some number of consecutive words. * * * * int_constant_table holds the values of integer constants. * * * * real_constant_table holds the values of real constants. * * * * machine_stack is the stack of the machine. * * * * code_array is the array where the byte codes are stored. * * * * code_array_map tells where each function starts in the code * * array. Each member contains a string that is * * the name of a function and an integer index * * where that function starts. * * * * array_backpatches holds information needed for creating global * * arrays. The arrays are created late to allow * * contant definitions to come after the array * * definitions. * * * * function_backpatches indicates addresses that need to be patched * * with the indexes where functions are stored. * * It is used to allow a function be used before * * it is defined. * ************************************************************************/ M_WORD global_table [MAX_GLOBAL_WORDS]; M_INT int_constant_table [MAX_INT_CONSTANTS]; M_REAL real_constant_table [MAX_REAL_CONSTANTS]; M_WORD machine_stack_data [MAX_STACK + LOCAL_OFFSET]; M_WORD* machine_stack = machine_stack_data + LOCAL_OFFSET; M_BYTE code_array [MAX_CODE]; M_MAPCELL code_array_map [MAX_FUNCTIONS]; FUNCTION_BACKPATCH_RECORD function_backpatches[MAX_FUNCTIONS]; ARRAY_BACKPATCH_RECORD array_backpatches[MAX_GLOBAL_ARRAYS]; /************************************************************************ * MACHINE CONFIGURATION VARIABLES * ************************************************************************ * These variables control the stack and other data structures. * * * * frame_pointer is the index of the return address in the stack * * frame of the currently running function. * * * * stack_pointer is the index of the first empty word in the * * stack. * * * * byte_code_pointer is the index in code_array of the first empty * * byte. * * * * map_pointer is the index of the first unoccupied member * * of code_array_map. * * * * int_constant_pointer is the index of the first unoccupied integer * * constant. * * * * real_constant_pointer is the indes of the first unoccupied real * * constant. * * * * global_word_pointer is the index in global_table of the next * * unoccupied word. * * * * function_backpatch_pointer is the index of the next unoccupied * * cell in function_backpatches. * * * * array_backpatch_pointer is the index of the next unoccupied * * cell in array_backpatches. * * * * start_function_name is the name of the function to start with. * * * * return_status is the status to return from main. * * * * trace is 1 to turn on instruction tracing and 2 for * * full tracing. * * * * last_index_result_type is 0 if the last M_INDEX instruction pushed * * an integer onto the stack, and 1 if it * * pushed a real number onto the stack. * ************************************************************************/ long frame_pointer = -LOCAL_OFFSET; long stack_pointer = 0; long byte_code_pointer = 0; long map_pointer = 0; long int_constant_pointer = 0; long real_constant_pointer = 0; long global_word_pointer = 0; long function_backpatch_pointer = 0; long array_backpatch_pointer = 0; CSTRING start_function_name = NULL; M_BOOL input_fail_flag = FALSE; M_BOOL eof_flag = FALSE; int return_status = 0; #ifdef DEBUG int trace = 0; int last_index_result_type = 0; #endif /************************************************************************ * ERROR MESSAGES * ************************************************************************/ #define COMPLAIN_CANNOT_READ_FILE 0 #define COMPLAIN_DUPLICATE_LABEL 1 #define COMPLAIN_UNKNOWN_LABEL 2 #define COMPLAIN_UNKNOWN_INSTRUCTION 3 #define COMPLAIN_UNKNOWN_FUNCTION 4 #define COMPLAIN_UNKNOWN_SECTION 5 #define COMPLAIN_UNKNOWN_GLOBAL 6 #define COMPLAIN_TOO_MANY_INTEGERS 7 #define COMPLAIN_TOO_MANY_REALS 8 #define COMPLAIN_TOO_MANY_GLOBALS 9 #define COMPLAIN_TOO_MANY_FUNCTIONS 10 #define COMPLAIN_PROGRAM_TOO_LARGE 11 #define COMPLAIN_FILE_NAME_TOO_LONG 12 #define COMPLAIN_NO_START_FUNCTION 13 #define COMPLAIN_EOF 14 #define COMPLAIN_NO_ARRAY_SIZE 15 #define COMPLAIN_STACK_UNDERFLOW 16 #define COMPLAIN_STACK_OVERFLOW 17 #define COMPLAIN_SUBSCRIPT_ERROR 18 #define COMPLAIN_DIVIDE_BY_ZERO 19 #define COMPLAIN_BAD_LOCAL 20 #define COMPLAIN_BAD_PARAM 21 #define COMPLAIN_BAD_INT_CONSTANT 22 #define COMPLAIN_BAD_REAL_CONSTANT 23 #define COMPLAIN_BAD_PROGRAM_COUNTER 24 #define COMPLAIN_TOO_MANY_GLOBAL_ARRAYS 25 CSTRING complaint[] = { /* COMPLAIN_CANNOT_READ_FILE */ "I cannot read file \"%s\"", /* COMPLAIN_DUPLICATE_LABEL */ "Duplicate label %d", /* COMPLAIN_UNKNOWN_LABEL */ "Unknown label %ld", /* COMPLAIN_UNKNOWN_INSTRUCTION */ "Unknown instruction %d", /* COMPLAIN_UNKNOWN_FUNCTION */ "Unknown function \"%s\"", /* COMPLAIN_UNKNOWN_SECTION */ "Unknown section code %d", /* COMPLAIN_UNKNOWN_GLOBAL */ "Unknown global %d", /* COMPLAIN_TOO_MANY_INTEGERS */ "Too many integer constants", /* COMPLAIN_TOO_MANY_REALS */ "Too many real constants", /* COMPLAIN_TOO_MANY_GLOBALS */ "Too many global variables", /* COMPLAIN_TOO_MANY_FUNCTIONS */ "Too many functions", /* COMPLAIN_PROGRAM_TOO_LARGE */ "Program too large", /* COMPLAIN_FILE_NAME_TOO_LONG */ "File name too long", /* COMPLAIN_NO_START_FUNCTION */ "No start function", /* COMPLAIN_EOF */ "Unexpected end of file", /* COMPLAIN_NO_ARRAY_SIZE */ "Array size %d undefined", /* COMPLAIN_STACK_UNDERFLOW */ "Stack underflow", /* COMPLAIN_STACK_OVERFLOW */ "Stack overflow", /* COMPLAIN_SUBSCRIPT_ERROR */ "Subscript out of bounds", /* COMPLAIN_DIVIDE_BY_ZERO */ "Division by 0", /* COMPLAIN_BAD_LOCAL */ "Bad local index %d", /* COMPLAIN_BAD_PARAM */ "Bad parameter index %d", /* COMPLAIN_BAD_INT_CONSTANT */ "Bad integer constant %d", /* COMPLAIN_BAD_REAL_CONSTANT */ "Bad real constant %d", /* COMPLAIN_BAD_PROGRAM_COUNTER*/ "Program counter out of range", /* COMPLAIN_TOO_MANY_GLOBAL_ARRAYS */ "Too many global arrays" }; M_BOOL m_complain(int w, ...) { va_list args; va_start(args, w); vprintf(complaint[w], args); printf("\n"); return_status = 1; va_end(args); return FALSE; } void m_abort(void) { exit(1); } /************************************************************************ * LABELS IN THE CODE ARRAY * ************************************************************************ * Labels are stored using INTERNAL_LABEL_SIZE bytes in the code array. * * That allows the entire code array to be indexed by a goto or call * * instruction. * ************************************************************************/ #define INTERNAL_LABEL_SIZE 2 /************************************************************************ * GET_LABEL * ************************************************************************ * get_label(I) returns the label stored at index I in the code array. * * It presumes that I is an acceptable index in the code array, but * * checks that the returned index is reasonable. * ************************************************************************/ long get_label(long i) { long r = (((long) code_array[i]) << M_BYTE_BITS) | ((long) code_array[i+1]); if(r < byte_code_pointer) return r; else { m_complain(COMPLAIN_UNKNOWN_LABEL, r); m_abort(); return 0; } } /************************************************************************ * STORE_LABEL * ************************************************************************ * Store label LBL at index I in the byte code array. * ************************************************************************/ void store_label(long i, long lbl) { code_array[i] = (M_BYTE) ((lbl >> M_BYTE_BITS) & M_BYTE_MASK); code_array[i+1] = (M_BYTE) (lbl & M_BYTE_MASK); } /************************************************************************ * GETTING AND STORING VALUES IN WORD ARRAYS * ************************************************************************/ /*----------------------------------------------------------------------* * GET_INT(arr,k) gets the integer stored at index k in word array arr. * * PUT_INT(arr,k,n) puts n at index k in word array arr. * *----------------------------------------------------------------------*/ #define GET_INT(arr,k) ((M_INT) arr[k]) #define PUT_INT(arr,k,n) arr[k] = (M_WORD)(n) #define GET_LONG GET_INT #define PUT_LONG PUT_INT /*----------------------------------------------------------------------* * GET_REAL(arr,k) gets the real number stored at index k in word * * array arr. * * PUT_INT(arr,k,x) puts x at index k in word array arr. * *----------------------------------------------------------------------*/ #define GET_REAL(arr,k) get_real(arr,k) #define PUT_REAL(arr,k,x) put_real(arr,k,x) /*----------------------------------------------------------------------* * GET_ARRAY(arr,k) gets the array stored at index k in word array arr. * * PUT_ARRAY(arr,k,n) puts A at index k in word array arr. * *----------------------------------------------------------------------*/ #define GET_ARRAY(arr,k) ((M_ARRAY) arr[k]) #define PUT_ARRAY(arr,k,A) arr[k] = (M_WORD)(A) /************************************************************************ * GET_REAL * ************************************************************************ * Return the real number stored at index I in array of words A. * ************************************************************************/ union transfer { M_REAL r; M_WORD words[2]; }; M_REAL get_real(M_WORD *A, long k) { union transfer t; t.words[0] = A[k]; t.words[1] = A[k+1]; return t.r; } /************************************************************************ * PUT_REAL * ************************************************************************ * Store X at index I in array of words A. * ************************************************************************/ void put_real(M_WORD *A, long k, M_REAL x) { union transfer t; t.r = x; A[k] = t.words[0]; A[k+1] = t.words[1]; } /************************************************************************ * LOADER SUPPORT * ************************************************************************/ /************************************************************************ * MAKE_INT_ARRAY * ************************************************************************ * Return a new integer array of size N. * ************************************************************************/ M_ARRAY make_int_array(M_INT n) { if(n < 0 || n > MAX_ARRAY_SIZE) { fprintf(stderr, "Array size %ld out of range\n", n); m_abort(); return NULL; } else { M_ARRAY_HEADER* hd = (M_ARRAY_HEADER*) malloc(sizeof(M_ARRAY_HEADER)); hd->size = n; hd->kind = M_INT_KIND; hd->content.integers = (M_INT*) malloc(n*sizeof(M_INT)); return hd; } } /************************************************************************ * MAKE_REAL_ARRAY * ************************************************************************ * Return a new real array of size N. * ************************************************************************/ M_ARRAY make_real_array(M_INT n) { if(n < 0 || n > MAX_ARRAY_SIZE) { fprintf(stderr, "Array size %ld out of range\n", n); m_abort(); return NULL; } else { M_ARRAY_HEADER* hd = (M_ARRAY_HEADER*) malloc(sizeof(M_ARRAY_HEADER)); hd->size = n; hd->kind = M_REAL_KIND; hd->content.reals = (M_REAL*) malloc(n*sizeof(M_REAL)); return hd; } } /************************************************************************ * DELETE_ARRAY * ************************************************************************ * Put the space occupied by array A back into the free space. * ************************************************************************/ void delete_array(M_ARRAY A) { if(A->kind == M_INT_KIND) free(A->content.integers); else free(A->content.reals); free(A); } /************************************************************************ * DUP_CSTRING * ************************************************************************ * Return a copy of null-terminated string S, allocated using malloc. * ************************************************************************/ CSTRING dupCstring(CSTRING s) { CSTRING cpy = (CSTRING) malloc(strlen(s) + 1); strcpy(cpy, s); return cpy; } /************************************************************************ * READ_NULL_TERMINATED_STRING * ************************************************************************ * Read a string up to a null character from file INF, and store it * * into BUFFER. Store no more than SIZE+1 bytes into BUFFER, including * * the null character. If there are too many characters to store * * in the buffer, then the entire string is read, but only a prefix is * * stored in BUFFER. * ************************************************************************/ void read_null_terminated_string(FILE* inf, CSTRING buffer, int size) { int i = 0; int c = getc(inf); int s = size - 1; while(c != 0 && c != EOF) { if(i < s) buffer[i++] = c; c = getc(inf); } buffer[i] = '\0'; } /************************************************************************ * GET_FUNCTION_INDEX * ************************************************************************ * Return the index in the code array where function FNAME is located. * * If there is no such function, return -1. * ************************************************************************/ long get_function_index(CSTRING fname) { int k; for(k = 0; k < map_pointer; k++) { if(strcmp(fname, code_array_map[k].function_name) == 0) { return code_array_map[k].index; } } return -1; } /************************************************************************ * GET_FUNCTION_NAME * ************************************************************************ * Return the name of the function that contains the instruction at * * index INDEX. * ************************************************************************/ #ifdef DEBUG CSTRING get_function_name(long index) { int k; CSTRING result = "(none)"; for(k = 0; k < map_pointer; k++) { if(code_array_map[k].index <= index) { result = code_array_map[k].function_name; } else return result; } return result; } #endif /************************************************************************ * GET_PERMANENT_NAME * ************************************************************************ * Return a name in the heap for function FNAME. It is found either * * by finding it in the function backpatches or by finding allocating * * it. * ************************************************************************/ CSTRING get_permanent_name(CSTRING fname) { int k; for(k = 0; k < function_backpatch_pointer; k++) { if(strcmp(function_backpatches[k].name, fname) == 0) { return function_backpatches[k].name; } } return dupCstring(fname); } /************************************************************************ * INSTALL_FUNCTION * ************************************************************************ * Install function FNAME into the code array map, starting at location * * LOC. * * * * Return TRUE on success, FALSE on failure. * ************************************************************************/ M_BOOL install_function(CSTRING fname, long loc) { if(map_pointer < MAX_FUNCTIONS) { code_array_map[map_pointer].function_name = get_permanent_name(fname); code_array_map[map_pointer].index = loc; map_pointer++; return TRUE; } else return FALSE; } /************************************************************************ * DO_LABEL_BACKPATCHES * ************************************************************************ * Install labels that are indicated in array BACKPATCHES, of size N. * * LABEL_INDEX[k] is the location of label k, or is -1 if there is no * * such label. * * * * Return TRUE on success, FALSE on failure. * ************************************************************************/ M_BOOL do_label_backpatches(LABEL_BACKPATCH_RECORD *backpatch, int n, long *label_index) { int k, loc; for(k = 0; k < n; k++) { loc = label_index[backpatch[k].lbl]; if(loc >= 0) { store_label(backpatch[k].index, loc); } else return m_complain(COMPLAIN_UNKNOWN_LABEL, k); } return TRUE; } /************************************************************************ * DO_FUNCTION_BACKPATCHES * ************************************************************************ * Install labels that are indicated in array backpatches, of size n. * * * * Return TRUE on success and FALSE on failure. * ************************************************************************/ M_BOOL do_function_backpatches(void) { int k; long loc; char *name; for(k = 0; k < function_backpatch_pointer; k++) { name = function_backpatches[k].name; loc = get_function_index(function_backpatches[k].name); if(loc >= 0) { store_label(function_backpatches[k].index, loc); } else { return m_complain(COMPLAIN_UNKNOWN_FUNCTION, name); } } return TRUE; } /************************************************************************ * REQUEST_FUNCTION_BACKPATCH * ************************************************************************ * Install a new function backpatch requesting that the address of * * function FNAME be installed at index HERE in code_array. * * * * Return TRUE on success and FALSE on failure. * ************************************************************************/ M_BOOL request_function_backpatch(CSTRING fname, long here) { if(function_backpatch_pointer < MAX_FUNCTIONS) { function_backpatches[function_backpatch_pointer].name = dupCstring(fname); function_backpatches[function_backpatch_pointer].index = here; function_backpatch_pointer++; return TRUE; } else { return m_complain(COMPLAIN_TOO_MANY_FUNCTIONS); } } /************************************************************************ * REQUEST_ARRAY_BACKPATCH * ************************************************************************ * Install a new array backpatch requesting an array created by * * instruction instr, whose size is given by integer constant k, stored * * at offset where in the global table. * * * * Return TRUE on success and FALSE on failure. * ************************************************************************/ M_BOOL request_array_backpatch(int instr, int k, int where) { if(array_backpatch_pointer < MAX_GLOBAL_ARRAYS) { array_backpatches[array_backpatch_pointer].instr = instr; array_backpatches[array_backpatch_pointer].size_index = k; array_backpatches[array_backpatch_pointer].where = where; array_backpatch_pointer++; return TRUE; } else { return m_complain(COMPLAIN_TOO_MANY_GLOBAL_ARRAYS); } } /************************************************************************ * DO_ARRAY_BACKPATCHES * ************************************************************************ * Perform the backpatches called for by array_backpatches. * * * * Return true on success, false on failure. * ************************************************************************/ M_BOOL do_array_backpatches(void) { int i; for(i = 0; i < array_backpatch_pointer; i++) { long size; int k, where, instr; M_ARRAY arr; instr = array_backpatches[i].instr; k = array_backpatches[i].size_index; where = array_backpatches[i].where; if(k < 0 || k >= int_constant_pointer) { return m_complain(COMPLAIN_NO_ARRAY_SIZE, k); } size = int_constant_table[k]; arr = (instr == MS_INTEGER_ARRAY_GLOBAL) ? make_int_array(size) : make_real_array(size); PUT_ARRAY(global_table, where, arr); } return TRUE; } /************************************************************************ * LOADER * ************************************************************************ * The loader loads the byte code from a file into the byte code * * array. load_byte_code(INF) loads the code from open file INF. * * It adds the code to the end of any current byte code that is in the * * code array. * * * * The return value is TRUE on success, FALSE on failure. * * * * Load_byte_code does not take responsibility either for opening or * * for closing the file. It only reads the file. * ************************************************************************/ M_BOOL load_function(FILE* inf); M_BOOL load_byte_code(FILE* inf) { char buffer[MAX_CONSTANT_SIZE + 1]; int nextc; while( (nextc = getc(inf)) != EOF) { switch(nextc) { case MS_INTEGER_CONSTANT: if(int_constant_pointer >= MAX_INT_CONSTANTS) { return m_complain(COMPLAIN_TOO_MANY_INTEGERS); } read_null_terminated_string(inf, buffer, MAX_CONSTANT_SIZE); int_constant_table[int_constant_pointer++] = atol(buffer); break; case MS_REAL_CONSTANT: if(real_constant_pointer >= MAX_REAL_CONSTANTS) { return m_complain(COMPLAIN_TOO_MANY_REALS); } read_null_terminated_string(inf, buffer, MAX_CONSTANT_SIZE); real_constant_table[real_constant_pointer++] = atof(buffer); break; case MS_FUNCTION: if(!load_function(inf)) return FALSE; break; case MS_INTEGER_GLOBAL: if(global_word_pointer > MAX_GLOBAL_WORDS - M_SIZE_INTEGER) { return m_complain(COMPLAIN_TOO_MANY_GLOBALS); } global_word_pointer += M_SIZE_INTEGER; break; case MS_REAL_GLOBAL: if(global_word_pointer >= MAX_GLOBAL_WORDS - M_SIZE_REAL) { return m_complain(COMPLAIN_TOO_MANY_GLOBALS); } global_word_pointer += M_SIZE_REAL; break; case MS_INTEGER_ARRAY_GLOBAL: case MS_REAL_ARRAY_GLOBAL: {int k = getc(inf); if(global_word_pointer >= MAX_GLOBAL_WORDS - M_SIZE_ARRAY) { return m_complain(COMPLAIN_TOO_MANY_GLOBALS); } request_array_backpatch(nextc, k, global_word_pointer); global_word_pointer += M_SIZE_ARRAY; break; } case MS_START: {char buffer[MAX_NAME_SIZE + 1]; read_null_terminated_string(inf, buffer, MAX_NAME_SIZE); start_function_name = dupCstring(buffer); break; } default: m_complain(COMPLAIN_UNKNOWN_SECTION, nextc); return FALSE; } } return do_function_backpatches() && do_array_backpatches(); } /************************************************************************ * LOAD_FUNCTION * ************************************************************************ * Read an MS_FUNCTION definition (after the MS_FUNCTION byte) from * * file INF and store the definition into the code array and the * * function location into the code map. * * * * Return TRUE on success and FALSE on failure. * ************************************************************************/ M_BOOL load_function(FILE* inf) { LABEL_BACKPATCH_RECORD backpatch[MAX_LABEL_BACKPATCHES]; long label_index[MAX_LABELS]; char funname[MAX_NAME_SIZE + 1]; long fun_start_loc; int k, num_backpatches, instr; fun_start_loc = byte_code_pointer; num_backpatches = 0; for(k = 0; k < MAX_LABELS; k++) label_index[k] = -1; read_null_terminated_string(inf, funname, MAX_NAME_SIZE); instr = getc(inf); while(instr != MS_END && instr != EOF) { /*----------------------------------------------------------------* * Check that there is enough room for at least three more bytes, * * to avoid need for checking again at two or three byte * * instructions. * *----------------------------------------------------------------*/ if(byte_code_pointer >= MAX_CODE - 2) { return m_complain(COMPLAIN_PROGRAM_TOO_LARGE); } /*------------------------------------------* * Read and install one more instruction. * *------------------------------------------*/ if(instr < M_FIRST_EXECUTABLE_INSTRUCTION || instr > M_LAST_INSTRUCTION) { return m_complain(COMPLAIN_UNKNOWN_INSTRUCTION, instr); } switch(instruction_class[instr - M_FIRST_EXECUTABLE_INSTRUCTION]) { case ONE_BYTE_INSTRUCTION: code_array[byte_code_pointer++] = (M_BYTE) instr; break; case TWO_BYTE_INSTRUCTION: code_array[byte_code_pointer] = (M_BYTE) instr; code_array[byte_code_pointer + 1] = (M_BYTE) getc(inf); byte_code_pointer += 2; break; case LABEL_INSTRUCTION: /*--------------------------------------------------------------* * Label instructions are only installed in the label array, * * not in the code array. We just need to know where the * * label is. * *--------------------------------------------------------------*/ {int k = getc(inf); if(k == EOF) { return m_complain(COMPLAIN_EOF); } if(label_index[k] != -1) { return m_complain(COMPLAIN_DUPLICATE_LABEL, k); } label_index[k] = byte_code_pointer; break; } case GOTO_INSTRUCTION: /*--------------------------------------------------------------* * In the file, a (conditional) goto is followed by a one byte * * label. In the internal form, it is followed by two bytes * * that tell the location of the label in the code array. * * * * A backward goto can have its label installed immediately. * * A forward goto needs to have its label patched in later * * when the label is encountered. * *--------------------------------------------------------------*/ {int k = getc(inf); int i; if(k == EOF) return m_complain(COMPLAIN_EOF); code_array[byte_code_pointer++] = (M_BYTE) instr; i = label_index[k]; if(i >= 0) { store_label(byte_code_pointer, i); } else { backpatch[num_backpatches].lbl = k; backpatch[num_backpatches].index = byte_code_pointer; num_backpatches++; } byte_code_pointer += INTERNAL_LABEL_SIZE; break; } case CALL_INSTRUCTION: {char funname[MAX_NAME_SIZE + 1]; int k = getc(inf); int i; /*-------------------------------------------------------------* * In the code array, the name of the function is replaced * * by the address where the function is stored. If we do not * * know that yet, request a backpatch later. * *-------------------------------------------------------------*/ if(k == EOF) return m_complain(COMPLAIN_EOF); code_array[byte_code_pointer++] = (M_BYTE) instr; code_array[byte_code_pointer++] = (M_BYTE) k; read_null_terminated_string(inf, funname, MAX_NAME_SIZE); i = get_function_index(funname); if(i >= 0) { store_label(byte_code_pointer, i); } else { if(!request_function_backpatch(funname, byte_code_pointer)) { return FALSE; } } byte_code_pointer += INTERNAL_LABEL_SIZE; break; } } instr = getc(inf); } if(instr != MS_END) return m_complain(COMPLAIN_EOF); if(!do_label_backpatches(backpatch, num_backpatches, label_index)) { return FALSE; } return install_function(funname, fun_start_loc); } /************************************************************************ * FUNCTIONS TO PERFORM INSTRUCTIONS * ************************************************************************/ /************************************************************************ * COMPARE_INTS * ************************************************************************ * Return * * -1 if X < Y * * 0 if X = Y * * 1 if X > Y * ************************************************************************/ M_INT compare_ints(M_INT x, M_INT y) { if(x < y) return -1; else if(x == y) return 0; else return 1; } /************************************************************************ * COMPARE_REALS * ************************************************************************ * Return * * -1 if X < Y * * 0 if X = Y * * 1 if X > Y * ************************************************************************/ M_INT compare_reals(M_REAL x, M_REAL y) { if(x < y) return -1; else if(x == y) return 0; else return 1; } /************************************************************************ * INTEGER_QUOTIENT * ************************************************************************ * Return X / Y. * ************************************************************************/ M_INT integer_quotient(M_INT x, M_INT y) { if(y == 0) { m_complain(COMPLAIN_DIVIDE_BY_ZERO); m_abort(); } if(x >= 0) { if(y > 0) return x / y; else return (x % (-y) == 0) ? -(x/(-y)) : -(x/(-y) + 1); } else { if(y > 0) return ((-x) % y == 0) ? -((-x)/y) : -((-x)/y) - 1; else return (-x)/(-y); } } /************************************************************************ * INTEGER_REMAINDER * ************************************************************************ * Return X mod Y. * ************************************************************************/ M_INT integer_remainder(M_INT x, M_INT y) { if(y == 0) { m_complain(COMPLAIN_DIVIDE_BY_ZERO); m_abort(); return 0; } else return x - y * integer_quotient(x,y); } /************************************************************************ * REAL_DIVIDE * ************************************************************************ * Return X / Y . * ************************************************************************/ M_REAL real_divide(M_REAL x, M_REAL y) { if(y == 0.0) { m_complain(COMPLAIN_DIVIDE_BY_ZERO); m_abort(); return 0.0; } else return x/y; } /************************************************************************ * INT_SUBSCRIPT * ************************************************************************ * Return A[n]. * ************************************************************************/ M_INT int_subscript(M_ARRAY A, M_INT n) { if(n < 0 || n >= A->size) { m_complain(COMPLAIN_SUBSCRIPT_ERROR); m_abort(); return 0; } else { return A->content.integers[n]; } } /************************************************************************ * REAL_SUBSCRIPT * ************************************************************************ * Return A[n]. * ************************************************************************/ M_REAL real_subscript(M_ARRAY A, M_INT n) { if(n < 0 || n >= A->size) { m_complain(COMPLAIN_SUBSCRIPT_ERROR); m_abort(); return 0.0; } else { return A->content.reals[n]; } } /************************************************************************ * STORE_ARRAY_INTEGER * ************************************************************************ * Set A[n] = x. * ************************************************************************/ void store_array_integer(M_ARRAY A, M_INT n, M_INT x) { if(n < 0 || n >= A->size) { m_complain(COMPLAIN_SUBSCRIPT_ERROR); m_abort(); } else { A->content.integers[n] = x; } } /************************************************************************ * STORE_ARRAY_REAL * ************************************************************************ * Set A[n] = x. * ************************************************************************/ void store_array_real(M_ARRAY A, M_INT n, M_REAL x) { if(n < 0 || n >= A->size) { m_complain(COMPLAIN_SUBSCRIPT_ERROR); m_abort(); } else { A->content.reals[n] = x; } } /************************************************************************ * M_CALL * ************************************************************************ * Push a new frame for a function with NARGS arguments and return * * address RET. * ************************************************************************/ void m_call(int nargs, long ret) { if(stack_pointer <= MAX_CODE - LOCAL_OFFSET) { /*------------------------------------------------------------* * Store the return address, number of arguments and dynamic * * link into the new frame. * *------------------------------------------------------------*/ int k = stack_pointer; PUT_LONG(machine_stack, k + RETURN_ADDRESS_OFFSET, ret); PUT_LONG(machine_stack, k + NUM_PARAMS_OFFSET, nargs); PUT_LONG(machine_stack, k + DYNAMIC_LINK_OFFSET, frame_pointer); /*------------------------------------------------------------* * Set up the new frame pointer and stack pointer and return. * *------------------------------------------------------------*/ frame_pointer = stack_pointer; stack_pointer += LOCAL_OFFSET; } else { m_complain(COMPLAIN_STACK_OVERFLOW); m_abort(); } } /************************************************************************ * M_RETURN * ************************************************************************ * Return from a function call by popping a frame from the stack. * * Parameter SIZE is the number of words in the returned value. * * * * Set *RET_ADDR to the return address. * * * * Return TRUE if this is a return from the last stack frame or from * * a nonexistent stack frame, and FALSE otherwise. * ************************************************************************/ M_BOOL m_return(int size, long *ret_addr) { long dynamic_link, numparamw, curr_ret_loc, new_ret_loc; if(frame_pointer < 0) { *ret_addr = 0; return TRUE; } *ret_addr = GET_LONG(machine_stack, frame_pointer + RETURN_ADDRESS_OFFSET); dynamic_link = GET_LONG(machine_stack, frame_pointer + DYNAMIC_LINK_OFFSET); /*--------------------------------------------------------------* * Copy the return value down to the top of the previous frame * * and adjust the stack pointer. * *--------------------------------------------------------------*/ numparamw = GET_LONG(machine_stack, frame_pointer + NUM_PARAMS_OFFSET); new_ret_loc = frame_pointer - numparamw; if(size > 0) { curr_ret_loc = stack_pointer - size; memcpy(machine_stack + new_ret_loc, machine_stack + curr_ret_loc, size*sizeof(M_WORD)); } /*--------------------------------------------------* * Install the new frame pointer and stack pointer. * *--------------------------------------------------*/ frame_pointer = dynamic_link; stack_pointer = new_ret_loc + size; return FALSE; } /************************************************************************ * SUPPORT FOR RUN * ************************************************************************ * The following macros are used in the body of the run function * * (below) to perform certain computation idioms on the stack. * ************************************************************************/ /*------------------------------------------------------* * POP_ONE(size) pops size words from the stack. * *------------------------------------------------------*/ #define POP_ONE(size)\ if(stack_pointer >= (size)) stack_pointer -= (size);\ else {\ m_complain(COMPLAIN_STACK_UNDERFLOW);\ return;\ } /*--------------------------------------------------------------* * DUP_ONE(size,putter) duplicates size words on the stack top. * *--------------------------------------------------------------*/ #define DUP_ONE(size,putter)\ if(stack_pointer >= (size)) {\ PUSH_ONE(machine_stack[stack_pointer - (size)], (size), putter);\ }\ else {\ m_complain(COMPLAIN_STACK_UNDERFLOW);\ return;\ } #define DUP_INT DUP_ONE(M_SIZE_INTEGER, PUT_INT) #define DUP_REAL DUP_ONE(M_SIZE_REAL, PUT_REAL) #define DUP_ARRAY DUP_ONE(M_SIZE_ARRAY, PUT_ARRAY) /*----------------------------------------------------------------------* * PUSH_ONE(expr, size, putter) pushes expression expr, of the given * * size, onto the stack, using putter to store onto the stack. * *----------------------------------------------------------------------*/ #define PUSH_ONE(expr,size,putter)\ if(stack_pointer <= MAX_STACK - (size)) {\ putter(machine_stack, stack_pointer, (expr));\ stack_pointer += (size);\ }\ else {\ m_complain(COMPLAIN_STACK_OVERFLOW);\ return;\ } #define PUSH_INT(expr) PUSH_ONE(expr, M_SIZE_INTEGER, PUT_INT) #define PUSH_REAL(expr) PUSH_ONE(expr, M_SIZE_REAL, PUT_REAL) #define PUSH_ARRAY(expr) PUSH_ONE(expr, M_SIZE_ARRAY, PUT_ARRAY) /*----------------------------------------------------------------------* * PERFORM_BINARY(expr,type,size,getter,putter) performs the following * * transformation on the stack. * * * * before after * * ------ ----- * * y expr * * x * * * * type is the type of thing being operated on. * * size is the number of words used by this type. * * getter is a function that extracts this type of thing from the * * stack and returns it. See GET_INT, for example. * * putter is a function that stores this type of thing into the * * stack. See PUT_INT, for example. * *----------------------------------------------------------------------*/ #define PERFORM_BINARY(expr,type,size,getter,putter)\ if(stack_pointer >= (size) + (size)) {\ type x,y;\ stack_pointer -= (size);\ y = getter(machine_stack, stack_pointer);\ x = getter(machine_stack, stack_pointer - (size));\ putter(machine_stack, stack_pointer - (size), (expr));\ }\ else {\ m_complain(COMPLAIN_STACK_UNDERFLOW);\ return;\ } #define PERFORM_BINARY_INT(expr)\ PERFORM_BINARY(expr,M_INT,M_SIZE_INTEGER,GET_INT,PUT_INT) #define PERFORM_BINARY_REAL(expr)\ PERFORM_BINARY(expr,M_REAL,M_SIZE_REAL,GET_REAL,PUT_REAL) /*----------------------------------------------------------------------* * BUILD_ARRAY(builder) pops an integer size n from the stack and * * pushes an array builder(n). * *----------------------------------------------------------------------*/ #if M_SIZE_INTEGER != M_SIZE_ARRAY #define BUILD_ARRAY(builder)\ if(stack_pointer >= M_SIZE_INTEGER) {\ M_INT n = GET_INT(machine_stack, stack_pointer - M_SIZE_INTEGER);\ PUT_ARRAY(machine_stack, stack_pointer - M_SIZE_INTEGER, builder(n));\ stack_pointer += M_SIZE_ARRAY - M_SIZE_INTEGER;\ }\ else { \ m_complain(COMPLAIN_STACK_UNDERFLOW);\ return;\ } #else #define BUILD_ARRAY(builder)\ if(stack_pointer >= M_SIZE_INTEGER) {\ M_INT n = GET_INT(machine_stack, stack_pointer - M_SIZE_INTEGER);\ PUT_ARRAY(machine_stack, stack_pointer - M_SIZE_INTEGER, builder(n));\ }\ else { \ m_complain(COMPLAIN_STACK_UNDERFLOW);\ return;\ } #endif /*----------------------------------------------------------------------* * STORE_INDEXED(type,size,getter,storer) pops from the stack * * * * x * * n * * A * * * * and sets A[n] = x. * * * * type is the type of x * * size is the size of x. * * getter is the function that gets the value from the stack * * storer is the function that is used to perform the store. * *----------------------------------------------------------------------*/ #define STORE_INDEXED(type,size,getter,storer)\ if(stack_pointer >= (M_SIZE_ARRAY + M_SIZE_INTEGER + (size))) {\ type x;\ M_ARRAY A;\ M_INT n;\ stack_pointer -= (size);\ x = getter(machine_stack, stack_pointer);\ n = GET_INT(machine_stack, stack_pointer - M_SIZE_INTEGER);\ A = GET_ARRAY(machine_stack,\ stack_pointer - (M_SIZE_INTEGER + M_SIZE_ARRAY));\ storer(A,n,x);\ stack_pointer -= (M_SIZE_INTEGER + M_SIZE_ARRAY);\ }\ else {\ m_complain(COMPLAIN_STACK_UNDERFLOW);\ return;\ } /*----------------------------------------------------------------------* * STORE_LEAVE_INDEXED(type,size,getter,storer) pops from the stack * * * * x * * n * * A * * * * and sets A[n] = x. Then it pushes x back onto the stack. * * * * type is the type of x * * size is the size of x. * * getter is the function that gets the value from the stack * * storer is the function that is used to perform the store. * * putter is the function for pushing x onto the stack. * *----------------------------------------------------------------------*/ #define STORE_LEAVE_INDEXED(type,size,getter,storer,putter)\ if(stack_pointer >= (M_SIZE_ARRAY + M_SIZE_INTEGER + (size))) {\ type x;\ M_ARRAY A;\ M_INT n;\ stack_pointer -= (size);\ x = getter(machine_stack, stack_pointer);\ n = GET_INT(machine_stack, stack_pointer - M_SIZE_INTEGER);\ A = GET_ARRAY(machine_stack,\ stack_pointer - (M_SIZE_INTEGER + M_SIZE_ARRAY));\ storer(A,n,x);\ stack_pointer -= (M_SIZE_INTEGER + M_SIZE_ARRAY);\ PUSH_ONE(x, (size), putter);\ }\ else {\ m_complain(COMPLAIN_STACK_UNDERFLOW);\ return;\ } /*----------------------------------------------------------------------* * CONDITIONAL_GOTO(expr) performs a conditional goto instruction with * * condition expr. It pops x from the stack. * *----------------------------------------------------------------------*/ #define CONDITIONAL_GOTO(expr)\ {M_INT x;\ if(stack_pointer >= M_SIZE_INTEGER) {\ stack_pointer -= M_SIZE_INTEGER;\ x = GET_INT(machine_stack, stack_pointer);\ if(expr) current_instruction_index = get_label(current_instruction_index);\ else current_instruction_index += INTERNAL_LABEL_SIZE;\ }\ else {\ m_complain(COMPLAIN_STACK_UNDERFLOW);\ return;\ }\ } /*----------------------------------------------------------------------* * LOCAL_FETCH(getter,pusher) gets an index from the code array, * * fetches the local variable at that index, and pushes the value of * * that local variable onto the stack. * * * * getter is the function that gets the local variable. * * pusher is the function that pushes the value onto the stack. * *----------------------------------------------------------------------*/ #define LOCAL_FETCH(getter, pusher)\ {int k,i;\ k = code_array[current_instruction_index++];\ i = frame_pointer + k + LOCAL_OFFSET;\ if(i >= stack_pointer) {\ m_complain(COMPLAIN_BAD_LOCAL, k);\ return;\ }\ pusher(getter(machine_stack, i));\ } /*----------------------------------------------------------------------* * PARAM_FETCH(getter,pusher) gets an index from the code array, * * fetches the parameter at that index, and pushes the value of * * that local variable onto the stack. * * * * getter is the function that gets the local variable. * * pusher is the function that pushes the value onto the stack. * *----------------------------------------------------------------------*/ #define PARAM_FETCH(getter, pusher)\ {int k,npw;\ long i;\ k = code_array[current_instruction_index++];\ npw = GET_INT(machine_stack, frame_pointer + NUM_PARAMS_OFFSET);\ i = frame_pointer + k - npw;\ if(i >= frame_pointer) {\ m_complain(COMPLAIN_BAD_PARAM, k);\ return;\ }\ pusher(getter(machine_stack,i));\ } /*----------------------------------------------------------------------* * GLOBAL_FETCH(getter,pusher) gets an index from the code array, * * fetches the global variable at that index, and pushes the value of * * that global variable onto the stack. * * * * getter is the function that gets the local variable. * * pusher is the function that pushes the value onto the stack. * *----------------------------------------------------------------------*/ #define GLOBAL_FETCH(getter, pusher)\ {int k;\ k = code_array[current_instruction_index++];\ if(k >= global_word_pointer) {\ m_complain(COMPLAIN_UNKNOWN_GLOBAL, k);\ return;\ }\ pusher(getter(global_table, k));\ } /*----------------------------------------------------------------------* * LOCAL_STORE(size,getter,putter) gets an index k from the code array, * * pops the stack and stores the popped value into the local variable * * at index k. * * * * size is the size in words of the value being popped. * * getter is the function that gets the value from the stack. * * putter is the function that stores the local variable. * *----------------------------------------------------------------------*/ #define LOCAL_STORE(size, getter, putter)\ {int k;\ long i;\ if(stack_pointer >= size) {\ stack_pointer -= size;\ k = code_array[current_instruction_index++];\ i = frame_pointer + k + LOCAL_OFFSET;\ if(i + (size) > stack_pointer) {\ m_complain(COMPLAIN_BAD_LOCAL, k);\ return;\ }\ putter(machine_stack, i, getter(machine_stack, stack_pointer));\ }\ else {\ m_complain(COMPLAIN_STACK_UNDERFLOW);\ return;\ }\ } /*----------------------------------------------------------------------* * PARAM_STORE(size,getter,putter) gets an index k from the code array, * * pops the stack and stores the popped value into the parameter * * at index k. * * * * size is the size in words of the value being popped. * * getter is the function that gets the value from the stack. * * putter is the function that stores the parameter. * *----------------------------------------------------------------------*/ #define PARAM_STORE(size, getter, putter)\ {int k,npw,i;\ if(stack_pointer >= size) {\ stack_pointer -= size;\ k = code_array[current_instruction_index++];\ npw = GET_INT(machine_stack, frame_pointer + NUM_PARAMS_OFFSET);\ i = frame_pointer + k - npw;\ if(i + (size) > frame_pointer) {\ m_complain(COMPLAIN_BAD_PARAM, k);\ return;\ }\ putter(machine_stack, i, getter(machine_stack, stack_pointer));\ }\ else {\ m_complain(COMPLAIN_STACK_UNDERFLOW);\ return;\ }\ } /*----------------------------------------------------------------------* * GLOBAL_STORE(size,getter,putter) gets an index k from the code array,* * pops the stack and stores the popped value into the global variable * * at index k. * * * * size is the size in words of the value being popped. * * getter is the function that gets the value from the stack. * * putter is the function that stores the global variable. * *----------------------------------------------------------------------*/ #define GLOBAL_STORE(size, getter, putter)\ {int k;\ if(stack_pointer >= size) {\ stack_pointer -= size;\ k = code_array[current_instruction_index++];\ if(k + (size) > global_word_pointer) {\ m_complain(COMPLAIN_UNKNOWN_GLOBAL, k);\ return;\ }\ putter(global_table, k, getter(machine_stack, stack_pointer));\ }\ else {\ m_complain(COMPLAIN_STACK_UNDERFLOW);\ return;\ }\ } /*----------------------------------------------------------------------* * DO_WRITE(size,getter,format) pops the stack and writes the popped * * value to the standard output. * * * * size is the size of the item on top of the stack. * * getter is the function that gets the value from the stack. * * format is the format to use in the write. * *----------------------------------------------------------------------*/ #define DO_WRITE(size, getter, format)\ if(stack_pointer >= size) {\ stack_pointer -= size;\ printf(format, getter(machine_stack, stack_pointer));\ }\ else {\ m_complain(COMPLAIN_STACK_UNDERFLOW);\ return;\ } /*----------------------------------------------------------------------* * DO_READ(type,format,pusher,deflt) reads a value from the standard * * input and pushed it onto the stack. It sets input_fail_flag to * * TRUE if there was an error and FALSE if there was success. * * * * type is the type of thing that is being read. * * format is the input format * * pusher is a function that will push the result onto the stack. * * deflt is the default value, in case of error. * *----------------------------------------------------------------------*/ #define DO_READ(type,format,pusher,deflt)\ {type x;\ if(scanf(format, &x) != 1) {\ x = deflt;\ input_fail_flag = TRUE;\ }\ else {\ input_fail_flag = FALSE;\ }\ pusher(x);\ } /************************************************************************ * RUN * ************************************************************************ * Run the program, starting at index START in the code array. * * All of the data structures, including the code array, must have * * been set up before this is called. * ************************************************************************/ void trace_instruction(long instruction_index, M_BYTE instruction); void trace_instruction_result(M_BYTE instruction); void dump_stack(void); void dump_globals(void); void run(int start) { long current_instruction_index = start; M_BYTE current_instruction; while(TRUE) { if(current_instruction_index >= byte_code_pointer) { m_complain(COMPLAIN_BAD_PROGRAM_COUNTER); return; } current_instruction = code_array[current_instruction_index]; # ifdef DEBUG if(trace) { trace_instruction(current_instruction_index, current_instruction); } # endif current_instruction_index++; switch(current_instruction) { case M_POP_INTEGER: POP_ONE(M_SIZE_INTEGER); break; case M_POP_REAL: POP_ONE(M_SIZE_REAL); break; case M_POP_ARRAY: POP_ONE(M_SIZE_ARRAY); break; case M_DUP_INTEGER: DUP_INT; break; case M_DUP_REAL: DUP_REAL; break; case M_DUP_ARRAY: DUP_ARRAY; break; case M_INTEGER_ADD: PERFORM_BINARY_INT(x+y); break; case M_INTEGER_SUBTRACT: PERFORM_BINARY_INT(x-y); break; case M_INTEGER_MULTIPLY: PERFORM_BINARY_INT(x*y); break; case M_INTEGER_DIVIDE: PERFORM_BINARY_INT(integer_quotient(x,y)); break; case M_INTEGER_MOD: PERFORM_BINARY_INT(integer_remainder(x,y)); break; case M_REAL_ADD: PERFORM_BINARY_REAL(x+y); break; case M_REAL_SUBTRACT: PERFORM_BINARY_REAL(x-y); break; case M_REAL_MULTIPLY: PERFORM_BINARY_REAL(x*y); break; case M_REAL_DIVIDE: PERFORM_BINARY_REAL(real_divide(x,y)); break; case M_COMPARE_INTEGERS: PERFORM_BINARY_INT(compare_ints(x,y)); break; case M_COMPARE_REALS: if(stack_pointer >= 2*M_SIZE_REAL) {\ M_REAL x,y;\ stack_pointer -= M_SIZE_REAL;\ y = GET_REAL(machine_stack, stack_pointer);\ x = GET_REAL(machine_stack, stack_pointer - M_SIZE_REAL);\ stack_pointer -= (M_SIZE_REAL - M_SIZE_INTEGER); PUT_INT(machine_stack, stack_pointer - M_SIZE_INTEGER, compare_reals(x,y));\ } break; case M_MAKE_INTEGER_ARRAY: BUILD_ARRAY(make_int_array); break; case M_MAKE_REAL_ARRAY: BUILD_ARRAY(make_real_array); break; case M_DELETE_ARRAY: if(stack_pointer >= M_SIZE_ARRAY) { stack_pointer -= M_SIZE_ARRAY; delete_array(GET_ARRAY(machine_stack, stack_pointer)); } else { m_complain(COMPLAIN_STACK_UNDERFLOW); return; } break; case M_INDEX: if(stack_pointer >= M_SIZE_INTEGER + M_SIZE_ARRAY) { M_INT n; M_ARRAY A; stack_pointer -= M_SIZE_INTEGER; n = GET_INT(machine_stack, stack_pointer); A = GET_ARRAY(machine_stack, stack_pointer - M_SIZE_ARRAY); if(A->kind == M_REAL_KIND) { PUT_REAL(machine_stack, stack_pointer - M_SIZE_ARRAY, real_subscript(A,n)); stack_pointer += (M_SIZE_REAL - M_SIZE_ARRAY); # ifdef DEBUG last_index_result_type = 1; # endif } else { PUT_INT(machine_stack, stack_pointer - M_SIZE_ARRAY, int_subscript(A,n)); stack_pointer += (M_SIZE_INTEGER - M_SIZE_ARRAY); # ifdef DEBUG last_index_result_type = 0; # endif } } else { m_complain(COMPLAIN_STACK_UNDERFLOW); return; } break; case M_STORE_INTEGER_INDEXED: STORE_INDEXED(M_INT, M_SIZE_INTEGER, GET_INT, store_array_integer); break; case M_STORE_REAL_INDEXED: STORE_INDEXED(M_REAL, M_SIZE_REAL, GET_REAL, store_array_real); break; case M_STORE_LEAVE_INTEGER_INDEXED: STORE_LEAVE_INDEXED(M_INT, M_SIZE_INTEGER, GET_INT, store_array_integer, PUT_INT); break; case M_STORE_LEAVE_REAL_INDEXED: STORE_LEAVE_INDEXED(M_REAL, M_SIZE_REAL, GET_REAL, store_array_real, PUT_REAL); break; case M_RETURN_INTEGER: if(m_return(M_SIZE_INTEGER, ¤t_instruction_index)) return; break; case M_RETURN_REAL: if(m_return(M_SIZE_REAL, ¤t_instruction_index)) return; break; case M_RETURN: if(m_return(0, ¤t_instruction_index)) return; break; case M_READ_INTEGER: DO_READ(M_INT, "%ld", PUSH_INT, 0); break; case M_READ_REAL: DO_READ(M_REAL, "%lf", PUSH_REAL, 0.0); break; case M_READ_CHAR: DO_READ(char, "%c", PUSH_INT, 0); break; case M_WRITE_INTEGER: DO_WRITE(M_SIZE_INTEGER, GET_INT, "%ld"); break; case M_WRITE_REAL: DO_WRITE(M_SIZE_REAL, GET_REAL, "%f"); break; case M_WRITE_CHAR: DO_WRITE(M_SIZE_INTEGER, GET_INT, "%lc"); break; case M_PUSH_INTEGER: {int k = code_array[current_instruction_index++]; PUSH_INT(k); break; } case M_PUSH_INTEGER_CONSTANT: {int k = code_array[current_instruction_index++]; if(k >= int_constant_pointer) { m_complain(COMPLAIN_BAD_INT_CONSTANT, k); return; } PUSH_INT(int_constant_table[k]); break; } case M_PUSH_REAL_CONSTANT: {int k = code_array[current_instruction_index++]; if(k >= real_constant_pointer) { m_complain(COMPLAIN_BAD_REAL_CONSTANT, k); return; } PUSH_REAL(real_constant_table[k]); break; } case M_ALLOC: {int k = code_array[current_instruction_index++]; if(stack_pointer <= MAX_CODE - k) stack_pointer += k; else { m_complain(COMPLAIN_STACK_OVERFLOW); return; } break; } case M_DEALLOC: {int k = code_array[current_instruction_index++]; if(stack_pointer >= k) stack_pointer -= k; else { m_complain(COMPLAIN_STACK_UNDERFLOW); return; } break; } case M_FETCH_LOCAL_INTEGER: LOCAL_FETCH(GET_INT, PUSH_INT); break; case M_FETCH_LOCAL_REAL: LOCAL_FETCH(GET_REAL, PUSH_REAL); break; case M_FETCH_LOCAL_ARRAY: LOCAL_FETCH(GET_ARRAY, PUSH_ARRAY); break; case M_STORE_LOCAL_INTEGER: LOCAL_STORE(M_SIZE_INTEGER, GET_INT, PUT_INT); break; case M_STORE_LOCAL_REAL: LOCAL_STORE(M_SIZE_REAL, GET_REAL, PUT_REAL); break; case M_STORE_LOCAL_ARRAY: LOCAL_STORE(M_SIZE_ARRAY, GET_ARRAY, PUT_ARRAY); break; case M_FETCH_PARAM_INTEGER: PARAM_FETCH(GET_INT, PUSH_INT); break; case M_FETCH_PARAM_REAL: PARAM_FETCH(GET_REAL, PUSH_REAL); break; case M_FETCH_PARAM_ARRAY: PARAM_FETCH(GET_ARRAY, PUSH_ARRAY); break; case M_STORE_PARAM_INTEGER: PARAM_STORE(M_SIZE_INTEGER, GET_INT, PUT_INT); break; case M_STORE_PARAM_REAL: PARAM_STORE(M_SIZE_REAL, GET_REAL, PUT_REAL); break; case M_STORE_PARAM_ARRAY: PARAM_STORE(M_SIZE_ARRAY, GET_ARRAY, PUT_ARRAY); break; case M_FETCH_GLOBAL_INTEGER: GLOBAL_FETCH(GET_INT, PUSH_INT); break; case M_FETCH_GLOBAL_REAL: GLOBAL_FETCH(GET_REAL, PUSH_REAL); break; case M_FETCH_GLOBAL_ARRAY: GLOBAL_FETCH(GET_ARRAY, PUSH_ARRAY); break; case M_STORE_GLOBAL_INTEGER: GLOBAL_STORE(M_SIZE_INTEGER, GET_INT, PUT_INT); break; case M_STORE_GLOBAL_REAL: GLOBAL_STORE(M_SIZE_REAL, GET_REAL, PUT_REAL); break; case M_STORE_GLOBAL_ARRAY: GLOBAL_STORE(M_SIZE_ARRAY, GET_ARRAY, PUT_ARRAY); break; case M_GOTO: current_instruction_index = get_label(current_instruction_index); break; case M_GOTO_IF_ZERO: CONDITIONAL_GOTO(x == 0); break; case M_GOTO_IF_NOT_ZERO: CONDITIONAL_GOTO(x != 0); break; case M_GOTO_IF_POSITIVE: CONDITIONAL_GOTO(x > 0); break; case M_GOTO_IF_NOT_POSITIVE: CONDITIONAL_GOTO(x <= 0); break; case M_GOTO_IF_NEGATIVE: CONDITIONAL_GOTO(x < 0); break; case M_GOTO_IF_NOT_NEGATIVE: CONDITIONAL_GOTO(x >= 0); break; case M_GOTO_IF_FAILED: if(input_fail_flag) { current_instruction_index = get_label(current_instruction_index); } else current_instruction_index += INTERNAL_LABEL_SIZE; break; case M_GOTO_IF_EOF: {int c = getc(stdin); if(c == EOF) { current_instruction_index = get_label(current_instruction_index); } else { current_instruction_index += INTERNAL_LABEL_SIZE; ungetc(c, stdin); } break; } case M_CALL: {long nargs, loc; nargs = code_array[current_instruction_index]; loc = get_label(current_instruction_index + 1); current_instruction_index += 1 + INTERNAL_LABEL_SIZE; m_call(nargs, current_instruction_index); current_instruction_index = loc; break; } default: m_complain(COMPLAIN_UNKNOWN_INSTRUCTION); return; } # ifdef DEBUG if(trace) trace_instruction_result(current_instruction); if(trace > 1) { dump_stack(); dump_globals(); } # endif } } /************************************************************************ * DEBUG SUPPORT * ************************************************************************/ #ifdef DEBUG /************************************************************************ * TRACE_INSTRUCTION * ************************************************************************ * Show that the instruction at index instruction_index (which is * * instruction) is executing. This prints to the standard output. * ************************************************************************/ void trace_instruction(long instruction_index, M_BYTE instruction) { M_INT n,m; M_REAL r,s; M_ARRAY a; if(instruction < M_FIRST_EXECUTABLE_INSTRUCTION || instruction > M_LAST_INSTRUCTION) { printf("%ld : %d (bad instruction)", instruction_index, instruction); } else { int index = instruction - M_FIRST_EXECUTABLE_INSTRUCTION; printf("[%s] %ld: %s", get_function_name(instruction_index), instruction_index, instruction_name[index]); switch(instruction_class[index]) { case ONE_BYTE_INSTRUCTION: printf("\n"); break; case TWO_BYTE_INSTRUCTION: printf(" %d\n", code_array[instruction_index + 1]); break; case GOTO_INSTRUCTION: printf(" %ld\n", get_label(instruction_index + 1)); break; case CALL_INSTRUCTION: printf(" %d %ld\n", code_array[instruction_index + 1], get_label(instruction_index + 2)); } switch(instruction_trace_kind[index]) { case 0: case 6: n = GET_INT(machine_stack, stack_pointer - M_SIZE_INTEGER); printf(" Pop %ld\n", n); break; case 1: r = GET_REAL(machine_stack, stack_pointer - M_SIZE_REAL); printf(" Pop %f\n", r); break; case 2: a = GET_ARRAY(machine_stack, stack_pointer - M_SIZE_ARRAY); printf(" Pop array %ld\n", (long) a); break; case 3: n = GET_INT(machine_stack, stack_pointer - M_SIZE_INTEGER); m = GET_INT(machine_stack, stack_pointer - 2*M_SIZE_INTEGER); printf(" Pop %ld then %ld\n", n, m); break; case 4: case 5: s = GET_REAL(machine_stack, stack_pointer - M_SIZE_REAL); r = GET_REAL(machine_stack, stack_pointer - 2*M_SIZE_REAL); printf(" Pop %f then %f\n", s, r); break; case 7: n = GET_INT(machine_stack, stack_pointer - M_SIZE_INTEGER); a = GET_ARRAY(machine_stack, stack_pointer - M_SIZE_INTEGER - M_SIZE_ARRAY); printf(" Pop %ld then array %ld\n", n, (long) a); break; case 8: case 14: n = GET_INT(machine_stack, stack_pointer - M_SIZE_INTEGER); m = GET_INT(machine_stack, stack_pointer - 2*M_SIZE_INTEGER); a = GET_ARRAY(machine_stack, stack_pointer - (2*M_SIZE_INTEGER + M_SIZE_ARRAY)); printf(" Pop %ld then %ld then array %ld\n", n, m, (long) a); break; case 9: case 15: r = GET_REAL(machine_stack, stack_pointer - M_SIZE_REAL); m = GET_INT(machine_stack, stack_pointer - (M_SIZE_REAL + M_SIZE_INTEGER)); a = GET_ARRAY(machine_stack, stack_pointer - (M_SIZE_INTEGER + M_SIZE_REAL + M_SIZE_ARRAY)); printf(" Pop %f then %ld then array %ld\n", r, m, (long) a); break; default: {} } } } /************************************************************************ * TRACE_INSTRUCTION_RESULT * ************************************************************************ * Show that the result of an instruction after it has run. * ************************************************************************/ void trace_instruction_result(M_BYTE instruction) { M_INT n, index; M_REAL r; M_ARRAY a; if(instruction < M_FIRST_EXECUTABLE_INSTRUCTION || instruction > M_LAST_INSTRUCTION) { return; } index = instruction - M_FIRST_EXECUTABLE_INSTRUCTION; switch(instruction_trace_kind[index]) { case 3: case 5: case 11: case 14: n = GET_INT(machine_stack, stack_pointer - M_SIZE_INTEGER); printf(" Push %ld\n", n); break; case 4: case 12: case 15: r = GET_REAL(machine_stack, stack_pointer - M_SIZE_REAL); printf(" Push %f\n", r); break; case 6: case 13: a = GET_ARRAY(machine_stack, stack_pointer - M_SIZE_ARRAY); printf(" Push array %ld\n", (long) a); break; case 7: if(last_index_result_type == 0) { n = GET_INT(machine_stack, stack_pointer - M_SIZE_INTEGER); printf(" Push %ld\n", n); } else { r = GET_REAL(machine_stack, stack_pointer - M_SIZE_REAL); printf(" Push %f\n", r); } break; default: {} } } long get_param_boundary(long fp) { if(fp < 0) return -1; else { long npw = GET_LONG(machine_stack, fp + NUM_PARAMS_OFFSET); return fp - npw; } } /************************************************************************ * DUMP_STACK * ************************************************************************ * Dump the entire stack to standard output. * ************************************************************************/ void dump_stack(void) { int k; long next_fp = frame_pointer; long next_param = get_param_boundary(frame_pointer); if(stack_pointer > 0) { printf(" Stack(top to bottom): [* = param/ret boundary | = frame boundary]\n "); for(k = stack_pointer - 1; k >= 0; k--) { printf("%ld ", machine_stack[k]); if(k == next_fp) { printf("* "); next_fp = GET_LONG(machine_stack, k + DYNAMIC_LINK_OFFSET); } else if(k == next_param) { printf("| "); next_param = get_param_boundary(next_fp); } } printf("\n"); } } /************************************************************************ * DUMP_GLOBALS * ************************************************************************ * Dump the entire table of globals. * ************************************************************************/ void dump_globals(void) { int k; if(global_word_pointer > 0) { printf(" Globals:\n "); for(k = 0; k < global_word_pointer; k++) { printf("%ld ", global_table[k]); } printf("\n"); } } /************************************************************************ * DUMP_PROGRAM * ************************************************************************ * Dump the internal form of the byte code to the standard output. * ************************************************************************/ void dump_program(void) { long k,i; printf("Program dump:\n"); k = 0; while(k < byte_code_pointer) { for(i = 0; i < 10 && k < byte_code_pointer; i++,k++) { printf("%4d", code_array[k]); } printf("\n"); } } #endif /************************************************************************ * INITIALIZE * ************************************************************************ * Initialize sets up the interpreter's data structures and reads the * * byte code from file FILENAME.m, where FILENAME is the parameter * * string. * * * * The return value is TRUE on success, FALSE on failure. * ************************************************************************/ M_BOOL initialize(CSTRING filename) { FILE* m_file; M_BOOL status; int i; m_file = fopen(filename, "rb"); if(m_file == NULL) { return m_complain(COMPLAIN_CANNOT_READ_FILE, filename); } else { status = load_byte_code(m_file); fclose(m_file); } for(i = 0; i < LOCAL_OFFSET; i++) { machine_stack_data[i] = 0; } return status; } /************************************************************************ * USAGE_ERROR * ************************************************************************ * Print a usage error message. * ************************************************************************/ void usage_error(void) { fprintf(stderr, "machine [-d] [-t | -T] file.m\n"); } /************************************************************************ * MAIN * ************************************************************************/ int main(int argc, char** argv) { long start_loc; int k; M_BOOL do_dump = FALSE; k = 1; while(k < argc - 1) { if(strcmp(argv[k], "-d") == 0) do_dump = TRUE; else if(strcmp(argv[k], "-t") == 0) trace = 1; else if(strcmp(argv[k], "-T") == 0) trace = 2; else { usage_error(); return 1; } k++; } if(k != argc - 1) { usage_error(); return 1; } if(initialize(argv[k])) { # ifdef DEBUG if(do_dump) dump_program(); # endif if(start_function_name == NULL) { m_complain(COMPLAIN_NO_START_FUNCTION); } else { start_loc = get_function_index(start_function_name); if(start_loc < 0) { m_complain(COMPLAIN_UNKNOWN_FUNCTION, start_function_name); } else run(start_loc); } } return return_status; }