version 1.49, 1995/11/30 18:01:48
|
version 1.50, 1996/01/07 17:22:12
|
Line 142 DOES> ( n -- ) + c@ ;
|
Line 142 DOES> ( n -- ) + c@ ;
|
|
|
\ name> found 17dec92py |
\ name> found 17dec92py |
|
|
: (name>) ( nfa -- cfa ) |
: (name>) ( nfa+cell -- cfa ) |
count $1F and + cfaligned ; |
1 cells - name>string + cfaligned ; |
: name> ( nfa -- cfa ) \ gforth |
: name> ( nfa -- cfa ) \ gforth |
cell+ |
cell+ |
dup (name>) swap c@ $80 and 0= IF @ THEN ; |
dup (name>) swap c@ $80 and 0= IF @ THEN ; |
Line 158 DOES> ( n -- ) + c@ ;
|
Line 158 DOES> ( n -- ) + c@ ;
|
|
|
\ : (find) ( addr count nfa1 -- nfa2 / false ) |
\ : (find) ( addr count nfa1 -- nfa2 / false ) |
\ BEGIN dup WHILE dup >r |
\ BEGIN dup WHILE dup >r |
\ cell+ count $1F and dup >r 2over r> = |
\ name>string dup >r 2over r> = |
\ IF -text 0= IF 2drop r> EXIT THEN |
\ IF -text 0= IF 2drop r> EXIT THEN |
\ ELSE 2drop drop THEN r> @ |
\ ELSE 2drop drop THEN r> @ |
\ REPEAT nip nip ; |
\ REPEAT nip nip ; |
Line 1264 G -1 warnings T !
|
Line 1264 G -1 warnings T !
|
0A constant #lf ( -- c ) \ gforth |
0A constant #lf ( -- c ) \ gforth |
|
|
: bell #bell emit ; |
: bell #bell emit ; |
|
: cr ( -- ) \ core |
|
\ emit a newline |
|
#lf ( sic! ) emit ; |
|
|
\ : backspaces 0 ?DO #bs emit LOOP ; |
\ : backspaces 0 ?DO #bs emit LOOP ; |
: >string ( span addr pos1 -- span addr pos1 addr2 len ) |
: >string ( span addr pos1 -- span addr pos1 addr2 len ) |
Line 1326 Defer emit ( c -- ) \ core
|
Line 1329 Defer emit ( c -- ) \ core
|
Defer key ( -- c ) \ core |
Defer key ( -- c ) \ core |
' (key) IS key |
' (key) IS key |
|
|
\ : form ( -- rows cols ) &24 &80 ; |
|
\ form should be implemented using TERMCAPS or CURSES |
|
\ : rows form drop ; |
|
\ : cols form nip ; |
|
|
|
\ Query 07apr93py |
\ Query 07apr93py |
|
|
: refill ( -- flag ) \ core-ext,block-ext,file-ext |
: refill ( -- flag ) \ core-ext,block-ext,file-ext |
Line 1681 DEFER DOERROR
|
Line 1679 DEFER DOERROR
|
|
|
\ Cold 13feb93py |
\ Cold 13feb93py |
|
|
\ : .name ( name -- ) cell+ count $1F and type space ; |
\ : .name ( name -- ) name>string type space ; |
\ : words listwords @ |
\ : words listwords @ |
\ BEGIN @ dup WHILE dup .name REPEAT drop ; |
\ BEGIN @ dup WHILE dup .name REPEAT drop ; |
|
|
Line 1761 Defer 'cold ' noop IS 'cold
|
Line 1759 Defer 'cold ' noop IS 'cold
|
cr |
cr |
THEN |
THEN |
false to script? |
false to script? |
." GForth " version-string type ." , Copyright (C) 1994 Free Software Foundation, Inc." cr |
." GForth " version-string type ." , Copyright (C) 1994-1996 Free Software Foundation, Inc." cr |
." GForth comes with ABSOLUTELY NO WARRANTY; for details type `license'" cr |
." GForth comes with ABSOLUTELY NO WARRANTY; for details type `license'" cr |
." Type `bye' to exit" |
." Type `bye' to exit" |
loadline off quit ; |
loadline off quit ; |