|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 6400 (0x1900)
Types: TextFile
Names: »FOUT.SRC«
└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
└─ ⟦this⟧ »FOUT.SRC«
; floating point output routine ; NAME FOUT ENTRY FOUT EXT FPTTEN,FPDTEN,MPADD,MPSUB INCLUDE FPINIT.SRC ; ;THIS IS MOD FPOUT,SO.. $FOUT SET 0FFFFH ; INCLUDE FPMAC.SRC ; fout: pop b ;get return address pop d ;move floating point number down 2 bytes pop h push psw ;add two bytes above op1 push h ;restore op1 push d push psw ;add two bytes after op1 push h push d ;create op1 push psw ;add two bytes push x push y push b ;save ix, iy, and return address lxi h,0 ;make ix point to end of dad s ;the stack push h pop ix xchg ;make de point to stack xra a ;clear carry mvi c,' ' ;output space unless negative bit sign,op1+msb(x) ;check sign jrz notneg mvi c,'-' ;output a '-' res sign,op1+msb(x) ;clear sign bit notneg: mov intflg(x),c ;set internal op flag lxi h,-5 ;add extra workspace to stack dad s ;for use in ascii string sphl ;construction xra a ;zero temporary variable mvi b,4 ;zero correct number of bytes zerstr: mov m,a ;zero this byte inx h ;bump pointer djnz zerstr ;and continue mov m,a ;zero exponent in case # is zero push h ;save bcd pointer zchk 1 ;check for fp number = 0 pop h ;restore bcd pointer jz bcdout ;yes, output it mvi m,6 ;initialize decimal exponent declop: push h ;save pointer on stack bit sign,op1(x) ;first check sign of exponent jrnz less1 ;negative, keep multiplying mvi a,23 ;process until 24 > exp > 20 cmp op1(x) ;now check size of exponent jrc gret1 ;if exp > 23 divide frac by 10 less1: call fptten ;op1 := op1 * 10 pop h ;decrement decimal exponent dcr m ;and save the pointer jr declop ;try again gret1: call fpdten ;op1 := op1 / 10 pop h ;get addr of decimal exponent inr m ;increment decimal exponent push h ;save bcd pointer mov a,op1(x) ;until exponent <= 23 cpi 24 jrnc gret1 ;try again frcout: mov c,a ;save value of exponent frc1: mov a,c ;get exponent cpi 23 ;make sure exponent = 23 jrz frc2 ;yes it is rotate 1,right ;no, shift it inr c jr frc1 ;...and try again frc2: lxi h,op1+msb ;get addr of op1 dad d push d ;save base register lxi d,ftable+3 ;point to 1,000,000 mvi b,nbytes-1 ;check all bytes after the exponent frc2a: ldax d ;get byte from constant cmp m ;is byte from number bigger jrc frc2c ;yes, done jrnz frc2b ;multiply by ten dcx h dcx d djnz frc2a jr frc2c ;done frc2b: pop d ;restore base reg call fptten ;op1 := op1 * 10 rotate 1,left ;and compensate for exp = 24 pop h ;get bcd pointer dcr m ;indicate multiplication jr frc3a frc2c: pop d ;restore base register frc3: pop h ;get bcd pointer frc3a: lxi b,-4 ;addr of lsb of bcd mantissa dad b ;in hl push d ;save base register lxi b,bcd ;save addr of first bcd value push b push h ;save bcd pointer lxi h,op1+lsb ;get addr of op1 dad d xchg ;de <- addr of op1 lxi h,ftable ;addr of floating point values mvi b,7 ;7 bcd digits conlop: mvi c,0 ;count number of subtractions conv1: push d ;save addr of both operands push h inr c ;count iterations call mpsub ;subtract until result is -ive pop h ;get addrs of both operands pop d jrnc conv1 ;result is still positive push d ;save addr of op1 call mpadd ;make result positive pop y ;save addr of op1 in y pop d ;bcd pointer xthl ;get addr of bcd constant ; ;and save addr of new ; ;floating point constant push b ;save b conv2: dcr c ;see if we're done subtracting jrz conv4 ;yes.. ora a ;clear carry mvi b,4 ;four byte bcd number push d ;save operands push h conv3: ldax d ;get present bcd value adc m ;add in value from constant daa ;decimal adjust stax d ;and save inx h ;bump pointers inx d djnz conv3 ;check counter pop h ;get original pointers pop d jr conv2 ;and try again conv4: lxi b,4 ;point to next bcd constant dad b pop b ;restore b xthl ;get addr of fp constant ; ;and save addr of bcd constant push d ;save addr of bcd number push y ;get addr of op1 pop d djnz conlop ;and continue pop d ;addr of bcd number lxi h,4 dad d ;get addr of exponent pop b ;throw away pointer to ftable pop b ;get stack pointer bcdout: push x ;get addr of op1 in y pop y lxi b,op1-2 ;interested in bytes after decimal point xra a ;clear carry... dady b ;...and add mov e,intflg(x) ;get leading space or - mvi 4(y),' ' ;leading space mov 3(y),e ;save in string space mov e,m ;save exponent in e dcx h ;point to msb of fraction mvi a,30h ;ascii '0' add m ;form ascii of high digit mov 2(y),a ;save in output string mvi 1(y),'.' ;now the decimal point mvi b,6 ;process 6 digits outlp: bit 0,b ;decrement hl on even counter jrnz outlp1 dcx h ;bump pointer outlp1: rld ;get next digit mov 0(y),a ;save byte in string dcx y ;bump pointer djnz outlp ;for 3 bytes mov b,e ;get exponent in b mvi 0(y),'E' ;for exponent mvi c,'+' ;assume exponent is +ve bit 7,b jrz posexp ;yes, exp is positive mvi c,'-' mov a,b neg ;otherwise make it positive mov b,a posexp: mov -1(y),c ;save sign of exponent xra a ;convert to bcd cmp b ;check for zero exponent jrz conxp1 xra a ;clear carry conexp: inr a daa djnz conexp conxp1: mov m,a ;save so rld will work mvi a,30h ;put 3 in high nybble rld ;get 1st digit mov -2(y),a ;tens digit of exponent ; mvi a,30h ;put 3 in high nybble rld ;get 2nd digit mov -3(y),a ;one digit of exponent lxi h,5 ;throw away bcd number dad s sphl pop h pop y pop x ;restore all regs xra a ;clear accumulator pchl ;done!! ; ; ftable: ; db 0,80h,96h,98h ; 10,000,000 db 0,40h,42h,0fh ; 1,000,000 db 0,0a0h,86h,1h ; 100,000 db 0,10h,27h,0 ; 10,000 db 0,0e8h,03,0 ; 1,000 db 0,64h,0,0 ; 100 db 0,0ah,0,0 ; 10 db 0,01,0,0 ; 1 bcd: ; db 00,00,00,10h ; ten million db 00,00,00,01h ; one million db 00,00,10h,00 ; hundred thousand db 00,00,01h,00 ; ten thousand db 00,10h,00,00 ; one thousand db 00,01h,00,00 ; one hundred db 10h,00,00,00 ; ten db 01h,00,00,00 ; one ; ; the floating point constant 10, in the five byte internal ; form ; db 0,0,0,50h ; 5/8 tentop: db 4 ; * 16 = 10 «eof»