Return to ds2texi.fs CVS log

Up to [gforth] / gforth

added code.fs (code, ;code, end-code, assembler)
renamed dostruc to dofield
made index and doc-entries nicer
Only words containing 'e' or 'E' are converted to FP numbers.
added many wordset comments
added flush-icache primitive and FLUSH_ICACHE macro
added +DO, U+DO, -DO, U-DO and -LOOP
added code address labels (`docol:' etc.)
fixed sparc cache_flush

    1: \ documentation source to texi format converter
    2: 
    3: \ documentation source can contain lines in the form `doc-word' and
    4: \ `short-word'. These are converted to appropriate full or short
    5: \ (without the description) glossary entries for word.
    6: 
    7: \ The glossary entries are generated from data present in the wordlist
    8: \ `documentation'. Each word resides there under its own name.
    9: 
   10: script? [IF]
   11: warnings off
   12: require search-order.fs
   13: require float.fs
   14: require struct.fs
   15: require debugging.fs
   16: [THEN]
   17: 
   18: wordlist constant documentation
   19: 
   20: struct
   21:     2 cells: field doc-name
   22:     2 cells: field doc-stack-effect
   23:     2 cells: field doc-wordset
   24:     2 cells: field doc-pronounciation
   25:     2 cells: field doc-description
   26: end-struct doc-entry
   27: 
   28: create description-buffer 4096 chars allot
   29: 
   30: : get-description ( -- addr u )
   31:     description-buffer
   32:     begin
   33: 	refill
   34:     while
   35: 	source nip
   36:     while
   37: 	source swap >r 2dup r> -rot cmove
   38: 	chars +
   39: 	#lf over c! char+
   40:     repeat then
   41:     description-buffer tuck - ;
   42: 
   43: : make-doc ( -- )
   44:     get-current documentation set-current
   45:     create
   46: 	last @ name>string 2,		\ name
   47: 	[char] ) parse save-string 2,	\ stack-effect
   48: 	bl parse-word save-string 2,	\ wordset
   49: 	bl parse-word dup		\ pronounciation
   50: 	if
   51: 	    save-string
   52: 	else
   53: 	    2drop last @ name>string
   54: 	endif
   55: 	2,
   56: 	get-description save-string 2,
   57:     set-current ;
   58: 
   59: : emittexi ( c -- )
   60:     >r
   61:     s" @{}" r@ scan 0<>
   62:     if
   63: 	[char] @ emit
   64:     endif
   65:     drop r> emit ;
   66: 
   67: : typetexi ( addr u -- )
   68:     0
   69:     ?do
   70: 	dup c@ emittexi
   71: 	char+
   72:     loop
   73:     drop ;
   74: 
   75: : print-short ( doc-entry -- )
   76:     >r
   77:     ." @findex "
   78:     r@ doc-name 2@ typetexi
   79:     ."  @var{ " r@ doc-stack-effect 2@ type ."  }  "
   80:     r@ doc-wordset 2@ type
   81:     cr
   82:     ." @format" cr
   83:     ." @code{" r@ doc-name 2@ typetexi ." }       "
   84:     ." @i{" r@ doc-stack-effect 2@ type ." }       "
   85:     r@ doc-wordset 2@ type ."        ``"
   86:     r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
   87:     rdrop ;
   88: 
   89: : print-doc ( doc-entry -- )
   90:     >r
   91:     r@ print-short
   92:     r@ doc-description 2@ dup 0<>
   93:     if
   94: 	." @iftex" cr ." @vskip-3ex" cr ." @end iftex" cr
   95: 	type cr cr \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr
   96:     else
   97: 	2drop cr
   98:     endif
   99:     rdrop ;
  100: 
  101: : do-doc ( addr1 u1 addr2 u2 xt -- f )
  102:     \ xt is the word to be executed if addr1 u1 is a string starting
  103:     \ with the prefix addr2 u2 and continuing with a word in the
  104:     \ wordlist `documentation'. f is true if xt is executed.
  105:     >r dup >r
  106:     3 pick over compare 0=
  107:     if \ addr2 u2 is a prefix of addr1 u1
  108: 	r> /string documentation search-wordlist
  109: 	if \ the rest of addr1 u1 is in documentation
  110: 	    execute r> execute true
  111: 	else
  112: 	    rdrop false
  113: 	endif
  114:     else
  115: 	2drop 2rdrop false
  116:     endif ;
  117: 
  118: : process-line ( addr u -- )
  119:     2dup s" doc-" ['] print-doc do-doc 0=
  120:     if
  121: 	2dup s" short-" ['] print-short do-doc 0=
  122: 	if
  123: 	    type cr EXIT
  124: 	endif
  125:     endif
  126:     2drop ;
  127: 
  128: 1024 constant doclinelength
  129: 
  130: create docline doclinelength chars allot
  131: 
  132: : ds2texi ( file-id -- )
  133:     >r
  134:     begin
  135: 	docline doclinelength r@ read-line throw
  136:     while
  137: 	dup doclinelength = abort" docline too long"
  138: 	docline swap process-line
  139:     repeat
  140:     drop rdrop ;
  141: 
  142: script? [IF]
  143: require prims2x.fs
  144: s" primitives.b" ' register-doc process-file
  145: require doc.fd
  146: require crossdoc.fd
  147: s" gforth.ds" r/o open-file throw ds2texi bye
  148: [THEN]