1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120 | with BBS;
with BBS.http;
with BBS.internal;
with Panel;
package body web.xml is
--
-- Get and optionally set the state of the auto_man flag
--
procedure auto_man(s : GNAT.Sockets.Stream_Access;
h : BBS.web_common.params.Map;
p : BBS.web_common.params.Map) is
pragma Unreferenced(h);
value : Boolean := Panel.auto_man;
begin
BBS.http.ok(s, "application/xml");
if (BBS.web_common.params.Contains(p, "auto-man")) then
begin
value := Boolean'Value(BBS.web_common.params.Element(p, "auto-man"));
exception
when others =>
value := Panel.auto_man;
end;
if Panel.sw_ctrl.auto then
Panel.auto_man := value;
end if;
end if;
String'Write(s, "<xml><auto-enable>" & Boolean'Image(Panel.sw_ctrl.auto) &
"</auto-enable><auto-man>" & Boolean'Image(Panel.auto_man) & "</auto-man></xml>");
end auto_man;
--
-- Get and optionally set the type of the simulation
--
procedure sim_type(s : GNAT.Sockets.Stream_Access;
h : BBS.web_common.params.Map;
p : BBS.web_common.params.Map) is
pragma Unreferenced(h);
value : Natural := Panel.get_pattern;
begin
BBS.http.ok(s, "application/xml");
if (BBS.web_common.params.Contains(p, "sim-type")) then
begin
value := Natural'Value(BBS.web_common.params.Element(p, "sim-type"));
exception
when others =>
value := Panel.get_pattern;
end;
Panel.set_pattern(value);
end if;
String'Write(s, "<xml><pattern>" & Natural'Image(Panel.get_pattern) & "</pattern></xml>");
end sim_type;
--
-- Get switch and LED register values. Currently read-only
--
procedure sw_led_reg(s : GNAT.Sockets.Stream_Access;
h : BBS.web_common.params.Map;
p : BBS.web_common.params.Map) is
pragma Unreferenced(h);
pragma Unreferenced(p);
begin
BBS.http.ok(s, "application/xml");
String'Write(s, "<xml>");
String'Write(s, "<lr-ad>" & BBS.uint32'Image(Panel.lr_ad) & "</lr-ad>");
String'Write(s, "<lr-ctl>" & BBS.uint16'Image(Panel.lr_ctl) & "</lr-ctl>");
String'Write(s, "<sr-ad>" & BBS.uint32'Image(Panel.sr_ad) & "</sr-ad>");
String'Write(s, "<sr-ctl>" & BBS.uint16'Image(Panel.sr_ctl) & "</sr-ctl>");
String'Write(s, "</xml>");
end sw_led_reg;
--
-- Get simulated CPU information (currently name, num reg, and mem size)
--
procedure Get_CPU_info(s : GNAT.Sockets.Stream_Access;
h : BBS.web_common.params.Map;
p : BBS.web_common.params.Map) is
pragma Unreferenced(h);
pragma Unreferenced(p);
begin
BBS.http.ok(s, "application/xml");
String'Write(s, "<xml>");
String'Write(s, "<cpu-name>" & Panel.CPU.all.name & "</cpu-name>");
String'Write(s, "<cpu-reg>" & BBS.uint32'Image(Panel.CPU.all.registers) & "</cpu-reg>");
String'Write(s, "<cpu-mem>" & BBS.uint32'Image(Panel.CPU.all.mem_size) & "</cpu-mem>");
String'Write(s, "</xml>");
end Get_CPU_info;
--
-- Get simulated CPU register name and value
--
procedure Get_CPU_reg(s : GNAT.Sockets.Stream_Access;
h : BBS.web_common.params.Map;
p : BBS.web_common.params.Map) is
pragma Unreferenced(h);
value : Natural;
begin
BBS.http.ok(s, "application/xml");
if (BBS.web_common.params.Contains(p, "register")) then
begin
value := Natural'Value(BBS.web_common.params.Element(p, "register"));
exception
when others =>
value := 0;
end;
end if;
String'Write(s, "<xml><reg-num>" & Natural'Image(value) & "</reg-num>");
String'Write(s, "<reg-name>" & Panel.CPU.all.reg_name(BBS.uint32(value))
& "</reg-name>");
String'Write(s, "<reg-value>" & String'(Panel.CPU.all.read_reg(BBS.uint32(value)))
& "</reg-value></xml>");
end Get_CPU_reg;
--
-- Set exit flags. Sets the simulator exit flag and then request that the
-- web server exit.
--
procedure set_exits(s : GNAT.Sockets.Stream_Access;
h : BBS.web_common.params.Map;
p : BBS.web_common.params.Map)is
begin
Panel.exit_sim := True;
BBS.internal.html_set_exit(s, h, p);
end set_exits;
--
end;
|