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]