Mandelbrot Fractal

Acorn computers don't have floating point chips so I wrote my own routines for this program. I wrote a divide routine as well but that is not used here. Subtraction was the trickiest one!
REM Mandlebrot to 256 colour sprite (c) R Geleit February 1995

ONERRORPROCerror

MODE13
OFF
VDU24,0;0;1023;1023;
VDU28,32,31,39,0
GCOL4,7
X=-2
Y=-1.25
S=2.5
PROCassemble
REPEAT
T%=TIME
CALLdrawmb
T%=TIME-T%
PROCnewxys
UNTIL0
END

DEFPROCassemble

DIM codespace 2000
REM GLOBAL
Fma=0
Fea=1
Fm1=2
Fe1=3
Fm2=4
Fe2=5
REM MAIN LOOP
x=11
y=12
c=8
to=9
REM FLOATING POINT
mman1=Fe1
mman2=Fe2
lman1=6
lman2=7
shift=7
mask=9
maskh=10

FORT%=0TO2 STEP2
P%=codespace
[OPTT%
ALIGN
.drawmb STMFD   R13!,{R0-R12,R14}
        MVN     x,#0
        LDR     Fm1,cxm
        LDR     Fe1,cxe
        STR     Fm1,Xm
        STR     Fe1,Xe

.oloop  LDR     Fm1,cym
        LDR     Fe1,cye
        STR     Fm1,Ym
        STR     Fe1,Ye
        LDR     Fm1,Xm
        LDR     Fe1,Xe
        LDR     Fm2,pixm
        LDR     Fe2,pixe
        BL      add
        STR     Fma,Xm
        STR     Fea,Xe
        MOV     y,#255
        ADD     x,x,#1

.iloop  LDR     Fm1,Ym
        LDR     Fe1,Ye
        LDR     Fm2,pixm
        LDR     Fe2,pixe
        BL      add
        STR     Fma,Ym
        STR     Fea,Ye
        BL      docalc

        LDR     to,stscn
        MOV     Fma,#320
        MLA     to,Fma,y,to
        STRB    c,[to,x]

        SUBS    y,y,#1
        BGE     iloop
        SWI     "OS_ReadEscapeState"
        BCS     quit
        CMP     x,#255
        BLT     oloop

.quit   LDMFD   R13!,{R0-R12,PC}^

.docalc STMFD   R13!,{R14}

        ADR     r14,Xm
        LDMIA   r14!,{Fm1,Fe1,Fm2,Fe2}
        STMIA   r14,{Fm1,Fe1,Fm2,Fe2}
        MOV     c,#0

.cloop  LDR     Fm1,xm
        LDR     Fe1,xe
        BL      sqr
        STR     Fma,xxm
        STR     Fea,xxe

        LDR     Fm1,ym
        LDR     Fe1,ye
        BL      sqr
        STR     Fma,yym
        STR     Fea,yye

        ADR     r14,xm
        LDMIA   r14,{Fm1,Fe1,Fm2,Fe2}
        BL      mult            \ get xy
        MOV     Fm1,Fma
        ADD     Fe1,Fea,#1    \ *2
        LDR     Fm2,Ym
        LDR     Fe2,Ye
        BL      add             \ y'=y+2xy
        STR     Fma,ym
        STR     Fea,ye

        ADR     r14,xxm
        LDMIA   r14,{Fm1,Fe1,Fm2,Fe2}
        EOR     Fm2,Fm2,#1<<31
        BL      add             \ get x*x-y*y
        MOV     Fm1,Fma
        MOV     Fe1,Fea
        LDR     Fm2,Xm
        LDR     Fe2,Xe
        BL      add             \ x'=x+x*x-y*y
        STR     Fma,xm
        STR     Fea,xe

        ADD     c,c,#1

        ADR     r14,xxm
        LDMIA   r14,{Fm1,Fe1,Fm2,Fe2}
        BL      add
        CMP     Fea,#2
        BGE     fin             \ x*x+y*y>4 ?
        CMP     c,#1024         \ max iterations
        BLT     cloop

.fin    LDMFD   R13!,{PC}

.sqr    LDR     maskh,maskhl            \ square

        MOV     Fea,Fe1,LSL#1

        ORR     Fm1,Fm1,#1<<31

        AND     lman1,Fm1,maskh
        MOV     Fm1,Fm1,LSR#16

        MULS    Fma,lman1,Fm1
        MOV     Fma,Fma,RRX
        MOV     Fma,Fma,LSR#14
        MLAS    Fma,Fm1,Fm1,Fma

        MOVPL   Fma,Fma,ASL#1
        ADDMI   Fea,Fea,#1

        EOR     Fma,Fma,#1<<31

        MOV     pc,r14

.ex1    EQUD    0
.man1   EQUD    0
.ex2    EQUD    0
.man2   EQUD    0
.aex    EQUD    0
.aman   EQUD    0
.maskhl EQUD    &0000FFFF
.stscn  EQUD    !&10C0

.Xm     EQUD    0
.Xe     EQUD    1<<31
.Ym     EQUD    0
.Ye     EQUD    1<<31
.xm     EQUD    0
.xe     EQUD    1<<31
.ym     EQUD    0
.ye     EQUD    1<<31
.xxm    EQUD    0
.xxe    EQUD    1<<31
.yym    EQUD    0
.yye    EQUD    1<<31
.count  EQUD    0

.cxm    EQUD    FNtoman(X)
.cxe    EQUD    FNtoexp(X)
.cym    EQUD    FNtoman(Y)
.cye    EQUD    FNtoexp(Y)
.pixm   EQUD    FNtoman(S/256)
.pixe   EQUD    FNtoexp(S/256)

.mult   MOV     mask,#1<<31
        LDR     maskh,maskhl

        CMP     Fe1,mask
        BEQ     zerout
        CMP     Fe2,mask
        BEQ     zerout
        ADD     Fea,Fe1,Fe2

        AND     Fe1,mask,Fm1
        ORR     Fm1,mask,Fm1

        BIC     Fe2,mask,Fm2
        ORR     Fm2,mask,Fm2
        EOR     mask,Fe1,Fe2

        AND     lman1,Fm1,maskh
        AND     lman2,Fm2,maskh
        MOV     Fm1,Fm1,LSR#16
        MOV     Fm2,Fm2,LSR#16

        MUL     mman1,lman1,Fm2
        MUL     mman2,lman2,Fm1
        ADDS    Fma,mman1,mman2
        MOV     Fma,Fma,RRX

        MOV     Fma,Fma,LSR#16-1
        MLAS    Fma,Fm1,Fm2,Fma

        MOVPL   Fma,Fma,ASL#1
        ADDMI   Fea,Fea,#1

        EOR     Fma,mask,Fma

        MOV     pc,r14

.add    STMFD   R13!,{R14}

        MOV mask,#1<<31

\        CMP     Fe1,mask
 \       BEQ     ok1
  \      CMP     Fe2,mask
   \     BEQ     ok2

        CMP     Fe1,Fe2
        BLLT    swap

        MOV     Fea,Fe1
        SUB     shift,Fe1,Fe2
\        CMP     shift,#32
 \       MOVGE   Fma,Fm1
  \      BGE     out
        AND     Fe1,Fm1,mask
        AND     Fe2,Fm2,mask
        ORR     Fm1,Fm1,mask
        ORR     Fm2,Fm2,mask
        MOV     Fm2,Fm2,LSR shift

        EORS    Fma,Fe1,Fe2
        BPL     same

.difrnt CMP     Fm1,Fm2
        BLLT    swap
        CMP     shift,#0
        BEQ     revsb

        SUBS    Fma,Fm2,Fm1
        EORMI   Fma,Fe1,Fma
        LDMMIFD R13!,{PC}
        MOVPL   Fe2,Fe1
        BPL     totopb+4

.revsb  SUBS    Fma,Fm1,Fm2
        SUBMI   Fea,Fea,#1
.totopb MOVMIS  Fma,Fma,ASL#1
        SUBPL   Fea,Fea,#1
        FNleft(3)
        BMI     enuf
        FNleft(14)
        BMI     enuf
        FNleft(14)
.enuf   EOR     Fma,Fe2,Fma
        LDMFD   R13!,{PC}

.same   ADDS    Fma,Fm1,Fm2
        ADDCS   Fea,Fea,#1
        ORRCS   Fma,mask,Fma,LSR#1
        BIC     Fma,Fma,mask
        ORR     Fma,Fma,Fe1
        LDMFD   R13!,{PC}

.zerout MOV     Fea,mask
        MOV     Fma,#0
.out    LDMFD   R13!,{PC}

.swap   STMFD   R13!,{Fea,R14}
        MOV     Fea,Fe1
        MOV     Fe1,Fe2
        MOV     Fe2,Fea
        MOV     Fma,Fm1
        MOV     Fm1,Fm2
        MOV     Fm2,Fma
        LDMFD   R13!,{Fea,PC}

.ok1    MOV     Fea,Fe2
        MOV     Fma,Fm2
        LDMFD   R13!,{PC}

.ok2    MOV     Fea,Fe1
        MOV     Fma,Fm1
        LDMFD   R13!,{PC}

]
NEXT
ENDPROC

DEFFNleft(howmany)
LOCALA%
FORA%=1TOhowmany
[OPTT%
        MOVPLS  Fma,Fma,ASL#1
        SUBPL   Fea,Fea,#1
]
NEXTA%
=""

DEFFNtoreal(mant,expn)
mant=!mant
expn=!expn
IF expn=1<<31 THEN=0
=-1^(mant>>>31)*2^expn*(1+ABS((mant AND&7FFFFFFF)/1<<31))

DEFFNtoexp(float)
IF float=0 THEN=1<<31
float=ABSfloat
LOCALA%
A%=0
WHILE float>=2
float=float/2
A%=A%+1
ENDWHILE
WHILE float<1
float=float*2
A%=A%-1
ENDWHILE
=A%

DEFFNtoman(float)
IF float=0 THEN=0
LOCALA%,S%
S%=(SGNfloat-1)/-2
float=ABSfloat
WHILE float>=2
float=float/2
ENDWHILE
WHILE float<1
float=float*2
ENDWHILE
A%=2^31*(float-1)
A%=A%+(S%<<31)
=A%

DEFPROCnewxys
LOCAL A$,X%,Y%,S%,Z%,R%,D%
CLS
PRINT"TIME:"'STR$(T%/100);"s      "''"SAVE?"
A$=GET$
IF A$="y" OR A$="Y" THEN *screensave $.frac
PRINT'"Mouse:"''" "'" SMA"
S%=100
REPEAT
RECTANGLEX%,Y%,S%
WAIT
RECTANGLEX%,Y%,S%
MOUSEX%,Y%,Z%
X%=X%-(S%>>1)
Y%=Y%-(S%>>1)
S%=S%+2*(Z%AND2)-4*(Z%AND1)
IFS%<9 S%=9
IFS%>1024 S%=1024
UNTIL Z%AND4
X=X+X%/1024*S
Y=Y+Y%/1024*S
S=S*S%/1024
P%=cxm
[OPT2
EQUD    FNtoman(X)
EQUD    FNtoexp(X)
EQUD    FNtoman(Y)
EQUD    FNtoexp(Y)
EQUD    FNtoman(S/256)
EQUD    FNtoexp(S/256)
]
ENDPROC

DEFPROCerror
REPORT
PRINT'"at line:";ERL/10
END