home *** CD-ROM | disk | FTP | other *** search
- ; ==============================================================
- ;
- ; REC module for some of the operators and predicates concerning
- ; numeric operands. These comprise:
- ;
- ; conversion, including compilation of numbers:
- ;
- ; [-]{d}.{d} | [-]d{d} | -{d}.{d}<E|D>[-|+]{d} |
- ; [-]d{d}<E|D>[-|+]{d} : numeric constant
- ; O : decimal ascii string to number
- ; # : number to decimal ascii string
- ;
- ; arithmetic:
- ;
- ; ~ : complement or negative
- ;
- ; --------------------------------------------------------------
- ;
- ; FLT87 - Copyright (c) 1986
- ; Gerardo Cisneros & Harold V. McIntosh
- ; Derechos Reservados
- ;
- ; [Gerardo Cisneros, 11 April 1984]
- ;
- ; 7 Feb 1986 - 8087 support added - GCS
- ; ==============================================================
-
- ; Compile a decimal number, which requires reading any
- ; further digits that follow including decimal point and
- ; exponent, and saving the terminator.
-
- RECDD: mov FRST,al ;save first character
- push dx ;save compilation address
- push cx ;save execution address
- call word ptr read ;fetch next character
- call recds ;build string
- pop cx ;recover execution address
- DD1: pop dx ;recover compilation pointer
- push ax ;save terminating character
- call recop ;compile subroutine call
- mov al,NSIZ ;get final constant size
- mov di,dx
- mov cs:[di],al ;save in calling sequence
- inc di
- mov si,(offset ARG1)
- mov cl,al
- mov ch,0
- mov bp,cs
- call xf2
- mov dx,di ;updated exec ptr back to DX
- pop ax ;recover terminating character
- jmp skp86 ;skip over character read call
-
- ; (O) Transform an ASCII character string on the PDL into a
- ; two or four byte integer or a single or double precision
- ; floating point number. Predicate - false if the argument
- ; is not a digit string or null, leaving the argument unchanged.
-
- UCO: mov byte ptr NSIZ,2 ;assume two-byte digit will be produced
- mov read,(offset pty) ;make buffer out of arg
- mov bx,PX ;start of the string
- mov RX,bx
- mov bx,PY ;end of the string, plus 1
- mov (byte ptr[bx]),00 ;add a NUL at the end
- inc bx
- mov RY,bx
- mov RSEG,ds
- call word ptr read
- or al,al
- jnz nnul ;skip if string not null
- mov word ptr ARG1,0000 ;null string, make 0
- jmp short o1
-
- nnul: mov FRST,al ;save first character
- call word ptr read ;get next character
- call recds ;and gather rest of number
- test al,al ;returned character must be NUL
- jz o1
- ret ;return FALSE if not
- o1: mov cl,NSIZ ;else we have a number of size (nsiz)
- mov ch,00 ;set up (BC) to allocate space on PDL
- call OARG ;get it
- mov PY,bx
- sub bx,cx ;recompute PX
- mov di,bx
- mov si,(offset ARG1)
- call xf1 ;move to PDL from arg1 onward
- jmp SKP ;take TRUE exit
-
- ; The heart of number parsing and conversion
-
- recds: push ax ;save second character
- mov byte ptr NSIZ,2 ;assume 2 byte integer
- call dsinit ;initialize number gathering areas and flags
- mov al,FRST ;start parsing
- cmp al,'-'
- jz ds1
- cmp al,'0' ;leading 0 may mean 4 byte integer
- jz ds4
- cmp al,'.' ;floating point implied by period
- jz ds5
- pop bx ;get second char, foreseeing ret in rnd
- call RND ;return if not a digit at this point
- mov byte ptr ARG1,al ;put in the digit-gathering buffer
- mov al,bl ;get second character
- jmp short ds6 ;go ahead with rest
-
- ds1: pop ax ;negative number, examine next char.
- cmp al,'.'
- jnz ds3
- ds2: mov DCPT,al ;period after minus or zero; record fact,
- call word ptr read ;get next character
- jmp short ds5a ;and go indicate floating point size
-
- ds3: call RND ;return if not period and not digit after sign
- jnz ds3b ;if not zero, restore to ascii
- ds3a: mov byte ptr NSIZ,4 ;set to gather a 4-byte integer
- ds3b: add al,'0' ;restore to ascii before continuing to gather
- jmp short ds6
-
- ds4: pop ax ;character following 0 may be:
- cmp al,'E' ; E, single precision exponent
- jz ds6
- cmp al,'D' ; D, double precision exponent
- jz ds6
- cmp al,'.' ; ., decimal point
- jz ds2
- call RND ; or digit; in the latter case
- jmp ds3a ;we set up for a 4-byte integer
-
- ds5: mov DCPT,al ;period as first character, record found
- pop ax ;fetch 2nd char before going on
- ds5a: mov byte ptr NSIZ,5 ;record size of single precision operand
-
- ds6: call dsgath ;go gather rest
- push ax ;save terminating character
- call dsend ;do final number-building
- pop ax ;put terminating character back in A
- ret ;done
-
- ; digit-gathering loop
-
- dsg1: call word ptr read
- dsgath: cmp al,'.' ;check decimal point first
- jnz dsg2
- mov ah,DCPT
- test ah,ah
- jz dsg1a
- ret ;period found twice, return
- dsg1a: mov DCPT,al ;first one, record fact
- mov byte ptr NSIZ,5 ;set single precision size
- jmp short dsg1
-
- dsg2: cmp al,'E' ;check S.P. exponent
- jnz dsg3
- mov ah,5
- dsg2a: mov NSIZ,ah ;S.P. size
- jmp short dsxpt ;go gather exponent
-
- dsg3: cmp al,'D' ;check D.P. exponent
- mov ah,8
- jz dsg2a
-
- call RND ;finally, check for digit
- mov cx,ax ;save digit in b
- mov al,ARG1H ;high order byte of significand
- and al,0F0H ;check highest nibble
- jz dsg3a ;skip if high nibble = 0
-
- xor al,al ;else drop, but check if digit dropped
- or al,DCPT ;belongs to integer or fractional part:
- jnz dsg1 ;continue gathering if fractional part
-
- inc DDCT ;else add 1 to partial exponent due to dropping
- jmp short dsg1 ;of integer part digit and continue gathering
-
- dsg3a: xor al,al
- or al,DCPT ;if decimal point not recorded
- jz dsg4 ;proceed to tack on this digit,
- dec DDCT ;else decr.partl expt due to incl of fract dig
-
- dsg4: push cx ;save digit
- call txp ;multiply current mantissa by 10
- mov di,(offset ARG2) ;set up alternate buffer
- call zarg ;to receive the next digit
- pop ax ;retrieve digit into ax
- mov byte ptr ARG2,al
- call add8 ;add it to previous mantissa
- jmp short dsg1 ;and continue gathering
-
- ; Exponent-gathering
-
- dsxpt: call word ptr read ;get next character
- mov DXSG,al ;save as indicator of decimal exponent sign
- mov bx,0 ;exponent will be put together in HL
- cmp al,'-' ;negative?
- jz dsx2 ;yes, go to next char
- cmp al,'+' ;explicit positive sign?
- jnz dsx3 ;no, go check if digit
-
- dsx2: call word ptr read ;fetch next character
- dsx3: mov DCXPT,bx ;save partially gathered exponent
- call RND ;terminate if not a digit
- mov cx,bx ;copy HL into BC
- sal bx,1 ;multiply HL by 4
- sal bx,1
- add bx,cx ;make it 5
- sal bx,1 ;twice again, to make it times 10
- add bx,ax ;add current digit
- test bh,0FCH ;check for exponent overflow
- jz dsx2
- mov bx,03FFH ;set large decimal exponent
- jmp dsx2
-
- ; Final number buildup
-
- dsend: cmp byte ptr NSIZ,5
- jc dsn0
- call dnd0 ;put together F.P. numbers
- dsn0: cmp byte ptr FRST,'-' ;take care of initial sign
- jz dsn1
- ret
- dsn1: mov al,NSIZ
- mov bx,(offset ARG1)
-
- ; Subroutine for negation of numeric arguments
-
- negn: cmp al,5
- mov cl,al
- mov ch,0
- jnc negr ;negate F.P. numbers
- ngn1: clc ;clear carry
- shr cx,1 ;divide count by 2 to do it by words
- ngn0: mov ax,0000 ;negate multi-byte integer
- sbb ax,[bx]
- mov [bx],ax
- inc bx
- inc bx
- loop ngn0
- ret
-
- negr: dec cx ;find exponent byte
- add bx,cx ;got it
- negr1: mov al,[bx]
- mov cl,al ;save it
- dec bx
- or al,[bx]
- jz negr2 ;return if operand is zero
- xor cl,80H ;complement sign bit
- inc bx ;point back to high byte
- mov [bx],cl ;restore exponent with changed mantissa sign
- negr2: ret ;done
-
- ; check if argument has size 0, 1, 2, 4, 5 or 8.
- ; zero flag is returned if size is 5 or 8
-
- numchk: mov bx,PX
- mov cx,PY
- mov dx,cx ;a copy of PY into DX
- sub cx,bx
- test ch,ch
- jnz nch1 ;no large arguments
- cmp cl,8
- jz nch0
- jnc nch1 ;no args of size gt 8
- cmp cl,5
- jz nch0
- jnc nch1 ;no size 6 or 7 args
- cmp cl,3
- jz nch1 ;no size 3 args
- nch0: ret
- nch1: jmp RER
-
- ; (~) Complement or negate the top of the PDL
-
- comp: call numchk
- jz negr ;negate F.P. argument
- test cl,cl
- jz cmp0 ;leave null string as is
- cmp cl,2
- jnc ngn1 ;negate 2 or 4-byte integer
- not byte ptr[bx] ;1-byte argument, do a log. complement
- cmp0: ret
-
- ; Final assembly of floating point operands
-
- dnd0: cmp byte ptr DXSG,'-' ;set proper decimal exponent sign
- jnz dnd1 ;skip if not negative
- neg DCXPT
-
- dnd1: mov al,DDCT ;fetch partial exponent due to digit-gathering
- cbw ;extend its sign into ah
- add ax,DCXPT ;compute final decimal exponent in HL
- mov DCXPT,ax ;and save it
- call zach ;check if arg1=0
- jnz dnd1a
- ret ;done if mantissa is zero
- dnd1a: mov dx,043EH ;else compute biased binary exponent
-
- dnd3: push dx ;save binexpt
- jmp short dnd3b
- dnd3a: call div10b ;mantissa will be divided by 10 if DCXPT<0
- dnd3b: call norg1 ;normalize arg1 (shift until high bit = 1)
- jz dnd3c
- pop bx
- add dx,bx ;reduce binexpt by amount shifted
- jnc ufl
- push dx
- dnd3c: mov bx,DCXPT ;check DCXPT sign
- test bx,bx
- js dnd3a ;go divide by 10 if dec. expt. negative
- jz dspack ;zero, do final packing
- call m58thb ;mult by 10/16 if positive
- jnc dnd3 ;beware of bin. expt. overflow
- jmp short ovf
-
- ; Pack up exponent and mantissa
-
- dspack: pop word ptr BINXPT ;retrieve binary exponent
- mov di,(offset ARG2) ;first do rounding of the mantissa
- call zarg
- mov bx,(offset ARG2B)
- cmp byte ptr NSIZ,8 ;set rounding bit according to size
- jnz dsp0
- shr al,1 ;make it a 4 to be the
- dec bx ; next to high bit of next to low nibble
- jmp short dsp0a
- dsp0: mov al,80H ;high bit
- inc bx ; of 5th mantissa byte for SP
- inc bx ;of 4th byte when 8087 is used
- dsp0a: mov (byte ptr[bx]),al ;store
- call add8 ;round
- jnc dsp1 ;skip if rounding produced no carry
- mov byte ptr ARG1H,080H ;else set MSbit of mantissa
- inc word ptr BINXPT ;and adjust bin. expt.
- jz ovf ;skip to overflow if it became 0
-
- dsp1: cmp byte ptr NSIZ,5 ;which size
- jnz dsp2 ;skip if D.P.
- mov ax,0FC80H ;constant to adjust S.P. bias
- add ax,word ptr BINXPT
- jz ufl ;0 means underflow
- jnc ufl
- test ah,ah ;(HL) must end up between 1 and 0FEH
- jnz ovf
- mov ah,al
- inc al
- jz ovf ;0FFH also invalid
- mov al,byte ptr ARG1H ;MSByte to al
- rol al,1 ;get rid of MSbit
- shr ax,1 ;binexpt LSbit into its place, 0 to sign
- mov word ptr ARG1H,ax
- mov di,(offset ARG1) ;shift S.P. number down 4 bytes
- mov si,(offset ARG1M)
- mov byte ptr [si],0 ;clear 5th byte (lowest) when using 8087
- mov cx,5
- jmp xf1 ;shift the upper 5 bytes
-
- ; Handle underflow in binary exponent
-
- ufl: call zarg1 ;make it all zero
- mov FRST,al ;including the sign
- ret
-
- ; Handle overflow in binary exponent
-
- ovf: call zarg1 ;set up infinite operand
- mov cx,7F80H ;first two bytes of SP infinite
- cmp byte ptr NSIZ,5 ;set rightmost bits of exponent
- jnz ov1 ;according to size of operand
- mov word ptr(ARG1M-1),cx
- ret
-
- ov1: or cl,70H ;D.P. handled here
- mov word ptr ARG1B,cx ;set next byte
- ret
-
- dsp2: mov dx,word ptr BINXPT
- cmp dx,07FFH
- jnb ovf ;07FFH or bigger is an overflow
- call halve ;shift mantissa down 3 bits
- call halve
- call halve
- mov cl,4
- sal dx,cl ;and shift exponent up 4 bits
- mov al,0FH
- and al,ARG1H ;mask implicit bit off
- or dl,al ;insert lower 4 bits of exponent
- mov word ptr ARG1H,dx ;store it
- mov di,(offset ARG1) ;shift one byte down
- mov si,di
- inc si
- mov cx,8
- jmp xf1 ;done when finished shifting
-
- ; (#) Change binary number into a decimal-based ASCII
- ; string as follows:
- ; size of max. size form
- ; number of string
- ; 0 1 0
- ; 1 3 d{d}
- ; 2 5 d{d}
- ; 4 12 [-]0d{d}
- ; 5 15 [-]d{d}.{d}[E[s]d{d}]
- ; 8 21 [-]d{d}.{d}D[s]d{d}
-
- ns: call numchk ;check for numerical argument
- mov NSIZ,cl ;record size in memory
- mov al,cl ;and in AL
- shl cl,1 ;compute size of maximum string
- inc cl
- cmp cl,11 ;is it FP?
- jc nsaa
- and cl,0FDH ;drop 2 if S.P. when using 8087
- inc cl ;yes, make it 1 longer
- nsaa: cmp cl,9 ;is it 4 bytes or longer?
- jc nsbb
- add cl,3 ;yes, make it 3 longer
- nsbb: call OARG ;and find out whether there is enough space for it
- mov si,PY ;load source index before modifying py
- sub bx,cx ;recompute PX
- mov PY,bx ;close interval before string production
- cmp al,4
- jnc nslrg ;jump on long operands
- mov cl,al
- mov ax,0000 ;put zero in DE for default
- jcxz ns1 ;load nothing
- mov al,[bx] ;load low byte
- dec cx ;test for one byte
- jcxz ns1 ;only byte and it's loaded
- mov ah,1[bx] ;load high byte
-
- ; The following code is also used to convert exponents of
- ; floating point operands and long integers whose high
- ; word is null.
-
- ns1: mov bp,bx ;save pointer for ASCII string
- mov cl,'0' ;prepare to write a zero
- mov bx,-10000 ;will there be 5 digits?
- add bx,ax ;
- jb ns2
- mov bx,-1000 ;will there be 4 digits?
- add bx,ax ;
- jb ns3
- mov bx,-100 ;will there be 3 digits?
- add bx,ax ;
- jb ns4
- mov bx,-10 ;will there be 2 digits?
- add bx,ax ;
- jb ns5
- jmp ns6 ;write one no matter what
- ns2: mov bx,10000 ;ten thousands digit
- call nsa ;
- ns3: mov bx,1000 ;thousands digit
- call nsa ;
- ns4: mov bx,100 ;hundreds digit
- call nsa ;
- ns5: mov bx,10 ;tens digit
- call nsa ;
- ns6: add cl,al ;units digit
- mov ds:[bp],cl ;store the digit
- inc bp ;position pointer for next byte
- mov PY,bp ;done, store it as terminator
- ret
-
- nsa: mov dx,0000 ;clear extension for div
- div bx ;div bx into axdx
- add cl,al ;form ASCII digit
- mov ax,dx ;put remainder in ax
- mov ds:[bp],cl ;store new digit
- inc bp ;advance pointer
- mov cl,'0' ;load a fresh ASCII zero
- ret
-
- ; Long number conversion to ASCII starts here.
- ; HL contains (px) on entry.
-
- nslrg: call dsinit ;clear all number buffers
- mov cl,NSIZ
- mov di,(offset arghh) ;get destination address +1
- call mduc ;move by decrement until count
- cld ;note: es=ds by call to mduc
- mov di,PY ;get ptr to next available byte for string
- cmp byte ptr NSIZ,4 ;do we have an integer?
- jnz nsflt ;no, jump to F.P. processor
- mov al,ARG1H ;yes, check its sign
- test al,al
- jns nsl2
- mov bx,(offset ARG1M) ;negate the 4-byte operand
- mov cx,4
- call ngn1
- mov al,'-'
- stosb ;record the negative sign
- nsl2: mov al,'0'
- stosb ;long integers have a leading 0
- mov PY,di ;save
- mov bx,word ptr ARG1B ;get high word of operand
- test bx,bx
- jnz nsl3 ;greater than 2**16 - 1?
- mov ax,word ptr ARG1M ;no, get it into HL
- mov bx,di ;put PDL pointer in bx
- jmp ns1 ;and treat it as a 2 byte operand
-
- nsl3: mov dx,20H ;make it look like a floating point number
- call nsdnor ;normalize decimal
- mov al,byte ptr DCXPT ;get dec. exponent (=# of dec. digits)
- call mkstr ;go make the string
- mov bx,PY ;pointer to start of string
- add bx,word ptr BINXPT ;length of produced string
- mov PY,bx ;make address of next free PDL byte
- ret ;done
-
- ; Real number strings produced here
-
- nsflt: mov al,ARG1H ;examine sign of operand
- or al,al
- jns nsf1
- mov al,'-'
- stosb ;insert sign right away
- nsf1: mov PY,di ;save pointer to the string
- call unpak ;unpack the operand
- call nsdnor ;normalize decimal
- mov al,NSIZ ;compute how many digits to produce
- and al,0CH ;use 4 or 8 when using 8087
- sal al,1
- dec al
- call mkstr ;produce them
- mov ax,DCXPT ;the decimal exponent
- test ah,ah
- jnz insxp ;force exponent insertion if >255 or <0
- cmp al,7 ;and also
- jnc insxp ;if >6
- mov bx,py
- add bx,ax ;determine where to insert dec. point
- call shstr ;insert point, shift string, drop trailing 0s
- inc bx ;update pointer
- mov PY,bx
- cmp al,'.' ;see if the last character was the period
- jnz nsfdp ;if not, go insert D0 if DP number
- mov ax,bx ;else make sure we have at least one digit
- mov dx,PX
- sub ax,dx
- cmp al,3
- jnc nsfdp ;we do, insert DP expt if necessary
- mov bx,dx ;make bx point at start of string
- mov al,(byte ptr[bx]) ;we don't, fix it
- cmp al,'.' ;is the first character a period?
- jnz nsf4
- mov (byte ptr[bx]),'0' ;yes, insert 0 in its place
- inc bx ;and put the period after it
- mov (byte ptr[bx]),al
- dec bx
- nsf4: cmp al,'-' ;was it a -?
- jnz nsf5
- mov (byte ptr[bx]),'0' ;yes, but next is sure to be a period
- nsf5: inc bx
- inc bx ;keep PDL pointer updated
- mov PY,bx
-
- nsfdp: cmp byte ptr NSIZ,5 ;was this a DP operand?
- jnz nsf6
- ret ;no, we're done
- nsf6: mov (word ptr[bx]),'0D' ;yes, insert D0
- inc bx
- inc bx
- mov PY,bx ;update pointer
- ret ;and quit
-
- ; FP exponent insertion
-
- insxp: dec ax ;decrement dec. expt., we will insert
- mov DCXPT,ax ;dec. point after first digit
- mov bx,PY ;get start of string
- inc bx ;point it to start of move
- mov al,1 ;bytes NOT to move
- call shstr ;insert period, shift, drop trailing zeros
- inc bx ;advance pointer
- mov ch,'E' ;prepare to insert exponent
- cmp byte ptr NSIZ,5 ;but first ch kind to insert
- jz insx1
- mov ch,'D' ;DP exponent
- insx1: mov (byte ptr[bx]),ch ;insert the letter
- inc bx ;advance the pointer
- mov ax,DCXPT ;get the decimal exponent
- test ah,ah ;examine its sign
- js insx2
- jmp ns1 ;positive, insert it and quit
- insx2: mov (byte ptr[bx]),'-' ;insert sign
- inc bx ;keep pointer updated
- neg ax ;negate the exponent
- jmp ns1 ;insert it and quit
-
- ; Insert period, shift string, drop trailing zeros
-
- shstr: mov cx,word ptr BINXPT ;total length of digit string
- sub cl,al ;minus digits to be left in place
- mov al,'.' ;prepare period
- shst1: mov ah,(byte ptr[bx]) ;start moving
- mov (byte ptr[bx]),al
- mov al,ah
- inc bx ;next
- loop shst1
- mov (byte ptr[bx]),al ;last
- shst2: cmp al,'0' ;while last character is zero, drop it
- jz shst3
- ret
- shst3: dec bx ;back up
- mov al,(byte ptr[bx])
- jmp shst2
-
- ; Unpack floating point number
-
- unpak: mov bx,(offset ARG1H) ;get address of high byte
- unpk1: dec bx
- mov dx,[bx] ;check for zero
- mov DXSG,dh ;save sign-containing byte
- test dx,dx
- jnz up0
- ret
-
- up0: mov cl,NSIZ
- cmp cl,5
- jnz updp ;jump if DP
- dec cl ;set up count for shlby1
- sal dx,1 ;move LSbit of exponent to MSBit of AH
- stc ;set "implicit" bit
- rcr dl,1 ;got full mantissa byte and LSbit of
- mov (byte ptr[bx]),dl ; exponent in Carry
- inc bx ;point to MSbyte
- mov dl,dh ;exponent to LSbyte of AX
- mov dh,0 ;zero to high byte of AX
- mov (byte ptr[bx]),dh ;and to high byte of arg1
- mov ax,0FF82H ;bias to subtract (-07EH)
- jmp short up2
-
- updp: mov al,dl ;save lower byte in al
- and dl,0FH ;select mantissa nibble
- or dl,10H ;and set "implicit" bit
- mov (byte ptr[bx]),dl ;put it back
- inc bx
- mov (byte ptr[bx]),0 ;clear highest byte
- and dh,07FH ;clear high bit
- mov dl,al ;restore low byte
- mov cl,4 ;set shift count
- shr dx,cl ;and divide by 16
- mov cl,7 ;set up count for shlby1
- mov ax,0FC05H ;bias to subtract (-3FFH + 1/2 byte)
- up2: add dx,ax ;subtract bias
- mov di,bx
- mov ch,0 ;clear upper half of count reg.
- call shlby1 ;move mantissa up one byte
- stc ;set carry to indicate nonzero operand
- ret ;and quit
-
- ; Decimal normalization: reduce binary exponent to zero
- ; while computing decimal exponent and keeping mantissa
- ; between 0.1 and 1.
-
- nsdnor: mov word ptr BINXPT,dx ;save the unbiased binary exponent
- jmp short nsdn1a
- nsdn1: call div10a ;divide by 10 while BINXPT>0
- nsdn1a: call norg1 ;keep mantissa normalized
- add dx,word ptr BINXPT ;and binary expt correct
- mov word ptr BINXPT,dx ;but test it
- test dx,dx
- jnz nsdn1b
- ret ;return when bin. expt. is zero
- nsdn1b: jns nsdn1 ;divide by 10 while positive
- push dx
- add dx,3 ;else see if number between 0.1 and 1.
- jc nsdn3 ;if not less than -3, almost there
- call m58tha ;else multiply by 10/16 and
- jmp short nsdnor ;keep at it
-
- nsdn3: test dx,dx ;almost there
- pop dx
- jnz nsdn4 ;done if -3<BINXPT<0 (# between .125 and 1.)
- push dx ;save binexpt in stack for m58tha
- mov di,PY ;save mantissa in PDL, we may have to restore it
- mov si,(offset ARG1)
- mov cx,8
- call xf1
- call m58tha ;try product by 10/16 one last time
- mov ah,arg1h ;get highest mantissa byte
- test ah,ah ;see if we overflowed
- jns nsdnor ;if not, normalize again
- mov si,PY ;if it did, we must undo it and quit:
- mov di,(offset ARG1) ;retrieve mantissa from PDL
- mov cx,8
- call xf1
- inc DCXPT ;restore DCXPT to what it was
- mov dx,0FFFDH ;value of l when we came in at nsdn3 (-3)
- nsdn4: neg dx ;final value of -(BINXPT)
- mov di,(offset ARG1H) ; mantissa to the right
- call shr1
- ret
-
- ; Generate (A) decimal digits from mantissa at arg1
-
- mkstr: mov bx,PY
- mov (byte ptr[bx]),'0'
- mkstr2: inc al ;one extra digit to use for rounding
- mov cl,al
- mov ch,0
- mkstr3: inc bx ;point to next byte on PDL
- push cx ;save counter
- push bx ;and pointer
- push bx ;once more for the benefit of m58thc
- call m58thc
- pop bx ;retrieve pointer
- mov al,ARG1H ;high byte, whose high nibble
- mov cl,4
- shr al,cl ;contains the next decimal digit
- add al,'0' ;which we translate to ASCII
- mov (byte ptr[bx]),al ;save on the PDL
- mov bp,bx
- mov dl,4 ;and drop from the mantissa
- mk4: call twice
- dec dl
- jnz mk4
- mov bx,bp
- pop cx ;retrieve counter
- loop mkstr3 ;and keep at it till we're through
- mov word ptr BINXPT,bx ;use BINXPT to point at the last char
- mov ch,5
- mk5: mov al,(byte ptr[bx]) ;do a decimal round on the string
- add al,ch
- cmp al,'9'+1
- jc mk6
- sub al,10 ;decimal carry ocurred, propagate it
- mov (byte ptr[bx]),al
- mov ch,1
- dec bx
- jmp mk5
-
- mk6: mov [bx],al ;return the last decimal digit rounded
- mov bx,PY
- mov al,[bx]
- sub word ptr BINXPT,bx ;compute string length
- cmp al,'0'
- jz mk7 ;all the way
- inc word ptr DCXPT ;if it did, adjust the decimal exponent
- ret
-
- mk7: dec word ptr BINXPT ;no carry propagated, get rid of extra 0
- mov cx,word ptr BINXPT ;adjust length and use it to shift:
- mov si,PY ;prepare to shift string down one digit
- mov di,si ;get start of digit string
- inc si ;point source index to 1st nonzero digit
- ; ;run into xf1 to do the transfer
-
- ; --------------------------------------------------------------
- ; Service routines for the preceding conversion operators
- ; --------------------------------------------------------------
-
- ; transfer in increasing memory direction
-
- xf1: mov bp,ds
- xf2: mov es,bp
- cld
- repnz movsb
- ret
-
- ; transfer in decreasing memory direction
-
- mduc: mov bp,ds
- mov es,bp
- mduc1: dec di
- dec si
- std
- repnz movsb
- ret
-
- ; Clear number buffers
-
- dsinit: mov di,(offset ARG1) ;starting byte to clear
- mov cx,22 ;number of bytes to clear
- jmp short zar1
-
- ; Clear 8 bytes or (CX) bytes starting at (DI)
-
- zarg1: mov di,(offset ARG1)
- zarg: mov cx,8
- zar1: mov ax,ds
- mov es,ax
- mov ax,0000
- cld
- repnz stosb
- ret
-
- ; arg1 times 10
-
- txp: call cop ;copy to arg2
- call twice ;multiply by fos
- call twice
- call add8 ;add it to make 5 and run into twice
-
- ; arg1 times 2
-
- twice: mov cx,4
- twi0: mov bx,(offset ARG1)
- twi1: clc
- tw1: rcl word ptr [bx],1
- inc bx
- inc bx
- loop tw1
- ret
-
- ; copy arg1 to arg2
-
- cop: mov si,(offset ARG1)
- mov di,(offset ARG2)
- mov cx,8
- jmp xf1
-
- ; shift right one nibble argument pointed to by DE
-
- shrnib: mov dl,4
- shr1: mov bx,di
- call halv2
- dec dl
- jnz shr1
- ret
-
- ; halve arg1
-
- halve: mov bx,(offset ARG1H)
- halv2: clc
- halvc: mov cx,8 ;this entry to shift right with initial carry
- hal1: rcr byte ptr [bx],1
- dec bx
- loop hal1
- ret
-
- ; add arg2 to arg1
-
- add8: mov cx,4
- adda: mov bx,(offset ARG1)
- addb: mov bp,(offset ARG2)
- addc: clc
- ad1: mov ax,ds:[bp]
- adc [bx],ax
- inc bx
- inc bx
- inc bp
- inc bp
- loop ad1
- ret
-
- ; shift left arg1 a full byte
-
- shlby: mov di,(offset ARG1H)
- shlby0: mov cx,7
- shlby1: mov si,di
- dec si
- std
- mov bp,ds
- mov es,bp
- repnz movsb
- mov al,ch ;clear AL
- stosb ;clear LSbyte
- ret
-
- ; multiply arg1 by 10/16
-
- m58tha: mov bx,DCXPT
- m58thb: dec bx ;subtract one from dec. exponent
- mov DCXPT,bx
- m58thc: call halve
- call cop
- call halve
- call halve
- call add8
- pop bp
- pop dx
- add dx,4 ;add 4 to bin. exponent
- jmp bp
-
- ; divide arg1 by 10
-
- div10a: mov bx,DCXPT
- div10b: inc bx ;add 1 to decimal exponent
- mov DCXPT,bx
- call halve
- call cop
- call halve
- call add8 ;here we have 3/4 of original mantissa
- call cop ;which we copy into arg2
- mov cx,15 ;nibbles in 8 bytes, minus one
- dv1: push cx ;this loop multiplies arg1 by 16/15 (approx)
- mov di,(offset ARG2H)
- call shrnib
- call add8
- pop cx
- loop dv1 ;when done, we have 4/5 of original arg1
- call halve ;divide by 8 to make 1/10
- call halve
- call halve
- ret
-
- ; normalize arg1
-
- norg1: mov dx,0
- nr0: mov al,ARG1H
- test al,al
- jnz nr2 ;determine whether a byte shift is needed
- mov al,dl ;it is
- sub al,38H ;max number of shifts (7 bytes)
- jnz nr1
- mov dl,al ;arg1 was 0
- ret
- nr1: add al,40H ;restore the subtracted 38H, add 8 more
- mov dl,al ; and save in c
- call shlby ;shift left a full byte
- jmp nr0 ;start over
-
- nr2: js nr3 ;high bit on means we're done
- call twice ;otherwise shift left one bit
- inc dl ;record the fact
- jns nr0 ;and test again
-
- nr3: neg dx ;negate the shift count
- ret
-
- ; Return if not decimal. A unchanged if not decimal, else
- ; reduced to binary.
-
- RND: cmp al,':' ;colon follows 9 in ASCII alphabet
- jnb RTN
- cmp al,'0' ;ASCII zero is lower limit
- jb RTN
- sub al,'0' ;normalize to get binary values
- mov ah,00 ;zero for uncomplicated arithmetic
- ret
- RTN: inc sp
- inc sp
- ret
-
- ; Check if arg1=0
-
- zach: xor ax,ax
- mov bx,(offset ARG1)
- mov cx,4
- zch0: or ax,(word ptr[bx]) ;pile up mantissa bytes on A
- inc bx
- inc bx
- loop zch0
- test ax,ax
- ret
-
- ; end