version 1.29, 1995/10/07 17:38:11
|
version 1.34, 1996/04/17 16:39:39
|
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 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 678 Build: T 0 , H ;
|
Line 694 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 |
Line 857 Cond: [ELSE] [ELSE] ;Cond
|
Line 877 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+ |