January 2017 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][master] 2 commits: Update docstring for REQUIRE
by Raymond Toy 29 Jan '17

29 Jan '17

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 28feabb4 by Raymond Toy at 2017-01-29T09:00:49-08:00 Update docstring for REQUIRE Include a list of the builtin modules supported by cmucl to the docstring. - - - - - f8d120c1 by Raymond Toy at 2017-01-29T09:00:49-08:00 Regenerated - - - - - 4 changed files: - src/code/module.lisp - src/i18n/locale/cmucl.pot - src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po - src/i18n/locale/ko/LC_MESSAGES/cmucl.po Changes: ===================================== src/code/module.lisp ===================================== --- a/src/code/module.lisp +++ b/src/code/module.lisp @@ -91,7 +91,17 @@ calling PROVIDE to indicate a successful load of the module. While loading any files, *load-verbose* is bound to *require-verbose* - which defaults to t." + which defaults to t. + + The predefined modules included are :defsystem, :asdf, :lisp-unit, + :unix, :clx, :clm, :hemlock, and :cmu-contribs. + + The module :cmu-contribs differs from the other modules in that + requiring this module only defines the following modules: + \"contrib-demos\", \"contrib-follow-mouse\", + \"contrib-games-feebs\", \"contrib-hist\", \"contrib-psgraph\", + \"contrib-ops\", \"contrib-embedded-c\", \"contrib-sprof\", and + \"contrib-packed-sse2\". " (let ((saved-modules (copy-list *modules*)) (module-name (module-name-string module-name))) (unless (member module-name *modules* :test #'string=) ===================================== src/i18n/locale/cmucl.pot ===================================== --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -10397,7 +10397,17 @@ msgid "" " calling PROVIDE to indicate a successful load of the module.\n" "\n" " While loading any files, *load-verbose* is bound to *require-verbose*\n" -" which defaults to t." +" which defaults to t.\n" +"\n" +" The predefined modules included are :defsystem, :asdf, :lisp-unit,\n" +" :unix, :clx, :clm, :hemlock, and :cmu-contribs.\n" +"\n" +" The module :cmu-contribs differs from the other modules in that\n" +" requiring this module only defines the following modules:\n" +" \"contrib-demos\", \"contrib-follow-mouse\",\n" +" \"contrib-games-feebs\", \"contrib-hist\", \"contrib-psgraph\",\n" +" \"contrib-ops\", \"contrib-embedded-c\", \"contrib-sprof\", and\n" +" \"contrib-packed-sse2\". " msgstr "" #: src/code/module.lisp ===================================== src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po ===================================== --- a/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po +++ b/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po @@ -14850,6 +14850,7 @@ msgstr "" " asecay-ensitivesay." #: src/code/module.lisp +#, fuzzy msgid "" "Loads a module when it has not been already. Pathname, if\n" " supplied, is a single pathname or list of pathnames to be loaded if\n" @@ -14872,7 +14873,17 @@ msgid "" " calling PROVIDE to indicate a successful load of the module.\n" "\n" " While loading any files, *load-verbose* is bound to *require-verbose*\n" -" which defaults to t." +" which defaults to t.\n" +"\n" +" The predefined modules included are :defsystem, :asdf, :lisp-unit,\n" +" :unix, :clx, :clm, :hemlock, and :cmu-contribs.\n" +"\n" +" The module :cmu-contribs differs from the other modules in that\n" +" requiring this module only defines the following modules:\n" +" \"contrib-demos\", \"contrib-follow-mouse\",\n" +" \"contrib-games-feebs\", \"contrib-hist\", \"contrib-psgraph\",\n" +" \"contrib-ops\", \"contrib-embedded-c\", \"contrib-sprof\", and\n" +" \"contrib-packed-sse2\". " msgstr "" "Oadslay away odulemay enwhay itway ashay otnay eenbay alreadyway. " "Athnamepay, ifway\n" ===================================== src/i18n/locale/ko/LC_MESSAGES/cmucl.po ===================================== --- a/src/i18n/locale/ko/LC_MESSAGES/cmucl.po +++ b/src/i18n/locale/ko/LC_MESSAGES/cmucl.po @@ -10422,7 +10422,17 @@ msgid "" " calling PROVIDE to indicate a successful load of the module.\n" "\n" " While loading any files, *load-verbose* is bound to *require-verbose*\n" -" which defaults to t." +" which defaults to t.\n" +"\n" +" The predefined modules included are :defsystem, :asdf, :lisp-unit,\n" +" :unix, :clx, :clm, :hemlock, and :cmu-contribs.\n" +"\n" +" The module :cmu-contribs differs from the other modules in that\n" +" requiring this module only defines the following modules:\n" +" \"contrib-demos\", \"contrib-follow-mouse\",\n" +" \"contrib-games-feebs\", \"contrib-hist\", \"contrib-psgraph\",\n" +" \"contrib-ops\", \"contrib-embedded-c\", \"contrib-sprof\", and\n" +" \"contrib-packed-sse2\". " msgstr "" #: src/code/module.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/005cf1790526bc501c40c7e1…

1 0

[Git][cmucl/cmucl][sparc64-dev] 2 commits: Hack fix for compute-code-from-fn
by Raymond Toy 21 Jan '17

21 Jan '17

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/0661784461fda653dfb2fc15…

1 0

[Git][cmucl/cmucl][sparc64-dev] 6 commits: WIP: Add support for not-implmeented
by Raymond Toy 20 Jan '17

20 Jan '17

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 794b815a by Raymond Toy at 2017-01-17T20:33:48-08:00 WIP: Add support for not-implmeented Add support for not-implemented trap where a VOP can mark itself as not implemented. This causes a illtrap instruction to be inserted followed by a branch always followed by a string (not necessarily nul terminated) that represents the name of the VOP. The signal handler currently catches the signal and sends prints out the string and then continues. Not yet debugged and definitely does not yet work. We're just saving this in safe place for now. - - - - - 155b792b by Raymond Toy at 2017-01-17T20:34:36-08:00 Registers are longs, not ints. Fixes a couple of compiler warnings. - - - - - 87731e87 by Raymond Toy at 2017-01-17T20:35:03-08:00 Add EMIT-NOT-IMPLEMENTED in a few interesting vops. - - - - - 67a3752d by Raymond Toy at 2017-01-18T19:29:29-08:00 Don't allow scheduling of not-implemented. We want everything here to be emitted in exactly this way. - - - - - 3f4030a7 by Raymond Toy at 2017-01-18T20:50:48-08:00 Bump the start of the object-not- enum This was overlapping the trap- enum. - - - - - 06617844 by Raymond Toy at 2017-01-18T20:53:28-08:00 Correct the implementation of the not-implmeented handler. The location of the string was off by one word and the length was incorrectly calculated because we have a 19-bit word displacement for the ba,pt instruction. - - - - - 8 changed files: - src/compiler/backend.lisp - src/compiler/meta-vmdef.lisp - src/compiler/sparc64/call.lisp - src/compiler/sparc64/insts.lisp - src/compiler/sparc64/move.lisp - src/compiler/sparc64/parms.lisp - src/lisp/solaris-os.c - src/lisp/sparc-arch.c Changes: ===================================== src/compiler/backend.lisp ===================================== --- a/src/compiler/backend.lisp +++ b/src/compiler/backend.lisp @@ -114,6 +114,24 @@ (backend-support-routines *target-backend*)) #',local-name)))) +(defmacro def-vm-support-routine (name ll &body body) + (unless (member (intern (string name) (find-package "C")) + vm-support-routines) + (warn (intl:gettext "Unknown VM support routine: ~A") name)) + (let ((local-name (symbolicate (backend-name *target-backend*) "-" name))) + `(progn + (defun ,local-name + ,ll + (macrolet ((vm::emit-not-implemented () + `(vm::not-implemented ,',local-name))) + ,@body)) + (setf (,(intern (concatenate 'simple-string + "VM-SUPPORT-ROUTINES-" + (string name)) + (find-package "C")) + (backend-support-routines *target-backend*)) + #',local-name)))) + ;;;; The backend structure. ===================================== src/compiler/meta-vmdef.lisp ===================================== --- a/src/compiler/meta-vmdef.lisp +++ b/src/compiler/meta-vmdef.lisp @@ -937,8 +937,10 @@ ,@(binds)) (declare (ignore ,@(vop-parse-ignores parse))) ,@(loads) - (new-assem:assemble (*code-segment* ,n-vop) - ,@(vop-parse-body parse)) + (macrolet ((vm::emit-not-implemented () + `(vm::not-implemented ,',(vop-parse-name parse)))) + (new-assem:assemble (*code-segment* ,n-vop) + ,@(vop-parse-body parse))) ,@(saves)))))) ===================================== src/compiler/sparc64/call.lisp ===================================== --- a/src/compiler/sparc64/call.lisp +++ b/src/compiler/sparc64/call.lisp @@ -179,6 +179,9 @@ (dotimes (i (1- vm:function-code-offset)) (inst word 0) (inst word 0)) + + (emit-not-implemented) + ;; The start of the actual code. ;; Fix CODE, cause the function object was passed in. (inst compute-code-from-fn code-tn code-tn start-lab temp) ===================================== src/compiler/sparc64/insts.lisp ===================================== --- a/src/compiler/sparc64/insts.lisp +++ b/src/compiler/sparc64/insts.lisp @@ -1534,6 +1534,31 @@ about function addresses and register values.") (sc-offsets) (lengths)))))))) +(defun snarf-not-implemented-name (stream dstate) + (let* ((sap (disassem:dstate-segment-sap dstate)) + (offset (disassem:dstate-next-offs dstate)) + (branch-inst (sys:sap-ref-32 sap offset))) + ;; sap + offset should point to the branch instruction after the + ;; illtrap (unimp) instruction. Make sure it's an unconditional + ;; branch instrution. + #+nil + (unless (= (ldb (byte 8 24) branch-inst) #xea) + (return-from snarf-not-implemented-name "")) + ;; From the offset in the branch instruction, compute the max + ;; length of the string that was encoded. + (let ((max-length (+ (ash (ldb (byte 24 0) branch-inst) 2) 4))) + ;; Skip the branch instruction + (incf offset 4) + ;; Print each following byte until max-length is reached or we + ;; get a 0 byte. + (with-output-to-string (s) + (do* ((k 0 (+ k 1)) + (octet (sys:sap-ref-8 sap (+ offset k)) + (sys:sap-ref-8 sap (+ offset k)))) + ((or (>= k max-length) + (zerop octet))) + (write-char (code-char octet) s)))))) + (defun unimp-control (chunk inst stream dstate) (declare (ignore inst)) (flet ((nt (x) (if stream (disassem:note x dstate)))) @@ -1556,6 +1581,10 @@ about function addresses and register values.") (nt "Function end breakpoint trap")) (#.vm:object-not-instance-trap (nt "Object not instance trap")) + (#.vm::not-implemented-trap + (nt (concatenate 'string + "Not-implemented trap: " + (snarf-not-implemented-name stream dstate)))) ))) (eval-when (compile load eval) @@ -2252,6 +2281,26 @@ about function addresses and register values.") +(defmacro not-implemented (&optional name) + (let ((string (string name))) + `(let ((length-label (gen-label))) + (new-assem:without-scheduling () + (inst unimp not-implemented-trap) + ;; NOTE: The branch offset helps estimate the length of the + ;; string. The actual length of the string may be equal to the + ;; displacement or it may be up to three bytes shorter at the + ;; first trailing NUL byte. The string may or may not be + ;; 0-terminated. + (inst b length-label) + (inst nop) + ,@(map 'list #'(lambda (c) + `(inst byte ,(char-code c))) + string) + ;; Append enough zeros to end on a word boundary. + ,@(make-list (mod (- (length string)) 4) + :initial-element '(inst byte 0)) + (emit-label length-label))))) + ;;;; Instructions for dumping data and header objects. (define-instruction word (segment word) ===================================== src/compiler/sparc64/move.lisp ===================================== --- a/src/compiler/sparc64/move.lisp +++ b/src/compiler/sparc64/move.lisp @@ -74,6 +74,7 @@ (define-move-function (store-stack 5) (vop x y) ((any-reg descriptor-reg) (control-stack)) + (not-implemented "DEFINE-MOVE STORE-STACK") (store-stack-tn y x)) (define-move-function (store-number-stack 5) (vop x y) ===================================== src/compiler/sparc64/parms.lisp ===================================== --- a/src/compiler/sparc64/parms.lisp +++ b/src/compiler/sparc64/parms.lisp @@ -243,6 +243,7 @@ after-breakpoint-trap allocation-trap pseudo-atomic-trap object-not-list-trap object-not-instance-trap + not-implemented-trap trace-table-normal trace-table-call-site trace-table-function-prologue trace-table-function-epilogue)) @@ -263,10 +264,11 @@ dynamic-space-overflow-warning #+heap-overflow-check dynamic-space-overflow-error + not-implemented ) ;; Make sure this starts AFTER the last element of the above enum! -(defenum (:prefix object-not- :suffix -trap :start 16) +(defenum (:prefix object-not- :suffix -trap :start 20) list instance) ===================================== src/lisp/solaris-os.c ===================================== --- a/src/lisp/solaris-os.c +++ b/src/lisp/solaris-os.c @@ -315,7 +315,7 @@ long * solaris_register_address(struct ucontext *context, int reg) { if (reg == 0) { - static int zero; + static long zero; zero = 0; @@ -323,7 +323,7 @@ solaris_register_address(struct ucontext *context, int reg) } else if (reg < 16) { return &context->uc_mcontext.gregs[reg + 3]; } else if (reg < 32) { - int *sp = (int *) context->uc_mcontext.gregs[REG_SP]; + long *sp = (long *) context->uc_mcontext.gregs[REG_SP]; return &sp[reg - 16]; } else ===================================== src/lisp/sparc-arch.c ===================================== --- a/src/lisp/sparc-arch.c +++ b/src/lisp/sparc-arch.c @@ -510,6 +510,53 @@ sigill_handler(HANDLER_ARGS) os_context); break; #endif +#ifdef trap_NotImplemented + case trap_NotImplemented: + { + /* + * Print out the name. The next instruction MUST be a + * branch immediate. + */ + unsigned char *string; + int length; + + /* + * Compute the maximum length of the string from the + * offset in the branch instruction. This code assumes + * a ba,pt instruction which has a 19-bit word offset in + * the low part of the instruction. Because branches + * have a delay slot, the string starts two words past + * the branch instruction. + */ + string = (unsigned char *) &pc[3]; + /* + * The offset is in 32-bit words, so subtract one for + * the instruction in the branch delay slot and scale up + * the offet to be in bytes. + */ + length = 4 * ((pc[1] & 0x7FFFF) - 1); + + while (string[length - 1] == '\0') { + --length; + } + + /* + * Don't want to use NOT_IMPLEMENTED here because we + * don't actually want to abort. We want to continue, + * but print out a useful message. + */ + printf("NOT-IMPLEMENTED: %p: \"%.*s\"\n", pc, length, string); + + /* + * Skip over the illtrap instruction so if we can + * continue. This will execute the branch, skipping + * over the string too. + */ + SC_PC(os_context) = (unsigned long) (pc + 1); + + } + break; +#endif default: interrupt_handle_now(signal, code, os_context); break; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/585895ac72b27299e4d5dd26…

1 0

[Git][cmucl/cmucl][sparc64-dev-nyi] Correct the implementation of the not-implmeented handler.
by Raymond Toy 19 Jan '17

19 Jan '17

Raymond Toy pushed to branch sparc64-dev-nyi at cmucl / cmucl Commits: 06617844 by Raymond Toy at 2017-01-18T20:53:28-08:00 Correct the implementation of the not-implmeented handler. The location of the string was off by one word and the length was incorrectly calculated because we have a 19-bit word displacement for the ba,pt instruction. - - - - - 1 changed file: - src/lisp/sparc-arch.c Changes: ===================================== src/lisp/sparc-arch.c ===================================== --- a/src/lisp/sparc-arch.c +++ b/src/lisp/sparc-arch.c @@ -522,12 +522,19 @@ sigill_handler(HANDLER_ARGS) /* * Compute the maximum length of the string from the - * offset in the branch instruction. (The signed offset - * is in the low 22 bits of the instruction.) Then try - * to find the last nul character for end of the string. + * offset in the branch instruction. This code assumes + * a ba,pt instruction which has a 19-bit word offset in + * the low part of the instruction. Because branches + * have a delay slot, the string starts two words past + * the branch instruction. */ - string = (unsigned char *) &pc[2]; - length = (pc[1] & 0x3fffff); + string = (unsigned char *) &pc[3]; + /* + * The offset is in 32-bit words, so subtract one for + * the instruction in the branch delay slot and scale up + * the offet to be in bytes. + */ + length = 4 * ((pc[1] & 0x7FFFF) - 1); while (string[length - 1] == '\0') { --length; @@ -538,14 +545,14 @@ sigill_handler(HANDLER_ARGS) * don't actually want to abort. We want to continue, * but print out a useful message. */ - printf("NOT-IMPLEMENTED: %p: \"%.*s\"\n", pc, length, (char*)(pc + 2)); + printf("NOT-IMPLEMENTED: %p: \"%.*s\"\n", pc, length, string); /* - * Skip over the UDF instruction so if we can + * Skip over the illtrap instruction so if we can * continue. This will execute the branch, skipping * over the string too. */ - SC_PC(context) = (unsigned long) (pc + 1); + SC_PC(os_context) = (unsigned long) (pc + 1); } break; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/0661784461fda653dfb2fc155…

1 0

[Git][cmucl/cmucl][sparc64-dev-nyi] Bump the start of the object-not- enum
by Raymond Toy 19 Jan '17

19 Jan '17

Raymond Toy pushed to branch sparc64-dev-nyi at cmucl / cmucl Commits: 3f4030a7 by Raymond Toy at 2017-01-18T20:50:48-08:00 Bump the start of the object-not- enum This was overlapping the trap- enum. - - - - - 1 changed file: - src/compiler/sparc64/parms.lisp Changes: ===================================== src/compiler/sparc64/parms.lisp ===================================== --- a/src/compiler/sparc64/parms.lisp +++ b/src/compiler/sparc64/parms.lisp @@ -268,7 +268,7 @@ ) ;; Make sure this starts AFTER the last element of the above enum! -(defenum (:prefix object-not- :suffix -trap :start 16) +(defenum (:prefix object-not- :suffix -trap :start 20) list instance) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/3f4030a7724bb4b00b4c871fc…

1 0

[Git][cmucl/cmucl][sparc64-dev-nyi] 3 commits: Registers are longs, not ints.
by Raymond Toy 19 Jan '17

19 Jan '17

Raymond Toy pushed to branch sparc64-dev-nyi at cmucl / cmucl Commits: 155b792b by Raymond Toy at 2017-01-17T20:34:36-08:00 Registers are longs, not ints. Fixes a couple of compiler warnings. - - - - - 87731e87 by Raymond Toy at 2017-01-17T20:35:03-08:00 Add EMIT-NOT-IMPLEMENTED in a few interesting vops. - - - - - 67a3752d by Raymond Toy at 2017-01-18T19:29:29-08:00 Don't allow scheduling of not-implemented. We want everything here to be emitted in exactly this way. - - - - - 4 changed files: - src/compiler/sparc64/call.lisp - src/compiler/sparc64/insts.lisp - src/compiler/sparc64/move.lisp - src/lisp/solaris-os.c Changes: ===================================== src/compiler/sparc64/call.lisp ===================================== --- a/src/compiler/sparc64/call.lisp +++ b/src/compiler/sparc64/call.lisp @@ -179,6 +179,9 @@ (dotimes (i (1- vm:function-code-offset)) (inst word 0) (inst word 0)) + + (emit-not-implemented) + ;; The start of the actual code. ;; Fix CODE, cause the function object was passed in. (inst compute-code-from-fn code-tn code-tn start-lab temp) ===================================== src/compiler/sparc64/insts.lisp ===================================== --- a/src/compiler/sparc64/insts.lisp +++ b/src/compiler/sparc64/insts.lisp @@ -2284,21 +2284,22 @@ about function addresses and register values.") (defmacro not-implemented (&optional name) (let ((string (string name))) `(let ((length-label (gen-label))) - (inst unimp not-implemented-trap) - ;; NOTE: The branch offset helps estimate the length of the - ;; string. The actual length of the string may be equal to the - ;; displacement or it may be up to three bytes shorter at the - ;; first trailing NUL byte. The string may or may not be - ;; 0-terminated. - (inst b length-label) - (inst nop) - ,@(map 'list #'(lambda (c) - `(inst byte ,(char-code c))) - string) - ;; Append enough zeros to end on a word boundary. - ,@(make-list (mod (- (length string)) 4) - :initial-element '(inst byte 0)) - (emit-label length-label)))) + (new-assem:without-scheduling () + (inst unimp not-implemented-trap) + ;; NOTE: The branch offset helps estimate the length of the + ;; string. The actual length of the string may be equal to the + ;; displacement or it may be up to three bytes shorter at the + ;; first trailing NUL byte. The string may or may not be + ;; 0-terminated. + (inst b length-label) + (inst nop) + ,@(map 'list #'(lambda (c) + `(inst byte ,(char-code c))) + string) + ;; Append enough zeros to end on a word boundary. + ,@(make-list (mod (- (length string)) 4) + :initial-element '(inst byte 0)) + (emit-label length-label))))) ;;;; Instructions for dumping data and header objects. ===================================== src/compiler/sparc64/move.lisp ===================================== --- a/src/compiler/sparc64/move.lisp +++ b/src/compiler/sparc64/move.lisp @@ -74,6 +74,7 @@ (define-move-function (store-stack 5) (vop x y) ((any-reg descriptor-reg) (control-stack)) + (not-implemented "DEFINE-MOVE STORE-STACK") (store-stack-tn y x)) (define-move-function (store-number-stack 5) (vop x y) ===================================== src/lisp/solaris-os.c ===================================== --- a/src/lisp/solaris-os.c +++ b/src/lisp/solaris-os.c @@ -315,7 +315,7 @@ long * solaris_register_address(struct ucontext *context, int reg) { if (reg == 0) { - static int zero; + static long zero; zero = 0; @@ -323,7 +323,7 @@ solaris_register_address(struct ucontext *context, int reg) } else if (reg < 16) { return &context->uc_mcontext.gregs[reg + 3]; } else if (reg < 32) { - int *sp = (int *) context->uc_mcontext.gregs[REG_SP]; + long *sp = (long *) context->uc_mcontext.gregs[REG_SP]; return &sp[reg - 16]; } else View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/794b815a0d6952170eb13687…

1 0

[Git][cmucl/cmucl] Pushed new branch sparc64-dev-nyi
by Raymond Toy 18 Jan '17

18 Jan '17

Raymond Toy pushed new branch sparc64-dev-nyi at cmucl / cmucl

1 0

[Git][cmucl/cmucl] Pushed new tag sparc64-dev-checkpoint-5
by Raymond Toy 15 Jan '17

15 Jan '17

Raymond Toy pushed new tag sparc64-dev-checkpoint-5 at cmucl / cmucl

1 0

[Git][cmucl/cmucl][sparc64-dev] Pad data block sizes to 16-byte boundary.
by Raymond Toy 15 Jan '17

15 Jan '17

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 585895ac by Raymond Toy at 2017-01-15T08:42:11-08:00 Pad data block sizes to 16-byte boundary. Data blocks are padded to double-word boundaries which is 16 bytes for sparc64. This also means telling new-genesis round up by 16 bytes in allocate-descriptor. Adjust string-to-core for 64-bit objects too. At this point, the static symbols appear to print out correctly (as determined by call print (in the lisp monitor). Some objects, such as *fp-constant-0d0* however appear to be incorrect. The value pointer appears to be a double-float but the object is messed up. But maybe this is caused by a buggy print function. - - - - - 2 changed files: - src/compiler/generic/new-genesis.lisp - src/compiler/generic/vm-macs.lisp Changes: ===================================== src/compiler/generic/new-genesis.lisp ===================================== --- a/src/compiler/generic/new-genesis.lisp +++ b/src/compiler/generic/new-genesis.lisp @@ -148,7 +148,7 @@ "Return a descriptor for a block of LENGTH bytes out of SPACE. The free pointer is boosted as necessary. If any additional memory is needed, we vm_allocate it. The descriptor returned is a pointer of type LOWTAG." - (let* ((bytes (round-up length #+amd64 16 #-amd64 (ash 1 vm:lowtag-bits))) + (let* ((bytes (round-up length (* 2 vm:word-bytes))) (offset (space-free-pointer space)) (new-free-ptr (+ offset (ash bytes (- vm:word-shift))))) (when (> new-free-ptr (space-words-allocated space)) @@ -462,9 +462,12 @@ (copy-to-system-area bytes (* vm:vector-data-offset ;; the word size of the native backend which ;; may be different from the target backend - (if (= (c:backend-fasl-file-implementation - c::*native-backend*) - #.c:amd64-fasl-file-implementation) + (if (or (= (c:backend-fasl-file-implementation + c::*native-backend*) + #.c:amd64-fasl-file-implementation) + (= (c:backend-fasl-file-implementation + c::*native-backend*) + #.c:sparc64-fasl-file-implementation)) 64 32)) (descriptor-sap des) ===================================== src/compiler/generic/vm-macs.lisp ===================================== --- a/src/compiler/generic/vm-macs.lisp +++ b/src/compiler/generic/vm-macs.lisp @@ -27,8 +27,9 @@ ;;; given a number of words. ;;; (defmacro pad-data-block (words) - `(logandc2 (+ (ash ,words word-shift) #+amd64 15 #-amd64 lowtag-mask) - #+amd64 15 #-amd64 lowtag-mask)) + (let ((dual-word-mask (1- (ash 2 word-shift)))) + `(logandc2 (+ (ash ,words word-shift) ,dual-word-mask) + ,dual-word-mask))) ;;; DEFENUM -- Internal Interface. ;;; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/585895ac72b27299e4d5dd269…

1 0

[Git][cmucl/cmucl][sparc64-dev] Fix bad stack offsets
by Raymond Toy 13 Jan '17

13 Jan '17

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: c94b80e3 by Raymond Toy at 2017-01-12T19:34:29-08:00 Fix bad stack offsets Was storing code-tn at the wrong stack slot and also storing the return address offset in the wrong stack slot. - - - - - 1 changed file: - src/lisp/sparc64-assem.S Changes: ===================================== src/lisp/sparc64-assem.S ===================================== --- a/src/lisp/sparc64-assem.S +++ b/src/lisp/sparc64-assem.S @@ -157,7 +157,7 @@ call_into_c: mov reg_CSP, reg_CFP add reg_CSP, 64, reg_CSP stn reg_OCFP, [reg_CFP] - stn reg_CODE, [reg_CFP+8] + stn reg_CODE, [reg_CFP+2*8] /* Turn on pseudo-atomic. */ or reg_ALLOC, pseudo_atomic_Value, reg_ALLOC @@ -165,7 +165,7 @@ call_into_c: /* Convert the return address to an offset and save it on the stack. */ sub reg_LIP, reg_CODE, reg_L0 add reg_L0, type_OtherPointer, reg_L0 - stn reg_L0, [reg_CFP+2*8] + stn reg_L0, [reg_CFP+8] /* Store LISP state */ store(reg_BSP,current_binding_stack_pointer) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/c94b80e39f6a6f341b692b8ea…

1 0