github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-25 08:29:53 +00:00
Code Issues Releases Wiki Activity

Builds all LISP; * FASL files that are on autoload properties when

Browse Source 
the lisp interpreter is first booted.

Redumps lisp compiler with updated FASL files built from source.
This commit is contained in:
Eric Swenson
2018-10-01 12:25:58 -07:00
parent 8f3e7b507c
commit cc8e6c1964
33 changed files with 16469 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files

174
src/lspsrc/extstr.97 Normal file
View File

@@ -0,0 +1,174 @@
;;; EXTSTR -*-Mode:Lisp;Package:SI;Lowercase:T-*-
;;; ****************************************************************
;;; *** MACLISP **** EXTended datatype scheme, basic STRuctures ****
;;; ****************************************************************
;;; ** (c) Copyright 1981 Massachusetts Institute of Technology ****
;;; ****************************************************************
(herald EXTSTR /97)
(eval-when (eval compile)
(or (get 'SUBLOAD 'VERSION)
(load '((lisp) subload)))
(subload EXTBAS)
(subload EXTMAC)
(subload EXTEND)
;; This would like to be a SUBLOAD of VECTOR, but this way it's not circular
(defmacro VSET (v n val) `(SI:XSET ,v ,n ,val))
)
;;; Wherein we build HUNKs for each class that will be directly pointed to
;;; by classes defined by DEFVST. We leave out the interconnections between
;;; classes, to help printing of objects defined by DEFVST. Loading EXTEND
;;; will supply the missing interconnections.
;;; We also define the basic CLASS creator, SI:DEFCLASS*-2 a sub-primitive that
;;; gives a skeletal class. This class can then be filled in by calling
;;; SI:INITIALIZE-CLASS (from EXTEND)
(defvar SI:SKELETAL-CLASSES () "At least it wont be unbound in Old lisps")
;;; SI:EXTSTR-SETUP-CLASSES is set up by EXTMAC, and includes things
;;; like CLASS-CLASS OBJECT-CLASS STRUCT=INFO-CLASS STRUCT-CLASS VECTOR-CLASS
(declare #.`(SPECIAL ,.si:extstr-setup-classes))
(setq-if-unbound CLASS-CLASS () "Will be set up, at some pain, in this file")
(setq-if-unbound OBJECT-CLASS () "Will be set up, at some pain, in this file")
(declare (own-symbol **SELF-EVAL** SI:DEFCLASS*-2 SI:DEFVST-BARE-INIT))
(defun SI:SELF-QUOTIFY (x) `',x)
(eval-when (eval compile load)
;; So that we can easily tell classes apart from random extends
(defvar SI:CLASS-MARKER '**CLASS-SELF-EVAL**)
(and (status feature COMPLR)
(*lexpr SI:DEFCLASS*-2 SI:DEFVST-BARE-INIT))
)
(defprop **SELF-EVAL** SI:SELF-QUOTIFY MACRO)
(defprop #.SI:CLASS-MARKER SI:SELF-QUOTIFY MACRO) ;**CLASS-SELF-EVAL**
;;;; SI:DEFCLASS*-2
(defun SI:DEFCLASS*-2 (name typep var superiors
&optional source-file class
&rest ignore )
(cond ((cond ((null class))
((not (classp class))
(+internal-lossage 'CLASS 'SI:DEFCLASS*-2 class)
'T))
;;Note that at initial boot-strap phase, CLASS-CLASS may not exist,
;; but either function -- si:make-extend or si:make-random-extend --
;; will be open-coded by COMPLR
(setq class (si:make-random-extend #.si:class-instance-size
CLASS-CLASS))
(setf (si:extend-marker-of class) SI:CLASS-MARKER)
(setf (si:class-typep class) typep)
(setf (si:class-plist class) (ncons name))
(setf (si:class-name class) name)))
(if source-file
(setf (get (si:class-plist class) ':SOURCE-FILE) source-file))
(if var
(setf (si:class-var (set var class)) var))
(cond ((fboundp 'SI:INITIALIZE-CLASS)
(setf (si:class-superiors class) superiors)
(si:initialize-class class))
('T (push `(,class ,superiors) SI:SKELETAL-CLASSES)
(setf (si:extend-class-of class) () )
(if (boundp 'PURCOPY) (push class PURCOPY))))
(putprop name class 'CLASS)
class)
;;;Move &OPTIONAL to after VERSION once old files are flushed (after
;;; defvst-version 1 is gone). July 4, 1981 -- JonL --
;;;See also the similar comments in DEFVSY.
(defun SI:DEFVST-BARE-INIT (name var-name cnsn size inis
&optional (version 1) source-file class sinfo
&rest ignore)
(if (pairp inis)
;; a slight open-coding of TO-VECTOR for (SETQ INIS (TO-VECTOR INIS))
(setq inis (let ((ln (length inis)))
(declare (fixnum ln))
(do ((v (si:make-extend ln VECTOR-CLASS))
(i 0 (1+ i))
(l inis (cdr l)))
((= i ln) v)
(declare (fixnum i))
(vset v i (car l))))))
(if (null class)
(setq class (or (get name 'CLASS)
(si:defclass*-2 name
name
var-name
(list STRUCT-CLASS)
source-file))))
(if (null sinfo)
(setq sinfo (si:extend STRUCT=INFO-CLASS
version
name
cnsn
size
inis
class)))
(putprop name sinfo 'STRUCT=INFO)
;;The STRUCT=INFO property can always be found on the plist of the 'name'
;; of the structure (and consequently the 'name' of the class)
;;So I've the following line optional, so that it doesn't cause
;; a printing circularity when EXTEND isn't loaded.
(if (get 'EXTEND 'VERSION)
(setf (get (si:class-plist class) 'STRUCT=INFO) sinfo)))
;; Setup basics of CLASS hierarchy, if not already done so. DEFVAR
;; at beginning of this file ensures that CLASS-CLASS has a value.
(and (null CLASS-CLASS)
(let (y x)
(mapc #'(lambda (z)
(desetq (x y z) z)
(si:defclass*-2 x x y (if z (list (symeval z)))))
'((OBJECT OBJECT-CLASS () )
(CLASS CLASS-CLASS OBJECT-CLASS)
(SEQUENCE SEQUENCE-CLASS OBJECT-CLASS)
(VECTOR VECTOR-CLASS SEQUENCE-CLASS)
(STRUCT STRUCT-CLASS OBJECT-CLASS)
(STRUCT=INFO STRUCT=INFO-CLASS STRUCT-CLASS)))))
;; The following is an open-coding of part of the result of CONS-A-STRUCT=INFO.
(si:defvst-bare-init
'STRUCT=INFO
'STRUCT=INFO-CLASS
'CONS-A-STRUCT=INFO
6
'( () ;&REST info
(VERS STRUCT=INFO-VERS SI:STRUCT=INFO-VERSION ) ;1st key
(NAME STRUCT=INFO-NAME () ) ;2nd
(CNSN STRUCT=INFO-CNSN () ) ;3nd
(SIZE STRUCT=INFO-SIZE 0 ) ;4rd
(INIS STRUCT=INFO-INIS () ) ;5th
(CLSS STRUCT=INFO-CLSS STRUCT=INFO-CLASS) ;6th
)
2) ;Version
(eval-when (eval compile)
(defmacro GEN-SOURCE-FILE-ADDENDA ()
(if (filep infile)
`(MAPC #'(LAMBDA (CLASS)
(SETF (GET (SI:CLASS-PLIST CLASS) ':SOURCE-FILE)
',(namestring (truename infile))))
(LIST CLASS-CLASS OBJECT-CLASS VECTOR-CLASS STRUCT-CLASS
STRUCT=INFO-CLASS SEQUENCE-CLASS))))
)
(gen-source-file-addenda)
(if (status feature COMPLR)
(subload EXTHUK))