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