DataMuseum.dk

top - metrics - download

    Length: 8704 (0x2200)
    Types: TextFile
    Names: »FXDCVT.SRC«

└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
    └─⟦this⟧ »FXDCVT.SRC« 

TextFile

;ROUTINE TO CONVERT A FLOATING POINT NUMBER TO FIXED POINT FORMAT
;
	NAME FXDCVT
	ENTRY FXDCVT
	EXT ABS
	INCLUDE DEFLT.SRC
;
; THIS IS MOD FXDCVT, SO....
$FXDCVT	SET	0FFFFH
	INCLUDE FCTMAC.SRC
FXDCVT:
; 	const exp = 13;
; 	      maxlen = 12;
; 	type sstring = arrayÆ1..14Å of char;
; procedure format( var x: sstring );
; 	var tpowr: integer; (* power of ten *)
; 	    fracln : 0..255;   (* fraction length specified *)
; 	    i, j: 0..255;
; 	    y: arrayÆ1..22Å of char;
; 	    sign: char;
; 	    fixed: boolean;
; 	begin
L162
	ENTR	D,2,29
; 	    fixed := false; (* assume no success *)
	MOV	-6(IX),A
; 	    sign := xÆ2Å;
	LXI	H,9
	ILOD	H,1,-1
	MOV	-5(IX),L
; 	    tpowr := -1;
	MVI	0(IX),255
	MVI	-1(IX),255
;  	    (*$R- *) fracln := ord( xÆ tpowr Å ); (*$R+ *)
R	SET	         0
	MOV	L,-1(IX)
	MOV	H,0(IX)
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MOV	D,A
	MOV	E,M
	MOV	-2(IX),E
R	SET	         1
; 	    tpowr := ord(xÆexpÅ) * 10 + ord(xÆexp+1Å) -11*ord('0');
	LXI	H,9
	ILOD	H,1,-12
	LXI	D,10
	MULT	D,0
	PUSH	H
	LXI	H,9
	ILOD	H,1,-13
	POP	D
	DADD	D,0
	PUSH	H
	LXI	H,48
	LXI	D,11
	MULT	D,0
	POP	D
	XCHG
	DSUB	D,0
	MOV	0(IX),H
	MOV	-1(IX),L
; 	    if xÆ exp-1 Å = '-' then tpowr := -tpowr;
	LXI	H,9
	ILOD	H,1,-11
	MOV	A,L
	CMPI	D,45
	MOV	A,H
	JNZ	L281
	MOV	L,-1(IX)
	MOV	H,0(IX)
	NEGT	H
	MOV	0(IX),H
	MOV	-1(IX),L
L281
; 	    for i := 1 to 22 do yÆ i Å := '0';
	MVI	-3(IX),1
	PUSH	IX
	POP	H
	DCX	H
	DCX	H
	DCX	H
	PUSH	H
	LXI	H,22
	XTHL
L309
	MOV	D,A
	MOV	E,M
	XTHL
	PUSH	H
	GE	D,0
	JNC	L310
	MOV	H,A
	MOV	L,-3(IX)
	XCHG
	LXI	H,-6
	ADDR	IX
	MVI	M,48
	POP	H
	XTHL
	INR	M
	JNZ	L309
L310
	POP	D
L329
	POP	D
;    	    if (tpowr >= 0) and (tpowr+2+fracln <=maxlen) then begin
	MOV	L,-1(IX)
	MOV	H,0(IX)
	MOV	D,A
	MOV	E,A
	GE	D,0
	JNC	L334
	MOV	L,-1(IX)
	MOV	H,0(IX)
	INX	H
	INX	H
	MOV	D,A
	MOV	E,-2(IX)
	DADD	D,0
	LXI	D,12
	LE	D,0
	JNC	L331
; 		fixed := true;
	MVI	-6(IX),1
; 		yÆ 1 Å := xÆ 3 Å;
	LXI	H,9
	ILOD	H,1,-2
	MOV	-7(IX),L
; 		if tpowr > 6 then begin
	MOV	L,-1(IX)
	MOV	H,0(IX)
	LXI	D,6
	GRET	D,0
	JNC	L377
; 			for i := 5 to 10 do yÆ i-3 Å := xÆ i Å;
	MVI	-3(IX),5
	PUSH	IX
	POP	H
	DCX	H
	DCX	H
	DCX	H
	PUSH	H
	LXI	H,10
	XTHL
L394
	MOV	D,A
	MOV	E,M
	XTHL
	PUSH	H
	GE	D,0
	JNC	L395
	MOV	H,A
	MOV	L,-3(IX)
	DCX	H
	DCX	H
	DCX	H
	XCHG
	LXI	H,-6
	ADDR	IX
	MOV	D,A
	MOV	E,-3(IX)
	PUSH	H
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MOV	D,A
	MOV	E,M
	POP	H
	MOV	M,E
	POP	H
	XTHL
	INR	M
	JNZ	L394
L395
	POP	D
L421
	POP	D
; 			for i := 7 to tpowr do yÆi+1Å := '0';
	MVI	-3(IX),7
	PUSH	IX
	POP	H
	DCX	H
	DCX	H
	DCX	H
	PUSH	H
	MOV	L,-1(IX)
	MOV	H,0(IX)
	XTHL
L430
	MOV	D,A
	MOV	E,M
	XTHL
	PUSH	H
	GE	D,0
	JNC	L431
	MOV	H,A
	MOV	L,-3(IX)
	INX	H
	XCHG
	LXI	H,-6
	ADDR	IX
	MVI	M,48
	POP	H
	XTHL
	INR	M
	JNZ	L430
L431
	POP	D
L451
	POP	D
; 			end
; 		else begin
	JMP	L454
L377
; 			for i := 2 to tpowr + 1 do yÆ i Å := xÆ i+3Å;
	MVI	-3(IX),2
	PUSH	IX
	POP	H
	DCX	H
	DCX	H
	DCX	H
	PUSH	H
	MOV	L,-1(IX)
	MOV	H,0(IX)
	INX	H
	XTHL
L465
	MOV	D,A
	MOV	E,M
	XTHL
	PUSH	H
	GE	D,0
	JNC	L466
	MOV	H,A
	MOV	L,-3(IX)
	XCHG
	LXI	H,-6
	ADDR	IX
	MOV	D,A
	MOV	E,-3(IX)
	INX	D
	INX	D
	INX	D
	PUSH	H
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MOV	D,A
	MOV	E,M
	POP	H
	MOV	M,E
	POP	H
	XTHL
	INR	M
	JNZ	L465
L466
	POP	D
L493
	POP	D
; 			for i := 3+tpowr to 8 do yÆ i Å := xÆ i+2Å;
	MOV	L,-1(IX)
	MOV	H,0(IX)
	INX	H
	INX	H
	INX	H
	MOV	-3(IX),L
	XCHG
	PUSH	IX
	POP	H
	DCX	H
	DCX	H
	DCX	H
	PUSH	H
	LXI	H,8
	XTHL
L503
	MOV	D,A
	MOV	E,M
	XTHL
	PUSH	H
	GE	D,0
	JNC	L504
	MOV	H,A
	MOV	L,-3(IX)
	XCHG
	LXI	H,-6
	ADDR	IX
	MOV	D,A
	MOV	E,-3(IX)
	INX	D
	INX	D
	PUSH	H
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MOV	D,A
	MOV	E,M
	POP	H
	MOV	M,E
	POP	H
	XTHL
	INR	M
	JNZ	L503
L504
	POP	D
L530
	POP	D
; 			end;
L454
; 		end;
L331
L333	EQU	L331
L334	EQU	L333
; 	    if (tpowr < 0) and (fracln+2+tpowr <= maxlen) then begin
	MOV	L,-1(IX)
	MOV	H,0(IX)
	MOV	D,A
	MOV	E,A
	LESS	D,0
	JNC	L539
	MOV	H,A
	MOV	L,-2(IX)
	INX	H
	INX	H
	MOV	E,-1(IX)
	MOV	D,0(IX)
	DADD	D,0
	MOV	A,L
	CMPI	D,13
	MOV	A,H
	JNC	L536
; 		fixed := true;
	MVI	-6(IX),1
; 		yÆ 2+abs( tpowr ) Å := xÆ 3 Å;
	MOV	L,-1(IX)
	MOV	H,0(IX)
	CALL	ABS
	INX	H
	INX	H
	XCHG
	LXI	H,-6
	ADDR	IX
	XCHG
	LXI	H,9
	ILOD	H,1,-2
	XCHG
	MOV	M,E
; 		for i := 3 to 8 do yÆ i+abs( tpowr ) Å := xÆ i+2 Å;
	MVI	-3(IX),3
	PUSH	IX
	POP	H
	DCX	H
	DCX	H
	DCX	H
	PUSH	H
	LXI	H,8
	XTHL
L596
	MOV	D,A
	MOV	E,M
	XTHL
	PUSH	H
	GE	D,0
	JNC	L597
	MOV	H,A
	MOV	L,-3(IX)
	PUSH	H
	MOV	L,-1(IX)
	MOV	H,0(IX)
	CALL	ABS
	POP	D
	DADD	D,0
	XCHG
	LXI	H,-6
	ADDR	IX
	MOV	D,A
	MOV	E,-3(IX)
	INX	D
	INX	D
	PUSH	H
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MOV	D,A
	MOV	E,M
	POP	H
	MOV	M,E
	POP	H
	XTHL
	INR	M
	JNZ	L596
L597
	POP	D
L630
	POP	D
; 		tpowr := 0; (* fudge to allow mutual code later on *)
	MOV	0(IX),A
	MOV	-1(IX),A
; 		end;
L536
L538	EQU	L536
L539	EQU	L538
; 	    if fixed then begin
	CMP	-6(IX)
	JNC	L640
; 		yÆ tpowr+2 Å := '.';
	MOV	L,-1(IX)
	MOV	H,0(IX)
	INX	H
	INX	H
	XCHG
	LXI	H,-6
	ADDR	IX
	MVI	M,46
; 		for i := 1 to 14 do xÆ i Å := ' ';
	MVI	-3(IX),1
	PUSH	IX
	POP	H
	DCX	H
	DCX	H
	DCX	H
	PUSH	H
	LXI	H,14
	XTHL
L668
	MOV	D,A
	MOV	E,M
	XTHL
	PUSH	H
	GE	D,0
	JNC	L669
	MOV	H,A
	MOV	L,-3(IX)
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MVI	M,32
	POP	H
	XTHL
	INR	M
	JNZ	L668
L669
	POP	D
L688
	POP	D
; 		j := tpowr+2+fracln;
	MOV	L,-1(IX)
	MOV	H,0(IX)
	INX	H
	INX	H
	MOV	D,A
	MOV	E,-2(IX)
	DADD	D,0
	MOV	-4(IX),L
; 		for i := 1 to j do xÆ i+(maxlen-j+2) Å := yÆ i Å;
	MVI	-3(IX),1
	PUSH	IX
	POP	H
	DCX	H
	DCX	H
	DCX	H
	PUSH	H
	MOV	H,A
	MOV	L,-4(IX)
	XTHL
L705
	MOV	D,A
	MOV	E,M
	XTHL
	PUSH	H
	GE	D,0
	JNC	L706
	MOV	H,A
	MOV	L,-3(IX)
	MOV	D,A
	MOV	E,-4(IX)
	PUSH	H
	LXI	H,12
	DSUB	D,0
	INX	H
	INX	H
	POP	D
	DADD	D,0
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MOV	D,A
	MOV	E,-3(IX)
	PUSH	H
	LXI	H,-6
	ADDR	IX
	MOV	D,A
	MOV	E,M
	POP	H
	MOV	M,E
	POP	H
	XTHL
	INR	M
	JNZ	L705
L706
	POP	D
L738
	POP	D
; 		(* round if necessary *)
; 		if (tpowr <= 6) and ( yÆ j+1 Å >= '5' ) then begin
	MOV	L,-1(IX)
	MOV	H,0(IX)
	LXI	D,6
	LE	D,0
	JNC	L743
	MOV	H,A
	MOV	L,-4(IX)
	INX	H
	XCHG
	LXI	H,-6
	ADDR	IX
	MOV	D,A
	MOV	E,M
	MVI	A,52
	CMP	E
	MOV	A,D
	JNC	L740
; 			xÆ maxlen+2 Å := succ(xÆ maxlen+2 Å );
	LXI	H,9
	ILOD	H,1,-13
	INX	H
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	LXI	B,-13
	DADD	B
	MOV	M,E
; 			i := 0;
	MOV	-3(IX),A
; 			while xÆ maxlen+2-i Å = succ( '9' ) do begin
L800
	MOV	H,A
	MOV	L,-3(IX)
	LXI	D,14
	XCHG
	DSUB	D,0
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MOV	D,A
	MOV	E,M
	PUSH	D
	LXI	H,57
	INX	H
	POP	D
	DSB1	D,0
	JNZ	L799
; 			  xÆ maxlen+2-i Å := '0';
	MOV	H,A
	MOV	L,-3(IX)
	LXI	D,14
	XCHG
	DSUB	D,0
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MVI	M,48
; 			  i :=i+1;
	MOV	H,A
	MOV	L,-3(IX)
	INX	H
	MOV	-3(IX),L
; 
; 			  if xÆmaxlen+2-i Å = '.' then i := i+1;
	MOV	H,A
	MOV	L,-3(IX)
	LXI	D,14
	XCHG
	DSUB	D,0
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MOV	D,A
	MOV	E,M
	MOV	A,E
	CMPI	D,46
	MOV	A,D
	JNZ	L845
	MOV	H,A
	MOV	L,-3(IX)
	INX	H
	MOV	-3(IX),L
L845
; 			  if xÆmaxlen+2-iÅ = ' ' then xÆmaxlen+2-iÅ:='1'
	MOV	H,A
	MOV	L,-3(IX)
	LXI	D,14
	XCHG
	DSUB	D,0
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MOV	D,A
	MOV	E,M
	MOV	A,E
	CMPI	D,32
	MOV	A,D
	JNZ	L868
	MOV	H,A
	MOV	L,-3(IX)
	LXI	D,14
	XCHG
	DSUB	D,0
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
; 			  else xÆmaxlen+2-iÅ:=succ(xÆmaxlen+2-iÅ);
	MVI	M,49
	JMP	L897
L868
	MOV	H,A
	MOV	L,-3(IX)
	LXI	D,14
	XCHG
	DSUB	D,0
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	PUSH	H
	MOV	H,A
	MOV	L,-3(IX)
	LXI	D,14
	XCHG
	DSUB	D,0
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MOV	D,A
	MOV	E,M
	INX	D
	POP	H
	MOV	M,E
L897
; 			  end;
	JMP	L800
L799
; 			if i = j then j := j+1
	MOV	H,A
	MOV	L,-3(IX)
	MOV	D,A
	MOV	E,-4(IX)
	DSB1	D,0
	JNZ	L929
	MOV	H,A
	MOV	L,-4(IX)
; 			end;
	INX	H
	MOV	-4(IX),L
L929
L740
L742	EQU	L740
L743	EQU	L742
; 		xÆ maxlen-j+2 Å := sign;
	MOV	H,A
	MOV	L,-4(IX)
	LXI	D,12
	XCHG
	DSUB	D,0
	INX	H
	INX	H
	XCHG
	MOV	H,9(IX)
	MOV	L,8(IX)
	DSUB
	INX	H
	MOV	D,A
	MOV	E,-5(IX)
	MOV	M,E
; 		end;
L640
; 	    end;
	EXIT	D,2
«eof»