home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / gofer / Sources / h / gofc < prev    next >
Encoding:
Text File  |  1993-02-12  |  9.6 KB  |  285 lines
  1. /* --------------------------------------------------------------------------
  2.  * gofc.h:      Copyright (c) Mark P Jones 1991-1993.   All rights reserved.
  3.  *              See goferite.h for details and conditions of use etc...
  4.  *        Gofer Compiler version 1.00 February 1992
  5.  *              Gofer version 2.28 January 1993
  6.  *
  7.  * Header file for Gofer Compiler runtime system.
  8.  * ------------------------------------------------------------------------*/
  9.  
  10. #include "prelude.h"
  11.  
  12. /*- Garbage collected heap ------------------------------------------------*/
  13.  
  14. #define GC_MARKSCAN    0            /* for mark/scan collector */
  15. #define GC_TWOSPACE    1            /* for twospace collector  */
  16.  
  17. typedef Int        Cell;            /* general cell value       */
  18. typedef Cell far    *Heap;            /* storage of heap       */
  19. extern  Int        heapSize;        /* Pairs are stored in the */
  20. extern  Void        garbageCollect Args((Void));
  21.  
  22. #if      GC_MARKSCAN
  23. #ifdef   GLOBALcar
  24. register Heap heapTopCar GLOBALcar;        /* Cells with -ve indices  */
  25. #else
  26. extern   Heap heapTopCar;
  27. #endif
  28. #ifdef   GLOBALcdr
  29. register Heap heapTopCdr GLOBALcdr;
  30. #else
  31. extern   Heap heapTopCdr;
  32. #endif
  33. #define fst(c)        heapTopCar[c]
  34. #define snd(c)        heapTopCdr[c]
  35. #define isPair(c)    ((c)<0)
  36. extern  Cell        pair    Args((Cell,Cell));
  37. #endif
  38.  
  39. #if    GC_TWOSPACE
  40. #ifdef  GLOBALcar
  41. register Heap        from GLOBALcar;
  42. #else
  43. extern  Heap        from;            /* top of from space       */
  44. #endif
  45. #ifdef  GLOBALcdr
  46. register Cell        hp GLOBALcdr;
  47. #else
  48. extern  Cell        hp;            /* last used heap loc       */
  49. #endif
  50. #define fst(c)        from[c]
  51. #define snd(c)        from[(c)+1]
  52. #define isPair(c)    ((c)<0)
  53. #define INLINE_ALLOC    0            /* 1 => allocate inline       */
  54. #if     INLINE_ALLOC
  55. #define pair(l,r)    ((from[++hp]=(l)), (from[++hp]=(r)), (hp-1))
  56. #else
  57. extern  Cell        pair    Args((Cell,Cell));
  58. #endif
  59. #endif
  60.  
  61. /*- Tags for fst() element in particular kinds of Pair ------------------- */
  62.  
  63. #define INDIRECT    0            /* Indirection           */
  64. #define INDIRECT1    1            /* Second form used in gc  */
  65. #define FORWARD        2            /* Forwarding pointer       */
  66. #define INTCELL         3            /* (Big) Integer       */
  67. #define STRCELL        4            /* Character String       */
  68. #define SUPERCOMB    5            /* Supercombinator       */
  69. #define FILECELL    6            /* File value           */
  70. #define FLOATCELL    7            /* Floating point       */
  71. #if BREAK_FLOATS
  72. #define MAXBOXTAG       FILECELL        /* Last boxed cell tag       */
  73. extern  Cell        safeMkFloat    Args((FloatPro));
  74. #else
  75. #define MAXBOXTAG    FLOATCELL        /* Last boxed cell tag       */
  76. #define safeMkFloat(n)    mkFloat(n)
  77. #endif
  78. #define MAXTAG        FLOATCELL        /* Last tag value       */
  79.  
  80. #define mkBig(n)    pair(INTCELL,n)
  81. #define bigOf(c)    ((Int)(snd(c)))
  82.  
  83. typedef FloatImpType    Float;
  84. extern  Cell        mkFloat        Args((FloatPro));
  85. extern    FloatPro    floatOf        Args((Cell));
  86. extern    String        floatToString    Args((FloatPro));
  87. extern  FloatPro    stringToFloat    Args((String));
  88.  
  89. #define mkString(s)    pair(STRCELL,(Int)(s))
  90. #define stringOf(c)    ((String)(snd(c)))
  91.  
  92. #define mkSuper(sc)    pair(SUPERCOMB,(Int)(sc))
  93. #define superOf(c)      ((Super *)(snd(c)))
  94.  
  95. /*- Cells>MAXTAG represent small integers, characters, dictionaries and -- */
  96. /*- constructor functions -- we don't have to worry which since these ---- */
  97. /*- routines will only be used with well-typed source programs ----------- */
  98.  
  99. #define SMALLMIN    (MAXTAG+2)
  100. #define SMALLMAX        MAXPOSINT
  101. #define SMALLZERO       (SMALLMIN/2 + SMALLMAX/2)
  102. #define isSmall(c)      (SMALLMIN<=(c))
  103. #define mkSmall(n)      (SMALLZERO+(n))
  104. #define smallOf(c)      ((Int)(c-SMALLZERO))
  105.  
  106. #define mkInt(n)    (isSmall(mkSmall(n)) ? mkSmall(n) : mkBig(n))
  107. #define intOf(c)    (isSmall(c) ? smallOf(c) : bigOf(c))
  108.  
  109. #define mkChar(c)    ((Cell)(SMALLMIN+((unsigned)((c)%NUM_CHARS))))
  110. #define charOf(c)       ((char)((c)-SMALLMIN))
  111.  
  112. #define mkDict(n)    ((Cell)(SMALLMIN+(n)))
  113. #define dictOf(c)       ((Int)((c)-SMALLMIN))
  114.  
  115. #define mkCfun(n)    ((Cell)(SMALLMIN+(n)))
  116. #define cfunOf(c)    ((Int)((c)-SMALLMIN))
  117. #define FAIL        mkCfun(-1)        /* Every type has a Fail   */
  118.  
  119. /*- Control stack implementation ------------------------------------------*/
  120.  
  121. typedef Cell        *StackPtr;         /* stack pointer       */
  122. extern    Cell        cellStack[];
  123. #ifdef  GLOBALsp
  124. register StackPtr    sp GLOBALsp;
  125. #else
  126. extern    StackPtr    sp;
  127. #endif
  128. #define clearStack()    sp=cellStack+NUM_STACK
  129. #define stackLoop(i)    for (i=cellStack+NUM_STACK-1; i>=sp; i--)
  130. #define push(c)          if (sp>cellStack) *--sp=(c); else overflow()
  131. #define    onto(c)        *--sp=(c)        /* fast form of push()       */
  132. #define pop()        *sp++
  133. #define drop()        sp++
  134. #define top()        *sp
  135. #define pushed(n)    sp[n]
  136. #define pushedSince(p)    ((Int)((p)-sp))
  137. #define offset(n)    root[-(n)]
  138.  
  139. /*- references to body of compiled code -----------------------------------*/
  140.  
  141. #define ARGCHECK 0        /* set to 1 for no. of argument checking   */
  142. extern  int argcheck;        /* check for consistency between main       */
  143.                 /* program and runtime library           */
  144.  
  145. extern  int        num_scs;        /* supercombinators       */
  146. extern  Cell        sc[];
  147. #if    ARGCHECK
  148. typedef Void        Super Args((StackPtr));
  149. #else
  150. typedef Void        Super Args((Void));
  151. #endif
  152. extern  Super        *scNames[];
  153.  
  154. extern  int        num_dicts;        /* dictionaries           */
  155. extern  Cell        dict[];
  156. extern  int        dictImps[];
  157. #define dsel(n,d)    dict[dictOf(d)+n]
  158.  
  159. /*-Super combinator skeleton definition -------------------------------------
  160.  * the following macros are used to construct the heading for a super-
  161.  * combinator definition.  The combn() family of macros is used for the
  162.  * benefit of compilers which do not automatically unroll small loops.
  163.  * combinators with >9 args are headed using the comb macro, and a loop is
  164.  * always used ... at least in the C code.  Adjust according to taste!
  165.  * ------------------------------------------------------------------------*/
  166.  
  167. #if     ARGCHECK
  168. #define defSc(nm,args)    Void nm(root)                       \
  169.             register StackPtr root; {               \
  170.                 if (root-sp<=args)                   \
  171.                 insufficientArgs();               \
  172.                 root=sp;
  173. #else
  174. #define defSc(nm,args)    Void nm() {                       \
  175.                 register StackPtr root=sp;
  176. #endif
  177. #define Arg        *root = snd(*(root+1)); root++;
  178. #define needStack(n)    if (sp-cellStack<n) overflow()
  179. #define End        }
  180.  
  181. #define comb(nm,n)    defSc(nm,n) {int i=n; do {Arg} while (--i>0);}
  182. #define comb0(nm)    defSc(nm,0)
  183. #define comb1(nm)    defSc(nm,1) Arg
  184. #define comb2(nm)    defSc(nm,2) Arg Arg
  185. #define comb3(nm)    defSc(nm,3) Arg Arg Arg
  186. #define comb4(nm)    defSc(nm,4) Arg Arg Arg Arg
  187. #define comb5(nm)    defSc(nm,5) Arg Arg Arg Arg Arg
  188. #define comb6(nm)    comb(nm,6)
  189. #define comb7(nm)    comb(nm,7)
  190. #define comb8(nm)    comb(nm,8)
  191. #define comb9(nm)    comb(nm,9)
  192.  
  193. /*- macros for simple steps in compiled code -------------------------------*/
  194.  
  195. extern  Cell whnf;        /* head of term in weak head normal form    */
  196. extern  Int  whnfInt;        /* integer value for term in whnf        */
  197.  
  198. #define pushInt(n)        onto(mkInt(n))
  199. #define pushFloat(f)        onto(safeMkFloat(f))
  200. #define pushStr(s)        onto(mkString(s))
  201. #define mkap()            sp[1]=pair(*sp,sp[1]); sp++
  202. #define toparg(e)        *sp=pair(*sp,e)
  203. #define topfun(e)        *sp=pair(e,*sp)
  204. #define pushpair(l,r)        onto(pair(l,r))
  205. #define updap(o,l,r)        snd(root[-o])=r; fst(root[-o])=l
  206. #define update(o,c)        updap(o,INDIRECT,c)
  207. #define updap2(o)        updap(o,*sp,sp[1]); sp+=2
  208. #define alloc()            pushpair(0,0)
  209. #define slide(n,e)        pushed(n)=e; sp+=n
  210. #define setstk(n)        sp=root-n
  211. #define test(c)            if (whnf!=c)
  212. #define inteq(n)        if (whnfInt!=n)
  213. #define intge(h,n)        if (whnfInt>=n) {               \
  214.                     heap(h);                   \
  215.                     onto(mkInt(whnfInt-n));           \
  216.                 } else
  217. #define intdv(h,n)        if (whnfInt>=0 && (whnfInt%n==0)) {       \
  218.                     heap(h);                   \
  219.                     onto(mkInt(whnfInt/n));           \
  220.                 } else
  221. #define ret()            sp=root; return
  222.  
  223. /* N.B.  values in heap() calls are possibly overestimates of storage use
  224.  * if INTCELL or FLOATCELL (with BREAK_FLOATS) values are ever allocated.
  225.  * If you change the basic allocators used here so that the exact figure
  226.  * is required, it will probably be best to make sure that an INTCELL is
  227.  * _always_ heap allocated (including the two INTCELLs that make up a
  228.  * BREAK_FLOATS FLOATCELL).  The alternative is to arrange that any unfilled
  229.  * cells are filled in with blanks of an appropriate form.
  230.  */
  231. #if GC_MARKSCAN
  232. #define heap(n)            /*do nothing*/
  233. #endif
  234. #if GC_TWOSPACE
  235. #define heap(n)            if (hp+(2*n)>=0) garbageCollect()
  236. #endif
  237.  
  238. /*- builtin primitive functions -------------------------------------------*/
  239.  
  240. extern Cell primFatbar,     primFail;    /* System (internal) primitives       */
  241. extern Cell primUndefMem,   primBlackHole;
  242. extern Cell primSel,        primIf;
  243. extern Cell primStrict;
  244.  
  245. extern Cell primPlusInt,    primMinusInt;/* User (general) primitives       */
  246. extern Cell primMulInt,     primDivInt;
  247. extern Cell primModInt,     primRemInt;
  248. extern Cell primNegInt,        primQuotInt;
  249. extern Cell primCharToInt,  primIntToChar;
  250. extern Cell primIntToFloat;
  251. extern Cell primPlusFloat,  primMinusFloat;
  252. extern Cell primMulFloat,   primDivFloat;
  253. extern Cell primNegFloat;
  254. extern Cell primEqInt,        primLeInt;
  255. extern Cell primEqChar,     primLeChar;
  256. extern Cell primEqFloat,    primLeFloat;
  257. extern Cell primGenericEq,  primGenericNe;
  258. extern Cell primGenericGt,  primGenericGe;
  259. extern Cell primGenericLt,  primGenericLe;
  260. extern Cell primShowsInt,   primShowsFloat;
  261. extern Cell primError;
  262. extern Cell primFopen;
  263.  
  264. #if  HAS_FLOATS
  265. extern Cell primSinFloat,   primAsinFloat;
  266. extern Cell primCosFloat,   primAcosFloat;
  267. extern Cell primTanFloat,   primAtanFloat;
  268. extern Cell primAtan2Float, primExpFloat;
  269. extern Cell primLogFloat,   primLog10Float;
  270. extern Cell primSqrtFloat,  primFloatToInt;
  271. #endif
  272.  
  273. /*- runtime support functions and variables -------------------------------*/
  274.  
  275. extern Void eval        Args((Cell));
  276. extern Void overflow        Args((Void));
  277. extern Void insufficientArgs    Args((Void));
  278. extern Void fail        Args((Void));
  279. extern Cell rootFst        Args((Cell));
  280. extern Int  readTerminalChar    Args((Void));
  281. extern Void noechoTerminal    Args((Void));
  282. extern Void normalTerminal    Args((Void));
  283.  
  284. /* ----------------------------------------------------------------------- */
  285.