Use low bit for aokp in parse-key-args

Makes it a little easier to work with.

FASL.md

@@ -23,6 +23,7 @@ After the last instruction is executed, the FASL has been fully loaded. Any rema
 ## 0.15 (pending)
 
 * `listify-rest-args` pushes to the stack again. `bind-optional-args` and `parse-key-args` do as well. (This makes compilation a little easier and cleaner.)
+* `parse-key-args` puts aokp in the low bit instead of the high bit, to simplify the long instruction.
 
 ## 0.14
 

MACHINE.md

@@ -256,14 +256,14 @@ Construct a list out of all the arguments beginning at `nfixed`, and push it to
 
 ## parse-key-args #x13 (nfixed misc) (key-count-info misc) (keys keys)
 
-The low 7 (or 15, for `long parse-key-args`) bits of `key-count-info` are a count of keywords, call it `nkeys`. There are `nkeys` literals beginning at `keys` that are keys. Interpret the arguments beginning with `nfixed` as a keyword plist, and push them to the stack in the order of the corresponding keywords. If any of these do not have an entry in the arguments plist, an "unsupplied" value with no meaning except to `jump-if-supplied` is pushed instead.
+The high 7 (or 15, for `long parse-key-args`) bits of `key-count-info` are a count of keywords, call it `nkeys`. There are `nkeys` literals beginning at `keys` that are keys. Interpret the arguments beginning with `nfixed` as a keyword plist, and push them to the stack in the order of the corresponding keywords. If any of these do not have an entry in the arguments plist, an "unsupplied" value with no meaning except to `jump-if-supplied` is pushed instead.
 
-If the length of the argument plist is odd, signal a program error. If the high bit of `key-count-info` is unset, and there are keywords in the argument plist that are not part of `keys`, signal a program error.
+If the length of the argument plist is odd, signal a program error. If the low bit of `key-count-info` is unset, and there are keywords in the argument plist that are not part of `keys`, signal a program error. (In other words, the low bit of `key-count-info` indicates whether `&allow-other-keys` was present.)
 
 ```lisp
 (let* ((plist (nthcdr NFIXED arguments))
-       (nkeys (ldb (byte 7 #|or 15|# 0) key-count-info))
-       (aokp (logbitp 7 #|or 15|# key-count-info))
+       (nkeys (ash key-count-info -1))
+       (aokp (logbitp 0 key-count-info))
        (keywords (subseq LITERALS keys (+ keys nkeys))))
   (unless (evenp (length plist)) (error 'program-error ...))
   (loop for i from base for kw in keywords

compile/compile.lisp

@@ -363,21 +363,12 @@
 (defun emit-fdefinition (context index) (assemble context m:fdefinition index))
 
 (defun emit-parse-key-args (context max-count key-count key-literal-start aok-p)
-  ;; Because of the key-count encoding, we have to special case long a bit.
   (let ((lit (if (zerop key-count) ; don't need a literal then
                  0
-                 key-literal-start)))
-    (cond ((and (< max-count #.(ash 1 8)) (< key-count #.(ash 1 7))
-                (< lit #.(ash 1 8)))
-           (assemble context m:parse-key-args
-             max-count
-             (if aok-p (logior #.(ash 1 7) key-count) key-count)
-             lit))
-          (t
-           (assemble context m:parse-key-args
-             max-count
-             (if aok-p (logior #.(ash 1 15) key-count) key-count)
-             lit)))))
+                 key-literal-start))
+        (skey-count (ash key-count 1)))
+    (assemble context m:parse-key-args
+      max-count (logior skey-count (if aok-p #b1 #b0)) lit)))
 
 (defun emit-bind (context count offset)
   (cond ((= count 1) (assemble context m:set offset))

disassemble.lisp

@@ -74,8 +74,8 @@
       ;; just pretty weird all around.
       (let* ((more-start (second (first args)))
              (kci (second (second args)))
-             (aokp (logbitp (if longp 15 7) kci))
-             (key-count (logand kci (if longp #x7fff #x7f)))
+             (aokp (logbitp 0 kci))
+             (key-count (ash kci -1))
              (keys (third args))
              (framestart (second (fourth args))))
         ;; Print

vm-cross.lisp

@@ -464,8 +464,8 @@
                       (setf sp
                             (vm:parse-key-args
                              nfixed
-                             (logand key-count-info #x7f)
-                             (logbitp 7 key-count-info)
+                             (ash key-count-info -1)
+                             (logbitp 0 key-count-info)
                              key-literal-start stack sp
                              (vm-arg-count vm) (vm-args vm) constants)))
                     (incf ip))
@@ -641,8 +641,8 @@
                          (setf sp
                                (vm:parse-key-args
                                 nfixed
-                                (logand key-count-info #x7fff)
-                                (logbitp 15 key-count-info)
+                                (ash key-count-info -1)
+                                (logbitp 0 key-count-info)
                                 key-literal-start stack sp
                                 (vm-arg-count vm) (vm-args vm) constants)))
                        (incf ip))

vm-native.lisp

@@ -266,8 +266,8 @@
                       (setf sp
                             (vm:parse-key-args
                              nfixed
-                             (logand key-count-info #x7f)
-                             (logbitp 7 key-count-info)
+                             (ash key-count-info -1)
+                             (logbitp 0 key-count-info)
                              key-literal-start stack sp
                              (vm-arg-count vm) (vm-args vm) constants)))
                     (incf ip))
@@ -462,8 +462,8 @@
                              (key-literal-start (next-long)))
                          (setf sp (vm:parse-key-args
                                    nfixed
-                                   (logand key-count-info #x7fff)
-                                   (logbitp 15 key-count-info)
+                                   (ash key-count-info -1)
+                                   (logbitp 0 key-count-info)
                                    key-literal-start stack sp
                                    (vm-arg-count vm) (vm-args vm) constants)))
                        (incf ip))