snapshot, this version should work quite well
This commit is contained in:
marting
parent
7927367f49
commit
1d4d7d0e0c
22
Makefile
22
Makefile
|
|
@ -83,8 +83,8 @@ BIG_HEAP = -h 5000000
|
|||
# LINKER_RUNNABLE = $(LINKER_VM) -i $(IMAGE)
|
||||
|
||||
# JMG now according 2
|
||||
LINKER_VM = $(RUNNABLE) $(BIG_HEAP)
|
||||
LINKER_RUNNABLE = $(RUNNABLE)
|
||||
LINKER_VM = /home/ai/marting/lib/scheme48/scheme48vm $(BIG_HEAP)
|
||||
LINKER_RUNNABLE = s4853
|
||||
|
||||
LINKER_IMAGE = build/linker.image
|
||||
LINKER = $(LINKER_VM) -i $(LINKER_IMAGE)
|
||||
|
|
@ -96,7 +96,7 @@ START_LINKER = echo ',batch' && echo ',bench on'
|
|||
|
||||
# Targets:
|
||||
|
||||
IMAGE = scheme48.image
|
||||
IMAGE = scsh.image
|
||||
INITIAL = build/initial.image
|
||||
#JMG: renamed the vm
|
||||
#JMG: we need cig at the moment
|
||||
|
|
@ -329,6 +329,12 @@ inst-man:
|
|||
inst-inc:
|
||||
$(INSTALL_DATA) c/scheme48.h $(incdir)
|
||||
|
||||
install-cig: cig
|
||||
$(INSTALL_PROGRAM) $(srcdir)/$(CIG) $(LIB)/cig
|
||||
$(INSTALL_PROGRAM) $(srcdir)/$(CIG).image $(LIB)/cig
|
||||
$(INSTALL_DATA) $(srcdir)/$(LIBCIG) $(LIB)/cig
|
||||
$(INSTALL_DATA) $(srcdir)/cig/libcig.h $(LIB)/cig
|
||||
|
||||
inst-misc:
|
||||
for stub in env big opt misc link; do \
|
||||
for f in scheme/$$stub/*.scm; do \
|
||||
|
|
@ -542,7 +548,7 @@ link/linker-in-lucid: build/lucid-script.lisp $(linker-files) \
|
|||
# no debugging environment to speak of.
|
||||
|
||||
$(INITIAL): $(LINKER_IMAGE) $(CONFIG_FILES) build/initial.scm $(initial-files) \
|
||||
scsh/here.scm # gross and Olin hates it -bri
|
||||
scsh/here.scm # gross and Olin hates it -bri
|
||||
($(START_LINKER); \
|
||||
echo '(load-configuration "scheme/interfaces.scm")'; \
|
||||
echo '(load-configuration "scheme/packages.scm")'; \
|
||||
|
|
@ -827,11 +833,15 @@ scsh/scsh.image: $(VM) $(SCHEME) $(CIG).image
|
|||
echo ",open floatnums"; \
|
||||
echo ",open scsh"; \
|
||||
echo ",open list-lib string-lib ccp-lib"; \
|
||||
echo ",batch off"; \
|
||||
echo ",open scsh-top-package"; \
|
||||
echo ",keep names maps files source tabulate"; \
|
||||
echo ",dump scsh06.image"; \
|
||||
echo "(dump-scsh \"scsh/scsh.image\")" \
|
||||
echo ",batch off") \
|
||||
echo "(dump-scsh \"scsh/scsh.image\")"; \
|
||||
echo ",batch on") \
|
||||
| ./$(VM) -o ./$(VM) -i $(CIG).image -h 10000000
|
||||
|
||||
# echo ",build (lambda (args) ((scsh-stand-alone-resumer (make-scsh-starter)) args)) bla.image"; \
|
||||
#scsh/scsh.image: $(VM) $(SCHEME) $(CIG).image
|
||||
# (echo ",translate =scheme48/ $(srcdir)/"; \
|
||||
# echo ",batch on"; \
|
||||
|
|
|
|||
22
Makefile.in
22
Makefile.in
|
|
@ -83,8 +83,8 @@ BIG_HEAP = -h 5000000
|
|||
# LINKER_RUNNABLE = $(LINKER_VM) -i $(IMAGE)
|
||||
|
||||
# JMG now according 2
|
||||
LINKER_VM = $(RUNNABLE) $(BIG_HEAP)
|
||||
LINKER_RUNNABLE = $(RUNNABLE)
|
||||
LINKER_VM = /home/ai/marting/lib/scheme48/scheme48vm $(BIG_HEAP)
|
||||
LINKER_RUNNABLE = s4853
|
||||
|
||||
LINKER_IMAGE = build/linker.image
|
||||
LINKER = $(LINKER_VM) -i $(LINKER_IMAGE)
|
||||
|
|
@ -96,7 +96,7 @@ START_LINKER = echo ',batch' && echo ',bench on'
|
|||
|
||||
# Targets:
|
||||
|
||||
IMAGE = scheme48.image
|
||||
IMAGE = scsh.image
|
||||
INITIAL = build/initial.image
|
||||
#JMG: renamed the vm
|
||||
#JMG: we need cig at the moment
|
||||
|
|
@ -329,6 +329,12 @@ inst-man:
|
|||
inst-inc:
|
||||
$(INSTALL_DATA) c/scheme48.h $(incdir)
|
||||
|
||||
install-cig: cig
|
||||
$(INSTALL_PROGRAM) $(srcdir)/$(CIG) $(LIB)/cig
|
||||
$(INSTALL_PROGRAM) $(srcdir)/$(CIG).image $(LIB)/cig
|
||||
$(INSTALL_DATA) $(srcdir)/$(LIBCIG) $(LIB)/cig
|
||||
$(INSTALL_DATA) $(srcdir)/cig/libcig.h $(LIB)/cig
|
||||
|
||||
inst-misc:
|
||||
for stub in env big opt misc link; do \
|
||||
for f in scheme/$$stub/*.scm; do \
|
||||
|
|
@ -542,7 +548,7 @@ link/linker-in-lucid: build/lucid-script.lisp $(linker-files) \
|
|||
# no debugging environment to speak of.
|
||||
|
||||
$(INITIAL): $(LINKER_IMAGE) $(CONFIG_FILES) build/initial.scm $(initial-files) \
|
||||
scsh/here.scm # gross and Olin hates it -bri
|
||||
scsh/here.scm # gross and Olin hates it -bri
|
||||
($(START_LINKER); \
|
||||
echo '(load-configuration "scheme/interfaces.scm")'; \
|
||||
echo '(load-configuration "scheme/packages.scm")'; \
|
||||
|
|
@ -827,11 +833,15 @@ scsh/scsh.image: $(VM) $(SCHEME) $(CIG).image
|
|||
echo ",open floatnums"; \
|
||||
echo ",open scsh"; \
|
||||
echo ",open list-lib string-lib ccp-lib"; \
|
||||
echo ",batch off"; \
|
||||
echo ",open scsh-top-package"; \
|
||||
echo ",keep names maps files source tabulate"; \
|
||||
echo ",dump scsh06.image"; \
|
||||
echo "(dump-scsh \"scsh/scsh.image\")" \
|
||||
echo ",batch off") \
|
||||
echo "(dump-scsh \"scsh/scsh.image\")"; \
|
||||
echo ",batch on") \
|
||||
| ./$(VM) -o ./$(VM) -i $(CIG).image -h 10000000
|
||||
|
||||
# echo ",build (lambda (args) ((scsh-stand-alone-resumer (make-scsh-starter)) args)) bla.image"; \
|
||||
#scsh/scsh.image: $(VM) $(SCHEME) $(CIG).image
|
||||
# (echo ",translate =scheme48/ $(srcdir)/"; \
|
||||
# echo ",batch on"; \
|
||||
|
|
|
|||
10
acconfig.h
10
acconfig.h
|
|
@ -25,6 +25,16 @@
|
|||
*/
|
||||
#undef USCORE
|
||||
|
||||
/*
|
||||
* Define if your tm struct in <time.h> has a tm_gmtoff field.
|
||||
*/
|
||||
#undef HAVE_GMTOFF
|
||||
/*
|
||||
* Define if you have dlopen() and related routines (dynamic linking
|
||||
* of shared object files).
|
||||
*/
|
||||
#undef HAVE_DLOPEN 1
|
||||
|
||||
@BOTTOM@
|
||||
|
||||
#include "fake/sigact.h"
|
||||
|
|
|
|||
6639
build/initial.debug
6639
build/initial.debug
File diff suppressed because it is too large
Load Diff
Binary file not shown.
|
|
@ -3,6 +3,10 @@
|
|||
/* Define to empty if the keyword does not work. */
|
||||
#undef const
|
||||
|
||||
/* Define if you don't have tm_zone but do have the external array
|
||||
tzname. */
|
||||
#undef HAVE_TZNAME
|
||||
|
||||
/* Define if you need to in order for stat and other things to work. */
|
||||
#undef _POSIX_SOURCE
|
||||
|
||||
|
|
@ -12,31 +16,38 @@
|
|||
/*
|
||||
* HAVE_SIGACTION is defined iff sigaction() is available.
|
||||
*/
|
||||
#undef HAVE_SIGACTION
|
||||
#undef HAVE_SIGACTION
|
||||
|
||||
/*
|
||||
* HAVE_STRERROR is defined iff the standard libraries provide strerror().
|
||||
*/
|
||||
#undef HAVE_STRERROR
|
||||
#undef HAVE_STRERROR
|
||||
|
||||
/*
|
||||
* NLIST_HAS_N_NAME is defined iff a struct nlist has an n_name member.
|
||||
* If it doesn't then we assume it has an n_un member which, in turn,
|
||||
* has an n_name member.
|
||||
*/
|
||||
#undef NLIST_HAS_N_NAME
|
||||
#undef NLIST_HAS_N_NAME
|
||||
|
||||
/*
|
||||
* USCORE is defined iff C externals are prepended with an underscore.
|
||||
*/
|
||||
#undef USCORE
|
||||
#undef USCORE
|
||||
|
||||
/*
|
||||
* Define if your tm struct in <time.h> has a tm_gmtoff field.
|
||||
*/
|
||||
#undef HAVE_GMTOFF
|
||||
/*
|
||||
* Define if you have dlopen() and related routines (dynamic linking
|
||||
* of shared object files).
|
||||
*/
|
||||
#undef HAVE_DLOPEN 1
|
||||
|
||||
/* Define if you have the chroot function. */
|
||||
#undef HAVE_CHROOT
|
||||
|
||||
/* Define if you have the dlopen function. */
|
||||
#undef HAVE_DLOPEN
|
||||
|
||||
/* Define if you have the ftime function. */
|
||||
#undef HAVE_FTIME
|
||||
|
||||
|
|
|
|||
|
|
@ -27,6 +27,16 @@ static void when_sigpipe_interrupt();
|
|||
//JMG:
|
||||
static void when_child_interrupt();
|
||||
static void when_hup_interrupt();
|
||||
static void when_cont_interrupt();
|
||||
static void when_quit_interrupt();
|
||||
static void when_term_interrupt();
|
||||
static void when_tstp_interrupt();
|
||||
static void when_usr1_interrupt();
|
||||
static void when_usr2_interrupt();
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
bool s48_setcatcher(int signum, void (*catcher)(int));
|
||||
|
|
@ -736,7 +746,7 @@ enum scsh_os_signal{
|
|||
int
|
||||
s48_os_signal_pending(void) {
|
||||
if (child_interrupt_count > 0) {
|
||||
fprintf(stderr, "cld c %d \n", child_interrupt_count);
|
||||
// fprintf(stderr, "cld c %d", child_interrupt_count);
|
||||
block_interrupts();
|
||||
--child_interrupt_count;
|
||||
allow_interrupts();
|
||||
|
|
@ -745,7 +755,7 @@ s48_os_signal_pending(void) {
|
|||
return TRUE;
|
||||
}
|
||||
else if (hup_interrupt_count > 0){
|
||||
fprintf(stderr, "hup c %d \n", hup_interrupt_count);
|
||||
fprintf(stderr, "hup c %d", hup_interrupt_count);
|
||||
block_interrupts();
|
||||
--hup_interrupt_count;
|
||||
allow_interrupts();
|
||||
|
|
|
|||
32
configure.in
32
configure.in
|
|
@ -79,6 +79,36 @@ define(S48_USCORE, [dnl
|
|||
rm -f conftest.c a.out
|
||||
])dnl
|
||||
dnl
|
||||
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
AC_DEFUN(SCSH_TZNAME,[
|
||||
AC_MSG_CHECKING(for tzname)
|
||||
AC_CACHE_VAL(scsh_cv_tzname,[
|
||||
AC_TRY_COMPILE([#include <time.h>],
|
||||
[return (int) tzname;],
|
||||
scsh_cv_tzname=yes,
|
||||
scsh_cv_tzname=no)])
|
||||
AC_MSG_RESULT($scsh_cv_tzname)
|
||||
if test $scsh_cv_tzname = yes; then
|
||||
AC_DEFINE(HAVE_TZNAME)
|
||||
fi
|
||||
])
|
||||
|
||||
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
AC_DEFUN(SCSH_GMTOFF,[
|
||||
AC_MSG_CHECKING(for gmtoff)
|
||||
AC_CACHE_VAL(scsh_cv_gmtoff,[
|
||||
AC_TRY_COMPILE([#include <time.h>],
|
||||
[struct tm time;
|
||||
return time.tm_gmtoff;],
|
||||
scsh_cv_gmtoff=yes,
|
||||
scsh_cv_gmtoff=no)])
|
||||
AC_MSG_RESULT($scsh_cv_gmtoff)
|
||||
if test $scsh_cv_gmtoff = yes; then
|
||||
AC_DEFINE(HAVE_GMTOFF)
|
||||
fi
|
||||
])
|
||||
|
||||
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
AC_INIT(c/scheme48vm.c)
|
||||
AC_CONFIG_HEADER(c/sysdep.h)
|
||||
S48_PROG_CC
|
||||
|
|
@ -132,4 +162,6 @@ fail
|
|||
AC_SUBST(CFLAGS)
|
||||
AC_SUBST(LIBOBJS)
|
||||
AC_SUBST(LDFLAGS)
|
||||
SCSH_TZNAME
|
||||
SCSH_GMTOFF
|
||||
AC_OUTPUT(Makefile)
|
||||
|
|
|
|||
|
|
@ -446,6 +446,7 @@
|
|||
$current-input-port
|
||||
$current-output-port
|
||||
$current-error-port
|
||||
$current-noise-port
|
||||
;; end of additions. ;;
|
||||
char-ready?
|
||||
read-block write-block
|
||||
|
|
|
|||
|
|
@ -64,6 +64,8 @@
|
|||
|
||||
push-command-levels?
|
||||
|
||||
start-new-session
|
||||
|
||||
command-input
|
||||
command-output
|
||||
command-error-output
|
||||
|
|
|
|||
Binary file not shown.
Binary file not shown.
|
|
@ -1,5 +1,6 @@
|
|||
/* This is an Scheme48/C interface file,
|
||||
** automatically generated by cig.
|
||||
** automatically generated by a hacked version of cig 3.0.
|
||||
step 4
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
|
@ -11,51 +12,60 @@
|
|||
#include "../regexp/regex.h"
|
||||
#include "re1.h"
|
||||
|
||||
scheme_value df_compile_re(long nargs, scheme_value *args)
|
||||
s48_value df_compile_re(s48_value g1, s48_value g2, s48_value mv_vec)
|
||||
{
|
||||
extern int compile_re(scheme_value , int , regex_t* *);
|
||||
scheme_value ret1;
|
||||
extern int compile_re(s48_value , int , regex_t* *);
|
||||
s48_value ret1;
|
||||
int r1;
|
||||
regex_t* r2;
|
||||
|
||||
cig_check_nargs(3, nargs, "compile_re");
|
||||
r1 = compile_re(args[2], EXTRACT_BOOLEAN(args[1]), &r2);
|
||||
ret1 = ENTER_FIXNUM(r1);
|
||||
AlienVal(VECTOR_REF(*args,0)) = (long) r2;
|
||||
|
||||
r1 = compile_re(g1, EXTRACT_BOOLEAN(g2), &r2);
|
||||
ret1 = s48_enter_integer(r1);
|
||||
SetAlienVal(S48_VECTOR_REF(mv_vec,0),(long) r2);//simple-assign
|
||||
return ret1;
|
||||
}
|
||||
}
|
||||
|
||||
scheme_value df_re_search(long nargs, scheme_value *args)
|
||||
s48_value df_re_search(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6, s48_value g7)
|
||||
{
|
||||
extern scheme_value re_search(const regex_t *, scheme_value , int , scheme_value , int , scheme_value , scheme_value );
|
||||
scheme_value ret1;
|
||||
scheme_value r1;
|
||||
extern s48_value re_search(const regex_t *, s48_value , int , s48_value , int , s48_value , s48_value );
|
||||
s48_value ret1;
|
||||
s48_value r1;
|
||||
|
||||
cig_check_nargs(7, nargs, "re_search");
|
||||
r1 = re_search((const regex_t *)AlienVal(args[6]), args[5], EXTRACT_FIXNUM(args[4]), args[3], EXTRACT_FIXNUM(args[2]), args[1], args[0]);
|
||||
|
||||
r1 = re_search((const regex_t *)AlienVal(g1), g2, s48_extract_integer(g3), g4, s48_extract_integer(g5), g6, g7);
|
||||
ret1 = r1;
|
||||
return ret1;
|
||||
}
|
||||
}
|
||||
|
||||
scheme_value df_re_errint2str(long nargs, scheme_value *args)
|
||||
s48_value df_re_errint2str(s48_value g1, s48_value g2, s48_value mv_vec)
|
||||
{
|
||||
extern const char *re_errint2str(int , const regex_t *);
|
||||
scheme_value ret1;
|
||||
s48_value ret1;
|
||||
const char *r1;
|
||||
|
||||
cig_check_nargs(3, nargs, "re_errint2str");
|
||||
r1 = re_errint2str(EXTRACT_FIXNUM(args[2]), (const regex_t *)AlienVal(args[1]));
|
||||
ret1 = VECTOR_REF(*args,0);
|
||||
{AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);}
|
||||
|
||||
r1 = re_errint2str(s48_extract_integer(g1), (const regex_t *)AlienVal(g2));
|
||||
ret1 = S48_VECTOR_REF(mv_vec,0);
|
||||
SetAlienVal(S48_CAR(ret1),(long) r1); S48_SET_CDR(ret1,strlen_or_false(r1));//str-and-len
|
||||
return ret1;
|
||||
}
|
||||
}
|
||||
|
||||
scheme_value df_free_re(long nargs, scheme_value *args)
|
||||
s48_value df_free_re(s48_value g1)
|
||||
{
|
||||
extern void free_re(regex_t* );
|
||||
|
||||
cig_check_nargs(1, nargs, "free_re");
|
||||
free_re((regex_t* )AlienVal(args[0]));
|
||||
return SCHFALSE;
|
||||
}
|
||||
|
||||
free_re((regex_t* )AlienVal(g1));
|
||||
return S48_FALSE;
|
||||
}
|
||||
|
||||
s48_value s48_init_re_low(void)
|
||||
{
|
||||
S48_EXPORT_FUNCTION(df_compile_re);
|
||||
S48_EXPORT_FUNCTION(df_re_search);
|
||||
S48_EXPORT_FUNCTION(df_re_errint2str);
|
||||
S48_EXPORT_FUNCTION(df_free_re);
|
||||
|
||||
return S48_UNSPECIFIC;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -113,6 +113,7 @@
|
|||
(export close
|
||||
close-after
|
||||
current-error-port
|
||||
error-output-port
|
||||
dup
|
||||
dup->inport
|
||||
dup->outport
|
||||
|
|
@ -127,7 +128,7 @@
|
|||
init-fdports! ;added by JMG
|
||||
|
||||
force-output
|
||||
; set-port-buffering
|
||||
set-port-buffering
|
||||
bufpol/block
|
||||
bufpol/line
|
||||
bufpol/none
|
||||
|
|
@ -1099,7 +1100,14 @@
|
|||
|
||||
(define-interface event-interface
|
||||
(export most-recent-event
|
||||
most-recent-event?
|
||||
|
||||
next-event
|
||||
event-type
|
||||
|
||||
wait-interrupt
|
||||
wait-interrupt-set
|
||||
nonblockwait-interrupt
|
||||
nonblockwait-interrupt-set
|
||||
|
||||
install-event-handlers!))
|
||||
|
|
@ -28,14 +28,14 @@
|
|||
|
||||
(define-structure error-package (export error warn)
|
||||
(open signals)
|
||||
(optimize auto-integrate)
|
||||
; (optimize auto-integrate)
|
||||
)
|
||||
|
||||
|
||||
(define-structure scsh-utilities scsh-utilities-interface
|
||||
(open bitwise error-package loopholes let-opt scheme)
|
||||
(files utilities)
|
||||
(optimize auto-integrate)
|
||||
; (optimize auto-integrate)
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -49,7 +49,7 @@
|
|||
scheme
|
||||
)
|
||||
(files syntax-helpers)
|
||||
(optimize auto-integrate)
|
||||
; (optimize auto-integrate)
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -57,7 +57,7 @@
|
|||
(define-structure buffered-io-flags buffered-io-flags-interface
|
||||
(open defenum-package scheme)
|
||||
(files (machine bufpol))
|
||||
(optimize auto-integrate)
|
||||
; (optimize auto-integrate)
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -68,7 +68,7 @@
|
|||
scsh-utilities ; For DEPRECATED-PROC
|
||||
scheme)
|
||||
(files char-set)
|
||||
(optimize auto-integrate)
|
||||
; (optimize auto-integrate)
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -76,7 +76,7 @@
|
|||
(scsh-internal-tty-flags scsh-internal-tty-flags-interface))
|
||||
(open scheme ascii bitwise)
|
||||
(files (machine tty-consts))
|
||||
(optimize auto-integrate)
|
||||
; (optimize auto-integrate)
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -91,7 +91,8 @@
|
|||
|
||||
$current-input-port
|
||||
$current-output-port
|
||||
$current-error-port)
|
||||
$current-error-port
|
||||
$current-noise-port)
|
||||
(open ports i/o))
|
||||
|
||||
(define-structure signal-handler signal-handler-interface
|
||||
|
|
@ -234,7 +235,7 @@
|
|||
sighandlers ; New in release 0.5.
|
||||
scsh
|
||||
; re
|
||||
rdelim ;rdelim omitted for now by JMG
|
||||
rdelim
|
||||
)
|
||||
; (optimize auto-integrate)
|
||||
)
|
||||
|
|
@ -243,21 +244,24 @@
|
|||
(open records scheme)
|
||||
(for-syntax (open scheme error-package receiving))
|
||||
(files defrec)
|
||||
(optimize auto-integrate)
|
||||
; (optimize auto-integrate)
|
||||
)
|
||||
|
||||
(define-structure defenum-package (export (define-enum-constant :syntax)
|
||||
(define-enum-constants :syntax))
|
||||
(open scheme)
|
||||
(files enumconst)
|
||||
(optimize auto-integrate)
|
||||
; (optimize auto-integrate)
|
||||
)
|
||||
|
||||
;;; This code opens so many modules of gruesome, low-level S48 internals
|
||||
;;; that these two modules are segregated into separate packages, each
|
||||
;;; exporting just two definitions.
|
||||
|
||||
(define-structure scsh-startup-package (export dump-scsh-program dump-scsh)
|
||||
(define-structure scsh-startup-package (export dump-scsh-program
|
||||
dump-scsh
|
||||
make-scsh-starter
|
||||
scsh-stand-alone-resumer)
|
||||
(open scsh-level-0-internals ; init-scsh-* set-command-line-args!
|
||||
scsh-level-0 ; error-output-port command-line-arguments
|
||||
scsh-top-package ; parse-switches-and-execute
|
||||
|
|
@ -267,6 +271,7 @@
|
|||
build-internals ; simple-condition-handler
|
||||
low-level ; flush-the-symbol-table!
|
||||
command-processor ; command-output
|
||||
package-commands-internal
|
||||
filenames ; translate
|
||||
usual-resumer ; usual-resumer
|
||||
fluids-internal ; JMG: get-dynamic-env
|
||||
|
|
@ -276,7 +281,8 @@
|
|||
scheme)
|
||||
(files startup))
|
||||
|
||||
(define-structure scsh-top-package (export parse-switches-and-execute repl)
|
||||
(define-structure scsh-top-package (export parse-switches-and-execute
|
||||
repl )
|
||||
(open command-processor
|
||||
command-levels ; with-new-session
|
||||
char-set-package
|
||||
|
|
@ -289,7 +295,7 @@
|
|||
|
||||
fluids-internal ; JMG: get-dynamic-env
|
||||
handle ; JMG: with-handler
|
||||
|
||||
; package-commands
|
||||
interrupts
|
||||
i/o
|
||||
package-commands-internal
|
||||
|
|
@ -332,7 +338,8 @@
|
|||
scheme
|
||||
)
|
||||
(files awk)
|
||||
(optimize auto-integrate))
|
||||
; (optimize auto-integrate)
|
||||
)
|
||||
|
||||
|
||||
(define-structure awk-package awk-interface
|
||||
|
|
@ -376,7 +383,7 @@
|
|||
|
||||
(access scsh-top-package)
|
||||
(begin (define repl (structure-ref scsh-top-package repl)))
|
||||
(optimize auto-integrate)
|
||||
; (optimize auto-integrate)
|
||||
)
|
||||
|
||||
(define-structure scsh-here-string-hax (export)
|
||||
|
|
|
|||
|
|
@ -19,8 +19,8 @@ s48_value df_sig2interrupt(s48_value g1)
|
|||
int r1;
|
||||
|
||||
|
||||
r1 = sig2interrupt(s48_extract_fixnum(g1));
|
||||
ret1 = s48_enter_fixnum(r1);
|
||||
r1 = sig2interrupt(s48_extract_integer(g1));
|
||||
ret1 = s48_enter_integer(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
||||
|
|
@ -44,8 +44,8 @@ s48_value df_scsh_set_sig(s48_value g1, s48_value g2, s48_value g3, s48_value mv
|
|||
|
||||
r1 = scsh_set_sig(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), &r2, &r3);
|
||||
ret1 = r1;
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
|
||||
S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
|
||||
S48_VECTOR_SET(mv_vec,1,s48_enter_integer(r3));
|
||||
return ret1;
|
||||
}
|
||||
|
||||
|
|
@ -60,8 +60,8 @@ s48_value df_scsh_get_sig(s48_value g1, s48_value mv_vec)
|
|||
|
||||
r1 = scsh_get_sig(s48_extract_fixnum(g1), &r2, &r3);
|
||||
ret1 = r1;
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
|
||||
S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
|
||||
S48_VECTOR_SET(mv_vec,1,s48_enter_integer(r3));
|
||||
return ret1;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -64,7 +64,9 @@
|
|||
;(define-simple-syntax (with-enabled-interrupts mask body ...)
|
||||
; (with-interrupts mask (lambda () body ...)))
|
||||
(define-simple-syntax (with-enabled-interrupts mask body ...)
|
||||
(begin body ...))
|
||||
(begin
|
||||
;(display "JMG: use of w-e-i")
|
||||
body ...))
|
||||
|
||||
(define (with-enabled-interrupts* thunk thunk)
|
||||
(warn "JMG: use of with-enabled-interrupts*")
|
||||
|
|
@ -127,23 +129,15 @@
|
|||
((< sig 0))
|
||||
(set-scsh-os-signal-handler!
|
||||
sig
|
||||
(lambda (x) (display "default handler was called"))))
|
||||
(lambda (x) #t)))
|
||||
|
||||
|
||||
|
||||
(begin
|
||||
(set-interrupt-handler!
|
||||
(enum interrupt os-signal)
|
||||
(lambda (type arg enabled-interrupts)
|
||||
(display type)
|
||||
|
||||
(newline)
|
||||
(display arg)
|
||||
(newline)
|
||||
(display enabled-interrupts)
|
||||
(newline)
|
||||
(if (= type (enum scsh-os-signal chld))
|
||||
(begin
|
||||
(display "will call proc")
|
||||
(procobj-handler enabled-interrupts)))
|
||||
((scsh-os-signal-handler-ref type) enabled-interrupts)
|
||||
))
|
||||
|
|
|
|||
|
|
@ -74,10 +74,10 @@ s48_value df_fork(s48_value mv_vec)
|
|||
|
||||
s48_value df_wait_pid(s48_value g1, s48_value g2, s48_value mv_vec)
|
||||
{
|
||||
extern s48_value wait_pid(int , int , int *, int *);
|
||||
extern s48_value wait_pid(pid_t , int , pid_t *, int *);
|
||||
s48_value ret1;
|
||||
s48_value r1;
|
||||
int r2;
|
||||
pid_t r2;
|
||||
int r3;
|
||||
|
||||
|
||||
|
|
@ -300,13 +300,13 @@ s48_value df_umask(s48_value g1)
|
|||
|
||||
s48_value df_process_times(s48_value mv_vec)
|
||||
{
|
||||
extern int process_times(int *, int *, int *, int *);
|
||||
extern int process_times(clock_t *, clock_t *, clock_t *, clock_t *);
|
||||
s48_value ret1;
|
||||
int r1;
|
||||
int r2;
|
||||
int r3;
|
||||
int r4;
|
||||
int r5;
|
||||
clock_t r2;
|
||||
clock_t r3;
|
||||
clock_t r4;
|
||||
clock_t r5;
|
||||
|
||||
|
||||
r1 = process_times(&r2, &r3, &r4, &r5);
|
||||
|
|
@ -326,7 +326,7 @@ s48_value df_cpu_clock_ticks_per_sec(void)
|
|||
|
||||
|
||||
r1 = cpu_clock_ticks_per_sec();
|
||||
ret1 = s48_enter_fixnum(r1);
|
||||
ret1 = s48_enter_integer(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
||||
|
|
@ -385,7 +385,7 @@ s48_value df_access(s48_value g1, s48_value g2)
|
|||
int r1;
|
||||
|
||||
|
||||
r1 = access(s48_extract_string(g1), s48_extract_fixnum(g2));
|
||||
r1 = access(s48_extract_string(g1), s48_extract_integer(g2));
|
||||
ret1 = ENTER_BOOLEAN(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
|
@ -463,14 +463,14 @@ s48_value df_rmdir(s48_value g1)
|
|||
return ret1;
|
||||
}
|
||||
|
||||
s48_value df_scm_utime(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5)
|
||||
s48_value df_scm_utime(s48_value g1, s48_value g2, s48_value g3)
|
||||
{
|
||||
extern int scm_utime(const char *, int , int , int , int );
|
||||
extern int scm_utime(const char *, time_t , time_t );
|
||||
s48_value ret1;
|
||||
int r1;
|
||||
|
||||
|
||||
r1 = scm_utime(s48_extract_string(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5));
|
||||
r1 = scm_utime(s48_extract_string(g1), s48_extract_integer(g2), s48_extract_integer(g3));
|
||||
ret1 = errno_or_false(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
|
@ -506,7 +506,7 @@ s48_value df_scheme_fstat(s48_value g1, s48_value g2)
|
|||
int r1;
|
||||
|
||||
|
||||
r1 = scheme_fstat(s48_extract_fixnum(g1), g2);
|
||||
r1 = scheme_fstat(s48_extract_integer(g1), g2);
|
||||
ret1 = False_on_zero(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
|
@ -698,7 +698,7 @@ s48_value df_write_fdes_char(s48_value g1, s48_value g2)
|
|||
|
||||
s48_value df_read_fdes_substring(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value mv_vec)
|
||||
{
|
||||
extern int read_fdes_substring(s48_value , int , int , int );
|
||||
extern int read_fdes_substring(s48_value , size_t , size_t , int );
|
||||
s48_value ret1;
|
||||
int r1;
|
||||
|
||||
|
|
@ -711,7 +711,7 @@ s48_value df_read_fdes_substring(s48_value g1, s48_value g2, s48_value g3, s48_v
|
|||
|
||||
s48_value df_write_fdes_substring(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value mv_vec)
|
||||
{
|
||||
extern int write_fdes_substring(s48_value , int , int , int );
|
||||
extern int write_fdes_substring(s48_value , size_t , size_t , int );
|
||||
s48_value ret1;
|
||||
int r1;
|
||||
|
||||
|
|
@ -750,7 +750,7 @@ s48_value df_alarm(s48_value g1)
|
|||
unsigned int r1;
|
||||
|
||||
|
||||
r1 = alarm(s48_extract_fixnum(g1));
|
||||
r1 = alarm(s48_extract_integer(g1));
|
||||
ret1 = s48_enter_fixnum(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
|
@ -805,7 +805,7 @@ s48_value df_group_info_gid(s48_value g1, s48_value mv_vec)
|
|||
int r4;
|
||||
|
||||
|
||||
r1 = group_info_gid(s48_extract_fixnum(g1), &r2, &r3, &r4);
|
||||
r1 = group_info_gid(s48_extract_integer(g1), &r2, &r3, &r4);
|
||||
ret1 = ENTER_BOOLEAN(r1);
|
||||
SetAlienVal(S48_CAR(S48_VECTOR_REF(mv_vec,0)),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2));//str-and-len
|
||||
SetAlienVal(S48_VECTOR_REF(mv_vec,1),(long) r3);//simple-assign
|
||||
|
|
@ -825,7 +825,7 @@ s48_value df_group_info_name(s48_value g1, s48_value mv_vec)
|
|||
|
||||
r1 = group_info_name(s48_extract_string(g1), &r2, &r3, &r4);
|
||||
ret1 = ENTER_BOOLEAN(r1);
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
|
||||
SetAlienVal(S48_VECTOR_REF(mv_vec,1),(long) r3);//simple-assign
|
||||
S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4));
|
||||
return ret1;
|
||||
|
|
@ -956,14 +956,14 @@ s48_value df_fcntl_write(s48_value g1, s48_value g2, s48_value g3)
|
|||
return ret1;
|
||||
}
|
||||
|
||||
s48_value df_sleep_until(s48_value g1, s48_value g2)
|
||||
s48_value df_sleep_until(s48_value g1)
|
||||
{
|
||||
extern s48_value sleep_until(int , int );
|
||||
extern s48_value sleep_until(time_t );
|
||||
s48_value ret1;
|
||||
s48_value r1;
|
||||
|
||||
|
||||
r1 = sleep_until(s48_extract_fixnum(g1), s48_extract_fixnum(g2));
|
||||
r1 = sleep_until(s48_extract_integer(g1));
|
||||
ret1 = r1;
|
||||
return ret1;
|
||||
}
|
||||
|
|
@ -988,7 +988,7 @@ s48_value df_errno_msg(s48_value g1, s48_value mv_vec)
|
|||
char *r1;
|
||||
|
||||
|
||||
r1 = errno_msg(s48_extract_fixnum(g1));
|
||||
r1 = errno_msg(s48_extract_integer(g1));
|
||||
ret1 = S48_VECTOR_REF(mv_vec,0);
|
||||
SetAlienVal(S48_CAR(ret1),(long) r1); S48_SET_CDR(ret1,strlen_or_false(r1));//str-and-len
|
||||
return ret1;
|
||||
|
|
|
|||
26
scsh/time.c
26
scsh/time.c
|
|
@ -30,39 +30,35 @@ s48_value df_time_plus_ticks(s48_value mv_vec)
|
|||
|
||||
s48_value df_scheme_time(s48_value mv_vec)
|
||||
{
|
||||
extern s48_value scheme_time(int *, int *);
|
||||
extern s48_value scheme_time(time_t *);
|
||||
s48_value ret1;
|
||||
s48_value r1;
|
||||
int r2;
|
||||
int r3;
|
||||
time_t r2;
|
||||
|
||||
|
||||
r1 = scheme_time(&r2, &r3);
|
||||
r1 = scheme_time(&r2);
|
||||
ret1 = r1;
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
|
||||
S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
|
||||
return ret1;
|
||||
}
|
||||
|
||||
s48_value df_date2time(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6, s48_value g7, s48_value g8, s48_value g9, s48_value mv_vec)
|
||||
{
|
||||
extern s48_value date2time(int , int , int , int , int , int , s48_value , s48_value , int , int *, int *);
|
||||
extern s48_value date2time(int , int , int , int , int , int , s48_value , s48_value , int , time_t *);
|
||||
s48_value ret1;
|
||||
s48_value r1;
|
||||
int r2;
|
||||
int r3;
|
||||
time_t r2;
|
||||
|
||||
|
||||
r1 = date2time(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5), s48_extract_fixnum(g6), g7, g8, EXTRACT_BOOLEAN(g9), &r2, &r3);
|
||||
r1 = date2time(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5), s48_extract_fixnum(g6), g7, g8, EXTRACT_BOOLEAN(g9), &r2);
|
||||
ret1 = r1;
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
|
||||
S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
|
||||
return ret1;
|
||||
}
|
||||
|
||||
s48_value df_time2date(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec)
|
||||
s48_value df_time2date(s48_value g1, s48_value g2, s48_value mv_vec)
|
||||
{
|
||||
extern s48_value time2date(int , int , s48_value , int *, int *, int *, int *, int *, int *, const char **, int *, int *, int *, int *);
|
||||
extern s48_value time2date(time_t , s48_value , int *, int *, int *, int *, int *, int *, const char **, int *, int *, int *, int *);
|
||||
s48_value ret1;
|
||||
s48_value r1;
|
||||
int r2;
|
||||
|
|
@ -78,7 +74,7 @@ s48_value df_time2date(s48_value g1, s48_value g2, s48_value g3, s48_value mv_ve
|
|||
int r12;
|
||||
|
||||
|
||||
r1 = time2date(s48_extract_fixnum(g1), s48_extract_fixnum(g2), g3, &r2, &r3, &r4, &r5, &r6, &r7, &r8, &r9, &r10, &r11, &r12);
|
||||
r1 = time2date(s48_extract_integer(g1), g2, &r2, &r3, &r4, &r5, &r6, &r7, &r8, &r9, &r10, &r11, &r12);
|
||||
ret1 = r1;
|
||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
|
||||
S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
|
||||
|
|
|
|||
|
|
@ -200,6 +200,7 @@
|
|||
(format-date "~a ~b ~d ~H:~M:~S ~Y" date))
|
||||
|
||||
(define (format-date fmt date)
|
||||
(warn "format-date called, this will fail since it calls with 13 args")
|
||||
(check-arg date? date format-date)
|
||||
(receive (err result)
|
||||
(%format-date/errno fmt
|
||||
|
|
|
|||
Loading…
Reference in New Issue