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

;;; 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*

;;; 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
(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

(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)
;;; 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 ?)