PDP-10.its/src/syseng/format.305

;;;-*-Midas-*-

subttl FORMAT

.begin format

;;;The master copy of this library lives in AI:SYSENG;FORMAT >.

;;;Modification history:
;;; Alan 12/2/87	Added ~U.
;;; Alan 10/10/87	Added ~:H.  $$ERRS defaults to 0 since nobody seems
;;;			to want it usually.  ~Q and ~F should now work
;;;			inside justification.
;;; Alan 5/16/87	Fixed ~E to understand multi-line error messages.
;;; Alan 11/23/85	Added : flag to ~S (and ~F?).
;;; Alan 5/2/85		Added ~| and ~Q and $$TIME.
;;; Alan 1/26/85	New switch:
;;;			$$IERR = 1, allow user supplied error macro
;;; CStacy ???		New switches:
;;;			$$ITS = 0, not running under ITS
;;;			$$ERRS = 0, ~E not enabled
;;; Alan 7/17/83	Installed FORMAT on SYSENG;

comment 

File: FORMAT, Node: Top, Up: (LIB), Next: Requirements

FORMAT is a .INSRTable MIDAS library patterned after Lisp's FORMAT
function.  The Lisp FORMAT function traces its ancestry back to the
FORTRAN FORMAT statement and to the ioa_ routine on Multics.  This is
simply the latest entry in a long tradition.

* Menu:

* Introduction::	Introduction to FORMAT for people who have never
			seen anything like it before.

* Requirements::	Basic requirements and calling convention.

* Operators::		Table of all operators.

* Switches::		Varying the behavior of FORMAT to suit your
			application.

File: FORMAT, Node: Switches, Previous: Operators, Up: Top, Next: PCode

For the most part FORMAT can function quite well without having \any/
switches set, most all operators are always assembled.  (The single
exception is the ~T operator currently.)

Some switches allow the user to choose between different techniques FORMAT
can use to accomplish the same ends.  For example, the $$ITAB and $$UTAB
switches allow the user to choose how the ~T operator keeps track of
horizontal position.

In some cases FORMAT can do a better job with some hints and assistance
from the user.  For example, the $$PCODE switch tells FORMAT that it is
outputting to a display mode TTY channel so that it can use -codes to
perform cursor positioning.

Anyone reading this documentation for the first time should probably glance
briefly at each node in the following menu, just to learn what the options
are.

* Menu:

* PCode::		The $$PCODE switch, for when FORMAT is outputting
			to a display mode TTY.

* ITab::		The $$ITAB switch, for when you can track
			horizontal position yourself.

* UTab::		The $$UTAB switch, for when you want FORMAT to
			track horizontal position for you.

* PFN::			The $$PFN switch allows FORMAT to call the RFN"PFN
			routine from the RFN library to print filenames.
			*Note RFN:(LIB)RFN.

* Time::		The $$TIME switch allows FORMAT to call routines
			from the DATIME library to print dates and times.
			*Note DATIME:(LIB)DATIME.

* Engl::		The $$ENGL switch can be used to disable the
			english number printer to conserve space.

* IErr::		The $$IERR switch controls the way FORMAT
			signals errors.

* Errs::		The $$ERRS switch controls the ~E operator.

* ITS::			The $$ITS switch says FORMAT is running under the
			ITS operating syste.

File: FORMAT, Node: Introduction, Previous: Top, Up: Top, Next: Requirements

If anyone needs this introduction, I refer them to the Lisp Machine
manual's documentation for the FORMAT function.  Perhaps someday I will
write something here myself.

File: FORMAT, Node: Operators, Previous: Requirements, Up: Top, Next: Switches

FORMAT operators are introduced by the escape character tilde (~), as with
the Lisp FORMAT function.  Each operator is identified by a single
character following the tilde, for example the two character sequence ~D is
the format operator for printing a number in decimal.  Additionally,
various "infix" arguments are allowed between the tilde and the
identifying character.  A sequence of digits is a numeric "parameter"; it
is interpreted in decimal.  (Unlike the Lisp FORMAT, only a single
parameter is permitted.)  Also the characters colon (:) and atsign (@) may
appear in the infix argument, they are simply "flags" that modify the
behavior of the operator in some binary way.

Instead of a sequence of digits the character "v" may appear as an infix
argument.  In this case the next FORMAT argument is gobbled and it is used
as the parameter.  This is mostly useful with the ~R, ~T and ~< operators.

Here is a table of all currently defined FORMAT operators.

~%	Outputs a carrage return.  ~n% outputs n carrage returns.  No
	argument is gobbled.

~&	Advances to a fresh line.  ~n& advances to a fresh line and outputs
	n-1 carrage returns.  No argument is gobbled.  FORMAT's ability to
	bring you to a fresh line without extraneous carrage returns
	depends on the settings of the $$PCODE, $$ITAB and $$UTAB switches.
	if none of those switches is set, then ~& behaves exactly like ~%.

~A	One argument is gobbled.  It should be a byte pointer to an ASCIZ
	string which is to be output.  -1 and 0 in the left half are both
	equivalent to 440700.

~B	One argument is gobbled.  It is output as a number in binary.

~C	One argument is gobbled.  It is output as a single character.
	Control characters are output as a two character sequence starting
	with ^.  ~:C just outputs the character, even if it is a control
	character. 

~D	One argument is gobbled.  It is output as a number in decimal.

~E	The error message associated with the channel currently in .BCHN is
	output (in all lower case).  Normally this is the error message
	associated with the most recent error (.CALL that failed to skip,
	or whatever).  ~:E gobbles one argument, which should be an ITS
	error code, and prints the associated error message.  The @ flag
	causes the first character of the error message to be capitalized.
	This operator is not assembled unless the $$ERRS flag is set.
	See *Note Errs:Errs.

~F	One argument is gobbled.  It should be a pointer to a four-word
	block containing an ITS filename.  (In the usual order: device,
	first filename, second filename, directory.)  The filename is
	printed in the standard way.  If the $$PFN flag is set, then FORMAT
	will call the RFN"PFN routine from the RFN library.  See
	*Note PFN:PFN.

~H	One argument is gobbled.  It is printed in octal halfword format
	similar to H mode in DDT (In fact the algorithm is borrowed from
	DDT).  -105 is printed as "-1,,-105" etc.  ~:H is the same except
	the left half is omitted when it would be redundant.  (That is,
	777 is printed as "777" rather than "0,,777" and -1 is printed as
	"-1" rather than "-1,,-1".)

~O	One argument is gobbled.  It is printed in octal.

~P	The previously gobbled argument is re-examined.  If it is 1,
	nothing is output, otherwise "s" is output.  No new arguments are
	gobbled.  ~:P is the same except instead of re-examining the
	previous argument, a new argument is gobbled.  (Note that the sense
	of the colon flag is reversed from the Lisp FORMAT function's ~P
	operator.)  ~@P and ~:@P are similar except if the argument is 1
	then "y" is output, otherwise "ies" is output.

~Q	One argument is gobbled.  It is interpreted as a date and time in
	ITS disk format and output.  ~:Q outputs just a time.  ~@Q outputs
	just a date.  This operator is not assembled unless the $$TIME
	switch is set.  See *Note Time:Time.

~R	~nR gobbles one argument and outputs it in base n.
	~R (no parameter) gobbles one argument and outputs it in english
	("one", "two", "three", etc.).  ~:R outputs an ordinal number
	("first", "second", "third", etc.).  The @ flag causes the first
	character of the first word output to be capitalized.  FORMAT's
	english number printing facilities can be disabled by use of the
	$$ENGL switch to save space, see *Note Engl:Engl.

~S	One argument is gobbled.  It is interpreted as a word of SIXBIT and
	output.  ~:S prints in lower case.

~T	~nT outputs enought tabs and spaces to advance the output to a
	horizontal position of n.  If the output is already beyond that
	column, nothing is output.  This operator is not assembled unless
	one of the switches $$ITAB or $$UTAB is set.  No arguments are
	gobbled.  (See *Note ITab:ITab, and its Next for details.)

~U	One argument is gobbled.  It is interpreted as a word of SQUOZE and
	output.

~X	~X gobbles one argument.  It is output in hexidecimal.

~|	If $$PCODE is set, ~| clears the screen.  If $$PCODE is not set, ~|
	outputs a formfeed.  In both cases ~n| then outputs n-1 carrage
	returns.

~~	Outputs a tilde.  No argument is gobbled.

~<cr>	Occasionally it may be necessary to insert a carrage return in a
	long FORMAT control string to improve readability.  The ~<cr>
	operator allow this to be done gracefully.  ~<cr> simply discards
	the carrage return and any leading whitespace on the next line and
	then continues processing the control string.  ~@<cr> outputs the
	carrage return and discards the whitespace.  ~:<cr> discards the
	carrage return and outputs the whitespace.  ~:@<cr> outputs both,
	and is therefore a no-op.  No argument is gobbled.

~<	These three operators provide a justification feature.
~;	~n<ll...ll~;crr...rr~> processes the two strings "ll...ll" and
~>	"rr...rr" and outputs them with as many copies of the character "c"
	between them as is necessary to fill up exactly n characters.  So
	for example, to print a decimal number in a 6 column field padded
	on the left with zeros, one could write: "~6<~;0~D~>".  If the
	output cannot possibly fit, no copies of the padding character will
	be output and the resulting text will simply be too long.

	By special dispensation, if the lefthand string is empty, and the
	padding character is a space, then the "~; " may be omitted.  Thus to
	output a decimal number in 6 columns padded on the left with
	spaces, one could simply write: "~6<~D~>".

	A few operators are illegal within the strings "ll...ll" and
	"rr...rr", mostly those having to do with knowing horizontal
	position.  They are: ~%, ~&, ~T and ~<.  The last means that
	recursive justifications are not currently supported.  

	Note that unlike ~T, the justification feature counts characters,
	rather than computing horizontal position.

File: FORMAT, Node: Requirements, Previous: Top, Up: Top, Next: Operators

FORMAT requires no static storage, it keeps all of its state on the stack
(including its small output buffer).  It is completely pure, and completely
reentrant.

FORMAT stack frames are relatively large, about 20. to 30. words.  Keep
this in mind when you are allocating your PDL!

The following accumulators must be defined: A, B, C, D, E, and P.  C must
be B+1.  P must be the pdl-pointer.

OUTSTR must be defined.  It should be a routine for printing an ASCII
string.  This is what FORMAT calls to output characters.

FORMAT does not define any symbols outside of its own symbol block, named
FORMAT.  (See *Note Blocks:(Midas)Blocks, for a review of Midas block
structure.)  Thus, for example, FORMAT's entrypoint is usually written
FORMAT"FORMAT by the caller.

Calling convention:

When FORMAT"FORMAT is called it expects A to contain a byte pointer to an
ASCII string.  B should contain the length of that string in characters.  C
should contain minus the number of arguments being passed to FORMAT.  Those
arguments should have been pushed on the PDL (in order) before FORMAT was
called.  The return address will be found below those arguments.  FORMAT
returns by popping the arguments off the stack and then doing a POPJ P,.  A
typical call to FORMAT might look like:

	push p,[foo69]
	push p,errors
	push p,trials
	hrroi a,[ascii "~&~D error~P in ~D trial~P."]
	movei b,.length "~&~D error~P in ~D trial~P."
	movni c,2
	jrst format"format
foo69:	

Obviously a little macrology can sugar this up to be not quite so
cumbersome.  See *Note Macro:Macro, for a possible candidate.

Notice, by the way, that a -1 or a 0 in the left half of the byte pointer
passed to FORMAT in A will be treated as if it were 440700.

FORMAT calls the routine OUTSTR to do output with a byte pointer in A,
character count in B.  That routine mustn't clobber D or E, but C is
fair game.  It is called by PUSHJ P,OUTSTR.  A likely OUTSTR might be: 

outstr:	.call [setz ? sixbit /siot/
		movei ttyo
		move a
		setz b]
	 .lose %lssys
	popj p,

File: FORMAT, Node: PFN, Previous: UTab, Up: Switches, Next: Time

By default $$PFN==0.

If $$PFN==0 then ~F will simply format a filename like: "~S: ~S; ~S ~S"

If $$PFN==1 then the ~F operator will work by calling the routine PFN,
which you must supply somehow.  It will be invoked as if it is the RFN"PFN
routine from the RFN library.  (*Note RFN:(LIB)RFN.)  Typically setting
$$PFN==1 will look something like:

rfn"$$pfn==:1
.insrt dsk:syseng;rfn >

format"$$pfn==:1
format"pfn==:rfn"pfn
.insrt dsk:syseng;format >

FORMAT assumes that no filename can require more than 54 characters to
print (including quotes, and including a potential ^@ after the last
character deposited).

Of course it needn't really be RFN"PFN that format calls in this case, the
routines RFN"PFNMCH and RFN"PFNBRF also have the same calling convention
and can be used instead.  Indeed, any routine can be used as long as it has
the same calling convention and doesn't deposit more than 54 characters!

File: FORMAT, Node: Time, Previous: PFN, Up: Switches, Next: Engl

By default $$TIME==0.

If $$TIME==1 then the ~Q operator is enabled.  It will format dates and
times by calling the routines FORMAT"DATIME, FORMAT"TIME, and FORMAT"DATE
in order to implement ~Q, ~:Q, and ~@Q respectively.  These routines are
all invoked as if they were output routines from the DATIME library.
(*Note DATIME:(LIB)DATIME.)  Typically setting $$TIME==1 will look
something like:

datime"$$out==:1
.insrt dsk:syseng;datime >

format"$$time==:1
format"datime==:datime"twdasc
format"time==:datime"timasc
format"date==:datime"datasc
.insrt dsk:syseng;format >

FORMAT assumes that no date or time requires more than 35 characters to
print.  (This is easily true of all the routines in DATIME.)

File: FORMAT, Node: Engl, Previous: Time, Up: Switches, Next: IErr

By default $$ENGL==1.

If $$ENGL==1, then FORMAT's english number printing routines are assembled.
This enables ~R, ~:R, ~@R and ~:@R.

If you are tight for space, you can set $$ENGL==0 and save about 250 words.

File: FORMAT, Node: ITS, Previous: Errs, Up: Switches

By default $$ITS==1.

If $$ITS==0, then FORMAT will not assume that it is running under ITS
timesharing.

File: FORMAT, Node: Errs, Previous: IErr, Up: Switches, Next: ITS

By default $$ERRS==0.

If $$ERRS==1, then the ~E operator is enabled and ERRI must be defined.  It
should be a channel on which FORMAT can open the ERR device if need be.

File: FORMAT, Node: IErr, Previous: Engl, Up: Switches, Next: Errs

By default $$IERR==0.

If $$IERR==1 then FORMAT will expect the user to define a macro named
FMTERR that FORMAT will use to signal errors.  It should expect a single
macro argument of a string of text surrounded by doublequotes.

If $$IERR==0 then format uses the following macro:

define fmterr *text*
	.value .+2
	jrst .-1
	asciz ":text
"
termin

File: FORMAT, Node: PCode, Previous: Switches, Up: Switches, Next: ITab

By default $$PCODE==0.

If $$PCODE==1 then FORMAT is allowed to output ^P codes.  This is different
from allowing the caller to include ^P codes in his FORMAT control string.
The only restriction on the latter is that if $$UTAB==1 (*Note UTab:UTab.),
then FORMAT will be confused by ^P codes not produced by FORMAT itself.

File: FORMAT, Node: ITab, Previous: PCode, Up: Switches, Next: UTab

By default $$ITAB==0.

If $$ITAB==1 then the ~T operator is enabled.  The user should supply a
routine named GETPOS to return the horizontal cursor position.  The routine
will be called using PUSHJ P,GETPOS.  It should return the current
horizontal cursor position in A.  It should return -1 if the horizontal
position is unknown.  It mustn't clobber D or E, but B and C are fair game.
A likely GETPOS might be:

getpos:	.call [setz ? sixbit /rcpos/
		movei ttyo
		setzm a]
	 skipa a,[-1]
	hrrz a,a
	popj p,

File: FORMAT, Node: UTab, Previous: ITab, Up: Switches, Next: PFN

By default $$UTAB==0.

If $$UTAB==1 then the ~T operator is enabled.  FORMAT will keep track
of horizontal position itself in this case.  This requires that D should
contain the starting horizontal position whenever FORMAT"FORMAT is called.
When FORMAT returns, D will contain the updated horizontal position.  A
GETPOS routine is NOT required.

The algorithm FORMAT uses to compute horizontal position is the same as
that employed by EMACS when it displays a file without SAIL characters
enabled.  That is, most control characters are two characters wide,
including ^H (backspace) and isolated ^M's (carrage return) and ^J's (line
feed).  ^M immediately followed by ^J resets horizontal position to 0.
^I (tab) characters are understood to advance the horizontal position to
the next multiple of 8 (and at least to advance it by 1).

File: FORMAT, Node: Macro

Here is a simple macrology for calling FORMAT:

The user writes:

	format "~&~D error~P in ~D trial~P.",[errors,trials]

This macro expands into a single instruction, so that it can be skipped
over.  All accumulators are saved and restored.  The arguments written in
the IRP list after the control string can refer to any location and will
find the expected value there, EXCEPT for P.

define format &string&,args
	pushj p,[
	pushj p,fmtin
zzz==-1
irp arg,,[args]
	push p,arg
zzz==.irpcnt
termin
	hrroi a,[ascii string]
	movei b,.length string
	movni c,zzz+1
	jrst format"format]
termin

fmtin:	push p,a
	push p,b
	push p,c
	push p,[fmtout]
	jrst @-4(p)

fmtout:	pop p,c
	pop p,b
	pop p,a
	pop p,(p)
	popj p,

	;end comment
.auxil				;Don't cref me please.

.tyo6 .ifnm1
.tyo 40
.tyo6 .ifnm2
fmtvrs==:.ifvrs
printx / included in this assembly.
/

ifn b+1-c, .err FORMAT requires C=B+1

ifndef $$pcode, $$pcode==0	;can use ^P codes
ifndef $$itab, $$itab==0	;~T and ~& can call GETPOS to do their job.
ifndef $$utab, $$utab==0	;format itself is tracking the hpos.
ifndef $$pfn, $$pfn==0		;PFN routine prints filenames.
ifndef $$engl, $$engl==1	;English number printing is enabled.
ifndef $$time, $$time==0	;Date and time printing is enabled.
ifndef $$ierr, $$ierr==0	;User has defined a fmterr macro for us.
ifndef $$its, $$its==1		;Running under ITS.
ifndef $$errs, $$errs==0	;Error code/message printing is enabled.

ifn $$utab, ifn $$itab, .err $$ITAB and $$UTAB simultaneously non-zero.

ife $$its,[
ifn $$errs, .err ~E feature only available under ITS
ife $$ierr, .value==jrst 4,
];ife $$its

ife $$ierr,[
define fmterr *text*
	.value .+2
	jrst .-1
	asciz ":text
"
termin
] ;ife $$ierr

call==pushj p,
return==popj p,
jcall==jrst

;;;Flags are kept in left half of E.
%fmcol==1_17.			;Colon flag, sign bit of E
%fmats==1_16.			;Atsign flag
%fmnum==1_15.			;Numeric argument seen.
%fmv==1_14.			;~vX type numeric argument seen.
%fmjst==1_13.			;Set during a justification.
%fmbuf==1_12.			;Indicates that a justification is still
				;possible on characters still in the
				;buffer.  If $$UTAB==1 then the characters
				;in the buffer have not been counted into
				;HPOS yet.  Cleared whenever the buffer is
				;dumped.
%fmcrl==1_11.			;If $$UTAB==1, this bit remembers that a ^M
				;was the last character out in case the
				;next one is ^J.
%fmeng==1_10.			;Internal to the english number printer.

ifn $$utab,[
define tyo x
ifn c-x, move c,x
	format"call format"%tyo
termin
] ;end ifn $$utab

ife $$utab,[
define tyo x
	idpb x,format"obp(e)
	sosg format"bufct(e)
	 format"call format"dump
termin
] ;end ife $$utab

define nojust
	tlne e,format"%fmjst
	 format"call format"bdjust
termin

define nextarg x,inst=move
	move x,format"argptr(e)
	aobjp x,format"nxarg
	movem x,format"argptr(e)
	inst x,(x)
termin

define getarg x,inst=move
	move x,format"argptr(e)
	inst x,(x)
termin

format:	push p,d
	  save.d=400000		;saved contents of D
	  hpos==save.d		;If $$UTAB==1, this is hpos.
	movei d,-1(p)
	add d,c
	push p,d
	  save.p=400001		;saved pdl height
	hrli d,-1(c)
	push p,d
	  argptr=400002		;AOBJP Argument pointer.
	push p,e
	  save.e=400003		;saved contents of E
	hrrzi e,-save.e(p)	;Flags all clear initially.
	hlrz c,a
	caie c,-1		;0 or -1 in left half acts like 440700
	 skipn c
	  hrli a,440700
	push p,a
	  bp=400004		;Control string byte pointer.
	push p,[0]
	  numarg=400005		;numeric argument to operator.
	movei a,buffer(e)
	hrli a,440700
	push p,a
	  obp=400006		;Output byte pointer.
	  ibfsiz==10.		;50. character buffer initially.
	push p,[ibfsiz*5]
	  bufct=400007		;Output buffer count.
	push p,[0]
	  just=400010		;For justification
	push p,[ibfsiz*5]
	  bufsiz=400011		;Size of buffer is variable.
repeat ibfsiz, push p,[ascii "_____"]
	  buffer=400012		;Buffer must be last.
	move d,b		;D: length of string
loop:	sojl d,done		;nothing left?
scan:	ildb c,bp(e)
xloop:	cain c,"~
	 jrst escape
	tyo c
	sojge d,scan
done:	call dump
	tlne e,%fmjst
	 call eof
	hrrz c,p
	sub c,save.p(e)
	move d,save.d(e)
	move e,save.e(e)
	hrl c,c
	sub p,c
	return

escape:	movei c,1
	movem c,numarg(e)	;default arg is 1
	tlz e,%fmats\%fmcol\%fmnum\%fmv\%fmeng		;clear flags
escp1:	sojl d,eof
	ildb c,bp(e)
	jrst @esctbl(c)

esctbl:
repeat 200, nxop

define defop char,handlr
zzz==.
loc format"esctbl+char
	handlr
ifge char-"A,[
ifle char-"Z,[
loc format"esctbl+char+"a-"A
	handlr
]]
loc zzz
termin

defop ":,opcolon
opcolo:	tloe e,%fmcol
	 call bdop
	jrst escp1
	
defop "@,opatsign
opatsi:	tloe e,%fmats
	 call bdop
	jrst escp1

defop "V,op.V
op.V:	tloe e,%fmnum\%fmv
	 call bdop
	nextarg c
	movem c,numarg(e)
	jrst escp1

repeat 10., defop "0+.rpcnt,opdigit
opdigi:	tlne e,%fmv
	 call bdop
	move a,numarg(e)
	tlon e,%fmnum
	 setzi a,
	imuli a,10.
	subi c,"0
	add a,c
	movem a,numarg(e)
	jrst escp1

defop "~,optilde
optild:	tyo c
cloop:	jrst loop

defop "R,op.R
defop "X,op.X
op.R:	tlnn e,%fmnum
	 jrst englsh
	skipa a,numarg(e)
op.X:	 movei a,16.
	jrst op.num

defop "B,op.B
op.B:	movei a,2
	jrst op.num

defop "D,op.D
defop "O,op.O
op.D:	skipa a,[10.]
op.O:	 movei a,8
op.num:	nextarg b
	call ntype
	jrst loop

defop "H,op.H
op.H:	nextarg b
	caml b,[-4000]
	 cail b,774000
	  skipa
	   jumpl e,op.H1
	hlrz b,b
	cail b,774000
	 hrre b,b
	movei a,8
	call ntype
	movei c,",
	tyo c
	movei c,",
	tyo c
	getarg b,hrrz
	cail b,774000
	 hrre b,b
op.H1:	movei a,8
	call ntype
	jrst loop

ifn $$engl,[

englsh:	nextarg b
	push p,cloop
	jumpe b,eng0
	jumpg b,eng1
	movei a,$minus
	call prinz
	movn b,b
	jumpl b,ensetz
eng1:	cail b,10000.
	 jrst eng1E9
	move a,b
	idivi b,100.
	idivi b,10.
	move b,a
	jumpe c,eng1E3
	tlo e,%fmeng
	jcall engb

eng0:	movei a,$0
	tlne e,%fmcol
	 movei a,$0th
	jcall prinz

;;;An inordinate number of instructions have been written in this world to
;;;compensate for the fact that in two's-compliment binary there is an
;;;extra negative number:
ensetz:	idiv b,[1000000000.]
	movn b,b
	movn c,c
	jrst eng1E8

eng1E9:	idiv b,[1000000000.]
eng1E8:	move a,[$billion,,eng1E6]
	jrst engil

eng1E6:	idiv b,[1000000.]
	move a,[$million,,eng1E3]
	jrst engil

eng1E3:	idivi b,1000.
eng1E2:	move a,[$thousand,,eng1E0]
	jrst engil

eng1E0:	tlo e,%fmeng
	jcall engb

engil:	exch b,c
	jumpe c,(a)
	push p,a
	push p,b
	call engc
	pop p,b
	hlr a,(p)
	call prinz
	jumpn b,sppopj
	pop p,(p)
	jumpge e,cpopj
thpopj:	movei a,[asciz "th"]
	jcall prinz

sppopj:	movei c,40
	tyo c
	return

;;;Still within IFN $$ENGL:

;;;Subroutine.  Outputs C(B) in english.  0 < C(B) < 10000., but not
;;;1000.|C(B).  ENGC prints C(C), ENGB prints C(B).  If %FMENG and %FMCOL are
;;;set, then we output an ordinal number.
engc:	move b,c
engb:	idivi b,100.
	jumpe b,engx2
	push p,c
	tlze e,%fmeng
	 tlnn e,%fmcol
	  jrst engx1
	call eng100
	movei a,$hundred
	call prinz
	pop p,b
	jumpe b,thpopj
	movei a,$and
	call prinz
	tlo e,%fmeng
	jcall eng100

engx1:	call eng100
	movei a,$hundred
	call prinz
	pop p,b
	jumpn b,eng140
	return

engx2:	move b,c
	jcall eng100

;;;Subroutine.  Outputs C(B) in english.  0 < C(B) < 100..
;;;ENG140 prints a space first, ENG100 does not.  If %FMENG is set, we
;;;output an ordinal number.
eng140:	movei c,40
	tyo c
eng100:	caige b,20.
	 jrst eng102
	idivi b,10.
	move a,C$20-2(b)
	move b,c
	call prinz
	jumpe b,eng103
	movei a,[asciz "y-"]
	call prinz
eng102: move a,C$1-1(b)
	tlne e,%fmeng
	 hlr a,a
prinz:	hrli a,440700
	tlzn e,%fmats		;Atsign flag causes capitalization
	 jrst prinz0
	ildb c,a
	subi c,"a-"A
prinz1:	tyo c
prinz0:	ildb c,a
	jumpn c,prinz1
	return

eng103:	tlne e,%fmeng
	 jrst eng104
	movei c,"y
	tyo c
	return

eng104:	movei a,[asciz "ieth"]
	jcall prinz

;;;Still within IFN $$ENGL:

C$1:	$1th,,$1 ? $2th,,$2 ? $3th,,$3 ? $4th,,$4 ? $5th,,$5 ? $6th,,$6
	$7th,,$7 ? $8th,,$8 ? $9th,,$9 ? $10th,,$10 ? $11th,,$11
	$12th,,$12 ? $13th,,$13 ? $14th,,$14 ? $15th,,$15 ? $16th,,$16
	$17th,,$17 ? $18th,,$18 ? $19th,,$19

C$20:	$20 ? $30 ? $40 ? $50 ? $60 ? $70 ? $80 ? $90

$minus:	asciz "minus "
$and:	asciz " and "
$0:	asciz "zero"
$0th:	asciz "zeroth"

$1:	asciz "one"
$1th:	asciz "first"
$2:	asciz "two"
$2th:	asciz "second"
$3:	asciz "three"
$3th:	asciz "third"
$4:	asciz "four"
$4th:	asciz "fourth"
$5:	asciz "five"
$5th:	asciz "fifth"
$6:	asciz "six"
$6th:	asciz "sixth"
$7:	asciz "seven"
$7th:	asciz "seventh"
$8:	asciz "eight"
$8th:	asciz "eighth"
$9:	asciz "nine"
$9th:	asciz "ninth"
$10:	asciz "ten"
$10th:	asciz "tenth"
$11:	asciz "eleven"
$11th:	asciz "eleventh"
$12:	asciz "twelve"
$12th:	asciz "twelfth"
$13:	asciz "thirteen"
$13th:	asciz "thirteenth"
$14:	asciz "fourteen"
$14th:	asciz "fourteenth"
$15:	asciz "fifteen"
$15th:	asciz "fifteenth"
$16:	asciz "sixteen"
$16th:	asciz "sixteenth"
$17:	asciz "seventeen"
$17th:	asciz "seventeenth"
$18:	asciz "eighteen"
$18th:	asciz "eighteenth"
$19:	asciz "nineteen"
$19th:	asciz "nineteenth"

$20:	asciz "twent"
$30:	asciz "thirt"
$40:	asciz "fort"
$50:	asciz "fift"
$60:	asciz "sixt"
$70:	asciz "sevent"
$80:	asciz "eight"
$90:	asciz "ninet"

$hundr:	asciz " hundred"
$thous:	asciz " thousand"
$milli:	asciz " million"
$billi:	asciz " billion"

] ;end ifn $$engl

defop "A,op.A
op.A:	nextarg a
	hlrz c,a
	caie c,-1		;0 or -1 in left half acts like 440700
	 skipn c
	  hrli a,440700
	jrst op.A1

op.A2:	tyo c
op.A1:	ildb c,a
	jumpn c,op.A2
	jrst loop

defop "S,op.S
op.S:	nextarg a
	call 6type
	jrst loop

defop "C,op.C
op.C:	nextarg a
	jumpl e,op.C1		;If colon set, just tyo it.
	cail a,40		;Normal printing characters just tyo'd
	 cail a,177
	  jrst op.C2
op.C1:	tyo a
	jrst loop

op.C2:	cain a,33		;altmode just gets tyo'd
	 jrst op.C1
	movei c,"^
	tyo c
	trc a,100
	jrst op.C1

defop "P,op.P
op.P:	jumpl e,op.P1		;Colon flag reversed from Lisp version.
	getarg c
	tlne e,%fmats
	 jrst op.P2
op.P3:	cain c,1
	 jrst loop
op.Ps:	movei c,"s
	tyo c
	jrst loop

op.P1:	nextarg c
	tlnn e,%fmats
	 jrst op.P3
op.P2:	cain c,1
	 jrst op.P4
	movei c,"i
	tyo c
	movei c,"e
	tyo c
	jrst op.Ps

op.P4:	movei c,"y
	tyo c
	jrst loop

;  SQUOZE			 ASCII
;  0		"/"		 57
;  1 - 12	"0" - "9"	 60 -  71
; 13 - 44	"A" - "Z"	101 - 132
; 45		"."		 56
; 46		"$"		 44
; 47		"%"		 45

defop "U,op.U
op.U:	nextarg b
	tlz b,740000
op.U1:	idiv b,[50*50*50*50*50]
	addi b,"A-13
	caige b,"A
	 subi b,<"A-1>-"9
	caile b,"Z
	 subi b,<"Z+2>-"$
	cain b,"$-1
	 movei b,".
	exch b,c
	tyo c
	imuli b,50
	jumpn b,op.U1
	jrst loop

ifn $$errs,[
defop "E,op.E
op.E:	jumpl e,op.E4		;If colon flag is set, arg is error code.
	movei a,1
op.E1:	.call op.Ecl
	 .lose %lssys
	tlnn e,%fmats		;If atsign flag is set, Capitalize first word.
	 jrst op.E3
	.iot erri,c
	jrst op.E2

op.E5:	movei c,",
	tyo c
	movei c,40
	tyo c
op.E6:	movei c,"a-"A(a)
	cail c,"a
	 caile c,"z
	  subi c,"a-"A
op.E2:	tyo c
op.E3:	.iot erri,a
	cail a,40
	 jrst op.E6
	caie a,^M
	 jrst op.E9
	.iot erri,a
	caie a,^J
	 jrst op.E9
	.iot erri,a
	cail a,40
	 jrst op.E5
op.E9:	.close erri,
	jrst loop

op.E4:	nextarg b
	movei a,4
	jrst op.E1

op.Ecl: setz
	sixbit /open/
	[.uai,,erri]
	[sixbit /err/]
	move a
	setz b
];$$errs

ife $$pfn,[
defop "F,op.F
op.F:	nextarg a
	push p,2(a)		;fn2
	push p,1(a)		;fn1
	push p,3(a)		;dir
	move a,0(a)		;dev
	call 6type
	movei c,":
	tyo c
	movei c,40
	tyo c
	pop p,a
	call 6type
	movei c,";
	tyo c
	movei c,40
	tyo c
	pop p,a
	call 6type
	movei c,40
	tyo c
	pop p,a
	call 6type
	jrst loop
] ;end ife $$pfn

ifn $$pfn,[

defop "F,op.F
op.F:	movei b,54.		;maximum size of filename including
	jsp a,grow		; the ^@ at the end.
	push p,d
	move d,obp(e)
	nextarg b
	call pfn
	move a,d
	pop p,d
	call nstr
	jrst loop

] ;end ifn $$pfn

ifn $$time,[

defop "Q,op.Q
op.Q:	movei b,35.
	jsp a,grow
	push p,d
	move d,obp(e)
	nextarg a
	tlnn e,%fmcol\%fmats
	 call datime
	tlne e,%fmcol
	 call time
	tlne e,%fmats
	 call date
	move a,d
	pop p,d
	call nstr
	jrst loop

] ;end ifn $$time

defop ^M,opcrlf
opcrlf:	tlne e,%fmats
	 call crlf
	sojl d,done
	ildb c,bp(e)
	caie c,^J		;flush linefeed if it is there
	 jrst nolf
	jumpl e,loop		;If colon set, we are done.
skpws1:	sojl d,done
	ildb c,bp(e)
skipws:	caie c,40
	 cain c,^I
	  jrst skpws1
	jrst xloop

nolf:	jumpge e,skipws		;If colon not set, skip white space.
	jrst xloop

ife $$pcode,[
defop "|,opvbar
opvbar:	movei c,^L
	tyo c
	sosg a,numarg(e)
	 jrst loop
	jrst op.%1
] ;end ife $$pcode

;;;~& is the same as ~% if you can't orient yourself:
ife $$pcode\$$itab\$$utab, defop "&,op.%

defop "%,op.%
op.%:	skipg a,numarg(e)
	 jrst loop
op.%1:	call crlf
	sojg a,op.%1
	jrst loop

ifn $$pcode,[
defop "|,opvbar
defop "&,opamper
opvbar:	skipa a,["C]
opampe:	 movei a,"A
opamp1:	nojust
	movei c,^P
	tyo c
	tyo a
ifn $$utab, setzm hpos(e)
	sosg a,numarg(e)
	 jrst loop
	jrst op.%1
] ;end ifn $$pcode

defop "<,oples
oples:	call dump
	tloe e,%fmjst\%fmbuf
	 call bdjust
	tlnn e,%fmnum
	 call bdop
	move b,numarg(e)
	jsp a,grow		;Make sure buffer is big enough.
oples3:	movei c,40
	hrl c,numarg(e)
	movem c,just(e)
	jrst loop

defop 73,opsemi			;"; (Emacs and Midas both give you grief if
				; you actually write a semicolon here...)
opsemi:	tlnn e,%fmjst
	 call bdop
	sojl d,eof
	ildb a,bp(e)
	tlnn e,%fmbuf		;buffer overflew, no justification.
	 jrst loop
	move c,bufsiz(e)
	sub c,bufct(e)
	jumpe c,opsmi1
	hlrz b,just(e)
	sub b,c
	jumple b,loop		;already no more room, no padding needed.
	hrl a,b
	movem a,just(e)
	call dump
	tlo e,%fmbuf
	jrst loop

opsmi1:	hrrm a,just(e)
	jrst loop

defop ">,opgrt
opgrt:	tlzn e,%fmjst
	 call bdop
	tlnn e,%fmbuf		;buffer overflew, no justification.
	 jrst loop
	move c,bufsiz(e)
	sub c,bufct(e)
	hlrz b,just(e)
	sub b,c
	jumple b,opgrt7		;no padding needed.
	move a,obp(e)
	push p,a
	push p,b
	hrrz c,just(e)
opgrt9:	idpb c,a
ifn $$utab, call pos
	sojg b,opgrt9
	pop p,b
	pop p,a
	call outstr
opgrt7:	call dump
	jrst loop

ifn $$itab,[

ife $$pcode,[
defop "&,opamper
opampe:	nojust
	call dump
	call getpos
	jumpn a,op.%
	sose numarg(e)
	 jrst op.%
	jrst loop
] ;end ife $$pcode

defop "T,op.T
op.T:	nojust
	tlnn e,%fmnum
	 call bdop
	call dump
	call getpos
	jumpl a,loop
	move b,numarg(e)
	camg b,a
	 jrst loop
	rot b,-3		;Only works for 8 character wide tabs.
	rot a,-3
	sub b,a
	hrrz a,b
	lsh b,-33.
	jumpe a,op.T2
	movei b,^I
op.T1:	tyo b
	sojg a,op.T1
	ldb b,[000300,,numarg(e)]
	jumpe b,loop
op.T2:	movei a,40
op.T3:	tyo a
	sojg b,op.T3
	jrst loop

] ;end ifn $$itab

ifn $$utab,[

%tyo:	idpb c,obp(e)
	sosg bufct(e)
	 jrst tyodmp
%tyo1:	tlne e,%fmbuf
	 return
pos:	tlze e,%fmcrl
	 jrst poscrl
posfoo:	cail c,40
	 cain c,177
	  jrst poscc
	aos hpos(e)
	return

tyodmp:	push p,c
	call dump
	pop p,c
	jrst %tyo1

poscrl:	caie c,^J
	 jrst posfoo
	setzm hpos(e)
	return

poscc:	cain c,^I
	 jrst postab
	cain c,^M
	 tloa e,%fmcrl
	  caie c,33
	   aos hpos(e)
	aos hpos(e)
	return

postab:	exch c,hpos(e)
	addi c,10		;Only works for 8 character wide tabs.
	andcmi c,7
	exch c,hpos(e)
	return

;;; still in ifn $$utab

ife $$pcode,[
defop "&,opamper
opampe:	nojust
	skipn hpos(e)
	 sose numarg(e)
	  jrst op.%
	jrst loop
] ;end ife $$pcode

defop "T,op.T
op.T:	nojust
	tlnn e,%fmnum
	 call bdop
	move b,numarg(e)
	move a,hpos(e)
	camg b,a
	 jrst loop
	rot b,-3
	rot a,-3
	sub b,a
	hrrz a,b
	lsh b,-33.
	jumpe a,op.T2
op.T1:	movei c,^I
	tyo c
	sojg a,op.T1
	ldb b,[000300,,numarg(e)]
	jumpe b,loop
op.T2:	movei c,40
	tyo c
	sojg b,op.T2
	jrst loop

] ;end ifn $$utab

;;;Make room in the buffer for B more characters.  Called by JSP A,GROW:
grow:	sub b,bufct(e)
	jumple b,(a)
	addi b,4
	idivi b,5		;B: how many words we need.
	movei c,5
	imul c,b		;C: how many characters that will add to
	addm c,bufsiz(e)	; the buffer.
	addm c,bufct(e)
	push p,[ascii "_____"]
	sojg b,.-1
	jrst (a)

;;;Empty the buffer.
dump:	push p,b
	move b,bufsiz(e)
	move c,b
	exch c,bufct(e)
	sub b,c
	jumpe b,dump3
	push p,a
	movei a,buffer(e)
	hrli a,440700
	movem a,obp(e)
ifn $$utab,[
	tlnn e,%fmbuf
	 jrst dump1
	push p,a
	push p,b
dump2:	ildb c,a
	call pos
	sojg b,dump2
	pop p,b
	pop p,a
] ;end ifn $$utab
dump1:	call outstr
	pop p,a
dump3:	tlz e,%fmbuf
	pop p,b
	return

;;;Outputs a crlf.
crlf:	movei c,^M
	tyo c
	movei c,^J
	tyo c
	return

;;;Types number in B in base A:
ntype:	jumpge b,ntype1
	movei c,"-
	tyo c
ntype1:	idiv b,a
	movm b,b
	movm c,c
ntype2:	addi c,"0
	caile c,"9
	 addi c,<"A-10.-"0>
	jumpe b,ntype3
	hrlm c,(p)
	idiv b,a
	call ntype2
	hlrz c,(p)
ntype3:	tyo c
	return

;;;Types the word in A in SIXBIT.  In lowercase if colon flag is set.
6type:	jumpe a,cpopj
6type1:	ldb c,[360600,,a]
	addi c,40
	tlne e,%fmcol
	 jrst 6type2
6type3:	tyo c
	lsh a,6
	jumpn a,6type1
cpopj:	return

6type2:	cail c,"A
	 caile c,"Z
	  jrst 6type3
	addi c,"a-"A
	jrst 6type3

ifn $$pfn\$$time,[
;;;Cleanup for the case where a string has been deposited in the buffer by
;;;someone other than ourselves.  New byte pointer is found in A.
nstr:	move c,a
	exch a,obp(e)
	skipge a
	 sub a,[430000,,1]	;In case A is 440700,,1 and B is 010700,,0
	sub c,a
	jumpe c,cpopj
	ldb b,[360600,,c]
	imuli c,5
	imuli b,55.
	lsh b,30.
	ash b,-30.
	subi b,(c)
	addm b,bufct(e)
ifn $$utab,[	;If we are tabbing, then we must update the HPOS
	tlne e,%fmbuf
	 return
nstr1:	ildb c,a
	call pos
	aojl b,nstr1
] ;end ifn $$utab
	return
] ;end ifn $$pfn\$$time

;;;Under construction:
;host printing
;flonum printing
;defop "?,opques	;Funcall escape.

nxop:	fmterr "Undefined format operator."

bdop:	fmterr "Bad call to format operator."
ife $$engl, englsh==:bdop

bdjust:	fmterr "Illegal format operation during justification."

eof:	fmterr "Format string terminated unexpectedly."

nxarg:	fmterr "Format ran out of arguments."

;define sizhac size
;printx /  (size!. words)
;/
;termin
;
;oradix==10
;radix 10.
;sizhac \.-format
;radix oradix

.end format