home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / oper_sys / emerald / emrldsys.lha / Language / Compiler / evaluate.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-08-16  |  3.2 KB  |  134 lines
  1. /*
  2.  * @(#)evaluate.c    1.2  4/11/88
  3.  */
  4. #include "assert.h"
  5. #include "error.h"
  6. #include "scan.h"
  7. #include "nodes.h"
  8. #include "symbols.h"
  9. #include "MyParser.h"
  10. #include "sequence.h"
  11. #include "semantics.h"
  12. #include "system.h"
  13. #include "flags.h"
  14. #include "trace.h"
  15. #include "builtins.h"
  16. #include "map.h"
  17. #include "evaluate.h"
  18. #include "opNames.h"
  19. #include "option.h"
  20.  
  21. #undef NULL
  22. #include <sys/file.h>
  23. #include "ndbm.h"
  24. #undef NULL
  25. DBM *emDBM;
  26. extern char *emDirectory, *emdbDirectory;
  27.  
  28. #define NULL 0
  29. extern NodePtr ownNameSig, ownTypeSig, ownNameOpDef, ownTypeOpDef;
  30. extern OID ownNameOID, ownTypeOID;
  31. Map manifestMap;
  32.  
  33. NodePtr findObjectOperation(object, opName)
  34. NodePtr object, opName;
  35. {
  36.   int stage;
  37.   NodePtr ops, anop, asig, aname;
  38.   register OID theID;
  39.  
  40.   object = GETVALUE(object);
  41.   assert(object->tag == P_OBLIT);
  42.   assert(opName->tag == P_OPNAME);
  43.   theID = opName->b.opname.id;
  44.   for(stage = 0; stage < 2; stage++) {
  45.     if (stage == 0) {
  46.       ops = object->b.oblit.monitor;
  47.       if (ops != NULL) {
  48.     assert(ops->tag == P_MONITOR);
  49.     ops = ops->b.monitor.ops;
  50.       }
  51.     } else if (stage == 1) {
  52.       ops = object->b.oblit.ops;
  53.     }
  54.     Sequence_For(anop, ops)
  55.       assert(anop->tag == P_OPDEF);
  56.       asig = anop->b.opdef.sig;
  57.       assert(asig->tag == P_OPSIG);
  58.       aname = asig->b.opsig.name;
  59.       assert(aname->tag == P_OPNAME);
  60.       if (aname->b.opname.id == theID) {
  61.     return(anop);
  62.       }
  63.     Sequence_Next
  64.   }
  65.   /*
  66.    * It is possible that this is an invocation of ownName or ownType.
  67.    */
  68.   if (theID == ownNameOID) {
  69.     return(ownNameOpDef);
  70.   } else if (theID == ownTypeOID) {
  71.     return(ownTypeOpDef);
  72.   } else {
  73.     return(NN);
  74.   }
  75. }
  76.  
  77. void initializeManifest()
  78. {
  79.   char mappath[100];
  80.   manifestMap = Map_Create();
  81.   sprintf(mappath, "%s/DB/db", emdbDirectory);
  82.   if ((emDBM = dbm_open(mappath, O_RDWR | O_CREAT, 0777)) <= 0) {
  83.     fprintf(stderr, "Could not open the data base file %s\n", mappath);
  84.     exit(1);
  85.   }
  86. }
  87.  
  88. NodePtr figureOutAT(p)
  89. register NodePtr p;
  90. {
  91.   register Symbol st;
  92.   register NodePtr result = NULL;
  93.   if ((int) p <= 0x200) {
  94.     fprintf(stderr, "Strange value %d in figureOutAT.\n", (int)p);
  95.     assert(FALSE);
  96.   } else if (p->tag == P_ATLIT) {
  97.     result = p;
  98.   } else if (p->tag == P_BUILTINLIT) {
  99.     if (p->b.builtinlit.whichType != KARRAY &&
  100.     p->b.builtinlit.whichType != KVECTOR)
  101.       result = refToBuiltinFromToken(B_INSTAT, p->b.builtinlit.whichType);
  102.   } else if (p->tag == P_SYMREF) {
  103.     st = ST_Fetch(p->b.symref.symbol);
  104.     if (st->isManifest || st->hasValue) result = figureOutAT(st->value.value);
  105.   } else if (p->tag == P_OBLIT) {
  106.     if (p->b.oblit.instat != NULL) result = figureOutAT(p->b.oblit.instat);
  107.   } else if (p->tag == P_GLOBALREF) {
  108.     resolveGlobal(p, (ValuePtr)NULL);
  109.     result = figureOutAT(p->b.globalref.value);
  110.   } else {
  111.     NotImplemented(p, "Figuring out general ATs");
  112.   }
  113.   return(result);
  114. }
  115.  
  116. void tryToSetCTInfo(st)
  117. register Symbol st;
  118. {
  119. #ifdef JUNK
  120.   register NodePtr at, ct;
  121.   if (loadedDummyBuiltins) return;
  122.   at = st->value.ATinfo;
  123.   assert(at != NULL);
  124.   if (at->b.atlit.f.cannotBeConformedTo) {
  125.     if (at->b.atlit.codeOID == 0) return;
  126.     ct = OTLookup(at->b.atlit.codeOID);
  127.     if (ct == NN) return;
  128.     if (ct->tag != P_OBLIT) return;
  129.     st->value.CTinfo = ct;
  130.   }
  131. #endif
  132. }
  133.  
  134.