diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:26 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:26 -0800 |
commit | deda2c0fd8689349fea2a900199a76ff7ecb319e (patch) | |
tree | c9726d54a0806a9b0c75e6c82db8692aea0053cf /scm.h | |
parent | 3278b75942bdbe706f7a0fba87729bb1e935b68b (diff) | |
download | scm-480dce1955c6d4d9463f2c0641be6f36576a0c5e.tar.gz scm-480dce1955c6d4d9463f2c0641be6f36576a0c5e.zip |
Import Upstream version 5d6upstream/5d6
Diffstat (limited to 'scm.h')
-rw-r--r-- | scm.h | 273 |
1 files changed, 195 insertions, 78 deletions
@@ -15,26 +15,26 @@ * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA. * * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. + * for additional uses of the text contained in its release of SCM. * - * The exception is that, if you link the GUILE library with other files + * The exception is that, if you link the SCM library with other files * to produce an executable, this does not by itself cause the * resulting executable to be covered by the GNU General Public License. * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. + * linking the SCM library code into it. * * This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU General Public License. * * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy + * Free Software Foundation under the name SCM. If you copy * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does + * SCM, as the General Public License permits, the exception does * not apply to the code that you add in this way. To avoid misleading * anyone as to the status of such modified files, you must delete * this exception notice from them. * - * If you write modifications of your own for GUILE, it is your choice + * If you write modifications of your own for SCM, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ @@ -51,6 +51,16 @@ extern "C" { # endif #endif +#ifdef PLAN9 +# include <u.h> +# include <libc.h> +/* Simple imitation of some Unix system calls */ +# define exit(val) exits("") +# define getcwd getwd +/* we have our own isatty */ +int isatty (int); +#endif + typedef long SCM; typedef struct {SCM car, cdr;} cell; typedef struct {long sname;SCM (*cproc)();} subr; @@ -100,15 +110,17 @@ typedef struct { int (*fflush)P((FILE *stream)); int (*fgetc)P((FILE *p)); int (*fclose)P((FILE *p)); + int (*ungetc)P((int c, SCM p)); } ptobfuns; typedef struct { + SCM data; + SCM port; long flags; - int unread; long line; + int unread; short col; short colprev; - SCM data; } port_info; typedef struct { @@ -143,16 +155,13 @@ typedef struct {SCM type;double *real;} dbl; #define ICHR(x) ((unsigned char)((x)>>8)) #define MAKICHR(x) (((x)<<8)+0xf4L) -#define ILOCP(n) ((0xff & (int)(n))==0xfc) #define ILOC00 (0x000000fcL) -#define IDINC (0x00100000L) -#define ICDR (0x00080000L) -#define IFRINC (0x00000100L) -#define IDSTMSK (-IDINC) -#define MAKILOC(if, id) (ILOC00 + (((long)id)<<20) + (((long)if)<<8)) -#define IFRAME(n) ((int)((ICDR-IFRINC)>>8) & ((int)(n)>>8)) -#define IDIST(n) (((unsigned long)(n))>>20) +#define ILOCP(n) ((0xff & (int)(n))==(int)ILOC00) +#define MAKILOC(if, id) (ILOC00 + (((long)id)<<8) + (((long)if)<<16)) +#define IDIST(n) (((int)(n)>>8) & 0x7f) +#define IFRAME(n) (((int)(n)>>16)) #define ICDRP(n) (ICDR & (n)) +#define ICDR (1L<<15) /* ISYMP tests for ISPCSYM and ISYM */ #define ISYMP(n) ((0x187 & (int)(n))==4) @@ -165,6 +174,9 @@ typedef struct {SCM type;double *real;} dbl; #define MAKSPCSYM(n) (((n)<<9)+((n)<<3)+4L) #define MAKISYM(n) (((n)<<9)+0x74L) #define MAKIFLAG(n) (((n)<<9)+0x174L) +/* This is to make the print representation of some evaluated code, + as in backtraces, make a little more sense. */ +#define MAKSPCSYM2(work, look) ((127L & (work)) | ((127L<<9) & (look))) extern char *isymnames[]; #define NUM_ISPCSYM 14 @@ -181,7 +193,7 @@ extern char *isymnames[]; #define IM_OR MAKSPCSYM(10) #define IM_QUOTE MAKSPCSYM(11) #define IM_SET MAKSPCSYM(12) -#define IM_DEFINE MAKSPCSYM(13) +#define IM_FUNCALL MAKSPCSYM(13) #define s_and (ISYMCHARS(IM_AND)+2) #define s_begin (ISYMCHARS(IM_BEGIN)+2) @@ -199,23 +211,38 @@ extern char *isymnames[]; #define s_define (ISYMCHARS(IM_DEFINE)+2) #define s_delay (ISYMCHARS(IM_DELAY)+2) #define s_quasiquote (ISYMCHARS(IM_QUASIQUOTE)+2) +#define s_let_syntax (ISYMCHARS(IM_LET_SYNTAX)+2) extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; #define s_apply (ISYMCHARS(IM_APPLY)+2) -/* each symbol defined here must have a unique number which */ - /* corresponds to it's position in isymnames[] in sys.c */ +/* each symbol defined here must have a unique number which + corresponds to it's position in isymnames[] in repl.c */ + /* These are used for dispatch in eval.c */ #define IM_APPLY MAKISYM(14) #define IM_FARLOC_CAR MAKISYM(15) #define IM_FARLOC_CDR MAKISYM(16) #define IM_DELAY MAKISYM(17) #define IM_QUASIQUOTE MAKISYM(18) -#define IM_UNQUOTE MAKISYM(19) -#define IM_UQ_SPLICING MAKISYM(20) -#define IM_ELSE MAKISYM(21) -#define IM_ARROW MAKISYM(22) - -#define NUM_ISYMS 23 +#define IM_EVAL_FOR_APPLY MAKISYM(19) +#define IM_LET_SYNTAX MAKISYM(20) +#define IM_ACRO_CALL MAKISYM(21) +#define IM_LINUM MAKISYM(22) +#define IM_DEFINE MAKISYM(23) + + /* These are not used for dispatch. */ +#define IM_UNQUOTE MAKISYM(24) +#define IM_UQ_SPLICING MAKISYM(25) +#define IM_ELSE MAKISYM(26) +#define IM_ARROW MAKISYM(27) +#define IM_VALUES_TOKEN MAKISYM(28) +#define IM_KEYWORD MAKISYM(29) + +#define SCM_MAKE_LINUM(n) (IM_LINUM | ((unsigned long)(n))<<16) +#define SCM_LINUM(x) ((unsigned long)(x)>>16) +#define SCM_LINUMP(x) ((0xffffL & (x))==IM_LINUM) + +#define NUM_ISYMS 30 #define BOOL_F MAKIFLAG(NUM_ISYMS+0) #define BOOL_T MAKIFLAG(NUM_ISYMS+1) @@ -267,6 +294,7 @@ extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; #define CONSP(x) (!NCONSP(x)) #define ECONSP(x) (CONSP(x) || (1==TYP3(x))) #define NECONSP(x) (NCONSP(x) && (1 != TYP3(x))) +#define SCM_GLOCP(x) (tc3_cons_gloc==(7 & (int)(x))) #define CAR(x) (((cell *)(SCM2PTR(x)))->car) #define CDR(x) (((cell *)(SCM2PTR(x)))->cdr) @@ -280,16 +308,39 @@ extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; #define GCENV ENV #define ARGC(x) ((6L & CDR(x))>>1) #ifdef CAUTIOUS -# define SCM_ESTK_FRLEN 3 +# define SCM_ESTK_FRLEN 4 #else -# define SCM_ESTK_FRLEN 2 +# define SCM_ESTK_FRLEN 3 #endif #define SCM_ESTK_BASE 4 #define SCM_ESTK_PARENT(v) (VELTS(v)[0]) #define SCM_ESTK_PARENT_WRITABLEP(v) (VELTS(v)[1]) #define SCM_ESTK_PARENT_INDEX(v) (VELTS(v)[2]) -extern long tc16_env; +extern long tc16_env, tc16_ident; #define ENVP(x) (tc16_env==TYP16(x)) +#define SCM_ENV_FORMALS CAR +#ifdef MACRO +# define M_IDENTP(x) (tc16_ident==TYP16(x)) +# define M_IDENT_LEXP(x) ((tc16_ident | (1L<<16))==CAR(x)) +# define IDENTP(x) (SYMBOLP(x) || M_IDENTP(x)) +# define IDENT_PARENT(x) (M_IDENT_LEXP(x) ? CAR(CDR(x)) : CDR(x)) +# define IDENT_ENV(x) (M_IDENT_LEXP(x) ? CDR(CDR(x)) : BOOL_F) +#else +# define IDENTP SYMBOLP +# define M_IDENTP(x) (0) +#endif + + /* markers for various static environment frame types */ + /* FIXME these need to be exported somehow to Scheme */ +#ifdef CAUTIOUS +# define SCM_ENV_FILENAME MAKINUM(1) +# define SCM_ENV_PROCNAME MAKINUM(2) +#endif +#define SCM_ENV_DOC MAKINUM(3) +#define SCM_ENV_ANNOTATION MAKINUM(4) +#define SCM_ENV_CONSTANT MAKINUM(5) +#define SCM_ENV_SYNTAX MAKINUM(6) +#define SCM_ENV_END MAKINUM(7) #define PORTP(x) (TYP7(x)==tc7_port) #define OPPORTP(x) (((0x7f | OPN) & CAR(x))==(tc7_port | OPN)) @@ -354,7 +405,7 @@ extern long tc16_env; #define MAKE_NUMDIGS(v, t) ((((v)+0L)<<16)+(t)) #define SETNUMDIGS(x, v, t) CAR(x) = MAKE_NUMDIGS(v, t) -#define SNAME(x) ((char *)(subr_table[NUMDIGS(x)].name)) +#define SNAME(x) ((char *)(subrs[NUMDIGS(x)].name)) #define SUBRF(x) (((subr *)(SCM2PTR(x)))->cproc) #define DSUBRF(x) (((dsubr *)(SCM2PTR(x)))->dproc) #define CCLO_SUBR(x) (VELTS(x)[0]) @@ -392,26 +443,37 @@ extern long tc16_array; #define SMOBNUM(x) (0x0ff & (CAR(x)>>8)) #define PTOBNUM(x) (0x0ff & (CAR(x)>>8)) #define SCM_PORTNUM(x) ((int)(((unsigned long)CAR(x))>>20)) +#define SCM_PORTNUM_MAX ((int)((0x7fffUL<<20)>>20)) #define SCM_PORTFLAGS(x) (scm_port_table[SCM_PORTNUM(x)].flags) #define SCM_PORTDATA(x) (scm_port_table[SCM_PORTNUM(x)].data) +#define SCM_SETFLAGS(x, flags) (CAR(x) = (CAR(x) & ~0x0f0000L) | (flags)) +/* This is used (only) for closing ports. */ +#define SCM_SET_PTOBNUM(x, typ) (CAR(x)=(typ)|(CAR(x) & ~0x0ffffL)) #define DIGITS '0':case '1':case '2':case '3':case '4':\ case '5':case '6':case '7':case '8':case '9' /* Aggregated types for dispatch in switch statements. */ -#define tcs_cons_imcar 2:case 4:case 6:case 10:\ - case 12:case 14:case 18:case 20:\ - case 22:case 26:case 28:case 30:\ - case 34:case 36:case 38:case 42:\ - case 44:case 46:case 50:case 52:\ - case 54:case 58:case 60:case 62:\ - case 66:case 68:case 70:case 74:\ - case 76:case 78:case 82:case 84:\ - case 86:case 90:case 92:case 94:\ - case 98:case 100:case 102:case 106:\ - case 108:case 110:case 114:case 116:\ - case 118:case 122:case 124:case 126 +#define tcs_cons_inum 2: case 6:case 10:case 14:\ + case 18:case 22:case 26:case 30:\ + case 34:case 38:case 42:case 46:\ + case 50:case 54:case 58:case 62:\ + case 66:case 70:case 74:case 78:\ + case 82:case 86:case 90:case 94:\ + case 98:case 102:case 106:case 110:\ + case 114:case 118:case 122:case 126 +#define tcs_cons_iloc 124 +#define tcs_cons_ispcsym 4:case 12:case 20:case 28:\ + case 36:case 44:case 52:case 60:\ + case 68:case 76:case 84:case 92:\ + case 100:case 108 +#define tcs_cons_chflag 116 /* char *or* flag */ +#define tcs_cons_imcar tcs_cons_inum:\ + case tcs_cons_iloc:\ + case tcs_cons_ispcsym:\ + case tcs_cons_chflag + #define tcs_cons_nimcar 0:case 8:case 16:case 24:\ case 32:case 40:case 48:case 56:\ case 64:case 72:case 80:case 88:\ @@ -438,6 +500,7 @@ extern long tc16_array; #define tc3_cons_imcar 2:case 4:case 6 #define tc3_cons_gloc 1 #define tc3_closure 3 +#define tc3_tc7_types 5:case 7 #define tc7_ssymbol 5 #define tc7_msymbol 7 @@ -477,6 +540,8 @@ extern long tc16_array; #define tc16_call_cc (tc7_specfun | (1L<<8)) #define tc16_cclo (tc7_specfun | (2L<<8)) #define tc16_eval (tc7_specfun | (3L<<8)) +#define tc16_values (tc7_specfun | (4L<<8)) +#define tc16_call_wv (tc7_specfun | (5L<<8)) #define tc16_flo 0x017f #define tc_flo 0x017fL @@ -489,17 +554,21 @@ extern long tc16_array; #define tc16_bigpos 0x027f #define tc16_bigneg 0x037f + /* The first four flags fit in the car of a port cell, remaining + flags only in the port table */ #define OPN (1L<<16) #define RDNG (2L<<16) #define WRTNG (4L<<16) #define CRDY (8L<<16) + #define TRACKED (16L<<16) #define BINARY (32L<<16) #define BUF0 (64L<<16) +#define EXCLUSIVE (128L<<16) /* LSB is used for gc mark */ -extern scm_gra subr_table_gra; -#define subr_table ((subr_info *)(subr_table_gra.elts)) +extern scm_gra subrs_gra; +#define subrs ((subr_info *)(subrs_gra.elts)) /* extern sizet numsmob, numptob; extern smobfuns *smobs; extern ptobfuns *ptobs; @@ -517,30 +586,32 @@ extern port_info *scm_port_table; #define tc16_strport (tc7_port + 2*256L) #define tc16_sfport (tc7_port + 3*256L) extern long tc16_dir; +extern long tc16_clport; extern SCM sys_protects[]; -#define cur_inp sys_protects[0] -#define cur_outp sys_protects[1] -#define cur_errp sys_protects[2] -#define def_inp sys_protects[3] -#define def_outp sys_protects[4] -#define def_errp sys_protects[5] -#define sys_errp sys_protects[6] -#define sys_safep sys_protects[7] -#define listofnull sys_protects[8] -#define undefineds sys_protects[9] -#define nullvect sys_protects[10] -#define nullstr sys_protects[11] -#define progargs sys_protects[12] -#define loadports sys_protects[13] -#define rootcont sys_protects[14] -#define dynwinds sys_protects[15] -#ifdef FLOATS -# define flo0 sys_protects[16] -# define NUM_PROTECTS 17 -#else -# define NUM_PROTECTS 16 -#endif +#define cur_inp sys_protects[0] +#define cur_outp sys_protects[1] +#define cur_errp sys_protects[2] +#define def_inp sys_protects[3] +#define def_outp sys_protects[4] +#define def_errp sys_protects[5] +#define sys_errp sys_protects[6] +#define sys_safep sys_protects[7] +#define listofnull sys_protects[8] +#define undefineds sys_protects[9] +#define nullvect sys_protects[10] +#define nullstr sys_protects[11] +#define progargs sys_protects[12] +#define loadports sys_protects[13] +#define rootcont sys_protects[14] +#define dynwinds sys_protects[15] +#define list_unspecified sys_protects[16] +#define f_evapply sys_protects[17] +#define eval_env sys_protects[18] +#define f_apply_closure sys_protects[19] +#define flo0 sys_protects[20] +#define scm_uprotects sys_protects[21] +#define NUM_PROTECTS 22 /* now for connects between source files */ @@ -565,7 +636,7 @@ extern SCM *loc_loadpath; extern SCM *loc_errobj; extern SCM loadport; extern char *errjmp_bad; -extern int ints_disabled, output_deferred; +extern int ints_disabled, output_deferred, gc_hook_pending, gc_hook_active; extern unsigned long SIG_deferred; extern SCM exitval; extern int cursinit; @@ -593,6 +664,8 @@ extern char s_close_port[]; #define s_port_type (s_close_port+6) extern char s_call_cc[]; #define s_cont (s_call_cc+18) +extern char s_try_create_file[]; +extern char s_badenv[]; /* function prototypes */ @@ -618,24 +691,47 @@ SCM lflush P((SCM port)); void scm_init_gra P((scm_gra *gra, sizet eltsize, sizet len, sizet maxlen, char *what)); int scm_grow_gra P((scm_gra *gra, char *elt)); +void scm_trim_gra P((scm_gra *gra)); void scm_free_gra P((scm_gra *gra)); long newsmob P((smobfuns *smob)); long newptob P((ptobfuns *ptob)); -SCM scm_port_entry P((long ptype, long flags)); +SCM scm_port_entry P((FILE *stream, long ptype, long flags)); +SCM scm_open_ports P((void)); void prinport P((SCM exp, SCM port, char *type)); SCM repl P((void)); +void repl_report P((void)); void growth_mon P((char *obj, long size, char *units, int grewp)); void gc_start P((char *what)); void gc_end P((void)); void gc_mark P((SCM p)); +void scm_gc_hook P((void)); +SCM scm_gc_protect P((SCM obj)); +SCM scm_add_finalizer P((SCM value, SCM finalizer)); +void scm_run_finalizers P((int exiting)); void scm_egc_start P((void)); void scm_egc_end P((void)); void heap_report P((void)); +void gra_report P((void)); void exit_report P((void)); void stack_report P((void)); +SCM scm_stack_trace P((SCM contin)); +SCM scm_scope_trace P((SCM env)); +SCM scm_frame_trace P((SCM contin, SCM nf)); +SCM scm_frame2env P((SCM contin, SCM nf)); +SCM scm_frame_eval P((SCM contin, SCM nf, SCM expr)); void iprin1 P((SCM exp, SCM port, int writing)); void intprint P((long n, int radix, SCM port)); void iprlist P((char *hdr, SCM exp, int tlr, SCM port, int writing)); +SCM scm_env_lookup P((SCM var, SCM stenv)); +SCM scm_env_rlookup P((SCM addr, SCM stenv, char *what)); +SCM scm_env_getprop P((SCM prop, SCM env)); +SCM scm_env_addprop P((SCM prop, SCM val, SCM env)); +long num_frames P((SCM estk, int i)); +SCM *estk_frame P((SCM estk, int i, int nf)); +SCM *cont_frame P((SCM contin, int nf)); +SCM stacktrace1 P((SCM estk, int i)); +void scm_princode P((SCM code, SCM env, SCM port, int writing)); +void scm_princlosure P((SCM proc, SCM port, int writing)); void lputc P((int c, SCM port)); void lputs P((char *s, SCM port)); sizet lfwrite P((char *ptr, sizet size, sizet nitems, SCM port)); @@ -648,6 +744,7 @@ SCM my_time P((void)); SCM your_time P((void)); void init_iprocs P((iproc *subra, int type)); +void final_scm P((int)); void init_sbrk P((void)); int init_buf0 P((FILE *inport)); void scm_init_from_argv P((int argc, char **argv, char *script_arg, @@ -659,6 +756,7 @@ void free_storage P((void)); char *dld_find_executable P((const char* command)); char *scm_find_execpath P((int argc, char **argv, char *script_arg)); void init_scm P((int iverbose, int buf0stdin, long init_heap_size)); +void scm_init_INITS P((void)); SCM scm_init_extensions P((void)); void init_user_scm P((void)); void ignore_signals P((void)); @@ -670,16 +768,17 @@ SCM markcdr P((SCM ptr)); #define mark0 (0) /*SCM mark0 P((SCM ptr)); */ SCM equal0 P((SCM ptr1, SCM ptr2)); sizet free0 P((CELLPTR ptr)); -void scm_warn P((char *str1, char *str2)); -void everr P((SCM exp, SCM env, SCM arg, char *pos, char *s_subr)); +void scm_warn P((char *str1, char *str2, SCM obj)); +void everr P((SCM exp, SCM env, SCM arg, char *pos, char *s_subr, int codep)); void wta P((SCM arg, char *pos, char *s_subr)); +void scm_experr P((SCM arg, char *pos, char *s_subr)); SCM intern P((char *name, sizet len)); SCM sysintern P((const char *name, SCM val)); SCM sym2vcell P((SCM sym)); SCM makstr P((long len)); SCM scm_maksubr P((const char *name, int type, SCM (*fcn)())); SCM make_subr P((const char *name, int type, SCM (*fcn)())); -SCM make_synt P((const char *name, SCM (*macroizer)(), SCM (*fcn)())); +SCM make_synt P((const char *name, long flags, SCM (*fcn)())); SCM make_gsubr P((const char *name, int req, int opt, int rst, SCM (*fcn)())); SCM closure P((SCM code, int nargs)); @@ -688,12 +787,14 @@ SCM force P((SCM x)); SCM makarb P((SCM name)); SCM tryarb P((SCM arb)); SCM relarb P((SCM arb)); -SCM ceval P((SCM x, SCM env)); +SCM ceval P((SCM x, SCM static_env, SCM env)); +SCM scm_wrapcode P((SCM code, SCM env)); +SCM scm_current_env P((void)); SCM prolixity P((SCM arg)); SCM gc_for_newcell P((void)); void gc_for_open_files P((void)); SCM gc P((SCM arg)); -SCM tryload P((SCM filename)); +SCM tryload P((SCM filename, SCM reader)); SCM acons P((SCM w, SCM x, SCM y)); SCM cons2 P((SCM w, SCM x, SCM y)); SCM resizuve P((SCM vect, SCM len)); @@ -725,6 +826,9 @@ SCM exactp P((SCM x)); SCM inexactp P((SCM x)); SCM eqp P((SCM x, SCM y)); SCM lessp P((SCM x, SCM y)); +SCM greaterp P((SCM x, SCM y)); +SCM leqp P((SCM x, SCM y)); +SCM greqp P((SCM x, SCM y)); SCM zerop P((SCM z)); SCM positivep P((SCM x)); SCM negativep P((SCM x)); @@ -811,11 +915,16 @@ SCM map P((SCM proc, SCM arg1, SCM args)); SCM scm_make_cont P((void)); SCM copytree P((SCM obj)); SCM eval P((SCM obj)); +SCM scm_values P((SCM arg1, SCM arg2, SCM rest, char *what)); +SCM scm_eval_values P((SCM x, SCM static_env, SCM env)); SCM identp P((SCM obj)); SCM ident2sym P((SCM id)); SCM ident_eqp P((SCM id1, SCM id2, SCM env)); +int scm_nullenv_p P((SCM env)); SCM env2tree P((SCM env)); SCM renamed_ident P((SCM id, SCM env)); +SCM scm_check_linum P((SCM x, SCM *linum)); +SCM scm_add_linum P((SCM linum, SCM x)); SCM input_portp P((SCM x)); SCM output_portp P((SCM x)); SCM cur_input_port P((void)); @@ -829,6 +938,7 @@ SCM lread P((SCM port)); SCM scm_read_char P((SCM port)); SCM peek_char P((SCM port)); SCM eof_objectp P((SCM x)); +int scm_io_error P((SCM port, char *what)); SCM lwrite P((SCM obj, SCM port)); SCM display P((SCM obj, SCM port)); SCM newline P((SCM port)); @@ -837,11 +947,14 @@ SCM file_position P((SCM port)); SCM file_set_position P((SCM port, SCM pos)); SCM scm_port_line P((SCM port)); SCM scm_port_col P((SCM port)); +void scm_line_msg P((SCM file, SCM linum, SCM port)); +void scm_err_line P((char *what, SCM file, SCM linum, SCM port)); SCM lgetenv P((SCM nam)); SCM prog_args P((void)); SCM makacro P((SCM code)); SCM makmacro P((SCM code)); SCM makmmacro P((SCM code)); +SCM makidmacro P((SCM code)); void poll_routine P((void)); void tick_signal P((void)); void stack_check P((void)); @@ -941,6 +1054,7 @@ long pseudolong P((long x)); #endif int bigcomp P((SCM x, SCM y)); SCM bigequal P((SCM x, SCM y)); +int scm_bigdblcomp P((SCM b, double d)); /* "script.c" functions */ char * scm_cat_path P((char *str1, const char *str2, long n)); @@ -956,9 +1070,9 @@ void scm_ecache_report P((void)); void scm_estk_reset P((sizet size)); void scm_env_cons P((SCM x, SCM y)); void scm_env_cons2 P((SCM w, SCM x, SCM y)); -void scm_env_cons_tmp P((SCM x)); -void scm_env_v2lst P((int argc, SCM *argv)); -void scm_extend_env P((SCM names)); +void scm_env_cons3 P((SCM v, SCM w, SCM x, SCM y)); +void scm_env_v2lst P((long argc, SCM *argv)); +void scm_extend_env P((void)); void scm_egc P((void)); /* Global state for environment cache */ @@ -968,8 +1082,11 @@ extern SCM scm_env, scm_env_tmp; extern SCM scm_egc_roots[]; extern VOLATILE long scm_egc_root_index; extern SCM scm_estk; -extern SCM *scm_estk_v, *scm_estk_ptr; +extern SCM *scm_estk_v, *scm_estk_ptr; extern long scm_estk_size; +#ifndef RECKLESS +extern SCM scm_trace, scm_trace_env; +#endif #ifdef RECKLESS # define ASSERT(_cond, _arg, _pos, _subr) ; @@ -1001,8 +1118,8 @@ extern long scm_estk_size; #define VTALRM_SIGNAL 19 #define PROF_SIGNAL 20 -#define EVAL(x, env) (IMP(x)?(x):ceval((x), (env))) -#define SIDEVAL(x, env) if NIMP(x) ceval((x), (env)) +#define EVAL(x, env, venv) (IMP(x)?(x):ceval((x), (SCM)(env), (SCM)(venv))) +#define SIDEVAL(x, env, venv) if NIMP(x) ceval((x), (SCM)(env), (SCM)(venv)) #define NEWCELL(_into) {if IMP(freelist) _into = gc_for_newcell();\ else {_into = freelist;freelist = CDR(freelist);++cells_allocated;}} |