a working scsh/static.scm and all the trimmings
This commit is contained in:
parent
bcdc349bcf
commit
f1dc00dcf6
17
Makefile.in
17
Makefile.in
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue