; ============================================================== ; ; 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}[-|+]{d} | ; [-]d{d}[-|+]{d} : numeric constant ; O : decimal ascii string to number ; # : number to decimal ascii string ; ; arithmetic: ; ; ~ : complement or negative ; ; -------------------------------------------------------------- ; ; FLT - Copyright (c) 1984 ; Universidad Autonoma de Puebla ; All Rights Reserved ; ; [Gerardo Cisneros, 11 April 1984] ; ; ============================================================== ; 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 jmps 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 jmps 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 jmps 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 jmps 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 jmps dsg1 dsg2: cmp al,'E' ;check S.P. exponent jnz dsg3 mov ah,5 dsg2a: mov NSIZ,ah ;S.P. size jmps 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 jmps 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 ARG2,al call add8 ;add it to previous mantissa jmps 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,0FC3FH ;else compute biased binary exponent dnd3: push dx ;save binexpt jmps dnd3b dnd3a: call div10b ;mantissa will be divided by 10 if DCXPT<0 dnd3b: call norg1 ;normalize arg1 (shift until high bit = 1) pop bx add dx,bx ;reduce binexpt by amount shifted push dx 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 jmps ovf ; Pack up exponent and mantissa dspack: pop BINXPT ;retrieve binary exponent mov di,(offset ARG2) ;first do rounding of the mantissa call zarg mov bx,(offset ARG2B) cmp 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 jmps dsp0a dsp0: mov al,80H ;high bit inc bx ; of 5th mantissa byte for SP 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 NSIZ,5 ;which size jnz dsp2 ;skip if D.P. mov ax,047FH ;constant to adjust S.P. bias add ax,BINXPT jnc ufl test ah,ah ;(HL) must end up between 1 and 0FEH jnz ovf test ax,ax jz ufl ;0 means underflow 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 cx,5 jmp xf1 ;shift the upper 5 bytes ; Handle overflow in binary exponent ovf: call zarg1 ;set up infinite operand mov cx,7F80H ;first two bytes of SP infinite cmp 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 ARG1B,cx ;set next byte ret ; Handle underflow in binary exponent ufl: call zarg1 ;make it all zero mov FRST,al ;including the sign ret dsp2: mov dx,07FFH ;constant to adjust D.P. bias add dx,BINXPT jnc ufl ;bin. expt. must end up between 1 and 07FEH cmp dx,07FFH jnbe ovf ;07FFH or bigger is an overflow test dx,dx jz ufl ;0 means underflow 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 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 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,'-' stos byte[di] ;record the negative sign nsl2: mov al,'0' stos byte[di] ;long integers have a leading 0 mov PY,di ;save mov bx,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,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,'-' stos byte[di] ;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 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 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 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,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) jmps 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 BINXPT,dx ;save the unbiased binary exponent jmps nsdn1a nsdn1: call div10a ;divide by 10 while BINXPT>0 nsdn1a: call norg1 ;keep mantissa normalized add dx,BINXPT ;and binary expt correct mov 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 jmps nsdnor ;keep at it nsdn3: test dx,dx ;almost there pop dx jnz nsdn4 ;done if -3