;EasyCodeName=Module1,1
;lpDecimal
;To buď ukazuje na celé číslo DWORD v paměti, nebo je to okamžité celé číslo DWORD podle obsahu uID.
;Nízký bajt nízkého slova celého čísla udává počet desetinných číslic, které mají být vráceny ve výsledku. 
;Celkový počet celočíselných a desetinných číslic nesmí překročit 16. Jinak se počet desetinných číslic odpovídajícím způsobem sníží. 
;(Všimněte si, že vždy je vrácena alespoň jedna celá číslice.)
;Vysoký bajt nízkého slova celého čísla udává počet znaků před desetinnou čárkou, přičemž mezery se používají pro odsazení. 
;Toto číslo nesmí překročit 17 (16 číslic + znak); jinak by byl snížen na 17. (Tento bajt je ignorován, pokud uID naznačuje, že výsledek musí být vrácen ve vědeckém formátu.)
;Vysoké slovo tohoto parametru Je ignorováno.



;Význam vlajky uID
;SRC1_FPU Src1 je již na FPU
;SRC1_REAL Src1 je ukazatel na 80bitové SKUTEČNÉ číslo
;SRC2_DMEM Src2 je ukazatel na 32bitové celé číslo se znaménkem
;SRC2_DIMM Src2 je 32bitové celé číslo se znaménkem
;STR_REG Řetězec musí být vrácen v desítkovém formátu
;STR_SCI Řetězec musí být vrácen ve vědecké notaci

.Const

.Data?

.Data

.Code


Real8ToReal10 Proc FastCall Frame lpSrc:QWord
	Mov lpSrc, Rcx
	Fld QWord Ptr lpSrc
	Fstp TByte Ptr Result
	Ret
Real8ToReal10 EndP

Real4ToReal10 Proc FastCall Frame lpSrc:QWord
	Mov lpSrc, Rcx
	Fld DWord Ptr lpSrc
	Fstp TByte Ptr Result
	Ret
Real4ToReal10 EndP


;Význam vlajky uID
;SRC1_FPU Src1 je již na FPU
;SRC1_REAL Src1 je ukazatel na 80bitové SKUTEČNÉ číslo
;SRC2_DMEM Src2 je ukazatel na 32bitové celé číslo se znaménkem
;SRC2_DIMM Src2 je 32bitové celé číslo se znaménkem
;STR_REG Řetězec musí být vrácen v desítkovém formátu
;STR_SCI Řetězec musí být vrácen ve vědecké notaci

FpuFLtoA64 Proc Public lpSrc:QWord, lpDecimal:DWord, lpDest:QWord, uID:DWord

	Local tempdw:QWord
	Local esize:DWord
	Local Padding:DWord
	Local Decimal:QWord
	Local content[108] :Byte
	Local tempst:TByte
	Local bcdstr:TByte
	Local oldcw:Word
	Local truncw:Word
	Local unpacked[20] :Byte    

	Mov lpSrc, Rcx
	Mov lpDecimal, Edx
	Mov lpDest, R8
	Mov uID, R9d


;get the specified number of decimals for result
;and make corrections if necessary

      Mov   Eax,lpDecimal
      Test  uID,SRC2_DMEM
      Jz    @F
      Mov   Eax,[Eax]         ;get the decimals from memory
   @@:
      Push Rax
      Movzx Eax,Al            ;low byte - number of decimal digits
      Cmp   Eax,15
      Jbe   @F
      Mov   Eax,15            ;a maximum of 15 decimals is allowed
   @@:
      Mov Decimal, Rax
      Pop Rax
      Movzx Eax,Ah            ;2nd byte - number of char before decimal point
      Cmp   Eax,17
      Jbe   @F
      Mov   Eax,17            ;a maximum of 17 characters is allowed
   @@:
      Mov   Padding,Eax

      Test uID, SRC1_FPU      ;is data taken from FPU?
      Jz    @F                ;continue if not

;-------------------------------
;check if top register is empty
;-------------------------------

      Fxam                    ;examine its content
      Fstsw Ax                ;store results in AX
      Fwait                   ;for precaution
      Sahf                    ;transfer result bits to CPU flag
      Jnc   @F                ;not empty if Carry flag not set
      Jpe @F                  ;not empty if Parity flag set
      Jz srcerr1        	  ;empty if Zero flag set

@@:
      Fsave content
;
;----------------------------------------
;check source for Src and load it to FPU
;----------------------------------------
;
      Test  uID,SRC1_FPU
      Jz    @F
      Lea   Eax,content
      Fld   TByte Ptr[Eax+28]
      Jmp   dest0

   @@:
      Test  uID,SRC1_REAL     ;is Src an 80-bit REAL in memory?
      Jz    srcerr            ;no proper source identificaiton
      Mov Rax, lpSrc
      Fld TByte Ptr [Rax]
      Jmp   dest0             ;go complete process

;Vypíše ERROR      
srcerr:
      Frstor content
srcerr1:
      Push Rdi
      Mov Rdi, lpDest
      Mov Rax, "ORRE"
      Stosd
      Mov   Ax,"R"
      Stosw
      Pop Rdi
      Xor Rax, Rax
      Ret
;
dest0:
;
;-------------------------------------------
;first examine the value on FPU for validity
;-------------------------------------------
;
      fxam                    ;examine value on FPU
      fstsw ax                ;get result
      fwait
      sahf                    ;transfer to CPU flags
      jz    maybezero
      jpo   srcerr            ;C3=0 and C2=0 would be NAN or unsupported
      jnc   getnumsize        ;continue if normal finite number
;
;--------------------------------
;value to be converted = INFINITY
;--------------------------------
;
      Push Rcx
      Push Rsi
      Push Rdi
      Mov Rdi, lpDest
      mov   al,"+"
      test  ah,2              ;C1 field = sign
      jz    @F
      mov   al,"-"
   @@:
      stosb
      Mov Rax, "IFNI"
      stosd
      Mov Rax, "YTIN"
      stosd
      jmp   finish      
;
;-------------------------
;value to be converted = 0
;-------------------------
;
maybezero:
      jpe   getnumsize        ;would be denormalized number
      fstp  st(0)             ;flush that 0 value off the FPU
      Push Rcx
      Push Rsi
      Push Rdi
      Mov Rdi, lpDest
      test  uID,STR_SCI       ;scientific notation?
      jnz   @F                ;no padding
      mov   ecx,Padding
      sub   ecx,2
      jle   @F                ;no padding specified or necessary
      mov   al," "
      rep   stosb
   @@:
      mov   ax,3020h          ;" 0" szstring
      stosw                   ;write it
      jmp   finish
;      
;---------------------------
; get the size of the number
;---------------------------
;
getnumsize:
      fldlg2                  ;log10(2)
      fld   st(1)             ;copy Src
      fabs                    ;insures a positive value
      fyl2x                   ;->[log2(Src)]*[log10(2)] = log10(Src)
      
      fstcw oldcw             ;get current control word
      fwait
      mov   ax,oldcw
      or    ax,0c00h          ;code it for truncating
      mov   truncw,ax
      fldcw truncw            ;insure rounding code of FPU to truncating
      
      fist  esize             ;store characteristic of logarithm
      fldcw oldcw             ;load back the former control word

      ftst                    ;test logarithm for its sign
      fstsw ax                ;get result
      fwait
      sahf                    ;transfer to CPU flags
      sbb   esize,0           ;decrement esize if log is negative
      fstp  st(0)             ;get rid of the logarithm
;
;-----------------------------------------------------------------------
; get the power of 10 required to generate an integer with the specified
; number of significant digits
;-----------------------------------------------------------------------
;
      mov   eax,uID
      and   eax,STR_SCI
      .if   eax == 0          ;regular decimal notation
            mov   eax,esize
            or    eax,eax     ;check if number is < 1
            js    @F
            .if   eax > 15    ;if number is >= 10^16
                  or    uID,STR_SCI ;switch to scientific notation
                  mov   Decimal,15  ;insures 15 decimal places in result
                  jmp   scific
            .endif
            Add Rax, Decimal
            .If Rax > 15    ;if integer + decimal digits > 16
                  Sub Rax, 15
                  Sub Decimal, Rax ;reduce decimal digits as required
            .endif
         @@:
            push  Decimal
            pop   tempdw
      .else                   ;scientific notation
      scific:
            Mov Rax, Decimal
            Sub Eax, esize
            Mov tempdw, Rax
      .endif
;
;----------------------------------------------------------------------------------------
; multiply the number by the power of 10 to generate required integer and store it as BCD
;----------------------------------------------------------------------------------------
;
.if   tempdw != 0
      fild  tempdw
      fldl2t
      fmul                    ;->log2(10)*exponent
      fld   st(0)
      frndint                 ;get the characteristic of the log
      fxch
      fsub st,st(1)           ;get only the fractional part but keep the characteristic
      f2xm1                   ;->2^(fractional part)-1
      fld1
      fadd                    ;add 1 back
      fscale                  ;re-adjust the exponent part of the REAL number
      fstp  st(1)             ;get rid of the characteristic of the log
      fmul                    ;->16-digit integer
.endif

      fbstp bcdstr            ;->TBYTE containing the packed digits
      fstsw ax                ;retrieve exception flags from FPU
      fwait
      shr   eax,1             ;test for invalid operation
      jc    srcerr            ;clean-up and return error
;
;------------------------------------------------------------------------------
; unpack BCD, the 10 bytes returned by the FPU being in the little-endian style
;------------------------------------------------------------------------------
;
      Push Rcx
      Push Rsi
      Push Rdi
      Lea Rsi, bcdstr + 9      ;go to the most significant byte (sign byte)
      Lea Rdi, unpacked
      mov   eax,3020h
      Mov Cl, Byte Ptr [Rsi]  ;sign byte
      .if   cl == 80h
            mov   al,"-"      ;insert sign if negative number
      .endif
      stosw
      mov   ecx,9
   @@:
      Dec Rsi
      Movzx Eax, Byte Ptr [Rsi]
      ror   ax,4
      ror   ah,4
      add   ax,3030h
      stosw
      dec   ecx
      jnz   @B

      Mov Rdi, lpDest
      Lea Rsi, unpacked
      test  uID,STR_SCI       ;scientific notation?
      Jnz scientific
;
;************************
; REGULAR STRING NOTATION
;************************

;------------------------------
; check if padding is specified
;------------------------------
;
      mov   ecx,Padding
      or    ecx,ecx           ;check if padding is specified
      jz    nopadding
      
      mov   edx,2             ;at least 1 integer + sign
      mov   eax,esize
      or    eax,eax
      js    @F                ;only 1 integer digit if size is < 1
      add   edx,eax           ;->number of integer digits
   @@:
      sub   ecx,edx
      jle   nopadding
      mov   al," "
      rep   stosb

nopadding:
      Pushfq                  ;save padding flags
      movsb                   ;insert sign
      mov   ecx,1             ;at least 1 integer digit
      mov   eax,esize
      or    eax,eax           ;is size negative (i.e. number smaller than 1)
      js    @F
      add   ecx,eax
   @@:
      Mov Rax, Decimal
      Add Rax, Rcx           ;->total number of digits to be displayed
      Sub Rax, 19
      Sub Rsi, Rax           ;address of 1st digit to be displayed
      Pop Rax               ;retrieve padding flags in EAX
      .If Byte Ptr [Rsi - 1] == "1"
            Dec Rsi
            inc   ecx
            Push Rax         ;transfer padding flags through stack
            Popfq             ;retrieve padding flags
            jle   @F          ;no padding was necessary
            Dec Rdi         ;adjust for one less padding byte
      .endif
   @@:
      rep   movsb             ;copy required integer digits
      Mov Rcx, Decimal
      Or Rcx, Rcx
      jz    @F
      mov   al,"."
      stosb
      rep   movsb             ;copy required decimal digits
   @@:
      jmp   finish
;
;********************
; SCIENTIFIC NOTATION
;********************
;
scientific:
      movsb                   ;insert sign
      Mov Rcx, Decimal
      mov   eax,18
      sub   eax,ecx
      Add Rsi, Rax
      Cmp Byte Ptr [Rsi - 1], "1"
      Pushfq                  ;save flags for extra "1"
      jnz   @F
      Dec Rsi
   @@:
      movsb                   ;copy the integer
      mov   al,"."
      stosb
      rep   movsb             ;copy the decimal digits

      mov   al,"E"
      stosb
      mov   al,"+"
      mov   ecx,esize
      Popfq                   ;retrieve flags for extra "1"
      jnz   @F                ;no extra "1"
      inc   ecx               ;adjust exponent
   @@:
      or    ecx,ecx
      jns   @F
      mov   al,"-"
      neg   ecx               ;make number positive
   @@:
      stosb                   ;insert proper sign

;Note: the absolute value of the size could not exceed 4931
      
      mov   eax,ecx
      mov   cl,100
      div   cl                ;->thousands & hundreds in AL, tens & units in AH
      Push Rax
      and   eax,0ffh          ;keep only the thousands & hundreds
      mov   cl,10
      div   cl                ;->thousands in AL, hundreds in AH
      add   ax,3030h          ;convert to characters
      stosw                   ;insert them
      Pop Rax
      shr   eax,8             ;get the tens & units in AL
      div   cl                ;tens in AL, units in AH
      add   ax,3030h          ;convert to characters
      stosw                   ;insert them
;
finish:
      Xor   Eax,Eax
      Stosb                   ;string terminating 0
      Pop Rdi
      Pop Rsi
      Pop Rcx

      Frstor content

      Or    Al,1              ;to insure EAX!=0
      Ret
      
FpuFLtoA64 EndP

; #########################################################################

end
