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

Merge branch 'master' into gno-version

This commit is contained in:
Stephen Heumann 2023-07-03 17:09:25 -05:00
parent b6bab6df80 3f70daed7d
commit 2f79cf3f3a
13 changed files with 174 additions and 5858 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Makefile
View File

@ -10,8 +10,7 @@
LIB = orca
SRCS = cc.asm ctype.asm orca.asm signal2.c stdlib.asm string.asm \
time.asm toolglue.asm vars.asm int64.asm fenv.asm fpextra.asm \
math2.asm locale.asm uchar.asm
time.asm toolglue.asm vars.asm int64.asm locale.asm uchar.asm
buildall .PHONY: build assert.o

361
fenv.asm
View File

@ -1,361 +0,0 @@
keep obj/fenv
mcopy fenv.macros
case on
****************************************************************
*
* Fenv - Floating-point environment access
*
* This code provides routines to query and modify the
* floating-point environment.
*
* Note: This relies on and only works with SANE.
*
****************************************************************
*
fenv private dummy segment
end
FE_ALL_EXCEPT gequ $001F
****************************************************************
*
* int feclearexcept(int excepts);
*
* Clear floating-point exceptions
*
* Inputs:
* excepts - floating-point exceptions to clear
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
feclearexcept start
csubroutine (2:excepts),0
FGETENV get current environment
phx
lda excepts
and #FE_ALL_EXCEPT
eor #$FFFF mask off excepts to clear
xba
and 1,S
sta 1,S
FSETENV clear them
creturn 2:#0
end
****************************************************************
*
* int fegetexceptflag(fexcept_t *flagp, int excepts);
*
* Get floating-point exception flags.
*
* Inputs:
* flagp - pointer to location to store exception flags
* excepts - floating-point exceptions to get
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
fegetexceptflag start
csubroutine (4:flagp,2:excepts),0
FGETENV get current environment
tya
and excepts get desired exceptions
and #FE_ALL_EXCEPT
sta [flagp] store them in *flagp
creturn 2:#0
end
****************************************************************
*
* int feraiseexcept(int excepts);
*
* Raise floating-point exceptions
*
* Inputs:
* excepts - floating-point exceptions to raise
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
feraiseexcept start
csubroutine (2:excepts),0
lda excepts
and #FE_ALL_EXCEPT
beq done
pha
FSETXCP raise exceptions
done creturn 2:#0
end
****************************************************************
*
* int fesetexceptflag(fexcept_t *flagp, int excepts);
*
* Set (but do not raise) floating-point exception flags
*
* Inputs:
* flagp - pointer to stored exception flags
* excepts - floating-point exceptions to set
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
fesetexceptflag start
csubroutine (4:flagp,2:excepts),0
FGETENV get env with excepts masked off
phx
lda excepts
and #FE_ALL_EXCEPT
eor #$FFFF
xba
and 1,S
sta 1,S
lda [flagp] set new exceptions
and excepts
and #FE_ALL_EXCEPT
xba
ora 1,S
sta 1,S
FSETENV
creturn 2:#0
end
****************************************************************
*
* int fetestexcept(int excepts);
*
* Test if floating-point exception flags are set
*
* Inputs:
* excepts - floating-point exceptions to test for
*
* Outputs:
* Bitwise or of exceptions that are set
*
****************************************************************
*
fetestexcept start
csubroutine (2:excepts),0
FGETENV get exception flags
tya
and excepts mask to just the ones we want
and #FE_ALL_EXCEPT
sta excepts
creturn 2:excepts
end
****************************************************************
*
* int fegetround(void);
*
* Get the current rounding direction
*
* Outputs:
* The current rounding direction
*
****************************************************************
*
fegetround start
FGETENV get high word of environment
tya
and #$00C0 just rounding direction
rtl
end
****************************************************************
*
* int fesetround(int round);
*
* Set the current rounding direction
*
* Inputs:
* round - the rounding direction to set
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
fesetround start
csubroutine (2:round),0
lda round flip words
xba
sta round
and #$3FFF do nothing if not a valid rounding dir
bne done
FGETENV set the rounding direction
txa
and #$3FFF
ora round
pha
FSETENV
stz round
done creturn 2:round
end
****************************************************************
*
* int fegetenv(fenv_t *envp);
*
* Get the current floating-point environment
*
* Inputs:
* envp - pointer to location to store environment
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
fegetenv start
csubroutine (4:envp),0
FGETENV get the environment
txa
sta [envp] store it in *envp
creturn 2:#0
end
****************************************************************
*
* int feholdexcept(fenv_t *envp);
*
* Get environment, then clear status flags and disable halts
*
* Inputs:
* envp - pointer to location to store environment
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
feholdexcept start
csubroutine (4:envp),0
FGETENV get the environment
txa
sta [envp] store it in *envp
and #$E0E0 clear exception flags and disable halts
pha
FSETENV set the new environment
creturn 2:#0
end
****************************************************************
*
* int fesetenv(const fenv_t *envp);
*
* Set the floating-point environment
*
* Inputs:
* envp - pointer to environment to set
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
fesetenv start
csubroutine (4:envp),0
lda [envp] set the environment
pha
FSETENV
creturn 2:#0
end
****************************************************************
*
* int feupdateenv(const fenv_t *envp);
*
* Save exceptions, set environment, then re-raise exceptions
*
* Inputs:
* envp - pointer to environment to set
*
* Outputs:
* Returns 0 if successful, non-zero otherwise
*
****************************************************************
*
feupdateenv start
csubroutine (4:envp),0
lda [envp] set the environment
pha
FPROCEXIT
creturn 2:#0
end
****************************************************************
*
* Default floating-point environment
*
****************************************************************
*
__FE_DFL_ENV start
dc i2'0'
end
****************************************************************
*
* int __get_flt_rounds(void);
*
* Get the value of FLT_ROUNDS, accounting for rounding mode
*
* Outputs:
* Current value of FLT_ROUNDS
*
****************************************************************
*
__get_flt_rounds start
FGETENV
tya get rounding direction in low bits of A
asl a
asl a
xba
inc a convert to values used by FLT_ROUNDS
and #$0003
rtl
end

117
fenv.macros
View File

@ -1,117 +0,0 @@
MACRO
&lab csubroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta 1
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+4+&work
&totallen seta &totallen+&len
&i seta &i+1
aif &i<=c:&parms,^b
.e
tsc
aif &work=0,.f
sec
sbc #&work
tcs
.f
phd
tcd
mend
MACRO
&lab creturn &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+2
sta &worklen+&totallen+2
lda &worklen+1
sta &worklen+&totallen+1
.i
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&LAB FGETENV
&LAB PEA $03
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSETENV
&LAB PEA $01
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSETXCP
&LAB PEA $15
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FPROCEXIT
&LAB PEA $19
LDX #$090A
JSL $E10000
MEND

116
fpextra.asm
View File

@ -1,116 +0,0 @@
keep obj/fpextra
mcopy fpextra.macros
****************************************************************
*
* FPextra - extra floating-point routines
*
* This code provides routines dealing with floating-point
* numbers that are used only by ORCA/C, supplementing the
* ones in SysFloat.
*
****************************************************************
*
fpextra private dummy segment
end
****************************************************************
*
* ~SinglePrecision - limit fp value to single precision & range
*
* Inputs:
* extended-format real on stack
*
****************************************************************
*
~SinglePrecision start
tsc
clc
adc #4
ldy #0
phy
pha
phy
pha
phy
pha
phy
pha
FX2S
FS2X
rtl
end
****************************************************************
*
* ~DoublePrecision - limit fp value to double precision & range
*
* Inputs:
* extended-format real on stack
*
****************************************************************
*
~DoublePrecision start
tsc
clc
adc #4
ldy #0
phy
pha
phy
pha
phy
pha
phy
pha
FX2D
FD2X
rtl
end
****************************************************************
*
* ~CompPrecision - limit fp value to comp precision & range
*
* Inputs:
* extended-format real on stack
*
* Note: This avoids calling FX2C on negative numbers,
* because it is buggy for certain values.
*
****************************************************************
*
~CompPrecision start
tsc round to integer
clc
adc #4
pea 0
pha
FRINTX
lda 4+8,s
pha save original sign
asl a force sign to positive
lsr a
sta 6+8,s
tsc limit precision
clc
adc #6
ldy #0
phy
pha
phy
pha
phy
pha
phy
pha
FX2C
FC2X
pla restore original sign
bpl ret
lda 4+8,s
ora #$8000
sta 4+8,s
ret rtl
end

42
fpextra.macros
View File

@ -1,42 +0,0 @@
MACRO
&LAB FX2S
&LAB PEA $0210
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2D
&LAB PEA $0110
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2C
&LAB PEA $0510
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FC2X
&LAB PEA $050E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FD2X
&LAB PEA $010E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FS2X
&LAB PEA $020E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FRINTX
&LAB PEA $0014
LDX #$090A
JSL $E10000
MEND

270
int64.asm
View File

@ -515,273 +515,3 @@ loop1 asl num1 do the remaining shift
rt0 pld
rtl rtl
end
****************************************************************
*
* ~CnvULongLongReal - convert an unsigned long long integer
* into an extended SANE real
*
* Inputs:
* unsigned long long int on stack
*
* Outputs:
* extended real on stack
*
****************************************************************
*
~CnvULongLongReal start
mantissa equ 4 mantissa (integer and fraction)
exponent equ mantissa+8 biased exponent and sign bit
lda 1,S move return value
pha
lda 4,S
sta 2,S
tsc set up DP
phd
tcd
lda mantissa+2 move 64-bit value to mantissa
sta mantissa
lda mantissa+4
sta mantissa+2
lda mantissa+6
sta mantissa+4
lda mantissa+8
sta mantissa+6
ora mantissa if value is 0 then
ora mantissa+2
ora mantissa+4
beq ret return
lda #63+16383 set initial exponent (2^63) and sign
sta exponent
lda mantissa+6 if number is normalized (i=1) then
bmi ret return
lp1 dec exponent normalize number
asl mantissa
rol mantissa+2
rol mantissa+4
rol mantissa+6
bpl lp1
ret pld
rtl
end
****************************************************************
*
* ~CnvLongLongReal - convert a long long integer into
* an extended SANE real
*
* Inputs:
* signed long long int on stack
*
* Outputs:
* extended real on stack
*
****************************************************************
*
~CnvLongLongReal start
mantissa equ 4 mantissa (integer and fraction)
exponent equ mantissa+8 biased exponent and sign bit
lda 1,S move return value
pha
lda 4,S
sta 2,S
tsc set up DP
phd
tcd
lda mantissa+2 move 64-bit value to mantissa
sta mantissa
lda mantissa+4
sta mantissa+2
lda mantissa+6
sta mantissa+4
lda mantissa+8
sta mantissa+6
ora mantissa if value is 0 then
ora mantissa+2
ora mantissa+4
beq ret return
ldy #0 default sign bit is 0 (positive)
lda mantissa+6 if mantissa is negative then
bpl lb0
negate8 mantissa negate it
ldy #$8000 sign bit is 1 (negative)
lb0 tya set sign
ora #63+16383 set initial exponent (2^63)
sta exponent
lda mantissa+6 if number is normalized (i=1) then
bmi ret return
lp1 dec exponent normalize number
asl mantissa
rol mantissa+2
rol mantissa+4
rol mantissa+6
bpl lp1
ret pld
rtl
end
****************************************************************
*
* ~CnvRealLongLong - convert an extended SANE real into
* a long long integer
*
* Inputs:
* extended real on stack
*
* Outputs:
* signed long long int on stack
*
* Note: This avoids calling FX2C on negative numbers,
* because it is buggy for certain values.
*
****************************************************************
*
~CnvRealLongLong start
tsc
clc
adc #4
pea 0 push src address for fcpxx
pha
pea llmin|-16 push dst address for fcpxx
pea llmin
pea 0 push operand address for ftintx
pha
ftintx round
fcpxx compare with LLONG_MIN
bne convert
lda #$8000 if it is LONG_MIN, use that value
sta 12,s
asl a
sta 10,s
sta 8,s
sta 6,s
bra done otherwise
convert lda 4+8,s
pha save original sign
asl a force sign to positive
lsr a
sta 6+8,s
tsc
clc
adc #6
pea 0 push src address for fx2c
pha
pea 0 push dst address for fx2c
inc a
inc a
pha
fx2c convert
pla if original value was negative
bpl done
sec
ldx #0 negate result
txa
sbc 6,s
sta 6,s
txa
sbc 6+2,s
sta 6+2,s
txa
sbc 6+4,s
sta 6+4,s
txa
sbc 6+6,s
sta 6+6,s
done phb move return address
pla
plx
ply
phx
pha
plb
rtl
llmin dc e'-9223372036854775808'
end
****************************************************************
*
* ~CnvRealULongLong - convert an extended SANE real into
* an unsigned long long integer
*
* Inputs:
* extended real on stack
*
* Outputs:
* unsigned long long int on stack
*
****************************************************************
*
~CnvRealULongLong start
pea 0 initially assume val <= LLONG_MAX
tsc
clc
adc #6
pea 0 push src address for fcpxx
pha
pea llbig|-16 push dst address for fcpxx
pea llbig
pea 0 push operand address for ftintx
pha
ftintx round
fcpxx compare with LLONG_MAX+1
bmi convert
lda #1 if val > LLONG_MAX:
sta 1,S save flag to indicate this
tsc
clc
adc #6
pea llbig|-16 push src address for fsubx
pea llbig
pea 0 push dst address for fsubx
pha
fsubx val -= LLONG_MAX+1
convert tsc
clc
adc #6
pea 0 push src address for fx2c
pha
pea 0 push dst address for fx2c
inc a
inc a
pha
fx2c convert val as comp
pla if orig val was > LLONG_MAX:
beq done
lda 12,s
eor #$8000
sta 12,s result += LLONG_MAX+1
done phb move return address
pla
plx
ply
phx
pha
plb
rtl
llbig dc e'9223372036854775808'
end

43
int64.macros
View File

@ -1,23 +1,4 @@
macro
&l negate8 &n1
&l ~setm
sec
ldy #0
tya
sbc &n1
sta &n1
tya
sbc &n1+2
sta &n1+2
tya
sbc &n1+4
sta &n1+4
tya
sbc &n1+6
sta &n1+6
~restm
mend
macro
&l move4 &m1,&m2
lclb &yistwo
&l ~setm
@ -140,27 +121,3 @@
.d
sta 2+&op
mend
MACRO
&LAB FTINTX
&LAB PEA $0016
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2C
&LAB PEA $0510
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCPXX
&LAB PEA $0A
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSUBX
&LAB PEA 2
LDX #$090A
JSL $E10000
MEND

4
make
View File

@ -19,7 +19,7 @@ if {#} == 0
unset exit
end
for i in cc ctype string stdlib time setjmp orca fcntl vars toolglue signal int64 fenv fpextra math2 locale uchar
for i in cc ctype string stdlib time setjmp orca fcntl vars toolglue signal int64 locale uchar
Newer obj/{i}.a {i}.asm
if {Status} != 0
set exit on
@ -40,7 +40,7 @@ delete orcalib
set list vars.a assert.a cc.a setjmp.a ctype.a string.a stdlib.a
set list {list} time.a signal.a toolglue.a orca.a fcntl.a stdio.a int64.a
set list {list} fenv.a fpextra.a math2.a locale.a uchar.a
set list {list} locale.a uchar.a
for i in {list}
echo makelib orcalib +obj/{i}
makelib orcalib +obj/{i}

3890
math2.asm
View File

File diff suppressed because it is too large Load Diff

750
math2.macros
View File

@ -1,750 +0,0 @@
macro
&l ph4 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab csubroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta 1
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+4+&work
&totallen seta &totallen+&len
&i seta &i+1
aif &i<=c:&parms,^b
.e
tsc
aif &work=0,.f
sec
sbc #&work
tcs
.f
phd
tcd
mend
MACRO
&lab creturn &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+2
sta &worklen+&totallen+2
lda &worklen+1
sta &worklen+&totallen+1
.i
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
macro
&l cmp4 &n1,&n2
lclb &yistwo
&l ~setm
~lda.h &n1
~op.h eor,&n2
bpl ~a&SYSCNT
~lda.h &n2
~op.h cmp,&n1
bra ~b&SYSCNT
~a&SYSCNT ~lda.h &n1
~op.h cmp,&n2
bne ~b&SYSCNT
~lda &n1
~op cmp,&n2
~b&SYSCNT anop
~restm
mend
macro
&l ~lda &op
lclc &c
&c amid "&op",1,1
aif "&c"<>"{",.b
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
&l lda &op
mend
macro
&l ~lda.h &op
&l anop
lclc &c
&c amid "&op",1,1
aif "&c"="[",.b
aif "&c"<>"{",.d
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
aif &yistwo,.c
&yistwo setb 1
ldy #2
.c
&op setc "&op,y"
lda &op
mexit
.d
aif "&c"<>"#",.e
&op amid "&op",2,l:&op-1
&op setc "#^&op"
lda &op
mexit
.e
lda 2+&op
mend
macro
&l ~op &opc,&op
lclc &c
&c amid "&op",1,1
aif "&c"<>"{",.b
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
&l &opc &op
mend
macro
&l ~op.h &opc,&op
&l anop
lclc &c
&c amid "&op",1,1
aif "&c"="[",.b
aif "&c"<>"{",.d
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
aif &yistwo,.c
&yistwo setb 1
ldy #2
.c
&op setc "&op,y"
&opc &op
mexit
.d
aif "&c"<>"#",.e
&op amid "&op",2,l:&op-1
&op setc "#^&op"
&opc &op
mexit
.e
&opc 2+&op
mend
macro
&l ~restm
&l anop
aif (&~la+&~li)=2,.i
sep #32*(.not.&~la)+16*(.not.&~li)
aif &~la,.h
longa off
.h
aif &~li,.i
longi off
.i
mend
macro
&l ~setm
&l anop
aif c:&~la,.b
gblb &~la
gblb &~li
.b
&~la setb s:longa
&~li setb s:longi
aif s:longa.and.s:longi,.a
rep #32*(.not.&~la)+16*(.not.&~li)
longa on
longi on
.a
mend
macro
&l inc4 &a
&l ~setm
inc &a
bne ~&SYSCNT
inc 2+&a
~&SYSCNT ~restm
mend
macro
&l sub4 &m1,&m2,&m3
lclb &yistwo
lclc &c
&l ~setm
aif c:&m3,.a
&c amid "&m2",1,1
aif "&c"<>"#",.a
&c amid "&m1",1,1
aif "&c"="{",.a
aif "&c"="[",.a
&c amid "&m2",2,l:&m2-1
aif &c>=65536,.a
sec
~lda &m1
~op sbc,&m2
~sta &m1
bcs ~&SYSCNT
~op.h dec,&m1
~&SYSCNT anop
ago .c
.a
aif c:&m3,.b
lclc &m3
&m3 setc &m1
.b
sec
~lda &m1
~op sbc,&m2
~sta &m3
~lda.h &m1
~op.h sbc,&m2
~sta.h &m3
.c
~restm
mend
macro
&l ~sta &op
lclc &c
&c amid "&op",1,1
aif "&c"<>"{",.b
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
&l sta &op
mend
macro
&l ~sta.h &op
&l anop
lclc &c
&c amid "&op",1,1
aif "&c"="[",.b
aif "&c"<>"{",.d
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
aif &yistwo,.c
&yistwo setb 1
ldy #2
.c
&op setc "&op,y"
sta &op
mexit
.d
sta 2+&op
mend
macro
&l cmpl &n1,&n2
lclb &yistwo
&l ~setm
~lda.h &n1
~op.h cmp,&n2
bne ~a&SYSCNT
~lda &n1
~op cmp,&n2
~a&SYSCNT anop
~restm
mend
macro
&l jmi &bp
&l bpl *+5
brl &bp
mend
macro
&l jpl &bp
&l bmi *+5
brl &bp
mend
macro
&l jeq &bp
&l bne *+5
brl &bp
mend
MACRO
&LAB FCLASSS
&LAB PEA $021C
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCLASSD
&LAB PEA $011C
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCLASSX
&LAB PEA $001C
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2S
&LAB PEA $0210
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2D
&LAB PEA $0110
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCMPX
&LAB PEA $0008
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FEXP2X
&LAB PEA $000A
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FEXP1X
&LAB PEA $000C
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FLN1X
&LAB PEA $0004
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FLOG2X
&LAB PEA $0002
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FLOGBX
&LAB PEA $001A
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2I
&LAB PEA $0410
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FTINTX
&LAB PEA $0016
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FRINTX
&LAB PEA $0014
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FXPWRY
&LAB PEA $0012
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FREMX
&LAB PEA $000C
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSCALBX
&LAB PEA $0018
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSUBX
&LAB PEA $0002
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FGETENV
&LAB PEA $03
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSETENV
&LAB PEA $01
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2C
&LAB PEA $0510
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCPXX
&LAB PEA $0A
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FNEXTX
&LAB PEA $001E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FX2X
&LAB PEA $0010
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCPXD
&LAB PEA $010A
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FNEXTD
&LAB PEA $011E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FD2X
&LAB PEA $010E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FS2X
&LAB PEA $020E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FNEXTS
&LAB PEA $021E
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FCPXS
&LAB PEA $020A
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FPROCENTRY
&LAB PEA $0017
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FPROCEXIT
&LAB PEA $0019
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FTESTXCP
&LAB PEA $001B
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FADDS
&LAB PEA $0200
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSETXCP
&LAB PEA $0015
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FADDX
&LAB PEA $0000
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FADDI
&LAB PEA $0400
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSUBI
&LAB PEA $0402
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FMULX
&LAB PEA $0004
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSQRTX
&LAB PEA $0012
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FLNX
&LAB PEA $0000
LDX #$0B0A
JSL $E10000
MEND
MACRO
&lab _SDivide
&lab ldx #$0A0B
jsl $E10000
MEND
MACRO
&LAB FMULI
&LAB PEA $0404
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FDIVI
&LAB PEA $0406
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FDIVX
&LAB PEA $0006
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FXPWRI
&LAB PEA $0010
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FCMPS
&LAB PEA $0208
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FEXPX
&LAB PEA $0008
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FCMPI
&LAB PEA $0408
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSUBS
&LAB PEA $0202
LDX #$090A
JSL $E10000
MEND
MACRO
&LAB FSINX
&LAB PEA $001A
LDX #$0B0A
JSL $E10000
MEND
MACRO
&LAB FREMI
&LAB PEA $040C
LDX #$090A
JSL $E10000
MEND
macro
&l dec4 &a
&l ~setm
lda &a
bne ~&SYSCNT
dec 2+&a
~&SYSCNT dec &a
~restm
mend
macro
&l add4 &m1,&m2,&m3
lclb &yistwo
lclc &c
&l ~setm
aif c:&m3,.a
&c amid "&m2",1,1
aif "&c"<>"#",.a
&c amid "&m1",1,1
aif "&c"="{",.a
aif "&c"="[",.a
&c amid "&m2",2,l:&m2-1
aif &c>=65536,.a
clc
~lda &m1
~op adc,&m2
~sta &m1
bcc ~&SYSCNT
~op.h inc,&m1
~&SYSCNT anop
ago .c
.a
aif c:&m3,.b
lclc &m3
&m3 setc &m1
.b
clc
~lda &m1
~op adc,&m2
~sta &m3
~lda.h &m1
~op.h adc,&m2
~sta.h &m3
.c
~restm
mend

8
orca.asm
View File

@ -53,7 +53,7 @@ lb1 rtl
*
enddesk start
jmp ~ENDDESK
brl ~ENDDESK
end
****************************************************************
@ -64,7 +64,7 @@ enddesk start
*
endgraph start
jmp ~ENDGRAPH
brl ~ENDGRAPH
end
****************************************************************
@ -119,7 +119,7 @@ id dc 8c' ',i1'0'
*
startdesk start
jmp ~STARTDESK
brl ~STARTDESK
end
****************************************************************
@ -130,7 +130,7 @@ startdesk start
*
startgraph start
jmp ~STARTGRAPH
brl ~STARTGRAPH
end
****************************************************************

422
stdio.asm
View File

@ -1322,11 +1322,10 @@ fprintf start
sta stream+2
phy restore return address/data bank
phx
ldx stream
plb
lda >stream+2 verify that stream exists
pha
lda >stream
pha
pha verify that stream exists
phx
jsl ~VerifyStream
bcc lb1
lda #EIO
@ -3327,11 +3326,10 @@ vfprintf start
sta stream+2
phy restore return address/data bank
phx
ldx stream
plb
lda >stream+2 verify that stream exists
pha
lda >stream
pha
pha verify that stream exists
phx
jsl ~VerifyStream
bcc lb1
lda #EIO
@ -3881,40 +3879,33 @@ argp equ 7 argument pointer
;
; For signed numbers, if the value is negative, use the sign flag
;
lda ~isLongLong handle long long values
beq sn0
ldy #6
lda [argp],Y
bpl cn0
sec
lda #0
sbc [argp]
sta [argp]
ldy #2
lda #0
sbc [argp],Y
sta [argp],Y
iny
iny
lda #0
sbc [argp],Y
sta [argp],Y
iny
iny
lda #0
sbc [argp],Y
sta [argp],Y
bra sn2
sn0 lda ~isLong handle long values
lda ~isLong handle long and long long values
beq sn0a
ldy #2
lda [argp],Y
lda ~isLongLong
beq sn0
ldy #6
sn0 lda [argp],Y
bpl cn0
sec
lda #0
ldx #0
txa
sbc [argp]
sta [argp]
lda #0
ldy #2
txa
sbc [argp],Y
sta [argp],Y
lda ~isLongLong
beq sn2
iny
iny
txa
sbc [argp],Y
sta [argp],Y
iny
iny
txa
sbc [argp],Y
sta [argp],Y
bra sn2
@ -3964,13 +3955,12 @@ cn1 lda [argp] push an int value
cn1a pha
cn2 ph4 #~str push the string addr
ph2 #l:~str push the string buffer length
ph2 #0 do an unsigned conversion
lda ~isLongLong do the proper conversion
beq cn2a
pla
jsr ~ULongLong2Dec
bra pd1
cn2a lda ~isLong
cn2a ph2 #0 do an unsigned conversion
lda ~isLong
beq cn3
_Long2Dec
bra pd1
@ -4057,17 +4047,8 @@ pn1 lda ~hexPrefix if there is a hex prefix then
jsl ~putchar
ph2 ~hexPrefix+1
jsl ~putchar
pn1a lda ~paddChar if the number needs 0 padding then
cmp #'0'
bne pn1c
lda ~fieldWidth
bmi pn1c
beq pn1c
pn1b ph2 ~paddChar print padd zeros
jsl ~putchar
dec ~fieldWidth
bne pn1b
pn1c lda ~precision if the number needs more padding then
pn1a jsr ~ZeroPad pad with '0's if needed
lda ~precision if the number needs more padding then
beq pn3
pn2 ph2 #'0' print padd characters
jsl ~putchar
@ -4095,10 +4076,10 @@ pn5 cpy #l:~str quit if we're at the end of the ~str
;
rn1 lda ~isLongLong
beq rn2
inc argp
inc argp
inc argp
inc argp
lda argp
clc
adc #4
sta argp
rn2 lda ~isLong
beq rn3
inc argp
@ -4244,9 +4225,12 @@ lb1 clc restore the original argp+4
****************************************************************
*
* ~Format_o - format an octal number
* ~Format_x - format a hexadecimal number (lowercase output)
* ~Format_X - format a hexadecimal number (uppercase output)
* ~Format_p - format a pointer
*
* Inputs:
* ~altForm - use a leading '0'?
* ~altForm - use a leading '0' (octal) or '0x' (hex)?
* ~fieldWidth - output field width
* ~paddChar - padd character
* ~leftJustify - left justify the output?
@ -4260,15 +4244,34 @@ lb1 clc restore the original argp+4
~Format_o private
using ~printfCommon
argp equ 7 argument pointer
lda #3 use 3 bits per output character
bra cn0
~Format_x entry
;
; Set the "or" value; this is used to set the case of character results
;
lda #$20*256
sta ~orVal
bra hx0
~Format_p entry
inc ~isLong
~Format_X entry
stz ~orVal
hx0 lda #4 use 4 bits per output character
;
; Initialization
;
cn0 sta bitsPerChar
stz ~hexPrefix assume we won't lead with 0x
stz ~sign ignore the sign flag
lda #' ' initialize the string to blanks
sta ~str
move ~str,~str+1,#l:~str-1
stz ~num+2 get the value to convert
lda ~isLongLong
lda ~isLongLong get the value to convert
beq cn1
ldy #6
lda [argp],Y
@ -4279,7 +4282,7 @@ argp equ 7 argument pointer
sta ~num+4
cn1 lda ~isLong
beq cn2
cn1a ldy #2
ldy #2
lda [argp],Y
sta ~num+2
cn2 lda [argp]
@ -4287,57 +4290,71 @@ cn2 lda [argp]
beq cn2a
and #$00FF
cn2a sta ~num
ldx bitsPerChar if doing hex format then
cpx #3
beq cn2b
ldx ~altForm if alt form has been selected then
beq cn2b
ora ~num+2 if value is not 0 then
ora ~num+4
ora ~num+6
beq cn2b
lda #'X0' set hex prefix to '0X' or '0x'
ora ~orVal
sta ~hexPrefix
;
; Convert the number to an ASCII string
;
short I,M
ldy #l:~str-1 set up the character index
cn3 lda ~num+7 quit if the number is zero
ora ~num+6
ora ~num+5
ora ~num+4
ora ~num+3
ora ~num+2
ora ~num+1
ora ~num
beq al1
lda #0 roll off 3 bits
ldx #3
cn4 lsr ~num+7
ror ~num+6
ror ~num+5
cn2b ldy #l:~str-1 set up the character index
cn3 lda #' 0' roll off 4 bits
ldx bitsPerChar
cn4 lsr ~num+6
ror ~num+4
ror ~num+3
ror ~num+2
ror ~num+1
ror ~num
ror A
dex
bne cn4
lsr A form a character
lsr A
lsr A
lsr A
lsr A
ora #'0'
xba form a character
ldx bitsPerChar
cn4a asl A
dex
bne cn4a
cmp #('9'+1)*256+' ' if the character should be alpha then
blt cn5
clc
adc #7*256 adjust it
ora ~orVal
cn5 dey
sta ~str,Y save the character
dey
bra cn3
lda ~num+6 loop if the number is not zero
ora ~num+4
ora ~num+2
ora ~num
bne cn3
;
; If a leading zero is required, be sure we include one
; If a leading '0x' is required, be sure we include one
;
al1 cpy #l:~str-1 include a zero if no characters have
beq al2 been placed in the string
lda ~altForm branch if no leading zero is required
lda bitsPerChar if doing octal format then
cmp #3
bne al3
lda ~altForm if alt form has been selected then
beq al3
al2 lda #'0'
sta ~str,Y
al3 long I,M
lda ~precision make sure precision is non-zero
bne al2
inc ~precision
al2 lda #'0 ' if the result is not ' 0' then
cmp ~str+l:~str-2
beq al3
sta ~str-1,Y include a zero in the string
;
; Piggy back off of ~Format_d for output
;
stz ~hexPrefix don't lead with 0x
brl ~Format_IntOut
al3 brl ~Format_IntOut
;
; Local data
;
bitsPerChar ds 2 bits per output character
end
****************************************************************
@ -4357,36 +4374,36 @@ al3 long I,M
using ~printfCommon
argp equ 7 argument pointer
ph4 <argp save the original argp
ldy #2 dereference argp
lda [argp],Y
tax
lda [argp]
sta argp
stx argp+2
short M determine the length of the string
ldy #-1
lb1 iny
lda [argp],Y
bne lb1
long M
tya
bra lb1a
sec set flag for c-string
bra lb0
~Format_b entry
~Format_P entry
ph4 <argp save the original argp
clc set flag for p-string
lb0 ph4 <argp save the original argp
ldy #2 dereference argp
lda [argp],Y
tax
lda [argp]
sta argp
stx argp+2
lda [argp] get the length of the string
bcs lb1 if formatting a p-string then
lda [argp] get the length of the string
and #$00FF
inc4 argp
bra lb1x else if formatting a c-string then
lb1 short M compute the length of the string
ldy #-1
lb1a iny
lda [argp],Y
bne lb1a
long M
tya
lb1a ldx ~precisionSpecified if the precision is specified then
lb1x ldx ~precisionSpecified if the precision is specified then
beq lb2
cmp ~precision if the precision is smaller then
blt lb2
@ -4415,133 +4432,6 @@ lb4 clc restore and increment argp
brl ~LeftJustify handle left justification
end
****************************************************************
*
* ~Format_x - format a hexadecimal number (lowercase output)
* ~Format_X - format a hexadecimal number (uppercase output)
* ~Format_p - format a pointer
*
* Inputs:
* ~altForm - use a leading '0x'?
* ~fieldWidth - output field width
* ~paddChar - padd character
* ~leftJustify - left justify the output?
* ~isLong - is the operand long?
* ~isLongLong - is the operand long long?
* ~precision - precision of output
* ~precisionSpecified - was the precision specified?
*
****************************************************************
*
~Format_x private
using ~printfCommon
argp equ 7 argument pointer
;
; Set the "or" value; this is used to set the case of character results
;
lda #$20
sta orVal
bra cn0
~Format_p entry
lda #1
sta ~isLong
~Format_X entry
stz orVal
;
; Initialization
;
cn0 stz ~sign ignore the sign flag
lda #' ' initialize the string to blanks
sta ~str
move ~str,~str+1,#l:~str-1
stz ~num+2 get the value to convert
stz ~num+4
stz ~num+6
lda ~isLongLong
beq cn1
ldy #6
lda [argp],Y
sta ~num+6
dey
dey
lda [argp],Y
sta ~num+4
cn1 lda ~isLong
beq cn2
ldy #2
lda [argp],Y
sta ~num+2
cn2 lda [argp]
ldx ~isByte
beq cn2a
and #$00FF
cn2a sta ~num
ora ~num+2
ora ~num+4
ora ~num+6
bne cn2b
stz ~altForm if value is 0, do not print hex prefix
cn2b stz ~hexPrefix assume we won't lead with 0x
;
; Convert the number to an ASCII string
;
short I,M
ldy #l:~str-1 set up the character index
cn3 lda #0 roll off 4 bits
ldx #4
cn4 lsr ~num+7
ror ~num+6
ror ~num+5
ror ~num+4
ror ~num+3
ror ~num+2
ror ~num+1
ror ~num
ror A
dex
bne cn4
lsr A form a character
lsr A
lsr A
lsr A
ora #'0'
cmp #'9'+1 if the character should be alpha,
blt cn5 adjust it
adc #6
ora orVal
cn5 sta ~str,Y save the character
dey
lda ~num+7 loop if the number is not zero
ora ~num+6
ora ~num+5
ora ~num+4
ora ~num+3
ora ~num+2
ora ~num+1
ora ~num
bne cn3
;
; If a leading '0x' is required, be sure we include one
;
lda ~altForm branch if no leading '0x' is required
beq al3
al2 lda #'X' insert leading '0x'
ora orVal
sta ~hexPrefix+1
lda #'0'
sta ~hexPrefix
al3 long I,M
;
; Piggy back off of ~Format_d for output
;
brl ~Format_IntOut
;
; Local data
;
orVal ds 2 for setting the case of characters
end
****************************************************************
*
* ~Format_Percent - format the '%' character
@ -4669,10 +4559,12 @@ stream equ 3 input stream
*
* ~LeftJustify - print padd characters for left justification
* ~RightJustify - print padd characters for right justification
* ~ZeroPad - print zeros to pad to field width
*
* Inputs:
* ~fieldWidth - # chars to print ( <= 0 prints none)
* ~leftJustify - left justify the output?
* ~paddChar - padding character
*
****************************************************************
*
@ -4695,6 +4587,19 @@ lb1 ph2 #' ' write the proper # of padd characters
dec ~fieldWidth
bne lb1
rts
~ZeroPad entry
lda ~paddChar if the number needs 0 padding then
cmp #'0'
bne zp2
lda ~fieldWidth
bmi zp2
beq zp2
zp1 ph2 ~paddChar print padd zeros
jsl ~putchar
dec ~fieldWidth
bne zp1
zp2 rts
end
****************************************************************
@ -4793,7 +4698,7 @@ lb3 creturn 4:ptr
* -----------------------
*
* An 'l' indicates that the 'd', 'o', 'u', 'x' or 'X' argument is
* long. 'L' and 'u' are also accepted for compliance with ANSI C,
* long. 'L' and 'h' are also accepted for compliance with ANSI C,
* but have no effect in this implementation.
*
* Conversion Specifier
@ -4806,12 +4711,14 @@ lb3 creturn 4:ptr
* while 'X' generates uppercase hex digits.
* c Character.
* s String.
* p Pascal string.
* P,b Pascal string.
* p Pointer.
* n The argument is (int *); the number of characters written so
* far is written to the location.
* f Signed decimal floating point.
* f,F Signed decimal floating point.
* e,E Exponential format floating point.
* g,G Use f,e or E, as appropriate.
* a,A Hexadecimal format floating point.
* % Write a '%' character.
*
****************************************************************
@ -4940,23 +4847,23 @@ Flag lda [format] get the character
and #$00FF
cmp #'-' if it is a '-' then
bne fl1
lda #1 left justify the output
sta ~leftJustify
sta ~leftJustify left justify the output
lda #' ' pad with spaces (ignore any '0' flag)
sta ~paddChar
bra fl5
fl1 cmp #'0' if it is a '0' then
bne fl2
sta ~paddChar padd with '0' characters
ldx ~leftJustify if not left justifying then
bne fl5
sta ~paddChar padd with '0' characters
bra fl5
fl2 cmp #'+' if it is a '+' or ' ' then
beq fl3
cmp #' '
bne fl4
ldx ~sign
cpx #'+'
beq fl5
fl3 sta ~sign set the sign flag
fl3 tsb ~sign set the sign flag ('+' overrides ' ')
bra fl5
fl4 cmp #'#' if it is a '#' then
@ -4986,8 +4893,10 @@ GetSize stz val assume a value of 0
bne fv0
eor #$ffff negative field width is like
inc a positive with - flag
ldx #1
ldx #'-'
stx ~leftJustify
ldx #' '
stx ~paddChar
bra fv1
fv0 lda #0 negative precision is ignored
stz ~precisionSpecified
@ -5021,10 +4930,10 @@ val ds 2 value
; List of format specifiers and the equivalent subroutines
;
fList dc c'%',a'~Format_Percent' %
dc c'a',a'~Format_e' a (not formatted correctly)
dc c'A',a'~Format_E' A (not formatted correctly)
dc c'a',a'~Format_a' a
dc c'A',a'~Format_A' A
dc c'f',a'~Format_f' f
dc c'F',a'~Format_f' F
dc c'F',a'~Format_F' F
dc c'e',a'~Format_e' e
dc c'E',a'~Format_E' E
dc c'g',a'~Format_g' g
@ -5074,8 +4983,9 @@ fListEnd anop
;
; Work buffers
;
~num ds 8 long long integer
~num ds 8 long long integer (must be 0 after each conversion)
~numChars ds 2 number of characters printed with this printf
~orVal ds 2 value to 'or' with to set case of characters
~str ds 83 string buffer
;
; Real formatting
@ -5958,13 +5868,9 @@ ps stz ~assignments no assignments yet
stz ~scanCount no characters scanned
stz ~scanError no scan error so far
stz ~eofFound eof was not the first char
jsl ~getchar test for eof
cmp #EOF
bne ps0
sta ~eofFound
ps0 jsl ~putback
ps1 lda ~scanError quit if a scan error has occurred
ora ~eofFound
bne rm1
lda [format] get a character
and #$00FF

6
stdlib.asm
View File

@ -37,7 +37,7 @@ abort start
ph2 #SIGABRT
jsl raise
lda #-1
jmp ~C_QUIT
brl ~C_QUIT
end
****************************************************************
@ -440,14 +440,14 @@ exit start
_exit entry
_Exit entry
lda 4,S
jmp ~C_QUIT
brl ~C_QUIT
end
quick_exit start
jsr ~QUICKEXIT
lda 4,S
jmp ~C_QUIT
brl ~C_QUIT
end
****************************************************************