-
Notifications
You must be signed in to change notification settings - Fork 0
/
KernelInit_A.thy
1060 lines (843 loc) · 41.7 KB
/
KernelInit_A.thy
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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(*
* Copyright 2014, General Dynamics C4 Systems
*
* This software may be distributed and modified according to the terms of
* the GNU General Public License version 2. Note that NO WARRANTY is provided.
* See "LICENSE_GPLv2.txt" for details.
*
* @TAG(GD_GPL)
*)
theory KernelInit_A
imports
"../../lib/WordEnum"
"../../lib/Lib"
Structures_A
Exceptions_A
Tcb_A
ArchVSpace_A
begin
section {* Generic stuff *}
translations
(type) "cslot_ptr" <= (type) "word32 \<times> bool list"
type_synonym slot_ptr = "cslot_ptr"
type_synonym slot_region_t = "nat \<times> nat"
type_synonym bi_dev_reg_t = "paddr \<times> word32 \<times> slot_region_t"
text {* Select from state S, throw ex if S is empty. *}
definition
"throw_select S ex \<equiv> doE
whenE (S = {}) (throwError ex);
liftE (select S)
odE"
section {* Parameters passed in from linker script *}
consts
ki_boot_end :: paddr
arm_vector_table :: obj_ref
arm_kernel_stack :: obj_ref
idle_thread_start :: vspace_ref (* &idle_thread *)
section {* Kernel Init State *}
text {* Ghost state representing the contents of the boot info frame *}
record bi_frame_data =
bi_f_node_id :: word32
bi_f_num_nodes :: word32
bi_f_num_iopt_levels :: word32
bi_f_ipcbuf_vptr :: vspace_ref
bi_f_null_caps :: slot_region_t
bi_f_sh_frame_caps :: slot_region_t
bi_f_ui_frame_caps :: slot_region_t
bi_f_ui_pt_caps :: slot_region_t
bi_f_ut_obj_caps :: slot_region_t
bi_f_ut_obj_paddr_list :: "paddr list"
bi_f_ut_obj_size_bits_list :: "word8 list"
bi_f_it_cnode_size_bits :: word8
bi_f_num_dev_regs :: word32
bi_f_dev_reg_list :: "bi_dev_reg_t list"
type_synonym (* XXX: natural numbers represent components of kernel objects, for those
objects that can be subdivided *)
component = "bool list"
text {*
For kernel initialisation, we need the basic kernel state plus some extra
information to keep track of, such as free memory.
At the concrete level, this is managed by region lists.
The ``available memory'' indicates memory that has been allocated (and thus
no longer free) but that has no objects in it, as it has not been retyped.
This is so we can state heap-consuming separation logic predicates which
assert that ``there's nothing here'', e.g. so-called untyped objects.
The components map should have the same domain as the abstract heap in the
kernel state, but indicate which components of the object we have permission
to access. The purpose is separation logic statements about heaps in which
objects can be split up, e.g. only one cap in a CNode.
*}
record ('z) ki_state =
ki_kernel_state :: "'z state"
ki_free_mem :: "obj_ref set" (* ndks_boot.freemem representative? *)
ki_available_mem :: "obj_ref set" (* ghost state *)
ki_bootinfo :: bi_frame_data (* ghost state *)
ki_components :: "paddr \<Rightarrow> component set"
ndks_boot_slot_pos_cur :: nat
ndks_boot_slot_pos_max :: nat
ndks_boot_bi_frame :: paddr
section {* Kernel init monad *}
text {*
The kernel init monad can fail. The actual value of the failure is largely
irrelevant, just so long as we don't have assertion failures for no reason.
*}
datatype ki_failure = InitFailure
type_synonym ('a,'z) ki_monad = "('z ki_state, ki_failure + 'a) nondet_monad"
translations
(type) "'a ki_monad" <=
(type) "((ki_failure + 'a) \<times> ki_state \<Rightarrow> bool) \<times> bool"
text {* Lift kernel state monad ops to the kernel init monad. *}
definition
do_kernel_op :: "('a,'z::state_ext) s_monad \<Rightarrow> ('a,'z) ki_monad" where
"do_kernel_op kop \<equiv> liftE $ do
ms \<leftarrow> gets ki_kernel_state;
(r, ms') \<leftarrow> select_f (kop ms);
modify (\<lambda>ks. ks \<lparr> ki_kernel_state := ms' \<rparr>);
return r
od"
section {* Kernel constants *}
definition "MIN_NUM_4K_UNTYPED_OBJ \<equiv> 12 :: nat"
definition "MAX_NUM_FREEMEM_REG \<equiv> 2 :: nat"
text {* Fixed cap positions in root CNode (bootinfo.h) *}
definition "BI_CAP_NULL \<equiv> 0 :: nat"
definition "BI_CAP_IT_TCB \<equiv> 1 :: nat"
definition "BI_CAP_IT_CNODE \<equiv> 2 :: nat"
definition "BI_CAP_IT_PD \<equiv> 3 :: nat"
definition "BI_CAP_IRQ_CTRL \<equiv> 4 :: nat"
definition "BI_CAP_ASID_CTRL \<equiv> 5 :: nat"
definition "BI_CAP_IT_ASID_POOL \<equiv> 6 :: nat"
definition "BI_CAP_IO_PORT \<equiv> 7 :: nat"
definition "BI_CAP_IO_SPACE \<equiv> 8 :: nat"
definition "BI_CAP_BI_FRAME \<equiv> 9 :: nat"
definition "BI_CAP_IT_IPCBUF \<equiv> 10 :: nat"
definition "BI_CAP_DYN_START \<equiv> 11 :: nat"
definition "BI_FRAME_SIZE_BITS \<equiv> pageBits"
definition "ROOT_CNODE_SIZE_BITS \<equiv> 12 :: nat"
section {* ARM constants *}
definition "PPTR_VECTOR_TABLE \<equiv> 0xffff0000 :: word32"
definition "PPTR_GLOBALS_PAGE \<equiv> 0xffffc000 :: word32"
definition "PPTR_KERNEL_STACK \<equiv> 0xfffff000 :: word32"
definition "IT_ASID \<equiv> 1 :: asid" (* initial thread ASID *)
definition "WORD_SIZE_BITS \<equiv> 2 :: nat"
definition "ASID_POOL_BITS \<equiv> asid_low_bits :: nat"
definition "ASID_POOL_SIZE_BITS \<equiv> ASID_POOL_BITS + WORD_SIZE_BITS"
definition "CTE_SIZE_BITS \<equiv> 4 :: nat" (* from ARM structures.h *)
text {* in abstract, these do not have a direct equivalent *}
definition "PD_BITS \<equiv> 12 :: nat"
definition "PT_BITS \<equiv> 8 :: nat"
definition "PDE_SIZE_BITS \<equiv> 2 :: nat"
definition "PTE_SIZE_BITS \<equiv> 2 :: nat"
text {* in abstract, these are pd_bits and pt_bits respectively *}
definition "PD_SIZE_BITS \<equiv> PD_BITS + PDE_SIZE_BITS"
definition "PT_SIZE_BITS \<equiv> PT_BITS + PTE_SIZE_BITS"
section {* Platform constants (iMX31) *}
definition "irqInvalid \<equiv> 255 :: irq"
definition "INTERRUPT_PMU \<equiv> 23 :: irq"
definition "INTERRUPT_EPIT1 \<equiv> 28 :: irq"
definition "KERNEL_TIMER_IRQ \<equiv> INTERRUPT_EPIT1"
text {* Kernel devices for imx31 *}
definition "EPIT_PADDR \<equiv> 0x53f94000 :: word32"
definition "EPIT_PPTR \<equiv> 0xfff00000 :: word32"
definition "AVIC_PADDR \<equiv> 0x68000000 :: word32"
definition "AVIC_PPTR \<equiv> 0xfff01000 :: word32"
definition "L2CC_PADDR \<equiv> 0x30000000 :: word32"
definition "L2CC_PPTR \<equiv> 0xfff02000 :: word32"
definition "UART_PADDR \<equiv> 0x43f90000 :: word32"
definition "UART_PPTR \<equiv> 0xfff03000 :: word32"
definition "BASE_OFFSET = physMappingOffset"
section {* Functions cloned and modified for separation logic to work *}
text {*
These shadow the normal functions, but do not force a well-formedness
check for the cnodes, as wellformed\_cnode\_sz is non-local with respect
to individual caps, and so get\_cap and set\_cap are also. *}
definition
get_cap_local :: "cslot_ptr \<Rightarrow> (cap,'z::state_ext) s_monad"
where
"get_cap_local \<equiv> \<lambda>(oref, cref). do
obj \<leftarrow> get_object oref;
caps \<leftarrow> case obj of
CNode sz cnode \<Rightarrow> return cnode
| TCB tcb \<Rightarrow> return (tcb_cnode_map tcb)
| _ \<Rightarrow> fail;
assert_opt (caps cref)
od"
definition
set_cap_local :: "cap \<Rightarrow> cslot_ptr \<Rightarrow> (unit,'z::state_ext) s_monad"
where
"set_cap_local cap \<equiv> \<lambda>(oref, cref). do
obj \<leftarrow> get_object oref;
obj' \<leftarrow> case obj of
CNode sz cn \<Rightarrow> if cref \<in> dom cn
then return $ CNode sz $ cn (cref \<mapsto> cap)
else fail
| TCB tcb \<Rightarrow>
if cref = tcb_cnode_index 0 then
return $ TCB $ tcb \<lparr> tcb_ctable := cap \<rparr>
else if cref = tcb_cnode_index 1 then
return $ TCB $ tcb \<lparr> tcb_vtable := cap \<rparr>
else if cref = tcb_cnode_index 2 then
return $ TCB $ tcb \<lparr> tcb_reply := cap \<rparr>
else if cref = tcb_cnode_index 3 then
return $ TCB $ tcb \<lparr> tcb_caller := cap \<rparr>
else if cref = tcb_cnode_index 4 then
return $ TCB $ tcb \<lparr> tcb_ipcframe := cap \<rparr>
else
fail
| _ \<Rightarrow> fail;
set_object oref obj'
od"
definition
set_untyped_cap_as_full_local :: "cap \<Rightarrow> cap \<Rightarrow> word32 \<times> bool list\<Rightarrow> (unit,'z::state_ext) s_monad"
where
"set_untyped_cap_as_full_local src_cap new_cap src_slot \<equiv>
if (is_untyped_cap src_cap \<and> is_untyped_cap new_cap
\<and> obj_ref_of src_cap = obj_ref_of new_cap \<and> cap_bits_untyped src_cap = cap_bits_untyped new_cap)
then set_cap_local (max_free_index_update src_cap) src_slot else return ()"
definition
cap_insert_local :: "cap \<Rightarrow> cslot_ptr \<Rightarrow> cslot_ptr \<Rightarrow> (unit,'z::state_ext) s_monad" where
"cap_insert_local new_cap src_slot dest_slot \<equiv> do
src_cap \<leftarrow> get_cap_local src_slot;
dest_original \<leftarrow> return (if is_ep_cap new_cap then
cap_ep_badge new_cap \<noteq> cap_ep_badge src_cap
else if is_aep_cap new_cap then
cap_ep_badge new_cap \<noteq> cap_ep_badge src_cap
else if \<exists>irq. new_cap = IRQHandlerCap irq then
src_cap = IRQControlCap
else is_untyped_cap new_cap);
old_cap \<leftarrow> get_cap_local dest_slot;
assert (old_cap = NullCap);
set_untyped_cap_as_full_local src_cap new_cap src_slot;
set_cap_local new_cap dest_slot;
is_original \<leftarrow> gets is_original_cap;
src_parent \<leftarrow> return $
should_be_parent_of src_cap (is_original src_slot) new_cap dest_original;
src_p \<leftarrow> gets (\<lambda>s. cdt s src_slot);
dest_p \<leftarrow> gets (\<lambda>s. cdt s dest_slot);
update_cdt (\<lambda>cdt. cdt (dest_slot := if src_parent
then Some src_slot
else cdt src_slot));
do_extended_op (cap_insert_ext src_parent src_slot dest_slot src_p dest_p);
set_original dest_slot dest_original
od"
definition
"setup_reply_master_local thread \<equiv> do
old_cap <- get_cap_local (thread, tcb_cnode_index 2);
when (old_cap = NullCap) $ do
set_original (thread, tcb_cnode_index 2) True;
set_cap_local (ReplyCap thread True) (thread, tcb_cnode_index 2)
od
od"
section {* Kernel init functions *}
consts (* TODO: serialise bi_frame_data and write it to the bootinfo frame *)
sync_bootinfo_frame :: "paddr \<Rightarrow> (unit,'z::state_ext) ki_monad"
definition (* C macro ROUND_DOWN *)
"round_down w b \<equiv> (w >> b) << b"
definition
alloc_region :: "nat \<Rightarrow> (obj_ref,'z) ki_monad" where
"alloc_region bits \<equiv> doE
free \<leftarrow> liftE $ gets ki_free_mem;
ptr \<leftarrow> throw_select
{ptr. is_aligned ptr bits \<and> {ptr .. ptr + 2 ^ bits - 1} \<subseteq> free}
InitFailure;
liftE $ modify (\<lambda>s. s \<lparr> ki_free_mem :=
free - {ptr .. ptr + 2 ^ bits - 1} \<rparr>);
(* Ghost state update: mark memory as available *)
avail \<leftarrow> liftE $ gets ki_available_mem;
liftE $ modify (\<lambda>s. s \<lparr> ki_available_mem :=
avail \<union> {ptr .. ptr + 2 ^ bits - 1} \<rparr>);
returnOk ptr
odE"
definition
init_freemem :: "(paddr \<times> paddr) \<Rightarrow> (unit,'z::state_ext) ki_monad" where
"init_freemem ui_reg \<equiv> doE
mem_regs \<leftarrow> do_kernel_op $ do_machine_op getMemoryRegions;
free_addrs \<leftarrow> returnOk $ foldl (op \<union>) {}
$ map (\<lambda>(start,end). {start..<end}) mem_regs;
(* subtract userland image addresses from the set of free addresses *)
free_addrs' \<leftarrow> returnOk $ free_addrs - {fst ui_reg..<(snd ui_reg)};
(* now pick a subset of those vars, because the C has a limit on the
number of slots in ndks_boot.freemem[] (MAX_NUM_FREEMEM_REG) which
isn't represented in the abstract spec *)
free_addrs_sel \<leftarrow> liftE $ select {s. s \<subseteq> free_addrs'};
liftE $ modify (\<lambda>s. s \<lparr> ki_free_mem := free_addrs_sel \<rparr>)
odE"
text {*
The @{text "arm_global_pts"} arch state field means something completely
different to the armKSGlobalPT in the C code. As such, the abstract spec as
it stands now must have a list of pts there. Since the kernel init abstract
spec is based on the actual C, we know there is only one such pt. To prevent
confusion, this function is meant as the canonical way to get the
armKSGlobalPT equivalent, whatever it ends up being.
This means that kernel init assumes the initial state will provide a PT
there that it can use. *}
definition
get_arm_global_pt :: "(paddr,'z::state_ext) s_monad" where
"get_arm_global_pt \<equiv> do
pt \<leftarrow> gets (hd \<circ> arm_global_pts \<circ> arch_state);
return pt
od"
definition
write_slot :: "slot_ptr \<Rightarrow> cap \<Rightarrow> (unit,'z::state_ext) s_monad" where
"write_slot slot_ptr cap \<equiv> do
set_cap_local cap slot_ptr;
set_original slot_ptr True
od"
definition
cap_slot_pptr :: "cap \<Rightarrow> nat \<Rightarrow> cslot_ptr" where
"cap_slot_pptr cap position \<equiv>
(obj_ref_of cap, nat_to_cref (bits_of cap) position)"
(* corresponds to C code: SLOT_PTR(pptr_of_cap(cap), position) for cnodes
but NOT TCBs, for that use something like tcb_cnode_index *)
definition
provide_cap :: "cap \<Rightarrow> cap \<Rightarrow> (unit,'z::state_ext) ki_monad" where
"provide_cap root_cnode_cap cap \<equiv> doE
slot_pos_cur \<leftarrow> liftE $ gets ndks_boot_slot_pos_cur;
slot_pos_max \<leftarrow> liftE $ gets ndks_boot_slot_pos_max;
(* Ran out of free slots in root CNode? *)
whenE (slot_pos_cur \<ge> slot_pos_max) $ throwError InitFailure;
do_kernel_op $ write_slot (cap_slot_pptr root_cnode_cap slot_pos_cur) cap;
liftE $ modify (\<lambda>s. s \<lparr> ndks_boot_slot_pos_cur := slot_pos_cur + 1 \<rparr>)
odE"
definition
provide_untyped_cap :: "cap \<Rightarrow> paddr \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (unit,'z::state_ext) ki_monad" where
"provide_untyped_cap root_cnode_cap pptr size_bits slot_pos_before \<equiv> doE
slot_pos_cur \<leftarrow> liftE $ gets ndks_boot_slot_pos_cur;
i \<leftarrow> returnOk $ slot_pos_cur - slot_pos_before;
(* the C code writes to index i, but we append, so crosscheck that...
this might prove to be overkill, but it's better to remove it during
corres proof or such *)
ut_objs \<leftarrow> liftE $ gets (bi_f_ut_obj_paddr_list \<circ> ki_bootinfo);
assertE (length ut_objs = i);
ut_objs \<leftarrow> liftE $ gets (bi_f_ut_obj_size_bits_list \<circ> ki_bootinfo);
assertE (length ut_objs = i);
(* update ghost bootinfo frame and sync *)
liftE $ modify (\<lambda>s. s \<lparr> ki_bootinfo := (ki_bootinfo s) \<lparr>
bi_f_ut_obj_paddr_list :=
(bi_f_ut_obj_paddr_list $ ki_bootinfo s) @ [pptr],
bi_f_ut_obj_size_bits_list :=
(bi_f_ut_obj_size_bits_list $ ki_bootinfo s) @ [of_nat size_bits]
\<rparr>\<rparr>);
bi_frame \<leftarrow> liftE $ gets ndks_boot_bi_frame;
sync_bootinfo_frame bi_frame;
provide_cap root_cnode_cap $ UntypedCap pptr size_bits 0
odE"
definition
init_cpu :: "(unit,'z::state_ext) s_monad" where
"init_cpu = do
do_machine_op cleanCache;
global_pd \<leftarrow> gets (arm_global_pd \<circ> arch_state);
do_machine_op $ setCurrentPD $ addrFromPPtr global_pd
od"
definition
init_plat :: "(unit,'z::state_ext) s_monad" where
"init_plat \<equiv> do
do_machine_op initTimer;
do_machine_op initL2Cache
od"
definition
init_irqs :: "cap \<Rightarrow> (unit,'z::state_ext) s_monad" where
"init_irqs root_cnode_cap \<equiv> do
mapM (set_irq_state IRQInactive) [0 .e. maxIRQ];
set_irq_state IRQTimer KERNEL_TIMER_IRQ;
write_slot (cap_slot_pptr root_cnode_cap BI_CAP_IRQ_CTRL) IRQControlCap
od"
definition
arch_configure_idle_thread :: "obj_ref \<Rightarrow> (unit,'z::state_ext) s_monad" where
"arch_configure_idle_thread tcb \<equiv> do
as_user tcb $ set_register CPSR 0x1f;
as_user tcb $ setNextPC idle_thread_start
od"
definition
configure_idle_thread :: "obj_ref \<Rightarrow> (unit,'z::state_ext) s_monad" where
"configure_idle_thread tcb \<equiv> do
arch_configure_idle_thread tcb;
set_thread_state tcb IdleThreadState
od"
definition
create_objects :: "nat \<Rightarrow> nat \<Rightarrow> apiobject_type \<Rightarrow> (paddr,'z::state_ext) ki_monad"
where
"create_objects bits ko_bits ko_typ \<equiv> doE
pptr \<leftarrow> alloc_region bits;
do_kernel_op $ retype_region pptr (bits div ko_bits) ko_bits ko_typ;
(* previously available memory now contains object: update ghost state *)
avail \<leftarrow> liftE $ gets ki_available_mem;
liftE $ modify (\<lambda>s. s \<lparr> ki_available_mem :=
avail - {pptr .. pptr + 2 ^ bits - 1} \<rparr>);
(* FIXME: update ki_components ghost state !!! *)
returnOk pptr
odE"
definition
create_idle_thread :: "(unit,'z::state_ext) ki_monad" where
"create_idle_thread \<equiv> doE
pptr \<leftarrow> create_objects (obj_bits $ TCB undefined)
(obj_bits $ TCB undefined) TCBObject;
do_kernel_op $ do
modify (\<lambda>s. s \<lparr> idle_thread := pptr \<rparr>);
configure_idle_thread pptr
od
odE"
definition
create_root_cnode :: "(cap,'z::state_ext) ki_monad" where
"create_root_cnode \<equiv>
let sz = (ROOT_CNODE_SIZE_BITS + CTE_SIZE_BITS) in
doE
liftE $ modify
(\<lambda>s. s \<lparr> ndks_boot_slot_pos_max := 2 ^ ROOT_CNODE_SIZE_BITS \<rparr>);
pptr \<leftarrow> create_objects sz sz CapTableObject;
let cap = CNodeCap pptr ROOT_CNODE_SIZE_BITS
(replicate (32 - ROOT_CNODE_SIZE_BITS) False)
in (doE
do_kernel_op $ write_slot (cap_slot_pptr cap BI_CAP_IT_CNODE) cap;
returnOk cap
odE)
odE"
definition
create_irq_cnode :: "(unit,'z::state_ext) ki_monad" where
"create_irq_cnode \<equiv> doE
(* Make a page full of cnodes with one CTE each. At the C level
this is of course just an array of CTEs taking up the whole page. *)
pptr \<leftarrow> create_objects pageBits CTE_SIZE_BITS CapTableObject;
(* Now associate each cnode with an irq *)
do_kernel_op $ modify
(\<lambda>s. s \<lparr> interrupt_irq_node :=
(\<lambda>irq. pptr + ucast irq * of_nat CTE_SIZE_BITS) \<rparr>)
odE"
definition
create_it_frame_cap :: "obj_ref \<Rightarrow> vspace_ref \<Rightarrow> asid option \<Rightarrow> bool \<Rightarrow> (cap,'z::state_ext) ki_monad"
where
"create_it_frame_cap pptr vptr asid use_large \<equiv>
let sz = if use_large then ARMLargePage else ARMSmallPage in
returnOk $ ArchObjectCap $ PageCap pptr {AllowRead,AllowWrite}
sz (map_option (\<lambda>a. (a, vptr)) asid)"
definition
create_ipcbuf_frame :: "cap \<Rightarrow> (vspace_ref \<times> vspace_ref)
\<Rightarrow> (cap \<times> vspace_ref,'z::state_ext) ki_monad" where
"create_ipcbuf_frame root_cnode_cap ui_v_reg \<equiv>
let vptr = snd ui_v_reg (* ui_v_reg.end *)
in
doE
pptr \<leftarrow> alloc_region pageBits;
do_kernel_op $ do_machine_op $ clearMemory pptr pageBits;
cap \<leftarrow> create_it_frame_cap pptr vptr (Some IT_ASID) False;
do_kernel_op $
write_slot (cap_slot_pptr root_cnode_cap BI_CAP_IT_IPCBUF) cap;
returnOk (cap, vptr)
odE"
definition
create_bi_frame :: "cap \<Rightarrow> (vspace_ref \<times> vspace_ref) \<Rightarrow> vspace_ref \<Rightarrow> word32
\<Rightarrow> word32 \<Rightarrow> (vspace_ref,'z::state_ext) ki_monad" where
"create_bi_frame root_cnode_cap ui_v_reg ipcbuf_vptr node_id num_nodes \<equiv>
let vptr = ipcbuf_vptr + of_nat (2 ^ pageBits)
in
doE
pptr \<leftarrow> alloc_region BI_FRAME_SIZE_BITS;
(* update in abstract representation of boot info frame *)
liftE $ modify (\<lambda>s. s \<lparr> ki_bootinfo := (ki_bootinfo s) \<lparr>
bi_f_node_id := node_id,
bi_f_num_nodes := num_nodes,
bi_f_num_iopt_levels := 0,
bi_f_ipcbuf_vptr := ipcbuf_vptr,
bi_f_it_cnode_size_bits := of_nat ROOT_CNODE_SIZE_BITS \<rparr>\<rparr>);
(* synchronise abstract bootinfo with boot info frame *)
sync_bootinfo_frame pptr;
liftE $ modify (\<lambda>s. s \<lparr> ndks_boot_bi_frame := pptr,
ndks_boot_slot_pos_cur := BI_CAP_DYN_START \<rparr> );
cap \<leftarrow> create_it_frame_cap pptr vptr (Some IT_ASID) False;
do_kernel_op $
write_slot (cap_slot_pptr root_cnode_cap BI_CAP_BI_FRAME) cap;
returnOk vptr
odE"
definition
create_it_asid_pool :: "cap \<Rightarrow> (cap,'z::state_ext) ki_monad" where
"create_it_asid_pool root_cnode_cap \<equiv> doE
(* create ASID pool *)
ap_pptr \<leftarrow> create_objects ASID_POOL_SIZE_BITS
ASID_POOL_SIZE_BITS (ArchObject ASIDPoolObj);
ap_cap \<leftarrow> returnOk $ ArchObjectCap $
ASIDPoolCap ap_pptr (IT_ASID >> asid_low_bits);
do_kernel_op $ write_slot (cap_slot_pptr root_cnode_cap
BI_CAP_IT_ASID_POOL) ap_cap;
(* create ASID control cap *)
do_kernel_op $ write_slot (cap_slot_pptr root_cnode_cap BI_CAP_ASID_CTRL)
(ArchObjectCap ASIDControlCap);
returnOk ap_cap
odE"
definition
create_frames_of_region :: "cap \<Rightarrow> (paddr \<times> paddr) \<Rightarrow> bool \<Rightarrow> word32
\<Rightarrow> (nat \<times> nat,'z::state_ext) ki_monad" where
"create_frames_of_region root_cnode_cap reg do_map pv_offset \<equiv> doE
slot_pos_before \<leftarrow> liftE $ gets ndks_boot_slot_pos_cur;
(swp mapME)
[(fst reg),(fst reg + of_nat (2 ^ pageBits)) .e. (snd reg - 1)]
(\<lambda>f. doE
frame_cap \<leftarrow> (if do_map
then create_it_frame_cap f
(f - BASE_OFFSET - pv_offset) (Some IT_ASID) False
else create_it_frame_cap f 0 None False);
provide_cap root_cnode_cap frame_cap
odE);
slot_pos_after \<leftarrow> liftE $ gets ndks_boot_slot_pos_cur;
returnOk (slot_pos_before, slot_pos_after)
odE"
definition
write_it_asid_pool :: "cap \<Rightarrow> cap \<Rightarrow> (unit,'z::state_ext) s_monad" where
"write_it_asid_pool it_ap_cap it_pd_cap \<equiv>
let ap_ptr = obj_ref_of it_ap_cap;
pd_ptr = obj_ref_of it_pd_cap;
asid_idx = ucast (IT_ASID >> asid_low_bits)
in
do
ap \<leftarrow> get_asid_pool ap_ptr;
ap' \<leftarrow> return (ap (ucast IT_ASID \<mapsto> pd_ptr));
set_asid_pool ap_ptr ap';
asid_table \<leftarrow> gets (arm_asid_table \<circ> arch_state);
asid_table' \<leftarrow> return (asid_table(asid_idx \<mapsto> ap_ptr));
modify (\<lambda>s. s \<lparr> arch_state :=
arch_state s \<lparr> arm_asid_table := asid_table' \<rparr>\<rparr>)
od"
definition
map_it_pt_cap :: "cap \<Rightarrow> cap \<Rightarrow> (unit,'z::state_ext) s_monad" where
"map_it_pt_cap pd_cap pt_cap \<equiv> do
pd \<leftarrow> return $ obj_ref_of pd_cap; (* C uses specific PD version *)
(pt,vptr) \<leftarrow> return $ case the_arch_cap pt_cap
of PageTableCap ref (Some (_, vref)) \<Rightarrow> (ref,vref);
slot \<leftarrow> return $ vptr >> pageBitsForSize ARMSection;
(* C code sets ParityEnable bit, which is apparently to enable ECC *)
pde \<leftarrow> return $ PageTablePDE (addrFromPPtr pt) {ParityEnabled} 0;
pd_obj \<leftarrow> get_object pd;
pd_obj' \<leftarrow> return (case pd_obj
of ArchObj (PageDirectory table)
\<Rightarrow> ArchObj (PageDirectory $ table(ucast slot := pde)
));
set_object pd pd_obj'
od"
definition
map_it_frame_cap :: "cap \<Rightarrow> cap \<Rightarrow> (unit,'z::state_ext) s_monad" where
"map_it_frame_cap pd_cap frame_cap \<equiv> do
pd \<leftarrow> return $ obj_ref_of pd_cap;
(frame, vptr) \<leftarrow> return $ case the_arch_cap frame_cap
of PageCap ref _ _ (Some (_, vptr)) \<Rightarrow> (ref, vptr);
pd_obj \<leftarrow> get_object pd;
pde \<leftarrow> return $ case pd_obj
of ArchObj (PageDirectory table)
\<Rightarrow> table (ucast (vptr >> pageBitsForSize ARMSection));
pt \<leftarrow> return (case pde of PageTablePDE ref _ _ \<Rightarrow> ptrFromPAddr ref);
slot \<leftarrow> return $ (vptr && mask (pageBitsForSize ARMSection))
>> pageBitsForSize ARMSmallPage;
pte \<leftarrow> return $ SmallPagePTE (addrFromPPtr frame) {PageCacheable}
vm_read_write;
pt_obj \<leftarrow> get_object pt;
pt_obj' \<leftarrow> return (case pt_obj
of ArchObj (PageTable table)
\<Rightarrow> ArchObj (PageTable $ table(ucast slot := pte)));
set_object pt pt_obj'
od"
definition
write_it_pd_pts :: "cap \<Rightarrow> cap \<Rightarrow> (unit,'z::state_ext) ki_monad" where
"write_it_pd_pts root_cnode_cap it_pd_cap \<equiv> doE
do_kernel_op $ copy_global_mappings $ obj_ref_of it_pd_cap;
(* map PTs into PD *)
(start, end) \<leftarrow> liftE $ gets (bi_f_ui_pt_caps \<circ> ki_bootinfo);
do_kernel_op $
(swp mapM)
[start..<end]
(\<lambda>pos. do
cap \<leftarrow> get_cap_local $ cap_slot_pptr root_cnode_cap pos;
map_it_pt_cap it_pd_cap cap
od);
(* map frames into PTs *)
(start, end) \<leftarrow> liftE $ gets (bi_f_ui_frame_caps \<circ> ki_bootinfo);
do_kernel_op (do
(swp mapM)
[start..<end]
(\<lambda>pos. do
cap \<leftarrow> get_cap_local $ cap_slot_pptr root_cnode_cap pos;
map_it_frame_cap it_pd_cap cap
od);
cap \<leftarrow> get_cap_local $ cap_slot_pptr root_cnode_cap BI_CAP_IT_IPCBUF;
map_it_frame_cap it_pd_cap cap;
cap \<leftarrow> get_cap_local $ cap_slot_pptr root_cnode_cap BI_CAP_BI_FRAME;
map_it_frame_cap it_pd_cap cap
od)
odE"
definition
bi_finalise :: "(unit,'z::state_ext) ki_monad" where
"bi_finalise \<equiv> doE
slot_pos_start \<leftarrow> liftE $ gets ndks_boot_slot_pos_cur;
slot_pos_end \<leftarrow> liftE $ gets ndks_boot_slot_pos_max;
liftE $ modify (\<lambda>s. s \<lparr> ki_bootinfo := (ki_bootinfo s) \<lparr>
bi_f_null_caps := (of_nat slot_pos_start, of_nat slot_pos_end) \<rparr>\<rparr>);
bi_frame \<leftarrow> liftE $ gets ndks_boot_bi_frame;
sync_bootinfo_frame bi_frame
odE"
definition
create_it_pd_pts :: "cap \<Rightarrow> (vspace_ref \<times> vspace_ref) \<Rightarrow> vspace_ref
\<Rightarrow> vspace_ref \<Rightarrow> (cap,'z::state_ext) ki_monad" where
"create_it_pd_pts root_cnode_cap ui_v_reg ipcbuf_vptr bi_frame_vptr \<equiv> doE
(* create PD obj and cap *)
pd_pptr \<leftarrow> create_objects PD_SIZE_BITS PD_SIZE_BITS
(ArchObject PageDirectoryObj);
pd_cap \<leftarrow> returnOk $ ArchObjectCap $
PageDirectoryCap pd_pptr (Some IT_ASID);
do_kernel_op $ write_slot (cap_slot_pptr root_cnode_cap BI_CAP_IT_PD)
pd_cap;
(* include IPC buffer and bootinfo frames in the userland image *)
(ui_v_reg_start, ui_v_reg_end) \<leftarrow>
returnOk (fst ui_v_reg, bi_frame_vptr + 2 ^ BI_FRAME_SIZE_BITS);
(* create all PT objs and caps necessary to cover userland image *)
slot_pos_before \<leftarrow> liftE $ gets ndks_boot_slot_pos_cur;
start \<leftarrow> returnOk $ round_down ui_v_reg_start (PD_BITS + pageBits);
next \<leftarrow> returnOk $ start + (2 ^ (PT_BITS + pageBits));
(swp mapME) [start,next .e. ui_v_reg_end] (\<lambda>pt_vptr. doE
pt_pptr \<leftarrow> alloc_region PT_SIZE_BITS;
do_kernel_op $ retype_region pt_pptr 1 PT_SIZE_BITS
(ArchObject PageTableObj);
provide_cap root_cnode_cap $
ArchObjectCap $ PageTableCap pt_pptr (Some (IT_ASID, pt_vptr))
odE);
slot_pos_after \<leftarrow> liftE $ gets ndks_boot_slot_pos_cur;
liftE $ modify (\<lambda>s. s \<lparr> ki_bootinfo := (ki_bootinfo s) \<lparr>
bi_f_ui_pt_caps := (of_nat slot_pos_before, of_nat slot_pos_after) \<rparr>\<rparr>);
bi_frame \<leftarrow> liftE $ gets ndks_boot_bi_frame;
sync_bootinfo_frame bi_frame;
returnOk pd_cap
odE"
definition
create_initial_thread :: "cap \<Rightarrow> cap \<Rightarrow> vspace_ref \<Rightarrow> vspace_ref \<Rightarrow> vspace_ref
\<Rightarrow> cap \<Rightarrow> (unit,'z::state_ext) ki_monad" where
"create_initial_thread root_cnode_cap it_pd_cap ui_v_entry bi_frame_vptr
ipcbuf_vptr ipcbuf_cap \<equiv>
let tcb_bits = obj_bits $ TCB undefined
in
doE
(* allocate TCB *)
tcb_pptr \<leftarrow> create_objects tcb_bits tcb_bits TCBObject;
(* Arch_initContext should be implicit in retype_region *)
do_kernel_op $ (do
cap_insert_local root_cnode_cap (cap_slot_pptr root_cnode_cap BI_CAP_IT_CNODE)
(tcb_pptr, tcb_cnode_index 0); (* tcbCTable *)
cap_insert_local root_cnode_cap (cap_slot_pptr root_cnode_cap BI_CAP_IT_PD)
(tcb_pptr, tcb_cnode_index 1); (* tcbVTable *)
cap_insert_local root_cnode_cap (cap_slot_pptr root_cnode_cap BI_CAP_IT_IPCBUF)
(tcb_pptr, tcb_cnode_index 4); (* tcbBuffer *)
tcb_obj \<leftarrow> get_object tcb_pptr;
tcb_obj' \<leftarrow> return $
case tcb_obj
of TCB tcb \<Rightarrow> TCB (tcb\<lparr>tcb_ipc_buffer := ipcbuf_vptr\<rparr>);
set_object tcb_pptr tcb_obj';
as_user tcb_pptr $ set_register CPSR 0x1f;
as_user tcb_pptr $ setNextPC ui_v_entry;
(* TCB priority not in abstract spec *)
setup_reply_master_local tcb_pptr;
set_thread_state tcb_pptr Running;
(* scheduler action not in abstract spec *)
idle_thread \<leftarrow> gets idle_thread;
modify (\<lambda>s. s\<lparr> cur_thread := idle_thread \<rparr>);
switch_to_thread tcb_pptr;
cap \<leftarrow> return $ ThreadCap tcb_pptr;
write_slot (cap_slot_pptr root_cnode_cap BI_CAP_IT_TCB) cap
od)
odE"
definition
create_device_frames :: "cap \<Rightarrow> (unit,'z::state_ext) ki_monad" where
"create_device_frames root_cnode_cap \<equiv> doE
dev_regs \<leftarrow> do_kernel_op $ do_machine_op getDeviceRegions;
(swp mapME) dev_regs (\<lambda>(start,end). doE
(* use 1M frames if possible, else 4K frames *)
frame_size \<leftarrow>
returnOk $ if (is_aligned start (pageBitsForSize ARMSection)
\<and> is_aligned end (pageBitsForSize ARMSection))
then ARMSection
else ARMSmallPage;
slot_pos_before \<leftarrow> liftE $ gets ndks_boot_slot_pos_cur;
(swp mapME) [start,(start + 2^(pageBitsForSize frame_size))
.e. (end - 1)]
(\<lambda>f. doE
frame_cap \<leftarrow> create_it_frame_cap f 0 None
(frame_size = ARMSection);
provide_cap root_cnode_cap frame_cap
odE);
slot_pos_after \<leftarrow> liftE $ gets ndks_boot_slot_pos_cur;
bi_dev_reg \<leftarrow> returnOk (addrFromPPtr start,
of_nat (pageBitsForSize frame_size),
(slot_pos_before, slot_pos_after));
liftE $ modify (\<lambda>s. s \<lparr> ki_bootinfo := (ki_bootinfo s) \<lparr>
bi_f_dev_reg_list := (bi_f_dev_reg_list $
ki_bootinfo s) @ [bi_dev_reg]
\<rparr>\<rparr>);
bi_frame \<leftarrow> liftE $ gets ndks_boot_bi_frame;
sync_bootinfo_frame bi_frame
odE);
liftE $ modify (\<lambda>s. s \<lparr> ki_bootinfo := (ki_bootinfo s) \<lparr>
bi_f_num_dev_regs := of_nat $ length (bi_f_dev_reg_list $
ki_bootinfo s)
\<rparr>\<rparr>);
bi_frame \<leftarrow> liftE $ gets ndks_boot_bi_frame;
sync_bootinfo_frame bi_frame
odE"
fun (* for (ptr,bits)-style regions which don't straddle the end of memory *)
no_region_overlap :: "(paddr \<times> nat) \<Rightarrow> (paddr \<times> nat) \<Rightarrow> bool" where
"no_region_overlap (ptr1,bits1) (ptr2,bits2) =
({ptr1 .. ptr1 + 2 ^ bits1 - 1} \<inter> {ptr2 .. ptr2 + 2 ^ bits2 - 1} = {})"
definition
freemem_regions :: "obj_ref set \<Rightarrow> ((paddr \<times> nat) list,'z::state_ext) s_monad" where
"freemem_regions free \<equiv> do
regs \<leftarrow> select {lst. (\<forall>(ptr,bits) \<in> set lst. is_aligned ptr bits \<and>
{ptr .. ptr + 2 ^ bits - 1} \<subseteq> free)
\<and> distinct_prop no_region_overlap lst};
return regs
od"
definition
create_untyped_obj :: "cap \<Rightarrow> (paddr \<times> paddr) \<Rightarrow> (unit,'z::state_ext) ki_monad" where
"create_untyped_obj root_cnode_cap boot_mem_reuse_reg \<equiv> doE
slot_pos_before \<leftarrow> liftE $ gets ndks_boot_slot_pos_cur;
(* re-use boot code/data frames *)
(swp mapME) [fst boot_mem_reuse_reg,(fst boot_mem_reuse_reg + 2^pageBits)
.e. (snd boot_mem_reuse_reg - 1)]
(\<lambda>i. provide_untyped_cap root_cnode_cap i pageBits
slot_pos_before);
(* allocate and provide the minimum number of 4K UT objects requested *)
slot_pos_cur \<leftarrow> liftE $ gets ndks_boot_slot_pos_cur;
(swp mapME) [(slot_pos_cur - slot_pos_before)..<MIN_NUM_4K_UNTYPED_OBJ]
(\<lambda>i. doE
pptr \<leftarrow> alloc_region pageBits;
provide_untyped_cap root_cnode_cap pptr pageBits slot_pos_before
odE);
(* convert remaining freemem into UT objects and provide the caps *)
(* using non-determinism to the max *)
freemem \<leftarrow> liftE $ gets ki_free_mem;
freeregs \<leftarrow> do_kernel_op $ freemem_regions freemem;
(swp mapME) (take MAX_NUM_FREEMEM_REG freeregs)
(\<lambda>(start,bits). provide_untyped_cap root_cnode_cap start bits
slot_pos_before);
slot_pos_after \<leftarrow> liftE $ gets ndks_boot_slot_pos_cur;
liftE $ modify (\<lambda>s. s \<lparr> ki_bootinfo := (ki_bootinfo s) \<lparr>
bi_f_ut_obj_caps := (slot_pos_before, slot_pos_after) \<rparr>\<rparr>);
bi_frame \<leftarrow> liftE $ gets ndks_boot_bi_frame;
sync_bootinfo_frame bi_frame
odE"
definition
map_kernel_frame :: "paddr \<Rightarrow> vspace_ref \<Rightarrow> vm_rights \<Rightarrow> vm_attributes
\<Rightarrow> (unit,'z::state_ext) s_monad" where
"map_kernel_frame paddr vaddr vm_rights attributes \<equiv> do
idx \<leftarrow> return $ (vaddr && mask (pageBitsForSize ARMSection))
>> pageBitsForSize ARMSmallPage;
global_pt \<leftarrow> get_arm_global_pt;
pte \<leftarrow> return $ SmallPagePTE paddr attributes vm_rights;
store_pte (global_pt + (idx << PTE_SIZE_BITS)) pte
od"
definition (* from plat/imx31/machine/hardware.c *)
map_kernel_devices :: "(unit,'z::state_ext) s_monad" where
"map_kernel_devices \<equiv> do
map_kernel_frame EPIT_PADDR EPIT_PPTR vm_kernel_only
{ParityEnabled,PageCacheable};
map_kernel_frame AVIC_PADDR AVIC_PPTR vm_kernel_only
{ParityEnabled,PageCacheable};
map_kernel_frame L2CC_PADDR L2CC_PPTR vm_kernel_only
{ParityEnabled,PageCacheable}
od"
definition
map_kernel_window :: "(unit,'z::state_ext) s_monad" where
"map_kernel_window \<equiv> do
global_pd \<leftarrow> gets (arm_global_pd \<circ> arch_state);
(* initial index into the PD, guaranteed to be divisible by 16 *)
idx \<leftarrow> return $ kernel_base >> pageBitsForSize ARMSection;
(* first physical address we'll map *)
phys \<leftarrow> return $ physBase;
(* map physBase at kernel_base 16M at a time, but not final supersection *)
iterations \<leftarrow> return ((2^(PD_BITS) - idx) >> 4);
(swp mapM) [0 .e. iterations - 1] (\<lambda>i. do
idx' \<leftarrow> return $ idx + i * 16;
phys' \<leftarrow> return $ phys + i * (2^(pageBitsForSize(ARMSuperSection)));
pde \<leftarrow> return $ SuperSectionPDE phys' {ParityEnabled,PageCacheable}
vm_kernel_only;
(* write 16 section entries for this supersection *)
mapM (\<lambda>offs. store_pde (idx' + offs) pde) [0 .e. 15]
od);
(* advance idx and phys to match exit of C loop *)
idx \<leftarrow> return $ idx + iterations * 16; (* should be 2^PD_BITS - 16 *)
phys \<leftarrow> return $ phys + iterations * (2^pageBitsForSize(ARMSuperSection));
(* next 15M mapped using 1M frames *)
(swp mapM) [0 .e. 14] (\<lambda>i. do
phys' \<leftarrow> return $ phys + i * (2^(pageBitsForSize(ARMSection)));
pde \<leftarrow> return $ SectionPDE phys' {ParityEnabled,PageCacheable} 0
vm_kernel_only;
store_pde (idx + i) pde
od);
(* advance idx and phys to match exit of C loop *)
idx \<leftarrow> return $ idx + 15; (* should be 2^PD_BITS - 1 *)
phys \<leftarrow> return $ phys + 15 * (2^pageBitsForSize(ARMSection));
(* now map global PT into last slot in global PD *)
global_pt \<leftarrow> get_arm_global_pt;
pde \<leftarrow> return $ PageTablePDE (addrFromPPtr global_pt) {ParityEnabled} 0;
store_pde idx pde;
(* init the PT *)
retype_region global_pt 1 PT_SIZE_BITS
(ArchObject PageTableObj);
(* map vector table *)
map_kernel_frame (addrFromPPtr arm_vector_table) PPTR_VECTOR_TABLE
vm_kernel_only {ParityEnabled,PageCacheable};
(* map globals frame *)
globals_frame \<leftarrow> gets (arm_globals_frame \<circ> arch_state);
map_kernel_frame (addrFromPPtr globals_frame) PPTR_GLOBALS_PAGE
vm_read_only {ParityEnabled,PageCacheable};
(* map stack frame *)
map_kernel_frame (addrFromPPtr arm_kernel_stack) PPTR_KERNEL_STACK
vm_kernel_only {ParityEnabled,PageCacheable};
map_kernel_devices
od"
definition
paddr_to_pptr_reg :: "(paddr \<times> paddr) \<Rightarrow> (paddr \<times> paddr)" where
"paddr_to_pptr_reg p_reg \<equiv> (fst p_reg + physMappingOffset,
snd p_reg + physMappingOffset)"
definition
init_kernel :: "paddr \<Rightarrow> paddr \<Rightarrow> word32 \<Rightarrow> vspace_ref \<Rightarrow> (unit,'z::state_ext) ki_monad" where
"init_kernel ui_p_reg_start ui_p_reg_end pv_offset v_entry \<equiv>