| 1 | \ @(#) savedicd.fth 98/01/26 1.2 |
| 2 | \ Save dictionary as data table. |
| 3 | \ |
| 4 | \ Author: Phil Burk |
| 5 | \ Copyright 1987 Phil Burk |
| 6 | \ All Rights Reserved. |
| 7 | \ |
| 8 | \ 970311 PLB Fixed problem with calling SDAD when in HEX mode. |
| 9 | \ 20010606 PLB Fixed AUTO.INIT , started with ';' !! |
| 10 | |
| 11 | decimal |
| 12 | ANEW TASK-SAVE_DIC_AS_DATA |
| 13 | |
| 14 | \ !!! set to 4 for minimally sized dictionary to prevent DIAB |
| 15 | \ compiler from crashing! Allocate more space in pForth. |
| 16 | 4 constant SDAD_NAMES_EXTRA \ space for additional names |
| 17 | 4 constant SDAD_CODE_EXTRA \ space for additional names |
| 18 | |
| 19 | \ buffer the file I/O for better performance |
| 20 | 256 constant SDAD_BUFFER_SIZE |
| 21 | create SDAD-BUFFER SDAD_BUFFER_SIZE allot |
| 22 | variable SDAD-BUFFER-INDEX |
| 23 | variable SDAD-BUFFER-FID |
| 24 | 0 SDAD-BUFFER-FID ! |
| 25 | |
| 26 | : SDAD.FLUSH ( -- ior ) |
| 27 | sdad-buffer sdad-buffer-index @ \ data |
| 28 | \ 2dup type |
| 29 | sdad-buffer-fid @ write-file |
| 30 | 0 sdad-buffer-index ! |
| 31 | ; |
| 32 | |
| 33 | : SDAD.EMIT ( char -- ) |
| 34 | sdad-buffer-index @ sdad_buffer_size >= |
| 35 | IF |
| 36 | sdad.flush abort" SDAD.FLUSH failed!" |
| 37 | THEN |
| 38 | \ |
| 39 | sdad-buffer sdad-buffer-index @ + c! |
| 40 | 1 sdad-buffer-index +! |
| 41 | ; |
| 42 | |
| 43 | : SDAD.TYPE ( c-addr cnt -- ) |
| 44 | 0 DO |
| 45 | dup c@ sdad.emit \ char to buffer |
| 46 | 1+ \ advance char pointer |
| 47 | LOOP |
| 48 | drop |
| 49 | ; |
| 50 | |
| 51 | : $SDAD.LINE ( $addr -- ) |
| 52 | count sdad.type |
| 53 | EOL sdad.emit |
| 54 | ; |
| 55 | |
| 56 | : (U8.) ( u -- a l , unsigned conversion, at least 8 digits ) |
| 57 | 0 <# # # # # # # # #S #> |
| 58 | ; |
| 59 | : (U2.) ( u -- a l , unsigned conversion, at least 2 digits ) |
| 60 | 0 <# # #S #> |
| 61 | ; |
| 62 | |
| 63 | : SDAD.CLOSE ( -- ) |
| 64 | SDAD-BUFFER-FID @ ?dup |
| 65 | IF |
| 66 | sdad.flush abort" SDAD.FLUSH failed!" |
| 67 | close-file drop |
| 68 | 0 SDAD-BUFFER-FID ! |
| 69 | THEN |
| 70 | ; |
| 71 | |
| 72 | : SDAD.OPEN ( -- ior, open file ) |
| 73 | sdad.close |
| 74 | s" pfdicdat.h" r/w create-file dup >r |
| 75 | IF |
| 76 | drop ." Could not create file pfdicdat.h" cr |
| 77 | ELSE |
| 78 | SDAD-BUFFER-FID ! |
| 79 | THEN |
| 80 | r> |
| 81 | ; |
| 82 | |
| 83 | : SDAD.DUMP.HEX { val -- } |
| 84 | base @ >r hex |
| 85 | s" 0x" sdad.type |
| 86 | val (u8.) sdad.type |
| 87 | r> base ! |
| 88 | ; |
| 89 | : SDAD.DUMP.HEX, |
| 90 | s" " sdad.type |
| 91 | sdad.dump.hex |
| 92 | ascii , sdad.emit |
| 93 | ; |
| 94 | |
| 95 | : SDAD.DUMP.HEX.BYTE { val -- } |
| 96 | base @ >r hex |
| 97 | s" 0x" sdad.type |
| 98 | val (u2.) sdad.type |
| 99 | r> base ! |
| 100 | ; |
| 101 | : SDAD.DUMP.HEX.BYTE, |
| 102 | sdad.dump.hex.byte |
| 103 | ascii , sdad.emit |
| 104 | ; |
| 105 | |
| 106 | : SDAD.DUMP.DATA { start-address end-address num-zeros | num-bytes -- } |
| 107 | end-address start-address - -> num-bytes |
| 108 | num-bytes 0 |
| 109 | ?DO |
| 110 | i $ 7FF and 0= IF ." 0x" i .hex cr THEN \ progress report |
| 111 | i 15 and 0= |
| 112 | IF |
| 113 | |
| 114 | EOL sdad.emit |
| 115 | s" /* " sdad.type |
| 116 | i sdad.dump.hex |
| 117 | s" : */ " sdad.type |
| 118 | THEN \ 16 bytes per line, print offset |
| 119 | start-address i + c@ |
| 120 | sdad.dump.hex.byte, |
| 121 | LOOP |
| 122 | \ |
| 123 | num-zeros 0 |
| 124 | ?DO |
| 125 | i $ 7FF and 0= IF i . cr THEN \ progress report |
| 126 | i 15 and 0= IF EOL sdad.emit THEN \ 15 numbers per line |
| 127 | 0 sdad.dump.hex.byte, |
| 128 | LOOP |
| 129 | ; |
| 130 | |
| 131 | : SDAD.DEFINE { $name val -- } |
| 132 | s" #define " sdad.type |
| 133 | $name count sdad.type |
| 134 | s" (" sdad.type |
| 135 | val sdad.dump.hex |
| 136 | c" )" $sdad.line |
| 137 | ; |
| 138 | |
| 139 | : IS.LITTLE.ENDIAN? ( -- flag , is Forth in Little Endian mode? ) |
| 140 | 1 pad ! |
| 141 | pad c@ |
| 142 | ; |
| 143 | |
| 144 | : SDAD { | fid -- } |
| 145 | sdad.open abort" sdad.open failed!" |
| 146 | \ Write headers. |
| 147 | c" /* This file generated by the Forth command SDAD */" $sdad.line |
| 148 | |
| 149 | c" HEADERPTR" headers-ptr @ namebase - sdad.define |
| 150 | c" RELCONTEXT" context @ namebase - sdad.define |
| 151 | c" CODEPTR" here codebase - sdad.define |
| 152 | c" IF_LITTLE_ENDIAN" IS.LITTLE.ENDIAN? IF 1 ELSE 0 THEN sdad.define |
| 153 | |
| 154 | ." Saving Names" cr |
| 155 | s" static const uint8_t MinDicNames[] = {" sdad.type |
| 156 | namebase headers-ptr @ SDAD_NAMES_EXTRA sdad.dump.data |
| 157 | EOL sdad.emit |
| 158 | c" };" $sdad.line |
| 159 | |
| 160 | ." Saving Code" cr |
| 161 | s" static const uint8_t MinDicCode[] = {" sdad.type |
| 162 | codebase here SDAD_CODE_EXTRA sdad.dump.data |
| 163 | EOL sdad.emit |
| 164 | c" };" $sdad.line |
| 165 | |
| 166 | sdad.close |
| 167 | ; |
| 168 | |
| 169 | if.forgotten sdad.close |
| 170 | |
| 171 | : AUTO.INIT ( -- , init at launch ) |
| 172 | auto.init \ daisy chain initialization |
| 173 | 0 SDAD-BUFFER-FID ! |
| 174 | 0 SDAD-BUFFER-INDEX ! |
| 175 | ; |
| 176 | |
| 177 | ." Enter: SDAD" cr |