Menu
▾
▴
[Win32forth-cvs] win32forth/src/kernel fkernel.f,1.1,1.2
|
From: Alex M. <ale...@us...> - 2005-01-02 23:05:07
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25726/src/kernel Modified Files: fkernel.f Log Message: arm: removed callback from kernel; added cmovxx instructions to assembler; factored macro[ ]macro Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** fkernel.f 21 Dec 2004 00:19:09 -0000 1.1 --- fkernel.f 2 Jan 2005 23:04:55 -0000 1.2 *************** *** 2782,2785 **** --- 2782,2787 ---- VARIABLE [UNKNOWN] \ also used to store last cfa found + in-system + CODE >NAME ( CFA -- NFA ) \ search vocabs for cfa, return nfa \ Follows the VOC-LINK pointer to all of the vocabularies, searches threads for CFA *************** *** 2815,2818 **** --- 2817,2822 ---- pop edx \ restore edx next c; + + in-application 4 CONSTANT OFA-BIT *************** *** 3079,3083 **** TRUE TO SYS-WARNING? ; ! : COMPILE, ( xt -- ) \ compile DUP SYS-ADDR? \ address in system space IN-SYS? 0= AND \ not currently system pointer --- 3083,3087 ---- TRUE TO SYS-WARNING? ; ! : (COMPILE,) ( xt -- ) \ compile DUP SYS-ADDR? \ address in system space IN-SYS? 0= AND \ not currently system pointer *************** *** 3086,3089 **** --- 3090,3095 ---- , ; \ same as , but with warning + DEFER COMPILE, ' (COMPILE,) IS COMPILE, + CODE COMPILE ( -- ) \ compile xt following push ebx *************** *** 3158,3178 **** BL WORD 1+ C@ ; in-system : [CHAR] ( -- char ) CHAR [COMPILE] LITERAL ; IMMEDIATE - in-application - - : ' ( -- cfa ) - DEFINED ?MISSING ; - in-system - : ['] ( -<name>- ) ' [COMPILE] LITERAL ; IMMEDIATE - : [COMPILE] ( -<name>- ) - ' COMPILE, ; IMMEDIATE - : POSTPONE ( -<name>- ) DEFINED DUP ?MISSING --- 3164,3180 ---- BL WORD 1+ C@ ; + : ' ( -- cfa ) + DEFINED ?MISSING ; in-system + : [COMPILE] ( -<name>- ) + ' COMPILE, ; IMMEDIATE + : [CHAR] ( -- char ) CHAR [COMPILE] LITERAL ; IMMEDIATE : ['] ( -<name>- ) ' [COMPILE] LITERAL ; IMMEDIATE : POSTPONE ( -<name>- ) DEFINED DUP ?MISSING *************** *** 4121,4125 **** : IF ?COMP HERE 2 CELLS - @ DUP ['] COMPILE = SWAP ['] LIT = OR 0= ! HERE CELL - @ ['] DUP = AND IF CELL NEGATE ALLOT COMPILE -?BRANCH ELSE COMPILE ?BRANCH --- 4123,4127 ---- : IF ?COMP HERE 2 CELLS - @ DUP ['] COMPILE = SWAP ['] LIT = OR 0= ! HERE CELL - @ ['] DUP = AND IF CELL NEGATE ALLOT COMPILE -?BRANCH ELSE COMPILE ?BRANCH *************** *** 4250,4254 **** DUP 0= THROW_NAMEREQD AND THROW "CLIP" - \ CAPS @ IF 2DUP UPPER THEN \ bad; should really copy 2dup UPPER \ bad; should really copy WARNING @ IF --- 4252,4255 ---- *************** *** 5258,5262 **** R> BASE ! \ restore base ; ! : WARNMSG ( n -- ) \ prints Warning: S" Warning" (TYPEMSG) ; \ mark the source line in error, warning --- 5259,5263 ---- R> BASE ! \ restore base ; ! : WARNMSG ( n -- ) \ prints Warning: S" Warning" (TYPEMSG) ; \ mark the source line in error, warning *************** *** 5525,5636 **** - \ -------------------- Callback Support ------------------------------------- - - \ CALLBACK-RETURN and CALLBACK-BEGIN restore and save regs, set up EBP and ESP - \ BUILD-CALLBACK uses ECX as parm count, EDX as ret count -- __CDECL sets to zero - - NCODE CALLBACK-RETURN \ general return code, restores all but ecx! - here-c cell+ ,-c \ make an ITC - mov eax, ebx \ return value - mov esp, ebp - pop SP0 [UP] - pop esi - pop edi - pop ebx - pop ebp - pop ecx \ count - lea ecx, 1234 [ecx] [ecx*2] \ calculate jump offset (4 byte lea version!) - a; here-c cell- \ point at the offset in lea - jmp ecx \ back to caller - a; here-c swap !-C \ correct the lea calculation - ret nop nop \ 3 bytes long ret - ret 1 cells - ret 2 cells - ret 3 cells - ret 4 cells - ret 5 cells - ret 6 cells - ret 7 cells - c; - - CFA-CODE CALLBACK-BEGIN \ general start code, don't disturb EAX! - push ebp \ save regs, return count is already on the stack - push ebx - push edi - push esi - - xor edi, edi \ edi is constant 0 - mov edx, fs: 0x14 \ edx is now ptr TIB pvArbitrary - push SP0 [UP] \ save sp0 on stack - - mov ebp, esp - sub esp, # 4096 32 - \ room for return stack (Not RSTACKSIZE, please!) - and esp, # -16 \ align to 16 byte boundary - mov SP0 [UP] , esp \ reset SP0 - - lea ebx, [ebp] [ecx*4] \ adjust ebx - neg ecx \ negate ecx - lea ecx, 1234 [ecx] [ecx*2] \ calculate jump offset (4 byte lea version!) - a; here-c cell- \ point at the offset (the 1234) in lea - jmp ecx \ and leap... - a; here-c 7 3 * + swap !-C \ correct the lea calculation - push ( 0 cells) [ebx] nop \ 7 callback, nop for short from - push 1 cells [ebx] \ all entries 3 bytes - push 2 cells [ebx] - push 3 cells [ebx] - push 4 cells [ebx] - push 5 cells [ebx] \ 2 callback - push 6 cells [ebx] \ 1 callback - pop ebx \ 0 callback -- recover ebx - - lea esi, ' callback-return - exec c; \ go for it - - ASSEMBLER CALLBACK-BEGIN META CONSTANT CALLBACK-BEGIN - - in-system - - variable __CDECLV 0 __CDECLV ! \ for __cdecl type callbacks - : __STDCALL ; IMMEDIATE \ does nothing, callback is stdcall - : __CDECL __CDECLV ON ; \ turn on __cdecl type callback - - : BUILD-CALLBACK ( n1 -- a1 a2 ) \ define a callback procedure - >R - CODE-HERE \ func address (a1) - 0XB8 CODE-C, \ mov eax, # cfa to execute - CODE-HERE \ cfa address (a2) - 0 CODE-, \ the cfa address - 0XB9 CODE-C, \ mov ecx, # args - R> CODE-, \ # of args - __CDECLV @ IF \ if __cdecl call - 0X006A CODE-W, \ push # 0 - __CDECLV OFF \ turn off cdecl - ELSE - 0X51 CODE-C, \ push ecx - THEN - 0XE9 CODE-C, \ jmp callback-begin - CALLBACK-BEGIN CODE-HERE CELL+ - CODE-, \ jmp address - ; - - : CALLBACK ( n1 -<name function>- ) \ define a callback with "name" that has n1 args - ( -- a1 ) \ runtime, returns address of callback - BUILD-CALLBACK >R CONSTANT ' R> ! - ; - - : CALLBACK: ( args -<name>- ) \ makes a headerless callback function, only - ( -- a1 ) \ the callback structure has a header - BUILD-CALLBACK >R - MAXCSTRING _LOCALALLOC >R \ use a dynamic string buffer - S" CONSTANT &" R@ PLACE - >IN @ BL WORD COUNT R@ +PLACE - >IN ! \ get a copy of next word in input stream - R> COUNT EVALUATE \ make a constant starting with '&' - _LOCALFREE - : \ build the colon definitions starting structure - HERE CELL- R> ! \ patch callback structure - ; - - IN-APPLICATION - \ -------------------- Tools -------------------- --- 5526,5529 ---- *************** *** 5880,5882 **** \ Prad~ - |
