scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

changes to get the 0.5.2 stuff running. Not yet completed, hangs on startup

This commit is contained in:
marting 1999-09-23 23:02:54 +00:00
parent 0f0fe9f2ff
commit b5771115b6
24 changed files with 118 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
Makefile
View File

@ -158,7 +158,7 @@ enough: $(VM) $(IMAGE) go $(LIBCIG) scsh $(LIBSCSH)
# External code to include in the VM # External code to include in the VM
# After changing any of these you should delete `scheme48vm' and remake it. # 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 #re rdelim
CIGGEDOBJ = $(patsubst %,scsh/%.o, $(CIGGED)) CIGGEDOBJ = $(patsubst %,scsh/%.o, $(CIGGED))
CIGGEDINIT = $(patsubst %,s48_init_%, $(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 \ $(IMAGE): $(VM) scheme/env/init-defpackage.scm scheme/more-interfaces.scm \
scheme/link-packages.scm scheme/more-packages.scm \ scheme/link-packages.scm scheme/more-packages.scm \
$(usual-files) build/initial.debug build/build-usual-image $(usual-files) build/initial.debug build/build-usual-image
sh $(srcdir)/build/build-usual-image "$(srcdir)" "$(LIB)" "$(IMAGE)" \ # sh $(srcdir)/build/build-usual-image "$(srcdir)" "$(LIB)" "$(IMAGE)" \
"$(VM)" "$(INITIAL)" # "$(VM)" "$(INITIAL)"
# build/build-usual-image . "`pwd`/scheme" '$(IMAGE)' './$(VM)' \ build/build-usual-image . "`pwd`/scheme" '$(IMAGE)' './$(VM)' \
# '$(INITIAL)' '$(INITIAL)'
### Fake targets: all clean install man dist ### 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. # no debugging environment to speak of.
$(INITIAL): $(LINKER_IMAGE) $(CONFIG_FILES) build/initial.scm $(initial-files) \ $(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); \ ($(START_LINKER); \
echo '(load-configuration "scheme/interfaces.scm")'; \ echo '(load-configuration "scheme/interfaces.scm")'; \
echo '(load-configuration "scheme/packages.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-vm-no-gc.scm'; \
echo ',exec ,load compile-gc.scm'; \ echo ',exec ,load compile-gc.scm'; \
echo ',exit' \ echo ',exit' \
) | $(RUNNABLE) -h 5000000 && \ ) | $(RUNNABLE) -h 8000000 && \
mv ../scheme/vm/scheme48vm.c ../scheme/vm/scheme48heap.c ../c mv ../scheme/vm/scheme48vm.c ../scheme/vm/scheme48heap.c ../c
cig: $(CIG) $(CIG).image $(LIBCIG) cig: $(CIG) $(CIG).image $(LIBCIG)
@ -671,7 +671,7 @@ $(CIG): $(VM) $(IMAGE) $(srcdir)/cig/cig.scm $(srcdir)/cig/libcig.scm
| ./$(VM) -i ./$(IMAGE) | ./$(VM) -i ./$(IMAGE)
$(srcdir)/cig/image2script $(LIB)/$(VM) </tmp/cig > $(CIG) $(srcdir)/cig/image2script $(LIB)/$(VM) </tmp/cig > $(CIG)
-chmod +x $(CIG) -chmod +x $(CIG)
# mv /tmp/cig $(srcdir)/cig/standalone.image mv /tmp/cig $(srcdir)/cig/standalone.image
$(RM) /tmp/cig $(RM) /tmp/cig
$(CIG)2: $(CIG)2:

16
Makefile.in
View File

@ -158,7 +158,7 @@ enough: $(VM) $(IMAGE) go $(LIBCIG) scsh $(LIBSCSH)
# External code to include in the VM # External code to include in the VM
# After changing any of these you should delete `scheme48vm' and remake it. # 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 #re rdelim
CIGGEDOBJ = $(patsubst %,scsh/%.o, $(CIGGED)) CIGGEDOBJ = $(patsubst %,scsh/%.o, $(CIGGED))
CIGGEDINIT = $(patsubst %,s48_init_%, $(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 \ $(IMAGE): $(VM) scheme/env/init-defpackage.scm scheme/more-interfaces.scm \
scheme/link-packages.scm scheme/more-packages.scm \ scheme/link-packages.scm scheme/more-packages.scm \
$(usual-files) build/initial.debug build/build-usual-image $(usual-files) build/initial.debug build/build-usual-image
sh $(srcdir)/build/build-usual-image "$(srcdir)" "$(LIB)" "$(IMAGE)" \ # sh $(srcdir)/build/build-usual-image "$(srcdir)" "$(LIB)" "$(IMAGE)" \
"$(VM)" "$(INITIAL)" # "$(VM)" "$(INITIAL)"
# build/build-usual-image . "`pwd`/scheme" '$(IMAGE)' './$(VM)' \ build/build-usual-image . "`pwd`/scheme" '$(IMAGE)' './$(VM)' \
# '$(INITIAL)' '$(INITIAL)'
### Fake targets: all clean install man dist ### 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. # no debugging environment to speak of.
$(INITIAL): $(LINKER_IMAGE) $(CONFIG_FILES) build/initial.scm $(initial-files) \ $(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); \ ($(START_LINKER); \
echo '(load-configuration "scheme/interfaces.scm")'; \ echo '(load-configuration "scheme/interfaces.scm")'; \
echo '(load-configuration "scheme/packages.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-vm-no-gc.scm'; \
echo ',exec ,load compile-gc.scm'; \ echo ',exec ,load compile-gc.scm'; \
echo ',exit' \ echo ',exit' \
) | $(RUNNABLE) -h 5000000 && \ ) | $(RUNNABLE) -h 8000000 && \
mv ../scheme/vm/scheme48vm.c ../scheme/vm/scheme48heap.c ../c mv ../scheme/vm/scheme48vm.c ../scheme/vm/scheme48heap.c ../c
cig: $(CIG) $(CIG).image $(LIBCIG) cig: $(CIG) $(CIG).image $(LIBCIG)
@ -671,7 +671,7 @@ $(CIG): $(VM) $(IMAGE) $(srcdir)/cig/cig.scm $(srcdir)/cig/libcig.scm
| ./$(VM) -i ./$(IMAGE) | ./$(VM) -i ./$(IMAGE)
$(srcdir)/cig/image2script $(LIB)/$(VM) </tmp/cig > $(CIG) $(srcdir)/cig/image2script $(LIB)/$(VM) </tmp/cig > $(CIG)
-chmod +x $(CIG) -chmod +x $(CIG)
# mv /tmp/cig $(srcdir)/cig/standalone.image mv /tmp/cig $(srcdir)/cig/standalone.image
$(RM) /tmp/cig $(RM) /tmp/cig
$(CIG)2: $(CIG)2:

46
build/initial.debug
View File

@ -6364,39 +6364,39 @@
(4339 loop 4338 95 ()) (4339 loop 4338 95 ())
(4340 #f 4296 24099 ()) (4340 #f 4296 24099 ())
(4341 loop 4340 95 ()) (4341 loop 4340 95 ())
(4342 #f 4296 26314 ()) (4342 #f 4296 26227 ())
(4343 #f 4296 26477 ()) (4343 #f 4296 26390 ())
(4344 #f 4296 26526 ()) (4344 #f 4296 26439 ())
(4345 #f 4296 26575 ()) (4345 #f 4296 26488 ())
(4346 #f 4296 26720 ()) (4346 #f 4296 26633 ())
(4347 #f 4296 26938 ()) (4347 #f 4296 26851 ())
(4348 #f 4296 29861 ()) (4348 #f 4296 29774 ())
(4349 #f 4296 30061 ()) (4349 #f 4296 29974 ())
(4350 #f 4296 30110 ()) (4350 #f 4296 30023 ())
(4351 #f 4296 30159 ()) (4351 #f 4296 30072 ())
(4352 #f 4351 146 ()) (4352 #f 4351 146 ())
(4353 #f 4296 30208 ()) (4353 #f 4296 30121 ())
(4354 #f 4353 329 ()) (4354 #f 4353 329 ())
(4355 #f 4353 403 ()) (4355 #f 4353 403 ())
(4356 #f 4296 30587 ()) (4356 #f 4296 30500 ())
(4357 #f 4296 30636 ()) (4357 #f 4296 30549 ())
(4358 #f 4357 176 ()) (4358 #f 4357 176 ())
(4359 parse-package-clauses 4296 30694 ()) (4359 parse-package-clauses 4296 30607 ())
(4360 loop 4359 76 ()) (4360 loop 4359 76 ())
(4361 #f 4296 30703 ()) (4361 #f 4296 30616 ())
(4362 #f 4361 35 ()) (4362 #f 4361 35 ())
(4363 #f 4362 146 ()) (4363 #f 4362 146 ())
(4364 #f 4296 30959 ()) (4364 #f 4296 30872 ())
(4365 #f 4296 31008 ()) (4365 #f 4296 30921 ())
(4366 loop 4365 35 ()) (4366 loop 4365 35 ())
(4367 #f 4296 31121 ()) (4367 #f 4296 31034 ())
(4368 #f 4296 31202 ()) (4368 #f 4296 31115 ())
(4369 #f 4296 31283 ()) (4369 #f 4296 31196 ())
(4370 loop 4369 51 ()) (4370 loop 4369 51 ())
(4371 #f 4369 90 ()) (4371 #f 4369 90 ())
(4372 #f 4369 114 ()) (4372 #f 4369 114 ())
(4373 #f 4296 31364 ()) (4373 #f 4296 31277 ())
(4374 #f 4296 32621 ()) (4374 #f 4296 32534 ())
(4375 #f 4296 32757 ()) (4375 #f 4296 32670 ())
(4376 #f #f #f ()) (4376 #f #f #f ())
- -

BIN
build/initial.image
View File

Binary file not shown.

2
scheme/interfaces.scm
View File

@ -757,6 +757,7 @@
procedure-type-arity procedure-type-arity
any-procedure-type any-procedure-type
(proc :syntax) (proc :syntax)
(some-values :syntax)
boolean-type boolean-type
char-type char-type
@ -1112,6 +1113,7 @@
(export ((:syntax :values :arguments :value) :type) (export ((:syntax :values :arguments :value) :type)
(procedure (proc (:type :type) :type)) ; (procedure T1 T2) (procedure (proc (:type :type) :type)) ; (procedure T1 T2)
(proc :syntax) ; (proc (T1 ... Tn) T) (proc :syntax) ; (proc (T1 ... Tn) T)
(some-values :syntax) ; (some-values T1 ... Tn) ;JMG added it again
((:boolean ((:boolean
:char :char
:number :number

6
scsh/dbm.c
View File

@ -49,7 +49,7 @@ s48_value df_db_open_btree(long nargs, s48_value *args)
DB** r2; DB** r2;
cig_check_nargs(11, nargs, "db_open_btree"); 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); ret1 = errno_or_false(r1);
AlienVal(VECTOR_REF(*args,0)) = (long) r2; AlienVal(VECTOR_REF(*args,0)) = (long) r2;
return ret1; return ret1;
@ -63,7 +63,7 @@ s48_value df_db_open_hash(long nargs, s48_value *args)
DB** r2; DB** r2;
cig_check_nargs(10, nargs, "db_open_hash"); 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); ret1 = errno_or_false(r1);
AlienVal(VECTOR_REF(*args,0)) = (long) r2; AlienVal(VECTOR_REF(*args,0)) = (long) r2;
return ret1; return ret1;
@ -77,7 +77,7 @@ s48_value df_db_open_recno(long nargs, s48_value *args)
DB** r2; DB** r2;
cig_check_nargs(12, nargs, "db_open_recno"); 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); ret1 = errno_or_false(r1);
AlienVal(VECTOR_REF(*args,0)) = (long) r2; AlienVal(VECTOR_REF(*args,0)) = (long) r2;
return ret1; return ret1;

2
scsh/flock.c
View File

@ -1,6 +1,6 @@
/* This is an Scheme48/C interface file, /* This is an Scheme48/C interface file,
** automatically generated by a hacked version of cig 3.0. ** automatically generated by a hacked version of cig 3.0.
step 3 step 4
*/ */
#include <stdio.h> #include <stdio.h>

3
scsh/flock.scm
View File

@ -8,6 +8,9 @@
;;; C syscall interface ;;; C syscall interface
;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;
(foreign-init-name "flock")
(foreign-source (foreign-source
"#include <sys/types.h>" "#include <sys/types.h>"
"#include <unistd.h>" "#include <unistd.h>"

4
scsh/network.c
View File

@ -1,6 +1,6 @@
/* This is an Scheme48/C interface file, /* This is an Scheme48/C interface file,
** automatically generated by a hacked version of cig 3.0. ** automatically generated by a hacked version of cig 3.0.
step 3 step 4
*/ */
#include <stdio.h> #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) s48_value df_listen(s48_value g1, s48_value g2)
{ {
extern int listen(int , int );
s48_value ret1; s48_value ret1;
int r1; int r1;

2
scsh/network.scm
View File

@ -4,6 +4,8 @@
;;; Scheme48 implementation. ;;; Scheme48 implementation.
(foreign-init-name "network")
(foreign-source (foreign-source
"#include <sys/types.h>" "#include <sys/types.h>"
"#include <sys/socket.h>" "#include <sys/socket.h>"

BIN
scsh/regexp/regcomp.o
View File

Binary file not shown.

BIN
scsh/regexp/regexec.o
View File

Binary file not shown.

14
scsh/scsh-package.scm
View File

@ -159,7 +159,7 @@
records records
extended-ports extended-ports
partial-s48-ports partial-s48-ports
; ports ports
build build
bigbit bigbit
bitwise bitwise
@ -396,12 +396,12 @@
interrupts) interrupts)
(files event)) (files event))
(define-structure test-package (export test-proc) ;(define-structure test-package (export test-proc)
(open scsh-regexp-package scheme) ; (open scsh-regexp-package scheme)
(begin (define (test-proc p) ; (begin (define (test-proc p)
(regexp-substitute p ; (regexp-substitute p
(string-match "(foo)(.*)(bar)" "Hello foo Olin bar quux") ; (string-match "(foo)(.*)(bar)" "Hello foo Olin bar quux")
'post 3 1 2 'pre)))) ; 'post 3 1 2 'pre))))
(define-structure scsh-threads (define-structure scsh-threads

2
scsh/select.c
View File

@ -1,6 +1,6 @@
/* This is an Scheme48/C interface file, /* This is an Scheme48/C interface file,
** automatically generated by a hacked version of cig 3.0. ** automatically generated by a hacked version of cig 3.0.
step 3 step 4
*/ */
#include <stdio.h> #include <stdio.h>

3
scsh/select.scm
View File

@ -1,6 +1,9 @@
;;; select(2) syscall for scsh. -*- Scheme -*- ;;; select(2) syscall for scsh. -*- Scheme -*-
;;; Copyright (c) 1995 by Olin Shivers. ;;; Copyright (c) 1995 by Olin Shivers.
(foreign-init-name "select")
(foreign-source (foreign-source
"/* Make sure foreign-function stubs interface to the C funs correctly: */" "/* Make sure foreign-function stubs interface to the C funs correctly: */"
"#include \"select1.h\"" "#include \"select1.h\""

2
scsh/sighandlers.c
View File

@ -1,6 +1,6 @@
/* This is an Scheme48/C interface file, /* This is an Scheme48/C interface file,
** automatically generated by a hacked version of cig 3.0. ** automatically generated by a hacked version of cig 3.0.
step 3 step 4
*/ */
#include <stdio.h> #include <stdio.h>

2
scsh/startup.scm
View File

@ -8,7 +8,7 @@
(define (make-scsh-starter) (define (make-scsh-starter)
(let ((context (user-context))) (let ((context (user-context)))
(lambda (args) (lambda (args)
(display "off we go") (display "off we go" (current-error-port))
(display context) (display context)
(parse-switches-and-execute args context)))) (parse-switches-and-execute args context))))

2
scsh/syscalls.c
View File

@ -1,6 +1,6 @@
/* This is an Scheme48/C interface file, /* This is an Scheme48/C interface file,
** automatically generated by a hacked version of cig 3.0. ** automatically generated by a hacked version of cig 3.0.
step 3 step 4
*/ */
#include <stdio.h> #include <stdio.h>

2
scsh/time.c
View File

@ -1,6 +1,6 @@
/* This is an Scheme48/C interface file, /* This is an Scheme48/C interface file,
** automatically generated by a hacked version of cig 3.0. ** automatically generated by a hacked version of cig 3.0.
step 3 step 4
*/ */
#include <stdio.h> #include <stdio.h>

2
scsh/time.scm
View File

@ -10,6 +10,8 @@
;;; - If tz-name not defined, fabbed from tz-secs. ;;; - If tz-name not defined, fabbed from tz-secs.
;;; - If tz-secs not defined, filled in from tz-name. ;;; - If tz-secs not defined, filled in from tz-name.
(foreign-init-name "time")
(foreign-source "#include \"time1.h\"" ; Import the time1.h interface. (foreign-source "#include \"time1.h\"" ; Import the time1.h interface.
"") "")

15
scsh/tty.c
View File

@ -1,6 +1,6 @@
/* This is an Scheme48/C interface file, /* This is an Scheme48/C interface file,
** automatically generated by a hacked version of cig 3.0. ** automatically generated by a hacked version of cig 3.0.
step 3 step 4
*/ */
#include <stdio.h> #include <stdio.h>
@ -51,6 +51,18 @@ s48_value df_scheme_tcgetattr(s48_value g1, s48_value g2, s48_value mv_vec)
return ret1; 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) 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 ); 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_value s48_init_tty(void)
{ {
S48_EXPORT_FUNCTION(df_scheme_tcgetattr); S48_EXPORT_FUNCTION(df_scheme_tcgetattr);
S48_EXPORT_FUNCTION(df_scheme_tcgetattrB);
S48_EXPORT_FUNCTION(df_scheme_tcsetattr); S48_EXPORT_FUNCTION(df_scheme_tcsetattr);
S48_EXPORT_FUNCTION(df_tcsendbreak); S48_EXPORT_FUNCTION(df_tcsendbreak);
S48_EXPORT_FUNCTION(df_tcdrain); S48_EXPORT_FUNCTION(df_tcdrain);

2
scsh/tty.scm
View File

@ -13,6 +13,8 @@
;;; Copyright (c) 1995 by Brian D. Carlstrom. ;;; Copyright (c) 1995 by Brian D. Carlstrom.
;;; Rehacked by Olin 8/95. ;;; Rehacked by Olin 8/95.
(foreign-init-name "tty")
(foreign-source (foreign-source
"#include <sys/types.h>" "#include <sys/types.h>"
"" ""

24
scsh/tty1.c
View File

@ -16,6 +16,7 @@
#include <termios.h> #include <termios.h>
#include <string.h> #include <string.h>
#include <sys/types.h> #include <sys/types.h>
#include "scheme48.h"
/* This #include is for the #ifdef'd code in open_ctty() below, and /* This #include is for the #ifdef'd code in open_ctty() below, and
** is therefor ifdef'd identically. ** is therefor ifdef'd identically.
@ -53,6 +54,29 @@ int scheme_tcgetattr(int fd, char *control_chars,
return result; 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;
}
/*****************************************************************************/ /*****************************************************************************/

9
scsh/utilities.scm
View File

@ -89,6 +89,15 @@
(define any? first?) (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) (define (every? pred list)
(letrec ((lp (lambda (list) (letrec ((lp (lambda (list)
(or (not (pair? list)) (or (not (pair? list))