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_error(2)
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