version 1.58, 2006/12/30 20:06:26
|
version 1.70, 2010/05/01 20:36:59
|
Line 1
|
Line 1
|
\ SEE.FS highend SEE for ANSforth 16may93jaw |
\ SEE.FS highend SEE for ANSforth 16may93jaw |
|
|
\ Copyright (C) 1995,2000,2003,2004 Free Software Foundation, Inc. |
\ Copyright (C) 1995,2000,2003,2004,2006,2007,2008 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
\ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
\ modify it under the terms of the GNU General Public License |
\ modify it under the terms of the GNU General Public License |
\ as published by the Free Software Foundation; either version 2 |
\ as published by the Free Software Foundation, either version 3 |
\ of the License, or (at your option) any later version. |
\ of the License, or (at your option) any later version. |
|
|
\ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
Line 15
|
Line 15
|
\ GNU General Public License for more details. |
\ GNU General Public License for more details. |
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program. If not, see http://www.gnu.org/licenses/. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
|
|
|
\ May be cross-compiled |
\ May be cross-compiled |
Line 120 VARIABLE Colors Colors on
|
Line 119 VARIABLE Colors Colors on
|
else |
else |
base @ >r try |
base @ >r try |
8 base ! 0 <<# # # # '\ hold #> ctype #>> 0 |
8 base ! 0 <<# # # # '\ hold #> ctype #>> 0 |
recover |
restore |
|
r@ base ! |
endtry |
endtry |
r> base ! throw |
rdrop throw |
endif |
endif |
endif |
endif |
1 /string |
1 /string |
Line 293 VARIABLE C-Pass
|
Line 293 VARIABLE C-Pass
|
\ here docon: , docol: , dovar: , douser: , dodefer: , dofield: , |
\ here docon: , docol: , dovar: , douser: , dodefer: , dofield: , |
\ here over - 2constant doers |
\ here over - 2constant doers |
|
|
|
[IFDEF] !does |
|
: c-does> \ end of create part |
|
Display? IF S" DOES> " Com# .string THEN ; |
|
\ maxaligned /does-handler + ; \ !! no longer needed for non-cross stuff |
|
[THEN] |
|
|
: c-lit ( addr1 -- addr2 ) |
: c-lit ( addr1 -- addr2 ) |
Display? IF |
Display? IF |
dup @ dup body> dup cfaligned over = swap in-dictionary? and if |
dup @ dup body> dup cfaligned over = swap in-dictionary? and if |
Line 301 VARIABLE C-Pass
|
Line 307 VARIABLE C-Pass
|
drop c-call EXIT |
drop c-call EXIT |
endif |
endif |
endif |
endif |
|
over 4 cells + over = if |
|
over 1 cells + @ decompile-prim ['] call xt>threaded = >r |
|
over 2 cells + @ ['] !does >body = >r |
|
over 3 cells + @ decompile-prim ['] ;S xt>threaded = |
|
r> and r> and |
|
if drop c-does> 4 cells + EXIT endif |
|
endif |
\ !! test for cfa here, and print "['] ..." |
\ !! test for cfa here, and print "['] ..." |
dup abs 0 <# #S rot sign #> 0 .string bl cemit |
dup abs 0 <# #S rot sign #> 0 .string bl cemit |
endif |
endif |
Line 529 VARIABLE C-Pass
|
Line 542 VARIABLE C-Pass
|
ELSE 2drop |
ELSE 2drop |
THEN ; |
THEN ; |
|
|
[IFDEF] (does>) |
|
: c-does> \ end of create part |
|
Display? IF S" DOES> " Com# .string THEN |
|
maxaligned /does-handler + ; |
|
[THEN] |
|
|
|
[IFDEF] (compile) |
[IFDEF] (compile) |
: c-(compile) |
: c-(compile) |
Display? |
Display? |
Line 576 CREATE C-Table
|
Line 583 CREATE C-Table
|
[IFDEF] (abort") ' (abort") A, ' c-abort" A, [THEN] |
[IFDEF] (abort") ' (abort") A, ' c-abort" A, [THEN] |
\ only defined if compiler is loaded |
\ only defined if compiler is loaded |
[IFDEF] (compile) ' (compile) A, ' c-(compile) A, [THEN] |
[IFDEF] (compile) ' (compile) A, ' c-(compile) A, [THEN] |
[IFDEF] (does>) ' (does>) A, ' c-does> A, [THEN] |
|
0 , here 0 , |
0 , here 0 , |
|
|
avariable c-extender |
avariable c-extender |
Line 657 Defer xt-see-xt ( xt -- )
|
Line 663 Defer xt-see-xt ( xt -- )
|
space ; |
space ; |
|
|
Defer discode ( addr u -- ) \ gforth |
Defer discode ( addr u -- ) \ gforth |
\G hook for the disassembler: disassemble code at addr of length u |
\G hook for the disassembler: disassemble u bytes of code at addr |
' dump IS discode |
' dump IS discode |
|
|
: next-head ( addr1 -- addr2 ) \ gforth |
: next-head ( addr1 -- addr2 ) \ gforth |
Line 706 Defer discode ( addr u -- ) \ gforth
|
Line 712 Defer discode ( addr u -- ) \ gforth
|
then |
then |
over - discode |
over - discode |
." end-code" cr ; |
." end-code" cr ; |
|
: seeabicode ( xt -- ) |
|
dup s" ABI-Code" .defname |
|
>body dup dup next-head |
|
swap - discode |
|
." end-code" cr ; |
: seevar ( xt -- ) |
: seevar ( xt -- ) |
s" Variable" .defname cr ; |
s" Variable" .defname cr ; |
: seeuser ( xt -- ) |
: seeuser ( xt -- ) |
Line 757 Defer discode ( addr u -- ) \ gforth
|
Line 768 Defer discode ( addr u -- ) \ gforth
|
dup >code-address |
dup >code-address |
CASE |
CASE |
docon: of seecon endof |
docon: of seecon endof |
|
[IFDEF] dovalue: |
|
dovalue: of seevalue endof |
|
[THEN] |
docol: of seecol endof |
docol: of seecol endof |
dovar: of seevar endof |
dovar: of seevar endof |
[ [IFDEF] douser: ] |
[IFDEF] douser: |
douser: of seeuser endof |
douser: of seeuser endof |
[ [THEN] ] |
[THEN] |
[ [IFDEF] dodefer: ] |
[IFDEF] dodefer: |
dodefer: of seedefer endof |
dodefer: of seedefer endof |
[ [THEN] ] |
[THEN] |
[ [IFDEF] dofield: ] |
[IFDEF] dofield: |
dofield: of seefield endof |
dofield: of seefield endof |
[ [THEN] ] |
[THEN] |
|
[IFDEF] doabicode: |
|
doabicode: of seeabicode endof |
|
[THEN] |
over of seecode endof \ direct threaded code words |
over of seecode endof \ direct threaded code words |
over >body of seecode endof \ indirect threaded code words |
over >body of seecode endof \ indirect threaded code words |
2drop abort" unknown word type" |
2drop abort" unknown word type" |