version 1.29, 1995/10/07 17:38:11
|
version 1.37, 1996/07/16 20:57:07
|
Line 1
|
Line 1
|
\ CROSS.FS The Cross-Compiler 06oct92py |
\ CROSS.FS The Cross-Compiler 06oct92py |
\ $Id$ |
|
\ Idea and implementation: Bernd Paysan (py) |
\ Idea and implementation: Bernd Paysan (py) |
\ Copyright 1992-94 by the GNU Forth Development Group |
|
|
\ Copyright (C) 1995 Free Software Foundation, Inc. |
|
|
|
\ This file is part of Gforth. |
|
|
|
\ Gforth 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. |
|
|
\ Log: |
\ Log: |
\ changed in ; [ to state off 12may93jaw |
\ changed in ; [ to state off 12may93jaw |
Line 341 variable ResolveFlag
|
Line 357 variable ResolveFlag
|
VARIABLE ^imm |
VARIABLE ^imm |
|
|
>TARGET |
>TARGET |
: immediate 20 flag! |
: immediate 40 flag! |
^imm @ @ dup <imm> = IF drop EXIT THEN |
^imm @ @ dup <imm> = IF drop EXIT THEN |
<res> <> ABORT" CROSS: Cannot immediate a unresolved word" |
<res> <> ABORT" CROSS: Cannot immediate a unresolved word" |
<imm> ^imm @ ! ; |
<imm> ^imm @ ! ; |
: restrict 40 flag! ; |
: restrict 20 flag! ; |
>CROSS |
>CROSS |
|
|
\ ALIAS2 ansforth conform alias 9may93jaw |
\ ALIAS2 ansforth conform alias 9may93jaw |
Line 389 Variable to-doc
|
Line 405 Variable to-doc
|
|
|
\ Target TAGS creation |
\ Target TAGS creation |
|
|
s" TAGS" r/w create-file throw value tag-file-id |
s" kernal.TAGS" r/w create-file throw value tag-file-id |
\ contains the file-id of the tags file |
\ contains the file-id of the tags file |
|
|
Create tag-beg 2 c, 7F c, bl c, |
Create tag-beg 2 c, 7F c, bl c, |
Line 402 Create tag-bof 1 c, 0C c,
|
Line 418 Create tag-bof 1 c, 0C c,
|
loadfilename 2@ last-loadfilename 2@ d<> |
loadfilename 2@ last-loadfilename 2@ d<> |
IF |
IF |
tag-bof count tag-file-id write-line throw |
tag-bof count tag-file-id write-line throw |
loadfilename 2@ 2dup |
sourcefilename 2dup |
tag-file-id write-file throw |
tag-file-id write-file throw |
last-loadfilename 2! |
last-loadfilename 2! |
s" ,0" tag-file-id write-line throw |
s" ,0" tag-file-id write-line throw |
Line 416 Create tag-bof 1 c, 0C c,
|
Line 432 Create tag-bof 1 c, 0C c,
|
tag-beg count tag-file-id write-file throw |
tag-beg count tag-file-id write-file throw |
tlast @ >image count $1F and tag-file-id write-file throw |
tlast @ >image count $1F and tag-file-id write-file throw |
tag-end count tag-file-id write-file throw |
tag-end count tag-file-id write-file throw |
base @ decimal loadline @ 0 <# #s #> tag-file-id write-file throw |
base @ decimal sourceline# 0 <# #s #> tag-file-id write-file throw |
\ >in @ 0 <# #s [char] , hold #> tag-file-id write-line throw |
\ >in @ 0 <# #s [char] , hold #> tag-file-id write-line throw |
s" ,0" tag-file-id write-line throw |
s" ,0" tag-file-id write-line throw |
base ! |
base ! |
Line 553 Cond: [Char] ( "<char>" -- ) restrict
|
Line 569 Cond: [Char] ( "<char>" -- ) restrict
|
(THeader ;Resolve ! there ;Resolve cell+ ! |
(THeader ;Resolve ! there ;Resolve cell+ ! |
docol, depth T ] H ; |
docol, depth T ] H ; |
|
|
|
: :noname ( -- colon-sys ) |
|
T align H there docol, depth T ] H ; |
|
|
Cond: EXIT ( -- ) restrict? compile ;S ;Cond |
Cond: EXIT ( -- ) restrict? compile ;S ;Cond |
|
|
Cond: ?EXIT ( -- ) 1 abort" CROSS: using ?exit" ;Cond |
Cond: ?EXIT ( -- ) 1 abort" CROSS: using ?exit" ;Cond |
Line 678 Build: T 0 , H ;
|
Line 697 Build: T 0 , H ;
|
by Constant |
by Constant |
Builder Value |
Builder Value |
|
|
|
Build: T 0 A, H ; |
|
by Constant |
|
Builder AValue |
|
|
Build: ( -- ) compile noop ; |
Build: ( -- ) compile noop ; |
DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO |
DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO |
Builder Defer |
Builder Defer |
by Defer :dodefer resolve |
by Defer :dodefer resolve |
|
|
|
Build: ( inter comp -- ) swap T immediate A, A, H ; |
|
DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO |
|
Builder special: |
|
|
\ Sturctures 23feb95py |
\ Sturctures 23feb95py |
|
|
>CROSS |
>CROSS |
Line 857 Cond: [ELSE] [ELSE] ;Cond
|
Line 884 Cond: [ELSE] [ELSE] ;Cond
|
|
|
bigendian Constant bigendian |
bigendian Constant bigendian |
|
|
Create magic s" gforth00" here over allot swap move |
Create magic s" Gforth10" here over allot swap move |
|
|
[char] 1 bigendian + cell + magic 7 + c! |
char 1 bigendian + cell + magic 7 + c! |
|
|
: save-cross ( "name" -- ) |
: save-cross ( "image-name" "binary-name" -- ) |
bl parse ." Saving to " 2dup type |
bl parse ." Saving to " 2dup type cr |
w/o bin create-file throw >r |
w/o bin create-file throw >r |
|
s" #! " r@ write-file throw |
|
bl parse r@ write-file throw |
|
s" -i" r@ write-file throw |
|
#lf r@ emit-file throw |
|
r@ dup file-position throw drop 8 mod 8 swap ( file-id limit index ) |
|
?do |
|
bl over emit-file throw |
|
loop |
|
drop |
magic 8 r@ write-file throw \ write magic |
magic 8 r@ write-file throw \ write magic |
image @ there r@ write-file throw \ write image |
image @ there r@ write-file throw \ write image |
bit$ @ there 1- cell>bit rshift 1+ |
bit$ @ there 1- cell>bit rshift 1+ |