Added is-macro to the Pass class

Added is-macro to the Pass class

is-macro allows the pipeline to replace the given pass name with a set of
subpasses. This replacement will only occur once a given element is the first
element of the list of passes left to execute.

;------------------------------------------------------------------------------
;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))
  ; this slot will allow us to expand passes that consist of multiple modules
  ; before changing focus to that module. This can be set to false even if
  ; there are submodules so that the programmer can control the process
  ; themselves. This is a convience feature more than anything else.
  (slot is-macro (type SYMBOL) (allowed-symbols FALSE TRUE))
  (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 (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)
							 (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 (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 (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)
							 (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))
;------------------------------------------------------------------------------


+ Added JDBC link snippet for testing

+ Added JDBC link snippet for testing

Tim

git-svn-id: 9643e93313b82f5e4da82d8413267a0daa4b5472@700 2cd91b7d-3b21-0410-a5f4-f42db4f24360

(deftemplate jdbc_test (slot id) (slot test_fact))
(assert
    (jdbclink
        (ConnectionName "testcon")
        (TableName "jamocha_facts")
        (TemplateName "jdbc_test")
        (Username "tim")
        (Password "jamocha")
        (JDBCurl "jdbc:postgresql://localhost:5432/tim")
        (JDBCdriver "org.postgresql.Driver")
    )
)
(jdbclink 2 "import" "foo")

error: pathspec 'samples/jdbclink.clp' did not match any file(s) known to git


Updated lib/durandal/Init.clp

Updated lib/durandal/Init.clp

The contents of the Init.clp file now also reference the pass registry as well
as defining the main module

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Init.clp - Default Entry Point for a expert system optimization
;------------------------------------------------------------------------------
; Usually this only contains elements necessary to start the load process
; With the modifications I made to CLIPS for LLVM this usually manifests
; itself as being a batch-load command which allows multiple loads to occur as
; a single command
;------------------------------------------------------------------------------
(batch-load
  (create$ "modules/core/ModuleHeader.clp"
			  "modules/llvm/ModuleHeader.clp"
			  "modules/rampancy/ModuleHeader.clp"
			  "modules/indirect/ModuleHeader.clp"
			  "modules/types/ModuleHeader.clp"
			  "modules/pipeline/ModuleHeader.clp"
			  ; Add entries to other modules here
			  "passes/PassRegistry.clp"
			  ))

(defmodule MAIN
			  (import core ?ALL)
			  (import llvm ?ALL)
			  (import rampancy ?ALL)
			  (import indirect ?ALL)
			  (import types ?ALL)
			  (import pipeline ?ALL)
			  (export ?ALL))

(reset)

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Init.clp - Default Entry Point for a expert system optimization
;------------------------------------------------------------------------------
; Usually this only contains elements necessary to start the load process
; With the modifications I made to CLIPS for LLVM this usually manifests
; itself as being a batch-load command which allows multiple loads to occur as
; a single command
;------------------------------------------------------------------------------
(batch-load
  (create$ "modules/core/ModuleHeader.clp"
	        "modules/llvm/ModuleHeader.clp"
        	  "modules/rampancy/ModuleHeader.clp"
			  "modules/indirect/ModuleHeader.clp"
			  "modules/types/ModuleHeader.clp"
			  "modules/pipeline/ModuleHeader.clp"
			  ; Add entries to other modules here
			  ))
;(defmodule MAIN (import core ?ALL) (import llvm ?ALL))


Finished WavefrontBlockReopen.clp porting.

;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.
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-reopen-blocks::AssertReopenBlocksOnWavefront
         ?fct <- (message (to wavefront-scheduling)
                          (action reopen-blocks)
                          (arguments ?cpv))
         ?obj <- (object (is-a CompensationPathVector)
                         (id ?cpv)
                         (Failures $?failures))
         =>
         (modify-instance ?obj (Failures))
         (modify ?fct (action reopen)
                 (arguments ?cpv => $?failures)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-reopen::ReopenBlockOnWavefront
         ?fct <- (message (to wavefront-scheduling)
                          (action reopen)
                          (arguments ?cpv => ?fail $?failures))
         ?wave <- (object (is-a Wavefront)
                          (Closed $?a ?fail $?b)
                          (contents $?cnts))
         ?bb <- (object (is-a BasicBlock)
                        (id ?fail)
                        (IsOpen FALSE))
         ?pa <- (object (is-a PathAggregate)
                        (parent ?fail)
                        (InstructionList $?il)
                        (ImpossibleCompensationPathVectors $?icpv))
         =>
         (modify-instance ?bb (IsOpen TRUE))
         (bind ?qs (create$))
         (progn$ (?q ?icpv)
                 (bind ?qObj (instance-address (symbol-to-instance-name ?q)))
                 (bind ?qs (create$ ?qs (send ?qObj get-parent))))
         (modify-instance ?pa (ImpossibleCompensationPathVectors)
                          (InstructionList $?il ?qs)
                          (TargetCompensationPathVectors $?icpv))
         (modify-instance ?wave (contents $?cnts ?fail)
                          (Closed ?a ?b))
         (modify ?fct (arguments ?cpv => $?failures)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-reopen-blocks::ReaddFailureToCPV
         ?fct <- (message (to wavefront-scheduling)
                          (action reopen)
                          (arguments ?cpv => ?fail $?failures))
         ?wave <- (object (is-a Wavefront)
           (Closed $?c&:(not (member$ ?fail $?c))))
         ?obj <- (object (is-a CompensationPathVector)
           (id ?cpv)
           (Failures $?z))
         =>
         (modify ?fct (arguments ?cpv => $?failures))
         (modify-instance ?obj (Failures $?z ?fail)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-reopen-blocks::RetractEmptyReopenFact
         ?fct <- (message (to wavefront-scheduling)
                          (action reopen)
                          (arguments ? =>))
         =>
         (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.
;------------------------------------------------------------------------------
(defrule AssertReopenBlocksOnWavefront
			(Stage WavefrontSchedule $?)
			(Substage ReopenBlocks $?)
			?fct <- (Reopen blocks from ?cpv)
			?obj <- (object (is-a CompensationPathVector) (ID ?cpv)
								 (Failures $?failures))
			=>
			(retract ?fct)
			(modify-instance ?obj (Failures))
			(assert (From ?cpv reopen $?failures)))
;------------------------------------------------------------------------------
(defrule ReopenBlockOnWavefront
			(Stage WavefrontSchedule $?)
			(Substage ReopenBlocks $?)
			?fct <- (From ?cpv reopen ?fail $?failures)
			?wave <- (object (is-a Wavefront) (ID ?w) (Closed $?a ?fail $?b)
								  (Contents $?cnts))
			?bb <- (object (is-a BasicBlock) (ID ?fail) (IsOpen FALSE))
			?pa <- (object (is-a PathAggregate) (Parent ?fail)
								(ImpossibleCompensationPathVectors $?icpv))
			=>
			(modify-instance ?bb (IsOpen TRUE))
			(modify-instance ?pa (ImpossibleCompensationPathVectors)
								  (TargetCompensationPathVectors $?icpv))
			(progn$ (?q ?icpv)
					  (slot-insert$ ?pa InstructionList 1
										 (send (symbol-to-instance-name ?q) get-Parent)))
			(modify-instance ?wave (Contents $?cnts ?fail) (Closed ?a ?b))
			(retract ?fct)
			(assert (From ?cpv reopen $?failures)))
;------------------------------------------------------------------------------
(defrule ReaddFailureToCPV
			(Stage WavefrontSchedule $?)
			(Substage ReopenBlocks $?)
			?fct <- (From ?cpv reopen ?fail $?failures)
			?wave <- (object (is-a Wavefront) (ID ?w) (Closed $?c))
			(test (not (member$ ?fail $?c)))
			?obj <- (object (is-a CompensationPathVector) (ID ?cpv))
			=>
			(slot-insert$ ?obj Failures 1 ?fail)
			(retract ?fct)
			(assert (From ?cpv reopen $?failures)))
;------------------------------------------------------------------------------
(defrule RetractEmptyReopenFact
			(Stage WavefrontSchedule $?)
			(Substage ReopenBlocks $?)
			?fct <- (From ? reopen)
			=>
			(retract ?fct))
;------------------------------------------------------------------------------


Fixed a typo in the visibility fields in Object.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.
;------------------------------------------------------------------------------
; Object.clp - Base class of all objects
;------------------------------------------------------------------------------
(defclass core::Object
  "Base class of all objects"
  (is-a USER)
  (slot id (type SYMBOL) (visibility public) (access initialize-only))
  (slot class (type SYMBOL) (visibility public) (access initialize-only)))
;------------------------------------------------------------------------------
(defmessage-handler core::Object init around
						  "Initializes the object, setting the id and class of the
						  object" ()
						  (call-next-handler)
						  ;we want to set this information as the last thing before
						  ;we return
						  (bind ?self:id (instance-name-to-symbol
												 (instance-name ?self)))
						  (bind ?self:class (class ?self)))
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
;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.
;------------------------------------------------------------------------------
; Object.clp - Base class of all objects
;------------------------------------------------------------------------------
(defclass core::Object
  "Base class of all objects"
  (is-a USER)
  (slot id (type SYMBOL) (visiblity public) (access initialize-only))
  (slot class (type SYMBOL) (visiblity public) (access initialize-only)))
;------------------------------------------------------------------------------
(defmessage-handler core::Object init around
						  "Initializes the object, setting the id and class of the
						  object" ()
						  (call-next-handler)
						  ;we want to set this information as the last thing before
						  ;we return
						  (bind ?self:id (instance-name-to-symbol
												 (instance-name ?self)))
						  (bind ?self:class (class ?self)))
;------------------------------------------------------------------------------


Fixed a bug where instances of scan path were not be retracted when finished

;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 is wavefront-scheduling-identify
(defrule wavefront-scheduling-identify::AssertIdentifySpansInitial
         (declare (salience 5))
         (object (is-a Wavefront)
          (parent ?r)
          (values $? ?e $?))
         ;select only BasicBlocks
         (object (is-a BasicBlock)
          (id ?e))
         =>
         (assert (Picked ?e for ?r)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-identify::IdentifySpanSkips-InvalidBlock
         (declare (salience 4))
         ?fct <- (Picked ?e for ?r)
         ?bb <- (object (is-a BasicBlock)
                        (id ?e)
                        (Successors $?a&:(not (eq (length$ $?a) 1))))
         =>
         ;we don't need to assert anything since the block isn't going to get
         ;scheduled
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-identify::IdentifySpans
         (declare (salience 4))
         ?fct <- (Picked ?block for ?)
         ?bb <- (object (is-a BasicBlock)
                        (id ?block)
                        (Successors ?) ; we only have one successor
                        (Paths $?paths))
         =>
         (retract ?fct)
         (modify-instance ?bb (IsOpen TRUE))
         ; originally I had a rule here that took a fact asserted in the form
         ; ?e => $?paths which would be inverted individually by separate rule
         ; fires. While this is more like an expert system, it is extremely
         ; inefficient because the agenda has to be updated after each rule
         ; fire. Using this technique allows me to minimize the number of rule
         ; fires to one yet do the same amount of work.
         (progn$ (?path $?paths)
                 (assert (message (to wavefront-scheduling)
                                  (action check-path)
                                  (arguments ?path for block ?block)))))
;------------------------------------------------------------------------------
; defmodule is wavefront-scheduling-pathing
(defrule wavefront-scheduling-pathing::GetFactsBeforePathing
         (declare (salience 10000))
         (message (action Debug))
         (message (action Facts))
         =>
         (printout t "BEFORE: Wavefront Pathing " crlf crlf)
         (facts)
         (printout t crlf crlf))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pathing::DispatchDivideBlock
         (declare (salience 200))
         ?fct <- (message (to wavefront-scheduling)
                          (action check-path)
                          (arguments ?path for block ?block))
         (object (is-a Path)
                 (id ?path)
                 (values $? ?block $?rest))
         ;we don't need to explicitly match for ?block
         =>
         (retract ?fct)
         (assert (message (to wavefront-scheduling-pathing)
                          (action scan-path)
                          (arguments ?path ?block => $?rest))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pathing::AnalyzePathElements
         ?fct <- (message (to wavefront-scheduling-pathing)
                          (action scan-path)
                          (arguments ?p ?e => ?curr $?rest))
         ?bb <- (object (is-a BasicBlock)
                        (id ?curr)
                        (Successors $?succ)
                        (HasCallBarrier ?hcb)
                        (HasMemoryBarrier ?hmb))
         =>
         (bind ?sLen (length$ $?succ))
         (if (= 0 ?sLen) then
           (assert (message (to wavefront-scheduling)
                            (action completely-invalid-blocks)
                            (arguments ?e => ?curr)))
           (retract ?fct)
           else
           (if (or (> ?sLen 1) ?hcb) then
             (assert (message (to wavefront-scheduling)
                              (action completely-invalid-blocks)
                              (arguments ?e => $?rest))
                     (message (to wavefront-scheduling)
                              (action potentially-valid-blocks)
                              (arguments ?e => ?curr)))
             (retract ?fct)
             else
             (if ?hmb then
               (assert (message (to wavefront-scheduling)
                                (action element-has-memory-barrier)
                                (arguments ?curr => ?e))))
             (modify ?fct (arguments ?p ?e => $?rest))
             (assert (message (to wavefront-scheduling)
                              (action potentially-valid-blocks)
                              (arguments ?e => ?curr))))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pathing::AnalyzePathElements-Region
         ?fct <- (message (to wavefront-scheduling-pathing)
                          (action scan-path)
                          (arguments ?p ?e => ?curr $?rest))
         ?bb <- (object (is-a Region)
                        (id ?curr)
                        (HasCallBarrier ?hcb)
                        (HasMemoryBarrier ?hmb))
         =>
         (if ?hcb then
           (assert (message (to wavefront-scheduling)
                            (action completely-invalid-blocks)
                            (arguments ?e => $?rest))
                   (message (to wavefront-scheduling)
                            (action potentially-valid-blocks)
                            (arguments ?e => ?curr)))
           (retract ?fct)
           else
           (if ?hmb then
             (assert (message (to wavefront-scheduling)
                              (action element-has-memory-barrier)
                              (arguments ?curr => ?e))))
           (modify ?fct (arguments ?p ?e => $?rest))
           (assert (message (to wavefront-scheduling)
                            (action potentially-valid-blocks)
                            (arguments ?e => ?curr)))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pathing::RetractCompletedFact
         ?fct <- (message (to wavefront-scheduling-pathing)
                          (action scan-path)
                          (arguments ? ? =>))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pathing::PrintoutCompletedFacts
         (declare (salience -999))
         (message (action Debug))
         (message (action Facts))
         =>
         (printout t "AFTER: Wavefront Pathing" crlf crlf)
         (facts)
         (printout t crlf crlf))
;------------------------------------------------------------------------------

;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 is wavefront-scheduling-identify
(defrule wavefront-scheduling-identify::AssertIdentifySpansInitial
         (declare (salience 5))
         (object (is-a Wavefront)
          (parent ?r)
          (values $? ?e $?))
         ;select only BasicBlocks
         (object (is-a BasicBlock)
          (id ?e))
         =>
         (assert (Picked ?e for ?r)))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-identify::IdentifySpanSkips-InvalidBlock
         (declare (salience 4))
         ?fct <- (Picked ?e for ?r)
         ?bb <- (object (is-a BasicBlock)
                        (id ?e)
                        (Successors $?a&:(not (eq (length$ $?a) 1))))
         =>
         ;we don't need to assert anything since the block isn't going to get
         ;scheduled
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-identify::IdentifySpans
         (declare (salience 4))
         ?fct <- (Picked ?block for ?)
         ?bb <- (object (is-a BasicBlock)
                        (id ?block)
                        (Successors ?) ; we only have one successor
                        (Paths $?paths))
         =>
         (retract ?fct)
         (modify-instance ?bb (IsOpen TRUE))
         ; originally I had a rule here that took a fact asserted in the form
         ; ?e => $?paths which would be inverted individually by separate rule
         ; fires. While this is more like an expert system, it is extremely
         ; inefficient because the agenda has to be updated after each rule
         ; fire. Using this technique allows me to minimize the number of rule
         ; fires to one yet do the same amount of work.
         (progn$ (?path $?paths)
                 (assert (message (to wavefront-scheduling)
                                  (action check-path)
                                  (arguments ?path for block ?block)))))
;------------------------------------------------------------------------------
; defmodule is wavefront-scheduling-pathing
(defrule wavefront-scheduling-pathing::GetFactsBeforePathing
         (declare (salience 10000))
         (message (action Debug))
         (message (action Facts))
         =>
         (printout t "BEFORE: Wavefront Pathing " crlf crlf)
         (facts)
         (printout t crlf crlf))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pathing::DispatchDivideBlock
         (declare (salience 200))
         ?fct <- (message (to wavefront-scheduling)
                          (action check-path)
                          (arguments ?path for block ?block))
         (object (is-a Path)
                 (id ?path)
                 (values $? ?block $?rest))
         ;we don't need to explicitly match for ?block
         =>
         (retract ?fct)
         (assert (message (to wavefront-scheduling-pathing)
                          (action scan-path)
                          (arguments ?path ?block => $?rest))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pathing::AnalyzePathElements
         ?fct <- (message (to wavefront-scheduling-pathing)
                          (action scan-path)
                          (arguments ?p ?e => ?curr $?rest))
         ?bb <- (object (is-a BasicBlock)
                        (id ?curr)
                        (Successors $?succ)
                        (HasCallBarrier ?hcb)
                        (HasMemoryBarrier ?hmb))
         =>
         (bind ?sLen (length$ $?succ))
         (if (= 0 ?sLen) then
           (assert (message (to wavefront-scheduling)
                            (action completely-invalid-blocks)
                            (arguments ?e => ?curr)))
           (retract ?fct)
           else
           (if (or (> ?sLen 1) ?hcb) then
             (assert (message (to wavefront-scheduling)
                              (action completely-invalid-blocks)
                              (arguments ?e => $?rest))
                     (message (to wavefront-scheduling)
                              (action potentially-valid-blocks)
                              (arguments ?e => ?curr)))
             (retract ?fct)
             else
             (if ?hmb then
               (assert (message (to wavefront-scheduling)
                                (action element-has-memory-barrier)
                                (arguments ?curr => ?e))))
             (modify ?fct (arguments ?p ?e => $?rest))
             (assert (message (to wavefront-scheduling)
                              (action potentially-valid-blocks)
                              (arguments ?e => ?curr))))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pathing::AnalyzePathElements-Region
         ?fct <- (message (to wavefront-scheduling-pathing)
                          (action scan-path)
                          (arguments ?p ?e => ?curr $?rest))
         ?bb <- (object (is-a Region)
                        (id ?curr)
                        (HasCallBarrier ?hcb)
                        (HasMemoryBarrier ?hmb))
         =>
         (if ?hcb then
           (assert (message (to wavefront-scheduling)
                            (action completely-invalid-blocks)
                            (arguments ?e => $?rest))
                   (message (to wavefront-scheduling)
                            (action potentially-valid-blocks)
                            (arguments ?e => ?curr)))
           (retract ?fct)
           else
           (if ?hmb then
             (assert (message (to wavefront-scheduling)
                              (action element-has-memory-barrier)
                              (arguments ?curr => ?e))))
           (modify ?fct (arguments ?p ?e => $?rest))
           (assert (message (to wavefront-scheduling)
                            (action potentially-valid-blocks)
                            (arguments ?e => ?curr)))))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pathing::RetractCompletedFact
         ?fct <- (message (to wavefront-scheduling)
                          (action scan-path)
                          (arguments ? ? =>))
         =>
         (retract ?fct))
;------------------------------------------------------------------------------
(defrule wavefront-scheduling-pathing::PrintoutCompletedFacts
         (declare (salience -999))
         (message (action Debug))
         (message (action Facts))
         =>
         (printout t "AFTER: Wavefront Pathing" crlf crlf)
         (facts)
         (printout t crlf crlf))
;------------------------------------------------------------------------------