Menu
▾
▴
[Win32forth-cvs] win32forth-stc/src/kernel gMeta.f, 1.2, 1.3 gkernel.f, 1.37, 1.38
|
From: Alex M. <ale...@us...> - 2007-05-13 21:39:31
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv7404/src/kernel Modified Files: gMeta.f gkernel.f Log Message: arm: remove caps-xxx functions to ansfile optimise case statements reorder kernel source (minor) Index: gMeta.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gMeta.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** gMeta.f 23 Sep 2006 06:00:17 -0000 1.2 --- gMeta.f 13 May 2007 21:39:27 -0000 1.3 *************** *** 51,55 **** 0x400000 to image-origin \ where target image will run image-origin to std-exeload \ needed but needs checked in imageman why so ! gui to exetype \ default is a gui true value image-save \ we want to save the image --- 51,55 ---- 0x400000 to image-origin \ where target image will run image-origin to std-exeload \ needed but needs checked in imageman why so ! cui to exetype \ dos console true value image-save \ we want to save the image Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.37 retrieving revision 1.38 diff -C2 -d -r1.37 -r1.38 *** gkernel.f 8 May 2007 08:02:27 -0000 1.37 --- gkernel.f 13 May 2007 21:39:27 -0000 1.38 *************** *** 426,430 **** next; ! code sw@ ( a1 -- w1 ) \ fetch the sign extended word (16bit) w1 from address a1 1 1 in/out movsx eax, word [eax] --- 426,430 ---- next; ! code sw@ ( a1 -- w1 ) \ sign fetch the word w1 1 1 in/out movsx eax, word [eax] *************** *** 2204,2208 **** mov ' dp >body , ecx \ restore dp ret 4 \ discard old value ! next; \ return : >application ( -- ) adp >dp exit ; \ select app dict, save prev dict --- 2204,2208 ---- mov ' dp >body , ecx \ restore dp ret 4 \ discard old value ! c; : >application ( -- ) adp >dp exit ; \ select app dict, save prev dict *************** *** 2427,2431 **** : xt-inline, ( xt -- ) \ inline the xt dup >name n>ofa \ get the length ! w@ dup xt-inline-max u> not if \ if short enough copy-code \ copy the code else --- 2427,2431 ---- : xt-inline, ( xt -- ) \ inline the xt dup >name n>ofa \ get the length ! w@ dup xt-inline-max u> not if \ if <= inline max copy-code \ copy the code else *************** *** 2476,2486 **** ; ! : (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 2dup ste-o ! ste-i ! \ set calc values last @ n>ste --- 2476,2486 ---- ; ! : (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 2dup ste-o ! ste-i ! \ set calc values last @ n>ste *************** *** 3113,3119 **** --- 3113,3130 ---- defer ?cr + 1 proc GetStdHandle + + -1 value stdout + -1 value stderr + -1 value stdin + : x_init-console ( -- f1 ) \ initialize the forth console window \ and the keyboard i/o \ f1=false if already inited + + STD_OUTPUT_HANDLE call GetStdHandle to stdout + STD_INPUT_HANDLE call GetStdHandle to stdin + STD_ERROR_HANDLE call GetStdHandle to stderr + _conhndl >r *************** *** 3185,3208 **** 2 proc c_gotoxy 0 proc c_getxy - 4 proc c_mark 0 proc c_getcolrow - 0 proc c_sizestate - 1 proc k_fpushkey - : x_sizestate ( -- state ) call c_sizestate ; : x_gotoxy ( x y -- ) swap call c_gotoxy drop ; : x_getxy ( -- x y ) call c_getxy word-split ; : x_getcolrow ( -- cols rows ) call c_getcolrow word-split ; - : x_markconsole ( startline startcol endline endcol -- ) - call c_mark drop ; - defer pushkey ' drop is pushkey - defer "pushkeys ' 2drop is "pushkeys - defer shiftmask ' k_noop1 is shiftmask - defer sizestate ' x_sizestate is sizestate defer gotoxy ' x_gotoxy is gotoxy defer getxy ' x_getxy is getxy defer getcolrow ' x_getcolrow is getcolrow - defer markconsole ' x_markconsole is markconsole defer console ' noop is console defer cursorinview ' noop is cursorinview --- 3196,3208 ---- *************** *** 3210,3215 **** defer fg@ ' k_noop1 is fg@ defer bg@ ' k_noop1 is bg@ - defer charwh ' k_noop2 is charwh - defer setcharwh ' 2drop is setcharwh defer setcolrow ' 2drop is setcolrow defer set-cursor ' drop is set-cursor --- 3210,3213 ---- *************** *** 3219,3223 **** defer getmaxcolrow ' k_noop2 is getmaxcolrow defer setmaxcolrow ' 2drop is setmaxcolrow - defer &the-screen ' k_noop1 is &the-screen : x_col ( n -- ) getcolrow drop 1- min getxy drop - spaces ; --- 3217,3220 ---- *************** *** 3228,3251 **** \ -------------------- deferred i/o part ii -------------------------------- - -1 value stdout - -1 value stderr - -1 value stdin - - 1 proc GetStdHandle - 0 proc AllocConsole - 0 proc FreeConsole - : _dosconsole ( fl -- ) \ true = open, false = close - if call AllocConsole drop - STD_OUTPUT_HANDLE call GetStdHandle to stdout - STD_INPUT_HANDLE call GetStdHandle to stdin - STD_ERROR_HANDLE call GetStdHandle to stderr - else call FreeConsole drop - then ; - defer load-forth ' noop is load-forth \ things to do at start defer unload-forth ' noop is unload-forth \ things to do at end - 0 proc IsWindow - 1 proc DestroyWindow 1 proc ExitProcess : k_bye ( -- ) \ exit forth --- 3225,3231 ---- *************** *** 5521,5525 **** |: locals-init ( -- ) \ init, check if locals validly used ! ?csp \ make sure not used inside control structures localstk throw_localstwice ?throw \ and not used before in the definition 0 to localsi --- 5501,5505 ---- |: locals-init ( -- ) \ init, check if locals validly used ! ?csp \ make sure not used inside control structures localstk throw_localstwice ?throw \ and not used before in the definition 0 to localsi *************** *** 5800,5806 **** reset-stacks ! ['] boot catch \ do boot ! if bye then \ fatal error, exit ! &except @ 0= if cmdline ['] evaluate catch ?dup if console message then --- 5780,5784 ---- reset-stacks ! ['] boot catch 0= \ do boot (which may never return) if cmdline ['] evaluate catch ?dup if console message then |
