;;; -*- Mode:LISP; Package:COMPILER; Base:8; Readtable:ZL -*- #| NO WAY STATIONS.. code is to be generated the "right way" at the extreme bottom of the tree, as opposed to compiled into a temp, the futz with multiple-values or frame-flushing, then return the temp, etc. the primary mechanism use to achieve this is "the closure", on *open-frames*, which is passed messages telling it what we want to do. The Closure is required to preserve the hardware m.v. flag. messages to the closure: :EXIST sent when instruction which causes frame to exist at runtime is emitted. :DISCARD used when thru with temporary-storage-frames (ie p2values-for-k) also when doing a GO out from under evaluated args. :RETURN Used when passing a value through a frame, yielding a value to a destination. However, the frame is discarded, not completed as for the NIL message. Hairy; see below: NIL normal completion. (open-frame operation dest) Hairy, see below: NIL and :RETURN receive the following arguments: Frame The frame-entry on *open-frames*; like SELF. Operation :RETURN, that is, this operation. Dest Where to put the result. Except for the last one to be removed, this will be a temporary global register. Source Where to get the value. A given frame can leave the value in the source, iff that source will be unaffected by discarding this frame. SType A source-type flag. Some frame types will look at this (i.e. THROW), and others will pass on to the recursive call to OUTI-FOR-K. The value from the NIL or :RETURN operation is left either in Dest or Source. Which one is indicated by the return value -- it will be the source for the next step. Source-type flags passed to OUTI-FOR-K when the instruction yielding a final value for some destination is output. The Source-type flag will be one of the following: NIL -- Some unknown number of values is computed, and the hardware m.v. flag is not set up. :SINGLE-VALUE -- A single value is computed, and the hardware m.v. flag is not set up. :SINGLE-VALUE-FLAG -- A single value is computed, and the hardware m.v. flag is cleared. I'm not sure this is usefully distinct from :SINGLE-VALUE. :SUBR-VALUE -- A function was called, which will set up the hardware m.v. flag to indicate whether multiple values were returned. :MULTIPLE-VALUES -- A VALUES form (or other open-compiled m.v. producing form) produced values, but the hardware m.v. flag is not set up. :MULTIPLE-VALUES-FLAG -- Like :MULTIPLE-VALUES, but the m.v. flag is set up. :LAST-VALUE -- Multiple values were prepared, distributed by a higher level, and Now this one (the first one) is passed along to activate the open frames and other hair, and eventually be placed where it belongs. OUTI-CLOSE-FOR-K takes optionally takes a Source and a Source-Type, passes them to the closure in question. OUTI-FOR-K optionally takes a Source-Type. This will be supplied when generating the instruction which produces the final result. OUTI-FOR-K will pass this on if it recurses, and will pass it on to CLEAN-UP-OPEN-FRAMES. (The default will be :SINGLE-VALUE). When OUTI-FOR-K gets a compound destination, it simplifies it: If it's a PROGDESC: If the PROGDEST-OPEN-FRAMES is the same as *OPEN-FRAMES*, the PROGDEST-IDEST is substituted in the instruction, and we're done. If the PROGDEST-OPEN-FRAMES is not in *OPEN-FRAMES*, we have an error situation. Otherwise: It substitutes the PROGDEST-IDEST, or K:R0 if the PROGDEST-IDEST is not an A register or D-IGNORE, and outputs the instruction. It calls CLEAN-UP-OPEN-FRAMES with the source being either K:R0 or the destination, depending on which was used above. The Source-Type is passed on. CLEAN-UP-OPEN-FRAMES will have moved it into the destination. If it's a MULTIPLE-VALUES, it will: Case Source-type: (:SINGLE-VALUE :SINGLE-VALUE-FLAG): Output the instruction to store into the first destination. Output instructions to store NIL's into the additional destinations. (:SUBR-VALUE): Output the instruction, to store into the first destination. Output code to test the hardware bit, and store the values or NIL's into the additional destinations. (:VALUES): Output the instruction, to store into the first destination. The hardware bit is not set, but there are multiple values. Copy from the global return registers into the additional destinations. If it's an OPEN-FRAME: Output the instruction, with a destination from the IDEST of the OPEN-FRAME. Call OUTI-CLOSE-FOR-K, with the IDEST as source as passing on the Source-type. CLEAN-UP-OPEN-FRAME takes the Source given, and: For each open frame to be popped, except the last, it calls the closure with Source = SOURCE and Dest = the global return-temp register. The return value becomes the new SOURCE. For the last open frame to be popped, the Dest = the Dest passed into CLEAN-UP-OPEN-FRAMES. If the return value is Dest, we're all done. If it isn't, a move must is done. (multiple-value-setq (a b c) (cond ((foo)))) would work as follows: * MULTIPLE-VALUE-SETQ's P2 would create a multiple-value destination, and call P2-FOR-K on (cond ((foo))) * (:PROPERTY COND P2-FOR-K) would call P2 on (FOO) and K:R0. * After braching, it would do a MOVE from K:R0 to the destination. The Source-type would be :SINGLE-VALUE, (throw 'foo (foo)) would work as follows: * P2THROW-FOR-K would create an open frame with its own closure. * 'FOO would be compiled to K:O0. * The PDEST of the open frame would be set to K:O1. * The IDEST of the open frame would be set to D-IGNORE, since we don't return. (Normally it would be the destination given P2THROW-FOR-K). * P2THROW-FOR-K would call P2-FOR-K with (FOO) and a destination of the open frame. * (Eventually, inside P2ARGC-FOR-K) OUTI-CLOSE-FOR-K will be called with Operation = NIL, Destination = open-frame, Source-type = :SUBR-VALUES. * OUTI-CLOSE-FOR-K will invoke P2ARGC-FOR-K's closure for FOO. It will pass on Source-type. * P2ARGC-FOR-K's closure will do OUTI-FOR-K of a call with a destination of the THROW open frame. It will pass on Source-type. * OUTI-FOR-K will see that it has a compound, and simplify it. In the case of an OPEN-FRAME, this means: * OUTI-FOR-K will output the call instruction for FOO, with a destination of K:O1 (from the PDEST of the OPEN-FRAME). * OUTI-FOR-K will call OUTI-CLOSE-FOR-K with a source of K:O1, a destination of D-IGNORE (from the IDEST of the open frame), and a Source-type passed on. * OUTI-CLOSE-FOR-K will pass those on to P2THROW-FOR-K's closure. * P2THROW-FOR-K's closure will output the appropriate code based on the Source-type. |# #| Logical Destinations. Valid arguments to everything from P2-FOR-K to OUTI-FOR-K. (OUTI-FOR-K also allows the use of all valid K: destinations). Symbols: D-IGNORE -- Value is to be ignored. D-RETURN -- Value is to be returned from the function. K:NOP -- Value is discarded, but the indicators are set. K:O0-K:O15 -- Place the result in this K register. Used for compiler temporaries and arguments to functions being called. K:A0-K:A15 -- Same. Used for local variables and arguments to this function. K:R0-K:R15 -- Same. Also, K:R0 is used to set the indicators for conditionals, and as an intermediate. GR:xxx -- General Register, by name. Otherwise -- A special variable. I would rather this were a structure, but P1 would have to create that. Lists: (K:REGISTER name block index) -- Same as GR:name. (K:NEW-OPEN n) -- Put the result of this into a new OPEN frame, in (O-N n). (K:NEW-TAIL-OPEN n) -- Put the result of this into a new TAIL-OPEN frame, in (O-N n). Structures: PROGDESC: Has the following relevant slots: IDEST -- Destination for this block. OPEN-FRAMES -- Tail of *OPEN-FRAMES*, indication how far to discard to. MULTIPLE-VALUES: Has the following slots: VALUES -- A list of destinations. OPEN-FRAME -- NIL, or an open frame to be activated when this is output. OPEN-FRAME: Has the following relevant slots: PDEST -- Where to put the value this frame needs. (New) IDEST -- Where to put the value when this frame is done. (New) CLEANUP-GENERATOR -- Function to generate the appropriate cleanup code. This is the part that does the interesting work. It will be called with an operation of NIL, and it can make decisions about what function to call depending on the Source-type argument. This is useful for THROW, MULTIPLE-VALUE-LIST, MULTIPLE-VALUE-BIND, MULTIPLE-VALUE-CALL, MULTIPLE-VALUE-SETQ, and any other multiple value receivers. (This open frame should also live on *OPEN-FRAMES*, if it involves a O-frame, as THROW does. They may as well ALL live on *OPEN-FRAMES*). VAR: Has the following relevant slots: LAP-ADDRESS -- Where to store it. NEW-VAR: Has the following relevant slots: VAR -- The VAR struct that this storing will create & initialize the home for. OPEN-FRAME -- NIL, or an open frame to be activated when this is output. |# ;This file has modifications to P2 of the compiler for cross compiling on K. ;cross compilation switches and conditionalization. ; *target-computer* can be 'lambda or 'k ; this is the main switch which indicates we are in fact cross compiling. ; the macro COMPILER-TARGET-SWITCH makes conditional calls based on this switch. It ; is also looked at directly. ; *fasd-interface* can be 'lambda-fasd-interface or nlisp-fasd-interface ; the macro COMPILER-FASD-SWITCH makes conditional calls based on this switch. ;the P2-FOR-K property. ; when cross compiling, P2F will look for this before looking for P2 or QINTCMP properties. ; When found, property is treated identically to how P2 property would be treated. ;general: ; MISC instructions have no meaning on the K. Therefore, P2MISC-for-k just calls P2ARGC-for-k (which ; compiles calls to ordinary functions) rather compiling a different sort of call. ; Since the K is (more or less) a register based machine, all references to D-PDL (etc) have to ; go away, more or less. ; Destinations: ; the destinations D-NEXT, D-LAST, and D-PDL basically do not apply to the K. They ;may be OK if the code will be converted by the cross compiler, however. ; D-LAST is completely gone now. --RWK ; D-INDS is equivalent to K:R0, and therefore is flushed. ;optimizations for the future: ; Introduce "h" pseudo-registers. These really address the hardware "A" registers, but ;in addition, guarantee the peep-hole optimizer the value will be "used" exactly once. ;Thus, (move h1 foo), (move bar h1) can be optimized, if possible, into (move bar foo) ;without worrying there might be another (move ble h1) comming along later. ;; Internals that tell the compiler what it is trying to do. (defconst *internal-return-destinations* '(d-return d-return-single d-return-multiple-value d-return-tail)) ;; These can actually appear in the destination of a K:MOVE instruction, etc. (defconst *return-destinations* '(k:return k:return-tail k:return-mv k:return-i k:return-i-mv k:return-i-tail )) (defconst *frame-registers-used-for-argument-passing* 16.) ;will be less when lexical env problem addressed. ;(defconst *k-constant-registers* '( (0 . gr:*zero) (1 . gr:*one*) (-1 . gr:*minus-one*) ; (2 . gr:*two*) (nil . gr:*nil*) (t . gr:*t*) ; (3 . gr:*three*) (4 . gr:*four*) (5 . gr:*five*) ; (6 . gr:*six*) (7 . gr:*seven*) (8 . gr:*eight*) ; (9 . gr:*nine*) (10. . gr:*ten*))) ;(defun k-ref-constant-frame (const) ; (let ((tem (assq const *k-constant-registers*))) ; (if tem `(register )))) (deftype functional-dest () `(satisfies functional-dest-p)) (deftype register-dest () `(satisfies register-dest-p)) (deftype return-dest () `(satisfies return-dest-p)) (deftype constant-register () `(satisfies constant-register)) (deftype quoted-object () `(satisfies quoted-object-p)) (deftype var-reference () `(satisfies var-reference-p)) (deftype new-frame-dest () `(satisfies new-frame-dest-p)) (defvar *reg-error-enable* t) ; Debugging switch. (defun reg-error (&rest args) (declare (eh:error-reporter)) (when *reg-error-enable* (apply #'fsignal args))) ;;; Some functions we just don't like to do tail calls on. Provide a way to not ;;; do them, so people can debug. (defvar *no-tail-call* nil) (defun initialize-no-tail-call () (unless *no-tail-call* (setq *no-tail-call* (make-hash-table :test #'eq)) (setf (gethash 'li::error *no-tail-call*) t) (setf (gethash 'lisp:error *no-tail-call*) t))) ;;; I think this is how you arrange to be initialized after the system is loaded. ;;; In this case, we have to wait for the flavor system and hash tables to be loaded. ;;; If the once-only initialization list isn't run at the right point, we'll just ;;; have to find or create a list which is. (add-initialization "Initialize no-tail-call table." '(initialize-no-tail-call) '(:once)) (defmacro compiling-to-destination ((dest source source-type) &body body) (let ((original-dest (gensymbol "ORIGINAL-DEST")) (source-var (gensymbol "SOURCE")) (source-type-var (gensymbol "SOURCE-TYPE"))) `(let ((,original-dest ,dest) (,source-var ,source) (,source-type-var ,source-type)) (multiple-value-bind (,dest ,source-var) (compute-temporary-destination ,original-dest ,source-var) ;; DEST is now the intermediate destination. ;; SOURCE-VAR is how you back get to that value. (Usually ;; it's the same, but it can be a quoted constant or constant ;; register.) (multiple-value-prog1 (progn ,@body) ;; Now move from the intermediate to the final value, if needed. (move-to-final-destination ,original-dest ,source-var ,source-type-var)))))) (defun functional-dest-p (dest) (case dest (k:nop t) ;As far as we're concerned. (otherwise (nc::functional-dest-p dest)))) (defun register-dest-p (dest) (typecase dest (list (case (first dest) (k:register t))) (symbol (or (find dest #(k:a0 k:a1 k:a2 k:a3 k:a4 k:a5 k:a6 k:a7 k:a8 k:a9 k:a10 k:a11 k:a12 k:a13 k:a14 k:a15 k:o0 k:o1 k:o2 k:o3 k:o4 k:o5 k:o6 k:o7 k:o8 k:o9 k:o10 k:o11 k:o12 k:o13 k:o14 k:o15 k:r0 k:r1 k:r2 k:r3 k:r4 k:r5 k:r6 k:r7 k:r8 k:r9 k:r10 k:r11 k:r12 k:r13 k:r14 k:r15)) ;; @#$@#$ This should be NC::REGISTER or COMPILER::REGISTER (get dest :register))) (otherwise nil))) (defun return-dest-p (dest) (typecase dest (symbol (or (memq dest *return-destinations*) (memq dest *internal-return-destinations*))) (otherwise nil))) (defun constant-register (reg) (typecase reg (list (third (find reg nc:*global-constants* :key #'cdr :test #'equal))) (symbol (third (find reg nc:*global-constants* :key #'third))) (otherwise nil))) (defun quoted-object-p (ref) (typecase ref (list (case (first ref) ((quote function breakoff-function) t) (otherwise nil))) (otherwise nil))) (defun var-reference-p (ref) (typecase ref (list (case (first ref) ((local-ref special-ref lexical-ref) t) (otherwise nil))) (otherwise nil))) (defun new-frame-dest-p (reg) (typecase reg (list (case (first reg) ((k:new-open k:new-tail-open) t) (otherwise nil))) (otherwise nil))) ;;; Answers the important question: Is this a source that can be moved ;;; arbitrarily later in the computation? (defun constant-source-p (source) (and source (etypecase source ((member k:trap-pc+) nil) ;Can't move this! (functional-dest nil) (quoted-object t) (var-reference nil) (constant-register t) (register-dest nil)))) ;;; This also works on sources (i.e. QUOTE frobs.) (defun register-static-across-opens-p (source) (etypecase source (register-dest ;; Exclude O-frames. (not (find source #(k:o0 k:o1 k:o2 k:o3 k:o4 k:o5 k:o6 k:o7 k:o8 k:o9 k:o10 k:o11 k:o12 k:o13 k:o14 k:o15)))) ;; Exclude k:new-open, etc. (new-frame-dest nil) (functional-dest nil) (quoted-object t) (var-reference t) (var-reference t)))