movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS movitz
by ffjeld 18 Jan '08

18 Jan '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv18702 Modified Files: asm-x86.lisp Log Message: More instructions. --- /project/movitz/cvsroot/movitz/asm-x86.lisp 2008/01/03 10:34:18 1.5 +++ /project/movitz/cvsroot/movitz/asm-x86.lisp 2008/01/18 21:37:41 1.6 @@ -6,7 +6,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: asm-x86.lisp,v 1.5 2008/01/03 10:34:18 ffjeld Exp $ +;;;; $Id: asm-x86.lisp,v 1.6 2008/01/18 21:37:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -102,7 +102,9 @@ prefixes)) (append (mapcar #'prefix-lookup (reverse prefixes)) (rex-encode rexes :rm rm) - (when (< 8(integer-length opcode)) + (when (< 16 (integer-length opcode)) + (list (ldb (byte 8 16) opcode))) + (when (< 8(integer-length opcode)) (list (ldb (byte 8 8) opcode))) (list (ldb (byte 8 0) opcode)) (when (or mod reg rm) @@ -479,7 +481,8 @@ ((and (not reg2) register-index (= 1 reg-scale) - (zerop offset)) + (and (zerop offset) + (not (= register-index #b101)))) (encoded-values :mod #b00 :rm register-index :address-size address-size)) @@ -803,7 +806,7 @@ ;;;;;;;;;;; BOUND, BSF, BSR, BSWAP -(define-operator* (:16 :boundw :32 :boundl) (bounds reg) +(define-operator* (:16 :boundw :32 :bound) (bounds reg) (reg-modrm reg bounds #x62)) (define-operator* (:16 :bsfw :32 :bsfl :64 :bsfr) (src dst) @@ -954,56 +957,6 @@ (reg-modrm dst src #x3b) (reg-modrm src dst #x39)) -;;;;;;;;;;; MOV - -(define-operator/8 :movb (src dst) - (when (eq src :al) - (moffset #xa2 dst (uint 8))) - (when (eq dst :al) - (moffset #xa0 src (uint 8))) - (opcode-reg-imm #xb0 dst src (xint 8)) - (imm-modrm src dst #xc6 0 (xint 8)) - (reg-modrm dst src #x8a) - (reg-modrm src dst #x88)) - -(define-operator/16 :movw (src dst) - (when (eq src :ax) - (moffset #xa3 dst (uint 16))) - (when (eq dst :ax) - (moffset #xa0 src (uint 16))) - (opcode-reg-imm #xb8 dst src (xint 16)) - (imm-modrm src dst #xc7 0 (xint 16)) - (sreg-modrm src dst #x8c) - (sreg-modrm dst src #x8e) - (reg-modrm dst src #x8b) - (reg-modrm src dst #x89)) - -(define-operator/32 :movl (src dst) - (when (eq src :eax) - (moffset #xa3 dst (uint 32))) - (when (eq dst :eax) - (moffset #xa0 src (uint 32))) - (opcode-reg-imm #xb8 dst src (xint 32)) - (imm-modrm src dst #xc7 0 (xint 32)) - (reg-modrm dst src #x8b) - (reg-modrm src dst #x89)) - -;;;;;;;;;;; POP - -(define-operator* (:16 :popw :32 :popl) (dst) - (case dst - (:ds (yield :opcode #x1f)) - (:es (yield :opcode #x07)) - (:ss (yield :opcode #x17)) - (:fs (yield :opcode #x0fa1)) - (:gs (yield :opcode #x0fa9))) - (opcode-reg #x58 dst) - (modrm dst #x8f 0)) - -(define-operator/64* :popr (dst) - (opcode-reg #x58 dst) - (modrm dst #x8f 0)) - ;;;;;;;;;;; CMPXCHG (define-operator/8 :cmpxchgb (cmp-reg cmp-modrm al-dst) @@ -1206,6 +1159,11 @@ (define-jcc :jpo #x7b) (define-jcc :js #x78) (define-jcc :jz #x74) + +(define-operator* (:16 :jcxz :32 :jecxz :64 :jrcxz) (dst) + (pc-rel #xe3 dst (sint 8) + :operand-size operator-mode + :rex default-rex)) ;;;;;;;;;;; JMP @@ -1242,6 +1200,131 @@ (define-operator* (:16 :lidtw :32 :lidtl :64 :lidtr) (addr) (modrm addr #x0f01 3)) +;;;;;;;;;;; LFENCE + +(define-operator :lfence () + (opcode #x0faee8)) + +;;;;;;;;;;; LOOP, LOOPE, LOOPNE + +(define-operator :loop (dst) + (pc-rel #xe2 dst (sint 8))) + +(define-operator :loope (dst) + (pc-rel #xe1 dst (sint 8))) + +(define-operator :loopne (dst) + (pc-rel #xe0 dst (sint 8))) + +;;;;;;;;;;; MOV + +(define-operator/8 :movb (src dst) + (when (eq src :al) + (moffset #xa2 dst (uint 8))) + (when (eq dst :al) + (moffset #xa0 src (uint 8))) + (opcode-reg-imm #xb0 dst src (xint 8)) + (imm-modrm src dst #xc6 0 (xint 8)) + (reg-modrm dst src #x8a) + (reg-modrm src dst #x88)) + +(define-operator/16 :movw (src dst) + (when (eq src :ax) + (moffset #xa3 dst (uint 16))) + (when (eq dst :ax) + (moffset #xa0 src (uint 16))) + (opcode-reg-imm #xb8 dst src (xint 16)) + (imm-modrm src dst #xc7 0 (xint 16)) + (sreg-modrm src dst #x8c) + (sreg-modrm dst src #x8e) + (reg-modrm dst src #x8b) + (reg-modrm src dst #x89)) + +(define-operator/32 :movl (src dst) + (when (eq src :eax) + (moffset #xa3 dst (uint 32))) + (when (eq dst :eax) + (moffset #xa0 src (uint 32))) + (opcode-reg-imm #xb8 dst src (xint 32)) + (imm-modrm src dst #xc7 0 (xint 32)) + (reg-modrm dst src #x8b) + (reg-modrm src dst #x89)) + +;;;;;;;;;;; MOVSX + +(define-operator* (:32 :movsxb) (src dst) + (reg-modrm dst src #x0fbe)) + +(define-operator* (:32 :movsxw) (src dst) + (reg-modrm dst src #x0fbf)) + +;;;;;;;;;;; MOVZX + +(define-operator* (:32 :movzxb) (src dst) + (reg-modrm dst src #x0fb6)) + +(define-operator* (:32 :movzxw) (src dst) + (reg-modrm dst src #x0fb7)) + +;;;;;;;;;;; OR + +(define-operator/8 :orb (src dst) + (when (eq dst :al) + (imm src #x0c (xint 8))) + (imm-modrm src dst #x80 1 (xint 8)) + (reg-modrm dst src #x0a) + (reg-modrm src dst #x08)) + +(define-operator* (:16 :orw :32 :orl :64 :orr) (src dst) + (imm-modrm src dst #x83 1 (sint 8)) + (when (eq dst :ax-eax-rax) + (imm src #x0d :int-16-32-64)) + (imm-modrm src dst #x81 1 :int-16-32-64) + (reg-modrm dst src #x0b) + (reg-modrm src dst #x09)) + +;;;;;;;;;;; OUT + +(define-operator/8 :outb (src port) + (when (eq :al src) + (typecase port + ((eql :dx) + (opcode #xee)) + ((uint 8) + (imm port #xe6 (uint 8)))))) + +(define-operator/16 :outw (src port) + (when (eq :ax src) + (typecase port + ((eql :dx) + (opcode #xef)) + ((uint 8) + (imm port #xe7 (uint 8)))))) + +(define-operator/32 :outl (src port) + (when (eq :eax src) + (typecase port + ((eql :dx) + (opcode #xef)) + ((uint 8) + (imm port #xe7 (uint 8)))))) + +;;;;;;;;;;; POP + +(define-operator* (:16 :popw :32 :popl) (dst) + (case dst + (:ds (yield :opcode #x1f)) + (:es (yield :opcode #x07)) + (:ss (yield :opcode #x17)) + (:fs (yield :opcode #x0fa1)) + (:gs (yield :opcode #x0fa9))) + (opcode-reg #x58 dst) + (modrm dst #x8f 0)) + +(define-operator/64* :popr (dst) + (opcode-reg #x58 dst) + (modrm dst #x8f 0)) + ;;;;;;;;;;; PUSH (define-operator* (:16 :pushw :32 :pushl) (src) @@ -1268,3 +1351,106 @@ (define-operator :ret () (opcode #xc3)) + +;;;;;;;;;;; SAR + +(define-operator/8 :sarb (count dst) + (case count + (1 (modrm dst #xd0 7)) + (:cl (modrm dst #xd2 7))) + (imm-modrm count dst #xc0 7 (uint 8))) + +(define-operator* (:16 :sarw :32 :sarl :64 :sarr) (count dst) + (case count + (1 (modrm dst #xd1 7)) + (:cl (modrm dst #xd3 7))) + (imm-modrm count dst #xc1 7 (uint 8))) + +;;;;;;;;;;; SHL + +(define-operator/8 :shlb (count dst) + (case count + (1 (modrm dst #xd0 4)) + (:cl (modrm dst #xd2 4))) + (imm-modrm count dst #xc0 4 (uint 8))) + +(define-operator* (:16 :shlw :32 :shll :64 :shlr) (count dst) + (case count + (1 (modrm dst #xd1 4)) + (:cl (modrm dst #xd3 4))) + (imm-modrm count dst #xc1 4 (uint 8))) + +;;;;;;;;;;; SHR + +(define-operator/8 :shrb (count dst) + (case count + (1 (modrm dst #xd0 5)) + (:cl (modrm dst #xd2 5))) + (imm-modrm count dst #xc0 5 (uint 8))) + +(define-operator* (:16 :shrw :32 :shrl :64 :shrr) (count dst) + (case count + (1 (modrm dst #xd1 5)) + (:cl (modrm dst #xd3 5))) + (imm-modrm count dst #xc1 5 (uint 8))) + +;;;;;;;;;;; STC, STD, STI + +(define-operator :stc () + (opcode #xf9)) + +(define-operator :std () + (opcode #xfd)) + +(define-operator :sti () + (opcode #xfb)) + +;;;;;;;;;;; SUB + +(define-operator/8 :subb (subtrahend dst) + (when (eq dst :al) + (imm subtrahend #x2c (xint 8))) + (imm-modrm subtrahend dst #x80 5 (xint 8)) + (reg-modrm dst subtrahend #x2a) + (reg-modrm subtrahend dst #x28)) + +(define-operator* (:16 :subw :32 :subl :64 :subr) (subtrahend dst) + (imm-modrm subtrahend dst #x83 5 (sint 8)) + (when (eq dst :ax-eax-rax) + (imm subtrahend #x2d :int-16-32-64)) + (imm-modrm subtrahend dst #x81 5 :int-16-32-64) + (reg-modrm dst subtrahend #x2b) + (reg-modrm subtrahend dst #x29)) + +;;;;;;;;;;; TEST + +(define-operator/8 :testb (mask dst) + (when (eq dst :al) + (imm mask #xa8 (xint 8))) + (imm-modrm mask dst #xf6 0 (xint 8)) + (reg-modrm mask dst #x84)) + +(define-operator* (:16 :testw :32 :testl :64 :testr) (mask dst) + (when (eq dst :ax-eax-rax) + (imm mask #xa9 :int-16-32-64)) + (imm-modrm mask dst #xf7 0 :int-16-32-64) + (reg-modrm mask dst #x85)) + + +;;;;;;;;;;; XOR + + +(define-operator/8 :xorb (src dst) + (when (eq dst :al) + (imm src #x34 (xint 8))) + (imm-modrm src dst #x80 6 (xint 8)) + (reg-modrm dst src #x32) + (reg-modrm src dst #x30)) + +(define-operator* (:16 :xorw :32 :xorl :64 :xorr) (src dst) + (imm-modrm src dst #x83 6 (sint 8)) + (when (eq dst :ax-eax-rax) + (imm src #x35 :int-16-32-64)) + (imm-modrm src dst #x81 6 :int-16-32-64) + (reg-modrm dst src #x33) + (reg-modrm src dst #x31))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 17 Jan '08

17 Jan '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv24499 Modified Files: memref.lisp Log Message: Add/improve support for physicalp for memref and (setf memref). --- /project/movitz/cvsroot/movitz/losp/muerte/memref.lisp 2008/01/15 23:01:09 1.51 +++ /project/movitz/cvsroot/movitz/losp/muerte/memref.lisp 2008/01/17 20:20:33 1.52 @@ -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.51 2008/01/15 23:01:09 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.52 2008/01/17 20:20:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -74,8 +74,11 @@ offset constant-offset index constant-index) (let ((type (movitz:movitz-eval type env)) - (physicalp (movitz:movitz-eval physicalp env))) - (when (and physicalp (not (eq type :unsigned-byte32))) + (physicalp (movitz:movitz-eval physicalp env)) + (prefixes (if (not physicalp) + () + movitz:*compiler-physical-segment-prefix*))) + (when (and physicalp (member type '(:lisp :code-vector))) (warn "(memref physicalp) unsupported for type ~S." type)) (case type (:unsigned-byte8 @@ -83,7 +86,7 @@ ((and (eql 0 offset) (eql 0 index)) `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8)) (:compile-form (:result-mode :eax) ,object) - (:movzxb (:eax ,(offset-by 1)) :ecx))) + (,prefixes :movzxb (:eax ,(offset-by 1)) :ecx))) ((eql 0 index) (let ((object-var (gensym "memref-object-")) (offset-var (gensym "memref-offset-"))) @@ -93,12 +96,11 @@ :type (unsigned-byte 8)) (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object-var ,offset-var) ;; (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) - (:movzxb (:eax :ecx ,(offset-by 1)) :ecx) - )))) + (,prefixes :movzxb (:eax :ecx ,(offset-by 1)) :ecx))))) ((eql 0 offset) `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8)) (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object ,index) - (:movzxb (:eax :ecx ,(offset-by 1)) :ecx))) + (,prefixes :movzxb (:eax :ecx ,(offset-by 1)) :ecx))) (t (let ((object-var (gensym "memref-object-"))) `(let ((,object-var ,object)) (with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8)) @@ -106,7 +108,7 @@ (:load-lexical (:lexical-binding ,object-var) :eax) (:addl :ebx :ecx) ; index += offset (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) - (:movzxb (:eax :ecx ,(offset-by 1)) :ecx))))))) + (,prefixes :movzxb (:eax :ecx ,(offset-by 1)) :ecx))))))) (:unsigned-byte16 (let* ((endian (ecase (movitz:movitz-eval endian env) ((:host :little) :little) @@ -119,7 +121,7 @@ `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 16)) (:compile-form (:result-mode :eax) ,object) - (:movzxw (:eax ,(offset-by 2)) :ecx) + (,prefixes :movzxw (:eax ,(offset-by 2)) :ecx) ,@endian-fix-ecx)) ((eql 0 index) (let ((object-var (gensym "memref-object-")) @@ -130,7 +132,7 @@ :type (unsigned-byte 16)) (:compile-two-forms (:eax :ecx) ,object-var ,offset-var) (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) - (:movzxw (:eax :ecx ,(offset-by 2)) :ecx) + (,prefixes :movzxw (:eax :ecx ,(offset-by 2)) :ecx) ,@endian-fix-ecx)))) ((eql 0 offset) (let ((object-var (gensym "memref-object-")) @@ -141,7 +143,7 @@ :type (unsigned-byte 16)) (:compile-two-forms (:eax :ecx) ,object-var ,index-var) (:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx) - (:movzxw (:eax :ecx ,(offset-by 2)) :ecx) + (,prefixes :movzxw (:eax :ecx ,(offset-by 2)) :ecx) ,@endian-fix-ecx)))) (t (let ((object-var (gensym "memref-object-")) (offset-var (gensym "memref-offset-")) @@ -155,14 +157,14 @@ (:leal (:ecx (:ebx 2)) :ecx) (:load-lexical (:lexical-binding ,object-var) :eax) (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) - (:movzxw (:eax :ecx ,(offset-by 2)) :ecx) + (,prefixes :movzxw (:eax :ecx ,(offset-by 2)) :ecx) ,@endian-fix-ecx))))))) (:unsigned-byte14 (cond ((and (eq 0 offset) (eq 0 index)) `(with-inline-assembly (:returns :ecx :type (unsigned-byte 14)) (:compile-form (:result-mode :eax) ,object) - (:movzxw (:eax ,(offset-by 2)) :ecx) + (,prefixes :movzxw (:eax ,(offset-by 2)) :ecx) (:testb ,movitz:+movitz-fixnum-zmask+ :cl) (:jnz '(:sub-program () (:int 63))))) ((eq 0 offset) @@ -173,7 +175,7 @@ (with-inline-assembly (:returns :ecx) (:compile-two-forms (:eax :ecx) ,object-var ,index-var) (:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx) - (:movzxw (:eax :ecx ,(offset-by 2)) :ecx) + (,prefixes :movzxw (:eax :ecx ,(offset-by 2)) :ecx) (:testb ,movitz:+movitz-fixnum-zmask+ :cl) (:jnz '(:sub-program () (:int 63))))))) (t (let ((object-var (gensym "memref-object-")) @@ -187,7 +189,7 @@ (:leal (:ecx (:ebx 2)) :ecx) (:load-lexical (:lexical-binding ,object-var) :eax) (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) - (:movzxw (:eax :ecx ,(offset-by 2)) :ecx) + (,prefixes :movzxw (:eax :ecx ,(offset-by 2)) :ecx) (:testb ,movitz:+movitz-fixnum-shift+ :cl) (:jnz '(:sub-program () (:int 63))))))))) (:unsigned-byte29+3 @@ -200,7 +202,7 @@ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) (:addl :ebx :ecx) (:popl :eax) ; object - (:movl (:eax :ecx ,(offset-by 4)) :ecx) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx) (:leal ((:ecx 4)) :ebx) (:shrl 1 :ecx) (:andl #b11100 :ebx) @@ -222,12 +224,12 @@ ((and (eq 0 offset) (eq 0 index)) `(with-inline-assembly (:returns :multiple-values) (:compile-form (:result-mode :eax) ,object) - (:movl (:eax ,(offset-by 4)) :ecx) + (,prefixes :movl (:eax ,(offset-by 4)) :ecx) ,@fix-ecx)) ((eq 0 offset) `(with-inline-assembly (:returns :multiple-values) (:compile-two-forms (:eax :ecx) ,object ,index) - (:movl (:eax :ecx ,(offset-by 4)) :ecx) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx) ,@fix-ecx)) (t (let ((object-var (gensym "memref-object-"))) `(let ((,object-var ,object)) @@ -261,7 +263,7 @@ (:xorl :eax :eax) (:movb ,(movitz:tag :character) :al) (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale index - (:movb (:ebx :ecx ,(offset-by 1)) :ah))) + (,prefixes :movb (:ebx :ecx ,(offset-by 1)) :ah))) (t (let ((object-var (gensym "memref-object-"))) `(let ((,object-var ,object)) (with-inline-assembly (:returns :eax) @@ -271,19 +273,19 @@ (:movb ,(movitz:tag :character) :al) (:load-lexical (:lexical-binding ,object-var) :ebx) (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale offset+index - (:movb (:ebx :ecx ,(offset-by 1)) :ah))))))) + (,prefixes :movb (:ebx :ecx ,(offset-by 1)) :ah))))))) (:location (assert (= 4 movitz::+movitz-fixnum-factor+)) (cond ((and (eq 0 offset) (eq 0 index)) `(with-inline-assembly (:returns :ecx :type (signed-byte 30)) (:compile-form (:result-mode :eax) ,object) - (:movl (:eax ,(offset-by 4)) :ecx) + (,prefixes :movl (:eax ,(offset-by 4)) :ecx) (:andl -4 :ecx))) ((eq 0 offset) `(with-inline-assembly (:returns :ecx :type (signed-byte 30)) (:compile-two-forms (:eax :ecx) ,object ,index) - (:movl (:eax :ecx ,(offset-by 4)) :ecx) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx) (:andl -4 :ecx))) (t (let ((object-var (gensym "memref-object-"))) `(let ((,object-var ,object)) @@ -292,7 +294,7 @@ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) (:load-lexical (:lexical-binding ,object-var) :eax) (:addl :ebx :ecx) - (:movl (:eax :ecx ,(offset-by 4)) :ecx) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx) (:andl -4 :ecx))))))) (:tag (assert (= 4 movitz::+movitz-fixnum-factor+)) @@ -300,12 +302,12 @@ ((and (eq 0 offset) (eq 0 index)) `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 3)) (:compile-form (:result-mode :eax) ,object) - (:movl (:eax ,(offset-by 4)) :ecx) + (,prefixes :movl (:eax ,(offset-by 4)) :ecx) (:andl 7 :ecx))) ((eq 0 offset) `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 3)) (:compile-two-forms (:eax :ecx) ,object ,index) - (:movl (:eax :ecx ,(offset-by 4)) :ecx) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx) (:andl 7 :ecx))) (t (let ((object-var (gensym "memref-object-"))) `(let ((,object-var ,object)) @@ -314,39 +316,36 @@ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) (:load-lexical (:lexical-binding ,object-var) :eax) (:addl :ebx :ecx) - (:movl (:eax :ecx ,(offset-by 4)) :ecx) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx) (:andl 7 :ecx))))))) (:unsigned-byte32 - (let ((prefixes (if (not physicalp) - () - movitz:*compiler-physical-segment-prefix*)) - (fix-endian (ecase (movitz:movitz-eval endian env) + (let ((fix-endian (ecase (movitz:movitz-eval endian env) ((:host :little) ()) (:big `((:bswap :ecx)))))) (assert (= 4 movitz::+movitz-fixnum-factor+)) (cond - ((and (eq 0 offset) (eq 0 index)) - `(with-inline-assembly (:returns :untagged-fixnum-ecx - :type (unsigned-byte 32)) - (:compile-form (:result-mode :eax) ,object) - (,prefixes :movl (:eax ,(offset-by 4)) :ecx) - ,@fix-endian)) - ((eq 0 offset) - `(with-inline-assembly (:returns :untagged-fixnum-ecx - :type (unsigned-byte 32)) - (:compile-two-forms (:eax :ecx) ,object ,index) - (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx) - ,@fix-endian)) - (t (let ((object-var (gensym "memref-object-"))) - `(let ((,object-var ,object)) - (with-inline-assembly (:returns :untagged-fixnum-ecx - :type (unsigned-byte 32)) - (:compile-two-forms (:ecx :ebx) ,offset ,index) - (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) - (:load-lexical (:lexical-binding ,object-var) :eax) - (:addl :ebx :ecx) - (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx) - ,@fix-endian))))))) + ((and (eq 0 offset) (eq 0 index)) + `(with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 32)) + (:compile-form (:result-mode :eax) ,object) + (,prefixes :movl (:eax ,(offset-by 4)) :ecx) + ,@fix-endian)) + ((eq 0 offset) + `(with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 32)) + (:compile-two-forms (:eax :ecx) ,object ,index) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx) + ,@fix-endian)) + (t (let ((object-var (gensym "memref-object-"))) + `(let ((,object-var ,object)) + (with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 32)) + (:compile-two-forms (:ecx :ebx) ,offset ,index) + (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) + (:load-lexical (:lexical-binding ,object-var) :eax) + (:addl :ebx :ecx) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx) + ,@fix-endian))))))) (:lisp (let* ((localp (movitz:movitz-eval localp env)) (prefixes (if localp @@ -433,469 +432,488 @@ form)))))))) (defun memref (object offset &key (index 0) (type :lisp) localp (endian :host) physicalp) - (macrolet - ((do-memref (physicalp) - `(ecase type - (:lisp - (if localp - (memref object offset :index index :localp t :physicalp ,physicalp) - (memref object offset :index index :localp nil :physicalp ,physicalp))) - (:unsigned-byte32 - (memref object offset :index index :type :unsigned-byte32 :physicalp ,physicalp)) - (:character - (memref object offset :index index :type :character :physicalp ,physicalp)) - (:unsigned-byte8 - (memref object offset :index index :type :unsigned-byte8 :physicalp ,physicalp)) - (:location - (memref object offset :index index :type :location :physicalp ,physicalp)) - (:unsigned-byte16 - (ecase endian - ((:host :little) - (memref object offset :index index :type :unsigned-byte16 :endian :little :physicalp ,physicalp)) - ((:big) - (memref object offset :index index :type :unsigned-byte16 :endian :big :physicalp ,physicalp)))) - (:code-vector - (memref object offset :index index :type :code-vector :physicalp ,physicalp)) - (:unsigned-byte14 - (memref object offset :index index :type :unsigned-byte14 :physicalp ,physicalp)) - (:signed-byte30+2 - (memref object offset :index index :type :signed-byte30+2 :physicalp ,physicalp)) - (:unsigned-byte29+3 - (memref object offset :index index :type :unsigned-byte29+3 :physicalp ,physicalp))))) - (if physicalp - (do-memref t) - (do-memref nil)))) + (case type + (:lisp + (if localp + (memref object offset :index index :localp t) + (memref object offset :index index :localp nil))) + (:code-vector + (memref object offset :index index :type :code-vector)) + (t (macrolet + ((do-memref (physicalp) + `(ecase type + + (:unsigned-byte32 + (memref object offset :index index :type :unsigned-byte32 :physicalp ,physicalp)) + (:character + (memref object offset :index index :type :character :physicalp ,physicalp)) + (:unsigned-byte8 + (memref object offset :index index :type :unsigned-byte8 :physicalp ,physicalp)) + (:location + (memref object offset :index index :type :location :physicalp ,physicalp)) + (:unsigned-byte16 + (ecase endian + ((:host :little) + (memref object offset :index index :type :unsigned-byte16 :endian :little :physicalp ,physicalp)) + ((:big) + (memref object offset :index index :type :unsigned-byte16 :endian :big :physicalp ,physicalp)))) + + (:unsigned-byte14 + (memref object offset :index index :type :unsigned-byte14 :physicalp ,physicalp)) + (:signed-byte30+2 + (memref object offset :index index :type :signed-byte30+2 :physicalp ,physicalp)) + (:unsigned-byte29+3 + (memref object offset :index index :type :unsigned-byte29+3 :physicalp ,physicalp))))) + (if physicalp + (do-memref t) + (do-memref nil)))))) -(define-compiler-macro (setf memref) (&whole form &environment env value object offset - &key (index 0) (type :lisp) (localp nil) (endian :host)) +(define-compiler-macro (setf memref) + (&whole form &environment env value object offset + &key (index 0) (type :lisp) (localp nil) (endian :host) (physicalp nil)) (if (or (not (movitz:movitz-constantp type env)) (not (movitz:movitz-constantp localp env)) - (not (movitz:movitz-constantp endian env))) + (not (movitz:movitz-constantp endian env)) + (not (movitz:movitz-constantp physicalp env))) form - (multiple-value-bind (constant-index xindex) - (extract-constant-delta index env) - (multiple-value-bind (constant-offset xoffset) - (extract-constant-delta offset env) - (flet ((offset-by (element-size) - (+ constant-offset (* constant-index element-size)))) - (case (movitz::movitz-eval type env) - (:character - (cond - ((and (movitz:movitz-constantp value env) - (movitz:movitz-constantp offset env) - (movitz:movitz-constantp index env)) - (let ((value (movitz:movitz-eval value env))) - (check-type value movitz::movitz-character) - `(progn - (with-inline-assembly (:returns :nothing) - (:compile-form (:result-mode :ebx) ,object) - (:movb ,(movitz:movitz-intern value) - (:ebx ,(+ (movitz:movitz-eval offset env) - (* 1 (movitz:movitz-eval index env)))))) - ,value))) - ((and (movitz:movitz-constantp offset env) - (movitz:movitz-constantp index env)) - `(with-inline-assembly (:returns :eax) - (:compile-two-forms (:eax :ebx) ,value ,object) - (:movb :ah (:ebx ,(+ (movitz:movitz-eval offset env) - (* 1 (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 :untagged-fixnum-ecx) ,object ,index) - (:load-lexical (:lexical-binding ,value-var) :eax) - (:movb :ah (:ebx :ecx ,(+ (movitz:movitz-eval offset env)))))))) - (t (let ((object-var (gensym "memref-object-")) - (offset-var (gensym "memref-offset-"))) - `(let ((,object-var ,object) (,offset-var ,offset)) - (with-inline-assembly (:returns :nothing) - (:compile-two-forms (:ecx :eax) ,index ,value) - (:load-lexical (:lexical-binding ,offset-var) :ebx) - (:addl :ebx :ecx) - (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) - (:load-lexical (:lexical-binding ,object-var) :ebx) - (:movb :ah (:ebx :ecx)))))))) - (:unsigned-byte32 - (let ((endian (ecase (movitz:movitz-eval endian env) - ((:host :little) :little) - (:big :big)))) - (assert (= 4 movitz::+movitz-fixnum-factor+)) - (cond - ((and (movitz:movitz-constantp value env) - (movitz:movitz-constantp offset env) - (movitz:movitz-constantp index env)) [805 lines skipped]

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 15 Jan '08

15 Jan '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv14571 Modified Files: memref.lisp Log Message: Fix several (more) bugs in (memref-int :type :unsigned-byte32) reader and writer. --- /project/movitz/cvsroot/movitz/losp/muerte/memref.lisp 2008/01/13 22:27:10 1.50 +++ /project/movitz/cvsroot/movitz/losp/muerte/memref.lisp 2008/01/15 23:01:09 1.51 @@ -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.50 2008/01/13 22:27:10 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.51 2008/01/15 23:01:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -432,24 +432,39 @@ (t (error "Unknown memref type: ~S" (movitz:movitz-eval type nil nil)) form)))))))) -(defun memref (object offset &key (index 0) (type :lisp) localp (endian :host)) - (ecase type - (:lisp (if localp - (memref object offset :index index :localp t) - (memref object offset :index index :localp nil))) - (:unsigned-byte32 (memref object offset :index index :type :unsigned-byte32)) - (:character (memref object offset :index index :type :character)) - (:unsigned-byte8 (memref object offset :index index :type :unsigned-byte8)) - (:location (memref object offset :index index :type :location)) - (:unsigned-byte16 (ecase endian - ((:host :little) - (memref object offset :index index :type :unsigned-byte16 :endian :little)) - ((:big) - (memref object offset :index index :type :unsigned-byte16 :endian :big)))) - (:code-vector (memref object offset :index index :type :code-vector)) - (:unsigned-byte14 (memref object offset :index index :type :unsigned-byte14)) - (:signed-byte30+2 (memref object offset :index index :type :signed-byte30+2)) - (:unsigned-byte29+3 (memref object offset :index index :type :unsigned-byte29+3)))) +(defun memref (object offset &key (index 0) (type :lisp) localp (endian :host) physicalp) + (macrolet + ((do-memref (physicalp) + `(ecase type + (:lisp + (if localp + (memref object offset :index index :localp t :physicalp ,physicalp) + (memref object offset :index index :localp nil :physicalp ,physicalp))) + (:unsigned-byte32 + (memref object offset :index index :type :unsigned-byte32 :physicalp ,physicalp)) + (:character + (memref object offset :index index :type :character :physicalp ,physicalp)) + (:unsigned-byte8 + (memref object offset :index index :type :unsigned-byte8 :physicalp ,physicalp)) + (:location + (memref object offset :index index :type :location :physicalp ,physicalp)) + (:unsigned-byte16 + (ecase endian + ((:host :little) + (memref object offset :index index :type :unsigned-byte16 :endian :little :physicalp ,physicalp)) + ((:big) + (memref object offset :index index :type :unsigned-byte16 :endian :big :physicalp ,physicalp)))) + (:code-vector + (memref object offset :index index :type :code-vector :physicalp ,physicalp)) + (:unsigned-byte14 + (memref object offset :index index :type :unsigned-byte14 :physicalp ,physicalp)) + (:signed-byte30+2 + (memref object offset :index index :type :signed-byte30+2 :physicalp ,physicalp)) + (:unsigned-byte29+3 + (memref object offset :index index :type :unsigned-byte29+3 :physicalp ,physicalp))))) + (if physicalp + (do-memref t) + (do-memref nil)))) (define-compiler-macro (setf memref) (&whole form &environment env value object offset &key (index 0) (type :lisp) (localp nil) (endian :host)) @@ -885,14 +900,14 @@ (define-compiler-macro memref-int (&whole form address &key (offset 0) (index 0) (type :unsigned-byte32) (physicalp t) &environment env) - (if (or (not (movitz:movitz-constantp type physicalp)) + (if (or (not (movitz:movitz-constantp type env)) (not (movitz:movitz-constantp physicalp env))) form (let* ((physicalp (movitz::eval-form physicalp env)) (prefixes (if (not physicalp) () movitz:*compiler-physical-segment-prefix*))) - (ecase (movitz::eval-form type) + (ecase (movitz::movitz-eval type env) (:lisp (let ((address-var (gensym "memref-int-address-"))) `(let ((,address-var ,address)) @@ -909,17 +924,22 @@ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale down address (,prefixes :movl (:ecx) :eax))))) (:unsigned-byte32 - (let ((address-var (gensym "memref-int-address-"))) - `(let ((,address-var ,address)) - (with-inline-assembly (:returns :untagged-fixnum-ecx) - (:compile-two-forms (:eax :ecx) ,offset ,index) - (:load-lexical (:lexical-binding ,address-var) :ebx) - (:shll 2 :ecx) - (:addl :ebx :eax) - (:into) - (:addl :eax :ecx) - (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale down address - (,prefixes :movl (:ecx) :ecx))))) + (cond + ((integerp index) + (let ((address-var (gensym "memref-int-address-"))) + `(let ((,address-var (+ ,address ,offset))) + (with-inline-assembly (:returns :untagged-fixnum-ecx) + (:compile-form (:result-mode :untagged-fixnum-ecx) ,address-var) + (,prefixes :movl (:ecx ,index) :ecx))))) + (t (let ((address-var (gensym "memref-int-address-")) + (index-var (gensym "memref-int-index-"))) + `(let ((,address-var (+ ,address ,offset)) + (,index-var ,index)) + (with-inline-assembly (:returns :untagged-fixnum-ecx) + (:compile-two-forms (:eax :untagged-fixnum-ecx) ,index-var ,address-var) + (:testb ,movitz:+movitz-fixnum-zmask+ :al) + (:jnz '(:sub-program () (:int 64))) + (,prefixes :movl (:ecx :eax) :ecx))))))) (:unsigned-byte8 (cond ((and (eq 0 offset) (eq 0 index)) @@ -1026,7 +1046,7 @@ (:pushl :ecx) ; an untagged integer (zerop (mod x 4)) is still GC-safe. (:compile-form (:result-mode :untagged-fixnum-ecx) ,value-var) (:popl :eax) - (:movl :ecx (:eax ,offset)))))) + (,prefixes :movl :ecx (:eax ,offset)))))) (t (let ((offset-var (gensym "memref-int-offset-")) (addr-var (gensym "memref-int-address-")) (value-var (gensym "memref-int-value-"))) @@ -1044,7 +1064,7 @@ (:compile-form (:result-mode :edx) ,offset-var) (:std) (:shrl ,movitz:+movitz-fixnum-shift+ :edx) - (:movl :ecx (:eax :edx)) + (,prefixes :movl :ecx (:eax :edx)) (:movl :edi :edx) ; make EDX GC-safe (:cld))))))) (:lisp

1 0

[movitz-cvs] CVS public_html
by ffjeld 13 Jan '08

13 Jan '08

Update of /project/movitz/cvsroot/public_html In directory clnet:/tmp/cvs-serv9798 Modified Files: index.html Log Message: *** empty log message *** --- /project/movitz/cvsroot/public_html/index.html 2007/03/15 16:03:13 1.30 +++ /project/movitz/cvsroot/public_html/index.html 2008/01/13 22:32:04 1.31 @@ -15,31 +15,11 @@ <h3>Most recent news</h3> <pre> -2007-03-14 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> +2008-01-13 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> - * movitz/losp/x86-pc/keyboard.lisp: Patch from Shawn Betts - improves the keyboard driver and adds dvorak support. - - * movitz/losp/x86-pc/vga.lisp: Patch from Martin Bealby adds some - simple VGA graphics capabilities, and a neat splash image. - - * movitz/bootblock.lisp: Added detection of floppy geometry in the - bootloader. This was prompted by the fact that Qemu appears to do - some weird auto-detection of the floppy geometry based on the - floppy image's size. However, it should also mean that movitz can - now be booted from a "real" 5 1/4' floppy should you ever find - one, and more importantly, probably also 2.88-MB floppies as - supported by bochs and qemu, and I think also some actual hardware - drives. - - * movitz/compiler.lisp: Much improved keyword argument parsing. It - is now faster, smaller in code-size, and more (fully?) ANSI - compliant. - - * doc/ChangeLog: Things are not moving quite as slowly as might be - suggested by the lack of activity in this file. The last few - weeks, there has been quite a bit of activity. I'll try once again - to remember to update this ChangeLog. + * movitz/losp/muerte/memref.lisp: Fixed (setf memref-int :type + :unsigned-byte32), which didn't really work at all I think. It + would write to the wrong address, or go into unbounded recursion. </pre> <h3>Introduction</h3>

1 0

[movitz-cvs] CVS public_html
by ffjeld 13 Jan '08

13 Jan '08

Update of /project/movitz/cvsroot/public_html In directory clnet:/tmp/cvs-serv9780 Modified Files: ChangeLog Log Message: *** empty log message *** --- /project/movitz/cvsroot/public_html/ChangeLog 2007/03/15 16:10:21 1.10 +++ /project/movitz/cvsroot/public_html/ChangeLog 2008/01/13 22:32:02 1.11 @@ -1,3 +1,9 @@ +2008-01-13 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> + + * movitz/losp/muerte/memref.lisp: Fixed (setf memref-int :type + :unsigned-byte32), which didn't really work at all I think. It + would write to the wrong address, or go into unbounded recursion. + 2007-03-14 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> * movitz/losp/x86-pc/keyboard.lisp: Patch from Shawn Betts

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 13 Jan '08

13 Jan '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv9220 Modified Files: memref.lisp Log Message: Fix (setf memref-int :type :unsigned-byte32), which was quite buggy, as reported by mxb. --- /project/movitz/cvsroot/movitz/losp/muerte/memref.lisp 2007/04/13 23:19:57 1.49 +++ /project/movitz/cvsroot/movitz/losp/muerte/memref.lisp 2008/01/13 22:27:10 1.50 @@ -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.49 2007/04/13 23:19:57 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.50 2008/01/13 22:27:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -998,109 +998,127 @@ (define-compiler-macro (setf memref-int) (&whole form value address &key (offset 0) (index 0) (type :type) (physicalp t) - &environment env) + &environment env) (if (or (not (movitz:movitz-constantp type env)) (not (movitz:movitz-constantp physicalp env))) (progn (warn "setf memref-int form: ~S, ~S ~S" form type physicalp) form) - (let* ((physicalp (movitz::eval-form physicalp env)) - (prefixes (if (not physicalp) - () - movitz:*compiler-physical-segment-prefix*))) - (ecase type - (:unsigned-byte32 - (assert (= 4 movitz:+movitz-fixnum-factor+)) - (if (not (movitz:movitz-constantp offset env)) - form - (let ((offset (movitz:movitz-eval offset env)) - (addr-var (gensym "memref-int-address-")) - (value-var (gensym "memref-int-value-"))) - `(let ((,value-var ,value) - (,addr-var (+ ,address ,index))) - (with-inline-assembly (:returns :untagged-fixnum-ecx) - (:compile-form (:result-mode :untagged-fixnum-ecx) ,addr-var) - (:testb ,(logior movitz:+movitz-fixnum-zmask+ - (* 3 movitz:+movitz-fixnum-factor+)) - :cl) - (:jnz '(:sub-program () (:int 70))) - (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) ; a fixnum (zerop (mod x 4)) shifted - (:pushl :ecx) ; ..twice left is still a fixnum! - (:compile-form (:result-mode :untagged-fixnum-ecx) ,value-var) - (:popl :eax) - (:movl :ecx (:eax ,offset))))))) - (:lisp - (assert (= 4 movitz:+movitz-fixnum-factor+)) - `(with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :push) ,address) - (:compile-form (:result-mode :push) ,index) - (:compile-form (:result-mode :push) ,offset) - (:compile-form (:result-mode :eax) ,value) - (:popl :edx) ; offset - (:popl :ebx) ; index - (:popl :ecx) ; address - (:addl :edx :ecx) - (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) - (,prefixes :movl :eax (:ecx :ebx)))) - (:unsigned-byte8 - (let ((address-var (gensym "memref-int-address-")) - (index-var (gensym "memref-int-index-var-")) - (offset-var (gensym "memref-int-offset-var-")) - (value-var (gensym "memref-int-value-var-"))) - `(let ((,value-var ,value) - (,address-var ,address) - (,offset-var (+ ,index ,offset))) - (with-inline-assembly (:returns :nothing) - (:load-lexical (:lexical-binding ,address-var) :ecx) - (:load-lexical (:lexical-binding ,offset-var) :edx) - (:load-lexical (:lexical-binding ,value-var) :eax) - (:shll ,(- 8 movitz::+movitz-fixnum-shift+) :eax) - (:addl :edx :ecx) - (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) - (,prefixes :movb :ah (:ecx))) - ,value-var))) - (:unsigned-byte16 - (cond - ((eq 0 offset) + (let* ((physicalp (movitz::eval-form physicalp env)) + (prefixes (if (not physicalp) + () + movitz:*compiler-physical-segment-prefix*))) + (ecase type + (:unsigned-byte32 + (assert (= 4 movitz:+movitz-fixnum-factor+)) + (cond + ((movitz:movitz-constantp offset env) + (let ((offset (movitz:movitz-eval offset env)) + (addr-var (gensym "memref-int-address-")) + (value-var (gensym "memref-int-value-"))) + `(let ((,value-var ,value) + (,addr-var (+ ,address ,index))) + (with-inline-assembly (:returns :untagged-fixnum-ecx) + (:compile-form (:result-mode :untagged-fixnum-ecx) ,addr-var) + (:testb ,movitz:+movitz-fixnum-zmask+ + :cl) + (:jnz '(:sub-program () (:int 70))) + (:pushl :ecx) ; an untagged integer (zerop (mod x 4)) is still GC-safe. + (:compile-form (:result-mode :untagged-fixnum-ecx) ,value-var) + (:popl :eax) + (:movl :ecx (:eax ,offset)))))) + (t (let ((offset-var (gensym "memref-int-offset-")) + (addr-var (gensym "memref-int-address-")) + (value-var (gensym "memref-int-value-"))) + `(let ((,offset-var ,offset) + (,value-var ,value) + (,addr-var (+ ,address ,offset ,index))) + (with-inline-assembly (:returns :untagged-fixnum-ecx) + (:compile-form (:result-mode :untagged-fixnum-ecx) ,addr-var) + (:testb ,movitz:+movitz-fixnum-zmask+ + :cl) + (:jnz '(:sub-program () (:int 70))) + (:pushl :ecx) ; an untagged integer (zerop (mod x 4)) is still GC-safe. + (:compile-form (:result-mode :untagged-fixnum-ecx) ,value-var) + (:popl :eax) + (:compile-form (:result-mode :edx) ,offset-var) + (:std) + (:shrl ,movitz:+movitz-fixnum-shift+ :edx) + (:movl :ecx (:eax :edx)) + (:movl :edi :edx) ; make EDX GC-safe + (:cld))))))) + (:lisp + (assert (= 4 movitz:+movitz-fixnum-factor+)) + `(with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :push) ,address) + (:compile-form (:result-mode :push) ,index) + (:compile-form (:result-mode :push) ,offset) + (:compile-form (:result-mode :eax) ,value) + (:popl :edx) ; offset + (:popl :ebx) ; index + (:popl :ecx) ; address + (:addl :edx :ecx) + (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) + (,prefixes :movl :eax (:ecx :ebx)))) + (:unsigned-byte8 (let ((address-var (gensym "memref-int-address-")) - (index-var (gensym "memref-index-var-")) - (value-var (gensym "memref-value-var-"))) + (index-var (gensym "memref-int-index-var-")) + (offset-var (gensym "memref-int-offset-var-")) + (value-var (gensym "memref-int-value-var-"))) `(let ((,value-var ,value) (,address-var ,address) - (,index-var ,index)) - (with-inline-assembly (:returns :eax) - (:load-lexical (:lexical-binding ,value-var) :eax) ; value - (:load-lexical (:lexical-binding ,index-var) :ebx) ; index - (:load-lexical (:lexical-binding ,address-var) :ecx) ; address - (:shll 1 :ebx) ; scale index - (:addl :ebx :ecx) - (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) ; scale address - (:std) - (:shrl ,movitz:+movitz-fixnum-shift+ :eax) ; scale value - (,prefixes :movw :ax (:ecx)) - (:leal ((:eax ,movitz:+movitz-fixnum-factor+)) :eax) - (:cld))))) - (t (let ((address-var (gensym "memref-int-address-")) - (offset-var (gensym "memref-offset-var-")) - (index-var (gensym "memref-index-var-")) - (value-var (gensym "memref-value-var-"))) - `(let ((,value-var ,value) - (,address-var ,address) - (,offset-var ,offset) - (,index-var ,index)) - (with-inline-assembly (:returns :eax) - (:load-lexical (:lexical-binding ,address-var) :ecx) - (:load-lexical (:lexical-binding ,index-var) :ebx) - (:load-lexical (:lexical-binding ,offset-var) :edx) - (:load-lexical (:lexical-binding ,value-var) :eax) - (:leal (:ecx (:ebx 2)) :ecx) - (:addl :edx :ecx) ; - (:shrl ,movitz::+movitz-fixnum-shift+ :eax) ; scale value - (:std) - (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale offset+address - (,prefixes :movw :ax (:ecx)) - (:leal ((:eax ,movitz:+movitz-fixnum-factor+)) :eax) - (:cld))))))))))) + (,offset-var (+ ,index ,offset))) + (with-inline-assembly (:returns :nothing) + (:load-lexical (:lexical-binding ,address-var) :ecx) + (:load-lexical (:lexical-binding ,offset-var) :edx) + (:load-lexical (:lexical-binding ,value-var) :eax) + (:shll ,(- 8 movitz::+movitz-fixnum-shift+) :eax) + (:addl :edx :ecx) + (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) + (,prefixes :movb :ah (:ecx))) + ,value-var))) + (:unsigned-byte16 + (cond + ((eq 0 offset) + (let ((address-var (gensym "memref-int-address-")) + (index-var (gensym "memref-index-var-")) + (value-var (gensym "memref-value-var-"))) + `(let ((,value-var ,value) + (,address-var ,address) + (,index-var ,index)) + (with-inline-assembly (:returns :eax) + (:load-lexical (:lexical-binding ,value-var) :eax) ; value + (:load-lexical (:lexical-binding ,index-var) :ebx) ; index + (:load-lexical (:lexical-binding ,address-var) :ecx) ; address + (:shll 1 :ebx) ; scale index + (:addl :ebx :ecx) + (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) ; scale address + (:std) + (:shrl ,movitz:+movitz-fixnum-shift+ :eax) ; scale value + (,prefixes :movw :ax (:ecx)) + (:leal ((:eax ,movitz:+movitz-fixnum-factor+)) :eax) + (:cld))))) + (t (let ((address-var (gensym "memref-int-address-")) + (offset-var (gensym "memref-offset-var-")) + (index-var (gensym "memref-index-var-")) + (value-var (gensym "memref-value-var-"))) + `(let ((,value-var ,value) + (,address-var ,address) + (,offset-var ,offset) + (,index-var ,index)) + (with-inline-assembly (:returns :eax) + (:load-lexical (:lexical-binding ,address-var) :ecx) + (:load-lexical (:lexical-binding ,index-var) :ebx) + (:load-lexical (:lexical-binding ,offset-var) :edx) + (:load-lexical (:lexical-binding ,value-var) :eax) + (:leal (:ecx (:ebx 2)) :ecx) + (:addl :edx :ecx) ; + (:shrl ,movitz::+movitz-fixnum-shift+ :eax) ; scale value + (:std) + (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale offset+address + (,prefixes :movw :ax (:ecx)) + (:leal ((:eax ,movitz:+movitz-fixnum-factor+)) :eax) + (:cld))))))))))) (defun (setf memref-int) (value address &key (offset 0) (index 0) (type :unsigned-byte32) (physicalp t))

1 0

[movitz-cvs] CVS movitz
by ffjeld 03 Jan '08

03 Jan '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv1590 Modified Files: asm.lisp Log Message: Some assembler work over christmas. --- /project/movitz/cvsroot/movitz/asm.lisp 2007/12/16 08:57:19 1.1 +++ /project/movitz/cvsroot/movitz/asm.lisp 2008/01/03 10:34:20 1.2 @@ -6,7 +6,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: asm.lisp,v 1.1 2007/12/16 08:57:19 ffjeld Exp $ +;;;; $Id: asm.lisp,v 1.2 2008/01/03 10:34:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -47,10 +47,10 @@ (typep operand 'register-operand)) (deftype indirect-operand () - 'cons) + '(and cons (not (cons (eql quote))))) (defun indirect-operand-p (operand) - (consp operand)) + (typep operand 'indirect-operand)) (define-condition unresolved-symbol () ((symbol

1 0

[movitz-cvs] CVS movitz
by ffjeld 03 Jan '08

03 Jan '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv1564 Modified Files: asm-x86.lisp Log Message: Some assembler work over christmas. --- /project/movitz/cvsroot/movitz/asm-x86.lisp 2007/12/20 22:52:18 1.4 +++ /project/movitz/cvsroot/movitz/asm-x86.lisp 2008/01/03 10:34:18 1.5 @@ -6,7 +6,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: asm-x86.lisp,v 1.4 2007/12/20 22:52:18 ffjeld Exp $ +;;;; $Id: asm-x86.lisp,v 1.5 2008/01/03 10:34:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -17,6 +17,7 @@ (defvar *symtab* nil) (defvar *cpu-mode* :32-bit) +(defvar *pc* nil "Current program counter.") (defvar *instruction-encoders* (make-hash-table :test 'eq)) @@ -81,22 +82,24 @@ (encode-to-parts instruction) (unless opcode (error "Unable to encode instruction ~S." instruction)) - (when (or (and (eq operand-size :16-bit) - (eq *cpu-mode* :64-bit)) - (and (eq operand-size :16-bit) - (eq *cpu-mode* :32-bit)) - (and (eq operand-size :32-bit) - (eq *cpu-mode* :16-bit))) - (pushnew :operand-size-override - prefixes)) (when (or (and (eq address-size :32-bit) (eq *cpu-mode* :64-bit)) (and (eq address-size :16-bit) (eq *cpu-mode* :32-bit)) + (and (eq address-size :64-bit) + (eq *cpu-mode* :32-bit)) (and (eq address-size :32-bit) (eq *cpu-mode* :16-bit))) (pushnew :address-size-override prefixes)) + (when (or (and (eq operand-size :16-bit) + (eq *cpu-mode* :64-bit)) + (and (eq operand-size :16-bit) + (eq *cpu-mode* :32-bit)) + (and (eq operand-size :32-bit) + (eq *cpu-mode* :16-bit))) + (pushnew :operand-size-override + prefixes)) (append (mapcar #'prefix-lookup (reverse prefixes)) (rex-encode rexes :rm rm) (when (< 8(integer-length opcode)) @@ -206,8 +209,12 @@ (check-type operator keyword) (let ((defun-name (intern (format nil "~A-~A" 'instruction-encoder operator)))) `(progn - (defun ,defun-name ,lambda-list (block operator - ,@body)) + (defun ,defun-name ,lambda-list + (let ((operator-mode nil) + (default-rex nil)) + (declare (ignorable operator-mode default-rex)) + (block operator + ,@body))) (setf (gethash ',operator *instruction-encoders*) ',defun-name) ',operator))) @@ -216,6 +223,7 @@ `(define-operator ,operator ,lambda-list (let ((operator-mode :8-bit) (default-rex nil)) + (declare (ignorable operator-mode default-rex)) (macrolet ((yield (&rest args) `(encoded-result :operand-size 8 ,@args))) ,@body)))) @@ -232,6 +240,7 @@ `(define-operator ,operator ,lambda-list (let ((operator-mode :32-bit) (default-rex nil)) + (declare (ignorable operator-mode)) (macrolet ((yield (&rest args) `(encoded-result :operand-size operator-mode ,@args))) ,@body)))) @@ -240,6 +249,7 @@ `(define-operator ,operator ,lambda-list (let ((operator-mode :64-bit) (default-rex '(:rex.w))) + (declare (ignorable operator-mode)) (macrolet ((yield (&rest args) `(encoded-result :operand-size operator-mode ,@args))) ,@body)))) @@ -250,15 +260,19 @@ (default-rex (case *cpu-mode* (:64-bit nil) (t '(:rex.w))))) + (declare (ignorable operator-mode)) ,@body))) (defmacro define-operator* ((&key |16| |32| |64|) args &body body) (let ((body16 (subst '(xint 16) :int-16-32-64 - (subst :ax :ax-eax-rax body))) + (subst :dx :dx-edx-rdx + (subst :ax :ax-eax-rax body)))) (body32 (subst '(xint 32) :int-16-32-64 - (subst :eax :ax-eax-rax body))) + (subst :edx :dx-edx-rdx + (subst :eax :ax-eax-rax body)))) (body64 (subst '(sint 32) :int-16-32-64 - (subst :rax :ax-eax-rax body)))) + (subst :rdx :dx-edx-rdx + (subst :rax :ax-eax-rax body))))) `(progn ,(when |16| `(define-operator/16 ,|16| ,args ,@body16)) @@ -267,12 +281,6 @@ ,(when |64| `(define-operator/64 ,|64| ,args ,@body64))))) - -(defmacro define-simple (operator opcode) - (check-type opcode (unsigned-byte 16)) - `(define-operator ,operator () - (encoded-values :opcode ,opcode))) - (defun resolve (x) (etypecase x (integer @@ -296,11 +304,13 @@ (t (error "Unresolved symbol ~S (size ~S)." x size))) type)) -(defun encode-pc-relative (operand type) - (when (typep operand '(cons (eql :pc+))) - (encode-integer (reduce #'+ (cdr operand) - :key #'resolve) - type))) +(defun resolve-pc-relative (operand) + (typecase operand + ((cons (eql :pc+)) + (reduce #'+ (cdr operand) + :key #'resolve)) + (symbol-reference + (- (resolve operand) *pc*)))) (defun encode-integer (i type) (assert (typep i type)) @@ -340,8 +350,8 @@ (defun encode-reg/mem (operand mode) - (check-type mode (member :8-bit :16-bit :32-bit :64-bit :mm :xmm)) - (if (keywordp operand) + (check-type mode (member nil :8-bit :16-bit :32-bit :64-bit :mm :xmm)) + (if (and mode (keywordp operand)) (encoded-values :mod #b11 :rm (or (position operand (ecase mode (:8-bit '(:al :cl :dl :bl :ah :ch :dh :bh)) @@ -361,10 +371,18 @@ (let ((offset (reduce #'+ offsets :key #'resolve))) (cond + ((and (not reg) + (eq mode :16-bit) + (typep offset '(xint 16))) + (encoded-values :mod #b00 + :rm #b110 + :address-size :16-bit + :displacement (encode-integer offset '(xint 16)))) ((and (not reg) (typep offset '(xint 32))) (encoded-values :mod #b00 :rm #b101 + :address-size :32-bit :displacement (encode-integer offset '(xint 32)))) ((and (eq reg :sp) (not reg2) @@ -483,13 +501,27 @@ :rm register-index :displacement (encode-integer offset '(sint 32)) :address-size address-size)) + ((and (not reg2) + register-index + (if (eq :64-bit *cpu-mode*) + (typep offset '(sint 32)) + (typep offset '(xint 32))) + (not (= #b100 register-index))) + (encoded-values :rm #b100 + :mod #b00 + :index register-index + :base #b101 + :scale (or (position reg-scale '(1 2 4 8)) + (error "Unknown register scale ~S." reg-scale)) + :displacement (encode-integer offset '(xint 32)))) ((and reg2 register-index (zerop offset) (not (= register-index #b100))) (encoded-values :mod #b00 :rm #b100 - :scale (position reg-scale '(1 2 4 8)) + :scale (or (position reg-scale '(1 2 4 8)) + (error "Unknown register scale ~S." reg-scale)) :index register-index :base (or (position reg2 map) (error "unknown reg2 [A] ~S" reg2)) @@ -580,13 +612,13 @@ (declare (ignore prefixes prefix rex opcode mod reg rm scale index base displacement immediate operand-size address-size)) `(return-from operator (encoded-values ,@args))) -(defmacro imm (imm-operand condition opcode imm-type &rest extras) - `(when (and ,(or condition t) - (immediate-p ,imm-operand)) +(defmacro imm (imm-operand opcode imm-type &rest extras) + `(when (immediate-p ,imm-operand) (let ((immediate (resolve ,imm-operand))) (when (typep immediate ',imm-type) (encoded-result :opcode ,opcode :immediate (encode-integer immediate ',imm-type) + :operand-size operator-mode :rex default-rex ,@extras))))) @@ -597,29 +629,29 @@ (return-from operator (merge-encodings (encoded-values :opcode ,opcode :reg ,digit - :operand-size (when (eq operator-mode :16-bit) - :16-bit) + :operand-size operator-mode :rex default-rex :immediate (encode-integer immediate ',type)) (encode-reg/mem ,op-modrm operator-mode))))))) -(defmacro pc-rel (opcode operand type) - `(let ((offset (encode-pc-relative ,operand ',type))) - (when offset +(defmacro pc-rel (opcode operand type &rest extras) + `(let ((offset (resolve-pc-relative ,operand))) + (when (typep offset ',type) (return-from operator (encoded-values :opcode ,opcode - :displacement offset))))) + :displacement (encode-integer offset ',type) + ,@extras))))) (defmacro modrm (operand opcode digit) - `(return-from operator - (merge-encodings (encoded-values :opcode ,opcode - :reg ,digit - :operand-size (when (eq operator-mode :16-bit) - :16-bit) - :rex default-rex) - (encode-reg/mem ,operand operator-mode)))) + `(when (typep ,operand '(or register-operand indirect-operand)) + (return-from operator + (merge-encodings (encoded-values :opcode ,opcode + :reg ,digit + :operand-size operator-mode + :rex default-rex) + (encode-reg/mem ,operand operator-mode))))) -(defmacro reg-modrm (op-reg op-modrm opcode) +(defmacro reg-modrm (op-reg op-modrm opcode &rest extras) `(let* ((reg-map (ecase operator-mode (:8-bit '(:al :cl :dl :bl :ah :ch :dh :bh)) (:16-bit '(:ax :cx :dx :bx :sp :bp :si :di)) @@ -632,9 +664,9 @@ (return-from operator (merge-encodings (encoded-values :opcode ,opcode :reg reg-index - :operand-size (case operator-mode - (:16-bit :16-bit)) - :rex default-rex) + :operand-size operator-mode + :rex default-rex + ,@extras) (encode-reg/mem ,op-modrm operator-mode)))))) (defmacro sreg-modrm (op-sreg op-modrm opcode) @@ -659,6 +691,17 @@ :key #'resolve) ',type))))))) +(defmacro opcode (opcode &rest extras) + `(return-from operator + (encoded-values :opcode ,opcode + ,@extras + :operand-size operator-mode))) + +(defmacro opcode* (opcode &rest extras) + `(return-from operator + (encoded-values :opcode ,opcode + ,@extras))) + (defmacro opcode-reg (opcode op-reg) `(let* ((reg-map (ecase operator-mode (:8-bit '(:al :cl :dl :bl :ah :ch :dh :bh)) @@ -704,19 +747,22 @@ ;;;;;;;;;;;;;;;; -(define-simple :nop #x90) +(define-operator :nop () + (opcode #x90)) ;;;;;;;;;;; ADC (define-operator/8 :adcb (src dst) - (imm src (eq dst :al) #x14 (xint 8)) + (when (eq dst :al) + (imm src #x14 (xint 8))) (imm-modrm src dst #x80 2 (xint 8)) (reg-modrm dst src #x12) (reg-modrm src dst #x10)) (define-operator* (:16 :adcw :32 :adcl :64 :adcr) (src dst) (imm-modrm src dst #x83 2 (sint 8)) - (imm src (eq dst :ax-eax-rax) #x15 :int-16-32-64) + (when (eq dst :ax-eax-rax) + (imm src #x15 :int-16-32-64)) (imm-modrm src dst #x81 2 :int-16-32-64) (reg-modrm dst src #x13) (reg-modrm src dst #x11)) @@ -724,14 +770,16 @@ ;;;;;;;;;;; ADD (define-operator/8 :addb (src dst) - (imm src (eq dst :al) #x04 (xint 8)) + (when (eq dst :al) + (imm src #x04 (xint 8))) (imm-modrm src dst #x80 0 (xint 8)) (reg-modrm dst src #x02) (reg-modrm src dst #x00)) (define-operator* (:16 :addw :32 :addl :64 :addr) (src dst) (imm-modrm src dst #x83 0 (sint 8)) - (imm src (eq dst :ax-eax-rax) #x05 :int-16-32-64) + (when (eq dst :ax-eax-rax) + (imm src #x05 :int-16-32-64)) (imm-modrm src dst #x81 0 :int-16-32-64) (reg-modrm dst src #x03) (reg-modrm src dst #x01)) @@ -739,14 +787,16 @@ ;;;;;;;;;;; AND (define-operator/8 :andb (mask dst) - (imm mask (eq dst :al) #x24 (xint 8)) + (when (eq dst :al) + (imm mask #x24 (xint 8))) (imm-modrm mask dst #x80 4 (xint 8)) (reg-modrm dst mask #x22) (reg-modrm mask dst #x20)) (define-operator* (:16 :andw :32 :andl :64 :andr) (mask dst) (imm-modrm mask dst #x83 4 (sint 8)) - (imm mask (eq dst :ax-eax-rax) #x25 :int-16-32-64) + (when (eq dst :ax-eax-rax) + (imm mask #x25 :int-16-32-64)) (imm-modrm mask dst #x81 4 :int-16-32-64) (reg-modrm dst mask #x23) (reg-modrm mask dst #x21)) @@ -798,11 +848,11 @@ ;;;;;;;;;;; CLC, CLD, CLI, CLTS, CMC -(define-simple :clc #xf8) -(define-simple :cld #xfc) -(define-simple :cli #xfa) -(define-simple :clts #x0f06) -(define-simple :cmc #xf5) +(define-operator :clc () (opcode #xf8)) +(define-operator :cld () (opcode #xfc)) +(define-operator :cli () (opcode #xfa)) +(define-operator :clts () (opcode #x0f06)) +(define-operator :cmc () (opcode #xf5)) ;;;;;;;;;;; CMOVcc @@ -890,14 +940,16 @@ ;;;;;;;;;;; CMP (define-operator/8 :cmpb (src dst) - (imm src (eq dst :al) #x3c (xint 8)) + (when (eq dst :al) + (imm src #x3c (xint 8))) (imm-modrm src dst #x80 7 (xint 8)) (reg-modrm dst src #x3a) (reg-modrm src dst #x38)) (define-operator* (:16 :cmpw :32 :cmpl :64 :cmpr) (src dst) (imm-modrm src dst #x83 7 (sint 8)) - (imm src (eq dst :ax-eax-rax) #x3d :int-16-32-64) + (when (eq dst :ax-eax-rax) + (imm src #x3d :int-16-32-64)) (imm-modrm src dst #x81 7 :int-16-32-64) (reg-modrm dst src #x3b) (reg-modrm src dst #x39)) @@ -962,6 +1014,234 @@ (when (eq al-dst :ax-eax-rax) (reg-modrm cmp-reg cmp-modrm #x0fb1))) [256 lines skipped]

1 0

[movitz-cvs] CVS movitz
by ffjeld 20 Dec '07

20 Dec '07

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv20205 Modified Files: asm-x86.lisp Log Message: Another bit of progress on the assembler. --- /project/movitz/cvsroot/movitz/asm-x86.lisp 2007/12/18 21:45:06 1.3 +++ /project/movitz/cvsroot/movitz/asm-x86.lisp 2007/12/20 22:52:18 1.4 @@ -6,7 +6,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: asm-x86.lisp,v 1.3 2007/12/18 21:45:06 ffjeld Exp $ +;;;; $Id: asm-x86.lisp,v 1.4 2007/12/20 22:52:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -296,6 +296,12 @@ (t (error "Unresolved symbol ~S (size ~S)." x size))) type)) +(defun encode-pc-relative (operand type) + (when (typep operand '(cons (eql :pc+))) + (encode-integer (reduce #'+ (cdr operand) + :key #'resolve) + type))) + (defun encode-integer (i type) (assert (typep i type)) (let ((bit-size (cadr type))) @@ -597,6 +603,13 @@ :immediate (encode-integer immediate ',type)) (encode-reg/mem ,op-modrm operator-mode))))))) +(defmacro pc-rel (opcode operand type) + `(let ((offset (encode-pc-relative ,operand ',type))) + (when offset + (return-from operator + (encoded-values :opcode ,opcode + :displacement offset))))) + (defmacro modrm (operand opcode digit) `(return-from operator (merge-encodings (encoded-values :opcode ,opcode @@ -634,6 +647,18 @@ :rex default-rex) (encode-reg/mem ,op-modrm operator-mode)))))) +(defmacro moffset (opcode op-offset type) + `(when (indirect-operand-p ,op-offset) + (multiple-value-bind (reg offsets reg2) + (parse-indirect-operand ,op-offset) + (when (and (not reg) + (not reg2)) + (return-from operator + (encoded-values :opcode ,opcode + :displacement (encode-integer (reduce #'+ offsets + :key #'resolve) + ',type))))))) + (defmacro opcode-reg (opcode op-reg) `(let* ((reg-map (ecase operator-mode (:8-bit '(:al :cl :dl :bl :ah :ch :dh :bh)) @@ -761,9 +786,14 @@ ;;;;;;;;;;; CALL (define-operator/16 :callw (dest) + (pc-rel #xe8 dest (sint 16)) (modrm dest #xff 2)) (define-operator/32 :call (dest) + (pc-rel #xe8 dest (sint 32)) + (modrm dest #xff 2)) + +(define-operator/32 :callr (dest) (modrm dest #xff 2)) ;;;;;;;;;;; CLC, CLD, CLI, CLTS, CMC @@ -875,12 +905,20 @@ ;;;;;;;;;;; MOV (define-operator/8 :movb (src dst) + (when (eq src :al) + (moffset #xa2 dst (uint 8))) + (when (eq dst :al) + (moffset #xa0 src (uint 8))) (opcode-reg-imm #xb0 dst src (xint 8)) (imm-modrm src dst #xc6 0 (xint 8)) (reg-modrm dst src #x8a) (reg-modrm src dst #x88)) (define-operator/16 :movw (src dst) + (when (eq src :ax) + (moffset #xa3 dst (uint 16))) + (when (eq dst :ax) + (moffset #xa0 src (uint 16))) (opcode-reg-imm #xb8 dst src (xint 16)) (imm-modrm src dst #xc7 0 (xint 16)) (sreg-modrm src dst #x8c) @@ -889,6 +927,10 @@ (reg-modrm src dst #x89)) (define-operator/32 :movl (src dst) + (when (eq src :eax) + (moffset #xa3 dst (uint 32))) + (when (eq dst :eax) + (moffset #xa0 src (uint 32))) (opcode-reg-imm #xb8 dst src (xint 32)) (imm-modrm src dst #xc7 0 (xint 32)) (reg-modrm dst src #x8b)

1 0

[movitz-cvs] CVS ia-x86
by ffjeld 20 Dec '07

20 Dec '07

Update of /project/movitz/cvsroot/ia-x86 In directory clnet:/tmp/cvs-serv19341 Modified Files: operands.lisp Log Message: Minor tweaks to printing instruction objects etc. Mostly related to testing the new assembler. --- /project/movitz/cvsroot/ia-x86/operands.lisp 2005/08/13 20:31:51 1.6 +++ /project/movitz/cvsroot/ia-x86/operands.lisp 2007/12/20 22:42:43 1.7 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Feb 16 14:02:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: operands.lisp,v 1.6 2005/08/13 20:31:51 ffjeld Exp $ +;;;; $Id: operands.lisp,v 1.7 2007/12/20 22:42:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -176,6 +176,11 @@ :reader operand-user-size :initform nil))) +(defmethod operand-listform ((operand calculated-operand)) + `(quote (:funcall ,(operand-calculation operand) + ,@(sub-operands operand)))) + + (defmethod operand-resolve-to-number ((operand calculated-operand) env) (assert (not (null env)) () "Resolving ~A requires an assemble-environment." operand) @@ -319,8 +324,16 @@ (defmethod operand-listform ((obj operand-indirect-register)) (with-slots (offset register scale register2) obj - (append (unless (and (integerp offset) (zerop offset)) - (list offset)) + (append (cond + ((eql 0 offset) + nil) + ((typep offset '(cons (eql +))) + (mapcar (lambda (x) + (if (symbolp x) + `(quote ,x) + x)) + (cdr offset))) + (t (list offset))) (if (= 1 scale) (list register) (list (list register scale))) @@ -328,7 +341,8 @@ (list register2))))) (defmethod print-object ((obj operand-indirect-register) stream) - (if (not *print-readably*) + (if *print-readably* + (call-next-method obj stream) (with-slots (offset register2 register scale) obj (format stream "[~@[~A+~]~@[%~A+~]%~A~@[*~D~]]" (unless (and (integerp offset) (zerop offset)) @@ -337,8 +351,7 @@ register (when (> scale 1) scale)) - obj) - (call-next-method obj stream))) + obj))) (defun resolve-indirect-register (operand env) (with-slots (register register2 offset scale) operand

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