diff --git a/src/inc/cmdsys.plh b/src/inc/cmdsys.plh
index d48c91b..235ae86 100644
--- a/src/inc/cmdsys.plh
+++ b/src/inc/cmdsys.plh
@@ -36,7 +36,7 @@ import cmdsys
//
// CMD exported functions
//
- predef putc(c)#0, putln()#0, puts(s)#0, puti(i)#0, getc()#1, gets(p)#1
+ predef putc(c)#0, putln()#0, puts(s)#0, puti(i)#0, getc()#1, gets(p)#1, toupper(c)#1
predef call(addr,areg,xreg,yreg,status)#1, syscall(cmd,params)#1
predef heapmark()#1, heapallocalign(size, pow2, freeaddr), heapalloc(size)#1, heaprelease(newheap)#1, heapavail()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0
diff --git a/src/libsrc/sane.pla b/src/libsrc/sane.pla
index 7a4166c..bcb04a0 100644
--- a/src/libsrc/sane.pla
+++ b/src/libsrc/sane.pla
@@ -753,19 +753,19 @@ end
//
def elemsLoad1(op, dst)#1
if loadElems
- return sane[3](op, dst)
+ return sane[6](op, dst)
fin
return -1
end
def elemsLoad2(op, dst, src)#1
if loadElems
- return sane[4](op, dst, src)
+ return sane[7](op, dst, src)
fin
return -1
end
def elemsLoad3(op, dst, src, src2)#1
if loadElems
- return sane[4](op, dst, src, src2)
+ return sane[8](op, dst, src, src2)
fin
return -1
end
diff --git a/src/samplesrc/sanity.pla b/src/samplesrc/sanity.pla
index ba3a28e..dca0621 100644
--- a/src/samplesrc/sanity.pla
+++ b/src/samplesrc/sanity.pla
@@ -3,14 +3,173 @@
//
include "inc/cmdsys.plh"
include "inc/sane.plh"
+struc t_decrecord
+ word sgn
+ word exp
+ byte sig[29]
+end
+struc t_decformat
+ word style
+ word digits
+end
//
// Test values
//
word iA, iB, iC, zero, fpEnv
byte xT[t_extended]
-word decrec = 0, 0
-byte strA[28] = "10"
-word decform = 0, 6
+byte strNum = "-100.25"
+byte strA[16]
+//
+// Parse string into decrecord
+//
+def str2ext(str, ext)
+ byte i, s, d
+ byte decrec[t_decrecord]
+ word sgnadj, expadj
+
+ decrec:sgn = 0
+ decrec:exp = 0
+ decrec.sig = 0
+ s = 1
+ i = 1
+ //
+ // Skip whitespace
+ //
+ while ^(str+i) <= ' ' and i <= ^str; i++; loop
+ //
+ // Check for sign
+ //
+ if ^(str+i) == '-'
+ decrec:sgn = 1
+ i++
+ elsif ^(str+i) == '+'
+ i++
+ fin
+ //
+ // Skip leading zeros
+ //
+ while i <= ^str and ^(str+i) == '0'
+ i++
+ loop
+ //
+ // Parse number
+ //
+ while i <= ^str
+ d = toupper(^(str+i))
+ if d >= '0' and d <= '9'
+ //
+ // Parse digit
+ //
+ decrec.sig[s] = ^(str+i)
+ decrec:sig++
+ s++
+ elsif d == '.'
+ //
+ // Parse decimal point
+ //
+ i++
+ while i <= ^str
+ d = toupper(^(str+i))
+ if d >= '0' and d <= '9'
+ decrec.sig[s] = ^(str+i)
+ decrec.sig++
+ decrec:exp--
+ s++
+ elsif d == 'E'
+ i--
+ break
+ else
+ i = ^str
+ fin
+ i++
+ loop
+ elsif d == 'E'
+ //
+ // Parse exponent
+ //
+ i++
+ expadj = 0
+ sgnadj = 1
+ if ^(str+i) == '-'
+ sgnadj = -1
+ i++
+ elsif ^(str+i) == '+'
+ i++
+ fin
+ while i <= ^str
+ d = ^(str+i)
+ if d >= '0' and d <= '9'
+ expadj = expadj * 10 + (d - '0')
+ else
+ i = ^str
+ fin
+ loop
+ decrec:exp = decrec:exp + (sgnadj * expadj)
+ else
+ i = ^str
+ fin
+ i++
+ loop
+ //
+ // Strip leading zeros from sig
+ //
+ while decrec.sig > 1 and decrec.sig.1 == '0'
+ decrec.sig--
+ if decrec:exp < 0
+ decrec:exp--
+ fin
+ memcpy(@decrec.sig.1, @decrec.sig.2, decrec.sig)
+ loop
+ //
+ // Check for zero
+ //
+ if !decrec.sig
+ decrec.sig = 1
+ decrec.sig.1 = '0'
+ fin
+ //putc(decrec.sgn ?? '-' :: '+'); puts(@decrec.sig); putc('e'); puti(decrec:exp); putln
+ return sane:fpOp2(FFEXT|FOD2B, ext, @decrec)
+end
+def ext2str(ext, str)
+ byte d, i, dp
+ byte decform[t_decformat]
+ byte decrec[t_decrecord]
+
+ decform:style = 1
+ decform:digits = 4
+ sane:fpOp3(FFEXT|FOB2D, @decrec, ext, @decform)
+ //putc(decrec.sgn ?? '-' :: '+'); puts(@decrec.sig); putc('e'); puti(decrec:exp); putln
+ i = 0
+ if decrec.sgn
+ ^(str+1) = '-'
+ i = 1
+ fin
+ dp = decrec.sig + decrec:exp
+ for d = 1 to decrec.sig
+ i++
+ ^(str+i) = decrec.sig[d]
+ if d == dp
+ i++
+ ^(str+i) = '.'
+ fin
+ next
+ ^str = i
+ return ^str
+end
+def divstri(strNum, denom)#0
+ byte strResult[16]
+ byte xResult[t_extended]
+
+ //
+ // Convert string to and from SANE
+ //
+ sane:zpSave()
+ str2ext(strNum, @xResult)
+ sane:fpOp2(FFINT|FODIV, @xResult, @denom) // Div int denom into ext Result
+ ext2str(@xResult, @strResult)
+ sane:zpRestore()
+ puts(strNum); putc('/'); puti(denom); putc('='); puts(@strResult); putln
+end
//
// My custom SANE exception handler
//
@@ -27,6 +186,7 @@ def myException(pstatus)
return pstatus=>4
end
+
iA = 3
iB = 4
iC = -1
@@ -73,14 +233,8 @@ sane:fpOp2(FFINT|FOX2Z, @iC, @xT) // Convert ext T to int C
sane:zpRestore()
puti(iA); putc('/'); puti(zero); putc('='); puti(iC); putc('\n')
//
-// Convert string to and from SANE
+// String conversion tests
//
-sane:zpSave()
-sane:fpOp2(FFEXT|FOD2B, @xT, @decrec)
-//sane:fpOp2(FFINT|FOZ2X, @xT, @iA) // Convert int A to ext T
-sane:fpOp2(FFINT|FODIV, @xT, @iB) // Div int B into ext T
-sane:fpOp2(FFINT|FOX2Z, @iC, @xT) // Convert ext T to int C
-sane:fpOp3(FFEXT|FOB2D, @decrec, @xT, @decform)
-sane:zpRestore()
-puts("10 / 4 = "); puts(@strA); putc('e'); puti(decrec:2); putc('('); puti(iC); putc(')'); putln
+divstri("-100.5", 4)
+divstri("00.5", 2)
done
diff --git a/src/samplesrc/test.pla b/src/samplesrc/test.pla
index 580349f..55a2da0 100755
--- a/src/samplesrc/test.pla
+++ b/src/samplesrc/test.pla
@@ -127,6 +127,10 @@ def dummy(zz)#0
return 0
end
+def value1
+ return 1
+end
+
puti(array[0]);putc(' ')
puti(array[1]);putc(' ')
puti(array[2]);putc(' ')
@@ -161,4 +165,7 @@ putln
puts(@constr); puti(constval); putln
puts("Signed byte constant:"); puti(-3); putln
puts("Hello from in-line string!\$7F\n")
+puts(1 ?? "This is TRUE\n" :: "This is FALSE\n")
+puts(0 ?? "This is TRUE\n" :: "This is FALSE\n")
+ptr = 0
done
diff --git a/src/toolsrc/codegen.c b/src/toolsrc/codegen.c
index bc53903..a2e3888 100755
--- a/src/toolsrc/codegen.c
+++ b/src/toolsrc/codegen.c
@@ -1665,6 +1665,11 @@ int emit_pending_seq()
case BRTRUE_CODE:
emit_brtru(op->tag);
break;
+ case CODETAG_CODE:
+ printf("_B%03d%c\n", op->tag, LBL);
+ break;
+ case NOP_CODE:
+ break;
default:
return (0);
}
diff --git a/src/toolsrc/codegen.h b/src/toolsrc/codegen.h
index e7c1247..49cc303 100755
--- a/src/toolsrc/codegen.h
+++ b/src/toolsrc/codegen.h
@@ -64,6 +64,8 @@ typedef struct _opseq {
#define BRNCH_CODE 0x031C
#define BRFALSE_CODE 0x031D
#define BRTRUE_CODE 0x031E
+#define CODETAG_CODE 0x031F
+#define NOP_CODE 0x0320
#define gen_uop(seq,op) gen_seq(seq,UNARY_CODE(op),0,0,0,0)
#define gen_op(seq,op) gen_seq(seq,BINARY_CODE(op),0,0,0,0)
@@ -83,6 +85,9 @@ typedef struct _opseq {
#define gen_drop(seq) gen_seq(seq,DROP_CODE,0,0,0,0)
#define gen_brfls(seq,tag) gen_seq(seq,BRFALSE_CODE,0,tag,0,0)
#define gen_brtru(seq,tag) gen_seq(seq,BRTRUE_CODE,0,tag,0,0)
+#define gen_brnch(seq,tag) gen_seq(seq,BRNCH_CODE,0,tag,0,0)
+#define gen_codetag(seq,tag) gen_seq(seq, CODETAG_CODE,0,tag,0,0)
+#define gen_nop(seq) gen_seq(seq,NOP_CODE,0,0,0,0)
void emit_flags(int flags);
void emit_header(void);
diff --git a/src/toolsrc/lex.c b/src/toolsrc/lex.c
index 0c7fe3f..985f454 100755
--- a/src/toolsrc/lex.c
+++ b/src/toolsrc/lex.c
@@ -388,6 +388,30 @@ t_token scan(void)
scanpos++;
}
break;
+ case ':':
+ if (scanpos[1] == ':')
+ {
+ scantoken = TRIELSE_TOKEN;
+ scanpos += 2;
+ }
+ else
+ {
+ scantoken = COLON_TOKEN;
+ scanpos++;
+ }
+ break;
+ case '?':
+ if (scanpos[1] == '?')
+ {
+ scantoken = TERNARY_TOKEN;
+ scanpos += 2;
+ }
+ else
+ {
+ scantoken = TERNARY_TOKEN;
+ scanpos++;
+ }
+ break;
default:
/*
* Simple single character tokens.
diff --git a/src/toolsrc/parse.c b/src/toolsrc/parse.c
index 94b1402..4f439b9 100755
--- a/src/toolsrc/parse.c
+++ b/src/toolsrc/parse.c
@@ -746,6 +746,32 @@ t_opseq *parse_expr(t_opseq *codeseq, int *stackdepth)
if (stackdepth)
(*stackdepth)--;
}
+ /*
+ * Look for ternary operator
+ */
+ if (scantoken == TERNARY_TOKEN)
+ {
+ int tag_else, tag_endtri;
+ int stackdepth1;
+
+ if (*stackdepth != 1)
+ parse_error("Ternary op must evaluate to single value");
+ tag_else = tag_new(BRANCH_TYPE);
+ tag_endtri = tag_new(BRANCH_TYPE);
+ codeseq = gen_brfls(codeseq, tag_else);
+ codeseq = parse_expr(codeseq, &stackdepth1);
+ if (scantoken != TRIELSE_TOKEN)
+ {
+ parse_error("Missing '::' in ternary op");
+ return (NULL);
+ }
+ codeseq = gen_brnch(codeseq, tag_endtri);
+ codeseq = gen_codetag(codeseq, tag_else);
+ codeseq = parse_expr(codeseq, stackdepth);
+ if (stackdepth1 != *stackdepth)
+ parse_error("Inconsistent value counts in ternary op");
+ codeseq = gen_codetag(codeseq, tag_endtri);
+ }
return (codeseq);
}
t_opseq *parse_set(t_opseq *codeseq)
diff --git a/src/toolsrc/tokens.h b/src/toolsrc/tokens.h
index dd629b7..dfe1421 100755
--- a/src/toolsrc/tokens.h
+++ b/src/toolsrc/tokens.h
@@ -44,6 +44,11 @@
#define STRUC_TOKEN TOKEN(31)
#define CONTINUE_TOKEN TOKEN(32)
//#define EVAL_TOKEN TOKEN(32)
+/*
+ * Ternary operand operators.
+ */
+#define TERNARY_TOKEN TOKEN('?')
+#define TRIELSE_TOKEN TOKEN('_')
/*
* Double operand operators.
*/
diff --git a/src/vmsrc/a1cmd.pla b/src/vmsrc/a1cmd.pla
index ec21df9..354ad9e 100755
--- a/src/vmsrc/a1cmd.pla
+++ b/src/vmsrc/a1cmd.pla
@@ -31,7 +31,7 @@ const CFFAEntryPtr = $0B
// Pedefined functions.
//
predef syscall(cmd)#1, call(addr,areg,xreg,yreg,status)#1
-predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1
+predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#1
predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr), releaseheap(newheap)#1, availheap()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1
@@ -74,6 +74,7 @@ byte putsstr[] = "PUTS"
byte putistr[] = "PUTI"
byte getcstr[] = "GETC"
byte getsstr[] = "GETS"
+byte toupstr[] = "TOUPPER"
byte sysstr[] = "SYSCALL"
byte callstr[] = "CALL"
byte hpmarkstr[] = "HEAPMARK"
@@ -99,6 +100,7 @@ word = @putsstr, @prstr
word = @putistr, @print
word = @getcstr, @cin
word = @getsstr, @rdstr
+word = @toupstr, @toupper
word = @hpmarkstr, @markheap
word = @hpallocstr,@allocheap
word = @hpalignstr,@allocalignheap
diff --git a/src/vmsrc/cmd.pla b/src/vmsrc/cmd.pla
index b8f1995..555ac3d 100755
--- a/src/vmsrc/cmd.pla
+++ b/src/vmsrc/cmd.pla
@@ -25,7 +25,7 @@ const modinitkeep = $4000
// Pedefined functions.
//
predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1
-predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1
+predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#1
predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr)#1, releaseheap(newheap)#1, availheap()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1
@@ -53,6 +53,7 @@ byte putsstr = "PUTS"
byte putistr = "PUTI"
byte getcstr = "GETC"
byte getsstr = "GETS"
+byte toupstr = "TOUPPER"
byte hpmarkstr = "HEAPMARK"
byte hpalignstr = "HEAPALLOCALIGN"
byte hpallocstr = "HEAPALLOC"
@@ -78,6 +79,7 @@ word = @putsstr, @prstr
word = @putistr, @print
word = @getcstr, @cin
word = @getsstr, @rdstr
+word = @toupstr, @toupper
word = @hpmarkstr, @markheap
word = @hpallocstr,@allocheap
word = @hpalignstr,@allocalignheap
diff --git a/src/vmsrc/soscmd.pla b/src/vmsrc/soscmd.pla
index 79fb66c..87802a0 100755
--- a/src/vmsrc/soscmd.pla
+++ b/src/vmsrc/soscmd.pla
@@ -26,7 +26,7 @@ const O_READ_WRITE = 3
// Pedefined functions.
//
predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1
-predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1
+predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#1
predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr), releaseheap(newheap)#1, availheap()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1
@@ -71,6 +71,7 @@ byte putsstr[] = "PUTS"
byte putistr[] = "PUTI"
byte getcstr[] = "GETC"
byte getsstr[] = "GETS"
+byte toupstr[] = "TOUPPER"
byte hpmarkstr[] = "HEAPMARK"
byte hpalignstr[] = "HEAPALLOCALIGN"
byte hpallocstr[] = "HEAPALLOC"
@@ -95,6 +96,7 @@ word = @putsstr, @prstr
word = @putistr, @print
word = @getcstr, @cin
word = @getsstr, @rdstr
+word = @toupstr, @toupper
word = @hpmarkstr, @markheap
word = @hpallocstr,@allocheap
word = @hpalignstr,@allocalignheap