Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
gforth
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Bernd Paysan
gforth
Commits
51639d4a
Commit
51639d4a
authored
Feb 06, 1995
by
anton
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
The bodies of words are now maxaligned
parent
4a735ba4
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
48 additions
and
33 deletions
+48
-33
BUGS
BUGS
+1
-10
cross.fs
cross.fs
+15
-6
errore.fs
errore.fs
+1
-1
float.fs
float.fs
+7
-7
kernal.fs
kernal.fs
+24
-9
No files found.
BUGS
View file @
51639d4a
...
...
@@ -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
View file @
51639d4a
\
CROSS
.
FS
The
Cross
-
Compiler
06
oct92py
\
$
Id
:
cross
.
fs
,
v
1
.
2
1
1995
-
02
-
02
18
:
13
:
02
pazsa
n
Exp
$
\
$
Id
:
cross
.
fs
,
v
1
.
2
2
1995
-
02
-
06
18
:
14
:
30
anto
n
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, cf
align ;
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
cf
align H ;
: view, ( -- ) ( dummy ) ;
VARIABLE CreateFlag CreateFlag off
...
...
errore.fs
View file @
51639d4a
...
...
@@ -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
...
...
float.fs
View file @
51639d4a
...
...
@@ -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
&
1
6
Value
precision
&
1
5
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
*
;
...
...
kernal.fs
View file @
51639d4a
...
...
@@ -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
17
dec92py
:
(
name
>)
(
nfa
--
cfa
)
count
$
1
F
and
+
aligned
;
:
name
>
(
nfa
--
cfa
)
cell
+
dup
(
name
>)
swap
c
@
$
80
and
0
=
IF
@
THEN
;
:
(
name
>)
(
nfa
--
cfa
)
count
$
1
F
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, cf
align ;
: 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, cf
align
$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 +
cf
aligned 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 !
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment