# FILE: mif.tcl # # Class for holding micromagnetic problem spec # # The input file should look like # # # MIF 2.1 # Specify Energy:UniformExchange: { # A 21e-12 # } # Specify Energy:UniformAnisotropy: { # Type Uniaxial # K1 0.5e3 # Axis 1 0 0 # } # # This is evaluated inside a slave interpreter, where "unsafe" commands # are likely not available (depending upon the setting of the "MIFinterp # safety" config option). # Oc_Class Oxs_Mif { private variable speckeys ;# Ordered list of keys private array variable spec private variable misckeys = {} ;# Ordered list of keys private array variable misc private variable destkeys = {} ;# Ordered list of keys private array variable dest private array variable assign private array variable assigned private array variable schedule const public variable mif_interp private variable random_seed = {} public common parameters {} private array variable local_params Constructor { args } { eval $this Configure $args set speckeys {} # Setup slave interpreter if {[Oc_Option Get MIFinterp safety safety_level]} { return -code error \ "Option value \"MIFinterp safety\" not set\ (see file oommf/config/options.tcl)." } if {[string match unsafe $safety_level]} { set mif_interp [interp create] } else { set mif_interp [interp create -safe] } # Add basic aliases interp alias $mif_interp Specify {} $this SetSpec interp alias $mif_interp ClearSpec {} $this UnsetSpec interp alias $mif_interp Report {} $this Status interp eval $mif_interp [list proc Ignore args {}] interp alias $mif_interp RandomSeed {} $this RandomSeed interp alias $mif_interp Random {} Oc_UnifRand interp alias $mif_interp OOMMFRootDir {} Oc_Main GetOOMMFRootDir interp alias $mif_interp Parameter {} $this SetParameter interp alias $mif_interp Destination {} $this Destination interp alias $mif_interp Schedule {} $this Schedule Oc_AddExprExtensions $mif_interp if {![string match safe $safety_level]} { # Add extras to "custom" and "unsafe" interpreters interp alias $mif_interp ReadFile {} Oxs_ReadFile } else { # In safe interpreters, set up "extra" commands # to raise errors interp alias $mif_interp ReadFile {} $this Missing ReadFile } } method KillApps {killtags} { if {([llength $killtags] == 1) && [string match all [lindex $killtags 0]]} { set killtags [array names assign] } foreach tag $killtags { set oid $assign($tag) # How do we kill an application, given its OID? # Maybe the "right" way is to involve the account server? # A hack is to loop over the known Net_Threads and send # the "exit" message to the first one that has a service # ID of the proper form? foreach t [Net_Thread Instances] { if {[string match $oid:* [$t Cget -pid]]} { if {[$t Ready]} { $t Send exit } else { Oc_EventHandler New _ $t Ready [list $t Send exit] } break } } } } callback method Status {m} { Oc_Log Log $m info $class } method Destination {tag instance {new ""}} { # Used to "declare" a destination in a MIF file. # The $tag is a name that is associated with that destination # for use in [Schedule] commands in the same MIF file. # $instance is the name of the program instance to run. # It has the form $app(:$name)? where $app is the name of a # program, and $name is an identifier for the particular instance. if {[lsearch -exact $destkeys $tag] != -1} { return -code error "Duplicate definition of Destination \"$tag\"" } set parts [split $instance :] if {[llength $parts] == 0} { return -code error "No application for Destination \"$tag\"" } set app [lindex $parts 0] if {[catch {Oc_Application CommandLine $app}]} { # NOTE: this tests what programs we know how to launch, # which might not necessarily be the same as what programs # are registered with the account server, but assume the same # for now. return -code error "Unknown application \"$app\" for\ Destination \"$tag\"" } set name [join [lrange $parts 1 end] :] lappend destkeys $tag set dest($tag) [list $app $name [string match new $new]] } method Schedule {o d e f} { # Establish an initial schedule to set output named $o to destination # with tag $d on the event $e with frequency $f. This amounts to # setting up for the creation of an Oxs_Schedule instance. # Would like to check for unknown outputs, but we don't know # them yet. They will appear during problem reset. if {[lsearch -exact $destkeys $d] == -1} { return -code error "Unknown Destination Tag \"$d\"" } set e [string toupper [string index $e 0]][string tolower [string range $e 1 end]] if {[lsearch -exact {Step Stage} $e] == -1} { return -code error "Unknown Event \"$e\"" } if {[catch {incr f 0}] || ($f < 0)} { return -code error "Frequency must be a non-negative integer,\ not\"$f\"" } # Only one schedule per (output, dest, event) triple. if {[info exists schedule($o,$d,$e)]} { return -code error "Multiple schedules for sending\ \"$o\" to \"$d\" on \"$e\" events" } set schedule($o,$d,$e) [list $o $d $e $f] } method CreateSchedule {} { set script "" foreach key [array names schedule] { # Get the arguments of the [Schedule] command foreach {o tag e f} $schedule($key) {break} # Verify that $o names an output if {[catch {Oxs_Output Lookup $o} output]} { Oc_Log Log "Error in \"Schedule $o $tag $e $f\":\ no such output \"$o\"" error continue } # Transform the destination tag into an Oxs_Destination name # The destination tag directly determines an OID set oid $assign($tag) # The OID identifies a running process. The service protocol # sought by the output determines which service of that process # we want to use as a destination. # NB: At this point we know that the application we seek is # known to the account server; we do not know if the service # has been registered there, let alone whether a Net_Thread # exists here to represent it! # # Ack! DataTable is special! if {[catch { if {[string match DataTable $output]} { set d [Oxs_Destination Find $oid DataTable] } else { set d [Oxs_Destination Find $oid [$output Protocol]] } }]} { # A destination could not be found; wait until another thread # becomes ready and try again. # puts stderr "NOT FOUND: $tag -> $oid" Oc_EventHandler New _ Net_Thread Ready [list $this CreateSchedule] \ -oneshot 1 -groups [list $this] return } # Set up the schedule append script " [list Oxs_Schedule Set $o $d Frequency $e $f] [list Oxs_Schedule Set $o $d Active $e 1] " } eval $script Oc_EventHandler Generate $this ScheduleReady } method SetupSchedule {acct} { # Once the destination tags are all assigned values, create the # schedule: if {[llength $destkeys]} { Oc_EventHandler New _ $this DestinationTagsAssigned \ [list $this CreateSchedule] -oneshot 1 -groups [list $this] $this FindDestinations $acct $destkeys } else { $this CreateSchedule } } method LaunchNewDestination {acct app tag {claim 0}} { #puts stderr "LND: $app $tag $claim" # Launch the application in the background; get the process id set pid [Oc_Application Exec $app &] # Retrieve the OID for that process id from the account server set qid [$acct Send getoid $pid] Oc_EventHandler New _ $acct Reply$qid \ [list $this GetoidReply $acct $tag $pid $claim] -oneshot 1 \ -groups [list $this $acct] } method NotifyNewOid {acct tag p claim} { set reply [$acct Get] if {![string match notify [lindex $reply 0]]} { return } if {![string match newoid [lindex $reply 1]]} { return } set pid [lindex $reply 2] if {[string compare $pid $p]} { return } Oc_EventHandler DeleteGroup NotifyNewOid-$pid # If we claimed a name, make that association set oid [lindex $reply 3] if {$claim} { foreach {app name new} $dest($tag) break set qid [$acct Send associate $app:$name $oid] Oc_EventHandler New _ $acct Reply$qid \ [list $this AssociateCheck $acct $name $oid] \ -oneshot 1 -groups [list $this $acct] } $this Assign $tag $oid return -code return } method GetoidReply {acct tag pid claim} { set reply [$acct Get] if {[lindex $reply 0]} { # The process ID was not known by the account server, but # a watch has been set to notify us when it shows up. Set # up to receive that notification Oc_EventHandler New _ $acct Readable \ [list $this NotifyNewOid $acct $tag $pid $claim] \ -groups [list NotifyNewOid-$pid] } else { # We got the OID set oid [lindex $reply 1] # If we claimed a name, make that association if {$claim} { foreach {app name new} $dest($tag) break set qid [$acct Send associate $app:$name $oid] Oc_EventHandler New _ $acct Reply$qid \ [list $this AssociateCheck $acct $name $oid] \ -oneshot 1 -groups [list $this $acct] } # Assign the OID to the destination tag $this Assign $tag $oid } } method AssociateCheck {acct name oid} { # All this does is report an error message in case of trouble set reply [$acct Get] if {[lindex $reply 0]} { set msg "associate $name $oid failed: [lindex $reply 1]" Oc_Log Log $msg error error $msg $msg } } method Assign {tag oid} { if {[info exists assigned($oid)]} { return -code error "Attempt to assign OID \"$oid\" to two tags" } #puts stderr "Assigning $tag to $oid..." #puts stderr "Command: [info level 0]" #puts stderr "Caller: [info level -1]" set assign($tag) $oid set assigned($oid) $tag if {[array size assign] == [llength $destkeys]} { # We have as many OID assignments as tags; all must be assigned Oc_EventHandler Generate $this DestinationTagsAssigned } } method FindDestinations {acct taglist} { # Make sure we know what process corresponds to each # Destination tag... # The "dest" array maps tag -> (app, name) as recorded # from Destination commands # Construct the "find" command set cmd [list $acct Send find] set seeking [list] foreach tag $taglist { foreach {app name new} $dest($tag) break if {$new} { $this LaunchNewDestination $acct $app $tag } else { lappend seeking $tag if {[string length $name]} { lappend cmd $app:$name } else { lappend cmd $app:* } } } # Issue the "find" command to the account server. set qid [eval $cmd] Oc_EventHandler New _ $acct Reply$qid \ [list $this FindReply $acct $seeking] \ -groups [list $this $acct] -oneshot 1 } method FindReply {acct seeking} { set reply [$acct Get] if {[lindex $reply 0]} { set msg "Error in find reply: [join [lrange $reply 1 end]]" error $msg $msg } set answers [lindex $reply 1] #puts "FIND REPLY: $seeking -> $answers" foreach tag $seeking { set candidates [lindex $answers 0] set answers [lrange $answers 1 end] foreach {app n new} $dest($tag) break switch -exact -- [llength $candidates] { 0 { # no application found for the name; # If the name was specific, we should claim the name # If not, then there's just no app of the right kind # running and we should launch one. if {[string length $n]} { $this NameClaim $acct $app $tag $n } else { $this LaunchNewDestination $acct $app $tag } } 1 { # Got a unique OID for that name (pattern) # (attempt to) Assign it. $this Assign $tag [lindex $candidates 0] } default { # Got a list of several matches; attempt to assign # each one until success. # Note this must be a name-less destination foreach oid $candidates { if {![catch {$this Assign $tag $oid}]} {break} } if {![info exists assign($tag)]} { # None of them worked. Launch a new one instead $this LaunchNewDestination $acct $app $tag } } } } } method NameClaim {acct app tag name} { set qid [$acct Send claim $name] Oc_EventHandler New _ $acct Reply$qid \ [list $this ClaimReply $acct $app $tag $name] \ -groups [list $this $acct] -oneshot 1 } method ClaimReply {acct app tag name} { set reply [$acct Get] if {[lindex $reply 0]} { # We lost the race; someone else got the name. # Set up to receive the notice when the name is associated Oc_EventHandler New _ $acct Readable \ [list $this NotifyClaim $acct $tag $name] \ -groups [list NotifyClaim-$name] } else { # We claimed the name; Launch the program; $this LaunchNewDestination $acct $app $tag 1 } } method NotifyClaim {acct tag n} { set reply [$acct Get] if {![string match notify [lindex $reply 0]]} { return } if {![string match claim [lindex $reply 1]]} { return } set name [lindex $reply 2] if {[string compare $name $n]} { return } Oc_EventHandler DeleteGroup NotifyClaim-$name $this FindDestinations $acct [list $tag] return -code return } method Missing { name args } { # Used for aliases missing from safe interpreters return -code error \ "Command \"$name\" is not available in safe interpreter.\ Safe level determined by option value \"MIFinterp safety\"\ in file oommf/config/options.tcl." } method RandomSeed { args } { if {[llength $args] > 1} { return -code error \ "wrong # args: should be \"$this RandomSeed ?arg?\"" } if {[llength $args]==0} { Oc_Srand ;# Use clock-based seed set random_seed [expr {round([Oc_UnifRand]*((1<<31)-1))}] ;## random_seed is an integer determined by clock-based seed } else { set random_seed [lindex $args 0] } Oc_Srand $random_seed ;# Set C-level random number generator expr srand($random_seed) ;# RNG in master interp interp eval $mif_interp expr srand($random_seed) ;# RNG in slave } method GetRandomSeed {} { return $random_seed } method SetSpec { key args } { set ac [llength $args] if {$ac != 1} { return -code error \ "Bad argument count ($ac) in Specify block (KEY $key)" } if {[string first ":" $key]<0} { # Append default instance name (empty string) append key ":" } if {[info exists spec($key)]} { return -code error "Key $key already in use" } lappend speckeys $key set spec($key) [lindex $args 0] } method UnsetSpec { key } { # If $key is {}, then clears out all specs. This does not # raise an error even if there are no specs. # If $key is not {}, then removes only that spec, from # both the spec array and the speckeys list. This operation # will raise an error if the spec $key is not set. if {[string match {} $key]} { catch {unset spec} set speckeys {} } else { unset spec($key) set keyindex [lsearch -exact $speckeys $key] if {$keyindex>=0} { set speckeys [lreplace $speckeys $keyindex $keyindex] } } } # It might also be useful to have a 'ReplaceSpec' method # that does an Unset + Set without changing key order. method Clear {} { $this UnsetSpec {} } method SetParameter { param_name args } { if {[$mif_interp eval info exists $param_name]} { return -code error "Parameter \"$param_name\" already set" } if {[info exists local_params($param_name)]} { # Set parameter using local_params common value. set val $local_params($param_name) $mif_interp eval set $param_name $val unset local_params($param_name) } else { # Parameter not mentioned in local_params; use default. if {[llength $args]<1} { return -code error "Parameter \"$param_name\" not set\ on command line, and no default value specified." } elseif {[llength $args]==1} { $mif_interp eval set $param_name [lindex $args 0] } else { return -code error "wrong # args: should be\ \"Parameter [list $param_name] ?default_value?\"" } } } method ReadMIF { filename } { # Fill spec from filename, using mif_interp to source the file. # Empty out any previous specifications (should we do this?) $this Clear # Reset local_params array catch {unset local_params} array set local_params $parameters # Read file into a string. Hopefully this isn't too big. set chan [open $filename] set filestr [read $chan] close $chan # Check that first line matches "# MIF 2.1" if {![regexp -- "^#\[ |\t\]*MIF\[ |\t\]*2.1\[ |\t\]*\n" \ $filestr]} { return -code error \ "Input file \"$filename\" not in MIF 2.1 format" } # Source filestr set errcode [catch {$mif_interp eval $filestr} errmsg] global errorInfo errorCode foreach {ei ec} [list $errorInfo $errorCode] {break} if {$errcode} { # Error occurred sourcing $filename $this Clear ;# Clear out partial problem spec return -code error -errorinfo $ei -errorcode $ec \ "Error processing file [list $filename]: $errmsg" } if {[llength [array names local_params]]>0} { $this Clear return -code error "Unused parameters: [array names local_params]" } } method GetSpecKeys {} { return $speckeys } method GetSpecValue { name } { return $spec($name) } method Dump {} { # Return specify block data. # NB: There may be additional data stored away # in $mif_interp, for example, proc definitions. set specstr "" foreach k $speckeys { append specstr "[list Specify $k $spec($k)]\n" } return $specstr } Destructor { catch {interp delete $mif_interp} } }