;copywr:bobak@computer.org
;--------------------------------------------------------------EOF
(deffunction ptag (?n) (printout t t "a stub for ptag" ?n))
;start of pvm clips task code, Mike B. ;-needs:util.clp
(defglobal ?*my-tid* = 0)
(defglobal ?*parent-tid* = 0)
(defglobal ?*model* = 0) ;compiled w/ the model, or talking to it
(defglobal ?*inst-tids* = (create$ )) ;tids of all the task instances
(defglobal ?*start-time* = 0)
(defglobal ?*recv-d-time* = 10)
;------------------------------------------------util
;(deffunction elapse-time () (- (time) ?*start-time*)) in misc-fnc.clp
(deffunction elapse-time () (- (time) ?*start-time*)) ;in misc-fnc.clp
(deffunction upk1int () (upkint))
;holds the information on how to contact another unix process on the
;virtual machine (note: pvm's virtual machine can include many machines)
(defclass TASK
(is-a INITIAL-OBJECT)
(role concrete) (pattern-match reactive)
(slot init-time (create-accessor read-write))
(slot active (create-accessor read-write))
(slot tid (create-accessor read-write))
(slot tpid (create-accessor read-write))
(slot host (create-accessor read-write))
(slot flag (create-accessor read-write))
;(multislot msgtags (create-accessor read-write)) ;tags of possible interest
(slot global-name ;(type INSTANCE)
(create-accessor read-write) (visibility public))
(slot Name (create-accessor read-write)))
;a type of task which will be a clips process which controls a model
(defclass CNTRL-TASK
(is-a TASK)
(role concrete) (pattern-match reactive)
(slot init-time (create-accessor read-write)))
;a type of task which will be the actual FORTRAN/C(++) model
(defclass MODEL-TASK
(is-a TASK)
(role concrete) (pattern-match reactive)
(slot init-time (create-accessor read-write)))
;send-str (implode$ (local-slotnames ?inst))
;send-str (implode$ (slot-local-values ?inst))
;can use to-str & to-pstr=quote now for any list of args
;-------------------------------------------------------send_to_tasks
;so can send whatever is packed up to many different tasks
;can use mcast too, or bcast & a group name
(deffunction send_to_tasks ($?tasks)
;(map2 send_ (map1 get-tid ?tasks) 0)
;(map2 send_0 ?tasks) ;in my orig file
(map2 send_0 ?tasks 0) ;a guess at a fix, mb
)
;-------------------------------------------------------GET-TID
(deffunction get-tid (?task)
(if (numberp ?task) then ?task
else (if (instancep ?task) then (send ?task get-tid)
else (printout t "[get-tid:bad-arg " ?task "]"))))
;(if (numberp ?task) then ?task else (send ?task get-tid))
; else if (stringp ?task) then return all the tids
;-------------------TASK msg handlers-----------------
;-------------------send/recv handlers
;(deffunction send-str-to (?str $?tasks)
; (printout t "[send-str to defined below]"))
(deffunction send-str-to (?str $?tasks)
(printout t "[send-str to defined below]"))
;------------------------------------------------------task EVAL
;take the args make into a parened string, and send to task for evaluation
;(defmessage-handler TASK eval primary ($?args)
; (send-str-to (quotes ?args) ?self))
;-------------------TASK init handler -------------
;makes sure that a newly created task has many of its slots filled in.
(defmessage-handler TASK init after ()
(send ?self put-init-time (elapse-time))
;if active slot isn't set, the task is waiting (by default)
;if spawned or gotton from tasks it should be set to active (if it is)
;flag has some of that status info
(if (not (symbolp ?self:active)) then (send ?self put-active waiting))
;set host if not set
(if (and (numberp ?self:tid) (not (numberp ?self:host))) then
(send ?self put-host (tidtohost ?self:tid)))
(insert$ ?*inst-tids* 1 ?self:tid)
;if there is a global-name for the task make that inst w/ the same tid
(if (or (and (instancep ?self:global-name) (neq ?self:global-name [nil]))
(stringp ?self:global-name)) then
(make-instance ?self:global-name of TASK (tid ?self:tid)))
)
(defmessage-handler TASK get-tid before ()
(if (null ?self:tid) then (printout t "[" ?self " has no tid, so put-tid]")))
;--ADD-TASK (takes 2 strings & and int right now)
;makes an instance of a task
(deffunction add-process (?name ?where ?tid)
(make-instance (sym-cat task- ?name - ?tid) of TASK
(tid ?tid)
(host ?where)
(Name ?name)))
;--MAKE-TASK (takes 2 strings right now)
;makes an instance of a task
(deffunction make-process (?name ?where)
(bind ?tid
(spawn ?name "(load pvm-agt)" 1 ?where (if (stringp ?where) then 1 else 0)) )
(add-process ?name ?where ?tid))
;latter will just incr the #, and use the tid slot for sends
;might still want something like above, so when you have a task/spawn it
;that the rest of the (tasks tid) info can be parsed into the new instance
;------------------------------------------------------task EVAL
;take the args make into a parened string, and send to task for evaluation
(defmessage-handler TASK eval primary ($?args)
(send-str-to (quotes ?args) ?self))
;------------------------------------------------------
;------------------------------------------------------OID
(defclass OID ;obj id (~= cORB-NAME)
(is-a INITIAL-OBJECT)
(role concrete) (pattern-match reactive)
(slot tid (create-accessor read-write)) ;task id ([inst] or int id)
(slot iid (create-accessor read-write)) ;inst id ([inst] or str id)
(slot orb-name (create-accessor read-write))) ;name given by naming service
;to have a globally seperate name, need 1 naming service
;either inst-name or orb-name slot should be unique
;-----------------------------------------------------new:
;(defclass TID ;task obj id ;mirror globals for now
; (is-a INITIAL-OBJECT)
; (role concrete) (pattern-match reactive)
; (slot tid (type INTEGER) (create-accessor read-write)) ;task id ([inst] or int id)
; (slot pid (type INTEGER) (create-accessor read-write)) ;parent task id ([inst] or int id)
; (slot start-time (type INTEGER) (create-accessor read-write)) ;also was a global
; (slot recv-d-time (type INTEGER) (create-accessor read-write)) ;also was a global
; (slot model (type INTEGER) (create-accessor read-write)) ;also was a global
; (multislot inst-tids (create-accessor read-write)) ;also was a global
;)
;-----------------------------------------------------EOF
;start of pvm clips code, Mike B. ;-needs:util.clp
;-------------------send/recv functions
;----------------------------------------send-str
;general send a string to a task w/ tid (takes an int||task & string, w/opt int)
(deffunction send-str (?task ?str $?msgtag)
(initsend 0)
(if (and (integerp (bind ?tid (get-tid ?task))) (lexemep ?str)) then
(pkstr ?str) ;might use stringp
(send_ ?tid (first-dflt ?msgtag 0))
else (printout t "[bad send-str " ?task ", " ?str "]")))
;----------------------------------------send-str-to
;(deffunction send-str-to (?str ?task)
; (initsend 1)
; (if (and (integerp (bind ?tid (get-tid ?task))) (stringp ?str)) then
; (pkstr ?str) (send_ ?tid 0)
; else (printout t "[bad send-str-to " ?task ", " ?str "]")))
;----------------------------------------send_0
;(deffunction send_0 (?task)
; (if (integerp (bind ?tid (get-tid ?task))) then (send_ ?tid 0)
; else (printout t "[bad send_0 " ?tid "]")))
;task can be a task-inst a tid or a group-string, msgtag will=0
(deffunction send_0 (?task)
(if (integerp (bind ?tid (get-tid ?task))) then (send_ ?tid 0)
else (if (stringp ?task) then (bcast ?task 0)
else (printout t "[bad send_0 " ?tid "]"))))
;----------------------------------------SEND-STR-TO
(deffunction send-str-to (?str $?tasks)
(initsend 1)
(if (stringp ?str) then (pkstr ?str) (map1 send_0 ?tasks)
else (printout t "[bad send-str-to " ?tasks ", " ?str "]")))
;----------------------------------------send-str-to-deem
;(deffunction send-str-to-deem (?str)
; (initsend 1) (pkstr ?str) (bcast "deem" 0))
;----------------------------------------send-str-to-models
;(deffunction send-str-to-models (?str)
; (initsend 1) (pkstr ?str) (bcast "models" 0))
;---------------------------------------------------(u)pk strings by bytes
(deffunction pkstrb (?str)
(bind ?l (+ (str-length ?str) 1))
(printout t "[pkstrb of len=" ?l "]")
;(free (pkbyte (deref b (imalloc ?l) ?str) ?l))
(pkbyte (deref b (imalloc ?l) ?str) ?l))
;-------------------
;(deffunction upkstrb (?l) (deref b (upkbyte (imalloc ?l) ?l)))
(deffunction upkstrb (?l)
(bind ?p (imalloc ?l))
(printout t "[upkstrb of len=" ?l "into " ?p "]")
(bind ?p2 (upkbyte ?p ?l))
(printout t "final ptr=" ?p2)
(deref b ?p2))
;-------------------
;----------------------------------------send-cl
;general send a string to a task w/ tid (takes an int & string)
;pkbyte for sends to fortran, probably won't be used
(deffunction send-cl (?tid ?str ?len)
(initsend 0)
(pkbyte ?str ?len)
(send_ ?tid 1))
(deffunction send-c (?tid ?str)
(send-cl ?tid ?str (str-length ?str)))
;----------------------------------------TRECV_EVAL
;timed receive, which expects a string, and will evaluate it.
(deffunction trecv_eval ($?time)
(bind ?t (first-dflt ?time 10))
(if (<> (trecv -1 0 ?t) 0) then ;(eval (upkstr))
(bind ?str (upkstr))
(if (lexemep ?str) then (eval ?str)
else (printout t "[bad trecv_eval:" ?str "]"))
))
;----------------------------------------recv-eval
;general receive any string and eval it (run this periodically)
(deffunction recv-eval ($?tid)
(recv_ (first-dflt ?tid -1) 0)
(eval (upkstr)))
;-------------------------------------------------EOF
;misc-fnc.clp has various misc functions MTB
;----------------------------------------time etc
(deffunction elapse-time () (- (time) ?*start-time*))
(deffunction rt () (round (time)))
(deffunction rt1 () (round (/ (time) 10)))
(deffunction rt2 () (round (/ (time) 100)))
(deffunction debug (?level) (setopt 2 ?level)) ;sets it up for debugs
(deffunction rr () (reset) (run 1) (agenda) (debug 1)) ;to start it up
(deffunction e () (agenda) (exit_pvm) (exit)) ;exit in a clean way
(deffunction ri (?file) (load-instances ?file))
(deffunction sleep (?t) (system (format nil "sleep %d" ?t)))
(deffunction is () (initsend 1)) ;1=no encodeing,0=xdr (avoid 2 for strs)
(deffunction bi () (bufinfo))
(deffunction rbi () (progn (recv_ -1) (bufinfo)))
(deffunction lrbi (?i) (loop-for-count ?i (printout t (rbi) crlf)))
;----------------------------------------------------------------DEBUG FNCS
;these below are already in utils.clp apr2005
;(deffunction wa () (watch all))
;(deffunction wmsg () (watch messages))
;(deffunction whnd () (watch message-handlers))
;(deffunction uwa () (unwatch all))
;(deffunction wdf ($?fncs) (funcall watch deffunctions ?fncs))
;(deffunction uwdf ($?fncs) (funcall unwatch deffunctions ?fncs))
;(deffunction wmh ($?fncs) (funcall watch message-handlers ?fncs))
;(deffunction uwmh ($?fncs) (funcall unwatch message-handlers ?fncs))
;(deffunction insm (?class) (instances MAIN ?class))
;(deffunction list-insts (?class) (instances MAIN ?class))
;(deffunction list-insts-from (?class) (instances MAIN ?class))
;might make a (wa) that takes extra args that would be fncs to (uwdf)
;----------------------------------------------------------------
;(deffunction list ($?stuff) (create$ ?stuff))
;;(deffunction let* ($?l2) (map-skip 2 bind ?l2))
;add from this utils:
(deffunction union- (?l1 ?l2) (create$ ?l1 ?l2)) ;for rul.clp -mb
;--------------------------------------------------------EOF
;-------------------util fncs
(deffunction s-atoi (?str)
(if (or (null ?str) (eq ?str "")) then 0 else (atoi ?str)))
;(deffunction gn (?ins) (instance-name-to-symbol ?ins))
;(deffunction gn (?ins) (sub-string 11 55 (str-cat (sym-cat ?ins))))
(deffunction gn (?ins) ?ins) ;just use instance-name
;=================================================================UPDATEABLE
;anything which is updated/ has a time-stamp /needs an explanation
(defclass UPDATEABLE
(is-a INITIAL-OBJECT)
(role concrete)
(pattern-match reactive)
;set these in advance
(slot expl (type STRING) ;short description
(create-accessor read-write) (visibility public))
(slot time (type INTEGER) ;time of last update
(create-accessor read-write) (visibility public))
;get/put deamons will update, so can be used for 'freshness'/matching
(slot get-time (type INTEGER) ;time of last put bind
(create-accessor read-write) (visibility public))
(slot put-time (type INTEGER) ;time of last get request
(create-accessor read-write) (visibility public))
(slot fresh (default FALSE) ;if the proj is newly filled
(create-accessor read-write))
)
;-----------------------------------make-fresh
(deffunction make-fresh (?p)
(send ?p put-fresh TRUE)
(if (slot-existp (class ?p) params) then
(map1 make-fresh (send ?p get-params))))
;will be done during an unpack & by running appropriate subs ?
;-------------------------------------------updateable INIT after
(defmessage-handler UPDATEABLE init after ()
(bind ?self:time (round (elapse-time))))
;-------------------
;=================================================================ACCESSIBLE
;-------------------
;used for any instance that will be transmitted between unix processes
(defclass ACCESSIBLE
(is-a UPDATEABLE) ; (is-a INITIAL-OBJECT)
(role concrete)
(pattern-match reactive)
;this will be even more of a numeric (rather than str) id, (no necc. msgtag)
(slot msgtag (type INTEGER) ;the flag used in the model (vid,fid)
(create-accessor read-write) (visibility public))
;set at runtime
(slot in-task ;task it is in
(create-accessor read-write) (visibility public))
(slot in-tid (type INTEGER) ;task-id it is in ??
(create-accessor read-write) (visibility public))
(slot count (type INTEGER) ;number of this type of instance made
(create-accessor read-write) (storage shared))
)
;-------------------------------------------accessible INIT after
(defmessage-handler ACCESSIBLE init after ()
(bind ?self:put-time (round (elapse-time)))
(if (instance-existp ?self:in-task) then
(printout t "[filling in-tid slot]")
(bind ?self:in-tid (get-tid ?self:in-task))))
;--------------------------------------------------------GET-TAG(s)
(deffunction get-tag (?acc) ;send in and accessible|| tag get out a tag
(if (numberp ?acc) then ?acc else (send ?acc get-msgtag)))
(deffunction get-tags ($?accs) (map1 get-tag ?accs)) ;outputs the tags
;--------------------------------------------------------
;keep simulated real time/ real clock time ratio -to see how its doing
;--------------------------------------------------------EOF
;class lib and msg handlers for arrays=(values of params) M.Bobak,ANL
;--------------------------
;-needs: util.clp
;--------------------------
;might have some array stuff accessible through PARAM handlers?
;lambda-fncs would still be nice (maybe tcl or scheme)-(has array,vect too)
;output to hdf format for viewing, trans this way?,can do quick mat.calcs
;==============================================================ARRAY
(defclass ARRAY
(is-a ACCESSIBLE)
(role concrete)
(pattern-match reactive)
(slot count (type INTEGER) ;number of this type of instance made
(create-accessor read-write) (storage shared))
(slot fresh (default FALSE) ;if the array is newly filled
(create-accessor read-write))
;----------------------stuff for the array 0 to 3 dim
(slot type (default f) ;type of the array value (i/f/d/s)
(create-accessor read-write) (visibility public))
; (multislot index (type INTEGER) (create-accessor read-write)) ;max array index
(slot lang (type SYMBOL) (create-accessor read-write)) ;FORTRAN or C
(slot x (type INTEGER) (default 1) ;1st dimension index
(create-accessor read-write) (visibility public))
(slot y (type INTEGER) (default 1) ;2nd dimension index
(create-accessor read-write) (visibility public))
(slot z (type INTEGER) (default 1) ;3rd dimension index
(create-accessor read-write) (visibility public))
(slot num (type INTEGER) (default 1) ;num of elts
(create-accessor read-write) (visibility public))
(slot size (type INTEGER) (default 1) ;num of elements * #bytes/element
(create-accessor read-write) (visibility public)) ;can just calc
(slot val_ptr (type INTEGER) ;long_int to point to value
(create-accessor read-write) (visibility public))
;----------------------if array a seperate class fill these
;for viewing & matching, which can be done with (param)arrays
;w/deamons can get and set val_ptr ed space, and update get/put-time
(slot value ;first value (usually only if 111)
(create-accessor read-write) (visibility public))
(multislot values ;first values (usually only if n11)
(create-accessor read-write) (visibility public))
)
;-----------------------------------------------------------GET-VALUE
(defmessage-handler ARRAY get-value after () ;for debugging
(printout t "[" (instance-name ?self) " v=" ?self:value "]"))
(deffunction get-value (?p) ;or (slot-value ?p value)
(if (slot-existp (class ?p) value) then (send ?p get-value)
else (printout t "[WARNING:" ?p " does not have a value slot]")) )
(deffunction gv (?p) (slot-value ?p value))
(deffunction pv (?p ?v) (send ?p put-value ?v))
;if get rid of value slot have these fncs, then hndlrs too
;(deffunction get-value (?p) (first (slot-value ?p values)))
;(deffunction put-value (?p ?val) (replace$ (slot-value ?p values) 1 1 ?val))
;-------------------------------------------array INIT after
(defmessage-handler ARRAY init after ()
(printout t ?self ",")
(send ?self incr count)
(bind ?self:num (* ?self:x ?self:y ?self:z))
(bind ?self:size (* ?self:num (typelen ?self:type)))
(if (< ?self:val_ptr 999) then (bind ?self:val_ptr (imalloc ?self:size)))
; (if (or (and (instancep ?self:global-name) (neq ?self:global-name [nil]))
; (stringp ?self:global-name)) then
; (make-instance ?self:global-name of ARRAY
; (x ?self:x) (y ?self:y) (z ?self:z)
; (msgtag ?self:msgtag) (val_ptr ?self:val_ptr)))
)
;in the end it might not have the same val_ptr/msgtag-for printing
;-------------------------------------------(array)MPRINT
(defmessage-handler ARRAY mprint primary () ;for debugging
(ptag (nnn ?self:msgtag)))
;-------------------------------------------(array)PUT-INDEX
(defmessage-handler ARRAY put-index ($?indx) ;sets indecies
(bind ?self:x (first-dflt ?indx 1))
(bind ?self:y (second-dflt ?indx 1))
(bind ?self:z (third-dflt ?indx 1)))
;=======================================================ARRAY STUFF
;'arrays' can be from 0 to 3 dimensions, (single= 1 1 1)
;-------------------------------------------------------Deref Handlers
(defmessage-handler ARRAY deref primary ($?nums)
(if (<> (length$ ?nums) 0) then (funcall deref ?self:type ?self:val_ptr ?nums)
else (deref ?self:type ?self:val_ptr)))
;-------------------
(defmessage-handler ARRAY deref-off primary (?offset $?nums)
(if (> ?offset ?self:size) then
(printout t "WARNING:offset too large " ?offset crlf) (return nil))
(printout t "[deref-off " ?offset " makes " ?self:val_ptr " into " (+ ?self:val_ptr (* ?offset 4)) "," ?nums "]" crlf)
(if (<> (length$ ?nums) 0)
then (funcall deref ?self:type (+ ?self:val_ptr (* ?offset 4)) ?nums)
else (deref ?self:type (+ ?self:val_ptr (* ?offset 4)))))
;right now type-size is hard-coded to 4
;-------------------
(defmessage-handler ARRAY zero-to primary (?n)
(loop-for-count (?i 0 ?self:num) do (send ?self deref-off ?i ?n)))
;-------------------
(defmessage-handler ARRAY deref-off-n primary (?offset ?n)
(bind ?top (+ ?offset ?n))
(bind ?l (create$ ))
(loop-for-count (?i 0 ?n) do
(printout t "[" (send ?self deref-off (- ?top ?i)) "]")
(insert$ ?l 1 (send ?self deref-off (- ?top ?i))))
?l)
;-------------------
(deffunction add2 (?x ?y) (+ ?x ?y))
(deffunction sub2 (?x ?y) (- ?x ?y))
(deffunction div2 (?x ?y) (/ ?x ?y))
(deffunction mul2 (?x ?y) (* ?x ?y))
;maybe ?fnc ?outarray $?array where they could be nums or array
;so array becomes a new wilder m.f.
(defmessage-handler ARRAY deref-fnc2 primary (?fnc ?warray ?outarray $?off-n)
(bind ?offset (first-dflt ?off-n 0))
(bind ?n (second-dflt ?off-n ?self:num))
(bind ?top (+ ?offset ?n))
(loop-for-count (?i ?offset ?top) do
(send ?outarray deref-off ?i
(funcall ?fnc (send ?self deref-off ?i) (send ?warray deref-off ?i)))))
;(get-nprcpk of SUBROUTINE
; (sub "(send [rainc] deref-fnc2 add2 [rainnc] [nprcpk])"))
;then (call [get-nprcpk]) to calculate it (do this in bats) rain(n)c state-vars
;-------------------
(defmessage-handler ARRAY check-ptr primary ()
(if (< (nn ?self:val_ptr) 99) then
(printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return TRUE)
else (return FALSE)))
;============================-----------------GET/PUT VALUE DEAMONS
;have a GET-value that does a get-value but gets it from the model 1st
;have a PUT-value that does a put-value then puts it into the model too
;--not needed in the same executable, as you are accessing the same space
;---------------------------------------------
;could just make value a multislot, or just have/use value, for now
;if just have values, can have get/put-value just access the 1st one <-*
;-------------------------PUT after
(defmessage-handler ARRAY put-value after ($?val)
(if (< (nn ?self:val_ptr) 99) then
(printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return nil))
(if (> ?self:num 1) then
(printout t crlf "[WARNING you are overwriting the 1st array element"))
(bind ?self:put-time (elapse-time))
(printout t "[" (instance-name ?self) " put-v " (send ?self deref) "]")
(send ?self deref ?val)) ;what put in value slot, goes in val_ptr space
(defmessage-handler ARRAY put-values after ($?vals)
(if (< (nn ?self:val_ptr) 99) then
(printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return nil))
(bind ?self:put-time (elapse-time))
(send ?self deref ?vals)) ;what put in values slot, goes in val_ptr space
;-------------------------GET before
(defmessage-handler ARRAY get-value before ()
(if (< (nn ?self:val_ptr) 99) then
(printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return nil))
(bind ?self:value (send ?self deref)) ;get value from val_ptr space, &cache
(printout t "[" (instance-name ?self) " get-v " ?self:value "]")
(bind ?self:get-time (elapse-time)))
(defmessage-handler ARRAY get-values before ($?n)
(if (< (nn ?self:val_ptr) 99) then
(printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return nil))
(bind ?self:values (send ?self deref-n (first-dflt ?n 1)))
(bind ?self:get-time (elapse-time)))
;get values from val_ptr space, &cache
;;;;-------------------------------------------------------------
;remeber the C deref fnc only takes a ptr & if it gets a number it sets it
;so to pick another array loc a handler has to recompute the ptr
;;;;-------------------------------------------------------------
;/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\-array com code (might change)
;--------------------------
;-needs: util.clp & pvm.clp
;--------------------------
;=======================================array COMMUNICATION (pvm) packing
;can send stride to pk_tpn too
;--------------------------------------------(un)packing using the tpn C fnc
;write a tpn fnc that takes an offset---------actually just alter the old 1
(defmessage-handler ARRAY pack-it primary ($?n-off) ;then stride & binary-flag
(bind ?n (first-dflt ?n-off ?self:num))
(bind ?off (second-dflt ?n-off 0))
(bind ?stride (third-dflt ?n-off 1))
(pk_tpn ?self:type ?self:val_ptr ?n ?off ?stride)
(send ?self get-value))
(defmessage-handler ARRAY upack-it primary ($?n-off)
(bind ?n (first-dflt ?n-off ?self:num))
(bind ?off (second-dflt ?n-off 0))
(bind ?stride (third-dflt ?n-off 1))
(pk_tpn (upcase ?self:type) ?self:val_ptr ?n ?off ?stride)
;(send ?self mprint) ;to have the FORTRAN model print out the arrays
(make-fresh ?self)
(send ?self get-value))
;--------------------------------------------(un)packing using the pvm_(u)pkbyte
(defmessage-handler ARRAY pack-byte primary ($?s)
(bind ?s (first-dflt ?s ?self:size))
(printout t "[pack-byte " ?self:val_ptr ", " ?s "]")
(pkbyte ?self:val_ptr ?s)
(send ?self get-value))
(defmessage-handler ARRAY upack-byte primary ($?s)
(bind ?s (first-dflt ?s ?self:size))
;a version of unpkbyte that takes a ptr rather than returning 1
(printout t "[upkbyte " ?self:val_ptr " " ?s " " ?self:size "]")
(upkbyte ?self:val_ptr ?s)
(make-fresh ?self)
(send ?self get-value))
;--------------------------------------------------------------------
;think about making array's xyz write-once (unless want to realloc)
; but would be better to just make a new one and transfer the data
;;;;-------------------------------------------------------------EOF
;-------fnc/hndlers to eval stuff on the other side MTB
;will need util.clp & pvm.clp (a send-str-to fnc)
;=====================
;----------------------------------------EVAL-SEND-TO
(deffunction eval-send-to (?str ?task)
(send-str-to (str-cat (eval ?str)) ?task))
;will evaluate the string and turn the result into a strin & send it to ?task
;often called remotely to get a result back from an eval
;-more in eval.clp -all use send-str-to
;----------------------------------------SEND-BACK-TO
(deffunction send-back-to (?str ?task $?to-opt)
(bind ?to-task (first-dflt ?to-opt (mytid)))
(send-str-to (quotes eval-send-to ?str ?to-task) ?task))
;send a str ready for evaluation to task, it is eval-ed and the result is
; sent back in string form to your task (or optionally to another task).
;--make a send-back-to-param & eval-send-to-param (which sticks it in the value)
;=====================
;----------------------------------------------------EVAL-SEND-TO-ARRAY
(deffunction eval-send-to-array (?str ?task ?array)
(send-str-to (quotes send ?array put-value (eval ?str)) ?task))
;(send-str-to (quote send ?array put-value (str-cat (eval ?str))) ?task)
;don't want string, but the real value now, make sure it's the right type
;will evaluate the string and turn the result into a strin & send it to ?task
; (& this version puts it in the value slot of the given array)
;often called remotely to get a result back from an eval
;----------------------------------------------------SEND-BACK-TO-ARRAY
(deffunction send-back-to-array (?str ?task ?array)
(send-str-to (quotes eval-send-to-array ?str (mytid) ?array) ?task))
;?task could default to (mytid) so would always get sent back
;or the other side could do a bufinfo to see what the source is
;send a str ready for evaluation to task, it is eval-ed and the result is
; sent back in string form to your task.
; (& this version puts it in the value slot of the given array)
;---want to make sure that it puts in the correct type
;-might have a version that can send a mf back to the values slot
;-might have a version that lets you pick the slot to put it into -better
;=====================
;a version that
;lets you return the ?str eval-ed at ?task and put it in the ?slot of your ?ins
;----------------------------------------------------EVAL-SEND-TO-INS
(deffunction eval-send-to-ins (?str ?task ?ins ?slot)
(send-str-to (quotes send ?ins (sym-cat put- ?slot) (eval ?str)) ?task))
;----------------------------------------------------SEND-BACK-TO-INS
(deffunction send-back-to-ins (?str ?task ?ins ?slot)
(send-str-to (quotes eval-send-to-ins ?str (mytid) ?ins ?slot) ?task))
;=================================================================COPY routines=
;----------------------turn slot & value into a parened symbol
(deffunction sv-sym (?ins ?sn) (quote ?sn (slot-value ?ins ?sn)))
;----------------------------------------------------COPY-NEW-INS-TO
(deffunction copy-new-ins-to (?task ?ins $?sn-s)
(if (not (instance-existp ?ins)) then
(printout t "[WARNING: No " ?ins " in copy-ins-to]") (return nil))
(bind ?sns (if (eq (length ?sn-s) 0) then (slotnames ?ins) else ?sn-s))
(send-str-to
(quotes make-instance ?ins of (class ?ins) (map2 sv-sym ?ins ?sns))
?task))
;----------------------------------------------------COPY-OLD-INS-TO
(deffunction copy-old-ins-to (?task ?ins $?sn-s)
(if (not (instance-existp ?ins)) then
(printout t "[WARNING: No " ?ins " in copy-ins-to]") (return nil))
(bind ?sns (if (eq (length ?sn-s) 0) then (slotnames ?ins) else ?sn-s))
(send-str-to
(quotes modify-instance ?ins of (class ?ins) (map2 sv-sym ?ins ?sns))
?task))
;later give another name to copy it too
;;;;-------------------------------------------------------------
;;;;-------------------------------------------------------------EOF
(defclass ConsCell
(is-a INITIAL-OBJECT)
(role concrete)
(pattern-match reactive)
(slot first (create-accessor read-write))
(slot rest (create-accessor read-write))
)
;=================================================================SUBROUTINE
;-------can be similar to Lambda Fncs (but no args as of yet)<-(objs for now)*
;used to hold the information on how to run a subroutine in a model
;can include the variables that need to be current to run, and the ones wich
;will be updated/or returned when the subroutine is finished
(defclass SUBROUTINE
(is-a ACCESSIBLE)
(role concrete)
(pattern-match reactive)
(slot sub ;subroutine code to eval
(create-accessor read-write))
(slot busy (default FALSE) ;wether the subroutine is busy
(create-accessor read-write))
(slot val_ptr (type INTEGER) ;LOC(sub-name)
(create-accessor read-write)) ;to be used by DF2
(multislot args (type INSTANCE) ;instances it will be called w/
(create-accessor read-write)) ; used to get arg typ/ptrs &#?
;might not use these-----------------get more data dict
(multislot vars-needed (type INSTANCE) ;vars used /needed
(create-accessor read-write)) ;can check if updated
(multislot proj-needed (type INSTANCE) ;vars used /needed
(create-accessor read-write)) ;can check if updated
(multislot sub-needed (type INSTANCE) ;vars used /needed
(create-accessor read-write)) ;can check if updated
(slot count (type INTEGER) ;number of this type of instance made
(create-accessor read-write) (storage shared))
) ;even id/fid/msgtag because nothing is returned
;-------------------------------------------subroutine INIT after
(defmessage-handler SUBROUTINE init after ()
; (if (and (stringp ?self:expl) (neq ?self:expl "")) then
; (printout t "[ " ?self:expl " ]"))
(printout t ?self ","))
;------------------------------------make-busy
(deffunction make-busy (?sub)
(send ?sub put-busy TRUE))
;------------------------------------------------------CALL
(defmessage-handler SUBROUTINE call primary ()
(if (stringp ?self:sub) then
(if (and (stringp ?self:expl) (neq ?self:expl "")) then
(printout t "[ " ?self:expl " ]"))
(eval ?self:sub)
else
(printout t "[call->ptag " ?self:msgtag "]")
(ptag ?self:msgtag)
))
(deffunction call-a-sub (?sub)
(if (not (instance-existp ?sub)) then
(printout t "[WARNING: sub:" ?sub " not there]")
(return nil)
else
(printout t "[sub:" ?sub "]")
(send ?sub call)))
;takes a list of subs and send the call msg to them
(deffunction call ($?subs)
(apply-1 call-a-sub ?subs))
;------------------------------------rcall
(deffunction rcall (?task $?subs)
(send-str-to (quotes call ?subs) ?task)
(map1 make-busy ?subs))
;=====================================================FUNCTION
;similar to a subroutine instance, but has a specific return value to look at
(defclass FUNCTION
(is-a SUBROUTINE)
(role concrete)
(pattern-match reactive)
(multislot ret-value ;a 'future' to be filled latter
(create-accessor read-write))
)
;-------------------a handler should construct the ret val send
;(quote send-str ?self:sub ?*my-tid*)
;will use: (send-back-to-param ?str ?task ?param)
;where the string gets eval-ed on the other side and
; the resulting value (not str) is put into the param's value slot
;------------------------------------------------------------------
;------------------------------------------------------------------EOF
;defn & msg-handlers for some of the PARAM class (has-a classes) MTB
;-sometimes what was a glob-pram will be made of a few of what where loc-params
; should references to them be sent along, or by transfering the 'glob-param'
; does it calc it from the locals, if they have been updated
;=========================================================projection_PARAMeter
;defclass PARAM in param.clp
;=================================================================GRID
(defclass GRID
(is-a ACCESSIBLE)
(role concrete)
(pattern-match reactive)
(slot units (type SYMBOL) ;actuall units (eg: ft,mi,m,km,deg)
(create-accessor read-write) (visibility public))
;could take any 2 opposite corners, but this is easier for now
(multislot corner-sw (type FLOAT) ;location of SW-lower corner
(create-accessor read-write) (visibility public))
(multislot corner-ne (type FLOAT) ;location of NE-upper corner
(create-accessor read-write) (visibility public))
(multislot delta (type FLOAT) ;length of delta-x-y-z segments
(create-accessor read-write) (visibility public))
(multislot nseg (type INTEGER) ;# of segments (should=array's xyz)
(create-accessor read-write) (visibility public))
)
;deg would be in deg-min-sec, but can't do z this way
;will be able to have relation like subgrid-p & eq-sp-subgrid-p
;& fncs like grid-intersection & grid-union
;-----------------------------------------------------------------
;=================================================================UNITS
;SI base-units: meter, kilogram, second, ampere, Kelvin, mole, and candela
; length, mass, time, current, temprature, mole, illum
; l(m) m(kg) t(s) c(A) t(K) (M) Cnd
;force=newton=kg m / s s
;--might not need an instance for this? (more just standardization of names)
(defclass UNITS ;name the instance w/ the basic-unit types (above order)
(is-a ACCESSIBLE)
(role concrete)
(pattern-match reactive)
(multislot units (type SYMBOL) ;actuall units (eg: ft / sec sec) orStr?
(create-accessor read-write) (visibility public))
(multislot units-type (type SYMBOL) ;type equiv (eg: length / time time)
(create-accessor read-write) (visibility public))
(multislot units-si (type SYMBOL) ;SI equiv (eg: m / sec sec) [7 types]
(create-accessor read-write) (visibility public))
(multislot syn (type SYMBOL) ;list of eqv unit defns (use member$)
(create-accessor read-write) (visibility public)))
;have all numerator terms a / then all the denominator terms
;-----------------------------------------------------------------
;=================================================================DESCRIPT
;(defclass DESCRIPT ;describe maybe hold constraints -ref?
; (is-a ACCESSIBLE)
; (role concrete)
; (pattern-match reactive)
;(slot journal (type INSTANCE) ;list of proceedures applied to the param
;(create-accessor read-write) (visibility public))
;(slot constr (type INSTANCE) ;list of constraint instances
;(create-accessor read-write) (visibility public))
;;maybe put these in contraint objs:
;(multislot range ;min & max of the values
; (create-accessor read-write) (visibility public))
;(slot default ;default value for the array value(s)
; (create-accessor read-write) (visibility public)))
;for units ft/(sec sec), ft/sec sec, ft/sec/sec or num= ft den= sec sec
;range/default values could be another param-inst
; which could mean use its range/default slots or the sep vals of the array
;could have get-actual-min get-actual-max get-mean get-median <-for arrays
;dumping the normed values or histogram of val bins to a fuz-fact ?
;would be nice to make arrays a base clips obj -or not
;------------------------------------------------------------------
;=================================================================CONSTR
(defclass CONSTR ;constraints
(is-a SUBROUTINE)
(role concrete)
(pattern-match reactive)
)
;use the constraint obj that updates slots/params/etc
;make it general, maybe like a subroutine, have good backup fncs
;---------------------------------------------------------------------------
;---still want to have params which are composed of other params,so need map-fnc
;-------------------
;instead of mapping, just have full description which can be mapped between
; (multislot from-var (type SYMBOL) ;variable(s) mapped from (usually 1)
; (create-accessor read-write) (visibility public))
; (slot to-var (type SYMBOL) ;variable mapped to
; (create-accessor read-write) (visibility public))
;;;have to list the model separtely, if no proxy around
;;(multislot from-mod (type SYMBOL) ;model(s) mapped from (almost always 1)
; (create-accessor read-write) (visibility public))
;;(slot to-mod (type SYMBOL) ;model mapped to
; (create-accessor read-write) (visibility public))
; (slot map-fnc (type SYMBOL) ;fnc to map between them
; (create-accessor read-write) (visibility public)) )
;-------------------
;Linda-like fncs/hndlers should be written around the param-
;------------------------------------------------------------------EOF
;defn & msg-handlers for the PARAM class MTB
;-sometimes what was a glob-pram will be made of a few of what where loc-params
; should references to them be sent along, or by transfering the 'glob-param'
; does it calc it from the locals, if they have been updated
;be able to mark if the array is in a model or malloced
;& if that array is in fortran or C format
;=========================================================projection_PARAMeter
(defclass PARAM
(is-a ACCESSIBLE)
(role concrete)
(pattern-match reactive)
(slot count (type INTEGER) ;number of this type of instance made
(create-accessor read-write) (storage shared))
;---------------------------------------------------------------has-a instances
;---------------------description of gridding of data
(slot grid (type INSTANCE) ;inst w/gridding info
(create-accessor read-write) (visibility public))
;---------------------description of gridding of data
(slot units (type INSTANCE) ;inst w/units info
(create-accessor read-write) (visibility public))
;---------------------holds the array (is in array.clp)
(slot array (type INSTANCE) ;inst w/memory &assoc descript
(create-accessor read-write) (visibility public))
;---------------------holds the constraint instances
(multislot cnstrs (type INSTANCE)
(create-accessor read-write) (visibility public))
;---------------------holds the process/sub instances which act of the inst
;=have the lists only be for the current & last simulation timesteps
;(finest grain or diferrent in each model- except for reasoning)
;-can use something like journal to show the goal state params
; or state at the begin/end of any process (as the annotation)
;This annotation will have to use the abstract process name (eg. [srfx])
(multislot journal (type INSTANCE) ;would be nice to also add the time
(create-accessor read-write) (visibility public))
(multislot journal-time (type INTEGER) ;time of the journal entry
(create-accessor read-write) (visibility public))
(multislot journal-use (type INTEGER) ;used as in out in-out
(create-accessor read-write) (visibility public)) ;assume only 'out'?
;-journal might get really long quickly with looping
; easier to keep a journal of calls, & then reconstruct the params-touched ?
;;---------------------description of type of data (meaning??)
; (slot descript (type INSTANCE) ;might hold constraints
; (create-accessor read-write) (visibility public))
;----------------------------------------------------------------extra val rep??
;for viewing & matching, which can be done with (param)arrays
;w/deamons can get and set val_ptr ed space, and update get/put-time
(slot value ;first value (usually only if xyz=111)??
(create-accessor read-write) (visibility public))
(multislot values ;first values(usually only if xyz=n11)??
(create-accessor read-write) (visibility public)))
;if copy over all the slots, then the refered to instances latter, they can
; be chekced with a sim-time stamp, and the value(s) slot too
;-----------------------------------------------------------------
;constraints checked when the value is updated (maybe for get/put seperately)
; might have w/>1 param so put in each to be 2way
;-----------------------------------------------------------------
;use descriptive/(standard) names (so could even do defaults from the name)
;defclass GRID in param-lib.clp
;defclass UNITS in param-lib.clp
;defclass CONSTR in param-lib.clp
;defclass ARRAY in array.clp
;if copy param to another task,refer to has-a as needed,use in-task slot to find
;------------------------------------------------------------------
(defmessage-handler PARAM pack-it primary ($?n-off)
(send ?self:array pack-it ?n-off))
(defmessage-handler PARAM upack-it primary ($?n-off)
(send ?self:array upack-it ?n-off))
;-------------------
;Linda-like fncs/hndlers should be written around the param-
;------------------------------------------------------------------EOF
;defn & msg-handlers for the PROJ class MTB
;=================================================================PROJection
(defclass PROJ
(is-a ACCESSIBLE)
(role concrete)
(pattern-match reactive)
(slot from (type INSTANCE) ;where is comes from ??
(create-accessor read-write))
(slot to (type INSTANCE) ;where is goes to ??
(create-accessor read-write))
(slot for (type INSTANCE) ;what subroutine gets called after ??
(create-accessor read-write)) ;it gets this data (redo so data-driven)
(multislot params ;(default (create$)) ;param instances which hold values
(create-accessor read-write) (visibility public))
)
;-----------------------------------------------------
;-----------------------------------------------------proj SEND-TO
;pack the upk cmd in a string then pack all the params
;(map1 pack-byte ?self:params ?tid) ;then one send
;-----------------------------------------------------(U)PK-(G)-PARAM
(deffunction pk-param (?param) (send (send ?param get-array) pack-byte))
(deffunction upk-param (?param) (send (send ?param get-array) upack-byte))
;----------------------------------------------------send-to
;(defmessage-handler PROJ send-to primary (?task)
; (if (< (length ?self:params) 1) then
; (printout t "[WARNING: PROJ send-to has no params " ?self:params "]"))
; (initsend 1)
;;need to have params stay a mf, but can't (quote (quote)) w/out messed up ""
; (pkstr (quotes map1 upk-param (quote create$ ?self:params)))
; (map1 pk-param ?self:params)
; (send_0 ?task))
;
;(defmessage-handler PROJ send_to_n primary (?task)
; (initsend 1)
; (pkstr (quotes apply-2 send (quote create$ ?self:params) upack-n))
; (apply-2 send ?self:params pack-n)
;;this is more like mark's proj-param-array send
;;(pkstr (quotes apply-2 send (quote create$ ?self:params) upack-byte))
;;(apply-2 send ?self:params pack-byte)
; (send_0 ?task))
;then the trecv-eval loop on the other side will get the string & upk the params
;assumes the glob params are set up the same on the other side
;the string that is sent along, runs upk-param which can updates/touchs the inst
;this is more efficient than the presend deem++send, so it should be reworked
;----------------------------------------------------proj SEND_TO
(defmessage-handler PROJ send_to primary (?task $?opt)
(initsend 1)
(pkstr (quotes apply-2 send (quote create$ ?self:params) upack-it ?opt))
(apply-2 send ?self:params pack-it ?opt)
(send_0 ?task))
;then the trecv-eval loop on the other side will get the string & upk the params
;----------------------
;----------------------------------------------------GET_FROM
;(defmessage-handler PROJ get_from primary (?task $?to-opt)
; (bind ?to-task (first-dflt ?to-opt (mytid))) (initsend 1)
; (pkstr (quotes send ?self send_to ?to-task ?to-opt))
; (send_0 ?task)) ;this only works if that proj is on the other side
;could do (send [clim-to-bats-init-proj] get_from [clim] [bats])
;if could assume the proper proj was there (could copy it)
;do by using a send_to for PARAM
(defmessage-handler PROJ get_from primary (?task $?opt)
(initsend 1)
(pkstr (quotes apply-2 send (quote create$ ?self:params) send_to (mytid) ?opt))
(send_0 ?task)) ;this only works if params are on the other side
;(pkstr (quotes apply-2 send (quote create$ ?self:params) pack-it ?opt))
;(apply-2 send ?self:params pack-it ?opt)
;param version of eval-send-to & send-back-to (in eval.clp)
;----------------------------------------------------
;probably have to reconfigure to synch w/ st
;----------------------------------------------------EOF
;-----------------------------------------------------new:
(defclass TID ;task obj id ;mirror globals for now
(is-a INITIAL-OBJECT)
(role concrete) (pattern-match reactive)
(slot tid (type INTEGER) (create-accessor read-write)) ;task id ([inst] or int id)
(slot pid (type INTEGER) (create-accessor read-write)) ;parent task id ([inst] or int id)
(slot start-time (type FLOAT) (create-accessor read-write)) ;also was a global ;try diff type
(slot recv-d-time (type INTEGER) (create-accessor read-write)) ;also was a global ;does it change w/time?
(slot elapse-time (type FLOAT) (create-accessor read-write)) ;was a fact
(slot model (type INTEGER) (create-accessor read-write)) ;also was a global
(multislot inst-tids (create-accessor read-write)) ;also was a global
)
;------------------------------------------------RULES
;the first rule to run (goes only once/reset),
;sets globals & some other stuff.
(defrule startup-TIME
(initial-fact)
=>
;(add_nrcv_route)
;(assert (TIME (rt2)))
(assert (TIME 0.0))
(bind ?*my-tid* (mytid))
(bind ?*parent-tid* (parent))
(printout t " mytid= " ?*my-tid* crlf)
(bind ?*start-time* (time))
;-new
(make-instance mytid of TID ;new
(start-time ?*start-time*)
(tid ?*my-tid*)
(pid ?*parent-tid*)
)
;(send [mytid] put-start-time ?*start-time*)
;(send [mytid] put-tid ?*my-tid*)
;(send [mytid] put-pid ?*parent-tid*)
;
;(make-tasks) ;set up the TASK instances
;(bcast-str (tasks ?*my-tid*)) ;make sure others get this new 1
(initsend)
(agenda)
)
;the problem is after the 1st time test fails, it is never checked again
;until the fact chages, (could try tick tock w/ nrecv_rout)
;updates the time, and does receives of command-strings
(defrule UPDATE-TIME
(declare (salience -50)) ;could go up w/time
?t <- (TIME ?old-time)
; (test (neq (rt2) ?old-time))
=>
(printout t "UT=" (rt2) " ")
;(if (not (nrecv_route)) then (system "sleep 1"))
(trecv_eval ?*recv-d-time*)
(send [mytid] put-recv-d-time ?*recv-d-time*) ;new
(send [mytid] put-elapse-time (elapse-time)) ;new
(retract ?t)
;(assert (TIME (rt2)))
;(assert (TIME (- (time) ?*start-time*)))
(assert (TIME (elapse-time)))
(agenda)
)
;-------------------------------------------------context rules
;;;;;;--this is out of date, latest work is in the tmp rul files
;(deffunction find-pp (?ppname)
; (find-instance (?pp PROVIDED-PARAM)
; (eq ?pp:gname ?ppname)))
;fix for all.clp -mb ;no class or gname elsewhere, glenda, howto-fix? ;also not called
(defclass PROVIDED-PARAM ;add this, as this file was probably lost.
(is-a PARAM) ;(is-a ACCESSIBLE)
(role concrete)
(pattern-match reactive)
(slot gname (create-accessor read-write)) ;maybe w/glenda?
) ;it is used in 'inputs' slot below, so there was even a produced|similar subclass?
(defclass PROCESS ;add this, as this file was probably lost, which really sucks. -mb
(is-a ACCESSIBLE)
(role concrete)
(pattern-match reactive)
(multislot inputs (create-accessor read-write)) ;
(multislot outputs (create-accessor read-write)) ;
(multislot comp-proc (create-accessor read-write)) ;
)
(deffunction find-pp (?ppname)
(find-instance ((?pp PROVIDED-PARAM))
(eq ?pp:gname ?ppname)))
(deffunction maprm (?l1 ?l2) (set-difference ?l1 ?l2)) ;just a guess right now-mb
;-------------------------------------------------FIND-PROC-PROVIDES
(defrule FIND-PROC-PROVIDES
(declare (salience 5)) ;doing before make-proc-chunks could save time?
?p1 <- (object (is-a PROCESS) (inputs ?in1) ;mved a paren back up-mb
(outputs ?out1)
(comp-proc ?cp1))
=>
;(map1 find-pp ?in1) ;gives a list of params that are provided for the proc
;this process's params should then be marked as being available
; and can be taken out of the active input list
;-would be good to save the old list or mark as not matchable
(send ?p1 put-inputs (maprm (map1 find-pp ?in1) ?in1))
)
;-------------------------------------------------MAKE-PROC-CHUNKS
;make a process out of 2 processes (refire till no more chunking/its usable)
(defrule MAKE-PROC-CHUNKS
?p1 <- (object (is-a PROCESS) (inputs $?in1)
(outputs $?out1)
(comp-proc $?cp1))
?p2 <- (object (is-a PROCESS) (inputs $?in2)
(outputs $?out2)
(comp-proc $?cp2))
(test (and (neq ?p1 ?p2) ;not combining the same process
(not (member$ ?p1 ?cp2)) ;process not alread a component
(not (member$ ?p2 ?cp1)) ; of a (chunked) process
(null-lv (intersection ?cp1 ?cp2))))
=>
(bind ?int1to2 (intersection ?in1 ?out2)) ;calc any out to input matches
(bind ?int2to1 (intersection ?in2 ?out1))
;if there are any make a chunked process
(if (full-lv ?int1to2) then (make-instance
(sym-cat (instance-name ?p1) - (instance-name ?p2))
of PROCESS
(inputs (union- ?in1 (set-difference ?in2 ?int1to2)))
(outputs (union- ?out1 ?out2))
(comp-proc (create$ ?p1 ?p2 ?cp1 ?cp2))))
(if (full-lv ?int2to1) then (make-instance
(sym-cat (instance-name ?p2) - (instance-name ?p1))
of PROCESS
(inputs (union- ?in2 (set-difference ?in1 ?int2to1)))
(outputs (union- ?out2 ?out1))
(comp-proc (create$ ?p2 ?p1 ?cp2 ?cp1))))
)
;inputs are all of the first ones and of of the 2nd except what the 1st provieds
;outputs are the combined outputs (even though used, still available-branch out)
;comprised proceedures are the 2 put together & all of there comp-proc s
;-------------------------------------------------
;(sym-cat (format nil "%s-%s" (instance-name ?p1) (instance-name ?p2)))
;-------------------------------------------------EOF