snapshot, this version should work quite well
This commit is contained in:
parent
7927367f49
commit
1d4d7d0e0c
20
Makefile
20
Makefile
|
@ -83,8 +83,8 @@ BIG_HEAP = -h 5000000
|
||||||
# LINKER_RUNNABLE = $(LINKER_VM) -i $(IMAGE)
|
# LINKER_RUNNABLE = $(LINKER_VM) -i $(IMAGE)
|
||||||
|
|
||||||
# JMG now according 2
|
# JMG now according 2
|
||||||
LINKER_VM = $(RUNNABLE) $(BIG_HEAP)
|
LINKER_VM = /home/ai/marting/lib/scheme48/scheme48vm $(BIG_HEAP)
|
||||||
LINKER_RUNNABLE = $(RUNNABLE)
|
LINKER_RUNNABLE = s4853
|
||||||
|
|
||||||
LINKER_IMAGE = build/linker.image
|
LINKER_IMAGE = build/linker.image
|
||||||
LINKER = $(LINKER_VM) -i $(LINKER_IMAGE)
|
LINKER = $(LINKER_VM) -i $(LINKER_IMAGE)
|
||||||
|
@ -96,7 +96,7 @@ START_LINKER = echo ',batch' && echo ',bench on'
|
||||||
|
|
||||||
# Targets:
|
# Targets:
|
||||||
|
|
||||||
IMAGE = scheme48.image
|
IMAGE = scsh.image
|
||||||
INITIAL = build/initial.image
|
INITIAL = build/initial.image
|
||||||
#JMG: renamed the vm
|
#JMG: renamed the vm
|
||||||
#JMG: we need cig at the moment
|
#JMG: we need cig at the moment
|
||||||
|
@ -329,6 +329,12 @@ inst-man:
|
||||||
inst-inc:
|
inst-inc:
|
||||||
$(INSTALL_DATA) c/scheme48.h $(incdir)
|
$(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:
|
inst-misc:
|
||||||
for stub in env big opt misc link; do \
|
for stub in env big opt misc link; do \
|
||||||
for f in scheme/$$stub/*.scm; do \
|
for f in scheme/$$stub/*.scm; do \
|
||||||
|
@ -827,11 +833,15 @@ scsh/scsh.image: $(VM) $(SCHEME) $(CIG).image
|
||||||
echo ",open floatnums"; \
|
echo ",open floatnums"; \
|
||||||
echo ",open scsh"; \
|
echo ",open scsh"; \
|
||||||
echo ",open list-lib string-lib ccp-lib"; \
|
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 scsh06.image"; \
|
||||||
echo "(dump-scsh \"scsh/scsh.image\")" \
|
echo "(dump-scsh \"scsh/scsh.image\")"; \
|
||||||
echo ",batch off") \
|
echo ",batch on") \
|
||||||
| ./$(VM) -o ./$(VM) -i $(CIG).image -h 10000000
|
| ./$(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
|
#scsh/scsh.image: $(VM) $(SCHEME) $(CIG).image
|
||||||
# (echo ",translate =scheme48/ $(srcdir)/"; \
|
# (echo ",translate =scheme48/ $(srcdir)/"; \
|
||||||
# echo ",batch on"; \
|
# echo ",batch on"; \
|
||||||
|
|
20
Makefile.in
20
Makefile.in
|
@ -83,8 +83,8 @@ BIG_HEAP = -h 5000000
|
||||||
# LINKER_RUNNABLE = $(LINKER_VM) -i $(IMAGE)
|
# LINKER_RUNNABLE = $(LINKER_VM) -i $(IMAGE)
|
||||||
|
|
||||||
# JMG now according 2
|
# JMG now according 2
|
||||||
LINKER_VM = $(RUNNABLE) $(BIG_HEAP)
|
LINKER_VM = /home/ai/marting/lib/scheme48/scheme48vm $(BIG_HEAP)
|
||||||
LINKER_RUNNABLE = $(RUNNABLE)
|
LINKER_RUNNABLE = s4853
|
||||||
|
|
||||||
LINKER_IMAGE = build/linker.image
|
LINKER_IMAGE = build/linker.image
|
||||||
LINKER = $(LINKER_VM) -i $(LINKER_IMAGE)
|
LINKER = $(LINKER_VM) -i $(LINKER_IMAGE)
|
||||||
|
@ -96,7 +96,7 @@ START_LINKER = echo ',batch' && echo ',bench on'
|
||||||
|
|
||||||
# Targets:
|
# Targets:
|
||||||
|
|
||||||
IMAGE = scheme48.image
|
IMAGE = scsh.image
|
||||||
INITIAL = build/initial.image
|
INITIAL = build/initial.image
|
||||||
#JMG: renamed the vm
|
#JMG: renamed the vm
|
||||||
#JMG: we need cig at the moment
|
#JMG: we need cig at the moment
|
||||||
|
@ -329,6 +329,12 @@ inst-man:
|
||||||
inst-inc:
|
inst-inc:
|
||||||
$(INSTALL_DATA) c/scheme48.h $(incdir)
|
$(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:
|
inst-misc:
|
||||||
for stub in env big opt misc link; do \
|
for stub in env big opt misc link; do \
|
||||||
for f in scheme/$$stub/*.scm; do \
|
for f in scheme/$$stub/*.scm; do \
|
||||||
|
@ -827,11 +833,15 @@ scsh/scsh.image: $(VM) $(SCHEME) $(CIG).image
|
||||||
echo ",open floatnums"; \
|
echo ",open floatnums"; \
|
||||||
echo ",open scsh"; \
|
echo ",open scsh"; \
|
||||||
echo ",open list-lib string-lib ccp-lib"; \
|
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 scsh06.image"; \
|
||||||
echo "(dump-scsh \"scsh/scsh.image\")" \
|
echo "(dump-scsh \"scsh/scsh.image\")"; \
|
||||||
echo ",batch off") \
|
echo ",batch on") \
|
||||||
| ./$(VM) -o ./$(VM) -i $(CIG).image -h 10000000
|
| ./$(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
|
#scsh/scsh.image: $(VM) $(SCHEME) $(CIG).image
|
||||||
# (echo ",translate =scheme48/ $(srcdir)/"; \
|
# (echo ",translate =scheme48/ $(srcdir)/"; \
|
||||||
# echo ",batch on"; \
|
# echo ",batch on"; \
|
||||||
|
|
10
acconfig.h
10
acconfig.h
|
@ -25,6 +25,16 @@
|
||||||
*/
|
*/
|
||||||
#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
|
||||||
|
|
||||||
@BOTTOM@
|
@BOTTOM@
|
||||||
|
|
||||||
#include "fake/sigact.h"
|
#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. */
|
/* Define to empty if the keyword does not work. */
|
||||||
#undef const
|
#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. */
|
/* Define if you need to in order for stat and other things to work. */
|
||||||
#undef _POSIX_SOURCE
|
#undef _POSIX_SOURCE
|
||||||
|
|
||||||
|
@ -31,12 +35,19 @@
|
||||||
*/
|
*/
|
||||||
#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. */
|
/* Define if you have the chroot function. */
|
||||||
#undef HAVE_CHROOT
|
#undef HAVE_CHROOT
|
||||||
|
|
||||||
/* Define if you have the dlopen function. */
|
|
||||||
#undef HAVE_DLOPEN
|
|
||||||
|
|
||||||
/* Define if you have the ftime function. */
|
/* Define if you have the ftime function. */
|
||||||
#undef HAVE_FTIME
|
#undef HAVE_FTIME
|
||||||
|
|
||||||
|
|
|
@ -27,6 +27,16 @@ static void when_sigpipe_interrupt();
|
||||||
//JMG:
|
//JMG:
|
||||||
static void when_child_interrupt();
|
static void when_child_interrupt();
|
||||||
static void when_hup_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));
|
bool s48_setcatcher(int signum, void (*catcher)(int));
|
||||||
|
@ -736,7 +746,7 @@ enum scsh_os_signal{
|
||||||
int
|
int
|
||||||
s48_os_signal_pending(void) {
|
s48_os_signal_pending(void) {
|
||||||
if (child_interrupt_count > 0) {
|
if (child_interrupt_count > 0) {
|
||||||
fprintf(stderr, "cld c %d \n", child_interrupt_count);
|
// fprintf(stderr, "cld c %d", child_interrupt_count);
|
||||||
block_interrupts();
|
block_interrupts();
|
||||||
--child_interrupt_count;
|
--child_interrupt_count;
|
||||||
allow_interrupts();
|
allow_interrupts();
|
||||||
|
@ -745,7 +755,7 @@ s48_os_signal_pending(void) {
|
||||||
return TRUE;
|
return TRUE;
|
||||||
}
|
}
|
||||||
else if (hup_interrupt_count > 0){
|
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();
|
block_interrupts();
|
||||||
--hup_interrupt_count;
|
--hup_interrupt_count;
|
||||||
allow_interrupts();
|
allow_interrupts();
|
||||||
|
|
32
configure.in
32
configure.in
|
@ -79,6 +79,36 @@ define(S48_USCORE, [dnl
|
||||||
rm -f conftest.c a.out
|
rm -f conftest.c a.out
|
||||||
])dnl
|
])dnl
|
||||||
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_INIT(c/scheme48vm.c)
|
||||||
AC_CONFIG_HEADER(c/sysdep.h)
|
AC_CONFIG_HEADER(c/sysdep.h)
|
||||||
S48_PROG_CC
|
S48_PROG_CC
|
||||||
|
@ -132,4 +162,6 @@ fail
|
||||||
AC_SUBST(CFLAGS)
|
AC_SUBST(CFLAGS)
|
||||||
AC_SUBST(LIBOBJS)
|
AC_SUBST(LIBOBJS)
|
||||||
AC_SUBST(LDFLAGS)
|
AC_SUBST(LDFLAGS)
|
||||||
|
SCSH_TZNAME
|
||||||
|
SCSH_GMTOFF
|
||||||
AC_OUTPUT(Makefile)
|
AC_OUTPUT(Makefile)
|
||||||
|
|
|
@ -446,6 +446,7 @@
|
||||||
$current-input-port
|
$current-input-port
|
||||||
$current-output-port
|
$current-output-port
|
||||||
$current-error-port
|
$current-error-port
|
||||||
|
$current-noise-port
|
||||||
;; end of additions. ;;
|
;; end of additions. ;;
|
||||||
char-ready?
|
char-ready?
|
||||||
read-block write-block
|
read-block write-block
|
||||||
|
|
|
@ -64,6 +64,8 @@
|
||||||
|
|
||||||
push-command-levels?
|
push-command-levels?
|
||||||
|
|
||||||
|
start-new-session
|
||||||
|
|
||||||
command-input
|
command-input
|
||||||
command-output
|
command-output
|
||||||
command-error-output
|
command-error-output
|
||||||
|
|
Binary file not shown.
Binary file not shown.
|
@ -1,5 +1,6 @@
|
||||||
/* This is an Scheme48/C interface file,
|
/* 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>
|
#include <stdio.h>
|
||||||
|
@ -11,51 +12,60 @@
|
||||||
#include "../regexp/regex.h"
|
#include "../regexp/regex.h"
|
||||||
#include "re1.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* *);
|
extern int compile_re(s48_value , int , regex_t* *);
|
||||||
scheme_value ret1;
|
s48_value ret1;
|
||||||
int r1;
|
int r1;
|
||||||
regex_t* r2;
|
regex_t* r2;
|
||||||
|
|
||||||
cig_check_nargs(3, nargs, "compile_re");
|
|
||||||
r1 = compile_re(args[2], EXTRACT_BOOLEAN(args[1]), &r2);
|
r1 = compile_re(g1, EXTRACT_BOOLEAN(g2), &r2);
|
||||||
ret1 = ENTER_FIXNUM(r1);
|
ret1 = s48_enter_integer(r1);
|
||||||
AlienVal(VECTOR_REF(*args,0)) = (long) r2;
|
SetAlienVal(S48_VECTOR_REF(mv_vec,0),(long) r2);//simple-assign
|
||||||
return ret1;
|
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 );
|
extern s48_value re_search(const regex_t *, s48_value , int , s48_value , int , s48_value , s48_value );
|
||||||
scheme_value ret1;
|
s48_value ret1;
|
||||||
scheme_value r1;
|
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;
|
ret1 = r1;
|
||||||
return ret1;
|
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 *);
|
extern const char *re_errint2str(int , const regex_t *);
|
||||||
scheme_value ret1;
|
s48_value ret1;
|
||||||
const char *r1;
|
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);}
|
|
||||||
return ret1;
|
|
||||||
}
|
|
||||||
|
|
||||||
scheme_value df_free_re(long nargs, scheme_value *args)
|
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;
|
||||||
|
}
|
||||||
|
|
||||||
|
s48_value df_free_re(s48_value g1)
|
||||||
{
|
{
|
||||||
extern void free_re(regex_t* );
|
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
|
(export close
|
||||||
close-after
|
close-after
|
||||||
current-error-port
|
current-error-port
|
||||||
|
error-output-port
|
||||||
dup
|
dup
|
||||||
dup->inport
|
dup->inport
|
||||||
dup->outport
|
dup->outport
|
||||||
|
@ -127,7 +128,7 @@
|
||||||
init-fdports! ;added by JMG
|
init-fdports! ;added by JMG
|
||||||
|
|
||||||
force-output
|
force-output
|
||||||
; set-port-buffering
|
set-port-buffering
|
||||||
bufpol/block
|
bufpol/block
|
||||||
bufpol/line
|
bufpol/line
|
||||||
bufpol/none
|
bufpol/none
|
||||||
|
@ -1099,7 +1100,14 @@
|
||||||
|
|
||||||
(define-interface event-interface
|
(define-interface event-interface
|
||||||
(export most-recent-event
|
(export most-recent-event
|
||||||
|
most-recent-event?
|
||||||
|
|
||||||
next-event
|
next-event
|
||||||
event-type
|
event-type
|
||||||
|
|
||||||
wait-interrupt
|
wait-interrupt
|
||||||
|
wait-interrupt-set
|
||||||
|
nonblockwait-interrupt
|
||||||
|
nonblockwait-interrupt-set
|
||||||
|
|
||||||
install-event-handlers!))
|
install-event-handlers!))
|
|
@ -28,14 +28,14 @@
|
||||||
|
|
||||||
(define-structure error-package (export error warn)
|
(define-structure error-package (export error warn)
|
||||||
(open signals)
|
(open signals)
|
||||||
(optimize auto-integrate)
|
; (optimize auto-integrate)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
(define-structure scsh-utilities scsh-utilities-interface
|
(define-structure scsh-utilities scsh-utilities-interface
|
||||||
(open bitwise error-package loopholes let-opt scheme)
|
(open bitwise error-package loopholes let-opt scheme)
|
||||||
(files utilities)
|
(files utilities)
|
||||||
(optimize auto-integrate)
|
; (optimize auto-integrate)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
@ -49,7 +49,7 @@
|
||||||
scheme
|
scheme
|
||||||
)
|
)
|
||||||
(files syntax-helpers)
|
(files syntax-helpers)
|
||||||
(optimize auto-integrate)
|
; (optimize auto-integrate)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
@ -57,7 +57,7 @@
|
||||||
(define-structure buffered-io-flags buffered-io-flags-interface
|
(define-structure buffered-io-flags buffered-io-flags-interface
|
||||||
(open defenum-package scheme)
|
(open defenum-package scheme)
|
||||||
(files (machine bufpol))
|
(files (machine bufpol))
|
||||||
(optimize auto-integrate)
|
; (optimize auto-integrate)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
@ -68,7 +68,7 @@
|
||||||
scsh-utilities ; For DEPRECATED-PROC
|
scsh-utilities ; For DEPRECATED-PROC
|
||||||
scheme)
|
scheme)
|
||||||
(files char-set)
|
(files char-set)
|
||||||
(optimize auto-integrate)
|
; (optimize auto-integrate)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
@ -76,7 +76,7 @@
|
||||||
(scsh-internal-tty-flags scsh-internal-tty-flags-interface))
|
(scsh-internal-tty-flags scsh-internal-tty-flags-interface))
|
||||||
(open scheme ascii bitwise)
|
(open scheme ascii bitwise)
|
||||||
(files (machine tty-consts))
|
(files (machine tty-consts))
|
||||||
(optimize auto-integrate)
|
; (optimize auto-integrate)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
@ -91,7 +91,8 @@
|
||||||
|
|
||||||
$current-input-port
|
$current-input-port
|
||||||
$current-output-port
|
$current-output-port
|
||||||
$current-error-port)
|
$current-error-port
|
||||||
|
$current-noise-port)
|
||||||
(open ports i/o))
|
(open ports i/o))
|
||||||
|
|
||||||
(define-structure signal-handler signal-handler-interface
|
(define-structure signal-handler signal-handler-interface
|
||||||
|
@ -234,7 +235,7 @@
|
||||||
sighandlers ; New in release 0.5.
|
sighandlers ; New in release 0.5.
|
||||||
scsh
|
scsh
|
||||||
; re
|
; re
|
||||||
rdelim ;rdelim omitted for now by JMG
|
rdelim
|
||||||
)
|
)
|
||||||
; (optimize auto-integrate)
|
; (optimize auto-integrate)
|
||||||
)
|
)
|
||||||
|
@ -243,21 +244,24 @@
|
||||||
(open records scheme)
|
(open records scheme)
|
||||||
(for-syntax (open scheme error-package receiving))
|
(for-syntax (open scheme error-package receiving))
|
||||||
(files defrec)
|
(files defrec)
|
||||||
(optimize auto-integrate)
|
; (optimize auto-integrate)
|
||||||
)
|
)
|
||||||
|
|
||||||
(define-structure defenum-package (export (define-enum-constant :syntax)
|
(define-structure defenum-package (export (define-enum-constant :syntax)
|
||||||
(define-enum-constants :syntax))
|
(define-enum-constants :syntax))
|
||||||
(open scheme)
|
(open scheme)
|
||||||
(files enumconst)
|
(files enumconst)
|
||||||
(optimize auto-integrate)
|
; (optimize auto-integrate)
|
||||||
)
|
)
|
||||||
|
|
||||||
;;; This code opens so many modules of gruesome, low-level S48 internals
|
;;; This code opens so many modules of gruesome, low-level S48 internals
|
||||||
;;; that these two modules are segregated into separate packages, each
|
;;; that these two modules are segregated into separate packages, each
|
||||||
;;; exporting just two definitions.
|
;;; 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!
|
(open scsh-level-0-internals ; init-scsh-* set-command-line-args!
|
||||||
scsh-level-0 ; error-output-port command-line-arguments
|
scsh-level-0 ; error-output-port command-line-arguments
|
||||||
scsh-top-package ; parse-switches-and-execute
|
scsh-top-package ; parse-switches-and-execute
|
||||||
|
@ -267,6 +271,7 @@
|
||||||
build-internals ; simple-condition-handler
|
build-internals ; simple-condition-handler
|
||||||
low-level ; flush-the-symbol-table!
|
low-level ; flush-the-symbol-table!
|
||||||
command-processor ; command-output
|
command-processor ; command-output
|
||||||
|
package-commands-internal
|
||||||
filenames ; translate
|
filenames ; translate
|
||||||
usual-resumer ; usual-resumer
|
usual-resumer ; usual-resumer
|
||||||
fluids-internal ; JMG: get-dynamic-env
|
fluids-internal ; JMG: get-dynamic-env
|
||||||
|
@ -276,7 +281,8 @@
|
||||||
scheme)
|
scheme)
|
||||||
(files startup))
|
(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
|
(open command-processor
|
||||||
command-levels ; with-new-session
|
command-levels ; with-new-session
|
||||||
char-set-package
|
char-set-package
|
||||||
|
@ -289,7 +295,7 @@
|
||||||
|
|
||||||
fluids-internal ; JMG: get-dynamic-env
|
fluids-internal ; JMG: get-dynamic-env
|
||||||
handle ; JMG: with-handler
|
handle ; JMG: with-handler
|
||||||
|
; package-commands
|
||||||
interrupts
|
interrupts
|
||||||
i/o
|
i/o
|
||||||
package-commands-internal
|
package-commands-internal
|
||||||
|
@ -332,7 +338,8 @@
|
||||||
scheme
|
scheme
|
||||||
)
|
)
|
||||||
(files awk)
|
(files awk)
|
||||||
(optimize auto-integrate))
|
; (optimize auto-integrate)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
(define-structure awk-package awk-interface
|
(define-structure awk-package awk-interface
|
||||||
|
@ -376,7 +383,7 @@
|
||||||
|
|
||||||
(access scsh-top-package)
|
(access scsh-top-package)
|
||||||
(begin (define repl (structure-ref scsh-top-package repl)))
|
(begin (define repl (structure-ref scsh-top-package repl)))
|
||||||
(optimize auto-integrate)
|
; (optimize auto-integrate)
|
||||||
)
|
)
|
||||||
|
|
||||||
(define-structure scsh-here-string-hax (export)
|
(define-structure scsh-here-string-hax (export)
|
||||||
|
|
|
@ -19,8 +19,8 @@ s48_value df_sig2interrupt(s48_value g1)
|
||||||
int r1;
|
int r1;
|
||||||
|
|
||||||
|
|
||||||
r1 = sig2interrupt(s48_extract_fixnum(g1));
|
r1 = sig2interrupt(s48_extract_integer(g1));
|
||||||
ret1 = s48_enter_fixnum(r1);
|
ret1 = s48_enter_integer(r1);
|
||||||
return ret1;
|
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);
|
r1 = scsh_set_sig(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), &r2, &r3);
|
||||||
ret1 = r1;
|
ret1 = r1;
|
||||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
|
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
|
||||||
S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
|
S48_VECTOR_SET(mv_vec,1,s48_enter_integer(r3));
|
||||||
return ret1;
|
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);
|
r1 = scsh_get_sig(s48_extract_fixnum(g1), &r2, &r3);
|
||||||
ret1 = r1;
|
ret1 = r1;
|
||||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
|
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
|
||||||
S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
|
S48_VECTOR_SET(mv_vec,1,s48_enter_integer(r3));
|
||||||
return ret1;
|
return ret1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -64,7 +64,9 @@
|
||||||
;(define-simple-syntax (with-enabled-interrupts mask body ...)
|
;(define-simple-syntax (with-enabled-interrupts mask body ...)
|
||||||
; (with-interrupts mask (lambda () body ...)))
|
; (with-interrupts mask (lambda () body ...)))
|
||||||
(define-simple-syntax (with-enabled-interrupts mask 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)
|
(define (with-enabled-interrupts* thunk thunk)
|
||||||
(warn "JMG: use of with-enabled-interrupts*")
|
(warn "JMG: use of with-enabled-interrupts*")
|
||||||
|
@ -127,23 +129,15 @@
|
||||||
((< sig 0))
|
((< sig 0))
|
||||||
(set-scsh-os-signal-handler!
|
(set-scsh-os-signal-handler!
|
||||||
sig
|
sig
|
||||||
(lambda (x) (display "default handler was called"))))
|
(lambda (x) #t)))
|
||||||
|
|
||||||
|
|
||||||
(begin
|
(begin
|
||||||
(set-interrupt-handler!
|
(set-interrupt-handler!
|
||||||
(enum interrupt os-signal)
|
(enum interrupt os-signal)
|
||||||
(lambda (type arg enabled-interrupts)
|
(lambda (type arg enabled-interrupts)
|
||||||
(display type)
|
|
||||||
|
|
||||||
(newline)
|
|
||||||
(display arg)
|
|
||||||
(newline)
|
|
||||||
(display enabled-interrupts)
|
|
||||||
(newline)
|
|
||||||
(if (= type (enum scsh-os-signal chld))
|
(if (= type (enum scsh-os-signal chld))
|
||||||
(begin
|
(begin
|
||||||
(display "will call proc")
|
|
||||||
(procobj-handler enabled-interrupts)))
|
(procobj-handler enabled-interrupts)))
|
||||||
((scsh-os-signal-handler-ref type) 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)
|
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 ret1;
|
||||||
s48_value r1;
|
s48_value r1;
|
||||||
int r2;
|
pid_t r2;
|
||||||
int r3;
|
int r3;
|
||||||
|
|
||||||
|
|
||||||
|
@ -300,13 +300,13 @@ s48_value df_umask(s48_value g1)
|
||||||
|
|
||||||
s48_value df_process_times(s48_value mv_vec)
|
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;
|
s48_value ret1;
|
||||||
int r1;
|
int r1;
|
||||||
int r2;
|
clock_t r2;
|
||||||
int r3;
|
clock_t r3;
|
||||||
int r4;
|
clock_t r4;
|
||||||
int r5;
|
clock_t r5;
|
||||||
|
|
||||||
|
|
||||||
r1 = process_times(&r2, &r3, &r4, &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();
|
r1 = cpu_clock_ticks_per_sec();
|
||||||
ret1 = s48_enter_fixnum(r1);
|
ret1 = s48_enter_integer(r1);
|
||||||
return ret1;
|
return ret1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -385,7 +385,7 @@ s48_value df_access(s48_value g1, s48_value g2)
|
||||||
int r1;
|
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);
|
ret1 = ENTER_BOOLEAN(r1);
|
||||||
return ret1;
|
return ret1;
|
||||||
}
|
}
|
||||||
|
@ -463,14 +463,14 @@ s48_value df_rmdir(s48_value g1)
|
||||||
return ret1;
|
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;
|
s48_value ret1;
|
||||||
int r1;
|
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);
|
ret1 = errno_or_false(r1);
|
||||||
return ret1;
|
return ret1;
|
||||||
}
|
}
|
||||||
|
@ -506,7 +506,7 @@ s48_value df_scheme_fstat(s48_value g1, s48_value g2)
|
||||||
int r1;
|
int r1;
|
||||||
|
|
||||||
|
|
||||||
r1 = scheme_fstat(s48_extract_fixnum(g1), g2);
|
r1 = scheme_fstat(s48_extract_integer(g1), g2);
|
||||||
ret1 = False_on_zero(r1);
|
ret1 = False_on_zero(r1);
|
||||||
return ret1;
|
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)
|
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;
|
s48_value ret1;
|
||||||
int r1;
|
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)
|
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;
|
s48_value ret1;
|
||||||
int r1;
|
int r1;
|
||||||
|
|
||||||
|
@ -750,7 +750,7 @@ s48_value df_alarm(s48_value g1)
|
||||||
unsigned int r1;
|
unsigned int r1;
|
||||||
|
|
||||||
|
|
||||||
r1 = alarm(s48_extract_fixnum(g1));
|
r1 = alarm(s48_extract_integer(g1));
|
||||||
ret1 = s48_enter_fixnum(r1);
|
ret1 = s48_enter_fixnum(r1);
|
||||||
return ret1;
|
return ret1;
|
||||||
}
|
}
|
||||||
|
@ -805,7 +805,7 @@ s48_value df_group_info_gid(s48_value g1, s48_value mv_vec)
|
||||||
int r4;
|
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);
|
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_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
|
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);
|
r1 = group_info_name(s48_extract_string(g1), &r2, &r3, &r4);
|
||||||
ret1 = ENTER_BOOLEAN(r1);
|
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
|
SetAlienVal(S48_VECTOR_REF(mv_vec,1),(long) r3);//simple-assign
|
||||||
S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4));
|
S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4));
|
||||||
return ret1;
|
return ret1;
|
||||||
|
@ -956,14 +956,14 @@ s48_value df_fcntl_write(s48_value g1, s48_value g2, s48_value g3)
|
||||||
return ret1;
|
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 ret1;
|
||||||
s48_value r1;
|
s48_value r1;
|
||||||
|
|
||||||
|
|
||||||
r1 = sleep_until(s48_extract_fixnum(g1), s48_extract_fixnum(g2));
|
r1 = sleep_until(s48_extract_integer(g1));
|
||||||
ret1 = r1;
|
ret1 = r1;
|
||||||
return ret1;
|
return ret1;
|
||||||
}
|
}
|
||||||
|
@ -988,7 +988,7 @@ s48_value df_errno_msg(s48_value g1, s48_value mv_vec)
|
||||||
char *r1;
|
char *r1;
|
||||||
|
|
||||||
|
|
||||||
r1 = errno_msg(s48_extract_fixnum(g1));
|
r1 = errno_msg(s48_extract_integer(g1));
|
||||||
ret1 = S48_VECTOR_REF(mv_vec,0);
|
ret1 = S48_VECTOR_REF(mv_vec,0);
|
||||||
SetAlienVal(S48_CAR(ret1),(long) r1); S48_SET_CDR(ret1,strlen_or_false(r1));//str-and-len
|
SetAlienVal(S48_CAR(ret1),(long) r1); S48_SET_CDR(ret1,strlen_or_false(r1));//str-and-len
|
||||||
return ret1;
|
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)
|
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 ret1;
|
||||||
s48_value r1;
|
s48_value r1;
|
||||||
int r2;
|
time_t r2;
|
||||||
int r3;
|
|
||||||
|
|
||||||
|
|
||||||
r1 = scheme_time(&r2, &r3);
|
r1 = scheme_time(&r2);
|
||||||
ret1 = r1;
|
ret1 = r1;
|
||||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
|
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
|
||||||
S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
|
|
||||||
return ret1;
|
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)
|
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 ret1;
|
||||||
s48_value r1;
|
s48_value r1;
|
||||||
int r2;
|
time_t r2;
|
||||||
int 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, &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;
|
ret1 = r1;
|
||||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
|
S48_VECTOR_SET(mv_vec,0,s48_enter_integer(r2));
|
||||||
S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3));
|
|
||||||
return ret1;
|
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 ret1;
|
||||||
s48_value r1;
|
s48_value r1;
|
||||||
int r2;
|
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;
|
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;
|
ret1 = r1;
|
||||||
S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2));
|
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,1,s48_enter_fixnum(r3));
|
||||||
|
|
|
@ -200,6 +200,7 @@
|
||||||
(format-date "~a ~b ~d ~H:~M:~S ~Y" date))
|
(format-date "~a ~b ~d ~H:~M:~S ~Y" date))
|
||||||
|
|
||||||
(define (format-date fmt 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)
|
(check-arg date? date format-date)
|
||||||
(receive (err result)
|
(receive (err result)
|
||||||
(%format-date/errno fmt
|
(%format-date/errno fmt
|
||||||
|
|
Loading…
Reference in New Issue