From: Alex M. <ale...@us...> - 2005-01-02 23:05:09
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25726/src Modified Files: 486ASM.F ASMWIN32.F CALLBACK.f MAPFILE.F Log Message: arm: removed callback from kernel; added cmovxx instructions to assembler; factored macro[ ]macro Index: ASMWIN32.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/ASMWIN32.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** ASMWIN32.F 21 Dec 2004 00:19:07 -0000 1.1 --- ASMWIN32.F 2 Jan 2005 23:04:55 -0000 1.2 *************** *** 3,6 **** --- 3,7 ---- \ ASMWIN32.F beta 3.1A 2002/09/25 arm performance enhancements \ ASMWIN32.F beta 3.3D 2002/10/08 Consolidation + \ arm 02/01/2005 21:28:34 factor macro[ ]macro to reduce postpone word count cr .( Loading 486ASM/Win32Forth Interface File...) *************** *** 92,103 **** also assembler also asm-hidden current @ also forth definitions nostack1 : macro[ ( create a macro in the assembler vocabulary ) save-current also assembler definitions ! postpone enter-macro ! postpone a; ; immediate : ]macro ( end a macro definition ) ! postpone a; ! postpone leave-macro previous restore-current ; immediate --- 93,105 ---- also assembler also asm-hidden current @ also forth definitions nostack1 + : (macro[) a; enter-macro ; + : (]macro) leave-macro a; ; + : macro[ ( create a macro in the assembler vocabulary ) save-current also assembler definitions ! postpone (macro[) ; immediate : ]macro ( end a macro definition ) ! postpone (]macro) previous restore-current ; immediate Index: CALLBACK.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CALLBACK.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** CALLBACK.f 21 Dec 2004 00:19:07 -0000 1.1 --- CALLBACK.f 2 Jan 2005 23:04:55 -0000 1.2 *************** *** 2,8 **** --- 2,115 ---- \ CALLBACK.F Windows Callback support by Tom Zimmer + \ arm 21/12/2004 21:21:09 Callback support -- moved out of kernel cr .( Loading Windows Callback...) + in-application + + \ -------------------- Callback Support ------------------------------------- + + \ CALLBACK-RETURN and CALLBACK-BEGIN restore and save regs, set up EBP and ESP + \ BUILD-CALLBACK uses ECX as parm count, ret count on stack -- __CDECL sets to zero + + NCODE CALLBACK-RETURN \ general return code, restores all but ecx! + code-here cell+ code-, \ 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; code-here cell- \ point at the offset in lea + jmp ecx \ back to caller + a; code-here swap ! \ 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; code-here cell- \ point at the offset (the 1234) in lea + jmp ecx \ and leap... + a; code-here 7 3 * + swap ! \ 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 + + mov esi, # ' callback-return + exec c; \ go for it + + 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 \ generated via macro[ ]macro + code-here \ func address (a1) + macro[ mov eax, # 1234 \ mov eax, # cfa to execute + mov ecx, # r@ \ mov ecx, # args + push \ push something + __cdeclv @ if + __cdeclv off \ turn off cdecl + # 0 \ if __cdecl, push # 0 + else + ecx \ else push # args + then jmp callback-begin + ]macro + r>drop dup 2 + \ cfa address (a2) + ; + + : 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 + MAXSTRING _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 + \ ************************************************************************* \ **************** allow Forth to handle windows messages ***************** *************** *** 112,114 **** in-application - |