movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS update: movitz/losp/muerte/packages.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4605 Modified Files: packages.lisp Log Message: Don't use movitz-accessor. Date: Thu Oct 21 22:50:19 2004 Author: ffjeld Index: movitz/losp/muerte/packages.lisp diff -u movitz/losp/muerte/packages.lisp:1.4 movitz/losp/muerte/packages.lisp:1.5 --- movitz/losp/muerte/packages.lisp:1.4 Sat Sep 25 17:36:16 2004 +++ movitz/losp/muerte/packages.lisp Thu Oct 21 22:50:19 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Aug 30 15:19:43 2001 ;;;; -;;;; $Id: packages.lisp,v 1.4 2004/09/25 15:36:16 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.5 2004/10/21 20:50:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -82,14 +82,14 @@ (unless status (let ((name (subseq name start end))) (map-into name key name) - (setf symbol (make-symbol name)) + (setf symbol (%create-symbol name package)) (when (eq package (find-package :keyword)) (setf (symbol-flags symbol) #.(bt:enum-value 'movitz::movitz-symbol-flags '(:constant-variable))) (setf (symbol-value symbol) symbol)))) (unless (symbol-package symbol) - (setf-movitz-accessor (symbol movitz-symbol package) package)) + (setf (memref symbol (movitz-type-slot-offset 'movitz-symbol 'package)) package)) (unless status (if (eq package (find-package :keyword)) (setf (gethash (symbol-name symbol) (package-object-external-symbols package)) symbol)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4581 Modified Files: memref.lisp Log Message: Added (setf (memref :unsigned-byte14)) Date: Thu Oct 21 22:47:27 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.35 movitz/losp/muerte/memref.lisp:1.36 --- movitz/losp/muerte/memref.lisp:1.35 Thu Oct 21 18:31:35 2004 +++ movitz/losp/muerte/memref.lisp Thu Oct 21 22:47:26 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 6 21:25:49 2001 ;;;; -;;;; $Id: memref.lisp,v 1.35 2004/10/21 16:31:35 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.36 2004/10/21 20:47:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -634,6 +634,37 @@ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) (:movb :ah (:ebx :ecx))) ,value-var))))) + (:unsigned-byte14 + (cond + ((and (movitz:movitz-constantp offset env) + (movitz:movitz-constantp index env)) + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ebx) ,value ,object) + (:andl ,(mask-field (byte 14 2) -1) :eax) + (:movw :ax (:ebx ,(+ (movitz:movitz-eval offset env) + (* 4 (movitz:movitz-eval index env))))))) + ((movitz:movitz-constantp offset env) + (let ((value-var (gensym "memref-value-"))) + `(let ((,value-var ,value)) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:ebx :ecx) ,object ,index) + (:load-lexical (:lexical-binding ,value-var) :eax) + ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2)) + `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx)) + (:andl ,(mask-field (byte 14 2) -1) :eax) + (:movw :ax (:ebx :ecx ,(movitz:movitz-eval offset env))))))) + (t (let ((value-var (gensym "memref-value-")) + (object-var (gensym "memref-object-"))) + `(let ((,value-var ,value) (,object-var ,object)) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index) + (:load-lexical (:lexical-binding ,value-var) :eax) + ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2)) + `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx)) + (:addl :ebx :ecx) ; index += offset + (:load-lexical (:lexical-binding ,object-var) :ebx) + (:andl ,(mask-field (byte 14 2) -1) :eax) + (:movl :ax (:ebx :ecx)))))))) (:lisp (let* ((localp (movitz:movitz-eval localp env)) (prefixes (if localp

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/eval.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4400 Modified Files: eval.lisp Log Message: Add eval of unwind-protect. Date: Thu Oct 21 22:45:48 2004 Author: ffjeld Index: movitz/losp/muerte/eval.lisp diff -u movitz/losp/muerte/eval.lisp:1.11 movitz/losp/muerte/eval.lisp:1.12 --- movitz/losp/muerte/eval.lisp:1.11 Tue Sep 21 15:02:57 2004 +++ movitz/losp/muerte/eval.lisp Thu Oct 21 22:45:48 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.11 2004/09/21 13:02:57 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.12 2004/10/21 20:45:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -102,6 +102,9 @@ ((throw) (throw (eval-form (second form) env) (eval-form (third form) env))) + ((unwind-protect) + (unwind-protect (eval-form (second form) env) + (eval-progn (cddr form) env))) (t (eval-funcall form env)))) (defun eval-progn (forms env)

1 0

[movitz-cvs] CVS update: movitz/special-operators-cl.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3657 Modified Files: special-operators-cl.lisp Log Message: In go, don't check if dynamic-unwind-next finds an unwind-protect or not, since there's noe sense in doing that. Date: Thu Oct 21 22:44:52 2004 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.27 movitz/special-operators-cl.lisp:1.28 --- movitz/special-operators-cl.lisp:1.27 Mon Oct 11 15:48:07 2004 +++ movitz/special-operators-cl.lisp Thu Oct 21 22:44:52 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:31:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: special-operators-cl.lisp,v 1.27 2004/10/11 13:48:07 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.28 2004/10/21 20:44:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -740,7 +740,6 @@ ;; Now, install correct jumper within tagbody as target. `((:addl ,(* 4 label-id) (:edx 8)))) (:globally (:call (:edi (:edi-offset dynamic-unwind-next)))) - (:jnc '(:sub-program () (:int 63))) ;; have next-continuation in EAX, final-continuation in EDX (:locally (:movl :edx (:edi (:edi-offset raw-scratch0)))) ; final continuation (:locally (:movl :esi (:edi (:edi-offset scratch1))))

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3638 Modified Files: storage-types.lisp Log Message: Somewhat improved support for movitz-ratio objects. Date: Thu Oct 21 22:42:51 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.42 movitz/storage-types.lisp:1.43 --- movitz/storage-types.lisp:1.42 Tue Sep 21 15:04:02 2004 +++ movitz/storage-types.lisp Thu Oct 21 22:42:51 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.42 2004/09/21 13:04:02 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.43 2004/10/21 20:42:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -73,11 +73,11 @@ :old-vector #x1a :basic-vector #x22 + :defstruct #x2a :funobj #x3a :bignum #x4a :ratio #x52 :complex #x5a - :defstruct #x2a :std-instance #x40 :run-time-context #x50 :illegal #x13 @@ -1237,6 +1237,7 @@ (assert (= (movitz-bignum-value object) lisp-object)) object) + (defmethod read-binary-record ((type-name (eql 'movitz-bignum)) stream &key) (let* ((header (call-next-method)) (x (loop for i from 0 below (movitz-bignum-length header) @@ -1280,3 +1281,14 @@ (setf (slot-value obj 'numerator) (numerator value) (slot-value obj 'denominator) (denominator value)) (call-next-method))) + + +(defmethod update-movitz-object ((object movitz-ratio) lisp-object) + (assert (= (movitz-ratio-value object) lisp-object)) + object) + +(defmethod print-object ((x movitz-ratio) stream) + (print-unreadable-object (x stream :type t) + (format stream "~D" (slot-value x 'value))) + x) +

1 0

[movitz-cvs] CVS update: movitz/special-operators.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3616 Modified Files: special-operators.lisp Log Message: Fix returned type-specifier to corret pacakge. Date: Thu Oct 21 22:41:56 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.41 movitz/special-operators.lisp:1.42 --- movitz/special-operators.lisp:1.41 Thu Oct 7 14:48:39 2004 +++ movitz/special-operators.lisp Thu Oct 21 22:41:56 2004 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.41 2004/10/07 12:48:39 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.42 2004/10/21 20:41:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -598,7 +598,7 @@ (compiler-values () :code code :returns returns - :type type + :type (translate-program type :muerte.cl :cl) :modifies modifies :functional-p (not side-effects))))))))))))

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3571 Modified Files: image.lisp Log Message: Removed dead code. Date: Thu Oct 21 22:40:32 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.71 movitz/image.lisp:1.72 --- movitz/image.lisp:1.71 Sat Sep 25 17:40:30 2004 +++ movitz/image.lisp Thu Oct 21 22:40:32 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.71 2004/09/25 15:40:30 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.72 2004/10/21 20:40:32 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1457,21 +1457,7 @@ (make-movitz-hash-table expr)) (ratio (make-instance 'movitz-ratio - :value expr) - #+ignore - (let ((slot-descriptions (gethash 'muerte.cl::ratio - (image-struct-slot-descriptions *image*) - nil))) - (unless slot-descriptions - (error "Don't know how to movitz-read ratios (yet)." expr)) - (let ((movitz-object (make-instance 'movitz-struct - :class (muerte::movitz-find-class 'muerte.cl::ratio) - :length (length slot-descriptions)))) - (setf (image-lisp-to-movitz-object *image* expr) movitz-object) - (setf (slot-value movitz-object 'slot-values) - (list (movitz-read (numerator expr)) - (movitz-read (denominator expr)))) - movitz-object))) + :value expr)) (structure-object (let ((slot-descriptions (gethash (type-of expr) (image-struct-slot-descriptions *image*)

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3533 Modified Files: compiler.lisp Log Message: Depreacated the :untagged-fixnum-eax more. It's incompatible with stack discipline. Date: Thu Oct 21 22:38:28 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.101 movitz/compiler.lisp:1.102 --- movitz/compiler.lisp:1.101 Mon Oct 11 15:44:04 2004 +++ movitz/compiler.lisp Thu Oct 21 22:38:28 2004 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.101 2004/10/11 13:44:04 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.102 2004/10/21 20:38:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -51,7 +51,7 @@ "Use this segment prefix when reading a lispval at (potentially) non-local locations.") -(defparameter *compiler-nonlocal-lispval-write-segment-prefix* '(:fs-override) +(defparameter *compiler-nonlocal-lispval-write-segment-prefix* '(:es-override) "Use this segment prefix when writing a lispval at (potentially) non-local locations.") @@ -2607,7 +2607,10 @@ (cdr instruction) (assert (not (getf jumper-sets name)) () "Duplicate jumper declaration for ~S." name) - (setf (getf jumper-sets name) set)))) + (setf (getf jumper-sets name) set))) + (t (when (listp instruction) + (dolist (binding (find-read-bindings instruction)) + (process-binding binding))))) do (let ((sub (instruction-sub-program instruction))) (when sub (process sub)))))) (process code) @@ -4801,6 +4804,7 @@ (values (append code `((:load-lexical ,returns-provided ,desired-result))) desired-result)))) + #+ignore (:untagged-fixnum-eax (case returns-provided (:untagged-fixnum-eax @@ -4977,7 +4981,8 @@ (values code returns-provided)) (:multiple-values (values code :values)) - (t (values (make-result-and-returns-glue :eax returns-provided code) + (t (values (make-result-and-returns-glue :eax returns-provided code + :type type) '(:values 1))))) ((:multiple-values :function) (case (operator returns-provided) @@ -4990,16 +4995,21 @@ (1 (values (append code '((:clc))) :multiple-values)) ((nil) (values code :multiple-values)) - (t (values (append code (make-immediate-move (first (operands returns-provided)) :ecx) '((:stc))) + (t (values (append code + (make-immediate-move (first (operands returns-provided)) :ecx) + '((:stc))) :multiple-values)))) (t (values (append (make-result-and-returns-glue :eax returns-provided - code) + code + :type type + :provider provider + :really-desired desired-result) '((:clc))) :multiple-values))))) (unless new-returns-provided (multiple-value-setq (new-code new-returns-provided glue-side-effects-p) - (case (operator returns-provided) + (ecase (operator returns-provided) (#.+boolean-modes+ (make-result-and-returns-glue desired-result :eax (make-result-and-returns-glue :eax returns-provided code @@ -5009,16 +5019,28 @@ :type type :provider provider)) (:untagged-fixnum-ecx - (case (result-mode-type desired-result) - ((:eax :single-value) - (values (append code - `((:call (:edi ,(global-constant-offset 'box-u32-ecx))))) - desired-result)) - (t (make-result-and-returns-glue desired-result :eax - (make-result-and-returns-glue :eax :untagged-fixnum-ecx code - :provider provider - :really-desired desired-result) - :provider provider)))) + (let ((fixnump (subtypep type `(integer 0 ,+movitz-most-positive-fixnum+)))) + (cond + ((and fixnump + (member (result-mode-type desired-result) '(:eax :ebx :ecx :edx))) + (values (append code + `((:leal ((:ecx ,+movitz-fixnum-factor+)) + ,(result-mode-type desired-result)))) + desired-result)) + ((and (not fixnump) + (member (result-mode-type desired-result) '(:eax :single-value))) + (values (append code + `((:call (:edi ,(global-constant-offset 'box-u32-ecx))))) + desired-result)) + (t (make-result-and-returns-glue + desired-result :eax + (make-result-and-returns-glue :eax :untagged-fixnum-ecx code + :provider provider + :really-desired desired-result + :type type) + :provider provider + :type type))))) + #+ignore (:untagged-fixnum-eax (make-result-and-returns-glue desired-result :eax (make-result-and-returns-glue :eax :untagged-fixnum-eax code @@ -5542,7 +5564,7 @@ (:lexical-binding result-mode) ((:ebx :ecx :edx :esi :push - :untagged-fixnum-eax + ;; :untagged-fixnum-eax :untagged-fixnum-ecx :boolean-branch-on-true :boolean-branch-on-false)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/symbols.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3487 Modified Files: symbols.lisp Log Message: Improve accessors to observe *compiler-nonlocal-lispval-read/write-segment-prefix* more. Also don't use the movitz-accessor etc. macros anymore, use memref and movitz-type-slot-offset instead. Date: Thu Oct 21 22:34:11 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.21 movitz/losp/muerte/symbols.lisp:1.22 --- movitz/losp/muerte/symbols.lisp:1.21 Tue Oct 12 16:45:16 2004 +++ movitz/losp/muerte/symbols.lisp Thu Oct 21 22:34:11 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.21 2004/10/12 14:45:16 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.22 2004/10/21 20:34:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -95,12 +95,12 @@ (defun %unbounded-symbol-function (symbol) (check-type symbol symbol) (memref symbol (movitz-type-slot-offset 'movitz-symbol 'function-value))) - ;; (movitz-accessor symbol movitz-symbol function-value)) (defun (setf symbol-function) (value symbol) (check-type symbol symbol) (check-type value compiled-function) - (setf-movitz-accessor (symbol movitz-symbol function-value) value)) + (setf (memref symbol (movitz-type-slot-offset 'movitz-symbol 'function-value)) + value)) (defun symbol-name (symbol) (get-symbol-slot symbol name string))

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3470 Modified Files: primitive-functions.lisp Log Message: Improve accessors to observe *compiler-nonlocal-lispval-read/write-segment-prefix* more. Also don't use the movitz-accessor etc. macros anymore, use memref and movitz-type-slot-offset instead. Date: Thu Oct 21 22:34:09 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.46 movitz/losp/muerte/primitive-functions.lisp:1.47 --- movitz/losp/muerte/primitive-functions.lisp:1.46 Thu Oct 7 14:44:17 2004 +++ movitz/losp/muerte/primitive-functions.lisp Thu Oct 21 22:34:09 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.46 2004/10/07 12:44:17 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.47 2004/10/21 20:34:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -306,7 +306,8 @@ (:movl :ebx (:ecx 8)) ; Store VALUE in binding. (:ret) no-binding - (:movl :ebx (:eax #.(bt:slot-offset 'movitz::movitz-symbol 'movitz::value))) + (#.movitz::*compiler-nonlocal-lispval-write-segment-prefix* + :movl :ebx (:eax (:offset movitz-symbol value))) (:ret))) (define-primitive-function keyword-search () @@ -595,9 +596,9 @@ (ratio (find-class 'ratio)) (std-instance - (movitz-accessor object movitz-std-instance class)) + (memref object (movitz-type-slot-offset 'movitz-std-instance 'class))) (standard-gf-instance - (movitz-accessor object movitz-funobj-standard-gf standard-gf-class)) + (memref object (movitz-type-slot-offset 'movitz-funobj-standard-gf 'standard-gf-class))) (string (find-class 'string)) (bit-vector

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