Menu
▾
▴
win32forth-cvs — CVS Commit List
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(70) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(38) |
Feb
(4) |
Mar
(11) |
Apr
(49) |
May
(81) |
Jun
(65) |
Jul
(36) |
Aug
(57) |
Sep
(63) |
Oct
(57) |
Nov
(49) |
Dec
(41) |
| 2006 |
Jan
(75) |
Feb
(80) |
Mar
(10) |
Apr
(13) |
May
(100) |
Jun
(100) |
Jul
(77) |
Aug
(87) |
Sep
(80) |
Oct
(124) |
Nov
(39) |
Dec
(41) |
| 2007 |
Jan
(20) |
Feb
(32) |
Mar
(32) |
Apr
(43) |
May
(146) |
Jun
(40) |
Jul
(49) |
Aug
(33) |
Sep
(25) |
Oct
(19) |
Nov
(11) |
Dec
(8) |
| 2008 |
Jan
(4) |
Feb
(11) |
Mar
(31) |
Apr
(40) |
May
(34) |
Jun
(24) |
Jul
(39) |
Aug
(104) |
Sep
(27) |
Oct
(35) |
Nov
(34) |
Dec
(97) |
| 2009 |
Jan
(75) |
Feb
(29) |
Mar
(45) |
Apr
(76) |
May
(121) |
Jun
(103) |
Jul
(67) |
Aug
(28) |
Sep
(22) |
Oct
(39) |
Nov
(9) |
Dec
(15) |
| 2010 |
Jan
(7) |
Feb
(39) |
Mar
(40) |
Apr
(57) |
May
(67) |
Jun
(69) |
Jul
(49) |
Aug
(68) |
Sep
(22) |
Oct
(7) |
Nov
(2) |
Dec
(10) |
| 2011 |
Jan
|
Feb
|
Mar
(10) |
Apr
(4) |
May
(6) |
Jun
(10) |
Jul
(16) |
Aug
(23) |
Sep
(9) |
Oct
|
Nov
(28) |
Dec
(3) |
| 2012 |
Jan
(11) |
Feb
(10) |
Mar
(1) |
Apr
|
May
(4) |
Jun
(3) |
Jul
(3) |
Aug
(4) |
Sep
(2) |
Oct
|
Nov
|
Dec
(1) |
| 2013 |
Jan
|
Feb
(7) |
Mar
(30) |
Apr
(4) |
May
(4) |
Jun
(8) |
Jul
(10) |
Aug
(4) |
Sep
|
Oct
(2) |
Nov
(24) |
Dec
(13) |
| 2014 |
Jan
(7) |
Feb
(2) |
Mar
|
Apr
(1) |
May
(9) |
Jun
|
Jul
(3) |
Aug
(9) |
Sep
|
Oct
(2) |
Nov
|
Dec
(3) |
| 2015 |
Jan
(4) |
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
(1) |
Oct
(4) |
Nov
(7) |
Dec
(39) |
| 2016 |
Jan
(17) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(1) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
(2) |
| 2017 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(1) |
Jun
(2) |
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
| 2018 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2019 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(1) |
Dec
(1) |
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
| 2025 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: George H. <geo...@us...> - 2006-11-21 15:26:27
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25534/win32forth/src Modified Files: Class.f Log Message: gah:Modified dispose to avoid ~: corrupting the object address Index: Class.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** Class.f 3 Oct 2006 07:44:22 -0000 1.24 --- Class.f 21 Nov 2006 15:26:19 -0000 1.25 *************** *** 1249,1253 **** : Dispose ( addr -- ) \ *G Dispose of a dynamically allocated object. ! ~: [ dup ] cell- Free Abort" Disposing Object failed!" ; --- 1249,1253 ---- : Dispose ( addr -- ) \ *G Dispose of a dynamically allocated object. ! ~: [ dup>r ] r> cell- Free Abort" Disposing Object failed!" ; |
|
From: George H. <geo...@us...> - 2006-11-20 14:18:24
|
Update of /cvsroot/win32forth/win32forth/apps/ForthForm In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8156/win32forth/apps/ForthForm Modified Files: CreateToolBar.f FORMCONTROLS.F FORMOBJECT.F FORTHFORM.F FormMenu.f Log Message: gah:Bug fix from Ezra Boyce Index: FORTHFORM.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORTHFORM.F,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** FORTHFORM.F 29 May 2006 17:13:14 -0000 1.14 --- FORTHFORM.F 20 Nov 2006 14:18:17 -0000 1.15 *************** *** 7,11 **** anew -ForthForm.f ! : sysgen ; \ : withbgnd ; \ add the ForthForm folder's to our path list --- 7,11 ---- anew -ForthForm.f ! : sysgen ; \ : withbgnd ; \ add the ForthForm folder's to our path list *************** *** 143,146 **** --- 143,147 ---- defer doLoadsession \ reload a saved state defer doCloseAllForms + defer doCloseForm defer doSaveAll defer doMoveToBack *************** *** 631,641 **** then r> IsChildState: ActiveForm ; is doTest :NoName ( -- ) \ clean slate ! #Forms ?dup ! if 1+ 1 ! do i >Link#: FormList ! Data@: FormList CloseForm: TheMainWindow ! loop ! then ; is doCloseAllForms :NoName ( -- ) \ save all modified forms --- 632,669 ---- then r> IsChildState: ActiveForm ; is doTest + : CloseForm { theform -- } + Close: theform + theform ?FormNumber >Link#: FormList + theform Dispose + 0 Data!: FormList + DeleteLink: FormList + #Forms 0= + if Blank: Monitor + ForthFormTitle$ SetText: TheMainWindow + ClearStatusWindow + SetFocus: TheMainWindow + 0 to ActiveForm + \ InhibitPropertyWindow + Close: frmProperties++ + UpdateSystem + FormList Dispose 0 to FormList + else SetFocus: [ Data@: FormList ] + ActiveControl: Activeform + if UpdatePropertyWindow + then + then UpdateFormPicker + #Forms 2 < + if Close: frmCreatePropertyForm + UpdateSystem + then ; ' CloseForm is doCloseForm + + :NoName ( -- ) \ clean slate ! FormList 0= ?exit ! >FirstLink: FormList ! Begin FormList ! While Data@: FormList CloseForm ! Repeat ; is doCloseAllForms ! :NoName ( -- ) \ save all modified forms *************** *** 877,881 **** :M Close: ( -- ) SaveDefaults ! DisposeForms Close: TheRebar Close: Monitor --- 905,909 ---- :M Close: ( -- ) SaveDefaults ! doCloseAllForms Close: TheRebar Close: Monitor *************** *** 975,1003 **** 0 ;M - :M CloseForm: { <form> -- } - Close: <Form> - <Form> ?FormNumber >Link#: FormList - <Form> Dispose - 0 Data!: FormList - DeleteLink: FormList - #Forms 0= - if Blank: Monitor - ForthFormTitle$ SetText: self - ClearStatusWindow - SetFocus: TheMainWindow - 0 to ActiveForm - \ InhibitPropertyWindow - Close: frmProperties++ - UpdateSystem - else SetFocus: [ Data@: FormList ] - ActiveControl: Activeform - if UpdatePropertyWindow - then - then UpdateFormPicker - #Forms 2 < - if Close: frmCreatePropertyForm - UpdateSystem - then ;M - :M PushKey: ( c -- ) case --- 1003,1006 ---- *************** *** 1237,1240 **** --- 1240,1244 ---- \+ sysgen s" %DIRSciEditMdi.exe %FILENAME %LINE" editor$ place \+ sysgen s" %DIRSciEditMdi.exe /B %FILENAME %LINE" browse$ place + \+ sysgen &forthdir count &appdir place \ create ForthForm.exe in the Win32Forth directory \+ sysgen 0 0 ' ff application ForthForm.exe Index: FormMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FormMenu.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** FormMenu.f 1 Nov 2005 23:14:04 -0000 1.2 --- FormMenu.f 20 Nov 2006 14:18:17 -0000 1.3 *************** *** 7,11 **** MenuItem "&Open\tCtrl+O" doOpen ; :MenuItem mnu_doform "&Edit properties" doForm ; ! :MenuItem mnu_close "Close Active &Form" ActiveForm if Close: ActiveForm then ; :MenuItem mnu_closeall "&Close All" doCloseAllForms ; MenuSeparator --- 7,11 ---- MenuItem "&Open\tCtrl+O" doOpen ; :MenuItem mnu_doform "&Edit properties" doForm ; ! :MenuItem mnu_close "Close Active &Form" ActiveForm if ActiveForm doCloseForm then ; :MenuItem mnu_closeall "&Close All" doCloseAllForms ; MenuSeparator Index: FORMCONTROLS.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORMCONTROLS.F,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** FORMCONTROLS.F 4 Nov 2005 06:40:15 -0000 1.5 --- FORMCONTROLS.F 20 Nov 2006 14:18:17 -0000 1.6 *************** *** 760,764 **** Update: self ;M ! : default-font ( -- ) Delete: TheFont --- 760,764 ---- Update: self ;M ! : default-font ( -- ) Delete: TheFont *************** *** 773,777 **** Update: self ;M ! : SetTheFont ( -- ) ctrlFont TheFont.LogFont sizeOf(LogFont) move --- 773,777 ---- Update: self ;M ! : SetTheFont ( -- ) ctrlFont TheFont.LogFont sizeOf(LogFont) move *************** *** 883,890 **** :M IsGlobal: ( f -- ) to ctrlGlobal ;M ! :M FontChanged: ( -- f ) fontchanged ;M ! :M FontData: ( -- addr cnt ) ctrlfont sizeof(logfont) ;M --- 883,890 ---- :M IsGlobal: ( f -- ) to ctrlGlobal ;M ! :M FontChanged: ( -- f ) fontchanged ;M ! :M FontData: ( -- addr cnt ) ctrlfont sizeof(logfont) ;M *************** *** 951,955 **** ;M ! :M ~: ( -- ) \ what to do when disposing control TheControl if GetHandle: TheControl --- 951,955 ---- ;M ! :M Free: ( -- ) \ what to do when disposing control TheControl if GetHandle: TheControl Index: FORMOBJECT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORMOBJECT.F,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** FORMOBJECT.F 5 Jul 2006 14:38:43 -0000 1.12 --- FORMOBJECT.F 20 Nov 2006 14:18:17 -0000 1.13 *************** *** 221,231 **** ControlList if >FirstLink: ControlList ! #controls 0 ! do Data@: ControlList dup to ThisControl ! if ThisControl dispose ! 0 Data!: ControlList ! DeleteLink: ControlList ! then >NextLink: ControlList ! loop then 0 to ActiveControl ; --- 221,231 ---- ControlList if >FirstLink: ControlList ! begin Data@: ControlList dup to ThisControl ! while Free: ThisControl ! \ ThisControl Dispose ! 0 Data!: ControlList ! DeleteLink: ControlList ! repeat ControlList Dispose ! 0 to ControlList then 0 to ActiveControl ; *************** *** 1291,1299 **** if SaveIt? if SaveForm ! then then Close: Super ;M :M WM_CLOSE ( -- ) \ let parent do the closing ! self CloseForm: TheMainWindow ;M --- 1291,1299 ---- if SaveIt? if SaveForm ! then DisposeControls then Close: Super ;M :M WM_CLOSE ( -- ) \ let parent do the closing ! self doCloseForm ;M Index: CreateToolBar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/CreateToolBar.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** CreateToolBar.f 1 Nov 2005 23:14:04 -0000 1.4 --- CreateToolBar.f 20 Nov 2006 14:18:17 -0000 1.5 *************** *** 71,75 **** if &bitmap SetBitmap: TheBitmap \ width height dc.hdc ShowFittedBitmap: TheBitmap ! 0 0 dc.hdc ShowBitmap: TheBitmap else 0 0 width height WHITE FillArea: dc then ;M --- 71,75 ---- if &bitmap SetBitmap: TheBitmap \ width height dc.hdc ShowFittedBitmap: TheBitmap ! 0 0 GetHandle: dc ShowBitmap: TheBitmap else 0 0 width height WHITE FillArea: dc then ;M *************** *** 97,101 **** mousex to savex mousey to savey ; ! : showposition ( -- ) ShowBox --- 97,101 ---- mousex to savex mousey to savey ; ! : showposition ( -- ) ShowBox |
|
From: George H. <geo...@us...> - 2006-11-15 12:40:03
|
Update of /cvsroot/win32forth/win32forth-610old/src/WinEd In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6464/win32forth-610old/src/WinEd Modified Files: WinEd.f Log Message: gah:Bug fix from Bruno Gauthier Index: WinEd.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-610old/src/WinEd/WinEd.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** WinEd.f 14 Dec 2004 23:54:02 -0000 1.1 --- WinEd.f 15 Nov 2006 12:39:57 -0000 1.2 *************** *** 7695,7699 **** highlight-word line-cur cursor-line screen-rows 4 - - 0max cursor-line between 0= ! IF cursor-line screen-rows 2 - VPosition: edit-window THEN --- 7695,7699 ---- highlight-word line-cur cursor-line screen-rows 4 - - 0max cursor-line between 0= ! IF cursor-line screen-rows 2 - 2/ - VPosition: edit-window THEN *************** *** 8819,8821 **** Completed items The list of files window on the left of the editor is retained across sessions ! |
|
From: George H. <geo...@us...> - 2006-11-13 13:52:02
|
Update of /cvsroot/win32forth/win32forth/apps/WinEd In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9111/win32forth/apps/WinEd Modified Files: Ed_Remote.F Log Message: gah:Bug fix from Bruno Gauthier Index: Ed_Remote.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/WinEd/Ed_Remote.F,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Ed_Remote.F 28 Aug 2005 07:28:07 -0000 1.3 --- Ed_Remote.F 13 Nov 2006 13:51:52 -0000 1.4 *************** *** 89,93 **** highlight-word line-cur cursor-line screen-rows 4 - - 0max cursor-line between 0= ! IF cursor-line screen-rows 2 - VPosition: edit-window THEN --- 89,93 ---- highlight-word line-cur cursor-line screen-rows 4 - - 0max cursor-line between 0= ! IF cursor-line screen-rows 2 - 2/ - VPosition: edit-window THEN *************** *** 100,104 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ 61 Automatic save of edit changes after a specifiable number of minutes \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 100,104 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ 61 Automatic save of edit changes after a specifiable number of minutes \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ |
|
From: George H. <geo...@us...> - 2006-11-13 13:01:44
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21690/win32forth-stc/src Modified Files: primutil.f Log Message: gah:Structure packages added. Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.18 retrieving revision 1.19 diff -C2 -d -r1.18 -r1.19 *** primutil.f 7 Nov 2006 11:04:50 -0000 1.18 --- primutil.f 13 Nov 2006 13:01:37 -0000 1.19 *************** *** 300,303 **** --- 300,313 ---- \ ------------------------------------------------------------------------ + \ Often used + \ ------------------------------------------------------------------------ + + : STRING: \ Allocates strings + CREATE MAXSTRING ALLOT \ Compiletime: ( -< name >- ) Runtime: ( - addr$ ) + ; + + : ERASE$ ( addr - ) MAXSTRING ERASE ; + + \ ------------------------------------------------------------------------ \ Some case insensitive version of search and compare \ ------------------------------------------------------------------------ |
|
From: George H. <geo...@us...> - 2006-11-13 13:01:42
|
Update of /cvsroot/win32forth/win32forth-stc/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21690/win32forth-stc/src/lib Added Files: ExtStruct.f STRUCT.F Log Message: gah:Structure packages added. --- NEW FILE: ExtStruct.f --- \ C like structures. \ Written by Jos v.d. Ven and Dirk Busch. \ Based on a previous Struct.f by Jos. cr .( Loading Extended C like structures... ) anew -ExtStruct.f in-system \ The following memory allocation words allow nesting and cloning \ of a memory structure. Definitions made in C can be used with \ small modifications. Use mkstruct: to allocate memory. vocabulary Structs \ all vocabularies for the struct's go in this one private Structs \ and avoids name conflicts. e.g. word internal 0 value _struct : _add-struct ( sizeof.struct -- ) \ compile current offset and increment _struct , +to _struct ; : add-struct ( sizeof.struct "name" -- ) \ compiling: store current offset and increment _struct offset +to _struct ; \ run-time: ( addr -- addr+offset ) : byte ( -- ) \ compiling: store offset and increment _struct by 1 1 add-struct ; \ run-time: ( offset - offset+dword ) immediate : word ( -- ) \ compiling: store offset and increment _struct by 2 2 add-struct ; \ run-time: ( offset - offset+dword ) immediate : dword ( -- ) \ compiling: store offset and increment _struct by 4 4 add-struct ; \ run-time: ( offset - offset+dword ) immediate : double ( -- ) \ compiling: store offset and increment _struct by 8 8 add-struct ; \ run-time: ( offset - offset+dword ) immediate : long_double ( -- ) \ compiling: store offset and increment _struct by 10 10 add-struct ; \ run-time: ( offset - offset+dword ) immediate : guid ( -- ) \ compiling: store offset and increment _struct by 16 16 add-struct ; \ run-time: ( offset - offset+dword ) immediate : qword ( -- ) \ compiling: store offset and increment _struct by 32 32 add-struct ; \ run-time: ( offset - offset+dword ) immediate : unsigned ; \ 0 can be ignored when allocating ' byte alias char \ 1 byte \ Note: Changed INT and UINT to 4 bytes, because INT's are 32 Bit's long \ under Windows (Samstag, Mai 29 2004 - 20:13 dbu) ' word alias short \ 2 bytes ' word alias ushort ' word alias wchar ' dword alias long \ 4 bytes ' dword alias int ' dword alias uint ' dword alias FOURCC \ for storing four ASCII bytes in a 32-bit field ' dword alias ulong ' dword alias langid ' dword alias lpvoid ' dword alias float ' add-struct alias field: \ Not standard in C ' dword alias HWND \ 4 bytes ' dword alias HICON \ 4 bytes ' dword alias COLORREF \ 4 bytes (added Samstag, Oktober 22 2005 dbu) ' word alias ATOM \ 2 bytes (added Montag, Mai 01 2006) [DEFINED] b/float [IF] : b/float \ compile-time: ( - ) \ 8 or 10 b/float add-struct ; \ run-time: ( offset - offset+dword ) [THEN] : cell \ compile-time: ( - ) \ Forth depended cell add-struct ; \ run-time: ( offset - offset+dword ) : offset \ compile-time: ( - ) It is a kind of label _struct offset ; \ run-time: ( offset - offset+dword ) 0 value current-voc \ Close a struct definiton. : ;struct ( ptr-size -- ) previous _struct swap ! \ Store the size previous current-voc set-current \ -1 +to olddepth ; : struct-voc[ ( -<name-struct>- -- wid ) also structs get-current also ' execute ; : ]struct-voc ( wid -- ) previous previous set-current ; : getsize-struct ( adr-struct - n ) >body cell+ @ ; external \ return the size of <name-struct> in bytes : sizeof ( -<name-struct>- -- size ) ' getsize-struct compilation> execute postpone literal ; \ compiles the adress and offset as one adress inside a definition : struct, ( -<Struct>- -<name-struct>- -<member>- -- ) ' execute \ struct_adress struct-voc[ swap ' execute \ struct_adress + offset_in_structure postpone literal ]struct-voc ; immediate internal : create-struct-voc ( addr len -- wid ) get-current >r also Structs definitions \ >SYSTEM "HEADER dovoc , #threads #WORDLIST SYSTEM> ( wid ) s" vocabulary " pad place pad +place pad count evaluate \ temporary hack last @ name>xt >body \ or two previous r> set-current ; : create-struct ( addr len wid -- ptr-size ) \ Map: WID size -rot \ ( create ) "HEADER DOVAR COMPILE, , immediate s" create " pad place pad +place pad count evaluate , \ temporary hack immediate here -2 , does> @ ( +order ) >R GET-ORDER 1+ R> SWAP SET-ORDER state @ if interpret \ Compile the offset+ part inside a definition previous \ and restore the order then ; create new-struct-name 255 allot external \ Open a struct definition. \ A vocabulary <name-struct> is created. \ All words for the struct members will be compiled into this vocabulary. : :struct ( -<name-struct>- -- ptr-size ) /parse-word count ( addr len ) new-struct-name place new-struct-name count \ create the vocabulary for the struct in the 'structs' vocabulary 2dup create-struct-voc ( addr len wid ) \ create a immediate word in current dict. That compiles the \ offset + part inside a definition at runtime dup>r sys-warning? >r sys-warning-off create-struct r> to sys-warning? r> ( wid ) get-current to current-voc also set-current ( -- ) also Structs 0 to _struct \ 1 +to olddepth ; \ create a struct in the dictionary and fill it with zero's \ Note create aligns the memory structures. : mkstruct: ( size-struct <-name-> -- ) create here over allot swap erase ; in-application module \s ---------------------------------------------------------------------------- \ Test \ ----------------------------------------------------------------------------- hex order cr .( def: s1) :struct s1 byte b1 word w1 long l1 ;struct cr .( def: s2) :struct s2 long l1 byte b1 word w1 int i1 ;struct order 0 constant relative cr .( Testing: s1) cr .( sizeof: ) sizeof s1 . cr .( makestruct: ) sizeof s1 mkstruct: struct1 struct1 sizeof s1 dump order s1 order cr .( rel. positions and adresses: ) cr relative b1 . struct1 b1 . cr relative w1 . struct1 w1 . cr relative l1 . struct1 l1 . cr .( fill-struct: ) 11 struct1 b1 c! 2222 struct1 w1 w! 33333333 struct1 l1 ! struct1 sizeof s1 dump previous order cr .( Testing: s2) cr .( sizeof: ) sizeof s2 . cr .( makestruct: ) sizeof s2 mkstruct: struct2 struct2 sizeof s2 dump order s2 order cr .( rel. positions and adresses: ) cr relative l1 . struct2 l1 . cr relative b1 . struct2 b1 . cr relative w1 . struct2 w1 . cr relative i1 . struct2 i1 . cr .( fill-struct: ) 33333333 struct2 l1 ! 11 struct2 b1 c! 2222 struct2 w1 w! 44444444 struct2 i1 ! struct2 sizeof s2 dump previous order cr .( Test compiling of struct-member-offsets ) : test 55 struct1 s1 b1 c! 6666 struct1 s1 w1 w! 77777777 struct1 s1 l1 ! 77777777 struct2 s2 l1 ! 55 struct2 s2 b1 c! 6666 struct2 s2 w1 w! 88888888 struct2 s2 i1 ! ; see test test struct1 sizeof s1 dump struct2 sizeof s2 dump cr .( Test compiling of struct-member-offsets ) : test1 11 struct, struct1 s1 b1 c! 2222 struct, struct1 s1 w1 w! 33333333 struct, struct1 s1 l1 ! 33333333 struct, struct2 s2 l1 ! 11 struct, struct2 s2 b1 c! 2222 struct, struct2 s2 w1 w! 44444444 struct, struct2 s2 i1 ! ; see test1 test1 struct1 sizeof s1 dump struct2 sizeof s2 dump cr .( Test sizeof inside a definition ) : test-sizeof cr ." sizeof s1: " [ sizeof s1 ] literal . cr ." sizeof s2: " [ sizeof s2 ] literal . ; test-sizeof : test-sizeof1 cr ." sizeof s1: " sizeof s1 . cr ." sizeof s2: " sizeof s2 . ; test-sizeof1 cr order decimal --- NEW FILE: STRUCT.F --- \ $Id: STRUCT.F,v 1.1 2006/11/13 13:01:37 georgeahubert Exp $ \ For C like structures. needs ExtStruct.f \ Added ulong ushort \ renamed @+ to n+adr@ \ August 22nd, 2001 - 19:23 \ added OFFSET saves calculations \ >STRUCT saves runtime \ changed }STRUCT for better cloning \ January 15th, 2002 - 16:46 removed a bug from _add-struct \ July 13th, 2002 - 16:26 Added Field: \ Donnerstag, Mai 26 2005 dbu - changed mkstruct: to fill the struct with zero's \ May 28th, 2005 - Jos: Adapted for ExtStruct.f cr .( Loading simple C like structures..) cr .( Members of a structure are not in a separate vocabulary.) anew -struct.f \ for Win32Forth in-system also structs \ Members of a structure are not in a separate vocabulary, when struct{ }struct are used. internal : (}struct) previous create forth-wordlist , _struct , \ store the offset/size does> cell+ @ add-struct ; \ get the offset and create a field with it that is itself that offsetword external : }struct sys-warning? >r sys-warning-off (}struct) r> to sys-warning? ; module \ >struct compiles the adress and offset as 1 adress inside a definition : >struct ( -<name-struct>- -<member>- - ) ' execute ' execute postpone literal ; immediate : struct{ ( -- ) also structs 0 to _struct ; previous in-application \ July 13th, 2002 - 13:17 \ Note: next-offset is Forth dependent \ 12 offset next-offset ( 'adr -- next-offset ) \s \ Examples: struct{ \ language LANGID language.LanguageID CHAR language.szDialect[LANG_LEN] }struct language \ There is nothing allocated yet only the positions in memory are defined \ Now it is going to be allocated in two different locations. sizeof language mkstruct: languageTemp1 sizeof language mkstruct: languageTemp2 \ Change language.szDialect[LANG_LEN] of languageTemp1 as follows: 1 languageTemp1 language.szDialect[LANG_LEN] c! cr cr .( The value of languageTemp1 is: ) languageTemp1 language.szDialect[LANG_LEN] c@ . \ The names are a bit longer, this is needed to avoid duplicate names. struct{ \ BitmapFileHeader WORD bfType LONG bfSize WORD bfReserved1 WORD bfReserved2 DWORD bfOffsetBits OFFSET >BitmapInfoHeader }struct BitmapFileHeader struct{ \ BITMAPINFOHEADER DWORD biSize LONG biWidth LONG biHeight WORD biPlanes WORD biBitCount DWORD biCompression DWORD biSizeImage LONG biXPelsPerMeter LONG biYPelsPerMeter DWORD biClrUsed DWORD biClrImportant }struct BITMAPINFOHEADER struct{ \ RGBQUAD BYTE rgbBlue BYTE rgbGreen BYTE rgbRed BYTE rgbReserved }struct RGBQUAD struct{ \ BITMAPINFO BitmapInfoHeader pbmiBitmapInfoHeader offset pbmiColors sizeof RGBQUAD 256 * _add-struct }struct bitmapinfo sizeof bitmapinfo mkstruct: pbmi cr .( The size of bitmapinfo is: ) sizeof bitmapinfo . : test cr ." A member can be compiled as an adress." 2 >struct pbmi biWidth ! cr ." The color array starts at: " >struct pbmi pbmiColors . cr >struct pbmi biWidth @ . ; cr see test test \s |
|
From: Alex M. <ale...@us...> - 2006-11-13 00:49:31
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv682 Modified Files: gkernel.f gkernext.f Log Message: arm: support for type system; :noname colon-sys is xt Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** gkernel.f 5 Nov 2006 23:34:42 -0000 1.24 --- gkernel.f 13 Nov 2006 00:49:28 -0000 1.25 *************** *** 2311,2314 **** --- 2311,2317 ---- : >ffa@ ( nfa -- ffa ) n>ffa @ ; \ get the file field + : tfa! ( type -- ) \ set the type + last @ n>tfa c! ; + \ --------------------------- Compiling words ------------------------------- *************** *** 2422,2425 **** --- 2425,2437 ---- : (copy-code) ( addr -- ) count copy-code ; \ routine to copy the code + : xt-inline, ( xt -- ) \ inline the xt + dup >name n>ofa \ get the length + w@ copy-code ; \ and copy the code + + : inline ( -- ) \ code will be inlined + tail-call 0= if \ there's a tail-call, so not inlineable + ['] xt-inline, compiles-last + then ; + \ ---------------------------- Defining Words -------------------------------- *************** *** 2430,2433 **** --- 2442,2446 ---- 5 constant tdef 6 constant tloc + 7 constant tcol : mov-tos,#n ( n -- ) \ generate a mov eax, # n *************** *** 2453,2457 **** : dogen ( xt type-of-name <-name-> -- ) \ generate do code header \ header ! last @ n>tfa c! \ set the type here mov-ecx,#n xt-jmp, \ name -> mov ecx, # here | jmp xt ofa-calc \ length calculation --- 2466,2470 ---- : dogen ( xt type-of-name <-name-> -- ) \ generate do code header \ header ! tfa! \ set the type here mov-ecx,#n xt-jmp, \ name -> mov ecx, # here | jmp xt ofa-calc \ length calculation *************** *** 4514,4518 **** 0 value localstk \ support for locals (including localalloc) ! : unnest ( -- ) \ generate a return $c3 code-c, ; immediate --- 4527,4531 ---- 0 value localstk \ support for locals (including localalloc) ! : unnest ( -- ) \ generate a return $c3 code-c, ; immediate *************** *** 4559,4577 **** ofa (ofa-calc) ; ! |: (;noname) ( -- ) \ ; internal postpone exit \ this may compile _localfree postpone [ ?csp \ stop compiling, check stack ; - |: ;noname ( -- ) \ ; for :noname - (;noname) - postpone unnest \ extra ret to stop see (ret ret is end of definition) - latestxt @ - ; - |: ;name ( -- ) \ ; for : ! (;noname) ! ofa-calc \ length calculation ! postpone unnest \ extra ret to stop see (ret ret is end of definition) reveal ; \ reveal the name --- 4572,4583 ---- ofa (ofa-calc) ; ! |: ;noname ( -- ) \ ; for :noname postpone exit \ this may compile _localfree postpone [ ?csp \ stop compiling, check stack ; |: ;name ( -- ) \ ; for : ! ;noname ! ofa 1+ (ofa-calc) \ length calculation (don't include the ret) reveal ; \ reveal the name *************** *** 4581,4585 **** |: (:noname) ( xt -- ) \ defining for headerless - is ; \ set the ; word 0 to localstk \ clear locals stack counter 0 to tail-call \ will be non-zero if we have any calls --- 4587,4590 ---- *************** *** 4591,4601 **** ['] xt-call, code-, \ the comp field -cell code-, \ ptr to the comp field ! code-here latestxt ! \ the xt ! ['] ;noname (:noname) \ set the noname ; word ; : : ( -<name>- -- ) \ forth's primary function defining word header hide ! ['] ;name (:noname) \ set the named ; word ; --- 4596,4609 ---- ['] xt-call, code-, \ the comp field -cell code-, \ ptr to the comp field ! code-here dup latestxt ! \ the xt, leave a copy on the stack (colon-sys) ! ['] ;noname is ; \ set the noname ; word ! (:noname) ; : : ( -<name>- -- ) \ forth's primary function defining word header hide ! tcol tfa! \ type is a colon-def ! ['] ;name is ; \ set the named ; word ! (:noname) ; *************** *** 4846,4850 **** header code-here swap voc>vxt ! \ set the xt for this name mov-ecx,#n ['] dovoc xt-jmp, \ set ecx, jmp to dovoc ! postpone unnest postpone unnest ; --- 4854,4858 ---- header code-here swap voc>vxt ! \ set the xt for this name mov-ecx,#n ['] dovoc xt-jmp, \ set ecx, jmp to dovoc ! postpone unnest ; *************** *** 5365,5369 **** >local "header \ build a header ! tloc last @ n>tfa c! \ mark as a local local> localstk cells [ local-ptrs cell- ] literal \ table is zero offset --- 5373,5377 ---- >local "header \ build a header ! tloc tfa! \ mark as a local local> localstk cells [ local-ptrs cell- ] literal \ table is zero offset *************** *** 5503,5506 **** --- 5511,5515 ---- : defer ( -<name>- ) \ create a deferred word header \ create a defer + tdef tfa! \ set as type=defer jmp[], ['] defer-err , \ the jump ofa-calc \ length calculation Index: gkernext.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernext.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** gkernext.f 24 Oct 2006 12:41:54 -0000 1.2 --- gkernext.f 13 Nov 2006 00:49:28 -0000 1.3 *************** *** 80,84 **** a; ofa-calc \ resolve the optimizer field address ! ret ret \ double ret to stop decompiler ;macro --- 80,84 ---- a; ofa-calc \ resolve the optimizer field address ! ret ;macro |
|
From: Alex M. <ale...@us...> - 2006-11-13 00:49:26
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv651 Modified Files: dis486.f optinline.f optliterals.f Log Message: arm: support for type system; :noname colon-sys is xt Index: dis486.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/dis486.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** dis486.f 4 Oct 2006 10:27:22 -0000 1.4 --- dis486.f 13 Nov 2006 00:49:19 -0000 1.5 *************** *** 1065,1102 **** repeat 3drop ; ! : next? ( a1 -- f1 ) ! next-seq count tuck compare ; ! : rest ( -- ) ! begin ! dup cr inst ! start/stop ! swap next? 0= \ NEXT ? ! until drop ; ! : see ( -- ) defined ?missing ! dup >name n>ofa w@ over + \ length to disassemble swap begin ! 2dup - 0> over next? 0= or \ anything left? while cr inst start/stop repeat ." ( end )" 2drop ; ! hidden ! ! decimal ! ! forth definitions ! ! : rest rest ; ! : see see ; ! ! ONLY FORTH ALSO DEFINITIONS ! --- 1065,1109 ---- repeat 3drop ; + + \ create ttable + \ tval , ," value" + \ tvar + \ tcon + \ tusr + \ tdef + \ tloc + \ tcol ! ! : desc-stack ( n -- ) ! dup 0< if drop ." ? " else . then ; ! ! also forth definitions ! : describe ( xt -- ) ! >name cr ! dup ." : " count type ! dup (in/out@) swap ! ." ( " desc-stack ! ." -- " desc-stack ! dup ." ) "oper-col ." ( len=" n>ofa w@ . ! dup ." type=" n>tfa c@ . ! ." flag=" n>flg c@ h.2 ." )" ; ! : see ( <name> -- ) defined ?missing ! dup describe ! dup >name n>ofa w@ over + \ length to disassemble swap begin ! 2dup - 0> \ anything left? while cr inst start/stop repeat + next-inst c@ $c3 = if cr inst then ." ( end )" 2drop ; ! only forth also definitions Index: optliterals.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optliterals.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** optliterals.f 5 Nov 2006 23:34:56 -0000 1.8 --- optliterals.f 13 Nov 2006 00:49:19 -0000 1.9 *************** *** 36,42 **** [undefined] optimise [if] vocabulary optimise - : xt-inline, ( xt -- ) \ inline the xt - dup >name n>ofa \ get the length - w@ copy-code ; \ and copy the code [then] --- 36,39 ---- *************** *** 76,84 **** )) ! :noname drop 4 postpone literal ; compiles-for cell :noname drop postpone cell postpone + ; compiles-for cell+ :noname drop postpone -cell postpone + ; compiles-for cell- :noname drop postpone cells postpone + ; compiles-for cells+ :noname drop 1 postpone literal postpone - ; compiles-for 1- :noname drop 1 postpone literal postpone + ; dup compiles-for 1+ compiles-for char+ --- 73,83 ---- )) ! :noname drop cell postpone literal ; compiles-for cell :noname drop postpone cell postpone + ; compiles-for cell+ :noname drop postpone -cell postpone + ; compiles-for cell- :noname drop postpone cells postpone + ; compiles-for cells+ :noname drop 1 postpone literal postpone - ; compiles-for 1- + :noname drop 2 postpone literal postpone - ; compiles-for 2- + :noname drop 2 postpone literal postpone + ; compiles-for 2+ :noname drop 1 postpone literal postpone + ; dup compiles-for 1+ compiles-for char+ *************** *** 161,167 **** drop lits spush ; \ the xt is of literal, just loose it - : execpush ( xt -- ) \ execute op and save result - execute lits spush ; - : lits=1? ( -- n ) lits sdepth 1 = ; : lits>0? ( -- n ) lits sdepth ; --- 160,163 ---- *************** *** 170,182 **** variable in-sync in-sync off \ to stop recursion in sync-code ! : litsync ( -- ) \ called when code is about to be generated in-sync @ 0= if \ recursing? in-sync on \ no, so set std-adjust ! lits>0? dup if \ anything to do? ! -4 mov-n[ebp],tos \ save tos ! lits spop #n->tos \ load tos ! lits sdepth 0 ?do \ do for n-1 entries ! lits spop over i - #n->std[] \ generate a move loop --- 166,178 ---- variable in-sync in-sync off \ to stop recursion in sync-code ! : litsync ( -- ) \ called when code is about to be generated in-sync @ 0= if \ recursing? in-sync on \ no, so set std-adjust ! lits>0? dup if \ anything to do? ! -4 mov-n[ebp],tos \ save tos ! lits spop 0 #n->std[] \ load tos ! lits sdepth 0 ?do \ do for n-1 entries ! lits spop over i - #n->std[] \ generate a move loop *************** *** 191,195 **** ' litsync is sync-code ! : opt/ ( xt -- ) lits>1? if lits s2pop swap rot execpush else xt-inline, then ; : opt= sub-tos,#n setcc ; --- 187,191 ---- ' litsync is sync-code ! : opt/ ( xt -- ) lits>1? if lits s2pop swap rot execute lits spush else xt-inline, then ; : opt= sub-tos,#n setcc ; Index: optinline.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optinline.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** optinline.f 28 Oct 2006 09:07:08 -0000 1.4 --- optinline.f 13 Nov 2006 00:49:19 -0000 1.5 *************** *** 39,54 **** also optimise definitions - : xt-inline, ( xt -- ) \ inline the xt - dup >name n>ofa \ get the length - w@ copy-code ; \ and copy the code - previous definitions also optimise - - : inline ( -- ) \ code will be inlined - tail-call 0= if \ there's a tail-call, so not inlineable - ['] xt-inline, compiles-last - then ; - - definitions \ set some optimisation for constants in the kernel --- 39,43 ---- |
|
From: Alex M. <ale...@us...> - 2006-11-13 00:49:17
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv622 Modified Files: gkernel.exe Log Message: arm: support for type system; :noname colon-sys is xt Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 Binary files /tmp/cvs3FxqkZ and /tmp/cvslJguYY differ |
|
From: George H. <geo...@us...> - 2006-11-08 11:11:29
|
Update of /cvsroot/win32forth/win32forth/src/old In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10486/win32forth/src/old Modified Files: Compat.f Log Message: gah:Corrected some spelling Index: Compat.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/old/Compat.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Compat.f 21 Dec 2004 00:19:11 -0000 1.1 --- Compat.f 8 Nov 2006 11:11:25 -0000 1.2 *************** *** 1,4 **** \ Compat.f ! \ Here you'll find Words witch are removed from Win32Forth for some reason only forth also definitions --- 1,4 ---- \ Compat.f ! \ Here you'll find Words which were removed from Win32Forth for some reason only forth also definitions |
|
From: George H. <geo...@us...> - 2006-11-08 11:11:29
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10486/win32forth/src Modified Files: CHILDWND.F CONTROL.F Window.f Log Message: gah:Corrected some spelling Index: Window.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Window.f,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** Window.f 5 Jun 2006 07:37:15 -0000 1.16 --- Window.f 8 Nov 2006 11:11:24 -0000 1.17 *************** *** 69,73 **** \ Note: this ivar was moved here form the child-window class some \ time ago. Altough it's not realy needed in the window class I ! \ left it here in order not to brake to mutch code (Sonntag, Juni 04 2006 dbu). int hWndParent \ handle of the parent window (added Sonntag, Juni 04 2006 dbu) int mydialoglink --- 69,73 ---- \ Note: this ivar was moved here form the child-window class some \ time ago. Altough it's not realy needed in the window class I ! \ left it here in order not to break too much code (Sonntag, Juni 04 2006 dbu). int hWndParent \ handle of the parent window (added Sonntag, Juni 04 2006 dbu) int mydialoglink Index: CHILDWND.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CHILDWND.F,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** CHILDWND.F 11 Jun 2006 07:37:26 -0000 1.8 --- CHILDWND.F 8 Nov 2006 11:11:24 -0000 1.9 *************** *** 21,25 **** \ Note: this ivar was moved into the window class some time ago. \ Altough it's not realy needed in the window class I (dbu) left ! \ it there in oder not to brake to mutch code (Sonntag, Juni 04 2006 dbu). :M ClassInit: ( -- ) --- 21,25 ---- \ Note: this ivar was moved into the window class some time ago. \ Altough it's not realy needed in the window class I (dbu) left ! \ it there in order not to break too much code (Sonntag, Juni 04 2006 dbu). :M ClassInit: ( -- ) Index: CONTROL.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CONTROL.F,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** CONTROL.F 11 Jun 2006 07:37:27 -0000 1.7 --- CONTROL.F 8 Nov 2006 11:11:24 -0000 1.8 *************** *** 47,51 **** \ Support for displaying tool tips; used by the oldstyle buttonbars (e.g. in WinEd). ! \ Since we have a mutch better toolbar class in Win32Forth for some time now, I \ (dbu) didn't spend the time to see how this works. And so I didn't document it. --- 47,51 ---- \ Support for displaying tool tips; used by the oldstyle buttonbars (e.g. in WinEd). ! \ Since we have a much better toolbar class in Win32Forth for some time now, I \ (dbu) didn't spend the time to see how this works. And so I didn't document it. *************** *** 222,226 **** \ Support for displaying tool tips; used by the oldstyle buttonbars (e.g. in WinEd). ! \ Since we have a mutch better toolbar class in Win32Forth for some time now, I \ (dbu) didn't spend the time to see how this works. And so I didn't document it. --- 222,226 ---- \ Support for displaying tool tips; used by the oldstyle buttonbars (e.g. in WinEd). ! \ Since we have a much better toolbar class in Win32Forth for some time now, I \ (dbu) didn't spend the time to see how this works. And so I didn't document it. |
|
From: George H. <geo...@us...> - 2006-11-08 11:11:29
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10486/win32forth/src/tools Modified Files: DexH-Glossary.f DexH.f HelpSystem.f Log Message: gah:Corrected some spelling Index: DexH-Glossary.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/DexH-Glossary.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** DexH-Glossary.f 7 Feb 2006 16:58:33 -0000 1.4 --- DexH-Glossary.f 8 Nov 2006 11:11:25 -0000 1.5 *************** *** 307,312 **** 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) --- 307,312 ---- output-string ; ! : print-file-name ( #anchor -- ) ! \ Write the name of input file with the anchor into the output file. [char] " output-char $infile lcount (output-string) *************** *** 315,325 **** [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 --- 315,325 ---- [char] " output-char ; ! : process-word ( #anchor addr len -- ) \ *G Process on line of the input file. ?dup if parse-line if set-class-name ! print-definition-type output-sep ( #anchor ) ! print-class-name output-sep ( #anchor ) print-file-name output-cr ( -- ) else drop Index: HelpSystem.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/HelpSystem.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** HelpSystem.f 3 Aug 2006 13:08:22 -0000 1.9 --- HelpSystem.f 8 Nov 2006 11:11:25 -0000 1.10 *************** *** 139,143 **** 260 LocalAlloc: dir$ 0 dir$ ! 260 LocalAlloc: ret$ 0 ret$ ! ! addr len 2dup [char] # scan nip - \ get html-filename without #<ancor name> asciiz ret$ dir$ rot call FindExecutable 32 > \ get the default browser if 1024 LocalAlloc: cmd$ --- 139,143 ---- 260 LocalAlloc: dir$ 0 dir$ ! 260 LocalAlloc: ret$ 0 ret$ ! ! addr len 2dup [char] # scan nip - \ get html-filename without #<anchor name> asciiz ret$ dir$ rot call FindExecutable 32 > \ get the default browser if 1024 LocalAlloc: cmd$ Index: DexH.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/DexH.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** DexH.f 7 Nov 2006 11:24:29 -0000 1.6 --- DexH.f 8 Nov 2006 11:11:25 -0000 1.7 *************** *** 250,254 **** CREATE $infile max$ 2 CELLS + ALLOT \ file name ! 0 value #gl-ancor : switchfolder ( -- ) \ Set new output folder --- 250,254 ---- CREATE $infile max$ 2 CELLS + ALLOT \ file name ! 0 value #gl-anchor : switchfolder ( -- ) \ Set new output folder *************** *** 264,268 **** S" .htm" XPAD R@ CHARS + SWAP MOVE \ add file extension xpad R@ 4 CHARS + $infile lplace \ save file name ! 0 to #gl-ancor \ reset ancor XPAD R> 4 CHARS + w/o ; --- 264,268 ---- S" .htm" XPAD R@ CHARS + SWAP MOVE \ add file extension xpad R@ 4 CHARS + $infile lplace \ save file name ! 0 to #gl-anchor \ reset anchor XPAD R> 4 CHARS + w/o ; *************** *** 295,301 **** then ; ! : gl-ancor ( -- ) ! \ *G Write ancor number. ! #gl-ancor s>d (D.) out ; CREATE $line max$ 2 CELLS + ALLOT \ previous line --- 295,301 ---- then ; ! : gl-anchor ( -- ) ! \ *G Write anchor number. ! #gl-anchor s>d (D.) out ; CREATE $line max$ 2 CELLS + ALLOT \ previous line *************** *** 311,315 **** 2dup gl-get-type if IsCloseingClass? 0= ! if $line lplace #gl-ancor $line lcount process-word else 2drop then --- 311,315 ---- 2dup gl-get-type if IsCloseingClass? 0= ! if $line lplace #gl-anchor $line lcount process-word else 2drop then *************** *** 320,329 **** \ *G Create a glossary entry \ cr ." gl-create-entry: " prevline LCOUNT type ! +n gl-ancor -n prevline LCOUNT outh -a create-glossary-file? if prevline LCOUNT gl-entry ! 1 +to #gl-ancor then ; --- 320,329 ---- \ *G Create a glossary entry \ cr ." gl-create-entry: " prevline LCOUNT type ! +n gl-anchor -n prevline LCOUNT outh -a create-glossary-file? if prevline LCOUNT gl-entry ! 1 +to #gl-anchor then ; |
|
From: George H. <geo...@us...> - 2006-11-07 11:58:32
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18272/win32forth/doc Modified Files: p-float.htm Log Message: gah:Corrected spelling of separate |
|
From: George H. <geo...@us...> - 2006-11-07 11:24:34
|
Update of /cvsroot/win32forth/win32forth/apps/WinEd In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4742/win32forth/apps/WinEd Modified Files: Ed_Version.F Log Message: gah:Corrected spelling of separate Index: Ed_Version.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/WinEd/Ed_Version.F,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Ed_Version.F 18 Oct 2006 15:58:28 -0000 1.5 --- Ed_Version.F 7 Nov 2006 11:24:27 -0000 1.6 *************** *** 216,220 **** - made it easier to debug WinEd (see: WinEdDbg) - Moved the code for the menu, status- and toolbar ! to seperate files. dbu September 12th, 2003 - Path's are now absolute in the hyperlink ndx-files. --- 216,220 ---- - made it easier to debug WinEd (see: WinEdDbg) - Moved the code for the menu, status- and toolbar ! to separate files. dbu September 12th, 2003 - Path's are now absolute in the hyperlink ndx-files. |
|
From: George H. <geo...@us...> - 2006-11-07 11:24:33
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4742/win32forth/src Modified Files: FLOAT.F Log Message: gah:Corrected spelling of separate Index: FLOAT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v retrieving revision 1.46 retrieving revision 1.47 diff -C2 -d -r1.46 -r1.47 *** FLOAT.F 2 Oct 2006 11:45:34 -0000 1.46 --- FLOAT.F 7 Nov 2006 11:24:29 -0000 1.47 *************** *** 276,280 **** endm ! \ makro to copy ST(0) on the seperate float stack macro: (FPU>) fsp-cached? 0= if --- 276,280 ---- endm ! \ makro to copy ST(0) on the separate float stack macro: (FPU>) fsp-cached? 0= if *************** *** 285,289 **** ! \ macro to move ST(0) on the seperate float stack macro: FPU> (FPU>) --- 285,289 ---- ! \ macro to move ST(0) on the separate float stack macro: FPU> (FPU>) *************** *** 291,295 **** endm ! \ makro to move the top of the seperate float stack into st(0) macro: >FPU fsp-cached? 0= if --- 291,295 ---- endm ! \ makro to move the top of the separate float stack into st(0) macro: >FPU fsp-cached? 0= if *************** *** 300,304 **** endm ! \ makro to copy the top of the seperate float stack into st(0) macro: (>FPU) >FPU --- 300,304 ---- endm ! \ makro to copy the top of the separate float stack into st(0) macro: (>FPU) >FPU *************** *** 306,310 **** endm ! \ macro to move the top 2 values from the seperate float stack into st(0) and st(1) macro: 2>FPU >FPU >FPU --- 306,310 ---- endm ! \ macro to move the top 2 values from the separate float stack into st(0) and st(1) macro: 2>FPU >FPU >FPU |
|
From: George H. <geo...@us...> - 2006-11-07 11:24:33
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4742/win32forth/src/console Modified Files: BasicWin.f WinBase.f Log Message: gah:Corrected spelling of separate Index: WinBase.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/WinBase.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** WinBase.f 3 Oct 2006 07:44:22 -0000 1.4 --- WinBase.f 7 Nov 2006 11:24:29 -0000 1.5 *************** *** 51,55 **** - added TTM_UPDATETIPTEXT, TTM_ENUMTOOLS & TTM_GETTEXT 19981117 ! - Seperated window classes into their own file (BasicWin.f) - Simplified definitions for zCount and MAKELONG - Factored ?WinError, but it still looks too complicated --- 51,55 ---- - added TTM_UPDATETIPTEXT, TTM_ENUMTOOLS & TTM_GETTEXT 19981117 ! - separated window classes into their own file (BasicWin.f) - Simplified definitions for zCount and MAKELONG - Factored ?WinError, but it still looks too complicated Index: BasicWin.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/BasicWin.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** BasicWin.f 14 May 2006 10:46:19 -0000 1.4 --- BasicWin.f 7 Nov 2006 11:24:29 -0000 1.5 *************** *** 49,53 **** - Changed ?WinError to DROP in Enable: & Disable: methods 19981117 ! - Seperated these from WinBase.f where they had been defined. - General cosmetic updates - Added some validity checking to PutHandle: and Destroy: --- 49,53 ---- - Changed ?WinError to DROP in Enable: & Disable: methods 19981117 ! - separated these from WinBase.f where they had been defined. - General cosmetic updates - Added some validity checking to PutHandle: and Destroy: |
|
From: George H. <geo...@us...> - 2006-11-07 11:24:33
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4742/win32forth/src/tools Modified Files: DexH.f Log Message: gah:Corrected spelling of separate Index: DexH.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/DexH.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** DexH.f 6 Feb 2006 17:48:18 -0000 1.5 --- DexH.f 7 Nov 2006 11:24:29 -0000 1.6 *************** *** 42,46 **** internal ! \ Set to true when a seperate glossary.txt should be created \ Still work in progress... (dbu) 1 value create-glossary-file? --- 42,46 ---- internal ! \ Set to true when a separate glossary.txt should be created \ Still work in progress... (dbu) 1 value create-glossary-file? |
|
From: George H. <geo...@us...> - 2006-11-07 11:08:43
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv30876/win32forth-stc/src Modified Files: float.f Log Message: gah:Corrected spelling of separate Index: float.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/float.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** float.f 4 Nov 2006 11:19:10 -0000 1.4 --- float.f 7 Nov 2006 11:08:39 -0000 1.5 *************** *** 201,205 **** 0 value fsp-adjust ! \ makro to copy ST(0) on the seperate float stack macro: (FPU>) fsp-cached? 0= if --- 201,205 ---- 0 value fsp-adjust ! \ makro to copy ST(0) on the separate float stack macro: (FPU>) fsp-cached? 0= if *************** *** 210,214 **** ! \ makro to move ST(0) on the seperate float stack macro: FPU> (FPU>) --- 210,214 ---- ! \ makro to move ST(0) on the separate float stack macro: FPU> (FPU>) *************** *** 216,220 **** endm ! \ makro to move the top of the seperate float stack into st(0) macro: >FPU fsp-cached? 0= if --- 216,220 ---- endm ! \ makro to move the top of the separate float stack into st(0) macro: >FPU fsp-cached? 0= if *************** *** 225,229 **** endm ! \ makro to copy the top of the seperate float stack into st(0) macro: (>FPU) >FPU --- 225,229 ---- endm ! \ makro to copy the top of the separate float stack into st(0) macro: (>FPU) >FPU *************** *** 231,235 **** endm ! \ macro to move the top 2 values from the seperate float stack into st(0) and st(1) macro: 2>FPU >FPU >FPU --- 231,235 ---- endm ! \ macro to move the top 2 values from the separate float stack into st(0) and st(1) macro: 2>FPU >FPU >FPU |
|
From: George H. <geo...@us...> - 2006-11-07 11:04:55
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29335/win32forth-stc/src Modified Files: asmwin32.f primutil.f Log Message: gah:Fix a bug where code definitions wouldn't inline. Modified OFFSET to work with the DOES> and inlined a short word in task.f Index: asmwin32.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/asmwin32.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** asmwin32.f 27 Sep 2006 21:38:36 -0000 1.4 --- asmwin32.f 7 Nov 2006 11:04:50 -0000 1.5 *************** *** 34,38 **** code-header hide !csp init-asm ! code-here to ofa ; ' (_code) is code --- 34,39 ---- code-header hide !csp init-asm ! code-here to ofa ! 0 to tail-call ; ' (_code) is code Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** primutil.f 4 Nov 2006 11:19:10 -0000 1.17 --- primutil.f 7 Nov 2006 11:04:50 -0000 1.18 *************** *** 119,125 **** 0 swap execute postpone literal postpone + ; : offset ( n1 <-name-> -- ) \ compiling ( n2 -- n3 ) \ runtime n3=n1+n2 ! create , ['] (comp-offs) compiles-last does> @ + ; : field+ ( n1 n2 <-name-> -- n3 ) \ compiling n3=n1+n2 stored offset=n1 --- 119,129 ---- 0 swap execute postpone literal postpone + ; + : (offset) ( n1 <-name-> -- ) \ compiling + ( n2 -- n3 ) \ runtime n3=n1+n2 + create , does> @ + ; + : offset ( n1 <-name-> -- ) \ compiling ( n2 -- n3 ) \ runtime n3=n1+n2 ! (offset) ['] (comp-offs) compiles-last ; : field+ ( n1 n2 <-name-> -- n3 ) \ compiling n3=n1+n2 stored offset=n1 *************** *** 138,142 **** : asciiz ( addr len -- z-buf ) ! \ *G Place string addr len in buffer z-buf and null terminate it. Note only one string \ ** per task can used at a time. z-buf ascii-z ; --- 142,146 ---- : asciiz ( addr len -- z-buf ) ! \ *G Place string addr len in buffer z-buf and nuul terminate it. Note only one string \ ** per task can used at a time. z-buf ascii-z ; |
|
From: George H. <geo...@us...> - 2006-11-07 11:04:55
|
Update of /cvsroot/win32forth/win32forth-stc/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29335/win32forth-stc/src/lib Modified Files: task.f Log Message: gah:Fix a bug where code definitions wouldn't inline. Modified OFFSET to work with the DOES> and inlined a short word in task.f Index: task.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/lib/task.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** task.f 30 Oct 2006 09:15:15 -0000 1.2 --- task.f 7 Nov 2006 11:04:50 -0000 1.3 *************** *** 64,68 **** : task>parm@ ( task-block -- parm ) \ W32F Task \ *G Fetch the parameter from the task-block. ! task>parm @ ; \ -------------------- Task Start Initialisation -------------------- --- 64,68 ---- : task>parm@ ( task-block -- parm ) \ W32F Task \ *G Fetch the parameter from the task-block. ! task>parm @ compilation> postpone task>parm postpone @ ; \ -------------------- Task Start Initialisation -------------------- |
|
From: George H. <geo...@us...> - 2006-11-07 11:01:51
|
Update of /cvsroot/win32forth/win32forth-stc/demos In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv27937/win32forth-stc/demos Modified Files: pardemo.f Log Message: gah:Removed definition of ASCII now in primutils.f Index: pardemo.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/demos/pardemo.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** pardemo.f 2 Oct 2006 11:46:51 -0000 1.2 --- pardemo.f 7 Nov 2006 11:01:41 -0000 1.3 *************** *** 1,6 **** needs multithr.f \ 10-4-99 - : ascii char state @ if postpone literal then ; immediate - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Timing Routines \ --- 1,4 ---- |
|
From: Alex M. <ale...@us...> - 2006-11-05 23:35:00
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv27513 Modified Files: optliterals.f Log Message: arm: better optimisation Index: optliterals.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optliterals.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** optliterals.f 31 Oct 2006 00:06:31 -0000 1.7 --- optliterals.f 5 Nov 2006 23:34:56 -0000 1.8 *************** *** 41,49 **** [then] also optimise definitions :noname drop postpone cell postpone + ; compiles-for cell+ :noname drop postpone -cell postpone + ; compiles-for cell- ! :noname drop 1 postpone literal postpone - ; dup compiles-for 1- :noname drop 1 postpone literal postpone + ; dup compiles-for 1+ compiles-for char+ --- 41,84 ---- [then] + code s-reverse ( n[k]..2 1 0 k -- 0 1 2..n[k] ) \ w32f + \ *g reverse n items on stack \n + \ ** usage: 1 2 3 4 5 5 s-reverse ==> 5 4 3 2 1 + lea ecx, -4 [ebp] \ ecx points 4 under top of stack + lea eax, 4 [ecx] [eax*4] \ eax points 4 over stack + \ bump pointers, if they overlap, stop + @@1: sub eax, # 4 \ adjust top + add ecx, # 4 \ adjust bottom + cmp ecx, eax \ compare + jae short @@2 \ ecx passing ebx, so exit + \ rotate a pair + mov edx, 0 [eax] \ bottom to edx + xor 0 [ecx], edx \ exchange top and edx + xor edx, 0 [ecx] + xor 0 [ecx], edx + mov 0 [eax], edx \ eax to bottom + jmp short @@1 \ next pair + + @@2: mov eax, [ebp] + lea ebp, 4 [ebp] + next c; + also optimise definitions + (( no stack effects; needs work + 1 constant nse \ no side effects + + : compiles-nse ( xt -- ) \ compiles-for and no side effects + ' dup>r (compiles-set) \ set the compiling word + r> >name n>flg dup sc@ nse or swap c! ; + + : nse? ( nfa -- flag ) \ is this no side effects? + n>flg c@ nse and ; + )) + + :noname drop 4 postpone literal ; compiles-for cell :noname drop postpone cell postpone + ; compiles-for cell+ :noname drop postpone -cell postpone + ; compiles-for cell- ! :noname drop postpone cells postpone + ; compiles-for cells+ ! :noname drop 1 postpone literal postpone - ; compiles-for 1- :noname drop 1 postpone literal postpone + ; dup compiles-for 1+ compiles-for char+ *************** *** 84,88 **** : mov-n[ebp],tos { off } macro[ mov off [ebp], eax ]macro ; ! macro: std[],# std[] , dword # ;m : #n->std[] { n off } --- 119,123 ---- : mov-n[ebp],tos { off } macro[ mov off [ebp], eax ]macro ; ! macro: std[],# std[] , dword # ;m : #n->std[] { n off } *************** *** 113,116 **** --- 148,152 ---- : shl-tos,#n ( n ) >r macro[ shl r@ tos,#n ]macro r>drop ; : shr-tos,#n ( n ) >r macro[ shr r@ tos,#n ]macro r>drop ; + : sar-tos,#n ( n ) >r macro[ sar r@ tos,#n ]macro r>drop ; : and-tos,#n ( n ) >r macro[ and r@ tos,#n ]macro r>drop ; : or-tos,#n ( n ) >r macro[ or r@ tos,#n ]macro r>drop ; *************** *** 120,123 **** --- 156,160 ---- : loop-add { n } macro[ add [esp], dword # n jno 0 ]macro ; : setcc { } macro[ cmp eax, # 1 sbb eax, eax ]macro ; + : imul-tos,#n ( n ) $C069 code-w, code-, ; \ no opcode for this? imul eax, # n : litstack ( n xt -- ) \ stack literal *************** *** 150,200 **** then ; ! : uniopt ( xt -- ) \ unary ops where 1 literal; execute it ! lits>0? if lits spop swap execpush else xt-inline, then ; ! : binopt ( xt -- ) \ binary ops where 2 literals; execute it ! lits>1? if lits s2pop swap rot execpush else xt-inline, then ; ! ' uniopt compiles-for invert ! ' uniopt compiles-for negate ! ' uniopt compiles-for 0= ! ' uniopt compiles-for not ! ' uniopt compiles-for 0<> ! ' uniopt compiles-for 0< ! ' uniopt compiles-for 0> ! ' uniopt compiles-for cells ! ' binopt compiles-for <> ! ' binopt compiles-for < ! ' binopt compiles-for > ! ' binopt compiles-for <= ! ' binopt compiles-for >= ! ' binopt compiles-for arshift ! ' binopt compiles-for * ! ' binopt compiles-for / : litstart ( xt -- n ) \ drop the xt, get constant drop lits spop sync-code ; - - : opt@ ( xt -- ) lits>0? if litstart push-tos var->tos else xt-inline, then ; - : optc@ ( xt -- ) lits>0? if litstart push-tos cvar->tos else xt-inline, then ; - : optpick ( xt -- ) lits>0? if - litstart push-tos cells dup if - mov-tos,n[ebp] - else drop then - else xt-inline, then ; ! : opt+ ( xt -- ) lits=1? if litstart add-tos,#n else binopt then ; ! : opt- ( xt -- ) lits=1? if litstart sub-tos,#n else binopt then ; ! : optlshift ( xt -- ) lits=1? if litstart shl-tos,#n else binopt then ; ! : optrshift ( xt -- ) lits=1? if litstart shr-tos,#n else binopt then ; ! : optand ( xt -- ) lits=1? if litstart and-tos,#n else binopt then ; ! : optor ( xt -- ) lits=1? if litstart or-tos,#n else binopt then ; ! : optxor ( xt -- ) lits=1? if litstart xor-tos,#n else binopt then ; ! : opt= ( xt -- ) lits=1? if litstart sub-tos,#n setcc else binopt then ; ! : opt<> ( xt -- ) lits=1? if litstart sub-tos,#n setcc not-tos else binopt then ; : opt! ( xt -- ) --- 187,287 ---- then ; + + ' litstack compiles-for literal + ' litsync is sync-code ! : opt/ ( xt -- ) lits>1? if lits s2pop swap rot execpush else xt-inline, then ; ! : opt= sub-tos,#n setcc ; ! : opt<> sub-tos,#n setcc not-tos ; ! : opt< sub-tos,#n postpone 0< ; ! : opt<= 1+ opt< ; ! : opt>= opt< not-tos ; ! : opt> opt<= not-tos ; ! : optswap 1 #n->std[] 1 std+n ; ! create opt-lit-table1 ! \ Only add entries with optimising code, or those with stack effects [...] n -- [...] ! \ where n can be a literal. ! ' + , ' add-tos,#n , ! ' - , ' sub-tos,#n , ! ' * , ' imul-tos,#n , ! ' and , ' and-tos,#n , ! ' or , ' or-tos,#n , ! ' xor , ' xor-tos,#n , ! ' = , ' opt= , ! ' <> , ' opt<> , ! ' < , ' opt< , ! ' <= , ' opt<= , ! ' >= , ' opt>= , ! ' > , ' opt> , ! ' 0= , ' setcc , ! ' 0<> , ' xt-inline, , ! ' 0< , ' xt-inline, , ! ' 0> , ' xt-inline, , ! ' not , ' setcc , ! ' invert , ' xt-inline, , ! ' negate , ' xt-inline, , ! ' lshift , ' shl-tos,#n , ! ' rshift , ' shr-tos,#n , ! ' arshift , ' sar-tos,#n , ! ' cells , ' xt-inline, , ! ' dup , ' xt-inline, , ! ' drop , ' xt-inline, , ! ' swap , ' optswap , ! ' nip , ' xt-inline, , ! 0 , 0 , ! : nseopt ( xt -- ) \ code gen for no-side-effect type words ! dup >name \ xt nfa ! (in/out@) \ get the in/out stack effects ! over lits sdepth <= if \ if we have enough input literals ! >r swap >r \ save the output count & the xt ! dup>r 0 ?do lits spop loop \ get literals onto the stack ! r> s-reverse \ reverse the order ! r> execute \ execute the word ! r> 0 ?do lits spush loop \ push outputs back on literal stack ! exit ! then 2drop \ drop the in/out ! lits>0? if \ might be a single literal operation ! >r opt-lit-table1 \ save xt on rstack, the table ! begin dup @ dup \ fetch the entry ! while ! r@ = if \ if a match ! r> drop \ no longer need the xt ! lits spop sync-code \ pop the literal, sync the code ! swap cell+ @ execute \ get the xt from table, go do ! exit \ and finish ! then ! 2 cells+ \ next entry ! repeat drop \ otherwise just drop it ! then ! xt-inline, ; \ else just inline it ! ! :noname ( -- ) \ set nseopt as the optimiser for specified xts ! ['] nseopt >r \ the optimisation code to run ! opt-lit-table1 \ the table ! begin dup @ dup \ fetch the entry ! while ! r@ swap (compiles-set) ! 2 cells+ \ next entry ! repeat r>drop 2drop ; execute \ do it now : litstart ( xt -- n ) \ drop the xt, get constant drop lits spop sync-code ; ! : optpick ( xt -- ) ! lits>0? if ! litstart push-tos cells dup if ! mov-tos,n[ebp] ! else drop then ! else ! xt-inline, ! then ; ! ! : opt@ ( xt -- ) lits>0? if litstart push-tos var->tos else xt-inline, then ; ! : optc@ ( xt -- ) lits>0? if litstart push-tos cvar->tos else xt-inline, then ; : opt! ( xt -- ) *************** *** 208,212 **** then ; ! : opt+! ( xt -- ) lits=1? if --- 295,299 ---- then ; ! : opt+! ( xt -- ) lits=1? if *************** *** 230,253 **** then ; - - ' litstack compiles-for literal - ' litsync is sync-code ! ' opt+ compiles-for + ! ' opt- compiles-for - ' opt@ compiles-for @ ' optc@ compiles-for c@ ' optpick compiles-for pick - ' optlshift compiles-for lshift - ' optrshift compiles-for rshift - ' optand compiles-for and - ' optor compiles-for or - ' optxor compiles-for xor ' opt! compiles-for ! ' opt+! compiles-for +! ' optc! compiles-for c! - ' opt= compiles-for = - ' opt<> compiles-for <> - previous definitions --- 317,340 ---- then ; ! (( ! create opt-lit-table2 ! \ Entries of the format ( n [ m ] -- x ) where m or n and m can be literals. ! \ First entry is for 1 literal, 2nd for 2. For 0 literals, just inline. ! \ Side effects not allowed ! ! ' @ , opt@-1 , opt@-2 , ! ' c@ , optc@-1 , optc@-2 , ! ' ! , opt!-1 , opt!-2 , ! ' +! , opt+!-1 , opt+!-2 , ! ' c! , optc!-1 , optc!-2 , ! 0 , ! )) ' opt@ compiles-for @ ' optc@ compiles-for c@ ' optpick compiles-for pick ' opt! compiles-for ! ' opt+! compiles-for +! ' optc! compiles-for c! previous definitions |
|
From: Alex M. <ale...@us...> - 2006-11-05 23:34:47
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv27486 Modified Files: gkernel.f Log Message: arm: better optimisation Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** gkernel.f 31 Oct 2006 00:06:53 -0000 1.23 --- gkernel.f 5 Nov 2006 23:34:42 -0000 1.24 *************** *** 1511,1515 **** code * ( n1 n2 -- n3 ) \ multiply n1 by n2, return single result n3 2 1 in/out ! mul dword [ebp] next; --- 1511,1515 ---- code * ( n1 n2 -- n3 ) \ multiply n1 by n2, return single result n3 2 1 in/out ! imul dword [ebp] next; *************** *** 2299,2302 **** --- 2299,2303 ---- -16 offset name>xtptr ( nfa -- xt-ptr ) + -1 offset n>flg ( nfa -- flag ) -2 offset n>tfa ( nfa -- tfa ) -4 offset n>ofa ( nfa -- ofa ) *************** *** 2471,2475 **** 0 1 in/out : create ( -<name>- ) \ pointer ['] dovar tvar dogen ! \ ['] (comp-create) compiles-last \ doesn't work because of DOES> needs fixed ; --- 2472,2476 ---- 0 1 in/out : create ( -<name>- ) \ pointer ['] dovar tvar dogen ! ['] (comp-create) compiles-last \ doesn't work because of DOES> needs fixed ; *************** *** 3570,3574 **** : header ( -<name>- ) \ build a header code-align \ align code section, temporary ! parse-word "header latestxt @ to ofa \ for length calculations of the code generated ; --- 3571,3575 ---- : header ( -<name>- ) \ build a header code-align \ align code section, temporary ! bl word count "header latestxt @ to ofa \ for length calculations of the code generated ; *************** *** 4659,4663 **** : (;code) ( -- ) \ compile code for does> r@ 1+ \ code for does> (after ret) ! last @ name>xt addr-off + dup>r \ xt for create, jump part - cell- \ make relative r> ! \ adjust jump part of xt of create --- 4660,4668 ---- : (;code) ( -- ) \ compile code for does> r@ 1+ \ code for does> (after ret) ! last @ name>xt \ last name created ( xt nfa ) ! dup >ct @ ['] execute <> if \ if this isn't an immediate ! ['] xt-call, over (compiles-set) \ reset the standard compile word ! then ! addr-off + dup>r \ xt for create, jump part - cell- \ make relative r> ! \ adjust jump part of xt of create *************** *** 5944,5956 **** \ -------------------- Various support words -------------------------- : in/out@ ( -- in out ) \ get the ste values ! last @ n>ste ! dup sc@ swap 1+ sc@ ; ! : (in/out) ( in out -- ) \ set the ste values last @ n>ste dup>r 1+ c! r> c! ; ! ' (in/out) alias in/out immediate \ immediate version \ --------------------------------------------------------------------- --- 5949,5963 ---- \ -------------------- Various support words -------------------------- + : (in/out@) ( nfa -- in out ) \ get the ste values + n>ste dup sc@ swap 1+ sc@ ; + : in/out@ ( -- in out ) \ get the ste values ! last @ (in/out@) ; ! : (in/out!) ( in out -- ) \ set the ste values last @ n>ste dup>r 1+ c! r> c! ; ! ' (in/out!) alias in/out immediate \ immediate version \ --------------------------------------------------------------------- |
|
From: Alex M. <ale...@us...> - 2006-11-05 23:34:24
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv27452 Modified Files: gkernel.exe Log Message: arm: better optimisation Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 Binary files /tmp/cvsHPnVJk and /tmp/cvsiNsVXF differ |
|
From: Alex M. <ale...@us...> - 2006-11-05 23:34:13
|
Update of /cvsroot/win32forth/win32forth-stc/demos/benchmarks In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv27201 Modified Files: bench.f Log Message: arm: better optimisation Index: bench.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/demos/benchmarks/bench.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** bench.f 1 Oct 2006 07:38:44 -0000 1.1 --- bench.f 5 Nov 2006 23:34:07 -0000 1.2 *************** *** 283,287 **** : Precedes ( n n - f ) u< ; ! : Exchange ( a1 a2 -- ) 2DUP @ SWAP @ ROT ! SWAP ! ; : Both-Ends ( f l pivot - f l ) --- 283,287 ---- : Precedes ( n n - f ) u< ; ! : Exchange ( a1 a2 -- ) 2DUP @ SWAP @ ROT ! SWAP ! ; : Both-Ends ( f l pivot - f l ) *************** *** 912,916 **** DROP IntLoc IntGlob - TRUE ! UNTIL THEN ; : Proc4 S" 'B' TO Char2Glob " EVALUATE ; IMMEDIATE --- 912,916 ---- DROP IntLoc IntGlob - TRUE ! UNTIL THEN ; : Proc4 S" 'B' TO Char2Glob " EVALUATE ; IMMEDIATE *************** *** 962,966 **** 0 0 0 \ The following must be on ONE line or Win32Forth will crash. ! LOCALS| CharIndex CharLoc EnumLoc IntLoc3 IntLoc2 IntLoc1 String2Loc String1Loc | RecordType TO PtrGlb \ constructor, allocates ! RecordType TO PtrGlbNext --- 962,967 ---- 0 0 0 \ The following must be on ONE line or Win32Forth will crash. ! LOCALS| CharIndex CharLoc EnumLoc ! IntLoc3 IntLoc2 IntLoc1 String2Loc String1Loc | RecordType TO PtrGlb \ constructor, allocates ! RecordType TO PtrGlbNext |
1040 messages has been excluded from this view by a project administrator.
