[gforth] / gforth / Attic / primitives  

gforth: gforth/Attic/primitives

Diff for /gforth/Attic/primitives between version 1.5 and 1.6

version 1.5, Thu May 5 17:05:37 1994 UTC version 1.6, Sat May 7 14:56:03 1994 UTC
Line 1 
Line 1 
 /*  \ Copyright 1992 by the ANSI figForth Development Group
 $Id$  \
 Copyright 1992 by the ANSI figForth Development Group  \ WARNING: This file is processed by m4. Make sure your identifiers
   \ don't collide with m4's (e.g. by undefining them).
 WARNING: This file is processed by m4. Make sure your identifiers  \
 don't collide with m4's (e.g. by undefining them).  \ This file contains instructions in the following format:
   \
 This file contains instructions in the following format:  \ forth name    stack effect    category        [pronounciation]
   \ [""glossary entry""]
 forth name      stack effect    category        [pronounciation]  \ C code
 [""glossary entry""]  \ [:
 C code  \ Forth code]
 [:  \
 Forth code]  \ The pronounciataion is also used for forming C names.
   \
 The pronounciataion is also used for forming C names.  \ These informations are automagically translated into C-code for the
   \ interpreter and into some other files. The forth name of a word is
 These informations are automagically translated into C-code for the  \ automatically turned into upper case. I hope that your C compiler has
 interpreter and into some other files. The forth name of a word is  \ decent optimization, otherwise the automatically generated code will
 automatically turned into upper case. I hope that your C compiler has  \ be somewhat slow. The Forth version of the code is included for manual
 decent optimization, otherwise the automatically generated code will  \ compilers, so they will need to compile only the important words.
 be somewhat slow. The Forth version of the code is included for manual  \
 compilers, so they will need to compile only the important words.  \ Note that stack pointer adjustment is performed according to stack
   \ effect by automatically generated code and NEXT is automatically
 Note that stack pointer adjustment is performed according to stack  \ appended to the C code. Also, you can use the names in the stack
 effect by automatically generated code and NEXT is automatically  \ effect in the C code. Stack access is automatic. One exception: if
 appended to the C code. Also, you can use the names in the stack  \ your code does not fall through, the results are not stored into the
 effect in the C code. Stack access is automatic. One exception: if  \ stack. Use different names on both sides of the '--', if you change a
 your code does not fall through, the results are not stored into the  \ value (some stores to the stack are optimized away).
 stack. Use different names on both sides of the '--', if you change a  \
 value (some stores to the stack are optimized away).  \ The stack variables have the following types:
   \ name matches  type
 The stack variables have the following types:  \ f.*           Bool
 name matches    type  \ c.*           Char
 f.*             Bool  \ [nw].*                Cell
 c.*             Char  \ u.*           UCell
 [nw].*          Cell  \ d.*           DCell
 u.*             UCell  \ ud.*          UDCell
 d.*             DCell  \ r.*           Float
 ud.*            UDCell  \ a_.*          Cell *
 r.*             Float  \ c_.*          Char *
 a_.*            Cell *  \ f_.*          Float *
 c_.*            Char *  \ df_.*         DFloat *
 f_.*            Float *  \ sf_.*         SFloat *
 df_.*           DFloat *  \ xt.*          XT
 sf_.*           SFloat *  \ wid.*         WID
 xt.*            XT  \ f83name.*     F83Name *
 wid.*           WID  \
 f83name.*       F83Name *  \ In addition the following names can be used:
   \ ip    the instruction pointer
 In addition the following names can be used:  \ sp    the data stack pointer
 ip      the instruction pointer  \ rp    the parameter stack pointer
 sp      the data stack pointer  \ NEXT  executes NEXT
 rp      the parameter stack pointer  \ cfa
 NEXT    executes NEXT  \ NEXT1 executes NEXT1
 cfa  \ FLAG(x)       makes a Forth flag from a C flag
 NEXT1   executes NEXT1  \
 FLAG(x) makes a Forth flag from a C flag  \ Percentages in comments are from Koopmans book: average/maximum use
   \ (taken from four, not very representattive benchmarks)
 Percentages in comments are from Koopmans book: average/maximum use  \
 (taken from four, not very representattive benchmarks)  \ To do:
   \ make sensible error returns for file words
 To do:  \
 make sensible error returns for file words  \ throw execute, cfa and NEXT1 out?
   \ macroize *ip, ip++, *ip++ (pipelining)?
 throw execute, cfa and NEXT1 out?  
 macroize *ip, ip++, *ip++ (pipelining)?  
 */  
   
 /* these m4 macros would collide with identifiers */  \ these m4 macros would collide with identifiers
 undefine(`index')  undefine(`index')
 undefine(`shift')  undefine(`shift')
   
Line 77 
Line 74 
 lit     -- w            fig  lit     -- w            fig
 w = (Cell)*ip++;  w = (Cell)*ip++;
   
 /* no clit today */  
   
 execute         xt --           core,fig  execute         xt --           core,fig
 cfa = xt;  cfa = xt;
 IF_TOS(TOS = sp[0]);  IF_TOS(TOS = sp[0]);
Line 183 
Line 178 
 j       -- n            core  j       -- n            core
 n = rp[2];  n = rp[2];
   
 /* digit is high-level: 0/0% */  \ digit is high-level: 0/0%
   
 emit    c --            fig  emit    c --            fig
 putchar(c);  putchar(c);
Line 203 
Line 198 
   
 move    c_from c_to ucount --           core  move    c_from c_to ucount --           core
 memmove(c_to,c_from,ucount);  memmove(c_to,c_from,ucount);
 /* make an ifdef for bsd and others? */  /* make an Ifdef for bsd and others? */
   
 cmove   c_from c_to u --        string  cmove   c_from c_to u --        string
 while (u-- > 0)  while (u-- > 0)
Line 412 
Line 407 
 lshift  u1 n -- u2              core  lshift  u1 n -- u2              core
   u2 = u1<<n;    u2 = u1<<n;
   
 /* comparisons(prefix, args, prefix, arg1, arg2, wordsets...) */  \ comparisons(prefix, args, prefix, arg1, arg2, wordsets...)
 define(comparisons,  define(comparisons,
 $1=     $2 -- f         $6      $3equals  $1=     $2 -- f         $6      $3equals
 f = FLAG($4==$5);  f = FLAG($4==$5);
Line 529 
Line 524 
   
 2rot    w1 w2 w3 w4 w5 w6 -- w3 w4 w5 w6 w1 w2  double  two_rote  2rot    w1 w2 w3 w4 w5 w6 -- w3 w4 w5 w6 w1 w2  double  two_rote
   
 /* toggle is high-level: 0.11/0.42% */  \ toggle is high-level: 0.11/0.42%
   
 @       a_addr -- w             fig     fetch  @       a_addr -- w             fig     fetch
 w = *a_addr;  w = *a_addr;
Line 616 
Line 611 
   
 allocate        u -- a_addr wior        memory  allocate        u -- a_addr wior        memory
 a_addr = (Cell *)malloc(u);  a_addr = (Cell *)malloc(u);
 wior = a_addr==NULL;    /* !! define a return code */  wior = a_addr==NULL;    /* !! Define a return code */
   
 free            a_addr -- wior          memory  free            a_addr -- wior          memory
 free(a_addr);  free(a_addr);
Line 624 
Line 619 
   
 resize          a_addr1 u -- a_addr2 wior       memory  resize          a_addr1 u -- a_addr2 wior       memory
 a_addr2 = realloc(a_addr1, u);  a_addr2 = realloc(a_addr1, u);
 wior = a_addr2==NULL;   /* !! define a return code */  wior = a_addr2==NULL;   /* !! Define a return code */
   
 (f83find)       c_addr u f83name1 -- f83name2   new     paren_f83find  (f83find)       c_addr u f83name1 -- f83name2   new     paren_f83find
 for (; f83name1 != NULL; f83name1 = f83name1->next)  for (; f83name1 != NULL; f83name1 = f83name1->next)
Line 910 
Line 905 
 ftan            r1 -- r2        float-ext  ftan            r1 -- r2        float-ext
 r2 = tan(r1);  r2 = tan(r1);
   
 /* The following words access machine/OS/installation-dependent ANSI  \ The following words access machine/OS/installation-dependent ANSI
    figForth internals */  \   figForth internals
 /* !! how about environmental queries DIRECT-THREADED,  \ !! how about environmental queries DIRECT-THREADED,
    INDIRECT-THREADED, TOS-CACHED, FTOS-CACHED, CODEFIELD-DOES */  \   INDIRECT-THREADED, TOS-CACHED, FTOS-CACHED, CODEFIELD-DOES */
   
 >body           xt -- a_addr    core    to_body  >body           xt -- a_addr    core    to_body
 a_addr = PFA(xt);  a_addr = PFA(xt);
Line 956 
Line 951 
 toupper c1 -- c2        new  toupper c1 -- c2        new
 c2 = toupper(c1);  c2 = toupper(c1);
   
 /* local variable implementation primitives */  \ local variable implementation primitives
 @local#         -- w    new     fetch_local_number  @local#         -- w    new     fetch_local_number
 w = *(Cell *)(lp+(int)(*ip++));  w = *(Cell *)(lp+(int)(*ip++));
   

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help