"Fossies" - the Fresh Open Source Software Archive

Member "scm/scm.h" (22 Oct 2017, 43938 Bytes) of package /linux/privat/scm-5f3.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "scm.h" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 5f2_vs_5f3.

    1 /* "scm.h" SCM data types and external functions.
    2  * Copyright (C) 1990-2006 Free Software Foundation, Inc.
    3  *
    4  * This program is free software: you can redistribute it and/or modify
    5  * it under the terms of the GNU Lesser General Public License as
    6  * published by the Free Software Foundation, either version 3 of the
    7  * License, or (at your option) any later version.
    8  *
    9  * This program is distributed in the hope that it will be useful, but
   10  * WITHOUT ANY WARRANTY; without even the implied warranty of
   11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   12  * Lesser General Public License for more details.
   13  *
   14  * You should have received a copy of the GNU Lesser General Public
   15  * License along with this program.  If not, see
   16  * <http://www.gnu.org/licenses/>.
   17  */
   18 
   19 #ifdef __cplusplus
   20 extern "C" {
   21 #endif
   22 
   23 #ifdef _WIN32
   24 # include <windows.h>
   25 #endif
   26 
   27 #ifdef _WIN32_WCE
   28 # include <windows.h>
   29 #endif
   30 
   31 #ifdef hpux
   32 # ifndef __GNUC__
   33 #  define const /**/
   34 # endif
   35 #endif
   36 
   37 #ifdef PLAN9
   38 # include <u.h>
   39 # include <libc.h>
   40 /* Simple imitation of some Unix system calls */
   41 # define exit(val) exits("")
   42 # define getcwd getwd
   43 /* we have our own isatty */
   44 int isatty (int);
   45 #endif
   46 
   47 typedef long SCM;
   48 typedef struct {SCM car, cdr;} cell;
   49 typedef struct {long sname;SCM (*cproc)();} subr;
   50 typedef struct {long sname;double (*dproc)();} dsubr;
   51 typedef struct {const char *string;SCM (*cproc)();} iproc;
   52 typedef struct {const char *name;} subr_info;
   53 
   54 #include <stdio.h>
   55 #include "scmfig.h"
   56 
   57 #ifdef _WIN32
   58 # ifdef SCM_WIN_DLL
   59 #  define SCM_DLL_EXPORT __declspec(dllexport)
   60 #  define SCM_EXPORT SCM_DLL_EXPORT
   61 # else
   62 #  define SCM_DLL_EXPORT /**/
   63 #  define SCM_EXPORT extern
   64 # endif
   65 #else
   66 # define SCM_DLL_EXPORT /**/
   67 # define SCM_EXPORT extern
   68 #endif
   69 
   70 
   71 typedef struct {
   72   sizet eltsize;
   73   sizet len;
   74   sizet alloclen;
   75   sizet maxlen;
   76   const char *what;
   77   char *elts;} scm_gra;
   78 
   79 #ifdef USE_ANSI_PROTOTYPES
   80 # define P(s) s
   81 #else
   82 # define P(s) ()
   83 #endif
   84 
   85 #ifndef STDC_HEADERS
   86         int isatty P((int));
   87 #endif
   88 
   89 typedef struct {
   90   SCM   (*mark)P((SCM));
   91   sizet (*free)P((CELLPTR));
   92   int   (*print)P((SCM exp, SCM port, int writing));
   93   SCM   (*equalp)P((SCM, SCM));
   94 } smobfuns;
   95 
   96 typedef struct {
   97   char  *name;
   98   SCM   (*mark)P((SCM ptr));
   99   int   (*free)P((FILE *p));
  100   int   (*print)P((SCM exp, SCM port, int writing));
  101   SCM   (*equalp)P((SCM, SCM));
  102   int   (*fputc)P((int c, FILE *p));
  103   int   (*fputs)P((const char *s, FILE *p));
  104   sizet (*fwrite)P((const void *s, sizet siz, sizet num, FILE *p));
  105   int   (*fflush)P((FILE *stream));
  106   int   (*fgetc)P((FILE *p));
  107   int   (*fclose)P((FILE *p));
  108   int   (*ungetc)P((int c, SCM p));
  109 } ptobfuns;
  110 
  111 typedef struct {
  112   SCM data;
  113   SCM port;
  114   long flags;
  115   long line;
  116   int unread;
  117   short col;
  118   short colprev;
  119 } port_info;
  120 
  121 typedef struct {
  122   SCM v;
  123   sizet base;
  124 } array;
  125 typedef struct {
  126   long lbnd;
  127   long ubnd;
  128   long inc;
  129 } array_dim;
  130 
  131 #ifdef FLOATS
  132 typedef struct {char *string;double (*cproc)P((double));} dblproc;
  133 # ifdef SINGLES
  134 #  ifdef CDR_DOUBLES
  135 typedef struct {SCM type;double num;} flo;
  136 #  else
  137 typedef struct {SCM type;float num;} flo;
  138 #  endif
  139 # endif
  140 typedef struct {SCM type;double *real;} dbl;
  141 #endif
  142 
  143   /* Conditionals should always expect immediates */
  144   /* GCC __builtin_expect() is stubbed in scmfig.h */
  145 #define IMP(x) SCM_EXPECT_TRUE(6 & PTR2INT(x))
  146 #define NIMP(x) (!IMP(x))
  147 
  148 #define INUMP(x) SCM_EXPECT_TRUE(2 & PTR2INT(x))
  149 #define NINUMP(x) (!INUMP(x))
  150 #define INUM0 ((SCM) 2)
  151 #define ICHRP(x) ((0xff & PTR2INT(x))==0xf4)
  152 #define ICHR(x) ((unsigned char)((x)>>8))
  153 #define MAKICHR(x) (((x)<<8)+0xf4L)
  154 
  155 #define ILOC00  (0x000000fcL)
  156 #define ILOCP(n) ((0xff & PTR2INT(n))==PTR2INT(ILOC00))
  157 #define MAKILOC(if, id) (ILOC00 + (((long)id)<<8) + (((long)if)<<16))
  158 #define IDIST(n) ((PTR2INT(n)>>8) & 0x7f)
  159 #define IFRAME(n) ((PTR2INT(n)>>16))
  160 #define ICDRP(n) (ICDR & (n))
  161 #define ICDR (1L<<15)
  162 
  163 /* ISYMP tests for ISPCSYM and ISYM */
  164 #define ISYMP(n) ((0x187 & PTR2INT(n))==4)
  165 /* IFLAGP tests for ISPCSYM, ISYM and IFLAG */
  166 #define IFLAGP(n) ((0x87 & PTR2INT(n))==4)
  167 #define ISYMNUM(n) ((PTR2INT((n)>>9)) & 0x7f)
  168 #define ISYMVAL(n) (PTR2INT((n)>>16))
  169 #define MAKISYMVAL(isym, val) ((isym) | ((long)(val) <<16))
  170 #define ISYMCHARS(n) (isymnames[ISYMNUM(n)])
  171 #define MAKSPCSYM(n) (((n)<<9)+((n)<<3)+4L)
  172 #define MAKISYM(n) (((n)<<9)+0x74L)
  173 #define MAKIFLAG(n) (((n)<<9)+0x174L)
  174 /* This is to make the print representation of some evaluated code,
  175    as in backtraces, make a little more sense. */
  176 #define MAKSPCSYM2(work, look) ((127L & (work)) | ((127L<<9) & (look)))
  177 
  178 SCM_EXPORT char *isymnames[];
  179 #define NUM_ISPCSYM 14
  180 #define IM_AND MAKSPCSYM(0)
  181 #define IM_BEGIN MAKSPCSYM(1)
  182 #define IM_CASE MAKSPCSYM(2)
  183 #define IM_COND MAKSPCSYM(3)
  184 #define IM_DO MAKSPCSYM(4)
  185 #define IM_IF MAKSPCSYM(5)
  186 #define IM_LAMBDA MAKSPCSYM(6)
  187 #define IM_LET MAKSPCSYM(7)
  188 #define IM_LETSTAR MAKSPCSYM(8)
  189 #define IM_LETREC MAKSPCSYM(9)
  190 #define IM_OR MAKSPCSYM(10)
  191 #define IM_QUOTE MAKSPCSYM(11)
  192 #define IM_SET MAKSPCSYM(12)
  193 #define IM_FUNCALL MAKSPCSYM(13)
  194 
  195 #define s_and (ISYMCHARS(IM_AND)+2)
  196 #define s_begin (ISYMCHARS(IM_BEGIN)+2)
  197 #define s_case (ISYMCHARS(IM_CASE)+2)
  198 #define s_cond (ISYMCHARS(IM_COND)+2)
  199 #define s_do (ISYMCHARS(IM_DO)+2)
  200 #define s_if (ISYMCHARS(IM_IF)+2)
  201 #define s_lambda (ISYMCHARS(IM_LAMBDA)+2)
  202 #define s_let (ISYMCHARS(IM_LET)+2)
  203 #define s_letstar (ISYMCHARS(IM_LETSTAR)+2)
  204 #define s_letrec (ISYMCHARS(IM_LETREC)+2)
  205 #define s_or (ISYMCHARS(IM_OR)+2)
  206 #define s_quote (ISYMCHARS(IM_QUOTE)+2)
  207 #define s_set (ISYMCHARS(IM_SET)+2)
  208 #define s_define (ISYMCHARS(IM_DEFINE)+2)
  209 #define s_delay (ISYMCHARS(IM_DELAY)+2)
  210 #define s_quasiquote (ISYMCHARS(IM_QUASIQUOTE)+2)
  211 #define s_let_syntax (ISYMCHARS(IM_LET_SYNTAX)+2)
  212 
  213 SCM_EXPORT SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing;
  214 #define s_apply (ISYMCHARS(IM_APPLY)+2)
  215 
  216 /* each symbol defined here must have a unique number which
  217    corresponds to it's position in isymnames[] in repl.c */
  218   /* These are used for dispatch in eval.c */
  219 #define IM_APPLY MAKISYM(14)
  220 #define IM_FARLOC_CAR MAKISYM(15)
  221 #define IM_FARLOC_CDR MAKISYM(16)
  222 #define IM_DELAY MAKISYM(17)
  223 #define IM_QUASIQUOTE MAKISYM(18)
  224 #define IM_EVAL_FOR_APPLY MAKISYM(19)
  225 #define IM_LET_SYNTAX MAKISYM(20)
  226 #define IM_ACRO_CALL MAKISYM(21)
  227 #define IM_LINUM MAKISYM(22)
  228 #define IM_DEFINE MAKISYM(23)
  229 #define IM_EVAL_VALUES MAKISYM(24)
  230 
  231   /* These are not used for dispatch. */
  232 #define IM_UNQUOTE MAKISYM(25)
  233 #define IM_UQ_SPLICING MAKISYM(26)
  234 #define IM_ELSE MAKISYM(27)
  235 #define IM_ARROW MAKISYM(28)
  236 #define IM_VALUES_TOKEN MAKISYM(29)
  237 #define IM_KEYWORD MAKISYM(30)
  238 
  239 #define NUM_ISYMS 31
  240 
  241 #define SCM_MAKE_LINUM(n) (IM_LINUM | ((unsigned long)(n))<<16)
  242 #define SCM_LINUM(x) ((unsigned long)(x)>>16)
  243 #define SCM_LINUMP(x) ((0xffffL & (x))==IM_LINUM)
  244 
  245 #define BOOL_F MAKIFLAG(NUM_ISYMS+0)
  246 #define BOOL_T MAKIFLAG(NUM_ISYMS+1)
  247 #define UNDEFINED MAKIFLAG(NUM_ISYMS+2)
  248 #define EOF_VAL MAKIFLAG(NUM_ISYMS+3)
  249 #ifdef SICP
  250 # define EOL BOOL_F
  251 #else
  252 # define EOL MAKIFLAG(NUM_ISYMS+4)
  253 #endif
  254 #define UNSPECIFIED MAKIFLAG(NUM_ISYMS+5)
  255 #define NUM_IFLAGS NUM_ISYMS+6
  256 
  257 /* Now some unnamed flags used as magic cookies by scm_top_level. */
  258 /* Argument n can range from -4 to 16 */
  259 #ifdef SHORT_INT
  260 # define COOKIE(n) (n)
  261 # define UNCOOK(f) (f)
  262 #else
  263 # define COOKIE(n) MAKIFLAG(NUM_IFLAGS+4+n)
  264 # define UNCOOK(f) (ISYMNUM(f)-(NUM_IFLAGS+4))
  265 #endif
  266 
  267 #define FALSEP(x) (BOOL_F==(x))
  268 #define NFALSEP(x) (BOOL_F != (x))
  269 /* BOOL_NOT returns the other boolean.  The order of ^s here is
  270    important for Borland C++. */
  271 #define BOOL_NOT(x)  ((x) ^ (BOOL_T ^ BOOL_F))
  272 #define NULLP(x) (EOL==(x))
  273 #define NNULLP(x) (EOL != (x))
  274 #define UNBNDP(x) (UNDEFINED==(x))
  275 #define CELLP(x) (!NCELLP(x))
  276 #define NCELLP(x) ((sizeof(cell)-1) & PTR2INT(x))
  277 
  278 #define GCMARKP(x) (1 & PTR2INT(CDR(x)))
  279 #define GC8MARKP(x) (0x80 & PTR2INT(CAR(x)))
  280 #define SETGCMARK(x) CDR(x) |= 1;
  281 #define CLRGCMARK(x) CDR(x) &= ~1L;
  282 #define SETGC8MARK(x) CAR(x) |= 0x80;
  283 #define CLRGC8MARK(x) CAR(x) &= ~0x80L;
  284 #define TYP3(x) (7 & PTR2INT(CAR(x)))
  285 #define TYP7(x) (0x7f & PTR2INT(CAR(x)))
  286 #define TYP7S(x) (0x7d & PTR2INT(CAR(x)))
  287 #define TYP16(x) (0xffff & PTR2INT(CAR(x)))
  288 #define TYP16S(x) (0xfeff & PTR2INT(CAR(x)))
  289 #define GCTYP16(x) (0xff7f & PTR2INT(CAR(x)))
  290 
  291 #define NCONSP(x) (1 & PTR2INT(CAR(x)))
  292 #define CONSP(x) (!NCONSP(x))
  293 #define ECONSP(x) (CONSP(x) || (1==TYP3(x)))
  294 #define NECONSP(x) (NCONSP(x) && (1 != TYP3(x)))
  295 #define SCM_GLOCP(x) (tc3_cons_gloc==(7 & PTR2INT(x)))
  296 
  297 #define CAR(x) (((cell *)(SCM2PTR(x)))->car)
  298 #define CDR(x) (((cell *)(SCM2PTR(x)))->cdr)
  299 #define GCCDR(x) (~1L & CDR(x))
  300 #define SETCDR(x, v) CDR(x) = (SCM)(v)
  301 
  302 #ifdef _M_ARM
  303 /* MS CLARM compiler bug workaround.  */
  304 volatile SCM MS_CLARM_dumy;
  305 # define CODE(x) (MS_CLARM_dumy = (CAR(x)-tc3_closure))
  306 #else
  307 # define CODE(x) (CAR(x)-tc3_closure)
  308 #endif
  309 #define CLOSUREP(x) (TYP3(x)==tc3_closure)
  310 #define SETCODE(x, e) CAR(x) = (e)+tc3_closure
  311 #define ENV(x) ((~7L & CDR(x)) ? (~7L & CDR(x)) : EOL)
  312 #define GCENV ENV
  313 #define ARGC(x) ((6L & CDR(x))>>1)
  314 #ifdef CAUTIOUS
  315 # define SCM_ESTK_FRLEN 4
  316 #else
  317 # define SCM_ESTK_FRLEN 3
  318 #endif
  319 #define SCM_ESTK_BASE 4
  320 #define SCM_ESTK_PARENT(v) (VELTS(v)[0])
  321 #define SCM_ESTK_PARENT_WRITABLEP(v) (VELTS(v)[1])
  322 #define SCM_ESTK_PARENT_INDEX(v) (VELTS(v)[2])
  323 SCM_EXPORT long tc16_env, tc16_ident;
  324 #define ENVP(x) (tc16_env==TYP16(x))
  325 #define SCM_ENV_FORMALS CAR
  326 #ifdef MACRO
  327 # define M_IDENTP(x) (tc16_ident==TYP16(x))
  328 # define M_IDENT_LEXP(x) ((tc16_ident | (1L<<16))==CAR(x))
  329 # define IDENTP(x) (SYMBOLP(x) || M_IDENTP(x))
  330 # define IDENT_PARENT(x) (M_IDENT_LEXP(x) ? CAR(CDR(x)) : CDR(x))
  331 # define IDENT_ENV(x) (M_IDENT_LEXP(x) ? CDR(CDR(x)) : BOOL_F)
  332 #else
  333 # define IDENTP SYMBOLP
  334 # define M_IDENTP(x) (0)
  335 #endif
  336 
  337   /* markers for various static environment frame types */
  338   /* FIXME these need to be exported somehow to Scheme */
  339 #ifdef CAUTIOUS
  340 # define SCM_ENV_FILENAME MAKINUM(1L)
  341 # define SCM_ENV_PROCNAME MAKINUM(2L)
  342 #endif
  343 #define SCM_ENV_DOC MAKINUM(3L)
  344 #define SCM_ENV_ANNOTATION MAKINUM(4L)
  345 #define SCM_ENV_CONSTANT MAKINUM(5L)
  346 #define SCM_ENV_SYNTAX MAKINUM(6L)
  347 #define SCM_ENV_END MAKINUM(7L)
  348 
  349 #define PORTP(x) (TYP7(x)==tc7_port)
  350 #define OPPORTP(x) (((0x7f | OPN) & CAR(x))==(tc7_port | OPN))
  351 #define OPINPORTP(x) (((0x7f | OPN | RDNG) & CAR(x))==(tc7_port | OPN | RDNG))
  352 #define OPOUTPORTP(x) (((0x7f | OPN | WRTNG) & CAR(x))==(tc7_port | OPN | WRTNG))
  353 #define OPIOPORTP(x) (((0x7f | OPN | RDNG | WRTNG) & CAR(x))==(tc7_port | OPN | RDNG | WRTNG))
  354 #define FPORTP(x) (TYP16S(x)==tc7_port)
  355 #define OPFPORTP(x) (((0xfeff | OPN) & CAR(x))==(tc7_port | OPN))
  356 #define OPINFPORTP(x) (((0xfeff | OPN | RDNG) & CAR(x))==(tc7_port | OPN | RDNG))
  357 #define OPOUTFPORTP(x) (((0xfeff | OPN | WRTNG) & CAR(x))==(tc7_port | OPN | WRTNG))
  358 
  359 #define INPORTP(x) (((0x7f | RDNG) & CAR(x))==(tc7_port | RDNG))
  360 #define OUTPORTP(x) (((0x7f | WRTNG) & CAR(x))==(tc7_port | WRTNG))
  361 #define OPENP(x) (OPN & CAR(x))
  362 #define CLOSEDP(x) (!OPENP(x))
  363 #define STREAM(x) ((FILE *)(CDR(x)))
  364 #define SETSTREAM SETCDR
  365 #define CRDYP(port) ((CAR(port) & CRDY) && (EOF != CGETUN(port)))
  366 #define CLRDY(port) (CAR(port) &= (SCM_PORTFLAGS(port) | (~0xf0000)))
  367 #define CGETUN(port) (scm_port_table[SCM_PORTNUM(port)].unread)
  368 
  369 #define tc_socket (tc7_port | OPN)
  370 #define SOCKP(x) (((0x7f | OPN | RDNG | WRTNG) & CAR(x))==(tc_socket))
  371 #define SOCKTYP(x) (INUM(SCM_PORTDATA(x)))
  372 
  373 #define DIRP(x) (NIMP(x) && (TYP16(x)==(tc16_dir)))
  374 #define OPDIRP(x) (NIMP(x) && (CAR(x)==(tc16_dir | OPN)))
  375 
  376 #ifdef FLOATS
  377 # define INEXP(x) (TYP16(x)==tc16_flo)
  378 # define CPLXP(x) (CAR(x)==tc_dblc)
  379 # define REAL(x) (*(((dbl *) (SCM2PTR(x)))->real))
  380 # define IMAG(x) (*((double *)(CHARS(x)+sizeof(double))))
  381 /* ((&REAL(x))[1]) */
  382 # ifdef SINGLES
  383 #  define REALP(x) ((~REAL_PART & CAR(x))==tc_flo)
  384 #  define SINGP(x) SCM_EXPECT_TRUE(CAR(x)==tc_flo)
  385 #  define FLO(x) (((flo *)(SCM2PTR(x)))->num)
  386 #  define REALPART(x) (SINGP(x)?0.0+FLO(x):REAL(x))
  387 # else /* SINGLES */
  388 #  define REALP(x) (CAR(x)==tc_dblr)
  389 #  define REALPART REAL
  390 # endif /* SINGLES */
  391 #endif
  392 
  393 #ifdef FLOATS
  394 # define NUMBERP(x) (INUMP(x) || (NIMP(x) && NUMP(x)))
  395 #else
  396 # ifdef BIGDIG
  397 #  define NUMBERP(x) (INUMP(x) || (NIMP(x) && NUMP(x)))
  398 # else
  399 #  define NUMBERP INUMP
  400 # endif
  401 #endif
  402 #define NUMP(x) ((0xfcff & PTR2INT(CAR(x)))==tc7_smob)
  403 #define BIGP(x) (TYP16S(x)==tc16_bigpos)
  404 #define BIGSIGN(x) (0x0100 & PTR2INT(CAR(x)))
  405 #define BDIGITS(x) ((BIGDIG *)(CDR(x)))
  406 #define NUMDIGS(x) ((sizet)(((unsigned long)CAR(x))>>16))
  407 #define MAKE_NUMDIGS(v, t) ((((v)+0L)<<16)+(t))
  408 #define SETNUMDIGS(x, v, t) CAR(x) = MAKE_NUMDIGS(v, t)
  409 
  410 #define SNAME(x) ((char *)(subrs[NUMDIGS(x)].name))
  411 #define SUBRF(x) (((subr *)(SCM2PTR(x)))->cproc)
  412 #define DSUBRF(x) (((dsubr *)(SCM2PTR(x)))->dproc)
  413 #define CCLO_SUBR(x) (VELTS(x)[0])
  414 #define CCLO_LENGTH NUMDIGS
  415 #define CXR_OP SMOBNUM
  416 
  417 #define SYMBOLP(x) (TYP7S(x)==tc7_ssymbol)
  418 #define STRINGP(x) (TYP7(x)==tc7_string)
  419 #define NSTRINGP(x) (!STRINGP(x))
  420 #define BYTESP(x) (TYP7(x)==tc7_VfixN8)
  421 #define VECTORP(x) (TYP7(x)==tc7_vector)
  422 #define NVECTORP(x) (!VECTORP(x))
  423 #define LENGTH(x) (((unsigned long)CAR(x))>>8)
  424 #define LENGTH_MAX (((unsigned long)-1L)>>8)
  425 #define MAKE_LENGTH(v, t) ((((v)+0L)<<8) + (t))
  426 #define SETLENGTH(x, v, t) CAR(x) = MAKE_LENGTH(v, t)
  427 #define CHARS(x) ((char *)(CDR(x)))
  428 #define UCHARS(x) ((unsigned char *)(CDR(x)))
  429 #define VELTS(x) ((SCM *)CDR(x))
  430 #define SETCHARS SETCDR
  431 #define SETVELTS SETCDR
  432 
  433 SCM_EXPORT long tc16_array;
  434 #define ARRAYP(a) (tc16_array==TYP16(a))
  435 #define ARRAY_V(a) (((array *)CDR(a))->v)
  436 /*#define ARRAY_NDIM(x) NUMDIGS(x)*/
  437 #define ARRAY_NDIM(x) ((sizet)(CAR(x)>>17))
  438 #define ARRAY_CONTIGUOUS 0x10000
  439 #define ARRAY_CONTP(x) (ARRAY_CONTIGUOUS & PTR2INT(CAR(x)))
  440 #define ARRAY_BASE(a) (((array *)CDR(a))->base)
  441 #define ARRAY_DIMS(a) ((array_dim *)(CHARS(a)+sizeof(array)))
  442 
  443 #define FREEP(x) (CAR(x)==tc_free_cell)
  444 #define NFREEP(x) (!FREEP(x))
  445 
  446 #define SMOBNUM(x) (0x0ff & (CAR(x)>>8))
  447 #define PTOBNUM(x) (0x0ff & (CAR(x)>>8))
  448 #define SCM_PORTNUM(x) ((int)(((unsigned long)CAR(x))>>20))
  449 #define SCM_PORTNUM_MAX ((int)((0x7fffUL<<20)>>20))
  450 #define SCM_PORTFLAGS(x) (scm_port_table[SCM_PORTNUM(x)].flags)
  451 #define SCM_PORTDATA(x) (scm_port_table[SCM_PORTNUM(x)].data)
  452 #define SCM_SETFLAGS(x, flags) (CAR(x) = (CAR(x) & ~0x0f0000L) | (flags))
  453 /* This is used (only) for closing ports. */
  454 #define SCM_SET_PTOBNUM(x, typ) (CAR(x)=(typ)|(CAR(x) & ~0x0ffffL))
  455 
  456 #define DIGITS '0':case '1':case '2':case '3':case '4':\
  457                 case '5':case '6':case '7':case '8':case '9'
  458 
  459 /* Aggregated types for dispatch in switch statements. */
  460 
  461 #define tcs_cons_inum 2: case 6:case 10:case 14:\
  462                  case 18:case 22:case 26:case 30:\
  463                  case 34:case 38:case 42:case 46:\
  464                  case 50:case 54:case 58:case 62:\
  465                  case 66:case 70:case 74:case 78:\
  466                  case 82:case 86:case 90:case 94:\
  467                  case 98:case 102:case 106:case 110:\
  468                  case 114:case 118:case 122:case 126
  469 #define tcs_cons_iloc 124
  470 #define tcs_cons_ispcsym 4:case 12:case 20:case 28:\
  471                    case 36:case 44:case 52:case 60:\
  472                    case 68:case 76:case 84:case 92:\
  473                    case 100:case 108
  474 #define tcs_cons_chflag 116     /* char *or* flag */
  475 #define tcs_cons_imcar tcs_cons_inum:\
  476                    case tcs_cons_iloc:\
  477                    case tcs_cons_ispcsym:\
  478                    case tcs_cons_chflag
  479 
  480 #define tcs_cons_nimcar 0:case 8:case 16:case 24:\
  481                  case 32:case 40:case 48:case 56:\
  482                  case 64:case 72:case 80:case 88:\
  483                  case 96:case 104:case 112:case 120
  484 #define tcs_cons_gloc 1:case 9:case 17:case 25:\
  485                  case 33:case 41:case 49:case 57:\
  486                  case 65:case 73:case 81:case 89:\
  487                  case 97:case 105:case 113:case 121
  488 
  489 #define tcs_closures   3:case 11:case 19:case 27:\
  490                  case 35:case 43:case 51:case 59:\
  491                  case 67:case 75:case 83:case 91:\
  492                  case 99:case 107:case 115:case 123
  493 #define tcs_subrs tc7_asubr:case tc7_subr_0:case tc7_subr_1:case tc7_cxr:\
  494         case tc7_subr_3:case tc7_subr_2:case tc7_rpsubr:case tc7_subr_1o:\
  495         case tc7_subr_2o:case tc7_lsubr_2:case tc7_lsubr
  496 #define tcs_symbols tc7_ssymbol:case tc7_msymbol
  497 #define tcs_bignums tc16_bigpos:case tc16_bigneg
  498 #define tcs_uves tc7_string:\
  499   case tc7_VfixN8:case tc7_VfixZ8:case tc7_VfixN16:case tc7_VfixZ16:\
  500   case tc7_VfixN32:case tc7_VfixZ32:case tc7_VfixN64:case tc7_VfixZ64:\
  501   case tc7_VfloR32:case tc7_VfloC32:case tc7_VfloR64:case tc7_VfloC64:\
  502   case tc7_Vbool
  503 
  504 #define tc3_cons_nimcar 0
  505 #define tc3_cons_imcar  2:case 4:case 6
  506 #define tc3_cons_gloc   1
  507 #define tc3_closure     3
  508 #define tc3_tc7_types   5:case 7
  509 
  510 #define tc7_ssymbol     5
  511 #define tc7_msymbol     7
  512 #define tc7_string      13
  513 #define tc7_vector      15
  514 #define tc7_VfixN8      21
  515 #define tc7_VfixZ8      23
  516 #define tc7_VfixN16     29
  517 #define tc7_VfixZ16     31
  518 #define tc7_VfixN32     37
  519 #define tc7_VfixZ32     39
  520 #define tc7_VfixN64     45
  521 #define tc7_VfixZ64     47
  522 
  523 #define tc7_VfloR32     53
  524 #define tc7_VfloC32     55
  525 #define tc7_VfloR64     61
  526 #define tc7_VfloC64     63
  527 #define tc7_Vbool       69
  528 
  529 #define tc7_port        71
  530 #define tc7_contin      77
  531 #define tc7_specfun     79
  532 
  533 #define tc7_subr_0      85
  534 #define tc7_subr_1      87
  535 #define tc7_cxr         93
  536 #define tc7_subr_3      95
  537 #define tc7_subr_2      101
  538 #define tc7_asubr       103
  539 #define tc7_subr_1o     109
  540 #define tc7_subr_2o     111
  541 #define tc7_lsubr_2     117
  542 #define tc7_lsubr       119
  543 #define tc7_rpsubr      125
  544 
  545 #define tc7_smob        127
  546 #define tc_free_cell    127
  547 #define tc_broken_heart (tc_free_cell+0x10000)
  548 
  549 #define tc16_apply      (tc7_specfun | (0L<<8))
  550 #define tc16_call_cc    (tc7_specfun | (1L<<8))
  551 #define tc16_cclo       (tc7_specfun | (2L<<8))
  552 #define tc16_eval       (tc7_specfun | (3L<<8))
  553 #define tc16_values     (tc7_specfun | (4L<<8))
  554 #define tc16_call_wv    (tc7_specfun | (5L<<8))
  555 
  556 #define tc16_flo        0x017f
  557 #define tc_flo          0x017fL
  558 
  559 #define REAL_PART       (1L<<16)
  560 #define IMAG_PART       (2L<<16)
  561 #define tc_dblr         (tc16_flo|REAL_PART)
  562 #define tc_dblc         (tc16_flo|REAL_PART|IMAG_PART)
  563 
  564 #define tc16_bigpos     0x027f
  565 #define tc16_bigneg     0x037f
  566 
  567   /* The first four flags fit in the car of a port cell, remaining
  568    flags only in the port table */
  569 #define OPN             (1L<<16)
  570 #define RDNG            (2L<<16)
  571 #define WRTNG           (4L<<16)
  572 #define CRDY            (8L<<16)
  573 
  574 #define TRACKED         (16L<<16)
  575 #define BINARY          (32L<<16)
  576 #define BUF0            (64L<<16)
  577 #define EXCLUSIVE       (128L<<16)
  578                 /* LSB is used for gc mark */
  579 
  580 SCM_EXPORT scm_gra subrs_gra;
  581 #define subrs ((subr_info *)(subrs_gra.elts))
  582 /* SCM_EXPORT sizet numsmob, numptob;
  583   SCM_EXPORT smobfuns *smobs;
  584   SCM_EXPORT ptobfuns *ptobs;
  585   SCM_EXPORT ptobfuns pipob; */
  586 SCM_EXPORT scm_gra smobs_gra;
  587 #define numsmob (smobs_gra.len)
  588 #define smobs ((smobfuns *)(smobs_gra.elts))
  589 SCM_EXPORT scm_gra ptobs_gra;
  590 #define numptob (ptobs_gra.len)
  591 #define ptobs ((ptobfuns *)(ptobs_gra.elts))
  592 SCM_EXPORT port_info *scm_port_table;
  593 
  594 #define tc16_fport (tc7_port + 0*256L)
  595 #define tc16_pipe (tc7_port + 1*256L)
  596 #define tc16_strport (tc7_port + 2*256L)
  597 #define tc16_sfport (tc7_port + 3*256L)
  598 SCM_EXPORT long tc16_dir;
  599 SCM_EXPORT long tc16_clport;
  600 
  601 SCM_EXPORT SCM sys_protects[];
  602 #define cur_inp          sys_protects[0]
  603 #define cur_outp         sys_protects[1]
  604 #define cur_errp         sys_protects[2]
  605 #define def_inp          sys_protects[3]
  606 #define def_outp         sys_protects[4]
  607 #define def_errp         sys_protects[5]
  608 #define sys_errp         sys_protects[6]
  609 #define sys_safep        sys_protects[7]
  610 #define listofnull       sys_protects[8]
  611 #define undefineds       sys_protects[9]
  612 #define nullvect         sys_protects[10]
  613 #define nullstr          sys_protects[11]
  614 #define progargs         sys_protects[12]
  615 #define loadports        sys_protects[13]
  616 #define rootcont         sys_protects[14]
  617 #define dynwinds         sys_protects[15]
  618 #define list_unspecified sys_protects[16]
  619 #define f_evapply        sys_protects[17]
  620 #define eval_env         sys_protects[18]
  621 #define f_apply_closure  sys_protects[19]
  622 #define flo0             sys_protects[20]
  623 #define scm_uprotects    sys_protects[21]
  624 #define scm_narn         sys_protects[22]
  625 #define pows5        sys_protects[23]
  626 #define NUM_PROTECTS 24
  627 
  628 /* now for connects between source files */
  629 
  630 /* SCM_EXPORT sizet num_finals;
  631    SCM_EXPORT void (**finals)P((void));
  632    SCM_EXPORT sizet num_finals; */
  633 SCM_EXPORT scm_gra finals_gra;
  634 #define num_finals (finals_gra.len)
  635 #define finals ((void (**)())(finals_gra.elts))
  636 
  637 SCM_EXPORT unsigned char upcase[], downcase[];
  638 SCM_EXPORT SCM symhash;
  639 SCM_EXPORT int symhash_dim;
  640 SCM_EXPORT int no_symhash_gc; /* Set when linking code produced by Hobbit compiler. */
  641 SCM_EXPORT long heap_cells;
  642 SCM_EXPORT CELLPTR heap_org;
  643 SCM_EXPORT VOLATILE SCM freelist;
  644 SCM_EXPORT long gc_cells_collected, gc_malloc_collected, gc_ports_collected;
  645 SCM_EXPORT long gc_syms_collected;
  646 SCM_EXPORT long cells_allocated, lcells_allocated;
  647 SCM_EXPORT unsigned long mallocated, lmallocated;
  648 SCM_EXPORT long mtrigger;
  649 SCM_EXPORT SCM *loc_loadpath;
  650 SCM_EXPORT SCM *loc_errobj;
  651 SCM_EXPORT SCM loadport;
  652 SCM_EXPORT char *errjmp_bad;
  653 SCM_EXPORT VOLATILE int ints_disabled;
  654 SCM_EXPORT int output_deferred, gc_hook_pending, gc_hook_active;
  655 SCM_EXPORT unsigned long SIG_deferred;
  656 SCM_EXPORT SCM exitval;
  657 SCM_EXPORT int cursinit;
  658 SCM_EXPORT unsigned int poll_count, tick_count;
  659 SCM_EXPORT int dumped;
  660 SCM_EXPORT char *execpath;
  661 SCM_EXPORT char s_no_execpath[];
  662 SCM_EXPORT int scm_verbose;
  663 #define verbose (scm_verbose+0)
  664 
  665 SCM_EXPORT const char dirsep[];
  666 
  667 /* strings used in several source files */
  668 
  669 SCM_EXPORT char s_write[], s_newline[], s_system[];
  670 SCM_EXPORT char s_make_string[], s_make_vector[], s_list[], s_op_pipe[];
  671 #define s_string (s_make_string+5)
  672 #define s_vector (s_make_vector+5)
  673 #define s_pipe (s_op_pipe+5)
  674 SCM_EXPORT char s_make_sh_array[];
  675 SCM_EXPORT char s_array_fill[];
  676 #define s_array (s_make_sh_array+12)
  677 SCM_EXPORT char s_ccl[];
  678 #define s_limit (s_ccl+10)
  679 SCM_EXPORT char s_close_port[];
  680 #define s_port_type (s_close_port+6)
  681 SCM_EXPORT char s_call_cc[];
  682 #define s_cont (s_call_cc+18)
  683 SCM_EXPORT char s_try_create_file[];
  684 SCM_EXPORT char s_badenv[];
  685 
  686 SCM_EXPORT void (*init_user_scm) P((void));
  687 
  688 /* function prototypes */
  689 
  690 SCM_EXPORT void (* deferred_proc) P((void));
  691 SCM_EXPORT void process_signals P((void));
  692 SCM_EXPORT int  handle_it P((int i));
  693 SCM_EXPORT SCM  must_malloc_cell P((long len, SCM c, const char *what));
  694 SCM_EXPORT void must_realloc_cell P((SCM z, unsigned long olen, unsigned long len, const char *what));
  695 SCM_EXPORT char *must_malloc P((long len, const char *what));
  696 SCM_EXPORT char *must_realloc P((char *where, unsigned long olen, unsigned long len, const char *what));
  697 SCM_EXPORT void must_free P((char *obj, sizet len));
  698 SCM_EXPORT void scm_protect_temp P((SCM *ptr));
  699 SCM_EXPORT long ilength P((SCM sx));
  700 SCM_EXPORT SCM  hash P((SCM obj, SCM n));
  701 SCM_EXPORT SCM  hashv P((SCM obj, SCM n));
  702 SCM_EXPORT SCM  hashq P((SCM obj, SCM n));
  703 SCM_EXPORT SCM  obhash P((SCM obj));
  704 SCM_EXPORT SCM  obunhash P((SCM obj));
  705 SCM_EXPORT unsigned long strhash P((unsigned char *str, sizet len, unsigned long n));
  706 SCM_EXPORT unsigned long hasher P((SCM obj, unsigned long n, sizet d));
  707 SCM_EXPORT SCM  lroom P((SCM args));
  708 SCM_EXPORT void lfflush P((SCM port));
  709 SCM_EXPORT SCM  scm_force_output P((SCM port));
  710 SCM_EXPORT void scm_init_gra P((scm_gra *gra, sizet eltsize, sizet len,
  711                         sizet maxlen, const char *what));
  712 SCM_EXPORT int  scm_grow_gra P((scm_gra *gra, char *elt));
  713 SCM_EXPORT void scm_trim_gra P((scm_gra *gra));
  714 SCM_EXPORT void scm_free_gra P((scm_gra *gra));
  715 SCM_EXPORT long newsmob P((smobfuns *smob));
  716 SCM_EXPORT long newptob P((ptobfuns *ptob));
  717 SCM_EXPORT SCM  scm_port_entry P((FILE *stream, long ptype, long flags));
  718 SCM_EXPORT SCM  scm_open_ports P((void));
  719 SCM_EXPORT void prinport P((SCM exp, SCM port, char *type));
  720 SCM_EXPORT SCM  repl P((void));
  721 SCM_EXPORT void repl_report P((void));
  722 SCM_EXPORT void growth_mon P((char *obj, long size, char *units, int grewp));
  723 SCM_EXPORT void gc_start P((const char *what));
  724 SCM_EXPORT void gc_end P((void));
  725 SCM_EXPORT void gc_mark P((SCM p));
  726 SCM_EXPORT void scm_gc_hook P((void));
  727 SCM_EXPORT SCM     scm_gc_protect P((SCM obj));
  728 SCM_EXPORT SCM  scm_add_finalizer P((SCM value, SCM finalizer));
  729 SCM_EXPORT void scm_run_finalizers P((int exiting));
  730 SCM_EXPORT void    scm_egc_start P((void));
  731 SCM_EXPORT void    scm_egc_end P((void));
  732 SCM_EXPORT void heap_report P((void));
  733 SCM_EXPORT void gra_report P((void));
  734 SCM_EXPORT void exit_report P((void));
  735 SCM_EXPORT void stack_report P((void));
  736 SCM_EXPORT SCM  scm_stack_trace P((SCM contin));
  737 SCM_EXPORT SCM  scm_scope_trace P((SCM env));
  738 SCM_EXPORT SCM  scm_frame_trace P((SCM contin, SCM nf));
  739 SCM_EXPORT SCM  scm_frame2env P((SCM contin, SCM nf));
  740 SCM_EXPORT SCM  scm_frame_eval P((SCM contin, SCM nf, SCM expr));
  741 SCM_EXPORT void scm_iprin1 P((SCM exp, SCM port, int writing));
  742 SCM_EXPORT void scm_intprint P((long n, int radix, SCM port));
  743 SCM_EXPORT void scm_iprlist P((char *hdr, SCM exp, int tlr, SCM port, int writing));
  744 SCM_EXPORT SCM  scm_env_lookup P((SCM var, SCM stenv));
  745 SCM_EXPORT SCM  scm_env_rlookup P((SCM addr, SCM stenv, const char *what));
  746 SCM_EXPORT SCM  scm_env_getprop P((SCM prop, SCM env));
  747 SCM_EXPORT SCM  scm_env_addprop P((SCM prop, SCM val, SCM env));
  748 SCM_EXPORT long num_frames P((SCM estk, int i));
  749 SCM_EXPORT SCM  *estk_frame P((SCM estk, int i, int nf));
  750 SCM_EXPORT SCM  *cont_frame P((SCM contin, int nf));
  751 SCM_EXPORT SCM  stacktrace1 P((SCM estk, int i));
  752 SCM_EXPORT void scm_princode P((SCM code, SCM env, SCM port, int writing));
  753 SCM_EXPORT void scm_princlosure P((SCM proc, SCM port, int writing));
  754 SCM_EXPORT void lputc P((int c, SCM port));
  755 SCM_EXPORT void lputs P((const char *s, SCM port));
  756 SCM_EXPORT sizet        lfwrite P((char *ptr, sizet size, sizet nitems, SCM port));
  757 SCM_EXPORT int  lgetc P((SCM port));
  758 SCM_EXPORT void lungetc P((int c, SCM port));
  759 SCM_EXPORT char *grow_tok_buf P((SCM tok_buf));
  760 SCM_EXPORT long mode_bits P((char *modes, char *cmodes));
  761 SCM_EXPORT long time_in_msec P((long x));
  762 SCM_EXPORT SCM  my_time P((void));
  763 SCM_EXPORT SCM  your_time P((void));
  764 SCM_EXPORT void init_iprocs P((iproc *subra, int type));
  765 
  766 SCM_EXPORT void final_scm P((int));
  767 SCM_EXPORT void init_sbrk P((void));
  768 SCM_EXPORT int  init_buf0 P((FILE *inport));
  769 SCM_EXPORT void scm_init_from_argv P((int argc, const char * const *argv, char *script_arg,
  770                               int iverbose, int buf0stdin));
  771 SCM_EXPORT void init_signals P((void));
  772 SCM_EXPORT SCM  scm_top_level P((char *initpath, SCM (*toplvl_fun)()));
  773 SCM_EXPORT void restore_signals P((void));
  774 SCM_EXPORT void free_storage P((void));
  775 SCM_EXPORT char *dld_find_executable P((const char* command));
  776 SCM_EXPORT char *scm_find_execpath P((int argc, const char * const *argv, const char *script_arg));
  777 SCM_EXPORT void init_scm P((int iverbose, int buf0stdin, long init_heap_size));
  778 SCM_EXPORT void    scm_init_INITS P((void));
  779 SCM_EXPORT SCM  scm_init_extensions P((void));
  780 SCM_EXPORT void ignore_signals P((void));
  781 SCM_EXPORT void unignore_signals P((void));
  782 
  783 SCM_EXPORT void add_feature P((char *str));
  784 SCM_EXPORT int  raprin1 P((SCM exp, SCM port, int writing));
  785 SCM_EXPORT SCM  markcdr P((SCM ptr));
  786 #define mark0 (0)    /*SCM mark0 P((SCM ptr)); */
  787 SCM_EXPORT SCM  equal0 P((SCM ptr1, SCM ptr2));
  788 SCM_EXPORT sizet        free0 P((CELLPTR ptr));
  789 SCM_EXPORT void scm_warn P((char *str1, char *str2, SCM obj));
  790 SCM_EXPORT void everr P((SCM exp, SCM env, SCM arg, const char *pos, const char *s_subr, int codep));
  791 SCM_EXPORT void wta P((SCM arg, const char *pos, const char *s_subr));
  792 SCM_EXPORT void scm_experr P((SCM arg, const char *pos, const char *s_subr));
  793 SCM_EXPORT SCM  intern P((char *name, sizet len));
  794 SCM_EXPORT SCM  sysintern P((const char *name, SCM val));
  795 SCM_EXPORT SCM  sym2vcell P((SCM sym));
  796 SCM_EXPORT SCM  makstr P((long len));
  797 SCM_EXPORT SCM  scm_maksubr P((const char *name, int type, SCM (*fcn)()));
  798 SCM_EXPORT SCM  make_subr P((const char *name, int type, SCM (*fcn)()));
  799 SCM_EXPORT SCM  make_synt P((const char *name, long flags, SCM (*fcn)()));
  800 SCM_EXPORT SCM  make_gsubr P((const char *name, int req, int opt, int rst,
  801                       SCM (*fcn)()));
  802 SCM_EXPORT SCM  closure P((SCM code, int nargs));
  803 SCM_EXPORT SCM  makprom P((SCM code));
  804 SCM_EXPORT SCM  force P((SCM x));
  805 SCM_EXPORT SCM  makarb P((SCM name));
  806 SCM_EXPORT SCM  tryarb P((SCM arb));
  807 SCM_EXPORT SCM  relarb P((SCM arb));
  808 SCM_EXPORT SCM  ceval P((SCM x, SCM static_env, SCM env));
  809 SCM_EXPORT SCM  scm_wrapcode P((SCM code, SCM env));
  810 SCM_EXPORT SCM  scm_current_env P((void));
  811 SCM_EXPORT SCM  prolixity P((SCM arg));
  812 SCM_EXPORT SCM  gc_for_newcell P((void));
  813 SCM_EXPORT void gc_for_open_files P((void));
  814 SCM_EXPORT SCM  gc P((SCM arg));
  815 SCM_EXPORT SCM  tryload P((SCM filename, SCM reader));
  816 SCM_EXPORT SCM  acons P((SCM w, SCM x, SCM y));
  817 SCM_EXPORT SCM  cons2 P((SCM w, SCM x, SCM y));
  818 SCM_EXPORT SCM  resizuve P((SCM vect, SCM len));
  819 SCM_EXPORT SCM  lnot P((SCM x));
  820 SCM_EXPORT SCM  booleanp P((SCM obj));
  821 SCM_EXPORT SCM  eq P((SCM x, SCM y));
  822 SCM_EXPORT SCM  equal P((SCM x, SCM y));
  823 SCM_EXPORT SCM  consp P((SCM x));
  824 SCM_EXPORT SCM  cons P((SCM x, SCM y));
  825 SCM_EXPORT SCM  nullp P((SCM x));
  826 SCM_EXPORT SCM  setcar P((SCM pair, SCM value));
  827 SCM_EXPORT SCM  setcdr P((SCM pair, SCM value));
  828 SCM_EXPORT SCM  listp P((SCM x));
  829 SCM_EXPORT SCM  list P((SCM objs));
  830 SCM_EXPORT SCM  length P((SCM x));
  831 SCM_EXPORT SCM  append P((SCM args));
  832 SCM_EXPORT SCM  reverse P((SCM lst));
  833 SCM_EXPORT SCM  list_ref P((SCM lst, SCM k));
  834 SCM_EXPORT SCM  memq P((SCM x, SCM lst));
  835 SCM_EXPORT SCM  member P((SCM x, SCM lst));
  836 SCM_EXPORT SCM  memv P((SCM x, SCM lst));
  837 SCM_EXPORT SCM  assq P((SCM x, SCM alist));
  838 SCM_EXPORT SCM  assoc P((SCM x, SCM alist));
  839 SCM_EXPORT SCM  symbolp P((SCM x));
  840 SCM_EXPORT SCM  symbol2string P((SCM s));
  841 SCM_EXPORT SCM  string2symbol P((SCM s));
  842 SCM_EXPORT SCM  string_copy P((SCM s));
  843 SCM_EXPORT SCM  numberp P((SCM x));
  844 SCM_EXPORT SCM  exactp P((SCM x));
  845 SCM_EXPORT SCM  inexactp P((SCM x));
  846 SCM_EXPORT SCM  eqp P((SCM x, SCM y));
  847 SCM_EXPORT SCM  eqv P((SCM x, SCM y));
  848 SCM_EXPORT SCM  lessp P((SCM x, SCM y));
  849 SCM_EXPORT SCM  greaterp P((SCM x, SCM y));
  850 SCM_EXPORT SCM  leqp P((SCM x, SCM y));
  851 SCM_EXPORT SCM  greqp P((SCM x, SCM y));
  852 SCM_EXPORT SCM  zerop P((SCM z));
  853 SCM_EXPORT SCM  positivep P((SCM x));
  854 SCM_EXPORT SCM  negativep P((SCM x));
  855 SCM_EXPORT SCM  oddp P((SCM n));
  856 SCM_EXPORT SCM  evenp P((SCM n));
  857 SCM_EXPORT SCM  scm_max P((SCM x, SCM y));
  858 SCM_EXPORT SCM  scm_min P((SCM x, SCM y));
  859 SCM_EXPORT SCM  sum P((SCM x, SCM y));
  860 SCM_EXPORT SCM  difference P((SCM x, SCM y));
  861 SCM_EXPORT SCM  product P((SCM x, SCM y));
  862 SCM_EXPORT SCM  divide P((SCM x, SCM y));
  863 SCM_EXPORT SCM  scm_round_quotient P((SCM x, SCM y));
  864 SCM_EXPORT SCM  lquotient P((SCM x, SCM y));
  865 SCM_EXPORT SCM  scm_iabs P((SCM x));
  866 SCM_EXPORT SCM  scm_abs P((SCM x));
  867 SCM_EXPORT SCM  lremainder P((SCM x, SCM y));
  868 SCM_EXPORT SCM  modulo P((SCM x, SCM y));
  869 SCM_EXPORT SCM  lgcd P((SCM x, SCM y));
  870 SCM_EXPORT SCM  llcm P((SCM n1, SCM n2));
  871 SCM_EXPORT SCM  number2string P((SCM x, SCM radix));
  872 SCM_EXPORT SCM  istring2number P((char *str, long len, long radix));
  873 SCM_EXPORT SCM  string2number P((SCM str, SCM radix));
  874 SCM_EXPORT SCM  istr2flo P((char *str, long len, long radix));
  875 SCM_EXPORT SCM  mkbig P((sizet nlen, int sign));
  876 SCM_EXPORT void bigrecy P((SCM bgnm));
  877 SCM_EXPORT SCM  mkstrport P((SCM pos, SCM str, long modes, char *caller));
  878 SCM_EXPORT SCM  mksafeport P((int maxlen, SCM port));
  879 SCM_EXPORT int  reset_safeport P((SCM sfp, int maxlen, SCM port));
  880 SCM_EXPORT SCM  long2big P((long n));
  881 SCM_EXPORT SCM  ulong2big P((unsigned long n));
  882 SCM_EXPORT SCM  big2inum P((SCM b, sizet l));
  883 SCM_EXPORT sizet ilong2str P((long num, int rad, char *p));
  884 SCM_EXPORT sizet iulong2str P((unsigned long num, int rad, char *p));
  885 SCM_EXPORT SCM  floequal P((SCM x, SCM y));
  886 SCM_EXPORT SCM  uve_equal P((SCM u, SCM v));
  887 SCM_EXPORT SCM  uve_read P((SCM v, SCM port));
  888 SCM_EXPORT SCM  uve_write P((SCM v, SCM port));
  889 SCM_EXPORT SCM  raequal P((SCM ra0, SCM ra1));
  890 SCM_EXPORT SCM  array_equal P((SCM u, SCM v));
  891 SCM_EXPORT SCM  array_rank P((SCM ra));
  892 SCM_EXPORT int  rafill P((SCM ra, SCM fill, SCM ignore));
  893 SCM_EXPORT SCM  uve_fill P((SCM uve, SCM fill));
  894 SCM_EXPORT SCM  array_fill P((SCM ra, SCM fill));
  895 SCM_EXPORT SCM  array_prot P((SCM ra));
  896 SCM_EXPORT SCM  array_rank P((SCM ra));
  897 SCM_EXPORT SCM  array_contents P((SCM ra, SCM strict));
  898 SCM_EXPORT int  bigprint P((SCM exp, SCM port, int writing));
  899 SCM_EXPORT int  floprint P((SCM sexp, SCM port, int writing));
  900 SCM_EXPORT SCM  istr2int P((char *str, long len, int radix));
  901 SCM_EXPORT SCM  istr2bve P((char *str, long len));
  902 SCM_EXPORT void scm_ipruk P((char *hdr, SCM ptr, SCM port));
  903 SCM_EXPORT SCM  charp P((SCM x));
  904 SCM_EXPORT SCM  char_lessp P((SCM x, SCM y));
  905 SCM_EXPORT SCM  chci_eq P((SCM x, SCM y));
  906 SCM_EXPORT SCM  chci_lessp P((SCM x, SCM y));
  907 SCM_EXPORT SCM  char_alphap P((SCM chr));
  908 SCM_EXPORT SCM  char_nump P((SCM chr));
  909 SCM_EXPORT SCM  char_whitep P((SCM chr));
  910 SCM_EXPORT SCM  char_upperp P((SCM chr));
  911 SCM_EXPORT SCM  char_lowerp P((SCM chr));
  912 SCM_EXPORT SCM  char2int P((SCM chr));
  913 SCM_EXPORT SCM  int2char P((SCM n));
  914 SCM_EXPORT SCM  char_upcase P((SCM chr));
  915 SCM_EXPORT SCM  char_downcase P((SCM chr));
  916 SCM_EXPORT SCM  stringp P((SCM x));
  917 SCM_EXPORT SCM  string P((SCM chrs));
  918 SCM_EXPORT SCM  make_string P((SCM k, SCM chr));
  919 SCM_EXPORT SCM  string2list P((SCM str));
  920 SCM_EXPORT SCM  st_length P((SCM str));
  921 SCM_EXPORT SCM  st_ref P((SCM str, SCM k));
  922 SCM_EXPORT SCM  st_set P((SCM str, SCM k, SCM chr));
  923 SCM_EXPORT SCM  st_equal P((SCM s1, SCM s2));
  924 SCM_EXPORT SCM  stci_equal P((SCM s1, SCM s2));
  925 SCM_EXPORT SCM  st_lessp P((SCM s1, SCM s2));
  926 SCM_EXPORT SCM  stci_lessp P((SCM s1, SCM s2));
  927 SCM_EXPORT SCM  substring P((SCM str, SCM start, SCM end));
  928 SCM_EXPORT SCM  st_append P((SCM args));
  929 SCM_EXPORT SCM  vectorp P((SCM x));
  930 SCM_EXPORT SCM  vector_length P((SCM v));
  931 SCM_EXPORT SCM  vector P((SCM l));
  932 SCM_EXPORT SCM  vector_ref P((SCM v, SCM k));
  933 SCM_EXPORT SCM  vector_set P((SCM v, SCM k, SCM obj));
  934 SCM_EXPORT SCM  make_vector P((SCM k, SCM fill));
  935 SCM_EXPORT SCM  vector2list P((SCM v));
  936 SCM_EXPORT SCM  for_each P((SCM proc, SCM arg1, SCM args));
  937 SCM_EXPORT SCM  procedurep P((SCM obj));
  938 SCM_EXPORT SCM  apply P((SCM proc, SCM arg1, SCM args));
  939 SCM_EXPORT SCM  scm_cvapply P((SCM proc, long n, SCM *argv));
  940 SCM_EXPORT int  scm_arity_check P((SCM proc, long argc, const char *what));
  941 SCM_EXPORT SCM  map P((SCM proc, SCM arg1, SCM args));
  942 SCM_EXPORT SCM  scm_make_cont P((void));
  943 SCM_EXPORT SCM  copytree P((SCM obj));
  944 SCM_EXPORT SCM  eval P((SCM obj));
  945 SCM_EXPORT SCM  scm_values P((SCM arg1, SCM arg2, SCM rest, const char *what));
  946 SCM_EXPORT SCM  scm_eval_values P((SCM x, SCM static_env, SCM env));
  947 SCM_EXPORT SCM  identp P((SCM obj));
  948 SCM_EXPORT SCM  ident2sym P((SCM id));
  949 SCM_EXPORT SCM  ident_eqp P((SCM id1, SCM id2, SCM env));
  950 SCM_EXPORT int  scm_nullenv_p P((SCM env));
  951 SCM_EXPORT SCM  env2tree P((SCM env));
  952 SCM_EXPORT SCM  renamed_ident P((SCM id, SCM env));
  953 SCM_EXPORT SCM  scm_check_linum P((SCM x, SCM *linum));
  954 SCM_EXPORT SCM  scm_add_linum P((SCM linum, SCM x));
  955 SCM_EXPORT SCM  input_portp P((SCM x));
  956 SCM_EXPORT SCM  output_portp P((SCM x));
  957 SCM_EXPORT SCM  cur_input_port P((void));
  958 SCM_EXPORT SCM  cur_output_port P((void));
  959 SCM_EXPORT SCM  i_setbuf0 P((SCM port));
  960 SCM_EXPORT SCM  try_open_file P((SCM filename, SCM modes));
  961 SCM_EXPORT SCM  open_file P((SCM filename, SCM modes));
  962 SCM_EXPORT SCM  open_pipe P((SCM pipestr, SCM modes));
  963 SCM_EXPORT SCM  close_port P((SCM port));
  964 SCM_EXPORT SCM  scm_file_position P((SCM port, SCM pos));
  965 #define file_position(port) scm_file_position(port, BOOL_F)
  966 #define file_set_position scm_file_position
  967 SCM_EXPORT SCM  scm_read P((SCM port));
  968 SCM_EXPORT SCM  scm_read_char P((SCM port));
  969 SCM_EXPORT SCM  scm_peek_char P((SCM port));
  970 SCM_EXPORT SCM  eof_objectp P((SCM x));
  971 SCM_EXPORT int  scm_io_error P((SCM port, const char *what));
  972 SCM_EXPORT SCM  scm_write P((SCM obj, SCM port));
  973 SCM_EXPORT SCM  scm_display P((SCM obj, SCM port));
  974 SCM_EXPORT SCM  scm_newline P((SCM port));
  975 SCM_EXPORT SCM  scm_write_char P((SCM chr, SCM port));
  976 SCM_EXPORT SCM  scm_port_line P((SCM port));
  977 SCM_EXPORT SCM  scm_port_col P((SCM port));
  978 SCM_EXPORT void scm_line_msg P((SCM file, SCM linum, SCM port));
  979 SCM_EXPORT void scm_err_line P((const char *what, SCM file, SCM linum, SCM port));
  980 SCM_EXPORT SCM  scm_getenv P((SCM nam));
  981 SCM_EXPORT SCM  prog_args P((void));
  982 SCM_EXPORT SCM  makacro P((SCM code));
  983 SCM_EXPORT SCM  makmacro P((SCM code));
  984 SCM_EXPORT SCM  makmmacro P((SCM code));
  985 SCM_EXPORT SCM  makidmacro P((SCM code));
  986 SCM_EXPORT void poll_routine P((void));
  987 SCM_EXPORT void tick_signal P((void));
  988 SCM_EXPORT void stack_check P((void));
  989 SCM_EXPORT SCM  list2ura P((SCM ndim, SCM prot, SCM lst));
  990 SCM_EXPORT SCM  make_ra P((int ndim));
  991 SCM_EXPORT SCM  makflo P((float x));
  992 SCM_EXPORT SCM  arrayp P((SCM v, SCM prot));
  993 SCM_EXPORT SCM  aset P((SCM v, SCM obj, SCM args));
  994 SCM_EXPORT SCM  aref P((SCM v, SCM args));
  995 SCM_EXPORT SCM     scm_array_ref P((SCM args));
  996 SCM_EXPORT SCM  cvref P((SCM v, sizet pos, SCM last));
  997 SCM_EXPORT SCM  quit P((SCM n));
  998 #ifdef CAREFUL_INTS
  999 SCM_EXPORT void ints_viol P((ints_infot *info, int sense));
 1000 SCM_EXPORT void    ints_warn P((char *s1, char* s2, char *fname, int linum));
 1001 #endif
 1002 SCM_EXPORT void add_final P((void (*final)(void)));
 1003 SCM_EXPORT SCM  makcclo P((SCM proc, long len));
 1004 SCM_EXPORT SCM  make_uve P((long k, SCM prot));
 1005 SCM_EXPORT long scm_prot2type P((SCM prot));
 1006 SCM_EXPORT long aind P((SCM ra, SCM args, const char *what));
 1007 SCM_EXPORT SCM  scm_eval_string P((SCM str));
 1008 SCM_EXPORT SCM  scm_load_string P((SCM str));
 1009 SCM_EXPORT SCM  scm_unexec P((const SCM pathname));
 1010 SCM_EXPORT SCM     scm_logbitp  P((SCM index, SCM j1));
 1011 SCM_EXPORT SCM     scm_logtest  P((SCM x, SCM y));
 1012 SCM_EXPORT SCM     scm_logxor P((SCM x, SCM y));
 1013 SCM_EXPORT SCM     scm_logand P((SCM x, SCM y));
 1014 SCM_EXPORT SCM     scm_logior P((SCM x, SCM y));
 1015 SCM_EXPORT SCM     scm_lognot P((SCM n));
 1016 SCM_EXPORT SCM     scm_intexpt P((SCM z1, SCM z2));
 1017 SCM_EXPORT SCM     scm_intlog P((SCM base, SCM k));
 1018 SCM_EXPORT SCM     scm_cintlog P((SCM base, SCM k));
 1019 SCM_EXPORT SCM     scm_ash P((SCM n, SCM cnt));
 1020 SCM_EXPORT SCM     scm_bitfield P((SCM n, SCM start, SCM end));
 1021 SCM_EXPORT SCM     scm_logcount P((SCM n));
 1022 SCM_EXPORT SCM     scm_intlength P((SCM n));
 1023 SCM_EXPORT SCM     scm_copybit P((SCM index, SCM j1, SCM bit));
 1024 SCM_EXPORT SCM  scm_bitif P((SCM mask, SCM n0, SCM n1));
 1025 SCM_EXPORT SCM  scm_copybitfield P((SCM to, SCM start, SCM rest));
 1026 
 1027                                 /* Defined in "rope.c" */
 1028 SCM_EXPORT SCM   long2num P((long n));
 1029 SCM_EXPORT SCM  ulong2num P((unsigned long n));
 1030 SCM_EXPORT unsigned char  num2uchar  P((SCM num, char *pos, char *s_caller));
 1031 SCM_EXPORT   signed char  num2char   P((SCM num, char *pos, char *s_caller));
 1032 SCM_EXPORT unsigned short num2ushort P((SCM num, char *pos, char *s_caller));
 1033 SCM_EXPORT          short num2short  P((SCM num, char *pos, char *s_caller));
 1034 SCM_EXPORT unsigned long  num2ulong  P((SCM num, char *pos, char *s_caller));
 1035 SCM_EXPORT          long  num2long   P((SCM num, char *pos, char *s_caller));
 1036 SCM_EXPORT         double num2dbl    P((SCM num, char *pos, char *s_caller));
 1037 SCM_EXPORT SCM  makfromstr  P((const char *src, sizet len));
 1038 SCM_EXPORT SCM  makfromstrs P((int argc, const char * const *argv));
 1039 SCM_EXPORT SCM  makfrom0str P((const char *scr));
 1040 SCM_EXPORT char **makargvfrmstrs P((SCM args, const char *s_v));
 1041 SCM_EXPORT void must_free_argv P((char **argv));
 1042 SCM_EXPORT SCM  scm_evstr  P((char *str));
 1043 SCM_EXPORT void scm_ldstr  P((char *str));
 1044 SCM_EXPORT int  scm_ldfile P((char *path));
 1045 SCM_EXPORT int  scm_ldprog P((char *path));
 1046 SCM_EXPORT void* scm_addr P((SCM args, const char *name));
 1047 SCM_EXPORT void* scm_base_addr P((SCM v, const char *name));
 1048 SCM_EXPORT int  scm_cell_p P((SCM x));
 1049 
 1050 #ifdef FLOATS
 1051 SCM_EXPORT SCM  makdbl P((double x, double y));
 1052 SCM_EXPORT SCM  dbl2big P((double d));
 1053 SCM_EXPORT double       int2dbl P((SCM b));
 1054 SCM_EXPORT double       scm_truncate P((double x));
 1055 SCM_EXPORT double       scm_round P((double x));
 1056 SCM_EXPORT double       floident P((double x));
 1057 #endif
 1058 
 1059 #ifdef BIGDIG
 1060 SCM_EXPORT void longdigs P((long x, BIGDIG digs[DIGSPERLONG]));
 1061 SCM_EXPORT SCM  adjbig P((SCM b, sizet nlen));
 1062 SCM_EXPORT SCM  normbig P((SCM b));
 1063 SCM_EXPORT SCM  copybig P((SCM b, int sign));
 1064 SCM_EXPORT SCM  addbig P((BIGDIG *x, sizet nx, int xsgn, SCM bigy, int sgny));
 1065 SCM_EXPORT SCM  mulbig P((BIGDIG *x, sizet nx, BIGDIG *y, sizet ny, int sgn));
 1066 SCM_EXPORT UBIGLONG divbigdig P((BIGDIG *ds, sizet h, BIGDIG div));
 1067 SCM_EXPORT SCM  divbigint P((SCM x, long z, int sgn, int mode));
 1068 SCM_EXPORT SCM  divbigbig P((BIGDIG *x, sizet nx, BIGDIG *y, sizet ny, int sgn,
 1069                    int mode));
 1070 SCM_EXPORT long  pseudolong P((long x));
 1071 #endif
 1072 SCM_EXPORT int  bigcomp P((SCM x, SCM y));
 1073 SCM_EXPORT SCM  bigequal P((SCM x, SCM y));
 1074 SCM_EXPORT int  scm_bigdblcomp P((SCM b, double d));
 1075 
 1076 /* "script.c" functions */
 1077 SCM_EXPORT char *       scm_cat_path P((char *str1, const char *str2, long n));
 1078 SCM_EXPORT char *       scm_try_path P((char *path));
 1079 SCM_EXPORT char *       script_find_executable P((const char *command));
 1080 SCM_EXPORT char **      script_process_argv P((int argc, const char **argv));
 1081 SCM_EXPORT int  script_count_argv P((const char **argv));
 1082 SCM_EXPORT char *       find_impl_file P((const char *exec_path, const char *generic_name,
 1083                           const char *initname, const char *sep));
 1084 
 1085 /* environment cache functions */
 1086 SCM_EXPORT void scm_ecache_report P((void));
 1087 SCM_EXPORT void scm_estk_reset P((sizet size));
 1088 SCM_EXPORT void scm_env_cons P((SCM x, SCM y));
 1089 SCM_EXPORT void scm_env_cons2 P((SCM w, SCM x, SCM y));
 1090 SCM_EXPORT void scm_env_cons3 P((SCM v, SCM w, SCM x, SCM y));
 1091 SCM_EXPORT void scm_env_v2lst P((long argc, SCM *argv));
 1092 SCM_EXPORT void scm_extend_env P((void));
 1093 SCM_EXPORT void scm_egc P((void));
 1094 
 1095 /* Global state for environment cache */
 1096 SCM_EXPORT CELLPTR scm_ecache;
 1097 SCM_EXPORT VOLATILE long scm_ecache_index, scm_ecache_len;
 1098 SCM_EXPORT SCM scm_env, scm_env_tmp;
 1099 SCM_EXPORT SCM scm_egc_roots[];
 1100 SCM_EXPORT VOLATILE long scm_egc_root_index;
 1101 SCM_EXPORT SCM scm_estk;
 1102 SCM_EXPORT SCM *scm_estk_v, *scm_estk_ptr;
 1103 SCM_EXPORT long scm_estk_size;
 1104 #ifndef RECKLESS
 1105 SCM_EXPORT SCM scm_trace, scm_trace_env;
 1106 #endif
 1107 
 1108 #ifdef RECKLESS
 1109 # define ASRTER(_cond, _arg, _pos, _subr) ;
 1110 # define ASRTGO(_cond, _label) ;
 1111 #else
 1112 # define ASRTER(_cond, _arg, _pos, _subr) if (SCM_EXPECT_FALSE(!(_cond))) wta(_arg, (char *)(_pos), _subr);
 1113 # define ASRTGO(_cond, _label) if (SCM_EXPECT_FALSE(!(_cond))) goto _label;
 1114 #endif
 1115 
 1116 #define ARGn            1L
 1117 #define ARG1            2L
 1118 #define ARG2            3L
 1119 #define ARG3            4L
 1120 #define ARG4            5L
 1121 #define ARG5            6L
 1122   /* following must match entry indexes in errmsgs[] */
 1123 #define WNA             7L
 1124 #define OVFLOW          8L
 1125 #define OUTOFRANGE      9L
 1126 #define NALLOC          10L
 1127 #define THRASH          11L
 1128 #define EXIT            12L
 1129 #define HUP_SIGNAL      13L
 1130 #define INT_SIGNAL      14L
 1131 #define FPE_SIGNAL      15L
 1132 #define BUS_SIGNAL      16L
 1133 #define SEGV_SIGNAL     17L
 1134 #define ALRM_SIGNAL     18L
 1135 #define VTALRM_SIGNAL   19L
 1136 #define PROF_SIGNAL     20L
 1137 
 1138 #define EVAL(x, env, venv) (IMP(x)?(x):ceval((x), (SCM)(env), (SCM)(venv)))
 1139 #define SIDEVAL(x, env, venv) if (NIMP(x)) ceval((x), (SCM)(env), (SCM)(venv))
 1140 
 1141 #define NEWCELL(_into) {if (IMP(freelist)) _into = gc_for_newcell();\
 1142         else {_into = freelist;freelist = CDR(freelist);++cells_allocated;}}
 1143 /*
 1144 #define NEWCELL(_into) {DEFER_INTS;if (IMP(freelist)) _into = gc_for_newcell();\
 1145         else {_into = freelist;freelist = CDR(freelist);++cells_allocated;}\
 1146         ALLOW_INTS;}
 1147 */
 1148 
 1149 #ifdef __cplusplus
 1150 }
 1151 #endif