;       Copyright (C) 1982 by Manx Software Systems
        common /Sysvec_/
ffault: dw      0
        ds      6
        common /flterr_/
errflt: dw      0
        common /.lnprm/
lnprm:  ds      2
lnsec:  ds      2
        common  /.flprm/
flprm:  dw      acc1
flsec:  dw      acc2
        dseg
retsave:ds      2
YU:     ds      2
VEE:    ds      2
expdiff:ds      1
acc1:   ds      18
acc2:   ds      18
        cseg
;
        public  .dlis           ;load double immediate secondary
.dlis:
        pop     d               ;get return addr
        lxi     h,8             ;size of double
        dad     d
        push    h               ;put back correct return addr
        xchg
                        ;fall through into .dlds
;
        public  .dlds           ;load double float into secondary accum
.dlds:
        xchg
        lhld    flsec
        jmp     dload
;
        public  .dlip           ;load double immediate primary
.dlip:
        pop     d               ;get return addr
        lxi     h,8             ;size of double
        dad     d
        push    h               ;put back correct return addr
        xchg
                        ;fall through into .dldp
;
        public .dldp            ;load double float into primary accum
.dldp:
        xchg
        lhld    flprm
dload:
        push    b
        ldax    d               ;get first byte of number
        mov     m,a             ;save sign
        inx     h
        ani     7fH             ;isolate exponent
        sui     64              ;adjust from excess 64 notation
        mov     m,a             ;and save
        inx     h
        mvi     m,0             ;extra byte for carry
        mvi     b,7             ;copy 7 byte fraction
dloop:
        inx     h
        inx     d
        ldax    d
        mov     m,a
        dcr     b
        jnz     dloop

        inx     h
        mvi     m,0             ;clear guard byte
        pop     b
        ret
;
        public .dst             ;store double at addr in HL
.dst:
        push    b
        push    h               ;save address
        call    dornd           ;round fraction to 7 bytes
        pop     d               ;restore address
        lhld    flprm
        mov     a,m             ;get sign
        ani     80H             ;and isolate
        mov     b,a             ;save
        inx     h
        mov     a,m             ;get exponent
        adi     64              ;put into excess 64 notation
        ani     7fH             ;clear sign bit
        ora     b               ;merge exponent and sign
        stax    d
        inx     h               ;skip overflow byte
        mvi     b,7             ;copy 7 bytes of fraction
dstlp:
        inx     d
        inx     h
        mov     a,m
        stax    d
        dcr     b
        jnz     dstlp
        pop     b
        ret
;
        public .dpsh            ;push double float onto the stack
.dpsh:                          ;from the primary accumulator
        pop     h               ;get return address
        shld    retsave         ;and save for later
        call    dornd
        lhld    flprm
        lxi     d,9
        dad     d
        mov     d,m             ;bytes 6 and 7
        dcx     h
        mov     e,m
        dcx     h
        push    d
        mov     d,m             ;bytes 4 and 5
        dcx     h
        mov     e,m
        dcx     h
        push    d
        mov     d,m             ;bytes 2 and 3
        dcx     h
        mov     e,m
        dcx     h
        push    d
        mov     d,m             ;byte 1
        dcx     h
        dcx     h               ;skip over carry byte
        mov     a,m             ;get exponent
        adi     64              ;and restore to excess 64 notation
        ani     7fH
        mov     e,a
        dcx     h
        mov     a,m
        ani     80H             ;isolate sign bit
        ora     e               ;combine exponent and sign
        mov     e,a
        push    d
        lhld    retsave
        pchl
;
        public  .dpop           ;pop double float into secondary accum
.dpop:
        pop     h               ;get return address
        shld    retsave         ;and save
        lhld    flsec
        pop     d               ;exponent/sign and first fraction
        mov     m,e             ;save sign
        inx     h
        mov     a,e
        ani     7fH             ;isolate exponent
        sui     64              ;adjust for excess 64 notation
        mov     m,a
        inx     h
        mvi     m,0             ;extra byte for carry
        inx     h
        mov     m,d
        inx     h
        pop     d               ;bytes 2 and 3 of fraction
        mov     m,e
        inx     h
        mov     m,d
        inx     h
        pop     d               ;bytes 4 and 5 of fraction
        mov     m,e
        inx     h
        mov     m,d
        inx     h
        pop     d               ;bytes 6 and 7 of fraction
        mov     m,e
        inx     h
        mov     m,d
        inx     h
        mvi     m,0             ;clear guard byte
        lhld    retsave
        pchl
;
        public  .dswap          ;exchange primary and secondary
.dswap:
        lhld    flsec
        xchg
        lhld    flprm
        shld    flsec
        xchg
        shld    flprm
        ret
;
        public  .dng            ;negate primary
.dng:
        lhld    flprm
        mov     a,m
        xri     80H             ;flip sign
        mov     m,a
        ret
;
        public  .dtst           ;test if primary is zero
.dtst:
        lhld    flprm
;       mov     a,m
;       ora     a
;       jnz     true
        inx     h
        mov     a,m
        cpi     -64
        jnz     true
;       inx     h
;       inx     h
;       mov     a,m
;       ora     a
;       jnz     true
        jmp     false
;
        public  .dcmp           ;compare primary and secondary
;
                        ;return 0 if p == s
p.lt.s:                 ;return < 0 if p < s
        xra     a
        dcr     a
        pop     b
        ret
;
p.gt.s:                 ;       > 0 if p > s
        xra     a
        inr     a
        pop     b
        ret
;
.dcmp:
        push    b
        lhld    flprm
        xchg
        lhld    flsec
        ldax    d
        ora     a
        jm      dcneg
;                       primary is positive
        xra     m               ;check if signs the same
        jm      p.gt.s          ;differ then p > s
        jmp     docomp
dcneg:
                        ;primary is negative
        xra     m               ;check if signs the same
        jm      p.lt.s          ;differ the p < s
        xchg                    ;both negative reverse sense of test
docomp:
        inx     h
        inx     d
        ldax    d
        cmp     m               ;compare exponents
        jm      p.lt.s          ;sign test ok since -64 < exp < 64
        jnz     p.gt.s
        mvi     b,9             ;test overflow byte + 8 bytes of fraction
cmploop:
        inx     h
        inx     d
        ldax    d
        cmp     m
        jc      p.lt.s
        jnz     p.gt.s
        dcr     b
        jnz     cmploop
                        ;return 0 if p == s
        xra     a
        pop     b
        ret
;
        public  .dsb            ;subtract secondary from primary
.dsb:
        lhld    flsec
        mov     a,m
        xri     80H             ;flip sign of secondary
        mov     m,a
                        ;fall thru into add routine
;
        public .dad             ;add secondary to primary
.dad:
                        ;DE is used as primary address
                        ;and HL is used as secondary address
        push    b
                        ;clear extra bytes at end of accumulators
        lhld    flprm
        lxi     d,11            ;leave guard byte alone
        dad     d
        mvi     b,7
        xra     a
clp1:
        mov     m,a
        inx     h
        dcr     b
        jnz     clp1

        lhld    flsec
        lxi     d,11            ;leave guard byte alone
        dad     d
        mvi     b,7
clp2:
        mov     m,a
        inx     h
        dcr     b
        jnz     clp2

        lhld    flprm
        xchg
        lhld    flsec
        inx     h
        inx     d
        ldax    d               ;primary exponent
        sub     m               ;compute difference
        jp      ordok
        xchg                    ;swap so primary is larger
        cma
        inr     a
ordok:
        dcx     d
        dcx     h
        shld    flsec           ;fix primary and secondary
        xchg
        shld    flprm
        cpi     9               ;check for exp diff too large
        jnc     normalize
        mov     c,a             ;save exponent difference
        push    h
        push    d
        adi     9               ;adjust for offset
        mov     e,a
        mvi     d,0
        dad     d               ;adjust address for exponent difference
        shld    YU
        pop     d
        lxi     h,9
        dad     d
        shld    VEE
        pop     h
        xchg                    ;get prm in DE and scnd in HL
        ldax    d               ;sign of primary
        xra     m               ;check if signs same
        jp      doadd

        ldax    d
        ora     a               ;test which one is negative
        jm      UfromV          ;jump if primary is negative
                        ;subtract V from U
        mvi     b,7
        lhld    YU
        xchg
        lhld    VEE
sublpa:                 ;carry is already cleared
        ldax    d
        sbb     m
        stax    d
        dcx     d
        dcx     h
        dcr     b
        jnz     sublpa
brlpa:
        ldax    d
        sbi     0
        stax    d
        dcx     d
        dcr     c
        jp      brlpa
        xchg                    ;get destination into HL
        jmp     subchk          ;check for negative result
;
UfromV:
                        ;subtract U from V
        mvi     b,7
        lhld    VEE
        xchg
        lhld    YU
sublpb:                 ;carry is already cleared
        ldax    d
        sbb     m
        mov     m,a
        dcx     d
        dcx     h
        dcr     b
        jnz     sublpb
brlpb:
        mvi     a,0
        sbb     m
        mov     m,a
        dcx     h
        dcr     c
        jp      brlpb
subchk:                 ;check for negative result
        inx     h
        mov     a,m     ;check carry byte
        ora     a       ;test sign
        mvi     a,1
        jp      makpos
        lxi     d,15
        dad     d       ;point to end of number
neglp:
        mvi     a,0
        sbb     m
        mov     m,a
        dcx     h
        dcr     e
        jp      neglp
        mvi     a,81H           ;make number negative
makpos:
        lhld    flprm
        mov     m,a             ;set sign of number
        jmp     normalize
;
doadd:
                        ;add V to U
        mvi     b,7
        lhld    YU
        xchg
        lhld    VEE
addlp:                  ;carry is already cleared
        ldax    d
        adc     m
        stax    d
        dcx     d
        dcx     h
        dcr     b
        jnz     addlp
crylp:
        ldax    d
        aci     0
        stax    d
        dcx     d
        dcr     c
        jp      crylp
        jmp     normalize
;
        dseg            ;work area for divide and multiply routines
lcnt:   ds      1       ;iterations left
tmpa:   ds      8       ;quotient
tmpb:   ds      8       ;remainder work area
tmpc:   ds      8       ;temp for divisor
        cseg
        public  .ddv
.ddv:           ;double floating divide (primary = primary/secondary)
        push    b
        lhld    flprm
        xchg
        lhld    flsec
        ldax    d
        xra     m               ;compute sign of result
        stax    d               ;and store
        inx     h
        inx     d
        ldax    d               ;primary exponent
        sub     m               ;eu-ev
        mov     c,a             ;save exponent
        push    d
        push    h
        mov     a,m
        cpi     -64
        jnz     d.ok
        pop     h
        pop     h               ;throw away
        mvi     a,3             ;flag divide by zero error
        sta     errflt
        jmp     setbig          ;set to biggest possible number
d.ok:
        inx     d
        inx     h
        mvi     b,8
cmloop:
        inx     d
        inx     h
        ldax    d
        cmp     m
        jnz     differ
        dcr     b
        jnz     cmloop
                        ;numbers are the same give 1 as the answer
        pop     h       ;throw away
        pop     h       ;get destination addr
        inr     c       ;adjust exponent
        mov     m,c     ;save exponent
        inx     h
        mvi     m,0             ;clear extra byte
        inx     h
        mvi     m,1             ;set result
        mvi     b,8
        xra     a
        sta     errflt
        jmp     zclr
;
differ:                 ;check carry to find out smaller number
        pop     d       ;restore divisor address
        pop     h       ;restore dividend address
        mov     m,c     ;store exponent
        jc      uok
        inr     c       ;bump exponent
        mov     m,c
        dcx     h       ;and shift dividend right (logically)
uok:
        push    d       ;save for later
        lxi     d,9
        dad     d               ;compute end address
        mvi     b,8
        lxi     d,tmpb          ;copy dividend into work area
remsav:
        mov     a,m
        stax    d
        dcx     h
        inx     d
        dcr     b
        jnz     remsav
        pop     h       ;restore divisor addr
        lxi     d,9
        dad     d       ;move backwards
        mvi     b,8
        lxi     d,tmpc  ;copy divisor into work area
divsav:
        mov     a,m
        stax    d
        dcx     h
        inx     d
        dcr     b
        jnz     divsav
        mvi     b,8
        lxi     h,tmpa          ;clear quotient buffer
        xra     a
quinit:
        mov     m,a
        inx     h
        dcr     b
        jnz     quinit

        mvi     a,64
        sta     lcnt            ;initialize loop counter
divloop:
        lxi     h,tmpa
        mvi     b,16
        ora     a               ;clear carry
shlp:
        mov     a,m
        adc     a               ;shift one bit to the left
        mov     m,a
        inx     h
        dcr     b
        jnz     shlp
        sbb     a
        ani     1
        mov     c,a

        mvi     b,8
        lxi     d,tmpb
        lxi     h,tmpc
        ora     a               ;clear carry
sublp:
        ldax    d
        sbb     m
        stax    d
        inx     d
        inx     h
        dcr     b
        jnz     sublp
        mov     a,c
        sbi     0
        jnz     zerobit
onebit:
        lxi     h,tmpa
        inr     m
        lxi     h,lcnt
        dcr     m
        jnz     divloop
        jmp     divdone
;
zerobit:
        lxi     h,lcnt
        dcr     m
        jz      divdone
        lxi     h,tmpa
        mvi     b,16
        ora     a               ;clear carry
zshlp:
        mov     a,m
        adc     a               ;shift one bit to the left
        mov     m,a
        inx     h
        dcr     b
        jnz     zshlp

        sbb     a
        mov     c,a
        mvi     b,8
        lxi     d,tmpb
        lxi     h,tmpc
        ora     a               ;clear carry
daddlp:
        ldax    d
        adc     m
        stax    d
        inx     d
        inx     h
        dcr     b
        jnz     daddlp
        mov     a,c
        aci     0
        jnz     zerobit
        jmp     onebit
;
divdone:
        lhld    flprm
        lxi     d,12
        dad     d
        mvi     m,0
        dcx     h
        mvi     m,0
        lxi     d,tmpa
        mvi     b,8
qusav:
        dcx     h
        ldax    d
        mov     m,a
        inx     d
        dcr     b
        jnz     qusav
        jmp     normalize
;
        public  .dml
.dml:           ;double floating multiply       (primary = primary * secondary)
        push    b
        lhld    flprm
        xchg
        lhld    flsec
        ldax    d
        xra     m               ;compute sign of result
        stax    d               ;and store
        inx     h
        inx     d
        ldax    d               ;primary exponent
        cpi     -64
        jz      zresult
        add     m               ;eu+ev
        stax    d               ;save exponent
        mov     a,m             ;check for mult by zero
        cpi     -64
        jz      zresult

        push    d               ;save for later
        lxi     d,9
        dad     d               ;compute end address
        mvi     b,8
        lxi     d,tmpc          ;copy muliplicand into work area
msav1:
        mov     a,m
        stax    d
        dcx     h
        inx     d
        dcr     b
        jnz     msav1
        pop     h       ;restore multiplier addr
        lxi     d,9
        dad     d       ;move backwards
        mvi     b,8
        lxi     d,tmpb  ;copy multiplier into work area
msav2:
        mov     a,m
        stax    d
        dcx     h
        inx     d
        dcr     b
        jnz     msav2
        mvi     b,8
        lxi     h,tmpa          ;clear buffer
        xra     a
clrmul:
        mov     m,a
        inx     h
        dcr     b
        jnz     clrmul

        mvi     a,64
        sta     lcnt            ;initialize loop counter
muloop:
        lxi     h,tmpa
        mvi     b,16
        ora     a               ;clear carry
mshlp:
        mov     a,m
        adc     a               ;shift one bit to the left
        mov     m,a
        inx     h
        dcr     b
        jnz     mshlp
        jnc     mnext

        mvi     b,8
        lxi     d,tmpa
        lxi     h,tmpc
        ora     a               ;clear carry
maddlp:
        ldax    d
        adc     m
        stax    d
        inx     d
        inx     h
        dcr     b
        jnz     maddlp
;
        mvi     b,8
madclp:
        ldax    d
        aci     0
        stax    d
        jnc     mnext
        inx     d
        dcr     b
        jnz     madclp
;
mnext:
        lxi     h,lcnt
        dcr     m
        jnz     muloop

        lhld    flprm
        lxi     d,12
        dad     d
        lxi     d,tmpb-2
        mvi     b,10
msav:
        ldax    d
        mov     m,a
        inx     d
        dcx     h
        dcr     b
        jnz     msav
        jmp     normalize
;
;
        public .deq
.deq:
        call    .dcmp
        jz      true
false:
        lxi     h,0
        xra     a
        ret
;
        public .dne
.dne:
        call    .dcmp
        jz      false
true:
        lxi     h,1
        xra     a
        inr     a
        ret
;
        public .dlt
.dlt:
        call    .dcmp
        jm      true
        jmp     false
;
        public .dle
.dle:
        call    .dcmp
        jm      true
        jz      true
        jmp     false
;
        public .dge
.dge:
        call    .dcmp
        jm      false
        jmp     true
;
        public .dgt
.dgt:
        call    .dcmp
        jm      false
        jz      false
        jmp     true
;
        public  .utod
.utod:
        push    b
        mov     a,h
        ora     l
        jz      zresult
        xchg
        mvi     b,0
        jmp     posconv
;
        public  .itod
.itod:
        push    b
        mov     a,h
        ora     l
        jz      zresult
        xchg
        mvi     b,0
        mov     a,d
        ora     a
        jp      posconv
        cma
        mov     d,a
        mov     a,e
        cma
        mov     e,a
        inx     d
        mvi     b,80H
posconv:
        lhld    flprm
        mov     m,b             ;store sign
        inx     h
        mov     a,d
        ora     a
        jnz     longcvt
        mvi     m,1             ;set up exponent
        inx     h
        mvi     m,0             ;clear extra byte
        inx     h
        mov     m,e             ;move number into accumulator
        mvi     b,7
        xra     a
        jmp     cnvlp
;
longcvt:
        mvi     m,2             ;setup exponent
        inx     h
        mvi     m,0             ;clear extra byte
        inx     h
        mov     m,d             ;move number into accumulator
        inx     h
        mov     m,e
        mvi     b,6
        xra     a
cnvlp:
        inx     h
        mov     m,a
        dcr     b
        jnz     cnvlp
        jmp     goodexit
;
dornd:          ; round the number in the primary accumulator
        lhld    flprm
        lxi     d,10            ;offset of guard byte
        dad     d
        mov     a,m
        cpi     128
        rc                      ; < 128 do nothing
        jnz     rndit
        dcx     h               ; == 128 make number odd
        mov     a,m
        ori     1
        mov     m,a
        ret
;
rndit:                          ; > 128 add one to fraction
        push    b
        lxi     b,0800H         ;b = 8, and c = 0
        stc                     ; make loop add 1
rndlp:
        dcx     h
        mov     a,m
        adc     c
        mov     m,a
        dcr     b
        jnz     rndlp
        ora     a               ;check for fraction overflow
        jnz     normalize       ;re-normalize number if so.
        pop     b
        ret                     ;return if none
;
normalize:
        lhld    flprm           ;get address of accum
        inx     h
        mov     a,m             ;fetch exponent

        mov     d,h             ;save address for later
        mov     e,l
        inx     h
        mov     c,a
        xra     a
        cmp     m               ;check extra byte
        jnz     movrgt          ;non-zero move number right

        mvi     b,8             ;search up to 8 bytes
nloop:
        inx     h
        cmp     m
        jnz     movleft
        dcr     c               ;adjust exponent
        dcr     b               ;count times thru
        jnz     nloop
                        ;zero answer
zresult:
        xra     a
        sta     errflt
under0:
        lhld    flprm
        mvi     b,10
        mov     m,a
        inx     h
        mvi     m,-64           ;so exponent will be zero after store
zclr:
        inx     h
        mov     m,a
        dcr     b
        jnz     zclr
        pop     b
        ret
;
movleft:
        mvi     a,8
        sub     b
        mov     b,a
        jz      chkexp          ;no change in counter, no move needed
        dcx     h               ;back up to zero
        mov     a,c
        stax    d               ;save new exponent
        push    d               ;save for rounding
        inx     d
        mvi     a,15
        sub     b               ;compute # of bytes to move
        mov     c,a             ;save for loop
lmovlp:
        mov     a,m
        stax    d
        inx     d
        inx     h
        dcr     c
        jnz     lmovlp
        xra     a
lclrlp:
        stax    d               ;pad with zeros
        inx     d
        dcr     b
        jnz     lclrlp
        pop     d               ;restore accum address
;
chkexp:                 ;check for over/under flow
        ldax    d               ;get exponent
        ora     a
        jm      chkunder
        cpi     64
        jc      goodexit
        jmp     overflow
;
chkunder:
        cpi     -63
        jc      underflow
goodexit:
        mvi     a,0
        sta     errflt
        pop     b
        ret
;
movrgt:                 ;fraction overflow
        inr     c               ;bump exponent
        mov     a,c
        stax    d               ;save in accum
        mvi     b,15
        push    d               ;save for check at end
        lxi     h,16
        dad     d               ;end address for backwards move
        mov     d,h
        mov     e,l
rmovlp:
        dcx     d
        ldax    d
        mov     m,a
        dcx     h
        dcr     b
        jnz     rmovlp
        mvi     m,0             ;zap overflow byte back to zero
        pop     d               ;restore exponent addr
        jmp     chkexp
;
underflow:
        mvi     a,1
        sta     errflt
        call    userrtn         ;check for user routine to handle errors
        jmp zresult             ; мое новшество
overflow:
        mvi     a,2
        sta     errflt
setbig:
        call    userrtn         ;check for user routine to handle errors
        lhld    flprm
        inx     h               ;leave sign alone
        mvi     m,63            ;set exponent at max
        inx     h
        mvi     m,0             ;clear overflow byte
        mvi     a,0ffH          ;and set fraction to max
        mvi     b,7
oclr:
        inx     h
        mov     m,a
        dcr     b
        jnz     oclr
        inx     h
        mvi     m,0
        pop     b
        ret
;
userrtn:
       ret     ; мое новшество !!!
oclr
        inx     h
        mvi     m,0
        pop     b
        re