home *** CD-ROM | disk | FTP | other *** search
/ norge.freeshell.org (192.94.73.8) / 192.94.73.8.tar / 192.94.73.8 / pub / computers / cpm / alphatronic / PASCALZ4.ZIP / D3 / FPRLOP.SRC < prev    next >
Text File  |  1999-04-05  |  3KB  |  86 lines
  1. ; floating point relational operators
  2. ;
  3.     NAME FPRLOP
  4.     ENTRY .FPEQ,.FPNEQ,.FPLTE,.FPLT,.FPGTE,.FPGT
  5.     INCLUDE FPINIT.SRC
  6. ;
  7. frelop:    macro    flags        ;;do a relop and check the correct flags
  8.     call    cmpops        ;;compare the operands
  9.     ani    flags        ;;check the return flags
  10.     jr    relfin        ;;...and finish the relop
  11.     endmac
  12. .fpgt:    frelop    gtbit        ;check the greater than bit
  13. .fpgte:    frelop    gtbit+eqbit    ;check the greater than and equal to bits
  14. .fplt:    frelop    ltbit        ;check the less than bit
  15. .fplte:    frelop    ltbit+eqbit    ;check the less than and equal to bits
  16. .fpeq:    frelop    eqbit        ;check equal to bit
  17. .fpneq:    frelop    ltbit+gtbit    ;check less than and greater than bits
  18. relfin:    mvi    a,0        ;clear accumulator
  19.     rz            ;return false if status bit wasn't set
  20.     stc            ;otherwize set the carry bit
  21.     ret            ;and return
  22. ;
  23. ; compare two floating point operands
  24. ;
  25. cmpops:    push    x        ;save ix
  26.     lxi    x,6        ;make ix point to bottom of op2
  27.     xra    a        ;clear the carry and...
  28.     dadx    s
  29.     mov    c,6(x)        ;get sign of op1
  30.     mov    e,2(x)        ;get sign of op2
  31.     mov    a,c
  32.     xra    e        ;check for like signs
  33.     jm    dfsgns        ;no, different signs
  34.     mov    a,5(x)        ;check for op1 = 0
  35.     ora    4(x)
  36.     ora    c
  37.     jrnz    cmp2        ;no, it's non-zero
  38.     mvi    7(x),080h    ;yes, set exponent to -128
  39. cmp2:    mov    a,1(x)        ;check for op2 = 0
  40.     ora    0(x)
  41.     ora    e
  42.     jrnz    cmp3        ;no, it's non-zero
  43.     mvi    3(x),080h    ;yes, set exponent to -128
  44. cmp3:    mov    a,7(x)        ;yes, get exponents and toggle
  45.     xri    80h        ;the high order bit in order to
  46.     mov    b,a        ;check the relative magnitudes
  47.     mov    a,3(x)        ;now do op2
  48.     xri    80h
  49.     cmp    b        ;check against op1.exponent
  50.     jrnz    fpdiff        ;they're different
  51.     mov    a,e        ;get high byte of op2's mantissa
  52.     cmp    c        ;check against op1's
  53.     jrnz    fpdiff        ;they're diferent
  54.     mov    a,1(x)        ;get middle byte of op2's mantissa
  55.     cmp    5(x)        ;compare against op1's
  56.     jrnz    fpdiff
  57.     mov    a,0(x)        ;get low byte of op2's mantissa
  58.     cmp    4(x)        ;check against op1's
  59.     jrnz    fpdiff
  60.     mvi    a,eqbit        ;op1 = op2
  61.     jr    cmpdon        ;done comparing
  62. dfsgns:    slar    e        ;get sign bit of op2 into carry
  63.     jr    fpdf1        ;don't check signs
  64. fpdiff:    bit    sign,c        ;check sign bit
  65.     jrz    fpdf1        ;both numbers +ive
  66.     cmc            ;both numbers negative, reverse test
  67. fpdf1:    jrc    obig        ;if carry then op1 > op2
  68.     mvi    a,ltbit        ;op1 < op2
  69.     jr    cmpdon
  70. obig:    mvi    a,gtbit        ;op1 > op2
  71. cmpdon:    pop    x        ;restore ix
  72.     pop    d        ;get return address
  73.     pop    h        ;get second return address
  74.     pop    b        ;kill op2
  75.     pop    b
  76.     pop    b        ;kill op1
  77.     xthl            ;restore second return address
  78.     xchg            ;hl <- return address
  79.     pchl            ;return
  80. ;
  81. ;
  82. ; STATUS BITS
  83. EQBIT:    EQU    1        ;HL = DE
  84. LTBIT:    EQU    2        ;HL < DE
  85. GTBIT:    EQU    4        ;HL > DE
  86.