| 1 | purpose: Save the Forth dictionary image in a file in ARM image format |
|---|
| 2 | \ See license at end of file |
|---|
| 3 | |
|---|
| 4 | \ save-forth ( filename -- ) |
|---|
| 5 | \ Saves the Forth dictionary to a file so it may be later used under Unix |
|---|
| 6 | \ |
|---|
| 7 | \ save-image ( header-adr header-len init-routine-name filename -- ) |
|---|
| 8 | \ Primitive save routine. Saves the dictionary image to a file. |
|---|
| 9 | \ The header is placed at the start of the file. The latest definition |
|---|
| 10 | \ whose name is the same as the "init-routine-name" argument is |
|---|
| 11 | \ installed as the init-io routine. |
|---|
| 12 | |
|---|
| 13 | hex |
|---|
| 14 | |
|---|
| 15 | variable dictionary-size |
|---|
| 16 | |
|---|
| 17 | only forth also hidden also |
|---|
| 18 | hidden definitions |
|---|
| 19 | |
|---|
| 20 | headerless |
|---|
| 21 | |
|---|
| 22 | : dict-size ( -- size-of-dictionary ) here origin - aligned ; |
|---|
| 23 | : rel-size ( -- reloc-size ) dict-size d# 31 + d# 32 / ; |
|---|
| 24 | |
|---|
| 25 | headers |
|---|
| 26 | |
|---|
| 27 | only forth also hidden also |
|---|
| 28 | forth definitions |
|---|
| 29 | |
|---|
| 30 | h# 80 buffer: aif-header |
|---|
| 31 | \ 00 NOP (BL decompress code) |
|---|
| 32 | \ 04 NOP (BL self reloc code) |
|---|
| 33 | \ 08 NOP (BL ZeroInit code) |
|---|
| 34 | \ 0c BL entry (or offset to entry point for non-executable AIF header) |
|---|
| 35 | \ 10 NOP (program exit instruction) |
|---|
| 36 | \ 14 0 (Read-only section size) |
|---|
| 37 | \ 18 Dictionary size, actual value will be set later |
|---|
| 38 | \ 1c Reloc Size (ARM Debug size) |
|---|
| 39 | \ 20 0 (ARM zero-init size) |
|---|
| 40 | \ 24 0 (image debug type) |
|---|
| 41 | \ 28 Reloc save base (image base) |
|---|
| 42 | \ 2c Dictionary growth size (min workspace size) |
|---|
| 43 | \ 30 d#32 (address mode) |
|---|
| 44 | \ 34 0 (data base address) |
|---|
| 45 | \ 38 reserved |
|---|
| 46 | \ 3c reserved |
|---|
| 47 | \ 40 NOP (debug init instruction) |
|---|
| 48 | \ 44-7c unused (zero-init code) |
|---|
| 49 | |
|---|
| 50 | decimal |
|---|
| 51 | |
|---|
| 52 | : aif! ( n offset -- ) aif-header + ! ; |
|---|
| 53 | : nop! ( offset -- ) h# e1a00000 swap aif! ; |
|---|
| 54 | |
|---|
| 55 | headerless |
|---|
| 56 | : $save-image ( header header-len filename$ -- ) |
|---|
| 57 | $new-file ( header header-len ) |
|---|
| 58 | |
|---|
| 59 | relocation-off |
|---|
| 60 | \ There is no need to copy the user area to the initial user area |
|---|
| 61 | \ image because the user area is currently accessed in-place. |
|---|
| 62 | |
|---|
| 63 | ( header header-len ) ofd @ fputs \ Write header |
|---|
| 64 | origin dict-size ofd @ fputs \ Write dictionary |
|---|
| 65 | relocation-map rel-size ofd @ fputs \ Write the relocation table |
|---|
| 66 | ofd @ fclose |
|---|
| 67 | relocation-on |
|---|
| 68 | ; |
|---|
| 69 | : make-arm-header ( -- ) |
|---|
| 70 | \ Build the header |
|---|
| 71 | aif-header h# 80 erase |
|---|
| 72 | h# 00 nop! |
|---|
| 73 | h# 04 nop! |
|---|
| 74 | h# 08 nop! |
|---|
| 75 | h# eb00001b h# 0c aif! \ branch to just after the header |
|---|
| 76 | h# ef000011 h# 10 aif! \ SWI_Exit |
|---|
| 77 | h# 80 h# 14 aif! \ Read-only image size = header size |
|---|
| 78 | dict-size rel-size + h# 18 aif! \ Read-write size |
|---|
| 79 | 0 h# 1c aif! |
|---|
| 80 | 0 h# 20 aif! |
|---|
| 81 | 0 h# 24 aif! |
|---|
| 82 | h# 8000 h# 28 aif! \ Load base |
|---|
| 83 | dictionary-size @ h# 8.0000 max h# 2c aif! \ Dictionary growth size |
|---|
| 84 | h# 20 h# 30 aif! \ 32-bit address mode |
|---|
| 85 | 0 h# 34 aif! |
|---|
| 86 | \ dict-size h# 38 aif! \ Dictionary size (Using a reserved field!) |
|---|
| 87 | \ origin h# 3c aif! \ Save base (Using a reserved field!) |
|---|
| 88 | h# 40 nop! |
|---|
| 89 | dict-size h# 10 origin+ ! \ Dictionary size |
|---|
| 90 | origin h# 14 origin+ ! \ Save base |
|---|
| 91 | ; |
|---|
| 92 | headers |
|---|
| 93 | |
|---|
| 94 | \ Save an image of the target system in a file. |
|---|
| 95 | : $save-forth ( str -- ) |
|---|
| 96 | 2>r |
|---|
| 97 | make-arm-header |
|---|
| 98 | " sys-init-io" $find-name is init-io |
|---|
| 99 | " sys-init" init-save |
|---|
| 100 | |
|---|
| 101 | aif-header h# 80 2r> $save-image |
|---|
| 102 | ; |
|---|
| 103 | |
|---|
| 104 | only forth also definitions |
|---|
| 105 | |
|---|
| 106 | \ LICENSE_BEGIN |
|---|
| 107 | \ Copyright (c) 1997 FirmWorks |
|---|
| 108 | \ |
|---|
| 109 | \ Permission is hereby granted, free of charge, to any person obtaining |
|---|
| 110 | \ a copy of this software and associated documentation files (the |
|---|
| 111 | \ "Software"), to deal in the Software without restriction, including |
|---|
| 112 | \ without limitation the rights to use, copy, modify, merge, publish, |
|---|
| 113 | \ distribute, sublicense, and/or sell copies of the Software, and to |
|---|
| 114 | \ permit persons to whom the Software is furnished to do so, subject to |
|---|
| 115 | \ the following conditions: |
|---|
| 116 | \ |
|---|
| 117 | \ The above copyright notice and this permission notice shall be |
|---|
| 118 | \ included in all copies or substantial portions of the Software. |
|---|
| 119 | \ |
|---|
| 120 | \ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, |
|---|
| 121 | \ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF |
|---|
| 122 | \ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND |
|---|
| 123 | \ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE |
|---|
| 124 | \ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION |
|---|
| 125 | \ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION |
|---|
| 126 | \ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. |
|---|
| 127 | \ |
|---|
| 128 | \ LICENSE_END |
|---|
