;;; -*- mode:lisp; package:user; base:10.; fonts:(cptfontb) -*- ;;; ;;;$Header: /ct/ctlisp/chunks.l,v 1.4 84/01/04 06:11:11 mark Exp $ ;;; ;;;$Log: /ct/ctlisp/chunks.l,v $ ;;;Revision 1.4 84/01/04 06:11:11 mark ;;;Changed names to conform with John's ctlisp proposed conventions. ;;;Cleaned up chunk-put to use putprop argument order and to return ;;;the value instead of the chunk. Rewrote to use the newly cleaned ;;;up Polly stuff instead of doing its own thing in pure space. Made ;;;it cleverer about compile-time optimizations for special cases. ;;;Removed the "-" from chunksize. Added a few more useful macros. ;;; ;;;Revision 1.3 83/12/20 02:02:01 mark ;;; Renamed chunk_p to chunkp, and tidied up a few expansions. ;;; ;;;Revision 1.2 83/12/18 14:09:40 mark ;;; Added the 128 sized chunks, after all. ;;; ;;;Revision 1.1 83/12/17 22:55:35 mark ;;; Initial revision ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; CHUNKS ;;; ;;; Mark L. Miller 17-Dec-83 ;;; ;;; ;;; ;;; This documentation is out of date and must be rewritten ++mlm ;;; ;;; Chunks, a new specialized datatype similar to hunks. However, ;;; ;;; they work the same way on all ctlisp implementations. They are ;;; ;;; useful for certain specialized kinds of records, such as Diana ;;; ;;; nodes. They come in both pure and impure varieties. They only ;;; ;;; come in 6 sizes: 4, 8, 16, 32, 64, and 128. They are simulated ;;; ;;; using hunks on Franz and arrays on LM. They are intended to be ;;; ;;; a highly efficient, low-level way of allocating and working ;;; ;;; with a contiguous "chunk" of storage cells. Each element of a ;;; ;;; chunk can be an arbitrary LISP object. Does NOT rely on polly ;;; ;;; package or other files EXCEPT basics from charmac, aip, compat. ;;; ;;; ;;; ;;; All macros, tries to be reasonably clever at compile time. ;;; ;;; Make-chunk (n) -- n must be one of the six fixnum sizes. The ;;; ;;; elements (range 0..(n-1)) are initialized to nil. ;;; ;;; Make-pure-chunk is analogous but it goes on a static page. ;;; ;;; Chunkp (frob) -- true iff frob is a chunk. ;;; ;;; Chunk-get (chunk n) -- returns chunk element n in range 0.. ;;; ;;; (size-1). Chunk-put (chunk val n) -- overwrites element n with ;;; ;;; val. Chunksize (chunk) -- fixnum in {4, 8, 16, 32, 64, 128}. ;;; ;;; ;;; ;;; This file is part of a proprietary software project. Source ;;; ;;; code and documentation describing implementation details are ;;; ;;; available on a confidential, non-disclosure basis only. These ;;; ;;; materials, including this file in particular, are trade secrets ;;; ;;; of Computer * Thought Corporation. ;;; ;;; ;;; ;;; (c) Copyright 1982 and 1983, Computer * Thought Corporation. ;;; ;;; All Rights Reserved. ;;; ;;; ;;; ;;; Reference materials: ;;; ;;; Foderaro and Sklower, The FRANZ LISP Manual, September 1981. ;;; ;;; Weinreb and Moon, LISP MACHINE MANUAL, Symbolics, July 1981. ;;; ;;; Charniak et al., 1980. Artificial Intelligence Programming. ;;; ;;; The following code assumes familiarity with these materials. ;;; ;;; ;;; ;;; ASSUMES CTLOAD AND SUITABLE FILEMAP ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Dependencies on Other Files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile load eval) (ct_load 'charmac)) ;Char set extensions. ;;; One thing we use a lot from charmac is hash-dollar-period, ;;; which expands to (eval-when (compile load eval) ,(read)). #$. (ct_load 'aip) ;AIP macros pkg. #$. (ct_load 'compat) ;Compatibility pkg. #$. (ct_load 'polly) ;Pure space functions. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Compiler Declarations and Global Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; #+franz (declare (macros t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Externally Useful Macros ;;; ;;; There are also a few internal-use-only exprs defined that are ;;; only for use as a result of certain cases in the macro expansions. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; #$. ;;;;;;;;;;;;;;;;; (defun chunksizep macro (form) ;;;;;;;;;;;;;;;;; ;;; One arg. Returns non-NIL iff the arg is a legal chunk size. ;;; Currently we allow chunks of any fixnum size in [1, 128.]. ;;; NB: It is possible that future implementations might restrict ;;; sizes to {2, 4., 8., 16., 32., 64., 128.}. On Franz, the ;;; actual space allocation is in these powers of two, but there ;;; seems to be no good reason to limit the user in this respect. ;;; This check is meant to be cheap and tries to win at compile-time. (selfinsertmacro form (let ((n (cadr form))) ; Value should be a fixnum. (cond ;; Try for compile-time special-case optimizations. ((fixp n) ; Constant fixnum arg. `(progn ,(not (or (< n 1) (> n 128.))))) ; Eg., (progn t). ((and (consp n) (eq (car n) 'quote)) ; Unnecessary quote? `(progn ,(and (fixp (cadr n)) (not (or (< (cadr n) 1) (> (cadr n) 128.)))))) ((symbolp n) ; No need to bind it up. `(and (fixp ,n) (not (or (< ,n 1) (> ,n 128.))))) ((not (consp n)) ; So it cannot eval ok. '(progn nil)) (t ; Arbitrary expression, (let ((g (gensym))) ; the general case. `(let ((,g ,n)) ; Must avoid name clashes. (and (fixp ,g) (not (or (< ,g 1) (> ,g 128.))))))))))) #$. ;;;;;;;;;;;;;;;;;;;;;; (defun chunksizep-check macro (form) ;;;;;;;;;;;;;;;;;;;;;; (selfinsertmacro form `(or (chunksizep ,(cadr form)) ;Siz, a fixnum. (lose 'wta ,(caddr form) ;Fun, name of caller. '("~&Chunk size must be a fixnum in the range [1, 128.].~%"))))) #$. ;;;;;;;;;; (defun make-chunk macro (form) ;;Eg., (make-chunk 32.) ;;;;;;;;;; ;;; Takes one arg which should be a fixnum in [1, 128.]. ;;; Somewhat analogous to Franz' makhunk, but does not handle ;;; the frivolous list-of-initial-values case {deliberately}. (selfinsertmacro form ;; Try for special-case (let ((siz (cadr form))) ;; compile-time optimizations. (cond ((fixp siz) ;; Constant fixnum case. (and (chunksizep-check siz 'make-chunk) `(#+franz impure-hunk-of-nils #+lispm make-array ,siz))) ((symbolp siz) ;;No need to bind up. `(and (chunksizep-check ,siz 'make-chunk) (#+franz impure-hunk-of-nils #+lispm make-array ,siz))) ((and (consp siz) (eq (car siz) 'quote)) ; Unnecessary quote? (and (chunksizep-check (cadr siz) 'make-chunk) `(#+franz impure-hunk-of-nils #+lispm make-array ,(cadr siz)))) ((not (consp siz)) (lose 'wta 'make-chunk `("~&Size arg not form that could eval to fixnum in [1, 128.].~%"))) (t ;; Must bind up, to prevent double eval. (let ((g (gensym))) ;; Must be careful to avoid name clashes. `(let ((,g ,siz)) (and (chunksizep-check ,g 'make-chunk) (#+franz impure-hunk-of-nils #+lispm make-array ,g))))))))) #$. ;;;;;;;;;;;;;;; (defun make-pure-chunk macro (form) ;;;;;;;;;;;;;;; ;;; Takes one arg which should be a fixnum in [1, 128.]. ;;; Pure-space version of make-chunk. (selfinsertmacro form ;; Try for special-case (let ((siz (cadr form))) ;; compile-time optimizations. (cond ((fixp siz) ;; Constant fixnum case. (and (chunksizep-check siz 'make-pure-chunk) `(#+franz pure-hunk-of-nils #+lispm pure-make-array ,siz))) ((symbolp siz) ;;No need to bind up. `(and (chunksizep-check ,siz 'make-pure-chunk) (#+franz pure-hunk-of-nils #+lispm pure-make-array ,siz))) ((and (consp siz) (eq (car siz) 'quote)) ; Unnecessary quote? (and (chunksizep-check (cadr siz) 'make-pure-chunk) `(#+franz pure-hunk-of-nils #+lispm pure-make-array ,(cadr siz)))) ((not (consp siz)) (lose 'wta 'make-pure-chunk `("~&Size arg not form that could eval to fixnum in [1, 128.].~%"))) (t ;; Must bind up, to prevent double eval. (let ((g (gensym))) ;; Must be careful to avoid name clashes. `(let ((,g ,siz)) (and (chunksizep-check ,g 'make-pure-chunk) (#+franz pure-hunk-of-nils #+lispm pure-make-array ,g))))))))) #$. ;;;;; (defun chunk macro (form) ;;;;; ;;; Analogous to Franz' hunk. From 1 to 128. arguments. (selfinsertmacro form (let ((l (1- (length form))) (args (cdr form))) (and (chunksizep-check l 'chunk) ;Known at compile time. #+franz `(hunk ,@args) #+lispm `(fillarray (make-array ,l) (list ,@args)))))) #$. ;;;;;;;;;; (defun pure-chunk macro (form) ;;;;;;;;;; ;;; Analogous to pure-hunk. From 1 to 128. arguments. (selfinsertmacro form (let ((l (1- (length form))) (args (cdr form))) (and (chunksizep-check l 'pure-chunk) ;Known at compile time. #+franz `(pure-hunk ,@args) ;See Polly. #+lispm `(fillarray (pure-make-array ,l) ;See Polly. (list ,@args)))))) #+lispm #$. ;;;;;;;;;;;;;;;; (defun chunkp-lispm-int (frob) ;For internal use only. ;;;;;;;;;;;;;;;; ;;; Internal expr needed only for LISPM case because the array ;;; representation of chunks is slightly harder to verify. We'd ;;; have to bind up the frob in any case. (and (eq (typep frob) ':array) (= (array-!#-dims frob) 1) (chunksizep (array-length frob)))) #$. ;;;;;; (defun chunkp macro (form) ;;;;;; ;;; Accepts any frob and returns non-NIL iff it is a legal chunk. (selfinsertmacro form `(#+franz hunkp #+lispm chunkp-lispm-int ,(cadr form)))) #$. ;;;;;;;;;; (defun chunksize macro (form) ;;;;;;;;;; ;;; No checking -- must be given a good chunk. Returns a ;;; fixnum in the range [1, 128.]. Note: on the Vax, this ;;; must actually count the non-empty elements. Hence, please ;;; use with some caution regarding efficiency. (selfinsertmacro form `(#+franz hunksize #+lispm array-length ,(cadr form)))) #$. ;;;;;;;;; (defun chunk-get macro (form) ;;;;;;;;; (let ((chunk (cadr form)) (idx (caddr form))) ;;; Chunk must be a legal chunk, index must be in 0..N-1 ;;; Otherwise the errors will be implementation specific ;;; and obscure {eg., array subscript out of range}. ;;; This is important, so chunks will be very cheap to use. (selfinsertmacro form #+franz `(cxr ,idx ,chunk) #+lispm `(aref ,chunk ,idx)))) #+franz #$. ;;;;;;;;;;;;;;;;;;; (defun chunk-put-franz-int (chunk val idx) ;;For internal use only. ;;;;;;;;;;;;;;;;;;; ;;; Internal to chunk-put macro for Franz case where you have to ;;; bind up the value to prevent double evaluation. An alternative ;;; might have been to macro-expand to an in-line lambda, but these ;;; take longer to compile. There is little or no run-time difference, ;;; since non-local scoping issues are not of concern here. (rplacx idx chunk val) ;Rplacx returns the chunk, val) ;but we return the value. #$. ;;;;;;;;; (defun chunk-put macro (form) ;;;;;;;;; ;;; Like putprop. Returns new VALue {NOT modified chunk}. ;;; Perhaps more efficient when the value is recognizably ;;; atomic at compile time. (let ((chunk (cadr form)) (val (caddr form)) (idx (cadddr form))) (selfinsertmacro form #+franz (cond ;;; Have to return val even though rplacx does not ;;; cooperate. Try to special-case optimize this, ;;; by using progn when no need to bind it up. ((or (symbolp val) (numberp val) (stringp val) (and (consp val) (eq (car val) 'quote))) ;;; Special cases for when no need to bind it up. `(progn (rplacx ,idx ,chunk ,val) ,val)) (t `(chunk-put-franz-int ,chunk ,val ,idx))) #+lispm `(aset ,val ,chunk ,idx)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; eof ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;