Fixed bugs in WavefrontOperandRename.clp

;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Now we need to rename operands as need be within the blocks that these
; instructions have been scheduled into
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::AssertReplacementActions
         "Iterates through the replacement actions multifield and asserts facts
         related to the replacement of given values with another value"
         (declare (salience 100))
         (object (is-a PathAggregate)
                 (parent ?e)
                 (ReplacementActions $? ?orig ?new ! $?))
         =>
         ; I have turned you into a cheese sandwich, what do you say to that?
         (assert (message (to wavefront-scheduling)
                          (action replace-uses)
                          (arguments of ?orig
                                     with ?new
                                     block ?e))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUses
         (declare (salience 20))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses)
                          (arguments of ?orig
                                     with ?new
                                     block ?e))
         (object (is-a Instruction)
                 (id ?orig)
                 (pointer ?oPtr))
         (object (is-a Instruction)
                 (id ?new)
                 (pointer ?nPtr))
         (object (is-a BasicBlock)
                 (id ?e)
                 (contents $? ?new $?rest))
         =>
         (bind ?ptrList (create$))
         (bind ?symList (create$))
         (bind ?i0 1)
         (progn$ (?var $?rest)
                 (bind ?obj (instance-name (symbol-to-instance-name ?var)))
                 (bind ?oOps (send ?obj get-Operands))
                 (if (member$ ?orig ?oOps) then
                   (bind ?ptrTmp (send ?obj get-Pointer))
                   (bind ?ptrList (insert$ ?ptrList ?i0 ?ptrTmp))
                   (bind ?symList (insert$ ?symList ?i0 ?var))
                   (bind ?i0 (+ ?i0 1))))
         ;reuse ?fct's memory
         (modify ?fct (action replace-uses-clips)
                 (arguments ?orig => ?new for ?symList))
         (assert (message (to wavefront-scheduling)
                          (action replace-uses-llvm)
                          (arguments ?oPtr => ?nPtr for ?ptrList))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUsesInLLVM
         (declare (salience -1))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses-llvm)
                          (arguments ?from => ?to for $?p2))
         =>
         (if (llvm-replace-uses ?from ?to ?p2) then
           (retract ?fct)
           else
           (printout t
                     "Some kind of error occured when trying to replace uses. "
                     crlf "Make sure that you've done arguments correctly. "
                     crlf "The failing rule is ReplaceUsesInLLVM." crlf
                     "?from = " ?from crlf
                     "?to = " ?to crlf
                     "?p2 = " ?p2 crlf
                     "Now I'm halting execution" crlf)
           (halt)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUsesInCLIPS
         (declare (salience -1))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses-clips)
                          (arguments ?from => ?to for ?symbol $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (Operands $?operands)
                          (LocalDependencies $?locDep)
                          (NonLocalDependencies $?nLocDep))
         =>
         (modify-instance ?inst (Operands)
                          (LocalDependencies)
                          (NonLocalDependencies))
         (modify ?fct (arguments ?from => ?to for $?rest))
         (assert (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ?from => ?to
                                     replacement ?symbol
                                     operands $?operands))
                 (message (to wavefront-scheduling)
                          (action replace-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents $?locDep))
                 (message (to wavefront-scheduling)
                          (action replace-non-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents $?nLocDep))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUsesInCLIPS-End
         (declare (salience -1))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses-clips)
                          (arguments ? => ? for))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualLocalDependencyEntries-NoMatch
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?curr&~?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (LocalDependencies $?locDep))
         =>
         (modify-instance ?inst (LocalDependencies $?locDep ?curr))
         (modify ?fct (arguments ?from => ?to
                                 in ?symbol
                                 contents $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualLocalDependencyEntries-Match
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (LocalDependencies $?locDep))
         =>
         (object-pattern-match-delay
           (modify-instance ?inst (LocalDependencies $?locDep ?to))
           (modify ?fct (arguments ?from => ?to
                                   in ?symbol
                                   contents $?rest))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualNonLocalDependencyEntries-NoMatch
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-non-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?curr&~?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (NonLocalDependencies $?nld))
         =>
         (modify-instance ?inst (NonLocalDependencies $?nld ?curr))
         (modify ?fct (arguments ?from => ?to
                                 in ?symbol
                                 contents $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualNonLocalDependencyEntries-Match
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-non-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (NonLocalDependencies $?nld))
         =>
         (modify-instance ?inst (NonLocalDependencies $?nld ?to))
         (modify ?fct (arguments ?from => ?to
                                 in ?symbol
                                 contents $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualInstructionUses-NoMatch
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ?f => ?t
                                     replacement ?s
                                     operands ?op&~?f $?ops))
         ?inst <- (object (is-a Instruction)
                          (id ?s)
                          (Operands $?operands))
         =>
         (modify-instance ?inst (Operands $?operands ?op))
         (modify ?fct (arguments ?f => ?t
                                 replacement ?s
                                 operands $?ops)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualInstructionUses-Match
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ?f => ?t
                                     replacement ?s
                                     operands ?f $?ops))
         ?inst <- (object (is-a Instruction)
                          (id ?s)
                          (Operands $?operands))
         =>
         (modify-instance ?inst (Operands $?operands ?t))
         (modify ?fct (arguments ?f => ?t
                                 replacement ?s
                                 operands $?ops)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualInstructionUses-Empty
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ? => ?
                                     replacement ?
                                     operands))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------

;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Now we need to rename operands as need be within the blocks that these
; instructions have been scheduled into
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::AssertReplacementActions
         "Iterates through the replacement actions multifield and asserts facts
         related to the replacement of given values with another value"
         (declare (salience 100))
         (object (is-a PathAggregate)
                 (parent ?e)
                 (ReplacementActions $? ?orig ?new ! $?))
         =>
         ; I have turned you into a cheese sandwich, what do you say to that?
         (assert (message (to wavefront-scheduling)
                          (action replace-uses)
                          (arguments of ?orig
                                     with ?new
                                     block ?e))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUses
         (declare (salience 20))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses)
                          (arguments of ?orig
                                     with ?new
                                     block ?e))
         (object (is-a Instruction)
                 (id ?orig)
                 (pointer ?oPtr))
         (object (is-a Instruction)
                 (id ?new)
                 (pointer ?nPtr))
         (object (is-a BasicBlock)
                 (id ?e)
                 (Contents $? ?new $?rest))
         =>
         (bind ?ptrList (create$))
         (bind ?symList (create$))
         (bind ?i0 1)
         (progn$ (?var $?rest)
                 (bind ?obj (instance-name (symbol-to-instance-name ?var)))
                 (bind ?oOps (send ?obj get-Operands))
                 (if (member$ ?orig ?oOps) then
                   (bind ?ptrTmp (send ?obj get-Pointer))
                   (bind ?ptrList (insert$ ?ptrList ?i0 ?ptrTmp))
                   (bind ?symList (insert$ ?symList ?i0 ?var))
                   (bind ?i0 (+ ?i0 1))))
         ;reuse ?fct's memory
         (modify ?fct (action replace-uses-clips)
                 (arguments ?orig => ?new for ?symList))
         (assert (message (to wavefront-scheduling)
                          (action replace-uses-llvm)
                          (arguments ?oPtr => ?nPtr for ?ptrList))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUsesInLLVM
         (declare (salience -1))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses-llvm)
                          (arguments ?from => ?to for $?p2))
         =>
         (if (llvm-replace-uses ?from ?to ?p2) then
           (retract ?fct)
           else
           (printout t
                     "Some kind of error occured when trying to replace uses. "
                     crlf "Make sure that you've done arguments correctly. "
                     crlf "The failing rule is ReplaceUsesInLLVM." crlf
                     "?from = " ?from crlf
                     "?to = " ?to crlf
                     "?p2 = " ?p2 crlf
                     "Now I'm halting execution" crlf)
           (halt)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUsesInCLIPS
         (declare (salience -1))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses-clips)
                          (arguments ?from => ?to for ?symbol $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (Operands $?operands)
                          (LocalDependencies $?locDep)
                          (NonLocalDependencies $?nLocDep))
         =>
         (modify-instance ?inst (Operands)
                          (LocalDependencies)
                          (NonLocalDependencies))
         (modify ?fct (arguments ?from => ?to for $?rest))
         (assert (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ?from => ?to
                                     replacement ?symbol
                                     operands $?operands))
                 (message (to wavefront-scheduling)
                          (action replace-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents $?locDep))
                 (message (to wavefront-scheduling)
                          (action replace-non-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents $?nLocDep))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceUsesInCLIPS-End
         (declare (salience -1))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-uses-clips)
                          (arguments ? => ? for))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualLocalDependencyEntries-NoMatch
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?curr&~?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (LocalDependencies $?locDep))
         =>
         (modify-instance ?inst (LocalDependencies $?locDep ?curr))
         (modify ?fct (arguments ?from => ?to
                                 in ?symbol
                                 contents $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualLocalDependencyEntries-Match
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (LocalDependencies $?locDep))
         =>
         (object-pattern-match-delay
           (modify-instance ?inst (LocalDependencies $?locDep ?to))
           (modify ?fct (arguments ?from => ?to
                                   in ?symbol
                                   contents $?rest))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualNonLocalDependencyEntries-NoMatch
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-non-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?curr&~?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (NonLocalDependencies $?nld))
         =>
         (modify-instance ?inst (NonLocalDependencies $?nld ?curr))
         (modify ?fct (arguments ?from => ?to
                                 in ?symbol
                                 contents $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualNonLocalDependencyEntries-Match
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-non-local-dependencies)
                          (arguments ?from => ?to
                                     in ?symbol
                                     contents ?from $?rest))
         ?inst <- (object (is-a Instruction)
                          (id ?symbol)
                          (NonLocalDependencies $?nld))
         =>
         (modify-instance ?inst (NonLocalDependencies $?nld ?to))
         (modify ?fct (arguments ?from => ?to
                                 in ?symbol
                                 contents $?rest)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualInstructionUses-NoMatch
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ?f => ?t
                                     replacement ?s
                                     operands ?op&~?f $?ops))
         ?inst <- (object (is-a Instruction)
                          (id ?s)
                          (Operands $?operands))
         =>
         (modify-instance ?inst (Operands $?operands ?op))
         (modify ?fct (arguments ?f => ?t
                                 replacement ?s
                                 operands $?ops)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualInstructionUses-Match
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ?f => ?t
                                     replacement ?s
                                     operands ?f $?ops))
         ?inst <- (object (is-a Instruction)
                          (id ?s)
                          (Operands $?operands))
         =>
         (modify-instance ?inst (Operands $?operands ?t))
         (modify ?fct (arguments ?f => ?t
                                 replacement ?s
                                 operands $?ops)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-rename::ReplaceIndividualInstructionUses-Empty
         (declare (salience -2))
         ?fct <- (message (to wavefront-scheduling)
                          (action replace-operands)
                          (arguments ? => ?
                                     replacement ?
                                     operands))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------


Added the Wavefront Scheduling proper code module.

This module may encompass a very large number of rules or it may just be the
launch point for a large number of modules. Only time will tell

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
;this module is used to determine which regions should be targeted for pathing
(defmodule wavefront-scheduling-determinant
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (import indirect ?ALL)
			  (import rampancy ?ALL)
			  (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-code
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (import indirect ?ALL)
			  (import rampancy ?ALL)
			  (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling::macro-expand-passes
			"Pushes the modules that make up this pass into the pass-description"
			?f <- (message (from pipeline)
								(to wavefront)
								(action initial-fact))
			?p <- (object (is-a pass-description) (passes $?passes))
			=>
			(retract ?f)
			(modify-instance ?p (passes
										loop-region-merging
										dependency-analysis
										wavefront-determinant
										paths-conditional
										wavefront-scheduling-code
										$?passes)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
;this module is used to determine which regions should be targeted for pathing
(defmodule wavefront-scheduling-determinant
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (import indirect ?ALL)
			  (import rampancy ?ALL)
			  (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling::macro-expand-passes
			"Pushes the modules that make up this pass into the pass-description"
			?f <- (message (from pipeline)
								(to wavefront)
								(action initial-fact))
			?p <- (object (is-a pass-description) (passes $?passes))
			=>
			(retract ?f)
			(modify-instance ?p (passes
										loop-region-merging
										dependency-analysis
										wavefront-determinant
										paths-conditional
										;TODO: Insert more modules here
										$?passes)))
;------------------------------------------------------------------------------


Updated Header to load the Message template

; Header.clp Describes the header for the engine module
; See LICENSE for license details
; Written by Joshua Scoggins

(defmodule engine (export ?ALL))

(load* "src/clips/modules/engine/Object.clp")
(load* "src/clips/modules/engine/Entity.clp")
(load* "src/clips/modules/engine/Resource.clp")
(load* "src/clips/modules/engine/TextResource.clp")
(load* "src/clips/modules/engine/Message.clp")


Added more rules for GLAPIConversion

Added more rules for GLAPIConversion

I added suport for zero input functions as well as converging the rules for
setting names and type for a given argument

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; GLAPIConversion.clp - an expert system that reads a define and generates
; corresponding CLIPS functions that convert the CLIPS values into
; corresponding opengl types. This gets a little goofy when dealing with
; multifields but the idea is sound.
;------------------------------------------------------------------------------
; We need to add functionality to diverge asterisks from a symbol
;------------------------------------------------------------------------------
(target-symbol-is-special "*"
								  identify-symbols-with-asterisks
								  "Splits asterisks (*) out of symbols if necessary")
;------------------------------------------------------------------------------
; Unlike GLConstantConversion, I don't need to use the heading span objects.
; This is because each file-line has already been correctly merged.
;------------------------------------------------------------------------------
(defrule build-groups::delete-heading-span
			"We don't need heading spans in this expert system. So delete them"
			?obj <- (object (is-a heading-span))
			=>
			(unmake-instance ?obj))
;------------------------------------------------------------------------------
; We need to define a transformation function/rule f which is responsible for
; taking in a knowledge representation of the original code from the input
; language and translates it to a knowledge representation of the code in the
; output language. In this case it is C => C with the added "benefit" of
; needing to add CLIPS api calls to interact with the overall environment.
;
; This isn't really that hard as what we need to do is just parse the arguments
; and generate the corresponding C code.
;------------------------------------------------------------------------------
(defclass types::GLAPIFunction
  "Defines a given GLAPI function"
  (is-a Object)
  (slot return-type (type SYMBOL STRING))
  (slot function-name)
  (slot clips-function-name)
  (multislot arguments)
  (message-handler add-argument))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIFunction add-argument
						  "Adds the arg name and returns the index"
						  (?name)
						  (bind ?index (length$ ?self:arguments))
						  (if (= 0 ?index) then
							 (slot-direct-insert$ arguments 1 ?name)
							 (return 1)
							 else
							 (slot-direct-insert$ arguments ?index ?name)
							 (return ?index)))
;------------------------------------------------------------------------------
(defclass types::GLAPIArgument
  "Defines a given GLAPI function argument"
  (is-a Object)
  (slot argument-type)
  (slot argument-name)
  (slot index)
  (slot is-constant (type SYMBOL) (allowed-values FALSE TRUE))
  (slot is-pointer (type SYMBOL) (allowed-values FALSE TRUE))
  (message-handler reconstitute))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIArgument reconstitute
 ()
 (format t "%s %s %s %s"
  (if ?self:is-constant then "const" else "")
  ?self:argument-type
  (if ?self:is-pointer then "*" else "")
  ?self:argument-name))
;------------------------------------------------------------------------------
(defrule build-groups::build-glapi-function
			?msg <- (message (to build-groups)
								  (action add-to-span)
								  (arguments ?id))
			?obj <- (object (is-a file-line)
								 (id ?id)
								 (type GLAPI-DEF)
								 (contents GLAPI ?ret GLAPIENTRY ?name "(" $?args ")"))
			=>
			;we need to set this up to do conversion of the different arguments
			(bind ?objName (gensym*))
			(make-instance ?objName of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name)))
			(modify ?msg (to grouping-update)
					  (action parse-arguments)
					  (arguments ?objName => $?args)))
;------------------------------------------------------------------------------
(defrule build-groups::build-glapi-function-void
			?msg <- (message (to build-groups)
								  (action add-to-span)
								  (arguments ?id))
			?obj <- (object (is-a file-line)
								 (id ?id)
								 (type GLAPI-DEF)
								 (contents GLAPI ?ret GLAPIENTRY ?name "(" void ")"))
			=>
			;we need to set this up to do conversion of the different arguments
			(bind ?objName (gensym*))
			(retract ?msg)
			(make-instance ?objName of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::parse-arguments
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?sentry ,|"," $?rest))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?rest))
			(bind ?name (gensym*))
			(duplicate ?fct (action populate-argument)
						  (arguments ?name => $?sentry))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::create-last-argument
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?all))
			(test (and (not (member$ , $?all))
						  (not (member$ "," $?all))))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(bind ?name (gensym*))
			(modify ?fct (action populate-argument)
					  (arguments ?name => $?all))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-empty-parse-message
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule grouping-update::mark-argument-is-pointer
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => $?before "*" $?after))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?before $?after))
			(modify-instance ?obj (is-pointer TRUE)))
;------------------------------------------------------------------------------
(defrule grouping-update::mark-argument-is-constant
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => $?before const|"const" $?after))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?before $?after))
			(modify-instance ?obj (is-constant TRUE)))
;------------------------------------------------------------------------------
(defrule grouping-update::set-argument-core-info
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => ?type ?name))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(retract ?fct)
			(modify-instance ?obj (argument-type ?type)
			 (argument-name ?name)))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-arguments
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule grouping-update::printout-arguments
			(declare (salience -10))
			?obj <- (object (is-a GLAPIArgument))
			=>
			(send ?obj reconstitute)
			(printout t crlf))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2013, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; GLAPIConversion.clp - an expert system that reads a define and generates
; corresponding CLIPS functions that convert the CLIPS values into
; corresponding opengl types. This gets a little goofy when dealing with
; multifields but the idea is sound.
;------------------------------------------------------------------------------
; We need to add functionality to diverge asterisks from a symbol
;------------------------------------------------------------------------------
(target-symbol-is-special "*"
								  identify-symbols-with-asterisks
								  "Splits asterisks (*) out of symbols if necessary")
;------------------------------------------------------------------------------
; Unlike GLConstantConversion, I don't need to use the heading span objects.
; This is because each file-line has already been correctly merged.
;------------------------------------------------------------------------------
(defrule build-groups::delete-heading-span
			"We don't need heading spans in this expert system. So delete them"
			?obj <- (object (is-a heading-span))
			=>
			(unmake-instance ?obj))
;------------------------------------------------------------------------------
; We need to define a transformation function/rule f which is responsible for
; taking in a knowledge representation of the original code from the input
; language and translates it to a knowledge representation of the code in the
; output language. In this case it is C => C with the added "benefit" of
; needing to add CLIPS api calls to interact with the overall environment.
;
; This isn't really that hard as what we need to do is just parse the arguments
; and generate the corresponding C code.
;------------------------------------------------------------------------------
(defclass types::GLAPIFunction
  "Defines a given GLAPI function"
  (is-a Object)
  (slot return-type (type SYMBOL STRING))
  (slot function-name)
  (slot clips-function-name)
  (multislot arguments)
  (message-handler add-argument))
;------------------------------------------------------------------------------
(defmessage-handler types::GLAPIFunction add-argument
						  "Adds the arg name and returns the index"
						  (?name)
						  (bind ?index (length$ ?self:arguments))
						  (if (= 0 ?index) then
							 (slot-direct-insert$ arguments 1 ?name)
							 (return 1)
							 else
							 (slot-direct-insert$ arguments ?index ?name)
							 (return ?index)))
;------------------------------------------------------------------------------
(defclass types::GLAPIArgument
  "Defines a given GLAPI function argument"
  (is-a Object)
  (slot argument-type)
  (slot argument-name)
  (slot index)
  (slot is-constant (type SYMBOL) (allowed-values FALSE TRUE))
  (slot is-pointer (type SYMBOL) (allowed-values FALSE TRUE)))
;------------------------------------------------------------------------------
(defrule build-groups::build-glapi-function
			?msg <- (message (to build-groups)
								  (action add-to-span)
								  (arguments ?id))
			?obj <- (object (is-a file-line)
								 (id ?id)
								 (type GLAPI-DEF)
								 (contents GLAPI ?ret GLAPIENTRY ?name "(" $?args ")"))
			=>
			;we need to set this up to do conversion of the different arguments
			(bind ?objName (gensym*))
			(make-instance ?objName of GLAPIFunction
								(return-type ?ret)
								(function-name ?name)
								(clips-function-name (sym-cat CLIPS_ ?name)))
			(modify ?msg (to grouping-update)
					  (action parse-arguments)
					  (arguments ?objName => $?args)))
;------------------------------------------------------------------------------
(defrule grouping-update::parse-arguments
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?sentry ,|"," $?rest))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?rest))
			(bind ?name (gensym*))
			(duplicate ?fct (action populate-argument)
						  (arguments ?name => $?sentry))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::create-last-argument
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ?o => $?all))
			(test (and (not (member$ , $?all))
						  (not (member$ "," $?all))))
			?obj <- (object (is-a GLAPIFunction)
								 (id ?o))
			=>
			(bind ?name (gensym*))
			(modify ?fct (action populate-argument)
					  (arguments ?name => $?all))
			(make-instance ?name of GLAPIArgument
								(parent ?o)
								(index (send ?obj add-argument ?name))))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-empty-parse-message
			?fct <- (message (to grouping-update)
								  (action parse-arguments)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule grouping-update::mark-argument-is-pointer
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => $?before "*" $?after))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?before $?after))
			(modify-instance ?obj (is-pointer TRUE)))
;------------------------------------------------------------------------------
(defrule grouping-update::mark-argument-is-constant
			(declare (salience 1))
			?fct <- (message (to grouping-update)
								  (action populate-argument)
								  (arguments ?o => $?before const|"const" $?after))
			?obj <- (object (is-a GLAPIArgument)
								 (id ?o))
			=>
			(modify ?fct (arguments ?o => $?before $?after))
			(modify-instance ?obj (is-constant TRUE)))
;------------------------------------------------------------------------------
(defrule grouping-update::set-argument-name
         ?fct <- (message (to grouping-update)
				(action populate-argument)
				(arguments ?o => $?items ?name))
			?obj <- (object (is-a GLAPIArgument)
				(id ?o))
			=>
			(modify ?fct (arguments ?o => $?items))
			(modify-instance ?obj (argument-name ?name)))
;------------------------------------------------------------------------------
(defrule grouping-update::set-argument-type
         ?fct <- (message (to grouping-update)
				(action populate-argument)
				(arguments ?o => ?type $?rest))
			?obj <- (object (is-a GLAPIArgument)
				(id ?o))
			=>
			(modify ?fct (arguments ?o => $?rest))
			(modify-instance ?obj (argument-type ?type)))
;------------------------------------------------------------------------------
(defrule grouping-update::retract-arguments
         ?fct <- (message (to grouping-update)
				              (action populate-argument)
								  (arguments ? =>))
			=>
			(retract ?fct))
;------------------------------------------------------------------------------
(defrule grouping-update::printout-arguments
         (declare (salience -10))
			?obj <- (object (is-a GLAPIArgument))
			=>
			(send ?obj print))
;------------------------------------------------------------------------------


The rules in PathConstruction.clp now generate control facts

Each of these controls facts are meant to control the firing of the path
traverser rules and path building rules.

The reintroduction of this control fact makes it possible to have the same
behavior as the original wavefront scheduler that wasn't broken into modules.

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; PathConstruction.clp - Contains rules devoted to starting the construction of
; a given path through a given region. Rewritten to take advantage of modules
;------------------------------------------------------------------------------
(defrule paths-conditional::initialize-path-construction-region
         (declare (salience 3))
         ?fct <- (message (to paths-conditional)
                          (action valid-pathing-target)
                          (arguments ?id))
         ?r0 <- (object (is-a Region)
                        (id ?id)
                        (Entrances $? ?a $?)
                        (contents $? ?z $?))
         (object (is-a Region)
                 (id ?z)
                 (parent ?id)
                 (Entrances $? ?a $?))
         (object (is-a BasicBlock)
                 (id ?a)
                 (parent ?n&~?id))
         =>
         (bind ?name (gensym*))
         (modify ?fct (action build-path)
                 (arguments ?name))
         (make-instance ?name of Path
                        (parent ?n)
                        (values ?z)))
;------------------------------------------------------------------------------
(defrule paths-conditional::initialize-path-construction-basicblock
         (declare (salience 3))
         ?fct <- (message (to paths-conditional)
                          (action valid-pathing-target)
                          (arguments ?id))
         ?r0 <- (object (is-a Region)
                        (id ?id)
                        (Entrances $? ?a $?))
         (object (is-a BasicBlock)
                 (id ?a)
                 (parent ?n))
         =>
         (bind ?name (gensym*))
         (modify ?fct (action build-path)
                 (arguments ?name))
         (make-instance ?name of Path
                        (parent ?n)
                        (values ?a)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; PathConstruction.clp - Contains rules devoted to starting the construction of
; a given path through a given region. Rewritten to take advantage of modules
;------------------------------------------------------------------------------
(defrule paths-conditional::initialize-path-construction-region
			(declare (salience 3))
			?fct <- (message (to paths-conditional)
				              (action valid-pathing-target)
								  (arguments ?id))
			?r0 <- (object (is-a Region) (id ?id) (Entrances $? ?a $?)
								(contents $? ?z $?))
			(object (is-a Region) (id ?z) (parent ?id) (Entrances $? ?a $?))
			(object (is-a BasicBlock) (id ?a) (parent ?n&~?id))
			=>
			(retract ?fct)
			(make-instance of Path (parent ?n) (values ?z)))
;------------------------------------------------------------------------------
(defrule paths-conditional::initialize-path-construction-basicblock
			(declare (salience 3))
			?fct <- (message (to paths-conditional)
				              (action valid-pathing-target)
								  (arguments ?id))
			?r0 <- (object (is-a Region) (id ?id) (Entrances $? ?a $?)
								(contents $? ?z $?))
			(object (is-a BasicBlock) (id ?a) (parent ?n))
			=>
			(retract ?fct)
			(make-instance of Path (parent ?n) (values ?a)))
;------------------------------------------------------------------------------


Modified Loader.clp to do more than just load other files

Now it also contains the defmodules for the code in this folder as well as the
rule that performs the macro expansion in the pass-description object.

;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
(defmodule wavefront-scheduling-init
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (import indirect ?ALL)
			  (import rampancy ?ALL)
			  (import MAIN ?ALL))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-code::macro-expand
         ?msg <- (message (from pipeline)
                          (to wavefront-scheduling-code)
                          (action initial-fact))
         ?p <- (object (is-a pass-description) (passes $?passes))
         =>
         (retract ?msg)
         (modify-instance ?p (passes
                               wavefront-scheduling-init
                               ;TODO: add more modules
                               $?passes)))
;------------------------------------------------------------------------------
(load* "Stages/Wavefront/WavefrontInitialization.clp")
(load* "Stages/Wavefront/ValidBlockIdentification.clp")
(load* "Stages/Wavefront/WavefrontScheduling.clp")
(load* "Stages/Wavefront/WavefrontPropagation.clp")
(load* "Stages/Wavefront/WavefrontAdvancement.clp")
(load* "Stages/Wavefront/WavefrontDependencyUpdate.clp")
(load* "Stages/Wavefront/WavefrontOperandRename.clp")
(load* "Stages/Wavefront/WavefrontInstructionMerging.clp")
(load* "Stages/Wavefront/WavefrontBlockReopen.clp")

;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
(load* "Stages/Wavefront/WavefrontInitialization.clp")
(load* "Stages/Wavefront/ValidBlockIdentification.clp")
(load* "Stages/Wavefront/WavefrontScheduling.clp")
(load* "Stages/Wavefront/WavefrontPropagation.clp")
(load* "Stages/Wavefront/WavefrontAdvancement.clp")
(load* "Stages/Wavefront/WavefrontDependencyUpdate.clp")
(load* "Stages/Wavefront/WavefrontOperandRename.clp")
(load* "Stages/Wavefront/WavefrontInstructionMerging.clp")
(load* "Stages/Wavefront/WavefrontBlockReopen.clp")


change the call to is-registered with pass-registered

This is because is-registered is the message name associated with the Pass
object while pass-regitered is the command that links into the C++ side of
things.

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Pass.clp - Pass types that interact with LibIndirect
;------------------------------------------------------------------------------
(defclass indirect::PassBase
  "The base class of all passes (native or indirect)"
  (is-a Object)
  (slot pass-name (type SYMBOL STRING) (visibility public))
  (slot pass-description (type STRING) (visibility public)))
;------------------------------------------------------------------------------
(defclass indirect::NativePass
  "A wrapper over a native LLVM pass"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive))
;------------------------------------------------------------------------------
(defclass indirect::Pass
  "Represents an indirect pass that uses LibIndirect to interact with LLVM"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive)
  (slot pass-type (type SYMBOL) (allowed-symbols Unknown Module Function Region
																 Loop BasicBlock CallGraphSCC MachineFunction))
  (slot is-analysis (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot is-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-loops (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-regions (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-all (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (multislot passes (type SYMBOL))
  (multislot required (type SYMBOL))
  (multislot required-transitive (type SYMBOL))
  (multislot preserved (type SYMBOL))
  ;begin CLIPS specific slots
  (slot entry-point (type STRING))
  (message-handler register)
  (message-handler unregister)
  (message-handler is-registered))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass init around ()
						  (call-next-handler)
						  ;automatically load the code if there is an entry point
						  (if (and (< (str-length ?self:entry-point) 0)
									  (not (defmodule-exists ?self:pass-name))) then
							 (batch* ?self:entry-point))
						  (if (not (pass-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass register ()
						  (if (not (is-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)
							 (return TRUE)
							 else
							 (printout werror "ERROR: pass already registered" crlf)
							 (return FALSE)))

;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass unregister ()
						  (unregister-pass ?self:pass-name))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass is-registered ()
						  (pass-registered ?self:pass-name))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;Copyright (c) 2012, Joshua Scoggins
;All rights reserved.
;
;Redistribution and use in source and binary forms, with or without
;modification, are permitted provided that the following conditions are met:
;    * Redistributions of source code must retain the above copyright
;      notice, this list of conditions and the following disclaimer.
;    * Redistributions in binary form must reproduce the above copyright
;      notice, this list of conditions and the following disclaimer in the
;      documentation and/or other materials provided with the distribution.
;    * Neither the name of Joshua Scoggins nor the
;      names of its contributors may be used to endorse or promote products
;      derived from this software without specific prior written permission.
;
;THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
;ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;DISCLAIMED. IN NO EVENT SHALL Joshua Scoggins BE LIABLE FOR ANY
;DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
;LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
;ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;------------------------------------------------------------------------------
; Pass.clp - Pass types that interact with LibIndirect
;------------------------------------------------------------------------------
(defclass indirect::PassBase
  "The base class of all passes (native or indirect)"
  (is-a Object)
  (slot pass-name (type SYMBOL STRING) (visibility public))
  (slot pass-description (type STRING) (visibility public)))
;------------------------------------------------------------------------------
(defclass indirect::NativePass
  "A wrapper over a native LLVM pass"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive))
;------------------------------------------------------------------------------
(defclass indirect::Pass
  "Represents an indirect pass that uses LibIndirect to interact with LLVM"
  (is-a PassBase)
  (role concrete)
  (pattern-match reactive)
  (slot pass-type (type SYMBOL) (allowed-symbols Unknown Module Function Region
																 Loop BasicBlock CallGraphSCC MachineFunction))
  (slot is-analysis (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot is-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-loops (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot need-regions (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-all (type SYMBOL) (allowed-symbols FALSE TRUE))
  (slot preserves-cfg (type SYMBOL) (allowed-symbols FALSE TRUE))
  (multislot passes (type SYMBOL))
  (multislot required (type SYMBOL))
  (multislot required-transitive (type SYMBOL))
  (multislot preserved (type SYMBOL))
  ;begin CLIPS specific slots
  (slot entry-point (type STRING))
  (message-handler register)
  (message-handler unregister)
  (message-handler is-registered))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass init around ()
						  (call-next-handler)
						  ;automatically load the code if there is an entry point
						  (if (and (< (str-length ?self:entry-point) 0)
									  (not (defmodule-exists ?self:pass-name))) then
							 (batch* ?self:entry-point))
						  (if (not (is-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass register ()
						  (if (not (is-registered ?self:pass-name)) then
							 (register-pass ?self:pass-name
												 ?self:pass-description
												 ?self:pass-type
												 ?self:is-analysis
												 ?self:is-cfg
												 ?self:need-regions
												 ?self:need-loops
												 ?self:passes
												 ?self:required
												 ?self:required-transitive
												 ?self:preserved
												 ?self:preserves-all
												 ?self:preserves-cfg)
							 (return TRUE)
							 else
							 (printout werror "ERROR: pass already registered" crlf)
							 (return FALSE)))

;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass unregister ()
						  (unregister-pass ?self:pass-name))
;------------------------------------------------------------------------------
(defmessage-handler indirect::Pass is-registered ()
						  (pass-registered ?self:pass-name))
;------------------------------------------------------------------------------