diff --git a/BUGS b/BUGS index 711e0a9..2e1eab9 100644 --- a/BUGS +++ b/BUGS @@ -33,3 +33,11 @@ Generational/Incremental Garbage Collector (a broken-heart is passed to Memoize_Frame() after an ExpandHeap()). o The percentage displayed at the end of a GC run is sometimes wrong. + + o This simple test causes a valgrind error after the first GC run: + + (define (fact x) (if (> x 1) (* x (fact (- x 1))) 1)) + (fact 100) + (fact 1000) + (fact 1000) + diff --git a/config/system b/config/system index b14e2d3..21fa2c8 100644 --- a/config/system +++ b/config/system @@ -295,7 +295,7 @@ ld=ld # The C compiler flags used for all files. -cflags='-O2 -I/usr/include/libelf' +cflags='-Wall -O2 -I/usr/include/libelf' # Are extra C compiler flags (such as -D_NO_PROTO) required to compile diff --git a/debian/README.Debian b/debian/README.Debian index 861cfdb..00fcdee 100644 --- a/debian/README.Debian +++ b/debian/README.Debian @@ -18,7 +18,9 @@ $install_dir/bin/scheme /usr/bin/scheme $install_dir/include/ /usr/include/elk/ -$install_dir/runtime/{scm,obj}/ /usr/lib/elk/{scm,obj}/ +$install_dir/runtime/scm/ /usr/share/elk/scm/ + +$install_dir/runtime/obj/ /usr/lib/elk/obj/ $install_dir/lib/*.o /usr/lib/elk/*.o @@ -27,4 +29,5 @@ $install_dir/lib/{linkscheme,makedl} /usr/bin/{linkscheme,makedl} $install_dir/lib/ldflags /usr/bin/ldflags-elk - -- Enrique Zanardi , Mon, 26 Mar 2001 20:19:04 +0100 + -- Enrique Zanardi Mon, 26 Mar 2001 20:19:04 +0100 + -- Samuel Hocevar Mon, 31 Mar 2003 15:00:23 +0200 diff --git a/debian/changelog b/debian/changelog index 868fd3c..9e933db 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,11 +1,26 @@ -elk (3.0-8.1) unstable; urgency=low +elk (3.0-9) unstable; urgency=low * New maintainer. - * Fixed spelling in the package description (Closes: #161056). - * Updated standards version to 3.5.9.0. - * Replaced sys_errlist usage with strerror calls, and mktemp with mkstemp. + * Packaging updates: + + Fixed spelling in the package description (Closes: #161056). + + Updated standards version to 3.5.9.0. + + Changed SCM_DIR from /usr/lib/elk/scm to /usr/share/elk/scm because + scheme scripts are platform-independent. + * Massive code cleanups: + + Added -Wall to the build rules to make error spotting easier, and fixed + all compilation warnings in the main program. + + Replaced sys_errlist with strerror, bcopy with memcpy, bzero with memset. + + Fixed many uninitialized variables. + * Fixed some pointer/integer type confusions which caused elk to crash + on alpha (Closes: #59893) and probably ia64. + * Fixed a read overflow in heap-gen.c:AllocPage() that was corrupting the + internal heap (Closes: #57621). + * Fixed a missing memory area initialization in heap-gen.c:ExpandHeap() that + was causing garbage collector crashes. + * Fixed an integer sign issue in main.c:Max_Stack (Closes: #176190). + * Made `quit' an alias for `exit' in toplevel.scm. - -- Samuel Hocevar Fri, 28 Mar 2003 10:30:34 +0100 + -- Samuel Hocevar Tue, 1 Apr 2003 11:33:23 +0200 elk (3.0-8.1) unstable; urgency=low @@ -85,6 +100,3 @@ elk (3.0-1) unstable; urgency=low -- Enrique Zanardi Wed, 30 Oct 1996 13:05:48 +0000 -Local variables: -mode: debian-changelog -End: diff --git a/debian/elk.ini b/debian/elk.ini index bb2c4ff..82184e6 100644 --- a/debian/elk.ini +++ b/debian/elk.ini @@ -47,7 +47,7 @@ ;;; the directory where any auxillary files to your Scheme ;;; implementation reside. -(define (implementation-vicinity) "/usr/lib/elk/scm") +(define (implementation-vicinity) "/usr/share/elk/scm") ;;; (library-vicinity) should be defined to be the pathname of the ;;; directory where files of Scheme library functions reside. diff --git a/debian/rules b/debian/rules index 4163aa2..502122a 100644 --- a/debian/rules +++ b/debian/rules @@ -21,9 +21,9 @@ build-stamp: # Add here commands to compile the package. ifeq ($(shell dpkg-architecture -qDEB_BUILD_ARCH),alpha) - echo "cflags='-O0 -I/usr/include/libelf'" > debian/arch-config + echo 'cflags=`echo $${cflags} | sed s/-O./-O0/`' > debian/arch-config else - echo "# empty" > debian/arch-config + echo '# empty' > debian/arch-config endif $(MAKE) SUBDIRS='include scripts src scm lib/misc lib/unix\ lib/xlib lib/xt lib/xaw lib/xm lib/xm/xt' @@ -54,7 +54,7 @@ install: build mv $(CURDIR)/debian/elk/usr/bin/scheme \ $(CURDIR)/debian/elk/usr/bin/scheme-elk install -m 755 debian/scheme-warning-elk $(CURDIR)/debian/elk/usr/bin/ - install -m 644 debian/elk.ini $(CURDIR)/debian/elk/usr/lib/elk/scm + install -m 644 debian/elk.ini $(CURDIR)/debian/elk/usr/share/elk/scm # dh_movefiles # Build architecture-independent files here. diff --git a/include/build-config b/include/build-config index c1357fd..dbc50ae 100755 --- a/include/build-config +++ b/include/build-config @@ -321,7 +321,7 @@ $def_bcopy $def_bzero $def_bcmp #define AOUT_H $aout_h -#define SCM_DIR "$final_dir/lib/elk/scm" +#define SCM_DIR "$final_dir/share/elk/scm" #define OBJ_DIR "$final_dir/lib/elk/obj" #define HEAP_SIZE $default_heap_size #define FIND_AOUT defined(USE_LD) || defined(CAN_DUMP)\\ diff --git a/include/cstring.h b/include/cstring.h index 28e1cb1..43f157e 100644 --- a/include/cstring.h +++ b/include/cstring.h @@ -6,7 +6,7 @@ Check_Type(_from, T_String);\ _len = STRING(_from)->size;\ Alloca ((_to), char*, _len+1);\ - bcopy (STRING(_from)->data, (_to), _len);\ + memcpy ((_to), STRING(_from)->data, _len);\ (_to)[_len] = '\0';\ } @@ -18,6 +18,6 @@ Wrong_Type_Combination ((_from), "string or symbol");\ _len = STRING(_from)->size;\ Alloca ((_to), char*, _len+1);\ - bcopy (STRING(_from)->data, (_to), _len);\ + memcpy ((_to), STRING(_from)->data, _len);\ (_to)[_len] = '\0';\ } diff --git a/include/extern.h b/include/extern.h index cbf95ab..3cf39bf 100644 --- a/include/extern.h +++ b/include/extern.h @@ -11,7 +11,7 @@ extern Object P_Autoload P_((Object, Object)); /* Bignums */ extern Object Make_Uninitialized_Bignum P_((int)); -extern Bignum_Normalize_In_Place P_((struct S_Bignum *)); +extern void Bignum_Normalize_In_Place P_((struct S_Bignum *)); /* Boolean operators */ @@ -82,10 +82,10 @@ extern Object The_Environment, Global_Environment; /* Error handling */ -extern Primitive_Error P_((ELLIPSIS)); -extern Fatal_Error P_((ELLIPSIS)); -extern Range_Error P_((Object)); -extern Panic P_((const char*)); +extern void Primitive_Error P_((ELLIPSIS)) __attribute__ ((__noreturn__)); +extern void Fatal_Error P_((ELLIPSIS)) __attribute__ ((__noreturn__)); +extern void Range_Error P_((Object)); +extern void Panic P_((const char*)); extern Object P_Error P_((int, Object*)); extern Object P_Reset P_((void)); extern const char *Error_Tag; /* will be removed in the near future */ @@ -110,8 +110,8 @@ extern Object P_Require P_((int, Object*)); */ extern int GC_Debug; extern Object Alloc_Object P_((int, int, int)); -extern Register_Before_GC P_((void (*)(void))); -extern Register_After_GC P_((void (*)(void))); +extern void Register_Before_GC P_((void (*)(void))); +extern void Register_After_GC P_((void (*)(void))); extern Object P_Collect P_((void)); extern Object P_Garbage_Collect_Status P_((int, Object *)); #ifdef GENERATIONAL_GC @@ -122,7 +122,7 @@ extern Object P_Garbage_Collect_Status P_((int, Object *)); */ extern Object Curr_Input_Port, Curr_Output_Port; extern Object Standard_Input_Port, Standard_Output_Port; -extern Reset_IO P_((int)); +extern void Reset_IO P_((int)); extern Object P_Current_Input_Port P_((void)); extern Object P_Current_Output_Port P_((void)); extern Object P_Input_Portp P_((Object)); @@ -182,7 +182,7 @@ extern Object P_Caaaar P_((Object)); extern Object P_Caaadr P_((Object)); extern Object P_Caadar P_((Object)); extern Object P_Caaddr P_((Object)); -extern Object P_Cadaar P_((Object)); +extern Object P_Cadaar P_((Object)); extern Object P_Cadadr P_((Object)); extern Object P_Caddar P_((Object)); extern Object P_Cadddr P_((Object)); @@ -220,15 +220,15 @@ extern void Elk_Init P_((int, char **av, int, char *)); /* malloc() and realloc() */ -extern char *Safe_Malloc P_((unsigned)); -extern char *Safe_Realloc P_((char*, unsigned)); +extern char *Safe_Malloc P_((unsigned int)); +extern char *Safe_Realloc P_((char*, unsigned int)); /* Numbers */ extern Object Make_Integer P_((int)); -extern Object Make_Unsigned P_((unsigned)); -extern Object Make_Long P_((long)); -extern Object Make_Unsigned_Long P_((unsigned long)); +extern Object Make_Unsigned P_((unsigned int)); +extern Object Make_Long P_((long int)); +extern Object Make_Unsigned_Long P_((unsigned long int)); extern Object Make_Reduced_Flonum P_((double)); extern Object Make_Flonum P_((double)); extern Object P_Numberp P_((Object)); @@ -281,23 +281,23 @@ extern Object P_Random P_((void)); extern Object P_Srandom P_((Object)); extern Object P_Number_To_String P_((int, Object*)); extern double Get_Double P_((Object)); -extern Get_Integer P_((Object)); -extern unsigned Get_Unsigned P_((Object)); -extern long Get_Long P_((Object)); -extern unsigned long Get_Unsigned_Long P_((Object)); -extern Get_Exact_Integer P_((Object)); -extern unsigned Get_Exact_Unsigned P_((Object)); -extern long Get_Exact_Long P_((Object)); -extern unsigned long Get_Exact_Unsigned_Long P_((Object)); +extern int Get_Integer P_((Object)); +extern unsigned int Get_Unsigned P_((Object)); +extern long int Get_Long P_((Object)); +extern unsigned long int Get_Unsigned_Long P_((Object)); +extern int Get_Exact_Integer P_((Object)); +extern unsigned int Get_Exact_Unsigned P_((Object)); +extern long int Get_Exact_Long P_((Object)); +extern unsigned long int Get_Exact_Unsigned_Long P_((Object)); /* Onfork handlers */ -extern Register_Onfork P_((void (*)(void))); +extern void Register_Onfork P_((void (*)(void))); extern void Call_Onfork P_((void)); /* Define_Primitive() */ -extern Define_Primitive P_((Object (*)(ELLIPSIS), const char*, int, int, +extern void Define_Primitive P_((Object (*)(ELLIPSIS), const char*, int, int, enum discipline)); /* Output @@ -311,12 +311,12 @@ extern Object P_Clear_Output_Port P_((int, Object*)); extern Object P_Flush_Output_Port P_((int, Object*)); extern Object P_Print P_((int, Object*)); extern Object P_Get_Output_String P_((Object)); -extern Check_Output_Port P_((Object)); -extern Discard_Output P_((Object)); -extern Printf P_((ELLIPSIS)); -extern Print_Object P_((Object, Object, int, int, int)); -extern General_Print_Object P_((Object, Object, int)); -extern Format P_((Object, const char*, int, int, Object*)); +extern void Check_Output_Port P_((Object)); +extern void Discard_Output P_((Object)); +extern void Printf P_((ELLIPSIS)); +extern void Print_Object P_((Object, Object, int, int, int)); +extern void General_Print_Object P_((Object, Object, int)); +extern void Format P_((Object, const char*, int, int, Object*)); extern int Saved_Errno; /* Evaluator, procedures, macros @@ -337,7 +337,7 @@ extern Object P_Macro_Expand P_((Object)); extern Object P_Primitivep P_((Object)); extern Object P_Compoundp P_((Object)); extern Object P_Macrop P_((Object)); -extern Check_Procedure P_((Object)); +extern void Check_Procedure P_((Object)); /* Delay and force */ @@ -356,8 +356,8 @@ extern Object P_Unread_Char P_((int, Object*)); extern Object P_Read_String P_((int, Object*)); extern Object P_Clear_Input_Port P_((int, Object*)); extern Object General_Read P_((Object, int)); -extern Check_Input_Port P_((Object)); -extern Discard_Input P_((Object)); +extern void Check_Input_Port P_((Object)); +extern void Discard_Input P_((Object)); extern void Define_Reader P_((int, READFUN)); /* Special forms @@ -426,8 +426,8 @@ extern Object Sym_Else; extern Object Var_Get P_((Object)); extern void Var_Set P_((Object, Object)); extern int Var_Is_True P_((Object)); -extern unsigned long Symbols_To_Bits P_((Object, int, SYMDESCR*)); -extern Object Bits_To_Symbols P_((unsigned long, int, SYMDESCR*)); +extern unsigned long int Symbols_To_Bits P_((Object, int, SYMDESCR*)); +extern Object Bits_To_Symbols P_((unsigned long int, int, SYMDESCR*)); /* Termination functions */ @@ -441,9 +441,10 @@ extern void Terminate_Type P_((int)); */ extern TYPEDESCR *Types; extern Object P_Type P_((Object)); -extern Wrong_Type P_((Object, int)); -extern Wrong_Type_Combination P_((Object, const char*)); -extern Define_Type P_((int, const char*, int (*)(Object), int, +extern void Wrong_Type P_((Object, int)) __attribute__ ((__noreturn__)); +extern void Wrong_Type_Combination P_((Object, const char*)) + __attribute__ ((__noreturn__)); +extern int Define_Type P_((int, const char*, int (*)(Object), int, int (*)(Object, Object), int (*)(Object, Object), int (*)(Object, Object, int, int, int), int (*)(Object*, int (*)(Object*)) )); diff --git a/include/gc.h b/include/gc.h index dd6ee59..dc08214 100644 --- a/include/gc.h +++ b/include/gc.h @@ -88,7 +88,7 @@ extern GCNODE *GC_List; #define GC_Unlink (GC_List = gc1.next) C_LINKAGE_BEGIN -extern Func_Global_GC_Link P_((Object*)); +extern void Func_Global_GC_Link P_((Object*)); C_LINKAGE_END #define Global_GC_Link(x) Func_Global_GC_Link(&x) diff --git a/include/intern.h b/include/intern.h index df39e16..cdaaa92 100644 --- a/include/intern.h +++ b/include/intern.h @@ -33,11 +33,11 @@ extern unsigned long Bignum_To_Unsigned_Long P_((Object)); extern long Bignum_To_Long P_((Object)); extern Object Bignum_To_String P_((Object, int)); extern double Bignum_To_Double P_((Object)); -extern Bignum_Equal P_((Object, Object)); -extern Bignum_Greater P_((Object, Object)); -extern Bignum_Less P_((Object, Object)); -extern Bignum_Eq_Less P_((Object, Object)); -extern Bignum_Eq_Greater P_((Object, Object)); +extern int Bignum_Equal P_((Object, Object)); +extern int Bignum_Greater P_((Object, Object)); +extern int Bignum_Less P_((Object, Object)); +extern int Bignum_Eq_Less P_((Object, Object)); +extern int Bignum_Eq_Greater P_((Object, Object)); /* cont.c */ @@ -105,7 +105,7 @@ extern char *Flonum_To_String P_((Object)); /* proc.c */ extern Object Sym_Lambda, Sym_Macro; -extern Funcall_Control_Point P_((Object, Object, int)); +extern void Funcall_Control_Point P_((Object, Object, int)); extern Object Make_Primitive P_((Object(*)(ELLIPSIS), const char*, int, int, enum discipline)); @@ -137,7 +137,7 @@ extern Object Unbound, Special, Zero, One; /* type.c */ -extern Num_Types, Max_Type; +extern int Num_Types, Max_Type; /* vector.c */ diff --git a/include/misc.h b/include/misc.h index ab10c3e..efbb167 100644 --- a/include/misc.h +++ b/include/misc.h @@ -50,7 +50,7 @@ extern Object False2; /* Used in special forms: */ extern int Tail_Call; -#define TC_Prolog register _t = Tail_Call +#define TC_Prolog register int _t = Tail_Call #define TC_Disable Tail_Call = 0 #define TC_Enable Tail_Call = _t diff --git a/include/object.h b/include/object.h index a74062b..02cc539 100644 --- a/include/object.h +++ b/include/object.h @@ -45,7 +45,7 @@ typedef struct { extern gcspace_t *space; extern gcspace_t current_space; C_LINKAGE_BEGIN - extern Visit P_((Object*)); /* required for REVIVE_OBJ below */ + extern int Visit P_((Object*)); /* required for REVIVE_OBJ below */ C_LINKAGE_END # ifdef ARRAY_BROKEN @@ -64,6 +64,9 @@ typedef struct { (space[OBJ_TO_PAGE(obj)] == current_space)) # define REVIVE_OBJ(obj) Visit (&obj); #else + C_LINKAGE_BEGIN + extern int Visit P_((Object*)); /* required in heap.c */ + C_LINKAGE_END # define IS_ALIVE(obj) WAS_FORWARDED(obj) # define REVIVE_OBJ(obj) #endif diff --git a/include/type.h b/include/type.h index bfddd19..c1a6548 100644 --- a/include/type.h +++ b/include/type.h @@ -10,14 +10,14 @@ } #define Check_Number(x) {\ - register t = TYPE(x);\ + register int t = TYPE(x);\ if (!Numeric (t)) Wrong_Type_Combination (x, "number");\ } /* This should be renamed; it checks whether x is an *exact* integer. */ #define Check_Integer(x) {\ - register t = TYPE(x);\ + register int t = TYPE(x);\ if (t != T_Fixnum && t != T_Bignum) Wrong_Type (x, T_Fixnum);\ } diff --git a/lib/misc/bitstring.c b/lib/misc/bitstring.c index 4444755..ef7c260 100644 --- a/lib/misc/bitstring.c +++ b/lib/misc/bitstring.c @@ -15,15 +15,15 @@ static int masks2[] = { 0, 0x1, 0x3, 0x7, 0xF, 0x1F, 0x3F, 0x7F, 0xFF }; int T_Bitstring; -static Object P_Bitstringp(x) Object x; { +static Object P_Bitstringp(Object x) { return TYPE(x) == T_Bitstring ? True : False; } -static int Bitstring_Size(b) Object b; { +static int Bitstring_Size(Object b) { return sizeof(struct S_Bitstring) + bits_to_bytes(BITSTRING(b)->len) - 1; } -static Bitstring_Equal(b1, b2) Object b1, b2; { +static Bitstring_Equal(Object b1, Object b2) { struct S_Bitstring *a = BITSTRING(b1), *b = BITSTRING(b2); if (a->len != b->len) @@ -31,11 +31,11 @@ static Bitstring_Equal(b1, b2) Object b1, b2; { return !bcmp(a->data, b->data, bits_to_bytes(a->len)); } -static Object P_Bitstring_Equalp(a, b) Object a, b; { +static Object P_Bitstring_Equalp(Object a, Object b) { return Bitstring_Equal(a, b) ? True : False; } -static char *Digits(c, n) unsigned char c; int n; { +static char *Digits(unsigned char c, int n) { static char buf[9]; int i = 0; @@ -47,7 +47,7 @@ static char *Digits(c, n) unsigned char c; int n; { /* Print starting with MSB */ -static Bitstring_Print(x, port, raw, depth, length) Object x, port; { +static Bitstring_Print(Object x, Object port, int raw, int depth, int length) { int i, rem; struct S_Bitstring *b = BITSTRING(x); GC_Node2; @@ -62,7 +62,7 @@ static Bitstring_Print(x, port, raw, depth, length) Object x, port; { GC_Unlink; } -static Object Make_Bitstring(len) unsigned len; { +static Object Make_Bitstring(unsigned int len) { Object b; int nbytes = bits_to_bytes(len); @@ -73,7 +73,7 @@ static Object Make_Bitstring(len) unsigned len; { return b; } -static void Fill_Bitstring(bs, fill) Object bs; int fill; { +static void Fill_Bitstring(Object bs, int fill) { struct S_Bitstring *b = BITSTRING(bs); int i, rem; unsigned char val = fill ? ~0 : 0; @@ -85,7 +85,7 @@ static void Fill_Bitstring(bs, fill) Object bs; int fill; { b->data[i] = val; } -static Object P_Make_Bitstring(len, init) Object len, init; { +static Object P_Make_Bitstring(Object len, Object init) { Object ret; int n, fill; diff --git a/lib/misc/newhandler.c b/lib/misc/newhandler.c index 025ab69..aa7ab52 100644 --- a/lib/misc/newhandler.c +++ b/lib/misc/newhandler.c @@ -10,7 +10,7 @@ static void New_Handler_Proc () { (void)Funcall (New_Handler, Null, 0); } -static Object P_Set_New_Handler (p) Object p; { +static Object P_Set_New_Handler (Object p) { Object old; Check_Procedure (p); diff --git a/lib/unix/fdescr.c b/lib/unix/fdescr.c index d72f29f..db2582c 100644 --- a/lib/unix/fdescr.c +++ b/lib/unix/fdescr.c @@ -249,7 +249,7 @@ static Object P_Ttyname(fd) Object fd; { return ret ? Make_String(ret, strlen(ret)) : False; } -elk_init_unix_fdescr() { +void elk_init_unix_fdescr() { Def_Prim(P_Close, "unix-close", 1, 1, EVAL); Def_Prim(P_Close_On_Exec, "unix-close-on-exec", 1, 2, VARARGS); Def_Prim(P_Dup, "unix-dup", 1, 2, VARARGS); diff --git a/lib/xlib/xlib.h b/lib/xlib/xlib.h index 41b5958..2ed67e7 100644 --- a/lib/xlib/xlib.h +++ b/lib/xlib/xlib.h @@ -136,7 +136,7 @@ extern Pixmap Get_Pixmap P_((Object)); extern Time Get_Time P_((Object)); extern Window Get_Window P_((Object)); extern XColor *Get_Color P_((Object)); -extern unsigned long Get_Pixel P_((Object)); +extern unsigned long int Get_Pixel P_((Object)); extern void Destroy_Event_Args P_((Object)); extern int Encode_Event P_((Object)); extern int Match_X_Obj P_((ELLIPSIS)); @@ -150,7 +150,7 @@ extern Object Make_Display P_((int, Display*)); extern Object Make_Font P_((Display*, Object, Font, XFontStruct*)); extern Object Make_Font_Foreign P_((Display*, Object, Font, XFontStruct*)); extern Object Make_Gc P_((int, Display*, GC)); -extern Object Make_Pixel P_((unsigned long)); +extern Object Make_Pixel P_((unsigned long int)); extern Object Make_Pixmap P_((Display*, Pixmap)); extern Object Make_Pixmap_Foreign P_((Display*, Pixmap)); extern Object Make_Window P_((int, Display*, Window)); @@ -163,8 +163,8 @@ extern Object P_Free_Gc P_((Object)); extern Object P_Free_Pixmap P_((Object)); extern Object P_Window_Unique_Id P_((Object)); extern Object Record_To_Vector - P_((RECORD*, int, Object, Display*, unsigned long)); -extern unsigned long Vector_To_Record P_((Object, int, Object, RECORD*)); + P_((RECORD*, int, Object, Display*, unsigned long int)); +extern unsigned long int Vector_To_Record P_((Object, int, Object, RECORD*)); C_LINKAGE_END @@ -178,7 +178,7 @@ extern XCharStruct CI; extern XWMHints WMH; extern XSizeHints SZH; -extern Set_Attr_Size, Conf_Size, GC_Size, Geometry_Size, Win_Attr_Size, +extern int Set_Attr_Size, Conf_Size, GC_Size, Geometry_Size, Win_Attr_Size, Font_Info_Size, Char_Info_Size, Wm_Hints_Size, Size_Hints_Size; extern RECORD Set_Attr_Rec[], Conf_Rec[], GC_Rec[], Geometry_Rec[], Win_Attr_Rec[], Font_Info_Rec[], Char_Info_Rec[], Wm_Hints_Rec[], diff --git a/scm/build b/scm/build index 09cf47c..73ed248 100755 --- a/scm/build +++ b/scm/build @@ -43,22 +43,22 @@ siteinfo.scm: ../config/system ../config/site \$(SHELL) ./build-siteinfo install: \$(TARGETS) - -@if [ ! -d $install_dir/lib ]; then \\ - echo mkdir $install_dir/lib; \\ - mkdir $install_dir/lib; \\ + -@if [ ! -d $install_dir/share ]; then \\ + echo mkdir $install_dir/share; \\ + mkdir $install_dir/share; \\ fi - -@if [ ! -d $install_dir/lib/elk ]; then \\ - echo mkdir $install_dir/lib/elk; \\ - mkdir $install_dir/lib/elk; \\ + -@if [ ! -d $install_dir/share/elk ]; then \\ + echo mkdir $install_dir/share/elk; \\ + mkdir $install_dir/share/elk; \\ fi - -@if [ ! -d $install_dir/lib/elk/scm ]; then \\ - echo mkdir $install_dir/lib/elk/scm; \\ - mkdir $install_dir/lib/elk/scm; \\ + -@if [ ! -d $install_dir/share/elk/scm ]; then \\ + echo mkdir $install_dir/share/elk/scm; \\ + mkdir $install_dir/share/elk/scm; \\ fi @for i in \$(FILES) ;\\ do \\ - echo cp \$\$i $install_dir/lib/elk/scm; \\ - cp \$\$i $install_dir/lib/elk/scm; \\ + echo cp \$\$i $install_dir/share/elk/scm; \\ + cp \$\$i $install_dir/share/elk/scm; \\ done lint: diff --git a/scm/initscheme.scm b/scm/initscheme.scm index 476de0f..6fd3220 100644 --- a/scm/initscheme.scm +++ b/scm/initscheme.scm @@ -33,6 +33,8 @@ (define call/cc call-with-current-continuation) +(define quit exit) + ;;; Backwards compatibility. These procedures are really obsolete; ;;; please do not use them any longer. diff --git a/src/autoload.c b/src/autoload.c index f824683..2322864 100644 --- a/src/autoload.c +++ b/src/autoload.c @@ -2,11 +2,11 @@ Object V_Autoload_Notifyp; -Init_Auto () { +void Init_Auto (void) { Define_Variable (&V_Autoload_Notifyp, "autoload-notify?", True); } -Object P_Autoload (sym, files) Object sym, files; { +Object P_Autoload (Object sym, Object files) { Object al, ret; GC_Node3; @@ -24,7 +24,7 @@ Object P_Autoload (sym, files) Object sym, files; { return ret; } -Object Do_Autoload (sym, al) Object sym, al; { +Object Do_Autoload (Object sym, Object al) { Object val, a[1]; GC_Node; diff --git a/src/bignum.c b/src/bignum.c index 2efcf3c..8ec11d9 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -1,11 +1,16 @@ #include #include +#include #include "kernel.h" -Object Make_Uninitialized_Bignum (size) { +static void Bignum_Mult_In_Place (register struct S_Bignum *, int); +static void Bignum_Add_In_Place (register struct S_Bignum *, int); +static int Bignum_Div_In_Place (register struct S_Bignum *, int); + +Object Make_Uninitialized_Bignum (int size) { Object big; - + big = Alloc_Object ((sizeof (struct S_Bignum) - sizeof (gran_t)) + (size * sizeof (gran_t)), T_Bignum, 0); BIGNUM(big)->minusp = False; @@ -14,43 +19,41 @@ Object Make_Uninitialized_Bignum (size) { return big; } -Object Copy_Bignum (x) Object x; { +Object Copy_Bignum (Object x) { Object big; - register size; + register int size; GC_Node; GC_Link (x); big = Make_Uninitialized_Bignum (size = BIGNUM(x)->usize); BIGNUM(big)->minusp = BIGNUM(x)->minusp; BIGNUM(big)->usize = size; - bcopy ((char *)BIGNUM(x)->data, (char *)BIGNUM(big)->data, - size * sizeof (gran_t)); + memcpy (BIGNUM(big)->data, BIGNUM(x)->data, size * sizeof (gran_t)); GC_Unlink; return big; } -Object Copy_S_Bignum (s) struct S_Bignum *s; { +Object Copy_S_Bignum (struct S_Bignum *s) { Object big; - register size; + register int size; big = Make_Uninitialized_Bignum (size = s->usize); BIGNUM(big)->minusp = s->minusp; BIGNUM(big)->usize = size; - bcopy ((char *)s->data, (char *)BIGNUM(big)->data, - size * sizeof (gran_t)); + memcpy (BIGNUM(big)->data, s->data, size * sizeof (gran_t)); return big; } -Object Make_Bignum (buf, neg, radix) const char *buf; { +Object Make_Bignum (char const *buf, int neg, int radix) { Object big; - register const char *p; - register c; - register size = (strlen (buf) + 4) / 4; + register char const *p; + register int c; + register int size = (strlen (buf) + 4) / 4; big = Make_Uninitialized_Bignum (size); BIGNUM(big)->minusp = neg ? True : False; p = buf; - while (c = *p++) { + while ((c = *p++)) { Bignum_Mult_In_Place (BIGNUM(big), radix); if (radix == 16) { if (isupper (c)) @@ -64,32 +67,32 @@ Object Make_Bignum (buf, neg, radix) const char *buf; { return big; } -Object Reduce_Bignum (x) Object x; { - unsigned ret = 0; +Object Reduce_Bignum (Object x) { + unsigned int ret = 0; int i, shift = 0, size = BIGNUM(x)->usize; int digits = sizeof(int)/2; if (size > digits) return x; for (i = 0; i < digits && i < size; i++, shift += 16) - ret |= (unsigned)BIGNUM(x)->data[i] << shift; + ret |= (unsigned int)BIGNUM(x)->data[i] << shift; if (Truep (BIGNUM(x)->minusp)) { - if (ret > (~(unsigned)0 >> 1) + 1) + if (ret > (~(unsigned int)0 >> 1) + 1) return x; return Make_Integer (-ret); } else { - if (ret > ~(unsigned)0 >> 1) + if (ret > ~(unsigned int)0 >> 1) return x; return Make_Integer (ret); } } -Bignum_Mult_In_Place (x, n) register struct S_Bignum *x; { - register i = x->usize; +static void Bignum_Mult_In_Place (register struct S_Bignum *x, int n) { + register int i = x->usize; register gran_t *p = x->data; - register j; - register unsigned k = 0; - + register int j; + register unsigned int k = 0; + for (j = 0; j < i; ++j) { k += n * *p; *p++ = k; @@ -103,11 +106,11 @@ Bignum_Mult_In_Place (x, n) register struct S_Bignum *x; { } } -Bignum_Add_In_Place (x, n) register struct S_Bignum *x; { - register i = x->usize; +static void Bignum_Add_In_Place (register struct S_Bignum *x, int n) { + register int i = x->usize; register gran_t *p = x->data; - register j = 0; - register unsigned k = n; + register int j = 0; + register unsigned int k = n; if (i == 0) goto extend; k += *p; @@ -126,10 +129,10 @@ Bignum_Add_In_Place (x, n) register struct S_Bignum *x; { } } -Bignum_Div_In_Place (x, n) register struct S_Bignum *x; { - register i = x->usize; +static int Bignum_Div_In_Place (register struct S_Bignum *x, int n) { + register int i = x->usize; register gran_t *p = x->data + i; - register unsigned k = 0; + register unsigned int k = 0; for ( ; i; --i) { k <<= 16; k += *--p; @@ -140,8 +143,8 @@ Bignum_Div_In_Place (x, n) register struct S_Bignum *x; { return k; } -Bignum_Normalize_In_Place (x) register struct S_Bignum *x; { - register i = x->usize; +void Bignum_Normalize_In_Place (register struct S_Bignum *x) { + register int i = x->usize; register gran_t *p = x->data + i; while (i && !*--p) --i; @@ -150,18 +153,18 @@ Bignum_Normalize_In_Place (x) register struct S_Bignum *x; { x->minusp = False; } -Print_Bignum (port, x) Object port, x; { +void Print_Bignum (Object port, Object x) { register char *p; char *buf; - register size; + register int size; struct S_Bignum *big; Alloca_Begin; - + if (Bignum_Zero (x)) { Printf (port, "0"); return; } - + size = BIGNUM(x)->usize * 5 + 3; Alloca (buf, char*, size + 1); p = buf + size; @@ -170,11 +173,11 @@ Print_Bignum (port, x) Object port, x; { size = (sizeof (struct S_Bignum) - sizeof (gran_t)) + BIGNUM(x)->usize * sizeof (gran_t); Alloca (big, struct S_Bignum*, size); - bcopy ((char *)POINTER(x), (char *)big, size); + memcpy (big, POINTER(x), size); big->size = BIGNUM(x)->usize; while (big->usize) { - register unsigned bigdig = Bignum_Div_In_Place (big, 10000); + register unsigned int bigdig = Bignum_Div_In_Place (big, 10000); *--p = '0' + bigdig % 10; bigdig /= 10; *--p = '0' + bigdig % 10; @@ -191,17 +194,17 @@ Print_Bignum (port, x) Object port, x; { Alloca_End; } -Object Bignum_To_String (x, radix) Object x; { +Object Bignum_To_String (Object x, int radix) { register char *p; char *buf; - register unsigned div, ndig, size; + register unsigned int div, ndig, size; struct S_Bignum *big; Object ret; Alloca_Begin; - + if (Bignum_Zero (x)) return Make_String ("0", 1); - + size = BIGNUM(x)->usize * (radix == 2 ? 17 : 6) + 3; Alloca (buf, char*, size + 1); p = buf + size; @@ -210,7 +213,7 @@ Object Bignum_To_String (x, radix) Object x; { size = (sizeof (struct S_Bignum) - sizeof (gran_t)) + BIGNUM(x)->usize * sizeof (gran_t); Alloca (big, struct S_Bignum*, size); - bcopy ((char *)POINTER(x), (char *)big, size); + memcpy (big, POINTER(x), size); big->size = BIGNUM(x)->usize; switch (radix) { @@ -221,12 +224,13 @@ Object Bignum_To_String (x, radix) Object x; { case 10: div = 10000; ndig = 4; break; case 16: + default: /* Just to avoid compiler warnings */ div = 65536; ndig = 4; break; } while (big->usize) { - register unsigned bigdig = Bignum_Div_In_Place (big, div); - register i; + register unsigned int bigdig = Bignum_Div_In_Place (big, div); + register int i; for (i = 0; i < ndig; i++) { *--p = '0' + bigdig % radix; if (*p > '9') @@ -243,8 +247,8 @@ Object Bignum_To_String (x, radix) Object x; { return ret; } -Bignum_To_Integer (x) Object x; { - unsigned ret = 0; +int Bignum_To_Integer (Object x) { + unsigned int ret = 0; int i, shift = 0, size = BIGNUM(x)->usize; int digits = sizeof(int)/2; @@ -252,32 +256,32 @@ Bignum_To_Integer (x) Object x; { err: Primitive_Error ("integer out of range: ~s", x); for (i = 0; i < digits && i < size; i++, shift += 16) - ret |= (unsigned)BIGNUM(x)->data[i] << shift; + ret |= (unsigned int)BIGNUM(x)->data[i] << shift; if (Truep (BIGNUM(x)->minusp)) { - if (ret > (~(unsigned)0 >> 1) + 1) + if (ret > (~(unsigned int)0 >> 1) + 1) goto err; return -ret; } else { - if (ret > ~(unsigned)0 >> 1) + if (ret > ~(unsigned int)0 >> 1) goto err; return ret; } } -unsigned Bignum_To_Unsigned (x) Object x; { - unsigned ret = 0; +unsigned int Bignum_To_Unsigned (Object x) { + unsigned int ret = 0; int i, shift = 0, size = BIGNUM(x)->usize; int digits = sizeof(int)/2; if (size > digits || Truep (BIGNUM(x)->minusp)) Primitive_Error ("integer out of range: ~s", x); for (i = 0; i < digits && i < size; i++, shift += 16) - ret |= (unsigned)BIGNUM(x)->data[i] << shift; + ret |= (unsigned int)BIGNUM(x)->data[i] << shift; return ret; } -long Bignum_To_Long (x) Object x; { - unsigned long ret = 0; +long Bignum_To_Long (Object x) { + unsigned long int ret = 0; int i, shift = 0, size = BIGNUM(x)->usize; int digits = sizeof(long)/2; @@ -285,34 +289,34 @@ long Bignum_To_Long (x) Object x; { err: Primitive_Error ("integer out of range: ~s", x); for (i = 0; i < digits && i < size; i++, shift += 16) - ret |= (unsigned long)BIGNUM(x)->data[i] << shift; + ret |= (unsigned long int)BIGNUM(x)->data[i] << shift; if (Truep (BIGNUM(x)->minusp)) { - if (ret > (~(unsigned long)0 >> 1) + 1) + if (ret > (~(unsigned long int)0 >> 1) + 1) goto err; return -ret; } else { - if (ret > ~(unsigned long)0 >> 1) + if (ret > ~(unsigned long int)0 >> 1) goto err; return ret; } } -unsigned long Bignum_To_Unsigned_Long (x) Object x; { - unsigned long ret = 0; +unsigned long int Bignum_To_Unsigned_Long (Object x) { + unsigned long int ret = 0; int i, shift = 0, size = BIGNUM(x)->usize; int digits = sizeof(long)/2; if (size > digits || Truep (BIGNUM(x)->minusp)) Primitive_Error ("integer out of range: ~s", x); for (i = 0; i < digits && i < size; i++, shift += 16) - ret |= (unsigned long)BIGNUM(x)->data[i] << shift; + ret |= (unsigned long int)BIGNUM(x)->data[i] << shift; return ret; } -Object Integer_To_Bignum (i) { +Object Integer_To_Bignum (int i) { int k, digits = sizeof(int)/2; - Object big; - unsigned n = i; + Object big; + unsigned int n = i; big = Make_Uninitialized_Bignum (digits); if (i < 0) { @@ -326,10 +330,10 @@ Object Integer_To_Bignum (i) { return big; } -Object Unsigned_To_Bignum (i) unsigned i; { +Object Unsigned_To_Bignum (unsigned int i) { int k, digits = sizeof(int)/2; Object big; - + big = Make_Uninitialized_Bignum (digits); for (k = 0; k < digits; k++, i >>= 16) BIGNUM(big)->data[k] = i & 0xffff; @@ -338,10 +342,10 @@ Object Unsigned_To_Bignum (i) unsigned i; { return big; } -Object Long_To_Bignum (i) long i; { +Object Long_To_Bignum (long i) { int k, digits = sizeof(long)/2; Object big; - unsigned long n = i; + unsigned long int n = i; big = Make_Uninitialized_Bignum (digits); if (i < 0) { @@ -355,10 +359,10 @@ Object Long_To_Bignum (i) long i; { return big; } -Object Unsigned_Long_To_Bignum (i) unsigned long i; { +Object Unsigned_Long_To_Bignum (unsigned long int i) { int k, digits = sizeof(long)/2; Object big; - + big = Make_Uninitialized_Bignum (digits); for (k = 0; k < digits; k++, i >>= 16) BIGNUM(big)->data[k] = i & 0xffff; @@ -367,12 +371,12 @@ Object Unsigned_Long_To_Bignum (i) unsigned long i; { return big; } -Object Double_To_Bignum (d) double d; { /* Truncates the double */ +Object Double_To_Bignum (double d) { /* Truncates the double */ Object big; int expo, size; double mantissa = frexp (d, &expo); register gran_t *p; - + if (expo <= 0 || mantissa == 0.0) return Make_Uninitialized_Bignum (0); size = (expo + (16-1)) / 16; @@ -383,7 +387,7 @@ Object Double_To_Bignum (d) double d; { /* Truncates the double */ mantissa = -mantissa; } p = BIGNUM(big)->data; - bzero ((char *)p, size * sizeof (gran_t)); + memset (p, 0, size * sizeof (gran_t)); p += size; if (expo &= (16-1)) mantissa = ldexp (mantissa, expo - 16); @@ -398,9 +402,9 @@ Object Double_To_Bignum (d) double d; { /* Truncates the double */ return Reduce_Bignum (big); } -double Bignum_To_Double (x) Object x; { /* error if it ain't fit */ +double Bignum_To_Double (Object x) { /* error if it ain't fit */ double rx = 0.0; - register i = BIGNUM(x)->usize; + register int i = BIGNUM(x)->usize; register gran_t *p = BIGNUM(x)->data + i; for (i = BIGNUM(x)->usize; --i >= 0; ) { @@ -414,23 +418,23 @@ double Bignum_To_Double (x) Object x; { /* error if it ain't fit */ return rx; } -Bignum_Zero (x) Object x; { +int Bignum_Zero (Object x) { return BIGNUM(x)->usize == 0; } -Bignum_Negative (x) Object x; { +int Bignum_Negative (Object x) { return Truep (BIGNUM(x)->minusp); } -Bignum_Positive (x) Object x; { +int Bignum_Positive (Object x) { return !Truep (BIGNUM(x)->minusp) && BIGNUM(x)->usize != 0; } -Bignum_Even (x) Object x; { +int Bignum_Even (Object x) { return BIGNUM(x)->usize == 0 || (BIGNUM(x)->data[0] & 1) == 0; } -Object Bignum_Abs (x) Object x; { +Object Bignum_Abs (Object x) { Object big; big = Copy_Bignum (x); @@ -438,8 +442,9 @@ Object Bignum_Abs (x) Object x; { return big; } -Bignum_Mantissa_Cmp (x, y) register struct S_Bignum *x, *y; { - register i = x->usize; +int Bignum_Mantissa_Cmp (register struct S_Bignum *x, + register struct S_Bignum *y) { + register int i = x->usize; if (i < y->usize) return -1; else if (i > y->usize) @@ -448,17 +453,17 @@ Bignum_Mantissa_Cmp (x, y) register struct S_Bignum *x, *y; { register gran_t *xbuf = x->data + i; register gran_t *ybuf = y->data + i; for ( ; i; --i) { - register n; - if (n = (int)*--xbuf - (int)*--ybuf) + register int n; + if ((n = (int)*--xbuf - (int)*--ybuf)) return n; } return 0; } } -Bignum_Cmp (x, y) register struct S_Bignum *x, *y; { - register xm = Truep (x->minusp); - register ym = Truep (y->minusp); +int Bignum_Cmp (register struct S_Bignum *x, register struct S_Bignum *y) { + register int xm = Truep (x->minusp); + register int ym = Truep (y->minusp); if (xm) { if (ym) return -Bignum_Mantissa_Cmp (x, y); @@ -470,27 +475,27 @@ Bignum_Cmp (x, y) register struct S_Bignum *x, *y; { } } -Bignum_Equal (x, y) Object x, y; { +int Bignum_Equal (Object x, Object y) { return Bignum_Cmp (BIGNUM(x), BIGNUM(y)) == 0; } -Bignum_Less (x, y) Object x, y; { +int Bignum_Less (Object x, Object y) { return Bignum_Cmp (BIGNUM(x), BIGNUM(y)) < 0; } -Bignum_Greater (x, y) Object x, y; { +int Bignum_Greater (Object x, Object y) { return Bignum_Cmp (BIGNUM(x), BIGNUM(y)) > 0; } -Bignum_Eq_Less (x, y) Object x, y; { +int Bignum_Eq_Less (Object x, Object y) { return Bignum_Cmp (BIGNUM(x), BIGNUM(y)) <= 0; } -Bignum_Eq_Greater (x, y) Object x, y; { +int Bignum_Eq_Greater (Object x, Object y) { return Bignum_Cmp (BIGNUM(x), BIGNUM(y)) >= 0; } -Object General_Bignum_Plus_Minus (x, y, neg) Object x, y; { +Object General_Bignum_Plus_Minus (Object x, Object y, int neg) { Object big; int size, xsize, ysize, xminusp, yminusp; GC_Node2; @@ -511,8 +516,8 @@ Object General_Bignum_Plus_Minus (x, y, neg) Object x, y; { if (xminusp == yminusp) { /* Add x and y */ - register unsigned k = 0; - register i; + register unsigned int k = 0; + register int i; register gran_t *xbuf = BIGNUM(x)->data; register gran_t *ybuf = BIGNUM(y)->data; register gran_t *zbuf = BIGNUM(big)->data; @@ -527,7 +532,7 @@ Object General_Bignum_Plus_Minus (x, y, neg) Object x, y; { } else { if (Bignum_Mantissa_Cmp (BIGNUM(x), BIGNUM(y)) < 0) { Object temp; - + temp = x; x = y; y = temp; xsize = ysize; ysize = BIGNUM(y)->usize; @@ -535,8 +540,8 @@ Object General_Bignum_Plus_Minus (x, y, neg) Object x, y; { } /* Subtract y from x */ { - register unsigned k = 1; - register i; + register unsigned int k = 1; + register int i; register gran_t *xbuf = BIGNUM(x)->data; register gran_t *ybuf = BIGNUM(y)->data; register gran_t *zbuf = BIGNUM(big)->data; @@ -557,22 +562,22 @@ Object General_Bignum_Plus_Minus (x, y, neg) Object x, y; { return Reduce_Bignum (big); } -Object Bignum_Plus (x, y) Object x, y; { /* bignum + bignum */ +Object Bignum_Plus (Object x, Object y) { /* bignum + bignum */ return General_Bignum_Plus_Minus (x, y, 0); } -Object Bignum_Minus (x, y) Object x, y; { /* bignum - bignum */ +Object Bignum_Minus (Object x, Object y) { /* bignum - bignum */ return General_Bignum_Plus_Minus (x, y, 1); } -Object Bignum_Fixnum_Multiply (x, y) Object x, y; { /* bignum * fixnum */ +Object Bignum_Fixnum_Multiply (Object x, Object y) { /* bignum * fixnum */ Object big; - register size, xsize, i; + register int size, xsize, i; register gran_t *xbuf, *zbuf; int fix = FIXNUM(y); - register unsigned yl, yh; + register unsigned int yl, yh; GC_Node; - + GC_Link (x); xsize = BIGNUM(x)->usize; size = xsize + 2; @@ -580,7 +585,7 @@ Object Bignum_Fixnum_Multiply (x, y) Object x, y; { /* bignum * fixnum */ BIGNUM(big)->usize = size; if (Truep (BIGNUM(x)->minusp) != (fix < 0)) BIGNUM(big)->minusp = True; - bzero ((char *)BIGNUM(big)->data, size * sizeof (gran_t)); + memset (BIGNUM(big)->data, 0, size * sizeof (gran_t)); xbuf = BIGNUM(x)->data; if (fix < 0) fix = -fix; @@ -588,8 +593,8 @@ Object Bignum_Fixnum_Multiply (x, y) Object x, y; { /* bignum * fixnum */ yh = fix >> 16; zbuf = BIGNUM(big)->data; for (i = 0; i < xsize; ++i) { - register unsigned xf = xbuf[i]; - register unsigned k = 0; + register unsigned int xf = xbuf[i]; + register unsigned int k = 0; register gran_t *r = zbuf + i; k += xf * yl + *r; *r++ = k; @@ -604,12 +609,12 @@ Object Bignum_Fixnum_Multiply (x, y) Object x, y; { /* bignum * fixnum */ return Reduce_Bignum (big); } -Object Bignum_Multiply (x, y) Object x, y; { /* bignum * bignum */ +Object Bignum_Multiply (Object x, Object y) { /* bignum * bignum */ Object big; - register size, xsize, ysize, i, j; + register int size, xsize, ysize, i, j; register gran_t *xbuf, *ybuf, *zbuf; GC_Node2; - + GC_Link2 (x, y); xsize = BIGNUM(x)->usize; ysize = BIGNUM(y)->usize; @@ -618,13 +623,13 @@ Object Bignum_Multiply (x, y) Object x, y; { /* bignum * bignum */ BIGNUM(big)->usize = size; if (!EQ(BIGNUM(x)->minusp, BIGNUM(y)->minusp)) BIGNUM(big)->minusp = True; - bzero ((char *)BIGNUM(big)->data, size * sizeof (gran_t)); + memset (BIGNUM(big)->data, 0, size * sizeof (gran_t)); xbuf = BIGNUM(x)->data; ybuf = BIGNUM(y)->data; zbuf = BIGNUM(big)->data; for (i = 0; i < xsize; ++i) { - register unsigned xf = xbuf[i]; - register unsigned k = 0; + register unsigned int xf = xbuf[i]; + register unsigned int k = 0; register gran_t *p = ybuf; register gran_t *r = zbuf + i; for (j = 0; j < ysize; ++j) { @@ -641,13 +646,13 @@ Object Bignum_Multiply (x, y) Object x, y; { /* bignum * bignum */ /* Returns cons cell (quotient . remainder); cdr is a fixnum */ -Object Bignum_Fixnum_Divide (x, y) Object x, y; { /* bignum / fixnum */ +Object Bignum_Fixnum_Divide (Object x, Object y) { /* bignum / fixnum */ Object big; - register xsize, i; + register int xsize, i; register gran_t *xbuf, *zbuf; int fix = FIXNUM(y); int xminusp, yminusp = 0; - register unsigned rem; + register unsigned int rem; GC_Node; GC_Link (x); @@ -684,10 +689,10 @@ Object Bignum_Fixnum_Divide (x, y) Object x, y; { /* bignum / fixnum */ /* Returns cons cell (quotient . remainder); cdr is a fixnum */ -Object Bignum_Divide (x, y) Object x, y; { /* bignum / bignum */ +Object Bignum_Divide (Object x, Object y) { /* bignum / bignum */ struct S_Bignum *dend, *dor; int quotsize, dendsize, dorsize, scale; - unsigned dor1, dor2; + unsigned int dor1, dor2; Object quot, rem; register gran_t *qp, *dendp; GC_Node2; @@ -706,7 +711,7 @@ Object Bignum_Divide (x, y) Object x, y; { /* bignum / bignum */ dendsize = (sizeof (struct S_Bignum) - sizeof (gran_t)) + (BIGNUM(x)->usize + 1) * sizeof (gran_t); Alloca (dend, struct S_Bignum*, dendsize); - bcopy ((char *)POINTER(x), (char *)dend, dendsize); + memcpy (dend, POINTER(x), dendsize); dend->size = BIGNUM(x)->usize + 1; if (quotsize == 0 || Bignum_Mantissa_Cmp (dend, BIGNUM(y)) < 0) @@ -715,7 +720,7 @@ Object Bignum_Divide (x, y) Object x, y; { /* bignum / bignum */ dorsize = (sizeof (struct S_Bignum) - sizeof (gran_t)) + BIGNUM (y)->usize * sizeof (gran_t); Alloca (dor, struct S_Bignum*, dorsize); - bcopy ((char *)POINTER(y), (char *)dor, dorsize); + memcpy (dor, POINTER(y), dorsize); dor->size = dorsize = BIGNUM(y)->usize; scale = 65536 / (unsigned int)(dor->data[dor->usize - 1] + 1); @@ -729,18 +734,18 @@ Object Bignum_Divide (x, y) Object x, y; { /* bignum / bignum */ dendp = dend->data + dend->usize; dor1 = dor->data[dor->usize - 1]; dor2 = dor->data[dor->usize - 2]; - + while (qp > BIGNUM(quot)->data) { - unsigned msw, guess; + unsigned int msw, guess; int k; register gran_t *dep, *dop, *edop; - + msw = dendp[-1] << 16 | dendp[-2]; guess = msw / dor1; if (guess >= 65536) /* [65535, 0, 0] / [65535, 65535] */ guess = 65535; for (;;) { - unsigned d1, d2, d3; + unsigned int d1, d2, d3; d3 = dor2 * guess; d2 = dor1 * guess + (d3 >> 16); d3 &= 0xFFFF; @@ -756,7 +761,7 @@ Object Bignum_Divide (x, y) Object x, y; { /* bignum / bignum */ k = 0; dep = dendp - dorsize; for (dop = dor->data, edop = dop + dor->usize; dop < edop; ) { - register unsigned prod = *dop++ * guess; + register unsigned int prod = *dop++ * guess; k += *dep; k -= prod & 0xFFFF; *dep++ = k; @@ -779,7 +784,7 @@ Object Bignum_Divide (x, y) Object x, y; { /* bignum / bignum */ } *--qp = guess; } - + if (Bignum_Div_In_Place (dend, scale)) Panic ("Bignum_Div scale"); zero: diff --git a/src/bool.c b/src/bool.c index 3d5ee6d..0ec2d6d 100644 --- a/src/bool.c +++ b/src/bool.c @@ -1,27 +1,31 @@ #include "kernel.h" -Object P_Booleanp (x) Object x; { +#include + +extern int Generic_Equal (Object, Object); + +Object P_Booleanp (Object x) { return TYPE(x) == T_Boolean ? True : False; } -Object P_Not (x) Object x; { +Object P_Not (Object x) { return Truep (x) ? False : True; } -Object P_Eq (x1, x2) Object x1, x2; { +Object P_Eq (Object x1, Object x2) { return EQ(x1, x2) ? True : False; } -Object P_Eqv (x1, x2) Object x1, x2; { +Object P_Eqv (Object x1, Object x2) { return Eqv (x1, x2) ? True : False; } -Object P_Equal (x1, x2) Object x1, x2; { +Object P_Equal (Object x1, Object x2) { return Equal (x1, x2) ? True : False; } -Eqv (x1, x2) Object x1, x2; { - register t1, t2; +int Eqv (Object x1, Object x2) { + register int t1, t2; if (EQ(x1, x2)) return 1; t1 = TYPE(x1); @@ -47,8 +51,8 @@ Eqv (x1, x2) Object x1, x2; { /*NOTREACHED*/ } -Equal (x1, x2) Object x1, x2; { - register t1, t2, i; +int Equal (Object x1, Object x2) { + register int t1, t2, i; again: if (EQ(x1, x2)) @@ -104,7 +108,7 @@ again: /*NOTREACHED*/ } -Object P_Empty_List_Is_False (is_false) Object is_false; { +Object P_Empty_List_Is_False (Object is_false) { Check_Type (is_false, T_Boolean); if (Truep (is_false)) False2 = Null; diff --git a/src/char.c b/src/char.c index 9caaaac..688e0d7 100644 --- a/src/char.c +++ b/src/char.c @@ -2,69 +2,69 @@ #include "kernel.h" -Object Make_Char (c) register c; { +Object Make_Char (register int c) { Object ch; SET(ch, T_Character, (unsigned char)c); return ch; } -Object P_Charp (c) Object c; { +Object P_Charp (Object c) { return TYPE(c) == T_Character ? True : False; } -Object P_Char_To_Integer (c) Object c; { +Object P_Char_To_Integer (Object c) { Check_Type (c, T_Character); return Make_Integer (CHAR(c)); } -Object P_Integer_To_Char (n) Object n; { - register i; +Object P_Integer_To_Char (Object n) { + register int i; if ((i = Get_Exact_Integer (n)) < 0 || i > 255) Range_Error (n); return Make_Char (i); } -Object P_Char_Upper_Casep (c) Object c; { +Object P_Char_Upper_Casep (Object c) { Check_Type (c, T_Character); return isupper (CHAR(c)) ? True : False; } -Object P_Char_Lower_Casep (c) Object c; { +Object P_Char_Lower_Casep (Object c) { Check_Type (c, T_Character); return islower (CHAR(c)) ? True : False; } -Object P_Char_Alphabeticp (c) Object c; { +Object P_Char_Alphabeticp (Object c) { Check_Type (c, T_Character); return isalpha (CHAR(c)) ? True : False; } -Object P_Char_Numericp (c) Object c; { +Object P_Char_Numericp (Object c) { Check_Type (c, T_Character); return isdigit (CHAR(c)) ? True : False; } -Object P_Char_Whitespacep (c) Object c; { - register x; +Object P_Char_Whitespacep (Object c) { + register int x; Check_Type (c, T_Character); x = CHAR(c); return Whitespace (x) ? True : False; } -Object P_Char_Upcase (c) Object c; { +Object P_Char_Upcase (Object c) { Check_Type (c, T_Character); return islower (CHAR(c)) ? Make_Char (toupper (CHAR(c))) : c; } -Object P_Char_Downcase (c) Object c; { +Object P_Char_Downcase (Object c) { Check_Type (c, T_Character); return isupper (CHAR(c)) ? Make_Char (tolower (CHAR(c))) : c; } -General_Chrcmp (c1, c2, ci) Object c1, c2; register ci; { +int General_Chrcmp (Object c1, Object c2, register int ci) { Check_Type (c1, T_Character); Check_Type (c2, T_Character); if (ci) @@ -72,42 +72,42 @@ General_Chrcmp (c1, c2, ci) Object c1, c2; register ci; { return CHAR(c1) - CHAR(c2); } -Object P_Char_Eq (c1, c2) Object c1, c2; { +Object P_Char_Eq (Object c1, Object c2) { return General_Chrcmp (c1, c2, 0) ? False : True; } -Object P_Char_Less (c1, c2) Object c1, c2; { +Object P_Char_Less (Object c1, Object c2) { return General_Chrcmp (c1, c2, 0) < 0 ? True : False; } -Object P_Char_Greater (c1, c2) Object c1, c2; { +Object P_Char_Greater (Object c1, Object c2) { return General_Chrcmp (c1, c2, 0) > 0 ? True : False; } -Object P_Char_Eq_Less (c1, c2) Object c1, c2; { +Object P_Char_Eq_Less (Object c1, Object c2) { return General_Chrcmp (c1, c2, 0) <= 0 ? True : False; } -Object P_Char_Eq_Greater (c1, c2) Object c1, c2; { +Object P_Char_Eq_Greater (Object c1, Object c2) { return General_Chrcmp (c1, c2, 0) >= 0 ? True : False; } -Object P_Char_CI_Eq (c1, c2) Object c1, c2; { +Object P_Char_CI_Eq (Object c1, Object c2) { return General_Chrcmp (c1, c2, 1) ? False : True; } -Object P_Char_CI_Less (c1, c2) Object c1, c2; { +Object P_Char_CI_Less (Object c1, Object c2) { return General_Chrcmp (c1, c2, 1) < 0 ? True : False; } -Object P_Char_CI_Greater (c1, c2) Object c1, c2; { +Object P_Char_CI_Greater (Object c1, Object c2) { return General_Chrcmp (c1, c2, 1) > 0 ? True : False; } -Object P_Char_CI_Eq_Less (c1, c2) Object c1, c2; { +Object P_Char_CI_Eq_Less (Object c1, Object c2) { return General_Chrcmp (c1, c2, 1) <= 0 ? True : False; } -Object P_Char_CI_Eq_Greater (c1, c2) Object c1, c2; { +Object P_Char_CI_Eq_Greater (Object c1, Object c2) { return General_Chrcmp (c1, c2, 1) >= 0 ? True : False; } diff --git a/src/cont.c b/src/cont.c index 26c99ee..68a2614 100644 --- a/src/cont.c +++ b/src/cont.c @@ -3,6 +3,13 @@ #include "kernel.h" +#include + +extern void Switch_Environment (Object); + +void Jump_Cont (struct S_Control *, Object); +void Do_Wind (Object); + /* The C library versions of longjmp on the VAX and the Convex unwind * the stack. As Jump_Cont below installs a new stack before calling * longjmp, the standard version cannot be used. The following simplistic @@ -45,7 +52,7 @@ #endif #if defined(convex) || defined(__convex__) -convex_longjmp (p, i) char *p; { +convex_longjmp (char *p, int i) { __asm__("ld.w 4(ap),s0"); __asm__("ld.w 0(ap),a1"); __asm__("ld.w 12(a1),a7"); @@ -66,7 +73,7 @@ static Object Cont_Value; static Object Cont_GCsave; #endif -Check_Stack_Grows_Down () { +int Check_Stack_Grows_Down () { char foo; return &foo < stkbase; @@ -82,22 +89,22 @@ unsigned int Stack_Size () { return Stack_Grows_Down ? stkbase-&foo : &foo-stkbase; } -Grow_Stack (cp, val) struct S_Control *cp; Object val; { +void Grow_Stack (struct S_Control *cp, Object val) { char buf[100]; /* Prevent the optimizer from optimizing buf away: */ - bzero (buf, 1); + memset (buf, 0, 1); Jump_Cont (cp, val); } -Jump_Cont (cp, val) struct S_Control *cp; Object val; { +void Jump_Cont (struct S_Control *cp, Object val) { static struct S_Control *p; static char *from, *to; /* Must not be allocated on stack */ - static i; /* Ditto */ + static int i; /* Ditto */ char foo; - + /* Reinstall the saved stack contents; take stack direction * into account. cp must be put into a static variable, as * variables living on the stack cannot be referenced any @@ -126,18 +133,18 @@ Jump_Cont (cp, val) struct S_Control *cp; Object val; { } #ifndef USE_ALLOCA -Object Terminate_Cont (cont) Object cont; { +Object Terminate_Cont (Object cont) { Free_Mem_Nodes (CONTROL(cont)->memlist); return Void; } #endif -Object P_Control_Pointp (x) Object x; { +Object P_Control_Pointp (Object x) { return TYPE(x) == T_Control_Point ? True : False; } -Object P_Call_With_Current_Continuation (proc) Object proc; { - register t; +Object P_Call_With_Current_Continuation (Object proc) { + register int t; t = TYPE(proc); if (t != T_Primitive && t != T_Compound && t != T_Control_Point) @@ -145,11 +152,11 @@ Object P_Call_With_Current_Continuation (proc) Object proc; { return Internal_Call_CC (0, proc); } -Object Internal_Call_CC (from_dump, proc) int from_dump; Object proc; { +Object Internal_Call_CC (int from_dump, Object proc) { Object control, ret, gcsave; register struct S_Control *cp; register char *p, *to; - register size; + register int size; GC_Node3; control = gcsave = Null; @@ -182,7 +189,7 @@ Object Internal_Call_CC (from_dump, proc) int from_dump; Object proc; { */ p = Stack_Grows_Down ? stkbase - cp->size : stkbase; to = cp->stack; - bcopy (p, to, cp->size); + memcpy (to, p, cp->size); cp->delta = to - p; #ifndef USE_ALLOCA Register_Object (control, (GENERIC)0, Terminate_Cont, 0); @@ -212,11 +219,11 @@ Object Internal_Call_CC (from_dump, proc) int from_dump; Object proc; { return ret; } -Funcall_Control_Point (control, argl, eval) Object control, argl; { +void Funcall_Control_Point (Object control, Object argl, int eval) { Object val, len; register struct S_Control *cp; register WIND *w, *wp, *cwp, *p; - register delta = 0; + register int delta = 0; GC_Node3; if (GC_In_Progress) @@ -264,7 +271,7 @@ Funcall_Control_Point (control, argl, eval) Object control, argl; { /*NOTREACHED*/ } -Do_Wind (w) Object w; { +void Do_Wind (Object w) { Object oldenv, b, tmp; if (TYPE(w) == T_Vector) { /* fluid-let */ @@ -284,7 +291,7 @@ Do_Wind (w) Object w; { } } -Add_Wind (w, in, out) register WIND *w; Object in, out; { +void Add_Wind (register WIND *w, Object in, Object out) { Object inout; GC_Node2; @@ -301,7 +308,7 @@ Add_Wind (w, in, out) register WIND *w; Object in, out; { GC_Unlink; } -Object P_Dynamic_Wind (in, body, out) Object in, body, out; { +Object P_Dynamic_Wind (Object in, Object body, Object out) { WIND w, *first = First_Wind; Object ret; GC_Node4; @@ -315,14 +322,14 @@ Object P_Dynamic_Wind (in, body, out) Object in, body, out; { (void)Funcall (in, Null, 0); ret = Funcall (body, Null, 0); (void)Funcall (out, Null, 0); - if (Last_Wind = w.prev) + if ((Last_Wind = w.prev)) Last_Wind->next = 0; First_Wind = first; GC_Unlink; return ret; } -Object P_Control_Point_Environment (c) Object c; { +Object P_Control_Point_Environment (Object c) { Check_Type (c, T_Control_Point); return CONTROL(c)->env; } diff --git a/src/cstring.c b/src/cstring.c index 937d9e5..c4e53b7 100644 --- a/src/cstring.c +++ b/src/cstring.c @@ -11,21 +11,23 @@ #include "kernel.h" +#include + static char *heapstr[NUMSTRBUFS]; static int heaplen[NUMSTRBUFS]; static int nextstr; -Init_Cstring() { /* Preallocate memory to avoid fragmentation */ +void Init_Cstring() { /* Preallocate memory to avoid fragmentation */ int i; for (i = 0; i < NUMSTRBUFS; i++) heapstr[i] = Safe_Malloc (heaplen[i] = 512); } -char *Get_String (str) Object str; { +char *Get_String (Object str) { char **pp = &heapstr[nextstr]; int len; - + Check_Type (str, T_String); if ((len = STRING(str)->size+1) > heaplen[nextstr]) { Disable_Interrupts; @@ -33,13 +35,13 @@ char *Get_String (str) Object str; { heaplen[nextstr] = len; Enable_Interrupts; } - bcopy (STRING(str)->data, *pp, --len); + memcpy (*pp, STRING(str)->data, --len); (*pp)[len] = '\0'; if (++nextstr == NUMSTRBUFS) nextstr = 0; return *pp; } -char *Get_Strsym (str) Object str; { +char *Get_Strsym (Object str) { if (TYPE(str) == T_Symbol) str = SYMBOL(str)->name; else if (TYPE(str) != T_String) diff --git a/src/debug.c b/src/debug.c index 7cbfa12..a499467 100644 --- a/src/debug.c +++ b/src/debug.c @@ -3,9 +3,9 @@ #include "kernel.h" -Object P_Backtrace_List (argc, argv) Object *argv; { +Object P_Backtrace_List (int argc, Object *argv) { register GCNODE *p, *gp = GC_List; - register delta = 0; + register int delta = 0; Object cp, list, tail, cell, vec; GC_Node3; diff --git a/src/dump-ecoff.c b/src/dump-ecoff.c index 94dfaf8..eb8f1fb 100644 --- a/src/dump-ecoff.c +++ b/src/dump-ecoff.c @@ -25,12 +25,12 @@ extern char *sbrk(); #define MAX_SECTS 20 -Object P_Dump (ofile) Object ofile; { +Object P_Dump (Object ofile) { struct filehdr fhdr; struct aouthdr ahdr; struct scnhdr sect[MAX_SECTS]; struct scnhdr *sp, *datap; - unsigned long data_start, data_end, delta; + unsigned long int data_start, data_end, delta; int mask, n; HDRR shdr; char buf[4096]; @@ -64,7 +64,7 @@ Object P_Dump (ofile) Object ofile; { */ data_start = datap->s_vaddr; mask = getpagesize () - 1; - data_end = (unsigned long)sbrk (0) + mask & ~mask; + data_end = (unsigned long int)sbrk (0) + mask & ~mask; delta = data_end - data_start - datap->s_size; ahdr.dsize = data_end - ahdr.data_start; diff --git a/src/dump-elf.c b/src/dump-elf.c index b77102f..d3b22a0 100644 --- a/src/dump-elf.c +++ b/src/dump-elf.c @@ -3,6 +3,7 @@ #include #include #include +#include #include #include #include @@ -11,7 +12,7 @@ */ #define FIND_SECTHDR(name,ndx) {\ char err[100];\ - unsigned _i;\ + unsigned int _i;\ for (_i = 0; _i < ohdr->e_shnum; _i++)\ if (strcmp (sectstr+osecthdr[_i].sh_name, (name)) == 0) break;\ if (_i == ohdr->e_shnum) {\ @@ -43,7 +44,7 @@ /* Bug: the mmapped regions are never munmapped again. */ -Object P_Dump (ofile) Object ofile; { +Object P_Dump (Object ofile) { /* * ELF header, section header table, program header table of running * a.out and new a.out @@ -54,7 +55,7 @@ Object P_Dump (ofile) Object ofile; { /* * .bss section index and section header pointer of running a.out */ - unsigned obssndx; + unsigned int obssndx; Elf32_Shdr *obssp; /* * .mdebug section index @@ -80,7 +81,7 @@ Object P_Dump (ofile) Object ofile; { char *oaddr, *naddr; struct stat st; - unsigned i; + unsigned int i; int sect_created = !Was_Dumped; Dump_Prolog; @@ -120,7 +121,7 @@ Object P_Dump (ofile) Object ofile; { Primitive_Error ("sbrk(0) failed: ~E"); } ndata = obssp->sh_addr; - ndatasize = (Elf32_Addr)Brk_On_Dump - ndata; + ndatasize = (Elf32_Addr)((ptrdiff_t)Brk_On_Dump - (ptrdiff_t)ndata); ndataoff = obssp->sh_offset; /* mmap new a.out file, setup pointers to ELF header, section header @@ -162,9 +163,9 @@ Object P_Dump (ofile) Object ofile; { #define max(a,b) ((a) > (b) ? (a) : (b)) for (i = 0; i < nhdr->e_phnum; i++) { Elf32_Phdr *pp = nproghdr+i; - unsigned mask = max(pp->p_align, obssp->sh_addralign) - 1; - Elf32_Addr ends_at = pp->p_vaddr + pp->p_filesz + mask & ~mask; - Elf32_Addr bssend = obssp->sh_addr + mask & ~mask; + unsigned int mask = max(pp->p_align, obssp->sh_addralign) - 1; + Elf32_Addr ends_at = (pp->p_vaddr + pp->p_filesz + mask) & ~mask; + Elf32_Addr bssend = (obssp->sh_addr + mask) & ~mask; #ifndef __sgi if (pp->p_vaddr + pp->p_filesz > obssp->sh_addr) { Dump_Finalize; @@ -241,14 +242,14 @@ Object P_Dump (ofile) Object ofile; { "memory" : "file"); (void)fflush (stdout); #endif if ((sp->sh_flags & (SHF_ALLOC|SHF_WRITE)) == (SHF_ALLOC|SHF_WRITE)) - from = (void *)sp->sh_addr; + from = (void *)(ptrdiff_t)sp->sh_addr; else from = (void *)(oaddr + sp->sh_offset); if (sp != ndatap && sp->sh_offset >= ndataoff) sp->sh_offset += ndatasize; if (sp->sh_type != SHT_NULL && sp->sh_type != SHT_NOBITS) { #ifdef DEBUG_DUMP - printf (" copy from %x to %x size %x", from, naddr+sp->sh_offset, + printf (" copy from %p to %p size %x", from, naddr+sp->sh_offset, sp->sh_size); (void)fflush (stdout); #endif memcpy ((void *)(naddr + sp->sh_offset), from, sp->sh_size); diff --git a/src/dump-hp9k.c b/src/dump-hp9k.c index 5216d4b..182de20 100644 --- a/src/dump-hp9k.c +++ b/src/dump-hp9k.c @@ -36,10 +36,10 @@ }\ } -Object P_Dump (ofile) Object ofile; { +Object P_Dump (Object ofile) { struct header hdr; struct som_exec_auxhdr auxhdr; - unsigned data_size; + unsigned int data_size; int delta; struct stat stat; extern void *sbrk(); @@ -72,7 +72,7 @@ Object P_Dump (ofile) Object ofile; { copy (afd, ofd, auxhdr.exec_dfile); #ifdef HPSHLIB - /* Save data segments of shared libraries + /* Save data segments of shared libraries */ Save_Shared_Data (); #endif @@ -178,7 +178,7 @@ Save_Shared_Data () { sprintf (Z, " copy data seg from %x to %x len %d\n", sp->oldaddr, sp->saved, sp->desc.dend - sp->desc.dstart); W; #endif - bcopy (sp->oldaddr, sp->saved, sp->desc.dend - sp->desc.dstart); + memcpy (sp->saved, sp->oldaddr, sp->desc.dend - sp->desc.dstart); } } @@ -230,7 +230,7 @@ Restore_Shared_Data () { sprintf (Z, " copy data seg from %x to %x len %d\n", sp->saved, sp->oldaddr, sp->desc.dend-sp->desc.dstart); W; #endif - bcopy (sp->saved, sp->oldaddr, sp->desc.dend - sp->desc.dstart); + memcpy (sp->oldaddr, sp->saved, sp->desc.dend - sp->desc.dstart); /* * Initial break must be set as soon as data segment of * C library is restored diff --git a/src/dump-vanilla.c b/src/dump-vanilla.c index babe4b3..b86b097 100644 --- a/src/dump-vanilla.c +++ b/src/dump-vanilla.c @@ -18,23 +18,23 @@ static int getpagesize () { } #endif -Object P_Dump (ofile) Object ofile; { +Object P_Dump (Object ofile) { #ifdef COFF static struct scnhdr thdr, dhdr, bhdr, scn; static struct filehdr hdr; static struct aouthdr ohdr; - unsigned bias; - unsigned lnno_start, syms_start; - unsigned text_scn_start, data_scn_start; - unsigned data_end; + unsigned int bias; + unsigned int lnno_start, syms_start; + unsigned int text_scn_start, data_scn_start; + unsigned int data_end; int pagemask = COFF_PAGESIZE-1; #else struct exec hdr, shdr; - unsigned data_start, data_end; + unsigned int data_start, data_end; int pagemask = getpagesize () - 1; #endif char *afn; - register n; + register int n; char buf[BUFSIZ]; Dump_Prolog; @@ -48,7 +48,7 @@ badaout: Primitive_Error ("corrupt a.out file"); } #ifdef COFF - data_end = ((unsigned)sbrk (0) + pagemask) & ~pagemask; + data_end = ((unsigned int)sbrk (0) + pagemask) & ~pagemask; syms_start = sizeof (hdr); if (hdr.f_opthdr > 0) { if (read (afd, (char *)&ohdr, sizeof (ohdr)) != sizeof (ohdr)) @@ -120,7 +120,7 @@ badwrite: #endif data_start = (data_start + SEG_SIZ-1) & ~(SEG_SIZ-1); #endif - data_end = (unsigned)sbrk (0); + data_end = (unsigned int)sbrk (0); #if !defined(__bsdi__) data_end = (data_end + pagemask) & ~pagemask; #endif @@ -168,7 +168,7 @@ badwrite: #else if (Heap_Start > Free_Start) { - n = (unsigned)Free_Start - data_start; + n = (unsigned int)Free_Start - data_start; if (write (ofd, (char *)data_start, n) != n) goto badwrite; (void)lseek (ofd, (off_t)(Free_End - Free_Start), 1); @@ -176,15 +176,15 @@ badwrite: if (write (ofd, Heap_Start, n) != n) goto badwrite; (void)lseek (ofd, (off_t)(Heap_End - Hp), 1); - n = data_end - (unsigned)Heap_End; + n = data_end - (unsigned int)Heap_End; if (write (ofd, Heap_End, n) != n) goto badwrite; } else { - n = (unsigned)Hp - data_start; + n = (unsigned int)Hp - data_start; if (write (ofd, (char *)data_start, n) != n) goto badwrite; (void)lseek (ofd, (off_t)(Free_End - Hp), 1); - n = data_end - (unsigned)Free_End; + n = data_end - (unsigned int)Free_End; if (write (ofd, Free_End, n) != n) goto badwrite; } diff --git a/src/dump.c b/src/dump.c index 3267ba4..99348c1 100644 --- a/src/dump.c +++ b/src/dump.c @@ -11,11 +11,18 @@ # define O_BINARY 0 #endif +extern void Check_If_Dump_Works (); +extern void Flush_Output (Object); +extern void Close_All_Files (); +extern void Generational_GC_Finalize (); + extern int errno; +void Set_File_Executable (int, char *); + Object Dump_Control_Point; -Init_Dump () { +void Init_Dump () { Dump_Control_Point = Null; Global_GC_Link (Dump_Control_Point); } @@ -60,7 +67,7 @@ Init_Dump () { } #define Dump_Finalize Saved_Errno = errno; close (afd); close (ofd) - + #define Dump_Epilog {\ close (afd);\ @@ -85,16 +92,16 @@ Init_Dump () { #endif /*ARGSUSED1*/ -Set_File_Executable (fd, fn) int fd; char *fn; { +void Set_File_Executable (int fd, char *fn) { struct stat st; if (fstat (fd, &st) != -1) { int omask = umask (0); (void)umask (omask); #ifdef FCHMOD_BROKEN - (void)chmod (fn, st.st_mode & 0777 | 0111 & ~omask); + (void)chmod (fn, (st.st_mode & 0777) | (0111 & ~omask)); #else - (void)fchmod (fd, st.st_mode & 0777 | 0111 & ~omask); + (void)fchmod (fd, (st.st_mode & 0777) | (0111 & ~omask)); #endif } } diff --git a/src/env.c b/src/env.c index 651f24c..33c963d 100644 --- a/src/env.c +++ b/src/env.c @@ -3,6 +3,11 @@ #include "kernel.h" +void Set_Name (Object, Object); +void Memoize_Frame (Object); +void Memoize_Frames (Object, Object); +void Forget_Frame (Object); + #define Env_To_List(env, list) SET((list), T_Pair, POINTER(env)) #define List_To_Env(list, env) SET((env), T_Environment, POINTER(list)) @@ -10,14 +15,14 @@ Object The_Environment, Global_Environment; Object General_Define(); -Init_Env () { +void Init_Env () { List_To_Env (Cons (Null, Null), Global_Environment); The_Environment = Global_Environment; Global_GC_Link (Global_Environment); Global_GC_Link (The_Environment); } -Object P_Environment_To_List (env) Object env; { +Object P_Environment_To_List (Object env) { Object e; Check_Type (env, T_Environment); @@ -25,11 +30,11 @@ Object P_Environment_To_List (env) Object env; { return Copy_List (e); } -Object P_Environmentp (x) Object x; { +Object P_Environmentp (Object x) { return TYPE(x) == T_Environment ? True : False; } -Push_Frame (frame) Object frame; { +void Push_Frame (Object frame) { Object e; Memoize_Frame (frame); @@ -37,15 +42,15 @@ Push_Frame (frame) Object frame; { List_To_Env (Cons (frame, e), The_Environment); } -Pop_Frame () { +void Pop_Frame () { Object e; - + Env_To_List (The_Environment, e); List_To_Env (Cdr (e), The_Environment); Forget_Frame (Car (e)); } -Switch_Environment (to) Object to; { +void Switch_Environment (Object to) { Object old, new, n; if (EQ(The_Environment,to)) @@ -64,14 +69,14 @@ Switch_Environment (to) Object to; { The_Environment = to; } -Memoize_Frames (this, last) Object this, last; { +void Memoize_Frames (Object this, Object last) { if (Nullp (this) || EQ(this,last)) return; Memoize_Frames (Cdr (this), last); Memoize_Frame (Car (this)); } -Memoize_Frame (frame) Object frame; { +void Memoize_Frame (Object frame) { Object binding; for (; !Nullp (frame); frame = Cdr (frame)) { @@ -80,12 +85,12 @@ Memoize_Frame (frame) Object frame; { } } -Forget_Frame (frame) Object frame; { +void Forget_Frame (Object frame) { for (; !Nullp (frame); frame = Cdr (frame)) SYMBOL(Car (Car (frame)))->value = Unbound; } -Object Add_Binding (frame, sym, val) Object frame, sym, val; { +Object Add_Binding (Object frame, Object sym, Object val) { Object b; GC_Node; @@ -95,7 +100,7 @@ Object Add_Binding (frame, sym, val) Object frame, sym, val; { return Cons (b, frame); } -Object Lookup_Symbol (sym, err) Object sym; { +Object Lookup_Symbol (Object sym, int err) { Object p, f, b; Env_To_List (The_Environment, p); @@ -115,7 +120,7 @@ Object P_The_Environment () { return The_Environment; } Object P_Global_Environment () { return Global_Environment; } -Object Define_Procedure (form, body, sym) Object form, body, sym; { +Object Define_Procedure (Object form, Object body, Object sym) { Object ret; GC_Node3; @@ -129,7 +134,7 @@ Object Define_Procedure (form, body, sym) Object form, body, sym; { return ret; } -Object General_Define (argl, sym) Object argl, sym; { +Object General_Define (Object argl, Object sym) { Object val, var, frame, binding; GC_Node3; TC_Prolog; @@ -165,15 +170,15 @@ Object General_Define (argl, sym) Object argl, sym; { /*NOTREACHED*/ } -Object P_Define (argl) Object argl; { +Object P_Define (Object argl) { return General_Define (argl, Sym_Lambda); } -Object P_Define_Macro (argl) Object argl; { +Object P_Define_Macro (Object argl) { return General_Define (argl, Sym_Macro); } -Object P_Set (argl) Object argl; { +Object P_Set (Object argl) { Object val, var, binding, old; GC_Node3; TC_Prolog; @@ -194,8 +199,8 @@ Object P_Set (argl) Object argl; { return old; } -Set_Name (var, val) Object var, val; { - register t; +void Set_Name (Object var, Object val) { + register int t; t = TYPE(val); if (t == T_Compound) { @@ -207,7 +212,7 @@ Set_Name (var, val) Object var, val; { } } -Object P_Boundp (x) Object x; { +Object P_Boundp (Object x) { Check_Type (x, T_Symbol); return Nullp (Lookup_Symbol (x, 0)) ? False : True; } diff --git a/src/error.c b/src/error.c index 7b09071..5036f93 100644 --- a/src/error.c +++ b/src/error.c @@ -1,8 +1,12 @@ #include #include +#include #include "kernel.h" +void Reset () __attribute__ ((__noreturn__)); +void Err_Handler () __attribute__ ((__noreturn__)); + Object Arg_True; static Object V_Error_Handler, V_Top_Level_Control_Point; @@ -12,11 +16,11 @@ static Object V_Error_Handler, V_Top_Level_Control_Point; * the variable was manipulated directly, therefore it will remain global * for some time for backwards compatibility. */ -const char *Error_Tag; +char const *Error_Tag; char *appname; -Init_Error () { +void Init_Error () { Arg_True = Cons (True, Null); Global_GC_Link (Arg_True); Define_Variable (&V_Error_Handler, "error-handler", Null); @@ -24,26 +28,26 @@ Init_Error () { Null); } -const char *Get_Error_Tag () { +char const *Get_Error_Tag () { return Error_Tag; } -void Set_Error_Tag (tag) const char *tag; { +void Set_Error_Tag (char const *tag) { Error_Tag = tag; } -void Set_App_Name (name) char *name; { +void Set_App_Name (char *name) { appname = name; } #ifdef lint /*VARARGS1*/ -Fatal_Error (foo) char *foo; { foo = foo; } +void Fatal_Error (char *foo) { foo = foo; } #else -Fatal_Error (va_alist) va_dcl { +void Fatal_Error (va_alist) va_dcl { va_list args; char *fmt; - + Disable_Interrupts; va_start (args); fmt = va_arg (args, char *); @@ -59,7 +63,7 @@ Fatal_Error (va_alist) va_dcl { } #endif -Panic (msg) const char *msg; { +void Panic (char const *msg) { Disable_Interrupts; (void)fflush (stdout); if (appname) @@ -70,7 +74,7 @@ Panic (msg) const char *msg; { abort (); } -Uncatchable_Error (errmsg) char *errmsg; { +void Uncatchable_Error (char *errmsg) { Disable_Interrupts; Reset_IO (0); /* @@ -87,12 +91,12 @@ Uncatchable_Error (errmsg) char *errmsg; { #ifdef lint /*VARARGS1*/ -Primitive_Error (foo) char *foo; { foo = foo; } +void Primitive_Error (char *foo) { foo = foo; } #else -Primitive_Error (va_alist) va_dcl { +void Primitive_Error (va_alist) va_dcl { va_list args; register char *p, *fmt; - register i, n; + register int i, n; Object msg, sym, argv[10]; GC_Node; GCNODE gcv; @@ -116,13 +120,13 @@ Primitive_Error (va_alist) va_dcl { } #endif -Object P_Error (argc, argv) Object *argv; { +Object P_Error (int argc, Object *argv) { Check_Type (argv[1], T_String); Err_Handler (argv[0], argv[1], argc-2, argv+2); /*NOTREACHED*/ } -Err_Handler (sym, fmt, argc, argv) Object sym, fmt, *argv; { +void Err_Handler (Object sym, Object fmt, int argc, Object *argv) { Object fun, args, a[1]; GC_Node3; @@ -145,7 +149,7 @@ Err_Handler (sym, fmt, argc, argv) Object sym, fmt, *argv; { /*NOTREACHED*/ } -Reset () { +void Reset () { Object cp; cp = Var_Get (V_Top_Level_Control_Point); @@ -161,6 +165,6 @@ Object P_Reset () { /*NOTREACHED*/ } -Range_Error (i) Object i; { +void Range_Error (Object i) { Primitive_Error ("argument out of range: ~s", i); } diff --git a/src/exception.c b/src/exception.c index aa00191..34b96de 100644 --- a/src/exception.c +++ b/src/exception.c @@ -1,7 +1,11 @@ #include "kernel.h" +#include + +extern void Reset () __attribute__ ((__noreturn__)); + int Intr_Was_Ignored; -unsigned long Intr_Level; +unsigned long int Intr_Level; #ifdef POSIX_SIGNALS sigset_t Sigset_Old, Sigset_Block; @@ -16,12 +20,12 @@ static Object V_Interrupt_Handler; /* Make sure temp files are removed on hangup and broken pipe. */ /*ARGSUSED*/ -void Signal_Exit (sig) int sig; { +void Signal_Exit (int sig) { Exit_Handler (); exit (1); } -Init_Exception () { +void Init_Exception () { Define_Variable (&V_Interrupt_Handler, "interrupt-handler", Null); #ifdef POSIX_SIGNALS sigemptyset (&Sigset_Block); @@ -38,7 +42,7 @@ Init_Exception () { } /*ARGSUSED*/ -void Intr_Handler (sig) int sig; { +void Intr_Handler (int sig) { Object fun; #ifndef BSD_SIGNALS diff --git a/src/feature.c b/src/feature.c index 06f5b5a..4dd4205 100644 --- a/src/feature.c +++ b/src/feature.c @@ -3,9 +3,11 @@ #include "kernel.h" +#include + static Object Features; -Init_Features () { +void Init_Features () { Features = Null; Global_GC_Link (Features); #ifdef CAN_DUMP @@ -20,7 +22,7 @@ Object P_Features () { return Features; } -Object P_Featurep (sym) Object sym; { +Object P_Featurep (Object sym) { Object member; Check_Type (sym, T_Symbol); @@ -28,7 +30,7 @@ Object P_Featurep (sym) Object sym; { return Truep (member) ? True : False; } -Object P_Provide (sym) Object sym; { +Object P_Provide (Object sym) { Object member; Check_Type (sym, T_Symbol); @@ -38,7 +40,7 @@ Object P_Provide (sym) Object sym; { return Void; } -static Object Feature_Filename (str) Object str; { +static Object Feature_Filename (Object str) { struct S_String *sp = STRING(str); int len = sp->size; char *p; @@ -51,13 +53,13 @@ static Object Feature_Filename (str) Object str; { return str; GC_Link (str); s = Make_String ((char *)0, len+4); - bcopy (STRING(str)->data, STRING(s)->data, len); - bcopy (".scm", STRING(s)->data+len, 4); + memcpy (STRING(s)->data, STRING(str)->data, len); + memcpy (STRING(s)->data+len, ".scm", 4); GC_Unlink; return s; } -Object P_Require (argc, argv) Object *argv; { +Object P_Require (int argc, Object *argv) { Object sym, a[1], isfeature; GC_Node; diff --git a/src/heap-gen.c b/src/heap-gen.c index c0dfa2b..2b9bddd 100644 --- a/src/heap-gen.c +++ b/src/heap-gen.c @@ -9,10 +9,15 @@ */ #include +#include +#include #include #ifdef HAS_MPROTECT # include #endif +#ifdef GETPAGESIZE +# define SYSCONF_PAGESIZE +#endif #ifdef SYSCONF_PAGESIZE # define link FOO # include @@ -49,7 +54,7 @@ int tuneable_force_expand = 20; /* % stable to force heap expansion defined in object.h: typedef int gcspace_t; // type used for space and type arrays -typedef unsigned gcptr_t; // type used for pointers +typedef unsigned int gcptr_t; // type used for pointers ------------------------------------------------------------------------ */ @@ -70,6 +75,7 @@ static pageno_t logical_pages, spanning_pages, physical_pages; static pageno_t firstpage, lastpage; +static char *saved_heap_ptr; gcspace_t *space; static gcspace_t *type, *pmap; static pageno_t *link; @@ -141,8 +147,8 @@ static void TerminateGC (); #endif #define MAKE_HEADER(obj,words,type) (SET(obj, type, words)) -#define HEADER_TO_TYPE(header) ((unsigned)TYPE(header)) -#define HEADER_TO_WORDS(header) ((unsigned)FIXNUM(header)) +#define HEADER_TO_TYPE(header) ((unsigned int)TYPE(header)) +#define HEADER_TO_WORDS(header) ((unsigned int)FIXNUM(header)) /* some conversion stuff. PHYSPAGE converts a logical page number into the * start address of the physical page the logical page lies on. @@ -168,7 +174,9 @@ static void TerminateGC (); #define IS_CLUSTER(a,b) (SAME_PHYSPAGE (PAGE_TO_ADDR ((a)), \ PAGE_TO_ADDR ((b))) || \ - (type[(a)&hp_per_pp_mask] == OBJECTPAGE && \ + (space[(a)&hp_per_pp_mask] == \ + space[((b)&hp_per_pp_mask)+hp_per_pp] && \ + type[(a)&hp_per_pp_mask] == OBJECTPAGE && \ type[((b)&hp_per_pp_mask)+hp_per_pp] == OBJECTPAGE)) /* check whether the (physical) page starting at address addr is protected @@ -227,13 +235,13 @@ static void SetupDirtyList () { dirtylist = (struct dirty_rec *) malloc (sizeof (struct dirty_rec)); if (dirtylist == (struct dirty_rec *)0) Fatal_Error ("SetupDirtyList: unable to allocate memory"); - bzero ((char *)dirtylist->pages, sizeof (dirtylist->pages)); + memset (dirtylist->pages, 0, sizeof (dirtylist->pages)); dirtylist->next = (struct dirty_rec *)0; dirtyhead = dirtylist; dirtyentries = 0; } -static void AddDirty (addr) pageno_t addr; { +static void AddDirty (pageno_t addr) { struct dirty_rec *p; if (dirtyentries != 0 && @@ -246,7 +254,7 @@ static void AddDirty (addr) pageno_t addr; { p = (struct dirty_rec *) malloc (sizeof (struct dirty_rec)); if (p == (struct dirty_rec *)0) Fatal_Error ("AddDirty: unable to allocate memory"); - bzero ((char *)p->pages, sizeof (p->pages)); + memset (p->pages, 0, sizeof (p->pages)); p->next = (struct dirty_rec *)0; dirtylist->next = p; dirtylist = p; @@ -275,7 +283,7 @@ static void ReprotectDirty () { * to remember pages, set a flag to rescan the whole scan region. */ -static void RegisterPage (page) pageno_t page; { +static void RegisterPage (pageno_t page) { if (allscan) return; @@ -294,7 +302,7 @@ static void RegisterPage (page) pageno_t page; { * Note that these parameters are value-result parameters ! */ -static void DetermineCluster (addr, len) gcptr_t *addr; int *len; { +static void DetermineCluster (gcptr_t *addr, int *len) { gcptr_t addr1; *len = 1; @@ -319,7 +327,7 @@ static void DetermineCluster (addr, len) gcptr_t *addr; int *len; { * is 0, DetermineCluster is called to set length accordingly. */ -static void ProtectCluster (addr, len) gcptr_t addr; { +static void ProtectCluster (gcptr_t addr, int len) { if (!len) DetermineCluster (&addr, &len); if (len > 1) { while (len) { @@ -343,7 +351,7 @@ static void ProtectCluster (addr, len) gcptr_t addr; { } -static void UnprotectCluster (addr, len) gcptr_t addr; { +static void UnprotectCluster (gcptr_t addr, int len) { if (!len) DetermineCluster (&addr, &len); MPROTECT (addr, len << pp_shift, PROT_RW); while (len--) { @@ -355,7 +363,7 @@ static void UnprotectCluster (addr, len) gcptr_t addr; { /* add one page to the stable set queue */ -static void AddQueue (page) pageno_t page; { +static void AddQueue (pageno_t page) { if (stable_queue != (pageno_t)-1) link[stable_tail] = page; @@ -375,7 +383,7 @@ static void PromoteStableQueue () { Object *p; int pcount, size; pageno_t start; - + while (stable_queue != (pageno_t)-1) { p = PAGE_TO_OBJ (stable_queue); #ifdef ALIGN_8BYTE @@ -383,7 +391,7 @@ static void PromoteStableQueue () { #endif size = HEADER_TO_WORDS (*p); pcount = NEEDED_PAGES (size); - + start = stable_queue; while (pcount--) space[start++] = current_space; @@ -396,7 +404,7 @@ static void PromoteStableQueue () { /* calculate the logarithm (base 2) for arguments == 2**n */ -static Logbase2 (psize) addrarith_t psize; { +static int Logbase2 (addrarith_t psize) { int shift = 0; #if LONG_BITS-64 == 0 @@ -419,7 +427,7 @@ static Logbase2 (psize) addrarith_t psize; { /* return next heap page number, wrap around at the end of the heap. */ -static pageno_t next (page) pageno_t page; { +static pageno_t next (pageno_t page) { return ((page < lastpage) ? page+1 : firstpage); } @@ -427,7 +435,7 @@ static pageno_t next (page) pageno_t page; { #ifdef MPROTECT_MMAP -static char *heapmalloc (s) { +static char *heapmalloc (int s) { char *ret = mmap (0, s, PROT_READ|PROT_WRITE, MAP_ANON, -1, 0); if (ret == (char*)-1) @@ -446,24 +454,24 @@ static char *heapmalloc (s) { * make a heap of size kilobytes. It is divided into heappages of * PAGEBYTES byte and is aligned at a physical page boundary. The * heapsize is rounded up to the nearest multiple of the physical - * pagesize. + * pagesize. Checked by sam@zoy.org on Apr 1, 2003. */ -Make_Heap (size) { +void Make_Heap (int size) { addrarith_t heapsize = size * 2 * 1024; char *heap_ptr, *aligned_heap_ptr; Object heap_obj; pageno_t i; - + #ifdef HAS_MPROTECT InstallHandler (); #endif - + /* calculate number of logical heappages and of used physical pages. * First, round up to the nearest multiple of the physical pagesize, * then calculate the resulting number of heap pages. */ - + #ifdef SYSCONF_PAGESIZE if ((bytes_per_pp = sysconf (_SC_PAGESIZE)) == -1) Fatal_Error ("sysconf(_SC_PAGESIZE) failed; can't get pagesize"); @@ -486,26 +494,28 @@ Make_Heap (size) { pp_shift = Logbase2 (bytes_per_pp); heap_ptr = heapmalloc (logical_pages*PAGEBYTES+bytes_per_pp-1); + /* FIXME: add heap_ptr to a list of pointers to free */ + saved_heap_ptr = heap_ptr; if (heap_ptr == NULL) Fatal_Error ("cannot allocate heap (%u KBytes)", size); - + /* Align heap at a memory page boundary */ - + if ((gcptr_t)heap_ptr & (bytes_per_pp-1)) - aligned_heap_ptr = (char*)(((gcptr_t)heap_ptr+bytes_per_pp) + aligned_heap_ptr = (char*)(((gcptr_t)heap_ptr+bytes_per_pp-1) & ~(bytes_per_pp-1)); else aligned_heap_ptr = heap_ptr; SET(heap_obj, 0, aligned_heap_ptr); -#ifdef ARRAY_BROKEN +#ifdef ARRAY_BROKEN pagebase = ((gcptr_t)POINTER (heap_obj)) / PAGEBYTES; #endif firstpage = OBJ_TO_PAGE (heap_obj); lastpage = firstpage+logical_pages-1; - + space = (gcspace_t *)malloc (logical_pages*sizeof (gcspace_t)); type = (gcspace_t *)malloc ((logical_pages + 1)*sizeof (gcspace_t)); pmap = (gcspace_t *)malloc (physical_pages*sizeof (gcspace_t)); @@ -519,9 +529,9 @@ Make_Heap (size) { Fatal_Error ("cannot allocate heap maps"); } - bzero ((char *)type, (logical_pages + 1)*sizeof (gcspace_t)); - bzero ((char *)pmap, physical_pages*sizeof (gcspace_t)); - bzero ((char *)link, logical_pages*sizeof (unsigned)); + memset (type, 0, (logical_pages + 1)*sizeof (gcspace_t)); + memset (pmap, 0, physical_pages*sizeof (gcspace_t)); + memset (link, 0, logical_pages*sizeof (unsigned int)); space -= firstpage; /* to index the arrays with the heap page number */ type -= firstpage; type[lastpage+1] = OBJECTPAGE; @@ -545,10 +555,10 @@ Make_Heap (size) { } /* - * increment the heap by 1024 KB. + * increment the heap by 1024 KB. Checked by sam@zoy.org on Apr 1, 2003. */ -static int ExpandHeap (reason) char *reason; { +static int ExpandHeap (char *reason) { int increment = (1024 * 1024 + bytes_per_pp - 1) / bytes_per_pp; int incpages = increment * hp_per_pp; addrarith_t heapinc = incpages * PAGEBYTES; @@ -567,22 +577,23 @@ static int ExpandHeap (reason) char *reason; { #else # define offset 0 #endif - - heap_ptr = heapmalloc (heapinc+bytes_per_pp-1); + + /* FIXME: this pointer is lost */ + heap_ptr = heapmalloc (heapinc+bytes_per_pp/*-1*/); if (heap_ptr == NULL) { if (Var_Is_True (V_Garbage_Collect_Notifyp)) { char buf[243]; sprintf(buf, "[Heap expansion failed (%s)]~%%", reason); - Format (Standard_Output_Port, buf, - strlen(buf), 0, (Object *)0); + Format (Standard_Output_Port, buf, + strlen(buf), 0, (Object *)0); (void)fflush (stdout); } return (0); } - + /* Align heap at a memory page boundary */ - + if ((gcptr_t)heap_ptr & (bytes_per_pp-1)) aligned_heap_ptr = (char*)(((gcptr_t)heap_ptr+bytes_per_pp-1) & ~(bytes_per_pp-1)); @@ -590,7 +601,7 @@ static int ExpandHeap (reason) char *reason; { aligned_heap_ptr = heap_ptr; SET(heap_obj, 0, aligned_heap_ptr); - + new_first = firstpage; new_last = lastpage; @@ -623,7 +634,7 @@ static int ExpandHeap (reason) char *reason; { new_spanpages = new_last-new_first+1; #endif new_physpages = new_spanpages / hp_per_pp; - + new_space = (gcspace_t *)malloc (new_spanpages*sizeof (gcspace_t)); new_type = (gcspace_t *)malloc ((new_spanpages + 1)*sizeof (gcspace_t)); new_pmap = (gcspace_t *)malloc (new_physpages*sizeof (gcspace_t)); @@ -635,23 +646,29 @@ static int ExpandHeap (reason) char *reason; { if (new_pmap) free ((char*)new_pmap); if (new_link) free ((char*)new_link); if (Var_Is_True (V_Garbage_Collect_Notifyp)) { - Format (Standard_Output_Port, "[Heap expansion failed]~%", - 25, 0, (Object *)0); + Format (Standard_Output_Port, "[Heap expansion failed]~%", + 25, 0, (Object *)0); (void)fflush (stdout); } return (0); } + /* new_first will be 0 if ARRAY_BROKEN is defined. */ - + new_space -= new_first; new_type -= new_first; new_link -= new_first; - bzero ((char*)new_pmap, new_physpages * sizeof (gcspace_t)); + + memset (new_pmap, 0, new_physpages * sizeof (gcspace_t)); #ifndef ARRAY_BROKEN new_pmap -= (PHYSPAGE (new_first) >> pp_shift); #endif + memset (new_type+inc_first+offset, 0, (incpages+1)*sizeof (gcspace_t)); + memset (new_link+inc_first+offset, 0, incpages*sizeof (unsigned int)); + + /* FIXME: memmove! */ for (i = firstpage; i <= lastpage; i++) { new_link[i + offset] = link[i] + offset; new_type[i + offset] = type[i]; @@ -661,7 +678,7 @@ static int ExpandHeap (reason) char *reason; { new_pmap[((addr - PAGE_TO_ADDR(0)) >> pp_shift) + offset] = IS_PROTECTED (addr); } - + #ifdef ARRAY_BROKEN for (i = 0; i < new_spanpages; i++) new_space[i] = UNALLOCATED_PAGE; for (i = firstpage; i <= lastpage; i++) new_space[i+offset] = space[i]; @@ -671,7 +688,7 @@ static int ExpandHeap (reason) char *reason; { #else for (i = new_first; i < firstpage; i++) new_space[i] = UNALLOCATED_PAGE; for (i = firstpage; i <= lastpage; i++) new_space[i] = space[i]; - + for (i = lastpage+1; i <= new_last; i++) new_space[i] = UNALLOCATED_PAGE; for (i = inc_first; i <= inc_last; i++) new_space[i] = FREE_PAGE; new_type[new_last+1] = OBJECTPAGE; @@ -684,7 +701,7 @@ static int ExpandHeap (reason) char *reason; { free ((char*)(link+firstpage)); free ((char*)(type+firstpage)); free ((char*)(space+firstpage)); - + #ifndef ARRAY_BROKEN free ((char*)(pmap+(PAGE_TO_ADDR (firstpage) >> pp_shift))); #else @@ -700,9 +717,9 @@ static int ExpandHeap (reason) char *reason; { logical_pages = new_logpages; spanning_pages = new_spanpages; physical_pages = new_physpages; - + if (Var_Is_True (V_Garbage_Collect_Notifyp)) { - int a = (logical_pages * PAGEBYTES) >> 10; + int a = (logical_pages * PAGEBYTES) >> 10; char buf[243]; sprintf(buf, "[Heap expanded to %dK (%s)]~%%", a, reason); @@ -713,12 +730,30 @@ static int ExpandHeap (reason) char *reason; { } +/* + * free the heap. + */ + +void Free_Heap () { + free (saved_heap_ptr); + + free ((char*)(link+firstpage)); + free ((char*)(type+firstpage)); + free ((char*)(space+firstpage)); + +#ifndef ARRAY_BROKEN + free ((char*)(pmap+(PAGE_TO_ADDR (firstpage) >> pp_shift))); +#else + free ((char*)pmap); +#endif +} + /* allocate new logical heappages. npg is the number of pages to allocate. * If there is not enough space left, the heap will be expanded if possible. * The new page is allocated in current space. */ -static int ProtectedInRegion (start, npages) pageno_t start, npages; { +static int ProtectedInRegion (pageno_t start, pageno_t npages) { gcptr_t beginpage = PHYSPAGE (start); gcptr_t endpage = PHYSPAGE (start+npages-1); @@ -731,11 +766,11 @@ static int ProtectedInRegion (start, npages) pageno_t start, npages; { return (0); } -static void AllocPage (npg) pageno_t npg; { - pageno_t first_freepage; /* first free heap page */ +static void AllocPage (pageno_t npg) { + pageno_t first_freepage = 0;/* first free heap page */ pageno_t cont_free; /* contiguous free pages */ pageno_t n, p; - + if (current_space != forward_space) { (void)Scanner ((pageno_t)1); if (!protected_pages) @@ -749,27 +784,32 @@ static void AllocPage (npg) pageno_t npg; { P_Collect (); } } - + /* now look for a cluster of npg free pages. cont_free counts the * number of free pages found, first_freepage is the number of the * first free heap page in the cluster. */ - + for (p = spanning_pages, cont_free = 0; p; p--) { if (space[current_freepage] < previous_space && !STABLE (current_freepage)) { - if (!(cont_free++)) { - if (IS_CLUSTER (current_freepage, current_freepage+npg-1)) + if (cont_free == 0) { + /* This is our first free page, first check that we have a + * continuous cluster of pages (we'll check later that they + * are free). Otherwise, go to the next free page */ + if (current_freepage+npg-1 <= lastpage + && IS_CLUSTER (current_freepage, current_freepage+npg-1)) first_freepage = current_freepage; else { current_freepage = next (current_freepage - current_freepage % hp_per_pp + hp_per_pp-1); - cont_free = 0; continue; } } - + + cont_free++; + if (cont_free == npg) { space[first_freepage] = current_space; type[first_freepage] = OBJECTPAGE; @@ -785,25 +825,27 @@ static void AllocPage (npg) pageno_t npg; { if (ProtectedInRegion (first_freepage, npg)) (void)ScanCluster (PHYSPAGE (first_freepage)); return; - } else { - current_freepage = next (current_freepage); - if (current_freepage == firstpage) cont_free = 0; } + + /* check the next free page. If we warped, reset cont_free to 0. */ + current_freepage = next (current_freepage); + if (current_freepage == firstpage) cont_free = 0; + } else { current_freepage = next (current_freepage); cont_free = 0; } } - + /* no space available, try to expand heap */ - + if (ExpandHeap ("to allocate new object")) { AllocPage (npg); return; } - + Fatal_Error ("unable to allocate %lu bytes in heap", npg*PAGEBYTES); - + /*NOTREACHED*/ } @@ -825,22 +867,22 @@ Object Alloc_Object (size, type, konst) { else P_Collect (); } - + /* if there is not enough space left on the current page, discard * the left space and allocate a new page. Space is discarded by * writing a T_Freespace object. */ - + if (s > current_free) { if (current_free) { MAKE_HEADER (*current_freep, current_free, T_Freespace); current_free = 0; } - + /* If we are about to allocate an object bigger than one heap page, * set a flag. The space behind big objects is discarded, see below. */ - + #ifdef ALIGN_8BYTE if (s < PAGEWORDS-1) AllocPage ((pageno_t)1); @@ -860,12 +902,12 @@ Object Alloc_Object (size, type, konst) { } #endif } - + /* now write a header for the object into the heap and update the * pointer to the next free location and the counter of free words * in the current heappage. */ - + MAKE_HEADER (*current_freep, s, type); current_freep++; *current_freep = Null; @@ -883,7 +925,7 @@ Object Alloc_Object (size, type, konst) { #endif if (type == T_Control_Point) CONTROL(obj)->reloc = 0; - + if (konst) SETCONST (obj); return (obj); } @@ -894,18 +936,18 @@ Object Alloc_Object (size, type, konst) { * on the same physical page the referenced object lies on. */ -static void AllocForwardPage (bad) Object bad; { +static void AllocForwardPage (Object bad) { Object *badaddr = (Object *)POINTER (bad); pageno_t whole_heap = spanning_pages; pageno_t tpage; - + while (whole_heap--) { if (space[forward_freepage] < previous_space && !STABLE (forward_freepage) && !SAME_PHYSPAGE ((gcptr_t)badaddr, PAGE_TO_ADDR (forward_freepage)) && !IN_SCANREGION (PAGE_TO_ADDR (forward_freepage))) { - + allocated_pages++; forwarded_pages++; space[forward_freepage] = forward_space; @@ -913,7 +955,7 @@ static void AllocForwardPage (bad) Object bad; { forward_freep = PAGE_TO_OBJ (forward_freepage); forward_free = PAGEWORDS; AddQueue (forward_freepage); - + tpage = last_forward_freepage; last_forward_freepage = next (forward_freepage); forward_freepage = tpage; @@ -922,15 +964,15 @@ static void AllocForwardPage (bad) Object bad; { forward_freepage = next (forward_freepage); } } - + if (ExpandHeap ("to allocate forward page")) { AllocForwardPage (bad); return; } - + Fatal_Error ("unable to allocate forward page in %lu KBytes heap", (logical_pages * PAGEBYTES) >> 10); - + /*NOTREACHED*/ } @@ -939,7 +981,7 @@ static void AllocForwardPage (bad) Object bad; { * object must be protected because it is to be scanned later. */ -Visit (cp) register Object *cp; { +int Visit (register Object *cp) { register pageno_t page = OBJ_TO_PAGE (*cp); register Object *obj_ptr = (Object *)POINTER (*cp); int tag = TYPE (*cp); @@ -948,41 +990,41 @@ Visit (cp) register Object *cp; { pageno_t objpages, pcount; gcptr_t ffreep, pageaddr = 0; int outside; - + /* if the Visit function is called via the REVIVE_OBJ macro and we are * not inside an incremental collection, exit immediately. */ if (current_space == forward_space) - return; + return 0; if (page < firstpage || page > lastpage || STABLE (page) || space[page] == current_space || space[page] == UNALLOCATED_PAGE || !Types[tag].haspointer) - return; + return 0; if (space[page] != previous_space) { char buf[100]; - sprintf (buf, "Visit: object not in prev space at 0x%lx ('%s') %d %d", + sprintf (buf, "Visit: object not in prev space at %p ('%s') %d %d", obj_ptr, Types[tag].name, space[page], previous_space); Panic (buf); } - + if (!IN_SCANREGION (obj_ptr) && IS_PROTECTED ((gcptr_t)obj_ptr)) { pageaddr = OBJ_TO_PPADDR (*cp); UNPROTECT (pageaddr); } - + if (WAS_FORWARDED (*cp)) { if (pageaddr != 0) PROTECT (pageaddr); MAKEOBJ (*cp, tag, POINTER(*obj_ptr)); if (konst) SETCONST (*cp); - return; + return 0; } - ffreep = PTR_TO_PPADDR (forward_freep); + ffreep = PTR_TO_PPADDR (forward_freep); outside = !IN_SCANREGION (forward_freep); objwords = HEADER_TO_WORDS (*(obj_ptr - 1)); if (objwords >= forward_free) { @@ -1001,17 +1043,17 @@ Visit (cp) register Object *cp; { RegisterPage (page); else ProtectCluster (PHYSPAGE (page), 0); - + if (pageaddr != 0) PROTECT (pageaddr); - - return; + + return 0; } - + if (forward_free) { if (outside && IS_PROTECTED (ffreep) && !SAME_PHYSPAGE ((gcptr_t)obj_ptr, ffreep)) { - + UNPROTECT (ffreep); MAKE_HEADER (*forward_freep, forward_free, T_Freespace); forward_free = 0; @@ -1021,7 +1063,7 @@ Visit (cp) register Object *cp; { forward_free = 0; } } - + AllocForwardPage (*cp); outside = !IN_SCANREGION (forward_freep); ffreep = PTR_TO_PPADDR (forward_freep); /* re-set ffreep ! */ @@ -1034,7 +1076,7 @@ Visit (cp) register Object *cp; { goto do_forward; #endif } - + if (outside && IS_PROTECTED (ffreep)) UNPROTECT (ffreep); @@ -1045,17 +1087,17 @@ do_forward: CONTROL (*cp)->reloc = (char*)(forward_freep + 1) - (char*)obj_ptr; } - + MAKE_HEADER (*forward_freep, objwords, tag); forward_freep++; - bcopy ((char*)obj_ptr, (char*)forward_freep, (objwords-1)*sizeof(Object)); + memcpy (forward_freep, obj_ptr, (objwords-1)*sizeof(Object)); SET (*obj_ptr, T_Broken_Heart, forward_freep); MAKEOBJ (*cp, tag, forward_freep); if (konst) SETCONST (*cp); forward_freep += (objwords - 1); forward_free -= objwords; - + #ifdef ALIGN_8BYTE if (!((gcptr_t)forward_freep & 7) && forward_free) { MAKE_HEADER (*forward_freep, 1, T_Align_8Byte); @@ -1063,38 +1105,38 @@ do_forward: forward_free--; } #endif - + if (outside) PROTECT (ffreep); - + if (pageaddr != 0) PROTECT (pageaddr); - - return; + + return 0; } - - + + /* Scan a page and visit all objects referenced by objects lying on the * page. This will possibly forward the referenced objects. */ - -static void ScanPage (currentp, nextcp) Object *currentp, *nextcp; { + +static void ScanPage (Object *currentp, Object *nextcp) { Object *cp = currentp, obj; addrarith_t len, m, n; int t; - + while (cp < nextcp && (cp != forward_freep || forward_free == 0)) { t = HEADER_TO_TYPE (*cp); len = HEADER_TO_WORDS (*cp); cp++; - + /* cp now points to the real Scheme object in the heap. t denotes * the type of the object, len its length inclusive header in * words. */ SET(obj, t, cp); - + switch (t) { case T_Symbol: Visit (&SYMBOL(obj)->next); @@ -1102,27 +1144,27 @@ static void ScanPage (currentp, nextcp) Object *currentp, *nextcp; { Visit (&SYMBOL(obj)->value); Visit (&SYMBOL(obj)->plist); break; - + case T_Pair: case T_Environment: Visit (&PAIR(obj)->car); Visit (&PAIR(obj)->cdr); break; - + case T_Vector: for (n = 0, m = VECTOR(obj)->size; n < m; n++ ) Visit (&VECTOR(obj)->data[n]); break; - + case T_Compound: Visit (&COMPOUND(obj)->closure); Visit (&COMPOUND(obj)->env); Visit (&COMPOUND(obj)->name); break; - + case T_Control_Point: (CONTROL(obj)->delta) += CONTROL(obj)->reloc; - + #ifdef USE_ALLOCA Visit_GC_List (CONTROL(obj)->gclist, CONTROL(obj)->delta); #else @@ -1130,45 +1172,45 @@ static void ScanPage (currentp, nextcp) Object *currentp, *nextcp; { #endif Visit_Wind (CONTROL(obj)->firstwind, (CONTROL(obj)->delta) ); - + Visit (&CONTROL(obj)->env); break; - + case T_Promise: Visit (&PROMISE(obj)->env); Visit (&PROMISE(obj)->thunk); break; - + case T_Port: Visit (&PORT(obj)->name); break; - + case T_Autoload: Visit (&AUTOLOAD(obj)->files); Visit (&AUTOLOAD(obj)->env); break; - + case T_Macro: Visit (&MACRO(obj)->body); Visit (&MACRO(obj)->name); break; - default: + default: if (Types[t].visit) (Types[t].visit) (&obj, Visit); } cp += (len - 1); } } - - + + /* rescan all pages remembered by the RegisterPage function. */ - + static void RescanPages () { register Object *cp; register int i; int pages = rescanpages; - + rescanpages = 0; for (i = 0; i < pages; i++) { cp = PAGE_TO_OBJ (rescan[i]); @@ -1179,12 +1221,12 @@ static void RescanPages () { #endif } } - -static int ScanCluster (addr) gcptr_t addr; { + +static int ScanCluster (gcptr_t addr) { register pageno_t page, lastpage; pageno_t npages; int n = 0; - + scanning = 1; DetermineCluster (&addr, &n); npages = n; @@ -1222,11 +1264,11 @@ static int ScanCluster (addr) gcptr_t addr; { } -static int Scanner (npages) pageno_t npages; { +static int Scanner (pageno_t npages) { register gcptr_t addr, lastaddr; pageno_t spages; pageno_t scanned = 0; - + while (npages > 0 && protected_pages) { lastaddr = PAGE_TO_ADDR (lastpage); for (addr = PAGE_TO_ADDR(firstpage); addr < lastaddr && npages > 0; @@ -1256,13 +1298,13 @@ static int Scanner (npages) pageno_t npages; { #ifdef SIGSEGV_SIGCONTEXT -static void PagefaultHandler (sig, code, scp) struct sigcontext *scp; { +static void PagefaultHandler (int sig, int code, struct sigcontext *scp) { char *addr = (char *)(scp->sc_badvaddr); #else #ifdef SIGSEGV_AIX -static void PagefaultHandler (sig, code, scp) struct sigcontext *scp; { +static void PagefaultHandler (int sig, int code, struct sigcontext *scp) { char *addr = (char *)scp->sc_jmpbuf.jmp_context.except[3]; /* * Or should that be .jmp_context.o_vaddr? @@ -1271,19 +1313,19 @@ static void PagefaultHandler (sig, code, scp) struct sigcontext *scp; { #else #ifdef SIGSEGV_SIGINFO -static void PagefaultHandler (sig, sip, ucp) siginfo_t *sip; ucontext_t *ucp; { +static void PagefaultHandler (int sig, siginfo_t *sip, ucontext_t *ucp) { char *addr; #else #ifdef SIGSEGV_ARG4 -static void PagefaultHandler (sig, code, scp, addr) struct sigcontext *scp; - char *addr; { +static void PagefaultHandler (int sig, int code, struct sigcontext *scp, + char *addr) { #else #ifdef SIGSEGV_HPUX -static void PagefaultHandler (sig, code, scp) struct sigcontext *scp; { +static void PagefaultHandler (int sig, int code, struct sigcontext *scp) { #else # include "HAS_MPROTECT defined, but missing SIGSEGV_xxx" @@ -1339,7 +1381,7 @@ static void PagefaultHandler (sig, code, scp) struct sigcontext *scp; { return; } -InstallHandler () { +void InstallHandler () { #ifdef SIGSEGV_SIGINFO struct sigaction sact; sigset_t mask; @@ -1359,7 +1401,7 @@ InstallHandler () { static void TerminateGC () { int save_force_total; - + forward_space = current_space; previous_space = current_space; @@ -1380,9 +1422,9 @@ static void TerminateGC () { Enable_Interrupts; if (Var_Is_True (V_Garbage_Collect_Notifyp) && !GC_Debug) { - int foo = percent - HEAPPERCENT (allocated_pages); - Object bar; - + int foo = percent - HEAPPERCENT (allocated_pages); + Object bar; + bar = Make_Integer (foo); if (!incomplete_msg) Format (Standard_Output_Port, "[", 1, 0, (Object *)0); @@ -1430,7 +1472,7 @@ static void Finish_Collection () { } -static void General_Collect (initiate) { +static void General_Collect (int initiate) { pageno_t fpage, free_fpages, i; pageno_t page; pageno_t fregion_pages; @@ -1517,7 +1559,7 @@ static void General_Collect (initiate) { * have been protected, else check whether to expand the heap because * the stable set has grown too big. */ - + page = stable_queue; while (page != (pageno_t)-1) { ProtectCluster (PHYSPAGE (page), 0); @@ -1526,11 +1568,11 @@ static void General_Collect (initiate) { if (!initiate) { Finish_Collection (); - } else + } else if (HEAPPERCENT (forwarded_pages) > tuneable_force_expand) /* return value should not be ignored here: */ (void)ExpandHeap ("large stable set"); - + GC_In_Progress = 0; return; } @@ -1585,20 +1627,23 @@ Object P_Collect () { } } -Generational_GC_Finalize () { +void Generational_GC_Finalize () { if (current_space != forward_space) Finish_Collection (); } -Generational_GC_Reinitialize () { +void Generational_GC_Reinitialize () { #ifdef HAS_MPROTECT InstallHandler (); #endif } -Object Internal_GC_Status (strat, flags) { - Object list, cell; +Object Internal_GC_Status (int strat, int flags) { + Object list; +#ifdef HAS_MPROTECT + Object cell; +#endif GC_Node; list = Cons (Sym_Generational_GC, Null); diff --git a/src/heap-sc.c b/src/heap-sc.c index d9388d7..5453421 100644 --- a/src/heap-sc.c +++ b/src/heap-sc.c @@ -1,6 +1,10 @@ /* Stop-and-copy garbage collector */ +#include + +extern void Uncatchable_Error (char *); +extern unsigned int Stack_Size (); extern void *sbrk(); #define Recursive_Visit(p) {\ @@ -18,9 +22,9 @@ char *Heap_Start, static char *To; -Make_Heap (size) { - register unsigned k = 1024 * size; - register unsigned s = 2 * k; +void Make_Heap (int size) { + register unsigned int k = 1024 * size; + register unsigned int s = 2 * k; if ((Hp = Heap_Start = (char *)sbrk (s)) == (char *)-1) Fatal_Error ("cannot allocate heap (%u KBytes)", 2*size); @@ -29,7 +33,11 @@ Make_Heap (size) { Free_End = Free_Start + k; } -Object Alloc_Object (size, type, konst) { +void Free_Heap () { + /* Do nothing. */ +} + +Object Alloc_Object (int size, int type, int konst) { register char *p = Hp; Object ret; @@ -55,7 +63,7 @@ Object Alloc_Object (size, type, konst) { Object P_Collect () { register char *tmp; - register msg = 0; + register int msg = 0; Object a[2]; if (!Interpreter_Initialized) @@ -93,27 +101,27 @@ Object P_Collect () { return Void; } -Visit (p) register Object *p; { +int Visit (register Object *p) { register Object *tag; - register t, size, reloc; + register int t, size, reloc = 0; again: t = TYPE(*p); if (!Types[t].haspointer) - return; + return 0; tag = (Object *)POINTER(*p); if ((char *)tag >= Free_Start && (char *)tag < Free_End) - return; + return 0; if (TYPE(*tag) == T_Broken_Heart) { SETPOINTER(*p, POINTER(*tag)); - return; + return 0; } ALIGN(To); switch (t) { case T_Bignum: size = sizeof (struct S_Bignum) - sizeof (gran_t) + BIGNUM(*p)->size * sizeof (gran_t); - bcopy ((char *)tag, To, size); + memcpy (To, tag, size); break; case T_Flonum: size = sizeof (struct S_Flonum); @@ -130,12 +138,12 @@ again: break; case T_String: size = sizeof (struct S_String) + STRING(*p)->size - 1; - bcopy ((char *)tag, To, size); + memcpy (To, tag, size); break; case T_Vector: size = sizeof (struct S_Vector) + (VECTOR(*p)->size - 1) * sizeof (Object); - bcopy ((char *)tag, To, size); + memcpy (To, tag, size); break; case T_Primitive: size = sizeof (struct S_Primitive); @@ -148,7 +156,7 @@ again: case T_Control_Point: size = sizeof (struct S_Control) + CONTROL(*p)->size - 1; reloc = To - (char *)tag; - bcopy ((char *)tag, To, size); + memcpy (To, tag, size); break; case T_Promise: size = sizeof (struct S_Promise); @@ -175,7 +183,7 @@ again: size = Types[t].const_size; else size = (Types[t].size)(*p); - bcopy ((char *)tag, To, size); + memcpy (To, tag, size); } SETPOINTER(*p, To); SET(*tag, T_Broken_Heart, To); @@ -195,7 +203,7 @@ again: p = &PAIR(*p)->cdr; goto again; case T_Vector: { - register i, n; + register int i, n; for (i = 0, n = VECTOR(*p)->size; i < n; i++) Recursive_Visit (&VECTOR(*p)->data[i]); break; @@ -235,6 +243,8 @@ again: if (Types[t].visit) (Types[t].visit)(p, Visit); } + + return 0; } Object Internal_GC_Status (strat, flags) { diff --git a/src/heap.c b/src/heap.c index 72ff94d..d4112a9 100644 --- a/src/heap.c +++ b/src/heap.c @@ -14,7 +14,7 @@ static FUNCT *Before_GC_Funcs, *After_GC_Funcs; static Object V_Garbage_Collect_Notifyp; static Object Sym_Stop_And_Copy_GC, Sym_Generational_GC, Sym_Incremental_GC; -Init_Heap () { +void Init_Heap () { Define_Variable (&V_Garbage_Collect_Notifyp, "garbage-collect-notify?", True); @@ -23,7 +23,7 @@ Init_Heap () { Define_Symbol (&Sym_Incremental_GC, "incremental"); } -Register_Before_GC (f) void (*f)(); { +void Register_Before_GC (void (*f)(void)) { FUNCT *p; p = (FUNCT *)Safe_Malloc (sizeof (*p)); @@ -32,14 +32,14 @@ Register_Before_GC (f) void (*f)(); { Before_GC_Funcs = p; } -Call_Before_GC () { +void Call_Before_GC () { FUNCT *p; for (p = Before_GC_Funcs; p; p = p->next) p->func(); } -Register_After_GC (f) void (*f)(); { +void Register_After_GC (void (*f)(void)) { FUNCT *p; p = (FUNCT *)Safe_Malloc (sizeof (*p)); @@ -48,16 +48,16 @@ Register_After_GC (f) void (*f)(); { After_GC_Funcs = p; } -Call_After_GC () { +void Call_After_GC () { FUNCT *p; for (p = After_GC_Funcs; p; p = p->next) p->func(); } -Visit_GC_List (list, delta) GCNODE *list; { +void Visit_GC_List (GCNODE *list, int delta) { register GCNODE *gp, *p; - register n; + register int n; register Object *vec; for (gp = list; gp; gp = p->next) { @@ -72,7 +72,7 @@ Visit_GC_List (list, delta) GCNODE *list; { } } -Visit_Wind (list, delta) WIND *list; unsigned delta; { +void Visit_Wind (WIND *list, unsigned int delta) { register WIND *wp, *p; for (wp = list; wp; wp = p->next) { @@ -81,7 +81,7 @@ Visit_Wind (list, delta) WIND *list; unsigned delta; { } } -Func_Global_GC_Link (x) Object *x; { +void Func_Global_GC_Link (Object *x) { GCNODE *p; p = (GCNODE *)Safe_Malloc (sizeof (*p)); @@ -98,7 +98,7 @@ Func_Global_GC_Link (x) Object *x; { Object Internal_GC_Status(); -Object P_Garbage_Collect_Status (argc, argv) Object* argv; { +Object P_Garbage_Collect_Status (int argc, Object* argv) { int strat = 0, flags = 0; if (argc > 0) { diff --git a/src/io.c b/src/io.c index 8dd410c..753f77d 100644 --- a/src/io.c +++ b/src/io.c @@ -4,7 +4,9 @@ #include "kernel.h" #include +#include #include +#include #include #include #include @@ -13,13 +15,15 @@ # include #endif +extern void Flush_Output (Object); + extern int errno; extern char *getenv(); Object Curr_Input_Port, Curr_Output_Port; Object Standard_Input_Port, Standard_Output_Port; -Init_Io () { +void Init_Io () { Standard_Input_Port = Make_Port (P_INPUT, stdin, Make_String ("stdin", 5)); Standard_Output_Port = Make_Port (0, stdout, Make_String ("stdout", 6)); Curr_Input_Port = Standard_Input_Port; @@ -30,7 +34,7 @@ Init_Io () { Global_GC_Link (Curr_Output_Port); } -Reset_IO (destructive) { +void Reset_IO (int destructive) { Discard_Input (Curr_Input_Port); if (destructive) Discard_Output (Curr_Output_Port); @@ -40,9 +44,8 @@ Reset_IO (destructive) { Curr_Output_Port = Standard_Output_Port; } -Object Make_Port (flags, f, name) FILE *f; Object name; { +Object Make_Port (int flags, FILE *f, Object name) { Object port; - extern fclose(); GC_Node; GC_Link (name); @@ -57,17 +60,17 @@ Object Make_Port (flags, f, name) FILE *f; Object name; { return port; } -Object P_Port_File_Name (p) Object p; { +Object P_Port_File_Name (Object p) { Check_Type (p, T_Port); return (PORT(p)->flags & P_STRING) ? False : PORT(p)->name; } -Object P_Port_Line_Number (p) Object p; { +Object P_Port_Line_Number (Object p) { Check_Type (p, T_Port); return Make_Unsigned (PORT(p)->lno); } -Object P_Eof_Objectp (x) Object x; { +Object P_Eof_Objectp (Object x) { return TYPE(x) == T_End_Of_File ? True : False; } @@ -75,11 +78,11 @@ Object P_Current_Input_Port () { return Curr_Input_Port; } Object P_Current_Output_Port () { return Curr_Output_Port; } -Object P_Input_Portp (x) Object x; { +Object P_Input_Portp (Object x) { return TYPE(x) == T_Port && IS_INPUT(x) ? True : False; } -Object P_Output_Portp (x) Object x; { +Object P_Output_Portp (Object x) { return TYPE(x) == T_Port && IS_OUTPUT(x) ? True : False; } @@ -91,7 +94,7 @@ int Path_Max () { return MAXPATHLEN; #else #ifdef PATHCONF_PATH_MAX - static r; + static int r; if (r == 0) { if ((r = pathconf ("/", _PC_PATH_MAX)) == -1) r = 1024; @@ -105,8 +108,8 @@ int Path_Max () { #endif } -Object Get_File_Name (name) Object name; { - register len; +Object Get_File_Name (Object name) { + register int len; if (TYPE(name) == T_Symbol) name = SYMBOL(name)->name; @@ -117,8 +120,8 @@ Object Get_File_Name (name) Object name; { return name; } -char *Internal_Tilde_Expand (s, dirp) register char *s, **dirp; { - register char *p; +char *Internal_Tilde_Expand (register char *s, register char **dirp) { + register char *p; struct passwd *pw, *getpwnam(); if (*s++ != '~') @@ -133,11 +136,11 @@ char *Internal_Tilde_Expand (s, dirp) register char *s, **dirp; { if ((pw = getpwnam (s)) == 0) Primitive_Error ("unknown user: ~a", Make_String (s, strlen (s))); *dirp = pw->pw_dir; - } + } return p; } -Object General_File_Operation (s, op) Object s; register op; { +Object General_File_Operation (Object s, register int op) { register char *r; Object ret, fn; Alloca_Begin; @@ -164,36 +167,39 @@ Object General_File_Operation (s, op) Object s; register op; { ret = stat (r, &st) == 0 ? True : False; Alloca_End; return ret; + } + default: { + return Null; /* Just to avoid compiler warnings */ }} /*NOTREACHED*/ } -Object P_Tilde_Expand (s) Object s; { +Object P_Tilde_Expand (Object s) { return General_File_Operation (s, 0); } -Object P_File_Existsp (s) Object s; { +Object P_File_Existsp (Object s) { return General_File_Operation (s, 1); } -Close_All_Files () { +void Close_All_Files () { Terminate_Type (T_Port); } -Object Terminate_File (port) Object port; { +Object Terminate_File (Object port) { (void)(PORT(port)->closefun) (PORT(port)->file); PORT(port)->flags &= ~P_OPEN; return Void; } -Object Open_File (name, flags, err) char *name; { +Object Open_File (char *name, int flags, int err) { register FILE *f; char *dir, *p; Object fn, port; struct stat st; Alloca_Begin; - if (p = Internal_Tilde_Expand (name, &dir)) { + if ((p = Internal_Tilde_Expand (name, &dir))) { Alloca (name, char*, strlen (dir) + 1 + strlen (p) + 1); sprintf (name, "%s/%s", dir, p); } @@ -220,11 +226,11 @@ Object Open_File (name, flags, err) char *name; { return port; } -Object General_Open_File (name, flags, path) Object name, path; { +Object General_Open_File (Object name, int flags, Object path) { Object port, pref; char *buf = 0; register char *fn; - register plen, len, blen = 0, gotpath = 0; + register int plen, len, blen = 0, gotpath = 0; Alloca_Begin; name = Get_File_Name (name); @@ -244,10 +250,10 @@ Object General_Open_File (name, flags, path) Object name, path; { blen = len + plen + 2; Alloca (buf, char*, blen); } - bcopy (STRING(pref)->data, buf, plen); + memcpy (buf, STRING(pref)->data, plen); if (buf[plen-1] != '/') buf[plen++] = '/'; - bcopy (fn, buf+plen, len); + memcpy (buf+plen, fn, len); buf[len+plen] = '\0'; port = Open_File (buf, flags, 0); /* No GC has been taken place in Open_File() if it returns Null. @@ -262,27 +268,27 @@ Object General_Open_File (name, flags, path) Object name, path; { Primitive_Error ("file ~s not found", name); if (len + 1 > blen) Alloca (buf, char*, len + 1); - bcopy (fn, buf, len); + memcpy (buf, fn, len); buf[len] = '\0'; port = Open_File (buf, flags, 1); Alloca_End; return port; } -Object P_Open_Input_File (name) Object name; { +Object P_Open_Input_File (Object name) { return General_Open_File (name, P_INPUT, Null); } -Object P_Open_Output_File (name) Object name; { +Object P_Open_Output_File (Object name) { return General_Open_File (name, 0, Null); } -Object P_Open_Input_Output_File (name) Object name; { +Object P_Open_Input_Output_File (Object name) { return General_Open_File (name, P_BIDIR, Null); } -Object General_Close_Port (port) Object port; { - register flags, err = 0; +Object General_Close_Port (Object port) { + register int flags, err = 0; FILE *f; Check_Type (port, T_Port); @@ -303,11 +309,11 @@ Object General_Close_Port (port) Object port; { return Void; } -Object P_Close_Input_Port (port) Object port; { +Object P_Close_Input_Port (Object port) { return General_Close_Port (port); } -Object P_Close_Output_Port (port) Object port;{ +Object P_Close_Output_Port (Object port) { return General_Close_Port (port); } @@ -330,7 +336,7 @@ Object P_Close_Output_Port (port) Object port;{ General_With (P_With_Input_From_File, Curr_Input_Port, P_INPUT) General_With (P_With_Output_To_File, Curr_Output_Port, 0) -Object General_Call_With (name, flags, proc) Object name, proc; { +Object General_Call_With (Object name, int flags, Object proc) { Object port, ret; GC_Node2; @@ -344,15 +350,15 @@ Object General_Call_With (name, flags, proc) Object name, proc; { return ret; } -Object P_Call_With_Input_File (name, proc) Object name, proc; { +Object P_Call_With_Input_File (Object name, Object proc) { return General_Call_With (name, P_INPUT, proc); } -Object P_Call_With_Output_File (name, proc) Object name, proc; { +Object P_Call_With_Output_File (Object name, Object proc) { return General_Call_With (name, 0, proc); } -Object P_Open_Input_String (string) Object string; { +Object P_Open_Input_String (Object string) { Check_Type (string, T_String); return Make_Port (P_STRING|P_INPUT, (FILE *)0, string); } diff --git a/src/list.c b/src/list.c index f0f0f42..df11277 100644 --- a/src/list.c +++ b/src/list.c @@ -1,14 +1,17 @@ #include "kernel.h" -Object Const_Cons (car, cdr) Object car, cdr; { +extern unsigned int Stack_Size (); +extern void Uncatchable_Error (char *); + +Object Const_Cons (Object car, Object cdr) { Object ret; - + ret = P_Cons (car, cdr); SETCONST(ret); return ret; } -Object P_Cons (car, cdr) Object car, cdr; { +Object P_Cons (Object car, Object cdr) { Object cell; GC_Node2; @@ -38,17 +41,17 @@ Object P_Cons (car, cdr) Object car, cdr; { return cell; } -Object P_Car (x) Object x; { +Object P_Car (Object x) { Check_Type (x, T_Pair); return Car (x); } -Object P_Cdr (x) Object x; { +Object P_Cdr (Object x) { Check_Type (x, T_Pair); return Cdr (x); } -Object Cxr (x, pat, len) Object x; register char *pat; register len; { +Object Cxr (Object x, register char *pat, register int len) { Object ret; for (ret = x, pat += len; len > 0; len--) @@ -60,38 +63,38 @@ Object Cxr (x, pat, len) Object x; register char *pat; register len; { return ret; } -Object P_Cddr (x) Object x; { return Cxr (x, "dd", 2); } -Object P_Cdar (x) Object x; { return Cxr (x, "da", 2); } -Object P_Cadr (x) Object x; { return Cxr (x, "ad", 2); } -Object P_Caar (x) Object x; { return Cxr (x, "aa", 2); } +Object P_Cddr (Object x) { return Cxr (x, "dd", 2); } +Object P_Cdar (Object x) { return Cxr (x, "da", 2); } +Object P_Cadr (Object x) { return Cxr (x, "ad", 2); } +Object P_Caar (Object x) { return Cxr (x, "aa", 2); } -Object P_Cdddr (x) Object x; { return Cxr (x, "ddd", 3); } -Object P_Cddar (x) Object x; { return Cxr (x, "dda", 3); } -Object P_Cdadr (x) Object x; { return Cxr (x, "dad", 3); } -Object P_Cdaar (x) Object x; { return Cxr (x, "daa", 3); } -Object P_Caddr (x) Object x; { return Cxr (x, "add", 3); } -Object P_Cadar (x) Object x; { return Cxr (x, "ada", 3); } -Object P_Caadr (x) Object x; { return Cxr (x, "aad", 3); } -Object P_Caaar (x) Object x; { return Cxr (x, "aaa", 3); } +Object P_Cdddr (Object x) { return Cxr (x, "ddd", 3); } +Object P_Cddar (Object x) { return Cxr (x, "dda", 3); } +Object P_Cdadr (Object x) { return Cxr (x, "dad", 3); } +Object P_Cdaar (Object x) { return Cxr (x, "daa", 3); } +Object P_Caddr (Object x) { return Cxr (x, "add", 3); } +Object P_Cadar (Object x) { return Cxr (x, "ada", 3); } +Object P_Caadr (Object x) { return Cxr (x, "aad", 3); } +Object P_Caaar (Object x) { return Cxr (x, "aaa", 3); } -Object P_Caaaar (x) Object x; { return Cxr (x, "aaaa", 4); } -Object P_Caaadr (x) Object x; { return Cxr (x, "aaad", 4); } -Object P_Caadar (x) Object x; { return Cxr (x, "aada", 4); } -Object P_Caaddr (x) Object x; { return Cxr (x, "aadd", 4); } -Object P_Cadaar (x) Object x; { return Cxr (x, "adaa", 4); } -Object P_Cadadr (x) Object x; { return Cxr (x, "adad", 4); } -Object P_Caddar (x) Object x; { return Cxr (x, "adda", 4); } -Object P_Cadddr (x) Object x; { return Cxr (x, "addd", 4); } -Object P_Cdaaar (x) Object x; { return Cxr (x, "daaa", 4); } -Object P_Cdaadr (x) Object x; { return Cxr (x, "daad", 4); } -Object P_Cdadar (x) Object x; { return Cxr (x, "dada", 4); } -Object P_Cdaddr (x) Object x; { return Cxr (x, "dadd", 4); } -Object P_Cddaar (x) Object x; { return Cxr (x, "ddaa", 4); } -Object P_Cddadr (x) Object x; { return Cxr (x, "ddad", 4); } -Object P_Cdddar (x) Object x; { return Cxr (x, "ddda", 4); } -Object P_Cddddr (x) Object x; { return Cxr (x, "dddd", 4); } +Object P_Caaaar (Object x) { return Cxr (x, "aaaa", 4); } +Object P_Caaadr (Object x) { return Cxr (x, "aaad", 4); } +Object P_Caadar (Object x) { return Cxr (x, "aada", 4); } +Object P_Caaddr (Object x) { return Cxr (x, "aadd", 4); } +Object P_Cadaar (Object x) { return Cxr (x, "adaa", 4); } +Object P_Cadadr (Object x) { return Cxr (x, "adad", 4); } +Object P_Caddar (Object x) { return Cxr (x, "adda", 4); } +Object P_Cadddr (Object x) { return Cxr (x, "addd", 4); } +Object P_Cdaaar (Object x) { return Cxr (x, "daaa", 4); } +Object P_Cdaadr (Object x) { return Cxr (x, "daad", 4); } +Object P_Cdadar (Object x) { return Cxr (x, "dada", 4); } +Object P_Cdaddr (Object x) { return Cxr (x, "dadd", 4); } +Object P_Cddaar (Object x) { return Cxr (x, "ddaa", 4); } +Object P_Cddadr (Object x) { return Cxr (x, "ddad", 4); } +Object P_Cdddar (Object x) { return Cxr (x, "ddda", 4); } +Object P_Cddddr (Object x) { return Cxr (x, "dddd", 4); } -Object P_Cxr (x, pat) Object x, pat; { +Object P_Cxr (Object x, Object pat) { Check_List (x); if (TYPE(pat) == T_Symbol) pat = SYMBOL(pat)->name; @@ -100,17 +103,17 @@ Object P_Cxr (x, pat) Object x, pat; { return Cxr (x, STRING(pat)->data, STRING(pat)->size); } -Object P_Nullp (x) Object x; { +Object P_Nullp (Object x) { return Nullp (x) ? True : False; } -Object P_Pairp (x) Object x; { +Object P_Pairp (Object x) { return TYPE(x) == T_Pair ? True : False; } -Object P_Listp (x) Object x; { +Object P_Listp (Object x) { Object s; - register f; + register int f; for (s = x, f = 0; !Nullp (x); f ^= 1) { if (TYPE(x) != T_Pair) @@ -123,22 +126,22 @@ Object P_Listp (x) Object x; { return True; } -Object P_Set_Car (x, new) Object x, new; { +Object P_Set_Car (Object x, Object new) { Check_Type (x, T_Pair); Check_Mutable (x); Car (x) = new; return new; } -Object P_Set_Cdr (x, new) Object x, new; { +Object P_Set_Cdr (Object x, Object new) { Check_Type (x, T_Pair); Check_Mutable (x); Cdr (x) = new; return new; } -Object General_Member (key, list, comp) Object key, list; register comp; { - register r; +Object General_Member (Object key, Object list, register int comp) { + register int r; for ( ; !Nullp (list); list = Cdr (list)) { Check_List (list); @@ -153,21 +156,21 @@ Object General_Member (key, list, comp) Object key, list; register comp; { return False; } -Object P_Memq (key, list) Object key, list; { +Object P_Memq (Object key, Object list) { return General_Member (key, list, 0); } -Object P_Memv (key, list) Object key, list; { +Object P_Memv (Object key, Object list) { return General_Member (key, list, 1); } -Object P_Member (key, list) Object key, list; { +Object P_Member (Object key, Object list) { return General_Member (key, list, 2); } -Object General_Assoc (key, alist, comp) Object key, alist; register comp; { +Object General_Assoc (Object key, Object alist, register int comp) { Object elem; - register r; + register int r; for ( ; !Nullp (alist); alist = Cdr (alist)) { Check_List (alist); @@ -185,38 +188,38 @@ Object General_Assoc (key, alist, comp) Object key, alist; register comp; { return False; } -Object P_Assq (key, alist) Object key, alist; { +Object P_Assq (Object key, Object alist) { return General_Assoc (key, alist, 0); } -Object P_Assv (key, alist) Object key, alist; { +Object P_Assv (Object key, Object alist) { return General_Assoc (key, alist, 1); } -Object P_Assoc (key, alist) Object key, alist; { +Object P_Assoc (Object key, Object alist) { return General_Assoc (key, alist, 2); } -Fast_Length (list) Object list; { +int Fast_Length (Object list) { Object tail; - register i; + register int i; for (i = 0, tail = list; TYPE(tail) == T_Pair; tail = Cdr (tail), i++) ; return i; } -Object P_Length (list) Object list; { +Object P_Length (Object list) { Object tail; - register i; + register int i; for (i = 0, tail = list; !Nullp (tail); tail = Cdr (tail), i++) Check_List (tail); return Make_Integer (i); } -Object P_Make_List (n, init) Object n, init; { - register len; +Object P_Make_List (Object n, Object init) { + register int len; Object list; GC_Node; @@ -230,7 +233,7 @@ Object P_Make_List (n, init) Object n, init; { return list; } -Object P_List (argc, argv) Object *argv; { +Object P_List (int argc, Object *argv) { Object list, tail, cell; GC_Node2; @@ -246,15 +249,15 @@ Object P_List (argc, argv) Object *argv; { return list; } -Object P_Last_Pair (x) Object x; { +Object P_Last_Pair (Object x) { Check_Type (x, T_Pair); for ( ; TYPE(Cdr (x)) == T_Pair; x = Cdr (x)) ; return x; } -Object P_Append (argc, argv) Object *argv; { +Object P_Append (int argc, Object *argv) { Object list, last, tail, cell; - register i; + register int i; GC_Node3; list = last = Null; @@ -270,17 +273,18 @@ Object P_Append (argc, argv) Object *argv; { last = cell; } } - if (argc) + if (argc) { if (Nullp (list)) list = argv[i]; else (void)P_Set_Cdr (last, argv[i]); + } GC_Unlink; return list; } -Object P_Append_Set (argc, argv) Object *argv; { - register i, j; +Object P_Append_Set (int argc, Object *argv) { + register int i, j; for (i = j = 0; i < argc; i++) if (!Nullp (argv[i])) @@ -292,7 +296,7 @@ Object P_Append_Set (argc, argv) Object *argv; { return *argv; } -Object P_Reverse (x) Object x; { +Object P_Reverse (Object x) { Object ret; GC_Node; @@ -305,7 +309,7 @@ Object P_Reverse (x) Object x; { return ret; } -Object P_Reverse_Set (x) Object x; { +Object P_Reverse_Set (Object x) { Object prev, tail; for (prev = Null; !Nullp (x); prev = x, x = tail) { @@ -316,19 +320,19 @@ Object P_Reverse_Set (x) Object x; { return prev; } -Object P_List_Tail (x, num) Object x, num; { - register n; +Object P_List_Tail (Object x, Object num) { + register int n; for (n = Get_Exact_Integer (num); n > 0 && !Nullp (x); n--, x = P_Cdr (x)) ; return x; } -Object P_List_Ref (x, num) Object x, num; { +Object P_List_Ref (Object x, Object num) { return P_Car (P_List_Tail (x, num)); } -Object Copy_List (x) Object x; { +Object Copy_List (Object x) { Object car, cdr; GC_Node3; diff --git a/src/load-dl.c b/src/load-dl.c index c623496..28edf19 100644 --- a/src/load-dl.c +++ b/src/load-dl.c @@ -1,10 +1,12 @@ #include #include +#include +#include -extern char *strrchr(); -extern char *getenv(); +extern void Free_Symbols (SYMTAB *); +extern void Call_Initializers (SYMTAB *, char *, int); -Dlopen_File (fn) char *fn; { +void Dlopen_File (char *fn) { void *handle; SYM *sp; @@ -23,23 +25,23 @@ Dlopen_File (fn) char *fn; { * this can be safely ignored. */ for (sp = The_Symbols->first; sp; sp = sp->next) - sp->value = (unsigned long)dlsym (handle, sp->name); + sp->value = (unsigned long int)dlsym (handle, sp->name); Call_Initializers (The_Symbols, 0, PR_CONSTRUCTOR); Call_Initializers (The_Symbols, 0, PR_EXTENSION); } static char *tempname; static char *tmpdir; -static tmplen; -static Seq_Num; +static int tmplen; +static int Seq_Num; -char *Temp_Name (seq) int seq; { +char *Temp_Name (int seq) { if (!tempname) { if (!(tmpdir = getenv ("TMPDIR"))) tmpdir = "/tmp"; tempname = Safe_Malloc (tmplen = strlen (tmpdir) + 20); sprintf (tempname, "%s/ldXXXXXX", tmpdir); - (void)mkstemp (tempname); + (void)mktemp (tempname); strcat (tempname, "."); } sprintf (strrchr (tempname, '.'), ".%d", seq); @@ -55,7 +57,7 @@ void Fork_Load () { Disable_Interrupts; newtemp = Safe_Malloc (tmplen); sprintf (newtemp, "%s/ldXXXXXX", tmpdir); - (void)mkstemp (newtemp); + (void)mktemp (newtemp); strcat (newtemp, "."); for (i = 0; i < Seq_Num; i++) { sprintf (strrchr (newtemp, '.'), ".%d", i); @@ -66,7 +68,7 @@ void Fork_Load () { Enable_Interrupts; } -Load_Object (names) Object names; { +void Load_Object (Object names) { Object port, tail, fullnames, libs; char *lp, *buf, *outfile; int len, liblen, i; @@ -87,8 +89,10 @@ Load_Object (names) Object names; { if (TYPE(libs) == T_String) { liblen = STRING(libs)->size; lp = STRING(libs)->data; - } else + } else { liblen = 0; + lp = ""; + } Disable_Interrupts; diff --git a/src/load-ld.c b/src/load-ld.c index 21c50d6..9bce158 100644 --- a/src/load-ld.c +++ b/src/load-ld.c @@ -15,17 +15,20 @@ struct headers { struct filehdr fhdr; struct aouthdr aout; - struct scnhdr section[3]; + struct scnhdr section[3]; }; #endif +extern void Free_Symbols (SYMTAB *); +extern void Call_Initializers (SYMTAB *, char *, int); + extern void *sbrk(); extern char *getenv(); static char *Loader_Output; static char *tmpdir; -Load_Object (names) Object names; { +Load_Object (Object names) { #ifdef ECOFF struct headers hdr; #else @@ -33,7 +36,7 @@ Load_Object (names) Object names; { #endif register char *brk, *obrk, *lp, *li; char *buf; - register n, f, len, liblen; + register int n, f, len, liblen; Object port, tail, fullnames, libs; FILE *fp; GC_Node3; @@ -78,7 +81,7 @@ Load_Object (names) Object names; { #else sprintf (buf, "%s -N %s -A %s -T %x -o %s ", #endif - LD_NAME, INC_LDFLAGS, li, (unsigned)brk, Loader_Output); + LD_NAME, INC_LDFLAGS, li, (unsigned int)brk, Loader_Output); for (tail = fullnames; !Nullp (tail); tail = Cdr (tail)) { register struct S_String *str = STRING(Car (tail)); @@ -117,7 +120,7 @@ err: close (f); Primitive_Error ("not enough memory to load object file"); } - bzero (brk, n); + memset (brk, 0, n); #ifdef ECOFF n -= hdr.aout.bsize; (void)lseek (f, (off_t)hdr.section[0].s_scnptr, 0); diff --git a/src/load-rld.c b/src/load-rld.c index ab7cae6..ef988c5 100644 --- a/src/load-rld.c +++ b/src/load-rld.c @@ -1,11 +1,14 @@ #include -Load_Object (names) Object names; { +extern void Free_Symbols (SYMTAB *); +extern void Call_Initializers (SYMTAB *, char *, int); + +Load_Object (Object names) { long retval; struct mach_header *hdr; char **filenames, *libs; NXStream *err_stream; - register i, n; + register int i, n; Object port, tail, fullnames; extern char *strtok(); GC_Node3; @@ -28,7 +31,7 @@ Load_Object (names) Object names; { Alloca (filenames, char**, (n+1 + strlen (libs)/2) * sizeof (char *)); for (i = 0; i < n; i++, fullnames = Cdr (fullnames)) { Object s; - + s = Car (fullnames); Get_Strsym_Stack (s, filenames[i]); } diff --git a/src/load-shl.c b/src/load-shl.c index 256606a..a7f1bc1 100644 --- a/src/load-shl.c +++ b/src/load-shl.c @@ -1,9 +1,12 @@ #include #include +extern void Free_Symbols (SYMTAB *); +extern void Call_Initializers (SYMTAB *, char *, int); + extern int errno; -static void Load_Them (names) Object names; { +static void Load_Them (Object names) { char *fn; shl_t handle; SYM *sp; @@ -47,7 +50,7 @@ static void Load_Them (names) Object names; { Alloca_End; } -Load_Object (names) Object names; { +Load_Object (Object names) { Object port, tail, fullnames, str; char *p, *libs = ""; GC_Node3; diff --git a/src/load.c b/src/load.c index f0f91b6..4d945d0 100644 --- a/src/load.c +++ b/src/load.c @@ -10,6 +10,9 @@ Object V_Load_Path, V_Load_Noisilyp, V_Load_Libraries; char *Loader_Input; /* tmp file name used by load.xx.c */ +extern void Switch_Environment (Object); +void Load_Source (Object); + #ifdef CAN_LOAD_OBJ void Fork_Load(); #endif @@ -30,23 +33,23 @@ char *Loader_Input; /* tmp file name used by load.xx.c */ #endif #endif -Init_Load () { +void Init_Load () { Define_Variable (&V_Load_Path, "load-path", Cons (Make_String (".", 1), Cons (Make_String (SCM_DIR, sizeof (SCM_DIR) - 1), Cons (Make_String (OBJ_DIR, sizeof (OBJ_DIR) - 1), Null)))); Define_Variable (&V_Load_Noisilyp, "load-noisily?", False); - Define_Variable (&V_Load_Libraries, "load-libraries", + Define_Variable (&V_Load_Libraries, "load-libraries", Make_String (Default_Load_Libraries, sizeof Default_Load_Libraries-1)); #ifdef CAN_LOAD_OBJ Register_Onfork (Fork_Load); #endif } -Init_Loadpath (s) char *s; { /* No GC possible here */ +void Init_Loadpath (char *s) { /* No GC possible here */ register char *p; Object path; - + path = Null; if (s[0] == '\0') return; @@ -61,7 +64,7 @@ Init_Loadpath (s) char *s; { /* No GC possible here */ Var_Set (V_Load_Path, P_Reverse (path)); } -Is_O_File (name) Object name; { +int Is_O_File (Object name) { register char *p; register struct S_String *str; @@ -72,9 +75,9 @@ Is_O_File (name) Object name; { return str->size >= 2 && *--p == 'o' && *--p == '.'; } -void Check_Loadarg (x) Object x; { +void Check_Loadarg (Object x) { Object tail; - register t = TYPE(x); + register int t = TYPE(x); if (t == T_Symbol || t == T_String) return; @@ -82,7 +85,7 @@ void Check_Loadarg (x) Object x; { Wrong_Type_Combination (x, "string, symbol, or list"); for (tail = x; !Nullp (tail); tail = Cdr (tail)) { Object f; - + f = Car (tail); if (TYPE(f) != T_Symbol && TYPE(f) != T_String) Wrong_Type_Combination (f, "string or symbol"); @@ -91,7 +94,7 @@ void Check_Loadarg (x) Object x; { } } -Object General_Load (what, env) Object what, env; { +Object General_Load (Object what, Object env) { Object oldenv; GC_Node; @@ -117,11 +120,11 @@ Object General_Load (what, env) Object what, env; { return Void; } -Object P_Load (argc, argv) Object *argv; { +Object P_Load (int argc, Object *argv) { return General_Load (argv[0], argc == 1 ? The_Environment : argv[1]); } -void Load_Source_Port (port) Object port; { +void Load_Source_Port (Object port) { Object val; GC_Node; TC_Prolog; @@ -142,7 +145,7 @@ void Load_Source_Port (port) Object port; { GC_Unlink; } -Load_Source (name) Object name; { +void Load_Source (Object name) { Object port; GC_Node; @@ -155,7 +158,7 @@ Load_Source (name) Object name; { /* Interface to P_Load() for use by applications. */ -void Load_File (name) char *name; { +void Load_File (char *name) { Object arg; arg = Make_String(name, strlen(name)); diff --git a/src/main.c b/src/main.c index 3e4e67f..9bb6bb0 100644 --- a/src/main.c +++ b/src/main.c @@ -2,6 +2,9 @@ #include #include +#include +#include +#include #include #include @@ -18,8 +21,42 @@ # endif #endif +extern void Call_Initializers (SYMTAB *, char *, int); +extern void Load_Source (Object); +extern void Call_Finalizers (); +extern void Finit_Load (); +extern void Generational_GC_Reinitialize (); +extern int Check_Stack_Grows_Down (); +extern void Make_Heap (int); +extern void Free_Heap (); +extern void Init_Auto (void); +extern void Init_Cstring(); +extern void Init_Dump (); +extern void Init_Env (); +extern void Init_Error (); +extern void Init_Exception (); +extern void Init_Features (); +extern void Init_Heap (); +extern void Init_Io (); +extern void Init_Load (); +extern void Init_Loadpath (char *); +extern void Init_Math (); +extern void Init_Prim (); +extern void Init_Print (); +extern void Init_Proc (); +extern void Init_Read (); +extern void Init_Special (); +extern void Init_String (); +extern void Init_Symbol (); +extern void Init_Terminate (); +extern void Init_Type(); + extern char *getenv(); +void Get_Stack_Limit (); +void Usage (); +void Init_Everything (); + char *stkbase; int Stack_Grows_Down; unsigned int Max_Stack; @@ -47,6 +84,7 @@ void Exit_Handler () { #ifdef CAN_LOAD_OBJ Finit_Load (); #endif + Free_Heap (); } #ifndef ATEXIT @@ -76,7 +114,7 @@ char *Brk_On_Dump; * This cannot be fixed without changing Elk_Init() and its use in * an incompatible way. */ -Check_If_Dump_Works () { +void Check_If_Dump_Works () { #ifdef NOMAIN Primitive_Error ("not yet supported for standalone applications"); #endif @@ -85,18 +123,18 @@ Check_If_Dump_Works () { #ifdef NOMAIN -void Elk_Init (ac, av, init_objects, toplevel) char **av, *toplevel; { +void Elk_Init (int ac, char **av, int init_objects, char *toplevel) { #else -main (ac, av) char **av; { +int main (int ac, char **av) { #endif /* To avoid that the stack copying code overwrites argv if a dumped * copy of the interpreter is invoked with more arguments than the * original a.out, move the stack base INITIAL_STK_OFFSET bytes down. - * The call to bzero() is there to prevent the optimizer from removing + * The call to memset() is there to prevent the optimizer from removing * the array. */ #ifdef CAN_DUMP @@ -107,13 +145,16 @@ main (ac, av) char **av; { Object file; struct stat st; extern int errno; - char foo; +#ifdef CAN_DUMP #ifdef NOMAIN # define foo (av[0][0]) +#else + char foo; +#endif #endif #ifdef CAN_DUMP - bzero (unused, 1); /* see comment above */ + memset (unused, 0, 1); /* see comment above */ #endif if (ac == 0) { av[0] = "Elk"; ac = 1; @@ -136,12 +177,13 @@ main (ac, av) char **av; { fprintf (stderr, "Can't restart dumped interpreter from a different machine architecture\n"); fprintf (stderr, -" (Stack delta = %d bytes).\n", stkbase - &foo); +" (Stack delta = %lld bytes).\n", (long long int)(ptrdiff_t)(stkbase - &foo)); exit (1); } /* Check if program break must be reset. */ - if (Brk_On_Dump && (char *)brk (Brk_On_Dump) == (char *)-1) { + if ((ptrdiff_t)Brk_On_Dump && (ptrdiff_t)brk (Brk_On_Dump) + == (ptrdiff_t)-1) { perror ("brk"); exit (1); } #if defined(HP9K) && defined(CAN_DUMP) && defined(HPSHLIB) @@ -220,7 +262,7 @@ main (ac, av) char **av; { #endif if (loadpath || (loadpath = getenv (LOADPATH_ENV))) Init_Loadpath (loadpath); - + /* The following code is sort of a hack. initscheme.scm should not * be resolved against load-path. However, the .scm-files may not * have been installed yet (note that the interpreter is already @@ -277,7 +319,7 @@ called", " [--] End options and begin arguments", 0 }; -Usage () { +void Usage () { char **p; fprintf (stderr, "Usage: %s [options] [arguments]\n", Argv[0]); @@ -286,7 +328,7 @@ Usage () { exit (1); } -Init_Everything () { +void Init_Everything () { Init_Type (); Init_Cstring (); Init_String (); @@ -311,7 +353,7 @@ Init_Everything () { #endif } -Get_Stack_Limit () { +void Get_Stack_Limit () { #ifdef MAX_STACK_SIZE Max_Stack = MAX_STACK_SIZE; #else @@ -321,21 +363,20 @@ Get_Stack_Limit () { perror ("getrlimit"); exit (1); } - Max_Stack = rl.rlim_cur; #endif Max_Stack -= STACK_MARGIN; } #ifdef FIND_AOUT -Executable (fn) char *fn; { +int Executable (char *fn) { struct stat s; return stat (fn, &s) != -1 && (s.st_mode & S_IFMT) == S_IFREG && access (fn, X_OK) != -1; } -char *Find_Executable (fn) char *fn; { +char *Find_Executable (char *fn) { char *path, *dir, *getenv(); static char buf[1025]; /* Can't use Path_Max or Safe_Malloc here */ register char *p; @@ -372,14 +413,14 @@ char *Find_Executable (fn) char *fn; { Object P_Command_Line_Args () { Object ret, tail; - register i; + register int i; GC_Node2; ret = tail = P_Make_List (Make_Integer (Argc-First_Arg), Null); GC_Link2 (ret, tail); for (i = First_Arg; i < Argc; i++, tail = Cdr (tail)) { Object a; - + a = Make_String (Argv[i], strlen (Argv[i])); Car (tail) = a; } @@ -387,7 +428,7 @@ Object P_Command_Line_Args () { return ret; } -Object P_Exit (argc, argv) Object *argv; { +Object P_Exit (int argc, Object *argv) { exit (argc == 0 ? 0 : Get_Unsigned (argv[0])); /*NOTREACHED*/ } diff --git a/src/malloc.c b/src/malloc.c index d64804e..60ffd2e 100644 --- a/src/malloc.c +++ b/src/malloc.c @@ -1,31 +1,33 @@ #include "kernel.h" -extern char *malloc(), *realloc(); +#include -char *Safe_Malloc (size) unsigned size; { +char *Safe_Malloc (unsigned int size) { char *ret; - + Disable_Interrupts; - if ((ret = malloc (size)) == 0) + if ((ret = malloc (size)) == 0) { if (Interpreter_Initialized) Primitive_Error ("not enough memory to malloc ~s bytes", Make_Integer (size)); else Fatal_Error ("not enough memory to malloc %u bytes", size); + } Enable_Interrupts; return ret; } -char *Safe_Realloc (ptr, size) char *ptr; unsigned size; { +char *Safe_Realloc (char *ptr, unsigned int size) { char *ret; Disable_Interrupts; - if ((ret = ptr ? realloc (ptr, size) : malloc (size)) == 0) + if ((ret = ptr ? realloc (ptr, size) : malloc (size)) == 0) { if (Interpreter_Initialized) Primitive_Error ("not enough memory to malloc ~s bytes", Make_Integer (size)); else Fatal_Error ("not enough memory to malloc %u bytes", size); + } Enable_Interrupts; return ret; } diff --git a/src/math.c b/src/math.c index 0acfa81..d9b716e 100644 --- a/src/math.c +++ b/src/math.c @@ -4,14 +4,18 @@ #include #include #include +#include +#include +#include +#include #include "kernel.h" -extern int errno; +extern int Bignum_To_Integer (Object); Object Generic_Multiply(), Generic_Divide(); -Init_Math () { +void Init_Math () { #ifdef RANDOM srandom (getpid ()); #else @@ -19,38 +23,38 @@ Init_Math () { #endif } -Object Make_Integer (n) register n; { +Object Make_Integer (register int n) { Object num; SET(num, T_Fixnum, n); return num; } -Object Make_Unsigned (n) register unsigned n; { +Object Make_Unsigned (register unsigned int n) { if (UFIXNUM_FITS(n)) return Make_Integer (n); else return Unsigned_To_Bignum (n); } -Object Make_Long (n) register long n; { +Object Make_Long (register long int n) { if (n < 0 ? (n < (long)INT_MIN) : (n > (long)INT_MAX)) return Long_To_Bignum (n); else return Make_Integer ((int)n); } -Object Make_Unsigned_Long (n) register unsigned long n; { - if ((n & ~((unsigned long)SIGNBIT-1)) == 0) +Object Make_Unsigned_Long (register unsigned long int n) { + if ((n & ~((unsigned long int)SIGNBIT-1)) == 0) return Make_Integer ((int)n); else return Unsigned_Long_To_Bignum (n); } -Object Fixnum_To_String (x, radix) Object x; { +Object Fixnum_To_String (Object x, int radix) { char buf[32]; register char *p; - register n = FIXNUM(x), neg = 0; + register int n = FIXNUM(x), neg = 0; if (n == 0) return Make_String ("0", 1); @@ -71,7 +75,7 @@ Object Fixnum_To_String (x, radix) Object x; { return Make_String (p, strlen (p)); } -char *Flonum_To_String (x) Object x; { +char *Flonum_To_String (Object x) { static char buf[32]; char *p; @@ -83,7 +87,7 @@ char *Flonum_To_String (x) Object x; { return buf; } -Object P_Number_To_String (argc, argv) Object *argv; { +Object P_Number_To_String (int argc, Object *argv) { int radix = 10; Object x; char *s; @@ -109,11 +113,13 @@ Object P_Number_To_String (argc, argv) Object *argv; { Primitive_Error ("radix for reals must be 10"); /* bleah! */ s = Flonum_To_String (x); return Make_String (s, strlen (s)); + default: /* Just to avoid compiler warnings */ + return Null; } /*NOTREACHED*/ } -Get_Integer (x) Object x; { +int Get_Integer (Object x) { double d; int expo; @@ -136,7 +142,7 @@ Get_Integer (x) Object x; { /*NOTREACHED*/ } -unsigned Get_Unsigned (x) Object x; { +unsigned int Get_Unsigned (Object x) { double d; int expo; @@ -164,7 +170,7 @@ err: /*NOTREACHED*/ } -long Get_Long (x) Object x; { +long int Get_Long (Object x) { double d; int expo; @@ -187,7 +193,7 @@ long Get_Long (x) Object x; { /*NOTREACHED*/ } -unsigned long Get_Unsigned_Long (x) Object x; { +unsigned long int Get_Unsigned_Long (Object x) { double d; int expo; @@ -195,7 +201,7 @@ unsigned long Get_Unsigned_Long (x) Object x; { case T_Fixnum: if (FIXNUM(x) < 0) goto err; - return (unsigned long)FIXNUM(x); + return (unsigned long int)FIXNUM(x); case T_Bignum: return Bignum_To_Unsigned_Long (x); case T_Flonum: @@ -215,7 +221,7 @@ err: /*NOTREACHED*/ } -Get_Exact_Integer (x) Object x; { +int Get_Exact_Integer (Object x) { switch (TYPE(x)) { case T_Fixnum: return FIXNUM(x); @@ -227,7 +233,7 @@ Get_Exact_Integer (x) Object x; { /*NOTREACHED*/ } -unsigned Get_Exact_Unsigned (x) Object x; { +unsigned int Get_Exact_Unsigned (Object x) { switch (TYPE(x)) { case T_Fixnum: if (FIXNUM(x) < 0) @@ -241,7 +247,7 @@ unsigned Get_Exact_Unsigned (x) Object x; { /*NOTREACHED*/ } -long Get_Exact_Long (x) Object x; { +long int Get_Exact_Long (Object x) { switch (TYPE(x)) { case T_Fixnum: return FIXNUM(x); @@ -253,7 +259,7 @@ long Get_Exact_Long (x) Object x; { /*NOTREACHED*/ } -unsigned long Get_Exact_Unsigned_Long (x) Object x; { +unsigned long int Get_Exact_Unsigned_Long (Object x) { switch (TYPE(x)) { case T_Fixnum: if (FIXNUM(x) < 0) @@ -267,8 +273,8 @@ unsigned long Get_Exact_Unsigned_Long (x) Object x; { /*NOTREACHED*/ } -Get_Index (n, obj) Object n, obj; { - register size, i; +int Get_Index (Object n, Object obj) { + register int size, i; i = Get_Exact_Integer (n); size = TYPE(obj) == T_Vector ? VECTOR(obj)->size : STRING(obj)->size; @@ -277,7 +283,7 @@ Get_Index (n, obj) Object n, obj; { return i; } -Object Make_Flonum (d) double d; { +Object Make_Flonum (double d) { Object num; num = Alloc_Object (sizeof (struct S_Flonum), T_Flonum, 0); @@ -286,7 +292,7 @@ Object Make_Flonum (d) double d; { return num; } -Object Make_Reduced_Flonum (d) double d; { +Object Make_Reduced_Flonum (double d) { Object num; int expo; @@ -303,7 +309,7 @@ Object Make_Reduced_Flonum (d) double d; { return num; } -Fixnum_Add (a, b, fits) int *fits; { +int Fixnum_Add (int a, int b, int *fits) { int ret = a + b; *fits = 1; @@ -315,7 +321,7 @@ Fixnum_Add (a, b, fits) int *fits; { return ret; } -Fixnum_Sub (a, b, fits) int *fits; { +int Fixnum_Sub (int a, int b, int *fits) { int ret = a - b; *fits = 1; @@ -332,11 +338,11 @@ Fixnum_Sub (a, b, fits) int *fits; { * resulting bignum gets reduced to a fixnum (if it fits) anyway. * (This should be fixed, though...) */ -Object Fixnum_Multiply (a, b) { - register unsigned aa = a; - register unsigned ab = b; - register unsigned prod, prod2; - register sign = 1; +Object Fixnum_Multiply (int a, int b) { + register unsigned int aa = a; + register unsigned int ab = b; + register unsigned int prod, prod2; + register int sign = 1; if (a < 0) { aa = -a; sign = -1; @@ -358,7 +364,7 @@ Object Fixnum_Multiply (a, b) { if (prod2 > (1 << (FIXBITS - 1 - 16)) - 1) { if (sign == 1 || prod2 != (1 << (FIXBITS - 1 - 16)) || prod != 0) return Null; - return Make_Integer (-(unsigned)SIGNBIT); + return Make_Integer (-(unsigned int)SIGNBIT); } prod += prod2 << 16; if (sign == -1) @@ -366,7 +372,7 @@ Object Fixnum_Multiply (a, b) { return Make_Integer (prod); } -Object P_Integerp (x) Object x; { +Object P_Integerp (Object x) { double d; switch (TYPE(x)) { @@ -379,34 +385,34 @@ Object P_Integerp (x) Object x; { return False; } -Object P_Rationalp (x) Object x; { +Object P_Rationalp (Object x) { return P_Integerp (x); } -Object P_Realp (x) Object x; { - register t = TYPE(x); +Object P_Realp (Object x) { + register int t = TYPE(x); return t == T_Flonum || t == T_Fixnum || t == T_Bignum ? True : False; } -Object P_Complexp (x) Object x; { +Object P_Complexp (Object x) { return P_Realp (x); } -Object P_Numberp (x) Object x; { +Object P_Numberp (Object x) { return P_Complexp (x); } -Object P_Exactp (n) Object n; { +Object P_Exactp (Object n) { Check_Number (n); return TYPE(n) == T_Flonum ? False : True; } -Object P_Inexactp (n) Object n; { +Object P_Inexactp (Object n) { Check_Number (n); return TYPE(n) == T_Flonum ? True : False; } -Object P_Exact_To_Inexact (n) Object n; { +Object P_Exact_To_Inexact (Object n) { Check_Number (n); switch (TYPE(n)) { case T_Fixnum: @@ -415,11 +421,13 @@ Object P_Exact_To_Inexact (n) Object n; { return n; case T_Bignum: return Make_Flonum (Bignum_To_Double (n)); + default: /* Just to avoid compiler warnings */ + return Null; } /*NOTREACHED*/ } -Object P_Inexact_To_Exact (n) Object n; { +Object P_Inexact_To_Exact (Object n) { double d; int i; @@ -432,12 +440,14 @@ Object P_Inexact_To_Exact (n) Object n; { d = floor (FLONUM(n)->val + 0.5); (void)frexp (d, &i); return (i <= FIXBITS-1) ? Make_Integer ((int)d) : Double_To_Bignum (d); + default: /* Just to avoid compiler warnings */ + return Null; } /*NOTREACHED*/ } -#define General_Generic_Predicate(prim,op,bigop) Object prim (x) Object x; {\ - register ret;\ +#define General_Generic_Predicate(prim,op,bigop) Object prim (Object x) {\ + register int ret;\ Check_Number (x);\ switch (TYPE(x)) {\ case T_Flonum:\ @@ -446,6 +456,8 @@ Object P_Inexact_To_Exact (n) Object n; { ret = FIXNUM(x) op 0; break;\ case T_Bignum:\ ret = bigop (x); break;\ + default: /* Just to avoid compiler warnings */\ + return False;\ }\ return ret ? True : False;\ } @@ -454,8 +466,8 @@ General_Generic_Predicate (P_Zerop, ==, Bignum_Zero) General_Generic_Predicate (P_Negativep, <, Bignum_Negative) General_Generic_Predicate (P_Positivep, >, Bignum_Positive) -Object P_Evenp (x) Object x; { - register ret; +Object P_Evenp (Object x) { + register int ret; double d; switch (TYPE(x)) { @@ -478,14 +490,14 @@ Object P_Evenp (x) Object x; { return ret ? True : False; } -Object P_Oddp (x) Object x; { +Object P_Oddp (Object x) { Object tmp; tmp = P_Evenp (x); return EQ(tmp,True) ? False : True; } -#define General_Generic_Compare(name,op,bigop) name (x, y) Object x, y; {\ - Object b; register ret;\ +#define General_Generic_Compare(name,op,bigop) int name (Object x, Object y) {\ + Object b; register int ret;\ GC_Node;\ \ switch (TYPE(x)) {\ @@ -501,6 +513,8 @@ Object P_Oddp (x) Object x; { ret = bigop (b, y);\ GC_Unlink;\ return ret;\ + default: /* Just to avoid compiler warnings */\ + return 0;\ }\ case T_Flonum:\ switch (TYPE(y)) {\ @@ -510,6 +524,8 @@ Object P_Oddp (x) Object x; { return FLONUM(x)->val op FLONUM(y)->val;\ case T_Bignum:\ return FLONUM(x)->val op Bignum_To_Double (y);\ + default: /* Just to avoid compiler warnings */\ + return 0;\ }\ case T_Bignum:\ switch (TYPE(y)) {\ @@ -523,7 +539,11 @@ Object P_Oddp (x) Object x; { return Bignum_To_Double (x) op FLONUM(y)->val;\ case T_Bignum:\ return bigop (x, y);\ + default: /* Just to avoid compiler warnings */\ + return 0;\ }\ + default: /* Just to avoid compiler warnings */\ + return 0;\ }\ /*NOTREACHED*/ /* ...but lint never sees it */\ } @@ -534,8 +554,8 @@ General_Generic_Compare (Generic_Greater, >, Bignum_Greater) General_Generic_Compare (Generic_Eq_Less, <=, Bignum_Eq_Less) General_Generic_Compare (Generic_Eq_Greater, >=, Bignum_Eq_Greater) -Object General_Compare (argc, argv, op) Object *argv; register (*op)(); { - register i; +Object General_Compare (int argc, Object *argv, register int (*op)()) { + register int i; Check_Number (argv[0]); for (i = 1; i < argc; i++) { @@ -546,29 +566,29 @@ Object General_Compare (argc, argv, op) Object *argv; register (*op)(); { return True; } -Object P_Generic_Equal (argc, argv) Object *argv; { +Object P_Generic_Equal (int argc, Object *argv) { return General_Compare (argc, argv, Generic_Equal); } -Object P_Generic_Less (argc, argv) Object *argv; { +Object P_Generic_Less (int argc, Object *argv) { return General_Compare (argc, argv, Generic_Less); } -Object P_Generic_Greater (argc, argv) Object *argv; { +Object P_Generic_Greater (int argc, Object *argv) { return General_Compare (argc, argv, Generic_Greater); } -Object P_Generic_Eq_Less (argc, argv) Object *argv; { +Object P_Generic_Eq_Less (int argc, Object *argv) { return General_Compare (argc, argv, Generic_Eq_Less); } -Object P_Generic_Eq_Greater (argc, argv) Object *argv; { +Object P_Generic_Eq_Greater (int argc, Object *argv) { return General_Compare (argc, argv, Generic_Eq_Greater); } -#define General_Generic_Operator(name,op,fixop,bigop) Object name (x, y)\ - Object x, y; {\ - Object b1, b2, ret; register i;\ +#define General_Generic_Operator(name,op,fixop,bigop) Object name (Object x,\ + Object y) {\ + Object b1, b2, ret; register int i;\ int fits;\ GC_Node2;\ \ @@ -594,6 +614,8 @@ Object P_Generic_Eq_Greater (argc, argv) Object *argv; { ret = bigop (b1, y);\ GC_Unlink;\ return ret;\ + default: /* Just to avoid compiler warnings */\ + return False;\ }\ case T_Flonum:\ switch (TYPE(y)) {\ @@ -603,6 +625,8 @@ Object P_Generic_Eq_Greater (argc, argv) Object *argv; { return Make_Flonum (FLONUM(x)->val op FLONUM(y)->val);\ case T_Bignum:\ return Make_Flonum (FLONUM(x)->val op Bignum_To_Double (y));\ + default: /* Just to avoid compiler warnings */\ + return False;\ }\ case T_Bignum:\ switch (TYPE(y)) {\ @@ -616,7 +640,11 @@ Object P_Generic_Eq_Greater (argc, argv) Object *argv; { return Make_Flonum (Bignum_To_Double (x) op FLONUM(y)->val);\ case T_Bignum:\ return bigop (x, y);\ + default: /* Just to avoid compiler warnings */\ + return False;\ }\ + default: /* Just to avoid compiler warnings */\ + return False;\ }\ /*NOTREACHED*/ /* ...but lint never sees it */\ } @@ -624,19 +652,19 @@ Object P_Generic_Eq_Greater (argc, argv) Object *argv; { General_Generic_Operator (Generic_Plus, +, Fixnum_Add, Bignum_Plus) General_Generic_Operator (Generic_Minus, -, Fixnum_Sub, Bignum_Minus) -Object P_Inc (x) Object x; { +Object P_Inc (Object x) { Check_Number (x); return Generic_Plus (x, One); } -Object P_Dec (x) Object x; { +Object P_Dec (Object x) { Check_Number (x); return Generic_Minus (x, One); } -Object General_Operator (argc, argv, start, op) Object *argv, start; - register Object (*op)(); { - register i; +Object General_Operator (int argc, Object *argv, Object start, + register Object (*op)()) { + register int i; Object accum; if (argc > 0) @@ -656,23 +684,23 @@ Object General_Operator (argc, argv, start, op) Object *argv, start; return accum; } -Object P_Generic_Plus (argc, argv) Object *argv; { +Object P_Generic_Plus (int argc, Object *argv) { return General_Operator (argc, argv, Zero, Generic_Plus); } -Object P_Generic_Minus (argc, argv) Object *argv; { +Object P_Generic_Minus (int argc, Object *argv) { return General_Operator (argc, argv, Zero, Generic_Minus); } -Object P_Generic_Multiply (argc, argv) Object *argv; { +Object P_Generic_Multiply (int argc, Object *argv) { return General_Operator (argc, argv, One, Generic_Multiply); } -Object P_Generic_Divide (argc, argv) Object *argv; { +Object P_Generic_Divide (int argc, Object *argv) { return General_Operator (argc, argv, One, Generic_Divide); } -Object Generic_Multiply (x, y) Object x, y; { +Object Generic_Multiply (Object x, Object y) { Object b, ret; switch (TYPE(x)) { @@ -689,6 +717,8 @@ Object Generic_Multiply (x, y) Object x, y; { return Make_Flonum (FIXNUM(x) * FLONUM(y)->val); case T_Bignum: return Bignum_Fixnum_Multiply (y, x); + default: /* Just to avoid compiler warnings */ + return Null; } case T_Flonum: switch (TYPE(y)) { @@ -698,6 +728,8 @@ Object Generic_Multiply (x, y) Object x, y; { return Make_Flonum (FLONUM(x)->val * FLONUM(y)->val); case T_Bignum: return Make_Flonum (FLONUM(x)->val * Bignum_To_Double (y)); + default: /* Just to avoid compiler warnings */ + return Null; } case T_Bignum: switch (TYPE(y)) { @@ -707,13 +739,17 @@ Object Generic_Multiply (x, y) Object x, y; { return Make_Flonum (Bignum_To_Double (x) * FLONUM(y)->val); case T_Bignum: return Bignum_Multiply (x, y); + default: /* Just to avoid compiler warnings */ + return Null; } + default: /* Just to avoid compiler warnings */ + return Null; } /*NOTREACHED*/ } -Object Generic_Divide (x, y) Object x, y; { - register t = TYPE(y); +Object Generic_Divide (Object x, Object y) { + register int t = TYPE(y); Object b, ret; GC_Node2; @@ -736,6 +772,8 @@ Object Generic_Divide (x, y) Object x, y; { return Car (ret); return Make_Reduced_Flonum ((double)FIXNUM(x) / Bignum_To_Double (y)); + default: /* Just to avoid compiler warnings */ + return Null; } case T_Flonum: switch (t) { @@ -745,6 +783,8 @@ Object Generic_Divide (x, y) Object x, y; { return Make_Flonum (FLONUM(x)->val / FLONUM(y)->val); case T_Bignum: return Make_Flonum (FLONUM(x)->val / Bignum_To_Double (y)); + default: /* Just to avoid compiler warnings */ + return Null; } case T_Bignum: switch (t) { @@ -766,13 +806,17 @@ Object Generic_Divide (x, y) Object x, y; { return Car (ret); return Make_Reduced_Flonum (Bignum_To_Double (x) / Bignum_To_Double (y)); + default: /* Just to avoid compiler warnings */ + return Null; } + default: /* Just to avoid compiler warnings */ + return Null; } /*NOTREACHED*/ } -Object P_Abs (x) Object x; { - register i; +Object P_Abs (Object x) { + register int i; Check_Number (x); switch (TYPE(x)) { @@ -783,12 +827,14 @@ Object P_Abs (x) Object x; { return Make_Flonum (fabs (FLONUM(x)->val)); case T_Bignum: return Bignum_Abs (x); + default: /* Just to avoid compiler warnings */ + return Null; } /*NOTREACHED*/ } -Object General_Integer_Divide (x, y, rem) Object x, y; { - register fx = FIXNUM(x), fy = FIXNUM(y); +Object General_Integer_Divide (Object x, Object y, int rem) { + register int fx = FIXNUM(x), fy = FIXNUM(y); Object b, ret; GC_Node; @@ -806,6 +852,8 @@ Object General_Integer_Divide (x, y, rem) Object x, y; { ret = Bignum_Divide (b, y); done: return rem ? Cdr (ret) : Car (ret); + default: /* Just to avoid compiler warnings */ + return Null; } case T_Bignum: switch (TYPE(y)) { @@ -815,20 +863,24 @@ done: case T_Bignum: ret = Bignum_Divide (x, y); goto done; + default: /* Just to avoid compiler warnings */ + return Null; } + default: /* Just to avoid compiler warnings */ + return Null; } /*NOTREACHED*/ } -Object Exact_Quotient (x, y) Object x, y; { +Object Exact_Quotient (Object x, Object y) { return General_Integer_Divide (x, y, 0); } -Object Exact_Remainder (x, y) Object x, y; { +Object Exact_Remainder (Object x, Object y) { return General_Integer_Divide (x, y, 1); } -Object Exact_Modulo (x, y) Object x, y; { +Object Exact_Modulo (Object x, Object y) { Object rem, xneg, yneg; GC_Node2; @@ -842,7 +894,7 @@ Object Exact_Modulo (x, y) Object x, y; { return rem; } -Object With_Exact_Ints (x, y, fun) Object x, y, (*fun)(); { +Object With_Exact_Ints (Object x, Object y, Object (*fun)()) { Object i, ret; int inex = 0; GC_Node3; @@ -868,19 +920,19 @@ Object With_Exact_Ints (x, y, fun) Object x, y, (*fun)(); { return ret; } -Object P_Quotient (x, y) Object x, y; { +Object P_Quotient (Object x, Object y) { return With_Exact_Ints (x, y, Exact_Quotient); } -Object P_Remainder (x, y) Object x, y; { +Object P_Remainder (Object x, Object y) { return With_Exact_Ints (x, y, Exact_Remainder); } -Object P_Modulo (x, y) Object x, y; { +Object P_Modulo (Object x, Object y) { return With_Exact_Ints (x, y, Exact_Modulo); } -Object Exact_Gcd (x, y) Object x, y; { +Object Exact_Gcd (Object x, Object y) { Object r, z; GC_Node2; @@ -904,15 +956,15 @@ Object Exact_Gcd (x, y) Object x, y; { return r; } -Object General_Gcd (x, y) Object x, y; { +Object General_Gcd (Object x, Object y) { return With_Exact_Ints (x, y, Exact_Gcd); } -Object P_Gcd (argc, argv) Object *argv; { +Object P_Gcd (int argc, Object *argv) { return P_Abs (General_Operator (argc, argv, Zero, General_Gcd)); } -Object Exact_Lcm (x, y) Object x, y; { +Object Exact_Lcm (Object x, Object y) { Object ret, p, z; GC_Node3; @@ -928,15 +980,15 @@ Object Exact_Lcm (x, y) Object x, y; { return ret; } -Object General_Lcm (x, y) Object x, y; { +Object General_Lcm (Object x, Object y) { return With_Exact_Ints (x, y, Exact_Lcm); } -Object P_Lcm (argc, argv) Object *argv; { +Object P_Lcm (int argc, Object *argv) { return P_Abs (General_Operator (argc, argv, One, General_Lcm)); } -#define General_Conversion(name,op) Object name (x) Object x; {\ +#define General_Conversion(name,op) Object name (Object x) {\ double d, i;\ \ Check_Number (x);\ @@ -953,7 +1005,7 @@ General_Conversion (P_Floor, floor) General_Conversion (P_Ceiling, ceil) General_Conversion (P_Truncate, trunc) -Object P_Round (x) Object x; { +Object P_Round (Object x) { double d, y, f; Object ret, isodd; @@ -972,7 +1024,7 @@ Object P_Round (x) Object x; { return ret; } -double Get_Double (x) Object x; { +double Get_Double (Object x) { Check_Number (x); switch (TYPE(x)) { case T_Fixnum: @@ -981,11 +1033,13 @@ double Get_Double (x) Object x; { return FLONUM(x)->val; case T_Bignum: return Bignum_To_Double (x); + default: /* Just to avoid compiler warnings */ + return 0.0; } /*NOTREACHED*/ } -Object General_Function (x, y, fun) Object x, y; double (*fun)(); { +Object General_Function (Object x, Object y, double (*fun)()) { double d, ret; d = Get_Double (x); @@ -999,64 +1053,64 @@ Object General_Function (x, y, fun) Object x, y; double (*fun)(); { return Make_Flonum (ret); } -Object P_Sqrt (x) Object x; { return General_Function (x, Null, sqrt); } +Object P_Sqrt (Object x) { return General_Function (x, Null, sqrt); } -Object P_Exp (x) Object x; { return General_Function (x, Null, exp); } +Object P_Exp (Object x) { return General_Function (x, Null, exp); } -Object P_Log (x) Object x; { return General_Function (x, Null, log); } +Object P_Log (Object x) { return General_Function (x, Null, log); } -Object P_Sin (x) Object x; { return General_Function (x, Null, sin); } +Object P_Sin (Object x) { return General_Function (x, Null, sin); } -Object P_Cos (x) Object x; { return General_Function (x, Null, cos); } +Object P_Cos (Object x) { return General_Function (x, Null, cos); } -Object P_Tan (x) Object x; { return General_Function (x, Null, tan); } +Object P_Tan (Object x) { return General_Function (x, Null, tan); } -Object P_Asin (x) Object x; { return General_Function (x, Null, asin); } +Object P_Asin (Object x) { return General_Function (x, Null, asin); } -Object P_Acos (x) Object x; { return General_Function (x, Null, acos); } +Object P_Acos (Object x) { return General_Function (x, Null, acos); } -Object P_Atan (argc, argv) Object *argv; { - register a2 = argc == 2; - return General_Function (argv[0], a2 ? argv[1] : Null, a2 ? +Object P_Atan (int argc, Object *argv) { + register int a2 = argc == 2; + return General_Function (argv[0], a2 ? argv[1] : Null, a2 ? (double(*)())atan2 : (double(*)())atan); } -Object Min (x, y) Object x, y; { +Object Min (Object x, Object y) { Object ret; - + ret = Generic_Less (x, y) ? x : y; if (TYPE(x) == T_Flonum || TYPE(y) == T_Flonum) ret = P_Exact_To_Inexact (ret); return ret; } -Object Max (x, y) Object x, y; { +Object Max (Object x, Object y) { Object ret; - + ret = Generic_Less (x, y) ? y : x; if (TYPE(x) == T_Flonum || TYPE(y) == T_Flonum) ret = P_Exact_To_Inexact (ret); return ret; } -Object P_Min (argc, argv) Object *argv; { +Object P_Min (int argc, Object *argv) { return General_Operator (argc, argv, argv[0], Min); } -Object P_Max (argc, argv) Object *argv; { +Object P_Max (int argc, Object *argv) { return General_Operator (argc, argv, argv[0], Max); } Object P_Random () { #ifdef RANDOM - extern long random(); + extern long int random(); return Make_Long (random ()); #else return Make_Integer (rand ()); #endif } -Object P_Srandom (x) Object x; { +Object P_Srandom (Object x) { #ifdef RANDOM srandom (Get_Unsigned (x)); #else diff --git a/src/onfork.c b/src/onfork.c index a55807e..6b54134 100644 --- a/src/onfork.c +++ b/src/onfork.c @@ -14,7 +14,7 @@ static FUNCT *Onfork_Funcs; -Register_Onfork (f) void (*f)(); { +void Register_Onfork (void (*f)()) { FUNCT *p; p = (FUNCT *)Safe_Malloc (sizeof (*p)); diff --git a/src/prim.c b/src/prim.c index 2672c55..5aa02d0 100644 --- a/src/prim.c +++ b/src/prim.c @@ -3,6 +3,8 @@ #include "kernel.h" +extern void Memoize_Frame (Object); + struct Prim_Init { Object (*fun)(); char *name; @@ -12,370 +14,370 @@ struct Prim_Init { /* autoload.c: */ - P_Autoload, "autoload", 2, 2, EVAL, + { P_Autoload, "autoload", 2, 2, EVAL }, /* bool.c: */ - P_Booleanp, "boolean?", 1, 1, EVAL, - P_Not, "not", 1, 1, EVAL, - P_Eq, "eq?", 2, 2, EVAL, - P_Eqv, "eqv?", 2, 2, EVAL, - P_Equal, "equal?", 2, 2, EVAL, - P_Empty_List_Is_False, "empty-list-is-false-for-backward-compatibility", - 1, 1, EVAL, + { P_Booleanp, "boolean?", 1, 1, EVAL }, + { P_Not, "not", 1, 1, EVAL }, + { P_Eq, "eq?", 2, 2, EVAL }, + { P_Eqv, "eqv?", 2, 2, EVAL }, + { P_Equal, "equal?", 2, 2, EVAL }, + { P_Empty_List_Is_False, "empty-list-is-false-for-backward-compatibility", + 1, 1, EVAL }, /* char.c: */ - P_Charp, "char?", 1, 1, EVAL, - P_Char_To_Integer, "char->integer", 1, 1, EVAL, - P_Integer_To_Char, "integer->char", 1, 1, EVAL, - P_Char_Upper_Casep, "char-upper-case?", 1, 1, EVAL, - P_Char_Lower_Casep, "char-lower-case?", 1, 1, EVAL, - P_Char_Alphabeticp, "char-alphabetic?", 1, 1, EVAL, - P_Char_Numericp, "char-numeric?", 1, 1, EVAL, - P_Char_Whitespacep, "char-whitespace?", 1, 1, EVAL, - P_Char_Upcase, "char-upcase", 1, 1, EVAL, - P_Char_Downcase, "char-downcase", 1, 1, EVAL, - P_Char_Eq, "char=?", 2, 2, EVAL, - P_Char_Less, "char?", 2, 2, EVAL, - P_Char_Eq_Less, "char<=?", 2, 2, EVAL, - P_Char_Eq_Greater, "char>=?", 2, 2, EVAL, - P_Char_CI_Eq, "char-ci=?", 2, 2, EVAL, - P_Char_CI_Less, "char-ci?", 2, 2, EVAL, - P_Char_CI_Eq_Less, "char-ci<=?", 2, 2, EVAL, - P_Char_CI_Eq_Greater,"char-ci>=?", 2, 2, EVAL, + { P_Charp, "char?", 1, 1, EVAL }, + { P_Char_To_Integer, "char->integer", 1, 1, EVAL }, + { P_Integer_To_Char, "integer->char", 1, 1, EVAL }, + { P_Char_Upper_Casep, "char-upper-case?", 1, 1, EVAL }, + { P_Char_Lower_Casep, "char-lower-case?", 1, 1, EVAL }, + { P_Char_Alphabeticp, "char-alphabetic?", 1, 1, EVAL }, + { P_Char_Numericp, "char-numeric?", 1, 1, EVAL }, + { P_Char_Whitespacep, "char-whitespace?", 1, 1, EVAL }, + { P_Char_Upcase, "char-upcase", 1, 1, EVAL }, + { P_Char_Downcase, "char-downcase", 1, 1, EVAL }, + { P_Char_Eq, "char=?", 2, 2, EVAL }, + { P_Char_Less, "char?", 2, 2, EVAL }, + { P_Char_Eq_Less, "char<=?", 2, 2, EVAL }, + { P_Char_Eq_Greater, "char>=?", 2, 2, EVAL }, + { P_Char_CI_Eq, "char-ci=?", 2, 2, EVAL }, + { P_Char_CI_Less, "char-ci?", 2, 2, EVAL }, + { P_Char_CI_Eq_Less, "char-ci<=?", 2, 2, EVAL }, + { P_Char_CI_Eq_Greater,"char-ci>=?", 2, 2, EVAL }, /* cont.c: */ - P_Control_Pointp, "control-point?", 1, 1, EVAL, - P_Call_With_Current_Continuation, - "call-with-current-continuation", 1, 1, EVAL, - P_Dynamic_Wind, "dynamic-wind", 3, 3, EVAL, - P_Control_Point_Environment, - "control-point-environment", 1, 1, EVAL, + { P_Control_Pointp, "control-point?", 1, 1, EVAL }, + { P_Call_With_Current_Continuation, + "call-with-current-continuation", 1, 1, EVAL }, + { P_Dynamic_Wind, "dynamic-wind", 3, 3, EVAL }, + { P_Control_Point_Environment, + "control-point-environment", 1, 1, EVAL }, /* debug.c: */ - P_Backtrace_List, "backtrace-list", 0, 1, VARARGS, + { P_Backtrace_List, "backtrace-list", 0, 1, VARARGS }, /* dump.c: */ #ifdef CAN_DUMP - P_Dump, "dump", 1, 1, EVAL, + { P_Dump, "dump", 1, 1, EVAL }, #endif /* env.c: */ - P_Environmentp, "environment?", 1, 1, EVAL, - P_The_Environment, "the-environment", 0, 0, EVAL, - P_Global_Environment,"global-environment", 0, 0, EVAL, - P_Define, "define", 1, MANY, NOEVAL, - P_Define_Macro, "define-macro", 1, MANY, NOEVAL, - P_Set, "set!", 2, 2, NOEVAL, - P_Environment_To_List, - "environment->list", 1, 1, EVAL, - P_Boundp, "bound?", 1, 1, EVAL, + { P_Environmentp, "environment?", 1, 1, EVAL }, + { P_The_Environment, "the-environment", 0, 0, EVAL }, + { P_Global_Environment,"global-environment", 0, 0, EVAL }, + { P_Define, "define", 1, MANY, NOEVAL }, + { P_Define_Macro, "define-macro", 1, MANY, NOEVAL }, + { P_Set, "set!", 2, 2, NOEVAL }, + { P_Environment_To_List, + "environment->list", 1, 1, EVAL }, + { P_Boundp, "bound?", 1, 1, EVAL }, /* error.c: */ - P_Error, "error", 2, MANY, VARARGS, - P_Reset, "reset", 0, 0, EVAL, + { P_Error, "error", 2, MANY, VARARGS }, + { P_Reset, "reset", 0, 0, EVAL }, /* exception.c: */ - P_Disable_Interrupts,"disable-interrupts", 0, 0, EVAL, - P_Enable_Interrupts, "enable-interrupts", 0, 0, EVAL, + { P_Disable_Interrupts,"disable-interrupts", 0, 0, EVAL }, + { P_Enable_Interrupts, "enable-interrupts", 0, 0, EVAL }, /* feature.c: */ - P_Features, "features", 0, 0, EVAL, - P_Featurep, "feature?", 1, 1, EVAL, - P_Provide, "provide", 1, 1, EVAL, - P_Require, "require", 1, 3, VARARGS, + { P_Features, "features", 0, 0, EVAL }, + { P_Featurep, "feature?", 1, 1, EVAL }, + { P_Provide, "provide", 1, 1, EVAL }, + { P_Require, "require", 1, 3, VARARGS }, /* heap.c: */ - P_Collect, "collect", 0, 0, EVAL, - P_Garbage_Collect_Status, "garbage-collect-status", 0, 2, VARARGS, + { P_Collect, "collect", 0, 0, EVAL }, + { P_Garbage_Collect_Status, "garbage-collect-status", 0, 2, VARARGS }, #ifdef GENERATIONAL_GC - P_Collect_Incremental, "collect-incremental", 0, 0, EVAL, + { P_Collect_Incremental, "collect-incremental", 0, 0, EVAL }, #endif /* io.c: */ - P_Port_File_Name, "port-file-name", 1, 1, EVAL, - P_Port_Line_Number, "port-line-number", 1, 1, EVAL, - P_Eof_Objectp, "eof-object?", 1, 1, EVAL, - P_Current_Input_Port, - "current-input-port", 0, 0, EVAL, - P_Current_Output_Port, - "current-output-port", 0, 0, EVAL, - P_Input_Portp, "input-port?", 1, 1, EVAL, - P_Output_Portp, "output-port?", 1, 1, EVAL, - P_Open_Input_File, "open-input-file", 1, 1, EVAL, - P_Open_Output_File, "open-output-file", 1, 1, EVAL, - P_Open_Input_Output_File, "open-input-output-file", 1, 1, EVAL, - P_Close_Input_Port, "close-input-port", 1, 1, EVAL, - P_Close_Output_Port, "close-output-port", 1, 1, EVAL, - P_With_Input_From_File, "with-input-from-file", 2, 2, EVAL, - P_With_Output_To_File, "with-output-to-file", 2, 2, EVAL, - P_Call_With_Input_File, "call-with-input-file", 2, 2, EVAL, - P_Call_With_Output_File, "call-with-output-file", 2, 2, EVAL, - P_Open_Input_String, "open-input-string", 1, 1, EVAL, - P_Open_Output_String,"open-output-string", 0, 0, EVAL, - P_Tilde_Expand, "tilde-expand", 1, 1, EVAL, - P_File_Existsp, "file-exists?", 1, 1, EVAL, + { P_Port_File_Name, "port-file-name", 1, 1, EVAL }, + { P_Port_Line_Number, "port-line-number", 1, 1, EVAL }, + { P_Eof_Objectp, "eof-object?", 1, 1, EVAL }, + { P_Current_Input_Port, + "current-input-port", 0, 0, EVAL }, + { P_Current_Output_Port, + "current-output-port", 0, 0, EVAL }, + { P_Input_Portp, "input-port?", 1, 1, EVAL }, + { P_Output_Portp, "output-port?", 1, 1, EVAL }, + { P_Open_Input_File, "open-input-file", 1, 1, EVAL }, + { P_Open_Output_File, "open-output-file", 1, 1, EVAL }, + { P_Open_Input_Output_File, "open-input-output-file", 1, 1, EVAL }, + { P_Close_Input_Port, "close-input-port", 1, 1, EVAL }, + { P_Close_Output_Port, "close-output-port", 1, 1, EVAL }, + { P_With_Input_From_File, "with-input-from-file", 2, 2, EVAL }, + { P_With_Output_To_File, "with-output-to-file", 2, 2, EVAL }, + { P_Call_With_Input_File, "call-with-input-file", 2, 2, EVAL }, + { P_Call_With_Output_File, "call-with-output-file", 2, 2, EVAL }, + { P_Open_Input_String, "open-input-string", 1, 1, EVAL }, + { P_Open_Output_String,"open-output-string", 0, 0, EVAL }, + { P_Tilde_Expand, "tilde-expand", 1, 1, EVAL }, + { P_File_Existsp, "file-exists?", 1, 1, EVAL }, /* load.c: */ - P_Load, "load", 1, 2, VARARGS, + { P_Load, "load", 1, 2, VARARGS }, /* list.c: */ - P_Cons, "cons", 2, 2, EVAL, - P_Car, "car", 1, 1, EVAL, - P_Cdr, "cdr", 1, 1, EVAL, - P_Caar, "caar", 1, 1, EVAL, - P_Cadr, "cadr", 1, 1, EVAL, - P_Cdar, "cdar", 1, 1, EVAL, - P_Cddr, "cddr", 1, 1, EVAL, + { P_Cons, "cons", 2, 2, EVAL }, + { P_Car, "car", 1, 1, EVAL }, + { P_Cdr, "cdr", 1, 1, EVAL }, + { P_Caar, "caar", 1, 1, EVAL }, + { P_Cadr, "cadr", 1, 1, EVAL }, + { P_Cdar, "cdar", 1, 1, EVAL }, + { P_Cddr, "cddr", 1, 1, EVAL }, - P_Caaar, "caaar", 1, 1, EVAL, - P_Caadr, "caadr", 1, 1, EVAL, - P_Cadar, "cadar", 1, 1, EVAL, - P_Caddr, "caddr", 1, 1, EVAL, - P_Cdaar, "cdaar", 1, 1, EVAL, - P_Cdadr, "cdadr", 1, 1, EVAL, - P_Cddar, "cddar", 1, 1, EVAL, - P_Cdddr, "cdddr", 1, 1, EVAL, + { P_Caaar, "caaar", 1, 1, EVAL }, + { P_Caadr, "caadr", 1, 1, EVAL }, + { P_Cadar, "cadar", 1, 1, EVAL }, + { P_Caddr, "caddr", 1, 1, EVAL }, + { P_Cdaar, "cdaar", 1, 1, EVAL }, + { P_Cdadr, "cdadr", 1, 1, EVAL }, + { P_Cddar, "cddar", 1, 1, EVAL }, + { P_Cdddr, "cdddr", 1, 1, EVAL }, - P_Caaaar, "caaaar", 1, 1, EVAL, - P_Caaadr, "caaadr", 1, 1, EVAL, - P_Caadar, "caadar", 1, 1, EVAL, - P_Caaddr, "caaddr", 1, 1, EVAL, - P_Cadaar, "cadaar", 1, 1, EVAL, - P_Cadadr, "cadadr", 1, 1, EVAL, - P_Caddar, "caddar", 1, 1, EVAL, - P_Cadddr, "cadddr", 1, 1, EVAL, - P_Cdaaar, "cdaaar", 1, 1, EVAL, - P_Cdaadr, "cdaadr", 1, 1, EVAL, - P_Cdadar, "cdadar", 1, 1, EVAL, - P_Cdaddr, "cdaddr", 1, 1, EVAL, - P_Cddaar, "cddaar", 1, 1, EVAL, - P_Cddadr, "cddadr", 1, 1, EVAL, - P_Cdddar, "cdddar", 1, 1, EVAL, - P_Cddddr, "cddddr", 1, 1, EVAL, + { P_Caaaar, "caaaar", 1, 1, EVAL }, + { P_Caaadr, "caaadr", 1, 1, EVAL }, + { P_Caadar, "caadar", 1, 1, EVAL }, + { P_Caaddr, "caaddr", 1, 1, EVAL }, + { P_Cadaar, "cadaar", 1, 1, EVAL }, + { P_Cadadr, "cadadr", 1, 1, EVAL }, + { P_Caddar, "caddar", 1, 1, EVAL }, + { P_Cadddr, "cadddr", 1, 1, EVAL }, + { P_Cdaaar, "cdaaar", 1, 1, EVAL }, + { P_Cdaadr, "cdaadr", 1, 1, EVAL }, + { P_Cdadar, "cdadar", 1, 1, EVAL }, + { P_Cdaddr, "cdaddr", 1, 1, EVAL }, + { P_Cddaar, "cddaar", 1, 1, EVAL }, + { P_Cddadr, "cddadr", 1, 1, EVAL }, + { P_Cdddar, "cdddar", 1, 1, EVAL }, + { P_Cddddr, "cddddr", 1, 1, EVAL }, - P_Cxr, "cxr", 2, 2, EVAL, - P_Nullp, "null?", 1, 1, EVAL, - P_Pairp, "pair?", 1, 1, EVAL, - P_Listp, "list?", 1, 1, EVAL, - P_Set_Car, "set-car!", 2, 2, EVAL, - P_Set_Cdr, "set-cdr!", 2, 2, EVAL, - P_Assq, "assq", 2, 2, EVAL, - P_Assv, "assv", 2, 2, EVAL, - P_Assoc, "assoc", 2, 2, EVAL, - P_Memq, "memq", 2, 2, EVAL, - P_Memv, "memv", 2, 2, EVAL, - P_Member, "member", 2, 2, EVAL, - P_Make_List, "make-list", 2, 2, EVAL, - P_List, "list", 0, MANY, VARARGS, - P_Length, "length", 1, 1, EVAL, - P_Append, "append", 0, MANY, VARARGS, - P_Append_Set, "append!", 0, MANY, VARARGS, - P_Last_Pair, "last-pair", 1, 1, EVAL, - P_Reverse, "reverse", 1, 1, EVAL, - P_Reverse_Set, "reverse!", 1, 1, EVAL, - P_List_Tail, "list-tail", 2, 2, EVAL, - P_List_Ref, "list-ref", 2, 2, EVAL, + { P_Cxr, "cxr", 2, 2, EVAL }, + { P_Nullp, "null?", 1, 1, EVAL }, + { P_Pairp, "pair?", 1, 1, EVAL }, + { P_Listp, "list?", 1, 1, EVAL }, + { P_Set_Car, "set-car!", 2, 2, EVAL }, + { P_Set_Cdr, "set-cdr!", 2, 2, EVAL }, + { P_Assq, "assq", 2, 2, EVAL }, + { P_Assv, "assv", 2, 2, EVAL }, + { P_Assoc, "assoc", 2, 2, EVAL }, + { P_Memq, "memq", 2, 2, EVAL }, + { P_Memv, "memv", 2, 2, EVAL }, + { P_Member, "member", 2, 2, EVAL }, + { P_Make_List, "make-list", 2, 2, EVAL }, + { P_List, "list", 0, MANY, VARARGS }, + { P_Length, "length", 1, 1, EVAL }, + { P_Append, "append", 0, MANY, VARARGS }, + { P_Append_Set, "append!", 0, MANY, VARARGS }, + { P_Last_Pair, "last-pair", 1, 1, EVAL }, + { P_Reverse, "reverse", 1, 1, EVAL }, + { P_Reverse_Set, "reverse!", 1, 1, EVAL }, + { P_List_Tail, "list-tail", 2, 2, EVAL }, + { P_List_Ref, "list-ref", 2, 2, EVAL }, /* main.c: */ - P_Command_Line_Args, "command-line-args", 0, 0, EVAL, - P_Exit, "exit", 0, 1, VARARGS, + { P_Command_Line_Args, "command-line-args", 0, 0, EVAL }, + { P_Exit, "exit", 0, 1, VARARGS }, /* math.c: */ - P_Number_To_String, "number->string", 1, 2, VARARGS, - P_Numberp, "number?", 1, 1, EVAL, - P_Complexp, "complex?", 1, 1, EVAL, - P_Realp, "real?", 1, 1, EVAL, - P_Rationalp, "rational?", 1, 1, EVAL, - P_Integerp, "integer?", 1, 1, EVAL, - P_Zerop, "zero?", 1, 1, EVAL, - P_Positivep, "positive?", 1, 1, EVAL, - P_Negativep, "negative?", 1, 1, EVAL, - P_Oddp, "odd?", 1, 1, EVAL, - P_Evenp, "even?", 1, 1, EVAL, - P_Exactp, "exact?", 1, 1, EVAL, - P_Inexactp, "inexact?", 1, 1, EVAL, - P_Exact_To_Inexact, "exact->inexact", 1, 1, EVAL, - P_Inexact_To_Exact, "inexact->exact", 1, 1, EVAL, - P_Generic_Less, "<", 1, MANY, VARARGS, - P_Generic_Greater, ">", 1, MANY, VARARGS, - P_Generic_Equal, "=", 1, MANY, VARARGS, - P_Generic_Eq_Less, "<=", 1, MANY, VARARGS, - P_Generic_Eq_Greater,">=", 1, MANY, VARARGS, - P_Inc, "1+", 1, 1, EVAL, - P_Dec, "-1+", 1, 1, EVAL, - P_Dec, "1-", 1, 1, EVAL, - P_Generic_Plus, "+", 0, MANY, VARARGS, - P_Generic_Minus, "-", 1, MANY, VARARGS, - P_Generic_Multiply, "*", 0, MANY, VARARGS, - P_Generic_Divide, "/", 1, MANY, VARARGS, - P_Abs, "abs", 1, 1, EVAL, - P_Quotient, "quotient", 2, 2, EVAL, - P_Remainder, "remainder", 2, 2, EVAL, - P_Modulo, "modulo", 2, 2, EVAL, - P_Gcd, "gcd", 0, MANY, VARARGS, - P_Lcm, "lcm", 0, MANY, VARARGS, - P_Floor, "floor", 1, 1, EVAL, - P_Ceiling, "ceiling", 1, 1, EVAL, - P_Truncate, "truncate", 1, 1, EVAL, - P_Round, "round", 1, 1, EVAL, - P_Sqrt, "sqrt", 1, 1, EVAL, - P_Exp, "exp", 1, 1, EVAL, - P_Log, "log", 1, 1, EVAL, - P_Sin, "sin", 1, 1, EVAL, - P_Cos, "cos", 1, 1, EVAL, - P_Tan, "tan", 1, 1, EVAL, - P_Asin, "asin", 1, 1, EVAL, - P_Acos, "acos", 1, 1, EVAL, - P_Atan, "atan", 1, 2, VARARGS, - P_Min, "min", 1, MANY, VARARGS, - P_Max, "max", 1, MANY, VARARGS, - P_Random, "random", 0, 0, EVAL, - P_Srandom, "srandom", 1, 1, EVAL, + { P_Number_To_String, "number->string", 1, 2, VARARGS }, + { P_Numberp, "number?", 1, 1, EVAL }, + { P_Complexp, "complex?", 1, 1, EVAL }, + { P_Realp, "real?", 1, 1, EVAL }, + { P_Rationalp, "rational?", 1, 1, EVAL }, + { P_Integerp, "integer?", 1, 1, EVAL }, + { P_Zerop, "zero?", 1, 1, EVAL }, + { P_Positivep, "positive?", 1, 1, EVAL }, + { P_Negativep, "negative?", 1, 1, EVAL }, + { P_Oddp, "odd?", 1, 1, EVAL }, + { P_Evenp, "even?", 1, 1, EVAL }, + { P_Exactp, "exact?", 1, 1, EVAL }, + { P_Inexactp, "inexact?", 1, 1, EVAL }, + { P_Exact_To_Inexact, "exact->inexact", 1, 1, EVAL }, + { P_Inexact_To_Exact, "inexact->exact", 1, 1, EVAL }, + { P_Generic_Less, "<", 1, MANY, VARARGS }, + { P_Generic_Greater, ">", 1, MANY, VARARGS }, + { P_Generic_Equal, "=", 1, MANY, VARARGS }, + { P_Generic_Eq_Less, "<=", 1, MANY, VARARGS }, + { P_Generic_Eq_Greater,">=", 1, MANY, VARARGS }, + { P_Inc, "1+", 1, 1, EVAL }, + { P_Dec, "-1+", 1, 1, EVAL }, + { P_Dec, "1-", 1, 1, EVAL }, + { P_Generic_Plus, "+", 0, MANY, VARARGS }, + { P_Generic_Minus, "-", 1, MANY, VARARGS }, + { P_Generic_Multiply, "*", 0, MANY, VARARGS }, + { P_Generic_Divide, "/", 1, MANY, VARARGS }, + { P_Abs, "abs", 1, 1, EVAL }, + { P_Quotient, "quotient", 2, 2, EVAL }, + { P_Remainder, "remainder", 2, 2, EVAL }, + { P_Modulo, "modulo", 2, 2, EVAL }, + { P_Gcd, "gcd", 0, MANY, VARARGS }, + { P_Lcm, "lcm", 0, MANY, VARARGS }, + { P_Floor, "floor", 1, 1, EVAL }, + { P_Ceiling, "ceiling", 1, 1, EVAL }, + { P_Truncate, "truncate", 1, 1, EVAL }, + { P_Round, "round", 1, 1, EVAL }, + { P_Sqrt, "sqrt", 1, 1, EVAL }, + { P_Exp, "exp", 1, 1, EVAL }, + { P_Log, "log", 1, 1, EVAL }, + { P_Sin, "sin", 1, 1, EVAL }, + { P_Cos, "cos", 1, 1, EVAL }, + { P_Tan, "tan", 1, 1, EVAL }, + { P_Asin, "asin", 1, 1, EVAL }, + { P_Acos, "acos", 1, 1, EVAL }, + { P_Atan, "atan", 1, 2, VARARGS }, + { P_Min, "min", 1, MANY, VARARGS }, + { P_Max, "max", 1, MANY, VARARGS }, + { P_Random, "random", 0, 0, EVAL }, + { P_Srandom, "srandom", 1, 1, EVAL }, /* prim.c: */ /* print.c: */ - P_Write, "write", 1, 2, VARARGS, - P_Display, "display", 1, 2, VARARGS, - P_Write_Char, "write-char", 1, 2, VARARGS, - P_Newline, "newline", 0, 1, VARARGS, - P_Print, "print", 1, 2, VARARGS, - P_Clear_Output_Port, "clear-output-port", 0, 1, VARARGS, - P_Flush_Output_Port, "flush-output-port", 0, 1, VARARGS, - P_Get_Output_String, "get-output-string", 1, 1, EVAL, - P_Format, "format", 2, MANY, VARARGS, + { P_Write, "write", 1, 2, VARARGS }, + { P_Display, "display", 1, 2, VARARGS }, + { P_Write_Char, "write-char", 1, 2, VARARGS }, + { P_Newline, "newline", 0, 1, VARARGS }, + { P_Print, "print", 1, 2, VARARGS }, + { P_Clear_Output_Port, "clear-output-port", 0, 1, VARARGS }, + { P_Flush_Output_Port, "flush-output-port", 0, 1, VARARGS }, + { P_Get_Output_String, "get-output-string", 1, 1, EVAL }, + { P_Format, "format", 2, MANY, VARARGS }, /* proc.c: */ - P_Procedurep, "procedure?", 1, 1, EVAL, - P_Primitivep, "primitive?", 1, 1, EVAL, - P_Compoundp, "compound?", 1, 1, EVAL, - P_Macrop, "macro?", 1, 1, EVAL, - P_Eval, "eval", 1, 2, VARARGS, - P_Apply, "apply", 2, MANY, VARARGS, - P_Lambda, "lambda", 2, MANY, NOEVAL, - P_Procedure_Environment, - "procedure-environment", 1, 1, EVAL, - P_Procedure_Lambda, "procedure-lambda", 1, 1, EVAL, - P_Map, "map", 2, MANY, VARARGS, - P_For_Each, "for-each", 2, MANY, VARARGS, - P_Macro, "macro", 2, MANY, NOEVAL, - P_Macro_Body, "macro-body", 1, 1, EVAL, - P_Macro_Expand, "macro-expand", 1, 1, EVAL, + { P_Procedurep, "procedure?", 1, 1, EVAL }, + { P_Primitivep, "primitive?", 1, 1, EVAL }, + { P_Compoundp, "compound?", 1, 1, EVAL }, + { P_Macrop, "macro?", 1, 1, EVAL }, + { P_Eval, "eval", 1, 2, VARARGS }, + { P_Apply, "apply", 2, MANY, VARARGS }, + { P_Lambda, "lambda", 2, MANY, NOEVAL }, + { P_Procedure_Environment, + "procedure-environment", 1, 1, EVAL }, + { P_Procedure_Lambda, "procedure-lambda", 1, 1, EVAL }, + { P_Map, "map", 2, MANY, VARARGS }, + { P_For_Each, "for-each", 2, MANY, VARARGS }, + { P_Macro, "macro", 2, MANY, NOEVAL }, + { P_Macro_Body, "macro-body", 1, 1, EVAL }, + { P_Macro_Expand, "macro-expand", 1, 1, EVAL }, /* promise.c: */ - P_Delay, "delay", 1, 1, NOEVAL, - P_Force, "force", 1, 1, EVAL, - P_Promisep, "promise?", 1, 1, EVAL, - P_Promise_Environment, - "promise-environment", 1, 1, EVAL, + { P_Delay, "delay", 1, 1, NOEVAL }, + { P_Force, "force", 1, 1, EVAL }, + { P_Promisep, "promise?", 1, 1, EVAL }, + { P_Promise_Environment, + "promise-environment", 1, 1, EVAL }, /* read.c: */ - P_Clear_Input_Port, "clear-input-port", 0, 1, VARARGS, - P_Read, "read", 0, 1, VARARGS, - P_Read_Char, "read-char", 0, 1, VARARGS, - P_Read_String, "read-string", 0, 1, VARARGS, - P_Unread_Char, "unread-char", 1, 2, VARARGS, - P_Peek_Char, "peek-char", 0, 1, VARARGS, - P_Char_Readyp, "char-ready?", 0, 1, VARARGS, + { P_Clear_Input_Port, "clear-input-port", 0, 1, VARARGS }, + { P_Read, "read", 0, 1, VARARGS }, + { P_Read_Char, "read-char", 0, 1, VARARGS }, + { P_Read_String, "read-string", 0, 1, VARARGS }, + { P_Unread_Char, "unread-char", 1, 2, VARARGS }, + { P_Peek_Char, "peek-char", 0, 1, VARARGS }, + { P_Char_Readyp, "char-ready?", 0, 1, VARARGS }, /* special.c: */ - P_Quote, "quote", 1, 1, NOEVAL, - P_Quasiquote, "quasiquote", 1, 1, NOEVAL, - P_Begin, "begin", 1, MANY, NOEVAL, - P_Begin1, "begin1", 1, MANY, NOEVAL, - P_If, "if", 2, MANY, NOEVAL, - P_Case, "case", 2, MANY, NOEVAL, - P_Cond, "cond", 1, MANY, NOEVAL, - P_Do, "do", 2, MANY, NOEVAL, - P_Let, "let", 2, MANY, NOEVAL, - P_Letseq, "let*", 2, MANY, NOEVAL, - P_Letrec, "letrec", 2, MANY, NOEVAL, - P_Fluid_Let, "fluid-let", 2, MANY, NOEVAL, - P_And, "and", 0, MANY, NOEVAL, - P_Or, "or", 0, MANY, NOEVAL, + { P_Quote, "quote", 1, 1, NOEVAL }, + { P_Quasiquote, "quasiquote", 1, 1, NOEVAL }, + { P_Begin, "begin", 1, MANY, NOEVAL }, + { P_Begin1, "begin1", 1, MANY, NOEVAL }, + { P_If, "if", 2, MANY, NOEVAL }, + { P_Case, "case", 2, MANY, NOEVAL }, + { P_Cond, "cond", 1, MANY, NOEVAL }, + { P_Do, "do", 2, MANY, NOEVAL }, + { P_Let, "let", 2, MANY, NOEVAL }, + { P_Letseq, "let*", 2, MANY, NOEVAL }, + { P_Letrec, "letrec", 2, MANY, NOEVAL }, + { P_Fluid_Let, "fluid-let", 2, MANY, NOEVAL }, + { P_And, "and", 0, MANY, NOEVAL }, + { P_Or, "or", 0, MANY, NOEVAL }, /* string.c: */ - P_String, "string", 0, MANY, VARARGS, - P_Stringp, "string?", 1, 1, EVAL, - P_Make_String, "make-string", 1, 2, VARARGS, - P_String_Length, "string-length", 1, 1, EVAL, - P_String_To_Number, "string->number", 1, 2, VARARGS, - P_String_Ref, "string-ref", 2, 2, EVAL, - P_String_Set, "string-set!", 3, 3, EVAL, - P_Substring, "substring", 3, 3, EVAL, - P_String_Copy, "string-copy", 1, 1, EVAL, - P_String_Append, "string-append", 0, MANY, VARARGS, - P_List_To_String, "list->string", 1, 1, EVAL, - P_String_To_List, "string->list", 1, 1, EVAL, - P_String_Fill, "string-fill!", 2, 2, EVAL, - P_Substring_Fill, "substring-fill!", 4, 4, EVAL, - P_String_Eq, "string=?", 2, 2, EVAL, - P_String_Less, "string?", 2, 2, EVAL, - P_String_Eq_Less, "string<=?", 2, 2, EVAL, - P_String_Eq_Greater, "string>=?", 2, 2, EVAL, - P_String_CI_Eq, "string-ci=?", 2, 2, EVAL, - P_String_CI_Less, "string-ci?", 2, 2, EVAL, - P_String_CI_Eq_Less, "string-ci<=?", 2, 2, EVAL, - P_String_CI_Eq_Greater, - "string-ci>=?", 2, 2, EVAL, - P_Substringp, "substring?", 2, 2, EVAL, - P_CI_Substringp, "substring-ci?", 2, 2, EVAL, + { P_String, "string", 0, MANY, VARARGS }, + { P_Stringp, "string?", 1, 1, EVAL }, + { P_Make_String, "make-string", 1, 2, VARARGS }, + { P_String_Length, "string-length", 1, 1, EVAL }, + { P_String_To_Number, "string->number", 1, 2, VARARGS }, + { P_String_Ref, "string-ref", 2, 2, EVAL }, + { P_String_Set, "string-set!", 3, 3, EVAL }, + { P_Substring, "substring", 3, 3, EVAL }, + { P_String_Copy, "string-copy", 1, 1, EVAL }, + { P_String_Append, "string-append", 0, MANY, VARARGS }, + { P_List_To_String, "list->string", 1, 1, EVAL }, + { P_String_To_List, "string->list", 1, 1, EVAL }, + { P_String_Fill, "string-fill!", 2, 2, EVAL }, + { P_Substring_Fill, "substring-fill!", 4, 4, EVAL }, + { P_String_Eq, "string=?", 2, 2, EVAL }, + { P_String_Less, "string?", 2, 2, EVAL }, + { P_String_Eq_Less, "string<=?", 2, 2, EVAL }, + { P_String_Eq_Greater, "string>=?", 2, 2, EVAL }, + { P_String_CI_Eq, "string-ci=?", 2, 2, EVAL }, + { P_String_CI_Less, "string-ci?", 2, 2, EVAL }, + { P_String_CI_Eq_Less, "string-ci<=?", 2, 2, EVAL }, + { P_String_CI_Eq_Greater, + "string-ci>=?", 2, 2, EVAL }, + { P_Substringp, "substring?", 2, 2, EVAL }, + { P_CI_Substringp, "substring-ci?", 2, 2, EVAL }, /* symbol.c: */ - P_String_To_Symbol, "string->symbol", 1, 1, EVAL, - P_Oblist, "oblist", 0, 0, EVAL, - P_Symbolp, "symbol?", 1, 1, EVAL, - P_Symbol_To_String, "symbol->string", 1, 1, EVAL, - P_Put, "put", 2, 3, VARARGS, - P_Get, "get", 2, 2, EVAL, - P_Symbol_Plist, "symbol-plist", 1, 1, EVAL, + { P_String_To_Symbol, "string->symbol", 1, 1, EVAL }, + { P_Oblist, "oblist", 0, 0, EVAL }, + { P_Symbolp, "symbol?", 1, 1, EVAL }, + { P_Symbol_To_String, "symbol->string", 1, 1, EVAL }, + { P_Put, "put", 2, 3, VARARGS }, + { P_Get, "get", 2, 2, EVAL }, + { P_Symbol_Plist, "symbol-plist", 1, 1, EVAL }, /* type.c: */ - P_Type, "type", 1, 1, EVAL, + { P_Type, "type", 1, 1, EVAL }, /* vector.c: */ - P_Vectorp, "vector?", 1, 1, EVAL, - P_Make_Vector, "make-vector", 1, 2, VARARGS, - P_Vector, "vector", 0, MANY, VARARGS, - P_Vector_Length, "vector-length", 1, 1, EVAL, - P_Vector_Ref, "vector-ref", 2, 2, EVAL, - P_Vector_Set, "vector-set!", 3, 3, EVAL, - P_Vector_To_List, "vector->list", 1, 1, EVAL, - P_List_To_Vector, "list->vector", 1, 1, EVAL, - P_Vector_Fill, "vector-fill!", 2, 2, EVAL, - P_Vector_Copy, "vector-copy", 1, 1, EVAL, + { P_Vectorp, "vector?", 1, 1, EVAL }, + { P_Make_Vector, "make-vector", 1, 2, VARARGS }, + { P_Vector, "vector", 0, MANY, VARARGS }, + { P_Vector_Length, "vector-length", 1, 1, EVAL }, + { P_Vector_Ref, "vector-ref", 2, 2, EVAL }, + { P_Vector_Set, "vector-set!", 3, 3, EVAL }, + { P_Vector_To_List, "vector->list", 1, 1, EVAL }, + { P_List_To_Vector, "list->vector", 1, 1, EVAL }, + { P_Vector_Fill, "vector-fill!", 2, 2, EVAL }, + { P_Vector_Copy, "vector-copy", 1, 1, EVAL }, - 0 + { 0 } }; /* The C-compiler can't initialize unions, thus the primitive procedures @@ -383,7 +385,7 @@ struct Prim_Init { * provide an intializer for the "tag" component of an S_Primitive). */ -Init_Prim () { +void Init_Prim () { register struct Prim_Init *p; Object frame, prim, sym; @@ -397,8 +399,8 @@ Init_Prim () { Memoize_Frame (frame); } -Define_Primitive (fun, name, min, max, disc) Object (*fun)(); const char *name; - enum discipline disc; { +void Define_Primitive (Object (*fun)(), char const *name, int min, int max, + enum discipline disc) { Object prim, sym, frame; GC_Node2; diff --git a/src/print.c b/src/print.c index dc06212..63cbb80 100644 --- a/src/print.c +++ b/src/print.c @@ -16,34 +16,45 @@ #endif #endif +extern void Print_Bignum (Object, Object); + extern int errno; +void Flush_Output (Object); +void Print_String (Object, register char *, register int); +void Pr_Char (Object, register int); +void Pr_Symbol (Object, Object, int); +void Pr_List (Object, Object, register int, register int, register int); +void Pr_String (Object, Object, int); +void Pr_Vector (Object, Object, register int, register int, register int); +void Print_Special (Object, register int); + int Saved_Errno; static Object V_Print_Depth, V_Print_Length; -Init_Print () { +void Init_Print () { Define_Variable (&V_Print_Depth, "print-depth", Make_Integer (DEF_PRINT_DEPTH)); Define_Variable (&V_Print_Length, "print-length", Make_Integer (DEF_PRINT_LEN)); } -Print_Length () { +int Print_Length () { Object pl; pl = Var_Get (V_Print_Length); return TYPE(pl) == T_Fixnum ? FIXNUM(pl) : DEF_PRINT_LEN; } -Print_Depth () { +int Print_Depth () { Object pd; pd = Var_Get (V_Print_Depth); return TYPE(pd) == T_Fixnum ? FIXNUM(pd) : DEF_PRINT_DEPTH; } -Print_Char (port, c) Object port; register c; { +void Print_Char (Object port, register int c) { char buf[1]; if (PORT(port)->flags & P_STRING) { @@ -57,8 +68,8 @@ Print_Char (port, c) Object port; register c; { } } -Print_String (port, buf, len) Object port; register char *buf; register len; { - register n; +void Print_String (Object port, register char *buf, register int len) { + register int n; register struct S_Port *p; Object new; GC_Node; @@ -73,19 +84,19 @@ Print_String (port, buf, len) Object port; register char *buf; register len; { new = Make_String ((char *)0, STRING(p->name)->size + n); p = PORT(port); GC_Unlink; - bcopy (STRING(p->name)->data, STRING(new)->data, p->ptr); + memcpy (STRING(new)->data, STRING(p->name)->data, p->ptr); p->name = new; } - bcopy (buf, STRING(p->name)->data + p->ptr, len); + memcpy (STRING(p->name)->data + p->ptr, buf, len); p->ptr += len; } #ifndef VPRINTF -vfprintf (f, fmt, ap) register FILE *f; register char *fmt; va_list ap; { +void vfprintf (register FILE *f, register char *fmt, va_list ap) { _doprnt (fmt, ap, f); } -vsprintf (s, fmt, ap) register char *s, *fmt; va_list ap; { +void vsprintf (register char *s, register char *fmt, va_list ap) { FILE x; x._flag = _IOWRT|_IOSTRG; x._ptr = s; @@ -96,7 +107,7 @@ vsprintf (s, fmt, ap) register char *s, *fmt; va_list ap; { #endif /*VARARGS0*/ -Printf (va_alist) va_dcl { +void Printf (va_alist) va_dcl { va_list args; Object port; char *fmt; @@ -118,31 +129,31 @@ Printf (va_alist) va_dcl { va_end (args); } -Object General_Print (argc, argv, raw) Object *argv; { +Object General_Print (int argc, Object *argv, int raw) { General_Print_Object (argv[0], argc == 2 ? argv[1] : Curr_Output_Port, raw); return Void; } -Object P_Write (argc, argv) Object *argv; { +Object P_Write (int argc, Object *argv) { return General_Print (argc, argv, 0); } -Object P_Display (argc, argv) Object *argv; { +Object P_Display (int argc, Object *argv) { return General_Print (argc, argv, 1); } -Object P_Write_Char (argc, argv) Object *argv; { +Object P_Write_Char (int argc, Object *argv) { Check_Type (argv[0], T_Character); return General_Print (argc, argv, 1); } /*VARARGS1*/ -Object P_Newline (argc, argv) Object *argv; { +Object P_Newline (int argc, Object *argv) { General_Print_Object (Newline, argc == 1 ? argv[0] : Curr_Output_Port, 1); return Void; } -Object P_Print (argc, argv) Object *argv; { +Object P_Print (int argc, Object *argv) { Object port; GC_Node; @@ -155,12 +166,12 @@ Object P_Print (argc, argv) Object *argv; { return Void; } -Object P_Clear_Output_Port (argc, argv) Object *argv; { +Object P_Clear_Output_Port (int argc, Object *argv) { Discard_Output (argc == 1 ? argv[0] : Curr_Output_Port); return Void; } -Discard_Output (port) Object port; { +void Discard_Output (Object port) { register FILE *f; Check_Output_Port (port); @@ -184,12 +195,12 @@ Discard_Output (port) Object port; { #endif } -Object P_Flush_Output_Port (argc, argv) Object *argv; { +Object P_Flush_Output_Port (int argc, Object *argv) { Flush_Output (argc == 1 ? argv[0] : Curr_Output_Port); return Void; } -Flush_Output (port) Object port; { +void Flush_Output (Object port) { Check_Output_Port (port); if (PORT(port)->flags & P_STRING) return; @@ -199,7 +210,7 @@ Flush_Output (port) Object port; { } } -Object P_Get_Output_String (port) Object port; { +Object P_Get_Output_String (Object port) { register struct S_Port *p; Object str; GC_Node; @@ -208,13 +219,13 @@ Object P_Get_Output_String (port) Object port; { GC_Link (port); str = Make_String ((char *)0, PORT(port)->ptr); p = PORT(port); - bcopy (STRING(p->name)->data, STRING(str)->data, p->ptr); + memcpy (STRING(str)->data, STRING(p->name)->data, p->ptr); p->ptr = 0; GC_Unlink; return str; } - -Check_Output_Port (port) Object port; { + +void Check_Output_Port (Object port) { Check_Type (port, T_Port); if (!(PORT(port)->flags & P_OPEN)) Primitive_Error ("port has been closed: ~s", port); @@ -222,14 +233,14 @@ Check_Output_Port (port) Object port; { Primitive_Error ("not an output port: ~s", port); } -General_Print_Object (x, port, raw) Object x, port; { +void General_Print_Object (Object x, Object port, int raw) { Check_Output_Port (port); Print_Object (x, port, raw, Print_Depth (), Print_Length ()); } -Print_Object (x, port, raw, depth, length) Object x, port; - register raw, depth, length; { - register t; +void Print_Object (Object x, Object port, register int raw, register int depth, + register int length) { + register int t; GC_Node2; GC_Link2 (port, x); @@ -341,7 +352,7 @@ Print_Object (x, port, raw, depth, length) Object x, port; GC_Unlink; } -Pr_Char (port, c) Object port; register c; { +void Pr_Char (Object port, register int c) { register char *p = 0; switch (c) { @@ -372,10 +383,10 @@ Pr_Char (port, c) Object port; register c; { if (p) Printf (port, p); } -Pr_List (port, list, raw, depth, length) Object port, list; - register raw, depth, length; { +void Pr_List (Object port, Object list, register int raw, register int depth, + register int length) { Object tail; - register len; + register int len; register char *s = 0; GC_Node2; @@ -427,9 +438,9 @@ Pr_List (port, list, raw, depth, length) Object port, list; GC_Unlink; } -Pr_Vector (port, vec, raw, depth, length) Object port, vec; - register raw, depth, length; { - register i, j; +void Pr_Vector (Object port, Object vec, register int raw, register int depth, + register int length) { + register int i, j; GC_Node2; if (depth == 0) { @@ -451,9 +462,9 @@ Pr_Vector (port, vec, raw, depth, length) Object port, vec; GC_Unlink; } -Pr_Symbol (port, sym, raw) Object port, sym; { +void Pr_Symbol (Object port, Object sym, int raw) { Object str; - register c, i; + register int c, i; GC_Node2; str = SYMBOL(sym)->name; @@ -481,9 +492,9 @@ Pr_Symbol (port, sym, raw) Object port, sym; { GC_Unlink; } -Pr_String (port, str, raw) Object port, str; { +void Pr_String (Object port, Object str, int raw) { register char *p = STRING(str)->data; - register c, i, len = STRING(str)->size; + register int c, i, len = STRING(str)->size; GC_Node2; if (raw) { @@ -512,7 +523,7 @@ Pr_String (port, str, raw) Object port, str; { GC_Unlink; } -Print_Special (port, c) Object port; register c; { +void Print_Special (Object port, register int c) { register char *fmt = "\\%c"; switch (c) { @@ -526,9 +537,9 @@ Print_Special (port, c) Object port; register c; { Printf (port, fmt, (unsigned char)c); } -Object P_Format (argc, argv) Object *argv; { +Object P_Format (int argc, Object *argv) { Object port, str; - register stringret = 0; + register int stringret = 0; GC_Node; port = argv[0]; @@ -550,24 +561,17 @@ Object P_Format (argc, argv) Object *argv; { return stringret ? P_Get_Output_String (port) : Void; } -Format (port, fmt, len, argc, argv) Object port; const char *fmt; - int len; Object *argv; { - register const char *s, *ep; +void Format (Object port, char const *fmt, int len, int argc, Object *argv) { + register char const *s, *ep; char *p; - register c; + register int c; char buf[256]; - extern sys_nerr; -#ifndef __bsdi__ - #ifndef __linux__ - extern char *sys_errlist[]; - #endif -#endif GC_Node; Alloca_Begin; GC_Link (port); Alloca (p, char*, len); - bcopy (fmt, p, len); + memcpy (p, fmt, len); for (ep = p + len; p < ep; p++) { if (*p == '~') { if (++p == ep) break; diff --git a/src/proc.c b/src/proc.c index f4795ff..38b01ff 100644 --- a/src/proc.c +++ b/src/proc.c @@ -25,6 +25,13 @@ Funcall_Control_Point (func, args, eval);\ } else Primitive_Error ("application of non-procedure: ~s", func);\ +extern void Switch_Environment (Object); +extern unsigned int Stack_Size (); +extern void Uncatchable_Error (char *); +extern void Funcall_Control_Point (Object, Object, int) + __attribute__ ((__noreturn__)); +extern void Pop_Frame (); +extern void Push_Frame (Object); /* Tail_Call indicates whether we are executing the last form in a * sequence of forms. If it is true and we are about to call a compound @@ -40,13 +47,13 @@ static Object tc_fun, tc_argl, tc_env; Object Macro_Expand(), Funcall_Primitive(), Funcall_Compound(); -Init_Proc () { +void Init_Proc () { Define_Symbol (&Sym_Lambda, "lambda"); Define_Symbol (&Sym_Macro, "macro"); } -Check_Procedure (x) Object x; { - register t = TYPE(x); +void Check_Procedure (Object x) { + register int t = TYPE(x); if (t != T_Primitive && t != T_Compound) Wrong_Type_Combination (x, "procedure"); @@ -54,21 +61,21 @@ Check_Procedure (x) Object x; { Primitive_Error ("invalid procedure: ~s", x); } -Object P_Procedurep (x) Object x; { - register t = TYPE(x); +Object P_Procedurep (Object x) { + register int t = TYPE(x); return t == T_Primitive || t == T_Compound || t == T_Control_Point ? True : False; } -Object P_Primitivep (x) Object x; { +Object P_Primitivep (Object x) { return TYPE(x) == T_Primitive ? True : False; } -Object P_Compoundp (x) Object x; { +Object P_Compoundp (Object x) { return TYPE(x) == T_Compound ? True : False; } -Object P_Macrop (x) Object x; { +Object P_Macrop (Object x) { return TYPE(x) == T_Macro ? True : False; } @@ -80,8 +87,8 @@ Object Make_Compound () { return proc; } -Object Make_Primitive (fun, name, min, max, disc) Object (*fun)(); - const char *name; enum discipline disc; { +Object Make_Primitive (Object (*fun)(), char const *name, int min, int max, + enum discipline disc) { Object prim; register struct S_Primitive *pr; @@ -96,11 +103,11 @@ Object Make_Primitive (fun, name, min, max, disc) Object (*fun)(); return prim; } -Object Eval (form) Object form; { - register t; +Object Eval (Object form) { + register int t; register struct S_Symbol *sym; Object fun, binding, ret; - static unsigned tick; + static unsigned int tick; GC_Node; TC_Prolog; @@ -150,7 +157,7 @@ again: /*NOTREACHED*/ } -Object P_Eval (argc, argv) Object *argv; { +Object P_Eval (int argc, Object *argv) { Object ret, oldenv; GC_Node; @@ -166,9 +173,9 @@ Object P_Eval (argc, argv) Object *argv; { return ret; } -Object P_Apply (argc, argv) Object *argv; { +Object P_Apply (int argc, Object *argv) { Object ret, list, tail, cell, last; - register i; + register int i; GC_Node3; Check_Procedure (argv[0]); @@ -196,11 +203,11 @@ Object P_Apply (argc, argv) Object *argv; { return ret; } -Object Funcall_Primitive (fun, argl, eval) Object fun, argl; { +Object Funcall_Primitive (Object fun, Object argl, int eval) { register struct S_Primitive *prim; - register argc, i; - const char *last_tag; - register Object *argv; + register int argc, i; + char const *last_tag; + register Object *argv = NULL; Object abuf[MAX_ARGS_ON_STACK], r, e; GC_Node4; GCNODE gcv; TC_Prolog; @@ -299,9 +306,9 @@ Object Funcall_Primitive (fun, argl, eval) Object fun, argl; { frame = Cons (r, frame);\ } -Object Funcall_Compound (fun, argl, eval) Object fun, argl; { - register argc, min, max, i, tail_calling = 0; - register Object *argv; +Object Funcall_Compound (Object fun, Object argl, int eval) { + register int argc, min, max, i, tail_calling = 0; + register Object *argv = NULL; Object abuf[MAX_ARGS_ON_STACK], rest, r, frame, tail, tail_call_env, oldenv, newframe; register GCNODE *p; @@ -386,13 +393,13 @@ again: return r; } -Object Funcall (fun, argl, eval) Object fun, argl; { - register t = TYPE(fun); +Object Funcall (Object fun, Object argl, int eval) { + register int t = TYPE(fun); Funcall_Switch (t, fun, argl, eval); /*NOTREACHED*/ } -Check_Formals (x, min, max) Object x; int *min, *max; { +void Check_Formals (Object x, int *min, int *max) { Object s, t1, t2; *min = *max = 0; @@ -412,7 +419,7 @@ Check_Formals (x, min, max) Object x; int *min, *max; { Wrong_Type_Combination (t1, "list or symbol"); } -Object P_Lambda (argl) Object argl; { +Object P_Lambda (Object argl) { Object proc, closure; GC_Node2; @@ -429,18 +436,18 @@ Object P_Lambda (argl) Object argl; { return proc; } -Object P_Procedure_Lambda (p) Object p; { +Object P_Procedure_Lambda (Object p) { Check_Type (p, T_Compound); return Copy_List (COMPOUND(p)->closure); } -Object P_Procedure_Environment (p) Object p; { +Object P_Procedure_Environment (Object p) { Check_Type (p, T_Compound); return COMPOUND(p)->env; } -Object General_Map (argc, argv, accum) Object *argv; register accum; { - register i; +Object General_Map (int argc, Object *argv, register int accum) { + register int i; Object *args; Object head, list, tail, cell, arglist, val; GC_Node2; GCNODE gcv; @@ -480,11 +487,11 @@ Object General_Map (argc, argv, accum) Object *argv; register accum; { /*NOTREACHED*/ } -Object P_Map (argc, argv) Object *argv; { +Object P_Map (int argc, Object *argv) { return General_Map (argc, argv, 1); } -Object P_For_Each (argc, argv) Object *argv; { +Object P_For_Each (int argc, Object *argv) { return General_Map (argc, argv, 0); } @@ -496,7 +503,7 @@ Object Make_Macro () { return mac; } -Object P_Macro (argl) Object argl; { +Object P_Macro (Object argl) { Object mac, body; GC_Node2; @@ -510,13 +517,13 @@ Object P_Macro (argl) Object argl; { return mac; } -Object P_Macro_Body (m) Object m; { +Object P_Macro_Body (Object m) { Check_Type (m, T_Macro); return Copy_List (MACRO(m)->body); } -Object Macro_Expand (mac, argl) Object mac, argl; { - register argc, min, max, i; +Object Macro_Expand (Object mac, Object argl) { + register int argc, min, max, i; Object frame, r, tail; GC_Node4; TC_Prolog; @@ -544,7 +551,7 @@ Object Macro_Expand (mac, argl) Object mac, argl; { return r; } -Object P_Macro_Expand (form) Object form; { +Object P_Macro_Expand (Object form) { Object ret, mac; GC_Node; diff --git a/src/promise.c b/src/promise.c index c1a35bb..c231df7 100644 --- a/src/promise.c +++ b/src/promise.c @@ -3,11 +3,11 @@ #include "kernel.h" -Object P_Promisep (x) Object x; { +Object P_Promisep (Object x) { return TYPE(x) == T_Promise ? True : False; } -Object P_Delay (argl) Object argl; { +Object P_Delay (Object argl) { Object d; GC_Node; @@ -20,7 +20,7 @@ Object P_Delay (argl) Object argl; { return d; } -Object P_Force (d) Object d; { +Object P_Force (Object d) { Object ret, a[2]; GC_Node; TC_Prolog; @@ -41,7 +41,7 @@ Object P_Force (d) Object d; { return ret; } -Object P_Promise_Environment (p) Object p; { +Object P_Promise_Environment (Object p) { Check_Type (p, T_Promise); return PROMISE(p)->env; } diff --git a/src/read.c b/src/read.c index 1eebfe2..3667a42 100644 --- a/src/read.c +++ b/src/read.c @@ -5,6 +5,7 @@ #include #include +#include #ifdef FLUSH_TIOCFLUSH # include @@ -18,9 +19,14 @@ # include FIONREAD_H #endif +extern void Flush_Output (Object); + extern char *index(); extern double atof(); +int Skip_Comment (Object); +void Reader_Error (Object, char *) __attribute__ ((__noreturn__)); + Object Sym_Quote, Sym_Quasiquote, Sym_Unquote, @@ -46,7 +52,7 @@ Object General_Read(), Read_Sequence(), Read_Atom(), Read_Special(); Object Read_String(), Read_Sharp(), Read_True(), Read_False(), Read_Void(); Object Read_Kludge(), Read_Vector(), Read_Radix(), Read_Char(); -Init_Read () { +void Init_Read () { Define_Symbol (&Sym_Quote, "quote"); Define_Symbol (&Sym_Quasiquote, "quasiquote"); Define_Symbol (&Sym_Unquote, "unquote"); @@ -69,7 +75,7 @@ Init_Read () { Read_Buf = Safe_Malloc (Read_Max); } -String_Getc (port) Object port; { +int String_Getc (Object port) { register struct S_Port *p; register struct S_String *s; @@ -82,12 +88,12 @@ String_Getc (port) Object port; { return p->ptr >= s->size ? EOF : s->data[p->ptr++]; } -String_Ungetc (port, c) Object port; register c; { +void String_Ungetc (Object port, register int c) { PORT(port)->flags |= P_UNREAD; PORT(port)->unread = c; } -Check_Input_Port (port) Object port; { +void Check_Input_Port (Object port) { Check_Type (port, T_Port); if (!(PORT(port)->flags & P_OPEN)) Primitive_Error ("port has been closed: ~s", port); @@ -95,12 +101,12 @@ Check_Input_Port (port) Object port; { Primitive_Error ("not an input port: ~s", port); } -Object P_Clear_Input_Port (argc, argv) Object *argv; { +Object P_Clear_Input_Port (int argc, Object *argv) { Discard_Input (argc == 1 ? argv[0] : Curr_Input_Port); return Void; } -Discard_Input (port) Object port; { +void Discard_Input (Object port) { register FILE *f; Check_Input_Port (port); @@ -124,7 +130,7 @@ Discard_Input (port) Object port; { #endif } -Object P_Unread_Char (argc, argv) Object *argv; { +Object P_Unread_Char (int argc, Object *argv) { Object port, ch; register struct S_Port *p; @@ -136,7 +142,7 @@ Object P_Unread_Char (argc, argv) Object *argv; { if (p->flags & P_STRING) { if (p->flags & P_UNREAD) Primitive_Error ("cannot push back more than one char"); - String_Ungetc (port, CHAR(ch)); + String_Ungetc (port, CHAR(ch)); } else { if (ungetc (CHAR(ch), p->file) == EOF) Primitive_Error ("failed to push back char"); @@ -145,10 +151,10 @@ Object P_Unread_Char (argc, argv) Object *argv; { return ch; } -Object P_Read_Char (argc, argv) Object *argv; { +Object P_Read_Char (int argc, Object *argv) { Object port; register FILE *f; - register c, str, flags; + register int c, str, flags; port = argc == 1 ? argv[0] : Curr_Input_Port; Check_Input_Port (port); @@ -160,7 +166,7 @@ Object P_Read_Char (argc, argv) Object *argv; { return c == EOF ? Eof : Make_Char (c); } -Object P_Peek_Char (argc, argv) Object *argv; { +Object P_Peek_Char (int argc, Object *argv) { Object a[2]; a[0] = P_Read_Char (argc, argv); @@ -173,7 +179,7 @@ Object P_Peek_Char (argc, argv) Object *argv; { * The following is only an approximation; even if FIONREAD is supported, * the primitive may return #f although a call to read-char would not block. */ -Object P_Char_Readyp (argc, argv) Object *argv; { +Object P_Char_Readyp (int argc, Object *argv) { Object port; port = argc == 1 ? argv[0] : Curr_Input_Port; @@ -191,10 +197,10 @@ Object P_Char_Readyp (argc, argv) Object *argv; { return False; } -Object P_Read_String (argc, argv) Object *argv; { +Object P_Read_String (int argc, Object *argv) { Object port; register FILE *f; - register c, str; + register int c, str; port = argc == 1 ? argv[0] : Curr_Input_Port; Check_Input_Port (port); @@ -211,13 +217,13 @@ Object P_Read_String (argc, argv) Object *argv; { return c == EOF ? Eof : Make_String (Read_Buf, Read_Size); } -Object P_Read (argc, argv) Object *argv; { +Object P_Read (int argc, Object *argv) { return General_Read (argc == 1 ? argv[0] : Curr_Input_Port, 0); } -Object General_Read (port, konst) Object port; { +Object General_Read (Object port, int konst) { register FILE *f; - register c, str; + register int c, str; Object ret; Check_Input_Port (port); @@ -256,9 +262,9 @@ comment: return ret; } -Skip_Comment (port) Object port; { +int Skip_Comment (Object port) { register FILE *f; - register c, str; + register int c, str; f = PORT(port)->file; str = PORT(port)->flags & P_STRING; @@ -268,7 +274,7 @@ Skip_Comment (port) Object port; { return c; } -Object Read_Atom (port, konst) Object port; { +Object Read_Atom (Object port, int konst) { Object ret; ret = Read_Special (port, konst); @@ -277,9 +283,9 @@ Object Read_Atom (port, konst) Object port; { return ret; } -Object Read_Special (port, konst) Object port; { +Object Read_Special (Object port, int konst) { Object ret; - register c, str; + register int c, str; register FILE *f; #define READ_QUOTE(sym) \ @@ -361,7 +367,7 @@ eof: /*NOTREACHED*/ } -Object Read_Sequence (port, vec, konst) Object port; { +Object Read_Sequence (Object port, int vec, int konst) { Object ret, e, tail, t; GC_Node3; @@ -408,9 +414,9 @@ Object Read_Sequence (port, vec, konst) Object port; { /*NOTREACHED*/ } -Object Read_String (port, konst) Object port; { +Object Read_String (Object port, int konst) { register FILE *f; - register n, c, oc, str; + register int n, c, oc, str; Read_Reset (); f = PORT(port)->file; @@ -448,7 +454,7 @@ eof: return General_Make_String (Read_Buf, Read_Size, konst); } -Object Read_Sharp (port, konst) Object port; { +Object Read_Sharp (Object port, int konst) { int c, str; FILE *f; char buf[32]; @@ -466,35 +472,35 @@ Object Read_Sharp (port, konst) Object port; { } /*ARGSUSED*/ -Object Read_True (port, chr, konst) Object port; { +Object Read_True (Object port, int chr, int konst) { return True; } /*ARGSUSED*/ -Object Read_False (port, chr, konst) Object port; { +Object Read_False (Object port, int chr, int konst) { return False; } /*ARGSUSED*/ -Object Read_Void (port, chr, konst) Object port; { +Object Read_Void (Object port, int chr, int konst) { Object ret; - + ret = Const_Cons (Void, Null); return Const_Cons (Sym_Quote, ret); } /*ARGSUSED*/ -Object Read_Kludge (port, chr, konst) Object port; { +Object Read_Kludge (Object port, int chr, int konst) { return Special; } /*ARGSUSED*/ -Object Read_Vector (port, chr, konst) Object port; { +Object Read_Vector (Object port, int chr, int konst) { return List_To_Vector (Read_Sequence (port, 1, konst), konst); } /*ARGSUSED*/ -Object Read_Radix (port, chr, konst) Object port; { +Object Read_Radix (Object port, int chr, int konst) { int c, str; FILE *f; Object ret; @@ -520,7 +526,7 @@ Object Read_Radix (port, chr, konst) Object port; { } /*ARGSUSED*/ -Object Read_Char (port, chr, konst) Object port; { +Object Read_Char (Object port, int chr, int konst) { int c, str; FILE *f; char buf[10], *p = buf; @@ -570,18 +576,18 @@ Object Read_Char (port, chr, konst) Object port; { /*NOTREACHED*/ } -void Define_Reader (c, fun) READFUN fun; { +void Define_Reader (int c, READFUN fun) { if (Readers[c] && Readers[c] != fun) Primitive_Error ("reader for `~a' already defined", Make_Char (c)); Readers[c] = fun; } -Object Parse_Number (port, buf, radix) Object port; const char *buf; { - const char *p; +Object Parse_Number (Object port, char const *buf, int radix) { + char const *p; int c, i; int mdigit = 0, edigit = 0, expo = 0, neg = 0, point = 0; int gotradix = 0, exact = 0, inexact = 0; - unsigned max; + unsigned int max; int maxdig; Object ret; @@ -616,7 +622,7 @@ Object Parse_Number (port, buf, radix) Object port; const char *buf; { p = buf; if (*p == '+' || (neg = *p == '-')) p++; - for ( ; c = *p; p++) { + for ( ; (c = *p); p++) { if (c == '.') { if (expo || point++) return Null; @@ -646,10 +652,10 @@ Object Parse_Number (port, buf, radix) Object port; const char *buf; { */ return Make_Flonum (atof (buf)); } - max = (neg ? -(unsigned)INT_MIN : INT_MAX); + max = (neg ? -(unsigned int)INT_MIN : INT_MAX); maxdig = max % radix; max /= radix; - for (i = 0, p = buf; c = *p; p++) { + for (i = 0, p = buf; (c = *p); p++) { if (c == '-' || c == '+') { buf++; continue; @@ -661,7 +667,7 @@ Object Parse_Number (port, buf, radix) Object port; const char *buf; { c = '9' + c - 'a' + 1; } c -= '0'; - if ((unsigned)i > max || (unsigned)i == max && c > maxdig) { + if ((unsigned int)i > max || ((unsigned int)i == max && c > maxdig)) { ret = Make_Bignum (buf, neg, radix); return inexact ? Make_Flonum (Bignum_To_Double (ret)) : ret; } @@ -672,7 +678,7 @@ Object Parse_Number (port, buf, radix) Object port; const char *buf; { return inexact ? Make_Flonum ((double)i) : Make_Integer (i); } -Reader_Error (port, msg) Object port; char *msg; { +void Reader_Error (Object port, char *msg) { char buf[100]; if (PORT(port)->flags & P_STRING) { diff --git a/src/special.c b/src/special.c index a8e07dc..b83f52d 100644 --- a/src/special.c +++ b/src/special.c @@ -3,17 +3,22 @@ #include "kernel.h" +extern void Do_Wind (Object); +extern void Pop_Frame (); +extern void Push_Frame (Object); +extern void Add_Wind (register WIND *, Object, Object); + Object Sym_Else; -Init_Special () { +void Init_Special () { Define_Symbol (&Sym_Else, "else"); } -Object P_Quote (argl) Object argl; { +Object P_Quote (Object argl) { return Car (argl); } -Object Quasiquote (x, level) Object x; { +Object Quasiquote (Object x, int level) { Object form, list, tail, cell, qcar, qcdr, ret; TC_Prolog; @@ -88,11 +93,11 @@ Object Quasiquote (x, level) Object x; { } } -Object P_Quasiquote (argl) Object argl; { +Object P_Quasiquote (Object argl) { return Quasiquote (Car (argl), 0); } -Object P_Begin (forms) Object forms; { +Object P_Begin (Object forms) { GC_Node; TC_Prolog; @@ -107,8 +112,8 @@ Object P_Begin (forms) Object forms; { return Eval (Car (forms)); } -Object P_Begin1 (forms) Object forms; { - register n; +Object P_Begin1 (Object forms) { + register int n; Object r, ret; GC_Node; TC_Prolog; @@ -126,7 +131,7 @@ Object P_Begin1 (forms) Object forms; { return n ? r : ret; } -Object P_If (argl) Object argl; { +Object P_If (Object argl) { Object cond, ret; GC_Node; TC_Prolog; @@ -153,7 +158,7 @@ Object P_If (argl) Object argl; { return ret; } -Object P_Case (argl) Object argl; { +Object P_Case (Object argl) { Object ret, key, clause, select; GC_Node; TC_Prolog; @@ -189,7 +194,7 @@ Object P_Case (argl) Object argl; { return ret; } -Object P_Cond (argl) Object argl; { +Object P_Cond (Object argl) { Object ret, clause, guard; int else_clause = 0; GC_Node3; @@ -237,7 +242,7 @@ Object P_Cond (argl) Object argl; { return ret; } -Object General_Junction (argl, and) Object argl; register and; { +Object General_Junction (Object argl, register int and) { Object ret; GC_Node; TC_Prolog; @@ -259,17 +264,17 @@ Object General_Junction (argl, and) Object argl; register and; { return ret; } -Object P_And (argl) Object argl; { +Object P_And (Object argl) { return General_Junction (argl, 1); } -Object P_Or (argl) Object argl; { +Object P_Or (Object argl) { return General_Junction (argl, 0); } -Object P_Do (argl) Object argl; { +Object P_Do (Object argl) { Object tail, b, val, test, frame, newframe, len, ret; - register local_vars; + register int local_vars; GC_Node6; TC_Prolog; @@ -292,7 +297,7 @@ Object P_Do (argl) Object argl; { Primitive_Error ("~s: duplicate variable binding", b); frame = Add_Binding (frame, b, val); } - if (local_vars = !Nullp (frame)) + if ((local_vars = !Nullp (frame))) Push_Frame (frame); test = Car (Cdr (argl)); Check_Type (test, T_Pair); @@ -324,7 +329,7 @@ Object P_Do (argl) Object argl; { return ret; } -Object General_Let (argl, disc) Object argl; { +Object General_Let (Object argl, int disc) { Object frame, b, binding, val, tail, ret; GC_Node5; TC_Prolog; @@ -384,7 +389,7 @@ Object General_Let (argl, disc) Object argl; { return ret; } -Object Named_Let (argl) Object argl; { +Object Named_Let (Object argl) { Object b, val, tail, vlist, vtail, flist, ftail, cell; GC_Node6; TC_Prolog; @@ -433,22 +438,22 @@ Object Named_Let (argl) Object argl; { return tail; } -Object P_Let (argl) Object argl; { +Object P_Let (Object argl) { if (TYPE(Car (argl)) == T_Symbol) return Named_Let (argl); - else + else return General_Let (argl, 0); } -Object P_Letseq (argl) Object argl; { +Object P_Letseq (Object argl) { return General_Let (argl, 1); } -Object P_Letrec (argl) Object argl; { +Object P_Letrec (Object argl) { return General_Let (argl, 2); } -Object Internal_Fluid_Let (bindings, argl) Object bindings, argl; { +Object Internal_Fluid_Let (Object bindings, Object argl) { Object b, sym, val, vec, ret; WIND w; GC_Node5; @@ -483,14 +488,14 @@ Object Internal_Fluid_Let (bindings, argl) Object bindings, argl; { return ret; } -Object P_Fluid_Let (argl) Object argl; { +Object P_Fluid_Let (Object argl) { Object ret; WIND *first = First_Wind, *last = Last_Wind; TC_Prolog; TC_Disable; ret = Internal_Fluid_Let (Car (argl), argl); - if (Last_Wind = last) + if ((Last_Wind = last)) last->next = 0; First_Wind = first; TC_Enable; diff --git a/src/stab-bsd.c b/src/stab-bsd.c index fbb672b..aa045dd 100644 --- a/src/stab-bsd.c +++ b/src/stab-bsd.c @@ -9,7 +9,7 @@ extern int errno; # define O_BINARY 0 #endif -SYMTAB *Snarf_Symbols (f, ep) FILE *f; struct exec *ep; { +SYMTAB *Snarf_Symbols (FILE *f, struct exec *ep) { SYMTAB *tab; register SYM *sp, **nextp; int nsyms, strsiz; @@ -56,7 +56,7 @@ strerr: return tab; } -SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { +SYMTAB *Open_File_And_Snarf_Symbols (char *name) { struct exec hdr; int fd; FILE *fp; diff --git a/src/stab-coff.c b/src/stab-coff.c index 7707e6e..babc4e7 100644 --- a/src/stab-coff.c +++ b/src/stab-coff.c @@ -3,7 +3,7 @@ #undef TYPE /* ldfnc.h defines a TYPE macro. */ #include -SYMTAB *Snarf_Symbols (lf, ep) LDFILE *lf; { +SYMTAB *Snarf_Symbols (LDFILE *lf, int ep) { SYMTAB *tab; register SYM *sp, **nextp; SYMENT sym; @@ -40,7 +40,7 @@ SYMTAB *Snarf_Symbols (lf, ep) LDFILE *lf; { } #ifdef INIT_OBJECTS -SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { +SYMTAB *Open_File_And_Snarf_Symbols (char *name) { LDFILE *f; SYMTAB *tab; diff --git a/src/stab-convex.c b/src/stab-convex.c index 54f7dee..875134c 100644 --- a/src/stab-convex.c +++ b/src/stab-convex.c @@ -9,7 +9,7 @@ #include #ifdef INIT_OBJECTS -SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { +SYMTAB *Open_File_And_Snarf_Symbols (char *name) { int f, n, len = 0; char *base; struct filehdr *fhp; @@ -33,7 +33,7 @@ SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); tab->first = 0; tab->strings = Safe_Malloc ((unsigned int)fhp->h_strsiz); - bcopy (base + fhp->h_strptr, tab->strings, (unsigned int)fhp->h_strsiz); + memcpy (tab->strings, base + fhp->h_strptr, (unsigned int)fhp->h_strsiz); nextp = &tab->first; ohp = (struct opthdr *)(base + sizeof *fhp); diff --git a/src/stab-ecoff.c b/src/stab-ecoff.c index 492427e..92e8dae 100644 --- a/src/stab-ecoff.c +++ b/src/stab-ecoff.c @@ -7,7 +7,7 @@ #include AOUT_H -SYMTAB *Snarf_Symbols (fp) FILE *fp; { +SYMTAB *Snarf_Symbols (FILE *fp) { long fdi; /* a counter for the file desc table */ FDR *file_desc; /* pointer to the filedesc table */ struct filehdr file_hdr; /* pointer to the file header */ @@ -74,7 +74,7 @@ symerr: symi++) { if (symbol[symi].st == stProc && symbol[symi].sc == scText) { p = symbol[symi].iss + strbase; - + /* Allocate and initialize node in the symbol table list; * link node into list */ @@ -92,10 +92,10 @@ symerr: return tab; } -SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { +SYMTAB *Open_File_And_Snarf_Symbols (char *name) { FILE *fp; SYMTAB *tab; - + if ((fp = fopen (name, "r")) == NULL) Primitive_Error ("can't open a.out file"); tab = Snarf_Symbols (fp); diff --git a/src/stab-elf.c b/src/stab-elf.c index 17e528e..f08a246 100644 --- a/src/stab-elf.c +++ b/src/stab-elf.c @@ -2,6 +2,7 @@ #include #include #include +#include SYMTAB * Snarf_Symbols (lf) @@ -15,16 +16,16 @@ Snarf_Symbols (lf) Elf32_Ehdr *elf_ehdr_ptr = NULL; Elf32_Shdr *elf_shdr_ptr = NULL, *symtab_ptr = NULL; - size_t elf_str_index, shstrndx; - char *symbol_name, *section_name; + size_t elf_str_index = 0, shstrndx; + char *section_name; if (elf_version (EV_CURRENT) == EV_NONE) Primitive_Error ("a.out file Elf version out of date"); if ((elf_ptr = elf_begin (lf, ELF_C_READ, (Elf *)NULL)) == NULL) Primitive_Error ("can't elf_begin() a.out file"); - /* - * get the elf header, so we'll know where to look for the section + /* + * get the elf header, so we'll know where to look for the section * names. */ if ((elf_ehdr_ptr = elf32_getehdr (elf_ptr)) == NULL) { @@ -32,12 +33,12 @@ Snarf_Symbols (lf) } shstrndx = elf_ehdr_ptr->e_shstrndx; /* look for the symbol and string tables */ - while (elf_scn_ptr = elf_nextscn (elf_ptr, elf_scn_ptr)) { + while ((elf_scn_ptr = elf_nextscn (elf_ptr, elf_scn_ptr))) { if ((elf_shdr_ptr = elf32_getshdr (elf_scn_ptr)) == NULL) Primitive_Error ("can't get section header in a.out file"); if (elf_shdr_ptr->sh_type == SHT_STRTAB) { - /* - * save the index to the string table for later use by + /* + * save the index to the string table for later use by * elf_strptr(). */ section_name = elf_strptr (elf_ptr, shstrndx, @@ -57,11 +58,11 @@ Snarf_Symbols (lf) Primitive_Error ("no symbol table in a.out file"); if (!elf_str_index) Primitive_Error ("no string table in a.out file"); - /* - * we've located the symbol table -- go through it and save the names + /* + * we've located the symbol table -- go through it and save the names * of the interesting symbols. */ - while (elf_data_ptr = elf_getdata (symtab_scn_ptr, elf_data_ptr)) { + while ((elf_data_ptr = elf_getdata (symtab_scn_ptr, elf_data_ptr))) { char *name = NULL; int symbol_count; Elf32_Sym *symbol_ptr = elf_data_ptr->d_buf; @@ -99,7 +100,7 @@ Snarf_Symbols (lf) } return tab; } - + SYMTAB * Open_File_And_Snarf_Symbols (name) char *name; diff --git a/src/stab-hp9k300.c b/src/stab-hp9k300.c index 1b489ee..cf0e311 100644 --- a/src/stab-hp9k300.c +++ b/src/stab-hp9k300.c @@ -3,22 +3,22 @@ /* On the HP9000 an nlist entry contains a fixed length * part consisting of the symbol information, plus a variable - * length part, the name without a '\0' terminator. - * We don't know how much space to allocate for the names + * length part, the name without a '\0' terminator. + * We don't know how much space to allocate for the names * until we have read them all. * The solution here is to save all the names on the fly * in a table that is grown in units of STRING_BLOCK bytes, * using realloc to expand it on demand. */ - + #define STRING_BLOCK 8192 -SYMTAB *Snarf_Symbols (f, ep) FILE *f; struct exec *ep; { +SYMTAB *Snarf_Symbols (FILE *f, struct exec *ep) { SYMTAB *tab; register SYM *sp; register SYM **nextp; int strsiz = 0; /* running total length of names read, */ - /* each '\0' terminated */ + /* each '\0' terminated */ int nread = 0; /* running total of bytes read from symbol table */ int max = 0; /* current maximum size of name table */ char *names = 0; /* the name table */ @@ -54,7 +54,7 @@ SYMTAB *Snarf_Symbols (f, ep) FILE *f; struct exec *ep; { Primitive_Error ("corrupt symbol table in object file"); } else { - nread += nl.n_length; + nread += nl.n_length; names[ strsiz + nl.n_length ] = '\0'; } if ((nl.n_type & N_TYPE) != N_TEXT) { @@ -71,15 +71,15 @@ SYMTAB *Snarf_Symbols (f, ep) FILE *f; struct exec *ep; { } tab->strings = names; - + for (sp = tab->first; sp; sp = sp->next) - sp->name += (unsigned)names; + sp->name += (unsigned int)names; return tab; } #ifdef INIT_OBJECTS -SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { +SYMTAB *Open_File_And_Snarf_Symbols (char *name) { struct exec hdr; FILE *f; SYMTAB *tab; diff --git a/src/stab-hp9k800.c b/src/stab-hp9k800.c index 23806e5..30f814b 100644 --- a/src/stab-hp9k800.c +++ b/src/stab-hp9k800.c @@ -1,10 +1,10 @@ #include AOUT_H #include -SYMTAB *Snarf_Symbols (f, hp) FILE *f; struct header *hp; { +SYMTAB *Snarf_Symbols (FILE *f, struct header *hp) { SYMTAB *tab; register SYM *sp, **nextp; - register n; + register int n; struct symbol_dictionary_record r; tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); @@ -38,7 +38,7 @@ SYMTAB *Snarf_Symbols (f, hp) FILE *f; struct header *hp; { return tab; } -SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { +SYMTAB *Open_File_And_Snarf_Symbols (char *name) { struct header hdr; FILE *f; SYMTAB *tab; diff --git a/src/stab-macho.c b/src/stab-macho.c index 83bef00..b313269 100644 --- a/src/stab-macho.c +++ b/src/stab-macho.c @@ -33,7 +33,7 @@ static SYMTAB *Grovel_Over_Nlist (symcmd, nl, strtab, text_sect) return tab; } -SYMTAB *Snarf_Symbols (mhdr) struct mach_header *mhdr; { +SYMTAB *Snarf_Symbols (struct mach_header *mhdr) { struct load_command *ld_cmd; struct symtab_command *sym_cmd; struct segment_command *seg_cmd; @@ -71,8 +71,8 @@ SYMTAB *Snarf_Symbols (mhdr) struct mach_header *mhdr; { } #ifdef INIT_OBJECTS -SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { +SYMTAB *Open_File_And_Snarf_Symbols (char *name) { extern char *_mh_execute_header; return Snarf_Symbols ((struct mach_header *)&_mh_execute_header); -} +} #endif /* INIT_OBJECTS */ diff --git a/src/stab.c b/src/stab.c index 5e12d86..b76a12a 100644 --- a/src/stab.c +++ b/src/stab.c @@ -3,6 +3,11 @@ #include "kernel.h" +#include +#include + +void Free_Symbols (SYMTAB *); + #if defined(CAN_LOAD_OBJ) || defined (INIT_OBJECTS) #ifdef MACH_O @@ -37,33 +42,33 @@ static SYMPREFIX Ignore_Prefixes[] = { /* Currently none */ - 0, 0 + { 0, 0 } }; static SYMPREFIX Init_Prefixes[] = { - INIT_PREFIX, PR_EXTENSION, - "_GLOBAL_.I.", PR_CONSTRUCTOR, /* SVR4.2/g++ */ - "__sti__", PR_CONSTRUCTOR, - "_STI", PR_CONSTRUCTOR, - "_GLOBAL_$I$", PR_CONSTRUCTOR, - 0, 0 + { INIT_PREFIX, PR_EXTENSION }, + { "_GLOBAL_.I.", PR_CONSTRUCTOR }, /* SVR4.2/g++ */ + { "__sti__", PR_CONSTRUCTOR }, + { "_STI", PR_CONSTRUCTOR }, + { "_GLOBAL_$I$", PR_CONSTRUCTOR }, + { 0, 0 } }; static SYMPREFIX Finit_Prefixes[] = { - FINIT_PREFIX, PR_EXTENSION, - "_GLOBAL_.D.", PR_CONSTRUCTOR, - "__std__", PR_CONSTRUCTOR, - "_STD", PR_CONSTRUCTOR, - "_GLOBAL_$D$", PR_CONSTRUCTOR, - 0, 0 + { FINIT_PREFIX, PR_EXTENSION }, + { "_GLOBAL_.D.", PR_CONSTRUCTOR }, + { "__std__", PR_CONSTRUCTOR }, + { "_STD", PR_CONSTRUCTOR }, + { "_GLOBAL_$D$", PR_CONSTRUCTOR }, + { 0, 0 } }; static FUNCT *Finalizers; -static void Call (l) unsigned long l; { +static void Call (unsigned long int l) { #ifdef XCOFF - unsigned long vec[3]; + unsigned long int vec[3]; extern main(); - bcopy ((char *)main, (char *)vec, sizeof vec); + memcpy (vec, main, sizeof vec); vec[0] = (l & ~0xF0000000) + (vec[0] & 0xF0000000); ((void (*)())vec)(); #else @@ -71,7 +76,7 @@ static void Call (l) unsigned long l; { #endif } -Call_Initializers (tab, addr, which) SYMTAB *tab; char *addr; { +void Call_Initializers (SYMTAB *tab, char *addr, int which) { SYM *sp; char *p; SYMPREFIX *pp; @@ -125,17 +130,17 @@ next: ; /* Call the finialization functions and C++ static destructors. Make sure * that calling exit() from a function doesn't cause endless recursion. */ -Call_Finalizers () { +void Call_Finalizers () { while (Finalizers) { FUNCT *fp = Finalizers; Finalizers = fp->next; if (Verb_Init) printf ("[calling %s]\n", fp->name); - Call ((unsigned long)fp->func); + Call ((unsigned long int)fp->func); } } -Free_Symbols (tab) SYMTAB *tab; { +void Free_Symbols (SYMTAB *tab) { register SYM *sp, *nextp; for (sp = tab->first; sp; sp = nextp) { diff --git a/src/stkmem.c b/src/stkmem.c index 7a0dffe..71f8333 100644 --- a/src/stkmem.c +++ b/src/stkmem.c @@ -9,7 +9,7 @@ extern char *malloc(); MEM_NODE *Mem_List; -char *Mem_Alloc (size) unsigned size; { +char *Mem_Alloc (unsigned int size) { char *ret; Disable_Interrupts; @@ -19,7 +19,7 @@ char *Mem_Alloc (size) unsigned size; { return ret; } -Free_Mem_Nodes (first) MEM_NODE *first; { +Free_Mem_Nodes (MEM_NODE *first) { MEM_NODE *p; Disable_Interrupts; @@ -31,8 +31,8 @@ Free_Mem_Nodes (first) MEM_NODE *first; { Enable_Interrupts; } -Save_Mem_Nodes (cont) Object cont; { - unsigned sum = 0; +Save_Mem_Nodes (Object cont) { + unsigned int sum = 0; char *s; MEM_NODE *p; Object str; @@ -46,12 +46,12 @@ Save_Mem_Nodes (cont) Object cont; { CONTROL(cont)->memsave = str; GC_Unlink; for (p = Mem_List, s = STRING(str)->data; p; s += p->len, p = p->next) { - bcopy ((char *)(p+1), s, p->len); + memcpy (s, p+1, p->len); p->refcnt++; } } -Restore_Mem_Nodes (cont) Object cont; { +Restore_Mem_Nodes (Object cont) { MEM_NODE *p; char *s; Object str; @@ -61,13 +61,13 @@ Restore_Mem_Nodes (cont) Object cont; { str = CONTROL(cont)->memsave; for (p = Mem_List, s = STRING(str)->data; p; s += p->len, p = p->next) { p->refcnt++; - bcopy (s, (char *)(p+1), p->len); + memcpy (p+1, s, p->len); } } Object Save_GC_Nodes () { Object vec; - register unsigned sum = 0, i = 0, n; + register unsigned int sum = 0, i = 0, n; register GCNODE *p; for (p = GC_List; p; p = p->next) @@ -75,20 +75,18 @@ Object Save_GC_Nodes () { vec = Make_Vector (sum, Null); for (p = GC_List; p; p = p->next, i += n) { n = p->gclen <= 0 ? 1 : p->gclen-1; - bcopy ((char *)p->gcobj, (char *)&(VECTOR(vec)->data[i]), - n * sizeof (Object)); + memcpy (&(VECTOR(vec)->data[i]), p->gcobj, n * sizeof (Object)); } return vec; } -Restore_GC_Nodes (vec) Object vec; { - register i = 0, n; +Restore_GC_Nodes (Object vec) { + register int i = 0, n; register GCNODE *p; for (p = GC_List; p; p = p->next, i += n) { n = p->gclen <= 0 ? 1 : p->gclen-1; - bcopy ((char *)&(VECTOR(vec)->data[i]), (char *)p->gcobj, - n * sizeof (Object)); + memcpy (p->gcobj, &(VECTOR(vec)->data[i]), n * sizeof (Object)); } } diff --git a/src/string.c b/src/string.c index a4fae03..a37ed72 100644 --- a/src/string.c +++ b/src/string.c @@ -1,11 +1,14 @@ #include +#include #include "kernel.h" +extern int Get_Index (Object, Object); + char Char_Map[256]; -Init_String () { - register i; +void Init_String () { + register int i; for (i = 0; i < 256; i++) Char_Map[i] = i; @@ -13,31 +16,31 @@ Init_String () { Char_Map[i] = tolower (i); } -Object General_Make_String (s, len, konst) const char *s; { +Object General_Make_String (char const *s, int len, int konst) { Object str; str = Alloc_Object (len + sizeof (struct S_String) - 1, T_String, konst); STRING(str)->tag = Null; STRING(str)->size = len; if (s) - bcopy (s, STRING(str)->data, len); + memcpy (STRING(str)->data, s, len); return str; } -Object Make_String (s, len) const char *s; { +Object Make_String (char const *s, int len) { return General_Make_String (s, len, 0); } -Object Make_Const_String (s, len) const char *s; { +Object Make_Const_String (char const *s, int len) { return General_Make_String (s, len, 1); } -Object P_Stringp (s) Object s; { +Object P_Stringp (Object s) { return TYPE(s) == T_String ? True : False; } -Object P_Make_String (argc, argv) Object *argv; { - register len, c = ' '; +Object P_Make_String (int argc, Object *argv) { + register int len, c = ' '; Object str; register char *p; @@ -52,9 +55,9 @@ Object P_Make_String (argc, argv) Object *argv; { return str; } -Object P_String (argc, argv) Object *argv; { +Object P_String (int argc, Object *argv) { Object str; - register i; + register int i; str = Make_String ((char *)0, argc); for (i = 0; i < argc; i++) { @@ -64,7 +67,7 @@ Object P_String (argc, argv) Object *argv; { return str; } -Object P_String_To_Number (argc, argv) Object *argv; { +Object P_String_To_Number (int argc, Object *argv) { Object ret; char *b; register struct S_String *p; @@ -83,25 +86,25 @@ Object P_String_To_Number (argc, argv) Object *argv; { } p = STRING(argv[0]); Alloca (b, char*, p->size+1); - bcopy (p->data, b, p->size); + memcpy (b, p->data, p->size); b[p->size] = '\0'; ret = Parse_Number (Null, b, radix); Alloca_End; return Nullp (ret) ? False : ret; } -Object P_String_Length (s) Object s; { +Object P_String_Length (Object s) { Check_Type (s, T_String); return Make_Integer (STRING(s)->size); } -Object P_String_Ref (s, n) Object s, n; { +Object P_String_Ref (Object s, Object n) { Check_Type (s, T_String); return Make_Char (STRING(s)->data[Get_Index (n, s)]); } -Object P_String_Set (s, n, new) Object s, n, new; { - register i, old; +Object P_String_Set (Object s, Object n, Object new) { + register int i, old; Check_Type (s, T_String); Check_Mutable (s); @@ -111,8 +114,8 @@ Object P_String_Set (s, n, new) Object s, n, new; { return Make_Char (old); } -Object P_Substring (s, a, b) Object s, a, b; { - register i, j; +Object P_Substring (Object s, Object a, Object b) { + register int i, j; Check_Type (s, T_String); if ((i = Get_Exact_Integer (a)) < 0 || i > STRING(s)->size) @@ -124,13 +127,13 @@ Object P_Substring (s, a, b) Object s, a, b; { return Make_String (&STRING(s)->data[i], j-i); } -Object P_String_Copy (s) Object s; { +Object P_String_Copy (Object s) { Check_Type (s, T_String); return Make_String (STRING(s)->data, STRING(s)->size); } -Object P_String_Append (argc, argv) Object *argv; { - register i, len; +Object P_String_Append (int argc, Object *argv) { + register int i, len; Object s, str; for (len = i = 0; i < argc; i++) { @@ -140,15 +143,15 @@ Object P_String_Append (argc, argv) Object *argv; { str = Make_String ((char *)0, len); for (len = i = 0; i < argc; i++) { s = argv[i]; - bcopy (STRING(s)->data, &STRING(str)->data[len], STRING(s)->size); + memcpy (&STRING(str)->data[len], STRING(s)->data, STRING(s)->size); len += STRING(s)->size; } return str; } -Object P_List_To_String (list) Object list; { +Object P_List_To_String (Object list) { Object str, len; - register i; + register int i; GC_Node; GC_Link (list); @@ -162,8 +165,8 @@ Object P_List_To_String (list) Object list; { return str; } -Object P_String_To_List (s) Object s; { - register i; +Object P_String_To_List (Object s) { + register int i; Object list, tail, cell; GC_Node3; @@ -181,8 +184,8 @@ Object P_String_To_List (s) Object s; { return list; } -Object P_Substring_Fill (s, a, b, c) Object s, a, b, c; { - register i, j; +Object P_Substring_Fill (Object s, Object a, Object b, Object c) { + register int i, j; Check_Type (s, T_String); Check_Mutable (s); @@ -197,21 +200,21 @@ Object P_Substring_Fill (s, a, b, c) Object s, a, b, c; { return s; } -Object P_String_Fill (s, c) Object s, c; { +Object P_String_Fill (Object s, Object c) { Object ret; GC_Node2; Check_Type (s, T_String); Check_Mutable (s); GC_Link2 (s, c); - ret = P_Substring_Fill (s, Make_Integer (0), + ret = P_Substring_Fill (s, Make_Integer (0), Make_Integer (STRING(s)->size), c); GC_Unlink; return ret; } -Object General_Substringp (s1, s2, ci) Object s1, s2; register ci; { - register n, l1, l2; +Object General_Substringp (Object s1, Object s2, register int ci) { + register int n, l1, l2; register char *p1, *p2, *p3, *map; Check_Type (s1, T_String); @@ -222,7 +225,7 @@ Object General_Substringp (s1, s2, ci) Object s1, s2; register ci; { for (p2 = STRING(s2)->data; l2 >= l1; p2++, l2--) { for (p1 = STRING(s1)->data, p3 = p2, n = l1; n; n--, p1++, p3++) { if (ci) { - if (map[*p1] != map[*p3]) goto fail; + if (map[(int)*p1] != map[(int)*p3]) goto fail; } else if (*p1 != *p3) goto fail; } @@ -232,16 +235,16 @@ fail: ; return False; } -Object P_Substringp (s1, s2) Object s1, s2; { +Object P_Substringp (Object s1, Object s2) { return General_Substringp (s1, s2, 0); } -Object P_CI_Substringp (s1, s2) Object s1, s2; { +Object P_CI_Substringp (Object s1, Object s2) { return General_Substringp (s1, s2, 1); } -General_Strcmp (s1, s2, ci) Object s1, s2; register ci; { - register n, l1, l2; +int General_Strcmp (Object s1, Object s2, register int ci) { + register int n, l1, l2; register char *p1, *p2, *map; Check_Type (s1, T_String); @@ -251,51 +254,51 @@ General_Strcmp (s1, s2, ci) Object s1, s2; register ci; { p1 = STRING(s1)->data; p2 = STRING(s2)->data; for (map = Char_Map; --n >= 0; p1++, p2++) { if (ci) { - if (map[*p1] != map[*p2]) break; + if (map[(int)*p1] != map[(int)*p2]) break; } else if (*p1 != *p2) break; } if (n < 0) return l1 - l2; - return ci ? map[*p1] - map[*p2] : *p1 - *p2; + return ci ? map[(int)*p1] - map[(int)*p2] : *p1 - *p2; } -Object P_String_Eq (s1, s2) Object s1, s2; { +Object P_String_Eq (Object s1, Object s2) { return General_Strcmp (s1, s2, 0) ? False : True; } -Object P_String_Less (s1, s2) Object s1, s2; { +Object P_String_Less (Object s1, Object s2) { return General_Strcmp (s1, s2, 0) < 0 ? True : False; } -Object P_String_Greater (s1, s2) Object s1, s2; { +Object P_String_Greater (Object s1, Object s2) { return General_Strcmp (s1, s2, 0) > 0 ? True : False; } -Object P_String_Eq_Less (s1, s2) Object s1, s2; { +Object P_String_Eq_Less (Object s1, Object s2) { return General_Strcmp (s1, s2, 0) <= 0 ? True : False; } -Object P_String_Eq_Greater (s1, s2) Object s1, s2; { +Object P_String_Eq_Greater (Object s1, Object s2) { return General_Strcmp (s1, s2, 0) >= 0 ? True : False; } -Object P_String_CI_Eq (s1, s2) Object s1, s2; { +Object P_String_CI_Eq (Object s1, Object s2) { return General_Strcmp (s1, s2, 1) ? False : True; } -Object P_String_CI_Less (s1, s2) Object s1, s2; { +Object P_String_CI_Less (Object s1, Object s2) { return General_Strcmp (s1, s2, 1) < 0 ? True : False; } -Object P_String_CI_Greater (s1, s2) Object s1, s2; { +Object P_String_CI_Greater (Object s1, Object s2) { return General_Strcmp (s1, s2, 1) > 0 ? True : False; } -Object P_String_CI_Eq_Less (s1, s2) Object s1, s2; { +Object P_String_CI_Eq_Less (Object s1, Object s2) { return General_Strcmp (s1, s2, 1) <= 0 ? True : False; } -Object P_String_CI_Eq_Greater (s1, s2) Object s1, s2; { +Object P_String_CI_Eq_Greater (Object s1, Object s2) { return General_Strcmp (s1, s2, 1) >= 0 ? True : False; } diff --git a/src/symbol.c b/src/symbol.c index 402de40..1e21e8d 100644 --- a/src/symbol.c +++ b/src/symbol.c @@ -1,7 +1,10 @@ #include +#include #include "kernel.h" +int Hash (char const *, int); + Object Obarray; Object Null, @@ -16,7 +19,7 @@ Object Null, Zero, One; -Init_Symbol () { +void Init_Symbol () { SET(Null, T_Null, 0); SET(True, T_Boolean, 1); SET(False, T_Boolean, 0); @@ -32,7 +35,7 @@ Init_Symbol () { Define_Symbol (&Void, ""); } -Object Make_Symbol (name) Object name; { +Object Make_Symbol (Object name) { Object sym; register struct S_Symbol *sp; GC_Node; @@ -47,17 +50,17 @@ Object Make_Symbol (name) Object name; { return sym; } -Object P_Symbolp (x) Object x; { +Object P_Symbolp (Object x) { return TYPE(x) == T_Symbol ? True : False; } -Object P_Symbol_To_String (x) Object x; { +Object P_Symbol_To_String (Object x) { Check_Type (x, T_Symbol); return SYMBOL(x)->name; } -Object Obarray_Lookup (str, len) register char *str; register len; { - register h; +Object Obarray_Lookup (register char const *str, register int len) { + register int h; register struct S_String *s; register struct S_Symbol *sym; Object p; @@ -72,10 +75,10 @@ Object Obarray_Lookup (str, len) register char *str; register len; { return Make_Integer (h); } -Object CI_Intern (str) const char *str; { +Object CI_Intern (char const *str) { Object s, *p, sym, ostr; - register len; - register const char *src; + register int len; + register char const *src; char *dst; char buf[128]; Alloca_Begin; @@ -83,7 +86,7 @@ Object CI_Intern (str) const char *str; { len = strlen (str); if (len > sizeof (buf)) { Alloca (dst, char*, len); - } else + } else dst = buf; src = str; str = dst; @@ -103,9 +106,9 @@ Object CI_Intern (str) const char *str; { return sym; } -Object Intern (str) const char *str; { +Object Intern (char const *str) { Object s, *p, sym, ostr; - register len; + register int len; if (Case_Insensitive) return CI_Intern (str); @@ -121,7 +124,7 @@ Object Intern (str) const char *str; { return sym; } -Object P_String_To_Symbol (str) Object str; { +Object P_String_To_Symbol (Object str) { Object s, *p, sym; Check_Type (str, T_String); @@ -137,7 +140,7 @@ Object P_String_To_Symbol (str) Object str; { } Object P_Oblist () { - register i; + register int i; Object p, list, bucket; GC_Node2; @@ -154,7 +157,7 @@ Object P_Oblist () { return list; } -Object P_Put (argc, argv) Object *argv; { +Object P_Put (int argc, Object *argv) { Object sym, key, last, tail, prop; GC_Node3; @@ -189,7 +192,7 @@ Object P_Put (argc, argv) Object *argv; { return key; } -Object P_Get (sym, key) Object sym, key; { +Object P_Get (Object sym, Object key) { Object prop; Check_Type (sym, T_Symbol); @@ -205,14 +208,14 @@ Object P_Get (sym, key) Object sym, key; { return Cdr (prop); } -Object P_Symbol_Plist (sym) Object sym; { +Object P_Symbol_Plist (Object sym) { Check_Type (sym, T_Symbol); return Copy_List (SYMBOL(sym)->plist); } -Hash (str, len) char *str; { - register h; - register char *p, *ep; +int Hash (char const *str, int len) { + register int h; + register char const *p, *ep; h = 5 * len; if (len > 5) @@ -222,12 +225,12 @@ Hash (str, len) char *str; { return h & 017777777777; } -void Define_Symbol (sym, name) Object *sym; const char *name; { +void Define_Symbol (Object *sym, char const *name) { *sym = Intern (name); Func_Global_GC_Link (sym); } -void Define_Variable (var, name, init) Object *var, init; const char *name; { +void Define_Variable (Object *var, char const *name, Object init) { Object frame, sym; GC_Node; @@ -241,26 +244,26 @@ void Define_Variable (var, name, init) Object *var, init; const char *name; { GC_Unlink; } -Object Var_Get (var) Object var; { +Object Var_Get (Object var) { return Cdr (var); } -void Var_Set (var, val) Object var, val; { +void Var_Set (Object var, Object val) { Cdr (var) = val; SYMBOL (Car (var))->value = val; } -int Var_Is_True (var) Object var; { +int Var_Is_True (Object var) { var = Var_Get (var); return Truep (var); } -unsigned long Symbols_To_Bits (x, mflag, stab) Object x; SYMDESCR *stab; { +unsigned long int Symbols_To_Bits (Object x, int mflag, SYMDESCR *stab) { register SYMDESCR *syms; - register unsigned long mask = 0; + register unsigned long int mask = 0; Object l, s; register char *p; - register n; + register int n; if (!mflag) Check_Type (x, T_Symbol); for (l = x; !Nullp (l); l = Cdr (l)) { @@ -282,7 +285,7 @@ unsigned long Symbols_To_Bits (x, mflag, stab) Object x; SYMDESCR *stab; { return mask; } -Object Bits_To_Symbols (x, mflag, stab) unsigned long x; SYMDESCR *stab; { +Object Bits_To_Symbols (unsigned long int x, int mflag, SYMDESCR *stab) { register SYMDESCR *syms; Object list, tail, cell; GC_Node2; @@ -292,7 +295,7 @@ Object Bits_To_Symbols (x, mflag, stab) unsigned long x; SYMDESCR *stab; { for (list = tail = Null, syms = stab; syms->name; syms++) if ((x & syms->val) && syms->val != ~0) { Object z; - + z = Intern (syms->name); cell = Cons (z, Null); if (Nullp (list)) diff --git a/src/terminate.c b/src/terminate.c index 61a4857..dde1e78 100644 --- a/src/terminate.c +++ b/src/terminate.c @@ -2,6 +2,7 @@ */ #include +#include #include "kernel.h" @@ -9,7 +10,7 @@ static WEAK_NODE *first; void Call_Terminators(); -Init_Terminate () { +void Init_Terminate () { Register_After_GC (Call_Terminators); } @@ -29,7 +30,7 @@ void Register_Object (obj, group, term, leader_flag) Object obj; GENERIC group; first = p; } -void Deregister_Object (obj) Object obj; { +void Deregister_Object (Object obj) { WEAK_NODE *p, **pp; Disable_Interrupts; @@ -95,7 +96,7 @@ Object Find_Object (va_alist) va_dcl { /* Terminate all objects belonging to the given group except leaders. */ -void Terminate_Group (group) GENERIC group; { +void Terminate_Group (GENERIC group) { WEAK_NODE *p, **pp, *q = 0; Disable_Interrupts; @@ -120,7 +121,7 @@ void Terminate_Group (group) GENERIC group; { /* Terminate all objects of a given type. */ -void Terminate_Type (type) int type; { +void Terminate_Type (int type) { WEAK_NODE *p, **pp, *q = 0; Disable_Interrupts; diff --git a/src/type.c b/src/type.c index 56dccfe..f6582ae 100644 --- a/src/type.c +++ b/src/type.c @@ -3,6 +3,8 @@ #include "kernel.h" +#include + #define TYPE_GROW 10 TYPEDESCR *Types; @@ -20,12 +22,12 @@ char *builtin_types[] = { 0 }; -Wrong_Type (x, t) Object x; register t; { +void Wrong_Type (Object x, register int t) { Wrong_Type_Combination (x, Types[t].name); } -Wrong_Type_Combination (x, name) Object x; register const char *name; { - register t = TYPE(x); +void Wrong_Type_Combination (Object x, register char const *name) { + register int t = TYPE(x); char buf[100]; if (t < 0 || t >= Num_Types) @@ -35,17 +37,17 @@ Wrong_Type_Combination (x, name) Object x; register const char *name; { Primitive_Error (buf); } -Object P_Type (x) Object x; { - register t = TYPE(x); +Object P_Type (Object x) { + register int t = TYPE(x); if (t < 0 || t >= Num_Types) Panic ("bad type2"); return Intern (Types[t].name); } -Define_Type (t, name, size, const_size, eqv, equal, print, visit) register t; - const char *name; - int (*size)(), (*eqv)(), (*equal)(), (*print)(), (*visit)(); { +int Define_Type (register int t, char const *name, + int (*size)(), int const_size, int (*eqv)(), int (*equal)(), + int (*print)(), int (*visit)()) { register TYPEDESCR *p; Set_Error_Tag ("define-type"); @@ -70,7 +72,7 @@ Define_Type (t, name, size, const_size, eqv, equal, print, visit) register t; return Num_Types-1; } -Init_Type() { +void Init_Type() { int i, bytes; char *p; @@ -78,8 +80,8 @@ Init_Type() { Max_Type = Num_Types + TYPE_GROW; bytes = Max_Type * sizeof(TYPEDESCR); Types = (TYPEDESCR *)Safe_Malloc(bytes); - bzero((char *)Types, bytes); - for (i = 0; p = builtin_types[i]; i++) { + memset(Types, 0, bytes); + for (i = 0; (p = builtin_types[i]); i++) { Types[i].haspointer = *p != '0'; Types[i].name = ++p; } diff --git a/src/vector.c b/src/vector.c index 33db53f..5e65953 100644 --- a/src/vector.c +++ b/src/vector.c @@ -1,10 +1,14 @@ #include "kernel.h" -Object General_Make_Vector (len, fill, konst) Object fill; { +#include + +extern int Get_Index (Object, Object); + +Object General_Make_Vector (int len, Object fill, int konst) { Object vec; register Object *op; GC_Node; - + GC_Link (fill); vec = Alloc_Object ((len-1) * sizeof (Object) + sizeof (struct S_Vector), T_Vector, konst); @@ -16,25 +20,25 @@ Object General_Make_Vector (len, fill, konst) Object fill; { return vec; } -Object Make_Vector (len, fill) Object fill; { +Object Make_Vector (int len, Object fill) { return General_Make_Vector (len, fill, 0); } -Object Make_Const_Vector (len, fill) Object fill; { +Object Make_Const_Vector (int len, Object fill) { return General_Make_Vector (len, fill, 1); } -Object P_Make_Vector (argc, argv) Object *argv; { - register len; +Object P_Make_Vector (int argc, Object *argv) { + register int len; if ((len = Get_Exact_Integer (argv[0])) < 0) Range_Error (argv[0]); return Make_Vector (len, argc == 1 ? Null : argv[1]); } -Object P_Vector (argc, argv) Object *argv; { +Object P_Vector (int argc, Object *argv) { Object vec; - register i; + register int i; vec = Make_Vector (argc, Null); for (i = 0; i < argc; i++) @@ -42,23 +46,23 @@ Object P_Vector (argc, argv) Object *argv; { return vec; } -Object P_Vectorp (x) Object x; { +Object P_Vectorp (Object x) { return TYPE(x) == T_Vector ? True : False; } -Object P_Vector_Length (x) Object x; { +Object P_Vector_Length (Object x) { Check_Type (x, T_Vector); return Make_Integer (VECTOR(x)->size); } -Object P_Vector_Ref (vec, n) Object vec, n; { +Object P_Vector_Ref (Object vec, Object n) { Check_Type (vec, T_Vector); return VECTOR(vec)->data[Get_Index (n, vec)]; } -Object P_Vector_Set (vec, n, new) Object vec, n, new; { +Object P_Vector_Set (Object vec, Object n, Object new) { Object old; - register i; + register int i; Check_Type (vec, T_Vector); Check_Mutable (vec); @@ -70,8 +74,8 @@ Object P_Vector_Set (vec, n, new) Object vec, n, new; { /* We cannot simply call P_List with vec->size and vec->data here, * because the latter can change during GC. */ -Object P_Vector_To_List (vec) Object vec; { - register i; +Object P_Vector_To_List (Object vec) { + register int i; Object list, tail, cell; GC_Node3; @@ -89,9 +93,9 @@ Object P_Vector_To_List (vec) Object vec; { return list; } -Object List_To_Vector (list, konst) Object list; { +Object List_To_Vector (Object list, int konst) { Object vec, len; - register i; + register int i; GC_Node; GC_Link (list); @@ -106,12 +110,12 @@ Object List_To_Vector (list, konst) Object list; { return vec; } -Object P_List_To_Vector (list) Object list; { +Object P_List_To_Vector (Object list) { return List_To_Vector (list, 0); } -Object P_Vector_Fill (vec, fill) Object vec, fill; { - register i; +Object P_Vector_Fill (Object vec, Object fill) { + register int i; Check_Type (vec, T_Vector); Check_Mutable (vec); @@ -120,14 +124,14 @@ Object P_Vector_Fill (vec, fill) Object vec, fill; { return vec; } -Object P_Vector_Copy (vec) Object vec; { +Object P_Vector_Copy (Object vec) { Object new; GC_Node; Check_Type (vec, T_Vector); GC_Link (vec); new = Make_Vector (VECTOR(vec)->size, Null); - bcopy ((char *)POINTER(vec), (char *)POINTER(new), + memcpy (POINTER(new), POINTER(vec), (VECTOR(vec)->size-1) * sizeof (Object) + sizeof (struct S_Vector)); GC_Unlink; return new;