X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Faliencomp.lisp;h=89771f2ebeb6acc86bab51fc74f69f0f3355aa29;hb=16a6592367eec7c5e9da668ec42fd260e7705b0c;hp=5ff94274b2120d8c146061843b9aa481611d66a7;hpb=ad5cd2538240a4283cb4498b21ff7ab23adcde92;p=sbcl.git diff --git a/src/compiler/aliencomp.lisp b/src/compiler/aliencomp.lisp index 5ff9427..89771f2 100644 --- a/src/compiler/aliencomp.lisp +++ b/src/compiler/aliencomp.lisp @@ -346,11 +346,11 @@ (/noshow (local-alien-info-force-to-memory-p info)) (/noshow alien-type (unparse-alien-type alien-type) (alien-type-bits alien-type)) (if (local-alien-info-force-to-memory-p info) - #!+x86 `(truly-the system-area-pointer + #!+(or x86 x86-64) `(truly-the system-area-pointer (%primitive alloc-alien-stack-space ,(ceiling (alien-type-bits alien-type) sb!vm:n-byte-bits))) - #!-x86 `(truly-the system-area-pointer + #!-(or x86 x86-64) `(truly-the system-area-pointer (%primitive alloc-number-stack-space ,(ceiling (alien-type-bits alien-type) sb!vm:n-byte-bits))) @@ -434,10 +434,10 @@ (let* ((info (lvar-value info)) (alien-type (local-alien-info-type info))) (if (local-alien-info-force-to-memory-p info) - #!+x86 `(%primitive dealloc-alien-stack-space + #!+(or x86 x86-64) `(%primitive dealloc-alien-stack-space ,(ceiling (alien-type-bits alien-type) sb!vm:n-byte-bits)) - #!-x86 `(%primitive dealloc-number-stack-space + #!-(or x86 x86-64) `(%primitive dealloc-number-stack-space ,(ceiling (alien-type-bits alien-type) sb!vm:n-byte-bits)) nil))) @@ -521,7 +521,7 @@ (count-low-order-zeros (lvar-uses thing)))) (combination (case (let ((name (lvar-fun-name (combination-fun thing)))) - (or (modular-version-info name) name)) + (or (modular-version-info name :unsigned) name)) ((+ -) (let ((min most-positive-fixnum) (itype (specifier-type 'integer))) @@ -578,7 +578,7 @@ (give-up-ir1-transform)) (let ((inside-fun-name (lvar-fun-name (combination-fun value-node)))) (multiple-value-bind (prototype width) - (modular-version-info inside-fun-name) + (modular-version-info inside-fun-name :unsigned) (unless (eq (or prototype inside-fun-name) 'ash) (give-up-ir1-transform)) (when (and width (not (constant-lvar-p amount))) @@ -678,19 +678,19 @@ (let* ((arg (pop args)) (sc (tn-sc tn)) (scn (sc-number sc)) - #!-x86 (temp-tn (make-representation-tn (tn-primitive-type tn) + #!-(or x86 x86-64) (temp-tn (make-representation-tn (tn-primitive-type tn) scn)) (move-arg-vops (svref (sc-move-arg-vops sc) scn))) (aver arg) (unless (= (length move-arg-vops) 1) (error "no unique move-arg-vop for moves in SC ~S" (sc-name sc))) - #!+x86 (emit-move-arg-template call + #!+(or x86 x86-64) (emit-move-arg-template call block (first move-arg-vops) (lvar-tn call block arg) nsp tn) - #!-x86 (progn + #!-(or x86 x86-64) (progn (emit-move call block (lvar-tn call block arg)