Raymond Toy pushed to branch issue-299-enable-xoroshiro-assem-routine at cmucl / cmucl

Commits:

6 changed files:

Changes:

  • src/assembly/assemfile.lisp
    ... ... @@ -209,7 +209,61 @@
    209 209 
     				    ,(reg-spec-temp res))))
    210 210 
     		     results))))))
    211 211
    212 
    +;;; Define-Assembly-Routine -- Public
    213 
    +;;;
    214 
    +;;;   Parse the code to produce an assembly routine and create a VOP
    215 
    +;;;   that calls the assembly routine.
    212 216 
     (defmacro define-assembly-routine (name&options vars &rest code)
    217 
    +  "Define-Assembly-Routine (Name&Options Vars Code*)
    218 
    +  Define a Lisp assembly routine, and a VOP to that calls the assembly
    219 
    +  routine, if enabled.  (A VOP is not created if the reader
    220 
    +  conditional #+assembler precedes the definition of the assembly
    221 
    +  routine.)
    222 
    +
    223 
    +  Name&Options
    224 
    +    A list giving the name of the assembly routine and options
    225 
    +    describing the assembly routine options and VOP options.  The
    226 
    +    format is (Name ({Key Value})*) where Name is the name of the
    227 
    +    assembly routine.  Options is a list of options:
    228 
    +
    229 
    +    Options
    230 
    +
    231 
    +      :Cost Cost
    232 
    +        The cost of the VOP.  This is used in the generated VOP.
    233 
    +
    234 
    +      :Policy {:Small | :Fast | :Safe | :Fast-Safe}
    235 
    +        The policy for the VOP.
    236 
    +
    237 
    +      :Translate Name
    238 
    +        The translation for the VOP.
    239 
    +
    240 
    +      :Arg-Types arg-types
    241 
    +      :Result-Types result-types
    242 
    +        The template restrictions for the arguments of the VOP and the
    243 
    +        results of the VOP.
    244 
    +
    245 
    +      :Return-Style {:Raw :Full-Call :None}
    246 
    +
    247 
    +    Vars is a list of the arguments and returned results and
    248 
    +    temporaries used by the assembly routine.
    249 
    +
    250 
    +      :Arg Arg-Name (SC*) SC-Offset
    251 
    +        Input argument for the assembly routine with the name
    252 
    +        Arg-Name.  The argument must be one of the SC types.  The register
    253 
    +        assigned to this argument is given by SC-Offset which must be
    254 
    +        the offset for the register holding this argument.
    255 
    +
    256 
    +      :Res Res-Name SC SC-Offset
    257 
    +        Result of the assembly routine with the name Res-Name.  The
    258 
    +        result must be a register of the specified storage class SC.  The
    259 
    +        Sc-offset is the register used for the result.
    260 
    +
    261 
    +      :Temp Temp-Name SC SC-Offset
    262 
    +        Like :Res, except this names a temporary register that the
    263 
    +        assembly routine can use.
    264 
    +
    265 
    +  Code
    266 
    +    The code for the assembly routine."
    213 267 
       (multiple-value-bind (name options)
    214 268 
     		       (if (atom name&options)
    215 269 
     			   (values name&options nil)

  • src/bootfiles/21e/boot-2023-08.lisp
    ... ... @@ -2,3 +2,46 @@
    2 2 
     ;; *SOFTWARE-VERSION* from the LISP package to the SYSTEM package.
    3 3 
     (ext:without-package-locks
    4 4 
         (unintern 'lisp::*software-version* "LISP"))
    5 
    +
    6 
    +#+(or random-mt19937 random-xoroshiro)
    7 
    +(in-package "C")
    8 
    +#+(or random-mt19937 random-xoroshiro)
    9 
    +(deftransform random ((num &optional state)
    10 
    +		      ((integer 1 #.(expt 2 32)) &optional *))
    11 
    +  _N"use inline (unsigned-byte 32) operations"
    12 
    +  (let* ((num-type (continuation-type num))
    13 
    +	 (num-high (cond ((numeric-type-p num-type)
    14 
    +			  (numeric-type-high num-type))
    15 
    +			 ((union-type-p num-type)
    16 
    +			  ;; Find the maximum of the union type.  We
    17 
    +			  ;; know this works because if we're in this
    18 
    +			  ;; routine, NUM must be a subtype of
    19 
    +			  ;; (INTEGER 1 2^32), so each member of the
    20 
    +			  ;; union must be a subtype too.
    21 
    +			  (reduce #'max (union-type-types num-type)
    22 
    +				  :key #'numeric-type-high))
    23 
    +			 (t
    24 
    +			  (give-up)))))
    25 
    +    ;; Rather than doing (rem (random-chunk) num-high), we do,
    26 
    +    ;; essentially, (rem (* num-high (random-chunk)) #x100000000).  I
    27 
    +    ;; (rtoy) believe this approach doesn't have the bias issue with
    28 
    +    ;; doing rem.  This method works by treating (random-chunk) as if
    29 
    +    ;; it were a 32-bit fraction between 0 and 1, exclusive.  Multiply
    30 
    +    ;; this by num-high to get a random number between 0 and num-high,
    31 
    +    ;; This should have no bias.
    32 
    +    (cond ((constant-continuation-p num)
    33 
    +	   (if (= num-high (expt 2 32))
    34 
    +	       '(random-chunk (or state *random-state*))
    35 
    +	       '(values (bignum::%multiply
    36 
    +			 (random-chunk (or state *random-state*))
    37 
    +			 num))))
    38 
    +	  ((< num-high (expt 2 32))
    39 
    +	   '(values (bignum::%multiply (random-chunk (or state *random-state*))
    40 
    +		     num)))
    41 
    +	  ((= num-high (expt 2 32))
    42 
    +	   '(if (= num (expt 2 32))
    43 
    +		(random-chunk (or state *random-state*))
    44 
    +		(values (bignum::%multiply (random-chunk (or state *random-state*))
    45 
    +					   num))))
    46 
    +	  (t
    47 
    +	   (error (intl:gettext "Shouldn't happen"))))))

  • src/code/pprint.lisp
    ... ... @@ -2088,6 +2088,7 @@ When annotations are present, invoke them at the right positions."
    2088 2088 
         (c:define-vop pprint-define-vop)
    2089 2089 
         (c:sc-case pprint-sc-case)
    2090 2090 
         (c:define-assembly-routine pprint-define-assembly)
    2091 
    +    (new-assem:assemble pprint-multiple-value-bind)
    2091 2092 
         (c:deftransform pprint-defun)
    2092 2093 
         (c:defoptimizer pprint-defun)
    2093 2094 
         (ext:with-float-traps-masked pprint-with-like)

  • src/code/rand-xoroshiro.lisp
    ... ... @@ -490,11 +490,8 @@
    490 490 
       (declare (inline %random-single-float %random-double-float))
    491 491 
       (cond
    492 492 
         ((typep arg '(integer 1 #x100000000))
    493 
    -     ;; Do the same thing as the deftransform would do.
    494 
    -     (if (= arg (expt 2 32))
    495 
    -	 (random-chunk state)
    496 
    -	 (values (bignum::%multiply (random-chunk state)
    497 
    -				    arg))))
    493 
    +     ;; Let the compiler deftransform take care of this case.
    494 
    +     (random arg state))
    498 495 
         ((and (typep arg 'single-float) (> arg 0.0F0))
    499 496 
          (%random-single-float arg state))
    500 497 
         ((and (typep arg 'double-float) (> arg 0.0D0))

  • src/general-info/release-21f.md
    ... ... @@ -51,8 +51,8 @@ public domain.
    51 51 
         * ~~#261~~ Remove `get-system-info` from "bsd-os.lisp"
    52 52 
         * ~~#268~~ Can't clone ansi-test repo on Mac OS CI box
    53 53 
         * ~~#265~~ CI for mac os is broken
    54 
    -    * ~~#269~~ Add function to get user's home directory
    55 54 
         * ~~#266~~ Support "~user" in namestrings
    55 
    +    * ~~#269~~ Add function to get user's home directory
    56 56 
         * ~~#271~~ Update ASDF to 3.3.7
    57 57 
         * ~~#272~~ Move scavenge code for static vectors to its own function
    58 58 
         * ~~#274~~ 1d99999999 hangs
    ... ... @@ -65,6 +65,7 @@ public domain.
    65 65 
         * ~~#288~~ Re-enable `deftransform` for random integers.
    66 66 
         * ~~#290~~ Pprint `with-float-traps-masked` better
    67 67 
         * ~~#291~~ Pprint `handler-case` neatly.
    68 
    +    * ~~#297~~ Pprint `new-assem:assemble` with less indentation.
    68 69 
       * Other changes:
    69 70 
       * Improvements to the PCL implementation of CLOS:
    70 71 
       * Changes to building procedure:

  • tests/pprint.lisp
    ... ... @@ -121,3 +121,17 @@
    121 121 
                    (:no-error ()
    122 122 
                     (format nil "Nothing bad happened.")))
    123 123 
                  s))))
    124 
    +
    125 
    +(define-test pprint.assemble
    126 
    +    (:tag :issues)
    127 
    +  (assert-equal
    128 
    +   "
    129 
    +(NEW-ASSEM:ASSEMBLE (C:*CODE-SEGMENT* 'X86::XOROSHIRO-UPDATE)
    130 
    +    X86::XOROSHIRO-UPDATE
    131 
    +  (PUSH (CONS 'X86::XOROSHIRO-UPDATE X86::XOROSHIRO-UPDATE)
    132 
    +        C::*ASSEMBLER-ROUTINES*))"
    133 
    +   (with-output-to-string (s)
    134 
    +     (pprint '(new-assem:assemble (c::*code-segment* 'vm::xoroshiro-update)
    135 
    +               vm::xoroshiro-update
    136 
    +               (push (cons 'vm::xoroshiro-update vm::xoroshiro-update) c::*assembler-routines*))
    137 
    +             s))))

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help