title PASIO - I/O routines for TOPS-20 Pascal

;edit history - begins with edit 2

;2 - keep disk open from blowing up when file has byte size of 0
;3 - improve recovery from arithmetic errors
;4 - set up to process pushdown overflow
;5 - Tenex
;6 - replace pasin. by pasif., which doesn't use pushj, in case
;	emulator is active (as it is for tenex)
;7 - more Tenex, convert some more erjmp's to erjrst, gnjfx1
;	end of line for tty I/O
;	tty openned as file should still use pstin
;10 - add multiple page buffers.  This involves major edits to the
;	whole map I/O section, getpag/relpag, and the callers thereof
;	I have not put edit numbers on this edit.
;11 - remove DMOVE, for KA Tenex
;12 - mark file as unopened after closing it
;13 - fix open of TTY and TTYOUTPUT, since edit 12 broke it
;14 - general Tenex TTY I/O, supposedly the INTERLISP-style line
;	Few TENEX sites support the PSTIN JSYS.
;15 - fix up what we do on errors a bit
;16 - use GET. instead of GET;  don't look for line numbers unless
;	first word of file is line numbered  (undone in edit 23, except SRI)
;17 - don't do line number test for size=0.  For version 1 monitors.  We
;	would get ill mem read, since ERJMP didn't always work in version 1.
;20 - replace newpage,retpage with getpages,relpages.  Move old ones to PASOLD
;21 - Add code for Tenex with PA2040
;22 - fix f%ltst routine so it doesn't need to use BKJFN, since that won't
;	work for tapes [monitor bug].  NB:  Originally, we tested every word
;	in the file to see if it was a line number.  I still prefer that code.
;	The business of testing the first word and turning off the test if it
;	is not a line number is done strictly for SRI.  The code is ugly, in
;	in case of errors in reading the first word, who knows what to do?
;	The reason SRI needs it is because their version of EMACS randomly
;	sets the low order bit in files it creates.
;23 - put funny line number testing under SRI conditional
;24 - add code for dynamic heap management (DDyer@USC-ISIB)
;25 (DFloodPage@BBNE) use non-binary mode in RDSTR on Tenex
;       Don't set bit zero in chfdb on Tenex
;26 - missing PSOUT of prompt in error handling
;27 - all continuation after quota exceeded.  This is a "temporary" fix.
;	A more general redesign to allow continuation in all cases
;	is in PASIO.NEW.  However it is going to be a bear to debug, so
;	this patch is being used as a safe one that does the job.
;30 - replace WRTPC with RUNERR, that allows continuation
;31 - new routines - SHOWLN and FIXLN
;32 - add TTYPR. - prompt for INPUT open on TTY:
;33 - retry opens when something goes wrong
;34 - new intelligible form for funny open options
;35 - minor fix to maperr, for holes in file
;36 - removed setting EOLN in CLREOF
;37 - typo: had move instead of movei at HAVSPC
;40 - handle zero counts for SOUT, SOUTR, and SINR
;41 - fix bad stack offset
;42 - fix CLREOF - AC 2 was being garbaged
;43 - fix NEWCL. - had reversed AC 1 and 2

	sall	;no macro bodies or repeats
	search monsym,pasunv

if1,<
ife tenex,<printx  Tops-20 version>
ifn tenex,<
 ifn sumex,<printx  Sumex version>
 ife sumex,<
  ifn pa2040,<printx Tenex PA2040 version>
  ife pa2040,<printx Tenex non-PA2040 version>
 >;ife sumex
>;ifn tenex
ifn srisw,<printx  SRI line number kludge included>  ;[23]
>;if1

	gnjfx1=601054	;[7] T20 calls this gnjfx1, Tenex gnjfx2.  In
			;[7]    Tenex gnjfx1 is something else.  So this
			;[7]    definition should let us transport the code.
ifn sumex,<
opdef	pstin	[jsys 611] ;[14] SUMEX has PSTIN, so does IMSSS, but nowheres
			   ;[14]    else is it guaranteed!  Thus, where the
			   ;[14]    SUMEX switch is not, we simulate the 
			   ;[14]    INTERLISP string reading stuff
>

mapbfs==4	;default number of pages in buffer for mapped I/O
ifn tenex,<mapbfs==1> ;except for Tenex, no advantage to more than 1
		;[the code should work for .gt. 1 even in tenex, though]
oldcom==1	;kludges needed to run this with .rel files made
		;by the tops-10 compiler (alas, I have never removed
		;the last vestiges of this program structure.  So this
		;switch is mostly a comment showing what should be
		;cleaned up.)

	entry initb.,init.b
	entry endl,runer.,gotoc.,dispc.,ilfil.
	entry resetf,rewrit,getch,get.,putch,put,clofil,getchr
	entry getfn.,getln,putln,putpg,getlnx,putlnx,putpgx
	entry putx,getx.,break,breaki
	entry setpos,curpos
	entry pasin.,pasif.,end,quit,clreof,getpg.
	entry newbnd,corerr,lstnew,illfn,norcht,norchx
	entry inxerr,ptrer.,srerr
	entry getnew,newcl.
	entry rename,delf.,append,update,resdev,relf.,nextfi
	entry erstat,analys,lstrec
	entry ttypr.

	twoseg

.jbren==124

	loc .jbren

	exp quit

	reloc 0

frepag:	block 17	;array of bits to indicate free pages
lstnew:	block 1		;last location used by new
ifn oldcom,<
newbnd:	block 1		;dummy for tops-10 code
> ;ifn oldcom

	reloc 400000

ife tenex,< ;[27]
;
;CHKQUO should be used after any JSYS that might get a disk quota overflow.
;  Note that it can be followed by an ERCAL or ERJMP, which will activate
;  if any other error condition is present.
;CHKQUO should not be used after ILDB or IDPB.  ERCAL MAPERR is the
;  canonical error handler for that.  MAPERR handles quota errors itself.
define chkquo,<	ercal quochk>
> ;ife tenex

ifn tenex,<
define chkquo,<> ;[27]
 ife sumex,<		; TENEX GETER loads 4-10 with PSB
define geter,<   pushj p,.geter >
.geter:	push p,4
	push p,5
	push p,6
	push p,7
	push p,10
	jsys 12		; geter
	pop p,10
	pop p,7
	pop p,6
	pop p,5
	pop p,4
	popj p,
 >
>
ifn oldcom,<
;This routine will be called once in initialization to create core
;for the beginning of the stack.  After that core will be created
;automatically, as the nxm interrupt will be off.
corerr:	move d,a	;save return address
	movei a,400000	;current process
	movei 2,1b22	;nxm interrupt
	dic		;disable interrupt
	move a,(p)	;reference the location
	movei n,777777	;set so we are never called again
	jrst (d)	;return
> ;ifn oldcom

GETNEW:	movn a,b	;must be interruptible
	addb a,lstnew	;get new addr and update lstnew at once
	cain a,377777	;if result is nil
	jrst newnil	; get another one!
	camge a,.jbff##	;overlap low?
	jrst nonew	;yes, nothing there
newxit:	move b,a
	popj p,
newnil:	caig b,0	;if size 0, adjust to 1 so we go somewhere
	movei b,1
	jrst getnew	;and try again

;[43] reverse roles of a and b after call to NEW, remove call to
;NEWXIT, which had been used to get value back in b
newcl.:	push p,b	;here to clear result
	pushj p,new##
	pop p,a
	jumple a,cpopj	;if 0, nothing to clear
	setzm (b)	;clear first
	sojle a,cpopj	;anything else to clear?
	add a,b		;last address
	hrli t,(b)	;first address
	hrri t,1(b)	;make blt for clear
	blt t,(a)
	popj p,

;Here if nothing more available
nonew:	move t,(p)	;this is addr for error printer
	pushj p,newerr
	movei b,377777	;return NIL if he tries to continue
	popj p,

define outstr(x),<
	hrroi a,x
	psout >
define eoutstr(x),<
	hrroi a,x
	esout >

;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

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 /]
	psout
;print PC in octal
	HRRZI d, 6
	MOVE e,[POINT 3,t,17]
	ILDB a, e
	ADDI a, 60
	pbout
	SOJG d,.-3
;go to debugger if there is any
	HRRZ c,.JBDDT##			;[3] LOAD PASDDT-ADDR
	JUMPE c,noddt	       		;[3] no .jbddt, maybe vmddt
	move c,.jbddt##			;[3] want left half, too
	tlze c,777777			;[3] if zero, it is PASDDT
	jrst decddt			;[3] if not, real DDT
;PASDDT
	pushj p,-1(c)			;[3] go to pasddt special entrance
	jrst errest			;continue if he continues

;nothing obvious - check for VM DDT or just halt
noddt:	move a,[xwd 400000,770]		;[3] no .jbddt, see if 770000
	rpacs				;[3] page exist?
	tlnn b,(pa%pex)			;[3]
	jrst hlterr			;[3] no - continue
	tlnn b,(pa%ex)			;[3] allowed to execute?
	jrst hlterr			;[3] no - continue
;DDT
	movei c,770000			;[3] seems to be ddt - get its addr
decddt:	movem t,.jbopc##		;save PC so he can continue
	hrrzm c,ddtgo
	outstr [asciz /
[Type POPJ 17,$X to continue if possible
      QUIT$G to close files and exit]
/]
	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:	move b,.jbren
	movei a,[asciz /
[Type CONTINUE to proceed if possible.]
/]
	cain b,quit			;if user hasn't set his own REE trap
	movei a,[asciz /
[Type CONTINUE to proceed if possible,
      REENTER to close all files and exit.]
/]
	psout
	haltf
;	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.:	eoutstr [ASCIZ /Uninitialized file/]
	move t,(p)	
	pushj p,runer.
	movei b,tty##		;use tty instead
	popj p,

INXERR: eoutstr	[ASCIZ /Array index out of bounds/]
	pushj p,runer.
	jrst @t

newerr:	eoutstr [asciz /No memory for heap/]
	pushj p,runer.
	popj p,

PTRER.:	eoutstr [ASCIZ /Uninitialzed or NIL pointer/]
	pushj p,runer.
	jrst @t

SRERR:	eoutstr[ASCIZ/Scalar out of range/]
	pushj p,runer.
	jrst @t

blktbe:	push p,t
	setz t,			;we don't know the location
	eoutstr[ASCIZ/Too many files open at once/]
	pushj p,runer.
	pop p,t
	popj p,
	
	subttl file openning - top level routines

;ac usage for the file openning routines:
;	t,a - temporary
;	b - fcb
;	c - string (file spec)
;	d - length of string
;	e - protection/interactive
;	f - gtjfn word or 0
;	g - openf word or 0
;	h - bits:
;	fl%lc	(1)	map lower case
;	fl%ioe	(2)	handle i/o errors
;	fl%fme	(4)	handle data format errors
;	fl%ope	(10)	handle open errors
;	fl%eol	(20)	show end of line char
;	fl%buf  (7700)	number of buffers or pages
;	fl%mod  (770000) I/O type
;	  fm%byt(1)	bin/bout
;	  fm%map(2)	pmap
;	  fm%tty(3)	texti/bout
;	  fm%nul(4)	popj
;	  fm%wrd(5)	buffered 36 bit
;	  fm%chr(6)	buffered logical byte size
;	  fm%lst	last legal mode

;places to save f and g for retry
filsvf==filst5
filsvg==fils21

;The following define flags we can't let the user play with.  We set
; flags first by zeroing these and then doing tlc with those we want
; to set.  This results in the settings needed for the bits listed
; here, but lets the user clear others that we set by specifying
; them in his argument.
gj%reg==gj%flg!gj%sht!gj%jfn!gj%ofg!gj%xtn
of%reg==of%rd!of%wr!of%ex!of%app

resetf:	movei t,0		;eof setting for correct operation
	pushj p,setprm		;initialize fcb
	tlz f,(gj%reg)
	tlc f,(gj%old!gj%flg!gj%sht) ;extra bits for gtjfn
	trz g,of%reg
	trc g,of%rd		;extra bits for openf
	pushj p,getjfn
	pushj p,devprm		;device-dependent parameter setting
	pcall f%open
	pcall f%ltst
	pushj p,errchk		;if open errors
	jrst resetf		;then try again
	hlre c,filcnt(b)	;get count in case record I/O
	movn c,c	;is negative
	jumpe e,@filget(b)	;if not interactive, get 1st thing
	skipn filerr(b)		;any errors in openning?
	aos fileol(b)		;no - set dummy eoln for interactive begin
cpopj:	popj p,

update:	movei t,0		;eof setting for correct operation
	pushj p,setprm		;initialize fcb
	tlz f,(gj%reg)
	tlc f,(gj%old!gj%flg!gj%sht) ;extra bits for gtjfn
	trz g,of%reg
	trc g,of%rd!of%wr	;extra bits for openf
	pushj p,getjfn
	pushj p,devprm		;device-dependent parameter setting
	pcall f%open
	pcall f%ltst
	pushj p,errchk		;errors?
	jrst update		; yes - try again
	skipn filerr(b)		;any errors in openning?
	aos fileol(b)		;no - set dummy eoln for interactive begin
	popj p,

rewrit:	movei t,1		;eof setting for correct operation
	pushj p,setprm		;initialize fcb
	tlz f,(gj%reg)
	tlc f,(gj%fou!gj%flg!gj%sht) ;extra bits for gtjfn
	trz g,of%reg
	trc g,of%wr
	pushj p,getjfn
	pushj p,devprm		;device-dependent parameter setting
	pcall f%open
	pushj p,errchk		;errors
	jrst rewrit		;yes - try again
	popj p,

append:	movei t,1		;eof setting for correct operation
	pushj p,setprm		;initialize fcb
	tlz f,(gj%reg)
	tlc f,(gj%old!gj%flg!gj%sht) ;extra bits for gtjfn
	trz g,of%reg
	trc g,of%app
	pushj p,getjfn
	pushj p,devprm		;device-dependent parameter setting
	pcall f%open
	pushj p,errchk		;errors?
	jrst append		;yes - try again
	popj p,
	subttl rename and delete

rename:	push p,filjfn(b)	;save old jfn
	push p,b
	push p,c
	movsi c,(co%nrj)	;close but leave jfn
	pushj p,doclos
	pop p,c
	pop p,b
	setzm fileof(b)		;assume it is OK
	setzm filerr(b)		;so getjfn works
	tlz f,(gj%reg)
	tlc f,(gj%fou!gj%flg!gj%sht)
	pushj p,getjfn		;get new jfn
	skipe filerr(b)		;if error, stop now
	jrst rener1
	move h,b		;protect fcb and put where doope wants
	pop p,a			;old jfn
	tlz a,-1
	hrrz b,filjfn(h)	;new jfn
	rnamf
	 erjrst rener		;[7]
	popj p,

rener:	hrrzm a,filerr(h)	;this is error code
	aos fileof(h)		;set eof
	popj p,

rener1:	movei a,1
	movem a,fileof(h)	;set eof
	popj p,

delf.:	push p,filjfn(b)
	push p,b
	push p,c
	movsi c,(co%nrj)
	pushj p,doclos
	pop p,c
	pop p,b
	setzm fileof(b)
	setzm filerr(b)
	pop p,a
	hrli a,(df%nrj)		;keep the jfn
	move h,b		;where rener needs it
	delf
	 erjrst rener		;[7]
	popj p,
	subttl low level routines for file openning

;AC usage for setprm:
;	t - at entry, this is normal setting of eof
;	a - length of file component, 0 if text
;	b - fcb pointer
;	c - lh=flags, rh=addr of file spec
;	d - length of file spec
;	e - 0 or 1 - interactive flag; more commonly - new funny option string
;	h - flags
;	t,a garbaged

;setprm handles all device-independent file-openning stuff,
;including initializing the fcb so all entries are valid for I/O.
;In case of error, filerr is set, so the caller had better check
;this.  Byte size and I/O routines are left for devprm, as they
;are device-dependent.

setprm:
;First we make sure we have a valid FCB
	push p,t
	move t,filtst(b)
	caie t,314157		;magic word will be there if it is legal
	pushj p,initb.		;not - init it
	pop p,t
;We do any format conversions before saving away the values
ifn oldcom,<
	camn h,[-1]		;old compiler uses -1 as default
	setz h,			;should be 0
> ;ifn oldcom
	came e,[exp -1]		;-1 or 0 LH is probably old format
	tlnn e,777777
	jrst setpr1		;old format
	pushj p,option		;new format  parse options
;now save values in case of restart. Note that format conversions won't be
;redone in case of restart since LH(e) is now 0, and h is not longer -1
setpr1:	movem f,filsvf(b)	;save args for error recovery
	movem g,filsvg(b)	;  h is also saved, below - e is not touched
	movem t,fileof(b)	;put in a few args
	trc t,1			;this is the eof to set if errors
	movem t,filbad(b)
	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)
;the following code is intended to set both H and FILFLG to
; H*(-20) + FILFLG*20.
	trz h,fl%tmp		;H * (-20)
	exch h,filflg(b)	;reverse them so we can play with FILFLG
	andi h,fl%tmp		;FILFLG * 20
	iorb h,filflg(b)	;both _ H * (-20) + FILFLG * 20
;here we figure out which character table to use
	movei a,0		;assume no lc map, standard EOL treatment
	trne h,fl%lc		;if lc mapping on
	tro a,2			;set bit 2
	trne h,fl%eol		;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)
;now random initialization
	movei a,filcmp(b)
	movem a,filptr(b)
	move a,[ascii /-----/]	;initial line number
	movem a,fillnr(b)
	push p,c
	movsi c,(co%nrj)	;assume we use existing jfn
	skipn d			;unless new file spec
	skipge (p)		;or request to get spec from tty
	setz c,			; then full close
	pushj p,doclos		;close file if one already open
		;becaue of code above, this also releases the jfn
		;and zeros filjfn if the user gave us a new file spec
	pop p,c
	setzm filerr(b)		;now zero things
	setzm fileol(b)
	setzm fillts(b)
	move a,filcnt(b)	;zero the component
	setzm (a)
	aobjn a,.-1
ifn oldcom,<
	caie b,tty##		;special for tops-10 tty open, since
	cain b,ttyout##		;args are garbage
	jrst opntty
> ;ifn oldcom
	popj p,			;no - done

;e - LH - count, RH - addr
option:	push p,t
	push p,a		;get some working space
	push p,b
	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
optend:	pop p,b			;exit
	pop p,a
	pop p,t
	popj p,

optmin="B"
opttab:	pushj p,optbyt		;B - byte size
	jrst opterr		;C - undef
	tro h,fl%ioe		;D - data trans errors
	tro h,fl%eol		;E - show eoln
	tro h,fl%fme		;F - data format errors
	jrst opterr		;G - undef
	jrst opterr		;H - undef
	movei e,1		;I - set interactive flag
repeat "M"-"J",< jrst opterr>	;J to L - undef
	pushj p,optmod		;M - mode
	jrst opterr		;N - undef
	tro h,fl%ope		;O - open errors
repeat "S"-"P",< jrst opterr>	;P to R - undef
	pushj p,numbuf		;S - buffer size
	jrst opterr		;T - undef
	tro h,fl%lc		;U - lower to upper
optmax=="U"

optmod:	pushj p,optdec		;parse a decimal number
	lsh b,^D12		;shift it to mode position
	or h,b			;and or into flags
	popj p,

numbuf:	pushj p,optdec		;parse decimal
	trne b,777		;any odd words?
	addi b,1000		;yes - round up pages
	lsh b,^D-9		;pages
	lsh b,6			;shift into page count
	or h,b
	popj p,

optbyt:	pushj p,optdec		;parse a decimal number
	lsh b,^D30		;shift it to the byte position
	or g,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
	hrroi a,[asciz / Error in option string/]
	esout
	move t,-4(p)		;-2 for saved args, -2 because called 2 deep
	pushj p,runer.
	jrst optend		;return from OPTION

ifn oldcom,<
opntty:	aos fileol(b)		;always interactive
	hrli t,ttynt		;[13] copy special tty dispatch table
	hrri t,filr11(b)	;[13]   since rest of open won't be done
	blt t,filr99(b)		;[13]
	pop p,(p)		;exit from caller
	popj p,
> ;ifn oldcom
;AC usage for devprm
;	b - fcb
;	g - openf word
;	h - used internally for dvchr flags
;	t,a,c,h garbaged, g updated

;devprm sets up device-dependent parameters in the fcb, mainly
;byte size and I/O routines.

devprm:	skipe filerr(b)		;no-op if error already
	popj p,
	move h,b		;save fcb over dvchr call
	hrrz a,filjfn(b)
	dvchr
	 erjmp doope
ifn tenex,<push p,a>		;[7] save designator in case of tty
	exch h,b		;result of dvchr to h, fcb to b
;now we set up proper device/function dependent table
	ldb a,[fl%mod!filflg(b)];get user specified mode
	caig a,fm%lst		;unimplemented gets default
	jumpn a,devfnd		;if he gave one, use it
	movei a,fm%byt		;else, byte I/O is default
	hlrz h,h		;get dv%typ field
	andi h,(dv%typ)		;code from here to devfnd sets
	cain h,.dvdsk		;   a to Pascal mode
	movei a,fm%map
	cain h,.dvtty
	movei a,fm%tty
	cain h,.dvnul
	movei a,fm%nul
	cain h,.dvmta
ife tenex,<movei a,fm%mta>
ifn tenex,<movei a,fm%wrd>
	caie h,.dvcdr
	cain h,.dvlpt
	movei a,fm%chr
devfnd:	

ifn tenex,<			;[7] if tty, see if ours
	cain a,fm%tty		;[7] tty mode?
	pushj p,devtty		;[7] yes, turn to fm%chr if not ctrl term
	adjstk p,-1		;[7] a was saved
> ;ifn tenex

	movsi t,070000		;default byte size
	skipge filcnt(b)	;except for record I/O
	movsi t,440000		;default is 36
	tlnn g,(of%bsz)		;if user defaulted it
	ior g,t			;then use our default
;special entry for mtaopn
setdsp:	subi a,1		;now set dispatch vector per a
	lsh a,1			;a _ (a - 1) * 2
	skipge filcnt(b)	;if record I/O,
	addi a,1		;use second column in table
	hrl t,devtab(a)		;get address of disp. vec. from table
	hrri t,filr11(b)	;whre to copy vector
	blt t,filr99(b)
	popj p,

ifn tenex,<	;[7] 

;this code is to see whether a tty is the controlling terminal.
;  If so, we use pstin.  Otherwise, you get the losing BBN type mode.

devtty:	push p,b
	hrroi a,[asciz /TTY/]	;get designator for own tty
	stdev
	 jrst [adjstk p,-3
	       jrst doope]
	movei a,fm%tty		;assume ours
	came b,-2(p)		;compare with dev designator saved
	movei a,fm%byt		;not ours, use bin/bout
	pop p,b
	popj p,

> ;ifn tenex [7] ^^

;here is the table of dispatch vectors

	;text,	record

fm%mta==0   ;pseudo-mode that sets defaults after looking at label type
	exp mtatxt, mtarec
devtab:	exp byttxt, bytrec
	exp maptxt, maprec
	exp ttytxt, ttyrec
	exp nultxt, nulrec
	exp wrdtxt, wrdrec
	exp chrtxt, chrrec
	exp rectxt, recrec

;here are the tables referred to in the matrix

;	byte-size,getch,putch,getln,putln,close,dispatch
;	getx,putx,putpage,setpos,curpos,init,open,break,lintst
;	showln,fixln


byttxt:	exp getchx,putchx,getlnx,putlnx,0,.+1
	exp illfn,illfn,putpgx,setpbx,curpbx,cpopj,openfi,cpopj,cpopj
	exp showln,notry
bytrec:	exp getbx,putbx,illfn,illfn,0,.+1
	exp getxbx,putxbx,illfn,setpbx,curpbx,bxini,bxopn,cpopj,cpopj
	exp showln,notry
maptxt:	exp getchd,putchd,getlnx,putlnx,dskclo,.+1
	exp illfn,illfn,putpgx,dskspo,dskcpo,dskbri,dskopn,dskbrk,dsklts
	exp showln,notry
maprec:	exp getd,putd,illfn,illfn,dskclo,.+1
	exp getxd,putxd,illfn,dskspo,dskcpo,dskbri,dskopn,dskbrk,cpopj
	exp showln,notry
ttytxt:	exp getcht,putchx,getlnx,putlnx,0,.+1
	exp illfn,illfn,putpgx,setpt,curpbx,ttyini,tdvopn,cpopj,cpopj
	exp tdvshl,tdvfxl
ttyrec==bytrec	;not sure this is right.  What is record I/O on tty?
nultxt:	exp simeof,cpopj,simeof,cpopj,0,.+1
	exp illfn,illfn,cpopj,nulspo,retzer,cpopj,openfi,cpopj,cpopj
	exp showln,notry
nulrec:	exp simeof,cpopj,illfn,illfn,0,.+1
	exp simeof,cpopj,illfn,nulspo,retzer,cpopj,openfi,cpopj,cpopj
	exp showln,notry
wrdtxt:	exp getchb,putchb,getlnx,putlnx,logclo,.+1
	exp illfn,illfn,putpgx,illfn,illfn,logini,wrdopn,logclo,wrdlts
	exp showln,notry
wrdrec:	exp getb,putb,illfn,illfn,logclo,.+1
	exp getxb,illfn,illfn,illfn,illfn,logini,wrdopn,logclo,cpopj
	exp showln,notry
chrtxt:	exp getchb,putchb,getlnx,putlnx,logclo,.+1
	exp illfn,illfn,putpgx,setpb,curpbx,logini,chropn,logclo,cpopj
	exp showln,notry
chrrec:	exp getb,putb,illfn,illfn,logclo,.+1
	exp getxb,illfn,illfn,setpb,curpbx,logini,chropn,logclo,cpopj
	exp showln,notry
rectxt:	exp getcx,putcx,getlx,putlx,logclx,.+1
	exp illfn,illfn,putpgx,illfn,illfn,loginx,chropx,logclx,cpopj
	exp showln,notry
recrec:	exp getbxr,putbxr,illfn,illfn,0,.+1
	exp illfn,illfn,illfn,setpbx,curpbx,bxini,bxopn,cpopj,cpopj
	exp showln,notry
mtarec:
mtatxt:	exp notop,notop,notop,notop,0,.+1
	exp notop,notop,notop,notop,notop,cpopj,mtaopn,cpopj,cpopj
	exp notop,notop


;The following table is used for tty and ttyout.  It is set up by pasin.

ttynt:	exp gettty,puttty,getlnx,putlnx,0,.+1
	exp illfn,illfn,putpgx,illfn,illfn,ttyini,cpopj,cpopj,cpopj
	exp ttyshl,ttyfxl

;The following table is used after an error
erropt:	exp cpopj,cpopj,cpopj,cpopj,0,.+1
	exp cpopj,cpopj,cpopj,cpopj,cpopj,cpopj,cpopj,cpopj,cpopj
	exp cpopj,notry

;The following is used for unopened files:

unop.:
unop:	exp notop,notop,notop,notop,0,.+1
	exp notop,notop,notop,notop,notop,cpopj,cpopj,cpopj,cpopj
	exp notop,notop

; Openfi is called by the device-dependent openner, f%open.
;   For simple devices, f%open can simply point to openfi.

;openfi just does an openf - pretty straight-forward
;	b - fcb, must be saved and restored
;	g - openf word
;	garbages a,h

openfi:	skipe filerr(b)		;no-op if error already seen
	popj p,
	move h,b		;save fcb pointer
	hrrz a,filjfn(h)	;set up args for openf - jfn
	move b,g		;openf word
	openf
	 erjrst doope		;[5]
	move b,h		;restore fcb
	popj p,

oper:	move h,b		;error in openfi
doope:	movei a,400000		;current process
	geter
	hrrz a,b		;error in RH only
smoper:	move b,h		;restore fcb - entry if error is known
	movem a,filerr(b)	;save error for user
	move a,filbad(b)	;set bad fileof
	movem a,fileof(b)
	movem a,fileol(b)
	hrli t,erropt		;and set up to get error if we try more I/O
	hrri t,filr11(b)
	blt t,filr99(b)
	move t,filflg(b)
	popj p,			;caller will process error later

errchk:	skipn filerr(b)		;error?
	jrst erchOK		;no
	move t,filflg(b)	;yes - is he enabled?
	trne t,fl%ope
	jrst erchOK		;yes - then that's OK, too
;here if an error we are supposed to handle
	move d,b		;
	pushj p,erp		;print error message
	move b,d
	hrroi a,[asciz /Try another file spec: /]
	psout
	hlre a,filcnt(b)	;restore state, without filespec
	movn a,a		;a has size of component, 0 if text
	setzm c,d		;no filespec
	tlo c,(op%tty)		;but ask for it from tty
	move f,filsvf(b)
	tlo f,(gj%cfm)		;confirm it from tty
	move g,filsvg(b)
	move h,filflg(b)
	popj p,			;error return
;here for no error or one we don't care about
erchOK:	aos (p)
	popj p,			;OK - skip return

;getjfn - AC usage
;	b - fcb pointer - must be saved and restored
;	c - string
;	d - string length
;	f - gtjfn word
;	h - used to save p or h
;	klobbers t,a,c,d,h

;getjfn gets a jfn if necessary.    In case of
; error, it sets of filerr, so the user better check!

getjfn:	skipe filerr(b)		;should be a no-op if previous error
	popj p,
	tlne c,(op%wld)		;set up for wild cards if requested
	tlo f,(gj%ifg)
	tlne c,(op%tty)		;if user asked for spec from tty, get it
	jrst ttyspc
	jumpn d,havspc		;if ascii spec, use it
	skipe filjfn(b)		;otherwise, if jfn already exists, use it
	popj p,
;here if no spec and no existing jfn - this is an internal file, we have
;to gensym a name.  Also, we set fl%tmp so it gets deleted upon exit of
;the lexical scope in which it was created.
;The name we make is of the form PAS-INTERNAL.001234;T   where 1234 is
;the address of the FCB in octal (for debugging)
	movei t,fl%tmp		;set temp flag
	iorm t,filflg(b)
	move h,p		;h _ saved copy of p
	hrri p,6(p)		;advance stack to get space for new name
	hrri d,1(h)		;place for new spec
	hrli d,[ascii /PAS-INTERNAL./]
	blt d,3(h)		;put it there
	move d,[point 7,3(h),20] ;place to put the rest
	hrlz a,b		;use addr of FCB, in octal
	movei c,6		;6 digits
	setz t,
makspl:	lshc t,3		;shift t and a - bytes in t
	addi t,"0"		;convert to char
	idpb t,d		;and put in destin
	setz t,
	sojg c,makspl		;loop for 6 char's
	movei t,";"		;now put ;T
	idpb t,d
	movei t,"T"
	idpb t,d
	setz t,
	idpb t,d
	move t,b		;where makspx expects B to be saved
makspr:	move a,f		;a _ flags
	hrroi b,1(h)		;b _ ptr to stack copy
	gtjfn
	 erjrst makspe		;[5]
	jrst makspx		;finished making spec
;If this is an internal file, we want to be able to read or update it
;even if it doesn't exist.  So, if the OLD bit is on, we will clear it
;(and set the WRITE bit for openf), and try again.  If that doesn't
;help, there is something more serious wrong.
makspe:	tlnn f,(gj%old)		;did he ask for old file?
	jrst specer		;no - nothing we can do
	tlz f,(gj%old)		;yes - enable for writing
	tro g,of%wr		;also openf bits
	jrst makspr		;retry this way

;here if the user gave us a spec.
havspc:	movei t,fl%tmp		;[37] a new file spec - clear temp from old one
	andcam t,filflg(b)
	move t,b		;t _ saved copy of b
ifn klcpu,< ;[5] 
	hrli a,440700		;a _ ptr to start of copy in stack
	hrri a,1(p)
	adjbp d,a		;d _ ptr to last byte stack copy
> ;[5] ifn klcpu
ife klcpu,< ;[5] start
	hrri a,1(p)		;RH(a) _ point to start on stack
	push p,e
	idivi d,5		;d _ words, e _ bytes
	addi d,(a)		;RH(d) _ addr of last byte
	hll d,byttab(e)		;LH(d) _ pointer to last byte
	pop p,e
> ;[5] end ife klcpu
	move h,p		;h _ saved copy of p
	hrri p,1(d)		;advance stack to cover whole copy
	hrl a,c			;a _ blt from original to stack
	blt a,1(d)
	setz a,			;make asciz by putting null at end
	idpb a,d
	move a,f		;a _ flags
	hrroi b,1(h)		;b _ ptr to stack copy
	gtjfn
	 erjrst specer		;[5]
makspx:	move b,t		;restore ac's
	move p,h
	movem a,filjfn(b)	;return new jfn
	popj p,

ifn tenex,< ;[5]
byttab:	point 7,0		;[5]
	point 7,0,6		;[5]
	point 7,0,13		;[5]
	point 7,0,20		;[5]
	point 7,0,27		;[5]
> ;[5] ifn tenex

specer:	move a,t		;get error recovery flag
	move a,filflg(a)
	trne a,fl%ope		;if he wants to handle errors,
	jrst [move b,t		;let him - first restore AC's
	      move p,h
	      jrst oper]
;special error printer needed for this routine, because main one
;uses jfns, but we don't have a file spec yet
;note that we are still in a funny context, where p and b are odd
	movei a,[asciz / /]
	esout
	movei a,.priou
	hrloi b,400000
	setz c,
	erstr
	 jfcl
	 jfcl
	hrroi a,[asciz / - /]
	psout
	hrroi a,1(h)		;file spec the user gave
	psout
	hrroi a,[asciz /
Try another file spec: /]
	psout
	move b,t		;restore to standard AC's
	move p,h
	tlo f,(gj%cfm)		;confirm spec from tty
	;jrst ttyspc		;and get spec from tty

ttyspc:	move h,b		;h _ saved copy of b
	movei a,fl%tmp		;clear temp flag, as this is new spec
	andcam a,filflg(b)
ttyspl:	move a,f		;a _ flags
	tlo a,(gj%fns)
	move b,[xwd .priin,.priou]
	gtjfn
	 erjrst ttyspe		;[5]
	move b,h
	movem a,filjfn(b)	;return new jfn
	popj p,

ttyspe:	movei a,[asciz / /]
	esout
	movei a,.priou
	hrloi b,400000
	setz c,
	erstr
	 jfcl
	 jfcl
	hrroi a,[asciz /
Try another file spec: /]
	psout
	jrst ttyspl

	subttl global entries to I/O routines

;In order to use the routines in PASNUM, get and put must obey the
;following AC usage conventions:
;	t,a	- temps
;	b up	- must be preserved

get.:	jrst @filget(b)		;get is odd because it is also a jsys
getch==get.
put:	jrst @filput(b)
putch==put
getln:	jrst @filgln(b)
putln:	jrst @filpln(b)
putpg:	vcall f%putp

setpos:	vcall f%setp
curpos:	vcall f%curp
getx.:	vcall f%getx
putx:	vcall f%putx

retzer:	setzm 1(p)		;returns zero - used for device nul
	popj p,

;setpos for nul:.  no-op, except in read mode if GET not suppressed,
;it simulates EOF.
nulspo:	jumpn d,nulspx		;if get suppression, no-op
	skprea			;if write mode, no-op
nulspx:	popj p,			;no-op
	jrst simeof		;else simulate GET

resdev:	movsi c,(cz%abt!co%nrj)	;this is DISMISS - the tops10 resdv.
	jrst clochk
relf.:	tlza c,(co%nrj)		;this is RCLOSE - release the jfn
clofil:	tlo c,(co%nrj)		;this is CLOSE - keep the jfn
clochk:	move a,filtst(b)	;if the file isn't init'ed
	caie a,314157
	pushj p,initb.		;then do it
doclos:		;We now assume that if there is a non-zero jfn, that is a
		;valid jfn.  SETPRM is thus coded to defend against garbage
		;jfn's.  But if a user calls this, he should beware.
	;warning: only a and t are free.  Be sure the filclo routine knows that
		;c - close bits
	movei a,0		;do mode-dependent clean-up
	exch a,filclo(b)
	skipe a			;  if 0, no routine
	pushj p,(a)
	move t,filjfn(b)	;close file
	jumpe t,clofb		;if no jfn, nothing to close
  ;if we are killing the jfn, special cleanups may be needed
	tlne c,(co%nrj)		;if asked to kill the jfn, do so
	jrst clonk		;don't kill jfn
  ;beginning of special cleanups for releasing jfn
	setzm filjfn(b)		;clear all record of it
	move a,filflg(b)	;get flags
	trnn a,fl%tmp		;if temp file
	jrst clonk		;  not temp, done with it
;Now, all cases go either to the following code for temp files,
;or to clonk, for closing without killing.
  ;temp file - releasing implies deleting
	hrrz a,t		;delete instead of just closing
	hrli a,(co%nrj)		;first we must close it
	closf
	 chkquo
	 erjrst clorl		;couldn't close it - just release it
	hrli a,(df%exp)		;now delete, expunge, and release it
	delf
	 erjrst clorl		;couldn't - just release it
	jrst clofb		;done with this jfn

  ;normal file - close it without killing it, using bits from c
clonk:	hrrz a,t
	hll a,c
	closf
	 chkquo			;[27]
	 erjrst .+2		;[7]  close failed, release instead
	jrst clofb		;  close worked, go on
	tlne c,(co%nrj)		;don't release if asked not to!
	jrst clofb
	hrrz a,t
clorl:	rljfn
	 chkquo			;[27]
	 erjrst clofb		;[7]  release failed too, no hope

;All cases join here, even after "impossible" combinations of errors
clofb:	movei a,0		;clean up buffers if any
	exch a,filbuf(b)
	jumpe a,clof2		;  none- done
	push p,b		;demap the page
	push p,a		; since may have been doing pmap I/O on it
ife tenex,<
	hlrz c,a		;count in rh of c
	ldb b,[point 9,a,26]	;page no.
	hrli b,400000		;in this process
	seto a,			;clear the page
	hrli c,(pm%cnt)		;do all at once
	pmap
	 chkquo			;[27]
	 erjmp .+1		;no errors here, please
> ;ife tenex
ifn tenex,<
	hlrz t,a		;count of pages to be released
	ldb b,[point 9,a,26]	;page no.
	hrli b,400000		;in this process
	seto a,			;clear the page
	setz c,
clof1l:	pmap
	addi b,1		;next page
	sojg t,clof1l		;if any
> ;ifn tenex
	pop p,a			;restore target page
	pushj p,relpg.		;put it in free list
	pop p,b
clof2:	hrli t,unop		;[12] now mark file as no longer open
	hrri t,filr11(b)	;[12] so future accesses get error
	blt t,filr99(b)		;[12]
	popj p,

break:	vcall f%brk		;force out buffers

breaki:	push p,c
	push p,b
	move a,[ascii /-----/]	;old line no. no longer valid
	movem a,fillnr(b)
	pcall f%init		;use buffer filler if any
	pop p,b
	pop p,d
	hlre c,filcnt(b)	;make up argument for binary get
	movn c,c		;is negative count in filcnt
	skpwrt			;don't do get if write-only file!
	jumpe d,@filget(b)	;and get unless suppressed
	move a,filcnt(b)	;otherwise clear buffer
	setzm (a)
	aobjn a,.-1
	move a,filbad(b)	;and set eoln, since dummy data in buf
	movem a,fileol(b)
	popj p,

nextfi:	movsi c,(co%nrj)	;go to next wildcard file - must be closed
	pushj p,doclos
	move a,filjfn(b)
	gnjfn
	 jrst nonext
	movem a,1(p)		;if succeed, return flags (always nonzero)
	popj p,

nonext: move d,b
	movei a,400000		;nextfi failed, see why
	geter
	andi b,-1		;get error code only
	caie b,gnjfx1		;if anything except ran out of files
	jrst nonxt1		;it is a real error
	move b,d
	setzm 1(p)		;bad return
	setzm filjfn(b)		;they released our jfn (naughty folks)
	popj p,
nonxt1:	pushj p,ioer		;a real error
	setzm 1(p)		;still give bad return
	popj p,
	subttl device-independent routines for error recovery

;showln - this is the default showln for devices where we can't
;  really show the current line.
showln:	push p,a
	push p,c
	push p,d
	hrroi a,[asciz /[Error at character number /]
	psout
	pushj p,curpos		;get current position
	push p,b
	movei a,.priou
	move b,1(p)		;returned value
	movei c,12		;in decimal
	nout
	 jfcl
	hrroi a,[asciz /]
/]
	psout
	pop p,b
	pop p,d
	pop p,c
	pop p,a
	popj p,	

;notry - use this routine for FIXLIN with devices where you don't
; implement retrying.
notry:	hrroi a,[asciz /Call to READ/]
	psout
	pushj p,runer.
	hrroi a,[asciz /
[Skipping bad character]
/]
	psout
	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 - jfn 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
	skipe .jbddt			;.jbddt?
	jrst tryddt			;yes - that is fine
	move a,[xwd 400000,770]		;else look for VMDDT
	rpacs				;page exist?
	move a,-2(p)
	tlnn b,(pa%pex)			;
	jrst trynod			;no - continue
	tlnn b,(pa%ex)			;allowed to execute?
	jrst trynod			;no - continue
;Here if DDT - give him an option
tryddt:	move a,-2(p)
	hrroi b,[asciz /
[Try again, from the beginning of the bad number.]
[Or type D to enter the debugger.]
/]
	setz c,
	sout
	move b,-1(p)		;get back FCB
	pushj p,@filget(b)
	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
	hrroi a,[asciz /Call to READ /]
	psout
	pushj p,runer.
	pcall f%init		;clear input buffer again
	jrst tryag1

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

/]
	setz c,
	sout
	move b,-1(p)
	pushj p,@filget(b)	;just get a char
tryOK:	pop p,c
	pop p,b			;return it to the user
	pop p,a
	pop p,t
	popj p,
	
	subttl pmap I/O - ascii top-level routines

filadv==fils11  ;routine to get to next buffer
filpag==filst1	;disk page currently working on
filbgp==filst4	;disk page at beginning of buffer
filpgb==fils15	;number of pages in buffer
filbct==filst2	;bytes in current page
filbpt==filst3	;pointer to next byte in buffer
fillby==fils12	;last byte in file
filcby==fils13	;current byte in file
filbfp==fils16	;ptr to beginning of current page
filbfs==fils17	;size of page in bytes
fillct==fils20	;count of last record operation

;put
putchd:	aos a,filcby(b)		;advance current byte
	camle a,fillby(b)	;beyond end seen so far?
	movem a,fillby(b)	;yes - update it
	sosge filbct(b)		;room in buffer?
	pushj p,@filadv(b)	;no - next
	move a,filcmp(b)	;put it in
	idpb a,filbpt(b)
	 ercal maperr
	popj p,

noput:	move d,b		;error routine if not open for write
	movei a,iox2		;write priv req
	movem a,filerr(d)
	jrst erp.

;This routine is called when we get an error upon attempting access
; to a page.  It makes assumes that the caller uses the following
; sequence:
;	aos filcby(b)
;	sos filbct(b)
;	idpb a,filbpt(b)
;	 ercal maperr
; as it will undo the sideeffects of these operations if necessary.
; When a hole is found, we just have to set a to zero after clearing
;	the page.
; But on a real error, we have to back out all the operations shown
;	and abort the caller.

maperr:	
;for tops-20 the most likely thing here is that we tried to read a
;  hole in the file. Tops-20 gives an ill mem read in that case. 
;Also, it may be quota exceeded.
;So the code comes in these pieces:
;  diagnose it - hole in the file?
;  if a hole, then give a zero page
;  else, print an error message and back out of the I/O operation

ife tenex,<
	push p,b		;see if page exists
;First see if we have a quota problem
	push p,a
repeat 1,<  ;This is due to a monitor bug.
	move a,[point 7,a]	;do an ILDB to clear first part done
	ildb a,a		;since ERCAL may leave it set
> ;repeat 1
	movei a,400000		;see what error
	geter
	tlz b,777777		;b _ error code
	cain b,iox11		;if quota error
	jrst mapquo		;special handling
	pop p,a
;here we check to see if the page is perhaps nonexistent in the file
;if so, we treat it as zeros.  
	move b,0(p)		;[35] get back FCB
	hrrz a,filbpt(b)	;addr of core page
	lsh a,-11		;convert to page
	hrli a,.fhslf		;in out fork
	rpacs
	 erjmp maper3		;treat this as an I/O error
;The case we are looking for is read-only access and an indirect pointer
	tlnn b,(pa%wt)		;if have write access, not this problem
	tlnn b,(pa%ind)		;if indirect too, that is it
	jrst maper3		;write access or not indirect: normal error
  ;here if it is a hole.  clear the page
maper1: move b,a		;b _ .fhslf,,core page no.
	seto a,			;clear page
	push p,c
	setz c,			;no counts
	pmap
	 chkquo			;[27]
	 erjmp maper2		;can't clear page
	pop p,c
	pop p,b
	setz a,			;return zero byte
	popj p,

;here if is a quota error, to retry
mapquo:	push p,c
;error message
	hrroi a,[asciz / Quota exceeded or disk full at /]
	esout
	movei a,.priou
	sos -3(p)		;adjust ret addr to go back to idpb
	sos -3(p)
	hrrz b,-3(p)
	movei c,10		;base 8
	nout
	 jfcl			;not sure how to handle errors here
	hrroi a,[asciz /
[Find some space, then type CONTINUE]
/]
	psout
; Finally we are ready to restore to the user's context and continue,
; if user types CONTINUE
	pop p,c
	pop p,a
	pop p,b
	haltf			;let him delete some files
	adjstk p,-1		;go retry
	jrstf @1(p)		;must use jrstf to restore first part done

ife klcpu,<printx Using KL instruction (ADJBP) at QUOBPT+>
;If you want to use a non-KL DEC-20, you will have to write a routine to
;simulate adjbp.  It must be able to handle any byte size.

;here is the beginning of the true error code.
maper2:	pop p,c
maper3:	pop p,b
> ;ife tenex
	sos filcby(b)		;move back
	aos filbct(b)

ifn klcpu,< ;[5]
	movni a,1
	adjbp a,filbpt(b)
	movem a,filbpt(b)
> ;[5] ifn klcpu

ife klcpu,< ;[5] start
;****** Tenex hackers, note:  this code assume byte size = 7, not always true.
	sos filbpt(b) 
repeat 4,<ibp filbpt(b)>
> ;[5] end ife klcpu

	pop p,(p)		;abort caller
	jrst ioerp

;get
getchd:	aos a,filcby(b)		;advance current byte
	camg a,fillby(b)	;beyond eof?
	 jrst getcd1		;no - do normal input
dskeof:	sos filcby(b)		;yes - don't do the advance
	;jrst simeof

;simeof - simulate eof for pmap, texti (etc.?)
simeof:	move t,filbad(b)	;yes - set eof
	movem t,fileof(b)
	movem t,fileol(b)
	skipl filcnt(b)		;if ascii
	setzm filcmp(b)		;clear buffer, for read/ln
	movei t,iox4		;simulate monitor eof error code
	movem t,filerr(b)
	popj p,

getcd1:	sosge filbct(b)		;count bytes left in this buffer
	pushj p,@filadv(b)	;none - get new buffer
	ildb a,filbpt(b)	;get character
	 ercal maperr
	move t,fillts(b)	;line no. test bit if 7 bit mode
	tdne t,@filbpt(b)	;was it a line no.?
	jrst getcln		; yes
	andi a,177		; no - be sure legal ascii
	jumpe a,getchd		;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

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 3,<letter>	;34 - 36

ifn tenex,<linech 1>	;37
ife tenex,<letter>	;37

repeat 162,<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 3,<letter>	;34 - 36

ifn tenex,<linech 1>	;37
ife tenex,<letter>	;37

repeat 101,<letter>	;40 - 140
repeat 32,<lc>		;141 - 172
repeat 5,<letter>	;173 - 177

;
;Now the tables for standard pascal semantics - replace EOLN by space
;
define linech(x),<xwd x," ">	;end of line char
;otherwise the tables are the same
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 3,<letter>	;34 - 36

ifn tenex,<linech 1>	;37
ife tenex,<letter>	;37

repeat 162,<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 3,<letter>	;34 - 36

ifn tenex,<linech 1>	;37
ife tenex,<letter>	;37

repeat 101,<letter>	;40 - 140
repeat 32,<lc>		;141 - 172
repeat 5,<letter>	;173 - 177

;called by get to skip line no.
getcln:	move t,@filbpt(b)	;line no. - get it
	movem t,fillnr(b)	;save it for user
	aos filbpt(b)		;skip it
	movei t,5		;update currentposition
	addm t,filcby(b)
	movni t,5		;note getchb already skipped one char, so
	addb t,filbct(b)	; we only skip 5
	jumpge t,getchd		;now get real character
;the context in which filadv is valid is where we have just done sosge filbct,
;and are about to do ildb.  Usually this is right, as in the subtraction of
;5 above, 1 of the 5 is in the new block.   so that is the sosge.  we will
;still have to do an ibp afterwards, though.  If we are further into the
;word than the first char, we now back up, since filadv will leave us at
;the start of the buffer (and its error handling is predicated on the
;assumption that we are working on the first char)
	addi t,1		;if more than one char into new buffer
	addm t,filcby(b)	;move back (T is negative)
	pushj p,@filadv(b)	;go to new buffer
	ibp filbpt(b)		;pass over first char (tab)
	jrst getchd		;now go back for real char
	subttl pmap I/O - buffer advance and go to new page

;dskadv - get to the next page when reading sequentially.  If
; the getpage succeeds, this gives new byte ptr, count, etc., for
; the new page.  Otherwise you are left exactly where you were before,
; with filcby adjusted, since the caller is assumed to have
; incremented it.
;	t,a - temps
;	b up - preserved
dskadv:	move t,filpag(b)	;old page
	addi t,1		;new page
	pushj p,getfpg		;get page routine
	 jrst badadv		;can't get new page
	move t,filbfs(b)	;bytes in buffer
	subi t,1		;caller has done sosge
	movem t,filbct(b)
	move t,filbfp(b)	;pointer to start of buffer
	movem t,filbpt(b)
	popj p,

badadv:	sos filcby(b)		;user has done aos on this
	pop p,(p)		;abort our caller
	popj p,

;getfpg - get specified page 
;	t - desired page - preserved
;	a - temp
;	b up - preserved
;  returns:  t - requested disk page
;    also resets 
;	filbfp(RH) to point to the core page where the disk page is mapped
;	filpag to indicate we are on a new file page
;	filbgp if we have to remap the buffer, to indicate new beginning
;    the user is assumed to adjust counts, pointers, etc., as he likes

getfpg:	move a,t		;a _ desired page
	sub a,filbgp(b)		;a _ pages beyond start of buffer
	cail a,0		;if before buffer start
	caml a,filpgb(b)	;or after buffer end
	jrst getfpn		;need new pages
  ;here when desired page is in buffer
	push p,c
	hrrz c,filbuf(b)	;beginning of core buffer
	lsh a,11		;convert page offset to word offset
	add a,c			;a _ core addr where we have file page
	hrrm a,filbfp(b)	;save as current buffer start
	movem t,filpag(b)	;also remember we are now where asked
	pop p,c
	jrst cpopj1

  ;here when desired page is not in buffer
getfpn:	push p,c		;filadv routine for pmap I/O
	push p,b
	hrr a,t			;desired page
	hrl a,filjfn(b)		;on this file

ife tenex,<
	hlr c,filbuf(b)		;c _ page count for buffer
	hrli c,(pm%cnt!pm%rd!pm%wr!pm%pld) ;say we have a count, preload
	hrrz b,filbuf(b)	;address of buffer
	lsh b,-9		;make page no.
	hrli b,400000		;current process
	pmap
	 chkquo			;[27]
	 erjmp badpag
> ;ife tenex

ifn tenex,<
	push p,d		;d will be page count
	hlrz d,filbuf(b)
	movsi c,(pm%rd!pm%wr)
	hrrz b,filbuf(b)	;addr of buffer
	lsh b,-9		;convert to page
	hrli b,400000		;this process
getfpl:	pmap			;one page only
	addi a,1		;go to next page
	addi b,1
	sojg d,getfpl		;and do it if desired
	pop p,d
> ;ifn tenex

 ;general success return
gotpag:	pop p,b
	pop p,c
	movem t,filpag(b)	;only now can we say are on that page
	movem t,filbgp(b)	;and that page is buffer begin
	hrrz a,filbuf(b)
	hrrm a,filbfp(b)	;and current page is first in buffer
cpopj1:	aos (p)			;skip return - success
	popj p,

;note that badpag is called with b&c saved on stack
badpag:	pop p,b			;we don't change filpag, as haven't moved
	pop p,c
	jrst ioerp		;gives non-skip (error) return
	subttl pmap I/O - actual I/O routines for record files

;The following routines set up C to indicate the desired
; transfer, and then call getdlp or putdlp, which simulate
; sin and sout.  If an I/O error occurs, getdlp or putdlp
; will return with c as at the point of error.  Thus the
; caller may have some adjustments to do.

;get
getd:	movem c,fillct(b)	;assume no. transferred = no. requested
	movn c,c		;make up aobjn word
	hrl c,c			;lh(c) _ no. to transfer
	hrri c,filcmp(b)	;rh(c) _ starting loc to transfer
	pushj p,getdlp		;sin
	hlre c,c		;c _ - no. left untransferred
	addm c,fillct(b)	;adjust assumption
	popj p,

;put
putd:	movem c,fillct(b)
	movn c,c
	hrl c,c
	hrri c,filcmp(b)
	pushj p,putdlp		;sout
	hlre c,c
	addm c,fillct(b)
	popj p,

;getx
getxd:	move d,c		;requested upper limit
	sub c,fillct(b)		;c _ no. needed this time
	movn c,c		;make aobjn word
	hrl c,c
	hrri c,filcmp(b)
	add c,fillct(b)		;adjust by no. already done
	pushj p,getdlp		;sin
	hlre c,c
	addm c,fillct(b)
	popj p,

;putx
putxd:	move c,filcby(b)	;go back to beginning of record
	sub c,fillct(b)		;c _ byte at beginning
	pushj p,dskmov		;move to beginning of record
	 popj p,		;no - I/O error in setpos
	move c,fillct(b)	;get back no. to transfer
	jrst putd		;now put out the record

;Here are the sin/sout simulations.  Note that if there is
; an I/O error, filadv will sos filcby(b) and abort the routine.
; In that case c will be left negative, and the caller (above)
; will do the right thing.

;sin
getdlp:	aos a,filcby(b)		;assume we are going to a new byte
	camle a,fillby(b)	;beyond eof?
	 jrst dskeof		;simulate eof
	sosge filbct(b)		;anything left in buffer?
	pushj p,@filadv(b)	;no - next buffer - may abort here
	ildb a,filbpt(b)
	 ercal maperr
	movem a,(c)
	aobjn c,getdlp
	popj p,

;sout
putdlp:	aos a,filcby(b)		;assume we are going to a new byte
	camle a,fillby(b)	;beyond eof?
	 movem a,fillby(b)	;update eof
	sosge filbct(b)
	pushj p,@filadv(b)
	move a,(c)
	idpb a,filbpt(b)
	 ercal maperr
	aobjn c,putdlp
	popj p,
	subttl pmap I/O - device dependent openning

;main entry to do openfi
dskopn:	skipe filerr(b)		;must be no-op if error in jfn
	popj p,
	movei t,dskadv		;disk advance routine
	movem t,filadv(b)
	ldb t,[point 6,g,5]	;get byte size
	move a,t		;a _ byte size
	lsh t,^D24		;put in byte size position
	movem t,filbpt(b)	;in pointer
	tlo t,440000		;byte pointer LH
	hllm t,filbfp(b)	;RH set up later (may be already)
	movei t,^D36		;compute no. of bytes in a page
	idiv t,a		;t _ no. of bytes/word
	lsh t,9			;t _ no. of bytes/page
	movem t,filbfs(b)	;save as public knowledge
;here we have to split according to the sort of open being done
	trne g,of%app		;special code to simulate append
	jrst dskapp
	trnn g,of%rd		;special code if write-only
	jrst dskwrt
;read or update - must be able to read, so pmap always works
	trne g,of%wr		;if only read
	jrst dskop1		; not - ignore this
  ;read only
	movei t,noput		;disable writing
	movem t,filput(b)
	movei t,dskrcl		;use special close (doesn't change size)
	movem t,filclo(b)
  ;read or update again
dskop1:	pushj p,openfi
	skipe filerr(b)		;this may fail
	popj p,
	pushj p,sizefi		;set up end of file stuff
	jrst dskini
;write only
dskwrt:	pushj p,openfi
	skipe filerr(b)
	popj p,
	hrrz a,filjfn(b)	;see if we can read, too
	move h,b
	gtsts
	 erjmp doope
	tlnn b,(gs%rdf)
	jrst dskbn1		;can't read it, use normal binary mode
	move b,h
	setzm fillby(b)		;file is now zero length
	jrst dskini
;here to exit to normal binary routines in case can't use pmap.  DEC
;requires read priv's to do pmap, although tenex doesn't
dskbn1:	move b,h
	hrr a,filjfn(b)		;It's open - close it
	hrli a,(co%nrj)
	closf
	 erjrst oper		;[7]
dskbin:	hrli t,chrtxt		;change to normal mode
	skipge filcnt(b)
	hrli t,chrrec
	hrri t,filr11(b)
	blt t,filr99(b)
	jrst chropn		;now open in real mode

;append simulation
dskapp:	trc g,of%app!of%rd!of%wr
	pushj p,dopenf		;try read/write open
	 jrst appbin		;failed, so try real append
	pushj p,sizefi		;find end of file
	skipe filerr(b)		;it can fail
	popj p,
	pushj p,dskini
	move c,fillby(b)	;go to end
	setz d,			;suppress get
	jrst dskspo
;here to ext to normal binary routines in case can't append using pmap
appbin:	trc g,of%app!of%rd!of%wr
	jrst dskbin
;here to do openf for dskapp - needs special routine so we don't
; trigger error processing if it fails.
dopenf:	move h,b		;save b
	hrrz a,filjfn(h)
	move b,g
	openf
	 erjrst cpopjh		;[5]
	aos (p)			;good return
cpopjh:	move b,h		;bad return
	popj p,

;These are common initializations that must not be done until
;we know the open succeeded
dskini:	setzm filbct(b)
	setom filpag(b)
	movni t,377777		;force us to get new page
	movem t,filbgp(b)
	setzm filcby(b)
	ldb a,[fl%buf!filflg(b)] ;number of buffers user wants
	caig a,0		;must be between 1 and 36
	movei a,mapbfs		;if 0, use default
	caile a,^D36		;if too big, use maximum
	movei a,^D36
	movem a,filpgb(b)	;save as buffer size in pages
	pushj p,alcbuf		;# pages is arg to alcbuf, in A
	move t,filbuf(b)
	hrrm t,filbfp(b)	;LH was set up at beginning
	popj p,

;alcbuf - allocation a page as a buffer - used elsewhere, too
;  a - number of pages to allocate
alcbuf:	hlrz t,filbuf(b)	;any buffer already?
	jumpe t,alcbfn		;no, get a new one
	camn t,a		;yes, right size?
	popj p,			;yes, nothing to do
	push p,a
	move a,filbuf(b)	;no, throw it away
	pushj p,relpg.
	pop p,a
alcbfn:	pushj p,getpg.		;get a new buffer
	movem a,filbuf(b)	;store size,,addr
	popj p,

ife srisw,<  ;[23]
;Here is the normal code for turning on the line number test.
;It turns it on for all text files with byte size 7.  If there
;are no line numbers in the file, of course everything is fine.

;This routine is considered device-dependent, since it is called only
;for devices capable of having line numbers.  For other devices, the
;test is simply CPOPJ, which leaves the test bit (FILLTS) 0.  This
;disables the test.  This distinction is just for safety, though
;presumably such devices wouldn't have line numbers anyway.

wrdlts:
dsklts:	ldb t,[point 6,filbfp(b),11] ;get byte size
	caie t,7		;if not 7
	popj p,			;can't be line numbered
	aos fillts(b)		;is line number - set fillts
	popj p,
>  ;[23] ife srisw

ifn srisw,< ;[23]
;This code is because SRI's EMACS puts random low-order bits into
;files.  Thus we have to test the first word of the file to see if
;it is a line number, and turn off testing if not.

;xxxlts - device-dependent routine to see if this is a line-numbered
;  file.  Only devices that read full words have such a routine.  Others
;  use CPOPJ, which results in fillts still being zero for them.  Error
;  processing is a big pain in the neck, since we really want to save
;  eof and errors for the first real read.  So we generally have to
;  bypass the normal I/O routines.  These routines depend upon the fact
;  that a line numbered file must begin with a line number.  We have to
;  enforce this since EMACS tends to create things that look like line
;  numbers by setting the low order bit randomly throughout the file.
dsklts: movei t,0		;get page 0 of file
	skiple fillby(b)	;[17] if file is zero size, not numbered
	pushj p,getfpg
	 popj p,		;if can't get page 0,not numbered
	setom filpag(b)		;pretend we didn't read the page
	move a,filbfp(b)	;get addr of first word
	move t,(a)		;get first word
	 erjmp cpopj		;if error, not linenumbered
;comlts - entry for testing line number.  first byte of file in t
comlts:	ldb a,[point 6,filbfp(b),11] ;get byte size
	trze t,1		;if low order bit off or
	caie a,7		;if not 7
	popj p,			;can't be line numbered
	camn t,[ascii /     /]	;this is a page mark
	jrst isnum		;which is OK to start the file
	movei a,5		;otherwise must be digits
	move c,[point 7,t]	;get from t
comlt1:	ildb d,c		;next digit
	cail d,"0"		;if not digit
	caile d,"9"
	popj p,			;isn't a line number
	sojg a,comlt1		;go back for next
isnum:	aos fillts(b)		;is line number - set fillts
	popj p,
> ;[23] ifn srisw



	subttl pmap I/O - device-dependent routines

;break
dskbrk:	skipge filbgp(b)	;break function - force out buffer
	popj p,
	move a,filbuf(b)	;count,,buf addr
	move d,b		;save fcb
ife tenex,<
	hlrz c,a		;count in rh of c
	ldb b,[point 9,a,26]	;page no.
	hrli b,400000		;in this process
	seto a,			;clear the page
	hrli c,(pm%cnt)		;do all at once
	pmap
	 chkquo			;[27]
	 erjmp ioer		;no errors here, please
> ;ife tenex
ifn tenex,<
	hlrz t,a		;count of pages to be released
	ldb b,[point 9,a,26]	;page no.
	hrli b,400000		;in this process
	seto a,			;clear the page
	setz c,
dskbrl:	pmap
	addi b,1		;next page
	sojg t,dskbrl		;if any
> ;ifn tenex
	move b,d
	popj p,

;close for read-only modes
dskrcl:	push p,c		;special close that doesn't change size
	push p,d
	jrst dskcl1

;breakin
dskbri:	setzm filbct(b)		;breakin function - clear buffer
	setom filpag(b)
	movni t,377777		;force us to get new page
	movem t,filbgp(b)
	setzm filcby(b)
	setzm fillct(b)
	popj p,

;close for read/write modes
dskclo:	push p,c
	push p,d		;filclo allows only t and a free
	push p,b		;now we will reset the eof pointer
ifn tenex,<hrli a,.fbbyv>		;the offset - byte size
ife tenex,<hrli a,400000!.fbbyv>	;same, suppress updating disk copy
	hrr a,filjfn(b)
	move c,filbpt(b)
	hrlzi b,007700		;mask
	chfdb
	 erjmp .+1		;if not open for output, ignore
	move b,(p)		;restore b
	hrli a,.fbsiz		;no. of bytes
	hrr a,filjfn(b)
	move c,fillby(b)
	seto b,			;all bits
	chfdb
	 erjmp .+1
	pop p,b
dskcl1:	pushj p,dskbrk		;close - force last buffer
	pop p,d
	pop p,c
	popj p,

;This doesn't belong here, is called by open
sizefi:	move h,b		;compute last byte no.
	hrrz a,filjfn(h)
	move b,[xwd 2,.fbbyv]
	movei c,b		;put b _ byte size, c _ bytes in file
	gtfdb			;get from fdb
	 erjmp doope
	ldb t,[point 6,filbpt(h),11]	;t _ our byte size
	ldb a,[point 6,b,11]	;a _ file's byte size
	cain a,0		;[2] if zero
	movei a,^D36		;[2] use 36 to prevent divide by 0
	camn a,t
	jrst sambsz		;if same, use exact calculation
	subi c,1		;else do in words
	push p,e		;resetf needs e preserved
	movei d,^D36
	idiv d,a		;d _ file bytes/wd
	idiv c,d		;c _ file words - 1
	addi c,1
	movei d,^D36
	idiv d,t		;d _ our bytes/wd
	imul c,d		;c _ our no. of bytes
	pop p,e
sambsz:	movem c,fillby(h)
	move b,h
	popj p,
	subttl pmap I/O - random access

;setpos
dskspo: move e,d		;e _ suppress get flag
	pushj p,dskmov		;go where asked to
	 popj p,		;error return
posdon:	setzm fillct(b)		;old transfers now irrelevant
	skipe a,filerr(b)	;clear eof unless due to real error
	cain a,iox4
	jrst .+2		;if no error or eof, clear eof
	jrst posnoc		; other error, don't clear
	move t,filbad(b)
	trc t,1
	movem t,fileof(b)	;clear pascal eof
	setzm filerr(b)		;and error code
posnoc:	hlre c,filcnt(b)	;set up arg for binary get if needed
	movn c,c
	skpwrt			;don't read if open for write
	jumpe e,@filget(b)	;get 1st char unless suppressed
	move a,filcnt(b)	;new at new place
	setzm (a)
	aobjn a,.-1
	move a,filbad(b)	;1 if input, 0 if not
	movem a,fileol(b)	;dummy eol since nothing there
	popj p,

;dskmov - internal routine to move to new place
dskmov:	caige c,0		;if less than zero
	move c,fillby(b)	;use end of file
	push p,c		;save desired byte
	idiv c,filbfs(b)	;c _ pages, d _ bytes off in page
	move t,c		;req. page goes in t
	pushj p,getfpg		;go to that page
	 jrst dskspf		;failed - leave things unchanged
	pop p,filcby(b)		;we are now at requested place
	move a,filbfs(b)	;compute bytes left in page
	sub a,d
	movem a,filbct(b)	;and leave in counter
ife klcpu,< ;[5] start
	movei t,^D36
	ldb a,[point 6,filbfp(b),11] ;byte size
	idiv t,a		;t _ byte / wd
	move c,d
	idiv c,t		;c _ words, d _ bytes
	add c,filbfp(b)		;c _ pointer adjusted by words
	jumpe d,.+3		;loop to adjust c by bytes
	ibp c
	sojg d,.-1
	movem c,filbpt(b)	;store as current byte
> ;ife klcpu 
ifn klcpu,< ;[5] end
	adjbp d,filbfp(b)	;get pointer to the requested place
	movem d,filbpt(b)
> ;ifn klcpu
	aos (p)			;good (skip) return
	popj p,

dskspf:	pop p,(p)		;fail return, restore stack
	popj p,

dskcpo:	move a,filcby(b)
	movem a,1(p)		;just return current byte pt.
	popj p,
	subttl actual I/O routines for text files on ascii devices

;getchx is the normal ascii input routine
getchx:	setzm fileol(b)
	hrrz a,filjfn(b)
	push p,b
getcx1:	bin
	 erjmp ioerb
	jumpe b,getcx1		;ignore nulls
	pop p,a
	exch b,a		;a _ char, b _ fdb
getchr:	andi a,177
	move a,@filcht(b)
	hlrem a,fileol(b)
	hrrzm a,filcmp(b)
	came a,[xwd -1," "]	;if CR in standard Pascal mode
	popj p,
	jrst geteol		;then search for real EOL

;putchx is the normal ascii output
putchx:	hrrz a,filjfn(b)
	push p,b
	move b,filcmp(b)
	bout
	 chkquo
	 erjmp ioerb
	pop p,b
	popj p,

ioerbc:	pop p,c
ioerb:	pop p,b
	jrst ioerp
	subttl I/O routines for tty and ttyoutput

	filttb==filst1		;buffer for tty input
;note that this is a variable because it has to be reset during
; interrupt handling

gettty:	sosge filbct(b)		;type ahead left?
	pushj p,ttyadv		; no - get more
	ildb a,filbpt(b)	;get next char
	jumpe a,gettty		;ignore null
	jrst getchr		;standard ascii processor

ttyadv:	hrro a,filttb(b)	;get a new buffer
	push p,b
	push p,c
ifn tenex,< ;[5]
	move b,[exp ttybsz]	;[5] count
  ifn sumex,<
	movei c,12		;[7] break on LF
	pstin			;[5] pstin; [14] SUMEX/IMSSS only!
	ldb t,a			;[7] get terminator
	caie t,15		;[7] cr?
	jrst ttyadn		;[7] no, normal
	movei t,12		;[7] yes, add lf
	idpb t,a		;[7]
	subi b,1		;[7] count it
  > ;ifn sumex

  ife sumex,<
     ife pa2040,<
	pushj p,rdstr		;[14] non SUMEX/IMSSS - simulate INTERLISP ed.
	printx	assembling non sumex tty i/o routine
     >
  > ;ife sumex
ttyadn:				;[7]
> ;[5] ifn tenex
ife tenex&<1-pa2040>,< ;[5]
	setz c,
	move b,[exp ttybsz!rd%top] ;break on tops-10 breaks
   ife pa2040,<
	rdtty
	 chkquo
	 erjmp ioecbp
   >
   ifn pa2040,<
	pushj p,$$rdtty##
	 jump 16,ioecbp		;erjmp ioecbp
   >
> ;[5]
	hrrz b,b		;loc. left in buffer
	movei t,ttybsz-1	;total number avail (simulate sos)
	sub t,b			;adjust for locations left
	pop p,c
	pop p,b
	movem t,filbct(b)
	hrr t,filttb(b)
	hrli t,440700
	movem t,filbpt(b)
	popj p,

;TTOCUR - output portion of TTY buffer before current position
; uses t,a
; assumes B is FCB
; returns column position of prev char in C, ILDB ptr to current char in T
ttocur:	hrr t,filttb(b)		;first put out the buffer up to cur pos
	hrli t,440700		;t is byte ptr
	setz c,			;c is column counter
ttocr2:	move a,t		;a _ new copy of byte ptr
	ibp a			;consider new char
	camn a,filbpt(b)	;if it is cur char, we are done
	jrst ttocr1
  ;begin safety - prevent infinite loop in case ptr somehow messed up
	hrrz a,t		;addr from byte ptr
	subi a,^D50		;compare to start of buffer + 50
	camle a,filttb(b)	;still within buffer?
	jrst ttocr1
  ;end safety	
	ildb a,t		;else do a real advance to this char
	aoj c,			;and count it
	pbout
	jrst ttocr2		;yes, loop

ttocr1:	push p,b
	movei a,.priou
	rfpos			;RH(b) _ position in line
	skipe b			;if not terminal, use counted C
	hrrz c,b		;use position in terminal line
	pop p,b
	popj p,

;TTYSHL - Show the entire current line, with an arrow under the
;  current position.  No sideeffects.
;expects b to be set up
ttyshl:	push p,t
	push p,a
	push p,c
  ;put out the line
	psout
	pushj p,ttocur		;put out start of line
	move a,t		;now put out cur and rest of line
	psout
  ;now put out a line with ^ under cur pos
    ;crlf unless old line ended in one
	movei a,.priou		;see where we are now on line
	push p,b
	rfpos			;probably retype ended in a CRLF
	hrrz b,b		;b _ current pos on line
	hrroi a,[asciz /
/]
	caile b,1		;if not at beginning
	psout			; then do CRLF
	pop p,b
    ;spaces up to the right place
	movei a,40		;now blanks up to cur pos
ttshl4:	sojl c,ttshl3		;up to column shown in C
	pbout
	jrst ttshl4
    ;put out the ^
ttshl3:	movei a,"^"		;now caret under cur. pos
	pbout
	hrroi a,[asciz /
/]
	psout			;and CRLF
	pop p,c
	pop p,a
	pop p,t
	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:	pushj p,ttyini
	movei a,.priou
	jrst tryagn
	
ifn tenex,<
ife sumex,<
ife pa2040,<
 ; non SUMEX/IMSSS tty routine...Similar to Sumex/IMSSS PSTIN, i.e.
 ; corrections by typing a "[" and reverse-echoing characters deleted
 ; from the string.  First newly-typed character gets a "]" first:
 ; "this is a mispe[ep]spelling".  However unlike the Sumex code, it
 ; does not put you into binary mode, and it uses the same breaks as
 ; RD%TOP, i.e. ^G, ^L, ^Z, ESC, CR, LF.
 ;   This code is the result of several iterations.  It was originally
 ; supplied by Sumex, fixed up by DFloodPage at BBN, and finally edited
 ; by Hedrick.

 ; AC1 contains the string pointer
 ; AC2 contains the maximum number of bytes to input
 ; AC0 holds line character count, won't delete if count=0
 ; Note:  The decrement bytepointer routine frequently sets
 ;	     Arithmetic Overflow.  Thus, channel 6 is shut off
 ;	     during RDSTR, and reactivated afterwards

;Uses the following table to tell whether the terminal type is display.
;The user should make sure it is right for his site.

if1, <printx Be sure to change TRMTAB as appropriate for your site>

trmtab:	exp 0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
trmmax=.-1-trmtab

;uses t,c.  a and b are returned.  Others preserved where used.

rdstr:	push	p,b			;save ac2
	push	p,e			;save ac5
	push	p,d			;save ac4
	hlrz	e,a			;get the left half of the pointer
	move	d,a			;move the whole pointer to d to use
	cain	e,777777		;implicit bp?
	 hrli	d,440700		;convert to standard bytepointer
;args now set up:
; t - free, will be count of char's seen, initialized below
; a - free
; b - count of free chars in buffer
; c - free, will be flag bits below, 200000 = echo on, 100000 = display
; d - byte pointer into buffer
; e - free

;now set up COC and mode word, saving old on stack
	move	e,b			;save b in e
	movei	a,101			;get old COC word
	rfcoc
	push	p,b			;save old COC
	push	p,c
	tlz	b,(3B3)			;clear echo for ^A
	tlz	c,(3B1+3B7+3B9+3B11+3B13);clear echo for ^R, ^U, ^V, ^W, ^X
	sfcoc				;new COC
	rfmod				;get old RFMOD
	push	p,b			;save old mode word
;We have to set break on punct because rubout is a punctuation char on tenex!
	trz	b,77B23+3B29		;new values for wakeup and mode
	tro	b,16B23+1B29		;all except alphanum, ASCII mode
	sfmod				;new mode
	gttyp
	caile	b,trmmax		;legal terminal type?
	setz	b,			;no - use 0
	setz	c,			;flags to zero
	skipe	trmtab(b)		;except if display terminal
	tro	c,100000		;set display flag
	move	b,e			;restore b
	push	p,d
;stack is now:
;   initial d
;   mode
;   COC, c on top
;   saved d
;   saved e
;   initial b

;finish setting up AC's as described above:
	setz	t,			;init count to 0
	
rdstr1:	pbin				;get byte
	andi	a,177			;[clh] make 7-bit
	cain	a,"V"-100		;^V to quote
	 jrst	rdqte
	cain	a,177			;delete?
	 jrst	rddel
	cail	a,40			;characters .ge. 40 are always OK
	 jrst	rdok			;This is just for speed
;It is a control character.  We now test its special properties.
	cain	a,"A"-100		;^A = delete
	 jrst	rddel
	cain	a,37			;37 is EOL (quote it to get ^_)
	 jrst	rdeol
	caie	a,"U"-100		;^U and
	cain	a,"X"-100		;^X = delete line
	 jrst	rddell
	cain	a,"R"-100		;^R
	 jrst	rdreds			; redisplay line
	cain	a,"W"-100		;^W
	 jrst	rddlwd			; delete word
	movei	e,1			;now check terminators
	lsh	e,(a)
	tdnn	e,[xwd 001400,032200]	;null is right-most bit
	 jrst	rdok			;not a terminator
	jrst	rdtrm			;is a terminator

rdeol:	movei	a,15			;treat as CRLF
	idpb	a,d			;put down the CR
	soj	b,			;adjust count
	movei	a,12			;and LF
	idpb	a,d
	soj	b,
	tlz	c,400000		;*clear delete bit, or it gets 
					;* integer overflow and crashes if you
					;* hit control-U.
	jrst	rdtrm1

rdok:	aoj	t,			;increment count
	idpb	a,d			;put the byte into the string
	soje	b,rdtrm1		;if all bytes gone, leave
	jrst	rdstr1

rdqte:	pbin
	andi	a,177			;[clh]
	jrst	rdok			;get a quoted character

;delete line
rddell:	cain	t,0			;at BOLN, nothing to do
	 jrst	  [movei a,7		;beep
		   pbout
		   jrst rdstr1]
	tlz	c,400000		;will start new line clean
	trne	c,100000		;handle display mode
	jrst 	rpdell
	hrroi	a,[asciz / XXX
/]
	psout				;tell him line is cleared
rxdell:	setz	a,			;null for clearing line
	move	d,0(p)			;reinit pointer
	setz	t,			;  count
	move	b,-6(p)			;  and char's free
	jrst	rdstr1			;now go for new line

;display version of delete line
rpdell:	movei	a,15			;bare cr
	pbout
	jrst	rxdell

;retype line
rdreds:	push	p,t			;put null at the end of string
	setz	t,			;  here's the null
	move	a,d			;  here's the end of string
	idpb	t,a			;  put it there
	pop	p,t			;and restore things
	trne	c,100000		;check display
	jrst	rpreds
	hrroi	a,[asciz /
/]
	psout				;CRLF
rxreds:	move	a,0(p)			;initial pointer to buffer
	psout				;now put it out
	jrst	rdstr1			;and go back for more

;display version of retype line
rpreds:	movei	a,15			;bare CR instead of CRLF
	pbout
	jrst rxreds

;delete word
rddlwd:	cain	t,0			;delete word, error at BOLN
	 jrst	  [movei a,7
		   pbout
		   jrst rdstr1]
	movei	a,"_"			;echoes as backarrow
	trnn	c,100000		;if display, DECBP will delete
	pbout				;do it
;do first char always
	ldb	a,d			;first char to be deleted
	pushj	p,decbp			;start by deleting a char
	aoj	b,			;and adjust counts
	soje	t,rdstr1		;  if run out of char, done
	pushj	p,isanum		;is thing we deleted alphanum?
	jrst	rdstr1			;no - we are finished
;do more as long as all alphanum (including first)
rddlw2:	ldb	a,d			;delete any more?
	pushj	p,isanum		;if alphanum, yes
	jrst	rdstr1			; not, done
	pushj	p,decbp			;delete
	aoj	b,			;adjust counts
	soje	t,rdstr1		;  if run out, done
	jrst	rddlw2			;otherwise, go back for more

isanum:	caig	a,"z"
	caige	a,"0"
	popj	p,			;null-(0    ;  z)-177
	caige	a,"a"
	caig	a,"9"
	jrst yesanm			;0 - 9	   ;   a - z
	caig	a,"Z"
	caige	a,"A"
	popj	p,			;9) - (A   ;   Z) - a(
yesanm:	aos	(p)			;fall through on A - Z
	popj	p,

rddel:	cain	t,0
	 jrst	  [movei a,7		;at "BOLN," don't do a delete
		   pbout		;<beep!>
		   jrst	rdstr1]
	trne	c,100000		;display mode?
	jrst	rddel2			;yes, skip this since DECBP deletes
	ldb	a,d			;echo the preceding character
	pbout
	movei	a,"\"			;and backslash
	pbout
rddel2:	pushj	p,decbp			;decrement the bytepointer
	aoj	b,			;take back that character
	soj	t,			;and decrement the line count
	jrst	rdstr1			;get another byte

rdtrm:	idpb	a,d			;the final byte for character .lt. 37
	tlz	c,400000		;*clear delete bit, or it gets 
					;* integer overflow and crashes if you
					;* hit control-U.
	soj	b,			;read a byte, correct the count
rdtrm1:	move	t,b			;save b to be returned in t
					;     a to be returned is in d
	setz	a,			;stick a null at the end
	move	b,d
	idpb	a,b
;stack is now:
;   initial d
;   mode
;   COC, c on top
;   saved d
;   saved e
;   initial b
	movei	a,400000
	movsi	b,(1b6)
;start restoring things from stack
	pop	p,(p)			;not needed
	movei	a,101
	pop	p,b
	sfmod				;mode
	pop	p,c
	pop	p,b
	sfcoc				;COC
  ;put in return values before we clobber where they are
	move	b,t
	move	a,d
  ;resume the restoration
	pop	p,d			;ac's
	pop	p,e
	pop	p,(p)			;not needed
	popj	p,			;leave

decbp:	repeat 4,<ibp d>
	subi d,1
	trnn	c,100000	;in display mode, also remove from screen
	popj	p,
;here to move back on a screen
	push	p,b
	push	p,c
	push	p,d
	ildb	d,d		;get thing being deleted
	cail	d,40		;if printable, handle easily
	jrst	decprt
;here for control character
	lsh	d,1		;multiply by 2, since 2 COC bits per word
	movei	a,.priou
	rfcoc			;echo depends upon COC words
	lshc	b,(d)		;shift COC bits to high order end of 2
	tlnn	b,600000	;if zero, nothing to back over
	jrst	decdon		;  so done
	tlnn	b,400000	;if one, ^X
	jrst	decctx		;  so do ^X
	cain	d,11		;if tab
	jrst	redisp		;  I am lazy - redisplay the line
	tlnn	b,200000	;if two, unknown
	jrst	redisp		;  so redisplay
	cain	d,33		;if esc
	jrst	decone		;  one char
	jrst	redisp		;else unknown, so redisplay

;here for printable char
decprt:	cain	d,177		;rubout is not printable
	jrst	decdon		;  so do nothing
	caig	d,132		;outside upper case
	caige	d,101
	jrst	decone		;it is just one char
	movei	a,.priou	;upper case - be sure we aren't mapping
	rfmod
	trnn	b,tt%uoc
	jrst	decone		;not mapping - one char only
	jrst	dectwo		;mapping - two char's

;here for ^X type.  Problem is that upper case when flagging is ^'A, etc.
decctx:	pushj	p,backsp	;backspace for the ^
	jrst	redisp
	addi	d,100		;give us the upper case thing after the ^
	jrst	decprt		;now the char itself

;here when completely confused, to redisplay the line
redisp:	movei	a,15		;start fresh
	pbout
	setz	b,		;null to put at end of string
	move	a,(p)		;get d (current byte pointer)
	idpb	b,a		;put null next
	move	a,-4(p)		;start of line
	psout
	jrst	decdon

;now the simple action routines
dectwo:	pushj	p,backsp
	jrst	redisp
decone:	pushj	p,backsp
	jrst	redisp
decdon:	pop	p,d
	pop	p,c
	pop	p,b
	popj	p,

;here is the backspacer:
backsp:	movei	a,.priou	;if at start of physical line, redisplay prev
	rfpos
	trnn	b,777777	;if zero, is at start
	popj	p,		;redisplay needed
	movei	a,.priou	;set for literal use of ^H
	rfcoc
	push	p,b
	tlz	b,(3B17)
	tlo	b,(2B17)
	sfcoc
	hrroi	a,[byte (7)10,40,10]	;bs,sp,bs
	psout
	pop	p,b
	movei	a,.priou	;retore coc
	sfcoc
	aos (p)
	popj	p,

> ;ife pa2040
> ;ife sumex
> ;ifn tenex


ioecbp:	pop p,c
	pop p,b
	adjstk p,-1
	jrst ioerp

	reloc

ttybsz==^D250		;no of char's in buffer
ttybuf:	block ^D50	;buffer itself

	reloc

puttty:	move a,filcmp(b)
	pbout
	 chkquo
	 erjmp ioerp
	popj p,

ttyini:	setzm filbct(b)			;this is done by breakin
	popj p,
	subttl actual I/O for terminals openned as files

;on tenex, this routine is only used for the controlling terminal

getcht:	sosge filbct(b)
	pushj p,tdvadv
	ildb a,filbpt(b)
	jumpe a,getcht
	cain a,"Z"-100		;control-Z?
	jrst simeof		;yes - is really eof
	jrst getchr

;device-dependent open routine
tdvopn:	tro g,of%wr		;need write priv's to do echo output
	setzm filbct(b)		;force read on first get
	setzm filter(b)		;no saved errors
	movei a,1		;get a one page buffer
	pushj p,alcbuf
	jrst openfi

tdvadv:	
ife tenex&<1-pa2040>,< ;[7]
	skipe filter(b)		;if any stored error
	jrst simerx		;do it and abort
	push p,[exp 4]		;construct arg block for texti - size
	push p,[exp rd%top!rd%jfn]
	move t,filjfn(b)
	hrl t,t
	push p,t
	hrro t,filbuf(b)	;place to put input
	push p,t
	push p,[exp 5000]	;no of char's allowed
	movei a,-4(p)
 ifn pa2040,<
	pushj p,$$texti##
	 hrrzm a,filter(b)	;save error for simerr
  >;ifn pa2040
 ife pa2040,<
	texti 
	 chkquo
	 ercal txtier
  >;ife pa2040
	movei t,4777		;no. of char's remaining
	sub t,(p)
	adjstk p,-5
> ;ife tenex

ifn tenex&<1-pa2040>,< ;[7] begin
	push p,b
	push p,c
	hrro a,filbuf(b)	;place to put input
	move b,[exp 5000]	;count
  ifn sumex,< 
	movei c,032012		;break on ^Z, LF
	pstin			;[14] sumex/imsss line read
	ldb t,a			;get terminator
	caie t,15		;cr?
	jrst tdvadn		;no, normal
	movei t,12		;yes, add lf
	idpb t,a		;
	subi b,1		;count it
  >
  ife sumex,<
	pushj	p,rdstr		;[14] non-sumex simulation of line read
  >
tdvadn:				;
	movei t,4777		;no of char's remaining
	subi t,(b)
	pop p,c
	pop p,b
> ;ifn tenex [7] ^^

	jumpl t,tdvadv		;none there - try again or do error now
	movem t,filbct(b)	;  (caller assumes we got at least 1)
	hrr t,filbuf(b)		;initial byte ptr
	hrli t,440700
	movem t,filbpt(b)
	popj p,

setpt:	setzm filbct(b)		;setpos (curpos is curpbx)
	skipe filter(b)		;activate stored errors
	pushj p,simerr
	jrst setpbx

ioerp5:	adjstk p,-6		;note - 5 to restore stk, 1 to abort caller
	jrst ioerp

txtier:	hrrzm a,filter(b)	;save error for simerr
	popj p,

;TDOCUR - output portion of TTY buffer before current position
; uses t,a
; assumes B is FCB
; returns column position of prev char in C, ILDB ptr to current char in T
tdocur:	push p,b
	push p,d
	push p,e
	hrr t,filbuf(b)		;first put out the buffer up to cur pos
	hrli t,440700		;t is byte ptr
	hrrz a,filjfn(b)	;a is jfn
	setz c,			;c is column counter
	hrrz d,filbuf(b)	;d _ end of buffer
	addi d,1000
	move e,filbpt(b)	;e _ byte pointer for end
tdocr2:	move b,t		;a _ new copy of byte ptr
	ibp b			;consider new char
	camn b,e		;if it is cur char, we are done
	jrst tdocr1
  ;begin safety - prevent infinite loop in case ptr somehow messed up
	hrrz b,t		;addr from byte ptr
	camle b,d		;still within buffer?
	jrst tdocr1
  ;end safety	
	ildb b,t		;else do a real advance to this char
	aoj c,			;and count it
	bout
	jrst tdocr2		;yes, loop

tdocr1:	rfpos			;RH(b) _ position in line
	skipe b			;if not terminal, use counted C
	hrrz c,b		;use position in terminal line
	pop p,e
	pop p,d
	pop p,b
	popj p,

;TDVSHL - Show the entire current line, with an arrow under the
;  current position.  No sideeffects.
;expects b to be set up
tdvshl:	push p,t
	push p,a
	push p,b
	push p,c
  ;put out the line
	pushj p,tdocur		;put out start of line
	hrrz a,filjfn(b)
	move b,t		;now put out cur and rest of line
	move t,c		;t _ position of ^ on line
	setz c,
	sout
  ;now put out a line with ^ under cur pos
    ;crlf unless old line ended in one
	rfpos			;probably retype ended in a CRLF
	hrrz b,b		;b _ current pos on line
	caig b,1		;if not, crlf
	jrst tdvsh1
	hrroi b,[asciz /
/]
	setz c,
	sout
tdvsh1:
    ;spaces up to the right place
	movei b,40		;now blanks up to cur pos
tdvsh4:	sojl t,tdvsh3		;up to column shown in t
	bout
	jrst tdvsh4
    ;put out the ^
tdvsh3:	movei b,"^"		;now caret under cur. pos
	bout
	hrroi b,[asciz /
/]
	setz c,
	sout			;and CRLF
	pop p,c
	pop p,b
	pop p,a
	pop p,t
	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:	pushj p,ttyini
	hrrz a,filjfn(b)
	jrst tryagn

	subttl line and page routines (all ascii modes)

;Note that getln is called by readln.  Thus I class it as a high-level
; function and so abort the operation if eof is set.  The low-level
; functions (get, put, etc.) will try to go on even if eof is set.

getlx1:	pushj p,@filget(b)
getlnx:	skipe fileof(b)		;stop after errors
	popj p,
	skipg fileol(b)
	jrst getlx1
	jrst @filget(b)

putlnx:	movei t,15
	movem t,filcmp(b)
	pushj p,@filput(b)
	movei t,12
	movem t,filcmp(b)
	jrst @filput(b)

putpgx:	movei t,15
	movem t,filcmp(b)
	pushj p,@filput(b)
	movei t,14
	movem t,filcmp(b)
	jrst @filput(b)
	subttl i/o routines for record files, sin/sout i/o used

;args to getbx and putbx:
;	b - fcb
;	c - count of words to transfer

getbx:	move e,b		;record read - save fcb
	hrrz a,filjfn(e)	;source
	hrri b,filcmp(e)	;destination
	hrli b,444400		;binary
	movem c,fillct(e)	;store count for error recov. and putx
	movn c,c		;count (negative means stop on count)
	setz d,
	sin
	 erjmp ioerbx
	popj p,

getxbx:	move e,b		;similar to getbx, but continue old read
	hrrz a,filjfn(e)
	hrri b,filcmp(e)
	hrli b,444400
	add b,fillct(e)		;start after last record
	movem c,fillct(e)
	sub c,fillct(e)		;reduce count that much
	movn c,c
	setz d,
	sin
	 erjmp ioerbx
	popj p,

ioerbx:	addm c,fillct(e)
	move d,e
	jrst ioer

putbx:	move e,b		;record write - save fcb
putby:	hrrz a,filjfn(e)	;source - entry for putx
	hrri b,filcmp(e)	;destination
	hrli b,444400
	movem c,fillct(e)	;count
	movn c,c		;make count negative
	setz d,
	skipe c			;[40] zero is special
	sout
	 chkquo
	 erjmp ioerbx
	popj p,

putxbx:	move e,b		;record rewrite
	hrrz a,filjfn(e)
	rfptr			;see where we are now
	 erjrst eioer		;[7]
	sub b,fillct(e)		;get to beginning of record
	sfptr
	 erjrst eioer		;[7]
	move c,fillct(e)	;size of record
	jrst putby		;now put it out

curpbx:	move d,b		;get current byte no.
	hrrz a,filjfn(d)
	rfptr
	 erjrst ioer		;[7]
	movem b,1(p)		;return value goes here
	popj p,

setpbx:	move e,d		;suppress get flag
	move d,b		;save fcb
	hrrz a,filjfn(d)
	move b,c		;place to go
	sfptr
	 erjrst ioer		;[7]
	move b,d		;restore b for get routine
	jrst posdon		;common code to clear status and do get

bxopn:	pushj p,openfi
bxini:	setzm fillct(b)		;initialization for open
	popj p,
	subttl i/o routines for tape - sinr/soutr i/o used

;args to getbxr and putbxr:
;	b - fcb
;	c - count of words to transfer

getbxr:	move e,b		;record read - save fcb
	hrrz a,filjfn(e)	;source
	hrri b,filcmp(e)	;destination
	hrli b,444400		;binary
	movem c,fillct(e)	;store count for error recov. and putx
	move t,c		;save requested count
	movn c,c		;count (negative means stop on count)
	setz d,
	sinr
	 erjmp ioerbx
	add c,t			;get no. words actually read
	movem c,fillct(e)	;save as real count
	popj p,

putbxr:	move e,b		;record write - save fcb
	hrrz a,filjfn(e)	;source - entry for putx
	hrri b,filcmp(e)	;destination
	hrli b,444400
	movem c,fillct(e)	;count
	movn c,c		;make count negative
	setz d,
	skipn c			;[40] zero is special
	hrri b,[exp 0]		;[40] stop immediately
	soutr
	 chkquo
	 erjmp ioerbx
	popj p,

lstrec:	move a,fillct(b)	;get size of last record
	movem a,1(p)
	popj p,

;Here are the routines for handling text with SINR and SOUTR

putcx:	sosge filbct(b)		;write a character
	jrst ptcxer		;ran out of space in buffer - line too long
	move a,filcmp(b)
	idpb a,filbpt(b)
	popj p,

ptcxer:	movei a,iox20		;illegal tape record size
	movem a,filerr(b)
	jrst ioerpx		;simulate I/O error

getcx:	sosge filbct(b)		;read a character
	jrst getcxl		;end of buffer - this is end of line
getcxn:	ildb a,filbpt(b)
	andi a,177
	jumpe a,getcx		;ignore nulls
	move a,@filcht(b)
	setzm fileol(b)		;the only end of line is end of record
	hrrzm a,filcmp(b)
	popj p,

;GETCXL - here from GETCX when run out of chars in record.  We simulate
;  end of line, and set things so the next character read forces going
;  to a new record.
getcxl:	movei a,getlx		;make the next GETCH get a new line
	movem a,filget(b)
	movei a,1		;set EOL
	movem a,fileol(b)
	movei a,40		;and call it a blank, as per Pascal std.
	movem a,filcmp(b)
	popj p,

;Here we have the routines to go to a new record.  there is a special
;version for format F

putlx:	push p,c		;write the buffer
	push p,b
	hrrz a,filjfn(b)
	movn c,filbfs(b)	;compute number of bytes to dump
	add c,filbct(b)		;subtract number not actually used
	move b,filpbp(b)
	skipn c			;[40] zero is special
	hrri b,[exp 0]		;[40] stop immediately
	soutr
	 chkquo
	 erjmp badpag
	pop p,b
	move a,filbfs(b)	;reinitialize state
	movem a,filbct(b)
	move a,filbfp(b)
	movem a,filbpt(b)
	pop p,c
	popj p,

;PUTLXX - special version for format F - writes an exact line
putlxx:	movei a,40		;put blanks until the record is full
	skipg c,filbct(b)	;space left?
	jrst putlx		;no - do output now
	idpb a,filbpt(b)	;yes - put in spaces
	sojg c,.-1		;as long as there is space
	setzm filbct(b)		;now no space left
	jrst putlx		;do normal write

getlx:	movei a,getcx		;restore normal reader
	movem a,filget(b)
	push p,c
	push p,b
	hrrz a,filjfn(b)
	movn c,filbfs(b)
	move b,filpbp(b)
	sinr
	 erjmp badpag
	pop p,b
	add c,filbfs(b)		;compute actual number transferred
;[40] remove subi c,1 - code must work for empty lines
	movem c,filbct(b)
	move a,filbfp(b)
	movem a,filbpt(b)
	pop p,c
	jrst getcx		;[40] was jrst getcxn

;CHROPX - mode-specific open.  This is bascially a version of
; CHROPN, the byte-mode open, except that it has to test for
; format F and use a special PUTLN routine.
chropx:	skipe filerr(b)		;byte mode I/O open
	popj p,			;no-op if error
;Here is the code that is always done
;The following is in fact just CHROPN
	pushj p,openfi		;now open it
chrox1:	pushj p,logopn		;compute logical parameters
	move t,filbfp(b)	;physical param's = logical ones
	movem t,filpbp(b)
	move t,filbfs(b)
	movem t,filpbs(b)
;This part sets up for special EOL handling because of the nature of this mode
	hrrz t,filcht(b)	;don't censor EOL char's, since they aren't EOL
	cain t,norchx		;if a char table that censors, change it
	movei t,norcht
	cain t,lcchx
	movei t,lccht
	hrrm t,filcht(b)	;put back correct table
;We have to "prime the pump" for reading.  this mode is different from others
;  because it will manufacture an EOL char when the buffer empties.  So if
;  we just start with an empty buffer, we get an initial EOL!
	skpwrt
	pushj p,getcxl		;if reading, init so the first GET reads
;The rest of this code is checking for writing a tape in format F, in which
;  case we have to set up a special routine for PUTLN.
;Writing
	skpwrt			;if reading, no problem 
	popj p,
;a tape
	move h,b		;save FCB
	hrrz a,filjfn(h)	;see if this is a tape
	dvchr
	ldb b,[point 9,b,17]	;get device type
	caie b,.dvmta		;if not tape, nothing to do
	jrst cpopjh		;exit, restoring B from H
;in format F
;  Since we are writing we can't just look at the label.  We have to
;  predict whether it will be format F.  It turns out that this will
;  happen only if the tape is labelled and the user has specified
;  ;FORMAT:F.

;labelled
	push p,[exp 3]		;place to put result
	push p,[exp 0]
	push p,[exp 0]
	hrrz a,filjfn(h)
	movei b,.morli		;look at label
	movei c,-2(p)
	mtopr
	erjmp chroxx		;not labelled, exit restoring stack and B
	move a,-1(p)		;label type
	cain a,.ltunl		;if unlabelled, forget this stuff
	jrst chroxx		;not labelled, exit restoring stack and B
;the user has specified format F
	hrroi a,-2(p)		;put results in stack
	setzm -2(p)
	hrrz b,filjfn(h)
	movei c,js%at1		;return attr
	hrroi d,[asciz /FORMAT/]
	jfns
	erjmp chroxx		;not format F, exit restoring stack and B
	move a,-2(p)
	came a,[asciz /F/]
	jrst chroxx		;not format F, exit restoring stack and B
;We now know that we will need the special format F PUTLN.  We have to set
; up the record size, so it knows how much to fill.  This is more complex
; than it sounds.  Since the tape is being created, we can't just get the
; record size from the label.  We have to predict what the monitor will
; decide on.  This turns out to be the user's RECORD attribute if there is
; one, or the block size if not.
;the user's RECORD attribute
	hrroi a,-2(p)		;put rec size in stack
	hrroi d,[asciz /RECORD/]
	jfns
	erjmp chronr		;no record attribute, use default
	hrroi a,-2(p)
	movei c,^D10
	nin
	erjmp chronr		;odd - use default too
	move c,b
	jrst chrofr		;found record size

;the block size if there is not RECORD attribute
chronr:	hrrz a,filjfn(h)	;no record attr - use default
	movei b,.morrs
	mtopr
	erjmp chroxx		;can't find that way either, treat as not F
;here the above two cases join - we have the record size in C
chrofr:	camle c,filbfs(h)	;too big for buffer?
	jrst rectb		;record too big
	movem c,filbfs(h)	;use this instead of buffer size
	movem c,filbct(h)	;we start with a full buffer available
	movei a,putlxx		;get special PUT for format F
	movem a,filpln(h)
;exit, restoring stack and B
chroxx:	adjstk p,-3
	move b,h
	popj p,
			
rectb:	adjstk p,-3		;record too big
	move b,h	
	jrst ptcxer		;give error message

;LOGCLX - mode-specific closer - force the buffer
logclx:	skpwrt			;only if writing
	popj p,
	move a,filbct(b)	;anything in this buffer?
	came a,filbfs(b)
	jrst @filpln(b)		;yes - force it
	popj p,			;no

loginx:	skpwrt			;breakin
	jrst getcxl
	move a,filbfs(b)
	movem a,filbct(b)
	move a,filbfp(b)
	movem a,filbpt(b)
	popj p,

	subttl magtape initialization

;This is a device-dependent openning routine for magtape.  It is used
;when the user leaves the I/O mode to us.  Here is what we do
;  format U, default, and unlabelled:  "stream I/O": out: WRDOPN, in: CHROPN
;  format F, D, and S:  "record I/O": text:CHROPX, binary:BXOPN
;Unfortunately, we have to do the OPENF first in order to be able to
;read labels.

;In addition, if this is an output file and the user hasn't specified
;a format, we want to specify format U.  This is somewhat harder than it
;sounds, since we can't specify the format after a GTJFN.  However
;since format U will default to stream I/O, we just make it use WRDOPN,
;which uses 36 bits.  This will get us format U by default.
;Input has to use CHROPN for format U in case the tape is foreign, in
;which case DEC is nice to us by forcing 8 bits internally.

;all three of the possible openning routines begin this way
mtaopn:	skipe filerr(b)
	popj p,
;might as well set up the stack now - everybody needs it
	push p,[exp 5]
	push p,[exp 0]
	push p,[exp 0]
	push p,[exp 0]
	push p,[exp 0]
	move h,b		;save B
	skpwrt			;if open for write
	jrst mtard		;not - no need to force 36 bits

;Part I - Check parameters for output file
  ;check unlabelled
	hrrz a,filjfn(h)
	movei b,.morli		;look at label
	movei c,-4(p)
	mtopr
	erjmp mtawrd		;unlabelled, force word
	move a,-3(p)		;get label type
	cain a,.ltunl
	jrst mtawrd		;unlabelled, force word
  ;check U or default
	hrroi a,0(p)		;put results in stack
	setzm 0(p)
	hrrz b,filjfn(h)
	movei c,js%at1		;return attr
	hrroi d,[asciz /FORMAT/]
	jfns
	erjmp mtawrd		;unlabelled, force word
  ;some real format 
	move a,(p)
	camn a,[asciz /U/]
	jrst mtawrd		;format U, force word

;here is the code for output files other than U - done separately from
;input since we don't want to do the MTOPR again
mtalog:	move b,h		;openfi needs b
	pushj p,openfi		;open with logical byte size
	jrst mtaans		;now go handle ans type

;Part II - Check parameters for input file
mtard:	pushj p,openfi
	hrrz a,filjfn(h)	;now we can look at the label
	movei b,.morli
	movei c,-4(p)
	mtopr
	erjmp mtachr		;unlabelled, use CHROPN
	move a,-3(p)		;get label type
	cain a,.ltunl
	jrst mtachr		;unlabelled, use CHROPN
	move a,0(p)		;format
	cain a,"U"
	jrst mtachr		;format U, use CHROPN
	;jrst mtaans

;Part III:
;Here are the exit routines.  they set up the dispatch vector, and then
; go to the openning routine after the OPENF

;now we know we have format F, D, or S - handle it in some record mode
mtaans:	adjstk p,-5		;[41] restore state
	move b,h
	skipge filcnt(b)
	jrst mtabx		;binary - BXOPN
	;jrst .+1

;text - use CHROPX
	movei a,fm%rec
	pushj p,setdsp		;set up dispatch block
	jrst chrox1		;and go to CHROPX

;binary - use BXOPN
mtabx:	movei a,fm%rec
	pushj p,setdsp
	jrst bxini

;format U input - use CHROPN
mtachr:	adjstk p,-5		;[41]
	move b,h		;restore FCB
	movei a,fm%chr
	pushj p,setdsp		;set up dispatch block
	jrst chrop1

;format U output - use WRDPON
mtawrd:	adjstk p,-5		;[41]
	move b,h		;restore FCB
  ;we haven't done OPENF yet, so we can just JRST to normal routine
	movei a,fm%wrd
	pushj p,setdsp		;set up dispatch block
	jrst wrdopn

	subttl i/o error routines

illfn:	move d,b		;here for illegal function
	movei a,mtox1		;"illegal function" (from mtopr)
	movem a,filerr(d)
	jrst erp.		;these errors are fatal
unimp==illfn			;here for unimplemented function

ife tenex,<
;chkquo - special thing designed to be used with ERCAL after a
;jsys that may write to disk.  If quota is exceed, gives a
;message that looks just like the EXEC's, and retries the jsys
;if continued.
quochk:	push p,a
	push p,b
	movei a,400000
	geter
	tlz b,777777		;b _ error code
	caie b,iox11		;is it quota problem?
	cain b,pmapx6
	jrst isquot		;yes
;not a quota problem, do the next instruction, including erjmp/cal
;simulation.
	move a,-2(p)		;ret addr
	hlrz b,(a)		;next inst
	cain b,(erjmp)		;is erjmp?
	jrst dojmp
	cain b,(ercal)		;is ercal?
	jrst docal
retba:	pop p,b			;no, normal return
	pop p,a
	popj p,
;here are the erjmp/cal simulations
dojmp:	hrrz b,(a)		;address to go to
	hrrm b,-2(p)		;make us return there
	jrst retba
docal:	hrrz a,(a)		;address to call
	pop p,b
	exch a,(p)
	adjstk p,-1		;we now have goto addr 1(p)
	aos (p)			;return after the next ercal
	jrst @1(p)		;this is pjrst
;here if it is a quota problem
; print a message, and then prepare to retry the instruction
isquot:	hrroi a,[asciz / Quota exceeded or disk full at /]
	esout
	push p,c
	hrrz b,-3(p)		;return addr
	subi b,2		;the actual jsys addr
	hrrm b,-3(p)		;reset to return there
	movei c,10		;base 8
	movei a,.priou
	nout
	 jfcl			;not sure how to handle errors here
	hrroi a,[asciz /
[Find some space, then type CONTINUE]
/]
	psout
; Finally we are ready to restore to the user's context and continue,
; is user types CONTINUE
	pop p,c			;restore ac's in case user does EXAMINE
	pop p,b
	pop p,a
	haltf			;let him delete some files
	popj p,


> ;ife tenex	

ioerpx:	move a,filerr(b)	;entry for those who already know the error
	jrst ioerp2
eioer:	skipa b,e	;entry if fcb is in e
ioer:	move b,d	;special entry if fcb is in d
;ioerp is the main error printer.  it preserves b up
ioerp:	push p,b
	movei a,400000		;use current process
	geter
	hrrz a,b		;error is in rh
	pop p,b
	movem a,filerr(b)	;and save new error
ioerp2:	move t,filbad(b)	;now set eof and eoln
	movem t,fileof(b)
	movem t,fileol(b)
	skipl filcnt(b)		;if ascii
	setzm filcmp(b)		;clear the component (read/ln needs this)
	move t,filflg(b)
	caie a,iox4		;end of file always enabled
	trne t,fl%ioe		;user error handling?
	popj p,			;yes - let user handle it
	move d,b
erp.::	pushj p,erp		;now put out message
	jrst endl		;and stop (fatal)

spec==1

erp..::
erp:	hrroi a,[asciz / /]
	esout
	movei a,.priou		;now the error message
	move b,filerr(d)
	hrli b,400000		;current process
	setz c,
	erstr
	 jfcl
	 jfcl
	hrroi a,[asciz / - /]	;now the file name
	psout
	skipn filjfn(d)		;[15]
	popj p,			;if no JFN, nothing to print
	movei a,.priou
	hrrz b,filjfn(d)
	setz c,
	jfns
erpdon:	hrroi a,[asciz /
/]
	psout
	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
	setz c,			;yes - kill it
	pushj p,doclos
	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
	setz c,			;yes - kill it
	pushj p,doclos
	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,

quit:
end:	movei g,blktab		;loop through all files
endcl:	skipn b,(g)		;get the fcb addr there
	jrst endcn		;nothing there, try next
	setz c,			;kill it
	pushj p,doclos		;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
endl::	haltf			;that's all, folks
	hrroi a,[asciz /Can't continue
/]
	esout
	jrst endl

erstat:	move t,filerr(b)	;let user see his error
	movem t,1(p)
	popj p,

analys:	skipn filerr(b)		;let him see error string
	popj p,
	move d,b
	pushj p,erp
	popj p,

;[43] - save the FCB in D, and change FILxxx(B) to FILxxx(D)
clreof:	move d,b		;[43] save FCB
	skipn a,filjfn(d)	;if no file involved,
	jrst clrOK		; then this is just bookkeeping
	hrrz a,a		;otherwise clear monitor's error bits
	gtsts
	erjmp ioerp		;if bad jfn, failed
	jumpge b,clrOK		;if file not open, nothing to do
	tlzn b,(gs%eof!gs%err)	;now reset with error bits off
	jrst clrOK		;no errors, nothing to do
	ststs
	erjrst ioer		;[7][43]
clrOK:	move t,filbad(d)	;set to normal eof
	trc t,1			;reverse of bad status
	movem t,fileof(d)
	setzm filerr(d)
	move b,d		;[43]
;[36] removed setting EOLN
	popj p,

notop:	move d,b		;where erp. wants it
	movei a,desx5		;not open
	movem a,filerr(d)
	jrst erp.
	subttl main file name getter for PROGRAM statement

;AC usage for getfn.:
;	b - fcb
;	c - pointer to name in ascii, length=10 always
;		lh - flags for gtjfn
;	h - used to save b
;	garbarges all ac's except b

ife tenex,<

;note - this routine is not reeentrant.  Since it is used in the
;  startup code, presumably it doesn't have to be.

getfn.:	pushj p,initb.		;always safe to init block at startup
	move h,b
	move d,(c)		;make up prompt and default
	movem d,fnprom
	movem d,deffil
	movem d,hlpfn1
	movem d,hlpfn2
	move d,1(c)
	movem d,fnprom+1
	movem d,deffil+1
	movem d,hlpfn1+1
	movem d,hlpfn2+1
	caie h,input##		;if input or output, use TTY:
	cain h,output##
	jrst .+2
	jrst getfno
	move a,[asciz /TTY:/]
	movem a,deffil
	move a,[ascii /TTY: /]
	movem a,hlpfn2
	move a,[ascii /     /]
	movem a,hlpfn2+1
   ;C already has the "substantive" bits - make sure odd ones are off
getfno:	tlz c,(gj%fns!gj%sht)	;long form
	hllm c,getfna+.gjgen	;use flag bits
	setzm getfna+.gjdev	;clear rest of arg block
	move a,[xwd getfna+.gjdev,getfna+.gjdev+1]
	blt a,getfna+16
	setzm cmjfn
	movei a,bufsiz*5	;init cmd block
	movem a,cmdblk+.cmcnt	;space left
	setzm cmdblk+.cminc	;char's not yet parsed
	move a,cmdblk+.cmbfp
	movem a,cmdblk+.cmptr	;next input
;entry for error
  ;main loop
getfn1:	skipe a,cmjfn		;if any jfn gotten
	rljfn			;release it
	 erjmp .+1
	setzm cmjfn		;now no jfn
  ;prompt
	movei a,cmdblk
	movei b,iniblk		;prompt
	comnd
	 erjmp getfer
	tlne a,(cm%nop)		;error?
	 jrst getfer		;yes - message and try again
;entry for reparse
  ;get file name
getfn2:	skipe a,cmjfn		;if any jfn gotten
	rljfn			;release it
	 erjmp .+1
	setzm cmjfn		;now no jfn
	movei a,cmdblk
	movei b,filblk		;file name
	comnd
	 erjmp getfer
	tlne a,(cm%nop)		;error?
	 jrst getfer		;yes - message and try again
	hrrzm b,cmjfn		;remember JFN in case have to close it
	movem b,filjfn(h)	;and put in FCB

  ;confirm
	movei a,cmdblk
	movei b,cfmblk		;confirm
	comnd
	 erjmp getfer
	tlne a,(cm%nop)		;error?
	 jrst getfer		;yes - message and try again
  ;exit
	move b,h
	popj p,
	
iniblk:	<.cmini>B8
	z
	z
	z

filblk:	<.cmfil>B8+cm%dpp+cm%hpp+cm%sdh
	z
	xwd -1,hlpfil
	xwd -1,deffil

cfmblk:	<.cmcfm>B8
	z
	z
	z

	reloc

hlpfil:	ascii /One of the following:
	File spec. for the Pascal file /
hlpfn1: block 2
	ascii /
	Carriage return to use default, /
hlpfn2:	block 2
	asciz /
/

deffil:	block 3			;default name

fnprom:	block 2			;file name
	asciz / : /

cmdblk:	getfn2			;reparse to loop
	xwd .priin,.priou	;jfn's
	xwd -1,fnprom		;^R
	xwd -1,cmdbuf		;start of buffer
	z			;next to parse
	z			;left
	z			;char's not parsed
	xwd -1,atbuf		;atom buf
	exp 5*bufsiz		;size of atom buf
	exp getfna		;addr of gtjfn arg

bufsiz==^D30
cmdbuf:	block bufsiz
atbuf:	block bufsiz

cmjfn:	block 1			;jfn needs releasing

getfna:	z			;gen
	xwd .priin,.priou	;jfn's
	block 15		;other junk for COMND

	reloc

getfer:	movei a,[asciz / /]
	esout		;give ?, etc.
	movei a,.priou	;now error message
	hrloi b,400000
	setz c,
	erstr
	 jfcl
	 jfcl
	hrroi a,[asciz /
/]
	psout
	jrst getfn1

> ;ife tenex

ifn tenex,<

getfn.:	pushj p,initb.		;always init block at startup
	move h,b
	setzm filflg(b)		;clear temp bit
	move d,(c)		;d,e,f _ asciz prompt message
	move e,1(c)
	move f,[asciz / : /]
	hllz g,c		;g _ gtjfn flags
getfn1:	hrroi a,d		;prompt
	psout
	move a,g
	move b,[xwd .priin,.priou]
	gtjfn
	 jrst getfer
getfnx:	movem a,filjfn(h)
	move b,h
	popj p,


getfer:	cain a,gjfx34	;? typed
	jrst getfhl	;print help
	cain a,gjfx33	;no name? - treat as default
	jrst getfdf
getfe1:	movei a,[asciz / /]
	esout		;give ?, etc.
	movei a,.priou	;now error message
	hrloi b,400000
	setz c,
	erstr
	 jfcl
	 jfcl
	hrroi a,[asciz /
/]
	psout
	jrst getfn1

getfhl:	hrroi a,[asciz /
    One of the following:
	File spec for the PASCAL file /]
	psout
	movei a,.priou		;print the file name
	hrroi b,d
	movni c,12
	sout
	hrroi a,[asciz /
	Carriage return to use default, /]
	psout
  ;Now give him the right default
	caie h,input##
	cain h,output##
	jrst getfh1
	movei a,.priou
	hrroi b,d
	movni c,12
	sout
	jrst getfh2
getfh1:	hrroi a,[asciz /your terminal/]
	psout
getfh2:	hrroi a,[asciz /
/]
	psout
	jrst getfn1

;here for default (TTY: for INPUT and OUTPUT, else filename)
getfdf:	move a,g		;flags user specified
	tlo a,(gj%sht)		;but short form
	tlz a,(gj%xtn!gj%fns)	;file spec as string
	hrroi b,d
	caie h,input##
	cain h,output##
	hrroi b,[asciz /TTY:/]
	gtjfn
	 jrst getfe1
	jrst getfnx		;done, return jfn and exit

> ;ifn tenex

;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,

;init.b is a special entry for the compiler's use
init.b:	push p,a
	jrst initbc

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

;prototype block
protob: exp 0		;FILPTR== 0	;pointer to filcmp
	exp 0		;FILEOF== 1	;input: 0 == normal state
					;	1 == eof or error
					;output:1 == normal state
					;	0 == error
	exp 0		;FILEOL== 2
	exp 0		;FILERR== 3	;RH - last error no, LH - enabled
	exp 0		;filjfn==4	;jfn
	exp 0		;filspc==5	;pointer to block with file spec in it
	exp 0		;filflg==6	;flags
	exp 1		;filbad==7	;contents to set fileof to if error
	exp norchx	;filcht==10	;pointer to character mapping table
	exp 0		;fils11==11
	exp 0		;fils12==12
	exp 0		;fils13==13
	exp 0		;fillts==14
	exp 0		;filbuf==15	;buffer for paged files:
				;LH == # of pages, RH == addr of first word
			;filr11 through filr99 must be contiguous
			;filr11==16	;first routine
	exp notop		;filget==16	;routine for GET
	exp notop		;filput==17	;routine for PUT
	exp notop		;filgln==20	;routine for GETLN
	exp notop		;filpln==21	;routine for PUTLN
	exp 0			;filclo==22	;device-dependent close
	exp unop+filr99+1  	;filr99==23	;pointer to other routines
	exp 0		;fils15==24	;another state variable
	exp 0		;fils16==25
	exp 0		;fils17==26
	exp 0		;fils20==27
	exp 0		;fils21==30
	exp 0		;FILLNR==31	;IF ASCII MODE - LINENR
	exp 0		;FILCNT==32	;LH== neg size of component
					;    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		;filst1==33	;state variables for special I/O modes
	exp 0		;filst2==34
	exp 0		;filst3==35
	exp 0		;filst4==36
	exp 0		;filst5==37
	exp 314157	;filtst==40	;should be 314157 if file is open
	exp 0		;filind==41	;location in index
	exp 0		;42 - spare
	exp 0		;FILCMP==43	;FIRST WORD OF COMPONENT

;ttypr. - do initial get for INPUT
ttypr.:	hrrz a,input##+filjfn
	dvchr			;see if a tty
	ldb c,[point 9,b,17]	;dev type field
	caie c,.dvtty		;if not tty, forget it
	jrst ttyprg
	hrrz a,input+filjfn
	hrroi b,[asciz /[INPUT, end with ^Z: ]
/]
	setz c,
	sout
ttyprg:	movei b,input##
	jrst getch

	subttl buffered I/O - text routines

	filpbp==fils12		;physical buffer byte pointer
	filpbs==fils13		;physical buffer size
	filter==fils15		;place to store defered error

;These routines do ildb/idpb from a one page buffer, which is filled/
; emptied by sin/sout.  It is a bit confusing because the I/O is
; often done in 36 bit mode, for efficiency.  thus physical buffer
; size is the number of 36 bit bytes in the buffer when you are in
; this "word mode", and the number of logical bytes when in normal
; "character mode".  Also, physical buffer byte pointer points to
; the beginning of the buffer, having a byte size of 36 in word mode,
; and the logical byte size in charcter mode.  These routines are
; inefficient for mag tape when the record size is much less than
; a page, as proper overlapping of I/O and computation requires our
; buffer to be near the record size or smaller.

putchb:	sosge filbct(b)		;write a character
	pushj p,wrtbuf		;put out the buffer
	move a,filcmp(b)
	idpb a,filbpt(b)
	popj p,

getchb:	sosge filbct(b)		;read a character
	pushj p,reabuf		;fill the buffer
getcb1:	ildb a,filbpt(b)        ;;entry for wrdlts
	move t,fillts(b)	;line number test bit
	tdne t,@filbpt(b)
	jrst getbln		;saw a line number
	andi a,177
	jumpe a,getchb		;ignore nulls
	move a,@filcht(b)
	hlrem a,fileol(b)
	hrrzm a,filcmp(b)
	came a,[xwd -1," "]	;CR is standard Pascal mode
	popj p,
	jrst geteol		;get "real" EOLN

getbln:	move t,@filbpt(b)
	movem t,fillnr(b)
	aos filbpt(b)
	movni t,5
	addb t,filbct(b)
	jumpge t,getchb
	pushj p,reabuf
	ibp filbpt(b)
	jrst getchb

	subttl buffered I/O - buffer advance routines

wrtbuf:	push p,c		;write the buffer
	push p,b
	hrrz a,filjfn(b)
	movn c,filpbs(b)
	move b,filpbp(b)
	skipe c			;[40] zero is special
	sout
	 chkquo
	 erjmp ioebcp
	pop p,b
	move a,filbfs(b)	;reinitialize state
	subi a,1		;sos already done
	movem a,filbct(b)
	move a,filbfp(b)
	movem a,filbpt(b)
	pop p,c
	popj p,

ioebcp:	pop p,b
ioecp:	pop p,c
	adjstk p,-1		;abort caller
	jrst ioerp

reabuf:	skipe filter(b)		;fill the buffer - delayed error?
	jrst simerx		;yes - pretend it happened now
	push p,c
	push p,b
	hrrz a,filjfn(b)
	movn c,filpbs(b)
	move b,filpbp(b)
	sin
	 erjmp saverr		;store error for later
	pop p,b
	move a,filbfs(b)
	subi a,1
	movem a,filbct(b)
	move a,filbfp(b)
	movem a,filbpt(b)
	pop p,c
	popj p,

;We have to delay errors and activate them after the user has seen any
; characters that have been returned.  Otherwise EOF would come too
; soon.  Note that the code assumes (implicitly) that reabuf returns
; something.  So if no bytes have been gotten at all, we have to do
; the error now - can't delay it.
saverr:	pop p,b			
	move t,filbfs(b)	;t _ logical bytes per transfer byte
	idiv t,filpbs(b)
	imul c,t		;c _ - logical bytes not transferred
	add c,filbfs(b)		;c _ bytes transferrred
	jumpe c,ioecp		;[27] none - immediate error
	subi c,1		;caller has done sos
	movem c,filbct(b)
	move a,filbfp(b)
	movem a,filbpt(b)	;otherwise normal init.
	movei a,400000		;save error code for simerr
	move c,b		;save b ever jsys
	geter
	exch b,c		;c _ error code, fcb back in b
	hrrzm c,filter(b)
	pop p,c
	popj p,

simerx:	adjstk p,-1		;abort caller
simerr:	move t,filter(b)	;activate delayed error
	movem t,filerr(b)	;put in real error place
	setzm filter(b)		;not delayed anymore
	jrst ioerpx		;and pretend we just saw it

	subttl buffered I/O - open and close

logopn:	trne g,of%rd		;common openning
	trnn g,of%wr		;if read and write, can't do it
	jrst .+2		;only one, OK
	jrst illfn
	movei t,illfn		;make wrong direction illegal (or he
	skprea			;writing? (might not get the error
	movem t,filget(b)	;read illegal    (until fnished the
	skpwrt			;reading?   (buffer)
	movem t,filput(b)
	ldb a,[fl%buf!filflg(b)] ;number of buffers user wants
	caig a,0		;must be between 1 and 36
	movei a,1		;if 0, use default
	caile a,^D36		;if too big, use maximum
	movei a,^D36
	move t,a		;now have pages per buffer - get words
	lsh t,^D9		;t _ words in buffer
	movem t,filpbs(b)	;filpbs _ words in buffer
	  ;caller may reset this to bytes in buffer if that is what he wants
	pushj p,alcbuf		;# pages is arg to alcbuf, in A
	ldb t,[point 6,g,5]	;logical byte size
	lsh t,^D24		;make byte pointer
	tlo t,440000		;to beginning of word
	hrr t,filbuf(b)		;at buffer
	movem t,filbfp(b)	;store as logical bufer start
	setzm filbpt(b)		;assume nothing in buffer
	skprea			;if writing, give a full buffer
	movem t,filbpt(b)
	movei t,^D36
	ldb a,[point 6,g,5]	;computer buffer size in bytes
	idiv t,a		;t _ bytes per word
	imul t,filpbs(b)	;t _ bytes in buffer
	movem t,filbfs(b)	;store as logical size
	setzm filbct(b)
	skprea		;if writing, give a full buffer
	movem t,filbct(b)
	setzm filter(b)
	setzm fillct(b)
	popj p,

chropn:	skipe filerr(b)		;byte mode I/O open
	popj p,			;no-op if error
	pushj p,openfi
chrop1:	pushj p,logopn		;compute logical parameters
	move t,filbfp(b)	;physical param's = logical ones
	movem t,filpbp(b)
	move t,filbfs(b)
	movem t,filpbs(b)
	popj p,

wrdopn:	skipe filerr(b)		;word mode I/O open
	popj p,
	pushj p,logopn
	move t,filbuf(b)	;physical param's use 36 bit bytes
	hrli t,444400
	movem t,filpbp(b)
	tlz g,770000
	tlo g,440000		;set 36 bit bytes
		;filpbs is left as set by logopn - words in buffer
	jrst openfi

ifn srisw,<  ;[23]
;This is part of the SRI kludge.  See DSKLTS for an explanation of the
;  reason for the kludge.

;device-dependent code to examine the first word to see if line-numbered.
;  This code is mainly for the use of magtape.  Since it is fairly common
;  there to open the file, set parameters, and then do the first read, we
;  have to wait and do the actual test at the first read.  Thus this routine
;  temporarily changes FILGET to call a routine that tests the first
;  word, restores FILGET to the right thing, and then calls it.  For the
;  disk we have to do the actual test at open time, because somebody might
;  do SETPOS before the first real.  But for disk it is safe because one
;  can do the test without any sideeffects.  We tried BIN then BKJFN, but
;  due to a monitor bug that doesn't work for tape.
wrdlts:	movei t,wrdgtt		;[22] special get that does a test first
	movem t,filget(b)	;[22] booby-trap FILGET
	popj p,

;[22] Special routine called for the first GETCH on the file, to see if line
;[22]    numbered. The order in which things are done in this routine is a bit
;[22]    more critical than it looks, in order to make error handling work.
wrdgtt:	movei t,getchb		;[22] restore normal reader
	movem t,filget(b)	;[22]
	pushj p,reabuf		;[22] get first buffer in
	move a,filbpt(b)	;[22] pointer to first byte
	ibp a			;[22] but expected to do ILDB
	move t,(a)		;[22] now have first word of buffer
	push p,c		;[22] comlts uses t,a,c,d
	push p,d		;[22]
	pushj p,comlts		;[22]
	pop p,d			;[22]
	pop p,c			;[22]
	jrst getcb1		;[22] now continue with normal code

>  ;[23] ifn srisw

logclo:	skpwrt			;force buffers
	popj p,			;reading - none
	move t,filbpt(b)	;zero rest of last word
;magic code to clear rest of word.  The offset field in the byte
; ponter now continas no. of bits from the right to be clered,
; so we use a new byte ptr with no offset and this as the size.
	tlz t,007700
	hllz a,t
	lsh a,-6
	hll t,a
	setz a,			;cler them
	dpb a,t
	move t,filbfs(b)	;compute no. of bytes to put out
	idiv t,filpbs(b)	;t _ bytes / transfer byte
	move a,t		;a _ bytes / transfer byte
	move t,filbfs(b)	;t _ bytes used
	sub t,filbct(b)		;t _ bytes remaining
	jumpe t,cpopj		;if none - done
	idiv t,a		;t _ transfer bytes remaining
	skipe a			;round up
	addi t,1
	push p,c
	push p,b
	movn c,t		;make sin arg block
	hrrz a,filjfn(b)
	move b,filpbp(b)
	skipe c			;[40] zero is special
	sout
	 chkquo
	 erjmp ioebcp		;abort caller
	pop p,b
	pop p,c
	move t,filbfp(b)	;set up to make more possible
	movem t,filbpt(b)
	move t,filbfs(b)
	movem t,filbct(b)
	popj p,

setpb:	pushj p,logclo		;setpos (curpos is curpbx)
	pushj p,logini
	jrst setpbx

logini:	skprea			;breakin
	popj p,			;no-op on write
	setzm filbct(b)
	setzm fillct(b)
	skipe filter(b)		;if saved error
	pushj p,simerr		;activate it
	popj p,
	
	subttl buffered I/O - routines for record I/O

;The following routines set up C to indicate the desired
; transfer, and then call getblp or putblp, which simulate
; sin and sout.  If an I/O error occurs, getblp or putblp
; will return with c as at the point of error.  Thus the
; caller may have some adjustments to do.

;get
getb:	movem c,fillct(b)	;assume no. transferred = no. requested
	movn c,c		;make up aobjn word
	hrl c,c			;lh(c) _ no. to transfer
	hrri c,filcmp(b)	;rh(c) _ starting loc to transfer
	pushj p,getblp		;sin
	hlre c,c		;c _ - no. left untransferred
	addm c,fillct(b)	;adjust assumption
	popj p,

;put
putb:	movem c,fillct(b)
	movn c,c
	hrl c,c
	hrri c,filcmp(b)
	pushj p,putblp		;sout
	hlre c,c
	addm c,fillct(b)
	popj p,

;getx
getxb:	move d,c		;requested upper limit
	sub c,fillct(b)		;c _ no. needed this time
	movn c,c		;make aobjn word
	hrl c,c
	hrri c,filcmp(b)
	add c,fillct(b)		;adjust by no. already done
	pushj p,getblp		;sin
	hlre c,c
	addm c,fillct(b)
	popj p,

;Here are the sin/sout simulations.  Note that if there is
; en I/O error, ioebcp will abort the routine.
; In that case c will be left negative, and the caller (above)
; will do the right thing.

;sin
getblp:	sosge filbct(b)		;sin simulation
	pushj p,reabuf
	ildb a,filbpt(b)
	movem a,(c)
	aobjn c,getblp
	popj p,

;sout
putblp:	sosge filbct(b)		;sout simulation
	pushj p,wrtbuf
	move a,(c)
	idpb a,filbpt(b)
	aobjn c,putblp
	popj p,

	subttl initialization

pasin.:	jsp a,pasif.		;[6] for old programs, new ones use pasif.
	popj p,			;[6]

pasif.:	move g,a		;[6] save return address
	move f,b		;save flag for checking
	hlrz e,.jbsa##		;get 1st above low seg
	subi e,1		;adjust to page boundary
	tro e,777		;we assume .jbff is always even page
	addi e,1
	hrlm e,.jbsa		;and put back adjusted value
clrlop:	caml e,.jbff##		;now clear everything up to .jbff
	jrst clrdon
	seto a,			;unmap the page
	move b,e
	lsh b,-9		;make page no.
	hrli b,400000		;this process
	setz c,
	pmap
	addi e,1000		;now go to next page
	jrst clrlop
clrdon:	hlrz e,.jbsa		;get back adjusted top of code
	movem e,.jbff		;use for .jbff

	reset

	setzm izer1		;zero interrupt data area
	move t,[xwd izer1,izer1+1]
	blt t,izer99
	setzm chntb.		;reinitialize interrupt control blocks
	move t,[xwd chntb.,chntb.+1]
	blt t,chntb.+^D35
	move t,[xwd 1,ovrflw]
	movem t,chntb.+6
	movem t,chntb.+7
	move t,[xwd 1,pdltrp]
	movem t,chntb.+^D9
	movei a,400000		;turn on interrupts
	move b,[xwd levtab,chntb.]
	sir			;set up vector
	movsi b,(1b9)		;[4] pdl overflow
	skipe f			;[4] ignore arith. if not checking
	tlo b,(1b6!1b7)		;[4] arith. overflow
	aic			;turn on conditions
	eir			;turn on system

;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

;here we are going to set the frepag bit table to all 1's to indicate all
;  pages are free.  GETPG. checks for overlap with heap, which is below
;  the code, so we won't run into the high seg.  After setting to all 1's,
;  we then remove pages below .jbff, i.e. the low seg.
pasin2: setom frepag		;indicate all 512 pages free
	move t,[xwd frepag,frepag+1]
	blt t,frepag+15		;clear 14 words
	movsi t,776000		;and 10 bits
	movem t,frepag+16
	move b,.jbff##		;now clear everything below .JBFF
	lsh b,-11		;get page number. b is # of pages to be clear
	idivi b,44		;b _ words to be cleared, c _ bits
	sojl b,pasin3		;no words, just do bits
	setzm frepag		;b _ words-1 to be cleared
	jumpe b,pasin3		;one word only, do bits
	move t,[xwd frepag,frepag+1]
	blt t,frepag(b)		;clear words
;all full words cleared, b _ # words cleared - 1
pasin3:	jumpe c,pasin4		;if no bits to clear, ignore
	movsi t,400000		;make mask for c bits
	movn c,c
	ash t,1(c)		;t _ xxx000, c bits on
	andcam t,frepag+1(b)	;clear these bits in next word
pasin4:	setzm tty##+1
	setzm tty##+filbct
	move t,[xwd tty##+1,tty##+2]
	blt t,tty##+filr11-1
	setzm ttyout##+1
	move t,[xwd ttyout##+1,ttyout##+2]
	blt t,ttyout##+filr11-1
	move t,[xwd ttynt,tty##+filr11] ;copy special tty routines into tty
	blt t,tty##+filr99
	move t,[xwd ttynt,ttyout##+filr11] ;and ttyout
	blt t,ttyout##+filr99
	aos tty##+fileol
	aos tty##+filbad
	aos ttyout##+fileof
	move t,[ascii /-----/]
	movem t,tty##+fillnr
	movem t,ttyout##+fillnr
	movei t,ttybuf
	movem t,tty##+filttb
	movei t,314157		;magic indicating a valid file
	movem t,tty##+filtst
	movem t,ttyout##+filtst
	SETZM	AVAIL##
	SETZM	AVAIL+1
	SETZM	BEGMEM##
	SETZM	ENDMEM##
	jrst (g)		;[6] return

	reloc

blklen==140			;there are only 100 jfn's possible
blklck: block blklen
blktab: block blklen
lstblk:	block 1

;still in low segment
	subttl error trapping
;still in low segment

	intern chntb.,oldpc.

levtab:	.+3
	.+3
	.+3
oldpc.:	block 3
chntb.:	block 6		;0 - 5
	xwd 1,ovrflw	;6
	xwd 1,ovrflw	;7
	block 1		;[4] 8
	xwd 1,pdltrp	;[4] 9
	block ^D32	;[4] 10-35

	reloc

ovrflw:	;This routine is taken from forots, more or less

	fxu==1b11	;floating underflow
	fov==1b3	;some floating pt. error
	ndv==1b12	;some division by zero

	adjstk p,3	;[3] just for safety, as sometimes use above stack
	push p,t	;[3] save ac's so we can restore
	push p,a	;[3]
	move t,oldpc.
	hrrz a,t	;the error pc
	cail a,safbeg##	;in runtime
	caile a,safend##
	jrst .+2
	jrst ignore
	camge n,.jbff##	;in debugger
	jrst ignore
	hlrz a,t	;get flags in RH
	andi a,(ndv!fov!fxu) ;clear all but these
	lsh a,-5	;right-justify ndv
	trze a,(1b8)	;fov set?
	iori a,1b33	;move it to right end
	hrro a,aprtab(a) ;get right error message
	esout
	pushj p,runer.	;put out pc and maybe go to ddt
;	jrst ignore	;if he continues, ignore the error

ignore:	pop p,a		;[3] restore state and exit
	pop p,t		;[3]
	adjstk p,-3	;[3]
	debrk

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

pdltrp:	move p,[xwd 20,20]	;[4] fake pdl - real one is garbage
	hrroi a,[asciz /No space left for stack or local variables/] ;[4]
	esout			;[4]
	move t,oldpc.		;[4]
	pushj p,runer. 		;[4] pasddt has its own stack
	hrroi a,[asciz /Can't continue without stack
/]
	psout
	jrst endl
	
	subttl critical sections

	intern lockc.,level.,leav.
	entry enterc,leavec

	reloc

izer1:
level.:	block 1		;current interrupt level
lockc.:	block 1		;0 or pointer to int. deferral block if in crit. section
dfins0:	block 1		;interrupt deferral blocks:
dfins1:	block 1
dfins2:	block 1
dfins3:	block 1
izer99==.-1

	reloc

dftab:	dfins0
	dfins1
	dfins2
	dfins3

enterc:	move a,level.	;set up int. deferral block
	move a,dftab(a)
	movem a,lockc.	;now in critical section
	popj p,

leavec:	movei a,0
	exch a,lockc.	;out of critical section
	skipe a		;user is doing leave without enter
	skipn (a)	;any deferred interrupt?
	popj p,		;no - normal exit
	push p,b
	move b,(a)	;deferred interrupts
	setzm (a)	;zero for next use
	movei a,400000	;this job
	iic
leav.:	pop p,b
	popj p,
	subttl page allocation/deallcation

	entry getpag,relpag	;[20]

;getpg.
;	a - count of number of pages desired
;garbages a,t - result in a

getpg.:	push p,lockc.		;remember if user was in crit. sec.
	push p,a
	skipn lockc.		;if so, don't make new one
	pushj p,enterc		;critical section
	pop p,a
	push p,b
	push p,c
	push p,d
	push p,e
	push p,f
;here we set up pagmsk to be xxxx0000, with x being (a) bits
	caile a,44		;be sure count is legal
	jrst getptm		;too many
	movsi b,400000		;b _ 400000,,0
	movn c,a
	ash b,1(c)		;b _ xxx0000, as ash propogates the bit
pagmsk==0   ;location of mask on stack
	push p,b
	hrlzi b,-17		;b - aobjn pointer to word we are looking at
	move d,a		;d - number of pages desired

;outer loop in which we check all words			     i
getpl1:	move t,frepag(b)	;first find a word in which there are free
	movei c,0		;c - accumulate previous shifts

;inner loop in which we check various starting places in word
;Note that t gets shifted if we have to retry this
getpl2:	jffo t,gotbit		;if free page in this word, exit search

	aobjn b,getpl1		;no more bits in this word, get next
	jrst nofree		;ran out of words, we failed

;here is the text of the inner loop
;we have found one free page, see if we have N contiguous ones
gotbit:	add c,a			;c _ total shift to this bit
	setcm e,frepag(b)	;e,f _ complement of words being tested
	setcm f,frepag+1(b)
	lshc e,(c)		;      shifted to left justify tested bits
	tdnn e,pagmsk(p)	;since complemented, if all are zero
	jrst gotpgs		;then we have our pages
;not enough bits after the one we found.  We now shift the word (in t)
;to the beginning of the field we were considering plus one more bit.
;this eliminates the bit our last jffo found, and causes the next one
;to advance to the next bit.  However it requires us to keep track of
;the total amount of shifting, which is done in c.
	lsh t,1(a)		;get to start of field, and gobble one bit
	addi c,1		;indicated shifted by one more
	jrst getpl2		;and see if another candidate in this word

;here when we have found the free pages 
;clear the bits in frepag array and figure out page number
gotpgs:	move e,pagmsk(p)	;get mask for clearing
	setz f,
	movn a,c		;a _ neg no. of bits shifted
	lshc e,(a)		;e,f _ mask of bits found
	andcam e,frepag(b)	;clear bits in memory
	andcam f,frepag+1(b)
	tlz b,-1		;now compute b _ page number
	imuli b,44		;words times pages in a word
	add b,c			;and offset within word
	lsh b,11		;d _ addr of first page in group
	move c,d		;c _ number of pages in group
	lsh c,11		;c _ number of words in group
	add c,b			;c _ first address beyond
	caml c,lstnew		;be sure we don't overlap heap
	jrst nofree		;if we do, fatal error
	camle c,.jbff##		;if we have taken more core
	movem c,.jbff##		;  update .jbff
	move a,b		;a _ address of first page in group
	hrl a,d			;number of pages in LH
	pop p,(p)		;pagmsk
	pop p,f			;saved ac's
	pop p,e	
	pop p,d
	pop p,c
	pop p,b			;previous lock still on stack
	push p,a		;stack is top --> ret val , lock
getpgx:	skipn -1(p)		;if user was in cri. sec., don't leave
	pushj p,leavec		;end critical section
	pop p,a
	pop p,(p)
	popj p,

getptm:	hrroi a,[asciz /Internal error: buffer request exceeds 36 pages/]
	esout
	jrst endl

nofree:	hrroi a,[asciz /Request for buffer space runs into heap /]
	esout
	jrst endl

;relpg.
;  a - count,,addr
;garbages a,t - arg in a
relpg.:	push p,lockc.		;remember whether user was in crit. sec.
	push p,a
	push p,b
	push p,c
	skipn lockc.		;if so, don't make new one
	pushj p,enterc		;critical section
	movsi t,400000		;t,a _ 400000...
	setz a,
	hlrz b,-2(p)		;number of pages
	caile b,44		;be sure its legal
	jrst getptm
	movn b,b		;b _ - number of pages
	ash t,1(b)		;t,a _ xxx000 with one x for each page
	hrrz b,-2(p)		;addr to return
	lsh b,-11		;make into page number
	idivi b,44		;b _ word offset, c _ bit within word
	movn c,c		;c _ - number of bits
	lshc t,(c)		;t,a _ mask of bits to set in word
	iorm t,frepag(b)	;clear at offset b and b+1
	iorm a,frepag+1(b)
	pop p,c
	pop p,b
	pop p,a
	pop p,t
	skipn t			;if user was in cri. sec., don't leave
	jrst leavec		;end critical section
	popj p,

;[20] Replaced old routines that did only one page.

;Routines for normal user use

;procedure getpages(howmany:integer;var pagenum:integer; var:page:^realpage);
;b - number of pages to get
;c - place to put page no.:
;d - place to put addr.
getpag:	move a,b		;number of pages
	pushj p,getpg.		;actually get page - addr in a
	hrrzm a,(d)		;return addr
	tlz a,777777		;clear out LH (count)
	lsh a,-9		;return page no.
	movem a,(c)
	popj p,

;procedure relpages(howmany:integer;pagenum:integer);
;b - number of pages to return
;c - page to return
relpag:	caile b,0		;check args - count GT 0
	caig c,0		;page number GT 0
	jrst illpag
	move d,c
	add d,b			;page + count  LE 1000
	caile b,1000
	jrst illpag
	lsh c,9			;make addr
	move a,c		;where rlpag wants it
	hrl a,b			;number to return
	jrst relpg.

illpag:	hrroi a,[asciz /Relpages: page numbers must be 1 to 777B
/]
	esout
	jrst endl

if2,<	purge sin>	;so we don't interfere with Forlib's sin

	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 DANGER - routine for dummy label when pasnum not loaded

	entry safbeg,safend

safbeg:	block 0
safend:	block 0

	end