home *** CD-ROM | disk | FTP | other *** search
/ Super Net 1 / SUPERNET_1.iso / PC / OTROS / MSDOS / WATTCP / DELFT / SAGE.TAR / sage / scheme / schmac.h < prev    next >
Encoding:
C/C++ Source or Header  |  1991-04-26  |  7.9 KB  |  201 lines
  1. /**********************************************************************
  2. ** MODULE INFORMATION*
  3. **********************
  4. **      FILE     NAME:       SCHMAC.H
  5. **      SYSTEM   NAME:       SCHEME
  6. **      ORIGINAL AUTHOR(S):  Alfred Kayser
  7. **      VERSION  NUMBER:     1.5.5
  8. **      CREATION DATE:       89/02/03
  9. **
  10. ** DESCRIPTION: Here all the macros defined.
  11. ***********************************************************************
  12. ** CHANGES INFORMATION **
  13. *************************
  14. ** REVISION:    $Revision:   1.0  $
  15. ** CHANGER:     $Author:   JAN  $
  16. ** WORKFILE:    $Workfile:   schmac.h  $
  17. ** LOGFILE:     $Logfile:   C:/CPROG/SCHEME/VCS/SCHMAC.H_V  $
  18. ** LOGINFO:     $Log:   C:/CPROG/SCHEME/VCS/SCHMAC.H_V  $
  19. **
  20. **                 Rev 1.0   12 Oct 1989 11:43:42   JAN
  21. **              Initial revision.
  22. **********************************************************************/
  23. #define ISNIL(p)    ((p)==NIL)
  24. #define ISTRUE(p)   ((p)!=NIL)
  25.  
  26. #ifndef FIXEDGLO
  27. # define GLOB(x)    (DsGlo->x)
  28. # define SETGLOB(x,f) if (ISNIL(x)||(x->magic!=COOKIE)) DsNoInitError(f);\
  29.                     DsGlo=x
  30. # define PGLOBAL    DsGlo
  31. #else
  32. # define GLOB(x)    (DsGlo.x)
  33. # define SETGLOB(x,f) if (ISNIL(x)||(x->magic!=COOKIE)) DsNoInitError(f);
  34. # define PGLOBAL    &DsGlo
  35. #endif
  36.  
  37.  
  38. /* The following macro tricks makes the compiler believe that   */
  39. /* the error functions never stops.  This results in a better   */
  40. /* optimization.                                                */
  41. /* The AIX xlc compiler has an internal bug when 'while(1) e;' is used!! */
  42. #ifdef AIX
  43. #define STOP(e)      while(e,1);
  44. #else
  45. #define STOP(e)      do{e;while(1);}while(0)
  46. #endif
  47. #define DSERROR(n,p)  STOP(DsError(n,p))
  48. #define DSPERROR(n,p) STOP(DsPError(n,p))
  49. #define DSSERROR      STOP(DsStkError())
  50. #define DSVERROR(n)   STOP(DsVError(n))
  51. #define DSTERROR(p)   STOP(DsTypError(p))
  52. #define DSTERROR(p)   STOP(DsTypError(p))
  53.  
  54. /*=====================================IO MACROS==============================*/
  55. #define DsOut(p,c) (p)->portout((c),(p)->stream)
  56.  
  57. #define INPUT      DsInput(GLOB(inport))
  58. #define UNPUT(c)   DsUnput(GLOB(inport),c)
  59. #define OUTPUT(c)  DsOut(GLOB(outport),c)
  60. #define NEWLINE    OUTPUT('\n')
  61.  
  62. /*=====================================CEL HANDLING===========================*/
  63. #define CARIpart(l)  ((l)->dat.spec.icar)
  64. #define PROCpart(l)  ((l)->dat.ext.extrn)
  65. #define KEYpart(l)   ((l)->dat.key.keynr)
  66. #define ARGpart(l)   ((l)->dat.key.args)
  67. #define TAGpart(l)   ((l)->tag)
  68. #define GCFpart(l)   ((l)->gcflags)
  69.  
  70. /*======================================FAST CEL HANDLING=====================*/
  71. #define TAG(l)          (ISNIL(l)?TYPE_NIL:(l)->tag)
  72. #define CARpart(l)      ((l)->dat.pair.car)
  73. #define CDRpart(l)      ((l)->dat.pair.cdr)
  74. #define CAARpart(l)     (((l)->dat.pair.car)->dat.pair.car)
  75. #define CADRpart(l)     (((l)->dat.pair.cdr)->dat.pair.car)
  76. #define CDARpart(l)     (((l)->dat.pair.car)->dat.pair.cdr)
  77. #define CDDRpart(l)     (((l)->dat.pair.cdr)->dat.pair.cdr)
  78. #define CAAARpart(list) (CARpart(CAARpart(list)))
  79. #define CAADRpart(list) (CARpart(CADRpart(list)))
  80. #define CADARpart(list) (CARpart(CDARpart(list)))
  81. #define CADDRpart(list) (CARpart(CDDRpart(list)))
  82. #define CDAARpart(list) (CDRpart(CAARpart(list)))
  83. #define CDADRpart(list) (CDRpart(CADRpart(list)))
  84. #define CDDARpart(list) (CDRpart(CDARpart(list)))
  85. #define CDDDRpart(list) (CDRpart(CDDRpart(list)))
  86.  
  87. /*====================================FAST STACK HANDLING=====================*/
  88. #define PUSH(p)         if (GLOB(stkptr)>=GLOB(estack)) DSSERROR;\
  89.                         *GLOB(stkptr)++=(p)
  90. #define STKADD(n)       if ((GLOB(stkptr)+=(n))>=GLOB(estack)) DSSERROR
  91. #define POP             (--GLOB(stkptr))        /* don't check on empty stack */
  92. #define STKARG(n)       (*(GLOB(stkptr)-(n)))  /* g/set n-th value from stack */
  93.  
  94. /*====================================ACCELLERATORS===========================*/
  95. #define ISTYP(p,typ)    (ISTRUE(p) && TAGpart(p)==typ)
  96. #define ISNUM(p)        (ISTRUE(p) && _ISNUM(p))
  97. #define ISCDR(p)        (ISTRUE(p) && _ISCDR(p))
  98. #define ISCAR(p)        (ISTRUE(p) && _ISCAR(p))
  99. #define ISSYM(p)        (ISTRUE(p) && _ISSYM(p))
  100. #define ISBIG(p)        (ISTRUE(p) && _ISBIG(p))
  101.  
  102. #define ISPAIR(p)       (ISTRUE(p) && (p)->tag==TYPE_PAIR)
  103. #define ISKEY(p)        (ISTRUE(p) && (p)->tag==TYPE_KEY)
  104. #define ISATOM(p)       (ISTRUE(p) && (p)->tag!=TYPE_PAIR)
  105. #define ISFALS(p)       ISNIL(p)
  106. #define INITCEL(t,n)    (t=DsGetCell(n))
  107. #define LIST(a,b)       (DsCons(a,DsCons(b,NIL)))
  108. #define TESTNUM(p)      if (!ISNUM(p)) DSTERROR(p)
  109. #define TYPCHECK(p,typ) if (ISNIL(p)||(TAGpart(p)!=typ)) DSTERROR(p);
  110. #define NUMCHECK(exp,n) if (DsLength(exp)<n) DSERROR(ERRARC,exp)
  111. #ifdef MATHTRAP
  112. #define ZEROCHECK(p)    p
  113. #else
  114. #define ZEROCHECK(p)    if (FLTpart(p)==0.0) DSVERROR(ERRDIV0)
  115. #endif
  116.  
  117. /*=======================DATA ABSTRACTION MACROS==============================*/
  118. #define BIGBASE         100000000L
  119. #define STRPpart(c)     ((c)->dat.sp.stp)
  120. #define STRLpart(c)     ((c)->dat.sp.len)
  121. #define VECPpart(c)     ((CELP *)STRPpart(c))
  122. #define VECLpart(c)     (STRLpart(c)/sizeof(CELP))
  123. #define BIGpart(c)      ((c)->dat.bignum.int1)
  124. #define INTpart(c)      ((c)->dat.bignum.int1)
  125. #define CHRpart(c)      ((c)->dat.ch)
  126. #define FLTpart(c)      ((c)->dat.rv)
  127. #define PRTpart(c)      ((c)->dat.prt)
  128.  
  129. #ifdef INLINE
  130. extern CELP _tmp_p;
  131. #define DSINTCEL(v)     (INTpart(_tmp_p=DsGetCell(TYPE_INT))=v),_tmp_p
  132. #define DSFLTCEL(v)     (FLTpart(_tmp_p=DsGetCell(TYPE_FLT))=v),_tmp_p
  133. #define DSCHRCEL(v)     (CHRpart(_tmp_p=DsGetCell(TYPE_CHR))=v),_tmp_p
  134. #define DSPRTCEL(v)     (PRTpart(_tmp_p=DsGetCell(TYPE_PRT))=v),_tmp_p
  135. #define INTCEL(c,v)     (INTpart(c=DsGetCell(TYPE_INT))=v)
  136. #define FLTCEL(c,v)     (FLTpart(c=DsGetCell(TYPE_FLT))=v)
  137. #define PRTCEL(c,v)     (PRTpart(c=DsGetCell(TYPE_PRT))=v)
  138. #define CHRCEL(c,v)     (CHRpart(c=DsGetCell(TYPE_CHR))=v)
  139. #else
  140. #define DSINTCEL(v)     DsIntCell(v)
  141. #define DSFLTCEL(v)     DsFltCell((double)v)
  142. #define DSCHRCEL(v)     DsChrCell(v)
  143. #define DSPRTCEL(v)     DsPrtCell(v)
  144. #define INTCEL(c,v)     c=DsIntCell(v)
  145. #define FLTCEL(c,v)     c=DsFltCell(v)
  146. #define CHRCEL(c,v)     c=DsChrCell(v)
  147. #define PRTCEL(c,v)     c=DsPrtCell(v)
  148. #endif
  149. #define DSSTRCEL(v)     DsStrCell(v)
  150. #define DSTMSCEL(v)     DsStrTime(v)
  151. #define STRCEL(c,v)     c=DsStrCell(v)
  152. #define TMSCEL(c,v)     c=DsStrTime(v)
  153.  
  154. #define CELINT(c)       BIGpart(c)                     /* assume short bignum */
  155. #define CELPRT(c)       c->dat.prt
  156. #define CELFLT(c)       c->dat.rv
  157. #define CELCHR(c)       c->dat.ch
  158. #define CELTIM(c)       c->dat.ts
  159. #define CELTMS(c)       DsTimeStr(c)
  160. #define CELEXT(c)       c->dat.ext.extdef
  161.  
  162. /*===========================TIME HANDLING====================================*/
  163. #define COM_TIME(h,m)   (((h) << 8) +(m))
  164. #define TIME_H(t)       (((t) >> 8) & 0xFF)
  165. #define TIME_M(t)       ((t) & 0xFF)
  166.  
  167. /*----------------------------------------------------------------------------*/
  168. /* The following macros return a pointer to the cel containing the            */
  169. /* corresponding IP number.                                                   */
  170. /*----------------------------------------------------------------------------*/
  171. #define CSYM(n)      (GLOB(conssym)[n])
  172. #define Q_false      (NIL)          /* Boolean FALSE is translated into a nil */
  173. #define Q_lambda     (CSYM(IP_LAMBDA))
  174. #define Q_undef      (CSYM(IP_UNDEF))
  175. #define Q_quote      (CSYM(IP_QUOTE))
  176. #define Q_else       (CSYM(IP_ELSE))
  177. #define Q_eof        (CSYM(IP_EOF))
  178.  
  179. #define TEST(x)       ((x)?Q_true:Q_false)
  180. #define RETBOO(x)     return TEST(x)
  181. #define BIGMAX        (GLOB(bigbufsize))            /* Maximum bigstring size */
  182. #define BIGBUF        (GLOB(bigbuf))                     /* bigstring pointer */
  183. #define TRACELEVEL    (GLOB(trace))
  184. #define PROTECT(p)    (p)->gcflags|=0x2;
  185.  
  186. #ifdef UNIX
  187. # define GETMEM(p,t,s,m) if ((p=(t *)malloc(s))==NULL) DsMemError(m)
  188. #else
  189. # define GETMEM(p,t,s,m) if ((p=malloc(s))==NULL) DsMemError(m)
  190. #endif
  191.  
  192. #ifndef MSC
  193. # define min(a,b) (a)<(b)?(a):(b)
  194. # ifndef labs
  195. #  define labs(a) (a)<0?-(a):(a)
  196. # endif
  197. #endif
  198.  
  199. #define BELL '\007'
  200. #define ENDOFLIST {NULL}
  201.