a working scsh/static.scm and all the trimmings

This commit is contained in:
bdc 1996-08-19 08:29:48 +00:00
parent bcdc349bcf
commit f1dc00dcf6
5 changed files with 87 additions and 34 deletions

View File

@ -98,6 +98,7 @@ VM = scshvm
LIBCIG = cig/lib$(VM).a
CIG = cig/cig
CIGOBJS = cig/libcig.o cig/libcig1.o
LIBSCSH = scsh/lib$(VM).a
SCSHVMHACKS = proc2.o # postgcstub.o
SCSHOBJS = \
@ -134,7 +135,7 @@ CONFIG_FILES = interfaces.scm low-packages.scm rts-packages.scm \
# The following is the first rule and therefore the "make" command's
# default target.
enough: $(VM) $(IMAGE) script $(LIBCIG) scsh $(MANPAGE) .notify
enough: $(VM) $(IMAGE) script $(LIBCIG) scsh $(LIBSCSH) $(MANPAGE) .notify
# The developers are curious to know. Don't be concerned if this fails.
# You may comment these lines out if you wish to be discourteous.
@ -183,6 +184,11 @@ $(LIBCIG): main.o $(OBJS)
$(AR) $@ main.o $(OBJS)
$(RANLIB) $@
$(LIBSCSH): smain.o $(OBJS)
$(RM) $@
$(AR) $@ smain.o $(OBJS)
$(RANLIB) $@
main.o: main.c
$(CC) -c -o $@ -DDEFAULT_IMAGE_NAME=\"$(LIB)/scsh.image\" \
$(CPPFLAGS) $(CFLAGS) $(srcdir)/main.c
@ -309,12 +315,14 @@ $(LIB)/link:
configure: configure.in
cd $(srcdir); autoconf
clean: clean-scsh
clean: clean-cig clean-scsh
-rm -f $(VM) *.o TAGS $(IMAGE) *.tmp script $(MANPAGE) \
link/*.image debug/*.image debug/*.debug mini mini-heap.c \
cig/*.o $(CIG) $(CIG).image $(LIBCIG)
-find . -name "*~" -o -name ".#*" -o -name core -exec rm {} \;
clear-cig:
-rm -f cig/*.o $(CIG) $(CIG).image $(LIBCIG)
distclean: clean
$(RM) Makefile sysdep.h config.status config.log config.cache \
scsh/machine scsh/regexp/Makefile scsh/endian.scm \
@ -695,9 +703,10 @@ install-scsh: scsh
$(RM) $(bindir)/$(RUNNABLE)
$(INSTALL_PROGRAM) $(srcdir)/scsh/scsh $(bindir)/$(RUNNABLE)
$(INSTALL_PROGRAM) $(srcdir)/scsh/scsh.image $(LIB)/scsh.image
$(INSTALL_PROGRAM) $(srcdir)/$(LIBSCSH) $(libdir)/$(LIBSCSH)
for f in $(srcdir)/scsh/*.scm; \
do $(INSTALL_DATA) $$f $(LIB)/scsh/; done
clean-scsh:
$(RM) scsh/*.o scsh/regexp/*.o scsh/*.image scsh/scsh install
$(RM) scsh/*.o scsh/regexp/*.o scsh/*.image scsh/scsh $(LIBSCSH)
-cd scsh/regexp; $(MAKE) clean

View File

@ -1,5 +1,5 @@
#!/usr/local/bin/scsh \
-lm /usr/local/lib/scsh/vm/ps-interface.scm -lm /usr/local/lib/scsh/vm/interfaces.scm -lm /usr/local/lib/scsh/vm/package-defs.scm -lm /usr/local/lib/scsh/vm/s48-package-defs.scm -m heap -l /usr/local/lib/scsh/scsh/static-heap.scm -dm -m scsh-static-heap -e scsh-static-linker -s
-lm /usr/local/lib/scsh/vm/ps-interface.scm -lm /usr/local/lib/scsh/vm/interfaces.scm -lm /usr/local/lib/scsh/vm/package-defs.scm -lm /usr/local/lib/scsh/vm/s48-package-defs.scm -dm -m scsh-static-heap -e scsh-static-linker -s
!#
;;; Package for Static heaps for the Scheme Shell
;;; Copyright (c) 1995 by Brian D. Carlstrom.
@ -7,15 +7,15 @@
;;; based on Scheme48 implementation.
;;; Copyright (c) 1993, 1994 by Richard Kelsey and Jonathan Rees.
(define-structure heap-extra (export newspace-begin
heap-pointer
header-a-units
d-vector?
stob-type)
(open scheme heap)
(begin
(define (newspace-begin) *newspace-begin*)
(define (heap-pointer) *hp*)))
;;(define-structure heap-extra (export newspace-begin
;; heap-pointer
;; header-a-units
;; d-vector?
;; stob-type)
;; (open scheme heap)
;; (begin
;; (define (newspace-begin) *newspace-begin*)
;; (define (heap-pointer) *hp*)))
(define-structure scsh-static-heap (export scsh-static-linker)
(open scheme heap memory data stob struct
@ -31,16 +31,20 @@
(define (scsh-static-linker argl)
(if (not (= (length argl) 3))
(error "usage: ~a input-image-file output-archive-file" (car argl))
(error "usage: ~a input-image-file output-executible-file"
(car argl))
(let ((tempdir (or (getenv "TMPDIR")
"@TMPDIR@"))
(cc-command (or (getenv "CC")
"@CC@ @CFLAGS@"))
(ar-command (or (getenv "AR")
"@AR@"))
(cc-command (or (getenv "CC")
"@CC@ @CFLAGS@"))
(linker-flags (or (getenv "LDFLAGS")
"@LDFLAGS@"))
(libraries (or (getenv "LIBS")
"@LIBS@"))
(infile (cadr argl))
(outfile (caddr argl)))
(scsh-do-it infile tempdir outfile cc-command ar-command)
(scsh-do-it infile tempdir outfile
cc-command linker-flags libraries)
(exit 0))))
;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
@ -49,7 +53,8 @@
(objects '())
)
;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
(define (scsh-do-it infile tempdir outfile cc-command ar-command)
(define (scsh-do-it infile tempdir outfile
cc-command linker-flags libraries)
(let* ((temp-dir (format #f "~a/scsh~s" tempdir (pid)))
(prefix (string-append temp-dir "/static"))
(start (read-heap-image infile)))
@ -66,7 +71,7 @@
(write-c-image pure impure reloc externs prefix)
(write-main-c-file start reloc prefix)
(compile-c-files cc-command prefix))
(archive-files ar-command outfile prefix)
(link-files cc-command linker-flags libraries outfile prefix)
)))
@ -230,30 +235,51 @@
(define (compile-c-files cc-command prefix)
(let ((n (nchunks))
(cc (line->list cc-command)))
(cc (append (line->list cc-command) '(-c))))
(message "Compiling main C file")
(message (append cc (list (format #f "~a.c" prefix))))
(run (,@(append cc (list (format #f "~a.c" prefix)))))
(do ((i 0 (+ i 1)))
((= i n))
(message "Compiling C file for pure chunk " i)
(message (append cc (list (format #f "~a-p~s.c" prefix i))))
(run (,@(append cc
(list (format #f "~a-p~s.c" prefix i)))))
(message "Compiling C file for impure chunk " i)
(message (append cc (list (format #f "~a-i~s.c" prefix i))))
(run (,@(append cc
(list (format #f "~a-i~s.c" prefix i))))))))
(define (archive-files ar-command outfile prefix)
(define (link-files cc-command linker-flags libraries outfile prefix)
(let ((n (nchunks))
(ar (line->list ar-command)))
(message "Archiving object files")
(ld (append (line->list cc-command)
(line->list linker-flags)
`(-o ,outfile)))
(libs (line->list libraries)))
(message "Linking executible")
(message (append ld
(let loop ((i 0)
(l '()))
(cond ((not (= i n))
(loop (+ i 1)
(cons
(format #f "~a-i~s.o" prefix i)
(cons
(format #f "~a-p~s.o" prefix i)
l))))
(else
(reverse
(cons
(string-append prefix ".o")
l)))))
'("@prefix@/lib/scsh/libscshvm.a")
libs))
(run (,@(append
ar
(cons
outfile
(let loop ((i 0)
(l '()))
(cond ((not (= i n))
(loop (+ i 1)
ld
(let loop ((i 0)
(l '()))
(cond ((not (= i n))
(loop (+ i 1)
(cons
(format #f "~a-i~s.o" prefix i)
(cons
@ -263,7 +289,9 @@
(reverse
(cons
(string-append prefix ".o")
l)))))))))))
l)))))
'("@prefix@/lib/scsh/libscshvm.a")
libs)))))
(define (scsh-emit-initializer x reloc externs port)
(write-hex port (stob-header x))

View File

@ -3,6 +3,10 @@
; storage should be allocated. Both of these are addresses (not
; descriptors).
; these two are for export in heap-extra for static linker support in scsh
(define (newspace-begin) *newspace-begin*)
(define (heap-pointer) *hp*)
(define check-preallocation? #f)
(define *hp* 0)

View File

@ -109,6 +109,17 @@
walk-over-symbols find-all-xs
))
(define-interface heap-extra-adds-interface
(export newspace-begin
heap-pointer
header-a-units
d-vector?
stob-type))
(define-interface heap-extra-interface
(compound-interface heap-extra-adds-interface
heap-interface))
(define-interface struct-interface
(export vm-pair? vm-pair-size vm-cons vm-car vm-set-car! vm-cdr vm-set-cdr!
vm-symbol? vm-symbol-size vm-symbol->string

View File

@ -15,6 +15,7 @@
(files data))
(define-structures ((heap heap-interface)
(heap-extra heap-extra-interface)
(stob stob-interface))
(open pre-scheme vm-utilities vm-architecture memory data)
(files heap stob gc))