8bitfiles.net/archives/archives.tar/archives/genie-commodore-file-library/GEOSApps/RPN128-SRC.SFX/rpnroutines

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 = -