diff --git a/lang/siod/files/patch-lib b/lang/siod/files/patch-lib index 32a173b5e58a..cb345c2b947a 100644 --- a/lang/siod/files/patch-lib +++ b/lang/siod/files/patch-lib @@ -1,2911 +1,2974 @@ --- siod.h 2014-03-25 04:10:42.000000000 -0400 -+++ siod.h 2021-02-22 11:41:33.795507000 -0500 ++++ siod.h 2024-11-26 09:55:05.742339000 -0500 @@ -9,9 +9,11 @@ */ +#ifndef _SIOD_H +#define _SIOD_H + #if defined(__cplusplus) extern "C" { #endif - struct obj {short gc_mark; -@@ -20,5 +22,5 @@ +@@ -20,26 +22,26 @@ struct obj * cdr;} cons; struct {double data;} flonum; - struct {char *pname; + struct {const char *pname; struct obj * vcell;} symbol; - struct {char *name; -@@ -41,5 +43,5 @@ - struct {char *name; +- struct {char *name; ++ struct {const char *name; + struct obj * (*f)(void);} subr0; +- struct {char *name; ++ struct {const char *name; + struct obj * (*f)(struct obj *);} subr1; +- struct {char *name; ++ struct {const char *name; + struct obj * (*f)(struct obj *, struct obj *);} subr2; +- struct {char *name; ++ struct {const char *name; + struct obj * (*f)(struct obj *, struct obj *, struct obj *); + } subr3; +- struct {char *name; ++ struct {const char *name; + struct obj * (*f)(struct obj *, struct obj *, struct obj *, + struct obj *); + } subr4; +- struct {char *name; ++ struct {const char *name; + struct obj * (*f)(struct obj *, struct obj *, struct obj *, + struct obj *,struct obj *); + } subr5; +- struct {char *name; ++ struct {const char *name; struct obj * (*f)(struct obj **, struct obj **);} subrm; - struct {char *name; + struct {const char *name; struct obj * (*f)(void *,...);} subr; struct {struct obj *env; -@@ -151,5 +153,5 @@ +@@ -125,5 +127,20 @@ + + typedef struct obj* LISP; +-typedef LISP (*SUBR_FUNC)(void); ++typedef LISP (*SUBR_FUNC0)(void); ++typedef LISP (*SUBR_FUNC1)(LISP); ++typedef LISP (*SUBR_FUNC2)(LISP, LISP); ++typedef LISP (*SUBR_FUNC3)(LISP, LISP, LISP); ++typedef LISP (*SUBR_FUNC4)(LISP, LISP, LISP, LISP); ++typedef LISP (*SUBR_FUNC5)(LISP, LISP, LISP, LISP, LISP); ++typedef LISP (*SUBR_FUNCm)(LISP *, LISP *); ++typedef union { ++ SUBR_FUNC0 subr0; ++ SUBR_FUNC1 subr1; ++ SUBR_FUNC2 subr2; ++ SUBR_FUNC3 subr3; ++ SUBR_FUNC4 subr4; ++ SUBR_FUNC5 subr5; ++ SUBR_FUNCm subrm; ++} SUBR_FUNC; + + #define CONSP(x) TYPEP(x,tc_cons) +@@ -151,5 +168,5 @@ struct gen_printio {int (*putc_fcn)(int,void *); - int (*puts_fcn)(char *,void *); + int (*puts_fcn)(const char *, void *); void *cb_argument;}; -@@ -160,10 +162,10 @@ +@@ -160,10 +177,10 @@ struct repl_hooks -{void (*repl_puts)(char *); +{void (*repl_puts)(const char *); LISP (*repl_read)(void); LISP (*repl_eval)(LISP); void (*repl_print)(LISP);}; -void __stdcall process_cla(int argc,char **argv,int warnflag); +void __stdcall process_cla(int argc, const char **argv, int warnflag); void __stdcall print_welcome(void); void __stdcall print_hs_1(void); -@@ -172,6 +174,6 @@ +@@ -172,6 +189,6 @@ LISP get_eof_val(void); long repl_driver(long want_sigint,long want_init,struct repl_hooks *); -void set_stdout_hooks(void (*puts_f)(char *)); -void set_repl_hooks(void (*puts_f)(char *), +void set_stdout_hooks(void (*puts_f)(const char *)); +void set_repl_hooks(void (*puts_f)(const char *), LISP (*read_f)(void), LISP (*eval_f)(LISP), -@@ -180,7 +182,8 @@ +@@ -180,7 +197,8 @@ LISP err(const char *message, LISP x); LISP errswitch(void); -char *get_c_string(LISP x); -char *get_c_string_dim(LISP x,long *); -char *try_get_c_string(LISP x); +void *get_string_data(LISP x); +const char *get_c_string(LISP x); +const char *get_c_string_dim(LISP x, long *); +const char *try_get_c_string(LISP x); long get_c_long(LISP x); double get_c_double(LISP x); -@@ -204,30 +207,30 @@ +@@ -204,30 +222,30 @@ LISP eq(LISP x,LISP y); LISP eql(LISP x,LISP y); -LISP symcons(char *pname,LISP vcell); +LISP symcons(const char *pname, LISP vcell); LISP symbolp(LISP x); LISP symbol_boundp(LISP x,LISP env); LISP symbol_value(LISP x,LISP env); -LISP cintern(char *name); -LISP rintern(char *name); -LISP subrcons(long type, char *name, SUBR_FUNC f); +LISP cintern(const char *name); +LISP rintern(const char *name); +LISP subrcons(long type, const char *name, SUBR_FUNC f); LISP closure(LISP env,LISP code); void gc_protect(LISP *location); void gc_protect_n(LISP *location,long n); -void gc_protect_sym(LISP *location,char *st); +void gc_protect_sym(LISP *location, const char *st); void __stdcall init_storage(void); void __stdcall init_slibu(void); -void init_subr(char *name, long type, SUBR_FUNC fcn); -void init_subr_0(char *name, LISP (*fcn)(void)); -void init_subr_1(char *name, LISP (*fcn)(LISP)); -void init_subr_2(char *name, LISP (*fcn)(LISP,LISP)); -void init_subr_2n(char *name, LISP (*fcn)(LISP,LISP)); -void init_subr_3(char *name, LISP (*fcn)(LISP,LISP,LISP)); -void init_subr_4(char *name, LISP (*fcn)(LISP,LISP,LISP,LISP)); -void init_subr_5(char *name, LISP (*fcn)(LISP,LISP,LISP,LISP,LISP)); -void init_lsubr(char *name, LISP (*fcn)(LISP)); -void init_fsubr(char *name, LISP (*fcn)(LISP,LISP)); -void init_msubr(char *name, LISP (*fcn)(LISP *,LISP *)); +void init_subr(const char *name, long type, SUBR_FUNC fcn); +void init_subr_0(const char *name, LISP (*fcn)(void)); +void init_subr_1(const char *name, LISP (*fcn)(LISP)); +void init_subr_2(const char *name, LISP (*fcn)(LISP, LISP)); +void init_subr_2n(const char *name, LISP (*fcn)(LISP, LISP)); +void init_subr_3(const char *name, LISP (*fcn)(LISP, LISP, LISP)); +void init_subr_4(const char *name, LISP (*fcn)(LISP, LISP, LISP, LISP)); +void init_subr_5(const char *name, LISP (*fcn)(LISP, LISP, LISP, LISP, LISP)); +void init_lsubr(const char *name, LISP (*fcn)(LISP)); +void init_fsubr(const char *name, LISP (*fcn)(LISP, LISP)); +void init_msubr(const char *name, LISP (*fcn)(LISP *, LISP *)); LISP assq(LISP x,LISP alist); -@@ -256,5 +259,5 @@ +@@ -256,5 +274,5 @@ LISP (*fcn2)(char *,long, int *)); LISP apropos(LISP); -LISP vload(char *fname,long cflag,long rflag); +LISP vload(const char *fname, long cflag, long rflag); LISP load(LISP fname,LISP cflag,LISP rflag); LISP require(LISP fname); -@@ -293,5 +296,6 @@ +@@ -293,5 +311,6 @@ void __stdcall init_trace(void); long __stdcall repl_c_string(char *,long want_sigint,long want_init,long want_print); -char * __stdcall siod_version(void); +long __stdcall repl_c_string01(const char *, long want_sigint, long want_init, long want_print); +const char * __stdcall siod_version(void); LISP nreverse(LISP); LISP number2string(LISP,LISP,LISP,LISP); -@@ -316,8 +320,8 @@ +@@ -316,8 +335,8 @@ LISP lapply(LISP fcn,LISP args); LISP mallocl(void *lplace,long size); -void gput_st(struct gen_printio *,char *); -void put_st(char *st); +void gput_st(struct gen_printio *, const char *); +void put_st(const char *st); LISP listn(long n, ...); -char *must_malloc(unsigned long size); +void *must_malloc(unsigned long size); LISP lstrbreakup(LISP str,LISP lmarker); LISP lstrunbreakup(LISP elems,LISP lmarker); -@@ -337,6 +341,4 @@ +@@ -337,6 +356,4 @@ size_t safe_strlen(const char *s,size_t size); LISP memq(LISP x,LISP il); -LISP lstrbreakup(LISP,LISP); -LISP lstrbreakup(LISP,LISP); LISP nth(LISP,LISP); LISP butlast(LISP); -@@ -356,5 +358,5 @@ +@@ -356,5 +373,5 @@ -LISP symalist(char *item,...); +LISP symalist(const char *item, ...); LISP encode_st_mode(LISP l); -@@ -363,5 +365,5 @@ +@@ -363,5 +380,5 @@ int __stdcall siod_main(int argc,char **argv, char **env); void __stdcall siod_shuffle_args(int *pargc,char ***pargv); -void __stdcall siod_init(int argc,char **argv); +void __stdcall siod_init(int argc, const char **argv); #if defined(WIN32) && defined(_WINDOWS_) -@@ -374,3 +376,3 @@ +@@ -374,3 +391,3 @@ #endif - +#endif --- siodp.h 2014-03-25 04:10:42.000000000 -0400 -+++ siodp.h 2021-02-22 11:50:39.297014000 -0500 ++++ siodp.h 2024-11-26 10:06:20.562343000 -0500 @@ -12,4 +12,6 @@ */ +#ifndef _SIODP_H +#define _SIODP_H extern char *tkbuffer; @@ -18,5 +20,5 @@ extern long siod_verbose_level; -extern char *siod_lib; +extern const char *siod_lib; extern long nointerrupt; extern long interrupt_differed; @@ -72,5 +74,5 @@ #define INTERRUPT_CHECK() if (interrupt_differed) handle_interrupt_differed() #else -#define INTERRUPT_CHECK() +#define INTERRUPT_CHECK() {} /* Avoids gcc's -Wempty-body after else */ #endif #endif @@ -81,7 +83,7 @@ #define STACK_CHECK(_ptr) \ - if (((char *) (_ptr)) < stack_limit_ptr) err_stack((char *) _ptr); + if (((char *) (_ptr)) < stack_limit_ptr) err_stack(_ptr); -void err_stack(char *); +void err_stack(LISP *); #if defined(VMS) && defined(VAX) @@ -95,9 +97,8 @@ void err_ctrl_c(void); double myruntime(void); -void fput_st(FILE *f,char *st); -void put_st(char *st); -void grepl_puts(char *,void (*)(char *)); +void fput_st(FILE *f, const char *st); +void grepl_puts(const char *, void (*)(const char *)); void gc_fatal_error(void); -LISP gen_intern(char *name,long copyp); +LISP gen_intern(const char *name, long copyp); void scan_registers(void); void init_storage_1(void); @@ -119,5 +120,4 @@ LISP extend_env(LISP actuals,LISP formals,LISP env); LISP envlookup(LISP var,LISP env); -LISP setvar(LISP var,LISP val,LISP env); LISP leval_setq(LISP args,LISP env); LISP syntax_define(LISP args); @@ -136,5 +136,5 @@ LISP leval_quote(LISP args,LISP env); LISP leval_tenv(LISP args,LISP env); -int flush_ws(struct gen_readio *f,char *eoferr); +int flush_ws(struct gen_readio *f, const char *eoferr); int f_getc(FILE *f); void f_ungetc(int c, FILE *f); -@@ -164,6 +164,6 @@ +@@ -155,6 +155,4 @@ + long array_sxhash(LISP,long); + +-int rfs_getc(unsigned char **p); +-void rfs_ungetc(unsigned char c,unsigned char **p); + void err1_aset1(LISP i); + void err2_aset1(LISP v); +@@ -164,6 +162,6 @@ void file_gc_free(LISP ptr); void file_prin1(LISP ptr,struct gen_printio *f); -LISP fopen_c(char *name,char *how); -LISP fopen_cg(FILE *(*)(const char *,const char *),char *,char *); +LISP fopen_c(const char *name, const char *how); +LISP fopen_cg(FILE *(*)(const char *, const char *), const char *, const char *); LISP fopen_l(LISP name,LISP how); LISP fclose_l(LISP p); -@@ -206,3 +206,3 @@ +@@ -206,3 +204,3 @@ #define VLOAD_OFFSET_HACK_CHAR '|' - +#endif --- slib.c 2014-03-25 04:40:18.000000000 -0400 -+++ slib.c 2021-02-22 11:46:46.903090000 -0500 ++++ slib.c 2024-11-26 09:53:15.451978000 -0500 @@ -77,8 +77,12 @@ #include +#if defined(HAVE_SYS_PARAM_H) +#include +#endif + #include "siod.h" #include "siodp.h" -#ifdef linux +#if defined(linux) || defined(BSD) #define sprintf_s snprintf #endif @@ -90,57 +94,57 @@ NIL);} -char * __stdcall siod_version(void) +const char * __stdcall siod_version(void) {return("3.6.2 12-MAY-07");} -long nheaps = 2; -LISP *heaps; +static long nheaps = 2; +static LISP *heaps; LISP heap,heap_end,heap_org; -long heap_size = 5000; -long old_heap_used; -long gc_status_flag = 1; -char *init_file = (char *) NULL; +static long heap_size = 5000; +static long old_heap_used; +static long gc_status_flag = 1; +static const char *init_file = NULL; char *tkbuffer = NULL; -long gc_kind_copying = 0; -long gc_cells_allocated = 0; -double gc_time_taken; -LISP *stack_start_ptr = NULL; -LISP freelist; -jmp_buf errjmp; +static long gc_kind_copying = 0; +static long gc_cells_allocated = 0; +static double gc_time_taken; +static LISP *stack_start_ptr = NULL; +static LISP freelist; +static jmp_buf errjmp; long errjmp_ok = 0; long nointerrupt = 1; long interrupt_differed = 0; -LISP oblistvar = NIL; +static LISP oblistvar = NIL; LISP sym_t = NIL; -LISP eof_val = NIL; -LISP sym_errobj = NIL; -LISP sym_catchall = NIL; -LISP sym_progn = NIL; -LISP sym_lambda = NIL; -LISP sym_quote = NIL; -LISP sym_dot = NIL; -LISP sym_after_gc = NIL; -LISP sym_eval_history_ptr = NIL; +static LISP eof_val = NIL; +static LISP sym_errobj = NIL; +static LISP sym_catchall = NIL; +static LISP sym_progn = NIL; +static LISP sym_lambda = NIL; +static LISP sym_quote = NIL; +static LISP sym_dot = NIL; +static LISP sym_after_gc = NIL; +static LISP sym_eval_history_ptr = NIL; LISP unbound_marker = NIL; -LISP *obarray; -long obarray_dim = 100; +static LISP *obarray; +static long obarray_dim = 100; struct catch_frame *catch_framep = (struct catch_frame *) NULL; -void (*repl_puts)(char *) = NULL; -LISP (*repl_read)(void) = NULL; -LISP (*repl_eval)(LISP) = NULL; -void (*repl_print)(LISP) = NULL; -void (*stdout_puts)(char *) = NULL; -LISP *inums; -long inums_dim = 256; -struct user_type_hooks *user_types = NULL; -long user_tc_next = tc_user_min; -struct gc_protected *protected_registers = NULL; -jmp_buf save_regs_gc_mark; -double gc_rt; -long gc_cells_collected; -char *user_ch_readm = ""; -char *user_te_readm = ""; -LISP (*user_readm)(int, struct gen_readio *) = NULL; -LISP (*user_readt)(char *,long, int *) = NULL; -void (*fatal_exit_hook)(void) = NULL; +static void (*repl_puts)(const char *) = NULL; +static LISP (*repl_read)(void) = NULL; +static LISP (*repl_eval)(LISP) = NULL; +static void (*repl_print)(LISP) = NULL; +static void (*stdout_puts)(const char *) = NULL; +static LISP *inums; +static long inums_dim = 256; +static struct user_type_hooks *user_types = NULL; +static long user_tc_next = tc_user_min; +static struct gc_protected *protected_registers = NULL; +static jmp_buf save_regs_gc_mark; +static double gc_rt; +static long gc_cells_collected; +static const char *user_ch_readm = ""; +static const char *user_te_readm = ""; +static LISP (*user_readm)(int, struct gen_readio *) = NULL; +static LISP (*user_readt)(char *, long, int *) = NULL; +static void (*fatal_exit_hook)(void) = NULL; #ifdef THINK_C int ipoll_counter = 0; @@ -148,5 +152,5 @@ char *stack_limit_ptr = NULL; -long stack_size = -+static long stack_size = ++static long stack_size = #ifdef THINK_C 10000; @@ -159,5 +163,5 @@ #ifndef SIOD_LIB_DEFAULT #ifdef unix -#define SIOD_LIB_DEFAULT "/usr/local/lib/siod" +#define SIOD_LIB_DEFAULT "/opt/lib/siod" #endif #ifdef vms @@ -170,10 +174,10 @@ #endif -char *siod_lib = SIOD_LIB_DEFAULT; +const char *siod_lib = SIOD_LIB_DEFAULT; -void __stdcall process_cla(int argc,char **argv,int warnflag) +void __stdcall process_cla(int argc, const char **argv, int warnflag) {int k; char *ptr; - static siod_lib_set = 0; + static int siod_lib_set = 0; char msgbuff[256]; #if !defined(vms) @@ -288,5 +292,5 @@ return(x);} -void handle_sigfpe(int sig SIG_restargs) +void handle_sigfpe(int sig SIG_restargs __unused) { #ifdef WIN32 @@ -296,5 +300,5 @@ err("floating point exception",NIL);} -void handle_sigint(int sig SIG_restargs) +void handle_sigint(int sig SIG_restargs __unused) {signal(SIGINT,handle_sigint); #if defined(WIN32) @@ -364,12 +368,12 @@ return(rv);} -static void ignore_puts(char *st) +static void ignore_puts(const char *st __unused) {} -static void noprompt_puts(char *st) +static void noprompt_puts(const char *st) {if (strcmp(st,"> ") != 0) put_st(st);} -static char *repl_c_string_arg = NULL; +static const char *repl_c_string_arg = NULL; static char *repl_c_string_out = NULL; static long repl_c_string_flag = 0; @@ -386,5 +390,5 @@ return(read_from_string(s));} -static void ignore_print(LISP x) +static void ignore_print(LISP x __unused) {repl_c_string_flag = 1;} @@ -397,5 +401,5 @@ char *end;}; -static int rcsp_puts(char *from,void *cb) +static int rcsp_puts(const char *from, void *cb) {long fromlen,intolen,cplen; struct rcsp_puts *p = (struct rcsp_puts *) cb; @@ -421,16 +425,11 @@ repl_c_string_flag = 1;} -long __stdcall repl_c_string(char *str, - long want_sigint,long want_init,long want_print) +long __stdcall repl_c_string01(const char *str, + long want_sigint, long want_init, long want_print) {struct repl_hooks h; long retval; h.repl_read = repl_c_string_read; h.repl_eval = NULL; - if (want_print > 1) - {h.repl_puts = ignore_puts; - h.repl_print = repl_c_string_print; - repl_c_string_print_len = want_print; - repl_c_string_out = str;} - else if (want_print) + if (want_print) {h.repl_puts = noprompt_puts; h.repl_print = not_ignore_print; @@ -452,4 +451,25 @@ return(2);} +long __stdcall repl_c_string(char *str, + long want_sigint, long want_init, long want_print) +{struct repl_hooks h; + long retval; + h.repl_read = repl_c_string_read; + h.repl_eval = NULL; + + h.repl_puts = ignore_puts; + h.repl_print = repl_c_string_print; + repl_c_string_print_len = want_print; + repl_c_string_out = str; + repl_c_string_arg = str; + repl_c_string_flag = 0; + retval = repl_driver(want_sigint, want_init, &h); + if (retval != 0) + return(retval); + else if (repl_c_string_flag == 1) + return(0); + else + return(2);} + #ifdef unix #include @@ -511,11 +531,11 @@ #endif -#if defined(SUN5) || defined(linux) +#if defined(SUN5) || defined(linux) || defined(BSD) -#if defined(linux) +#if defined(linux) || defined(BSD) #include #endif -double myrealtime(void) +static double myrealtime(void) {struct timeval x; if (gettimeofday(&x,NULL)) @@ -532,5 +552,5 @@ #endif -#if !defined(__osf__) & !defined(VMS) & !defined(SUN5) & !defined(WIN32) &!defined(linux) +#if !defined(__osf__) & !defined(VMS) & !defined(SUN5) & !defined(WIN32) &!defined(linux) && !defined(BSD) double myrealtime(void) {time_t x; @@ -539,5 +559,5 @@ #endif -void set_repl_hooks(void (*puts_f)(char *), +void set_repl_hooks(void (*puts_f)(const char *), LISP (*read_f)(void), LISP (*eval_f)(LISP), @@ -548,13 +568,13 @@ repl_print = print_f;} -void set_stdout_hooks(void (*puts_f)(char *)) +void set_stdout_hooks(void (*puts_f)(const char *)) { stdout_puts = puts_f; } -void gput_st(struct gen_printio *f,char *st) +void gput_st(struct gen_printio *f, const char *st) {PUTS_FCN(st,f);} -void fput_st(FILE *f,char *st) +void fput_st(FILE *f, const char *st) {long flag; flag = no_interrupt(1); @@ -562,9 +582,9 @@ no_interrupt(flag);} -int fputs_fcn(char *st,void *cb) +static int fputs_fcn(const char *st, void *cb) {fput_st((FILE *)cb,st); return(1);} -void put_st(char *st) +void put_st(const char *st) { if (stdout_puts == NULL) @@ -574,10 +594,10 @@ } -void grepl_puts(char *st,void (*repl_puts)(char *)) -{if (repl_puts == NULL) +void grepl_puts(const char *st, void (*_repl_puts)(const char *)) +{if (_repl_puts == NULL) {put_st(st); fflush(stdout);} else - (*repl_puts)(st);} + (_repl_puts)(st);} long repl(struct repl_hooks *h) @@ -691,7 +711,7 @@ {return(err("BUG. Reached impossible case",NIL));} -void err_stack(char *ptr) +void err_stack(LISP *l) /* The user could be given an option to continue here */ -{err("the currently assigned stack limit has been exceded",NIL);} +{err("the currently assigned stack limit has been exceded", *l);} LISP stack_limit(LISP amount,LISP silent) @@ -707,5 +727,5 @@ return(flocons(stack_size));} -char *try_get_c_string(LISP x) +const char *try_get_c_string(LISP x) {if TYPEP(x,tc_symbol) return(PNAME(x)); @@ -715,5 +735,13 @@ return(NULL);} -char *get_c_string(LISP x) +void *get_string_data(LISP x) +{switch (TYPE(x)) + {case tc_string: + case tc_byte_array: + return(x->storage_as.string.data);} + err("Neither a string nor a byte array", x); + return(NULL);} + +const char *get_c_string(LISP x) {if TYPEP(x,tc_symbol) return(PNAME(x)); @@ -724,5 +752,5 @@ return(NULL);} -char *get_c_string_dim(LISP x,long *len) +const char *get_c_string_dim(LISP x, long *len) {switch(TYPE(x)) {case tc_symbol: @@ -836,5 +864,5 @@ return(flocons(FLONM(x)/FLONM(y)));}} -LISP lllabs(LISP x) +static LISP lllabs(LISP x) {double v; if NFLONUMP(x) err("wta to abs",x); @@ -845,5 +873,5 @@ return(x);} -LISP lsqrt(LISP x) +static LISP lsqrt(LISP x) {if NFLONUMP(x) err("wta to sqrt",x); return(flocons(sqrt(FLONM(x))));} @@ -861,5 +889,5 @@ return(NIL);} -LISP greaterEp(LISP x,LISP y) +static LISP greaterEp(LISP x, LISP y) {if NFLONUMP(x) err("wta(1st) to greaterp",x); if NFLONUMP(y) err("wta(2nd) to greaterp",y); @@ -867,5 +895,5 @@ return(NIL);} -LISP lessEp(LISP x,LISP y) +static LISP lessEp(LISP x, LISP y) {if NFLONUMP(x) err("wta(1st) to lessp",x); if NFLONUMP(y) err("wta(2nd) to lessp",y); @@ -873,5 +901,5 @@ return(NIL);} -LISP lmax(LISP x,LISP y) +static LISP lmax(LISP x, LISP y) {if NULLP(y) return(x); if NFLONUMP(x) err("wta(1st) to max",x); @@ -879,5 +907,5 @@ return((FLONM(x) > FLONM(y)) ? x : y);} -LISP lmin(LISP x,LISP y) +static LISP lmin(LISP x, LISP y) {if NULLP(y) return(x); if NFLONUMP(x) err("wta(1st) to min",x); @@ -889,11 +917,11 @@ LISP eql(LISP x,LISP y) -{if EQ(x,y) return(sym_t); else - if NFLONUMP(x) return(NIL); else - if NFLONUMP(y) return(NIL); else +{if EQ(x,y) return(sym_t); + if NFLONUMP(x) return(NIL); + if NFLONUMP(y) return(NIL); if (FLONM(x) == FLONM(y)) return(sym_t); return(NIL);} -LISP symcons(char *pname,LISP vcell) +LISP symcons(const char *pname, LISP vcell) {LISP z; NEWCELL(z,tc_symbol); @@ -905,5 +933,5 @@ {if SYMBOLP(x) return(sym_t); else return(NIL);} -LISP err_ubv(LISP v) +static LISP err_ubv(LISP v) {return(err("unbound variable",v));} @@ -926,13 +954,13 @@ -char *must_malloc(unsigned long size) -{char *tmp; - tmp = (char *) malloc((size) ? size : 1); - if (tmp == (char *)NULL) err("failed to allocate storage from system",NIL); +void *must_malloc(unsigned long size) +{void *tmp; + tmp = malloc((size) ? size : 1); + if (tmp == NULL) err("failed to allocate storage from system", NIL); return(tmp);} -LISP gen_intern(char *name,long copyp) +LISP gen_intern(const char *name, long copyp) {LISP l,sym,sl; - char *cname; + const char *cname; long hash=0,n,c,flag; flag = no_interrupt(1); @@ -950,6 +978,6 @@ return(CAR(l));} if (copyp == 1) - {cname = (char *) must_malloc(strlen(name)+1); - strcpy(cname,name);} + {char *_cname = must_malloc(strlen(name)+1); + strcpy(_cname, name); cname = _cname;} else cname = name; @@ -960,8 +988,8 @@ return(sym);} -LISP cintern(char *name) +LISP cintern(const char *name) {return(gen_intern(name,0));} -LISP rintern(char *name) +LISP rintern(const char *name) {return(gen_intern(name,1));} -@@ -969,5 +997,5 @@ +@@ -969,9 +997,9 @@ {return(rintern(get_c_string(name)));} -LISP subrcons(long type, char *name, SUBR_FUNC f) +LISP subrcons(long type, const char *name, SUBR_FUNC f) {LISP z; NEWCELL(z,type); + (*z).storage_as.subr.name = name; +- (*z).storage_as.subr0.f = f; ++ (*z).storage_as.subr0.f = f.subr0; + return(z);} + @@ -988,5 +1016,5 @@ void gc_protect_n(LISP *location,long n) {struct gc_protected *reg; - reg = (struct gc_protected *) must_malloc(sizeof(struct gc_protected)); + reg = must_malloc(sizeof(struct gc_protected)); (*reg).location = location; (*reg).length = n; @@ -994,5 +1022,5 @@ protected_registers = reg;} -void gc_protect_sym(LISP *location,char *st) +void gc_protect_sym(LISP *location, const char *st) {*location = cintern(st); gc_protect(location);} @@ -1021,20 +1049,20 @@ {LISP ptr; long j; - tkbuffer = (char *) must_malloc(TKBUFFERN+1); + tkbuffer = must_malloc(TKBUFFERN+1); if (((gc_kind_copying == 1) && (nheaps != 2)) || (nheaps < 1)) err("invalid number of heaps",NIL); - heaps = (LISP *) must_malloc(sizeof(LISP) * nheaps); + heaps = must_malloc(sizeof(LISP) * nheaps); for(j=0;j 1) - {obarray = (LISP *) must_malloc(sizeof(LISP) * obarray_dim); + {obarray = must_malloc(sizeof(LISP) * obarray_dim); for(j=0;j 0) - {inums = (LISP *) must_malloc(sizeof(LISP) * inums_dim); + {inums = must_malloc(sizeof(LISP) * inums_dim); for(j=0;j= 0) && (type < tc_table_dim)) @@ -1135,5 +1163,5 @@ LISP (*mark)(LISP), void (*scan)(LISP), - void (*free)(LISP), + void (*gc_free)(LISP), long *kind) {struct user_type_hooks *p; @@ -1142,5 +1170,5 @@ p->gc_scan = scan; p->gc_mark = mark; - p->gc_free = free; + p->gc_free = gc_free; *kind = gc_kind_copying;} @@ -1274,5 +1302,5 @@ put_st(msgbuff); } - heaps[j] = (LISP) must_malloc(sizeof(struct obj)*heap_size); + heaps[j] = must_malloc(sizeof(struct obj)*heap_size); ptr = heaps[j]; end = heaps[j] + heap_size; @@ -1323,5 +1351,5 @@ setjmp(save_regs_gc_mark); mark_locations((LISP *) save_regs_gc_mark, - (LISP *) (((char *) save_regs_gc_mark) + sizeof(save_regs_gc_mark))); + (LISP *)(void *)(((char *)save_regs_gc_mark) + sizeof(save_regs_gc_mark))); mark_protected_registers(); mark_locations((LISP *) stack_start_ptr, @@ -1443,5 +1471,5 @@ end = org + heap_size; for(ptr=org; ptr < end; ++ptr) - if (((*ptr).gc_mark == 0)) + if ((*ptr).gc_mark == 0) {switch((*ptr).type) {case tc_free_cell: @@ -1485,6 +1513,6 @@ errjmp_ok = 0; old_status_flag = gc_status_flag; - if NNULLP(args) - if NULLP(car(args)) gc_status_flag = 0; else gc_status_flag = 1; + if NNULLP(args) { + if NULLP(car(args)) gc_status_flag = 0; else gc_status_flag = 1; } gc_mark_and_sweep(); gc_status_flag = old_status_flag; @@ -1507,6 +1535,6 @@ LISP gc_status(LISP args) {long n,m; - if NNULLP(args) - if NULLP(car(args)) gc_status_flag = 0; else gc_status_flag = 1; + if NNULLP(args) { + if NULLP(car(args)) gc_status_flag = 0; else gc_status_flag = 1;} if (gc_kind_copying == 1) {if (gc_status_flag) @@ -1735,5 +1763,6 @@ if (p->leval) {if NULLP((*p->leval)(tmp,&x,&env)) return(x); else goto loop;} - err("bad function",tmp);} + return err("bad function",tmp);} + /* FALLTHROUGH -- gcc8 needs this... */ default: return(x);}} @@ -1928,5 +1957,5 @@ return(sym_t);} -LISP letstar_macro(LISP form) +static LISP letstar_macro(LISP form) {LISP bindings = cadr(form); if (NNULLP(bindings) && NNULLP(cdr(bindings))) @@ -1939,5 +1968,5 @@ return(form);} -LISP letrec_macro(LISP form) +static LISP letrec_macro(LISP form) {LISP letb,setb,l; for(letb=NIL,setb=cddr(form),l=cadr(form);NNULLP(l);l=cdr(l)) @@ -1968,8 +1997,8 @@ return(form);} -LISP leval_quote(LISP args,LISP env) +LISP leval_quote(LISP args, LISP env __unused) {return(car(args));} -LISP leval_tenv(LISP args,LISP env) +LISP leval_tenv(LISP args __unused, LISP env) {return(env);} @@ -1999,5 +2028,5 @@ p->prin1 = fcn;} -char *subr_kind_str(long n) +static const char *subr_kind_str(long n) {switch(n) {case tc_subr_0: return("subr_0"); @@ -2082,5 +2111,5 @@ return(NIL);} -LISP lprin1(LISP exp,LISP lf) +static LISP lprin1(LISP exp, LISP lf) {FILE *f = get_c_file(lf,stdout); lprin1f(exp,f); @@ -2099,8 +2128,13 @@ int f_getc(FILE *f) -{long iflag,dflag; +{long iflag; +#ifdef VMS + long dflag; +#endif int c; iflag = no_interrupt(1); +#ifdef VMS dflag = interrupt_differed; +#endif c = getc(f); #ifdef VMS @@ -2114,10 +2148,10 @@ {ungetc(c,f);} -int flush_ws(struct gen_readio *f,char *eoferr) +int flush_ws(struct gen_readio *f, const char *eoferr) {int c,commentp; commentp = 0; while(1) {c = GETC_FCN(f); - if (c == EOF) if (eoferr) err(eoferr,NIL); else return(c); + if (c == EOF) { if (eoferr) err(eoferr, NIL); else return(c);} if (commentp) {if (c == '\n') commentp = 0;} else if (c == ';') commentp = 1; @@ -2149,5 +2183,6 @@ {int c,j; char *p,*buffer=tkbuffer; - STACK_CHECK(&f); + const char *pc; + p = buffer; c = flush_ws(f,"end of file inside read"); @@ -2156,5 +2191,5 @@ return(lreadparen(f)); case ')': - err("unexpected close paren",NIL); + return err("unexpected close paren", NIL); case '\'': return(cons(sym_quote,cons(lreadr(f),NIL))); @@ -2165,13 +2200,13 @@ switch(c) {case '@': - p = "+internal-comma-atsign"; + pc = "+internal-comma-atsign"; break; case '.': - p = "+internal-comma-dot"; + pc = "+internal-comma-dot"; break; default: - p = "+internal-comma"; + pc = "+internal-comma"; UNGETC_FCN(c,f);} - return(cons(cintern(p),lreadr(f))); + return(cons(cintern(pc), lreadr(f))); case '"': return(lreadstring(f)); @@ -2238,5 +2273,5 @@ LISP apropos(LISP matchl) {LISP result = NIL,l,ml; - char *pname; + const char *pname; for(l=oblistvar;CONSP(l);l=CDR(l)) {pname = get_c_string(CAR(l)); @@ -2248,5 +2283,6 @@ return(result);} -LISP fopen_cg(FILE *(*fcn)(const char *,const char *),char *name,char *how) +LISP fopen_cg(FILE *(*fcn)(const char *, const char *), + const char *name, const char *how) {LISP sym; long flag; @@ -2260,10 +2296,10 @@ SAFE_STRCAT(errmsg,name); err(errmsg,llast_c_errmsg(-1));} - sym->storage_as.c_file.name = (char *) must_malloc(strlen(name)+1); + sym->storage_as.c_file.name = must_malloc(strlen(name)+1); strcpy(sym->storage_as.c_file.name,name); no_interrupt(flag); return(sym);} -LISP fopen_c(char *name,char *how) +LISP fopen_c(const char *name, const char *how) {return(fopen_cg(fopen,name,how));} @@ -2286,10 +2322,11 @@ return(NIL);} -LISP vload(char *ofname,long cflag,long rflag) +LISP vload(const char *ofname, long cflag, long rflag) {LISP form,result,tail,lf,reader = NIL; FILE *f; int c; - long j,len; - char buffer[512],*key = "parser:",*start,*end,*ftype=".scm",*fname; + size_t j, len; + char buffer[512], *start, *end; + const char *key = "parser:", *ftype = ".scm", *fname; if ((start = strchr(ofname,VLOAD_OFFSET_HACK_CHAR))) {len = atol(ofname); @@ -2338,6 +2375,6 @@ if ((start = strstr(buffer,key))) {for(end = &start[strlen(key)]; - *end && isalnum(*end); - ++end); + *end && isalnum(*end); /* empty */) + ++end; /* Empty loop body worries gcc */ j = end - start; memmove(buffer,start,j); @@ -2386,5 +2423,5 @@ LISP save_forms(LISP fname,LISP forms,LISP how) -{char *cname,*chow = NULL; +{const char *cname, *chow = NULL; LISP l,lf; FILE *f; @@ -2487,5 +2524,5 @@ LISP parse_number(LISP x) -{char *c; +{const char *c; c = get_c_string(x); return(flocons(atof(c)));} @@ -2525,9 +2562,9 @@ {return((siod_verbose_level >= level) ? 1 : 0);} -LISP lruntime(void) +static LISP lruntime(void) {return(cons(flocons(myruntime()), cons(flocons(gc_time_taken),NIL)));} -LISP lrealtime(void) +static LISP lrealtime(void) {return(flocons(myrealtime()));} @@ -2538,5 +2575,5 @@ {return(car(cdr(x)));} -LISP cdar(LISP x) +static LISP cdar(LISP x) {return(cdr(car(x)));} @@ -2544,5 +2581,5 @@ {return(cdr(cdr(x)));} -LISP lrand(LISP m) +static LISP lrand(LISP m) {long res; res = rand(); @@ -2552,5 +2589,5 @@ return(flocons(res % get_c_long(m)));} -LISP lsrand(LISP s) +static LISP lsrand(LISP s) {srand(get_c_long(s)); return(NIL);} @@ -2583,5 +2620,5 @@ return(cintern(errmsg));} -LISP lllast_c_errmsg(void) +static LISP lllast_c_errmsg(void) {return(llast_c_errmsg(-1));} @@ -2611,5 +2648,5 @@ return(s1);} -static LISP parser_read(LISP ignore) +static LISP parser_read(LISP ignore __unused) {return(leval(cintern("read"),NIL));} --- sliba.c 2014-03-25 04:10:42.000000000 -0400 -+++ sliba.c 2021-02-22 12:01:55.507489000 -0500 ++++ sliba.c 2024-11-26 10:14:19.038656000 -0500 @@ -16,4 +16,8 @@ #include +#if defined(HAVE_SYS_PARAM_H) +#include +#endif + #include "siod.h" #include "siodp.h" @@ -145,4 +149,5 @@ gput_st(f," ");} gput_st(f,")"); + /* FALLTHROUGH */ case tc_byte_array: sprintf(tkbuffer,"#%ld\"",ptr->storage_as.string.dim); +@@ -177,5 +182,5 @@ + return(s);} + +-int rfs_getc(unsigned char **p) ++static int rfs_getc(unsigned char **p) + {int i; + i = **p; @@ -184,9 +189,9 @@ return(i);} -void rfs_ungetc(unsigned char c,unsigned char **p) -+void rfs_ungetc(unsigned char c __unused, unsigned char **p) ++static void rfs_ungetc(int c __unused, unsigned char **p) {*p = *p - 1;} LISP read_from_string(LISP x) -{char *p; +{const char *p; struct gen_readio s; p = get_c_string(x); @@ -196,5 +201,5 @@ return(readtl(&s));} -int pts_puts(char *from,void *cb) +static int pts_puts(const char *from, void *cb) {LISP into; size_t fromlen,intolen,intosize,fitsize; @@ -210,8 +215,8 @@ return(1);} -LISP err_wta_str(LISP exp) +static LISP err_wta_str(LISP exp) {return(err("not a string",exp));} -LISP print_to_string(LISP exp,LISP str,LISP nostart) +static LISP print_to_string(LISP exp, LISP str, LISP nostart) {struct gen_printio s; if NTYPEP(str,tc_string) err_wta_str(str); @@ -308,4 +313,5 @@ if (initp) for(j=0;jstorage_as.string.data[j] = ' '; + /* FALLTHROUGH */ case tc_byte_array: a->storage_as.string.dim = n; @@ -390,8 +396,9 @@ return(s);} -LISP bytes_append(LISP args) +static LISP bytes_append(LISP args) {long size,n,j; LISP l,s; - char *data,*ptr; + char *data; + const char *ptr; size = 0; for(l=args;NNULLP(l);l=cdr(l)) @@ -408,5 +415,5 @@ LISP substring(LISP str,LISP start,LISP end) {long s,e,n; - char *data; + const char *data; data = get_c_string_dim(str,&n); s = get_c_long(start); @@ -420,5 +427,5 @@ LISP string_search(LISP token,LISP str) -{char *s1,*s2,*ptr; +{const char *s1, *s2, *ptr; s1 = get_c_string(str); s2 = get_c_string(token); @@ -432,5 +439,5 @@ LISP string_trim(LISP str) -{char *start,*end; +{const char *start, *end; start = get_c_string(str); while(*start && IS_TRIM_SPACE(*start)) ++start; @@ -440,5 +447,5 @@ LISP string_trim_left(LISP str) -{char *start,*end; +{const char *start, *end; start = get_c_string(str); while(*start && IS_TRIM_SPACE(*start)) ++start; @@ -447,5 +454,5 @@ LISP string_trim_right(LISP str) -{char *start,*end; +{const char *start, *end; start = get_c_string(str); end = &start[strlen(start)]; @@ -455,10 +462,11 @@ LISP string_upcase(LISP str) {LISP result; - char *s1,*s2; + const char *s1; + char *s2; long j,n; s1 = get_c_string(str); n = strlen(s1); result = strcons(n,s1); - s2 = get_c_string(result); + s2 = get_string_data(result); for(j=0;jstorage_as.subr.name;*s;++s) + for(hash=0, s = (const unsigned char *)obj->storage_as.subr.name; *s; ++s) hash = HASH_COMBINE(hash,*s,n); return(hash); @@ -750,5 +758,5 @@ return(err("improper list to assoc",alist));} -LISP assv(LISP x,LISP alist) +static LISP assv(LISP x, LISP alist) {LISP l,tmp; for(l=alist;CONSP(l);l=CDR(l)) @@ -858,4 +866,5 @@ case '\n': return(fast_read(table));} + /* FALLTHROUGH */ case FO_fetch: len = get_long(f); @@ -1054,5 +1063,5 @@ {FILE *f; long flag; - char *data; + const char *data; long dim,len; f = get_c_file(file,stdout); @@ -1066,5 +1075,5 @@ return(NIL);} -LISP lfflush(LISP file) +static LISP lfflush(LISP file) {FILE *f; long flag; @@ -1079,5 +1088,5 @@ return(flocons(strlen(string->storage_as.string.data)));} -LISP string_dim(LISP string) +static LISP string_dim(LISP string) {if NTYPEP(string,tc_string) err_wta_str(string); return(flocons((double)string->storage_as.string.dim));} @@ -1113,5 +1122,5 @@ {char buffer[1000]; double y; - long base,width,prec; + int base, width, prec; if NFLONUMP(x) err("wta",x); y = FLONM(x); @@ -1156,5 +1165,5 @@ LISP string2number(LISP x,LISP b) -{char *str; +{const char *str; long base,value = 0; double result; @@ -1181,5 +1190,5 @@ return(flocons(result));} -LISP lstrcmp(LISP s1,LISP s2) +static LISP lstrcmp(LISP s1, LISP s2) {return(flocons(strcmp(get_c_string(s1),get_c_string(s2))));} @@ -1191,8 +1200,11 @@ err_wta_str(s);} -LISP lstrcpy(LISP dest,LISP src) +static LISP lstrcpy(LISP dest, LISP src) {long ddim,slen; - char *d,*s; + char *d = NULL; + const char *s; chk_string(dest,&d,&ddim); + if (d == NULL) /* if err() didn't exit after reporting error, we will */ + exit(10); s = get_c_string(src); slen = strlen(s); @@ -1203,8 +1215,11 @@ return(NIL);} -LISP lstrcat(LISP dest,LISP src) +static LISP lstrcat(LISP dest, LISP src) {long ddim,dlen,slen; - char *d,*s; + char *d = NULL; /* chk_string may not set it, and err() may still return */ + const char *s; chk_string(dest,&d,&ddim); + if (d == NULL) /* if err() didn't exit after reporting error, we will */ + exit(10); s = get_c_string(src); slen = strlen(s); @@ -1217,5 +1232,5 @@ LISP lstrbreakup(LISP str,LISP lmarker) -{char *start,*end,*marker; +{const char *start, *end, *marker; size_t k; LISP result = NIL; @@ -1238,8 +1253,8 @@ return(string_append(nreverse(result)));} -LISP stringp(LISP x) +static LISP stringp(LISP x) {return(TYPEP(x,tc_string) ? sym_t : NIL);} -static char *base64_encode_table = "\ +static const char *base64_encode_table = "\ ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz\ @@ -1250,8 +1265,8 @@ static void init_base64_table(void) {int j; - base64_decode_table = (char *) malloc(256); + base64_decode_table = malloc(256); memset(base64_decode_table,-1,256); for(j=0;j<65;++j) - base64_decode_table[base64_encode_table[j]] = j;} + base64_decode_table[(int)base64_encode_table[j]] = j;} #define BITMSK(N) ((1 << (N)) - 1) @@ -1262,7 +1277,8 @@ #define ITEM4(X) X & BITMSK(6) -LISP base64encode(LISP in) -{char *s,*t = base64_encode_table; - unsigned char *p1,*p2; +static LISP base64encode(LISP in) +{const char *s, *t = base64_encode_table; + const unsigned char *p1; + unsigned char *p2; LISP out; long j,m,n,chunks,leftover; @@ -1272,6 +1288,6 @@ m = (chunks + ((leftover) ? 1 : 0)) * 4; out = strcons(m,NULL); - p2 = (unsigned char *) get_c_string(out); - for(j=0,p1=(unsigned char *)s;jstorage_as.closure.code) (fcn->storage_as.closure.env,a1));} + /* FALLTHROUGH */ default: return(lapply(fcn,cons(a1,NIL)));}} @@ -1501,5 +1520,5 @@ return(lapply(fcn,cons(a1,cons(a2,NIL))));}} -LISP lqsort(LISP l,LISP f,LISP g) +static LISP lqsort(LISP l, LISP f, LISP g) /* this is a stupid recursive qsort */ {int j,n; @@ -1524,5 +1543,5 @@ lqsort(notless,f,g))));} -LISP string_lessp(LISP s1,LISP s2) +static LISP string_lessp(LISP s1, LISP s2) {if (strcmp(get_c_string(s1),get_c_string(s2)) < 0) return(sym_t); @@ -1530,5 +1549,5 @@ return(NIL);} -LISP benchmark_funcall1(LISP ln,LISP f,LISP a1) +static LISP benchmark_funcall1(LISP ln, LISP f, LISP a1) {long j,n; LISP value = NIL; @@ -1538,5 +1557,5 @@ return(value);} -LISP benchmark_funcall2(LISP l) +static LISP benchmark_funcall2(LISP l) {long j,n; LISP ln = car(l);LISP f = car(cdr(l)); LISP a1 = car(cdr(cdr(l))); @@ -1548,5 +1567,5 @@ return(value);} -LISP benchmark_eval(LISP ln,LISP exp,LISP env) +static LISP benchmark_eval(LISP ln, LISP exp, LISP env) {long j,n; LISP value = NIL; @@ -1556,5 +1575,5 @@ return(value);} -LISP mapcar1(LISP fcn,LISP in) +static LISP mapcar1(LISP fcn, LISP in) {LISP res,ptr,l; if NULLP(in) return(NIL); @@ -1564,5 +1583,5 @@ return(res);} -LISP mapcar2(LISP fcn,LISP in1,LISP in2) +static LISP mapcar2(LISP fcn, LISP in1, LISP in2) {LISP res,ptr,l1,l2; if (NULLP(in1) || NULLP(in2)) return(NIL); @@ -1572,5 +1591,5 @@ return(res);} -LISP mapcar(LISP l) +static LISP mapcar(LISP l) {LISP fcn = car(l); switch(get_c_long(llength(l))) @@ -1582,10 +1601,10 @@ return(err("mapcar case not handled",l));}} -LISP lfmod(LISP x,LISP y) +static LISP lfmod(LISP x, LISP y) {if NFLONUMP(x) err("wta(1st) to fmod",x); if NFLONUMP(y) err("wta(2nd) to fmod",y); return(flocons(fmod(FLONM(x),FLONM(y))));} -LISP lsubset(LISP fcn,LISP l) +static LISP lsubset(LISP fcn, LISP l) {LISP result = NIL,v; for(v=l;CONSP(v);v=CDR(v)) @@ -1594,5 +1613,5 @@ return(nreverse(result));} -LISP ass(LISP x,LISP alist,LISP fcn) +static LISP ass(LISP x, LISP alist, LISP fcn) {LISP l,tmp; for(l=alist;CONSP(l);l=CDR(l)) @@ -1603,5 +1622,5 @@ return(err("improper list to ass",alist));} -LISP append2(LISP l1,LISP l2) +static LISP append2(LISP l1, LISP l2) {long n; LISP result = NIL,p1,p2; @@ -1612,5 +1631,5 @@ return(result);} -LISP append(LISP l) +static LISP append(LISP l) {STACK_CHECK(&l); INTERRUPT_CHECK(); @@ -1635,7 +1654,6 @@ return(result);} - -LISP fast_load(LISP lfname,LISP noeval) -{char *fname; +static LISP fast_load(LISP lfname, LISP noeval) +{const char *fname; LISP stream; LISP result = NIL,form; @@ -1667,6 +1685,7 @@ sprintf(&outstr[j*2],"%02X",data[j]);} -LISP fast_save(LISP fname,LISP forms,LISP nohash,LISP comment,LISP fmode) -{char *cname,msgbuff[100],databuff[50]; +static LISP fast_save(LISP fname, LISP forms, LISP nohash, LISP comment, LISP fmode) +{const char *cname; + char msgbuff[100], databuff[50]; LISP stream,l; FILE *f; @@ -1687,5 +1706,5 @@ sprintf(msgbuff,"# Siod Binary Object Save File\n"); fput_st(f,msgbuff); - sprintf(msgbuff,"# sizeof(long) = %d\n# sizeof(double) = %d\n", + sprintf(msgbuff, "# sizeof(long) = %zu\n# sizeof(double) = %zu\n", sizeof(long),sizeof(double)); fput_st(f,msgbuff); @@ -1703,5 +1722,5 @@ return(NIL);} -void swrite1(LISP stream,LISP data) +static void swrite1(LISP stream, LISP data) {FILE *f = get_c_file(stream,stdout); switch TYPE(data) @@ -1730,5 +1749,5 @@ return(value);} -LISP swrite(LISP stream,LISP table,LISP data) +static LISP swrite(LISP stream, LISP table, LISP data) {long j,k,m,n; switch(TYPE(data)) @@ -1753,44 +1772,44 @@ return(NIL);} -LISP lpow(LISP x,LISP y) +static LISP lpow(LISP x, LISP y) {if NFLONUMP(x) err("wta(1st) to pow",x); if NFLONUMP(y) err("wta(2nd) to pow",y); return(flocons(pow(FLONM(x),FLONM(y))));} -LISP lexp(LISP x) +static LISP lexp(LISP x) {return(flocons(exp(get_c_double(x))));} -LISP llog(LISP x) +static LISP llog(LISP x) {return(flocons(log(get_c_double(x))));} -LISP lsin(LISP x) +static LISP lsin(LISP x) {return(flocons(sin(get_c_double(x))));} -LISP lcos(LISP x) +static LISP lcos(LISP x) {return(flocons(cos(get_c_double(x))));} -LISP ltan(LISP x) +static LISP ltan(LISP x) {return(flocons(tan(get_c_double(x))));} -LISP lasin(LISP x) +static LISP lasin(LISP x) {return(flocons(asin(get_c_double(x))));} -LISP lacos(LISP x) +static LISP lacos(LISP x) {return(flocons(acos(get_c_double(x))));} -LISP latan(LISP x) +static LISP latan(LISP x) {return(flocons(atan(get_c_double(x))));} -LISP latan2(LISP x,LISP y) +static LISP latan2(LISP x, LISP y) {return(flocons(atan2(get_c_double(x),get_c_double(y))));} -LISP hexstr(LISP a) -{unsigned char *in; +static LISP hexstr(LISP a) +{const unsigned char *in; char *out; LISP result; long j,dim; - in = (unsigned char *) get_c_string_dim(a,&dim); + in = (const unsigned char *)get_c_string_dim(a, &dim); result = strcons(dim*2,NULL); - for(out=get_c_string(result),j=0;jstorage_as.string.data; + out = (unsigned char *)get_string_data(result); for(j=0;j +#if defined(HAVE_SYS_PARAM_H) +#include +#endif + #if defined(unix) #include @@ -51,5 +55,5 @@ #endif -#if defined(__osf__) || defined(sun) || defined(linux) || defined(sgi) +#if defined(__osf__) || defined(sun) || defined(linux) || defined(sgi) || defined(BSD) #include #endif @@ -98,5 +102,5 @@ #include "siod.h" #include "siodp.h" -#include "md5.h" +#include static void init_slibu_version(void) @@ -106,8 +110,10 @@ -LISP sym_channels = NIL; -long tc_opendir = 0; +static LISP sym_channels = NIL; +static long tc_opendir = 0; -char *ld_library_path_env = "LD_LIBRARY_PATH"; +#if defined(unix) && !defined(BSD) +static const char *ld_library_path_env = "LD_LIBRARY_PATH"; +#endif #ifdef VMS @@ -119,5 +125,5 @@ #endif -LISP lsystem(LISP args) +static LISP lsystem(LISP args) {int retval; long iflag; @@ -131,8 +137,8 @@ #ifndef WIN32 -LISP lgetuid(void) +static LISP lgetuid(void) {return(flocons(getuid()));} -LISP lgetgid(void) +static LISP lgetgid(void) {return(flocons(getgid()));} #endif @@ -140,5 +146,5 @@ #ifdef unix -LISP lcrypt(LISP key,LISP salt) +static LISP lcrypt(LISP key, LISP salt) {char *result; if ((result = crypt(get_c_string(key),get_c_string(salt)))) @@ -156,5 +162,5 @@ #endif -LISP lgetcwd(void) +static LISP lgetcwd(void) {char path[PATH_MAX+1]; if (getcwd(path,sizeof(path))) @@ -167,6 +173,5 @@ #ifdef unix - -LISP ldecode_pwent(struct passwd *p) +static LISP ldecode_pwent(const struct passwd *p) {return(symalist( "name",strcons(strlen(p->pw_name),p->pw_name), @@ -186,13 +191,17 @@ #endif "shell",strcons(strlen(p->pw_shell),p->pw_shell), +#if defined(BSD) + "change", flocons(p->pw_change), +#endif NULL));} -static char *strfield(char *name,LISP alist) +#if !defined(BSD) +static char *strfield(const char *name, LISP alist) {LISP value,key = rintern(name); if NULLP(value = assq(key,alist)) - return(""); - return(get_c_string(cdr(value)));} + return(NULL); + return(get_string_data(cdr(value)));} -static long longfield(char *name,LISP alist) +static long longfield(const char *name, LISP alist) {LISP value,key = rintern(name); if NULLP(value = assq(key,alist)) @@ -200,5 +209,5 @@ return(get_c_long(cdr(value)));} -void lencode_pwent(LISP alist,struct passwd *p) +static void lencode_pwent(LISP alist, struct passwd *p) {p->pw_name = strfield("name",alist); p->pw_passwd = strfield("passwd",alist); @@ -217,6 +226,7 @@ #endif p->pw_shell = strfield("shell",alist);} +#endif -LISP lgetpwuid(LISP luid) +static LISP lgetpwuid(LISP luid) {int iflag; uid_t uid; @@ -230,5 +240,5 @@ return(result);} -LISP lgetpwnam(LISP nam) +static LISP lgetpwnam(LISP nam) {int iflag; struct passwd *p; @@ -240,5 +250,5 @@ return(result);} -LISP lgetpwent(void) +static LISP lgetpwent(void) {int iflag; LISP result = NIL; @@ -250,5 +260,5 @@ return(result);} -LISP lsetpwent(void) +static LISP lsetpwent(void) {int iflag = no_interrupt(1); setpwent(); @@ -256,5 +266,5 @@ return(NIL);} -LISP lendpwent(void) +static LISP lendpwent(void) {int iflag = no_interrupt(1); endpwent(); @@ -262,5 +272,5 @@ return(NIL);} -LISP lsetuid(LISP n) +static LISP lsetuid(LISP n) {uid_t uid; uid = (uid_t) get_c_long(n); @@ -270,5 +280,5 @@ return(NIL);} -LISP lseteuid(LISP n) +static LISP lseteuid(LISP n) {uid_t uid; uid = (uid_t) get_c_long(n); @@ -278,5 +288,5 @@ return(NIL);} -LISP lgeteuid(void) +static LISP lgeteuid(void) {return(flocons(geteuid()));} @@ -289,4 +299,5 @@ #endif +#if !defined(BSD) LISP lputpwent(LISP alist,LISP file) {int iflag = no_interrupt(1); @@ -297,8 +308,9 @@ no_interrupt(iflag); return(NIL);} +#endif -LISP laccess_problem(LISP lfname,LISP lacc) -{char *fname = get_c_string(lfname); - char *acc = get_c_string(lacc),*p; +static LISP laccess_problem(LISP lfname, LISP lacc) +{const char *fname = get_c_string(lfname); + const char *acc = get_c_string(lacc), *p; int amode = 0,iflag = no_interrupt(1),retval; for(p=acc;*p;++p) @@ -325,5 +337,5 @@ return(NIL);} -LISP lsymlink(LISP p1,LISP p2) +static LISP lsymlink(LISP p1, LISP p2) {long iflag; iflag = no_interrupt(1); @@ -333,5 +345,5 @@ return(NIL);} -LISP llink(LISP p1,LISP p2) +static LISP llink(LISP p1, LISP p2) {long iflag; iflag = no_interrupt(1); @@ -341,5 +353,5 @@ return(NIL);} -LISP lunlink(LISP p) +static LISP lunlink(LISP p) {long iflag; iflag = no_interrupt(1); @@ -349,5 +361,5 @@ return(NIL);} -LISP lrmdir(LISP p) +static LISP lrmdir(LISP p) {long iflag; iflag = no_interrupt(1); @@ -357,5 +369,5 @@ return(NIL);} -LISP lmkdir(LISP p,LISP m) +static LISP lmkdir(LISP p, LISP m) {long iflag; iflag = no_interrupt(1); @@ -365,5 +377,5 @@ return(NIL);} -LISP lreadlink(LISP p) +static LISP lreadlink(LISP p) {long iflag; char buff[PATH_MAX+1]; @@ -375,5 +387,5 @@ return(strcons(size,buff));} -LISP lrename(LISP p1,LISP p2) +static LISP lrename(LISP p1, LISP p2) {long iflag; iflag = no_interrupt(1); @@ -385,15 +397,15 @@ #endif -LISP lrandom(LISP n) +static LISP lrandom(LISP n) {int res; #if defined(hpux) || defined(vms) || defined(sun) || defined(sgi) || defined(WIN32) res = rand(); #endif -#if defined(__osf__) || defined(linux) +#if defined(__osf__) || defined(linux) || defined(BSD) res = random(); #endif return(flocons(NNULLP(n) ? res % get_c_long(n) : res));} -LISP lsrandom(LISP n) +static LISP lsrandom(LISP n) {long seed; seed = get_c_long(n); @@ -401,5 +413,5 @@ srand(seed); #endif -#if defined(__osf__) || defined(linux) +#if defined(__osf__) || defined(linux) || defined(BSD) srandom(seed); #endif @@ -408,5 +420,5 @@ #ifdef unix -LISP lfork(void) +static LISP lfork(void) {int iflag; pid_t pid; @@ -423,6 +435,7 @@ #endif -char **list2char(LISP *safe,LISP v) -{char **x,*tmp; +static char **list2char(LISP *safe, LISP v) +{char **x; + const char *tmp; long j,n; LISP l; @@ -438,5 +451,5 @@ #ifdef unix -LISP lexec(LISP path,LISP args,LISP env) +static LISP lexec(LISP path, LISP args, LISP env) {int iflag; char **argv = NULL, **envp = NULL; @@ -453,5 +466,5 @@ return(err("exec",llast_c_errmsg(-1)));} -LISP lnice(LISP val) +static LISP lnice(LISP val) {int iflag,n; n = get_c_long(val); @@ -490,5 +503,5 @@ #ifdef unix -LISP lwait(LISP lpid,LISP loptions) +static LISP lwait(LISP lpid, LISP loptions) {pid_t pid,ret; int iflag,status = 0,options; @@ -515,5 +528,5 @@ return(cons(flocons(ret),cons(flocons(status),NIL)));} -LISP lkill(LISP pid,LISP sig) +static LISP lkill(LISP pid, LISP sig) {long iflag; iflag = no_interrupt(1); @@ -527,12 +540,12 @@ #endif -LISP lgetpid(void) +static LISP lgetpid(void) {return(flocons(getpid()));} #ifdef unix -LISP lgetpgrp(void) +static LISP lgetpgrp(void) {return(flocons(getpgrp()));} -LISP lgetgrgid(LISP n) +static LISP lgetgrgid(LISP n) {gid_t gid; struct group *gr; @@ -552,13 +565,13 @@ #ifndef WIN32 -LISP lgetppid(void) +static LISP lgetppid(void) {return(flocons(getppid()));} #endif -LISP lmemref_byte(LISP addr) +static LISP lmemref_byte(LISP addr) {unsigned char *ptr = (unsigned char *) get_c_long(addr); return(flocons(*ptr));} -LISP lexit(LISP val) +static LISP lexit(LISP val) {int iflag = no_interrupt(1); exit(get_c_long(val)); @@ -566,5 +579,5 @@ return(NIL);} -LISP ltrunc(LISP x) +static LISP ltrunc(LISP x) {long i; if NFLONUMP(x) err("wta to trunc",x); @@ -573,10 +586,11 @@ #ifdef unix -LISP lputenv(LISP lstr) -{char *orig,*cpy; +static LISP lputenv(LISP lstr) +{const char *orig; + char *cpy; orig = get_c_string(lstr); /* unix putenv keeps a pointer to the string we pass, therefore we must make a fresh copy, which is memory leaky. */ - cpy = (char *) must_malloc(strlen(orig)+1); + cpy = must_malloc(strlen(orig)+1); strcpy(cpy,orig); if (putenv(cpy)) @@ -586,28 +600,31 @@ #endif -MD5_CTX * get_md5_ctx(LISP a) +static MD5_CTX * get_md5_ctx(LISP a) {if (TYPEP(a,tc_byte_array) && (a->storage_as.string.dim == sizeof(MD5_CTX))) - return((MD5_CTX *)a->storage_as.string.data); + return((MD5_CTX *)(void *)a->storage_as.string.data); else {err("not an MD5_CTX array",a); return(NULL);}} -LISP md5_init(void) +static LISP md5_init(void) {LISP a = arcons(tc_byte_array,sizeof(MD5_CTX),1); MD5Init(get_md5_ctx(a)); return(a);} -void md5_update_from_file(MD5_CTX *ctx,FILE *f,unsigned char *buff,long dim) +static void md5_update_from_file(MD5_CTX *ctx, FILE *f, void *buff, long dim) {size_t len; - while((len = fread(buff,sizeof(buff[0]),dim,f))) - MD5Update(ctx,buff,len);} - -LISP md5_update(LISP ctx,LISP str,LISP len) -{char *buffer; long dim,n; - buffer = get_c_string_dim(str,&dim); + while((len = fread(buff, 1, dim, f))) + MD5Update(ctx, buff, len); + if (!feof(f)) + err("fread", llast_c_errmsg(-1));} + +static LISP md5_update(LISP ctx, LISP str, LISP len) +{void *buffer; long dim, n; + buffer = get_string_data(str); + dim = str->storage_as.string.dim; if TYPEP(len,tc_c_file) {md5_update_from_file(get_md5_ctx(ctx), get_c_file(len,NULL), - (unsigned char *)buffer,dim); + buffer, dim); return(NIL);} else if NULLP(len) @@ -616,16 +633,16 @@ {n = get_c_long(len); if ((n < 0) || (n > dim)) err("invalid length for string",len);} - MD5Update(get_md5_ctx(ctx),(unsigned char *)buffer,n); + MD5Update(get_md5_ctx(ctx), buffer, n); return(NIL);} -LISP md5_final(LISP ctx) +static LISP md5_final(LISP ctx) {LISP result = arcons(tc_byte_array,16,0); - MD5Final((unsigned char *) result->storage_as.string.data, + MD5Final(get_string_data(result), get_md5_ctx(ctx)); return(result);} -#if defined(__osf__) || defined(sun) +#if defined(__osf__) || defined(sun) || defined(BSD) || defined(linux) -void handle_sigxcpu(int sig) +static void handle_sigxcpu(int sig __unused) {struct rlimit x; if (getrlimit(RLIMIT_CPU,&x)) @@ -640,5 +657,5 @@ err("cpu limit exceded",NIL);} -LISP cpu_usage_limits(LISP soft,LISP hard) +static LISP cpu_usage_limits(LISP soft, LISP hard) {struct rlimit x; if (NULLP(soft) && NULLP(hard)) @@ -662,5 +679,5 @@ static int handle_sigalrm_flag = 0; -void handle_sigalrm(int sig) +static void handle_sigalrm(int sig __unused) {if (nointerrupt == 1) {if (handle_sigalrm_flag) @@ -673,5 +690,5 @@ err("alarm signal",NIL);} -LISP lalarm(LISP seconds,LISP flag) +static LISP lalarm(LISP seconds, LISP flag) {long iflag; int retval; @@ -686,5 +703,5 @@ -#if defined(__osf__) || defined(SUN5) || defined(linux) +#if defined(__osf__) || defined(SUN5) || defined(linux) || defined(BSD) #define TV_FRAC(x) (((double)x.tv_usec) * 1.0e-6) @@ -694,5 +711,5 @@ #endif -LISP current_resource_usage(LISP kind) +static LISP current_resource_usage(LISP kind) {struct rusage u; int code; @@ -729,5 +746,5 @@ #ifdef unix -LISP l_opendir(LISP name) +static LISP l_opendir(LISP name) {long iflag; LISP value; @@ -742,5 +759,5 @@ return(value);} -DIR *get_opendir(LISP v,long oflag) +static DIR *get_opendir(LISP v, long oflag) {if NTYPEP(v,tc_opendir) err("not an opendir",v); if NULLP(CAR(v)) @@ -749,5 +766,5 @@ return((DIR *)CAR(v));} -LISP l_closedir(LISP v) +static LISP l_closedir(LISP v) {long iflag,old_errno; DIR *d; @@ -761,10 +778,10 @@ return(NIL);} -void opendir_gc_free(LISP v) +static void opendir_gc_free(LISP v) {DIR *d; if ((d = get_opendir(v,0))) closedir(d);} -LISP l_readdir(LISP v) +static LISP l_readdir(LISP v) {long iflag,namlen; DIR *d; @@ -782,5 +799,5 @@ return(strcons(namlen,r->d_name));} -void opendir_prin1(LISP ptr,struct gen_printio *f) +static void opendir_prin1(LISP ptr, struct gen_printio *f) {char buffer[256]; sprintf(buffer,"#",get_opendir(ptr,0)); @@ -879,5 +896,5 @@ #endif -LISP file_times(LISP fname) +static LISP file_times(LISP fname) {struct stat st; int iflag,ret; @@ -894,5 +911,5 @@ #if defined(unix) -LISP decode_st_moden(mode_t mode) +static LISP decode_st_moden(mode_t mode) {LISP ret = NIL; if (mode & S_ISUID) ret = cons(cintern("SUID"),ret); @@ -952,8 +969,8 @@ #endif -LISP decode_st_mode(LISP value) +static LISP decode_st_mode(LISP value) {return(decode_st_moden(get_c_long(value)));} -LISP decode_stat(struct stat *s) +static LISP decode_stat(struct stat *s) {return(symalist("dev",flocons(s->st_dev), "ino",flocons(s->st_ino), @@ -978,5 +995,5 @@ -LISP g_stat(LISP fname,int (*fcn)(const char *,struct stat *)) +static LISP g_stat(LISP fname, int (*fcn)(const char *, struct stat *)) {struct stat st; int iflag,ret; @@ -989,8 +1006,8 @@ return(decode_stat(&st));} -LISP l_stat(LISP fname) +static LISP l_stat(LISP fname) {return(g_stat(fname,stat));} -LISP l_fstat(LISP f) +static LISP l_fstat(LISP f) {struct stat st; int iflag,ret; @@ -1004,5 +1021,5 @@ #ifdef unix -LISP l_lstat(LISP fname) +static LISP l_lstat(LISP fname) {return(g_stat(fname,lstat));} #endif @@ -1022,5 +1039,5 @@ #if defined(unix) || defined(WIN32) -LISP l_chmod(LISP path,LISP mode) +static LISP l_chmod(LISP path, LISP mode) {if (chmod(get_c_string(path),get_c_long(mode))) return(err("chmod",llast_c_errmsg(-1))); @@ -1030,8 +1047,17 @@ #endif +#if defined(unix) || defined(WIN32) + +static LISP l_lchmod(LISP path, LISP mode) +{if (lchmod(get_c_string(path), get_c_long(mode))) + return(err("lchmod", llast_c_errmsg(-1))); + else + return(NIL);} + +#endif #ifdef unix -LISP lutime(LISP fname,LISP mod,LISP ac) +static LISP lutime(LISP fname, LISP mod, LISP ac) {struct utimbuf x; x.modtime = get_c_long(mod); @@ -1043,5 +1069,5 @@ -LISP lfchmod(LISP file,LISP mode) +static LISP lfchmod(LISP file, LISP mode) {if (fchmod(fileno(get_c_file(file,NULL)),get_c_long(mode))) return(err("fchmod",llast_c_errmsg(-1))); @@ -1061,5 +1087,5 @@ NULL)));} -int get_fd(LISP ptr) +static int get_fd(LISP ptr) {if TYPEP(ptr,tc_c_file) return(fileno(get_c_file(ptr,NULL))); @@ -1067,5 +1093,5 @@ return(get_c_long(ptr));} -LISP gsetlk(int op,LISP lfd,LISP ltype,LISP whence,LISP start,LISP len) +static LISP gsetlk(int op, LISP lfd, LISP ltype, LISP whence, LISP start, LISP len) {struct flock f; int fd = get_fd(lfd); @@ -1084,11 +1110,11 @@ return(listn(2,flocons(f.l_type),flocons(f.l_pid)));} -LISP lF_SETLK(LISP fd,LISP ltype,LISP whence,LISP start,LISP len) +static LISP lF_SETLK(LISP fd, LISP ltype, LISP whence, LISP start, LISP len) {return(gsetlk(F_SETLK,fd,ltype,whence,start,len));} -LISP lF_SETLKW(LISP fd,LISP ltype,LISP whence,LISP start,LISP len) +static LISP lF_SETLKW(LISP fd, LISP ltype, LISP whence, LISP start, LISP len) {return(gsetlk(F_SETLKW,fd,ltype,whence,start,len));} -LISP lF_GETLK(LISP fd,LISP ltype,LISP whence,LISP start,LISP len) +static LISP lF_GETLK(LISP fd, LISP ltype, LISP whence, LISP start, LISP len) {return(gsetlk(F_GETLK,fd,ltype,whence,start,len));} @@ -1097,5 +1123,5 @@ #endif -LISP delete_file(LISP fname) +static LISP delete_file(LISP fname) {int iflag,ret; iflag = no_interrupt(1); @@ -1111,5 +1137,5 @@ return(NIL);} -LISP utime2str(LISP u) +static LISP utime2str(LISP u) {time_t bt; struct tm *btm; @@ -1218,5 +1244,5 @@ #endif -LISP lgetenv(LISP var) +static LISP lgetenv(LISP var) {char *str; if ((str = getenv(get_c_string(var)))) @@ -1225,8 +1251,8 @@ return(NIL);} -LISP unix_time(void) +static LISP unix_time(void) {return(flocons((double)time(NULL)));} -LISP unix_ctime(LISP value) +static LISP unix_ctime(LISP value) {time_t b; char *buff,*p; @@ -1241,5 +1267,5 @@ return(NIL);} -LISP http_date(LISP value) +static LISP http_date(LISP value) /* returns the internet standard RFC 1123 format */ {time_t b; @@ -1320,5 +1346,5 @@ #endif -LISP lsleep(LISP ns) +static LISP lsleep(LISP ns) {double val = get_c_double(ns); #ifdef unix @@ -1333,7 +1359,8 @@ return(NIL);} -LISP url_encode(LISP in) +static LISP url_encode(LISP in) {int spaces=0,specials=0,regulars=0,c; - char *str = get_c_string(in),*p,*r; + const char *str = get_c_string(in), *p; + char *r; LISP out; for(p=str,spaces=0,specials=0,regulars=0;(c = *p);++p) @@ -1344,5 +1371,5 @@ return(in); out = strcons(spaces + regulars + specials * 3,NULL); - for(p=str,r=get_c_string(out);(c = *p);++p) + for (p = str, r = get_string_data(out); (c = *p); ++p) if (c == ' ') *r++ = '+'; @@ -1352,10 +1379,11 @@ else *r++ = c; - *r = 0; + *r = '\0'; return(out);} -LISP url_decode(LISP in) +static LISP url_decode(LISP in) {int pluses=0,specials=0,regulars=0,c,j; - char *str = get_c_string(in),*p,*r; + const char *str = get_c_string(in), *p; + char *r; LISP out; for(p=str,pluses=0,specials=0,regulars=0;(c = *p);++p) @@ -1371,5 +1399,5 @@ return(in); out = strcons(regulars + pluses + specials,NULL); - for(p=str,r=get_c_string(out);(c = *p);++p) + for (p = str, r = get_string_data(out); (c = *p); ++p) if (c == '+') *r++ = ' '; @@ -1386,7 +1414,8 @@ return(out);} -LISP html_encode(LISP in) +static LISP html_encode(LISP in) {long j,n,m; - char *str,*ptr; + const char *str; + char *ptr; LISP out; switch(TYPE(in)) @@ -1411,5 +1440,5 @@ if (n == m) return(in); out = strcons(m,NULL); - for(j=0,ptr=get_c_string(out);j < n; ++j) + for(j = 0, ptr = get_string_data(out); j < n; ++j) switch(str[j]) {case '>': @@ -1429,8 +1458,8 @@ return(out);} -LISP html_decode(LISP in) +static LISP html_decode(LISP in) {return(in);} -LISP lgets(LISP file,LISP buffn) +static LISP lgets(LISP file, LISP buffn) {FILE *f; int iflag; @@ -1442,5 +1471,5 @@ else if ((n = get_c_long(buffn)) < 0) err("size must be >= 0",buffn); - else if (n > sizeof(buffer)) + else if (n > (long)sizeof(buffer)) err("not handling buffer of size",listn(2,buffn,flocons(sizeof(buffer)))); iflag = no_interrupt(1); @@ -1451,11 +1480,12 @@ return(NIL);} -LISP readline(LISP file) +static LISP readline(LISP file) {LISP result; - char *start,*ptr; + const char *start; + char *ptr; result = lgets(file,NIL); if NULLP(result) return(NIL); start = get_c_string(result); - if ((ptr = strchr(start,'\n'))) + if ((ptr = strchr(start, '\n')) != NULL) {*ptr = 0; /* we also change the dim, because otherwise our equal? function @@ -1470,5 +1500,5 @@ #ifndef WIN32 -LISP l_chown(LISP path,LISP uid,LISP gid) +static LISP l_chown(LISP path, LISP uid, LISP gid) {long iflag; iflag = no_interrupt(1); @@ -1481,5 +1511,5 @@ #if defined(unix) && !defined(linux) -LISP l_lchown(LISP path,LISP uid,LISP gid) +static LISP l_lchown(LISP path, LISP uid, LISP gid) {long iflag; iflag = no_interrupt(1); @@ -1493,5 +1523,5 @@ #ifdef unix -LISP popen_l(LISP name,LISP how) +static LISP popen_l(LISP name, LISP how) {return(fopen_cg(popen, get_c_string(name), @@ -1504,5 +1534,5 @@ So beware. */ -LISP pclose_l(LISP ptr) +static LISP pclose_l(LISP ptr) {FILE *f = get_c_file(ptr,NULL); long iflag = no_interrupt(1); @@ -1520,5 +1550,5 @@ #endif -LISP so_init_name(LISP fname,LISP iname) +static LISP so_init_name(LISP fname, LISP iname) {LISP init_name; if NNULLP(iname) @@ -1533,6 +1563,6 @@ return(intern(init_name));} -LISP so_ext(LISP fname) -{char *ext = ".so"; +static LISP so_ext(LISP fname) +{const char *ext = ".so"; LISP lext; #if defined(hpux) @@ -1551,9 +1581,9 @@ return(string_append(listn(2,fname,lext)));} -LISP load_so(LISP fname,LISP iname) +static LISP load_so(LISP fname, LISP iname) /* note: error cases can leak memory in this procedure. */ {LISP init_name; void (*fcn)(void) = NULL; -#if defined(__osf__) || defined(sun) || defined(linux) || defined(sgi) +#if defined(__osf__) || defined(sun) || defined(linux) || defined(sgi) || defined(BSD) void *handle; #endif @@ -1576,5 +1606,5 @@ put_st(get_c_string(fname)); put_st("\n");} -#if defined(__osf__) || defined(sun) || defined(linux) || defined(sgi) +#if defined(__osf__) || defined(sun) || defined(linux) || defined(sgi) || defined(BSD) #if !defined(__osf__) /* Observed bug: values of LD_LIBRARY_PATH established with putenv @@ -1637,5 +1667,5 @@ return(init_name);} -LISP require_so(LISP fname) +static LISP require_so(LISP fname) {LISP init_name; init_name = so_init_name(fname,NIL); @@ -1647,9 +1677,9 @@ return(NIL);} -LISP siod_lib_l(void) +static LISP siod_lib_l(void) {return(rintern(siod_lib));} -LISP ccall_catch_1(LISP (*fcn)(void *),void *arg) +static LISP ccall_catch_1(LISP (*fcn)(void *), void *arg) {LISP val; val = (*fcn)(arg); @@ -1669,5 +1699,5 @@ return(ccall_catch_1(fcn,arg));} -LISP decode_tm(struct tm *t) +static LISP decode_tm(struct tm *t) {return(symalist("sec",flocons(t->tm_sec), "min",flocons(t->tm_min), @@ -1685,8 +1715,8 @@ NULL));} -LISP symalist(char *arg,...) +LISP symalist(const char *arg, ...) {va_list args; LISP result,l,val; - char *key; + const char *key; if (!arg) return(NIL); va_start(args,arg); @@ -1694,5 +1724,5 @@ result = cons(cons(cintern(arg),val),NIL); l = result; - while((key = va_arg(args,char *))) + while((key = va_arg(args, const char *))) {val = va_arg(args,LISP); CDR(l) = cons(cons(cintern(key),val),NIL); @@ -1701,5 +1731,5 @@ return(result);} -void encode_tm(LISP alist,struct tm *t) +static void encode_tm(LISP alist, struct tm *t) {LISP val; val = cdr(assq(cintern("sec"),alist)); @@ -1727,5 +1757,5 @@ } -LISP llocaltime(LISP value) +static LISP llocaltime(LISP value) {time_t b; struct tm *t; @@ -1739,5 +1769,5 @@ return(err("localtime",llast_c_errmsg(-1)));} -LISP lgmtime(LISP value) +static LISP lgmtime(LISP value) {time_t b; struct tm *t; @@ -1752,10 +1782,10 @@ #if defined(unix) || defined(WIN32) -LISP ltzset(void) +static LISP ltzset(void) {tzset(); return(NIL);} #endif -LISP lmktime(LISP alist) +static LISP lmktime(LISP alist) {struct tm tm; time_t t; @@ -1764,7 +1794,7 @@ return(flocons((double)t));} -#if defined(__osf__) || defined(SUN5) || defined(linux) +#if defined(__osf__) || defined(SUN5) || defined(linux) || defined(BSD) -LISP lstrptime(LISP str,LISP fmt,LISP in) +static LISP lstrptime(LISP str,LISP fmt,LISP in) {struct tm tm; encode_tm(in,&tm); @@ -1785,5 +1815,5 @@ #ifdef unix -LISP lstrftime(LISP fmt,LISP in) +static LISP lstrftime(LISP fmt, LISP in) {struct tm tm; time_t b; @@ -1805,5 +1835,5 @@ #endif -LISP lchdir(LISP dir) +static LISP lchdir(LISP dir) {long iflag; #ifdef unix @@ -1811,5 +1841,5 @@ int fd; #endif - char *path; + const char *path; switch(TYPE(dir)) {case tc_c_file: @@ -1844,5 +1874,5 @@ #ifdef unix -LISP lgetpass(LISP lprompt) +static LISP lgetpass(LISP lprompt) {long iflag; char *result; @@ -1857,5 +1887,5 @@ #ifdef unix -LISP lpipe(void) +static LISP lpipe(void) {int filedes[2]; long iflag; @@ -1886,9 +1916,9 @@ #define CTYPE_ULONG 10 -LISP err_large_index(LISP ind) +static LISP err_large_index(LISP ind) {return(err("index too large",ind));} -LISP datref(LISP dat,LISP ctype,LISP ind) -{char *data; +static LISP datref(LISP dat, LISP ctype, LISP ind) +{const void *data; long size,i; data = get_c_string_dim(dat,&size); @@ -1898,46 +1928,46 @@ {case CTYPE_FLOAT: if (((i+1) * (int) sizeof(float)) > size) err_large_index(ind); - return(flocons(((float *)data)[i])); + return(flocons(((const float *)data)[i])); case CTYPE_DOUBLE: if (((i+1) * (int) sizeof(double)) > size) err_large_index(ind); - return(flocons(((double *)data)[i])); + return(flocons(((const double *)data)[i])); case CTYPE_LONG: if (((i+1) * (int) sizeof(long)) > size) err_large_index(ind); - return(flocons(((long *)data)[i])); + return(flocons(((const long *)data)[i])); case CTYPE_SHORT: if (((i+1) * (int) sizeof(short)) > size) err_large_index(ind); - return(flocons(((short *)data)[i])); + return(flocons(((const short *)data)[i])); case CTYPE_CHAR: if (((i+1) * (int) sizeof(char)) > size) err_large_index(ind); - return(flocons(((char *)data)[i])); + return(flocons(((const char *)data)[i])); case CTYPE_INT: if (((i+1) * (int) sizeof(int)) > size) err_large_index(ind); - return(flocons(((int *)data)[i])); + return(flocons(((const int *)data)[i])); case CTYPE_ULONG: if (((i+1) * (int) sizeof(unsigned long)) > size) err_large_index(ind); - return(flocons(((unsigned long *)data)[i])); + return(flocons(((const unsigned long *)data)[i])); case CTYPE_USHORT: if (((i+1) * (int) sizeof(unsigned short)) > size) err_large_index(ind); - return(flocons(((unsigned short *)data)[i])); + return(flocons(((const unsigned short *)data)[i])); case CTYPE_UCHAR: if (((i+1) * (int) sizeof(unsigned char)) > size) err_large_index(ind); - return(flocons(((unsigned char *)data)[i])); + return(flocons(((const unsigned char *)data)[i])); case CTYPE_UINT: if (((i+1) * (int) sizeof(unsigned int)) > size) err_large_index(ind); - return(flocons(((unsigned int *)data)[i])); + return(flocons(((const unsigned int *)data)[i])); default: return(err("unknown CTYPE",ctype));}} -LISP sdatref(LISP spec,LISP dat) +static LISP sdatref(LISP spec, LISP dat) {return(datref(dat,car(spec),cdr(spec)));} -LISP mkdatref(LISP ctype,LISP ind) +static LISP mkdatref(LISP ctype, LISP ind) {return(closure(cons(ctype,ind), leval(cintern("sdatref"),NIL)));} -LISP datlength(LISP dat,LISP ctype) -{char *data; +static LISP datlength(LISP dat, LISP ctype) +{ long size; - data = get_c_string_dim(dat,&size); + (void)get_c_string_dim(dat, &size); switch(get_c_long(ctype)) {case CTYPE_FLOAT: @@ -1981,7 +2011,7 @@ return(NIL);} - -static int htqs_arg(char *value) -{char tmpbuff[1024],*p1,*p2; +static int htqs_arg(const char *value) +{char tmpbuff[1024], *p1; + const char *p2; if ((strcmp(value,"(repl)") == 0) || (strcmp(value,"repl") == 0)) @@ -1994,12 +2024,12 @@ *p1 = 0; strcat(tmpbuff,"\")"); - return(repl_c_string(tmpbuff,0,0,0));} + return(repl_c_string01(tmpbuff, 0, 0, 0));} else - return(repl_c_string(value,0,0,0));} - + return(repl_c_string01(value, 0, 0, 0));} int __stdcall siod_main(int argc,char **argv, char **env) {int j,retval = 0,iargc,mainflag = 0,text_plain_flag = 0; - char *iargv[2],*start,*end; + const char *iargv[2], *start, *end; + char *iargv1; LISP l; iargv[0] = ""; @@ -2008,14 +2038,15 @@ {while(*start) {if (!(end = strstr(start,",-"))) end = &start[strlen(start)]; - iargv[1] = (char *) malloc(end-start+1); - memcpy(iargv[1],start,end-start); - iargv[1][end-start] = 0; - if ((strncmp(iargv[1],"-v",2) == 0) && - (atol(&iargv[1][2]) > 0) && - (iargv[1][2] != '0')) + iargv1 = malloc(end-start+1); + iargv[1] = iargv1; + memcpy(iargv1, start, end - start); + iargv1[end - start] = 0; + if ((strncmp(iargv1, "-v", 2) == 0) && + (atol(iargv1 + 2) > 0) && + (iargv1[2] != '0')) {put_st("Content-type: text/plain\r\n\r\n"); text_plain_flag = 1;} - if ((strncmp(iargv[1],"-m",2) == 0)) - mainflag = atol(&iargv[1][2]); + if ((strncmp(iargv1, "-m", 2) == 0)) + mainflag = atol(iargv1 + 2); else process_cla(2,iargv,1); @@ -2064,5 +2095,5 @@ #define BOOTSTRAP_EXE_FILE_SIZE_LIMIT 1000000 -long position_script(FILE *f,char *buff,size_t bufflen) +static long position_script(FILE *f, char *buff, size_t bufflen) /* This recognizes #!/ sequence. Exersize: compute the probability of the sequence showing up in a file of N random bytes. */ @@ -2115,5 +2146,5 @@ would do for a #!/xxx script execution. */ {FILE *f; - char flagbuff[100],**argv,**nargv,offbuff[10]; + char flagbuff[100], **argv, **nargv; long pos; int argc,nargc,j,k; @@ -2131,11 +2162,9 @@ if (pos < 0) return; nargc = argc + ((*flagbuff) ? 2 : 1); - nargv = (char **) malloc(sizeof(char *) * nargc); + nargv = malloc(sizeof(char *) * nargc); j = 0; - nargv[j++] = "siod.exe"; + nargv[j++] = argv[0]; if (*flagbuff) nargv[j++] = strdup(flagbuff); - sprintf(offbuff,"%ld",pos); - nargv[j] = (char *) malloc(strlen(offbuff)+strlen(argv[0])+2); - sprintf(nargv[j],"%s%c%s",offbuff,VLOAD_OFFSET_HACK_CHAR,argv[0]); + asprintf(&nargv[j], "%ld%c%s", pos, VLOAD_OFFSET_HACK_CHAR, argv[0]); j++; for(k=1;k