include compiler.inc

	ttl	_FMT, 1.05, 10-21-86, jwk

;support printf etc - original size 07de bytes

;			BITS in FLG byte
ljust	equ	1
sign	equ	2
blank	equ	4
altern	equ	8
zfill	equ	16
islong	equ	32
issgnd	equ	64

	dseg

flch	db	'-+0 #', 0		;flag chars
flgbits	db	ljust, sign, zfill, blank, altern

cch	db	'sc'			;runs on with 'nch'

nch	db	'iXoxud%', 0		;numeric conversions

	cseg

incptr	macro	bump
ifdef	bump&_v
	inc	word ptr bump&_v
else
	inc	word ptr bump
endif
	endm

leads	macro	dest,ofst
	fixds
	lea	dest,ofst
	endm

fixds	macro
ifdef	LONGPTR
	mov	ds,saveds
endif
	endm

setds	macro
ifdef	LONGPTR
	mov	saveds,ds
endif
	endm

	xtfs <index, strlen, tolower, _xd, _xo, _xh>

		;	int _fmt (rtn, arglst)
		;	int *(rtn)(), **arglst;

	procdef	_fmt, <<rtn, fptr>, <arglst, ptr>>
	dclv	ctl, ptr	; char ptr to control string
	dclv	ctlchr, byte	; current control character
	dclv	sent, word	; number of bytes sent out
	dclv	pad, word	; number of bytes padding required
	dclv	tnum, word	; total size of prefix+string
	dclv	prec, word	; precision specified
	dclv	minwid, word	; minimum field width
	dclv	nbr, word	; work area
	dclv	prefix, baray, 128
	dclv	str, baray, 64	; working string buffer
	dclv	flg, byte	; flag byte for prefix formatting
	dclv	op, ptr		; char ptr to working buffer
	dclv	saveds, word	; save word for data segment
	locs	<<strp, ptr>>	; pointer to output string (str or %s)
	pushreg
	pushds
	setds
	xor	ax, ax		; sent = 0;
	mov	sent, ax
	ptrcpyinc arglst, ctl	; ctl = *arglst++;
outer:	ldptr	si, ctl		; while (*ctl)  /*main loop*/
	mov	al, byte ptr [si]
	or	al, al
	jnz	chrok
	jmp	fini
chrok:	caseb	'%', parse	; { if (*ctl != '%')
	call	sndout		;   { if ((*rtn)(*ctl)==EOF)return EOF;++sent;
	jmp	bmpctl		;   }	/*go step CTL*/
parse:				;   else
	incptr	ctl		;   { ++ctl;
	xor	ax, ax		;     flg = 0;
	mov	flg, al
	dec	ax		;     prec = -1;
	mov	prec, ax
	setptr	strp, str, ss	;     strp = str;
	setptr	op, prefix, ss	;     op = prefix;
flglp:	ldptr	si, ctl		;     while (regax=index("-+0 #",*ctl))
	mov	al, byte ptr [si]
	xor	ah, ah
	leads	dx, flch
	callit	index, <<ax, reg>, <dx, preg, ds>>
	dec	ax
	js	setwd
	incptr	ctl		;     { ++ctl;
	mov	bx, ax		;       flg |= flgbits[regax-1];
	mov	al, 7[bx]
	or	flg, al
	jmp	flglp		;     }
setwd:	call	getval		;     minwid = getval(ctl,arglst);
	mov	minwid, ax
	cmp	ax, 0		;     if (minwid<0)
	jge	setpre
	mov	minwid, 1	;	minwid = 1;
setpre:	ldptr	si, ctl		;     if (*ctl=='.')
	cmp	byte ptr [si], '.'
	jne	doltr
	incptr	ctl		;     {	++ctl;
	call	getval		;	prec = getval(ctl,arglst);
	cmp	ax, 0		;	if (prec<0)
	jge	sprec
	xor	ax, ax		;	  prec = 0;
sprec:	mov	prec, ax	;     }
doltr:	ldptr	si, ctl		;     ctlchr = *ctl;
	mov	al, byte ptr [si]
	mov	ctlchr, al
	or	al, 32		;     switch(tolower(ctlchr))
	caseb	'l', casel	;     {
	caseb	'i', csisi
	caseb	'd', cased
	jmp	cx1		;	/*chain the switch tests*/
casel:				;	case 'l':
	or	flg, islong	;	  flg |= islong;
	incptr	ctl		;	  ++ctl;
	jmp	doltr		;	  goto doltr;

csisi:	mov	al, 'd'		;	case 'i':
	mov	ctlchr, al	;	  ctlchr = 'd';

cased:				;	case 'd':
	or	flg, issgnd	;	  flg |= issgnd
	call	gtrg		;	  nbr = getarg();
	mov	nbr, dx
	cmp	dx, 0		;	  if (nbr<0)
	jge	absdn
	xor	dx, -1		;	    nbr = -nbr;
	xor	ax, -1
	add	ax, 1
	adc	dx, 0
absdn:				;	  _xd(nbr, strp);
	callit	_xd, <<strp, ptr>, <dx, reg>, <ax, reg>>
	cmp	nbr, 0		;	  if ( nbr < 0 )
	jge	noneg
	mov	al, '-'		;	    *op++ = '-';
	jmp	setpfx		;	  else
noneg:	test	flg, sign	;	  if (flg & sign)
	jz	nosgn
	mov	al, '+'		;	    *op++ = '+';
	jmp	setpfx		;	  else
nosgn:	test	flg, blank	;	  if (flg & blank)
	jz	endcsd
	mov	al, ' '		;	    *op++ = ' ';
setpfx:	pci	op
endcsd:	jmp	chrdon		;	  break;

cx1:	caseb	'u', caseu		; more CASE tests
	caseb	'o', caseo
	caseb	'x', casex
	jmp	cx2
caseu:				;	case 'u':
	call	gtrg		;	  _xd(getarg(), strp);
	callit	_xd, <<strp, ptr>, <dx, reg>, <ax, reg>>
	jmp	chrdon		;	  break;

caseo:				;	case 'o':
	call	gtrg		;	  _xo(getarg(), strp);
	callit	_xo, <<strp, ptr>, <dx, reg>, <ax, reg>>
	mov	al, flg		;	  if (flg & altern)
	and	al, altern
	jz	endcso
	mov	al, '0'		;	    *op++ = '0';
	pci	op
endcso:	jmp	chrdon		;	  break;

casex:				;	case 'x':
	call	gtrg		;	  _xh(getarg(), strp);
	callit	_xh, <<strp, ptr>, <dx, reg>, <ax, reg>>
	mov	al, flg		;	  if (flg & altern)
	and	al, altern
	jz	endcsx
	mov	al, '0'		;	  { *op++ = '0';
	pci	op
	mov	al, 'x'		;	    *op++ = 'x';
	pci	op
endcsx:	jmp	short	chrdon	;	  break;

cx2:	caseb	'c', casec
	caseb	's', cases
	caseb	'%', cpct
	jmp	dflt

casec:				;	case 'c':
	gwi	arglst		;	  strp[0] = *arglst++;
	jmp	short	stch	;	  strp[1] = 0; break;

cases:				;	case 's':
	ptrcpyinc arglst, strp	;	  strp = *arglst++;
	mov	ax, prec	;	  if (prec<0)
	cmp	ax, 0
	jge	endcss
	callit	strlen <<strp, ptr>>
	mov	prec, ax	;	    prec = strlen(strp);
endcss:	jmp	short	chrdon	;	  break;

cpct:				;	case '%':
	mov	al, '%'		;	  strp[0] = '%'; strp[1] = 0;
	jmp	short	stch	;	  break;

dflt:				;	default:
	ldptr	si, ctl		;	  strp[0] = *ctl;
	mov	al, byte ptr [si]
stch:
	xor	ah, ah		;	  strp[1] = 0;
	ldptr	di, strp, es
	stosw
;	jmp	short	chrdon	;	  break;
chrdon:				;     } /*end of SWITCH on CTLCHR */
	ldptr	si, op		;     *op = 0;
	mov	byte ptr [si], 0
	lea	ax, prefix	;     tnum = strlen(prefix)+strlen(strp);
	callit	strlen <<ax, preg, ss>>
	mov	di, ax
	callit	strlen <<strp, ptr>>
	add	ax, di
	mov	tnum, ax
	leads	di, nch		;     if (index (nch, ctlchr))
	callit	index <<ctlchr, ptr>, <di, preg, ds>>
	or	ax, ax
	jz	notnum
flwhl:	mov	ax, tnum	;     {	while (tnum<prec)
	cmp	ax, prec
	jge	chkpre
	test	flg, zfill	;	{ *op++ = (flg & zfill) ? '0' : ' ';
	jz	fw1
	mov	al, '0'
	jmp	short	fw2
fw1:	mov	al, ' '
fw2:	pci	op
	xor	al, al		;	  *op = 0;
	mov	byte ptr [di], al
	inc	tnum		;	  ++tnum;
	jmp	flwhl		;	} /* end of WHILE */
notnum:				;     } else
	mov	ax, prec	;     { if (prec < 0)
	cmp	ax, 0
	jge	chkpre
	mov	ax, 1		;	  prec = 1;
	mov	prec, ax	;     }
chkpre:	mov	ax, prec	;     nbr = max (prec, minwid);
	cmp	ax, minwid
	jg	svnum
	mov	ax, minwid
svnum:	mov	nbr, ax
	sub	ax, tnum	;     pad = (tnum<nbr ? nbr-tnum : 0);
	jns	svpad
	xor	ax, ax
svpad:	mov	pad, ax
	mov	al, ctlchr	;     if (ctlchr=='x')
	cmp	al, 'x'
	jnz	chkch2
	setptr	op, prefix, ss	;     {	op = prefix;
lcpfx:	ldptr	si, op		;	while (*op)
	mov	al, byte ptr [si]
	xor	ah, ah
	or	ax, ax
	jz	lcpex
	callit	tolower, <<ax, reg>>
	pci	op		;	  *op++ = tolower(*op);
	jmp	lcpfx
lcpex:	setptr	op, str, ss	;	op = str;
lcstr:	ldptr	si, op		;	while (*op)
	mov	al, byte ptr [si]
	xor	ah, ah
	or	ax, ax
	jz	chkch2
	callit	tolower, <<ax, reg>>
	pci	op		;	  *op++ = tolower(*op);
	jmp	lcstr		;     }	/* end IF(CTLCHR..	*/
chkch2:	leads	di, cch		;     if (index(cch, ctlchr))
	callit	index <<ctlchr, ptr>, <di, preg, ds>>
	or	ax, ax
	jnz	cc2a
	jmp	notctch
cc2a:	test	flg, zfill	;     { nbr = (flg & zfill ? '0' : ' ');
	jz	cc2b
	mov	al, '0'
	jmp	short	cc2c
cc2b:	mov	al, ' '
cc2c:	mov	nbr, ax
	test	flg, ljust	;	if (!(flg & ljust)) /* pad on left */
	jnz	lpadx
padlft:	dec	pad		;	  while (--pad >= 0)
	js	lpadx
	mov	ax, nbr		;	    sndout(nbr);
	call	sndout
	jmp	padlft
lpadx:	setptr	op, prefix, ss	;	op = prefix;	/* out prefix	*/
outpfx:	ldptr	si, op		;	while (*op)
	cmp	byte ptr [si], 0
	je	outstg
	lodsb			;	  sndout(*op++);
	svptr	si, op
	call	sndout
	jmp	outpfx
outstg:	ldptr	si, strp	;	while (*strp)	/* out string	*/
	cmp	byte ptr [si], 0
	je	ckrpad
	cmp	ctlchr, 's'	;	{ if ( ctlchr == 's'
	jnz	notstg
	dec	prec		;	    && --prec < 0 )
	js	ckrpad		;	    break;
notstg:	gci	strp		;	  sndout(*strp++);
	call	sndout
	jmp	outstg		;	} /* end WHILE */
ckrpad:	test	flg, ljust	;	if (flg & ljust)	/* pad right */
	jz	bmpctl
dorpad:	dec	pad		;	  while ( --pad >= 0 )
	js	bmpctl
	mov	al, ' '		;	    sndout(' ');
	call	sndout
	jmp	dorpad
notctch:			;     } else /*end of IF(INDEX... */
	ldptr	si, ctl		;	sndout(*ctl);
	mov	al, byte ptr [si]
	call	sndout
bmpctl:	incptr	ctl		;     ++ctl;
	jmp	outer		;   }	/* main control loop ends here */
fini:	mov	ax, sent	;   return (sent);
fmtqt:	pret			; }	/* end of function */
	pend	_fmt

	internal	gtrg	;uses _FMT's BP and offsets
	cld			;get "long" from arg list
	push	ds
	ldptr	si,arglst	;grab the pointer
	lodsw
	mov	cl, flg		;check for sign extension
	test	cl, issgnd
	jnz	sxt
	xor	dx, dx		;unsigned
	jmp short tstlg
sxt:	cwd			;assume it's int
tstlg:	and	cl, islong
	jz	gtrgx		;not a long, done
	xchg	dx, ax		;was a long, so...
	lodsw			;get hi word
	xchg	dx, ax
gtrgx:	svptr	si,arglst	;update ARGLST pointer
	pop	ds
	ret
	iend	gtrg

	internal	sndout	;uses _FMT's BP and offsets
	xor	ah, ah
	push	ax
	fixds
	call	rtn
	inc	sp
	inc	sp
	cmp	ax, -1		;error?
	jne	sndok		;no
	inc	sp		;yes, flush ret address
	inc	sp
	jmp	fmtqt		;and get out of _fmt()
sndok:	inc	sent		;bump SENT count
	ret			;to caller inside _fmt
	iend	sndout

	internal	getval	;must reference from main BP
	push	ds
	mov	cx, -1		;initialize accumulator
	ldptr	si, ctl
	mov	al, byte ptr [si]
	cmp	al, '*'
	jne	gv_ckn
	gwi	arglst		;get an argument
	jmp	gv_lx
gv_ckn:	sub	al, '0'
	jb	gv_lr		;not numeric either
	cmp	al, 9
	ja	gv_lr		;so return -1
	cbw
	mov	cx, ax		;re-initialize accumulator
	mov	di, 10
gv_dgl:	inc	si
	mov	al, [si]
	sub	al, '0'
	jb	gv_ls		;out of digits, return acc
	cmp	al, 9
	ja	gv_ls
	cbw
	xchg	ax, cx		;swap for multiply by 10
	cwd
	mul	di
	add	cx, ax		;accumulate it
	jmp	gv_dgl
gv_ls:	svptr	si, ctl		;update CTL pointer
gv_lr:	mov	ax, cx		;get return value
gv_lx:	pop	ds
	ret
	iend	getval

	finish