From db04688faa20f3576257c0fe41752ec435beab9a Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:25 -0800 Subject: Import Upstream version 5c3 --- scm.h | 198 +++++++++++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 142 insertions(+), 56 deletions(-) (limited to 'scm.h') diff --git a/scm.h b/scm.h index 55be55a..1af22f1 100644 --- a/scm.h +++ b/scm.h @@ -100,6 +100,11 @@ typedef struct { long inc; } array_dim; +#ifndef INUMS_ONLY +# define NUM_HP_MAX_REQ 4*sizeof(double) + +#endif + #ifdef FLOATS typedef struct {char *string;double (*cproc)P((double));} dblproc; # ifdef SINGLES @@ -137,7 +142,9 @@ typedef struct {SCM type;double *real;} dbl; #define ISYMP(n) ((0x187 & (int)(n))==4) /* IFLAGP tests for ISPCSYM, ISYM and IFLAG */ #define IFLAGP(n) ((0x87 & (int)(n))==4) -#define ISYMNUM(n) ((int)((n)>>9)) +#define ISYMNUM(n) (((int)((n)>>9)) & 0x7f) +#define ISYMVAL(n) ((int)((n)>>16)) +#define ISYMSETVAL(isym, val) ((isym) | ((long)(val) <<16)) #define ISYMCHARS(n) (isymnames[ISYMNUM(n)]) #define MAKSPCSYM(n) (((n)<<9)+((n)<<3)+4L) #define MAKISYM(n) (((n)<<9)+0x74L) @@ -183,17 +190,16 @@ extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; /* each symbol defined here must have a unique number which */ /* corresponds to it's position in isymnames[] in sys.c */ #define IM_APPLY MAKISYM(14) -#define IM_CONT MAKISYM(15) -#define IM_FARLOC_CAR MAKISYM(16) -#define IM_FARLOC_CDR MAKISYM(17) -#define IM_DELAY MAKISYM(18) -#define IM_QUASIQUOTE MAKISYM(19) -#define IM_UNQUOTE MAKISYM(20) -#define IM_UQ_SPLICING MAKISYM(21) -#define IM_ELSE MAKISYM(22) -#define IM_ARROW MAKISYM(23) - -#define NUM_ISYMS 24 +#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 BOOL_F MAKIFLAG(NUM_ISYMS+0) #define BOOL_T MAKIFLAG(NUM_ISYMS+1) @@ -253,7 +259,16 @@ extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; #define CLOSUREP(x) (TYP3(x)==tc3_closure) #define CODE(x) (CAR(x)-tc3_closure) #define SETCODE(x, e) CAR(x) = (e)+tc3_closure -#define ENV(x) CDR(x) +#define ENV(x) ((~7L & CDR(x)) ? (~7L & CDR(x)) : EOL) +#define GCENV ENV +#define ARGC(x) ((6L & CDR(x))>>1) +#ifdef CAUTIOUS +# define SCM_ESTK_FRLEN 3 +#else +# define SCM_ESTK_FRLEN 2 +#endif +#define SCM_ESTK_BASE (2*SCM_ESTK_FRLEN) +extern long tc16_env; #define PORTP(x) (TYP7(x)==tc7_port) #define OPPORTP(x) (((0x7f | OPN) & CAR(x))==(tc7_port | OPN)) @@ -273,7 +288,7 @@ extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; #define SETSTREAM SETCDR #define CRDYP(port) (CAR(port) & CRDY) #define CLRDY(port) {CAR(port) &= CUC;} -#define CGETUN(port) ((int)SRS(CAR(port), 22)) +#define CGETUN(port) ((unsigned char)SRS(CAR(port), 22)) #define CUNGET(c, port) {CAR(port) += ((long)c<<22) + CRDY;} #define tc_socket (tc7_port | OPN) @@ -320,6 +335,7 @@ extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; #define SUBRF(x) (((subr *)(SCM2PTR(x)))->cproc) #define DSUBRF(x) (((dsubr *)(SCM2PTR(x)))->dproc) #define CCLO_SUBR(x) (VELTS(x)[0]) +#define CCLO_LENGTH NUMDIGS #define SYMBOLP(x) (TYP7S(x)==tc7_ssymbol) #define STRINGP(x) (TYP7(x)==tc7_string) @@ -387,7 +403,8 @@ extern long tc16_array; #define tcs_symbols tc7_ssymbol:case tc7_msymbol #define tcs_bignums tc16_bigpos:case tc16_bigneg -#define tc3_cons 0 +#define tc3_cons_nimcar 0 +#define tc3_cons_imcar 2:case 4:case 6 #define tc3_cons_gloc 1 #define tc3_closure 3 @@ -405,7 +422,7 @@ extern long tc16_array; #define tc7_cvect 53 #define tc7_port 55 #define tc7_contin 61 -#define tc7_cclo 63 +#define tc7_specfun 63 /* spare 69 71 77 79 */ #define tc7_subr_0 85 @@ -422,6 +439,11 @@ extern long tc16_array; #define tc7_smob 127 #define tc_free_cell 127 +#define tc_broken_heart (tc_free_cell+0x10000) + +#define tc16_apply (tc7_specfun | (0L<<8)) +#define tc16_call_cc (tc7_specfun | (1L<<8)) +#define tc16_cclo (tc7_specfun | (2L<<8)) #define tc16_flo 0x017f #define tc_flo 0x017fL @@ -458,15 +480,15 @@ extern SCM sys_protects[]; #define def_inp sys_protects[3] #define def_outp sys_protects[4] #define def_errp sys_protects[5] -#define listofnull sys_protects[6] -#define undefineds sys_protects[7] -#define nullvect sys_protects[8] -#define nullstr sys_protects[9] -#define progargs sys_protects[10] -#define transcript sys_protects[11] -#define rootcont sys_protects[12] -#define dynwinds sys_protects[13] -#define stacktrace sys_protects[14] +#define sys_errp sys_protects[6] +#define listofnull sys_protects[7] +#define undefineds sys_protects[8] +#define nullvect sys_protects[9] +#define nullstr sys_protects[10] +#define progargs sys_protects[11] +#define transcript sys_protects[12] +#define rootcont sys_protects[13] +#define dynwinds sys_protects[14] #ifdef FLOATS # define flo0 sys_protects[15] # define NUM_PROTECTS 16 @@ -481,9 +503,9 @@ extern void (**finals)P((void)); extern unsigned char upcase[], downcase[]; extern SCM symhash; extern int symhash_dim; -extern long heap_size; +extern long heap_cells; extern CELLPTR heap_org; -extern SCM freelist; +extern VOLATILE SCM freelist; extern long gc_cells_collected, gc_malloc_collected, gc_ports_collected; extern long gc_syms_collected; extern long cells_allocated, lcells_allocated, mallocated, lmallocated; @@ -492,12 +514,15 @@ extern SCM *loc_loadpath; extern SCM *loc_errobj; extern SCM loadport; extern long linum; -extern int errjmp_bad, ints_disabled, sig_deferred, alrm_deferred; +extern int errjmp_bad, ints_disabled, output_deferred; +extern unsigned long SIG_deferred; extern SCM exitval; extern int cursinit; extern unsigned int poll_count, tick_count; extern int dumped; extern char *execpath; +extern int scm_verbose; +#define verbose (scm_verbose+0) /* strings used in several source files */ @@ -512,15 +537,20 @@ extern char s_ccl[]; #define s_limit (s_ccl+10) 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) /* function prototypes */ -void gc_mark P((SCM p)); -void han_sig P((void)); -void han_alrm P((void)); +extern void (* deferred_proc) P((void)); +void process_signals P((void)); +int handle_it P((int i)); +SCM must_malloc_cell P((long len, char *what)); +void must_realloc_cell P((SCM z, long olen, long len, char *what)); char *must_malloc P((long len, char *what)); char *must_realloc P((char *where, long olen, long len, char *what)); -void must_free P((char *obj)); +void must_free P((char *obj, sizet len)); +void scm_protect_temp P((SCM *ptr)); long ilength P((SCM sx)); SCM hash P((SCM obj, SCM n)); SCM hashv P((SCM obj, SCM n)); @@ -535,9 +565,12 @@ long newsmob P((smobfuns *smob)); long newptob P((ptobfuns *ptob)); void prinport P((SCM exp, SCM port, char *type)); void repl P((void)); -void growth_mon P((char *obj, long size, char *units)); +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_egc_start P((void)); +void scm_egc_end P((void)); void heap_report P((void)); void exit_report P((void)); void stack_report P((void)); @@ -570,11 +603,11 @@ void warn P((char *str1, char *str2)); void everr P((SCM exp, SCM env, SCM arg, char *pos, char *s_subr)); void wta P((SCM arg, char *pos, char *s_subr)); SCM intern P((char *name, sizet len)); -SCM sysintern P((char *name, SCM val)); +SCM sysintern P((const char *name, SCM val)); SCM sym2vcell P((SCM sym)); SCM makstr P((long len)); -SCM make_subr P((char *name, int type, SCM (*fcn)())); -SCM closure P((SCM code, SCM env)); +SCM make_subr P((const char *name, int type, SCM (*fcn)())); +SCM closure P((SCM code, int nargs)); SCM makprom P((SCM code)); SCM force P((SCM x)); SCM makarb P((SCM name)); @@ -583,7 +616,7 @@ SCM relarb P((SCM arb)); SCM ceval P((SCM x, SCM env)); SCM prolixity P((SCM arg)); SCM gc_for_newcell P((void)); -SCM gc P((void)); +SCM gc P((SCM arg)); SCM tryload P((SCM filename)); SCM acons P((SCM w, SCM x, SCM y)); SCM cons2 P((SCM w, SCM x, SCM y)); @@ -652,6 +685,7 @@ int rafill P((SCM ra, SCM fill, SCM ignore)); SCM uve_fill P((SCM uve, SCM fill)); SCM array_fill P((SCM ra, SCM fill)); SCM array_prot P((SCM ra)); +SCM array_rank P((SCM ra)); int bigprint P((SCM exp, SCM port, int writing)); int floprint P((SCM sexp, SCM port, int writing)); SCM istr2int P((char *str, long len, long radix)); @@ -698,6 +732,7 @@ SCM scm_make_cont P((void)); SCM copytree P((SCM obj)); SCM eval P((SCM obj)); SCM identp P((SCM obj)); +SCM ident2sym P((SCM id)); SCM ident_eqp P((SCM id1, SCM id2, SCM env)); SCM renamed_ident P((SCM id, SCM env)); SCM input_portp P((SCM x)); @@ -705,6 +740,7 @@ SCM output_portp P((SCM x)); SCM cur_input_port P((void)); SCM cur_output_port P((void)); SCM i_setbuf0 P((SCM port)); +SCM try_open_file P((SCM filename, SCM modes)); SCM open_file P((SCM filename, SCM modes)); SCM open_pipe P((SCM pipestr, SCM modes)); SCM close_port P((SCM port)); @@ -737,9 +773,13 @@ SCM ura_read P((SCM v, SCM port)); SCM ura_write P((SCM v, SCM port)); SCM aset P((SCM v, SCM obj, SCM args)); SCM aref P((SCM v, SCM args)); +SCM scm_array_ref P((SCM args)); SCM cvref P((SCM v, sizet pos, SCM last)); SCM quit P((SCM n)); -void ints_viol P((int sense)); +#ifdef CAREFUL_INTS +void ints_viol P((ints_infot *info, int sense)); +void ints_warn P((char *s1, char* s2, char *fname, int linum)); +#endif void add_final P((void (*final)(void))); SCM makcclo P((SCM proc, long len)); SCM make_uve P((long k, SCM prot)); @@ -751,7 +791,25 @@ SCM scm_eval_string P((SCM str)); SCM scm_load_string P((SCM str)); void scm_print_stack P((SCM stk)); char * dld_find_executable P((const char* command)); +char * scm_find_executable P((void)); +SCM scm_find_impl P((SCM execpath)); SCM scm_unexec P((const SCM pathname)); +SCM scm_log_aref P((SCM args)); +SCM scm_log_aset P((SCM ra, SCM obj, SCM args)); +SCM scm_logbitp P((SCM index, SCM j1)); +SCM scm_logtest P((SCM x, SCM y)); +SCM scm_logxor P((SCM x, SCM y)); +SCM scm_logand P((SCM x, SCM y)); +SCM scm_logior P((SCM x, SCM y)); +SCM scm_lognot P((SCM n)); +SCM scm_intexpt P((SCM z1, SCM z2)); +SCM scm_ash P((SCM n, SCM cnt)); +SCM scm_bitfield P((SCM n, SCM start, SCM end)); +SCM scm_logcount P((SCM n)); +SCM scm_intlength P((SCM n)); +SCM scm_copybit P((SCM index, SCM j1, SCM bit)); +SCM scm_bitif P((SCM mask, SCM n0, SCM n1)); +SCM scm_copybitfield P((SCM to, SCM start, SCM rest)); /* Defined in "rope.c" */ SCM long2num P((long n)); @@ -781,7 +839,7 @@ double lasinh P((double x)); double lacosh P((double x)); double latanh P((double x)); double ltrunc P((double x)); -double round P((double x)); +double scm_round P((double x)); double floident P((double x)); #endif @@ -810,6 +868,25 @@ int script_count_argv P((char **argv)); char * scm_find_impl_file P((char *exec_path, const char *generic_name, const char *initname, const char *sep)); +/* environment cache functions */ +void scm_ecache_report P((void)); +void scm_estk_reset P((void)); +void scm_estk_grow P((sizet inc)); +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_extend_env P((SCM names)); +void scm_egc P((void)); + +/* Global state for environment cache */ +extern CELLPTR scm_ecache; +extern VOLATILE long scm_ecache_index, scm_ecache_len; +extern SCM scm_env, scm_env_tmp; +extern SCM scm_egc_roots[]; +extern long scm_egc_root_index; +extern SCM scm_estk; +extern SCM *scm_estk_v, *scm_estk_ptr; + #ifdef RECKLESS # define ASSERT(_cond, _arg, _pos, _subr) ; # define ASRTGO(_cond, _label) ; @@ -818,30 +895,39 @@ char * scm_find_impl_file P((char *exec_path, const char *generic_name, # define ASRTGO(_cond, _label) if(!(_cond)) goto _label; #endif -#define ARGn 0 -#define ARG1 1 -#define ARG2 2 -#define ARG3 3 -#define ARG4 4 -#define ARG5 5 +#define ARGn 0 +#define ARG1 1 +#define ARG2 2 +#define ARG3 3 +#define ARG4 4 +#define ARG5 5 /* following must match entry indexes in errmsgs[] */ -#define WNA 6 -#define OVFLOW 7 -#define OUTOFRANGE 8 -#define NALLOC 9 -#define EXIT 10 -#define HUP_SIGNAL 11 -#define INT_SIGNAL 12 -#define FPE_SIGNAL 13 -#define BUS_SIGNAL 14 -#define SEGV_SIGNAL 15 -#define ALRM_SIGNAL 16 +#define WNA 6 +#define OVFLOW 7 +#define OUTOFRANGE 8 +#define NALLOC 9 +#define THRASH 10 +#define EXIT 11 +#define HUP_SIGNAL 12 +#define INT_SIGNAL 13 +#define FPE_SIGNAL 14 +#define BUS_SIGNAL 15 +#define SEGV_SIGNAL 16 +#define ALRM_SIGNAL 17 +#define PROF_SIGNAL 18 #define EVAL(x, env) (IMP(x)?(x):ceval((x), (env))) #define SIDEVAL(x, env) if NIMP(x) ceval((x), (env)) #define NEWCELL(_into) {if IMP(freelist) _into = gc_for_newcell();\ else {_into = freelist;freelist = CDR(freelist);++cells_allocated;}} +/* +#define NEWCELL(_into) {DEFER_INTS;if IMP(freelist) _into = gc_for_newcell();\ + else {_into = freelist;freelist = CDR(freelist);++cells_allocated;}\ + ALLOW_INTS;} +*/ + +int run_scm P((int argc, char **argv, int iverbose, int buf0stdin, char *initpath)); #ifdef __cplusplus } -- cgit v1.2.3