Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-11 - 43,50531/pasio.mac
There are 4 other files named pasio.mac in the archive. Click here to see a list.
	TITLE PASIO  *** RUNTIME SUPPORT FOR PASCAL PROGRAMS ***

;Edit history - begins suddenly with edit 2 - no version number is
;  used, since it can't go in a library file anyway (it would override
;  the version number of the main program).

;2 - make it run under tenex and tops-20, so we can bootstrap and test the
;	system on Tops-20 using the emulator.  the problem is the page. UUO
;3 - fix computation of number of buffers in updat1.  This is probably
;	the mysterious CSL patch that didn't get in the master source.
;	code was total garbage before
;4 - make the default Tops-10 in case of an old .rel file that doesn't
;	call pasim. Make mon.tp internal so other routines can check
;5 - =2 in tops20 pasnum.mac - implement break set in string read
;6 - =3 in tops20 pasnum.mac - make real numbers read in have same
;	representation as compiled
;7 - prevent finding arithmetic errors in runtimes
;10 - fix bug in counting destination in readps
;11 - detect wraparound in corerr
;12 - use tops-20 table-driven strategy for GETCH
;13 - fix readps for version 106 compiler PACKED ARRAY OF CHAR
;14 - do clrbfi on fatal errors
;15 - =7 in tops20 pasnum.mac - make real number reader read exact fractions exactly
;16 - allow user to enable for end of tape
;17 - retrofit to KA
;20 - add DELETE
;21 - fix to real number reader, =12 in tops-20 pasnum.mac

;Version 2 - reorganize to be table-driven along the lines of the Tops-20
; implementation.
;22 - fix chkmta to clear LH bit
;23 - changed error handling around to keep from clearing the rest of the
;     record when get EOF in the middle of a record.  This required changing
;     most of the error routines, to have skip/no-skip returns instead of
;     aborting the caller (which was a bad idea anyway)
;24 - moved LSTREC to XIO
;25 - move fndchn and loschn to separate module, for Fortran interface
;26 - add support for DISPOSE
;27 - fixes to random access
;30 - typo in PUTU
;31 - set page-modified flag after IDPB, not before (be sure on right page!)
;32 - at putcu, fix skip that skiped into error code
;33 - block number off by one on files being written
;34 - clean up defn of breakin
;35 - fix NEWCL.  Roles of AC 1 and 2 had been reversed
;36 - fix to allow programs to go virtual
	TWOSEG 400000
	if1, <printx TOPS-10 version>


	;ENTRY POINTS

	entry initb.,init.b,gotoc.,dispc.,ilfil.
	ENTRY LSTNEW,NEWBND,PASIN.,PASIM.,PASIF.
	entry getchn	
	entry relchn	
	entry curchn	
	entry analys,upcase
	ENTRY CORERR,DCORER
	entry endl,runer.
	ENTRY GETNEW,NEWCL.
	ENTRY END,QUIT
	ENTRY GETLN
	ENTRY GET.,GETX.
	ENTRY PUTLN
	ENTRY PUT,PUTX
	ENTRY RESETF
	ENTRY REWRIT
	entry rename,resdev,update
repeat 0,<
	entry dumpin,dumpou,usetin,usetou	
> 
	entry delf.
	entry append
	ENTRY BREAK,BREAKIN	
	ENTRY TTYOPN
	ENTRY INXERR
	ENTRY PTRER.
	ENTRY PUTPG
	ENTRY GETCH
	ENTRY SRERR
	ENTRY CLOFIL,rclose
	entry curpos,setpos

	intern brkdn.,mon.tp
	intern geter.
	intern in.ddt,erend,in.crt
	intern norcht,illfn,norchx
	intern in.use

	EXTERN PARSE,fn.chn,lo.chn,enterc,leavec

	;registers and file block

	search pasunv,uuosym

ifn ka10sw,<
	intern wrk.sz
> ;ifn ka10sw

	;ADDRESSES
	EXTERNAL .JBDDT,.JBFF,.JBSA

	;constants

	maxeof==10
	%close==close	;These are because of MACRO10 bugs
	%useto==useto
	%setsts==setsts
	%out==out
	%wait==<calli 10>
	%mtape==mtape
	%rename=055000000000


	subttl memory allocation routines
;START OF RUNTIME-SUPPORT'S CODE



;
;***  FEHLER BEI STOREOVERFLOW
;
;memory structure:
; I/O buffers are at .JBFF, maintained by monitor
; NEW area is just below 400000, maintained by NEW routine.
;  LSTNEW is address of last location used by NEW
;  NEWBND is lowest address NEW can use without getting core
; stack and heap is above hiseg code, maintained by CORERR
;  ac 15 points to highest address available to stack without new core
;    (Note that ac 15 used to be LSTNEW, in effect, and so is called NEWREG)
;
;about reentrancy:
; We intend to implement PSI interrupts eventually, so some care has
;  gone into making sure this code can all be interrupted.  If NEW
;  or CORERR are interrupted at the wrong time, certain things can
;  be needlessly redone, but it should work.  Note that if the
;  interrupting process expands core during an interrupt in NEW or
;  CORERR, there can be more core than we thought, and the PAGE. UUO
;  will fail (as the page requested already exists.  This should be
;  OK.)  Also note that if the interrupter does NEW or CORERR,
;  stkexp+1 can be different after the PAGE. than we set it.  However,
;  that should cause no trouble.  There is also a problem with I/O.
;  An interrupt process may not use the same file used by the main prog,
;  as there would be conflict in accessing the file block.  The state of
;  the TTY file should be saved and restored to allow this to be relaxed.
;assumptions about interrupt process:
; ac 17, the PDL pointer, it returned to where it was before
; ac 15, the highest avail hiseg address, may be increased if more
;    core is gotten during the interrupt
; newbnd and lstnew may be decreased if NEW is done during the
;    interrupt.  Note that NEW is coded so this should cause no
;    trouble.
; if I/O is done, all channels are closed, so that INUSE is restored.
;    This is necessary in case we are interrupted at a bad time during
;    GETCHN.  We should make GETCHN more clever, to relax this.
; AC's other than 15 and 17 must be saved and restored by the
;    interrupt

	w==14		;[11] be careful - AC not usually free in runtimes - just at block entry time

ife ka10sw,< ;[17]
dcorer:	move w,ac0	;[11] desired location
	caige w,(basis)	;[11] wraparound ?
	jrst cordon	;[11] yes - done for
	jrst corerl	;[11] enter main corget loop
corerr:	hrrz w,-2(ac1)	;[11] addr field of CAIG before call
	addi w,(p)	;[11] i.e. add rh(p) - addr field is offset from stack
corerl:	camge w,newreg	;[11] do we have it?
	jrst (ac1)	;yes - return
	move ac0,newreg	;highest we have
	lsh ac0,-11	;get page number
	addi ac0,1	;get a new page
	caile ac0,776	;see if about to overwrite PFH
	jrst cordon	;we're done for
	hrrm ac0,stkexp+1	;and save for page. UUO
;[2] ready for page. see if need to simulate for tops-20 or tenex
	move ac0,mon.tp	;[2] get monitor type

repeat 0,<  ;this code uses a simulation of the page. UUO.  It works, but
	    ;at the moment we prefer to have initialization do a CORE UUO
	    ;that allocates all of memory
	cain ac0,4	;[2] tops-20
	jrst cor20	;[2] requires real simulation
  > ;repeat 0

	caie ac0,1	;[2] tops-10 will continue for page.
	jrst corsuc	;[2] others (tenex?) create on reference
;[2] code to do page. for tops-10
	hrli ac0,1	;create a page
	hrri ac0,stkexp	;address spec
	page. ac0,	
	 jrst corfai	;page may already exist, if restarted, or interrupted
			;between the camge and here
corsuc:	hrrz ac0,stkexp+1	;[36] may be larger than what we put there
			;if we were interrupted
	lsh ac0,11	;make an address
	tro ac0,777	;highest in page is OK
	move newreg,ac0	;and make it highest legal
	jrst corerl	;[11] now see if need still more

corfai:	cain ac0,3	;page already exists
	jrst corsuc	;pretend we succeeded
	caie ac0,12	;over cormax
	jrst cordon	;some other problem
	move ac0,stkexp+1	;the page being created
	tloe ac0,200000	;specify on disk?
	jrst cordon	;then we can't do anything
	movem ac0,stkexp+1	;try again on disk
	jrst corerl	;[11] bypass success code
> ;ife ka10sw
ifn ka10sw,< ;[17]
corerr:
dcorer:
> ;ifn ka10sw

cordon:	outstr [asciz /
?	No memory for stack/]
	jrst erend

ife ka10sw,<
repeat 0,<
   ;At the moment we don't need this routine, because we do an initial
   ;CORE UUO to assign all of memory
;[2] routine to simulate page. UUO for tops-20.  Just have to access a word
;[2]   on the new page to get the monitor to create it.  But the emulator
;[2]   has set up a trap for such cases to allow it to catch ill mem ref's.
;[2]   this trap must be turned off before we create and then back on.
cor20:	hrl 16,1	;[2] save ac 1 (lh 16 is redundant)
	move 0,2	;[2] save ac 2
	movei 1,400000	;[2] current process
	movei 2,1b22	;[2] nxm interrupt
	104000,,133	;[2] dic - disable interrupt
	hrrz 2,stkexp+1	;[2] get page to be created
	lsh 2,11	;[2] turn into address
	move 2,(2)	;[2] access it
	movei 2,1b22	;[2] now enable interrupt again
	104000,,131	;[2] aic - enable interrupt
	hlrz 1,16	;[2] restore ac's
	hrl 16,16	;[2] 
	move 2,0	;[2] 
	jrst corsuc	;[2] finished with simulation
>  ;repeat 0


;
;*** INLINEPROCEDURE NEW
;

getnew:	movn ac1,reg	;must change lstnew and read it in same
			;instruction if we are to be interrupted
	addb ac1,lstnew	;subtract length asked for from lstnew
	CAIN ac1,377777	;IF NIL, COULD CAUSE TROUBLE - TRY AGAIN
	JRST NEWNIL
	caml ac1,.jbff	;see if there is room
					;USE OF STACK BY RUNTIME SUPPORT
	JRST   . +3
	ADDI ac1,(REG)		
	JRST NEWERR 			;   MOVEI REG,^O377777
newlop:	caml ac1,newbnd		;is memory there?
	JRST NEWXIT		;YES - DONE
	move ac0,newbnd		;get lowest we have
	lsh ac0,-11		;make page number
	subi ac0,1		;and get next
	hrrm ac0,heaexp+1	;page request
;[2] ready for page. UUO.  call emulations if not tops-10
	move ac0,mon.tp		;[2] get monitor type code

repeat 0,<  ;At the moment we don't need this code, because we do an
	    ;initial CORE UUO to allocate all of memory
	cain ac0,4		;[2] if tops-20, need real simulation
	jrst new20		;[2] 
  > ;repeat 0

	caie ac0,1		;[2] if tops-10, continue into page.
	jrst newsuc		;[2] else (tenex) assume reference creates
;[2] do page. UUO
	hrli ac0,1		;create a page
	hrri ac0,heaexp		
	page. ac0,		
	 jrst newfai
newsuc:	hrrz ac0,heaexp+1	;[36] page we created (usually)
	lsh ac0,11		;turn into address
	movem ac0,newbnd	;lowest legal
	jrst newlop		;see if we need more
> ;ife ka10sw

newnil:	caig reg,0		;here if would return NIL
	movei reg,1		;if size=0, use 1, or get a loop
	jrst getnew		;and throw away this block

ifn ka10sw,< ;[17]
getnew:	movn ac1,reg		;crazy code to prevent race
	addb ac1,newreg		;so can set both in one operation
	caige ac1,(p)		;complain if overlapped stack
	jrst newerr
	CAIN ac1,377777	;IF NIL, COULD CAUSE TROUBLE - TRY AGAIN
	JRST NEWNIL
	jrst newxit
> ;ifn ka10sw
	

;[35] reverse roles of A and B after call to NEW, and remove the
;call to newxit, which had been used to put the data back into B
NEWCL.:	PUSH P,REG
	PUSHJ P,NEW##		;ENTRY IF TYPECHECKING 
	pop p,a
	jumple a,cpopj		;set new place to zero - ignore if none
	setzm (b)		;set first loc to zero
	sojle a,cpopj		;if no more, stop
	add a,b			;a _ last loc in block
	hrli ac0,(b)
	hrri ac0,1(b)
	blt ac0,(a)		;clear block
	popj p,

newxit:	MOVE REG,ac1		
	POPJ P,

ife ka10sw,<
newfai:	cain ac0,3	;page already existed
	jrst newsuc	;pretend we succeeded
	caie ac0,12	;no room in core
	jrst newerr	;something else wrong
	move ac0,heaexp+1	;get page to be created
	tloe ac0,200000	;on disk?
	jrst newerr	;yes - can't help him
	movem ac0,heaexp+1	;try again on disk
	jrst newlop	;skip success code and try again
> ;ife ka10sw

NEWERR: OUTSTR [ASCIZ /
?	No memory for heap/]	;Need new message
	move ac0,(p)		;PC to print
	pushj p,runer.		;print PC and go to debugger
	movei reg,377777	;return nil if continues
	popj p,


;various file cleanup stuff:

;gotoc. - cleanup for goto
;  b - new o
;  c - new p
;  d - where to go
;any files above the new p and below the current p are to be released
gotoc.:	push p,c		;new P
	push p,b		;new O
	hrrz e,p		;release if leq e
	hrrz f,c		;and gt f
	movei g,blktab		;loop over blktab
;loop on blktab
gotol:	move b,(g)		;get the fcb addr there
	camle b,f		;if leq f
	camle b,e		;or g e
	 jrst gotocn		; don't do anything with it
;here if the FCB is in area to be released
	pushj p,clofxx
	setzm filtst(b)		;and indicate no longer valid
	setzm (g)		;clear table entry
	setom blklck-blktab(g)	;and release lock on it
;end of loop on blktab
gotocn:	camge g,lstblk
	aoja g,gotol		;if any more to look at, do so
;now we have killed all the files that we should have. Do the goto
	pop p,o			;new O
	pop p,t			;new P
	move p,t
	jrst (d)		;go to place where we should

;dispc. - dispose of a record containing a file.  Search our
;database for one that might be it
;  b - addr of record
;  c - length of record
dispc.:	push p,b		;save b and c
	push p,c
	move f,b		;f - lower limit
	move e,b
	add e,c			;e - upper limit
	movei g,blktab		;loop over blktab
;loop on blktab
dispfl:	move b,(g)		;get the fcb addr there
	caml b,f		;if lt f
	caml b,e		;or ge e
	 jrst dispfn		; don't do anything with it
;here if the FCB is in area to be released
	pushj p,clofxx
	setzm filtst(b)		;and indicate no longer valid
	setzm (g)		;clear table entry
	setom blklck-blktab(g)	;and release lock on it
;end of loop on blktab
dispfn:	camge g,lstblk
	aoja g,dispfl		;if any more to look at, do so
	pop p,c
	pop p,b
	popj p,

;[14] Special exit for fatal errors
endl:			;tops-20 name for this
erend:	clrbfi		;[14] Unexpected event - clear typeahead
quit:
end:	movei g,blktab		;loop through all files
endcl:	skipn b,(g)		;get the fcb addr there
	jrst endcn		;nothing there, try next
	pushj p,clofxx		;close it
	setzm filtst(b)		;and indicate no longer valid
	setzm (g)		;clear table entry
	setom blklck-blktab(g)	;and release lock on it
endcn:	camge g,lstblk		;go to next, if any
	aoja g,endcl
	exit

ife ka10sw,<
repeat 0,<
      ;At the moment we don't need this code, because we do an initial CORE
      ;UUO to allocate all of memory
;[2] The following is an emulation of the page UUO for tops-20.  It is just
;[2]   like cor20, except that the pdl can be used for saving ac's and that
;[2]   the argument comes from heaexp instead of corexp.
new20:	push p,1	;[2] save ac's used by jsys
	push p,2	;[2] 
	movei 1,400000	;[2] this process
	movei 2,1b22	;[2] nxm interrupt
	104000,,133	;[2] dic
	hrrz 2,heaexp+1	;[2] page needed
	lsh 2,11	;[2] word on page
	move 2,(2)	;[2] access it
	movei 2,1b22	;[2] nxm interrupt
	104000,,131	;[2] aic
	pop p,2		;[2] restore ac's
	pop p,1		;[2] 
	jrst newsuc	;[2] successful simulation
  > ;repeat 0
> ;ife ka10sw

	subttl character tables for lower-upper conversion
;[12] this whole page is part of edit 12

define letter,<exp .-beg>	;real letter
define lc,<exp .-beg-40>	;upper case equiv. of lower case letter
define linech(x),<xwd x,.-beg>	;end of line char

norcht:
beg==norcht
repeat 12,<letter>	;0 - 11
	linech 1	;12
	letter		;13
	linech 1	;14
	linech -1	;15
repeat 14,<letter>	;16 - 31
	linech 1	;32
	linech 1	;33
repeat 166,<letter>	;everything else is a letter

lccht:
beg==lccht
repeat 12,<letter>
	linech 1
	letter
	linech 1
	linech -1
repeat 14,<letter>
	linech 1
	linech 1	;33
repeat 105,<letter>	;34 - 140
repeat 32,<lc>		;141 - 172
repeat 5,<letter>	;173 - 177

;Here are the tables that don't show you end of line
define linech(x),<xwd x," ">	;end of line char

norchx:
beg==norchx
repeat 12,<letter>	;0 - 11
	linech 1	;12
	letter		;13
	linech 1	;14
	linech -1	;15
repeat 14,<letter>	;16 - 31
	linech 1	;32
	linech 1	;33
repeat 166,<letter>	;everything else is a letter

lcchx:
beg==lcchx
repeat 12,<letter>
	linech 1
	letter
	linech 1
	linech -1
repeat 14,<letter>
	linech 1
	linech 1	;33
repeat 105,<letter>	;34 - 140
repeat 32,<lc>		;141 - 172
repeat 5,<letter>	;173 - 177

;[12] end of edit 12

	subttl mode-dependent dispatch tables

;	get,put,.+1
;	getx,putx,closer,breakin,break,curpos,setpos
;	showln,fixln

nortxt:	exp getcn,putcn,.+1
	exp illfn,illfn,0,brkin,brkn,curpn,setpn
	exp showln,fixln

norrec:	exp getn,putn,.+1
	exp getxn,putxx,0,brkin,brkn,curpn,setpn
	exp noshow,notry

blkrec:	exp getb,putb,.+1
	exp getxn,putxx,0,brkin,brkn,curpn,setpn
	exp noshow,notry

updtxt:	exp getcu,putcu,.+1
	exp illfn,illfn,brku,brkiu,brku,curpn,setpup
	exp noshow,notry

updrec:	exp getu,putu,.+1
	exp getxu,putxx,brku,brkiu,brku,curpn,setpup
	exp noshow,notry

notopn:	exp unopn,unopn,.+1
notopx:	exp unopn,unopn,0,unopn,unopn,unopn,unopn
	exp unopn,unopn

ttytxt:	exp tgetch,tputch,.+1
	exp illfn,illfn,0,brktty,cpopj,retzer,cpopj
	exp ttyshl,ttyfxl

trmtxt:	exp getct,putct,.+1
	exp illfn,illfn,0,brkt,cpopj,retzer,cpopj
	exp tdvshl,tdvfxl

retzer:	setzm 1(p)
cpopj:	popj p,

unimp:
illfn:	outstr [asciz /
? Illegal function for this mode on file /]
	pushj p,wrtfnm	
	jrst erend

unopn:	OUTSTR	[ASCIZ /
? File /]
	pushj p,wrtfnm	
	outstr	[asciz /not open/]
	jrst erend

get.:
getch:	jrst @filget(reg)

putch:	movem ac0,filcmp(reg)
put:	jrst @filput(reg)

getx.:	move ac1,filr99(reg)
	jrst @filgtx(ac1)

putx:	move ac1,filr99(reg)
	jrst @filptx(ac1)

putxx:	pushj p,curpos
	move c,2(p)		;current postion
	sub c,filrcs(b)		;go back to begin. of current record
	seto d,			;suppress get
	pushj p,setpos		;move to that position
	move c,filrcs(b)
	jrst put

	pushj p,@filget(reg)		;GETS NEXT CHARACTER IN LINE
getln:	skipg fileol(reg)		;IS EOLN = TRUE (CR DOESN'T COUNT)
	jrst getln-1			;NO - CHARAKTER'S IN LINE
	jrst @filget(reg)

breakin:move ac1,filr99(reg)
	jrst @filbki(ac1)

break:	move ac1,filr99(reg)
	jrst @filbrk(ac1)

curpos: move ac1,filr99(reg)
	jrst @filcrp(ac1)

setpos:	move ac1,filr99(reg)
	jrst @filstp(ac1)


	subttl device-independent routines for error recovery

showln:	move a,filst1(b)	;get flags
	tlne a,filctm		;is it controlling terminal?
	jrst ttyshl		;yes, use special guy		
;noshow - this is the default showln for devices where we can't
;  really show the current line.
noshow:	push p,t
	push p,a
	push p,c
	outstr [asciz /[Error at character number /]
	pushj p,curpos		;get current position
	move t,2(p)		;returned value
	pushj p,decprt		;print it
	outstr [asciz /]
/]
	pop p,c
	pop p,a
	pop p,t
	popj p,	

;arg in t, uses t,a,c
;prints arg in decimal on tty
decprt:	setz c,			;c is num of digits
decprl:	idivi t,12		;a _ next digit
	push p,a		;push on stack
	aoj c,
	jumpn t,decprl		;next digit if anything left
decpr:	pop p,a			;a _ next digit
	addi a,"0"		;turn to char
	outchr a		;put it out
	sojg c,decpr		;back for more if there are any
	popj p,

fixln:	move a,filst1(b)	;get flags
	tlne a,filctm		;is it controlling terminal?
	jrst ttyfxl		;yes, use special guy		
;notry - use this routine for FIXLIN with devices where you don't
; implement retrying.
notry:	outstr [asciz /Call to READ/]
	pushj p,runer.
	outstr [asciz /
[Skipping bad character]
/]
	jrst @filget(b)

;tryagn - ask him to try again.  If there is a debugger, offer to
; go to it.
;t - PC to print if error; A - FCB for printing; B - FCB
tryagn:	push p,t
	push p,a
	push p,b
	push p,c
tryag1:	
;Now, if DDT is there, do a bit differently
	skipn .jbddt			;.jbddt?
	jrst trynod			;no - no option
;Here if DDT - give him an option
	move b,-2(p)
	movei c,[asciz /
[Try again, from the beginning of the bad number.]
[Or type D to enter the debugger.]
/]
	pushj p,wrtstr
	move b,-1(p)		;get back FCB
	move a,filr99(b)
	movei reg1,0		;do the get
	pushj p,@filbki(a)	;clear input buffer again
	move a,filcmp(b)	;See if he typed a D
	caie a,"D"
	cain a,"d"
	 caia
	jrst tryOK		;no a D - use what he gave us
;Here if he wants DDT - let runer. do it
	move t,-3(p)		;PC passed to us in T
	outstr [asciz /Call to READ /]
	pushj p,runer.
	jrst tryag1

;Here for no DDT cases
trynod:	move b,-2(p)
	movei c,[asciz /
[Try again, from the beginning of the bad number.]

/]
	pushj p,wrtstr
	move b,-1(p)
	move a,filr99(b)
	movei reg1,0		;do the get
	pushj p,@filbki(a)	;clear input buffer again
tryOK:	pop p,c
	pop p,b			;return it to the user
	pop p,a
	pop p,t
	popj p,

;wrtstr - write string
;b - FCB
;c - addr of asciz string
;uses 
wrtstr:	push p,filcmp(b)
	hrli c,440700		;make byte pointer
wrtstl:	ildb a,c		;get next char
	jumpe a,wrtstx		;stop at zero, since asciz
	movem a,filcmp(b)
	pushj p,put
	jrst wrtstl
wrtstx:	pop p,filcmp(b)
	popj p,


	subttl byte input routines
;************  NEUE LAUFZEITUNTERSTUETZUNG

;getcn - normal read in buffered mode
getcn:	SOSGE FILBTC(B)		;ANY BYTE LEFT IN BUFFER ?
	pushj p,advclr			;advance, or return via eofclr
	ildb a,filbtp(b)		;[12] get next byte
	ldb t,[point 6,filbtp(b),11]	;[12] get byte size
	caie t,7			;[12] if not 7
	jrst getnln			;loworder bit not line no.
	movei t,1			;[12] test for linenr or pagemark
	tdne t,@filbtp(b)		;[12] last bit on?
	jrst getcln			;yes - line number
getnln:	andi a,177		; no - be sure legal ascii
	jumpe a,getcn		;ignore nulls
	move a,@filcht(b)	;get eoln flag and mapped char
	hlrem a,fileol(b)	;put down eoln flag
	hrrzm a,filcmp(b)	;put down mapped char
	came a,[xwd -1," "]	;carriage return in official mode
	popj p,
geteol:	pushj p,@filget(b)	;we have a CR, look for real EOL
	skipe fileof(b)		;stop after errors
	popj p,
	skipg fileol(b)		;real EOL?
	jrst geteol		;no, next char
	popj p,			;yes, done

;Handle line numbers
getcln:	MOVE AC1,@FILBTP(REG)		;NO - GET LINENUMBER OR PAGEMARK
	TRZ AC1,1			;BIT 35 TO ZERO
	MOVEM AC1,FILLNR(REG)		;STORE IT TO FILLNR
	MOVE AC0,FILBTC(REG)
	SUBI AC0,5			;TO OVERREAD LAST FOUR DIGITS AND TAB
	JUMPGE AC0,GETNCP		;ALL FIVE CHARACTERS IN THIS BUFFER?
	pushj p,@filadv(reg)		;get next buffer
	jrst eofclr			;error - set eof and clear buffer
	IBP FILBTP(REG)			;TO OVERREAD TAB OR CR
	jrst getcn
GETNCP: MOVEM AC0,FILBTC(REG)		;RESTORE BYTECOUNT
	AOS FILBTP(REG)			;INCREMENTS BYTEPOINTER BY 5
					; 4 DIGITS AND TAB
	JRST GETCN			;now go back and get real char

;advclr - advance, and call eofclr if error.  This routine is needed
;  when there is a sosge, to avoid the sequence
;	sosge count
;	pushj p,advance
;	jrst error
;  which would obviously activate error at the wrong time!

advclr:	pushj p,@filadv(reg)		;advance
	jrst .+2			;error
	popj p,				;OK
	pop p,(p)			;abort the caller
	jrst eofclr

;noradv - filadv routine for normal buffered I/O
;  non-skip - error
;  skip - OK
noradv:	aos filphb(reg)			;we are now one block further
	move ac0,filchn(reg)		;make the IN UUO
	tlo ac0,(in)
	xct ac0
	jrst norok
	pushj p,geter.			;error - analyze it
	jrst norok			;there was data - use it
	popj p,

norok:	sosge filbtc(reg)		;caller expectes this decremented
	jrst noradv			;nothing there - try again
	aos (p)				;normal return
	popj p,



;getcu - special version of GETCH for update mode.  Differs from the
; above only in maintaining the read count in FILPPN.
getcu:	SOSGE FILBTC(B)		;ANY BYTE LEFT IN BUFFER ?
	pushj p,advclr			;advance or return via eofclr
	sosge filppn(reg)		;end of existing part?
	jrst sefclr			;yes - end of file
	ildb a,filbtp(b)		;[12] get next byte
	ldb t,[point 6,filbtp(b),11]	;[12] get byte size
	caie t,7			;[12] if not 7
	jrst getnlu			;loworder bit not line no.
	movei t,1			;[12] test for linenr or pagemark
	tdne t,@filbtp(b)		;[12] last bit on?
	jrst getclu			;yes - line number
getnlu:	andi a,177		; no - be sure legal ascii
	jumpe a,getcu		;ignore nulls
	move a,@filcht(b)	;get eoln flag and mapped char
	hlrem a,fileol(b)	;put down eoln flag
	hrrzm a,filcmp(b)	;put down mapped char
	came a,[xwd -1," "]	;carriage return in official mode
	popj p,
getelu:	pushj p,@filget(b)	;we have a CR, look for real EOL
	skipe fileof(b)		;stop after errors
	popj p,
	skipg fileol(b)		;real EOL?
	jrst getelu		;no, next char
	popj p,			;yes, done

;Handle line numbers
getclu:	MOVE AC1,@FILBTP(REG)		;NO - GET LINENUMBER OR PAGEMARK
	TRZ AC1,1			;BIT 35 TO ZERO
	MOVEM AC1,FILLNR(REG)		;STORE IT TO FILLNR
	MOVE AC0,FILBTC(REG)
	SUBI AC0,5			;TO OVERREAD LAST FOUR DIGITS AND TAB
	JUMPGE AC0,GETNCU		;ALL FIVE CHARACTERS IN THIS BUFFER?
	pushj p,@filadv(reg)		;get next buffer
	jrst eofclr			;error - set eof and clear buffer
	sosge filppn(reg)		;end of file?
	jrst sefclr			;yes - do it
	IBP FILBTP(REG)			;TO OVERREAD TAB OR CR
	jrst getcu
GETNCU: MOVEM AC0,FILBTC(REG)		;RESTORE BYTECOUNT
	movni ac0,5			;subtract read count also
	addb ac0,filppn(reg)
	jumpl ac0,sefclr		;and if nothing there, do eof
	AOS FILBTP(REG)			;INCREMENTS BYTEPOINTER BY 5
					; 4 DIGITS AND TAB
	JRST GETCU			;now go back and get real char

geter.:	;here after IN or OUT UUO fails. Analyze error and user's bits
	;
	; pushj p,geter.
	;   there was data
	;   there was no data
	;
	;geter. will return to
	; +1 (ignore ret) if user says that error is OK
	;   and data was there (i.e. neither EOF nor non-blocking)
	; +2 (abort return) having set EOF if EOF
	;  or non-blocking I/O failure
	; print error msg and abort if non-enabled error
;;Be sure the phys. block count is incremented before calling
;;this, as we will decrement it for non-blocking failure and EOF.
;;You need not worry about this is you can show that non-blocking
;;failure is not possible.  (EOF doesnt really matter.)
;;(e.g. dump-mode I/O, or initial buffer creation).
	push p,ac0	;we will use these ac's
	push p,ac1
	push p,reg1
	movei reg1,740000	;default error bits
	move ac0,filst1(reg)
	tlne ac0,filmta		;if magtape
	tro reg1,2000		;this is also error (end of tape)
	move ac0,filchn(reg)	;make a GETSTS
	tlo ac0,(getsts)
	xct ac0
	move ac1,ac0		;save error status for user
	and ac1,reg1		;only error bits
	trne ac0,20000		;or EOF
	tro ac1,20000
	hrlz ac1,ac1		;to LH
	iorm ac1,filerr(reg)	;accumulate in error place
	hrrz ac1,filerr(reg)	;get errors user enabled
	and ac1,reg1		;throw away non-error bits
	tdc ac1,reg1		;now we have non-enabled errors
	trne ac0,(ac1)		;any non-enabled errors?
	 jrst getems		;yes (note EOF always skips)
	tdzn ac0,reg1		;end of file or non-blocking failure?
	 jrst getend		;yes - EOF return
;	tdz ac0,740000		;continuable error - first clear error status
	hll ac0,filchn(reg)	;make setsts
	tlc ac0,(setsts)
	xct ac0
gterrt:	pop p,reg1		;now take normal return
	pop p,ac1		;restore ac's
	pop p,ac0
	popj p,

getend:	sos filphb(reg)		;This is in case of non-blocking failure.
	trne ac0,20000		;but if EOF
	setom filphb(reg)	;invalidate the block for SETPOS
	aos -3(p)		;skip return (abort)
	pop p,reg1
	pop p,ac1
	pop p,ac0
	popj p,			;return via seteof

getems:	pushj p,analys		;print error message if fatal
	jrst erend

;getu - normal read in update mode
getu:	movn	reg2,reg1		;compute AOBJN word - negative count
	hrl	ac1,reg2		;to LH
	hrr	ac1,filcnt(reg)		;addr of first destination word
	hrrm	reg1,filrcs(reg)	;and save size
getstu: SOSGE	FILBTC(REG)		;ANY BYTE LEFT IN BUFFER?
	pushj	p,recadv		;advance or adjust count and set eof
	sosge	filppn(reg)		;beyond eof?
	jrst 	recsef			;yes
	ILDB	AC0, FILBTP(REG)	;GET NEXT BYTE
	MOVEM	AC0, (AC1)		;DEPOSIT IT IN FILECOMPONENT
	AOBJN	AC1, GETSTU		;MORE BYTES IN THIS COMPONENT?
	POPJ	 P,			;NO ,RETURN

;special version of receof that simulates end of file
recsef:	hlre ac1,ac1			;ac1 _ - number bytes left
	addm ac1,filrcs(reg)		;adjust count of bytes done
	jrst setsef

;recadv - call advance and return via receof if failure
recadv:	pushj p,@filadv(reg)		;next block
	jrst .+2			;error
	popj p,
	pop p,(p)			;abort caller
	;jrst receof			;fall into receof

;receof - adjust FILRCS and do eof
receof:	hlre ac1,ac1			;ac1 _ - number bytes left
	addm ac1,filrcs(reg)		;adjust count of bytes done
	jrst seteof			;set eof and return

getb1:	setzm filrcs(reg)		;nothing transferred
	jrst eofclr			;set eof and clear buffer

;getb - read in buffered mode for blocked tapes
getb:	pushj	p,@filadv(reg)		;force moving to new block
	jrst	getb1			;clear buffer and set error
	camle	reg1,filbtc(reg)	;take min of actual size and request
	move	reg1,filbtc(reg)
	;jrst	regn			;fall into normal routine

;getn - normal read in buffered mode
GETN:	movn	reg2,reg1		;compute AOBJN word - negative count
	hrl	ac1,reg2		;to LH
	hrr	ac1,filcnt(reg)		;addr of first destination word
	hrrm	reg1,filrcs(reg)	;and save size
GETEST: SOSGE	FILBTC(REG)		;ANY BYTE LEFT IN BUFFER?
	pushj	p,recadv		;advance or adjust count, eof, return
	ILDB	AC0, FILBTP(REG)	;GET NEXT BYTE
	MOVEM	AC0, (AC1)		;DEPOSIT IT IN FILECOMPONENT
	AOBJN	AC1, GETEST		;MORE BYTES IN THIS COMPONENT?
	POPJ	 P,			;NO ,RETURN

repeat 0,<
getdmp:	skipa	reg3,filin(reg)		;get in dump mode - input instruction
putdmp:	move	reg3,filout(reg)	;put in dump mode - output instruction
	hrrm	reg1,filrcs(reg)	;save current record length
	subi	reg1,1
	hlrz	ac0,filrcs(reg)		;length of phys block - bytes
	idiv	reg1,ac0		;no. phys. blocks this operation
	addi	reg1,1			;rounded up to nearest phys block
	addm	reg1,filphb(reg)	;update phys. block number
	hrri reg3,reg1
	move reg1,ac1			;word 1 of pgm is transfer word
	subi reg1,1			; but must adjust addr
	setz reg2,			;word 2 is 0
	xct reg3			;input or output
	popj p,				;normal
	pushj p,geter.			;error - abort or return to .-1
>

getxn:	;Extend existing record to longer variant
	hrr ac0,filrcs(reg)	;ac0 _ length of record so far
	camg reg1,ac0
	popj p,			;done if new isn't larger
	movn ac1,reg1		;ac1 _ - new total length requested
	add ac1,ac0		;ac1 _ - additional bytes this req.
	hrl ac1,ac1		;make ac1 aobjn pointer
	add ac0,filcnt(reg)	;starting addr of new portion
	hrr ac1,ac0		;ac1 _ aobjn pointer for transfer
	jrst getest		;now join regular get

getxu:	;Extend existing record to longer variant
	hrr ac0,filrcs(reg)	;ac0 _ length of record so far
	camg reg1,ac0
	popj p,			;done if new isn't larger
	movn ac1,reg1		;ac1 _ - new total length requested
	add ac1,ac0		;ac1 _ - additional bytes this req.
	hrl ac1,ac1		;make ac1 aobjn pointer
	add ac0,filcnt(reg)	;starting addr of new portion
	hrr ac1,ac0		;ac1 _ aobjn pointer for transfer
	jrst getstu		;now join regular get

	subttl dump-mode I/O routines
repeat 0,<
dumpou:	skipa ac1,filout(reg)
dumpin:	move ac1,filin(reg)
	;reg - file
	;reg1 - object address
	;reg2 - object size
	caie reg,tty##
	cain reg,ttyout##
	jrst badmod
	skipge (reg)
	jrst badmod
	skipe fileof(reg)	;test for error
	jrst getef.		
	hrrm reg2,filrcs(reg)	;length of last record
	hrri ac1,reg1		;command list will be in reg1&2
	subi reg1,1		;iowd in reg1
	move reg3,reg2		;bytes inputted
	subi reg3,1
	hlrz reg4,filrcs(reg)	;bytes per physical block
	idiv reg3,reg4		;phys. blocks this operation
	addi reg3,1		;rounded up to nearest phys block
	addm reg3,filphb(reg)	;adjust physical block no.
	movn reg2,reg2		;neg count
	hrl reg1,reg2		
	setz reg2,		;terminate command list
	xct ac1
	popj P,		;OK
	pushj p,geter.	;bad - returns to .-1 or abort

;NB: SETPOS depends upon USETIN and USETOU not using any AC above
;REG3.
usetin:	caie reg,tty##
	cain reg,ttyout##
	popj p,
	skipge (reg)
	popj p,			;no op if string I/O
	move reg3,reg2		;arg to suppress get
	pushj p,setin		;do the useti - common code
	move reg1,reg3		;get suppression for breakin
	jrst brkin2

;NB: SETPOS depends upon USETIN and USETOU not using any AC above
;REG3.
usetou:	caie reg,tty##
	cain reg,ttyout##
	popj p,
	skipge (reg)		;if string I/O
	popj p,			;noop
	move ac0,filsta(reg)	;see if buffered
	andi ac0,17
	caige ac0,15
	xct filout(reg)		;yes - force out old buffer
	jrst .+2		;OK return
	 pushj p,geter.		;error return
	pushj p,setou		;common code
	popj p,

setin:	;reg - file
	;reg1 - block number
	skipa ac1,[useti (reg1)]
setou:	move ac1,[useto (reg1)]	
	move reg2,reg1
	subi reg2,1		;new phys block no.
	movem reg2,filphb(reg)	;save in data area
	move ac0,filchn(reg)	;get chan
	ior ac1,ac0		
	xct ac1			;never fails
	hllzs filrcs(reg)	;clear out remnants of old records
	setzm filrcp(reg)	;  "
;set up filblc for blocked file in case in middle of block
	skipn ac1,filbll(reg)	;logical block size
	popj p,			;if not blocked, forget it
	hrrz ac0,ac1
	subi ac0,1
	hlrz reg2,filrcs(reg)	;reg2 _ physical block size
	idiv ac0,reg2
	addi ac0,1
	imul ac0,reg2		;ac0 _ log block size rounded up to phys block
	subi reg1,1
	imul reg1,reg2		;reg1 _ bytes from beginning of file
	idiv reg1,ac0		;reg2 _ bytes into logical block
	hrrz ac0,filbll(reg)	;logical block size
	sub ac0,reg2		;ac0 _ bytes left in this log block
	movem ac0,filblc(reg)	;save
	popj p,

> ;end repeat 0

	subttl byte output routines

;putcu is special entry for update mode to note that write has happened
putcu:	sosl filbtc(reg)		;[32] space left in buffer?
	jrst putcu1			;[32] yes
	pushj p,@filadv(reg)		;[32] no, get the next
	jrst seteof			;[32] set eof and exit
putcu1:	sos filppn(reg)			;count down read ctr., too
	move ac0,filcmp(reg)		;get thing to output
	idpb ac0,filbtp(reg)		;deposit character in output buffer
	hllos filst1(reg)		;[31] note that write has happened
	popj p,				;return

;adveof - advance or return via seteof
adveof:	pushj p,@filadv(reg)
	jrst .+2
	popj p,				;OK
	pop p,(p)			;abort caller
	jrst seteof			;set eof and exit

;putcn - normal character write routine
putcn:	sosge filbtc(reg)		;space left in buffer?
	pushj p,adveof			;advance or set eof and exit
	move ac0,filcmp(reg)		;get thing to output
	idpb ac0,filbtp(reg)		;deposit character in output buffer
	popj p,				;return

;nowadv - filadv routine for normal buffered I/O
; error return
; normal return
nowadv:	aos filphb(reg)			;we are now one block further
	move ac0,filchn(reg)		;make the IN UUO
	tlo ac0,(out)
	xct ac0
	jrst nowok
	pushj p,geter.			;error - analyze it
	jrst nowok			;there was data - use it
	popj p,				;no data there - error

nowok:	sosge filbtc(reg)		;caller expectes this decremented
	jrst nowadv			;nothing there - try again
	aos (p)				;normal (skip) return
	popj p,

;putb - write routine for blocked records
putb:	pushj	p,@filadv(reg)		;force new record
	jrst	putb1			;no data trans
	jrst	putn			;now treat normallly

putb1:	setzm	filrcs(reg)		;so zero the count
	jrst	seteof			;and set eof

;putu is special entry for update mode to flag that a write has happened
putu:	movn	reg2,reg1		;compute transfer word
	hrl	ac1,reg2		;neg. count
	hrr	ac1,filcnt(reg)		;first source addr.
	hrrm	reg1,filrcs(reg)	;save length of record
PUTSTU:	SOSGE	FILBTC(REG)		;SPACE LEFT IN BUFFER ?
	pushj	p,recadv		;[30] advance or update cnt, eof, exit
	sos	filppn(reg)		;account for in read count, too
	MOVE	AC0,(AC1) 		;GET NEXT WORD OF COMPONENT
	IDPB	AC0,FILBTP(REG)		;DEPOSIT IN OUTPUT BUFFER
	hllos	filst1(reg)		;[31] note that a write has happened
	AOBJN	AC1,PUTSTU		;MORE WORDS IN COMPONENT ?
	POPJ	P,			;NO

;putn - normal write routine for record I/O
PUTN:	movn	reg2,reg1		;compute transfer word
	hrl	ac1,reg2		;neg. count
	hrr	ac1,filcnt(reg)		;first source addr.
	hrrm	reg1,filrcs(reg)	;save length of record
PUTEST:	SOSGE	FILBTC(REG)	;SPACE LEFT IN BUFFER ?
	pushj	p,recadv		;advance or adjust cnt, eof, exit
	MOVE	AC0,(AC1) 		;GET NEXT WORD OF COMPONENT
	IDPB	AC0,FILBTP(REG)		;DEPOSIT IN OUTPUT BUFFER
	AOBJN	AC1,PUTEST		;MORE WORDS IN COMPONENT ?
	POPJ	P,			;NO

	subttl minor device-independent routines

PUTLN:	MOVEI  AC0,15			;CR
	PUSHJ P,PUTCH
	MOVEI  AC0,12			;LF
	PUSHJ P,PUTCH
	POPJ  P,

PUTPG:	MOVEI AC0 ,15		       ;<CR>
	PUSHJ P,PUTCH	       
	MOVEI AC0 ,14		       ;<FF>
	PUSHJ P,PUTCH
	POPJ  P,

wrtfnm:	move	reg1,fildev(reg)	;dev name
	jumpe	reg1,wrtfn1		;nothing there to do
	camn	reg1,[sixbit /DSK/]	;see if DSK:
	jrst	wrtfn1			;forget it
	hrri	reg1,fildev(reg)	;now print dev
	hrli	reg1,440600		
	movei	reg2,6			
	ildb	reg3,reg1		
	addi	reg3,40			
	caie	reg3,40			
	outchr	reg3			
	sojg	reg2,.-4		
	movei	reg3,":"		;and trailing colon
	outchr	reg3			
WRTFN1: HRRI   REG1,FILNAM(REG) 	;ADDRESS OF FILENAME
	HRLI  REG1,440600		;SET UP BYTE POINTER
	MOVEI REG2,  6			;CHARACTER COUNT
	ILDB  REG3,REG1 		;GET NEXT CHARACTER
	ADDI  REG3, 40			;CONVERT TO ASCII
	caie	reg3,40		;skip blanks
	OUTCHR	     REG3
	SOJG  REG2, .-4 		;MORE CHARACTERS ?
	MOVEI REG3,  56 		;INSERT PERIOD
	hlrz	reg2,filext(reg)	;see if extension
	skipe	reg2			;if not no period
	OUTCHR	     REG3
	MOVEI REG2, 3			;TYPE EXTENSION
	ILDB  REG3,REG1
	ADDI  REG3, 40
	caie	reg3,40		;skip blanks
	OUTCHR	     REG3
	SOJG  REG2, .-4 		;ALL THREE BYTES TRANSFERRED ?
	POPJ	P,			;RETURN

	jrst erend

	subttl file openning routines

blkerr:	outstr [asciz /
?	Bad user lookup block for file /]
	pushj p,wrtfnm
	jrst erend

preblk:	cain reg4,0	;prepare user lookup block - is there one?
	popj p,		;no - forget it
	move ac0,(reg4)	;be sure the count is plausible
	andi ac0,377777	;[jmh] allow the non-superceding bit
	cail ac0,4	;too small
	caile ac0,100	;too big
	jrst blkerr
	move ac0,filnam+3(reg)	;ppn or ptr to path
	movem ac0,1(reg4)
	move ac0,filnam(reg)	;file name
	movem ac0,2(reg4)
	move ac0,filext(reg)	;extension
	hllm ac0,3(reg4)
	ldb ac0,[point 9,filpro(reg),8]	;protection
	caie ac0,0			;if zero, leave block alone
	dpb ac0,[point 9,4(reg4),8]
	popj P,

rename:	skipn filbfp(reg)	;was the thing opened?
	jrst unopn		;no
	move ac1,filr99(reg)	;if there is a closer, do it
	move ac1,filclo(ac1)
	skipe ac1
	pushj p,(ac1)
	jumpe reg2,renam1	;is there a new name?
	push P,reg
	push P,reg3
	push P,reg4
	push P,ac0		;dummy
	pushj P,parse.
	pop P,ac0
	pop P,reg4
	pop P,reg3
	pop P,reg
	skipe fileof(reg)	;error in parse?
	jrst badnam		;yes
renam1:	lsh reg3,^d27		;handle protection
	movem reg3,filpro(reg)
	movei ac0,filppn-2(reg)	;path ptr - now set up PPN
	skipn filppn(reg)	;is ppn=0?
	setz ac0,		;use zero
	movem ac0,filnam+3(reg)
	movei ac0,1		;normalize filbad
	movem ac0,filbad(reg)
	movsi ac1,(%rename)
	pushj p,lkent		;do the rename
	jfcl
	setz reg1,		;normal close
	jrst doclos		;file got closed, so account for it

delf.:	skipn filbfp(reg)	;[20] was the thing opened?
	jrst unopn		;[20] no
	hll reg2,filchn(reg)	;[20] make a rename
	tlo reg2,(%rename)	;[20] make it rename
	hrri reg2,reg3		;[20] make it refer to reg3 for block
	setzb reg3,reg4		;[20] and make the block null
	movei ac0,1		;normalize filbad
	movem ac0,filbad(reg)
	xct reg2		;[20] delete it
	pushj p,lkerr
	setz reg1,		;normal close
	jrst doclos		;file is now closed, so account for it

append:	pushj p,option
	movei ac0,0		;eof normally on
	movem ac0,filbad(reg)
	caie reg,ttyout##	;ignore for TTY
	cain reg,tty##
	jrst ttout
	pushj p,setnam
	 jrst opener
	hrrz ac0,filst1(reg)	;device type
	 jumpn ac0,rewrt2	;if not disk - append is just rewrite
	hrlzi ac0,filbfh(reg)
	pushj p,reopen
	 jrst opener
	push p,reg4
	push p,[exp 5]		;make up extended block on stack
	add p,[xwd 5,5]
;stack: saved reg4, exp 5, junk, junk, junk, junk, junk
	movei reg4,-5(p)	;here is addr of ext. block
	movsi ac1,(lookup)
	pushj p,lkent
	 jrst updx
	move reg4,-6(p)		;recover the user's block
	movsi ac1,(enter)
	pushj p,lkent
	 jrst updx
	pop p,reg4		;reg4 _ file size
	sub p,[xwd 6,6]
	movsi ac0,(outbuf)
	pushj p,modini
;allocate the buffer so we can play below
	move ac0,filchn(reg)
	tlo ac0,(OUT)
	xct ac0
	jrst .+4
	pushj p,geter.
	jrst .+2		;there was data - use it
	jrst [pushj p,eofclr	;no data - set eof and exit
	      jrst opener]
;now go to last block
	move reg3,reg4		;reg3 _ size of file in words
	idivi reg3,^D128	;reg3 _ last block; reg4 _ no. bytes
	addi reg3,1
	cain reg4,0		;if empty last block, skip this
	jrst appemp
	move reg6,filchn(reg)	;now set up to get old last block
	or reg6,[useti (reg3)]	
	xct reg6		;useti to it
	hllz reg6,filchn(reg)	;now set mode 17 for input
	or reg6,[setsts 17]
	xct reg6
	movsi reg1,-^D128	;set up dump control word
	hrr reg1,filbfh(reg)	;pointing to output buffer!
	addi reg1,1
	setz reg2,		;control word terminator
	move ac1,filchn(reg)	;and make up IN uuo
	ior ac1,[in reg1]
	xct ac1			;now do the input
	jrst .+3
	pushj p,geter.
	jfcl
	hrr reg6,filsta(reg)	;and restore initial status
	xct reg6
appemp:	hllz reg6,filchn(reg)	;get channel
	or reg6,[useto (reg3)]	;make useto
	xct reg6
	move ac0,reg3
;[33] remove subi ac0,1
	movem ac0,filphb(reg)	;store as cur phys block
;Now we figure out how far we are into a logical block, if any
appem1:	cain reg4,0		;any bytes into that block?
	jrst appem2		;no - forget it
	hlrz ac0,filst2(reg)	;ac0 _ bytes per word
	imul ac0,reg4		;ac0 _ no. bytes in last block
	movn ac0,ac0
	addm ac0,filbtc(reg)	;subtract from count in buffer
	addm reg4,filbtp(reg)	;and add words from byte ptr
appem2:	sub p,[openoff]
	popj p,

repeat 0,<

badmod:	outstr [asciz %
?	DUMPIN/OUT may not be used with TTY or a string%]
	jrst erend

> ;repeat 0


resdev:	;NB: we skip any mode-dependent close routine
	move ac1,filtst(b)	;is this a legal block?
	caie ac1,314157
	pushj p,initb.		;no - make it one
	hrli ac1,notopn		;mark the channel as closed
	hrri ac1,filr11(reg)
	blt ac1,filr99(reg)
	skipn filbfp(reg)	;if no device openned
	jrst clofl1		;release buffer if any
	movei ac1,0		;assume it works (eof false)
	ldb ac0,[point 4,filchn(reg),12]	;channel
	resdv. ac0,		;release the chan
	movei ac1,1		;failed
	movem ac1,fileof(reg)
	ldb ac1,[point 4,filchn(reg),12] ;get channel number
	pushj p,lo.chn		;[25] mark channel (ac1) free
	jrst clofl1		;release buffer if any
	
;lkent - do lookup or enter.  opcode in AC1
lkent:	pushj p,preblk		;prepare user lookup block (if any)
	cain reg4,0			;is there?
	hrri reg4,filnam(reg)		;no - use theirs
	hll reg4,filchn(reg)		;channel
	ior reg4,ac1			;op code
	xct reg4			
	jrst lkerr			;failed
	aos (p)				;OK return
	popj p,

;modini - mode-dependent initializations
; ac0 has inbuf or outbuf opcode
modini:
;Split according to dump or buffered mode
	hrrz	ac1,filsta(reg)		;see if dump mode (LH is bits)
	andi	ac1,17
	cail	ac1,15			
	jrst	dmpini
;Here for buffered modes
; initialize dispatch table
	hrli ac1,norrec			;assume record I/O
	tlze reg5,400000		;if blocked
	hrli ac1,blkrec			;use blocking routines
	skipl filcnt(reg)		;if really text
	hrli ac1,nortxt			;use text dispatch
	hrri ac1,filr11(reg)		;copy it to dispatch table
	blt ac1,filr99(reg)
	movei ac1,noradv		;set up buffer advance routine
	skipn filbad(reg)		;if write
	movei ac1,nowadv		;use other one
	movem ac1,filadv(reg)
; See if there are existing buffers that can be reused
; Start with default for this device
	MOVEI	REG2,FILSTA(REG)	;ADDRESS OF NEW OPEN BLOCK
	DEVSIZ	REG2,			;SEE IF NEEDS SAME LENGTH
	 move	reg2,[xwd 2,203]	;default if devsiz fails
; But if magtape and user specified a buffer size, use his
	move ac1,filst1(reg)		;get flags
	tlne reg5,377777		;if request
	tlnn ac1,filmta			;and magtape
	jrst nosizr			; not - go on
	hlr reg2,reg5			;then use that size
	trz reg2,400000			;with funny bit cleared
	addi reg2,2			;and incremented by two because
					;of odd way DEVSIZ counts
; And if he specified number of buffers, use that
nosizr:	trne reg5,777777		;non-zero spec?
	hrl reg2,reg5			;yes - use it
; Reg2 is now requested   COUNT,,SIZE
	move a,reg2
	pushj p,getbuf			;try to get from free list
	trne a,777777			;if something there
	hrli a,400000			;mark as unused
	movem a,filbfh(reg)		;save what we got as new buffers
	jumpn a,bnumok			;if we got something, that's it
; if didn't find good ones, get new buffers
	hll 	reg5,filchn(reg)	;get channel
	ior	reg5,ac0		;make into inbuf/outbuf
	xct	reg5			;create buffers
; Now we set up byte pointer in case we skip IN below (since PUTX needs it)
bnumok:	move	reg5,filbtp(reg)	;At least it has the byte size
	tlz	reg5,770077		;Set it to point to first byte
	hrr	reg5,filbfh(reg)	;Nominal loc of 1st buffer
	movei	ac0,^D36		;compute bytes per word
	ldb	ac1,[point 6,reg5,11]	;byte size
	idiv	ac0,ac1			;ac0 _ bytes per word
	hrlm	ac0,filst2(reg)		;save in filst2 LH
	hlrz	ac1,(reg5)		;buffer size in words
	trz	ac1,400000		;clear use bit
	subi	ac1,1			;adjust to size of data only
	imul	ac1,ac0			;ac1 _ bytes per buffer
	hrrm	ac1,filst2(reg)		;save in filst2 RH
	addi	reg5,1			;adjust pointer to data area
	movem	reg5,filbtp(reg)	;and put it back
	popj p,
;dump mode - not yet here
dmpini:	outstr [asciz /
? Dump mode not implemented yet/]
	jrst erend


;OPTION
;Initializations that are applicable to all openning, even funny
;ones such as TTY and TTYOUT.  Two basic things are done:
; 1) make sure the FCB is legal, and init it if not. this includes
;     setting FILCNT from the arg in A
; 2) translate the user's option string, if any, to internal bits
;
;  Note that any defauting has to be done before translating the
;  user's option string, so that our
;  bits are or'ed into the correct words
;Also note that all ac's except T contain args to this thing.
;WARNING:  Any code in this routine is NOT redone in case the
;open is retried because of error-recovery.

option:	
;1 - make the block legal
	move t,filtst(b)	;is this a legal block?
	caie t,314157
	pushj p,initb.		;no - make it one
;   init FILCNT from arg passed by compiler
	movn a,a		;filcnt wants negative count
	hrl a,a			; in left,
	hrri a,filcmp(b)	; with addr of buffer in RH
	movem a,filcnt(b)
;2 - Now do the option string translation
	came	reg6,[exp -1]	;see if he defaulted mode
  ;problem is that zero is a valid mode, so compiler uses -1 for default
  ;The bits I check here are the error bits, which the user should never
  ;want to set for himself.
	jrst	opt1		;no - use his
	movei	reg6,0		;yes - probably 0
	skipge	filcnt(reg)	;if text file
	movei	reg6,14		;not text - use binary
;see if there is a string to parse
opt1:	push p,a		;get some working space
	push p,b
	came e,[exp -1]		;-1 or 0 LH is probably old format
	tlnn e,777777
	jrst optend		;old format
;there is an option string - parse it and set bits
;e - LH - count, RH - addr
	hlrz a,e		;a _ count
	hrrz t,e		;t _ byte ptr
	setz e,			;e is now one of the AC's we are setting up
	hrli t,440700
	jumpe a,optend
optlop:	ildb b,t		;b _ next char
	caie b,"/"		;use / to separate options
	 jrst opterr		;error
	sojle a,opterr		;count /, there had better be letter following
	ildb b,t		;b _ option letter
	soj a,			;count the letter
	caile b,140		;if lower case
	subi b,40		;make it upper
	cail b,optmin		;if below first
	caile b,optmax		;or above last
	jrst opterr		;error
	xct opttab-optmin(b)	;appropriate processing routine
	jumpg a,optlop		;if any more char's, get next

;Now that all options are set up, set up the character table
optend:	pop p,b			;exit
setcas:	movei a,0		;assume no lc map, standard EOL treatment
	trne reg5,200000	;if lc mapping on
	tro a,2			;set bit 2
	trne reg5,040000	;if we want to see EOL char
	tro a,1			;set bit 1
	move t,[exp norchx,norcht,lcchx,lccht](a) ;get the right table
	hrli t,a		;indexed on this ac
	movem t,filcht(b)
	pop p,a
	popj p,

;UPCASE - this is for the user to call to change case
;  B - FCB
;  C - raise it?
;This is in this module instead of XIO because it uses magic that is
;likely to change, and because it references symbols internal to this
;module.
upcase:	movsi t,fillcm		;clear any old setting of lower case bit
	andcam t,filst1(b)
	caie c,0		;if user asks for turning it on
	iorm t,filst1(b)	;then do so
	move t,filst1(b)	;now get current flags
	setz a,			;and build up index in A
	tlne t,fillcm		;if lc mapping on
	tro a,2			;set bit 2
	tlne t,filsel		;if we want to see EOL char
	tro a,1			;set bit 1
	move t,[exp norchx,norcht,lcchx,lccht](a) ;get the right table
	hrli t,a		;indexed on this ac
	movem t,filcht(b)
	popj p,

optmin="B"
opttab:	pushj p,optbyt		;B - byte size
	jrst opterr		;C - undef
	tro reg6,742000		;D - data trans errors
	tro reg5,040000		;E - show eoln
	tro reg6,010000		;F - data format errors
	jrst opterr		;G - undef
	jrst opterr		;H - undef
	movei e,1		;I - set interactive flag
repeat "O"-"J",< jrst opterr>	;J to N - undef
	tro reg6,004000		;O - open errors
repeat "U"-"P",< jrst opterr>	;P to T - undef
	tro reg5,200000		;U - lower to upper
optmax=="U"

optbyt:	pushj p,optdec		;parse a decimal number
	lsh b,^D9		;shift it to the byte position
	or reg5,b		;and or into open bits
	popj p,

optdec:	push p,c
	push p,d
	sojle a,opterd		;count colon, better be an extra after that
	ildb b,t
	caie b,":"
	jrst opterr
	setz c,			;accumulate number in c
optdcl:	ildb b,t
	cail b,"0"
	caile b,"9"
	jrst opterd
	subi b,"0"
	imuli c,^D10
	add c,b
	sojle a,optdcx		;count digit, if end of string, done
	move d,t		;peek at next
	ildb b,d
	cain b,"/"		;if /, this is end
	jrst optdcx
	jrst optdcl		;really get char
optdcx:	move b,c		;return value in b
	pop p,d
	pop p,c
	popj p,

opterd:	pop p,d
	pop p,c
	pop p,(p)
opterr:	move b,a		;save a
	outstr [asciz /
? Error in option string/]
	move t,-4(p)		;-2 for saved args, -2 because called 2 deep
	pushj p,runer.
	jrst optend		;return from OPTION


;resetf - this is the main routine to do a Pascal Reset
resetf:	pushj	p,option
	movei	ac0,1			;EOF setting for error is 1
	movem	ac0,filbad(reg)
	caie	reg,tty##		;see if openning TTY
	cain	reg,ttyout
	jrst	ttin			;set up specially
	pushj	p,setnam
	 jrst	opener
	hrrz	ac0,filst1(reg)		;device type
	trze	reg5,100000		;if normal open forced
	jrst	.+3			;skip test
	cain	ac0,3			;tty
	pushj	p,ttopin
	hrrzi	ac0,filbfh(reg)		;BUFFER HEADER ADDRESS
	pushj	p,reopen		;reinitialize and do open
	 jrst	opener
	movsi	ac1,(lookup)
	pushj	p,lkent			;lookup
	 jrst	xopner
;at this point the mode-independent stuff is done.  Now we try various
;  mode-dependent things
	pushj	p,chkmta		;this sets mta blksize if asked
	movsi	ac0,(inbuf)
	pushj	p,modini
	movei	ac0,illfn		;make write be illegal
	movem	ac0,filput(reg)
;Now we get the first item, if appropriate
	sub	p,[openoff]
	skipe	reg3			;user parameter to prevent the get
	jrst	setnul			;don't if user told us no to
	hlre	reg1,filcnt(reg)	;make up arg to GET
	movn	reg1,reg1		;will transfer whole buffer
	jrst	@filget(reg)		;call appropriate routine

chkmta:	;routine to handle blocksize requests for MTA (lh of REG5)
	move ac0,filst1(reg)
	tlnn ac0,filmta			;if not magtape
;;NB: ac0 is used again at mta1 - be sure it is not touched
	popj p,				;forget it
	tlnn reg5,377777		;if no request
	jrst mta1			;see if want industry compat
;Now we do a TAPOP. to set the blocksize
	add reg5,[xwd 1,0]	;tapop. and buffer use size+1
	movei	reg1,2006		;arg block reg1:reg3 - set blocksize
	ldb	reg2,[point 5,filchn(reg),12]	;channel
	push	P,reg3		;need this later
	hlrz	reg3,reg5		;requested block size
	trz	reg3,400000		;[22] clear bit for logical blocking
	move	ac1,[3,,reg1]
	tapop.	ac1,
	 jrst	tapfai
	pop	P,reg3
;Now we do MTAPE to set industry-compat. mode, if requested
mta1:	
	tlnn ac0,filind			;request for indus mode?
	popj p,				;no
	move ac1,filchn(reg)		;get MTAPE
	tlo ac1,(%mtape)
	hrri ac1,101			;code to set indust. mode
	xct ac1				;no error return
	popj	P,

tapfai:	outstr [asciz/
?	TAPOP. to set blocksize failed/]
	jrst erend

;rclose - This is documented as a close followed by a release.  To
;  be consistent with Tops-20, it also deletes temporary files, so
;  clofxx if used instead of clofil
rclose:	move ac1,filtst(b)	;is this a legal block?
	caie ac1,314157
	pushj p,initb.		;no - make it one
	pushj p,clofxx
	move t,filchn(reg)	;get the appropriate close UUO
	tlo t,(release)	;make it release
	xct t
	popj p,

;clofxx - like clofil, but if the file is "temporary" (i.e. internal),
;  deletes it. uses A and C, I think.
clofxx:	move a,filst1(b)	;get flags
	tlnn a,filtmp		;if not temp
	jrst norclo		;this is a normal close
;mode-dependent close
	move a,filr99(b)	;mode-dependent closer
	move a,filclo(a)
	skipe a			;if there is one
	pushj p,(a)		;call it
;change dispatch vector to error
	hrli ac1,notopn		;and mark pascal file not open
	hrri ac1,filr11(reg)
	blt ac1,filr99(reg)
;now instead of a close, we want a delete, but it had better be open!
	skipe filbfp(b)		;is there is channel open?
	jrst rclo1		;yes
;here if not open, do so
	pushj p,fn.chn		;no - get a channel
	dpb a,[point 4,filchn(b),12] ;put it in right field
	move a,filchn(b)	;make up open UUO
	hrri a,filsta(b)
	push p,filbfh(b)	;save buffers (probably none) over open
	tlo a,(open)
	xct a			;OPEN
	 jrst [pop p,filbfh(b)	;can't get rid of temp file, normal close
	       jrst norclo]
	pop p,filbfh(b)
	hrri a,filnam(b)	;make arg for lookup
	hll a,filchn(b)		;channel
	tlo a,(lookup)		;op code
	xct a
	 jrst norclo	
;we now have an open file
rclo1:	hll a,filchn(b)		;make a rename
	tlo a,(%rename)		;make it rename
	push p,d
	hrri a,c		;arg block is in C,D
	setzb c,d		;make it null
	xct a			;delete the file
	 jrst [pop p,d		;can't delete it, proceed with close
	       jrst norclo]
	pop p,d
	ldb a,[point 4,filchn(b),12] ;channel number
	pushj p,lo.chn		;[25] set channel (A) unused
	jrst clofl1		;get rid of buffers

;clofil - implements CLOSE
clofil:	move ac1,filtst(b)	;is this a legal block?
	caie ac1,314157
	pushj p,initb.		;no - make it one
	jrst doclos

norclo:	setz reg1,
;reg1 contains bits
doclos:	
;mode-dependent close
	move ac1,filr99(reg)	;mode-dependent closer
	move ac1,filclo(ac1)
	skipe ac1		;if there is one
	pushj p,(ac1)		;call it
;change dispatch vector to error
	hrli ac1,notopn		;and mark pascal file not open
	hrri ac1,filr11(reg)
	blt ac1,filr99(reg)
;if there is a channel to close, close it and free the channel
	skipn filbfp(reg)	;SEE IF WE HAVE A CHANNEL ASSIGNED
	jrst clofl1		;NO - FORGET THIS
	setzm filbfp(reg)	;NOTE THAT IT IS NOW GOING AWAY.
	hll reg1,filchn(reg)	;get close (RH is bits)
	tlo reg1,(close)
	xct reg1
	ldb ac1,[POINT 4,FILCHN(REG),12]	;GET THE CHANNEL NO.
	pushj p,lo.chn		;[25] set channel (ac1) unused
;release the buffer, if any
clofl1:	hrrz a,filbfh(b)	;see if there is a buffer
	jumpe a,cloflx		;no, nothing more
	pushj p,retbuf		;yes, return it to storage
	setzm filbfh(b)		;there isn't now
cloflx:	popj p,

;retbuf - address of buffer ring in A.  Puts it in free list.
;a,c are garbaged, nothing else touched.
;  This code must be very clever in case it is interrupted.  The
;  worst that can happen in that case is some buffer can be lost
;  from the free list, but that is fairly unlikely.
retbuf:	
;first we count the number of buffers in the ring
;and clear the use bit in each
	push p,t		;t - bit to clear use bit
				;a - start of ring
	push p,b		;b - current place in ring
	push p,c		;c - count
	hrlzi t,400000	;initialize the above
	move b,a
	movei c,1
retbfl:	andcam t,(b)		;clear use bit
	hrr b,(b)		;get next buffer in ring
	came b,a		;same as first?
	aoja c,retbfl		;no - count and loop
;now we make up the buffer description, count,,size, which is used
;to compare free buffers against what we need
	hrlz c,c		;c _ count,,size
	hlr c,(a)		;  size field from buffer
	addi c,2		;incr size by 2 to get the way DEVSIZ counts
	movem c,-1(a)		;put in -1 entry in first buffer
;Now we have the buffer list ready to put in free list
;Critical section
	pushj p,enterc
	move c,buflst		;old list
	movem c,1(a)		;link old list after us
	movem a,buflst		;and put us as head of list
	pushj p,leavec
;End critical section
	pop p,c
	pop p,b
	pop p,t
	popj p,

;getbuf - get a buffer ring.
;  A - count,,size of buffers in ring.  Returns addr of first
;	buffer found, or 0 if none
;  All but A are saved.
getbuf:	push p,b
	push p,c
;begin critical section
	pushj p,enterc
  ;a - target description
  ;b - predecessor of current thing being considered
  ;c - current buffer being considered
	movei b,buflst-1	;free list header is predecessor
getbfl:	move c,1(b)		;look at next
	jumpe c,getbfn		;end of list - none there
	camn a,-1(c)		;compare desired with this one
	jrst getbff		;match - we have found one
	move b,c		;failed, advance
	jrst getbfl
  ;we found one, b=pred, c=this
getbff:	move a,1(c)		;get next
	movem a,1(b)		;link it as next from pred
	setzm -1(c)		;clear garbage used for list linkage
	setzm 1(c)
  ;here also if none found, c=0 in that case
getbfn:	pushj p,leavec
;end criticial section
	move a,c		;return thing found
	pop p,c
	pop p,b
	popj p,

getchn:	pushj p,fn.chn		;get a channel for user to play with
	movem ac1,1(p)		;place to return ftn. value
	popj p,

relchn:	cail reg,0		;free a channel user is done with
	caile reg,17		;see if legal
	jrst badchn		;no
	move ac1,reg		;[25] now free it
	pushj p,lo.chn		;[25]
	popj p,
badchn:	outstr [asciz /
?	RELCHN: illegal channel/]
	jrst erend

curchn:	ldb	ac0,[point 4,filchn(reg),12]	;get a file's chan
	movem	ac0,1(P)	;and return it
	popj	P,		

lkerr:	move	ac0,(reg4)	;here if lookup fails - get code
	tlnn	ac0,777777	;this is word 0 - was it extended?
	addi	reg4,2		;yes - code is later is block
	hrrz	ac0,1(reg4)	;get error code
	jrst	opnerr

rewrit:	pushj 	p,option
	setz	ac0,		;EOF setting for error is 0
	movem	ac0,filbad(reg)
	caie	reg,ttyout##	;see if openning TTY
	cain	reg,tty##
	jrst	ttout		;set up specially
	pushj	p,setnam
	 jrst	opener
rewrt2:  ;secondary entry for append
	hrrz	ac0,filst1(reg)	;device type
	trze	reg5,100000	;if normal open forced
	jrst	.+3		;skip test for tty
	cain	ac0,3		;tty
	pushj	p,ttopou
	hrlzi	ac0,filbfh(reg)
	pushj	p,reopen
	 jrst	opener
	movsi	ac1,(enter)	;do enter
	pushj	p,lkent
	 jrst	opener
	pushj	p,chkmta	;set mta blocksize if asked
	movsi	ac0,(outbuf)
	pushj	p,modini	;now do mode-dependent init
	movei	ac0,illfn	;make reading illegal
	movem	ac0,filget(reg)
	sub	p,[openoff]
	popj	p,

nochan:	setzm	filbfp(reg)	;no chans-get sure we remember
	movei	ac0,^d103	;and set error code
	jrst	opnerr

badnam:	movei	ac0,^d102	;here if syntax error in file name
	jrst	opnerr

operr:	movei	ac0,^d101	;here if the open UUO failed
	jrst	opnerr

opnerr:	tro ac0,1B24		;general routine for all errors in reset etc.
	hrlm ac0,filerr(reg)	;lookup/enter code, with bit 23 on
	move ac0,filerr(reg)	;see if we are enabled for these errors
	hrli ac0,notopn		;enabled for error - mark file not open
	hrri ac0,filr11(reg)
	blt ac0,filr99(reg)
	jrst eofclr		;set eof and clear variable

	subttl REOPEN, BREAK, and BREAKIN

;Device-indepedent initializations for open routines
; save parameters in case of error
; close old file
; get file name
; get device type
;Note that this routine saves data on the stack, to allow restarting
;the routine in case of an error.  This means that the caller will
;have to prune the stack before returning.
setnam:	push	p,reg4		;save AC's in case of error retry
	push	p,reg5
	push	p,reg6
	push	p,-3(p)		;our return address
  openoff==<xwd 4,4>		;use this to clean off the stack
;stack is now ret addr; reg4; reg5; reg6; ret addr
;the low ret addr is used for the error retry
	push	p,reg1
	movei	a,norclo	;assume normal close
	tlnn	reg1,400000	;but if getting new name from tty
	skipe	reg2		;or file spec
	movei	a,clofxx	;then kill any old temp file
	pushj	p,(a)		;close one way or the other
	pop	p,reg1
	move	ac0,reg6	;set up enabled errors
	andi	ac0,776000
	movem	ac0,filerr(reg)
	tlnn	reg1,400000	;if getting from tty, length may be 0
	jumpe	reg2,setnm1	;if no name, skip the name parsing
	PUSH	P,REG
	PUSH	P,REG3
	push	P,reg4		
	push	P,reg5		
	push	p,reg6
	push	P,ac0		;dummy entry- gets garbaged
	pushj	p,parse.	;parse file name
	pop	P,ac0		
	pop	p,reg6
	pop	P,reg5		
	pop	P,reg4		
	POP	P,REG3
	POP	P,REG
	skipe	fileof(reg)		;see if parse complained
	jrst	badnam			;yes - bad file name
	jrst setnm2			;now we have a good name
;here if user didn't give a name.  See if we have an old one
setnm1:	skipe fildev(reg)
	jrst setnm2			;yes, we have a name of some sort
;here if no spec and no existing name - this is an internal file, we have
;to gensym a name.  Also, we set filtmp so it gets deleted upon exit of
;the lexical scope in which it was created.
;The name we make is of the form 001234.nnn   where 1234 is
;the address of the FCB in octal (for debugging), and nnn is job number
	movsi t,filtmp		;set temp flag
	iorm t,filst1(b)
  ;name
	hrlz a,b		;a _ fcb addr left justified
	movei c,6		;c _ digit counter
	setz t,			;t _ place where we build up name (sixbit)
maksp1:	lsh t,3			;make room for next digit
	lshc t,3		;next digit into RH of T
	tro t,20		;turn number into digit
	sojg c,maksp1		;do for all digits
	movem t,filnam(b)
  ;extension
	pjob a,			;a _ job number left just
	lsh a,^D27
	movei c,3		;c _ digit counter
	setz t,			;t _ place where we build up name
maksp2:	lsh t,3
	lshc t,3
	tro t,20
	sojg c,maksp2
	lsh t,^D18		;needs to be left justified
	movem t,filext(b)
  ;rest of params
	movsi t,'DSK'		;always disk
	movem t,fildev(b)
	setzm filpro(b)
	setzm filppn-1(b)
	setzm filppn(b)
	setzm filppn+1(b)
setnm2:	move ac0,fildev(reg)		;see if magtape
	devtyp ac0,
	 setz ac0,
	andi ac0,77			;device code
	hrrm ac0,filst1(reg)		;save it for the world
	aos (p)				;ok return is skip
	popj p,

;XOPNER is a special version of OPENER for RESET.  It checks for
;"temporary" (i.e. internal) files, and if it is failing with
;file not found, allows the error.  this is because a non-existent
;input file is supposed to give immediate EOF, not error.
xopner:	move ac0,filst1(reg)	;magic bits
	tlnn ac0,filtmp		;if not temp file
	jrst opener		;treat as usual
	hlrz ac0,filerr(reg)	;get error code
	caie ac0,1B24+0		;file not found?
	jrst opener		;no - treat as usual
	jrst opene1		;yes - just give EOF return

;OPENER - error processor for the 4 file openning routines.  This
;routine is called from the top level of the openning routine.
;It either aborts that routine or restarts it, depending upon the
;user's request.  It uses the saved data on the stack (from SETNAM)
;to do the restart, if requested.
opener:	move ac0,filerr(reg)	;RH is error bits user specified
	trne ac0,1B24		;did he allow open errors?
	jrst opene1		;yes - do a normal return
	push p,reg3		;analys kills reg3
	pushj p,analys		;no - print error message
	outstr [asciz /Try another file spec: /] ;and let him try again
	pop p,reg3		;restore AC's for restart
	pop p,reg6
	pop p,reg5
	pop p,reg4
	setz reg2,		;length of file spec=0
	movsi reg1,400000	;get spec from TTY
	jrst setnam		;recycle to SETNAM call
;The jrst setnam works because the stack still has the return address
;used when SETNAM was originally called.  So this goes to SETNAM and
;then SETNAM returns near the beginning of the main routine.

opene1:	sub p,[openoff]		;remove garbage left on stack by SETNAM
	popj p,

;reopen performs all initializations that are mode-independent and then
; opens the file
reopen:	setzm	filbtc(reg)	;zero for getindex to get correct error code
	movem	ac0,filbfp(reg)	;set up buffer header
	pushj	p,fn.chn	;get a free channel
	jumpl	ac1,nochan	;if -1, none
	dpb	ac1,[point 4,filchn(reg),12]
;set up the mode
	movem	reg6,filsta(reg);put mode in open block
	andi	reg6,776000	;[16] and the error bits in error place
	movem	reg6,filerr(reg)
	andcam	reg6,filsta(reg);clear these bits in mode word
;set up flags, protection, etc. - all the parameters in the f.c.b.
acset3:	setz reg1,			;assume no flags
	hrrz ac0,filst1(reg)		;get device code
	cain ac0,2			;magtape?
	tlo reg1,filmta			;if so - set bit in filptr
	cain ac0,3			;tty?
	pushj p,chkctm			;if so, see if controlling term
	trze reg5,400000		;request for indust compat?
	caie ac0,2			;and magtape?
	jrst .+2			;no
	tlo reg1,filind			;yes
	trze reg5,200000		;request for lower case mapping?
	tlo reg1,fillcm			;yes - set it
	trze reg5,040000		;request to see end of line?
	tlo reg1,filsel			;yes - set it
	movsi ac0,filtmp		;use old FILTMP flag if any
	and ac0,filst1(reg)		;ac0 now has old tmp flag
	ior reg1,ac0			;or it into flags we're making
	hllm reg1,filst1(reg)		;now put result in flag area
	setzm filrcs(reg)
	setom filphb(reg)
	skipn filbad(reg)		;[33] if writing
	aos filphb(reg)			;[33] starts at block zero
	move ac0,reg3			;move prot code into right place
	lsh ac0,^D27			; in ac0 so we don't change reg3
	movem ac0,filprot(reg)		; which is also interactive flag
	MOVE	AC0,[XWD 777000,0]	;ZERO REST OF PROT WORD
	ANDM	AC0,FILPROT(REG)
	HLLZS	FILEXT(REG)		;ZERO REST OF EXTENSION WORD
	MOVEI	AC0,FILPPN-2(REG)	;POINTER TO PATH
	SKIPN	FILPPN(REG)		;IS THERE ANYTHING THERE?
	SETZ	AC0,			;NO - USE ZERO
	MOVEM	AC0,FILNAM+3(REG)	;WHERE PATH POINTER GOES
	move	ac0,filbad(reg)		;set eof to normal value
	trc	ac0,1
	movem	ac0,fileof(reg)	
	SETZM	FILEOL(REG)		;CLEAR EOL - MARKER
	SETZM	FILCMP(REG)		;CLEARS COMPONENT
	MOVE AC0,[ASCII/-----/] 	;FOR INITIALIZE FILLINENUMBER
	MOVEM AC0,FILLNR(REG)
;actually do the open
	move	ac0,filchn(reg)		;make up open UUO
	hrri	ac0,filsta(reg)
	tlo	ac0,(open)
	xct	ac0			;OPEN
	jrst	operr			;error on open
	trnn	reg5,077000		;byte size spec?
	jrst	openx			;no - done
	ldb	ac0,[point 6,reg5,26]	;yes - put it in
	dpb	ac0,[point 6,filbtp(reg),11]
	trz	reg5,077000		;and clear field for buffer count
openx:	aos	(p)			;normal exit - skip
	popj	p,

chkctm:	push p,t
	push p,a
	move t,fildev(b)
	devnam t,
	setz t,
	getlin a,
	camn a,t
	tlo reg1,filctm
	pop p,a
	pop p,t
	popj p,	

spcsiz=^D30 ;words
;parse. - file name parser.  just calls PARSE unless bit set asking to
; get file spec from TTY.
parse.:	movsi a,filtmp			;this is now a real file
	andcam a,filst1(b)
	tlnn c,400000			;if no special request
	jrst parse			;just call parse directly
	push p,o			;standard entry sequence
	hrls o,p
	hrri p,spcsiz*5+1(p)
	caig n,40(p)	
	jsp a,corerr
spclp1:	move a,[point 7,1(o)]		;put file spec on stack
	movei d,0			;count in d
spclop:	inchwl t			;get char 
	caie t,33			;stop at eol
	cain t,14
	jrst spcdon
	cain t,12
	jrst spcdon
	cain t,15
	jrst spccr			;special for cr
	idpb t,a			;normal char - put it in
	aoj d,				;count
	caige d,spcsiz*5			;if too many, error
	jrst spclop			;else go back for more
	outstr [asciz /
? File spec too long.  Try again: /]
	clrbfi
	jrst spclp1			;try again
spccr:	inchwl t			;read lf
spcdon:	movei c,1(o)			;addr is on stack
	push p,b
	push p,t
	pushj p,parse			;parse the thing
	pop p,t
	pop p,b
	skipn fileof(b)			;was it ok?
	jrst spcxit			;yes - done
	outstr [asciz /
? Illegal file spec.  Try again: /]	;no - try again
	clrbfi
	jrst spclp1

spcxit:	hrri p,(o)			;normal exit code
	pop p,o
	popj p,

;EOF handling.  There are 4 routines:
;
;	SETEOF - just sets Pascal EOF
;	EOFCLR - sets Pascal EOF and also clears the Pascal buffer
;
;Versions of the above using SEF instead of EOF.  These are used by the
;  pmap I/O routines to simulate EOF.  When doing pmap I/O, we never 
;  really get a physical EOF.  Instead we simulate it when we reach a
;  position that matches the end of file pointer.

setsef:	hrlzi ac0,20000			;eof bit
	iorm ac0,filerr(reg)		;say it happened
	;jrst seteof

seteof:	move ac0,filbad(reg)		;set eof to complement of normal
	movem ac0,fileof(reg)
	popj p,

sefclr:	hrlzi ac0,20000			;eof bit
	iorm ac0,filerr(reg)		;say it happened
	;jrst eofclr
	
eofclr:	move ac0,filbad(reg)		;set eof to complement of normal
	movem ac0,fileof(reg)
	skipge	filcnt(reg)		;see if ASCII
	jrst	seteob			;no - clear binary element
	MOVEI  AC0, " "
	MOVEM  AC0,FILCMP(REG)		;INSERT BLANK
	movei	ac0,1			;be sure it is 1
	movem	ac0,fileol(reg)		;now called in wierd contexts
	POPJ	 P,

seteob:	push p,ac1	;can't use 0 as index!
	move ac1,filcnt(reg)
	setzm (ac1)	;clear binary component
	aobjn ac1,.-1
	pop p,ac1
	popj p,

;put null in buffer and set eof - for interactive file openning
setnul:	movei ac0,1
	movem ac0,fileol(reg)
	setzm filcmp(reg)
	popj p,

brkn:	setzm filrcs(reg)	;forget last record
	pushj p,@filadv(reg)	;put out this buffer
	jrst seteof		;set eof and exit
	popj p,

brkin:	setzm filrcs(reg)		;forget last record
	move ac0,filchn(reg)		;make a WAIT
	tdo ac0,[exp %wait]
	xct ac0				;never skips
	movsi ac0,400000		;clear out buffer
	move ac1,filbfh(reg)		;first in ring
	andcam ac0,(ac1)		;clear use bit
	hrr ac1,(ac1)			;get next buffer
	came ac1,filbfh(reg)		;full circle?
	jrst .-3			;no - clear next
	move ac0,filchn(reg)		;make in IN UUO
	tlo ac0,(IN)
	hrr ac0,filbfh(reg)		;in with explicit buffer addr
	aos filphb(reg)			;note that another block has come
	xct ac0
	jrst brkdn.			;normal
	pushj p,geter.			;error - return to .-1 or abort
	jrst brkdn.			;there is data
	jrst eofclr			;there is not - set eof and exit
;entry for a routine that needs to do implicit GET
brkdn.:	skipe reg1			;user asked us not to do get?
	jrst setnul			;[34] yes - done
	hlre reg1,filcnt(reg)		;set up arg to GET
	movn reg1,reg1			;transfer whole buffer
	jrst @filget(reg)		;do the GET

brktty:	clrbfi				;this has same effect as above
	movei ac0,tgetch		;cancel saved LF if any
	movem ac0,filget(reg)
	jrst brkdn.

TTYOPN: PUSHJ	 P,PUTLN
	MOVEI	  AC0,"*"		;TYPE ASTERISK
	PUSHJ	 P,PUTCH
	PUSHJ	 P,BREAK
	POPJ	 P,

	subttl random access for normal files

;curpn - curpos for normal buffered files
curpn:	move ac0,filbad(reg)	;see if eof
	camn ac0,fileof(reg)
	jrst cureof		;yes - return -1
	skipge filphb(reg)	;see if at start of file
	jrst retzer		;yes - return 0
curpn1:	hrrz ac0,filst2(reg)	;ac0 _ buffer size in bytes
	imul ac0,filphb(reg)	;ac0 _ bytes before this buffer
	push p,ac0		;0(p) _ bytes before this buffer
	move ac1,filbfh(reg)	;ac1 _ addr of buffer
	move ac1,1(ac1)		;ac1 _ words in this buffer
	hlrz ac0,filst2(reg)	;ac0 _ bytes per word
	imul ac1,ac0		;ac1 _ bytes this buffer
	sub ac1,filbtc(reg)	;ac1 _ bytes in buf. before cur. pos
	add ac1,0(p)		;ac1 _ bytes in file before cur. pos
	pop p,ac0		;restore stack
	movem ac1,1(p)		;return cur. pos
	popj p,

cureof:	setom 1(p)		;return eof indication
	popj p,

;setpn - setpos for normal buffered files
;  reg1 - target
;  reg2 - suppress get
setpn:	skipn filbad(reg)	;must be input file
	jrst illfn
	setzm fileof(reg)	;[27] clear end of file
;	skipe fileof(reg)	;no-op at end of file
;	popj p,
	hrrz reg4,filst2(reg)	;reg4 _ bytes/block
	move reg3,reg1		;reg3 _ target in bytes
	idiv reg3,reg4		;reg3 _ block#; reg4 _ bytes into block
	camn reg3,filphb(reg)	;on right block already?
	jrst setpn3		;yes - skip read
;here if we have to move to a new block
	movem reg3,filphb(reg)	;[27] for breakin
	sos filphb(reg)		;[27] filphb _ block before this one
	addi reg3,1		;adjust reg3 to monitors numbering scheme
	tlo reg3,(useti)	;make useti
	ior reg3,filchn(reg)
	xct reg3		;useti to correct block
	seto reg1,		;suppress get from breakin
	pushj p,brkin		;now let breakin get in the block
	skipe fileof(reg)	;did it work?
	popj p,			;no
;here to get to the right byte within the block after reading it
setpn1:	movn reg3,reg4		;reg3 _  - bytes into the block
	addm reg3,filbtc(reg)	;adjust byte counter
	move reg3,reg4		;reg3 _ bytes into the block
	hlrz reg4,filst2(reg)	;reg4 _ bytes per word
	idiv reg3,reg4		;reg3 _ words, reg4 _ bytes
	addm reg3,filbtp(reg)	;adjust byte pointer by words
	jumpe reg4,setpn2	;and if non-zero bytes
	ibp filbtp(reg)		;then by bytes
	sojg reg4,.-1
;here to get new item unless suppressed
setpn2:	skipe reg2		;suppress get?
	popj p,			;yes - done
	hlre reg1,filcnt(reg)	;no - do get
	movn reg1,reg1
	jrst @filget(reg)

;here if current buffer is right - redo count and pointer
setpn3:	move ac1,filbfh(reg)	;ac1 _ words in this buffer
	move ac1,1(ac1)
	hlrz ac0,filst2(reg)	;ac0 _ bytes per word
	imul ac1,ac0		;ac1 _ bytes in this buffer
	movem ac1,filbtc(reg)	;use for byte count
	move ac1,filbtp(reg)	;ac1 _ byte size field only
	tlz ac1,770077
	hrr ac1,filbfh(reg)	;addr of buffer
	addi ac1,1		;start at data area
	movem ac1,filbtp(reg)	;use for byte pointer
	jrst setpn1		;now adjust for count into buffer
	
	subttl update mode

;Update mode is done in mode 17 (dump).  However it is originally
; openned normally and buffers are allocated.  We just do I/O into
; them in dump mode.  Note that only one of the buffers is used.
; In additional to the usual information, the length of the file
; in words is kept at -1 in the buffer header.  This is because we
; have to simulate end of file ourselves in order to get things
; accurate to the word, instead of just the block as the easiest
; implementation would do. Also, RH(filst1) is a flag indicating
; whether the current buffer has been written into, so we don't
; rewrite it unless we have to.  This is set up so that sequential
; reading in update mode doesn't have any extra overhead (except
; that there is a block size of 1)

update:	pushj p,option
	caie reg,tty##		;illegal except for disk
	cain reg,ttyout##
	jrst upbdev
	movei ac0,1		;set up for input
	movem ac0,filbad(reg)
	pushj p,setnam
	 jrst opener
	hrrz ac0,filst1(reg)
	jumpn ac0,upbdev
	hrrzi ac0,filbfh(reg)	;open file and init status
	pushj p,reopen
	 jrst opener
	push p,reg4
	push p,[exp 5]		;make up extended block on stack
	add p,[xwd 5,5]
;stack: saved reg4, exp 5, junk, junk, junk, junk, junk
	movei reg4,-5(p)	;here is addr of ext. block
	movsi ac1,(lookup)
	pushj p,lkent
	 jrst updx
	move reg4,-6(p)		;recover the user's block
	movsi ac1,(enter)
	pushj p,lkent
	 jrst updx
	pop p,reg4		;reg4 _ file size
	sub p,[xwd 6,6]
	movsi ac0,(inbuf)	;allocate buffers and other init's
	pushj p,modini
	move ac1,filbfh(reg)	;ac1 _ addr of buffer
	move ac0,reg4		;ac0 _ size of file in words
	movem ac0,-1(ac1)	;save in buffer header
	movei ac0,200		;always treat buffer as full
	movem ac0,1(ac1)	; (this is word count in header)
	move ac0,filchn(reg)	;go into dump mode
	tlc ac0,(setsts)	;make a setsts
	hrr ac0,filsta(reg)	;original file status
	tro ac0,17		;same except dump mode
	hrrm ac0,filsta(reg)	;save it for future setsts's
	xct ac0			;do the setsts
	hrli ac0,updtxt		;now set up special dispatch table
	skipge filcnt(reg)	;if record
	hrli ac0,updrec		;use that one
	hrri ac0,filr11(reg)
	blt filr99(reg)
	movei ac0,updadv	;special advance routine
	movem ac0,filadv(reg)
	setzm filppn(reg)	;special count for read
	sub p,[openoff]
	jrst setnul		;interactive open

updx:	sub p,[xwd 7,7]
	jrst opener

;breakin
brkiu:	setzm filcnt(reg)
	jrst brkdn.

;break
brku:	setzm filrcs(reg)	;forget last record
	push p,fileof(reg)	;save old eof
	setzm fileof(reg)	;clear eof to make op always happen
	pushj p,updadv		;next buffer
	 pushj p,seteof		;if error, set eof
	pop p,ac0		;get old eof
	iorm ac0,fileof(reg)	;reset it if it was on
	popj p,

;special buffer advance
;  error
;  OK
updadv:	push p,ac1
	push p,reg1
	push p,reg2
	move reg1,filphb(reg)	;current block
	addi reg1,1		;next block
	hrrz reg2,filst2(reg)	;bytes per block
	imul reg1,reg2		;reg1 _ first byte next block
	seto reg2,		;suppress get
	pushj p,setpup		;not go there random access
	sos filbtc(reg)		;caller expects it to be decremented
	pop p,reg2
	pop p,reg1
	pop p,ac1
	skipn fileof(reg)	;if no failure
	aos(p)			;success return
	popj p,

;setpup - setpos for update mode
; reg1 - target
; reg2 - suppress get flag
setpup:	setzm fileof(reg)	;[27] clear eof
;	skipe fileof(reg)	;forget it if eof
;	popj p,
;ac1 is addr of buffer throughout this routine
	move ac1,filbfh(reg)	;ac1 _ addr of buffer
	push p,reg3
	push p,reg4
	push p,reg5	
	move ac0,filst1(reg)	;see if write needed
	trne ac0,-1		;if no write or
	skipge reg3,filphb(reg)	;if still at start of file
	jrst setpu2		;then no write needed
				;reg3 _ current block
;here if the current block has changed.  may have to write it
	ldb ac0,[point 29,-1(ac1),28] ;ac0 _ block # of end of file
	camge reg3,ac0		;if at last block or later
	jrst setpu1		;not
;here if we are at last block of the file or later - update eof
	lsh reg3,7		;reg3 _ words before this block
	hrrz ac0,filbtp(reg)	;ac0 _ words this block
	subi ac0,1(ac1)
	add ac0,reg3		;ac0 _ new words in file
	camle ac0,-1(ac1)	;word cnt, ac0 _ max (old,new)
	movem ac0,-1(ac1)
	move ac0,-1(ac1)
	sub ac0,reg3		;ac0 _ words this block
	caile ac0,200		;if more than 200, just use 200
setpu1:	movei ac0,200
;at this point, the eof count is updated, and ac0 has # words in this buf.
;we now find out whether we have to write the block
	move reg4,reg1		;reg4 _ target byte
	hrrz reg5,filst2(reg)	;reg5 _ bytes/block
	idiv reg4,reg5		;reg4 _ target block
	camn reg4,filphb(reg)	;same as now?
	jrst setpu4		;yes - no I/O needed
;here when we have to write the block and read new one
	movn reg3,ac0		;reg3 will be IOWD
	hrl reg3,reg3
	hrri reg3,1(ac1)
	setz reg4,		;reg4 will be command end
	move ac0,filphb(reg)	;ac0 will be USETO to current block
	add ac0,[useto 1]
	ior ac0,filchn(reg)
	xct ac0			;do useto
	move ac0,filchn(reg)	;ac0 will be OUT uuo
	ior ac0,[out reg3]
	xct ac0			;do OUT
	jrst setpu3		;OK
	pushj p,geter.
	jrst setpu3
	jrst setpuy
;here when the block has not changed.  See if we need new one.
setpu2:	move reg4,reg1		;reg4 _ target byte
	hrrz reg5,filst2(reg)	;reg5 _ bytes/block
	idiv reg4,reg5		;reg4 _ target block
	camn reg4,filphb(reg)	;same as now?
	jrst setpu4		;yes - no I/O needed
;here to read a new block
setpu3:	hllzs filst1(reg)	;clear change indicator of old block
	move reg3,reg1		;reg3 _ target byte
	hrrz reg4,filst2(reg)	;reg4 _ bytes/block
	idiv reg3,reg4		;reg3 _ target block; reg4 _ bytes into it
	move reg4,filphb(reg)	;reg4 _ old block
	movem reg3,filphb(reg)	;say we are there
	move ac0,-1(ac1)	;ac0 _ last block in file
	subi ac0,1
	ash ac0,-7
	camle reg3,ac0		;is the desired block there?
	jrst setp3b		;no - don't try to read it
	addi reg4,1		;see if next block
	camn reg4,reg3		;is what we want
	jrst setp3a		;yes - no need for useti
	add reg3,[useti 1]	;make useti for block
	ior reg3,filchn(reg)
	xct reg3		;do useti
setp3a:	hrli reg3,-200		;make IOWD
	hrri reg3,1(ac1)
	setz reg4,
	move ac0,filchn(reg)	;make IN
	ior ac0,[in reg3]
	xct ac0			;do IN
	jrst setpu4		;OK
	pushj p,geter.
	jrst setpu4
	jrst setpux
;here when asked to read a non-existent block
setp3b:	setzm 2(ac1)		;zero first word
	hrli ac0,2(ac1)		;now rest of block
	hrri ac0,3(ac1)
	blt ac0,201(ac1)
;all paths join here - we are at the right block
setpu4:	move reg3,reg1		;reg3 _ target
	hrrz reg4,filst2(reg)	;reg4 _ bytes / block
	idiv reg3,reg4		;reg4 _ bytes into block
;reinit buffer
	move ac0,filbtp(reg)	;reinit buffer
	tlz ac0,770077
	hrri ac0,1(ac1)
	movem ac0,filbtp(reg)	;new pointer
	hlrz ac0,filst2(reg)
	lsh ac0,7
	movem ac0,filbtc(reg)	;new count (full 200 words)
	movem ac0,filppn(reg)	;special count for read
;set special count for read if at end
	ldb ac0,[point 29,-1(ac1),28] ;ac0 _ block # of eof
	camge reg3,ac0		;might the block be only part full?
	jrst setpu5		;no - go adjust count and pointer
	move ac0,reg3		;ac0 _ block number
	lsh ac0,7		;ac0 _ words before this block
	move ac1,-1(ac1)	;ac1 _ end of file in words
	sub ac1,ac0		;ac1 _ end of file relative to start of buf
	caige ac1,0		;if less than 0, normal to zero
	movei ac1,0
	caile ac1,200		;if greater than 200, normal to 200
	movei ac1,200
	hlrz ac0,filst2(reg)	;ac0 _ bytes per word
	imul ac0,ac1		;ac0 _ count in bytes
	movem ac0,filppn(reg)	;use as special read count
setpu5:	movn reg3,reg4		;reg3 _  - bytes into the block
	addm reg3,filbtc(reg)	;adjust byte counter
	addm reg3,filppn(reg)	;and one for read
	move reg3,reg4		;reg3 _ bytes into the block
	hlrz reg4,filst2(reg)	;reg4 _ bytes per word
	idiv reg3,reg4		;reg3 _ words, reg4 _ bytes
	addm reg3,filbtp(reg)	;adjust byte pointer by words
	jumpe reg4,setpux	;and if non-zero bytes
	ibp filbtp(reg)		;then by bytes
	sojg reg4,.-1
setpux:	pop p,reg5
	pop p,reg4
	pop p,reg3
	skipe reg2		;get to be done?
	popj p,			;no - done
	hlre reg1,filcnt(reg)	;yes, do it
	movn reg1,reg1
	jrst @filget(reg)

setpuy:	pushj p,eofclr		;error - set eof and exit
	jrst setpux

upbdev:	outstr [asciz /
?	/]
	pushj p,wrtfnm
	outstr [asciz / UPDATE may only be used with disks
/]
	jrst erend
		
	subttl error analysis routines


;runer. - general-purpose routine for processing runtime errors.
;  if t matters to a continuation, we assume it has been saved at erracs
;  t - addr of PC to print out
;  pushj p,runer.
;  here if user continues (after correcting error, one hopes)
;This routine prints a PC, then either goes to a debugger (if there
;is any) or warns the user that continuation is at his own risk.
;If there is any reason to believe that P is blown, you had better
;supply a good one before calling this guy.

	reloc 0

ddtgo:	block 1
erracs:	block 20

	reloc

runer.:	movem 0,erracs			;save the AC's
	move 0,[xwd 1,erracs+1]
	blt 0,erracs+17
	move 0,erracs
	OUTSTR	 [ASCIZ/ at user PC /]
	HRRZI	 REG2, 6
	MOVE	 REG3,[POINT 3,AC0,17]
	ILDB	 AC1, REG3
	ADDI	 AC1, 60
	OUTCHR	 AC1
	SOJG	 REG2,.-3
	HRR	AC1,.JBDDT		;LOAD PASDDT-ADDR
	JUMPE	AC1,hlterr		;no debugger, just halt him
	move	ac1,.jbddt		;want left half, too
	tlze	ac1,777777		;if zero, it is PASDDT
	jrst	decddt			;if not, real DDT
	pushj	p,-1(AC1)		;GOTO 'ERRDB.'
	jrst	errest			;continue if he continues

decddt:	movem ac0,.jbopc##		;save PC so he can continue
	hrrzm ac1,ddtgo
	outstr [asciz /
[Type POPJ 17,$X to continue if possible, but don't trust any results] 
/]
	move 0,[xwd erracs+1,1]		;restore ac's to pgm context
	blt 0,16
	move 0,erracs
	pushj p,@ddtgo			;[3] avoid -1 entry point!
	jrst errest			;continue if he exits

;no debugger, just halt and let him go on if he dares
hlterr:	outstr [asciz /
[Type CONTINUE to proceed if possible, but don't trust any results]
/]
	exit 1,				;continuable halt
;	jrst errest

;here to continue if the user really wants to
errest:	move 0,[xwd erracs+1,1]
	blt 0,17
	move 0,erracs
	popj p,

ilfil.:	outstr [asciz /
? Uninitialized file/]
	move t,(p)
	pushj p,runer.
	movei b,tty##		;use tty instead
	popj p,

blktbe:	push p,t
	setz t,			;we don't know the location
	outstr [asciz /
? Too many files open at once/]
	pushj p,runer.
	pop p,t
	popj p,

INXERR: OUTSTR	[ASCIZ /
?	array index out of bounds/]
	PUSHJ	P	,runer.
	jrst @0

PTRER.:	OUTSTR [ASCIZ /
?	uninitialzed or NIL pointer/]
	PUSHJ P,runer.
	JRST @0


SRERR:	OUTSTR[ASCIZ/
?	scalar out of range/]
	PUSHJ	P,runer.
	JRST @0

analys:	hlrz	ac1,filerr(reg)	;get error bits
	jumpe	ac1,analx	;if none, no-op
	trnn	ac1,1B24	;open error?
	jrst	anioer		;no - analyze bits
	andi	ac1,177		;yes - get code
	caile	ac1,30		;codes between 31 and ^d99 are unknown
	cail	ac1,^d101	
	jrst	.+2		
	movei	ac1,36		;unknown error
	cain	ac1,^d101	;special codes get mapped down
	movei	ac1,33		
	cain	ac1,^d102	
	movei	ac1,34		
	cain	ac1,^d103	
	movei	ac1,35		
	cail	ac1,0		;otherwise we don't know it
	caile	ac1,36		
	movei	ac1,36		;unknown error code
	outstr	[asciz /
?  /]			
	pushj	P,wrtfnm	
	outstr	[asciz / /]	
	outstr	@msg(ac1)	
	outstr	[asciz /
/]				
analx:	popj	P,

msg:
 [asciz /(0) file not found/]
 [asciz /(1) no such UFD/]
 [asciz /(2) protection failure/]
 [asciz /(3) file being modified/]
 [asciz /(4) already existing file name/]
 [asciz /(5) illegal sequence of UUOs/]
 [asciz /(6) UFD or RIB error/]
 [asciz /(7) not a save file/]
 [asciz /(10) not enough core/]
 [asciz /(11) device not available/]
 [asciz /(12) no such device/]
 [asciz /(13) illegal UUO/]
 [asciz /(14) no room/]
 [asciz /(15) write-locked/]
 [asciz /(16) not enought monitor table space/]
 [asciz /(17) partial allocation only/]
 [asciz /(20) block not free/]
 [asciz /(21) can't supercede a directory/]
 [asciz /(22) can't delete non-empty directory/]
 [asciz /(23) SFD not found/]
 [asciz /(24) search list empty/]
 [asciz /(25) SFD nest level too deep/]
 [asciz /(26) no-create for all structures/]
 [asciz /(27) high segment not on swap space/]
 [asciz /(30) can't update file/]
 [asciz /(31)/]
 [asciz /file connected to a string/]
 [asciz /OPEN failed/]
 [asciz /illegal file spec/]
 [asciz /no channel free/]
 [asciz /unknown error code/]

anioer:	outstr [asciz /
?	/]
	trne ac1,1b18
	outstr [asciz /Improper mode/]
	trne ac1,1b19
	outstr [asciz /Hard device error/]
	trne ac1,1b20
	outstr [asciz /Hard data error/]
	trne ac1,1b21
	outstr [asciz /Quota exceeded or block too large/]
	trne ac1,1b23
	outstr [asciz /Data format error/]
	trne ac1,1B25
	outstr [asciz /Physical end of tape/]
	outstr [asciz / for file /]
	pushj p,wrtfnm
	outstr [asciz /
/]
	popj p,
	
	subttl routines to simulate I/O using TTCALL's
tgetch:	inchwl ac1			;[12] get char
tgetc3:	andi ac1,177			;[12] in case of pim-ignore parity
	jumpe ac1,tgetch		;[12] skip nulls!
	move a,@filcht(b)	;get eoln flag and mapped char
	hlrem a,fileol(b)	;put down eoln flag
	hrrzm a,filcmp(b)	;put down mapped char
	camn a,[xwd -1,15]	;cr if user wants to see it
	jrst tgetc1		;must be handled oddly
	came a,[xwd -1," "]	;carriage return in official mode
	popj p,
	jrst geteol		;is handled as for other devices

TGETC1:	inchwl ac1		;get the LF
	movem ac1,filst2(reg)	;save it
	movei ac0,tgetc2	;now set up so next get gets saved char
	movem ac0,filget(reg)
	POPJ P,

tgetc2:	move ac1,filst2(reg)	;get saved char
	movei ac0,tgetch	;restore normal read routine
	movem ac0,filget(reg)
	jrst tgetc3		;join normal routine

tputch:	move ac0,filcmp(reg)	;get thing to output
	outchr ac0		;put it out
	popj P,

ttin:	setzm filbfp(reg)	;tell the world these are not open
	hrli ac0,ttytxt		;init dispatch
	hrri ac0,filr11(reg)
	blt ac0,filr99(reg)
	setzm fileof(reg)	;initialize state variables
	movei ac0,1
	setzm filcmp(reg)	;start with end of file and null buffer
	movem ac0,fileol(reg)
	andi reg6,776000	;error bits only
	movem reg6,filerr(reg)		;for data error enabling
	movei ac0,0
	trne reg5,200000	;lower case to upper mapping?
	tlo ac0,fillcm		;yes - set it
	movem ac0,filst1(reg)
	popj p,

ttout:	setzm filbfp(reg)
	hrli ac0,ttytxt
	hrri ac0,filr11(reg)
	blt ac0,filr99(reg)
	movei ac0,1
	movem fileof(reg)
	setzm fileol(reg)
	andi reg6,776000		;error bits only
	movem reg6,filerr(reg)		;for data error enabling
	popj p,

;TTYSHL - Show the error char and the rest of the line
;  current position.  No sideeffects.
;Note that this routine is intended to be called for I/O using the
;user's terminal, but possibly when it is open as a normal device.
;GETCH is used for input, so as to synchronize with pascal I/O.
;direct outchr is used for output, since we can't assume in general
;that he has the output side open.
ttyshl:	outstr [asciz /[Error was detected here:]
/]
ttysh1:	skipe fileol(b)		;copy the rest of the line
	jrst ttysh2
	outchr filcmp(b)
	pushj p,getch
	jrst ttysh1	
	outstr [asciz /
/]
ttysh2:	popj p,

;TTYFXL - clear rest of line and ask user for more.
;expects b to be set up
;t - PC to print if error msg
ttyfxl:	movei a,ttyout##		;FCB for printing
	jrst tryagn

	subttl routines for using TRMOP. on terminals

getct:	push p,[exp .toinc]		;inchwl
	push p,filbtp(reg)		;iondx
	push p,ac1			;dummy
getct1:	movei ac1,-2(p)
	hrli ac1,2
	trmop. ac1,			;get a char
	 jrst trmer
getct2:	andi ac1,177			;[12] in case of pim-ignore parity
	jumpe ac1,getct1		;[12] skip nulls!
	cain ac1,32			;control-Z?
	jrst getct5
	move ac1,@filcht(reg)		;map lower case and eoln
	hlrem ac1,fileol(reg)		;[12] put down eoln flag
	hrrzm ac1,filcmp(reg)		;[12] put down mapped char
	camn ac1,[xwd -1,15]		;CR if user wants to see it
	jrst getct3			;is handled oddly
	sub p,[xwd 3,3]
	came ac1,[xwd -1," "]		;CR in official mode
	popj P,
	jrst geteol			;is handled as for other devices


GETCT3:	movei ac1,-2(p)
	hrli ac1,2
	trmop. ac1,		;get the LF	
	 jrst trmer
	movem ac1,filst2(reg)	;save it
	movei ac0,getct4	;now set up so next get gets saved char
	movem ac0,filget(reg)
	sub p,[xwd 3,3]
	POPJ P,

getct4:	move ac1,filst2(reg)	;get saved char
	movei ac0,getct		;restore normal read routine
	movem ac0,filget(reg)
	push p,[exp .toinc]
	push p,filbtp(reg)
	push p,ac0		;dummy
	jrst getct2		;join normal routine

getct5:	sub p,[xwd 3,3]		;here to set eof
	jrst sefclr		;simulate eof, set eof, and clear buf

trmer:	sub p,[xwd 3,3]
	hrlzi ac0,1B18		;consider this as improper mode error
	iorm ac0,filerr(reg)	;say it happened
	hrrzi ac0,1B18		;see if it is OK
	tdnn ac0,filerr(reg)
	jrst getems		;no - fatal
	jrst eofclr		;yes - set EOF

putct:	push p,[exp .toouc]	;outchr
	push p,filbtp(reg)	;iondx
	push p,filcmp(reg)	;the thing to output
	movei ac0,-2(p)
	hrli ac0,3
	trmop. ac0,
	 jrst trmer
	sub p,[xwd 3,3]
	popj P,

ttopin:	move ac0,fildev(reg)	;get iondx
	iondx. ac0,
	 popj p,		;failed - old monitor or tops-20
				;use normal open
	movem ac0,filbtp(reg)	;save iondx
	hrli ac0,trmtxt		;init dispatch
	hrri ac0,filr11(reg)
	blt ac0,filr99(reg)
	setzm fileof(reg)	;initialize state variables
	movei ac0,1
	setzm filcmp(reg)	;start with end of file and null buffer
	movem ac0,fileol(reg)
	movem reg6,filerr(reg)		;for data error enabling
	movei ac0,0
	trne reg5,200000	;lower case to upper mapping?
	tlo ac0,fillcm		;yes - set it
	movem ac0,filst1(reg)
	sub p,[openoff]
	pop p,(p)		;we were pushj'ed to - abort caller
	popj p,

ttopou:	move ac0,fildev(reg)	;get iondx
	iondx. ac0,
	 popj p,		;failed - old monitor or Tops-20
				;use normal open
	movem ac0,filbtp(reg)	;save iondx
	hrli ac0,trmtxt
	hrri ac0,filr11(reg)
	blt ac0,filr99(reg)
	movei ac0,1
	movem fileof(reg)
	setzm fileol(reg)
	movem reg6,filerr(reg)		;for data error enabling
	sub p,[openoff]
	pop p,(p)
	popj p,

brkt:	push p,[exp .tocib]	;clear the buffer
	push p,filbtp(reg)	;the udx
	push p,ac0		;dummy
	movei ac0,-2(p)
	hrli ac0,2
	trmop. ac0,
	 jrst trmer
	movei ac0,getct		;kill saved LF if any
	movem ac0,filget(reg)
	sub p,[xwd 3,3]
	jrst brkdn.

;TDVSHL - Show the error char and the rest of the line
;  current position.  No sideeffects.
;Note that this routine is intended to be called for I/O using the
;user's terminal, but possibly when it is open as a normal device.
;GETCH is used for input, so as to synchronize with pascal I/O.
;direct trmop. is used for output, since we can't assume in general
;that he has the output side open.
tdvshl:
;outstr [error was detected here:]
	push p,[exp .toous]	;outstr
	push p,filbtp(reg)	;iondx
	push p,[[asciz /[Error was detected here:]
/]]				;the thing to output
	movei ac0,-2(p)
	hrli ac0,3
	trmop. ac0,
	 jrst trmer
	sub p,[xwd 3,3]
;now put out the rest of the line
tdvsh1:	skipe fileol(b)		;copy the rest of the line
	jrst tdvsh2
   ;put
	push p,[exp .toouc]	;outchr
	push p,filbtp(reg)	;iondx
	push p,filcmp(b)	;the thing to output
	movei ac0,-2(p)
	hrli ac0,3
	trmop. ac0,
	 jrst trmer
	sub p,[xwd 3,3]
   ;get
	pushj p,getch
	jrst tdvsh1	
;outstr crlf
tdvsh2:	push p,[exp .toous]	;outstr
	push p,filbtp(reg)	;iondx
	push p,[[asciz /
/]]				;the thing to output
	movei ac0,-2(p)
	hrli ac0,3
	trmop. ac0,
	 jrst trmer
	sub p,[xwd 3,3]
	popj p,

;TDVFXL - clear rest of line and ask user for more.
;expects b to be set up
;t - PC to print if error msg
tdvfxl:	move a,b			;FCB for printing
	jrst tryagn

	subttl	APR trapper
;here is the routine we go to when trap happens

	fxu==1b11		;floating exponent underflow
	fov==1b3		;floating overflow
	ndv==1b12		;no divide

aprerr:			;This routine is taken from FOROTS
	move ac0,.jbtpc##	;get the error PC
	hrrz ac1,ac0		;see if it is OK (in runtime)
	cail ac1,safbeg##	;[7] see if it is in runtime
	caile ac1,safend##	;[7]
	jrst .+2		;[7] no
	jrst ignore		;[7] it's OK
	skipe in.ddt		;[17] in debugger?
	jrst ignore		;yes - ignore it
	hlrz ac1,ac0		;store flags in RH(1)
	tlz ac0,(ndv!fov!fxu)	;clear error bits
	andi ac1,(fxu!fov!ndv)	;clear all except these flags
	lsh ac1,-5		;right justify ndv flag(if set)
	trze ac1,(1b8)		;fov set?
	iori ac1,1b33		;yes--copy to another place
	outstr [asciz /
?	/]
	outstr @aprtab(ac1)	;put out appropriate message
	pushj p,runer.		;now go to PASCAL PC printer
	;jrst ignore		;and continue if it returns

ignore:	movei ac1,110		;reenable APR trapper
	aprenb ac1,
	jrstf @.jbtpc##		;return to pgm, error flags still set

aprtab:	[asciz /Integer overflow/]
	[asciz /Integer divide check/]
	[0]
	[0]
	[asciz /Floating overflow/]
	[asciz /Floating divide check/]
	[asciz /Floating underflow/]
	[0]

	subttl FCB allocation

;initb. - make file control block be fresh and clean
;  b - addr of fcb
;saves all ac's

initb.:	push p,a
;We must enter this into the table of known blocks before setting
; filtst, in order to prevent a race condition if the user ^C's
; and restarts during this routine.  We must make sure that the
; code as pasin1 knows to clear filtst.

;enter it into the table of known blocks
	hrli a,-blklen		;aobjn word for searching block table
	hrri a,blklck		;we are actually searching table of locks
	aose (a)		;take it if free.  Skip if it worked
				;This code is designed to be reentrant, so
				;a single instruction must test and take it
	aobjn a,.-1		;failed, try again
	jumpge a,initbf		;failed to find an index location
	movem b,blktab-blklck(a) ;found it, save block addr
	movei a,blktab-blklck(a) ;and update high-water mark
	camle a,lstblk
	movem a,lstblk
;init the block
initbc:	hrli a,protob		;blt prototype block to it
	hrr a,b
	blt a,filcmp(b)
	movei a,filcmp(b)	;now initializations that depend upon address
	movem a,filptr(b)
	movem a,filcnt(b)	;don't have info to set up LH yet
	pop p,a
	popj p,

initbf:	pushj p,blktbe		;print error message
	jrst initbc		;init the block anyway if he says to

;init.b - special entry to reinit an exisiting block
init.b:	push p,a
	jrst initbc

;prototype block


protob:
exp 0	;FILPTR= 0	;pointer to filcmp
exp 0	;FILEOF= 1	;input: 0 = normal state
			;	1 = eof or error - no more data in file (some
			;	    errors will allow reading to continue, and
			;	    thus will NOT set FILEOF)
			;output:1 = normal state
			;	0 = error (but program will abort so this will
			;	     never show up)
exp 0	;FILEOL= 2
	;filr11= 3
exp unopn;filget= 3
exp unopn;filput= 4
exp notopx;filr99= 5
exp 0	;filadv= 6
exp 1	;filbad= 7
exp 0	;filchn=10
exp 0	;FILSTA=11	; .+0  FOR FILESTATUS
exp 0	;FILDEV=12	; .+1  FOR DEVICE
exp 0	;FILBFP=13	; .+2  FOR POINTER TO BUFFERHEADER
exp 0	;FILNAM=14
exp 0	;FILEXT=15
exp 0	;FILPRO=16
exp 0
exp 0	;FILPPN=20
exp 0,0,0,0,0
exp 0	;FILBFH=26	;BUFFER HEADER
exp 0	;FILBTP=27	;BYTE POINTER
exp 0	;FILBTC=30	;BYTE COUNT IN BUFFER
exp 0	;FILLNR=31	;IF ASCII MODE - LINENR IN ASCIICHARACTERS
exp 0	;FILCNT=32	;LH= if non-text file: neg. number of words in comp.
			;    if text file: zero
			;test sign bit of this loc to see if an ASCII file
			;RH= ADDRESS OF FIRST WORD IN COMPONENT
exp 0	;filphb=33	;last physical block input or output
exp 0	;filrcs=34	;LH=physical block size, bytes
			;RH=size of last record input or output, bytes
exp 0	;filerr=35	;LH= errors that have happened; RH=errors allowed
exp 0	;filst1=36	;mode-dependent - usally bits in LH:
exp 0	;filst2=37	;mode-dependent
exp 314157 ;filtst=40	;314157 if the file block is legal
exp 0			;free
exp norchx ;filcht=42	;character mapping table
exp 0	;FILCMP=43	;FIRST WORD OF COMPONENT


	subttl file initialization
pasin.:	jsp ac1,pasif.			;entry for old programs
	popj p,

pasif.:	move reg2,ac1			;save ret addr

;if any files are left open, we clear filtst, to indicate that they
;need reinitialization

	movei a,blktab		;loop through all files
pasin1:	skipe b,(a)		;get the fcb addr there
	setzm filtst(b)		;and indicate no longer valid
	setzm (a)		;clear table entry
	camge a,lstblk		;go to next, if any
	aoja a,pasin1
	setzm lstblk		;now nothing in use
	setom blklck		;restore all to unlocked
	move a,[xwd blklck,blklck+1]
	blt a,blklck+blklen-1

	setom in.use			;free all channels
	move ac0,[xwd in.use,in.use+1]
	blt ac0,in.use+17
	setzm buflst			;and note no buffer free list
	jrst (reg2)

pasim.:	move ac0,[xwd 112,11]		;[2] set up mon.tp so we know what
	gettab ac0,			;[2]  operating sys. we are on
	movei ac0,10000			;[2] assume tops-10 if fails
	ldb ac0,[point 6,ac0,23]	;[2] monitor type field
	movem ac0,mon.tp		;[2] 
	cain ac0,1			;if not tops-10
	jrst pasim1			;is tops-10, forget this
	move reg,.jbhrl			;the following will change .jbhrl
	move ac0,[xwd 677777,377777]	;allocate all of memory
	core ac0,			;so we can put arg's to UUO's on stack
	 jfcl
	movem reg,.jbhrl		;we don't want it changed
pasim1:	setzm in.ddt			;[17]
	setzm in.crt
	setzm avail##
	setzm avail+1
	setzm begmem##
	setzm endmem##
ife ka10sw,<
	jrst (ac1)			;[2] 
> ;ife ka10sw

;[17] begin new init code for KA

ifn ka10sw,<
	move newreg,lstnew	;value of /HEAP
	cain newreg,0		;if defaulted
	movei newreg,4000	;use 4 pages
	skipe wrk.sz		;if he specified size in reenter
	move newreg,wrk.sz	;use it instead
	add newreg,.jbff	;15 _ new .jbff
	move ac0,.jbff		;ac0 _ old .jbff, start of stack
	movem newreg,.jbff	;put in new .jbff
	move b,mon.tp		;what monitor are we on?
	caie b,1		;if on tops-10
	jrst pasim2		;  tops-20 or tenex, we already have it
	core newreg,		;get the core
	 jrst nocore
pasim2:	move newreg,.jbff	;core UUO garbaged newreg
	hrrz basis,basis	;find offset between 17 and 16
	hrrz p,p
	sub p,basis		;17 _ offset
	move basis,ac0		;16 _ first loc in stack
	hrl basis,basis
	add p,ac0		;17 _ that + offset
	hrl p,p
	movem basis,%rndev##+3	;save 16 and 17 in globbasis and globtopp
	movem p,%rndev##+2
	jrst (ac1)

nocore:	outstr [asciz /
?  Can't allocate initial core request
/]
	exit


corall:	outstr [asciz /
Number of words to assign to stack+heap: /]
	setzb ac1,ac0
coralp:	inchwl ac0
	cail ac0,60		;better be a digit
	caile ac0,71
	jrst coralx
	subi ac0,60
	imuli ac1,^D10		;add into number being built up
	add ac1,ac0
	jrst coralp		;and try for another digit
coralx:	caie ac0,15		;should end in cr
	jrst corale
	inchwl ac0		;read lf
	movem ac1,wrk.sz	;store final value
	outstr [asciz /[Size set - START or SAVE the program]
/]
	exit

corale:	outstr [asciz /
?  Type a decimal number, end with CRLF
/]
	clrbfi
	jrst corall
> ;ifn ka10sw

	subttl misc. data
;**PLATZ FUER LITERALS ** - XLISTED

	XLIST
	LIT
	LIST

	reloc

updblk:	exp 5
	block 4
updlen:	block 1

blklen==40			;There are only 20(8) channels
blklck: block blklen
blktab: block blklen
lstblk:	block 1

in.use:	repeat 20,<
	exp -1>
buflst:	block 1	;header of list of free buffers
		;What is actually on this list is a list of whole
		;buffer rings.  The addresses refer to word 0 of
		;the first buffer in the ring.  Word +1 is the
		;address of the next entry in the list.  Word -1
		;is the buffer count as size as returned by BUFSIZ
lstnew:	0	;last location used by NEW
newbnd:	0	;lowest legal location for NEW
stkexp: exp 1	;page. block for expanding stack
	exp 0	; place for page to create
heaexp:	exp 1	;ditto for expanding heap
	exp 0	
mon.tp:	exp 1	;[2] type of system (1=tops10,3=tenex,4=tops20)
in.ddt:	0	;[17] 1 if in pasddt
in.crt:	0	;negative if in critical section
ifn ka10sw,<
wrk.sz:	0	;[17] size of work area (heap+stack) specified by reenter
> ;ifn ka10sw
	subttl	magic locations

;set up the APR trap

	.jbapr=125
	loc .jbapr
	exp aprerr

ifn ka10sw,<

;set up the REENTER address

	.jbren==124
	loc .jbren
	exp corall

> ;ifn ka10sw

	prgend
TITLE	NEW	; FAKE ENTRY IN CASE DISPOSE NOT INCLUDED
	SEARCH PASUNV
ENTRY NEW
NEW=GETNEW##
	TWOSEG
	RELOC 0
AVAIL::	BLOCK 2
BEGMEM::BLOCK 1
ENDMEM::BLOCK 1

	RELOC	400000
	PRGEND
	title PASCHN - allocate/deallocate channels
	
;This is done as a separate module to allow for the fortran interface.
;The interface will include its own version of these which call the
;fortran channel allocator/deallocator.

	twoseg 400000

	search pasunv

	entry fn.chn,lo.chn
	external in.use

fn.chn:	hrlzi ac1,-17		;find free channel - search 1 to 17 first
	hrri ac1,in.use+1	;inuse(ch)=-1 if free, .ge. 0 if used
	aose (ac1)		;take it if free.  Skip if it worked
	 	;This may seem obscure, but the idea is to test if free and
	 	;allocate the channel in the same instruction, 
		;so we are interruptible
	aobjn ac1,.-1		;failed, try again
	jumpl ac1,chnfnd	;loop not exhausted - found it
	aose in.use		;1-17 used, try 0
	jrst chnnfd		;nope - none found
	setz ac1,		;yes - return 0
	popj p,
chnfnd:	hrrz ac1,ac1		;get channel found
	subi ac1,in.use
	popj p,
chnnfd:	seto ac1,		;-1 means none found
	popj p,

lo.chn:	setom in.use(ac1)	;lose channel
	popj p,

	prgend
	title DUMCRI - dummy critical section, if no PSI

	entry leavec,enterc

	twoseg

	reloc 400000

leavec:
enterc:	popj 17,

	prgend

	title DANGER - routine for dummy label when pasnum not loaded

	entry safbeg,safend

safbeg:	block 0
safend:	block 0

	END