[Git][cmucl/cmucl][sparc64-dev] 2 commits: Hack fix for compute-code-from-fn

[Raymond Toy]

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl


Commits:
1d74bf8d by Raymond Toy at 2017-01-21T08:36:22-08:00
Hack fix for compute-code-from-fn

component-header-length returns a value that is off by half, even
after explicitly telling to shift by 3 instead of 2.  So, do the extra
shift here for now.

This needs to be fixed!

- - - - -
58c09b81 by Raymond Toy at 2017-01-21T08:37:02-08:00
Mark more vops so we can stop and check the generated code.

- - - - -


6 changed files:

- src/compiler/sparc64/call.lisp
- src/compiler/sparc64/cell.lisp
- src/compiler/sparc64/insts.lisp
- src/compiler/sparc64/memory.lisp
- src/compiler/sparc64/move.lisp
- src/compiler/sparc64/print.lisp


Changes:

=====================================
src/compiler/sparc64/call.lisp
=====================================
--- a/src/compiler/sparc64/call.lisp
+++ b/src/compiler/sparc64/call.lisp
@@ -171,6 +171,7 @@
     ;; Make sure the function is aligned, and drop a label pointing to this
     ;; function header.
     (align vm:lowtag-bits)
+    (emit-not-implemented)
     (trace-table-entry trace-table-function-prologue)
     (emit-label start-lab)
     ;; Allocate function header.
@@ -262,6 +263,7 @@
   (:info nargs)
   (:results (res :scs (any-reg)))
   (:generator 2
+    (emit-not-implemented)
     (when (> nargs register-arg-count)
       (move res csp-tn)
       (inst add csp-tn csp-tn (* nargs vm:word-bytes)))))
@@ -774,6 +776,7 @@ default-value-8
 		     15
 		     (if (eq return :unknown) 25 0))
        (trace-table-entry trace-table-call-site)
+       (emit-not-implemented)
        (let* ((cur-nfp (current-nfp-tn vop))
 	      ,@(unless (eq return :tail)
 		  '((lra-label (gen-label))))
@@ -1271,6 +1274,7 @@ default-value-8
   (:vop-var vop)
   (:save-p :compute-only)
   (:generator 3
+    (emit-not-implemented)
     (let ((err-lab
 	   (generate-error-code vop invalid-argument-count-error nargs)))
       (inst cmp nargs (fixnumize count))


=====================================
src/compiler/sparc64/cell.lisp
=====================================
--- a/src/compiler/sparc64/cell.lisp
+++ b/src/compiler/sparc64/cell.lisp
@@ -83,6 +83,7 @@
 (define-vop (boundp boundp-frob)
   (:translate boundp)
   (:generator 9
+    (emit-not-implemented)
     (loadw value object vm:symbol-value-slot vm:other-pointer-type)
     (inst cmp value vm:unbound-marker-type)
     (inst b (if not-p :eq :ne) target)


=====================================
src/compiler/sparc64/insts.lisp
=====================================
--- a/src/compiler/sparc64/insts.lisp
+++ b/src/compiler/sparc64/insts.lisp
@@ -2384,7 +2384,12 @@ about function addresses and register values.")
 			  (- other-pointer-type
 			     function-pointer-type
 			     (label-position label posn delta-if-after)
-			     (component-header-length))))))
+			     ;; FIXME: component-header-length (and
+			     ;; maybe label-position?) return thw
+			     ;; wrong number of bytes.  We need to
+			     ;; shift left by 1 because our words are
+			     ;; 64 bits long and not 32.
+			     (ash (component-header-length) 1))))))
 
 ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
 (define-instruction compute-code-from-lra (segment dst src label temp)


=====================================
src/compiler/sparc64/memory.lisp
=====================================
--- a/src/compiler/sparc64/memory.lisp
+++ b/src/compiler/sparc64/memory.lisp
@@ -36,6 +36,7 @@
   (:variant-vars offset lowtag)
   (:policy :fast-safe)
   (:generator 4
+    (emit-not-implemented)
     (storew value object offset lowtag)))
 
 ;;; Slot-Ref and Slot-Set are used to define VOPs like Closure-Ref, where the


=====================================
src/compiler/sparc64/move.lisp
=====================================
--- a/src/compiler/sparc64/move.lisp
+++ b/src/compiler/sparc64/move.lisp
@@ -25,6 +25,7 @@
   ((null immediate zero)
    (any-reg descriptor-reg))
   (let ((val (tn-value x)))
+    (not-implemented "LOAD-IMMEDIATE")
     (etypecase val
       (integer
        (inst li y (fixnumize val)))
@@ -121,6 +122,7 @@
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:results (y))
   (:generator 0
+    (emit-not-implemented)
     (sc-case y
       ((any-reg descriptor-reg)
        (move y x))


=====================================
src/compiler/sparc64/print.lisp
=====================================
--- a/src/compiler/sparc64/print.lisp
+++ b/src/compiler/sparc64/print.lisp
@@ -30,6 +30,7 @@
   (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
   (:vop-var vop)
   (:generator 100
+    (emit-not-implemented)
     (let ((cur-nfp (current-nfp-tn vop)))
       (when cur-nfp
 	(store-stack-tn nfp-save cur-nfp))



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/0661784461fda653dfb2fc155c6e7cf89e46fbbc...58c09b81fba6e4317a4338ecf646badb2de88c98
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20170121/db6d9d0c/attachment-0001.html>