Menu
▾
▴
[Win32forth-cvs] win32forth-stc/src/kernel gkernel.f, 1.7, 1.8 gmeta-fkernel.f, 1.1, 1.2
|
From: Alex M. <ale...@us...> - 2006-10-04 10:27:43
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv20664 Modified Files: gkernel.f gmeta-fkernel.f Log Message: arm: support dual code areas in system and application Index: gmeta-fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gmeta-fkernel.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** gmeta-fkernel.f 21 Sep 2006 16:26:33 -0000 1.1 --- gmeta-fkernel.f 4 Oct 2006 10:27:37 -0000 1.2 *************** *** 52,61 **** 512000 0x1000 naligned constant MINCODEMEM \ minimum size of kernel code dictionary 512000 0x1000 naligned constant MINSYSMEM \ minimum size of kernel system dictionary ! 1024 0x1000 naligned constant MINKODEMEM \ minimum size of kernel kode dictionary 512000 0x1000 naligned TO IMAGE-ASIZE \ size of kernel application dictionary 512000 0x1000 naligned TO IMAGE-CSIZE \ size of kernel data dictionary 512000 0x1000 naligned TO IMAGE-SSIZE \ size of kernel system dictionary ! 1024 0x1000 naligned TO IMAGE-KSIZE \ size of kernel kode dictionary 0 STD-HEADLEN + TO IMAGE-CSEP \ separations --- 52,61 ---- 512000 0x1000 naligned constant MINCODEMEM \ minimum size of kernel code dictionary 512000 0x1000 naligned constant MINSYSMEM \ minimum size of kernel system dictionary ! 512000 0x1000 naligned constant MINKODEMEM \ minimum size of kernel kode dictionary 512000 0x1000 naligned TO IMAGE-ASIZE \ size of kernel application dictionary 512000 0x1000 naligned TO IMAGE-CSIZE \ size of kernel data dictionary 512000 0x1000 naligned TO IMAGE-SSIZE \ size of kernel system dictionary ! 512000 0x1000 naligned TO IMAGE-KSIZE \ size of kernel kode dictionary 0 STD-HEADLEN + TO IMAGE-CSEP \ separations Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** gkernel.f 1 Oct 2006 07:38:44 -0000 1.7 --- gkernel.f 4 Oct 2006 10:27:37 -0000 1.8 *************** *** 2155,2159 **** \ 1 4 Address of the area (origin) \ 2 8 Highest address of area (origin + length) ! \ 4 16 Link of all the xDP areas; set in DP-LINK \ 5 20 Counted name of the area \ --- 2155,2159 ---- \ 1 4 Address of the area (origin) \ 2 8 Highest address of area (origin + length) ! \ 4 16 Link of all the DP areas; set in DP-LINK \ 5 20 Counted name of the area \ *************** *** 2164,2168 **** \ See also PDP and LDP (procs and locals data respectively) ! variable dp-link \ list of xdp structures 0 dp-link ! --- 2164,2168 ---- \ See also PDP and LDP (procs and locals data respectively) ! variable dp-link \ list of dp structures 0 dp-link ! *************** *** 2173,2178 **** adp value dp \ data pointer defaults to app space ! \ ----------------- Switching dictionary words --------------- \ To switch between data areas, >DP saves and resets the data pointer. --- 2173,2179 ---- adp value dp \ data pointer defaults to app space + cdp value xdp \ xdp is the default code pointer ! \ ----------------- Switching section areas -------------------- \ To switch between data areas, >DP saves and resets the data pointer. *************** *** 2186,2196 **** \ used to save/restore the current value, and must be used in matching pairs. ! : in-application ( -- ) adp to dp ; \ set the correct pointer ! : in-system ( -- ) sdp to dp ; : in-app? ( -- f ) dp adp = ; \ if the dp is set to adp : in-sys? ( -- f ) dp sdp = ; \ if the dp is set to sdp - : in-code? ( -- f ) dp cdp = ; \ if the dp is set to cdp - : in-kode? ( -- f ) dp kdp = ; \ if the dp is set to kdp : >dp ( dp -- ) \ nasty piece of code! --- 2187,2198 ---- \ used to save/restore the current value, and must be used in matching pairs. ! : get-section ( -- n m ) dp xdp ; ! : set-section ( n m -- ) to xdp to dp ; ! ! : in-application ( -- ) adp cdp set-section ; \ set the correct pointers ! : in-system ( -- ) sdp kdp set-section ; : in-app? ( -- f ) dp adp = ; \ if the dp is set to adp : in-sys? ( -- f ) dp sdp = ; \ if the dp is set to sdp : >dp ( dp -- ) \ nasty piece of code! *************** *** 2209,2224 **** : >application ( -- ) adp >dp exit ; \ select app dict, save prev dict : >system ( -- ) sdp >dp exit ; \ select sys dict, save prev dict ! : >code ( -- ) cdp >dp exit ; \ select code dict, save prev dict ! : >kode ( -- ) kdp >dp exit ; \ select code dict, save prev dict ! ! ' dp> alias system> ! ' dp> alias application> ! ' dp> alias code> ! ' dp> alias kode> ! ! : app-origin ( -- a1 ) adp cell+ @ ; ! : sys-origin ( -- a1 ) sdp cell+ @ ; ! : code-origin ( -- a1 ) cdp cell+ @ ; ! : kode-origin ( -- a1 ) kdp cell+ @ ; : here ( -- a1 ) dp @ ; \ next free byte --- 2211,2215 ---- : >application ( -- ) adp >dp exit ; \ select app dict, save prev dict : >system ( -- ) sdp >dp exit ; \ select sys dict, save prev dict ! : >code ( -- ) xdp >dp exit ; \ select code dict, save prev dict : here ( -- a1 ) dp @ ; \ next free byte *************** *** 2229,2234 **** : mem-free ( -- n1 ) dp 2 cells+ @ here - ; ! : ?memchk ( n1 -- ) \ test to see if we have enough memory ! mem-free > if dp 4 cells+ count temp$ place \ name of the space temp$ throw_outofmem nabort! --- 2220,2225 ---- : mem-free ( -- n1 ) dp 2 cells+ @ here - ; ! : ?memchk ( -- ) \ test to see if we have enough memory ! 4096 mem-free > if dp 4 cells+ count temp$ place \ name of the space temp$ throw_outofmem nabort! *************** *** 2236,2240 **** : allot ( n -- ) \ allot n bytes ! dup 1024 + ?memchk dp +! ; : align ( -- ) \ align data space & pad --- 2227,2231 ---- : allot ( n -- ) \ allot n bytes ! ?memchk dp +! ; : align ( -- ) \ align data space & pad *************** *** 2243,2247 **** : sys-addr? ( a -- f ) \ is it a system address? ! sys-origin [ sdp 2 cells+ ] literal @ within ; : sys-warning-off ( -- ) \ disable warning for use of system words in application --- 2234,2238 ---- : sys-addr? ( a -- f ) \ is it a system address? ! sdp cell+ 2@ swap within ; : sys-warning-off ( -- ) \ disable warning for use of system words in application *************** *** 2269,2307 **** next; ! : app-free ( -- n1 ) >application mem-free application> ; ! : app-here ( -- a ) adp @ ; ! : app-allot ( n1 -- ) >application allot application> ; ! : app-align ( -- ) >application align application> ; ! : sys-free ( -- n1 ) >system mem-free system> ; : sys-here ( -- a ) sdp @ ; ! : sys-allot ( n1 -- ) >system allot system> ; ! : sys-, ( n -- ) >system , system> ; ! : sys-w, ( n -- ) >system w, system> ; ! : sys-c, ( n -- ) >system c, system> ; ! : sys-align ( -- ) >system align system> ; ! ! : kode-free ( -- n1 ) >kode mem-free kode> ; ! : kode-here ( -- a ) kdp @ ; ! : kode-allot ( n1 -- ) >kode allot kode> ; ! : kode-, ( n -- ) >kode , kode> ; ! : kode-c! ( n -- ) >kode c! kode> ; ! : kode-w, ( n -- ) >kode w, kode> ; ! : kode-c, ( n -- ) >kode c, kode> ; ! : kode-align ( -- ) >kode align kode> ; ! : code-free ( -- n1 ) >code mem-free code> ; ! : code-here ( -- a ) cdp @ ; ! : code-allot ( n1 -- ) >code allot code> ; ! : code-, ( n -- ) >code , code> ; ! : code-c! ( n -- ) >code c! code> ; ! : code-w! ( n -- ) >code w! code> ; ! : code-w, ( n -- ) >code w, code> ; ! : code-c, ( n -- ) >code c, code> ; \ : code-align ( -- ) >code \ cell allot \ align to 16byte boundary \ here dup 16 naligned ! \ swap - cell- allot code> ; ! : code-align ( -- ) >code align code> ; : break $cc code-c, ; immediate --- 2260,2283 ---- next; ! : app-free ( -- n1 ) >application mem-free dp> ; ! : app-align ( -- ) >application align dp> ; ! : sys-free ( -- n1 ) >system mem-free dp> ; : sys-here ( -- a ) sdp @ ; ! : sys-align ( -- ) >system align dp> ; ! : code-free ( -- n1 ) >code mem-free dp> ; ! : code-here ( -- a ) xdp @ ; ! : code-allot ( n1 -- ) >code allot dp> ; ! : code-, ( n -- ) >code , dp> ; ! : code-c! ( n -- ) >code c! dp> ; ! : code-w! ( n -- ) >code w! dp> ; ! : code-w, ( n -- ) >code w, dp> ; ! : code-c, ( n -- ) >code c, dp> ; \ : code-align ( -- ) >code \ cell allot \ align to 16byte boundary \ here dup 16 naligned ! \ swap - cell- allot dp> ; ! : code-align ( -- ) >code align dp> ; : break $cc code-c, ; immediate *************** *** 2459,2463 **** 0 1 in/out : constant ( n "name" ) \ compile time ( -- n ) \ run time ! \ >system create , system> \ create in system space header \ postpone literal --- 2435,2439 ---- 0 1 in/out : constant ( n "name" ) \ compile time ( -- n ) \ run time ! \ >system create , dp> \ create in system space header \ postpone literal *************** *** 3560,3564 **** over class>sys or \ or is a class or object if >system else >application then \ then build the header in the same space ! 2000 ?memchk \ check avail mem _header-build \ build head in current dp> ; \ back to original dictionary pointer --- 3536,3540 ---- over class>sys or \ or is a class or object if >system else >application then \ then build the header in the same space ! ?memchk \ check avail mem _header-build \ build head in current dp> ; \ back to original dictionary pointer *************** *** 4828,4832 **** : #lexicon ( #threads -<name>- -- ) ! >application (voc) application> ; : lexicon ( -- ) \ like a vocabulary, but in app space --- 4804,4810 ---- : #lexicon ( #threads -<name>- -- ) ! get-section 2>r \ save dp and xdp ! in-application (voc) \ move to in-system ! 2r> set-section ; \ and restore dp and xdp : lexicon ( -- ) \ like a vocabulary, but in app space *************** *** 4834,4838 **** : #vocabulary ( #threads -<name>- ) ! >system (voc) system> ; : vocabulary ( -- ) --- 4812,4818 ---- : #vocabulary ( #threads -<name>- ) ! get-section 2>r \ save dp and xdp ! in-system (voc) \ move to in-system ! 2r> set-section ; \ and restore dp and xdp : vocabulary ( -- ) *************** *** 5103,5107 **** : sys-fload ( -<filename>- ) \ load "filename" into system space ! >system fload system> ; \ ----------------------- Find name in vocabulary --------------------------- --- 5083,5089 ---- : sys-fload ( -<filename>- ) \ load "filename" into system space ! get-section 2>r \ save dp and xdp ! in-system fload \ move to in-system ! 2r> set-section ; \ and restore dp and xdp \ ----------------------- Find name in vocabulary --------------------------- *************** *** 5719,5726 **** : new-sys-chain ( -- ) ! >system ! new-chain ! system> ! ; |: ?sys-chain ( chain_address xt -- chain_address xt ) --- 5701,5707 ---- : new-sys-chain ( -- ) ! get-section 2>r \ save dp and xdp ! in-system new-chain \ move to in-system ! 2r> set-section ; \ and restore dp and xdp |: ?sys-chain ( chain_address xt -- chain_address xt ) |
