\ @(#) savedicd.fth 98/01/26 1.2\ Save dictionary as data table.\\ Author: Phil Burk\ Copyright 1987 Phil Burk\ All Rights Reserved.\\ 970311 PLB Fixed problem with calling SDAD when in HEX mode.\ 20010606 PLB Fixed AUTO.INIT , started with ';' !! decimalANEW TASK-SAVE_DIC_AS_DATA \ !!! set to 4 for minimally sized dictionary to prevent DIAB\ compiler from crashing!  Allocate more space in pForth.4 constant SDAD_NAMES_EXTRA   \ space for additional names4 constant SDAD_CODE_EXTRA    \ space for additional names \ buffer the file I/O for better performance256 constant SDAD_BUFFER_SIZEcreate SDAD-BUFFER SDAD_BUFFER_SIZE allotvariable SDAD-BUFFER-INDEXvariable SDAD-BUFFER-FID        0 SDAD-BUFFER-FID ! : SDAD.FLUSH  ( -- ior )    sdad-buffer sdad-buffer-index @  \ data\ 2dup type    sdad-buffer-fid @  write-file    0 sdad-buffer-index !; : SDAD.EMIT  ( char -- )    sdad-buffer-index @  sdad_buffer_size >=    IF        sdad.flush abort" SDAD.FLUSH failed!"    THEN\    sdad-buffer sdad-buffer-index @ + c!    1 sdad-buffer-index +!; : SDAD.TYPE  ( c-addr cnt -- )    0 DO        dup c@ sdad.emit    \ char to buffer        1+   \ advance char pointer    LOOP    drop; : $SDAD.LINE  ( $addr -- )    count sdad.type    EOL sdad.emit; : (U8.)  ( u -- a l , unsigned conversion, at least 8 digits )    0 <#  # # # #  # # # #S #>;: (U2.)  ( u -- a l , unsigned conversion, at least 2 digits )    0 <#  # #S #>; : SDAD.CLOSE ( -- )    SDAD-BUFFER-FID @ ?dup    IF        sdad.flush abort" SDAD.FLUSH failed!"        close-file drop        0 SDAD-BUFFER-FID !    THEN; : SDAD.OPEN  ( -- ior, open file )    sdad.close    s" pfdicdat.h" r/w create-file dup >r    IF        drop ." Could not create file pfdicdat.h" cr    ELSE        SDAD-BUFFER-FID !    THEN    r>; : SDAD.DUMP.HEX  { val -- }    base @ >r hex    s" 0x" sdad.type    val (u8.) sdad.type    r> base !;: SDAD.DUMP.HEX,    s"    " sdad.type    sdad.dump.hex    ascii , sdad.emit; : SDAD.DUMP.HEX.BYTE  { val -- }    base @ >r hex    s" 0x" sdad.type    val (u2.) sdad.type    r> base !;: SDAD.DUMP.HEX.BYTE,    sdad.dump.hex.byte    ascii , sdad.emit; : SDAD.DUMP.DATA { start-address end-address num-zeros | num-bytes -- }    end-address start-address - -> num-bytes    num-bytes 0    ?DO        i $ 7FF and 0= IF ." 0x" i .hex cr THEN   \ progress report        i 15 and 0=        IF              EOL sdad.emit             s" /* " sdad.type             i sdad.dump.hex             s" : */ " sdad.type        THEN   \ 16 bytes per line, print offset        start-address   i + c@        sdad.dump.hex.byte,    LOOP\    num-zeros 0    ?DO        i $ 7FF and 0= IF i . cr THEN   \ progress report        i 15 and 0= IF EOL sdad.emit THEN   \ 15 numbers per line        0 sdad.dump.hex.byte,    LOOP; : SDAD.DEFINE  { $name val -- }    s" #define " sdad.type    $name  count sdad.type    s"   (" sdad.type    val sdad.dump.hex    c" )" $sdad.line; : IS.LITTLE.ENDIAN?  ( -- flag , is Forth in Little Endian mode? )    1 pad !    pad c@; : SDAD   { | fid -- }    sdad.open abort" sdad.open failed!"\ Write headers.    c" /* This file generated by the Forth command SDAD */" $sdad.line     c" HEADERPTR" headers-ptr @ namebase - sdad.define    c" RELCONTEXT" context @ namebase - sdad.define    c" CODEPTR" here codebase - sdad.define    c" IF_LITTLE_ENDIAN" IS.LITTLE.ENDIAN? IF 1 ELSE 0 THEN sdad.define ." Saving Names" cr    s" static const uint8_t MinDicNames[] = {" sdad.type    namebase headers-ptr @ SDAD_NAMES_EXTRA sdad.dump.data    EOL sdad.emit    c" };" $sdad.line ." Saving Code" cr    s" static const uint8_t MinDicCode[] = {" sdad.type    codebase here SDAD_CODE_EXTRA sdad.dump.data    EOL sdad.emit    c" };" $sdad.line     sdad.close; if.forgotten sdad.close : AUTO.INIT ( -- , init at launch )    auto.init \ daisy chain initialization    0 SDAD-BUFFER-FID !    0 SDAD-BUFFER-INDEX !; ." Enter: SDAD" cr