-export C_INCLUDE_PATH=$(srcdir)/h:$(srcdir)/gcl-tk
+C_INCLUDE_PATH:=$(srcdir)/h:$(srcdir)/gcl-tk:$(C_INCLUDE_PATH)
+export C_INCLUDE_PATH
AM_CPPFLAGS=$(BASE_CPPFLAGS)
AM_CFLAGS=$(BASE_CFLAGS)
ln -snf gcl_cmpnopt_$*.lsp ../unixport/gcl_cmpnopt.lsp && \
mkdir h && \
ln -snf ../../h/cmpinclude.h h/ && \
- GCL_LSPSYSDIR=../$(srcdir)/unixport/ \
- ../unixport/raw_$* $$(dirname $$(pwd))/unixport/ -libdir $$(dirname $$(pwd))/ \
- < <(cat ../unixport/init_raw.lsp <(echo "(system:save-system \"../$@\")")) && \
- rm -f ../unixport/gcl_cmpnopt.lsp
+ echo "(system:save-system \"../$@\")" | cat ../unixport/init_raw.lsp - | \
+ GCL_LSPSYSDIR=../$(srcdir)/unixport/ GCL_MEM_BOUND=29 \
+ ../unixport/raw_$* $$(dirname $$(pwd))/unixport/ -libdir $$(dirname $$(pwd))/ && \
+ rm -f ../unixport/gcl_cmpnopt.lsp #FIXME GCL_MEM_BOUND darwin limited raw heap xcode linker __huge issue
rm -rf sb_$*
unixport/raw_%: unixport/lib%.a
- $(CC) $(AM_LDFLAGS) -rdynamic -Wl,-z,relro $(LDFLAGS) -o $@ $< $(LIBS) #FIXME relro
+ $(CC) $(AM_LDFLAGS) -rdynamic $(LDFLAGS) -o $@ $< $(LIBS) #FIXME relro
unixport/gcl_cmpnopt_gcl_gprof.lsp unixport/gcl_cmpnopt_ansi_gcl_gprof.lsp:\
unixport/gcl_cmpnopt_%_gprof.lsp: unixport/gcl_cmpnopt_%.lsp
unixport/pcl_gcl: | unixport/saved_mod_gcl
unixport/ansi_gcl: | unixport/saved_pcl_gcl
$(addprefix unixport/,gcl0 gcl1): unixport/% : unixport/cinit.lisp | %
- $(word 2,$|) < <(cat $< <(echo "(system:save-system \"$@\")"))
+ echo "(system:save-system \"$@\")" | cat $< - | $(word 2,$|)
$(addprefix unixport/,gcl2 gcl3 gcl mod_gcl): unixport/% : | %
ln -snf $$(basename $(word 2,$|)) $@
CLEANFILES+=h/cmpinclude.h h/mstdint.h h/cmpincludea.h h/mcompdefs.h
h/mstdint.h:
- echo "#include <stdint.h>" | $(CC) -E -I./h/ - | $(AWK) '/fsid/ {next} {print}' >$@
+ echo "#include <stdint.h>" | $(CPP) $(AM_CPPFLAGS) -P $(CPPFLAGS) - | $(AWK) '/fsid/ {next} {print}' >$@
h/mcompdefs.h: h/compdefs.h h/new_decl.h
$(AWK) 'BEGIN {print "#include \"include.h\"";print "#include \"page.h\"";print "---"} {a=$$1;gsub("\\.\\.\\.","",a);print "\"#define " $$1 "\" " a}' $< |\
- $(CC) $(AM_CPPFLAGS) $(AM_CFLAGS) -E -P -I./h/ - |\
+ $(CPP) $(AM_CPPFLAGS) -P $(CPPFLAGS) - |\
$(AWK) '/^\-\-\-$$/ {i=1;next} {if (!i) next} {gsub("\"","");print}' >$@
h/cmpincludea.h: $(filter-out gclincl.h,$(CMPINCLUDE_FILES)) | h/gclincl.h # FIXME!
cat $< $| $(filter-out $<,$^) | \
- $(CC) $(AM_CPPFLAGS) $(AM_CFLAGS) -E -I./h/ - | \
+ $(CPP) $(AM_CPPFLAGS) -P $(CPPFLAGS) - | \
$(AWK) '/^# |^$$|^#pragma/ {next}{print}' > $@
h/cmpinclude.h: h/mcompdefs.h h/cmpincludea.h h/cmponly_last.h
h/new_decl.h: $(INI_FILES)
echo '#include "make-decl.h"' > foo.c
cat $^ |sed 's,DEFBFUN,DEFUN,g' >> foo.c
- $(CPP) $(AM_CPPFLAGS) $(CPPFLAGS) foo.c | sed -n -e '/#/d' -e '/DO_/d' -e '/[a-zA-Z;]/p' > $@
+ $(CPP) $(AM_CPPFLAGS) -P $(CPPFLAGS) foo.c | sed -n -e '/DO_/d' -e '/[a-zA-Z;]/p' > $@
rm -f foo.c
o/boot.h: %.h: %.ini
# parallel builds can only have one target accessing an intermediate file
# solved with BUILT_SOURCES
o/%.ini: o/%.c | o/grab_defs
- @$(CPP) $(AM_CPPFLAGS) -DINICOMP -DNO_DEFUN $(CPPFLAGS) $< | $| > new_$(@F)
+ @$(CPP) $(AM_CPPFLAGS) -P -DINICOMP -DNO_DEFUN $(CPPFLAGS) $< | $| > new_$(@F)
@([ -e $@ ] && cmp new_$(@F) $@) || mv -v new_$(@F) $@
@rm -f new_$(@F)
echo '}' >> $@
! cat $@ | awk -F, '/DEFUN/ {print $$1,$$2}' | grep -v object || (rm $@ && false)
+sbr_ansi-tests/random_test: ansi-tests | unixport/saved_ansi_gcl
+ [ -d $(@D) ] || (mkdir $(@D) && cp $</*.lsp $(@D)) # FIXME testsuite in separate directory, hard
+ cd $(@D) && \
+ echo "(load \"gclload1\")" \
+ "(compile-and-load \"random-int-form.lsp\")" \
+ "(in-package :cl-test)" \
+ "(let ((*random-state* (make-random-state t))) \
+ (test-random-integer-forms 100 4 10000))" | \
+ GCL_MEM_BOUND=29 ../$| | tee $(@F) #FIXME MEM_BOUND
+
sb_ansi-tests/test_results: ansi-tests | unixport/saved_ansi_gcl
[ -d $(@D) ] || (mkdir $(@D) && cp $</*.lsp $(@D)) # FIXME testsuite in separate directory, hard
cd $(@D) && echo '(load "gclload")' | ../$| |tee $(@F)
rm -rf $* $(addprefix unixport/,$* lib$*.a saved_$* sys_$*.o gcl_cmpnopt_$*.lsp)
clean-local: $(addprefix clean_,pre_gcl $(MY_DIRS) gcl_gprof ansi_gcl_gprof)
- rm -rf sb_ansi-tests sb_cmpnew sb_bench
+ rm -rf sb_ansi-tests sbr_ansi-tests sb_cmpnew sb_bench
distclean-local:
rm -rf gcl.script unixport/gcl.script #FIXME
--regex='/[ \n\t\#\.`]*(defmfun[ \n\t]+"[^ \n\t"]+"[ \n\t]+\([^ \n\t]+\)/\1/'
TAGS_FILES=lsp/*.lsp cmpnew/*.lsp mod/*.lsp pcl/*sp clcs/*sp xgcl-2/*p
+
+info/gcl.texi: $(addprefix info/,$(addsuffix .texi,\
+ chap-1 chap-2 chap-3 chap-4 chap-5 chap-6 chap-7 chap-8 chap-9 chap-10 chap-11 \
+ chap-12 chap-13 chap-14 chap-15 chap-16 chap-17 chap-18 chap-19 chap-20 chap-21 \
+ chap-22 chap-23 chap-24 chap-25 chap-26 chap-a))
+ touch $@
+
+info/gcl-si.texi: $(addprefix info/,$(addsuffix .texi,\
+ number sequence character list io form compile \
+ symbol system structure iteration user-interface doc type internal c-interface \
+ si-defs debug misc compiler-defs japi))
+ touch $@
+
+info/gcl-tk.texi: $(addprefix info/,$(addsuffix .texi,general widgets control))
+ touch $@
find . \( -type f -a \! \
\( -name .nfs* -o -name .smb* -o -name .__afs* \) \) -print
ACLOCAL = @ACLOCAL@
-ALLOCA = @ALLOCA@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AUTOCONF = @AUTOCONF@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
+C_INCLUDE_PATH := $(srcdir)/h:$(srcdir)/gcl-tk:$(C_INCLUDE_PATH)
AM_CPPFLAGS = $(BASE_CPPFLAGS)
AM_CFLAGS = $(BASE_CFLAGS)
AM_LDFLAGS = $(BASE_LDFLAGS)
.PRECIOUS: Makefile
-export C_INCLUDE_PATH=$(srcdir)/h:$(srcdir)/gcl-tk
+export C_INCLUDE_PATH
unixport/saved_gcl$(EXEEXT):
unixport/saved_ansi_gcl$(EXEEXT):
unixport/saved_gcl_gprof$(EXEEXT):
ln -snf gcl_cmpnopt_$*.lsp ../unixport/gcl_cmpnopt.lsp && \
mkdir h && \
ln -snf ../../h/cmpinclude.h h/ && \
- GCL_LSPSYSDIR=../$(srcdir)/unixport/ \
- ../unixport/raw_$* $$(dirname $$(pwd))/unixport/ -libdir $$(dirname $$(pwd))/ \
- < <(cat ../unixport/init_raw.lsp <(echo "(system:save-system \"../$@\")")) && \
- rm -f ../unixport/gcl_cmpnopt.lsp
+ echo "(system:save-system \"../$@\")" | cat ../unixport/init_raw.lsp - | \
+ GCL_LSPSYSDIR=../$(srcdir)/unixport/ GCL_MEM_BOUND=29 \
+ ../unixport/raw_$* $$(dirname $$(pwd))/unixport/ -libdir $$(dirname $$(pwd))/ && \
+ rm -f ../unixport/gcl_cmpnopt.lsp #FIXME GCL_MEM_BOUND darwin limited raw heap xcode linker __huge issue
rm -rf sb_$*
unixport/raw_%: unixport/lib%.a
- $(CC) $(AM_LDFLAGS) -rdynamic -Wl,-z,relro $(LDFLAGS) -o $@ $< $(LIBS) #FIXME relro
+ $(CC) $(AM_LDFLAGS) -rdynamic $(LDFLAGS) -o $@ $< $(LIBS) #FIXME relro
unixport/gcl_cmpnopt_gcl_gprof.lsp unixport/gcl_cmpnopt_ansi_gcl_gprof.lsp:\
unixport/gcl_cmpnopt_%_gprof.lsp: unixport/gcl_cmpnopt_%.lsp
unixport/pcl_gcl: | unixport/saved_mod_gcl
unixport/ansi_gcl: | unixport/saved_pcl_gcl
$(addprefix unixport/,gcl0 gcl1): unixport/% : unixport/cinit.lisp | %
- $(word 2,$|) < <(cat $< <(echo "(system:save-system \"$@\")"))
+ echo "(system:save-system \"$@\")" | cat $< - | $(word 2,$|)
$(addprefix unixport/,gcl2 gcl3 gcl mod_gcl): unixport/% : | %
ln -snf $$(basename $(word 2,$|)) $@
cat $*.data >>$@
h/mstdint.h:
- echo "#include <stdint.h>" | $(CC) -E -I./h/ - | $(AWK) '/fsid/ {next} {print}' >$@
+ echo "#include <stdint.h>" | $(CPP) $(AM_CPPFLAGS) -P $(CPPFLAGS) - | $(AWK) '/fsid/ {next} {print}' >$@
h/mcompdefs.h: h/compdefs.h h/new_decl.h
$(AWK) 'BEGIN {print "#include \"include.h\"";print "#include \"page.h\"";print "---"} {a=$$1;gsub("\\.\\.\\.","",a);print "\"#define " $$1 "\" " a}' $< |\
- $(CC) $(AM_CPPFLAGS) $(AM_CFLAGS) -E -P -I./h/ - |\
+ $(CPP) $(AM_CPPFLAGS) -P $(CPPFLAGS) - |\
$(AWK) '/^\-\-\-$$/ {i=1;next} {if (!i) next} {gsub("\"","");print}' >$@
h/cmpincludea.h: $(filter-out gclincl.h,$(CMPINCLUDE_FILES)) | h/gclincl.h # FIXME!
cat $< $| $(filter-out $<,$^) | \
- $(CC) $(AM_CPPFLAGS) $(AM_CFLAGS) -E -I./h/ - | \
+ $(CPP) $(AM_CPPFLAGS) -P $(CPPFLAGS) - | \
$(AWK) '/^# |^$$|^#pragma/ {next}{print}' > $@
h/cmpinclude.h: h/mcompdefs.h h/cmpincludea.h h/cmponly_last.h
h/new_decl.h: $(INI_FILES)
echo '#include "make-decl.h"' > foo.c
cat $^ |sed 's,DEFBFUN,DEFUN,g' >> foo.c
- $(CPP) $(AM_CPPFLAGS) $(CPPFLAGS) foo.c | sed -n -e '/#/d' -e '/DO_/d' -e '/[a-zA-Z;]/p' > $@
+ $(CPP) $(AM_CPPFLAGS) -P $(CPPFLAGS) foo.c | sed -n -e '/DO_/d' -e '/[a-zA-Z;]/p' > $@
rm -f foo.c
o/boot.h: %.h: %.ini
# parallel builds can only have one target accessing an intermediate file
# solved with BUILT_SOURCES
o/%.ini: o/%.c | o/grab_defs
- @$(CPP) $(AM_CPPFLAGS) -DINICOMP -DNO_DEFUN $(CPPFLAGS) $< | $| > new_$(@F)
+ @$(CPP) $(AM_CPPFLAGS) -P -DINICOMP -DNO_DEFUN $(CPPFLAGS) $< | $| > new_$(@F)
@([ -e $@ ] && cmp new_$(@F) $@) || mv -v new_$(@F) $@
@rm -f new_$(@F)
echo '}' >> $@
! cat $@ | awk -F, '/DEFUN/ {print $$1,$$2}' | grep -v object || (rm $@ && false)
+sbr_ansi-tests/random_test: ansi-tests | unixport/saved_ansi_gcl
+ [ -d $(@D) ] || (mkdir $(@D) && cp $</*.lsp $(@D)) # FIXME testsuite in separate directory, hard
+ cd $(@D) && \
+ echo "(load \"gclload1\")" \
+ "(compile-and-load \"random-int-form.lsp\")" \
+ "(in-package :cl-test)" \
+ "(let ((*random-state* (make-random-state t))) \
+ (test-random-integer-forms 100 4 10000))" | \
+ GCL_MEM_BOUND=29 ../$| | tee $(@F) #FIXME MEM_BOUND
+
sb_ansi-tests/test_results: ansi-tests | unixport/saved_ansi_gcl
[ -d $(@D) ] || (mkdir $(@D) && cp $</*.lsp $(@D)) # FIXME testsuite in separate directory, hard
cd $(@D) && echo '(load "gclload")' | ../$| |tee $(@F)
rm -rf $* $(addprefix unixport/,$* lib$*.a saved_$* sys_$*.o gcl_cmpnopt_$*.lsp)
clean-local: $(addprefix clean_,pre_gcl $(MY_DIRS) gcl_gprof ansi_gcl_gprof)
- rm -rf sb_ansi-tests sb_cmpnew sb_bench
+ rm -rf sb_ansi-tests sbr_ansi-tests sb_cmpnew sb_bench
distclean-local:
rm -rf gcl.script unixport/gcl.script #FIXME
rm -rf h/config.h #FIXME
+info/gcl.texi: $(addprefix info/,$(addsuffix .texi,\
+ chap-1 chap-2 chap-3 chap-4 chap-5 chap-6 chap-7 chap-8 chap-9 chap-10 chap-11 \
+ chap-12 chap-13 chap-14 chap-15 chap-16 chap-17 chap-18 chap-19 chap-20 chap-21 \
+ chap-22 chap-23 chap-24 chap-25 chap-26 chap-a))
+ touch $@
+
+info/gcl-si.texi: $(addprefix info/,$(addsuffix .texi,\
+ number sequence character list io form compile \
+ symbol system structure iteration user-interface doc type internal c-interface \
+ si-defs debug misc compiler-defs japi))
+ touch $@
+
+info/gcl-tk.texi: $(addprefix info/,$(addsuffix .texi,general widgets control))
+ touch $@
+
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
;; (defmacro referred-length (info)
;; `(length (info-ref ,info)))
-(defun imerge (x y list)
- (nunion x (intersection y list :test 'eq) :test 'eq))
-(declaim (inline imerge))
+(declaim (inline in-env-p))
+(defun in-env-p (x)
+ (typecase x
+ (symbol t)
+ (structure (or (member x *vars*) (member x *blocks*) (member x *tags*) (member x *funs*)))))
(defun add-info (to-info from-info)
;; Allow nil from-info without error CM 20031030
(unless from-info (return-from add-info to-info))
- (macrolet ((mrg (field) `(let* ((r (,field from-info)))
- (when r
- (setf (,field to-info) (imerge (,field to-info) r *vars*)
- (,field to-info) (imerge (,field to-info) r *blocks*)
- (,field to-info) (imerge (,field to-info) r *tags*)
- (,field to-info) (imerge (,field to-info) r *funs*))))))
+ (macrolet ((mrg (field)
+ `(setf (,field to-info)
+ (union (,field to-info)
+ (remove-if-not 'in-env-p (,field from-info))
+ :test 'eq))))
(mrg info-ch)
(mrg info-ref-ccb)
(mrg info-ref-clb)
(mrg info-ref))
(setf (info-flags to-info) (logior (info-flags to-info) (info-flags from-info)))
- (setf (info-ref to-info) (nunion (info-ref to-info) (remove-if-not 'symbolp (info-ref from-info))));FIXME nunion asym
(setf (info-ch-ccb to-info) (nunion (info-ch-ccb to-info) (info-ch-ccb from-info)))
to-info)
-;; (defun add-info (to-info from-info)
-;; ;; Allow nil from-info without error CM 20031030
-;; (unless from-info (return-from add-info to-info))
-;; (macrolet ((mrg (field scrn) `(let* ((r (,field from-info))) (when r (setf (,field to-info) (imerge (,field to-info) r ,scrn)))))
-;; (mrg1 (field) `(let* ((r (,field from-info)))
-;; (when r
-;; (setf (,field to-info) (imerge (,field to-info) r *vars*)
-;; (,field to-info) (imerge (,field to-info) r *blocks*)
-;; (,field to-info) (imerge (,field to-info) r *tags*)
-;; (,field to-info) (imerge (,field to-info) r *funs*))))))
-;; (mrg info-ch *vars*)
-;; (mrg1 info-ref-ccb)
-;; (mrg1 info-ref-clb)
-;; (mrg1 info-ref))
-;; (when (/= (info-sp-change from-info) 0) (setf (info-sp-change to-info) 1))
-;; (setf (info-flags to-info) (logior (info-flags to-info) (info-flags from-info)))
-;; to-info)
-
-;; (defun add-info (to-info from-info)
-;; ;; Allow nil from-info without error CM 20031030
-;; (unless from-info (return-from add-info to-info))
-;; (macrolet ((mrg (field scrn) `(let* ((r (,field from-info))) (when r (setf (,field to-info) (imerge (,field to-info) r ,scrn)))))
-;; (mrg1 (field) `(let* ((r (,field from-info)))
-;; (when r
-;; (setf (,field to-info) (imerge (,field to-info) r *vars*)
-;; (,field to-info) (imerge (,field to-info) r *blocks*)
-;; (,field to-info) (imerge (,field to-info) r *tags*)
-;; (,field to-info) (imerge (,field to-info) r *funs*))))))
-;; (mrg info-ref *vars*)
-;; (mrg info-ch *vars*)
-;; (mrg info-blocks *blocks*)
-;; (mrg info-tags *tags*)
-;; (when *make-fast-ref*
-;; (mrg1 info-vref-ccb)
-;; (mrg1 info-vref-clb)
-;; (mrg1 info-vref)))
-;; (when (/= (info-sp-change from-info) 0) (setf (info-sp-change to-info) 1))
-;; (setf (info-flags to-info) (logior (info-flags to-info) (info-flags from-info)))
-;; to-info)
-
-;; (defun add-info (to-info from-info)
-;; ;; Allow nil from-info without error CM 20031030
-;; (unless from-info (return-from add-info to-info))
-;; (macrolet ((mrg (field scrn) `(let* ((r (,field from-info))) (when r (setf (,field to-info) (imerge (,field to-info) r ,scrn))))))
-;; (mrg info-ref *vars*)
-;; (mrg info-ch *vars*)
-;; (mrg info-blocks *blocks*)
-;; (mrg info-tags *tags*)
-;; (mrg info-vref-ccb *vars*)
-;; (mrg info-vref-clb *vars*)
-;; (mrg info-vref *vars*)
-;; (mrg info-bref-ccb *blocks*)
-;; (mrg info-bref-clb *blocks*)
-;; (mrg info-bref *blocks*)
-;; (mrg info-tref-ccb *tags*)
-;; (mrg info-tref-clb *tags*)
-;; (mrg info-tref *tags*)
-;; (mrg info-fref-ccb *funs*)
-;; ; (mrg info-fref-clb *funs*)
-;; (mrg info-fref *funs*))
-;; (when (/= (info-sp-change from-info) 0) (setf (info-sp-change to-info) 1))
-;; (setf (info-flags to-info) (logior (info-flags to-info) (info-flags from-info)))
-;; to-info)
-
-;; (setf (info-ref to-info) (imerge (info-ref to-info) (info-ref from-info) *vars*)
-;; (info-ch to-info) (imerge (info-ch to-info) (info-ch from-info) *vars*)
-;; (info-blocks to-info) (imerge (info-blocks to-info) (info-blocks from-info) *blocks*)
-;; (info-tags to-info) (imerge (info-tags to-info) (info-tags from-info) *tags*)
-;; (info-vref-ccb to-info) (imerge (info-vref-ccb to-info) (info-vref-ccb from-info) *vars*)
-;; (info-vref-clb to-info) (imerge (info-vref-clb to-info) (info-vref-clb from-info) *vars*)
-;; (info-vref to-info) (imerge (info-vref to-info) (info-vref from-info) *vars*)
-;; (info-bref-ccb to-info) (imerge (info-bref-ccb to-info) (info-bref-ccb from-info) *blocks*)
-;; (info-bref-clb to-info) (imerge (info-bref-clb to-info) (info-bref-clb from-info) *blocks*)
-;; (info-bref to-info) (imerge (info-bref to-info) (info-bref from-info) *blocks*)
-;; (info-tref-ccb to-info) (imerge (info-tref-ccb to-info) (info-tref-ccb from-info) *tags*)
-;; (info-tref-clb to-info) (imerge (info-tref-clb to-info) (info-tref-clb from-info) *tags*)
-;; (info-tref to-info) (imerge (info-tref to-info) (info-tref from-info) *tags*)
-;; (info-fref-ccb to-info) (imerge (info-fref-ccb to-info) (info-fref-ccb from-info) *funs*)
-;; ; (info-fref-clb to-info) (imerge (info-fref-clb to-info) (info-fref-clb from-info) *funs*)
-;; (info-fref to-info) (imerge (info-fref to-info) (info-fref from-info) *funs*)
-;; )
-;; (when (/= (info-sp-change from-info) 0) (setf (info-sp-change to-info) 1))
-;; (setf (info-flags to-info) (logior (info-flags to-info) (info-flags from-info)))
-;; to-info)
-
(defconstant +c1nil+ (list 'LOCATION (make-info :type (object-type nil)) nil))
(defmacro c1nil () `+c1nil+)
(defconstant +c1t+ (list 'LOCATION (make-info :type (object-type t)) t))
do (setq m (si::fread tem 0 n st-b))
while (and m (> m 0))
do (si::fwrite tem 0 m st-a))))))
-
-#+dos
-(progn
-(defun directory (x &aux ans)
- (let* ((pa (pathname x))
- (temp "XXDIR")
- tem
- (name (pathname-name pa)))
- (setq pa (make-pathname :directory (pathname-directory pa)
- :name (or (pathname-name pa) :wild)
- :type (pathname-type pa)))
- (setq name (namestring pa))
- (safe-system (format nil "ls -d ~a > ~a" name temp))
- (with-open-file (st temp)
- (loop (setq tem (read-line st nil nil))
- (if (and tem (setq tem (probe-file tem)))
- (push tem ans) (return))))
- ans))
-
-
-(defun user-homedir-pathname ()
- (or (si::getenv "HOME") "/"))
-
-)
-
;
; These functions are added to build custom images requiring
; the loading of binary objects on systems relocating with dlopen.
NIFLAGS
FINAL_CFLAGS
BASE_LDFLAGS
-ALLOCA
EXT
TCL_LIB_SPEC
TK_LIB_SPEC
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
} # ac_fn_check_decl
-
-# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
-# -------------------------------------------
-# Tests whether TYPE exists after having included INCLUDES, setting cache
-# variable VAR accordingly.
-ac_fn_c_check_type ()
-{
- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
-printf %s "checking for $2... " >&6; }
-if eval test \${$3+y}
-then :
- printf %s "(cached) " >&6
-else case e in #(
- e) eval "$3=no"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$4
-int
-main (void)
-{
-if (sizeof ($2))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"
-then :
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$4
-int
-main (void)
-{
-if (sizeof (($2)))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"
-then :
-
-else case e in #(
- e) eval "$3=yes" ;;
-esac
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;
-esac
-fi
-eval ac_res=\$$3
- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-printf "%s\n" "$ac_res" >&6; }
- eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
-
-} # ac_fn_c_check_type
ac_configure_args_raw=
for ac_arg
do
-std=gnu17 \
-Wall \
-Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \
- -Wno-unused-but-set-variable -D_FILE_OFFSET_BITS=64 -D_TIME_BITS=64
+ -Wno-unused-but-set-variable -D_FILE_OFFSET_BITS=64 -D_TIME_BITS=64 \
+ -fbracket-depth=512
-add_args_to_ldflags -no-pie # -Wl,-z,lazy
+add_args_to_ldflags -no-pie -Wl,-z,relro # -Wl,-z,lazy
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for inline semantics" >&5
printf %s "checking for inline semantics... " >&6; }
#include <unistd.h>
int
main(int argc,char **argv,char **envp) {
- FILE *fp = fopen("conftest1","w"),*f=fopen("/proc/self/maps","r");
+ FILE *fp = fopen("conftest1","w"),*f;
unsigned long i,j;
char b[4096];
i=(unsigned long)alloca(sizeof(void *));
+ f=fopen("/proc/self/maps","r");
for (j=0;j<i && fgets(b,sizeof(b),f);)
sscanf(b,"%x-",&j);
j-=1;
#include <errno.h>
int
main(int argc,char **argv,char **envp) {
- FILE *fp = fopen("conftest1","w"),*f=fopen("/proc/self/maps","r");
+ FILE *fp = fopen("conftest1","w"),*f;
unsigned long i,j;
char b[4096],*stack_map_base;
#include "$srcdir/h/cstack.h"
i=(unsigned long)alloca(sizeof(void *));
+ f=fopen("/proc/self/maps","r");
for (j=0;j<i && fgets(b,sizeof(b),f);)
sscanf(b,"%x-",&j);
j-=1;
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: not found" >&5
printf "%s\n" "not found" >&6; }
fi
- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking output_mach" >&5
-printf %s "checking output_mach... " >&6; }
- output_mach=`cat gcl.script |grep OUTPUT_ARCH|head -n 1|sed 's,.*(\(.*\)).*,\1:,1'|cut -f2 -d:|tr '-' '_'|tr -d '.'`;
- if test "$output_mach" = "common" ; then #FIXME
- output_mach=""
- fi
- defaulted=""
- if test "$output_mach" = "" ; then
- if test "$output_arch" = "i386" ; then
- output_mach="i386_i386";
- defaulted="(defaulted)"
- fi
- fi
- if test "$output_mach" != "" ; then
-
-printf "%s\n" "#define OUTPUT_MACH bfd_mach_${output_mach}" >>confdefs.h
- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $defaulted bfd_mach_${output_mach}" >&5
-printf "%s\n" "$defaulted bfd_mach_${output_mach}" >&6; }
- else
- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: not found" >&5
-printf "%s\n" "not found" >&6; }
- fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: trying to adjust text start" >&5
printf "%s\n" "$as_me: trying to adjust text start" >&6;}
then :
printf "%s\n" "#define HAVE_DIS_ASM_H 1" >>confdefs.h
MLIBS=$LIBS
+
+# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
+# -------------------------------------------
+# Tests whether TYPE exists after having included INCLUDES, setting cache
+# variable VAR accordingly.
+ac_fn_c_check_type ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+printf %s "checking for $2... " >&6; }
+if eval test \${$3+y}
+then :
+ printf %s "(cached) " >&6
+else case e in #(
+ e) eval "$3=no"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+int
+main (void)
+{
+if (sizeof ($2))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"
+then :
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+int
+main (void)
+{
+if (sizeof (($2)))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"
+then :
+
+else case e in #(
+ e) eval "$3=yes" ;;
+esac
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;
+esac
+fi
+eval ac_res=\$$3
+ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+printf "%s\n" "$ac_res" >&6; }
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_type
+ac_fn_c_check_type "$LINENO" "fprintf_styled_ftype" "ac_cv_type_fprintf_styled_ftype" "#include <dis-asm.h>
+"
+if test "x$ac_cv_type_fprintf_styled_ftype" = xyes
+then :
+
+printf "%s\n" "#define HAVE_FPRINTF_STYLED_FTYPE 1" >>confdefs.h
+
+
+fi
+
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for init_disassemble_info in -lopcodes" >&5
printf %s "checking for init_disassemble_info in -lopcodes... " >&6; }
if test ${ac_cv_lib_opcodes_init_disassemble_info+y}
fi
-ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default"
-if test "x$ac_cv_type_size_t" = xyes
-then :
-
-else case e in #(
- e)
-printf "%s\n" "#define size_t unsigned int" >>confdefs.h
- ;;
-esac
-fi
-
-# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works
-# for constant arguments. Useless!
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working alloca.h" >&5
-printf %s "checking for working alloca.h... " >&6; }
-if test ${ac_cv_working_alloca_h+y}
-then :
- printf %s "(cached) " >&6
-else case e in #(
- e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <alloca.h>
-int
-main (void)
-{
-char *p = (char *) alloca (2 * sizeof (int));
- if (p) return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"
-then :
- ac_cv_working_alloca_h=yes
-else case e in #(
- e) ac_cv_working_alloca_h=no ;;
-esac
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.beam \
- conftest$ac_exeext conftest.$ac_ext ;;
-esac
-fi
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_working_alloca_h" >&5
-printf "%s\n" "$ac_cv_working_alloca_h" >&6; }
-if test $ac_cv_working_alloca_h = yes; then
-
-printf "%s\n" "#define HAVE_ALLOCA_H 1" >>confdefs.h
-
-fi
-
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5
-printf %s "checking for alloca... " >&6; }
-if test ${ac_cv_func_alloca_works+y}
-then :
- printf %s "(cached) " >&6
-else case e in #(
- e) ac_cv_func_alloca_works=$ac_cv_working_alloca_h
-if test "$ac_cv_func_alloca_works" != yes
-then :
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <stdlib.h>
-#include <stddef.h>
-#ifndef alloca
-# ifdef __GNUC__
-# define alloca __builtin_alloca
-# elif defined _MSC_VER
-# include <malloc.h>
-# define alloca _alloca
-# else
-# ifdef __cplusplus
-extern "C"
-# endif
-void *alloca (size_t);
-# endif
-#endif
-
-int
-main (void)
-{
-char *p = (char *) alloca (1);
- if (p) return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"
-then :
- ac_cv_func_alloca_works=yes
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.beam \
- conftest$ac_exeext conftest.$ac_ext
-fi ;;
-esac
-fi
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_alloca_works" >&5
-printf "%s\n" "$ac_cv_func_alloca_works" >&6; }
-
-if test $ac_cv_func_alloca_works = yes; then
-
-printf "%s\n" "#define HAVE_ALLOCA 1" >>confdefs.h
-
-else
- # The SVR3 libPW and SVR4 libucb both contain incompatible functions
-# that cause trouble. Some versions do not even contain alloca or
-# contain a buggy version. If you still want to use their alloca,
-# use ar to extract alloca.o from them instead of compiling alloca.c.
-
-ALLOCA=\${LIBOBJDIR}alloca.$ac_objext
-
-printf "%s\n" "#define C_ALLOCA 1" >>confdefs.h
-
-
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking stack direction for C alloca" >&5
-printf %s "checking stack direction for C alloca... " >&6; }
-if test ${ac_cv_c_stack_direction+y}
-then :
- printf %s "(cached) " >&6
-else case e in #(
- e) if test "$cross_compiling" = yes
-then :
- ac_cv_c_stack_direction=0
-else case e in #(
- e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$ac_includes_default
-int
-find_stack_direction (int *addr, int depth)
-{
- int dir, dummy = 0;
- if (! addr)
- addr = &dummy;
- *addr = addr < &dummy ? 1 : addr == &dummy ? 0 : -1;
- dir = depth ? find_stack_direction (addr, depth - 1) : 0;
- return dir + dummy;
-}
-
-int
-main (int argc, char **argv)
-{
- return find_stack_direction (0, argc + !argv + 20) < 0;
-}
-_ACEOF
-if ac_fn_c_try_run "$LINENO"
-then :
- ac_cv_c_stack_direction=1
-else case e in #(
- e) ac_cv_c_stack_direction=-1 ;;
-esac
-fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext ;;
-esac
-fi
- ;;
-esac
-fi
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_stack_direction" >&5
-printf "%s\n" "$ac_cv_c_stack_direction" >&6; }
-printf "%s\n" "#define STACK_DIRECTION $ac_cv_c_stack_direction" >>confdefs.h
-
-
-fi
-
-
#LDFLAGS="`echo $GPL_FLAG $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`"
LDFLAGS="`echo $GPL_FLAG $LDFLAGS`"
-std=gnu17 \
-Wall \
-Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \
- -Wno-unused-but-set-variable -D_FILE_OFFSET_BITS=64 -D_TIME_BITS=64
+ -Wno-unused-but-set-variable -D_FILE_OFFSET_BITS=64 -D_TIME_BITS=64 \
+ -fbracket-depth=512
-add_args_to_ldflags -no-pie # -Wl,-z,lazy
+add_args_to_ldflags -no-pie -Wl,-z,relro # -Wl,-z,lazy
AC_MSG_CHECKING([for inline semantics])
AC_COMPILE_IFELSE(
#include <unistd.h>
int
main(int argc,char **argv,char **envp) {
- FILE *fp = fopen("conftest1","w"),*f=fopen("/proc/self/maps","r");
+ FILE *fp = fopen("conftest1","w"),*f;
unsigned long i,j;
char b[4096];
i=(unsigned long)alloca(sizeof(void *));
+ f=fopen("/proc/self/maps","r");
for (j=0;j<i && fgets(b,sizeof(b),f);)
sscanf(b,"%x-",&j);
j-=1;
#include <errno.h>
int
main(int argc,char **argv,char **envp) {
- FILE *fp = fopen("conftest1","w"),*f=fopen("/proc/self/maps","r");
+ FILE *fp = fopen("conftest1","w"),*f;
unsigned long i,j;
char b[4096],*stack_map_base;
#include "$srcdir/h/cstack.h"
i=(unsigned long)alloca(sizeof(void *));
+ f=fopen("/proc/self/maps","r");
for (j=0;j<i && fgets(b,sizeof(b),f);)
sscanf(b,"%x-",&j);
j-=1;
else
AC_MSG_RESULT([not found])
fi
- AC_MSG_CHECKING([output_mach])
- output_mach=`cat gcl.script |grep OUTPUT_ARCH|head -n 1|sed 's,.*(\(.*\)).*,\1:,1'|cut -f2 -d:|tr '-' '_'|tr -d '.'`;
- if test "$output_mach" = "common" ; then #FIXME
- output_mach=""
- fi
- defaulted=""
- if test "$output_mach" = "" ; then
- if test "$output_arch" = "i386" ; then
- output_mach="i386_i386";
- defaulted="(defaulted)"
- fi
- fi
- if test "$output_mach" != "" ; then
- AC_DEFINE_UNQUOTED(OUTPUT_MACH,bfd_mach_${output_mach},[bfd output mach])
- AC_MSG_RESULT([$defaulted bfd_mach_${output_mach}])
- else
- AC_MSG_RESULT([not found])
- fi
+ dnl FIXME this does not work reliably. Defines added by hand to .h files, but this is fragile.
+ dnl
+ dnl AC_MSG_CHECKING([output_mach])
+ dnl output_mach=`cat gcl.script |grep OUTPUT_ARCH|head -n 1|sed 's,.*(\(.*\)).*,\1:,1'|cut -f2 -d:|tr '-' '_'|tr -d '.'`;
+
+ dnl if test "$output_mach" = "common" ; then #FIXME
+ dnl output_mach=""
+ dnl fi
+ dnl defaulted=""
+ dnl if test "$output_mach" = "" ; then
+ dnl if test "$output_arch" = "i386" ; then
+ dnl output_mach="i386_i386";
+ dnl defaulted="(defaulted)"
+ dnl fi
+ dnl fi
+ dnl if test "$output_mach" != "" ; then
+ dnl AC_DEFINE_UNQUOTED(OUTPUT_MACH,bfd_mach_${output_mach},[bfd output mach])
+ dnl AC_MSG_RESULT([$defaulted bfd_mach_${output_mach}])
+ dnl else
+ dnl AC_MSG_RESULT([not found])
+ dnl fi
AC_MSG_NOTICE([trying to adjust text start])
cp gcl.script gcl.script.def
AC_CHECK_HEADERS(dis-asm.h,
MLIBS=$LIBS
+ AC_CHECK_TYPES([fprintf_styled_ftype],[],[],[#include <dis-asm.h>])
AC_CHECK_LIB(opcodes,init_disassemble_info)
AC_CHECK_LIB(dl,dlopen,#opcodes changes too quickly to link directly
AC_CHECK_FUNCS(print_insn_i386,LIBS="$MLIBS -ldl")))
AC_CHECK_HEADERS(sys/mman.h,AC_CHECK_FUNCS(mprotect))
AC_CHECK_HEADERS(alloca.h)
-AC_FUNC_ALLOCA
-
#LDFLAGS="`echo $GPL_FLAG $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`"
LDFLAGS="`echo $GPL_FLAG $LDFLAGS`"
-"Version_2_7_2ore1"
+"Version_2_7_2ore2"
--- /dev/null
+#!/bin/bash
+
+touch aclocal.m4 \
+ configure.ac gcl-tk/gcltksrv.in bin/gcl.in unixport/init_raw.lsp.in h/gclincl.h.in \
+ configure \
+ Makefile.am Makefile.in \
+ info/gcl.info info/gcl-si.info info/gcl-tk.info info/gcl-dwdoc.info
#define SGC
#define RELOC_H "elf32_i386_reloc.h"
+
+#define OUTPUT_MACH bfd_mach_i386_i386
#undef HAVE_ELF
-/** sbrk(2) emulation */
-
/* Alternatively, we could use the global variable vm_page_size. */
#define PAGEWIDTH 12
-/* The following value determines the running process heap size. */
-/* #define BIG_HEAP_SIZE 0x50000000 */
-
-extern char *mach_mapstart;
-extern char *mach_maplimit;
-extern char *mach_brkpt;
-
-extern char *get_dbegin ();
#include <unistd.h> /* to get sbrk defined */
-extern void *my_sbrk(long incr);
-#define sbrk my_sbrk
/** (si::save-system "...") a.k.a. unexec implementation */
sigaction (SIGSEGV, &sact, 0); \
} while (0);
-/* si_addr not containing the faulting address is a bug in Darwin.
- Work around this by looking at the dar field of the exception state. */
#define GET_FAULT_ADDR(sig,code,sv,a) ((siginfo_t *)code)->si_addr
-/* #define GET_FAULT_ADDR(sig,code,scp,addr) ((char *) (((ucontext_t *) scp)->uc_mcontext->es.dar)) */
-
-/*
-#include <signal.h>
-#include <unistd.h>
-#include <stdio.h>
-#include <sys/ucontext.h>
-
-void handler (int sig, siginfo_t *info, void *scp)
-{
- ucontext_t *uc = (ucontext_t *)scp;
- fprintf(stderr, "addr = 0x%08lx\n", uc->uc_mcontext->es.dar);
- _exit(99);
-}
-
-int main(void)
-{
- struct sigaction sact;
- int ret;
-
- sigfillset(&(sact.sa_mask));
- sact.sa_flags = SA_SIGINFO;
- sact.sa_sigaction = (void (*)())handler;
- ret = sigaction (SIGBUS, &sact, 0);
- return *(int *)0x43;
-}
-*/
/** Misc stuff */
#include <sys/param.h>/*PATH_MAX MAXPATHLEN*/
#undef MIN
#undef MAX
+
+#undef sbrk
+#define sbrk msbrk
+#define INITIALIZE_BRK msbrk_init();
#define NEED_STACK_CHK_GUARD
#define SGC
+
+#define OUTPUT_MACH bfd_mach_aarch64
/*FIXME probe broken in recent kernels, no access*/
/* #define DEFINED_REAL_MAXPAGE (1UL<<18) /\*FIXME brk probe broken*\/ */
+
+#define OUTPUT_MACH bfd_mach_alpha_ev6
#define MAX_CODE_ADDRESS (1L<<31)/*large memory model broken gcc 4.8*/
#define MAX_DEFAULT_MEMORY_MODEL_CODE_ADDRESS (1UL<<31)
#define LARGE_MEMORY_MODEL /*working -mcmodel=large giving unrestricted code load addresses*/
+
+#define OUTPUT_MACH bfd_mach_x86_64
#define SPECIAL_RELOC_H "elf32_arm_reloc_special.h"
#define NEED_STACK_CHK_GUARD
+
+#define OUTPUT_MACH bfd_mach_arm_9
#define SPECIAL_RELOC_H "elf32_armhf_reloc_special.h"
#define NEED_STACK_CHK_GUARD
+
+#define OUTPUT_MACH bfd_mach_arm_9
{
void *p,*p1,*b,*s;
int a,f=MAP_FIXED|MAP_PRIVATE|MAP_ANON|MAP_STACK;
+ int ss=
+#ifdef CHECK_FOR_QEMU
+ qemu_p() ? FIXED_STACK :
+#endif
+ SS;
p=alloca(1);
p1=alloca(1);
- b=CTOP-(p1<p ? SS : FIXED_STACK);
+ b=CTOP-(p1<p ? ss : FIXED_STACK);
a=p1<p ? p-p1 : p1-p;
a<<=2;
s=p1<p ? CTOP-a : b+a;
if (p1<p) f|=MAP_GROWSDOWN;
if (p > CTOP || p < b) {
- if (mmap(b,SS,PROT_READ|PROT_WRITE|PROT_EXEC,f,-1,0)!=(void *)-1) {
+ if (mmap(b,ss,PROT_READ|PROT_WRITE|PROT_EXEC,f,-1,0)!=(void *)-1) {
stack_map_base=b;
asm volatile (SET_STACK_POINTER::"r" (s):"memory");
if (p1>p)
/* whether C stack grows up or down */
#undef CSTACK_DIRECTION
-/* Define to 1 if using 'alloca.c'. */
-#undef C_ALLOCA
-
/* debug safecdr code */
#undef DEBUG_SAFE_CDR
/* using gmp */
#undef GMP
-/* Define to 1 if you have 'alloca', as a function or macro. */
-#undef HAVE_ALLOCA
-
-/* Define to 1 if <alloca.h> works. */
+/* Define to 1 if you have the <alloca.h> header file. */
#undef HAVE_ALLOCA_H
/* have __builtin__clear_cache instruction */
/* Define to 1 if you have the <float.h> header file. */
#undef HAVE_FLOAT_H
+/* Define to 1 if the system has the type 'fprintf_styled_ftype'. */
+#undef HAVE_FPRINTF_STYLED_FTYPE
+
/* Define to 1 if you have the 'getcwd' function. */
#undef HAVE_GETCWD
/* bfd output arch */
#undef OUTPUT_ARCH
-/* bfd output mach */
-#undef OUTPUT_MACH
-
/* Name of package */
#undef PACKAGE
/* The size of 'short', as computed by sizeof. */
#undef SIZEOF_SHORT
-/* If using the C implementation of alloca, define if you know the
- direction of stack growth for your system; otherwise it will be
- automatically deduced at runtime.
- STACK_DIRECTION > 0 => grows toward higher addresses
- STACK_DIRECTION < 0 => grows toward lower addresses
- STACK_DIRECTION = 0 => direction of growth unknown */
-#undef STACK_DIRECTION
-
/* staticly linked images */
#undef STATIC_LINKING
/* short gmp3 limbs */
#undef __SHORT_LIMB
-
-/* Define as 'unsigned int' if <stddef.h> doesn't define. */
-#undef size_t
#define RELOC_H "elf32_hppa_reloc.h"
#define SPECIAL_RELOC_H "elf32_hppa_reloc_special.h"
+
+#define OUTPUT_MACH bfd_mach_hppa11
/* #define MAX_CODE_ADDRESS (1L<<31)/\*large memory model broken gcc 4.8*\/ */
#define NEED_STACK_CHK_GUARD
+
+#define OUTPUT_MACH bfd_mach_loongarch64
#define NEED_STACK_CHK_GUARD
/* #define DEFINED_REAL_MAXPAGE (1UL<<18) /\*FIXME brk probe broken*\/ */
+
+#define OUTPUT_MACH bfd_mach_m68060
#include "linux.h"
#define SGC
+
+#define OUTPUT_MACH bfd_mach_mipsisa64r6
#if SIZEOF_LONG == 4
#define RELOC_H "elf32_ppc_reloc.h"
+#define OUTPUT_MACH bfd_mach_ppc
#else
#ifdef WORDS_BIGENDIAN
#define RELOC_H "elf64_ppc_reloc.h"
#define RELOC_H "elf64_ppcle_reloc.h"
#define SPECIAL_RELOC_H "elf64_ppcle_reloc_special.h"
#endif
+#define OUTPUT_MACH bfd_mach_ppc64
#define C_GC_OFFSET 4
#endif
/* #define MAX_CODE_ADDRESS (1L<<31)/\*large memory model broken gcc 4.8*\/ */
#define NEED_STACK_CHK_GUARD
+
+#define OUTPUT_MACH bfd_mach_riscv64
#define C_GC_OFFSET 4
#define RELOC_H "elf64_s390_reloc.h"
#define SPECIAL_RELOC_H "elf64_sparc_reloc_special.h"
+#define OUTPUT_MACH #define bfd_mach_s390_64
#else
#define RELOC_H "elf32_s390_reloc.h"
+#define OUTPUT_MACH #define bfd_mach_s390_32
#endif
+
#define NEED_STACK_CHK_GUARD
/* #define DEFINED_REAL_MAXPAGE (1UL<<18) /\*FIXME brk probe broken*\/ */
+
+#define OUTPUT_MACH bfd_mach_sh4
/* #if SIZEOF_LONG == 8 */
/* #define C_GC_OFFSET 4 */
/* #endif */
+
+#define OUTPUT_MACH bfd_mach_sparc_v9
@end defun
@defvr {Constant} CHAR-SUPER-BIT
-Package:LISP
+Package:SI
The bit that indicates a super character.
@end defvr
@defvr {Constant} CHAR-FONT-LIMIT
-Package:LISP
+Package:SI
The upper exclusive bound on values produced by CHAR-FONT.
@end defun
@defun STRING-CHAR-P (char)
-Package:LISP
+Package:SI
Returns T if CHAR can be stored in a string. In GCL, this function always
returns T since any character in GCL can be stored in a string.
@end defun
@defvr {Constant} CHAR-HYPER-BIT
-Package:LISP
+Package:SI
The bit that indicates a hyper character.
@end defun
@defvr {Constant} CHAR-CONTROL-BIT
-Package:LISP
+Package:SI
The bit that indicates a control character.
@end defun
@defun CHAR-FONT (char)
-Package:LISP
+Package:SI
Returns the font attribute of CHAR.
@end defun
@defvr {Constant} CHAR-META-BIT
-Package:LISP
+Package:SI
The bit that indicates a meta character.
@end defun
@defvr {Constant} CHAR-BITS-LIMIT
-Package:LISP
+Package:SI
The upper exclusive bound on values produced by CHAR-BITS.
@end defun
@defun CHAR-BIT (char name)
-Package:LISP
+Package:SI
Returns T if the named bit is on in the character CHAR; NIL otherwise.
In GCL, this function always returns NIL.
@end defun
@defun MAKE-CHAR (char &optional (bits 0) (font 0))
-Package:LISP
+Package:SI
Returns a character object with the same code attribute as CHAR and with
the specified BITS and FONT attributes.
@end defun
@defun CHAR-BITS (char)
-Package:LISP
+Package:SI
Returns the bits attribute (which is always 0 in GCL) of CHAR.
@end defun
@defun SET-CHAR-BIT (char name newvalue)
-Package:LISP
+Package:SI
Returns a character just like CHAR except that the named bit is set or
cleared, according to whether NEWVALUE is non-NIL or NIL. This function
@end defun
@defun LINK (files image &optional post extra-libs (run-user-init t) &aux raw init)
-Package:LISP
+Package:COMPILER
On systems where dlopen is used for relocations, one cannot make custom
images containing loaded binary object files simply by loading the files
@end defun
-
-@defun GPROF-SET (begin end)
-Package:SYSTEM
-
-GCL now has preliminary support for profiling with gprof, an
-externally supplied profiling tool at the C level which typically
-accompanies gcc. Support must be enabled at compile time with
---enable-gprof. This function sets the address range used by
-GPROF-START in specifying the section of the running program which is
-to be profiled. All subsequent calls to GPROF-START will use this new
-address range. By default, the range is set to begin at the starting
-address of the .text section, and to end at the current end of the
-running core. These default values can be restored by calling
-GPROF-SET with both argments set to 0.
-
-@end defun
-
-
@defvar *DEFAULT-SYSTEM-P*
Package:COMPILER
Specifies the default setting of :SYSTEM-P used by COMPILE. Defaults to NIL.
@end example
@end defun
-@defun COMPILER-DEFAULT-TYPE (pathname)
+@defun *COMPILER-DEFAULT-TYPE* (pathname)
Package:COMPILER
Allows you to set the default file extension for compiler source files.
@end example
-@end defun
-@defun COMPILER-RESET-TYPE ()
-Package:COMPILER
-
-Resets the default compiler input file extension to the GCL historical
-value of #''.lsp''.
-
@end defun
@defvar *CC*
Package:COMPILER
@end defvr
@defun GET-SETF-METHOD (form)
-Package:LISP
+Package:SI
Returns the five values (or five 'gangs') constituting the SETF method for
FORM. See the doc of DEFINE-SETF-METHOD for the meanings of the gangs. It
@end deffn
@defvar *EVALHOOK*
-Package:LISP
+Package:SI
If *EVALHOOK* is not NIL, its value must be a function that can receive
two arguments: a form to evaluate and an environment. This function does
the evaluation instead of EVAL.
@end defvr
@defun APPLYHOOK (function args evalhookfn applyhookfn &optional (env nil))
-Package:LISP
+Package:SI
Applies FUNCTION to ARGS, with *EVALHOOK* bound to EVALHOOKFN and with
*APPLYHOOK* bound to APPLYHOOKFN. Ignores the hook function once, for the
@end deffn
@defun GET-SETF-METHOD-MULTIPLE-VALUE (form)
-Package:LISP
+Package:SI
Returns the five values (or five 'gangs')
constituting the SETF method for FORM. See the doc of
DEFINE-SETF-METHOD for the meanings of the gangs. The third value
@end deffn
@deffn {Macro} DEFINE-SETF-METHOD
-Package:LISP
+Package:SI
Syntax:
@example
@end deffn
@deffn {Special Form} COMPILER-LET
-Package:LISP
+Package:SI
Syntax:
@example
@end deffn
@defvar *APPLYHOOK*
-Package:LISP
+Package:SI
Used to substitute another function for the implicit APPLY normally done
within EVAL. If *APPLYHOOK* is not NIL, its value must be a function
which takes three arguments: a function to be applied, a list of arguments,
@end deffn
@defun EVALHOOK (form evalhookfn applyhookfn &optional (env nil))
-Package:LISP
+Package:SI
Evaluates FORM with *EVALHOOK* bound to EVALHOOKFN and *APPLYHOOK* bound
to APPLYHOOKFN. Ignores these hooks once, for the top-level evaluation
@chapter GCL Specific
@defun SYSTEM (string)
-Package:LISP
+Package:SI
GCL specific: Executes a Shell command as if STRING is an input to the
Shell. Not all versions of GCL support this function. At least on
on which GCL is currently running.
-@end defun
-
-@defun BY ()
-Package:LISP
-
-GCL specific: Exits from GCL.
-
-
@end defun
@deffn {Macro} DEFCFUN
-Package:LISP
+Package:SI
Syntax:
@example
@end deffn
@deffn {Macro} CLINES
-Package:LISP
+Package:SI
Syntax:
@example
@end defun
@defun ALLOCATE (type number &optional (really-allocate nil))
-Package:LISP
+Package:SI
GCL specific: Sets the maximum number of pages for the type class of the
GCL implementation type TYPE to NUMBER. If REALLY-ALLOCATE is given a
@end defun
@defun GBC (x)
-Package:LISP
+Package:SI
GCL specific: Invokes the garbage collector (GC) with the collection level
specified by X. NIL as the argument causes GC to collect cells only. T as
@end defun
@defun SAVE (pathname)
-Package:LISP
+Package:SI
GCL specific: Saves the current GCL core image into a program file specified
by PATHNAME. This function depends on the version of GCL. The function
@end defun
@defun HELP* (string &optional (package 'lisp))
-Package:LISP
+Package:USER
GCL specific: Prints the documentation associated with those symbols in the
specified package whose print names contain STRING as substring. STRING may
@end defun
@deffn {Macro} DEFLA
-Package:LISP
+Package:SI
Syntax:
@example
@end defun
@deffn {Macro} DEFENTRY
-Package:LISP
+Package:SI
Syntax:
@example
@end defun
@defun BYE ( &optional (exit-status 0))
-Package:LISP
+Package:SI
GCL specific: Exits from GCL with exit-status.
@end defun
@defun USE-FAST-LINKS (turn-on)
-Package:LISP
+Package:SI
GCL specific: If TURN-ON is not nil, the fast link mechanism is enabled,
so that ordinary function calls will not appear in the invocation stack,
@end defun
@defun INT-CHAR (integer)
-Package:LISP
+Package:SI
Performs the inverse of CHAR-INT. Equivalent to CODE-CHAR in GCL.
calling this the defstruct should not be altered.
-@end defun
-@defun MAXIMUM-ALLOCATABLE-PAGES (type)
-Package:SI
-
-GCL specific: Returns the current maximum number of pages for the type class
-of the GCL implementation type TYPE.
-
-
@end defun
@defun ALLOCATED-RELOCATABLE-PAGES ()
Package:SI
Give SYMBOL the VALUE on INDICATOR property.
-@end defun
-@defun ALLOCATED-PAGES (type)
-Package:SI
-
-GCL specific: Returns the number of pages currently allocated for the type
-class of the GCL implementation type TYPE.
-
-
@end defun
@defun ALLOCATE-RELOCATABLE-PAGES (number)
Package:SI
type.
-@end defun
-@defun CATCH-BAD-SIGNALS ()
-Package:SI
-
-GCL/BSD specific: Installs a signal catcher for bad signals:
- SIGILL, SIGIOT, SIGEMT, SIGBUS, SIGSEGV, SIGSYS.
-The signal catcher, upon catching the signal, signals an error (and enter
-the break-level). Since the internal memory of GCL may be broken, the user
-should check the signal and exit from GCL if necessary. When the signal
-is caught during garbage collection, GCL terminates immediately.
-
-
@end defun
@defun RESET-STACK-LIMITS ()
Package:SI
@end defvar
-@defvar *GBC-NOTIFY*
+@defvar *NOTIFY-GBC*
Package:SI
GCL specific: If the value is non-NIL, the garbage
collector prints a very brief one line message about the area causing the collection,
@end defvar
-@deffn {Funcition} ALLOCATED (type)
+@deffn {Function} ALLOCATED (type)
Package:SI
Returns 6 values:
resetting io streams. It would not be possible to continue normally.
-@end defun
-@defun UNCATCH-BAD-SIGNALS ()
-Package:SI
-
-GCL/BSD specific: Undoes the effect of SI:CATCH-BAD-SIGNALS.
-
-
@end defun
@defun VS (i)
Package:SI
@end defun
-@defvar *DEFAULT-TIME-ZONE*
-Package:SI
-GCL specific: Holds the default time zone. The initial value of SI:*DEFAULT-
-TIME-ZONE* is 6 (the time zone of Austin, Texas).
-
-
-@end defvar
@defun GETENV (string)
Package:SI
@end defun
-@defun WRITE-DEBUG-SYMBOLS (start file &key (main-file "/usr/local/schelter/xgcl/unixport/raw_gcl") (output-file "debug-symbols.o" ))
-Package:SI
-
-Write out a file of debug-symbols using address START as the place
-where FILE will be loaded into the running executable MAIN-FILE. The
-last is a keyword argument.
-
-
-
-
-@end defun
-@defun PROF (x y)
-Package:SI
+@c @defun PROF (x y)
+@c Package:SI
-These functions in the SI package are GCL specific, and allow monitoring
-the run time of functions loaded into GCL, as well as the basic functions.
- Sample Usage:
- (si::set-up-profile 1000000) (si::prof 0 90)
- run program
- (si::prof 0 0) ;; turn off profile
- (si::display-prof)
- (si::clear-profile)
- (si::prof 0 90) ;; start profile again
- run program
- ..
- Profile can be stopped with (si::prof 0 0) and restarted with (si::prof 0 90)
-The START-ADDRESS will correspond to the beginning of the profile array, and
-the SCALE will mean that 256 bytes of code correspond to SCALE bytes in the
-profile array.
+@c These functions in the SI package are GCL specific, and allow monitoring
+@c the run time of functions loaded into GCL, as well as the basic functions.
+@c Sample Usage:
+@c (si::set-up-profile 1000000) (si::prof 0 90)
+@c run program
+@c (si::prof 0 0) ;; turn off profile
+@c (si::display-prof)
+@c (si::clear-profile)
+@c (si::prof 0 90) ;; start profile again
+@c run program
+@c ..
+@c Profile can be stopped with (si::prof 0 0) and restarted with (si::prof 0 90)
+@c The START-ADDRESS will correspond to the beginning of the profile array, and
+@c the SCALE will mean that 256 bytes of code correspond to SCALE bytes in the
+@c profile array.
-Thus if the profile array is 1,000,000 bytes long and the code segment is
-5 megabytes long you can profile the whole thing using a scale of 50
-Note that long runs may result in overflow, and so an understating of the
-time in a function.
+@c Thus if the profile array is 1,000,000 bytes long and the code segment is
+@c 5 megabytes long you can profile the whole thing using a scale of 50
+@c Note that long runs may result in overflow, and so an understating of the
+@c time in a function.
-You must run intensively however since, with a scale of 128 it takes
-6,000,000 times through a loop to overflow the sampling in one part of
-the code.
+@c You must run intensively however since, with a scale of 128 it takes
+@c 6,000,000 times through a loop to overflow the sampling in one part of
+@c the code.
-@end defun
+@c @end defun
@defun CATCH-FATAL (i)
Package:SI
@end deffn
@defun HELP (&optional symbol)
-Package:LISP
+Package:USER
GCL specific: Prints the documentation associated with SYMBOL. With no
argument, this function prints the greeting message to GCL beginners.
@end defun
@defun COMMONP (x)
-Package:LISP
+Package:SI
Returns T if X is a Common Lisp object; NIL otherwise.
@end deffn
@defvar *BREAK-ENABLE*
-Package:LISP
+Package:SI
GCL specific: When an error occurrs, control enters to the break loop only
if the value of this variable is non-NIL.
@end defvar
@defvar *BREAK-ON-WARNINGS*
-Package:LISP
+Package:SI
When the function WARN is called, control enters to the break loop only
if the value of this varialbe is non-NIL.
(defseq union (nil (l1 l2) :list t)
(let (rp)
- (prog1 (or (mapcan (lambda (x)
+ (prog1 (or (unless l2 l1)
+ (mapcan (lambda (x)
(unless (member (key x) l2 :test #'test)
(setq rp (cons x nil))))
l1)
(defseq set-difference (nil (l1 l2) :list t)
- (mapcan (lambda (x)
+ (if l2
+ (mapcan (lambda (x)
(unless (member (key x) l2 :test #'test)
(cons x nil)))
- l1))
+ l1)
+ l1))
(defseq set-exclusive-or (nil (l1 l2) :list t)
- (let (rp (rr (copy-list l2)))
- (prog1 (or (mapcan (lambda (x &aux (k (key x)))
+ (let (rp tmp n2)
+ (declare (dynamic-extent tmp))
+ (or (unless l2 l1)
+ (prog1 (mapcan (lambda (x &aux (k (key x)))
(if (member k l2 :test #'test)
- (unless (setq rr (delete k rr :test #'test)))
+ (unless (push k tmp))
(setq rp (cons x nil))))
l1)
- rr)
- (when rp (rplacd rp rr)))))
+ (setq n2 (set-difference l2 tmp :test (lambda (x y) (funcall #'test y x))))
+ (when rp (rplacd rp n2)))
+ n2)))
(defseq nintersection (nil (l1 l2) :list t)
(let (r rp)
(defbltin clzl)
(defbltin ctzl)
-(defbltin popcountl)
+#-darwin(defbltin popcountl) ;Macports builtin calls external function outside symbol table
+#+darwin(defmacro popcountl (x) `(popcount ,x))
(defbltin parityl)
(defbltin ffsl)
(defun canonicalize-pathname-directory (l)
(cond ((eq l :wild) (canonicalize-pathname-directory '(:absolute :wild-inferiors)))
((stringp l) (canonicalize-pathname-directory (list :absolute l)))
- ((mapl (lambda (x &aux (c (car x)))
- (when (and (or (stringp c) (eq c :wild)) (eq (cadr x) :back))
+ ((mapl (lambda (x &aux (c (car x))
+ (skip (cond ((equal c ".") (cdr x))
+ ((when (or (stringp c) (eq c :wild)) (eq (cadr x) :back)) (cddr x)))))
+ (when skip
(return-from canonicalize-pathname-directory
- (canonicalize-pathname-directory (nconc (ldiff-nf l x) (cddr x))))))
+ (canonicalize-pathname-directory (nconc (ldiff-nf l x) skip)))))
l))))
(defvar *default-pathname-defaults* (init-pathname nil nil nil nil nil nil ""))
#ifdef USE_READLINE
if (readline_on && strm->sm.sm_fp==rl_instream)
- if (rl_line_buffer) return *rl_line_buffer ? TRUE : FALSE;
+ /*FIXME homogenize this*/
+ if (rl_line_buffer) return *rl_line_buffer && *rl_line_buffer!=EOF ? TRUE : FALSE;
#endif
if (strm->sm.sm_fp == NULL)
closed_stream(strm);
ssize_t i;
char *p;
- if (*s && (n=strlen(FN1))) {
+ if (*s) {
+ n=strlen(FN1);
memmove(FN1,FN1+n+1,sizeof(FN1)-(n+1));
*s-=n+1;
}
}
+int
+qemu_p(void) {
+
+#if !defined(DARWIN) && !defined(__CYGWIN__) && !defined(__MINGW32__) && !defined(__MINGW64__)/*FIXME*/
+
+ char *c;
+ ufixnum e,r=0;
+ int l;
+
+ massert((l=open("/proc/cpuinfo",O_RDONLY))!=-1);
+
+ for (e=0;!e && (c=next_line(l,&r));)
+ e=!memcmp("model",c,5) && strstr(c,"QEMU");
+
+ massert(!close(l));
+
+ return e;
+
+#else
+
+ return 0;
+
+#endif
+}
+
static void *
next_shared_lib_map_no_malloc(void) {
bds_top = bds_org-1;
frs_top = frs_org-1;
+#define CHECK_FOR_QEMU
#include "cstack.h"
gcl_init_alloc(alloca(1));
return r;
}
+#ifdef HAVE_FPRINTF_STYLED_FTYPE
static int
my_fprintf_styled(void *v,enum disassembler_style,const char *f,...) {
va_list va;
va_end(va);
return r;
}
+#endif
static int
my_read(bfd_vma memaddr, bfd_byte *myaddr, unsigned int length, struct disassemble_info *dinfo) {
if ((v=dlopen("libopcodes.so",RTLD_NOW))) {
if ((s=dlsym(v,"init_disassemble_info"))) {
- s(&i, stdout,(fprintf_ftype) my_fprintf,my_fprintf_styled);
+ s(&i, stdout,(fprintf_ftype)my_fprintf
+#ifdef HAVE_FPRINTF_STYLED_FTYPE
+ ,my_fprintf_styled
+#endif
+ );
i.read_memory_func=my_read;
i.print_address_func=my_pa;
#if defined(OUTPUT_MACH)
i.mach=OUTPUT_MACH;
#endif
if ((s=dlsym(v,"disassembler"))) {
- disassembler_ftype disasm=(disassembler_ftype)(ufixnum)s(OUTPUT_ARCH,false,0,NULL);/*bfd_mach_x86_64*/
+ disassembler_ftype disasm=(disassembler_ftype)(ufixnum)s(OUTPUT_ARCH,0,0,NULL);
bp=b;
disasm(addr,&i);
my_fprintf(NULL," ;");
}
-#if !defined(DARWIN) && !defined(__CYGWIN__) && !defined(__MINGW32__) && !defined(__MINGW64__)/*FIXME*/
+#if !defined(__CYGWIN__) && !defined(__MINGW32__) && !defined(__MINGW64__)/*FIXME*/
static void *
new_map(void *v,ufixnum s) {
return mmap(v,s,PROT_READ|PROT_WRITE|PROT_EXEC,MAP_PRIVATE|MAP_ANON|MAP_FIXED,-1,0);
}
+#if defined(DARWIN)
+/*This initial heap must be large enough to initialize the raw image,
+ but not so large that the Mac linker ignores the segment designation
+ and creates a __huge section under __DATA for this and other
+ variables. We enlarge this on unexec.*/
+asm (".zerofill __HEAP,__heap,__end,0x70000000\n\t.globl __end");
+#endif
+
int
msbrk_init(void) {
}
-
void
gcl_init_num_sfun(void)
{
if (LOAD_SEC(sec))
memcpy((void *)sec->addr,v1+sec->offset,sec->size);
else
- bzero((void *)sec->sh_addr,sec->sh_size);
+ bzero((void *)sec->addr,sec->size);
}
if (**got) {
unsigned num_marked_regions;
-/* Size of the heap. */
-static unsigned long big_heap;
-
/* Start of the heap. */
char *mach_mapstart = 0;
unexec_error ("cannot write header of __DATA segment");
curr_header_offset += lc->cmdsize;
- /* Create new __DATA segment load commands for regions on the region
- list that do not corresponding to any segment load commands in
- the input file.
- */
- /* for (j = 0; j < num_unexec_regions; j++) */
- {
- struct segment_command sc;
-
- sc.cmd = LC_SEGMENT;
- sc.cmdsize = sizeof (struct segment_command);
- /* strncpy (sc.segname, SEG_DATA, 16); */
- strncpy (sc.segname, "__HEAP", 16);
- sc.vmaddr = (long)mach_mapstart;
- sc.vmsize = mach_maplimit-mach_mapstart;
- sc.fileoff = curr_file_offset;
- sc.filesize = core_end-mach_mapstart;
- sc.maxprot = VM_PROT_READ | VM_PROT_WRITE | VM_PROT_EXECUTE;
- sc.initprot = VM_PROT_READ | VM_PROT_WRITE /* | VM_PROT_EXECUTE */;
- sc.nsects = 0;
- sc.flags = 0;
-
-#if VERBOSE
- printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n",
- sc.segname, (long) (sc.fileoff), (long) (sc.filesize),
- (long) (sc.vmsize), (long) (sc.vmaddr));
-#endif
-
- if (!unexec_write (sc.fileoff, (void *) sc.vmaddr, sc.filesize))
- unexec_error ("cannot write new __DATA segment");
- curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (sc.filesize);
-
- if (!unexec_write (curr_header_offset, &sc, sc.cmdsize))
- unexec_error ("cannot write new __DATA segment's header");
- curr_header_offset += sc.cmdsize;
- mh.ncmds++;
- }
}
/* Copy a LC_SYMTAB load command from the input file to the output
dump_it () {
int i;
- long linkedit_delta = 0;
+ long linkedit_delta=0,linkedit_vmdelta=0;
#if VERBOSE
printf ("--- Load Commands written to Output File ---\n");
copy_data_segment (lca[i]);
- } else {
+ } else if (strncmp (scp->segname, "__HEAP", 16) == 0) {
- if (strncmp (scp->segname, SEG_LINKEDIT, 16) == 0) {
- if (linkedit_delta)
- unexec_error ("cannot handle multiple LINKEDIT segments in input file");
- linkedit_delta = curr_file_offset - scp->fileoff;
- }
+ extern char *data_start;
+ struct section *sectp = (struct section *) (scp + 1);
+ unsigned long header_offset=curr_header_offset + sizeof (struct segment_command);
- if (strncmp (scp->segname, "__HEAP", 16) != 0) copy_segment (lca[i]); else mh.ncmds--;
+ scp->vmaddr=(long)data_start;
+ linkedit_vmdelta=(1UL<<37)-scp->vmsize;
+ scp->vmsize=(1UL<<37);
+ scp->fileoff=curr_file_offset;
+ scp->filesize=core_end-data_start;
+ scp->maxprot=VM_PROT_READ | VM_PROT_WRITE | VM_PROT_EXECUTE;
+ scp->initprot=VM_PROT_READ | VM_PROT_WRITE;
+ scp->nsects=1;
+ scp->flags=S_REGULAR;
- }
+ sectp->addr=scp->vmaddr;
+ sectp->size=scp->filesize;
+ sectp->flags=S_REGULAR;
+
+ if (!unexec_write (header_offset, sectp, sizeof (struct section)))
+ unexec_error ("cannot write section _HEAP's header");
+
+ if (!unexec_write (scp->fileoff, (void *) scp->vmaddr, scp->filesize))
+ unexec_error ("cannot write __HEAP segment");
+ curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (scp->filesize);
+
+ if (!unexec_write (curr_header_offset, scp, sizeof (struct segment_command)))
+ unexec_error ("cannot write header of __HEAP segment");
+ curr_header_offset += scp->cmdsize;
+
+ } else if (strncmp (scp->segname, SEG_LINKEDIT, 16) == 0) {
+
+ if (linkedit_delta)
+ unexec_error ("cannot handle multiple LINKEDIT segments in input file");
+ linkedit_delta = curr_file_offset - scp->fileoff;
+ scp->vmaddr+=linkedit_vmdelta;
+ copy_segment (lca[i]);
+ } else
+ copy_segment (lca[i]);
}
break;
case LC_SYMTAB:
}
-/* Replacement for broken sbrk(2). */
-
-#include <sys/mman.h>
-#include <errno.h>
-unsigned long
-probe_big_heap(unsigned long try,unsigned long inc,unsigned long max) {
-
- void *r;
-
- if ((r=mmap(NULL, try, PROT_READ|PROT_WRITE, MAP_PRIVATE | MAP_ANON, -1, 0))==(void *)-1)
- return try>inc ? probe_big_heap(try-inc,inc>>1,max) : 0;
- munmap(r,try);
- return (!inc || try >=max) ? try : probe_big_heap(try+inc,inc,max);
-
-}
-
-void *my_sbrk (long incr)
-{
- char *temp, *ptr;
-
- if (mach_brkpt == 0) {
-
- big_heap=(1UL)<<35;
- if (!(big_heap=probe_big_heap(PAGESIZE,big_heap>>1,big_heap))) {
- unexec_error("my_sbrk(): probe_big_heap() failed\n");
- return ((char *)-1);
- }
-
- mach_brkpt=mmap(NULL, big_heap, PROT_READ|PROT_WRITE, MAP_PRIVATE | MAP_ANON, -1, 0);
-
- mach_mapstart = mach_brkpt;
- mach_maplimit = mach_brkpt + big_heap;
-
- }
- if (incr == 0) {
- return (mach_brkpt);
- } else {
- ptr = mach_brkpt + incr;
- if (ptr<mach_mapstart || ptr > mach_maplimit)
- return (char *)-1;
- temp = mach_brkpt;
- mach_brkpt = ptr;
- return (temp);
- }
-}
-
static size_t stub_size (malloc_zone_t *zone, const void *ptr)
{
extern object malloc_list;
; (print `(deftype ,name nil `(si::std-instance ,(si::coerce-to-standard-class ',name))))
; (print (si::coerce-to-standard-class name))
(eval `(deftype ,name nil t))
+ (unintern (get name 'si::simple-typep-fn))
(remprop name 'si::simple-typep-fn)))
;; #+cmu17 (declare (ignore name predicate))
shift
ARCHIVE=$1
shift
+XPWD=$(pwd)
TMPDIR=$(mktemp -d)
while [ $# -gt 0 ] ; do
case $(basename $1) in
*.o) cp $1 $TMPDIR;;
*.go) cp $1 $TMPDIR/$(echo $(basename $1)|sed 's,\.go,.o,g');;
- *.a) ar x $1 --output $TMPDIR;;
+ *.a) cd $TMPDIR && ar x $XPWD/$1 && cd $XPWD;;
recompile);;
*) echo Bad arg $1 ; exit 1 ;;
esac
projects / gcl27.git / commitdiff