File:  [gforth] / gforth / ds2texi.fs
Revision 1.21: download - view: text, annotated - select for diffs
Sun Dec 13 23:29:58 1998 UTC (25 years, 3 months ago) by pazsan
Branches: MAIN
CVS tags: v0-4-0, HEAD
Added some documentation (files stup, blocks stub, Mini-OOF implementation)
Added Benchres for my machine
made DOS and Win32 compile and run
New gforthmi.bat script for DOS - needs a temporary file for the commands
instead of the -e option.
Added select.o again for DOS (DJGPP's select is broken wrt timing)
Improved select.c
Bug with DOS: engine-ditc doesn't compile with optimization on. Maybe I need
to get a new GCC version for DOS?

    1: \ documentation source to texi format converter
    2: 
    3: \ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
    4: 
    5: \ This file is part of Gforth.
    6: 
    7: \ Gforth is free software; you can redistribute it and/or
    8: \ modify it under the terms of the GNU General Public License
    9: \ as published by the Free Software Foundation; either version 2
   10: \ of the License, or (at your option) any later version.
   11: 
   12: \ This program is distributed in the hope that it will be useful,
   13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: \ GNU General Public License for more details.
   16: 
   17: \ You should have received a copy of the GNU General Public License
   18: \ along with this program; if not, write to the Free Software
   19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   20: 
   21: \ documentation source can contain lines in the form `doc-word' and
   22: \ `short-word'. These are converted to appropriate full or short
   23: \ (without the description) glossary entries for word.
   24: 
   25: \ The glossary entries are generated from data present in the wordlist
   26: \ `documentation'. Each word resides there under its own name.
   27: 
   28: script? [IF]
   29:     warnings off
   30:     require search.fs
   31:     require extend.fs
   32:     require glocals.fs
   33:     require float.fs
   34:     require struct.fs
   35:     require debugs.fs
   36: [THEN]
   37: 
   38: wordlist constant documentation
   39: 
   40: struct
   41:     cell% 2* field doc-name
   42:     cell% 2* field doc-stack-effect
   43:     cell% 2* field doc-wordset
   44:     cell% 2* field doc-pronounciation
   45:     cell% 2* field doc-description
   46: end-struct doc-entry
   47: 
   48: create description-buffer 4096 chars allot
   49: 
   50: : get-description ( -- addr u )
   51:     description-buffer
   52:     begin
   53: 	refill
   54:     while
   55: 	source nip
   56:     while
   57: 	source swap >r 2dup r> -rot cmove
   58: 	chars +
   59: 	#lf over c! char+
   60:     repeat then
   61:     description-buffer tuck - ;
   62: 
   63: : skip-prefix ( c-addr1 u1 -- c-addr2 u2 )
   64:     2dup 2 min s" --" compare 0=
   65:     IF
   66: 	[char] - skip [char] - scan 1 /string
   67:     THEN ;
   68: 
   69: : replace-_ ( c-addr u -- )
   70:     \ replaces _ with -
   71:     chars bounds
   72:     +DO
   73: 	i c@ [char] _ =
   74: 	if
   75: 	    [char] - i c!
   76: 	endif
   77: 	1 chars
   78:     +loop ;
   79:     
   80: : condition-stack-effect ( c-addr1 u1 -- c-addr2 u2 )
   81:     save-mem 2dup replace-_ ;
   82:     
   83: : condition-wordset ( c-addr1 u1 -- c-addr2 u2 )
   84:     dup 0=
   85:     if
   86: 	2drop s" unknown"
   87:     else
   88: 	save-mem
   89:     endif ;
   90: 
   91: : condition-pronounciation ( c-addr1 u1 -- c-addr2 u2 )
   92:     save-mem 2dup replace-_ ;
   93: 
   94: : make-doc ( -- )
   95:     get-current documentation set-current
   96:     create
   97: 	last @ name>string skip-prefix 2,		\ name
   98: 	[char] ) parse save-mem 2,	\ stack-effect
   99: 	bl sword condition-wordset 2,	\ wordset
  100: 	bl sword dup	\ pronounciation
  101: 	if
  102: 	    condition-pronounciation
  103: 	else
  104: 	    2drop last @ name>string skip-prefix
  105: 	endif
  106: 	2,
  107: 	get-description save-mem 2,
  108:     set-current ;
  109: 
  110: : emittexi ( c -- )
  111:     >r
  112:     s" @{}" r@ scan 0<>
  113:     if
  114: 	[char] @ emit
  115:     endif
  116:     drop r> emit ;
  117: 
  118: : typetexi ( addr u -- )
  119:     0
  120:     ?do
  121: 	dup c@ emittexi
  122: 	char+
  123:     loop
  124:     drop ;
  125: 
  126: : print-short ( doc-entry -- )
  127:     >r
  128:     ." @findex "
  129:     r@ doc-name 2@ typetexi
  130:     ."  @var{ " r@ doc-stack-effect 2@ type ."  }  "
  131:     r@ doc-wordset 2@ type
  132:     cr
  133:     ." @cindex "
  134:     ." @code{" r@ doc-name 2@ typetexi ." }"
  135:     cr
  136:     ." @format" cr
  137:     ." @code{" r@ doc-name 2@ typetexi ." }       "
  138:     ." @i{" r@ doc-stack-effect 2@ type ." }       "
  139:     r@ doc-wordset 2@ type ."        ``"
  140:     r@ doc-pronounciation 2@ type ." ''" cr ." @end format" cr
  141:     rdrop ;
  142: 
  143: : print-doc ( doc-entry -- )
  144:     >r
  145:     r@ print-short
  146:     r@ doc-description 2@ dup 0<>
  147:     if
  148: 	\ ." @iftex" cr ." @vskip-0ex" cr ." @end iftex" cr
  149: 	type cr cr
  150: 	\ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr
  151:     else
  152: 	2drop cr
  153:     endif
  154:     rdrop ;
  155: 
  156: : do-doc ( addr1 u1 addr2 u2 xt -- f )
  157:     \ xt is the word to be executed if addr1 u1 is a string starting
  158:     \ with the prefix addr2 u2 and continuing with a word in the
  159:     \ wordlist `documentation'. f is true if xt is executed.
  160:     >r dup >r
  161:     3 pick over compare 0=
  162:     if \ addr2 u2 is a prefix of addr1 u1
  163: 	r> /string documentation search-wordlist
  164: 	if \ the rest of addr1 u1 is in documentation
  165: 	    execute r> execute true
  166: 	else
  167: 	    rdrop false
  168: 	endif
  169:     else
  170: 	2drop 2rdrop false
  171:     endif ;
  172: 
  173: : process-line ( addr u -- )
  174:     2dup s" doc-" ['] print-doc do-doc 0=
  175:     if
  176: 	2dup s" short-" ['] print-short do-doc 0=
  177: 	if
  178: 	    type cr EXIT
  179: 	endif
  180:     endif
  181:     2drop ;
  182: 
  183: 1024 constant doclinelength
  184: 
  185: create docline doclinelength chars allot
  186: 
  187: : ds2texi ( file-id -- )
  188:     >r
  189:     begin
  190: 	docline doclinelength r@ read-line throw
  191:     while
  192: 	dup doclinelength = abort" docline too long"
  193: 	docline swap process-line
  194:     repeat
  195:     drop rdrop ;
  196: 
  197: : compare-ci ( addr1 u1 addr2 u2 -- n )
  198:     \ case insensitive string compare
  199:     2 pick swap -
  200:     ?dup-0=-if
  201:         capscomp
  202:     else
  203: 	nip nip nip
  204: 	0<
  205: 	if
  206: 	    -1
  207: 	else
  208: 	    1
  209: 	endif
  210:     endif  ;
  211: 
  212: : answord ( "name wordset pronounciation" -- )
  213:     \ check the documentaion of an ans word
  214:     name { D: wordname }
  215:     name { D: wordset }
  216:     name { D: pronounciation }
  217:     wordname documentation search-wordlist
  218:     if
  219: 	execute { doc }
  220: 	wordset doc doc-wordset 2@ compare-ci
  221: 	if 
  222: 	    ." wordset: " wordname type ." : '"  doc doc-wordset 2@ type ." ' instead of '" wordset type ." '" cr
  223: 	endif
  224: 	pronounciation doc doc-pronounciation 2@ compare-ci
  225: 	if
  226: 	    ." pronounciation: " wordname type ." : '" doc doc-pronounciation 2@ type ." ' instead of '" pronounciation type ." '" cr
  227: 	endif
  228:     else
  229: 	." undocumented: " wordname type cr
  230:     endif ;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>