| ... |
... |
@@ -1920,6 +1920,42 @@ When annotations are present, invoke them at the right positions." |
|
1920
|
1920
|
(pprint-newline :mandatory stream)))
|
|
1921
|
1921
|
(pprint-exit-if-list-exhausted)
|
|
1922
|
1922
|
(pprint-newline :mandatory stream))))
|
|
|
1923
|
+
|
|
|
1924
|
+(defun pprint-define-assembly (stream list &rest noise)
|
|
|
1925
|
+ (declare (ignore noise))
|
|
|
1926
|
+ (pprint-logical-block (stream list :prefix "(" :suffix ")")
|
|
|
1927
|
+ ;; Output "define-assembly-routine"
|
|
|
1928
|
+ (output-object (pprint-pop) stream)
|
|
|
1929
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1930
|
+ (write-char #\space stream)
|
|
|
1931
|
+ ;; Output routine name and options.
|
|
|
1932
|
+ (pprint-logical-block (stream (pprint-pop) :prefix "(" :suffix ")")
|
|
|
1933
|
+ ;; Output the routine name
|
|
|
1934
|
+ (output-object (pprint-pop) stream)
|
|
|
1935
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1936
|
+ (pprint-newline :mandatory stream)
|
|
|
1937
|
+ (pprint-indent :block 0 stream)
|
|
|
1938
|
+ ;; Output options, one per line, neatly lined up and indented
|
|
|
1939
|
+ ;; below the routine name.
|
|
|
1940
|
+ (loop
|
|
|
1941
|
+ (output-object (pprint-pop) stream)
|
|
|
1942
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1943
|
+ (pprint-newline :mandatory stream)))
|
|
|
1944
|
+ ;; Now output the args, results, and temps used by the assembly
|
|
|
1945
|
+ ;; routine. Instead of lining up with the routine name, let's
|
|
|
1946
|
+ ;; just indent it 4 spaces from the "define-assembly-routine" so
|
|
|
1947
|
+ ;; it doesn't look so top-heavy.
|
|
|
1948
|
+ (pprint-indent :block 4 stream)
|
|
|
1949
|
+ (pprint-newline :mandatory stream)
|
|
|
1950
|
+ (pprint-logical-block (stream (pprint-pop) :prefix "(" :suffix ")")
|
|
|
1951
|
+ (loop
|
|
|
1952
|
+ (output-object (pprint-pop) stream)
|
|
|
1953
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1954
|
+ (pprint-newline :mandatory stream)))
|
|
|
1955
|
+ ;; Now print out the assembly code as if it were a tagbody. Then
|
|
|
1956
|
+ ;; labels are outdented by one to make them easy to see.
|
|
|
1957
|
+ (pprint-newline :mandatory stream)
|
|
|
1958
|
+ (pprint-tagbody-guts stream)))
|
|
1923
|
1959
|
|
|
1924
|
1960
|
;;;; Interface seen by regular (ugly) printer and initialization routines.
|
|
1925
|
1961
|
|
| ... |
... |
@@ -2037,7 +2073,8 @@ When annotations are present, invoke them at the right positions." |
|
2037
|
2073
|
(stream::with-stream-class pprint-with-like)
|
|
2038
|
2074
|
(lisp::with-array-data pprint-with-like)
|
|
2039
|
2075
|
(c:define-vop pprint-define-vop)
|
|
2040
|
|
- (c:sc-case pprint-sc-case)))
|
|
|
2076
|
+ (c:sc-case pprint-sc-case)
|
|
|
2077
|
+ (c:define-assembly-routine pprint-define-assembly)))
|
|
2041
|
2078
|
|
|
2042
|
2079
|
(defun pprint-init ()
|
|
2043
|
2080
|
(setf *initial-pprint-dispatch* (make-pprint-dispatch-table))
|