\ @(#) 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 ';' !!

decimal
ANEW 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 names
4 constant SDAD_CODE_EXTRA    \ space for additional names

\ buffer the file I/O for better performance
256 constant SDAD_BUFFER_SIZE
create SDAD-BUFFER SDAD_BUFFER_SIZE allot
variable SDAD-BUFFER-INDEX
variable 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
