Menu
▾
▴
[Win32forth-cvs] win32forth/src/tools DexH-CreateDocs.f,1.11,1.12 DexH-Glossary.f,1.2,1.3 DexH.f,1.4,1.5
|
From: Dirk B. <db...@us...> - 2006-02-06 17:48:31
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24798/src/tools Modified Files: DexH-CreateDocs.f DexH-Glossary.f DexH.f Log Message: Updated the glossary generator in DexH. Now it supports most but not all defining words. Index: DexH-Glossary.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/DexH-Glossary.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** DexH-Glossary.f 4 Feb 2006 10:40:36 -0000 1.2 --- DexH-Glossary.f 6 Feb 2006 17:48:18 -0000 1.3 *************** *** 5,33 **** \ **************************************************************************** - \ helper words - \ **************************************************************************** - - [UNDEFINED] 2+ [if] - CODE 2+ ( n1 -- n2 ) \ add two to n1 - inc ebx - inc ebx - next c; - [then] - - [UNDEFINED] 2- [if] - CODE 2- ( n1 -- n2 ) \ sub two from n1 - dec ebx - dec ebx - next c; - [then] - - : "minus-path" { a1 n1 -- a2 n2 } \ remove path from filename - \ scan to last '\' in filename - a1 n1 + n1 [CHAR] \ -SCAN - ?dup if n1 swap - 1- swap 1+ swap else drop a1 n1 then - ; - - - \ **************************************************************************** \ write output file \ **************************************************************************** --- 5,8 ---- *************** *** 59,65 **** : output-delete ( -- ) OutputFile delete-file drop ; ! : (output-string) ( addr count -- ) \ *G Write a string to the output-file. OutputFileHandle write-file drop ; --- 34,41 ---- : output-delete ( -- ) + \ *G Delete the output file for the glossary. OutputFile delete-file drop ; ! : output-write ( addr len -- ) \ *G Write a string to the output-file. OutputFileHandle write-file drop ; *************** *** 67,71 **** : output-char ( char -- ) \ *G Write a char to the output-file. ! here c! here 1 (output-string) ; : output-string ( addr count -- ) --- 43,56 ---- : output-char ( char -- ) \ *G Write a char to the output-file. ! here c! here 1 output-write ; ! ! : (output-string) ( addr count -- ) ! \ *G Write a string to the output-file. ! \ ** A " char will be written as "" into the file. ! bounds ! ?do i c@ dup [char] " = ! if dup output-char ! then output-char ! loop ; : output-string ( addr count -- ) *************** *** 76,82 **** [char] " output-char ; ! : output-tab ( -- ) ! \ *G Write TAB to the output-file. ! \ 9 output-char ; [char] , output-char ; --- 61,66 ---- [char] " output-char ; ! : output-sep ( -- ) ! \ *G Write seperator to the output-file. [char] , output-char ; *************** *** 88,96 **** : output-header ( -- ) \ *G Write the header line to the output-file. ! s" Name" output-string output-tab ! s" Stack" output-string output-tab ! s" Comment" output-string output-tab ! s" Type" output-string output-tab ! s" Class" output-string output-tab s" File" output-string output-cr ; --- 72,80 ---- : output-header ( -- ) \ *G Write the header line to the output-file. ! s" Name" output-string output-sep ! s" Stack" output-string output-sep ! s" Comment" output-string output-sep ! s" Type" output-string output-sep ! s" Class" output-string output-sep s" File" output-string output-cr ; *************** *** 107,119 **** \ **************************************************************************** ! 99 value definition-type ! create $definition-name 260 allot $definition-name off ! create $class-name 260 allot $class-name off false value InClass? ! : IsClass? ( -- f ) ! definition-type 8 = \ :class ? ! definition-type 9 = \ :object ? ! or ; : IsCloseingClass? ( -- f ) --- 91,113 ---- \ **************************************************************************** ! -1 constant #invalid-definition-type ! #invalid-definition-type value definition-type ! ! : allot-erase ( n -- ) ! here over allot swap erase ; ! ! create $definition-name 1024 allot-erase ! create $definition-type 1024 allot-erase ! create $stack-comment 1024 allot-erase ! create $comment 1024 allot-erase ! create $class-name 1024 allot-erase ! false value InClass? ! : IsClass? ( -- f ) ! definition-type 8 = \ :class ? ! definition-type 9 = \ :object ? ! definition-type 14 = \ |class ? ! or or ; : IsCloseingClass? ( -- f ) *************** *** 122,254 **** or ; ! : save-definition-name ( addr len f -- addr len ) ! if 2dup $definition-name place ! then IsClass? ! if 2dup $class-name place ! then ! IsCloseingClass? ! if $class-name off ! then ! ; ! : print-line { addr count char fSaveName -- addr' count' } \ write line to output file; stop on char ! count 0> ! if ! addr count char scan dup 0<> ! if 1- swap 1+ swap ! dup count swap - addr swap char bl = if 1- then ! fSaveName save-definition-name \ save name ! output-string ! else 2drop addr count ! fSaveName save-definition-name \ save name ! output-string ! addr 0 \ preevent stack underflow ! then ! else addr 0 \ preevent stack underflow ! then ! ; ! : print-definition-name ( addr count -- addr' count' ) \ write word name output file ! bl scan bl skip bl IsClass? print-line ; ! : print-stack-comment ( addr count -- addr' count' ) \ write stack-comment output file ! ?dup ! if bl skip dup ! if over c@ [char] ( = ! if [char] ) false print-line ! else over c@ [char] { = ! if [char] } false print-line ! then ! then ! then ! else 0 \ preevent stack underflow ! then ! ; ! : print-comment ( addr count -- ) \ write comment to output file ! ?dup ! if bl skip dup ! if over c@ [char] \ = ! if [char] \ skip ! bl skip ! output-string ! else 2drop ! then ! else 2drop ! then ! else drop ! then ! ; ! : print-definition-type ( -- ) \ write type of definition to output file ! definition-type ! case 0 of s" COLON" endof ! 1 of s" CODE" endof ! 2 of s" CONSTANT" endof ! 3 of s" DEFER" endof ! 4 of s" CREATE" endof ! 5 of s" VARIABLE" endof ! 6 of s" VALUE" endof ! 7 of s" METHOD" endof ! 8 of s" CLASS" endof ! 9 of s" OBJECT" endof ! 10 of s" ;CLASS" endof ! 11 of s" ;OBJECT" endof ! 99 of s" ?" endof ! endcase ! output-string ; ! : print-file-name ( #ancor -- ) \ write input file name to output file ! $infile lcount output-string ! s" #" output-string ! s>d (D.) output-string ; ! : is-definition-type ( addr1 len1 addr2 len2 -- f ) ! \ 4dup cr tab . space drop . drop ! \ 4dup cr tab type ! \ cr tab type ! COMPARE 0= ; ! : +word ( a1 n1 -- a2 n2 a3 n3 ) ! bl skip 2dup bl scan 2dup 2>r nip - 2r> 2swap ; ! : set-definition-type ( addr len n -- ) ! to definition-type 2drop ; ! : get-definition-type ( addr len -- ) \ get type of definition ! \ cr ." get-definition-type for: " 2dup type ! 99 to definition-type \ default: unkonwen ! 2dup upper +word 2nip -trailing ! 2dup s" :" is-definition-type if 0 set-definition-type exit then ! 2dup s" CODE" is-definition-type if 1 set-definition-type exit then ! 2dup s" CONSTANT" is-definition-type if 2 set-definition-type exit then ! 2dup s" DEFER" is-definition-type if 3 set-definition-type exit then ! 2dup s" CREATE" is-definition-type if 4 set-definition-type exit then ! 2dup s" VARIABLE" is-definition-type if 5 set-definition-type exit then ! 2dup s" VALUE" is-definition-type if 6 set-definition-type exit then ! 2dup s" :M" is-definition-type if 7 set-definition-type exit then ! 2dup s" :CLASS" is-definition-type if 8 set-definition-type true to InClass? exit then ! 2dup s" :OBJECT" is-definition-type if 9 set-definition-type true to InClass? exit then ! 2dup s" ;CLASS" is-definition-type if 10 set-definition-type false to InClass? exit then ! 2dup s" ;OBJECT" is-definition-type if 11 set-definition-type false to InClass? exit then ! 2drop ; : print-class-name ( -- ) InClass? IsClass? 0= and ! if $class-name count else s" " then output-string ; ! : process-word ( #ancor addr count -- ) \ process on line of the input file ?dup ! if print-definition-name output-tab ( #ancor addr' count' ) ! print-stack-comment output-tab ( #ancor addr' count' ) ! print-comment output-tab ( #ancor ) ! print-definition-type output-tab ( #ancor ) ! print-class-name output-tab ( #ancor ) ! print-file-name output-cr ( -- ) else 2drop then ; --- 116,327 ---- or ; ! : set-class-name ( -- ) IsClass? ! if $definition-name lcount $class-name lplace ! else IsCloseingClass? ! if 0 $class-name ! ! then ! then ; ! : +word ( a1 n1 -- a2 n2 a3 n3 ) ! bl skip 2dup bl scan 2dup 2>r nip - 2r> 2swap ; ! : set-definition-type ( addr len n -- ) ! to definition-type 2drop ; ! : is-definition-type ( a1 n1 -- ) ! 2dup s" :" COMPARE 0= if 0 set-definition-type exit then ! 2dup s" CODE" COMPARE 0= if 1 set-definition-type exit then ! 2dup s" CONSTANT" COMPARE 0= if 2 set-definition-type exit then ! 2dup s" DEFER" COMPARE 0= if 3 set-definition-type exit then ! 2dup s" CREATE" COMPARE 0= if 4 set-definition-type exit then ! 2dup s" VARIABLE" COMPARE 0= if 5 set-definition-type exit then ! 2dup s" VALUE" COMPARE 0= if 6 set-definition-type exit then ! 2dup s" :M" COMPARE 0= if 7 set-definition-type exit then ! 2dup s" :CLASS" COMPARE 0= if 8 set-definition-type true to InClass? exit then ! 2dup s" :OBJECT" COMPARE 0= if 9 set-definition-type true to InClass? exit then ! 2dup s" ;CLASS" COMPARE 0= if 10 set-definition-type false to InClass? exit then ! 2dup s" ;OBJECT" COMPARE 0= if 11 set-definition-type false to InClass? exit then ! 2dup s" FVARIABLE" COMPARE 0= if 12 set-definition-type exit then ! 2dup s" 2VARIABLE" COMPARE 0= if 13 set-definition-type exit then ! 2dup s" |CLASS" COMPARE 0= if 14 set-definition-type true to InClass? exit then ! 2dup s" :NONAME" COMPARE 0= if 15 set-definition-type exit then ! 2dup s" |:" COMPARE 0= if 16 set-definition-type exit then ! 2dup s" FCONSTANT" COMPARE 0= if 17 set-definition-type exit then ! 2dup s" 2CONSTANT" COMPARE 0= if 18 set-definition-type exit then ! 2dup s" BYTES" COMPARE 0= if 19 set-definition-type exit then ! 2dup s" BYTE" COMPARE 0= if 20 set-definition-type exit then ! 2dup s" BITS" COMPARE 0= if 21 set-definition-type exit then ! 2dup s" SHORT" COMPARE 0= if 22 set-definition-type exit then ! 2dup s" INT" COMPARE 0= if 23 set-definition-type exit then ! 2dup s" DINT" COMPARE 0= if 24 set-definition-type exit then ! 2dup s" USER" COMPARE 0= if 25 set-definition-type exit then ! 2dup s" NEWUSER" COMPARE 0= if 26 set-definition-type exit then ! 2dup s" CFA-CODE" COMPARE 0= if 27 set-definition-type exit then ! 2dup s" CFA-FUNC" COMPARE 0= if 28 set-definition-type exit then ! 2dup s" HEADER" COMPARE 0= if 29 set-definition-type exit then ! 2dup s" ALIAS" COMPARE 0= if 30 set-definition-type exit then ! 2dup s" SYNONYM" COMPARE 0= if 31 set-definition-type exit then ! 2dup s" EQU" COMPARE 0= if 32 set-definition-type exit then ! \ 2dup s" AS" COMPARE 0= if 33 set-definition-type exit then ! 2dup s" MACRO" COMPARE 0= if 34 set-definition-type exit then ! 2dup s" #DEFINE" COMPARE 0= if 35 set-definition-type exit then ! 2dup s" RECORD:" COMPARE 0= if 36 set-definition-type exit then ! 2dup s" ;RECORDSIZE:" COMPARE 0= if 37 set-definition-type exit then ! 2dup s" MACRO:" COMPARE 0= if 38 set-definition-type exit then ! 2dup s" SUBR:" COMPARE 0= if 39 set-definition-type exit then ! \ 2dup s" PROC" COMPARE 0= if 40 set-definition-type exit then ! 2dup s" EXTERN" COMPARE 0= if 41 set-definition-type exit then ! 2dup s" WINLIBRARY" COMPARE 0= if 42 set-definition-type exit then ! 2drop ; ! : get-definition-type ( addr len -- ) ! \ Get the type of the definition. ! \ Note: The string will be in uppercase letters after this. ! #invalid-definition-type to definition-type \ default: unkonwen ! 2dup upper +word -trailing ! is-definition-type definition-type #invalid-definition-type = ! if +word -trailing is-definition-type 2drop ! else 2drop ! then ; ! create buf1$ 1024 allot ! create buf2$ 1024 allot ! : parse-stack-comment ( a1 n1 c1 c2 -- a2 n2 f ) ! { c1 c2 -- } ! 0 $stack-comment ! ! 2dup c1 scan ?dup \ a1 n1 a2 n2 f ! if \ stack comment found ! 2nip 2dup c2 scan 2dup 2>r nip - ?dup \ a2 n2 a3 n3 ! if c1 skip bl skip -trailing $stack-comment lplace ! else drop ! then 2r> 1 /string ! else drop ! then $stack-comment lcount nip ; ! : parse-line ( addr len -- f ) ! \ Parse one line of the input file, and write ! \ the name the stack comment, and to comment into the output file. ! \ the name and definition type ! +word buf1$ lplace ! +word buf2$ lplace ! ! buf1$ lcount $definition-type lplace $definition-type lcount ! get-definition-type definition-type #invalid-definition-type = ! if buf2$ lcount $definition-type lplace $definition-type lcount ! get-definition-type definition-type #invalid-definition-type = ! if 2drop false exit \ exit on error ! else buf1$ lcount $definition-name lplace ! then ! else buf2$ lcount $definition-name lplace ! then ! ! \ stack comment ! [char] ( [char] ) parse-stack-comment 0= ! if [char] { [char] } parse-stack-comment drop ! then ! ! \ comment ! [char] \ scan ?dup ! if [char] \ skip bl skip -trailing $comment lplace ! else drop 0 $comment ! ! then ! ! \ write the strings into the output file ! $definition-name lcount output-string output-sep ! $stack-comment lcount output-string output-sep ! $comment lcount output-string output-sep ! ! true ; : print-class-name ( -- ) + \ Write the name of the current class into the output file. InClass? IsClass? 0= and ! if $class-name lcount else s" " then output-string ; ! : print-definition-type ( -- ) ! \ Write the definition type into the output file. ! definition-type ! case 0 of s" COLON" endof ! 15 of s" COLON hidden" endof \ :noname ! 16 of s" COLON hidden" endof \ |: ! ! 1 of s" CODE" endof ! ! 2 of s" CONSTANT" endof ! 17 of s" FCONSTANT" endof ! 18 of s" 2CONSTANT" endof ! ! 3 of s" DEFER" endof ! 4 of s" CREATE" endof ! ! 5 of s" VARIABLE" endof ! 12 of s" FVARIABLE" endof ! 13 of s" 2VARIABLE" endof ! ! 6 of s" VALUE" endof ! ! 14 of s" |CLASS" endof ! 8 of s" CLASS" endof ! 9 of s" OBJECT" endof ! ! 10 of s" ;CLASS" endof ! 11 of s" ;OBJECT" endof ! ! 7 of s" METHOD" endof \ :m ! 19 of s" BYTES ivar" endof ! 20 of s" BYTE ivar" endof ! 21 of s" BITS ivar" endof ! 22 of s" SHORT ivar" endof ! 23 of s" INT ivar" endof ! 24 of s" DINT ivar" endof ! ! 25 of s" USER" endof ! 26 of s" NEWUSER" endof ! 27 of s" CFA-CODE" endof ! 28 of s" CFA-FUNC" endof ! 29 of s" HEADER" endof ! 30 of s" ALIAS" endof ! 31 of s" SYNONYM" endof ! 32 of s" EQU" endof ! 33 of s" AS" endof ! 34 of s" MACRO" endof ! 35 of s" #DEFINE" endof ! 36 of s" RECORD:" endof ! 37 of s" ;RECORDSIZE:" endof ! 38 of s" MACRO:" endof ! 39 of s" SUBR:" endof ! 40 of s" PROC" endof ! 41 of s" EXTERN" endof ! 42 of s" WINLIBRARY" endof ! endcase ! output-string ; ! ! : print-file-name ( #ancor -- ) ! \ Write the name of input file with the ancor into the output file. ! [char] " output-char ! $infile lcount (output-string) ! [char] # output-char ! s>d (D.) (output-string) ! [char] " output-char ; ! ! : process-word ( #ancor addr len -- ) ! \ *G Process on line of the input file. ?dup ! if parse-line ! if set-class-name ! print-definition-type output-sep ( #ancor ) ! print-class-name output-sep ( #ancor ) ! print-file-name output-cr ( -- ) ! else drop ! then else 2drop then ; Index: DexH-CreateDocs.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/DexH-CreateDocs.f,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** DexH-CreateDocs.f 4 Feb 2006 16:12:24 -0000 1.11 --- DexH-CreateDocs.f 6 Feb 2006 17:48:18 -0000 1.12 *************** *** 11,16 **** \ create a new gloassary file if needed ! create-glossary-file? ! if output-new then \ classes --- 11,16 ---- \ create a new gloassary file if needed ! 1 to create-glossary-file? ! output-new \ classes Index: DexH.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/DexH.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** DexH.f 4 Feb 2006 10:40:36 -0000 1.4 --- DexH.f 6 Feb 2006 17:48:18 -0000 1.5 *************** *** 44,48 **** \ Set to true when a seperate glossary.txt should be created \ Still work in progress... (dbu) ! 1 constant create-glossary-file? ( *P DexH is ANS Forth except for the need for BOUNDS, SCAN, SKIP and LCOUNT. ) --- 44,48 ---- \ Set to true when a seperate glossary.txt should be created \ Still work in progress... (dbu) ! 1 value create-glossary-file? ( *P DexH is ANS Forth except for the need for BOUNDS, SCAN, SKIP and LCOUNT. ) *************** *** 304,308 **** $line lplace $line lcount get-definition-type ! definition-type 99 <> ; --- 304,308 ---- $line lplace $line lcount get-definition-type ! definition-type #invalid-definition-type <> ; *************** *** 310,315 **** \ cr 2dup type 2dup gl-get-type ! if $line lplace ! #gl-ancor $line lcount process-word else 2drop cr ." Line: " $line lcount type ." skipped" then ; --- 310,317 ---- \ cr 2dup type 2dup gl-get-type ! if IsCloseingClass? 0= ! if $line lplace #gl-ancor $line lcount process-word ! else 2drop ! then else 2drop cr ." Line: " $line lcount type ." skipped" then ; |
