diff options
-rw-r--r-- | src/interp/construc.lisp (renamed from src/interp/construc.lisp.pamphlet) | 236 | ||||
-rw-r--r-- | src/interp/domain.lisp (renamed from src/interp/domain.lisp.pamphlet) | 198 | ||||
-rw-r--r-- | src/interp/guess.boot (renamed from src/interp/guess.boot.pamphlet) | 24 | ||||
-rw-r--r-- | src/interp/nhyper.boot (renamed from src/interp/nhyper.boot.pamphlet) | 24 |
4 files changed, 201 insertions, 281 deletions
diff --git a/src/interp/construc.lisp.pamphlet b/src/interp/construc.lisp index e97d2501..f038d78a 100644 --- a/src/interp/construc.lisp.pamphlet +++ b/src/interp/construc.lisp @@ -1,100 +1,7 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp construc.lisp} -\author{Timothy Daly} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\begin{verbatim} - the old compiler splits source files on a domain by domain basis - - the new compiler compiles all of the domains in a file together into a - single output file - - in order to converge these two approaches nrlibs are being combined on - a file basis rather than split on a domain basis. this change should be - transparent to all code that properly accesses the files. - - INTERP.EXPOSED will be enhanced to contain the source file name of - the domain. thus, instead of: - INT Integer - it will be: - INT integer Integer - - which would mean that the library that contains INT would be integer.NRLIB - by using this mechanism we can continue to use the old libraries - since each entry would now contain: - INT INT Integer - which would mean that the library that contains the domain INT is INT.NRLIB - - old file formats for nrlibs: - - first sexpr is integer specifying the byte position of the index of the file - next n sexprs are information in the nrlib - last sexpr is an alist (pointed at by the first number in the file) which - contains triples. e.g. (("slot1info" 0 2550)...) - each triple consists of a string, a zero, and an byte offset into the file - of the information requested e.g. slot1info starts at byte 2550 - - new file formats for libs: - - first sexpr is either an integer (in which case this is exactly an old nrlib - --- or --- - first sexpr is an alist of the form: - ((abbreviation . index) ...) - where each abbreviation is the abbreviation of the domain name and each - index is a pointer to the triples alist - - so, for example, integer.spad contains 5 domains: - INTSLPE, INT, NNI, PI and ROMAN - previously INT.NRLIB/index.KAF contained: - 2550 - (sexpr1...) - (sexpr2....) - (sexpr3...) - (("sexpr1" 0 8) ("sexpr2" 0 22) ("sexpr3 0 45)) - and the individual index.KAF files were similar for the other 4 domains. - - under the new scheme integer.nrlib/index.KAF would contain: - ((INTSLPE . 2000) (INT . 4000) (NNI . 6000) (PI . 8000) (ROMAN . 10000)) - (sexpr1...) --- info for INTSLPE - (sexpr2....) - (sexpr3...) - (("sexpr1" 0 8) ("sexpr2" 0 22) ("sexpr3 0 45)) - (sexpr1...) --- info for INT - (sexpr2....) - (sexpr3...) - (("sexpr1" 0 2800) ("sexpr2" 0 2900) ("sexpr3 0 3000)) - (sexpr1...) --- info for NNI - (sexpr2....) - (sexpr3...) - (("sexpr1" 0 4100) ("sexpr2" 0 4200) ("sexpr3 0 4300)) - (sexpr1...) --- info for PI - (sexpr2....) - (sexpr3...) - (("sexpr1" 0 6100) ("sexpr2" 0 6200) ("sexpr3 0 6300)) - (sexpr1...) --- info for ROMAN - (sexpr2....) - (sexpr3...) - (("sexpr1" 0 8100) ("sexpr2" 0 8200) ("sexpr3 0 8300)) - - when an NRLIB is opened currently the position information is first - read into the libstream-indextable slot, then this information is - overwritten by the index table itself. - - we need the name of the NRLIB passed down to the low level functions - so they can open the new NRLIB format and perform the correct file - position operation. once the NRLIB is open it is only referenced - within one constructor so we can lose the master index table. -\end{verbatim} -\section{License} -<<license>>= ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. +;; Copyright (C) 2007, Gabriel Dos Reis. +;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions are @@ -124,9 +31,88 @@ ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> + +;; the old compiler splits source files on a domain by domain basis + +;; the new compiler compiles all of the domains in a file together into a +;; single output file + +;; in order to converge these two approaches nrlibs are being combined on +;; a file basis rather than split on a domain basis. this change should be +;; transparent to all code that properly accesses the files. + +;; INTERP.EXPOSED will be enhanced to contain the source file name of +;; the domain. thus, instead of: +;; INT Integer +;; it will be: +;; INT integer Integer + +;; which would mean that the library that contains INT would be integer.NRLIB +;; by using this mechanism we can continue to use the old libraries +;; since each entry would now contain: +;; INT INT Integer +;; which would mean that the library that contains the domain INT is INT.NRLIB + +;; old file formats for nrlibs: + +;; first sexpr is integer specifying the byte position of the index of the file +;; next n sexprs are information in the nrlib +;; last sexpr is an alist (pointed at by the first number in the file) which +;; contains triples. e.g. (("slot1info" 0 2550)...) +;; each triple consists of a string, a zero, and an byte offset into the file +;; of the information requested e.g. slot1info starts at byte 2550 + +;; new file formats for libs: + +;; first sexpr is either an integer (in which case this is exactly an old nrlib +;; --- or --- +;; first sexpr is an alist of the form: +;; ((abbreviation . index) ...) +;; where each abbreviation is the abbreviation of the domain name and each +;; index is a pointer to the triples alist + +;; so, for example, integer.spad contains 5 domains: +;; INTSLPE, INT, NNI, PI and ROMAN +;; previously INT.NRLIB/index.KAF contained: +;; 2550 +;; (sexpr1...) +;; (sexpr2....) +;; (sexpr3...) +;; (("sexpr1" 0 8) ("sexpr2" 0 22) ("sexpr3 0 45)) +;; and the individual index.KAF files were similar for the other 4 domains. + +;; under the new scheme integer.nrlib/index.KAF would contain: +;; ((INTSLPE . 2000) (INT . 4000) (NNI . 6000) (PI . 8000) (ROMAN . 10000)) +;; (sexpr1...) --- info for INTSLPE +;; (sexpr2....) +;; (sexpr3...) +;; (("sexpr1" 0 8) ("sexpr2" 0 22) ("sexpr3 0 45)) +;; (sexpr1...) --- info for INT +;; (sexpr2....) +;; (sexpr3...) +;; (("sexpr1" 0 2800) ("sexpr2" 0 2900) ("sexpr3 0 3000)) +;; (sexpr1...) --- info for NNI +;; (sexpr2....) +;; (sexpr3...) +;; (("sexpr1" 0 4100) ("sexpr2" 0 4200) ("sexpr3 0 4300)) +;; (sexpr1...) --- info for PI +;; (sexpr2....) +;; (sexpr3...) +;; (("sexpr1" 0 6100) ("sexpr2" 0 6200) ("sexpr3 0 6300)) +;; (sexpr1...) --- info for ROMAN +;; (sexpr2....) +;; (sexpr3...) +;; (("sexpr1" 0 8100) ("sexpr2" 0 8200) ("sexpr3 0 8300)) + +;; when an NRLIB is opened currently the position information is first +;; read into the libstream-indextable slot, then this information is +;; overwritten by the index table itself. + +;; we need the name of the NRLIB passed down to the low level functions +;; so they can open the new NRLIB format and perform the correct file +;; position operation. once the NRLIB is open it is only referenced +;; within one constructor so we can lose the master index table. + (in-package "BOOT") @@ -223,43 +209,43 @@ (defun loadvol (&rest filearg) (cond ((typep (car filearg) 'libstream) - (load (concat (libstream-dirname (car filearg)) "/code"))) - (t + (load (concat (libstream-dirname (car filearg)) "/code"))) + (t (setq filearg (make-input-filename (boot::mergelib filearg) 'LISPLIB)) - (if (library-file filearg) - (load (concat filearg "/code")) - (load filearg))))) + (if (library-file filearg) + (load (concat filearg "/code")) + (load filearg))))) ; from nlib.lisp ;; (RDEFIOSTREAM ((MODE . IO) (FILE fn ft dir))) IO is I,O,INPUT,OUTPUT (defun rdefiostream (options &optional (missing-file-error-flag t) abbrev) (let ((mode (cdr (assoc 'mode options))) - (file (assoc 'file options)) - (stream nil) - (fullname nil) - (indextable nil)) + (file (assoc 'file options)) + (stream nil) + (fullname nil) + (indextable nil)) (cond ((equal (elt (string mode) 0) #\I) - (setq fullname (make-input-filename (cdr file) 'LISPLIB)) - (setq stream (get-input-index-stream fullname)) + (setq fullname (make-input-filename (cdr file) 'LISPLIB)) + (setq stream (get-input-index-stream fullname)) (if (null stream) - (if missing-file-error-flag - (ERROR (format nil "Library ~s doesn't exist" - (make-filename (cdr file) 'LISPLIB))) - NIL) + (if missing-file-error-flag + (ERROR (format nil "Library ~s doesn't exist" + (make-filename (cdr file) 'LISPLIB))) + NIL) (make-libstream :mode 'input :dirname fullname :indextable (get-index-table-from-stream stream abbrev) :indexstream stream))) ((equal (elt (string mode) 0) #\O) - (setq fullname (make-full-namestring (cdr file) 'LISPLIB)) - (case (directory? fullname) - (-1 (makedir fullname)) - (0 (error (format nil "~s is an existing file, not a library" fullname))) - (otherwise)) - (multiple-value-setq (stream indextable) (get-io-index-stream fullname)) - (make-libstream :mode 'output :dirname fullname - :indextable indextable - :indexstream stream )) + (setq fullname (make-full-namestring (cdr file) 'LISPLIB)) + (case (directory? fullname) + (-1 (makedir fullname)) + (0 (error (format nil "~s is an existing file, not a library" fullname))) + (otherwise)) + (multiple-value-setq (stream indextable) (get-io-index-stream fullname)) + (make-libstream :mode 'output :dirname fullname + :indextable indextable + :indexstream stream )) ('t (ERROR "Unknown MODE"))))) (in-package "BOOT") @@ -851,9 +837,3 @@ (file-position out 0) (print masterpos out) (finish-output out))))) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/domain.lisp.pamphlet b/src/interp/domain.lisp index 775f3526..952b3a5e 100644 --- a/src/interp/domain.lisp.pamphlet +++ b/src/interp/domain.lisp @@ -1,18 +1,7 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp domain.lisp} -\author{Timothy Daly} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<<license>>= ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. +;; Copyright (C) 2007, Gabriel Dos Reis. +;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions are @@ -42,9 +31,6 @@ ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> ;; lisp support for creating domain stubs @@ -56,55 +42,55 @@ (defstruct (old-compiler-domain (:include domain) (:conc-name oldom-)) (devaluate (if dollar (|devaluate| dollar) - (CONS constructor (MAPCAR #'|devaluate| args)))) + (CONS constructor (MAPCAR #'|devaluate| args)))) (vector nil)) (defun check-dollar-fields (constructor arglist) (if (some #'(lambda (x) (and (domain-p x) (domain-dollar x))) arglist) (apply constructor (mapcar #'(lambda (x) (if (domain-p x) - (or (domain-dollar x) x) - x)) arglist)) + (or (domain-dollar x) x) + x)) arglist)) nil)) (defun |domain?| (x) (domain-p x)) (defun |Mapping| (&rest args) (make-old-compiler-domain :constructor '|Mapping| :args args - :vector '|Mapping0|)) + :vector '|Mapping0|)) (defun |Record| (&rest args) (make-old-compiler-domain :constructor '|Record| :args args - :vector '|Record0|)) + :vector '|Record0|)) (defun |Union| (&rest args) (make-old-compiler-domain :constructor '|Union| :args args - :vector '|Union0|)) + :vector '|Union0|)) (defun |devaluate| (x &aux tag dom) (cond ((REFVECP x) - (if (> (QVSIZE x) 5) - (cond ((equal (qvelt x 3) '(|Category|)) - (qvelt x 0)) + (if (> (QVSIZE x) 5) + (cond ((equal (qvelt x 3) '(|Category|)) + (qvelt x 0)) ;; next line will become obsolete - ((|isFunctor| (qvelt x 0)) (qvelt x 0)) - ((domain-p (qvelt x 0)) (|devaluate| (qvelt x 0))) - (t x)) - x)) - ((and (pairp x) (eq (car x) '|:|) (dcq (tag dom) (cdr x))) - (list (car x) tag (|devaluate| dom))) + ((|isFunctor| (qvelt x 0)) (qvelt x 0)) + ((domain-p (qvelt x 0)) (|devaluate| (qvelt x 0))) + (t x)) + x)) + ((and (pairp x) (eq (car x) '|:|) (dcq (tag dom) (cdr x))) + (list (car x) tag (|devaluate| dom))) ; 20030527 note that domain-p does not exist - ((not (domain-p x)) x) + ((not (domain-p x)) x) ; 20030527 note that old-compiler-domain-p does not exist - ((old-compiler-domain-p x) (oldom-devaluate x)) - (t (error "devaluate of new compiler domain")))) + ((old-compiler-domain-p x) (oldom-devaluate x)) + (t (error "devaluate of new compiler domain")))) (defun |domainEqual| (x y) (cond ((old-compiler-domain-p x) - (if (old-compiler-domain-p y) - (equalp (oldom-devaluate x) (oldom-devaluate y)) - nil)) - ((old-compiler-domain-p y) nil) - (t (error "no new compiler domains yet")))) + (if (old-compiler-domain-p y) + (equalp (oldom-devaluate x) (oldom-devaluate y)) + nil)) + ((old-compiler-domain-p y) nil) + (t (error "no new compiler domains yet")))) (defun |domainSelectDollar| (dom) (or (domain-dollar dom) dom)) @@ -117,14 +103,14 @@ (defun |domainSelectVector| (dom) (let ((vec (oldom-vector dom))) (cond ((vectorp vec) vec) - ((null vec) nil) - ((symbolp vec) ;; case for Records and Unions - (setq vec (funcall vec (domain-args dom))) - (setf (elt vec 0) dom) - (setf (oldom-vector dom) vec)) - ((or (fboundp (car vec)) - (|loadLib| (cdr vec)) t) - (instantiate (car vec) dom))))) + ((null vec) nil) + ((symbolp vec) ;; case for Records and Unions + (setq vec (funcall vec (domain-args dom))) + (setf (elt vec 0) dom) + (setf (oldom-vector dom) vec)) + ((or (fboundp (car vec)) + (|loadLib| (cdr vec)) t) + (instantiate (car vec) dom))))) ;;(defun instantiate (innername dom) ;; (let ((vec (apply innername (domain-args dom)))) @@ -134,13 +120,13 @@ (defun instantiate (innername dom) (let* ((infovec (get (domain-constructor dom) '|infovec|)) - (|$dollarVec| (getrefv (size (car infovec ))))) + (|$dollarVec| (getrefv (size (car infovec ))))) (declare (special |$dollarVec|)) (setf (elt |$dollarVec| 0) dom) (setf (elt |$dollarVec| 1) - (list (symbol-function (|getLookupFun| infovec)) - |$dollarVec| - (elt infovec 1))) + (list (symbol-function (|getLookupFun| infovec)) + |$dollarVec| + (elt infovec 1))) (setf (elt |$dollarVec| 2) (elt infovec 2)) (setf (oldom-vector dom) |$dollarVec|) (apply innername (domain-args dom)) @@ -148,32 +134,32 @@ (defun universal-domain-constructor (&rest args-env) (let* ((args (fix-domain-args (butlast args-env))) - (env (car (last args-env)))) + (env (car (last args-env)))) (check-constructor-cache env args))) (defun fix-domain-args (args) (mapcar #'(lambda (x) (if (and (vectorp x) (domain-p (elt x 0))) - (elt x 0) x)) args)) + (elt x 0) x)) args)) (defun universal-nocache-domain-constructor (&rest args-env) (let* ((args (butlast args-env)) - (env (car (last args-env)))) + (env (car (last args-env)))) (make-old-compiler-domain :constructor (car env) - :args args - :vector (cdr env)))) + :args args + :vector (cdr env)))) (defun universal-category-defaults-constructor (&rest args-env) (let* ((args (butlast args-env)) - (env (car (last args-env)))) + (env (car (last args-env)))) (make-old-compiler-domain :constructor (car env) - :args args - :dollar (car args) - :vector (cdr env)))) + :args args + :dollar (car args) + :vector (cdr env)))) (defun cached-constructor (cname) (if (or (|isCategoryPackageName| cname) - (and (boundp '|$mutableDomains|) - (memq cname |$mutableDomains|))) + (and (boundp '|$mutableDomains|) + (memq cname |$mutableDomains|))) nil t)) @@ -182,66 +168,60 @@ (defun |mkAutoLoad| (fn cname) (cond ((or (memq cname |$CategoryNames|) - (eq (GETDATABSE cname 'CONSTRUCTORKIND) '|category|)) - (function (lambda (&rest args) - (|autoLoad| fn cname) - (apply cname args)))) - (t (|systemDependentMkAutoload| fn cname) - (symbol-function cname)))) + (eq (GETDATABSE cname 'CONSTRUCTORKIND) '|category|)) + (function (lambda (&rest args) + (|autoLoad| fn cname) + (apply cname args)))) + (t (|systemDependentMkAutoload| fn cname) + (symbol-function cname)))) (defun |systemDependentMkAutoload| (fn cname) (let* ((cnameInner (intern (strconc cname ";"))) - (env (list* cname cnameInner fn)) - (spadfun - (cond ((|isCategoryPackageName| cname) - (cons #'universal-category-defaults-constructor env)) - ((and (boundp '|$mutableDomains|) - (memq cname |$mutableDomains|)) - (cons #'universal-nocache-domain-constructor env)) - (t (cons #'universal-domain-constructor env))))) + (env (list* cname cnameInner fn)) + (spadfun + (cond ((|isCategoryPackageName| cname) + (cons #'universal-category-defaults-constructor env)) + ((and (boundp '|$mutableDomains|) + (memq cname |$mutableDomains|)) + (cons #'universal-nocache-domain-constructor env)) + (t (cons #'universal-domain-constructor env))))) (setf (symbol-function cname) (mkConstructor spadfun)) (set cname spadfun))) (defun mkConstructor (spadfun) (function (lambda (&rest args) - (apply (car spadfun) (append args (list (cdr spadfun))))))) + (apply (car spadfun) (append args (list (cdr spadfun))))))) (defun |makeAddDomain| (add-domain dollar) (cond ((old-compiler-domain-p add-domain) - (make-old-compiler-domain :constructor (domain-constructor add-domain) - :args (domain-args add-domain) - :dollar dollar - :vector (cddr (eval (domain-constructor add-domain))))) - (t (error "no new compiler adds supported yet")))) + (make-old-compiler-domain :constructor (domain-constructor add-domain) + :args (domain-args add-domain) + :dollar dollar + :vector (cddr (eval (domain-constructor add-domain))))) + (t (error "no new compiler adds supported yet")))) (defun check-constructor-cache (env arglist) (let ((dollar (check-dollar-fields (car env) arglist))) (if dollar (make-old-compiler-domain :constructor (car env) - :args arglist - :dollar dollar - :vector (cdr env)) + :args arglist + :dollar dollar + :vector (cdr env)) (let* ((constructor (car env)) - (devargs (mapcar #'|devaluate| arglist)) - (cacheddom - (|lassocShiftWithFunction| devargs - (HGET |$ConstructorCache| constructor) - #'|domainEqualList|))) - (if cacheddom (|CDRwithIncrement| cacheddom) - (cdr (|haddProp| |$ConstructorCache| constructor devargs - (cons 1 (make-old-compiler-domain :constructor constructor - :args arglist - :devaluate - (cons constructor devargs) - :vector (cdr env)))))))))) - - - - - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} + (devargs (mapcar #'|devaluate| arglist)) + (cacheddom + (|lassocShiftWithFunction| devargs + (HGET |$ConstructorCache| constructor) + #'|domainEqualList|))) + (if cacheddom (|CDRwithIncrement| cacheddom) + (cdr (|haddProp| |$ConstructorCache| constructor devargs + (cons 1 (make-old-compiler-domain :constructor constructor + :args arglist + :devaluate + (cons constructor devargs) + :vector (cdr env)))))))))) + + + + + + diff --git a/src/interp/guess.boot.pamphlet b/src/interp/guess.boot index 4f4d2544..1aeefc88 100644 --- a/src/interp/guess.boot.pamphlet +++ b/src/interp/guess.boot @@ -1,18 +1,7 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp guess.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<<license>>= -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. +-- Copyright (C) 2007, Gabriel Dos Reis. +-- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are @@ -42,9 +31,6 @@ -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> $minThreshold := 3 $maxThreshold := 7 @@ -361,9 +347,3 @@ forge(word,w,W,entry,e,E,n) == --+ forge(word,w+1,W,entry,e+1,E,d,i,s+1,t) mySort u == listSort(function GLESSEQP,u) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nhyper.boot.pamphlet b/src/interp/nhyper.boot index d0fb8051..57e4771b 100644 --- a/src/interp/nhyper.boot.pamphlet +++ b/src/interp/nhyper.boot @@ -1,18 +1,7 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nhyper.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<<license>>= -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. +-- Copyright (C) 2007, Gabriel Dos Reis. +-- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are @@ -42,9 +31,6 @@ -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> -- HyperTex Spad interface @@ -133,9 +119,3 @@ HTKillPage w == HTErrorSignal() == sockSendInt($MenuServer, $SpadError) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} |