Changeset 510

Timestamp:

02/10/08 23:53:46 (8 months ago)

Author:

krobillard

Message:

'loop is now an opcode and can act as loop.to for integers.
File port! read now handles optional limit.
console.out now handles binary!.
Can now 'make an int! from first 4 bytes of a binary!
Added ur_initDecimal macro.
Added 'fcalc.
Removed word inc/dec.

Location:

trunk/thune

Files:

• boot.c (modified) (2 diffs)
• config.t (modified) (1 diff)
• doc/UserManual (modified) (3 diffs)
• doc/thune.vim (modified) (1 diff)
• fcalc.c (added)
• files.c (modified) (3 diffs)
• gc.c (modified) (1 diff)
• gl/gx_atoms.h (modified) (1 diff)
• internal.h (modified) (5 diffs)
• make.c (modified) (1 diff)
• math.c (modified) (2 diffs)
• mkboot.t (modified) (2 diffs)
• net.c (modified) (2 diffs)
• project.r (modified) (1 diff)
• read_config.r (modified) (1 diff)
• scripts/mandel.t (modified) (1 diff)
• scripts/nsieve.t (modified) (2 diffs)
• stdio.c (modified) (1 diff)
• tests/working/inc.good (modified) (1 diff)
• tests/working/inc.t (modified) (2 diffs)
• thune.c (modified) (7 diffs)
• urlan.c (modified) (1 diff)
• urlan.h (modified) (2 diffs)
• urlan_atoms.h (modified) (1 diff)

trunk/thune/boot.c

@@ -36 +36 @@
   "  opcode! 31 'verify  make :verify\n"
   "  opcode! 32 'forever make :forever\n"
+  "  opcode! 33 'loop    make :loop\n"
   "  int!/decimal! :number!\n"
   "  word!/set-word!/get-word!/lit-word! :any-word!\n"
@@ -65 +66 @@
   "]\n"
   "'loop proc :while  ;(block cond -- )\n"
-  "[\n"
-  "  int! verify\n"
-  "  [dup zero? ift break over do dec] forever\n"
-  "  drop drop\n"
-  "]\n"
-  "'loop proc :loop   ;(block count -- )\n"
   "[body  n number!  limit number!] [\n"
   "  n\n"

trunk/thune/config.t

@@ -4 +4 @@
 [x] trig     "Include trigonometric math calls"
 [x] math3d   "Include vector & matrix math calls"
-             enable trig
+             enable [trig fcalc]
 [x] macros   "Reader macros"
 [x] net      "UDP socket port"
 [x] dataflow "Component! datatype for dataflow programming"
+[X] fcalc    "Floating point calculator"
 
 [ ] threads  "CPU Threads"

trunk/thune/doc/UserManual

@@ -364 +364 @@
 either    (logic t-val f-val -- )    Evaluate either t-val or f-val.
 forever   (block -- )                Evaluate block until exception thrown.
+loop_     (block n -- )              Repeat block **n** times.
+loop_     (block n limit -- )        Repeat block **n** to **limit** times.
 iter      (ser body -- )             Iterate over series.
 iter/N    (ser body -- )             Iterate over series with skip.
@@ -393 +395 @@
 each.set  (ser words body -- )       Iterate over series and assign elements.
 while     (body cond -- )            Evaluate body while cond is true.
-loop      (block n -- )              Repeat block **n** times.
 loop.to   (block n limit -- )        Repeat block **n** to **limit** times.
 proc.env  (env body -- proc)         Create procedure with private context.
@@ -632 +633 @@
 
 
+loop
+----
+::
+
+    (block int -- )
+    (block int int -- )
+
+The first form simply evalutes the body block a given number of times.
+
+The second form pushes the counter value onto the stack before each loop,
+and stops when the limit is reached.
+
+Example::
+
+    )> [.] -2 2 loop
+    -2
+    -1
+    0
+    1
+
 
 Data Manipulation Functions

trunk/thune/doc/thune.vim

@@ -117 +117 @@
 syn keyword     thuneType       unset! datatype! none! logic! word! set-word!
 syn keyword     thuneType       get-word! lit-word! select! set-select! opcode!
-syn keyword     thuneType       char! int! int64! decimal! coord! vec3!
+syn keyword     thuneType       char! int! bignum! decimal! coord! vec3! vector!
 syn keyword     thuneType       binary! string!  block! paren! path! setpath!
-syn keyword     thuneType       slice! list! context!
+syn keyword     thuneType       list! context! port!
 syn keyword     thuneType       function! call! date! time! bitset! error! code!
 "syn keyword     thuneTypeFunction type?

trunk/thune/files.c

@@ -317 +317 @@
         UPortDevice* dev = _devicePtr( ut, ur_s_prev(tos) );
         if( dev )
-            dev->read( ut, tos /*, part*/ );
+            dev->read( ut, tos, part );
         return;
     }
@@ -1099 +1099 @@
 
 
-// (port buf len -- port buf)
-UR_CALL( _fileRead )
+// (port buf -- port buf)
+void _fileRead( UThread* ut, UCell* tos, int part )
 {
     UBlock* blk;
@@ -1122 +1122 @@
 
 
-        len = READ_BUF_SIZE;
+        len = part ? part : READ_BUF_SIZE;
 
         if( ur_is(tos, UT_BINARY) || ur_is(tos, UT_STRING) )

trunk/thune/gc.c

@@ -394 +394 @@
                 break;
 
+            case CC_LOOP:
+                --it;
+                SET_BIT_BLOCK_L( it->cell.series.n )
+                --it;
+                break;
+
             case CC_REDUCE:
                 SET_BIT_BLOCK_L( it->reduce.n )

trunk/thune/gl/gx_atoms.h

@@ -1 +1 @@
 // This file is automatically generated - do not edit.
 
-#define UR_ATOM_DRAW_LIST_OPCODES               323
-#define UR_ATOM_WIDTH           324
-#define UR_ATOM_HEIGHT          325
-#define UR_ATOM_AREA            326
-#define UR_ATOM_RECT            327
-#define UR_ATOM_RASTER          328
-#define UR_ATOM_TEXTURE         329
-#define UR_ATOM_ELEM            330
-#define UR_ATOM_CLOSE           184
-#define UR_ATOM_FOCUS           331
-#define UR_ATOM_RESIZE          332
-#define UR_ATOM_KEY_DOWN                333
-#define UR_ATOM_KEY_UP          334
-#define UR_ATOM_MOUSE_MOVE              335
-#define UR_ATOM_MOUSE_UP                336
-#define UR_ATOM_MOUSE_DOWN              337
-#define UR_ATOM_MOUSE_WHEEL             338
-#define UR_ATOM_AMBIENT         339
-#define UR_ATOM_DIFFUSE         340
-#define UR_ATOM_SPECULAR                341
-#define UR_ATOM_POS             342
-#define UR_ATOM_SHADER          343
-#define UR_ATOM_VERTEX          344
-#define UR_ATOM_FRAGMENT                345
-#define UR_ATOM_DEFAULT         346
-#define UR_ATOM_WAIT            135
-#define UR_ATOM_RGB             347
-#define UR_ATOM_RGBA            348
-#define UR_ATOM_DEPTH           349
-#define UR_ATOM_CLAMP           350
-#define UR_ATOM_REPEAT          351
-#define UR_ATOM_NEAREST         352
-#define UR_ATOM_LINEAR          353
-#define UR_ATOM_MIN             354
-#define UR_ATOM_MAG             355
-#define UR_ATOM_MIPMAP          356
-#define UR_ATOM_GRAY            357
-#define UR_ATOM_RGB             347
-#define UR_ATOM_RGBA            348
-#define UR_ATOM_ON              267
-#define UR_ATOM_OFF             269
-#define UR_ATOM_ADD             203
-#define UR_ATOM_BURN            358
-#define UR_ATOM_COLOR           359
-#define UR_ATOM_TRANS           360
-#define UR_ATOM_SPRITE          361
-#define UR_ATOM_ONCE            362
-#define UR_ATOM_PING_PONG               363
-#define UR_ATOM_PONG            364
+#define UR_ATOM_DRAW_LIST_OPCODES               326
+#define UR_ATOM_WIDTH           327
+#define UR_ATOM_HEIGHT          328
+#define UR_ATOM_AREA            329
+#define UR_ATOM_RECT            330
+#define UR_ATOM_RASTER          331
+#define UR_ATOM_TEXTURE         332
+#define UR_ATOM_ELEM            333
+#define UR_ATOM_CLOSE           186
+#define UR_ATOM_FOCUS           334
+#define UR_ATOM_RESIZE          335
+#define UR_ATOM_KEY_DOWN                336
+#define UR_ATOM_KEY_UP          337
+#define UR_ATOM_MOUSE_MOVE              338
+#define UR_ATOM_MOUSE_UP                339
+#define UR_ATOM_MOUSE_DOWN              340
+#define UR_ATOM_MOUSE_WHEEL             341
+#define UR_ATOM_AMBIENT         342
+#define UR_ATOM_DIFFUSE         343
+#define UR_ATOM_SPECULAR                344
+#define UR_ATOM_POS             345
+#define UR_ATOM_SHADER          346
+#define UR_ATOM_VERTEX          347
+#define UR_ATOM_FRAGMENT                348
+#define UR_ATOM_DEFAULT         349
+#define UR_ATOM_WAIT            137
+#define UR_ATOM_RGB             350
+#define UR_ATOM_RGBA            351
+#define UR_ATOM_DEPTH           352
+#define UR_ATOM_CLAMP           353
+#define UR_ATOM_REPEAT          354
+#define UR_ATOM_NEAREST         355
+#define UR_ATOM_LINEAR          356
+#define UR_ATOM_MIN             357
+#define UR_ATOM_MAG             358
+#define UR_ATOM_MIPMAP          359
+#define UR_ATOM_GRAY            360
+#define UR_ATOM_RGB             350
+#define UR_ATOM_RGBA            351
+#define UR_ATOM_ON              270
+#define UR_ATOM_OFF             272
+#define UR_ATOM_ADD             205
+#define UR_ATOM_BURN            361
+#define UR_ATOM_COLOR           362
+#define UR_ATOM_TRANS           363
+#define UR_ATOM_SPRITE          364
+#define UR_ATOM_ONCE            365
+#define UR_ATOM_PING_PONG               366
+#define UR_ATOM_PONG            367

trunk/thune/internal.h

@@ -108 +108 @@
 typedef struct
 {
+    int16_t  code;
+    uint16_t flags;
+    int32_t  n;
+    int32_t  it;
+}
+CELoop;
+
+typedef struct
+{
     int16_t code;
     int16_t locals;
@@ -118 +127 @@
 typedef union
 {
-    char   bytes[16];
+    UCell  cell;
     CEId   id;
     CECell cp;
     CEEnd  end;
     CEEval eval;
+    CELoop loop;
     CECell iter;
     CECell reduce;
@@ -134 +144 @@
 #define CC_EVAL             2
 #define CC_EVAL_RUNNING     3
-#define CC_FOREVER          4
-#define CC_REDUCE           5
-#define CC_ITER             6
-#define CC_EACH             7
-#define CC_CATCH            8
-#define CC_TERM             9
-#define CC_END              10
+#define CC_REDUCE           4
+#define CC_FOREVER          5
+#define CC_LOOP             6
+#define CC_ITER             7
+#define CC_EACH             8
+#define CC_CATCH            9
+#define CC_TERM             10
+#define CC_END              11
 #define CC_COUNT            (CC_END+1)
 
@@ -147 +158 @@
 #define CC_LEN_EVAL         1
 #define CC_LEN_FOREVER      1
+#define CC_LEN_LOOP         2
 #define CC_LEN_REDUCE       1
 #define CC_LEN_ITER         2
@@ -210 +222 @@
 #define OP_VERIFY           31
 #define OP_FOREVER          32
-#define OP_REDUCE           33
-#define OP_DO_FUNC          34
+#define OP_LOOP             33
+#define OP_REDUCE           34
+#define OP_DO_FUNC          35
 //#define OP_END              255
 

trunk/thune/make.c

@@ -1582 +1582 @@
                         n = ur_stringToInt( spA, spB, 0 );
                     }
+                }
+            }
+            else if( ur_binarySlice(ut, tos, &spA, &spB) )
+            {
+                if( (spB - spA) > 3 )
+                {
+                    // Load 32-bit big-endian number.
+                    uint8_t* bp = (uint8_t*) spA;
+                    n = (bp[0] << 24) | (bp[1] << 16) |
+                        (bp[2] <<  8) | bp[3];
                 }
             }

trunk/thune/math.c

@@ -977 +977 @@
 #include "math3d.c"
 #endif
+#ifdef UR_CONFIG_FCALC
+#include "fcalc.c"
+#endif
 
 
@@ -1018 +1021 @@
     { uc_cross,        "cross" },
     { uc_normalize,    "normalize" },
-    { uc_set_stride,   "set-stride" }
+    { uc_set_stride,   "set-stride" },
+#endif
+
+#ifdef UR_CONFIG_FCALC
+    { uc_fcalc,         "fcalc" },
 #endif
 };

trunk/thune/mkboot.t

@@ -37 +37 @@
   opcode! 31 'verify  make :verify
   opcode! 32 'forever make :forever
+  opcode! 33 'loop    make :loop
 
   int!/decimal! :number!
@@ -72 +73 @@
 ]
 'loop proc :while  ;(block cond -- )
-
-[
-  int! verify
-  [dup zero? ift break over do dec] forever
-  drop drop
-]
-'loop proc :loop   ;(block count -- )
 
 [body  n number!  limit number!] [

trunk/thune/net.c

@@ -326 +326 @@
 
 // (port buf -- port buf)
-UR_CALL( _netRead )
+void _netRead( UThread* ut, UCell* tos, int part )
 {
     UBinary* bin;
@@ -333 +333 @@
     UCell* val;
     UCell* pc = ur_s_prev(tos);
+
+    (void) part;
 
     blk = ur_blockPtr( pc->port.valBlk );

trunk/thune/project.r

@@ -14 +14 @@
 default [
     warn
-    debug
-    ;release
+   ;debug
+    release
 
     cflags {-DLANG_THUNE}

trunk/thune/read_config.r

@@ -14 +14 @@
        dataflow:
        dt-code:
+       fcalc:
        net:
        uds:

trunk/thune/scripts/mandel.t

@@ -31 +31 @@
             40.0 div  y 40.0 div  mandelbrot '*' ' ' either prin
         ]
-        -39 39 loop.to
+        -39 39 loop
     ]
-    -39 39 loop.to
+    -39 39 loop
     eol prin
 ]

trunk/thune/scripts/nsieve.t

@@ -27 +27 @@
         )
     ]
-    2 size loop.to
+    2 size loop
 
     ;count
@@ -62 +62 @@
 int! args/1 make :n
 
-[10000 n rot sub lshift nsieve] 0 3 loop.to
+[10000 n rot sub lshift nsieve] 0 3 loop
 

trunk/thune/stdio.c

@@ -56 +56 @@
             fwrite( it, 1, end - it, stdout );
         }
+    }
+    else if( ur_binarySlice(ut, tos, &it, &end) && it )
+    {
+        fwrite( it, 1, end - it, stdout );
     }
 

trunk/thune/tests/working/inc.good

@@ -3 +3 @@
 2.0
 0.0
-1
-0
-2.0
-1.0

trunk/thune/tests/working/inc.t

@@ -5 +5 @@
 1.0 dec .
 
+/*
 0 :a
 ++ a a .
@@ -12 +13 @@
 ++ a a .
 -- a a .
+*/
 
 .s

trunk/thune/thune.c

@@ -45 +45 @@
             case CC_EVAL:
             case CC_EVAL_RUNNING:
+            case CC_REDUCE:
             case CC_FOREVER:
-            case CC_REDUCE:
                 toc -= CC_LEN_EVAL;
                 break;
 
+            case CC_LOOP:
             case CC_ITER:
             case CC_EACH:
@@ -795 +796 @@
                         goto bad_opcode_type;
                     break;
-
+#if 0
                 case OP_INC_WORD:               // ( -- )
                     if( (pc == end) || (! ur_is(pc, UT_WORD)) )
@@ -841 +842 @@
                     }
                     break;
-
+#endif
                 case OP_VERIFY:     // (val type -- val)
                                     // (v1 v2 t1 t2 -- v1 v2)
@@ -869 +870 @@
                     goto control;
 
+                case OP_LOOP:           // (body n [n2] -- )
+                {
+                    int n0, n1;
+                    int prevInt;
+                    UCell* prev = ur_s_prev(UR_TOS);
+
+                    if( ur_is(prev, UT_INT) )
+                    {
+                        n0 = ur_int(prev);
+                        --prev;
+                        prevInt = 1;
+                    }
+                    else
+                    {
+                        n0 = 0;
+                        prevInt = 0;
+                    }
+
+                    if( ! ur_is(UR_TOS, UT_INT) || ! ur_is(prev, UT_BLOCK) )
+                    {
+                        ur_throwErr( UR_ERR_DATATYPE,
+                                     "loop expected block! int!" );
+                        goto throw_cc;
+                    }
+                    n1 = ur_int(UR_TOS);
+                    UR_S_DROP;
+                    if( prevInt )
+                        UR_S_DROP;
+                    if( n1 > n0 )
+                    {
+                        PUSHC_EVAL( blkN, start, pc );
+                        SET_BLK_PC( UR_TOS->series.n,
+                                    UR_TOS->series.it );
+                        ur_copyCell( ut->toc, *UR_TOS );
+                        UR_C_GROW;
+
+                        UR_TOC->loop.code  = CC_LOOP;
+                        UR_TOC->loop.flags = prevInt;
+                        UR_TOC->loop.n     = n1;
+                        UR_TOC->loop.it    = n0;
+                        UR_C_GROW;
+
+                        if( prevInt )   // Loop body must drop counter.
+                        {
+                            ur_initInt( UR_TOS, n0 );
+                            UR_S_GROW;
+                        }
+                    }
+                    UR_S_DROP;
+                }
+                    break;
+
                 //case OP_END:
                 //    goto finish;
@@ -1070 +1123 @@
             goto control;
 
-        case CC_FOREVER:
-            SET_BLK_PC( UR_TOC->eval.n, UR_TOC->eval.it );
-            UR_C_GROW;
-            goto execute;
-
         case CC_REDUCE:
         {
@@ -1097 +1145 @@
             ur_setSeries(ntos, rblkN, 0);
         }
+            goto control;
+
+        case CC_FOREVER:
+            SET_BLK_PC( UR_TOC->eval.n, UR_TOC->eval.it );
+            UR_C_GROW;
+            goto execute;
+
+        case CC_LOOP:
+            if( ++UR_TOC->loop.it < UR_TOC->loop.n )
+            {
+                UCell* ser = ut->toc - 1;
+                if( UR_TOC->loop.flags )
+                {
+                    UR_S_GROW;      // Loop code must drop TOS.
+                    ur_initInt( UR_TOS, UR_TOC->loop.it );
+                }
+                SET_BLK_PC( ser->series.n, ser->series.it );
+                UR_C_GROW;
+                goto execute;
+            }