Commit 9c2dccfb authored by Raymond Toy's avatar Raymond Toy
Browse files

Merge branch 'master' into rtoy-gitlab-ci

parents 8296f92f 3b4f3977
Pipeline #149 failed with stage
in 1 minute and 19 seconds
......@@ -25,6 +25,9 @@ b) A supported C compiler for the C runtime code.
means the vendor-supplied C compiler. The compiler must be
available under the name specified by your ports Config file.
Note for FreeBSD 10 and above: The build requires gcc (Clang will
not work) and the lib32 compatiblity package.
c) GNU make
This has to be available either as gmake or make in your PATH, or
......@@ -691,3 +694,4 @@ In particular steps 3, 4, and 5 can be combined into one by using the
-c, -r, and -l options for The -c option cleans
out the targe and cross directories; -r does step 4; and -l does step
......@@ -50,3 +50,4 @@ Here is a summary of its main features:
maintained and improved by a team of volunteers collaborating over
the Internet.
For the latest news and other information, see [the wiki](
\ No newline at end of file
......@@ -39,7 +39,7 @@ ENABLE2="yes"
......@@ -78,7 +78,7 @@ case $uname_s in
OpenBSD*) motif_variant=OpenBSD ;;
*_darwin) motif_variant=Darwin ;;
sun4_solaris_gcc|sparc_gcc) motif_variant=solaris ;;
sun4_solaris_sunc|sparc_sunc|x86_solaris_sunc) motif_variant=solaris_sunc ;;
sun4_solaris_sunc|sparc_sunc|x86_solaris_sunc|sparc64_sunc) motif_variant=solaris_sunc ;;
sun4c*) motif_variant=sun4c_411 ;;
hp700*) motif_variant=hpux_cc ;;
pmax_mach) motif_variant=pmax_mach ;;
......@@ -12,7 +12,7 @@
# $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/,v 1.20 2011/04/11 16:34:49 rtoy Exp $
usage() {
echo " [-hbg] [-G group] [-O owner] [-I destdir] [-M mandir] dir [version arch os]"
echo " [-hbg] [-G group] [-O owner] [-I destdir] [-M mandir] [-A arch] [-V version] [-o OS] dir"
echo " -h This help"
echo " -b Use bzip2 compression"
echo " -g Use gzip compression"
......@@ -24,10 +24,10 @@ usage() {
echo " The compressed tar file is named cmucl-src-<VERSION>.tar.<ext>"
echo " If -I is also given, the -S means that the sources are "
echo " installed in the <destdir>/src"
echo " -A arch Architecture (x86, sparc, ppc, etc.)"
echo " -o OS OS (linux, solaris10, etc.)"
echo " -V version Version (usually date and/or other version info)"
echo " dir Directory where the build is located"
echo " version Version (usually date and/or other version info)"
echo " arch Architecture (x86, sparc, etc.)"
echo " os OS (linux, solaris8, etc.)"
echo ""
echo "If the -I option is given, directly install all of the files to the"
echo "specified directory. Otherwise, Make a CMUCL distribution consisting"
......@@ -57,7 +57,7 @@ def_arch_os () {
case `uname -m` in
ARCH=sparcv9 ;;
ARCH=sparc ;;
ARCH=x86 ;;
......@@ -90,7 +90,23 @@ def_arch_os () {
while getopts "G:O:I:M:bghS?" arg
# Figure out the architecture and OS in case options aren't given
# Choose a version based on the git hash as the default version. We
# only compute a default if the git hash looks like a snapshot
# ("snapshot-yyyy-mm") or a release number..
GIT_HASH="`(cd src; git describe --dirty 2>/dev/null)`"
if expr "X${GIT_HASH}" : 'Xsnapshot-[0-9][0-9][0-9][0-9]-[01][0-9]' > /dev/null; then
DEFAULT_VERSION=`expr "${GIT_HASH}" : "snapshot-\(.*\)"`
if expr "X${GIT_HASH}" : 'X[0-9][0-9][a-f]' > /dev/null; then
while getopts "G:O:I:M:bghSA:o:V:?" arg
case $arg in
......@@ -100,46 +116,28 @@ do
b) ENABLE_BZIP=-b ;;
g) ENABLE_GZIP=-g ;;
o) OS=$OPTARG ;;
h | \?) usage; exit 1 ;;
shift `expr $OPTIND - 1`
# Figure out the architecture and OS
# Figure out the architecture and OS
# Directory is required; exit if not given
if [ $# -lt 1 ]; then
if [ -n "${INSTALL_DIR}" ]; then
# Doing direct installation
if [ $# -lt 1 ]; then
if [ -z "$VERSION" ]; then
# If a default version exists, use it. Otherwise this is an
# error---at least one of these must not be empty.
if [ -z "${DEFAULT_VERSION}" ]; then
echo "Version (-V) must be specified because default version cannot be determined."
elif [ $# -lt 2 ]; then
# Version not specified so choose a version based on the git hash.
GIT_HASH="`(cd src; git describe --dirty 2>/dev/null)`"
if expr "X${GIT_HASH}" : 'Xsnapshot-[0-9][0-9][0-9][0-9]-[01][0-9]' > /dev/null; then
VERSION=`expr "${GIT_HASH}" : "snapshot-\(.*\)"`
if expr "X${GIT_HASH}" : 'X[0-9][0-9][a-f]' > /dev/null; then
echo "Defaulting version to $VERSION"
if [ $# -eq 3 ]; then
elif [ $# -eq 4 ]; then
......@@ -167,6 +165,7 @@ if [ -n "$INSTALL_DIR" ]; then
echo cmucl-$VERSION-$ARCH-$OS
ROOT=`dirname $0`
# If no compression options given, default to bzip
;;;; Boot file for changing the fasl file version numbers to 21a.
(in-package :c)
(setf lisp::*enable-package-locked-errors* nil)
;;; Note that BYTE-FASL-FILE-VERSION is a constant.
;;; (Be sure to change BYTE-FASL-FILE-VERSION in
;;; compiler/byte-comp.lisp to the correct value too!)
(setf (symbol-value 'byte-fasl-file-version) #x21b)
(setf (backend-fasl-file-version *target-backend*) #x21b)
;;; Don't check fasl versions in the compiling Lisp because we'll
;;; load files compiled with the new version numbers.
(setq lisp::*skip-fasl-file-version-check* t)
;;; This is here because BYTE-FASL-FILE-VERSION is constant-folded in
;;; OPEN-FASL-FILE. To make the new version number take effect, we
;;; have to redefine the function.
(defun open-fasl-file (name where &optional byte-p)
(declare (type pathname name))
(let* ((stream (open name :direction :output
:if-exists :new-version
:element-type '(unsigned-byte 8)
:class 'binary-text-stream))
(res (make-fasl-file :stream stream)))
(version f-vers f-imp)
(if byte-p
(values "Byte code"
(backend-byte-fasl-file-implementation *backend*))
(values (backend-version *backend*)
(backend-fasl-file-version *backend*)
(backend-fasl-file-implementation *backend*)))
(format stream
"FASL FILE output from ~A.~@
Compiled ~A on ~A~@
Compiler ~A, Lisp ~A~@
Targeted for ~A, FASL version ~X~%"
(ext:format-universal-time nil (get-universal-time))
(machine-instance) compiler-version
version f-vers)
;; Terminate header.
(dump-byte 255 res)
;; Specify code format.
(dump-fop 'lisp::fop-long-code-format res)
(dump-byte f-imp res)
(dump-unsigned-32 f-vers res))
;; Boot file to increase the max alignment value from 3 to 4.
;; This takes care of everything for the bootstrap, but when new-assem
;; is loaded. you'll get a warning. Select the CLOBBER-IT restart to
;; continue.
(in-package :new-assem)
((error (lambda (c)
(declare (ignore c))
(invoke-restart 'continue))))
(defconstant max-alignment 4))
(deftype alignment ()
`(integer 0 ,max-alignment))
(handler-bind ((error (lambda (c)
(declare (ignore c))
(invoke-restart 'kernel::clobber-it))))
(defstruct (segment
(:print-function %print-segment)
(:constructor make-segment (&key name run-scheduler inst-hook)))
;; The name of this segment. Only using in trace files.
(name "Unnamed" :type simple-base-string)
;; Whether or not run the scheduler. Note: if the instruction defintions
;; were not compiled with the scheduler turned on, this has no effect.
(run-scheduler nil)
;; If a function, then it is funcalled for each inst emitted with the
;; segment, the VOP, the name of the inst (as a string), and the inst
;; arguments.
(inst-hook nil :type (or function null))
;; Where to deposit the next byte.
(fill-pointer (system:int-sap 0) :type system:system-area-pointer)
;; Where the current output block ends. If fill-pointer is ever sap= to
;; this, don't deposit a byte. Move the fill pointer into a new block.
(block-end (system:int-sap 0) :type system:system-area-pointer)
;; What position does this correspond to. Initially, positions and indexes
;; are the same, but after we start collapsing choosers, positions can change
;; while indexes stay the same.
(current-posn 0 :type posn)
;; Were in the output blocks are we currently outputing.
(current-index 0 :type index)
;; A vector of the output blocks.
(output-blocks (make-array 4 :initial-element nil) :type simple-vector)
;; A list of all the annotations that have been output to this segment.
(annotations nil :type list)
;; A pointer to the last cons cell in the annotations list. This is
;; so we can quickly add things to the end of the annotations list.
(last-annotation nil :type list)
;; The number of bits of alignment at the last time we synchronized.
(alignment max-alignment :type alignment)
;; The position the last time we synchronized.
(sync-posn 0 :type posn)
;; The posn and index everything ends at. This is not maintained while the
;; data is being generated, but is filled in after. Basically, we copy
;; current-posn and current-index so that we can trash them while processing
;; choosers and back-patches.
(final-posn 0 :type posn)
(final-index 0 :type index)
;; *** State used by the scheduler during instruction queueing.
;; List of postit's. These are accumulated between instructions.
(postits nil :type list)
;; ``Number'' for last instruction queued. Used only to supply insts
;; with unique sset-element-number's.
(inst-number 0 :type index)
;; Simple-Vectors mapping locations to the instruction that reads them and
;; instructions that write them.
(readers (make-array (assem-params-max-locations
(c:backend-assembler-params c:*backend*))
:initial-element nil)
:type simple-vector)
(writers (make-array (assem-params-max-locations
(c:backend-assembler-params c:*backend*))
:initial-element nil)
:type simple-vector)
;; The number of additional cycles before the next control transfer, or NIL
;; if a control transfer hasn't been queued. When a delayed branch is
;; queued, this slot is set to the delay count.
(branch-countdown nil :type (or null (and fixnum unsigned-byte)))
;; *** These two slots are used both by the queuing noise and the
;; scheduling noise.
;; All the instructions that are pending and don't have any unresolved
;; dependents. We don't list branches here even if they would otherwise
;; qualify. They are listed above.
(emittable-insts-sset (make-sset) :type sset)
;; List of queued branches. We handle these specially, because they have to
;; be emitted at a specific place (e.g. one slot before the end of the
;; block).
(queued-branches nil :type list)
;; *** State used by the scheduler duing instruction scheduling.
;; The instructions who would have had a read dependent removed if it were
;; not for a delay slot. This is a list of lists. Each element in the
;; top level list corresponds to yet another cycle of delay. Each element
;; in the second level lists is a dotted pair, holding the dependency
;; instruction and the dependent to remove.
(delayed nil :type list)
;; The emittable insts again, except this time as a list sorted by depth.
(emittable-insts-queue nil :type list)
;; Whether or not to collect dynamic statistics. This is just the same as
;; *collect-dynamic-statistics* but is faster to reference.
(collect-dynamic-statistics nil))))
;; Bootstrap file for linuu to move the heap to a higher address so
;; that executables will work on newer OSes, as mentioned in issue
;; #40.
;; Use "bin/ -B boot-2017-04" to build this.
;; Also need to move the foreign linkage start to a different address
;; because this also overlaps where the C code is placed in an
;; executable image.
;; This reduces the max total heap space on older systems, but it
;; looks like newer systems have the C libraries and stack mapped at a
;; much higher address.
(setf (c::backend-foreign-linkage-space-start c::*target-backend*)
((error (lambda (c)
(declare (ignore c))
(invoke-restart 'continue))))
(defconstant vm::target-foreign-linkage-space-start
(c:backend-foreign-linkage-space-start c::*target-backend*))
(defconstant vm::target-dynamic-space-start
......@@ -295,7 +295,7 @@
;; Motif
;; Hemlock
......@@ -515,12 +515,9 @@
:format-arguments (list n)
:datum n
:expected-type '(real 0)))
(multiple-value-bind (sec usec)
(if (integerp n)
(values n 0)
(multiple-value-bind (sec frac) (truncate n)
(values sec (truncate frac 1e-6))))
(unix:unix-select 0 0 0 0 sec usec))
(alien:extern-alien "os_sleep" (function c-call:void double-float))
(float n 1d0))
......@@ -91,7 +91,17 @@
calling PROVIDE to indicate a successful load of the module.
While loading any files, *load-verbose* is bound to *require-verbose*
which defaults to t."
which defaults to t.
The predefined modules included are :defsystem, :asdf, :lisp-unit,
:unix, :clx, :clm, :hemlock, and :cmu-contribs.
The module :cmu-contribs differs from the other modules in that
requiring this module only defines the following modules:
\"contrib-demos\", \"contrib-follow-mouse\",
\"contrib-games-feebs\", \"contrib-hist\", \"contrib-psgraph\",
\"contrib-ops\", \"contrib-embedded-c\", \"contrib-sprof\", and
\"contrib-packed-sse2\". "
(let ((saved-modules (copy-list *modules*))
(module-name (module-name-string module-name)))
(unless (member module-name *modules* :test #'string=)
......@@ -1643,12 +1643,9 @@
;; Can't call process-wait if the scheduling is inhibited.
;; The initial-process may block.
(multiple-value-bind (sec usec)
(if (integerp n)
(values n 0)
(multiple-value-bind (sec frac)(truncate n)
(values sec (truncate frac 1e-6))))
(unix:unix-select 0 0 0 0 sec usec))
(alien:extern-alien "os_sleep" (function c-call:void double-float))
(float n 1d0))
(process-wait-with-timeout "Sleep" n (constantly nil)))))
......@@ -742,7 +742,8 @@
(unix:unix-unlink name)
(when fd
(let ((newline (string #\Newline)))
(let ((newline (make-array 1 :element-type '(unsigned-byte 8)
:initial-element (char-code #\Newline))))
(line no-cr)
......@@ -766,7 +767,7 @@
(multiple-value-bind (read-fd write-fd)
(unless read-fd
(error (intl:gettext "Cound not create pipe: ~A")
(error (intl:gettext "Could not create pipe: ~A")
(unix:get-unix-error-msg write-fd)))
(copy-descriptor-to-stream read-fd object cookie)
(push read-fd *close-on-error*)
......@@ -58,7 +58,6 @@
;;; Return system time, user time and number of page faults.
#-(and sparc svr4)
(defun get-system-info ()
(err? utime stime maxrss ixrss idrss isrss minflt majflt)
......@@ -70,19 +69,6 @@
(values utime stime majflt)))))
;;; GET-SYSTEM-INFO -- Interface
;;; Return system time, user time and number of page faults.
#+(and sparc svr4)
(defun get-system-info ()
(err? utime stime cutime cstime)
(declare (ignore err? cutime cstime))
;; Return times in microseconds; page fault statistics not supported.
(values (* utime 10000) (* stime 10000) 0)))
;;; GET-PAGE-SIZE -- Interface
;;; Return the system page size.
......@@ -64,7 +64,6 @@
;;; Get-Internal-Run-Time -- Public
#-(and sparc svr4)
(defun get-internal-run-time ()
_N"Return the run time in the internal time format. This is useful for
finding CPU usage."
......@@ -81,20 +80,6 @@
(truncate (+ utime-usec stime-usec)
;;; Get-Internal-Run-Time -- Public
#+(and sparc svr4)
(defun get-internal-run-time ()
_N"Return the run time in the internal time format. This is useful for
finding CPU usage."
(declare (values (unsigned-byte 32)))
(locally (declare (optimize (speed 3) (safety 0)))
(multiple-value-bind (ignore utime stime cutime cstime)
(declare (ignore ignore cutime cstime)
(type (unsigned-byte 31) utime stime))
(the (unsigned-byte 32) (+ utime stime)))))
;;;; Encode and Decode universal times.
......@@ -223,8 +208,11 @@
(type (mod 24) hour)
(type (integer 1 31) date)
(type (integer 1 12) month)
(type (or (integer 0 99) (integer 1900)) year)
(type (or null rational) time-zone))
;; 1899 to account for time zones that are equivalent to 1900.
(type (or (integer 0 99) (integer 1899)) year)
(type (or null rational) time-zone)
;; Result must be non-negative integer!
(values (integer 0)))
(let* ((year (if (< year 100)
(pick-obvious-year year)
......@@ -38,7 +38,7 @@
;; 0-9 followed by a single hex digit in the range a-f. Then the
;; version looks like a decimal number followed by a minor release
;; letter of a to f.
(defconstant byte-fasl-file-version #x21a)
(defconstant byte-fasl-file-version #x21b)
(let* ((version-string (format nil "~X" byte-fasl-file-version)))
;; Add :cmu<n> to *features*
......@@ -80,7 +80,7 @@
;;; format. If the loader only loads objects 8-byte aligned, we can't do
;;; any better than that ourselves.
(defconstant max-alignment 3)
(defconstant max-alignment 4)
(deftype alignment ()
`(integer 0 ,max-alignment))
......@@ -64,7 +64,7 @@
(setf (backend-page-size *target-backend*) 4096)
(setf (c::backend-foreign-linkage-space-start *target-backend*)
#+linux #x58000000
#+linux #x5f000000
#+solaris #x30000000
#-(or linux solaris) #xB0000000
(c::backend-foreign-linkage-entry-size *target-backend*)
......@@ -235,7 +235,7 @@
#+FreeBSD #x28F00000
#-FreeBSD #x28000000)
(defconstant target-dynamic-space-start
#+linux #x58100000
#+linux #x60000000
#+solaris #x40000000
#-(or linux solaris) #x48000000)
(defconstant target-foreign-linkage-space-start
This diff is collapsed.
This diff is collapsed.
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment