Apple-2gs-SW/ORCA-C
1
0
Fork 0
mirror of https://github.com/byteworksinc/ORCA-C.git synced 2024-12-21 16:29:31 +00:00
Code Issues Projects Releases Wiki Activity
06e17cd8f5
ORCA-C/Expression.asm

941 lines
19 KiB
NASM
Raw Normal View History

Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
mcopy exp.macros
****************************************************************
*
* function lshr(x,y: longint): longint;
*
* Inputs:
* num1 - number to shift
* num2 - # bits to shift by
*
* Outputs:
* A - result
*
****************************************************************
*
Move some code from the blank segment to named load segments. This frees up some space in the blank segment for more static data.
2017-06-19 03:07:32 +00:00
lshr start exp
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
subroutine (4:num1,4:num2),0
lda num2+2 if num2 < 0 then
bpl lb2
cmp #$FFFF shift left
bne zero
ldx num2
cpx #-34
blt zero
lb1 asl num1
rol num1+2
inx
bne lb1
bra lb4
zero stz num1 (result is zero)
stz num1+2
bra lb4
lb2 bne zero else shift right
ldx num2
beq lb4
cpx #33
bge zero
lb3 lsr num1+2
ror num1
dex
bne lb3
lb4 lda 0 fix stack and return
sta num2
lda 2
sta num2+2
return 4:num1
end
****************************************************************
*
* function udiv(x,y: longint): longint;
*
* Inputs:
* num1 - numerator
* num2 - denominator
*
* Outputs:
* ans - result
*
****************************************************************
*
Move some code from the blank segment to named load segments. This frees up some space in the blank segment for more static data.
2017-06-19 03:07:32 +00:00
udiv start exp
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
ans equ 0 answer
rem equ 4 remainder
subroutine (4:num1,4:num2),8
;
; Initialize
;
stz rem rem = 0
stz rem+2
move4 num1,ans ans = num1
lda num2 check for division by zero
ora num2+2
beq dv9
lda num2+2 do 16 bit divides separately
ora ans+2
beq dv5
;
; 32 bit divide
;
ldy #32 32 bits to go
dv3 asl ans roll up the next number
rol ans+2
rol ans+4
rol ans+6
sec subtract for this digit
lda ans+4
Fix bug in unsigned 32-bit division and remainder routines, which could cause mis-evaluation of constant expressions. The following example shows cases that were mis-evaluated: /* Should print "3 10000" */ #include <stdio.h> int main(void) { printf("%lu %lu\n", 100000ul / 30000ul, 100000ul % 30000ul); }
2016-12-19 04:52:53 +00:00
sbc num2
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
tax
lda ans+6
sbc num2+2
bcc dv4 branch if minus
stx ans+4 turn the bit on
sta ans+6
inc ans
dv4 dey next bit
bne dv3
bra dv9 go do the sign
;
; 16 bit divide
;
dv5 lda #0 initialize the remainder
ldy #16 16 bits to go
dv6 asl ans roll up the next number
rol a
sec subtract the digit
sbc num2
bcs dv7
adc num2 digit is 0
dey
bne dv6
bra dv8
dv7 inc ans digit is 1
dey
bne dv6
dv8 sta ans+4 save the remainder
;
; Return the result
;
dv9 return 4:ans move answer
end
****************************************************************
*
* function uge(x,y: longint): cboolean;
*
****************************************************************
*
Move some code from the blank segment to named load segments. This frees up some space in the blank segment for more static data.
2017-06-19 03:07:32 +00:00
uge start exp
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
result equ 0
subroutine (4:x,4:y),4
stz result
stz result+2
lda x+2
cmp y+2
bne lb1
lda x
cmp y
lb1 blt lb2
Fix to make statically-evaluated unsigned comparisons evaluate to 1 if true. Previously, they evaluated to -1. The following example shows the problem: #include <stdio.h> int main(void) { printf("%i\n", 0U <= 5U); }
2016-12-19 20:02:26 +00:00
inc result
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
lb2 return 2:result
end
****************************************************************
*
* function ugt(x,y: longint): cboolean;
*
****************************************************************
*
Move some code from the blank segment to named load segments. This frees up some space in the blank segment for more static data.
2017-06-19 03:07:32 +00:00
ugt start exp
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
result equ 0
subroutine (4:x,4:y),4
stz result
stz result+2
lda x+2
cmp y+2
bne lb1
lda x
cmp y
lb1 ble lb2
Fix to make statically-evaluated unsigned comparisons evaluate to 1 if true. Previously, they evaluated to -1. The following example shows the problem: #include <stdio.h> int main(void) { printf("%i\n", 0U <= 5U); }
2016-12-19 20:02:26 +00:00
inc result
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
lb2 return 2:result
end
****************************************************************
*
* function ule(x,y: longint): cboolean;
*
****************************************************************
*
Move some code from the blank segment to named load segments. This frees up some space in the blank segment for more static data.
2017-06-19 03:07:32 +00:00
ule start exp
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
result equ 0
subroutine (4:x,4:y),4
stz result
stz result+2
lda x+2
cmp y+2
bne lb1
lda x
cmp y
lb1 bgt lb2
Fix to make statically-evaluated unsigned comparisons evaluate to 1 if true. Previously, they evaluated to -1. The following example shows the problem: #include <stdio.h> int main(void) { printf("%i\n", 0U <= 5U); }
2016-12-19 20:02:26 +00:00
inc result
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
lb2 return 2:result
end
****************************************************************
*
* function ult(x,y: longint): cboolean;
*
****************************************************************
*
Move some code from the blank segment to named load segments. This frees up some space in the blank segment for more static data.
2017-06-19 03:07:32 +00:00
ult start exp
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
result equ 0
subroutine (4:x,4:y),4
stz result
stz result+2
lda x+2
cmp y+2
bne lb1
lda x
cmp y
lb1 bge lb2
Fix to make statically-evaluated unsigned comparisons evaluate to 1 if true. Previously, they evaluated to -1. The following example shows the problem: #include <stdio.h> int main(void) { printf("%i\n", 0U <= 5U); }
2016-12-19 20:02:26 +00:00
inc result
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
lb2 return 2:result
end
****************************************************************
*
* function umod(x,y: longint): longint;
*
* Inputs:
* num1 - numerator
* num2 - denominator
*
* Outputs:
* ans+4 - result
*
****************************************************************
*
Move some code from the blank segment to named load segments. This frees up some space in the blank segment for more static data.
2017-06-19 03:07:32 +00:00
umod start exp
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
ans equ 0 answer
rem equ 4 remainder
subroutine (4:num1,4:num2),8
;
; Initialize
;
stz rem rem = 0
stz rem+2
move4 num1,ans ans = num1
lda num2 check for division by zero
ora num2+2
beq dv9
lda num2+2 do 16 bit divides separately
ora ans+2
beq dv5
;
; 32 bit divide
;
ldy #32 32 bits to go
dv3 asl ans roll up the next number
rol ans+2
rol ans+4
rol ans+6
sec subtract for this digit
lda ans+4
Fix bug in unsigned 32-bit division and remainder routines, which could cause mis-evaluation of constant expressions. The following example shows cases that were mis-evaluated: /* Should print "3 10000" */ #include <stdio.h> int main(void) { printf("%lu %lu\n", 100000ul / 30000ul, 100000ul % 30000ul); }
2016-12-19 04:52:53 +00:00
sbc num2
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
tax
lda ans+6
sbc num2+2
bcc dv4 branch if minus
stx ans+4 turn the bit on
sta ans+6
inc ans
dv4 dey next bit
bne dv3
bra dv9 go do the sign
;
; 16 bit divide
;
dv5 lda #0 initialize the remainder
ldy #16 16 bits to go
dv6 asl ans roll up the next number
rol a
sec subtract the digit
sbc num2
bcs dv7
adc num2 digit is 0
dey
bne dv6
bra dv8
dv7 inc ans digit is 1
dey
bne dv6
dv8 sta ans+4 save the remainder
;
; Return the result
;
dv9 return 4:ans+4 move answer
end
****************************************************************
*
* function umul(x,y: longint): longint;
*
* Inputs:
* num2,num1 - operands
*
* Outputs:
* ans - result
*
****************************************************************
*
Move some code from the blank segment to named load segments. This frees up some space in the blank segment for more static data.
2017-06-19 03:07:32 +00:00
umul start exp
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
ans equ 0 answer
subroutine (4:num1,4:num2),8
;
; Initialize the sign and split on precision.
;
stz ans+4 set up the multiplier
stz ans+6
lda num1
sta ans
lda num1+2
sta ans+2
beq ml3 branch if the multiplier is 16 bit
;
; Do a 32 bit by 32 bit multiply.
;
ldy #32 32 bit multiply
jsr ml1
brl ml7
ml1 lda ans SYSS1*SYSS1+2+SYSS1+2 -> SYSS1,SYSS1+2
lsr a
bcc ml2
clc add multiplicand to the partial product
lda ans+4
adc num2
sta ans+4
lda ans+6
adc num2+2
sta ans+6
Spellcheck comments throughout the code. There are no non-comment changes.
2020-01-29 23:09:52 +00:00
ml2 ror ans+6 shift the interim result
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
ror ans+4
ror ans+2
ror ans
dey loop til done
bne ml1
rts
;
; Do and 16 bit by 32 bit multiply.
;
ml3 lda num2+2 branch if 16x16 is possible
beq ml4
ldy #16 set up for 16 bits
jsr ml1 do the multiply
lda ans+2 move the answer
sta ans
lda ans+4
sta ans+2
bra ml7
;
; Do a 16 bit by 16 bit multiply.
;
ml4 ldy #16 set the 16 bit counter
ldx ans move the low word
stx ans+2
ml5 lsr ans+2 test the bit
bcc ml6 branch if the bit is off
clc
adc num2
ml6 ror a shift the answer
ror ans
dey loop
bne ml5
sta ans+2 save the high word
;
; Return the result.
;
ml7 return 4:ans fix the stack
end
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.
2021-02-15 02:39:22 +00:00
****************************************************************
*
* 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
Evaluate 64-bit comparisons in constant expressions.
2021-02-17 05:11:41 +00:00
****************************************************************
*
* 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
Reference in New Issue Copy Permalink