.title	tank routines for the imp compiler

	.psect	tanks,exe,nowrt,shr,pic,rel

; %recordformat tankfm (%bytename base, last, first free, 
;                       %integer charcount)
; %externalrecord(tankfm)%map create tank(%integer npages)
;     returns a handle on a tank of npages in size

	.entry	createtank,^m<r11>
	subl	#8,sp		;get space for descriptor
	movl	sp,r11		;preserve its address
	$expreg_s 4(ap),(r11)	;get the pages
	blbs	r0,10$		;br if all is well
	clrl	r0		;zero means failed
	ret
10$:	movl	(r11),r0	;base of allocated area
	movq	(r11),(r0)	;first:last
	addl3	#16,r0,8(r0)	;first free byte
	clrl	12(r0)		;no characters in the tank
	ret


; %externalroutine destroy tank(%integer tank)
;  destroys the tank and releases the space

	.entry	destroytank,^m<>
	$deltva_s @4(ap)
	ret


; %externalroutine select input tank(%integer tank)
;  selects the given tank for access by get

	.entry	selectinputtank,^m<>
	movl	4(ap),itank
	ret

; %externalroutine select output tank(%integer tank)
;  selects the given tank for access by put

	.entry	selectoutputtank,^m<>
	movl	4(ap),otank
	ret

; %externalroutine reinput tank(%integer tank)
;  resets the tank so that get will access the first byte,
;  and removes any surplus pages

	.entry	reinputtank,^m<r2>
	movl	4(ap),r2	;tank address
	movq	4(r2),r0	;current end and high water
	subl3	r2,r1,12(r2)	;bytes used = high water - base - 16
	subl2	#16,12(r2)	;update size field
	addl3	#16,r2,8(r2)    ;reset pointer to first character
	decl	r1		;unused byte
	movl	r1,4(r2)	;set new end
	addl	#512,r1		;ensure the last page OK
	cmpl	r1, r0		;lots of wasted space?
	bleq	nospare		;no: ->
	pushl	r0		;end of area
	pushl	r1		;start of area to free
	movl	sp,r2		;descriptor address
	$deltva_s (r2)
nospare:
	ret


; %externalroutine get(%integername ch)
;  sets ch to the next character in the current input tank

	.entry	get,^m<>
	movl	itank, r1	;current input tank
	movzbl	@8(r1), @4(ap)	;fetch char
	incl	8(r1)		;update pointer
	ret

get_jsb::
	movl	itank,r1
	movzbl	@8(r1),(r0)
	incl	8(r1)
	rsb


;%externalintegerfn getword

	.entry	getword,^m<>
	movl	itank, r1	;current input tank
	cvtwl	@8(r1), r0
	addl2	#2, 8(r1)
	ret

getword_jsb::
	movl	itank, r1	;current input tank
	cvtwl	@8(r1), r0
	addl2	#2, 8(r1)
	rsb


;%externalintegerfn getlong

	.entry	getlong,^m<>
	movl	itank, r1	;current input tank
	movl	@8(r1), r0
	addl2	#4, 8(r1)
	ret

getlong_jsb::
	movl	itank, r1	;current input tank
	movl	@8(r1), r0
	addl2	#4, 8(r1)
	rsb


;%externalroutine getblock(%integer size, %bytename b)
	.entry getblock,^m<r2,r3,r4,r5>
	movl 	itank, r1
	movl	8(r1), r0
	addl2	4(ap), 8(r1)
	movc3	4(ap), (r0), @8(ap)
	ret

getblock_jsb::
	movl	itank, r2
	movl	8(r2), r3
	addl	r0, 8(r2)
	movc3	r0, (r3), (r1)
	rsb

; %externalintegerfn look
;  looks at the next character (but does not skip over it)
	.entry	look, ^m<>
	movl	itank, r1	;current input tank
	movzbl	@8(r1), r0	;get character
	ret

; %externalroutine put(%integer ch)
;  puts ch (1 byte) into the current output tank

	.entry	put, ^m<>
	movl	otank, r1	;current output tank
	movb	4(ap), @8(r1)	;put char into tank
	incl	8(r1)		;update pointer
	ret

put_jsb::
	movl	otank, r1	;current output tank
	movb	r0, @8(r1)	;put into tank
	incl	8(r1)		;update pointer
	rsb


; %externalroutine putword(%integer ch)
;  puts ch (2 bytes) into the current output tank

	.entry	putword, ^m<>
	movl	otank, r1	;current output tank
	movw	4(ap), @8(r1)	;put into tank
	addl2	#2, 8(r1)	;update pointer
	ret

putword_jsb::
	movl	otank,r1	;current output tank
	movw	r0, @8(r1)	;put into tank
	addl2	#2, 8(r1)	;update pointer
	rsb


; %externalroutine putlong(%integer ch)
;  puts ch (4 bytes) into the current output tank

	.entry	putlong, ^m<>
	movl	otank, r1	;current output tank
	movl	4(ap), @8(r1)	;put into tank
	addl2	#4, 8(r1)
	ret

putlong_jsb::
	movl	otank, r1	;current output tank
	movl	r0, @8(r1)	;put into tank
	addl2	#4, 8(r1)
	rsb

;%externalroutine putblock(%integer count, %bytename b)

	.entry putblock,^m<r2,r3,r4,r5>
	movl	otank, r1
	movl	8(r1), r0
	addl2	4(ap), 8(r1)
	movc3	4(ap), @8(ap), (r0)
	ret

putblock_jsb::
	movl	otank, r2
	movl	8(r2), r3
	addl2	r0, 8(r2)
	movc3	r0, (r1), (r3)
	rsb

	.psect	tanks$w,wrt,noshr,noexe,rel,pic

otank::.blkl	1
itank::.blkl	1

	.end