[movitz-cvs] CVS update: movitz/compiler.lisp movitz/image.lisp movitz/procfs-image.lisp movitz/special-operators-cl.lisp movitz/special-operators.lisp movitz/storage-types.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Wed Sep 15 10:22:57 UTC 2004
Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv7579
Modified Files:
compiler.lisp image.lisp procfs-image.lisp
special-operators-cl.lisp special-operators.lisp
storage-types.lisp
Log Message:
many cleanup regarding stack and register discipline.
Date: Wed Sep 15 12:22:52 2004
Author: ffjeld
Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.98 movitz/compiler.lisp:1.99
--- movitz/compiler.lisp:1.98 Thu Sep 2 11:16:42 2004
+++ movitz/compiler.lisp Wed Sep 15 12:22:52 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.98 2004/09/02 09:16:42 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.99 2004/09/15 10:22:52 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -2194,15 +2194,15 @@
(setq p (list i `(:pushl ,(twop-src i)))
next-pc (nthcdr 2 pc))
(explain nil "store, push => store, push reg: ~S ~S" i i2))
- ((and (instruction-is i :cmpl)
- (true-and-equal (stack-frame-operand (twop-dst i))
- (load-stack-frame-p i3))
- (branch-instruction-label i2))
- (setf p (list i3
- `(:cmpl ,(twop-src i) ,(twop-dst i3))
- i2)
- next-pc (nthcdr 3 pc))
- (explain nil "~S ~S ~S => ~S" i i2 i3 p))
+;;; ((and (instruction-is i :cmpl)
+;;; (true-and-equal (stack-frame-operand (twop-dst i))
+;;; (load-stack-frame-p i3))
+;;; (branch-instruction-label i2))
+;;; (setf p (list i3
+;;; `(:cmpl ,(twop-src i) ,(twop-dst i3))
+;;; i2)
+;;; next-pc (nthcdr 3 pc))
+;;; (explain t "~S ~S ~S => ~S" i i2 i3 p))
((and (instruction-is i :pushl)
(instruction-is i3 :popl)
(store-stack-frame-p i2)
Index: movitz/image.lisp
diff -u movitz/image.lisp:1.66 movitz/image.lisp:1.67
--- movitz/image.lisp:1.66 Thu Sep 2 11:21:14 2004
+++ movitz/image.lisp Wed Sep 15 12:22:52 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.66 2004/09/02 09:21:14 ffjeld Exp $
+;;;; $Id: image.lisp,v 1.67 2004/09/15 10:22:52 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -290,12 +290,24 @@
:initform 0)
(values
:binary-type #.(* 4 +movitz-multiple-values-limit+))
- (malloc-pointer-words
+ (get-cons-pointer
:binary-type code-vector-word
+ :initform nil
:map-binary-write 'movitz-intern-code-vector
:map-binary-read-delayed 'movitz-word-code-vector
:binary-tag :primitive-function)
- (malloc-non-pointer-words
+ (cons-commit
+ :binary-type code-vector-word
+ :initform nil
+ :map-binary-write 'movitz-intern-code-vector
+ :map-binary-read-delayed 'movitz-word-code-vector
+ :binary-tag :primitive-function)
+ (get-cons-pointer-non-pointer
+ :binary-type code-vector-word
+ :map-binary-write 'movitz-intern-code-vector
+ :map-binary-read-delayed 'movitz-word-code-vector
+ :binary-tag :primitive-function)
+ (cons-commit-non-pointer
:binary-type code-vector-word
:map-binary-write 'movitz-intern-code-vector
:map-binary-read-delayed 'movitz-word-code-vector
@@ -438,11 +450,13 @@
(segment-descriptor-7
:binary-type segment-descriptor
:initform (make-segment-descriptor))
- (scratch0 ; A non-GC-root scratch register
+ (raw-scratch0 ; A non-GC-root scratch register
:binary-type lu32
:initform 0)
(non-pointers-end :binary-type :label) ; ========= NON-POINTER-END =======
-
+ (scratch1
+ :binary-type word
+ :initform 0)
(atomically-status
:binary-type (define-bitfield atomically-status (lu32)
(((:enum :byte (3 2))
@@ -456,19 +470,7 @@
:initform '(:inactive))
(atomically-esp
:binary-type lu32
- :initform 0)
- (get-cons-pointer
- :binary-type code-vector-word
- :initform nil
- :map-binary-write 'movitz-intern-code-vector
- :map-binary-read-delayed 'movitz-word-code-vector
- :binary-tag :primitive-function)
- (cons-commit
- :binary-type code-vector-word
- :initform nil
- :map-binary-write 'movitz-intern-code-vector
- :map-binary-read-delayed 'movitz-word-code-vector
- :binary-tag :primitive-function))
+ :initform 0))
(:slot-align null-symbol -5))
(defun atomically-status-simple-pf (pf-name reset-status-p &rest registers)
@@ -937,7 +939,7 @@
(assert (file-position stream 512) () ; leave room for bootblock.
"Couldn't set file-position for ~W." (pathname stream))
(let* ((stack-vector (make-instance 'movitz-basic-vector
- :num-elements #x2ffe
+ :num-elements #x3ffe
:fill-pointer 0
:symbolic-data nil
:element-type :u32))
Index: movitz/procfs-image.lisp
diff -u movitz/procfs-image.lisp:1.18 movitz/procfs-image.lisp:1.19
--- movitz/procfs-image.lisp:1.18 Mon Aug 30 16:59:23 2004
+++ movitz/procfs-image.lisp Wed Sep 15 12:22:52 2004
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Created at: Fri Aug 24 11:39:37 2001
;;;;
-;;;; $Id: procfs-image.lisp,v 1.18 2004/08/30 14:59:23 ffjeld Exp $
+;;;; $Id: procfs-image.lisp,v 1.19 2004/09/15 10:22:52 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -196,6 +196,7 @@
(null
(write-string "?")
(let* ((eax (get-word (+ (* 4 (interrupt-frame-index :eax)) stack-frame)))
+ (ebx (get-word (+ (* 4 (interrupt-frame-index :ebx)) stack-frame)))
(ecx (get-word (+ (* 4 (interrupt-frame-index :ecx)) stack-frame)))
(edx (get-word (+ (* 4 (interrupt-frame-index :edx)) stack-frame)))
(edi (get-word (+ (* 4 (interrupt-frame-index :edi)) stack-frame)))
@@ -203,9 +204,9 @@
(esi (get-word (+ (* 4 (interrupt-frame-index :esi)) stack-frame)))
(exception (get-word (+ (* 4 (interrupt-frame-index :exception-vector))
stack-frame))))
- (format t "#x~X {EAX: #x~X, ECX: #x~X, EDX: #x~X, EDI: #x~X, ESI: #x~X, EIP: #x~X, exception ~D}"
+ (format t "#x~X {EAX: #x~X, EBX: #x~X, ECX: #x~X, EDX: #x~X, EDI: #x~X, ESI: #x~X, EIP: #x~X, exception ~D}"
stack-frame
- eax ecx edx edi esi eip exception)))
+ eax ebx ecx edx edi esi eip exception)))
(movitz-symbol
(let ((name (movitz-print movitz-name)))
(when print-frames
Index: movitz/special-operators-cl.lisp
diff -u movitz/special-operators-cl.lisp:1.22 movitz/special-operators-cl.lisp:1.23
--- movitz/special-operators-cl.lisp:1.22 Thu Sep 2 11:27:32 2004
+++ movitz/special-operators-cl.lisp Wed Sep 15 12:22: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.22 2004/09/02 09:27:32 ffjeld Exp $
+;;;; $Id: special-operators-cl.lisp,v 1.23 2004/09/15 10:22:52 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -1182,15 +1182,10 @@
`((:pushl :ebp) ; push stack frame
(:locally (:movl :esp (:edi (:edi-offset dynamic-env))))) ; install catch
body-code
- `((:popl :ebp) ; This value is identical to current EBP.
- ,exit-point
- (:leal (:esp ,(+ -8 16)) :esp))
- (if (not *compiler-produce-defensive-code*)
- `((:locally (:popl (:edi (:edi-offset dynamic-env)))))
- `((:xchgl :ecx (:esp))
- (:locally (:bound (:edi (:edi-offset stack-bottom)) :ecx))
- (:locally (:movl :ecx (:edi (:edi-offset dynamic-env))))
- (:popl :ecx)))))))
+ `(,exit-point
+ (:popl :ebp)
+ (:leal (:esp 8) :esp) ; Skip catch-tag and jumper
+ (:locally (:popl (:edi (:edi-offset dynamic-env)))))))))
(define-special-operator unwind-protect (&all all &form form &env env)
(destructuring-bind (protected-form &body cleanup-forms)
Index: movitz/special-operators.lisp
diff -u movitz/special-operators.lisp:1.37 movitz/special-operators.lisp:1.38
--- movitz/special-operators.lisp:1.37 Thu Sep 2 11:27:38 2004
+++ movitz/special-operators.lisp Wed Sep 15 12:22:52 2004
@@ -8,7 +8,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Created at: Fri Nov 24 16:22:59 2000
;;;;
-;;;; $Id: special-operators.lisp,v 1.37 2004/09/02 09:27:38 ffjeld Exp $
+;;;; $Id: special-operators.lisp,v 1.38 2004/09/15 10:22:52 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -1199,16 +1199,23 @@
)))) ; save dynamic-slot in EBP
;; now outside of m-v-prog1's cloak, with final dynamic-slot in ESP..
;; ..unwind it and transfer control.
- `((:load-lexical ,dynamic-slot-binding :ebp)
- (:leave)
- (:movl (:ebp -4) :esi)
- (:movl (:esp 4) :edx)
- ;; (:halt)
+ ;;
+ ;; * 12 dynamic-env uplink
+ ;; * 8 target jumper number
+ ;; * 4 target catch tag
+ ;; * 0 target EBP
+;;; `((:load-lexical ,dynamic-slot-binding :edx)
+;;; ())
+ `((:load-lexical ,dynamic-slot-binding :edx)
+ (:locally (:movl :esi (:edi (:edi-offset scratch1))))
+ (:movl :edx :esp) ; enter non-local jump stack mode.
+
+ (:movl (:esp) :edx) ; target stack-frame EBP
+ (:movl (:edx -4) :esi) ; get target funobj into EDX
+
+ (:movl (:esp 8) :edx) ; target jumper number
(:jmp (:esi :edx ,(slot-offset 'movitz-funobj 'constant0))))))))))
-;;; (:leal (:esp 8) :esp) ; skip tag and eip
-;;; (:locally (:popl (:edi (:edi-offset dynamic-env)))) ; unwind dynamic env
-;;; (:jmp (:esp -8))))))))
(define-special-operator muerte::with-basic-restart (&all defaults &form form &env env)
(destructuring-bind ((name function interactive test format-control
@@ -1284,8 +1291,9 @@
:result-mode :multiple-values
:with-stack-used entry-size
:form body)
- `((:leal (:esp ,(+ -12 (* 4 entry-size))) :esp)
+ `((:leal (:esp ,(+ -12 -4 (* 4 entry-size))) :esp)
,exit-point
- (:leal (:esp ,(+ -8 16)) :esp)
+ (:popl :ebp)
+ (:leal (:esp 8) :esp)
(:locally (:popl (:edi (:edi-offset dynamic-env))))
)))))))
Index: movitz/storage-types.lisp
diff -u movitz/storage-types.lisp:1.39 movitz/storage-types.lisp:1.40
--- movitz/storage-types.lisp:1.39 Thu Aug 19 00:32:53 2004
+++ movitz/storage-types.lisp Wed Sep 15 12:22:52 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.39 2004/08/18 22:32:53 ffjeld Exp $
+;;;; $Id: storage-types.lisp,v 1.40 2004/09/15 10:22:52 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -58,9 +58,14 @@
:odd-fixnum 4
:cons 1
:character 2
+ :tag0 0
+ :tag1 1
:tag2 2
:tag3 3 ; unused
:tag4 4
+ :tag5 5
+ :tag6 6
+ :tag7 7
;; :immediate 4
:null 5
:other 6
@@ -72,7 +77,7 @@
:bignum #x4a
:ratio #x52
:complex #x5a
- :defstruct #x20
+ :defstruct #x2a
:std-instance #x40
:run-time-context #x50
:illegal #x13
@@ -1171,12 +1176,6 @@
(make-instance 'movitz-std-instance
:class (movitz-read class)
:slots slots))
-
-;;;(defmethod write-binary-record ((obj movitz-std-instance) stream)
-;;; (+ (write-binary 'word stream (movitz-intern (movitz-std-instance-class obj)))
-;;; (let ((slots (movitz-read (movitz-std-instance-slots obj))))
-;;; (assert (typep slots 'movitz-vector))
-;;; (write-binary 'word stream (movitz-intern slots)))))
(defmethod print-object ((object movitz-std-instance) stream)
(print-unreadable-object (object stream :identity t)
More information about the Movitz-cvs
mailing list