Menu
▾
▴
[Win32forth-cvs] win32forth/src Boot.f, 1.8, 1.9 CONTROL.F, 1.15, 1.16 Class.f, 1.45, 1.46 Extend.f, 1.32, 1.33 Pre-save.f, 1.8, 1.9 Primutil.f, 1.66, 1.67 Utils.f, 1.31, 1.32
|
From: George H. <geo...@us...> - 2013-12-09 21:25:19
|
Update of /cvsroot/win32forth/win32forth/src In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv31062 Modified Files: Boot.f CONTROL.F Class.f Extend.f Pre-save.f Primutil.f Utils.f Log Message: Moved some memory allocation initialisation to pre-save, moved class pointers and data for heap objects down by 1 cell. Made able to build V7.xx.xx conditionally (V7.xx.xx requires win2000 or above) Index: Boot.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Boot.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** Boot.f 15 Nov 2013 19:35:02 -0000 1.8 --- Boot.f 9 Dec 2013 21:25:16 -0000 1.9 *************** *** 10,16 **** --- 10,18 ---- \ -rbs make shell work in other drives : set-shell + [ version# ((version)) 0. 2swap >number 3drop 7 < ] [if] \ For V6.xx.xx suporting older OSs winver winnt351 >= if s" CMD.EXE " else s" c:\command.com " then + [else] s" CMD.EXE" [then] 2dup dos$ place shell$ place s" /c " shell$ +place ; Index: Extend.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Extend.f,v retrieving revision 1.32 retrieving revision 1.33 diff -C2 -d -r1.32 -r1.33 *** Extend.f 15 Nov 2013 19:35:03 -0000 1.32 --- Extend.f 9 Dec 2013 21:25:16 -0000 1.33 *************** *** 14,17 **** --- 14,19 ---- sys-FLOAD src\module.f \ scoping support for modules sys-FLOAD src\interpif.f \ interpretive conditionals + FLOAD src\WinVersion.f \ Windows Versioning + FLOAD src\paths.f \ multi path support words *************** *** 117,121 **** fload lib\Resources.f ! winver winnt4 >= [if] &forthdir count pad place --- 119,124 ---- fload lib\Resources.f ! version# ((version)) 0. 2swap >number 3drop 7 < dup [if] winver winnt4 < and [then] 0= ! [if] &forthdir count pad place *************** *** 128,132 **** false EndUpdate ! [else] s" src\res\Win32For.ico" s" Win32for.exe" AddAppIcon [then] --- 131,135 ---- false EndUpdate ! [else] \ For V6.xx.xx older OSs s" src\res\Win32For.ico" s" Win32for.exe" AddAppIcon [then] Index: Utils.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Utils.f,v retrieving revision 1.31 retrieving revision 1.32 diff -C2 -d -r1.31 -r1.32 *** Utils.f 15 Nov 2013 19:35:03 -0000 1.31 --- Utils.f 9 Dec 2013 21:25:16 -0000 1.32 *************** *** 56,59 **** --- 56,60 ---- cr ." Platform: Windows " winver case + [ version# ((version)) 0. 2swap >number 3drop 7 < ] [if] \ For V6.xx.xx suporting older OSs WIN95 of ." 95" endof WIN98 of ." 98" endof *************** *** 61,65 **** WINNT351 of ." NT3.51" endof WINNT4 of ." NT4" endof ! WIN2K of ." 2000" endof WINXP of ." XP" endof WIN2003 of ." SERVER 2003 R2" endof --- 62,66 ---- WINNT351 of ." NT3.51" endof WINNT4 of ." NT4" endof ! [then] WIN2K of ." 2000" endof WINXP of ." XP" endof WIN2003 of ." SERVER 2003 R2" endof Index: Class.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v retrieving revision 1.45 retrieving revision 1.46 diff -C2 -d -r1.45 -r1.46 *** Class.f 20 Nov 2013 12:28:36 -0000 1.45 --- Class.f 9 Dec 2013 21:25:16 -0000 1.46 *************** *** 417,425 **** dLen cell+ idWid ! IF idWid #els * cell+ + \ get total length of obj THEN malloc ! theClass over ! \ create the class ptr ! cell+ to obAddr \ get nonReloc heap, save ptr to cfa idWid IF obAddr dLen + idWid over w! 2 + #els swap w! --- 417,425 ---- dLen cell+ idWid ! IF idWid #els * ( cell+ ) + \ get total length of obj THEN malloc ! theClass over cell- ! \ create the class ptr ! ( cell+ ) to obAddr \ get nonReloc heap, save ptr to cfa idWid IF obAddr dLen + idWid over w! 2 + #els swap w! *************** *** 1301,1305 **** : Dispose ( addr -- ) \ *G Dispose of a dynamically allocated object. ! ~: [ dup>r ] r> cell- Free THROW_DISPOSE_ERR ?throw ; \ -------------------------------------------------------------------- --- 1301,1305 ---- : Dispose ( addr -- ) \ *G Dispose of a dynamically allocated object. ! ~: [ dup>r ] r> ( cell- ) Free THROW_DISPOSE_ERR ?throw ; \ -------------------------------------------------------------------- Index: Pre-save.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Pre-save.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** Pre-save.f 28 Nov 2013 20:51:55 -0000 1.8 --- Pre-save.f 9 Dec 2013 21:25:16 -0000 1.9 *************** *** 69,76 **** : pre-init-system-locks-off ( -- ) ! \ *G Set all the system deferred words for locking and unlocking (except (memlock) and ! \ ** (memunlock) which are set by the kernel) to noops in the image. This is done for ! \ ** the system so that at start-up code that uses them will work correctly before the locks ! \ ** are initialised. ['] noop is-image (controllock) ['] noop is-image (controlunlock) --- 69,76 ---- : pre-init-system-locks-off ( -- ) ! \ *G Set all the system deferred words for locking and unlocking to noops in the image. ! \ ** This is done for the system so that at start-up code that uses ! \ ** them will work correctly before the locks are initialised. ! \ ** Also the allocated memory link is zeroed. ['] noop is-image (controllock) ['] noop is-image (controlunlock) *************** *** 85,88 **** --- 85,91 ---- ['] noop is-image (gdilock) ['] noop is-image (gdiunlock) + ['] noop is-image (memlock) + ['] noop is-image (memunlock) + 0 malloc-link >image ! ; Index: Primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v retrieving revision 1.66 retrieving revision 1.67 diff -C2 -d -r1.66 -r1.67 *** Primutil.f 28 Nov 2013 20:51:55 -0000 1.66 --- Primutil.f 9 Dec 2013 21:25:16 -0000 1.67 *************** *** 728,812 **** reset-stack-chain do-chain ; is reset-stacks \ install in kernel word - \ ---------------- Operating System Checking -------------------------- - - 1 PROC GetVersionEx - - 1 constant win95 - 2 constant win98 - 3 constant winme - 4 constant winnt351 - 5 constant winnt4 - 6 constant win2k - 7 constant winxp - 8 constant win2003 \ Windows Server 2003 R2 - 9 constant winvista \ Windows Vista - 10 constant win2008 \ Windows Server 2008 - 11 constant win2008r2 \ Windows Server 2008 R2 - 12 constant win7 \ Windows 7 - 13 constant win8 \ Windows 8 - - \ To check for a version, say Win2K or greater, try WINVER WIN2K >= - - 0 value winver - - : winver-init ( -- ) \ get windows version - 156 dup _localalloc dup>r ! \ set length of OSVERSIONINFOEX structure - r@ call GetVersionEx \ call os for version - dup 0= if drop 148 r@ ! r@ call GetVersionEx then \ try lower size for win98FE (and possibly win95) - 0= abort" call failed" - r@ 4 cells+ @ \ get osplatformid - case - 1 of \ 95, 98, and me - r@ 2 cells+ @ \ minorversion - case - 0 of win95 endof \ 95 - 10 of win98 endof \ 98 - 90 of winme endof \ me - endcase - endof - - 2 of \ nt, 2k, xp - r@ cell+ @ \ majorversion - case - 3 of winnt351 endof \ nt351 - 4 of winnt4 endof \ nt4 - 5 of - r@ 2 cells+ @ \ minor version - case - 0 of win2k endof \ win2k - 1 of winxp endof \ winxp - 2 of win2003 endof \ 2003 - endcase - endof - 6 of - r@ 2 cells+ @ \ minor version - case - 0 of r@ 154 + c@ \ Product Type - VER_NT_WORKSTATION = if winvista \ Windows Vista - else win2008 \ Windows Server 2008 - then - endof - 1 of r@ 154 + c@ \ Product Type - VER_NT_WORKSTATION = if win7 \ Windows 7 - else win2008r2 \ Windows Server 2008 R2 - then - endof - 2 of r@ 154 + c@ \ Product Type - VER_NT_WORKSTATION = if win8 \ Windows 8 - else win2008r2 \ Windows Server 2008 R2 - then - endof - drop -2 dup \ unknown product Type - endcase - endof - drop -1 dup \ unknown windows version - endcase - endof - endcase to winver - rdrop _localfree - ; - - initialization-chain chain-add winver-init - winver-init \ -------------------- Load Standard Libraries -------------------- --- 728,731 ---- Index: CONTROL.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CONTROL.F,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** CONTROL.F 28 Nov 2013 20:51:55 -0000 1.15 --- CONTROL.F 9 Dec 2013 21:25:16 -0000 1.16 *************** *** 100,105 **** int title \ the counted title string int handleofparent \ the frame window handle ! int Horizontal ! int Vertical ' wStatus0 alias timering? \ are we opening a popup info window ' wStatus1 alias timerclosed? \ has popup been closed --- 100,105 ---- int title \ the counted title string int handleofparent \ the frame window handle ! short Horizontal ! short Vertical ' wStatus0 alias timering? \ are we opening a popup info window ' wStatus1 alias timerclosed? \ has popup been closed |
