February 2004 - movitz-cvs@common-lisp.net

[movitz-cvs] CVS update: ia-x86/assemble.lisp
by Frode Vatvedt Fjeld 09 Feb '04

09 Feb '04

Update of /project/movitz/cvsroot/ia-x86 In directory common-lisp.net:/tmp/cvs-serv26689 Removed Files: assemble.lisp Log Message: Removed this dead, empty file from CVS. Date: Mon Feb 9 18:57:27 2004 Author: ffjeld

1 0

[movitz-cvs] CVS update: ia-x86/operands.lisp
by Frode Vatvedt Fjeld 09 Feb '04

09 Feb '04

Update of /project/movitz/cvsroot/ia-x86 In directory common-lisp.net:/tmp/cvs-serv3751 Modified Files: operands.lisp Log Message: Reformatted some defclass forms, and removed some type-declarations that are more likely to break things than being helpful in any way. Date: Mon Feb 9 18:46:23 2004 Author: ffjeld Index: ia-x86/operands.lisp diff -u ia-x86/operands.lisp:1.2 ia-x86/operands.lisp:1.3 --- ia-x86/operands.lisp:1.2 Fri Jan 16 06:54:14 2004 +++ ia-x86/operands.lisp Mon Feb 9 18:46:23 2004 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 20012000, 2002-2003, +;;;; Copyright (C) 20012000, 2002-2004, ;;;; Department of Computer Science, University of Tromso, Norway ;;;; ;;;; Filename: operands.lisp @@ -9,7 +9,7 @@ ;;;; Created at: Wed Feb 16 14:02:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: operands.lisp,v 1.2 2004/01/16 11:54:14 ffjeld Exp $ +;;;; $Id: operands.lisp,v 1.3 2004/02/09 23:46:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -186,9 +186,10 @@ (setf (cdr x) x))))) ; make circular one-list. (defclass operand-number (abstract-operand) - ((number :type integer - :initarg number - :reader operand-number))) + ((number + :type integer + :initarg number + :reader operand-number))) (defmethod operand-listform ((operand operand-number)) (list* 'quote @@ -207,9 +208,9 @@ ;;; ---------------------------------------------------------------- (defclass operand-immediate (concrete-operand) - ((value :type (unsigned-byte 32) - :initarg value - :accessor operand-value))) + ((value + :initarg value + :accessor operand-value))) (defmethod operand-listform ((obj operand-immediate)) (operand-value obj)) @@ -280,7 +281,6 @@ (defclass operand-rel-pointer (operand-memory) ((offset - :type (signed-byte 32) :accessor operand-offset :initarg offset)))

1 0

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

09 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv10272 Modified Files: packages.lisp Log Message: Added some package-object symbols to the muerte package. Date: Mon Feb 9 18:42:18 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.3 movitz/packages.lisp:1.4 --- movitz/packages.lisp:1.3 Sun Feb 8 18:05:59 2004 +++ movitz/packages.lisp Mon Feb 9 18:42:18 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.3 2004/02/08 23:05:59 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.4 2004/02/09 23:42:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1114,6 +1114,10 @@ *error-no-condition-for-debugger* formatted-error + + #:package-object-use-list + #:package-object-internal-symbols + #:package-object-external-symbols vector-element-type vector-element-size

1 0

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

09 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv30535 Modified Files: image.lisp Log Message: Fixed the dumping of package objects so as to not rely on the ability to access defstruct objects with slot-value. This to accommodate CMUCL. Date: Mon Feb 9 18:41:13 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.9 movitz/image.lisp:1.10 --- movitz/image.lisp:1.9 Thu Feb 5 09:46:13 2004 +++ movitz/image.lisp Mon Feb 9 18:41:13 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.9 2004/02/05 14:46:13 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.10 2004/02/09 23:41:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1005,16 +1005,15 @@ :name package-name :shadowing-symbols-list (package-shadowing-symbols lisp-package) :external-symbols (make-hash-table :test #'equal) - :internal-symbols (make-hash-table :test #'equal)))) + :internal-symbols (make-hash-table :test #'equal) + :use-list (mapcar #'(lambda (up) + (ensure-package (movitz-package-name (package-name up)) up)) + (package-use-list lisp-package))))) (setf (gethash package-name packages-hash) p) - (setf (slot-value p 'muerte::use-list) - (mapcar #'(lambda (up) - (ensure-package (movitz-package-name (package-name up)) up)) - (package-use-list lisp-package))) p))))) - (let ((cl-package (ensure-package (symbol-name :common-lisp) - (find-package :muerte.common-lisp)))) - (setf (gethash "NIL" (slot-value cl-package 'muerte::external-symbols)) + (let ((movitz-cl-package (ensure-package (symbol-name :common-lisp) + (find-package :muerte.common-lisp)))) + (setf (gethash "NIL" (funcall 'muerte:package-object-external-symbols movitz-cl-package)) nil)) (loop for symbol being the hash-key of (image-oblist *image*) as lisp-package = (symbol-package symbol) @@ -1027,12 +1026,12 @@ (ecase status (:internal (setf (gethash (symbol-name symbol) - (slot-value movitz-package 'muerte::internal-symbols)) + (funcall 'muerte:package-object-internal-symbols movitz-package)) symbol)) (:external ;; (warn "putting external ~S in ~S" symbol package-name) (setf (gethash (symbol-name symbol) - (slot-value movitz-package 'muerte::external-symbols)) + (funcall 'muerte:package-object-external-symbols movitz-package)) symbol)) (:inherited (warn "inherited symbol: ~S" symbol))))))

1 0

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

08 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3749 Modified Files: special-operators.lisp Log Message: Provide name for gensym of setf-expanders. Date: Sun Feb 8 18:27:56 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.6 movitz/special-operators.lisp:1.7 --- movitz/special-operators.lisp:1.6 Wed Feb 4 11:01:26 2004 +++ movitz/special-operators.lisp Sun Feb 8 18:27: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.6 2004/02/04 16:01:26 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.7 2004/02/08 23:27:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -359,7 +359,7 @@ (values-list (translate-program (multiple-value-list (block ,access-fn ,@cl-body)) :cl :muerte.cl))))))) - (movitz-macro-expander-make-function expander :type :setf))))))) + (movitz-macro-expander-make-function expander :type :setf :name access-fn))))))) (compiler-values ())) (define-special-operator muerte::defmacro-compile-time (&form form) @@ -977,12 +977,15 @@ :form term-form) (assert term2-type) (let ((term2-type (type-specifier-primary term2-type))) +;;; (warn "t2-type: ~S, t2-ret: ~S, rm: ~S" +;;; term2-type term2-returns result-mode) (case term2-returns (:untagged-fixnum-eax (case result-mode (:untagged-fixnum-eax (compiler-values () :returns :untagged-fixnum-eax + :type 'integer :functional-p term2-functional-p :modifies term2-modifies :code (append term2-code @@ -1009,20 +1012,23 @@ :returns add-register :functional-p term2-functional-p :modifies term2-modifies + :type 'integer :code (append new-load-term-code - (unless nil #+ignore (subtypep (translate-program term2-type :muerte.cl :cl) - `(integer ,+movitz-most-negative-fixnum+ - ,+movitz-most-positive-fixnum+)) + (unless nil + #+ignore (subtypep (translate-program term2-type :muerte.cl :cl) + `(integer ,+movitz-most-negative-fixnum+ + ,+movitz-most-positive-fixnum+)) `((:testb ,+movitz-fixnum-zmask+ ,(register32-to-low8 add-register)) (:jnz '(:sub-program (,label) (:int 107) (:jmp (:pc+ -4)))))) `((:addl ,(* constant-term +movitz-fixnum-factor+) ,add-register)) - (unless nil #+ignore (subtypep (translate-program term2-type :muerte.cl :cl) - `(integer ,(+ +movitz-most-negative-fixnum+ - constant-term) - ,(+ +movitz-most-positive-fixnum+ - constant-term))) + (unless nil + #+ignore (subtypep (translate-program term2-type :muerte.cl :cl) + `(integer ,(+ +movitz-most-negative-fixnum+ + constant-term) + ,(+ +movitz-most-positive-fixnum+ + constant-term))) '((:into))))))))))))) (cond ((and (movitz-constantp term1 env)

1 0

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

08 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv22384 Modified Files: compiler.lisp Log Message: Two things: 1. Make movitz-macro-expander-make-function work consistently (return the function's name). 2. Support the supplied-p-parameter for the optimized compilation of (x &optional (y init supplied-p)). Date: Sun Feb 8 18:24:13 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.17 movitz/compiler.lisp:1.18 --- movitz/compiler.lisp:1.17 Thu Feb 5 09:46:02 2004 +++ movitz/compiler.lisp Sun Feb 8 18:24:13 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.17 2004/02/05 14:46:02 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.18 2004/02/08 23:24:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -135,11 +135,14 @@ object) (defun movitz-macro-expander-make-function (lambda-form &key name (type :unknown)) - "Make a lambda-form that is a macro-expander into a proper function." - (if *compiler-compile-macro-expanders* - (compile (gensym (format nil "~A-expander-~@[~A-~]" type name)) - lambda-form) - (coerce lambda-form 'function))) + "Make a lambda-form that is a macro-expander into a proper function. +Gensym a name whose symbol-function is set to the macro-expander, and return that symbol." + (let ((function-name (gensym (format nil "~A-expander-~@[~A-~]" type name)))) + (if *compiler-compile-macro-expanders* + (compile function-name lambda-form) + (setf (symbol-function function-name) + (coerce lambda-form 'function))) + function-name)) (defun make-compiled-funobj (name lambda-list declarations form env top-level-p &key funobj) "Compiler entry-point for making a (lexically) top-level function." @@ -349,12 +352,12 @@ (loop for function-binding in (sub-function-binding-usage funobj) by #'cddr do (analyze-funobj (function-binding-funobj function-binding))) funobj)) - #+ignore (analyze-funobj toplevel-funobj) - #+ignore (dolist (binding bindings) - (let ((types (binding-store-type binding))) - (unless (some #'type-is-t types) - (warn "binding: ~S~% types: ~S" - binding types)))) +;;; (analyze-funobj toplevel-funobj) +;;; (dolist (binding bindings) +;;; (let ((types (binding-store-type binding))) +;;; (when (or t (notany #'type-is-t types)) +;;; (warn "binding: ~S~% types: ~S" +;;; binding types)))) toplevel-funobj))) (defun resolve-borrowed-bindings (toplevel-funobj) @@ -545,42 +548,60 @@ (optional-stack-frame-p (tree-search resolved-optional-code '(:ebp :esp :call :leave)))) (assert (not optional-stack-frame-p)) - (let* ((stack-setup-size stack-frame-size) - (function-code + (let* ((function-code (let* ((req-binding (movitz-binding (first (required-vars function-env)) function-env nil)) (req-location (cdr (assoc req-binding frame-map))) (opt-binding (movitz-binding (first (optional-vars function-env)) function-env nil)) - (opt-location (cdr (assoc opt-binding frame-map)))) + (opt-location (cdr (assoc opt-binding frame-map))) + (optp-binding (movitz-binding (optional-function-argument-supplied-p-var opt-binding) + function-env nil)) + (optp-location (cdr (assoc optp-binding frame-map))) + (stack-setup-pre 0)) (append `((:jmp (:edi ,(global-constant-offset 'trampoline-cl-dispatch-1or2)))) '(entry%1op) (unless (eql nil opt-location) resolved-optional-code) + (when optp-location + `((:movl :edi :ecx) + (:jmp 'optp-into-ecx-ok))) '(entry%2op) + (when optp-location + `((,*compiler-global-segment-prefix* + :movl (:edi ,(global-constant-offset 't-symbol)) :ecx) + optp-into-ecx-ok)) (when use-stack-frame-p +enter-stack-frame-code+) '(start-stack-frame-setup) (cond ((and (eql 1 req-location) (eql 2 opt-location)) - (decf stack-setup-size 2) + (incf stack-setup-pre 2) `((:pushl :eax) (:pushl :ebx))) ((and (eql 1 req-location) (eql nil opt-location)) - (decf stack-setup-size 1) + (incf stack-setup-pre 1) `((:pushl :eax))) ((and (member req-location '(nil :eax)) (eql 1 opt-location)) - (decf stack-setup-size 1) + (incf stack-setup-pre 1) `((:pushl :ebx))) ((and (member req-location '(nil :eax)) (member opt-location '(nil :ebx))) nil) (t (error "Can't deal with req ~S opt ~S." req-location opt-location))) - (make-stack-setup-code stack-setup-size) + (cond + ((not optp-location) + ()) + ((= optp-location (1+ stack-setup-pre)) + (incf stack-setup-pre 1) + `((:pushl :ecx))) + (t (error "Can't deal with optional-p at ~S, after (~S ~S)." + optp-location req-location opt-location))) + (make-stack-setup-code (- stack-frame-size stack-setup-pre)) resolved-code (make-compiled-function-postlude funobj function-env use-stack-frame-p)))))

1 0

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

08 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv22657 Modified Files: packages.lisp Log Message: Added some defvar names to the movitz package. Date: Sun Feb 8 18:05:59 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.2 movitz/packages.lisp:1.3 --- movitz/packages.lisp:1.2 Mon Feb 2 08:06:39 2004 +++ movitz/packages.lisp Sun Feb 8 18:05:59 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.2 2004/02/02 13:06:39 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.3 2004/02/08 23:05:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1284,7 +1284,15 @@ movitz-read-and-intern movitz-word word - + + #:*warn-function-change-p* + #:*compiler-do-optimize* + #:*compiler-use-cmov-p* + #:*compiler-auto-stack-checks-p* + #:*compiler-local-segment-prefix* + #:*compiler-global-segment-prefix* + #:*compiler-compile-eval-whens* + #:*compiler-compile-macro-expanders* ) (:import-from muerte #:translate-program

1 0

[movitz-cvs] CVS update: ia-x86/codec.lisp
by Frode Vatvedt Fjeld 08 Feb '04

08 Feb '04

Update of /project/movitz/cvsroot/ia-x86 In directory common-lisp.net:/tmp/cvs-serv19649 Modified Files: codec.lisp Log Message: Changed :type declaration of instr-opcode-numo of class instr-template, because there are indeed instructions longer than 2 bytes. Date: Sun Feb 8 17:38:35 2004 Author: ffjeld Index: ia-x86/codec.lisp diff -u ia-x86/codec.lisp:1.3 ia-x86/codec.lisp:1.4 --- ia-x86/codec.lisp:1.3 Sun Feb 8 17:35:11 2004 +++ ia-x86/codec.lisp Sun Feb 8 17:38:35 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Thu May 4 15:16:45 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: codec.lisp,v 1.3 2004/02/08 22:35:11 ffjeld Exp $ +;;;; $Id: codec.lisp,v 1.4 2004/02/08 22:38:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -124,7 +124,7 @@ :initarg immediate-numo :accessor template-instr-immediate-numo) (instr-opcode-numo - :type (integer 1 2) ; size of "opcode" field. + :type (integer 1 16) ; size of "opcode" field. :initarg opcode-numo :accessor template-instr-opcode-numo)))

1 0

[movitz-cvs] CVS update: ia-x86/codec.lisp
by Frode Vatvedt Fjeld 08 Feb '04

08 Feb '04

Update of /project/movitz/cvsroot/ia-x86 In directory common-lisp.net:/tmp/cvs-serv4832 Modified Files: codec.lisp Log Message: Changed indenting style of defclass forms. Date: Sun Feb 8 17:35:12 2004 Author: ffjeld Index: ia-x86/codec.lisp diff -u ia-x86/codec.lisp:1.2 ia-x86/codec.lisp:1.3 --- ia-x86/codec.lisp:1.2 Fri Jan 16 06:54:14 2004 +++ ia-x86/codec.lisp Sun Feb 8 17:35:11 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Thu May 4 15:16:45 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: codec.lisp,v 1.2 2004/01/16 11:54:14 ffjeld Exp $ +;;;; $Id: codec.lisp,v 1.3 2004/02/08 22:35:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -39,75 +39,94 @@ (defclass template () - ((value :type unsigned-byte - :initarg value - :accessor template-value) - (numo :type (integer 1 12) - :initarg numo - :accessor template-numo) - (priority :type integer - :initarg priority - :initform +template-default-priority+ - :accessor template-priority))) + ((value + :type unsigned-byte + :initarg value + :accessor template-value) + (numo + :type (integer 1 12) + :initarg numo + :accessor template-numo) + (priority + :type integer + :initarg priority + :initform +template-default-priority+ + :accessor template-priority))) (defclass instr-template (template) - ((mask :type signed-byte - :initarg mask - :accessor template-mask) - (not-list :type list ; list of value/masks that must *not* match. - :initform '() - :initarg not-list - :accessor template-not-list) - (cpu-mode :type (member :32-bit :16-bit :any-mode) - :initform :any-mode - :initarg cpu-mode - :accessor template-cpu-mode) - (operand-mode :type (member :32-bit :16-bit :any-mode) - :initform :any-mode - :initarg operand-mode - :accessor template-operand-mode) - (addressing-mode :type (member :32-bit :16-bit :any-mode) - :initform :any-mode - :initarg addressing-mode - :accessor template-addressing-mode) - (req-prefixes :type list ; list of prefixes required for a match - :initform '() - :initarg req-prefixes - :accessor template-req-prefixes) - (not-prefixes :type list ; list of prefixes disqualifying any match - :initform '() - :initarg not-prefixes - :accessor template-not-prefixes) - (instr-classname :initarg instr-classname - :accessor template-instr-classname) - (instr-numo :type (integer 1 16) - :initarg instr-numo - :accessor template-instr-numo) - (instr-operand-types :type list - :initarg instr-operand-types - :accessor template-instr-operand-types) - (instr-operand-classes :type list ; this template generates operands of these classes (in this order) - :initarg instr-operand-classes - :accessor template-instr-operand-classes) + ((mask + :type signed-byte + :initarg mask + :accessor template-mask) + (not-list + :type list ; list of value/masks that must *not* match. + :initform '() + :initarg not-list + :accessor template-not-list) + (cpu-mode + :type (member :32-bit :16-bit :any-mode) + :initform :any-mode + :initarg cpu-mode + :accessor template-cpu-mode) + (operand-mode + :type (member :32-bit :16-bit :any-mode) + :initform :any-mode + :initarg operand-mode + :accessor template-operand-mode) + (addressing-mode + :type (member :32-bit :16-bit :any-mode) + :initform :any-mode + :initarg addressing-mode + :accessor template-addressing-mode) + (req-prefixes + :type list ; list of prefixes required for a match + :initform '() + :initarg req-prefixes + :accessor template-req-prefixes) + (not-prefixes + :type list ; list of prefixes disqualifying any match + :initform '() + :initarg not-prefixes + :accessor template-not-prefixes) + (instr-classname + :initarg instr-classname + :accessor template-instr-classname) + (instr-numo + :type (integer 1 16) + :initarg instr-numo + :accessor template-instr-numo) + (instr-operand-types + :type list + :initarg instr-operand-types + :accessor template-instr-operand-types) + (instr-operand-classes + :type list ; this template generates operands of these classes (in this order) + :initarg instr-operand-classes + :accessor template-instr-operand-classes) (instr-operand-base-classes :type list ; caching the base-classes of instr-operand-classes :initarg instr-operand-base-classes :accessor template-instr-operand-base-classes) - (instr-modr/m-p :type boolean ; does instruction have modr/m? - :initarg modr/m-p - :accessor template-instr-modr/m-p) - (instr-sib-p :type boolean ; does instruction have SIB? - :initarg sib-p - :accessor template-instr-sib-p) - (instr-displacement-numo :type (integer 0 4) ; size of "displacement" field. - :initarg displacement-numo - :accessor template-instr-displacement-numo) - (instr-immediate-numo :type (integer 0 4) ; size of "immediate" field. - :initarg immediate-numo - :accessor template-instr-immediate-numo) - (instr-opcode-numo :type (integer 1 2) ; size of "opcode" field. - :initarg opcode-numo - :accessor template-instr-opcode-numo))) + (instr-modr/m-p + :type boolean ; does instruction have modr/m? + :initarg modr/m-p + :accessor template-instr-modr/m-p) + (instr-sib-p + :type boolean ; does instruction have SIB? + :initarg sib-p + :accessor template-instr-sib-p) + (instr-displacement-numo + :type (integer 0 4) ; size of "displacement" field. + :initarg displacement-numo + :accessor template-instr-displacement-numo) + (instr-immediate-numo + :type (integer 0 4) ; size of "immediate" field. + :initarg immediate-numo + :accessor template-instr-immediate-numo) + (instr-opcode-numo + :type (integer 1 2) ; size of "opcode" field. + :initarg opcode-numo + :accessor template-instr-opcode-numo))) (defmethod print-object ((obj instr-template) stream) (if *print-pretty* @@ -125,7 +144,8 @@ (call-next-method obj stream))) (defclass prefix-template (template) - ((value :type (unsigned-byte 8)))) + ((value + :type (unsigned-byte 8)))) (defmethod template-numo ((template prefix-template)) (values 1))

1 0

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

05 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13331 Modified Files: primitive-functions.lisp Log Message: These changes are all about making the compiler smarter about functions whose lambda-list look like (x &optional y). Most such functions become about 20 bytes shorter. More importantly, they become branch-less, reducing the CPU-cycle-cost of this abstraction essentially zero. Date: Thu Feb 5 09:46:24 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.2 movitz/losp/muerte/primitive-functions.lisp:1.3 --- movitz/losp/muerte/primitive-functions.lisp:1.2 Mon Jan 19 06:23:47 2004 +++ movitz/losp/muerte/primitive-functions.lisp Thu Feb 5 09:46:24 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.2 2004/01/19 11:23:47 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.3 2004/02/05 14:46:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -45,6 +45,19 @@ ;;; (:movb 2 :cl) (:movb 3 :cl) (:jmp (:esi -6)))) + +(define-primitive-function trampoline-cl-dispatch-1or2 () + "Jump to the entry-point designated by :cl, which must be 1 or 2." + (with-inline-assembly (:returns :nothing) + (:cmpb 1 :cl) + (:jne 'not-one) + (:jmp (:esi #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:code-vector%1op))) + not-one + (:cmpb 2 :cl) + (:jne 'not-two) + (:jmp (:esi #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:code-vector%2op))) + not-two + (:int 100))) (define-primitive-function no-code-vector () "This is the default code-vector, which never should be called."

1 0