Complete contant expression evaluation

src/samplesrc/test.pla

@@ -13,6 +13,10 @@ struc mystruc
   word data
 end
 //
+// Const expression
+//
+const constval = 2*(2+3) // a test expression should evaluate to 10
+//
 // Declare all global variables for this module.
 // Note that arrays are declared with prefix []. postfix [], or no [].
 // Only arrays with predclared sizes need [ and ], such as "int[3] a".
@@ -24,6 +28,7 @@ byte[] a2p = "][+"
 byte[] a2e = "//e"
 byte[] a2c = "//c"
 byte[] a3 = "///"
+byte   constr = "Constant expression = "
 byte[] offsets = "Structure offsets:"
 word array[] = 1, 10, 100, 1000, 10000
 word ptr
@@ -108,4 +113,5 @@ puti(data)
 putln
 puti(mystruc)
 putln
+puts(@constr); puti(constval); putln
 done

src/toolsrc/parse.c

@@ -67,9 +67,87 @@ int tos_op_prec(int tos)
 {
     return opsptr <= tos ? 100 : precstack[opsptr];
 }
+long valstack[16];
+int typestack[16];
+int sizestack[16];
+int valptr = -1;
+void push_val(long value, int size, int type)
+{
+    if (++valptr == 16)
+    {
+        parse_error("Stack overflow\n");
+        return;
+    }
+    valstack[valptr]  = value;
+    sizestack[valptr] = size;
+    typestack[valptr] = type;
+}
+int pop_val(long *value, int *size, int *type)
+{
+    if (valptr < 0)
+    {
+        parse_error("Stack underflow\n");
+        return (-1);
+    }
+    *value = valstack[valptr];
+    *size  = sizestack[valptr];
+    *type  = typestack[valptr];
+    return valptr--;
+}
 /*
  * Constant expression parsing
  */
+int calc_op(t_token op)
+{
+    long val1, val2;
+    int size1, size2, type1, type2;
+    if (!pop_val(&val2, &size2, &type2))
+        return 0;
+    pop_val(&val1, &size1, &type1);
+    if (type1 != CONST_TYPE || type2 != CONST_TYPE)
+    {
+        parse_error("Bad constant operand");
+        return (0);
+    }
+    switch (op)
+    {
+        case MUL_TOKEN:
+            val1 *= val2;
+            break;
+        case DIV_TOKEN:
+            val1 /= val2;
+            break;
+        case MOD_TOKEN:
+            val1 %= val2;
+            break;
+        case ADD_TOKEN:
+            val1 += val2;
+            break;
+        case SUB_TOKEN:
+            val1 -= val2;
+            break;
+        case SHL_TOKEN:
+            val1 <<= val2;
+            break;
+        case SHR_TOKEN:
+            val1 >>= val2;
+            break;
+        case AND_TOKEN:
+            val1 &= val2;
+            break;
+        case OR_TOKEN:
+            val1 |= val2;
+            break;
+        case EOR_TOKEN:
+            val1 ^= val2;
+            break;
+        default:
+            return (0);
+    }
+    size1 = size1 > size2 ? size1 : size2;
+    push_val(val1, size1, type1);
+    return (1);
+}
 int parse_constexpr(long *value, int *size);
 int parse_constterm(long *value, int *size)
 {
@@ -104,11 +182,14 @@ int parse_constterm(long *value, int *size)
     }
     return (type);
 }
-int parse_constval(long *value, int *size)
+int parse_constval(void)
 {
-    int mod = 0, type;
+    int mod = 0, type, size;
+    long value;
 
-    while (!(type = parse_constterm(value, size)))
+    value = 0;
+    size  = 1;
+    while (!(type = parse_constterm(&value, &size)))
     {
         switch (scantoken)
         {
@@ -138,9 +219,11 @@ int parse_constval(long *value, int *size)
      */
     switch (scantoken)
     {
+        case CLOSE_PAREN_TOKEN:
+            break;
     	case STRING_TOKEN:
-            *size  = tokenlen - 1;
+            size  = tokenlen - 1;
-            *value = constval;
+            value = constval;
             type  = STRING_TYPE;
             if (mod)
             {
@@ -149,100 +232,110 @@ int parse_constval(long *value, int *size)
             }
             break;
         case CHAR_TOKEN:
-            *size  = 1;
+            size  = 1;
-            *value = constval;
+            value = constval;
             type  = CONST_TYPE;
             break;
         case INT_TOKEN:
-            *size  = 2;
+            size  = 2;
-            *value = constval;
+            value = constval;
             type  = CONST_TYPE;
             break;
         case ID_TOKEN:
-            *size = 2;
+            size = 2;
             type = id_type(tokenstr, tokenlen);
             if (type & CONST_TYPE)
-                *value = id_const(tokenstr, tokenlen);
+                value = id_const(tokenstr, tokenlen);
             else if ((type & (FUNC_TYPE | EXTERN_TYPE)) || ((type & ADDR_TYPE) && (mod == 8)))
-                *value = id_tag(tokenstr, tokenlen);
+                value = id_tag(tokenstr, tokenlen);
             else
-            {
-                parse_error("Invalid constant");
                 return (0);
-            }
-            break;
-        case CLOSE_PAREN_TOKEN:
             break;
         default:
-            parse_error("Invalid constant");
             return (0);
     }
     if (mod & 1)
-        *value = -*value;
+        value = -value;
     if (mod & 2)
-        *value = ~*value;
+        value = ~value;
     if (mod & 4)
-        *value = *value ? 0 : -1;
+        value = value ? 0 : -1;
+    push_val(value, size, type);
     return (type);
 }
 int parse_constexpr(long *value, int *size)
 {
-    long val1, val2;
+    int prevmatch;
-    int valtype, type, size1, size2;
+    int matchop = 0;
-
+    int optos = opsptr;
-    if (!(valtype = parse_constval(&val1, &size1)))
+    int i;
-        return (0);
+    int type = CONST_TYPE;
+    *value = 0;
+    *size  = 1;
     do
     {
-        size2 = 0;
+        /*
+         * Parse sequence of double operand operations.
+         */
+        prevmatch = matchop;
+        matchop   = 0;
+        if (parse_constval())
+        {
+            matchop = 1;
+            scan();
+            for (i = 0; i < sizeof(binary_ops_table); i++)
+                if (scantoken == binary_ops_table[i])
+                {
+                    matchop = 2;
+                    if (binary_ops_precedence[i] >= tos_op_prec(optos))
+                        if (!calc_op(pop_op()))
+                        {
+                            parse_error(": Invalid binary operation");
+                            return (0);
+                        }
+                    push_op(scantoken, binary_ops_precedence[i]);
+                    break;
+                }
+        }
+    } while (matchop == 2);
+    if (matchop == 0 && prevmatch == 0)
+        return (0);
+    if (matchop == 0 && prevmatch == 2)
+    {
+        parse_error("Missing operand");
+        return (0);
+    }
+    while (optos < opsptr)
+        if (!calc_op(pop_op()))
+        {
+            parse_error(": Invalid binary operation");
+            return (0);
+        }
+    pop_val(value, size, &type);
+    return (type);
+}
+int parse_const(long *value)
+{
+    /*
+     * Get simple constant.
+     */
     switch (scan())
     {
-            case ADD_TOKEN:
+        case CHAR_TOKEN:
-                if (!(type = parse_constval(&val2, &size2)))
+        case INT_TOKEN:
-                    return (0);
+            *value = constval;
-                val1 = val1 + val2;
             break;
-            case SUB_TOKEN:
+        case ID_TOKEN:
-                if (!(type = parse_constval(&val2, &size2)))
+            if (id_type(tokenstr, tokenlen) & CONST_TYPE)
-                    return (0);
-                val1 = val1 - val2;
-                break;
-            case MUL_TOKEN:
-                if (!(type = parse_constval(&val2, &size2)))
-                    return (0);
-                val1 = val1 * val2;
-                break;
-            case DIV_TOKEN:
-                if (!(type = parse_constval(&val2, &size2)))
-                    return (0);
-                val1 = val1 / val2;
-                break;
-            case AND_TOKEN:
-                if (!(type = parse_constval(&val2, &size2)))
-                    return (0);
-                val1 = val1 & val2;
-                break;
-            case OR_TOKEN:
-                if (!(type = parse_constval(&val2, &size2)))
-                    return (0);
-                val1 = val1 | val2;
-                break;
-            case EOR_TOKEN:
-                if (!(type = parse_constval(&val2, &size2)))
-                    return (0);
-                val1 = val1 ^ val2;
-                break;
-        }
-        if (size1 > size2)
-            *size = size1;
-        else
             {
-            valtype = type;
+                *value = id_const(tokenstr, tokenlen);
-            *size   = size2;
+                break;
             }
-    } while (size2);
+        default:
-    *value = val1;
+            *value = 0;
-    return (valtype);
+            return (0);
+    }
+    return (CONST_TYPE);
 }
 /*
  * Normal expression parsing
@@ -509,7 +602,7 @@ int parse_value(int rvalue)
                 }
                 ref_type   = (scantoken == PTRB_TOKEN) ? BPTR_TYPE : WPTR_TYPE;
                 ref_offset = 0;
-                if (!parse_constval(&ref_offset, &const_size))
+                if (!parse_const(&ref_offset))
                     scan_rewind(tokenstr);
                 if (ref_offset != 0)
                 {
@@ -526,7 +619,7 @@ int parse_value(int rvalue)
                 ref_type = (ref_type & (VAR_TYPE | CONST_TYPE)) 
                          ? ((scantoken == DOT_TOKEN) ? BYTE_TYPE : WORD_TYPE)
                          : ((scantoken == DOT_TOKEN) ? BPTR_TYPE : WPTR_TYPE);
-                if (parse_constval(&const_offset, &const_size))
+                if (parse_const(&const_offset))
                     ref_offset += const_offset;
                 else
                     scan_rewind(tokenstr);
@@ -943,7 +1036,7 @@ int parse_stmnt(void)
                      */
                     int elem_size;
                     elem_type = (scantoken == DOT_TOKEN) ? BYTE_TYPE : WORD_TYPE;
-                    if (!parse_constval(&elem_offset, &elem_size))
+                    if (!parse_const(&elem_offset))
                         scantoken = ID_TOKEN;
                     else
                         scan();

src/toolsrc/sb.pla

@@ -91,7 +91,7 @@ word              = $0450,$04D0,$0550,$05D0,$0650,$06D0,$0750,$07D0
 // Editor variables
 //
 byte nullstr      = ""
-byte version      = "PLASMA ][ SANDBOX VERSION 00.11 "
+byte version      = "PLASMA ][ SANDBOX VERSION 00.12"
 byte errorstr     = "ERROR: $"
 byte okstr        = "OK"
 byte outofmem     = "OUT OF MEMORY!"
@@ -287,6 +287,10 @@ byte                    = 10
 byte[16] opstack
 byte[16] precstack
 word opsp = -1
+word[16] valstack
+byte[16] sizestack
+byte[16] typestack
+word valsp = -1
 //
 // Symbol table variables
 //
@@ -327,9 +331,7 @@ word  lineno = 0
 //
 // Compiler output messages
 //
-//byte entrypt_str[]          = "START: "
 byte bytes_compiled_str[]   = "\nBYTES COMPILED: "
-//byte comp_ok_msg[]          = "COMPILATION COMPLETE"
 byte dup_id[]               = "DUPLICATE IDENTIFIER"
 byte undecl_id[]            = "UNDECLARED IDENTIFIER"
 byte bad_cnst[]             = "BAD CONSTANT"
@@ -626,7 +628,7 @@ end
 //
 asm cout
     	LDA 	ESTKL,X
-        BIT 	$BF98
+COUT1   BIT 	$BF98
         BMI 	+
         JSR 	TOUPR
 +   	ORA 	#$80
@@ -663,17 +665,11 @@ asm prstr
         LDA     (SRC),Y
         STA     TMP
         BEQ     ++
-        BIT 	ROMEN
 -    	INY
     	LDA 	(SRC),Y
-        BIT 	$BF98
+	JSR	COUT1
-        BMI 	+
-        JSR 	TOUPR
-+    	ORA 	#$80
-        JSR 	$FDED
         CPY 	TMP
         BNE 	-
-        BIT 	LCRDEN+LCBNK2
 ++   	RTS
 end
 //
@@ -1282,7 +1278,6 @@ def drawscrn(toprow, ofst)
     byte row, numchars
     word strptr, scrnptr
 
-    if ofst
     for row = 0 to 23
         strptr   = strlinbuf:[toprow + row]
 	scrnptr  = txtscrn[row]
@@ -1298,19 +1293,6 @@ def drawscrn(toprow, ofst)
        	fin
 	memcpy(scrnptr, strptr + ofst + 1, numchars)
     next
-    else
-        for row = 0 to 23
-            strptr   = strlinbuf:[toprow + row]
-	    scrnptr  = txtscrn[row]
-	    numchars = ^strptr
-	    if numchars >= 40
-                numchars = 40
-	    else
-	        memset(scrnptr + numchars, 40 - numchars, $A0A0)
-       	    fin
-	    memcpy(scrnptr, strptr + 1, numchars)
-        next
-    fin
 end
 def cursoff
     if flags & showcurs
@@ -1473,7 +1455,7 @@ def keyin2e
 	        key = keyctrlz
 		break
 	    is keyenter
-	        key = keyctrlo
+	        key = keyctrlf
 		break
 	wend
     fin
@@ -2625,6 +2607,25 @@ def tos_op_prec(tos)
     fin
     return precstack[opsp]
 end
+def push_val(value, size, type)
+    valsp = valsp + 1
+    if valsp == 16
+        return parse_err(@estk_overflw)
+    fin
+    valstack[valsp]  = value
+    sizestack[valsp] = size
+    typestack[valsp] = type
+end
+def pop_val(valptr, sizeptr, typeptr)
+    if valsp < 0
+        return parse_err(@estk_underflw)
+    fin
+    *valptr  = valstack[valsp]
+    ^sizeptr = sizestack[valsp]
+    ^typeptr = typestack[valsp]
+    valsp = valsp - 1
+    return valsp  + 1
+end
 //
 // Lexical anaylzer
 //
@@ -2868,6 +2869,51 @@ end
 //
 // Constant expression parsing
 //
+def calc_binaryop(op)
+    word val1, val2
+    byte size1, size2, type1, type2
+    
+    if not pop_val(@val2, @size2, @type2); return 0; fin
+    pop_val(@val1, @size1, @type1)
+    if type1 <> CONST_TYPE and type2 <> CONST_TYPE; return parse_err(@bad_cnst); fin    
+    when op
+        is MUL_TKN
+            val1 = val1 * val2
+	        break
+        is DIV_TKN
+            val1 = val1 / val2
+    	    break
+        is MOD_TKN
+            val1 = val1 % val2
+            break
+        is ADD_TKN
+            val1 = val1 + val2
+	        break
+        is SUB_TKN
+            val1 = val1 - val2
+    	    break
+        is SHL_TKN
+            val1 = val1 << val2
+            break
+        is SHR_TKN
+            val1 = val1 >> val2
+            break
+        is AND_TKN
+            val1 = val1 & val2
+            break
+        is OR_TKN
+            val1 = val1 | val2
+            break
+        is EOR_TKN
+            val1 = val1 ^ val2
+            break
+        otherwise
+            return FALSE
+    wend
+    if size2 > size1; size1 = size2; fin
+    push_val(val1, size1, type1)
+    return TRUE
+end
 def parse_constterm(valptr, sizeptr)
     word type
     
@@ -2884,14 +2930,15 @@ def parse_constterm(valptr, sizeptr)
     wend
     return FALSE
 end
-def parse_constval(valptr, sizeptr)
+def parse_constval
-    byte mod, type
+    byte mod, type, size
-    word idptr, ctag
+    word idptr, ctag, value
 
+    value = 0
+    size  = 1
     mod   = 0
-    ^sizeptr = 0
     repeat
-        type = parse_constterm(valptr, sizeptr)
+        type = parse_constterm(@value, @size)
         if !type
             when token
                 is SUB_TKN
@@ -2910,24 +2957,26 @@ def parse_constval(valptr, sizeptr)
         fin
     until type
     when token
+        is CLOSE_PAREN_TKN
+            break
         is STR_TKN
-            ^sizeptr = tknlen - 1
+            size  = tknlen - 1
-            *valptr  = constval
+            value = constval
             type  = STR_TYPE
             if mod; return parse_err(@bad_op); fin
             break
         is CHR_TKN
-            ^sizeptr = 1
+            size  = 1
-            *valptr  = constval
+            value = constval
-            type     = BYTE_TYPE
+            type  = CONST_TYPE
             break
         is INT_TKN
-            ^sizeptr = 2
+            size  = 2
-            *valptr  = constval
+            value = constval
-            type     = WORD_TYPE
+            type  = CONST_TYPE
             break
         is ID_TKN
-            ^sizeptr = 2
+            size  = 2
             idptr = id_lookup(tknptr, tknlen)
             if !idptr; return parse_err(@bad_cnst); fin
             type = idptr->idtype
@@ -2935,83 +2984,76 @@ def parse_constval(valptr, sizeptr)
 	        if mod <> 8; return parse_err(@bad_cnst); fin
                 type = CONSTADDR_TYPE
             fin
-            *valptr = idptr=>idval
+            value = idptr=>idval
-    	    break
-        is CLOSE_PAREN_TKN
     	    break
         otherwise
-            return parse_err(@bad_cnst)
+            return 0
     wend
     if mod & 1
-        *valptr = -*valptr
+        value = -value
     fin
     if mod & 2
-        *valptr = ~*valptr
+        value = ~value
     fin
     if mod & 4
-        *valptr = !*valptr
+        value = !value
     fin
+    push_val(value, size, type)
     return type
 end
 def parse_constexpr(valptr, sizeptr)
-    byte valtype, type, size1, size2
+    byte prevmatch, matchop, i, type
-    word val1, val2
+    word optos
 
-    valtype = parse_constval(@val1, @size1)
+    *valptr  = 0
-    if !valtype; return 0; fin
+    *sizeptr = 1
+    matchop  = 0
+    optos    = opsp
     repeat
-        size2 = 0
+        prevmatch = matchop
-        when scan
+        matchop   = 0
-            is ADD_TKN
+        if parse_constval
-                type = parse_constval(@val2, @size2)
+            matchop = 1
-                if !type; return 0; fin
+            scan
-                val1 = val1 + val2
+            for i = 0 to bops_tblsz
-	            break
+                if token == bops_tbl[i]
-            is SUB_TKN
+                    matchop = 2
-                type = parse_constval(@val2, @size2)
+                    if bops_prec[i] >= tos_op_prec(optos)
-                if !type; return 0; fin
+                        if !calc_binaryop(pop_op); return parse_err(@bad_op); fin
-                val1 = val1 - val2
-                break
-            is MUL_TKN
-                type = parse_constval(@val2, @size2)
-                if !type; return 0; fin
-                val1 = val1 * val2
-                break
-            is DIV_TKN
-                type = parse_constval(@val2, @size2)
-                if !type; return 0; fin
-                val1 = val1 / val2
-                break
-            is MOD_TKN
-                type = parse_constval(@val2, @size2)
-                if !type; return 0; fin
-                val1 = val1 % val2
-                break
-            is AND_TKN
-                type = parse_constval(@val2, @size2)
-                if !type; return 0; fin
-                val1 = val1 & val2
-                break
-            is OR_TKN
-                type = parse_constval(@val2, @size2)
-                if !type; return 0; fin
-                val1 = val1 | val2
-                break
-            is EOR_TKN
-                type = parse_constval(@val2, @size2)
-                if !type; return 0; fin
-                val1 = val1 ^ val2
-                break
-        wend
-        if size1 > size2
-            ^sizeptr = size1
-        else
-            valtype  = type
-            ^sizeptr = size2
                     fin
-    until !size2
+                    push_op(token, bops_prec[i])
-    *valptr = val1
+                    break
-    return valtype
+                fin
+            next
+        fin
+    until matchop <> 2
+    if matchop == 0 and prevmatch == 0; return 0; fin
+    if matchop == 0 and prevmatch == 2; return parse_err(@missing_op); fin
+    while optos < opsp
+        if !calc_binaryop(pop_op); return parse_err(@bad_op); fin
+    loop
+    pop_val(valptr, sizeptr, @type)
+    return type
+end
+def parse_const(valptr)
+    word idptr
+    
+    when scan
+        is CHR_TKN
+        is INT_TKN
+            *valptr = constval
+            break
+        is ID_TKN
+            idptr = id_lookup(tknptr, tknlen)
+            if !idptr; return parse_err(@bad_cnst); fin
+            if idptr->idtype & CONST_TYPE
+                *valptr = idptr=>idval
+                break
+            fin
+        otherwise
+            return 0
+    wend
+    return CONST_TYPE
 end
 //
 // Normal expression parsing
@@ -3255,7 +3297,7 @@ def parse_value(rvalue)
                     ref_type = WPTR_TYPE
                 fin
                 ref_offset = 0
-                if !parse_constval(@ref_offset, @const_size)
+                if !parse_const(@ref_offset)
                     rewind(tknptr)
                 fin
                 if ref_offset <> 0
@@ -3282,7 +3324,7 @@ def parse_value(rvalue)
                         ref_type = WPTR_TYPE
                     fin
                 fin
-                if parse_constval(@const_offset, @const_size)
+                if parse_const(@const_offset)
                     ref_offset = ref_offset + const_offset
                 else
                     rewind(tknptr)
@@ -3640,7 +3682,7 @@ def parse_stmnt
                     else
                         elem_type = WORD_TYPE
                     fin
-                    if !parse_constval(@elem_offset, @elem_size)
+                    if !parse_const(@elem_offset)
                         token = ID_TKN
                     else
                         scan

src/vmsrc/a1cmd.pla

@@ -39,7 +39,7 @@ predef loadmod, execmod, lookupstrmod
 //
 // System variables.
 //
-word version     = $0011 // 00.1
+word version     = $0012 // 00.12
 word systemflags = 0
 word heap
 word symtbl, lastsym

src/vmsrc/cmd.pla

@@ -33,7 +33,7 @@ predef loadmod, execmod, lookupstrmod
 //
 // System variable.
 //
-word version     = $0011 // 00.11
+word version     = $0012 // 00.12
 word systemflags = 0
 word heap
 word xheap       = $0800

src/vmsrc/soscmd.pla

@@ -34,7 +34,7 @@ predef loadmod, execmod, lookupstrmod
 //
 // System variables.
 //
-word version     = $0011 // 00.11
+word version     = $0012 // 00.12
 word systemflags = 0
 byte refcons     = 0
 byte devcons     = 0