start_up = proc() %effects: This program takes in files using the following command line: % % schedule [output] % % where "network" and "messages" fit the format specified in the % get_network and get_messages procedures (respectively) below. % This program produces a schedule for moving the messages described % in "messages" from their initial location to their destination, (also % specified in "messages") along the network described in "network." % If "output" is specified and it is the legitimate name of a writeable % file, then all output is sent to this file. If "output" is not % specified, then output is sent to the screen. % %modifies: Contents of the file named by the string % output (or the screen). command_line: sequence[string] := get_argv() commands: int := sequence[string]$size(command_line) if commands = 0 then eprint("Missing network and message files") eprint(" Usage: schedule [output]") return end if commands = 1 then eprint("Missing message file") eprint(" Usage: schedule [output]") return end if commands > 3 then eprint("Too many files specified") eprint(" Usage: schedule [output]") return end network_file: string := command_line[1] message_file: string := command_line[2] out_file: string if commands = 3 then out_file:= command_line[3] end net: network := network$create(open_file(network_file)) except when net_error(why: string, line: int): eprint("Unrecoverable Network Error:") eprint(" " || why) eprint(" Line: " || int$unparse(line)) return when cantopen: return end messtream: stream :=open_file(message_file) except when cantopen: return end msgs: array[message]:= array[message]$new() for m: message in message$parse(messtream) do array[message]$addh(msgs, m) end answer: string:= schedule(net, msgs) if commands = 2 then stream$puts(stream$primary_output(), answer) else stream$puts(write_file(out_file), answer) except when cantopen: return end end end start_up open_file = proc(filename: string) returns (stream) signals(cantopen) % effects: If "filename" names a legitimate file that is readable, % "open_file" returns a stream corresponding to the contents of % the file. Signals cantopen and sends a message to the error % stream if the file cannot be opened. e_stream: stream := stream$error_output() return(stream$open(file_name$parse(filename), "read")) except when bad_format: stream$putl(e_stream, "Invalid filename: " || filename) signal cantopen when not_possible(why: string): stream$putl(e_stream, filename || ": " || why) signal cantopen end end open_file write_file = proc(filename: string) returns (stream) signals(cantopen) % effects: If "filename" names a legitimate file that is writable, % "write_file" returns a stream corresponding to the file. % Signals cantopen and sends a message to the error % stream if the file cannot be opened. e_stream: stream := stream$error_output() return(stream$open(file_name$parse(filename), "write")) except when bad_format: stream$putl(e_stream, "Invalid filename: " || filename) signal cantopen when not_possible(why: string): stream$putl(e_stream, filename || ": " || why) signal cantopen end end write_file next = proc (net: network, origin, destination: string) returns(string) signals(already_there, no_node(string), impossible) % effects: Takes in a network, a node of origin, and a node % of destination and returns a node adjacent to the node of % of origin that is closer to the destination node. % Signals already_there if the origin and destination % are the same. Signals no_node(string) if either of the % nodes does not exist, where string is the name of the first % nonexistent nodeencountered. Signals impossible if % the destination node cannot be reached from the node of origin. parents = p_table[string, string] if string$equal(origin, destination) then signal already_there end table: parents:= parents$create() for n_name: string in network$nodes(net) do parents$insert(table, n_name, "") end parents$lookup(table, origin) except when not_found: signal no_node(origin) end parents$change(table, origin, destination) hotlist: array[string] := array[string]$new() not_hot: array[string] := array[string]$new() array[string]$addh(hotlist, origin) while string$empty(parents$lookup(table, destination)) do if array[string]$size(hotlist) = 0 then signal impossible end temp: array[string] := array[string]$copy(hotlist) for nd: string in array[string]$elements(temp) do for nd_neigh: string in network$neighbors(net, nd) do member: bool:= false for bad: string in array[string]$elements(not_hot) do member := member cor (string$equal(nd_neigh, bad)) end if ~member then array[string]$addh(hotlist, nd_neigh) parents$change(table, nd_neigh, nd) end end trs: string:=array[string]$reml(hotlist) array[string]$addh(not_hot, trs) end end except when not_found: signal no_node(destination) end nd2: string:= destination while parents$lookup(table, nd2) ~= origin do nd2:=parents$lookup(table, nd2) end return(nd2) end next path = proc(net: network, origin, destination: string) returns(array[string]) signals(impossible, no_node(string)) % effects: Given the network net, path takes a node of % origin and a node of destination and returns an array % of node names where the index corresponds to where % the message is at a point in time. (E.g., % answer[0]=origin, answer[1]=node1, ..., answer[n]=destination temp: string answer: array[string]:= array[string]$create(0) array[string]$addh(answer, origin) while true do temp := next(net, origin, destination) array[string]$addh(answer, temp) end resignal impossible resignal no_node except when already_there: end return(answer) end path schedule = proc(net: network, am: array[message]) returns(string) % effects: Returns a human readable string % describing how to move the messages in "am" along "net" from % their origin to their destination. Also returns information % on what messages cannot reach their destinations if there is % no path from the origin to the destination (e.g., one of the % nodes is not in the network.) Note: If the origin and destination % of a message are not in the network, but the origin is the % same node as the destination, then no error is printed even % though the node is not in the network, because it has still % reached it's destination. mgs: array[message] := array[message]$new() val: string:= "" for mess: message in array[message]$elements(am) do org: string:= message$origin(mess) des: string:= message$destination(mess) next(net, org, des) except when already_there: when impossible: val:= string$concat(val, "Impossible: " || message$value(mess) || " -- No path exists between nodes '" || org || "' and '" || des || "'\n") continue when no_node(node: string): val:= string$concat(val, "Impossible: '" || message$value(mess) || "' node '" || node || "' is not in the network\n") continue end array[message]$addh(mgs, mess) end temp: array[message] count: int:= 1 while true do val:= string$concat(val, "\nCycle " || int$unparse(count) || ":\n") temp:= array[message]$new() for mess: message, action: string in cycle(net, mgs) do array[message]$addh(temp, mess) val:=string$concat(val, message$value(mess) || ": " || action || "\n") end mgs:= temp count:= count + 1 end except when done: end return(val) end schedule cycle = iter(net: network, am: array[message]) yields(message, string) signals(done) % effects: For each message in "am", yields a string which % describes the movement of the message along the network % during this cycle and another message that indicates the new % message position. Signals done if all messages have reached % their destination. d: bool:= true n: network:= network$copy(net) for mess: message in array[message]$elements(am) do orgn: string := message$origin(mess) dst: string := message$destination(mess) nd: string := next(n, orgn, dst) except when already_there: yield(mess, "") continue when impossible: yield(mess, orgn) continue end d := false network$delete(n, nd, orgn) val: string:= message$value(mess) yield(message$create(val, nd, dst), string$concat(orgn, " -> " || nd)) end if d then signal done end end cycle eprint = proc(error: string) % effects: sends error to error_output stream$putl(stream$error_output(), error) end eprint