mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2025-02-06 04:30:13 +00:00
Evaluate arithmetic and shifts in long long constant expressions.
This winds up calling functions for these operations in ORCALib, so an up-to-date version of that must now be available to build the ORCA/C compiler.
This commit is contained in:
Stephen Heumann
parent
76cc4b9ca7
commit
d66f6b27b7
104
Exp.macros
104
Exp.macros
@ -162,3 +162,107 @@
|
||||
LONGI OFF
|
||||
.I
|
||||
MEND
|
||||
macro
|
||||
&l ph8 &n1
|
||||
lclc &c
|
||||
&l anop
|
||||
&c amid &n1,1,1
|
||||
aif s:longa=1,.a
|
||||
rep #%00100000
|
||||
.a
|
||||
aif "&c"="#",.d
|
||||
aif "&c"="[",.b
|
||||
aif "&c"<>"{",.c
|
||||
&c amid &n1,l:&n1,1
|
||||
aif "&c"<>"}",.g
|
||||
&n1 amid &n1,2,l:&n1-2
|
||||
&n1 setc (&n1)
|
||||
.b
|
||||
ldy #6
|
||||
~&SYSCNT lda &n1,y
|
||||
pha
|
||||
dey
|
||||
dey
|
||||
bpl ~&SYSCNT
|
||||
ago .e
|
||||
.c
|
||||
ldx #6
|
||||
~&SYSCNT lda &n1,x
|
||||
pha
|
||||
dex
|
||||
dex
|
||||
bpl ~&SYSCNT
|
||||
ago .e
|
||||
.d
|
||||
&n1 amid &n1,2,l:&n1-1
|
||||
bra ~b&SYSCNT
|
||||
~a&SYSCNT dc i8"&n1"
|
||||
~b&SYSCNT ldx #6
|
||||
~c&SYSCNT lda ~a&SYSCNT,x
|
||||
pha
|
||||
dex
|
||||
dex
|
||||
bpl ~c&SYSCNT
|
||||
.e
|
||||
aif s:longa=1,.f
|
||||
sep #%00100000
|
||||
.f
|
||||
mexit
|
||||
.g
|
||||
mnote "Missing closing '}'",16
|
||||
mend
|
||||
macro
|
||||
&l pl8 &n1
|
||||
lclc &c
|
||||
&l anop
|
||||
aif s:longa=1,.a
|
||||
rep #%00100000
|
||||
.a
|
||||
&c amid &n1,1,1
|
||||
aif "&c"<>"{",.b
|
||||
&c amid &n1,l:&n1,1
|
||||
aif "&c"<>"}",.f
|
||||
&n1 amid &n1,2,l:&n1-2
|
||||
pla
|
||||
sta (&n1)
|
||||
ldy #2
|
||||
pla
|
||||
sta (&n1),y
|
||||
ldy #4
|
||||
pla
|
||||
sta (&n1),y
|
||||
ldy #6
|
||||
pla
|
||||
sta (&n1),y
|
||||
ago .d
|
||||
.b
|
||||
aif "&c"<>"[",.c
|
||||
pla
|
||||
sta &n1
|
||||
ldy #2
|
||||
pla
|
||||
sta &n1,y
|
||||
ldy #4
|
||||
pla
|
||||
sta &n1,y
|
||||
ldy #6
|
||||
pla
|
||||
sta &n1,y
|
||||
ago .d
|
||||
.c
|
||||
pla
|
||||
sta &n1
|
||||
pla
|
||||
sta &n1+2
|
||||
pla
|
||||
sta &n1+4
|
||||
pla
|
||||
sta &n1+6
|
||||
.d
|
||||
aif s:longa=1,.e
|
||||
sep #%00100000
|
||||
.e
|
||||
mexit
|
||||
.f
|
||||
mnote "Missing closing '}'",16
|
||||
mend
|
||||
|
||||
256
Expression.asm
256
Expression.asm
@ -382,3 +382,259 @@ ml6 ror a shift the answer
|
||||
;
|
||||
ml7 return 4:ans fix the stack
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* procedure umul64 (var x: longlong; y: longlong);
|
||||
*
|
||||
* Inputs:
|
||||
* x,y - operands
|
||||
*
|
||||
* Outputs:
|
||||
* x - result
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
umul64 start exp
|
||||
|
||||
subroutine (4:x,4:y),0
|
||||
|
||||
ph8 [x]
|
||||
ph8 [y]
|
||||
jsl ~UMUL8
|
||||
pl8 [x]
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* procedure udiv64 (var x: longlong; y: longlong);
|
||||
*
|
||||
* Inputs:
|
||||
* x,y - operands
|
||||
*
|
||||
* Outputs:
|
||||
* x - result
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
udiv64 start exp
|
||||
|
||||
subroutine (4:x,4:y),0
|
||||
|
||||
ph8 [x]
|
||||
ph8 [y]
|
||||
jsl ~UDIV8
|
||||
pl8 [x]
|
||||
pla
|
||||
pla
|
||||
pla
|
||||
pla
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* procedure div64 (var x: longlong; y: longlong);
|
||||
*
|
||||
* Inputs:
|
||||
* x,y - operands
|
||||
*
|
||||
* Outputs:
|
||||
* x - result
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
div64 start exp
|
||||
|
||||
subroutine (4:x,4:y),0
|
||||
|
||||
ph8 [x]
|
||||
ph8 [y]
|
||||
jsl ~CDIV8
|
||||
pl8 [x]
|
||||
pla
|
||||
pla
|
||||
pla
|
||||
pla
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* procedure umod64 (var x: longlong; y: longlong);
|
||||
*
|
||||
* Inputs:
|
||||
* x,y - operands
|
||||
*
|
||||
* Outputs:
|
||||
* x - result
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
umod64 start exp
|
||||
|
||||
subroutine (4:x,4:y),0
|
||||
|
||||
ph8 [x]
|
||||
ph8 [y]
|
||||
jsl ~UDIV8
|
||||
pla
|
||||
pla
|
||||
pla
|
||||
pla
|
||||
pl8 [x]
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* procedure rem64 (var x: longlong; y: longlong);
|
||||
*
|
||||
* Inputs:
|
||||
* x,y - operands
|
||||
*
|
||||
* Outputs:
|
||||
* x - result
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
rem64 start exp
|
||||
|
||||
subroutine (4:x,4:y),0
|
||||
|
||||
ph8 [x]
|
||||
ph8 [y]
|
||||
jsl ~CDIV8
|
||||
pla
|
||||
pla
|
||||
pla
|
||||
pla
|
||||
pl8 [x]
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* procedure add64 (var x: longlong; y: longlong);
|
||||
*
|
||||
* Inputs:
|
||||
* x,y - operands
|
||||
*
|
||||
* Outputs:
|
||||
* x - result
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
add64 start exp
|
||||
|
||||
subroutine (4:x,4:y),0
|
||||
|
||||
ph8 [x]
|
||||
ph8 [y]
|
||||
jsl ~ADD8
|
||||
pl8 [x]
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* procedure sub64 (var x: longlong; y: longlong);
|
||||
*
|
||||
* Inputs:
|
||||
* x,y - operands
|
||||
*
|
||||
* Outputs:
|
||||
* x - result
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
sub64 start exp
|
||||
|
||||
subroutine (4:x,4:y),0
|
||||
|
||||
ph8 [x]
|
||||
ph8 [y]
|
||||
jsl ~SUB8
|
||||
pl8 [x]
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* procedure shl64 (var x: longlong; y: integer);
|
||||
*
|
||||
* Inputs:
|
||||
* x,y - operands
|
||||
*
|
||||
* Outputs:
|
||||
* x - result
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
shl64 start exp
|
||||
|
||||
subroutine (4:x,2:y),0
|
||||
|
||||
ph8 [x]
|
||||
lda y
|
||||
jsl ~SHL8
|
||||
pl8 [x]
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* procedure ashr64 (var x: longlong; y: integer);
|
||||
*
|
||||
* Inputs:
|
||||
* x,y - operands
|
||||
*
|
||||
* Outputs:
|
||||
* x - result
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
ashr64 start exp
|
||||
|
||||
subroutine (4:x,2:y),0
|
||||
|
||||
ph8 [x]
|
||||
lda y
|
||||
jsl ~ASHR8
|
||||
pl8 [x]
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
*
|
||||
* procedure lshr64 (var x: longlong; y: integer);
|
||||
*
|
||||
* Inputs:
|
||||
* x,y - operands
|
||||
*
|
||||
* Outputs:
|
||||
* x - result
|
||||
*
|
||||
****************************************************************
|
||||
*
|
||||
lshr64 start exp
|
||||
|
||||
subroutine (4:x,2:y),0
|
||||
|
||||
ph8 [x]
|
||||
lda y
|
||||
jsl ~LSHR8
|
||||
pl8 [x]
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
111
Expression.pas
111
Expression.pas
@ -269,6 +269,29 @@ function umod (x,y: longint): longint; extern;
|
||||
|
||||
function umul (x,y: longint): longint; extern;
|
||||
|
||||
{-- External 64-bit math routines ------------------------------}
|
||||
{ Procedures for arithmetic and shifts compute "x := x OP y". }
|
||||
|
||||
procedure umul64 (var x: longlong; y: longlong); extern;
|
||||
|
||||
procedure udiv64 (var x: longlong; y: longlong); extern;
|
||||
|
||||
procedure div64 (var x: longlong; y: longlong); extern;
|
||||
|
||||
procedure umod64 (var x: longlong; y: longlong); extern;
|
||||
|
||||
procedure rem64 (var x: longlong; y: longlong); extern;
|
||||
|
||||
procedure add64 (var x: longlong; y: longlong); extern;
|
||||
|
||||
procedure sub64 (var x: longlong; y: longlong); extern;
|
||||
|
||||
procedure shl64 (var x: longlong; y: integer); extern;
|
||||
|
||||
procedure ashr64 (var x: longlong; y: integer); extern;
|
||||
|
||||
procedure lshr64 (var x: longlong; y: integer); extern;
|
||||
|
||||
{---------------------------------------------------------------}
|
||||
|
||||
function Unary(tp: baseTypeEnum): baseTypeEnum;
|
||||
@ -1247,18 +1270,23 @@ var
|
||||
else
|
||||
ekind := longlongconst;
|
||||
|
||||
unsigned := ekind = ulonglongconst;
|
||||
GetLongLongVal(llop1, op^.left^.token);
|
||||
GetLongLongVal(llop2, op^.right^.token);
|
||||
|
||||
case op^.token.kind of
|
||||
barbarop : begin {||}
|
||||
op1 := ord((llop1.lo <> 0) or (llop1.hi <> 0) or
|
||||
(llop2.lo <> 0) or (llop2.hi <> 0));
|
||||
llop1.hi := 0;
|
||||
llop1.lo :=
|
||||
ord((llop1.lo <> 0) or (llop1.hi <> 0) or
|
||||
(llop2.lo <> 0) or (llop2.hi <> 0));
|
||||
ekind := intconst;
|
||||
end;
|
||||
andandop : begin {&&}
|
||||
op1 := ord(((llop1.lo <> 0) or (llop1.hi <> 0)) and
|
||||
((llop2.lo <> 0) or (llop2.hi <> 0)));
|
||||
llop1.hi := 0;
|
||||
llop1.lo :=
|
||||
ord(((llop1.lo <> 0) or (llop1.hi <> 0)) and
|
||||
((llop2.lo <> 0) or (llop2.hi <> 0)));
|
||||
ekind := intconst;
|
||||
end;
|
||||
carotch : begin {^}
|
||||
@ -1274,34 +1302,63 @@ var
|
||||
llop1.hi := llop1.hi & llop2.hi;
|
||||
end;
|
||||
eqeqop : begin {==}
|
||||
op1 := ord((llop1.lo = llop2.lo) and
|
||||
(llop1.hi = llop2.hi));
|
||||
llop1.hi := 0;
|
||||
llop1.lo := ord((llop1.lo = llop2.lo) and
|
||||
(llop1.hi = llop2.hi));
|
||||
ekind := intconst;
|
||||
end;
|
||||
exceqop : begin {!=}
|
||||
op1 := ord((llop1.lo <> llop2.lo) or
|
||||
(llop1.hi <> llop2.hi));
|
||||
llop1.hi := 0;
|
||||
llop1.lo := ord((llop1.lo <> llop2.lo) or
|
||||
(llop1.hi <> llop2.hi));
|
||||
ekind := intconst;
|
||||
end;
|
||||
ltch, {<}
|
||||
gtch, {>}
|
||||
lteqop, {<=}
|
||||
gteqop, {>=}
|
||||
ltltop, {<<}
|
||||
gtgtop, {>>}
|
||||
plusch, {+}
|
||||
minusch, {-}
|
||||
asteriskch, {*}
|
||||
slashch, {/}
|
||||
percentch: begin {%}
|
||||
if kind in [normalExpression,autoInitializerExpression]
|
||||
then goto 1;
|
||||
Error(157);
|
||||
llop1 := longlong0;
|
||||
op1 := 0;
|
||||
if op^.token.kind in [ltch,gtch,lteqop,gteqop] then
|
||||
ekind := intconst;
|
||||
end;
|
||||
gteqop : begin {>=}
|
||||
if kind in [normalExpression,autoInitializerExpression]
|
||||
then goto 1;
|
||||
Error(157);
|
||||
llop1 := longlong0;
|
||||
op1 := 0;
|
||||
if op^.token.kind in [ltch,gtch,lteqop,gteqop] then
|
||||
ekind := intconst;
|
||||
end;
|
||||
ltltop : begin {<<}
|
||||
shl64(llop1, long(llop2.lo).lsw);
|
||||
ekind := kindLeft;
|
||||
end;
|
||||
gtgtop : begin {>>}
|
||||
if kindleft = ulonglongconst then
|
||||
lshr64(llop1, long(llop2.lo).lsw)
|
||||
else
|
||||
ashr64(llop1, long(llop2.lo).lsw);
|
||||
ekind := kindLeft;
|
||||
end;
|
||||
plusch : add64(llop1, llop2); {+}
|
||||
minusch : sub64(llop1, llop2); {-}
|
||||
asteriskch : umul64(llop1, llop2); {*}
|
||||
slashch : begin {/}
|
||||
if (llop2.lo = 0) and (llop2.hi = 0) then begin
|
||||
Error(109);
|
||||
llop2 := longlong1;
|
||||
end; {if}
|
||||
if unsigned then
|
||||
udiv64(llop1, llop2)
|
||||
else
|
||||
div64(llop1, llop2);
|
||||
end;
|
||||
percentch : begin {%}
|
||||
if (llop2.lo = 0) and (llop2.hi = 0) then begin
|
||||
Error(109);
|
||||
llop2 := longlong1;
|
||||
end; {if}
|
||||
if unsigned then
|
||||
umod64(llop1, llop2)
|
||||
else
|
||||
rem64(llop1, llop2);
|
||||
end;
|
||||
otherwise: Error(57);
|
||||
end; {case}
|
||||
|
||||
@ -1314,8 +1371,12 @@ var
|
||||
op^.token.qval := llop1;
|
||||
op^.token.class := longlongConstant;
|
||||
end {if}
|
||||
else if ekind in [longconst,ulongconst] then begin
|
||||
op^.token.lval := llop1.lo;
|
||||
op^.token.class := longConstant;
|
||||
end {if}
|
||||
else begin
|
||||
op^.token.ival := long(op1).lsw;
|
||||
op^.token.ival := long(llop1.lo).lsw;
|
||||
op^.token.class := intConstant;
|
||||
end; {else}
|
||||
goto 1;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user