Commit 51639d4a authored by anton's avatar anton

The bodies of words are now maxaligned

parent 4a735ba4
......@@ -2,7 +2,7 @@ name> does not take the same argument as e.g. .name. Remedy: add cell+
before name>, but adapt all uses. anton 23apr94 Solved?
revealing the same name several times (e.g., by using recursive)
results in redefined messages. anton 28jul94
results in "redefined ..." messages. anton 28jul94
if blocks.fb does not exist, 1 block creates the file, but cannot
read-file from it. Only if the file-id has been created with
......@@ -10,15 +10,6 @@ open-file, not create-file, read-file works. - anton 6aug94
etags.fs crashes one of my applications (gs.fs). anton 12jan95
f. suppresses all digits when it prints 0:
0e0 f. . ok
There's also one other problem with f.:
1e-20 f. 0.00000000000000000001000000000000001 ok
-20e0 falog f. 0.00000000000000000001000000000000001 ok
0.00000000000000000001e0 f. 0.00000000000000000001000000000000001 ok
All this happens under Slackware Linux. On the DecStation I get a
similar error in the other direction. anton 17jan95
not all aliases are in the etags file. Bug in etags.fs? anton 24jan95
emacs often finds the wrong tag. anton 24jan95
......
\ CROSS.FS The Cross-Compiler 06oct92py
\ $Id: cross.fs,v 1.21 1995-02-02 18:13:02 pazsan Exp $
\ $Id: cross.fs,v 1.22 1995-02-06 18:14:30 anton Exp $
\ Idea and implementation: Bernd Paysan (py)
\ Copyright 1992-94 by the GNU Forth Development Group
......@@ -39,10 +39,10 @@ decimal
VARIABLE GhostNames
0 GhostNames !
: GhostName ( -- addr )
here GhostNames @ , GhostNames ! here 0 ,
bl word count
\ 2dup type space
dup c, here over chars allot swap move align ;
here GhostNames @ , GhostNames ! here 0 ,
bl word count
\ 2dup type space
string, cfalign ;
hex
......@@ -172,11 +172,18 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c, 8 c, 4 c, 2 c, 1 c,
: align+ ( taddr -- rest )
cell tuck 1- and - [ cell 1- ] Literal and ;
: cfalign+ ( taddr -- rest )
\ see kernal.fs:cfaligned
float tuck 1- and - [ float 1- ] Literal and ;
>TARGET
: aligned ( taddr -- ta-addr ) dup align+ + ;
\ assumes cell alignment granularity (as GNU C)
: cfaligned ( taddr1 -- taddr2 )
\ see kernal.fs
dup cfalign+ + ;
>CROSS
: >image ( taddr -- absaddr ) image @ + ;
>TARGET
......@@ -195,6 +202,8 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c, 8 c, 4 c, 2 c, 1 c,
: , ( w -- ) T here H cell T allot ! H ;
: c, ( char -- ) T here 1 allot c! H ;
: align ( -- ) T here H align+ 0 ?DO bl T c, H LOOP ;
: cfalign ( -- )
T here H cfalign+ 0 ?DO bl T c, H LOOP ;
: A! dup relon T ! H ;
: A, ( w -- ) T here H relon T , H ;
......@@ -344,7 +353,7 @@ VARIABLE ^imm
: string, ( addr count -- )
dup T c, H bounds DO I c@ T c, H LOOP ;
: name, ( "name" -- ) bl word count string, T align H ;
: name, ( "name" -- ) bl word count string, T cfalign H ;
: view, ( -- ) ( dummy ) ;
VARIABLE CreateFlag CreateFlag off
......
......@@ -10,7 +10,7 @@ AVARIABLE ErrLink \ Linked list entry point
ErrLink linked
,
[char] " word count
dup c, here over chars allot swap move align ;
string, align ;
decimal
......
......@@ -26,20 +26,16 @@
: f, ( f -- ) here 1 floats allot f! ;
\ !! have create produce faligned pfas
: fconstant ( r -- )
falign here f, Create A,
DOES> @ f@ ;
: fvariable
falign here 0. d>f f, AConstant ;
Create f,
DOES> f@ ;
: fdepth ( -- n ) f0 @ fp@ - [ 1 floats ] Literal / ;
: FLit ( -- r ) r> faligned dup f@ float+ >r ;
: FLiteral ( r -- ) postpone FLit falign f, ; immediate
&16 Value precision
&15 Value precision
: set-precision to precision ;
: scratch ( r -- addr len )
......@@ -83,6 +79,10 @@
' sfnumber IS notfound
: fvariable ( -- )
Create 0e0 f, ;
\ does> ( -- f-addr )
1e0 fasin 2e0 f* fconstant pi
: f2* 2e0 f* ;
......
......@@ -66,6 +66,15 @@ DOES> ( n -- ) + c@ ;
bl c,
LOOP ;
\ !! this is machine-dependent, but works on all but the strangest machines
' faligned Alias maxaligned
' falign Alias maxalign
\ the code field is aligned if its body is maxaligned
\ !! machine-dependent and won't work if "0 >body" <> "0 >body maxaligned"
' maxaligned Alias cfaligned
' maxalign Alias cfalign
: chars ; immediate
: A! ( addr1 addr2 -- ) dup relon ! ;
......@@ -78,9 +87,11 @@ DOES> ( n -- ) + c@ ;
\ name> found 17dec92py
: (name>) ( nfa -- cfa ) count $1F and + aligned ;
: name> ( nfa -- cfa ) cell+
dup (name>) swap c@ $80 and 0= IF @ THEN ;
: (name>) ( nfa -- cfa )
count $1F and + cfaligned ;
: name> ( nfa -- cfa )
cell+
dup (name>) swap c@ $80 and 0= IF @ THEN ;
: found ( nfa -- cfa n ) cell+
dup c@ >r (name>) r@ $80 and 0= IF @ THEN
......@@ -358,7 +369,7 @@ Defer notfound ( c-addr count -- )
IF
1 and
IF \ not restricted to compile state?
nip nip execute EXIT
nip nip execute EXIT
THEN
-&14 throw
THEN
......@@ -802,10 +813,14 @@ Avariable leave-sp leave-stack 3 cells + leave-sp !
defer (header)
defer header ' (header) IS header
: string, ( c-addr u -- )
\ puts down string as cstring
dup c, here swap chars dup allot move ;
: name, ( "name" -- )
name
dup $1F u> -&19 and throw ( is name too long? )
dup c, here swap chars dup allot move align ;
string, cfalign ;
: input-stream-header ( "name" -- )
\ !! this is f83-implementation-dependent
align here last ! -1 A,
......@@ -824,7 +839,7 @@ create nextname-buffer 32 chars allot
\ !! f83-implementation-dependent
nextname-buffer count
align here last ! -1 A,
dup c, here swap chars dup allot move align
string, cfalign
$80 flag!
input-stream ;
......@@ -836,7 +851,7 @@ create nextname-buffer 32 chars allot
['] nextname-header IS (header) ;
: noname-header ( -- )
0 last !
0 last ! cfalign
input-stream ;
: noname ( -- ) \ general
......@@ -856,7 +871,7 @@ create nextname-buffer 32 chars allot
Create ??? 0 , 3 c, char ? c, char ? c, char ? c,
: >name ( cfa -- nfa )
$21 cell do
dup i - count $9F and + aligned over $80 + = if
dup i - count $9F and + cfaligned over $80 + = if
i - cell - unloop exit
then
cell +loop
......@@ -992,7 +1007,7 @@ G forth-wordlist current T !
dup cell+ @ @ execute ;
: search-wordlist ( addr count wid -- 0 / xt +-1 )
(search-wordlist) dup IF found THEN ;
(search-wordlist) dup IF found THEN ;
Variable warnings G -1 warnings T !
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment