<<<--- % Author M.Ruckert LOC #100 w IS $0 return value u IS$0 1. parameter s IS $1$u$unpacked e IS$2 f IS $3 f0 IS$4 carry IS $5 for rounding tmp IS$6 --->>> Fmod ZSN s,u,1 %\ul{\sl 1.~Unpack.} Set sign. SETH tmp,#FFF0; ANDN f,u,tmp Remove sign and exponent from $f$. INCH f,#0010 Add hidden bit. SLU e,u,1; SRU e,e,53 Get exponent. SET f0,0 $u=\pm (f,f_0)2^{e-q}/2^{52}$. SET tmp,1023; SUB e,e,tmp %\ul{\sl 2.~Subtract $q$.} BNP e,0F Branch if $u$ has no integer part. ADD tmp,e,12; SLU f,f,tmp %\ul{\sl 3.~Remove integer part.} SRU f,f,12 SET e,0 0H BZ s,0F ADD tmp,e,64; SLU f0,f,tmp %\ul{\sl 4.~Complement fraction part.} NEG tmp,e; SRU f,f,tmp $(f,f_0)\is (f,0)/2^e$ SET e,0 $e \is 0$ NEGU f0,f0 ZSNZ carry,f0,1; ADDU f,f,carry SETH tmp,#0010; SUBU f,tmp,f $(f,f_0)\is 1 - (f,f_0)$ SET s,0 $(f,f_0)>0$ 0H INCL e,1023 %\ul{\sl 5.~Add $q$.} OR tmp,f,f0; BNZ tmp,Normalize %\ul{\sl 6.~Normalize}, if not zero SET w,0 else $w\is 0$ <<<--- POP 1,0 Normalize SRU tmp,f,53; BP tmp,4F \ul{\sl N1.~Test $f$.} If $f\ge 2$, scale right. OR tmp,f,f0; BZ tmp,Error underflow 2H SRU tmp,f,52; BP tmp,5F \ul{\sl N2.~Is $f$ normalized?} ZSN carry,f0,1; SLU f0,f0,1 \ul{\sl N3.~Scale left.} SLU f,f,1; ADDU f,f,carry SUB e,e,1 JMP 2B 4H AND carry,f,1 \ul{\sl N4.~Scale right.} SLU carry,carry,63 SRU f0,f0,1; ADDU f0,f0,carry SRU f,f,1 ADD e,e,1 5H SETH tmp,#8000 \ul{\sl N5.~Round.} CMPU tmp,f0,tmp Compare $f_0$ to ${1\over 2}$ CSOD carry,f,1 $f$ is odd. Round up if $f_0 \ge {1\over 2}$ CSEV carry,f,tmp $f$ is even. Round up if $f_0 > {1\over 2}$ ZSNN carry,tmp,carry Round down if $f_0 < {1\over 2}$ ADDU f,f,carry SET f0,0 SRU tmp,f,53; BP tmp,4B Rounding overflow SET tmp,#7FE; CMP tmp,e,tmp \ul{\sl N6.~Check $e$.} BP tmp,Error Overflow BNP e,Error Underflow SLU w,s,63 \ul{\sl N5.~Pack.} SLU tmp,e,52; OR u,u,tmp ANDNH f,#FFF0 remove hidden bit OR w,w,f SET $0,u POP 1,0 Error SET$255,1 TRAP 0,:Halt,0 PREFIX : Main FLOT $255,10 FLOT$1,77 FDIV $1,$1,$255 PUSHJ$0,Fmod NEG $1,33 FLOT$1,$1 FDIV$1,$1,$255 PUSHJ $0,Fmod NEG$1,33 FLOT $1,$1 FLOT $255,100 FDIV$1,$1,$255 FDIV $1,$1,$255 PUSHJ$0,Fmod FMUL $255,$255,$255; FMUL$255,$255,$255; FMUL $255,$255,$255 SET$1,$255 PUSHJ$0,Fmod FLOT $1,1 FDIV$1,$1,$255 PUSHJ $0,Fmod NEG$1,1 FLOT $1,$1 FDIV $1,$1,$255 PUSHJ$0,Fmod NEG $1,2 FLOT$1,$1 FDIV$1,$1,$255 PUSHJ $0,Fmod SETH$1,#0010 very small positiv PUSHJ $0,Fmod SETH$1,#8010 very small negativ PUSHJ $0,Fmod SET$255,0 TRAP 0,Halt,0 --->>>