// PrintFloat(str,lvnum) Prints floating point number. // Copyright Xerox Corporation 1979 //outgoing routines external PrintFloat external [ //OS Puts Wns //FLOAT FLD;FST;FTR;FLDI;FNEG;FAD;FSB;FML;FDV;FCM;FSN FLDV;FSTV;FLDDP;FSTDP;DPAD;DPSB ] // incoming statics external [ keys dsp ] // internal statics static [ coms sc ] // File-wide structure and manifest declarations. structure STR: [ length byte char↑1,255 byte ] manifest strlen=10 //number of words // Procedures let PrintFloat(s,lvnum) be [ let v=vec 4*5 for i=1 to 4 do FSTV(i,v+4*i) FLD(1,lvnum) let p=FSN(1) test p eq 0 then Puts(s,$0) or [ //Really work if p eq -1 then [ FNEG(1); Puts(s,$-) ] FLDV(2,table [ 0; 1; #100000; 4 ]); //Fuzz1= 1+2E-9 FML(1,2) //n←fuzz1*number FLDI(3,1);FLDI(2,10) FLD(4,1) //number p=0 while FCM(4,2) eq 1 do [ FDV(4,2); p=p+1 ] while FCM(4,3) eq -1 do [ FML(4,2); p=p-1 ] // 4 has number between 1 and 10, and p has power FLD(3,table [ #031325; #163073 ]) //Fuzz2 = 5E-9 FML(3,1) //s←fuzz2 * n let q=p test p gr 7 % p ls -3 then p=0 or q=0 test p ls 0 then [ Puts(s,$0); Puts(s,$.) for i=p to -2 do Puts(s,$0) for i=1 to -p do FDV(3,2) //s=s E P ] or [ for i=1 to p do FML(3,2) ] //now print (s suppresses trailing zeroes) for i=1 to 9 do [ let ipart=FTR(4) Puts(s,$0+ipart) p=p-1 FLDI(1,ipart); FSB(4,1); FML(4,2) if p ls 0 then [ if p eq -1 then Puts(s,$.) FML(3,2) if FCM(4,3) eq -1 then break //fuzz ] ] if q ne 0 then [ Puts(s,$E); Wns(s,q) ] ] //Really work for i=1 to 4 do FLDV(i,v+4*i) ]