/fth/savedicd.fth

https://github.com/philburk/pforth · Forth · 177 lines · 153 code · 24 blank · 0 comment · 4 complexity · c078fba4829119d26c53dbd3fe299a20 MD5 · raw file

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