Menu
▾
▴
[Win32forth-cvs] win32forth/src Menu.f, 1.9, 1.10 Pre-save.f, 1.3, 1.4 Primutil.f, 1.57, 1.58 imageman.f, 1.29, 1.30
|
From: George H. <geo...@us...> - 2013-03-08 20:43:07
|
Update of /cvsroot/win32forth/win32forth/src In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv19404 Modified Files: Menu.f Pre-save.f Primutil.f imageman.f Log Message: Finished moving words. Now turnkeys can have a dos console (like setup.exe) but not the GUI based one (lot's of things in that are still in-system). Minor corrections Index: Pre-save.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Pre-save.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Pre-save.f 7 Mar 2013 15:29:02 -0000 1.3 --- Pre-save.f 8 Mar 2013 20:43:04 -0000 1.4 *************** *** 3,6 **** --- 3,8 ---- in-system + Require Imageman.f + : Trim-image-list ( addr -- ) \ *G Given the head of a list or chain remove all those items not in the image. *************** *** 32,41 **** : Init?EnableConsoleMessages ( -- ) ! ['] noop ['] ?EnableConsoleMessages >image >body ! ; pre-save-image-chain chain-add Init?EnableConsoleMessages - in-previous - : PreInitAppID ( -- ) NewAppID &of MyAppID >image ! --- 34,41 ---- : Init?EnableConsoleMessages ( -- ) ! ['] noop is-image ?EnableConsoleMessages ; pre-save-image-chain chain-add Init?EnableConsoleMessages : PreInitAppID ( -- ) NewAppID &of MyAppID >image ! *************** *** 45,46 **** --- 45,48 ---- pre-save-image-chain chain-add PreInitAppID + + in-previous Index: Primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v retrieving revision 1.57 retrieving revision 1.58 diff -C2 -d -r1.57 -r1.58 *** Primutil.f 8 Mar 2013 00:07:53 -0000 1.57 --- Primutil.f 8 Mar 2013 20:43:04 -0000 1.58 *************** *** 836,839 **** --- 836,840 ---- + in-system \ ------------------ switching defered i/o ------------------ *************** *** 869,874 **** ['] k_bye IS bye ; - \ in-system - : DosConsole ( -- ) \ switch to DOS console functions ['] NOOP IS CONSOLE --- 870,873 ---- *************** *** 898,910 **** ['] K_NOOP1 IS &THE-SCREEN ['] NOOP IS SCROLLTOVIEW ! \ reset BYE to default ( althought should have never changed) ['] k_bye IS bye ; in-application \ defered i/o setting for various consoles ! : (NoConsoleBoot) ( -- ) NoConsoleIO ; \ in-system ! : (DosConsoleBoot) ( -- ) DosConsole init-console drop ; defer (ConsoleBoot) ' DosConsole is (ConsoleBoot) --- 897,911 ---- ['] K_NOOP1 IS &THE-SCREEN ['] NOOP IS SCROLLTOVIEW ! \ reset BYE to default ( although should have never changed) ['] k_bye IS bye ; in-application \ defered i/o setting for various consoles ! : (NoConsoleBoot) ( -- ) ( NoConsoleIO ) ; \ in-system ! : (DosConsoleBoot) ( -- ) ( DosConsole ) init-console drop ; ! ! in-system defer (ConsoleBoot) ' DosConsole is (ConsoleBoot) *************** *** 912,918 **** defer (ConsoleHiddenBoot) ' DosConsole is (ConsoleHiddenBoot) ! in-system \ ----------------------------------------------------------------------- --- 913,921 ---- defer (ConsoleHiddenBoot) ' DosConsole is (ConsoleHiddenBoot) + defer PresetConsoleIO ' noop is PresetConsoleIO + pre-save-image-chain chain-add PresetConsoleIO ! \ in-system \ ----------------------------------------------------------------------- *************** *** 1062,1066 **** : init-system-locks-off ( -- ) ! \ *G Set all the system deferred words for locking to noops. This is done automatically \ ** by the system at start-up so code that uses it will work correctly before the locks \ ** are initialised. --- 1065,1070 ---- : 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. This is done automatically \ ** by the system at start-up so code that uses it will work correctly before the locks \ ** are initialised. Index: Menu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Menu.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** Menu.f 14 Feb 2013 20:05:48 -0000 1.9 --- Menu.f 8 Mar 2013 20:43:04 -0000 1.10 *************** *** 492,496 **** :M ClassInit: ( -- ) ClassInit: super ! m"text" ,"text" ;M --- 492,496 ---- :M ClassInit: ( -- ) ClassInit: super ! \in-system-ok m"text" ,"text" ;M *************** *** 510,514 **** :M ClassInit: ( check_flag -- ) ClassInit: super ! m"text" to check_flag ;M --- 510,514 ---- :M ClassInit: ( check_flag -- ) ClassInit: super ! \in-system-ok m"text" to check_flag ;M Index: imageman.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/imageman.f,v retrieving revision 1.29 retrieving revision 1.30 diff -C2 -d -r1.29 -r1.30 *** imageman.f 7 Mar 2013 15:29:02 -0000 1.29 --- imageman.f 8 Mar 2013 20:43:04 -0000 1.30 *************** *** 276,281 **** ; - \ EXTERNAL - : SECTIONTYPE ( n -- ) \ section characteristics SECT-CHARACTER @ OR SECT-CHARACTER ! ; \ or them in --- 276,279 ---- *************** *** 328,333 **** ; - \ INTERNAL - : SECTWRITE ( -- ) \ write out sections EXEH-#SECTS W@ 0 ?DO \ now each section --- 326,329 ---- *************** *** 396,401 **** ; - \ EXTERNAL - : IMPLIB ( addr len -- ) \ define library name IMPLIB-LINK IMPSTR \ allocate the string --- 392,395 ---- *************** *** 449,454 **** )) - \ INTERNAL - (( 0 VALUE CURR-IID \ current IID --- 443,446 ---- *************** *** 459,463 **** 0 VALUE LEN-ALLIIDS \ length of all IIDs )) ! \ EXTERNAL : MOVE-NAME { src dest -- len } --- 451,455 ---- 0 VALUE LEN-ALLIIDS \ length of all IIDs )) ! \ : MOVE-NAME { src dest -- len } *************** *** 560,565 **** 0 VALUE BUILDTYPE \ EXE or DLL - \ EXTERNAL - : SUBSYSTEM ( m -- ) \ declare subsystem CASE --- 552,555 ---- *************** *** 729,733 **** ; ! PREVIOUS DEFINITIONS ALSO VIMAGE --- 719,723 ---- ; ! External *************** *** 818,825 **** IMG-ENTRY TO IMAGE-ENTRY STD-EXELOAD TO IMAGE-ORIGIN - IMAGE-PTR APP-ORIGIN - >R \ adjust to app origin ZERO-WORDS \ list of app words to zero - pre-save-image-chain do-chain \ do any extra manipulations BEGIN DUP CELL+ SWAP @ ?DUP WHILE --- 808,814 ---- IMG-ENTRY TO IMAGE-ENTRY STD-EXELOAD TO IMAGE-ORIGIN IMAGE-PTR APP-ORIGIN - >R \ adjust to app origin + ZERO-WORDS \ list of app words to zero BEGIN DUP CELL+ SWAP @ ?DUP WHILE *************** *** 827,834 **** --- 816,854 ---- REPEAT R>DROP DROP + pre-save-image-chain do-chain \ do any extra manipulations + IMAGE-STATS ; + Internal + + \ ------------------------------------------------------------------------------ + \ Helper words for Image manipulation + \ ------------------------------------------------------------------------------ + + : >IMAGE-APP ( Addr1 -- Addr2 ) + APP-ORIGIN - IMAGE-APPPTR + ; + + : >IMAGE-SYS ( Addr1 -- Addr2 ) + SYS-ORIGIN - IMAGE-SYSPTR + ; + + : >IMAGE-CODE ( Addr1 -- Addr2 ) + CODE-ORIGIN - IMAGE-CODEPTR + ; + + EXTERNAL + + : >IMAGE ( Addr1 -- Addr2|false ) + dup in-app-space? if >image-app else + dup in-sys-space? if >image-sys else + dup in-code-space? if >image-code else + drop false then then then ; + + : IN-IMAGE? ( Addr1 -- flag ) + dup in-app-space? over in-sys-space? or swap in-code-space? or ; + + : is-image ( xt "name" -- ) \ preset a defer to xt + ?comp ' >body postpone literal postpone >image postpone ! ; immediate + \ ------------------------------------------------------------------------------ \ General boot words *************** *** 895,904 **** \ This could be solved once the Console itself uses MessageLoop. \ ------------------------------------------------------------------------------ ! \ SAVE & TURNKEY \ ------------------------------------------------------------------------------ ! IN-SYSTEM CREATE &appdir MAXCOUNTED 1+ ALLOT \ static application directory --- 915,987 ---- \ This could be solved once the Console itself uses MessageLoop. + IN-SYSTEM \ ------------------------------------------------------------------------------ ! \ PresetConsole Defers in image \ ------------------------------------------------------------------------------ ! : PresetDosConsole ( -- ) \ Preset DOS console functions in Image ! ['] NOOP IS-IMAGE CONSOLE ! ['] d_Init-Console IS-IMAGE INIT-CONSOLE ! ['] NOOP IS-IMAGE INIT-SCREEN ! ['] d_KEY IS-IMAGE KEY ! ['] d_KEY? IS-IMAGE KEY? ! ['] d_ACCEPT IS-IMAGE ACCEPT ! ['] DROP IS-IMAGE PUSHKEY ! ['] 2DROP IS-IMAGE "PUSHKEYS ! ['] NOOP IS-IMAGE CLS ! ['] d_EMIT IS-IMAGE EMIT ! ['] d_TYPE IS-IMAGE TYPE ! ['] d_CR IS-IMAGE CR ! ['] DROP IS-IMAGE ?CR ! ['] 2DROP IS-IMAGE GOTOXY ! ['] K_NOOP2 IS-IMAGE GETXY ! ['] 2DROP IS-IMAGE FGBG! ! ['] K_NOOP1 IS-IMAGE FG@ ! ['] K_NOOP1 IS-IMAGE BG@ ! ['] 2DROP IS-IMAGE SETCHARWH ! ['] K_NOOP2 IS-IMAGE CHARWH ! ['] DROP IS-IMAGE SET-CURSOR ! ['] K_NOOP1 IS-IMAGE GET-CURSOR ! ['] K_NOOP2 IS-IMAGE GETCOLROW ! ['] K_NOOP1 IS-IMAGE GETROWOFF ! ['] K_NOOP1 IS-IMAGE &THE-SCREEN ! ['] NOOP IS-IMAGE SCROLLTOVIEW ! \ preset BYE to default ( although should have never changed) ! ['] k_bye IS-IMAGE bye ; ! ! : PresetNoConsoleIO ( -- ) \ Preset all defered I/O words to noop's. ! ['] NOOP IS-IMAGE CONSOLE ! ['] K_NOOP1 IS-IMAGE INIT-CONSOLE ! ['] NOOP IS-IMAGE INIT-SCREEN ! ['] K_NOOP1 IS-IMAGE KEY ! ['] K_NOOP1 IS-IMAGE KEY? ! ['] K_NOOP0 IS-IMAGE ACCEPT ! ['] DROP IS-IMAGE PUSHKEY ! ['] 2DROP IS-IMAGE "PUSHKEYS ! ['] NOOP IS-IMAGE CLS ! ['] DROP IS-IMAGE EMIT ! ['] 2DROP IS-IMAGE TYPE ! ['] NOOP IS-IMAGE CR ! ['] DROP IS-IMAGE ?CR ! ['] 2DROP IS-IMAGE GOTOXY ! ['] K_NOOP2 IS-IMAGE GETXY ! ['] 2DROP IS-IMAGE FGBG! ! ['] K_NOOP1 IS-IMAGE FG@ ! ['] K_NOOP1 IS-IMAGE BG@ ! ['] 2DROP IS-IMAGE SETCHARWH ! ['] K_NOOP2 IS-IMAGE CHARWH ! ['] DROP IS-IMAGE SET-CURSOR ! ['] K_NOOP1 IS-IMAGE GET-CURSOR ! ['] K_NOOP2 IS-IMAGE GETCOLROW ! ['] K_NOOP1 IS-IMAGE GETROWOFF ! ['] K_NOOP1 IS-IMAGE &THE-SCREEN ! ['] NOOP IS-IMAGE SCROLLTOVIEW ! \ preset BYE to default ( although should have never changed) ! ['] k_bye IS-IMAGE bye ; ! ! \ ------------------------------------------------------------------------------ ! \ SAVE & TURNKEY ! \ ------------------------------------------------------------------------------ CREATE &appdir MAXCOUNTED 1+ ALLOT \ static application directory *************** *** 948,957 **** ConsoleMode case ! 1 of ['] (NoConsoleBoot) endof ! 2 of ['] (DosConsoleBoot) endof ! 4 of ['] (ConsoleBoot) endof ! 8 of ['] (ConsoleHiddenBoot) endof true Abort" Illegal console mode" endcase is DoConsoleBoot \ set SAVEd console mode 0 to ConsoleMode \ reset default (saver & image) --- 1031,1041 ---- ConsoleMode case ! 1 of ['] (NoConsoleBoot) ['] PresetNoConsoleIO endof ! 2 of ['] (DosConsoleBoot) ['] PresetDosConsole endof ! 4 of action-of (ConsoleBoot) ['] noop endof ! 8 of action-of (ConsoleHiddenBoot) ['] noop endof true Abort" Illegal console mode" endcase + is PresetConsoleIO \ set to preset IO in image is DoConsoleBoot \ set SAVEd console mode 0 to ConsoleMode \ reset default (saver & image) *************** *** 1018,1043 **** r> throw ; \ throw error after restore - \ Helper words for Image manipulation - - : >IMAGE-APP ( Addr1 -- Addr2 ) - APP-ORIGIN - IMAGE-APPPTR + ; - - : >IMAGE-SYS ( Addr1 -- Addr2 ) - SYS-ORIGIN - IMAGE-SYSPTR + ; - - : >IMAGE-CODE ( Addr1 -- Addr2 ) - CODE-ORIGIN - IMAGE-CODEPTR + ; - - EXTERNAL - - : >IMAGE ( Addr1 -- Addr2|false ) - dup in-app-space? if >image-app else - dup in-sys-space? if >image-sys else - dup in-code-space? if >image-code else - drop false then then then ; - - : IN-IMAGE? ( Addr1 -- flag ) - dup in-app-space? over in-sys-space? or swap in-code-space? or ; - MODULE --- 1102,1105 ---- |
