1# BEGIN LICENSE BLOCK 2# Version: CMPL 1.1 3# 4# The contents of this file are subject to the Cisco-style Mozilla Public 5# License Version 1.1 (the "License"); you may not use this file except 6# in compliance with the License. You may obtain a copy of the License 7# at www.eclipse-clp.org/license. 8# 9# Software distributed under the License is distributed on an "AS IS" 10# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11# the License for the specific language governing rights and limitations 12# under the License. 13# 14# The Original Code is The ECLiPSe Constraint Logic Programming System. 15# The Initial Developer of the Original Code is Cisco Systems, Inc. 16# Portions created by the Initial Developer are 17# Copyright (C) 2006 Cisco Systems, Inc. All Rights Reserved. 18# 19# Contributor(s): 20# 21# END LICENSE BLOCK 22 23# 24# $Id: tkmulti.tcl,v 1.2 2012/03/01 12:49:21 jschimpf Exp $ 25# 26 27package provide eclipse_peer_multitask 1.0 28 29set tkecl(multi_state) not_registered 30 31proc ec_multi:peer_register { {mtcommands {}} } { 32 global tkecl 33 34 if {$tkecl(multi_state) != "not_registered"} { 35 error "Calling ec_multi:peer_register when peer is already registered for multitasking." 36 } 37 38 set res [ec_rpcq [list peer_register_multitask [ec_peer_name] _] {(()_)}] 39 switch $res { 40 fail - 41 throw { 42 error "Unable to establishing a multitasking link with ECLiPSe." 43 } 44 default { 45 set tkecl(multi_fromec) [lindex $res 2] 46 set tkecl(multi_state) off 47 ec_set_queue_handler $tkecl(multi_fromec) fromec ec_multi:fromec_handler 48 } 49 } 50 51 foreach commandtype [list multi_start_command \ 52 multi_end_command multi_timeslice_command] { 53 set tkecl($commandtype) {} 54 } 55 56 foreach {type command} $mtcommands { 57 switch $type { 58 start { 59 set tkecl(multi_start_command) $command 60 } 61 end { 62 set tkecl(multi_end_command) $command 63 } 64 interact { 65 set tkecl(multi_timeslice_command) $command 66 } 67 default { 68 error "Unknown command type $type given in" 69 " ec_multi:peer_register" 70 } 71 } 72 } 73} 74 75 76proc ec_multi:peer_deregister {} { 77 global tkecl 78 79 if {$tkecl(multi_state) == "not_registered"} { 80 error "Calling ec_multi:peer_deregister when peer is not registered for multitasking." 81 } 82 83 set res [ec_rpcq [list peer_deregister_multitask [ec_peer_name]] {(())}] 84 switch $res { 85 fail - 86 throw { 87 error "Unable to deregister multitasking link with ECLiPSe." 88 } 89 default { 90 set tkecl(multi_fromec) "" 91 set tkecl(multi_state) not_registered 92 } 93 } 94} 95 96 97proc ec_multi:fromec_handler {multi_fromec_stream_nr {size 0}} { 98 99 set message [ec_read_exdr [ec_streamnum_to_channel $multi_fromec_stream_nr]] 100 set state [lindex $message 0] 101 set arg [lindex $message 1] ;# could be empty if no argument 102 ec_multi:state_action $state $arg 103 104} 105 106proc ec_multi:state_action {state {arg {}}} { 107 global tkecl 108 109 switch $state { 110 start_multitask { 111 if {$tkecl(multi_state) != "off"} { 112 set peername [ec_peer_name] 113 tk_messageBox -icon error -type ok -message "peer_multitask error ($peername): Told to start multitasking during multitasking." 114 return -code error 115 } 116 117 set tkecl(multi_type) $arg 118 set tkecl(multi_state) on 119 if {$tkecl(multi_start_command) != {}} { 120 switch [eval [list $tkecl(multi_start_command) $arg]] { 121 continue { 122 ec_rpcq peer_multitask_confirm () 123 } 124 terminate { 125 ec_multi:terminate_phase 126 } 127 } 128 } 129 update 130 } 131 end_multitask { 132 ;# ignore message if not multitasking... 133 if {$tkecl(multi_state) != "off"} { 134 135 update 136 set tkecl(multi_state) off 137 if {$tkecl(multi_end_command) != {}} { 138 eval [list $tkecl(multi_end_command) $tkecl(multi_type)] 139 } 140 update ;# allow handler's changes to occur 141 } 142 } 143 interact { 144 if {$tkecl(multi_state) == "off"} { 145 set peername [ec_peer_name] 146 tk_messageBox -type ok -icon error -message "peer_multitask error ($peername): Trying to multitask while not multitasking." 147 return -code error 148 } 149 150 update 151 if {$tkecl(multi_timeslice_command) != {}} { 152 if {[catch [eval [list $tkecl(multi_timeslice_command) \ 153 $tkecl(multi_type)]] result] == 1} { 154 # need to check for == 1 to avoid catching break/continue 155 # something went wrong, just return error 156 return -code error 157 } 158 switch $result { 159 terminate { 160 ec_multi:terminate_phase 161 } 162 } 163 } 164 } 165 default { 166 set peername [ec_peer_name] 167 tk_messageBox -icon error -type ok -message "peer_multitask error ($peername): unknown multitasking state message from ECLiPSe: $state." 168 return -code error 169 } 170 } 171} 172 173proc ec_multi:terminate_phase {} { 174 global tkecl 175 176 if {$tkecl(multi_state) == "on"} { 177 ec_rpcq peer_multitask_terminate () 178 } 179} 180 181 182proc ec_multi:get_multi_status {} { 183 global tkecl 184 185 return $tkecl(multi_state) 186 187} 188