Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Sources C convertis en ANSI C 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1696 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Xavier Leroy 1997-09-02 12:55:01 +00:00
parent d75918f7e4
commit 1517cea772
208 changed files with 1351 additions and 2091 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
asmrun/Makefile
View File

@ -91,7 +91,7 @@ compact.c: ../byterun/compact.c
LINKEDFILES=misc.c freelist.c major_gc.c minor_gc.c memory.c alloc.c \
compare.c ints.c floats.c str.c io.c extern.c intern.c hash.c sys.c \
parsing.c gc_ctrl.c terminfo.c md5.c obj.c lexing.c printexc.c callback.c \
weak.c
weak.c compact.c
clean::
rm -f $(LINKEDFILES)

8
asmrun/array.c
View File

@ -19,8 +19,7 @@
#include "misc.h"
#include "mlvalues.h"
value make_vect(len, init)
value len, init;
value make_vect(value len, value init)
{
value res;
mlsize_t size, wsize, i;
@ -66,8 +65,7 @@ value make_vect(len, init)
return res;
}
value make_array(init)
value init;
value make_array(value init)
{
mlsize_t wsize, size, i;
value v, res;
@ -98,7 +96,7 @@ value make_array(init)
}
}
void array_bound_error()
void array_bound_error(void)
{
fatal_error("Fatal error: out-of-bound access in array or string\n");
}

33
asmrun/fail.c
View File

@ -35,12 +35,11 @@ extern caml_generated_constant Out_of_memory, Sys_error, Failure,
/* Exception raising */
extern void raise_caml_exception P((value bucket)) Noreturn;
extern void raise_caml_exception (value bucket) Noreturn;
char * caml_exception_pointer = NULL;
void mlraise(v)
value v;
void mlraise(value v)
{
#ifdef POSIX_SIGNALS
sigset_t mask;
@ -68,8 +67,7 @@ void mlraise(v)
raise_caml_exception(v);
}
void raise_constant(tag)
value tag;
void raise_constant(value tag)
{
value bucket;
Begin_root (tag);
@ -79,9 +77,7 @@ void raise_constant(tag)
mlraise(bucket);
}
void raise_with_arg(tag, arg)
value tag;
value arg;
void raise_with_arg(value tag, value arg)
{
value bucket;
Begin_roots2 (tag, arg);
@ -92,15 +88,12 @@ void raise_with_arg(tag, arg)
mlraise(bucket);
}
void raise_with_string(tag, msg)
value tag;
char * msg;
void raise_with_string(value tag, char *msg)
{
raise_with_arg(tag, copy_string(msg));
}
void failwith (msg)
char * msg;
void failwith (char *msg)
{
raise_with_string((value) Failure, msg);
}
@ -113,8 +106,7 @@ void failwith (msg)
Finally, this allows a number of C primitives to be declared "noalloc",
and this makes calling them much more efficient. */
void invalid_argument (msg)
char * msg;
void invalid_argument (char *msg)
{
fatal_error_arg("Fatal_error: Invalid_argument \"%s\"\n", msg);
}
@ -130,30 +122,29 @@ static struct {
value exn;
} out_of_memory_bucket;
void raise_out_of_memory()
void raise_out_of_memory(void)
{
out_of_memory_bucket.hdr = Make_header(1, 0, White);
out_of_memory_bucket.exn = (value) Out_of_memory;
mlraise((value) &(out_of_memory_bucket.exn));
}
void raise_sys_error(msg)
value msg;
void raise_sys_error(value msg)
{
raise_with_arg((value) Sys_error, msg);
}
void raise_end_of_file()
void raise_end_of_file(void)
{
raise_constant((value) End_of_file);
}
void raise_zero_divide()
void raise_zero_divide(void)
{
raise_constant((value) Division_by_zero);
}
void raise_not_found()
void raise_not_found(void)
{
raise_constant((value) Not_found);
}

2
asmrun/roots.c
View File

@ -32,7 +32,7 @@ struct global_root {
static struct global_root * global_roots = NULL;
void (*scan_roots_hook) P((scanning_action)) = NULL;
void (*scan_roots_hook) (scanning_action) = NULL;
/* Register a global C root */

51
asmrun/signals.c
View File

@ -25,9 +25,9 @@
#include "fail.h"
#include "signals.h"
Volatile int async_signal_mode = 0;
Volatile int pending_signal = 0;
Volatile int force_major_slice = 0;
volatile int async_signal_mode = 0;
volatile int pending_signal = 0;
volatile int force_major_slice = 0;
value signal_handlers = 0;
extern unsigned long caml_last_return_address;
void (*enter_blocking_section_hook)() = NULL;
@ -35,8 +35,7 @@ void (*leave_blocking_section_hook)() = NULL;
/* Execute a signal handler immediately. */
static void execute_signal(signal_number)
int signal_number;
static void execute_signal(int signal_number)
{
Assert (!async_signal_mode);
callback(Field(signal_handlers, signal_number), Val_int(signal_number));
@ -45,7 +44,7 @@ static void execute_signal(signal_number)
/* This routine is the common entry point for garbage collection
and signal handling */
void garbage_collection()
void garbage_collection(void)
{
int sig;
@ -60,7 +59,7 @@ void garbage_collection()
/* Trigger a garbage collection as soon as possible */
void urge_major_slice ()
void urge_major_slice (void)
{
force_major_slice = 1;
young_limit = young_end;
@ -70,7 +69,7 @@ void urge_major_slice ()
from young_limit. */
}
void enter_blocking_section()
void enter_blocking_section(void)
{
int sig;
@ -88,7 +87,7 @@ void enter_blocking_section()
if (enter_blocking_section_hook != NULL) enter_blocking_section_hook();
}
void leave_blocking_section()
void leave_blocking_section(void)
{
Assert(async_signal_mode);
if (leave_blocking_section_hook != NULL) leave_blocking_section_hook();
@ -97,16 +96,11 @@ void leave_blocking_section()
#if defined(TARGET_alpha) || defined(TARGET_mips) || \
(defined(TARGET_power) && defined(_AIX))
void handle_signal(sig, code, context)
int sig, code;
struct sigcontext * context;
void handle_signal(int sig, int code, struct sigcontext * context)
#elif defined(TARGET_power) && defined(__linux)
void handle_signal(sig, context)
int sig;
struct pt_regs * context;
void handle_signal(int sig, sutrct pt_regs * context)
#else
void handle_signal(sig)
int sig;
void handle_signal(int sig)
#endif
{
#ifndef POSIX_SIGNALS
@ -227,8 +221,8 @@ int posix_signals[] = {
#define NSIG 32
#endif
value install_signal_handler(signal_number, action) /* ML */
value signal_number, action;
value install_signal_handler(value signal_number, value action) /* ML */
{
int sig;
void (*act)();
@ -274,10 +268,8 @@ value install_signal_handler(signal_number, action) /* ML */
/* Machine- and OS-dependent handling of bound check trap */
#if defined(TARGET_sparc) && defined(SYS_sunos)
static void trap_handler(sig, code, context, address)
int sig, code;
struct sigcontext * context;
char * address;
static void trap_handler(int sig, int code,
struct sigcontext * context, char * address)
{
if (code == ILL_TRAP_FAULT(5)) {
array_bound_error();
@ -289,10 +281,7 @@ static void trap_handler(sig, code, context, address)
#endif
#if defined(TARGET_sparc) && defined(SYS_solaris)
static void trap_handler(sig, info, context)
int sig;
siginfo_t * info;
struct ucontext_t * context;
static void trap_handler(int sig, siginfo_t info, struct ucontext_t * context)
{
if (info->si_code == ILL_ILLTRP) {
array_bound_error();
@ -305,16 +294,14 @@ static void trap_handler(sig, info, context)
#endif
#if defined(TARGET_sparc) && defined(SYS_bsd)
static void trap_handler(sig)
int sig;
static void trap_handler(int sig)
{
array_bound_error();
}
#endif
#if defined(TARGET_power)
static void trap_handler(sig)
int sig;
static void trap_handler(int sig)
{
array_bound_error();
}
@ -322,7 +309,7 @@ static void trap_handler(sig)
/* Initialization of signal stuff */
void init_signals()
void init_signals(void)
{
#if defined(TARGET_sparc) && (defined(SYS_sunos) || defined(SYS_bsd))
signal(SIGILL, trap_handler);

24
asmrun/startup.c
View File

@ -33,9 +33,7 @@ char * code_area_start, * code_area_end;
struct segment { char * begin; char * end; };
static void minmax_table(table, min, max)
struct segment table[];
char ** min, ** max;
static void minmax_table(struct segment *table, char **min, char **max)
{
int i;
*min = table[0].begin;
@ -46,7 +44,7 @@ static void minmax_table(table, min, max)
}
}
static void init_atoms()
static void init_atoms(void)
{
int i;
extern struct segment caml_data_segments[], caml_code_segments[];
@ -73,9 +71,7 @@ static unsigned long max_stack_init = Max_stack_def;
*/
/* Note: option l is irrelevant to the native-code runtime. */
static void scanmult (opt, var)
char *opt;
unsigned long *var;
static void scanmult (char *opt, long unsigned int *var)
{
char mult = ' ';
sscanf (opt, "=%lu%c", var, &mult);
@ -84,7 +80,7 @@ static void scanmult (opt, var)
if (mult == 'G') *var = *var * (1024 * 1024 * 1024);
}
static void parse_camlrunparam()
static void parse_camlrunparam(void)
{
char *opt = getenv ("CAMLRUNPARAM");
if (opt != NULL){
@ -102,12 +98,11 @@ static void parse_camlrunparam()
}
}
extern void caml_start_program P((void));
extern void init_ieee_floats P((void));
extern void init_signals P((void));
extern void caml_start_program (void);
extern void init_ieee_floats (void);
extern void init_signals (void);
void caml_main(argv)
char ** argv;
void caml_main(char **argv)
{
init_ieee_floats();
#ifdef DEBUG
@ -122,8 +117,7 @@ void caml_main(argv)
caml_start_program();
}
void caml_startup(argv)
char ** argv;
void caml_startup(char **argv)
{
caml_main(argv);
}

29
byterun/alloc.c
View File

@ -26,9 +26,7 @@
#define Setup_for_gc
#define Restore_after_gc
value alloc (wosize, tag)
mlsize_t wosize;
tag_t tag;
value alloc (mlsize_t wosize, tag_t tag)
{
value result;
@ -37,14 +35,12 @@ value alloc (wosize, tag)
return result;
}
value alloc_tuple(n)
mlsize_t n;
value alloc_tuple(mlsize_t n)
{
return alloc(n, 0);
}
value alloc_string (len)
mlsize_t len;
value alloc_string (mlsize_t len)
{
value result;
mlsize_t offset_index;
@ -62,10 +58,7 @@ value alloc_string (len)
return result;
}
value alloc_final (len, fun, mem, max)
mlsize_t len;
final_fun fun;
mlsize_t mem, max;
value alloc_final (mlsize_t len, final_fun fun, mlsize_t mem, mlsize_t max)
{
value result = alloc_shr (len, Final_tag);
@ -75,8 +68,7 @@ value alloc_final (len, fun, mem, max)
return result;
}
value copy_string(s)
char * s;
value copy_string(char *s)
{
int len;
value res;
@ -87,9 +79,7 @@ value copy_string(s)
return res;
}
value alloc_array(funct, arr)
value (*funct) P((char *));
char ** arr;
value alloc_array(value (*funct)(char *), char ** arr)
{
mlsize_t nbr, n;
value v, result;
@ -113,15 +103,12 @@ value alloc_array(funct, arr)
}
}
value copy_string_array(arr)
char ** arr;
value copy_string_array(char **arr)
{
return alloc_array(copy_string, arr);
}
int convert_flag_list(list, flags)
value list;
int * flags;
int convert_flag_list(value list, int *flags)
{
int res;
res = 0;

18
byterun/alloc.h
View File

@ -18,15 +18,15 @@
#include "misc.h"
#include "mlvalues.h"
value alloc P((mlsize_t, tag_t));
value alloc_tuple P((mlsize_t));
value alloc_string P((mlsize_t));
value alloc_final P((mlsize_t, final_fun, mlsize_t, mlsize_t));
value copy_string P((char *));
value copy_string_array P((char **));
value copy_double P((double));
value alloc_array P((value (*funct) P((char *)), char ** array));
int convert_flag_list P((value, int *));
value alloc (mlsize_t, tag_t);
value alloc_tuple (mlsize_t);
value alloc_string (mlsize_t);
value alloc_final (mlsize_t, final_fun, mlsize_t, mlsize_t);
value copy_string (char *);
value copy_string_array (char **);
value copy_double (double);
value alloc_array (value (*funct) (char *), char ** array);
int convert_flag_list (value, int *);
#endif /* _alloc_ */

9
byterun/array.c
View File

@ -19,16 +19,14 @@
#include "misc.h"
#include "mlvalues.h"
value array_get(array, index) /* ML */
value array, index;
value array_get(value array, value index) /* ML */
{
long idx = Long_val(index);
if (idx < 0 || idx >= Wosize_val(array)) invalid_argument("Array.get");
return Field(array, idx);
}
value array_set(array, index, newval) /* ML */
value array, index, newval;
value array_set(value array, value index, value newval) /* ML */
{
long idx = Long_val(index);
if (idx < 0 || idx >= Wosize_val(array)) invalid_argument("Array.set");
@ -36,8 +34,7 @@ value array_set(array, index, newval) /* ML */
return Val_unit;
}
value make_vect(len, init) /* ML */
value len, init;
value make_vect(value len, value init) /* ML */
{
value res;
mlsize_t size, i;

20
byterun/callback.c
View File

@ -37,7 +37,7 @@ static opcode_t callback3_code[] = { ACC3, APPLY3, POP, 1, STOP };
static int callback_code_threaded = 0;
static void thread_callback()
static void thread_callback(void)
{
thread_code(callback1_code, sizeof(callback1_code));
thread_code(callback2_code, sizeof(callback2_code));
@ -53,8 +53,7 @@ static void thread_callback()
#endif
value callback(closure, arg)
value closure, arg;
value callback(value closure, value arg)
{
value res;
Init_callback();
@ -67,8 +66,7 @@ value callback(closure, arg)
return res;
}
value callback2(closure, arg1, arg2)
value closure, arg1, arg2;
value callback2(value closure, value arg1, value arg2)
{
value res;
Init_callback();
@ -82,8 +80,7 @@ value callback2(closure, arg1, arg2)
return res;
}
value callback3(closure, arg1, arg2, arg3)
value closure, arg1, arg2, arg3;
value callback3(value closure, value arg1, value arg2, value arg3)
{
value res;
Init_callback();
@ -112,16 +109,14 @@ struct named_value {
static struct named_value * named_value_table[Named_value_size] = { NULL, };
static unsigned int hash_value_name(name)
char * name;
static unsigned int hash_value_name(char *name)
{
unsigned int h;
for (h = 0; *name != 0; name++) h = h * 19 + *name;
return h % Named_value_size;
}
value register_named_value(vname, val) /* ML */
value vname, val;
value register_named_value(value vname, value val) /* ML */
{
struct named_value * nv;
char * name = String_val(vname);
@ -137,8 +132,7 @@ value register_named_value(vname, val) /* ML */
return Val_unit;
}
value * caml_named_value(name)
char * name;
value * caml_named_value(char *name)
{
struct named_value * nv;
for (nv = named_value_table[hash_value_name(name)];

12
byterun/callback.h
View File

@ -18,14 +18,14 @@
#include "mlvalues.h"
value callback P((value closure, value arg));
value callback2 P((value closure, value arg1, value arg2));
value callback3 P((value closure, value arg1, value arg2, value arg3));
value callback (value closure, value arg);
value callback2 (value closure, value arg1, value arg2);
value callback3 (value closure, value arg1, value arg2, value arg3);
extern int callback_depth;
value * caml_named_value P((char * name));
value * caml_named_value (char * name);
void caml_main P((char ** argv));
void caml_startup P((char ** argv));
void caml_main (char ** argv);
void caml_startup (char ** argv);
#endif

17
byterun/compact.c
View File

@ -24,7 +24,7 @@
#include "weak.h"
extern unsigned long percent_free; /* major_gc.c */
extern void shrink_heap P((char *)); /* memory.c */
extern void shrink_heap (char *); /* memory.c */
/* Encoded headers: the color is stored in the 2 least significant bits.
(For pointer inversion, we need to distinguish headers from pointers.)
@ -44,8 +44,7 @@ extern void shrink_heap P((char *)); /* memory.c */
typedef unsigned long word;
static void invert_pointer_at (p)
word *p;
static void invert_pointer_at (word *p)
{
word q = *p;
@ -97,16 +96,14 @@ static void invert_pointer_at (p)
}
}
static void invert_root (v, p)
value v;
value *p;
static void invert_root (value v, value *p)
{
invert_pointer_at ((word *) p);
}
static char *compact_fl;
static void init_compact_allocate ()
static void init_compact_allocate (void)
{
char *ch = heap_start;
while (ch != NULL){
@ -116,8 +113,8 @@ static void init_compact_allocate ()
compact_fl = heap_start;
}
static char *compact_allocate (size)
mlsize_t size; /* in bytes, including header */
static char *compact_allocate (mlsize_t size)
/* in bytes, including header */
{
char *chunk, *adr;
@ -379,7 +376,7 @@ void compact_heap (void)
unsigned long percent_max;
void compact_heap_maybe ()
void compact_heap_maybe (void)
{
/* Estimated free words in the heap: FW = 1.5 * fl_cur_size
Estimated live words: LW = stat_heap_size - FW

4
byterun/compact.h
View File

@ -18,8 +18,8 @@
#include "config.h"
#include "misc.h"
void compact_heap P((void));
void compact_heap_maybe P((void));
void compact_heap (void);
void compact_heap_maybe (void);
#endif /* _compact_ */

25
byterun/compare.c
View File

@ -20,8 +20,7 @@
/* Structural comparison on trees.
May loop on cyclic structures. */
static long compare_val(v1, v2)
value v1,v2;
static long compare_val(value v1, value v2)
{
tag_t t1, t2;
@ -102,8 +101,7 @@ static long compare_val(v1, v2)
}
}
value compare(v1, v2) /* ML */
value v1, v2;
value compare(value v1, value v2) /* ML */
{
long res = compare_val(v1, v2);
if (res < 0)
@ -114,39 +112,32 @@ value compare(v1, v2) /* ML */
return Val_int(0);
}
value equal(v1, v2) /* ML */
value v1, v2;
value equal(value v1, value v2) /* ML */
{
return Val_int(compare_val(v1, v2) == 0);
}
value notequal(v1, v2) /* ML */
value v1, v2;
value notequal(value v1, value v2) /* ML */
{
return Val_int(compare_val(v1, v2) != 0);
}
value lessthan(v1, v2) /* ML */
value v1, v2;
value lessthan(value v1, value v2) /* ML */
{
return Val_int(compare_val(v1, v2) < 0);
}
value lessequal(v1, v2) /* ML */
value v1, v2;
value lessequal(value v1, value v2) /* ML */
{
return Val_int(compare_val(v1, v2) <= 0);
}
value greaterthan(v1, v2) /* ML */
value v1, v2;
value greaterthan(value v1, value v2) /* ML */
{
return Val_int(compare_val(v1, v2) > 0);
}
value greaterequal(v1, v2) /* ML */
value v1, v2;
value greaterequal(value v1, value v2) /* ML */
{
return Val_int(compare_val(v1, v2) >= 0);
}

25
byterun/debugger.c
View File

@ -32,12 +32,11 @@ unsigned long event_count;
#if !defined(HAS_SOCKETS) || defined(_WIN32)
void debugger_init()
void debugger_init(void)
{
}
void debugger(event)
enum event_kind event;
void debugger(enum event_kind event)
{
}
@ -66,7 +65,7 @@ static int dbg_socket = -1; /* The socket connected to the debugger */
static struct channel * dbg_in; /* Input channel on the socket */
static struct channel * dbg_out;/* Output channel on the socket */
static void open_connection()
static void open_connection(void)
{
dbg_socket = socket(sock_domain, SOCK_STREAM, 0);
if (dbg_socket == -1 ||
@ -79,14 +78,14 @@ static void open_connection()
flush(dbg_out);
}
static void close_connection()
static void close_connection(void)
{
close_channel(dbg_in);
close_channel(dbg_out);
dbg_socket = -1; /* was closed by close_channel */
}
void debugger_init()
void debugger_init(void)
{
char * address;
char * port, * p;
@ -131,8 +130,7 @@ void debugger_init()
trap_barrier = stack_high;
}
static value getval(chan)
struct channel * chan;
static value getval(struct channel *chan)
{
value res;
if (really_getblock(chan, (char *) &res, sizeof(res)) == 0)
@ -140,16 +138,12 @@ static value getval(chan)
return res;
}
static void putval(chan, val)
struct channel * chan;
value val;
static void putval(struct channel *chan, value val)
{
really_putblock(chan, (char *) &val, sizeof(val));
}
static void safe_output_value(chan, val)
struct channel * chan;
value val;
static void safe_output_value(struct channel *chan, value val)
{
struct longjmp_buffer raise_buf, * saved_external_raise;
@ -170,8 +164,7 @@ static void safe_output_value(chan, val)
#define Extra_args(sp) (Long_val((sp[2])))
#define Locals(sp) (sp + 3)
void debugger(event)
enum event_kind event;
void debugger(enum event_kind event)
{
int frame_number;
value * frame;

4
byterun/debugger.h
View File

@ -27,8 +27,8 @@ enum event_kind {
TRAP_BARRIER, UNCAUGHT_EXC
};
void debugger_init P((void));
void debugger P((enum event_kind event));
void debugger_init (void);
void debugger (enum event_kind event);
/* Communication protocol */

56
byterun/extern.c
View File

@ -46,7 +46,7 @@ static byteoffset_t obj_counter; /* Number of objects emitted so far */
#endif
/* Allocate a new extern table */
static void alloc_extern_table()
static void alloc_extern_table(void)
{
asize_t i;
extern_table = (struct extern_obj *)
@ -55,7 +55,7 @@ static void alloc_extern_table()
}
/* Grow the extern table */
static void resize_extern_table()
static void resize_extern_table(void)
{
asize_t oldsize;
struct extern_obj * oldtable;
@ -86,7 +86,7 @@ static void resize_extern_table()
/* Free the extern table. We keep it around for next call if
it's still small (we did not grow it) and the initial offset
does not risk running over next time. */
static void free_extern_table()
static void free_extern_table(void)
{
if (extern_table_size > INITIAL_EXTERN_TABLE_SIZE ||
initial_ofs >= INITIAL_OFFSET_MAX) {
@ -100,7 +100,7 @@ static void free_extern_table()
static char * extern_block, * extern_ptr, * extern_limit;
static int extern_block_malloced;
static void alloc_extern_block()
static void alloc_extern_block(void)
{
extern_block = stat_alloc(INITIAL_EXTERN_BLOCK_SIZE);
extern_limit = extern_block + INITIAL_EXTERN_BLOCK_SIZE;
@ -108,8 +108,7 @@ static void alloc_extern_block()
extern_block_malloced = 1;
}
static void resize_extern_block(required)
int required;
static void resize_extern_block(int required)
{
long curr_pos, size, reqd_size;
@ -133,18 +132,14 @@ static void resize_extern_block(required)
if (extern_ptr >= extern_limit) resize_extern_block(1); \
*extern_ptr++ = (c)
static void writeblock(data, len)
char * data;
long len;
static void writeblock(char *data, long int len)
{
if (extern_ptr + len > extern_limit) resize_extern_block(len);
bcopy(data, extern_ptr, len);
extern_ptr += len;
}
static void writecode8(code, val)
int code;
long val;
static void writecode8(int code, long int val)
{
if (extern_ptr + 2 > extern_limit) resize_extern_block(2);
extern_ptr[0] = code;
@ -152,9 +147,7 @@ static void writecode8(code, val)
extern_ptr += 2;
}
static void writecode16(code, val)
int code;
long val;
static void writecode16(int code, long int val)
{
if (extern_ptr + 3 > extern_limit) resize_extern_block(3);
extern_ptr[0] = code;
@ -163,8 +156,7 @@ static void writecode16(code, val)
extern_ptr += 3;
}
static void write32(val)
long val;
static void write32(long int val)
{
if (extern_ptr + 4 > extern_limit) resize_extern_block(4);
extern_ptr[0] = val >> 24;
@ -174,9 +166,7 @@ static void write32(val)
extern_ptr += 4;
}
static void writecode32(code, val)
int code;
long val;
static void writecode32(int code, long int val)
{
if (extern_ptr + 5 > extern_limit) resize_extern_block(5);
extern_ptr[0] = code;
@ -188,9 +178,7 @@ static void writecode32(code, val)
}
#ifdef ARCH_SIXTYFOUR
static void writecode64(code, val)
int code;
long val;
static void writecode64(int code, long val)
{
int i;
if (extern_ptr + 9 > extern_limit) resize_extern_block(9);
@ -207,8 +195,7 @@ static unsigned long size_64; /* Size in words of 64-bit block for struct. */
static int extern_ignore_sharing; /* Flag to ignore sharing */
static int extern_closures; /* Flag to allow externing code pointers */
static void extern_invalid_argument(msg)
char * msg;
static void extern_invalid_argument(char *msg)
{
if (extern_block_malloced) stat_free(extern_block);
initial_ofs += obj_counter;
@ -216,8 +203,7 @@ static void extern_invalid_argument(msg)
invalid_argument(msg);
}
static void extern_rec(v)
value v;
static void extern_rec(value v)
{
tailcall:
if (Is_long(v)) {
@ -355,8 +341,7 @@ static void extern_rec(v)
enum { NO_SHARING = 1, CLOSURES = 2 };
static int extern_flags[] = { NO_SHARING, CLOSURES };
static long extern_value(v, flags)
value v, flags;
static long extern_value(value v, value flags)
{
long res_len;
int fl;
@ -403,9 +388,7 @@ static long extern_value(v, flags)
return res_len;
}
void output_val(chan, v, flags)
struct channel * chan;
value v, flags;
void output_val(struct channel *chan, value v, value flags)
{
long len;
alloc_extern_block();
@ -414,8 +397,7 @@ void output_val(chan, v, flags)
stat_free(extern_block);
}
value output_value(vchan, v, flags) /* ML */
value vchan, v, flags;
value output_value(value vchan, value v, value flags) /* ML */
{
struct channel * channel = Channel(vchan);
Lock(channel);
@ -424,8 +406,7 @@ value output_value(vchan, v, flags) /* ML */
return Val_unit;
}
value output_value_to_string(v, flags) /* ML */
value v, flags;
value output_value_to_string(value v, value flags) /* ML */
{
long len;
value res;
@ -437,8 +418,7 @@ value output_value_to_string(v, flags) /* ML */
return res;
}
value output_value_to_buffer(buf, ofs, len, v, flags) /* ML */
value buf, ofs, len, v, flags;
value output_value_to_buffer(value buf, value ofs, value len, value v, value flags) /* ML */
{
long len_res;
extern_block = &Byte(buf, Long_val(ofs));

33
byterun/fail.c
View File

@ -25,8 +25,7 @@
struct longjmp_buffer * external_raise;
value exn_bucket;
void mlraise(v)
value v;
void mlraise(value v)
{
Assert(! async_signal_mode);
Unlock_exn();
@ -34,8 +33,7 @@ void mlraise(v)
siglongjmp(external_raise->buf, 1);
}
void raise_constant(tag)
value tag;
void raise_constant(value tag)
{
value bucket;
Begin_root (tag);
@ -45,9 +43,7 @@ void raise_constant(tag)
mlraise(bucket);
}
void raise_with_arg(tag, arg)
value tag;
value arg;
void raise_with_arg(value tag, value arg)
{
value bucket;
Begin_roots2 (tag, arg);
@ -58,9 +54,7 @@ void raise_with_arg(tag, arg)
mlraise(bucket);
}
void raise_with_string(tag, msg)
value tag;
char * msg;
void raise_with_string(value tag, char *msg)
{
value vmsg;
Begin_root(tag);
@ -69,14 +63,12 @@ void raise_with_string(tag, msg)
raise_with_arg(tag, vmsg);
}
void failwith (msg)
char * msg;
void failwith (char *msg)
{
raise_with_string(Field(global_data, FAILURE_EXN), msg);
}
void invalid_argument (msg)
char * msg;
void invalid_argument (char *msg)
{
raise_with_string(Field(global_data, INVALID_EXN), msg);
}
@ -92,35 +84,34 @@ static struct {
value exn;
} out_of_memory_bucket;
void raise_out_of_memory()
void raise_out_of_memory(void)
{
out_of_memory_bucket.hdr = Make_header(1, 0, White);
out_of_memory_bucket.exn = Field(global_data, OUT_OF_MEMORY_EXN);
mlraise((value) &(out_of_memory_bucket.exn));
}
void raise_stack_overflow()
void raise_stack_overflow(void)
{
raise_constant(Field(global_data, STACK_OVERFLOW_EXN));
}
void raise_sys_error(msg)
value msg;
void raise_sys_error(value msg)
{
raise_with_arg(Field(global_data, SYS_ERROR_EXN), msg);
}
void raise_end_of_file()
void raise_end_of_file(void)
{
raise_constant(Field(global_data, END_OF_FILE_EXN));
}
void raise_zero_divide()
void raise_zero_divide(void)
{
raise_constant(Field(global_data, ZERO_DIVIDE_EXN));
}
void raise_not_found()
void raise_not_found(void)
{
raise_constant(Field(global_data, NOT_FOUND_EXN));
}

26
byterun/fail.h
View File

@ -44,18 +44,18 @@ struct longjmp_buffer {
extern struct longjmp_buffer * external_raise;
extern value exn_bucket;
void mlraise P((value bucket)) Noreturn;
void raise_constant P((value tag)) Noreturn;
void raise_with_arg P((value tag, value arg)) Noreturn;
void raise_with_string P((value tag, char * msg)) Noreturn;
void failwith P((char *)) Noreturn;
void invalid_argument P((char *)) Noreturn;
void raise_out_of_memory P((void)) Noreturn;
void raise_stack_overflow P((void)) Noreturn;
void raise_sys_error P((value)) Noreturn;
void raise_end_of_file P((void)) Noreturn;
void raise_zero_divide P((void)) Noreturn;
void raise_not_found P((void)) Noreturn;
void fatal_uncaught_exception P((value)) Noreturn;
void mlraise (value bucket) Noreturn;
void raise_constant (value tag) Noreturn;
void raise_with_arg (value tag, value arg) Noreturn;
void raise_with_string (value tag, char * msg) Noreturn;
void failwith (char *) Noreturn;
void invalid_argument (char *) Noreturn;
void raise_out_of_memory (void) Noreturn;
void raise_stack_overflow (void) Noreturn;
void raise_sys_error (value) Noreturn;
void raise_end_of_file (void) Noreturn;
void raise_zero_divide (void) Noreturn;
void raise_not_found (void) Noreturn;
void fatal_uncaught_exception (value) Noreturn;
#endif /* _fail_ */

12
byterun/fix_code.c
View File

@ -33,9 +33,7 @@ unsigned char code_md5[16];
/* Read the main bytecode block from a file */
void load_code(fd, len)
int fd;
asize_t len;
void load_code(int fd, asize_t len)
{
int i;
struct MD5Context ctx;
@ -67,9 +65,7 @@ void load_code(fd, len)
#ifdef ARCH_BIG_ENDIAN
void fixup_endianness(code, len)
code_t code;
asize_t len;
void fixup_endianness(code_t code, asize_t len)
{
code_t p;
len /= sizeof(opcode_t);
@ -133,9 +129,7 @@ void thread_code (code_t code, asize_t len)
#endif /* THREADED_CODE */
void set_instruction(pos, instr)
code_t pos;
opcode_t instr;
void set_instruction(code_t pos, opcode_t instr)
{
#ifdef THREADED_CODE
*pos = (opcode_t)(instr_table[instr] - instr_base);

8
byterun/fix_code.h
View File

@ -26,14 +26,14 @@ extern asize_t code_size;
extern unsigned char * saved_code;
extern unsigned char code_md5[16];
void load_code P((int fd, asize_t len));
void fixup_endianness P((code_t code, asize_t len));
void set_instruction P((code_t pos, opcode_t instr));
void load_code (int fd, asize_t len);
void fixup_endianness (code_t code, asize_t len);
void set_instruction (code_t pos, opcode_t instr);
#ifdef THREADED_CODE
extern char ** instr_table;
extern char * instr_base;
void thread_code P((code_t code, asize_t len));
void thread_code (code_t code, asize_t len);
#endif
#endif

123
byterun/floats.c
View File

@ -23,8 +23,7 @@
#ifdef ARCH_ALIGN_DOUBLE
double Double_val(val)
value val;
double Double_val(value val)
{
union { value v[2]; double d; } buffer;
@ -34,9 +33,7 @@ double Double_val(val)
return buffer.d;
}
void Store_double_val(val, dbl)
value val;
double dbl;
void Store_double_val(value val, double dbl)
{
union { value v[2]; double d; } buffer;
@ -48,8 +45,7 @@ void Store_double_val(val, dbl)
#endif
value copy_double(d)
double d;
value copy_double(double d)
{
value res;
@ -62,8 +58,7 @@ value copy_double(d)
return res;
}
value format_float(fmt, arg) /* ML */
value fmt, arg;
value format_float(value fmt, value arg) /* ML */
{
#define MAX_DIGITS 350
/* Max number of decimal digits in a "natural" (not artificially padded)
@ -104,81 +99,68 @@ value format_float(fmt, arg) /* ML */
return res;
}
value float_of_string(s) /* ML */
value s;
value float_of_string(value s) /* ML */
{
return copy_double(atof(String_val(s)));
}
value int_of_float(f) /* ML */
value f;
value int_of_float(value f) /* ML */
{
return Val_long((long) Double_val(f));
}
value float_of_int(n) /* ML */
value n;
value float_of_int(value n) /* ML */
{
return copy_double((double) Long_val(n));
}
value neg_float(f) /* ML */
value f;
value neg_float(value f) /* ML */
{
return copy_double(- Double_val(f));
}
value abs_float(f) /* ML */
value f;
value abs_float(value f) /* ML */
{
return copy_double(fabs(Double_val(f)));
}
value add_float(f, g) /* ML */
value f, g;
value add_float(value f, value g) /* ML */
{
return copy_double(Double_val(f) + Double_val(g));
}
value sub_float(f, g) /* ML */
value f, g;
value sub_float(value f, value g) /* ML */
{
return copy_double(Double_val(f) - Double_val(g));
}
value mul_float(f, g) /* ML */
value f, g;
value mul_float(value f, value g) /* ML */
{
return copy_double(Double_val(f) * Double_val(g));
}
value div_float(f, g) /* ML */
value f, g;
value div_float(value f, value g) /* ML */
{
double dg = Double_val(g);
return copy_double(Double_val(f) / dg);
}
value exp_float(f) /* ML */
value f;
value exp_float(value f) /* ML */
{
return copy_double(exp(Double_val(f)));
}
value floor_float(f) /* ML */
value f;
value floor_float(value f) /* ML */
{
return copy_double(floor(Double_val(f)));
}
value fmod_float(f1, f2) /* ML */
value f1, f2;
value fmod_float(value f1, value f2) /* ML */
{
return copy_double(fmod(Double_val(f1), Double_val(f2)));
}
value frexp_float(f) /* ML */
value f;
value frexp_float(value f) /* ML */
{
int exponent;
value res;
@ -192,26 +174,22 @@ value frexp_float(f) /* ML */
return res;
}
value ldexp_float(f, i) /* ML */
value f, i;
value ldexp_float(value f, value i) /* ML */
{
return copy_double(ldexp(Double_val(f), Int_val(i)));
}
value log_float(f) /* ML */
value f;
value log_float(value f) /* ML */
{
return copy_double(log(Double_val(f)));
}
value log10_float(f) /* ML */
value f;
value log10_float(value f) /* ML */
{
return copy_double(log10(Double_val(f)));
}
value modf_float(f) /* ML */
value f;
value modf_float(value f) /* ML */
{
#if macintosh
_float_eval frem;
@ -231,116 +209,97 @@ value modf_float(f) /* ML */
return res;
}
value sqrt_float(f) /* ML */
value f;
value sqrt_float(value f) /* ML */
{
return copy_double(sqrt(Double_val(f)));
}
value power_float(f, g) /* ML */
value f, g;
value power_float(value f, value g) /* ML */
{
return copy_double(pow(Double_val(f), Double_val(g)));
}
value sin_float(f) /* ML */
value f;
value sin_float(value f) /* ML */
{
return copy_double(sin(Double_val(f)));
}
value sinh_float(f) /* ML */
value f;
value sinh_float(value f) /* ML */
{
return copy_double(sinh(Double_val(f)));
}
value cos_float(f) /* ML */
value f;
value cos_float(value f) /* ML */
{
return copy_double(cos(Double_val(f)));
}
value cosh_float(f) /* ML */
value f;
value cosh_float(value f) /* ML */
{
return copy_double(cosh(Double_val(f)));
}
value tan_float(f) /* ML */
value f;
value tan_float(value f) /* ML */
{
return copy_double(tan(Double_val(f)));
}
value tanh_float(f) /* ML */
value f;
value tanh_float(value f) /* ML */
{
return copy_double(tanh(Double_val(f)));
}
value asin_float(f) /* ML */
value f;
value asin_float(value f) /* ML */
{
return copy_double(asin(Double_val(f)));
}
value acos_float(f) /* ML */
value f;
value acos_float(value f) /* ML */
{
return copy_double(acos(Double_val(f)));
}
value atan_float(f) /* ML */
value f;
value atan_float(value f) /* ML */
{
return copy_double(atan(Double_val(f)));
}
value atan2_float(f, g) /* ML */
value f, g;
value atan2_float(value f, value g) /* ML */
{
return copy_double(atan2(Double_val(f), Double_val(g)));
}
value ceil_float(f) /* ML */
value f;
value ceil_float(value f) /* ML */
{
return copy_double(ceil(Double_val(f)));
}
value eq_float(f, g) /* ML */
value f, g;
value eq_float(value f, value g) /* ML */
{
return Val_bool(Double_val(f) == Double_val(g));
}
value neq_float(f, g) /* ML */
value f, g;
value neq_float(value f, value g) /* ML */
{
return Val_bool(Double_val(f) != Double_val(g));
}
value le_float(f, g) /* ML */
value f, g;
value le_float(value f, value g) /* ML */
{
return Val_bool(Double_val(f) <= Double_val(g));
}
value lt_float(f, g) /* ML */
value f, g;
value lt_float(value f, value g) /* ML */
{
return Val_bool(Double_val(f) < Double_val(g));
}
value ge_float(f, g) /* ML */
value f, g;
value ge_float(value f, value g) /* ML */
{
return Val_bool(Double_val(f) >= Double_val(g));
}
value gt_float(f, g) /* ML */
value f, g;
value gt_float(value f, value g) /* ML */
{
return Val_bool(Double_val(f) > Double_val(g));
}
@ -360,7 +319,7 @@ value gt_float(f, g) /* ML */
#endif
#endif
void init_ieee_floats()
void init_ieee_floats(void)
{
#ifdef __i386__
#ifdef __linux__

19
byterun/freelist.c
View File

@ -49,7 +49,7 @@ asize_t fl_cur_size = 0; /* How many free words were added since
#define Next(b) (((block *) (b))->next_bp)
#ifdef DEBUG
void fl_check ()
void fl_check (void)
{
char *cur, *prev;
int prev_found = 0, merge_found = 0;
@ -82,9 +82,7 @@ void fl_check ()
it is located in the high-address words of the free block. This way,
the linking of the free-list does not change in case 2.
*/
static char *allocate_block (wh_sz, prev, cur)
mlsize_t wh_sz;
char *prev, *cur;
static char *allocate_block (mlsize_t wh_sz, char *prev, char *cur)
{
header_t h = Hd_bp (cur);
Assert (Whsize_hd (h) >= wh_sz);
@ -110,8 +108,7 @@ static char *allocate_block (wh_sz, prev, cur)
The calling function must do it before any GC function gets called.
[fl_allocate] returns a head pointer.
*/
char *fl_allocate (wo_sz)
mlsize_t wo_sz;
char *fl_allocate (mlsize_t wo_sz)
{
char *cur, *prev;
Assert (sizeof (char *) == sizeof (value));
@ -144,7 +141,7 @@ char *fl_allocate (wo_sz)
static char *last_fragment;
void fl_init_merge ()
void fl_init_merge (void)
{
last_fragment = NULL;
fl_merge = Fl_head;
@ -155,7 +152,7 @@ void fl_init_merge ()
}
/* This is called by compact_heap. */
void fl_reset ()
void fl_reset (void)
{
Next (Fl_head) = 0;
fl_prev = Fl_head;
@ -164,8 +161,7 @@ void fl_reset ()
/* [fl_merge_block] returns the head pointer of the next block after [bp],
because merging blocks may change the size of [bp]. */
char *fl_merge_block (bp)
char *bp;
char *fl_merge_block (char *bp)
{
char *prev, *cur, *adj;
header_t hd = Hd_bp (bp);
@ -242,8 +238,7 @@ char *fl_merge_block (bp)
Most of the heap extensions are expected to be at the end of the
free list. (This depends on the implementation of [malloc].)
*/
void fl_add_block (bp)
char *bp;
void fl_add_block (char *bp)
{
Assert (fl_last != NULL);
Assert (Next (fl_last) == NULL);

10
byterun/freelist.h
View File

@ -22,11 +22,11 @@
extern asize_t fl_cur_size;
char *fl_allocate P((mlsize_t));
void fl_init_merge P((void));
void fl_reset P((void));
char *fl_merge_block P((char *));
void fl_add_block P((char *));
char *fl_allocate (mlsize_t);
void fl_init_merge (void);
void fl_reset (void);
char *fl_merge_block (char *);
void fl_add_block (char *);
#endif /* _freelist_ */

37
byterun/gc_ctrl.c
View File

@ -37,8 +37,7 @@ extern unsigned long percent_max; /* cf. compact.c */
/* This will also thoroughly verify the heap if compiled in DEBUG mode. */
value gc_stat(v) /* ML */
value v;
value gc_stat(value v) /* ML */
{
value res;
long live_words = 0, live_blocks = 0,
@ -121,8 +120,7 @@ value gc_stat(v) /* ML */
return res;
}
value gc_get(v) /* ML */
value v;
value gc_get(value v) /* ML */
{
value res;
@ -137,20 +135,17 @@ value gc_get(v) /* ML */
#define Max(x,y) ((x) < (y) ? (y) : (x))
static unsigned long norm_pfree (p)
unsigned long p;
static unsigned long norm_pfree (long unsigned int p)
{
return Max (p, 1);
}
static unsigned long norm_pmax (p)
unsigned long p;
static unsigned long norm_pmax (long unsigned int p)
{
return p;
}
static long norm_heapincr (i)
unsigned long i;
static long norm_heapincr (long unsigned int i)
{
#define Psv (Wsize_bsize (Page_size))
i = ((i + Psv - 1) / Psv) * Psv;
@ -159,16 +154,14 @@ static long norm_heapincr (i)
return i;
}
static long norm_minsize (s)
long s;
static long norm_minsize (long int s)
{
if (s < Minor_heap_min) s = Minor_heap_min;
if (s > Minor_heap_max) s = Minor_heap_max;
return s;
}
value gc_set(v) /* ML */
value v;
value gc_set(value v) /* ML */
{
unsigned long newpf, newpm;
asize_t newheapincr;
@ -209,23 +202,20 @@ value gc_set(v) /* ML */
return Val_unit;
}
value gc_minor(v) /* ML */
value v;
value gc_minor(value v) /* ML */
{ Assert (v == Val_unit);
minor_collection ();
return Val_unit;
}
value gc_major(v) /* ML */
value v;
value gc_major(value v) /* ML */
{ Assert (v == Val_unit);
minor_collection ();
finish_major_cycle ();
return Val_unit;
}
value gc_full_major(v) /* ML */
value v;
value gc_full_major(value v) /* ML */
{ Assert (v == Val_unit);
minor_collection ();
finish_major_cycle ();
@ -233,8 +223,7 @@ value gc_full_major(v) /* ML */
return Val_unit;
}
value gc_compaction(v) /* ML */
value v;
value gc_compaction(value v) /* ML */
{ Assert (v == Val_unit);
minor_collection ();
finish_major_cycle ();
@ -243,9 +232,7 @@ value gc_compaction(v) /* ML */
return Val_unit;
}
void init_gc (minor_size, major_size, major_incr, percent_fr, percent_m, verb)
unsigned long minor_size, major_size, major_incr;
unsigned long percent_fr, percent_m, verb;
void init_gc (long unsigned int minor_size, long unsigned int major_size, long unsigned int major_incr, long unsigned int percent_fr, long unsigned int percent_m, long unsigned int verb)
{
unsigned long major_heap_size = Bsize_wsize (norm_heapincr (major_size));
#ifdef DEBUG

4
byterun/gc_ctrl.h
View File

@ -25,8 +25,8 @@ extern long
stat_heap_size,
stat_compactions;
void init_gc P((unsigned long, unsigned long, unsigned long,
unsigned long, unsigned long, unsigned long));
void init_gc (unsigned long, unsigned long, unsigned long,
unsigned long, unsigned long, unsigned long);
#endif /* _gc_ctrl_ */

8
byterun/hash.c
View File

@ -20,10 +20,9 @@
static unsigned long hash_accu;
static long hash_univ_limit, hash_univ_count;
static void hash_aux();
static void hash_aux(value obj);
value hash_univ_param(count, limit, obj) /* ML */
value obj, count, limit;
value hash_univ_param(value count, value limit, value obj) /* ML */
{
hash_univ_limit = Long_val(limit);
hash_univ_count = Long_val(count);
@ -39,8 +38,7 @@ value hash_univ_param(count, limit, obj) /* ML */
#define Combine(new) (hash_accu = hash_accu * Alpha + (new))
#define Combine_small(new) (hash_accu = hash_accu * Beta + (new))
static void hash_aux(obj)
value obj;
static void hash_aux(value obj)
{
unsigned char * p;
mlsize_t i, j;

4
byterun/instrtrace.h
View File

@ -22,8 +22,8 @@
extern int trace_flag;
extern long icount;
void stop_here P((void));
void disasm_instr P((code_t pc));
void stop_here (void);
void disasm_instr (code_t pc);
#endif

28
byterun/intern.c
View File

@ -54,7 +54,7 @@ static value intern_block;
(intern_src[-2] << 8) + intern_src[-1])
#ifdef ARCH_SIXTYFOUR
static long read64s()
static long read64s(void)
{
long res;
int i;
@ -68,15 +68,14 @@ static long read64s()
#define readblock(dest,len) \
(bcopy(intern_src, dest, len), intern_src += len)
static void intern_cleanup()
static void intern_cleanup(void)
{
if (intern_input_malloced) stat_free((char *) intern_input);
if (intern_obj_table != NULL) stat_free((char *) intern_obj_table);
Hd_val(intern_block) = intern_header; /* Don't confuse the GC */
}
static void intern_rec(dest)
value * dest;
static void intern_rec(value *dest)
{
unsigned int code;
tag_t tag;
@ -233,8 +232,7 @@ static void intern_rec(dest)
*dest = v;
}
static void intern_alloc(whsize, num_objects)
mlsize_t whsize, num_objects;
static void intern_alloc(mlsize_t whsize, mlsize_t num_objects)
{
mlsize_t wosize;
@ -260,8 +258,7 @@ static void intern_alloc(whsize, num_objects)
}
}
value input_val(chan)
struct channel * chan;
value input_val(struct channel *chan)
{
uint32 magic;
mlsize_t block_len, num_objects, size_32, size_64, whsize;
@ -296,8 +293,7 @@ value input_val(chan)
return res;
}
value input_value(vchan) /* ML */
value vchan;
value input_value(value vchan) /* ML */
{
struct channel * chan = Channel(vchan);
value res;
@ -308,9 +304,7 @@ value input_value(vchan) /* ML */
return res;
}
value input_val_from_string(str, ofs)
value str;
long ofs;
value input_val_from_string(value str, long int ofs)
{
mlsize_t num_objects, size_32, size_64, whsize;
value obj;
@ -337,14 +331,12 @@ value input_val_from_string(str, ofs)
return obj;
}
value input_value_from_string(str, ofs) /* ML */
value str, ofs;
value input_value_from_string(value str, value ofs) /* ML */
{
return input_val_from_string(str, Long_val(ofs));
}
value marshal_data_size(buff, ofs) /* ML */
value buff, ofs;
value marshal_data_size(value buff, value ofs) /* ML */
{
uint32 magic;
mlsize_t block_len;
@ -384,7 +376,7 @@ unsigned char * code_checksum()
#include "fix_code.h"
unsigned char * code_checksum()
unsigned char * code_checksum(void)
{
return code_md5;
}

4
byterun/interp.c
View File

@ -138,9 +138,7 @@ sp is a local copy of the global variable extern_sp. */
/* The interpreter itself */
value interprete(prog, prog_size)
code_t prog;
asize_t prog_size;
value interprete(code_t prog, asize_t prog_size)
{
#ifdef PC_REG
register code_t pc PC_REG;

2
byterun/interp.h
View File

@ -20,7 +20,7 @@
#include "misc.h"
#include "mlvalues.h"
value interprete P((code_t prog, asize_t prog_size));
value interprete (code_t prog, asize_t prog_size);
#endif

8
byterun/intext.h
View File

@ -79,12 +79,12 @@
/* The entry points */
void output_val P((struct channel * chan, value v, value flags));
value input_val P((struct channel * chan));
value input_val_from_string P((value str, long ofs));
void output_val (struct channel * chan, value v, value flags);
value input_val (struct channel * chan);
value input_val_from_string (value str, long ofs);
/* Auxiliary stuff for sending code pointers */
unsigned char * code_checksum P((void));
unsigned char * code_checksum (void);
#ifndef NATIVE_CODE
#include "fix_code.h"

6
byterun/ints.c
View File

@ -20,8 +20,7 @@
#include "mlvalues.h"
#include "str.h"
value int_of_string(s) /* ML */
value s;
value int_of_string(value s) /* ML */
{
long res;
int sign;
@ -67,8 +66,7 @@ value int_of_string(s) /* ML */
return Val_long(sign < 0 ? -res : res);
}
value format_int(fmt, arg) /* ML */
value fmt, arg;
value format_int(value fmt, value arg) /* ML */
{
char format_string[32], format_buffer[32];
int prec;

140
byterun/io.c
View File

@ -47,17 +47,16 @@
/* Hooks for locking channels */
void (*channel_mutex_free) P((struct channel *)) = NULL;
void (*channel_mutex_lock) P((struct channel *)) = NULL;
void (*channel_mutex_unlock) P((struct channel *)) = NULL;
void (*channel_mutex_unlock_exn) P((void)) = NULL;
void (*channel_mutex_free) (struct channel *) = NULL;
void (*channel_mutex_lock) (struct channel *) = NULL;
void (*channel_mutex_unlock) (struct channel *) = NULL;
void (*channel_mutex_unlock_exn) (void) = NULL;
/* Basic functions over type struct channel *.
These functions can be called directly from C.
No locking is performed. */
struct channel * open_descriptor(fd)
int fd;
struct channel * open_descriptor(int fd)
{
struct channel * channel;
@ -70,16 +69,14 @@ struct channel * open_descriptor(fd)
return channel;
}
void close_channel(channel)
struct channel * channel;
void close_channel(struct channel *channel)
{
close(channel->fd);
if (channel_mutex_free != NULL) (*channel_mutex_free)(channel);
stat_free((char *) channel);
}
long channel_size(channel)
struct channel * channel;
long channel_size(struct channel *channel)
{
long end;
@ -103,10 +100,7 @@ long channel_size(channel)
#define EWOULDBLOCK (-1)
#endif
static int do_write(fd, p, n)
int fd;
char * p;
int n;
static int do_write(int fd, char *p, int n)
{
int retcode;
@ -139,8 +133,7 @@ again:
at least one character. Returns true if the buffer is empty at the
end of the flush, or false if some data remains in the buffer. */
int flush_partial(channel)
struct channel * channel;
int flush_partial(struct channel *channel)
{
int towrite, written;
@ -159,17 +152,14 @@ int flush_partial(channel)
/* Flush completely the buffer. */
void flush(channel)
struct channel * channel;
void flush(struct channel *channel)
{
while (! flush_partial(channel)) /*nothing*/;
}
/* Output data */
void putword(channel, w)
struct channel * channel;
uint32 w;
void putword(struct channel *channel, uint32 w)
{
putch(channel, w >> 24);
putch(channel, w >> 16);
@ -177,10 +167,7 @@ void putword(channel, w)
putch(channel, w);
}
int putblock(channel, p, len)
struct channel * channel;
char * p;
long len;
int putblock(struct channel *channel, char *p, long int len)
{
int n, free, towrite, written;
@ -206,10 +193,7 @@ int putblock(channel, p, len)
}
}
void really_putblock(channel, p, len)
struct channel * channel;
char * p;
long len;
void really_putblock(struct channel *channel, char *p, long int len)
{
int written;
while (len > 0) {
@ -219,27 +203,21 @@ void really_putblock(channel, p, len)
}
}
void seek_out(channel, dest)
struct channel * channel;
long dest;
void seek_out(struct channel *channel, long int dest)
{
flush(channel);
if (lseek(channel->fd, dest, 0) != dest) sys_error(NO_ARG);
channel->offset = dest;
}
long pos_out(channel)
struct channel * channel;
long pos_out(struct channel *channel)
{
return channel->offset + channel->curr - channel->buff;
}
/* Input */
static int do_read(fd, p, n)
int fd;
char * p;
unsigned n;
static int do_read(int fd, char *p, unsigned int n)
{
int retcode;
@ -259,8 +237,7 @@ static int do_read(fd, p, n)
return retcode;
}
unsigned char refill(channel)
struct channel * channel;
unsigned char refill(struct channel *channel)
{
int n;
@ -272,8 +249,7 @@ unsigned char refill(channel)
return (unsigned char)(channel->buff[0]);
}
uint32 getword(channel)
struct channel * channel;
uint32 getword(struct channel *channel)
{
int i;
uint32 res;
@ -285,10 +261,7 @@ uint32 getword(channel)
return res;
}
int getblock(channel, p, len)
struct channel * channel;
char * p;
long len;
int getblock(struct channel *channel, char *p, long int len)
{
int n, avail, nread;
@ -317,10 +290,7 @@ int getblock(channel, p, len)
}
}
int really_getblock(chan, p, n)
struct channel * chan;
char * p;
long n;
int really_getblock(struct channel *chan, char *p, long int n)
{
int r;
while (n > 0) {
@ -332,9 +302,7 @@ int really_getblock(chan, p, n)
return (n == 0);
}
void seek_in(channel, dest)
struct channel * channel;
long dest;
void seek_in(struct channel *channel, long int dest)
{
if (dest >= channel->offset - (channel->max - channel->buff) &&
dest <= channel->offset) {
@ -346,14 +314,12 @@ void seek_in(channel, dest)
}
}
long pos_in(channel)
struct channel * channel;
long pos_in(struct channel *channel)
{
return channel->offset - (channel->max - channel->curr);
}
long input_scan_line(channel)
struct channel * channel;
long input_scan_line(struct channel *channel)
{
char * p;
int n;
@ -397,36 +363,31 @@ long input_scan_line(channel)
objects into a heap-allocated, finalized object. Perform locking
and unlocking around the I/O operations. */
static void finalize_channel(vchan)
value vchan;
static void finalize_channel(value vchan)
{
struct channel * chan = Channel(vchan);
if (channel_mutex_free != NULL) (*channel_mutex_free)(chan);
stat_free((char *) chan);
}
static value alloc_channel(chan)
struct channel * chan;
static value alloc_channel(struct channel *chan)
{
value res = alloc_final(2, finalize_channel, 1, 32);
Field(res, 1) = (value) chan;
return res;
}
value caml_open_descriptor(fd) /* ML */
value fd;
value caml_open_descriptor(value fd) /* ML */
{
return alloc_channel(open_descriptor(Int_val(fd)));
}
value channel_descriptor(vchannel) /* ML */
value vchannel;
value channel_descriptor(value vchannel) /* ML */
{
return Val_long(Channel(vchannel)->fd);
}
value caml_close_channel(vchannel) /* ML */
value vchannel;
value caml_close_channel(value vchannel) /* ML */
{
/* For output channels, must have flushed before */
struct channel * channel = Channel(vchannel);
@ -435,27 +396,23 @@ value caml_close_channel(vchannel) /* ML */
return Val_unit;
}
value caml_channel_size(vchannel) /* ML */
value vchannel;
value caml_channel_size(value vchannel) /* ML */
{
return Val_long(channel_size(Channel(vchannel)));
}
value caml_flush_partial(vchannel) /* ML */
value vchannel;
value caml_flush_partial(value vchannel) /* ML */
{
return Val_bool(flush_partial(Channel(vchannel)));
}
value caml_flush(vchannel) /* ML */
value vchannel;
value caml_flush(value vchannel) /* ML */
{
flush(Channel(vchannel));
return Val_unit;
}
value caml_output_char(vchannel, ch) /* ML */
value vchannel, ch;
value caml_output_char(value vchannel, value ch) /* ML */
{
struct channel * channel = Channel(vchannel);
Lock(channel);
@ -464,8 +421,7 @@ value caml_output_char(vchannel, ch) /* ML */
return Val_unit;
}
value caml_output_int(vchannel, w) /* ML */
value vchannel, w;
value caml_output_int(value vchannel, value w) /* ML */
{
struct channel * channel = Channel(vchannel);
Lock(channel);
@ -474,8 +430,7 @@ value caml_output_int(vchannel, w) /* ML */
return Val_unit;
}
value caml_output_partial(vchannel, buff, start, length) /* ML */
value vchannel, buff, start, length;
value caml_output_partial(value vchannel, value buff, value start, value length) /* ML */
{
struct channel * channel = Channel(vchannel);
int res;
@ -485,8 +440,7 @@ value caml_output_partial(vchannel, buff, start, length) /* ML */
return Val_int(res);
}
value caml_output(vchannel, buff, start, length) /* ML */
value vchannel, buff, start, length;
value caml_output(value vchannel, value buff, value start, value length) /* ML */
{
struct channel * channel = Channel(vchannel);
long pos = Long_val(start);
@ -504,8 +458,7 @@ value caml_output(vchannel, buff, start, length) /* ML */
return Val_unit;
}
value caml_seek_out(vchannel, pos) /* ML */
value vchannel, pos;
value caml_seek_out(value vchannel, value pos) /* ML */
{
struct channel * channel = Channel(vchannel);
Lock(channel);
@ -514,14 +467,12 @@ value caml_seek_out(vchannel, pos) /* ML */
return Val_unit;
}
value caml_pos_out(vchannel) /* ML */
value vchannel;
value caml_pos_out(value vchannel) /* ML */
{
return Val_long(pos_out(Channel(vchannel)));
}
value caml_input_char(vchannel) /* ML */
value vchannel;
value caml_input_char(value vchannel) /* ML */
{
struct channel * channel = Channel(vchannel);
unsigned char c;
@ -532,8 +483,7 @@ value caml_input_char(vchannel) /* ML */
return Val_long(c);
}
value caml_input_int(vchannel) /* ML */
value vchannel;
value caml_input_int(value vchannel) /* ML */
{
struct channel * channel = Channel(vchannel);
long i;
@ -547,8 +497,7 @@ value caml_input_int(vchannel) /* ML */
return Val_long(i);
}
value caml_input(vchannel, buff, start, length) /* ML */
value vchannel, buff, start, length;
value caml_input(value vchannel, value buff, value start, value length) /* ML */
{
struct channel * channel = Channel(vchannel);
long res;
@ -559,8 +508,7 @@ value caml_input(vchannel, buff, start, length) /* ML */
return Val_long(res);
}
value caml_seek_in(vchannel, pos) /* ML */
value vchannel, pos;
value caml_seek_in(value vchannel, value pos) /* ML */
{
struct channel * channel = Channel(vchannel);
Lock(channel);
@ -569,14 +517,12 @@ value caml_seek_in(vchannel, pos) /* ML */
return Val_unit;
}
value caml_pos_in(vchannel) /* ML */
value vchannel;
value caml_pos_in(value vchannel) /* ML */
{
return Val_long(pos_in(Channel(vchannel)));
}
value caml_input_scan_line(vchannel) /* ML */
value vchannel;
value caml_input_scan_line(value vchannel) /* ML */
{
struct channel * channel = Channel(vchannel);
long res;

30
byterun/io.h
View File

@ -52,19 +52,19 @@ struct channel {
? refill(channel) \
: (unsigned char) *((channel))->curr++)
struct channel * open_descriptor P((int));
void close_channel P((struct channel *));
struct channel * open_descriptor (int);
void close_channel (struct channel *);
int flush_partial P((struct channel *));
void flush P((struct channel *));
void putword P((struct channel *, uint32));
int putblock P((struct channel *, char *, long));
void really_putblock P((struct channel *, char *, long));
int flush_partial (struct channel *);
void flush (struct channel *);
void putword (struct channel *, uint32);
int putblock (struct channel *, char *, long);
void really_putblock (struct channel *, char *, long);
unsigned char refill P((struct channel *));
uint32 getword P((struct channel *));
int getblock P((struct channel *, char *, long));
int really_getblock P((struct channel *, char *, long));
unsigned char refill (struct channel *);
uint32 getword (struct channel *);
int getblock (struct channel *, char *, long);
int really_getblock (struct channel *, char *, long);
/* Extract a struct channel * from the heap object representing it */
@ -72,10 +72,10 @@ int really_getblock P((struct channel *, char *, long));
/* The locking machinery */
extern void (*channel_mutex_free) P((struct channel *));
extern void (*channel_mutex_lock) P((struct channel *));
extern void (*channel_mutex_unlock) P((struct channel *));
extern void (*channel_mutex_unlock_exn) P((void));
extern void (*channel_mutex_free) (struct channel *);
extern void (*channel_mutex_lock) (struct channel *);
extern void (*channel_mutex_unlock) (struct channel *);
extern void (*channel_mutex_unlock_exn) (void);
#define Lock(channel) \
if (channel_mutex_lock != NULL) (*channel_mutex_lock)(channel)

5
byterun/lexing.c
View File

@ -46,10 +46,7 @@ struct lexing_table {
#define Short(tbl,n) (((short *)(tbl))[n])
#endif
value lex_engine(tbl, start_state, lexbuf) /* ML */
struct lexing_table * tbl;
value start_state;
struct lexer_buffer * lexbuf;
value lex_engine(struct lexing_table *tbl, value start_state, struct lexer_buffer *lexbuf) /* ML */
{
int state, base, backtrk, c;

8
byterun/main.c
View File

@ -18,10 +18,10 @@
#include "mlvalues.h"
#include "sys.h"
extern void caml_main P((char **));
extern void caml_main (char **);
#ifdef _WIN32
extern void expand_command_line P((int *, char ***));
extern void expand_command_line (int *, char ***);
#endif
#if macintosh
@ -30,9 +30,7 @@ extern void expand_command_line P((int *, char ***));
int volatile have_to_interact = 0;
#endif
int main(argc, argv)
int argc;
char ** argv;
int main(int argc, char **argv)
{
#ifdef _WIN32
expand_command_line(&argc, &argv);

30
byterun/major_gc.c
View File

@ -51,9 +51,9 @@ extern char *fl_merge; /* Defined in freelist.c. */
static char *markhp, *chunk, *limit;
static void update_weak_pointers ();
static void update_weak_pointers (void);
static void realloc_gray_vals ()
static void realloc_gray_vals (void)
{
value *new;
@ -79,9 +79,9 @@ static void realloc_gray_vals ()
}
}
void darken (v, p)
value v;
value *p; /* not used */
void darken (value v, value *p)
/* not used */
{
if (Is_block (v) && Is_in_heap (v)) {
if (Tag_val(v) == Infix_tag) v -= Infix_offset_val(v);
@ -93,7 +93,7 @@ void darken (v, p)
}
}
static void start_cycle ()
static void start_cycle (void)
{
Assert (gc_phase == Phase_idle);
Assert (gray_vals_cur == gray_vals);
@ -102,8 +102,7 @@ static void start_cycle ()
markhp = NULL;
}
static void mark_slice (work)
long work;
static void mark_slice (long int work)
{
value *gray_vals_ptr; /* Local copy of gray_vals_cur */
value v, child;
@ -184,7 +183,7 @@ static void mark_slice (work)
Arrays that are white are removed from this list.
For the other arrays, pointers to white objects are erased.
*/
static void update_weak_pointers ()
static void update_weak_pointers (void)
{
value *prev = &weak_list_head;
value *cur = (value *) *prev;
@ -210,8 +209,7 @@ static void update_weak_pointers ()
}
}
static void sweep_slice (work)
long work;
static void sweep_slice (long int work)
{
char *hp;
header_t hd;
@ -255,7 +253,7 @@ static void sweep_slice (work)
}
/* The main entry point for the GC. Called at each minor GC. */
void major_collection_slice ()
void major_collection_slice (void)
{
/*
Free memory at the start of the GC cycle (garbage + free list) (assumed):
@ -312,7 +310,7 @@ void major_collection_slice ()
free and live memory are only valid for a cycle done incrementally.
Besides, this function is called by compact_heap_maybe.
*/
void finish_major_cycle ()
void finish_major_cycle (void)
{
if (gc_phase == Phase_idle) start_cycle ();
if (gc_phase == Phase_mark) mark_slice (LONG_MAX);
@ -323,8 +321,7 @@ void finish_major_cycle ()
allocated_words = 0;
}
asize_t round_heap_chunk_size (request)
asize_t request;
asize_t round_heap_chunk_size (asize_t request)
{ Assert (major_heap_increment >= Heap_chunk_min);
if (request < major_heap_increment){
Assert (major_heap_increment % Page_size == 0);
@ -337,8 +334,7 @@ asize_t round_heap_chunk_size (request)
}
}
void init_major_heap (heap_size)
asize_t heap_size;
void init_major_heap (asize_t heap_size)
{
asize_t i;
void *block;

12
byterun/major_gc.h
View File

@ -58,12 +58,12 @@ extern char *gc_sweep_hp;
((addr)(p) >= (addr)heap_start && (addr)(p) < (addr)heap_end \
&& page_table [Page (p)])
void init_major_heap P((asize_t));
asize_t round_heap_chunk_size P((asize_t));
void darken P((value, value *));
void major_collection_slice P((void));
void major_collection P((void));
void finish_major_cycle P((void));
void init_major_heap (asize_t);
asize_t round_heap_chunk_size (asize_t);
void darken (value, value *);
void major_collection_slice (void);
void major_collection (void);
void finish_major_cycle (void);
#endif /* _major_gc_ */

26
byterun/md5.c
View File

@ -21,8 +21,7 @@
/* MD5 message digest */
value md5_string(str, ofs, len) /* ML */
value str, ofs, len;
value md5_string(value str, value ofs, value len) /* ML */
{
struct MD5Context ctx;
value res;
@ -33,8 +32,7 @@ value md5_string(str, ofs, len) /* ML */
return res;
}
value md5_chan(vchan, len) /* ML */
value vchan, len;
value md5_chan(value vchan, value len) /* ML */
{
struct channel * chan = Channel(vchan);
struct MD5Context ctx;
@ -78,9 +76,7 @@ value md5_chan(vchan, len) /* ML */
#ifndef ARCH_BIG_ENDIAN
#define byteReverse(buf, len) /* Nothing */
#else
static void byteReverse(buf, longs)
unsigned char *buf;
unsigned longs;
static void byteReverse(unsigned char * buf, unsigned longs)
{
uint32 t;
do {
@ -96,8 +92,7 @@ static void byteReverse(buf, longs)
* Start MD5 accumulation. Set bit count to 0 and buffer to mysterious
* initialization constants.
*/
void MD5Init(ctx)
struct MD5Context *ctx;
void MD5Init(struct MD5Context *ctx)
{
ctx->buf[0] = 0x67452301;
ctx->buf[1] = 0xefcdab89;
@ -112,10 +107,7 @@ void MD5Init(ctx)
* Update context to reflect the concatenation of another buffer full
* of bytes.
*/
void MD5Update(ctx, buf, len)
struct MD5Context *ctx;
unsigned char *buf;
unsigned len;
void MD5Update(struct MD5Context *ctx, unsigned char *buf, unsigned int len)
{
uint32 t;
@ -163,9 +155,7 @@ void MD5Update(ctx, buf, len)
* Final wrapup - pad to 64-byte boundary with the bit pattern
* 1 0* (64-bit count of bits processed, MSB-first)
*/
void MD5Final(digest, ctx)
unsigned char digest[16];
struct MD5Context *ctx;
void MD5Final(unsigned char *digest, struct MD5Context *ctx)
{
unsigned count;
unsigned char *p;
@ -223,9 +213,7 @@ void MD5Final(digest, ctx)
* reflect the addition of 16 longwords of new data. MD5Update blocks
* the data and converts bytes into longwords for this routine.
*/
void MD5Transform(buf, in)
uint32 buf[4];
uint32 in[16];
void MD5Transform(uint32 *buf, uint32 *in)
{
register uint32 a, b, c, d;

13
byterun/md5.h
View File

@ -7,8 +7,8 @@
#include "mlvalues.h"
#include "io.h"
value md5_string P((value str, value ofs, value len));
value md5_chan P((value vchan, value len));
value md5_string (value str, value ofs, value len);
value md5_chan (value vchan, value len);
struct MD5Context {
uint32 buf[4];
@ -16,11 +16,10 @@ struct MD5Context {
unsigned char in[64];
};
void MD5Init P((struct MD5Context *context));
void MD5Update P((struct MD5Context *context, unsigned char *buf,
unsigned len));
void MD5Final P((unsigned char digest[16], struct MD5Context *ctx));
void MD5Transform P((uint32 buf[4], uint32 in[16]));
void MD5Init (struct MD5Context *context);
void MD5Update (struct MD5Context *context, unsigned char *buf, unsigned len);
void MD5Final (unsigned char digest[16], struct MD5Context *ctx);
void MD5Transform (uint32 buf[4], uint32 in[16]);
#endif

31
byterun/memory.c
View File

@ -30,8 +30,7 @@
Faudrait nettoyer tout ca pour decoupler heap_start de heap_base
et pour simplifier l'agrandissement de page_table.
*/
static char *expand_heap (request)
mlsize_t request;
static char *expand_heap (mlsize_t request)
{
char *mem;
page_table_entry *new_page_table;
@ -125,8 +124,7 @@ static char *expand_heap (request)
/* Remove the heap chunk [chunk] from the heap and give the memory back
to [malloc].
*/
void shrink_heap (chunk)
char *chunk;
void shrink_heap (char *chunk)
{
char **cp;
int i;
@ -165,9 +163,7 @@ void shrink_heap (chunk)
free (Chunk_block (chunk));
}
value alloc_shr (wosize, tag)
mlsize_t wosize;
tag_t tag;
value alloc_shr (mlsize_t wosize, tag_t tag)
{
char *hp, *new_block;
@ -207,8 +203,7 @@ value alloc_shr (wosize, tag)
(or kilobytes, ...) instead of words. You can change units between
calls to [adjust_collector_speed].
*/
void adjust_gc_speed (mem, max)
mlsize_t mem, max;
void adjust_gc_speed (mlsize_t mem, mlsize_t max)
{
if (max == 0) max = 1;
if (mem > max) mem = max;
@ -227,9 +222,7 @@ void adjust_gc_speed (mem, max)
*/
/* [initialize] never calls the GC, so you may call it while an object is
unfinished (i.e. just after a call to [alloc_shr].) */
void initialize (fp, val)
value *fp;
value val;
void initialize (value *fp, value val)
{
*fp = val;
Assert (Is_in_heap (fp));
@ -245,15 +238,12 @@ void initialize (fp, val)
unless you are sure the value being overwritten is not a shared block and
the value being written is not a young block. */
/* [modify] never calls the GC. */
void modify (fp, val)
value *fp;
value val;
void modify (value *fp, value val)
{
Modify (fp, val);
}
char *stat_alloc (sz)
asize_t sz;
char *stat_alloc (asize_t sz)
{
char *result = (char *) malloc (sz);
@ -261,15 +251,12 @@ char *stat_alloc (sz)
return result;
}
void stat_free (blk)
char * blk;
void stat_free (char *blk)
{
free (blk);
}
char *stat_resize (blk, sz)
char *blk;
asize_t sz;
char *stat_resize (char *blk, asize_t sz)
{
char *result = (char *) realloc (blk, sz);

22
byterun/memory.h
View File

@ -24,16 +24,16 @@
#include "misc.h"
#include "mlvalues.h"
value alloc_shr P((mlsize_t, tag_t));
void adjust_gc_speed P((mlsize_t, mlsize_t));
void modify P((value *, value));
void initialize P((value *, value));
value check_urgent_gc P((value));
char * stat_alloc P((asize_t)); /* Size in bytes. */
void stat_free P((char *));
char * stat_resize P((char *, asize_t)); /* Size in bytes. */
value alloc_shr (mlsize_t, tag_t);
void adjust_gc_speed (mlsize_t, mlsize_t);
void modify (value *, value);
void initialize (value *, value);
value check_urgent_gc (value);
char * stat_alloc (asize_t); /* Size in bytes. */
void stat_free (char *);
char * stat_resize (char *, asize_t); /* Size in bytes. */
/* void shrink_heap P((char *)); Only used in compact.c */
/* void shrink_heap (char *); Only used in compact.c */
#ifdef NATIVE_CODE
#define Garbage_collection_function garbage_collection
@ -197,12 +197,12 @@ extern struct caml__roots_block *local_roots; /* defined in roots.h */
for the duration of the program, or until [remove_global_root] is
called. */
void register_global_root P((value *));
void register_global_root (value *);
/* [remove_global_root] removes a memory root registered on a global C
variable with [register_global_root]. */
void remove_global_root P((value *));
void remove_global_root (value *);
#endif /* _memory_ */

13
byterun/meta.c
View File

@ -25,14 +25,12 @@
#include "prims.h"
#include "stacks.h"
value get_global_data(unit) /* ML */
value unit;
value get_global_data(value unit) /* ML */
{
return global_data;
}
value reify_bytecode(prog, len) /* ML */
value prog, len;
value reify_bytecode(value prog, value len) /* ML */
{
value clos;
#ifdef ARCH_BIG_ENDIAN
@ -46,8 +44,7 @@ value reify_bytecode(prog, len) /* ML */
return clos;
}
value realloc_global(size) /* ML */
value size;
value realloc_global(value size) /* ML */
{
mlsize_t requested_size, actual_size, i;
value new_global_data;
@ -68,12 +65,12 @@ value realloc_global(size) /* ML */
return Val_unit;
}
value available_primitives() /* ML */
value available_primitives(value unit) /* ML */
{
return copy_string_array(names_of_cprim);
}
value get_current_environment() /* ML */
value get_current_environment(value unit) /* ML */
{
return *extern_sp;
}

14
byterun/minor_gc.c
View File

@ -32,8 +32,7 @@ value **ref_table_ptr = NULL, **ref_table_limit;
static asize_t ref_table_size, ref_table_reserve;
int in_minor_collection = 0;
void set_minor_heap_size (size)
asize_t size;
void set_minor_heap_size (asize_t size)
{
char *new_heap;
value **new_table;
@ -65,9 +64,7 @@ void set_minor_heap_size (size)
ref_table_end = ref_table + ref_table_size + ref_table_reserve;
}
void oldify (v, p)
value v;
value *p;
void oldify (value v, value *p)
{
value result, field0;
header_t hd;
@ -120,7 +117,7 @@ void oldify (v, p)
}
}
void minor_collection ()
void minor_collection (void)
{
value **r;
long prev_alloc_words = allocated_words;
@ -142,8 +139,7 @@ void minor_collection ()
force_major_slice = 0;
}
value check_urgent_gc (extra_root)
value extra_root;
value check_urgent_gc (value extra_root)
{
if (force_major_slice) {
Begin_root(extra_root);
@ -153,7 +149,7 @@ value check_urgent_gc (extra_root)
return extra_root;
}
void realloc_ref_table ()
void realloc_ref_table (void)
{ Assert (ref_table_ptr == ref_table_limit);
Assert (ref_table_limit <= ref_table_end);
Assert (ref_table_limit >= ref_table_threshold);

10
byterun/minor_gc.h
View File

@ -25,10 +25,10 @@ extern int in_minor_collection;
#define Is_young(val) \
((addr)(val) > (addr)young_start && (addr)(val) < (addr)young_end)
extern void set_minor_heap_size P((asize_t));
extern void minor_collection P((void));
extern void garbage_collection P((void)); /* for the native-code system */
extern void realloc_ref_table P((void));
extern void oldify P((value, value *));
extern void set_minor_heap_size (asize_t);
extern void minor_collection (void);
extern void garbage_collection (void); /* for the native-code system */
extern void realloc_ref_table (void);
extern void oldify (value, value *);
#endif /* _minor_gc_ */

28
byterun/misc.c
View File

@ -20,9 +20,7 @@
#ifdef DEBUG
void failed_assert (expr, file, line)
char *expr, *file;
int line;
void failed_assert (char * expr, char * file, int line)
{
fprintf (stderr, "Assertion failed: %s; file %s; line %d\n",
expr, file, line);
@ -31,7 +29,7 @@ void failed_assert (expr, file, line)
static unsigned long seed = 0x12345;
unsigned long not_random ()
unsigned long not_random (void)
{
seed = seed * 65537 + 12345;
return seed;
@ -41,9 +39,7 @@ unsigned long not_random ()
int verb_gc;
void gc_message (msg, arg)
char *msg;
unsigned long arg;
void gc_message (char *msg, long unsigned int arg)
{
if (verb_gc){
#ifdef HAS_UI
@ -55,8 +51,7 @@ void gc_message (msg, arg)
}
}
void fatal_error (msg)
char * msg;
void fatal_error (char *msg)
{
#ifdef HAS_UI
ui_print_stderr("%s", msg);
@ -67,8 +62,7 @@ void fatal_error (msg)
#endif
}
void fatal_error_arg (fmt, arg)
char * fmt, * arg;
void fatal_error_arg (char *fmt, char *arg)
{
#ifdef HAS_UI
ui_print_stderr(fmt, arg);
@ -84,9 +78,7 @@ void fatal_error_arg (fmt, arg)
/* This should work on 64-bit machines as well as 32-bit machines.
It assumes a long is the natural size for memory reads and writes.
*/
void memmov (dst, src, length)
char *dst, *src;
unsigned long length;
void memmov (char * dst, char * src, unsigned long length)
{
unsigned long i;
@ -158,10 +150,10 @@ void memmov (dst, src, length)
#endif /* USING_MEMMOV */
char *aligned_malloc (size, modulo, block)
asize_t size;
int modulo;
void **block; /* output */
char *aligned_malloc (asize_t size, int modulo, void **block)
/* output */
{
char *raw_mem;
unsigned long aligned_mem;

30
byterun/misc.h
View File

@ -26,14 +26,6 @@
#include <stdlib.h>
#endif
/* Function prototypes */
#ifdef __STDC__
#define P(x) x
#else
#define P(x) ()
#endif
/* Basic types and constants */
#ifdef __STDC__
@ -48,14 +40,6 @@ typedef int asize_t;
typedef char * addr;
/* Volatile stuff */
#ifdef __STDC__
#define Volatile volatile
#else
#define Volatile
#endif
#ifdef __GNUC__
/* Works only in GCC 2.5 and later */
#define Noreturn __attribute ((noreturn))
@ -81,22 +65,22 @@ typedef char * addr;
#define Assert(x)
#endif
void failed_assert P((char *, char *, int)) Noreturn;
void fatal_error P((char *)) Noreturn;
void fatal_error_arg P((char *, char *)) Noreturn;
void failed_assert (char *, char *, int) Noreturn;
void fatal_error (char *) Noreturn;
void fatal_error_arg (char *, char *) Noreturn;
/* GC flags and messages */
extern int verb_gc;
void gc_message P((char *, unsigned long));
void gc_message (char *, unsigned long);
/* Memory routines */
void memmov P((char *, char *, unsigned long));
char *aligned_malloc P((asize_t, int, void **));
void memmov (char *, char *, unsigned long);
char *aligned_malloc (asize_t, int, void **);
#ifdef DEBUG
unsigned long not_random P((void));
unsigned long not_random (void);
#endif

6
byterun/mlvalues.h
View File

@ -202,8 +202,8 @@ typedef opcode_t * code_t;
#define Double_val(v) (* (double *)(v))
#define Store_double_val(v,d) (* (double *)(v) = (d))
#else
double Double_val P((value));
void Store_double_val P((value,double));
double Double_val (value);
void Store_double_val (value,double);
#endif
/* Arrays of floating-point numbers. */
@ -216,7 +216,7 @@ void Store_double_val P((value,double));
[Final_fun] before deallocation.
*/
#define Final_tag 255
typedef void (*final_fun) P((value));
typedef void (*final_fun) (value);
#define Final_fun(val) (((final_fun *) (val)) [0]) /* Also an l-value. */

18
byterun/obj.c
View File

@ -21,39 +21,33 @@
#include "mlvalues.h"
#include "prims.h"
value static_alloc(size) /* ML */
value size;
value static_alloc(value size) /* ML */
{
return (value) stat_alloc((asize_t) Long_val(size));
}
value static_free(blk) /* ML */
value blk;
value static_free(value blk) /* ML */
{
stat_free((char *) blk);
return Val_unit;
}
value static_resize(blk, new_size) /* ML */
value blk, new_size;
value static_resize(value blk, value new_size) /* ML */
{
return (value) stat_resize((char *) blk, (asize_t) Long_val(new_size));
}
value obj_is_block(arg) /* ML */
value arg;
value obj_is_block(value arg) /* ML */
{
return Val_bool(Is_block(arg));
}
value obj_tag(arg) /* ML */
value arg;
value obj_tag(value arg) /* ML */
{
return Val_int(Tag_val(arg));
}
value obj_block(tag, size) /* ML */
value tag, size;
value obj_block(value tag, value size) /* ML */
{
value res;
mlsize_t sz, i;

6
byterun/parsing.c
View File

@ -104,11 +104,7 @@ int parser_trace = 0;
/* The pushdown automata */
value parse_engine(tables, env, cmd, arg) /* ML */
struct parser_tables * tables;
struct parser_env * env;
value cmd;
value arg;
value parse_engine(struct parser_tables *tables, struct parser_env *env, value cmd, value arg) /* ML */
{
int state;
mlsize_t sp, asp;

11
byterun/printexc.c
View File

@ -29,16 +29,12 @@ struct stringbuf {
char data[256];
};
static void add_char(buf, c)
struct stringbuf * buf;
char c;
static void add_char(struct stringbuf *buf, char c)
{
if (buf->ptr < buf->end) *(buf->ptr++) = c;
}
static void add_string(buf, s)
struct stringbuf * buf;
char * s;
static void add_string(struct stringbuf *buf, char *s)
{
int len = strlen(s);
if (buf->ptr + len > buf->end) len = buf->end - buf->ptr;
@ -52,8 +48,7 @@ static void add_string(buf, s)
#define errprintf(fmt,arg) fprintf(stderr, fmt, arg)
#endif
void fatal_uncaught_exception(exn)
value exn;
void fatal_uncaught_exception(value exn)
{
mlsize_t start, i;
value bucket, v;

20
byterun/roots.c
View File

@ -30,12 +30,11 @@ struct global_root {
static struct global_root * global_roots = NULL;
void (*scan_roots_hook) P((scanning_action)) = NULL;
void (*scan_roots_hook) (scanning_action f) = NULL;
/* Register a global C root */
void register_global_root(r)
value * r;
void register_global_root(value *r)
{
struct global_root * gr;
gr = (struct global_root *) stat_alloc(sizeof(struct global_root));
@ -46,8 +45,7 @@ void register_global_root(r)
/* Un-register a global C root */
void remove_global_root(r)
value * r;
void remove_global_root(value *r)
{
struct global_root ** gp, * gr;
for (gp = &global_roots; *gp != NULL; gp = &(*gp)->next) {
@ -62,7 +60,7 @@ void remove_global_root(r)
/* Call [oldify] on all roots except [global_data] */
void oldify_local_roots ()
void oldify_local_roots (void)
{
register value * sp;
struct global_root * gr;
@ -92,13 +90,12 @@ void oldify_local_roots ()
/* Call [darken] on all roots */
void darken_all_roots ()
void darken_all_roots (void)
{
do_roots (darken);
}
void do_roots (f)
scanning_action f;
void do_roots (scanning_action f)
{
struct global_root * gr;
@ -116,10 +113,7 @@ void do_roots (f)
if (scan_roots_hook != NULL) (*scan_roots_hook)(f);
}
void do_local_roots (f, stack_low, stack_high, local_roots)
scanning_action f;
value * stack_low, * stack_high;
struct caml__roots_block * local_roots;
void do_local_roots (scanning_action f, value *stack_low, value *stack_high, struct caml__roots_block *local_roots)
{
register value * sp;
struct caml__roots_block *lr;

18
byterun/roots.h
View File

@ -17,19 +17,19 @@
#include "misc.h"
#include "memory.h"
typedef void (*scanning_action) P((value, value *));
typedef void (*scanning_action) (value, value *);
void oldify_local_roots P((void));
void darken_all_roots P((void));
void do_roots P((scanning_action));
void oldify_local_roots (void);
void darken_all_roots (void);
void do_roots (scanning_action);
#ifndef NATIVE_CODE
void do_local_roots P((scanning_action, value *, value *,
struct caml__roots_block *));
void do_local_roots (scanning_action, value *, value *,
struct caml__roots_block *);
#else
void do_local_roots P((scanning_action, unsigned long, char *,
struct caml__roots_block *));
void do_local_roots (scanning_action, unsigned long, char *,
struct caml__roots_block *);
#endif
extern void (*scan_roots_hook) P((scanning_action));
extern void (*scan_roots_hook) (scanning_action);
#endif /* _roots_ */

23
byterun/signals.c
View File

@ -22,23 +22,21 @@
#include "roots.h"
#include "signals.h"
Volatile int async_signal_mode = 0;
Volatile int pending_signal = 0;
Volatile int something_to_do = 0;
Volatile int force_major_slice = 0;
volatile int async_signal_mode = 0;
volatile int pending_signal = 0;
volatile int something_to_do = 0;
volatile int force_major_slice = 0;
value signal_handlers = 0;
void (*enter_blocking_section_hook)() = NULL;
void (*leave_blocking_section_hook)() = NULL;
static void execute_signal(signal_number)
int signal_number;
static void execute_signal(int signal_number)
{
Assert (!async_signal_mode);
callback(Field(signal_handlers, signal_number), Val_int(signal_number));
}
void handle_signal(signal_number)
int signal_number;
void handle_signal(int signal_number)
{
#ifndef POSIX_SIGNALS
#ifndef BSD_SIGNALS
@ -55,13 +53,13 @@ void handle_signal(signal_number)
}
}
void urge_major_slice ()
void urge_major_slice (void)
{
force_major_slice = 1;
something_to_do = 1;
}
void enter_blocking_section()
void enter_blocking_section(void)
{
int temp;
@ -78,7 +76,7 @@ void enter_blocking_section()
if (enter_blocking_section_hook != NULL) enter_blocking_section_hook();
}
void leave_blocking_section()
void leave_blocking_section(void)
{
Assert(async_signal_mode);
if (leave_blocking_section_hook != NULL) leave_blocking_section_hook();
@ -159,8 +157,7 @@ int posix_signals[] = {
#define NSIG 32
#endif
value install_signal_handler(signal_number, action) /* ML */
value signal_number, action;
value install_signal_handler(value signal_number, value action) /* ML */
{
int sig;
void (*act)();

14
byterun/signals.h
View File

@ -18,14 +18,14 @@
#include "mlvalues.h"
extern value signal_handlers;
extern Volatile int pending_signal;
extern Volatile int something_to_do;
extern Volatile int force_major_slice;
extern Volatile int async_signal_mode;
extern volatile int pending_signal;
extern volatile int something_to_do;
extern volatile int force_major_slice;
extern volatile int async_signal_mode;
void enter_blocking_section P((void));
void leave_blocking_section P((void));
void urge_major_slice P((void));
void enter_blocking_section (void);
void leave_blocking_section (void);
void urge_major_slice (void);
extern void (*enter_blocking_section_hook)();
extern void (*leave_blocking_section_hook)();

8
byterun/stacks.c
View File

@ -30,8 +30,7 @@ value global_data;
unsigned long max_stack_size;
void init_stack (initial_max_size)
unsigned long initial_max_size;
void init_stack (long unsigned int initial_max_size)
{
stack_low = (value *) stat_alloc(Stack_size);
stack_high = stack_low + Stack_size / sizeof (value);
@ -44,7 +43,7 @@ void init_stack (initial_max_size)
max_stack_size / 1024 * sizeof (value));
}
void realloc_stack()
void realloc_stack(void)
{
asize_t size;
value * new_low, * new_high, * new_sp;
@ -79,8 +78,7 @@ void realloc_stack()
#undef shift
}
void change_max_stack_size (new_max_size)
unsigned long new_max_size;
void change_max_stack_size (long unsigned int new_max_size)
{
asize_t size = stack_high - extern_sp + Stack_threshold / sizeof (value);

8
byterun/stacks.h
View File

@ -31,10 +31,10 @@ extern value * trap_barrier;
#define Trap_pc(tp) (((code_t *)(tp))[0])
#define Trap_link(tp) (((value **)(tp))[1])
void reset_roots P((void));
void init_stack P((unsigned long init_max_size));
void realloc_stack P((void));
void change_max_stack_size P((unsigned long new_max_size));
void reset_roots (void);
void init_stack (unsigned long init_max_size);
void realloc_stack (void);
void change_max_stack_size (unsigned long new_max_size);
#endif /* _stacks_ */

38
byterun/startup.c
View File

@ -50,7 +50,7 @@ header_t atom_table[256];
/* Initialize the atom table */
static void init_atoms()
static void init_atoms(void)
{
int i;
for(i = 0; i < 256; i++) atom_table[i] = Make_header(0, i, White);
@ -58,8 +58,7 @@ static void init_atoms()
/* Read the trailer of a bytecode file */
static unsigned long read_size(p)
unsigned char * p;
static unsigned long read_size(unsigned char *p)
{
return ((unsigned long) p[0] << 24) + ((unsigned long) p[1] << 16) +
((unsigned long) p[2] << 8) + p[3];
@ -69,9 +68,7 @@ static unsigned long read_size(p)
#define TRUNCATED_FILE (-2)
#define BAD_MAGIC_NUM (-3)
static int read_trailer(fd, trail)
int fd;
struct exec_trailer * trail;
static int read_trailer(int fd, struct exec_trailer *trail)
{
char buffer[TRAILER_SIZE];
@ -88,10 +85,7 @@ static int read_trailer(fd, trail)
return BAD_MAGIC_NUM;
}
static int attempt_open(name, trail, do_open_script)
char ** name;
struct exec_trailer * trail;
int do_open_script;
static int attempt_open(char **name, struct exec_trailer *trail, int do_open_script)
{
char * truename;
int fd;
@ -115,9 +109,7 @@ static int attempt_open(name, trail, do_open_script)
/* Check the primitives used by the bytecode file against the table of
primitives linked in this interpreter */
static void check_primitives(fd, prim_size)
int fd;
int prim_size;
static void check_primitives(int fd, int prim_size)
{
char * prims = stat_alloc(prim_size);
char * p;
@ -174,8 +166,7 @@ extern int trace_flag;
/* Parse options on the command line */
static int parse_command_line(argv)
char ** argv;
static int parse_command_line(char **argv)
{
int i;
@ -202,9 +193,7 @@ static int parse_command_line(argv)
Except for l (maximum stack size) and h (initial heap size).
*/
static void scanmult (opt, var)
char *opt;
unsigned long *var;
static void scanmult (char *opt, long unsigned int *var)
{
char mult = ' ';
sscanf (opt, "=%lu%c", var, &mult);
@ -213,7 +202,7 @@ static void scanmult (opt, var)
if (mult == 'G') *var = *var * (1024 * 1024 * 1024);
}
static void parse_camlrunparam()
static void parse_camlrunparam(void)
{
char *opt = getenv ("CAMLRUNPARAM");
if (opt != NULL){
@ -231,12 +220,11 @@ static void parse_camlrunparam()
}
}
extern void init_ieee_floats P((void));
extern void init_ieee_floats (void);
/* Main entry point when loading code from a file */
void caml_main(argv)
char ** argv;
void caml_main(char **argv)
{
int fd;
struct exec_trailer trail;
@ -309,11 +297,7 @@ void caml_main(argv)
/* Main entry point when code is linked in as initialized data */
void caml_startup_code(code, code_size, data, argv)
code_t code;
asize_t code_size;
char * data;
char ** argv;
void caml_startup_code(code_t code, asize_t code_size, char *data, char **argv)
{
struct longjmp_buffer raise_buf;

33
byterun/str.c
View File

@ -19,8 +19,7 @@
#include "mlvalues.h"
#include "misc.h"
mlsize_t string_length(s)
value s;
mlsize_t string_length(value s)
{
mlsize_t temp;
temp = Bosize_val(s) - 1;
@ -28,8 +27,7 @@ mlsize_t string_length(s)
return temp - Byte (s, temp);
}
value ml_string_length(s) /* ML */
value s;
value ml_string_length(value s) /* ML */
{
mlsize_t temp;
temp = Bosize_val(s) - 1;
@ -37,24 +35,21 @@ value ml_string_length(s) /* ML */
return Val_long(temp - Byte (s, temp));
}
value create_string(len) /* ML */
value len;
value create_string(value len) /* ML */
{
mlsize_t size = Long_val(len);
if (size > Bsize_wsize (Max_wosize) - 1) invalid_argument("String.create");
return alloc_string(size);
}
value string_get(str, index) /* ML */
value str, index;
value string_get(value str, value index) /* ML */
{
long idx = Long_val(index);
if (idx < 0 || idx >= string_length(str)) invalid_argument("String.get");
return Val_int(Byte_u(str, idx));
}
value string_set(str, index, newval) /* ML */
value str, index, newval;
value string_set(value str, value index, value newval) /* ML */
{
long idx = Long_val(index);
if (idx < 0 || idx >= string_length(str)) invalid_argument("String.set");
@ -62,8 +57,7 @@ value string_set(str, index, newval) /* ML */
return Val_unit;
}
value string_equal(s1, s2) /* ML */
value s1, s2;
value string_equal(value s1, value s2) /* ML */
{
mlsize_t sz1 = Wosize_val(s1);
mlsize_t sz2 = Wosize_val(s2);
@ -74,21 +68,18 @@ value string_equal(s1, s2) /* ML */
return Val_true;
}
value string_notequal(s1, s2) /* ML */
value s1, s2;
value string_notequal(value s1, value s2) /* ML */
{
return Val_not(string_equal(s1, s2));
}
value blit_string(s1, ofs1, s2, ofs2, n) /* ML */
value s1, ofs1, s2, ofs2, n;
value blit_string(value s1, value ofs1, value s2, value ofs2, value n) /* ML */
{
bcopy(&Byte(s1, Long_val(ofs1)), &Byte(s2, Long_val(ofs2)), Int_val(n));
return Val_unit;
}
value fill_string(s, offset, len, init) /* ML */
value s, offset, len, init;
value fill_string(value s, value offset, value len, value init) /* ML */
{
register char * p;
register mlsize_t n;
@ -106,8 +97,7 @@ static unsigned char printable_chars_ascii[] = /* 0x20-0x7E */
static unsigned char printable_chars_iso[] = /* 0x20-0x7E 0xA1-0xFF */
"\000\000\000\000\377\377\377\377\377\377\377\377\377\377\377\177\000\000\000\000\376\377\377\377\377\377\377\377\377\377\377\377";
value is_printable(chr) /* ML */
value chr;
value is_printable(value chr) /* ML */
{
int c;
unsigned char * printable_chars;
@ -126,8 +116,7 @@ value is_printable(chr) /* ML */
return Val_bool(printable_chars[c >> 3] & (1 << (c & 7)));
}
value bitvect_test(bv, n) /* ML */
value bv, n;
value bitvect_test(value bv, value n) /* ML */
{
int pos = Int_val(n);
return Val_int(Byte_u(bv, pos >> 3) & (1 << (pos & 7)));

2
byterun/str.h
View File

@ -18,7 +18,7 @@
#include "misc.h"
#include "mlvalues.h"
mlsize_t string_length P((value));
mlsize_t string_length (value);
#endif /* _str_ */

57
byterun/sys.c
View File

@ -44,9 +44,9 @@ extern int errno;
#ifdef HAS_STRERROR
extern char * strerror();
extern char * strerror(int);
char * error_message()
char * error_message(void)
{
return strerror(errno);
}
@ -56,7 +56,7 @@ char * error_message()
extern int sys_nerr;
extern char * sys_errlist [];
char * error_message()
char * error_message(void)
{
if (errno < 0 || errno >= sys_nerr)
return "unknown error";
@ -66,8 +66,7 @@ char * error_message()
#endif /* HAS_STRERROR */
void sys_error(arg)
value arg;
void sys_error(value arg)
{
char * err = error_message();
value str;
@ -87,8 +86,7 @@ void sys_error(arg)
raise_sys_error(str);
}
value sys_exit(retcode) /* ML */
value retcode;
value sys_exit(value retcode) /* ML */
{
#ifndef NATIVE_CODE
debugger(PROGRAM_EXIT);
@ -120,8 +118,7 @@ static int sys_open_flags[] = {
O_BINARY, O_TEXT, O_NONBLOCK
};
value sys_open(path, flags, perm) /* ML */
value path, flags, perm;
value sys_open(value path, value flags, value perm) /* ML */
{
int ret;
ret = open(String_val(path), convert_flag_list(flags, sys_open_flags)
@ -133,15 +130,13 @@ value sys_open(path, flags, perm) /* ML */
return Val_long(ret);
}
value sys_close(fd) /* ML */
value fd;
value sys_close(value fd) /* ML */
{
close(Int_val(fd));
return Val_unit;
}
value sys_file_exists(name) /* ML */
value name;
value sys_file_exists(value name) /* ML */
{
#if macintosh
int f;
@ -155,8 +150,7 @@ value sys_file_exists(name) /* ML */
#endif
}
value sys_remove(name) /* ML */
value name;
value sys_remove(value name) /* ML */
{
int ret;
ret = unlink(String_val(name));
@ -164,23 +158,20 @@ value sys_remove(name) /* ML */
return Val_unit;
}
value sys_rename(oldname, newname) /* ML */
value oldname, newname;
value sys_rename(value oldname, value newname) /* ML */
{
if (rename(String_val(oldname), String_val(newname)) != 0)
sys_error(oldname);
return Val_unit;
}
value sys_chdir(dirname) /* ML */
value dirname;
value sys_chdir(value dirname) /* ML */
{
if (chdir(String_val(dirname)) != 0) sys_error(dirname);
return Val_unit;
}
value sys_getcwd(unit) /* ML */
value unit;
value sys_getcwd(value unit) /* ML */
{
char buff[4096];
#ifdef HAS_GETCWD
@ -191,8 +182,7 @@ value sys_getcwd(unit) /* ML */
return copy_string(buff);
}
value sys_getenv(var) /* ML */
value var;
value sys_getenv(value var) /* ML */
{
char * res;
@ -203,28 +193,24 @@ value sys_getenv(var) /* ML */
static char ** main_argv;
value sys_get_argv(unit) /* ML */
value unit;
value sys_get_argv(value unit) /* ML */
{
return copy_string_array(main_argv);
}
void sys_init(argv)
char ** argv;
void sys_init(char **argv)
{
main_argv = argv;
}
value sys_system_command(command) /* ML */
value command;
value sys_system_command(value command) /* ML */
{
int retcode = system(String_val(command));
if (retcode == -1) sys_error(command);
return Val_int(retcode);
}
value sys_get_config(unit) /* ML */
value unit;
value sys_get_config(value unit) /* ML */
{
value result;
value ostype;
@ -242,8 +228,7 @@ value sys_get_config(unit) /* ML */
#ifdef _WIN32
char * searchpath(name)
char * name;
char * searchpath(char * name)
{
char * fullname;
char * path;
@ -279,8 +264,7 @@ char * searchpath(name)
/* We don't need searchpath on the Macintosh because there are no #! scripts */
char *searchpath (name)
char *name;
char *searchpath (char * name)
{
return name;
}
@ -291,8 +275,7 @@ char *searchpath (name)
#define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG)
#endif
char * searchpath(name)
char * name;
char * searchpath(char * name)
{
char * fullname;
char * path;

8
byterun/sys.h
View File

@ -17,9 +17,9 @@
#include "misc.h"
#define NO_ARG Val_int(0)
void sys_error P((value));
void sys_init P((char **));
value sys_exit P((value));
char * searchpath P((char * name));
void sys_error (value);
void sys_init (char **);
value sys_exit (value);
char * searchpath (char * name);
#endif /* _sys_ */

44
byterun/terminfo.c
View File

@ -21,21 +21,19 @@
#ifdef HAS_TERMCAP
extern int tgetent P((char * buffer, char * name));
extern int tgetstr P((char * id, char ** area));
extern int tgetnum P((char * id));
extern int tputs P((char * str, int count, int (*outchar)(int c)));
extern int tgetent (char * buffer, char * name);
extern int tgetstr (char * id, char ** area);
extern int tgetnum (char * id);
extern int tputs (char * str, int count, int (*outchar)(int c));
value terminfo_setup(unit) /* ML */
value unit;
value terminfo_setup(value unit) /* ML */
{
static char buffer[1024];
if (tgetent(buffer, getenv("TERM")) != 1) failwith("Terminfo.setupterm");
return Val_unit;
}
value terminfo_getstr(capa) /* ML */
value capa;
value terminfo_getstr(value capa) /* ML */
{
char buff[1024];
char * p = buff;
@ -43,8 +41,7 @@ value terminfo_getstr(capa) /* ML */
return copy_string(buff);
}
value terminfo_getnum(capa) /* ML */
value capa;
value terminfo_getnum(value capa) /* ML */
{
int res = tgetnum(String_val(capa));
if (res == -1) raise_not_found();
@ -53,15 +50,13 @@ value terminfo_getnum(capa) /* ML */
static struct channel * terminfo_putc_channel;
static int terminfo_putc(c)
int c;
static int terminfo_putc(int c)
{
putch(terminfo_putc_channel, c);
return c;
}
value terminfo_puts(vchan, str, count) /* ML */
value vchan, str, count;
value terminfo_puts(value vchan, value str, value count) /* ML */
{
terminfo_putc_channel = Channel(vchan);
tputs(String_val(str), Int_val(count), terminfo_putc);
@ -70,29 +65,26 @@ value terminfo_puts(vchan, str, count) /* ML */
#else
value terminfo_setup(unit)
value unit;
value terminfo_setup(value unit)
{
failwith("Terminfo.setupterm");
return Val_unit;
}
value terminfo_getstr(capa)
value terminfo_getstr(value capa)
{
raise_not_found();
return Val_unit;
}
value terminfo_getnum(value capa)
value capa;
{
raise_not_found();
return Val_unit;
}
value terminfo_getnum(capa)
value capa;
{
raise_not_found();
return Val_unit;
}
value terminfo_puts(vchan, str, count)
value vchan, str, count;
value terminfo_puts(value vchan, value str, value count)
{
invalid_argument("Terminfo.puts");
return Val_unit;

8
byterun/ui.h
View File

@ -15,7 +15,7 @@
#include "config.h"
void ui_exit P((int return_code));
int ui_read P((int file_desc, char *buf, unsigned int length));
int ui_write P((int file_desc, char *buf, unsigned int length));
void ui_print_stderr P((char *format, void *arg));
void ui_exit (int return_code);
int ui_read (int file_desc, char *buf, unsigned int length);
int ui_write (int file_desc, char *buf, unsigned int length);
void ui_print_stderr (char *format, void *arg);

9
byterun/weak.c
View File

@ -20,8 +20,7 @@
value weak_list_head = 0;
value weak_create (len) /* ML */
value len;
value weak_create (value len) /* ML */
{
mlsize_t size, i;
value res;
@ -38,8 +37,7 @@ value weak_create (len) /* ML */
#define None_val 1
#define Some_tag 0
value weak_set (ar, n, el) /* ML */
value ar, n, el;
value weak_set (value ar, value n, value el) /* ML */
{
mlsize_t offset = Long_val (n) + 1;
Assert (Is_in_heap (ar));
@ -54,8 +52,7 @@ value weak_set (ar, n, el) /* ML */
#define Setup_for_gc
#define Restore_after_gc
value weak_get (ar, n) /* ML */
value ar, n;
value weak_get (value ar, value n) /* ML */
{
mlsize_t offset = Long_val (n) + 1;
value res;

24
byterun/wincmdline.c
View File

@ -26,17 +26,18 @@ static int argc;
static char ** argv;
static int argvsize;
static void store_argument(), expand_argument();
static void expand_pattern(), expand_diversion();
static void store_argument(char * arg);
static void expand_argument(char * arg);
static void expand_pattern(char * arg);
static void expand_diversion(char * filename);
static void out_of_memory()
static void out_of_memory(void)
{
fprintf(stderr, "Out of memory while expanding command line\n");
exit(2);
}
static void store_argument(arg)
char * arg;
static void store_argument(char * arg)
{
if (argc + 1 >= argvsize) {
argvsize *= 2;
@ -46,8 +47,7 @@ static void store_argument(arg)
argv[argc++] = arg;
}
static void expand_argument(arg)
char * arg;
static void expand_argument(char * arg)
{
char * p;
@ -64,8 +64,7 @@ static void expand_argument(arg)
store_argument(arg);
}
static void expand_pattern(pat)
char * pat;
static void expand_pattern(char * pat)
{
int handle;
struct _finddata_t ffblk;
@ -81,8 +80,7 @@ static void expand_pattern(pat)
_findclose(handle);
}
static void expand_diversion(filename)
char * filename;
static void expand_diversion(char * filename)
{
struct _stat stat;
int fd;
@ -111,9 +109,7 @@ static void expand_diversion(filename)
}
}
void expand_command_line(argcp, argvp)
int * argcp;
char *** argvp;
void expand_command_line(int * argcp, char *** argvp)
{
int i;
argc = 0;

24
config/auto-aux/align.c
View File

@ -17,29 +17,24 @@
long foo;
void access16(p)
short * p;
void access16(short int *p)
{
foo = *p;
}
void access32(p)
long * p;
void access32(long int *p)
{
foo = *p;
}
jmp_buf failure;
void sig_handler(dummy)
int dummy;
void sig_handler(int dummy)
{
longjmp(failure, 1);
}
int test(fct, p)
void (*fct)();
char * p;
int test(void (*fct) (/* ??? */), char *p)
{
int res;
@ -58,20 +53,17 @@ int test(fct, p)
jmp_buf timer;
void alarm_handler(dummy)
int dummy;
void alarm_handler(int dummy)
{
longjmp(timer, 1);
}
void use(n)
int n;
void use(int n)
{
return;
}
int speedtest(p)
char * p;
int speedtest(char *p)
{
int * q;
volatile int total;
@ -94,7 +86,7 @@ int speedtest(p)
return total;
}
main()
main(void)
{
long n[1001];
int speed_aligned, speed_unaligned;

19
config/auto-aux/ansi.c Normal file
View File

@ -0,0 +1,19 @@
/***********************************************************************/
/* */
/* Objective Caml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
/* Copyright 1997 Institut National de Recherche en Informatique et */
/* Automatique. Distributed only by permission. */
/* */
/***********************************************************************/
int main()
{
#ifdef __STDC__
return 0;
#else
return 1;
#endif
}

5
config/auto-aux/async_io.c
View File

@ -19,13 +19,12 @@
int signalled;
void sigio_handler(arg)
int arg;
void sigio_handler(int arg)
{
signalled = 1;
}
int main()
int main(void)
{
#if defined(SIGIO) && defined(FASYNC) && defined(F_SETFL) && defined(F_SETOWN)
int p[2];

2
config/auto-aux/bytecopy.c
View File

@ -19,7 +19,7 @@ char buffer[27];
#define cpy copy
#endif
main()
int main(int argc, char ** argv)
{
cpy("abcdefghijklmnopqrstuvwxyz", buffer, 27);
if (strcmp(buffer, "abcdefghijklmnopqrstuvwxyz") != 0) exit(1);

8
config/auto-aux/dblalign.c
View File

@ -17,21 +17,19 @@
double foo;
void access_double(p)
double * p;
void access_double(double *p)
{
foo = *p;
}
jmp_buf failure;
void sig_handler(sig)
int sig;
void sig_handler(int sig)
{
longjmp(failure, 1);
}
int main()
int main(void)
{
long n[10];
int res;

2
config/auto-aux/endian.c
View File

@ -23,7 +23,7 @@ char * bigendian = "ABCDEFGH";
char * littleendian = "HGFEDCBA";
#endif
main()
main(void)
{
long n[2];
char * p;

4
config/auto-aux/getgroups.c
View File

@ -16,7 +16,7 @@
#ifdef NGROUPS
int main()
int main(void)
{
int gidset[NGROUPS];
if (getgroups(NGROUPS, gidset) == -1) return 1;
@ -25,6 +25,6 @@ int main()
#else
int main() { return 1; }
int main(void) { return 1; }
#endif

2
config/auto-aux/schar.c
View File

@ -12,7 +12,7 @@
/* $Id$ */
char foo[]="\377";
main()
main(void)
{
int i;
i = foo[0];

2
config/auto-aux/schar2.c
View File

@ -12,7 +12,7 @@
/* $Id$ */
signed char foo[]="\377";
main()
main(void)
{
int i;
i = foo[0];

2
config/auto-aux/sighandler.c
View File

@ -13,7 +13,7 @@
#include <signal.h>
main()
int main(void)
{
SIGRETURN (*old)();
old = signal(SIGQUIT, SIG_DFL);

11
config/auto-aux/signals.c
View File

@ -40,15 +40,12 @@
int counter;
void sig_handler(dummy)
int dummy;
void sig_handler(int dummy)
{
counter++;
}
int main(argc, argv)
int argc;
char ** argv;
int main(int argc, char **argv)
{
signal(IGNSIG, sig_handler);
counter = 0;
@ -61,9 +58,7 @@ int main(argc, argv)
/* If no suitable signal was found, assume System V */
int main(argc, argv)
int argc;
char ** argv;
int main(int argc, char ** argv)
{
return 1;
}

4
config/auto-aux/sizes.c
View File

@ -11,9 +11,7 @@
/* $Id$ */
int main(argc, argv)
int argc;
char ** argv;
int main(int argc, char **argv)
{
printf("%d %d %d\n", sizeof(int), sizeof(long), sizeof(long *));
return 0;

13
configure vendored
View File

@ -142,6 +142,19 @@ echo "BYTECCLINKOPTS=$bytecclinkopts" >> Makefile
cc="$bytecc $bytecclinkopts"
export cc cclibs
# Check C compiler
sh ./runtest ansi.c
case $? in
0) echo "The C compiler is ANSI-compliant.";;
1) echo "The C compiler $cc is not ANSI-compliant."
echo "You need an ANSI C compiler to build Objective Caml."
exit 2;;
*) echo "Unable to compiler the test program."
echo "Make sure the C compiler $cc is properly installed."
exit 2;;
esac
# Check the sizes of data types
echo "Checking the sizes of integers and pointers..."

33
otherlibs/dbm/cldbm.c
View File

@ -26,10 +26,9 @@ static int dbm_open_flags[] = {
O_RDONLY, O_WRONLY, O_RDWR, O_CREAT
};
static void raise_dbm P((char *errmsg)) Noreturn;
static void raise_dbm (char *errmsg) Noreturn;
static void raise_dbm(errmsg)
char *errmsg;
static void raise_dbm(char *errmsg)
{
static value * dbm_exn = NULL;
if (dbm_exn == NULL)
@ -38,10 +37,7 @@ static void raise_dbm(errmsg)
}
/* Dbm.open : string -> Sys.open_flag list -> int -> t */
value caml_dbm_open(vfile, vflags, vmode) /* ML */
value vfile;
value vflags;
value vmode;
value caml_dbm_open(value vfile, value vflags, value vmode) /* ML */
{
char *file = String_val(vfile);
int flags = convert_flag_list(vflags, dbm_open_flags);
@ -55,17 +51,14 @@ value caml_dbm_open(vfile, vflags, vmode) /* ML */
}
/* Dbm.close: t -> unit */
value caml_dbm_close(vdb) /* ML */
value vdb;
value caml_dbm_close(value vdb) /* ML */
{
dbm_close((DBM *)vdb);
return Val_unit;
}
/* Dbm.fetch: t -> string -> string */
value caml_dbm_fetch(vdb,vkey) /* ML */
value vdb;
value vkey;
value caml_dbm_fetch(value vdb, value vkey) /* ML */
{
datum key,answer;
key.dptr = String_val(vkey);
@ -79,8 +72,7 @@ value caml_dbm_fetch(vdb,vkey) /* ML */
else raise_not_found();
}
value caml_dbm_insert(vdb,vkey,vcontent) /* ML */
value vdb,vkey,vcontent;
value caml_dbm_insert(value vdb, value vkey, value vcontent) /* ML */
{
datum key, content;
@ -99,9 +91,7 @@ value caml_dbm_insert(vdb,vkey,vcontent) /* ML */
}
}
value caml_dbm_replace(vdb,vkey,vcontent) /* ML */
value vdb,vkey,vcontent;
value caml_dbm_replace(value vdb, value vkey, value vcontent) /* ML */
{
datum key, content;
@ -118,8 +108,7 @@ value caml_dbm_replace(vdb,vkey,vcontent) /* ML */
}
}
value caml_dbm_delete(vdb,vkey) /* ML */
value vdb, vkey;
value caml_dbm_delete(value vdb, value vkey) /* ML */
{
datum key;
key.dptr = String_val(vkey);
@ -130,8 +119,7 @@ value caml_dbm_delete(vdb,vkey) /* ML */
else return Val_unit;
}
value caml_dbm_firstkey(vdb) /* ML */
value vdb;
value caml_dbm_firstkey(value vdb) /* ML */
{
datum key = dbm_firstkey((DBM *)vdb);
@ -143,8 +131,7 @@ value caml_dbm_firstkey(vdb) /* ML */
else raise_not_found();
}
value caml_dbm_nextkey(vdb) /* ML */
value vdb;
value caml_dbm_nextkey(value vdb) /* ML */
{
datum key = dbm_nextkey((DBM *)vdb);

12
otherlibs/graph/color.c
View File

@ -26,7 +26,7 @@ static struct color_cache_entry color_cache[Color_cache_size];
#define Hash_rgb(r,g,b) \
((((r) & 0xC0) >> 2) + (((g) & 0xC0) >> 4) + (((b) & 0xC0) >> 6))
void gr_init_color_cache()
void gr_init_color_cache(void)
{
int i;
for (i = 0; i < Color_cache_size; i++) color_cache[i].rgb = Empty;
@ -38,9 +38,7 @@ void gr_init_color_cache()
color_cache[i].pixel = grwhite;
}
unsigned long gr_pixel_rgb(rgb)
int rgb;
unsigned long gr_pixel_rgb(int rgb)
{
unsigned int r, g, b;
int h, i;
@ -66,8 +64,7 @@ unsigned long gr_pixel_rgb(rgb)
return color.pixel;
}
int gr_rgb_pixel(pixel)
unsigned long pixel;
int gr_rgb_pixel(long unsigned int pixel)
{
XColor color;
int i;
@ -86,8 +83,7 @@ int gr_rgb_pixel(pixel)
((color.red >> 8) << 16) + ((color.green >> 8) << 8) + (color.blue >> 8);
}
value gr_set_color(vrgb)
value vrgb;
value gr_set_color(value vrgb)
{
gr_check_open();
grcolor = gr_pixel_rgb(Int_val(vrgb));

21
otherlibs/graph/draw.c
View File

@ -14,8 +14,7 @@
#include "libgraph.h"
#include <alloc.h>
value gr_plot(vx, vy)
value vx, vy;
value gr_plot(value vx, value vy)
{
int x = Int_val(vx);
int y = Int_val(vy);
@ -26,15 +25,14 @@ value gr_plot(vx, vy)
return Val_unit;
}
value gr_moveto(vx, vy)
value vx, vy;
value gr_moveto(value vx, value vy)
{
grx = Int_val(vx);
gry = Int_val(vy);
return Val_unit;
}
value gr_current_point()
value gr_current_point(void)
{
value res;
res = alloc_tuple(2);
@ -43,8 +41,7 @@ value gr_current_point()
return res;
}
value gr_lineto(vx, vy)
value vx, vy;
value gr_lineto(value vx, value vy)
{
int x = Int_val(vx);
int y = Int_val(vy);
@ -59,8 +56,7 @@ value gr_lineto(vx, vy)
return Val_unit;
}
value gr_draw_arc_nat(vx, vy, vrx, vry, va1, va2)
value vx, vy, vrx, vry, va1, va2;
value gr_draw_arc_nat(value vx, value vy, value vrx, value vry, value va1, value va2)
{
int x = Int_val(vx);
int y = Int_val(vy);
@ -78,15 +74,12 @@ value gr_draw_arc_nat(vx, vy, vrx, vry, va1, va2)
return Val_unit;
}
value gr_draw_arc(argv, argc)
int argc;
value * argv;
value gr_draw_arc(value *argv, int argc)
{
return gr_draw_arc_nat(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
}
value gr_set_line_width(vwidth)
value vwidth;
value gr_set_line_width(value vwidth)
{
int width = Int_val(vwidth);
gr_check_open();

6
otherlibs/graph/dump_img.c
View File

@ -16,8 +16,7 @@
#include <alloc.h>
#include <memory.h>
static value gr_alloc_int_vect(size)
mlsize_t size;
static value gr_alloc_int_vect(mlsize_t size)
{
value res;
mlsize_t i;
@ -33,8 +32,7 @@ static value gr_alloc_int_vect(size)
return res;
}
value gr_dump_image(image)
value image;
value gr_dump_image(value image)
{
int width, height, i, j;
XImage * idata, * imask;

6
otherlibs/graph/events.c
View File

@ -22,8 +22,7 @@ static int gr_tail = 0; /* position of next write */
#define QueueIsEmpty (gr_head == gr_tail)
#define QueueIsFull (gr_head == gr_tail + 1)
void gr_enqueue_char(c)
unsigned char c;
void gr_enqueue_char(unsigned char c)
{
if (QueueIsFull) return;
gr_queue[gr_tail] = c;
@ -31,8 +30,7 @@ void gr_enqueue_char(c)
if (gr_tail >= SIZE_QUEUE) gr_tail = 0;
}
value gr_wait_event(eventlist)
value eventlist;
value gr_wait_event(value eventlist)
{
value res;
int mask;

13
otherlibs/graph/fill.c
View File

@ -14,8 +14,7 @@
#include "libgraph.h"
#include <memory.h>
value gr_fill_rect(vx, vy, vw, vh)
value vx, vy, vw, vh;
value gr_fill_rect(value vx, value vy, value vw, value vh)
{
int x = Int_val(vx);
int y = Int_val(vy);
@ -31,8 +30,7 @@ value gr_fill_rect(vx, vy, vw, vh)
return Val_unit;
}
value gr_fill_poly(array)
value array;
value gr_fill_poly(value array)
{
XPoint * points;
int npoints, i;
@ -56,8 +54,7 @@ value gr_fill_poly(array)
return Val_unit;
}
value gr_fill_arc_nat(vx, vy, vrx, vry, va1, va2)
value vx, vy, vrx, vry, va1, va2;
value gr_fill_arc_nat(value vx, value vy, value vrx, value vry, value va1, value va2)
{
int x = Int_val(vx);
int y = Int_val(vy);
@ -75,9 +72,7 @@ value gr_fill_arc_nat(vx, vy, vrx, vry, va1, va2)
return Val_unit;
}
value gr_fill_arc(argv, argc)
int argc;
value * argv;
value gr_fill_arc(value *argv, int argc)
{
return gr_fill_arc_nat(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
}

15
otherlibs/graph/image.c
View File

@ -15,8 +15,7 @@
#include "image.h"
#include <alloc.h>
static void gr_free_image(im)
value im;
static void gr_free_image(value im)
{
XFreePixmap(grdisplay, Data_im(im));
if (Mask_im(im) != None) XFreePixmap(grdisplay, Mask_im(im));
@ -24,8 +23,7 @@ static void gr_free_image(im)
#define Max_image_mem 1000000
value gr_new_image(w, h)
int w, h;
value gr_new_image(int w, int h)
{
value res = alloc_final(Grimage_wosize, gr_free_image, w*h, Max_image_mem);
Width_im(res) = w;
@ -36,15 +34,13 @@ value gr_new_image(w, h)
return res;
}
value gr_create_image(vw, vh)
value vw, vh;
value gr_create_image(value vw, value vh)
{
gr_check_open();
return gr_new_image(Int_val(vw), Int_val(vh));
}
value gr_blit_image(im, vx, vy)
value im, vx, vy;
value gr_blit_image(value im, value vx, value vy)
{
int x = Int_val(vx);
int y = Int_val(vy);
@ -56,8 +52,7 @@ value gr_blit_image(im, vx, vy)
return Val_unit;
}
value gr_draw_image(im, vx, vy)
value im, vx, vy;
value gr_draw_image(value im, value vx, value vy)
{
int x = Int_val(vx);
int y = Int_val(vy);

2
otherlibs/graph/image.h
View File

@ -28,4 +28,4 @@ struct grimage {
#define Transparent (-1)
value gr_new_image();
value gr_new_image(int w, int h);

14
otherlibs/graph/libgraph.h
View File

@ -62,10 +62,10 @@ extern XFontStruct * grfont; /* Current font */
#endif
#endif
void gr_fail();
void gr_check_open();
unsigned long gr_pixel_rgb();
int gr_rgb_pixel();
void gr_handle_simple_event();
void gr_enqueue_char();
void gr_init_color_cache();
void gr_fail(char *fmt, char *arg);
void gr_check_open(void);
unsigned long gr_pixel_rgb(int rgb);
int gr_rgb_pixel(long unsigned int pixel);
void gr_handle_simple_event(XEvent *e);
void gr_enqueue_char(unsigned char c);
void gr_init_color_cache(void);

3
otherlibs/graph/make_img.c
View File

@ -15,8 +15,7 @@
#include "image.h"
#include <memory.h>
value gr_make_image(m)
value m;
value gr_make_image(value m)
{
int width, height;
value im;

39
otherlibs/graph/open.c
View File

@ -26,12 +26,11 @@ Display * grdisplay = NULL;
static Bool gr_initialized = False;
static int gr_error_handler();
static int gr_ioerror_handler();
value gr_clear_graph();
static int gr_error_handler(Display *display, XErrorEvent *error);
static int gr_ioerror_handler(Display *display);
value gr_clear_graph(void);
value gr_open_graph(arg)
value arg;
value gr_open_graph(value arg)
{
char display_name[64], geometry_spec[64];
char * p, * q;
@ -177,7 +176,7 @@ value gr_open_graph(arg)
return Val_unit;
}
value gr_close_graph()
value gr_close_graph(void)
{
if (gr_initialized) {
#ifdef USE_INTERVAL_TIMER
@ -197,7 +196,7 @@ value gr_close_graph()
return Val_unit;
}
value gr_clear_graph()
value gr_clear_graph(void)
{
gr_check_open();
XSetForeground(grdisplay, grwindow.gc, grwhite);
@ -212,13 +211,13 @@ value gr_clear_graph()
return Val_unit;
}
value gr_size_x()
value gr_size_x(void)
{
gr_check_open();
return Val_int(grwindow.w);
}
value gr_size_y()
value gr_size_y(void)
{
gr_check_open();
return Val_int(grwindow.h);
@ -231,15 +230,14 @@ value gr_size_y()
(There is no blocking primitives in this library, not even
wait_next_event, for various reasons.) */
void gr_handle_simple_event();
void gr_handle_simple_event(XEvent *e);
value gr_sigio_signal(unit)
value unit;
value gr_sigio_signal(value unit)
{
return Val_int(EVENT_SIGNAL);
}
value gr_sigio_handler()
value gr_sigio_handler(void)
{
XEvent grevent;
@ -253,8 +251,7 @@ value gr_sigio_handler()
return Val_unit;
}
void gr_handle_simple_event(e)
XEvent * e;
void gr_handle_simple_event(XEvent *e)
{
switch (e->type) {
@ -320,8 +317,7 @@ void gr_handle_simple_event(e)
static value * graphic_failure_exn = NULL;
void gr_fail(fmt, arg)
char * fmt, * arg;
void gr_fail(char *fmt, char *arg)
{
char buffer[1024];
@ -334,14 +330,12 @@ void gr_fail(fmt, arg)
raise_with_string(*graphic_failure_exn, buffer);
}
void gr_check_open()
void gr_check_open(void)
{
if (!gr_initialized) gr_fail("graphic screen not opened", NULL);
}
static int gr_error_handler(display, error)
Display * display;
XErrorEvent * error;
static int gr_error_handler(Display *display, XErrorEvent *error)
{
char errmsg[512];
XGetErrorText(error->display, error->error_code, errmsg, sizeof(errmsg));
@ -349,8 +343,7 @@ static int gr_error_handler(display, error)
return 0;
}
static int gr_ioerror_handler(display)
Display * display;
static int gr_ioerror_handler(Display *display)
{
gr_fail("fatal I/O error", NULL);
return 0;

3
otherlibs/graph/point_col.c
View File

@ -13,8 +13,7 @@
#include "libgraph.h"
value gr_point_color(vx, vy)
value vx, vy;
value gr_point_color(value vx, value vy)
{
int x = Int_val(vx);
int y = Int_val(vy);

3
otherlibs/graph/sound.c
View File

@ -13,8 +13,7 @@
#include "libgraph.h"
value gr_sound(vfreq, vdur)
value vfreq, vdur;
value gr_sound(value vfreq, value vdur)
{
XKeyboardControl kbdcontrol;

19
otherlibs/graph/text.c
View File

@ -17,8 +17,7 @@
XFontStruct * grfont = NULL;
static void gr_font(fontname)
char * fontname;
static void gr_font(char *fontname)
{
XFontStruct * font = XLoadQueryFont(grdisplay, fontname);
if (font == NULL) gr_fail("cannot find font %s", fontname);
@ -28,17 +27,14 @@ static void gr_font(fontname)
XSetFont(grdisplay, grbstore.gc, grfont->fid);
}
value gr_set_font(fontname)
value fontname;
value gr_set_font(value fontname)
{
gr_check_open();
gr_font(String_val(fontname));
return Val_unit;
}
static void gr_draw_text(txt, len)
char * txt;
int len;
static void gr_draw_text(char *txt, int len)
{
if (grfont == NULL) gr_font(DEFAULT_FONT);
XDrawString(grdisplay, grwindow.win, grwindow.gc,
@ -49,8 +45,7 @@ static void gr_draw_text(txt, len)
XFlush(grdisplay);
}
value gr_draw_char(chr)
value chr;
value gr_draw_char(value chr)
{
char str[1];
gr_check_open();
@ -59,16 +54,14 @@ value gr_draw_char(chr)
return Val_unit;
}
value gr_draw_string(str)
value str;
value gr_draw_string(value str)
{
gr_check_open();
gr_draw_text(String_val(str), string_length(str));
return Val_unit;
}
value gr_text_size(str)
value str;
value gr_text_size(value str)
{
int width;
value res;

117
otherlibs/num/nat_stubs.c
View File

@ -21,8 +21,7 @@
/* Stub code for the BigNum package. */
value create_nat(size) /* ML */
value size;
value create_nat(value size)
{
mlsize_t sz = Long_val(size);
@ -33,15 +32,13 @@ value create_nat(size) /* ML */
}
}
value set_to_zero_nat(nat, ofs, len) /* ML */
value nat, ofs, len;
value set_to_zero_nat(value nat, value ofs, value len)
{
BnSetToZero(Bignum_val(nat), Long_val(ofs), Long_val(len));
return Val_unit;
}
value blit_nat(nat1, ofs1, nat2, ofs2, len) /* ML */
value nat1, ofs1, nat2, ofs2, len;
value blit_nat(value nat1, value ofs1, value nat2, value ofs2, value len)
{
BnAssign(Bignum_val(nat1), Long_val(ofs1),
Bignum_val(nat2), Long_val(ofs2),
@ -49,111 +46,93 @@ value blit_nat(nat1, ofs1, nat2, ofs2, len) /* ML */
return Val_unit;
}
value set_digit_nat(nat, ofs, digit) /* ML */
value nat, ofs, digit;
value set_digit_nat(value nat, value ofs, value digit)
{
BnSetDigit(Bignum_val(nat), Long_val(ofs), Long_val(digit));
return Val_unit;
}
value nth_digit_nat(nat, ofs) /* ML */
value nat, ofs;
value nth_digit_nat(value nat, value ofs)
{
return Val_long(BnGetDigit(Bignum_val(nat), Long_val(ofs)));
}
value num_digits_nat(nat, ofs, len) /* ML */
value nat, ofs, len;
value num_digits_nat(value nat, value ofs, value len)
{
return Val_long(BnNumDigits(Bignum_val(nat), Long_val(ofs), Long_val(len)));
}
value num_leading_zero_bits_in_digit(nat, ofs) /* ML */
value nat, ofs;
value num_leading_zero_bits_in_digit(value nat, value ofs)
{
return
Val_long(BnNumLeadingZeroBitsInDigit(Bignum_val(nat), Long_val(ofs)));
}
value is_digit_int(nat, ofs) /* ML */
value nat, ofs;
value is_digit_int(value nat, value ofs)
{
return Val_bool(BnDoesDigitFitInWord(Bignum_val(nat), Long_val(ofs)));
}
value is_digit_zero(nat, ofs) /* ML */
value nat, ofs;
value is_digit_zero(value nat, value ofs)
{
return Val_bool(BnIsDigitZero(Bignum_val(nat), Long_val(ofs)));
}
value is_digit_normalized(nat, ofs) /* ML */
value nat, ofs;
value is_digit_normalized(value nat, value ofs)
{
return Val_bool(BnIsDigitNormalized(Bignum_val(nat), Long_val(ofs)));
}
value is_digit_odd(nat, ofs) /* ML */
value nat, ofs;
value is_digit_odd(value nat, value ofs)
{
return Val_bool(BnIsDigitOdd(Bignum_val(nat), Long_val(ofs)));
}
value incr_nat(nat, ofs, len, carry_in) /* ML */
value nat, ofs, len, carry_in;
value incr_nat(value nat, value ofs, value len, value carry_in)
{
return Val_long(BnAddCarry(Bignum_val(nat), Long_val(ofs),
Long_val(len), Long_val(carry_in)));
}
value add_nat_native(nat1, ofs1, len1, nat2, ofs2, len2, carry_in)
value nat1, ofs1, len1, nat2, ofs2, len2, carry_in;
value add_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value len2, value carry_in)
{
return Val_long(BnAdd(Bignum_val(nat1), Long_val(ofs1), Long_val(len1),
Bignum_val(nat2), Long_val(ofs2), Long_val(len2),
Long_val(carry_in)));
}
value add_nat(argv, argn) /* ML */
value * argv;
int argn;
value add_nat(value *argv, int argn)
{
return add_nat_native(argv[0], argv[1], argv[2], argv[3],
argv[4], argv[5], argv[6]);
}
value complement_nat(nat, ofs, len) /* ML */
value nat, ofs, len;
value complement_nat(value nat, value ofs, value len)
{
BnComplement(Bignum_val(nat), Long_val(ofs), Long_val(len));
return Val_unit;
}
value decr_nat(nat, ofs, len, carry_in) /* ML */
value nat, ofs, len, carry_in;
value decr_nat(value nat, value ofs, value len, value carry_in)
{
return Val_long(BnSubtractBorrow(Bignum_val(nat), Long_val(ofs),
Long_val(len), Long_val(carry_in)));
}
value sub_nat_native(nat1, ofs1, len1, nat2, ofs2, len2, carry_in)
value nat1, ofs1, len1, nat2, ofs2, len2, carry_in;
value sub_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value len2, value carry_in)
{
return Val_long(BnSubtract(Bignum_val(nat1), Long_val(ofs1), Long_val(len1),
Bignum_val(nat2), Long_val(ofs2), Long_val(len2),
Long_val(carry_in)));
}
value sub_nat(argv, argn) /* ML */
value * argv;
int argn;
value sub_nat(value *argv, int argn)
{
return sub_nat_native(argv[0], argv[1], argv[2], argv[3],
argv[4], argv[5], argv[6]);
}
value mult_digit_nat_native(nat1, ofs1, len1, nat2, ofs2, len2, nat3, ofs3)
value nat1, ofs1, len1, nat2, ofs2, len2, nat3, ofs3;
value mult_digit_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value len2, value nat3, value ofs3)
{
return
Val_long(BnMultiplyDigit(Bignum_val(nat1), Long_val(ofs1), Long_val(len1),
@ -161,16 +140,13 @@ value mult_digit_nat_native(nat1, ofs1, len1, nat2, ofs2, len2, nat3, ofs3)
Bignum_val(nat3), Long_val(ofs3)));
}
value mult_digit_nat(argv, argn) /* ML */
value * argv;
int argn;
value mult_digit_nat(value *argv, int argn)
{
return mult_digit_nat_native(argv[0], argv[1], argv[2], argv[3],
argv[4], argv[5], argv[6], argv[7]);
}
value mult_nat_native(nat1, ofs1, len1, nat2, ofs2, len2, nat3, ofs3, len3)
value nat1, ofs1, len1, nat2, ofs2, len2, nat3, ofs3, len3;
value mult_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value len2, value nat3, value ofs3, value len3)
{
return
Val_long(BnMultiply(Bignum_val(nat1), Long_val(ofs1), Long_val(len1),
@ -178,32 +154,26 @@ value mult_nat_native(nat1, ofs1, len1, nat2, ofs2, len2, nat3, ofs3, len3)
Bignum_val(nat3), Long_val(ofs3), Long_val(len3)));
}
value mult_nat(argv, argn) /* ML */
value * argv;
int argn;
value mult_nat(value *argv, int argn)
{
return mult_nat_native(argv[0], argv[1], argv[2], argv[3],
argv[4], argv[5], argv[6], argv[7], argv[8]);
}
value shift_left_nat_native(nat1, ofs1, len1, nat2, ofs2, nbits)
value nat1, ofs1, len1, nat2, ofs2, nbits;
value shift_left_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value nbits)
{
BnShiftLeft(Bignum_val(nat1), Long_val(ofs1), Long_val(len1),
Bignum_val(nat2), Long_val(ofs2), Long_val(nbits));
return Val_unit;
}
value shift_left_nat(argv, argn) /* ML */
value * argv;
int argn;
value shift_left_nat(value *argv, int argn)
{
return shift_left_nat_native(argv[0], argv[1], argv[2],
argv[3], argv[4], argv[5]);
}
value div_digit_nat_native(natq, ofsq, natr, ofsr, nat1, ofs1, len1, nat2, ofs2)
value natq, ofsq, natr, ofsr, nat1, ofs1, len1, nat2, ofs2;
value div_digit_nat_native(value natq, value ofsq, value natr, value ofsr, value nat1, value ofs1, value len1, value nat2, value ofs2)
{
BnDivideDigit(Bignum_val(natq), Long_val(ofsq),
Bignum_val(natr), Long_val(ofsr),
@ -212,86 +182,71 @@ value div_digit_nat_native(natq, ofsq, natr, ofsr, nat1, ofs1, len1, nat2, ofs2)
return Val_unit;
}
value div_digit_nat(argv, argn) /* ML */
value * argv;
int argn;
value div_digit_nat(value *argv, int argn)
{
return div_digit_nat_native(argv[0], argv[1], argv[2], argv[3],
argv[4], argv[5], argv[6], argv[7], argv[8]);
}
value div_nat_native(nat1, ofs1, len1, nat2, ofs2, len2)
value nat1, ofs1, len1, nat2, ofs2, len2;
value div_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value len2)
{
BnDivide(Bignum_val(nat1), Long_val(ofs1), Long_val(len1),
Bignum_val(nat2), Long_val(ofs2), Long_val(len2));
return Val_unit;
}
value div_nat(argv, argn) /* ML */
value * argv;
int argn;
value div_nat(value *argv, int argn)
{
return div_nat_native(argv[0], argv[1], argv[2],
argv[3], argv[4], argv[5]);
}
value shift_right_nat_native(nat1, ofs1, len1, nat2, ofs2, nbits)
value nat1, ofs1, len1, nat2, ofs2, nbits;
value shift_right_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value nbits)
{
BnShiftRight(Bignum_val(nat1), Long_val(ofs1), Long_val(len1),
Bignum_val(nat2), Long_val(ofs2), Long_val(nbits));
return Val_unit;
}
value shift_right_nat(argv, argn) /* ML */
value * argv;
int argn;
value shift_right_nat(value *argv, int argn)
{
return shift_right_nat_native(argv[0], argv[1], argv[2],
argv[3], argv[4], argv[5]);
}
value compare_digits_nat(nat1, ofs1, nat2, ofs2) /* ML */
value nat1, ofs1, nat2, ofs2;
value compare_digits_nat(value nat1, value ofs1, value nat2, value ofs2)
{
return Val_long(BnCompareDigits(Bignum_val(nat1), Long_val(ofs1),
Bignum_val(nat2), Long_val(ofs2)));
}
value compare_nat_native(nat1, ofs1, len1, nat2, ofs2, len2)
value nat1, ofs1, len1, nat2, ofs2, len2;
value compare_nat_native(value nat1, value ofs1, value len1, value nat2, value ofs2, value len2)
{
return Val_long(BnCompare(Bignum_val(nat1), Long_val(ofs1), Long_val(len1),
Bignum_val(nat2), Long_val(ofs2), Long_val(len2)));
}
value compare_nat(argv, argn) /* ML */
value * argv;
int argn;
value compare_nat(value *argv, int argn)
{
return compare_nat_native(argv[0], argv[1], argv[2],
argv[3], argv[4], argv[5]);
}
value land_digit_nat(nat1, ofs1, nat2, ofs2) /* ML */
value nat1, ofs1, nat2, ofs2;
value land_digit_nat(value nat1, value ofs1, value nat2, value ofs2)
{
BnAndDigits(Bignum_val(nat1), Long_val(ofs1),
Bignum_val(nat2), Long_val(ofs2));
return Val_unit;
}
value lor_digit_nat(nat1, ofs1, nat2, ofs2) /* ML */
value nat1, ofs1, nat2, ofs2;
value lor_digit_nat(value nat1, value ofs1, value nat2, value ofs2)
{
BnOrDigits(Bignum_val(nat1), Long_val(ofs1),
Bignum_val(nat2), Long_val(ofs2));
return Val_unit;
}
value lxor_digit_nat(nat1, ofs1, nat2, ofs2) /* ML */
value nat1, ofs1, nat2, ofs2;
value lxor_digit_nat(value nat1, value ofs1, value nat2, value ofs2)
{
BnXorDigits(Bignum_val(nat1), Long_val(ofs1),
Bignum_val(nat2), Long_val(ofs2));

29
otherlibs/str/strstubs.c
View File

@ -18,15 +18,14 @@ struct regexp_struct {
typedef struct regexp_struct * regexp;
static void free_regexp(vexpr)
value vexpr;
static void free_regexp(value vexpr)
{
regexp expr = (regexp) Bp_val(vexpr);
expr->re.translate = NULL;
regfree(&(expr->re));
}
static regexp alloc_regexp()
static regexp alloc_regexp(void)
{
value res =
alloc_final(sizeof(struct regexp_struct) / sizeof(value),
@ -38,8 +37,7 @@ static regexp alloc_regexp()
static char * case_fold_table = NULL;
value str_compile_regexp(src, fold) /* ML */
value src, fold;
value str_compile_regexp(value src, value fold) /* ML */
{
regexp expr;
char * msg;
@ -72,9 +70,7 @@ static regoff_t start_regs[10], end_regs[10];
static struct re_registers match_regs = { 10, start_regs, end_regs };
value str_string_match(expr, text, pos) /* ML */
regexp expr;
value text, pos;
value str_string_match(regexp expr, value text, value pos) /* ML */
{
switch (re_match(&(expr->re), String_val(text), string_length(text),
Int_val(pos), &match_regs)) {
@ -87,9 +83,7 @@ value str_string_match(expr, text, pos) /* ML */
}
}
value str_search_forward(expr, text, pos) /* ML */
regexp expr;
value text, pos;
value str_search_forward(regexp expr, value text, value pos) /* ML */
{
int len = string_length(text);
int start = Int_val(pos);
@ -105,9 +99,7 @@ value str_search_forward(expr, text, pos) /* ML */
}
}
value str_search_backward(expr, text, pos) /* ML */
regexp expr;
value text, pos;
value str_search_backward(regexp expr, value text, value pos) /* ML */
{
int len = string_length(text);
int start = Int_val(pos);
@ -123,20 +115,17 @@ value str_search_backward(expr, text, pos) /* ML */
}
}
value str_beginning_group(ngroup) /* ML */
value ngroup;
value str_beginning_group(value ngroup) /* ML */
{
return Val_int(start_regs[Int_val(ngroup)]);
}
value str_end_group(ngroup) /* ML */
value ngroup;
value str_end_group(value ngroup) /* ML */
{
return Val_int(end_regs[Int_val(ngroup)]);
}
value str_replacement_text(repl, orig) /* ML */
value repl, orig;
value str_replacement_text(value repl, value orig) /* ML */
{
value res;
mlsize_t len, n;

96
otherlibs/systhreads/posix.c
View File

@ -100,17 +100,16 @@ extern char * caml_exception_pointer;
/* Forward declarations */
value caml_mutex_new P((value));
value caml_mutex_lock P((value));
value caml_mutex_unlock P((value));
static void caml_pthread_check P((int, char *));
value caml_mutex_new (value);
value caml_mutex_lock (value);
value caml_mutex_unlock (value);
static void caml_pthread_check (int, char *);
/* Hook for scanning the stacks of the other threads */
static void (*prev_scan_roots_hook) P((scanning_action));
static void (*prev_scan_roots_hook) (scanning_action);
static void caml_thread_scan_roots(action)
scanning_action action;
static void caml_thread_scan_roots(scanning_action action)
{
caml_thread_t th;
@ -134,7 +133,7 @@ static void caml_thread_scan_roots(action)
static void (*prev_enter_blocking_section_hook) () = NULL;
static void (*prev_leave_blocking_section_hook) () = NULL;
static void caml_thread_enter_blocking_section()
static void caml_thread_enter_blocking_section(void)
{
if (prev_enter_blocking_section_hook != NULL)
(*prev_enter_blocking_section_hook)();
@ -158,7 +157,7 @@ static void caml_thread_enter_blocking_section()
pthread_mutex_unlock(&caml_mutex);
}
static void caml_thread_leave_blocking_section()
static void caml_thread_leave_blocking_section(void)
{
/* Re-acquire the global mutex */
pthread_mutex_lock(&caml_mutex);
@ -186,8 +185,7 @@ static void caml_thread_leave_blocking_section()
/* Hooks for I/O locking */
static void caml_io_mutex_free(chan)
struct channel * chan;
static void caml_io_mutex_free(struct channel *chan)
{
pthread_mutex_t * mutex = chan->mutex;
if (mutex != NULL) {
@ -196,8 +194,7 @@ static void caml_io_mutex_free(chan)
}
}
static void caml_io_mutex_lock(chan)
struct channel * chan;
static void caml_io_mutex_lock(struct channel *chan)
{
if (chan->mutex == NULL) {
pthread_mutex_t * mutex =
@ -211,14 +208,13 @@ static void caml_io_mutex_lock(chan)
pthread_setspecific(last_channel_locked_key, (void *) chan);
}
static void caml_io_mutex_unlock(chan)
struct channel * chan;
static void caml_io_mutex_unlock(struct channel *chan)
{
pthread_mutex_unlock(chan->mutex);
pthread_setspecific(last_channel_locked_key, NULL);
}
static void caml_io_mutex_unlock_exn()
static void caml_io_mutex_unlock_exn(void)
{
struct channel * chan = pthread_getspecific(last_channel_locked_key);
if (chan != NULL) caml_io_mutex_unlock(chan);
@ -226,7 +222,7 @@ static void caml_io_mutex_unlock_exn()
/* The "tick" thread fakes a SIGVTALRM signal at regular intervals. */
static void * caml_thread_tick()
static void * caml_thread_tick(void * arg)
{
struct timeval timeout;
while(1) {
@ -249,9 +245,9 @@ static void * caml_thread_tick()
/* Thread cleanup: remove the descriptor from the list and free
the stack space. */
static void caml_thread_cleanup(th)
caml_thread_t th;
static void caml_thread_cleanup(void * arg)
{
caml_thread_t th = (caml_thread_t) arg;
/* Signal that the thread has terminated */
caml_mutex_unlock(Terminated(th->descr));
/* Remove th from the doubly-linked list of threads */
@ -269,8 +265,7 @@ static void caml_thread_cleanup(th)
/* Initialize the thread machinery */
value caml_thread_initialize(unit) /* ML */
value unit;
value caml_thread_initialize(value unit) /* ML */
{
pthread_t tick_pthread;
pthread_attr_t attr;
@ -331,9 +326,9 @@ value caml_thread_initialize(unit) /* ML */
/* Create a thread */
static void * caml_thread_start(th)
caml_thread_t th;
static void * caml_thread_start(void * arg)
{
caml_thread_t th = (caml_thread_t) arg;
value clos;
/* Associate the thread descriptor with the thread */
@ -353,8 +348,7 @@ static void * caml_thread_start(th)
return 0;
}
value caml_thread_new(clos) /* ML */
value clos;
value caml_thread_new(value clos) /* ML */
{
pthread_attr_t attr;
caml_thread_t th;
@ -404,8 +398,7 @@ value caml_thread_new(clos) /* ML */
/* Return the current thread */
value caml_thread_self(unit) /* ML */
value unit;
value caml_thread_self(value unit) /* ML */
{
if (curr_thread == NULL) invalid_argument("Thread.self: not initialized");
return curr_thread->descr;
@ -413,16 +406,14 @@ value caml_thread_self(unit) /* ML */
/* Return the identifier of a thread */
value caml_thread_id(th) /* ML */
value th;
value caml_thread_id(value th) /* ML */
{
return Ident(th);
}
/* Allow re-scheduling */
value caml_thread_yield(unit) /* ML */
value unit;
value caml_thread_yield(value unit) /* ML */
{
enter_blocking_section();
sched_yield();
@ -432,8 +423,7 @@ value caml_thread_yield(unit) /* ML */
/* Suspend the current thread until another thread terminates */
value caml_thread_join(th) /* ML */
value th;
value caml_thread_join(value th) /* ML */
{
caml_mutex_lock(Terminated(th));
caml_mutex_unlock(Terminated(th));
@ -442,8 +432,7 @@ value caml_thread_join(th) /* ML */
/* Terminate the current thread */
value caml_thread_exit(unit) /* ML */
value unit;
value caml_thread_exit(value unit) /* ML */
{
pthread_exit(0);
return Val_unit; /* never reached */
@ -451,8 +440,7 @@ value caml_thread_exit(unit) /* ML */
/* Kill another thread */
value caml_thread_kill(th) /* ML */
caml_thread_t th;
value caml_thread_kill(caml_thread_t th) /* ML */
{
pthread_cancel(th->pthread);
return Val_unit;
@ -463,14 +451,12 @@ value caml_thread_kill(th) /* ML */
#define Mutex_val(v) (*((pthread_mutex_t *)(&Field(v, 1))))
#define Max_mutex_number 1000
static void caml_mutex_finalize(mut)
value mut;
static void caml_mutex_finalize(value mut)
{
pthread_mutex_destroy(&Mutex_val(mut));
}
value caml_mutex_new(unit) /* ML */
value unit;
value caml_mutex_new(value unit) /* ML */
{
value mut;
mut = alloc_final(1 + sizeof(pthread_mutex_t) / sizeof(value),
@ -480,8 +466,7 @@ value caml_mutex_new(unit) /* ML */
return mut;
}
value caml_mutex_lock(mut) /* ML */
value mut;
value caml_mutex_lock(value mut) /* ML */
{
int retcode;
enter_blocking_section();
@ -491,8 +476,7 @@ value caml_mutex_lock(mut) /* ML */
return Val_unit;
}
value caml_mutex_unlock(mut) /* ML */
value mut;
value caml_mutex_unlock(value mut) /* ML */
{
int retcode;
enter_blocking_section();
@ -502,8 +486,7 @@ value caml_mutex_unlock(mut) /* ML */
return Val_unit;
}
value caml_mutex_try_lock(mut) /* ML */
value mut;
value caml_mutex_try_lock(value mut) /* ML */
{
int retcode;
retcode = pthread_mutex_trylock(&(Mutex_val(mut)));
@ -517,14 +500,12 @@ value caml_mutex_try_lock(mut) /* ML */
#define Condition_val(v) (*((pthread_cond_t *)(&Field(v, 1))))
#define Max_condition_number 1000
static void caml_condition_finalize(cond)
value cond;
static void caml_condition_finalize(value cond)
{
pthread_cond_destroy(&Condition_val(cond));
}
value caml_condition_new(unit) /* ML */
value unit;
value caml_condition_new(value unit) /* ML */
{
value cond;
cond = alloc_final(1 + sizeof(pthread_cond_t) / sizeof(value),
@ -534,8 +515,7 @@ value caml_condition_new(unit) /* ML */
return cond;
}
value caml_condition_wait(cond, mut) /* ML */
value cond, mut;
value caml_condition_wait(value cond, value mut) /* ML */
{
int retcode;
enter_blocking_section();
@ -545,8 +525,7 @@ value caml_condition_wait(cond, mut) /* ML */
return Val_unit;
}
value caml_condition_signal(cond) /* ML */
value cond;
value caml_condition_signal(value cond) /* ML */
{
int retcode;
enter_blocking_section();
@ -556,8 +535,7 @@ value caml_condition_signal(cond) /* ML */
return Val_unit;
}
value caml_condition_broadcast(cond) /* ML */
value cond;
value caml_condition_broadcast(value cond) /* ML */
{
int retcode;
enter_blocking_section();
@ -569,9 +547,7 @@ value caml_condition_broadcast(cond) /* ML */
/* Error report */
static void caml_pthread_check(retcode, msg)
int retcode;
char * msg;
static void caml_pthread_check(int retcode, char *msg)
{
char * err;
int errlen, msglen;

93
otherlibs/systhreads/win32.c
View File

@ -102,14 +102,13 @@ extern char * caml_exception_pointer;
/* Forward declarations */
static void caml_wthread_error P((char * msg));
static void caml_wthread_error (char * msg);
/* Hook for scanning the stacks of the other threads */
static void (*prev_scan_roots_hook) P((scanning_action));
static void (*prev_scan_roots_hook) (scanning_action);
static void caml_thread_scan_roots(action)
scanning_action action;
static void caml_thread_scan_roots(scanning_action action)
{
caml_thread_t th;
@ -133,7 +132,7 @@ static void caml_thread_scan_roots(action)
static void (*prev_enter_blocking_section_hook) () = NULL;
static void (*prev_leave_blocking_section_hook) () = NULL;
static void caml_thread_enter_blocking_section()
static void caml_thread_enter_blocking_section(void)
{
if (prev_enter_blocking_section_hook != NULL)
(*prev_enter_blocking_section_hook)();
@ -157,7 +156,7 @@ static void caml_thread_enter_blocking_section()
ReleaseMutex(caml_mutex);
}
static void caml_thread_leave_blocking_section()
static void caml_thread_leave_blocking_section(void)
{
/* Re-acquire the global mutex */
WaitForSingleObject(caml_mutex, INFINITE);
@ -182,8 +181,7 @@ static void caml_thread_leave_blocking_section()
/* Hooks for I/O locking */
static void caml_io_mutex_free(chan)
struct channel * chan;
static void caml_io_mutex_free(struct channel * chan)
{
HANDLE mutex = chan->mutex;
if (mutex != NULL) {
@ -192,8 +190,7 @@ static void caml_io_mutex_free(chan)
}
}
static void caml_io_mutex_lock(chan)
struct channel * chan;
static void caml_io_mutex_lock(struct channel * chan)
{
if (chan->mutex == NULL) {
HANDLE mutex = CreateMutex(NULL, TRUE, NULL);
@ -206,21 +203,20 @@ static void caml_io_mutex_lock(chan)
last_channel_locked = chan;
}
static void caml_io_mutex_unlock(chan)
struct channel * chan;
static void caml_io_mutex_unlock(struct channel * chan)
{
ReleaseMutex((HANDLE) chan->mutex);
last_channel_locked = NULL;
}
static void caml_io_mutex_unlock_exn()
static void caml_io_mutex_unlock_exn(void)
{
if (last_channel_locked != NULL) caml_io_mutex_unlock(last_channel_locked);
}
/* The "tick" thread fakes a SIGVTALRM signal at regular intervals. */
static void * caml_thread_tick()
static void * caml_thread_tick(void)
{
while(1) {
Sleep(Thread_timeout);
@ -236,8 +232,7 @@ static void * caml_thread_tick()
/* Thread cleanup: remove the descriptor from the list and free
the stack space. */
static void caml_thread_cleanup(th)
caml_thread_t th;
static void caml_thread_cleanup(caml_thread_t th)
{
/* Remove th from the doubly-linked list of threads */
th->next->prev = th->prev;
@ -250,16 +245,14 @@ static void caml_thread_cleanup(th)
stat_free((char *) th);
}
static void caml_thread_finalize(vthread)
value vthread;
static void caml_thread_finalize(value vthread)
{
CloseHandle(((struct caml_thread_handle *)vthread)->handle);
}
/* Initialize the thread machinery */
value caml_thread_initialize(unit) /* ML */
value unit;
value caml_thread_initialize(value unit) /* ML */
{
pthread_t tick_pthread;
pthread_attr_t attr;
@ -318,8 +311,7 @@ value caml_thread_initialize(unit) /* ML */
/* Create a thread */
static void caml_thread_start(th)
caml_thread_t th;
static void caml_thread_start(caml_thread_t th)
{
value clos;
@ -335,8 +327,7 @@ static void caml_thread_start(th)
ReleaseMutex(caml_mutex);
}
value caml_thread_new(clos) /* ML */
value clos;
value caml_thread_new(value clos) /* ML */
{
pthread_attr_t attr;
caml_thread_t th;
@ -387,8 +378,7 @@ value caml_thread_new(clos) /* ML */
/* Return the current thread */
value caml_thread_self(unit) /* ML */
value unit;
value caml_thread_self(value unit) /* ML */
{
if (curr_thread == NULL) invalid_argument("Thread.self: not initialized");
return curr_thread->descr;
@ -396,16 +386,14 @@ value caml_thread_self(unit) /* ML */
/* Return the identifier of a thread */
value caml_thread_id(th) /* ML */
value th;
value caml_thread_id(value th) /* ML */
{
return Ident(th);
}
/* Allow re-scheduling */
value caml_thread_yield(unit) /* ML */
value unit;
value caml_thread_yield(value unit) /* ML */
{
enter_blocking_section();
Sleep(0);
@ -415,8 +403,7 @@ value caml_thread_yield(unit) /* ML */
/* Suspend the current thread until another thread terminates */
value caml_thread_join(th) /* ML */
value th;
value caml_thread_join(value th) /* ML */
{
HANDLE h = Threadhandle(th)->handle;
enter_blocking_section();
@ -427,8 +414,7 @@ value caml_thread_join(th) /* ML */
/* Terminate the current thread */
value caml_thread_exit(unit) /* ML */
value unit;
value caml_thread_exit(value unit) /* ML */
{
caml_thread_cleanup(curr_thread);
ReleaseMutex(caml_mutex);
@ -438,8 +424,7 @@ value caml_thread_exit(unit) /* ML */
/* Kill another thread */
value caml_thread_kill(target) /* ML */
value target;
value caml_thread_kill(value target) /* ML */
{
caml_thread_t th;
@ -457,14 +442,12 @@ value caml_thread_kill(target) /* ML */
#define Mutex_val(v) (*((HANDLE *)(&Field(v, 1))))
#define Max_mutex_number 1000
static void caml_mutex_finalize(mut)
value mut;
static void caml_mutex_finalize(value mut)
{
CloseHandle(Mutex_val(mut));
}
value caml_mutex_new(unit) /* ML */
value unit;
value caml_mutex_new(value unit) /* ML */
{
value mut;
mut = alloc_final(1 + sizeof(HANDLE) / sizeof(value),
@ -474,8 +457,7 @@ value caml_mutex_new(unit) /* ML */
return mut;
}
value caml_mutex_lock(mut) /* ML */
value mut;
value caml_mutex_lock(value mut) /* ML */
{
int retcode;
enter_blocking_section();
@ -485,8 +467,7 @@ value caml_mutex_lock(mut) /* ML */
return Val_unit;
}
value caml_mutex_unlock(mut) /* ML */
value mut;
value caml_mutex_unlock(value mut) /* ML */
{
BOOL retcode;
enter_blocking_section();
@ -496,8 +477,7 @@ value caml_mutex_unlock(mut) /* ML */
return Val_unit;
}
value caml_mutex_try_lock(mut) /* ML */
value mut;
value caml_mutex_try_lock(value mut) /* ML */
{
int retcode;
retcode = WaitForSingleObject(Mutex_val(mut), 0);
@ -508,8 +488,7 @@ value caml_mutex_try_lock(mut) /* ML */
/* Delay */
value caml_thread_delay(val) /* ML */
value val;
value caml_thread_delay(value val) /* ML */
{
enter_blocking_section();
Sleep((DWORD)(Double_val(val)*1000)); /* milliseconds */
@ -528,14 +507,12 @@ struct caml_condvar {
#define Condition_val(v) ((struct caml_condvar *)(v))
#define Max_condition_number 1000
static void caml_condition_finalize(cond)
value cond;
static void caml_condition_finalize(value cond)
{
CloseHandle(Condition_val(cond)->event);
}
value caml_condition_new(unit) /* ML */
value unit;
value caml_condition_new(value unit) /* ML */
{
value cond;
cond = alloc_final(sizeof(struct caml_condvar) / sizeof(value),
@ -547,8 +524,7 @@ value caml_condition_new(unit) /* ML */
return cond;
}
value caml_condition_wait(cond, mut) /* ML */
value cond, mut;
value caml_condition_wait(value cond, value mut) /* ML */
{
int retcode1, retcode2;
HANDLE m = Mutex_val(mut);
@ -568,8 +544,7 @@ value caml_condition_wait(cond, mut) /* ML */
return Val_unit;
}
value caml_condition_signal(cond) /* ML */
value cond;
value caml_condition_signal(value cond) /* ML */
{
HANDLE e = Condition_val(cond)->event;
@ -583,8 +558,7 @@ value caml_condition_signal(cond) /* ML */
return Val_unit;
}
value caml_condition_broadcast(cond) /* ML */
value cond;
value caml_condition_broadcast(value cond) /* ML */
{
HANDLE e = Condition_val(cond)->event;
unsigned long c = Condition_val(cond)->count;
@ -601,8 +575,7 @@ value caml_condition_broadcast(cond) /* ML */
/* Error report */
static void caml_wthread_error(msg)
char * msg;
static void caml_wthread_error(char * msg)
{
_dosmaperr(GetLastError());
sys_error(msg, NO_ARG);

70
otherlibs/threads/scheduler.c
View File

@ -118,10 +118,9 @@ static value next_ident = Val_int(0);
/* Scan the stacks of the other threads */
static void (*prev_scan_roots_hook) P((scanning_action));
static void (*prev_scan_roots_hook) (scanning_action);
static void thread_scan_roots(action)
scanning_action action;
static void thread_scan_roots(scanning_action action)
{
thread_t th;
@ -139,8 +138,7 @@ static void thread_scan_roots(action)
/* Initialize the thread machinery */
value thread_initialize(unit) /* ML */
value unit;
value thread_initialize(value unit) /* ML */
{
struct itimerval timer;
/* Create a descriptor for the current thread */
@ -176,8 +174,7 @@ value thread_initialize(unit) /* ML */
/* Create a thread */
value thread_new(clos) /* ML */
value clos;
value thread_new(value clos) /* ML */
{
thread_t th;
/* Allocate the thread and its stack */
@ -222,15 +219,14 @@ value thread_new(clos) /* ML */
/* Return the thread identifier */
value thread_id(th) /* ML */
value th;
value thread_id(value th) /* ML */
{
return ((struct thread_struct *)th)->ident;
}
/* Return the current time as a floating-point number */
static double timeofday()
static double timeofday(void)
{
struct timeval tv;
gettimeofday(&tv, NULL);
@ -242,11 +238,11 @@ static double timeofday()
#define FOREACH_THREAD(x) x = curr_thread; do { x = x->next;
#define END_FOREACH(x) } while (x != curr_thread)
static value alloc_process_status();
static void add_fdlist_to_set();
static value inter_fdlist_set();
static value alloc_process_status(int pid, int status);
static void add_fdlist_to_set(value fdl, fd_set *set);
static value inter_fdlist_set(value fdl, fd_set *set);
static value schedule_thread()
static value schedule_thread(void)
{
thread_t run_thread, th;
fd_set readfds, writefds, exceptfds;
@ -401,7 +397,7 @@ try_again:
/* Since context switching is not allowed in callbacks, a thread that
blocks during a callback is a deadlock. */
static void check_callback()
static void check_callback(void)
{
if (callback_depth > 0)
fatal_error("Thread: deadlock during callback");
@ -409,8 +405,7 @@ static void check_callback()
/* Reschedule without suspending the current thread */
value thread_yield(unit) /* ML */
value unit;
value thread_yield(value unit) /* ML */
{
Assert(curr_thread != NULL);
curr_thread->retval = Val_unit;
@ -419,8 +414,7 @@ value thread_yield(unit) /* ML */
/* Suspend the current thread */
value thread_sleep(unit) /* ML */
value unit;
value thread_sleep(value unit) /* ML */
{
Assert(curr_thread != NULL);
check_callback();
@ -430,8 +424,7 @@ value thread_sleep(unit) /* ML */
/* Suspend the current thread on a select() request */
value thread_select(arg) /* ML */
value arg;
value thread_select(value arg) /* ML */
{
double date;
/* Don't do an error if we're not initialized yet
@ -455,15 +448,13 @@ value thread_select(arg) /* ML */
/* Primitives to implement suspension on buffered channels */
value thread_inchan_ready(vchan) /* ML */
value vchan;
value thread_inchan_ready(value vchan) /* ML */
{
struct channel * chan = Channel(vchan);
return Val_bool(chan->curr < chan->max);
}
value thread_outchan_ready(vchan, vsize) /* ML */
value vchan, vsize;
value thread_outchan_ready(value vchan, value vsize) /* ML */
{
struct channel * chan = Channel(vchan);
long size = Long_val(vsize);
@ -481,8 +472,7 @@ value thread_outchan_ready(vchan, vsize) /* ML */
/* Suspend the current thread for some time */
value thread_delay(time) /* ML */
value time;
value thread_delay(value time) /* ML */
{
double date = timeofday() + Double_val(time);
Assert(curr_thread != NULL);
@ -494,8 +484,7 @@ value thread_delay(time) /* ML */
/* Suspend the current thread until another thread terminates */
value thread_join(th) /* ML */
value th;
value thread_join(value th) /* ML */
{
check_callback();
Assert(curr_thread != NULL);
@ -507,8 +496,7 @@ value thread_join(th) /* ML */
/* Suspend the current thread until a Unix process exits */
value thread_wait_pid(pid) /* ML */
value pid;
value thread_wait_pid(value pid) /* ML */
{
Assert(curr_thread != NULL);
check_callback();
@ -519,8 +507,7 @@ value thread_wait_pid(pid) /* ML */
/* Reactivate another thread */
value thread_wakeup(thread) /* ML */
value thread;
value thread_wakeup(value thread) /* ML */
{
thread_t th = (thread_t) thread;
switch (th->status) {
@ -538,8 +525,7 @@ value thread_wakeup(thread) /* ML */
/* Return the current thread */
value thread_self(unit) /* ML */
value unit;
value thread_self(value unit) /* ML */
{
Assert(curr_thread != NULL);
return (value) curr_thread;
@ -547,8 +533,7 @@ value thread_self(unit) /* ML */
/* Kill a thread */
value thread_kill(thread) /* ML */
value thread;
value thread_kill(value thread) /* ML */
{
value retval = Val_unit;
thread_t th = (thread_t) thread;
@ -574,9 +559,7 @@ value thread_kill(thread) /* ML */
/* Set a list of file descriptors in a fdset */
static void add_fdlist_to_set(fdl, set)
value fdl;
fd_set * set;
static void add_fdlist_to_set(value fdl, fd_set *set)
{
for (/*nothing*/; fdl != NO_FDS; fdl = Field(fdl, 1)) {
FD_SET(Int_val(Field(fdl, 0)), set);
@ -586,9 +569,7 @@ static void add_fdlist_to_set(fdl, set)
/* Build the intersection of a list and a fdset (the list of file descriptors
which are both in the list and in the fdset). */
static value inter_fdlist_set(fdl, set)
value fdl;
fd_set * set;
static value inter_fdlist_set(value fdl, fd_set *set)
{
value res = Val_unit;
value cons;
@ -624,8 +605,7 @@ static value inter_fdlist_set(fdl, set)
#define TAG_WSIGNALED 1
#define TAG_WSTOPPED 2
static value alloc_process_status(pid, status)
int pid, status;
static value alloc_process_status(int pid, int status)
{
value st, res;

5
otherlibs/unix/accept.c
View File

@ -21,8 +21,7 @@
#include "socketaddr.h"
value unix_accept(sock) /* ML */
value sock;
value unix_accept(value sock) /* ML */
{
int retcode;
value res;
@ -44,6 +43,6 @@ value unix_accept(sock) /* ML */
#else
value unix_accept() { invalid_argument("accept not implemented"); }
value unix_accept(value sock) { invalid_argument("accept not implemented"); }
#endif

Some files were not shown because too many files have changed in this diff Show More