home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
8bitfiles.net/archives
/
archives.tar
/
archives
/
genie-commodore-file-library
/
GEOSApps
/
RPN128-SRC.SFX
/
rpnroutines
(
.txt
)
< prev
next >
Wrap
GEOS ConVerT
|
1990-02-12
|
23KB
|
952 lines
RPNroutines
SEQ formatted GEOS file V1.0
Star NX-10
OP V2.0 or higher
;"RPNconst
BLASTER'S CONVERTER V2.5
geosSym.RPN
geosMac
Write Image V2.1
geoWrite V2.0
0Event routines for RPN 64.
d +# k" t
.noeqin
@.include geosSym
.include RPNconst
@include geosMac
graphicsMode == $003f
config == $ff00
.eqin
Number:
;DEAL WITH ALL NUMBERS
CmpBI INVFLG,true
bne 5$
Number:
;DEAL WITH ALL NUMBERS
CmpBI INVFLG,true
bne 5$
jsr Inverse ;Turn off INVFLG -- Inverse has no effect here
5$ MoveB r0L,CurNumE ;number of the icon pressed
CmpBI F_ENTRY,true
beq 10$ ;If already within an entry, jump over init. code
LoadB F_ENTRY,true ;If no entry yet, Set the Entry Flag
LoadB EnterStr,' ' ;Put space at start of EnterStr (for "-" if needed)
LoadB EnterPos,1 ;Set EnterStr pointer--- set other things
LoadB ManDigits,$00 ; start with 0 digits in mantissa
sta ExDigits ; 0 digits in exponent
LoadB F_FRACTION,false ; no decimal point yet
sta F_EXPON ; no E yet
sta F_NEG ; start positive
sta F_NEGE ; exponent isn't negative
LoadW TextXpos,$8000+DATA_LEFT*8+7 ;set the Text Prompt
LoadB TextYpos,ENTRY_TOP*8+4
lda #$08
jsr InitTextPrompt
MoveW TextXpos,stringX
MoveB TextYpos,stringY
jsr PromptOn
AddVB $08,TextYpos
10$ CmpBI F_EXPON,false ;Check to see if on Exponent
beq 20$
CmpBI ExDigits,$01 ;Make sure not too many exponent digits
beq 15$ ;If 1 digit, go to 1 digit handling routine
bcs 90$ ;If >1 digits, don't add another!
bra 25$ ;Otherwise, process digit
15$ ldy EnterPos ;If already 1 digit, make sure abs(exp) < 38
lda EnterStr,y
sub #$30 ;Convert to a number
sta temp
asl a
asl a
asl a
add temp
adc temp ;a=10*a
adc CurNumE ;a=Exponent
adc IPdigs ;Add number of digits in integer part of Mantissa
cmp #$28 ;Total must be less than 39
bcs 90$
bra 25$
20$ CmpBI ManDigits,$0a ;Make sure not too many mantissa digits
bcs 90$
beq 90$
25$ lda CurNumE ;Stick ASCII number to EnterStr
add #$30
ldy EnterPos
sta EnterStr,y
inc EnterPos
CmpBI F_EXPON,false ;Increment appropriate length pointer
beq 40$
inc ExDigits
bra 50$
40$ inc ManDigits
50$ lda EnterStr,y
jsr PrintA
@rts
DecimalPoint:
CmpBI INVFLG,true
bne 5$
@jmp pi_R1
5$ CmpBI F_ENTRY,true ;If not an entry yet, do a 0
beq 10$
LoadB r0L,$00
jsr Number
bra 20$
10$ CmpBI F_FRACTION,true ;If there already is a ".", don't add another
bne 15$
@rts
15$ CmpBI F_EXPON,true ;No decimal points in the exponent!
bne 20$
@rts
20$ LoadB F_FRACTION,true
lda #'.'
ldy EnterPos ;stick a '.' in the string
sta EnterStr,y
inc EnterPos
jsr PrintA
@rts
Scinot:
;Scientific Notation -- handler for E icon
CmpBI INVFLG,true
bne 5$
jsr Inverse ;Just turn off Inverse Flag
5$ CmpBI F_ENTRY,true ;If not working on an entry, E does nothing
beq 10$
@rts
10$ CmpBI F_EXPON,true ;Check if already have an exponent
bne 20$
@rts
20$ LoadB F_EXPON,true
LoadB ExDigits,0
lda #'E'
ldy EnterPos ;stick a 'E' in the string
sta EnterStr,y
inc EnterPos
jsr PrintA
MoveW TextXpos,EsignX ;Save this position for placing sign on exponent
MoveB EnterPos,Epos
lda #' ' ;and a space (for negative)
ldy EnterPos
sta EnterStr,y
inc EnterPos
jsr PrintA
ldy #$00
30$ iny
lda EnterStr,y
cmp #'.'
beq 40$
cmp #'E'
beq 40$
bra 30$
40$ sty IPdigs ;Number of digits in integer part of mantissa...
@rts
AddNums:
@jsr INVENT
;Deal with INVFLG and F_ENTRY
jsr R1_F1 ;Move F.P. Reg #1 to FAC1
@jsr GETBASIC
lda #<Reg2
ldy #>Reg2
jsr fadd
@jsr FLUSHBASIC
jsr F1_R2 ;Move FAC1 to F
AddNums:
@jsr INVENT
;Deal with INVFLG and F_ENTRY
jsr R1_F1 ;Move F.P. Reg #1 to FAC1
@jsr GETBASIC
lda #<Reg2
ldy #>Reg2
jsr fadd
@jsr FLUSHBASIC
jsr F1_R2 ;Move FAC1 to F.P. Reg #2
jsr Raise ;Move each F.P. Reg up
@ jmp PostOPrint
;Print out Registers (Post-Operation)
SubNums:
@jsr INVENT
jsr R1_F1
@jsr GETBASIC
lda #<Reg2
ldy #>Reg2
jsr fsub
@jsr FLUSHBASIC
jsr F1_R2
jsr Raise
@ jmp PostOPrint
MultNums:
@jsr INVENT
jsr R1_F1
LoadW a0,Reg2 ;Point to Reg2
@jsr Do_Mult
;Does the multiplication, checks overflow
CmpBI temp,$00 ;non-0 indicates overflow error
beq 10$
@jmp OvFloErr
10$ jsr F1_R2
jsr Raise
@jmp PostOPrint
DivNums:
@jsr INVENT
jsr R1_F1
@jsr GETBASIC
jsr fsgna ;Check to make sure R1<>0
cmp #$00
bne 10$
@jsr FLUSHBASIC
jmp ErrorMess
10$ lda #<Reg2
ldy #>Reg2
jsr fdiv
@jsr FLUSHBASIC
jsr F1_R2
jsr Raise
@ jmp PostOPrint
Expo:
;R2^R1
@jsr INVENT
jsr R2_F1 ;Check that R2 is positive
@jsr GETBASIC
jsr fsgna ;Find sign of FAC1
cmp #$01
beq 10$ ;Continue if positiv
Expo:
;R2^R1
@jsr INVENT
jsr R2_F1 ;Check that R2 is positive
@jsr GETBASIC
jsr fsgna ;Find sign of FAC1
cmp #$01
beq 10$ ;Continue if positive
@ jsr FLUSHBASIC
@ jmp ErrorMess
jsr flog
LoadW a0,Reg1
jsr Do_Mult ;Fac1 = Reg1*log(Reg2) [will flush BASIC for us]
CmpBI temp,$00
beq 20$
@jmp OvFloErr
20$ jsr Do_AntiLog ;Fac1 = Exp(Reg1*log(Reg2)) = Reg2 ^ Reg1
CmpBI temp,$00
beq 30$
@jmp OvFloErr
30$ jsr F1_R2
jsr Raise
@ jmp PostOPrint
Hpi_R1:
@jsr Inverse
;turn off inverse
CmpBI F_ENTRY,true
bne 5$
@jsr Do_Enter
5$ jsr Sink ;Move 1-7 down
@jsr GETBASIC
lda #<fpi
ldy #>fpi
jsr memfac1
ldx #<Reg1
ldy #>Reg1
jsr fac1mem ;Copy pi to Reg1
@jsr FLUSHBASIC
jmp PrintRegs
;Print all registers
@INVENT:
;Routine that checks for Inverse, does nothing
;Checks for Entry, does an "Enter" if necessary
@INVENT:
;Routine that checks for Inverse, does nothing
;Checks for Entry, does an "Enter" if necessary
CmpBI INVFLG,true
bne 5$
@jmp Inverse
;INV/whatever is nothing
5$ CmpBI F_ENTRY,true
bne 10$
LoadB oprint,false
@jmp Do_Enter
10$ LoadB oprint,true
@rts
PostOPrint:
;Support routine, print appropriate regs after operation
CmpBI oprint,true
bne 10$
@jmp PrintRegs
@jmp PrintR1
Delete:
CmpBI INVFLG,true
bne 5$
jsr Inverse
5$ CmpBI F_ENTRY,true
bne 80$
10$ CmpBI F_EXPON,false
beq 20$
lda ExDigits ;Subtract 1 from current digit counter
beq 80$ ;(Skip if ExDigits=0)
sub #$01
sta ExDigits
bra 30$
20$ lda ManDigits
beq 80$ ;(Skip if ManDigits=0)
sub #$01
sta ManDigits
bra 30$
@80$ jmp end_Delete
30$ ldy EnterPos ;First, blank last character of string, dec. pointer
sty EnterPos
lda EnterStr,y
tax ;save identity of character in x
cmp #'.' ;(Check for decimal point)
bne 40$
inc ManDigits ;If a decimal point, we aren't removing a digit!
LoadB F_FRACTION,false ;We just deleted the decimal point
40$ lda #$00
sta EnterStr,y
txa ;Blank space on screen- draw rect. of char's width
jsr GetCharWidth
sta temp
lda #$00
sta temp2 ;High byte of temp = 0
jsr SetPattern ;Set for clearing
LoadB r2L,ENTRY_TOP*8+1
LoadB r2H,(ENTRY_TOP+2)*8-2
MoveW TextXpos,r4
SubW temp,TextXpos ;Subtract the width from TextXpos
MoveW TextXpos,r3
jsr Rectangle ;Do the clear
MoveW TextXpos,stringX ;Reset Prompt position back
lda TextYpos
sub #$08
sta stringY
jsr PromptOn
@end_Delete: rts
@end_Delete: rts
Number of digits in integer part of mantissa...
Enter:
CmpBI INVFLG,true
bne 5$
jmp PrintInfo
5$ CmpBI F_ENTRY,true
beq 10$
@jmp Duplicate
10$ jsr Do_Enter
jsr PrintRegs ;Print all F.P. Registers
@rts
@Do_Enter:
ldy EnterPos
lda #$00 ;Make sure EnterStr is 0 terminated
sta EnterStr,y
LoadW PPDBtxt,befSink
jsr PausePrint
jsr Sink ;Move Regs down
LoadW PPDBtxt,aftSink
; jsr PausePrint
ldx #$09
10$ lda EnterStr,x ;Move Enter String to System String
sta systring,x
bpl 10$
jsr ASCIIDEC ;translate the system string to fac1
LoadW PPDBtxt,aftASC
; jsr PausePrint
jsr F1_R1 ;copy fac1 to reg1
LoadW PPDBtxt,aftF1R1
; jsr PausePrint
jsr ClrEntry ;Clear enterline, EnterStr, EnterPos
LoadW PPDBtxt,aftClrE
; jsr PausePrint
LoadB F_ENTRY,false
@rts
befSink: .byte "Before Sink",0
aftSink: .byte "After Sink",0
aftASC: .byte "After ASCIIDEC",0
;aftF1R1: .byte "After F1_R1",0
;aftClrE: .byte "After ClrEntry",0
Duplicate:
;ENTER when no entry in progress is a DUP -- copy
jsr Sink ; Reg1 to Reg2, move 2-3, 3-4 etc.
jsr PrintRegs
@rts
PrintInfo:
jsr ClearData ;Clear the Data
PrintInfo:
jsr ClearData ;Clear the Data Screen
LoadW leftMargin,$8000+DATA_LEFT*8+4
jsr i_PutString
screen1: .word $8000+DATA_LEFT*8+4
.byte DATA_TOP*8+12
.byte 24,"Hints:",27,13,13,"INV-SWAP is ROLL"
.byte 13,"INV-DROP is ROLLD"
.byte 13,"INV-Min is MR"
.byte 13,"INV-. is pi"
.byte 13,13,"(Click to continue)",0
10$ CmpBI mouseData,%10000000 ;Wait for click
bne 20$
bra 10$
20$ jsr ClearData
LoadW leftMargin,$8000+DATA_LEFT*8+4
jsr i_PutString
screen2: .word $8000+DATA_LEFT*8+4
.byte DATA_TOP*8+12
.byte 24,"Key Shortcuts:",27,13,13
.byte "Return -- Enter",13,"f1 -- Inverse",13
.byte "f3 -- Swap",13,"f5 -- Drop",13
.byte "f7 -- +/-",13,"m -- Mem. In.",13,"q -- quit",13,13
.byte "(Click to Continue)",0
30$ CmpBI mouseData,%10000000 ;Wait for click
bne 40$
bra 30$
40$ jsr ClearData
LoadW leftMargin,$8000+DATA_LEFT*8+4
jsr i_PutString
screen3: .word $8000+DATA_LEFT*8+4
.byte DATA_TOP*8+12
.byte 24,"Key Shortcuts:",27,13,13
.byte "s -- sin",13,"c -- cos",13,"t -- tan",13
.byte "v -- Sqr. Root",13,"r -- 1/x",13
.byte "l -- ln",13,13
.byte "(Click to continue)",0
42$ CmpBI mouseData,%10000000 ;Wait for click
bne 47$
bra 42$
47$ jsr ClearData
LoadW leftMargin,$8000+DATA_LEFT*8+4
jsr i_PutString
screen4: .word $8000+DATA_LEFT*8+4
.byte DATA_TOP*8+12
.byte 13,13,"The Masked Nerd",13,"Was Here!",0
50$ CmpBI mouseData,%10000000
bne 60$
bra 50$
60$ LoadW leftMargin,#$00
jsr ClearData
jsr PrintRegs
@jmp Inverse
;Jump to Inverse to turn off the Inverse Flag
SignChange:
CmpBI INVFLG,true
bne 5$
jsr Inverse
5$ CmpBI F_ENTRY,tr
SignChange:
CmpBI INVFLG,true
bne 5$
jsr Inverse
5$ CmpBI F_ENTRY,true
beq 10$ ;If no entry, change sign of Reg. 1
@jmp screg1
;Rest of this routine deals with Enter String
10$ CmpBI F_EXPON,true ;Check to see if we change sign of exponent
beq 30$
CmpBI F_NEG,true
beq 15$
LoadB F_NEG,true
lda #'-'
bra 20$
15$ LoadB F_NEG,false
lda #' '
20$ MoveW TextXpos,tmpblk ;Save cursor position
LoadW TextXpos,$8000+DATA_LEFT*8+4
pla ;Character of sign was pushed on stack
sta EnterStr
jsr PrintA
MoveW tmpblk,TextXpos ;Restore cursor position
@rts
30$ CmpBI F_NEGE,true
beq 40$
LoadB F_NEGE,true
lda #'-'
bra 50$
40$ LoadB F_NEGE,false
lda #' '
50$ MoveW TextXpos,tmpblk
MoveW EsignX,TextXpos
ldy Epos
sta EnterStr,y
jsr PrintA
MoveW tmpblk,TextXpos
@rts
@screg1:
;Sign Change on Register 1
lda Reg1+1
eor #%10000000 ;Flip sign bit
sta Reg1+1 ;Save mauled top byte of m
@screg1:
;Sign Change on Register 1
lda Reg1+1
eor #%10000000 ;Flip sign bit
sta Reg1+1 ;Save mauled top byte of mantissa
jsr PrintR1 ;Print out mauled register
@rts
@;END OF SIGNCHANGE
CmpBI INVFLG,true ;Check inverse- if set, jump to inverse of function
bne 10$
@jmp ArcSin
@jsr PreFunc
;Do general Pre-Function setup subroutine
jsr R1_F1
@jsr GETBASIC
jsr fsin
@jsr FLUSHBASIC
jsr F1_R1
@ jmp PostOPrint
;Post-operation print-F.P. Regs routine
CmpBI INVFLG,true
bne 10$
@jmp ArcCos
@jsr PreFunc
jsr R1_F1
@jsr GETBASIC
jsr fcos
@jsr FLUSHBASIC
jsr F1_R1
@ jmp PostOPrint
5$ CmpBI F_ENTRY,true
bne 10byte $80+PADLEFT+7
.byte (DA_TOP+7)*8
.byte $80+Ia keytable,y ;put routine vector @ temp (lb) & temp2 (hb)
sta temp
lda keytable,y
8!8%9
CmpBI INVFLG,true
bne 10$
@jmp ArcTan
@jsr PreFunc
@jsr GETBASIC
lda #<fpi
ldy #>fpi
jsr memfac1
lda #<fhalf
ldy #>fhalf
jsr fmult
lda #<Reg1
ldy #>Reg1
jsr fsub ;Fac1 = Reg1 - pi/2
lsr facsgn ;Fac1 = |Reg1 - pi/2| (clear bit 7)
ldx #<fvar
ldy #>fvar
jsr fac1mem
lda #<fpi
ldy #>fpi
jsr memfac1
lda #<fvar
ldy #>fvar
jsr fdiv ;Divide |Reg1-pi/2|/pi
ldx #<fvar
ldy #>fvar
jsr fac1mem
jsr fint
lda #<fvar
ldy #>fvar
jsr fcompare ;Check to see if fac1 = int(fac1)
cmp #$00 ;a=0 indicates fac1 is an integer... thus error!
bne 20$
@ jsr FLUSHBASIC
jmp ErrorMess
20$ lda #<Reg1
ldy #>Reg1
jsr memfac1
jsr ftan
@jsr FLUSHBASIC
jsr F1_R1
@ jmp PostOPrint
Sqrt:
CmpBI INVFLG,true
bne 10$
@jmp Square
@jsr PreFunc
jsr R1_F1
@jsr GETBASIC
jsr fsgna ;Check sign of R1
cmp #$ff
bne 20$ ;Continue if not negative
@ jsr FLUSHBASIC
jmp ErrorMess
20$ jsr fsqrt
@jsr FLUSHBASIC
jsr F1_R1
@ jmp PostOPrint
Recip:
;1/x
CmpBI INVFLG,true
bne 10$
@jsr Inverse
;Just turn off Inverse
Recip:
;1/x
CmpBI INVFLG,true
bne 10$
@jsr Inverse
;Just turn off Inverse
@jsr PreFunc
jsr R1_F1
CmpBI stofac1,#$00 ;BASIC is out, so look at exponent of
stofac1
bne 20$ ;If facexp is 0, this is an error (1/0)
@ jmp ErrorMess
@jsr GETBASIC
lda #<fone
ldy #>fone
jsr fdiv
@ jsr FLUSHBASIC
jsr F1_R1
@jsr PostOPrint
CmpBI INVFLG,true
bne 10$
@jmp AntiLog
@jsr PreFunc
jsr R1_F1
@jsr GETBASIC
jsr fsgna ;Check that R1>0
cmp #$01
beq 20$ ;if R1>0, ok to continue
@jsr FLUSHBASIC
jmp ErrorMess
20$ jsr flog
@jsr FLUSHBASIC
jsr F1_R1
@ jmp PostOPrint
ArcSin:
;ASIN(X)=ATN(X/SQRT(-X*X+1))
@ jsr Inverse
jsr PreFunc
jsr FunkyAtan ;Calculates the ASIN
CmpBI temp,#$00 ;temp has error return status
beq 10$
@jmp ErrorMess
@jmp PostOPrint
ArcCos:
;ACOS(X)=-ATN(X/SQR(-X*X+1))+PI/2 = -ASIN(X)+PI/2
@jsr Inverse
jsr PreFunc
jsr FunkyAtan
CmpBI temp,#$00 ;temp has error return status
beq 10$
@jmp ErrorMess
10$ lda Reg1+1
eor #%10000000
sta Reg1+1
LoadW r5,Reg1
LoadW r6,fvar
ldx #r5
ldy #r6
lda #$05
jsr CopyFString ;Copy Reg1 to tmpblk
@jsr GETBASIC
lda #<fpi
ldy #>fpi
jsr memfac1
lda #<fhalf
ldy #>fhalf
jsr fmult ;Faci = 0.5*pi
lda #<fvar
ldy #>fvar
jsr fadd
@jsr FLUSHBASIC
jsr F1_R1
@ jmp PostOPrint
ArcTan:
@jsr Inverse
;turn off Inverse
@jsr PreFunc
jsr R1_F1
@jsr GETBASIC
jsr fatan
@jsr FLUSHBASIC
jsr F1_R1
@jmp PostOPrint
@FunkyAtan:
@FunkyAtan:
;Calculates the ATN used in both ASIN and ACOS
jsr R1_F1
@jsr GETBASIC
lsr facsgn ;Take absoulute value of FAC1
lda #<fone
ldy #>fone
jsr fcompare ;Compare 1 to fac1 ( |R1| )
cmp #$ff ;$ff indicates 1 > fac1
beq 10$ ;If |R1|>1, arcsin or arccos won't work!
@jsr FLUSHBASIC
LoadB temp,$ff ;$ff in temp Indicates an error
@ rts
10$ LoadB temp,$00 ;no error if we are continuing
lda #<Reg1
ldy #>Reg1
jsr memfac1
lda #<Reg1
ldy #>Reg1
jsr fmult ;R1*R1
lda facsgn
eor #$ff ;Flip the sign bit
sta facsgn
lda #<fone
ldy #>fone
jsr fadd ;add 1
jsr fsqrt
lda #<Reg1
ldy #>Reg1
jsr fdiv ;X/Fac1 = X/SQRT(-X*X+1)
jsr fatan
@jsr FLUSHBASIC
jsr F1_R1
@ rts
@PreFunc:
;Pre-function general setup routine
CmpBI F_ENTRY,true
bne 10$
LoadB oprint,true
@jmp Do_Enter
10$ LoadB oprint,false
@ rts
Square:
jsr Inverse ;turn off inverse flag
@ jsr PreFunc
Square:
jsr Inverse ;turn off inverse flag
@ jsr PreFunc
jsr R1_F1
LoadW a0,Reg1
jsr Do_Mult ;Does the multiplication and checks for overflow
lda temp
beq 10$
@ jmp OvFloErr
10$ jsr F1_R1
@ jmp PostOPrint
AntiLog:
jsr Inverse ;turn off inverse flag
@jsr PreFunc
jsr R1_F1
jsr Do_AntiLog
lda temp
beq 10$
@jmp OvFloErr
10$ jsr F1_R1
@jmp PostOPrint
ldy #>Reg1
jsr memfac1
lda #<Reg1
ldy
@Do_Mult:
;Multiplies FAC1 * (a0) ; returns $ff in temp
; if overflow
@jsr GETBASIC
ldy #$00
lda (a0),y
add facexp
bcc 50$ ;If carry is clear, no overflow
and #%10000000
cmp #$00
beq 50$ ;If carry set, high bit clear, no overflow
LoadB temp,$ff
bra 60$
50$ LoadB temp,$00
lda a0L
ldy a0H
jsr fmult
@jsr FLUSHBASIC
Do_AntiLog:
jsr GETBASIC
ldx #<fvar
ldy #>fvar
jsr fac1mem
lda #$00
ldy #$58 ;$58=88; exp(88) is the highest possible
jsr givayf ;(actually 88.03, but 88 is close enough)
lda #<fvar
ldy #>fvar
jsr fcompare
cmp #$ff ;$ff indicates fvar>88
bne 10$
LoadB temp,$ff
bra 20$
10$ LoadB temp,$00
lda #<fvar
ldy #>fvar
jsr memfac1
jsr fe_to
@ jsr FLUSHBASIC
CmpBI INVFLG,true
bne 5$
@ jmp Roll
;INV-Swap is Roll 8
5$ CmpBI F_ENTRY,true
bne 10$
@jsr Do_Enter
10$ LoadW r5,Reg1 ;Reg1 -> fvar
LoadW r6,fvar
ldx #r5
ldy #r6
lda #$05
CmpBI INVFLG,true
bne 5$
@ jmp Roll
;INV-Swap is Roll 8
5$ CmpBI F_ENTRY,true
bne 10$
@jsr Do_Enter
10$ ldx #$04 ;Copy 5 bytes
15$ lda Reg1,x ;Reg1->tempororay
sta r0L
lda Reg2,x ;Reg2->Reg1
sta Reg1,x
lda r0L ;temporary->Reg2
sta Reg2,x
bpl 15$
; LoadW r5,Reg1 ;Reg1 -> fvar
; LoadW r6,fvar
; ldx #r5
; ldy #r6
; lda #$05
; jsr CopyFString
; LoadW r5,Reg2 ;Reg2 -> Reg1
; LoadW r6,Reg1
; ldx #r5
; ldy #r6
; lda #$05
; jsr CopyFString
; LoadW r5,fvar ;fvar -> Reg2
; LoadW r6,Reg2
; ldx #r5
; ldy #r6
; lda #$05
; jsr CopyFString
jsr PrintRegs ;Print out all registers
@rts
Drop:
CmpBI INVFLG,true
bne 5$
@jmp RollDown
;INV-Drop is RollDown 8
5$ CmpBI F_ENTRY,true
bne 10$
jsr ClrEntry
LoadB F_ENTRY,false
@rts
10$ jsr Raise
jsr PrintRegs
@rts
Do_Enter
10$ LoadB oprint,false
@ rts
r FLUSHBASIC
jsr F1_R1
@jmp PostOPrint
@ jsr FLUSHBASIC
jmp ErrorMess
20$ js
Roll:
jsr Inverse ;turn off inverse
CmpBI F_ENTRY,true
bne 10$
@jsr Do_Enter
10$ LoadW r5,Reg8 ;Reg8 -> fvar
LoadW r6,fvar
ldx #r5
ldy #r6
lda #$05
jsr CopyFString
jsr Sink ;Move Regs down
LoadW r5,fvar ;fvar -> Reg1
LoadW r6,Reg1
ldx #r5
ldy #r6
lda #$05
jsr CopyFString
jsr PrintRegs
@rts
RollDown:
jsr Inverse ;turn off inverse
CmpBI F_ENTRY,true
bne 10$
@jsr Do_Enter
10$ LoadW r5,Reg1 ;Reg1 -> fvar
LoadW r6,fvar
ldx #r5
ldy #r6
lda #$05
jsr CopyFString
jsr Raise ;Move Regs up
LoadW r5,fvar ;fvar -> Reg8
LoadW r6,Reg8
ldx #r5
ldy #r6
lda #$05
jsr CopyFString
jsr PrintRegs
@rts
Memin:
CmpBI INVFLG,true
bne
Memin:
CmpBI INVFLG,true
bne 10$
@jmp MemRec
10$ CmpBI F_ENTRY,true
bne 20$
@jsr Enter
;Do a full-blown Enter
20$ LoadW r5,Reg1
LoadW r6,RegMem
ldx #r5
ldy #r6
lda #$05
jsr CopyFString
@rts
MemRec:
CmpBI F_ENTRY,true
bne 10$
jsr Do_Enter
10$ jsr Sink
LoadW r5,RegMem
LoadW r6,Reg1
ldx #r5
ldy #r6
lda #$05
jsr CopyFString
jsr PrintRegs
@jmp Inverse
Inverse:
CmpBI INVFLG
Inverse:
CmpBI INVFLG,true
beq 10$
LoadB INVFLG,true
jsr i_BitmapUp ;Draw indicator
.word INVpic
.byte $80+L_INV_IND
.byte T_INV_IND*8
.byte $80+2
.byte 8
@rts
10$ LoadB INVFLG,false
lda #$00
jsr SetPattern ;Set pattern to white
jsr i_Rectangle ;clear indicator
.byte T_INV_IND*8
.byte (T_INV_IND+1)*8-1
.word $8000+L_INV_IND*8
.word $8000+(L_INV_IND+2)*8 ;(This clears one extra pixel- so what?)
@rts
INVpic:
HQuitRPN:
jsr i_MoveData ;Restore applications's zero page space
.word appzpage
.word $0061
.word $009e
@jmp RstrAppl
;return to application!
@;Nous avons fini !!!!
@jmp RstrAppl
;return to application!
@;Nous avons fini !!!!
$ CmpBI F_E
CmpBI temp,#$00 ;temp has error return status
beq 10$
@jmp ErrorMess
@jmp PostOPrint
ArcCos:
;ACOS
CmpBI temp,#$00 ;temp has error return status
beq 10$
@jmp ErrorMess
@jmp PostOPrint
ArcCos:
;ACOS(X)=-ATN(X/SQR(-X*X+1))+PI/2 = -