home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel-075.lha / feel0.75 / AddOns / linkins.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-06-08  |  3.1 KB  |  154 lines
  1. /* ******************************************************************** */
  2. /* init_elvira.c     Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Interpreter elvira.                                            */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * Change Log:
  9.  *   Version 1, August 1990
  10.  */
  11.  
  12. /* No Elvira as yet... */
  13.  
  14. #include <irun.h>
  15. #include "allocate.h"
  16. #include "garbage.h"
  17. #include "error.h" 
  18.  
  19. #define FRAMEBUG(x) 
  20.  
  21. LispObject dlp;
  22.  
  23. LispObject elvira_slowcall_object;
  24.  
  25. LispObject Slowcall(LispObject i1)
  26. {
  27.   LispObject res;
  28.  
  29.   if (elvira_slowcall_object == nil)
  30.     CallError("slowcall: object to call unknown",i1,NONCONTINUABLE);
  31.  
  32.   res = module_mv_apply_1(elvira_slowcall_object,i1);
  33.   elvira_slowcall_object = NULL;
  34.  
  35.   return(res);
  36. }
  37.  
  38. LispObject allocate_e_function(LispObject mod,LispObject (*fun)(),int args)
  39. {
  40.   LispObject f;
  41.  
  42. FRAMEBUG(printf("Grabbing function object %d\n",args); fflush(stdout);)
  43.  
  44.   f = allocate_module_function(mod,nil,fun,args);
  45.   f->OBJECT.type = TYPE_E_FUNCTION;
  46.  
  47.   if (dp != nil) {
  48.  
  49.     if (FRAME_TYPE(dp) == nil) {    /* Copy it to the heap */
  50.       LispObject temp;
  51.       int i;
  52.  
  53.       STACK(f); STACK(dp);
  54.       temp = (LispObject) allocate_vector(dp->VECTOR.length);
  55.       UNSTACK(2);
  56.  
  57.       for (i = dp->VECTOR.length-1; i > 0; --i) 
  58.     VREF(temp,i) = VREF(dp,i);
  59.  
  60.       VREF(temp,0) = lisptrue; /* Heap frame */
  61.  
  62.       dlp = dp = temp;
  63.     }
  64.  
  65.   }
  66.   
  67.   f->C_FUNCTION.env = (Env) dp; /* Right? */
  68.  
  69. FRAMEBUG(printf("Grabbed function object %d\n",args); fflush(stdout);)
  70.  
  71.   return(f);
  72. }
  73.  
  74. void init_stack_frame(LispObject frame,int n)
  75. {
  76.   int i;
  77.  
  78. FRAMEBUG(printf("Initialising stack frame %d\n",n); fflush(stdout);)
  79.  
  80.   frame->VECTOR.type = TYPE_VECTOR;
  81.   frame->VECTOR.gc = -1;
  82.   frame->VECTOR.class = Vector;
  83.  
  84.   frame->VECTOR.next = NULL;
  85.   frame->VECTOR.length = n+2;
  86.  
  87.   FRAME_TYPE(frame) = nil; /* Stack frame */
  88.   LAST_FRAME(frame) = nil;
  89.  
  90.   for (i=0; i<n; ++i) VREF(frame,i+2) = nil;
  91.  
  92. FRAMEBUG(printf("Initialised stack frame %d\n",n); fflush(stdout);)
  93. }
  94.   
  95. LispObject allocate_e_macro(LispObject mod,LispObject (*fun)(),int args)
  96. {
  97.   LispObject f;
  98.  
  99.   f = allocate_module_function(mod,nil,fun,args);
  100.   
  101.   f->OBJECT.type = TYPE_E_MACRO;
  102.   f->C_FUNCTION.env = (Env) dp; /* Right? */
  103.  
  104.   return(f);
  105. }
  106.  
  107. LispObject *dynamic_ref(LispObject name)
  108. {
  109.   Env ee = DYNAMIC_ENV();
  110.  
  111.   while (ee != NULL)
  112.     if (ee->variable == name) 
  113.       return(&(ee->value));
  114.     else
  115.       ee = ee->next;
  116.  
  117.   if (name->SYMBOL.gvalue != NULL) 
  118.     return(&(name->SYMBOL.gvalue));
  119.   else
  120.     CallError("dynamic: name unbound",name,NONCONTINUABLE);
  121.  
  122.   return(&nil);
  123. }
  124.  
  125. LispObject dynamic_setq(LispObject name,LispObject value)
  126. {
  127.   Env ee = DYNAMIC_ENV();
  128.  
  129.   while (ee != NULL)
  130.     if (ee->variable == name) 
  131.       return(ee->value = value);
  132.     else
  133.       ee = ee->next;
  134.  
  135.   if (name->SYMBOL.gvalue != NULL) 
  136.     return(name->SYMBOL.gvalue = value);
  137.   else
  138.     CallError("dynamic-setq: name unbound",name,NONCONTINUABLE);
  139.  
  140.   return(nil);
  141. }
  142.       
  143.  
  144. void initialise_elvira_modules() 
  145. {
  146.   extern void initialise_YY();
  147.  
  148.   dp = nil;
  149.  
  150.   INIT_YY();
  151. }
  152.  
  153.  
  154.