Menu
▾
▴
win32forth-cvs
|
From: Dirk B. <db...@us...> - 2005-09-03 09:00:33
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18837/src/kernel Modified Files: fkernel.f Log Message: Fixed a bug in (RESTORE-INPUT) whitch I intruduced when I readded the SOURCE-POSITION value Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** fkernel.f 29 Aug 2005 15:56:28 -0000 1.22 --- fkernel.f 3 Sep 2005 09:00:25 -0000 1.23 *************** *** 337,341 **** pop ebx jo short @@1 ! br-next @@1: mov eax, 4 [esi] add esi, # 8 --- 337,341 ---- pop ebx jo short @@1 ! br-next @@1: mov eax, 4 [esi] add esi, # 8 *************** *** 449,453 **** mov 0 [esp], ecx next c; ! \ -------------------- Stack Operations ------------------------------------- --- 449,453 ---- mov 0 [esp], ecx next c; ! \ -------------------- Stack Operations ------------------------------------- *************** *** 1817,1822 **** shl ebx, 1 \ put sign bit into carry sbb ebx, ebx ! next c; ! : D>S ( d -- s ) \ convert double to single drop ; --- 1817,1822 ---- shl ebx, 1 \ put sign bit into carry sbb ebx, ebx ! next c; ! : D>S ( d -- s ) \ convert double to single drop ; *************** *** 1878,1884 **** 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 --- 1878,1884 ---- 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 *************** *** 1890,1896 **** 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 --- 1890,1896 ---- 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 *************** *** 2229,2233 **** - REPEAT DROP ; ! DEFER COL --- 2229,2233 ---- - REPEAT DROP ; ! DEFER COL *************** *** 3105,3114 **** DUP SYS-ADDR? \ address in system space IN-SYS? 0= AND \ not currently system pointer ! IF WARN_SYSWORD WARNMSG THEN ; : COMPILE, ( xt -- ) \ compile (same as , but with warning) SYS-WARNING? if (syswarn) then \ warn if system word in app word , ; ! CODE COMPILE ( -- ) \ compile xt following push ebx --- 3105,3114 ---- DUP SYS-ADDR? \ address in system space IN-SYS? 0= AND \ not currently system pointer ! IF WARN_SYSWORD WARNMSG THEN ; : COMPILE, ( xt -- ) \ compile (same as , but with warning) SYS-WARNING? if (syswarn) then \ warn if system word in app word , ; ! CODE COMPILE ( -- ) \ compile xt following push ebx *************** *** 3360,3364 **** \ *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 --- 3360,3364 ---- \ *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 *************** *** 3754,3758 **** mHeapParm call HeapReAlloc dup 0= ; \ flags, heapaddress ! : mHeapSize ( rel-addr -- n ) \ size of rel-addr bytes mHeapParm --- 3754,3758 ---- mHeapParm call HeapReAlloc dup 0= ; \ flags, heapaddress ! : mHeapSize ( rel-addr -- n ) \ size of rel-addr bytes mHeapParm *************** *** 3979,3983 **** else call GetLastError NO_ERROR <> ! if 2drop 0 0 true then --- 3979,3983 ---- else call GetLastError NO_ERROR <> ! if 2drop 0 0 true then *************** *** 4233,4237 **** : ("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 --- 4233,4237 ---- : ("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 *************** *** 4335,4339 **** FALSE TO ?:M 0 TO PARMS ; ! |: :COLONDEF ( -- ) PARMS-INIT DOCOL COMPILE, !CSP ] ; --- 4335,4339 ---- FALSE TO ?:M 0 TO PARMS ; ! |: :COLONDEF ( -- ) PARMS-INIT DOCOL COMPILE, !CSP ] ; *************** *** 4438,4442 **** DOVALUE! COMPILE, DOVALUE+! COMPILE, ; ! |: ?TO_CHECK ( xt -- xt_body ) DUP @ >R --- 4438,4442 ---- DOVALUE! COMPILE, DOVALUE+! COMPILE, ; ! |: ?TO_CHECK ( xt -- xt_body ) DUP @ >R *************** *** 4545,4549 **** ( 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 --- 4545,4549 ---- ( 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 *************** *** 4748,4752 **** \ September 23rd, 2003 - dbu : LINKFILE ( a1 -- ) \ link name a1 as current file IF LOADING ONLY !! ! ?LOADING IF MAXCOUNTED _LOCALALLOC \ alloc local path buffer --- 4748,4752 ---- \ September 23rd, 2003 - dbu : LINKFILE ( a1 -- ) \ link name a1 as current file IF LOADING ONLY !! ! ?LOADING IF MAXCOUNTED _LOCALALLOC \ alloc local path buffer *************** *** 4785,4792 **** SOURCE-ID SOURCE ! 6 ; : RESTORE-INPUT ( ... 7 -- flag ) \ restore input ! DROP (SOURCE) 2! TO SOURCE-ID --- 4785,4792 ---- SOURCE-ID SOURCE ! 7 ; : RESTORE-INPUT ( ... 7 -- flag ) \ restore input ! 7 ?PAIRS (SOURCE) 2! TO SOURCE-ID *************** *** 4816,4820 **** | CODE (RESTORE-INPUT) ( R: ... 7 -- ... 7 ) \ save input to stack push ebx ! push 8 CELLS [ebp] push 6 CELLS [ebp] push 5 CELLS [ebp] --- 4816,4820 ---- | CODE (RESTORE-INPUT) ( R: ... 7 -- ... 7 ) \ save input to stack push ebx ! push 7 CELLS [ebp] push 6 CELLS [ebp] push 5 CELLS [ebp] *************** *** 4869,4873 **** : FLOAD ( -<filename>- ) \ load "filename" into application dictionary /PARSE-S$ $FLOAD ; ! ' INCLUDED ALIAS "FLOAD ' FLOAD ALIAS INCLUDE --- 4869,4873 ---- : FLOAD ( -<filename>- ) \ load "filename" into application dictionary /PARSE-S$ $FLOAD ; ! ' INCLUDED ALIAS "FLOAD ' FLOAD ALIAS INCLUDE *************** *** 5192,5196 **** : 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= --- 5192,5196 ---- : 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= *************** *** 5289,5296 **** S" Error" (TYPEMSG) \ mark the source line in error, error ?LOADING IF EDIT-ERROR THEN \ edit if loading ! else drop THEN ; ! DEFER MESSAGE ' _MESSAGE IS MESSAGE : QUERY-INTERPRET ( -- ) --- 5289,5296 ---- S" Error" (TYPEMSG) \ mark the source line in error, error ?LOADING IF EDIT-ERROR THEN \ edit if loading ! else drop THEN ; ! DEFER MESSAGE ' _MESSAGE IS MESSAGE : QUERY-INTERPRET ( -- ) |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X