|
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: 4992 (0x1380)
Types: TextFile
Names: »FPMAC.SRC«
└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
└─ ⟦this⟧ »FPMAC.SRC«
EXT ROTATLEFT,ROTATRIGHT,ROTLEFT,ROTRIGHT,FPERR,COMPOP,COMP1 EXT ZERCHK,ZERCK1,FXDCVT ; IF NOT $FNORM EXT FNORM ENDIF ; IF NOT $CVTFLT EXT CVTFLT ENDIF ; IF NOT $FOUT EXT FOUT ENDIF ; ; these macros use arg = 1 to refer to the first operand and... ; arg = 2 to refer to the second operand ; arg = y to refer to the present operand ; rotate: macro arg,direction ;;rotate operand one bit if 'arg'-'y' ;;standard arg lxi h,op!arg+msb ;;offset of the argument call rotat!direction ;;call rotate routine else ;;use present operand push y ;;move y to hl pop h dcx h ;;point to msb ora a ;;clear carry call rot!direction ;;enter rotate after addr calcs endif endmac ;;done shift: macro arg,direction ;;shift right if 'arg'-'l' ;;do right shift if 'arg'-'y' ;;standard argument lxi h,op!arg+exp ;;offset of the argument dad d ;;hl <- addr of " else ;;use current operand push y pop h ;;get addr of msb hl endif inr m ;;bump exponent jv fperr ;floating point error dcx h mov a,m ;;get msbyte ral ;;shift sign bit into carry call rotright ;;rotate w/o clearing carry else ;;shift left call rotatl ;;do a rotate left mvi a,0 ;;clear w/o disturbing carry rar ;;move carry to msbit xra m ;;xor with msb of fp number mov m,a ;;save result endif endmac cmplmt: macro arg ;;2's complement operand if 'arg'-'y' ;;standard arg lxi h,op!arg+lsb ;;get offset of lsb of operand call compop ;;complement operand else ;;use present operand push y ;;move y to hl pop h lxi b,lsb ;;point to lsb dad b call comp1 ;;enter compop after addr calcs endif endmac zchk: macro arg ;;check for operand = 0 if 'arg'-'y' ;;if standard argument lxi h,op!arg+msb ;;get offset call zerchk ;;and check for a zero else ;;use current operand push y pop h ;;hl <- y dcx h ;;make (hl) = msb call zerck1 ;;and check for zero endif endmac normfp: macro arg ;;normalizing routine if 'arg'-'y' ;;use indicated argument lxi b,op!arg ;;get offset of operand push x ;;get base into y xtiy dady b ;;get addr of operand into y call fnorm ;;normalize pop y ;;and restore y else ;;current operand call fnorm ;;just normalize endmac setupf: macro ;;macro used to set up stack for fp ; ;;processing pop b ;;get return address pop d ;;get first half of op2 pop h ;;get second half of op2 push psw ;;add two bytes to op1 push h ;;restore op2 push d push psw ;;add two bytes to op2 push x ;;save ix... push y ;;...and iy push b ;;restore 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 mov intflg(x),a ;;clear internal op flag endmac ; ; xcfp: macro ;;exchange top two floating point numbers pop d ;;get op2 in de, hl pop h pop b ;;get low 16 bits of op1 xthl ;;exchange high 16 bits of op1 & op2 push d ;;save low 16 bits of op2 push h ;;save high 16 bits of op1 push b ;;save low 16 bits of op1 endmac ; ; convert an integer to floating point, or fp to ASCII ; cvtf: macro where,value ;;where is the argument and what is it? ;; ;; A -> process immediate argument and push ;; ;; B -> process top of stack ;; ;; C -> process 2nd on stack ;; ;; D -> process # in de ;; ;; H -> process # in hl ;; ;; S -> convert top of stack to a string if 'A'-'where' ;;check for NOT A if 'B'-'where' ;;check for NOT B if 'C'-'where' ;;check for not C if 'D'-'where' ;;check for not D if 'H'-'where' ;;check for not H ;; ;;process option S if value-4 ;;should we attempt to convert to fixed pt mov a,l ;;yes, first save fraction length pop b pop d ;;get fp number pop h ;;get field info mov h,a ;;save fraction length push h ;;restore stack push d push b xra a ;;clear acc call fout ;;convert to form ' sx.xxxxxxesxx' lxi h,13 ;;point to top of string dad s push h ;;save the parameter call fxdcvt ;;try to convert to fixed point else ;;otherwise simply print the string call fout ;;process fp -> ascii string endif else ;;process option H call cvtflt ;;process # in hl endif else ;;process option D xchg ;;put # in hl call cvtflt ;;process # in hl endif else ;;process option C pop b ;;get top of stack in bc, de pop d pop h ;;get integer in hl push d ;;save float # on stack push b call cvtflt ;;convert hl -> float xcfp ;;...and exchange op1 & op2 endif else ;;process option B pop h ;;get 2's complement value call cvtflt ;;call routine to convert # in hl endif else ;;process option A lxi h,value ;;get 16 bit value call cvtflt ;;convert to float, and done!! endif endmac ; dsb1 macro reg xra a dsbc reg d endmac cmpi macro q,value cpi value endmac «eof»