Changeset 468

Timestamp:

09/03/07 02:29:05 (13 months ago)

Author:

krobillard

Message:

Squashed commit of master.

Location:

trunk/thune

Files:

• boot.c (modified) (1 diff)
• console.c (modified) (12 diffs)
• doc/UserManual (modified) (1 diff)
• doc/thune.vim (modified) (4 diffs)
• env.h (modified) (1 diff)
• gl/scripts/view.t (modified) (3 diffs)
• mkboot.t (modified) (1 diff)
• scripts/unicode_db.t (added)
• series.c (modified) (3 diffs)
• tests/working/utf8.good (modified) (1 diff)
• tests/working/utf8.t (modified) (1 diff)
• thune.c (modified) (1 diff)
• urlan.c (modified) (10 diffs)
• urlan.h (modified) (2 diffs)

trunk/thune/boot.c

@@ -124 +124 @@
   "proc :parse.some  ;(data rules -- )\n"
   "[\n"
-  "  0,0,1 :version\n"
+  "  0,0,3 :version\n"
   "  none :os\n"
   "  [] :devices\n"

trunk/thune/console.c

@@ -21 +21 @@
 #include <assert.h>
 #include <stdio.h>
-#include "env.h"
+#include "urlan.h"
 
 
@@ -113 +113 @@
 int main( int argc, char** argv )
 {
-    UrlanEnv env;
+    UrlanEnv* env;
+    UThread* ut;
     char cmd[ 2048 ];
     int fileN = 0;
@@ -119 +120 @@
 
 
-    if( ur_startup( &env, CUSTOM_DT, CUSTOM_DT_COUNT ) != UR_EVAL_OK )
-    {
-        printf( "ur_startup failed\n" );
+    env = ur_makeEnv( CUSTOM_DT, CUSTOM_DT_COUNT );
+    if( ! env )
+    {
+        printf( "ur_makeEnv failed\n" );
         return -1;
     }
 
 #ifdef THUNE_GL
-    if( gx_startup( &env ) != UR_EVAL_OK )
+    if( gx_startup( env ) != UR_EVAL_OK )
     {
         printf( "gx_startup failed\n" );
@@ -133 +135 @@
 #endif
 
-    ur_freezeEnv( env.threads, 128, 256 );
+    ur_freezeEnv( env, 128, 256 );
+    ut = ur_thread( env );
 
     if( argc > 1 )
@@ -148 +151 @@
                 {
                     case 's':
-                        ur_disable( &env, UR_ENV_SECURE );
+                        ur_disable( env, UR_ENV_SECURE );
                         break;
 
@@ -204 +207 @@
         assert( cmd[ sizeof(cmd) - 1 ] == -1 && "cmd buffer overflow" );
 
-        switch( ur_evalCStr( env.threads, cmd, pos - cmd ) )
+        switch( ur_evalCStr( ut, cmd, pos - cmd ) )
         {
             case UR_EVAL_HALT:
@@ -210 +213 @@
 
             case UR_EVAL_ERROR:
-                reportError( env.threads );
+                reportError( ut );
                 goto prompt;
         }
@@ -243 +246 @@
             else if( cmd[0] != '\n' )
             {
-                switch( ur_evalCStr( env.threads, cmd, -1 ) )
+                switch( ur_evalCStr( ut, cmd, -1 ) )
                 {
                     case UR_EVAL_OK:
@@ -250 +253 @@
                         UString str;
 
-                        val = ur_result( env.threads, 0 );
+                        val = ur_result( ut, 0 );
                         if( ur_is(val, UT_UNSET) ||
                             ur_is(val, UT_CONTEXT) ||
@@ -257 +260 @@
 
                         ur_arrayInit( &str, 1, 0 );
-                        ur_toStrT( env.threads, val, &str, 0 );
+                        ur_toStrT( ut, val, &str, 0 );
                         if( str.ptr.c )
                         {
@@ -284 +287 @@
 
                     case UR_EVAL_ERROR:
-                        reportError( env.threads );
-                        ur_threadReset( env.threads );
+                        reportError( ut );
+                        ur_threadReset( ut );
                         break;
                 }
@@ -295 +298 @@
 
 #ifdef THUNE_GL
-    gx_shutdown( &env );
-#endif
-
-    ur_shutdown( &env );
+    gx_shutdown( env );
+#endif
+
+    ur_freeEnv( env );
 
     return ret;

trunk/thune/doc/UserManual

@@ -523 +523 @@
 random       (max -- n)         Generate random number.
 random       (n 'seed -- )      Seed random number generator.
+zero?        (n -- logic)       True if number is zero.
 ===========  =================  =================
 

trunk/thune/doc/thune.vim

@@ -36 +36 @@
 syn match       thuneGetWord    "\a\k*:"
 syn match       thuneLitWord    "'\a\k*"
-"syn match       thuneWord       "\a\k*"
+syn match       thuneWord       "\a\k*"
 "syn match       thuneWordPath   "[^[:space:]]/[^[:space]]"ms=s+1,me=e-1
 
@@ -100 +100 @@
 "syn keyword     thuneMathFunction  square-root subtract tangent
 " Binary operators
-"syn keyword     thuneBinaryOperator complement and or xor ~
+syn keyword     thuneBinaryOperator complement and or xor
 " Logic operators
 "syn match       thuneLogicOperator "[<>=]=\="
@@ -131 +131 @@
 " Series statements
 "syn keyword     thuneStatement  change clear copy fifth find first format fourth free
-syn keyword     thuneStatement  proc func
+syn keyword     thuneStatement  make proc func
 "head insert last match next parse past
 "syn keyword     thuneStatement  pick remove second select skip sort tail third trim length?
 
 " Context
-"syn keyword     thuneStatement  alias bind use
+syn keyword     thuneStatement  bind infuse
 
 " Object
@@ -184 +184 @@
   HiLink thuneType              Type
 
-" HiLink thuneWord              Identifier
+" HiLink thuneWord              Keyword
   HiLink thuneOpcode    Operator
 " HiLink thuneWordPath  thuneWord

trunk/thune/env.h

@@ -11 +11 @@
 #define UR_EMH_STEP     1
 #define UR_EMH_HALT     2
-
-
-#define UR_ENV_GC           0x01
-#define UR_ENV_SECURE       0x02
 
 

trunk/thune/gl/scripts/view.t

@@ -2 +2 @@
 
 <"scripts/stars.t" load do>
+
+;"scripts/timer_bar.t" load do
 
 0.6 :zoom
@@ -172 +174 @@
 [
     now start-time sub :flare-sh/time
+    ;update-timer-bar
 ]
 proc 'sim-update set
@@ -299 +302 @@
         ;enable/?
         image/trans logo-pos <"image/warpfleetc.png" load.tex.clamp>
+
+        ;shader matte
+        ;call dl-timer-bar
     ]
 ]

trunk/thune/mkboot.t

@@ -144 +144 @@
 
 [
-  0,0,1 :version
+  0,0,3 :version
   none :os
   [] :devices

trunk/thune/series.c

@@ -3197 +3197 @@
 
 
-//#define REF_CASE_PART   a1+1
+void _lowercaseUcs16( uint16_t* it, uint16_t* end )
+{
+    int c;
+    while( it != end )
+    {
+        c = *it;
+        if( (c >= 'A') && (c <= 'Z') )
+            *it = c + 32;
+        else if( (c >= 0x00C0) && (c <= 0x00DE) && (c != 0x00D7) )
+            *it = c + 32;
+        else if( (c >= 0x0391) && (c <= 0x03AB) && (c != 0x03A2) )
+            *it = c + 32;
+        else if( (c >= 0x0410) && (c <= 0x042F) )
+            *it = c + 32;
+        else if( (c >= 0x0531) && (c <= 0x0556) )
+            *it = c + 48;
+        // TODO: Implement full lookup table.
+        ++it;
+    }
+}
+
+void _lowercaseAscii( char* it, char* end )
+{
+    int c;
+    while( it != end )
+    {
+        c = *it;
+        if( (c >= 'A') && (c <= 'Z') )
+            *it = c + ('a' - 'A');
+        ++it;
+    }
+}
+
 
 /*
@@ -3204 +3236 @@
 UR_CALL( uc_lowercase )
 {
+    int len;
+    int part;
+    char* cp;
+    char* end;
+    UString* str;
+
+#ifdef LANG_THUNE
+    if( ur_is(tos, UT_INT) )
+    {
+        UR_S_DROP;
+        part = ur_int(tos);
+        tos = ur_s_prev(tos);
+    }
+    else
+#endif
+    {
+        part = -1;
+    }
+
+    str = ur_stringSlice( ut, tos, &cp, &end );
+    if( str )
+    {
+        if( cp )
+        {
+            if( ur_encoding(tos) == UR_ENC_UTF16 )
+            {
+                uint16_t* cp16  = (uint16_t*) cp;
+                uint16_t* end16 = (uint16_t*) end;
+                if( part > -1 )
+                {
+                    len = end16 - cp16;
+                    if( part < len )
+                        end16 = cp16 + part;
+                }
+                _lowercaseUcs16( cp16, end16 );
+            }
+            else
+            {
+                if( part > -1 )
+                {
+                    len = end - cp;
+                    if( part < len )
+                        end = cp + part;
+                }
+                _lowercaseAscii( cp, end );
+            }
+        }
+    }
+    else
+    {
+        ur_throwErr( UR_ERR_DATATYPE, "lowercase expected string!" );
+    }
+}
+
+
+void _uppercaseUcs16( uint16_t* it, uint16_t* end )
+{
     int c;
-    UString* str = ur_bin(tos);
-    char* cp  = str->ptr.c + tos->series.it;
-    char* end = str->ptr.c + str->used;
-
-    UR_CALL_UNUSED_TH
-#if 0
-    if( orRefineSet(REF_CASE_PART) )
-    {
-        char* pend;
-        UCell* a3 = tos + 2;
-        if( ur_ins(a3) < 0 )
-        {
-            ur_throwErr( 0, "/part less than zero." );
-            return;
-        }
-        pend = cp + ur_int(a3);
-        if( end > pend )
-            end = pend;
-    }
-#endif
-
-    while( cp != end )
-    {
-        c = *cp;
-        if( (c >= 'A') && (c <= 'Z') )
-            *cp = c + ('a' - 'A');
-        ++cp;
+    while( it != end )
+    {
+        c = *it;
+        if( (c >= 'a') && (c <= 'z') )
+            *it = c - 32;
+        else if( (c >= 0x00E0) && (c <= 0x00FE) && (c != 0x00F7) )
+            *it = c - 32;
+        else if( (c >= 0x03B1) && (c <= 0x03CB) && (c != 0x03C2) )
+            *it = c - 32;
+        else if( (c >= 0x0430) && (c <= 0x044F) )
+            *it = c - 32;
+        else if( (c >= 0x0561) && (c <= 0x0586) )
+            *it = c - 48;
+        // TODO: Implement full lookup table.
+        ++it;
+    }
+}
+
+void _uppercaseAscii( char* it, char* end )
+{
+    int c;
+    while( it != end )
+    {
+        c = *it;
+        if( (c >= 'a') && (c <= 'z') )
+            *it = c - ('a' - 'A');
+        ++it;
     }
 }
@@ -3238 +3327 @@
 /*
   (str -- str)
+  (str part -- str)
 */
 UR_CALL( uc_uppercase )
 {
-    int c;
-    UString* str = ur_bin(tos);
-    char* cp  = str->ptr.c + tos->series.it;
-    char* end = str->ptr.c + str->used;
-
-    UR_CALL_UNUSED_TH
-#if 0
-    if( orRefineSet(REF_CASE_PART) )
-    {
-        char* pend;
-        UCell* a3 = tos + 2;
-        if( ur_int(a3) < 0 )
-        {
-            ur_throwErr( 0, "/part less than zero." );
-            return;
-        }
-        pend = cp + ur_int(a3);
-        if( end > pend )
-            end = pend;
-    }
+    int len;
+    int part;
+    char* cp;
+    char* end;
+    UString* str;
+
+#ifdef LANG_THUNE
+    if( ur_is(tos, UT_INT) )
+    {
+        UR_S_DROP;
+        part = ur_int(tos);
+        tos = ur_s_prev(tos);
+    }
+    else
 #endif
-
-    while( cp != end )
-    {
-        c = *cp;
-        if( (c >= 'a') && (c <= 'z') )
-            *cp = c - ('a' - 'A');
-        ++cp;
+    {
+        part = -1;
+    }
+
+    str = ur_stringSlice( ut, tos, &cp, &end );
+    if( str )
+    {
+        if( cp )
+        {
+            if( ur_encoding(tos) == UR_ENC_UTF16 )
+            {
+                uint16_t* cp16  = (uint16_t*) cp;
+                uint16_t* end16 = (uint16_t*) end;
+                if( part > -1 )
+                {
+                    len = end16 - cp16;
+                    if( part < len )
+                        end16 = cp16 + part;
+                }
+                _uppercaseUcs16( cp16, end16 );
+            }
+            else
+            {
+                if( part > -1 )
+                {
+                    len = end - cp;
+                    if( part < len )
+                        end = cp + part;
+                }
+                _uppercaseAscii( cp, end );
+            }
+        }
+    }
+    else
+    {
+        ur_throwErr( UR_ERR_DATATYPE, "uppercase expected string!" );
     }
 }

trunk/thune/tests/working/utf8.good

@@ -9 +9 @@
  юга жОл-был цОтрус? Да, МП фальшОвый экзеЌпляр! ёъ.}
 ]
+{Les naïfs Êgithales hâtifs pondant à  Noël où il gÚle sont sûrs d'être déçus et de voir leurs drÃŽles d'œufs abîmés.}
+{LES NAÏFS ÆGITHALES HÂTIFS PONDANT À NOËL OÙ IL GÈLE SONT SÛRS D'ÊTRE DÉÇUS ET DE VOIR LEURS DRÔLES D'œUFS ABÎMÉS.}
+{les naïfs Êgithales hâtifs pondant à  noël où il gÚle sont sûrs d'être déçus et de voir leurs drÃŽles d'œufs abîmés.}
+{Falsches Üben von Xylophonmusik quÀlt jeden größeren Zwerg.}
+{FALSCHES ÜBEN VON XYLOPHONMUSIK QUÄLT JEDEN GRÖßEREN ZWERG.}
+{falsches ÃŒben von xylophonmusik quÀlt jeden größeren zwerg.}
+"Οεσκεπάζω τηΜ ψÏ
+χοφΞόρα βΎελÏ
+γΌία"
+"ΞΕΣΚΕΠάΖΩ ΀ΗΝ ΚΥΧΟΊΘόΡΑ ΒΔΕΛΥΓΜίΑ"
+"Οεσκεπάζω τηΜ ψÏ
+χοφΞόρα βΎελÏ
+γΌία"
+"SÊvör grét áðan ßví úlpan var ónÜt."
+"SÆVÖR GRÉT ÁÐAN ÞVÍ ÚLPAN VAR ÓNÝT."
+"sÊvör grét áðan ßví úlpan var ónÜt."
+{В чащаÑ
+ юга жОл-был цОтрус? Да, МП фальшОвый экзеЌпляр! ёъ.}
+{В ЧАЩАХ ЮГА ЖИЛ-БЫЛ ЊИТРУС? ДА, НО ЀАЛЬКИВЫЙ ЭКЗЕМПЛЯР! ёЪ.}
+{в чащаÑ
+ юга жОл-был цОтрус? Ўа, МП фальшОвый экзеЌпляр! ёъ.}

trunk/thune/tests/working/utf8.t

@@ -15 +15 @@
  юга жОл-был цОтрус? Да, МП фальшОвый экзеЌпляр! ёъ.}
 ]
-.
+dup .
 
+next
+[first dup . uppercase dup . lowercase .]
+iter/2

trunk/thune/thune.c

@@ -1105 +1105 @@
 
     UR_CALL_OP = 0;
-    
+
 op_throw:
 

trunk/thune/urlan.c

@@ -445 +445 @@
 
 
-int ur_sizeofUrlanEnv()
-{
-    return sizeof(UrlanEnv);
-}
-
-
 UThread* ur_thread( UrlanEnv* env )
 {
@@ -458 +452 @@
 
 /**
-  Initialize UrlanEnv.
+  Create and initialize UrlanEnv.
 
   \param custom       Pointer to array of cutsom datatypes.
@@ -464 +458 @@
   \param customCount  Number of UDatatype in custom array.
 
-  \return  UR_EVAL_ code.
-*/
-int ur_startup( UrlanEnv* env, UDatatype* custom, int customCount )
-{
+  \return pointer to script environment.
+*/
+UrlanEnv* ur_makeEnv( UDatatype* custom, int customCount )
+{
+    UrlanEnv* env;
     UThread* ut;
     int n;
@@ -474 +469 @@
     _validateEnv();
 #endif
+
+    env = memAlloc( sizeof(UrlanEnv) );
+    if( ! env )
+        return 0;
 
     env->threads  = 0;
@@ -505 +504 @@
         perror( "mutexInit" );
 #endif
-        return UR_EVAL_ERROR;
+        return 0;
     }
 
@@ -535 +534 @@
     n = ur_tokenize( ut, _bootScript, _bootScript + sizeof(_bootScript) );
     if( ! n )
-        return UR_EVAL_ERROR;
+    {
+        ur_freeEnv( env );
+        return 0;
+    }
     ur_bind( n, (UCell*) &ur_thrGlobal );
     n = ur_eval( ut, n, 0 );
     if( n != UR_EVAL_OK )
-        return n;
+    {
+        ur_freeEnv( env );
+        return 0;
+    }
 #endif
     n = ur_evalCStr( ut, _envScript, sizeof(_envScript) );
@@ -573 +578 @@
     ur_installExceptionHandlers();
 
-    return n;
+    return env;
 }
 
@@ -630 +635 @@
   before a second thread is created.
 */
-void ur_freezeEnv( UThread* ut, int binCount, int blkCount )
-{
-    UrlanEnv* env = ut->env;
+void ur_freezeEnv( UrlanEnv* env, int binCount, int blkCount )
+{
+    UThread* ut = env->threads;
 
     assert( env->bin.arr.ptr.v == 0 );
@@ -727 +732 @@
   Release all resources used by env.
 */
-void ur_shutdown( UrlanEnv* env )
+void ur_freeEnv( UrlanEnv* env )
 {
     UThread* thr;
     UThread* next;
+
+    if( ! env )
+        return;
+
     if( (thr = env->threads) )
     {
@@ -753 +762 @@
     ur_arrayFree( &env->atoms );
     ur_arrayFree( &env->atomNames );
+
+    memFree( env );
 }
 

trunk/thune/urlan.h

@@ -421 +421 @@
 
 
-#define UR_DSTACK_SIZE       256
-#define UR_CSTACK_SIZE       128
-
-#define UR_TASK_RUNNING    1
-#define UR_TASK_READY      2
-#define UR_TASK_BLOCKED    3
-#define UR_TASK_TERM       4
+#define UR_ENV_GC           0x01
+#define UR_ENV_SECURE       0x02
+
+#define UR_DSTACK_SIZE      256
+#define UR_CSTACK_SIZE      128
+
+#define UR_TASK_RUNNING     1
+#define UR_TASK_READY       2
+#define UR_TASK_BLOCKED     3
+#define UR_TASK_TERM        4
 
 typedef struct UrlanEnv     UrlanEnv;
@@ -510 +513 @@