bas0.s

/ bas0 -- basic

.globl	main
.globl	sin, cos, log, exp, atan, pow
.globl	atoi, atof, ftoa, ftoo
.globl	rand, srand

one = 40200

main:
	setd
	sys	time
	mov	r1,r0
	mov	r0,randx
	jsr	pc,srand
	sys	intr; intrup
	mov	sp,gsp
	clr	seeka
	mov	$'a,r1
1:
	movb	r1,tmpf+8
	sys	stat; tmpf; line
	bes	1f
	inc	r1
	cmp	r1,$'z
	blos	1b
	br	2f
1:
	sys	creat; tmpf; 14
	bes	2f
	mov	r0,tfo
	sys	open; tmpf; 0
	bec	1f
2:
	mov	$3f,r0
	jsr	pc,print
	sys	exit
3:
	<Tmp file?\n\0>; .even
1:
	mov	r0,tfi
	jsr	pc,isymtab
	cmp	(sp),$2
	blt	loop
	mov	4(sp),0f
	sys	open; 0:..; 0
	bes	1f
	mov	r0,fi
	br	loop
1:
	mov	$1f,r0
	jsr	pc,print
	br	loop
1:
	<Cannot open file\n\0>; .even

intrup:
	mov	$'\n,r0
	jsr	r5,putc
	jsr	r5,error
		<ready\n\0>; .even

loop:
	mov	gsp,sp
	clr	lineno
	jsr	pc,rdline
	mov	$line,r3
1:
	movb	(r3),r0
	jsr	pc,digit
		br 1f
	jsr	r5,atoi; nextc
	cmp	r0,$' /
	bne	1f
	mov	$lintab,r3
	mov	r1,r0
	bgt	2f
	jsr	pc,serror
2:
	cmp	r0,(r3)
	beq	2f
	tst	(r3)
	beq	2f
	add	$6,r3
	br	2b
2:
	cmp	r3,$elintab-12.
	blo	2f
	jsr	r5,error
		<too many lines\n\0>; .even
2:
	mov	r0,(r3)+
	mov	seeka,(r3)+
	mov	tfo,r0
	sys	seek; seeka:..; 0
	mov	$line,r0
	jsr	pc,size
	inc	r0
	add	r0,seeka
	mov	r0,0f
	mov	tfo,r0
	sys	write; line; 0:..
	br	loop
1:
	mov	$line,r3
	jsr	pc,singstat
	br	loop

nextc:
	movb	(r3)+,r0
	rts	r5

size:
	clr	-(sp)
1:
	inc	(sp)
	cmpb	(r0)+,$'\n
	bne	1b
	mov	(sp)+,r0
	rts	pc

rdline:
	mov	$line,0f
1:
	mov	fi,r0
	sys	read; 0:..; 1
	bes	2f
	tst	r0
	beq	2f
	cmp	0b,$line+99.
	bhis	2f			/ bad check, but a check
	movb	*0b,r0
	inc	0b
	cmp	r0,$'\n
	bne	1b
	clrb	*0b
	rts	pc
2:
	mov	fi,r0
	beq	1f
	sys	close
	clr	fi
	br	1b
1:
	jmp	_done

error:
	tst	fi
	beq	1f
	sys	close
	clr	fi
1:
	tst	lineno
	beq	1f
	jsr	pc,nextlin
		br 1f
	mov	$line,r0
	jsr	pc,print
1:
	mov	r5,r0
	jsr	pc,print
	jmp	loop

serror:
	dec	r3
	tst	fi
	beq	1f
	sys	close
	clr	fi
1:
	mov	$line,r1
1:
	cmp	r1,r3
	bne	2f
	mov	$'_,r0
	jsr	r5,putc
	mov	$10,r0
	jsr	r5,putc
2:
	movb	(r1),r0
	jsr	r5,putc
	cmpb	(r1)+,$'\n
	bne	1b
	jmp	loop

print:
	mov	r0,0f
	jsr	pc,size
	mov	r0,0f+2
	mov	$1,r0
	sys	write; 0:..; ..
	rts	pc

digit:
	cmp	r0,$'0
	blo	1f
	cmp	r0,$'9
	bhi	1f
	add	$2,(sp)
1:
	rts	pc

alpha:
	cmp	r0,$'a
	blo	1f
	cmp	r0,$'z
	bhi	1f
	add	$2,(sp)
1:
	rts	pc

name:
	mov	$nameb,r1
	clr	(r1)
	clr	2(r1)
1:
	cmp	r1,$nameb+4
	bhis	2f
	movb	r0,(r1)+
2:
	movb	(r3)+,r0
	jsr	pc,alpha
		br 2f
	br	1b
2:
	jsr	pc,digit
		br 2f
	br	1b
2:
	mov	$resnam,r1
1:
	cmp	nameb,(r1)
	bne	2f
	cmp	nameb+2,2(r1)
	bne	2f
	sub	$resnam,r1
	asr	r1
	add	$2,(sp)
	rts	pc
2:
	add	$4,r1
	cmp	r1,$eresnam
	blo	1b
	mov	$symtab,r1
1:
	tst	(r1)
	beq	1f
	cmp	nameb,(r1)
	bne	2f
	cmp	nameb+2,2(r1)
	bne	2f
	rts	pc
2:
	add	$14.,r1
	br	1b
1:
	cmp	r1,$esymtab-28.
	blo	1f
	jsr	r5,error
		<out of symbol space\n\0>; .even
1:
	mov	nameb,(r1)
	mov	nameb+2,2(r1)
	clr	4(r1)
	clr	14.(r1)
	rts	pc

skip:
	cmp	r0,$' /
	bne	1f
	movb	(r3)+,r0
	br	skip
1:
	rts	pc

putc:
	tstb	drflg
	beq	1f
	jsr	pc,drput
	rts	r5
1:
	mov	r0,ch
	mov	$1,r0
	sys	write; ch; 1
	rts	r5

nextlin:
	clr	-(sp)
	mov	$lintab,r1
1:
	tst	(r1)
	beq	1f
	cmp	lineno,(r1)
	bhi	2f
	mov	(sp),r0
	beq	3f
	cmp	(r0),(r1)
	blos	2f
3:
	mov	r1,(sp)
2:
	add	$6,r1
	br	1b
1:
	mov	(sp)+,r1
	beq	1f
	mov	(r1)+,lineno
	mov	(r1)+,0f
	mov	tfi,r0
	sys	seek; 0:..; 0
	mov	tfi,r0
	sys	read; line; 100.
	add	$2,(sp)
1:
	rts	pc

getloc:
	mov	$lintab,r1
1:
	tst	(r1)
	beq	1f
	cmp	r0,(r1)
	beq	2f
	add	$6,r1
	br	1b
1:
	jsr	r5,error
		<label not found\n\0>; .even
2:
	rts	pc

isymtab:
	mov	$symtab,r0
	mov	$symtnam,r1
	clrf	fr0
	movf	$one,fr1
1:
	mov	(r1)+,(r0)+
	mov	(r1)+,(r0)+
	mov	$1,(r0)+
	subf	r1,r0
	movf	r0,(r0)+
	cmp	r1,$esymtnam
	blo	1b
	clr	(r0)+
	rts	pc