movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS update: movitz/losp/muerte/cons.lisp
by Frode Vatvedt Fjeld 22 Mar '04

22 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16332 Modified Files: cons.lisp Log Message: Removed some dead code. Date: Mon Mar 22 09:42:32 2004 Author: ffjeld Index: movitz/losp/muerte/cons.lisp diff -u movitz/losp/muerte/cons.lisp:1.2 movitz/losp/muerte/cons.lisp:1.3 --- movitz/losp/muerte/cons.lisp:1.2 Mon Jan 19 06:23:46 2004 +++ movitz/losp/muerte/cons.lisp Mon Mar 22 09:42:31 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 15:25:45 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: cons.lisp,v 1.2 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: cons.lisp,v 1.3 2004/03/22 14:42:31 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -215,10 +215,3 @@ (:compile-form (:result-mode :eax) car) (:compile-form (:result-mode :ebx) cdr) (:call-global-constant fast-cons))) - -#+ignore -(defun cons (car cdr) - (let ((cell (inline-malloc 8 :tag :cons))) - (setf (car cell) car - (cdr cell) cdr) - cell))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/print.lisp
by Frode Vatvedt Fjeld 22 Mar '04

22 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3394 Modified Files: print.lisp Log Message: Fixed :gensym argument to write. Date: Mon Mar 22 09:38:13 2004 Author: ffjeld Index: movitz/losp/muerte/print.lisp diff -u movitz/losp/muerte/print.lisp:1.2 movitz/losp/muerte/print.lisp:1.3 --- movitz/losp/muerte/print.lisp:1.2 Mon Jan 19 06:23:47 2004 +++ movitz/losp/muerte/print.lisp Mon Mar 22 09:38:13 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Sep 3 11:48:19 2001 ;;;; -;;;; $Id: print.lisp,v 1.2 2004/01/19 11:23:47 ffjeld Exp $ +;;;; $Id: print.lisp,v 1.3 2004/03/22 14:38:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -150,7 +150,7 @@ (defun write (object &key stream case circle (array *print-array*) (base *print-base*) ((:escape *print-escape*) *print-escape*) - ((:gensym *print-gensym*) *print-readably*) + ((:gensym *print-gensym*) *print-gensym*) (length *print-length*) (level *print-level*) lines miser-width pprint-dispatch (pretty *print-pretty*) (radix *print-radix*)

1 0

[movitz-cvs] CVS update: movitz/losp/los0.lisp
by Frode Vatvedt Fjeld 22 Mar '04

22 Mar '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv24697 Modified Files: los0.lisp Log Message: Bind *, **, etc. around the top-level REPL. Also several minor edits. Date: Mon Mar 22 04:49:11 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.3 movitz/losp/los0.lisp:1.4 --- movitz/losp/los0.lisp:1.3 Tue Feb 10 18:38:20 2004 +++ movitz/losp/los0.lisp Mon Mar 22 04:49:11 2004 @@ -9,17 +9,18 @@ ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.3 2004/02/10 23:38:20 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.4 2004/03/22 09:49:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ (provide :los0 :load-priority 0) (require :common-lisp) +(require :x86-pc/interrupt) (require :x86-pc/all) (require :x86-pc/io-space) (require :x86-pc/ne2k) -;; (require :x86-pc/floppy) +(require :x86-pc/floppy) (require :lib/readline) (require :lib/toplevel) @@ -28,7 +29,10 @@ (require :lib/repl) (defpackage muerte.init - (:use muerte.cl muerte muerte.lib muerte.x86-pc muerte.readline muerte.toplevel + (:use muerte.cl muerte muerte.lib + muerte.x86-pc + muerte.readline + muerte.toplevel muerte.ethernet muerte.ip6 muerte.ip4 @@ -225,9 +229,10 @@ (format t "~&test-funcall args: ~S~%" args)) #+ignore -(defun test-rest (&optional a0 a1 a3 &rest args) +(defun test-rest (&optional (a0 nil a0-p) a1 a3 &rest args) (declare (dynamic-extent args)) - (format t "args: ~S, ~S, ~S: ~S~%" a0 a1 a3 args)) + (when a0-p + (format t "args: ~S, ~S, ~S: ~S~%" a0 a1 a3 args))) (defun test-return () @@ -316,8 +321,10 @@ (print 'hello))) #+ignore -(defun sloo (x y) - 'sllooo) +(defun sloo (&rest x) + (declare (dynamic-extent x)) + (let ((y (car x))) + (sloo y))) #+ignore (defun test-throw (tag) @@ -343,7 +350,11 @@ (defun test-up (tag) (unwind-protect (test-throw tag) - (print 'hello-cleanup))) + (print 'hello-cleanup))) + +(defun test-cons (x) + (let ((c (cons x x))) + (cdr c))) (defun test-fixed (x y z) (warn "x: ~W, y: ~W, z: ~W" x y z)) @@ -469,6 +480,17 @@ (return-from dingu 'fooob)) (+ x y)) + +(defun foo (&edx edx x &optional (y nil yp)) + (format t "~@{ ~A~}" x y yp edx)) + +(defun wefwe (&rest args) + (declare (dynamic-extent args)) + (do ((p args (cdr p))) + ((endp p)) + (let ((x (car p))) + (print x)))) + ;;;;; (defclass food () ()) @@ -487,53 +509,62 @@ (declare (ignore f)) (print "Cooking some food.")) -(defun foo (x &optional (y nil yp)) - (format t "~@{ ~A~}" yp)) - (defun test-pie (n pie) (dotimes (i n) (pie-filling pie))) +(defun test-inc (n) + (dotimes (i n) + (warn "foo: ~S" (lambda () + (setf i 5))))) + +(defun test-id (n x) + (dotimes (i n) + (identity x))) + +(defun test-inc2 (x) + (print (prog1 x (incf x))) + (print x)) + (defclass pie (food) ((filling :accessor pie-filling :initarg :filling :initform 'apple)) #+ignore (:default-initargs :filling (if (foo) 'apple 'banana))) -#+ignore (defclass pie2 (food) ((filling :accessor pie-filling :initarg :filling :initform nil))) -;;;(defmethod cook ((p (eql 'pie))) -;;; (warn "Won't really cook a symbolic pie!") -;;; (values)) -;;; -;;;(defmethod cook ((p (eql 'pudding))) -;;; 'cooked-pudding) - -;;;(defmethod slot-value-using-class :after (class (pie pie2) slot) -;;; (warn "HEy, don't poke inside my pie2!")) - -;;;(defmethod cook :after ((p symbol)) -;;; (warn "A symbol may or may not have been cooked.")) - -;;;(defmethod cook ((p pie)) -;;; (cond -;;; ((eq 'banana (pie-filling p)) -;;; (print "Won't cook a banana-pie, trying next.") -;;; (call-next-method)) -;;; (t (print "Cooking a pie.") -;;; (setf (pie-filling p) (list 'cooked (pie-filling p)))))) - -;;;(defmethod cook :before ((p pie)) -;;; (declare (ignore p)) -;;; (print "A pie is about to be cooked.")) -;;; -;;;(defmethod cook :after ((p pie)) -;;; (declare (ignore p)) -;;; (print "A pie has been cooked.")) +(defmethod cook ((p (eql 'pie))) + (warn "Won't really cook a symbolic pie!") + (values)) + +(defmethod cook ((p (eql 'pudding))) + 'cooked-pudding) + +(defmethod slot-value-using-class :after (class (pie pie2) slot) + (warn "HEy, don't poke inside my pie2!")) + +(defmethod cook :after ((p symbol)) + (warn "A symbol may or may not have been cooked.")) + +(defmethod cook ((p pie)) + (cond + ((eq 'banana (pie-filling p)) + (print "Won't cook a banana-pie, trying next.") + (call-next-method)) + (t (print "Cooking a pie.") + (setf (pie-filling p) (list 'cooked (pie-filling p)))))) + +(defmethod cook :before ((p pie)) + (declare (ignore p)) + (print "A pie is about to be cooked.")) + +(defmethod cook :after ((p pie)) + (declare (ignore p)) + (print "A pie has been cooked.")) (defun assess-cpu-frequency () "Assess the CPU's frequency in units of 1024 Hz." @@ -828,10 +859,13 @@ *standard-input* s *terminal-io* s *debug-io* s))) - (loop - (catch 'top-level-repl ; If restarts don't work, you can throw this.. - (with-simple-restart (abort "Abort to the top command level.") - (read-eval-print))))) + (let ((* nil) (** nil) (*** nil) + (/ nil) (// nil) (/// nil) + (+ nil) (++ nil) (+++ nil)) + (loop + (catch :top-level-repl ; If restarts don't work, you can throw this.. + (with-simple-restart (abort "Abort to the top command level.") + (read-eval-print)))))) (error "What's up? [~S]" 'hey)) @@ -884,6 +918,7 @@ ,(when error-spec `(error ,@error-spec)))) +#+ignore (defun bridge (&optional (inside (do-default (*inside* "No inside NIC.") (muerte.x86-pc.ne2k:ne2k-probe #x300))) (outside (do-default (*outside* "No outside NIC.")

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by Frode Vatvedt Fjeld 19 Mar '04

19 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv24680 Modified Files: storage-types.lisp Log Message: Some not-too-big changes of certain symbolic constants in preparation of supporting GC scanning. Date: Fri Mar 19 05:49:40 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.10 movitz/storage-types.lisp:1.11 --- movitz/storage-types.lisp:1.10 Thu Mar 18 04:16:38 2004 +++ movitz/storage-types.lisp Fri Mar 19 05:49:39 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.10 2004/03/18 09:16:38 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.11 2004/03/19 10:49:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -67,13 +67,13 @@ :other 6 :symbol 7 - :vector #x08 - :defstruct #x09 - :funobj #x10 - :std-instance #x14 - :run-time-context #x15 + :vector #x10 + :defstruct #x20 + :funobj #x30 + :std-instance #x40 + :run-time-context #x50 - :simple-vector #x20 + ;; :simple-vector #x20 ;; :character-vector :basic-restart #x32 @@ -326,9 +326,9 @@ :initarg :flags :initform nil :binary-type (define-bitfield movitz-vector-flags (u8) - (((:bits) :fill-pointer-p 0 - :code-vector-p 1 - :std-instance-slots-p 2)))) + (((:bits) :fill-pointer-p 2 + :code-vector-p 3 + :std-instance-slots-p 4)))) (alignment-power :binary-lisp-type u8 ; align to 2^(high-nibble+3) + low-nibble :initform 0 @@ -585,18 +585,18 @@ :map-binary-read-delayed 'movitz-word :initform *movitz-nil* :accessor movitz-symbol-package) - (hash-key - :binary-lisp-type lu16 - :reader movitz-symbol-hash-key - :initarg :hash-key) (flags :binary-type (define-bitfield movitz-symbol-flags (lu16) (((:bits) - :special-variable 0 - :constant-variable 1 - :setf-placeholder 4))) + :special-variable 3 + :constant-variable 4 + :setf-placeholder 5))) :accessor movitz-symbol-flags :initform nil) + (hash-key + :binary-lisp-type lu16 + :reader movitz-symbol-hash-key + :initarg :hash-key) (lisp-symbol :initform nil :initarg :lisp-symbol)) @@ -793,10 +793,18 @@ :accessor movitz-funobj-name :initarg :name) (num-jumpers ; how many of the first constants are jumpers. - :binary-type lu16 - :initform 0 + :binary-type lu16 ; 14 bits, the lower 16 bits of a fixnum. + :initform 0 ; This, in order to see this as a fixnum while + :accessor movitz-funobj-num-jumpers ; GC scanning. :initarg :num-jumpers - :accessor movitz-funobj-num-jumpers) + :map-binary-write (lambda (x &optional type) + (declare (ignore type)) + (check-type x (unsigned-byte 14)) + (* x +movitz-fixnum-factor+)) + :map-binary-read (lambda (x &optional type) + (declare (ignore type)) + (assert (zerop (ldb (byte 2 0) x))) + (/ x +movitz-fixnum-factor+))) (num-constants :binary-type lu16 :initform 0 @@ -932,8 +940,13 @@ (num-jumpers :binary-type lu16 :initform 0 - :initarg :num-constants - :accessor movitz-funobj-num-jumpers) + :accessor movitz-funobj-num-jumpers + :map-binary-write (lambda (x &optional type) + (declare (ignore typE)) + (* x +movitz-fixnum-factor+)) + :map-binary-read (lambda (x &optional type) + (declare (ignore typE)) + (/ x +movitz-fixnum-factor+))) (num-constants :binary-type lu16 :initform (/ (- (sizeof 'movitz-funobj-standard-gf)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/lists.lisp
by Frode Vatvedt Fjeld 18 Mar '04

18 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22982 Modified Files: lists.lisp Log Message: Have nthcdr bail out when nil is encountered. Date: Thu Mar 18 04:24:23 2004 Author: ffjeld Index: movitz/losp/muerte/lists.lisp diff -u movitz/losp/muerte/lists.lisp:1.3 movitz/losp/muerte/lists.lisp:1.4 --- movitz/losp/muerte/lists.lisp:1.3 Tue Feb 3 04:57:49 2004 +++ movitz/losp/muerte/lists.lisp Thu Mar 18 04:24:23 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Tue Dec 5 18:40:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: lists.lisp,v 1.3 2004/02/03 09:57:49 ffjeld Exp $ +;;;; $Id: lists.lisp,v 1.4 2004/03/18 09:24:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -133,7 +133,7 @@ (defun nthcdr (n list) (do () - ((= 0 n) list) + ((or (null list) (not (plusp n))) list) (decf n) (setf list (cdr list)))) @@ -200,10 +200,10 @@ (defun copy-list (list) (if (null list) nil - (do* ((new-list (cons (pop list) nil)) - (new-tail new-list (cdr new-tail))) - ((null list) new-list) - (setf (cdr new-tail) (cons (pop list) nil))))) + (let ((new-list (cons (pop list) nil))) + (do ((new-tail new-list (cdr new-tail))) + ((null list) new-list) + (setf (cdr new-tail) (cons (pop list) nil)))))) (defun list (&rest objects) (numargs-case

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/run-time-context.lisp
by Frode Vatvedt Fjeld 18 Mar '04

18 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5600 Modified Files: run-time-context.lisp Log Message: Tune-up of %run-time-context-slot. Date: Thu Mar 18 04:23:02 2004 Author: ffjeld Index: movitz/losp/muerte/run-time-context.lisp diff -u movitz/losp/muerte/run-time-context.lisp:1.1.1.1 movitz/losp/muerte/run-time-context.lisp:1.2 --- movitz/losp/muerte/run-time-context.lisp:1.1.1.1 Tue Jan 13 06:05:06 2004 +++ movitz/losp/muerte/run-time-context.lisp Thu Mar 18 04:23:01 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 12 18:33:02 2003 ;;;; -;;;; $Id: run-time-context.lisp,v 1.1.1.1 2004/01/13 11:05:06 ffjeld Exp $ +;;;; $Id: run-time-context.lisp,v 1.2 2004/03/18 09:23:01 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -67,13 +67,18 @@ form (let ((slot-name (movitz::eval-form slot-name env))) (ecase (bt:binary-slot-type 'movitz::movitz-constant-block (intern (symbol-name slot-name) :movitz)) - (movitz::word + (movitz:word `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) ,value) (:locally (:movl :eax (:edi (:edi-offset ,slot-name)))))) - (movitz::lu32 + (movitz:lu32 `(with-inline-assembly (:returns :untagged-fixnum-ecx) (:compile-form (:result-mode :untagged-fixnum-ecx) ,value) + (:locally (:movl :ecx (:edi (:edi-offset ,slot-name)))))) + (movitz:code-vector-word + `(with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) ,value) + (:leal (:eax ,(bt:slot-offset 'movitz:movitz-vector 'movitz::data)) :ecx) (:locally (:movl :ecx (:edi (:edi-offset ,slot-name)))))))))) (defun (setf %run-time-context-slot) (value slot-name &optional (context (current-run-time-context))) @@ -83,6 +88,8 @@ (word (setf (memref context -6 (third slot) :lisp) value)) (lu32 + (setf (memref context -6 (third slot) :unsigned-byte32) value)) + (code-vector-word (setf (memref context -6 (third slot) :unsigned-byte32) value))))) (defun %run-time-context-segment-base (slot-name

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-functions.lisp
by Frode Vatvedt Fjeld 18 Mar '04

18 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv28802 Modified Files: primitive-functions.lisp Log Message: Minor optimizations regarding register usage. Date: Thu Mar 18 04:21:18 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.4 movitz/losp/muerte/primitive-functions.lisp:1.5 --- movitz/losp/muerte/primitive-functions.lisp:1.4 Thu Feb 26 08:43:51 2004 +++ movitz/losp/muerte/primitive-functions.lisp Thu Mar 18 04:21:17 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.4 2004/02/26 13:43:51 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.5 2004/03/18 09:21:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -466,9 +466,8 @@ (:shrl 1 :eax))) (define-primitive-function fast-cons () - "Call with car in eax and cdr in ebx. Preserves EDX." + "Allocate a cons cell. Call with car in eax and cdr in ebx." (with-inline-assembly (:returns :multiple-values) - (:pushl :edx) (:xchgl :eax :ecx) (:locally (:movl (:edi (:edi-offset malloc-buffer)) :eax)) (:movl (:eax 4) :edx) @@ -483,24 +482,21 @@ (:movl :ecx (:eax)) (:movl :ebx (:eax 4)) (:incl :eax) - (:popl :edx) (:ret))) (define-primitive-function ensure-heap-cons-variable () "Call with lended variable (a cons) in EAX. Preserves EDX." (with-inline-assembly (:returns :multiple-values) - ;; (:movl (:ebp :ecx) :eax) ; stack-frame variable's content into eax (:cmpl :ebp :eax) ; is cons above stack-frame? (:jge 'return-ok) (:cmpl :esp :eax) ; is cons below stack-frame? (:jl 'return-ok) ;; must migrate cell onto heap + (:pushl :edx) (:movl (:eax 3) :ebx) ; cdr (:movl (:eax -1) :eax) ; car - ;; (:pushl :ecx) (:locally (:call (:edi (:edi-offset fast-cons)))) - ;; (:popl :ecx) - ;; (:movl :eax (:ebx :ecx)) + (:popl :edx) return-ok (:ret)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
by Frode Vatvedt Fjeld 18 Mar '04

18 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18618 Modified Files: arrays.lisp Log Message: Aref tune-up. Date: Thu Mar 18 04:19:45 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.5 movitz/losp/muerte/arrays.lisp:1.6 --- movitz/losp/muerte/arrays.lisp:1.5 Mon Mar 8 09:33:52 2004 +++ movitz/losp/muerte/arrays.lisp Thu Mar 18 04:19:45 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sun Feb 11 23:14:04 2001 ;;;; -;;;; $Id: arrays.lisp,v 1.5 2004/03/08 14:33:52 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.6 2004/03/18 09:19:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -230,13 +230,13 @@ not-u8 (:cmpl #.(movitz:vector-type-tag :u16) :ecx) - (:je 'not-u16) + (:jne 'not-u16) (:movzxw (:eax (:ebx 2) 2) :eax) ; u16 (:jmp 'done) not-u16 (:cmpl #.(movitz:vector-type-tag :u32) :ecx) - (:je 'not-u32) + (:jne 'not-u32) (:movl (:eax (:ebx 4) 2) :ecx) ; u32 (:cmpl #.movitz::+movitz-most-positive-fixnum+ :ecx) (:jg '(:sub-program (:overflowing-u32)

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by Frode Vatvedt Fjeld 18 Mar '04

18 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv24919 Modified Files: storage-types.lisp Log Message: Added function vector-type-tag. Date: Thu Mar 18 04:16:38 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.9 movitz/storage-types.lisp:1.10 --- movitz/storage-types.lisp:1.9 Fri Feb 13 10:25:34 2004 +++ movitz/storage-types.lisp Thu Mar 18 04:16:38 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.9 2004/02/13 15:25:34 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.10 2004/03/18 09:16:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -362,6 +362,11 @@ :initarg :symbolic-data :accessor movitz-vector-symbolic-data)) (:slot-align type -2)) + +(defun vector-type-tag (element-type) + (dpb (enum-value 'movitz-vector-element-type element-type) + (byte 8 8) + (enum-value 'other-type-byte :vector))) (define-binary-class movitz-new-vector (movitz-heap-object-other) ((length

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by Frode Vatvedt Fjeld 17 Mar '04

17 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv6535 Modified Files: packages.lisp Log Message: Various symbols added and removed. Date: Wed Mar 17 11:36:36 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.6 movitz/packages.lisp:1.7 --- movitz/packages.lisp:1.6 Thu Feb 26 06:31:31 2004 +++ movitz/packages.lisp Wed Mar 17 11:36:36 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Nov 15 21:39:55 2003 ;;;; -;;;; $Id: packages.lisp,v 1.6 2004/02/26 11:31:31 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.7 2004/03/17 16:36:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1118,7 +1118,7 @@ #:package-object-use-list #:package-object-internal-symbols #:package-object-external-symbols - + vector-element-type vector-element-size with-subvector-accessor @@ -1268,6 +1268,8 @@ #:code-vector%1op #:code-vector%2op #:code-vector%3op + #:code-vector-word + #:lu32 #:+movitz-fixnum-factor+ #:+movitz-fixnum-shift+ @@ -1280,6 +1282,7 @@ #:movitz-vector-num-elements #:movitz-vector-element-type #:movitz-vector-symbolic-data + #:vector-type-tag #:movitz-symbol #:movitz-string

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs