You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
383 lines
13 KiB
383 lines
13 KiB
Index: labltk-8.06.2/support/cltkCaml.c
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/support/cltkCaml.c
|
|
+++ labltk-8.06.2/support/cltkCaml.c
|
|
@@ -39,7 +39,7 @@ int CamlCBCmd(ClientData clientdata, Tcl
|
|
int id;
|
|
if (Tcl_GetInt(interp, argv[1], &id) != TCL_OK)
|
|
return TCL_ERROR;
|
|
- callback2(*handler_code,Val_int(id),
|
|
+ caml_callback2(*handler_code,Val_int(id),
|
|
copy_string_list(argc - 2,(char **)&argv[2]));
|
|
/* Never fails (OCaml would have raised an exception) */
|
|
/* but result may have been set by callback */
|
|
@@ -65,7 +65,7 @@ CAMLprim value camltk_return (value v)
|
|
/* Note: raise_with_string WILL copy the error message */
|
|
CAMLprim void tk_error(const char *errmsg)
|
|
{
|
|
- raise_with_string(*tkerror_exn, errmsg);
|
|
+ caml_raise_with_string(*tkerror_exn, errmsg);
|
|
}
|
|
|
|
|
|
Index: labltk-8.06.2/support/cltkDMain.c
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/support/cltkDMain.c
|
|
+++ labltk-8.06.2/support/cltkDMain.c
|
|
@@ -56,7 +56,7 @@ void invoke_pending_caml_signals (client
|
|
/* Rearm timer */
|
|
Tk_CreateTimerHandler(SIGNAL_INTERVAL, invoke_pending_caml_signals, NULL);
|
|
signal_events = 1;
|
|
- leave_blocking_section();
|
|
+ caml_leave_blocking_section();
|
|
}
|
|
/* The following is taken from byterun/startup.c */
|
|
header_t atom_table[256];
|
|
@@ -222,10 +222,10 @@ int Caml_Init(interp)
|
|
strcat(f, RCNAME);
|
|
if (0 == access(f,R_OK))
|
|
if (TCL_OK != Tcl_EvalFile(cltclinterp,f)) {
|
|
- stat_free(f);
|
|
+ caml_stat_free(f);
|
|
tk_error(Tcl_GetStringResult(cltclinterp));
|
|
};
|
|
- stat_free(f);
|
|
+ caml_stat_free(f);
|
|
}
|
|
}
|
|
|
|
Index: labltk-8.06.2/support/cltkEval.c
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/support/cltkEval.c
|
|
+++ labltk-8.06.2/support/cltkEval.c
|
|
@@ -45,7 +45,7 @@ value copy_string_list(int argc, char **
|
|
for (i = argc-1; i >= 0; i--) {
|
|
oldres = res;
|
|
str = tcl_string_to_caml(argv[i]);
|
|
- res = alloc(2, 0);
|
|
+ res = caml_alloc(2, 0);
|
|
Field(res, 0) = str;
|
|
Field(res, 1) = oldres;
|
|
}
|
|
@@ -71,7 +71,7 @@ CAMLprim value camltk_tcl_eval(value str
|
|
Tcl_ResetResult(cltclinterp);
|
|
cmd = caml_string_to_tcl(str);
|
|
code = Tcl_Eval(cltclinterp, cmd);
|
|
- stat_free(cmd);
|
|
+ caml_stat_free(cmd);
|
|
|
|
switch (code) {
|
|
case TCL_OK:
|
|
@@ -143,8 +143,8 @@ int fill_args (char **argv, int where, v
|
|
fill_args(tmpargv,0,Field(v,0));
|
|
tmpargv[size] = NULL;
|
|
merged = Tcl_Merge(size,(const char *const*)tmpargv);
|
|
- for(i = 0; i<size; i++){ stat_free(tmpargv[i]); }
|
|
- stat_free((char *)tmpargv);
|
|
+ for(i = 0; i<size; i++){ caml_stat_free(tmpargv[i]); }
|
|
+ caml_stat_free((char *)tmpargv);
|
|
/* must be freed by stat_free */
|
|
argv[where] = (char*)caml_stat_alloc(strlen(merged)+1);
|
|
strcpy(argv[where], merged);
|
|
@@ -227,10 +227,10 @@ CAMLprim value camltk_tcl_direct_eval(va
|
|
|
|
/* Free the various things we allocated */
|
|
for(i=0; i< size; i ++){
|
|
- stat_free((char *) allocated[i]);
|
|
+ caml_stat_free((char *) allocated[i]);
|
|
}
|
|
- stat_free((char *)argv);
|
|
- stat_free((char *)allocated);
|
|
+ caml_stat_free((char *)argv);
|
|
+ caml_stat_free((char *)allocated);
|
|
|
|
switch (result) {
|
|
case TCL_OK:
|
|
Index: labltk-8.06.2/support/cltkEvent.c
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/support/cltkEvent.c
|
|
+++ labltk-8.06.2/support/cltkEvent.c
|
|
@@ -49,6 +49,6 @@ CAMLprim value camltk_dooneevent(value f
|
|
|
|
CheckInit();
|
|
|
|
- ret = Tk_DoOneEvent(convert_flag_list(flags, event_flag_table));
|
|
+ ret = Tk_DoOneEvent(caml_convert_flag_list(flags, event_flag_table));
|
|
return Val_int(ret);
|
|
}
|
|
Index: labltk-8.06.2/support/cltkFile.c
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/support/cltkFile.c
|
|
+++ labltk-8.06.2/support/cltkFile.c
|
|
@@ -33,7 +33,7 @@
|
|
|
|
void FileProc(ClientData clientdata, int mask)
|
|
{
|
|
- callback2(*handler_code,Val_int(clientdata),Val_int(0));
|
|
+ caml_callback2(*handler_code,Val_int(clientdata),Val_int(0));
|
|
}
|
|
|
|
/* Map Unix.file_descr values to Tcl file handles */
|
|
Index: labltk-8.06.2/support/cltkImg.c
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/support/cltkImg.c
|
|
+++ labltk-8.06.2/support/cltkImg.c
|
|
@@ -47,7 +47,7 @@ CAMLprim value camltk_getimgdata (value
|
|
|
|
code = Tk_PhotoGetImage(ph,&pib); /* never fails ? */
|
|
size = pib.width * pib.height * pib.pixelSize;
|
|
- res = alloc_string(size);
|
|
+ res = caml_alloc_string(size);
|
|
|
|
/* no holes, default format ? */
|
|
if ((pib.pixelSize == 3) &&
|
|
Index: labltk-8.06.2/support/cltkMain.c
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/support/cltkMain.c
|
|
+++ labltk-8.06.2/support/cltkMain.c
|
|
@@ -51,11 +51,11 @@ int signal_events = 0; /* do we have a p
|
|
void invoke_pending_caml_signals (ClientData clientdata)
|
|
{
|
|
signal_events = 0;
|
|
- enter_blocking_section(); /* triggers signal handling */
|
|
+ caml_enter_blocking_section(); /* triggers signal handling */
|
|
/* Rearm timer */
|
|
Tk_CreateTimerHandler(SIGNAL_INTERVAL, invoke_pending_caml_signals, NULL);
|
|
signal_events = 1;
|
|
- leave_blocking_section();
|
|
+ caml_leave_blocking_section();
|
|
}
|
|
|
|
/* Now the real Tk stuff */
|
|
@@ -77,7 +77,7 @@ CAMLprim value camltk_opentk(value argv)
|
|
tmp = Val_unit;
|
|
|
|
if ( argv == Val_int(0) ){
|
|
- failwith("camltk_opentk: argv is empty");
|
|
+ caml_failwith("camltk_opentk: argv is empty");
|
|
}
|
|
argv0 = String_val( Field( argv, 0 ) );
|
|
|
|
@@ -91,7 +91,7 @@ CAMLprim value camltk_opentk(value argv)
|
|
/* Register cltclinterp for use in other related extensions */
|
|
value *interp = caml_named_value("cltclinterp");
|
|
if (interp != NULL)
|
|
- Store_field(*interp,0,copy_nativeint((intnat)cltclinterp));
|
|
+ Store_field(*interp,0,caml_copy_nativeint((intnat)cltclinterp));
|
|
}
|
|
|
|
if (Tcl_Init(cltclinterp) != TCL_OK)
|
|
@@ -128,7 +128,7 @@ CAMLprim value camltk_opentk(value argv)
|
|
args = Tcl_Merge(argc, (const char *const*)tkargv); /* args must be freed by Tcl_Free */
|
|
Tcl_SetVar(cltclinterp, "argv", args, TCL_GLOBAL_ONLY);
|
|
Tcl_Free(args);
|
|
- stat_free( tkargv );
|
|
+ caml_stat_free( tkargv );
|
|
}
|
|
}
|
|
if (Tk_Init(cltclinterp) != TCL_OK)
|
|
@@ -164,10 +164,10 @@ CAMLprim value camltk_opentk(value argv)
|
|
strcat(f, RCNAME);
|
|
if (0 == access(f,R_OK))
|
|
if (TCL_OK != Tcl_EvalFile(cltclinterp,f)) {
|
|
- stat_free(f);
|
|
+ caml_stat_free(f);
|
|
tk_error(Tcl_GetStringResult(cltclinterp));
|
|
};
|
|
- stat_free(f);
|
|
+ caml_stat_free(f);
|
|
}
|
|
}
|
|
|
|
Index: labltk-8.06.2/support/cltkMisc.c
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/support/cltkMisc.c
|
|
+++ labltk-8.06.2/support/cltkMisc.c
|
|
@@ -41,12 +41,12 @@ CAMLprim value camltk_splitlist (value v
|
|
{ value res = copy_string_list(argc,argv);
|
|
Tcl_Free((char *)argv); /* only one large block was allocated */
|
|
/* argv points into utf: utf must be freed after argv are freed */
|
|
- stat_free( utf );
|
|
+ caml_stat_free( utf );
|
|
return res;
|
|
}
|
|
case TCL_ERROR:
|
|
default:
|
|
- stat_free( utf );
|
|
+ caml_stat_free( utf );
|
|
tk_error(Tcl_GetStringResult(cltclinterp));
|
|
}
|
|
}
|
|
@@ -54,7 +54,7 @@ CAMLprim value camltk_splitlist (value v
|
|
/* Copy an OCaml string to the C heap. Should deallocate with stat_free */
|
|
char *string_to_c(value s)
|
|
{
|
|
- int l = string_length(s);
|
|
+ int l = caml_string_length(s);
|
|
char *res = caml_stat_alloc(l + 1);
|
|
memmove (res, String_val (s), l);
|
|
res[l] = '\0';
|
|
Index: labltk-8.06.2/support/cltkTimer.c
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/support/cltkTimer.c
|
|
+++ labltk-8.06.2/support/cltkTimer.c
|
|
@@ -26,7 +26,7 @@
|
|
/* Basically the same thing as FileProc */
|
|
void TimerProc (ClientData clientdata)
|
|
{
|
|
- callback2(*handler_code,Val_long(clientdata),Val_int(0));
|
|
+ caml_callback2(*handler_code,Val_long(clientdata),Val_int(0));
|
|
}
|
|
|
|
CAMLprim value camltk_add_timer(value milli, value cbid)
|
|
Index: labltk-8.06.2/support/cltkUtf.c
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/support/cltkUtf.c
|
|
+++ labltk-8.06.2/support/cltkUtf.c
|
|
@@ -76,14 +76,14 @@ value tcl_string_to_caml( const char *s
|
|
char *str;
|
|
|
|
str = utf_to_external( s );
|
|
- res = copy_string(str);
|
|
- stat_free(str);
|
|
+ res = caml_copy_string(str);
|
|
+ caml_stat_free(str);
|
|
CAMLreturn(res);
|
|
}
|
|
|
|
#else
|
|
|
|
char *caml_string_to_tcl(value s){ return string_to_c(s); }
|
|
-value tcl_string_to_caml(char *s){ return copy_string(s); }
|
|
+value tcl_string_to_caml(char *s){ return caml_copy_string(s); }
|
|
|
|
#endif
|
|
Index: labltk-8.06.2/support/cltkVar.c
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/support/cltkVar.c
|
|
+++ labltk-8.06.2/support/cltkVar.c
|
|
@@ -35,7 +35,7 @@ CAMLprim value camltk_getvar(value var)
|
|
stable_var = string_to_c(var);
|
|
s = (char *)Tcl_GetVar(cltclinterp,stable_var,
|
|
TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
|
|
- stat_free(stable_var);
|
|
+ caml_stat_free(stable_var);
|
|
|
|
if (s == NULL)
|
|
tk_error(Tcl_GetStringResult(cltclinterp));
|
|
@@ -57,11 +57,11 @@ CAMLprim value camltk_setvar(value var,
|
|
utf_contents = caml_string_to_tcl(contents);
|
|
s = (char *)Tcl_SetVar(cltclinterp,stable_var, utf_contents,
|
|
TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
|
|
- stat_free(stable_var);
|
|
+ caml_stat_free(stable_var);
|
|
if( s == utf_contents ){
|
|
tk_error("camltk_setvar: Tcl_SetVar returned strange result. Call the author of mlTk!");
|
|
}
|
|
- stat_free(utf_contents);
|
|
+ caml_stat_free(utf_contents);
|
|
|
|
if (s == NULL)
|
|
tk_error(Tcl_GetStringResult(cltclinterp));
|
|
@@ -84,7 +84,7 @@ static char * tracevar(clientdata, inter
|
|
Tcl_UntraceVar2(interp, name1, name2,
|
|
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
|
|
tracevar, clientdata);
|
|
- callback2(*handler_code,Val_int(clientdata),Val_unit);
|
|
+ caml_callback2(*handler_code,Val_int(clientdata),Val_unit);
|
|
return (char *)NULL;
|
|
}
|
|
|
|
@@ -103,10 +103,10 @@ CAMLprim value camltk_trace_var(value va
|
|
tracevar,
|
|
(ClientData) (Long_val(cbid)))
|
|
!= TCL_OK) {
|
|
- stat_free(cvar);
|
|
+ caml_stat_free(cvar);
|
|
tk_error(Tcl_GetStringResult(cltclinterp));
|
|
};
|
|
- stat_free(cvar);
|
|
+ caml_stat_free(cvar);
|
|
return Val_unit;
|
|
}
|
|
|
|
@@ -123,6 +123,6 @@ CAMLprim value camltk_untrace_var(value
|
|
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
|
|
tracevar,
|
|
(ClientData) (Long_val(cbid)));
|
|
- stat_free(cvar);
|
|
+ caml_stat_free(cvar);
|
|
return Val_unit;
|
|
}
|
|
Index: labltk-8.06.2/support/cltkWait.c
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/support/cltkWait.c
|
|
+++ labltk-8.06.2/support/cltkWait.c
|
|
@@ -54,8 +54,8 @@ static void WaitVisibilityProc(clientDat
|
|
Tk_DeleteEventHandler(vis->win, VisibilityChangeMask,
|
|
WaitVisibilityProc, clientData);
|
|
|
|
- stat_free((char *)vis);
|
|
- callback2(*handler_code,cbid,Val_int(0));
|
|
+ caml_stat_free((char *)vis);
|
|
+ caml_callback2(*handler_code,cbid,Val_int(0));
|
|
}
|
|
|
|
/* Sets up a callback upon Visibility of a window */
|
|
@@ -65,7 +65,7 @@ CAMLprim value camltk_wait_vis(value win
|
|
(struct WinCBData *)caml_stat_alloc(sizeof(struct WinCBData));
|
|
vis->win = Tk_NameToWindow(cltclinterp, String_val(win), cltk_mainWindow);
|
|
if (vis -> win == NULL) {
|
|
- stat_free((char *)vis);
|
|
+ caml_stat_free((char *)vis);
|
|
tk_error(Tcl_GetStringResult(cltclinterp));
|
|
};
|
|
vis->cbid = Int_val(cbid);
|
|
@@ -79,9 +79,9 @@ static void WaitWindowProc(ClientData cl
|
|
if (eventPtr->type == DestroyNotify) {
|
|
struct WinCBData *vis = clientData;
|
|
value cbid = Val_int(vis->cbid);
|
|
- stat_free((char *)clientData);
|
|
+ caml_stat_free((char *)clientData);
|
|
/* The handler is destroyed by Tk itself */
|
|
- callback2(*handler_code,cbid,Val_int(0));
|
|
+ caml_callback2(*handler_code,cbid,Val_int(0));
|
|
}
|
|
}
|
|
|
|
@@ -92,7 +92,7 @@ CAMLprim value camltk_wait_des(value win
|
|
(struct WinCBData *)caml_stat_alloc(sizeof(struct WinCBData));
|
|
vis->win = Tk_NameToWindow(cltclinterp, String_val(win), cltk_mainWindow);
|
|
if (vis -> win == NULL) {
|
|
- stat_free((char *)vis);
|
|
+ caml_stat_free((char *)vis);
|
|
tk_error(Tcl_GetStringResult(cltclinterp));
|
|
};
|
|
vis->cbid = Int_val(cbid);
|
|
Index: labltk-8.06.2/browser/searchpos.ml
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/browser/searchpos.ml
|
|
+++ labltk-8.06.2/browser/searchpos.ml
|
|
@@ -782,7 +782,7 @@ and search_pos_expr ~pos exp =
|
|
search_pos_expr exp' ~pos
|
|
end;
|
|
search_pos_expr exp ~pos
|
|
- | Texp_function (_, l, _) ->
|
|
+ | Texp_function { arg_label = _; param = _ ; cases = l; partial = _; } ->
|
|
List.iter l ~f:(search_case ~pos)
|
|
| Texp_apply (exp, l) ->
|
|
List.iter l ~f:(fun (_, x) -> Misc.may (search_pos_expr ~pos) x);
|
|
Index: labltk-8.06.2/jpf/fileselect.ml
|
|
===================================================================
|
|
--- labltk-8.06.2.orig/jpf/fileselect.ml
|
|
+++ labltk-8.06.2/jpf/fileselect.ml
|
|
@@ -55,7 +55,7 @@ let myentry_create p ~variable =
|
|
let subshell cmd =
|
|
let r,w = pipe () in
|
|
match fork () with
|
|
- 0 -> close r; dup2 ~src:w ~dst:stdout;
|
|
+ 0 -> close r; dup2 ~cloexec:false ~src:w ~dst:stdout;
|
|
execv ~prog:"/bin/sh" ~args:[| "/bin/sh"; "-c"; cmd |]
|
|
| id ->
|
|
close w;
|