Commit 893c9f57 authored by pazsan's avatar pazsan

Removed BUGS, tried to clean up.

parent 9ea125d9
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
etags.fs crashes one of my applications (gs.fs). anton 12jan95
not all aliases are in the etags file. Bug in etags.fs? anton 24jan95
-> wrote special tag generation for cross compilation. bernd 6sep95
emacs often finds the wrong tag. anton 24jan95
-> emacs does not search for a complete word, but for parts.
-> Solution: add blanks in front and end of tag name (etags.fs)
-> and use own forth-find-tag. bernd 6sep95
gforth.el: indentation does not work right on the first line of a
buffer. anton 27jan95
-> Solved?
Conditional compilation continues after the file ends. This is allowed
by the standard (through an ambiguous condition), but the compiler
should at least produce a warning. anton 27jan95
accept and expect: the result string can be exceeded with tab
(completion). anton 16apr95
gforth should terminate when the input file ends. Also, C-d from the
terminal should terminate gforth. anton 16apr95
floating-point stack not checked. anton 23apr95
.1 is interpreted as floating-pint number, not as double number or
.1 is interpreted as floating-point number, not as double number or
error. anton 4may95
-> All numbers ecvt converts are (by implementation) floating-point.
-> Should we add a check againgst . at the start of a number?
-> .1 isn't a double number; it's either an error or a FP number.
-> bernd 5sep95
DOS and OS/2 don't like . at begin of a file (.gforth-history). bernd 6sep95py
\ No newline at end of file
......@@ -193,50 +193,50 @@ gforth: $(OBJECTS)
@MAKE_EXE@
kernl16l.fi+: $(KERN_SRC) mach16l.fs $(FORTH_GEN0)
-$(CP) kernl16l.fi kernl16l.fi~
$(FORTH) -e 's" mach16l.fs"' main.fs
kernl16b.fi+: $(KERN_SRC) mach16b.fs $(FORTH_GEN0)
-$(CP) kernl16b.fi kernl16b.fi~
$(FORTH) -e 's" mach16b.fs"' main.fs
kernl32l.fi+: $(KERN_SRC) mach32l.fs $(FORTH_GEN0)
-$(CP) kernl32l.fi kernl32l.fi~
$(FORTH) -e 's" mach32l.fs"' main.fs
kernl32b.fi+: $(KERN_SRC) mach32b.fs $(FORTH_GEN0)
-$(CP) kernl32b.fi kernl32b.fi~
$(FORTH) -e 's" mach32b.fs"' main.fs
kernl64l.fi+: $(KERN_SRC) mach64l.fs $(FORTH_GEN0)
-$(CP) kernl64l.fi kernl64l.fi~
$(FORTH) -e 's" mach64l.fs"' main.fs
kernl64b.fi+: $(KERN_SRC) mach64b.fs $(FORTH_GEN0)
-$(CP) kernl64b.fi kernl64b.fi~
$(FORTH) -e 's" mach64b.fs"' main.fs
kernl16b.fi: $(KERNLS)
-$(CP) kernl16b.fi kernl16b.fi~
-$(CP) kernl16b.fi+ kernl16b.fi
@LINK_KERNL16B@
kernl16l.fi: $(KERNLS)
-$(CP) kernl16l.fi kernl16l.fi~
-$(CP) kernl16l.fi+ kernl16l.fi
@LINK_KERNL16L@
kernl32b.fi: $(KERNLS)
-$(CP) kernl32b.fi kernl32b.fi~
-$(CP) kernl32b.fi+ kernl32b.fi
@LINK_KERNL32B@
kernl32l.fi: $(KERNLS)
-$(CP) kernl32l.fi kernl32l.fi~
-$(CP) kernl32l.fi+ kernl32l.fi
@LINK_KERNL32L@
kernl64b.fi: $(KERNLS)
-$(CP) kernl64b.fi kernl64b.fi~
-$(CP) kernl64b.fi+ kernl64b.fi
@LINK_KERNL64B@
kernl64l.fi: $(KERNLS)
-$(CP) kernl64l.fi kernl64l.fi~
-$(CP) kernl64l.fi+ kernl64l.fi
@LINK_KERNL64L@
......@@ -304,3 +304,7 @@ configure: configure.in
makefile.dos: mkdosmf.sed Makefile.in
sed -f mkdosmf.sed <Makefile.in >makefile.dos
startup.dos: startup.fs Makefile.in
sed -e "s/\\\\ include doskey/include doskey/g" \
-e "s/include vt100key/\\\\ include vt100key/g" <$< >$@
\ No newline at end of file
......@@ -39,13 +39,13 @@ block-cold
Defer flush-file
: use-file ( addr u -- )
block-fid @ IF flush-file block-fid @ close-file throw THEN
2dup r/w bin open-file 0<>
if
drop r/w bin create-file throw
else
nip nip
then
block-fid @ IF flush-file block-fid @ close-file throw THEN
block-fid ! ;
\ the file is opened as binary file, since it either will contain text
......
\ CROSS.FS The Cross-Compiler 06oct92py
\ $Id: cross.fs,v 1.27 1995-08-27 19:56:27 pazsan Exp $
\ $Id: cross.fs,v 1.28 1995-09-06 21:00:11 pazsan Exp $
\ Idea and implementation: Bernd Paysan (py)
\ Copyright 1992-94 by the GNU Forth Development Group
......@@ -357,7 +357,7 @@ VARIABLE ^imm
\ Target Header Creation 01nov92py
: string, ( addr count -- )
dup T c, H bounds DO I c@ T c, H LOOP ;
dup T c, H bounds ?DO I c@ T c, H LOOP ;
: name, ( "name" -- ) bl word count string, T cfalign H ;
: view, ( -- ) ( dummy ) ;
......@@ -387,6 +387,43 @@ Variable to-doc
>in !
THEN to-doc on ;
\ Target TAGS creation
s" TAGS" r/w create-file throw value tag-file-id
\ contains the file-id of the tags file
Create tag-beg 2 c, 7F c, bl c,
Create tag-end 2 c, bl c, 01 c,
Create tag-bof 1 c, 0C c,
2variable last-loadfilename 0 0 last-loadfilename 2!
: put-load-file-name ( -- )
loadfilename 2@ last-loadfilename 2@ d<>
IF
tag-bof count tag-file-id write-line throw
loadfilename 2@ 2dup
tag-file-id write-file throw
last-loadfilename 2!
s" ,0" tag-file-id write-line throw
THEN ;
: cross-tag-entry ( -- )
tlast @ 0<> \ not an anonymous (i.e. noname) header
IF
put-load-file-name
source >in @ min 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
tag-end count tag-file-id write-file throw
base @ decimal loadline @ 0 <# #s #> tag-file-id write-file throw
\ >in @ 0 <# #s [char] , hold #> tag-file-id write-line throw
s" ,0" tag-file-id write-line throw
base !
THEN ;
\ Target header creation
VARIABLE CreateFlag CreateFlag off
: (Theader ( "name" -- ghost ) T align H view,
......@@ -402,7 +439,7 @@ VARIABLE CreateFlag CreateFlag off
Already @ IF dup >end tdoes !
ELSE 0 tdoes ! THEN
80 flag!
cross-doc-entry ;
cross-doc-entry cross-tag-entry ;
VARIABLE ;Resolve 1 cells allot
......
......@@ -281,7 +281,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)
IF_TOS(TOS = sp[0]);
IF_FTOS(FTOS = fp[0]);
prep_terminal();
/* prep_terminal(); */
NEXT_P0;
NEXT;
......
......@@ -77,7 +77,9 @@ create emit-file-char 0 c,
r@ put-load-file-name
source drop >in @ r@ write-file throw
127 r@ emit-file throw
bl r@ emit-file throw
last @ name>string r@ write-file throw
bl r@ emit-file throw
1 r@ emit-file throw
base @ decimal loadline @ 0 <# #s #> r@ write-file throw base !
s" ,0" r@ write-line throw
......@@ -85,7 +87,7 @@ create emit-file-char 0 c,
\ instead of using 0, we could use file-position and subtract
\ the line length
rdrop
endif ;
endif cr ;
: (tags-header) ( -- )
defers header
......
......@@ -20,7 +20,7 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; $Header: /usr/local/lib/cvs-repository/src-master/gforth/gforth.el,v 1.12 1995-08-27 19:56:30 pazsan Exp $
;;; $Header: /usr/local/lib/cvs-repository/src-master/gforth/gforth.el,v 1.13 1995-09-06 21:00:15 pazsan Exp $
;;-------------------------------------------------------------------
;; A Forth indentation, documentation search and interaction library
......@@ -37,13 +37,13 @@
(defvar forth-positives
" : :noname begin do ?do while if ?dup-if ?dup-not-if else case create does> exception> struct [if] [else] "
" : :noname begin do ?do while if ?dup-if ?dup-not-if else case struct [if] [else] "
"Contains all words which will cause the indent-level to be incremented
on the next line.
OBS! All words in forth-positives must be surrounded by spaces.")
(defvar forth-negatives
" ; until repeat while +loop loop s+loop else then endif again endcase does> end-struct [then] [else] [endif]"
" ; until repeat while +loop loop s+loop else then endif again endcase end-struct [then] [else] [endif]"
"Contains all words which will cause the indent-level to be decremented
on the current line.
OBS! All words in forth-negatives must be surrounded by spaces.")
......@@ -81,6 +81,14 @@ OBS! All words in forth-negatives must be surrounded by spaces.")
(define-key forth-mode-map "\t" 'forth-indent-command)
(define-key forth-mode-map "\C-m" 'reindent-then-newline-and-indent)
(define-key forth-mode-map "\M-q" 'forth-fill-paragraph)
(define-key forth-mode-map "\e." 'forth-find-tag)
(load "etags.el")
(defun forth-find-tag (tagname &optional next-p regexp-p)
(interactive (find-tag-interactive "Find tag: "))
(switch-to-buffer
(find-tag-noselect (concat " " tagname " ") next-p regexp-p)))
(defvar forth-mode-syntax-table nil
"Syntax table in use in Forth-mode buffers.")
......@@ -103,7 +111,7 @@ OBS! All words in forth-negatives must be surrounded by spaces.")
;only supports one comment syntax (and a hack to accomodate C++); I
;use '\' for natural language comments and '(' for formal comments
;like stack comments, so for me it's better to have emacs treat '\'
;comments as comments. I you want it different, make the appropriate
;comments as comments. If you want it different, make the appropriate
;changes (best in your .emacs file).
;
;Hmm, the C++ hack could be used to support both comment syntaxes: we
......@@ -413,12 +421,9 @@ part of the screen."
(message "Resetting Forth process...done")))))
(defun forth-default-command-line ()
(concat forth-program-name " -emacs"
(concat forth-program-name
(if forth-program-arguments
(concat " " forth-program-arguments)
"")
(if forth-band-name
(concat " -band " forth-band-name)
"")))
;;;; Internal Variables
......
......@@ -6,11 +6,12 @@
2Variable backward^
2Variable end^
: get-history ( addr len -- wid )
\ check-file-prefix drop
: force-open ( addr len -- handle )
2dup r/w open-file 0<
IF drop r/w create-file throw ELSE nip nip THEN
to history
IF drop r/w create-file throw ELSE nip nip THEN ;
: get-history ( addr len -- wid )
force-open to history
history file-size throw
2dup forward^ 2! 2dup backward^ 2! end^ 2! ;
......@@ -30,25 +31,28 @@ s" ~/.gforth-history" get-history
: clear-tib ( max span addr pos -- max 0 addr 0 false )
clear-line 0 tuck dup ;
: get-line ( max addr -- max span addr pos dpos )
history file-position throw backward^ 2!
2dup swap history read-line throw drop
2dup type tuck
history file-position throw forward^ 2! ;
: hist-pos ( -- ud ) history file-position throw ;
: hist-setpos ( ud -- ) history reposition-file throw ;
: get-line ( addr len -- len' flag )
swap history read-line throw ;
: next-line ( max span addr pos1 -- max span addr pos2 false )
clear-line
forward^ 2@ history reposition-file throw
get-line 0 ;
forward^ 2@ 2dup hist-setpos backward^ 2!
2dup get-line drop
hist-pos forward^ 2!
tuck 2dup type 0 ;
: prev-line ( max span addr pos1 -- max span addr pos2 false )
clear-line over 2 + negate s>d backward^ 2@ d+ 0. dmax
2dup history reposition-file throw
BEGIN 2over swap history read-line throw WHILE
>r history file-position throw
2dup backward^ 2@ d< WHILE 2swap 2drop rdrop
REPEAT ELSE >r history file-position throw THEN
forward^ 2! backward^ 2! r> tuck 2dup type 0 ;
clear-line backward^ 2@ forward^ 2!
over 2 + negate s>d backward^ 2@ d+ 0. dmax 2dup hist-setpos
BEGIN
backward^ 2! 2dup get-line WHILE
hist-pos 2dup forward^ 2@ d< WHILE
rot drop
REPEAT 2drop THEN
tuck 2dup type 0 ;
: ctrl ( "<char>" -- ctrl-code )
char [char] @ - postpone Literal ; immediate
......@@ -56,10 +60,9 @@ s" ~/.gforth-history" get-history
Create lfpad #lf c,
: (enter) ( max span addr pos1 -- max span addr pos2 true )
>r end^ 2@ history reposition-file throw
2dup swap history write-file throw
lfpad 1 history write-file throw
history file-position throw 2dup backward^ 2! end^ 2!
>r end^ 2@ hist-setpos
2dup swap history write-line throw
hist-pos 2dup backward^ 2! end^ 2!
r> (ret) ;
\ some other key commands 16oct94py
......@@ -82,28 +85,44 @@ Create prefix-found 0 , 0 ,
IF r> char+ capscomp 0<= EXIT THEN
nip r> c@ $1F and < ;
: search-prefix ( addr len1 -- suffix len2 ) 0 >r context
BEGIN BEGIN dup @ over cell - @ = WHILE cell - REPEAT
dup >r -rot r> @ @
BEGIN dup WHILE >r dup r@ cell+ c@ $1F and <=
IF 2dup r@ cell+ char+ capscomp 0=
IF r> dup r@ word-lex
IF dup prefix-found @ word-lex
0>= IF rdrop dup >r THEN
THEN >r
THEN
THEN r> @
REPEAT drop rot cell - dup vp u> 0=
UNTIL drop r> dup prefix-found ! ?dup
IF cell+ count $1F and rot /string rot drop
ELSE 2drop s" " THEN ;
: search-voc ( addr len nfa1 nfa2 -- addr len nfa3 ) >r
BEGIN dup WHILE >r dup r@ cell+ c@ $1F and <=
IF 2dup r@ cell+ char+ capscomp 0=
IF r> dup r@ word-lex
IF dup prefix-found @ word-lex
0>= IF rdrop dup >r THEN
THEN >r
THEN
THEN r> @
REPEAT drop r> ;
: prefix-string ( addr len nfa -- addr' len' )
dup prefix-found ! ?dup
IF cell+ count $1F and rot /string rot drop
dup 1+ prefix-found cell+ !
ELSE
2drop s" " prefix-found cell+ off
THEN ;
: search-prefix ( addr1 len1 -- addr2 len2 )
0 vp dup @ 1- cells over +
DO I 2@ <>
IF I cell+ @ @ swap search-voc THEN
[ -1 cells ] Literal +LOOP
prefix-string ;
: kill-expand ( max span addr pos1 -- max span addr pos2 )
prefix-found cell+ @ 0 ?DO (del) LOOP ;
: tib-full? ( max span addr pos addr' len' -- max span addr pos addr1 u flag )
5 pick over 4 pick + prefix-found @ 0<> - < ;
: tab-expand ( max span addr pos1 -- max span addr pos2 0 )
prefix-found cell+ @ 0 ?DO (del) LOOP
2dup extract-word search-prefix
dup prefix-found @ 0<> - prefix-found cell+ !
bounds ?DO I c@ (ins) LOOP
prefix-found @ IF bl (ins) THEN 0 ;
kill-expand 2dup extract-word search-prefix
tib-full?
IF 7 emit 2drop 0 0 prefix-found 2!
ELSE bounds ?DO I c@ (ins) LOOP THEN
prefix-found @ IF bl (ins) THEN 0 ;
: kill-prefix ( key -- key )
dup #tab <> IF 0 0 prefix-found 2! THEN ;
......
/*
$Id: hppa.h,v 1.7 1995-08-27 19:56:32 pazsan Exp $
$Id: hppa.h,v 1.8 1995-09-06 21:00:18 pazsan Exp $
Copyright 1992 by the ANSI figForth Development Group
This is the machine-specific part for a HPPA running HP-UX
......
......@@ -570,6 +570,8 @@ long key_avail (stream)
long chars_avail = pending;
int result;
if(!terminal_prepped) prep_terminal();
#if defined (FIONREAD)
result = ioctl (tty, FIONREAD, &chars_avail);
#endif
......@@ -605,6 +607,8 @@ unsigned char getkey(stream)
int result;
unsigned char c;
if(!terminal_prepped) prep_terminal();
while (pending < 0)
{
result = read (fileno (stream), &c, sizeof (char));
......@@ -615,7 +619,7 @@ unsigned char getkey(stream)
/* If zero characters are returned, then the file that we are
reading from is empty! Return EOF in that case. */
if (result == 0)
return (0);
return CTRL('D');
/* If the error that we received was SIGINT, then try again,
this is simply an interrupted system call to read ().
......@@ -745,7 +749,7 @@ signal_throw(int sig)
static void
termprep (int sig)
{
terminal_prepped=0; prep_terminal();
terminal_prepped=0;
signal(sig,termprep);
}
......
......@@ -346,7 +346,9 @@ hex
\ ?stack 23feb93py
: ?stack ( ?? -- ?? ) sp@ s0 @ > IF -4 throw THEN ;
: ?stack ( ?? -- ?? )
sp@ s0 @ > IF -4 throw THEN
fp@ f0 @ > IF -&45 throw THEN ;
\ ?stack should be code -- it touches an empty stack!
\ interpret 10mar92py
......@@ -990,15 +992,15 @@ AVariable current
: last? ( -- false / nfa nfa ) last @ ?dup ;
: (reveal) ( -- )
last?
IF
dup @ 0<
IF
current @ @ over ! current @ !
ELSE
drop
THEN
THEN ;
last?
IF
dup @ 0<
IF
current @ @ over ! current @ !
ELSE
drop
THEN
THEN ;
\ object oriented search list 17mar93py
......@@ -1096,9 +1098,10 @@ Variable warnings G -1 warnings T !
: (ret) type-rest drop true space ;
: back dup IF 1- #bs emit ELSE #bell emit THEN 0 ;
: forw 2 pick over <> IF 2dup + c@ emit 1+ ELSE #bell emit THEN 0 ;
: eof 2 pick 0= IF bye ELSE (ret) THEN ;
Create ctrlkeys
] false false back false false false forw false
] false false back false eof false forw false
?del false (ret) false false (ret) false false
false false false false false false false false
false false false false false false false false [
......@@ -1334,7 +1337,7 @@ create included-files 0 , 0 , ( pointer to and count of included files )
: recurse ( -- )
lastxt compile, ; immediate restrict
: recursive ( -- )
reveal ; immediate
reveal last off ; immediate
\ */MOD */ 17may93jaw
......@@ -1503,17 +1506,16 @@ Variable argc
: process-args ( -- )
>tib @ >r
true to script?
argc @ 1
?DO
I arg over c@ [char] - <>
IF
required 1
ELSE
I 1+ arg do-option
I 1+ argc @ = IF s" " ELSE I 1+ arg THEN
do-option
THEN
+LOOP
false to script?
r> >tib ! ;
Defer 'cold ' noop IS 'cold
......@@ -1524,12 +1526,14 @@ Defer 'cold ' noop IS 'cold
'cold
argc @ 1 >
IF
true to script?
['] process-args catch ?dup
IF
dup >r DoError cr r> negate (bye)
THEN
cr
THEN
cr
false to script?
." GNU Forth " version-string type ." , Copyright (C) 1994 Free Software Foundation, Inc." cr
." GNU Forth comes with ABSOLUTELY NO WARRANTY; for details type `license'" cr
." Type `bye' to exit"
......
/*
$Id: main.c,v 1.26 1995-08-27 19:56:33 pazsan Exp $
$Id: main.c,v 1.27 1995-09-06 21:00:22 pazsan Exp $
Copyright 1993 by the ANSI figForth Development Group
*/
......
......@@ -193,50 +193,50 @@ gforth: $(OBJECTS)
coff2exe $@
kernl16l.fi+: $(KERN_SRC) mach16l.fs $(FORTH_GEN0)
-$(CP) kernl16l.fi kernl16l.fi~
$(FORTH) -e 's" mach16l.fs"' main.fs
kernl16b.fi+: $(KERN_SRC) mach16b.fs $(FORTH_GEN0)
-$(CP) kernl16b.fi kernl16b.fi~
$(FORTH) -e 's" mach16b.fs"' main.fs
kernl32l.fi+: $(KERN_SRC) mach32l.fs $(FORTH_GEN0)
-$(CP) kernl32l.fi kernl32l.fi~
$(FORTH) -e 's" mach32l.fs"' main.fs
kernl32b.fi+: $(KERN_SRC) mach32b.fs $(FORTH_GEN0)
-$(CP) kernl32b.fi kernl32b.fi~
$(FORTH) -e 's" mach32b.fs"' main.fs
kernl64l.fi+: $(KERN_SRC) mach64l.fs $(FORTH_GEN0)
-$(CP) kernl64l.fi kernl64l.fi~
$(FORTH) -e 's" mach64l.fs"' main.fs
kernl64b.fi+: $(KERN_SRC) mach64b.fs $(FORTH_GEN0)
-$(CP) kernl64b.fi kernl64b.fi~
$(FORTH) -e 's" mach64b.fs"' main.fs
kernl16b.fi: $(KERNLS)
-$(CP) kernl16b.fi kernl16b.fi~
-$(CP) kernl16b.fi+ kernl16b.fi
kernl16l.fi: $(KERNLS)
-$(CP) kernl16l.fi kernl16l.fi~
-$(CP) kernl16l.fi+ kernl16l.fi
kernl32b.fi: $(KERNLS)
-$(CP) kernl32b.fi kernl32b.fi~
-$(CP) kernl32b.fi+ kernl32b.fi
kernl32l.fi: $(KERNLS)
-$(CP) kernl32l.fi kernl32l.fi~
-$(CP) kernl32l.fi+ kernl32l.fi
-$(CP) kernl32l.fi gforth.fi
kernl64b.fi: $(KERNLS)
-$(CP) kernl64b.fi kernl64b.fi~
-$(CP) kernl64b.fi+ kernl64b.fi
kernl64l.fi: $(KERNLS)
-$(CP) kernl64l.fi kernl64l.fi~
-$(CP) kernl64l.fi+ kernl64l.fi
......@@ -304,3 +304,7 @@ configure: configure.in
makefile.dos: mkdosmf.sed Makefile.in
sed -f mkdosmf.sed <Makefile.in >makefile.dos
startup.dos: startup.fs Makefile.in
sed -e "s/\\\\ include doskey/include doskey/g" \
-e "s/include vt100key/\\\\ include vt100key/g" <$< >$@
\ No newline at end of file
$Id: model,v 1.3 1995-08-27 19:56:38 pazsan Exp $
$Id: model,v 1.4 1995-09-06 21:00:25 pazsan Exp $
Copyright 1992 by the ANSI figForth Development Group
This file describes the implementation model of ANSI figForth. The things
......
......@@ -779,7 +779,7 @@ n=system(cstr(c_addr,u,1)); /* ~ expansion on first part of string? */
getenv c_addr1 u1 -- c_addr2 u2 new
c_addr2 = getenv(cstr(c_addr1,u1,1));
u2=strlen(c_addr2);
u2 = (c_addr2 == NULL ? 0 : strlen(c_addr2));
popen c_addr u n -- wfileid own
static char* mode[2]={"r","w"}; /* !! should we use FAM here? */
......@@ -793,7 +793,7 @@ struct timeval time1;
struct timezone zone1;
struct tm *ltime;
gettimeofday(&time1,&zone1);
ltime=localtime(&time1.tv_sec);
ltime=localtime((time_t *)&time1.tv_sec);
nyear =ltime->tm_year+1900;
nmonth=ltime->tm_mon+1;
nday =ltime->tm_mday;
......@@ -924,14 +924,14 @@ wior = IOR(fclose((FILE *)wfileid)==EOF);
open-file c_addr u ntype -- w2 wior file open_file
w2 = (Cell)fopen(tilde_cstr(c_addr, u, 1), fileattr[ntype]);
wior = IOR(w2 == NULL);
wior = IOR(w2 == 0);
create-file c_addr u ntype -- w2 wior file create_file
Cell fd;
fd = open(tilde_cstr(c_addr, u, 1), O_CREAT|O_RDWR|O_TRUNC, 0666);
if (fd != -1) {
w2 = (Cell)fdopen(fd, fileattr[ntype]);
wior = IOR(w2==NULL);
wior = IOR(w2 == 0);
} else {
w2 = 0;
wior = IOR(1);
......@@ -1143,7 +1143,7 @@ represent r c_addr u -- n f1 f2 float
char *sig;
Cell flag;
Cell decpt;
sig=ecvt(r, u, &decpt, &flag);
sig=ecvt(r, u, (int *)&decpt, (int *)&flag);
n=(r==0 ? 1 : decpt);
f1=FLAG(flag!=0);
f2=FLAG(isdigit(sig[0])!=0);
......
<
#! /usr/stud/paysan/bin/forth
\ startup file
warnings off
\ include float.fs
\ include search-order.fs
include glocals.fs
include environ.fs
\ include toolsext.fs
include wordinfo.fs
include vt100.fs
\ include colorize.fs
include see.fs
include bufio.fs
include debug.fs
include history.fs
include doskey.fs
\ include vt100key.fs
0 Value $?
: sh '# parse cr system to $? ;
warnings on
\ startup file
warnings off
\ include float.fs
\ include search-order.fs
include glocals.fs
include environ.fs
\ include toolsext.fs
include wordinfo.fs
include vt100.fs
\ include colorize.fs
include see.fs
include bufio.fs
include debug.fs
include history.fs
include doskey.fs
\ include vt100key.fs
require debugging.fs
require assert.fs
require blocks.fs
0 Value $?
: sh '# parse cr system to $? ;
\ define the environmental queries for all the loaded wordsets
\ since the blocks wordset is loaded in a single file, its queries
\ are defined there
\ queries for other things than presence of a wordset are answered
\ in environ.fs
get-current environment-wordlist set-current
true constant double
true constant double-ext
true constant exception
true constant exception-ext
true constant facility
\ !! facility-ext
true constant file
true constant file-ext
true constant floating
true constant floating-ext
true constant locals
true constant locals-ext
true constant memory-alloc