Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-ots-debugger/foropn.mac
There are 27 other files named foropn.mac in the archive. Click here to see a list.
	SEARCH	FORPRM
	TV	FOROPN	OPEN & CLOSE ,6(2033)

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
COMMENT \

***** Begin Revision History *****

1100	CKS	5-Jun-79
	New

1272	DAW	19-Feb-81
	A few low-risk changes to support extended addressing.

1273	EDS	19-Feb-81	Q10-04732
	Add /RECL to dialog keyword table.

1274	EDS	19-Feb-81	Q10-04574
	Add support code for TAPEMODE='ANSI-ASCII'.

1277	JLC	23-Feb-81
	Added code to calculate bytes/word (BPW) on -10,
	plus used it to calculate rounded record size (RSIZR)
	for use in %IREC.

1305	JLC	26-Feb-81
	Moved the RSIZR code to its correct resting place in FIXDEF.

1306	DAW	26-Feb-81
	New arg list format passed by %SAVE.

1307	EDS	26-Feb-81
	Put ACCESS back in list of valid switches for DIALOG.

1310	DAW	26-Feb-81
	Full words in DDB for ERR=, END=, IOST=, AVAR= addresses.

1312	EDS	27-Feb-81
	Remove edit 1307 as it causes generation number skew on TOPS-20
	with certain combinations of ACCESS in DIALOG different from
	the ACCESS that was specified in the OPEN.

1313	JLC	3-Mar-81
	Added code to handle magtape op's better

1316	JLC	5-Mar-81
	Changed refs to D%LIO to D%LOUT. Major code changes
	for magtape i/o and proper direction switching.

1325	JLC	9-Mar-81
	Yet more changes for magtape I/O for the -10

1326	JLC	10-Mar-81
	Minor bug fix in -10 open.

1333	JLC	11-Mar-81
	Magtape patches (mostly typos) for the -10

1336	JLC	12-Mar-81
	Fix more typos; change name of CLOSE to CLOSE0.

1353	JLC	18-Mar-81
	More magtape op fixes. Set I/O direction flags after
	calling routine. Install backing over EOF if program
	reads to EOF then writes. Fix empty buffer problem
	for OSWTCH.

1354	JLC	18-Mar-81
	OSWTCH fix. Must truncate file at previous block to
	get the monitor to not round word count up to blocksize.

1356	JLC	18-Mar-81
	Add dump mode write to oswtch.

1361	JLC	20-Mar-81
	Put -20 null file prevention code in IF20.

1363	JLC	24-Mar-81
	Commented out code for common tty ddbs.

1364	CKS	24-Mar-81
	Don't do RLJFN if the GTJFN failed

1365	JLC	25-Mar-81
	Move code to set device index for -10 up slightly in DOOPEN
	so magtapes will know about it after half-open (seqinout).
	Typo in dump mode output FILOP.

1370	EDS	26-Mar-81	Q10-04566
	Make IMAGE and BINARY mode I/O illegal on TTYs.

1375	EDS	31-Mar-81	Q10-05002
	Fix FILOP. for CLOSE DISPOSE='RENAME', remove monitor
	version dependent code.

1376	JLC	31-Mar-81
	Fix more code in -10 OSWTCH, did not do correct thing for
	null files or pointer at beginning of buffer.

1400	JLC	02-Apr-81
	Typo - PUSHJ should use P as reg and not 0.

1401	JLC	03-Apr-81
	Make sure block number never goes negative in OSWTCH.

1402	JLC	06-Apr-81
	Avoid doing dump-mode truncation for magtape - not necessary.
	Move turning on CRLF suppression from OSW to %IREC.

1407	JLC	07-Apr-81
	Move device-dependent I/O so it gets called before buffers
	are set up, so BLOCKSIZE will work.

1410	JLC	07-Apr-81
	Move setup of record buffer to FORIO in preparation for
	input/output separation of record buffer.

1411	DAW	08-Apr-81
	Use IJFN and OJFN instead of JFN field in DDB.

1412	JLC	09-Apr-81
	Uncomment the commented-out tying of TTYs to 1 DDB,
	as multiple channels to the same DDB doesn't work on
	the -10.

1416	JLC	10-Apr-81
	Removed RSIZR code, was unnecessary.

1417	DAW	10-Apr-81
	Type traceback info if OPEN arg error caused user to
	get to DIALOG mode.

1420	JLC	10-Apr-81
	Deallocation of separate record buffers.

1421	JLC	10-Apr-81
	Typo in edit 1407. DF was not set up
	when DSKSET was called.

1422	JLC	13-Apr-81
	External symbol %TRACE.

1423	DAW	13-Apr-81
	Put %SETD in FORIO (was in FOROPN).

1426	JLC	14-Apr-81
	Changed error reporting in OSWTCH-10 to fatal errors.
	Restore .JBFF in DOOPEN upon FILOP failure, caused
	problems with SORT.

1427	JLC	15-Apr-81
	Changed RSIZ to be a word (RSIZE) in the DDB.

1433	DAW	16-Apr-81
	Show possible switches user can type when he gets to DIALOG
	mode on the -20 and types a question mark.

1434	DAW	16-Apr-81
	Check for READONLY set and if so, change ACCESS=
	'RANDOM' to 'RANDIN', 'SEQINOUT' to 'SEQIN'.

1441	JLC	17-Apr-81
	Remove all refs to D%RSIZ, no longer needed.

1442	DAW	17-Apr-81
	Remove /LABELS and /TAPEMODE from OPEN and DIALOG options.

1451	JLC	23-Apr-81
	Special handling of dump mode I/O in OSWTCH. Removal of
	BAKEOF call in OSWTCH for magtape (reading to EOF, followed
	by write, will leave the tape mark).

1453	JLC	24-Apr-81
	Move -10 code to set up BPW, so that BLOCKSIZE setup will work.

1463	JLC	7-May-81
	Many major changes. See revhist in FOROTS.MAC.

1464	DAW	11-May-81
	Error messages.

1465	JLC	15-May-81
	Major changes to -20 I/O.

1473	CKS	21-May-81	Qvarious
	Add flags to IOERR macro, I%REC to print current input record with
	arrow under current position, I%FMT to do same for current format.
	Add I%REC and I%FMT to appropriate messages.

1474	JLC	22-May-81
	Fix bug in new -20 open code, can't look at DF before it's set up.

1475	JLC	22-May-81
	Minor bug in XXXSET, %GTBLK has no error return.

1476	JLC	26-May-81
	Fix bug in non-disk opens, was setting BYTN to large
	number which then overflowed.

1477	JLC	27-May-81
	In OSWTCH-10, must clear BLKN for magtape if writing after
	EOF, since it's a new file.

1502	JLC	28-May-81
	Install defensive WAIT operations in magtape code.

1503	JLC	28-May-81
	SINR and SOUTR are asymmetric - tape I/O rounds up to
	words, so that SINR fails with default (1000 bytes).
	Fix: force rounding to words in OPEN.

1505	JLC	01-Jun-81
	Don't do extra backspace in MTAISW; data is still there.

1512	BL	5-JUN-81	Q10-05829
	Fix omission of <crlf> when output assigned from DSK to TTY.

1513	BL	8-Jun-81	Q10-06193
	Fix no error message writing small file to write-locked tape.

1514	JLC	8-Jun-81
	Change default "width" of disk output lines from 132 to 72 chars
	for NAMELIST and list-directed output.

1515	BL	9-Jun-81
	Change JRST to CLSERR in EDIT 1513 to PUSHJ.

1532	DAW	14-Jul-81
	OPEN rewrite: Base level 1

1534	DAW	14-Jul-81
	Code for TOPS-20 "STATUS='SCRATCH'". Also fix infinite
	loop if errors in DIALOG='string'.

1537	DAW	16-Jul-81
	Finish TOPS-20 SCRATCH file handling. Fixup TOPS-20
	CLOSE code so it works again.

1540	DAW	17-Jul-81
	Delete IS from DDB, use IOSTAT variable directly.
	Set IOSTAT variable to zero at the start of each IO statement.
	Set D%ERR if "?" error in IOERR.

1541	DAW	17-Jul-81
	Get rid of D%LIN and D%LOUT.

1542	JLC	17-Jul-81
	Delete D%EOF, hopefully forever.

1543	DAW	17-Jul-81
	Allow SCRATCH files for devices besides DSK:

1544	DAW	20-Jul-81
	Invent "FIXU" to solve problem with /CARRAIGECONTROL.

1545	DAW	20-jul-81
	Remove call to %OCRLF at CLOSE time.

1546	JLC	20-Jul-81
	Don't suppress initial CRLF in files.

1547	DAW	20-Jul-81
	Provide the functionality that %AUXBF used to.

1554	DAW	22-Jul-81
	Fix CLOSE /DISPOSE actions; CLOSE keywords different from OPEN.

1556	DAW	22-Jul-81
	CLOSE from EXIT.

1560	DAW	28-Jul-81
	OPEN rewrite base level 2.

1563	DAW	29-Jul-81
	DIALOG='string' lost track of its arg type.

1564	DAW	29-Jul-81
	Check conflicts in CLOSE args; use STATUS value if DISPOSE not given.

1565	DAW	29-Jul-81
	Default BLANK= correctly.

1570	DAW	30-Jul-81
	Don't clear %IONAM in %IOERR anymore - it is used at end of OPEN.

1573	DAW	31-Jul-81
	Better error handling for RENAME.

1575	JLC	05-Aug-81
	Fixed half-hearted attempt to make DIRECTORY=array work,
	implemented separate access bit-setting by device type
	in DOOPEN, eliminating need for MTACRK and making
	SEQINOUT work in general.

1576	DAW	11-Aug-81
	OSWTCH for disk.

1602	JLC	12-Aug-81
	Reinserted suppression of initial CRLF for terminals only.

1610	DAW	17-Aug-81
	CLOSE /default rename didn't work on the -10

1616	DAW	19-Aug-81
	Infinite loop on TOPS-10 if non-disk OPEN failed.

1617	DAW	19-Aug-81	Q10-5204
	Problem with DISPOSE='SUBMIT'

1620	DAW	20-Aug-81
	Fix TOPS-20 generation skew problem in DIALOG mode

1621	DAW	20-Aug-81
	CLOSE/ RENAME/ DELETE on the -10.

1625	DAW	21-Aug-81
	Get rid of "DF".

1640	DAW	26-Aug-81
	Always use EXTENDED GTJFN to get ";FORMAT:F"
	This edit for future use for magtape format specifier.
	Part of edit (actual format specifier) is REPEAT 0'd
	until we allow magtape format to be specified in OPEN
	statement.

1641	DAW	26-Aug-81
	OPEN STATUS='NEW' FAILED ON TOPS-20

1642	JLC	27-Aug-81
	Replace %FILOP calls with FILOPs.

1643	JLC	27-Aug-81
	Change IRBUF & ORBUF into full word byte pntrs, so
	releasing them must use only right half addr.

1650	BL	31-Aug-81
	Fix RECORDSIZE applied to NAMELIST & LIST directed output.

1652	DAW	1-Sep-81
	Fix DUMP MODE I/O on TOPS-10.

1654	BL	1-Sep-81
	Typo in EDIT 1650.

1655	DAW	1-Sep-81
	Clear .RBALC after OPEN FILOP.

1660	DAW	3-Sep-81
	Use low channels if all extended ones are taken.

1663	JLC	8-Sep-81
	Write out last buffer for magtape on -10. Normally done
	by monitor, but if no data, no tape mark gets written unless
	the initial OUT is done.

1664	DAW	8-Sep-81
	Don't call DOOPEN twice if DDB's get consolidated at OPENX.

1665	DAW	8-Sep-81
	D.TTY = DDB address of the controlling TTY: (if OPEN yet..)

1666	DAW	8-Sep-81
	/MODE:IMAGE implies /FORM:F. /FORM:U is a conflict.

1670	DAW	9-Sep-81
	Two DSK: files open for append no longer get same DDB.

1672	DAW	9-Sep-81
	Was bypassing conflict check for RANDOM and no RECORDSIZE.

1674	DAW	9-Sep-81
	Couldn't WRITE to LPT: on the -10 ("IO" bits toggled).

1675	DAW	9-Sep-81
	Added code for device conflicts with MODE.

1677	JLC	10-Sep-81
	Fixed unmapping of unused pages.

1701	JLC	10-Sep-81
	Added SETO for setup to unmap pages

1706	DAW	11-Sep-81
	Lots of changes to errors.

1711	DAW	15-Sep-81
	Set D%ERR if IOERR, even if message not typed.

1712	JLC/DAW	15-Sep-81
	Got rid of D%ERR, use DDBADR instead.

1715	DAW	15-Sep-81
	If user specified FORM='FORMATTED' but not MODE, he got
	an "?Internal FOROTS error".

1717	DAW	16-Sep-81
	Implement D%NCLS - set if CLOSE error happened,
	to avoid the "infinite loop" of CLOSE - %ABORT - CLOSE - %ABORT ...

1723	DAW	17-Sep-81
	Fix problem with sticky ERR= from OPEN.

1725	DAW	17-Sep-81
	DIALOG parsing on TOPS-10.

1732	DAW	22-Sep-81
	Fix -20 STATUS='NEW'.

1734	DAW	22-Sep-81
	STATUS='SCRATCH', ACCESS='RANDOM' on TOPS-20.

1740	DAW	23-Sep-81
	More REREAD code - clear U.RERD in %CLOSE.

1742	JLC	23-Sep-81
	Fix OSWTCH to do the right thing to N.REC: decrement it
	for disk, as we are backing over the ENDFILE record, set
	it to 1 for magtape, as we are writing a new file. All this
	because BACKSPACE checks the record number and leaves
	if zero.

1743	DAW	24-Sep-81
	Fix obscure bug in DIALOG scanning, caused "?Bad source/dest designator"
	on TOPS-20 if a switch was mis-typed and then typed correctly.

1744	DAW	24-Sep-81
	Allow user to OPEN the special negative units (note: not documented.)

1750	DAW	28-Sep-81
	Stop after reading in 5 SFD's in DIRECTORY=array.

1751	JLC	28-Sep-81
	Fix unformatted backspace again. A bug in DSKOSW-20 was causing
	attempts to PMAP page -1. If either IPTR is zero or the file
	position is negative, clear IPTR/ICNT so we'll just start
	writing at the start of the file.

1752	DAW	29-Sep-81
	Minor fixes to DIALOG processing.

1753	DAW	29-Sep-81
	IOERR's to type the PC. %TRACE call no longer needed.

1754	DAW	29-Sep-81
	Allow negative generation numbers on TOPS-20. (For example,
	-1 means the next generation number).

1755	DAW	1-Oct-81
	Allow protections <111> in TOPS-10 DIALOG mode, as per V5a.
	They can be either before or after PPN's.

1757	DAW	2-Oct-81
	Conflict with /READONLY caused "?Ill mem ref".

1763	DAW	7-Oct-81
	Fatal error if user tries to write to a LINED file.

1764	DAW	7-Oct-81
	TOPS-10 MTASET got "Integer divide check", "TAPOP. error" trying
	to set BLOCKSIZE.

1765	DAW	7-Oct-81
	Make TOPS-10 OPEN error type the non-printing character
	that caused the problem.

1770	DAW	8-Oct-81
	TOPS-10 progs hang in EW state at the QUEUE. UUO if GALAXY
	version 2 is running.

1771	DAW	8-Oct-81
	Missing /LIMIT code for TOPS-10 GALAXY V2 packet.

1772	DAW	8-Oct-81
	TOPS-10 DISPOSE='DELETE' didn't release the channel.

1774	DAW	8-Oct-81
	Avoid getting "?Unexpected TAPOP. error" for typical errors.

1775	JLC	9-Oct-81
	Prevent doing tapops if program didn't specify anything.

1776	DAW	9-Oct-81
	Allow BINARY,DUMP,IMAGE mode to be used with TOPS-10 NUL: device.

1777	DAW	9-Oct-81
	FILOP. CLOSE before RELEASE when appropriate.

2000	DAW	9-Oct-81
	Fix typo that caused PLOT routines to stop working because
	unit -7 couldn't be opened.
	Get rid of extraneous, unreachable TOPS-10 code.

2002	DAW	13-Oct-81
	OPEN 'TTY', ACCESS='SEQIN', followed by "TYPE" didn't work.

2004	DAW	14-Oct-81
	Before consolidating DDB's, check to make sure MODE is the same.

2005	JLC	15-Oct-81
	Add unmapping of unused pages for random files also.

2011	DAW	19-Oct-81
	At DOOPEN store EOFN from .RBSIZ info. Use that to compute blocks
	when queueing file. Also get rid of "FSIZE".

2014	JLC	19-Oct-81
	Fix unmapping of unused pages not to unmap holes in the file.

2016	JLC	20-Oct-81
	Fix minor bug in QUEUE acknowledge, error msgs.

2023	DAW	23-Oct-81
	With GALAXY R2, DISPOSE='LIST' didn't make the file be
	deleted after it was printed.

2026	JLC	27-Oct-81
	Fixed RSIZW for LINED files so backspace will work.

2027	DAW	27-Oct-81
	Rework GALAXY v2 code to use symbolic names, so sites who
	have modified QSRMAC can just reassemble FOROTS to make it
	handle /DISPOSE:<queue> at their site.

2033	DAW	30-Nov-81
	In CLSQ, zero out the page returned by GTPGS.

***** End Revision History *****

\
	FSRCH
	SEARCH QSRMAC
IF20,<	SEARCH GLXMAC >

	ENTRY	OPEN%,CLOSE%,RELEA%,ALCHN%,DECHN%,INQ%
	INTERN	EXIT1%,%EXIT1
	INTERN	%ALCHN,%DECHN
	INTERN	%SETIN,%SETOUT,%CHKNR
IF10,<	INTERN	%CHMSK,%CLSER,%ST10B,%CALOF   >
IF20,<	INTERN	%OCCOC,%CCMSK,%CLSOP   >
	INTERN	%TERR,%TIOS,%TEND
	INTERN	%OPENX,%LSTBF
IF10,<	INTERN	%ARGNM >	;name of arg for ERROR

	EXTERN	%POPJ,%POPJ1,%POPJ2
	EXTERN	%SAVE1,%SAVE2,%SAVE3,%SAVE4,%SAVE,%PUSHT,%POPT
	EXTERN	%GTBLK,%FREBLK,%GTPGS,%FREPGS
	EXTERN	%IREC,%OREC,%OCRLF
IF20,<	EXTERN	%PTOF,%FTOP    >
	EXTERN	%CRLF,G.EFS,G.FERR
	EXTERN	%ABORT
	EXTERN	%DDBTAB,%UDBAD,I.PID,%SIZTB,I.FLAG
	EXTERN	D.TTY,U.ERR,U.ACS,U.PDL
IF10,<	EXTERN	G.PPN,%RANWR,I.MVER,%CLRBC,%BACKB,%BAKEF,%ISET   >
IF20,<	EXTERN	G.LJE   >
	EXTERN	%ERRST,%EMSGT,%FOREC,%ERSVV,%ERRRS
	EXTERN	%LTYPE
	EXTERN	%SETD,%SETAV
	EXTERN	U.RERD
IF20,<	EXTERN	DBSTP.>		;Close out DBMS databases

	SEGMENT	CODE
	SUBTTL	OPEN

	SIXBIT	/OPEN./
OPEN%:	PUSHJ	P,%SAVE		;SAVE USER'S ACS, COPY ARG LIST
	XMOVEI	T1,[ASCIZ /OPEN/] ;SET STATEMENT NAME FOR ERROR MESSAGES
	MOVEM	T1,%IONAM

	PUSHJ	P,OPNCNV	;CONVERT OLD ARG BLOCK FORMAT

;Get TUNIT= unit #, %TERR= "ERR=" address, %TIOS= "IOSTAT=" address
	PUSHJ	P,FNDAGL	;Find UNIT=, ERR=, IOSTAT=
				;If no UNIT= given, gets abortive error.
	PUSHJ	P,UNRNGE	;Check unit range
				; (returns if in range, unit # in T2).
	SKIPE	T1,%TIOS	;Any IOSTAT variable?
	 SETZM	(T1)		;Yes, initialize to zero

; See if unit is already OPEN, if so do a CLOSE.
OPENA0:	SKIPE	U,%DDBTAB(T2)	;Get unit block, skip if not OPEN
	 PUSHJ	P,CLZUNT	;Close it
				;(Errors take ERR= branch)

;Unit is now closed and deallocated.
;Get a new one.
OPENA1:	MOVEI	T1,ULEN		;Length of a unit block
	PUSHJ	P,%GTBLK	;Allocate it
	MOVE	U,T1		;Point to empty unit block
	MOVE	T2,TUNIT	;Stick unit number in block
	STORE	T2,UNUM(U)
	MOVEI	T1,DLEN		;Length of a DDB block
	PUSHJ	P,%GTBLK	;Allocate it
	MOVE	D,T1		;Point to empty DDB block

;Set ERR= and IOSTAT= in the unit block

	MOVE	T1,%TERR	;Set ERR=
	MOVEM	T1,ERRAD(U)
	MOVE	T1,%TIOS	;Set IOSTAT=
	MOVEM	T1,IOSAD(U)
	TXO	F,F%DCU		;Set flag that tells IOERR
				; to deallocate U and D

;Setup the U and D blocks with information from the arg list.
;Possibly dialog mode will be flagged.

	PUSHJ	P,OPNARG	;Copy arguments from arg list
				;(Possibly take ERR= branch)
	PUSHJ	P,CKSCRT	;See if he specified STATUS='SCRATCH'
				;if so, filename is not allowed.
	PUSHJ	P,DFBSTS	;Set defaults based on STATUS
				; (probably FORnn.DAT)
	TXNN	F,F%DSTRG	;"DIALOG='string'" seen?
	 JRST	OPENA2		;No
	PUSHJ	P,DLGSTR	;Yes, do it
				; (possibly take ERR= branch)
	TXZ	F,F%DSTRG!F%INDST	;Clear flag if set
	PUSHJ	P,CKSCRT	;Check STATUS='SCRATCH' conflict
	PUSHJ	P,DFBSTS	;Set defaults based on STATUS
OPENA2:	PUSHJ	P,CHKDLG	;Go do DIALOG if necessary
	PUSHJ	P,CKSCRT	;Check STATUS='SCRATCH' conflict

;OPEN args all read in (including "DIALOG" if specified).

OPENA3:	PUSHJ	P,OPENX		;Call the implicit OPEN routine
				;Note: OPENX (not %OPENX) because
				;  there may be switch conflicts.
	MOVX	T1,D%OPEN	;"Explicit OPEN statement has been done"
	IORM	T1,FLAGS(D)	; Set DDB flag

;Return from OPEN

	PJRST	%SETAV		;Set AVAR if given; clear ERRAD, etc.
				; in UDB; return from OPEN.
;%OPENX: Routine to do implicit open
;  This routine is used by all I/O statements that do
;an implicit OPEN, and also the OPEN statement itself.
;  This routine must only be called when the arguments given
;so far do not conflict.
;	D and U are setup with the implicit args.
;	 (including ERR=, IOSTAT=)
;	Errors go to ERR= or call DIALOG.
;If no errors, DDBTAB entry is set up.

;Here if we either know or suspect that there are conflicts
; in the args given.

OPENX:	PUSHJ	P,DFBSTS	;Set default filespec info based on STATUS
	PUSHJ	P,CHKDLG	;Do DIALOG mode if necessary
	PUSHJ	P,CKCONF	;Check conflicts in OPEN switches now
	 JRST	OPENX		;Conflicts, go fix
	JRST	OPENX1		;No conflicts in args

;Here if we know there are no conflicting OPEN switches
; ** Implicit OPEN routine starts here **

%OPENX:	PUSHJ	P,%SAVE1	;Make sure P1 gets preserved
	PUSHJ	P,DFDEV		;Set default device
	PUSHJ	P,DFBSTS	;Set default filespec info based on STATUS

OPENX1:	PUSHJ	P,OPDFLT	;Set other defaults
	TXNE	F,F%DRE		;If problem,
	 JRST	OPENX		;Go fix it
	PUSHJ	P,DFDEV1	;Get real device info
	  JRST	OPENX		;Fix problem
	PUSHJ	P,CNFDEV	;Check conflicts with device type
	 JRST	OPENX		;Fix problem
	PUSHJ	P,MARKCS	;Mark for consolidation if we can
				; (goes to %ABORT if problem)
	MOVEM	D,DDBAD(U)	;Set DDB address
	LOAD	T1,FLAGS(D)	;Get DDB flags
	TXNE	T1,D%IN+D%OUT	; Is it already open (consolidated DDB's?)
	 JRST	OPXRET		;Yes, return

;No errors. Do the actual OPEN if we need to

	LOAD	T1,STAT(D)	;Get status
	CAIL	T1,ST.DISP	;STATUS that's really a DISPOSE?
	 PUSHJ	P,STATDS	;Yes, change to DISPOSE, STATUS='UNKNOWN'

;There are four possibilities for STATUS= now.
; If STATUS='UNKNOWN' and file access is sequential
; then the file is not opened until
;the first I/O operation.

	CAIN	T1,ST.UNK	;STATUS='UNKNOWN'?
	 JRST	OPXUNK		;Yes
	CAIN	T1,ST.OLD	;STATUS='OLD'?
	 JRST	OPXOLD		;yes
	CAIN	T1,ST.NEW	;STATUS='NEW'? (or implied)
	 JRST	OPXNEW		;Yes, go do the OPEN
	CAIN	T1,ST.SCR	;STATUS='SCRATCH'?
	 JRST	OPXSCR		;Yes, go do the OPEN
	$SNH			;?That's all that could happen

;Here if STATUS='OLD'

OPXOLD:	PUSHJ	P,OPNOLD	;** OPEN FILE FOR INPUT **
	 JRST	OPENX		;Error, go try again
	JRST	OPXRET		;Return

;Here if STATUS='NEW'

OPXNEW:	PUSHJ	P,OPNNEW	;** OPEN FILE FOR OUTPUT **
	 JRST	OPENX		;Error, go try again
	JRST	OPXRET		;Return

;Here if STATUS='SCRATCH'

OPXSCR:	PUSHJ	P,OPNSCR	;** OPEN FILE FOR SCRATCH **
	 JRST	OPENX		;Error, go try again
	JRST	OPXRET		;Return

;Here if STATUS='UNKNOWN'

OPXUNK:	LOAD	T1,INDX(D)	;What type of device?
	CAIN	T1,DI.TTY	;If TTY:,
	 SKIPA	T1,[AC.SOU]	;Pretend "SEQOUT" access.
	LOAD	T1,ACC(D)	;Get access
	PUSHJ	P,OPXUAC(T1)	;Do something
	 JRST	OPENX		;?failed
	JRST	OPXRET		;Success, return

;OPEN routine to call when status='UNKNOWN', by access type

OPXUAC:	$SNH			;* UNKNOWN ACCESS TYPE *
	JRST	OPNOLD		;SEQIN
	JRST	OPNOUT		;SEQOUT - Open file for output
	JRST	OPXUSO		;SEQINOUT- See what to do
	JRST	OPNOLD		;RANDIN
	JRST	OPNRIO		;RANDOM
	JRST	OPNAPP		;APPEND

;Here if SEQINOUT UNKNOWN

OPXUSO:	TXNE	F,F%CTTY	;Controlling TTY:?
	 JRST	OPNOUT		;Yes, go open it now
	JRST	%POPJ1		;Don't OPEN it yet
;Here when %OPENX is successful

OPXRET:	HXRE	T1,UNUM(U)	; Get unit number
	MOVEM	U,%DDBTAB(T1)	;Store unit block address in DDBTAB.
;	PJRST	STBLNK		;Set BLANK= default and return

;Routine to set BLANK= default
; If device is TTY: the default is always NULL
; Else if this is an OPEN statement, set BLANK=NULL
;   else set BLANK=ZERO.
;This may seem like nonsense, but it makes FOROTS compatible
;	with VAX.

STBLNK:	LOAD	T1,BLNK(U)
	JUMPN	T1,%POPJ	;Return if user specified it
	LOAD	T2,INDX(D)	; T2= device index
	MOVE	T1,%IONAM	; T1= address of statement name
	MOVE	T1,(T1)		;Get ASCIZ
	CAIE	T2,DI.TTY	;For TTY
	CAMN	T1,[ASCIZ /OPEN/] ; or OPEN statement
	 SKIPA	T1,[BL.NULL]	;Default is BLANK=NULL
	MOVEI	T1,BL.ZERO	;Else Default is BLANK=ZERO..
	STORE	T1,BLNK(U)	;Store the value
	POPJ	P,		;Return


;Routine to change STATUS that's really a DISPOSE into
; STATUS='UNKNOWN' and DISPOSE.
;There should be no conflicts with DISPOSE and STATUS when we
;get here.
;Call:
;	T1/ STATUS value that's really a dispose
;Return:
;	T1/ ST.UNK, DISP(D) set, STAT(D) set to ST.UNK

STATDS:	SUBI	T1,ST.DISP	;Get /DISPOSE value
	LOAD	T2,DISP(D)	; If not set,
	SKIPN	T2
	 STORE	T1,DISP(D)	; Set it
	MOVEI	T1,ST.UNK	;Set 'UNKNOWN' status
	STORE	T1,STAT(D)
	POPJ	P,		;Return, T1= 'UNKNOWN' status
;Routine to set OPEN defaults based on STATUS
;If STATUS='SCRATCH', all info except device is cleared
; Otherwise default name is FORnn.DAT
;This routine does not affect the value of F%DRE.
;  and can not cause an error.
;This routine should be called before each DIALOG mode is called
; and before the OPEN is done.

DFBSTS:	LOAD	T1,STAT(D)	;Get current value of "STATUS"
	CAIE	T1,ST.SCR	;'SCRATCH'?
	 PJRST	DFFILE		;No, set default filename and return
	TXZ	F,F%FSS		;Clear flag "user specified filespec stuff"
	TXZ	F,F%EXT		;Clear "extension was specified"

IF10,<				;Set defaults for STATUS='SCRATCH'
DFSCR:	SETZM	LKPB(D)		;Clear the LOOKUP block
	HRLI	T1,LKPB(D)
	HRRI	T1,LKPB+1(D)
	BLT	T1,LKPB+LLEN-1(D) ; . .
	SETZM	PTHB(D)		;Clear the path block
	HRLI	T1,PTHB(D)
	HRRI	T1,PTHB+1(D)
	BLT	T1,PTHB+^D9-1(D) ; . .
	SETZM	PPN(D)		;Clear PPN or ptr to path block
	POPJ	P,		;Return
>
IF20,<				;Set defaults for STATUS='SCRATCH'
DFSCR:	SETZM	DIR(D)		;Clear directory
	SETZM	FILE(D)		; Filename
	SETZM	EXT(D)		; Extension
	SETZM	PROT(D)		; Protection
	SETZM	XGEN(D)		; Generation #
	POPJ	P,		;Return
>
;Routine to check for unit out of range
;Input:
;	TUNIT/ unit number from OPEN or CLOSE arg list
;	PUSHJ	P,UNRNGE
;	<return here if unit in range, unit # in T2>
; If unit is not in range for OPEN or CLOSE,
;	the program takes ERR= path (TERR) or aborts.

UNRNGE:	MOVE	T2,TUNIT	;Get unit number
	CAML	T2,[MINUNIT]	;Skip if less than the minimum
	CAILE	T2,MAXUNIT	;Skip if .LE. the maximum
	 $ECALL	IUN,%ABORT	;?UNIT out of range
	POPJ	P,		;Ok, unit in range
;CLZUNT-- Routine to do an implicit "CLOSE (UNIT=un)"
;U points to unit block
; The ERR= and IOSTAT= args are copied from the OPEN parameters.
;If IOERR happens in CLOSE, D and U blocks are not deallocated.
;   (because F%DCU is not set).

CLZUNT:	MOVE	D,DDBAD(U)	;Get old DDB block
	MOVE	T1,%TERR	; Use ERR= from open
	MOVEM	T1,ERRAD(U)
	MOVE	T1,%TIOS	; Use IOSTAT= from open
	MOVEM	T1,IOSAD(U)
	PJRST	%CLOSE		;Go close it and return.
;CKCONF - Routine to check for conflicts in OPEN args.
;Called after each DIALOG to check for bad arguments,
; inconsistancies, etc.
;  This routine gives error messages (possibly takes ERR= branch),
; or sets F%DRE if there are errors.
;It must be called in OPEN after OPNARG, and after each
; DIALOG.
;If no errors, returns .+2

CKCONF:	PUSHJ	P,CKSCRT	;Check STATUS='scratch' conflict

;Check /STATUS conflict with /DISPOSE
;T1= status

CKCNST:	MOVEM	T1,%OPNV1	;Store switch value for error message
	LOAD	T2,DISP(D)	;Get /DISPOSE
	CAIN	T1,ST.SCR	;/STATUS=SCRATCH?
	 JRST	CKCNS1		;Yes, /DISPOSE=SAVE not allowed
	SUBI	T1,ST.DISP	;Convert to /DISP:something
	JUMPLE	T1,CKCNFM	;Go check /FORM
	JUMPE	T2,CKCNFM	; If not specified, no conflict then
	CAIN	T1,(T2)		;Do STATUS and DISPOSE agree?
	 JRST	CKCNFM		;Yes, no error
	JRST	CKCNS2		;Error
CKCNS1:	CAIE	T2,DS.SAVE	;/DISPOSE='SAVE' specified?
	 JRST	CKCNFM		;No, ok
CKCNS2:	MOVEM	T2,%OPNV2	;Store /DISPOSE value for error
	MOVEI	T1,OK.STAT	;Store switch number for errors
	MOVEM	T1,%OPNK1
	MOVEI	T1,OK.DISP
	MOVEM	T1,%OPNK2
	PUSHJ	P,OPCONF	;Give error message

;Check /MODE and /FORM conflict
CKCNFM:	LOAD	T1,FORM(D)	;T1= form
	JUMPE	T1,CKCNAC	;If not specified, no conflict
	LOAD	T2,MODE(D)	;T2= mode
	JUMPE	T2,CKCNAC	;If not specified, no conflict
	CAIL	T2,MD.ASC	;ASCII or greater implies /FORM:F
	 JRST	CKFMF		;Go check that

;8-SEP-81 /DAW, MODE='IMAGE' conflicts with FORM='FORMATTED'
;	CAIGE	T2,MD.BIN	;BINARY or greater implies /FORM:U
;	 JRST	CKCNAC		;/MODE:IMAGE - no conflict

;Must be /FORM:UNFORMATTED
CKFMU:	CAIN	T1,FM.UNF	;UNFORMATTED?
	 JRST	CKCNAC		;Yes, ok
CKFMUE:	MOVEM	T1,%OPNV2	;Store value for error message
	MOVEI	T1,OK.MOD	;Store switch numbers
	MOVEM	T1,%OPNK1
	MOVEI	T1,OK.FORM
	MOVEM	T1,%OPNK2
	MOVEM	T2,%OPNV1	;Value of /MODE
	PUSHJ	P,OPCONF	;Give error
	JRST	CKCNAC		;Go on

;Here if /FORM must be "FORMATTED"
CKFMF:	CAIE	T1,FM.FORM	;FORMATTED?
	 JRST	CKFMUE		;No, give error

;Check conflict of /ACCESS and /READONLY
CKCNAC:	LOAD	T1,RO(D)	;T1= "Readonly" bit
	JUMPE	T1,CKCSRO	;If not specified, no conflict
	LOAD	T2,ACC(D)	;T2= ACCESS
	CAIE	T2,AC.SOU	;SEQOUT?
	CAIN	T2,AC.APP	; or APPEND?
	  JRST	.+2		;Yes, can't have READONLY
	JRST	CKCSRO		;Otherwise it's ok

	MOVEM	T2,%OPNV1	;Store value of ACCESS
	SETOM	%OPNV2		;READONLY has no value
	MOVEI	T1,OK.ACC
	MOVEM	T1,%OPNK1
	MOVEI	T1,OK.RO
	MOVEM	T1,%OPNK2
	PUSHJ	P,OPCONF	;Give error

;Check conflict of /STATUS and /READONLY
CKCSRO:	LOAD	T1,RO(D)	;Get value of /READONLY
	JUMPE	T1,CKCSAC	;Not specified, no conflict
	LOAD	T2,STAT(D)	;Get /STATUS
	CAIE	T2,ST.NEW
	CAIN	T2,ST.SCR	;New and scratch don't make sense
	 JRST	.+2
	JRST	CKCSAC		;Otherwise OK
	MOVEM	T2,%OPNV1
	SETOM	%OPNV2		;READONLY has no value
	MOVEI	T1,OK.STAT
	MOVEM	T1,%OPNK1
	MOVEI	T1,OK.RO
	MOVEM	T1,%OPNK2
	PUSHJ	P,OPCONF	;Give error

;Check conflict of /STATUS and /ACCESS
CKCSAC:	LOAD	T1,ACC(D)
	JUMPE	T1,CKCACM	;If no ACCESS specified, no conflict
	LOAD	T2,STAT(D)	;Get STATUS
	JUMPE	T2,CKCACM	;If not specified, no conflict
	CAILE	T2,ST.DISP	;Any kind of DISPOSE is ok
	 JRST	CKCACM
	CAIE	T2,ST.OLD	;STATUS='old'
	CAIN	T2,ST.UNK	;STATUS='unknown'
	 JRST	CKCACM		;No conflict

;STATUS= 'NEW' or 'SCRATCH' - can't happen if file is read-only
	CAIE	T1,AC.SIN	;SEQIN
	CAIN	T1,AC.RIN	;RANDIN
	 JRST	CKCSC1		;?Conflict

	CAIE	T2,ST.SCR	;STATUS='SCRATCH'?
	 JRST	CKCACM		;No, no conflict
	CAIE	T1,AC.SIO	;Yes, only SEQINOUT
	CAIN	T1,AC.RIO	; and RANDOM allowed
	 JRST	CKCACM		;No conflict

;/ACCESS vs. /STATUS
CKCSC1:	MOVEM	T1,%OPNV1
	MOVEM	T2,%OPNV2
	MOVEI	T1,OK.ACC
	MOVEM	T1,%OPNK1
	MOVEI	T1,OK.STAT
	MOVEM	T1,%OPNK2
	PUSHJ	P,OPCONF	;Give error

;Check /ACCESS conflict with /MODE
CKCACM:	LOAD	T1,ACC(D)	;Get /ACCESS
	LOAD	T2,MODE(D)	;Get /MODE
	CAIE	T1,AC.RIN	;Random?
	CAIN	T1,AC.RIO
	 JRST	.+2		;Yes
	JRST	CHKRSZ		;No, -- next check

;Random (DIRECT) access.
	CAIE	T2,MD.DMP	;/MODE:DUMP illegal (not hard to make
				; it legal at some future date.. if so
				; each record would be a block and /RECORDSIZE
				; could not also be specified (??).).
	 JRST	CHKRSZ		;Not /MODE:DUMP, go on.
	MOVEM	T1,%OPNV1	;Value of ACCESS
	MOVEM	T2,%OPNV2	;Value of MODE
	MOVEI	T1,OK.ACC
	MOVEM	T1,%OPNK1
	MOVEI	T1,OK.MODE
	MOVEM	T1,%OPNK2
	PUSHJ	P,OPCONF	;Give error

;Make sure he specified "RECORDSIZE" if random access requested
CHKRSZ:	LOAD	T1,ACC(D)	;GET /ACCESS
	CAIE	T1,AC.RIN	;RANDOM?
	CAIN	T1,AC.RIO
	  JRST	.+2		;YES
	 JRST	CKCNXT		;No
	MOVE	T1,RSIZE(D)	;GET /RECORDSIZE
	JUMPN	T1,CKCNXT	;NONZERO, OK
;	IOERR	(RRR,30,507,?,Random IO requires /RECORDSIZE,,%POPJ)
	$ECALL	RRR,REQDIA	;"?Random IO requires /RECORDSIZE"

CKCNXT:	TXNN	F,F%DRE		;Skip if errors
	 AOS	(P)		;No, skip return
	POPJ	P,		;Yes, return .+1


;CKSCRT--Routine to check for STATUS='SCRATCH' and also filespec given.
; If both specified, an error is generated. Either ERR= will be
; taken or F%DRE will be set.
;Call:
;	PUSHJ	P,CKSCRT
;	<return here unless ERR= taken>
;On return, T1= status

CKSCRT:	LOAD	T1,STAT(D)	;Get STATUS
	CAIE	T1,ST.SCR	;SCRATCH?
	 POPJ	P,		;No
	TXNN	F,F%FSS		;User specify filespec stuff?
	 POPJ	P,		;No, ok
	$ECALL	SNM,REQDIA	;?STATUS='SCRATCH' with a named file!
;ROUTINE TO TYPE ERROR MESSAGE FOR CONFLICTING OPEN SWITCHES
;ARGS:	%OPNK1 = KEYWORD NUMBER OF FIRST CONFLICTING SWITCH
;	%OPNV1 = KEYWORD-VALUE NUMBER OF SWITCH
;	%OPNK2 = KEYWORD NUMBER OF OTHER CONFLICTING SWITCH
;	%OPNV2 = KEYWORD-VALUE NUMBER, OR -1 IF SWITCH DOESN'T TAKE VALUE

OPCONF:	MOVE	T1,%OPNK1	;GET FIRST SWITCH NUMBER
	MOVEI	T2,OPNSWT	;POINT TO SWITCH TABLE
	PUSHJ	P,FNDSWT	;FIND CORRESPONDING STRING IN OPNSWT
	EXCH	T1,%OPNK1	;SAVE STRING ADDRESS, GET SWITCH NUMBER
	HRRZ	T2,OPNDSP(T1)	;GET SWITCH VALUE TABLE ADDRESS
	MOVE	T1,%OPNV1	;GET SWITCH VALUE NUMBER
	PUSHJ	P,FNDSWT	;FIND SWITCH VALUE STRING IN ITS TABLE
	MOVEM	T1,%OPNV1	;STORE STRING ADDRESS

	MOVE	T1,%OPNK2	;SAME FOR SECOND SWITCH
	MOVEI	T2,OPNSWT
	PUSHJ	P,FNDSWT
	EXCH	T1,%OPNK2
	HRRZ	T2,OPNDSP(T1)
	SKIPGE	T1,%OPNV2
	  SKIPA	T1,[[0]]
	PUSHJ	P,FNDSWT
	MOVEM	T1,%OPNV2

;	IOERR	(ISW,30,506,?,Incompatible attributes /$Z$Z /$Z$Z,<%OPNK1,%OPNV1,%OPNK2,%OPNV2>,REQDIA)
	$ECALL	ISW,REQDIA
;CNFDEV - Check for conflicts for OPEN device
;If there is a conflict, either ERR= is taken or
; an error message is typed and F%DRE is set.

;Readonly devices cannot do output
CNFDEV:	LOAD	T1,IO(D)	;Get possible IO values
	TRNE	T1,2		;Can device do output?
	 JRST	CNFDV1		;Yes, ok
	LOAD	T1,ACC(D)	;Get access
	CAIE	T1,AC.SOU	;SEQOUT
	CAIN	T1,AC.APP	;APPEND
	 JRST	CNFDAC		;Yes, conflict
	CAIE	T1,AC.RIO	;RANDOM (DIRECT)
	CAIN	T1,AC.RIN	;RANDIN
	 JRST	CNFDAC		;Yes, conflict
	JRST	CNFDV1		;Yes, ok

;T1= Access type that conflicts
CNFDAC:	MOVEI	T2,SWACC	;Get switch value table address
	PUSHJ	P,FNDSWT	;Find switch value string in its table
;	IOERR	(IAC,30,248,/ACCESS:$Z is illegal for this device)
	$ECALL	IAC,REQDIA	;Set F%DRE if ERR= not taken

;Writeonly devices cannot do input
CNFDV1:	LOAD	T1,IO(D)	;Get input/output possible
	TRNE	T1,1		;Can device do input?
	 JRST	CNFDV2		;Yes, ok
	LOAD	T1,ACC(D)	;Get ACCESS
	CAIE	T1,AC.RIN	;No RANDOM allowed
	CAIN	T1,AC.RIO
	 JRST	CNFDAC		;?conflict
	CAIN	T1,AC.SIN	;SEQIN
	 JRST	CNFDAC		;?conflict
	JRST	CNFDV2		;No conflict

;Check for DIRECT access specified for a sequential device
CNFDV2:	LOAD	T1,ACC(D)	;Get /ACCESS
	CAIE	T1,AC.RIN	;Random?
	CAIN	T1,AC.RIO
	 JRST	.+2		;Yes, check to see if device allows this
	JRST	CNFDV3		;Not RANDOM access, all devices allow it
	LOAD	T2,DVTYP(D)	;Get type of device
IF20,<
	CAIE	T2,.DVDSK	;Disk
	CAIN	T2,.DVNUL	; and NUL: are the only random-access devices
	 JRST	CNFDV3		;OK, next test
>
IF10,<
	CAIE	T2,.TYDSK	;DSK: (and NUL: which gets this same value)
	CAIN	T2,.TYDTA	; and DECTAPE can do random-IO
	 JRST	CNFDV3		;OK, next test
>
;Device can not do RANDOM IO
;T1= ACCESS MODE
	JRST	CNFDAC

;/BLOCKSIZE only allowed with magtape.
CNFDV3:	LOAD	T1,BLKSZ(D)	;Get /BLOCKSIZE
	JUMPE	T1,CNFDV4	;Jump if not specified
	LOAD	T1,INDX(D)	;Get device type
	CAIN	T1,DI.MTA	;Magtape?
	 JRST	CNFDV4		;Yes, ok
	SETZ	T1,		;Clear it
	STORE	T1,BLKSZ(D)
;	IOERR	(BSI,0,0,% BLOCKSIZE ignored: device is not a magnetic tape)
	$ECALL	BSI

;Check to see that the device can be opened in the requested mode

CNFDV4:	LOAD	T1,INDX(D)	;Get device type
	LOAD	T2,MODE(D)	;Get mode
	JUMPE	T2,CNFDV5	;Jump if no mode specified (no conflict, then)
	CAIN	T2,MD.ASC	;Everything likes ASCII
	 JRST	CNFDV5

;Not ASCII mode

	CAIE	T1,DI.DSK	;DSK: everything allowed
	CAIN	T1,DI.MTA	; also magtape
	 JRST	CNFDV5		;No conflict
	LOAD	T1,DVTYP(D)	;Get device type
IF10,<
	CAIE	T1,.TYDSK	;DSK: (append)
	CAIN	T1,.TYDTA	;DTA:
	 JRST	CNFDV5		;Everything allowed

	CAIE	T1,.TYTTY	;TTY:
	CAIN	T1,.TYPTY	; or PTY:
	 JRST	CNFD4X		;Yes, conflict
>
IF20,<
	CAIE	T1,.DVDSK	;DSK: (append)
	CAIN	T1,.DVNUL	;NUL:
	 JRST	CNFDV5		;Everything allowed

	CAIE	T1,.DVTTY	;TTY:
	CAIN	T1,.DVPTY	;or PTY:?
	 JRST	CNFD4X		;Yes, conflict
>
;Not TTY: or PTY:, everything else likes image

	CAIN	T2,MD.IMG	;Image?
	 JRST	CNFDV5		;Yes, no conflict

;Mode is not IMAGE or ASCII

IF10,	CAIN	T1,.TYLPT	;LPT:?
IF20,	CAIN	T1,.DVLPT	;LPT:?
	 JRST	CNFD4X		;Yes, conflict

IF10,<
	CAIN	T1,.TYPLT	;Plotter?
	 JRST	CNFD4X		;Yes, conflict
>;END IF10

;Not LPT: either, everthing else likes BINARY

	CAIN	T2,MD.BIN
	 JRST	CNFDV5		;No conflict

;Mode is LINED or DUMP (TOPS-10)
;We know that device is not MTA, DTA, DSK, NUL.

;ERROR- mode conflict with device

CNFD4X:	MOVE	T1,T2		;Get /MODE value
	MOVEI	T2,SWMODE
	PUSHJ	P,FNDSWT	;Find switch value string in its table
;	IOERR	(IDM,n1,n2,/MODE:$A illegal for this device,T1)
	$ECALL	IDM,REQDIA	;Request DIALOG mode

CNFDV5:	JRST	%POPJ1		;No error-- skip return
;CHKDLG - routine to check for dialog needed and do it
;Called from OPEN and CLOSE routines
;Returns when everything cleared up.
CHKDLG:	TXZN	F,F%DRE		;Dialog requested because of errors?
	 JRST	CHKDL2		;No
	TXZ	F,F%DIALOG	;Clear /DIALOG if set
CHKDL1:	PUSHJ	P,CLRCNS	;Clear DDB consolidation pointers, if any
	PUSHJ	P,DIALOG	;Do DIALOG (could set F%DRE again)
	JRST	CHKDLG		; Loop until no errors.

CHKDL2:	TXZE	F,F%DIALOG	;DIALOG requested?
	 JRST	CHKDL1		;Yes
	POPJ	P,		;Return
;FNDAGL:
;Routine to find UNIT=, ERR=, and IOSTAT= in the argument list
; and if there, store them in TUNIT, %TERR, and %TIOS respectively.
;
;Called by OPEN% and CLOSE%
;
;Inputs:
;	L points to argument list
;Uses T1, T2, T3
;Leaves L intact

FNDAGL:	SETZM	%TERR		;Not specified yet..
	SETZM	%TIOS

;"L" is "saved" in T1 below.
	MOVE	T1,L		;Keep L in T1 during this code.

;Find unit. If not specified, abort.
FAGL1A:	LDB	T2,[POINTR @%LTYPE,ARGKWD]
	CAIE	T2,OK.UNIT
	  AOBJN	L,FAGL1A
	JUMPL	L,FAGL1B	;Jump if we found it
;	IOERR	(UNS,30,501,?,Unit not specified,,%ABORT)]
	$ECALL	UNS,%ABORT	;?Unit not specified
FAGL1B:	HRRE	T2,(L)		;Assume unit is a constant
	LDB	T3,[POINTR @%LTYPE,ARGTYP]
	CAIE	T3,0		;Is it a constant?
	 MOVE	T2,@0(L)	;No, get it
	MOVEM	T2,TUNIT	;Store UNIT= arg.
	MOVE	L,T1		;Restore L

;Find ERR= and IOSTAT= if specified.
FAGL2A:	LDB	T2,[POINTR @%LTYPE,ARGKWD]
	CAIN	T2,OK.ERR	;ERR=
	 JRST	FAGL2B
	CAIN	T2,OK.IOS	;IOSTAT=
	 JRST	FAGL2C
FAGL2E:	AOBJN	L,FAGL2A	;Loop thru arg list
	MOVE	L,T1		;Restore L
	POPJ	P,		;Return

;ERR=
FAGL2B:	XMOVEI	T2,@0(L)	;Get address
	MOVEM	T2,%TERR	;save it
	JRST	FAGL2E

;IOSTAT=
FAGL2C:	XMOVEI	T2,@0(L)	;Get address
	MOVEM	T2,%TIOS	;Save it
	JRST	FAGL2E		;Continue
SEGMENT DATA

;Stuff from OPEN and CLOSE arg list
%TERR:	BLOCK	1		;ERR= from arg list
%TIOS:	BLOCK	1		;IOSTAT= from arg list
TUNIT:	BLOCK	1		;UNIT= from arg list
%TEND:	BLOCK	1		;END=

SEGMENT CODE
;OPNRIO - Open random file for Input and Output.
; STATUS = 'unknown'
OPNRIO:
IF20,<	SETZ	T1,>		;No special JFN bits
	PJRST	OPCMO		;open for output

;OPNAPP - Open file when Access= 'APPEND'
OPNAPP:
IF20,<	SETZ	T1,>		;No special JFN bits
	PJRST	OPCMO		;Open for output

;OPNOLD - Open file for input
;This routine is called from OPEN to open a file when
; STATUS='OLD'.

OPNOLD:
IF20,<	MOVX	T1,GJ%OLD>	;"File must exist"
	MOVX	T3,D%IN		;Assume open for input
	LOAD	T2,ACC(D)	;But ACCESS might change it
	CAIE	T2,AC.SOU	;SEQOUT
	CAIN	T2,AC.APP	;APPEND
	 MOVX	T3,D%OUT	;Will open file for output
	TXNE	T3,D%IN		;Open for input?
	 JRST	OPCMI		;Yes
;	JRST	OPCMO		;Open for output

;Common routine to OPEN file for output

OPCMO:	MOVX	T0,D%IO		;Say "Doing output"
	IORM	T0,FLAGS(D)	;. .
IF10,<	MOVX	T1,D%OUT>
	PUSHJ	P,DOOPEN	;Do the OPEN
	 POPJ	P,		;Problems, single return
	MOVX	T1,D%OUT	;Set "OPENED FOR OUTPUT"
	IORM	T1,FLAGS(D)	; . .
	JRST	%POPJ1		;Skip return

;Common routine to open file for input

OPCMI:	MOVX	T0,D%IO		;Make sure "Doing output" bit
	ANDCAM	T0,FLAGS(D)	; is off
IF10,<	MOVX	T1,D%IN>
	PUSHJ	P,DOOPEN	;Do the OPEN
	  POPJ	P,		;Problems, single return
	MOVX	T1,D%IN		;Set "OPENED for input"
	IORM	T1,FLAGS(D)	; . .
	JRST	%POPJ1		;OK, skip return

;OPNNEW - Open file if status=new
;  This routine is called only from OPEN when STATUS='NEW'.
; The file must not exist and is opened for output.

OPNNEW:
IF20,<	MOVX	T1,GJ%NEW>	;"File must not exist"
	PJRST	OPCMO		;Continue at common output code

;OPNOUT - Open file for output
; This is called from IO statements to open
;a file for output. If the file already exists, it is superseded.

OPNOUT:
IF20,<	MOVX	T1,GJ%FOU>	;New generation (supersede also)
	PJRST	OPCMO		;Go to common code

;OPNIN - Open file for input
;  This is called from IO statements (but not OPEN) to open
;a file for input. The file must exist.

OPNIN:
IF20,<	MOVX	T1,GJ%OLD>	;"File must exist"
	PJRST	OPCMI		;Go to common input code
;OPNSCR - Open file if status=scratch

;This routine is called only from OPEN when STATUS='SCRATCH'.
;  A random filename is generated and the file must not exist.
;  It is opened for output.
IF10,<
OPNSCR:	PJRST	OPCMO		;Go to common output code
>
IF20,<				;TOPS-20 open scratch file routine
OPNSCR:	PUSHJ	P,%SAVE1	;Free up P1
	PUSHJ	P,GMODBY	;Get info based on /MODE
	MOVE	T2,[POINT 7,[ASCIZ/FOROTS-SCRATCH-FILE.TMP/]]
	SETZ	P1,		;Number of tries so far = 0
OPNTX0:	PUSHJ	P,GTSNAM	;Get a scratch name
	MOVX	T1,GJ%SHT!GJ%FOU ;Next generation number, pls
	GTJFN%			;Get handle on a temp file
	 ERJMP	OTME01		;Can't
	STORE	T1,OJFN(D)	;Store it
	STORE	T1,IJFN(D)
	MOVX	T3,D%RJN	;'Got a real JFN'
	IORM	T3,FLAGS(D)	;Set flag

;DO OPENF
	LOAD	T2,ACC(D)
	CAIN	T2,AC.RIO	;RANDOM?
	 JRST	OPSCR		;Yes, open for input and output
	MOVX	T2,OF%WR	;SEQINOUT - OPEN FOR OUTPUT ONLY
	OR	T2,DMBS(D)
	OPENF%
	 ERJMP	OTME02		;?Can't
	JRST	OPSCRA

OPSCR:	MOVX	T2,OF%RD+OF%WR	;Get initial bits for OPENF
	OR	T2,DMBS(D)	;Put in byte size
	OPENF%
	 ERJMP	OTME02		;?Can't
	JRST	OPSCRA

OPSCRA:	MOVX	T1,D%OUT	;Say "File is opened for output"
	IORM	T1,FLAGS(D)
	LOAD	T1,INDX(D)	;Get device index
	CAIE	T1,DI.DSK	;Skip if disk
	 JRST	OPSCRB		;Not DSK, skip UFPGS%
	LOAD	T1,OJFN(D)	;Get JFN
	HRLZ	T1,T1
	SETZ	T2,		;Update file pages to make the file appear
	UFPGS%
	 ERJMP	OTME03		;?can't
OPSCRB:	LOAD	T1,ACC(D)	;GET ACCESS
	MOVE	T2,ACCTAB(T1)	;Get bits to set in DDB flags
	IORM	T2,FLAGS(D)	; Set 'em
	PUSHJ	P,OPFSTT	;Do DSKSET, etc.
	 POPJ	P,		;Error, return .+1
	JRST	%POPJ1		;Success, return

;Here if can't get JFN for file

OTME01:	$ECALL	OPE,%ABORT	;Wierd OPEN error

;Here if OPENF% failed

OTME02:	CAIE	T1,OPNX9	;Invalid simultaneous access?
	 $ECALL	OPE,%ABORT	;No, take ERR= or abort
				; (No dialog if SCRATCH open fails!)

;OPENF% failed because of invalid simultanous access.
;Note that this should only happen if there are two users on the system
; and one has opened a file with the same name as this user but has not
; done an "UPFGS" JSYS yet. We will simply pick another name, try that,
; and if it continues to fail the same way we'll just give the error.

	ADDI	P1,1		;Increment number of tries
	CAILE	P1,5		;Tried too many times?
	 $ECALL	OPE,%ABORT	;Yes, go give the error
	LOAD	T1,OJFN(D)	;Get JFN
	RLJFN%
	 ERJMP	.+1		;This should never happen
	MOVX	T1,D%RJN	;Don't have a real JFN anymore
	ANDCAM	T1,FLAGS(D)	;Clear the DDB flag
	SETZ	T1,
	STORE	T1,OJFN(D)
	STORE	T1,IJFN(D)
	MOVEI	T1,^D100	;Sleep for a fraction of a second
	DISMS%
	GTAD%			;Return current date/time
	ANDI	T1,3		;Get random number 0 to 3
	MOVE	T2,OTMFNS(T1)	;Get a random filename
	JRST	OPNTX0		;Go try again

;Table of four random filenames

OTMFNS:	POINT 7,[ASCIZ/WXX.TMP/]
	POINT 7,[ASCIZ/XXX.TMP/]
	POINT 7,[ASCIZ/YXX.TMP/]
	POINT 7,[ASCIZ/ZXX.TMP/]

;Here if UPFGS% JSYS fails

OTME03:	$ECALL	OPE,%ABORT	;Type JSYS error, abort.
				; (or take ERR=)

;Routine to get a scratch name
;Call:
;	T2/ byte ptr to file name
;Return:
;	T2/ byte ptr to whole filespec

GTSNAM:	PUSH	P,T2		;Save ptr to name
	MOVE	T1,[POINT 7,SNAMEX]
	MOVE	T2,[POINT 7,DEV(D)]
	PUSHJ	P,CPYNUL	;Copy to null
	MOVEI	T3,":"		;Colon separator after device
	IDPB	T3,T1
	POP	P,T2		;Retrieve ptr to name
	LOAD	T3,INDX(D)	;Get device index
	CAIN	T3,DI.MTA	;Magtape?
	 JRST	GTSNDN		;Yes, done (no file name needed)
	PUSHJ	P,CPYNUL	; Append filename to string
	MOVE	T2,[POINT 7,[ASCIZ/.-1;T/]] ;Say "temp file"
	LOAD	T3,INDX(D)	;Device index again
	CAIN	T3,DI.DSK	;DSK?
	 PUSHJ	P,CPYNUL	;Yes, append ".-1;t" to string
GTSNDN:	SETZ	T3,		;Store null byte to end
	IDPB	T3,T1
	MOVE	T2,[POINT 7,SNAMEX] ;Get ptr to whole thing
	POPJ	P,		;And return

;Copy to null
;T1/ ptr to string to append to
;T2/ ptr to string to append
;Returns:
;T1/ updated string ptr.

CPYNUL:	ILDB	T3,T2		;Get a byte
	JUMPE	T3,%POPJ	;Jump when got a null
	IDPB	T3,T1		;Store it
	JRST	CPYNUL		;Loop

SEGMENT DATA
SNAMEX:	BLOCK	100		;ASCIZ scratch file name
SEGMENT CODE

>;END IF20
;%SETIN-- Get file opened for input
; If already open for input, just returns.
; If file has been opened for output, closes it.

%SETIN:	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNE	T1,D%IN		;File already opened for input?
	 POPJ	P,		;Yes, nothing to do

	TXNN	T1,D%OUT	;Skip if file opened for output
	 JRST	OPIN		;No, open for input
	TXZ	T1,D%IO		;(D%IO may have been set by OPENX for TTYs,
	MOVEM	T1,FLAGS(D)	; even if the statement was "READ")

;File is now opened for output.

SWIN:	LOAD	T1,ACC(D)	;Get access
	MOVE	T2,LOUTIN(T1)	;Switch direction to input
	PUSHJ	P,(T2)
	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXZ	T1,D%OUT	;Clear old direction flag
	TXO	T1,D%IN		;Set new direction flag
	MOVEM	T1,FLAGS(D)	;Set in DDB
	POPJ	P,		;Return

;Open file for input.

OPIN:	LOAD	T1,ACC(D)	;Get access
	MOVE	T2,NIOIN(T1)	;First READ routine
	PUSHJ	P,(T2)		;Do OPEN if necessary
	 JRST	FSTINF		;?Failed to OPEN file
	MOVX	T1,D%IN		;Set "File opened for input"
	IORM	T1,FLAGS(D)	; Set in DDB
	POPJ	P,		;Return

;First READ failed to OPEN file

FSTINF:	PUSHJ	P,OPENX		;Do generic OPEN
	JRST	%SETIN		;Go try again
;%SETOUT-- Get file opened for output
; If already open for output, just return.
; If file is read-only, give error (%ABORT).
; If file is open for input, closes it and opens for output.
;  (What happens in this case depends on the device).
;Returns .+1

%SETOUT: LOAD	T1,MODE(D)	;Get MODE
	CAIN	T1,MD.ASL	;'LINED'?
	 $ECALL	CWL,%ABORT	;Yes, can't do it.
	MOVE	T1,FLAGS(D)	;Get DDB flags now
	TXO	T1,D%IO		;Set "doing output"
	IORM	T1,FLAGS(D)
	TXNE	T1,D%OUT	;File already opened for output?
	  POPJ	P,		;Yes, nothing to do
	TXNN	T1,D%IN		;Skip if file was opened for input
	 JRST	OPOUT		;Open file for output

;File was open for input, switch to output

	LOAD	T1,ACC(D)	;Get access mode
	MOVE	T2,LINOUT(T1)	;Get routine
	PUSHJ	P,(T2)		;Set new direction
	MOVE	T1,FLAGS(D)	;Get DDB flags to change
	TXZ	T1,D%IN		;Clear input
	TXO	T1,D%OUT	;Set output
	MOVEM	T1,FLAGS(D)	;Set new flags
	POPJ	P,		;Done, return

;Open file for output. Supersede any file with same name.

OPOUT:	LOAD	T1,ACC(D)	;Get access
	MOVE	T2,NIOOUT(T1)	;First WRITE action
	PUSHJ	P,(T2)		;Call routine
	 JRST	FWTFAI		;?Failed, no ERR= taken.
	MOVX	T1,D%OUT	;Set output
	IORM	T1,FLAGS(D)
	POPJ	P,		;Return

;First WRITE failed to OPEN file.

FWTFAI:	PUSHJ	P,OPENX		;Generic OPEN again.
	JRST	%SETOUT		;And set output again.

ILLIN:	DMOVE	T1,[EXP [ASCIZ /read/],[ASCIZ /output/]]
	JRST	CDT

ILLOUT:	DMOVE	T1,[EXP [ASCIZ /write/],[ASCIZ /input/]]

CDT:	XMOVEI	T1,(T1)		;Section number in LH
	XMOVEI	T2,(T2)		;. .
;	IOERR	(CDT,31,502,?,Can't $A an $A-only file,<T1,T2>,%ABORT)
	$ECALL	CDT,%ABORT


;HERE TO FIND OUT WHAT TO DO IF LAST OPERATION WAS INPUT
;AND NEXT OPERATION IS INPUT, BY ACCESS TYPE
LININ:	%POPJ		;SEQINOUT
	%POPJ		;SEQIN
	%POPJ		;SEQOUT
	%POPJ		;SEQINOUT
	%POPJ		;RANDIN
	%POPJ		;RANDOM
	%POPJ		;APPEND

;HERE TO FIND OUT WHAT TO DO IF LAST OPERATION WAS INPUT
;AND NEXT OPERATION IS OUTPUT, BY ACCESS TYPE
LINOUT:	OSWTCH		;SEQINOUT
	ILLOUT		;SEQIN
	OSWTCH		;SEQOUT
	OSWTCH		;SEQINOUT
	ILLOUT		;RANDIN
	%POPJ		;RANDOM
	OSWTCH		;APPEND

;HERE TO FIND OUT WHAT TO DO IF LAST OPERATION WAS OUTPUT
;AND NEXT OPERATION IS INPUT, BY ACCESS TYPE
LOUTIN:	ISWTCH		;SEQINOUT
	ISWTCH		;SEQIN
	ISWTCH		;SEQOUT
	ISWTCH		;SEQINOUT
	%POPJ		;RANDIN
	%POPJ		;RANDOM
	ISWTCH		;APPEND

;HERE TO FIND OUT WHAT TO DO IF LAST OPERATION WAS OUTPUT
;AND NEXT OPERATION IS OUTPUT, BY ACCESS TYPE
LOUTOU:	%POPJ		;SEQINOUT
	ILLOUT		;SEQIN
	%POPJ		;SEQOUT
	%POPJ		;SEQINOUT
	ILLOUT		;RANDIN
	%POPJ		;RANDOM
	%POPJ		;APPEND

;HERE TO FIND OUT WHAT TO DO IF NO I/O DONE BEFORE
;AND NEXT OPERATION IS INPUT, BY ACCESS TYPE
NIOIN:	SEQIN		;SEQINOUT FIRST READ
	%POPJ1		;SEQIN
	NIOISW		;SEQOUT
	SEQIN		;SEQINOUT FIRST READ
	%POPJ1		;RANDIN
	%POPJ1		;RANDOM
	NIOISW		;APPEND

NIOISW:	PUSHJ	P,ISWTC1	;Switch to input
	JRST	%POPJ1		;Success return

;HERE TO FIND OUT WHAT TO DO IF NO I/O DONE BEFORE
;AND NEXT OPERATION IS OUTPUT, BY ACCESS TYPE
NIOOUT:	SEQOUT		;SEQINOUT FIRST WRITE
	ILLOUT		;SEQIN
	%POPJ1		;SEQOUT
	SEQOUT		;SEQINOUT FIRST WRITE
	ILLOUT		;RANDIN
	%POPJ1		;RANDOM
	%POPJ1		;APPEND
;SEQINOUT

;HERE WHEN FIRST OPERATION IS READ

SEQIN:
IF20,<	MOVX	T1,GJ%OLD>	;File must exist
IF10,<	MOVX	T1,D%IN>
	PUSHJ	P,DOOPEN	;Do the OPEN
	 POPJ	P,		;Error
	JRST	%POPJ1		;Successful OPEN, return .+2


;HERE WHEN FIRST OPERATION IS WRITE

SEQOUT:
IF20,<	MOVX	T1,GJ%FOU>	;Open new generation for output
IF10,<	MOVX	T1,D%OUT >
	PUSHJ	P,DOOPEN	;Do the OPEN
	 POPJ	P,		;Error
	JRST	%POPJ1		;Successful OPEN, return .+2
;HERE FOR SEQUENTIAL FILES  ON INPUT FOLLOWING OUTPUT.
;-20: JUST CLEAR THE BYTE COUNT, SPECIFYING EOF.
;
;-10: CLOSE THE FILE, REOPEN FOR INPUT, READ THE LAST
;BLOCK, POINT TO THE END OF THE BLOCK.
;
;-20 Note: DISK APPEND file is DI.OTHR. It is opened on TOPS-20 for
;APPEND access and cannot do input. But to be fast, FOROTS will not
;check and will just POPJ from this routine to set D%IN. Then
;when input is about to be done, ACCESS='APPEND' and DISK will
;cause an EOF error. REWIND and BACKSPACE are no-ops for disk APPEND files.

ISWTCH:
ISWTC1:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIN	T1,DI.DSK	;DISK?
	 JRST	DSKISW		;YES
	CAIN	T1,DI.MTA	;OR MTA
	 JRST	MTAISW		;YES
	POPJ	P,		;NO. NOTHING TO DO

IF20,<
DSKISW:	MOVE	T1,WSIZ(D)	;GET WINDOW SIZE
	SUB	T1,ICNT(D)	;GET # ACTIVE BYTES
	SKIPE	IPTR(D)		;IF WE WROTE ANY DATA
	 MOVEM	T1,WCNT(D)	;PRETEND WE READ THEM
	SETZM	ICNT(D)		;TELL DIREC WE'RE AT EOF!
	POPJ	P,
> ;IF20
IF10,<
DSKISW:
MTAISW:	PJRST	%ISET		;JUST LIKE A BACKSPACE, ALMOST
>; IF10
;HERE FOR OUTPUT FOLLOWING INPUT FOR ALL DEVICES.
;FOR DISK AND MAGTAPE, TRUNCATE FILE AT CURRENT INPUT POINTER,
;OPEN FOR OUTPUT, AND COPY THE DATA INTO THE OUTPUT BUFFER.

OSWTCH:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIN	T1,DI.DSK	;DISK
	 JRST	DSKOSW		;YES
	CAIN	T1,DI.MTA	;OR MTA
	 JRST	MTAOSW		;YES
	POPJ	P,		;OTHER

IF20,<
DSKOSW:	MOVE	T1,FLAGS(D)	;GET FLAGS
	TXZE	T1,D%END	;END OF FILE?
	 SOS	NREC(D)		;YES. DECR THE RECORD COUNT
	MOVEM	T1,FLAGS(D)	;SAVE FLAGS WITHOUT EOF
	PUSHJ	P,%SAVE3	;SAVE P ACS
	SKIPN	IPTR(D)		;Any IO done yet?
	 JRST	CHKWRT		;Maybe REWIND just done..
	MOVE	T1,BYTN(D)	;GET BYTE # OF NEXT WINDOW
	SUB	T1,ICNT(D)	;GET LAST BYTE IN USE
	MOVEM	T1,EOFN(D)	;SAVE AS EOF PNTR
	MOVE	T1,WSIZ(D)	;YES. GET SIZE OF WINDOW
	SUB	T1,WCNT(D)	;GET # UNUSED BYTES IN WINDOW
	ADDM	T1,OCNT(D)	;RESTORE FULL WINDOW SIZE
	MOVE	T1,FLAGS(D)	;Get DDB flags now
CHKWRT:	TXNN	T1,D%WRT	;Do we have WRITE access?
	 PUSHJ	P,CLSOUT	;No, CLOSE, reopen for OUTPUT
	MOVX	T1,D%WRT	;We have WRITE access now
	IORM	T1,FLAGS(D)
	POPJ	P,		;Return

CLSOUT:
	SETO	T1,		;SET TO UNMAP FILE FOR CLOSING
	MOVE	T2,WTAB(D)	;GET PAGE ID OF FILE WINDOW
	HRLI	T2,.FHSLF
	LOAD	T3,BUFCT(D)	;GET PAGE COUNT
	HRLI	T3,(PM%CNT)
	PMAP%

	LOAD	T1,IJFN(D)	;CLOSE FILE, KEEP JFN
	HRLI	T1,(CO%NRJ)
	CLOSF%
;	  IOERR	(OSW,30,,?,$J,,%ABORT)
	  $ECALL OSW,%ABORT

	LOAD	T1,OJFN(D)	;GET JFN BACK
	MOVE	T2,DMBS(D)	;GET DATA MODE AND BYTE SIZE
	TRO	T2,OF%RD+OF%WR	;GET READ+WRITE ACCESS
	OPENF%			;REOPEN FILE
;	  IOERR	(OSW,30,,?,$J,,%ABORT) ;CAN'T
	  $ECALL OSW,%ABORT

	HRRZ	P1,IPTR(D)	;GET PROCESS ADDRESS OF FILE POINTER
	JUMPE	P1,ZERPNT	;NO DATA NEEDED YET IF 0
	PUSHJ	P,%PTOF		;CONVERT TO FILE ADDRESS
	JUMPL	P1,ZERPNT	;IF NEG FILE POSITION, NO DATA NEEDED

	PUSH	P,P1		;SAVE FILE POSITION
	MOVE	P1,(P)		;GET FILE ADDRESS BACK
	PUSHJ	P,%FTOP		;MAP IT
	ADDI	P1,1		;MAPW LEFT US AT ADDR-1
	SUBI	P2,1		;AND WITH CURRENT WORD AS AVAILABLE
	HRRM	P1,IPTR(D)	;STORE ADDRESS IN FILE POINTER

	POP	P,P1		;GET FILE ADDRESS ONE MORE TIME
	ADDI	P1,1(P2)	;GET WORD NUMBER OF END+1 OF WINDOW
	LOAD	T1,BPW(D)	;GET BYTES PER WORD
	IMULI	P1,(T1)		;GET BYTE NUMBER OF END+1 OF WINDOW
	MOVEM	P1,BYTN(D)	;STORE FOR NXTW
	CAIG	T1,1		;UNFORMATTED?  (1 BYTE PER WORD)
	  JRST	[MOVEM P2,ICNT(D) ;YES, STORE WORDS LEFT
		 POPJ P,]

	HLL	P2,IPTR(D)	;PUT LH OF BYTE POINTER INTO P2
	MULI	P2,(T1)		;CONVERT BYTE POINTER TO BYTE COUNT IN RH(P3)
	ADDI	P3,(P2)		;ADD # BYTES LEFT IN WORD
	HRRZM	P3,ICNT(D)	;STORE NUMBER OF BYTES LEFT IN WINDOW
	POPJ	P,		;DONE

ZERPNT:	SETZM	IPTR(D)		;CLEAR PNTR/COUNT
	SETZM	ICNT(D)
	POPJ	P,

> ;IF20

IF10,<
DSKOSW:
MTAOSW:	LOAD	T1,DMODE(D)	;GET DATA MODE
	CAIE	T1,.IODMP	;DUMP?
	 JRST	OSNDMP		;NO
	SKIPN	BLKN(D)		;YES. NULL FILE?
	 PUSHJ	P,OSWDEL	;YES. DELETE FILE
	MOVX	T1,D%END	;Clear EOF if any
	ANDCAM	T1,FLAGS(D)
	SETZM	PATNUM		;SET FOR NO PATCHING
	PUSHJ	P,OSWREL	;Close file, release channel.
	PUSHJ	P,OSWUPD	;Truncate file where we are now.
	PJRST	OSWOPN		;OPEN FOR OUTPUT AGAIN

OSNDMP:	PUSHJ	P,OSWPAT	;RECORD DATA TO TRANSFER
	LOAD	T1,BUFAD(D)	;GET THE CURRENT BUFFER ADDRESS
	MOVEM	T1,PATBUF	;SAVE IT (MUST DEALLOCATE IT LATER)
	SKIPE	PATNUM		;ANY PATCHING TO DO
	 JRST	OSWNDL		;YES. CAN'T POSSIBLY BE NULL FILE
				;NO. CURRENT BLOCK HAS NO RELEVANT DATA
				;SO THAT ACTUAL BLOCK COUNT SHOULD
				;BE DECREMENTED, UNLESS IT'S ALREADY ZERO
	SKIPE	BLKN(D)		;IF # BLOCKS IN FILE ZERO
	 SOSG	BLKN(D)		;OR DECREMENTING IT MAKES IT ZERO
	  PUSHJ	P,OSWDEL	;DELETE FILE IF NO BLOCKS
OSWNDL:	PUSHJ	P,OSWREL	;RELEASE THE CHANNEL
	PUSHJ	P,OSWUPD	;TRUNCATE FILE, REWRITE LAST BLOCK
	PUSHJ	P,OSWOPN	;REOPEN FOR UPDATE MODE
	MOVE	T1,PATBUF	;GET THE OLD BUFFER SET
	PJRST	%FREBLK		;DEALLOCATE IT

OSWPAT:	SETZM	PATNUM		;INIT # OF PATCH WORDS
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	MOVE	T2,FLAGS(D)	;Get DDB flags
	TXZN	T2,D%END	;Clear EOF, skip if it was on.
	 JRST	NOBACK		;No. Don't back over EOF
	MOVEM	T2,FLAGS(D)	;Remember we cleared EOF
	CAIN	T1,DI.DSK	;DISK?
	 JRST	YESBAK		;YES. GO BACK OVER IT
	SETZM	BLKN(D)		;NO. WRITING A NEW FILE
	MOVEI	T1,1		;START RECORD COUNTER FRESH ALSO
	MOVEM	T1,NREC(D)
	POPJ	P,

YESBAK:	PUSHJ	P,%BAKEF	;BACK OVER EOF
	SOS	NREC(D)		;DECR THE RECORD COUNT
NOBACK:	SKIPN	BLKN(D)		;NULL FILE?
	 POPJ	P,		;YES. NOTHING MORE TO DO
	MOVE	T1,IPTR(D)	;SAVE AWAY THE PNTR
	MOVEM	T1,PATPNT
	LOAD	T2,BPW(D)	;GET THE # BYTES/WORD
	MOVE	T1,IBCB(D)	;GET THE BUFFER HEADER PNTR
	HRRZ	T1,1(T1)	;GET THE # WORDS IN THIS BUFFER
	JUMPE	T1,NOPAT	;IF ZERO, NO PATCHING TO DO
	IMULI	T1,(T2)		;GET THE # BYTES IN THIS BUFFER
	SUB	T1,ICNT(D)	;GET THE # BYTES USED
	MOVEM	T1,PATCNT	;SAVE FOR LATER
	LOAD	T2,MODE(D)	;GET FILE MODE
	CAIE	T2,MD.ASC	;ASCII?
	 JRST	WORDS		;NO
	MOVE	T2,IPTR(D)	;GET BYTE PNTR
	SETZ	T3,		;WE HAVE TO CLEAR SOME BYTES(ARGH!!!)
ZBYTLP:	TLNN	T2,760000	;LAST BYTE?
	 JRST	DEPBP
	IDPB	T3,T2		;NO. DEPOSIT A NULL
	JRST	ZBYTLP		;THIS WILL NOT WORK FOR XTENDED ADDRESS
DEPBP:	MOVEM	T2,IPTR(D)	;SAVE THE NEW B.P.
WORDS:	HRRZ	T3,IPTR(D)	;GET ADDR OF LAST BYTE
	HRRZ	T2,IBCB(D)	;GET ADDRESS OF BUFFER
	SUBI	T3,1(T2)	;GET NUMBER OF WORDS
	MOVEM	T3,PATNUM	;SAVE FOR DUMP MODE WRITE LATER
	ADDI	T2,2		;SAVE ADDR OF ACTUAL BUFFER
	MOVEM	T2,PATADD	;SAVE ADDRESS ALSO
NOPAT:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIE	T1,DI.MTA	;MAGTAPE?
	 POPJ	P,		;NO. WE'RE DONE
	PUSHJ	P,%CLRBC	;COUNT ACTIVE BUFFERS
	PUSH	P,P4		;Get a spare perm AC
	MOVE	P4,T1		;Get # of active buffers
OSWBKL:	PUSHJ	P,%BACKB
	SOJG	P4,OSWBKL	;BACKSPACE OVER THEM
	POP	P,P4		;Restore P4
	POPJ	P,

OSWDEL:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIE	T1,DI.DSK	;DISK?
	 POPJ	P,		;NO. DON'T DELETE THE MAGTAPE
	MOVEI	T1,.FODLT	;DELETE THE FILE
	HRRM	T1,FBLK(D)	;USING THE FULL FILOP BLOCK
	MOVEI	T1,FBLK(D)
	HRLI	T1,FLEN
	FILOP.	T1,
;	 IOERR	(OSW,,,?,$E,<T1>,%ABORT)
	 $ECALL OSW,%ABORT
	POPJ	P,

OSWREL:	MOVE	T2,FBLK(D)	;GET CHANNEL STUFF
	HRRI	T2,.FOCLS	;CLOSE THE FILE
	MOVE	T1,[1,,T2]	;WITH A FILOP
	FILOP.	T1,
	 PUSHJ	P,CLSERR
	MOVE	T2,FBLK(D)
	HRRI	T2,.FOREL	; AND RELEASE THE FILE
	MOVE	T1,[1,,T2]	;WITH A FILOP
	FILOP.	T1,
	 PUSHJ	P,CLSERR
	POPJ	P,

OSWUPD:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIE	T1,DI.MTA	;MAGTAPE?
	 SKIPN	T1,BLKN(D)	;OR NULL FILE?
	  POPJ	P,		;YES. NOTHING TO UPDATE
	MOVEM	T1,LKPB+.RBALC(D)
	MOVE	T1,[FO.PRV+FO.ASC+.FOSAU] ;UPDATE MODE
	MOVEM	T1,FBLK(D)	;STORE IN FILOP BLOCK
	PUSH	P,FBLK+.FOIOS(D) ;SAVE THE OLD MODE
	MOVEI	T1,17		;SET TO DUMP MODE
	MOVEM	T1,FBLK+.FOIOS(D)
	SETZM	FBLK+.FOBRH(D)	;CLEAR THE BLOCK HEADERS
	SETZM	FBLK+.FONBF(D)	;AND # BUFFERS
	MOVEI	T1,FBLK(D)	;SETUP FOR OPEN
	HRLI	T1,FLEN
	FILOP.	T1,
;	 IOERR	(OSW,,,?,$E,<T1>)
	 $ECALL	OSW,%ABORT

	SKIPN	PATNUM		;ANYTHING TO WRITE?
	 JRST	NDUMP		;NO
	MOVE	T3,BLKN(D)	;GET BLOCK # OF LAST BLOCK
	HLLZ	T2,FBLK(D)	;SETUP FOR USETO
	HRRI	T2,.FOUSO
	MOVE	T1,[2,,T2]
	FILOP.	T1,		;SET TO LAST BLOCK
;	 IOERR	(OSW,,,?,$E,<T1>,%ABORT)
	 $ECALL	OSW,%ABORT	;Must be there.

	MOVN	T1,PATNUM	;GET # WORDS TO WRITE
	HRLZI	T1,(T1)		;IN IOWD
	HRR	T1,PATADD
	SUBI	T1,1
	MOVEM	T1,OLST		;SETUP OUTPUT LIST
	SETZM	OLST+1
	MOVEI	T3,OLST		;SETUP TO DO OUTPUT
	MOVE	T2,FBLK(D)	;GET CHANNEL STUFF
	HRRI	T2,.FOOUT
	MOVE	T1,[2,,T2]	;DO THE FILOP
	FILOP.	T1,
;	 IOERR	(OSW,,,?,$E,<T1>)
	 $ECALL	OSW,%ABORT

NDUMP:	MOVE	T2,FBLK(D)	;GET CHANNEL STUFF
	HRRI	T2,.FOCLS	;CLOSE THE FILE
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 PUSHJ	P,CLSERR
	MOVE	T2,FBLK(D)
	HRRI	T2,.FOREL	;RELEASE THE FILE
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 PUSHJ	P,CLSERR
	POP	P,FBLK+.FOIOS(D) ;RESTORE OLD DATA MODE
	POPJ	P,

OSWOPN:	PUSHJ	P,%SAVE1	;Uses P1
	MOVE	T1,[FO.PRV+FO.ASC+.FOSAU] ;UPDATE MODE
	MOVEM	T1,FBLK(D)	;STORE IN FILOP BLOCK
	SETZM	LKPB+.RBALC(D)	;DON'T RESET THE BLOCK COUNT
	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXZ	T1,D%IN		;Clear the input bit
	TXO	T1,D%IO		;Set for output direction
	MOVEM	T1,FLAGS(D)	;Store updated flags
	MOVX	T1,D%OUT	;Set for output only
	PUSHJ	P,ALLBUF	;AND ALLOCATE BUFFERS
	PUSHJ	P,DOFLP		;Now do the FILOP.
	 JRST	[PUSHJ P,FLPFL	;Give error, FILOP failed
		JRST %ABORT]	;Forget DIALOG.
	SKIPN	T3,BLKN(D)	;GET BLOCK # OF LAST BLOCK
	 POPJ	P,		;DON'T PROCEED IF NO DATA!
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIE	T1,DI.DSK	;DISK?
	 JRST	OSWMOP		;NO. MAGTAPE
	SKIPN	PATNUM		;ANY PATCHING IN THIS BLOCK?
	 ADDI	T3,1		;NO. THEN WE WANT BEG OF NEXT ONE!
	HLLZ	T2,FBLK(D)	;SETUP FOR USETO
	HRRI	T2,.FOUSO
	MOVE	T1,[2,,T2]
	FILOP.	T1,		;SET TO LAST BLOCK
	 PUSHJ	P,CLSERR	;MIGHT NOT BE THERE
OSWMOP:	SKIPN	PATNUM		;ANYTHING TO BLT?
	 POPJ	P,		;NO. DON'T DO INITIAL OUTPUT
	MOVE	T2,FBLK(D)	;DO INITIAL OUTPUT
	HRRI	T2,.FOOUT
	MOVE	T1,[1,,T2]
	FILOP.	T1,
;	 IOERR	(OSW,,,?,$E,<T1>)
	 $ECALL	OSW,%ABORT
	HRLZ	T1,PATADD	;NOW BLT THE DATA TO THE NEW BLOCK
	HRR	T1,OPTR(D)
	ADDI	T1,1
	HRRZ	T2,OPTR(D)
	ADD	T2,PATNUM
	BLT	T1,(T2)
	MOVE	T1,PATPNT	;NOW FIX UP THE PNTR/COUNT
	HLLM	T1,OPTR(D)	;PNTR FIXUP
	MOVE	T1,PATNUM	;AND ADDR FIXUP
	ADDM	T1,OPTR(D)
	MOVN	T1,PATCNT	;GET NEG # BYTES USED
	ADDM	T1,OCNT(D)	;UPDATE THE COUNT
	POPJ	P,

%LSTBF:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIE	T1,DI.MTA	;MAGTAPE?
	 POPJ	P,		;NO. -10 CLOSE WRITES LAST BUFFER
	MOVE	T2,CHAN(D)	;BUT FOR MTA A TAPE MARK
	HRRI	T2,.FOOUT	;WON'T GET WRITTEN
	MOVE	T1,[1,,T2]	;UNLESS AN INITIAL OUTPUT IS DONE
	FILOP.	T1,
	 $ECALL	IOE		;ERROR. DIE
	POPJ	P,

>;END IF10

	SEGMENT	DATA

IF10,<

PATADD:	BLOCK	1		;ADDRESS OF DATA TO DUMP
PATNUM:	BLOCK	1		;NUMBER OF WORDS TO DUMP
PATPNT:	BLOCK	1		;PNTR OF OLD BUFFER
PATCNT:	BLOCK	1		;COUNT OF BYTES USED IN OLD BUFFER
PATBUF:	BLOCK	1		;BUFFER BLOCK ALLOCATED
OLST:	BLOCK	2		;DUMP I/O LIST

>;END IF10

	SEGMENT	CODE
IF20,<

;HERE FOR SEQINOUT MTA ONLY ON READ WHEN FILE IS OPEN FOR OUTPUT

MTAISW:	PUSHJ	P,%LSTBF	;WRITE LAST BUFFER
	MOVE	T1,WSIZ(D)	;GET WINDOW SIZE
	SUB	T1,ICNT(D)	;GET # ACTIVE BYTES
	SKIPE	IPTR(D)		;IF WE WROTE ANY DATA
	 MOVEM	T1,WCNT(D)	;PRETEND WE READ THEM
	SETZM	ICNT(D)		;BUFFER HAS NO MORE BYTES IN IT
	PUSHJ	P,CLSOPN	;CLOSE FILE, OPEN FOR INPUT

	LOAD	T1,IJFN(D)	;%LSTBF (ABOVE) WROTE AN EOF MARK, BACK OVER IT
	MOVEI	T2,.MONOP	;FIRST WAIT FOR I/O TO STOP
	MTOPR%

	MOVEI	T2,.MOBKR	;DO THE BACKSPACE
	MTOPR%

	MOVEI	T2,.MONOP	;WAIT FOR TAPE TO STOP
	MTOPR%

	POPJ	P,		;DONE

%LSTBF:	PUSHJ	P,%SAVE2	;SAVE P1,P2
	DMOVE	P1,OPTR(D)	;GET PNTR/COUNT
	JUMPE	P1,LSBCLS	;IF NO I/O YET, NOTHING MUCH TO DO
	XMOVEI	T1,(P1)		;GET JUST ADDRESS OF LAST DATA
	CAMGE	T1,WADR(D)	;ANY DATA IN WINDOW?
	 JRST	LSBCLS		;NO. JUST WRITE EOF MARK
	LOAD	T1,IJFN(D)	;GET JFN
	HRRO	T2,WADR(D)	;GET BUFFER ADDR
	MOVE	T3,FLAGS(D)	;Unformatted?
	TXNE	T3,D%UNF	; ?
	 HRLI	T2,(POINT 36)	;YES. GET 36-BIT PNTR
	MOVN	T3,WSIZ(D)	;GET WINDOW SIZE
	JUMPLE	P2,.+2		;IF MIDDLE OF WINDOW, DECREMENT BYTE COUNT
	ADD	T3,P2
	SOUTR%			;OUTPUT THE BUFFER
LSBCLS:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIE	T1,DI.MTA	;MAGTAPE?
	 POPJ	P,		;NO
	LOAD	T1,IJFN(D)	;GET JFN AGAIN
	MOVEI	T2,.MONOP	;WAIT FOR I/O TO STOP
	MTOPR%
	MOVEI	T2,.MOEOF	;WRITE AN EOF MARK
	MTOPR%
	MOVEI	T2,.MONOP	;AND WAIT AGAIN
	MTOPR%
	POPJ	P,
%CLSOP:
CLSOPN:	LOAD	T1,OJFN(D)	;CLOSE FILE
	HRLI	T1,(CO%NRJ)	;KEEP JFN
	CLOSF%
;	  IOERR	(ISW,31,,?,$J,,%ABORT)
	  $ECALL ISW,%ABORT

	LOAD	T1,IJFN(D)	;GET JFN AGAIN (WITHOUT BITS IN LH)
	MOVE	T2,DMBS(D)	;GET DATA MODE & BYTE SIZE FOR OPENF
	TRO	T2,OF%RD	;SET FOR INPUT
	OPENF%			;REOPEN FILE
	 $ECALL	ISW,%ABORT
	POPJ	P,


;HERE FOR SEQINOUT MTA ONLY ON WRITE WHEN TAPE IS OPEN FOR INPUT

MTAOSW:	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXZN	T1,D%END	;CLEAR ALL EOF BITS
	 JRST	MTANEF		;NOT AT EOF
	MOVEM	T1,FLAGS(D)	;Remember we cleared the EOF flag
	SETZM	BLKN(D)		;IF IT WAS EOF, NEW FILE!
	MOVEI	T1,1		;SET RECORD NUMBER FRESH ALSO
	MOVEM	T1,NREC(D)
	JRST	MTACLO		;AND JUST GO CLOSE AND REOPEN

MTANEF:	SKIPN	IPTR(D)		;ANY I/O DONE YET?
	 JRST	MTACLO		;NO. GO CLOSE, OPEN
	LOAD	T1,IJFN(D)	;GET JFN
	MOVEI	T2,.MONOP	;WAIT FOR I/O TO FINISH
	MTOPR%
	MOVEI	T2,.MOBKR	;BACKSPACE RECORD
	MTOPR%
	MOVEI	T2,.MONOP	;AND WAIT FOR IT TO FINISH AGAIN
	MTOPR%
	MOVE	T1,WSIZ(D)	;GET WINDOW SIZE
	SUB	T1,WCNT(D)	;GET UNUSED BYTES IN WINDOW
	ADDM	T1,OCNT(D)	;RESTORE FULL WINDOW SIZE

MTACLO:	LOAD	T1,IJFN(D)	;REOPEN FILE FOR OUTPUT
	HRLI	T1,(CO%NRJ)
	CLOSF%
	 $ECALL	OSW,%ABORT
	LOAD	T1,OJFN(D)
	MOVE	T2,DMBS(D)
	TRO	T2,OF%WR
	OPENF%
	 $ECALL	OSW,%ABORT
	POPJ	P,

>;END IF20
	SUBTTL	MOVE ARGUMENTS TO DDB

;** Warning: Uses P1-P4

OPNARG:	PUSHJ	P,DFDEV		;Setup default device
	PUSHJ	P,DFFILE	; and filename for this unit

OARGLP:	LDB	P1,[POINTR @%LTYPE,ARGKWD] ;GET NEXT ARG KEYWORD
	CAILE	P1,OPNMAX	;RANGE CHECK
	  SKIPA	T1,[OPNERR]	;OUT OF BOUNDS, ERROR
	HLRZ	T1,OPNDSP(P1)	;POINT TO ROUTINE FOR THIS ARG
IF10,<
	MOVE	T2,OPARGN(P1)	;Get address of ASCIZ arg name
	MOVEM	T2,%ARGNM	; To type incase errors
>
	PUSHJ	P,(T1)		;PUT ARG INTO DDB
	AOBJN	L,OARGLP	;GO DO NEXT ARG
	POPJ	P,		;ALL DONE, RETURN

;Here is the routine for CLOSE

CLSARG:	PUSHJ	P,DFDEV		;Setup default device
	PUSHJ	P,DFFILE	; and filename for this unit

CLARGL:	LDB	P1,[POINTR @%LTYPE,ARGKWD] ;Get next arg keyword
	CAILE	P1,OPNMAX	;Range check
	 SKIPA	T1,[OPNERR]	;Out of bounds, error
	HLRZ	T1,CLSDSP(P1)	;Point to routine for this arg
	PUSHJ	P,(T1)		;Call routine
	AOBJN	L,CLARGL	;Go do next arg
	POPJ	P,		;All done, return

;Routine to call when an OPEN arg is used in CLOSE but it is meaningless.

CLIGN:	MOVE	T1,P1		;Get switch number
	MOVEI	T2,OPNSWT	;Switch table
	PUSHJ	P,FNDSWT	;Get t1= addr of ASCII arg.
	$ECALL	NCK,%POPJ	;?Not a CLOSE keyword, ignored

;UNIT=
OPNUNT:	POPJ	P,		;Return (we've already range-checked it
				;        and put it in unit block).
	
OPNKWD:
IF20,<
	XMOVEI	T1,ATMBUF	;MOVE ARG TO ATMBUF
	PUSHJ	P,MVARG
>
IF10,<
	PUSHJ	P,MAKEBP	;Get BP to arg in %SRCBP
	PUSHJ	P,PRSSWV	;Parse the switch value
	 JRST	REQDIA		;?Error, request DIALOG
>
	HRRZ	T1,OPNDSP(P1)	;POINT TO KEYWORD TABLE
	HRROI	T2,ATMBUF	;POINT TO KEYWORD
	PUSHJ	P,TABLK		;LOOK UP KEYWORD IN TABLE
	  JRST	KWDUNK		;NOT THERE
	  JRST	KWDAMB		;AMBIGUOUS
	HRRZ	T2,(T1)		;GET VALUE
	JRST	OPNDPB		;GO STORE IT IN DDB

;Keyword recognizer for CLOSE keywords

CLSKWD:
IF20,<
	XMOVEI	T1,ATMBUF	;MOVE ARG TO ATMBUF
	PUSHJ	P,MVARG
>
IF10,<
	PUSHJ	P,MAKEBP	;Get BP to arg in %SRCBP
	PUSHJ	P,PRSSWV	;Parse the switch value
	 JRST	REQDIA		;?Error, request DIALOG
>
	HRRZ	T1,CLSDSP(P1)	;POINT TO KEYWORD TABLE
	HRROI	T2,ATMBUF	;POINT TO KEYWORD
	PUSHJ	P,TABLK		;LOOK UP KEYWORD IN TABLE
	  JRST	KWDUNK		;NOT THERE
	  JRST	KWDAMB		;AMBIGUOUS
	HRRZ	T2,(T1)		;GET VALUE
	JRST	OPNDPB		;GO STORE IT IN DDB

OPNERR:; IOERR	(UOA,30,503,%,<Unknown OPEN keyword $D, ignored>,<P1>,%POPJ)
	$ECALL	UOA,%POPJ

KWDUNK:	XMOVEI	P2,[ASCIZ /Unknown/]
	 TRNA
KWDAMB:	XMOVEI	P2,[ASCIZ /Ambiguous/]
	MOVEI	T1,(P1)		;GET KWD NUMBER
	MOVEI	T2,OPNSWT	;POINT TO SWITCH TABLE
	PUSHJ	P,FNDSWT	;FIND ASCII NAME OF SWITCH
	XMOVEI	T5,ATMBUF	;Point to atom buffer
;	IOERR	(ESV,30,241,?,$A keyword value /$Z$Z,<P2,T1,[ATMBUF]>,REQDIA)
	$ECALL	ESV,REQDIA

OPNINT:	MOVE	T2,@(L)		;GET ARG
	JRST	OPNDPB		;Go store it in DDB
OPNADR:	XMOVEI	T2,@0(L)	;Get arg address
	JRST	OPNDPB		;GO STORE IT IN DDB

OPNSET:	SKIPA	T2,[1]		;GET A TURNED-ON BIT
OPNCHR:	LDB	T2,[POINT 7,@(L),6] ;GET FIRST CHAR OF STRING
OPNDPB:	XCT	OPSTOR(P1)	;STORE IN DDB
	POPJ	P,		;RETURN
;Get next char from source string
;Returns char in T1

DPRCHR:	PUSHJ	P,DPRCHS	;Get char
	CAIN	T1," "		;Ignore spaces
	 JRST	DPRCHR
	POPJ	P,		;Return

;Same as DPRCHR but space not ignored
;P4= # chars possibly left to parse

DPRCHS:	SOJL	P4,DPRNUL	;Return null if string ran out
	ILDB	T1,SRCBP
	AOS	%NCHRR
	POPJ	P,		;Return
DPRNUL:	SETZ	T1,
	POPJ	P,
OPNDEV:	PUSHJ	P,MAKEBP	;Setup SRCBP, %NCHRR, P4
	PUSHJ	P,PRSDEV	;Parse the device name
	 JRST	REQDIA		;?Error, request dialog
	TXO	F,F%DSS		;Remember device specified
IF10,<
	MOVE	T1,ATMBUF	;Put in DEV(D)
	MOVEM	T1,DEV(D)
>
IF20,<
	MOVE	T1,[POINT 7,ATMBUF]
	MOVE	T2,[POINT 7,DEV(D)]
	ILDB	T3,T1
	IDPB	T3,T2
	JUMPN	T3,.-2
>
	TXO	F,F%DSS		;Remember device specified
	POPJ	P,		;Return


IF10,<
PRSDEV:	MOVE	T3,[POINT 6,ATMBUF] ;Store sixbit in atom buffer
	SETZM	ATMBUF
PRSDV1:	PUSHJ	P,DPRCHS	;Get next char
	JUMPE	T1,%POPJ1	;end ok
	CAIE	T1," "		;Space is legal end
	CAIN	T1,":"		;Colon ends
	 JRST	%POPJ1
	PUSHJ	P,DPRCSX	;Else must be plain sixbit char
	 POPJ	P,		;?Problem, return .+1
	TLNE	T3,770000	;Room?
	 IDPB	T1,T3		;Yes, store char
	JRST	PRSDV1		;Loop until end
>;END IF10
IF20,<
PRSDEV:	MOVE	T3,[POINT 7,ATMBUF]
PRSDV1:	PUSHJ	P,DPRCHS	;Get char
	JUMPE	T1,PRSDVE	;End
	CAIE	T1," "		;Space
	CAIN	T1,":"		;or colon
	 JRST	PRSDVE		;Is ok end
	IDPB	T1,T3		;Store char
	JRST	PRSDV1		;Loop
PRSDVE:	SETZ	T1,		;Store null to end
	IDPB	T1,T3
	JRST	%POPJ1		;Return ok
>;END IF20
IF20,< ;to be fixed later..
OPNFIL:	TXO	F,F%FSS		;Remember filespec stuff supplied
	XMOVEI	T1,FILE(D)	;POINT TO PLACE TO PUT FILENAME
	MOVX	T2,1_'.'	;TERMINATE ON DOT
	PUSHJ	P,MVARGX	;MOVE FILENAME TO DDB
	CAIE	T1,"."		;WAS IT TERMINATED BY DOT?
	  POPJ	P,		;NO, THAT'S IT
	TXO	F,F%EXT		;REMEMBER EXTENSION SPECIFIED
	XMOVEI	T1,EXT(D)	;POINT TO PLACE FOR EXTENSION
	MOVX	T2,1_'.'	;TERMINATE ON DOT
	PUSHJ	P,MOVARG	;MOVE EXT TO DDB

IF20,<
	CAIE	T1,"."		;GENERATION NUMBER SPECIFIED?
	  POPJ	P,		;NO, DONE

	XMOVEI	T1,ATMBUF	;POINT TO DEST FOR GENERATION NUMBER
	PUSHJ	P,MOVARG	;MOVE IT THERE
	MOVEI	T1,ATMBUF	;POINT TO IT AGAIN
	PUSHJ	P,ASCDEC	;CONVERT IT TO BINARY
;	  ERR	(IGN,?,Illegal generation number $A,<0(L)>)
	 $ECALL	IGN,REQDIA
	JUMPL	T1,GENNOK	;Jump if -n
	TLNE	T1,-1		;IN RANGE?
	 $ECALL	IGN,REQDIA	;No
GENNOK:	HRRZM	T1,xGEN(D)	;Store in DDB
>

	POPJ	P,		;DONE
>;END IF20 to be done later..
IF10,<
OPNFIL:	PUSHJ	P,MAKEBP	;Setup SRCBP
	PUSHJ	P,PRSFIL	;Parse the file info
	 JRST	REQDIA		;?Error, request dialog
	POPJ	P,		;Ok, return

PRSFIL:	PUSHJ	P,DPRFNM	;Parse filename
	 POPJ	P,		;?failed
	MOVE	T2,ATMBUF	;Get atom (sixbit filename)
	MOVEM	T2,FILE(D)	;Store filename
	TXO	F,F%FSS		;Remember filespec stuff
	CAIE	T1," "		;Space
	CAIN	T1,0		; or null
	 JRST	%POPJ1		;means we're done.
	CAIE	T1,"."		;Must be "." then
	  $SNH
	TXO	F,F%EXT		;Remember extension specified
	PUSHJ	P,DPRFEX	;Parse extension
	 POPJ	P,		;?Ill char
	HLLZ	T2,ATMBUF	;Get atom (sixbit ext.)
	HLLZM	T2,EXT(D)	;Store it
	JRST	%POPJ1		;Return ok

;Parse a filename

DPRFNM:	MOVE	T3,[POINT 6,ATMBUF]
	SETZM	ATMBUF		;Ready for filename
DPRFN1:	PUSHJ	P,DPRCHS	;Get char
	JUMPE	T1,%POPJ1	;Null ok end
	CAIE	T1," "		;Also space
	CAIN	T1,"."		; and dot (start of ext.)
	 JRST	%POPJ1		;Done
	PUSHJ	P,DPRCSX	;Else must be sixbit
	 POPJ	P,		;?no, error
	TLNE	T3,770000	;Store char if we can
	 IDPB	T1,T3
	JRST	DPRFN1		;Loop

;Parse a file extension

DPRFEX:	MOVE	T3,[POINT 6,ATMBUF]
	SETZM	ATMBUF		;Ready for filename
DPRFX1:	PUSHJ	P,DPRCHS	;Get char
	CAIE	T1," "
	CAIN	T1,0		;Space or null ok
	 JRST	%POPJ1
	PUSHJ	P,DPRCSX	;Else must be sixbit
	 POPJ	P,		;?no, error
	TLNE	T3,770000	;Room?
	 IDPB	T1,T3		;Yes, store char
	JRST	DPRFX1		;Loop
>;END IF10
IF20,<

OPNDIR:	TXO	F,F%FSS		;Remember filespec stuff
	MOVE	T1,@(L)		;GET FIRST WORD OF ARG
	TLNN	T1,(177B6)	;LEADING ASCII CHAR NULL?
	  JRST	OPNPPN		;YES, IT'S A PPN

	XMOVEI	T1,DIR(D)	;POINT TO PLACE TO STORE STRING
	MOVEI	T2,1		;Break at first space
	PUSHJ	P,MAKEBP	;CREATE SOURCE/DEST BP
	MOVEI	P4,^D79		;UP TO DEST SIZE
	PJRST	MOVARG		;GO TRANSFER ARG

OPNPPN:	TLNE	T1,-1		;PROJECT NUMBER IN LH?
	  JRST	OPNPP1		;YES, XWD FORMAT
	HRLZ	T1,T1		;No, doubleword format
	AOS	(L)		;BUMP TO SECOND WORD
	HRR	T1,@(L)		;PUT IN PROGRAMMER NUMBER

OPNPP1:	JUMPE	T1,%POPJ	;ZERO MEANS "DEFAULT PATH"
	MOVEM	T1,DIR(D)	;STORE PPN
	TXO	F,F%PPN		;REMEMBER IT'S A PPN, NOT A STRING
	POPJ	P,		;DONE

>;END IF20
IF10,<

OPNDIR:	TXO	F,F%FSS		;Remember he supplied filespec info
	PUSHJ	P,%SAVE3	;SAVE P1-P2
	LDB	T1,[POINTR @%LTYPE,ARGTYP] ;GET ARG TYPE
	CAIN	T1,TP%LIT	;ASCIZ LITERAL?
	  JRST	OPPNST		;YES
	MOVE	P1,%SIZTB(T1)	;GET ELEMENT SIZE IN WORDS

	MOVE	T1,@(L)		;GET FIRST WORD OF ARG
	TLNE	T1,-1		;PROJECT NUMBER IN LH?
	  JRST	OPNPP1		;YES, XWD FORMAT
	HRLZ	T1,T1		;NO, DOUBLEWORD FORMAT
	AOS	(L)		;BUMP TO SECOND WORD
	HRR	T1,@(L)		;PUT IN PROGRAMMER NUMBER

OPNPP1:	JUMPE	T1,%POPJ	;ZERO MEANS DEFAULT PATH
	MOVEM	T1,PTHB+.PTPPN(D) ;STORE PPN

	MOVEI	P2,.PTPPN+1	;POINT TO PLACE FOR FIRST SFD
	MOVEI	P3,5		;Max # SFD's.
	AOSA	(L)		;BUMP PAST PPN WORD
OPPNLP:	ADDM	P1,(L)		;BUMP TO NEXT ARGUMENT
	SKIPN	@(L)		;END OF LIST?
	  POPJ	P,		;YES, DONE
	XMOVEI	T1,PTHB(D)	;POINT TO PATH BLOCK
	ADDI	T1,(P2)		;POINT TO DEST FOR SFD NAME
	PUSHJ	P,MVARG		;MOVE SFD NAME INTO PATH BLOCK
	SOJLE	P3,%POPJ	;If done 5 SFD's, return now.
	AOJA	P2,OPPNLP	;COPY WHOLE THING

OPPNST:	PUSHJ	P,MAKEBP	;Get SRCBP= BP to arg.
	PUSHJ	P,DPTH		;Go parse path
	 JRST	REQDIA		;Error, go request dialog
	POPJ	P,		;Success, return

>;END IF10
IF20,<

SETPROT: TXO	F,F%FSS		;Remember he typed filespec info
	HRLZ	T1,T2		;Put binary protection in LH
	MOVEI	T0,6		;GET DIGIT COUNT
	MOVEI	T3,PROT(D)	;POINT TO PROTECTION BUFFER
	HRLI	T3,(POINT 7,)	; FOR CONVERSION TO ASCIZ

PRTLP:	MOVEI	T2,"0"_-3	;GET HALF A DIGIT
	ROTC	T1,3		;GET OTHER HALF DIGIT FROM PROT
	IDPB	T2,T3		;STORE IN BUFFER
	SOJG	T0,PRTLP	;DO 6 DIGITS

	SETZ	T2,		;TERMINATE WITH NULL
	IDPB	T2,T3
	POPJ	P,

>

IF10,<

SETPROT: TXO	F,F%FSS		;Remember he typed filespec info
	DPB	T2,[POINTR (PROT(D),RB.PRV)] ;STORE IN DDB
	POPJ	P,

>
OPNDIA:	XMOVEI	P3,@0(L)	;Get arg address
	JUMPE	P3,RQDIAX	;IF DIALOG WITHOUT ARGUMENT, GO REQUEST DIALOG

	TXO	F,F%DSTRG	;SET DIALOG FROM STRING
	MOVEM	P3,DIASAG	;Save DIALOG string arg.
	LDB	T1,[POINTR @%LTYPE,ARGTYP] ;Get arg type
	MOVEM	T1,DIASAT	;Save arg type
	POPJ	P,		;Return for more args.

IF20,<

;PUSHJ HERE AFTER CSB INITIALIZED TO MOVE DIALOG ARG TO TEXTI BUFFER

DIABLT:	$BLDBP	P3		;Get 7-bit byte ptr in P3
	MOVEM	P3,SRCBP	;Store BP to arg
	MOVEI	P4,LTEXT*5-1	;MAX STRING LENGTH IS SIZE OF BUFFER
	XMOVEI	T1,TXTBUF	;POINT TO BUFFER
	MOVX	T2,1_' '	;DIALOG STRING IS TERMINATED BY SPACE
	MOVE	T3,DIASAT	;Get arg type
	CAIN	T3,TP%LIT	;IS IT ASCIZ?
	  SETZ	T2,		;YES, IT CAN INCLUDE IMBEDDED SPACES
	PUSHJ	P,MOVARG	;MOVE ARG TO BUFFER

	JUMPGE	T2,.+2		;DID MOVARG TERMINATE NORMALLY?
;	  ERR	(DTL,?,Dialog string too long) ;NO
	 $ECALL	DTL		;?Dialog string too long

	MOVEI	T1,12		;OVERWRITE TERMINATING NULL WITH A LF
	DPB	T1,DSTBP	; TO STOP COMND JSYS

	SUBI	P4,LTEXT*5	;CALCULATE NUMBER OF CHARS IN STRING
	MOVNM	P4,CSB+.CMINC	;STORE IN CSB AS IF TEXTI HAD READ THE STRING

	POPJ	P,		;RETURN TO DIALOG SCANNER

> ;IF20

REQDIA:	SKIPGE	I.BAT##		;BATCH?
	  JRST	%ABORT		;YES, DON'T TRY TO DIALOG WITH A .CTL FILE
	TXO	F,F%DRE		;Error condition caused us to go do DIALOG.

RQDIAX:	TXO	F,F%DIALOG	;REQUEST DIALOG
	POPJ	P,		;RETURN FROM ROUTINE CONTAINING ERROR
;ROUTINE TO LOOK UP STRING IN TABLE
;FINDS UNIQUE ABBREVIATIONS
;ARGS:	 T1 = ADDRESS OF TBLUK-FORMAT TABLE
;	 T2 = POINTER TO STRING TO FIND IN TABLE
;RETURN: T1 = ADDRESS OF TABLE ENTRY THAT MATCHES STRING
;NONSKIP RETURN IF NO MATCH
;1 SKIP IF AMBIGUOUS
;2 SKIPS IF OK

IF20,<
TABLK:	TBLUK%			;LOOK UP STRING IN TABLE
	TXNN	T2,TL%NOM	;NO MATCH?
	  AOS	(P)		;NO, ONE SKIP
	TXNN	T2,TL%NOM+TL%AMB ;AMBIGUOUS?
	  AOS	(P)		;NO, ONE MORE SKIP
	POPJ	P,		;RETURN
>

IF10,<
;PRESERVES T5
TABLK:	PUSHJ	P,%SAVE3	;SAVE P1-P3
	MOVE	P1,(T2)		;GET FIRST WORD OF SIXBIT STRING
	MOVSI	P3,(IFIW (T1))	;MAKE POINTER TO SWITCH TABLE IN P3
	HRRI	P3,(T1)
	MOVN	T2,P1		;GET RIGHTMOST BIT PRESENT IN WORD
	AND	T2,P1
	JFFO	T2,.+1		;GET BIT NUMBER OF RIGHTMOST BIT
	IDIVI	T3,6		;GET BYTE NUMBER OF THE BIT
	LSH	T2,-5(T4)	;RIGHT-JUSTIFY BIT WITHIN BYTE
	MOVN	P2,T2		;MAKE MASK OF CHARS PRESENT IN THE WORD

	HLRZ	T1,(P3)		;SET TABLE INDEX TO TOP OF TABLE
	SETO	T4,		;INITIALIZE COUNT OF MATCHING SWITCHES
TABLP:	HLRZ	T2,@P3		;GET ADDRESS OF A SWITCH
	MOVE	T3,(T2)		;GET FIRST WORD OF THE SWITCH
	CAMN	T3,P1		;EXACT MATCH
	  SOJA	T1,TABWIN	;YES, WIN NOW
	AND	T3,P2		;MASK OUT IGNORED TRAILING CHARS
	CAMN	T3,P1		;MATCH?
	  AOJA	T4,.+2		;YES, COUNT AND KEEP LOOKING
	CAMLE	T3,P1		;DOES IT MATCH SWITCH WE'RE LOOKING FOR?
	  SOJG	T1,TABLP	;NO MATCH AND NOT PAST SWITCH YET, LOOP
TABEND:	JUMPL	T4,%POPJ	;NO MATCHES, NONSKIP RETURN
	CAME	P1,(T2)		;EXACT MATCH ALWAYS WINS
	  JUMPG	T4,%POPJ1	;MORE THAN ONE MATCH, AMBIGUOUS RETURN
TABWIN:	ADDI	T1,1(P3)	;CONVERT OFFSET TO ADDRESS
	JRST	%POPJ2		;EXACTLY ONE MATCH, FINE

>
;ROUTINE TO MOVE AN ASCII ARGUMENT TO SOME LOCAL BUFFER
;ARGS:	 T1 = ADDRESS OF 1-WORD (10) OR 16-WORD (20) BUFFER TO PUT ARG IN
;	 L = ADDRESS OF FORTRAN ARGUMENT POINTER
;RETURNS WITH ARGUMENT MOVED

MVARG:	SETZ	T2,		;STOP TRANSFER ONLY WHEN WHOLE STRING MOVED
MVARGX:	PUSHJ	P,MAKEBP	;GET P3 = BYTE POINTER TO ARG STRING
	PJRST	MOVARG		;GO MOVE THE STRING



;ROUTINE TO SET UP BYTE POINTER AND COUNT TO AN ARGUMENT STRING
;ARGS:	 L = ADDRESS OF FORTRAN ARGUMENT POINTER
;RETURN: SRCBP = BYTE POINTER TO STRING
;	 P4 = NUMBER OF CHARS IN STRING

MAKEBP:	XMOVEI	T0,@0(L)	;Point to arg
	$BLDBP	T0		;Get a byte ptr.
	MOVEM	T0,SRCBP	;Store in SRCBP.
	SETZM	%NCHRR		;Clear char counter

	LDB	T0,[POINTR @%LTYPE,ARGTYP] ;GET ARG TYPE
	MOVEI	P4,^D10		;GUESS DOUBLEWORD, 10 CHARS
	CAIL	T0,TP%DPR	;IS IT DOUBLE?
	CAILE	T0,TP%CPX
	  MOVEI	P4,^D5		;NO, SINGLE IS 5 CHARS
	CAIN	T0,TP%LIT	;LITERAL STRING?
	  MOVEI	P4,^D79		;YES, ONLY LIMIT IS SIZE OF DEST BUFFER
	POPJ	P,		;DONE
IF20,<

;ROUTINE TO MOVE ARG TO LOCAL AREA, STANDARDIZING IT
;CONVERTS TO UPPER CASE, REMOVES SPACES, PUTS IN ASCIZ NULL AT END
;COPIES ARG UNTIL IT ENDS OR UNTIL A BREAK CHAR
;
;ARGS:	 T1 = 30-BIT ADDRESS OF 8-WORD BLOCK TO PUT STRING INTO
;	 T2 = MASK OF BREAK CHARS WITH BIT 1_N ON IF CHAR 40+N TERMINATES ARG
;	 SRCBP = Ptr to arg.
;	 P4 = CHAR COUNT
;
;RETURN: T1 = CHAR THAT TERMINATED ARG, OR -1 IF SOURCE STRING EXHAUSTED
;	 SRCBP, P4 UPDATED

MOVARG:	$BLDBP	T1		;Get BP to dest. string
	MOVEM	T1,DSTBP

BMVALP:	ILDB	T1,SRCBP	;GET A BYTE
	JUMPE	T1,MVAEND	;DONE IF NULL
	CAIE	T1,' '		;SKIP LEADING BLANKS
	 JRST	MVAL1		;NON-BLANK CHAR
	SOJG	P4,BMVALP	;BLANK
	SETO	T1,		;FLAG END OF STRING FOUND
	JRST	MVAEND

MVALP:	ILDB	T1,SRCBP	;GET A BYTE
	JUMPE	T1,MVAEND	;NULL, DONE
MVAL1:	MOVEI	T0,1		;GET BIT
	LSH	T0,-40(T1)	;SHIFT OVER
	TDNE	T0,T2		;CHECK CHAR IN BREAK MASK
	  SOJA	P4,MVAEND	;BREAK CHAR, DONE

	CAIN	T1," "		;SPACE?
	  JRST	MVANXT		;YES, IGNORE IT
	CAIL	T1,"a"		;CONVERT LOWER CASE TO UPPER CASE
	CAILE	T1,"z"
	  JRST	.+2		;NOT LC
	SUBI	T1,40		;LC, CONVERT

	IDPB	T1,DSTBP	;STORE CHAR IN DEST STRING

MVANXT:	SOJG	P4,MVALP	;COPY WHOLE STRING
	SETO	T1,		;FLAG STRING TERMINATED BY NO MORE CHARS

MVAEND:	SETZ	T0,		;TERMINATE DEST STRING WITH A NULL
	IDPB	T0,DSTBP
	POPJ	P,		;ALL DONE

>;END IF20
IF10,<

;ROUTINE TO MOVE ARG TO LOCAL AREA, STANDARDIZING IT
;CONVERTS TO SIXBIT, REMOVES SPACES & CONTROL CHARS, TRUNCATES TO 6 CHARS
;COPIES ARG UNTIL IT ENDS OR UNTIL A BREAK CHAR
;
;ARGS:	 T1 = ADDRESS OF WORD TO STORE ARG IN
;	 T2 = MASK OF BREAK CHARS
;	 SRCBP = SOURCE BYTE PTR.
;	 P4 = CHAR COUNT
;RETURN: T1 = TERMINATING CHAR, OR -1 IF SOURCE STRING EXHAUSTED
;	 SRCBP, P4 UPDATED

MOVARG:	SETZM	(T1)		;CLEAR DEST WORD
	MOVEI	T3,(T1)		;MAKE BYTE POINTER TO DEST STRING
	HRLI	T3,(POINT 6,)

MVALP:	ILDB	T1,SRCBP	;GET SOURCE BYTE
	JUMPE	T1,%POPJ	;NULL, DONE
	MOVEI	T0,1		;GET A BIT
	LSH	T0,-40(T1)	;SHIFT OVER
	TDNN	T0,T2		;CHECK CHAR IN BREAK MASK
	CAIN	T1,","		;COMMA TOO
	  POPJ	P,		;BREAK CHAR, DONE

	CAIE	T1,"["		;OTHER BREAKS?
	CAIN	T1,"]"
	  POPJ	P,		;YES, RETURN

	CAIG	T1," "		;SPACE OR CONTROL CHAR?
	  JRST	MVANXT		;YES, INGORE IT
	CAIL	T1,"a"		;LOWER CASE?
	CAILE	T1,"z"
	  SUBI	T1,40		;NO, CONVERT TO SIXBIT

	TLNE	T3,770000	;ALREADY HAVE 6 CHARS IN DEST STRING?
	  IDPB	T1,T3		;NO, PUT THIS ONE IN

MVANXT:	SOJG	P4,MVALP	;COPY WHOLE STRING
	SETO	T1,		;RAN OUT, SET FLAG
	POPJ	P,		;ALL DONE

>;END IF10

SEGMENT DATA
%SRCBP::			;Non-indexed source BP
SRCBP:	BLOCK	1		;Source byte ptr
DSTBP:	BLOCK	1		;Destination byte ptr
%NCHRR:: BLOCK	1		;# chars read from SRCBP so far
				; (Used by FORERR)
IF10,<
%ARGNM:: BLOCK	1		;Addr of ASCII name of arg.
>
DIASAG:	BLOCK	1		;Address of DIALOG='string'
DIASAT:	BLOCK	1		;Arg type for DIALOG='string' arg.
SEGMENT CODE
;T1=DEC #
;T2=BP


DECASC:	MOVE	T3,T2
	PUSHJ	P,DECAS1
	SETZ	T1,
	IDPB	T1,T3
	POPJ	P,

DECAS1:	IDIVI	T1,12
	JUMPE	T1,DECAS2
	PUSH	P,T2
	PUSHJ	P,DECAS1
	POP	P,T2
DECAS2:	ADDI	T2,60
	IDPB	T2,T3
	POPJ	P,


DECSIX:	MOVE	T3,[POINT 6,T4]
	SETZ	T4,
	PUSHJ	P,DECSX1
	MOVE	T1,T4
	POPJ	P,

DECSX1:	IDIVI	T1,12
	JUMPE	T1,DECSX2
	PUSH	P,T2
	PUSHJ	P,DECSX1
	POP	P,T2
DECSX2:	ADDI	T2,'0'
	IDPB	T2,T3
	POPJ	P,
;ASCDEC -- ASCII to DECIMAL conversion routine.

;Input:
;	T1/ 18-bit address.
;Call:
;	PUSHJ	P,ASCDEC
;	<here if parse error, no message typed>
;	<here if ok>
;Output:
;	T1/ number (could be negative).

ASCDEC:	MOVSI	T4,(POINT 7,)
	HRR	T4,T1
	SETZB	T1,T3		;Start with 0 result, not negated
	ILDB	T2,T4		;Get digit or "-"
	CAIE	T2,"-"		;Minus?
	 JRST	ADECL1		;No
	SETO	T3,		;Yes, remember to negate answer
ADECLP:	ILDB	T2,T4		;Get next digit
ADECL1:	JUMPE	T2,ADECL2
	CAIL	T2,"0"
	CAILE	T2,"9"
	  POPJ	P,		;?not numeric
	IMULI	T1,^D10
	ADDI	T1,-"0"(T2)
	JRST	ADECLP

ADECL2:	SKIPE	T3		;Negative?
	 MOVN	T1,T1		;Yes, negate
	JRST	%POPJ1		;Return ok
;ROUTINE TO CONVERT OLD-STYLE CALL TO NEW-STYLE CALL
;OLD STYLE HAS POSITIONAL ARGS FOR UNIT, END, ERR.
;RECOGNIZED BY FIRST ARG HAVING KEYWORD FIELD 0.  PUT IN
;RIGHT KEYWORDS FOR THE POSITIONAL ARGS.

OPNCNV:
CLSCNV:	LDB	T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD FIELD OF FIRST ARG
	JUMPN	T1,%POPJ	;NONZERO, NEW-STYLE CALL

	MOVEI	T1,OK.UNIT	;GET KWD VALUE FOR /UNIT
	DPB	T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST

	MOVEI	T1,OK.ERR	;GET KWD VALUE FOR /ERR
	CAMLE	L,[-3,,-1]	;AT LEAST 3 ARGS PRESENT?
	POPJ	P,		;No, done
	PUSH	P,L
	ADDI	L,2		;Point to /ERR arg
	DPB	T1,[POINTR @%LTYPE,ARGKWD] ;Store /ERR keyword
	POP	P,L
	POPJ	P,		;Return

RLSCNV:	HLRZ	T1,L		;GET ARG COUNT
	CAIE	T1,-1		;MUST BE EXACTLY 1 ARG
;	  IOERR	(WNA,33,504,?,Wrong number of arguments,,%ABORT)
	  $ECALL WNA,%ABORT
	MOVEI	T1,OK.UNIT	;GET KWD VALUE FOR /UNIT

	DPB	T1,[POINTR @%LTYPE,ARGKWD]	;STORE IN LOCAL ARG LIST
	POPJ	P,		;DONE
	SUBTTL	FILL IN DEFAULTS & CHECK FOR CONFLICTS

	COMMENT	&

Trivial defaults are handled by clearing the DDB to zero initially,
then defining the default value for a field to be zero.  Unless set to
something else, the zero will be used as the value of the keyword.
Defaults which cannot be handled that way and defaults which interact
with each other are handled here.

	&


;ROUTINE TO PUT DEFAULT FIELDS INTO A DDB
;ARGS:	 D = DDB ADDRESS

;(THE NEED FOR A DEFAULT IS RECOGNIZED BY A FIELD STILL BEING ZERO.
; HENCE ALL VALUES FOR A DEFAULTED FIELD MUST BE NONZERO.  THE ORDER
; OF THESE CALLS IS IMPORTANT.)


OPDFLT:	PUSHJ	P,DFDIR		;	     DIRECTORY
;	PUSHJ	P,DFFILE	;	     FILENAME
	PUSHJ	P,DFBUF   	;	     BUFFER COUNT
	PUSHJ	P,DFMODE	;	     MODE	[CAN IMPLY /FORM, /TAPEMODE]
	PUSHJ	P,DFSTAT	;	     STATUS	[CAN IMPLY /DISP]
	PUSHJ	P,DFACC		;	     ACCESS	[INTERACTS WITH /STAT, /READONLY]
	PUSHJ	P,DFDISP	;	     DISPOSE	[IF NOT SET ABOVE]
	PUSHJ	P,DFFORM	;	     FORM	[IF NOT SET ABOVE]
	POPJ	P,		;DONE
;*** SPOOLED LPT HAS UNIT = -1 AND DEV=.DVLPT

IF20,<

DFDEV:	SKIPE	DEV(D)		;DEVICE SET?
	  POPJ	P,		;Yes, return
	HXRE	T1,UNUM(U)	;GET UNIT NUMBER
	JUMPL	T1,DFDEV0	;NEGATIVE, NO CHECK FOR LOGICAL NAME
	MOVE	T2,[POINT 7,DEV(D)] ;POINT TO DESTINATION FOR DEVICE
	PUSHJ	P,DECASC	;CONVERT UNIT TO DECIMAL ASCIZ STRING

	HRROI	T1,DEV(D)	;POINT TO DEVICE NAME
	STDEV%			;GET DEVICE DESIGNATOR
	  ERJMP	.+2		;NO SUCH DEVICE
	POPJ	P,		;Got it, return

	HXRE	T1,UNUM(U)	;GET UNIT NUMBER AGAIN
DFDEV0:	CAIL	T1,0		;NEGATIVE UNIT?
	CAIGE	T1,MAXDEV	;OR POSITIVE AND IN TABLE?
	  SKIPA	T1,DEVTAB(T1)	;YES, GET DEVICE NAME FROM TABLE
	MOVE	T1,[ASCII "DSK"] ;NO, USE DEFAULT
	MOVEM	T1,DEV(D)	;STORE DEVICE NAME
	POPJ	P,		;Return
;Routine to check out device and get information about it

DFDEV1:	HRROI	T1,DEV(D)	;POINT TO DEVICE NAME
	STDEV%			;GET DEVICE DESIGNATOR
	 ERJMP	.+2
	JRST	DFDVCH		;OK

	XMOVEI	T1,DEV(D)	;Get address of device name for error msg
;	IOERR	(NSD,30,245,?,No such device $A,<T1>,REQDIA)
	$ECALL	NSD,REQDIA

DFDVCH:	MOVE	T1,T2		;PUT DEVICE DESIGNATOR IN RIGHT AC
	MOVEM	T1,DVICE(D)	;Save device designator
	CAMN	T1,TT.DES##	;OPENING CONTROLLING TTY?
	  TXO	F,F%CTTY	;YES, REMEMBER THAT

	DVCHR%			;GET DEVCHR WORD
	LDB	T1,[POINT 9,T2,17] ;GET DEVICE TYPE
	STORE	T1,DVTYP(D)	;STORE THAT
	CAIE	T1,.DVTTY	;IS DEVICE A TTY?
	CAIN	T1,.DVPTY	; OR PTY?
	TXZ	T2,DV%M10	;NO IMAGE MODE
	CAIN	T1,.DVMTA	;IS DEVICE A MAGTAPE?
	TXO	T2,DV%M10	;ALLOW IMAGE MODE
	STORE	T2,LGLM(D)	;STORE LEGAL DATA MODES
	ROT	T2,2		;GET INPUT/OUTPUT BITS
	STORE	T2,IO(D)	;STORE THAT

;Figure out appropriate INDX(D) -- device type index
	LOAD	T1,DVTYP(D)	;Get device type
	MOVEI	T2,DI.OTHR	;Guess type "other"
	CAIN	T1,.DVDSK	;Disk?
	 MOVEI	T2,DI.DSK	;Yes
	CAIN	T1,.DVMTA	;Tape?
	 MOVEI	T2,DI.MTA	;Yes
	CAIN	T1,.DVTTY	;TTY?
	 MOVEI	T2,DI.TTY
	LOAD	T3,ACC(D)	;Get ACCESS
	CAIN	T3,AC.APP	;APPEND?
	 CAIN	T1,.DVMTA	;Yes, not tape?
	  JRST	.+2		;No
	 MOVEI	T2,DI.OTHR	;Append and non-tape, use SOUTS
	STORE	T2,INDX(D)	; . .
	JRST	%POPJ1		;No error--Skip return
DFDIR:	TXNN	F,F%PPN		;DID USER GIVE DIRECTORY=PPN?
	  POPJ	P,		;NO, GREAT

	HRROI	T1,ATMBUF	;TRANSLATE PPN TO DIRECTORY STRING
	MOVE	T2,DIR(D)	;GET PPN
	HRROI	T3,DEV(D)	;POINT TO DEVICE NAME
	PPNST%			;TRANSLATE IT
	  ERJMP	PPNERR		;ERROR, GO BITCH

	MOVE	P3,[POINT 7,ATMBUF] ;INITIALIZE STRING POINTER
	MOVEM	P3,SRCBP
	MOVEI	P4,LATOM*5	;AND COUNT
	XMOVEI	T1,ATMBUF	;MOVE STRING TO SELF
	MOVSI	T2,(1_'<')	;UNTIL START OF DIRECTORY NAME
	PUSHJ	P,MOVARG	;SKIP TO LEFT ANGLE BRACKET

	XMOVEI	T1,DIR(D)	;NOW POINT TO REAL DESTINATION
	MOVSI	T2,(1_'>')	;TERMINATE ON END OF DIRECTORY NAME
	PUSHJ	P,MOVARG	;MOVE DIRECTORY TO DDB, RETURN

	TXZ	F,F%PPN		;DIRECTORY IS NO LONGER STORED AS PPN
	POPJ	P,

PPNERR:; IOERR	(PPN,30,405,?,$J,,REQDIA)
	$ECALL	PPN,REQDIA
;STILL IF20

DFFILE:	SKIPE	FILE(D)		;FILENAME SET?
	  JRST	DFEXT		;YES, GO CHECK EXT
	MOVE	T1,[ASCII "FOR0"] ;GET PART OF DEFAULT FILENAME
	MOVEM	T1,FILE(D)	;STORE IN DDB
	HXRE	T1,UNUM(U)	;GET UNIT NUMBER
	JUMPL	T1,DFFILX	;NEGATIVE UNITS ARE SPECIAL
	MOVE	T2,[POINT 7,FILE(D),27] ;POINT TO AFTER "FOR0"
	CAIL	T1,^D10		;UNLESS UNIT NUMBER IS OVER 10
	  MOVE	T2,[POINT 7,FILE(D),20] ;THEN POINT AFTER "FOR"
	PUSHJ	P,DECASC	;CONVERT UNIT NUMBER TO ASCIZ
	JRST	DFEXT		;GO DO EXTENSION

DFFILX:	MOVE	T1,DEVTAB(T1)	;GET DEV NAME FOR NEGATIVE UNIT
	SETZ	T2,		;CLEAR JUNK
	LSHC	T1,-^D22	;MOVE OVER 3 CHARS
	LSH	T1,1		;PUT IN EXTRA BIT BETWEEN WORDS
	OR	T1,["FOR"B20]	;PUT FIRST PART OF FILENAME IN
	DMOVEM	T1,FILE(D)	;SAVE IN DDB

DFEXT:	TXNN	F,F%EXT		;EXT SPECIFIED BY FILE=?
	SKIPE	EXT(D)		;NO, EXTENSION ALREADY SET?
	  POPJ	P,		;YES, DONE
	MOVE	T1,[ASCIZ "DAT"] ;NO, SET DEFAULT
	MOVEM	T1,EXT(D)
	POPJ	P,

>;END IF20
;***TY.SPL & TY.VAR

IF10,<

DFDEV:	SKIPE	T1,DEV(D)	;DEVICE SET?
	  POPJ	P,		;Yes, return
	HXRE	T1,UNUM(U)	;GET UNIT NUMBER
	JUMPL	T1,DFDEV0	;NEGATIVE, NO LOGICAL NAME CHECK
	PUSHJ	P,DECSIX	;CONVERT UNIT NUMBER TO SIXBIT
	MOVEM	T1,DEV(D)	;SAVE IN DDB

	DEVCHR	T1,		;SEE IF DEVICE EXISTS
;BL;	Change at DFDEV+7 (if10)  Q10-05829
;	JUMPN	T1,DFDVCH	;YES, USE UNIT NUMBER AS DEVICE NAME
	JUMPN	T1,%POPJ	;Yes, use unit number as device name
	HXRE	T1,UNUM(U)	;GET UNIT NUMBER BACK
DFDEV0:	CAIL	T1,0		;NEGATIVE UNIT?
	CAIGE	T1,MAXDEV	;OR POSITIVE AND IN TABLE?
	  SKIPA	T1,DEVTAB(T1)	;YES, GET TABLE ENTRY
	MOVSI	T1,'DSK'	;NOT IN TABLE, USE DEFAULT
	MOVEM	T1,DEV(D)	;SAVE IN DDB
	POPJ	P,		;Return, default device set.

DFDIR==%POPJ			;NO DIRECTORY PROCESSING NECESSARY
;Routine to check out device and get information about it

DFDEV1:	MOVE	T1,DEV(D)	;Get sixbit device name
	IONDX.	T1,		;GET UDX
	  SETO	T1,
	CAMN	T1,TT.DES##	;OPENING CONTROLLING TTY?
	  TXO	F,F%CTTY	;YES, REMEMBER THAT

	MOVE	T1,DEV(D)	;Get device name
	DEVCHR	T1,		;GET DEVCHR WORD
	JUMPN	T1,DFDVCH	;GOT IT, GO SAVE IT
;	IOERR	(NSD,30,245,?,No such device $S,<DEV(D)>,REQDIA)
	$ECALL	NSD,REQDIA

DFDVCH:	TXNN	T1,DV.TTY	;Is device a TTY?
	 JRST	DFDVC1		;No, FOROTS allows every mode that
				; the monitor allows.
	TXNN	T1,DV.MTA	;If this is also set, device is NUL: - skip.
	 TXZ	T1,DV.M17!DV.M14!DV.M10 ;TTY: -- Don't allow DUMP,BINARY,IMAGE.
DFDVC1:	STORE	T1,LGLM(D)	;STORE LEGAL DATA MODES
	SETZ	T0,		;Assume this is not a directory device
	TXNE	T1,DV.DIR	;Is it?
	 SETO	T0,		;Yes, set flag
	STORE	T0,DRDVF(D)	;. .

	SETZ	T0,		;T0 will get input/output bits
	TXNE	T1,DV.IN	;Can this device do input?
	 TRO	T0,1		;Yes, set 2nd bit in "IO"
	TXNE	T1,DV.OUT	;Can this device do output?
	 TRO	T0,2		;Yes, set 1st bit in "IO"
	STORE	T0,IO(D)	;STORE LAST TWO BITS IN DDB

	MOVE	T1,DEV(D)	;GET DEVICE NAME
	DEVTYP	T1,		;GET DEVTYP BITS
	  $SNH			;?Should not fail
	ANDI	T1,TY.DEV	;GET RID OF UNWANTED BITS
	STORE	T1,DVTYP(D)	;STORE DEVTYP CODE

;Find appropriate INDX(D)
	MOVEI	T2,DI.OTHR	;Guess type OTHER
	CAIN	T1,.TYDSK	;DISK?
	 MOVEI	T2,DI.DSK	;Yes
	CAIN	T1,.TYMTA	;TAPE?
	 MOVEI	T2,DI.MTA	;Yes
	CAIN	T1,.TYTTY	;TTY?
	 MOVEI	T2,DI.TTY	;Yes
	STORE	T2,INDX(D)	;Store dev index for dev-dependent code

;Get physical device name (which uniquely identifies this device)
; and store in DVICE(D)
	MOVE	T1,DEV(D)	;Get device name
	DEVNAM	T1,		;Get phys. device name
	 $SNH			;?Can't happen
	TXNE	F,F%CTTY	;Controlling TTY:?
	 MOVSI	T1,'TTY'	;Yes, just store "TTY"
	MOVEM	T1,DVICE(D)	;Store unique device identifier.

	JRST	%POPJ1		;No error--skip return
;STILL IF10

DFFILE:	SKIPE	FILE(D)		;FILENAME SET?
	  JRST	DFEXT		;YES, GO CHECK EXT
	HXRE	T1,UNUM(U)	;GET UNIT NUMBER
	JUMPL	T1,DFFILX	;NEGATIVE, SPECIAL CODE
	PUSHJ	P,DECSIX	;CONVERT TO SIXBIT
	TLNE	T1,007777	;1-DIGIT NUMBER?
	  JRST	DFFILY		;NO, OK
	LSH	T1,-6		;YES, PUT IN LEADING ZERO
	TLO	T1,'0  '
DFFILY:	HRRI	T1,'FOR'	;PUT IN REST OF FILENAME
	MOVSM	T1,FILE(D)	;SAVE IN DDB
	JRST	DFEXT		;GO DO EXT

DFFILX:	HLRZ	T1,DEVTAB(T1)	;RH OF FILENAME IS DEVICE NAME
	HRLI	T1,'FOR'	;PUT IN OTHER HALF OF FILENAME
	MOVEM	T1,FILE(D)	;SAVE IN DDB

DFEXT:	TXNN	F,F%EXT		;EXT SPECIFIED BY FILE=?
	SKIPE	EXT(D)		;NO, EXTENSION ALREADY SET?
	  POPJ	P,		;YES, DONE
	MOVSI	T1,'DAT'	;NO, SET DEFAULT
	MOVEM	T1,EXT(D)
	POPJ	P,

>;END IF10
DFACC:	LOAD	T1,ACC(D)	;DEFAULT IS /ACCESS:SEQINOUT
	JUMPN	T1,DFACCX	;SKIP IF ALREADY SET
	MOVEI	T1,AC.SIO	;GET DEFAULT, SEQINOUT
	STORE	T1,ACC(D)	;STORE IN DDB
DFACCX:	LOAD	T2,RO(D)	;GET /READONLY
	JUMPE	T2,%POPJ	;Not set, leave ACCESS alone

;/READONLY set. Change ACCESS of 'RANDOM' to 'RANDIN',
;		  change ACCESS of 'SEQINOUT' to 'SEQIN'.
DFACC1:	CAIE	T1,AC.SIO	;SEQINOUT?
	CAIN	T1,AC.RIO	;RANDOM?
	 CAIA			;Yes, change them
	POPJ	P,		;Don't change /ACCESS
	CAIN	T1,AC.SIO
	 SKIPA	T1,[AC.SIN]	;SEQINOUT to SEQIN
	  MOVEI	T1,AC.RIN	;RANDOM to RANDIN
	STORE	T1,ACC(D)	;Store in DDB
	POPJ	P,


DFBUF:
IF20,<	LOAD	T1,BUFCT(D)	;GET BUFFER COUNT
	JUMPN	T1,%POPJ	;IF ALREADY SET, DON'T SET DEFAULT
	MOVEI	T1,4		;DEFAULT IS 4
	STORE	T1,BUFCT(D)
> ;IF20
	POPJ	P,


DFDISP:	LOAD	T1,DISP(D)	;DEFAULT IS /DISP:SAVE
	JUMPN	T1,%POPJ
	LOAD	T2,STAT(D)	;Unless STATUS='SCRATCH'
	CAIN	T2,ST.SCR
	 SKIPA	T1,[DS.EXP]	; Then it's /DISPOSE:EXPUNGE
	MOVEI	T1,DS.SAVE
	STORE	T1,DISP(D)
	POPJ	P,


DFFORM:	LOAD	T1,FORM(D)	;DEFAULT IS /FORM:FORMATTED
	JUMPN	T1,DFFRM1	;Already set
	MOVEI	T1,FM.FORM
	STORE	T1,FORM(D)
DFFRM1:	MOVE	T2,FLAGS(D)	;Get DDB flags
	CAIN	T1,FM.FORM	;Formatted?
	 TXZA	T2,D%UNF	;Yes, clear "unformatted" flag
	TXO	T2,D%UNF	;No, set "unformatted" flag
	MOVEM	T2,FLAGS(D)	;Store updated flags
	POPJ	P,
DFMODE:	LOAD	T1,MODE(D)	;GET FILE MODE
	JUMPN	T1,DFMOD0	;IF SET, NO DEFAULT

	MOVEI	T1,1		;SET FLAG XMODE TO REMEMBER WE DEFAULTED MODE
	STORE	T1,XMODE(D)

	LOAD	T1,FORM(D)	;GET /FORM
	CAIN	T1,FM.UNF	;/FORM:UNFORMATTED?
	  SKIPA	T1,[MD.BIN]	;UNFORMATTED, DEFAULT IS /MODE:BINARY
	MOVEI	T1,MD.ASC	;FORMATTED, DEFAULT IS /MODE:ASCII
	STORE	T1,MODE(D)	;SET DEFAULT
DFMOD0:	CAIE	T1,MD.EBC	;/MODE:EBCDIC?
	  JRST	DFMOD1		;NO
	MOVEI	T2,TM.IND	;YES, IMPLIES /TAPEMODE:INDUSTRY
	STORE	T2,TAPM(D)

DFMOD1:	CAIL	T1,MD.ASC	;ASCII OR GREATER IMPLIES /FORM:F
	  JRST	SETFORM
	CAIL	T1,MD.BIN	;BINARY OR GREATER IMPLIES /FORM:U
	  JRST	SETUNF
;8-SEP-81 /DAW  /MODE:IMAGE IMPLIES /FORM:UNF
;	LOAD	T1,FORM(D)	;ONLY THING LEFT IS /MODE:IMAGE
;	JUMPN	T1,%POPJ	;IF USER SPECIFIED /FORM, USE THAT
	MOVEI	T1,FM.UNF	;OTHERWISE /MODE:IMAGE IMPLIES /FORM:U
	STORE	T1,FORM(D)
	POPJ	P,

SETUNF:	SKIPA	T1,[FM.UNF]	;GET /FORM:U
SETFORM: MOVEI	T1,FM.FORM	;GET /FORM:F
	MOVEI	T2,(T1)		;SET IT TO IMPLIED FORMAT
	STORE	T2,FORM(D)
	POPJ	P,		;Return



;Default STATUS
DFSTAT:	LOAD	T1,STAT(D)	;GET /STATUS
	JUMPN	T1,DFSTAX	;IF SET, NO DEFAULT
	MOVEI	T1,ST.UNK	;DEFAULT IS /STATUS:UNKNOWN
	STORE	T1,STAT(D)	;SET DEFAULT
DFSTAX:	SUBI	T1,ST.DISP	;CONVERT TO /DISP:SOMETHING
	JUMPLE	T1,%POPJ	;WASN'T A /STAT THAT'S REALLY /DISP, DONE
	STORE	T1,DISP(D)	;ELSE JUST STORE NEW DISP
	POPJ	P,		;RETURN
;FIXDEF DOES FINAL DEFAULT PROCESSING AFTER EVERYTHING IS IN PLACE
;INITIALIZES TTYW TO 72 OR RECORD SIZE, IN CASE NON-TERMINAL

FIXDEF:	MOVE	T2,FLAGS(D)	;T2= DDB flags to update
IF10,<
	MOVE	T1,DEV(D)	;GET DEV AGAIN
	DEVTYP	T1,		;GET DEVTYP (AGAIN)
	  SETZ	T1,
	TXNE	T1,TY.INT	;INTERACTIVE?
	 TXO	T2,D%INT	;Yes, set flag
> ;IF10

	LOAD	T1,FORM(D)	;GET /FORM
	CAIN	T1,FM.UNF	;UNFORMATTED?
	  TXO	T2,D%UNF	;Yes, file is now officially unformatted
	LOAD	T1,MODE(D)	;GET /MODE
	CAIN	T1,MD.BIN	;BINARY?
	  TXO	T2,D%BIN	;YES, FLAG THAT TOO
	MOVEM	T2,FLAGS(D)	;Done with flags, free up T2

	LOAD	T1,BPW(D)	;IS BYTES/WORD NON-ZERO ALREADY?
	JUMPN	T1,GOTBPW	;YES. DON'T TOUCH IT
	LOAD	T1,MODE(D)	;GET FILE MODE
	LDB	T1,MODBYT	;GET BYTE SIZE
	MOVEI	T2,^D36		;DIVIDE INTO 36 TO GET # BYTES/WORD
	IDIVI	T2,(T1)
	STORE	T2,BPW(D)	;MIGHT BE RECALCULATED AT READ/WRITE TIME
	MOVE	T1,T2		;Put in T1

;Here with # of bytes/word in T1.
GOTBPW:
IF10,<	MOVE	T2,SIZ(D)	;Incase this is an input file,
	IMUL	T2,T1		; get number of bytes and store in EOFN.
	MOVEM	T2,EOFN(D)
>;END IF10
	MOVE	T1,RSIZE(D)	;GET RECORD SIZE
	JUMPE	T1,NOSIZE
	LOAD	T3,BPW(D)	;GET # BYTES/WORD
	LOAD	T2,MODE(D)	;GET FILE MODE
	CAIN	T2,MD.ASL	;LINE-SEQUENCED ASCII?
	 ADDI	T1,6		;YES. ADD 6 FOR LSN AND TAB
	CAIE	T2,MD.IMG	;IMAGE?
	 ADDI	T1,1(T3)	;NO. ADD IN FOR CRLF & NULLS, OR LSCW'S
	IDIVI	T1,(T3)		;GET # WORDS
	STORE	T1,RSIZW(D)	;STORE RECORD SIZE IN WORDS

repeat 0,<
NOSIZE:	SKIPN	T1,RSIZE(D)	;GET RECORD SIZE AGAIN
	 MOVEI	T1,^D72		;NO RECORD SIZE, LINES ARE 72 COLS
	LOAD	T2,TTYW(D)	;GET LINE SIZE
	CAIN	T2,0		;ALREADY SET? (TERMINALS SET BY TTYSET)
	  STORE	T1,TTYW(D)	;NO, SET DEFAULT LINE SIZE
>
NOSIZE:	SKIPN	T1,RSIZE(D)	;GET RECORD SIZE AGAIN
	  LOAD	  T1,TTYW(D)	;  DEFAULT FROM TTYSET IF TERMINAL
	CAIN	T1,0		;DO WE HAVE A VALUE?
	  MOVEI	  T1,^D72	;  NOW WE DO
	STORE	T1,TTYW(D)	;SET IT

	POPJ	P,
;FIXU - Routine to fixup U after OPEN is done.
; Called with FIXDEF, for every "U" that applies.
;SETS /CARRIAGE:DEVICE TO APPROPRIATE DEVICE DEFAULT
; and other stuff

FIXU:	MOVEI	T1,1		;INIT RECORD NUMBER TO 1
	MOVEM	T1,NREC(U)
	LOAD	T1,CC(U)	;GET CC
	CAIE	T1,CC.DEV	;DEVICE DEFAULT?
	  POPJ	P,		;NO, DONE
	LOAD	T1,DVTYP(D)	;GET DEVICE TYPE
IF10,<	CAIE	T1,.TYTTY	;TERMINAL?
	CAIN	T1,.TYLPT >	;OR PRINTER?
IF20,<	CAIE	T1,.DVTTY	;TERMINAL?
	CAIN	T1,.DVLPT >	;OR PRINTER?
	  SKIPA	T1,[CC.FORT]	;YES, CC=FORT
	MOVEI	T1,CC.LIST	;NO, CC=LIST
	STORE	T1,CC(U)	;STORE DEFAULT CC
	POPJ	P,		;Return
;LOOK UP SWITCH IN TABLE
;ARGS:	 T1 = NUMBER TO FIND IN RH OF TABLE ENTRY
;	 T2 = (18-bit) ADDRESS OF TBLUK-FORMAT TABLE
;RETURN: T1 = STRING ADDRESS (FROM RH OF TABLE ENTRY)
;USES T1 THRU T4

FNDSWT:	HRRZ	T3,(T2)		;GET LENGTH OF TABLE
	HRLI	T2,(IFIW (T3))	;PUT T3 INDEX IN LH OF T2
FSWLP:	HRRZ	T4,@T2		;GET A TABLE ENTRY
	CAIE	T4,(T1)		;DOES IT MATCH THE ONE WE WANT?
	  SOJG	T3,FSWLP	;NO, KEEP LOOKING
	HLRZ	T1,@T2		;GET STRING POINTER
	JUMPG	T3,%POPJ	;RETURN UNLESS SWITCH WAS NOT FOUND IN TABLE
	$SNH			;Switch not found, internal error
	SUBTTL	CHECK JFN FOR TTY:

IF20,<
;	This routine is called after a GTJFN is done, to see
; if the filespec was actually TTY:. If this is true, and
; the user has no logical name TTY:, IJFN and OJFN are changed to
; .PRIIN and .PRIOU, respectively. This way TOPS-20 allows you
; to DETACH and REATTACH somewhere else, and the TTY output will
; follow you around (just like on the -10).

;Input:
;	T1/ JFN
;Call:
;	PUSHJ	P,CTTYJF
;	<return here always>
;Returns:
;	T1/ JFN (if TTY:, .PRIIN is returned)
;Uses T2, T3

CTTYJF:	MOVE	T2,T1		;Copy JFN
	SETZM	TDHOLD		;Clear device field
	HRROI	T1,TDHOLD	;Temp HOLD area
	MOVX	T3,FLD(.JSAOF,JS%DEV) ;Output device name
	JFNS%			;** Return ASCIZ device name **
	MOVE	T1,T2		;JFN back in T1

;If device is exactly "TTY", set .PRIIN and .PRIOU,
; and just release the JFN
	MOVE	T3,TDHOLD	;What did we get?
	CAME	T3,[ASCIZ /TTY/] ;TTY:?
	 POPJ	P,		;No, return
	RLJFN%			;Release old JFN
	  $SNH			;?Should work
	MOVEI	T1,.PRIOU	;How about that.
	STORE	T1,OJFN(D)	;Store in DDB.
	MOVEI	T1,.PRIIN	;This gets returned in T1
	STORE	T1,IJFN(D)	; . .
	POPJ	P,		;Return

SEGMENT DATA
TDHOLD:	BLOCK	<^D39+1>/5	;Up to 39 characters in device name
SEGMENT CODE
>;END IF20
	SUBTTL	DIALOG SCANNER

IF20,<

DLGSTR:	MOVE	P3,DIASAG	;Get DIALOG='string' arg ptr.
	TXO	F,F%INDST	;Set flag saying we're now doing DIALOG='string'

DIALOG:	PUSHJ	P,SAVERR	;DIVERT ERR MSGS TO TTY
	TXNE	F,F%INDST	;DIALOG FROM STRING?
	  JRST	DIASK1		;YES, SKIP PREFIX
	SKIPN	G.EFS		;SKIP IF PREFIX ALREADY TYPED
;	  IOERR	(EFS,,,[,Enter correct file specs)
	  $ECALL EFS
	SETOM	G.EFS		;SUPPRESS PROMPT NEXT TIME

DIASK1:	MOVEI	T1,REPARSE	;FILL IN CSB
	MOVEM	T1,CSB+.CMFLG
	TXNE	F,F%INDST	;DIALOG COMING FROM STRING?
	  SKIPA	T1,[.NULIO,,.NULIO] ;YES, NO JFNS
	MOVE	T1,[.PRIIN,,.PRIOU] ;NO, NORMAL JFNS
	MOVEM	T1,CSB+.CMIOJ
	HRROI	T1,[ASCIZ /*/]	;PROMPT STRING
	MOVEM	T1,CSB+.CMRTY
	HRROI	T1,TXTBUF	;TEXT BUFFER
	MOVEM	T1,CSB+.CMBFP
	MOVEM	T1,CSB+.CMPTR
	MOVEI	T1,LTEXT*5	;CHARS IN TEXT BUFFER
	MOVEM	T1,CSB+.CMCNT
	HRROI	T1,ATMBUF	;ATOM BUFFER
	MOVEM	T1,CSB+.CMABP
	MOVEI	T1,LATOM*5-1	;CHARS IN ATOM BUFFER
	MOVEM	T1,CSB+.CMABC	;   (-1 BECAUSE OF COMND JSYS BUG)
	MOVEI	T1,JFNBLK	;GTJFN BLOCK
	MOVEM	T1,CSB+.CMGJB

	MOVX	T1,<<.CMKEY>B8> ;FILL IN SWITCH-KEYWORD FLDDB BLOCK
	MOVEM	T1,SWTDDB+.CMFNP
	MOVX	T1,<<.CMSWI>B8> ;Fill in FLDDB block for switches
	MOVEM	T1,FLDSWT+.CMFNP
	MOVEI	T1,OPNSWT	;Assume OPEN
	TXNE	F,F%CLS		;CLOSE?
	 MOVEI	T1,CLSSWT	; Yes, get alternate switches
	MOVEM	T1,FLDSWT+.CMDAT ;Store in block
;STILL IF20

	PUSHJ	P,%SAVE4

RESCN:	MOVEI	T1,CSB		;POINT TO CSB
	MOVEI	T2,[FLDDB.(.CMINI)] ;INITIALIZE IT
	PUSHJ	P,COMAND

	TXNE	F,F%INDST	;DIALOG FROM STRING?
	  PUSHJ	P,DIABLT	;YES, GO FAKE A TEXTI

	MOVEM	P,SAVEP		;SAVE P FOR REPARSE
REPARSE:
	MOVE	P,SAVEP		;RESTORE P
	PUSHJ	P,SETJFN	;FILL IN GTJFN BLOCK
	MOVE	T1,[GJ%OLD!GJ%NEW!GJ%FOU!777777] ;Clear stuff that
	ANDCAM	T1,JFNBLK+.GJGEN ; gets us an actual generation number
	TXNE	F,F%CLS		;In CLOSE?
	 HLLOM	JFNBLK+.GJGEN	;Yes, default generation number to -1.
	MOVX	T1,GJ%OFG	;Don't get link to actual file yet
	IORM	T1,JFNBLK+.GJGEN ;(Incase he changes /ACCESS after typing
				; the filespec).
	MOVEI	T1,CSB		;RESTORE T1
	MOVEI	T2,FLDFNS	;Parse file name or switches
	PUSHJ	P,COMAND	;** Go do parse **
	HRRZ	P1,T3		;See what it was
	CAIN	P1,FLDFNS	;CRLF?
	 POPJ	P,		;Yes, just return
	CAIN	P1,FLDSWT	;Switch?
	 JRST	DIASWG		;Yes, go process

;Filename was parsed

DIAFNM:	MOVX	T0,D%RJN	;Clear flag, this is not a JFN
	ANDCAM	T0,FLAGS(D)	; that can be "OPENF'd".
	TXO	F,F%FSS		;Set "Filespec info given" flag
	STORE	T2,IJFN(D)	;STORE JFN IN DDB
	STORE	T2,OJFN(D)	; . .
	PUSHJ	P,DOJFNS	;STORE NEW DEVICE, FILENAME, ... IN DDB
	HRRZ	T1,T2		;Copy JFN
	PUSHJ	P,CTTYJF	;Check to see if TTY: is used,
				; if so, possibly change to .PRIOU, .PRIIN
DIASWT:	MOVEI	T1,CSB		;POINT TO CSB
	MOVEI	T2,[FLDDB.(.CMCFM,,,,,FLDSWT)]
	PUSHJ	P,COMAND	;PARSE A SWITCH OR A CRLF
	TSC	T3,T3		;SEE WHAT WAS ACTUALLY PARSED
	JUMPE	T3,%POPJ	;CRLF, DONE WITH DIALOG

DIASWG:	MOVEI	T1,CSB		;Point to COMND block
	HRRZ	P1,(T2)		;GET KEYWORD NUMBER OF SWITCH
	HRRZ	T2,OPNDSP(P1)	;Point to switch value handler
	TXNE	F,F%CLS		;In CLOSE?
	 HRRZ	T2,CLSDSP(P1)	;Yes, separate handler
	JUMPN	T2,DIASWD	;IF ANY
	  $SNH			;No handler, internal error
DIASWD:	MOVE	T3,(T2)		;GET ROUTINE ADDRESS OR TOP OF KEYWORD TABLE
	TLNN	T3,-1		;SEE WHICH IT IS
	  JRST	(T3)		;SUBROUTINE, GO TO IT

DIAKWD:	MOVEM	T2,SWTDDB+.CMDAT ;KEYWORD TABLE, STORE ADDRESS
	MOVEI	T2,SWTDDB	;POINT TO KEYWORD FLDDB
	PUSHJ	P,COMAND	;PARSE SWITCH KEYWORD
	HRRZ	T2,(T2)		;GET VALUE
	XCT	OPSTOR(P1)	;STORE IN DDB
	JRST	DIASWT		;LOOP

;Routine to ignore the next keyword
;P1 = Switch number

DIAIGN:	PUSHJ	P,CLIGN		;Type "%Ignoring <KEYWORD>"
	MOVEI	T2,SWACC	;Get a random switch table
	MOVEM	T2,SWTDDB+.CMDAT ;Store address
	MOVEI	T1,CSB
	MOVEI	T2,SWTDDB
	COMND%
	 ERJMP	CMDER1		;?Funny error
	JRST	DIASWT		;Don't care whether it parsed or not

DIAINT:	SKIPA	T2,[[FLDDB.(.CMNUM,,^D10)]] ;GET A DECIMAL NUMBER
DIAOCT:	MOVEI	T2,[FLDDB.(.CMNUM,,^D8)] ;GET AN OCTAL NUMBER
	PUSHJ	P,COMAND
	XCT	OPSTOR(P1)	;STORE IN DDB
	JRST	DIASWT

DIACHR:	MOVEI	T2,[FLDDB.(.CMQST,,,single character)] ;GET A SINGLE CHAR
	PUSHJ	P,COMAND
	LDB	T2,[POINT 7,ATMBUF,6] ;GET CHAR FROM ATOM BUFFER
	CAIN	T2,""		;QUOTING CHAR?
	  LDB	T2,[POINT 7,ATMBUF,13] ;YES, GET CHAR IT QUOTED
	XCT	OPSTOR(P1)	;STORE IN DDB
	JRST	DIASWT

DIASET:	MOVEI	T2,1		;SET BIT TO 1
	XCT	OPSTOR(P1)
	JRST	DIASWT

;CRLF or Filespec or switch

FLDFNS:	FLDDB. (.CMCFM,CM%SDH,,,,FLDFNM)
FLDFNM:	FLDDB. (.CMFIL,CM%SDH,,<file name>,,FLDSWT)

SEGMENT	DATA
FLDSWT:	BLOCK	.CMDAT+1	;Allocate space for FLDDB. block
SEGMENT	CODE
COMAND:	COMND%			;PARSE THE WHATEVER-IT-IS
	  ERJMP	CMDERR		;ERROR IN COMND
	TXNE	T1,CM%NOP	;DID IT PARSE CORRECTLY?
	  JRST	CMDERR		;NO
	POPJ	P,		;YES

CMDERR:	ADJSP	P,-1		;DISCARD RETURN ADDRESS

CMDER1:	MOVEI	T1,.FHSLF	;SEE WHAT ERROR WE GOT
	GETER%			;GET LAST ERROR
	MOVEI	T1,(T2)		;DISCARD JUNK IN LH
	CAIN	T1,IOX4		;END OF COMMAND FILE?
	  JRST	DIAEOF		;CANNOT RECOVER FROM THAT WITH MORE DIALOG

	TXNN	F,F%INDST	;Are we parsing DIALOG= argument?
	 JRST	CMDER2		;No
	CAIE	T1,NPXNOM	;"Does not match switch or keyword"?
	CAIN	T1,NPXAMB	; or "Ambiguous"?
	 JRST	CMDER4		;Yes
;	  IOERR	(EDS,,,?,Error in dialog string - $J,,REQDIA)
	  $ECALL EDS,REQDIA
CMDER4:	XMOVEI	T1,ATMBUF	;Point to atom buffer
	$ECALL	EDA,REQDIA	;Type EDS + atom buffer

;Not DIALOG = 'string'

CMDER2:	PUSH	P,T1		;Save error code
	PUSHJ	P,COL1		;GET TERMINAL TO COL 1 IF IT ISN'T ALREADY
	POP	P,T1

;See if we should type out the atom buffer with this error

	CAIE	T1,NPXNOM	;Does not match switch or keyword
	CAIN	T1,NPXAMB	;Ambigous
	 JRST	CMDERA		;Yes
	CAIN	T1,NPXNC
	 JRST	CMDERA
;	IOERR	(JSE,30,,?,$J)
	$ECALL	JSE,RESCN	;Type JSYS error and go try again

;Type error and type out atom buffer

CMDERA:	XMOVEI	T1,ATMBUF	;Point to atom buffer
	$ECALL	JSA,RESCN	;Type JSYS error and go try again


;Routine to get termiinal to column 1

COL1:	MOVE	T1,CSB+.CMINC	;GET CHAR COUNT FROM CSB
	MOVE	T2,CSB+.CMPTR	;GET BYTE POINTER
C1LP:	SOJL	T1,C1CRLF	;IF NO CHARS LEFT, GO TYPE CRLF
	ILDB	T3,T2		;GET A CHAR FROM TEXTI BUFFER
	CAIN	T3,12		;A LF?
	  POPJ	P,		;YES, TERMINAL IS ALREADY AT COL 1
	JRST	C1LP		;NO, SEARCH SOME MORE

C1CRLF:	HRROI	T1,%CRLF	;GET TO COLUMN 1 BY TYPING CRLF
	PSOUT%
	POPJ	P,		;RETURN



DIAEOF:	TXNE	F,F%INDST	;DIALOG FROM STRING?
	  POPJ	P,		;YES, DIALOG IS COMPLETE
	JRST	%ABORT		;END OF COMMAND FILE, FATAL ERROR

> ;IF20
IF10,<

DMSK==1_':' + 1_'.' + 1_'/' + 1_'=' ;BREAKS

DLGSTR:	MOVE	P3,DIASAG	;Get DIALOG='string' arg.
	TXO	F,F%INDST	;Set flag saying we're now doing DIALOG='string'
	XMOVEI	T1,[ASCIZ/DIALOG=/]
	 SKIPA

DIALOG:	XMOVEI	T1,[ASCIZ/DIALOG/]
	MOVEM	T1,%ARGNM	;Store arg name incase errors
	PUSHJ	P,SAVERR	;DIVERT ERR MSGS TO TTY
	PUSHJ	P,%SAVE4	;SAVE P ACS

	TXNE	F,F%INDST	;DIALOG FROM STRING?
	  JRST	DIABLT		;YES, SKIP PROMPT
	SKIPN	G.EFS		;SKIP IF ALREADY TYPED ONCE
;	  IOERR	(EFS,,,[,Enter correct file specs)
	  $ECALL EFS
	SETOM	G.EFS		;SUPPRESS NEXT TIME

RESCN:	OUTCHR	["*"]		;PROMPT

	MOVE	P3,[POINT 7,TXTBUF] ;POINT TO TEXT DESTINATION
	MOVEI	P4,LTEXT*5-1
DIAINP:	INCHWL	T1		;READ CHAR
	CAIE	T1," "		;SPACE?
	CAIN	T1,15		;CR?
	  JRST	DIAINP		;YES, SKIP IT
	CAIN	T1,11		;TAB TOO
	  JRST	DIAINP
	CAIN	T1,33		;ALT?
	  JRST	DIAALT		;YES
	CAIN	T1,12		;LF?
	  JRST	DIALF		;YES
	IDPB	T1,P3		;ELSE STORE IN BUFFER
	SOJG	P4,DIAINP	;READ WHOLE STRING
;	IOERR	(DTL,,,?,Dialog string too long,,%RESCN)
	$ECALL	DTL,RESCN


DIABLT:	MOVEM	P3,SRCBP
	MOVE	P3,[POINT 7,(P3)] ;Make pointer to arg
	EXCH	P3,SRCBP
	MOVEI	P4,LTEXT*5-1	;MAX STRING LENGTH IS SIZE OF BUFFER
	MOVE	T2,[POINT 7,TXTBUF] ;POINT TO BUFFER
	MOVE	T3,DIASAT	;Get arg type

DIABL1:	ILDB	T1,SRCBP	;GET BYTE FROM ARG
	JUMPE	T1,DIABL3	;NULL, DONE
	CAIE	T1," "		;SPACE?
	  JRST	DIABL2		;NO
	CAIN	T3,TP%LIT	;LITERAL ARG?
	  JRST	DIABL1		;YES, SUPPRESS SPACE
	JRST	DIABL3		;NO, TERMINATES ARG
DIABL2:	IDPB	T1,T2		;STORE CHAR
	SOJG	P4,DIABL1	;LOOP
;	IOERR	(DTL,,,?,Dialog string too long)
	$ECALL	DTL,RESCN

DIABL3:	SETZ	T1,		;TERMINATE WITH NULL
	IDPB	T1,T2
	JRST	DIASC2		;DONE
;STILL IF10

DIAALT:	OUTSTR	%CRLF		;TYPE CRLF AFTER ALT
DIALF:	LDB	T1,P3		;CHECK LAST CHAR IN BUFFER
	CAIE	T1,"-"		;CONTINUATION?
	  JRST	DIASC1		;NO, GO PARSE DIALOG STRING

	ADD	P3,[47B5]	;DECREMENT P3 TO OVERWRITE -
	TLCN	P3,(1B0)
	  SUB	P3,[430000,,1]
	JRST	DIAINP		;KEEP READING

DIASC1:	SETZ	T1,		;FLAG END OF ASCIZ STRING
	IDPB	T1,P3

;Now string has been stored in TXTBUF.

DIASC2:	MOVE	P3,[POINT 7,TXTBUF] ;POINT TO TEXT BUFFER
	MOVEM	P3,SRCBP
	SETZM	%NCHRR		;# chars read so far = 0
	MOVEI	P4,LTEXT*5-1	;MAX STRING LENGTH IS SIZE OF BUFFER

;SRCBP = current bp to source string.

DIASCN:	PUSHJ	P,DPRS1		;Parse filename or device ...
	 JRST	RESCN		;Error, let him try again
	CAIN	T1,":"		;Colon terminator?
	 JRST	DIADEV		;Yes, we just got a device
DIASN1:	SKIPE	T2,ATMBUF	;Filename?
	 MOVEM	T2,FILE(D)	;Yes, store it
	SKIPE	T2,ATMBUF
	 TXO	F,F%FSS		;Got filespec info
	JUMPE	T1,%POPJ	;Return if at end
	CAIN	T1,"."		;Extension coming?
	 JRST	DIAEXT		;Yes
	CAIN	T1,"["		;Path coming?
	 JRST	DIAPTH		;Yes
	CAIN	T1,.CHLAB	;Protection coming?
	 JRST	DIAPRO		;Yes
	CAIN	T1,"/"		;Switch coming?
	 JRST	DIASW1		;Yes
	$ECALL	IDD,RESCN	;?Illegal character

;Got a device (":" was delimiter)

DIADEV:	SKIPN	T2,ATMBUF	;DEV
	 $ECALL	NDI,RESCN	;?Null device
	MOVEM	T2,DEV(D)
	TXO	F,F%DSS		;He specified a device
	PUSHJ	P,DPRS1		;Parse filename..
	 JRST	RESCN		;Error, let him try again
	CAIE	T1,":"		;Another device?
	 JRST	DIASN1		;No, ok
	$ECALL	IDD,RESCN	;?Illegal character

;Next thing is extension ("." seen)

DIAEXT:	PUSHJ	P,DPRS2		;Parse extension
	 JRST	RESCN		;Error, let him try again
	TXO	F,F%EXT!F%FSS	;EXT IS EXPLICITLY SPECIFIED, EVEN IF NULL
	HLLZ	T2,ATMBUF
	MOVEM	T2,EXT(D)
	JUMPE	T1,%POPJ	;Return if at end
	CAIN	T1,"["		;Path coming?
	 JRST	DIAPTH		;Yes
	CAIN	T1,.CHLAB	;Start of protection
	 JRST	DIAPRO
	CAIN	T1,"/"		;Switch coming?
	 JRST	DIASW1		;Yes
	$ECALL	IDD,RESCN	;?Illegal character
;STILL IF10

;Parse a protection (Left angle bracket seen).

DIAPRO:	PUSHJ	P,DOCT		;Read protection
	CAIE	T1," "		;space?
	CAIN	T1,.CHRAB	;End of field?
	 PUSHJ	P,DPRCHR	;Yes, get next char.
	JUMPE	T1,DIPROK	;Jump if ok delimiter
	CAIE	T1,"["		;Start of PPN
	CAIN	T1,"/"		; or switch is ok
	 JRST	DIPROK
	$ECALL	IDD,RESCN	;Else "illegal character"

DIPROK:	DPB	T2,[POINTR (PROT(D),RB.PRV)] ;STORE IN DDB
	JUMPE	T1,%POPJ	;Return if end of string
	CAIN	T1,"/"		;Switch coming?
	 JRST	DIASW1		;Yes
;Must be "["
;	CAIN	T1,"["		;Start of PPN?
	 JRST	DIAPTH		;Yes
;STILL IF10

DIAPTH:	PUSHJ	P,DPTH		;READ PATH
	 JRST	RESCN		;Error
	CAIE	T1,"]"		;End square bracket?
	CAIN	T1," "		; or space?
	 PUSHJ	P,DPRCHR	;Yes, get next char
	JUMPE	T1,%POPJ	;Return if at end
	CAIN	T1,.CHLAB	;Protection coming?
	 JRST	DIAPRO		;Yes
	CAIN	T1,"/"		;Switch coming?
	 JRST	DIASW1		;Yes
	$ECALL	IDD,RESCN	;?Illegal character

;Routine to parse a path
;Reads from SRCBP updates %NCHRR
;Puts path in DDB.
;If errors, returns .+1 ($ECALL given)
;  if ok, returns .+2

DPTH:	PUSHJ	P,DOCT		;READ PPN
	CAIN	T2,0		;ALLOW [P,] AND [,PN] AND [,,SFD]
	  HLRZ	T2,G.PPN
	CAIN	T1,0
;	  IOERR	(IPP,,,?,Illegal PPN,,REQDIA)
	  $ECALL IPP,%POPJ
	CAIE	T1,","
	  $ECALL IDD,%POPJ
	PUSH	P,T2
	PUSHJ	P,DOCT
	CAIN	T2,0
	  HRRZ	T2,G.PPN
	HRLM	T2,(P)
	POP	P,T2
	MOVSM	T2,PTHB+.PTPPN(D)
	TXO	F,F%FSS		;"Filespec info seen"

	MOVEI	P2,PTHB+.PTPPN+1(D) ;POINT TO SFD BLOCK
DIASFD:	SETZM	(P2)		;FLAG END OF SFD LIST
	JUMPE	T1,%POPJ1	;CHECK DELIMITER.  END OF STRING IS OK
	CAIE	T1,"]"		;RIGHT BRACKET TERMINATES PATH
	CAIN	T1," "		;SO DOES SPACE
	  JRST	%POPJ1
	CAIE	T1,","		;COMMA MEANS SFDS COMING
	 $ECALL	IDD,%POPJ	;ELSE ILL DELIMITER IN DIALOG

	CAIL	P2,PTHB+.PTPPN+6(D) ;CHECK SFD COUNT
;	  IOERR	(TMF,,,?,Too many SFDs,,REQDIA)
	  $ECALL TMF,%POPJ
	PUSHJ	P,DPRS3		;READ SFD NAME
	 POPJ	P,		;Error
	SKIPN	T2,ATMBUF	;GET SFD
;	  IOERR	(NSI,,,?,Null SFD,,REQDIA)
	  $ECALL NSI,%POPJ
	MOVEM	T2,(P2)		;STORE IN PATH BLOCK
	AOJA	P2,DIASFD	;KEEP GOING
;STILL IF10
;Parsing routines for DIALOG mode

;Read DEV or FILESPEC or delimiter

DPRS1:	MOVE	T3,[POINT 6,ATMBUF] ;Store sixbit in atom buffer
	SETZM	ATMBUF
DPRS1A:	PUSHJ	P,DPRCHR	;Get next char, ignore spaces
	JUMPE	T1,%POPJ1	;0 ok
	CAIE	T1,":"		;COLON
	CAIN	T1,"."		;Dot
	 JRST	%POPJ1		;Are ok
	CAIE	T1,"["		;Start of PPN
	CAIN	T1,"/"		;Start of switch
	 JRST	%POPJ1		;Are ok
	CAIN	T1,.CHLAB	;And start of protection
	 JRST	%POPJ1
	PUSHJ	P,DPRCSX	;Convert char to sixbit
	 POPJ	P,		;Problem, return
	TLNE	T3,770000	;Room?
	 IDPB	T1,T3		;Yes, store in BP
	JRST	DPRS1A		;Loop

;Same as DPRS1 except ":" and "." are not legal delimiters

DPRS2:	MOVE	T3,[POINT 6,ATMBUF]
	SETZM	ATMBUF
DPRS2A:	PUSHJ	P,DPRCHR	;Get next char, ignore spaces
	JUMPE	T1,%POPJ1	;Return if done
	CAIE	T1,"["		;Start of PPN
	CAIN	T1,"/"		;Start of switch
	 JRST	%POPJ1		;Are ok
	CAIN	T1,.CHLAB	;Start of protection
	 JRST	%POPJ1
	PUSHJ	P,DPRCSX	;Convert char to sixbit
	 POPJ	P,		;Problem, return
	TLNE	T3,770000	;Room?
	 IDPB	T1,T3		;Yes, store in BP
	JRST	DPRS2A		;Loop

;Parse SFD names (sixbit)

DPRS3:	MOVE	T3,[POINT 6,ATMBUF]
	SETZM	ATMBUF
DPRS3A:	PUSHJ	P,DPRCHS	;Get next char (space not ignored)
	JUMPE	T1,%POPJ1	;Return if done
	CAIE	T1,"]"		;End of PPN ok
	CAIN	T1,","		;Comma ok
	 JRST	%POPJ1
	CAIN	T1," "		;Space ok
	 JRST	%POPJ1
	PUSHJ	P,DPRCSX	;Convert char to sixbit
	 POPJ	P,		;Problem, return
	TLNE	T3,770000	;Room?
	 IDPB	T1,T3		;Yes, store in BP
	JRST	DPRS3A		;Loop
;Parse a switch

DPRSWT:	MOVE	T3,[POINT 6,ATMBUF]
	SETZM	ATMBUF
DPRSW1:	PUSHJ	P,DPRCHR	;Get char
	JUMPE	T1,%POPJ1	;End ok
	CAIE	T1,"="		;Delimiters for switch value ok
	CAIN	T1,":"
	 JRST	%POPJ1
	CAIN	T1,"/"		;Another switch ok
	 JRST	%POPJ1
	PUSHJ	P,DPRCSX	;Convert char to sixbit
	 POPJ	P,		;Error
	TLNE	T3,770000	;If room,
	 IDPB	T1,T3		;Store in BP
	JRST	DPRSW1		;Loop

;Parse a switch value

DPRSWV:	MOVE	T3,[POINT 6,ATMBUF]
	SETZM	ATMBUF
DPRSV1:	PUSHJ	P,DPRCHR	;Get char
	JUMPE	T1,%POPJ1	;END ok
	CAIN	T1,"/"		;Another switch ok
	 JRST	%POPJ1
	PUSHJ	P,DPRCSX	;Convert to sixbit
	 POPJ	P,		;?Error
	TLNE	T3,770000	;If room,
	 IDPB	T1,T3		;Store char
	JRST	DPRSV1		;Loop

;Parse a switch value in OPEN keyword arg.
;Leading spaces are ignored.

PRSSWV:	MOVE	T3,[POINT 6,ATMBUF]
	SETZM	ATMBUF
PRSSV1:	PUSHJ	P,DPRCHR	;Get next char
	JUMPE	T1,%POPJ1	;END ok
	JRST	PRSSV3		;Got 1st char
PRSSV2:	PUSHJ	P,DPRCHS	;Get next char (don't ignore spaces)
	JUMPE	T1,%POPJ1	;Null ends it
	CAIN	T1," "		; and space ends it
	 JRST	%POPJ1
PRSSV3:	PUSHJ	P,DPRCSX	;Convert to sixbit
	 POPJ	P,		;?error
	TLNE	T3,770000	;If room,
	 IDPB	T1,T3		;Store char
	JRST	PRSSV2		;Loop for all chars
;Translate char in T1 to sixbit
;Must be a letter or number
;Returns .+1 if problem (IDD error given), .+2 if ok

DPRCSX:	CAIL	T1,"A"+40	;Check for lowercase letter
	CAILE	T1,"Z"+40
	 CAIA			;not
	SUBI	T1,40		;Translate to upper case
	CAIL	T1,"A"		;Letter?
	CAILE	T1,"Z"
	 JRST	DPRCS1		;No
DPRCS2:	SUBI	T1,40		;Translate to sixbit
	JRST	%POPJ1		;Return ok
DPRCS1:	CAIL	T1,"0"		;Digit?
	CAILE	T1,"9"
	 $ECALL	IDD,%POPJ	;No, return
	JRST	DPRCS2		;Yes, Ok
;STILL IF10

DIASWT:	PUSHJ	P,DPRCHR	;Get next non-space char.
DIASW1:	JUMPE	T1,%POPJ	;NONE, DONE
	CAIE	T1,"/"		;BEGINNING OF SWITCH?
	 $ECALL	IDD,RESCN	;NO, BAD
	PUSHJ	P,DPRSWT	;Parse a switch
	 JRST	RESCN		;Error - bad char

DSWOK:	MOVEI	T1,OPNSWT	;LOOK UP KEYWORD
	MOVEI	T2,ATMBUF
	MOVE	T5,ATMBUF	;Get sixbit word to type incase error
	PUSHJ	P,TABLK
;	  IOERR	(USW,,,?,Unknown switch /$S,T5,%RESCN)
	  $ECALL USW,RESCN
;	  IOERR	(ASW,,,?,Ambiguous switch /$S,T5,%RESCN)
	  $ECALL ASW,RESCN
	HRRZ	P1,(T1)		;GET KEYWORD NUMBER
	HRRZ	T2,OPNDSP(P1)	;POINT TO SWITCH VALUE HANDLER
	TXNE	F,F%CLS		;CLOSE?
	 HRRZ	T2,CLSDSP(P1)	;Yes, different action routines
	JUMPN	T2,.+2		;IF ANY
	  $SNH			;None, internal error
	MOVE	T3,(T2)		;GET ROUTINE ADDRESS OR KEYWORD TABLE
	TLNN	T3,-1		;SEE WHICH
	  JRST	(T3)		;ROUTINE, GO TO IT

DIAKWD:	SETZM	ATMBUF		;Clear buffer
	PUSH	P,T2		;SAVE KWD TABLE ADDRESS
	LDB	T1,%SRCBP	;See if last char was end of switch
	JUMPE	T1,DIAKWW	;Yes, no switch value (gets "?Ambigous")

	PUSHJ	P,DPRSWV	;Parse switch value
	 JRST	[POP P,(P)	;Error, fix stack
		 JRST RESCN]	; and go try again
;	SETZM	ATMBUF+1	;MAKE SURE STRING IS TERMINATED WITH NULL

DIAKWW:	POP	P,T1		;GET KWD TABLE ADDRESS
	MOVEI	T2,ATMBUF
	PUSHJ	P,TABLK
	  JRST	KWDUNK		;UNKNOWN
	  JRST	KWDAMB		;AMBIGUOUS
	HRRZ	T2,(T1)		;GET VALUE
	XCT	OPSTOR(P1)	;STORE IN TABLE
	LDB	T1,SRCBP	;RELOAD DELIMITING CHAR
	JRST	DIASW1		;READ ON
;STILL IF10

DIAOCT:	PUSHJ	P,DOCT		;READ NUMBER, THEN RETURN TO LOOP
	XCT	OPSTOR(P1)
	JRST	DIASW1
DIAINT:	PUSHJ	P,DINT
	XCT	OPSTOR(P1)
	JRST	DIASW1

DOCT:	SKIPA	T5,[^D8]	;RADIX 8
DINT:	MOVEI	T5,^D10		;RADIX 10
	SETZ	T2,		;CLEAR RESULT
DINT1:	ILDB	T1,SRCBP	;GET CHAR
	AOS	%NCHRR
	CAIL	T1,"0"		;DIGIT?
	CAIL	T1,"0"(T5)
	  POPJ	P,		;NO, RETURN
	IMULI	T2,(T5)		;ADD THIS DIGIT IN
	ADDI	T2,-"0"(T1)
	JRST	DINT1		;LOOP

DIACHR:	PUSHJ	P,DPRCHS	;Get char
	CAIE	T1,""""		;STARTING QUOTE?
;	  IOERR	(NQS,,,?,PADCHAR must be single char in double quotes,,%RESCN)
EENQS:	  $ECALL NQS,RESCN
	PUSHJ	P,DPRCHS	;Get PAD char
	CAIN	T1,""		;QUOTING CHAR?
	 PUSHJ	P,DPRCHS	;YES, GET CHAR IT QUOTES
	JUMPE	T1,EENQS	;END OF STRING HERE IS AN ERROR
	XCT	OPSTOR(P1)	;STORE IN DDB
	PUSHJ	P,DPRCHS	;Get closing quote
	CAIE	T1,""""		;CLOSING QUOTE?
	 $ECALL	NQS,RESCN	;No, complain
	JRST	DIASWT

DIASET: MOVEI	T2,1		;SET BIT TO 1
	XCT	OPSTOR(P1)
	JRST	DIASWT		;RETURN

;IGNORE THE ARGUMENT

DIAIGN:	PUSHJ	P,CLIGN		;Say "%ignoring.."
	PUSHJ	P,DPRSWT	;Parse switch
	 JRST	RESCN		;?error
	CAIE	T1,"="		;If there is a switch value,
	CAIN	T1,":"
	 JRST	DIAIG1		;Ignore that too
	JRST	DIASW1
DIAIG1:	PUSHJ	P,DPRSWV	;Parse switch value
	 JRST	RESCN		;?Error
	JRST	DIASW1		;Go on

> ;IF10
;ROUTINE TO PUSH U.ERR SO DIALOG IS WITH TTY, NOT FILE
;DOES NOT HANDLE SKIP RETURNS

SAVERR:	SKIPN	U.ERR		;ERR UNIT SET?
	  POPJ	P,		;NO, NOTHING TO DO

	PUSH	P,U.ERR		;SAVE IT
	SETZM	U.ERR		;CLEAR IT SO WE USE TTY
	PUSHJ	P,@-1(P)	;CALL CALLER
	POP	P,U.ERR		;RESTORE U.ERR
	POP	P,(P)		;Discard one return so don't return
				; after "PUSHJ P,SAVERR".
	POPJ	P,		;DONE
	SUBTTL	DO OPEN

;Call:
;	MOVX	T1,GTJFN bits GJ%OLD or GJ%NEW or GJ%FOU
;	PUSHJ	P,DOOPEN
;	 <return here if error, f%DRE set>
;	<return here if ok>
IF20,<

DOOPEN:	MOVEM	T1,GJBTS	;Save GTJFN bits
	LOAD	T1,IJFN(D)	;Get JFN
	MOVE	T2,FLAGS(D)	;Get DDB flags
	TXNE	T2,D%RJN	;Do we have a real JFN already?
	 JRST	DOOPN1		;Yes
	CAIN	T1,.PRIIN	;Controlling TTY:?
	 JRST	DOOPN2		;Yes, bypass a lot of this..
	SKIPE	T2,T1		;Skip if no JFN at all, get in T2
	 PUSHJ	P,DOJFNS	;Get info in file block
	PUSHJ	P,SETJFN	;Setup JFN info
	MOVE	T1,GJBTS	;Get JFN bits to set
	TXO	T1,GJ%XTN	;Extended GTJFN
	HLLM	T1,JFNBLK+.GJGEN ;Store away
	MOVEI	T1,JFNBLK	;Get a JFN
	MOVEI	T2,[0]
	GTJFN%
	 ERJMP	GJERR		;Failure return

;Here when got real JFN in T1

DOOPN1:	STORE	T1,IJFN(D)	;Store
	STORE	T1,OJFN(D)
	PUSHJ	P,CTTYJF	;Get .PRIIN if TTY:
	MOVX	T0,D%RJN	;"Got a real JFN now"
	CAIE	T1,.PRIIN	;Skip if controlling TTY:
	 IORM	T0,FLAGS(D)	;Set the flag
DOOPN2:	PUSHJ	P,GMODBY	;Get DMBS, BPW

;Do OPENF

	PUSHJ	P,%CHKNR	;Check data mode
	 POPJ	P,		;Illegal, go have DIALOG
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PUSHJ	P,@SABDT(T1)	;SET ACCESS BY DEVICE TYPE
	OR	T2,DMBS(D)	;SET DATA MODE, BYTE SIZE
	LOAD	T1,IJFN(D)	;GET JFN

;T1= JFN
;T2= proper OPENF flag bits

	CAIE	T1,.PRIIN	;Don't OPENF TTY:
	OPENF%			;OPEN file
	 ERJMP	OPFERR		;Can't

	MOVEI	T2,AC.SOU	;Change ACCESS to SEQOUT
	LOAD	T1,INDX(D)	; If device was a TTY
	CAIN	T1,DI.TTY
	 STORE	T2,ACC(D)

	LOAD	T1,ACC(D)	;GET ACCESS
	MOVE	T2,ACCTAB(T1)	;Get bits to set in DDB flags
	IORM	T2,FLAGS(D)	; Set 'em

;OPFSTT - called when OPENF% is successful to finish setup.

OPFSTT:	LOAD	T2,INDX(D)	;Get device index
	PUSHJ	P,@[
		  IFIW	TTYSET
		  IFIW	DSKSET
		  IFIW	MTASET
		  IFIW	XXXSET
		  IFIW	E..SNH](T2) ;Do device-dependent stuff
	 PJRST	REQDIA		;Failed, request DIALOG

	PUSHJ	P,FIXDEF	;Defaults after everything is in place.
	PUSHJ	P,FIXU		;Fixup this unit block
	PUSHJ	P,DOCONS	;Do consolidation of DDB's if necessary
	TXNE	F,F%CTTY	;Is this the controlling TTY:?
	 MOVEM	D,D.TTY		;Yes, store the TTY's DDB address
	JRST	%POPJ1		;Skip return

SABDT:	IFIW	TTYSA		;TTY
	IFIW	DSKSA		;DSK
	IFIW	MTASA		;MTA
	IFIW	XXXSA		;OTHER

TTYSA:	MOVX	T2,OF%RD+OF%WR	;READ + WRITE ACCESS
	POPJ	P,

XXXSA:
DSKSA:	LOAD	T2,ACC(D)	;GET ACCESS TYPE
	HRRZ	T2,FILTAB(T2)	;GET ACCESS BITS
	JUMPN	T2,%POPJ	;LEAVE IF GOT ANY
	MOVX	T2,OF%RD	;NONE. TRY READ
	MOVE	T0,FLAGS(D)	;Get DDB flags
	TXNE	T0,D%IO		;UNLESS WE'RE WRITING
	 MOVX	T2,OF%WR
	POPJ	P,

MTASA:	LOAD	T2,ACC(D)	;GET ACCESS
	CAIN	T2,AC.APP	;APPEND?
	 JRST	MTAPP		;YES. GET WRITE ACCESS INSTEAD
	HRRZ	T2,FILTAB(T2)	;GET ACCESS BITS
	JUMPN	T2,%POPJ	;LEAVE IF WE GOT ANY
	MOVX	T2,OF%RD	;NONE. TRY READ
	MOVE	T0,FLAGS(D)	;Get DDB flags
	TXNE	T0,D%IO		;UNLESS WE'RE WRITING
MTAPP:	 MOVX	T2,OF%WR
	POPJ	P,

;Routine to get DMBS, BPW based on /MODE

GMODBY:	LOAD	T1,MODE(D)	;GET /MODE
	MOVE	T1,MODTAB(T1)	;GET DATA MODE, BYTE SIZE
	TLZ	T1,(OF%MOD)	;USE DATA MODE 0 FOR ALL FILES
	MOVEM	T1,DMBS(D)	;STORE IN DDB

	MOVEI	T1,^D36		;GET WORD SIZE
	LOAD	T2,BSIZ(D)	;GET BYTE SIZE
	IDIVI	T1,(T2)		;CALC BYTES/WORD
	STORE	T1,BPW(D)	;SAVE IT
	POPJ	P,		;Return

SEGMENT DATA
GJBTS:	BLOCK	1		;GTJFN bits for DOOPEN
SEGMENT CODE
;ERRORS - UNDO JSYSES THAT HAVE SUCCEEDED, THEN GO HAVE DIALOG

FDBERR:	LOAD	T1,IJFN(D)	;GET THE JFN
	CLOSF%			;CLOSE THE FILE
	  JSHALT		;SHOULDN'T FAIL
	JRST	OPFER1		;NO NEED TO RELEASE JFN

OPFERR:	LOAD	T1,IJFN(D)	;GET THE JFN BACK
	JUMPE	T1,OPFER1	;IF WE HAVE ONE
	RLJFN%			;RELEASE THE UNOPENED JFN
	  JSHALT		;SHOULD NOT FAIL
OPFER1:	SETZ	T1,		;CLEAR JFN STORED IN DDB
	STORE	T1,IJFN(D)
	STORE	T1,OJFN(D)

GJERR:; IOERR	(OPE,30,,?,$J,,REQDIA) ;TYPE ERROR MESSAGE, TRY AGAIN
	$ECALL	OPE,REQDIA
;ROUTINE TO SET UP TERMINAL

TTYSET:	MOVX	T1,D%SICR+D%SILF ;Suppress initial CRLF for terminals
	IORM	T1,FLAGS(D)	; . .
	LOAD	T1,IJFN(D)	;GET JFN
	RFCOC%			;SAVE CCOC WORDS FOR USE DURING TEXTI
	DMOVEM	T2,CCOC(D)
	AND	T2,%CCMSK	;SET CCOC FOR CORRECT OUTPUT
	IOR	T2,%OCCOC	;LEAVE ^I AND ^L AS THEY WERE, SET OTHERS
	MOVE	T3,%OCCOC+1	; TO SEND LITERALLY
	SFCOC%

	MOVE	T1,RSIZE(D)	;RECORD SIZE SPECIFIED?
	JUMPN	T1,%POPJ1	;YES, IT WINS; DON'T OVERWRITE LINE WIDTH

	LOAD	T1,OJFN(D)	;GET JFN
	MOVEI	T2,.MORLW	;READ LINE WIDTH
	MTOPR%
	  ERJMP	[SETZ T3,	;CAN'T, MAKE A GUESS
		 JRST .+1]
	CAIN	T3,0		;LINE WIDTH SET?
	  MOVEI	T3,^D72		;NO, GUESS 72
	STORE	T3,TTYW(D)	;STORE LINE SIZE FOR NAMELIST AND LIST-DIRECTED
	JRST	%POPJ1		;DONE

;	        @ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ \ ] ^ _
%OCCOC:	BYTE (2)1,2,2,2,2,2,2,2,2,0,2,2,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
%CCMSK:	BYTE (2)0,0,0,0,0,0,0,0,0,3,0,0,3,0,0,0,0,0
;ROUTINE TO SET UP DISK

DSKSET:	LOAD	T1,IJFN(D)	;GET JFN
	MOVSI	T2,1+.FBSIZ	;READ UP THROUGH FILE SIZE
	MOVEI	T3,FDB		;POINT TO DEST BUFFER
	GTFDB%			;READ FDB
	  ERJMP	FDBERR		;CAN'T

	LOAD	T1,STAT(D)	;GET /STAT
	CAIE	T1,ST.OLD	;/STAT:OLD?
	CAIN	T1,ST.NEW	;OR /STAT:NEW?
	  JRST	.+2		;YES, MUST CHECK IT
	JRST	DSET1		;NO
	MOVE	T2,FDB+.FBCTL	;GET FILE BITS
	CAIN	T1,ST.OLD	;/STAT:OLD?
	  TXC	T2,FB%NXF	;YES, FILE MUST EXIST

DSET1:	LDB	T1,[POINTR (FDB+.FBBYV,FB%BSZ)] ;GET FILE BYTE SIZE
	CAIN	T1,0		;ZERO?
	  MOVEI	T1,^D36		;YES, SET 36-BIT BYTES
	LOAD	T2,BSIZ(D)	;GET /MODE-IMPLIED BYTE SIZE
	MOVEI	T3,^D36		;GET NUMBER OF BITS IN A WORD
	IDIVM	T3,T1		;GET OLD BYTES PER WORD
	IDIVM	T3,T2		;AND NEW BYTES PER WORD
	STORE	T2,BPW(D)	;REMEMBER NUMBER OF BYTES PER WORD
	MOVE	T3,FDB+.FBSIZ	;GET NUMBER OF OLD BYTES IN THE FILE
	MULI	T3,(T2)		;CONVERT TO NUMBER OF NEW BYTES IN THE FILE
	ADDI	T4,-1(T1)	;ROUND UP
	DIVI	T3,(T1)
	MOVEM	T3,EOFN(D)	;STORE IN DDB

	LOAD	T1,BUFCT(D)	;GET BUFFER (PAGE) COUNT
	PUSHJ	P,%GTPGS	;ALLOCATE THAT MANY PAGES
	 $ECALL	MFU,%ABORT	;?Can't, memory full
	MOVE	T0,FLAGS(D)	;Get DDB flags
	TXNN	T0,D%RAN	;Is this a RANDOM file?
	  jrst	dset2		;no

	push	p,t1
	load	t1,bufct(d)	;get page count
	pushj	p,%gtblk	;get a block for the page table
	pop	p,t2		;get first page number in window
	hrloi	t2,(t2)		;get process page,,impossible file page
	load	t3,bufct(d)	;get count again
	movni	t3,(t3)		;negate
	hrli	t1,(t3)		;make aobjn pointer
	move	t3,t1		;copy
dset3:	movem	t2,(t3)		;store process page,,file page
	add	t2,[1,,0]	;bump to next process page in window
	aobjn	t3,dset3	;loop

	HRRZM	T1,WPTR(D)	;store
	MOVEM	T1,WTAB(D)
	LOAD	T1,BPW(D)	;GET BYTES/WORD
	LSH	T1,9		;GET # BYTES IN A PAGE
	MOVEM	T1,WSIZ(D)	;STORE AS WINDOW SIZE

	JRST	%POPJ1		;ALL SET

DSET2:	MOVEM	T1,WTAB(D)	;SAVE PAGE ADDRESS
	ANDI	T1,777		;Just local section's page #
	LSH	T1,9		; Save local CORE ADDRESS
	MOVEM	T1,WADR(D)
	LOAD	T1,BUFCT(D)	;GET BUFFER COUNT
	LSH	T1,9		;GET WORD COUNT IN WINDOW
	LOAD	T2,BPW(D)	;GET # BYTES/WORD
	IMULI	T1,(T2)		;GET # BYTES IN WINDOW
	MOVEM	T1,WSIZ(D)	;STORE AS WINDOW SIZE
	JRST	%POPJ1
;ROUTINE TO SET UP MTA

MTASET:	PUSHJ	P,%SAVE1	;SAVE P1

	HRLOI	T1,377777	;MARK FILE NOT AT EOF YET
	MOVEM	T1,EOFN(D)

	STKVAR	<LABINF,>	;GET TWO TEMP WORDS
	LOAD	T1,IJFN(D)	;GET LABEL TYPE OF TAPE
	MOVEI	T2,.MORLI	;READ LABEL INFO
	MOVEI	T3,2		;SET ARG BLOCK LENGTH
	MOVEM	T3,LABINF
	MOVEI	T3,LABINF	;POINT TO ARG BLOCK
	MTOPR%			;READ LABEL INFO
	  ERJMP	[MOVEI T3,1	;CAN'T, ASSUME UNLABELED
		 MOVEM T3,1+LABINF
		 JRST .+1]
	MOVE	T1,1+LABINF	;GET LABEL TYPE
	UNSTK			;DISCARD TEMP VARS
	STORE	T1,LTYP(D)	;STORE FOR LATER
	CAIE	T1,.LTUNL	;LABELED TAPE?
	  JRST	LABSKP		;YES, DO NOT TRY TO SET UP DENSITY AND FRIENDS

	LOAD	T1,IJFN(D)	;GET JFN OF TAPE
	MOVEI	T2,.MOSDN	;SET DENSITY
	LOAD	T3,DEN(D)	;GET /DENSITY
	MOVEI	P1,[ASCIZ /density/] ;GET TEXT FOR ERR MESSAGE
	MTOPR%			;SET IT
	  ERCAL MOPERR		;SHOULDN'T FAIL, BUT DON'T DIE

	MOVEI	T2,.MOSPR	;SET PARITY
	LOAD	T3,PAR(D)	;GET /PARITY
	MOVEI	P1,[ASCIZ /parity/]
	MTOPR%			;SET IT
	  ERCAL MOPERR

	LOAD	T2,TAPM(D)	;GET /TAPEMODE
	SETZ	T3,		;USERS DEFAULT TAPE MODE
	CAIN	T2,TM.IND	;INDUSTRY COMPATIBLE?
	  MOVEI	T3,.SJDM8	;YES, SET 8-BIT BYTES
	CAIN	T2,TM.DMP	;COREDUMP?
	  MOVEI	T3,.SJDMC	;YES, SET CORE DUMP
	CAIN	T2,TM.ANS	;ANSI-ASCII?
	  MOVEI	T3,.SJDMA	;YES, 7-BITS IN 8 BIT BYTES
	JUMPE	T3,MTARS	;NO EXPLICIT MODE
	MOVEI	T2,.MOSDM	;SET HARDWARE DATA MODE
	MOVEI	P1,[ASCIZ /data mode/]
	MTOPR%			;SET IT
	  ERCAL	MOPERR

MTARS:	MOVEI	T2,.MOSRS	;SET RECORD SIZE
	LOAD	T3,BLKSZ(D)	;GET FILE BLOCK SIZE
	JUMPE	T3,MTANRS	;IF SET
	MOVEI	P1,[ASCIZ /block size/]
	MTOPR%			;SET IT
	  ERCAL	MOPERR

MTANRS:	MOVE	T0,FLAGS(D)	;Get DDB flags
	TXNN	T0,D%APP	;Are we appending?
	  JRST	MTANAP		;NO
	MOVEI	T2,.MOFWF	;FORWARD ONE FILE
	MTOPR%
	  ERJMP	APPERR
	MOVEI	T2,.MOBKR	;BACK OVER TAPE MARK
	MTOPR%
	  ERJMP	APPERR
MTANAP:
LABSKP:	LOAD	T1,IJFN(D)	;GET JFN
	MOVEI	T2,.MORRS	;READ RECORD SIZE
	MTOPR%
	 ERJMP	MOPERR		;SHOULDN'T EVER FAIL...
	LOAD	T2,BPW(D)	;GET # BYTES/WORD
	ADDI	T3,-1(T2)	;GET # WORDS, ROUNDED UP
	IDIVI	T3,(T2)
	MOVEI	T1,(T3)		;RECORD # WORDS
	IMULI	T3,(T2)		;GET CHARS AGAIN
	MOVEM	T3,WSIZ(D)	;SAVE AS WINDOW SIZE
	PUSHJ	P,%GTBLK	;ALLOCATE A BLOCK
	MOVEM	T1,WADR(D)	;SAVE THE ADDRESS OF THE BUFFER
	JRST	%POPJ1


XXXSET:	HRLOI	T1,377777	;SET FILE VERY LARGE
	MOVEM	T1,EOFN(D)
	MOVEI	T1,1		;GET A BUFFER PAGE
	STORE	T1,BUFCT(D)	;STORE BUFFER COUNT
	LSH	T1,9		;MAKE # WORDS
	LOAD	T2,BPW(D)	;GET # BYTES/WORD
	IMULI	T2,(T1)		;GET # BYTES/BUFFER
	MOVEM	T2,WSIZ(D)	;STORE AS WINDOW SIZE
	PUSHJ	P,%GTBLK
	MOVEM	T1,WADR(D)	;STORE ADDRESS OF BUFFER

	JRST	%POPJ1		;ALL SET


MOPERR:; IOERR	(UMO,30,,%,$J trying to set tape $A,<P1>,%POPJ)
	$ECALL	UMO,%POPJ

APPERR:; IOERR	(APP,30,,?,$J,,%POPJ)
	$ECALL	APP,%POPJ
;ROUTINE TO FILL IN GTJFN BLOCK FROM DDB
;POINTS DEFAULTS AT THE STRINGS STORED IN THE DDB
;SETS UP THE FLAGS APPROPRIATELY FROM /ACCESS AND /STATUS


SETJFN:	LOAD	T2,IJFN(D)	;ALREADY HAVE A JFN?
	JUMPE	T2,SETJ1	;NO, SKIP

	PUSHJ	P,DOJFNS	;CONVERT JFN TO ASCIZ, STORE IN GTJFN BLOCK

	MOVE	T1,T2		;RELEASE THE JFN
	CAIE	T1,.PRIIN	;If not real JFN,
	CAIN	T1,.PRIOU	;. .
	 JRST	SETJF0		;Don't release it
	RLJFN%
	  JSHALT		;SHOULD NOT FAIL

SETJF0:	MOVX	T1,D%RJN	;Clear "Got a real JFN" flag
	ANDCAM	T1,FLAGS(D)	; if set.
	SETZ	T1,		;CLEAR JFN FIELDS IN DDB
	STORE	T1,IJFN(D)
	STORE	T1,OJFN(D)

	MOVEI	T1,ATMBUF	;POINT TO ASCIZ GENERATION NUMBER
	PUSHJ	P,ASCDEC	;CONVERT TO BINARY
	  $SNH			;Shouldn't fail
	HRRZM	T1,XGEN(D)	;Store in DDB
SETJ1:	LOAD	T1,ACC(D)	;GET /ACCESS
	HLLZ	T1,FILTAB(T1)	;GET SOME APPROPRIATE FLAG BITS
	HRR	T1,XGEN(D)	;PUT IN DEFAULT GENERATION NUMBER

	LOAD	T2,DVTYP(D)	;GET DEV TYPE
	CAIE	T2,.DVDSK	;DISK?
	  TXZ	T1,GJ%OFG	;NO, CLEAR PARSE-ONLY BIT

	LOAD	T2,STAT(D)	;GET /STATUS
	CAIN	T2,ST.OLD	;/STATUS:OLD?
	  TXO	T1,GJ%OLD	;YES, IMPLIES GTJFN BIT
	CAIN	T2,ST.NEW	;/STATUS:NEW?
	  TXO	T1,GJ%NEW	;YES, IMPLIES GTJFN BIT
	TXNE	T1,GJ%OLD	;KEEP FLAG BITS CONSISTENT
	  TXZ	T1,GJ%NEW+GJ%FOU ;IF OLD, THEN NOT NEW AND NOT FOR OUTPUT
	TXO	T1,GJ%MSG!GJ%XTN	;ALWAYS TYPE CONFIRMATION MESSAGE
				; and use extended GTJFN block
	MOVEM	T1,JFNBLK+.GJGEN ;STORE IN FLAG WORD
	MOVEI	T1,<.GJATR-.GJF2> ;No flags,,# of words to follow extended word
	MOVEM	T1,JFNBLK+.GJF2

	MOVE	T1,[.NULIO,,.NULIO] ;NO JFNS
	MOVEM	T1,JFNBLK+.GJSRC

	SKIPE	T1,DEV(D)	;DEVICE
	  HRROI	T1,DEV(D)
	MOVEM	T1,JFNBLK+.GJDEV

	SKIPE	T1,DIR(D)	;DIRECTORY
	  HRROI	T1,DIR(D)
	MOVEM	T1,JFNBLK+.GJDIR

	SKIPE	T1,FILE(D)	;FILENAME
	  HRROI	T1,FILE(D)
	MOVEM	T1,JFNBLK+.GJNAM

	SKIPE	T1,EXT(D)	;EXT
	  HRROI	T1,EXT(D)
	MOVEM	T1,JFNBLK+.GJEXT

	SKIPE	T1,PROT(D)	;PROT
	  HRROI	T1,PROT(D)
	MOVEM	T1,JFNBLK+.GJPRO

;SOMETHING LIKE THE FOLLOWING WHEN /TAPEMODE WORKS.
; It can't be done now because you get GTJFN error
; for disk ("?Attribute illegal for this device")
REPEAT 0,<
	XMOVEI	T1,[EXP 2	;2 words in attribute block
		  POINT 7,[ASCIZ/FORMAT:F/]] ;For MAGTAPE
	MOVEM	T1,JFNBLK+.GJATR
>;end repeat 0

	POPJ	P,		;ALL SET
;Routine to get the ASCII filespec fields back out of the JFN
;Call:
;	T2/ JFN
; PUSHJ	P,DOJFNS
;	<return here, ASCII strings in DDB set up>
; Uses T1, T3

DOJFNS:	CAIE	T2,.PRIOU	;TTY:?
	CAIN	T2,.PRIIN	; . .
	 JRST	DOJFN1		;Yes, don't use JFNS%

;"REAL" JFN in T2.
DOJFNR:	HRROI	T1,DEV(D)	;STORE DEVICE AS SUBSEQUENT DEFAULT
	MOVX	T3,FLD(.JSAOF,JS%DEV)
	JFNS%

	HRROI	T1,DIR(D)	;STORE DIRECTORY
	MOVX	T3,FLD(.JSAOF,JS%DIR)
	JFNS%
	TXZ	F,F%PPN		;DIRECTORY IS NOW NOT A PPN

	HRROI	T1,FILE(D)	;STORE FILENAME
	MOVX	T3,FLD(.JSAOF,JS%NAM)
	JFNS%

	HRROI	T1,EXT(D)	;STORE EXTENSION
	MOVX	T3,FLD(.JSAOF,JS%TYP)
	JFNS%

	HRROI	T1,ATMBUF	;STORE GENERATION NUMBER IN ASCIZ
	MOVX	T3,FLD(.JSAOF,JS%GEN)
	JFNS%

	SETZM	PROT(D)		;Clear old protection, if set.
	HRROI	T1,PROT(D)	;STORE PROTECTION
	MOVX	T3,FLD(.JSAOF,JS%PRO)
	JFNS%

;	HRROI	T1,ACCT(D)	;DO SOMETHING REASONABLE ABOUT THIS
;	MOVX	T3,FLD(.JSAOF,JS%ACT)
;	JFNS%

	POPJ	P,

;JFN in T2 was .PRIIN or .PRIOU
;Store filespec as TTY:FORTTY.DAT
DOJFN1:	SETZM	DIR(D)		;No directory
	SETZM	ATMBUF		;No generation number
	SETZM	PROT(D)		;No protection
;	SETZM	ACCT(D)		;No account
	MOVE	T1,[ASCIZ /TTY/]
	MOVEM	T1,DEV(D)	;Store device name
	MOVE	T1,[ASCII /FORTT/]
	MOVEM	T1,FILE(D)	;Store file name..
	MOVE	T1,[ASCIZ /Y/]
	MOVEM	T1,FILE+1(D)
	MOVE	T1,[ASCIZ /DAT/]
	MOVEM	T1,EXT(D)	;Store extension
	POPJ	P,		;Done, return
>;END IF20
IF10,<

;Call:
;	T1/ BITS TO SET WHEN FILE GETS OPENED
;	PUSHJ	P,DOOPEN
;	<here if OPEN failed, F%DRE set (unless ERR= taken)>
;	<here if worked>

DOOPEN:	PUSHJ	P,%SAVE1	;Get a free ac
	MOVE	P1,T1		;Save bits in P1

	LOAD	T1,MODE(D)	;Get /MODE
	LDB	T2,[POINT 4,MODTAB(T1),9] ;And data mode
	STORE	T2,DMODE(D)

	PUSHJ	P,%CHKNR	;Check data mode
	 JRST	REQDIA		;Illegal, go have dialog
	PUSHJ	P,SETOCH	;Set OPEN channel
				;May take ERR= branch
	LOAD	T2,ACC(D)	;Get ACCESS mode
	CAIE	T2,AC.RIN	;RANDOM IO?
	CAIN	T2,AC.RIO
	 JRST [	TXO P1,D%RAN	;Yes, will set "RANDOM" if file opened
		MOVEI T2,.IODMP	;And set "DUMP MODE"
		STORE T2,DMODE(D)
		JRST .+1]

;Do some setup depending on device type

	LOAD	T2,INDX(D)	;Get device index
	PUSHJ	P,@[
		IFIW TTYSET
		IFIW DSKSET
		IFIW MTASET
		IFIW XXXSET
		IFIW E..SNH](T2) ;Do dev-dependent stuff

	  JRST	[PUSHJ P,RETOCH	;?Failed, Return OPEN channel
		PJRST REQDIA]	;Go request DIALOG and return .+1

;Warning-- errors from now on must first un-do the above, for
; example the allocation of buffers for disk, etc.
	MOVE	T1,P1		;Get flags to set in T1
	PUSHJ	P,ALLBUF	;Allocate buffers
	MOVE	T5,P1		;Get fresh flags in T5
	PUSHJ	P,CALOF		;Call OPEN routine based on flags, ACC, STAT
	 POPJ	P,		;error, return .+1

	MOVEI	T2,AC.SOU	;Change ACCESS to SEQOUT
	LOAD	T1,INDX(D)	; If device was a TTY
	CAIN	T1,DI.TTY
	 STORE	T2,ACC(D)

	PUSHJ	P,FIXDEF	;Defaults after everything is in place.
	PUSHJ	P,FIXU		;Fix unit block stuff too
	PUSHJ	P,DOCONS	;Do consolidation of DDB's if necessary
	TXNE	F,F%CTTY	;Is this the controlling TTY:?
	 MOVEM	D,D.TTY		;Yes, store its DDB address.
	JRST	%POPJ1		;Return success

;Routine to clean up from OPEN error (deallocate buffers, channel)
; This is called prior to IOERR call incase the ERR= branch is taken,
;therefore it doesn't need to be called above if CALOF returns .+1.

OFCLNU:	LOAD	T1,BUFAD(D)	;Deallocate buffer (if any)
	JUMPE	T1,OFCLN1	; None
	PUSHJ	P,%FREBLK
	SETZ	T1,
	STORE	T1,BUFAD(D)
OFCLN1:	MOVEI	T1,FBLK(D)	;Point to FILOP. block
	SETZM	.FONBF(T1)	;Clear buffer counts
	SETZM	.FOBRH(T1)	;Clear buffer headers

;Deallocate stuff gotten by DSKSET

	LOAD	T1,INDX(D)	;What type of device
	CAIE	T1,DI.DSK	; If not disk,
	 JRST	OFCLN2		;No more core to deallocate
	LOAD	T1,ACC(D)	;Get ACCESS type
	MOVE	T3,ACCTAB(T1)	;See if random file
	TXNN	T3,D%RAN	; Skip if random
	 JRST	OFCLN2		;No, we didn't allocate any more core
	HRRZ	T1,WTAB(D)	;Get address of page table
	HLRZ	T1,(T1)		;Get number of first block
	LSH	T1,-2		;Get first page # allocated
	HLRE	T2,WTAB(D)	;Get -# words
	MOVN	T2,T2		;# words
	LSH	T2,-2		;# pages
	PUSHJ	P,%FREPGS	;Free up the core
	HRRZ	T1,WTAB(D)	;Now free the page table
	PUSHJ	P,%FREBLK	; . .
	SETZM	WTAB(D)		;Clear all indication that we had memory

OFCLN2:	PUSHJ	P,RETOCH	;Return OPEN channel
	SETZM	FBLK(D)		; Forget file was opened
	POPJ	P,		;Return
;Routine to do general FILOP. setup.
;T1= flags to set.
;Returns .+1 always

ALLBUF:	PUSH	P,T1		;Save flags a sec
	LOAD	T1,ACC(D)	;Get ACCESS
	MOVE	T3,ACCTAB(T1)	;Get flags by ACCESS type
	TXNE	T3,D%RAN	;RANDOM I/O?
	 JRST	NOABUF		;Yes, don't allocate buffer here
	MOVEI	T2,DMOD(D)	;Point ot OPEN block
	DEVSIZ	T2,		;Get buffer size
	 JRST	NOABUF		;No buffers
	JUMPE	T2,NOABUF
	LOAD	T1,BUFCT(D)	;Get /BUFFERCOUNT
	CAIN	T1,0		; If set
	 HLRZ	T1,T2		;Else get default
	STORE	T1,BUFCT(D)	;Store it back
	IMULI	T1,(T2)		;Get total space needed by buffers

	LOAD	T2,INDX(D)	;GET DEVICE INDEX
	CAIN	T2,DI.TTY	;TTY?
	 LSH	T1,1		;Yes, one for input, one for output
NOTIN:	PUSHJ	P,%GTBLK	;Allocate buffers
	STORE	T1,BUFAD(D)	;Save for CLOSE
NOABUF:
	MOVEI	T1,FBLK(D)	;T1 points to FILOP. block
	MOVEI	T2,LKPB(D)	;Set pointers
	MOVEM	T2,.FOLEB(T1)
	MOVEI	T2,LLEN
	MOVEM	T2,LKPB+.RBCNT(D)
	MOVEI	T2,PTHB(D)
	HRLI	T2,9
	MOVEM	T2,.FOPAT(T1)
	PUSHJ	P,SETPPB	;Set ptr to path block
	POP	P,T5		;Get flags in T5
	PJRST	%ST10B		;Setup .FOBRH, .FONBF and return
;Routine to setup part of TOPS-10 FILOP. block based on IO flags
; Sets up .FOBRH, .FONBF
;Call:
;	MOVX T5,D%IN or D%OUT (flags to set on OPEN)
;	PUSHJ	P,SET10F
;	<return here always>
;If DUMP mode is set, no buffer pointers are setup.

%ST10B:	MOVEI	T1,FBLK(D)	;T1 points to FILOP. block
	SETZ	T2,		;IBCB or OBCB or both
	LOAD	T3,DMODE(D)	;Unless dump mode
	CAIN	T3,.IODMP
	  POPJ	P,		;Then no ptrs setup

	LOAD	T4,INDX(D)	;Get type of device
	CAIN	T4,DI.TTY	;TTY?
	 TXO	T5,D%IN+D%OUT	;Yes, will be both input and output
	TXNE	T5,D%IN
	 HRRI	T2,IBCB(D)
	TXNE	T5,D%OUT
	 HRLI	T2,OBCB(D)
	MOVEM	T2,.FOBRH(T1)

	LOAD	T3,BUFCT(D)	;Set buffer count
	TLNE	T2,-1
	 HRLI	T2,(T3)
	TRNE	T2,-1
	 HRRI	T2,(T3)
	MOVEM	T2,.FONBF(T1)
	POPJ	P,		;Return
;Routine to call the appropriate OPEN routine based on flags in T5,
; ACCESS and STATUS.
;Returns .+1 if error, F%DRE set (unless ERR= taken)
;Returns .+2 if success, DDB flags set.

CALOF:	LOAD	T2,INDX(D)	;Get type of device
	CAIN	T2,DI.TTY	;TTY:?
	 SKIPA	T1,[AC.SOU]	;Yes, use SEQOUT access.
	LOAD	T1,ACC(D)	;T1= access
	LOAD	T2,STAT(D)	;T2= STATUS
	CAILE	T2,ST.UNK	;Must be OLD, NEW, SCRATCH, or UNKNOWN
	 $SNH			;NO, ERROR
	MOVE	T2,STIDX(T2)	;Get index
	JUMPL	T2,E..SNH	;?Must be good status
	MOVE	T1,OPACTB(T1)	;Get table by access
	JUMPE	T1,E..SNH	;? Illegal access
	ADD	T1,T2		;Get address of place to go
	JRST	CALOF1		;Go call routine

;Enter here when the FBLK word is all setup.
; Called from FORIO when the file is closed and re-opened.
;T5= flags to set when file gets opened.

%CALOF:	MOVEI	T1,OPGFB	;Routine to call
	JRST	CALOF1		;Continue here

;Here is the routine for CLOSE/OPEN when FBLK is already setup.

OPGFB:	PUSHJ	P,DOFLP		;Do the FILOP.
	 JRST	FLPFL		;Failed, go restore stuff and give error
	JRST	%POPJ1		;Success, done.

;** Common code for CALOF **

CALOF1:	PUSHJ	P,(T1)		;Call appropriate routine
	 JRST	OFAIL		;Failed, go clear stuff and return .+1
	IORM	T5,FLAGS(D)	;Success: Set DDB flag bits
	LOAD	T1,MODE(D)	;Get /MODE
	LDB	T2,MODBYT	;Get byte size
	STORE	T2,IBSIZ(D)	;Save
	STORE	T2,OBSIZ(D)
	JRST	%POPJ1		;Return success

;"Dialog requested" bit set.

OFAIL:	;; ** UNDO STUFF **
	POPJ	P,		;Failure return
;Index into tables by STATUS
STIDX:	-1			;?Must be set
	0			;OLD
	1			;NEW
	3			;SCRATCH
	2			;UNKNOWN

OPACTB:	0			;0- illegal
	OTBSIN			;1- SEQIN
	OTBSOU			;2- SEQOUT
	OTBSIO			;3- SEQINOUT
	OTBRIN			;4- RANDIN
	OTBRIO			;5- RANDOM
	OTBAPP			;6- APPEND

;SEQIN ACCESS
OTBSIN:	JRST	OPRD		;OLD
	$SNH			;NEW
	JRST	OPRD		;UNKNOWN
	$SNH			;SCRATCH

;SEQOUT ACCESS
OTBSOU:	JRST	OPSO		;OLD
	JRST	OPSWN		;NEW
	JRST	OPSW		;UNKNOWN
	$SNH			;SCRATCH

;SEQINOUT ACCESS
OTBSIO:	JRST	OPRD		;OLD
	JRST	OPSWN		;NEW
	JRST	OPSIOU		;UNKNOWN (DEPENDS ON VERB)
	JRST	OPSIOS		;SCRATCH

;RANDIN ACCESS
OTBRIN:	JRST	OPRD		;OLD
	$SNH			;NEW
	JRST	OPRD		;UNKNOWN
	$SNH			;SCRATCH

;RANDOM ACCESS
OTBRIO:	JRST	OPRO		;OLD
	JRST	OPRN		;NEW
	JRST	OPRU		;UNKNOWN
	JRST	OPRS		;SCRATCH

;APPEND ACCESS
OTBAPP:	JRST	OPAO		;OLD
	JRST	OPAN		;NEW
	JRST	OPAU		;UNKNOWN
	$SNH			;SCRATCH
;OPEN file that must exist for READ.

OPRD:	MOVEI	T1,.FORED	;Simple READ function
	HRRM	T1,FBLK(D)	;Set it
	PUSHJ	P,DOFLP		;Do the FILOP.
	 JRST	FLPFL		;Failed, go restore stuff and give error
	JRST	%POPJ1		;Success, done.

;OPEN file that must exist for WRITE (it will be superseded!)

OPSO:	MOVEI	T1,.FOCRE	;CREATE function
	HRRM	T1,FBLK(D)
	PUSHJ	P,DOFLP		;Do the FILOP.
	 JRST	OPRD1		;Failed, check out error code
	PUSHJ	P,CLDISC	;OOPS, create succeeded!
				; CLOSE file and discard it.
	MOVEI	T1,ERFNF%	;Pretend he got FILOP. error "File not found"
	JRST	FLPFL		;Go process the error

;The CREATE FILOP. failed. See if the error code = 'FILE ALREADY EXISTS'

OPRD1:	CAIE	T1,ERAEF%	;Already exists?
	 JRST	FLPFL		;No, unexpected error
	MOVEI	T1,.FOWRT	;OK, plain WRITE
	HRRM	T1,FBLK(D)	;Set function
	PUSHJ	P,DOFLP
	 JRST	FLPFL		;?failed
	JRST	%POPJ1		;Succeeded, return

;OPEN file that must not exist for WRITE

OPSWN:	MOVEI	T1,.FOCRE	;Create function
	HRRM	T1,FBLK(D)	;Set function
	PUSHJ	P,DOFLP
	 JRST	FLPFL		;?failed
	JRST	%POPJ1		;Succeeded, return

;OPEN file for WRITE. If it exists, it is superseded.

OPSW:	MOVEI	T1,.FOWRT	;Write function
	HRRM	T1,FBLK(D)	;Set it
	PUSHJ	P,DOFLP
	 JRST	FLPFL		;?failed
	JRST	%POPJ1		;Succeeded, return

;OPEN SEQINOUT (SEQUENTIAL) file with UNKNOWN status.
;T5= the way we want it opened.
;D%IN= want it opened for input.
;D%OUT= want it opened for output.
; If neither set, don't care.

OPSIOU:	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNE	T1,D%IO		;Doing a WRITE?
	 JRST	OPSW		;Yes, do a plain WRITE
	TXNE	T5,D%IN		;Want it opened for input?
	 JRST	OPRD		;Yes
	TXNE	T5,D%OUT	;Want it opened for output?
	 JRST	OPSW		;yes

;See if file exists.
; IF IT exists, it will be opened for input.
; If it doesn't exist, it will be created and opened for output.

	LOAD	T1,DRDVF(D)	;T1= non-zero if this is a directory device
	JUMPE	T1,[TXO T5,D%IN	;No, just go open for read
		JRST OPRD]

	MOVEI	T1,.FORED	;Try to read file
	HRRM	T1,FBLK(D)
	PUSHJ	P,DOFLP		;If succeeds, set file opened for input
	 JRST	OPSIC1		;Failed, maybe file not found?
	TXO	T5,D%IN		;Set opened for input if successful
	JRST	%POPJ1		;Return

;Note: If the directory is protected WRITE-ONLY, then he will get
; an error from CLOSE because the file could not be created!

OPSIC1:	CAIE	T1,ERFNF%	;File not found?
	 JRST	FLPFL		;No, bad error
	MOVEI	T1,.FOCRE	;Create file
	HRRM	T1,FBLK(D)
	PUSHJ	P,DOFLP		;** Do FILOP. **
	 JRST	FLPFL		;All errors are fatal
	TXO	T5,D%OUT	;Set file opened for output
	JRST	%POPJ1		;Return
;OPEN RANDOM file that must exist.

OPRO:	PUSHJ	P,CHKEXI	;Make sure file exists
	 POPJ	P,		;It doesn't
OPRGO:	MOVEI	T1,.FOSAU	;OK, do an update
	HRRM	T1,FBLK(D)
	PUSHJ	P,DOFLP
	 JRST	FLPFL		;?failed
	JRST	%POPJ1		;Succeeded, return


;OPEN RANDOM file that must not exist.

OPRN:	MOVEI	T1,.FOCRE	;Set CREATE function
	HRRM	T1,FBLK(D)
	PUSHJ	P,DOFLP		;Do FILOP.
	 JRST	FLPFL		;?failed

;File did not exist. Now CLOSE and OPEN it again for updating.

	MOVEI	T2,.FOCLS
	HLL	T2,CHAN(D)
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 PUSHJ	P,CLSERR
	JRST	OPRGO


;OPEN RANDOM file, STATUS='UNKNOWN'

OPRU:	MOVEI	T1,.FOCRE	;Set CREATE Function
	HRRM	T1,FBLK(D)
	PUSHJ	P,DOFLP
	 JRST	OPRUCF		;Failed, go check error

;File did not exist. Close, re-open for updating.

	MOVEI	T2,.FOCLS
	HLL	T2,CHAN(D)
	MOVE	T1,[1,,T2]
	FILOP.	T1,		;Do CLOSE FILOP.
	 PUSHJ	P,CLSERR
	JRST	OPRGO		;Go open for updating now

;Here if OPEN For RANDOM, STATUS='UNKNOWN' and FILOP. CREATE failed.

OPRUCF:	CAIE	T1,ERAEF%	;Already exists?
	 JRST	FLPFL		;No, funny failure
	JRST	OPRGO		;Go open for updating now
;OPEN APPEND, file must exist

OPAO:	PUSHJ	P,CHKEXI	;Make sure file exists
	 POPJ	P,		;It doesn't
OPAGO:	MOVEI	T1,.FOAPP	;Set APPEND function
	HRRM	T1,FBLK(D)
	PUSHJ	P,DOFLP
	 JRST	FLPFL		;?Failed
	JRST	%POPJ1		;Succeeded, return


;OPEN APPEND, file must not exist

OPAN:	MOVEI	T1,.FOCRE	;Set CREATE function
	HRRM	T1,FBLK(D)
	PUSHJ	P,DOFLP
	 JRST	FLPFL		;?failed
	JRST	%POPJ1		;Succeeded, return


;OPEN APPEND, status='UNKNOWN'

OPAU:	MOVEI	T1,.FOCRE	;Try a create
	HRRM	T1,FBLK(D)
	PUSHJ	P,DOFLP
	 JRST	OPAUCF		;Failed, go see why

;Hey we just succeeded in creating a new file. We
; could probably just return "successfully" now, but
; some people claim it is "more consistant" to CLOSE
; this channel and re-open with the APPEND FILOP.

	MOVEI	T2,.FOCLS	;CLOSE channel
	HLL	T2,CHAN(D)
	MOVE	T1,[1,,T2]
	FILOP.	T1,		;Do CLOSE FILOP.
	 PUSHJ	P,CLSERR	;Failed, give warning
	JRST	OPAGO		;OK, now re-open with "APPEND" FILOP.

OPAUCF:	CAIE	T1,ERAEF%	;Already exists?
	 JRST	FLPFL		;No, funny failure
	JRST	OPAGO		;Go do APPEND function
;OPEN SCRATCH SEQINOUT file
OPSIOS:	PUSHJ	P,SETSCN	;Set scratch name
	SETZ	T3,		;Count # tries
OPSIS1:	MOVEI	T1,.FOCRE	;Get new file
	HRRM	T1,FBLK(D)
	PUSHJ	P,DOFLP		;Try a CREATE
	 JRST	OPSIS2		;Failed, go see why
	JRST	%POPJ1		;Succeeded, file opened for output

OPSIS2:	ADDI	T3,1		;Count # of attempts
	CAIE	T1,ERAEF%	;File already exists?
	 JRST	FLPFL		;No, bad error
	CAILE	T3,^D10		;Tried too many times?
	 JRST	FLPFL		;Yes, just give error
	PUSHJ	P,SETSCN	;Try another name
	JRST	OPSIS1		; . .


;OPEN SCRATCH RANDOM file
OPRS:	PUSHJ	P,SETSCN	;Set scratch name
	SETZ	T3,		;Count # of tries

OPRS1:	MOVEI	T1,.FOCRE	;Set CREATE function
	HRRM	T1,FBLK(D)
	PUSHJ	P,DOFLP
	 JRST	OPRS2		;Maybe file does exist already

;File did not exist. CLOSE and OPEN again for updating.

	MOVEI	T2,.FOCLS
	HLL	T2,CHAN(D)
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 PUSHJ	P,CLSERR
	JRST	OPRGO		;Go open random file.

OPRS2:	CAIE	T1,ERAEF%	;File already exists error?
	 JRST	FLPFL		;No, the OPEN fails.
	ADDI	T3,1		;Count # attempts
	CAILE	T3,^D10		;Too many?
	 JRST	FLPFL		;Yes, just give FILOP error
	PUSHJ	P,SETSCN	;Get another name for SCRATCH
	JRST	OPRS1		;Try again
;Routine to set a name for a SCRATCH file
;Uses T1,T2 only

SETSCN:	PUSHJ	P,GTMWRD	;Get random sixbit
	MOVEM	T1,FILE(D)
	MOVSI	T1,'TMP'	;Extension .TMP
	MOVEM	T1,EXT(D)
	POPJ	P,		;Return

;Routine to get random sixbit word in T1

GTMWRD:	SKIPE	SEED		;Already have a random seed?
	 JRST	GTMWR1		;Yes
	MSTIME	T1,		;Get time of day in milliseconds
	HRRM	T1,SEED		;Save random-number seed
	HRLM	T1,SEED		;. .
GTMWR1:	SETZ	T1,		;Start with nothing
	DMOVEM	T3,GTMSV3	;Save acs
	MOVEI	T4,6		;# chars to get
GTMWR2:	PUSHJ	P,GTMCHR	;Get random char
	LSH	T1,6		;Shift left six
	ADDI	T1,(T2)		;Add in char
	SOJG	T4,GTMWR2	;Loop
	DMOVE	T3,GTMSV3	;Restore acs
	POPJ	P,		;And return

;Routine to get random sixbit letter in T2
;Uses t3
GTMCHR:	MOVE	T3,SEED		;Get current seed
	ANDI	T3,17		;Just save last 4 bits
	MOVEI	T2,'A'(T3)	;Get letter
	MOVE	T3,SEED		;Get current seed
	ROT	T3,7		;Rotate
	ADD	T3,T2		;Add in value of letter
	MOVEM	T3,SEED		;Store new seed
	POPJ	P,		;Return

SEGMENT DATA
GTMSV3:	BLOCK	2		;Saved acs for GTMWRD
SEED:	BLOCK	1		;Random-number seed
SEGMENT CODE
;Routine to make sure file exists.
; If it doesn't, return .+1, error given (or ERR= taken)
; If it does, return .+2

CHKEXI:	MOVEI	T1,.FOCRE	;Try to create file
	HRRM	T1,FBLK(D)	;Set function
	PUSHJ	P,DOFLP
	 JRST	CHKEX2		;Failed, make sure error is correct
	PUSHJ	P,CLDISC	;OOPS, create succeeded!
				; CLOSE file and discard it.
;Give error message

	MOVEI	T1,ERFNF%	;Pretend we got "file not found" error
	PJRST	FLPFL

;The CREATE FILOP. failed. See if the error code = 'FILE ALREADY EXISTS'

CHKEX2:	CAIE	T1,ERAEF%	;Already exists?
	 PJRST	FLPFL		;No, unexpected error
	PJRST	%POPJ1		;Return ok
;Routine to get an OPEN channel
; Goes to %ABORT or ERR= if can't get

SETOCH:	TXNE	F,F%XCHAN	;Extended channels available?
	 JRST	GTXCHN		;Yes, use them
	PUSHJ	P,ALCHN		;Get a channel
	$ECALL	NFC,%ABORT	;?Too many OPEN units
	TXOA	T1,(FO.PRV)	;Request use of privs incase we have any
GTXCHN:	MOVEI	T1,(FO.PRV+FO.ASC)	;"Allocate any channel"
	HRLM	T1,CHAN(D)	;Store channel number
	POPJ	P,		;Return


;Routine to deallocate OPEN channel if necessary

RETOCH:	HLRZ	T1,CHAN(D)	;Get channel number
	TRZE	T1,(FO.ASC)	;Extended channel not assigned yet?
	 POPJ	P,		;yes, nothing to do
	PUSH	P,T1		;Save bits
	MOVEI	T2,.FOREL	;Release it
	HLL	T2,CHAN(D)
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	  JFCL			; (If the OPEN failed, channel not assigned.)
	POP	P,T1		;Restore channel stuff
	TRZ	T1,(FO.PRV)	;Clear PRIV bit
	CAILE	T1,17		; Did we have to allocate chan ourselves?
	 POPJ	P,		;No, nothing to do
	PJRST	DECHN		;Yes, go deallocate it and return
;Routine to do some kind of OPEN FILOP.
;Clears .RBALC word after a successful OPEN
;  (so further FILOP's don't set it by mistake).
;Uses T1, T2 only

DOFLP:	PUSH	P,.JBFF
	LOAD	T1,BUFAD(D)	;Point .JBFF at buffers
	HRRZM	T1,.JBFF
	MOVEI	T1,FBLK(D)	;Point to FILOP. block
	HRLI	T1,FLEN		;Set length
	FILOP.	T1,		;** Do FILOP. **
	 JRST	DOFLP1		;Failed
	POP	P,.JBFF		;Succeeded, restore .JBFF
	MOVEI	T2,LKPB(D)	;Clear .RBALC word (returned by ENTER)
	SETZM	.RBALC(T2)	;  so it won't be an arg to further FILOP's
	PUSHJ	P,SETPPB	;Store correct path stuff
	JRST	%POPJ1		; And skip return

;Here if the OPEN FILOP. failed
;If the error was "not enough free channels",
; try to allocate a low channel.

DOFLP1:	POP	P,.JBFF		;Failed, restore .JBFF
	CAIE	T1,ERNFC%	;Not enough channels?
	 PJRST	SETPPB		;No, store correct path stuff and return
	PUSHJ	P,ALCHN		;Go allocate a channel
	 $ECALL	NFC,%ABORT	;?Too many OPEN units
	TXO	T1,(FO.PRV)	;Request use of privs incase we have any
	HRLM	T1,CHAN(D)	;Try again with this channel
	JRST	DOFLP		;Try again

;Routine to setup correct path stuff
; If there is a specified path, point to it.
; Else store zero in the PPN word of the lookup block.
;Uses T2 only

SETPPB:	MOVEI	T2,PTHB(D)
	SKIPN	PTHB+.PTPPN(D)	;If PATH set, put PATH dir in LOOKUP block
	 SETZ	T2,		; Else store zero
	HRRZM	T2,PPN(D)
	POPJ	P,		;Return
;Routine to CLOSE file and discard old stuff
; If errors, the program is aborted.

CLDISC:	MOVE	T1,[2,,T2]	;Setup for CLOSE
	MOVEI	T2,.FOCLS
	HLL	T2,CHAN(D)
	MOVX	T3,CL.RST	; Discard new file
	FILOP.	T1,
	 PUSHJ	P,CLSERR	;Type error message
	POPJ	P,		;Return

;Come here if the FILOP. failed and this means that the operation failed.
; Clean up, give standard FILOP. error, and if the ERR= branch is not
; taken, return .+1 to go to request dialog

FLPFL:	PUSH	P,T1		;Save FILOP. error code
	PUSHJ	P,OFCLNU	;Cleanup (deallocate buffers, etc.)
	POP	P,T1		;Re-get FILOP. error
	$ECALL	OPN,REQDIA	;FILOP. error - reason
;Prior-to-OPEN-FILOP setup routines for devices.

XXXSET==%POPJ1

TTYSET:	MOVX	T1,D%SICR+D%SILF ;Suppress initial CRLF for terminals
	IORM	T1,FLAGS(D)	; . .
	MOVE	T1,RSIZE(D)	;RECORD SIZE SPECIFIED?
	JUMPN	T1,%POPJ1	;YES, IT WINS; DON'T OVERWRITE LINE WIDTH

	MOVE	T1,[2,,T2]	;LEN,,ADDRESS OF TRMOP BLOCK
	MOVEI	T2,.TOWID	;LINE WIDTH
	MOVE	T3,DEV(D)	;GET DEVICE NAME
	IONDX.	T3,		;CONVERT TO TERMINAL UDX
	  JRST	TTY72		;CAN'T GUESS 72 COLS
	TRMOP.	T1,		;READ LINE WIDTH
	  JRST	TTY72		;CAN'T

	CAIN	T1,0		;IS IT SET?
TTY72:	  MOVEI	T1,^D72		;NO, USE 72
	STORE	T1,TTYW(D)	;STORE LINE SIZE FOR NAMELIST/LIST-DIRECTED

	JRST	%POPJ1		;DONE



DSKSET:	TXNN	P1,D%RAN	;RANDOM?
	  JRST	%POPJ1		;NO

	LOAD	T1,BUFCT(D)	;GET BUFFERCOUNT, BLOCKS
	JUMPN	T1,DSKNZB	;OK IF NON-ZERO
	MOVEI	T1,^D16		;USE 16 IF ZERO
	STORE	T1,BUFCT(D)	;STORE THIS DEFAULT
DSKNZB:	ADDI	T1,3		;ROUND UP TO PAGES
	LSH	T1,-2
	PUSH	P,T1		;SAVE PAGE COUNT
	PUSHJ	P,%GTPGS	;ALLOCATE PAGES FOR BUFFERING DUMP IO
	 $ECALL	MFU,%ABORT	;?Can't, mem full
	
	EXCH	T1,(P)		;GET PAGE COUNT, SAVE PAGE ADDRESS
	LSH	T1,2		;MAKE INTO BLOCKS
	PUSH	P,T1		;SAVE AGAIN
	PUSHJ	P,%GTBLK	;ALLOCATE PAGE TABLE, ONE WORD PER BLOCK
	POP	P,T2		;RESTORE BLOCK COUNT
	MOVNI	T3,(T2)		;GET NEGATIVE
	HRLI	T1,(T3)		;MAKE AOBJN POINTER TO PAGE TABLE
	MOVEM	T1,WTAB(D)	;SAVE IT
	HRRZM	T1,WPTR(D)

	POP	P,T2		;RESTORE PAGE ADDRESS OF BUFFERS
	LSH	T2,2		;MAKE BLOCK ADDRESS
	HRLOI	T2,(T2)		;MAKE PROCESS ADDRESS,,IMPOSSIBLE FILE ADDRESS
DSETL:	MOVEM	T2,(T1)		;STORE IN PAGE TABLE
	ADD	T2,[1,,0]	;BUMP TO NEXT PROCESS PAGE
	AOBJN	T1,DSETL	;LOOP

	JRST	%POPJ1		;DONE
MTASET:	PUSHJ	P,%SAVE1

	MOVE	T2,DEV(D)	;GET DEVICE NAME
	MOVEI	T1,.TFDEN+.TFSET ;SET DENSITY
	LOAD	T3,DEN(D)	;GET /DENSITY
	JUMPE	T3,MTAST1	;IF UNIT DEFAULT, LEAVE ALONE
	CAIN	T3,DN.SYS	;SYSTEM DEFAULT?
	  MOVEI	T3,.TFD00	;YES, SET THAT
	MOVEI	P1,[ASCIZ /density/]
	MOVE	T0,[3,,T1]	;SET POINTER FOR TAPOP
	TAPOP.	T0,		;SET IT
	 JRST	TOPERR		;Shouldn't fail

MTAST1:	MOVEI	T1,.TFPAR+.TFSET ;SET PARITY
	LOAD	T0,PAR(D)	;GET /PARITY
	JUMPE	T0,NOPAR	;NO PARITY GIVEN
	SETZ	T3,		;ASSUME ODD
	CAIN	T0,PR.EVEN	;EVEN?
	 MOVEI	T3,1		;YES. SET TO EVEN PARITY
	MOVEI	P1,[ASCIZ /parity/]
	MOVE	T0,[3,,T1]	;SET POINTER FOR TAPOP
	TAPOP.	T0,		;SET IT
	  JRST	TOPERR		;?Shouldn't fail

NOPAR:	LOAD	T1,TAPM(D)	;GET /TAPEMODE
	JUMPE	T1,NOMODE	;NONE GIVEN. DON'T DO IT!
	MOVEI	T3,.TFMDD	;GET DEFAULT
	CAIN	T1,TM.IND	;INDUSTRY COMPATIBLE?
	  MOVEI	T3,.TFM8B	;YES, READ 8-BIT BYTES
	CAIN	T1,TM.ANS	;ANSI-ASCII?
	  MOVEI	T3,.TFM7B	;YES, 7-BITS IN 8-BIT BYTES
	MOVEI	T1,.TFMOD+.TFSET ;SET HARDWARE DATA MODE
	MOVEI	P1,[ASCIZ /data mode/]
	MOVE	T0,[3,,T1]	;SET POINTER FOR TAPOP
	TAPOP.	T0,		;SET IT
	 JRST	TOPERR		;?Shouldn't fail

NOMODE:	LOAD	T3,BLKSZ(D)	;GET /BLOCKSIZE, BYTES
	JUMPE	T3,%POPJ1	;IF SET

;Compute bytes/per/word, not normally done until FIXDEF called.

	PUSH	P,T2		;Save device name
	LOAD	T1,MODE(D)	;GET FILE MODE
	LDB	T2,MODBYT	;GET BYTE SIZE
	MOVEI	T1,^D36		;DIVIDE INTO 36 TO GET # BYTES/WORD
	IDIVI	T1,(T2)
	MOVE	T4,T1		;Copy to T4
	MOVEI	T1,.TFBSZ+.TFSET ;SET BLOCK SIZE
	POP	P,T2		;Restore device name
	ADDI	T3,-1(T4)	;ROUND UP BLOCKSIZE
	IDIVI	T3,(T4)		;GET # WORDS
	ADDI	T3,1		;ADD 1 MORE BECAUSE UUO WANTS IT
	MOVEI	P1,[ASCIZ /block size/]
	MOVE	T0,[3,,T1]	;SET POINTER FOR TAPOP
	TAPOP.	T0,		;SET IT
	 JRST	TOPERR		;?Shouldn't fail

	JRST	%POPJ1		;ALL SET


;Error on TAPOP. from a device that we haven't OPENED yet.
; This could be caused by someone else assigning the device
; and we don't have privs to set the functions.

TOPERR:	CAIN	T0,TPPRV%	;Not enough privs?
	 JRST	TOPERP		;Yes
	MOVE	T3,T0		;PUT ERROR CODE IN SAFE AC
;	IOERR	(UTO,30,,?,Unexpected TAPOP. error $O trying to set $A,<T3,P1>)
	$ECALL	UTO,%POPJ	;"? Unexpected TAPOP. error.."
				;Return to DIALOG if no ERR= taken

TOPERP:	MOVEI	T1,ERDAJ%	;Pretend it was a FILOP. error
				; "Device allocated to another job"
	$ECALL	OPN,%POPJ	;Give error and return

>;END IF10
;TABLES

IF20,<
 DEFINE	X (G,F,D) <XWD <(G)>,F> ;XWD GTJFN BITS, ACCESS BITS
>

IF10,<
 DEFINE X (G,F,D) <D>	;FILOP FUNCTION
>


FILTAB:	X	GJ%OFG,0,.FORED			;SEQINOUT	
	X	GJ%OLD,OF%RD,.FORED		;SEQIN
	X	GJ%FOU,OF%WR,.FOWRT		;SEQOUT
	X	GJ%OFG,0,.FORED			;SEQINOUT
	X	GJ%OLD,OF%RD,.FORED		;RANDIN
	X	0,OF%RD+OF%WR,.FOSAU		;RANDOM
	X	0,OF%APP,.FOAPP			;APPEND

ACCTAB:	0		;SEQINOUT
	0		;SEQIN
	0		;SEQOUT
	0		;SEQINOUT
	D%RAN		;RANDIN
	D%RAN		;RANDOM
	D%APP		;APPEND



;BYTE SIZE, DATA MODE

MODBYT:	POINT 6,MODTAB(T1),5
IF20,<
MODTAB:	0
	BYTE	(6)44(4)10	;IMAGE
	BYTE	(6)44(4)10	;BINARY
	BYTE	(6)44(4)17	;DUMP
	BYTE	(6)7(4)0	;ASCII
	BYTE	(6)7(4)0	;LINED
	BYTE	(6)8(4)10	;EBCDIC
>

IF10,<
MODTAB:	0
	BYTE	(6)44(4)10	;IMAGE
	BYTE	(6)44(4)14	;BINARY
	BYTE	(6)44(4)17	;DUMP
	BYTE	(6)7(4)0	;ASCII
	BYTE	(6)7(4)0	;LINED
	BYTE	(6)8(4)10	;EBCDIC
>
;ROUTINE TO CHECK DATA MODE BEFORE OPENING FILE

%CHKNR:: LOAD	T1,DMODE(D)	;GET DATA MODE
	MOVEI	T2,1		;GET A BIT
	LSH	T2,(T1)		;SHIFT INTO POSITION FOR REQUESTED MODE
	LOAD	T3,LGLM(D)	;GET LEGAL DATA MODES FOR THIS DEVICE
	TRNE	T2,(T3)		;CHECK THAT DATA MODE IS LEGAL
	  JRST	%POPJ1		;YES, FINE
	JRST	DMERR		;NO, ERROR

	SEGMENT	ERR

DMERR:	LOAD	T1,MODE(D)	;GET DATA MODE
	MOVEI	T2,SWMODE	;POINT TO TABLE
	PUSHJ	P,FNDSWT	;FIND NAME OF REQUESTED MODE
;	IOERR	(IDM,30,249,?,/MODE:$Z illegal for this device,<T1>,%POPJ)
	$ECALL	IDM,%POPJ

	SEGMENT	CODE
	SUBTTL	SWITCH TABLES

IF20,<
 DEFINE	X (NAME,VAL) <
	XWD	[ASCIZ \NAME\],VAL
 >
>

IF10,<
 DEFINE X (NAME,VAL) <
	XWD	[SIXBIT \NAME \],VAL
 >
>


OPNSWT:	XWD	LSWT,LSWT+1
	X	ACCESS:,OK.ACC
	X	BLANK:,OK.BLNK
	X	BLOCKSIZE:,OK.BLK
	X	BUFFERCOUNT:,OK.BFC
	X	CARRIAGECONTROL:,OK.CC
	X	DENSITY:,OK.DEN
	X	DISPOSE:,OK.DISP
	X	FILESIZE:,OK.FLS
	X	FORM:,OK.FORM
;	X	LABELS:,OK.LBL
	X	MODE:,OK.MOD
	X	PADCHAR:,OK.PAD
	X	PARITY:,OK.PAR
	X	PROTECTION:,OK.PROT
	X	READONLY,OK.RO
	X	RECL:,OK.REC
	X	RECORDSIZE:,OK.REC
	X	STATUS:,OK.STAT
;	X	TAPEMODE:,OK.TAPM
	X	VERSION:,OK.VER
LSWT==.-OPNSWT-1

;Legal DIALOG CLOSE switches

CLSSWT:	XWD	CSWT,CSWT
	X	DISPOSE:,OK.DISP
	X	PROTECTION:,OK.PROT
	X	STATUS:,OK.STAT
CSWT==.-CLSSWT-1
SWACC:	XWD	LACC,LACC
	X	APPEND,AC.APP
	X	DIRECT,AC.RIO
	X	RANDIN,AC.RIN
	X	RANDOM,AC.RIO
	X	SEQIN,AC.SIN
	X	SEQINOUT,AC.SIO
	X	SEQOUT,AC.SOU
	X	SEQUENTIAL,AC.SIO
LACC==.-SWACC-1


SWBLNK:	XWD	LBLNK,LBLNK
	X	NULL,BL.NULL
	X	ZERO,BL.ZERO
LBLNK==.-SWBLNK-1


SWCC:	XWD	LCC,LCC
	X	DEVICE,CC.DEV
	X	FORTRAN,CC.FORT
	X	LIST,CC.LIST
LCC==.-SWCC-1


SWDEN:	XWD	LDEN,LDEN
IF10,<	X	SYSTEM,DN.SYS >
	X	1600,DN.1600
	X	200,DN.200
	X	556,DN.556
	X	6250,DN.6250
	X	800,DN.800
IF20,<	X	SYSTEM,DN.SYS >
LDEN==.-SWDEN-1
;OPEN DISPOSE values

SWDSPO:	XWD	LDISPO,LDISPO
	X	DELETE,DS.DEL
	X	EXPUNGE,DS.EXP
	X	KEEP,DS.SAVE
	X	LIST,DS.LIST
	X	PRINT,DS.PRNT
	X	PUNCH,DS.PNCH
	X	SAVE,DS.SAVE
	X	SUBMIT,DS.SUB
LDISPO==.-SWDSPO-1

;CLOSE dispose values

SWDISC:	XWD	LDISPC,LDISPC
	X	DELETE,DS.DEL
	X	EXPUNGE,DS.EXP
	X	KEEP,DS.SAVE
	X	LIST,DS.LIST
	X	PRINT,DS.PRNT
	X	PUNCH,DS.PNCH
	X	RENAME,DS.REN
	X	SAVE,DS.SAVE
	X	SUBMIT,DS.SUB
LDISPC==.-SWDISC-1
SWFORM:	XWD	LFORM,LFORM
	X	FORMATTED,FM.FORM
	X	UNFORMATTED,FM.UNF
LFORM==.-SWFORM-1


SWLBL:	XWD	LLBL,LLBL
	X	ANSI,LB.ANSI
	X	DEC,LB.DEC
;	X	EBCDIC,LB.IBM
	X	NONE,LB.NONE
LLBL==.-SWLBL-1


SWMODE:	XWD	LMODE,LMODE
	X	ASCII,MD.ASC
	X	BINARY,MD.BIN
IF10,<	X	DUMP,MD.DMP	>
;	X	EBCDIC,MD.EBC
	X	IMAGE,MD.IMG
	X	LINED,MD.ASL
LMODE==.-SWMODE-1


SWPAR:	XWD	LPAR,LPAR
	X	EVEN,PR.EVEN
	X	ODD,PR.ODD
LPAR==.-SWPAR-1


SWRECT:	XWD	LRECT,LRECT
	X	FIXED,RT.FIX
	X	SPANNED,RT.SPN
	X	VARIABLE,RT.VAR
LRECT==.-SWRECT-1
;OPEN STATUS values

SWSTAT:	XWD	LSTAT,LSTAT
	X	DELETE,ST.DISP+DS.DEL
	X	EXPUNGE,ST.DISP+DS.EXP
	X	KEEP,ST.DISP+DS.SAVE
	X	NEW,ST.NEW
	X	OLD,ST.OLD
	X	SAVE,ST.DISP+DS.SAVE
	X	SCRATCH,ST.SCR
	X	UNKNOWN,ST.UNK
LSTAT==.-SWSTAT-1

;LEGAL STATUS VALUES FOR CLOSE

SWSTTC:	XWD	LSTTC,LSTTC
	X	DELETE,ST.DISP+DS.DEL
	X	EXPUNGE,ST.DISP+DS.EXP
	X	KEEP,ST.DISP+DS.SAVE
	X	SAVE,ST.DISP+DS.SAVE
LSTTC==.-SWSTTC-1


;/TAPEMODE

SWTAPM:	XWD	LTAPM,LTAPM
	X	ANSI-ASCII,TM.ANS
	X	COREDUMP,TM.DMP
	X	INDUSTRY,TM.IND
	X	SYSTEM,TM.SYS
LTAPM==.-SWTAPM-1
;DISPATCH TABLES FOR OPEN SWITCHES, INDEXED BY SWITCH NUMBER
;
;OPNDSP:
;  LH = ROUTINE TO CONVERT PROGRAM-SUPPLIED ARGUMENT TO INTERNAL FORMAT
;  RH = ROUTINE TO PARSE DIALOG-MODE ARGUMENT
;       OR ADDRESS OF SWITCH-VALUE TABLE IF SWITCH TAKES ASCII KEYWORDS
;
;OPSTOR:
;  INSTRUCTION TO STORE SWITCH VALUE IN T2 INTO DDB


OPNDSP:	XWD	%POPJ,		;(0)  IGNORED
	XWD	OPNDIA,		;(1)  DIALOG=
	XWD	OPNKWD,SWACC	;(2)  ACCESS=
	XWD	OPNDEV,		;(3)  DEVICE=
	XWD	OPNINT,[DIAINT]	;(4)  BUFFER COUNT=
	XWD	OPNINT,[DIAINT]	;(5)  BLOCK SIZE=
	XWD	OPNFIL,		;(6)  FILE NAME=
	XWD	OPNINT,[DIAOCT] ;(7)  PROTECTION=
	XWD	OPNDIR,		;(10) DIRECTORY=
	XWD	OPNINT,[DIAINT]	;(11) LIMIT=
	XWD	OPNKWD,SWMODE	;(12) MODE=
	XWD	OPNINT,[DIAINT]	;(13) FILE SIZE=
	XWD	OPNINT,[DIAINT]	;(14) RECORD SIZE=
	XWD	OPNKWD,SWDSPO	;(15) DISPOSE=
	XWD	OPNINT,[DIAOCT]	;(16) VERSION=
	XWD	OPNERR,		;(17) REELS=
	XWD	OPNERR,		;(20) MOUNT=
	XWD	OPNADR,		;(21) IOSTAT=
	XWD	OPNADR,		;(22) ASSOCIATE VARIABLE=
	XWD	OPNKWD,SWPAR	;(23) PARITY=
	XWD	OPNKWD,SWDEN	;(24) DENSITY=
	XWD	OPNKWD,SWBLNK	;(25) BLANK=
	XWD	OPNKWD,SWCC	;(26) CARRIAGE CONTROL=
	XWD	OPNKWD,SWFORM	;(27) FORM=
	XWD	OPNKWD,SWLBL	;(30) LABELS=
	XWD	OPNCHR,[DIACHR]	;(31) PADCHAR=
	XWD	OPNKWD,SWRECT	;(32) RECTYPE=
	XWD	OPNKWD,SWSTAT	;(33) STATUS=
	XWD	OPNKWD,SWTAPM	;(34) TAPE MODE=
	XWD	OPNSET,[DIASET]	;(35) READONLY
	XWD	OPNUNT,		;(36) UNIT=
	XWD	OPNADR,		;(37) ERR=
OPNMAX==.-OPNDSP-1
IF10,<

;Switch values (used for error messages)

OPARGN:	[ASCIZ/?/]		;(0) IGNORED
	[ASCIZ/?/]		;(1) DIALOG (no parsing)
	[ASCIZ/ACCESS=/]
	[ASCIZ/DEVICE=/]
	[ASCIZ/BUFFER COUNT=/]
	[ASCIZ/BLOCK SIZE=/]
	[ASCIZ/FILENAME=/]
	[ASCIZ/PROTECTION=/]
	[ASCIZ/DIRECTORY=/]
	[ASCIZ/LIMIT=/]
	[ASCIZ/MODE=/]
	[ASCIZ/FILE SIZE=/]
	[ASCIZ/RECORD SIZE=/]
	[ASCIZ/DISPOSE=/]
	[ASCIZ/VERSION=/]
	[ASCIZ/REELS=/]
	[ASCIZ/MOUNT=/]
	[ASCIZ/?/]		;(21) IOSTAT (no parsing)
	[ASCIZ/?/]		;(22) ASSOCIATEVARIABLE (no parsing)
	[ASCIZ/PARITY/]		;(23)
	[ASCIZ/DENSITY=/]	;(24)
	[ASCIZ/BLANK=/]		;(25)
	[ASCIZ/CARRIAGE CONTROL=/] ;(26)
	[ASCIZ/FORM=/]		;(27)
	[ASCIZ/LABELS=/]	;(30)
	[ASCIZ/PADCHAR=/]
	[ASCIZ/RECTYPE=/]
	[ASCIZ/STATUS=/]
	[ASCIZ/TAPE MODE=/]
	[ASCIZ/?/]		;(35) READONLY (no parsing)
	[ASCIZ/?/]		;(36) UNIT (no parsing)
	[ASCIZ/?/]		;(37) ERR= (no parsing)
OPMSMX==.-OPARGN-1

;Guard against maintainer errors

IFN	<OPNMAX-OPMSMX>,<PRINTX ?OPNMAX .NE. OPMSMX>

>;END IF10
;The list for CLOSE
CLSDSP:	XWD	%POPJ,		;(0) IGNORED
	XWD	OPNDIA,		;(1) DIALOG
	XWD	CLIGN,[DIAIGN]	;(2) ACCESS=
	XWD	OPNDEV,		;(3) DEVICE=
	XWD	CLIGN,[DIAIGN]	;(4) BUFFERCOUNT
	XWD	CLIGN,[DIAIGN]	;(5) BLOCKSIZE
	XWD	OPNFIL,		;(6) FILE NAME=
	XWD	OPNINT,[DIAOCT]	;(7) PROTECTION
	XWD	OPNDIR,		;(10) DIRECTORY
	XWD	CLIGN,[DIAIGN]	;(11) LIMIT
	XWD	CLIGN,[DIAIGN]	;(12) MODE
	XWD	CLIGN,[DIAIGN]	;(13) FILESIZE
	XWD	CLIGN,[DIAIGN]	;(14) RECORDSIZE
	XWD	CLSKWD,SWDISC	;(15) DISPOSE
	XWD	CLIGN,[DIAIGN]	;(16) VERSION
	XWD	OPNERR,		;(17) REELS
	XWD	OPNERR,		;(20) MOUNT
	XWD	OPNADR,		;(21) IOSTAT
	XWD	OPNADR,		;(22) ASSOCIATEVARIABLE
	XWD	CLIGN,[DIAIGN]	;(23) PARITY
	XWD	CLIGN,[DIAIGN]	;(24) DENSITY
	XWD	CLIGN,[DIAIGN]	;(25) BLANK
	XWD	CLIGN,[DIAIGN]	;(26) CARRIAGECONTROL
	XWD	CLIGN,[DIAIGN]	;(27) FORM
	XWD	CLIGN,[DIAIGN]	;(30) LABELS
	XWD	CLIGN,[DIAIGN]	;(31) PADCHAR
	XWD	CLIGN,[DIAIGN]	;(32) RECTYPE
	XWD	CLSKWD,SWSTTC	;(33) STATUS
	XWD	CLIGN,[DIAIGN]	;(34) TAPEMODE
	XWD	CLIGN,[DIAIGN]	;(35) READONLY
	XWD	OPNUNT,		;(36) UNIT=
	XWD	OPNADR,		;(37) ERR=
CLSMAX==.-CLSDSP-1

;Guard against maintainer errors

IFN	<OPNMAX-CLSMAX>,<PRINTX ?OPNMAX .NE. CLSMAX>
OPSTOR:	$SNH			;(0)
	$SNH			;(1)  DIALOG=
	STORE	T2,ACC(D)	;(2)  ACCESS=
	$SNH			;(3)  DEVICE=
	STORE	T2,BUFCT(D)	;(4)  BUFFER COUNT=
	STORE	T2,BLKSZ(D)	;(5)  BLOCK SIZE=
	$SNH			;(6)  FILE=
	PUSHJ	P,SETPROT	;(7)  PROTECTION=
	$SNH			;(10) DIRECTORY=
	STORE	T2,LIM(D)	;(11) LIMIT=
	STORE	T2,MODE(D)	;(12) MODE=
	MOVEM	T2,EST(D)	;(13) FILE SIZE=
	MOVEM	T2,RSIZE(D)	;(14) RECORD SIZE=
	STORE	T2,DISP(D)	;(15) DISPOSE=
	MOVEM	T2,VERN(D)	;(16) VERSION=
	$SNH			;(17) REELS=
	$SNH			;(20) MOUNT=
	MOVEM	T2,IOSAD(U)	;(21) IOSTAT=
	MOVEM	T2,AVAR(U)	;(22) ASSOCIATE VARIABLE=
	STORE	T2,PAR(D)	;(23) PARITY=
	STORE	T2,DEN(D)	;(24) DENSITY=
	STORE	T2,BLNK(U)	;(25) BLANK=
	STORE	T2,CC(U)	;(26) CARRIAGE CONTROL=
	STORE	T2,FORM(D)	;(27) FORM=
	STORE	T2,LBL(D)	;(30) LABELS=
	STORE	T2,PADCH(U)	;(31) PADCHAR=
	STORE	T2,RECFM(D)	;(32) RECTYPE=
	STORE	T2,STAT(D)	;(33) STATUS=
	STORE	T2,TAPM(D)	;(34) TAPE MODE=
	STORE	T2,RO(D)	;(35) READONLY
	STORE	T2,UNUM(U)	;(36) UNIT=
	MOVEM	T2,ERRAD(U)	;(37) ERR=
;DEFAULT DEVICE TABLE

IF10,<DEFINE X (A) <EXP SIXBIT /A/>>
IF20,<DEFINE X (A) <EXP ASCII /A/>>

	X	PLT		;-7	FOR USE BY FORPLT
	X	REREAD		;-6	REREAD
	X	CDR		;-5	READ
	X	TTY		;-4	ACCEPT
	X	LPT		;-3	PRINT
	X	PTP		;-2	PUNCH
	X	TTY		;-1	TYPE
DEVTAB:
IFE FTDSK,<
	X	DSK		;00	DISK
	X	DSK		;01	DISK
	X	CDR		;02	CARD READER
	X	LPT		;03	LINE PRINTER
	X	CTY		;04	CONSOLE TELETYPE
	X	TTY		;05	USER'S TELETYPE
	X	PTR		;06	PAPER TAPE READER
	X	PTP		;07	PAPER TAPE PUNCH
	X	DIS		;08	DISPLAY
	X	DTA1		;09	DECTAPE
	X	DTA2		;10
	X	DTA3		;11
	X	DTA4		;12
	X	DTA5		;13
	X	DTA6		;14
	X	DTA7		;15
	X	MTA0		;16	MAG TAPE
	X	MTA1		;17
	X	MTA2		;18
	X	FORTR		;19
	X	DSK		;20
	X	DSK		;21
	X	DSK		;22
	X	DSK		;23
	X	DSK		;24
	X	DEV1		;25	ASSIGNABLE DEVICES
	X	DEV2		;26
	X	DEV3		;27
	X	DEV4		;28
	X	DEV5		;29
>
MAXDEV==.-DEVTAB		;MAXDEV & UP   DISK
	SUBTTL	DDB CONSOLIDATION ROUTINES

;Routine to mark DDB for consolidation if the device is the
; same. If there is an error, the program is aborted.
;Called for all generic OPEN's.

MARKCS:	MOVEI	T1,1		;Set use count to 1
	MOVEM	T1,USCNT(D)	; (Probably won't be consolidated)
	LOAD	T1,DVTYP(D)	;Get device type
IF10,	CAIN	T1,.TYDSK	;DSK: doesn't get consolidated

IF20,<
	CAIE	T1,.DVNUL	;NUL: DOESN'T GET CONSOLIDATED
	CAIN	T1,.DVDSK	;DSK: doesn't get consolidated
>;END IF20

	 POPJ	P,		; Return; not consolidated

;See if we can find another DDB with same device.

	MOVE	T1,DVICE(D)	;Get device info to compare
	MOVE	T2,[MINUNIT-MAXUNIT-1,,MINUNIT] ;Loop thru all units
MRKSC1:	MOVE	T3,%DDBTAB(T2)	;Get a unit block address
	JUMPE	T3,MRKSC2	;None, skip
	MOVE	T4,DDBAD(T3)	;Get DDB addr.
	CAMN	T1,DVICE(T4)	;Same device?
	 JRST	MRKSCS		;Yes
MRKSC2:	AOBJN	T2,MRKSC1	;Not the same, loop
	POPJ	P,		;This device not used yet, no consolidation

MRKSCS:	CAMN	U,T3		;Same unit?
	 JRST	MRKSC2		;Yes, skip it

;We found the device in another DDB
;T3= new unit address
;T4= DDB address for it

	MOVEM	T3,CNSUNT	;Save unit address
	PUSHJ	P,CNSCHK	;Make sure something isn't incompatible
				; (if so, take ERR= or abort)
	MOVE	T3,CNSUNT	;T3= address of unit to consolidate
	MOVE	T2,DDBAD(T3)	;T2= DDB address of it
	MOVE	T1,FLAGS(T2)	;Get DDB flags
	TXNE	T1,D%IN+D%OUT	;OPEN already?
	 JRST	MRKCNS		;Yes, consolidate now

;Can't really consolidate yet (since an OPEN failure might get us to DIALOG
; mode where the guy might change some DDB parameters, including the
; device). So we have to "mark" the DDB for consolidation, which will
; happen for all unopened DDB's when any one of them is really OPENed.
;This is done by inserting this DDB in a doublyinked list.
;T3= unit address

	LOAD	T1,CNSL1(T3)	;See if any consolidated yet..
	JUMPE	T1,NOTCYT	;No
	STORE	U,CNSL1(T3)	;Store new "next" link in old previous
				; unit block
	STORE	T3,CNSL2(U)	;Store new "previous" link in added unit block
	STORE	T1,CNSL1(U)	;Store new "next" link in added unit block
	STORE	U,CNSL2(T1)	;Store new "previous" link in old next
				; unit block
	POPJ	P,		;Return

;Set up initial doubly-linked list (two items in it)
;Next and previous links are the same for each item - they just point
;to the other one.

NOTCYT:	STORE	T3,CNSL1(U)
	STORE	T3,CNSL2(U)
	STORE	U,CNSL1(T3)
	STORE	U,CNSL2(T3)
	POPJ	P,		;Linked to each other

;The device is already OPEN on another DDB

MRKCNS:	MOVEI	T1,(D)		;Throw away this DDB
	PUSHJ	P,%FREBLK
	MOVE	T1,CNSUNT	;Get unit address that points to common DDB
	MOVE	D,DDBAD(T1)	;Get DDB
	AOS	USCNT(D)	;Increment use count
	PJRST	FIXU		;Fixup "U" and return.

SEGMENT	DATA
CNSUNT:	BLOCK	1		;Address of the unit that might point
				; to a "common" DDB.
SEGMENT	CODE
;DOCONS: Routine to do consolidation of DDB's (when an OPEN was successful)
; If any DDB's are linked in the "consolidation" chain (waiting for
; one of the units to actually get "OPEN'ed"), they are thrown away
; and the use count of the one that is opened reflects the number
; that are attached.
; This routine returns .+1 always.

DOCONS:	LOAD	T1,CNSL1(U)	;Get "next" unit in chain, if any
	JUMPE	T1,%POPJ	;Return if none -- nothing to do.
	PUSHJ	P,%SAVE2	;Free up a perm ac
	SETZ	P2,		;P2= permanently zero ac.
	MOVE	P1,T1		;Get unit block address

;P1= address of unit block to consolidate with this one

DOCNS1:	MOVE	T1,DDBAD(P1)	;Throw away it's DDB
	PUSHJ	P,%FREBLK
	MOVEM	D,DDBAD(P1)	;Store consolidated DDB address
	AOS	USCNT(D)	;Increment use count
	PUSH	P,U		;Save "u"
	MOVE	U,P1		;Get unit to setup
	PUSHJ	P,FIXU		;Fixup the unit block (OPENED)
	POP	P,U		;Restore "u"

	LOAD	T1,CNSL1(P1)	;Get "next" unit in chain
	CAMN	T1,U		;Wrapped around to beginning?
	 JRST	DOCNS2		;Yes
	STORE	P2,CNSL1(P1)	;Clear the links..
	STORE	P2,CNSL2(P1)	; . .
	MOVE	P1,T1		;P1= next unit
	JRST	DOCNS1		;Loop

;Clear links in the current unit block also.

DOCNS2:	STORE	P2,CNSL1(U)
	STORE	P2,CNSL2(U)
	POPJ	P,		;Return
;Routine to see if we can successfully consolidate a DDB.
; The parameters must match in the DDB.
;If they don't, the program takes ERR= branch or is aborted.
;Call:
;	CNSUNT/ address of unit that points to DDB to check
;	D/  current (set-up) DDB
;	PUSHJ	P,CNSCHK
;	<return here if ok>
;

CNSCHK:	MOVE	T1,CNSUNT	;Point to unit block
	LOAD	T2,UNUM(T1)	;T2= unit number for error message
	MOVE	T1,DDBAD(T1)	;T1= DDB address to check
	LOAD	T3,MODE(T1)	;Get old mode
	LOAD	T4,MODE(D)	;Get new mode
	CAME	T3,T4		;The same?
	 $ECALL	SDO,%ABORT	;?No, give error
	POPJ	P,		;Return
;Routine to clear consolidation pointers for this DDB (if any).
;If a DDB has consolidation pointers, it is because there
; are other DDB's that refer to the same device, although they
; have not yet been OPEN'ed.

CLRCNS:	LOAD	T1,CNSL1(U)	;Get "next" link
	JUMPE	T1,%POPJ	;Return if none
	LOAD	T2,CNSL2(U)	;Get "previous" link
	SETZ	T3,		;Get a clear ac
	CAMN	T1,T2		;The same? (just two unit blocks in link)
	 JRST	CLRCN1		;Yes, delete all ptrs.
	STORE	T1,CNSL1(T2)	;Store new "next" link in old previous
	STORE	T2,CNSL2(T1)	;Store new "previous" link in old next
	JRST	CLRCN2		;Delete links of this DDB

;Delete all ptrs.

CLRCN1:	STORE	T3,CNSL1(T1)
	STORE	T3,CNSL2(T1)

;Delete ptrs in this unit block.

CLRCN2:	STORE	T3,CNSL1(U)
	STORE	T3,CNSL2(U)
	POPJ	P,		;Return
	SUBTTL	CLOSE

	SIXBIT	/RELEA./
RELEA%:	PUSHJ	P,%SAVE		;SAVE USER'S ACS
	XMOVEI	T1,[ASCIZ /RELEASE/] ;SET STATEMENT NAME FOR ERR MESSAGES
	MOVEM	T1,%IONAM
	PUSHJ	P,RLSCNV	;CONVERT TO CLOSE STATEMENT
	JRST	RCONT		;CONTINUE AS IF CLOSE(UNIT=U)

	SIXBIT	/CLOSE./
CLOSE%:	PUSHJ	P,%SAVE		;SAVE USER'S ACS
	XMOVEI	T1,[ASCIZ /CLOSE/] ;SET STATEMENT NAME FOR ERR MESSAGES
	MOVEM	T1,%IONAM
	PUSHJ	P,CLSCNV	;CONVERT OLD ARG BLOCK FORMAT

;Get TUNIT= unit #, %TERR= "ERR=" address, %TIOS= "IOSTAT=" address

RCONT:	PUSHJ	P,FNDAGL	;Find UNIT=, ERR=, IOSTAT=
				;If no UNIT= given, gets abortive error.
	PUSHJ	P,UNRNGE	;Check for unit out of range
				; Only return if in range, unit # in T2.
	SKIPE	T1,%TIOS	;Any IOSTAT variable?
	 SETZM	(T1)		;Yes, initialize to zero
	PUSHJ	P,SETFCL	;Set flag if non-trivial CLOSE
				; arguments were given
	MOVE	T2,TUNIT	;GET THE UNIT
	MOVE	P1,%DDBTAB(T2)	;Get ptr to unit block
	JUMPE	P1,CLSNOP	; If not open, this is a no-op

;Close an opened unit

	MOVE	P2,DDBAD(P1)	;P2= ptr to old DDB

;Set ERR= and IOSTAT= in the unit block

	MOVE	T1,%TERR	;Set ERR=
	MOVEM	T1,ERRAD(P1)
	MOVE	T1,%TIOS	;Set IOSTAT=
	MOVEM	T1,IOSAD(P1)

	MOVEI	T1,ULEN		;Allocate a blank unit
	PUSHJ	P,%GTBLK
	MOVE	U,T1
	MOVEI	T1,DLEN		; and DDB
	PUSHJ	P,%GTBLK
	MOVE	D,T1
	PUSHJ	P,COPFDD	;Copy file-spec info from old DDB

;D and U are pointers to blocks that get the arg-list info.
; The real unit block pointer and DDB pointer are in P1 and P2.

	MOVEM	D,RENAMD	;Save here incase of errors
	MOVEM	U,RENAMU	; (ERR routine will deallocate them)
	TXO	F,F%CLS		;NOW IN CLOSE
	PUSH	P,P1		;STACK-1 = Unit block
	PUSH	P,P2		;STACK-0 = DDB block
	PUSHJ	P,CLSARG	;MOVE ARGS TO DDB
				; (possibly take ERR= branch)
	TXNE	F,F%DSTRG	;DIALOG='string' seen?
	 PUSHJ	P,DLGSTR	;Yes, do it
				;(possibly take ERR= branch)
	TXZ	F,F%DSTRG!F%INDST	;Clear flags
	JRST	CLOS.1		;Go to main CLOSE code.
;Here if unit was never opened.
;Unit number in TUNIT
CLSNOP:	TXNN	F,F%CLA		;Any CLOSE args given that we are ignoring?
	 POPJ	P,		;No, just return from CLOSE
	MOVE	T2,TUNIT	;Get unit number to print in message
	$ECALL	CLA,%POPJ	;Give warning and return.

;Here with:
;	STACK-0 = old DDB block
;	STACK-1 = old Unit block
;	D = new DDB block
;	U = new Unit block
;Final CLOSE statement processing is done here, then
; we "PJRST" off to %CLOSE (the generic CLOSE routine).

CLOS.1:	PUSHJ	P,CHKDLG	;Do DIALOG mode if necessary
	DMOVE	P1,-1(P)	;P1= old unit block, P2= OLD DDB
	PUSHJ	P,CKCARG	;Check CLOSE args for problems,
				; issue errors and warnings
	TXNE	F,F%DRE		;Might have to go to dialog mode again
	 JRST	CLOS.1		; (user has to fix stuff)

	TXNE	F,F%FSS!F%DSS	;Dispose='rename' to be done?
	 JRST	CLOS.2		;Yes, the dummy blocks hold
				; the new filespec info- don't deallocate
	MOVEI	T1,(D)		;Deallocate the dummy DDB and unit blocks
	PUSHJ	P,%FREBLK	;. .
	MOVEI	T1,(U)		; . .
	PUSHJ	P,%FREBLK
	SETZM	RENAMD
	SETZM	RENAMU		;Clear ptrs
CLOS.2:	POP	P,D		;Re-get unit and DDB block ptrs.
	POP	P,U
	PJRST	CLOSE1		;Go close an opened unit and return
;Routine to set F%CLA if CLOSE args given besides UNIT, ERR, IOSTAT
;Call:
;	TERR, TIOS, TUNIT set up.
;	PUSHJ	P,SETFCL
;	<return here>
;	L/ -# ARGS,,addr
;Preserves T2

SETFCL:	HLRE	T1,L		;Get -# args
	ADDI	T1,1		;Account for unit=
	SKIPE	%TIOS		;IOSTAT=?
	 ADDI	T1,1		;Yes
	SKIPE	%TERR		;ERR=?
	 ADDI	T1,1		;Yes
	SKIPGE	T1		;More args specified?
	 TXO	F,F%CLA		;Yes, set flag
	POPJ	P,		;Return
	SUBTTL	%CLOSE: GENERIC CLOSE ROUTINE

;Routine to close an opened unit
;Call:
;	D/ ptr to DDB block
;	U/ ptr to unit block
;
; If F%FSS!F%DSS is set, then RENAMD and RENAMU contain ptrs to
;the D and U block that holds a new filespec to RENAME to.
;  Note: This is called from %ABORT and %EXIT-- flags
;F%FSS and F%DSS must be OFF.
;
;  ERR= and IOSTAT= args must have been put in the unit block (U).
;

%CLOSE:	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXOE	T1,D%NCLS	;Did a CLOSE error happen before?
	 POPJ	P,		;Yes, forget it
	MOVEM	T1,FLAGS(D)	;Set the flag incase an error happens
				; But if it's a RENAME error, the flag
				;should be turned off.
	LOAD	T1,DISP(D)	;Get /DISPOSE to set
	MOVEM	T1,DSPV

;Entry from CLOSE statement
;DSPV has been set.

CLOSE1:	PUSHJ	P,%SAVE2	;Free up P1 and P2

;We have to open the file if an explicit OPEN statement
; has been done.

	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNE	T1,D%IN!D%OUT	;Was file ever opened?
	 JRST	CLSITA		;Yes
	TXNE	T1,D%OPEN	;Was explicit OPEN done?
	 JRST	CLSITO		;Yes, have to open file first.
CLOSNO:	PUSHJ	P,CLSCLN	;Cleanup after CLOSE (core, etc.)
	JRST	CLSNOP		; Return, give error if CLOSE
				; arguments were specified and ignored.

;File must be opened since an explicit OPEN was done.
; If file exists, open for input.
;Else create a null file and open for input.

CLSITO:	LOAD	T1,INDX(D)	;What type of device?
	CAIN	T1,DI.DSK
	 JRST	CLSITY		;Yes, must do this.
IF10,<
	LOAD	T1,DVTYP(D)	;Not disk, but for DECtape have to do it too
	CAIN	T1,.TYDTA	;DECTAPE?
	 JRST	CLSITY		;Yes, must do it.
>
	JRST	CLOSNO		;Else don't have to do this.
;Here if file is on Disk or DECtape, and
;an OPEN was done but the file is not open now.
;Actually get the file opened.
; Note; No worry about sharing DDB's.
;The ACCESS must be SEQINOUT and the STATUS must be UNKNOWN (else
; the file would have been opened at the OPEN statement!)
;If file already exists, open for input.
;Else open for output.

CLSITY:	PUSHJ	P,CLOPNK	;Do the CLOSE-OPEN kludge
	 JRST	CSTYDL		;?Failed, go into DIALOG mode
	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNN	T1,D%IN!D%OUT	;Was file ever opened?
	 JRST	CLSNOP		;No
	JRST	CLSITA		;Go on

;Have to go into DIALOG mode because OPEN failed.
;  (how ironic!)

CSTYDL:	PUSH	P,F		;Save flags
	TXZ	F,F%CLS		;Forget we are in CLOSE
	PUSHJ	P,OPENX		;Go do the default OPEN
	TXO	F,F%CLS		;Back to being in CLOSE
	POP	P,T1		;Get back old flags
	TXZ	F,F%DSS!F%FSS	;Clear "filespec info seen"
	TXNE	T1,F%DSS	; Set them again
	 TXO	F,F%DSS		;If they were set at CLOSE
	TXNE	T1,F%FSS
	 TXO	F,F%FSS
	JRST	CLOSE1		;Go back and try again
;Here when file is open, to close it.

CLSITA:	LOAD	T1,INDX(D)	;GET DEV INDEX
	CAIE	T1,DI.DSK	;DISK?
	 JRST	XXXCLS		;NO.
	PUSHJ	P,DSKCLS	;Write out changed pages, throw away WTAB info.
	JRST	XCLSDN		;SKIP NON-DISK STUFF
XXXCLS:
	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNE	T1,D%OUT	;Was file open for output?
	 PUSHJ	P,%LSTBF	;YES. GO WRITE LAST BUFFER

IF20,<
	SKIPE	T1,WADR(D)	;ANY BUFFER TO DEALLOCATE?
	 PUSHJ	P,%FREBLK	;YES. DO IT
	SETZM	WADR(D)		;Clear core pointer
> ;IF20

XCLSDN:	LOAD	T1,UNUM(U)	;Get unit number
	HRRE	T1,T1		;Negative or positive, get full word value
	CAMN	T1,U.RERD	;Is it the last successful READ unit?
	 SETZM	U.RERD		;Yes, clear so REREAD fails.

	TXNN	F,F%FSS!F%DSS	;Implied DISPOSE='RENAME'?
	 JRST	XCLSDS		;No, go finish CLOSE
	PUSHJ	P,CLREN		;Yes, rename it
	 JRST	CLGDLG		;Error, go to DIALOG mode
	TXZ	F,F%FSS!F%DSS	;Clear flags
	MOVX	T1,1B0		;Clear "Delete after dispose" bit, if set
	ANDCAM	T1,DSPV
XCLSDS:	HRRZ	T1,DSPV		;Get value of /DISPOSE to do
	CAIL	T1,DS.QUEUE	;DOES IT IMPLY QUEUEING?
	  MOVEI	T1,DS.QUEUE	;YES
	PUSHJ	P,@CLSDIS(T1)	;DISPOSE OF FILE SOMEHOW
	 JRST	CLGDLG		;Error, go to DIALOG mode
	PJRST	CLSCLN		;Cleanup and return


;Note: For files where a DDB is shared by more than 1 unit block,
;   the only possible value is "SAVE".

CLSDIS:	IFIW	E..SNH		;0--?DSPV must be set
	IFIW	CLSAVE		;SAVE
	IFIW	CLDEL		;DELETE
	IFIW	CLEXP		;EXPUNGE
	IFIW	E..SNH		;RENAME (?can't get here)
	IFIW	CLSQ		;ALL OTHERS MEAN QUEUE
;Come here to go into DIALOG for CLOSE.
;IOERR has been given, but ERR= branch was not taken.

CLGDLG:	PUSHJ	P,CLSDLG	;Prepare for CLOSE dialog
				; (Get D and U pointing to the New blocks,
				; P1 AND P2 are the old blocks).
CLGDLA:	PUSHJ	P,CHKDLG	;Go do it
	PUSHJ	P,CKCARG	;Check CLOSE args for problems,
				; issue errors and warnings
	TXNE	F,F%DRE		;Might have to go to dialog mode again
	 JRST	CLGDLA		; ..
	TXNE	F,F%FSS!F%DSS	;Filespec given?
	 JRST	CLGDL1		;Yes, have to store new blocks.

	MOVEI	T1,(D)		;Deallocate the dummy blocks
	PUSHJ	P,%FREBLK
	MOVEI	T1,(U)
	PUSHJ	P,%FREBLK
	MOVE	U,P1		;U= old unit block
	MOVE	D,P2		;D= old DDB block
	SETZM	RENAMD
	SETZM	RENAMU		;No alternate blocks
	JRST	CLGDL2		;Continue

;Here if filespec info given. (Implied RENAME)

CLGDL1:	MOVEM	D,RENAMD	;Save RENAME info
	MOVEM	U,RENAMU	; .. away
	MOVE	U,P1		;Reget old block ptrs
	MOVE	D,P2

CLGDL2:	MOVX	T1,D%NCLS	;Set the error flag again (it could
				; have been turned off by CLREN).
	IORM	T1,FLAGS(D)	;(So any real CLOSE error will not
				; cause a loop with %ABORT).
	JRST	CLSITA		;Go restart generic CLOSE routine
;Routine to clean up after CLOSE (successfully) done.
; Throws away core not used, DDB and unit blocks.

CLSCLN:	CAMN	U,U.ERR		;ERROR MESSAGE UNIT?
	 SETZM	U.ERR		;YES, NO MORE ERR MESSAGE UNIT
	PUSHJ	P,CLRCNS	;Clear consolidation ptrs if any
				; (for un-opened units on same device)
	SOSGE	T1,USCNT(D)	;This DDB no longer in use
	 $SNH			;??USE count went negative
	JUMPN	T1,CLSCL1	;DDB still in use, don't deallocate it
	CAMN	D,D.TTY		;Is this the TTY DDB?
	 SETZM	D.TTY		;Yes, no more.
	HRRZ	T1,IRBUF(D)	;GET INPUT REC BUFFER ADDRESS
	SOJL	T1,.+2		;REMOVE ZERO WORD, SKIP IF NO BUFFER YET
	  PUSHJ	P,%FREBLK	;DEALLOCATE BUFFER

	HRRZ	T1,ORBUF(D)	;GET OUTPUT REC BUFFER ADDRESS
	SOJL	T1,.+2		;REMOVE ZERO WORD, SKIP IF NO BUFFER YET
	  PUSHJ	P,%FREBLK	;DEALLOCATE BUFFER

IF10,<
	HRRZ	T1,FBLK(D)	;GET FILOP FUNCTION
	JUMPE	T1,NDECHN	;IF NOT SET, CHANNEL WAS NEVER ALLOCATED
	LDB	T1,[POINTR CHAN(D),FO.CHN] ;GET CHANNEL NUMBER
	CAIG	T1,17		;IF NONEXTENDED,
	  PUSHJ	P,DECHN		;DEALLOCATE IT

NDECHN:	LOAD	T1,BUFAD(D)	;GET ADDRESS OF BUFFERS
	CAIE	T1,0		;IF SET
	  PUSHJ	P,%FREBLK	;FREE THEM

> ;IF10
	MOVEI	T1,(D)		;Throw away DDB
	PUSHJ	P,%FREBLK
	JRST	CLSCL2

;Here if DDB is in use by another unit.

CLSCL1:	MOVX	T1,D%NCLS	;Turn off error flag
	ANDCAM	T1,FLAGS(D)

;Unit is now closed. Throw away the unit block and ptr in DDBTAB.

CLSCL2:	HXRE	T2,UNUM(U)	;Get unit number
	SETZM	%DDBTAB(T2)	;Clear entry in DDBTAB
	MOVEI	T1,(U)		;Throw away unit block
	PUSHJ	P,%FREBLK
	POPJ	P,		;Return
;Routine to get ready for dialog mode in CLOSE statement.
;  This routine saves the old DDB and unit block addresses
; in P1 and P2, respectively, and sets D and U pointing to dummy
; blocks (to get the args from DIALOG mode).
;
;If DISPOSE='RENAME' was set, use the blocks we kept around to hold
;	the filespecs.
;Else
;	Allocate new blocks.

CLSDLG:	MOVE	P1,U		;Set P1, P2 to OPEN blocks
	MOVE	P2,D
	TXNE	F,F%FSS!F%DSS	;Rename DDB blocks setup?
	 JRST	CLSDL1		;Yes, use them
	MOVEI	T1,ULEN		;No, allocate new ones
	PUSHJ	P,%GTBLK
	MOVE	U,T1
	MOVEI	T1,DLEN
	PUSHJ	P,%GTBLK
	MOVE	D,T1
	PJRST	COPFDD		;Copy filespec info from old DDB
				; and return

;Come here if we can use those old blocks
; we kept around for the RENAME info.

CLSDL1:	MOVE	D,RENAMD	;Use same blocks we kept around
	MOVE	U,RENAMU
	SETZM	RENAMD		;Clear ptrs
	SETZM	RENAMU
	POPJ	P,		;Return
;TOPS-10 routine to OPEN a file in the CLOSE statement.
; This makes sure that the file gets created if it does not exist.
;Return:
;	.+1 if error happened, no flags set.
;	.+2 if ok, with either D%IN or D%OUT set.
;only called if device is DSK or DTA.

IF10,<
CLOPNK:	SETZ	T1,		;Don't care whether D%IN or D%OUT set.
	PUSHJ	P,DOOPEN	; Open file for input
	 POPJ	P,		;?Failed, go into DIALOG
	JRST	%POPJ1		;Worked, return success
>

;TOPS-20 routine to OPEN a file in the CLOSE statement.
; This makes sure that the file gets created if it does not exist.
;Only called if device is DSK.

IF20,<
CLOPNK:	LOAD	T1,INDX(D)	;Get device index
	CAIE	T1,DI.DSK	;Don't do it unless disk
	 JRST	%POPJ1
	LOAD	T2,IJFN(D)	;Get JFN
	SKIPE	T2		;Skip if any..
	 PUSHJ	P,DOJFNS	;Get info in file block
	PUSHJ	P,SETJFN	;Get JFN
	MOVX	T1,GJ%NEW	;Get a new JFN
	HLLM	T1,JFNBLK+.GJGEN
	MOVEI	T1,JFNBLK	;Get a JFN
	MOVEI	T2,[0]
	GTJFN%
	 ERJMP	CLOPK2		;Already exists, go open for input
	MOVX	T2,D%OUT	;Set this flag if all goes well
CLOPK1:	MOVEM	T2,SVCLKB	;Save bits
	STORE	T1,IJFN(D)
	STORE	T1,OJFN(D)	;Store away JFN
	MOVX	T1,D%RJN	;"Got a real JFN now"
	IORM	T1,FLAGS(D)	; Set the flag in the DDB
	PUSHJ	P,GMODBY	;Get DMBS, BPW
	PUSHJ	P,%CHKNR	;Check data mode
	 POPJ	P,		;?illegal, go have dialog
	LOAD	T1,IJFN(D)	;Get JFN again
	MOVX	T2,OF%WR	;Assume he wants WRITE access
	MOVE	T3,SVCLKB	;Get bits
	TXNE	T3,D%IN		;Want to open for input?
	 MOVX	T2,OF%RD	;Yes, set READ access
	OR	T2,DMBS(D)	;Set data mode, byte size
	OPENF%			;Get file opened
	 ERJMP	OPFERR		;Failed, give error
	MOVE	T1,SVCLKB	;Set "File opened" for either input or output
	IORM	T1,FLAGS(D)	; in the DDB
	JRST	%POPJ1		;Return success

CLOPK2:	CAIE	T1,GJFX27	;"File already exists"?
	 JRST	GJERR		;No, bad error
	MOVX	T1,GJ%OLD	;Try old file this time
	HLLM	T1,JFNBLK
	MOVEI	T1,JFNBLK
	MOVEI	T2,[0]
	GTJFN%
	 ERJMP	GJERR		;?Failed
	MOVX	T2,D%IN		;Set "FILE OPENED FOR INPUT" if successful
	JRST	CLOPK1

SEGMENT DATA
SVCLKB:	BLOCK	1		;D%IN or D%OUT
SEGMENT CODE

>;END IF20
;Routine to copy filespec info from old DDB to new one.
; (as defaults for DIALOG, etc.)
;Inputs:
;	P1 & P2/ old unit & DDB blocks
;	U & D/ new unit & DDB blocks
;Call:
;	PUSHJ	P,COPFDD
;	<return here always>

COPFDD:	LOAD	T1,INDX(P2)	;Device index is copied
	STORE	T1,INDX(D)
	LOAD	T1,UNUM(P1)	;Unit number is copied
	STORE	T1,UNUM(U)
IF20,<
	HRLI	T1,DEV(P2)	;Copy a bunch of stuff
	HRRI	T1,DEV(D)
	BLT	T1,DEV+.FSSLN-1(D) ;. .
>
IF10,<
	LOAD	T1,DVTYP(P2)	;Device-type code
	STORE	T1,DVTYP(D)
	MOVE	T1,DEV(P2)	;Device name
	MOVEM	T1,DEV(D)
	MOVE	T1,FILE(P2)	;Filename
	MOVEM	T1,FILE(D)
	HLLZ	T1,EXT(P2)	;Extension
	HLLM	T1,EXT(D)
	HRLI	T1,PTHB(P2)	;Path
	HRRI	T1,PTHB(D)
	BLT	T1,PTHB+^D9-1(D)
	LDB	T1,[POINTR (PROT(P2),RB.PRV)] ;Protection
	DPB	T1,[POINTR (PROT(D),RB.PRV)]
>;end IF10
	POPJ	P,		;Return
;Reconcile CLOSE args with the OPEN unit info.
; Errors and warnings are issued (possibly ERR= branch taken).
;If DISPOSE='RENAME', the new filespec is remembered.
; Possibly set F%DRE to get him to DIALOG mode.
;Inputs:
;	p1 and p2 point to old unit and DDB blocks
;	U and D point to new ones.
;	PUSHJ	P,CKCARG
;	<return here> (or take ERR=).

CKCARG:	PUSHJ	P,DFDEV1	;Get device info, skip if ok
	 POPJ	P,		;No, error
	PUSHJ	P,CKCCNF	;Check CLOSE arg conflicts
	  POPJ	P,		;Error, return immediately
	PUSHJ	P,CKDPSR	;Check DISPOSE='RENAME'
				; Remembers filespec if necessary.

	PJRST	SETCDS		;Set disposition of file and return
				; (could get error)
;Routine to check for CLOSE arg conflicts
; and issue errors and warnings.
;Returns .+2 if no problems,
; else returns .+1 with F%DRE set (unless ERR= taken)

CKCCNF:	LOAD	T1,STAT(D)	;Get STATUS
	JUMPE	T1,CKCCN1	; If not specified, no conflict
	LOAD	T2,DISP(D)	;Get DISPOSE
	JUMPE	T2,CKCCN1	; If not specified, no conflict
	SUBI	T1,ST.DISP	;Get /DISPOSE value
	SKIPG	T1		;Better be positive
	  $SNH			;?OOPS what's this??
	CAME	T1,T2		;Does it match?
	 JRST	CKCCN2		;?No, conflict
;	JRST	CKCCN1		;Yes, no conflict

SEGMENT ERR
CKCCN2:	PUSH	P,T2		;Save DISPOSE value
	XMOVEI	T3,[ASCIZ/STATUS:/]
	MOVEM	T3,%OPNK1	;Save string address of first switch
	XMOVEI	T3,[ASCIZ/DISPOSE:/]
	MOVEM	T3,%OPNK2	; and string address of second switch
	MOVEI	T3,OK.DISP	;Look in DISPOSE table for switch values
	HRRZ	T2,CLSDSP(T3)
	PUSH	P,T2		;Save address of switch table
	PUSHJ	P,FNDSWT	;Find STATUS value
	MOVEM	T1,%OPNV1	;Save it
	POP	P,T2		;Get addr of switch table
	POP	P,T1		;Get DISPOSE value
	PUSHJ	P,FNDSWT	;Find DISPOSE keyword
	MOVEM	T1,%OPNV2	;Save for error
	$ECALL	ISW,REQDIA	;?Incompatible attributes
SEGMENT CODE

CKCCN1:	JRST	%POPJ1		;No conflicts, return .+2
;Routine to set disposition of file
; Possibly ERR= taken.

SETCDS:	LOAD	T1,DISP(P2)	;T1:= OPEN DISPOSE value
	MOVEM	T1,DSPV		;Use that if nothing else specified
	LOAD	T1,DISP(D)	;T1:= Get new DISPOSE value
				; Cannot be "RENAME"
	JUMPN	T1,SETCD1	;Jump if something specified
	LOAD	T1,STAT(D)	;No, get status
	JUMPE	T1,SETCD1	;If that also isn't specified, forget it
	SUBI	T1,ST.DISP	;Get DS.xxx value

SETCD1:	LOAD	T2,STAT(P2)	;Get old STATUS
	CAIE	T2,ST.SCR	;Skip if scratch
	 JRST	COPDSP		;Copy new disposition (if specified)

;Don't allow DISPOSE='SAVE' when STATUS='SCRATCH'
; unless the file is being renamed.

	CAIN	T1,DS.SAVE
	 JRST	DSSCNF		;Conflict
;	JRST	COPDSP		;Not DISPOSE='SAVE'

SEGMENT ERR
DSSCNF:	XMOVEI	T1,[ASCIZ/DISPOSE:/]
	LOAD	T2,DISP(D)	;Was it really STATUS?
	SKIPN	T2
	 XMOVEI	T1,[ASCIZ/STATUS:/] ;Yes, say conflict there
	MOVEM	T1,%OPNK1
	XMOVEI	T1,[ASCIZ/SAVE/]
	MOVEM	T1,%OPNV1
	XMOVEI	T1,[ASCIZ/STATUS:/]
	MOVEM	T1,%OPNK2
	XMOVEI	T1,[ASCIZ/SCRATCH/]
	MOVEM	T1,%OPNV2
	$ECALL	ISW,REQDIA	;?Incompatible attributes
SEGMENT CODE

;Copy disposition (if specified)
;T1= DISPOSITION specified in CLOSE.

COPDSP:	LOAD	T3,STAT(P2)	;Get OPEN STATUS value
	MOVX	T4,1B0		;Get "delete after dispose" bit
	JUMPE	T1,COPDS1	;Jump if no disposition specified
	PUSHJ	P,DISPCK	;Check disposition conflict with device
	MOVEM	T1,DSPV		;Store dispose value
	CAIN	T3,ST.SCR	;STATUS='SCRATCH'?
	 IORM	T4,DSPV		;Yes, set "delete after dispose" bit
	POPJ	P,		;Return

;Here if no disposition specified on CLOSE
;If a SCRATCH file and beginning DISP was DELETE or EXPUNGE,
; set to "SAVE". This way if an implied RENAME is done then
; the "delete after dispose" bit is cleared and then the file
; is saved.

COPDS1:	CAIE	T3,ST.SCR	;STATUS='SCRATCH'?
	 POPJ	P,		;No, done
	MOVE	T1,[1B0+DS.SAVE] ;Get "SAVE" + "delete after dispose"
	MOVE	T2,DSPV		;Get OPEN dispose value
	CAIE	T2,DS.DEL	;DELETE
	CAIN	T2,DS.EXP	; or EXPUNGE
	 MOVEM	T1,DSPV		;Yes, set to "SAVE"
	POPJ	P,		;Return

SEGMENT	DATA
DSPV:	BLOCK	1		;DISPOSE value, also 1B0="delete after dispose"
SEGMENT	CODE
;Routine to check disposition to make sure it is ok for that device
;Call:
;	T1/ Disposition value requested
;	D/ ptr to DDB (used to get INDX)
;	PUSHJ	P,DISPCK
;	<return here, T1= disposition to set>
;A warning is given if the disposition is not allowed (and SAVE is used).
;
;If device is disk, everything is ok.
;(10) If device is dectape, everything is ok too.
;If device is anything else, only "SAVE" is allowed.
;Uses T1,T2

DISPCK:	CAIN	T1,DS.SAVE	;SAVE is always allowed
	 POPJ	P,
	LOAD	T2,INDX(D)	;T2= device index
				; Note INDX field copied to dummy DDB.
	CAIN	T2,DI.DSK	;DEVICE-type = disk?
	 POPJ	P,		;Yes, all dispositions allowed

IF10,<
	LOAD	T2,DVTYP(D)	;Check device type
	CAIN	T2,.TYDTA	;DECTAPE can get any dispose
	 POPJ	P,		; . .
>
	MOVEI	T1,DS.SAVE	;Set DISPOSE='SAVE'
	$ECALL	DSS		;%DISPOSE='SAVE' assumed for non-disk device
	POPJ	P,
;Check for DISPOSE='RENAME' .. if specified, get the
;RENAME arguments out of the DDB block.
;If DISPOSE='RENAME' specified but no new filename
; is given, a warning is given.

CKDPSR:	TXNE	F,F%FSS!F%DSS	;Implied?
	 JRST	CKDPS1		;Yes
	LOAD	T1,DISP(D)	;Get value of /DISPOSE
	CAIE	T1,DS.REN	;RENAME?
	 POPJ	P,		;No, just return

;DISPOSE='RENAME' given but no filespec info (??).

	$ECALL	RND		;%DISPOSE='RENAME' ignored	
	SETZ	T1,		;Set DISPOSE value to "not specified"
	STORE	T1,DISP(D)	;. .
	POPJ	P,

;Implied rename
;Remember the new filespec, by storing away the addresses
; of the "D" and "U" used to read the CLOSE arguments with the
; new filespec. (We won't release the core for them until after the RENAME
;is successfully completed!).

CKDPS1:	MOVEM	D,RENAMD	;Save info from the dummy blocks
	MOVEM	U,RENAMU	; . .
	LOAD	T1,DISP(D)	;If DISP:/RENAME, set to "not specified"
	SETZ	T2,
	CAIN	T1,DS.REN
	 STORE	T2,DISP(D)
	POPJ	P,		;Return

SEGMENT	DATA

RENAMD:	BLOCK	1	;Address of dummy "D" with rename filespec
RENAMU:	BLOCK	1	;Address of dummy "U" with rename filespec

SEGMENT	CODE
IF20,<

CLSAVE:	MOVE	T1,USCNT(D)	;Get use count
	CAIE	T1,1		; Only CLOSE file if open on just 1 unit
	 JRST	%POPJ1
	SKIPGE	DSPV		;Skip if not DELETE after close
	 JRST	CLEXP		;DELETE needed, go expunge file

	LOAD	T1,IJFN(D)	;GET JFN
	CAIN	T1,.PRIIN	;If TTY:, don't close it
	 JRST	%POPJ1		; or release it
	GTSTS%			;GET FILE STATUS
	JUMPGE	T2,CLNCL	;IF NOT OPEN, DON'T CLOSE IT

	CLOSF%			;CLOSE FILE
	  ERJMP	CLF		;FAILED
	JRST	%POPJ1		;All done, file saved

CLNCL:	RLJFN%			;GIVE JFN BACK
	  JFCL			;NOTHING YOU CAN DO
	JRST	%POPJ1		;Done


CLF1:	POP	P,(P)		;FIX STACK
CLF:	SETZ	T1,		;DISCARD JFN SO WE NEVER TRY TO CLOSE IT AGAIN
	STORE	T1,IJFN(D)
	STORE	T1,OJFN(D)
;	IOERR	(CLF,34,,?,$J,%POPJ)
	$ECALL	CLF,REQDIA

RNFL:	SETZ	T1,		;Same as CLF, but
	STORE	T1,IJFN(D)	;Different error msg
	STORE	T1,OJFN(D)
	MOVX	T1,D%NCLS	;Turn off CLOSE error flag
	ANDCAM	T1,FLAGS(D)	; (RENAME failed)
	$ECALL	RNM,REQDIA
; TOPS-20 /DISPOSE:DELETE and EXPUNGE

CLDEL:	TDZA	T0,T0		;SET TO JUST DELETE
CLEXP:	MOVX	T0,DF%EXP	;SET TO EXPUNGE
	LOAD	T1,OJFN(D)	;GET JFN
	CAIN	T1,.PRIOU	;If TTY:,
	 JRST	%POPJ1		;Nothing to do
	PUSH	P,T1		;SAVE FOR DELF
	GTSTS%			;SEE IF OPEN
	JUMPGE	T2,CLDEL1	;IF NOT OPEN, DON'T CLOSE IT


	HRLI	T1,(CO%NRJ)	;CLOSE FILE, KEEP JFN
	CLOSF%
	 ERJMP	CLF1

CLDEL1:	POP	P,T1		;GET DELF ARG BACK
	HLL	T1,T0		;PUT IN EXPUNGE BIT, IF /DISP:EXPUNGE
	DELF%			;DELETE FILE, MAYBE EXPUNGE
	 ERJMP	CLF

	JRST	%POPJ1		;Ok, file deleted
;Routine to RENAME file prior to close.
;On TOPS-20 this requires that the CLOSF be done.
;Also only DISK devices are allowed.
;D/ U/ old DDB block.
;RENAMD/ RENAMU/ new DDB block.

CLREN:	LOAD	T1,IJFN(D)	;Get JFN
	GTSTS%
	JUMPGE	T2,RNNCL	;IF NOT OPEN, DON'T CLOSE IT

	LOAD	T1,IJFN(D)	;CLOSE FILE, KEEP JFN
	HRLI	T1,(CO%NRJ)
	CLOSF%
	 ERJMP	CLF		;Can't

RNNCL:	PUSHJ	P,RNFCHK	;Check for RENAME on invalid devices
	 POPJ	P,		;Error, go into DIALOG
	CAIE	T1,.DVDSK	;RENAME disk to disk?
	 JRST	RNME1		;No, just return success
	EXCH	D,RENAMD	;SWITCH TO DATA SPECIFIED IN CLOSE STMT
	PUSHJ	P,SETJFN	;SET UP JFNBLK WITH FILENAME
	EXCH	D,RENAMD
	MOVX	T1,GJ%FOU	;NEXT HIGHER GENERATION NUMBER ON
	HLLM	T1,JFNBLK+.GJGEN

	MOVEI	T1,JFNBLK	;GET JFN ON DESTINATION FILE
	HRROI	T2,[0]
	GTJFN%
	  ERJMP	RNFL

	MOVEI	T2,(T1)		;COPY DESTINATION JFN
	LOAD	T1,IJFN(D)	;GET SOURCE JFN
	RNAMF%			;RENAME THE FILE
	  ERCAL	RNFL

	STORE	T2,IJFN(D)	;Store new JFN in old DDB
	STORE	T2,OJFN(D)	; The JFN is CLOSE'd.

;Throw away the RENAMD and RENAMU blocks; done with them

	PJRST	RNME1		;Go throw away core, etc.
>;END IF20
;Routine to throw away the RENAMD and RENAMU blocks because
;  they are no longer needed.  Also clears F%FSS and F%DSS.
;Returns .+2 always

RNME1:	TXZ	F,F%FSS!F%DSS	;RENAME no longer necessary
	MOVE	T1,RENAMD
	PUSHJ	P,%FREBLK	;Throw away blocks
	MOVE	T1,RENAMU
	PUSHJ	P,%FREBLK
	SETZM	RENAMD		;Clear ptrs
	SETZM	RENAMU		; . .
	AOS	(P)		;Return ok
	POPJ	P,		;DONE
IF20,<

;TOPS-20 routine to prepare for disk close.
; It un-maps any mapped pages and throws away the core.

DSKCLS:	MOVE	T2,WTAB(D)	;POINT TO IN-CORE WINDOW
	JUMPE	T2,%POPJ	;IF ANY
	JUMPG	T2,DCLS2	;IF NEG
	HLRZ	T2,(T2)		;GET FIRST PAGE IN TABLE
DCLS2:	HRLI	T2,.FHSLF	;PUT FORK HANDLE IN LH
	LOAD	T3,BUFCT(D)	;GET LENGTH OF WINDOW, PAGES
	HRLI	T3,(PM%CNT)	;THAT'S THE REPEAT COUNT
	SETO	T1,		;SET TO UNMAP
	PMAP%			;UNMAP THE FILE PAGES

	MOVE	T1,WTAB(D)
	JUMPG	T1,DCLS3	;IF NEG
	HLRZ	T1,(T1)		;GET FIRST PAGE IN TABLE
DCLS3:	LOAD	T2,BUFCT(D)	;GET PAGE COUNT OF WINDOW
	PUSHJ	P,%FREPGS	;DEALLOCATE IT
	SETZM	WTAB(D)		;Note we threw it away

	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNN	T1,D%MOD	;WAS FILE MODIFIED?
	  POPJ	P,		;NO, DONE

	LOAD	T1,IJFN(D)	;GET FILE JFN
	HRLI	T1,.FBBYV+<(CF%NUD)> ;SET TO CHANGE BYTE SIZE
	MOVX	T2,FB%BSZ+FB%MOD ;SET FILE BYTE SIZE AND DATA MODE
	LOAD	T3,BSIZ(D)	;GET FILE BYTE SIZE
	LSH	T3,30		;PUT IN POSITION, CLEAR DATA MODE
	CHFDB%			;CHANGE FDB

	MOVE	T3,EOFN(D)	;GET FILE SIZE, BYTES
	LOAD	T1,IJFN(D)	;GET FILE JFN
	HRLI	T1,.FBSIZ+<(CF%NUD)> ;SET FILE SIZE
	SETO	T2,		;WHOLE WORD
	CHFDB%			;CHANGE FDB

	MOVE	T2,EOFN(D)	;NO. GET FILE SIZE AGAIN
	LOAD	T3,BPW(D)	;GET BYTES/WORD
	IDIVI	T2,(T3)		;GET # WORDS IN FILE
	LSH	T2,-9		;GET # PAGES IN FILE
	CAML	T2,TPAGE(D)	;LESS THAN TOP PAGE ACCESSED?
	 POPJ	P,		;NO. WE'RE OK

	LOAD	T1,IJFN(D)	;GET JFN
	HRRI	T1,(T2)		;GET PAGE # OF EOFN
UNMPLP:	FFUFP%			;GET NEXT USED PAGE
	 JRST	%POPJ		;DONE. NO MORE USED PAGES
	PUSH	P,T1		;SAVE FOR NEXT CALL
	LOAD	T2,IJFN(D)	;GET JFN
	HRLI	T2,(T2)		;SETUP PMAP CALL
	HRRI	T2,(T1)		;PAGE # IN RH
	SETZ	T3,		;NO REPEAT COUNT
	SETO	T1,		;SETUP FOR UNMAP FUNCTION
	PMAP%
	POP	P,T1		;GET JFN,,PAGE BACK
	JRST	UNMPLP		;BACK FOR MORE

> ;IF20
IF10,<

CLSAVE:	HRRZ	T1,FBLK(D)	;IF FILE WAS NEVER OPENED
	JUMPE	T1,%POPJ1	;RETURN NOW
	MOVE	T1,USCNT(D)	;Get use count
	CAIE	T1,1		; Only CLOSE file if open on just 1 unit
	 JRST	%POPJ1
	SKIPGE	DSPV		;Skip if not DELETE after close
	 JRST	CLEXP		;DELETE needed, go expunge file

	MOVEI	T2,.FOCLS	;Close first
	HLL	T2,CHAN(D)	; to get the data out
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 PUSHJ	P,CLSERR	;Get error message on write-locked tape

	MOVEI	T2,.FOREL	;Now release the channel
	HLL	T2,CHAN(D)
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	  JRST	CLSERR
	JRST	%POPJ1

%CLSER:
CLSERR:	TXNE	T1,IO.ERR	;JUST EOF?
;	  IOERR	(CLS,,,%,$I,<T1>) ;NO, TYPE MESSAGE
	  $ECALL CLS
	POPJ	P,		;DONE
;"EXPUNGE" and "DELETE" are the same on TOPS-10

CLEXP:
CLDEL:	HRRZ	T1,FBLK(D)	;RETURN NOW IF FILE NOT REALLY OPEN
	JUMPE	T1,%POPJ1

	MOVEI	T2,.FOCLS	;Close it
	HLL	T2,CHAN(D)
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 PUSHJ	P,CLSERR	;Get error message

	SETZM	FBLK+.FOBRH(D)	;CLEAR THE BLOCK HEADERS
	SETZM	FBLK+.FONBF(D)	;AND # BUFFERS
	MOVEI	T1,.FODLT	;DELETE FILE
	HRRM	T1,FBLK(D)
	MOVEI	T1,FBLK(D)
	HRLI	T1,FLEN
	FILOP.	T1,
;	  IOERR	(DEL,,,%,$E,<T1>,REQDIA)
	  $ECALL DEL,REQDIA

	MOVEI	T2,.FOREL	;Now release the channel
	HLL	T2,CHAN(D)
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 JRST	CLSERR		;?Shouldn't ever happen

	JRST	%POPJ1		;Ok, return
;TOPS-10 routine to RENAME prior to CLOSE.
;D/ U/ old DDB block.
;RENAMD/ RENAMU/ new DDB block

CLREN:	PUSHJ	P,RNFCHK	;Check for invalid RENAMEs
	 POPJ	P,		; Invalid, return to DIALOG mode.

;Don't care if files are on same device type even if they are not
; disk or MTA-- TOPS-10 monitor doesn't give an error unless the
; devices are different.

	MOVE	T1,RENAMD	;Point to new DDB
	MOVEI	T1,LKPB(T1)	;POINT TO LOOKUP BLOCK IN NEW DDB
	HRLM	T1,FBLK+.FOLEB(D) ;STORE IN OLD DDB
	MOVEI	T2,LLEN		;SET LENGTH OF RENAME BLOCK
	MOVEM	T2,.RBCNT(T1)
	MOVEI	T1,.FORNM	;SET TO RENAME FILE
	HRRM	T1,FBLK(D)
	SETZM	FBLK+.FOBRH(D)	;CLEAR THE BLOCK HEADERS
	SETZM	FBLK+.FONBF(D)	;AND # BUFFERS
	MOVEI	T1,FBLK(D)	;DO THE RENAME
	HRLI	T1,FLEN
	FILOP.	T1,		;** Do RENAME, closes file **
	 JRST	CLRENF		;?failed, give error
	MOVE	T1,RENAMD	;T1 points to new DDB.
	HRLI	T2,LKPB(T1)	;Copy RENAME block
	HRRI	T2,LKPB(D)	; To LOOKUP block (so subsequent LOOKUP's
	BLT	T2,LKPB+LLEN-1(D) ;Finds the file!
	HRLI	T2,PTHB(T1)	;Copy PATH. block From new DDB
	HRRI	T2,PTHB(D)	;To old DDB
	BLT	T2,PTHB+^D9-1(D) ; . .
	PUSHJ	P,SETPPB	;Reset path block
	HRRZS	FBLK+.FOLEB(D)	;CLEAR RENAME BLOCK POINTER
	PJRST	RNME1		; Throw away RENAMD and RENAMU; return .+2

;	  IOERR	(RNM,,,?,$E,<T1>) ;FAILED
CLRENF:	MOVX	T2,D%NCLS	;Turn off CLOSE error flag
	ANDCAM	T2,FLAGS(D)
	$ECALL	RNM		;?failed, give error
	EXCH	D,RENAMD	;Point to this DDB to type RENAME filespec
	$ECALL	RFN		;Type renamed file's name
	EXCH	D,RENAMD	;Get original D back
	JRST	REQDIA		;Go request DIALOG
;STILL IF10

;TOPS-10 routine to prepare for CLOSE of disk file.
;If file is random, it writes out altered pages and throws away
; the core used by WTAB.

DSKCLS:	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNN	T1,D%RAN	;Is this a RANDOM file?
	  POPJ	P,		;NO, NOTHING SPECIAL
	PUSHJ	P,%RANWR	;WRITE ALTERED PAGES
	HRRZ	T1,WTAB(D)	;GET TABLE POINTER
	JUMPE	T1,%POPJ	;IF ANY
	HLRZ	T1,(T1)		;GET CORE POINTER FROM FIRST ENTRY
	TRNE	T1,3		;MUST BE MULT OF 4
	  $SNH	
	TRZ	T1,400000
	LOAD	T2,BUFCT(D)	;GET LENGTH
	ADDI	T2,3		;ROUNDED UP
	LSHC	T1,-2
	PUSHJ	P,%FREPGS
	HRRZ	T1,WTAB(D)	;POINT TO TABLE
	PUSHJ	P,%FREBLK	;FREE IT
	SETZM	WTAB(D)		;Note we threw it away
	POPJ	P,
> ;IF10
;Routine to check for invalid RENAMEs.
; Returns .+1 and F%DRE set if invalid.
; if ok returns .+2
;Returns T1= device type

RNFCHK:	LOAD	T1,DVTYP(D)	;Get device type of 1st file
	MOVE	T2,RENAMD	;T2 points to new DDB
	LOAD	T3,DVTYP(T2)	;Get it's device type
	CAMN	T1,T3		;Same?
	 JRST	%POPJ1		;Yes, say it's ok.
IF20,<
	CAIN	T1,.DVDSK	;DISK ok
	 JRST	RNFCH1		;Yes
>
IF10,<
	CAIE	T1,.TYDSK	;DISK Ok
	CAIN	T1,.TYDTA	;DTA ok
	 JRST	RNFCH1
>
	$ECALL	FD1		;?File not on disk- can't RENAME
FNDERR:	EXCH	D,RENAMD
	$ECALL	RFN		;[RENAMING to file]
	EXCH	D,RENAMD	;Put D back
	JRST	REQDIA		;Go request dialog

RNFCH1:
IF20,<
	CAIN	T3,.DVDSK	;Only DISK allowed
	 JRST	RNFCH2		;Ok
>
IF10,<
	CAIE	T3,.TYDSK	;DISK OK
	CAIN	T3,.TYDTA	; DECTAPE OK
	 JRST	RNFCH2
>
	$ECALL	FD2,FNDERR	;?File 2 not on disk or dectape

RNFCH2:	JRST	%POPJ1		;Return .+2, rename OK
	SUBTTL	QUASAR INTERFACE

;ROUTINE TO SEND A QUEUE REQUEST OFF TO QUASAR
;ARGS:	 JFN, QUEUE NUMBER
;RETURN: PACKET SENT

CLSQ:	PUSHJ	P,%SAVE3	;SAVE P ACS
	HRRZ	P3,DSPV		;Get disposition

IF10,<

	PUSHJ	P,CLSAVE	;CLOSE FILE, SAVE IT
	 POPJ	P,		;?error, single return

;See if GALAXY V2 is running.

	MOVX	T1,%SIOPR	;Look for ORION's PID
	GETTAB	T1,		; (only present if GALAXY R4)
	 JRST	OLDGLX		;Gettab failed, assume R2
	JUMPE	T1,OLDGLX	;If 0 returned, R2.

;GALAXY V4 - try to do a QUEUE. UUO.

	MOVEI	P2,QBLK-1	;POINT TO QUEUE. ARG BLOCK
	PUSH	P2,QFNC(P3)	;PUSH FUNCTION CODE
	MOVSI	T1,(QF.RSP)	;REQUEST RESPONSE
	IORM	T1,(P2)
	PUSH	P2,[0]		;NODE ID
	PUSH	P2,[LRESP,,%RESP] ;RESPONSE BLOCK LENGTH,,ADDRESS

	MOVEI	T1,FD-1		;FILL IN FILE DESCRIPTOR
	PUSH	T1,PTHB(D)	;STRUCTURE NAME
	PUSH	T1,FILE(D)	;FILE NAME
	PUSH	T1,EXT(D)	;EXTENSION
	HLLZS	(T1)
	PUSH	T1,PTHB+.PTPPN(D) ;PPN
	MOVEI	T2,PTHB+.PTPPN+1(D)
Q1SFD:	SKIPN	(T2)		;SFDS, IF ANY
	  JRST	Q1SFDE
	PUSH	T1,(T2)
	AOJA	T2,Q1SFD

Q1SFDE:	SUBI	T1,FD-1		;GET FD LENGTH
	PUSH	P2,[.QBFIL]	;ARG IS AN FD
	HRLM	T1,(P2)		;SET LENGTH
	PUSH	P2,[FD]		;AND ADDRESS

	CAIE	P3,DS.LIST	;/DISP:LIST?
	  JRST	Q1NLST		;NO
	PUSH	P2,[QA.IMM+.QBODP] ;ARG IS DISPOSITION
	PUSH	P2,[1]		;DISP IS DELETE
Q1NLST:
	SUBI	P2,QBLK-1	;GET LENGTH OF QUEUE. ARG BLOCK
	MOVEI	T1,QBLK		;GET LENGTH,,ADDRESS
	HRLI	T1,(P2)
	QUEUE.	T1,		;DO IT
	  JRST	Q1CANT		;FAILED, GO SEE WHY

	MOVE	T1,%RESP	;GET FIRST WORD OF RESPONSE
	TLNE	T1,774000	;SEE IF ANY TEXT IS PRESENT
;	  IOERR	(QUE,,,[,$A,<[%RESP]>) ;YES, TYPE IT
	  $ECALL QUE

	JRST	%POPJ1		;Done

Q1CANT:	TLNN	T1,-1		;IS UUO IMPLEMENTED?
;	  IOERR	(CQF,,,%,<Can't queue file, QUEUE. error $D>,<T1>,%POPJ)
	  $ECALL CQF,%POPJ1
			;NO UUO, SEND QUASAR A (GALAXY VERSION 2) PACKET



	SEGMENT	DATA

QBLK:	BLOCK	11		;QUEUE. BLOCK, LENGTH 3 + 2 MAX-POSSIBLE-ARGS
LRESP==20			;LENGTH OF RESPONSE BLOCK
%RESP::	BLOCK	LRESP		;RESPONSE BLOCK
FD:	BLOCK	10		;FILE DESCRIPTOR

	SEGMENT	CODE
> ;IF10
;Here for TOPS20 or pre-version 4 GALAXY on TOPS-10.
;Use IPCF sends.

OLDGLX:	MOVEI	T1,1		;GET A PAGE TO SEND TO QUASAR
	PUSHJ	P,%GTPGS##
	  POPJ	P,		;CAN'T

	MOVEI	P1,(T1)		;COPY PAGE NUMBER
	LSH	P1,9		;MAKE INTO ADDRESS

;Clear out the page (%GTPGS doesn't do it automatically).

	SETZM	(P1)		;Clear out the page
	HRLZ	T1,P1		;Starting addr,,
	HRRI	T1,1(P1)	;  .+1
	BLT	T1,777(P1)	;** Clear one page **

	XMOVEI	P2,-1(P1)	;COPY ADDRESS

;MAKE PACKET

IF20,<				;GALAXY RELEASE 4 PACKET FORMAT

;Notice the PUSH's. This code should eventually be modified to use
; the symbolic names, because users who have modified QSRMAC may
; have to totally rearrange this code.
;To see how to do it "right", look at the GALAXY v2 code for TOPS-10
;on the next page.  (There was no time to do the same thing here..)

	PUSH	P2,[.QOCQE]	;CREATE QUEUE ENTRY
	PUSH	P2,[MF.ACK]	;REQUEST ACK
	PUSH	P2,[0]		;SET UNIQUE ID TO 0 SINCE WE SEND
				;ONE MESSAGE AT A TIME

	PUSH	P2,[0]		;FLAGS, 0
	PUSH	P2,[0]		;COUNT IS 0 FOR NOW

	AOS	.OARGC(P1)	;COUNT ARG
	PUSH	P2,[2,,.QCQUE]	;ARG IS QUEUE TYPE
	PUSH	P2,QOT(P3)	;QUEUE TYPE DEPENDS ON DISPOSITION

	AOS	.OARGC(P1)	;COUNT ARG
	PUSH	P2,[.QCFIL]	;ARG IS FILE DESCRIPTOR (FD)
	HRROI	T1,.FDFIL(P2)	;POINT TO FILE SPEC DESTINATION
	LOAD	T2,IJFN(D)	;GET JFN
	MOVX	T3,11111B14+JS%PAF
	JFNS%			;MAKE FULL FILESPEC STRING
	  JSHALT		;SHOULD NEVER FAIL
	SETZ	T2,		;FOLLOW WITH A NULL
	IDPB	T2,T1

	SUBI	T1,-1(P2)	;GET LENGTH OF FD
	HRLM	T1,.FDLEN(P2)	;STORE IN LENGTH WORD
	ADDI	P2,-1(T1)	;BUMP POINTER PAST FD

	CAIE	P3,DS.LIST	;/DISP:LIST?
	  JRST	QNLST		;NO
	AOS	.OARGC(P1)	;COUNT ARG
	PUSH	P2,[2,,.QCODP]	;ARG IS DISPOSITION
	PUSH	P2,[1]		;DISP IS DELETE

QNLST:
;	AOS	.OARGC(P1)	;COUNT ARG
;	SET /LIMIT TO SOMETHING REASONABLE ... QUASAR DEFAULTS INADEQUATE

	SUBI	P2,-1(P1)	;GET LENGTH OF MESSAGE
	HRLM	P2,(P1)		;STORE IN HEADER
> ;IF20
IF10,<				;GALAXY RELEASE 2 PACKET

;P1 points to the message block, initially all zero.
;Users who have their own modified version of QSRMAC should
;reassemble FOROPN using their QSRMAC. If they have added fields
;that should be filled in (instead of left 0), they must add code
;here.

;Store message header

	MOVX	T1,MS.ACK	;Request an acknowledgement
	MOVEM	T1,.MSTYP(P1)
	MOVEI	T1,.QOCRE	;Create message
	DPB	T1,[POINTR .MSTYP(P1),MS.TYP]
				;Length is filled in later
;Store CREATE header

	MOVE	T1,['FOROTS']	;Internal task name
	MOVEM	T1,.EQITN(P1)
	MOVEI	T1,%%.QSR	;QUASAR version number
	DPB	T1,[POINTR .EQLEN(P1),EQ.VRS]
	MOVEI	T1,EQHSIZ	;Length of the header (including MSHSIZ)
	DPB	T1,[POINTR .EQLEN(P1),EQ.LOH]
	MOVE	T1,QDEV(P3)	;Requested processing device
	MOVEM	T1,.EQRDV(P1)
	MOVE	T1,FILE(D)	;Job name (SIXBIT) - use file name
	MOVEM	T1,.EQJOB(P1)
	MOVEI	T1,^D10		;Priority
	DPB	T1,[POINTR .EQSEQ(P1),EQ.PRI]
	HRROI	T1,.GTLOC	;Get location
	GETTAB	T1,
	 SETZ	T1,
	DPB	T1,[POINTR .EQSEQ(P1),EQ.DSN]
	MOVEI	T1,055		;Protection
	DPB	T1,[POINTR .EQSPC(P1),EQ.PRO]
	MOVEI	T1,1		;File count
	DPB	T1,[POINTR .EQSPC(P1),EQ.NUM]
	MOVEI	T1,EQ.UNO	;/UNIQUE:NO
	DPB	T1,[POINTR .EQLM1(P1),EQ.UNI]

	CAIN	P3,DS.SUB	;DISPOSE='SUBMIT'?
	 JRST	NOLIM2		;Yes, don't set a LIMIT in that case.

;Compute number of blocks written from EOFN and BPW.

	MOVE	T2,EOFN(D)	;Get # bytes written
	LOAD	T1,BPW(D)
	IDIV	T2,T1		;Get # words written
	SKIPE	T3		; round up
	 ADDI	T2,1
	IDIVI	T2,^D128	;# blocks written
	SKIPE	T3		; Round up
	 ADDI	T2,1
	DPB	T2,[POINTR .EQLM2(P1),EQ.NBL] ;Output number of blocks

NOLIM2:	HRROI	T1,.GTNM1	;USER NAME
	GETTAB	T1,
	  SETZ	T1,
	HRROI	T2,.GTNM2
	GETTAB	T2,
	  SETZ	T2,
	DMOVEM	T1,.EQUSR(P1)	;Store user name

	MOVE	T1,G.PPN	;Get my PPN
	MOVEM	T1,.EQOWN(P1)	; Store that in owner ID word

;Store filespec info.

	MOVEI	T4,EQHSIZ(P1)	;T4: = ptr to file info
	MOVEI	T1,FPMSIZ	;Size of FP area
	DPB	T1,[POINTR .FPSIZ(T4),FP.FHD]
				;FD size is stored later.
	MOVEI	T1,.FPFAS	;/FILE:ASCII
	DPB	T1,[POINTR .FPINF(T4),FP.FFF] ;File format
	MOVEI	T1,%FPLAS	;/PRINT:ASCII
	DPB	T1,[POINTR .FPINF(T4),FP.FPF] ;Paper format
	MOVEI	T1,1		;/COPIES:1
	DPB	T1,[POINTR .FPINF(T4),FP.FCY]
	MOVEI	T1,1		;/SPACING:1
	DPB	T1,[POINTR .FPINF(T4),FP.FSP]
	MOVX	T1,FP.DEL
	SKIPL	DSPV		;Delete after dispose?
	CAIN	P3,DS.LIST	;or /DISP:LIST?
	  IORM	T1,.FPINF(T4)	;Yes, set /DELETE bit

	MOVEI	T1,1		;Starting point information
	MOVEM	T1,.FPFST(T4)

	MOVEI	T3,FPMSIZ(T4)	;T3 points to start of filespec block
	MOVEI	T0,.FDPPN+1	;T0 counts how many words in this
	MOVE	T1,PTHB(D)	;STR
	MOVEM	T1,.FDSTR(T3)
	MOVE	T1,FILE(D)	;FILENAME
	MOVEM	T1,.FDNAM(T3)
	HLLZ	T1,EXT(D)	;EXT
	HLLZM	T1,.FDEXT(T3)
	MOVE	T1,PTHB+.PTPPN(D) ;PPN
	MOVEM	T1,.FDPPN(T3)

	MOVEI	T2,PTHB+.PTPPN+1(D)
	MOVEI	T3,.FDPAT(T3)	;Point to place to store SFD words
QSFD:	SKIPN	T1,(T2)		;SFDS, IF ANY
	  JRST	QSFDE
	ADDI	T0,1		;Count words
	MOVEM	T1,(T3)		;Store that SFD
	ADDI	T3,1		;Bump ptr incase more SFD's.
	AOJA	T2,QSFD
QSFDE:	DPB	T0,[POINTR .FPSIZ(T4),FP.FFS] ;Store size of the FD block
	ADDI	T0,FPMSIZ	;Get total size of FP+FD
	ADDI	T0,EQHSIZ	;Get total size of packet
	DPB	T0,[POINTR .MSTYP(P1),MS.CNT] ;Store length of the message

> ;IF10
IF20,<	PUSHJ	P,CLSAVE	;CLOSE FILE (DEFERRED UNTIL NOW BECAUSE OF JFNS%)
	 POPJ	P, >		;?Error, single return

	PUSHJ	P,QSND		;SEND PACKET TO QUASAR
	 JRST	%POPJ1		;Failed, but just return "successfully"
	PUSHJ	P,QACK		;WAIT FOR ACK AND TYPE RESPONSE

	MOVEI	T1,(P1)		;GET ADDRESS OF PAGE WE ALLOCATED
	LSH	T1,-9		;MAKE PAGE NUMBER
	MOVEI	T2,1		;SET LENGTH, 1 PAGE
	PUSHJ	P,%FREPGS	;Free page
	JRST	%POPJ1		; and return

IF20,<

QOT=.-DS.QUEUE			;QUEUE OBJECT TYPE, INDEXED BY DISP
	EXP	.OTLPT		;PRINT
	EXP	.OTPTP		;PUNCH
	EXP	.OTLPT		;LIST
	EXP	.OTBAT		;SUBMIT

> ;IF20


IF10,<

QFNC=.-DS.QUEUE			;QUEUE. FUNCTIONS FOR GALAXY 4+
	EXP	.QUPRT		;PRINT
	EXP	.QUPTP		;PUNCH
	EXP	.QUPRT		;LIST
	EXP	.QUBAT		;SUBMIT


QDEV=.-DS.QUEUE			;QUEUE NAMES FOR GALAXY 2
	SIXBIT	/LPT/		;PRINT
	SIXBIT	/PTP/		;PUNCH
	SIXBIT	/LPT/		;LIST
	SIXBIT	/INP/		;SUBMIT

> ;IF10
IF20,<

;ROUTINE TO SEND PAGE TO QUASAR
;ARGS:	 P1 = ADDRESS (ON PAGE BOUNDARY) OF MESSAGE
;SKIP RETURN IF SUCCESSFUL
;WHETHER SUCCESSFUL OR NOT, MESSAGE IS GONE ON RETURN

QSND:	SKIPE	T1,QSRPID	;GET QUASAR'S PID, IF WE KNOW IT ALREADY
	  JRST	GOTQSR		;GOT IT, SKIP

	MOVEI	T1,3		;SET LENGTH, ADDRESS OF BLOCK
	MOVEI	T2,IPCBLK
	MOVEI	T3,.MURSP	;READ SYSTEM PID
	MOVEM	T3,(T2)
	MOVEI	T3,.SPQSR	;OF <SYSTEM>QUASAR
	MOVEM	T3,1(T2)
	MUTIL%
	  JSHALT

	MOVE	T1,IPCBLK+2	;GET PID
	MOVEM	T1,QSRPID
GOTQSR:	MOVEM	T1,IPCBLK+.IPCFR ;SET RECIEVER PID

	MOVE	T1,I.PID	;GET MY PID
	MOVEM	T1,IPCBLK+.IPCFS ;SET SENDER PID

	MOVEI	T1,(P1)
	LSH	T1,-9
	HRLI	T1,1000		;SET LENGTH,,ADDRESS OF PACKET
	MOVEM	T1,IPCBLK+.IPCFP

QTRY:	MOVX	T1,IP%CFV	;PAGE MODE
	SKIPN	IPCBLK+.IPCFS	;IF WE DON'T HAVE A PID,
	  TXO	T1,IP%CPD	; CREATE ONE
	MOVEM	T1,IPCBLK+.IPCFL

	MOVEI	T1,4		;SEND PAGE TO QUASAR
	MOVEI	T2,IPCBLK
	MSEND%
	  ERJMP	QSNDF		;FAILED, SEE WHY

	SKIPE	T1,IPCBLK+.IPCFS ;GET RETURNED PID
	  MOVEM	T1,I.PID	;SAVE IT
	JRST	%POPJ1

QSNDF:	CAIL	T1,IPCFX6	;CHECK ERROR CODE
	CAILE	T1,IPCFX8
	  JRST	E..IJE

	SKIPE	T1,IPCBLK+.IPCFS ;GET RETURNED PID
	  MOVEM	T1,I.PID	;SAVE IT

	MOVEI	T1,^D3000	;WAIT 3 SECONDS
	DISMS%
	JRST	QTRY		;TRY AGAIN
;ROUTINE TO WAIT FOR ACK FROM QUASAR AND TYPE RESPONSE
;IF QUASAR SENDS BACK AN ERROR, BUILD A FOROTS ERROR MESSAGE
;AND ENTER DIALOG MODE (??)

QACK:	XMOVEI	T1,IPCBLK-1
	PUSH	T1,[0]		;CLEAR FLAGS
	PUSH	T1,[0]		;CLEAR SENDER
	PUSH	T1,I.PID	;RECIEVE MESSAGE TO ME ONLY
	MOVEI	T2,(P1)		;POINT TO PAGE WE USED FOR SENDING
	HRLI	T2,1000		;LENGTH IS 1000
	PUSH	T1,T2

RCVAGN:	MOVEI	T1,4		;GET RESPONSE FROM QUASAR
	MOVEI	T2,IPCBLK
	MRECV%
	  JSHALT

	MOVE	T1,IPCBLK+.IPCFS ;GET SENDER
	CAME	T1,QSRPID	;QUASAR?
	  JRST	RCVAGN		;NO, DISCARD JUNK

	HRRZ	P1,IPCBLK+.IPCFP ;POINT TO MESSAGE
	MOVE	P2,.MSFLG(P1)	;GET MESSAGE FLAGS
	TXNE	P2,MF.NOM	;ACK TEXT PRESENT?
	  JRST	NOMSG		;NO, DON'T TYPE ANYTHING

	XMOVEI	T1,.OHDRS+ARG.DA-4(P1) ;MAKE ARG BLOCK FOR FORERR
				;ON TOP OF MESSAGE HEADER
	PUSH	T1,[PUSHJ P,%IOERR] ;START WITH CALL TO IOERR
	MOVX	T2,"["B6	;ASSUME INFO MESSAGE
	TXNE	P2,MF.FAT+MF.WRN ;ERROR?
	  MOVX	T2,"%"B6	;YES, CHANGE PREFIX CHAR
	PUSH	T1,T2		;SET PREFIX CHAR
	MOVSI	T2,(P2)		;GET SIXBIT ERROR PREFIX
	CAIN	T2,0		;IF SET
	  MOVSI	T2,'QUE'	;IF NOT, USE FRSQUE
	PUSH	T1,T2		;SAVE THAT
				;ASCII ERROR MESSAGE FOLLOWS IN PACKET
	PUSHJ	P,.OHDRS+ARG.DA-3(P1) ;CALL FORERR

NOMSG:	TXNE	P2,MF.MOR	;MORE COMING?
	  JRST	RCVAGN		;YES, GO GET IT
	POPJ	P,		;NO, RETURN
> ;IF20
IF10,<

;ROUTINE TO SEND PAGE TO QUASAR
;ARGS:	 P1 = ADDRESS (ON PAGE BOUNDARY) OF MESSAGE
;SKIP RETURN IF SUCCESSFUL
;WHETHER SUCCESSFUL OR NOT, MESSAGE IS GONE ON RETURN

QSND:	SKIPE	T1,QSRPID	;GET QUASAR'S PID, IF KNOWN
	  JRST	GOTQSR		;KNOWN, SKIP

	MOVE	T1,[%SIQSR]	;GETTAB QSRPID
	GETTAB	T1,
	  $SNH	
	MOVEM	T1,QSRPID

GOTQSR:	MOVEM	T1,IPCBLK+.IPCFR ;SET RECIEVER PID
	SETZM	IPCBLK+.IPCFS	;NO SENDER PID

	MOVEI	T1,(P1)		;SET SEND ADDRESS
	LSH	T1,-9		;MAKE PAGE NUMBER
	HRLI	T1,1000		;SET LENGTH,,ADDRESS OF PACKET
	MOVEM	T1,IPCBLK+.IPCFP

	MOVX	T1,IP.CFV	;FLAGS: PAGE MODE
	MOVEM	T1,IPCBLK+.IPCFL

QTRY:	MOVE	T1,[4,,IPCBLK]	;SEND PAGE TO QUASAR
	IPCFS.	T1,
	  JRST	QSNDF		;FAILED, SEE WHY
	JRST	%POPJ1		;PAGE SUCCESSFULLY SENT

QSNDF:	CAIL	T1,IPCDD%	;RECOVERABLE?
	CAILE	T1,IPCRY%
	  $SNH			;NO, QUIT

	MOVEI	T1,3		;WAIT 3 SECONDS
	SLEEP	T1,
	JRST	QTRY		;TRY AGAIN
;ROUTINE TO WAIT FOR ACK FROM QUASAR AND TYPE RESPONSE
;IF QUASAR SENDS BACK AN ERROR, BUILD A FOROTS ERROR MESSAGE

QACK:	MOVE	T1,[4,,IPCBLK]	;INSPECT RECIEVE QUEUE
	IPCFQ.	T1,
	  JRST	QSLP		;NOTHING THERE, GO WAIT
	SKIPN	IPCBLK+.IPCFP	;[Q10-5204]
	 JRST	QSLP		;[Q10-5204]
	MOVE	T1,IPCBLK+.IPCFS ;GET SENDER PID
	CAMN	T1,QSRPID	;FROM QUASAR?
	  JRST	RCV		;YES, GO READ MESSAGE

	MOVE	T1,IPCBLK+.IPCFL ;GET FLAGS
	ANDI	T1,IP.CFV	;CLEAR ALL BUT PAGE-MODE
	TXO	T1,IP.CFT	;TRUNCATE IF TOO LONG
	MOVEM	T1,IPCBLK+.IPCFL
	SETZM	IPCBLK+.IPCFP	;CLEAR LENGTH,,ADDRESS
	MOVE	T1,[4,,IPCBLK]
	IPCFR.	T1,		;RECIEVE MESSAGE AND IGNORE IT
	  $SNH	

	JRST	QACK		;KEEP TRYING

QSLP:	MOVE	T1,[HB.IPC+^D3000] ;WAIT FOR IPCF ACTIVITY
	HIBER	T1,
	  JFCL
	JRST	QACK		;GO SEE WHAT THE ACTIVITY WAS
RCV:	MOVX	T1,IP.CFV	;PAGE MODE
	ANDB	T1,IPCBLK+.IPCFL ;GET JUST THAT BIT FROM IPCFQ. INFO
	MOVEI	T3,(P1)		;GET DEST ADDRESS
	LSH	T3,-9		;CONVERT TO PAGE NUMBER
	JUMPN	T1,RCVX		;IF PAGE-MODE MESSAGE, GO RECIEVE IT
	MOVE	T1,[.PAGCD,,T2]	;WORD-MODE, MUST CREATE PAGE FIRST
	MOVEI	T2,1		;1 PAGE, PAGE NUMBER IN T3
	PAGE.	T1,		;DO IT
	  JFCL			;PAGE IS ALREADY THERE
	MOVEI	T3,(P1)		;GET DEST ADDRESS
RCVX:	HRLI	T3,1000		;SET LENGTH,,ADDRESS
	MOVEM	T3,IPCBLK+.IPCFP

	MOVE	T1,[4,,IPCBLK]
	IPCFR.	T1,		;GET MESSAGE
	  $SNH			;SHOULDN'T FAIL

	MOVE	T1,IPCBLK+.IPCFS ;GET SENDER
	CAME	T1,QSRPID	;QUASAR?
	  JRST	RCV		;NO, DISCARD JUNK

	MOVE	P2,TEX.ST(P1)	;GET STATUS WORD
	TXNE	P2,TX.NMS	;ACK TEXT PRESENT?
	  JRST	NOMSG		;NO, DON'T TYPE ANYTHING

	TXNN	P2,TX.FAT!TX.WRN ;ERROR?
	  OUTCHR ["["]		;NO, INFO
	TXNE	P2,TX.FAT!TX.WRN ;ERROR?
	  OUTCHR ["%"]		;YES
	OUTSTR	TEX.MS(P1)	;TYPE MESSAGE
	TXNN	P2,TX.FAT!TX.WRN ;INFO?
	  OUTCHR ["]"]		;YES, TYPE CLOSING BRACKET
	OUTSTR	%CRLF##		;TYPE CRLF

NOMSG:	TXNE	P2,TX.MOR	;MORE COMING?
	  JRST	QACK		;YES, GO GET IT

	POPJ	P,		;NO, RETURN

> ;IF10

	SEGMENT	DATA

QSRPID:	BLOCK	1		;QUASAR PID
IPCBLK:	BLOCK	4		;CONTROL BLOCK FOR IPCF FUNCTIONS

	SEGMENT	CODE
;ROUTINE TO CLOSE ALL FILES

EXIT1%:	PUSHJ	P,%SAVE

%EXIT1:	XMOVEI	T1,[ASCIZ /CLOSE/] ;FOR ERROR MESSAGES, WE'RE A CLOSE STMT
	MOVEM	T1,%IONAM

	PUSHJ	P,%SAVE1

	MOVE	P1,[MINUNIT-MAXUNIT-1,,MINUNIT]	;LOOP THROUGH ALL UNITS
EX1L:	MOVE	U,%DDBTAB(P1)	;GET A Unit block ADDRESS
	JUMPE	U,EX1N		;NONE, SKIP
	MOVE	D,DDBAD(U)	;Get DDB address
	PUSHJ	P,%CLOSE	;Close the DDB
EX1N:	AOBJN	P1,EX1L		;DO THEM ALL

IF20,<
	SKIPE	DBSTP.		;Skip if no DBMS loaded with FORLIB.
	PUSHJ	P,@DBSTP.	;If DBMS around, leave databases in
>				; a CLOSEd state.
	POPJ	P,		;DONE
	SUBTTL	RANDOM ROUTINES

IF10,<

;ALLOCATE I/O CHANNEL

;THREE ENTRY POINTS:

;ALCHN%: STANDARD FORTRAN CALLING SEQUENCE, ONE ARG POINTED TO BY L
;	 ARG = 0 TO FIND A FREE CHANNEL, 1-17 TO ALLOCATE THAT SPECIFIC CHANNEL
;RETURN: T0 = CHANNEL NUMBER ALLOCATED, OR -1 IF NO FREE CHANNELS

;%ALCHN: T1 =  0 TO FIND A FREE CHANNEL, 1-17 TO ALLOCATE THAT SPECIFIC CHANNEL
;RETURN: T1 = CHANNEL NUMBER ALLOCATED.  NONSKIP RETURN IF NO FREE CHANNELS

;ALCHN:  JUST FINDS A FREE CHANNEL
;RETURN: T1 = CHANNEL NUMBER.  NONSKIP RETURN IF NO FREE CHANNELS


	SIXBIT	/ALCHN./
ALCHN%:	PUSHJ	P,%SAVE
	MOVE	T1,@0(L)	;GET USER'S ARG
	TDNE	T1,[-20]	;IF NEGATIVE OR OVER 17, ERROR
	  JRST	ALCHNX
	PUSHJ	P,%ALCHN	;TRY TO ALLOCATE CHANNEL
ALCHNX:	  SETO	T1,		;CAN'T
	MOVEM	T1,U.ACS+T0	;STORE FOR USER
	POPJ	P,		;RETURN


%ALCHN:	JUMPN	T1,ALCHN1	;IF SPECIFIC REQUEST, GO TRY TO ALLOCATE IT

ALCHN:	MOVE	T0,%CHMSK	;GET ALLOCATED CHANNEL MASK
	JFFO	T0,ALCHN1	;FIND FIRST FREE CHANNEL
	  POPJ	P,		;NONE, ERROR RETURN

ALCHN1:	MOVNI	T3,(T1)		;GET SHIFT COUNT FOR CHANNEL
	MOVSI	T2,(1B0)	;GET A 1 BIT
	LSH	T2,(T3)		;SHIFT INTO POSITION
	TDNN	T2,%CHMSK	;CHANNEL FREE?
	  POPJ	P,		;NO, ERROR RETURN
	ANDCAM	T2,%CHMSK	;MARK IT ALLOCATED
	JRST	%POPJ1		;SUCCESS RETURN
;DEALLOCATE CHANNEL

;THREE ENTRY POINTS:

;DECHN%: STANDARD FORTRAN CALLING SEQUENCE, ONE ARG POINTED TO BY L
;	 ARG = CHANNEL NUMBER TO DEALLOCATE
;RETURN: T0 = 0 IF DEALLOCATED OK, -1 IF CHANNEL WASN'T ALLOCATED

;%DECHN: T1 = CHANNEL NUMBER TO DEALLOCATE
;NONSKIP RETURN IF CHANNEL NOT ALLOCATED, SKIP RETURN IF OK

;DECHN:	 T1 = CHANNEL NUMBER TO DEALLOCATE
;INTERNAL ERROR HALT IF CHANNEL NOT ALLOCATED, NONSKIP RETURN IF OK


	SIXBIT	/DECHN./
DECHN%:	PUSHJ	P,%SAVE
	MOVE	T1,@0(L)	;GET ARG
	TDNE	T1,[-20]	;RANGE CHECK
	  JRST	DECHNX		;ILLEGAL CHANNEL, ERROR
	PUSHJ	P,%DECHN	;DEALLOCATE THE CHANNEL
DECHNX:	  SKIPA	T1,[-1]		;CAN'T
	SETZ	T1,		;CAN, DID
	MOVEM	T1,U.ACS+T0	;STORE FOR RETURN TO USER
	POPJ	P,		;RETURN


DECHN:	PUSHJ	P,%DECHN	;DEALLOCATE CHANNEL
	  $SNH			;NOT ALLOCATED, ERROR
	POPJ	P,		;RETURN


%DECHN:	MOVNI	T1,(T1)		;GET SHIFT COUNT
	MOVSI	T2,(1B0)	;GET A 1 BIT
	LSH	T2,(T1)		;SHIFT INTO POSITION
	TDNE	T2,%CHMSK	;CHANNEL ALLOCATED?
	  POPJ	P,		;NO, ERROR
	IORM	T2,%CHMSK	;DEALLOCATE IT
	JRST	%POPJ1		;SUCCESS



	SEGMENT	DATA
%CHMSK:	BLOCK	1		;BIT 1B<N> ON IF CHAN N FREE
	SEGMENT	CODE


>;END IF10
IF20,<

ALCHN%:	SETO	T0,		;NO CHANNELS AVAILABLE ON -20
%ALCHN:	POPJ	P,		;SAY SO AND RETURN

DECHN%:	SETO	T0,		;NO CHANNEL CAN BE ALLOCATED
%DECHN:	POPJ	P,		;ERROR RETURN

>;END IF20
	SUBTTL	INQUIRE

INQ%:;	ERR	(INI,,,?,INQUIRE not implemented,,%ABORT)
	$ECALL	INI,%ABORT	;?INQUIRE not implemented
	SUBTTL	I/O ERROR PREFIX LINE TYPER

	SEGMENT	ERR

$FTSHR==FTSHR		;PUSH PSECT FLAG
FTSHR==0		;MACRO BUG PROBIBITS NESTED PSECTS WITH SAME NAME


ENTRY %IOERR
%IOERR:	PUSHJ	P,%ERRST	;Fix things up to start error
	MOVE	T1,0(P1)	;Get first word of arg block
	TXNE	T1,I%UNI	;No "D" and "U" setup?
	 JRST	IOERR0		; Right, get ERR=, IOSTAT= out of %TERR, etc.
	MOVE	T1,ERRAD(U)	;Get stuff from Unit block
	MOVEM	T1,%TERR
	MOVE	T1,ENDAD(U)
	MOVEM	T1,%TEND
	MOVE	T1,IOSAD(U)
	MOVEM	T1,%TIOS
IOERR0:

IF20,<
	MOVEI	T1,.FHSLF	;GET JSYS ERROR NUMBER FOR LAST ERROR
	GETER%
	  ERJMP	.+1
	HRRZM	T2,G.LJE	;STORE FOR FORERR
> ;IF20

	LDB	T1,[POINT 10,(P1),16] ;GET ERROR NUMBERS
	LDB	T2,[POINT 10,(P1),26]
	CAIN	T2,1777		;N2= -1?
	 SETO	T2,		;yes, error is -1
IF20,<
	JUMPE	T1,ZERN		;Zero error number
	JUMPN	T2,.+2		;IF NO N2 SUPPLIED, USE MONITOR ERROR NUMBER
	  HRRZ	T2,G.LJE
ZERN:
> ;IF20
	HRLI	T2,(T1)		;COMBINE ERROR NUMBERS
	MOVEM	T2,G.IS		;STORE FOR ERRSNS
	HRRZ	T2,T2		;Get N2
	CAIN	T2,-1		;EOF?
	 SETO	T2,		;Yes, get whole word -1
	SKIPE	T1,%TIOS	;Any IOSTAT=?
	 MOVEM	T2,(T1)		;Yes, store it

;Iff this is a "?" error, do the ERR= or END= stuff

	LDB	T1,[POINT 7,(P1),6] ;Get PREFIX char.
	CAIE	T1,"?"		;"?" says take ERR= if we can.
	 JRST	NERR1		;Not fatal, just go type message

;Fatal error. Clear %UDBAD
; This is so all the IOLST. calls that follow an IO call that gets
; a fatal error will not screw up things any more.

	SETZM	%UDBAD		;CLEAR THE UDB PNTR

	SKIPGE	T2		;EOF?
	 SKIPN	T1,%TEND	;Yes, use END= address not ERR=
				;But if no END= specified, use ERR=
	MOVE	T1,%TERR	;Get ERR= Address
	JUMPE	T1,NERR		;IF ANY

;Take END= or ERR= branch.
;Address of where to go is in T1.
;T2 contains the error number

	MOVE	P,U.PDL		;Get old stack
	MOVEM	T1,(P)		;Store return address
	ADJSP	P,1		; Fix so we get our acs back
	PUSHJ	P,%EMSGT	;Get error message text for ERSNS.
	PUSHJ	P,DEALCB	;Deallocate RENAMD, RENAMU if necessary
	PJRST	FXTRET		; Fixup stuff to return and return
				; (to program)

;No END= or ERR= specified

NERR:	SKIPN	%TIOS		;How about IOSTAT=?
	 JRST	NERR1		;No

;Return to next statement in the program.

	PUSHJ	P,%EMSGT	;Get error message text for ERRSNS.
	PUSHJ	P,DEALCB	;Deallocate RENAMD, RENAMU if necessary
	PUSHJ	P,FXTRET	;Fixup stuff to return
	MOVE	P,U.PDL		;Reset stack
	ADJSP	P,1		; Fix so we get our acs back
	POPJ	P,		;Return to next statement in pgm.

;Routine to fixup stuff to return from IO error.

FXTRET:	MOVE	T1,(P1)		;Get flags
	TXNE	T1,I%UNI	;No "U" or "D"?
	 POPJ	P,		;Yes. Don't deallocate
	TXNE	F,F%DCU		;Deallocate "D" and "U"?
	 PUSHJ	P,FXTRTD	;Yes, do that
FXTRT1:	PJRST	%SETAV		;Set associate-variable and return
				; (also clears ERRAD, ENDAD, IOST)

;Deallocate "U" and "D" before returning.

FXTRTD:	MOVEI	T1,(U)		;Get address of "U"
	PUSHJ	P,%FREBLK	;Free it
	MOVEI	T1,(D)		;Get address of "D"
	PJRST	%FREBLK		;Free it and return

;Deallocate RENAMD, RENAMU if necessary
; having this routine here greatly simplifies error handling in CLOSE.

DEALCB:	SKIPN	T1,RENAMD
	 POPJ	P,		;Not necessary
	PUSHJ	P,%FREBLK
	MOVE	T1,RENAMU
	PJRST	%FREBLK		;Deallocate and return

;Print out the error.

NERR1:	MOVE	T1,(P1)		;Get flags
	TXNE	T1,I%UNI	; No "U" or "D"?
	 PJRST	%FOREC		;Right, Skip prefix line

	TXNE	F,F%NION	;First error in this statement?
	  PJRST	%FOREC		;NO, SKIP PREFIX LINE

; From now on, this is just like an ERR call except
;that there is a first line of the message.

	LDB	T0,[POINT 7,(P1),6] ;GET FIRST CHAR OF ERROR MESSAGE
	MOVEM	T0,PFXCHR	;SAVE FOR OUR MESSAGE
	PUSHJ	P,%ERSVV	;Save parameters on stack from previous call

	MOVE	T1,PFXCHR	;GET PREFIX CHAR
	HRRZ	T3,U.PDL	;GET RETURN ADDRESS FOR MESSAGE
	MOVE	T3,(T3)
	SUBI	T3,1
	MOVE	T0,FLAGS(D)	;Get DDB flags
	TXNE	T0,D%ENC	;ENCODE/DECODE?
;	  ERR	(EDE,$,$A error at $1L,<T1,%IONAM,T3>)
	 $ECALL	EDE,IOCONT	;YES, SIMPLE MESSAGE

	HXRE	T1,UNUM(U)	;GET UNIT NUMBER
	MOVE	T2,PFXCHR	;GET PREFIX CHAR
;	ERR	(NAM,$,$A unit $D  $F at $1L,<T2,%IONAM,T1,T3>)
	$ECALL	NAM
IF10,<
	TXZE	F,F%INDST	;DIALOG FROM STRING?
;	  ERR	(DST,$,Error in dialog string,<T2>)
	 $ECALL	DST
;	JRST	IOCONT
>

IOCONT:	TXO	F,F%NION	;Set flag so IONAM doesn't get printed again
	PUSHJ	P,%ERRRS	;Restore everything
	PJRST	%FOREC		;Go type regular message

FTSHR==$FTSHR			;POP PSECT FLAG
	SEGMENT	DATA

IF20,<

CSB:	BLOCK	12		;COMMAND STATE BLOCK

JFNBLK:	BLOCK	.GJATR+1	;GTJFN ARG BLOCK

FDB:	BLOCK	1+.FBSIZ	;FDB, UP THROUGH FILE SIZE

SWTDDB:	BLOCK	2		;FLDDB FOR SWITCHES

ERRBUF:	BLOCK	40		;BUFFER FOR ERROR-MESSAGE JFNS

>;END IF20

SAVEP:	BLOCK	1		;TEMP FOR STACK POINTER
PFXCHR:	BLOCK	1		;FIRST CHAR OF ERROR MESSAGE

	LTEXT==100
TXTBUF:	BLOCK	LTEXT		;TEXT BUFFER

	LATOM==40
ATMBUF: BLOCK	LATOM		;ATOM BUFFER

%IONAM:: BLOCK	1		;ADDRESS OF ASCIZ STATEMENT NAME
G.IS::	BLOCK	1		;ERROR NUMBERS FOR ERRSNS

%OPNK1:: BLOCK	1		;FIRST CONFLICTING SWITCH NUMBER 
%OPNV1:: BLOCK	1		;FIRST CONFLICTING SWITCH VALUE
%OPNK2:: BLOCK	1		;SECOND CONFLICTING SWITCH NUMBER
%OPNV2:: BLOCK	1		;SECOND CONFLICTING SWITCH VALUE

	SEGMENT	CODE
	PURGE	$SEG$
	END