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 / CMPCHK.SRC < prev    next >
Text File  |  1999-04-05  |  2KB  |  61 lines
  1. ;ROUTINES TO COMPLEMENT AN OPERAND, AND CHECK FOR A ZERO OPERAND
  2. ;
  3.     NAME CMPCHK
  4.     ENTRY .COMPOP,.COMP1,.ZERCHK,.ZERCK1,.FPNEG
  5.     INCLUDE FPINIT.SRC
  6. ;
  7. ; complement an operand
  8. ;
  9. .compop:    dad    d        ;and calculate addr of fpacc
  10. .comp1:    mvi    b,fracln    ;process whole mantissa
  11.     mov    a,m        ;get first byte
  12.     cma            ;complement and...
  13.     adi    1        ;..add one
  14. compl:    mov    m,a        ;save present byte
  15.     inx    h        ;bump pointer
  16.     mov    a,m        ;get next byte
  17.     cma            ;complement and add
  18.     aci    0        ;carry
  19.     djnz    compl        ;check for last byte
  20.     ret            ;yes...done
  21.  
  22. ;
  23. ; check number for a zero, or negative zero ( neg. zero can only be
  24. ;   generated by a floating point operation )
  25. ;
  26. ;
  27. .zerchk:
  28.     dad    d        ;and calculate address of fpacc
  29. .zerck1:
  30.     xra    a        ;clear flags
  31.     mov    a,m        ;into accumulator
  32.     ani    7fh        ;check for zero, masking sign bit
  33.     dcx    h
  34.     mvi    b,fracln-1    ;process whole mantissa
  35. zchka:    ora    m        ;check next byte
  36.     dcx    h        ;bump pointer
  37.     djnz    zchka        ;any more?
  38.     ret            ;no, return
  39. ;
  40. ;negate a f.p. number.  if zero, don't negate
  41. ;
  42. ;
  43. .fpneg:
  44.     lxi    h,4
  45.     dad    s        ;msb of mantissa
  46.     xra    a        ;clear flags
  47.     mov    a,m
  48.     ani    7fh        ;check msb with sign bit masked
  49.     dcx    h
  50.     ora    m        ;check middle byte
  51.     dcx    h
  52.     ora    m        ;check low byte
  53.     jrz    zer        ;if number is zero, don't negate
  54.     inx    h
  55.     inx    h        ;msb of mantissa
  56.     mvi    a,80h        ;set high bit
  57.     xra    m        ;toggle high bit of msb of mantissa
  58.     mov    m,a        ;replace high word of mantissa
  59. zer:    ret            ;and return
  60.  
  61.