changes to get the 0.5.2 stuff running. Not yet completed, hangs on startup
This commit is contained in:
marting
parent
0f0fe9f2ff
commit
b5771115b6
16
Makefile
16
Makefile
|
|
@ -158,7 +158,7 @@ enough: $(VM) $(IMAGE) go $(LIBCIG) scsh $(LIBSCSH)
|
|||
# External code to include in the VM
|
||||
# After changing any of these you should delete `scheme48vm' and remake it.
|
||||
|
||||
CIGGED = flock network select syscalls tty time sighandlers
|
||||
CIGGED = flock network select syscalls tty time sighandlers re_low
|
||||
#re rdelim
|
||||
CIGGEDOBJ = $(patsubst %,scsh/%.o, $(CIGGED))
|
||||
CIGGEDINIT = $(patsubst %,s48_init_%, $(CIGGED))
|
||||
|
|
@ -292,10 +292,10 @@ c/fake/strerror.o: c/fake/strerror.h
|
|||
$(IMAGE): $(VM) scheme/env/init-defpackage.scm scheme/more-interfaces.scm \
|
||||
scheme/link-packages.scm scheme/more-packages.scm \
|
||||
$(usual-files) build/initial.debug build/build-usual-image
|
||||
sh $(srcdir)/build/build-usual-image "$(srcdir)" "$(LIB)" "$(IMAGE)" \
|
||||
"$(VM)" "$(INITIAL)"
|
||||
# build/build-usual-image . "`pwd`/scheme" '$(IMAGE)' './$(VM)' \
|
||||
# '$(INITIAL)'
|
||||
# sh $(srcdir)/build/build-usual-image "$(srcdir)" "$(LIB)" "$(IMAGE)" \
|
||||
# "$(VM)" "$(INITIAL)"
|
||||
build/build-usual-image . "`pwd`/scheme" '$(IMAGE)' './$(VM)' \
|
||||
'$(INITIAL)'
|
||||
|
||||
### Fake targets: all clean install man dist
|
||||
|
||||
|
|
@ -540,7 +540,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/scsh-read.scm 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")'; \
|
||||
|
|
@ -654,7 +654,7 @@ i-know-what-i-am-doing:
|
|||
echo ',exec ,load compile-vm-no-gc.scm'; \
|
||||
echo ',exec ,load compile-gc.scm'; \
|
||||
echo ',exit' \
|
||||
) | $(RUNNABLE) -h 5000000 && \
|
||||
) | $(RUNNABLE) -h 8000000 && \
|
||||
mv ../scheme/vm/scheme48vm.c ../scheme/vm/scheme48heap.c ../c
|
||||
cig: $(CIG) $(CIG).image $(LIBCIG)
|
||||
|
||||
|
|
@ -671,7 +671,7 @@ $(CIG): $(VM) $(IMAGE) $(srcdir)/cig/cig.scm $(srcdir)/cig/libcig.scm
|
|||
| ./$(VM) -i ./$(IMAGE)
|
||||
$(srcdir)/cig/image2script $(LIB)/$(VM) </tmp/cig > $(CIG)
|
||||
-chmod +x $(CIG)
|
||||
# mv /tmp/cig $(srcdir)/cig/standalone.image
|
||||
mv /tmp/cig $(srcdir)/cig/standalone.image
|
||||
$(RM) /tmp/cig
|
||||
|
||||
$(CIG)2:
|
||||
|
|
|
|||
16
Makefile.in
16
Makefile.in
|
|
@ -158,7 +158,7 @@ enough: $(VM) $(IMAGE) go $(LIBCIG) scsh $(LIBSCSH)
|
|||
# External code to include in the VM
|
||||
# After changing any of these you should delete `scheme48vm' and remake it.
|
||||
|
||||
CIGGED = flock network select syscalls tty time sighandlers
|
||||
CIGGED = flock network select syscalls tty time sighandlers re_low
|
||||
#re rdelim
|
||||
CIGGEDOBJ = $(patsubst %,scsh/%.o, $(CIGGED))
|
||||
CIGGEDINIT = $(patsubst %,s48_init_%, $(CIGGED))
|
||||
|
|
@ -292,10 +292,10 @@ c/fake/strerror.o: c/fake/strerror.h
|
|||
$(IMAGE): $(VM) scheme/env/init-defpackage.scm scheme/more-interfaces.scm \
|
||||
scheme/link-packages.scm scheme/more-packages.scm \
|
||||
$(usual-files) build/initial.debug build/build-usual-image
|
||||
sh $(srcdir)/build/build-usual-image "$(srcdir)" "$(LIB)" "$(IMAGE)" \
|
||||
"$(VM)" "$(INITIAL)"
|
||||
# build/build-usual-image . "`pwd`/scheme" '$(IMAGE)' './$(VM)' \
|
||||
# '$(INITIAL)'
|
||||
# sh $(srcdir)/build/build-usual-image "$(srcdir)" "$(LIB)" "$(IMAGE)" \
|
||||
# "$(VM)" "$(INITIAL)"
|
||||
build/build-usual-image . "`pwd`/scheme" '$(IMAGE)' './$(VM)' \
|
||||
'$(INITIAL)'
|
||||
|
||||
### Fake targets: all clean install man dist
|
||||
|
||||
|
|
@ -540,7 +540,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/scsh-read.scm 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")'; \
|
||||
|
|
@ -654,7 +654,7 @@ i-know-what-i-am-doing:
|
|||
echo ',exec ,load compile-vm-no-gc.scm'; \
|
||||
echo ',exec ,load compile-gc.scm'; \
|
||||
echo ',exit' \
|
||||
) | $(RUNNABLE) -h 5000000 && \
|
||||
) | $(RUNNABLE) -h 8000000 && \
|
||||
mv ../scheme/vm/scheme48vm.c ../scheme/vm/scheme48heap.c ../c
|
||||
cig: $(CIG) $(CIG).image $(LIBCIG)
|
||||
|
||||
|
|
@ -671,7 +671,7 @@ $(CIG): $(VM) $(IMAGE) $(srcdir)/cig/cig.scm $(srcdir)/cig/libcig.scm
|
|||
| ./$(VM) -i ./$(IMAGE)
|
||||
$(srcdir)/cig/image2script $(LIB)/$(VM) </tmp/cig > $(CIG)
|
||||
-chmod +x $(CIG)
|
||||
# mv /tmp/cig $(srcdir)/cig/standalone.image
|
||||
mv /tmp/cig $(srcdir)/cig/standalone.image
|
||||
$(RM) /tmp/cig
|
||||
|
||||
$(CIG)2:
|
||||
|
|
|
|||
|
|
@ -6364,39 +6364,39 @@
|
|||
(4339 loop 4338 95 ())
|
||||
(4340 #f 4296 24099 ())
|
||||
(4341 loop 4340 95 ())
|
||||
(4342 #f 4296 26314 ())
|
||||
(4343 #f 4296 26477 ())
|
||||
(4344 #f 4296 26526 ())
|
||||
(4345 #f 4296 26575 ())
|
||||
(4346 #f 4296 26720 ())
|
||||
(4347 #f 4296 26938 ())
|
||||
(4348 #f 4296 29861 ())
|
||||
(4349 #f 4296 30061 ())
|
||||
(4350 #f 4296 30110 ())
|
||||
(4351 #f 4296 30159 ())
|
||||
(4342 #f 4296 26227 ())
|
||||
(4343 #f 4296 26390 ())
|
||||
(4344 #f 4296 26439 ())
|
||||
(4345 #f 4296 26488 ())
|
||||
(4346 #f 4296 26633 ())
|
||||
(4347 #f 4296 26851 ())
|
||||
(4348 #f 4296 29774 ())
|
||||
(4349 #f 4296 29974 ())
|
||||
(4350 #f 4296 30023 ())
|
||||
(4351 #f 4296 30072 ())
|
||||
(4352 #f 4351 146 ())
|
||||
(4353 #f 4296 30208 ())
|
||||
(4353 #f 4296 30121 ())
|
||||
(4354 #f 4353 329 ())
|
||||
(4355 #f 4353 403 ())
|
||||
(4356 #f 4296 30587 ())
|
||||
(4357 #f 4296 30636 ())
|
||||
(4356 #f 4296 30500 ())
|
||||
(4357 #f 4296 30549 ())
|
||||
(4358 #f 4357 176 ())
|
||||
(4359 parse-package-clauses 4296 30694 ())
|
||||
(4359 parse-package-clauses 4296 30607 ())
|
||||
(4360 loop 4359 76 ())
|
||||
(4361 #f 4296 30703 ())
|
||||
(4361 #f 4296 30616 ())
|
||||
(4362 #f 4361 35 ())
|
||||
(4363 #f 4362 146 ())
|
||||
(4364 #f 4296 30959 ())
|
||||
(4365 #f 4296 31008 ())
|
||||
(4364 #f 4296 30872 ())
|
||||
(4365 #f 4296 30921 ())
|
||||
(4366 loop 4365 35 ())
|
||||
(4367 #f 4296 31121 ())
|
||||
(4368 #f 4296 31202 ())
|
||||
(4369 #f 4296 31283 ())
|
||||
(4367 #f 4296 31034 ())
|
||||
(4368 #f 4296 31115 ())
|
||||
(4369 #f 4296 31196 ())
|
||||
(4370 loop 4369 51 ())
|
||||
(4371 #f 4369 90 ())
|
||||
(4372 #f 4369 114 ())
|
||||
(4373 #f 4296 31364 ())
|
||||
(4374 #f 4296 32621 ())
|
||||
(4375 #f 4296 32757 ())
|
||||
(4373 #f 4296 31277 ())
|
||||
(4374 #f 4296 32534 ())
|
||||
(4375 #f 4296 32670 ())
|
||||
(4376 #f #f #f ())
|
||||
-
|
||||
|
|
|
|||
Binary file not shown.
|
|
@ -757,6 +757,7 @@
|
|||
procedure-type-arity
|
||||
any-procedure-type
|
||||
(proc :syntax)
|
||||
(some-values :syntax)
|
||||
|
||||
boolean-type
|
||||
char-type
|
||||
|
|
@ -1112,6 +1113,7 @@
|
|||
(export ((:syntax :values :arguments :value) :type)
|
||||
(procedure (proc (:type :type) :type)) ; (procedure T1 T2)
|
||||
(proc :syntax) ; (proc (T1 ... Tn) T)
|
||||
(some-values :syntax) ; (some-values T1 ... Tn) ;JMG added it again
|
||||
((:boolean
|
||||
:char
|
||||
:number
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@ s48_value df_db_open_btree(long nargs, s48_value *args)
|
|||
DB** r2;
|
||||
|
||||
cig_check_nargs(11, nargs, "db_open_btree");
|
||||
r1 = db_open_btree(cig_string_body(args[10]), s48_extract_fixnum(args[9]), s48_extract_fixnum(args[8]), s48_extract_fixnum(args[7]), s48_extract_fixnum(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2);
|
||||
r1 = db_open_btree(cig_string_body(args[10]), s48_extract_fixnum(args[9]), s48_extract_fixnum(args[8]), s48_extract_fixnum(args[7]), s48_extract_fixnum(args[6]), s48_extract_fixnum(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2);
|
||||
ret1 = errno_or_false(r1);
|
||||
AlienVal(VECTOR_REF(*args,0)) = (long) r2;
|
||||
return ret1;
|
||||
|
|
@ -63,7 +63,7 @@ s48_value df_db_open_hash(long nargs, s48_value *args)
|
|||
DB** r2;
|
||||
|
||||
cig_check_nargs(10, nargs, "db_open_hash");
|
||||
r1 = db_open_hash(cig_string_body(args[9]), s48_extract_fixnum(args[8]), s48_extract_fixnum(args[7]), s48_extract_fixnum(args[6]), s48_extract_fixnum(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2);
|
||||
r1 = db_open_hash(cig_string_body(args[9]), s48_extract_fixnum(args[8]), s48_extract_fixnum(args[7]), s48_extract_fixnum(args[6]), s48_extract_fixnum(args[5]), s48_extract_fixnum(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2);
|
||||
ret1 = errno_or_false(r1);
|
||||
AlienVal(VECTOR_REF(*args,0)) = (long) r2;
|
||||
return ret1;
|
||||
|
|
@ -77,7 +77,7 @@ s48_value df_db_open_recno(long nargs, s48_value *args)
|
|||
DB** r2;
|
||||
|
||||
cig_check_nargs(12, nargs, "db_open_recno");
|
||||
r1 = db_open_recno(cig_string_body(args[11]), s48_extract_fixnum(args[10]), s48_extract_fixnum(args[9]), s48_extract_fixnum(args[8]), s48_extract_fixnum(args[7]), EXTRACT_FIXNUM(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), s48_extract_char(args[2]), cig_string_body(args[1]), &r2);
|
||||
r1 = db_open_recno(cig_string_body(args[11]), s48_extract_fixnum(args[10]), s48_extract_fixnum(args[9]), s48_extract_fixnum(args[8]), s48_extract_fixnum(args[7]), s48_extract_fixnum(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), s48_extract_char(args[2]), cig_string_body(args[1]), &r2);
|
||||
ret1 = errno_or_false(r1);
|
||||
AlienVal(VECTOR_REF(*args,0)) = (long) r2;
|
||||
return ret1;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
/* This is an Scheme48/C interface file,
|
||||
** automatically generated by a hacked version of cig 3.0.
|
||||
step 3
|
||||
step 4
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
|
|
|||
|
|
@ -8,6 +8,9 @@
|
|||
;;; C syscall interface
|
||||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(foreign-init-name "flock")
|
||||
|
||||
|
||||
(foreign-source
|
||||
"#include <sys/types.h>"
|
||||
"#include <unistd.h>"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
/* This is an Scheme48/C interface file,
|
||||
** automatically generated by a hacked version of cig 3.0.
|
||||
step 3
|
||||
step 4
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
|
@ -58,7 +58,7 @@ s48_value df_scheme_connect(s48_value g1, s48_value g2, s48_value g3)
|
|||
|
||||
s48_value df_listen(s48_value g1, s48_value g2)
|
||||
{
|
||||
extern int listen(int , int );
|
||||
|
||||
s48_value ret1;
|
||||
int r1;
|
||||
|
||||
|
|
|
|||
|
|
@ -4,6 +4,8 @@
|
|||
|
||||
;;; Scheme48 implementation.
|
||||
|
||||
(foreign-init-name "network")
|
||||
|
||||
(foreign-source
|
||||
"#include <sys/types.h>"
|
||||
"#include <sys/socket.h>"
|
||||
|
|
|
|||
Binary file not shown.
Binary file not shown.
|
|
@ -159,7 +159,7 @@
|
|||
records
|
||||
extended-ports
|
||||
partial-s48-ports
|
||||
; ports
|
||||
ports
|
||||
build
|
||||
bigbit
|
||||
bitwise
|
||||
|
|
@ -396,12 +396,12 @@
|
|||
interrupts)
|
||||
(files event))
|
||||
|
||||
(define-structure test-package (export test-proc)
|
||||
(open scsh-regexp-package scheme)
|
||||
(begin (define (test-proc p)
|
||||
(regexp-substitute p
|
||||
(string-match "(foo)(.*)(bar)" "Hello foo Olin bar quux")
|
||||
'post 3 1 2 'pre))))
|
||||
;(define-structure test-package (export test-proc)
|
||||
; (open scsh-regexp-package scheme)
|
||||
; (begin (define (test-proc p)
|
||||
; (regexp-substitute p
|
||||
; (string-match "(foo)(.*)(bar)" "Hello foo Olin bar quux")
|
||||
; 'post 3 1 2 'pre))))
|
||||
|
||||
|
||||
(define-structure scsh-threads
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
/* This is an Scheme48/C interface file,
|
||||
** automatically generated by a hacked version of cig 3.0.
|
||||
step 3
|
||||
step 4
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
|
|
|||
|
|
@ -1,6 +1,9 @@
|
|||
;;; select(2) syscall for scsh. -*- Scheme -*-
|
||||
;;; Copyright (c) 1995 by Olin Shivers.
|
||||
|
||||
(foreign-init-name "select")
|
||||
|
||||
|
||||
(foreign-source
|
||||
"/* Make sure foreign-function stubs interface to the C funs correctly: */"
|
||||
"#include \"select1.h\""
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
/* This is an Scheme48/C interface file,
|
||||
** automatically generated by a hacked version of cig 3.0.
|
||||
step 3
|
||||
step 4
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
(define (make-scsh-starter)
|
||||
(let ((context (user-context)))
|
||||
(lambda (args)
|
||||
(display "off we go")
|
||||
(display "off we go" (current-error-port))
|
||||
(display context)
|
||||
(parse-switches-and-execute args context))))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
/* This is an Scheme48/C interface file,
|
||||
** automatically generated by a hacked version of cig 3.0.
|
||||
step 3
|
||||
step 4
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
/* This is an Scheme48/C interface file,
|
||||
** automatically generated by a hacked version of cig 3.0.
|
||||
step 3
|
||||
step 4
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
|
|
|||
|
|
@ -10,6 +10,8 @@
|
|||
;;; - If tz-name not defined, fabbed from tz-secs.
|
||||
;;; - If tz-secs not defined, filled in from tz-name.
|
||||
|
||||
(foreign-init-name "time")
|
||||
|
||||
(foreign-source "#include \"time1.h\"" ; Import the time1.h interface.
|
||||
"")
|
||||
|
||||
|
|
|
|||
15
scsh/tty.c
15
scsh/tty.c
|
|
@ -1,6 +1,6 @@
|
|||
/* This is an Scheme48/C interface file,
|
||||
** automatically generated by a hacked version of cig 3.0.
|
||||
step 3
|
||||
step 4
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
|
@ -51,6 +51,18 @@ s48_value df_scheme_tcgetattr(s48_value g1, s48_value g2, s48_value mv_vec)
|
|||
return ret1;
|
||||
}
|
||||
|
||||
s48_value df_scheme_tcgetattrB(s48_value g1, s48_value g2, s48_value g3)
|
||||
{
|
||||
extern int scheme_tcgetattrB(int , char *, s48_value );
|
||||
s48_value ret1;
|
||||
int r1;
|
||||
|
||||
|
||||
r1 = scheme_tcgetattrB(s48_extract_fixnum(g1), s48_extract_string(g2), g3);
|
||||
ret1 = errno_or_false(r1);
|
||||
return ret1;
|
||||
}
|
||||
|
||||
s48_value df_scheme_tcsetattr(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 g10, s48_value g11, s48_value g12, s48_value g13, s48_value g14, s48_value g15)
|
||||
{
|
||||
extern int scheme_tcsetattr(int , int , const char *, int , int , int , int , int , int , int , int , int , int , int , int );
|
||||
|
|
@ -190,6 +202,7 @@ s48_value df_scm_ctermid(s48_value mv_vec)
|
|||
s48_value s48_init_tty(void)
|
||||
{
|
||||
S48_EXPORT_FUNCTION(df_scheme_tcgetattr);
|
||||
S48_EXPORT_FUNCTION(df_scheme_tcgetattrB);
|
||||
S48_EXPORT_FUNCTION(df_scheme_tcsetattr);
|
||||
S48_EXPORT_FUNCTION(df_tcsendbreak);
|
||||
S48_EXPORT_FUNCTION(df_tcdrain);
|
||||
|
|
|
|||
|
|
@ -13,6 +13,8 @@
|
|||
;;; Copyright (c) 1995 by Brian D. Carlstrom.
|
||||
;;; Rehacked by Olin 8/95.
|
||||
|
||||
(foreign-init-name "tty")
|
||||
|
||||
(foreign-source
|
||||
"#include <sys/types.h>"
|
||||
""
|
||||
|
|
|
|||
24
scsh/tty1.c
24
scsh/tty1.c
|
|
@ -16,6 +16,7 @@
|
|||
#include <termios.h>
|
||||
#include <string.h>
|
||||
#include <sys/types.h>
|
||||
#include "scheme48.h"
|
||||
|
||||
/* This #include is for the #ifdef'd code in open_ctty() below, and
|
||||
** is therefor ifdef'd identically.
|
||||
|
|
@ -53,6 +54,29 @@ int scheme_tcgetattr(int fd, char *control_chars,
|
|||
return result;
|
||||
}
|
||||
|
||||
int scheme_tcgetattrB(int fd, char *control_chars, s48_value scmvec)
|
||||
{
|
||||
struct termios t;
|
||||
int result = tcgetattr(fd, &t);
|
||||
// JMG int *ivec = ADDRESS_AFTER_HEADER(scmvec, int);
|
||||
|
||||
if (result != -1) {
|
||||
memcpy(control_chars, t.c_cc, NCCS);
|
||||
S48_VECTOR_SET(scmvec, 0, s48_enter_fixnum(t.c_iflag >> 24));
|
||||
S48_VECTOR_SET(scmvec, 1, s48_enter_fixnum(t.c_iflag & 0xffffff));
|
||||
S48_VECTOR_SET(scmvec, 2, s48_enter_fixnum(t.c_oflag >> 24));
|
||||
S48_VECTOR_SET(scmvec, 3, s48_enter_fixnum(t.c_oflag & 0xffffff));
|
||||
S48_VECTOR_SET(scmvec, 4, s48_enter_fixnum(t.c_cflag >> 24));
|
||||
S48_VECTOR_SET(scmvec, 5, s48_enter_fixnum(t.c_cflag & 0xffffff));
|
||||
S48_VECTOR_SET(scmvec, 6, s48_enter_fixnum(t.c_lflag >> 24));
|
||||
S48_VECTOR_SET(scmvec, 7, s48_enter_fixnum(t.c_lflag & 0xffffff));
|
||||
S48_VECTOR_SET(scmvec, 8, s48_enter_fixnum(cfgetispeed(&t)));
|
||||
S48_VECTOR_SET(scmvec, 9, s48_enter_fixnum(cfgetospeed(&t)));
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
/*****************************************************************************/
|
||||
|
||||
|
|
|
|||
|
|
@ -89,6 +89,15 @@
|
|||
|
||||
(define any? first?)
|
||||
|
||||
|
||||
(define (every pred list)
|
||||
(or (not (pair? list))
|
||||
(let lp ((head (car list)) (tail (cdr list)))
|
||||
(if (pair? tail)
|
||||
(and (pred head) (lp (car tail) (cdr tail)))
|
||||
(pred head))))) ; Tail-call the last PRED call.
|
||||
|
||||
|
||||
(define (every? pred list)
|
||||
(letrec ((lp (lambda (list)
|
||||
(or (not (pair? list))
|
||||
|
|
|
|||
Loading…
Reference in New Issue