lang/m2/comp/defmodule.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 /* D E F I N I T I O N   M O D U L E S */
   9
  10 /* $Id: defmodule.c,v 1.41 1994/06/24 12:40:31 ceriel Exp $ */
  11
  12 #include        "debug.h"
  13
  14 #include        <assert.h>
  15 #include        <em_arith.h>
  16 #include        <em_label.h>
  17 #include        <alloc.h>
  18
  19 #include        "idf.h"
  20 #include        "input.h"
  21 #include        "scope.h"
  22 #include        "LLlex.h"
  23 #include        "def.h"
  24 #include        "Lpars.h"
  25 #include        "f_info.h"
  26 #include        "main.h"
  27 #include        "node.h"
  28 #include        "type.h"
  29 #include        "misc.h"
  30
  31 #ifdef DEBUG
  32 long    sys_filesize();
  33 #endif
  34
  35 t_idf *DefId;
  36
  37 char *
  38 getwdir(fn)
  39         register char *fn;
  40 {
  41         register char *p;
  42         char *strrindex();
  43
  44         while ((p = strrindex(fn,'/')) && *(p + 1) == '\0') {
  45                 /* remove trailing /'s */
  46                 *p = '\0';
  47         }
  48
  49         if (p) {
  50                 *p = '\0';
  51                 fn = Salloc(fn, (unsigned) (p - &fn[0] + 1));
  52                 *p = '/';
  53                 return fn;
  54         }
  55         return "";
  56 }
  57
  58 STATIC
  59 GetFile(name)
  60         char *name;
  61 {
  62         /*      Try to find a file with basename "name" and extension ".def",
  63                 in the directories mentioned in "DEFPATH".
  64         */
  65         char buf[15];
  66         char *strncpy(), *strcat();
  67
  68         strncpy(buf, name, 10);
  69         buf[10] = '\0';                 /* maximum length */
  70         strcat(buf, ".def");
  71         DEFPATH[0] = WorkingDir;
  72         if (! InsertFile(buf, DEFPATH, &(FileName))) {
  73                 error("could not find a DEFINITION MODULE for \"%s\"", name);
  74                 return 0;
  75         }
  76         WorkingDir = getwdir(FileName);
  77         LineNumber = 1;
  78         DO_DEBUG(options['F'], debug("File %s : %ld characters", FileName, sys_filesize(FileName)));
  79         return 1;
  80 }
  81
  82 t_def *
  83 GetDefinitionModule(id, incr)
  84         register t_idf *id;
  85 {
  86         /*      Return a pointer to the "def" structure of the definition
  87                 module indicated by "id".
  88                 We may have to read the definition module itself.
  89                 Also increment level by "incr".
  90         */
  91         register t_def *df;
  92         static int level;
  93         t_scopelist *vis;
  94         char *fn = FileName;
  95         int ln = LineNumber;
  96         t_scope *newsc;
  97
  98         level += incr;
  99         df = lookup(id, GlobalScope, D_IMPORTED, 0);
 100         if (!df) {
 101                 /* Read definition module. Make an exception for SYSTEM.
 102                 */
 103                 extern int ForeignFlag;
 104
 105                 ForeignFlag = 0;
 106                 DefId = id;
 107                 open_scope(CLOSEDSCOPE);
 108                 newsc = CurrentScope;
 109                 vis = CurrVis;
 110                 newsc->sc_defmodule = incr;
 111                 if (!strcmp(id->id_text, "SYSTEM")) {
 112                         do_SYSTEM();
 113                         df = lookup(id, GlobalScope, D_IMPORTED, 0);
 114                 }
 115                 else {
 116                         if (!is_anon_idf(id) && GetFile(id->id_text)) {
 117
 118                                 char *f = FileName;
 119                                 DefModule();
 120                                 df = lookup(id, GlobalScope, D_IMPORTED, 0);
 121                                 if (level == 1 &&
 122                                     (df && !(df->df_flags & D_FOREIGN))) {
 123                                         /* The module is directly imported by
 124                                            the currently defined module, and
 125                                            is not foreign, so we have to
 126                                            remember its name because we have
 127                                            to call its initialization routine
 128                                         */
 129                                         static t_node *nd_end;
 130                                         register t_node *n;
 131                                         extern t_node *Modules;
 132
 133                                         n = dot2leaf(Def);
 134                                         n->nd_def = newsc->sc_definedby;
 135                                         if (nd_end) nd_end->nd_NEXT = n;
 136                                         else Modules = n;
 137                                         nd_end = n;
 138                                 }
 139                                 free(f);
 140                         }
 141                         else {
 142                                 df = lookup(id, GlobalScope, D_IMPORTED, 0);
 143                                 newsc->sc_name = id->id_text;
 144                         }
 145                 }
 146                 close_scope(SC_CHKFORW);
 147                 if (! df) {
 148                         df = MkDef(id, GlobalScope, D_ERROR);
 149                         df->mod_vis = vis;
 150                         newsc->sc_definedby = df;
 151                 }
 152         }
 153         else if (df->df_flags & D_BUSY) {
 154                 error("definition module \"%s\" depends on itself",
 155                         id->id_text);
 156         }
 157         else if (df == Defined && level == 1) {
 158                 error("cannot import from current module \"%s\"", id->id_text);
 159                 df->df_kind = D_ERROR;
 160         }
 161         FileName = fn;
 162         LineNumber = ln;
 163         assert(df);
 164         level -= incr;
 165         return df;
 166 }