Apple-2gs-SW
/
ORCA-C
mirror of https://github.com/byteworksinc/ORCA-C.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Evaluate 64-bit comparisons in constant expressions.

This commit is contained in:
Stephen Heumann 2021-02-16 23:11:41 -06:00
parent e3b24fb50b
commit 955ee74b25
2 changed files with 346 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

300
Expression.asm
View File

@ -638,3 +638,303 @@ lshr64 start exp
return
end
****************************************************************
*
* function ult64(a,b: longlong): integer;
*
****************************************************************
*
ult64 start exp
result equ 0
subroutine (4:a,4:b),2
stz result
ldy #6
lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
lda [a]
cmp [b]
lb1 bge lb2
inc result
lb2 return 2:result
end
****************************************************************
*
* function uge64(a,b: longlong): integer;
*
****************************************************************
*
uge64 start exp
result equ 0
subroutine (4:a,4:b),2
stz result
ldy #6
lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
lda [a]
cmp [b]
lb1 blt lb2
inc result
lb2 return 2:result
end
****************************************************************
*
* function ule64(a,b: longlong): integer;
*
****************************************************************
*
ule64 start exp
result equ 0
subroutine (4:a,4:b),2
stz result
ldy #6
lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
lda [a]
cmp [b]
lb1 bgt lb2
inc result
lb2 return 2:result
end
****************************************************************
*
* function ugt64(a,b: longlong): integer;
*
****************************************************************
*
ugt64 start exp
result equ 0
subroutine (4:a,4:b),2
stz result
ldy #6
lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
lda [a]
cmp [b]
lb1 ble lb2
inc result
lb2 return 2:result
end
****************************************************************
*
* function slt64(a,b: longlong): integer;
*
****************************************************************
*
slt64 start exp
result equ 0
subroutine (4:a,4:b),2
stz result
ldy #6
lda [a],y
eor [b],y
bpl lb0
lda [b],y
cmp [a],y
bra lb1
lb0 lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
lda [a]
cmp [b]
lb1 bge lb2
inc result
lb2 return 2:result
end
****************************************************************
*
* function sge64(a,b: longlong): integer;
*
****************************************************************
*
sge64 start exp
result equ 0
subroutine (4:a,4:b),2
stz result
ldy #6
lda [a],y
eor [b],y
bpl lb0
lda [b],y
cmp [a],y
bra lb1
lb0 lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
lda [a]
cmp [b]
lb1 blt lb2
inc result
lb2 return 2:result
end
****************************************************************
*
* function sle64(a,b: longlong): integer;
*
****************************************************************
*
sle64 start exp
result equ 0
subroutine (4:a,4:b),2
stz result
ldy #6
lda [a],y
eor [b],y
bpl lb0
lda [b],y
cmp [a],y
bra lb1
lb0 lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
lda [a]
cmp [b]
lb1 bgt lb2
inc result
lb2 return 2:result
end
****************************************************************
*
* function sgt64(a,b: longlong): integer;
*
****************************************************************
*
sgt64 start exp
result equ 0
subroutine (4:a,4:b),2
stz result
ldy #6
lda [a],y
eor [b],y
bpl lb0
lda [b],y
cmp [a],y
bra lb1
lb0 lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
dey
dey
lda [a],y
cmp [b],y
bne lb1
lda [a]
cmp [b]
lb1 ble lb2
inc result
lb2 return 2:result
end

56
Expression.pas
View File

@ -292,6 +292,22 @@ procedure ashr64 (var x: longlong; y: integer); extern;
procedure lshr64 (var x: longlong; y: integer); extern;
function ult64(a,b: longlong): integer; extern;
function uge64(a,b: longlong): integer; extern;
function ule64(a,b: longlong): integer; extern;
function ugt64(a,b: longlong): integer; extern;
function slt64(a,b: longlong): integer; extern;
function sge64(a,b: longlong): integer; extern;
function sle64(a,b: longlong): integer; extern;
function sgt64(a,b: longlong): integer; extern;
{---------------------------------------------------------------}
function Unary(tp: baseTypeEnum): baseTypeEnum;
@ -1313,17 +1329,37 @@ var
(llop1.hi <> llop2.hi));
ekind := intconst;
end;
ltch, {<}
gtch, {>}
lteqop, {<=}
ltch : begin {<}
if unsigned then
llop1.lo := ult64(llop1, llop2)
else
llop1.lo := slt64(llop1, llop2);
llop1.hi := 0;
ekind := intconst;
end;
gtch : begin {>}
if unsigned then
llop1.lo := ugt64(llop1, llop2)
else
llop1.lo := sgt64(llop1, llop2);
llop1.hi := 0;
ekind := intconst;
end;
lteqop : begin {<=}
if unsigned then
llop1.lo := ule64(llop1, llop2)
else
llop1.lo := sle64(llop1, llop2);
llop1.hi := 0;
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;
if unsigned then
llop1.lo := uge64(llop1, llop2)
else
llop1.lo := sge64(llop1, llop2);
llop1.hi := 0;
ekind := intconst;
end;
ltltop : begin {<<}
shl64(llop1, long(llop2.lo).lsw);