1REM > BtNetBSD
2REM $NetBSD: BtNetBSD,v 1.1.1.1 2002/05/09 20:03:57 jdolecek Exp $
3REM
4REM Copyright (c) 2000, 2001, 2002 Reinoud Zandijk
5REM Copyright (c) 1998, 1999, 2000 Ben Harris
6REM ELF file reading based on work by Ben Harris
7REM All rights reserved.
8REM
9REM Redistribution and use in source and binary forms, with or without
10REM modification, are permitted provided that the following conditions
11REM are met:
12REM 1. Redistributions of source code must retain the above copyright
13REM    notice, this list of conditions and the following disclaimer.
14REM 2. Redistributions in binary form must reproduce the above copyright
15REM    notice, this list of conditions and the following disclaimer in the
16REM    documentation and/or other materials provided with the distribution.
17REM 3. The name of the author may not be used to endorse or promote products
18REM    derived from this software without specific prior written permission.
19REM
20REM THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
21REM IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
22REM OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
23REM IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
24REM INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
25REM NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
26REM DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
27REM THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
28REM (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
29REM THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30REM
31REM This file is part of NetBSD/acorn32 -- a port of NetBSD to ARM6+ machines
32REM This source contains pieces of code by Ben Harris (file structure)
33REM and Mark Brinicombe (DRAM/VRAM search)
34REM
35REM Purpose : Trying to boot NetBSD/acorn32 !!
36
37
38ON ERROR REPORT:PRINT " at line ";ERL: PRINT'"Press key":QQ=GET:END
39
40debug%           = 0
41emulateVRAM%     = 0
42emulateDRAMsize% = 0
43extradebug%      = 0
44startdelay%      = 5
45
46REM For Kinetic cards
47SDRAM_ADDR_START% = 512*1024*1024
48REM For debugging only :
49REM SDRAM_ADDR_START% = &18000000
50
51
52REM set pretty screen for printing without scrolling
53SYS "XWimp_CommandWindow", -1: VDU 26
54SYS "XHourglass_Smash"
55MODE MODE
56COLOUR 128+4:CLS
57scwidth% = FNvdu_var(256): scheigth% = FNvdu_var(257)
58width% = INT(scwidth%*0.75*0.5)*2: heigth% = INT(scheigth%*0.75*0.5)*2
59VDU 4, 28, (scwidth%-width%)/2, (scheigth%+heigth%)/2, (scwidth%+width%)/2, (scheigth%-heigth%)/2
60COLOUR 128:CLS
61
62PRINT''
63PROCcenter("BtNetBSD 0.99a")
64PROCcenter("booting NetBSD/acorn32 on a RiscPC/A7000/NC")
65PRINT''
66
67REM get argument string
68SYS "OS_GetEnv" TO args$
69WHILE LEFT$(args$, 1)=" ": args$=MID$(args$,2):ENDWHILE
70IF LEFT$(args$, 5)="BASIC" THEN args$=MID$(args$, 6)
71WHILE LEFT$(args$, 1)=" ": args$=MID$(args$,2):ENDWHILE
72IF LEFT$(args$, 5)="-quit" THEN args$=MID$(args$, 6)
73WHILE LEFT$(args$, 1)=" ": args$=MID$(args$,2):ENDWHILE
74prog$ = LEFT$(args$, INSTR(args$, " ")-1)
75args$ = MID$(args$, LEN(prog$)+1)
76WHILE LEFT$(args$, 1)=" ": args$=MID$(args$,2):ENDWHILE
77
78REM get kernel name
79file$ = LEFT$(args$, INSTR(args$, " ")-1)
80PRINT"Booting ";file$;" ";args$''
81
82
83IF FNtolower(LEFT$(file$,9))="unixfs:$." THEN
84  kernelname$=MID$(file$, 10)
85ELSE
86  kernelname$="netbsd" : REM RISC OS file namen zeggen niets XXX
87ENDIF
88
89
90REM Get some space to mess with
91REM Declare a large array ... and then wipe it/map it in in the OS_Mem loop
92REM the difference is that RO4 won't map it in by default and
93REM that could trigger a OS_Memory bug ...
94SYS "OS_Memory", 6 TO ,memorytablesize%, nbpp% : REM get tablesize%
95memory_image_size% = HIMEM-512*1024            : REM keep a 512 Kb for vars
96DIM memory_image% memory_image_size%           : REM claim the space
97
98bot_memory% = memory_image%
99top_memory% = memory_image% + memory_image_size%
100
101KERNEL_BASE = &F0000000
102
103MAX_RELOCPAGES = 4096
104MAX_DRAMBANKS = 32
105MAX_VRAMBANKS = 16
106
107twirl% = 0
108firstpage%  = (bot_memory% DIV nbpp%)+1
109lastpage%   = (top_memory% DIV nbpp%)-1
110totalpages% = lastpage% - firstpage%
111PRINT "I got a ";totalpages%;" memory pages to mess with"
112
113relocsize% = (MAX_RELOCPAGES+1)*12
114DIM relocinstr% relocsize%
115relocpos% = relocinstr%+4 : REM first word in number of relocations
116relocnr% = 0: relocoff% = 0
117
118REM this memory block contains all information about the memory layout
119REM maybe a bug in BASIC but if I DIM this variable in a procedure it
120REM gets on the stack or so ? It malfunctions if I pass this on as a
121REM procedure variable.
122DIM memoryblock% (totalpages%*12+4)
123
124PROCget_memory_configuration
125PROCget_memory_map
126
127PROCload_kernel(file$)
128PROCcreate_initial_pagetables
129PROCadd_pagetables
130PROCcreate_configuration
131
132REM now only the relocation code itself and then copying the relocation table itself
133!relocinstr% = relocnr%
134PROCcreate_relocate_mechanism
135PRINT " "
136
137REM start the kernel
138A% = FNblock_paddr(configurationbasepage%)
139B% = physical_start_address% - FNblock_vaddr(relocatebasepage%) + FNblock_paddr(relocatebasepage%)
140C% = FNblock_paddr(relocatebasepage%) + nbpp% : REM one page after the code
141D% = L1pages_phys%
142E% = entry%
143
144IF debug% THEN
145  IF ((relocpos%-(relocinstr%+4)) MOD 12)<>0 THEN ERROR 0,"Sanity check for relocation entries failed!"
146  PRINT"Entering kernel at 0x";~entry%
147  REM  OSCLI("Memoryi "+STR$~(FNblock_vaddr(start_kernelpage%)+(entry% MOD nbpp%)))
148  REM  PRINT"Go for it (key)":qq=GET
149ENDIF
150PRINT ''"Press ESC to abort loader"
151PRINT "Kernel will be started in ";
152FOR secs%=startdelay% TO 1 STEP -1
153  PRINT ;secs%;"...";
154  tt=TIME: WHILE TIME-tt<=100: ENDWHILE : REM wait one second
155NEXT
156PRINT "start!"
157
158REM get ECID for each podule
159FOR pod% =-1 TO 8
160  SYS "XPodule_ReadID",,,,pod%
161NEXT
162
163REM shut down RiscOS
164SYS "XOS_CLI", "RMKill UnixFS"
165SYS "OS_FSControl", 23     : REM close files etc.
166SYS "OS_ServiceCall",, &45 : REM prereset
167
168REM Remove all cursors
169*pointer 0
170SYS "OS_RemoveCursors"
171
172REM XXX is this OK ? What is this!
173DIM buf 8
174buf!?3 = 2: buf!4 = 0: SYS "OS_Word", 22, buf+3
175
176CALL relocate_entry%
177
178END
179
180
181DEF PROCload_kernel(file$)
182  LOCAL file%, magic%
183  file% = OPENIN(file$)
184  IF file% = 0 THEN ERROR EXT 1, "Can't open kernel"
185    DIM magic% 3
186  SYS "OS_GBPB", 3, file%, magic%, 4, 0
187  IF magic%?0 = 127 AND magic%?1 = ASC("E") AND magic%?2 = ASC("L") AND magic%?3 = ASC("F") THEN
188    PROCload_kernel_elf(file%)
189  ELSE
190    PROCload_kernel_aout(file%)
191  ENDIF
192  CLOSE#file%
193ENDPROC
194
195
196
197REM *****************************************************************************
198REM * ELF LOADER                                                                *
199REM *****************************************************************************
200
201
202DEF PROCload_kernel_elf(file%)
203  REM read header
204  DIM hdr% 52
205  SYS "OS_GBPB", 3, file%, hdr%, 52, 0
206
207  REM check if its a correct kernel to load
208  IF hdr%?4 <> 1 THEN ERROR 1, "Not a 32-bit ELF file"
209  IF hdr%?5 <> 1 THEN ERROR 1, "Not an LSB ELF file"
210  IF hdr%?6 <> 1 THEN ERROR 1, "Not a version-1 ELF file"
211  REM hdr%?7 is EI_OSABI.  Should it be 255 (ELFOSABI_STANDALONE)?
212  IF (hdr%!16 AND &FFFF) <> 2 THEN ERROR 1, "Not an executable ELF file"
213  IF (hdr%!18 AND &FFFF) <> 40 THEN ERROR 1, "Not an ARM ELF file"
214
215  PRINT "(ELF) ";
216  REM read kernel characteristics and headers
217  entry% = hdr%!24
218  phoff% = hdr%!28
219  shoff% = hdr%!32
220  phentsize% = hdr%!42 AND &FFFF
221  phnum% = hdr%!44 AND &FFFF
222  shentsize% = hdr%!46 AND &FFFF
223  shnum% = hdr%!48 AND &FFFF
224  DIM phdrs% phnum% * phentsize% - 1  : REM array with headers ?
225  SYS "OS_GBPB", 3, file%, phdrs%, phnum% * phentsize%, phoff%
226  IF phnum% = 0 THEN ERROR 1, "No program headers"
227
228  REM start loading !
229  freepagesbase% = first_mapped_DRAM_index% : REM == first virt address in DRAM0a
230  start_kernelpage% = freepagesbase%
231  pv_offset% = KERNEL_BASE - DRAM_addr%(0) : REM XXX hardcoded
232
233  REM load the program blocks
234  first% = TRUE
235  FOR ph% = phdrs% TO phdrs% + (phnum% - 1) * phentsize% STEP phentsize%
236    IF ph%!0 = 1 THEN
237      REM We only do PT_LOAD
238      IF NOT first% THEN PRINT "+";
239      first%  = FALSE
240      offset% = ph%!4
241      vaddr%  = ph%!8
242      REM physaddr% = ph%!12
243      filesz% = ph%!16
244      memsz%  = ph%!20
245      flags%  = ph%!24
246      PROCload_chunk(file%, offset%, vaddr%, filesz%, memsz%)
247      REM freepagesbase% is updated
248
249      vfreebase% = vaddr% + memsz% : REM memsz% is the real size.... filesz can be only Text f.e.
250    ENDIF
251  NEXT
252
253  txtbase% = 0
254  txtsize% = 0
255  database% = 0
256  datasize% = 0
257  bssbase% = 0
258  bsssize% = 0
259  ssym% = 0
260  esym% = 0
261
262  DIM shdrs% shnum% * shentsize% - 1
263  SYS "OS_GBPB", 3, file%, shdrs%, shnum% * shentsize%, shoff%
264  IF shnum% <> 0 THEN
265    havesyms% = FALSE
266    FOR sh% = shdrs% TO shdrs% + (shnum% - 1) * shentsize% STEP shentsize%
267      IF sh%!4 = 2 THEN havesyms% = TRUE
268    NEXT
269    IF havesyms% THEN
270      IF INSTR(args$, "symtab")=0 THEN havesyms% = FALSE
271      IF debug% THEN
272        IF havesyms% PRINT ;" (symbols avail) "; ELSE PRINT ;" (ignoring symbols) ";
273      ENDIF
274    ENDIF
275    REM freepagesbase% points to first free relocation page
276    IF havesyms% THEN
277      REM vfreebase points to first free address in relocated area
278      PRINT "+[";
279
280      REM First, we have the munged ELF header
281      ssym% = vfreebase%
282      ssympage% = freepagesbase%
283      PROCload_chunk(file%, 0, ssym%, 52, 52)
284      !(FNblock_vaddr(ssympage%) + 32) = 52: REM  PROCwrite_word(ssym%+32, 52)
285      vfreebase% += 52
286
287      REM then, the munged section headers
288      mshdrs% = vfreebase%
289      mshdrspage% = freepagesbase%
290      PRINT "+";
291      PROCload_chunk(file%, shoff%, mshdrs%, shnum% * shentsize%, shnum% * shentsize%)
292      vfreebase% += shnum% * shentsize%
293      FOR sh% = shdrs% TO shdrs% + (shnum% - 1) * shentsize% STEP shentsize%
294        IF sh%!4 = 2 OR sh%!4 = 3 THEN
295          PRINT "+";
296          PROCload_chunk(file%, sh%!16, vfreebase%, sh%!20, sh%!20)
297          !(FNblock_vaddr(mshdrspage%) + sh% - shdrs% + 16) = vfreebase% - ssym%
298          vfreebase% += FNroundup(sh%!20, 4)
299        ENDIF
300      NEXT
301      esym% = vfreebase%
302      PRINT "]";
303    ENDIF
304  ENDIF
305  PRINT " ";
306
307  kernelpages% = freepagesbase% - start_kernelpage%
308  IF extradebug% THEN PRINT ''"Number of kernel pages ";kernelpages%;" (";kernelpages%*nbpp%;" bytes)"
309
310  PROCfinish_relocationtable
311ENDPROC
312
313
314DEF PROCload_chunk(file%, offset%, vaddr%, filesz%, memsz%)
315  LOCAL paddr%, ppn%, fragaddr%, fragsz%
316
317  REM offset%  offset in file
318  REM vaddr%   indicates virtual address where stuff needs to be relocated to
319  REM filesz%  number of bytes to read of `file' for this chunk
320  REM memsz%   number of bytes to clear for this chunk
321  PRINT ;filesz%;
322  IF extradebug% PRINT ;" (";~vaddr%;"-";~(vaddr%+memsz%);" [till base+";INT((vaddr%+memsz%-&F0000000)/1024);"k]) ";
323  WHILE filesz% > 0
324    REM freepagesbase% is first page index in freepages list
325    fragsz% = nbpp%
326    IF fragsz% > filesz% THEN fragsz% = filesz%
327
328    fragaddr% = FNblock_vaddr(freepagesbase%)
329    SYS "OS_GBPB", 3, file%, fragaddr%, fragsz%, offset%
330
331    REM create a relocation block
332    relocpos%!0 = FNblock_paddr(freepagesbase%)
333    relocpos%!4 = vaddr% - pv_offset%
334    relocpos%!8 = fragsz%
335    relocpos% += 12: relocnr%+=1: relocoff%+=1
336    freepagesbase% += 1
337
338    offset% += fragsz%
339    vaddr% += fragsz%
340    filesz% -= fragsz%
341    memsz% -= fragsz%
342    PROCtwirl
343  ENDWHILE
344
345  IF memsz% > 0 PRINT "+";memsz%;
346  WHILE memsz% > 0
347    REM freepagesbase% is first page index in freepages list
348    fragsz% = nbpp%
349    IF fragsz% > memsz% THEN fragsz% = memsz%
350
351    PROCbzero(FNblock_vaddr(freepagesbase%), fragsz%)
352
353    REM create a relocation block
354    relocpos%!0 = FNblock_paddr(freepagesbase%)
355    relocpos%!4 = vaddr% - pv_offset%
356    relocpos%!8 = fragsz%
357    relocpos% += 12: relocnr%+=1: relocoff%+=1
358    freepagesbase% += 1
359
360    offset% += fragsz%
361    vaddr% += fragsz%
362    filesz% -= fragsz%
363    memsz% -= fragsz%
364    PROCtwirl
365  ENDWHILE
366ENDPROC
367
368
369REM *****************************************************************************
370REM * A.OUT LOADER                                                              *
371REM *****************************************************************************
372
373DEF PROCload_kernel_aout(file%)
374  LOCAL hdr%
375  DIM hdr% 32
376  ssym% = 0 : esym% = 0
377  SYS "OS_GBPB", 3, file%, hdr%, 32, 0
378  bemagic% = (hdr%?0 << 24) OR (hdr%?1 <<16) OR (hdr%?2 << 8) OR hdr%?3
379  CASE bemagic% AND &0000FFFF OF
380    WHEN &0107
381      PRINT "(OMAGIC) ";
382    WHEN &0108
383      PRINT "(NMAGIC) ";
384    WHEN &010B
385      PRINT "(ZMAGIC) ";
386    WHEN &00CC
387      PRINT "(QMAGIC) ";
388  ENDCASE
389  REM XXX: Assume ZMAGIC
390
391  REM foooff% is byte offset in file.  foobasepage% is base page in RAM.
392  txtoff% = 0 : REM in arm26 its 4096
393  txtbasepage% = first_mapped_DRAM_index% : REM == first virt address in DRAM0a
394  start_kernelpage% = txtbasepage%
395
396  txtsize% = hdr%!4
397  IF txtsize% MOD nbpp% <> 0 THEN
398    ERROR EXT 1, "Text size not a multiple of page size"
399  ENDIF
400  txtpages% = txtsize% DIV nbpp%
401  dataoff% = txtoff% + txtsize%
402  databasepage% = txtbasepage% + txtpages%
403  database% = databasepage% * nbpp%
404  datasize% = hdr%!8
405  IF datasize% MOD nbpp% <> 0 THEN
406    ERROR EXT 1, "Data size not a multiple of page size"
407  ENDIF
408  datapages% = datasize% DIV nbpp%
409  bssbasepage% = databasepage% + datapages%
410  bssbase% = bssbasepage% * nbpp%
411  bsspages% = FNroundup(hdr%!12, nbpp%) DIV nbpp%
412  bsssize% = bsspages% * nbpp%
413  IF bsssize% MOD nbpp% <> 0 THEN
414    ERROR EXT 1, "Bss size not a multiple of page size"
415  ENDIF
416
417  entry% = hdr%!20
418  IF debug% THEN PRINT "Entry point at ";~entry%
419
420  REM kernelpages without syms table is :
421  kernelpages% = txtpages% + datapages% + bsspages% : REM
422
423  REM  symbasepage% = bssbasepage% + bsspages%-1 : REM REAL size... not in pages
424  symoff% = dataoff% + datasize%
425  symsize% = hdr%!16
426  stringtablesize% = EXT#file% - (txtsize% + datasize% + symsize%)
427  IF INSTR(args$, "symtab")>0 THEN
428    kernelpages% += FNroundup(stringtablesize% + symsize% + 4, nbpp%) DIV nbpp%
429  ELSE
430    symsize% = 0
431    stringtablesize% = 0
432  ENDIF
433  REM reserve 1 extra word for the length
434  symbolsize% = symsize% + stringtablesize% + 4
435  symbolpages% = FNroundup(symbolsize%, nbpp%) DIV nbpp%
436  IF debug% PRINT '"Stringtablesize = 0x";~stringtablesize%;"  symsize = 0x";~symsize%
437
438  PRINT '"A total of about ";kernelpages%;" pages need to be relocated"
439  IF (kernelpages%+40)*nbpp% > memory_image_size% THEN
440    REM 40 is an estimation ...
441    ERROR EXT 1, "Not enough memory free... please increase WimpSlot in the configuration file"
442  ENDIF
443
444  PRINT ;txtsize%;
445  new_hdr% = FNblock_vaddr(txtbasepage%)
446  FOR pg% = 0 TO txtpages%-1
447    SYS "OS_GBPB", 3, file%, FNblock_vaddr(txtbasepage%+pg%), nbpp%, txtoff% + pg%*nbpp%
448    relocpos%!0 = FNblock_paddr(txtbasepage%+pg%)
449    relocpos%!4 = kernel_phys_start% + nbpp%*relocoff%: relocnr%+=1: relocoff%+=1
450    relocpos%!8 = nbpp%
451    relocpos% += 12
452    PROCtwirl
453  NEXT
454
455  PRINT "+";datasize%;
456  FOR pg% = 0 TO datapages%-1
457    SYS "OS_GBPB", 3, file%, FNblock_vaddr(databasepage%+pg%), nbpp%, dataoff% + pg%*nbpp%
458    relocpos%!0 = FNblock_paddr(databasepage%+pg%)
459    relocpos%!4 = kernel_phys_start% + nbpp%*relocoff%: relocnr%+=1: relocoff%+=1
460    relocpos%!8 = nbpp%
461    relocpos% += 12
462    PROCtwirl
463  NEXT
464  REM PRINT;"(";off%;" gaps)";
465
466  PRINT "+";bsssize%;
467  FOR pg% = 0 TO bsspages%-1 : REM overshoot is safe
468    PROCbzero(FNblock_vaddr(bssbasepage%+pg%), nbpp%)
469    relocpos%!0 = FNblock_paddr(bssbasepage%+pg%)
470    relocpos%!4 = kernel_phys_start% + nbpp%*relocoff%: relocnr%+=1: relocoff%+=1
471    relocpos%!8 = nbpp%
472    relocpos% += 12
473    PROCtwirl
474  NEXT
475  REM PRINT;"(";off%;" gaps)";
476
477  freepagesbase% = bssbasepage% + bsspages%
478
479  IF INSTR(args$, "symtab")>0 THEN
480    symbasepage% = freepagesbase%
481
482    REM put a page for the value of symsize just after bss%
483    symDaddr% = !(relocpos%-8) + ((hdr%!12) AND (nbpp%-1))
484
485    symstartpagaddrV% = FNblock_vaddr(symbasepage%)
486    PROCbzero(symstartpagaddrV%, nbpp%)
487    !symstartpagaddrV% = symsize%
488
489    relocpos%!0 = FNblock_paddr(symbasepage%)
490    relocpos%!4 = symDaddr%  : relocnr%+=1: relocoff%+=1
491    relocpos%!8 = nbpp% : REM XXX
492    relocpos% += 12
493    symDaddr% += 4
494
495    REM update the symbasepage !! ... we used one!
496    symbasepage%+=1
497
498    PRINT "+";symbolsize%;
499    REM now fill in rest of the file
500    FOR pg% = 0 TO symbolpages%-1 : REM => due to first page to hold offset
501      SYS "OS_GBPB", 3, file%, FNblock_vaddr(symbasepage%+pg%), nbpp%, symoff% + pg%*nbpp%
502      relocpos%!0 = FNblock_paddr(symbasepage%+pg%)
503      relocpos%!4 = symDaddr% + nbpp%*pg%: relocnr%+=1: relocoff%+=1
504      relocpos%!8 = nbpp%
505      relocpos% += 12
506      PROCtwirl
507    NEXT
508
509    freepagesbase% = symbasepage% + symbolpages% + 4 : REM XXX
510  ENDIF
511
512  REM update new header structure
513  new_hdr%!16 = symsize%
514
515  REM mark highest virtual address free in NetBSD's mapping
516  vfreebase% = KERNEL_BASE + nbpp%*relocoff%
517
518  REM `patch' symbol table stuff
519  ssym% = 0
520  esym% = 0
521
522  PROCfinish_relocationtable
523ENDPROC
524
525
526REM *****************************************************************************
527REM * Common loader and relocate stuff                                          *
528REM *****************************************************************************
529
530DEF PROCfinish_relocationtable
531  REM align vfreebase% to a page
532  vfreebase% = FNroundup(vfreebase%, nbpp%)
533  relocoff% = (vfreebase% - KERNEL_BASE) DIV nbpp%
534
535  IF vfreebase% > (nbpp%*relocoff% + KERNEL_BASE) THEN
536    PRINT ''"WHOOAH!' : 0x", ~vfreebase%;" > 0x";~(nbpp%*relocoff%+KERNEL_BASE)
537    freepagesbase% += 16
538    kernelpages%   += 16
539    relocoff%      += 16
540  ENDIF
541
542  IF INSTR(args$, "oldkernel")>0 THEN
543    REM place the arguments in a block ... for the old bootloader's sake
544    argsbasepage% = freepagesbase%
545    argspages% = 1
546    argvirtualbase% = nbpp%*relocoff% + KERNEL_BASE
547    relocpos%!0 = FNblock_paddr(argsbasepage%)
548    relocpos%!4 = kernel_phys_start% + nbpp%*relocoff%: relocnr%+=1: relocoff%+=1
549    relocpos%!8 = nbpp%
550    relocpos% += 12
551    $(FNblock_vaddr(argsbasepage%)) = args$+CHR$0
552    freepagesbase% += argspages%
553    kernelpages%   += argspages%
554    IF debug% THEN PRINT "Args at 0x";~argvirtualbase%
555  ELSE
556    REM reserve some space for the MDF file
557    REM XXX not implemented yet XXX
558  ENDIF
559
560  REM I give it a 48k scratch space
561  scratchbasepage% = freepagesbase%
562  scratchpages% = 12
563  scratchvirtualbase% = nbpp%*relocoff% + KERNEL_BASE
564  freepagesbase% += scratchpages%
565  kernelpages%   += scratchpages%
566
567  REM Create one page for the initial vectors
568  initvectorbasepage% = freepagesbase%
569  initvectorpages%    = 1
570  relocpos%!0 = FNblock_paddr(initvectorbasepage%)
571  relocpos%!4 = top_physdram% - 1*1024*1024 : relocnr%+=1
572  relocpos%!8 = nbpp%
573  relocpos% += 12
574  freepagesbase% += initvectorpages%
575
576  P%=FNblock_vaddr(initvectorbasepage%)
577  FOR vec=0 TO &20 STEP 4
578    [OPT 2: MOVS PC, r14:]
579  NEXT
580ENDPROC
581
582
583DEF PROCadd_pagetables
584  REM DESTINATION MUST BE ON A 16kb boundary!!! (!!!!)
585  REM get 4 pages on the top of physical memory (top_physdram%) and copy PT's in it
586  addr% = top_physdram% - 4*nbpp%
587  IF (addr% AND (16*1024-1)) <> 0 ERROR EXT 0, "L1 pages not on 16Kb boundary"
588  FOR pg%=0 TO 3
589    PROCcopy(FNblock_vaddr(freepagesbase% + pg%), bootpagetables% + pg%*nbpp%, nbpp%)
590    relocpos%!0 = FNblock_paddr(freepagesbase%+pg%)
591    relocpos%!4 = addr%+pg%*nbpp%: relocnr%+=1
592    relocpos%!8 = nbpp%
593    relocpos% += 12
594  NEXT
595  L1pages_phys% = addr%
596  freepagesbase% = freepagesbase%+pg%
597ENDPROC
598
599
600DEF PROCcreate_initial_pagetables
601  LOCAL I%, addr%, kaddr%, mapped_screenmemory%
602  DIM bootpagetables% 16*1024
603  REM linear translation on the whole domain 00 in blocks of 1Mb
604  REM AP=%01, CB=%00 for easy initial setup, dom=0
605  FOR I%=0 TO 4*1024-1
606    bootpagetables%!(I%*4) = (I%<<20) + (0<<11)+(1<<10) + (1<<4) + (0<<3) + (0<<2) + (1<<1) + 0
607  NEXT
608
609  REM video memory is mapped 1:1 in the DRAM section or in VRAM section
610
611  REM map 1Mb from top of memory to bottom 1Mb of virt. memmap
612  addr% = (top_physdram%/1024/1024) -1
613  bootpagetables%!0 = (addr%<<20) + (0<<11)+(1<<10) + (1<<4) + (0<<3) + (0<<2) + (1<<1) + 0
614
615  REM map 16 Mb of DRAM0a (kernel space) to 0xf0000000
616  FOR I%=0 TO 15
617    addr% = (kernel_phys_start% >> 20) + I%
618    kaddr% = &F00 + I% : REM &F0000000 LSR #20 + I%
619    bootpagetables%!(kaddr%*4) = (addr%<<20) + (0<<11)+(1<<10) + (1<<4) + (0<<3) + (0<<2) + (1<<1) + 0
620  NEXT
621ENDPROC
622
623
624DEF PROCcreate_relocate_mechanism
625  REM relocate mechanism relies on a contigunous space of the relocator + tables
626  REM this isn't finished yet
627
628  relocatesize% = nbpp% + relocsize% : REM just ONE code page + relocation table
629  PRINT ;"+";relocatesize%;
630  relocatepages% = FNroundup(relocatesize%, nbpp%) DIV nbpp%
631  relocatebasepage% = freepagesbase%
632  pg%=0
633  WHILE pg%<relocatepages%
634    IF pg%>0 THEN
635      PROCcopy(FNblock_vaddr(relocatebasepage%+pg%), relocinstr%+(pg%-1)*nbpp%, nbpp%)
636    ENDIF
637    PROCtwirl
638
639    IF pg%<>relocatepages%-1 THEN
640      IF FNblock_paddr(relocatebasepage%+pg%+1)-FNblock_paddr(relocatebasepage%+pg%)<>nbpp% THEN
641        REM Help! non contigunous relocate area => try again
642        REM ERROR EXT 0, "Help! non contigunous relocate area"
643        PRINT ;"*";
644        relocatebasepage% = freepagesbase% + pg% : REM  try again from this page
645        pg%=-1 : REM will be auto incremented later ...
646      ENDIF
647    ENDIF
648    pg%+=1
649  ENDWHILE
650  PROCassemble_relocate_code(FNblock_vaddr(relocatebasepage%), FNblock_paddr(relocatebasepage%), entry%, L1pages_phys%)
651ENDPROC
652
653
654DEF PROCcreate_configuration
655  PRINT ;"+";nbpp%;
656  configurationbasepage% = freepagesbase%
657  configurationpages% = 1
658  freepagesbase% += configurationpages%
659
660  REM fatal(swix(OS_ReadSysInfo, IN(R0)|OUT(R3), 2, &bootconfig.machine_id));
661  SYS "OS_ReadSysInfo", 2 TO r0,r1,r2, machineId%
662
663  IF INSTR(args$, "oldkernel")>0 THEN
664    PROCold_configuration_structure
665  ELSE
666    PROCnew_configuration_structure
667  ENDIF
668ENDPROC
669
670
671DEF PROCnew_configuration_structure
672  FOR opt%=0 TO 2 STEP 2
673    P% = FNblock_vaddr(configurationbasepage%)
674    [OPT opt%
675    ; u_int magic
676        EQUD          &43112233 ; BOOTCONFIG_MAGIC
677    ; u_int bootconfig_version
678        EQUD          2
679
680    ; u_char machine_id[4]
681        EQUD          machineId%
682    ; char kernelname[80]
683        EQUS          LEFT$(kernelname$+CHR$0+STRING$(80, " "), 80)
684    ; char args[512]
685        EQUS          args$+CHR$0
686        ]: P% += 512 - LEN(args$+CHR$0): [ OPT opt%
687
688    ; u_int kernvirtualbase             /* not used now */
689        EQUD 0
690    ; u_int kernphysicalbase            /* not used now */
691        EQUD 0
692    ; u_int kernsize
693        EQUD          kernelpages% * nbpp%
694    ; u_int scratchvirtualbase
695        EQUD          scratchvirtualbase%
696    ; u_int scratchphysicalbase
697        EQUD          scratchvirtualbase%
698    ; u_int scratchsize
699        EQUD          scratchpages% * nbpp%
700
701    ; u_int ksym_start
702        EQUD ssym%
703    ; u_int ksym_end
704        EQUD esym%
705
706    ; u_int MDFvirtualbase
707        EQUD 0
708    ; u_int MDFphysicalbase
709        EQUD 0
710    ; u_int MDFsize
711        EQUD 0
712
713    ; u_int display_phys
714        EQUD          videomem_start%
715    ; u_int display_start
716        EQUD          videomem_start% ; screenstart (149)
717    ; u_int display_size
718        EQUD          display_size%   ; screensize  (150)
719    ; u_int width
720        EQUD          FNvdu_var(11)   ; acorn32 port needs 0..x-1
721    ; u_int heigth
722        EQUD          FNvdu_var(12)   ; acorn32 port needs 0..y-1
723    ; u_int log2_bpp
724        EQUD          FNvdu_var(9)    ; acorn32 port needs log(bitsperpixel)/log(2)
725    ; u_int framerate
726        EQUD          56 ; XXX why?
727
728    ; char reserved[512]
729    ]: P% += 512: [ OPT opt%
730
731    ; u_int pagesize
732        EQUD          nbpp%
733    ; u_int drampages
734        EQUD          totaldrampages%
735    ; u_int vrampages;
736        EQUD          totalvrampages%
737    ; u_int dramblocks
738        EQUD          dramblocks%
739    ; u_int vramblocks
740        EQUD          vramblocks%
741
742    ]
743    REM phys_mem dram[DRAM_BLOCKS]  <- 32
744    FOR I%=0 TO MAX_DRAMBANKS-1
745      [OPT opt%
746        ; address% : EQUD DRAM_addr%(I%)
747        ; length%  : EQUD DRAM_pages%(I%)
748        ; flags%   : EQUD 0
749      ]
750    NEXT
751    REM phys_mem vram[VRAM_BLOCKS]  <- 16
752    FOR I%=0 TO MAX_VRAMBANKS-1
753      [OPT opt%
754        ; address% : EQUD VRAM_addr%(I%)
755        ; length%  : EQUD VRAM_pages%(I%)
756        ; flags%   : EQUD 0
757      ]
758    NEXT
759  NEXT
760ENDPROC
761
762
763DEF PROCold_configuration_structure
764  FOR opt%=0 TO 2 STEP 2
765    P% = FNblock_vaddr(configurationbasepage%)
766    [OPT opt%
767    ;kernvirtualbase%
768        EQUD          0   ; not used
769    ;kernphysicalbase%
770        EQUD          0   ; not used
771    ;kernsize%
772        EQUD          kernelpages% * nbpp%
773    ;argvirtualbase
774        EQUD          argvirtualbase%
775    ;argphysicalbase
776        EQUD          FNblock_paddr(argsbasepage%)
777    ;argsize%
778        EQUD          nbpp%
779    ;scratchvirtualbase%
780        EQUD          scratchvirtualbase%
781    ;scratchphysicalbase%
782        EQUD          scratchvirtualbase%
783    ;scratchsize%
784        EQUD          scratchpages% * nbpp%
785    ;display_start%
786        EQUD          videomem_start% ; screenstart (149)
787    ;display_size%
788        EQUD          display_size%   ; screensize  (150)
789    ;width%
790        EQUD          FNvdu_var(11)   ; arm32 port needs 0..x-1
791    ;height%
792        EQUD          FNvdu_var(12)   ; arm32 port needs 0..y-1
793    ;bitsperpixel
794        EQUD          FNvdu_var(9)    ; arm32 port needs log(bitsperpixel)/log(2)
795    ]
796    REM for compatibility for now just 4 DRAM and 1 VRAM
797    FOR I%=0 TO 3
798      [OPT opt%
799        ;address% : EQUD DRAM_addr%(I%)
800        ;length%  : EQUD DRAM_pages%(I%)
801      ]
802    NEXT
803    REM current config structure only wants 1 VRAM entry !
804    FOR I%=0 TO 0
805      [OPT opt%
806        ;address% : EQUD VRAM_addr%(I%)
807        ;length%  : EQUD VRAM_pages%(I%)
808      ]
809    NEXT
810    [OPT opt%
811    ;c_dramblocks%
812        EQUD          dramblocks%
813    ;c_vramblocks%
814        EQUD          vramblocks%
815    ;pagesize%
816        EQUD          nbpp%
817    ;drampages%
818        EQUD          totaldrampages%
819    ;vrampages%
820        EQUD          totalvrampages%
821    ;kernelname%
822        EQUS          LEFT$(kernelname$+CHR$0+STRING$(80, " "), 80)
823    ;framerate%
824        EQUD          56 ; XXXXX
825    ;machine_id%
826        EQUD          machineId%
827    ;magic%
828        EQUD          &43112233 ; BOOTCONFIG_MAGIC
829    ;display_phys%
830        EQUD          videomem_start%
831    ]
832  NEXT opt%
833ENDPROC
834
835
836REM XXXX a bit messy still
837DEF PROCassemble_relocate_code(virtaddress%, physaddress%, entry%, L1pages_phys%)
838  FOR opt%=0 TO 2 STEP 2
839    P%=virtaddress%
840    [OPT opt%
841      ; entry conditions :
842      ;   - on RiscOS page tables in usr26 mode on virt address ....
843      ;   - R0  pointer to configuration structure
844      ;   - R1  pointer to physical restart point
845      ;   - R2  pointer to physical relocation table
846      ;   - R3  pointer to physical new L1 page address
847      ;   - R4  new virt adres of kernel entry%
848      .relocate_entry%
849        ; Enter sup26 mode
850        SWI "OS_EnterOS"
851
852        ; move args up in register bank
853        STMFD r13!, {r0-r4}
854        LDMFD r13!, {r8-r12}
855
856        ; r8  = config structure address
857        ; r9  = physical restart point address
858        ; r10 = physical relocation table address
859        ; r11 = physical address of new L1page
860        ; r12 = kernel entry point in new virt. map
861
862        ; go to sup32 mode with IRQ + FIQ disabled
863        EQUD %11100001000011110000000000000000 ; MRS R0, CPSR
864        BIC r0, r0, #&1F                       ; clear proc. mode
865        ORR r0, r0, #(1<<7) + (1<<6)           ; set FIQ + IRQ disable
866        ORR r0, r0, #%10011                    ; superv. 32 bit
867        EQUD %11100001001010011111000000000000 ; MSR CPSR, r0
868        MOV r0, r0
869        MOV r0, r0                             ; nops ... nessisary?
870
871        ; flush data cache
872        ; just read a 64kb app space in the cache
873        MOV r0, #&8000
874        ADD r1, r0, r0
875      .loop_flush1
876        LDR r2, [r0], #4
877        SUBS r1, r1, #4
878        BNE loop_flush1
879
880        ; determine processor type ... nessisary for correct copro instr .. store in r13
881        EQUD %11101110000100000000111100010000 ; MRC cp15, 0, r0, c0, c0, 0 ; read CPU Id in r0
882        MOV   r13, r0                          ; store in r13
883
884        ; determine if its a StrongARM
885        MOV   r14, #1                          ; r14 flags if its a StrongARM ... assume one
886
887        ; detecting an ARM6 needs a special mask
888        MOV   r0,     #&FF000000               ; get processor discr. mask in r0
889        ADD   r0, r0, #&00000F00               ;
890
891        MOV   r1,     #&41000000               ; check for 0x41xxx6xx => ARM6
892        ADD   r1, r1, #&00000600
893        AND   r2, r13, r0                      ; mask with discr. mask
894        CMP   r2, r1                           ; is it a ARM6 ?
895        MOVEQ r14, #0                          ; ifso ... then its a v3
896
897        ; newer ARMs need a different mask
898        MOV   r0,     #&FF000000               ; get processor discr. mask in r0
899        ADD   r0, r0, #&0000F000               ;
900
901        MOV   r1,     #&41000000               ; check for 0x41xx7xxx => ARM7
902        ADD   r1, r1, #&00007000
903        AND   r2, r13, r0                      ; mask with discr. mask
904        CMP   r2, r1                           ; is it a ARM7 ?
905        MOVEQ r14, #0                          ; ifso ... then its a v3
906
907;        MOV   r1,     #&44000000               ; check for 0x44xxaxxx => Strong ARM
908;        ADD   r1, r1, #&0000a000
909;        AND   r2, r13, r0                      ; mask with discr. mask
910;        CMP   r2, r1                           ; is it a StrongARM ?
911
912        ; switch off MMU, IDcache and WB and branch to physical code !!
913        CMP r14, #0
914        EQUD %00011110000100010000111100010000 ; MRCNE cp15, 0, r0, c1, c0, 0 ; read control register
915        BICNE r0, r0, #&3F                     ; clear only known bits please !
916        MOVEQ r0, #0                           ; ARM6/7 only have these
917        ORR r0, r0, #%0001110000
918        ;             RSB1DPWCAM
919        MOV r13, r0                            ; save this value in r13
920        MOV r1, #0
921        CMP r14, #0
922        EQUD %11101110000000010000111100010000 ; MCR cp15, 0, r0, c1, c0, 0 ; write control register
923        EQUD %00011110000001110001111100010101 ; MCRNE cp15, 0, r1, c7, c5, 0 ; write 0 in v4 MMU disable
924        MOV pc, r9                             ; call rest of code in physical mem ... not flat
925
926      .physical_start_address%
927        ; should now be running in physical space
928        ; this relocate code can be heavyly optimised ... but it is used only once ... and is fast enough
929        ; relocate kernel (physical to physical) + debug in screenmemory
930        MOV  r5, r10                           ; load PC relative r5 = startreloc table
931        LDR  r6, [r5], #4                      ; r4 = number of relocated pages
932      .loop_relocate_pages%
933        LDR  r2, [r5], #4                      ; r2 = from address
934        LDR  r3, [r5], #4                      ; r3 = to address
935        LDR  r7, [r5], #4                      ; r6 = number of bytes to travel
936        MOV  r1, #0                            ; r1 = offset in page
937      .loop_one_page%
938        LDRB r0, [r2, r1]
939        STRB r0, [r3, r1]
940        ADD  r1, r1, #1
941        CMP  r1, r7                            ; all bytes copied ?
942        BNE loop_one_page%
943        SUBS r6, r6, #1
944        BNE loop_relocate_pages%
945
946        ; switch over to the new L1 pages
947
948        ; disable clockswitching for SA110  (WHY?)
949        MOV r0,  #0                            ; write 0
950        CMP r14, #0                            ; check v4 .. or SA110 specific ?
951        EQUD %00011110000011110000111101010010 ; MCRNE cp15, 0, r0, c15, c2, 2 ; from Linux loader
952
953        ; flush ID cache
954        MOV r0,  #0
955        CMP r14, #0
956        EQUD %00001110000001110000111100010000 ; MCREQ cp15, 0, r0, c7, c0, 0 ; flush v3 ID cache
957        EQUD %00011110000001110000111100010111 ; MCRNE cp15, 0, r0, c7, c7, 0 ; flush v4 ID cache
958
959        ; drain WB (v4)
960        MOV r0,  #0
961        CMP r14, #0
962        EQUD %00011110000001110000111110011010 ; MCRNE cp15, 0, r0, c7, c10, 4; drain WB v4 from Linux loader
963
964        ; flush TLB
965        EQUD %11101110000001010000111100010000 ; MCR cp15, 0, r0, c5, c0, 0 ; flush v3 TLB
966
967        ; set new TLB address
968        MOV r0, r11
969        EQUD %11101110000000100000111100010000 ; MCR cp15, 0, r0, c2, c0, 0 ; write TLB base
970
971        ; switch on MMU, IDcache and WB and keep on running (flat *translated*)
972        ; in r13 last written value
973        ORR r0, r13, #%0001111101
974        ;              RSB1DPWCAM
975        ORR r0, r0,  #%1000000000
976        CMP r14, #0
977        EQUD %11101110000000010000111100010000 ; MCR cp15, 0, r0, c1, c0, 0 ; write control register
978        MOV r0, r0                             ; flat
979        MOV r0, r0                             ; flat
980        ; not flat anymore ... but it doesnt matter
981    ]
982    IF extradebug% THEN
983      [OPT opt%
984        MOV r6, #videomem_start%
985        MOV r7, #videomem_pages% * nbpp%
986        MOV r5, #KERNEL_BASE
987        .loop_testing%
988          LDR r0, [r5], #4
989          STR r0, [r6], #4
990          SUBS r7, r7, #4
991        BNE loop_testing%
992       ]
993     ENDIF
994     [OPT opt%
995        ; call kernel in new virtual space ... start()
996
997        MOV  r0, r8
998        MOV  pc, r12
999    ]
1000  NEXT
1001ENDPROC
1002
1003
1004DEF FNblock_vaddr(pagenr%)
1005=!(memoryblock% + pagenr%*12 + 4)
1006
1007
1008DEF FNblock_paddr(pagenr%)
1009=!(memoryblock% + pagenr%*12 + 8)
1010
1011
1012DEF PROCget_memory_map
1013  PRINT '"Getting actual memory mapping ";
1014  FOR pg%=0 TO totalpages%-1
1015    pos% = memoryblock% + 12*pg%
1016    pos%!0  = 0
1017    pos%!4  = (firstpage% + pg%) * nbpp%
1018    pos%!8  = 0
1019    REM force paging in this page in RO4
1020    IF (pg% MOD 5)=0 THEN PROCtwirl
1021    !(pos%!4) = 0: REM PROCbzero(pos%!4, nbpp%)
1022  NEXT
1023  PRINT ;" "
1024
1025  os_memory_GIVEN_LOG_ADDR   = &200
1026  os_memory_RETURN_PAGE_NO   = &800
1027  os_memory_RETURN_PHYS_ADDR = &2000
1028  SYS "OS_Memory", os_memory_GIVEN_LOG_ADDR+os_memory_RETURN_PAGE_NO+os_memory_RETURN_PHYS_ADDR, memoryblock%, totalpages%
1029
1030  PROCsort_memory_map(memoryblock%, totalpages%)
1031
1032  REM Get first DRAM index
1033  PRINT '"Found memory blocks ";
1034  first_mapped_DRAM_index%=-1
1035  pg% = 0
1036  WHILE pg%<totalpages%
1037    addr% = !(memoryblock% + pg%*12 + 8)
1038    PRINT "[";"0x";~addr%;
1039    num_seq_pag%=0
1040    WHILE (!(memoryblock% + pg%*12 + 12 + 8) - addr%)=nbpp%
1041      IF first_mapped_DRAM_index%<0 AND (addr%>=DRAM_addr%(0)) THEN first_mapped_DRAM_index% = pg%
1042      num_seq_pag%+=1
1043      pg%+=1
1044      addr% = !(memoryblock% + pg%*12 + 8)
1045    ENDWHILE
1046    PRINT;"-0x";~(!(memoryblock% + pg%*12 + 8) + nbpp%-1);"]";
1047    PRINT ;"  ";
1048    pg%+=1
1049  ENDWHILE
1050  PRINT'
1051  IF extradebug% THEN PRINT '"First DRAM index found at index ";first_mapped_DRAM_index%;" DRAM_addr%(0)=0x";~DRAM_addr%(0)
1052  IF first_mapped_DRAM_index%<0 THEN ERROR EXT 1, "No (S)DRAM mapped in this program (wierd) ... increase Wimpslot!"
1053ENDPROC
1054
1055
1056DEF PROCget_memory_configuration
1057  REM Get memory distribution
1058  PRINT "Getting memory configuration ";
1059  DIM DRAM_addr%(MAX_DRAMBANKS), DRAM_pages%(MAX_DRAMBANKS)
1060  DIM VRAM_addr%(MAX_VRAMBANKS), VRAM_pages%(MAX_VRAMBANKS)
1061  DIM memorytable% memorytablesize%
1062  SYS "OS_Memory", 7, memorytable% : REM read table
1063  dramblocks% = 0: vramblocks% = 0: currentpages% = 0: currentadr% = 0
1064  currentpage% = -1: loop%=0
1065  WHILE loop% < memorytablesize%*2
1066    page% = memorytable%!(loop% DIV 2)
1067    IF loop% MOD 2 THEN page% = page% >> 4
1068    page% = page% AND &07
1069    IF page% <> currentpage% THEN
1070      IF currentpage% = 1 THEN
1071        DRAM_addr%(dramblocks%) = currentaddr% * nbpp%
1072        DRAM_pages%(dramblocks%) = currentpages%
1073        dramblocks% +=1
1074      ENDIF
1075      IF currentpage%=2 THEN
1076        VRAM_addr%(vramblocks%) = currentaddr% * nbpp%
1077        VRAM_pages%(vramblocks%) = currentpages%
1078        vramblocks% +=1
1079       ENDIF
1080      currentpage% = page%
1081      currentaddr% = loop%
1082      currentpages% = 0
1083    ENDIF
1084    currentpages% += 64
1085    loop% += 64
1086    PROCtwirl
1087  ENDWHILE
1088
1089  IF emulateDRAMsize% > 0 THEN
1090    REM emulate HACK
1091    DRAM0% = DRAM_addr%(0)
1092    DRAM_addr%() = 0
1093    DRAM_pages%() = 0
1094    DRAM_addr%(0) = DRAM0%
1095    DRAM_pages%(0) = (emulateDRAMsize%*1024*1024)/nbpp%
1096    dramblocks% = 1
1097    REM END HACK
1098  ENDIF
1099
1100  REM find top of DRAM pages
1101  I%=8: WHILE (I%>=0) AND DRAM_addr%(I%)=0: I%-=1: ENDWHILE
1102
1103  IF I%>=0 THEN top_drambank% = I% ELSE ERROR EXT 0, "Reality check: No DRAM banks??"
1104  top_physdram% = DRAM_addr%(top_drambank%) + DRAM_pages%(top_drambank%)*nbpp%
1105
1106  PRINT " "
1107  PRINT'
1108
1109  REM Emulate VRAM by reporting different memory sizes
1110  REM XXX assumption : no VRAM => screen is located in bottom DRAM; leave it there
1111  IF (VRAM_pages%(0)=0) OR emulateVRAM% THEN
1112    mapped_screenmemory% = 1024*1024 : REM Max allowed on RiscPC
1113    videomem_start% = DRAM_addr%(0)
1114    videomem_pages% = mapped_screenmemory% DIV nbpp%
1115    display_size%   = FNvdu_var(150) AND NOT(nbpp%-1)
1116    DRAM_addr%(0)  += videomem_pages% * nbpp%
1117    DRAM_pages%(0) -= videomem_pages%
1118  ELSE
1119    mapped_screenmemory% = 0
1120    videomem_start% = VRAM_addr%(0)
1121    videomem_pages% = VRAM_pages%(0)
1122    display_size%   = videomem_pages% * nbpp%
1123  ENDIF
1124
1125  IF mapped_screenmemory%>0 THEN PRINT "Used 1st Mb of DRAM at 0x";RIGHT$("00000000"+STR$~videomem_start%,8);" for video memory"
1126
1127  totaldrampages% = 0
1128  FOR I%=0 TO dramblocks%-1
1129    totaldrampages% += DRAM_pages%(I%)
1130    PRINT "Found ";
1131    IF (DRAM_addr%(I%) >= SDRAM_ADDR_START%) PRINT ;"SDRAM"; ELSE PRINT ;" DRAM";
1132    PRINT " (";I%;") at 0x";RIGHT$("00000000"+STR$~DRAM_addr%(I%),8);" for ";,DRAM_pages%(I%)*nbpp%/1024;" k"
1133  NEXT
1134
1135  totalvrampages% = 0
1136  FOR I%=0 TO vramblocks%-1
1137    totalvrampages% += VRAM_pages%(I%)
1138    PRINT "Found  VRAM (";I%;") at 0x";RIGHT$("00000000"+STR$~VRAM_addr%(I%),8);" for ";,VRAM_pages%(I%)*nbpp%/1024;" k"
1139  NEXT
1140
1141  kernel_phys_start% = DRAM_addr%(0)
1142
1143  REM Expirimental Kinetic support
1144  IF INSTR(args$, "kinetic")>0 THEN
1145    REM The Kinetic card has SDRAM on the processor module ... first fix is to only use this memory
1146    REM for VRAM emulation and only pass it trough as buffer memory for the DRAM is the only one
1147    REM wich DMA capabilities.
1148
1149    PRINT ''"Kinetic support asked ... ";
1150
1151    REM find SDRAM start... DRAM is under 512 Mb, SDRAM is above it
1152    first_SDRAM% = -1
1153    FOR I%=0 TO MAX_RAMBANKS
1154      IF (DRAM_addr%(I%) >= SDRAM_ADDR_START%) AND (first_SDRAM%<0) THEN first_SDRAM% = I%
1155    NEXT
1156    IF first_SDRAM% >= 0 THEN
1157      PRINT ;"granted"
1158      REM put kernel pointer to the first SDRAM module and update DRAM reporting (yeah ...more clear than fast)
1159      FOR I%=0 TO first_SDRAM%-1
1160        PRINT "Moving DRAM at 0x";RIGHT$("00000000"+STR$~DRAM_addr%(I%),8);" for ";,DRAM_pages%(I%)*nbpp%/1024;" k"
1161        REM save this block
1162        DRAM_addr% = DRAM_addr%(I%): DRAM_pages% = DRAM_pages%(I%)
1163        REM move everything down
1164        FOR J%=I% TO MAX_RAMBANKS-1
1165          DRAM_addr%(J%) = DRAM_addr%(J%+1): DRAM_pages%(J%) = DRAM_pages%(J%+1)
1166        NEXT
1167        DRAM_addr%(MAX_RAMBANKS) = 0: DRAM_pages%(MAX_RAMBANKS) = 0
1168        REM fill in the moved block at the top of the structure
1169        DRAM_addr%(dramblocks%-1) = DRAM_addr%: DRAM_pages%(dramblocks%-1) = DRAM_pages%
1170      NEXT
1171      REM XXX kernel is loaded per definition in dram[0]
1172      first_SDRAM% = 0
1173      kernel_phys_start% = DRAM_addr%(first_SDRAM%)
1174    ELSE
1175      PRINT ;"ignored; no SDRAM found"
1176    ENDIF
1177    PRINT
1178  ENDIF
1179ENDPROC
1180
1181
1182DEF PROCsort_memory_map(memoryblock%, totalpages%)
1183  LOCAL out%, in%, outp%, inp%
1184
1185  DIM code% 1024
1186  FOR opt%=0 TO 2 STEP 2
1187    P%=code%
1188    [OPT opt%
1189     .sortit%
1190          STMFD r13!, {r0-r12}
1191          ; R0  = A% = memory block%
1192          ; R1  = B% = totalpages%
1193          ; r2  = out%
1194          ; r3  = inp%
1195          ; R12 = limit r3
1196          SUB r2, r1, #2
1197     .loop_outer%
1198          MOV r3, r0
1199          MOV r4, #12
1200          MLA r12, r2, r4, r0
1201     .loop_inner%
1202          LDR r4, [r3, #8]
1203          LDR r5, [r3, #20]
1204          CMP r4, r5
1205          BLT not_bigger%
1206            LDMIA r3, {r6, r7, r8}
1207            ADD r4, r3, #12
1208            LDMIA r4, {r9, r10, r11}
1209            STMIA r3, {r9, r10, r11}
1210            STMIA r4, {r6, r7, r8}
1211     .not_bigger%
1212          ADD r3, r3, #12
1213          CMP r3, r12
1214          BLE loop_inner%
1215          SUBS r2, r2, #1
1216          BPL loop_outer%
1217          LDMFD r13!, {r0-r12}
1218          MOV pc, r14
1219  ]
1220  NEXT
1221
1222  A% = memoryblock%
1223  B% = totalpages%
1224  CALL sortit%
1225
1226ENDPROC
1227
1228
1229DEF PROCcenter(line$)
1230  PRINT STRING$((width%-LEN(line$))/2, " ");line$
1231ENDPROC
1232
1233
1234DEF PROCbzero(addr%, len%)
1235  LOCAL a%
1236  FOR a% = 0 TO len%-4 STEP 4
1237    addr%!a% = 0
1238  NEXT
1239ENDPROC
1240
1241
1242DEF PROCcopy(dest%, src%, len%)
1243  LOCAL a%
1244  FOR a% = 0 TO len%-4 STEP 4
1245    dest%!a% = src%!a%
1246  NEXT
1247ENDPROC
1248
1249
1250DEF PROCtwirl
1251  PRINT MID$("|/-\", twirl%+1, 1)+CHR$(8);
1252  twirl% += 1
1253  twirl% = twirl% MOD 4
1254ENDPROC
1255
1256
1257DEF FNvdu_var(var%)
1258  LOCAL b%
1259  DIM b% 7
1260  b%!0 = var%
1261  b%!4 = -1
1262  SYS "OS_ReadVduVariables", b%, b%
1263= b%!0
1264
1265
1266DEF FNroundup(val%, size%)
1267=val% + (size% - 1) AND NOT (size% - 1)
1268
1269
1270DEF FNtolower(name$)
1271  LOCAL A$, Ch$, i%
1272  FOR i%=1 TO LEN(name$)
1273    Ch$ = LEFT$(name$,1)
1274    IF Ch$>="A" AND Ch$<="Z" THEN
1275      A$ += CHR$(ASC(Ch$)+ASC("a")-ASC("A"))
1276    ELSE
1277      A$ += Ch$
1278    ENDIF
1279    name$ = MID$(name$, 2)
1280  NEXT
1281= A$
1282