Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/upsala/dec20init.clisp
There are no other files named dec20init.clisp in the archive.
;;; This is a -*-Lisp-*- file.
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
(in-package 'lisp)
(export '(*features* tops-20 decsystem-20 lambda-list-keywords help
lambda-parameters-limit call-arguments-limit multiple-values-limit
array-dimension-limit array-total-size-limit
most-positive-fixnum most-negative-fixnum
short-float-radix single-float-radix long-float-radix
double-float-radix internal-time-units-per-second
most-positive-short-float least-positive-short-float
most-negative-short-float least-negative-short-float
most-positive-single-float least-positive-single-float
most-negative-single-float least-negative-single-float
most-positive-long-float least-positive-long-float
most-negative-long-float least-negative-long-float
most-positive-double-float least-positive-double-float
most-negative-double-float least-negative-double-float
short-float-epsilon single-float-epsilon long-float-epsilon
double-float-epsilon short-float-negative-epsilon
single-float-negative-epsilon long-float-negative-epsilon
double-float-negative-epsilon))
;;; Initialization for Spice Lisp system, called by TOP-LEVEL.
;;; Also, assorted implementation-dependent stuff.
;;; This file contains variables that may need to be known at
;;; compile time, so this file should be part of the compilation
;;; environment.
;;; Written by Scott Fahlman and Walter van Roggen.
;;; *******************************************************************
(proclaim '(special %catch-all-object *prompt* *features*
*lisp-initialization-functions*))
;;; There are a number of variables which specify implementation
;;; dependent characteristics that would be useful to have available.
;;; These would be set up at Lisp initialization, in the xxINIT.SLISP
;;; file. They should also be available to the compiler.
;;; Variables that end in -BYTE are byte specifiers.
;;; Variables that end in -SLOT are fixnums giving the index in the vector
;;; or offset on the stack.
(defconstant current-machine 'DECSYSTEM-20)
(defconstant current-system 'TOPS-20)
(defconstant target-machine 'DECSYSTEM-20)
(defconstant target-system 'TOPS-20)
(defvar *features* '(common decsystem-20 tops-20)
"A list of symbols that name 'features' provided by the implementation.")
(defconstant lambda-list-keywords
'(&optional &rest &key &allow-other-keys &aux &body &whole &environment)
"Keywords that you can put in a lambda-list, supposing you should
want to do such a thing.")
(defconstant lambda-parameters-limit 256000
"The exclusive upper bound on the number of parameters which may be
specifed in a given lambda list. This is actually the limit on
required and optional parameters. With &key and &aux you can get
more.")
(defconstant call-arguments-limit 256000
"The exclusive upper bound on the number of arguments which may be
passed to a function, including rest args.")
(defconstant multiple-values-limit 256000
"The exclusive upper bound on the number of multiple-values that
you can have.")
;;; Various miscellaneous objects and fields
(defconstant %character-code-byte (byte 7 0))
(defconstant %character-control-byte (byte 8 7))
(defconstant %character-font-byte (byte 8 15))
(defconstant %character-code-mask #o177)
(defconstant %character-control-mask #o77600)
(defconstant %character-font-mask #o37700000)
(defconstant %character-int-mask #o37777777)
(defconstant %character-code-control-mask #o77777)
;;; Type codes as returned by the TYPE instruction:
(defconstant %misc-type 0)
(defconstant %bit-vector-type 1)
(defconstant %integer-vector-type 2)
(defconstant %string-type 3)
(defconstant %bignum-type 4)
(defconstant %long-float-type 5)
(defconstant %complex-type 6)
(defconstant %ratio-type 7)
(defconstant %general-vector-type 8)
(defconstant %function-type 9)
(defconstant %array-type 10)
(defconstant %symbol-type 11)
(defconstant %list-type 12)
(defconstant %stream-type 13)
(defconstant %hash-table-type 14)
(defconstant %fixnum-type 16)
(defconstant %+-fixnum-type 16)
(defconstant %--fixnum-type 17)
(defconstant %+-short-float-type 18)
(defconstant %--short-float-type 19)
(defconstant %character-type 20)
(defconstant %values-marker-type 21)
(defconstant %call-header-type 22)
(defconstant %catch-header-type 23)
(defconstant %catch-all-type 24)
(defconstant %gc-forward-type 25)
;;; Format of an array:
(defconstant %array-data-slot 0)
(defconstant %array-length-slot 1)
(defconstant %array-fill-pointer-slot 2)
(defconstant %array-displacement-slot 3)
(defconstant %array-dim-base 3)
(defconstant %array-first-dim-slot 4)
(defconstant %array-header-overhead 3)
(defconstant ARRAY-DIMENSION-LIMIT 256000
"The exclusive upper bound any given dimension of an array.")
(defconstant ARRAY-TOTAL-SIZE-LIMIT 2000000
"The exclusive upper bound on the total number of elements in an
array.")
(defconstant %ratio-numerator-slot 0)
(defconstant %ratio-denominator-slot 1)
;;; Super-fast implementation-dependent char-upcase for the reader.
;;; Does no checking -- CHAR had better be a character.
;;; Evals CHAR twice.
(defmacro fast-char-upcase (char)
`(let ((ch (%sp-make-fixnum ,char)))
(if (and (> ch #o140) ; Octal 141 is #\a.
(< ch #o173)) ; Octal 172 is #\z.
(%sp-make-immediate-type (- ch 32) %character-type)
,char)))
;;; Numeric arithmetic constants
(defconstant %fixnum-length 32)
(defconstant most-positive-fixnum #o17777777777
"The fixnum closest in value to positive infinity.")
(defconstant most-negative-fixnum #o-20000000000
"The fixnum closest in value to negative infinity.")
(defconstant short-float-radix 2 "The radix of short-floats.")
(defconstant single-float-radix 2 "The radix of single-floats.")
(defconstant double-float-radix 2 "The radix of double-floats.")
(defconstant long-float-radix 2 "The radix of long-floats.")
(defconstant %short-float-exponent-length 9)
(defconstant %short-float-mantissa-length 23)
(defconstant %single-float-exponent-length 9)
(defconstant %single-float-mantissa-length 23)
(defconstant %long-float-exponent-length 9)
(defconstant %long-float-mantissa-length 62)
(defconstant %double-float-exponent-length 9)
(defconstant %double-float-mantissa-length 62)
;don't compile the first one. reading 1.9999997 in and writing it back
;out will give 2.0, whch causes an overflow.
(eval-when (eval)
(defconstant most-positive-single-float (scale-float 1.9999997 126))
)
(defconstant MOST-POSITIVE-SHORT-FLOAT most-positive-single-float)
(defconstant least-positive-single-float (scale-float 1.0 -129))
(defconstant LEAST-POSITIVE-SHORT-FLOAT least-positive-single-float)
(defconstant least-negative-single-float (- least-positive-single-float))
(defconstant LEAST-NEGATIVE-SHORT-FLOAT least-negative-single-float)
(defconstant most-negative-single-float (- most-positive-single-float))
(defconstant MOST-NEGATIVE-SHORT-FLOAT most-negative-single-float)
(defconstant %dp-v 4611686018427387903) ;;mantissae of largest float number
(defconstant most-positive-double-float (scale-float (float %dp-v 1.0d0) 65))
(defconstant MOST-POSITIVE-LONG-FLOAT most-positive-double-float)
(defconstant least-positive-double-float (scale-float 1.0d0 -129))
(defconstant LEAST-POSITIVE-LONG-FLOAT least-positive-double-float)
(defconstant least-negative-double-float (- least-positive-double-float))
(defconstant LEAST-NEGATIVE-LONG-FLOAT least-negative-double-float)
(defconstant most-negative-double-float (- most-positive-double-float))
(defconstant MOST-NEGATIVE-LONG-FLOAT most-negative-double-float)
(defconstant single-float-epsilon (scale-float 1.0 -22))
(defconstant SHORT-FLOAT-EPSILON single-float-epsilon)
(defconstant double-float-epsilon (scale-float 1.0d0 -62))
(defconstant LONG-FLOAT-EPSILON double-float-epsilon)
(defconstant single-float-negative-epsilon (+ (scale-float 1.0 -28)
(scale-float 1.0 -50)))
(defconstant SHORT-FLOAT-NEGATIVE-EPSILON single-float-negative-epsilon)
(defconstant double-float-negative-epsilon (+ (scale-float 1.0d0 -63)
(scale-float 1.0d0 -124)))
(defconstant LONG-FLOAT-NEGATIVE-EPSILON double-float-negative-epsilon)
(defconstant internal-time-units-per-second 1000
"The number of internal time units that fit into a second. See
Get-Internal-Real-Time and Get-Internal-Run-Time.")
(defun help nil ?)