home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / program / language / gofer / !GToC / h / gofc next >
Encoding:
Text File  |  1993-02-17  |  11.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.