1 " ***********************************************************
2 " * *
3 " * Copyright, C Honeywell Bull Inc., 1987 *
4 " * *
5 " * Copyright, C Honeywell Information Systems Inc., 1985 *
6 " * *
7 " * Copyright c 1972 by Massachusetts Institute of *
8 " * Technology and Honeywell Information Systems, Inc. *
9 " * *
10 " ***********************************************************
11
12 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
13 "
14 " LEVEL
15 "
16 " This procedure is called to get and set the validation level
17 " for the process.
18 " the get entrypoint is both a ring zero utility and an fgate.
19 " the set entrypoint is called only from ring zero.
20 " the seg_gate entrypoint can be called through hcs_ as
21 " an fgate.
22 "
23 " Modified 5/19/80 by J. A. Bush to not call ring_alarm if no change in validation level
24 " Modified 830518 BIM for level$gate_set, various cleanup,
25 " no stack frame.
26 " Modified 1985-05-08, BIM: new entrypoint level$admin_gate_set
27 " sets no_audit_ring1_fs_object_ops.
28 "
29 " This procedure maintains the array in pds$ring_alarm_val.
30 " pds$ring_alarm_val r ^= 0 iff a ring alarm should be
31 " signalled upon leaving ring r for the purpose of fixing
32 " the validation level. On other reasons for ring alarms
33 " pds$ring_alarm_val should NOT be set.
34 "
35 " Furthermore pds$ring_alarm_val r is equal to the value
36 " of the validation level on entry to this ring. This is
37 " guaranteed by setting it nonzero iff it is zero.
38 "
39
40 name level
41 entry get
42 entry set
43 entry set_gate
44 entry set_admin_gate
45
46 " The *_gate entries are called as FGATES. Therefore, there is no
47 " stack frame for the gate itself. Therefore, sp
48 " is a pointer to the outer ring's stack frame, and
49 " we can use that ring number to validate that
50 " call hcs_$level_set v -- v >= ring of execution.
51
52 " CODING CONVENTION
53 "
54 " A contains the new or putative new validation level
55 " Q contains the ring on behalf of whom we are acting
56 " X1 is stored into pds$no_audit_ring1_fs_object_ops
57
58 set_gate:
59 lda ap|2,* Get argument
60 tmi error_big_ring Unsigned number, after all
61 cmpa =7,dl
62 tpnz error_big_ring No more ring 64
63 eax0 0,al Copy to X0
64
65 epaq sp|0 Get ringno
66 ana =7,dl ringno only
67
68 " The following gets around the lack of inter-register compare instructions.
69 " Since there are only 8 different values for the argument, this maneuver
70 " uses x0 to find its own value in storage. Ycch.
71
72 cmpa ring_table,x0 is execution ring A <= requested ring X0?
73 tpnz error_small_ring no, go bitch.
74
75 llr 36 A -> Q
76 eaa 0,x0 X0 -> AU
77 arl 18 AU -> AL
78
79 cmpa 1,dl Ring 1?
80 tpl reset_no_audit greater
81 ldx1 pds$no_audit_ring1_fs_object_ops " value remains
82 tra set_common
83 reset_no_audit:
84 eax1 0 greater than 1, zero flag
85 tra set_common
86
87 set_admin_gate:
88 lda pds$validation_level
89 sta ap|2,* return old value
90
91 lda 1,dl We are setting 1
92
93 ldq 1,dl Called from ring 1
94
95 ldx1 pds$no_audit_ring1_fs_object_ops " may be zeroed
96 tnz no_audit_already_set
97 lxl2 pds$initial_ring Initial ring must not be 1
98 cmpx2 1,du
99 tze dont_suppress_audit
100 szn active_hardcore_data$audit_ring1_fs_object_ops
101 tnz dont_suppress_audit
102 ldx1 =o400000,du turn on the bit
103 no_audit_already_set:
104 dont_suppress_audit:
105 tra set_common
106
107 " This is called only in ring 0
108
109 set:
110 lda ap|2,* fetch argument
111 tmi error_r0_big_ring
112 cmpa =7,dl Reasonable?
113 tpnz error_r0_big_ring
114
115 ldq 0,dl we are ring 0.
116
117 ldx1 pds$no_audit_ring1_fs_object_ops retain value
118
119 set_common:
120 cmpa pds$validation_level Trivial case?
121 " For access audit, the ring
122 " alarm for the validation
123 " level is already set.
124 tnz set_non_trivial nope.
125 short_return No change.
126
127 set_non_trivial:
128 stx1 pds$no_audit_ring1_fs_object_ops " set new value
129 szn pds$ring_alarm_val,ql
130 tnz set_not_first
131
132 eax1 0,al store new level in X1
133 lda pds$validation_level we need to save this
134 sta pds$ring_alarm_val,ql if this is first save
135 sxl1 pds$validation_level set new level
136 tra call_ring_alarm and recalculate RAR
137
138 set_not_first:
139 sta pds$validation_level new level
140 cmpa pds$ring_alarm_val,ql if back, no more alarm
141 tnz call_ring_alarm not back to where it was
142 stz pds$ring_alarm_val,ql
143
144 call_ring_alarm:
145 eppap null_arglist
146 tra ring_alarm$reset its return is ours
147
148 "^L
149 tempd arg_list_error2
150 temp bad_ring_arg
151
152 error_big_ring:
153 tsx2 make_error_arglist " PUSHES
154 short_call level_error$ring_bigger_than_7
155 return
156
157 error_small_ring:
158 eaa 0,x0
159 arl 18 " move arg back to A
160 tsx2 make_error_arglist " PUSHES
161 short_call level_error$ring_too_small
162 return
163
164 error_r0_big_ring:
165 tsx2 make_error_arglist " PUSHES
166 short_call level_error$r0_invalid_ring
167 return
168
169
170 make_error_arglist: "Called with tsx2
171 push
172 sta bad_ring_arg
173 ldaq one_arg_arglist
174 staq arg_list_error
175 epp1 bad_ring_arg
176 spri1 arg_list_error+2
177 eppap arg_list_error set AP appropriately
178 tra 0,x2
179
180 even
181 null_arglist:
182 vfd 18/0,18/4 External call
183 vfd 18/0,18/0
184 one_arg_arglist:
185 vfd 17/1,1/0,18/4 One arg, Ext call
186 vfd 18/0,18/0
187
188 " This table is indexed by requested ring number. Each slot contains the
189 " smallest legal setting from that level.
190
191 ring_table:
192 dec 0
193 dec 1
194 dec 2
195 dec 3
196 dec 4
197 dec 5
198 dec 6
199 dec 7
200
201 " ^L
202 " This is both an FGATE and a normal entry
203
204 get: lda pds$validation_level return the current value
205 sta ap|2,* ..
206 short_return
207
208 end