Menu
▾
▴
win32forth-cvs — CVS Commit List
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(70) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(38) |
Feb
(4) |
Mar
(11) |
Apr
(49) |
May
(81) |
Jun
(65) |
Jul
(36) |
Aug
(57) |
Sep
(63) |
Oct
(57) |
Nov
(49) |
Dec
(41) |
| 2006 |
Jan
(75) |
Feb
(80) |
Mar
(10) |
Apr
(13) |
May
(100) |
Jun
(100) |
Jul
(77) |
Aug
(87) |
Sep
(80) |
Oct
(124) |
Nov
(39) |
Dec
(41) |
| 2007 |
Jan
(20) |
Feb
(32) |
Mar
(32) |
Apr
(43) |
May
(146) |
Jun
(40) |
Jul
(49) |
Aug
(33) |
Sep
(25) |
Oct
(19) |
Nov
(11) |
Dec
(8) |
| 2008 |
Jan
(4) |
Feb
(11) |
Mar
(31) |
Apr
(40) |
May
(34) |
Jun
(24) |
Jul
(39) |
Aug
(104) |
Sep
(27) |
Oct
(35) |
Nov
(34) |
Dec
(97) |
| 2009 |
Jan
(75) |
Feb
(29) |
Mar
(45) |
Apr
(76) |
May
(121) |
Jun
(103) |
Jul
(67) |
Aug
(28) |
Sep
(22) |
Oct
(39) |
Nov
(9) |
Dec
(15) |
| 2010 |
Jan
(7) |
Feb
(39) |
Mar
(40) |
Apr
(57) |
May
(67) |
Jun
(69) |
Jul
(49) |
Aug
(68) |
Sep
(22) |
Oct
(7) |
Nov
(2) |
Dec
(10) |
| 2011 |
Jan
|
Feb
|
Mar
(10) |
Apr
(4) |
May
(6) |
Jun
(10) |
Jul
(16) |
Aug
(23) |
Sep
(9) |
Oct
|
Nov
(28) |
Dec
(3) |
| 2012 |
Jan
(11) |
Feb
(10) |
Mar
(1) |
Apr
|
May
(4) |
Jun
(3) |
Jul
(3) |
Aug
(4) |
Sep
(2) |
Oct
|
Nov
|
Dec
(1) |
| 2013 |
Jan
|
Feb
(7) |
Mar
(30) |
Apr
(4) |
May
(4) |
Jun
(8) |
Jul
(10) |
Aug
(4) |
Sep
|
Oct
(2) |
Nov
(24) |
Dec
(13) |
| 2014 |
Jan
(7) |
Feb
(2) |
Mar
|
Apr
(1) |
May
(9) |
Jun
|
Jul
(3) |
Aug
(9) |
Sep
|
Oct
(2) |
Nov
|
Dec
(3) |
| 2015 |
Jan
(4) |
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
(1) |
Oct
(4) |
Nov
(7) |
Dec
(39) |
| 2016 |
Jan
(17) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(1) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
(2) |
| 2017 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(1) |
Jun
(2) |
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
| 2018 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2019 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(1) |
Dec
(1) |
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
| 2025 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Alex M. <ale...@us...> - 2007-04-11 20:22:46
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv26006 Modified Files: optinline.f Log Message: arm: reflect changes in kernel, remove incorrect inlining of PERFORM Index: optinline.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optinline.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** optinline.f 22 Mar 2007 02:13:56 -0000 1.6 --- optinline.f 11 Apr 2007 20:22:42 -0000 1.7 *************** *** 113,120 **** ' xt-inline, compiles-for rshift ' xt-inline, compiles-for arshift ! ' xt-inline, compiles-for incr ! ' xt-inline, compiles-for decr ! ' xt-inline, compiles-for cincr ! ' xt-inline, compiles-for cdecr ' xt-inline, compiles-for on ' xt-inline, compiles-for off --- 113,120 ---- ' xt-inline, compiles-for rshift ' xt-inline, compiles-for arshift ! ' xt-inline, compiles-for 1+! ! ' xt-inline, compiles-for 1-! ! ' xt-inline, compiles-for 1+c! ! ' xt-inline, compiles-for 1-c! ' xt-inline, compiles-for on ' xt-inline, compiles-for off *************** *** 159,163 **** ' xt-inline, compiles-for lcount ' xt-inline, compiles-for zcount - ' xt-inline, compiles-for perform ' xt-inline, compiles-for bounds --- 159,162 ---- |
|
From: Alex M. <ale...@us...> - 2007-04-11 20:21:56
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25621 Modified Files: primutil.f Log Message: arm: -- is no longer a comment in its own right Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** primutil.f 22 Mar 2007 02:11:27 -0000 1.24 --- primutil.f 11 Apr 2007 20:21:53 -0000 1.25 *************** *** 86,90 **** synonym // \ \ comment after // - synonym -- \ \ comment after -- synonym <a \ \ html link start marker : //{{no_dependencies}} ; \ so we can load .h file --- 86,89 ---- |
|
From: Alex M. <ale...@us...> - 2007-04-11 20:20:32
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25090 Modified Files: dis486.f Log Message: arm: rework of disassembler, simplify, correct some formatting bugs, now does prefix operations (specifically 16 bit) correctly Index: dis486.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/dis486.f,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** dis486.f 22 Mar 2007 02:08:33 -0000 1.16 --- dis486.f 11 Apr 2007 20:20:28 -0000 1.17 *************** *** 97,101 **** [char] + emit $. \ and the non-zero offset else space then ! else drop $. then ; --- 97,101 ---- [char] + emit $. \ and the non-zero offset else space then ! else drop $s. then ; [...1085 lines suppressed...] 2dup - 0> \ anything left? *************** *** 1147,1153 **** next-inst c@ $c3 = if cr inst then ." ( end )" 2drop ! dup >name n>tfa c@ tdef = if \ if it's a defer defer@ recurse \ do again for deferred word ! else drop then ; : see ( <name> -- ) --- 1119,1127 ---- next-inst c@ $c3 = if cr inst then ." ( end )" 2drop ! dup >name n>tfa c@ tdef <> if \ if it's not a defer ! drop ! else defer@ recurse \ do again for deferred word ! then ; : see ( <name> -- ) |
|
From: Alex M. <ale...@us...> - 2007-04-11 20:18:35
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv24239/src/kernel Modified Files: gkernel.f Log Message: arm: minor changes; rename incr, decr ro 1+! 1-! Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.34 retrieving revision 1.35 diff -C2 -d -r1.34 -r1.35 *** gkernel.f 22 Mar 2007 02:13:56 -0000 1.34 --- gkernel.f 11 Apr 2007 20:18:30 -0000 1.35 *************** *** 488,492 **** mov ecx, [ebp] mov ax, cx ! next c; \ -------------------- Arithmetic Operators --------------------------------- --- 488,492 ---- mov ecx, [ebp] mov ax, cx ! next; \ -------------------- Arithmetic Operators --------------------------------- *************** *** 760,764 **** next; ! code incr ( addr -- ) \ increment the contents of addr 1 0 in/out add dword [eax], # 1 --- 760,764 ---- next; ! code 1+! ( addr -- ) \ increment the contents of addr 1 0 in/out add dword [eax], # 1 *************** *** 766,770 **** next; ! code decr ( addr -- ) \ decrement the contents of addr 1 0 in/out sub dword [eax], # 1 --- 766,770 ---- next; ! code 1-! ( addr -- ) \ decrement the contents of addr 1 0 in/out sub dword [eax], # 1 *************** *** 772,776 **** next; ! code cincr ( addr -- ) \ increment the byte contents of addr 1 0 in/out add byte [eax], # 1 --- 772,776 ---- next; ! code 1+c! ( addr -- ) \ increment the byte contents of addr 1 0 in/out add byte [eax], # 1 *************** *** 778,782 **** next; ! code cdecr ( addr -- ) \ decrement the byte contents of addr 1 0 in/out sub byte [eax], # 1 --- 778,782 ---- next; ! code 1-c! ( addr -- ) \ decrement the byte contents of addr 1 0 in/out sub byte [eax], # 1 *************** *** 995,998 **** --- 995,1000 ---- (comp-only) compilation> drop _r>drop (copy-code) ; 0 0 in/out + + ' r>drop alias rdrop gcode _2>r \ push two items onto the rstack *************** *** 1502,1506 **** code * ( n1 n2 -- n3 ) \ multiply n1 by n2, return single result n3 2 1 in/out ! imul dword [ebp] next; --- 1504,1508 ---- code * ( n1 n2 -- n3 ) \ multiply n1 by n2, return single result n3 2 1 in/out ! imul dword [ebp] next; *************** *** 2211,2215 **** : , ( n -- ) here ! cell dp +! ; \ cell store, incr : w, ( n -- ) here w! 2 dp +! ; \ word store, incr ! : c, ( n -- ) here c! dp incr ; \ char store : mem-free ( -- n1 ) dp 2 cells+ @ here - ; --- 2213,2217 ---- : , ( n -- ) here ! cell dp +! ; \ cell store, incr : w, ( n -- ) here w! 2 dp +! ; \ word store, incr ! : c, ( n -- ) here c! dp 1+! ; \ char store : mem-free ( -- n1 ) dp 2 cells+ @ here - ; *************** *** 2356,2362 **** \ : IF -14 throw \ compilation> ...stuff to do IF at compile... ; ! \ ' opt-swap compiles swap ! \ ' noop compiles chars ! \ ' opt-inline compiles dup \ : x swap ; inline --- 2358,2364 ---- \ : IF -14 throw \ compilation> ...stuff to do IF at compile... ; ! \ ' opt-swap compiles-for swap ! \ ' noop compiles-for chars ! \ ' opt-inline compiles-for dup \ : x swap ; inline *************** *** 3318,3324 **** cmp eax, edi jae short @@3 \ out of base range ! xchg eax, 4 [ebp] \ high word * base mul edi ! xchg eax, 8 [ebp] \ low word * base mul edi add eax, 4 [ebp] \ add --- 3320,3332 ---- cmp eax, edi jae short @@3 \ out of base range ! \ xchg eax, 4 [ebp] \ high word * base ! mov edx, eax ! mov eax, 4 [ebp] \ swap eax <-> 4 [ebp] ! mov 4 [ebp], edx mul edi ! \ xchg eax, 8 [ebp] \ low word * base ! mov edx, eax ! mov eax, 8 [ebp] \ swap eax <-> 8 [ebp] ! mov 8 [ebp], edx mul edi add eax, 4 [ebp] \ add *************** *** 3398,3405 **** jbe short @@1 add al, # 7 ! @@1: add al, # char 0 mov ecx, hld [up] sub ecx, # 1 ! mov 0 [ecx], al mov hld [up], ecx mov eax, esi --- 3406,3413 ---- jbe short @@1 add al, # 7 ! @@1: add al, # '0' mov ecx, hld [up] sub ecx, # 1 ! mov [ecx], al mov hld [up], ecx mov eax, esi |
|
From: Alex M. <ale...@us...> - 2007-04-11 20:18:35
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv24239 Modified Files: gkernel.exe Log Message: arm: minor changes; rename incr, decr ro 1+! 1-! Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.40 retrieving revision 1.41 diff -C2 -d -r1.40 -r1.41 Binary files /tmp/cvscZ2isw and /tmp/cvsQe4Yh2 differ |
|
From: Janet s. <Jan...@Ha...> - 2007-04-03 15:36:52
|
acts as until purchased allow licenses be http://img444.imageshack.us/img444/4604/xqkk1.gif SDK PSP Audio Manager MailCOPA Email ReachaMail |
|
From: Alex M. <ale...@us...> - 2007-03-23 11:43:33
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5345/src/kernel Modified Files: gkernext.f Log Message: arm: reverted over-aggressive stack adjustment code Index: gkernext.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernext.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** gkernext.f 22 Mar 2007 02:13:56 -0000 1.4 --- gkernext.f 23 Mar 2007 11:43:28 -0000 1.5 *************** *** 48,53 **** macro: next ( -- ) \ assemble the code to do a next a; - ste-adjust \ adjust stack - ste-reset ofa-calc \ resolve the optimizer field address ret --- 48,51 ---- *************** *** 55,58 **** --- 53,58 ---- macro: next; ( -- ) \ terminate code word + ste-adjust \ adjust stack + ste-reset next c; \ and return ;macro |
|
From: Alex M. <ale...@us...> - 2007-03-23 11:43:32
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5345 Modified Files: gkernel.exe Log Message: arm: reverted over-aggressive stack adjustment code Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.39 retrieving revision 1.40 diff -C2 -d -r1.39 -r1.40 Binary files /tmp/cvsF0KgWo and /tmp/cvsdOSa9r differ |
|
From: Alex M. <ale...@us...> - 2007-03-22 02:14:08
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv12049 Modified Files: gkernel.exe Log Message: arm: variable inline length control, support stack effects properly Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.38 retrieving revision 1.39 diff -C2 -d -r1.38 -r1.39 Binary files /tmp/cvsx7PVRT and /tmp/cvsrcWKvT differ |
|
From: Alex M. <ale...@us...> - 2007-03-22 02:14:08
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv12049/src/kernel Modified Files: gkernel.f gkernext.f gmeta-compiler.f gmeta-fkernel.f Log Message: arm: variable inline length control, support stack effects properly Index: gmeta-compiler.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gmeta-compiler.f,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** gmeta-compiler.f 22 Jan 2007 21:51:40 -0000 1.12 --- gmeta-compiler.f 22 Mar 2007 02:13:56 -0000 1.13 *************** *** 56,59 **** --- 56,61 ---- \ FORWARD words are used in the kernel before they are defined. + sys-warning-off + vocabulary meta \ metacompiler implementation vocabulary target \ target words *************** *** 551,555 **** 2dup ste-o ! ste-i ! ! last-h @ n>ste dup>r 1+ tsys-c! r> tsys-c! ; \ resolution of cts --- 553,557 ---- 2dup ste-o ! ste-i ! ! last-h @ n>ste dup>r 1+ tsys-c! r> tsys-c! ; \ resolution of cts *************** *** 664,667 **** --- 666,681 ---- ' ofa-meta is ofa-calc + : ste-meta ( -- ) \ generate adjustment offset + ste-i @ ste-o @ + 2dup or 0< not -rot - cells and \ zero if either -ve + dup if >r + macro[ + lea ebp, r@ [ebp] \ !! use lea not add/sub to preserve cc + ]macro r> + then drop ste-reset \ reset + ; + + ' ste-meta is ste-adjust + : init-assembler ( -- ) \ prepare for assembly code [ assembler ] clear-labels *************** *** 686,697 **** previous ; ! : t-ecxaddr ( n -- ) \ generate a mov ecx, # n $c1c7 tcode-w, \ mov ecx, # tcode-, ; \ the value ! : t-dogen ( xt type-of-name <-name-> -- ) \ generate do code 2>r code 2r> t-tfa! \ type ! t-align t-here t-ecxaddr make-tjmp, \ name -> mov ecx, # here | jmp xt macro[ c; ]macro ofa-meta ; --- 700,722 ---- previous ; ! : t-ecxaddr-# ( n -- ) \ generate a mov ecx, # n $c1c7 tcode-w, \ mov ecx, # tcode-, ; \ the value ! : t-ecxaddr-@ ( n -- ) \ generate a mov ecx, n ! $0D8B tcode-w, \ mov ecx, ! tcode-, ; \ the value ! ! : t-dogen-# ( xt type-of-name <-name-> -- ) \ generate do code 2>r code 2r> t-tfa! \ type ! t-align t-here t-ecxaddr-# make-tjmp, \ name -> mov ecx, # here | jmp xt ! macro[ c; ]macro ! ofa-meta ; ! ! : t-dogen-@ ( xt type-of-name <-name-> -- ) \ generate do code ! 2>r code 2r> ! t-tfa! \ type ! t-align t-here t-ecxaddr-@ make-tjmp, \ name -> mov ecx, here | jmp xt macro[ c; ]macro ofa-meta ; *************** *** 1017,1021 **** : variable ( -<name>- ) \ create a variable (changable) t-align t-here meta-constant ! s" 't-ptr dovar" evaluate tvar t-dogen 0 t-, 0 1 in/out --- 1042,1046 ---- : variable ( -<name>- ) \ create a variable (changable) t-align t-here meta-constant ! s" 't-ptr dovar" evaluate tvar t-dogen-# 0 t-, 0 1 in/out *************** *** 1024,1028 **** : create ( -<name>- ) \ create a ptr to here t-align t-here meta-constant ! s" 't-ptr dovar" evaluate tvar t-dogen 0 1 in/out ; --- 1049,1053 ---- : create ( -<name>- ) \ create a ptr to here t-align t-here meta-constant ! s" 't-ptr dovar" evaluate tvar t-dogen-# 0 1 in/out ; *************** *** 1038,1042 **** : value ( n -<name>- ) \ create a self fetching changeable value ! s" 't-ptr doval" evaluate tval t-dogen t-, 0 1 in/out --- 1063,1067 ---- : value ( n -<name>- ) \ create a self fetching changeable value ! s" 't-ptr dovar" evaluate tval t-dogen-@ t-, 0 1 in/out Index: gmeta-fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gmeta-fkernel.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** gmeta-fkernel.f 4 Oct 2006 10:27:37 -0000 1.2 --- gmeta-fkernel.f 22 Mar 2007 02:13:56 -0000 1.3 *************** *** 98,103 **** \ ======================= LOAD COMPILER ============================= - defer ofa-calc - KERN-NEXT $FLOAD \ load kernel extension for NEXT, EXEC code KERN-CMP $FLOAD \ load the compiler --- 98,101 ---- Index: gkernext.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernext.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** gkernext.f 13 Nov 2006 00:49:28 -0000 1.3 --- gkernext.f 22 Mar 2007 02:13:56 -0000 1.4 *************** *** 39,91 **** cr .( Loading NEXT ASM Support) ! get-current also forth definitions ! ! variable ste-i -1 ste-i ! \ # of input cells, -ve is unknown ! variable ste-o -1 ste-o ! \ # of output cells, -ve is unknown ! ! : ste-reset ( -- ) \ reset stack effects ! ste-i on ste-o on ; ! ! : ste-zero ( -- ) \ zero stack effects ! ste-i off ste-o off ; ! : ste-adjust ( -- ) \ generate adjustment offset ! ste-i @ ste-o @ ! 2dup or 0< not -rot - cells and \ zero if either -ve ! dup if >r ! macro[ ! lea ebp, r@ [ebp] \ !! use lea not add/sub to preserve cc ! ]macro r> ! then drop ste-reset \ reset ! ; ! : ste-calc ( in out -- ) \ calculate stack effects ! 2dup or ste-i @ or ste-o @ or 0< \ if any -ve ! if ! 2drop ste-reset \ set both -ve ! else ! over ste-o @ - dup 0> \ get in stk value ! if ! dup ste-i +! ste-o +! \ adjust ! else ! drop ! then ! swap - ste-o +! ! then ! ; ! ! previous set-current macro: next ( -- ) \ assemble the code to do a next a; ofa-calc \ resolve the optimizer field address ! ret ;macro macro: next; ( -- ) \ terminate code word - ste-adjust \ adjust stack next c; \ and return - ste-reset ;macro - --- 39,59 ---- cr .( Loading NEXT ASM Support) ! [DEFINED] setsize [IF] \ when meta-compiling ! defer ofa-calc \ these are overriden by ! defer ste-adjust \ meta compiler equivalents ! [THEN] macro: next ( -- ) \ assemble the code to do a next a; + ste-adjust \ adjust stack + ste-reset ofa-calc \ resolve the optimizer field address ! ret ;macro macro: next; ( -- ) \ terminate code word next c; \ and return ;macro Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.33 retrieving revision 1.34 diff -C2 -d -r1.33 -r1.34 *** gkernel.f 15 Mar 2007 17:55:15 -0000 1.33 --- gkernel.f 22 Mar 2007 02:13:56 -0000 1.34 *************** *** 241,265 **** jmp ecx \ go execute next c; - \ -------------------------- Primitives ----------------------------- code dovar ( -- n ) \ variable mov -4 [ebp], eax - lea ebp, -4 [ebp] mov eax, ecx ! next c; ! ! code doval ( -- n ) \ value ! mov -4 [ebp], eax ! lea ebp, -4 [ebp] ! mov eax, [ecx] ! next c; code dousr ( -- n ) \ user mov -4 [ebp], eax mov eax, [ecx] \ offset - lea ebp, -4 [ebp] add eax, ebx ! next c; \ ------------------------- Vector Variables -------------------------- --- 241,259 ---- jmp ecx \ go execute next c; \ -------------------------- Primitives ----------------------------- code dovar ( -- n ) \ variable + 0 1 in/out mov -4 [ebp], eax mov eax, ecx ! next; code dousr ( -- n ) \ user + 0 1 in/out mov -4 [ebp], eax mov eax, [ecx] \ offset add eax, ebx ! next; ! \ ------------------------- Vector Variables -------------------------- *************** *** 2244,2250 **** : (syswarn) ( xt -- xt ) \ warn if system word in app word ! dup sys-addr? \ address in system space ! in-sys? 0= and \ not currently system pointer ! if warn_sysword warnmsg then ; code -aligned ( addr1 -- addr2 ) --- 2238,2246 ---- : (syswarn) ( xt -- xt ) \ warn if system word in app word ! sys-warning? if ! dup sys-addr? \ address in system space ! in-sys? 0= and \ not currently system pointer ! if warn_sysword warnmsg then ! then ; code -aligned ( addr1 -- addr2 ) *************** *** 2272,2279 **** : 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 --- 2268,2276 ---- : code-allot ( n1 -- ) >code allot dp> ; : code-, ( n -- ) >code , dp> ; : code-w, ( n -- ) >code w, dp> ; : code-c, ( n -- ) >code c, dp> ; + : code-! ( n -- ) >code ! dp> ; + : code-w! ( n -- ) >code w! dp> ; + : code-c! ( n -- ) >code c! dp> ; \ : code-align ( -- ) >code \ cell allot \ align to 16byte boundary *************** *** 2392,2397 **** 0 | value tail-call \ see exit for use - \ *enhance if in-application, needs to issue warning if a call into system space : xt-call, ( xt -- ) \ core routine for generation a call sync-code \ ensure outstanding code generated $e8 xt-rel, \ compile call to xt on the stack --- 2389,2394 ---- 0 | value tail-call \ see exit for use : xt-call, ( xt -- ) \ core routine for generation a call + (syswarn) \ check the xt issue warning if a call into system space sync-code \ ensure outstanding code generated $e8 xt-rel, \ compile call to xt on the stack *************** *** 2424,2434 **** : (copy-code) ( addr -- ) count copy-code ; \ routine to copy the code : xt-inline, ( xt -- ) \ inline the xt dup >name n>ofa \ get the length ! w@ copy-code ; \ and copy the code : inline ( -- ) \ code will be inlined ! tail-call 0= if \ there's a tail-call, so not inlineable ! ['] xt-inline, compiles-last then ; --- 2421,2437 ---- : (copy-code) ( addr -- ) count copy-code ; \ routine to copy the code + -1 value xt-inline-max \ max length of an inline, -1 is unlimited + : 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 ! drop xt-call, \ otherwise generate a call ! then ; : inline ( -- ) \ code will be inlined ! tail-call 0= if \ there's no calls, so inlineable ! ['] xt-inline, compiles-last \ tail-call is set for any call then ; *************** *** 2438,2441 **** --- 2441,2477 ---- \ -------------------- Various support words -------------------------- + variable ste-i -1 ste-i ! \ # of input cells, -ve is unknown + variable ste-o -1 ste-o ! \ # of output cells, -ve is unknown + + : ste-reset ( -- ) \ reset stack effects + ste-i on ste-o on ; + + : ste-zero ( -- ) \ zero stack effects + ste-i off ste-o off ; + + : ste-adjust ( -- ) \ generate adjustment offset + ste-i @ ste-o @ + 2dup or 0< not -rot - cells and \ zero if either -ve + dup if + $6D8D code-w, code-c, \ lea ebp, n [ebp] + else drop then + ste-reset \ reset + ; + + : ste-calc ( in out -- ) \ calculate stack effects + 2dup or ste-i @ or ste-o @ or 0< \ if any -ve + if + 2drop ste-reset \ set both -ve + else + over ste-o @ - dup 0> \ get in stk value + if + dup ste-i +! ste-o +! \ adjust + else + drop + then + swap - ste-o +! + then + ; + : (in/out@) ( nfa -- in out ) \ get the ste values n>ste dup sc@ swap 1+ sc@ ; *************** *** 2444,2453 **** last @ (in/out@) ; ! : (in/out!) ( in out -- ) \ set the ste values last @ n>ste dup>r 1+ c! r> c! ; - ' (in/out!) alias in/out immediate \ immediate version - \ ---------------------------- Defining Words -------------------------------- --- 2480,2488 ---- last @ (in/out@) ; ! : in/out ( in out -- ) \ set the ste values ! 2dup ste-o ! ste-i ! \ set calc values last @ n>ste dup>r 1+ c! r> c! ; \ ---------------------------- Defining Words -------------------------------- *************** *** 2474,2481 **** $C1C7 code-w, code-, ; \ mov ecx, # 2 equ body-off \ the offset where a body is - 7 equ addr-off \ the offset of the address part ! : >body ( xt -- body ) body-off + @ ; \ get body of created word : literal ( n -- ) \ compile time --- 2509,2524 ---- $C1C7 code-w, code-, ; \ mov ecx, # + : mov-ecx,n ( n -- ) \ generate a mov ecx, n + sync-code \ generate pending code + $0D8B code-w, code-, ; \ mov ecx, + 2 equ body-off \ the offset where a body is ! \ : >body ( xt -- body ) body-off + @ ; \ get body of created word ! ! code >body ! 1 1 in/out ! mov eax, body-off [eax] \ body-off + @ ! next; : literal ( n -- ) \ compile time *************** *** 2486,2501 **** mov-tos,#n ; ! : dogen ( xt type-of-name <-name-> -- ) \ generate do code header \ header tfa! \ set the type ! here mov-ecx,#n xt-jmp, \ name -> mov ecx, # here | jmp xt ofa-calc ; \ length calculation : (comp-cons) ( xt -- ) execute postpone literal ; \ execute & compile a literal ! : constant ( n "name" ) \ compile time ( -- n ) \ run time >system \ constant value in system space ! ['] doval tcon dogen , dp> ['] (comp-cons) compiles-last \ make the defined word compile this --- 2529,2550 ---- mov-tos,#n ; ! : dogen-# ( xt type-of-name <-name-> -- ) \ generate do code header \ header tfa! \ set the type ! here mov-ecx,#n xt-jmp, \ name -> mov ecx, # here | jmp xt ! ofa-calc ; \ length calculation ! ! : dogen-@ ( xt type-of-name <-name-> -- ) \ generate do code ! header \ header ! tfa! \ set the type ! here mov-ecx,n xt-jmp, \ name -> mov ecx, here | jmp xt ofa-calc ; \ length calculation : (comp-cons) ( xt -- ) execute postpone literal ; \ execute & compile a literal ! : constant ( n "name" ) \ compile time ( -- n ) \ run time >system \ constant value in system space ! ['] dovar tcon dogen-@ , \ equivalent of does> @ dp> ['] (comp-cons) compiles-last \ make the defined word compile this *************** *** 2506,2510 **** : create ( -<name>- ) \ pointer ! ['] dovar tcre dogen ['] (comp-create) compiles-last \ doesn't work because of DOES> , needs fixed ??? 0 1 in/out --- 2555,2559 ---- : create ( -<name>- ) \ pointer ! ['] dovar tcre dogen-# ['] (comp-create) compiles-last \ doesn't work because of DOES> , needs fixed ??? 0 1 in/out *************** *** 2513,2517 **** : variable ( "name") \ compile time ( -- n ) \ run time ! ['] dovar tvar dogen 0 , ['] (comp-cons) compiles-last 0 1 in/out --- 2562,2566 ---- : variable ( "name") \ compile time ( -- n ) \ run time ! ['] dovar tvar dogen-# 0 , ['] (comp-cons) compiles-last 0 1 in/out *************** *** 2522,2530 **** : value ( n -<name>- ) \ self fetching value ! ['] doval tval dogen , ['] (comp-val) compiles-last \ make the defined word compile this 0 1 in/out ; 1 0 in/out ! : 2literal ( n m -- ) \ run-time skeleton for 2literal (comp-only) \ compile only --- 2571,2579 ---- : value ( n -<name>- ) \ self fetching value ! ['] dovar tval dogen-@ , ['] (comp-val) compiles-last \ make the defined word compile this 0 1 in/out ; 1 0 in/out ! : 2literal ( n m -- ) \ run-time skeleton for 2literal (comp-only) \ compile only *************** *** 3633,3637 **** : user ( n -<name>- ) \ create a user variable ! ['] dousr tusr dogen , 0 1 in/out ; 1 0 in/out --- 3682,3686 ---- : user ( n -<name>- ) \ create a user variable ! ['] dousr tusr dogen-# , 0 1 in/out ; 1 0 in/out *************** *** 4602,4608 **** --- 4651,4660 ---- ofa (ofa-calc) ; + defer ; immediate \ changed to suit the type of colon def + |: ;noname ( -- ) \ ; for :noname postpone exit \ this may compile _localfree postpone [ ?csp \ stop compiling, check stack + ['] (comp-only) is ; ; *************** *** 4612,4617 **** reveal ; \ reveal the name - defer ; immediate \ changed to suit the type of colon def - \ Words to support : --- 4664,4667 ---- *************** *** 4686,4689 **** --- 4736,4741 ---- \ uses the return address to calcuate the body of does>. + 7 equ addr-off \ the offset of the address part + : (;code) ( -- ) \ compile code for does> r@ 1+ \ code for does> (after ret) *************** *** 4718,4722 **** 0 to localstk \ can have its own locals cs-leave -stack \ clear the stack used for leave addresses ! code-here latestxt @ (compiles-set) \ make the defined word compile this ; --- 4770,4774 ---- 0 to localstk \ can have its own locals cs-leave -stack \ clear the stack used for leave addresses ! code-here compiles-last \ make the defined word compile this ; |
|
From: Alex M. <ale...@us...> - 2007-03-22 02:14:08
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv12049/src Modified Files: optinline.f optliterals.f Log Message: arm: variable inline length control, support stack effects properly Index: optliterals.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optliterals.f,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** optliterals.f 15 Mar 2007 17:55:15 -0000 1.13 --- optliterals.f 22 Mar 2007 02:13:56 -0000 1.14 *************** *** 148,159 **** : lits>1? ( -- n ) lits sdepth 1 > ; ! variable in-sync in-sync off \ to stop recursion in sync-code : litsync ( -- ) \ called when code is about to be generated in-sync @ 0= if \ recursing? in-sync on \ no, so set stk-adjust lits>0? dup if \ anything to do? ! -4 tos->n[ebp] \ save tos lits spop 0 #n->stk[] \ load tos lits sdepth 0 ?do \ do for n-1 entries --- 148,160 ---- : lits>1? ( -- n ) lits sdepth 1 > ; ! variable in-sync in-sync off \ to stop recursion in sync-code : litsync ( -- ) \ called when code is about to be generated in-sync @ 0= if \ recursing? in-sync on \ no, so set + [ also assembler ] a; [ previous ] \ make sure assembler has finished stk-adjust lits>0? dup if \ anything to do? ! -4 tos->n[ebp] \ save tos lits spop 0 #n->stk[] \ load tos lits sdepth 0 ?do \ do for n-1 entries Index: optinline.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optinline.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** optinline.f 13 Nov 2006 00:49:19 -0000 1.5 --- optinline.f 22 Mar 2007 02:13:56 -0000 1.6 *************** *** 39,43 **** also optimise definitions ! \ set some optimisation for constants in the kernel --- 39,43 ---- also optimise definitions ! -1 to xt-inline-max \ set maximum length of inline here; -1 is unlimited \ set some optimisation for constants in the kernel |
|
From: Alex M. <ale...@us...> - 2007-03-22 02:11:33
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv11236 Modified Files: float.f primutil.f Log Message: arm: remove use of NEXT, in code sections Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** primutil.f 15 Mar 2007 17:55:15 -0000 1.23 --- primutil.f 22 Mar 2007 02:11:27 -0000 1.24 *************** *** 113,119 **** in-system - defer enter-assembler ' noop is enter-assembler - defer exit-assembler ' noop is exit-assembler - : (comp-offs) ( xt -- ) 0 swap execute postpone literal postpone + ; --- 113,116 ---- Index: float.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/float.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** float.f 8 Dec 2006 10:27:31 -0000 1.6 --- float.f 22 Mar 2007 02:11:27 -0000 1.7 *************** *** 50,54 **** mov tos, 0 [ebp] lea ebp, 4 [ebp] ! next, end-code --- 50,54 ---- mov tos, 0 [ebp] lea ebp, 4 [ebp] ! next end-code *************** *** 58,62 **** mov tos, 0 [ebp] lea ebp, 4 [ebp] ! next, end-code --- 58,62 ---- mov tos, 0 [ebp] lea ebp, 4 [ebp] ! next end-code *************** *** 68,72 **** mov tos, -8 [ebp] lea ebp, -4 [ebp] ! next, end-code --- 68,72 ---- mov tos, -8 [ebp] lea ebp, -4 [ebp] ! next end-code *************** *** 76,80 **** mov tos, 0 [ebp] lea ebp, 4 [ebp] ! next, end-code --- 76,80 ---- mov tos, 0 [ebp] lea ebp, 4 [ebp] ! next end-code *************** *** 84,88 **** fnstsw ax lea ebp, -4 [ebp] ! next, end-code --- 84,88 ---- fnstsw ax lea ebp, -4 [ebp] ! next end-code *************** *** 177,181 **** ret L$1: mov tos, # FPU_STATUS_CCF_EMPTY ! next, end-code --- 177,181 ---- ret L$1: mov tos, # FPU_STATUS_CCF_EMPTY ! next end-code *************** *** 193,197 **** and word -4 [ebp], # 0x0eff \ 8 byte mode fldcw word -4 [ebp] [THEN] ! next, end-code --- 193,197 ---- and word -4 [ebp], # 0x0eff \ 8 byte mode fldcw word -4 [ebp] [THEN] ! next end-code |
|
From: Alex M. <ale...@us...> - 2007-03-22 02:08:42
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10027 Modified Files: asmwin32.f dis486.f Log Message: arm: tidy up asm interface, make DIS visible in forth vocabulary Index: asmwin32.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/asmwin32.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** asmwin32.f 7 Nov 2006 11:04:50 -0000 1.5 --- asmwin32.f 22 Mar 2007 02:08:33 -0000 1.6 *************** *** 22,58 **** ( This file version 1.1, first distributed with 486asm, version 1.1 ) ! only forth also definitions also assembler also asm-hidden ! forth ' code-c, asm-hidden is code-c, ( x -- ) ! forth ' code-w, asm-hidden is code-w, ( x -- ) ! forth ' code-, asm-hidden is code-d, ( x -- ) ! forth ' code-here asm-hidden is code-here ( -- a ) ! forth ' code-align asm-hidden is code-align ( -- ) ! forth ' header asm-hidden is code-header ( -- ) ! : (_code) ( start a native code definition ) ! code-header hide ! !csp init-asm ! code-here to ofa ! 0 to tail-call ; ! ' (_code) is code ! only forth also assembler also asm-hidden definitions also forth ! ' _;code is ;code : (macro[) a; enter-macro ; : (]macro) leave-macro a; ; ! definitions ! : 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 only forth also assembler definitions --- 22,63 ---- ( This file version 1.1, first distributed with 486asm, version 1.1 ) ! only forth definitions also assembler ! ' code-c, also asm-hidden is code-c, previous ( x -- ) ! ' code-w, also asm-hidden is code-w, previous ( x -- ) ! ' code-, also asm-hidden is code-d, previous ( x -- ) ! ' code-! also asm-hidden is code-d! previous ( x -- ) ! ' code-here also asm-hidden is code-here previous ( -- a ) ! ' code-align also asm-hidden is code-align previous ( -- ) ! ' header also asm-hidden is code-header previous ( -- ) ! also asm-hidden definitions ! : (_end-code) ! _end-code ! \ *enhance needs work to support standard ;name ! \ ;name ! ['] (comp-only) is ; ! ; ! ! ' (_end-code) is end-code ! : (_code) ( start a native code definition ) ! : init-asm postpone [ \ runs in interpreted mode, not compile ! ['] end-code is ; \ set the code ; word ! ; ! ' (_code) is code : (macro[) a; enter-macro ; : (]macro) leave-macro a; ; ! also forth definitions ! : macro[ ( generate code in a definition ) ! also assembler postpone (macro[) ; immediate ! : ]macro ( end generating code ) ! postpone (]macro) previous ; immediate only forth also assembler definitions *************** *** 60,66 **** ' end-code alias c; fload src\kernel\gkernext.f \ load exec/next words - ' next alias next, ' noop alias ptr immediate --- 65,75 ---- ' end-code alias c; + \ Everything below this line was added to support Tom Zimmer + \ It was diked out of 486asm.f and put here because it could make it + \ difficult to load the assembler as a cross assembler + \ 12/21/94 09:45 tjz added for Win32Forth + fload src\kernel\gkernext.f \ load exec/next words ' noop alias ptr immediate *************** *** 80,97 **** macro: [tos], ( -- ) [eax], endm - \ Everything below this line was added to support Tom Zimmer - \ It was diked out of 486asm.f and put here because it could make it - \ difficult to load the assembler as a cross assembler - \ 12/21/94 09:45 tjz added for Win32Forth - - only forth also assembler definitions also asm-hidden - - : _enter-assembler ( -- ) - hide !csp init-asm ( code-here ofa-last code-d! ) ; - - ' _enter-assembler is enter-assembler - - \ exit-assembler is unused ( -- ) - only forth also definitions --- 89,92 ---- Index: dis486.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/dis486.f,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** dis486.f 15 Mar 2007 17:55:15 -0000 1.15 --- dis486.f 22 Mar 2007 02:08:33 -0000 1.16 *************** *** 105,109 **** code (next-seq) \ next sequence as counted string 2 code-c, ! next; ' (next-seq) value next-seq \ counted string --- 105,109 ---- code (next-seq) \ next sequence as counted string 2 code-c, ! next ; ' (next-seq) value next-seq \ counted string *************** *** 1063,1066 **** --- 1063,1071 ---- : .ds cr ." string " 0x22 emit count 2dup type + 0x22 emit ; + : desc-stack ( n -- ) + dup 0< if drop ." ? " else . then ; + + also forth definitions + : dis ( adr -- ) begin *************** *** 1079,1087 **** repeat 3drop ; - : desc-stack ( n -- ) - dup 0< if drop ." ? " else . then ; - - also forth definitions - \ *bug needs to check for :noname type xts : describe ( xt -- ) --- 1084,1087 ---- |
|
From: Alex M. <ale...@us...> - 2007-03-22 02:06:57
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9217/src Modified Files: 486asm.f Log Message: arm: asm changes to correctly process context; remove no-errors reporting Index: 486asm.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/486asm.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** 486asm.f 2 Dec 2006 12:21:22 -0000 1.2 --- 486asm.f 22 Mar 2007 02:06:38 -0000 1.3 *************** *** 29,34 **** ( declare the vocabularies needed ) only forth definitions ( vocabulary assembler ) also assembler definitions ! vocabulary asm-hidden also asm-hidden definitions also assembler ! ( the also assembler is strictly to turn off stack warnings ) ( words to manipulate the vocabulary search order ) --- 29,33 ---- ( declare the vocabularies needed ) only forth definitions ( vocabulary assembler ) also assembler definitions ! vocabulary asm-hidden also asm-hidden definitions ( words to manipulate the vocabulary search order ) *************** *** 809,812 **** --- 808,812 ---- in-asm + (( : report-errors ( turn on error reporting ) ['] _?params is ?params *************** *** 864,867 **** --- 864,868 ---- ['] noop is ?mem ['] noop is ?reg ; + )) ( generate prefix sequences ) *************** *** 2016,2031 **** ( create code definitions ) in-hidden - variable current-sv ( needed for stashing the current vocabulary ) - : save-current ( save the current vocabulary linkage ) - ( -- ) - current data-@ current-sv data-! ; - - : unsave-current ( reset current-sv ) - ( -- ) - 0 current-sv data-! ; - - : restore-current ( restore current to its previously saved value ) - ( -- ) - current-sv data-@ ?dup if current data-! unsave-current then ; ( debugging ) --- 2017,2020 ---- *************** *** 2051,2059 **** : subr: ( create a subroutine in the assembler vocabulary ) ! save-current init-asm definitions !csp create hide data-here 0 ! data-, code-align code-here swap data-! does> data-@ ; : macro: ( create a macro in the assembler vocabulary ) ! save-current also assembler definitions : postpone enter-macro ; ( end code definitions ) --- 2040,2050 ---- : subr: ( create a subroutine in the assembler vocabulary ) ! init-asm !csp get-current definitions ! create hide code-here data-, ! set-current does> data-@ ; : macro: ( create a macro in the assembler vocabulary ) ! get-current >r also assembler definitions ! : postpone enter-macro r> set-current ; ( end code definitions ) *************** *** 2063,2068 **** in-hidden : _end-code ( end a code definition ) ! end-asm ?finished ?unres ?csp reveal restore-current code-align ! exit-assembler ; in-asm --- 2054,2058 ---- in-hidden : _end-code ( end a code definition ) ! end-asm ?finished ?unres ?csp reveal ; in-asm *************** *** 2071,2075 **** : endm ( end a macro definition ) ! postpone leave-macro postpone ; previous restore-current ; also forth immediate previous --- 2061,2065 ---- : endm ( end a macro definition ) ! postpone leave-macro postpone ; previous ; also forth immediate previous |
|
From: Alex M. <ale...@us...> - 2007-03-22 02:06:57
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9217 Modified Files: gkernel.exe Log Message: arm: asm changes to correctly process context; remove no-errors reporting Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.37 retrieving revision 1.38 diff -C2 -d -r1.37 -r1.38 Binary files /tmp/cvsjPrmKC and /tmp/cvsDNAseH differ |
|
From: Ignacio F. <rus...@ja...> - 2007-03-19 11:22:26
|
<html> <body bgcolor=3D"#ffffff" text=3D"#000000"> <img src=3D"cid:EE2FAD96=2E382E684A"> <br> It takes a wise man to handle a lie, a fool had better remain honest=2E = <br> The worst nightmare I ever had about Vietnam was that I had to go back=2E= I woke up in a sweat, in total terror=2E <br> A total commitment is paramount to reaching the ultimate in performance=2E= <br> A walking shadow, a poor player, that struts and frets his hour upon the= stage, and then is heard no more=2E <br> In free society art is not a weapon=2E Artists are not engineers of the = soul=2E <br> When a man brings his wife flowers for no reason, there's a reason=2E <br> It is not the situation that makes the man, but the man who makes the si= tuation=2E <br> Guilt is perhaps the most painful companion of death=2E <br> Faith may be defined briefly as an illogical belief in the occurrence of= the improbable=2E <br> Christian life consists of faith and charity=2E <br> Old age is an excellent time for outrage=2E My goal is to say or do at l= east one outrageous thing every week=2E <br> Crime expands according to our willingness to put up with it=2E <br> The life of the dead is placed in the memory of the living=2E </body> </html> |
|
From: Alex M. <ale...@us...> - 2007-03-15 17:55:44
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25895/src/kernel Modified Files: gkernel.f Log Message: arm: correct problems with turnkey; not yet fixed entirely (see optliterals) Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.32 retrieving revision 1.33 diff -C2 -d -r1.32 -r1.33 *** gkernel.f 13 Mar 2007 23:49:34 -0000 1.32 --- gkernel.f 15 Mar 2007 17:55:15 -0000 1.33 *************** *** 5,9 **** WIN32FORTH EXPERIMENTAL KERNEL ! SKERNEL.F Version 0.1 15/08/2005 23:09:35 --- 5,9 ---- WIN32FORTH EXPERIMENTAL KERNEL ! GKERNEL.F Version 0.1 15/08/2005 23:09:35 *************** *** 276,280 **** image-ksize constant kode-size image-ksep constant kode-offs ! image-ssize constant sys-size image-ssep constant sys-offs \ image-entry constant img-entry \ see after exem, the entry point --- 276,280 ---- image-ksize constant kode-size image-ksep constant kode-offs ! image-ssize value sys-size \ changed for turnkey image-ssep constant sys-offs \ image-entry constant img-entry \ see after exem, the entry point *************** *** 2235,2239 **** : 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 --- 2235,2239 ---- : sys-addr? ( a -- f ) \ is it a system address? ! sdp cell+ @ u> ; : sys-warning-off ( -- ) \ disable warning for use of system words in application *************** *** 2387,2394 **** --- 2387,2396 ---- : xt-rel, ( xt op -- ) code-c, xt-reladdr, ; \ generate opcode and rel adjusted xt + \ *enhance if in-application, needs to issue warning if a jump into system space : xt-jmp, ( xt -- ) $e9 xt-rel, ; \ generate jump to xt on the stack 0 | value tail-call \ see exit for use + \ *enhance if in-application, needs to issue warning if a call into system space : xt-call, ( xt -- ) \ core routine for generation a call sync-code \ ensure outstanding code generated *************** *** 3693,3696 **** --- 3695,3699 ---- if >r 3drop r> else + in-application rot align here >r *************** *** 3700,3703 **** --- 3703,3707 ---- c, ", 0 c, \ move in name null terminated r> dup 0winproc \ initialise + in-previous then dup winproc-last ! proc>ep \ return ep ptr *************** *** 3761,3764 **** --- 3765,3769 ---- 2drop \ drop unused else + in-application align here winlib-last ! \ point last at here *************** *** 3766,3769 **** --- 3771,3775 ---- 0 , \ the library handle ", 0 c, \ counted string + in-previous then ; *************** *** 5188,5191 **** --- 5194,5198 ---- get-section 2>r \ save dp and xdp in-system fload \ move to in-system + in-application \ and back 2r> set-section ; \ and restore dp and xdp |
|
From: Alex M. <ale...@us...> - 2007-03-15 17:55:28
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25895/src Modified Files: POINTER.F dis486.f imageman.f optliterals.f primutil.f Log Message: arm: correct problems with turnkey; not yet fixed entirely (see optliterals) Index: POINTER.F =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/POINTER.F,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** POINTER.F 30 Oct 2006 09:15:13 -0000 1.4 --- POINTER.F 15 Mar 2007 17:55:15 -0000 1.5 *************** *** 24,33 **** : Pointer ( bytes -<name>- ) \ make a pointer "name" ! in-previous in-application \ always in app space 128 max \ at least 160 bytes create 0 , \ initialize to unallocated PHEAD link, \ link into chain , \ lay in size in bytes ! in-previous does> \ back to where we came from dup @ if @ exit then \ ok, straight fetch dup (pointerlock) --- 24,33 ---- : Pointer ( bytes -<name>- ) \ make a pointer "name" ! in-application in-application \ always in app space 128 max \ at least 160 bytes create 0 , \ initialize to unallocated PHEAD link, \ link into chain , \ lay in size in bytes ! in-application does> \ back to where we came from dup @ if @ exit then \ ok, straight fetch dup (pointerlock) *************** *** 92,96 **** external ! in-previous : %UnPointer ( cfa -- ) \ deallocate pointer given the cfa --- 92,96 ---- external ! in-application : %UnPointer ( cfa -- ) \ deallocate pointer given the cfa *************** *** 161,165 **** MAXSTRING Pointer ; ! in-previous \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 161,165 ---- MAXSTRING Pointer ; ! in-application \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** primutil.f 12 Mar 2007 21:34:57 -0000 1.22 --- primutil.f 15 Mar 2007 17:55:15 -0000 1.23 *************** *** 98,102 **** \ ------------------------------------------------------------------------ ! in-previous : 2constant ( n m "name" ) --- 98,102 ---- \ ------------------------------------------------------------------------ ! in-application : 2constant ( n m "name" ) *************** *** 136,140 **** : ctrl char 31 and compilation> execute postpone literal ; ! in-previous \ Moved to user area to make asciiz thread safe gah 28jun04 --- 136,140 ---- : ctrl char 31 and compilation> execute postpone literal ; ! in-application \ Moved to user area to make asciiz thread safe gah 28jun04 *************** *** 165,169 **** \ new-sys-chain post-forget-chain \ chain of types of things to forget ! in-previous :noname ( -- ) \ chain for cleanup --- 165,169 ---- \ new-sys-chain post-forget-chain \ chain of types of things to forget ! in-application :noname ( -- ) \ chain for cleanup Index: dis486.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/dis486.f,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** dis486.f 13 Mar 2007 23:49:34 -0000 1.14 --- dis486.f 15 Mar 2007 17:55:15 -0000 1.15 *************** *** 1084,1091 **** also forth definitions : describe ( xt -- ) dup>r >name cr ! \ do the header piece dup dup n>tfa c@ case --- 1084,1092 ---- also forth definitions + \ *bug needs to check for :noname type xts : describe ( xt -- ) dup>r >name cr ! \ do the header piece; dup dup n>tfa c@ case Index: optliterals.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optliterals.f,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** optliterals.f 2 Mar 2007 15:16:54 -0000 1.12 --- optliterals.f 15 Mar 2007 17:55:15 -0000 1.13 *************** *** 68,71 **** --- 68,72 ---- 100 stack lits + \ *bug this is in-system, but the chain is in-application; turnkeys fail to run : reset-lits ( -- ) \ clear the stack lits -stack ; Index: imageman.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/imageman.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** imageman.f 6 Oct 2006 12:17:17 -0000 1.5 --- imageman.f 15 Mar 2007 17:55:15 -0000 1.6 *************** *** 963,970 **** true to ignore-missing-procs? \ WHEN TURNKEYING, IGNORE MISSING PROCEDURE WARNINGS ! action-of INIT-CONSOLE ['] x_INIT-CONSOLE is INIT-CONSOLE \ no statusbar for the console \ FALSE to with-source? \ no source level debugging 0 0 r> application \ calls default application after init ! ['] SYS-SIZE >BODY ! is INIT-CONSOLE to ignore-missing-procs? --- 963,971 ---- true to ignore-missing-procs? \ WHEN TURNKEYING, IGNORE MISSING PROCEDURE WARNINGS ! action-of INIT-CONSOLE + sys-size 0 to sys-size ['] x_INIT-CONSOLE is INIT-CONSOLE \ no statusbar for the console \ FALSE to with-source? \ no source level debugging 0 0 r> application \ calls default application after init ! to sys-size is INIT-CONSOLE to ignore-missing-procs? |
|
From: Alex M. <ale...@us...> - 2007-03-15 17:55:19
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25895 Modified Files: gkernel.exe Log Message: arm: correct problems with turnkey; not yet fixed entirely (see optliterals) Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.36 retrieving revision 1.37 diff -C2 -d -r1.36 -r1.37 Binary files /tmp/cvsXf8atU and /tmp/cvsN7coe1 differ |
|
From: Alex M. <ale...@us...> - 2007-03-13 23:49:39
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6466/src Modified Files: dis486.f extend.f Log Message: arm: minor mods to disassembler; show offsets as signed hex Index: dis486.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/dis486.f,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** dis486.f 2 Mar 2007 15:16:54 -0000 1.13 --- dis486.f 13 Mar 2007 23:49:34 -0000 1.14 *************** *** 74,84 **** \ pseudo Object DIS for all the vars used by the disassembler ! 0 value dis.default-16bit? ! 0 value dis.base-addr ! 0 value dis.size ! 0 value dis.16-bit-data ! 0 value dis.16-bit-addr ! 0 value dis.prefix-op ! 0 value dis.mmx-reg? \ ----------------------------------------------------------------------- --- 74,84 ---- \ pseudo Object DIS for all the vars used by the disassembler ! 0 value dis.16bit \ start in 32 bit mode ! 0 value dis.base-addr \ no offset by default ! 0 value dis.size \ size of immediate ! 0 value dis.data16 \ 16 bit data ! 0 value dis.addr16 \ 16 bit address ! 0 value dis.prefix-op \ prefix operator (like cs: rep etc) ! 0 value dis.mmx-reg? \ display as mmx reg \ ----------------------------------------------------------------------- *************** *** 86,91 **** \ ----------------------------------------------------------------------- ! : default-16bit ( -- ) true to dis.default-16bit? ; ! : default-32bit ( -- ) false to dis.default-16bit? ; --- 86,91 ---- \ ----------------------------------------------------------------------- ! \ : default-16bit ( -- ) true to 16bit ; ! \ : default-32bit ( -- ) false to 16bit ; *************** *** 117,121 **** : cmnt-col 60 col ; \ set to comment field ! : .ss ( n adr w ) oper-col >r swap r@ * + r> type opnd-col ; : .# ( -- ) ." # " ; : ., ( -- ) ." , " ; --- 117,121 ---- : cmnt-col 60 col ; \ set to comment field ! : .ss ( n adr w ) oper-col dup>r rot * + r> type opnd-col ; : .# ( -- ) ." # " ; : ., ( -- ) ." , " ; *************** *** 155,186 **** : bits0-2 ( n -- n' ) %0111 and ; \ isolate bits 0 thru 2 : bits0-3 ( n -- n' ) %1111 and ; \ isolate bits 0 thru 3 ! : bits3-5 ( n -- n' ) 3 rshift bits0-2 ; \ isolate bits 3 thru 5 ! : bits3-4 ( n -- n' ) 3 rshift bits0-1 ; \ isolate bits 3 thru 4 ! : bit3 ( n -- f ) %1000 and ; ! : bit2 ( n -- f ) %0100 and ; ! : bit1 ( n -- f ) %0010 and ; ! : bit0 ( n -- f ) %0001 and ; ! : .cnd-code ( code -- ) bits0-3 z" o nob aee nebea s nsp npl geleg " 2 .ss ; \ was tttn ! : .sreg(XX-NNN-XXX) ( sreg -- ) bits3-5 z" escsssdsfsgs????" 2 .ss ; ! : .creg(XX-NNN-XXX) ( eee -- ) bits3-5 z" cr0???cr2cr3cr4?????????" 3 .ss ; ! : .dreg(XX-NNN-XXX) ( eee -- ) bits3-5 z" dr0dr1dr2dr3??????dr6dr7" 3 .ss ; ! : .treg(XX-NNN-XXX) ( eee -- ) bits3-5 z" ?????????tr3tr4tr5tr6tr7" 3 .ss ; \ obsolete ! : .regm(XX-XXX-NNN) ( n -- ) bits0-2 z" mm0mm1mm2mm3mm4mm5mm6mm7" 3 .ss ; ! : .reg8(XX-XXX-NNN) ( n -- ) bits0-2 z" alcldlblahchdhbh" 2 .ss ; ! : .reg16(XX-XXX-NNN) ( n -- ) bits0-2 z" axcxdxbxspbpsidi" 2 .ss ; ! : .reg32(XX-XXX-NNN) ( n -- ) bits0-2 z" eaxecxedxebxespebpesiedi" 3 .ss ; ! : .reg16/32(XX-XXX-NNN) ( n -- ) dis.16-bit-data if .reg16(XX-XXX-NNN) else .reg32(XX-XXX-NNN) then ; ! : .[ind16](XX-XXX-0NN) ( r/m -- ) bits0-1 z" [bx+si][bx+di][bp+si][bp+di]" 7 .ss ; \ r/m = 0, 1, 2, 3 ! : .[base16](XX-XXX-1NN) ( r/m -- ) bits0-1 z" [si][di][bp][bx]" 4 .ss ; \ r/m = 4, 5, 6, 7 ! : .[reg16](XX-XXX-NNN) ( r/m -- ) bit2 if .[ind16](XX-XXX-0NN) else .[base16](XX-XXX-1NN) then ; ! : .reg(XX-XXX-NNN) ( n -- ) ! dis.mmx-reg? if .regm(XX-XXX-NNN) ! else dis.size if .reg16/32(XX-XXX-NNN) ! else .reg8(XX-XXX-NNN) then then ; --- 155,186 ---- : bits0-2 ( n -- n' ) %0111 and ; \ isolate bits 0 thru 2 : bits0-3 ( n -- n' ) %1111 and ; \ isolate bits 0 thru 3 ! : bits3-5 ( n -- n' ) 3 rshift bits0-2 ; \ isolate bits 3 thru 5 ! : bits3-4 ( n -- n' ) 3 rshift bits0-1 ; \ isolate bits 3 thru 4 ! : bit3 ( n -- f ) %1000 and %1000 = ; ! : bit2 ( n -- f ) %0100 and %0100 = ; ! : bit1 ( n -- f ) %0010 and %0010 = ; ! : bit0 ( n -- f ) %0001 and %0001 = ; ! : .cnd-code ( code -- ) bits0-3 z" o nob aee nebea s nsp npl geleg " 2 .ss ; \ was tttn ! : .sreg ( sreg -- ) bits3-5 z" escsssdsfsgs????" 2 .ss ; ! : .creg ( eee -- ) bits3-5 z" cr0???cr2cr3cr4?????????" 3 .ss ; ! : .dreg ( eee -- ) bits3-5 z" dr0dr1dr2dr3??????dr6dr7" 3 .ss ; ! : .treg ( eee -- ) bits3-5 z" ?????????tr3tr4tr5tr6tr7" 3 .ss ; \ obsolete ! : .regm ( n -- ) bits0-2 z" mm0mm1mm2mm3mm4mm5mm6mm7" 3 .ss ; ! : .reg8 ( n -- ) bits0-2 z" alcldlblahchdhbh" 2 .ss ; ! : .reg16 ( n -- ) bits0-2 z" axcxdxbxspbpsidi" 2 .ss ; ! : .reg32 ( n -- ) bits0-2 z" eaxecxedxebxespebpesiedi" 3 .ss ; ! : .reg16/32 ( n -- ) dis.data16 if .reg16 else .reg32 then ; ! : .[ind16] ( r/m -- ) bits0-1 z" [bx+si][bx+di][bp+si][bp+di]" 7 .ss ; \ r/m = 0, 1, 2, 3 ! : .[base16] ( r/m -- ) bits0-1 z" [si][di][bp][bx]" 4 .ss ; \ r/m = 4, 5, 6, 7 ! : .[reg16] ( r/m -- ) bit2 if .[ind16] else .[base16] then ; ! : .reg ( n -- ) ! dis.mmx-reg? if .regm ! else dis.size if .reg16/32 ! else .reg8 then then ; *************** *** 190,204 **** : .rel16/32 ( addr -- addr' ) ! dis.16-bit-addr IF wCount ELSE LCount THEN over + dis.base-addr - show-name ; ! : .disp8[pc++] ( adr -- adr' ) count show-name ; : .disp16[pc++] ( adr -- adr' ) wCount show-name ; : .disp32[pc++] ( adr -- adr' ) LCount show-name ; : .disp16/32[pc++] ( adr -- adr' ) ! dis.16-bit-addr if .disp16[pc++] else .disp32[pc++] --- 190,204 ---- : .rel16/32 ( addr -- addr' ) ! dis.addr16 IF wCount ELSE LCount THEN over + dis.base-addr - show-name ; ! : .disp8[pc++] ( adr -- adr' ) count sext $s. ; : .disp16[pc++] ( adr -- adr' ) wCount show-name ; : .disp32[pc++] ( adr -- adr' ) LCount show-name ; : .disp16/32[pc++] ( adr -- adr' ) ! dis.addr16 if .disp16[pc++] else .disp32[pc++] *************** *** 208,230 **** : .imm16/32[pc++] ( adr -- adr' ) ! .# dis.16-bit-data IF wCount ELSE LCount THEN show-name ; ! : .[reg32 ( n -- ) ." [" bits0-2 .reg32(XX-XXX-NNN) ; \ prints [reg ! : .[reg32](XX-XXX-NNN) ( n -- ) .[reg32 ." ]" ; ! : .[reg*2](XX-XXX-NNN) ( n -- ) .[reg32 ." *2]" ; ! : .[reg*4](XX-XXX-NNN) ( n -- ) .[reg32 ." *4]" ; ! : .[reg*8](XX-XXX-NNN) ( n -- ) .[reg32 ." *8]" ; ! : .[index]=SS-III-BBB ( sib -- ) parse/sib over 4 = \ ( b i s ) i=4? if 2drop \ no esp scaled index else case ( s ) ! 0 of .[reg32](XX-XXX-NNN) endof ! 1 of .[reg*2](XX-XXX-NNN) endof ! 2 of .[reg*4](XX-XXX-NNN) endof ! 3 of .[reg*8](XX-XXX-NNN) endof endcase then ( b ) drop ; --- 208,230 ---- : .imm16/32[pc++] ( adr -- adr' ) ! .# dis.data16 IF wCount ELSE LCount THEN show-name ; ! : .[reg32 ( n -- ) ." [" bits0-2 .reg32 ; \ prints [reg ! : .[reg32] ( n -- ) .[reg32 ." ]" ; ! : .[reg*2] ( n -- ) .[reg32 ." *2]" ; ! : .[reg*4] ( n -- ) .[reg32 ." *4]" ; ! : .[reg*8] ( n -- ) .[reg32 ." *8]" ; ! : .[sib] ( sib -- ) parse/sib over 4 = \ ( b i s ) i=4? if 2drop \ no esp scaled index else case ( s ) ! 0 of .[reg32] endof ! 1 of .[reg*2] endof ! 2 of .[reg*4] endof ! 3 of .[reg*8] endof endcase then ( b ) drop ; *************** *** 236,250 **** : .sib=NN ( adr mod -- adr ) >r count tuck bits0-2 5 = r@ 0= and ! if .disp32[pc++] swap .[index]=SS-III-BBB r> drop \ ebp base and mod = 00 else r> case ( mod ) 1 of .disp8[pc++] endof 2 of .disp32[pc++] endof endcase ! swap dup .[reg32](XX-XXX-NNN) .[index]=SS-III-BBB then ; : mod-r/m32(r/m,mod) ( adr r/m mod -- adr' ) dup 3 = ! if drop .reg(XX-XXX-NNN) \ mod = 3, register case else over 4 = if nip .sib=NN \ r/m = 4, sib case --- 236,250 ---- : .sib=NN ( adr mod -- adr ) >r count tuck bits0-2 5 = r@ 0= and ! if .disp32[pc++] swap .[sib] r> drop \ ebp base and mod = 00 else r> case ( mod ) 1 of .disp8[pc++] endof 2 of .disp32[pc++] endof endcase ! swap dup .[reg32] .[sib] then ; : mod-r/m32(r/m,mod) ( adr r/m mod -- adr' ) dup 3 = ! if drop .reg \ mod = 3, register case else over 4 = if nip .sib=NN \ r/m = 4, sib case *************** *** 256,260 **** 2 of .disp32[pc++] endof endcase ! swap .[reg32](XX-XXX-NNN) then then --- 256,260 ---- 2 of .disp32[pc++] endof endcase ! swap .[reg32] then then *************** *** 265,277 **** if 2drop .disp16[pc++] \ disp16 case else case ( mod ) ! 0 of .[reg16](XX-XXX-NNN) endof ! 1 of swap .disp8[pc++] swap .[reg16](XX-XXX-NNN) endof ! 2 of swap .disp16[pc++] swap .[reg16](XX-XXX-NNN) endof ! 3 of .reg(XX-XXX-NNN) endof endcase then ; : mod-r/m(ModR/M) ( adr modr/m -- adr' ) ! parse/ModR/M nip dis.16-bit-addr if mod-r/m16(r/m,mod) else mod-r/m32(r/m,mod) --- 265,277 ---- if 2drop .disp16[pc++] \ disp16 case else case ( mod ) ! 0 of .[reg16] endof ! 1 of swap .disp8[pc++] swap .[reg16] endof ! 2 of swap .disp16[pc++] swap .[reg16] endof ! 3 of .reg endof endcase then ; : mod-r/m(ModR/M) ( adr modr/m -- adr' ) ! parse/ModR/M nip dis.addr16 if mod-r/m16(r/m,mod) else mod-r/m32(r/m,mod) *************** *** 280,291 **** : r/m8(ModR/M) 0 to dis.size mod-r/m(ModR/M) ; : r/m16/32(ModR/M) 1 to dis.size mod-r/m(ModR/M) ; ! : r/m16(ModR/M) true to dis.16-bit-data r/m16/32(ModR/M) ; : r,r/m() ( adr -- adr' ) count dup bits3-5 ( op/reg->reg/m ) ! .reg(XX-XXX-NNN) ., mod-r/m(ModR/M) ; : r/m,r() ( adr -- adr' ) ! count dup >r mod-r/m(ModR/M) ., r> bits3-5 .reg(XX-XXX-NNN) ; : r/m() ( adr op -- adr' ) --- 280,291 ---- : r/m8(ModR/M) 0 to dis.size mod-r/m(ModR/M) ; : r/m16/32(ModR/M) 1 to dis.size mod-r/m(ModR/M) ; ! : r/m16(ModR/M) true to dis.data16 r/m16/32(ModR/M) ; : r,r/m() ( adr -- adr' ) count dup bits3-5 ( op/reg->reg/m ) ! .reg ., mod-r/m(ModR/M) ; : r/m,r() ( adr -- adr' ) ! count dup >r mod-r/m(ModR/M) ., r> bits3-5 .reg ; : r/m() ( adr op -- adr' ) *************** *** 364,382 **** pre a16a "a16:" ! : d16 ( adr code -- adr' ) d16a true to dis.16-bit-data ; ! : a16 ( adr code -- adr' ) a16a true to dis.16-bit-addr ; : aam ( adr code -- adr' ) .sop" aam" drop count drop ; : aad ( adr code -- adr' ) .sop" aad" drop count drop ; ! : isd ( adr code -- adr' ) drop dis.16-bit-data if .sop" insw" else .sop" insd" then ; ! : osd ( adr code -- adr' ) drop dis.16-bit-data if .sop" outsw" else .sop" outsd" then ; ! : inp/ind ( adr code -- adr' ) .sop" in" opnd-col bit0 if dis.16-bit-data if .ax, else .eax, then else .al, then ; : inp ( adr code -- adr' ) inp/ind count $. ; : ind ( adr code -- adr' ) inp/ind .dx ; : .out ( adr code -- adr' ) .sop" out" opnd-col ; ! : otp/otd ( adr code -- adr' ) bit0 if dis.16-bit-data if ." , ax" else ." , eax" then else ." , al" then ; : otp ( adr code -- adr' ) .out swap count $. swap otp/otd ; : otd ( adr code -- adr' ) .out .dx otp/otd ; --- 364,382 ---- pre a16a "a16:" ! : d16 ( adr code -- adr' ) d16a true to dis.data16 ; ! : a16 ( adr code -- adr' ) a16a true to dis.addr16 ; : aam ( adr code -- adr' ) .sop" aam" drop count drop ; : aad ( adr code -- adr' ) .sop" aad" drop count drop ; ! : isd ( adr code -- adr' ) drop dis.data16 if .sop" insw" else .sop" insd" then ; ! : osd ( adr code -- adr' ) drop dis.data16 if .sop" outsw" else .sop" outsd" then ; ! : inp/ind ( adr code -- adr' ) .sop" in" opnd-col bit0 if dis.data16 if .ax, else .eax, then else .al, then ; : inp ( adr code -- adr' ) inp/ind count $. ; : ind ( adr code -- adr' ) inp/ind .dx ; : .out ( adr code -- adr' ) .sop" out" opnd-col ; ! : otp/otd ( adr code -- adr' ) bit0 if dis.data16 if ." , ax" else ." , eax" then else ." , al" then ; : otp ( adr code -- adr' ) .out swap count $. swap otp/otd ; : otd ( adr code -- adr' ) .out .dx otp/otd ; *************** *** 400,409 **** : ala ( adr op -- adr' ) ! dup .alu bit0 if 0 .reg(XX-XXX-NNN) .imm16/32[pc++] else 0 .reg8(XX-XXX-NNN) .imm8[pc++] then ; \ -------------------- Test/Xchg -------------------- : txb ( addr op -- addr' ) ! dup bit1 z" testxchg" 4 .ss bit0 to dis.size r,r/m() ; --- 400,409 ---- : ala ( adr op -- adr' ) ! dup .alu bit0 if 0 .reg .imm16/32[pc++] else 0 .reg8 .imm8[pc++] then ; \ -------------------- Test/Xchg -------------------- : txb ( addr op -- addr' ) ! dup bit1 negate z" testxchg" 4 .ss bit0 to dis.size r,r/m() ; *************** *** 411,415 **** : tst ( addr op -- addr' ) .sop" test" bit0 ! IF dis.16-bit-data IF .ax, ELSE .eax, --- 411,415 ---- : tst ( addr op -- addr' ) .sop" test" bit0 ! IF dis.data16 IF .ax, ELSE .eax, *************** *** 424,428 **** : ppp ( addr op -- addr' ) opstr does> count oper-col type drop ! dis.16-bit-data 0= IF ." d" THEN opnd-col ; ppp psa "pusha" --- 424,428 ---- : ppp ( addr op -- addr' ) opstr does> count oper-col type drop ! dis.data16 0= IF ." d" THEN opnd-col ; ppp psa "pusha" *************** *** 432,436 **** : idp ( addr op -- addr' ) ! opstr does> count (.sop") .reg16/32(XX-XXX-NNN) ; idp inc "inc" --- 432,436 ---- : idp ( addr op -- addr' ) ! opstr does> count (.sop") .reg16/32 ; idp inc "inc" *************** *** 439,444 **** idp pop "pop" ! : pss ( addr op -- addr' ) .sop" push" .sreg(XX-NNN-XXX) ; ! : pps ( addr op -- addr' ) .sop" pop" .sreg(XX-NNN-XXX) ; : 8F. ( addr op -- addr' ) drop count .sop" pop" r/m16/32(ModR/M) ; : psi ( addr op -- addr' ) .sop" push" bit1 IF .imm8[pc++] ELSE .imm16/32[pc++] THEN ; --- 439,444 ---- idp pop "pop" ! : pss ( addr op -- addr' ) .sop" push" .sreg ; ! : pps ( addr op -- addr' ) .sop" pop" .sreg ; : 8F. ( addr op -- addr' ) drop count .sop" pop" r/m16/32(ModR/M) ; : psi ( addr op -- addr' ) .sop" push" bit1 IF .imm8[pc++] ELSE .imm16/32[pc++] THEN ; *************** *** 449,454 **** : mri ( addr op -- addr' ) .sop-mov dup bit3 ! IF .reg16/32(XX-XXX-NNN) .imm16/32[pc++] ! ELSE .reg8(XX-XXX-NNN) .imm8[pc++] THEN ; --- 449,454 ---- : mri ( addr op -- addr' ) .sop-mov dup bit3 ! IF .reg16/32 .imm16/32[pc++] ! ELSE .reg8 .imm8[pc++] THEN ; *************** *** 462,492 **** : mrs ( addr op -- addr' ) ! dis.16-bit-data IF .sop-mov drop 1 to dis.size count dup mod-r/m(ModR/M) ., ! .sreg(XX-NNN-XXX) ELSE ??? THEN ; : msr ( addr op -- addr' ) ! dis.16-bit-data IF .sop-mov drop 1 to dis.size ! count dup .sreg(XX-NNN-XXX) ., mod-r/m(ModR/M) ELSE ??? THEN ; ! : mrc ( addr op -- addr' ) .sop-mov drop count dup .reg32(XX-XXX-NNN) ., .creg(XX-NNN-XXX) ; ! : mcr ( addr op -- addr' ) .sop-mov drop count dup .creg(XX-NNN-XXX) ., .reg32(XX-XXX-NNN) ; ! : mrd ( addr op -- addr' ) .sop-mov drop count dup .reg32(XX-XXX-NNN) ., .dreg(XX-NNN-XXX) ; ! : mdr ( addr op -- addr' ) .sop-mov drop count dup .dreg(XX-NNN-XXX) ., .reg32(XX-XXX-NNN) ; ! : mrt ( addr op -- addr' ) .sop-mov drop count dup .reg32(XX-XXX-NNN) ., .treg(XX-NNN-XXX) ; \ obsolete ! : mtr ( addr op -- addr' ) .sop-mov drop count dup .treg(XX-NNN-XXX) ., .reg32(XX-XXX-NNN) ; \ obsolete : mv1 ( addr op -- addr' ) .sop-mov bit0 ! IF dis.16-bit-data IF .ax, ELSE .eax, --- 462,492 ---- : mrs ( addr op -- addr' ) ! dis.data16 IF .sop-mov drop 1 to dis.size count dup mod-r/m(ModR/M) ., ! .sreg ELSE ??? THEN ; : msr ( addr op -- addr' ) ! dis.data16 IF .sop-mov drop 1 to dis.size ! count dup .sreg ., mod-r/m(ModR/M) ELSE ??? THEN ; ! : mrc ( addr op -- addr' ) .sop-mov drop count dup .reg32 ., .creg ; ! : mcr ( addr op -- addr' ) .sop-mov drop count dup .creg ., .reg32 ; ! : mrd ( addr op -- addr' ) .sop-mov drop count dup .reg32 ., .dreg ; ! : mdr ( addr op -- addr' ) .sop-mov drop count dup .dreg ., .reg32 ; ! : mrt ( addr op -- addr' ) .sop-mov drop count dup .reg32 ., .treg ; \ obsolete ! : mtr ( addr op -- addr' ) .sop-mov drop count dup .treg ., .reg32 ; \ obsolete : mv1 ( addr op -- addr' ) .sop-mov bit0 ! IF dis.data16 IF .ax, ELSE .eax, *************** *** 498,502 **** : mv2 ( addr op -- addr' ) .sop-mov .disp16/32[pc++] ., bit0 ! IF dis.16-bit-data IF ." ax" ELSE ." eax" --- 498,502 ---- : mv2 ( addr op -- addr' ) .sop-mov .disp16/32[pc++] ., bit0 ! IF dis.data16 IF ." ax" ELSE ." eax" *************** *** 508,512 **** : lxs ( addr op -- addr' ) bit0 IF .sop" lds" ELSE .sop" les" THEN r,r/m() ; : bnd ( addr op -- addr' ) .sop" bound" drop 1 to dis.size r,r/m() ; ! : arp ( addr op -- addr' ) .sop" arpl" drop 1 to dis.size true to dis.16-bit-data r,r/m() ; : mli ( addr op -- addr' ) 1 to dis.size --- 508,512 ---- : lxs ( addr op -- addr' ) bit0 IF .sop" lds" ELSE .sop" les" THEN r,r/m() ; : bnd ( addr op -- addr' ) .sop" bound" drop 1 to dis.size r,r/m() ; ! : arp ( addr op -- addr' ) .sop" arpl" drop 1 to dis.size true to dis.data16 r,r/m() ; : mli ( addr op -- addr' ) 1 to dis.size *************** *** 534,538 **** ELSE .sop" jmp" THEN ! dis.16-bit-data IF ." ptr16:16 " ELSE ." ptr16:32 " --- 534,538 ---- ELSE .sop" jmp" THEN ! dis.data16 IF ." ptr16:16 " ELSE ." ptr16:32 " *************** *** 552,556 **** drop .sop" nop" else ! .sop" xchg" .eax, .reg16/32(XX-XXX-NNN) then ; --- 552,556 ---- drop .sop" nop" else ! .sop" xchg" .eax, .reg16/32 then ; *************** *** 567,571 **** 0xC0 of count $. endof 0xD0 of 1 $. endof ! 0xD2 of 1 .reg8(XX-XXX-NNN) endof endcase ; --- 567,571 ---- 0xC0 of count $. endof 0xD0 of 1 $. endof ! 0xD2 of 1 .reg8 endof endcase ; *************** *** 827,831 **** : xad ( addr op -- addr' ) .sop" xadd" bit0 to dis.size r/m,r() ; : cx8 ( addr op -- addr' ) .sop" cmpxchg8b" drop count r/m16/32(ModR/M) ; ! : bsp ( addr op -- addr' ) .sop" bswap" .reg32(XX-XXX-NNN) ; --- 827,831 ---- : xad ( addr op -- addr' ) .sop" xadd" bit0 to dis.size r/m,r() ; : cx8 ( addr op -- addr' ) .sop" cmpxchg8b" drop count r/m16/32(ModR/M) ; ! : bsp ( addr op -- addr' ) .sop" bswap" .reg32 ; *************** *** 838,850 **** bit0 >r count dup to op2 parse/sib r> \ size bit ! if swap .reg32(XX-XXX-NNN) ., \ word to dword case 3 = ! if .reg16(XX-XXX-NNN) else drop .word op2 mod-r/m(ModR/M) then ! else swap .reg16/32(XX-XXX-NNN) ., \ byte case 3 = ! if .reg8(XX-XXX-NNN) else drop ." byte " op2 mod-r/m(ModR/M) --- 838,850 ---- bit0 >r count dup to op2 parse/sib r> \ size bit ! if swap .reg32 ., \ word to dword case 3 = ! if .reg16 else drop .word op2 mod-r/m(ModR/M) then ! else swap .reg16/32 ., \ byte case 3 = ! if .reg8 else drop ." byte " op2 mod-r/m(ModR/M) *************** *** 920,929 **** : gpa ( adr op -- adr' ) \ xx00-xxxx -> ??? ! >r count dup .psx(XXNN-XXXX) r> mmx-size .regm(XX-XXX-NNN) ., .imm8[pc++] ; : mpd ( adr op -- adr' ) .sop" movd" drop count parse/ModR/M ! swap .regm(XX-XXX-NNN) ., 3 = ! if .reg32(XX-XXX-NNN) else mod-r/m(ModR/M) then ; --- 920,929 ---- : gpa ( adr op -- adr' ) \ xx00-xxxx -> ??? ! >r count dup .psx(XXNN-XXXX) r> mmx-size .regm ., .imm8[pc++] ; : mpd ( adr op -- adr' ) .sop" movd" drop count parse/ModR/M ! swap .regm ., 3 = ! if .reg32 else mod-r/m(ModR/M) then ; *************** *** 932,938 **** .sop" movd" drop count parse/ModR/M swap 3 = ! if .reg32(XX-XXX-NNN) else mod-r/m(ModR/M) ! then ., .regm(XX-XXX-NNN) ; : par ( adr op -- adr' ) --- 932,938 ---- .sop" movd" drop count parse/ModR/M swap 3 = ! if .reg32 else mod-r/m(ModR/M) ! then ., .regm ; : par ( adr op -- adr' ) *************** *** 1033,1043 **** count dup bit0 to dis.size ! dup cells op1-table + @ execute dis.prefix-op 0= ! if dis.default-16bit? 0= ! if false to dis.16-bit-data ! false to dis.16-bit-addr ! else true to dis.16-bit-data ! true to dis.16-bit-addr then then ; --- 1033,1043 ---- count dup bit0 to dis.size ! dup cells op1-table + @ execute dis.prefix-op 0= ! if dis.16bit 0= ! if false to dis.data16 ! false to dis.addr16 ! else true to dis.data16 ! true to dis.addr16 then then ; Index: extend.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/extend.f,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** extend.f 24 Jan 2007 23:48:17 -0000 1.16 --- extend.f 13 Mar 2007 23:49:34 -0000 1.17 *************** *** 4,24 **** cr .( -- META EXTEND.F ) cr - sys-fload src\primutil.f - sys-fload src\optinline \ inline optimiser ! sys-fload src\module.f \ scoping support for modules sys-fload src\interpif.f \ interpretive conditionals fload src\numconv.f \ general number conversions - sys-fload src\486asm.f \ jim's 486 assembler sys-fload src\asmmac.f \ jim's 486 macros sys-fload src\asmwin32.f \ next for win32forth - sys-fload src\optliterals \ literals optimiser - - fload src\console\console.f \ console i/o extracted from primutil.f fload src\console\console2.f \ console i/o extracted from primutil.f sys-fload src\dotwords.f \ dot support words sys-FLOAD src\forget.f \ forget words --- 4,19 ---- cr .( -- META EXTEND.F ) cr sys-fload src\optinline \ inline optimiser ! fload src\primutil.f sys-fload src\module.f \ scoping support for modules sys-fload src\interpif.f \ interpretive conditionals fload src\numconv.f \ general number conversions sys-fload src\486asm.f \ jim's 486 assembler sys-fload src\asmmac.f \ jim's 486 macros sys-fload src\asmwin32.f \ next for win32forth sys-fload src\optliterals \ literals optimiser fload src\console\console.f \ console i/o extracted from primutil.f fload src\console\console2.f \ console i/o extracted from primutil.f + sys-FLOAD src\dis486.f \ load the disassembler sys-fload src\dotwords.f \ dot support words sys-FLOAD src\forget.f \ forget words *************** *** 26,31 **** sys-fload src\imageman.f \ fsave, application & turnkey words sys-FLOAD src\environ.f \ environment? support - - sys-FLOAD src\dis486.f \ load the disassembler FLOAD src\pointer.f \ pointer support ( w/o forgetting and decompiling ) fload src\callback.f \ windows callback support --- 21,24 ---- *************** *** 39,42 **** --- 32,36 ---- FLOAD src\ansfile.f \ ansi file words FLOAD src\registry.f \ Win32 Registry support + FLOAD src\primhash.f \ primitive hash functions for OOP later *** to be done *** here fence ! mark empty \ Prevent forgetting anything before this *************** *** 52,61 **** .olly - \ sys-fload src\optliterals \ literals optimiser - - \s - \ FLOAD src\primhash.f \ primitive hash functions for OOP later *** to be done *** \ sys-FLOAD src\dbgsrc1.f \ source level debugging support part one *** to be done *** --- 46,51 ---- |
|
From: Alex M. <ale...@us...> - 2007-03-13 23:49:38
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6466/src/kernel Modified Files: gkernel.f Log Message: arm: minor mods to disassembler; show offsets as signed hex Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.31 retrieving revision 1.32 diff -C2 -d -r1.31 -r1.32 *** gkernel.f 1 Feb 2007 23:02:02 -0000 1.31 --- gkernel.f 13 Mar 2007 23:49:34 -0000 1.32 *************** *** 3354,3358 **** --- 3354,3362 ---- mov eax, esi next; + + : base@ ( n -- base n ) base @ ; + : base! ( base -- ) base ! ; + : (.$) ( -- ) [char] $ emit ; : "HOLD ( addr len -- ) dup negate hld +! hld @ swap move ; : #s ( d1 -- d2 ) begin # 2dup or 0= until ; *************** *** 3364,3372 **** : u. ( u -- ) 0 d. ; : u.r ( u w -- ) 0 swap d.r ; ! : h. ( u -- ) base @ swap hex u. base ! ; : ? ( addr -- ) @ . ; : .id ( nfa -- ) count type space ; ! : 10. ( u -- ) base @ swap decimal . base ! ; \ display number in decimal ! : $. ( u -- ) [char] $ emit h. ; \ display $hex \ -------------------- Header structure as of Aug 2005 ---------------------- --- 3368,3377 ---- : u. ( u -- ) 0 d. ; : u.r ( u w -- ) 0 swap d.r ; ! : h. ( u -- ) base@ swap hex u. base! ; : ? ( addr -- ) @ . ; : .id ( nfa -- ) count type space ; ! : 10. ( n -- ) base@ swap decimal . base! ; \ display number in decimal ! : $. ( u -- ) (.$) h. ; \ display $hex ! : $s. ( n -- ) (.$) base@ swap hex . base! ; \ display signed $hex \ -------------------- Header structure as of Aug 2005 ---------------------- |
|
From: Alex M. <ale...@us...> - 2007-03-13 23:49:38
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6466 Modified Files: gkernel.exe Log Message: arm: minor mods to disassembler; show offsets as signed hex Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.35 retrieving revision 1.36 diff -C2 -d -r1.35 -r1.36 Binary files /tmp/cvstpdm8o and /tmp/cvsBaJCbH differ |
|
From: Alex M. <ale...@us...> - 2007-03-13 23:48:21
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6049 Added Files: primhash.f Log Message: arm: start work on class support --- NEW FILE: primhash.f --- \ $Id: primhash.f,v 1.1 2007/03/13 23:48:16 alex_mcdonald Exp $ \ PRIMHASH.F primitive hash functions (( --------------------------- Change Block ------------------------------- arm 15/08/2005 22:56:45 First version 0.1 STC based kernel ------------------------- End Change Block ----------------------------- Experimental: a fully optimising, STC based, ANS Forth compliant kernel Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com) The original Win32Forth system was public domain; this kernel (and currently the kernel alone) is GPL. Although the basic structure of Win32Forth and many of its capabilities are employed in this code, most of the original Win32Forth kernel has been completely rewritten. The original code was originally developed by Tom Zimmer, Andrew McKewan with minor contributions by others and placed in the public domain. I acknowledge their copyrighted contributions and the structure and some of the methods and concepts employed in this further development. The assembler is Copyright [c] 1994, 1995, by Jim Schneider and is issued under the LGPL. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or <at your option> any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ------------------------------------------------------------------------ )) cr .( Loading Primitive Hash...) \ ---------------- 32-bit Hash Function for Objects ---------------- code method-hash ( addr len -- hash-val ) 2 1 in/out mov edx, 0 [ebp] \ edx = address test eax, eax \ eax=0? jz short @@4 \ yes, bail out mov ecx, eax \ ecx = count, eax=result(includes count) @@1: rol eax, # 7 xor al, 0 [edx] \ add in next byte add edx, # 1 sub ecx, # 1 jnz short @@1 @@3: test eax, eax \ make sure it's negative js short @@2 @@4: not eax @@2: lea ebp, 4 [ebp] next c; \s \ -------------------- Method/Ivar Search -------------------- CODE ((FINDM)) ( SelID addr -- 0cfa t | f ) pop eax \ selector id @@1: mov ebx, 0 [ebx] \ follow link test ebx, ebx \ end of list? je short @@2 cmp eax, 4 [ebx] \ selectors match? jne short @@1 add ebx, # 8 \ method cfa push ebx mov ebx, # -1 \ and true flag @@2: next c; \ -------------------- Runtime for Methods -------------------- \ m0cfa is executed when the object address is on the stack \ m1cfa is executed when the ivar offset is compile in-line CFA-CODE M0CFA mov -4 [ebp], esi mov ecx, OP [UP] mov -8 [ebp], ecx mov ecx, LP [UP] mov -12 [ebp], ecx sub ebp, # 12 mov OP [UP], ebx \ get object address mov LP [UP], ebp \ LP = ebp pop ebx lea esi, 8 [eax] \ get new ip (skip m1cfa) mov ecx, 8 [eax] \ get locals count test ecx, ecx jnz MOVE-LOCALS \ we need to set up locals mov eax, 4 [esi] \ optimised next add esi, # 8 exec c; CFA-CODE M1CFA mov ecx, 0 [esi] \ get inline offset add esi, # 4 \ esi past offset mov -4 [ebp], esi mov esi, OP [UP] mov -8 [ebp], esi mov esi, LP [UP] mov -12 [ebp], esi sub ebp, # 12 add OP [UP], ecx \ add offset to object address mov LP [UP], ebp \ LP = ebp lea esi, 4 [eax] \ get new ip (skip m1cfa) mov ecx, 4 [eax] \ get locals count test ecx, ecx jnz MOVE-LOCALS \ we need to set up locals mov eax, 4 [esi] \ optimised next add esi, # 8 exec c; \ end of method definition \ EXITM was lost in Version 6.07.00 \ readded here for compatiblity September 8th, 2003 - 12:53 dbu NCODE UNNESTM ( -- ) mov ebp, LP [UP] xchg esp, ebp pop LP [UP] \ restore local pointer pop OP [UP] \ restore object pointer pop esi \ restore ip xchg esp, ebp next c; ' UNNESTM ALIAS EXITM \ -------------------- Runtime for Objects -------------------- CFA-CODE DOOBJ push ebx lea ebx, 8 [eax] next c; \ return the base of the current object CODE ^BASE ( -- addr ) push ebx mov ebx, OP [UP] next c; \ -------------------- Runtime for Instance Variables -------------------- \ These are the "non-object" instance variables. They have the same \ names and syntax as the regular Forth versions. They are defined in \ the META vocabulary and will be found when inside a class definition. \ The Offset from OP stored at cfa+15 \ bytes runtime CFA-CODE (&IV) push ebx mov ebx, 4 [eax] \ get ivar offset add ebx, OP [UP] \ add to base of current object next c; \ single byte (8bit) instance variables CFA-CODE (IVC@) push ebx mov eax, 4 [eax] \ get ivar offset add eax, OP [UP] \ add to base of current object movzx ebx, byte ptr 0 [eax] \ fetch value next c; CFA-CODE (IVC!) mov eax, -4 [eax] \ get ivar offset add eax, OP [UP] \ add to base of current object mov 0 [eax], bl \ store value pop ebx next c; CFA-CODE (IVC+!) mov eax, -8 [eax] \ get ivar offset add eax, OP [UP] \ add to base of current object add 0 [eax], bl \ add value pop ebx next c; \ word number (16bit) instance variables CFA-CODE (IVW@) push ebx mov eax, 4 [eax] \ get ivar offset add eax, OP [UP] \ add to base of current object movzx ebx, word ptr 0 [eax] \ fetch WORD value next c; CFA-CODE (IVW!) mov eax, -4 [eax] \ get ivar offset add eax, OP [UP] \ add to base of current object mov 0 [eax], bx \ store WORD value pop ebx next c; CFA-CODE (IVW+!) mov eax, -8 [eax] \ get ivar offset add eax, OP [UP] \ add to base of current object add 0 [eax], bx \ add WORD value pop ebx next c; \ single number (32bit) instance variables CFA-CODE (IV@) push ebx mov eax, 4 [eax] \ get ivar offset add eax, OP [UP] \ add to base of current object mov ebx, 0 [eax] \ fetch value next c; CFA-CODE (IV!) mov eax, -4 [eax] \ get ivar offset add eax, OP [UP] \ add to base of current object mov 0 [eax], ebx \ store value pop ebx next c; CFA-CODE (IV+!) mov eax, -8 [eax] \ get ivar offset add eax, OP [UP] \ add to base of current object add 0 [eax], ebx \ add value pop ebx next c; \ double number (64bit) instance variable CFA-CODE (IVD@) push ebx mov eax, 4 [eax] \ get ivar offset add eax, OP [UP] \ add to base of current object mov ecx, 4 [eax] \ fetch value at cell + mov ebx, 0 [eax] \ fetch value push ecx next c; CFA-CODE (IVD!) mov eax, -4 [eax] \ get ivar offset add eax, OP [UP] \ add to base of current object mov 0 [eax], ebx \ store value pop ebx mov 4 [eax], ebx \ store value pop ebx next c; CFA-CODE (IVD+!) mov eax, -8 [eax] \ get ivar offset add eax, OP [UP] \ add to base of current object pop ecx add 4 [eax], ecx \ add low part first adc 0 [eax], ebx \ add high part with carry pop ebx next c; \ -------------------- Object pointer -------------------- : OP@ OP @ ; \ to allow UP to be kept in the EDX register : OP! OP ! ; \ -------------------- Find Name for Hashed Value -------------------- 79 #vocabulary hashed ' hashed vcfa>voc constant hash-wid 7 #vocabulary classes sys-here ' classes >body - \ voc-pfa-size 5 cells sys-reserve \ extra for a class constant voc-pfa-size : (unhash) ( hash-val -- addr len flag ) hash-wid dup voc#threads cells+ hash-wid ( hash-wid end to hash-wid ) do i begin @ ?dup while ( hash-val link-field ) 2dup link> >body @ = if nip ( discard hash value ) l>name dup LATEST-NFA ! \ save nfa for other use (Sonntag, März 13 2005 dbu) count ( addr len ) true unloop exit then repeat cell +loop drop S" Unknown" false ; : unhash ( hash-val -- addr len ) (unhash) drop ; : ?unhash ( hash-val -- f1 ) (unhash) nip nip ; IN-SYSTEM defer clash ( hash-val -- ) ' drop is clash : add-hash ( addr len hash-val -- ) >r 2dup hash-wid search-wordlist if r> 4drop ( already found ) else hash-wid swap-current >r "header docon , r> set-current r> dup , clash then ; 0 value obj-save : .M0NAME ( a1 -- ) [ 1 cells ] literal - @ unhash type space ; : .M1NAME ( a1 a2 -- a3 ) [ 2 cells ] literal - @ unhash type cell+ ( a1 becomes a3 ) \ skip next cell also dup @ ?dup if obj-save if obj-save cell - @ \ should use obj>CLASS, not yet there voc-pfa-size cell+ + \ should use IFA, not yet there begin @ 2dup 3 cells+ @ u< 0= start/stop until nip dup if cell+ @ unhash space type else drop ." ???" then space else ." NULL " then else ." self " then ; IN-APPLICATION |
|
From: Alex M. <ale...@us...> - 2007-03-12 21:35:09
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv15308 Modified Files: primutil.f Log Message: arm: corrected winver-init Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.21 retrieving revision 1.22 diff -C2 -d -r1.21 -r1.22 *** primutil.f 1 Feb 2007 23:01:39 -0000 1.21 --- primutil.f 12 Mar 2007 21:34:57 -0000 1.22 *************** *** 194,197 **** --- 194,198 ---- 7 constant winxp 8 constant win2003 + 9 constant winvista \ To check for a version, say Win2K or greater, try WINVER WIN2K >= *************** *** 199,203 **** 0 value winver ! : winver-init ( -- n ) \ get windows version 148 dup _localalloc dup>r ! \ set length of structure r@ call GetVersionEx \ call os for version --- 200,204 ---- 0 value winver ! : winver-init ( -- ) \ get windows version 148 dup _localalloc dup>r ! \ set length of structure r@ call GetVersionEx \ call os for version *************** *** 214,218 **** endof ! 2 of \ nt, 2k, xp r@ cell+ @ \ majorversion case --- 215,219 ---- endof ! 2 of \ nt, 2k, xp, vista r@ cell+ @ \ majorversion case *************** *** 227,230 **** --- 228,233 ---- endcase endof + 6 of winvista endof + drop -1 dup \ unknown windows version endcase endof |
|
From: Jos v.d.V. <jo...@us...> - 2007-03-10 15:06:25
|
Update of /cvsroot/win32forth/win32forth In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv20182 Modified Files: setup.exe Log Message: Jos: The updated setup. Index: setup.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/setup.exe,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 Binary files /tmp/cvspIHFJb and /tmp/cvso0h0ox differ |
1040 messages has been excluded from this view by a project administrator.
