/* @(#)cc.c 17.1.1.1 (ES0-DMD) 01/25/02 17:47:36 */ /*=========================================================================== Copyright (C) 1995 European Southern Observatory (ESO) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, MA 02139, USA. Corresponding concerning ESO-MIDAS should be addressed as follows: Internet e-mail: midas@eso.org Postal address: European Southern Observatory Data Management Division Karl-Schwarzschild-Strasse 2 D 85748 Garching bei Muenchen GERMANY ===========================================================================*/ /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .TYPE Module .NAME cc.c .LANGUAGE C .AUTHOR Francois Ochsenbein [ESO-IPG] .CATEGORY C Compiler .PURPOSE .ENVIRONMENT Machines with 4-byte addresses. .COMMENTS This module allows the compilation (transformation into a `microcode') and the execution of the generated `microcode'. The original text is similar to C, with the following restrictions: \begin{TeX} \begin{itemize} \item Only 1-dimension arrays are allowed \item Pointers restricted to one level, and no pointer dereferencing is available (use p[0] instead of *p) \item no {\em do} statements, but only {\em while} and {\em for} \item {\em null} special value for integers / floating point numbers \end{itemize} The grammar is ({\em id} is an identifier name, which may be indexed with []): $$\begin{tabular}{rl} Declarations :& {\bf int} {\em id} {\bf ;} \\ $|$ & {\bf double} {\em id} {\bf ;} \\ $|$ & {\bf char} {\em id} {\bf ;} \\ $|$ & {\bf short} {\em id} {\bf ;} \\ statement : & {\em expr} {\bf ;} \\ $|$ & \{ {\em statement} \} \\ $|$ & {\em expr} {\bf , } {\em expr} {\bf ;} \\ $|$ & {\bf if (} {\em expr} {\bf )} {\em statement} \\ $|$ & {\bf if (} {\em expr} {\bf )} {\em statement} {\bf else} {\em statement} \\ $|$ & {\bf for(} {\em expr; expr; expr} {\bf )} {\em statement} \\ $|$ & {\bf while (} {\em expr} {\bf )} {\em statement} \\ $|$ & {\bf switch (} {\em expr} {\bf ) \{ } {\em statement}{\bf\}} \\ \end{tabular}$$ {\em expr} is a C expression with the following operators from lowest to highest priorities: $$\begin{tabular}{|r|l|} \hline Operators & Explanation \\ \hline {\bf =} \quad {\bf (op)=} & Assignments, possibly with operator \\ {\bf \&\&} \quad {\bf $|$ $|$} & Logical and or \\ {\bf \& \quad $|$ \quad \^{ }} & Bitwise and \quad or \quad exclusive or \\ {\bf $<$} \quad {\bf $<=$} \quad {\bf $==$} \quad {\bf $>=$} \quad {\bf $>$} \quad {\bf $!=$} & Relational comparison \\ {\bf $<<$} \quad {\bf $>>$} & Shift \\ {\bf $+$} \quad {\bf $-$} & (binary)\\ {\bf $*$} \quad {\bf $/$} \quad {\bf \%} & \% for modulo \\ {\bf $**$} & exponentiation \\ {\bf $++$} \quad {\bf $--$} & pre--incrementation / decrementation\\ {\bf $-$} \quad {\bf \~{ }} \quad {\bf !} \quad {\bf \&} & (unary)\\ \hline\end{tabular}$$ The reserved keywords are: $$\begin{tabular}{|lllllll|l|} \hline & & & char & short & int & double & declarations \\ return & if & else & for & while & break & continue & statements \\ & & & & & pi & null & standard values \\ sign &abs &sqrt & log & log10 & exp & & standard functions \\ cos & sin & tan & acos & asin & atan & atan2 & (argument in Radians) \\ cosd& sind& tand& acosd& asind & atand& atan2d& (argument in $\d$) \\ cosh& sinh& tanh& acosh& asinh & atanh& & hyperbolic functions \\ atoi& atof & & & & & & ascii to numeric \\ strlen&strupper& strlower& strred& & & ERROR & 1-argument string functions\\ strcopy& strcat& strindex&stuindex&strloc&strskip& 2-argument string functions\\ strdiff& studiff& & & & & String Comparisons (2-arg) \\ stritem& stuitem& & & & & Word in a list (3-arg)\\ strtrs& & & & & & Translate \\ \hline \end{tabular}$$ The execution of the `microcode' operates on a stack, and makes use of an index register for arrays. The code is made of 1 and 4-byte instructions: \begin{enumerate} \item 1-byte instructions: \begin{itemize} \item binary operations (applied on the two numbers which are on top of the stack): {\em A} ($+$) \quad {\em S} ($-$) \quad {\em D} ($/$) \quad {\em M} ($\times$) \quad {\em MOD} (modulo) \quad {\em BAND} (Bit And) \quad {\em BOR} (Bit Or) \quad {\em BXOR} (Bit Exclusive Or) \quad {\em LSH} (Left Shift) \quad {\em RSH} (Right Shift) \quad {\em SIC} (Store Indirect Character) \quad {\em SIH} (Store Indirect Short integer) \quad {\em SI} (Store Indirect Integer) \quad {\em SID} (Store Indirect Double) \quad \item unary operations (on the number which is on top of the stack) \qquad {\em NOP} (No Operation) \quad {\em CHS} (Negation $-x$) \quad {\em COMP} (Bit complement) \quad {\em ABSV} (Absolute Value $|x|$) \quad {\em SIGN} ($\frac{x}{|x|}$) \quad {\em NOT} (Boolean negation: $0$ if $x=0$, $1$ otherwise) \quad {\em LC} (Load Indirect Character) \quad {\em LH} (Load Indirect Short integer) \quad {\em L} (Load Indirect Integer) \quad {\em LD} (Load Indirect Double) \quad \item comparison operations (between the two numbers which are on top of the stack) {\em NE} ($\neq$)\quad {\em LT} ($<$)\quad {\em LE} ($\leq$)\quad {\em EQ} ($=$)\quad {\em GE} ($\geq$)\quad {\em GT} ($>$)\quad {\em AND} (boolean) {\em OR} (boolean) \item Other operations: {\em CLR} (Clear Stack) \quad {\em STX} (Store to Index) \quad {\em LX} (Move Index to Stack) \quad {\em SWAP} (Exchange the two numbers on top of the stack) \quad \end{itemize} \item 5-byte instructions: \begin{itemize} \item Jump instructions: {\em J} (Jump Unconditionnaly) \quad {\em JZ} (Jump if Zero) \quad {\em JNE} (Jump if Not Equal) \quad \item Load Instructions: {\em LAL} \quad {\em LAG} \quad to load Addresses from Local or Global space. \item Call instructions: {\em ICALL} to call a function returning an integer, {\em FCALL} to call a function returning a double. \end{itemize} \end{enumerate} \end{TeX} .VERSION 1.0 08-Dec-1988: Creation. .VERSION 1.1 20-Dec-1988: Be sure that allocated variables are initialized to zero. Added RETURN statement. .VERSION 1.2 17-Jan-1989: Allow expression like "string"[index] .VERSION 1.3 02-Mar-1989: Removed bug in opp .VERSION 1.4 10-Apr-1989: Added ** (exp) . Ported to Unix .VERSION 1.5 19-Jun-1989: Identifier may include a dot. Allow return can return something... Allow Permanent Definitions as cc_dcl. Take NULL numbers for integers / float numbers. .VERSION 1.6 27-Jun-1989: Solve alignments problems. .VERSION 2.0 15-Nov-1989: Allow pointers / switch / etc .VERSION 2.1 20-Mar-1990: Modified cc_glb to allow arrays. Added string functions. Allow switch on addresses (e.g. case &x[2]:) .VERSION 2.2 16-May-1990: Ensure crrect error messages from cc_glb (Symptom e.g. "char 0" gives an erroneous error message...) .VERSION 2.3 16-Oct-1990: Modified getx / ungetx .VERSION 2.4 08-Jun-1991: Added a few string functions .VERSION 2.5 05-Mar-1992: Removing dumplicated functions CG. Patch.01 ---------------------------------------------------*/ #define PM_LEVEL 12 typedef double (*FCT_PTR)(); /* Just to simplify ... */ typedef int (*INT_FCT)(); /* Just to simplify ... */ #define PASCAL_DEF 0 #include #include /* ASCII classification */ #include /* Standard string Utilities */ #include /* Standard library definitions */ #include /* String Utilities */ #include /* Automatic Buffers / Stacks */ #include /* For function definitions */ #define NULL1 -128 /* NULL for integer*n */ #define NULL2 -32768 /* NULL for integer*n */ #ifdef __alpha #define NULL4 (1u<<31)/* NULL for integer*n */ #else #define NULL4 (1L<<31)/* NULL for integer*n */ #endif #define NULLF -1.5e38 #define error0(t) error(NULL_PTR(char),NULL_PTR(char)) #define error1(t) error(t,NULL_PTR(char)) #ifdef isid #undef isid #undef isid1 #endif #define isid(c) (isalnum(c) || (c == '_') || (c == '$')|| (c == '.')) #define isid1(c) (isalpha(c) || (c == '_') || (c == '$')) #if DEBUG /* Main Program only in DEBUG option */ #define ENTER_DEBUG(x) ENTER(x) #define EXIT_DEBUG(x) EXIT(x) #define TRACE_DEBUG(x) TRACE(x) #else #define ENTER_DEBUG(x) /* */ #define TRACE_DEBUG(x) /* */ #define EXIT_DEBUG(x) return(x) #endif #define SYMSIZE 44 /* Maximum length of a symbol */ #define STACKSIZE 32 /* Maximum length of operation stack */ /* Definition of mask for Variable types */ #define _LOCAL_ 0x08 #define _VARIABLE_ 0x10 #define _ARRAY_ 0x20 #define _POINTER_ 0x30 #define _INT_ 0 #define _CHAR_ 1 #define _SHORT_ 2 #define _DOUBLE_ 3 /* Definition of Instruction Set. 5-byte instructions have the 0x40 bit clear, 1-byte this 0x40 bit set. */ #define J 0x01 /* Jump */ #define JZ 0x02 /* Jump if Zero */ #define JNE 0x03 /* Jump if NotEq */ #define BADOP 0x0B /* Bad Operator */ #define LAL 0x0E /* Load Local */ #define LAG 0x0F /* Load Global */ #define ICALL 0x20 /* Call Function */ #define FCALL 0x30 /* Call Function */ #define A 0x41 /* Add */ /* Binary Operators */ #define S 0x42 /* Substract */ #define M 0x43 /* Multiply */ #define D 0x44 /* Divide */ #define MOD 0x45 /* Modulo */ #define BXOR 0x46 /* Bit Xor */ #define BAND 0x47 /* Bit And */ #define BOR 0x48 /* Bit Or */ #define POW 0x49 /* Exponent */ #define LSH 0x4E /* Left Shift */ #define RSH 0x4F /* Right Shift */ #define EQ 0x50 /* Comparisons */ #define NE 0x51 #define LT 0x52 #define GE 0x53 #define GT 0x54 #define LE 0x55 #define AND 0x56 #define OR 0x57 #define L 0x60 /* Load Int */ #define LC 0x61 /* Load Char */ #define LH 0x62 /* Load Short */ #define LD 0x63 /* Load Double */ #define ST 0x68 /* Store Int */ #define STC 0x69 /* Store Char */ #define STH 0x6A /* Store Short */ #define STD 0x6B /* Store Double */ #define NOT 0x70 /* ! */ /* Unary Operators */ #define CHS 0x71 /* - */ /* Unary Operators */ #define COMP 0x72 /* ~ */ /* Unary Operators */ #define ABSV 0x73 /* Unary Operators */ #define SIGN 0x74 /* Unary Operators */ #define RET 0x77 #define STX 0x78 /* Store to Index Register */ #define LX 0x79 /* Load from Index Register */ #define SWAP 0x7D /* Exchange values on top of stack */ #define CLR 0x7E /* Clear Registers */ #define NOP 0x7F #define isUnaryOperator(x) (x&0x78)==0x70 #define isBinaryOperator(x) (x&0x60)==0x40 #define NONE 0 static unsigned char sizel[8] = { /* Size of atomic elements */ sizeof(int), 1, sizeof(short), sizeof(double), sizeof(int), sizeof(int), sizeof(int), sizeof(int) }; /* Definition of Token Classes */ #define UNARY 2 #define POSTFIX 1 /* Postfix operators */ #define isUnaryToken(x) ((x&0xff00)==(UNARY<<8)) #define isPostfixToken(x) ((x&0xff00)==(POSTFIX<<8)) #define POST_INCREMENT (0xFA|(POSTFIX<<8)) #define POST_DECREMENT (0xFB|(POSTFIX<<8)) #define INCREMENT (0xFA|(UNARY<<8)) #define DECREMENT (0xFB|(UNARY<<8)) #define ADROF (0xFE|(UNARY<<8)) #define INDIRECT (0xFF|(UNARY<<8)) #define ASSIGN_PRIO 11 /* The highest prio number */ #define ASSIGN (ASSIGN_PRIO<<8) /* = +=, etc */ #define FCT 0x1000 /* Function */ #define ID 0x2000 /* Identifier */ #define KEYWORD 0x2100 /* Reserved keywords, e.g. switch */ #define INUM (ID|_LOCAL_|_INT_) /* Constants: */ #define FNUM (ID|_LOCAL_|_DOUBLE_|_VARIABLE_) #define SNUM (ID|_LOCAL_|_ARRAY_|_CHAR_) /* String */ #define CDCL (ID|0xF0|_CHAR_) /* Variable char */ #define IDCL (ID|0xF0|_INT_) /* integer */ #define FDCL (ID|0xF0|_DOUBLE_) /* float */ #define HDCL (ID|0xF0|_SHORT_) /* Short */ #define NULLval (KEYWORD|0x00) #define IF (KEYWORD|0x10) #define ELSE (KEYWORD|0x11) #define WHILE (KEYWORD|0x12) #define FOR (KEYWORD|0x13) #define SWITCH (KEYWORD|0x14) #define DEFAULT (KEYWORD|0x15) #define RETURN (KEYWORD|RET) #define BREAK (KEYWORD|0x80|J) #define CASE (KEYWORD|0x80|JNE) #define CONTINUE (KEYWORD|0x80|JZ) #define DONE 0x3fff /* The `Codes' are stored in a dedicated buffer; * The index in this Codes buffer is returned by cc_compile. * a summary of the current statement is copied to stmt_code buffer. */ typedef struct { /* CODE structure */ BUFFER bop; /* Collects the `code' */ BUFFER var; /* Collects local variables */ } CODE; static BUFFER Codes = SET_Init(CODE, 4); static CODE *Code = NULL_PTR(CODE); /* The current Code */ static BUFFER stmt_code = SET_Init(char, 128);/* Operations for one stmt */ /* Declare variables required for the lexical analysis */ static char lexbuf[SYMSIZE+3]; static long l_token = 0; static double *a_token; static char *token_name = (char *)0;/* Name of the variable / token */ static int old_token = NONE; static int lookahead = 0; static int stmt_start = 0; /* Index Code->bop of current stmt */ static int expr_flags = 0; /* Set to 1 for Constant Expressions */ static int found_errors; /* Collects the errors */ static int lineno = 1; /* Symbols are stored in two buffers (global / local), * but names are pooled in a third buffer */ typedef struct { /* Symbol element */ double *addr; /* Address */ short token; /* Token class */ short name; /* Index in symnames */ } SYMBOL; static BUFFER sym_glob = SET_Init(SYMBOL, 128); /* Global sybols */ static BUFFER symlocal = SET_Init(SYMBOL, 32); /* Local symbols */ static BUFFER symnames = BUF_Init(char, 512); /* Pool of names */ #define SymbolName(ps) (symnames.buf + ps->name) /* during the execution phase (cc_exec), operations are made * on a stack. Three stacks are used, for datatypes (regt), * integer / addresses (regi) and double-float (regf) */ static unsigned char regt[STACKSIZE]; /* 0 = INT, 1 = DOUBLE */ static double regf[STACKSIZE]; static int regi[STACKSIZE]; static int *call_stack; static int xreg, ireg; /* xreg = index register */ static char *source, *pstmt, *psource, *pmatched; /* Operators are listed as name, priority, symbol value */ static unsigned char op_list1[] = { /* Single letter symbols */ '=', ASSIGN_PRIO, 0, '&', 8, BAND, '|', 8, BOR, '^', 8, BXOR, '<', 7, LT, '>', 7, GT, '+', 5, A, '-', 5, S, '*', 4, M, '/', 4, D, '%', 4, MOD, '!', UNARY, NOT, '~', UNARY, COMP, '-', UNARY, CHS, '+', UNARY, NOP, '&', UNARY, (unsigned char)ADROF, /* '*', UNARY, INDIRECT, */ EOS }; static unsigned char op_list2[] = { /* Two letters symbols */ '*', '*', 3, POW, '&', '&', 9, AND, '|', '|', 9, OR, '<', '=', 7, LE, '=', '=', 7, EQ, '>', '=', 7, GE, '!', '=', 7, NE, '<', '<', 6, LSH, '>', '>', 6, RSH, '+', '+', POSTFIX, (unsigned char)POST_INCREMENT, '-', '-', POSTFIX, (unsigned char)POST_DECREMENT, '+', '+', UNARY, (unsigned char)INCREMENT, '-', '-', UNARY, (unsigned char)DECREMENT, '+', '=',ASSIGN_PRIO, A, '-', '=',ASSIGN_PRIO, S, '*', '=',ASSIGN_PRIO, M, '/', '=',ASSIGN_PRIO, D, '%', '=',ASSIGN_PRIO, MOD, '&', '=',ASSIGN_PRIO, BAND, '|', '=',ASSIGN_PRIO, BOR, '^', '=',ASSIGN_PRIO, BXOR, EOS }; static unsigned char op_list3[] = { /* Three letters symbols */ '<', '<', '=', ASSIGN_PRIO, LSH, '>', '>', '=', ASSIGN_PRIO, RSH, EOS }; static unsigned char *op_list[] = { /* List of list of symbols */ op_list1, /* 1-letter symbols */ op_list2, /* 2-letter symbols */ op_list3 /* 3-letter symbols */ }; #define issign(c) ((c == '+') || (c == '-')) #define FINISH goto FIN /* For boundary limits, use local variables */ static short the_short; static int the_int; static double the_double; static char *the_pointer; #define CodeCounter Code->bop.used #define copy(d,s,l) oscopy((char *)d, (char *)s, l) #define copy_int(d,s) copy(d, s, sizeof(int)) #define HereIsJumpTarget(o) oscopy(Code->bop.buf + o, \ (char *)&(Code->bop.used), sizeof(int)) #define SetJumpTarget(o, where_to_jump) oscopy(Code->bop.buf + o, \ (char *)&(where_to_jump), sizeof(int)) /* Static recursive functions are declared */ static int expr0(), expr(), opp(), stmt(), cst_expr(), execode(); /*===========================================================================*/ static int getx() /*+++++ .PURPOSE Get next char .RETURNS Next char --------------*/ { int c; c = *(psource++); if (c == '\n') lineno += 1; return(c); } static int ungetx() /*+++++ .PURPOSE Get next char .RETURNS Deleted char --------------*/ { int c; c = *(--psource); if (c == '\n') lineno -= 1; return(c); } /*===========================================================================*/ static char *atok(t, islookahead) /*+++++ .PURPOSE Transform token to a comprehensive text .RETURNS Pointer to text .REMARKS --------------*/ int t; /* IN: token class */ int islookahead; /* IN: 1 if token has symbol in lexbuf */ { static char text[SYMSIZE+24]; char *p; p = NULL_PTR(char); if (t < 0xff) /* Single character */ islookahead = 0, text[0] = '`', text[1] = t, text[2] = '\'', text[3] = EOS; else if (t < FCT) /* = += -=, etc... */ p = "Operator"; else if (t < ID) /* Identifier */ p = "function"; else if ((t == INUM) || (t == FNUM)) islookahead = 0, p = "Constant"; else if (t == SNUM) islookahead = 0, p = "stringConstant"; else if (t < (ID|0xF0)) /* Identifier */ p = "Identifier"; else if (t < KEYWORD+0x100) p = "keyword"; else if (t == DONE) islookahead = 0, p = "end-of-source"; else p = "??"; if (p) { p = text + strcopy(text, p); if (islookahead) *(p++) = ' ', *(p++) = '`', p += strcopy(p, lexbuf), *(p++) = '\'', *p = EOS; } return(text); } /*===========================================================================*/ static int error(txt, str) /*+++++ .PURPOSE Error report .RETURNS Error count .REMARKS Error always logged on two lines --------------*/ char *txt; /* IN: Text of error text */ char *str; /* IN: Continuation of error */ { static char errmsg[] = "Error in line 9999: "; int no, i; oscfill(&errmsg[sizeof(errmsg)-7], 4, ' '); for (i = sizeof(errmsg)-3, no = lineno; no; no /= 10) errmsg[--i] = '0' + no%10; i = 1 + strloc(source, ';'); ERR_ED_STR2(errmsg, source, i); found_errors += 1; if(txt) if (str) ERR_ED_STRING(txt, str); else ERROR(txt); return(found_errors); } /*===========================================================================*/ static int align(token_class) /*+++++ .PURPOSE Align variables in Code->var buffer .RETURNS Number of bytes required. .REMARKS --------------*/ int token_class; /* IN: Class of variable to insert */ { int b; /* Number of bytes */ int padd; if ((token_class & (_POINTER_|_ARRAY_|_VARIABLE_)) == _POINTER_) b = sizeof(char *); else b = sizel[token_class&7]; if(b) { padd = (Code->var).used % b; if (padd) (Code->var).used += (b-padd); } return(b); } /*===========================================================================*/ static SYMBOL *lookup(s) /*+++++ .PURPOSE Lookup .RETURNS Pointer to relevant entry / NULL if fail .REMARKS Table is scanned from end, i.e. in case of synonyms the lastest entered will be found. --------------*/ char *s; /* IN: String to locate */ { SYMBOL *p; /* Look first in Local symbols ... */ if (symlocal.buf) for (p = (SYMBOL *)(symlocal.buf + symlocal.used); --p >= (SYMBOL *)(symlocal.buf) ; ) if (strcomp(s, symnames.buf + p->name) == 0) return(p); /* ... then in Global symbols ... */ for (p = (SYMBOL *)(sym_glob.buf + sym_glob.used); --p >= (SYMBOL *)(sym_glob.buf) ; ) if (strcomp(s, symnames.buf + p->name) == 0) return(p); return(NULL_PTR(SYMBOL)); } static SYMBOL *insert(s, tok, atok) /*+++++ .PURPOSE Insert symbol .RETURNS Allocated symbol address .REMARKS Don't check if name already exists. --------------*/ char *s; /* IN: Symbol Name to Insert, or NULL */ int tok; /* IN: Token Class */ double *atok; /* IN: Related function / value */ { SYMBOL new, *p; BUFFER *b; new.name = 0; /* When constant */ new.token= tok; new.addr = atok; if (s) new.name = symnames.used, BUF_SaveString(&symnames, s); b = (tok & _LOCAL_ ? &symlocal : &sym_glob); p = BUF_AppendItem (b, SYMBOL, &new); token_name = symnames.buf + new.name; return(p); } static SYMBOL *pops() /*+++++ .PURPOSE Remove latest entered symbol from Local Table .RETURNS Address of popped symbol --------------*/ { SYMBOL *ps; if (symlocal.used) symlocal.used -= sizeof(SYMBOL), ps = (SYMBOL *)(symlocal.buf + symlocal.used); else ps = NULL_PTR(SYMBOL); return(ps); } /*===========================================================================*/ static int pop_op(error_text) /*+++++ .PURPOSE Remove the top operation, if it is a load operation. .RETURNS The operator .REMARKS Typically used for ADROF (&) --------*/ char *error_text; /* IN: Text to print if op is not a Load */ { int tp; /* previous Instruction */ /* Previous Instruction */ tp = stmt_code.buf[stmt_code.used-1]; if ((tp >= L) && (tp < ST)) /* OK, remove */ --(CodeCounter), --(stmt_code.used); else tp = 0, error1(error_text); return(tp); } /*===========================================================================*/ static int do_prefix(op, offset) /*+++++ .PURPOSE Insert in the code what to do for a ++ / -- operation .RETURNS The operator .REMARKS --------*/ int op; /* IN: The load operator */ int offset; /* IN: Value to add */ { static struct { char p1[5]; char a[sizeof(int)]; char p2[2];} ops = { { STX, LX, LX, L, LAG}, {0}, {A, ST}} ; stmt_code.buf[stmt_code.used++] = NOP; /* This is a short cut to avoid an LAG instruction in the current statement summary. */ ops.p1[3] = op; /* The Load Operator */ ops.p2[1] = ST | (op&7); /* The peculiar store */ the_int = offset, copy_int(ops.a, &the_int); BUF_AppendItems(&(Code->bop), char, &ops, sizeof(ops)); return(op); } static int do_postfix(op, offset) /*+++++ .PURPOSE Insert in the code what to do for a ++ / -- operation .RETURNS The operator .REMARKS --------*/ int op; /* IN: The load operator */ int offset; /* IN: Value to add */ { static struct { char p1[8]; char a[sizeof(int)]; char p2[3];} ops = {{ STX, LX, LX, L, SWAP, LX, L, LAG}, {0}, {A, ST, STX}} ; stmt_code.buf[stmt_code.used++] = NOP; /* This is a short cut to avoid an LAG instruction in the current statement summary. */ ops.p1[3] = op, ops.p1[6] = op; /* The Load Operator */ ops.p2[1] = ST | (op&7); /* The peculiar store */ the_int = offset, copy_int(ops.a, &the_int); BUF_AppendItems(&(Code->bop), char, &ops, sizeof(ops)); return(op); } static int do_assign(op, assign_op) /*+++++ .PURPOSE Insert in the code what to do for x ASSIGN result. .RETURNS The operator .REMARKS --------*/ int op; /* IN: The load operator */ int assign_op; /* IN: The assign operator */ { static char ops[] = { SWAP, STX, LX, SWAP, LX, L, A} ; int the_op; the_op = (assign_op & 0xff); if (the_op) { ops[5] = op, ops[6] = the_op; BUF_AppendItems(&(Code->bop), char, ops, sizeof(ops)); BUF_AppendItems(&(stmt_code), char, ops, sizeof(ops)); } ops[6] = ST | (op&7); BUF_AppendItem(&(Code->bop), char, &ops[6]); BUF_AppendItem(&(stmt_code), char, &ops[6]); return(op); } /*===========================================================================*/ static int emit(t, aval) /*+++++ .PURPOSE Generates the Program in (Code->bop) buffer. .RETURNS The operator which is on top of the stack. .REMARKS stmt_code just keeps instructions for the current statement. --------*/ int t; /* IN: Token class */ double *aval; /* IN: Variable / function address */ { int tc, tp; /* Instructions: current, previous */ int len; char *pop, *pcode; char op; double *adr; static char CLR_instruction = CLR; /* If it's a new statement (instruction CLR), avoid consecutive * CLR statements, and prepare source pointer for * eventual error messages */ tc = t & 0xff; if (t == CLR) { if (expr_flags & 1) return (0); /* Constant Expression */ if (pstmt) source = pstmt + strspan(pstmt, _SPACE_); if ((stmt_code.used) && (CodeCounter)) { if (stmt_code.buf[stmt_code.used-1] == CLR) CodeCounter -= 1; } BUF_Clear(&stmt_code); stmt_start = CodeCounter; BUF_AppendItem(&(stmt_code), char, &CLR_instruction); BUF_AppendItem(&(Code->bop), char, &CLR_instruction); return(tc); } if (stmt_code.used == 0) BUF_AppendItem(&(stmt_code), char, &CLR_instruction); pop = &stmt_code.buf[stmt_code.used-1], tp = *pop; /* tp = Previous Instruction */ /* Examine special instructions: & (ADROF) and ++ -- */ switch(t) { case ADROF: return(pop_op("Bad address-of (&)")); case INCREMENT: if (tp = pop_op("Bad ++ prefix")) do_prefix(tp, 1); return(tp); case POST_INCREMENT: if (tp = pop_op("Bad ++ postfix")) do_postfix(tp, 1); return(tp); case DECREMENT: if (tp = pop_op("Bad -- prefix")) do_prefix(tp, -1); return(tp); case POST_DECREMENT: if (tp = pop_op("Bad -- postfix")) do_postfix(tp, -1); return(tp); } op = tc; BUF_AppendItem(&(Code->bop), char, &op); BUF_AppendItem(&(stmt_code), char, &op); /* Reduce the constants which are stored as LAG followed by operators */ if ((tc & 0x40) == 0) /* Need an address */ adr = aval, BUF_AppendItem(&(Code->bop), double *, &adr); else if ((tp == CLR)&&(tc != RET)) /* First operation in stmt */ error1("Missing variable ?"); else if (tp == LAG) /* There is an operation. Check if constant */ { len = 0; if (isUnaryOperator (tc)) len = 1; /* Unary Operation */ else if (isBinaryOperator(tc)) { tp = *(--pop); if ( (tp == LAL) || (tp == LAG)) /* Binary Operation */ len = 2; } if(len) { stmt_code.used -= (1+len); len = len*sizeof(int) + (1+len); CodeCounter -= len; pcode = Code->bop.buf+CodeCounter; /* -> LAL or LAG */ *pcode = LAG; emit(tp, execode(Code->bop.buf+CodeCounter, len)); } else /* Check if previous number isn't just the neutral el.*/ { copy_int(&the_int, Code->bop.buf + (CodeCounter-1-sizeof(int))); if (the_int == 0) len = (tc == A)||(tc == S)||(tc == OR) ||(tc == BXOR)||(tc == BOR)||(tc == LSH)||(tc == RSH); else if (the_int == 1) len =(tc == M)||(tc == D)||(tc == AND)||(tc == POW); if(len) stmt_code.used -= 2, CodeCounter -= (2+sizeof(int)); } } return(tc); } static int emito(op) /*+++++ .PURPOSE Just emit a codop, without address .RETURNS The operator .REMARKS --------*/ int op; /* IN : op code */ { return(emit(op, NULL_PTR(double))); } static int emita(token, addr) /*+++++ .PURPOSE Just emit a codop, without address .RETURNS The operator .REMARKS --------*/ int token; /* IN: The identifier description */ double *addr; /* IN: Where id is located */ { return(emit((token&_LOCAL_ ? LAL : LAG), addr)); } /*===========================================================================*/ static int match_comment() /*+++++ .PURPOSE Match the end of a comment .RETURNS OK / NOK .REMARKS Don't forget to count the newlines... -------*/ { int t, stat; ENTER_DEBUG("match_comment"); TRACE_DEBUG(psource); stat = OK; while (t = getx()) { if (t != '*') continue; t = getx(); /* Char following the * must be a / ... */ if (t == '/') break; if (t == EOS) break; ungetx(); } if (t == EOS) stat = NOK, error1("Non-terminated comment"); EXIT_DEBUG(stat); } /*===========================================================================*/ static int match_num() /*+++++ .PURPOSE Match a number (double floating), also in hexa form (0x...) .RETURNS Type (int / float) as INUM / FNUM (number stored in local buffer) .REMARKS Number stored in l_token (integer) or a_token (offset in Code->var) -------*/ { char x; int i, stat; char t; double *aval; char the_number[80]; ENTER_DEBUG("match_num"); TRACE_DEBUG(psource); l_token = 0, stat = INUM, i = 0; while( (t = getx()) == '0'); /* Skip leading zeroes, not significant */ if (tolower(t) == 'x') /* It's 0x hexa representation... */ { for (t = getx(); isxdigit(t); t = getx()) { if (isdigit(t)) i = t - '0'; else i = toupper(t) - ('A' - 10); l_token = (l_token<<4) | i; } ungetx(); FINISH; } while(isdigit(t) && (i < sizeof(the_number)-3)) the_number[i++] = t, t = getx(); /* Take digits before the . */ if (t != '.') goto GET_VALUE; /* Integer Number */ stat = FNUM; the_number[i++] = t, t = getx(); while(isdigit(t) && (i < sizeof(the_number)-3)) the_number[i++] = t, t = getx(); /* Take digits after the . */ /* Look for Exponent */ if (isalpha(t)) { x = toupper(t); if ((x == 'E') || (x == 'D')) /* Exponent */ { the_number[i++] = 'e', t = getx(); if (issign(t)) the_number[i++] = t, t = getx(); while(isdigit(t) && (i < sizeof(the_number)-1)) the_number[i++] = t, t = getx(); } } GET_VALUE: the_number[i] = EOS; /* Terminate the String */ ungetx(); if (stat == FNUM) /* Double */ { align(FNUM); a_token = (double *)(Code->var).used; aval = BUF_AllocateItem(&(Code->var), double); *aval = atof(the_number); insert(NULL_PTR(char), stat, a_token); } else l_token = atol(the_number); FIN: EXIT_DEBUG(stat); } /*===========================================================================*/ static int match_char() /*+++++ .PURPOSE Match a character x or \x .RETURNS INUM .REMARKS Number stored in l_token -------*/ { int i; char t; ENTER_DEBUG("match_char"); TRACE_DEBUG(psource); l_token = 0; if ((t = getx()) == '\\') switch(t = getx()) { case 'n': l_token = '\n'; break; /* Newline */ case 'r': l_token = '\r'; break; /* */ case 't': l_token = '\t'; break; /* Horiz. Tab */ case 'b': l_token = '\b'; break; /* Backspace */ case 'f': l_token = '\f'; break; /* Form Feed */ default : l_token = t; break; case '0': case '1': case '2': case '3': /* Octal number */ for(i=3; (--i >= 0) && isdigit(t); t = getx()) l_token = l_token*8 + (t - '0'); if ((i < 0) || !isdigit(t)) ungetx(); break; } else l_token = (unsigned char)t; EXIT_DEBUG(INUM); } /*===========================================================================*/ static int match_str() /*+++++ .PURPOSE Match a string, and copy it to local buffer. .RETURNS SNUM .REMARKS Position of string in Code->var buffer is stored as a_token -------*/ { int i; char t; ENTER_DEBUG("match_str"); TRACE_DEBUG(psource); i = (Code->var).used; /* Where the string is stored */ for (l_token = 0, match_char(); l_token != '\"'; match_char()) { t = l_token; BUF_AppendItem(&(Code->var), char, &t); } t = 0, BUF_AppendItem(&(Code->var), char, &t); /* Append the EOS */ if (l_token != '\"') error1("Non-terminated string constant"); a_token = (double *)i; /* Position of String */ insert(NULL_PTR(char), SNUM, a_token); EXIT_DEBUG(SNUM); } /*===========================================================================*/ static int match_op(unary) /*+++++ .PURPOSE Match an operator .RETURNS Token class as (prio*256 + op) / NONE .REMARKS Unary / binary checked here. -------*/ int unary; /* IN: 1 for unary operator */ { unsigned char *p; unsigned char t, next_byte; int n; ENTER_DEBUG("match_op"); TRACE_DEBUG(psource); /* Get the maximal number of characters */ for (n = 0; n < ITEMS(op_list); n++) { lexbuf[n] = getx(); if_not(ispunct(lexbuf[n])) { ungetx(); break; } } lexbuf[n] = EOS; /* Compare from longest to shortest symbols */ for (; n > 0; n--) { for (p = op_list[n-1]; *p; p += n+2) { t = (unary ? UNARY : *(p+n)); if ( t != *(p+n)) continue; if (oscomp((char *)p, (char *)lexbuf, n) == 0) break; } if (*p) break; ungetx(); } if (n) p += n+1, n = (t<<8) + *p; EXIT_DEBUG (n); } /*===========================================================================*/ static int match_id() /*+++++ .PURPOSE Match an identifier. .RETURNS Token class as found in tables, or ID when new identifier .REMARKS a_token contains on return the address of the variable, and token_name the address of the variable name. -------*/ { int tc, b; SYMBOL *p; char t; ENTER_DEBUG("match_id"); TRACE_DEBUG(psource); t = getx(), b = 0, tc = ID; while ((isid(t)) && (b < SYMSIZE)) { lexbuf[b++] = t; t = getx(); } token_name = lexbuf; if (b >= SYMSIZE) error("Too long symbol: ", lexbuf); lexbuf[b] = EOS, ungetx(); p = lookup(lexbuf); if(p) a_token = p->addr, tc = p->token, token_name = symnames.buf + p->name; EXIT_DEBUG(tc); } /*===========================================================================*/ static int lexan(old_token) /*+++++ .PURPOSE Lexical Analyzer .RETURNS Token Symbol .REMARKS --------------*/ int old_token; /* IN: Previous token (to check unary / binary) */ { int tc; char t, unary; ENTER_DEBUG("lexan"); TRACE_DEBUG(psource); while(1) { switch(t = getx()) { case EOS: tc = DONE; FINISH; case '/': /* Check for Comments */ t = getx(); if (t == '*') /* It's a comment */ { match_comment(); continue; } ungetx(); t = '/'; break; case '\'': /* Character */ tc = match_char(); if (getx() != '\'') error1("Missing ' in Character"); FINISH; case '\"': /* String */ tc = match_str(); FINISH; case ';': pstmt = psource; /* Keep position of stmt */ case '(': case ')': case ',': case ':': case '{': case '}': case '[': case ']': tc = t; FINISH; } if(isspace(t)) continue; if (isdigit(t) || (t == '.')) /* Check for a Number */ { ungetx(); tc = match_num(); break; } if (isid1(t)) /* Check for Known Identifier */ { ungetx(); tc = match_id(); break; } /* Check now for Operators; we know that in some conditions it can ONLY be binary, which helps to solve ambiguities */ if ( (old_token == ')') || (old_token == ']') || ((old_token >= FCT) && (old_token < IDCL)) || isPostfixToken(old_token)) unary = 0; /* Binary Operator */ else unary = 1; ungetx(); tc = match_op(unary); if (tc != NONE) break; /* No token matched. Use just the next byte */ tc = getx(); break; } FIN: EXIT_DEBUG(tc); } /*===========================================================================*/ static int match(t) /*+++++ .PURPOSE Check if next token matches specified type .RETURNS OK / NOK .REMARKS --------------*/ int t; /* IN: token class to match */ { char msg[2*SYMSIZE + 28], *p; int stat; ENTER_DEBUG("match"); #if DEBUG TRACE_ED_I("Matching ", t); TRACE_ED_I("lookahead = ", lookahead); #endif stat = OK; if (lookahead != t) { stat = NOK, p = msg + strcopy(msg, "Got "); p += strcopy(p, atok(lookahead, 1)); p += strcopy(p, " when waiting for "); p += strcopy(p, atok(t, 0)); error1(msg); } else old_token = lookahead, lookahead = lexan(lookahead); EXIT_DEBUG(stat); } /*===========================================================================*/ static int init_char() /*+++++ .PURPOSE Used by declare, in case there is an initialisation for a char (e.g. declaration char x=0) .RETURNS not-zero if number found / 0 if not found .REMARKS -------*/ { int r; char *p; r = cst_expr(); if (r == LAL) error1("Bad initialisation..."); p = BUF_AllocateItem(&(Code->var), char); *p = l_token; return(r); } static int init_short() /*+++++ .PURPOSE Used by declare, in case there is an initialisation for a short (e.g. declaration short x=0) .RETURNS not-zero if number found / 0 if not found .REMARKS -------*/ { int r; short *p; r = cst_expr(); if (r == LAL) error1("Bad initialisation..."); p = BUF_AllocateItem(&(Code->var), short); *p = l_token; return(r); } static int init_int() /*+++++ .PURPOSE Used by declare, in case there is an initialisation for an int (e.g. declaration int x=0) .RETURNS not-zero if number found / 0 if not found .REMARKS -------*/ { int r; int *p; r = cst_expr(); if (r == LAL) error1("Bad initialisation..."); p = BUF_AllocateItem(&(Code->var), int); *p = l_token; return(r); } static int init_double() /*+++++ .PURPOSE Used by declare, in case there is an initialisation for a double (e.g. declaration double x=0) .RETURNS not-zero if number found / 0 if not found .REMARKS -------*/ { int r; double *p; if (lookahead == FNUM) /* Already in buffer: remove symbol */ r = 1, match(lookahead), pops(); else { r = cst_expr(); if (r == LAL) error1("Bad initialisation..."); p = BUF_AllocateItem(&(Code->var), double); *p = l_token; } return(r); } /*===========================================================================*/ static int declare(token_class) /*+++++ .PURPOSE Match a declaration, and allocate space in variable buffer. .RETURNS The array size .REMARKS -------*/ int token_class; /* IN: Type of variable to declare, e.g. _CHAR_|_LOCAL_*/ { int n, tc, na, la; SYMBOL *ps; int (*f)(); static INT_FCT init_fct[] = { init_int, init_char, init_short, init_double, init_int, init_int, init_int, init_int }; tc = (token_class & 0xff) | ID; if (lookahead == '*') tc |= _POINTER_, match('*'); if (lookahead != ID) error(atok(lookahead, 1), ": already declared ?"); if (tc & _LOCAL_) /* Local allocation. Align variable */ la = align(tc), /* Size of 1 item */ a_token = (double *)Code->var.used; ps = insert(lexbuf, tc, a_token); /* Insert Symbol */ match(lookahead); n = 1; /* Default length for arrays */ if (lookahead == '[') { match('['); if (cst_expr() == LAL) error1("Bad array size !"); n = l_token; /* Void expression returns 0 in l_token */ if (n < 0) n = 0, error1("Size of an array can't be Negative! "); match(']'); if (tc & _POINTER_) error1("I don't (yet?) support Arrays of pointers"); tc |= _ARRAY_; } else if (tc & _ARRAY_) ; else tc |= _VARIABLE_; /* Allocate space and initialize to zero */ if (tc & _LOCAL_) /* Local allocation. Look also for init */ { na = 0; /* Number of initialized items */ if (lookahead == ASSIGN) { match(lookahead); f = init_fct[tc&7]; if (n == 1) /* Not an array. */ na = 1, (*f)(); else if (lookahead == SNUM) /* String: get used bytes */ na = Code->var.used - (int)(ps->addr), pops(), match(lookahead); else if (lookahead == '{') /* Array */ { while (lookahead != DONE) { match(lookahead); (*f)(), na++; if (lookahead != ',') break; } match('}'); } } if (n > na) /* Uninitialized item(s) */ n = (n-na)*la, oscfill(BUF_AllocateItems(&(Code->var), char, n), n, 0); if ((n == 0) && (na == 0)) error("Zero size for: ", SymbolName(ps)); } ps->token = tc; return(tc); } /*===========================================================================*/ static int gotos(t0, t1, continue_target) /*+++++ .PURPOSE Replace continue and break statements .RETURNS OK .REMARKS --------------*/ int t0; /* IN: starting loop (target of continue) */ int t1; /* IN: end of loop (target of break) */ int continue_target; /* IN: what to use for `continue' */ { unsigned char *pop, *popo, *pope, op; ENTER_DEBUG("gotos"); popo = (unsigned char *)(Code->bop).buf; for (pop = popo + t0, pope = popo + t1; pop < pope; ) { popo = pop, op = *(pop++); if (op & 0x40) /* Binary Operation */ continue; the_int = -1; switch(op) { case 0xff&CONTINUE: the_int = continue_target; break; case 0xff&BREAK: the_int = t1; break; } if (the_int != -1) /* Copy the Addresses of Jump */ *popo = J, copy_int(pop, &the_int); pop += sizeof(int); } EXIT_DEBUG(OK); } /*===========================================================================*/ static int cc_index(tok) /*+++++ .PURPOSE Find the index as [ expr ] .RETURNS The index number .REMARKS ---------*/ int tok; /* IN: Token class */ { int size1; size1 = sizel[tok&7]; /* Size of 1 element */ match('['); expr(); match(']'); /* The Index Value is on Top of the Stack. * Scale it. */ if (size1 != 1) emit(LAG, size1), emito(M); return(OK); } /*===========================================================================*/ static int arguments(n) /*+++++ .PURPOSE Matches the arguments .RETURNS n .REMARKS --------------*/ int n; /* IN: Number of arguments */ { int i; ENTER_DEBUG("arguments"); i = n; while (--i >= 0) { expr0(); /* Each argument may be an expression WITHOUT , */ if (i) match(','); } EXIT_DEBUG(n); } /*===========================================================================*/ static int match_if() /*+++++ .PURPOSE Match the IF statement .RETURNS 0 (single if) / 1 (with else clause) .ALGORITHM If statement is if (expr) then_clause; else else_clause; expr (t0) JZ t1 then_clause J fin (t1) else_clause (fin) ... --------------*/ { int stat, t0, t1; ENTER_DEBUG("match_if"); stat = 0; match(lookahead); match('('), expr(), match(')'); t0 = CodeCounter; emit(JZ, -1); stmt(); /* Match THEN clause */ if (lookahead == ELSE) { stat = 1; t1 = CodeCounter; emit(J, -1); HereIsJumpTarget(t0+1); t0 = t1; match(lookahead); stmt(); /* Match ELSE clause */ } HereIsJumpTarget(t0+1); EXIT_DEBUG(stat); } static int match_while() /*+++++ .PURPOSE Match the while statement .RETURNS 0 .ALGORITHM while (test) stmt is translated as (t0) test (t) JZ t1 stmt J t0 (t1) ... --------------*/ { int t, t0, t1; ENTER_DEBUG("match_while"); match(lookahead); t0 = stmt_start; /* Target of Continue */ match('('), expr(), match(')'); /* Get (expression) */ t = CodeCounter; emit(JZ, -1); stmt(); emit(J , t0); HereIsJumpTarget(t+1); gotos(t0, CodeCounter, t0); EXIT_DEBUG(0); } static int match_for() /*+++++ .PURPOSE Match the for statement .RETURNS 0 .ALGORITHM for (init; test; next) stmt is translated as init (tt0) test (tt1) JZ t1 J ts (t0) next J tt0 (ts) stmt J t0 (t1) ... --------------*/ { int t0, tt0, tt1; ENTER_DEBUG("match_for"); match(lookahead); match('('); expr(); tt0 = CodeCounter; match(';'); emito(CLR); expr0(); tt1 = CodeCounter; match(';'); emit(JZ, -1); emit(J, -1); t0 = CodeCounter; emito(CLR); expr(); match(')'); emit(J, tt0); /* Process now the inner part of the for stmt */ HereIsJumpTarget(tt1 +2+sizeof(int)); stmt(); emit(J, t0); HereIsJumpTarget(tt1 +1); gotos(t0, CodeCounter, t0); EXIT_DEBUG(0); } static int match_switch() /*+++++ .PURPOSE Match the switch statement .RETURNS Number of cases .ALGORITHM switch(expr) { case CONSTANT: ... } (t0) expr CASE J *+15 LAG Value (t) JNE next-CASE ... --------------*/ { int stat, t, t0, t1; /* t1 = `default' address */ ENTER_DEBUG("match_switch"); match(lookahead); stat = 0; t0 = stmt_start, t1 = -1, t = -1; /* No (default) case yet */ match('('), expr(), match(')'); match('{'); if ((lookahead != CASE) && (lookahead != DEFAULT)) error1("You missed a `case' in switch statement"); while (lookahead != '}') switch(lookahead) { case DONE: error1("Source ends within a switch!"); FINISH; case CASE: stat++; match(lookahead); if (t > 0) emit(J, CodeCounter +3*(1+sizeof(int))), /* Skip test */ HereIsJumpTarget(t+1); /* Target JNE*/ if_not(t = cst_expr()) error1("Missing constant"); emit(t, l_token); match(':'); t = CodeCounter; /* Target of next JNE */ emit(JNE, -1); continue; case DEFAULT: stat++; match(lookahead); match(':'); if (t1 > 0) error1("Too many `default'"); t1 = CodeCounter; continue; default: stmt(); continue; } match('}'); /* End of Switch */ if (t1 < 0) t1 = CodeCounter; /* Default `default' case */ if (t > 0) SetJumpTarget(t+1, t1); /* After last case: default */ /* Fill the `break' statements */ t1 = CodeCounter; gotos(t0, t1, -1); FIN: EXIT_DEBUG(stat); } /*===========================================================================*/ static int stmt() /*+++++ .PURPOSE Match a statement .RETURNS The last token encountered. .REMARKS --------------*/ { int t, old_nam, old_var; double *aval; char *tname; int indexed; ENTER_DEBUG("stmt"); emito(CLR); /* A new statement starts... */ switch(lookahead) { case '{': /* Statement { ... } */ /* old_nam = symnames.used, old_var = symlocal.used; /* Local def. */ match(lookahead); while((lookahead != DONE) && (lookahead != '}')) stmt(); /* symnames.used = old_nam, symlocal.used = old_var; /* Local def. */ match('}'); break; case IF: match_if(); break; case WHILE: match_while(); break; case FOR: match_for(); break; case CONTINUE: case BREAK: t = lookahead, match(lookahead); emito(t); match(';'); break; case SWITCH: match_switch(); break; case RETURN: match(lookahead); if (lookahead == '(') match('('), expr(), match(')'); emito(RET); match(';'); break; case ';': /* NULL Statement */ match(';'); break; default: expr(); match(';'); break; case IDCL: case FDCL: case CDCL: case HDCL: /* Local Declarations */ t = (lookahead & 7) | _LOCAL_; match(lookahead); declare(t); while (lookahead == ',') match(','), declare(t); match(';'); break; } EXIT_DEBUG(lookahead); } /*===========================================================================*/ static int cst_expr() /*+++++ .PURPOSE Evaluate a constant expression (only INTEGERS) .RETURNS LAG (absolute constant) / LAL (relative constant) / BADOP (error) / 0 (no constant) --------------*/ { int stat; /* Returned status */ CODE *old_Code; int old_expr_flags; CODE aCode; /* Expressions will match only constants when expr_flags is 1 */ if ( (lookahead == INUM) || (lookahead == '(') || isUnaryToken(lookahead)) { /* Initialize the two buffers to (0, 32) bytes */ aCode.bop.buf = (char *)0; aCode.bop.increment = 32; aCode.bop.allocated = aCode.bop.used = aCode.bop.offset = 0; aCode.var.buf = (char *)0; aCode.var.increment = 32; aCode.var.allocated = aCode.var.used = aCode.var.offset = 0; old_Code = Code, Code = &aCode; old_expr_flags = expr_flags, expr_flags = 1; stat = BADOP; expr0(); /* Result as LAG, value. NO COMMA . */ if (CodeCounter == (1+sizeof(int))) { stat = *(Code->bop.buf); if ( (stat != LAG) && (stat != LAL)) { error1("Only Constants allowed !"); stat = BADOP; } copy_int(&l_token, Code->bop.buf + (CodeCounter-sizeof(int))); } expr_flags = old_expr_flags ; BUF_Close (&aCode.bop); BUF_Close (&aCode.var); Code = old_Code; } else stat = 0, l_token = 0; return(stat); } /*===========================================================================*/ static int expr0() /*+++++ .PURPOSE Parse a complete expression made of terms, WITHOUT COMMAs .RETURNS Last matched token .REMARKS Simply starts the opp from top priority level --------------*/ { return(opp(ASSIGN_PRIO)); } /*===========================================================================*/ static int expr() /*+++++ .PURPOSE Parse a complete expression made of terms; COMMAS ARE ALLOWED. .RETURNS Last matched token .REMARKS Simply starts the opp from top priority level --------------*/ { int stat; /* Returned status */ stat = expr0(); if_not(expr_flags & 1) /* It's not a constant expr., , are allowed */ while (lookahead == ',') { match(','), emito(STX), /* Decrease stack */ stat = expr0(); } return(stat); } /*===========================================================================*/ static int opp(o) /*+++++ .PURPOSE Parse operation o .RETURNS Matched token .REMARKS --------------*/ int o; /* IN: Operator order */ { int t, t1, oo, prio, op, tclass; double *aval; char *tname, indexed; ENTER_DEBUG("opp"); if (o == 0) { switch (lookahead) { case '(': match('('), expr(), match(')'); break; case NULLval: l_token = NULL4; case INUM: emit(LAG, l_token); match(lookahead); break; case FNUM: if (expr_flags & 1) { error1("Only Constants allowed !"); break; } emit(LAL, a_token); emito(LD); match(lookahead); break; default: tclass = lookahead & 0xff00; if (tclass == (UNARY<<8)) /* Unary Operators */ break; if (tclass == ID) /* Load */ { t = lookahead, aval = a_token, tname = token_name; match(t); indexed = (lookahead == '['); emita(t, aval); /* Load its address */ t1 = L | (t&7); /* The Load operator */ switch(t&(_POINTER_|_ARRAY_)) { case _ARRAY_: break; case _POINTER_: emito(L); break; case _VARIABLE_: if (indexed) error("Invalid index to variable: ", tname); else emito(t1); break; default: error("Unknown variable: ", tname); } if (indexed) /* Element of Array */ cc_index(t), emito(A), emito(t1); break; } if (expr_flags & 1) { error1("Only Constants allowed !"); break; } if (tclass == FCT) /* Function */ { t = lookahead, aval = a_token; match(t), match('('); arguments(t&15); match(')'); emit(t, aval); break; } error("Unexpected ", atok(lookahead, 1)); old_token = lookahead, lookahead = lexan(lookahead); } EXIT_DEBUG(t); } oo = o - 1; prio = o<<8; opp(oo); while( (lookahead & 0xff00) == prio) { t = lookahead, match(lookahead); if (prio == ASSIGN) op = pop_op("Bad left-hand of Assign(=) statement"); else op = 0; if (prio != (POSTFIX<<8)) opp(oo); if (prio == ASSIGN) do_assign(op, t); else emito(t); } EXIT_DEBUG(t); } /*===========================================================================*/ static int load (op, a) /*+++++ .PURPOSE Load instructions .RETURNS Type of loaded (int / float) .REMARKS On the top of the Stack --------------*/ int op; /* IN: Operation */ char *a; /* IN: Address to Recall */ { int typ; char *apointer; static char opc; typ = 0; /* Integer */ switch(op) { case LAL: /* Local */ apointer = (Code->var).buf; apointer += (int)a; the_int = (int)apointer; break; case LAG: /* Load Address */ the_int = (int)a; break; case L: /* Load Integer */ copy_int(&the_int, a); break; case LC: /* Load Char */ the_int = *a; if (the_int == NULL1) the_int = NULL4; break; case LH: /* Load Short */ copy(&the_short, a, sizeof(short)); the_int = the_short; if (the_int == NULL2) the_int = NULL4; break; case LD: /* Load Double */ copy(&the_double, a, sizeof(double)); typ = 1; break; default: /* Error... */ opc = op; ERR_ED_STR2("Unknown operation: ", &opc, 1); break; } if (ireg >= sizeof(regt)-1) ERR_ED_I("Stack overflow: ", sizeof(regt)); else { regt[ireg] = typ; if(typ) regf[ireg] = the_double; else regi[ireg] = the_int; } ireg++; return(typ); } /*===========================================================================*/ static int store(op, a) /*+++++ .PURPOSE Store instructions. The stack is decremented. .RETURNS Type (double / float) -------*/ int op; /* IN: Operation */ char *a; /* IN: Address to Store */ { int typ; static char opc; typ = regt[--ireg]; /* Type of Value */ if(typ) the_int = (regf[ireg] <= NULLF ? NULL4 : regf[ireg] ); else the_int = regi[ireg]; switch(op) { case ST: /* Store Int */ copy_int(a, &the_int); break; case STC: /* Store Char */ if(the_int == NULL4) the_int = NULL1; *a = the_int; break; case STH: /* Store Short */ if(the_int == NULL4) the_int = NULL2; the_short = the_int; copy(a, &the_short, sizeof(the_short)); break; case STD: /* Store Double */ if(typ) the_double = regf[ireg]; else the_double = (the_int == (int)NULL4 ? (double)NULLF : (double)the_int); copy(a, &the_double, sizeof(the_double)); break; default: /* Error... */ opc = op; ERR_ED_STR2("Unknown operation: ", &opc, 1); break; } return(typ); } /*===========================================================================*/ static int exec_op(op) /*+++++ .PURPOSE Unary / Binary Operations .RETURNS Type of result (int / float) / -1 for STOP .REMARKS For Store operations, Stack contains (@, value) before store, and (value) after. --------------*/ int op; /* IN: Operation */ { int i1, i2, *pi; double f1, f2, *pf; int r; unsigned char *pt, notNull; static char opc; i2 = ireg - 1; /* Top of stack */ i1 = i2-1; pt = ®t[i2]; switch(op) /* Look first for simple operations */ { case NOP: return(0); /* No Operation */ case CLR: /* Clear Stack */ ireg = 0; return(0); case RET: /* Put top of stack on [0] */ regi[0] = regi[i2]; return(-1); case LX: /* Load X-reg */ return(load(LAG, xreg)); case STX: xreg = regi[--ireg]; return(0); case LAL: case LAG: case L: case LC: case LH: case LD: return(load(op, regi[--ireg])); case ST: case STC: case STH: case STD: /* Stack is (@, value) */ r = store(op, regi[i1]); if (regt[i1] = regt[i2]) /* Double */ regf[i1] = regf[i2]; /* Push double */ else regi[i1] = regi[i2]; /* Push int */ return(r); case SWAP: /* Exchange Top of Stack */ r = regi[i1], regi[i1] = regi[i2], regi[i2] = r; r = regt[i1], regt[i1] = regt[i2], regt[i2] = r; if (regt[i1] | regt[i2]) /* Double numbers */ f1 = regf[i1], regf[i1] = regf[i2], regf[i2] = f1; return(*pt); } /* r is used as an indicator of mized types: * 0 means only integers; * 1/2 mixed types (1 = first argument is double) * 3 only doubles */ r = 0; /* Result = INT */ f1 = 0, f2 = 0; if (*pt) /* Float */ f2 = regf[i2], r |= 1; else i2 = regi[i2]; if ((op & 0x70) != 0x70) /* For Binary Operations */ { ireg--, pt--; i1 = ireg - 1; if (regt[i1]&1) /* Float */ f1 = regf[i1], r |= 2; else i1 = regi[i1]; } pf = ®f[ireg-1]; pi = ®i[ireg-1]; if (r == 1) f1 = (i1 == (int)NULL4 ? (double)NULLF : (double)i1); if (r == 2) f2 = (i2 == (int)NULL4 ? (double)NULLF : (double)i2); if (r) *pt = 1; /* double result */ if(r) { notNull = !( (f1 <= NULLF) || (f2 <= NULLF)); *pf = NULLF; /* Default NULL / FALSE */ switch(op) /* Floating-point */ { case M: if (notNull) *pf = f1 * f2; break; case D: if (notNull) *pf = f1 / f2; break; case MOD: if (notNull) *pf = fmod(f1, f2); break; case POW: if (notNull) *pf = pow (f1, f2); break; case A: if (notNull) *pf = f1 + f2; break; case S: if (notNull) *pf = f1 - f2; break; case CHS: if (notNull) *pf = -f2; break; case LT: *pt = 0; *pi = (f1 < f2); break; case LE: *pt = 0; *pi = (f1 <= f2); break; case GT: *pt = 0; *pi = (f1 > f2); break; case GE: *pt = 0; *pi = (f1 >= f2); break; case EQ: *pt = 0; *pi = (f1 == f2); break; case NE: *pt = 0; *pi = (f1 != f2); break; case AND: *pt = 0; *pi = (f1 && f2); break; case NOT: *pt = 0; *pi = !f2; break; case OR: *pt = 0; *pi = (f1 || f2); break; case ABSV: if (notNull) *pf = ABSOLUTE(f2); break; case SIGN: if (notNull) *pf = (f2 < 0 ? -1 : (f2 ? 1 : 0)); break; case BAND: case BOR: case BXOR: case COMP: case LSH: case RSH: ERROR("Bit operations only on integers..."); break; default: opc = op; ERR_ED_STR2("Unknown operation: ", &opc, 1); break; } } else { notNull = !( (i1 == NULL4) || (i2 == NULL4)); *pi = NULL4; /* Default NULL / FALSE */ switch(op) /* Integer... */ { case M: if (notNull) *pi = i1 * i2; break; case D: if (notNull) *pi = i1 / i2; break; case MOD: if (notNull) *pi = i1 % i2; break; case POW: if (notNull) for (*pi = 1; i2 > 0; i2--) *pi *= i1; if (i2 < 0) *pi = 0; break; case A: if (notNull) *pi = i1 + i2; break; case S: if (notNull) *pi = i1 - i2; break; case CHS: if (notNull) *pi = -i2; break; case LT: *pi = (i1 < i2); break; case LE: *pi = (i1 <= i2); break; case GT: *pi = (i1 > i2); break; case GE: *pi = (i1 >= i2); break; case EQ: *pi = (i1 == i2); break; case NE: *pi = (i1 != i2); break; case AND: *pi = (i1 && i2); break; case OR: *pi = (i1 || i2); break; case NOT: *pi = !i2; break; case BAND: *pi = i1 & i2; break; case BOR: *pi = i1 | i2; break; case BXOR: *pi = i1 ^ i2; break; case COMP: *pi = ~i2; break; case LSH: *pi = i1 << i2; break; case RSH: *pi = i1 >> i2; break; case ABSV: if(notNull) *pi = ABSOLUTE(i2); break; case SIGN: if(notNull) *pi = (i2 < 0 ? -1 : (i2 ? 1 : 0)); break; default: opc = op; ERR_ED_STR2("Unknown operation: ", &opc, 1); break; } } return(*pt); } /*===========================================================================*/ static int execode(start, len) /*+++++ .PURPOSE Execute code .RETURNS result .REMARKS Returned value on the top of the Stack. NO CALL, NO JUMP. --------------*/ char *start; /* IN: The code to execute */ int len; /* IN: Length of code */ { char *pop, *pope; int op; ireg = 0; regi[0] = 0; for (pop = start, pope = pop + len; pop < pope; ) { op = *(pop++); if (op < 0x40) /* Need an address */ { copy_int(&the_pointer,pop), pop += sizeof(int); if ( (op == LAL) || (op == LAG)) load(op, the_pointer); else error1("non-constant expression"); } else exec_op(op); } return(regi[0]); } /*===========================================================================*/ static int do_arglist(np) /*+++++ .PURPOSE Move parameters to a stack for later call. .RETURNS Number of integers (parameters when all are integers...) .REMARKS Stack is stored in call_stack. --------------*/ int np; /* IN: Number of Parameters */ { int i, *p, *p0; union { double f; int ia[2]; } eq; p = p0 = (int *)®f[ireg]; for (i = np; --i >= 0;) { if (regt[--ireg]) /* It's a double... */ eq.f = regf[ireg], *--p = eq.ia[1], *--p = eq.ia[0]; else *--p = regi[ireg]; } call_stack = p; return(p0 - p); } /*===========================================================================*/ static int fcall(np, fct) /*+++++ .PURPOSE Call a function with n parameters .RETURNS OK .REMARKS Returned value on the top of the Stack --------------*/ int np; /* IN: Number of Parameters (0, 1, 2) */ FCT_PTR fct; /* IN: Function to call... */ { int neq, *p; double result; neq = do_arglist(np); p = call_stack; if (neq <= 4) result = (*fct)(p[0], p[1], p[2], p[3]); else if (neq <= 8) result = (*fct)(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7]); else result = (*fct)(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8], p[9], p[10], p[11], p[12], p[13], p[14], p[15]); return(load(LD, &result)); } static int icall(np, fct) /*+++++ .PURPOSE Call a function with n parameters .RETURNS OK .REMARKS Returned value on the top of the Stack --------------*/ int np; /* IN: Number of Parameters (0, 1, 2) */ int (*fct)(); /* IN: Function to call... */ { int neq, *p; int result; neq = do_arglist(np); p = call_stack; if (neq <= 4) result = (*fct)(p[0], p[1], p[2], p[3]); else if (neq <= 8) result = (*fct)(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7]); else result = (*fct)(p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7], p[8], p[9], p[10], p[11], p[12], p[13], p[14], p[15]); return(load(L, &result)); } /*===========================================================================*/ static int exec_tz() /*+++++ .PURPOSE Test the number .RETURNS 1 if zero / 0 if not zero .REMARKS --------------*/ { int iszero; if (regt[--ireg]) iszero = (regf[ireg] == 0.); else iszero = (regi[ireg] == 0); return(iszero); } static int exec_ne() /*+++++ .PURPOSE Compare two numbers on top of stack .RETURNS 1 if numbers differ / 0 if identical .REMARKS --------------*/ { int isne; isne = regi[ireg-1] - regi[ireg-2]; --ireg; return(isne); } /*===========================================================================*/ static int init() /*+++++ .PURPOSE Initialize .RETURNS OK .REMARKS --------------*/ { /* CG. Already defined in standare math.h Patch.01 /* double sqrt(), log(), log10(), exp(); /* double cos(), sin(), tan(), acos(), asin(), atan(); /* double cosh(), sinh(), tanh(); /* double atan2(); */ /* CG. Already defined in trigo.h /* double cosd(), sind(), tand(), acosd(), asind(), atand(), atan2d(); /* double acosh(), asinh(), atanh(); /* CG. strlen(); not always is int. /* CG. strcat() and strlen() are defined in string.h /* CG. atol() and atof() are defined in stdlig.h */ int eh_put1(), strupper(), strlower(), strred(); int strcopy(), strindex(), stuindex(), strloc(), strskip(), stritem(), stuitem(), strcomp(),stucomp(); int strtrs(); /* Translate */ static FCT_PTR callf[] = { atof, sqrt, log, log10, exp, cos, sin, tan, acos, asin, atan, cosd, sind, tand, acosd, asind, atand, cosh, sinh, tanh, acosh, asinh, atanh, atan2, atan2d}; static INT_FCT calls[] = { (int (*)())atol, eh_put1, (int (*)())strlen, strupper, strlower, strred, strcopy,(int (*)())strcat, strindex, stuindex, strloc, strskip,strcomp, stucomp, stritem, stuitem, strtrs }; static char fct1[] = "atof\0sqrt\0log\0log10\0exp\0\ cos\0sin\0tan\0acos\0asin\0atan\0\ cosd\0sind\0tand\0acosd\0asind\0atand\0\ cosh\0sinh\0tanh\0acosh\0asinh\0atanh\0"; static char fct2[] = "atan2\0atan2d\0"; static char str1[] = "atoi\0ERROR\0\ strlen\0strupper\0strlower\0strred\0"; static char str2[] = "strcopy\0strcat\0strindex\0stuindex\0strloc\0\ strskip\0strdiff\0studiff\0"; static char str3[] = "stritem\0stuitem\0"; static char str4[] = "strtrs\0"; static char symb[] = "char\0int\0double\0short\0\ return\0if\0else\0continue\0break\0switch\0case\0default\0while\0for\0null\0\ abs\0sign\0"; static short as [] = {CDCL, IDCL, FDCL, HDCL, RETURN, IF, ELSE, CONTINUE, BREAK, SWITCH, CASE, DEFAULT, WHILE, FOR, NULLval, (UNARY<<8)|ABSV, (UNARY<<8)|SIGN}; char *p; short *ps; int i; static double pi = 3.1415927; /* Computed here */ BUF_Clear(&sym_glob); BUF_Clear(&symnames); BUF_SaveString(&symnames, "==>"); /* Constants name */ for (p = fct1, i = 0; *p; p+= 1+strlen(p)) insert(p, FCT|FCALL|1, callf[i++]); for (p = fct2; *p; p+= 1+strlen(p)) insert(p, FCT|FCALL|2, callf[i++]); for (p = str1, i=0; *p; p+= 1+strlen(p)) insert(p, FCT|ICALL|1, calls[i++]); for (p = str2; *p; p+= 1+strlen(p)) insert(p, FCT|ICALL|2, calls[i++]); for (p = str3; *p; p+= 1+strlen(p)) insert(p, FCT|ICALL|3, calls[i++]); for (p = str4; *p; p+= 1+strlen(p)) insert(p, FCT|ICALL|4, calls[i++]); for (p = symb, ps = as; *p; ps++, p+= 1+strlen(p)) insert(p, *ps, NULL_PTR(double)); pi = 4.0e0 * atan(1.0e0); insert("pi", ID|_DOUBLE_|_VARIABLE_, &pi); #if DEBUG list_symbols("Global Symbol Table", &sym_glob); #endif sym_glob.offset = sym_glob.used; /* Permanent */ symnames.offset = symnames.used; /* Permanent */ return(OK); } #if DEBUG /*===========================================================================*/ static int list_symbols(txt, table) /*+++++ .PURPOSE List the Symbols .RETURNS OK .REMARKS --------------*/ char *txt; /* IN: Title */ BUFFER *table; /* IN: Buffer with symbols */ { SYMBOL *ps, *pe; char *p, *pel; int t, class; static char *elname[9] = { " int", " char", " short", "double", " ?4?", " ?5?", " ?6?", " ?7?"}; printf("\n%s\n", txt); for (ps= (SYMBOL *)(table->buf + table->offset), pe= (SYMBOL *)(table->buf + table->used); psaddr); t = ps->token; class = t&0xff00; if (class == ID) pel = elname[t&7]; else if (class == FCT) pel = elname[((t&FCALL) == FCALL ? 3 : 0)]; else pel = "Symbol"; printf("%s", pel); p = " "; /* Text following */ if (class == FCT) p = "Funct "; else if (class == ID) switch (t&(_ARRAY_|_POINTER_|_VARIABLE_)) { case _ARRAY_: p = "Array "; break; case _POINTER_: p = "Pointer"; break; } printf("%s : ", p); p = symnames.buf + ps->name; printf("%s", p); /* Name of variable */ if (*p == '=') /* Litteral value: print it ... */ { if (t&_LOCAL_) p = Code->var.buf + (int)ps->addr, a_token = (double *)p; else a_token = ps->addr; switch(t&7) { case _CHAR_: printf("\"%s\"", a_token); break; case _DOUBLE_: printf("\"%f\"", *a_token); break; } } printf("\n"); } return(0); } /*===========================================================================*/ static int list_code(txt) /*+++++ .PURPOSE List the Code .RETURNS OK .REMARKS --------------*/ char *txt; /* IN: Title */ { unsigned char *pop, *pope, op; char bed[21]; int i, o, lines; char *opsym; char oped[5]; printf("\n%s\n", txt); lines = 0; for (pop = (unsigned char *)(Code->bop).buf, pope = pop + CodeCounter; pop < pope; ) { o = pop - (unsigned char *)(Code->bop).buf; op = *(pop++); lines++; if (op == CLR) lines = 0; if (!(lines&3)) printf("\n"); oscfill(bed, sizeof(bed)-1, ' '); bed[sizeof(bed)-1] = EOS; i = ed_pic(bed, (op == CLR ? "00XXXX==" : "00XXXX: "), o); switch(op) { case J : opsym = "J "; break; case JZ : opsym = "JZ "; break; case JNE : opsym = "JNE "; break; case STC : opsym = "StC "; break; case ST : opsym = "St "; break; case STD : opsym = "StD "; break; case STH : opsym = "StH "; break; case LAL : opsym = "LL "; break; case LAG : opsym = "LG "; break; case LC : opsym = "LC "; break; case L : opsym = "L "; break; case LD : opsym = "LD "; break; case LH : opsym = "LH "; break; case A : opsym = "Add "; break; case S : opsym = "Sub "; break; case M : opsym = "Mul "; break; case D : opsym = "Div "; break; case MOD : opsym = "Mod "; break; case POW : opsym = "Pow "; break; case BXOR : opsym = "Xor "; break; case BAND : opsym = "And "; break; case BOR : opsym = "Or "; break; case LSH : opsym = "ShL "; break; case RSH : opsym = "ShR "; break; case EQ : opsym = ".EQ."; break; case NE : opsym = ".NE."; break; case LT : opsym = ".LT."; break; case GE : opsym = ".GE."; break; case GT : opsym = ".GT."; break; case LE : opsym = ".LE."; break; case AND : opsym = ".AND"; break; case OR : opsym = ".OR."; break; case NOT : opsym = ".NOT"; break; case CHS : opsym = "CHS "; break; case COMP : opsym = "COMP"; break; case ABSV : opsym = "abs "; break; case SIGN : opsym = "Sgn "; break; case STX : opsym = "StX "; break; case LX : opsym = "LX "; break; case SWAP : opsym = "SWAP"; break; case CLR : opsym = "Clr "; break; case NOP : opsym = "Nop "; break; default : if ( (op >= ICALL) && (op < FCALL+16)) opsym = "Cal "; else ed_pic(oped, "xXX ", op), opsym = oped; } i += copy(&bed[i], opsym, 4); if ((op & 0x40) == 0) { copy_int(&the_int, pop); ed_pic(&bed[i], "XXXXXXXX", the_int); pop += sizeof(int); } else bed[i] = ' '; printf("%s", bed); } printf("\n"); } #endif /*=========================================================================== * Public Functions *===========================================================================*/ int cc_ext(s, addr) /*+++++ .PURPOSE Insert an external reference definition. .RETURNS OK / NOK .REMARKS The definition must be done before the compilation. --------------*/ char *s; /* IN: Symbol to insert, e.g. "double x" or char x[10]*/ double *addr; /* IN: Address of external symbol */ { int k; ENTER("cc_ext"); TRACE(s); source = s, psource = s; if (sym_glob.used == 0) init(); switch(lookahead = lexan(NONE)) { case IDCL: case FDCL: case CDCL: case HDCL: k = lookahead & 7; break; default: k = 0, psource = s; } EXIT(cc_glb(k, psource, addr)); } /*===========================================================================*/ int cc_glb(type, s, addr) /*+++++ .PURPOSE Insert an external reference definition. .RETURNS OK / NOK .REMARKS The definition must be done before the compilation. --------------*/ int type; /* IN: 1=char, 0=integer, 3=double, 2=short, \ |0x10 for arrays */ char *s; /* IN: Symbol to insert, e.g. "x" or "x[12]" */ double *addr; /* IN: Address of external symbol */ { int tc; /* Token class */ ENTER("cc_glb"); TRACE(s); TRACE_ED_I("Type of Variable: ", type); source = s, psource = s, pstmt = NULL_PTR(char); found_errors = 0; if (sym_glob.used == 0) init(); if (type < 0) type = (-type) | 0x10; tc = ABSOLUTE(type) & 7; if (tc == 4) tc = 0; if (type & 0x10) tc |= _ARRAY_; a_token = addr; lookahead = lexan(NONE); /* Analyze Identifier */ declare(ID|tc); if (lookahead == ';') match(';'); if (lookahead != DONE) ERROR("Unexpected continuation"), found_errors += 1; EXIT((found_errors ? NOK : OK)); } /*===========================================================================*/ int cc_fct(s, np, addr) /*+++++ .PURPOSE Define an external Function. .RETURNS OK / NOK .REMARKS The definition must be done before the compilation. --------------*/ char *s; /* IN: Function symbolic name, e.g. "double cbrt" */ int np; /* IN: Number of parameters */ double *addr; /* IN: Function Address */ { int tclass; ENTER("cc_fct"); TRACE(s); TRACE_ED_I("Number of parameters: ", np); if ((np < 0) || (np > 7)) { ERR_ED_I("Bad number of parameters: ", np); found_errors = 1; FINISH; } source = s, psource = s, pstmt = NULL_PTR(char); found_errors = 0; if (sym_glob.used == 0) init(); switch(lookahead = lexan(NONE)) { case IDCL: case CDCL: case HDCL: tclass = ICALL; /* Int Function */ break; case FDCL: tclass = FCALL; /* Double Function */ break; default: error1("Bad declaration"), found_errors += 1; } tclass |= (FCT | np); a_token = addr; match(lookahead); /* keyword int double, etc */ if (lookahead == ID) insert(token_name, tclass, addr); else error("Function already defined: ", token_name); match(lookahead); if (lookahead == '(') match('('), match(')'); if (lookahead == ';') match(';'); if (lookahead != DONE) ERROR("Unexpected continuation"), found_errors += 1; FIN: EXIT((found_errors ? NOK : OK)); } /*===========================================================================*/ int cc_dcl(s, np, addr) /*+++++ .PURPOSE Define Permanent external Functions. .RETURNS OK / NOK .REMARKS The definition must be done before the compilation. --------------*/ char *s; /* IN: Function symbolic name, e.g. "double cbrt" */ int np; /* IN: Number of parameters */ double *addr; /* IN: Function Address */ { ENTER("cc_finit"); cc_fct(s, np, addr); /* Install Definition */ sym_glob.offset = sym_glob.used; /* Permanent */ symnames.offset = symnames.used; /* Permanent */ EXIT((found_errors ? NOK : OK)); } /*===========================================================================*/ int cc_compile(text) /*+++++ .PURPOSE Compile the source text into a `microcode' that can be executed by cc_exec routine. .RETURNS Microcode number (0 if failed). This number can be used as an argument to cc_exec and cc_free routines. .REMARKS Before the compilation, cc_fct must be used for definition of external functions if any (with the exception of the `standard' functions defined above), and cc_ext to bind external variables. --------------*/ char *text; /* IN: Text to compile */ { int thecode; ENTER("+cc_compile"); /* Check if integers may be taken as addresses */ if ((sizeof(int) != sizeof(char *)) || (sizeof(double) != 2*sizeof(int))) { ERROR("This machine can't work for cc_compile"); EXIT(0); } if (sym_glob.used == 0) init(); BUF_Clear(&symlocal); /* No Local Symbol */ /* Get New space in the Codes buffer for the new microcode. */ Code = SET_FindFreeItem(&Codes, CODE); thecode = 1 + SET_Item(&Codes, CODE); /* Define buffers of operations (bop) and local variables (var) * as automatic */ Code->bop.increment = 128; Code->var.increment = 8*sizeof(double); /* Initialize compilation */ source = text, psource = text, pstmt = NULL_PTR(char); found_errors = 0, lineno = 1; old_token = NONE, lookahead = lexan(old_token); while (lookahead != DONE) stmt(); (Code->var).offset = 0; #if DEBUG list_symbols("Global Symbol Table", &sym_glob); list_symbols("Local Symbol Table", &symlocal); list_code ("Generated Code"); #endif if (found_errors) /* Bad... */ cc_free(thecode), thecode = 0, ERR_ED_I("No microcode generated due to errors: ", found_errors); /* Prepare the general symbol buffers for next compilation */ sym_glob.used = sym_glob.offset; symnames.used = symnames.offset; EXIT(thecode); } /*===========================================================================*/ int cc_free(thecode) /*+++++ .PURPOSE Free the microcode compiled by cc_compile. .RETURNS thecode / 0 if failed .REMARKS --------------*/ int thecode; /* IN: Microcode number */ { int i; ENTER("+cc_free"); i = thecode - 1; if_not (Code = SET_FindItem(&Codes, CODE, i)) i = 0; else BUF_Close(&(Code->var)), BUF_Close(&(Code->bop)), SET_FreeItem(&Codes, CODE, i), i = thecode; EXIT(i); } /*===========================================================================*/ int cc_exec(thecode) /*+++++ .PURPOSE Execute the microcode compiled by cc_compile. .RETURNS What's to be returned by program... .REMARKS --------*/ int thecode; /* IN: Microcode number */ { char *pop, *pope, op; char *ptr; /* Any pointer ... */ int stat; ENTER("cc_exec"); stat = thecode - 1; regi[0] = -1; /* Default Value Returned... */ if_not (Code = SET_FindItem(&Codes, CODE, stat)) { ERR_ED_I("Bad microcode #", thecode); FINISH; } ireg = 0; for (pop = (Code->bop).buf, pope = pop + CodeCounter; pop < pope; ) { op = *(pop++); if (op < 0x40) /* Need an address */ { copy_int(&the_pointer,pop), ptr=the_pointer; pop += sizeof(ptr); switch(op & 0xf0) { case 0x20: /* Function */ icall(op&7, ptr); continue; case 0x30: /* Function */ fcall(op&7, ptr); continue; case 0x00: switch(op) { case JZ: /* Jump if Zero */ if (exec_tz()) goto JUMP_UNCONDITIONNALLY; else continue; case JNE: /* Jump if Not-Equal */ if (exec_ne()) goto JUMP_UNCONDITIONNALLY; else continue; case J: /* Jump Unconditionnally */ JUMP_UNCONDITIONNALLY: pop = (Code->bop).buf + (int)ptr; continue; case LAL: case LAG: load(op, ptr); continue; } } } if (exec_op(op) == -1) FINISH; } FIN: EXIT(regi[0]); }