.title	io

;+	IO	- I/O routines for KOM
;
; Edit history (from 03-Apr-86 21:24:01)
;
;	Date		What /Who
;	03-Apr-86	Added new terminal type(s) /JS
;	09-May-86	
;	09-Aug-86	Fixed some small (but fatal) bugs
;	23-Aug-86	Added support for new TERMINAL definitions
;			(removed support for old style terminal types)
;	01-Nov-86	Added RUBOUT routine 
;	13-Nov-86	Deleted RUBOUT routine
;- 

	.inclu	"b:global.mac"
	
	romnum	= true			; We want roman numerals to work

	sect	code

STROUT:
	push	<r0, r1>
	clr	r0
	bisb	(r1)+, r0
	call	Print
	pop	<r1, r0>
	rts	pc

;+	STROUF does a formatted print of a text string.
;
; Input: 
;	r0 contains format
;	r1 pointer to STRING
; Formats:
;	0  	No formatting.
;	pos.	Right justified.
;	neg.	Left justified.
;-	
STROUF:
	push	<r0, r1, r2, r3>
	clr	r3
	bisb	(r1), r3		; Length of string to r3
	mov	r0, r2
	bpl	10$
	neg	r0
10$:	sub	r3, r0			; r0 will contain # of spaces
	ble	50$
	tst	r2	
	bpl	40$
	call	STROUT
	bcs	99$
	call	SpcOut			; Output spaces
	br	99$
40$:	call	SpcOut
50$:	call	STROUT
99$:	pop	<r3, r2, r1, r0>
	rts	pc

SpcOut:	push	r1
	mov	#40, r1
	call	String
	pop	r1
	rts	pc

PCR2LF:	call	PCRLF			; Print two CRLFs
	bcc	PCRLF
	rts	pc

PCRLF:					; Print a CRLF
	push	r1
	write	#CRLF
	pop	r1
	rts	pc

PCR:					; Print a CR
	push	r0
	mov	#CR, r0
	call	ttyout
	pop	r0
	rts	pc

PLF:					; Perform LF
	push	r1
	write	#LFchar
	pop	r1
	rts	pc
	
; Print a string after stripping parity
; r0 = length, r1 = pointer to RW memory
xPrint:
	push	<r2, r3>
	cmp	r1, #RTSBEG		; RO memory?
	bhis	20$			; Don't strip in that case
;	blo	7$
;	push	<r0>
;	mov	#'~, r0
;	call	ttyout
;	clr	r0
;	call	deco16
;	pop	<r0>
;	br	20$
7$:	
;	push	r0
;	mov	#'_, r0
;	call	ttyout
;	pop	r0

	mov	r1, r3
	mov	r0, r2
	beq	20$
10$:	bicb	#200, (r3)+
	sob	r2, 10$
20$:	pop	<r3, r2>
	jmp	PrintN

Print:
;	cmp	@#Pterm, #-1
	tstb	TTFlag			; Ask for "return" ?
	bmi	2$			; Negative means DON'T
;	beq	2$
	tst	@#Line			; Clear Carry!
	bpl	3$
2$:
;	jmp	xPrintN
	jmp	PrintN
3$:	tst	UtmFlg
	bne	5$
	bit	#UtmOn, KSW
	beq	5$
;	jmp	xPrintN
	jmp	PrintN	

5$:	push	r0
	ble	30$
	push	<r2, r1>
	mov	r0, r2
	mov	r1, r0
;10$:	cmp	r0, #RTSBEG		; This may take some time...
;	bhis	11$
;	bicb	#200, (r0)		; Strip sign bit => uparrow
10$:	cmpb	(r0)+, #LF
	bne	20$
	sub	r1, r0			; String length to r0
;	call	xPrintN			; Write it
	call	PrintN			; Write it
	add	r0, r1
	mov	r1, r0
	inc	@#Line
	sub	#2, @#MaxLin
	cmp	@#Line, @#MaxLin
	bhis	13$
	add	#2, @#MaxLin
	br	20$

13$:	add	#2, @#MaxLin
	clr	@#Line
	gos	PresCr,	<#endq-begq, #Begq> ; Write 'Tryck p} RETURN'
	bcc	15$			; Somebody pressed a non-CR char

	bit	#1, TTflag
	beq	25$
	call	clrcrt
	br	25$

15$:	bit	#1, TTflag
	beq	20$
	call	clrcrt
20$:	sob	r2, 10$
	sub	r1, r0
	call	PrintN

	tst	(pc)+

25$:	sec

	pop	<r1, r2>
30$:	pop	r0
	rts	pc
	

proc	PresCr,	<Len, Pos>

begin
	push	<r0, r1>

	mov	Len(r5), r0
	mov	Pos(r5), r1

	call	CTRLO			; Make wonders!
	bcs	130$			; and exit if ^O was pressed.
	call	PrintN
	sub	#12., sp		; Make room for a small buffer on stack
	call	clrxrb
	mov	#10., (r1)+
	tst	(r1)+
	mov	sp, (r1)
	.read
	mov	xrb+xrbc, r1
	add	sp, r1
	clrb	(r1)			; Make it ASCIZ

	call	CATA			; Cancel all typeahead
	
	movb	(sp), r1
	call	PCR			; Erase the '(Tryck p}..' text
	mov	Len(r5), r0
	call	erol
	call	PCR
	cmp	r1, #'0
	blo	99$
	cmp	r1, #'9
	bhi	99$			; The user doesn't want the rest!

	mov	sp, r1
101$:
	cmpb	(r1), #'0
	blo	102$
	cmpb	(r1), #'9		; Check if it's a 2 (or less) digit #
	bhi	102$
	inc	r1
	br	101$

102$:	cmpb	(r1), #40		; Just a number?
	blos	103$
	add	#12., sp
	br	120$
					; IT IS a number!
103$:	mov	r1, r0
	mov	sp, r1
	sub	r1, r0
	call	val16
	mov	r0, r1
	clr	r0
	mov	@#MaxLin, @#Line		     
	div	@#Line, r0
	sub	r1, @#Line
	inc	@#Line
	add	#12., sp
	clc
	br	130$

99$:	add	#12., sp
	cmp	r1, #CR	
	beq	105$
	cmp	r1, #27.		; Escape?
	bne	120$

	mov	@#MaxLin, @#Line	; One line forward.
105$:	clc
	br	130$

120$:	sec
130$:	pop	<r1, r0>
	ret

proc	PrCrLf,	<Lines, LinLft>

begin
	push	<r2, r1, r0>
	mov	#CrlfT, r1
	mov	#2, r0
	call	PrintN
	tstb	TTflag
	bmi	999$
3$:	tst	UtmFlg
	bne	5$
	bit	#UtmOn, KSW
	bne	999$

5$:	inc	@#Line	
	sub	#2, @#MaxLin
	cmp	@#Line, @#MaxLin
	bhis	10$
	add	#2, @#MaxLin
	clc
	br	999$

10$:	add	#2, @#MaxLin
	clr	Line
	mov	#TmpStr+100, r2
	movb	#'), -(r2)
	movb	#'%, -(r2)
	mov	Lines(r5), r0
	sub	LinLft(r5), r0
	mul	#100., r0
	div	Lines(r5), r0
	mov	r0, r1
20$:	clr	r0
	div	#10., r0
	add	#'0, r1
	movb	r1, -(r2)
	mov	r0, r1
	bne	20$
	mov	#PrCrEn, r1
	mov	#PrCrEn-PrCrBe, r0
15$:	movb	-(r1), -(r2)
	sob	r0, 15$
	mov	#TmpStr+100, r0
	sub	r2, r0
	gos	PresCr,	<r0, r2>

999$:	pop	<r0, r1, r2>
	ret

PrintN:	push	r0
	ble	40$
	push	r1
	tst	UtmFlg
	bne	20$
	bit	#UtmOn, KSW
	beq	20$

	push	r2
	mov	r0, r2
10$:	clr	r0
	bisb	(r1)+, r0
	call	PutChU
	sob	r2, 10$
	pop	r2
	mov	2(sp), r0
	br	30$

20$:	call	clrxrb
	mov	r0, (r1)
	mov	(r1)+, (r1)+
	mov	(sp), (r1)
	;.ttrst
	.write
30$:	add	r0, @#Out
	pop	r1
40$:	pop	r0
	clc
	rts	pc
	
Readln:	push	<r0, r1>
	trap	1			; clrxrb
	mov	#177, (r1)+
	clr	(r1)+
	mov	#TmpStr+1, (r1)
	.read
	mov	xrb+xrbc, r0
	mov	r0, r1
	add	#TmpStr, r1
	inc	r1
10$:	cmpb	-(r1), #40
	bhis	20$
	dec	r0
	bne	10$

20$:	movb	r0, TmpStr	
	pop	<r1, r0>
	rts	pc

TTYIN:	
	push	r1
	call	clrxrb			
	clr	-(sp)			; Local var.
	inc	(r1)+
	tst	(r1)+
	mov	sp, (r1)
	mov	@#TimLim, xrb+xrtime
	.ttddt
	.read
	cmpb	firqb, #15.		; Wait time exhausted?
	beq	20$
	cmp	(sp), #CR
	bne	10$
	jsr	pc, TTYIN
10$:	tst	(pc)+
20$:	sec
	pop	<r0, r1>
	rts	pc

TTYOUT:	
	push	<r1, r0>
	tst	UtmFlg			; Output to File?
	bne	10$
	bit	#UtmOn, KSW		; Is it wanted too?
	beq	10$
	call	PutChU			; Output it on file!
	br	20$

10$:	call	clrxrb
	inc	(r1)
	mov	(r1)+, (r1)+
	mov	sp, (r1)+
	;.ttrst
	.write
20$:	inc	@#Out
	tst	(sp)+
	pop	r1
	rts	pc

; Put character in r0 to Output file. (as set by "Utmatning...")

PutChU:	push	r1
	mov	UtmPtr, r1
	movb	r0, (r1)+
	cmp	r1, #EOFBU
	blo	10$
	gos	put <#7, , #FBU>
	mov	#FBU, r1
	inc	UtmBlk
10$:	mov	r1, UtmPtr
	pop	r1
	rts	pc

;+ RUBOUT THE CHARACTER IN R0
;-
;RUBOUT:
;	TST	TTFLAG			; PAPER TERMINAL?
;	BMI	TTYOUT
;	PUSH	R1
;	WRITE	#RUBSTR
;	POP	R1
;	RTS	PC

; EROL takes one arguments - r0, which contains the length of the rest of line

EROL:	
	push	r1
	clr	r1			; First entry in the term def, 0 based
	call	getdef			; Show the string (or dont't)
	bcc	10$
	Call	SpcOut
	mov	#10, r1
	call	String
10$:	pop	r1
	rts	pc
	
getdef:
	push	<r0, r2>
	mov	#TTdefs, r2
	tst	r1
	beq	20$

10$:	clr	r0
	bisb	(r2)+, r0
	add	r0, r2
	sob	r1, 10$

20$:	mov	r2, r1
	bitb	#177, (r1)		; An existing sequence for this term?
	beq	80$
	clr	r2
	movb	(r1)+, r0
	bpl	30$
	dec	r0
	bic	#^c177, r0
	mov	r0, r2
	add	r1, r2
	movb	(r2), r2
30$:	call	PrintN
	mov	r2, r0
	clr	r1
	call	String			; Issue fillers
	tst	(pc)+
80$:	sec
	pop	<r2,r0>
	rts	pc

;EROL:	push 	<r1, r0>
;	ble	xit
;	mov	@#PTerm, r1
;	bne	9$			; Dumb CRT
;	Call	SpcOut
;	mov	#10, r1
;	call	String
;	br	xit
;
;9$:	cmp	#-1, r1
;	beq	20$
;	call	Tdlook
;	br	xit
;20$:	call	PLF			; Paper-terminal
;	br	xit

; Eral erases all of a line

ERAL:	push	<r0, r1>
	call	PCR
	clr	r1
	call	getdef
	bcc	10$
	mov	Width, r0
	call	SpcOut
	call	PCR
10$:	pop	<r1, r0>
	rts	pc

;Eral:	push	r0
;	call	PCR			; Return the Carriage!
;	mov	@#Width, r0
;	cmp	@#PTerm, #-1
;	bne	10$
;	call	PLF			; Paper terminal
;	br	90$
;
;10$:	tst	@#PTerm
;	bne	20$
;	call	SpcOut			; Dumb CRT
;	call	PCR
;	br	90$
;
;20$:	call	Erol			; Clever CRT
;90$:	pop	r0
;	rts	pc

ClrCRT:
	push	<r0, r1>
	mov	#1, r1			; Second entry in ter def block
	call	getdef
	bcc	10$
	call	PCR
	mov	#12., r0
	call	TTYOut
10$:	pop	<r1, r0>
	rts	pc

;ClrCrt:	push	<r0, r1>
;	mov	@#PTerm, r1
;	bne	20$
;10$:	call	PCR
;	mov	#12., r0
;	Call	TtyOut
;	br	xit
;
;20$:	cmp	#-1, r1
;	beq	10$
;
;	movb	(r1)+, r0
;	bic	#177600, r0
;	add	r0, r1
;	call	Tdlook
;	call	PCR
;xit:	pop	<r0, r1>
;	rts	pc
	
;TDlook:	movb	(r1)+, r0		; Else - look in the TD Block
;	mov	r0, -(sp)	
;	bpl	6$
;	bic	#177600, r0
;	dec	r0
;6$:	call	PrintN			; Do a Non-CR-checking print
;
;	tst	(sp)+
;	bpl	10$
;	add	r1, r0
;	movb	(r0), r0
;	bic	#177400, r0
;	clr	r1
;	call	String			; Issue fillers
;10$:	rts	pc		
;	
proc	String
	Var	buf,	132.
	begin
	push	<r2, r1>		; Print r0 number of chr(r1)'s
	tst	r0
	beq	20$
	mov	#buf, r2
	add	r5, r2
	push	<r0, r2>

10$:	movb	r1, (r2)+
	sob	r0, 10$
	pop	<r1, r0>
	call	PrintN
20$:	pop	<r1, r2>
	ret

CCOff:	
	push	r1
	call	clrfqb
	movb	#uu.trm, firqb+fqfun
	movb	#377, firqb+5		; Current KB
	movb	#203, firqb+30		; CTRL-C as delimiter
	.uuo
	call	error
	pop	r1
	rts	pc
	
CCOn:
	push	r1
	call	clrfqb
	movb	#uu.trm, firqb+fqfun
	movb	#377, firqb+5		; Current KB
	movb	#200, firqb+30		; No delimiter
	.uuo
	call	error
	pop	r1
	rts	pc

	
proc	Get <chnl, blk, adr, amnt, unlock>
	Begin	
	push	<r0, r1, r2>
	clr	r2
	tst	chnl(r5)
	bpl	3$
	inc	r2
	neg	chnl(r5)
	
3$:	bit	#xDEB, MyFlag		; Debug?
	beq	5$
	push	KSW
	bic	#UtmOn, KSW
	mov	#'G, r0
	call	ttyout
	mov	blk(r5), r0
	call	nout
	mov	#40, r0
	call	ttyout
	mov	chnl(r5), r0
	call	nout
	call	PCRLF
	pop	KSW
5$:	asl	chnl(r5)		; Channel-number*2
	mov	amnt(r5), r1
	ash	#9., r1
10$:	mov	#xrb, r0
	mov	r1, (r0)+
	clr	(r0)+
	mov	adr(r5), (r0)+
	mov	chnl(r5), (r0)+
	mov	blk(r5), (r0)
	.read	
	tst	r2
	beq	15$
	cmpb	firqb, #11.		; EOF?
	beq	40$

15$:	cmpb	firqb, #19.		; Was the block available?
	bne	20$
	
	mov	#1, xrb
	.sleep				; Wait for block to be free!
	br	10$			; Try again!

20$:	call	ioerr
	tst	unlock(r5)		; Shall we unlock the block?
	beq	30$			; Nope, skip unlocking section
	
	mov	#1, xrb			; Release Implicit lock
	mov	chnl(r5), xrb+xrci
	.spec
	call	error			; Debuggin'

30$:	mov	adr(r5), r0
	mov	blk(r5), -(r0)
	tst	(pc)+
40$:	sec
	pop	<r2, r1, r0>
	Ret

Proc	Put <chnl, blk, adr>
Begin
	push	r0
	bit	#xDEB, MyFlag		; Debug section
	beq	10$
	push	KSW
	bic	#UtmOn, KSW
	mov	#'P, r0
	call	ttyout
	mov	blk(r5), r0
	bne	5$
	mov	adr(r5), r0
	mov	-(r0), r0
5$:	call	nout
	mov	#40, r0
	call	ttyout
	mov	chnl(r5), r0
	call	nout
	call	PCRLF
	pop	KSW
10$:	asl	chnl(r5)
	mov	#xrb, r0
	mov	#1000, (r0)
	mov	(r0)+, (r0)+
	mov	adr(r5), (r0)+
	mov	chnl(r5), (r0)+
	mov	blk(r5), (r0)
	bne	20$			; Use block currently in buffer if
	sub	#2, adr(r5)		;   BLK=0
	mov	@adr(r5), (r0)
	add	#2, adr(r5)		; Temporary
20$:	.write	
	call	ioerr
	cmp	(r0), #2
	bne	30$
	cmp	chnl(r5), #2
	bne	30$
	push	r1
	mov	adr(5), r1
	cmp	46(r1), #4
	beq	25$
	write	#tjohej
25$:	pop	r1
30$:	pop	r0
	Ret

;+ Gets a specified record (cluster) from a given file.	
; (This routine works only on files 1-4, for file 5 - use the FysTxt routine)
; The block # which was read from disk is returned in r0.
; A pointer to the read cluster is returned in r1
;-

Proc	GetRec <chnl, rec, adr, unlock>
	Begin
	bit	#xDEB, MyFlag
	beq	7$
	Write	#rnum
	mov	rec(r5), r1
	mov	#-6, r0
	call	deco16
7$:
	mov	chnl(r5), r0
	bpl	10$			; No EOF report support.
	neg	r0
10$:	mov	rec(r5), r1
	call	R.to.B
	add	adr(r5), r1
	gos	Get <chnl(r5), r0, adr(r5), #1, unlock(r5)>
	Ret

;+ Tries to find the record in the specified buffer
; Same parameters as with GetRec
;-
Proc	TstRec	<chnl, rec, adr>
	Begin
	push	r2
	mov	chnl(r5), r0
	mov	rec(r5), r1
	mov	adr(r5), r2

	call	R.to.B
	cmp	-2(r2), r0
	bne	10$
	bit	#xDEB, MyFlag
	beq	20$
	push	<r1, r0, KSW>
	write	#rnum
	mov	rec(r5), r1
	mov	#-6, r0
	call	deco16	

	bic	#UtmOn, KSW
	mov	#'(, r0
	call	ttyout
	mov	(sp), r0
	call	nout
	mov	#40, r0
	call	ttyout
	mov	chnl(r5), r0
	call	nout
	mov	#'), r0
	call	ttyout
	call	PCRLF
	pop	<KSW, r0, r1>
20$:	add	r2, r1
	tst	(pc)+
10$:	sec
	pop	r2
	Ret

Proc	TryRec <chnl, rec, adr, unlock>
	Begin
	gos	TstRec <chnl(r5), rec(r5), adr(r5)>
	bcc	10$
	gos	GetRec <chnl(r5), rec(r5), adr(r5), unlock(r5)>
10$:	Ret

Proc	PutGet	<chnl, rec, adr>
	Begin
	gos	TstRec	<chnl(r5), rec(r5), adr(r5)>
	bcc	10$
	gos	Put	<chnl(r5),, adr(r5)>
	gos	Getrec,	<chnl(r5), rec(r5), adr(r5),>
10$:	Ret

;+	R.to.B converts a record # to a block #
; Data passed:	 r0, channel #
;		 r1, record number.
; Data returned: r0, block #
;		 r1, Offset in block.
;-
R.to.B:	push	r3
	asl	r0
	mov	CluSiz-2(r0), r3	; Get file cluster size to r3
	mov	NClus-2(r0), -(sp)	; # of clusters per block
	cmp	r0, #8.
	blo	10$
	cmp	r0, #6.*2
	beq	10$			; File 6 special hack
	add	(sp), r1
10$:	dec	r1
	clr	r0

	call	Ldiv			; Block to r0/r1, cluster on stack
	mov	r1, r0
	pop	r1

	inc	r0
	mul	r3, r1
	pop	r3
	rts	pc

;+	Spawn finds an empty cluster in the specified file
; Data passed:	r0, File #
;		R1, Address of file buffer
; Data retunred: r0, Block #
;		 R1, Pointer to the found cluster. The word at @r1 contains
;		     the cluster number.
;-
Proc	Spawn
Var	FreLst,	word
Var	FreRec, word

	Begin
	push	<r2, r3, r4>
	cmp	r0, #3			; File 3 ?
	bne	10$
	movb	#21, firqb
	call	error	

10$:	mov	r0, r2			; File # to r2
	mov	r2, r4
	asl	r4
	mov	r1, r3			; Buffer address to r3

	gos	Get <r2, #1, r3, #1,>	; Get block #1
	call	ExLock

	mov	(r3), FreRec(r5)
	mov	2(r3), FreLst(r5)
	bne	30$

	push	r3			; Clear the whole block.
	mov	#400, r0
15$:	clr	(r3)+
	sob	r0, 15$
	pop	r3

	mov	FreRec(r5), (r3)	; First word will contain rec #
	inc	FreRec(r5)
	mov	FreRec(r5), FreLst(r5)	; Some new clusters will be created!

	mov	NClus-2(r4), r0
	sub	#2, r0

	push	r3
20$:	add	CluSiz-2(r4), r3	; Produce an array of free.
	clr	(r3)			; 0=LEDIG
	inc	FreRec(r5)
	mov	FreRec(r5), 2(r3)	; Next LEDIG
	sob	r0, 20$
	inc	FreRec(r5)
	pop	r3

	mov	(r3), r1		; Next free cluster (FreRec)
	cmp	r2, #4
	blo	25$
	cmp	r2, #5
	bhi	25$
	sub	NClus-2(r4), (r3)	; Special case for files 4-5

25$:	dec	r1
	clr	r0
	div	NClus-2(r4), r0
	inc	r0			; Block number in r0
	gos	put <r2, r0, r3>	; Expand the file.
	call	60$			; Put block 1
	gos	get <r2, r0, r3, #1,>
	mov	r3, r1
	br	50$
	
30$:	mov	FreLst(r5), r0
	cmp	r2, #4
	blo	40$
	sub	NClus-2(r4), r0
40$:	push	r0
	gos	GetRec <r2, r0, r3,>
	mov	2(r1), FreLst(r5)	; Get next free record number
	call	60$			; Put block #1
	mov	(sp), r0
	gos	GetRec <r2, r0, r3,>
	pop	(r1)			; First word contains cluster #
	clr	2(r1)
	
50$:	mov	#xrb, r3
	mov	#3, (r3)+
	mov	#1, (r3)+		; Block #1
	clr	(r3)+
	mov	r4, (r3)
	.spec				; Release Ex-lock (on block #1)
	call	ioerr			; Debugin'

	pop	<r4, r3, r2>
	Ret

60$:	mov	#FreRec, r1		; 
	add	r5, r1
	gos	Put <r2, #1, r1>	; Write updated block 1
	rts	pc
	
;+	Dispos makes unused records part of the free record list
;
Proc	Dispos	<chnl,rec,adr>
	begin
	push	<r0, r1, r2>
	mov	adr(r5), r1
	mov	chnl(r5), r0
	gos	Get <r0, #1, r1, #1,>
	call	Exlock
	push	(r1)
 	push	2(r1)
	gos	GetRec <r0, rec(r5), r1,>
	mov	r0, r2
	tst	(r1)
	bne	7$

	cmp	(sp)+, (sp)+
	write	#WrnDsp
	mov	rec(r5), r1
	mov	#6, r0
	call	deco16
	call	PCRLF
	mov	chnl(r5), r0
	call	Releas
	br	999$

7$:	clr	(r1)+
	pop	(r1)+
	mov	chnl(r5), r0
	asl	r0
	mov	CluSiz-2(r0), r0
	asr	r0
	dec	r0
	dec	r0
10$:	clr	(r1)+
	sob	r0, 10$
	mov	chnl(r5), r0
	mov	adr(r5), r1
	gos	put <r0, r2, r1>
	pop	(r1)
	mov 	rec(r5), 2(r1)
	mov	r0, r2
	asl	r2
	cmp	r2, #8.
	blo	20$
	add	NClus-2(r2), 2(r1)	; Special case with files 4 & 5
20$:	gos	put <r0, #1, r1>
	mov	#xrb, r0
	mov	#3, (r0)+
	mov	#1, (r0)+
	clr	(r0)+
	mov	r2, (r0)
	.spec
	call	IOERR
999$:	pop	<r2, r1, r0>
	ret

;+	Releas releases the implicit lock on a specified channel
; Data passed:	r0, Channel number
;-
Releas:	
	clr	xrb			; Release ex, and implicit lock
	mov	r0, xrb+6
	asl	xrb+6
	.spec
	call	ioerr
	rts	pc

;+
; UnlBlk unlocks a block
; Data passed 	r0, Chanel number
;		r1, Block number
;-
UnlBlk:
	mov	#3, xrb
	mov	r1, xrb+xrbc
	clr	xrb+xrloc
	mov	r0, xrb+xrci
	asl	xrb+xrci
	.spec
	call	ioerr
	rts	pc

;+	ExLock converts the current implicit lock into an explicit one.
; Data passed:	r0, Channel number
;-
ExLock:
	mov	#2, xrb
	mov	r0, xrb+xrci
	asl	xrb+xrci
	.spec
	call	ioerr
	rts	pc

;+	FysTst converts a locigal TEXT-number to the corresponding physical.
; If the specified text already is in memory no get is performed.
; Data passed:	R0, Address of the file buffer to be used temporarily.
;		R1, Address of a long number.
; Data returned: R0, Physical TEXT number.
;-
FysTst:	
	push	<r2, r1, r0>
	mov	(r1)+, -(sp)
	mov	(r1), r0
	mov	(sp)+, r1
	call	rtob5
	pop	r2
	cmp	-2(r2), r0		; Have we got that one already?
	beq	10$
	gos	get <#5, r0, r2, #1, #Unlock>
10$:	add	r1, r2
	mov	(r2), r0
	pop	<r1, r2>
	rts	pc

;+	FysTxt converts a logical text # to the corresponding physical.
; Data passed:	 R0, pointer to a file buffer to be used temporary.
;		 R1, pointer to a long (logical) text number.
; Data returned: R0, Physical text number.
;-
FysTxt:	
	clr	-2(r0)
	br	FysTst

proc	FysLin	<nnn, ptr, adr>
	begin
	push	<r0, r1, r2>
	mov	ptr(r5), r2
	mov	(r2)+, r1
	mov	(r2), r0
	call	rtob5			; r0 will contain block #, r1 pos.
	mov	adr(r5), r2
	gos	get <#5, #1, r2, #1,>
	cmp	r0, (r2)		; Within file?
	blo	10$

	push	r0
	mov	#5, r0
	call	exlock
	pop	r0
	inc	(r2)
	gos	put <#5, , r2>
	mov	r0, -2(r2)		; Force this block to be put.
	br	20$
	
10$:	gos	get <#5, r0, r2, #1,>

20$:	add	r2, r1
	mov	nnn(r5), (r1)
	gos	put <#5, , r2>
	mov	#5, r0
	call	releas
	pop	<r2, r1, r0>
	ret

;+ Grein4 creates a specified group in file 4.
; Data passed:	 R0, Group number.
;		 R1, Pointer to file buffer.
; Data returned: R0, ????
;		 R1, Pointer to record (in core)
;-
Crein4:	push	<r2, r3>
	mov	r1, r2
	mov	r0, r3
10$:	gos	getrec <#-4, r3, r2,>
	bcc	20$			; N E B ?
	gos	get <#4, #1, r2, #1,>	; Yes! Create it!
	mov	r0, -2(r2)		; R0 contains block number to create
	mov	#4, r0
	call	ExLock
	gos	put <r0, ,r2>		; Extend file.
	call	Releas
	br	10$
20$:	pop	<r3, r2>
	rts	pc
	
rtob5:					; Converts r0/r1 to block, and pos.
	push	<r2, r3>
	add	#511., r1
	adc	r0
	mov	#10, r2
	clr	r3

10$:	ror	r0
	ror	r1
	ror	r3
	sob	r2, 10$
	ashc	#-7, r2
	mov	r1, r0
	mov	r3, r1
	add	HshEnd, r0
	pop	<r3, r2>
	rts	pc

;Call: r1 contain word to be translated.
;Return: Pointer in r1 and length in r0.

Num16:	
	push	r2
	mov	#TmpStr+200, r2
10$:	clr	r0
	div	#10., r0
	add	#'0, r1
	movb	r1, -(r2)	
	mov	r0, r1
	bne	10$
30$:	mov	r2, r1
	mov	#TmpStr+200, r0
	sub	r1, r0
	pop	r2
	rts	pc	

Num32:

	push	r2
	mov	#TmpStr+200, r2
10$:	push	#10.
	call	LDiv
	add	#'0, (sp)
	movb	(sp)+, -(r2)
	tst	r1
	bne	10$
	tst	r0
	bne	10$
	mov	r2, r1
	mov	#TmpStr+200, r0
	sub	r1, r0
	pop	r2
	rts	pc

Deco16:					; Number in r1, format in r0
.if df romnum
	bit	#xFOO, MyFlag
	beq	1$
	cmp	r1, #5000.		; Too big to latinize?
	bhi	1$
	bit	#100200, r0
	ble	2$
	clr	r0
2$:	jmp	ROMAN
.endc

1$:	push	<r0, r3, r2, r1>
	push	r0
	clr	r3
	bit	#100200, r0		; Leadin' zeroes
	ble	5$			; No!
	mov	r0, r3
	bic	#177600, r3
	clr	(sp)
	
5$:	mov	#TmpStr+200, r2
10$:	clr	r0
	div	#10., r0
	add	#'0, r1
	movb	r1, -(r2)	
	mov	r0, r1
	tst	r3
	beq	20$
	sob	r3, 10$
	br	30$
	
20$:	tst	r1			; Zero quotient?
	bne	10$
30$:	mov	r2, r1
	mov	#TmpStr+200, r2
	sub	r1, r2
	movb	r2, -(r1)
	pop	r0
	call	StrouF
	pop	<r1, r2, r3, r0>
	rts	pc

deco32:	
	tst	2(r1)			; > 65535. ?
	bne	5$
	mov	(r1), r1
	br	deco16

5$:	push	<r2, r1, r0>
	mov	#TmpStr+200, r2
	mov	2(r1), r0
	mov	(r1), r1
10$:	push	#10.
	call	LDiv
	add	#'0, (sp)
	movb	(sp)+, -(r2)
	tst	r1
	bne	10$
	tst	r0
	bne	10$
	mov	#TmpStr+200, r0
	sub	r2, r0
	movb	r0, -(r2)
	write	r2, (sp)+
	pop	<r1, r2>
	rts	pc

	
.if df romnum
ROMAN:		
	push	<R1, R2, R3, R4, R0>
	tst	r1
	bne	5$
	mov	#nihil, R1
	br	90$
5$:	mov	#tmpstr+100, r4
	mov	#25., r2
	clr	r3
	clr	r0

30$:	div	CT(r3), r0
	beq	10$
	push	r1
	mov	STR(r3), r1

40$:	movb	r1, (r4)+
	swab	r1
	beq	20$
	movb	r1, (r4)+
20$:	swab	r1
	sob	r0, 40$
	
	pop	r1
	
10$:	add	#2, r3
	sob	r2, 30$

	sub	#tmpstr+100, R4
	mov	#tmpstr+77, R1
	movb	r4, (R1)
90$:	pop	r0
	call	strouf
	pop	<r4, r3, r2, r1>
	rts	pc	
.endc

IOERR:	
	tstb	firqb
	bne	10$
	rts	pc

10$:	clr	Innept			; Exit on ctrl-c trap
	push	<r0, r1, r2, r3, firqb>
	mov	xrb+xrblk, r2
	movb	xrb+xrci, r3
	write	#IOERR1
	mov	12(sp), r1
	cmp	-(r1), -(r1)
	mov	-(r1), r0
	bic	#177400, r0
	call	nout
	call	PCRLF
	write	#IOErr2
	mov	r2, r0
	call	Nout
	call	PCRLF
	write	#IOErr3
	mov	r3, r0
	call	nout
	call	PCRLF
	write	#IOErr4
	mov	sp, r1
;	sub	#12+20, r1
	mov	#stack, r0
	sub	r1, r0
	asr	r0
	call	dump
	pop	<firqb, r3, r2 ,r1, r0>
	jmp	error

	sect	texts

;VC404:	.byte	1, 150.			; Rest of line
;	.byte	202, 152., 39.		; Erase screen
;VT52:	.ascii	<2><155.>"K"
;	.ascii	<4><155.>"H"<155.>"J"
;VT100:	.ascii	<3><155.>"[K"		; Erase rest of line
;	.ascii	<6><155.>"[H"<155.>"[J"	; Erase the screen
;ADM31:	.ascii	<2><155.>"T"		; Clear to end of line
;	.byte	1, 232			; Clear screen

	.even

;TtyTyp:.word	VC404
;	.ascii	"VC404   "
;	.word	VT100
;	.ascii	"VT100   "
;	.word	VT52
;	.ascii	"VT52    "
;	.word	ADM31
;	.ascii	"ADM31   "
;	.word	0			; EOT

	.even

CluSiz:	.word	128.			; Cluster size for file 1
	.word	46.			; File 2
	.word	512.			; File 
	.word	64.			; File 4
	.word	2			; File 5
	.word	128.			; For file #6 (same as for #1)
	.word	64.			; For file #7 (same as for #4)

NClus:	.word	4			; # of clusters per block. (file 1)
	.word	11.
	.word	1
	.word	8.
	.word	256.
	.word	4			; For file #6
	.word	8.			; For file #7

Text	IOErr1,	<<cr><lf>"?IO-err EMT:">
Text	IOErr2,	<"XRBLK:">
Text	IOErr3,	<"XRCI:">
Text	IOErr4,	<"Stack:"<cr><lf>>

PrCrBe:	.ascii	"(Tryck p} Return - "
PrCrEn:

begq:	.ascii	'(Tryck p} Return)'
endq:

CrLfT:	.ascii	<Cr><Lf>

text	LFchar,	<<lf>>
text	rnum,	<"Rec: ">
text	WrnDsp, <" %DISPOS on DISPOSed record. Ignoring:">
text	tjohej,	<" %Tjohej!"<cr><lf>>
	
.if df romnum
CT:	.word	1000.,	999.,	995.,	990.,	950.,	900.
	.word	500.,	499.,	495.,	490.,	450.,	400.
	.word	100.,	99.,	95.,	90.
	.word	50.,	49.,	45.,	40.
	.word	10.,	9.
	.word	5.,	4
	.word	1

STR:	.word	'M,	"IM,	"VM,	"XM,	"LM,	"CM
	.word	'D,	"ID,	"VD,	"XD,	"LD,	"CD
	.word	'C,	"IC,	"VC,	"XC
	.word	'L,	"IL,	"VL,	"XL
	.word	'X,	"IX
	.word	'V,	"IV
	.word	'I

text	nihil,	<"Nil">

.endc
	.even

	sect	code

	.end