lang/m2/comp/main.c

   1 /*
   2  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
   3  * See the copyright notice in the ACK home directory, in the file "Copyright".
   4  *
   5  * Author: Ceriel J.H. Jacobs
   6  */
   7
   8 /* M A I N   P R O G R A M */
   9
  10 /* $Id: main.c,v 1.65 1996/08/14 07:42:34 ceriel Exp $ */
  11
  12 #include        "debug.h"
  13
  14 #include        <system.h>
  15 #include        <em_arith.h>
  16 #include        <em_label.h>
  17 #include        <em_code.h>
  18 #include        <alloc.h>
  19 #include        <assert.h>
  20 #include        <stb.h>
  21
  22 #include        "strict3rd.h"
  23 #include        "dbsymtab.h"
  24 #include        "input.h"
  25 #include        "f_info.h"
  26 #include        "idf.h"
  27 #include        "LLlex.h"
  28 #include        "Lpars.h"
  29 #include        "type.h"
  30 #include        "def.h"
  31 #include        "scope.h"
  32 #include        "standards.h"
  33 #include        "tokenname.h"
  34 #include        "node.h"
  35 #include        "warning.h"
  36 #include        "SYSTEM.h"
  37
  38 int             state;                  /* either IMPLEMENTATION or PROGRAM */
  39 char            options[128];
  40 int             DefinitionModule;
  41 char            *ProgName;
  42 char            **DEFPATH;
  43 int             nDEF = 2, mDEF = 10;
  44 int             pass_1 = 1;
  45 t_def           *Defined;
  46 extern int      err_occurred;
  47 extern int      fp_used;                /* set if floating point used */
  48 static t_node   _emptystat = { Stat, 0, NULLTYPE, { ';' }};
  49 t_node          *EmptyStatement = &_emptystat;
  50
  51 main(argc, argv)
  52         register char **argv;
  53 {
  54         register int Nargc = 1;
  55         register char **Nargv = &argv[0];
  56
  57         ProgName = *argv++;
  58         DEFPATH = (char **) Malloc((unsigned)mDEF * sizeof(char *));
  59         DEFPATH[1] = 0;
  60
  61         while (--argc > 0) {
  62                 if (**argv == '-')
  63                         DoOption((*argv++) + 1);
  64                 else
  65                         Nargv[Nargc++] = *argv++;
  66         }
  67         Nargv[Nargc] = 0;       /* terminate the arg vector     */
  68         if (Nargc < 2) {
  69                 fprint(STDERR, "%s: Use a file argument\n", ProgName);
  70                 sys_stop(S_EXIT);
  71         }
  72         sys_stop(Compile(Nargv[1], Nargv[2]) ? S_END : S_EXIT);
  73         /*NOTREACHED*/
  74 }
  75
  76 Compile(src, dst)
  77         char *src, *dst;
  78 {
  79         extern struct tokenname tkidf[];
  80         extern char *getwdir();
  81
  82         if (! InsertFile(src, (char **) 0, &src)) {
  83                 fprint(STDERR,"%s: cannot open %s\n", ProgName, src);
  84                 return 0;
  85         }
  86         LineNumber = 1;
  87         FileName = src;
  88         WorkingDir = getwdir(src);
  89         C_init(word_size, pointer_size);
  90         if (! C_open(dst)) fatal("could not open output file");
  91         C_magic();
  92         C_ms_emx(word_size, pointer_size);
  93 #ifdef DBSYMTAB
  94         if (options['g']) {
  95                 C_ms_std(FileName, N_SO, 0);
  96         }
  97 #endif /* DBSYMTAB */
  98         init_idf();
  99         InitCst();
 100         reserve(tkidf);
 101         InitScope();
 102         InitTypes();
 103         AddStandards();
 104 #ifdef DEBUG
 105         if (options['t']) {
 106                 LexScan();
 107                 return 1;
 108         }
 109 #endif /* DEBUG */
 110         open_scope(OPENSCOPE);
 111         GlobalVis = CurrVis;
 112         close_scope(0);
 113         CheckForLineDirective();
 114         CompUnit();
 115         C_ms_src((int)LineNumber - 1, FileName);
 116         if (!err_occurred) {
 117                 pass_1 = 0;
 118                 C_exp(Defined->mod_vis->sc_scope->sc_name);
 119                 WalkModule(Defined);
 120                 if (fp_used) C_ms_flt();
 121         }
 122         C_close();
 123 #ifdef DEBUG
 124         if (options['i']) Info();
 125 #endif
 126         return ! err_occurred;
 127 }
 128
 129 #ifdef DEBUG
 130 LexScan()
 131 {
 132         register t_token *tkp = &dot;
 133         extern char *symbol2str();
 134
 135         while (LLlex() > 0) {
 136                 print(">>> %s ", symbol2str(tkp->tk_symb));
 137                 switch(tkp->tk_symb) {
 138
 139                 case IDENT:
 140                         print("%s\n", tkp->TOK_IDF->id_text);
 141                         break;
 142
 143                 case INTEGER:
 144                         print("%ld\n", tkp->TOK_INT);
 145                         break;
 146
 147                 case REAL:
 148                         print("%s\n", tkp->TOK_RSTR);
 149                         break;
 150
 151                 case STRING:
 152                         print("\"%s\"\n", tkp->TOK_STR);
 153                         break;
 154
 155                 default:
 156                         print("\n");
 157                 }
 158         }
 159 }
 160 #endif
 161
 162 static struct stdproc {
 163         char *st_nam;
 164         int  st_con;
 165 } stdprocs[] = {
 166         { "ABS",        S_ABS },
 167         { "CAP",        S_CAP },
 168         { "CHR",        S_CHR },
 169         { "FLOAT",      S_FLOAT },
 170         { "HIGH",       S_HIGH },
 171         { "HALT",       S_HALT },
 172         { "EXCL",       S_EXCL },
 173         { "DEC",        S_DEC },
 174         { "INC",        S_INC },
 175         { "VAL",        S_VAL },
 176 #ifndef STRICT_3RD_ED
 177         { "NEW",        S_NEW },
 178         { "DISPOSE",    S_DISPOSE },
 179 #endif
 180         { "TRUNC",      S_TRUNC },
 181         { "SIZE",       S_SIZE },
 182         { "ORD",        S_ORD },
 183         { "ODD",        S_ODD },
 184         { "MAX",        S_MAX },
 185         { "MIN",        S_MIN },
 186         { "INCL",       S_INCL },
 187         { "LONG",       S_LONG },
 188         { "SHORT",      S_SHORT },
 189         { "TRUNCD",     S_TRUNCD },
 190         { "FLOATD",     S_FLOATD },
 191         { 0,            0 }
 192 };
 193
 194 static struct stdproc sysprocs[] = {
 195         { "TSIZE",      S_TSIZE },
 196         { "ADR",        S_ADR },
 197         { 0,            0 }
 198 };
 199
 200 extern t_def *Enter(), *EnterType();
 201
 202 AddProcs(p)
 203         register struct stdproc *p;
 204 {
 205         for (; p->st_nam != 0; p++) {
 206                 if (! Enter(p->st_nam, D_PROCEDURE, std_type, p->st_con)) {
 207                         assert(0);
 208                 }
 209         }
 210 }
 211
 212 AddStandards()
 213 {
 214         register t_def *df;
 215         static t_token nilconst = { INTEGER, 0};
 216
 217         AddProcs(stdprocs);
 218         EnterType("CHAR", char_type);
 219         EnterType("INTEGER", int_type);
 220         EnterType("LONGINT", longint_type);
 221         EnterType("REAL", real_type);
 222         EnterType("LONGREAL", longreal_type);
 223         EnterType("CARDINAL", card_type);
 224         if (options['l']) {
 225                 /* local extension: LONGCARD. */
 226                 EnterType("LONGCARD", longcard_type);
 227         }
 228         EnterType("(void)", void_type);
 229         df = Enter("NIL", D_CONST, address_type, 0);
 230         df->con_const = nilconst;
 231
 232         EnterType("PROC", construct_type(T_PROCEDURE, NULLTYPE));
 233         EnterType("BITSET", bitset_type);
 234         df = Enter("FALSE", D_ENUM, bool_type, 0);
 235         bool_type->enm_enums = df;
 236         df->enm_next = Enter("TRUE", D_ENUM, bool_type, 0);
 237         df->enm_next->enm_val = 1;
 238         assert(df->enm_val == 0 && df->enm_next->enm_next == 0);
 239         EnterType("BOOLEAN", bool_type);
 240 }
 241
 242 do_SYSTEM()
 243 {
 244         /*      Simulate the reading of the SYSTEM definition module
 245         */
 246         static char systemtext[] = SYSTEMTEXT;
 247
 248         EnterType("WORD", word_type);
 249         EnterType("BYTE", byte_type);
 250         EnterType("ADDRESS",address_type);
 251         AddProcs(sysprocs);
 252         if (!InsertText(systemtext, sizeof(systemtext) - 1)) {
 253                 fatal("could not insert text");
 254         }
 255         DefModule();
 256 }
 257
 258 #ifdef DEBUG
 259
 260 int     cntlines;
 261
 262 Info()
 263 {
 264         extern int cnt_def, cnt_node, cnt_paramlist, cnt_type,
 265                    cnt_switch_hdr, cnt_case_entry,
 266                    cnt_scope, cnt_scopelist, cnt_tmpvar;
 267
 268         print("\
 269 %6d def\n%6d node\n%6d paramlist\n%6d type\n%6d switch_hdr\n\
 270 %6d case_entry\n%6d scope\n%6d scopelist\n%6d tmpvar\n",
 271 cnt_def, cnt_node, cnt_paramlist, cnt_type,
 272 cnt_switch_hdr, cnt_case_entry,
 273 cnt_scope, cnt_scopelist, cnt_tmpvar);
 274 print("\nNumber of lines read: %d\n", cntlines);
 275 }
 276 #endif
 277
 278 void
 279 No_Mem()
 280 {
 281         fatal("out of memory");
 282 }
 283
 284 void
 285 C_failed()
 286 {
 287         fatal("write failed");
 288 }