[gforth] / gforth / kernel / basics.fs  

gforth: gforth/kernel/basics.fs

Diff for /gforth/kernel/basics.fs between version 1.5 and 1.11

version 1.5, Sat Sep 13 12:05:51 1997 UTC version 1.11, Fri Feb 5 16:08:16 1999 UTC
Line 1 
Line 1 
 \ kernel.fs    GForth kernel                        17dec92py  \ kernel.fs    GForth kernel                        17dec92py
   
 \ Copyright (C) 1995 Free Software Foundation, Inc.  \ Copyright (C) 1995,1998 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 35 
Line 35 
   
 \ !! this is machine-dependent, but works on all but the strangest machines  \ !! this is machine-dependent, but works on all but the strangest machines
   
 : maxaligned ( addr -- f-addr ) \ float  : maxaligned ( addr -- f-addr ) \ gforth
     [ /maxalign 1 - ] Literal + [ 0 /maxalign - ] Literal and ;      [ /maxalign 1 - ] Literal + [ 0 /maxalign - ] Literal and ;
 \ !! machine-dependent and won't work if "0 >body" <> "0 >body maxaligned"  \ !! machine-dependent and won't work if "0 >body" <> "0 >body maxaligned"
 ' maxaligned Alias cfaligned ( addr1 -- addr2 ) \ gforth  ' maxaligned Alias cfaligned ( addr1 -- addr2 ) \ gforth
Line 141 
Line 141 
 : accumulate ( +d0 addr digit - +d1 addr )  : accumulate ( +d0 addr digit - +d1 addr )
   swap >r swap  base @  um* drop rot  base @  um* d+ r> ;    swap >r swap  base @  um* drop rot  base @  um* d+ r> ;
   
 : >number ( d addr count -- d addr count ) \ core  : >number ( d1 addr1 count1 -- d2 addr2 count2 ) \ core
     0      0
     ?DO      ?DO
         count digit?          count digit?
Line 180 
Line 180 
 ' noop IS 'catch  ' noop IS 'catch
 ' noop IS 'throw  ' noop IS 'throw
   
   Defer store-backtrace
   ' noop IS store-backtrace
   
 : catch ( x1 .. xn xt -- y1 .. ym 0 / z1 .. zn error ) \ exception  : catch ( x1 .. xn xt -- y1 .. ym 0 / z1 .. zn error ) \ exception
     'catch      'catch
     sp@ >r      sp@ >r
Line 191 
Line 194 
 [ [THEN] ]  [ [THEN] ]
     handler @ >r      handler @ >r
     rp@ handler !      rp@ handler !
       backtrace-empty on
     execute      execute
     r> handler ! rdrop      r> handler ! rdrop
 [ has? floating [IF] ]  [ has? floating [IF] ]
Line 203 
Line 207 
   
 : throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception  : throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception
     ?DUP IF      ?DUP IF
         [ has? header [IF] here 9 cells ! [THEN] ] ] \ entry point for signal handler          [ has? header [IF] here 9 cells ! [THEN] ] \ entry point for signal handler
           store-backtrace
 [ has? interpreter [IF] ]  [ has? interpreter [IF] ]
         handler @ dup 0= IF          handler @ dup 0= IF
 [ has? os [IF] ]  [ has? os [IF] ]
Line 230 
Line 235 
 : bounce ( y1 .. ym error/0 -- y1 .. ym error / y1 .. ym ) \ gforth  : bounce ( y1 .. ym error/0 -- y1 .. ym error / y1 .. ym ) \ gforth
 \ a throw without data or fp stack restauration  \ a throw without data or fp stack restauration
   ?DUP IF    ?DUP IF
         store-backtrace
       handler @ rp!        handler @ rp!
       r> handler !        r> handler !
 [ has? glocals [IF] ]  [ has? glocals [IF] ]
Line 251 
Line 257 
     THEN      THEN
     rdrop ;      rdrop ;
   
   : abort ( ?? -- ?? ) \ core,exception-ext
       -1 throw ;
   
 \ ?stack                                               23feb93py  \ ?stack                                               23feb93py
   
 : ?stack ( ?? -- ?? ) \ gforth  : ?stack ( ?? -- ?? ) \ gforth
Line 263 
Line 272 
   
 \ DEPTH                                                 9may93jaw  \ DEPTH                                                 9may93jaw
   
 : depth ( -- +n ) \ core  : depth ( -- +n ) \ core depth
       \G +n is the number of values that were on the data stack before
       \G +n itself was placed on the stack.
     sp@ sp0 @ swap - cell / ;      sp@ sp0 @ swap - cell / ;
 : clearstack ( ... -- )  
   : clearstack ( ... -- ) \ gforth clear-stack
       \G remove and discard all/any items from the data stack.
     sp0 @ sp! ;      sp0 @ sp! ;
   
 \ Strings                                                22feb93py  \ Strings                                                22feb93py
Line 285 
Line 298 
 \ HEX DECIMAL                                           2may93jaw  \ HEX DECIMAL                                           2may93jaw
   
 : decimal ( -- ) \ core  : decimal ( -- ) \ core
       \G Set the numeric conversion radix (the value of @code{BASE}) to 10
       \G (decimal).
     a base ! ;      a base ! ;
 : hex ( -- ) \ core-ext  : hex ( -- ) \ core-ext
       \G Set the numeric conversion radix (the value of @code{BASE}) to 16
       \G (hexadecimal).
     10 base ! ;      10 base ! ;
   

Generate output suitable for use with a patch program
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.11
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help