home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacGofer 0.22d / MacGofer Sources / builtin.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-01-06  |  8.0 KB  |  230 lines  |  [TEXT/MPS ]
  1. /* --------------------------------------------------------------------------
  2.  * builtin.c:   Copyright (c) Mark P Jones 1991-1993.   All rights reserved.
  3.  *              See goferite.h for details and conditions of use etc...
  4.  *              Gofer version 2.28 January 1993
  5.  *
  6.  * Primitive functions, input output etc...
  7.  * ------------------------------------------------------------------------*/
  8.  
  9. #define  NEED_MATH
  10. #include "prelude.h"
  11. #include "storage.h"
  12. #include "connect.h"
  13. #include "errors.h"
  14.  
  15. #if MPW
  16. #pragma segment Builtin
  17. #endif
  18.  
  19. Name nameFatbar, nameFail;        /* primitives reqd for translation */
  20. Name nameIf,     nameSel;
  21. Name nameMinus,  nameDivide;
  22.  
  23. Name nameUndefMem;            /* undefined member primitive       */
  24. Name nameError;                /* error primitive function       */
  25. Name nameBlackHole;            /* for GC-detected black hole       */
  26.  
  27. Name nameAnd,    nameOr;        /* built-in logical connectives       */
  28. Name nameOtherwise;
  29.  
  30. Name namePrint,  nameNPrint;        /* primitives for printing       */
  31.  
  32. /* Should probably be standard?  KH */
  33. #if 1
  34. static Name nameAsinh, nameAcosh, nameAtanh;    /* Float primitives */
  35. #endif
  36.  
  37. #ifdef LAMBDAVAR
  38. static Name nameLvUnbound;        /* unbound mutable variable       */
  39. #endif
  40. #ifdef LAMBDANU
  41. static Name nameLnUnbound;        /* unbound mutable variable       */
  42. static Name nameLnNocont;        /* unspecified continuation       */
  43. static Name nameLnFlip;            /* simple flip primitive       */
  44. static Name nameLnDone;            /* simple finishing continuation   */
  45. #endif
  46.  
  47.  
  48. #if MAC
  49. static Name nameUnitIO;            /* unitIO primitive           */
  50. static Name nameCUnitIO;        /* unitIO primitive closure       */
  51.  
  52. static Name nameBindIO;            /* bindIO primitive           */
  53. static Name nameCBindIO;        /* bindIO primitive closure       */
  54. static Name nameCCBindIO;        /* second bindIO primitive closure */
  55.  
  56. static Name nameTrap;            /* Trap primitive           */
  57. static Name nameTrapReg;        /* Trap Register primitive       */
  58. static Name nameAssign;            /* Assign primitive           */
  59. static Name nameAssignS;        /* Short Assign primitive       */
  60. static Name nameAssignC;        /* Char Assign primitive       */
  61. static Name nameAssignBlock;        /* Block Assign primitive       */
  62. static Name nameMalloc;            /* Malloc primitive           */
  63. static Name nameFree;            /* Free primitive           */
  64. static Name nameDeref;            /* Deref primitive           */
  65. static Name nameSeq;            /* Seq primitive           */
  66. static Name nameTrace;            /* Trace primitive           */
  67.  
  68. static Name nameButton;            /* Button primitive           */
  69. static Name nameGetMouse;        /* GetMouse primitive           */
  70. static Name nameLineTo;            /* LineTo primitive           */
  71. static Name nameMoveTo;            /* MoveTo primitive           */
  72.  
  73. static Name nameGetNextEvt;        /* Event reading primitive       */
  74. static Name nameEvtAvail;        /* Event testing primitive       */
  75.  
  76. static Name nameCreateCallback;        /* Create callback fn primitive       */
  77. static Name nameDisposeCallback;    /* Dispose callback fn primitive   */
  78.  
  79. extern Name nameImperate;        /* Imperate request           */
  80. extern Name nameIO;            /* IO constructor           */
  81. #endif
  82.  
  83. /* --------------------------------------------------------------------------
  84.  * Built-in primitives:
  85.  * ------------------------------------------------------------------------*/
  86.  
  87. #if MPW
  88. #pragma segment Primitives
  89. #endif
  90.  
  91. #define PRIMITIVES_CODE 1        /* want to include code for prims  */
  92. #include "prims.c"
  93.  
  94. #if MPW
  95. #pragma segment Builtin2
  96. #endif
  97.  
  98. /* --------------------------------------------------------------------------
  99.  * Built-in control:
  100.  * ------------------------------------------------------------------------*/
  101.  
  102. Void builtIn(what)
  103. Int what; {
  104.     Int i;
  105.  
  106.     switch (what) {
  107.     case RESET   : if (writingFile) {
  108.                fclose(writingFile);
  109.                writingFile = 0;
  110.                }
  111.                break;
  112.  
  113.     case MARK    : for (i=0; i<NUM_CHARS; ++i)
  114.                mark(consCharArray[i]);
  115.                break;
  116.  
  117.     case INSTALL : for (i=0; i<NUM_CHARS; ++i)
  118.                consCharArray[i] = ap(nameCons,mkChar(i));
  119.  
  120.                consOpen       = consCharArray['('];
  121.                consSpace      = consCharArray[' '];
  122.                consComma      = consCharArray[','];
  123.                consClose      = consCharArray[')'];
  124.                consObrace     = consCharArray['{'];
  125.                consCbrace     = consCharArray['}'];
  126.                consOsq          = consCharArray['['];
  127.                consCsq          = consCharArray[']'];
  128.                consBack       = consCharArray['`'];
  129.                consMinus      = consCharArray['-'];
  130.                consQuote      = consCharArray['\''];
  131.                consDQuote     = consCharArray['\"'];
  132.  
  133. #define pFun(n,s,t)    addPrim(0,n=newName(findText(s)),t,NIL)
  134.                pFun(nameFatbar,       "_FATBAR", "primFatbar");
  135.                pFun(nameFail,       "_FAIL",   "primFail");
  136.                pFun(nameIf,       "_IF",     "primIf");
  137.                pFun(nameSel,       "_SEL",    "primSel");
  138.  
  139.                pFun(nameMinus,     "_minus",  "primMinusInt");
  140.                pFun(nameDivide,       "_divide", "primDivInt");
  141.  
  142.                pFun(namePrimCmp,   "_compare", "primCompare");
  143.                pFun(namePrint,       "_print",   "primPrint");
  144.                pFun(nameNPrint,       "_nprint",  "primNprint");
  145.                pFun(nameLPrint,       "_lprint",  "primLprint");
  146.                pFun(nameNLPrint,   "_nlprint", "primNlprint");
  147.                pFun(nameSPrint,       "_sprint",  "primSprint");
  148.                pFun(nameNSPrint,   "_nsprint", "primNsprint");
  149.                pFun(nameInput,       "_input",   "primInput");
  150.                pFun(nameUndefMem,  "_undefined_member", "primUndefMem");
  151.                pFun(nameBlackHole, "Gc Black Hole", "primGCBhole");
  152. #ifdef LAMBDAVAR
  153.                pFun(nameLvUnbound, "Unbound mutable variable",
  154.                             "primLvUnbound");
  155. #endif
  156. #ifdef LAMBDANU
  157.                pFun(nameLnUnbound, "Unbound mutable variable",
  158.                             "primLnUnbound");
  159.                pFun(nameLnNocont,  "Unspecified continuation",
  160.                             "primLnNocont");
  161.                pFun(nameLnFlip,       "_LambdaNuFlip", "primLnFlip");
  162.                pFun(nameLnDone,       "_LambdaNuDone", "primLnDone");
  163. #endif
  164.  
  165. #if MAC
  166.                pFun(nameUnitIO,         "_unitIO",      "primUnitIO");
  167.                pFun(nameCUnitIO,     "_cunitio",    "primCUnitIO");
  168.  
  169.                pFun(nameBindIO,         "_bindIO",      "primBindIO");
  170.                pFun(nameCBindIO,     "_cbindio",     "primCBindIO");
  171.                pFun(nameCCBindIO,    "_ccbindio",    "primCCBindIO");
  172.  
  173.                pFun(nameTrap,         "_trap",        "primTrap");
  174.                pFun(nameTrapReg,     "_trapReg",     "primTrapReg");
  175.                pFun(nameAssign,         "_assign",      "primAssign");
  176.                pFun(nameAssignS,     "_assignS",     "primAssignS");
  177.                pFun(nameAssignC,     "_assignC",     "primAssignC");
  178.                pFun(nameAssignBlock, "_assignBlock", "primAssignBlock");
  179.                pFun(nameDeref,       "_deref",       "primDeref");
  180.                pFun(nameMalloc,      "_malloc",      "primMalloc");
  181.                pFun(nameFree,        "_free",        "primFree");
  182.                pFun(nameSeq,         "_seq",         "primSeq");
  183.                pFun(nameTrace,       "_trace",       "primTrace");
  184.  
  185.                pFun(nameButton ,     "_button",      "primButton");
  186.                pFun(nameGetMouse,    "_getMouse",    "primGetMouse");
  187.                pFun(nameLineTo ,     "_lineTo",      "primLineTo");
  188.                pFun(nameMoveTo ,     "_moveTo",      "primMoveTo");
  189.  
  190.                pFun(nameGetNextEvt,  "_getNextEvent","primGetNextEvent");
  191.                pFun(nameEvtAvail,    "_eventAvail",  "primEventAvail");
  192.  
  193.                pFun(nameCreateCallback,  "_createCallback",  "primCreateCallback");
  194.                pFun(nameDisposeCallback, "_disposeCallback", "primDisposeCallback");
  195. #endif
  196.  
  197. #undef pFun
  198. #define predef(nm,str) nm=newName(findText(str)); name(nm).defn=PREDEFINED
  199.                predef(nameAnd,        "&&");
  200.                predef(nameOr,        "||");
  201.                predef(nameOtherwise,    "otherwise");
  202.                predef(nameError,    "error");
  203. #undef  predef
  204.                break;
  205.     }
  206. }
  207.  
  208. #if 1
  209. /*  Reinitialise pre-defined names, so we can reload the Prelude.   KH */
  210. #define Predef(nm) name(nm).defn=PREDEFINED; \
  211.                    name(nm).line   = 0;         \
  212.                    name(nm).arity   = 0;     \
  213.                    name(nm).number  = 0;     \
  214.                       name(nm).type    = 0;     \
  215.                       name(nm).code    = 0;     \
  216.                       name(nm).primDef = 0;
  217.  
  218.  
  219. InitPredefNames()
  220. {
  221.   Predef(nameAnd);
  222.   Predef(nameOr);
  223.   Predef(nameOtherwise);
  224.   Predef(nameError);
  225. }
  226.  
  227. #endif
  228.  
  229. /*-------------------------------------------------------------------------*/
  230.