From: George H. <geo...@us...> - 2006-02-09 11:09:32
|
Update of /cvsroot/win32forth/win32forth-610old/src/kernel In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17257/win32forth-610old/src/kernel Modified Files: fkernel.f version.f Log Message: gah: Corrected \\ to fix fload bug. Altered version to V6.10.04 (needs updating of download). Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-610old/src/kernel/fkernel.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** fkernel.f 20 Jun 2005 15:28:47 -0000 1.4 --- fkernel.f 9 Feb 2006 11:09:00 -0000 1.5 *************** *** 351,355 **** pop ebx jo short @@1 ! br-next @@1: mov eax, 4 [esi] add esi, # 8 --- 351,355 ---- pop ebx jo short @@1 ! br-next @@1: mov eax, 4 [esi] add esi, # 8 *************** *** 1870,1876 **** mov eax, # 1234 \ get constant (patched, see res-multi-libs) LABEL RES-MULTI-X \ cell beyond patch address ! xchg esp, ebp \ swap regs for call call callf \ resolve with forth call ! xchg esp, ebp \ swap regs for call mov eax, ebx \ get address pop ebx \ correct the stack --- 1870,1876 ---- mov eax, # 1234 \ get constant (patched, see res-multi-libs) LABEL RES-MULTI-X \ cell beyond patch address ! xchg esp, ebp \ swap regs for call call callf \ resolve with forth call ! xchg esp, ebp \ swap regs for call mov eax, ebx \ get address pop ebx \ correct the stack *************** *** 1882,1888 **** mov eax, # 1234 \ get constant (patched, see res-single-lib) LABEL RES-SINGLE-X \ cell beyond patch address ! xchg esp, ebp \ swap regs for call call callf \ resolve with forth call ! xchg esp, ebp \ swap regs for call mov eax, ebx \ get address pop ebx \ correct the stack --- 1882,1888 ---- mov eax, # 1234 \ get constant (patched, see res-single-lib) LABEL RES-SINGLE-X \ cell beyond patch address ! xchg esp, ebp \ swap regs for call call callf \ resolve with forth call ! xchg esp, ebp \ swap regs for call mov eax, ebx \ get address pop ebx \ correct the stack *************** *** 2214,2218 **** - REPEAT DROP ; ! DEFER COL --- 2214,2218 ---- - REPEAT DROP ; ! DEFER COL *************** *** 3334,3338 **** \ *G Compiletime: Parses the input stream until it finds the next " and \ ** compiles it into the current definition. ! \ ** Runtime: Prints the compiled text to the console window COMPILE (.") ," ; IMMEDIATE --- 3334,3338 ---- \ *G Compiletime: Parses the input stream until it finds the next " and \ ** compiles it into the current definition. ! \ ** Runtime: Prints the compiled text to the console window COMPILE (.") ," ; IMMEDIATE *************** *** 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 --- 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 *************** *** 4232,4236 **** : ("HEADER) ( a1 n1 -- ) CURRENT @ DUP SYS-ADDR? \ if the dictionary is in system space ! over class>sys or \ or is a class or object IF >SYSTEM ELSE >APPLICATION THEN \ then build the header in the same space 2000 ?MEMCHK \ check avail mem --- 4232,4236 ---- : ("HEADER) ( a1 n1 -- ) CURRENT @ DUP SYS-ADDR? \ if the dictionary is in system space ! over class>sys or \ or is a class or object IF >SYSTEM ELSE >APPLICATION THEN \ then build the header in the same space 2000 ?MEMCHK \ check avail mem *************** *** 4333,4337 **** FALSE TO ?:M 0 TO PARMS ; ! |: :COLONDEF ( -- ) PARMS-INIT DOCOL COMPILE, !CSP ] ; --- 4333,4337 ---- FALSE TO ?:M 0 TO PARMS ; ! |: :COLONDEF ( -- ) PARMS-INIT DOCOL COMPILE, !CSP ] ; *************** *** 4432,4436 **** DOVALUE! COMPILE, DOVALUE+! COMPILE, ; ! in-system --- 4432,4436 ---- DOVALUE! COMPILE, DOVALUE+! COMPILE, ; ! in-system *************** *** 4541,4545 **** ( n2 -- n3 ) \ runtime n3=n1+n2 header dooff compile, , ; ! : field+ ( n1 n2 <-name-> -- n3 ) \ compiling n3=n1+n2 stored offset=n1 ( addr1 -- addr2 ) \ runtime addr2=addr1+n1 --- 4541,4545 ---- ( n2 -- n3 ) \ runtime n3=n1+n2 header dooff compile, , ; ! : field+ ( n1 n2 <-name-> -- n3 ) \ compiling n3=n1+n2 stored offset=n1 ( addr1 -- addr2 ) \ runtime addr2=addr1+n1 *************** *** 4868,4872 **** : FLOAD ( -<filename>- ) \ load "filename" into application dictionary /PARSE-S$ $FLOAD ; ! ' INCLUDED ALIAS "FLOAD ' FLOAD ALIAS INCLUDE --- 4868,4872 ---- : FLOAD ( -<filename>- ) \ load "filename" into application dictionary /PARSE-S$ $FLOAD ; ! ' INCLUDED ALIAS "FLOAD ' FLOAD ALIAS INCLUDE *************** *** 4885,4889 **** : \ ( -- ) ! (SOURCE) >IN ! ; IMMEDIATE --- 4885,4889 ---- : \ ( -- ) ! (SOURCE) @ >IN ! ; IMMEDIATE *************** *** 5177,5181 **** : PARMFIND ( addr -- addr FALSE | cfa -1 | cfa 1 ) dup count find-buffer place \ copy for case-sensitive searches ! ?UPPERCASE \ uppercase PFIND ?DUP 0= IF (FIND) ?DUP 0= --- 5177,5181 ---- : PARMFIND ( addr -- addr FALSE | cfa -1 | cfa 1 ) dup count find-buffer place \ copy for case-sensitive searches ! ?UPPERCASE \ uppercase PFIND ?DUP 0= IF (FIND) ?DUP 0= *************** *** 5258,5262 **** R> BASE ! \ restore base ; ! : WARNMSG ( n -- ) \ prints Warning: S" Warning" (TYPEMSG) ; \ mark the source line in error, warning --- 5258,5262 ---- R> BASE ! \ restore base ; ! : WARNMSG ( n -- ) \ prints Warning: S" Warning" (TYPEMSG) ; \ mark the source line in error, warning *************** *** 5268,5272 **** THEN DROP ; ! DEFER MESSAGE ' _MESSAGE IS MESSAGE : QUERY-INTERPRET ( -- ) --- 5268,5272 ---- THEN DROP ; ! DEFER MESSAGE ' _MESSAGE IS MESSAGE : QUERY-INTERPRET ( -- ) *************** *** 5833,5837 **** in-application ! ' CONSTANT RESOLVES CONSTANT ' THROW RESOLVES THROW ' START/STOP RESOLVES START/STOP --- 5833,5837 ---- in-application ! ' CONSTANT RESOLVES CONSTANT ' THROW RESOLVES THROW ' START/STOP RESOLVES START/STOP *************** *** 5880,5882 **** \ Prad~ - |