Support 64-bit decimal constants in code.

This commit is contained in:
Stephen Heumann 2021-02-15 12:28:30 -06:00
parent d66f6b27b7
commit 2e29390e8e
3 changed files with 165 additions and 6 deletions

View File

@ -53,6 +53,54 @@ lb2 iny next character
return 4:val
end
****************************************************************
*
* Convertsll - Convert a string to a long long integer
*
* Inputs:
* qval - pointer to location to save value
* str - pointer to the string
*
* Outputs:
* Saves the value to [qval].
*
* Notes:
* Assumes the string is valid.
*
****************************************************************
*
Convertsll start scanner
disp equ 0 displacement into the string
count equ 2 number of characters remaining to read
subroutine (4:qval,4:str),4
lda [str] set count to length of string
and #$00FF
sta count
lda #1 start reading from character 1
sta disp
ph8 #0 initialize the number to zero
bra lb1a
lb1 ph8 #10 multiply by 10
jsl ~UMUL8
lb1a pea $0000
pea $0000
pea $0000
ldy disp
lda [str],Y add in the new digit
and #$000F
pha
jsl ~ADD8
lb2 inc disp next character
dec count
bne lb1
pl8 [qval] save the value
return
end
****************************************************************
*
* KeyPress - Has a key been pressed?

View File

@ -529,3 +529,110 @@
dc i4'&p'
~restm
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
aif "&c"<>"<",.c1
pei &n1+6
pei &n1+4
pei &n1+2
pei &n1
ago .e
.c1
ldx #6
~&SYSCNT lda &n1,x
pha
dex
dex
bpl ~&SYSCNT
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-48
pea +(&n1)|-32
pea +(&n1)|-16
pea &n1
.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

View File

@ -414,6 +414,11 @@ function Convertsl(var str: pString): longint; extern;
{ Return the integer equivalent of the string. Assumes a valid }
{ 4-byte integer string; supports unsigned values. }
procedure Convertsll(var qval: longlong; var str: pString); extern;
{ Save the integer equivalent of the string to qval. Assumes a }
{ valid 8-byte integer string; supports unsigned values. }
procedure SetDateTime; extern;
@ -3356,22 +3361,21 @@ else if numString[1] <> '0' then begin {convert a decimal integer}
or (not unsigned and (stringIndex = 10) and (numString > '2147483647'))
or (unsigned and (stringIndex = 10) and (numString > '4294967295')) then
isLongLong := true;
if (stringIndex > 10) or {TODO increase limits}
((stringIndex = 10) and (numString > '4294967295')) then begin
if (not unsigned and ((stringIndex > 19) or
((stringIndex = 19) and (numString > '9223372036854775807')))) or
(unsigned and ((stringIndex > 20) or
((stringIndex = 20) and (numString > '18446744073709551615')))) then begin
numString := '0';
if flagOverflows then
FlagError(6);
end; {if}
if isLongLong then begin
token.class := longlongConstant;
token.qval.hi := 0;
token.qval.lo := Convertsl(numString); {TODO support full 64-bit range}
Convertsll(token.qval, numString);
if unsigned then
token.kind := ulonglongConst
else begin
token.kind := longlongConst;
if token.qval.hi < 0 then
FlagError(6);
end; {else}
end {if}
else if isLong then begin