summaryrefslogtreecommitdiffstats
path: root/scm.h
diff options
context:
space:
mode:
Diffstat (limited to 'scm.h')
-rw-r--r--scm.h198
1 files changed, 142 insertions, 56 deletions
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
}
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-28 07:02:40 +0000