home *** CD-ROM | disk | FTP | other *** search
/ Super Net 1 / SUPERNET_1.iso / PC / OTROS / MSDOS / WATTCP / DELFT / SAGE.TAR / sage / scheme / schinc.h < prev    next >
Encoding:
C/C++ Source or Header  |  1991-04-26  |  20.4 KB  |  420 lines
  1. /**********************************************************************
  2. ** MODULE INFORMATION*
  3. **********************
  4. **      FILE     NAME:       SCHINC.H
  5. **      SYSTEM   NAME:       SCHEME 
  6. **      ORIGINAL AUTHOR(S):  Alfred Kayser
  7. **      VERSION  NUMBER:     1.5.5
  8. **      CREATION DATE:       88/03/01
  9. **
  10. ** DESCRIPTION: Global include file for the SCHEME system.
  11. ***********************************************************************
  12. ** CHANGES INFORMATION **
  13. *************************
  14. ** REVISION:    $Revision: $
  15. ** CHANGER:     $Author: $
  16. ** WORKFILE:    $Workfile: $
  17. ** LOGFILE:     $Logfile: $
  18. ** LOGINFO:     $Log: $
  19. **********************************************************************/
  20. #define MAXSTR    2048            /* Maximum string size */
  21. #define IOBUFSIZE 512             /* buffer size of file IO ports */
  22. #define AUTHOR    "Alfred Kayser"
  23. #define SYSTEM    "DScheme"
  24. #define VERSION   "1.5.5"
  25.  
  26. #if defined OS2 || defined MSDOS  /* All OS/2 compilers are more or less ANSI */
  27. #define MSC                    /* Both are MicroSoft C (No TURBO-C Please!!!) */
  28. #define __STDC__                   /* An ANSI volation itself, but it must be */
  29. #endif
  30.  
  31.  /******************* All included headerfiles ******************/
  32. #ifdef __STDC__
  33. # include <signal.h>
  34. # include <stdarg.h>
  35. # include <stdlib.h>
  36. # include <malloc.h>
  37. # include <limits.h>
  38. #else
  39. # include <varargs.h>
  40. # include <values.h>
  41. # include <sys/signal.h>
  42. #endif
  43. #include <stdio.h>
  44. #include <string.h>
  45. #include <ctype.h>
  46. #include <math.h>
  47. #include <errno.h>
  48. #include <time.h>
  49. #include <setjmp.h>
  50.  
  51. #ifndef OS2_INCLUDED               /* OS/2 has already defined these in os2.h */
  52.   typedef          char  CHAR;
  53.   typedef          short SHORT;
  54.   typedef          long  LONG;
  55.   typedef unsigned char  BYTE;
  56.   typedef unsigned short USHORT;
  57.   typedef unsigned long  ULONG;
  58. # undef __                   /* Undefine various junk */
  59. # undef PASCAL
  60. # undef FAR
  61. #endif
  62.         
  63. typedef SHORT WORD;         
  64. typedef LONG DWORD;
  65.  
  66. #ifdef __STDC__
  67. #define __(a) a
  68. #define VAR_ARGS        
  69. #define VAR_DCL
  70. #define VAR_START(va,f) va_start(va,f)
  71. #else
  72. #define __(a) ()
  73. #define VAR_ARGS        , va_alist
  74. #define VAR_DCL         va_dcl
  75. #define VAR_START(va,f) va_start(va)
  76. #endif
  77.  
  78. #ifdef MSC
  79. # pragma pack(2)
  80. # include <conio.h>
  81. # include <dos.h>
  82. # define FAR               _far
  83. # define FARMALLOC(size,t) _fmalloc((size)*sizeof(t))
  84. # define FFREE(size)       _ffree(size)
  85. # define CDECL             _cdecl
  86. # define CONST             const
  87. # define PASCAL           _fastcall
  88. # define MATHTRAP         
  89. # ifdef OS2
  90. #  undef MSDOS             /* Undo 'bug' of Microsoft C */
  91. # endif                    /* Compiling /Lp under OS2 has MSDOS defined */
  92. #endif
  93.  
  94. #ifdef UNIX
  95. # define UNTYPE    char
  96. # define MATHTRAP         
  97. #endif
  98.  
  99. /*---------------------- Defaults of various defines ----------------------*/
  100. #ifndef INT_MAX
  101. # define INT_MAX MAXINT
  102. # define time_t  long
  103. #endif
  104. #ifndef SIG_ERR
  105. # define SIG_ERR -1
  106. #endif
  107. #ifndef CLOCKS_PER_SEC
  108. # define CLOCKS_PER_SEC   1000000L  /* number of ticks per seconds */
  109. #endif
  110. #ifndef FAR
  111. # define FAR
  112. # define FARMALLOC(size,t) (t *)malloc((size)*sizeof(t))
  113. # define FFREE(size)       free(size)
  114. #endif
  115. #ifndef CDECL
  116. # define CDECL
  117. #endif
  118. #ifndef PASCAL
  119. # define PASCAL
  120. #endif
  121. #ifndef UNTYPE
  122. # define UNTYPE void
  123. #endif
  124. #ifndef CONST
  125. # define CONST
  126. #endif
  127. #ifndef SEEK_SET
  128. # define SEEK_SET 0
  129. # define SEEK_CUR 1
  130. # define SEEK_END 2
  131. #endif
  132.  
  133. /*----------------------------------------------------------------------*/
  134. /* Definition datatypes                                                 */
  135. /*----------------------------------------------------------------------*/
  136.  
  137.                                 /*--------------------------------------*/
  138. typedef struct  _cel    CEL;    /* Scheme cell                          */
  139. typedef CEL  FAR *      CELP;   /* Pointer to scheme cell               */
  140. typedef CELP FAR *      CELPP;  /* (far) pointer to cell pointer        */
  141. typedef struct  _pts    PTS;    /* 2 pointers to Scheme cell            */
  142. typedef struct  _pti    PTI;    /* 1 int & 1 pointer                    */
  143. typedef struct  _tms    TMS;    /* 1 long & 1 float                     */
  144. typedef struct  _str    STP;    /* String construction part             */
  145. typedef union   _cvl    CVAL;   /* Scheme cell without tag              */
  146. typedef struct  _key    KEY;    /* Key cell                             */
  147. typedef struct  _ext    EXT;    /* External procedure cell              */
  148. typedef struct  _big    BIG;    /* Bignum integer                       */
  149. typedef int             CHR;    /* Scheme character                     */
  150. typedef double          REAL;   /* Scheme floating point                */
  151. typedef struct  _port   PORT;   /* Structure with filedefinition        */
  152. typedef struct  _glb    GLOBAL; /* Structure with global var's          */
  153. typedef struct _extdef  EXTDEF; /* External definition record           */
  154.                                 /*--------------------------------------*/
  155.                  
  156. typedef void  (PASCAL * TCALL) __((int));              /* Trace Call function */
  157. typedef int   (PASCAL * INP_FUN) __((UNTYPE *));             /* same as fgetc */
  158. typedef void  (PASCAL * OUT_FUN) __((int, UNTYPE *));        /* same as fputc */
  159. typedef void  (PASCAL * CTL_FUN) __((UNTYPE *, int)); 
  160. typedef CELP  (* EXTPROC) __((void));      
  161. typedef int   (* ERRFUN)  __((GLOBAL *, int, CELP)); 
  162.  
  163. /*----------------------------------------------------------------------*/
  164. /*  Scheme structures and such                                          */
  165. /*  The CDR pointer used in _pts,_pti and _str must be on the           */
  166. /*  same place in all structures.                                       */
  167. /*----------------------------------------------------------------------*/
  168.  
  169. struct  _pts  {                 /*--------------------------------------*/
  170.               CELP    cdr;      /* Cdr pointer                      (4) */
  171.               CELP    car;      /* Car pointer                      (4) */
  172.               };                /*--------------------------------------*/
  173.  
  174. struct  _pti  {                 /*--------------------------------------*/
  175.               CELP    cdr;      /* Cdr pointer (blockallocation)    (4) */
  176.               long    icar;     /* Car value (this pair is for)     (4) */
  177.               };                /*--------------------------------------*/
  178.  
  179. struct  _ext  {                 /*--------------------------------------*/
  180.               CELP    cdr;      /* Cdr pointer (points to name)     (4) */
  181.               EXTDEF *extdef;   /* External function definition     (4) */
  182.               };                /*--------------------------------------*/
  183.  
  184. struct  _key  {                 /*--------------------------------------*/
  185.               CELP    cdr;      /* Cdr pointer (points to name)     (4) */
  186.               WORD    keynr;    /* Keyword number                   (2) */
  187.               WORD    args;     /* Number of arguments to expect    (2) */
  188.               };                /*--------------------------------------*/
  189.  
  190. struct  _str  {                 /*--------------------------------------*/
  191.               char *  stp;      /* Pointer to string                (4) */
  192.               int     len;      /* length of string                 (2) */
  193.               };                /*--------------------------------------*/
  194.  
  195. struct  _tms  {                 /*--------------------------------------*/
  196.               WORD    time;     /* month+day (0=unknown)            (2) */
  197.               WORD    date;     /* year (0=unknown)                 (2) */
  198.               float   fsec;     /* float  (fraction of secs)        (4) */
  199.               };                /*--------------------------------------*/
  200.  
  201. struct  _big  {                 /*--------------------------------------*/
  202.               CELP    cdr;      /* ptr to next part of bignum.      (4) */
  203.               long    int1;     /* 9 digits integer for bignum      (4) */
  204.               };                /*--------------------------------------*/
  205.  
  206. union   _cvl  {                 /*--------------------------------------*/
  207.               PTS     pair;     /* a pair cell (2 pointers)             */
  208.               PTI     spec;     /* a special cell                       */
  209.               KEY     key;      /* key cell                             */
  210.               EXT     ext;      /* external procedure cell              */
  211.               BIG     bignum;   /* bignumber                            */
  212.               REAL    rv;       /* Floating point value                 */
  213.               CHR     ch;       /* Character                            */
  214.               TMS     ts;       /* Timestamp (long + float)             */
  215.               STP     sp;       /* Pointer to string + length           */
  216.               PORT   *prt;      /* Scheme port                          */
  217.               };                /*--------------------------------------*/
  218.  
  219. struct  _cel  {                 /*--------------------------------------*/
  220.               BYTE    tag;      /* Cell type indicator              (1) */
  221.               BYTE    gcflags;  /* Garbage collector flags          (1) */
  222.               CVAL    dat;      /* Value of this cell               (8) */
  223.               };                /*--------------------------------------*/
  224.  
  225. struct _extdef{                 /*--------------------------------------*/
  226.               char   *name;     /* pointer to name                  (4) */
  227.               EXTPROC extrn;    /* function pointer                 (4) */
  228.               WORD    args;     /* Number of arguments to expect    (2) */
  229.               BYTE    at1;      /* Indicates type of arg 1 wanted   (1) */
  230.               BYTE    at2;      /* Indicates type of arg 2 wanted   (1) */
  231.               BYTE    at3;      /* Indicates type of arg 3 wanted   (1) */
  232.               };                /*--------------------------------------*/
  233.  
  234. struct _port  {                 /*--------------------------------------*/
  235.               UNTYPE *stream;   /* Pointer to stream info           (2) */
  236.               OUT_FUN portout;  /* input function                   (2) */
  237.               INP_FUN portin;   /* output function                  (2) */
  238.               CTL_FUN portctl;  /* port control function            (2) */
  239.               DWORD   lineno;   /* line number                      (4) */
  240.               WORD    dir;      /* Type of port (-1=FREE,1=READ,..) (2) */
  241.               CHR     unput;    /* Unputted character               (2) */
  242.               };                /*--------------------------------------*/
  243.  
  244. struct  _glb  {                 /*--------------------------------------*/
  245.               CELP   sysenv;    /* The system environment               */
  246.               CELP   curenv;    /* Current environment in eval          */
  247.               CELP   topexp;    /* Points to current expression in eval */
  248.               CELP   curargs;   /* Pointer to list with arguments       */
  249.               CELPP  conssym;   /* Array with pointers to constants     */
  250.               CELPP  sstack;    /* Scheme eval. stack                   */
  251.               CELPP  estack;    /* End of Scheme eval. stack            */
  252.               CELPP  stkptr;    /* Pointer to top of stack              */
  253.                                 /*--------------------------------------*/
  254.               WORD   hashsize;  /* Hashtable size (<32000)              */
  255.               CELP  *hashtab;   /* hashtable                            */
  256.               CELP   freel;     /* Pointer to first cell in freelist    */
  257.               CELP   fblk;      /* Pointer to first block with cells    */
  258.               long   freecels;  /* Number of free cells                 */
  259.               CELP   freestr;   /* List with free strspace descriptors  */
  260.               CELP   allostr;   /* List with allocaetd strspace blocks  */
  261.               long   strspace;  /* number of characters free in strspace*/
  262.               long   strsize;   /* total number of chars. in strspace   */
  263.                                 /*--------------------------------------*/
  264.               DWORD  iobufflag; /* IObuffer flags, TRUE when used       */
  265.               WORD   iobufsize; /* Size of IO buffers                   */
  266.               WORD   ionumbuf;  /* Number of IO buffers                 */
  267.               char  *iobuffers; /* Io buffer space                      */
  268.               char  *bigbuf;    /* Big string buffer for IO             */
  269.               WORD   bigbufsize;/* Big buffer size                      */
  270.               DWORD  GCtreshold;/* Garbage collect when free<treshold   */
  271.               WORD   GCflag;    /* Garbage Collect flag                 */
  272.               char   prompt[40];/* prompt                               */
  273.               WORD   evaldepth; /* Depth of evaluation                  */
  274.               WORD   debug;     /* debug level                          */
  275.               BYTE   verbose;   /* informative mode                     */
  276.               BYTE   bignum;    /* Bignumber math linked?               */
  277.                                 /*--------------------------------------*/
  278.               PORT  *inport;    /* Pointer to input port struct         */
  279.               PORT  *outport;   /* Pointer to output port  "            */
  280.               PORT  *errport;   /* Pointer to error port                */
  281.               PORT  *sinport;   /* Pointer to stdin port (always active)*/
  282.               PORT  *soutport;  /* Pointer to stdout port(always active)*/
  283.               PORT  *serrport;  /* Pointer to stderr port(always active)*/
  284.               PORT  *ports;     /* Port resource                        */
  285.               WORD   prtnum;    /* Number of ports in port resource     */
  286.                                 /*--------------------------------------*/
  287.               jmp_buf err_jmp;  /* Place to jump to on error            */
  288.               int    errnr;     /* Error number                         */
  289.               DWORD  errline;   /* Linenumber where error occurred      */
  290.               CELP   errexp;    /* Expression in error                  */
  291.               CELP   erritem;   /* Item in error                        */
  292.               CELP   curexp;    /* Remember current expression          */
  293.               ERRFUN errfunc;   /* Error reporting function             */
  294.               WORD   magic;     /* A magic number. (should be last)     */
  295.               };                /*--------------------------------------*/
  296.  
  297. #define COOKIE 21345            /* glo->magic must contain this value   */
  298. #define BIGBASE 100000000L      /* Bignumber base */
  299.  
  300. /*--------------------------------------------------------------*/
  301. /* The TYPE tag identifies the type of the car value of a cell  */
  302. /*--------------------------------------------------------------*/
  303. #define MASKCDR  (0x40)   /* bit mask for CDR pointer          */
  304. #define MASKCAR  (0x20)   /* bit mask for CAR pointer          */
  305. #define MASKSYM  (0x10)   /* bit mask to test for symbol (CDR) */
  306. #define MASKNUM  (0x08)   /* bit mask to test for number       */
  307. #define MASKVAR  (0x7E)   /* bit mask for env. vars */
  308.  
  309. #define _ISCDR(c) ((c)->tag & MASKCDR) 
  310. #define _ISCAR(c) ((c)->tag & MASKCAR) 
  311. #define _ISSYM(c) ((c)->tag & MASKSYM)
  312. #define _ISNUM(c) ((c)->tag & MASKNUM) 
  313. #define _ISBIG(c) (((c)->tag & (MASKCDR+MASKNUM))==MASKCDR+MASKNUM)
  314. #define _ISVAR(c) (((c)->tag & 0x5E)==0x54)
  315.  
  316.                             /*------------------------------------------*/
  317. #define TYPE_NIL  0x00      /*  NIL                                     */
  318. #define TYPE_TMS  0x01      /*  Timestamp               (DWORD & float) */
  319. #define TYPE_CHR  0x02      /*  Char                              (CHR) */
  320. #define TYPE_PRT  0x03      /*  Scheme port           (pointer to PORT) */
  321. #define TYPE_STR  0x04      /*  String             (str:length & char*) */
  322. #define TYPE_VEC  0x05      /*  Vector type             (see: type_str) */
  323. #define TYPE_OID  0x06      /*  OID                                     */
  324.                             /*  Cells with NUMBERS:                     */
  325. #define TYPE_INT  0x08      /*  Integer                         (DWORD) */
  326. #define TYPE_FLT  0x09      /*  Floating point                   (REAL) */
  327.                             /*  Cells with only a CDR pointer           */
  328. #define TYPE_FREE 0x40      /*  Free cell                               */
  329.                             /*  Cells with Numbers and CDR pointers     */
  330. #define TYPE_BIGP 0x48      /*  BIG! Integer positive             (BIG) */
  331. #define TYPE_BIGN 0x49      /*  BIG! Integer negative             (BIG) */
  332.                             /*  Cells with Symbols:                     */
  333. #define TYPE_EXT  0x50      /*  External procedure          (fun & int) */
  334. #define TYPE_SPC  0x51      /*  Special pair                (constants) */
  335. #define TYPE_FUN  0x52      /*  Function definition cell     (ptr+2int) */
  336. #define TYPE_SYM  0x54      /*  Symbol                    (ptr to name) */
  337. #define TYPE_KEY  0x55      /*  Keyword & std procs (2 WORD & ptr=>sym) */
  338.                             /*  Cells with CAR and CDR pointers:        */
  339. #define TYPE_PAIR 0x60      /*  Cel is a pair of pointers      (pts:2*) */
  340. #define TYPE_PRC  0x61      /*  User defined proc   (pts to proc & env) */
  341.                             /*  Cell ISSYM, ISCAR, ISCDR                */
  342. #define TYPE_SYMD 0x74      /*  Symbol +value     (defined in toplevel) */
  343. #define TYPE_MAC  0x75      /*  Macro definition           (2 pointers) */
  344.                             /*------------------------------------------*/
  345.  
  346.  /**--------------------------------------------------------------**/
  347.  /**  The IP number indicates what action should be taken when    **/
  348.  /**  eval wants to evaluate this element.                        **/
  349.  /**--------------------------------------------------------------**/
  350.                          /**--------------------------------------**/
  351. #define IP_EOF     0    /** EOF object                           **/
  352. #define IP_DEF     1    /** Special form: DEFINE                 **/
  353. #define IP_QUOTE   2    /** Special form: QUOTE                  **/
  354. #define IP_LAMBDA  3    /** Special form: LAMBDA                 **/
  355. #define IP_IF      4    /** Special form: IF                     **/
  356. #define IP_SET     5    /** Special form: SET!                   **/
  357. #define IP_BEGIN   6    /** Special form: BEGIN                  **/
  358. #define IP_COND    7    /** Special form: COND                   **/
  359. #define IP_CASE    8    /** Special form: CASE                   **/
  360. #define IP_LET     9    /** Special form: LET                    **/
  361. #define IP_LETA    10
  362. #define IP_LETREC  11   /** Special form: LETREC                 **/
  363. #define IP_MACRO   12   /** Special form: MACRO                  **/
  364. #define IP_DO      13   /** Special form: DO                     **/
  365. #define IP_DELAY   14   /** Special form: DELAY                  **/
  366. #define IP_APPLY   15   /** Special form: APPLY                  **/
  367. #define IP_EVAL    16   /** Special form: EVAL                   **/       
  368. #define IP_CONS    17   /** Special CONS                         **/
  369. #define IP_LIST    18   /** Special LIST                         **/
  370. #define IP_NULL    19   /** Special NULL (and NOT)               **/
  371. #define IP_NOT     20   /** Same as NULL                         **/
  372. #define IP_AND     21   /** Special AND                          **/
  373. #define IP_OR      22   /** Special OR                           **/
  374. #define IP_EXIT    23
  375. #define IP_BREAK   24
  376. #define IP_VERSION 25
  377. #define IP_COLLECT 26
  378.                         /**--------------------------------------**/
  379. #define IP_TRUE    27   /** not a real keyword **/
  380. #define IP_INVIS   28
  381. #define IP_UNDEF   29
  382. #define IP_ELSE    30
  383.  
  384.  
  385.  /********************** Trace defines **************************/
  386. #define T_SELF    1
  387. #define T_START   2
  388. #define T_MACRO   3
  389. #define T_END     4
  390. #define T_TAIL    5
  391. #define T_APPLY   6
  392. #define T_LOOKUP  7
  393.  
  394.  /****************** Standard defines ***************************/
  395. #define FREE     0x00
  396. #define READMODE 0x01       /* bit 0 is read flag */
  397. #define WRITMODE 0x02       /* bit 1 is write flag */
  398. #define READWRIT 0x03       /* both 0 and 1 */
  399. #define STANDARD 0x10       /* port is std-in/out/err */
  400. #define UNPUTTED 0x20       /* char in unput buffer */
  401. #define GCMARK   0x80       /* GC mark */
  402.  
  403. #include "scheme.h"
  404. #include "schmac.h"
  405. /*--------------------------------------------------------------*/
  406. /* Include the SCH prototypes                                   */
  407. /*--------------------------------------------------------------*/
  408. #include "schdcl.h"
  409.  
  410. #ifdef FIXEDGLO
  411.   extern GLOBAL DsGlo;        
  412. #else
  413.   extern GLOBAL *DsGlo;       
  414. #endif
  415.  
  416. extern CELP Q_invis;
  417. extern CELP Q_true;
  418. extern CELP item;
  419. extern CELP key;            /* Needed for tracing and sys-dumps */
  420.