
	cmp	r0,$'*
	beq	3f
	inc	r1
4:
	cmp	r1,(sp)
	bhis	4f
	movb	(r1)+,r0
	sub	$'0,r0
	mpy	$10.,r3
	add	r0,r3
	br	4b
4:
	mov	r3,r0
	beq	3f
	mov	r0,holquo
	mov	(sp)+,r1
	movb	$'h,(r1)+
4:
	jsr	pc,get
	cmp	r0,$'\n
	bne	5f
	mov	r0,ch
	mov	$' ,r0
5:
	bis	$200,r0
	movb	r0,(r1)+
	cmp	r1,$eline-1
	bhis	err1
	dec	holquo
	bne	4b
	br	1b
3:
	mov	(sp)+,r1
	mov	$'h,r0
2:
	movb	r0,(r1)+
	cmp	r1,$eline-1
	blo	1b
err1:
	jsr	r5,error; 1.
1:
	clrb	(r1)+
	mov	(sp)+,r3
	tstb	line
	bne	1f
	jmp	getline
1:
	rts	r5

isagn:
	jsr	r5,levzer; '=
		br 1f
	br	3f
1:
	mov	r0,-(sp)
	jsr	r5,levzer; ',
		br 4f
	jsr	r5,levzer; '(
		br 1f
	tst	(sp)+
2:
	rts	r5
1:
	cmp	(sp)+,r0
	blt	2b
	mov	r1,-(sp)
	mov	r0,r1
	inc	r1
	jsr	r5,levzer; ')
		br 1f
1:
	mov	(sp)+,r1
	cmpb	1(r0),$'=
	bne	3f
	rts	r5

levzer:
	mov	r1,r0
	clr	-(sp)
1:
	tst	(sp)
	bne	2f
	cmpb	(r0),(r5)
	beq	1f
2:
	cmpb	(r0),$'(
	bne	2f
	inc	(sp)
2:
	cmpb	(r0),$')
	bne	2f
	dec	(sp)
	blt	5f
2:
	tstb	(r0)+
	bne	1b
5:
	tst	(r5)+
1:
4:
	tst	(sp)+
3:
	tst	(r5)+
	rts	r5

get:
	movb	ch,r0
	beq	1f
	clrb	ch
	rts	pc
1:
	jsr	pc,get1
	cmp	r0,$'\n
	bne	2f
	jsr	pc,get1
	cmp	r0,$'&
	beq	1b
	movb	r0,ch1
	mov	$'\n,r0
2:
	tst	holquo
	bne	1f
	cmp	$' ,r0
	beq	1b
	cmp	$'\t,r0
	beq	1b
1:
	cmp	r0,$4		/ test EOT
	bne	1f
	mov	$1,r0
	sys	write; mes; emes-mes
	mov	$1,r0		/ syntax errors detected
	sys	exit
1:
	rts	pc

get1:
	movb	ch1,r0
	beq	1f
	clrb	ch1
	br	2f
1:
	jsr	r5,getc; ibuf
	bcs	1f
	bic	$!177,r0
	beq	1b
	cmp	r0,$'\n
	bne	2f
	inc	lino
2:
	tst	nlflg
	beq	2f
	clr	nlflg
	cmp	r0,$'c
	bne	2f
3:
	jsr	pc,get1
	cmp	r0,$'\n
	beq	1b
	cmp	r0,$4
	bne	3b
2:
	cmp	r0,$'\n
	bne	2f
	inc	nlflg
2:
	rts	pc
1:
	mov	$4,r0
	rts	pc

.data
nlflg:	1
.text
mes:
	<EOF on input\n\0>
emes:
.bss
lino:	.=.+2
	beq	1b
1:
	cmp	r0,$4		/ test EOT
	bne	1f
	mov	$1,r0
	sys	write; mes; emes-mes
	mov	$1,r0		/ syntax errors detected
	sys	exit
1:
	rts	pc

get1:
	movb	ch1,r0
	beq	1f
	clrb	ch1
	br	2f
1:
	jsr	r5,getc; ibuf
	bcs	1f
	bic	$!177,r0
	beq	1b
	cmp	r0,$'\n
	bne	2f
	inc	lino
2:
	tst	nlflg
	beq	2f
	clr	nlflg
	cmp	r0,$'c
	bne	2f
3:
	jsr	pc,get1
	cmp	r0,$'\n
	/
/

/ fx9 -- code

/	jsr	r5,code; <string\0>; .even
/		arg1
/		arg2
/		...
/
/ args specified by %<c> in string.
/   %s:  string
/   %d:  decimal number
/   %o:  octal number
/   %c:  character
/
/ args are addresses
/ or registers r0-r4

.globl	code

.globl	putc
.globl	getname

code:
	mov	r4,-(sp)
	mov	r3,-(sp)
	mov	r2,-(sp)
	mov	r1,-(sp)
	mov	r0,-(sp)
	mov	r5,r4
1:
	tstb	(r5)+
	bne	1b
	inc	r5
	bic	$1,r5
1:
	movb	(r4)+,r0
	beq	1f
	cmp	r0,$'%
	beq	2f
	jsr	r5,putc; obuf
	br	1b
2:
	movb	(r4)+,r0
	beq	1f
	cmp	r0,$'s
	beq	cstr
	cmp	r0,$'c
	beq	cchr
	cmp	r0,$'d
	beq	cdec
	cmp	r0,$'o
	beq	coct
	cmp	r0,$'n
	beq	cnam
	jsr	r5,putc; obuf
	br	1b
cnam:
	jsr	pc,cget
	mov	r1,r3
	jsr	r5,getname
	mov	$symbuf,r1
	br	2f
cstr:
	jsr	pc,cget
2:
	movb	(r1)+,r0
	beq	1b
	cmp	r0,$'\n
	beq	2b
	jsr	r5,putc; obuf
	br	2b
cchr:
	jsr	pc,cget
	mov	r1,r0
	jsr	r5,putc; obuf
	mov	r1,r0
	clrb	r0
	swab	r0
	beq	1b
	jsr	r5,putc; obuf
	br	1b
coct:
	jsr	pc,cget
	mov	$8.,r2
	br	2f
cdec:
	jsr	pc,cget
	mov	$10.,r2
2:
	jsr	pc,2f
	br	1b
2:
	clr	r0
	dvd	r2,r0
	mov	r1,-(sp)
	mov	r0,r1
	beq	2f
	jsr	pc,2b
2:
	mov	(sp)+,r0
	add	$'0,r0
	jsr	r5,putc; obuf
	rts	pc
1:
	mov	(sp)+,r0
	mov	(sp)+,r1
	mov	(sp)+,r2
	mov	(sp)+,r3
	mov	(sp)+,r4
	rts	r5

cget:
	mov	(r5)+,r1
	cmp	r1,$4
	blos	1f
	rts	pc
1:
	asl	r1
	add	$2,r1
	add	sp,r1
	mov	(r1),r1
	rts	pc

b
cchr:
	jsr	pc,cget
	mov	r1,r0
	jsr	r5,putc; obuf
	mov	r1,r0
	clrb	r0
	swab	r0
	beq	1b
	jsr	r5,putc; obuf
	br	1b
coct:
	jsr	pc,cget
	mov	$8.,r2
	br	2f
cdec:
	jsr	pc,cget
	mov	$10.,r2
2:
	jsr	pc,2f
	br	1b
2:
	clr	r0
	dvd	/
/

/ fxa -- genop -- output a typed operator

.globl	genop
.globl	newline


.globl	code
.globl	typ
.globl	error

genop:
	mov	r1,-(sp)
	mov	r3,-(sp)
	bic	$!7,r3
	movb	typ(r3),r1
	cmpb	r1,$'u
	bne	1f
	jsr	r5,error; 34.
1:
	mov	(sp),r3
	clrb	r3
	swab	r3
	jsr	r5,code
		<	%c%c%d\0>; .even
		r1
		r0
		r3
	mov	(sp)+,r3
	mov	(sp)+,r1
	rts	r5

newline:
	jsr	r5,code
		<\n\0>; .even
	rts	r5

typ:
	<?irlc?ug>


coct:
	jsr	pc,cget
	mov	$8.,r2
	br	2f
cdec:
	jsr	pc,cget
	mov	$10.,r2
2:
	jsr	pc,2f
	br	1b
2:
	clr	r0
	dvd	/
/

/ fxb -- get integer constant or label

.globl	geticon
.globl	getlab

.globl	getsym
.globl	geti
.globl	ptemp

geticon:
	jsr	r5,getsym
	cmp	r0,$2
	bne	1f
	cmp	r3,$intcon
	bne	1f
	jsr	r5,geti
	tst	(r5)+
1:
	rts	r5

getlab:
	jsr	r5,geticon
		br 1f
	mov	r0,temp
	jsr	r5,ptemp; 'r; temp; line
	tst	(r5)+
1:
	rts	r5

	mov	(sp)+,r1
	rts	r5

newline:
	jsr	r5,code
		<\n\0>; .even
	rts	r5

typ:
	<?irlc?ug>


coct:
	jsr	pc,cget
	mov	$8.,r2
	br	2f
cdec:
	jsr	pc,cget
	mov	$10.,r2
2:
	jsr	pc,2f
	br	1b
2:
	clr	r0
	dvd	/
/

/ fxc -- size of array

.globl	size
.globl	nelem

.globl	error

size:
	movb	symtab+1(r3),r0
	jsr	r5,nelem
	inc	r0
	bic	$1,r0		/ round to 0 mod 2
	rts	r5

nelem:
	mov	r1,-(sp)
	mov	r0,r1
	mov	symtab(r3),r0
	bic	$!70,r0
	cmp	r0,$20
	bne	1f
	mov	symtab+2(r3),r0
	mov	(r0)+,-(sp)
2:
	mpy	(r0)+,r1
	dec	(sp)
	bgt	2b
	tst	(sp)+
1:
	mov	r1,r0
	mov	(sp)+,r1
	rts	r5

\n\0>; .even
	rts	r5

typ:
	<?irlc?ug>


coct:
	jsr	pc,cget
	mov	$8.,r2
	br	2f
cdec:
	jsr	pc,cget
	mov	$10.,r2
2:
	jsr	pc,2f
	br	1b
2:
	clr	r0
	dvd	/
/

/ xd -- tmp file 2 handl

.globl	setln
.globl	getln

.globl	tfil2
.globl	tfildiag
.globl	fopen
.globl	getc
.globl	getw
.globl	xbuf

setln:
	mov	$tfil2,r0
	jsr	r5,fopen; xbuf
	bcc	1f
	jmp	tfildiag
1:
	rts	r5

getln:
	jsr	r5,getc; xbuf
	bcs	3f
	mov	r0,-(sp)
	jsr	r5,getw; xbuf
	mov	r0,efno
	jsr	r5, getw; xbuf
	mov	r0,ifno
	mov	$line,r1
1:
	jsr	r5,getc; xbuf
	bcs	1f
	tst	r0
	beq	1f
	bic	$200,r0
	movb	r0,(r1)+
	br	1b
1:
	clrb	(r1)+
	mov	(sp)+,r0
	tst	(r5)+
	rts	r5
3:
	mov	xbuf,r0
	sys	close
	rts	r5

0
	dvd	/
/

/ xe -- temp file junk

.globl	tfildiag
.globl	tfil1, tfil2

tfildiag:
	mov	$1,r0
	sys	write; mes1; emes1-mes1
	clr	r0
	sys	seek; 0; 2
	mov	$-1,r0		/ failure return
	sys	exit

mes1:
	<Temp file?\n>
emes1:
tfil1:
	<f.tmp1\0>
tfil2:
	<f.tmp2\0>

ov	r0,-(sp)
	jsr	r5,getw; xbuf
	mov	r0,efno
	jsr	r5, getw; xbuf
	mov	r0,ifno
	mov	$line,r1
1:
	jsr	r5,getc; xbuf
	bcs	1f
	tst	r0
	beq	1f
	bic	$200,r0
	movb	r0,(r1)+
	br	1b
1:
	clrb	(r1)+
	mov	(sp)+,r0
	tst	(r5)+
	rts	r5
3:
	mov	xbuf,r0
	sys	close
	rts	r5

0
	dvd	/
/

/ fxf -- format statements

.globl	sform
.globl	sdata

.globl	ptemp
.globl	error

sform:
	cmp	progt,$6		/ block data
	bne	1f
	jsr	r5,error; 50.
1:
	jsr	r5,ptemp; 'f; efno; line
	rts	r5

sdata:
	jsr	r5,ptemp; 'd; efno; line
	rts	r5

<f.tmp2\0>

ov	r0,-(sp)
	jsr	r5,getw; xbuf
	mov	r0,efno
	jsr	r5, getw; xbuf
	mov	r0,ifno
	mov	$line,r1
1:
	jsr	r5,getc; xbuf
	bcs	1f
	tst	r0
	beq	1f
	bic	$200,r0
	movb	r0,(r1)+
	br	1b
1:
	clrb	(r1)+
	mov	(sp)+,r0
	tst	(r5)+
	rts	r5
3:
	mov	xbuf,r0
	sys	close
	rts	r5

0
	dvd	/
/

/ fxg -- declare implicit functions

.globl	funimpl

.globl	getname
.globl	lookup

funimpl:
	bit	$7,symtab(r3)
	bne	1f
	jsr	r5,getname
	mov	r2,-(sp)
	mov	$symbuf,r2
	jsr	r5,lookup; funtab
		br 2f
	cmpb	(r2),$'\n
	bne	2f
	asr	r0
	movb	funtabt(r0),r0
	mov	r0,-(sp)
	bic	$!17,r0
	bis	typtab(r0),symtab(r3)
	mov	(sp)+,r0
	asr	r0
	asr	r0
	asr	r0
	asr	r0
	bic	$!17,r0
	mov	typtab(r0),symtab+2(r3)	/ save argument conversion
2:					/ in dimension pointer
	mov	(sp)+,r2
1:
	rts	r5

typtab:
	intcon
	realcon
	dblcon
	cplxcon
	dcplxcon

funtab:
	<tanh\0>
	<sqrt\0>
	<sngl\0>
	<sin\0>
	<sign\0>
	<real\0>
	<mod\0>
	<min1\0>
	<min0\0>
	<max1\0>
	<max0\0>
	<isign\0>
	<int\0>
	<ifix\0>
	<idint\0>
	<idim\0>
	<iabs\0>
	<float\0>
	<exp\0>
	<dsqrt\0>
	<dsin\0>
	<dsign\0>
	<dreal\0>
	<dmod\0>
	<dmin1\0>
	<dmax1\0>
	<dlog10\0>
	<dlog\0>
	<dimag\0>
	<dim\0>
	<dexp\0>
	<dcsqrt\0>
	<dcsin\0>
	<dcos\0>
	<dconjg\0>
	<dcmplx\0>
	<dclog\0>
	<dcexp\0>
	<dccos\0>
	<dcabs\0>
	<dble\0>
	<datan2\0>
	<datan\0>
	<dabs\0>
	<csqrt\0>
	<csin\0>
	<cos\0>
	<conjg\0>
	<cmplx\0>
	<clog\0>
	<cexp\0>
	<ccos\0>
	<cabs\0>
	<atan2\0>
	<atan\0>
	<amod\0>
	<amin1\0>
	<amin0\0>
	<amax1\0>
	<amax0\0>
	<alog10\0>
	<alog\0>
	<aint\0>
	<aimag\0>
	<abs\0>
	<\0>

/ function type xy
/	x = arg types
/	y = result type
/ 0 = integer
/ 2 = real
/ 4 = double
/ 6 = complex
/ 8 = doublecomplex
funtabt:
	.byte	2\<4+2		/ tanh
	.byte	2\<4+2		/ sqrt
	.byte	4\<4+2		/ sngl
	.byte	2\<4+2		/ sin
	.byte	2\<4+2		/ sign
	.byte	6\<4+2		/ real
	.byte	0\<4+0		/ mod
	.byte	2\<4+0		/ min1
	.byte	0\<4+0		/ min0
	.byte	2\<4+0		/ max1
	.byte	0\<4+0		/ max0
	.byte	0\<4+0		/ isign
	.byte	2\<4+0		/ int
	.byte	2\<4+0		/ ifix
	.byte	4\<4+0		/ idint
	.byte	0\<4+0		/ idim
	.byte	0\<4+0		/ iabs
	.byte	0\<4+2		/ float
	.byte	2\<4+2		/ exp
	.byte	4\<4+4		/ dsqrt
	.byte	4\<4+4		/ dsin
	.byte	4\<4+4		/ dsign
	.byte	8\<4+4		/ dreal
	.byte	4\<4+4		/ dmod
	.byte	4\<4+4		/ dmin1
	.byte	4\<4+4		/ dmax1
	.byte	4\<4+4		/ dlog10
	.byte	4\<4+4		/ dlog
	.byte	8\<4+4		/ dimag
	.byte	2\<4+2		/ dim
	.byte	4\<4+4		/ dexp
	.byte	8\<4+8		/ dcsqrt
	.byte	8\<4+8		/ dcsin
	.byte	4\<4+4		/ dcos
	.byte	8\<4+8		/ dconjg
	.byte	4\<4+8		/ dcmplx
	.byte	8\<4+8		/ dclog
	.byte	8\<4+8		/ dcexp
	.byte	8\<4+8		/ dccos
	.byte	8\<4+4		/ dcabs
	.byte	2\<4+4		/ dble
	.byte	4\<4+4		/ datan2
	.byte	4\<4+4		/ datan
	.byte	4\<4+4		/ dabs
	.byte	6\<4+6		/ csqrt
	.byte	6\<4+6		/ csin
	.byte	2\<4+2		/ cos
	.byte	6\<4+6		/ conjg
	.byte	2\<4+6		/ cmplx
	.byte	6\<4+6		/ clog
	.byte	6\<4+6		/ cexp
	.byte	6\<4+6		/ ccos
	.byte	6\<4+2		/ cabs
	.byte	2\<4+2		/ atan2
	.byte	2\<4+2		/ atan
	.byte	2\<4+2		/ amod
	.byte	2\<4+2		/ amin1
	.byte	0\<4+2		/ amin0
	.byte	2\<4+2		/ amax1
	.byte	0\<4+2		/ amax0
	.byte	2\<4+2		/ alog10
	.byte	2\<4+2		/ alog
	.byte	2\<4+2		/ aint
	.byte	6\<4+2		/ aimag
	.byte	2\<4+2		/ abs
te	4\<4+4		/ datan
	.byte	4\<4+4		/ dabs
	.byte	6\<4+6		/ csqrt
	.byte	6\<4+6		/ csin
	.byte	2\<4+2		/ cos
	.byte	6\<4+6		/ conjg
	.byte	2\<4+6		/ cmplx
	.byte	6\<4+6		/ clog
	.byte	6\<4+6		/ cexp
	.byte	6\<4+6		/ ccos
	.byte	6\<4+2		/ cabs
	.byte	2\<4+/
/

/ fxh -- array constant offset

.globl	consub

.globl	getsym
.globl	geti
.globl	error
.globl	geticon

/ turn constant subscripts into offset.
/	in: r3 -> symtab
/	    r1 -> just beyond (
/	out:r0 has offset

consub:
	mov	symtab(r3),r0
	bic	$!70,r0
	cmp	r0,$20		/ test class == array
	beq	1f
	jsr	r5,error; 17.
	clr	r0
	rts	r5
1:
	mov	r5,-(sp)
	mov	r4,-(sp)
	mov	r3,-(sp)
	mov	r2,-(sp)
	clr	r4		/ accumulated offset
	mov	symtab+2(r3),r2	/ ptr to declarator
	mov	(r2)+,-(sp)	/ dimensionality
	mov	$1,r5		/ prod of declarators
1:
	jsr	r5,geticon
		br 9f
	cmp	r0,(r2)
	bgt	3f
	dec	r0
	bge	2f
3:
	jsr	r5,error; 19.	/ out of range
	clr	r0
2:
	mov	r5,-(sp)
	mpy	r0,r5
	add	r5,r4
	mov	(sp)+,r5
	mpy	(r2)+,r5
	jsr	r5,getsym
	cmp	r0,$36.		/ comma
	bne	1f
	dec	(sp)
	bgt	1b
	jsr	r5,error; 18.	/ wrong subscript count
	br	1b
1:
	cmp	r0,$34.		/ )
	beq	1f
9:
	jsr	r5,error; 20.
	clr	r0
1:
	cmp	(sp)+,$1
	beq	1f
	jsr	r5,error; 18.	/ subscript count
1:
	mov	(sp)+,r2
	mov	(sp)+,r3
	movb	symtab+1(r3),r5
	mpy	r4,r5
	mov	r5,r0
	mov	(sp)+,r4
	mov	(sp)+,r5
	rts	r5

,geticon
		br 9f
	cmp	r0,(r2)
	bgt	3f
	dec	r0
	bge	2f
3:
	jsr	r5,error; 19.	/ out of range
	clr	r0
2:
	mov	r5,-(sp)
	mpy	r0,r5
	add	r5,r4
	mov	(sp)+,r5
	mpy	(r2)+,r5
	jsr	r5,getsym
	cmp	r0,$36.		/ comma
	bne	1f
	dec	(sp)
	bgt	1b
	jsr	r5,error; 18.	/ wrong subscript count
	br	1b
1:
	cmp	r0,$34.		/ )
	beq	1f
9:
	jsr	r5,error; 20.
	clr	r0
1:
	cmp	(sp)+,$1
	beq	1f
	jsr	r5,error; 18.	/ subscript count
1:
	mov	(sp)+,r2
	mov	(sp)+,r3
	movb	symtab+1(r3),r5
	mpy	r4,r5
	mov	r5,r0
	mov	(sp)+/
/

/ quicker sort

/	mov	$base,r1
/	mov	$base+[n*width],r2
/	mov	$width,r3
/	jsr	pc,qsort

/	r0,r1,r2,r3,r4 are used

.globl	qsort
.globl	compare

qsort:
	mov	r5,-(sp)
	mov	r4,-(sp)
	bit	$1,r3
	bne	1f
	bit	$1,r1
	bne	1f
	cmp	r3,$2
	bne	2f
	mov	$exch1,exchange
	br	3f
2:
	mov	r3,r5
	clc
	ror	r5
	mov	r5,width
	mov	$exchw,exchange
	br	3f
1:
	mov	$exchb,exchange
3:
	jsr	pc,qs1
	mov	(sp)+,r4
	mov	(sp)+,r5
	rts	pc

qs1:
	mov	r1,r5
	neg	r5
	add	r2,r5
	bgt	1f
	rts	pc
1:
	clr	r4
	dvd	r3,r4
	asr	r4
	mpy	r3,r4
	mov	r5,r4
	add	r1,r4

	mov	r1,-(sp)
	mov	r2,-(sp)

loop:
	cmp	r1,r4
	bhis	loop1
	mov	r1,r0
	jsr	pc,compare
	bgt	loop1
	add	r3,r1
	br	loop

loop1:
	cmp	r2,r4
	blos	1f
	sub	r3,r2
	mov	r2,r0
	jsr	pc,compare
	bge	loop1

	jsr	pc,*exchange
	cmp	r1,r4
	bne	loop
	mov	r2,r4
	br	loop

1:
	cmp	r1,r4
	beq	1f
	jsr	pc,*exchange
	mov	r1,r4
	br	loop1

1:
	mov	(sp)+,r2
	mov	r4,-(sp)
	mov	r4,r1
	add	r3,r1
	mov	r2,r0
	sub	r1,r0
	sub	2(sp),r4
	cmp	r0,r4
	blo	1f
	mov	(sp)+,r0
	mov	(sp)+,r4
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r0,r2
	mov	r4,r1
1:
	jsr	pc,qs1
	mov	(sp)+,r2
	mov	(sp)+,r1
	br	qs1

exchb:
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,r5
1:
	movb	(r1),r0
	movb	(r2),(r1)+
	movb	r0,(r2)+
	sob	r5,1b
	mov	(sp)+,r2
	mov	(sp)+,r1
	rts	pc

exchw:
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	width,r5
1:
	mov	(r1),r0
	mov	(r2),(r1)+
	mov	r0,(r2)+
	sob	r5,1b
	mov	(sp)+,r2
	mov	(sp)+,r1
	rts	pc

exch1:
	mov	(r1),r0
	mov	(r2),(r1)
	mov	r0,(r2)
	rts	pc

.bss
exchange: .=.+2
width:	.=.+2
o	1f
	mov	(sp)+,r0
	mov	(sp)+,r4
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r0,r2
	mov/
/

/ fxx -- data segment definition

.data
.globl	holround
holround:	4

.bss

/ pass 1

.globl	dimu
dimu:	.=.+2

/ pass 2

.globl	eqvtab

/ pass 3 stuff

.globl	conu
.globl	dou
.globl	blockp
.globl	dotabp
.globl	dotab
.globl	edotab
.globl	functn
.globl	blocks

conu:	.=.+2
dou:	.=.+2
blockp:	.=.+2
dotabp:	.=.+2
dotab:	.=.+60.
edotab:
functn:	.=.+2

/ pass 4

.globl	negflg
.globl	repfact
.globl	contab
.globl	dattab

negflg:	.=.+2
repfact:.=.+2

/ general buffer

/ 2200. for fc1, 15000. for fc2.
xbufsiz	= 2200.

.globl	xbuf

xbuf:	.=.+xbufsiz

eqvtab	= xbuf+518.	/ for pass 2

blocks	= xbuf		/ for pass 3

dattab	= xbuf+518.	/ for pass 4
contab	= xbuf+xbufsiz

/ for all passes

data:
	ibuf:	.=.+518.
	obuf:	.=.+518.
	tbuf:	.=.+518.
	line:	.=.+linsize
	eline:	.=.+4
	ifno:	.=.+2
	efno:	.=.+2
	errp:	.=.+2	/ init(errb)
	errb:	.=.+12.
	eerrb:		/ size 0 mod 4
	symtab:	.=.+symsize
	esymtab:
	esymp:	.=.+2	/ init(esymtab)
	symtp:	.=.+2
	namebuf:.=.+namsize
	enamebuf:
	namep:	.=.+2	/ init(namebuf)
.=.+40	/fake
	.=.+1		/ make odd
	symbuf:	.=.+smblsize	/ init(<_>)
	esymbuf:
	ch:	.=.+1
	ch1:	.=.+1
	progt:	.=.+2
	holquo:	.=.+2
	nxtaloc:.=.+2
	imptab:	.=.+[26.*2*2]	/ 26 letters, 2 alphabets, 2 bytes
	nerror:	.=.+2
	temp:	.=.+2
	functm:	.=.+2
edata:
dsize	=.-data

ize
	eline:	.=.+4
	ifno:	.=.+2
	efno:	.=.+2
	errp:	.=.+2	/ init(errb)
	errb:	.=.+12.
	eerrb:		/ size 0 mod 4
	symtab:	.=.+symsize
	esymtab:
	esymp:	.=.+2	/ init(esymtab)
	symtp:	.=.+2
	namebuf:.=.+namsize
	enamebuf:
	namep:	.=.+2	/ init(namebuf)
.=.+40	/fake
	.=.+1		/ ma/
/

/ io1 --  I/O operators


.globl	rerr
.globl	endio
.globl	rio4
.globl	rio8
.globl	iio1
.globl	iio2
.globl	iio4
.globl	lio2
.globl	lio1
.globl	cio8
.globl	cio16
.globl	ecvt
.globl	fcvt
.globl	_ndigit

endio:
	mov	(sp)+,r5
	rts	r5

cio8:
	tst	slcnt
	bne	2f
	inc	slcnt
	tst	-(r4)
	br	rio4
2:
	clr	slcnt
	mov	ilval,-(sp)
	add	$4,(sp)
	br	rio4

cio16:
	tst	slcnt
	bne	2f
	inc	slcnt
	tst	-(r4)
	br	rio8
2:
	clr	slcnt
	mov	ilval,-(sp)
	add	$8,(sp)
	br	rio8

rio8:
	mov	$8.\<8+'r,r0
	br	1f

rio4:
	mov	$4\<8+'r,r0
	br	1f

iio4:
	mov	$4\<8+'i,r0
	br	1f

iio2:
	mov	$2\<8+'i,r0
	br	1f

lio2:
	mov	$2\<8+'l,r0
	br	1f

iio1:
	mov	$1\<8+'i,r0
	br	1f

lio1:
	mov	$1\<8+'l,r0

1:
	mov	r0,itype
	mov	(sp)+,ilval
	mov	(sp)+,r5
	tst	(r5)+
	rts	r5

r5
	rts	r5

cio8:
	tst	slcnt
	bne	2f
	inc	slcnt
	tst	-(r4)
	br	rio4
2:
	clr	slcnt
	mov	ilval,-(sp)
	add	$4,(sp)
	br	rio4

cio16:
	tst	slcnt
	bne	2f
	inc	slcnt
	tst	-(r4)
	br	rio8
2:
	clr	slcnt
	mov	ilval,-(sp)
	add	$8,(sp)
	br	rio8

rio8:
	mov	$8.\<8+'r,r0
	br	1f

rio4:
	mov	$4\<8+'r,r0
	/
/

/ io2 -- format cracker

.globl	iowf
.globl	iowp
.globl	iorf

iowp:
	mov	(sp)+,formp
	mov	$6,r1
	br	1f

iowf:
	mov	(sp)+,formp
	tst	(sp)+
	mov	(sp)+,r1
1:
	jsr	r5,setio; 2		/ write
	clr	rdflg
	br	1f

iorf:
	mov	(sp)+,formp
	tst	(sp)+
	mov	(sp)+,r1
	jsr	r5,setio; 1		/ read
	mov	pc,rdflg

1:
	clr	binflg
	clr	slcnt
	clr	itmfnd
	clr	scale
	clr	itmflg
	mov	$pbuf,ppar
	mov	$-1,llpcnt
	jsr	r5,fmtchr
	mov	formp,llp
	cmp	r0,$'(
	beq	crack
	jsr	r5,rerr; 106.
	sys	exit
crack:
	clr	ngflg
	mov	$1,rep
item:
	jsr	r5,fmtchr
	cmp	$' ,r0
	beq	item
	cmp	$'\t,r0
	beq	item
	jsr	r5,switch; mswitch
	jsr	r5,rerr; 105.
	sys	exit

mswitch:
	'a; afmt
	'f; ffmt
	'e; efmt
	'g; gfmt
	'd; dfmt
	'i; ifmt
	'l; lfmt
	'h; hfmt
	'x; xfmt
	'p; scal
	'-; minus
	'0; numb
	'1; numb
	'2; numb
	'3; numb
	'4; numb
	'5; numb
	'6; numb
	'7; numb
	'8; numb
	'9; numb
	',; crack
	'/; slash
	'(; lpar
	'); rpar
	'"; quote
	' ; item
	0; 0

minus:
	jsr	r5,gnum
	neg	r0
	br	1f
numb:
	dec	formp
	jsr	r5,gnum
1:
	mov	r0,rep
	br	item

scal:
	mov	rep,scale
	br	crack

elist:
	tst	_nocr
	beq	1f
	tst	rdflg
	bne	1f
	jsr	r5,eorec1
	br	2f
1:
	jsr	r5,eorec
2:
	jmp	*(r4)+

slash:
	jsr	r5,eorec
	br	crack

rpar:
	mov	ppar,r0
	cmp	r0,$pbuf		/ see if outer parens
	blos	2f
	dec	-2(r0)
	ble	1f		/ no repeats left
	mov	-4(r0),formp	/ reset scan
	br	crack
1:
	sub	$4,ppar
	br	crack		/ pop parens
2:
	jsr	r5,getitm
		br elist
	tst	itmfnd
	bne	1f
	jsr	r5,rerr; 107.
	sys	exit
1:
	jsr	r5,eorec
	inc	itmflg
	mov	llpcnt,r1
	bpl	1f
	mov	llp,formp
	jmp	crack
1:
	mov	llp,r2
	mov	r2,formp
	mov	ppar,r0
	mov	r2,(r0)+
	mov	r1,(r0)+
	mov	r0,ppar
	jbr	crack1

lpar:
	mov	ppar,r0
	cmp	r0,$pbuf+10
	blo	1f
	jsr	r5,rerr; 108.
	sys	exit
1:
	mov	formp,(r0)+
	mov	rep,(r0)+
	mov	r0,ppar
	cmp	r0,$pbuf+4
	bhi	1f
	mov	formp,llp
	mov	rep,llpcnt
1:
	jmp	crack
quote:
	inc	ngflg
	mov	$44,-(sp)
	br	3f

hfmt:
	inc	ngflg
	mov	$40,-(sp)
	br	3f

xfmt:
	inc	ngflg
	mov	$34,-(sp)
	br	3f

afmt:
	mov	$30,-(sp)
	br	1f

ifmt:
	clr	-(sp)
	br	1f

lfmt:
	mov	$4,-(sp)
1:
	jsr	r5,gnum
	mov	r0,width
	br	2f

ffmt:
	mov	$10,-(sp)
	br	1f

dfmt:
	mov	$14,-(sp)
	br	1f

gfmt:
	mov	$20,-(sp)
	br	1f

efmt:
	mov	$24,-(sp)

1:
	jsr	r5,gnum
	mov	r0,width
4:
	jsr	r5,fmtchr
	cmp	r0,$' /
	beq	4b
	cmp	r0,$'.
	bne	err1
	jsr	r5,gnum
	mov	r0,ndig
2:
	inc	itmfnd
3:
	add	$cvsw,(sp)
	tst	rdflg
	beq	1f
	add	$2,(sp)
1:
	mov	*(sp)+,-(sp)
1:
	tst	ngflg
	bne	2f
	jsr	r5,getitm
		br 1f
2:
	clr	gflg
	jsr	r5,*(sp)
	dec	rep
	bgt	1b
	tst	(sp)+
	br	crack1
1:
	tst	(sp)+
	jmp	elist

cvsw:
	iocv; iicv	/ 0
	locv; licv	/ 4
	focv; ficv	/ 10
	docv; dicv	/ 14
	gocv; gicv	/ 20
	eocv; eicv	/ 24
	aocv; aicv	/ 30
	xocv; xicv	/ 34
	hocv; hicv	/ 40
	qocv; qicv	/ 44

crack1:
	jmp	crack

err1:
	jsr	r5,rerr; 109.
	sys	exit


	beq	4b
	cmp	r0,$'.
	bne	err1
	jsr	r5,gnum
	mov	r0,ndig
2:
	inc	itmfnd
3:
	add	$cvsw,(sp)
	tst	rdflg
	beq	1f
	add	$2,(sp)
1:
	mov	*(sp)+,-(sp)
1:
	tst	ngflg
	bne	2f
	jsr	r5,getitm
		br 1f
2:
	clr	gflg
	jsr	r5,*(sp)
	dec	rep
	bgt	1b
	tst	(sp)+
	br	crack1
1:
	tst	(sp)+
	jmp	elist

cvsw:
	iocv; iicv	/ 0
	locv; licv	/ 4
	focv; ficv	/ 10
	docv; dicv	/ 14
	gocv; gicv	/ 20/
/

/ io3 --  Fortran I/O

.globl	getbuf
.globl	chkunit
.globl	creatf
.globl	openf

setio:
	mov	r1,unit
	jsr	r5,chkunit
	movb	utable(r1),r0
	beq	1f
	bpl	2f
	mov	r1,r0
	asl	r0
	mov	btable(r0),r0
	mov	r0,r2
	br	4f
2:
	cmp	(r5),r0
	beq	3f
	jsr	r5,rerr; 101.		/ inconsistent use of unit
	sys	exit
1:
	mov	r1,-(sp)
	clr	r0
	dvd	$10.,r0
	swab	r1
	bis	r1,r0
	add	$"00,r0
	mov	r0,filnam+4
	mov	(sp)+,r1
	jsr	r5,getbuf
	mov	$filnam,r0
4:
	movb	(r5),utable(r1)
	bit	$1,(r5)
	bne	2f
	jsr	r5,creatf
	br	3f
2:
	jsr	r5,openf
3:
	tst	(r5)+
	asl	r1
	mov	btable(r1),buffer
	rts	r5

getbuf:
	mov	$utable,r0
	mov	$btable,r2
1:
	tstb	(r0)+
	beq	2f
	tst	(r2)+
	br	3f
2:
	tst	(r2)+
	beq	3f
	mov	-(r2),r0
	clr	(r2)
	mov	r0,r2
	br	2f
3:
	cmp	r0,$utable+20.
	blo	1b
	mov	bufp,r2
	add	$134.,bufp
	mov	bufp,0f
	sys	break; 0:..
2:
	mov	r1,r0
	asl	r0
	mov	r2,btable(r0)
	mov	r2,buffer
	rts	r5

chkunit:
	cmp	r1,$20.
	blo	1f
	jsr	r5,rerr; 100.		/ illegal unit number
	sys	exit
1:
	rts	r5

creatf:
	cmp	unit,$6
	bne	2f
	mov	$1,r0
	br	1f
2:
	mov	r0,0f
	sys	creat; 0:..; 666
	bec	1f
	jsr	r5,rerr; 102.		/ create error
	sys	exit
1:
	mov	r2,-(sp)
	mov	r0,(r2)+
	clr	(r2)+
	clr	(r2)+
	mov	r2,-(r2)
	mov	(sp)+,r2
	rts	r5

openf:
	cmp	unit,$5
	bne	2f
	clr	r0
	br	1f
2:
	mov	r0,0f
	sys	open; 0:..; 0
	bec	1f
	jsr	r5,rerr; 103.		/ open error
	sys	exit
1:
	mov	r2,-(sp)
	mov	r0,(r2)+
	clr	(r2)+
	clr	(r2)+
	mov	(sp)+,r2
	rts	r5

fputc:
	mov	r1,-(sp)
	mov	buffer,r1
	dec	2(r1)
	bge	1f
	mov	r0,-(sp)
	jsr	pc,flush1
	dec	2(r1)
	mov	(sp)+,r0
1:
	movb	r0,*4(r1)
	inc	4(r1)
	mov	(sp)+,r1
	rts	r5

fflush:
	mov	r1,-(sp)
	mov	buffer,r1
	jsr	pc,flush1
	mov	(sp)+,r1
	rts	r5

flush1:
	mov	r1,r0
	add	$6,r0
	mov	r0,-(sp)
	mov	r0,0f
	neg	r0
	add	4(r1),r0
	bhis	1f
	mov	r0,0f+2
	mov	(r1),r0
	sys	write; 0:..; ..
1:
	mov	(sp)+,4(r1)
	mov	$128.,2(r1)
	rts	pc

fgetc:
	tst	nlflg
	bne	4f
	mov	r1,-(sp)
	mov	buffer,r1
	dec	2(r1)
	bge	1f
	mov	r1,r0
	add	$6,r0
	mov	r0,0f
	mov	r0,4(r1)
	mov	(r1),r0
	sys	read; 0:..; 128.
	bes	2f
	tst	r0
	bne	3f
2:
	jsr	r5,rerr; 104.		/ EOF on input
	sys	exit
3:
	dec	r0
	mov	r0,2(r1)
1:
	clr	r0
	bisb	*4(r1),r0
	inc	4(r1)
	mov	(sp)+,r1
	tst	binflg
	bne	1f
	cmp	r0,$'\n
	bne	1f
4:
	mov	pc,nlflg
	mov	$' ,r0
1:
	rts	r5

gnum:
	mov	r1,-(sp)
	clr	r1
1:
	jsr	r5,fmtchr
	cmp	r0,$'  /
	beq	1b
	sub	$'0,r0
	cmp	r0,$9.
	bhi	1f
	mpy	$10.,r1
	add	r0,r1
	br	1b
1:
	mov	r1,r0
	mov	(sp)+,r1
	dec	formp
	rts	r5

switch:
	mov	(r5)+,r1
1:
	tst	(r1)
	beq	1f
	cmp	r0,(r1)+
	bne	1b
	tst	(sp)+
	jmp	*(r1)
1:
	rts	r5

fmtchr:
	movb	*formp,r0
	inc	formp
	rts	r5

getitm:
	tst	itmflg
	bne	1f
	mov	r5,-(sp)
	jmp	*(r4)+
1:
	clr	itmflg
	tst	(r5)+
	rts	r5

/ just a fake, there's no carriage control

fputcc:
	cmp	$' ,r0
	bne	1f
	inc	nspace
	rts	r5
1:
	mov	r0,-(sp)
1:
	dec	nspace
	blt	1f
	mov	$' ,r0
	jsr	r5,fputc
	br	1b
1:
	clr	nspace
	mov	(sp)+,r0
	beq	1f
	jsr	r5,fputc
1:
	rts	r5

eorec:
	mov	unit,r0
	bitb	$1,utable(r0)
	bne	1f
	clr	nspace
	mov	$'\n,r0
	jsr	r5,fputc
eorec1:
	clr	r0
	jsr	r5,fputcc
/	cmp	unit,$6			/ tty output
/	bne	2f
	jsr	r5,fflush
2:
	rts	r5
1:
	tst	nlflg
	bne	1f
	jsr	r5,fgetc
	br	1b
1:
	clr	nlflg
	rts	r5

spaces:
	add	r1,nspace
	rts	r5

r5

/ just a fake, there's no carriage control

fputcc:
	cmp	$' ,r0
	bne	1f
	inc	nspace
	rts	r5
1:
	mov	r0,-(sp)
1:
	dec	nspace
	blt	1f
	mov	$' ,r0
	jsr	r5,fputc
	br	1b
1:
	clr	nspace
	mov	(sp)+,r0
	beq	1f
	jsr	r5,fputc
1:
	rts	r5

eorec:
	mov	unit,r0
	bitb	$1,utable(r0)
	bne	1f
	clr	nspace
	mov	$'\n,r0
	jsr	r5,fputc
eorec1:
	clr	r0
	jsr	r5,fputcc
/	cmp	unit,$6			/ tty output
/	bne	2f
	jsr	r5,fflush
2:
	rts	r5
1:
	tst	nlflg
	bne	1f
	jsr	r5,fgetc
	br	1b
1:
	clr	nlflg
	r/
/

/ io4 -- numeric output conversion

qicv:
hicv:
	tst	rep
	ble	1f
	jsr	r5,fgetc
	movb	r0,*formp
	inc	formp
	dec	rep
	bgt	hicv
1:
	rts	r5


xicv:
	jsr	r5,fgetc
	rts	r5

gocv:
	mov	pc,gflg
	jsr	r5,getarg
	mov	ndig,_ndigit
	jsr	pc,ecvt
	tst	r2
	bmi	eocv
	cmp	r2,ndig
	bgt	eocv
	mov	ndig,-(sp)
	sub	r2,ndig
	sub	$4,width
	jsr	r5,focv
	add	$4,width
	add	$4,nspace
	mov	(sp)+,ndig
	rts	r5

eocv:
	mov	$'e,-(sp)
	br	1f

docv:
	mov	$'d,-(sp)
1:
	tst	gflg
	bne	1f
	jsr	r5,getarg
1:
	mov	ndig,r1
	add	$6,r1
	add	nflg,r1
	sub	width,r1
	bge	2f
	sub	r1,nspace
2:
	tst	nflg
	beq	2f
	mov	$'-,r0
	jsr	r5,fputcc
2:
	mov	ndig,r1
	mov	scale,r0
	bgt	2f
	add	r0,r1
	br	3f
2:
	inc	r1
3:
	mov	r1,_ndigit
	jsr	pc,ecvt
	mov	r0,r1
	mov	r2,-(sp)
	mov	scale,r2
	sub	r2,(sp)
	tst	r2
	bgt	2f
	mov	$'0,r0
	jsr	r5,fputcc
	br	3f
2:
	movb	(r1)+,r0
	dec	_ndigit
	jsr	r5,fputcc
	sob	r2,2b
3:
	mov	$'.,r0
	jsr	r5,fputcc
	neg	r2
	ble	2f
3:
	mov	$'0,r0
	jsr	r5,fputcc
	sob	r2,3b
2:
	mov	_ndigit,r2
	ble	2f
3:
	movb	(r1)+,r0
	jsr	r5,fputcc
	sob	r2,3b
2:
	mov	2(sp),r0
	jsr	r5,fputcc
	mov	(sp)+,r1
	bge	2f
	mov	$'-,r0
	jsr	r5,fputcc
	neg	r1
	br	3f
2:
	mov	$'+,r0
	jsr	r5,fputcc
3:
	clr	r0
	div	$10.,r0
	add	$'0,r0
	jsr	r5,fputcc
	mov	r1,r0
	add	$'0,r0
	jsr	r5,fputcc
	tst	(sp)+
	rts	r5

iocv:
	clr	-(sp)
	clr	ndig
	br	1f

focv:
	mov	$1,-(sp)
1:
	clr	-(sp)
	tst	gflg
	bne	1f
	jsr	r5,getarg
	tst	2(sp)
	beq	1f
	mov	scale,(sp)
1:
	mov	ndig,_ndigit
	add	(sp)+,_ndigit
	jsr	pc,fcvt
	mov	r0,r1
	tst	(sp)
	beq	1f
	tst	gflg
	bne	1f
	add	scale,r2
1:
	mov	ndig,r0
	add	(sp),r0
	add	nflg,r0
	tst	r2
	ble	1f
	add	r2,r0
1:
	sub	width,r0
	bge	1f
	sub	r0,nspace
1:
	tst	nflg
	beq	1f
	mov	$'-,r0
	jsr	r5,fputcc
1:
	tst	r2
	ble	2f
1:
	movb	(r1)+,r0
	jsr	r5,fputcc
	sob	r2,1b
2:
	tst	(sp)+
	beq	1f
	mov	$'.,r0
	jsr	r5,fputcc
1:
	mov	ndig,-(sp)
	ble	1f
	tst	r2
	bge	1f
	neg	r2
2:
	mov	$'0,r0
	jsr	r5,fputcc
	dec	ndig
	ble	1f
	sob	r2,2b
1:
	mov	ndig,r2
	ble	2f
1:
	movb	(r1)+,r0
	jsr	r5,fputcc
	sob	r2,1b
2:
	mov	(sp)+,ndig
	rts	r5

getarg:
	clr	nflg
	setd
	cmpb	itype,$'r
	beq	1f
	seti
	cmpb	ilen,$4
	bne	2f
	setl
2:
	cmpb	ilen,$1
	beq	3f
	movif	*ilval,r0
	br	2f
3:
	movb	*ilval,r0
	movif	r0,fr0
	br	2f
1:
	cmpb	ilen,$4
	bne	1f
	movof	*ilval,r0
	br	2f
1:
	movf	*ilval,r0
2:
	cfcc
	bge	1f
	absf	r0
	mov	$1,nflg
1:
	rts	r5


	jsr	r5,fputcc
1:
	mov	ndig,-(sp)
	ble	1f
	tst	r2
	bge	1f
	neg	r2
2:
	mov	$'0,r0
	jsr	r5,fputcc
	dec	ndig
	ble	1f
	sob	r2,2b
1:
	mov	ndig,r2
	ble	2f
1:
	movb	(r1)+,r0
	jsr	r5,fputcc
	sob	r2,1b
2:
	mov	(sp)+,ndig
	rts	r5

getarg:
	clr	nflg
	setd
	cmpb	itype,$'r
	beq	1f
	seti
	cmpb	ilen,$4
	bne/
/

/ io5 -- more conversions

/.globl	hocv
/.globl	qocv
/.globl	xocv
/.globl	aocv
/.globl	locv
/
/.globl	fmtchr
/.globl	fputcc
/.globl	rep
/.globl	formp
/.globl	spaces
/.globl	ilen
/.globl	width
/.globl	ilval
.globl	rerr

hocv:
	jsr	r5,fmtchr
	tst	r0
	beq	2f
	jsr	r5,fputcc
	dec	rep
	bgt	hocv
	rts	r5
2:
	jsr	r5,rerr; 111.
	sys	exit

qocv:
	mov	formp,-(sp)
1:
	jsr	r5,fmtchr
	tst	r0
	beq	2f
	cmp	r0,$'"
	beq	2f
	jsr	r5,fputcc
	br	1b
2:
	dec	rep
	ble	1f
	mov	(sp),formp
	br	1b
1:
	tst	(sp)+
	rts	r5

xocv:
	mov	$1,r1
	jsr	r5,spaces
	rts	r5

aocv:
	movb	ilen,r1
	sub	width,r1
	neg	r1
	bpl	1f
	clr	r1
1:
	jsr	r5,spaces
	mov	ilval,r2
	mov	width,r1
	cmpb	r1,ilen
	ble	2f
	movb	ilen,r1
2:
	movb	(r2)+,r0
	jsr	r5,fputcc
	dec	r1
	bgt	2b
	rts	r5

locv:
	mov	width,r1
	dec	r1
	jsr	r5,spaces
	mov	$'f,r0
	movb	ilen,r1
	mov	ilval,r2
2:
	tstb	(r2)+
	bne	1f
	dec	r1
	bgt	2b
	br	2f
1:
	mov	$'t,r0
2:
	jsr	r5,fputcc
	rts	r5

0,$'"
	beq	2f
	jsr	r5,fputcc
	br	1b
2:
	dec	rep
	ble	1f
	mov	(sp),formp
	br	1b
1:
	tst	(sp)+
	rts	r5

xocv:
	mov	/
/

/ io6 --  input conversions

/.globl	aicv
/.globl	gicv
/
/.globl	ilval
/.globl	width
/.globl	ilen
/.globl	fgetc
/.globl	itype
/.globl	nlflg
/.globl	gcflg

aicv:
	mov	ilval,r1
	movb	width,r2
	movb	ilen,r0
	mov	r0,-(sp)
1:
	cmp	r2,(sp)
	ble	1f
	jsr	r5,fgetc
	dec	r2
	br	1b
1:
	tst	r2
	ble	1f
	jsr	r5,fgetc
	movb	r0,(r1)+
	dec	r2
	dec	(sp)
	br	1b
1:
	tst	(sp)
	ble	1f
	movb	$' ,(r1)+
	dec	(sp)
	br	1b
1:
	tst	(sp)+
	rts	r5

licv:
	mov	width,twidth
	setd
	seti
	clrf	fr0
1:
	jsr	r5,fgetcn
	cmp	r0,$'t
	beq	2f
	cmp	r0,$'T
	beq	2f
	cmp	r0,$'1
	beq	2f
	cmp	r0,$',
	beq	1f
	br	1b
2:
	movif	$1,fr0
	br	1b
1:
	br	storin

iicv:
	clr	ndig
	clr	iscale
	br	1f

ficv:
eicv:
dicv:
	mov	scale,iscale
1:
	mov	width,twidth
	br	1f

gicv:
	tst	width
	bgt	ficv
	mov	$16383.,twidth
	clr	ndig
	mov	pc,gcflg
	mov	scale,iscale
	br	2f
1:
	clr	gcflg
2:
	jsr	r5,gatof
storin:
	cmpb	itype,$'r
	beq	1f
	cmpb	ilen,$1
	beq	3f
	cmpb	ilen,$4
	bne	2f
	setl
2:
	movfi	fr0,*ilval
	rts	r5
3:
	movfi	fr0,r0
	movb	r0,*ilval
	rts	r5
1:
	cmpb	ilen,$8.
	beq	2f
	setf
2:
	movf	fr0,*ilval
	rts	r5

gatof:
	setd
	seti
	movif	$10.,fr3
	clr	r2
	clrf	fr0
	clr	-(sp)
1:
	jsr	r5,fgetcn
	cmp	$' ,r0
	bne	1f
	tst	nlflg
	beq	1b
	tst	(sp)+
	rts	r5
1:
	cmp	r0,$'+
	beq	1f
	cmp	r0,$'-
	bne	2f
	inc	(sp)
1:
	jsr	r5,fgetcn
2:
	cmp	$' ,r0
	bne	3f
	tst	gcflg
	bne	3f
	mov	$'0,r0
3:
	sub	$'0,r0
	cmp	r0,$9.
	bhi	2f
	mulf	fr3,fr0
	movif	r0,fr1
	addf	fr1,fr0
	dec	r1
	br	1b
2:
	add	$'0,r0
	cmp	r0,$'.
	bne	1f
	inc	r2
	clr	r1
	br	1b
1:
	mov	r3,-(sp)
	clr	r3
	cmp	r0,$'d
	beq	3f
	cmp	r0,$'+
	beq	3f
	cmp	r0,$'-
	beq	3f
	cmp	r0,$'e
	bne	2f
3:
	clr	iscale
	jsr	r5,atoi
2:
	tst	r2
	bne	1f
	mov	ndig,r1
	neg	r1
1:
	movf	fr3,fr2
	add	r3,r1
	sub	iscale,r1
	mov	(sp)+,r3
	tst	r1
	beq	1f
	bpl	3f
	neg	r1
	mov	pc,-(sp)
	br	2f
3:
	clr	-(sp)
2:
	dec	r1
	ble	2f
	mulf	fr3,fr2
	br	2b
2:
	tst	(sp)+
	bne	2f
	mulf	fr2,fr0
	br	1f
2:
	divf	fr2,fr0
1:
	tst	(sp)+
	beq	1f
	negf	r0
1:
	cmp	r0,$',
	beq	1f
	cmp	$' ,r0
	beq	1f
	jsr	r5,rerr; 110.
1:
	rts	r5

atoi:
	clr	-(sp)
	cmp	r0,$'+
	beq	1f
	cmp	r0,$'-
	beq	3f
	jsr	r5,fgetcn
	cmp	r0,$'+
	beq	1f
	cmp	r0,$'-
	bne	2f
3:
	inc	(sp)
1:
	jsr	r5,fgetcn
2:
	sub	$'0,r0
	cmp	r0,$'9.
	bhi	2f
	mpy	$10.,r3
	add	r0,r3
	br	1b
2:
	add	$'0,r0
	tst	(sp)+
	beq	1f
	neg	r3
1:
	rts	r5

fgetcn:
	tst	twidth
	bgt	1f
	mov	$',,r0
	rts	r5
1:
	jsr	r5,fgetc
	dec	twidth
	rts	r5

	tst	(sp)+
	bne	2f
	mulf	fr2,fr0
	br	1f
2:
	divf	fr2,fr0
1:
	tst	(sp)+
	beq	1f
	negf	r0
1:
	cmp	r0,$',
	beq	1f
	cmp	$' ,r0
	beq	1f
	jsr	r5,rerr; 110.
1:
	rts	r5

atoi:
	clr	-(sp)
	cmp	r0,$'+
	beq	1f
	cmp	r0,$'-
	beq	3f
	jsr	r5,fgetcn
	c/
/

/ Fortran binary I/O

.globl	iowu
.globl	ioru
.globl	rewi
.globl	enfl

iowu:
	tst	(sp)+
	mov	(sp)+,r1		/ unit number
	jsr	r5,setio; 42
1:
	jsr	r5,getitm
		br 1f
	movb	ilen,r1
	mov	ilval,r2
2:
	movb	(r2)+,r0
	jsr	r5,fputc
	sob	r1,2b
	br	1b
1:
	jsr	r5,fflush
	jmp	*(r4)+

ioru:
	tst	(sp)+
	mov	(sp)+,r1		/ unit number
	jsr	r5,setio; 41
	clr	nlflg
	mov	pc,binflg
1:
	jsr	r5,getitm
		br 1f
	movb	ilen,r1
	mov	ilval,r2
2:
	jsr	r5,fgetc
	movb	r0,(r2)+
	sob	r1,2b
	br	1b
1:
	jmp	*(r4)+

rewi:
enfl:
	tst	(sp)+
	mov	(sp)+,r1		/ unit number
	jsr	r5,chkunit
	clrb	utable(r1)
	asl	r1
	mov	*btable(r1),r0
	cmp	r0,$1
	bhi	1f
	sys	seek; 0; 0
	jmp	*(r4)+
1:
	sys	close
	jmp	*(r4)+
	br 1f
	movb	ilen,r1
	mov	ilval,r2
2:
	movb	(r2)+,r0
	jsr	r5,fputc
	sob	r1,2b
	br	1b
1:
	jsr	r5,fflush
	jmp	*(r4)+

ioru:
	tst	(sp)+
	mov	(sp)+,r1		/ unit number
	jsr	r5,setio; 41
	clr	nlflg
	mov	pc,binflg
1:
	jsr	r5,getitm
		br 1f
	movb	ilen,r1
	mov	ilval,r2
2:
	jsr	r5,fgetc
	movb	r0,(r2)+
	sob	r1,2b
	br	1b
1:
	jmp	*(r4)+

rewi:
enfl:
	tst	(sp)+
	mov/
/

/ iox -- io variables

.globl	_nocr
.globl	utable
.globl	btable
.globl	ftable

.globl	_end
.globl	formp

bufp:	_end
filnam:
	<fortxx\0>; .even

	.bss

gflg:	.=.+2
formp:	.=.+2
rdflg:	.=.+2
nflg:	.=.+2
unit:	.=.+2
buffer:	.=.+2
slcnt:	.=.+2
itype:	.=.+1
ilen:	.=.+1
ilval:	.=.+2
width:	.=.+2
twidth:	.=.+2
ndig:	.=.+2
pbuf:	.=.+10
ppar:	.=.+2
llp:	.=.+2
llpcnt:	.=.+2
itmflg:	.=.+2
nspace:	.=.+2
gcflg:	.=.+2
binflg:	.=.+2

utable:	.=.+20.
btable:	.=.+40.
ftable:	.=.+2.
rep:	.=.+2
scale:	.=.+2
itmfnd:	.=.+2
ngflg:	.=.+2
iscale:	.=.+2
nlflg:	.=.+2
_nocr:	.=.+2

.globl	btable
.globl	ftable

.globl	_end
.globl	formp

bufp:	_end
filnam:
	<fortxx\0>; .even

	.bss

gflg:	.=.+2
formp:	.=.+2
rdflg:	.=.+2
nflg:	.=.+2
unit:	.=.+2
buffer:	.=.+2
slcnt:	.=.+2
itype:	.=.+1
ilen:	.=.+1
ilval:	.=.+2
width:	.=.+2
twidth:	.=.+2
ndig:	.=.+2
pbuf:	.=.+10
ppar:	.=.+2
llp:	.=.+2
llpcnt:	.=.+2
itmflg:	.=.+2
nspace:	.=.+2
gcflg:	.=.+2
binflg:	.=.+2

utable:	.=.+20.
btable:	.=.+40.
ftable:	.=.+2.
rep:	.=.+2
scale:	.=.+2
itmfnd:	.=.+2USRF = /usr/fort
DD = tmp

LD = -ld
LDFLAGS = -s

AS = -as

.s.o:
	$(AS) -o $*.o fx/fhd.s $<


#------
# install: Create fc1 and install in $(USRF)/fc1.
#------
install: fc1
	-mv $(USRF)/fc1 $(USRF)/$(DD)fc1
	mv fc1 $(USRF)/fc1
	-chown bin $(USRF)/fc1
	-rm -f $(USRF)/$(DD)fc1
	ls -l $(USRF)/fc1


#------
# fc1: Create fc1 in current directory.
#------
fc1:	f1/f1.o f2/f2.o f3/f3.o f4/f4.o fx/fx.o
	$(LD) $(LDFLAGS) -o fc1 f1/f1.o f2/f2.o f3/f3.o f4/f4.o fx/fx.o -l
	-chmod 755 fc1


#------
# clean: Remove all created .o files.
#------
clean:
	-rm -f f1/f1.o f2/f2.o f3/f3.o f4/f4.o fx/fx.o
	-rm -f f1/f11.o f1/f12.o f1/f13.o f1/f14.o f1/f15.o f1/f16.o f1/f17.o
	-rm -f f2/f21.o f2/f22.o f2/f23.o f2/f24.o
	-rm -f f3/f31.o f3/f32.o f3/f33.o f3/f34.o f3/f35.o f3/f36.o f3/f37.o f3/f38.o f3/f39.o
	-rm -f f4/f41.o f4/f42.o f4/f43.o f4/f44.o f4/f45.o f4/f46.o f4/f47.o
	-rm -f fx/fx1.o fx/fx2.o fx/fx3.o fx/fx4.o fx/fx5.o fx/fx6.o fx/fx7.o fx/fx8.o
	-rm -f fx/fx9.o fx/fxa.o fx/fxb.o fx/fxc.o fx/fxd.o fx/fxe.o fx/fxf.o fx/fxg.o
	-rm -f fx/fxh.o fx/fxi.o fx/fxx.o


#------
# Dependencies for indiv files.
#------
f1/f1.o:	f1/f11.o f1/f12.o f1/f13.o f1/f14.o f1/f15.o f1/f16.o f1/f17.o
	$(LD) -r f1/f11.o f1/f12.o f1/f13.o f1/f14.o f1/f15.o f1/f16.o f1/f17.o -o f1/f1.o

f1/f11.o:	f1/f11.s fx/fhd.s
f1/f12.o:	f1/f12.s fx/fhd.s
f1/f13.o:	f1/f13.s fx/fhd.s
f1/f14.o:	f1/f14.s fx/fhd.s
f1/f15.o:	f1/f15.s fx/fhd.s
f1/f16.o:	f1/f16.s fx/fhd.s
f1/f17.o:	f1/f17.s fx/fhd.s

f2/f2.o:	f2/f21.o f2/f22.o f2/f23.o f2/f24.o
	$(LD) -r f2/f21.o f2/f22.o f2/f23.o f2/f24.o -o f2/f2.o

f2/f21.o:	f2/f21.s fx/fhd.s
f2/f22.o:	f2/f22.s fx/fhd.s
f2/f23.o:	f2/f23.s fx/fhd.s
f2/f24.o:	f2/f24.s fx/fhd.s

f3/f3.o: f3/f31.o f3/f32.o f3/f33.o f3/f34.o f3/f35.o f3/f36.o f3/f37.o f3/f38.o f3/f39.o
	$(LD) -r f3/f31.o f3/f32.o f3/f33.o f3/f34.o f3/f35.o f3/f36.o f3/f37.o \
			f3/f38.o f3/f39.o -o f3/f3.o

f3/f31.o:	f3/f31.s fx/fhd.s
f3/f32.o:	f3/f32.s fx/fhd.s
f3/f33.o:	f3/f33.s fx/fhd.s
f3/f34.o:	f3/f34.s fx/fhd.s
f3/f35.o:	f3/f35.s fx/fhd.s
f3/f36.o:	f3/f36.s fx/fhd.s
f3/f37.o:	f3/f37.s fx/fhd.s
f3/f38.o:	f3/f38.s fx/fhd.s
f3/f39.o:	f3/f39.s fx/fhd.s

f4/f4.o:	f4/f41.o f4/f42.o f4/f43.o f4/f44.o f4/f45.o f4/f46.o f4/f47.o
	$(LD) -r f4/f41.o f4/f42.o f4/f43.o f4/f44.o f4/f45.o f4/f46.o f4/f47.o -o f4/f4.o

f4/f41.o:	f4/f41.s fx/fhd.s
f4/f42.o:	f4/f42.s fx/fhd.s
f4/f43.o:	f4/f43.s fx/fhd.s
f4/f44.o:	f4/f44.s fx/fhd.s
f4/f45.o:	f4/f45.s fx/fhd.s
f4/f46.o:	f4/f46.s fx/fhd.s
f4/f47.o:	f4/f47.s fx/fhd.s

fx/fx.o: fx/fx1.o fx/fx2.o fx/fx3.o fx/fx4.o fx/fx5.o fx/fx6.o fx/fx7.o fx/fx8.o \
	fx/fx9.o fx/fxa.o fx/fxb.o fx/fxc.o fx/fxd.o fx/fxe.o fx/fxf.o fx/fxg.o \
	fx/fxh.o fx/fxi.o fx/fxx.o
	$(LD) -r -o fx/fx.o fx/fx1.o fx/fx2.o fx/fx3.o fx/fx4.o \
		fx/fx5.o fx/fx6.o fx/fx7.o fx/fx8.o \
		fx/fx9.o fx/fxa.o fx/fxb.o fx/fxc.o fx/fxd.o fx/fxe.o fx/fxf.o fx/fxg.o \
		fx/fxh.o fx/fxi.o fx/fxx.o

fx/fx1.o:	fx/fx1.s fx/fhd.s
fx/fx2.o:	fx/fx2.s fx/fhd.s
fx/fx3.o:	fx/fx3.s fx/fhd.s
fx/fx4.o:	fx/fx4.s fx/fhd.s
fx/fx5.o:	fx/fx5.s fx/fhd.s
fx/fx6.o:	fx/fx6.s fx/fhd.s
fx/fx7.o:	fx/fx7.s fx/fhd.s
fx/fx8.o:	fx/fx8.s fx/fhd.s
fx/fx9.o:	fx/fx9.s fx/fhd.s
fx/fxa.o:	fx/fxa.s fx/fhd.s
fx/fxb.o:	fx/fxb.s fx/fhd.s
fx/fxc.o:	fx/fxc.s fx/fhd.s
fx/fxd.o:	fx/fxd.s fx/fhd.s
fx/fxe.o:	fx/fxe.s fx/fhd.s
fx/fxf.o:	fx/fxf.s fx/fhd.s
fx/fxg.o:	fx/fxg.s fx/fhd.s
