* Maxon C++ Library:
* Modul "fout" (Unterroutine für "printf" etc.) 
* Jens Gelhar 26.05.92, 08.04.94

	xdef	form__out

	xref	_vlongtostr,_uvlongtostr
	xref	DoubleToFixed,DoubleToExpo,Expo10

form__out:
	; String a0, Parameter ab a1, Buffer [mind. 80 Z.] ab a2:
	; nächste Ausgabedaten nach d2/d3, führende Spaces nach d0
	; (Bit 31: mit Nullen auffüllen, 30: rechtsbündig, Bit 29: Anzahl nach (a2))
	; a0 und a1 entspr. weitersetzen
	move.b	(a0),d0
	beq	EoS
	cmp.b	#'%',d0
	beq.b	Param
	move.l	a0,d2
.1	; normale Zeichen scannen:
	move.b	(a0)+,d0
	beq.b	.2
	cmp.b	#'%',d0
	bne.b	.1
.2	subq.l	#1,a0
	move.l	a0,d3
	sub.l	d2,d3
	moveq	#0,d0
	rts
Param:	; "%"
	move.l	a0,d2
	addq.l	#1,a0
	moveq	#0,d7		; d7 = Flagbits
	moveq	#0,d6		; d6 = min. Feldbreite
	moveq	#-1,d5		; d5 = Genauigkeit
Flags:	move.b	(a0)+,d0
	cmp.b	#'-',d0
	bne.b	fo3
	bset	#0,d7		; d7.0: linksbündig
	bra.b	Flags
fo3:	cmp.b	#'+',d0
	bne.b	fo4
	bset	#1,d7		; d7.1: mit Vorzeichen
	bra.b	Flags
fo4:	cmp.b	#' ',d0
	bne.b	fo5
	bset	#2,d7		; d7.2: Space statt "+"
	bra.b	Flags
fo5:	cmp.b	#'0',d0
	bne.b	fo6
	bset	#3,d7		; d7.3: mit Nullen aufüllen
	bra.b	Flags
fo6:	cmp.b	#'#',d0
	bne.b	Feldbreite
	bset	#4,d7		; d7.4: alternative "#"-Ausgabe
	bra.b	Flags
Feldbreite:
	; Ende der Steuerzeichen:
	cmp.b	#'*',d0
	bne.b	fo7
	; Feldbreite "*":
	bsr	AlignW
	move.l	(a1)+,d6
	move.b	(a0)+,d0
	bra.b	Point
fo7:	cmp.b	#'0',d0
	blo.b	Point
	cmp.b	#'9',d0
	bhi.b	Point
	mulu	#10,d6
	sub.b	#'0',d0
	ext.w	d0
	ext.l	d0
	add.l	d0,d6
	move.b	(a0)+,d0
	bra.b	fo7
Point:	cmp.b	#'.',d0
	bne.b	Precision
	move.b	(a0)+,d0
Precision:
	cmp.b	#'*',d0
	bne.b	fo8
	bsr	AlignW
	move.l	(a1)+,d5         ; Genauigkeit von Parameterstack
	move.b	(a0)+,d0
	bra.b	Length
fo8:	cmp.b	#'0',d0
	blo.b	Length
	cmp.b	#'9',d0
	bhi.b	Length
	moveq	#0,d5
	sub.b	#'0',d0
	move.b	d0,d5
fo9:	moveq	#0,d0
	move.b	(a0)+,d0
	cmp.b	#'0',d0
	blo.b	Length
	cmp.b	#'9',d0
	bhi.b	Length
	sub.w	#'0',d0
	mulu	#10,d5
	add.w	d0,d5
	bra.b	fo9
Length:	cmp.b	#'h',d0
	bne.b	fo10
	bset	#5,d7		; d7.5: "h"-Breite
	move.b	(a0)+,d0
	bra.b	Arg
fo10:	cmp.b	#'l',d0
	bne.b	fo11
	bset	#6,d7		; d7.6: "l"-Breite
	move.b	(a0)+,d0
	bra.b	Arg
fo11:	cmp.b	#'L',d0
	bne.b	Arg
	bset	#7,d7		; d7.7: "L"-Breite
	move.b	(a0)+,d0
Arg:	; OK, jetzt wird's ernst:
	cmp.b	#'s',d0
	beq	String
	cmp.b	#'%',d0
	beq	Prozent
	cmp.b	#'c',d0
	beq	Char
	cmp.b	#'d',d0
	beq.b	Int
	cmp.b	#'i',d0
	beq.b	Int
	cmp.b	#'u',d0
	beq	Unsigned
	cmp.b	#'o',d0
	beq	Unsigned
	cmp.b	#'x',d0
	beq	Unsigned
	cmp.b	#'X',d0
	beq	Unsigned
	cmp.b	#'f',d0
	beq	Fixed
	cmp.b	#'e',d0
	beq	Expo
	cmp.b	#'E',d0
	beq	ExpoE
	cmp.b	#'g',d0
	beq	gFloat
	cmp.b	#'G',d0
	beq	Float
	cmp.b	#'p',d0
	beq	Pointer
	cmp.b	#'n',d0
	beq	Nifty

	; ungültig:
	move.l	a0,d3
	sub.l	d2,d3
	moveq	#0,d0
	rts


Int:	bsr	AlignW
	btst	#5,d7
	beq.b	int1		; short
	move.l	(a1)+,d0
	ext.l	d0
	bra.b	int3
int1:	btst	#7,d7
	beq.b	int2		; long
	move.l	(a1)+,d0
	move.l	(a1)+,d1
	bra.b	int4
int2:	move.l	(a1)+,d0	; int
int3:	moveq	#0,d1
	tst.l	d0
	bpl.b	int4
	moveq	#-1,d1
int4:	movem.l	a0/a1,-(a7)
	move.w	#10,-(a7)	; Basis 10
	pea	1(a2)		; ein Zeichen freilassen
	move.l	d1,-(a7)
	move.l	d0,-(a7)
	jsr	_vlongtostr
	lea	8+4+2(a7),a7
	movem.l	(a7)+,a0/a1
	move.l	d0,d2
	move.l	d0,a2
	moveq	#-1,d5
	cmp.b	#'-',(a2)
	beq	foS1
	btst	#2,d7
	bne.b	int5
	btst	#1,d7
	beq	foS1
	; mit "+":
	move.b	#'+',-(a2)
	move.l	a2,d2
	bra	foS1
int5:	; mit Space:
	move.b	#' ',-(a2)
	move.l	a2,d2
	bra	foS1

Unsigned:
	move.b	d0,d3
	bsr	AlignW
	moveq	#0,d0
	moveq	#0,d1
	btst	#5,d7
	beq.b	uns1
	addq.l	#2,a1
	move.w	(a1)+,d0
	bra.b	uns3
uns1:	btst	#7,d7
	beq.b	uns2
	move.l	(a1)+,d0
	move.l	(a1)+,d1
	bra.b	uns3
uns2:	move.l	(a1)+,d0
uns3:	move.l	a2,d2
	move.b	#' ',(a2)+

	movem.l	a0/a1,-(a7)
	cmp.b	#'X',d3
	beq.b	.Hex
	cmp.b	#'x',d3
	beq.b	.Hex
	cmp.b	#'o',d3
	beq.b	.Oct
	move.w	#10,-(a7)	; dezimal
.unsIn:	move.l	a2,-(a7)
	move.l	d1,-(a7)
	move.l	d0,-(a7)
	jsr	_uvlongtostr
	lea	8+4+2(a7),a7
	movem.l	(a7)+,a0/a1
	cmp.b	#'X',d3
	bne.b	.4
	move.l	d2,a2
	bsr	Upcase
.4	moveq	#-1,d5
	btst	#2,d7
	bne	foS1		; Space soll bleiben
	move.l	d2,a2
	move.b	#'+',(a2)
	btst	#1,d7
	bne	foS1
	addq.l	#1,d2		; auch "+" ist recht
	bra	foS1

.Hex	btst	#4,d7
	beq.b	.hx1
.hx0	move.b	#'0',(a2)+
	move.b	#'x',(a2)+
.hx1	move.w	#16,-(a7)
	bra.b	.unsIn

.Oct	btst	#4,d7
	beq.b	.oct1
	tst.l	d0
	bne.b	.oct0
	tst.l	d1
	beq.b	.oct1
.oct0	move.b	#'0',(a2)+
.oct1	move.w	#8,-(a7)
	bra.b	.unsIn

Float:	bset	#9,d7		; d7.9: "G"-Flag
gFloat:	bset	#8,d7		; d7.8: "g oder G"-Flag
	bsr	AlignW
	movem.l	(a1),d0/d1
	jsr	Expo10
	cmp.w	#-4,d4
	blt.b	Expo
	cmp.w	#10,d4
	bgt.b	Expo

Fixed:	bsr	AlignW
	move.l	(a1)+,d0
	move.l	(a1)+,d1
	tst.l	d5
	bpl.b	fx1
	moveq	#6,d5
fx1:	move.w	d5,d2
	movem.l	d5-d7/a0-a2,-(a7)
	jsr	DoubleToFixed
	movem.l	(a7)+,d5-d7/a0-a2
	btst	#8,d7
	beq.b	fx2
	btst	#4,d7
	bne.b	flIn
	bsr	NullenToeten		; "G" ohne "#"
	bra.b	flIn
fx2:	; "F":
	btst	#4,d7
	beq.b	flIn
	; alternativer Modus bei 0 Stellen: "." anhängen
	move.l	a2,d2
	bsr	InsertPoint
	move.l	d2,a2
flIn:	; Zahlenstring a2:
	move.l	a2,d2
	btst	#9,d7
	beq.b	fl1
	bsr	Upcase
	move.l	d2,a2
fl1:
	moveq	#-1,d5
	cmp.b	#' ',(a2)
	bne	foS1
	btst	#2,d7
	bne	foS1		; Space bleibt
	move.b	#'+',(a2)
	btst	#1,d7
	bne.b	foS1		; "+" erwünscht
	addq.l	#1,d2
	bra.b	foS1

ExpoE:	bset	#9,d7		; d7.9: "G oder E"-Flag
Expo:
	bsr	AlignW
	move.l	(a1)+,d0
	move.l	(a1)+,d1
	tst.l	d5
	bpl.b	exp1
	moveq	#6,d5
exp1:	move.l	d5,d2
	movem.l	d6-d7/a0-a2,-(a7)
	jsr	DoubleToExpo
	movem.l	(a7)+,d6-d7/a0-a2
	btst	#4,d7
	beq.b	exp2
	move.l	a2,d2
	bsr	InsertPoint
	move.l	d2,a2
	bra.b	exp3
exp2:	btst	#8,d7
	beq.b	exp3
	bsr	NullenToeten	; "G" ohne "#"
exp3:	bra	flIn

Pointer:
	moveq	#'x',d3		; Hex ausgeben
	bset	#4,d7		; mit "0x"
	bsr	AlignW
	moveq	#0,d1
	bra	uns2

Nifty:	bsr.b	AlignW
	move.l	(a1)+,a2
	move.l	#$20000000,d0
	moveq	#0,d2
	moveq	#0,d3
	rts

Prozent:
	moveq	#'%',d0
	bra.b	foC1
Char:	bsr.b	AlignW
	move.l	(a1)+,d0
foC1:	move.l	a2,d2
	move.b d0,(a2)+
	clr.b	(a2)+
	bra.b	foS1
String:
	bsr.b	AlignW
	move.l	(a1)+,d2
foS1:	; String d2:
	moveq	#-1,d3
	move.l	d2,a2
foSCount:
	addq.l #1,d3    ; Zeichen zählen
	tst.b (a2)+
	bne.b foSCount
	cmp.l d5,d3
	bls.b Fill
	move.l d5,d3    ; höchstens d5 Zeichen
Fill:	; d3 auffüllen...
	move.l d6,d0
	sub.l d3,d0
	bls.b NoFill
	; d0 Füllbytes:
	btst #0,d7
	beq.b fo12
	bset #30,d0     ; linksbündig, also Füllbytes voranstellen
fo12:	btst #3,d7
	beq.b fo13
	bset #31,d0     ; mit Nullen füllen
fo13:	rts

EoS:	; Stringende:
	move.l a0,d2
	moveq #0,d3
NoFill:	; keine Füllbytes
	moveq #0,d0
	rts

AlignW:	; a1 aufrunden
	exg d0,a1
	addq.l #1,d0
	bclr #0,d0
	exg d0,a1
	rts

Upcase:	; String a2 nach Upcase
	move.b (a2)+,d0
	beq.b up0
	cmp.b #'a',d0
	blo.b Upcase
	cmp.b #'z',d0
	bhi.b Upcase
	add.b #'A'-'a',-1(a2)
	bra.b Upcase
up0:	rts

InsertPoint:
ip1:	move.b (a2)+,d0
	beq.b ip2
	cmp.b #'e',d0
	beq.b ip2
	cmp.b #'.',d0
	bne.b ip1
	rts
ip2:	; Ende, aber keinen Punkt gelesen:
	moveq #'.',d1
	subq.l #1,a2
ip3:	move.b (a2),d0
	move.b d1,(a2)+
	move.b d0,d1
	bne.b ip3
	move.b d0,(a2)
	rts

NullenToeten:	; aus a2 Nullen und Dezimalpunkt am Ende löschen
	movem.l a1/a2,-(a7)
nt1:	; Punkt oder Ende suchen:
	move.b (a2)+,d0
	beq.b ntRet
	cmp.b #'e',d0
	beq.b ntRet
	cmp.b #'.',d0
	bne.b nt1
	; Dezimalpunkt gefunden
nt2:	move.b (a2)+,d0
	beq.b nt3
	cmp.b #'e',d0
	bne.b nt2
nt3:	subq.l #1,a2            ; Ende des Nachkommateils gefunden
	move.l a2,a1
nt4:	cmp.b #'0',-(a1)        ; Nullen suchen
	beq.b nt4
	cmp.b #'.',(a1)
	beq.b nt5               ; Punkt dann auch löschen
	addq.l #1,a1
nt5:	; Nullen abgeschnitten:
	move.b	(a2)+,(a1)+
	bne.b	nt5
ntRet:	movem.l	(a7)+,a1/a2
	rts

	end