	.title	edio
	.ident	/009/

;	Copyright (C) 1978 1979 1980 1981 1982 1983   Change Software, Inc.
;	
;	This software is furnished in  an  as-is
;	condition,  with no committments of sup-
;	port or updates.  This software may  NOT
;	be sold for profit nor can it be includ-
;	ed in any package to be sold for  profit
;	without  the  written consent of the au-
;	thor.  This software may  be  used  only
;	within the above conditions of use.
;	
;	The information in contained  herein  is
;	subject  to  change  or  revision at any
;	time without notice.
;	
;	
;

	.globl	getc	,retc
	.sbttl	get a line from disk/tape/keyboard ect....

	.if ne	,rsx11m
	.ift
	.enabl	gbl
	.endc

;	edits
;
;	05-oct-82	bdn	fix for null records from f77 created files


	section	$edio


	routine	$getlin

;	(r5)	=	channel buffer address
;	2(r5)	=	channel number to use.
;	4(r5)	=	string address
;
;	string format
;			@stringaddr	= first char of string
;			@stringaddr-2	= maximum length in bytes
;			@stringaddr-4	= current length in bytes
;

	mov	r0	,-(sp)
	calls	jread	,<4(r5),2(r5)>	; perhaps we are getting
	tst	r0			; input from cmd file.
	bne	10$			; it worked
	call	stread
10$:	mov	r1	,-(sp)		; return length at string addr
	mov	4(r5)	,r1		; offset -4 (an old stupid move)
	mov	r0	,-4(r1)		; and so on
	ifnoerr	20$
	clr	r0			; force fake eof to journal
20$:	calls	jwrite	,<r1,r0,2(r5)>	; perhaps echoprint kb input
	mov	(sp)+	,r1		; pop r1 and exit
	mov	(sp)+	,r0
	return


	.sbttl	read stream ascii or nfs device


stread::save	<r1,r3,r4>
	mov	4(r5)	,r4		; the address of the string
	mov	r4	,r3		; get the address again.
	clr	r1			; length counter for string
	mov	2(r5)	,r0		; channel number
	beq	20$			; zero must always be KB:
	asl	r0			; channel number times two
	cmpb	iostat(r0),#kbhnd
	beq	20$			; kb input. skip call to getc
	cmpb	iostat(r0),#crhnd	; how about the card reader (?)
	bne	50$
20$:	 asr	r0
	 .if eq	,rsx11m			; is it rsts or m?
	 .ift				; rsts
	 calls	$getbl	,<r3,#maxlen-2,r0,#0>
	 .iff				; m
	 calls	rgetkb	,<r3,#maxlen-2>	; simple (ti: only)
	 .endc				; rsx or rsts
	 mov	@#recount,r1
	 ble	40$			; nothing read here ??????????
	 add	r1	,r4		; point to the end of the line
	 cmp	r1	,#1		; double check the char count
	 beq	30$			; find out was the terminator
	 cmpb	-2(r4)	,#cr		; was. If carriage ret  or ff,
	 beq	100$			; all is ok,else change lf char
30$:	 cmpb	-1(r4)	,#lf		; to line feed/carriage return
	 bne	100$			; sequence.
	 movb #cr	,(r4)+		; create a lf/cr/null ending.
	 clrb	@r4			; and the null (chr(0))
	 add	#2	,r1		; finx the line length and exit
	 br	100$			; bye........

40$:	 cmpb	#ed.cc	,@#errsav	; See if control-c set trapped
	 bne	100$			; no control c's today
	  mov	#ed.eof	,@#errsav	; Fake EOF for a control c trap.
	  br	100$			; bye


50$:	calli	getc			; get the next char in buffer
	ifnoerr 60$			; read errors (like eof,daterr)
	 cmpb #ed.eof	,@#errsav	; was the error an end of file
	 bne	110$			; if not, then its a fatal err
	  movb #26.	,(r4)		; stuff a control z in buffer.
	  inc	r1			; bump byte count by one char.
	  br	100$			; fake eof and exit.....

60$:	 movb	r0	,(r4)		; return the character to str
	 beq	50$			; ignore all null (ascii 0 ).
	 inc	r4			; bump current line pointer.
	 inc	r1			; add one to the string  len.
	 cmp	r1	,#maxlen-1	; see if len is > max length.
	 bge	120$			; if so, set '%line too long'

	 cmpb	r0	,#ff		; see if we got a terminator.
	 beq	100$			; form feed, nothing else to do
	 cmpb	r0	,#cr		; cr or lf must  be  followed
	 beq	80$			; by a lf or cr, respectively
	 cmpb	r0	,#lf		; if lf, then need two more
	 bne	50$			; reads to get car ret & null.
	 mov	2(r5)	,-(sp)		; no lf/cr/null if rms file.
	 call	isrms			; check it out
	 bcc	65$			; no, must be stream ascii
	 movb	#cr	,-1(r4)		; trailing lf, make into cr/lf
	 br	90$			; stuff lf in and exit
	 
65$:	 call	getc			; Is the line feed followed by
	 cmpb	#cr	,r0		; a carriage return ?
	 beq	70$			; Yes.
	 call	retc			; No. try to put character back
	 br	100$			; should not usually occur.
70$:	 movb	r0	,(r4)+		; stuff car ret in after lf
	 inc	r1			; and bump char count also.
	 clr	r0			; linefeed-car ret-null seq
	 br	90$			; common exit

80$:	call	getc			; get second line terminator.
90$:	movb	r0	,(r4)+		; and return the character.
	inc	r1

100$:	mov	r1	,r0		; return the string  length.
110$:	unsave	<r4,r3,r1>
	return				; bye .............

120$:	.errprt	#ed.long		; Line to long. Print message,
	.print	r3	,r1		; print the offending line and
	callg	$pcrlf			; a cr/lf to round things off.
	br	100$			; exit now.

	.sbttl	attempt to return char to buffer

	.iif ndf , er$sav , er$sav = errsav
	.iif ndf , bl$num , bl$num = blknum
	.iif ndf , bf$pnt , bf$pnt = bufpnt
	.iif ndf , fd.cr  , fd.cr  = 2*400
	.iif ndf , fd.ftn , fd.ftn = 1*400
	.iif ndf , fd.blk , fd.blk = 4000
	r.fix	=	1
	r.var	=	2


;	input:	 @r5	=	buffer address
;		2(r5)	=	channel number
;
;	calls:	$retc
;


	.if eq	,rt11
	.ift

retc::	save	<r1>
	mov	2(r5)	,r1
	asl	r1
	cmp	rc$fmt(r1),#1004
	beq	10$
	tst	rc$fmt(r1)
	bne	20$
10$:	call	$retc
20$:	unsave	<r1>
	return

	.iff

retc::	call	$retc			; for native 11m systems
	return

	.endc


	.sbttl	getc	get next character for stream and rms seq

;	input:	@r5	=	buffer address
;		2(r5)	=	channel number
;	calls:	$getc	to return next char

	.if eq	,rt11		; this is for RSTS
	.ift

e$getc::
getc::	save <r1,r2>			; save part of the world
	clr	er$sav			; say no errors yet please.
	mov	2(r5)	,-(sp)		; channel number here
	call	isrms			; stream ascii ?
	bcs	20$			; no, fd.cr or fd.ftn
	call	$getc			; no, normal stream ascii (?)
	br	100$			; bye ..........

20$:	mov	2(r5)	,r1		; channel number
	asl	r1			; times 2
	mov	r1	,r2		; set pointer to rm$siz(r1)
	add	#rm$siz	,r2		; r2@ = rm$siz(r1)
	tst	bl$num(r1)		; anything in the buffers yet?
	beq	25$			; yes, no need for inital load
	cmp	@r2	,#100001	; fd.cr flag for at eor/lf ?
	bne	30$			; if eq, then load next recsiz
25$:	 call	rmsini			; no, get byte count of record.
	 iferr	100$			; exit on logical end of file.

30$:	cmp	@r2	,#100000	; set if fd.cr and need a 'lf'.
	beq	40$			; yes, return a line feed next.
	tst	@r2			; if > 0, even byte count
	bne	60$			; if < 0, odd  byte count
	bit	#fd.ftn!fd.cr,rc$fmt(r1); no, but should we return cr
	beq	50$			; lf at the record's end ?
	 movb	#cr	,r0		; yes, return cr and setup for
	 mov	#100000 ,@r2		; returned a lf at next call.
	 bit	#fd.ftn	,rc$fmt(r1)	; fortran vfc records?
	 beq	100$			; no, exit with setup for <lf>
	 cmpb	vfc$(r1),#'1		; new page required ?
	 bne	100$			; no
	  movb	#ff	,r0		; yes
	  br	45$			; and flag eor for next call.
40$:	 movb	#lf	,r0		; final call, return line feed
45$:	 mov	#100001	,@r2		; and load for next record.
	 br	100$			; and exit !!!!!

50$:	call	rmsini			; end of record, load next rec
	iferr	100$			; exit on eof on get
60$:	call	$getc			; return nextch in main buffer
	tst	@r2			; if >, then dec else inc to 0.
	blt	70$			; if <, then odd length record.
	 dec	@r2			; dec size of remaining rms rec
	 br	80$			; and exit
70$:	 inc	@r2			; we may need to eat a trailing
	 bne	80$			; null character (filler)
	 save	<r0>			; keep last char around please.
	 call	$getc			; zero, so eatup the filler.
	 unsave	<r0>
80$:	tst	@r2			; anything left in rms record?
	bne	100$			; yes, skip next check
	bit	#fd.cr	,rc$fmt(r1)	; is it implied cr/lf ?
	beq	100$			; no
	cmpb	r0	,#ff		; if already has a terminator
	beq	90$			; then we should not add cr/lf.
	cmpb	r0	,#lf		; yes, do we need to stuff a
	bne	100$			; stuff a cr/lf in. if eq, no
90$:	 mov	#100001	,@r2		; yes, flag not to next time.
100$:	unsave	<r2,r1>			; pop temp registers
	return				; and so long now .......


	.sbttl	initialize next fcs/rms record for getc


rmsini:	clr	-(sp)			; clear rms record size first
	call	$eof			; check for logical end of
	bcc	100$			; file for attributed files.
	 movb	#ed.eof	,er$sav		; set end of file error then.
	 .if eq	,rsx11m!rt11
	 .ift
	 movb	#ed.eof	,firqb		; stuff it here too please.
	 .endc
	 br	220$			; bye.......
100$:	bit	#fd.blk	,rc$fmt(r1)	; what about nospan ?
	beq	210$			; no
	mov	bf$pnt(r1),-(sp)	; yes, stuff current buffer
	mov	@sp	,r0		; save it
	bic	#777	,@sp		; pointer and extract block#
	add	mx$siz(r1),r0		; fake a read of next record
	bic	#777	,r0		; and extract block info
	cmp	r0	,(sp)+		; cross a block to do the read?
	beq	210$			; no
200$:	bit	#777	,bf$pnt(r1)	; yes, eat the rest of the block
	beq	210$			; up or stop at eof
	call	$getc			; simple
	iferr	220$			; but an error must cause exit?
	br	200$			; next please
	
210$:	mov	mx$siz(r1),@sp		; preset with max recordsize
	bit	#r.var	,rc$fmt(r1)	; really var length records?
	beq	211$			; no, assume fixed
	call	$getc			; get first byte of rec size
	iferr	220$			; exit on error always please.
	mov	r0	,@sp		; save in r2
	call	$getc			; next byte of record size
	iferr	220$			; always exit on error !
	swab	r0			; the high order byte is here
	bis	r0	,@sp		; set into r2 and then swap
211$:	clr	r0			; correction for vfc character.
	bit	#fd.ftn	,rc$fmt(r1)	; fortran vfc records ?
	beq	215$			; no
	 clrb	vfc$(r1)		; insure default for no car ctl
	 tst	@sp			; null record ?
	 beq	215$			; yes, --> no carriage control info
	 call	$getc			; yes, get the vfc character
	 movb	r0	,vfc$(r1)	; and save it please.
	 mov	#1	,r0		; read a byte for vertical form
215$:	bit	#1	,@sp		; odd length record ?
	beq	220$			; no
	 neg	r0			; vfc correction
	 neg	@sp			; yes, set so filler is eaten.
220$:	mov	(sp)+	,@r2		; stuff size of next rms record
	sub	r0	,@r2		; correct for VFC character read
	return				; thats all, folks.....



isrms::	mov	r0	,-(sp)		; check for being RMS file
	mov	4(sp)	,r0		; channel passed on the stack
	beq	100$			; never for KB:
	asl	r0			; times 2
	tst	rc$fmt(r0)		; stream ascii ?
	beq	100$			; yes
	cmp	rc$fmt(r0),#1004	; same here
	beq	100$
	sec				; return 'c' up if rms seq
	br	110$			; exit
100$:	clc				; clear 'c' for stream ascii
110$:	mov	(sp)+	,r0		; pop temps and exit
	mov	(sp)+	,(sp)		; pop channel
	return				; bye

	.endc				; for rsts

	.if ne	,rt11
	.ift
isrms::	mov	(sp)+	,(sp)
	clc
	return
	.endc

	.sbttl	check for eof with attributed file

	.if eq	,rt11		; for RSTS

	routine	$eof

;	input:	2(r5)	=	channel number (LUN)


	save	<r2,r3>
	movb	2(r5)	,r0
	asl	r0			; Becomes channel # * 2
	cmpb	iostat(r0),#dkhnd	; Must be a disk device
	bne	20$			; go away if it isn't.
	tst	la$blk(r0)		; See if attributes there.
	beq	20$			; No. exit with eof=false.

	 tst	blknum(r0)		; read ANYTHING at all yet ?
	 beq	20$			; no, can not have any eof.
	 mov	rd$siz(r0),r2		; Size of the last read please
	 beq	10$
	 ash	#-9.	,r2		; convert to block count.
	 dec	r2			; To convert to file attr stuff.
	 neg	r2			; subtract from current pointer.
	 add	blknum(r0),r2		; finally.
	 mov	bufpnt(r0),r3		; size of our buffer today.
	 ash	#-9.	,r3		; nuber of blocks into buffer.
	 add	r3	,r2		; finally, where we really are.
	 mov	bufpnt(r0),r3		; of the file yet ?
	  bic	#^C777	,r3
	 cmp	r2	,la$blk(r0)
	 blt	20$			; No. exit with eof=false.
	 bgt	10$			; Yes. Set eof = true, exit.
	  cmp	r3	,la$byt(r0)	; Last block. Check  buffer
	  blt	20$			; pointer. If less than,ok.

10$:	unsave	<r3,r2>
	sec				; set carry if eof set
	return
20$:	unsave	<r3,r2>
	clc				; no carry if no eof
	return

	.endc				; for RSTS

	.if ne	,rt11
	.ift

$eof::	clc
	return

	.endc


	.sbttl	get a character from chan


	routine	$getc

;	(r5)	=	buffer address
;	2(r5)	=	channel number
;

	save	<r1>
	mov	(r5)	,r0		; copy the buffer address
	mov	2(r5)	,r1		; the channel number next
	asl	r1


	cmp	bufpnt(r1),rd$siz(r1)	; see if we are at end of
	blt	2$			; buffer yet. if not,read

1$:	  save	<r2>
	  mov	r1	,r2		; copy the channel number
	  inc	blknum(r2)		; increment block number.
	  asr	r1			; channel number
	  calls	$getbl	,<r0,@#bufsiz,r1,blknum(r2)>
	  save	<r0,r1>			; fix up to be real block number
	  mov	rd$siz(r2),r1
	  clr	r0
	  div	#512.	,r0
	  dec	r0
	  ble	55$
	   add	r0	,blknum(r2)
55$:	  unsave	<r1,r0>
	  unsave	<r2>
	  iferr	10$
	  asl	r1			; get channel*2 back.
	  clr	bufpnt(r1)		; current index into buff.

2$:	add	bufpnt(r1),r0		; set to index into buffer
	movb	(r0)	,r0		; return character in  r0.
;-	bicb	#200	,r0
	bic	#^C377	,r0
	inc	bufpnt(r1)		; update the buff pointer.
10$:	unsave	<r1>
	return


	.if ne	,rt11
	.ift
getc:	call	$getc
	return
	.endc

	.sbttl	put one character back

$retc::
	save	<r1>
	mov	2(r5)	,r1		; channel number to use.
	asl	r1
	dec	bufpnt(r1)		; bufferpnt=bufferpnt - 1
	bge	1$
	  clr	bufpnt(r1)
1$:	unsave	<r1>
	return

	.sbttl	ttyout subroutine



	routine	$ttyout

	.globl	vt.lun


;	input:		(r5)	= string address
;			2(r5)	= string length


e$ttyo::save	<r0,r1,@#errsav>	; registers we may use.
	mov	(r5)	,r1		; the string address first.
	mov	2(r5)	,r0		; the string length next.
	bgt	3$			; Was non-zero. Otherwise

	clr	r0			; be safe.
1$:	tstb	(r1)+			; loop looking for a null
	beq	2$			; terminator and count chars.
	inc	r0			; length := succ( length )
	br	1$			; check next byte for a null

2$:	tst	r0			; do we have anything to do?
	beq	5$			; no, a null string was passed.
3$:	clr	r1			; assume channel number zero.
	bit	#vtedit	,@#edsta1	; are we in the scope editor?
	beq	4$			; no, writes to 0 are ok then.
	 mov	#vt.lun	,r1		; yes, keep the ttdvr happy.

	.if eq	,rsx11m			; for RSTS
	.ift
4$:	calls	$putbl	,<(r5),r0,r1,#0>; finally, call writer.
	.iff
4$:	bit	#vtedit	,@#edsta1
	beq	120$
	calls	rputbn	,<@r5,r0>	; write all mode
	br	130$			;
120$:	calls	rputkb	,<@r5,r0>	; for RSX11M
130$:
	.endc

5$:	unsave	<@#errsav,r1,r0>	; pop err and regs and then ....
	return				; bye......


	.sbttl	write decimal

	routine	$wrdec

;
;	write a decimal number to KB: passed at 2(sp)
;
;
	save	<r0>
	mov	4(sp)	,r0
	save	<r1,@#errsav>		; a scratch register
	sub	#12	,sp
	mov	sp	,r1
	calls	$cvti6	,<r1,r0>	; convert into a decimal str.
	.print	r1	,#6
	add	#12	,sp
	unsave	<@#errsav,r1>
	unsave	<r0>
	mov	(sp)+	,(sp)		; fix return address up
	return


	routine	$cvti6

;	write out a decimal number at 2(r5) into the buffer
;	address passed at 0(r5). All registers saved.


	save	<r0,r1,r2,r3>		; some scratch registers saved
	mov	(r5)	,r2		; the buffer address to use.
	mov	#6	,r3
1$:	movb	#32.	,(r2)+		; fill the buffer with blanks
	sob	r3	,1$
	mov	#6	,r3
	mov	(r5)	,r2
	mov	2(r5)	,r1		; reset buffer address and get
	bpl	10$			; > 0
	neg	r1			; < 0, make positive and insert
	movb	#'-	,@r2		; sign.
10$:	add	r3	,r2		; buffer address. Do it backward

2$:	clr	r0			; set up for the divide by 10.
	div	#10.	,r0		; remainder in r1, quotient r0
	add	#'0	,r1		; convert remainder to character
	movb	r1	,-(r2)		; and return the character now.
	mov	r0	,r1
	beq	3$
	sob	r3	,2$		; go back for more

3$:	unsave	<r3,r2,r1,r0>
	return				; thats all there is to it.



	.sbttl	write 2 word integer


	routine	$wrldec

;
;	write a 2 word decimal number passed at (r5) and 2(r5)
;
;
	save	<r0,r1>			; a scratch register or two
	sub	#12.	,sp		; allocate a buffer
	mov	sp	,r1		; and point to the buffer
	calls	$cvtli	,<r1,(r5),2(r5)>; convert into a decimal str.
	mov	#8.	,r0		; maximum length of the string
10$:	cmpb	@r1	,#'0		; remove leading zeroes and
	bhi	30$			; spaces
	inc	r1			; space or '0' so increment pointer
	sob	r0	,10$		; and look again
	br	100$			; nothing to do, exit
30$:	.print	r1	,r0		; print whats left of the string
100$:	add	#12.	,sp		; and pop the buffer
	unsave	<r1,r0>
	return


	routine	$cvtli

;	Convert a 2 word decimal number at 2(r5) and 4(r5) into 
;	ASCII at buffer address passed at 0(r5). All registers saved.


	save	<r0,r1,r2,r3>		; some scratch registers saved
	mov	(r5)	,r2		; the buffer address to use.
	mov	#8.	,r3
1$:	movb	#32.	,(r2)+		; fill the buffer with blanks
	sob	r3	,1$
	mov	#8.	,r3
	mov	(r5)	,r2
	add	r3	,r2		; buffer address. Do it backward
	asr	r3			; only try for 4 digits at a time
	mov	2(r5)	,r0
	mov	4(r5)	,r1
	div	#10000.	,r0		; divide it up to do part at a
	save	<r0>			; time. Get the high part saved
	calli	2$
	unsave	<r1>			; Do the lower part next
	mov	#3	,r3
	calli	2$
	br	3$

2$:	clr	r0
	div	#10.	,r0		; remainder in r1, quotient r0
	add	#'0	,r1		; convert remainder to character
	movb	r1	,-(r2)		; and return the character now.
	mov	r0	,r1
	sob	r3	,2$		; go back for more
	return

3$:	unsave	<r3,r2,r1,r0>
	return				; thats all there is to it.

	.sbttl	binary to octal conversion
;
;	convert binary number at 2(r5) to ascii string
;	at buffer address 0(r5).
;
	routine	$otoa

	save	<r0,r1,r2,r3>		; save the scratch regs.
	mov	(r5)	,r2
	mov	2(r5)	,r3
	mov	#6	,r0		; do it 6 times
	add	r0	,r2
1$:
	mov	r3	,r1		; get the number
	bic	#177770	,r1		; leave low order 3 bits on
	movb	digits(r1),-(r2) 	; move an octal digit
	ash	#-3	,r3		; shift three bytes
	bic	#160000	,r3		; zap propagated sign bits
	sob	r0	,1$		; go convert next digit

	unsave	<r3,r2,r1,r0>
	return


	.nlist	bex
digits:	.ascii	\01234567\	; ascii/octal digits
	.list	bex
	.even


	.sbttl	write octal to keyboard


	routine	$wroct

;	(r5)	=	value to write to KB:

	save	<r0>
	sub	#10	,sp
	mov	sp	,r0		; use stack for a buffer
	calls	$otoa	,<r0,(r5)>
	.print	r0	,#6
	add	#10	,sp
	unsave	<r0>
	return



	.sbttl	move character string


;	input:
;
;	  6(sp)		src address of string
;	  4(sp)		dst address
;	  2(sp)		length (zero implies .asciz move)
;	  0(sp)		return address


	nsave	=	6 + 2
	len	=	nsave + 0
	dst	=	nsave + 2
	src	=	nsave + 4

$movc::	save	<r0,r1,r2>		; save the three temps
	mov	src(sp)	,r1		; source string address
	mov	dst(sp)	,r2		; destination address
	mov	len(sp)	,r0		; anything length to do?
	beq	20$			; assume .asciz
10$:	movb	(r1)+	,(r2)+		; not .asciz
	.if	ne	,rt11		; rt11 today ?
	.ift				; yes
	dec	r0			; assume no 'SOB' instruction
	bne	10$			; more to come
	.iff				; not 11/03
	sob	r0	,10$		; please
	.endc				; for rt11 pdp 11/03 or PDT150
	br	100$			; exit

20$:	movb	(r1)+	,(r2)+		; .asciz copy
	bne	20$			; simple

100$:	unsave	<r2,r1,r0>		; pop temps
	mov	(sp)	,6(sp)		; bubble return address up now
	add	#6	,sp		; pop args and exit
	return				; bye



	.sbttl	convert rad50 word to 3 ascii bytes and back
;rdtoa
;		(r5)	=	address of where to put ascii chars
;	input	2(r5)	=	the value of rad 50 word
;
;
;
;procedure rd_toa( rval: integer ; var aout: array [1..3] of char ) ;
;
; type rlist = array [0..39] of char ;
; const
;      r50ch = rlist(' ','A','B','C','D','E','F','G','H','I','J','K',
;		    'L','M','N','O','P','Q','R','S','T','U','V','W',
;		    'X','Y','Z','$','.','?','0','1','2','3','4','5',
;		    '6','7','8','9' );
; var i: integer ;
; begin
;  aout[1] := r50ch[ rval div 3100B ]; rval := rval mod 3100B ;
;  aout[2] := r50ch[ rval div 50B ]  ; aout[3] := r50ch[ rval mod 50B ]
; end ;


rdtoa::
radasc::save	<r0,r1,r3>		; same some registers
	mov	2(r5)	,r1		; go get the rad50 character.
	mov	(r5)	,r3		; where to put the characters.
com:	clr	r0			; prepare for divide
	div	#3100	,r0		; get first char
	movb	radchr(r0),(r3)+ 	; put in buffer
	clr	r0			; another divide
	div	#50	,r0		; this one gives char 2
	movb	radchr(r0),(r3)+ 	; put this in buffer
	movb	radchr(r1),(r3)+ 	; and also char 3
	unsave	<r3,r1,r0>		; restore the registers we used.
	return				; bye

	.nlist	bex
radchr:	.ascii	/ ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789:/
	.list	bex
	.even

;ATORD
;	input:	(r5)	=	address of ascii chars
;	output:	 r0	=	rad50 word

atord::
ascrad::save	<r1,r2,r3,r4>		; save the scratch registers .
	mov	(r5)	,r4		; the address of the ASCII str.
	clr	r3
	mov	#3	,r0
1$:	mov	#radchr	,r1
	mov	#40.	,r2
2$:	cmpb	(r4)	,(r1)+
	beq	3$			; Found the character. EXIT loop
	sob	r2	,2$
	mov	#40.	,r2
3$:	dec	r2
	mul	#40.	,r3		; We accumulate the RAD50 chars
	sub	r2	,r3		; in r3. R1 has the next  rad50
	add	#39.	,r3
	tstb	(r4)+			; to add on. Move to  the  next
	sob	r0	,1$		; byte ( for a total of 3 bytes)

	mov	r3	,r0
	unsave	<r4,r3,r2,r1>		; return result in r0 and return
	return


	.sbttl	put lines and buffer them for disk i/o

;
;	input:	 (r5)	=	channel buffer address
;		2(r5)	=	channel number
;		4(r5)	=	string (line) address.
;		6(r5)	=	string length in bytes
;
;
	.if eq	,rsx11m			; for RSTS
	.ift

$putli::call	$putrec
	return


	.iff				; for RSX

$putli::mov	r0	,-(sp)		; used for a temp
	mov	r1	,-(sp)		; also
	mov	6(r5)	,r0		; size of the record to write
	ble	10$			; only a cr/lf
	mov	4(r5)	,r1		; line address to put out.
	add	r0	,r1		; point to the end
	cmpb	-(r1)	,#lf		; line feed (should be there)
	bne	10$			; ok
	dec	r0			; reduce record length by one.
	ble	10$			; nothing is left there.
	cmpb	-(r1)	,#cr		; should be there
	bne	10$			; no
	dec	r0
	
;;10$:	calls	rputrc	,<4(r5),r0,2(r5)>
10$:	mov	r0	,-(sp)		; allocate buffer for byte count
	mov	2(r5)	,r1		; get channel number, then get
	asl	r1			; record format
	bit	#r.fix	,rc$fmt(r1)	; fixed length ?
	bne	15$			; yes
	mov	sp	,r1		; point to record size
	calls	$putre	,<@r5,2(r5),r1,#2>; and insert it into buffer
15$:	tst	(sp)+			;   pop small buffer
	calls	$putre	,<@r5,2(r5),4(r5),r0>
	bit	#1	,r0		; what about odd record length?
	beq	20$			; ok
	calls	$putre	,<@r5,2(r5),#200$,#1>
20$:	mov	2(r5)	,r1		; compute maximum record size
	asl	r1			; index into mx$siz
	cmp	r0	,mx$siz(r1)	; well ?
	blos	30$			; ok so far
	mov	r0	,mx$siz(r1)	; no, fix max record size
30$:	mov	(sp)+	,r1
	mov	(sp)+	,r0
	return

200$:	.byte	0,0

	.endc

$putrec::
	clr	@#errsav
	save	<r0,r1,r2,r3,r4>	; always save scratch registers
	mov	(r5)	,r0		; the buffer address for chan.
	mov	2(r5)	,r1		; and the channel number to use
	mov	4(r5)	,r2		; also the string address
	mov	6(r5)	,r3		; and  the string length.
	ble	10$			; Be sure that we have something

	asl	r1			; convert to channel # times 2
1$:	cmp	bufpnt(r1),@#bufsiz	; See if our buffer is full yet
	blt	2$			; if not, then room for next ch

	  save	<r2>			; Buffer is full. Write  next
	  mov	r1	,r2		; block out to disk.
	  inc	blknum(r2)
	  asr	r1			; the channel number to write.
	  calls	$putbl	,<r0,@#bufsiz,r1,blknum(r2)>
	  save	<r4,r5>			; fix up the block number by
	  clr	r4			; taking into consideration
	  mov	@#bufsiz,r5		; the current blocking factor.
	  div	#512.	,r4		; blockcount
	  dec	r4			; -1
	  add	r4	,blknum(r2)
	  unsave	<r5,r4>
	  unsave	<r2>
	  iferr	10$			; Exit if any errors on write.
	  asl	r1			; get channel number times  2.
	  clr	bufpnt(r1)		; and clear out the buffer pnt

2$:	mov	r0	,r4		; the buffer address
	add	bufpnt(r1),r4		; get set to get the next char
	movb	(r2)+	,(r4)		; transfer it to the buffer.
	inc	bufpnt(r1)		; and fix our pointer up
	sob	r3	,1$		; repeat for the entire string

10$:	unsave	<r4,r3,r2,r1,r0>
	return


	.sbttl	print line number for terminal

	routine	lineno

;
;	input	(r5)	=	number to print
;
;
	.wrdec	(r5)
	.print	#1$
	return

1$:	.asciz	/ )/
	.even





$$open::mov	r5	,-(sp)
	mov	sp	,r5
	add	#4	,r5
	call	$open
	mov	(sp)+	,r5
	mov	@sp	,4(sp)
	cmp	(sp)+	,(sp)+
	return

	global	<$open>

$$clos::mov	r5	,-(sp)
	mov	sp	,r5
	add	#4	,r5
	call	$close
	mov	(sp)+	,r5
	mov	(sp)+	,(sp)
	return

	global	<$close>

	.end
