Google
 

Trailing-Edge - PDP-10 Archives - BB-D480G-SB_FORTRAN10_V11.0_short - foropn.mac
There are 27 other files named foropn.mac in the archive. Click here to see a list.
	SEARCH	MTHPRM,FORPRM
	TV	FOROPN	OPEN & CLOSE ,11(5022)

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;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.

***** Begin Version 6A *****

2041	DAW	21-Dec-81
	Correct deficiency in TOPS-20 logical name handling that
	caused unexpected "?File not found" errors for OPEN/READ
	sequence.

2042	TGS	2-Feb-82	20-17208
	Change NREC(D) to NREC(U) at end-of-file routines so record
	counts get correctly updated. 

2043	ERD	9-Feb-82	10-32099
	Change in DPRFN1 to allow leading spaces in file names on
	TOPS-10.

2050	ERD	20-Apr-82	10-32326
	Code addition in %LSTBF so that DUMP mode output on magtape
	will skip over the initial output.

2062	EDS	7-Jun-82
	Files with extension of "DAT" when sent to the printer via
	DISPOSE = 'LIST' or 'PRINT' do not have the first character
	of each line used for carriage control.

2064	EDS	10-Jun-82
	Create files for STATUS='SCRATCH' using the standard naming
	convention for TOPS-10.  File names will now be nnnccc.TMP,
	where nnn is the job number and ccc are random letters.

2112	TGS	29-Sep-82	10-32830
	Set up the path pointer in the RENAME block before executing the
	rename FILOP. so CLOSE/DISPOSE=RENAME can rename a file to a 
	different SFD or directory.

***** Begin Version 7 *****

3012	JLC	4-Nov-81
	Rework FOROTS call arg copier. No more LTYPE.
	Rework of OPNDIR, which modified the arg list.

3015	AHM	7-Nov-81
	DIALOG with zero address comes out as 1,,0 when produced by the XMOVEI
	at OPNDIA and was thus not seen as zero.

3016	JLC	9-Nov-81
	Fix OPNDIA for new arg block - checks if immediate-mode arg
	to decide if it has a string.

3023	JLC	15-Nov-81
	Various V6 patches: non-consolidation of NUL:, correct call
	to %FREPGS in disk close, leading blanks in OPEN parameters,
	quickie patch to turn off D%IO for TTY input after DIALOG.

3035	JLC	5-Feb-82
	Rework of OPEN code that decides default MODE and FORM
	parameters. Set byte size to 7 and BPW to 5 for all files.
	Fix APPEND bug - was not setting BLKN to end of file.

3051	JLC	26-Feb-82
	Set BUFFERCOUNT to 1 for magtapes on the -10, ignoring the
	user's specification, since PULSAR does not return the magtape
	EOF bit in a consistent place (sometimes the active buffer,
	sometimes the EOF buffer), so BACKSPACE, WRITE cannot work
	because the active buffer count, and therefore the number of
	blocks to backspace, is sometimes off by 1.

3056	JLC	23-Mar-82
	Catch illegal OPEN arguments (such as RECORDSIZE=0) and
	illegal options for binary files (such as BLANK=).

3072	JLC	30-Mar-82
	Fix CLOSE of image mode files with character data, was rounding
	incorrectly (wrong AC).

3111	JLC	15-Apr-82
	Fix SDO error message, was getting unit number with LOAD, which
	does not sign-extend.

3114	BL	29-Apr-82
	Make character expressions work in OPEN statements (FOROPN.MAC).

3115	BL	13-May-82
	Continue above(3114). Fix OPNCHR & DIABLT to check ARGTYP and
	get the character descriptor if appropriate.

3116	BL	14-May-82
	Move label DIANST up one line(typo).

3117	BL	14-May-82
	Changed HLRE to HXRE in CNSCHK to get correct unit number
	in SDO error. (Note: Same edit as 3111!)

3122	JLC	28-May-82
	Make FILE= fully qualified string work. Fix some extended
	addressing bugs for character args.

3123	JLC	29-May-82
	Fix bug in SMBA, was not paying attention to FORM=.

3125	JLC	3-Jun-82
	Moved the AC save routine back to the hiseg.

3126	JLC	7-Jun-82
	Installed OPEN on a "connected unit". Fixed some code
	which flowed across SEGMENT macros.

3136	JLC	26-Jun-82
	Support work for I/O performance. Install some TSG patches.

3140	JLC	2-Jul-82
	Put in missing external %EXCHN.

3150	JLC	12-Jul-82
	Day 1 bug - DIALOG in close set up GTJFN flag word with
	junk from T0 (HLLOM instead of HLLOS). Fix bug in -10 OPNDIR,
	did not recognize character string args.

3153	JLC	20-Jul-82
	Fixed problem caused by new EOF-handling code for random files.

3161	JLC	19-Aug-82
	Installed modified TSG patch regarding setting and restoring
	of CCOC words. Fixed TPAGE on the -20 so it won't leave
	a null file with 1 page allocated. Changed NREC(U) to CREC(D).

3165	JLC	28-Aug-82
	Fix random I/O so it can handle files larger than 256K blocks.

3166	JLC	30-Aug-82
	Fix XXXSET so it sets WSIZ to a page rather than 15 bytes.
	Search QSRMC2 instead of QSRMAC on the -10, since QSRMAC is
	now for GALAXY 4.1. Change APPEND so it uses PMAP again.

3174	JLC	4-Sep-82
	Fix FOROPN on the -10 so TPAGE is calculated in pages, not
	blocks.

3175	JLC	8-Sep-82
	Change OPEN on "connected unit" to only do this if the
	OPEN in progress specifies STATUS='OLD'.

3200	JLC	24-Sep-82
	Install 6A patch to supercede on TOPS-10 rather than
	deleting the file in OSWTCH. This avoids failures for
	protection code 2 and accidently creating the file in
	a different SFD than the original file. Fix DSKCLS on
	the -20 to free the page tables, which caused eventual
	memory full if many random files were opened and closed
	repeatedly.

3202	JLC	26-Oct-82
	Install code to provide base support for ANSI tapes for
	TOPS-20, since most of the work is done by the monitor.

3203	JLC	31-Oct-82
	Store a word of spaces (SPCWD) in DDB for each type
	of file.

3212	JLC	11-Nov-82
	Update and consolidate -20 magtape code so that B36FLG(D) controls
	whether formatted or unformatted I/O is done.

3213	JLC	12-Nov-82
	Fix FILOP close in OSWCRE, didn't expect a skip (normal) return.

3214	BL	12-Nov-82
	Merge in EDIT 2124 from V6A...
	This edit supersedes edit 2063.  Ensure that calls to FRSISW errors
	always pass SIXBIT strings for keywords and key values on TOPS10 only.

3215	JLC	15-Nov-82
	Fix magtape bugs, typos.

3216	JLC	16-Nov-82
	Fix bytesize on CLOSE. Also store the data mode, which heretofore
	was discarded.

3221	JLC	21-Nov-82
	Fix %LSTBF call so it doesn't setup the buffer (changed call
	to %OBUF).

3223	JLC	22-Nov-82
	Do not allow modes on OPEN after all, as most of the devices
	don't allow them anyhow. Fix DEVICE=' '.

3225	JLC	24-Nov-82
	Remove extraneous (and deadly) multiplication of # bytes by BPW.

3226	JLC	29-Nov-82
	Fix various little bugs, magtape bugs, etc.

3227	JLC	8-Dec-82
	Fix EOFN problem at OSWTCH.

3230	RJD	8-Dec-82
	Fix CLOSE STATUS and DISPOSE problems.

3231	JLC	14-Dec-82
	Remove warning given for CLOSE on units that are not OPENed.
	Fix EOFN problems regarding null files (REWIND, ENDFILE)
	and files which have data to page bounds (REWIND, WRITE).

3250	JLC	7-Jan-83
	Fix GTJFN in DOOPEN do try GJ%OLD, then no flags if correct
	type of failure. In CLOSE, save UDB of file to be renamed
	in %RNOLD.

3252	JLC	12-Jan-83
	Fix RENAME error msg reporting.

3253	JLC	13-Jan-83
	Fix EXIT1 so it doesn't fall over with I/O within I/O.

3256	JLC	14-Jan-83
	Fix CLOSE so it puts DDB addr in UDB so $F can find it.

***** End V7 Development *****

3265	JLC	10-Feb-83
	Clear the buffer pointers and buffer count so that .JBFF
	is correct.  This corrects the problem of overlayed programs
	failing with a ?Can't create page nnn when several REWIND
	WRITE sequences are executed.

3274	JLC	23-Feb-83
	Allow BLANK= to be specified in the OPEN statement for
	either formatted or unformatted files then use only if
	a formatted WRITE is executed.  Also, store the space
	for PADCHAR for all types of files.

3340	RJD	8-AUG-83	SPR:10-34053
	Calculate the number of blocks to be stored in EST(D) from the
	value provided in words for FILESIZE.

3360	TGS	17-OCT-83	SPR:20-19540
	Since both FORLIB and LIBOL define DBSTP. as a global symbol
	for DBMS calls, producing a LNKMDS error, change it to D.BSTP.

3371	RJD	6-DEC-83	SPR:10-34318
	Allow the CLOSE to accept a zero in the PROTECTION specifier
	in order that files may be protected <000>.

3421	RJD	27-FEB-84	SPR:10-34529
	Clear the PPN including the SFD's before entering the
	information specified in the DIRECTORY= into the path block.

3422	RJD	2-MAR-84	SPR:none
	When RENAMing a file, make sure all the creation date bits
	are saved.

3453	TGS	12-Nov-84	SPR:10-34969
	When calculating the QUEUE limit value for DISPOSE='PRINT',
	don't use SIZ(D) to retrieve filesize in words, since this
	will be accurate only for existing files to which no I/O
	has been performed.  Use EOFN(D) instead.

***** Begin Version 10 *****

4000	JLC	22-Feb-83
	Clear # buffers before doing FOWRT in OSWCRE (-10 autopatch).
	Remove code which checks for extraneous args for unformatted
	OPEN.	Do changes necessary for I/O performance enhancements.

4010	JLC	19-Apr-83
	Fix unlabeled tape bug - the monitor does NOT change the
	internal bytesize for industry tapes to 8 for unlabeled
	tapes, so they must be treated separately. Install some
	more keyword values for INQUIRE. Move around some code
	in %SETOUT for performanace improvements.

4014	JLC	14-Jun-83
	INQUIRE. Minor changes for RMS/tape support.

4016	JLC	22-Jun-83
	Make TTYs consistent with other devices (removed useless
	special code). Add a SEGMENT CODE so literals will be in
	the high segment.

4023	JLC	29-Jun-83
	Fix new magtape feature: if the record format is 'D',
	the recordsize specified by the user must have 4 added
	to it for the maximum recordsize on the label.

4024	JLC	30-Jun-83
	INQUIRE code review changes. Also remove some useless code.

4027	JLC	6-Jul-83
	Fix misunderstanding about "D" format records: the RECL
	specifier includes the 4 bytes for the control word.

4032	JLC	12-Jul-83
	Reinstate a last-minute mode/form setting routine for DOOPEN,
	needed only by ENDFILE.

4033	JLC	18-Jul-83
	Fix bugs in INQUIRE - typos.

4035	JLC	22-Jul-83
	Fix BLANK= in INQUIRE.

4036	JLC	3-Aug-83
	Add one-word-global-byte-pointer table. Remove most of
	the "illegal data mode for this device" code, replaced
	with setting ASCII-only device flag, to allow binary
	(image) I/O to those devices.

4040	JLC	6-Sep-83
	Finally make CARRIAGECONTROL='FORTRAN' VAX-compatible, that
	is, set the bit in the FDB. If the CHFDB fails, issue a warning
	message. Change CC='FORTRAN' to CC='TRANSLATED' for TTYs and
	LPTs. Fix a bug in DIALOG whereby it was looping in DIALOG
	mode on command errors even though running under batch.

4041	JLC	7-Sep-83
	Fix typo in GMODBY. Caused all files to be 36-bit.

4044	JLC	23-Sep-83
	Modify magtape code slightly. Calculate bytesize
	before doing GTJFN.

4047	JLC	5-Oct-83
	Fix EOFSET, another typo. Caused bogus warning message.

4052	JLC	12-Oct-83
	Clear magtape attributes for assigned magtapes, as they
	are illegal as GTJFN args. Fix OPNCON to leave via %SETAV.
	Fix reparse on COMND%, still had JFN, so was getting
	internal FOROTS error.

4053	JLC	18-Oct-83
	Fixed OPNARG, CLSARG, and OPNCNV/CLSCNV to use separate
	arg pointer and count (no AOBJN).

4054	JLC	25-Oct-83
	Fix DFDEV1, was not storing correct AC for DVCHR bits.

4055	JLC	27-Oct-83
	Fix GMODBY to set ANSI-ASCII and INDUSTRY tapes to
	ASCII-only devices, so that unformatted I/O will
	not read/write LSCWs.

4057	JLC	31-Oct-83
	Fix FIXDEF so it adds LSCWs to the unformatted record
	size of ASCII files.

4064	JLC	14-Nov-83
	Add new keywords for RMS. Fix flaw in INQUIRE regarding
	ERR= and IOSTAT= processing by adding arg copying routine,
	which also simplifies OPEN/CLOSE processing.

4065	JLC	6-Dec-83
	More preparation for RMS.

4066	JLC	11-Jan-84
	Major restructuring of OPEN code to prepare for RMS interface.

4067	JLC	13-Jan-84
	Fix APPEND bug, TOPS-10 filespec bug.

4071	JLC	18-Jan-84
	Fix bugs in INQUIRE.

4072	JLC	24-Jan-84
	Fix more bugs in INQUIRE, and prepare INQUIRE for RMS.

4073	JLC	26-Jan-84
	Fix a bug in RMS INQUIRE functionality: don't rely on
	IJFN(D) being non-zero to tell if the file is open. RMS
	files have no JFN assigned by FOROTS.

4100	MRB	9-Feb-84
	Added code to do compatibility flagging in FOROTS. Outputs
	a warning message for usage of non compatible language features
	like incompatible Keywords in Open/Close statement. KWDFND

4102	JLC	17-Feb-84
	Massive changes to OPEN and CLOSE to establish orthogonal
	STATUS and DISPOSE values.

4103	JLC	21-Feb-84
	Fix bugs introduced by edit 4102. Insert V7A patch for
	DIRECTORY= for TOPS-10.

4104	JLC	23-Feb-84
	Fix DATE75 bug introduced by allowing PROTECTION=<000>.

4105	JLC	28-Feb-84
	Modify the error handling routines, and fix a whole pile
	of latent and real bugs in error handling.

4107	JLC	5-Mar-84
	Fix bugs introduced into DIALOG by edit 4105.

4111	JLC	16-Mar-84
	Modify the error calling sequence again. Fixed some DDB
	consolidation problems introduced by the restructuring
	of STATUS/DISPOSE.

4112	JLC	19-Mar-84
	Renamed FIXU to FIXCC, and moved the call to it to DFDEV1, so
	CARRIAGECONTROL would be set up for deferred-open files.

4114	JLC	28-Mar-84
	Remove I%TCH on TOPS-10, as it is almost useless
	and didn't work anyhow.

4115	JLC	2-Apr-84
	Fixes to OSWTCH and ISWTCH.

4116	JLC	4-Apr-84
	More fixes to OPEN, ISWTCH, and OSWTCH

4122	JLC	2-May-84
	A whole raft of changes to make the TOPS-10 and TOPS-20
	DDB databases the same.

4123	JLC	5-May-84
	Add more code to TOPS-10 TABLK to make it more like TOPS-20.

4124	JLC	8-May-84
	Stop copying generation number for CLOSE with rename. Move
	the default open code within CLOSE before the CLOSE arguments
	are processed, and notably before the filespec is copied to
	the rename DDB. Fix OPNDEV so it accepts a blank string again.

4125	JLC	11-May-84
	Fix PROTECTION= and DIRECTORY=.

4127	JLC	15-May-84
	Fix TOPS-10 append. Fix OPEN/CLOSE specifiers so they take
	hollerith arguments again.

4131	JLC	12-Jun-84
	Disallow DUMP mode for magtape, as magtape code is totally
	reworked to handle industry tapes, etc. Move alot of code
	around, clean it up, consolidate the OPEN/CLOSE/INQUIRE
	argument processor. Remove most of the flags of F, replace
	them with global context variables DSPPNT and SWTPNT and
	with better top-down coding practices.

4134	JLC	3-Jul-84
	Made some changes in error messages and changed around
	the order of the tables for COMND% in DIALOG so that
	you get a reasonable error message for a bad character.
	Fixed DUMP mode again.

4135	JLC	9-Jul-84
	Fix GTJFN and COMND% interfaces so the entire JFN, including
	flags, is saved so JFNS will return the exact string given.
	Add MOPBTS, since magtape does not allow both OF%RD and OF%WR
	at the same time. At %SETOUT, set the access to SEQOUT so that
	successive calculations of SAIDX will yield the same results.
	Allow temporary files and wild-cards in filespecs. For TOPS-20,
	translate TOPS-10 style PPN to directory after all arguments
	and defaults are processed.

4137	JLC	17-Jul-84
	Fix magtape ISWTCH and OSWTCH problems for TOPS-20 - they
	were not resetting the magtape parameters, which go away
	when you close the file. Allow wildcard specs in the
	filespec in CLOSE.

4141	JLC	3-Aug-84
	Fix magtape code for TOPS-10.

4144	JLC	29-Aug-84
	Fix magtape code again, this time for null file at BOT.
	Add DISPOSE='PLOT' for John Edgecombe's edification.

4145	JLC	7-Sep-84
	Fix DISPOSE=. If it failed, it would leave around
	a JFN/channel. Fix handling of no such device. Setup the
	file size of files not actually opened for DISPOSE='PRINT'.

4150	JLC	13-Sep-84
	Fix magtape append code yet again, since edit 4144 broke it
	for the normal append case.

4151	MRB	19-Sep-84
	Magtape stuff, re-write CNFDEV.

4153	JLC	27-Sep-84
	Default TAPEFORMAT='INDUSTRY' if it is not set and RECORDTYPE
	is set to anything but STREAM.

4155	JLC	11-Oct-84
	Fix CLOSE so that dispose and status values in a CLOSE
	statement do not get imported into the original DDB.

4157	MRB	25-Oct-84
	Add code in CNVDEV to call error messages for the magtape 
	specifiers conflicts.	

4161	JLC	1-Nov-84
	Change ASCFLG to IMGFLG. Rearrange some magtape code to
	make the -10 and -20 magtape handling similar. Set IMGFLG
	for INDUSTRY tapes in MTADEF, called in DFDEV1.

4164	JLC	15-Nov-84
	Fix edit 4161: IMGFLG was getting cleared/set in more than one
	place.

4170	JLC	19-Nov-84
	Fix CMPACC in OPNCON: the ACCESS= was not being compared if
	ACCESS= on the consecutive OPEN statement was not given or,
	for V10, was 'SEQUENTIAL'.

4171	JLC	27-Nov-84
	Fix edit 4170: OPEN on a connected unit should succeed if
	SEQINOUT (or no access) is specified in the second access
	and the first access was either SEQOUT or SEQINOUT.
	Implement CARRIAGECONTROL='FORTRAN' for TOPS-10 - if it
	is requested in the OPEN statement, set it in the LOOKUP/ENTER
	block (expanded to be 7.03 size), so that it will begin to work
	when customers receive 7.03.

4174	JLC	9-Jan-85
	Fix FTVAX code so that the units are aligned correctly.
	Fix code in DSKRNM so that the FILOP error will be preserved
	in T1.

4177	JLC	28-Jan-85
	Do not set the bytesize of non-magtape IMAGE devices
	to the default bytesize, as that makes IMAGE files
	have 7-bit bytes instead of 36-bit bytes.

4202	JLC	15-Feb-85
	Move ALCHN. and DECHN. to FORMEM, so the call to %SAVAC can be
	changed the SAVAC routine local to FORMEM.

4203	JLC	13-Mar-85
	Set D%IN and D%OUT for TTY to avoid going to OSWTCH code.
	Fix DSKREN so that the path block is copied correctly.
	Store user-supplied bytesize separately from actual bytesize
	used, so that going through the code again will not do
	weird things.

4205	JLC	19-Mar-85
	Allow *.* for filename for TOPS-10 magtapes, clearing
	the filename and extension field so that the TOPS-10 labeled tape
	processor gets the "next file" on the tape. Make some of the
	pseudonyms for RECORDTYPE invisible for DIALOG, and modify FNDSWT
	so that it does not return those strings for INQUIRE.
	Make PRINT, READ *, and WRITE * go to TTY for FTVAX.

4211	JLC	2-May-85
	Deallocate channels allocated by accident by TOPS-10 on FILOPs
	which fail, thus preventing undeserved "out of channels" errors
	for programs which open a few files many times. Also, don't
	return path information if the path block wasn't filled in,
	such as for protection failures.

4212	JLC	2-May-85
	Fix yet another DATE75 bug, this one due to the fact that TOPS-10
	deposits the rename error code in the right half of .RBEXT, where
	the low-order 15 bits of the creation date reside. This happened
	only on a rename failure after DIALOG.

4213	JLC	9-May-85
	Make sure BLOCKSIZE is an integral multiple of RECL for
	fixed-length records on industry magtape; issue fatal error
	if not.

4220	JLC	22-July-85
	Fix initial TTY output, which was throwing away all vertical
	motion control, instead of reducing the number of LFs by 1,
	as in V7.

4225	RJD	23-Sep-85
	Add check for FTDSK being set non-zero.  

4244	MRB	7-Feb-86
	Files are always written in .IODMP mode. They must have the 
	user selected mode recorded in the FDB.  When closing a file 
	(on a TOPS-10 system) we should look at the I/O mode specified 
	by the user and perform a rename FILOP. to set the proper 
	I/O mode in the FDB.
	
4246	MRB	11-Mar-86
	CORRECTION TO EDIT 4244! When closing a non-disk unit we should
	NOT do a rename FILOP.

4247	RJD	11-Mar-86
	Make the error "FRSOPN Can't open file: Too many open units"
	a fatal error.

4250	MRB	17-Mar-86
	Add an additional check to the routine that checks to see if this 
	is the controling terminal.  This new check will see if the job
	is detached. If the job is detached we shouldn't to a DEVST JSYS
	because, this JSYS will wait until a controling attaches to the
	job to return. If the job is detached just jump to NOTTTY 
	because a detached job cannot have a controling terminal.

4251	MRB	1-APR-86
	Yet another CORRECTION TO EDIT 4244! When closing a disk unit
	which is opened for input only we should NOT do a rename FILOP.	
	Also,problems with renaming the dates&time fixed.

4253	MRB	5-MAY-86
	Remove the test for Ascii-only devices in OTHOPN. Was causing 
	plotter output to be wrong mode.

4254	MRB     6-May-86
	<CRLF> before error message was lost after installing edit 4250.

4256	MRB	20-JUN-86
	Set Blocksize for magtape {record size to the monitor}.

4260	MRB	30-SEP-86
	More of edit 4251.  Defined here for autopatch 15. Edit 4251
	was incomplete on autopatch 14.

4261	MRB	1-OCT-86	10-35596
	If we are creating an SFD don't close and re-open for output as
	this will yield a protection failure. Just leave it open in 
	.FOCRE mode.

***** Begin Version 11 *****

5000	TGS	1-Jul-85
	Implement RMS OPEN.

5001	TGS	1-Aug-85
	Implement RMS INQUIRE.

5002	TGS	1-Sep-85
	Implement RMS CLOSE.

5004	TGS	10-Nov-85
	RMS WRITE.

	MRB	2-Dec-85
5005	Added routine MTGTJF and called it by code in MTAOPN.

5006	MRB	18-Dec-85
	Disallow append mode for labeled magtapes, disallow 
	Input and output switching for labeled tapes.
	Removed routine MTGTJF (incompatible with Tops-10).

5007	TGS	4-Jan-86
	Add %RMECK call to cleanup after failing FOROPN OPEN for RMS
	files.

5016	MRB	16-Jun-86
	Implement MAXREC keyword in open statements.

5020	TGS	29-Jul-86
	Make node and network attributes default correctly for DEFAULTFILE:
	separate out FILE=, NAME=, and DEFAULTFILE= from the common parser
	(sigh).

5022	MRB	8-Oct-86
	Wrong error messages are coming out for blocksize not 
	specified/intregal multiple. Corrected it.  CNFBLR


***** End Revision History *****
\
	FSRCH
IF20,<	SEARCH QSRMAC,GLXMAC >

	INTERN	%EXIT1
	INTERN	%SETIN,%SETOUT,%CLSOP,%CLSCL
	INTERN	%MTPRM,%LABCK
	INTERN	%UNNAM,%ERFNS
	INTERN	%OPENX,%LSTBF
	INTERN	%ARGNM,%EX1N,%OWGBT
	INTERN	%TXTBF,%GTFNS
	INTERN	%RNAMU,%RNAMD
IF20,<	INTERN	%OLDDB,CLSDDB,DSKREN,TXTBF2,SWDISC,%SOCNT,JFNBLK ;[5002]>
IF20,<	INTERN	OPNSWT,KEYVAL,FNDSWT,SWRECT,D.KEY,OPCNF		;[5000]>
IF20,<	INTERN	FNSCLR,FNSPNT,%GNPNT,FNOJFN,ASCFNS,RELJFN	;[5000]>
IF20,<	INTERN	%DOJFNS,RANALC,CHKBSZ,BSTAB,%RSEOF,FDB		;[5000]>
IF20,<	INTERN	UNKXST						;[5001]>
IF20,<	INTERN	ILLOUT						;[5004]>
	INTERN	O.KEY,O.DIAL					;[5000]

	EXTERN	%FLIDX
	EXTERN	A.END,A.ERR,A.IOS,%CUNIT,%OCCOC,%CCMSK,%OCLR
	EXTERN	%POPJ,%POPJ1,%POPJ2
	EXTERN	%SAVE1,%SAVE2,%SAVE3,%SAVE4,%SAVAC,%CPARG,%PUSHT,%POPT
	EXTERN	%GTBLK,%FREBLK,%GTPGS,%FREPGS
	EXTERN	%OCRLF,%PTOF
	EXTERN	%JIBLK,D.BSTP,%NAMLN
	EXTERN	%CRLF,%SMAPW,%OSDSK,%OSMAP,%OBUF,%ISBUF
	EXTERN	%MTBSB,%MTEOF,%MTFSF,%MTBSA
	EXTERN	%ABORT,%ABFLG
	EXTERN	%DDBTAB,%UDBAD,I.PID,%SIZTB
	EXTERN	D.TTY,U.TTY,U.ERR,AU.ACS
IF10,<	EXTERN	%RANWR,I.JOB >
	EXTERN	%SETAV
IF20,<	EXTERN	%RMISW,%RSISW,%RMOSW,%RMCLS,%RMOPN,%RMLKP	;[5000]>
IF20,<	EXTERN	%RMRFS,%RMDSP,%RMREN				;[5000]>
IF20,<	EXTERN	%RMGXF,%CHKBD,FNDRMS				;[5000]>
IF20,<	EXTERN	%RMEFN,%RMCSY					;[5002]>
	EXTERN	%RMKOP,%RMDAB,%RMDKB,%RMCKF,%RMDFA		;[5000]
	EXTERN	%RSOSW						;[5000]
	EXTERN	%RMECK						;[5007]
	EXTERN	U.RERD


	SEGMENT	CODE
	SUBTTL	OPEN

	FENTRY	(OPEN)
	PUSHJ	P,%SAVAC	;SAVE USER'S ACS, COPY ARG LIST
	PUSHJ	P,%CPARG
	XMOVEI	T1,[ASCIZ /OPEN/] ;SET STATEMENT NAME FOR ERROR MESSAGES
	MOVEM	T1,%IONAM

	PUSHJ	P,CLCVAR	;CLEAR COMMON OPEN/CLOSE VARIABLES
	PUSHJ	P,OPNCNV	;CONVERT OLD ARG BLOCK FORMAT
	PUSHJ	P,OICCPY	;COPY ARG LIST TO KEYWORD BLOCK
	PUSHJ	P,UNRNGE	;Check unit range

;Unit may not be closed yet. In an case,
;get a new one.

	MOVEI	T1,ULEN		;Length of a unit block
	PUSHJ	P,%GTBLK	;Allocate it
	 $ACALL	MFU		;CAN'T
	MOVE	U,T1		;Point to empty unit block
	MOVE	T2,%CUNIT	;Stick unit number in block
	STORE	T2,UNUM(U)
	MOVEI	T1,DLEN		;Length of a DDB block
	PUSHJ	P,%GTBLK	;Allocate it
	 $ACALL	MFU		;CAN'T
	MOVE	D,T1		;Point to empty DDB block
	MOVEM	U,%UDBAD	;FLAG THAT WE HAVE A PROPER DDB
	MOVEM	D,DDBAD(U)	;SAVE DDB ADDR

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

;PAST VERSIONS OF THE FORTRAN COMPILER ALLOWED BOTH DIALOG
;AND DIALOG= TO BE SPECIFIED IN THE SAME OPEN STATEMENT,
;AND NAME= HAD THE SAME KEYWORD NUMBER AS DIALOG. TO ALLOW
;FOR MOST OF THE BOGUS (BUT WORKING) COMBINATIONS IN THESE
;OLD PROGRAMS' REL FILES, WE CLEAR O.DIAL AND LET OPNARG
;SET UP POSSIBLY BOTH O.DIAS (FOR A DIALOG= STRING) AND
;O.DIAL (FOR DIALOG WITH NO STRING).

	SETZM	O.DIAL		;KLUDGE - FILLED IN BY OPNARG
	PUSHJ	P,OPNARG	;Copy arguments from arg list

	PUSHJ	P,DFDEV		;Setup default device
	PUSHJ	P,DFFILE	;SETUP DEFAULT FILENAME
	PUSHJ	P,PPNDIR	;[4135] TRANSLATE PPN TO DIRECTORY IF NECESSARY

IF20,<
	SETZM	LOCNOD		;CLEAR LOCAL NODE
	SETZM	JFNBLK+.GJNOD	;AND ANY PREVIOUS NODE
> ;END IF20

	SKIPE	O.DFLT		;DEFAULTFILE= SEEN?
	 PUSHJ	P,DFOPN		;YES. PROCESS IT
	SKIPE	O.FILE		;FILE='string' SEEN?
	 PUSHJ	P,FILOPN	;YES. PROCESS IT
	SKIPE	O.NAME		;NAME= SEEN?
	 PUSHJ	P,NAMOPN	;YES. DO IT

IF20,<
	SKIPE	LOCNOD
	 SETZM	NODNAM(D)
> ;END IF20

	SKIPE	O.KEY		;[5000] KEY= SEEN?
	 PUSHJ	P,%RMKOP	;[5000] Yes, do it (must precede DIALOG=)
	SKIPE	O.DIAS		;DIALOG= SEEN?
	 PUSHJ	P,DLSOPN	;Yes, do it
	PUSHJ	P,OPNDLG	;GO DO DIALOG IF NECESSARY

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

	PUSHJ	P,SMBA		;SET MODE BY ACCESS
	MOVX	T1,D%OPEN	;"Explicit OPEN statement has been done"
	IORM	T1,FLAGS(D)	; Set DDB flag
	PUSHJ	P,OPENZ		;OPEN FILE IF NOT DEFERRED
	HXRE	T1,UNUM(U)	; Get unit number
	MOVEM	U,%DDBTAB(T1)	;Store unit block address in DDBTAB.
	PJRST	%SETAV		;Set AVAR if given, return from OPEN

OPNCON:	PUSHJ	P,%RMDKB	;[5000] DEALLOCATE DIALOG KEY=
	MOVE	P1,%CUNIT	;GET UNIT # AGAIN
	SKIPN	P1,%DDBTA(P1)	;GET UDB ADDR
	 POPJ	P,		;NONE. JUST PROCEED WITH OPEN
	MOVE	P2,DDBAD(P1)	;GET DDB ADDR


;IF THE USER DID NOT SPECIFY FILE= IN THE SUCCEEDING OPEN, THE FILENAME
;COMPARISON IS SKIPPED, SINCE IT IS OBVIOUS THAT THE USER WANTS US TO
;REMEMBER THE FILENAME USED FOR THE ORIGINAL OPEN, BUT FOROTS HAS
;SUBSTITUTED FORnn.DAT.

	SKIPN	FILPRS(D)	;IF USER DID NOT SPECIFY FILE=
	 JRST	NOCFIL		;DO NOT COMPARE FILESPECS
	PUSHJ	P,CMPFIL	;CHECK FILE STRING
	 JRST	CLZUNT		;BAD
NOCFIL:	PUSHJ	P,CMPSTA	;CHECK STATUS
	 JRST	CLZUNT		;BAD
	PUSHJ	P,CMPMOD	;CHECK MODE
	 JRST	CLZUNT		;BAD
	PUSHJ	P,CMPFRM	;CHECK FORM
	 JRST	CLZUNT		;BAD
	PUSHJ	P,CMPACC	;CHECK ACCESS
	 JRST	CLZUNT		;BAD
	LOAD	T1,BLNK(U)	;GET BLANK=
	STORE	T1,BLNK(P1)	;STORE IN OLD FILE DDB
	LOAD	T1,CC(U)	;GET CARRIAGE=
	STORE	T1,CC(P1)	;STORE IN OLD FILE DDB
	LOAD	T1,PADCH(U)	;GET PADCHAR
	STORE	T1,PADCH(P1)	;STORE IN OLD FILE DDB
	AOS	(P)		;SKIP RETURN
	POPJ	P,

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

CLZUNT:	MOVEM	U,SAVEU		;SAVE NEW DDB
	MOVEM	D,SAVED
	MOVE	T1,O.KEY	;[5000] SAVE NEW KEY= PNTR
	MOVEM	T1,SAVKEY	;[5000]
	MOVE	T1,%CUNIT	;GET UNIT #
	MOVE	U,%DDBTAB(T1)	;GET UDB
	MOVE	D,DDBAD(U)	;Get old DDB block
	PUSHJ	P,%CLOSX	;Go close it.
	MOVE	U,SAVEU		;RESTORE NEW DDB
	MOVEM	U,%UDBAD	;[4135] SAVE AGAIN - %CLOSX CLOBBERED IT
	MOVE	T1,SAVKEY	;[5000] RESTORE O.KEY
	MOVEM	T1,O.KEY	;[5000]
	MOVE	D,SAVED
	POPJ	P,

	SEGMENT	DATA

SAVEU:	BLOCK	1		;SAVED UNIT BLOCK
SAVED:	BLOCK	1		;SAVED DEVICE BLOCK
SAVKEY:	BLOCK	1		;[5000] O.KEY POINTER

;COMPARE ROUTINES FOR OPEN ON A CONNECTED UNIT

	SEGMENT	CODE

CMPFIL:	MOVEM	U,INQUDB	;SAVE UDB ADDR
	MOVE	T1,FLAGS(P2)	;GET DDB FLAGS OF OLD FILE
	TXNN	T1,D%OPEN+D%IN+D%OUT	;FILE OPEN?
	 POPJ	P,		;NO
	TXNN	T1,D%IN+D%OUT	;IS FILE ACTUALLY OPEN?
	 JRST	OPCNJ		;NO. GO DO PARSE-ONLY COMPARISON

	MOVE	U,P1		;GET OLD UDB ADDR
	MOVE	D,P2		;GET OLD DDB ADDR

	MOVE	T1,[POINT 7,TXTBF2] ;GET FULL FILE STRING
	PUSHJ	P,%GTFNS

;NOW WE TAKE THE INFORMATION GLEANED FROM THE FILE= SPEC OF THE
;NEW OPEN STATEMENT AND TRY TO LOOKUP THE FILE IN ORDER TO EXPAND
;THE FILE STRING.

	MOVE	U,INQUDB	;GET NEW UDB AGAIN
	MOVE	D,DDBAD(U)	;GET DDB ADDR
	PUSHJ	P,LOOKF		;LOOKUP FILE
	 POPJ	P,		;FILE NOT FOUND

	MOVE	T1,[POINT 7,%TXTBF] ;GET FILE STRING
	PUSHJ	P,%GTFNS
	PUSHJ	P,RELJFN	;RELEASE THE JFN
	JRST	OPCCOM		;GO COMPARE FILE STRINGS

OPCNJ:	MOVE	U,P1		;GET OLD UDB ADDR
	MOVE	D,P2		;GET OLD DDB ADDR

	MOVE	T1,[POINT 7,TXTBF2] ;POINT TO DDB FILESTRING BLOCK
	PUSHJ	P,%GTFNS	;DO PARSE-ONLY GTJFN, JFNS

	MOVE	U,INQUDB	;GET NEW UDB AGAIN
	MOVE	D,DDBAD(U)	;GET DDB ADDR
	MOVE	T1,[POINT 7,%TXTBF] ;POINT TO OPEN FILESTRING BLOCK
	PUSHJ	P,%GTFNS	;DO PARSE-ONLY GTJFN, JFNS

OPCCOM:	MOVEI	T3,LTEXTC	;SETUP FOR COMPARE
	MOVEI	T0,(T3)
	MOVE	T1,[POINT 7,%TXTBF] ;NEW OPEN FILESTRING
	MOVE	T4,[POINT 7,TXTBF2] ;OLD OPEN FILESTRING
	EXTEND	T0,[EXP <CMPSN>,0,0] ;SKIP IF NOT EQUAL
	 AOS	(P)		;EQUAL. SKIP RETURN
	POPJ	P,

CMPMOD:	LOAD	T1,MODE(D)	;GET NEW MODE
	JUMPE	T1,%POPJ1	;OK IF NONE
	LOAD	T2,MODE(P2)	;GET OLD MODE
	CAIN	T1,(T2)		;EQUAL?
	 AOS	(P)		;YES. SKIP RETURN
	POPJ	P,

;CMPSTA - IN ORDER TO MAINTAIN COMPATIBILITY WITH V6, ONLY FILES
;OPENED WITH STATUS='OLD' ARE CONSIDERED TO BE CANDIDATES FOR
;A "CONNECTED OPEN". OTHERWISE, CMPSTA WILL NON-SKIP RETURN, FORCING
;THE CURRENTLY OPEN FILE TO BE CLOSED FIRST.
CMPSTA:	LOAD	T1,STAT(D)	;GET STATUS OF NEW ONE
	CAIN	T1,ST.OLD	;IS IT OLD?
	 AOS	(P)		;YES. SKIP RETURN
	POPJ	P,

CMPFRM:	LOAD 	T1,FORM(D)	;GET FORMAT OF NEW FILE
	JUMPE	T1,%POPJ1	;OK IF NONE
	LOAD	T2,FORM(P2)	;GET OLD ONE
	CAIN	T1,(T2)		;EQUAL?
	 AOS	(P)		;YES. SKIP RETURN
	POPJ	P,

CMPACC:	LOAD	T1,ACC(D)	;GET ACCESS OF NEW FILE
	CAIE	T1,AC.SIO	;[4171] SEQINOUT (OR NONE SPECIFIED?)
	 JRST	NOTSIO		;[4171] NO
	LOAD	T2,ACC(P2)	;[4171] GET OLD ONE
	CAIE	T2,AC.SOU	;[4171] SEQOUT?
	 CAIN	T2,AC.SIO	;[4171] OR SEQINOUT?
	  JRST	%POPJ1		;[4171] YES. SKIP RETURN
NOTSIO:	LOAD	T2,ACC(P2)	;[4171] GET OLD ONE
	CAIN	T1,(T2)		;EQUAL?
	 AOS	(P)		;YES. SKIP RETURN
	POPJ	P,

;%OPENX - Routine to do implicit open
;This routine is used by all I/O statements that do
;an implicit OPEN.
;This routine must only be called when the arguments given
;so far do not conflict.
;	D and U are setup with the implicit args.
;	Errors go to ERR= or call DIALOG.
;If no errors, DDBTAB entry is set up.

; ** Implicit OPEN routine starts here **

%OPENX:	PUSHJ	P,CLCVAR	;CLEAR COMMON OPEN/CLOSE VARIABLES
	PUSHJ	P,DFDEV		;Set default device
	PUSHJ	P,DFFILE	;Set default filespec info based on STATUS

	MOVEI	T1,BL.ZERO	;BLANK=ZERO IF NO OPEN STATEMENT
	LOAD	T2,INDX(D)	;GET DEVICE INDEX
	CAIN	T2,DI.TTY	;TTY?
	 MOVEI	T1,BL.NULL	;YES. SET BLANK=NULL
	STORE	T1,BLNK(U)	;Store the value
	PUSHJ	P,OPENZ		;OPEN FILE
	HXRE	T1,UNUM(U)	; Get unit number
	MOVEM	U,%DDBTAB(T1)	;Store unit block address in DDBTAB.
	POPJ	P,

;HERE IF FILE WAS NOT ACTUALLY OPENED PREVIOUSLY,
;BUT DID HAVE MOST OF THE (DEFERRED) OPEN CODE EXECUTED.
;DOOPEN IS CALLED, BUT THE CODE REVERTS TO OPENX IF
;AN ERROR OCCURS. THIS IS ALSO CALLED BY CLOSE.

OPNLP:	PUSHJ	P,OPENX		;SETUP THE DDB WITH PROPER DEFAULTS
	PUSHJ	P,MARKCS	;Mark for consolidation if we can
	 JRST	OPNLP		;CONFLICT FOUND. TRY AGAIN
	MOVE	T1,FLAGS(D)	;SEE IF FILE IS OPEN ALREADY
	TXNE	T1,D%IN+D%OUT	;AND IF IT IS
	 POPJ	P,		;DON'T OPEN IT AGAIN
OPENY:	PUSHJ	P,DOOPEN	;Do the OPEN
	 JRST	OPNLP		;FAILED
OPNDN:	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	MOVE	T1,DOPFLG(T1)	;GET FLAGS
	IORM	T1,FLAGS(D)	;RECORD THE FACT THAT THE FILE IS OPEN
	POPJ	P,

;HERE TO OPEN A FILE WHICH HAS NOT BEEN TOUCHED BEFORE.
;IF STATUS/ACCESS INDEX IS SA.UR (UNKNOWN, READ), IT IS
;A "DEFERRED OPEN" AND THE FINAL OPEN AWAITS THE FIRST
;READ OR WRITE OR CLOSE.

OPENZ:	PUSHJ	P,OPENX		;SETUP THE DDB WITH PROPER DEFAULTS
	PUSHJ	P,OPENC		;CHECK FOR OPEN ON A CONNECTED UNIT
	 POPJ	P,		;IT IS. WE'RE DONE
	PUSHJ	P,MARKCS	;Mark for consolidation if we can
	 JRST	OPENZ		;CONFLICT FOUND. TRY AGAIN
	MOVE	T1,FLAGS(D)	;SEE IF FILE IS OPEN ALREADY
	TXNE	T1,D%IN+D%OUT	;AND IF IT IS
	 POPJ	P,		;DON'T OPEN IT AGAIN
	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	CAIN	T1,SA.UR	;UNKNOWN, READ?
	 POPJ	P,		;YES. DON'T OPEN THE FILE YET
	PUSHJ	P,DOOPEN	;NO. OPEN THE FILE NOW
	 JRST	OPENZ		;FAILED. TRY AGAIN
	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	MOVE	T1,DOPFLG(T1)	;GET OPEN FLAGS FOR IT
	IORM	T1,FLAGS(D)	;SAVE THEM
	POPJ	P,

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

OPENX:	PUSHJ	P,OPNDLG	;Do DIALOG mode if necessary
	PUSHJ	P,CKCONF	;Check conflicts in OPEN switches now
	 JRST	OPENX		;Conflicts, go fix
	PUSHJ	P,OPDFLT	;Set other defaults
	PUSHJ	P,DFDEV1	;Get real device info
	 JRST	OPENX		;Fix problem
	PUSHJ	P,DSCALC	;CALCULATE DISPOSE/STATUS INDEX
	 JRST	OPENX		;CONFLICT. TRY AGAIN

	LOAD	T1,STAT(D)	;Get status
	CAIL	T1,ST.DISP	;IS IT A CLOSE DISPOSITION?
	 MOVEI	T1,ST.UNK	;YES. USE STATUS=UNKNOWN
	IMULI	T1,AC.NUM	;POINT TO CORRECT SECTION IN TABLE
	LOAD	T2,ACC(D)	;GET ACCESS
	ADDI	T1,(T2)		;POINT TO CORRECT ENTRY IN TABLE
	SKIPGE	T1,SATAB(T1)	;GET STATUS/ACCESS INDEX
	 JRST	SAILL		;ILLEGAL. REPORT AND GO TO OPENX
	STORE	T1,SAIDX(D)	;SAVE IT
	POPJ	P,

SAILL:	LOAD	T1,STAT(D)	;GET STATUS
	LOAD	T2,ACC(D)	;[5000] GET ACCESS
	MOVEI	T3,OK.STAT	;[5000] AND STATUS KEYWORD VALUE
	MOVEI	T4,OK.ACC	;[5000] AND ACCESS KEYWORD VALUE
	PUSHJ	P,OPCNF		;[5000] REPORT ERROR
	JRST	OPENX		;AND TRY AGAIN

OPENC:	PUSHJ	P,OPNCON	;CHECK FOR OPEN ON A CONNECTED UNIT
	 JRST	%POPJ1		;IT IS NOT. SKIP RETURN

;WE HAVE AN OPEN ON A CONNECTED UNIT. DEALLOCATE THE UDB AND DDB,
;AND SET U AND D TO THE OLD UDB AND DDB AND GO SET THE ASSOCIATE
;VARIABLE, IF ONE IS GIVEN.

	PUSHJ	P,%RMDAB	;[5000] DEALLOCATE RMS STUFF IF THERE
	SETZM	O.KEY		;[5000] CLEAR KEY PNTR
	MOVE	T1,U		;DEALLOCATE U
	PUSHJ	P,%FREBLK
	MOVE	T1,D		;DEALLOCATE D
	PUSHJ	P,%FREBLK
	MOVE	U,%CUNIT	;GET UNIT NUMBER AGAIN
	MOVE	U,%DDBTAB(U)	;GET UDB ADDR
	MOVEM	U,%UDBAD	;POINT TO CORRECT UDB
	MOVE	D,DDBAD(U)	;GET DDB ADDR
	POPJ	P,		;NON-SKIP RETURN

DSCALC:	LOAD	T1,DISP(D)	;GET DISPOSE VALUE
	IMULI	T1,ST.NUM	;GET CORRECT PART OF TABLE
	LOAD	T2,STAT(D)	;GET STATUS
	ADDI	T1,(T2)		;GET INDEX INTO TABLE
	SKIPGE	T1,DSTAB(T1)	;GET DISPOSE/STATUS INDEX
	 JRST	DSILL		;ILLEGAL COMBINATION
	HLRZ	T2,NEWDSP(T1)	;GET ORTHOGONAL DISPOSE VALUE
	STORE	T2,ODISP(D)	;SAVE IT
	HRRZ	T2,NEWDSP(T1)	;GET ORTHOGONAL STATUS VALUE
	STORE	T2,OSTAT(D)	;SAVE IT
	JRST	%POPJ1		;SKIP RETURN

DSILL:	LOAD	T1,STAT(D)	;GET STATUS
	LOAD	T2,DISP(D)	;[5000]
	MOVEI	T3,OK.STAT
	MOVEI	T4,OK.DISP
	PUSHJ	P,OPCNF		;[5000] REPORT ERROR
	POPJ	P,

;Routine to check for unit out of range
;Input:
;	O.UNIT/ unit number argument from OPEN or CLOSE arg list
;	PUSHJ	P,UNRNGE
;	<return here if unit in range>
; If unit is not in range for OPEN or CLOSE,
;	the program takes ERR= path or aborts.

UNRNGE:	SKIPN	T1,O.UNIT	;UNIT SPECIFIED?
	 $ACALL	UNS		;NO. FATAL
	MOVE	T2,@T1		;YES. GET IT
	MOVEM	T2,%CUNIT	;SAVE IT
	CAML	T2,[MINUNIT]	;Skip if less than the minimum
	CAILE	T2,MAXUNIT	;Skip if .LE. the maximum
	 $ACALL	IUN		;?UNIT out of range
	POPJ	P,		;Ok, unit in range

;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 O.DIAL if there are errors.
;It must be called in OPEN after OPNARG, and after each
; DIALOG.
;If no errors, returns .+2

;[5000] Rewritten

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

;Must be /FORM:UNFORMATTED
CKFMU:	CAIN	T2,FM.UNF	;UNFORMATTED?
	 JRST	CKCNAC		;Yes, ok
CKFMUE:	MOVEI	T3,OK.MOD	;MODE switch number
	MOVEI	T4,OK.FORM	;FORM switch number
	PUSHJ	P,OPCNF		;Setup and issue error
	JRST	CKCNAC		;Continue

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

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

	SETZ	T2,		;READONLY has no value
	MOVEI	T3,OK.ACC	;ACCESS switch number
	MOVEI	T4,OK.RO	;READONLY switch number
	CALL	OPCNF		;Setup and issue error

;Check conflict of /STATUS and /READONLY
CKCSRO:	LOAD	T2,RO(D)	;Get value of /READONLY
	JUMPE	T2,CKCSAC	;[4205] Not specified, no conflict
	LOAD	T1,STAT(D)	;Get /STATUS
	CAIE	T1,ST.NEW
	CAIN	T1,ST.SCR	;New and scratch don't make sense
	 JRST	.+2
	JRST	CKCSAC		;Otherwise OK

	SETZ	T2,		;READONLY has no value
	MOVEI	T3,OK.STAT
	MOVEI	T4,OK.RO
	CALL	OPCNF		;Setup and issue 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:	MOVEI	T3,OK.ACC
	MOVEI	T4,OK.STAT
	CALL	OPCNF		;Setup and issue 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	CHKRMS		;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	CHKRMS		;Not /MODE:DUMP, go on.
	MOVEI	T3,OK.ACC
	MOVEI	T4,OK.MODE
	CALL	OPCNF

CHKRMS:	PUSHJ	P,%RMCKF	;Check for RMS keyword conflicts
	 JRST	CKRETN		;Was RMS, all done
				;Not RMS, check for RECORDSIZE

CHKRSZ:	LOAD	T1,ACC(D)	;GET /ACCESS
	CAIE	T1,AC.RIN	;RANDOM?
	CAIN	T1,AC.RIO
	  TRNA			;YES
	 JRST	CKRETN		;[4205] RETURN FROM CHECKING CONFLICTS
	MOVE	T1,RSIZE(D)	;GET /RECORDSIZE
	JUMPN	T1,CKRETN	;[4205] NONZERO, OK
	PUSHJ	P,[$DCALL RRR]	;"?Random IO requires /RECORDSIZE"

CKRETN:	SKIPN	O.DIAL		;[4205] DID WE REPORT A BAD ERROR?
	 AOS	(P)		;[4205] NO. SKIP RETURN
	POPJ	P,		;[4205]

;OPCNF - Setup for a call to OPCONF
;++ [5000] New
;
; FUNCTIONAL DESCRIPTION:
;
;	Sets up OPEN keyword switch numbers and values for an "Incompatible
;	attributes" call to OPCONF
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,OPCNF
;
; INPUT PARAMETERS:
;
;	T1	-	Switch value for %OPNV1
;	T2	-	Switch value for %OPNV2
;	T3	-	Switch number for %OPNK1
;	T4	-	Switch number for %OPNK2
;
; IMPLICIT INPUTS:
;
;	None
;
; OUTPUT PARAMETERS:
;
;	%OPNV1
;	%OPNV2
;	%OPNK1
;	%OPNK2
;
; IMPLICIT OUTPUTS:
;
;	None
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	Uses T1-T4.
;
;--

OPCNF:	MOVEM	T1,%OPNV1	;Setup values for OPCONF
	MOVEM	T2,%OPNV2
	MOVEM	T3,%OPNK1
	MOVEM	T4,%OPNK2
	PUSHJ	P,OPCONF	;Report the error 
	POPJ	P,

;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)
	MOVE	T1,%OPNV2
	PUSHJ	P,FNDSWT
	MOVEM	T1,%OPNV2
	$DCALL	ICA		;INCOMPATIBLE ATTRIBUTES


	SUBTTL	CNFDEV - Check for conflicts for OPEN device
;++				;[4151]re-write
; FUNCTIONAL DESCRIPTION:
;
;	Check the OPEN statement keywords (including default settings) 
;	to see if there is a conflict in them. This routine is called 
;	after we have determined the actual type of device by performing
;	a DVCHR jsys on the device name string. This routine will check
;	for conflicts in MODE and ACCESS specifiers with the type of 
;	device. For instance a card reader (CDR:) cannot be opened for 
;	Access='SEQOUT'. If there is a conflict, either ERR= is taken 
;	or an error message is typed and O.DIAL is set.
;
; CALLING SEQUENCE:
;
;	Called ONLY by routine DOOPEN
;
;	PUSHJ	P,CNFDEV	;CHECK FOR DEVICE CONFLICTS
;	 <error return>
;	 <good return>
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	DVBTS(D) - Device characteristics (from the DVCHR JSYS)
;	ACC(D)   - File Access type specified in open statement
;	INDX(D)  - Device index (from the DVCHR JSYS)
;	BLKSZ(D) - Block Size specified in open statement
;	RSIZE(D) - Record size specified in open statement
;	RECTP(D) - Record type specified in open statement
;	MODE(D)	 - Hardware data mode specified in open statement
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	None
;
; SIDE EFFECTS:
;
;	If a conflict is detected the routine will not return to the
;	caller, but, will perform the error processing (described above).
;
;--
;+
;  Readonly devices cannot do output
;-

CNFDEV:	MOVE	T1,DVBTS(D)	;Get device charactistics (DEVCHR) bits
	TXNE	T1,DV%OUT	;Can this device do output?
	 JRST	CNFDV1		;Yes, No further checking required
	LOAD	T1,ACC(D)	;No, Get type of access specified

	CAIE	T1,AC.SOU	;Is Access = SEQOUT
	CAIN	T1,AC.APP	;or Access = APPEND ?
	 JRST	CNFDAC		;Yes, Conflict "device cannot do output"

	CAIE	T1,AC.RIO	;Is Access = RANDOM (DIRECT)
	CAIN	T1,AC.RIN	;or Access = RANDIN ?
	 JRST	CNFDAC		;Yes, Conflict "device cannot do output"
;	JRST	CNFDV1		;No Conflict 

;+
;  WriteOnly devices cannot do input
;-

CNFDV1:	MOVE	T1,DVBTS(D)	;Get device characistics (DEVCHR) bits
	TXNE	T1,DV%IN	;Can this device do input?
	 JRST	CNFDV2		;Yes, No further cheching required
	LOAD	T1,ACC(D)	;Get type of ACCESS specified
	CAIE	T1,AC.RIN	;Is Access = RANDOM 
	CAIN	T1,AC.RIO	;or Access = RANDIN ?
	 JRST	CNFDAC		;Yes, Conflict "device cannot do input"
	CAIN	T1,AC.SIN	;Is Access = SEQIN ?
	 JRST	CNFDAC		;Yes, Conflict "device cannot do input"
;	JRST	CNFDV2		;No Conflict

;+
;  Check for DIRECT access specified for a sequential device
;-

CNFDV2:	LOAD	T1,ACC(D)	;Get type of ACCESS specified
	CAIE	T1,AC.RIN	;Is Access = RANDOM 
	CAIN	T1,AC.RIO	;or Access = RANDIN ?
	 JRST	.+2		;Yes, check to see if device allows this
	JRST	CNFDV3		;Not RANDOM access

	LOAD	T2,INDX(D)	;Get device index
	CAIE	T2,DI.RMS	;[5000] If RMS...
	CAIN	T2,DI.RSF	;[5000] or RSF
	 MOVEI	T2,DI.DSK	;[5000] pretend it's disk
	CAIE	T2,DI.DSK	;The only random access device is disk!
	 JRST	CNFDAC		;Random access not allowed !
	JRST	CNFDV3		;No Conflict

;
;  Access type Conflicts with type of device
;
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)
	$DCALL	IAC		;Set O.DIAL if ERR= not taken
;+
;  /BLOCKSIZE only allowed with magtape.
;-

CNFDV3:	LOAD	T1,INDX(D)	;Get device type
	CAIN	T1,DI.MTA	;Is it a Magtape?
	JRST	CNFMT1		;Yes, Go do Magtape checks
				;No, Do Blocksize check
	LOAD	T1,BLKSZ(D)	;Get /BLOCKSIZE
	JUMPE	T1,CNFDV4	;Jump if not specified
	 $ECALL	BSI		;BLOCKSIZE IGNORED FOR NON-MAGTAPE
	JRST	CNFDV4		;No conflict (and NOT a magtape).

;+				;[4157]<
;   /RECORDSIZE must be specified for a fixed length record.
;-

CNFMT1:	LOAD	T1,RECTP(D)	;Get /RECORDTYPE
	CAIE	T1,RT.FIX	;Is it Fixed-Length?
	 JRST	CNFMT3		;No, not fixed.
	LOAD	T1,RSIZE(D)	;Yes, Get /RECL 
	JUMPN	T1,CNFBLR	;[4213] Jump if it is specified
;	"/RECORDSIZE required for FIXED-LENGTH records"
	 $DCALL	FRR		;None specified.

CNFBLR:	LOAD	T1,BLKSZ(D)	;[4213] GET BLOCKSIZE
	CAIN	T1,0		;[4213] IF NOT SPECIFIED FOR FIXED RECORDS
	 $DCALL	FBR		;[5022] IT IS A FATAL ERROR
	MOVE	T2,RSIZE(D)	;[4213] GET RECORDSIZE
	IDIV	T1,T2		;[4213] DIVIDE BLOCKSIZE BY RECORDSIZE
	JUMPE	T2,CNFMT5	;[4213] IF NO REMAINDER, IT'S OK
	 $DCALL	BLZ		;[5022] RECORDS MUST FIT EXACTLY INTO BLOCK

;+
;  Magtape Check - Carriage Control specified for Fixed-Length and
;	Delimited records (Can't be translated)
;-
CNFMT3:LOAD	T1,RECTP(D)	;[4213] Get /RECORDTYPE
	CAIE	T1,RT.DEL	;Is it DELIMITED
	 JRST	CNFMT7		;No

CNFMT5:	LOAD	T2,CC(U)	;Get /CARRIAGECONTROL
	 CAIN	T2,CC.TRN	;Is it translated?
;	"/CARRIAGECONTROL:TRANSLATED illegal with this RECORDTYPE"
	$DCALL	CIR		;/CARRIAGECONTROL illegal with /RECTYPE:

;+
;  Magtape Check - See if RECORDSIZE larger than BLOCKSIZE
;-

CNFMT7:	LOAD	T1,BLKSZ(D)	;Get BLOCKSIZE
	JUMPE	T1,CNFDV4	;No BLOCKSIZE specified?
	LOAD	T2,RSIZE(D)	;Get RECORDSIZE
	JUMPE	T2,CNFDV4	;No RECORDSIZE specified?
	CAMGE	T1,T2		;BLOCKSIZE .GE. RECORDSIZE
	 $DCALL	RLB		;Nope, Thats an error.
;	JRST	CNFDV4		;It's OK!	>[4157]
;+
;  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
;
	CAIN	T1,DI.DSK	;Is it a DSK: ?
	 JRST	CNFDV5		;Yes, everything allowed, No conflict
				;No, Not a DSK: device
	CAIE	T2,MD.DMP	;Is it Dump mode ?
	 JRST	CNFDV5		;No (it's not dump mode). No conflict
;
;  Mode is DUMP and device is not a disk. Mode conflicts 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)
	$DCALL	IDM		;Request DIALOG mode
;
;  No conflicts have been detected
;
CNFDV5:	JRST	%POPJ1		;No error-- skip return
				;End of routine CNFDEV
	SUBTTL	OPEN
;
;OPNDLG and CLSDLG - routines to check for dialog needed and do it
;Called from OPEN and CLOSE routines
;Returns when everything cleared up.
;

OPNDLG:	SKIPN	O.DIAL		;DIALOG REQUESTED?
	 POPJ	P,		;NO
	SETZM	O.DIAL		;TURN IT OFF
	PUSHJ	P,OPNCTX	;ENTER OPEN CONTEXT
	PUSHJ	P,CLRCNS	;Clear DDB consolidation pointers, if any
	PUSHJ	P,DIALOG	;Do DIALOG (could set O.DIAL again)
	JRST	OPNDLG		; Loop until no errors.

CLSDLG:	SKIPN	O.DIAL		;DIALOG REQUESTED?
	 POPJ	P,		;NO
	SETZM	O.DIAL		;TURN IT OFF
	PUSHJ	P,CLSCTX	;ENTER CLOSE CONTEXT
	PUSHJ	P,CLRCNS	;Clear DDB consolidation pointers, if any
	PUSHJ	P,DIALOG	;Do DIALOG (could set O.DIAL again)
	JRST	CLSDLG		; Loop until no errors.

INQDLG:	SKIPN	O.DIAL		;DIALOG REQUESTED?
	 POPJ	P,		;NO
	SETZM	O.DIAL		;TURN IT OFF
	PUSHJ	P,INQCTX	;ENTER INQUIRE CONTEXT
	PUSHJ	P,CLRCNS	;Clear DDB consolidation pointers, if any
	PUSHJ	P,DIALOG	;Do DIALOG (could set O.DIAL again)
	JRST	INQDLG		; Loop until no errors.

OPNCTX:	XMOVEI	T1,OPNSWT	;POINT TO OPEN SWITCHES
	MOVEM	T1,SWTPNT
	XMOVEI	T1,OPNDSP	;AND KEYWORD PROCESSOR TABLE
	MOVEM	T1,DSPPNT
	POPJ	P,

CLSCTX:	XMOVEI	T1,CLSSWT	;POINT TO CLOSE SWITCHES
	MOVEM	T1,SWTPNT
	XMOVEI	T1,CLSDSP	;AND KEYWORD PROCESSOR TABLE
	MOVEM	T1,DSPPNT
	POPJ	P,

INQCTX:	SETZM	SWTPNT		;NO SWITCHES
	XMOVEI	T1,INQDSP	;POINT TO INQUIRE KEYWORD PROCESSOR
	MOVEM	T1,DSPPNT
	POPJ	P,

CLCVAR:	SETZM	EFSFLG		;FLAG FOR [ENTER CORRECT FILE SPECS]
	POPJ	P,

;OICCPY - COPIES THE ARGUMENTS INTO THEIR RESPECTIVE KEYWORD
;BLOCK ENTRIES, THEN PUTS ERR= AND IOSTAT= INTO A.ERR AND A.IOS
;WHERE THEY CAN BE USED BY THE ERROR PROCESSOR
OICCPY:	SETZM	OICBLK		;CLEAR THE KEYWORD BLOCK
	MOVE	T1,[OICBLK,,OICBLK+1]
	BLT	T1,OICBLK+OICMAX
	HLRE	T2,-1(L)	;GET NEG ARG COUNT
	MOVE	T3,L		;COPY ARG POINTER
OPNCLP:	MOVE	T1,(T3)		;GET AN ARG
	LDB	T4,[POINTR ((T3),ARGKWD)] ;GET ITS KEYWORD NUMBER
	CAIG	T4,OICMAX	;WITHIN RANGE
	 MOVEM	T1,OICBLK(T4)	;YES. SAVE THE ARG
	ADDI	T3,1		;INCR THE POINTER
	AOJL	T2,OPNCLP	;LOOP FOR ALL

	MOVE	T1,O.ERR	;GET ERR=
	MOVEM	T1,A.ERR	;SAVE FOR ERROR PROCESSOR
	MOVE	T1,O.IOS	;GET IOSTAT=
	MOVEM	T1,A.IOS	;SAVE FOR %SETAV
	POPJ	P,


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

	TXNE	T1,D%OUT	;Skip if file opened for output
	 JRST	SWIN		;YES. SWITCH TO INPUT

	PUSHJ	P,CLCVAR	;CLEAR COMMON OPEN/CLOSE VARIABLES
	MOVX	T1,SA.UR	;SET STATUS/ACCESS INDEX TO UNKNOWN, READ
	STORE	T1,SAIDX(D)
	PUSHJ	P,OPENY		;OPEN FOR SEQUENTIAL INPUT
	MOVE	T1,FLAGS(D)	;GET FLAGS
	TXNE	T1,D%IN		;DID WE ACTUALLY OPEN IT FOR INPUT?
	 POPJ	P,		;YES. WE'RE DONE

;File is now opened for output.

SWIN:	LOAD	T1,ACC(D)	;Get access
	PUSHJ	P,LOUTIN(T1)	;SWITCH DIRECTION TO INPUT
	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



;%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: MOVE	T1,FLAGS(D)	;Get DDB flags now
	TXNE	T1,D%OUT	;File already opened for output?
	  POPJ	P,		;Yes, nothing to do
	LOAD	T0,MODE(D)	;Get MODE
	CAIN	T0,MD.ASL	;'LINED'?
	 $ACALL	CWL		;Yes, can't do it.
	TXNE	T1,D%IN		;IS FILE OPENED FOR INPUT?
	 JRST	SWOUT		;YES. SWITCH TO OUTPUT

	PUSHJ	P,CLCVAR	;CLEAR COMMON OPEN/CLOSE VARIABLES
	MOVEI	T1,AC.SOU	;[4135] SET ACCESS TO SEQOUT
	STORE	T1,ACC(D)	;[4135]
	MOVX	T1,SA.UW	;SET STATUS/ACCESS TO UNKNOWN, WRITE
	STORE	T1,SAIDX(D)
	PUSHJ	P,OPENY		;OPEN THE FILE
	MOVE	T1,FLAGS(D)	;GET DDB FLAGS
	TXNE	T1,D%OUT	;DID FILE GET OPENED FOR OUTPUT
	 POPJ	P,		;YES. DONE

;File was open for input, switch to output

SWOUT:	LOAD	T1,ACC(D)	;Get access mode
	PUSHJ	P,LINOUT(T1)	;SET NEW DIRECTION
	MOVE	T1,FLAGS(D)	;Get DDB flags to change
	TXZ	T1,D%IN		;Clear input
	TXO	T1,D%OUT+D%MOD+D%WRT ;Set output
	MOVEM	T1,FLAGS(D)	;Set new flags
	POPJ	P,		;Done, return


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)		;. .
	$ACALL	CDT

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

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

;HERE FOR SEQUENTIAL FILES  ON INPUT FOLLOWING OUTPUT.
;-20: JUST CLEAR THE BYTE COUNT, SPECIFYING EOF.
;
;-10: WRITE THE CURRENT WINDOW, CLEAR THE BYTE COUNT.
;

ISWTCH:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PJRST	ISWTAB(T1)	;GO TO APPROPRIATE ROUTINE

ISWTAB:	POPJ	P,		;TTY
	JRST	DSKISW		;DISK
	JRST	MTAISW		;MAGTAPE
	JRST	ILLIN		;OTHER. CAN'T SWITCH TO INPUT
IF20,<	JRST	%RSISW		;[5000] REMOTE STREAM FILE
	JRST	%RMISW		;[5000] RMS FILE
> ;End IF20

DSKISW:	LOAD	T1,ACC(D)	;GET ACCESS
	CAIN	T1,AC.APP	;APPEND?
	 JRST	ILLIN		;YES. CAN'T DO INPUT TO OUTPUT-ONLY FILE
	PUSHJ	P,%OCLR		;CLEAR UNUSED BYTES IN LAST WORD
	PUSHJ	P,%OSDSK	;OUTPUT CURRENT OUTPUT WINDOW
	SETZM	ICNT(D)		;TELL DIREC WE'RE AT EOF!
	POPJ	P,

MTAISW:	PUSHJ	P,%CLSOP	;CLOSE FILE, OPEN FOR INPUT
	PUSHJ	P,%MTPRM	;[4137] SET TAPE PARAMETERS
	PUSHJ	P,%MTBSB	;BACKSPACE OVER EOF
	SETZM	ICNT(D)		;BUFFER HAS NO MORE BYTES IN IT
	POPJ	P,		;DONE


;HERE FOR OUTPUT FOLLOWING INPUT FOR ALL DEVICES.

OSWTCH:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PJRST	OSWTAB(T1)	;GO TO APPROPRIATE ROUTINE

OSWTAB:	POPJ	P,		;TTY
	JRST	DSKOSW		;DISK
	JRST	MTAOSW		;MAGTAPE
	JRST	ILLOUT		;OTHER. CAN'T SWITCH TO OUTPUT
IF20,<	JRST	DSKOSW		;[5000] REMOTE STREAM FILE (GOES TO %RSOSW)
	JRST	%RMOSW		;[5000] RMS FILE
> ; End IF20

;DISK OUTPUT SWITCH. IF THE FILE IS INPUT-ONLY, CLOSE
;AND OPEN IT FOR OUTPUT. OTHERWISE JUST USE THE CURRENT
;BUFFER AND BYTE POINTER. IN ANY CASE, WE HAVE TO SET
;THE BYTE COUNT (ICNT) TO THE NUMBER OF BYTES FROM THE
;CURRENT POINTER TO THE END OF A FULL WINDOW. THIS IS CALCULATED
;BY GETTING THE NUMBER OF WORDS FROM THE BEGINNING OF THE WINDOW,
;THEN MULTIPLYING BY BPW(D) TO GET BYTES, THEN SUBTRACTING THIS
;FROM THE FULL WINDOW SIZE, AND ADDING THE NUMBER OF BYTES LEFT
;IN THE CURRENT WORD. THIS LAST QUANTITY IS CALCULATED BY A BIT
;OF "MAGIC" ARITHMETIC: A MULTIPLY OF THE LEFT-HAND OF THE BYTE
;POINTER BY BPW(D); THE HIGH-ORDER WORD OF THE MULTIPLY YIELDS
;THE NUMBER OF LEFTOVER BYTES. THE ARITHMETIC IS, IN FACT,
;MULTIPLYING THE NUMBER OF BITS TO THE RIGHT OF THE CURRENT BYTE
;BY BPW AND THEN DIVIDING BY 32 (BY DINT OF THE
;POSITION WITHIN THE BYTE POINTER OF THE NUMBER OF BITS TO THE
;RIGHT OF THE CURRENT BYTE). THE FORMULAE FOR 6, 7, 8, AND 9-BIT
;BYTES ARE THEN:
;
;6-BIT		(N*6)*6/32
;
;7-BIT		(N*7+1)*5/32
;
;8-BIT		(N*8+4)*4/32
;
;9-BIT		(N*9)*4/32
;
;WHERE N IS THE NUMBER OF LEFTOVER BYTES. AS YOU CAN SEE, THE
;QUOTIENT OF ALL OF THESE FORMULAE IS N. SOME OTHER BYTE SIZES WORK
;AS WELL. WE SHALL NOT PRESENT HERE THE THEORETICAL BASIS FOR THE
;ARITHMETIC.

DSKOSW:	PUSHJ	P,%PTOF		;CALC CURRENT BYTE NUMBER
	MOVEM	T1,EOFN(D)	;SAVE AS EOF PNTR
	MOVE	T1,FLAGS(D)	;GET FLAGS
	TXZE	T1,D%END	;END OF FILE?
	 SOS	CREC(D)		;[2042] YES. DECR THE RECORD COUNT
	MOVEM	T1,FLAGS(D)	;SAVE FLAGS WITHOUT EOF
	LOAD	T1,INDX(D)	;[5004] GET FILE TYPE
	CAIN	T1,DI.RSF	;[5004] RSF?
	 PJRST	%RSOSW		;[5004] YES, MUST TRUNCATE (MAYBE) NOW
	PUSHJ	P,CLSOUT	;CLOSE FILE, OPEN FOR WRITE
	PJRST	%SOCNT		;SET OUTPUT COUNT

;MAGTAPE OSWTCH
;BACK OVER ACTIVE BUFFER, OPEN FOR OUTPUT

MTAOSW:	PUSHJ	P,OSWBAK	;BACKUP TAPE, SET PNTR/COUNT
	PUSHJ	P,MTACLO	;CLOSE FILE, OPEN FOR OUTPUT
	PJRST	%MTPRM		;[4137] AND SETUP TAPE PARAMETERS

OSWBAK:	MOVE	T2,FLAGS(D)	;Get DDB flags
	TXZN	T2,D%END	;Clear EOF, skip if it was on.
	 JRST	BACKUP		;NOT EOF. GO BACK OVER ACTIVE BUFFER
	MOVEM	T2,FLAGS(D)	;Remember we cleared EOF
	HXLZ	T1,BYTPT(D)	;GET BYTE POINTER
	MOVEM	T1,IPTR(D)	;SAVE IT
	SETZM	ICNT(D)
	SETZM	BYTN(D)		;WRITING A NEW FILE
	SETZM	EOFN(D)
	SETZM	CREC(D)		;CLEAR RECORD COUNT
	POPJ	P,

BACKUP:	HRRZ	T1,IPTR(D)	;GET ADDRESS OF DATA
	JUMPE	T1,%POPJ	;IF NO DATA, LEAVE
	PUSHJ	P,%MTBSB	;BACKSPACE OVER ACTIVE BUFFER

%SOCNT:	HRRZ	T1,IPTR(D)	;GET CURRENT WORD
	JUMPE	T1,%POPJ	;IF NONE, LEAVE
	SUB	T1,WADR(D)	;GET OFFSET WITHIN WINDOW
	ADDI	T1,1		;GET # WORDS USED
	IMUL	T1,BPW(D)	;GET # BYTES USED
	MOVE	T2,IPTR(D)	;GET LEFT HALF OF BP
	MUL	T2,BPW(D)	;CALC # BYTES LEFT IN WORD
	SUBI	T1,(T2)		;SUBTRACT THE LEFTOVER BYTES
	MOVE	T2,WSIZ(D)	;GET THE WINDOW SIZE
	SUBI	T2,(T1)		;GET # AVAILABLE BYTES
	MOVEM	T2,ICNT(D)	;SAVE IT FOR I/O
	POPJ	P,

IF20,<

%LSTBF:	PUSHJ	P,%OCLR		;CLEAR UNUSED CHARS IN LAST WORD
	PUSHJ	P,%OBUF		;OUTPUT BUFFER

	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIN	T1,DI.MTA	;MAGTAPE?
	 PUSHJ	P,%MTEOF	;YES. WRITE AN EOF MARK
	POPJ	P,

;CLOSE FILE FOR OUTPUT, OPEN FOR INPUT
%CLSOP:	MOVE	T1,FLAGS(D)	;GET DDB FLAGS
	TXNE	T1,D%OUT	;WAS FILE OPEN FOR OUTPUT?
	 PUSHJ	P,%LSTBF	;YES. OUTPUT LAST BUFFERFUL
	MOVE	T1,IJFN(D)	;CLOSE FILE
	HRLI	T1,(CO%NRJ)	;KEEP JFN
	CLOSF%
	  $ACALL ISW
	MOVE	T1,IJFN(D)	;GET JFN AGAIN (WITHOUT BITS IN LH)
	MOVE	T2,DMABS(D)	;GET DATA MODE & BYTE SIZE FOR OPENF
	TRO	T2,OF%RD	;SET FOR INPUT
	OPENF%			;REOPEN FILE
	 $ACALL	ISW
	MOVE	T1,FLAGS(D)	;GET DDB FLAGS
	TXZ	T1,D%END+D%OUT	;NOT DOING OUTPUT ANY MORE, NOR AT EOF
	TXO	T1,D%IN		;NOW WE ARE DOING INPUT
	MOVEM	T1,FLAGS(D)	;SAVE UPDATED FLAGS
	POPJ	P,


;CLOSE MAGTAPE FOR INPUT, OPEN FOR OUTPUT
MTACLO:	MOVE	T1,IJFN(D)	;REOPEN FILE FOR OUTPUT
	HRLI	T1,(CO%NRJ)
	CLOSF%
	 $ACALL	OSW

	LOAD	T1,LTYP(D)	;[5006]Get label type
	CAIE	T1,LT.UNL	;[5006] If its' labeled give error
	 $ACALL	 SLT		;[5006] Labeled tapes can't

	MOVE	T1,IJFN(D)
	MOVE	T2,DMABS(D)
	TRO	T2,OF%WR
	OPENF%
	 $ACALL	OSW
	POPJ	P,

;CLOSE FILE, OPEN FOR OUTPUT
CLSOUT:	MOVE	T1,FLAGS(D)	;GET DDB FLAGS
	TXNE	T1,D%WRT	;DO WE HAVE WRITE ACCESS ALREADY?
	 POPJ	P,		;YES. DON'T HAVE TO CLOSE/OPEN
	MOVX	T1,D%WRT	;We have WRITE access now
	IORM	T1,FLAGS(D)

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

	MOVE	T1,IJFN(D)	;CLOSE FILE, KEEP JFN
	HRLI	T1,(CO%NRJ)
	CLOSF%
	 $ACALL OSW

	MOVE	T1,IJFN(D)	;GET JFN BACK
	MOVE	T2,DMABS(D)	;GET DATA MODE AND BYTE SIZE
	TRO	T2,OF%RD!OF%WR	;GET READ/WRITE ACCESS
	OPENF%			;REOPEN FILE
	 $ACALL OSW

	HRRZ	T1,IPTR(D)	;GET ADDRESS OF DATA
	JUMPE	T1,%POPJ	;IF NO DATA, LEAVE
	MOVN	T1,WSIZ(D)	;SET TO MAP CURRENT WINDOW
	ADDM	T1,BYTN(D)
	PUSHJ	P,%SMAPW	;MAP THE PAGES
	MOVE	T1,WSIZ(D)	;SET NEXT WINDOW BYTE NUMBER
	ADDM	T1,BYTN(D)
	POPJ	P,

> ;END IF20

IF10,<

MTACLO:	DMOVE	T1,IPTR(D)	;SAVE POINTER/COUNT
	DMOVEM	T1,TPTR(D)	;IN UNUSED HEADER IN DDB
	PUSHJ	P,FICLOS	;CLOSE FILE, RELEASE CHANNEL
	MOVE	T1,[FO.PRV+FO.ASC+.FOWRT] ;USE SUPERCEDE
	MOVEM	T1,FBLK(D)	;STORE IN FILOP BLOCK
	PUSHJ	P,SETFB		;SETUP FILOP BLOCK
	MOVX	T1,SA.UW	;SETUP FOR WRITE ACCESS
	STORE	T1,SAIDX(D)
	MOVSI	T1,IBCB(D)	;SETUP FOR OUTPUT BUFFER ONLY
	MOVEM	T1,FBLK+.FOBRH(D)
	MOVSI	T1,1		;1 BUFFER ONLY
	MOVEM	T1,FBLK+.FONBF(D)
	PUSHJ	P,DOFLP		;Now do the FILOP.
	 $ACALL	OSW		;CAN'T FOR SOME REASON
	MOVX	T1,BF.IBC	;PREVENT ZEROING OF THE BUFFER
	IORM	T1,IBCB(D)
	MOVE	T2,FBLK(D)	;DO INITIAL OUTPUT
	HRRI	T2,.FOOUT
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 $ACALL	OSW
	DMOVE	T1,TPTR(D)	;RESTORE POINTER/COUNT
	DMOVEM	T1,IPTR(D)
	POPJ	P,

CLSOUT:	PUSHJ	P,FICLOS	;CLOSE FILE, RELEASE CHANNEL
	SKIPE	EOFN(D)		;ANYTHING IN FILE?
	 JRST	OSWOPN		;YES. JUST GO OPEN IT
	MOVE	T1,[FO.PRV+FO.ASC+.FOWRT] ;NO. USE SUPERCEDE FOR NULL FILE
	MOVEM	T1,FBLK(D)	;STORE IN FILOP BLOCK
	PUSHJ	P,DOFLP		;OPEN THE FILE
	 $ACALL	OSW		;CAN'T. REPORT IT AND DIE
	PUSHJ	P,FICLOS	;CLOSE FILE, RELEASE CHANNEL
OSWOPN:	MOVE	T1,[FO.PRV+FO.ASC+.FOSAU] ;UPDATE MODE
	MOVEM	T1,FBLK(D)	;STORE IN FILOP BLOCK
	MOVE	T1,EOFN(D)	;GET # BYTES IN FILE
	MOVE	T2,BPW(D)	;GET # BYTES/WORD
	IMULI	T2,200		;GET # BYTES/BLOCK
	ADDI	T1,-1(T2)
	IDIVI	T1,(T2)		;GET # BLOCKS IN FILE
	MOVEM	T1,BLKN(D)	;[4134] SAVE IT
	MOVEM	T1,.RBALC+LKPB(D) ;SETUP TO TRUNCATE FILE
	PUSHJ	P,DOFLP		;Now do the FILOP.
	 $ACALL	OSW		;CAN'T FOR SOME REASON
	LOAD	T1,MODE(D)	;GET MODE
	CAIN	T1,MD.DMP	;DUMP?
	 JRST	CLODMP		;YES, UNFORTUNATELY
	SKIPN	T3,BYTN(D)	;GET BYTE # OF NEXT WINDOW
	 POPJ	P,		;DON'T PROCEED IF NO DATA!
	SUB	T3,WSIZ(D)	;GET BYTE NUMBER OF THIS WINDOW
	MOVE	T2,BPW(D)	;GET # BYTES/WORD
	LSH	T2,9		;GET # BYTES/PAGE
	IDIVI	T3,(T2)		;GET PAGE #, # BYTES LEFTOVER
	IMULI	T3,4		;GET BLOCK #
	ADDI	T3,1		;FIRST BLOCK IS 1
	MOVE	T2,FBLK(D)	;GET CHANNEL STUFF
	HRRI	T2,.FOUSO	;DO USETO TO POINT TO CORRECT PAGE
	MOVE	T1,[2,,T2]	;DO FILOP
	FILOP.	T1,
	 $ACALL	OSW
	POPJ	P,

CLODMP:	MOVE	T3,BLKN(D)	;[4134] GET # BLOCKS IN FILE AGAIN
	ADDI	T3,1		;POINT TO NEXT BLOCK
	MOVE	T2,FBLK(D)	;GET CHANNEL STUFF
	HRRI	T2,.FOUSO	;DO USETO TO NEXT BLOCK IN FILE
	MOVE	T1,[2,,T2]	;SETUP FOR FILOP
	FILOP.	T1,		;SETUP FOR APPENDING
	 $ACALL	OSW
	POPJ	P,

;Routine to CLOSE and then re-OPEN a file for input.
;This will have the effect of clearing the EOF status if set.

%CLSOP:	DMOVE	T1,IPTR(D)	;[4141] GET PNTR/COUNT
	DMOVEM	T1,TPTR(D)	;[4141] SAVE IT
	MOVE	T1,FLAGS(D)	;GET DDB FLAGS
	TXNE	T1,D%OUT	;WAS FILE OPEN FOR OUTPUT?
	 PUSHJ	P,%LSTBF	;YES. OUTPUT LAST BUFFERFUL
	MOVE	T2,FBLK(D)	;GET CHANNEL STUFF
	HRRI	T2,.FOCLS	;CLOSE THE FILE
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 $ACALL CLS		;FAILED. TYPE MSG AND DIE
	MOVE	T2,FBLK(D)
	HRRI	T2,.FOREL	;RELEASE THE CHANNEL
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 $ACALL CLS		;FAILED. TYPE MSG AND DIE
	MOVE	T1,[FO.PRV+FO.ASC+.FORED] ;OPEN IT FOR INPUT
	MOVEM	T1,FBLK(D)
	SETZM	LKPB+.RBALC(D)	;PREVENT TRUNCATION
	MOVX	T0,D%END+D%OUT
	ANDCAM	T0,FLAGS(D)	;Clear flags
	PUSHJ	P,SETFB		;SETUP FILOP BLOCK
	MOVX	T1,SA.UR	;SETUP FOR READ
	STORE	T1,SAIDX(D)
	MOVEI	T1,IBCB(D)	;SETUP FOR INPUT BUFFER
	MOVEM	T1,FBLK+.FOBRH(D)
	LOAD	T1,BUFCT(D)	;SET BUFFERCOUNT
	MOVEM	T1,FBLK+.FONBF(D)
	PUSHJ	P,DOFLP		;Try re-opening the file
	 $ACALL	ISW		;CAN'T FOR SOME OBSCURE REASON
	MOVX	T1,BF.IBC	;[4141] PREVENT ZEROING OF THE BUFFER
	IORM	T1,IBCB(D)	;[4141]
	DMOVE	T1,TPTR(D)	;[4141] RESTORE PNTR/COUNT
	DMOVEM	T1,IPTR(D)	;[4141]
	MOVX	T1,D%IN		;SET FILE TO INPUT
	IORM	T1,FLAGS(D)
	POPJ	P,		;Done, return

%LSTBF:	LOAD	T1,MODE(D)	;GET MODE 
	CAIN	T1,MD.DMP	;DUMP? 
	 POPJ	P,		;YES. DON'T DO ANYTHING!
	PUSHJ	P,%OCLR		;CLEAR UNUSED CHARS IN LAST WORD
	PJRST	%OBUF		;NO. OUTPUT LAST BUFFERFUL

>;END IF10

	SUBTTL	MOVE ARGUMENTS TO DDB


INQARG:	PUSHJ	P,INQCTX	;ENTER INQUIRE CONTEXT
	JRST	COMARG		;JOIN COMMON ARG COPIER

CLSARG:	PUSHJ	P,CLSCTX	;ENTER CLOSE CONTEXT
	JRST	COMARG		;JOIN COMMON ARG COPIER

OPNARG:	PUSHJ	P,OPNCTX	;ENTER OPEN CONTEXT
COMARG:	HLRE	T1,-1(L)	;GET ARG COUNT
	MOVEM	T1,ARGCNT	;SAVE IT

OARGLP:	LDB	T1,[POINTR ((L),ARGKWD)] ;GET NEXT ARG KEYWORD
	MOVEM	T1,KEYVAL	;SAVE IT
	MOVEI	T2,(T1)		;COPY IT
	ADD	T2,DSPPNT	;POINT TO DISPATCH TABLE ENTRY
	CAILE	T1,OPNMAX	;RANGE CHECK
	  SKIPA	T2,[OPNERR]	;OUT OF BOUNDS, ERROR
	HLRZ	T2,(T2)		;POINT TO ROUTINE FOR THIS ARG
	PUSHJ	P,(T2)		;PUT ARG INTO DDB
	ADDI	L,1		;INCR ARG POINTER
	AOSGE	ARGCNT		;DECR COUNT
	 JRST	OARGLP
	SETZM	UNKXST		;[5001] CLEAR "UNKNOWN EXISTENCE" FLAG
	POPJ	P,		;ALL DONE, RETURN

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

CLIGN:	MOVE	T1,KEYVAL	;Get switch number
	MOVEI	T2,OPNSWT	;Switch table
	PUSHJ	P,FNDSWT	;Get t1= addr of ASCII arg.
	 $ECALL	NCK		;%Not a CLOSE keyword, ignored
ARGNOP:	POPJ	P,
	
;+
;  Keyword recognizer for OPEN/CLOSE keywords
;-
OPNKWD:
	MOVEI	T1,ATMBUF	;MOVE ARG TO ATMBUF
	HRLI	T1,(POINT 7)
	MOVEM	T1,DSTBP
	MOVEI	T1,LATOMC
	MOVEM	T1,DSTLEN
	PUSHJ	P,MVARG
	MOVE	T1,KEYVAL	;GET KEY NUMBER
	ADD	T1,DSPPNT	;POINT TO OPEN/CLOSE KEYWORD TABLE ENTRY
	HRRZ	T1,(T1)		;POINT TO SELECTED KEYWORD TABLE
	MOVEI	T2,ATMBUF	;POINT TO KEYWORD
	HRLI	T2,(POINT 7)
	PUSHJ	P,TABLK		;LOOK UP KEYWORD IN TABLE
	  JRST	KWDUNK		;NOT THERE
	  JRST	KWDAMB		;AMBIGUOUS
	  JRST	KWDFND		;FOUND - ADDRESS OF TABLE ENTRY IN T1
;+
; Keyword was found
;-
;
; Get Incompatibility_Flag and display message (if necessary).
;
KWDFND:	MOVEM	T1,KEYADR	;Save the table_entry_address.
	SKIPN	%FLIDX		;Any flagging being done?
	 JRST	KWDFN1		;No. Skip this slow stuff
	MOVE	T1,KEYVAL	;SetUp pointer to keyword number
	MOVE	T2,[OPNSWT]	;SetUp pointer to  keyword table
	PUSHJ	P,FNDSWT	;Return address of keyword string (in t1)

	MOVE	T3,KEYADR	;Fetch the table_entry_address.
	HLRZ	T2,(T3)		;Get the address of Keyword value String.
	
	HRRZ	T3,(T3)		;Get address of Flags,,Value
	HLRZ	T3,(T3)		;Get (only) the Incompat_Flags
	TDNE	T3,%FLIDX	;Any flags the same?
	 $ECALL	CFK		;Yes, Go display appropriate message.
;
; Get the DDB_Keyword_value, then go store it into the ddb
;
KWDFN1:	MOVE	T1,KEYADR	;Fetch the keyword table entry address.
	HRRZ	T2,(T1)		;Get address of [Flags,,Value]
	HRRZ	T2,(T2)		;Get Keyword_Value from RH 
	JRST	OPNDPB		;Go store it in DDB
;+
; Keyword is Unknown
;-
KWDUNK:	XMOVEI	P2,[ASCIZ /Unknown/]
	 TRNA
;+
; Keyword is Ambiguous
;-
KWDAMB:	XMOVEI	P2,[ASCIZ /Ambiguous/]
	MOVE	T1,KEYVAL	;GET KEYWORD NUMBER
	MOVEI	T2,OPNSWT	;POINT TO SWITCH TABLE
	PUSHJ	P,FNDSWT	;FIND ASCII NAME OF SWITCH
	XMOVEI	T5,ATMBUF	;Point to atom buffer
	$DCALL	ESV		;UNKNOWN OR AMBIGUOUS KEYWORD
;+
; Open error
;-
OPNERR:	$ECALL	UOA		;UNKNOWN $A KEYWORD
	POPJ	P,

OPNINT:	SKIPL	T2,@(L)		;GET ARG
	 JRST	OPNDPB		;Go store it in DDB
	MOVE	T1,KEYVAL	;GET KEYWORD NUMBER
	MOVEI	T2,OPNSWT	;[5000] POINT TO SWITCH TABLE
	PUSHJ	P,FNDSWT	;FIND ASCII NAME OF SWITCH
	MOVEM	T1,%ARGNM	;SAVE IT FOR ERROR
	$DCALL	IAV		;MUST BE POSITIVE OR ZERO

OPNADR:	XMOVEI	T2,@0(L)	;Get arg address
	JRST	OPNDPB		;GO STORE IT IN DDB

OPNSET:	MOVEI	T2,1		;[3115]Get a turned-on-bit
OPNDPB:	MOVE	T1,KEYVAL	;GET KEYWORD NUMBER into t1
				;T2 usually contains keyword value
	XCT	OPSTOR(T1)	;STORE IN DDB
	POPJ	P,

PADCHR:	LDB	T2,[POINT 7,@(L),6] ;GET FIRST CHAR OF STRING
	LDB	T1,[POINTR ((L),ARGTYP)] ;[3115]Get arg type
	CAIE	T1,TP%CHR	;[3115]Character string?
	 JRST	STOPAD		;[3115]NO.
	MOVE	T2,@(L)		;[3115]Load descriptor
	ILDB	T2,T2		;[3115]Load the character
STOPAD:	STORE	T2,PADCH(U)	;STORE IN DDB
	MOVEI	T1,1		;AND FLAG WE GOT ONE
	STORE	T1,PADSP(U)
	POPJ	P,		;RETURN


;Get next char from source string
;Returns char in T1
;SRCLEN= # chars possibly left to parse

DPRCHR:	SOSGE	SRCLEN		;DECR COUNT
	 JRST	DPRNUL		;RETURN NULL IF STRING RAN OUT
	ILDB	T1,SRCBP
	POPJ	P,		;Return

DPRNUL:	IBP	SRCBP		;POINT TO NEXT CHAR
	SETZ	T1,		;RETURN NULL
	POPJ	P,

OPNDEV:	SETOM	FILPRS(D)	;SET FILESPEC PARSED
	MOVEI	T1,DEV(D)	;POINT TO DEVICE FIELD
	HRLI	T1,(POINT 7)
	MOVEM	T1,DSTBP
	MOVEI	T1,LDEVC	;AND GET ITS LENGTH
	MOVEM	T1,DSTLEN
	MOVEI	T2,":"		;STOP ON COLON
	PJRST	MVAWD		;MOVE DEVICE NAME
IF20,<

OPNDIR:	SETOM	FILPRS(D)	;SET FILESPEC PARSED
	MOVE	T1,@(L)		;GET FIRST WORD OF ARG
	TLNN	T1,(177B6)	;LEADING ASCII CHAR NULL?
	  JRST	OPNPPN		;YES, IT'S A PPN

	MOVEI	T1,DIRNAM(D)	;MOVE ARG TO DIRNAM
	HRLI	T1,(POINT 7)
	MOVEM	T1,DSTBP
	MOVEI	T1,LDIRC
	MOVEM	T1,DSTLEN
	PJRST	MVARRY		;MOVE ARGUMENT

OPNPPN:	TLNE	T1,-1		;PROJECT NUMBER IN LH?
	 JRST	OPNPP1		;YES, XWD FORMAT
	HRLZ	T1,T1		;No, doubleword format
	XMOVEI	T2,@(L)		;GET ADDR OF ARRAY
	HRR	T1,1(T2)	;GET PROGRAMMER NUMBER
OPNPP1:	MOVEM	T1,PPNSTR(D)	;[4135] SAVE IT
	POPJ	P,		;[4135]

PPNDIR:	SKIPN	T2,PPNSTR(D)	;[4135] PUT IT IN PROPER PLACE FOR TRANSLATION
	 POPJ	P,		;[4135] NONE THERE
	HRROI	T1,ATMBUF	;TRANSLATE PPN TO DIRECTORY STRING
	HRROI	T3,DEV(D)	;POINT TO DEVICE NAME
	PPNST%			;TRANSLATE IT
	 $DJCAL	PPN		;CAN'T

	MOVE	T1,[POINT 7,ATMBUF] ;INITIALIZE STRING POINTER
	MOVEM	T1,SRCBP
	MOVEM	T1,DSTBP	;MOVE STRING TO SELF
	MOVEI	T1,LATOMC	;AND COUNT
	MOVEM	T1,SRCLEN
	MOVEM	T1,DSTLEN
	MOVEI	T2,.CHLAB	;UNTIL START OF DIRECTORY NAME
	SETZM	DIARRY		;NOT AN ARRAY
	PUSHJ	P,MOVARG	;SKIP TO LEFT ANGLE BRACKET

	MOVEI	T1,DIRNAM(D)	;NOW POINT TO REAL DESTINATION
	HRLI	T1,(POINT 7)
	MOVEM	T1,DSTBP
	MOVEI	T1,LDIRC	;AND GET DEST SIZE
	MOVEM	T1,DSTLEN
	MOVEI	T2,.CHRAB	;TERMINATE ON END OF DIRECTORY NAME
	SETZM	DIARRY		;NOT AN ARRAY
	PJRST	MOVARG		;MOVE DIRECTORY TO DDB, RETURN

SETPRO:	SETOM	FILPRS(D)	;SET FILESPEC PARSED
	LSH	T2,<<^D12-PRTDIG>*3> ;LEFT-JUSTIFY THE PROTECTION CODE
	MOVEI	T0,PRTDIG	;GET DIGIT COUNT
	MOVEI	T3,PROT(D)	;POINT TO PROTECTION BUFFER
	HRLI	T3,(POINT 7,)	; FOR CONVERSION TO ASCIZ

PRTLP:	SETZ	T1,		;CLEAR THE AC
	LSHC	T1,3		;MOVE A DIGIT TO T1
	ADDI	T1,"0"		;CONVERT TO ASCII
	IDPB	T1,T3		;STORE IN BUFFER
	SOJG	T0,PRTLP	;DO 6 DIGITS

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

SETFSZ:	POPJ	P,		;[3340] FILESIZE not applicable


>;END IF20
IF10,<

OPNDIR:	SETOM	FILPRS(D)	;SET FILESPEC PARSED
	LDB	T1,[POINTR ((L),ARGTYP)] ;GET ARG TYPE
	CAIE	T1,TP%CHR	;[3150] CHARACTER?
	 CAIN	T1,TP%LIT	;ASCIZ LITERAL?
	  JRST	OPPNST		;YES

	MOVEI	T1,DIRNAM(D)	;POINT TO DIRECTORY NAME BUFFER
	HRLI	T1,(POINT 7)	;MAKE IT A BYTE POINTER
	MOVEM	T1,FNSPNT	;SAVE FOR TRANSLATION ROUTINES

	LDB	T1,[POINTR ((L),ARGTYP)] ;GET ARG TYPE AGAIN
	MOVE	P1,%SIZTB(T1)	;GET ELEMENT SIZE IN WORDS
	XMOVEI	P3,@(L)		;GET ARRAY ADDR
	MOVE	T1,(P3)		;GET FIRST WORD OF ARG
	JUMPE	T1,%POPJ	;ZERO MEANS DEFAULT PATH
	TLNN	T1,-1		;PROJECT NUMBER IN LH?
	 JRST	GETPRG		;NO. GET PROGRAMMER NUMBER
	ADDI	P3,(P1)		;POINT TO PATHS
	JRST	OPNPP1		;SKIP GETTING PROG #

GETPRG:	HRLZ	T1,T1		;NO, DOUBLEWORD FORMAT
	HRR	T1,1(P3)	;PUT IN PROGRAMMER NUMBER
	ADDI	P3,2		;POINT TO PATHS

OPNPP1:	PUSHJ	P,XWDASC	;OUTPUT AS A STRING

	MOVEI	P2,5		;5 SFD'S
OPPNLP:	SKIPN	(P3)		;END OF LIST?
	 JRST	OPPNUL		;YES. GO DEPOSIT A NULL
	MOVEI	T1,","		;PUT IN A COMMA
	IDPB	T1,FNSPNT
	MOVEI	T1,(P3)		;GET AN SFD POINTER
	HRLI	T1,(POINT 7)
	MOVEI	T2,5		;5 CHARS/WORD
	IMULI	T2,(P1)		;GET # CHARS/SFD
	PUSHJ	P,ASCASC	;TRANSLATE TO ASCII
	ADDI	P3,(P1)		;POINT TO NEXT PATH
	SOJG	P2,OPPNLP	;COPY WHOLE THING
OPPNUL:	SETZ	T1,		;DEPOSIT A NULL AT END
	IDPB	T1,FNSPNT
	POPJ	P,		;DONE

OPPNST:	MOVEI	T1,DIRNAM(D)	;MOVE ARG TO DIRNAM
	HRLI	T1,(POINT 7)
	MOVEM	T1,DSTBP
	MOVEI	T1,LDIRC
	MOVEM	T1,DSTLEN
	PJRST	MVARRY		;MOVE ARGUMENT

PPNDIR:	POPJ	P,		;[4135] PPN IS THE FORMAT ON TOPS-10

SETPRO:	SETOM	FILPRS(D)	;SET FILESPEC PARSED
	DPB	T2,[POINTR (LKPB+.RBPRV(D),RB.PRV)] ;STORE IN DDB
	POPJ	P,

SETFSZ:	IDIVI	T2,^D128	;[3340] Convert FILESIZE to blocks
	SKIPE	T3		;[3340] Round up
	 ADDI	T2,1		;[3340] 
	MOVEM	T2,LKPB+.RBEST(D) ;[3340] Store in DDB
	POPJ	P,		;[3340]

>;END IF10


OPNDIA:	LDB	T1,[POINTR ((L),ARGTYP)] ;ANY ARGTYPE?
	JUMPE	T1,RQDIAX	;NO. SET TO DO TTY DIALOG
	MOVE	T1,(L)		;YES. GET IT
	MOVEM	T1,O.DIAS	;SAVE IT FOR LATER
	POPJ	P,

RQDIAX:	SETOM	O.DIAL		;SET FLAG FOR DIALOG REQUESTED
	POPJ	P,		;RETURN FROM ROUTINE CONTAINING ERROR

;HERE TO MOVE FILE= OR DIALOG= STRING TO TEXT BUFFER

DIABLT:	LDB	T3,[POINTR STRARG,ARGTYP] ;GET ARG TYPE
	CAIE	T3,TP%CHR	;[3115]Character string?
	  JRST	DIANST		;[3115]NO.
	DMOVE	P3,@STRARG	;[3115]Load byte pointer & length
	MOVEM	P3,SRCBP	;[3115]Store pointer
	JRST	DIAFC		;[3115]Go move string

DIANST:	XMOVEI	P3,@STRARG	;GET ADDRESS OF LITSTRING
	$BLDBP	P3		;BUILD A BYTE POINTER
	MOVEM	P3,SRCBP	;SAVE IT
	MOVE	P4,%SIZTB(T3)	;GET SIZE OF VARIABLE IN WORDS
	IMULI	P4,IBPW		;GET IT IN CHARS
	SKIPN	DIARRY		;CAN IT BE AN ARRAY?
	 CAIN	T3,TP%LIT	;OR IS IT A LITSTRING?
	  MOVEI	P4,-1		;YES. USE 2**18-1
DIAFC:	MOVE	T2,[POINT 7,%TXTBF] ;POINT TO BUFFER
	SETZ	T4,		;CLEAR COUNT OF CHARS TRANSFERRED
DIAFCL:	ILDB	T1,SRCBP	;GET A BYTE
	JUMPE	T1,DIAEFC	;SKIP IT IF NULL
	CAIE	T1," "		;OR SPACE
	 JRST	DIABL2		;DEPOSIT IF ANYTHING ELSE
DIAEFC:	SOJG	P4,DIAFCL	;GO SKIP MORE LEADING NULLS OR SPACES
	JRST	DIAEND		;NULL STRING

DIABL1:	ILDB	T1,SRCBP	;GET BYTE FROM ARG
	JUMPE	T1,DIAEND	;NULL, DONE
	CAIE	T1," "		;SPACE?
	 JRST	DIABL2		;NO. GO STORE IT
	CAIE	T3,TP%CHR	;TYPE CHARACTER?
	 CAIN	T3,TP%LIT	;OR LITERAL?
	  JRST	DIASKB		;YES. SKIP IT
	SKIPN	DIARRY		;CAN IT BE AN ARRAY?
	 JRST	DIASKB		;NO. SKIP IT (MIGHT BE FILE .EXT)
	JRST	DIAEND		;YES. SPACE ENDS DIALOG STRING

DIABL2:	CAILE	T4,LTEXTC-1	;CHECK LENGTH BEFORE MOVING CHAR
	 $DCALL	DTL		;DIALOG STRING TOO LONG
	IDPB	T1,T2		;STORE CHAR
	ADDI	T4,1		;INCR # CHARS ACTUALLY TRANSFERRED
DIASKB:	SOJG	P4,DIABL1	;LOOP

IF20,<
DIAEND:	MOVEM	T4,SRCLEN	;SAVE # CHARACTERS TRANSFERRED
	MOVEI	T1,12		;TERMINATE WITH LF
	IDPB	T1,T2
	ADDI	T4,2		;COUNT IT AND ADD 1
	MOVEM	T4,CSB+.CMINC	;STORE IN CSB AS IF TEXTI HAD READ THE STRING
	POPJ	P,		;RETURN TO DIALOG SCANNER
> ;END IF20

IF10,<
DIAEND:	MOVEM	T4,SRCLEN	;SAVE # CHARACTERS TRANSFERRED
	SETZ	T1,		;TERMINATE WITH NULL
	IDPB	T1,T2
	MOVE	T1,[POINT 7,%TXTBF] ;POINT TO BEG OF BUFFER AGAIN
	MOVEM	T1,SRCBP
	POPJ	P,		;DONE
> ;END IF10



;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
> ;END IF20

IF10,<
TABLK:	MOVEM	T2,STRADD	;SAVE STRING ADDRESS
	XMOVEI	T1,(T1)		;EXTEND TABLE ADDRESS
	HRRZ	T2,(T1)		;GET TABLE COUNT
	MOVEM	T2,TABCNT	;SAVE IT
	ADDI	T1,1		;POINT TO FIRST ENTRY
	MOVEM	T1,TABADD	;SAVE TABLE ADDRESS

TABLP:	HLRZ	T1,@TABADD	;GET ADDRESS OF A VALUE STRING
	MOVE	T1,(T1)		;GET 1ST WORD OF STRING
	TLNN	T1,774000	;ANY CHAR IN FIRST POSITION?
	 TXNN	T1,CM%FW	;NO. FLAG WORD?
	  JRST	CHKAMB		;CHAR THERE OR NO FLAG WORD. GO ON
	TXNE	T1,CM%ABR	;[4205] IS THERE AN "UNAMBIGUOUS" ENTRY?
	 JRST	TABUNA		;[4205] YES. GO SEE IF IT'S A MATCH!

CHKAMB:	PUSHJ	P,TABCMP	;NO. TRY THE REGULAR GRIND
	 JRST	TABNXT		;DOES NOT MATCH. GO ON
	  JRST	TABEXA		;EXACT MATCH
	AOS	TABADD		;NON-EXACT MATCH. GO TO NEXT ONE
	SOSG	TABCNT		;DECR TABLE COUNT
	 JRST	TABMAT		;NONE LEFT. WE HAVE A MATCH
	PUSHJ	P,TABCMP	;COMPARE AGAIN
	 JRST	TABMAT		;NEXT ONE DOES NOT MATCH, SO WE'VE GOT IT
	  $SNH			;SHOULDN'T GET 2 EXACT MATCHES!
	JRST	%POPJ1		;AMBIGUOUS

TABUNA:	PUSHJ	P,TABCMP	;COMPARE THE STRINGS
	 JRST	TABNXT		;TOO BAD, NOT A MATCH
	  NOP			;EXACT MATCH IS OK TOO
	HRRZ	T1,@TABADD	;GET ADDRESS OF MATCHING ENTRY
	XMOVEI	T1,(T1)		;EXTEND THE ADDRESS
	JRST	%POPJ2		;RETURN SUCCESS

TABEXA:	MOVE	T1,TABADD	;GET MATCHING ADDRESS
	JRST	%POPJ2		;RETURN SUCCESS

TABMAT:	SOS	T1,TABADD	;GET MATCHING ADDRESS
	JRST	%POPJ2		;RETURN SUCCESS

TABNXT:	AOS	TABADD		;INCREMENT TABLE ADDRESS
	SOSLE	TABCNT		;DECR COUNT
	 JRST	TABLP		;LOOP
	POPJ	P,		;RETURN NOT FOUND

TABCMP:	HLRZ	T1,@TABADD	;GET VALUE ADDRESS
	MOVE	T2,(T1)		;GET THE FIRST WORD OF IT
	TLNN	T2,774000	;ANY CHAR IN FIRST POSITION?
	 TLNN	T2,(CM%FW)	;NO. FLAG WORD?
	  JRST	TABAMB		;CHAR THERE OR NO FLAG WORD. GO ON
	ADDI	T1,1		;YES. UNAMBIGUOUS TABLE ENTRY
TABAMB:	HRLI	T1,(POINT 7)	;MAKE IT A POINTER
	MOVE	T3,STRADD	;POINT TO STRING
	HRLI	T3,(POINT 7)	;MAKE IT A POINTER TOO
TABCLP:	ILDB	T2,T1		;GET A CHAR
	JUMPE	T2,ENDMAT	;IF NULL, WE MATCHED UP TO HERE
	ILDB	T4,T3		;GET A STRING CHAR
	JUMPE	T4,%POPJ2	;IF NULL, WE MATCHED NON-EXACTLY
	CAIN	T2,(T4)		;CHARS EQUAL?
	 JRST	TABCLP		;YES. LOOP UNTIL ONE IS NULL
	POPJ	P,		;NO. NON-MATCH RETURN

ENDMAT:	ILDB	T4,T3		;GET NEXT CHAR FROM STRING
	JUMPE	T4,%POPJ1	;IF NULL, WE MATCH EXACTLY
	POPJ	P,		;IF NOT, WE DID NOT MATCH AT ALL!

> ;END IF10

;ROUTINE TO MOVE AN ASCII ARGUMENT TO SOME LOCAL BUFFER
;ARGS:	 T1 = ADDRESS OF 16-WORD BUFFER TO PUT ARG IN
;	 L = ADDRESS OF FORTRAN ARGUMENT POINTER
;RETURNS WITH ARGUMENT MOVED
;MVARG SETS NO DELIMITER. MVAWD EXPECTS A DELIMITER IN T2.

MVARRY:	SETZ	T2,		;NO DELIMITER - TRANSFER ENTIRE STRING
	SETOM	DIARRY		;INPUT CAN BE AN ARRAY
	PUSHJ	P,MAKEBP	;SETUP SOURCE BYTE POINTER
	PJRST	MOVARG		;GO MOVE THE STRING

MVARG:	SETZ	T2,		;NO DELIMITER - TRANSFER ENTIRE STRING
MVAWD:	SETZM	DIARRY		;INPUT CANNOT BE AN ARRAY
	PUSHJ	P,MAKEBP	;GET SRCBP = 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
;	 SRCLEN = NUMBER OF CHARS IN STRING

MAKEBP:	LDB	T4,[POINTR ((L),ARGTYP)] ;GET ARG TYPE
	CAIN	T4,TP%CHR	;character string?
	 JRST	BPCHAR		;YES. GO GET IT FROM DESCRIPTOR
	XMOVEI	T3,@0(L)	;Point to arg
	$BLDBP	T3		;Build a byte ptr.
	MOVEM	T3,SRCBP	;Store in SRCBP.
	CAIN	T4,TP%LIT	;LITERAL?
	 JRST	MBPLIT		;YES. GO SET MAX COUNT
	MOVE	T1,%SIZTB(T4)	;GET # WORDS/ENTRY
	IMULI	T1,IBPW		;GET # CHARS/ENTRY
	SKIPE	DIARRY		;BUT IF IT IS AN ARRAY
	 MOVEI	T1,-1		;SETUP FOR SEMI-INFINITE COUNT
	MOVEM	T1,SRCLEN	;SAVE IT
	POPJ	P,		;DONE

MBPLIT:	SETZM	DIARRY		;IT IS NOT AN ARRAY
	MOVEI	T1,-1		;SETUP FOR MAX COUNT
	MOVEM	T1,SRCLEN	;SAVE IT
	POPJ	P,

BPCHAR:	SETZM	DIARRY		;IT IS NOT AN ARRAY
	DMOVE	T3,@0(L)	;GET DESCRIPTOR
	MOVEM	T3,SRCBP	;SAVE BYTE POINTER
	MOVEM	T4,SRCLEN	;SAVE IT
	POPJ	P,


;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:	 DSTBP = 30-BIT ADDRESS OF BLOCK TO PUT STRING INTO
;	 DSTLEN = DESTINATION CHAR COUNT
;	 SRCBP = Ptr to arg.
;	 SRCLEN = SOURCE CHAR COUNT
;	 T2 = BREAK CHARACTER
;
;RETURN: T1 = CHAR THAT TERMINATED ARG, OR LAST CHAR IF SOURCE STRING EXHAUSTED
;	 SRCBP, SRCLEN UPDATED

MOVARG:
BMVALP:	SOSGE	SRCLEN		;DECR COUNT
	 JRST	MVAEND		;COUNT EXHAUSTED
	ILDB	T1,SRCBP	;GET A BYTE
	JUMPE	T1,MVAEND	;DONE IF NULL
	CAIE	T1,' '		;SKIP LEADING BLANKS
	 JRST	MVAL1		;NON-BLANK CHAR
	JRST	BMVALP		;SKIP IT

MVALP:	SOSGE	SRCLEN		;DECR COUNT
	 JRST	MVAEND		;STRING EXHAUSTED
	ILDB	T1,SRCBP	;GET A BYTE
	JUMPE	T1,MVAEND	;NULL, DONE
MVAL1:	CAIN	T1,(T2)		;BREAK CHAR?
	 JRST	MVAEND		;BREAK CHAR. DONE

	CAIE	T1," "		;SPACE?
	 JRST	MVACVT		;NO

	SKIPE	DIARRY		;INPUT FROM ARRAY?
	 JRST	MVAEND		;YES. END ON SPACE CHAR
	JRST	MVALP		;NO. IGNORE IT

MVACVT:	CAIL	T1,"a"		;CONVERT LOWER CASE TO UPPER CASE
	CAILE	T1,"z"
	  JRST	.+2		;NOT LC
	SUBI	T1,40		;LC, CONVERT

	SOSLE	DSTLEN		;DECR DEST COUNT
	 IDPB	T1,DSTBP	;IF ROOM, STORE CHAR IN DEST STRING
	JRST	MVALP		;COPY ENTIRE STRING

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


	SEGMENT DATA

SRCBP:	BLOCK	1		;Source byte ptr
SRCLEN:	BLOCK	1		;LENGTH
DSTBP:	BLOCK	1		;Destination byte ptr
DSTLEN:	BLOCK	1		;LENGTH
%ARGNM: BLOCK	1		;Addr of ASCII name of arg.
STRARG:	BLOCK	1		;COMMON STRING ARG POINTER
DIARRY:	BLOCK	1		;0=CANNOT BE AN ARRAY


	SEGMENT CODE

DECNAS:	MOVEI	T3,(T2)		;SAVE # DIGITS TO GET FROM NUMBER
DECNA1:	IDIVI	T1,12
	PUSH	P,T2
	SOJLE	T3,DECNA2
	PUSHJ	P,DECNA1	;GO ENCODE NEXT DIGIT
DECNA2:	POP	P,T1		;GET A DIGIT
	ADDI	T1,"0"		;CONVERT TO ASCII
	IDPB	T1,FNSPNT	;PUT IN BUFFER
	POPJ	P,		;BACK FOR MORE OR RETURN

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

;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


;CONVERT ASCII TO SIXBIT. NON-SKIP RETURN IF BAD CHAR

ASCSIX:	MOVE	T3,[POINT 6,ATMBUF]
	SETZM	ATMBUF
DPRS3A:	PUSHJ	P,DPRCHR	;Get next char
	JUMPE	T1,%POPJ1	;Return if done
	CAIN	T1,","		;Comma 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

;Translate char in T1 to sixbit
;Must be a letter or number
;Returns .+1 if problem, .+2 if ok

DPRCSX:	CAIL	T1,140		;LOWER CASE CHAR?
	 SUBI	T1,40		;YES. CONVERT TO UPPER CASE
	CAIG	T1,"Z"		;ALPHANUMERIC?
	 CAIGE	T1,"A"
	CAIG	T1,"9"
	 CAIGE	T1,"0"
	  POPJ	P,		;NO. NON-SKIP RETURN
	SUBI	T1,40		;CONVERT TO SIXBIT
	JRST	%POPJ1		;AND SKIP RETURN


;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 ((L),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 ((L),ARGKWD)] ;STORE IN LOCAL ARG LIST

	HLRE	T2,-1(L)	;GET NEGATIVE # ARGS
	MOVEI	T1,OK.ERR	;GET KWD VALUE FOR /ERR
	CAMLE	T2,[-3]		;AT LEAST 3 ARGS PRESENT?
	 POPJ	P,		;No, done
	DPB	T1,[POINTR (2(L),ARGKWD)] ;Store /ERR keyword
	POPJ	P,		;Return

	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.

	&

;OPDFLT - POST-ARG DEFAULT PROCESSING
;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,DFBUF   	;BUFFER COUNT
	PUSHJ	P,DFACC		;ACCESS	[INTERACTS WITH /READONLY]
	PUSHJ	P,CHKFRM	;FORM	[IF SET, SETS DEFAULT MODE]
	PUSHJ	P,CHKMOD	;MODE	[IF SET, SETS DEFAULT FORM]
	PJRST	DFPAD		;IF NO PADCHAR, SETUP DEFAULT


DFFILE:	LOAD	T1,STAT(D)	;GET STATUS
	CAIN	T1,ST.SCR	;SCRATCH?
	 JRST	SCRDEF		;YES. GET SCRATCH FILENAME DEFAULT
	MOVE	T1,[ASCII "FOR0"] ;GET PART OF DEFAULT FILENAME
	MOVEM	T1,FILNAM(D)	;STORE IN DDB
	HXRE	T1,UNUM(U)	;GET UNIT NUMBER
	JUMPL	T1,DFFILX	;NEGATIVE UNITS ARE SPECIAL
	MOVE	T2,[POINT 7,FILNAM(D),27] ;POINT TO AFTER "FOR0"
	CAIL	T1,^D10		;UNLESS UNIT NUMBER IS OVER 10
	 MOVE	T2,[POINT 7,FILNAM(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,FILNAM(D)	;SAVE IN DDB

DFEXT:	MOVE	T1,DATEXT	;SET DEFAULT EXTENSION
	MOVEM	T1,EXT(D)
	MOVE	T1,DATGEN	;SET DEFAULT GENERATION
	MOVEM	T1,GEN(D)
	POPJ	P,


IF20,<

DATGEN:	ASCIZ	/0/		;ZERO IS GENERATION DEFAULT

;*** SPOOLED LPT HAS DVTYP(D)=.DVLPT

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,DSKDEF	;NO, USE DEFAULT
	MOVEM	T1,DEV(D)	;STORE DEVICE NAME
	POPJ	P,		;Return

;Routine to check out device and get information about it

DFDEV1:	SKIPE	NODNAM(D)	;[5000] REMOTE FILESPEC?
	 JRST	SETRDV		;[5000] YES, DON'T QUERY REMOTE DEVICES
	HRRI	T1,DEV(D)	;POINT TO DEVICE NAME
	HRLI	T1,(POINT 7)
	STDEV%			;GET DEVICE DESIGNATOR
	 ERJMP	NSDCHK		;CHECK FOR GOOD DEVICE AFTER BAD ONE
DEVOK:	MOVEM	T2,DVICE(D)	;SAVE IT

;[4250] Check to see if this job is detached. If this job is detached 
;[4250] we cannot do a DEVST JSYS (cause it will wait for a terminal 
;[4250] to attach to it).

	SETO	T1,T1		;[4250]Current Job
	MOVE	T2,[-1,,T1]	;[4250]Return result in T1
	XMOVEI	T3,1		;[4250]we only want word 1
	GETJI			;[4250]Get the job info
	 $SNH			;[4250]Shouldn't happen!
	SKIPG	T1		;[4254]Is this job detached?
	 JRST	NOTTTY		;[4250]Yes,Device cant be controling TTY

	MOVX	T2,.CTTRM	;CHECK AGAINST CONTROLLING TERMINAL
	HRROI	T1,ATMBUF	;TRANSLATE CONTROLLING TTY TO STRING
	DEVST%
	 JSHALT			;SHOULDN'T FAIL
	HRROI	T1,ATMBUF	;POINT TO STRING
	STDEV%			;GET DEVICE DESIGNATOR
	 JSHALT
	CAME	T2,DVICE(D)	;SAME AS DEV(D)?
	 JRST	NOTTTY		;NO
	MOVX	T1,.CTTRM	;YES. SET DVICE TO CONTROLLING TTY
	MOVEM	T1,DVICE(D)

NOTTTY:	MOVE	T1,DVICE(D)	;GET DEVICE DESIGNATOR
	DVCHR%			;GET DEVCHR WORD
	MOVEM	T2,DVBTS(D)	;SAVE IT

;HERE FIGURE OUT IF DEVICE IS "ASCII-ONLY". IF IT IS,
;SET IMGFLG(D), WHICH WILL PREVENT UNFORMATTED (BINARY)
;I/O FROM READING/WRITING LSCW'S.

	SETZM	IMGFLG(D)	;[4164] CLEAR THE ASCII-ONLY (IMAGE) FLAG
	LOAD	T1,MODE(D)	;[4164] GET FORTRAN DATA MODE
	CAIN	T1,MD.IMG	;[4164] IMAGE?
	 SETOM	IMGFLG(D)	;[4164] YES. SET FLAG
	LOAD	T1,DVTYP(D)	;Get device type
	CAIE	T1,.DVLPT	;LINE PRINTER?
	 CAIN	T1,.DVTTY	;OR TERMINAL?
	  SETOM	IMGFLG(D)	;YES. SET ASCII-ONLY
	CAIE	T1,.DVPLT	;PLOTTER?
	 CAIN	T1,.DVPTY	;OR PTY?
	  SETOM	IMGFLG(D)	;YES. SET ASCII-ONLY
	JRST	SETIND		;[5000]

;[5000] Here when file is remote to set DVTYP to .DVDSK and DVBTS.

SETRDV:	MOVEI	T1,.DVDSK	;[5000] Disk
	STORE	T1,DVTYP(D)	;[5000] Set it as device type
	MOVE	T2,DVBTS(D)	;[5000] Get device bits
	TXO	T2,DV%IN!DV%OUT	;[5000] Allow access
	MOVEM	T2,DVBTS(D)	;[5000] Save

;Figure out appropriate INDX(D) -- device type index

SETIND:	MOVEI	T2,DI.OTHR	;[5000] Guess type "other"
	CAIN	T1,.DVDSK	;Disk?
	 MOVEI	T2,DI.DSK	;Yes
	CAIN	T1,.DVMTA	;Tape?
	 MOVEI	T2,DI.MTA	;Yes
	CAIE	T1,.DVPTY	;PTY?
	 CAIN	T1,.DVTTY	;TTY?
	  MOVEI	T2,DI.TTY
	LOAD	T3,RECTP(D)	;[5000] Check RECORDTYPE
	CAIN	T3,RT.UND	;[5000] If STREAM
	 MOVEI	T2,DI.DSK	;[5000] assume it's local disk
	SKIPE	NODNAM(D)	;[5000] Remote file?
	 MOVEI	T2,DI.RSF	;[5000] Yes, assume remote stream
	LOAD	T3,ORGAN(D)	;[5000] Get ORGANIZATION
	SKIPE	T3		;[5000] If any given, assume RMS
	 MOVEI	T2,DI.RMS	;[5000]
	CAIN	T1,.DVMTA	;[5000] Unless it's a magtape
	 MOVEI	T2,DI.MTA	;[5000]
	STORE	T2,INDX(D)	; . .
	CAIN	T2,DI.MTA	;[4161] MAGTAPE?
	 PUSHJ	P,MTADEF	;[4161] YES. SETUP CERTAIN DEFAULTS
	PUSHJ	P,FIXCC		;SETUP CARRIAGECONTROL
	LOAD	T2,INDX(D)	;[5000] GET INDEX BACK
	CAIE	T2,DI.RMS	;[5000] IF RMS IS TO BE INVOKED...
	CAIN	T2,DI.RSF	;[5000]
	 TRNA			;[5000] CHECK IF RMS IS AVAILABLE
	JRST	%POPJ1		;No error--Skip return
	PUSHJ	P,FNDRMS	;[5000] SEE IF RMS IS AROUND
	 POPJ	P,		;[5000] NOT, TAKE ERROR RETURN
	JRST	%POPJ1		;[5000] YES, OK RETURN

SCRDEF:	MOVEI	T1,FILNAM(D)	;GET POINTER TO FILENAME ENTRY
	HRLI	T1,(POINT 7)
	MOVEM	T1,FNSPNT
	XMOVEI	T1,[ASCIZ/FOROTS-JOB-/]
	PUSHJ	P,ASCFNS	;PUT INTO STRING
	MOVE	T1,%JIBLK+.JIJNO ;GET JOB NUMBER
	PUSHJ	P,DNFNS		;PUT INTO STRING
	XMOVEI	T1,[ASCIZ /-UNIT-/]
	PUSHJ	P,ASCFNS	;PUT INTO STRING
	MOVE	T1,%CUNIT	;GET UNIT NUMBER
	PUSHJ	P,DNFNS		;PUT INTO STRING
	XMOVEI	T1,[ASCIZ/-SCRATCH-FILE/]
	PUSHJ	P,ASCFNS	;PUT INTO STRING
	SETZ	T1,
	IDPB	T1,FNSPNT	;END WITH NULL
	MOVE	T1,[ASCIZ /TMP/] ;TEMP FILE
	MOVEM	T1,EXT(D)
	MOVE	T1,DATGEN	;SET DEFAULT GENERATION
	MOVEM	T1,GEN(D)
	POPJ	P,

;HERE DO A LOOKUP TO STEP PAST THE BAD DEVICE
;ONTO A GOOD DEVICE, AND DO AN STDEV% JSYS ON IT AND RETURN. IF
NSDCHK:	PUSHJ	P,DLOOK		;LOOKUP FILE
	 JRST	BADNSD		;LOOKUP ALSO FAILED, GIVE MSG AND DIE
	HRROI	T1,ATMBUF	;GET DEVICE FROM OPEN JFN
	MOVE	T2,IJFN(D)	;GET JFN
	MOVX	T3,FLD(.JSAOF,JS%DEV)
	JFNS%
	 JSHALT			;CAN'T FAIL
	PUSHJ	P,RELJFN	;NOW RELEASE THE JFN
	HRROI	T1,ATMBUF	;POINT BACK AT DEVICE NAME
	STDEV%			;GET A VALID DEVICE DESIGNATOR
	 JSHALT			;SHOULD NOT FAIL NOW
	JRST	DEVOK		;GO BACK TO COMMON CODE

BADNSD:	PUSHJ	P,RELJFN	;[4135] RELEASE THE JFN
	XMOVEI	T1,DEV(D)	;POINT TO BAD DEVICE NAME
	 $DCALL NSD		;NO SUCH DEVICE

> ;END IF20

;***TY.SPL & TY.VAR

IF10,<

DATGEN:	0			;NULL GENERATION NUMBER FOR TOPS-10

SCRDEF:	POPJ	P,		;SCRATCH DOES NOTHING HERE ON TOPS-10

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
	MOVE	T2,[POINT 7,DEV(D)] ;POINT TO DESTINATION FOR DEVICE
	PUSHJ	P,DECASC	;CONVERT UNIT TO DECIMAL ASCIZ STRING
	MOVEI	T1,DEV(D)	;NOW GET IT AGAIN
	HRLI	T1,(POINT 7)
	MOVEM	T1,SRCBP
	MOVEI	T1,LDEVC
	MOVEM	T1,SRCLEN
	PUSHJ	P,ASCSIX	;AND CONVERT IT TO SIXBIT
	 $SNH			;CAN'T FAIL!

	MOVE	T1,ATMBUF	;GET THE SIXBIT DEVICE NAME
	DEVCHR	T1,		;SEE IF DEVICE EXISTS
	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
	MOVE	T1,DSKDEF	;NOT IN TABLE, USE DEFAULT
	MOVEM	T1,DEV(D)	;SAVE IN DDB
	POPJ	P,		;Return, default device set.

;Routine to check out device and get information about it

DFDEV1:	PUSHJ	P,SETFI		;SETUP FILE BLOCKS WITH FILESTRING INFO
	 POPJ	P,		;ERROR IN FILESTRING

	MOVE	T1,FBLK+.FODEV(D) ;GET DEVICE NAME
	DEVCHR	T1,		;GET DEVCHR WORD
	MOVEM	T1,DVBTS(D)	;SAVE DEVCHR WORD
	JUMPE	T1,DFNSD	;NO SUCH DEVICE IF ZERO

	MOVE	T1,FBLK+.FODEV(D) ;GET DEVICE NAME
	DEVNAM	T1,		;GET PHYSICAL DEVICE NAME
	 $SNH			;SHOULDN'T FAIL
	MOVE	T2,DVBTS(D)	;GET THE DEVCHR BITS AGAIN
	TXNE	T2,DV.TTA	;CONTROLLING TERMINAL?
	 MOVX	T1,.CTTRM	;YES. SUBSTITUTE JUST TTY
	MOVEM	T1,DVICE(D)	;SAVE IT

	MOVE	T1,FBLK+.FODEV(D) ;GET DEVICE NAME
	DEVTYP	T1,		;GET DEVTYP BITS
	  $SNH			;?Should not fail
	MOVEM	T1,DVTW(D)	;SAVE ENTIRE DEVTYP WORD

;HERE FIGURE OUT IF DEVICE IS "ASCII-ONLY". IF IT IS,
;SET IMGFLG(D), WHICH WILL PREVENT UNFORMATTED (BINARY)
;I/O FROM READING/WRITING LSCW'S.

	SETZM	IMGFLG(D)	;[4164] CLEAR THE ASCII-ONLY (IMAGE) FLAG
	LOAD	T1,MODE(D)	;[4164] GET FORTRAN DATA MODE
	CAIN	T1,MD.IMG	;[4164] IMAGE?
	 SETOM	IMGFLG(D)	;[4164] YES. SET FLAG
	LOAD	T1,DVTYP(D)	;GET THE DEVICE TYPE
	CAIE	T1,.TYLPT	;LINE PRINTER?
	 CAIN	T1,.TYTTY	;OR TERMINAL?
	  SETOM	IMGFLG(D)	;YES. SET ASCII-ONLY
	CAIE	T1,.TYPLT	;PLOTTER?
	 CAIN	T1,.TYPTY	;OR PTY?
	  SETOM	IMGFLG(D)	;YES. SET ASCII-ONLY

;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
	CAIE	T1,.TYPTY	;PTY?
	 CAIN	T1,.TYTTY	;TTY?
	  MOVEI	T2,DI.TTY	;Yes
	TXNE	T1,TY.SPL	;SPOOLED DEVICE?
	 MOVEI	T2,DI.OTHR	;YES. USE TYPE OTHER
	MOVE	T1,DVBTS(D)	;[4205] GET THE DEVCHR BITS AGAIN
	TXNE	T1,DV.MTA	;[4205] IF IT IS A MAGTAPE
	 TXNN	T1,DV.DSK	;[4205] AND IT IS A DISK
	  CAIA			;[4205]
	 MOVEI	T2,DI.OTHR	;[4205] THEN IT IS THE NULL DEVICE!
	STORE	T2,INDX(D)	;Store dev index for dev-dependent code

	CAIN	T2,DI.MTA	;[4161] MAGTAPE?
	 PUSHJ	P,MTADEF	;[4161] YES. SETUP PARAMETERS
	PUSHJ	P,FIXCC		;SETUP CARRIAGECONTROL
	JRST	%POPJ1		;No error--skip return

DFNSD:	XMOVEI	T1,DEV(D)	;GET IT AGAIN FOR ERROR
	$DCALL	NSD		;NO SUCH DEVICE

>;END IF10

DFACC:	PUSHJ	P,%RMDFA	;[5000] Set RMS defaults
	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'.
	LOAD	T1,ACC(D)	;DEFAULT IS /ACCESS:SEQINOUT
	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:	LOAD	T1,UBUFCT(D)	;[5000] GET USER'S BUFFER COUNT
	STORE	T1,BUFCT(D)	;[5000] STORE
	JUMPN	T1,%POPJ	;IF ALREADY SET, DON'T SET DEFAULT
	MOVEI	T1,BUFNM	;LOAD DEFAULT
	STORE	T1,BUFCT(D)
	POPJ	P,

;CHKFRM - IF THE FORM IS SET AND THE MODE IS NOT, SET THE MODE
CHKFRM:	LOAD	T1,FORM(D)	;GET FORM
	JUMPE	T1,%POPJ	;NOT DEFAULTED UNTIL LATER
SETMOD:	LOAD 	T2,MODE(D)	;FORM IS SET. GET MODE
	JUMPN	T2,%POPJ	;ALREADY SET BY OPEN
	MOVEI	T3,MD.ASC	;ASSUME ASCII
	CAIE	T1,FM.FORM	;FORM=FORMATTED?
	 MOVEI	T3,MD.BIN	;NO. USE MODE=BINARY
	STORE	T3,MODE(D)	;STORE IT
	POPJ	P,

;SET MODE AND FORM - DONE JUST BEFORE THE FILE IS OPENED
;IF THE UNIT HAS NOT BEEN OPENED PREVIOUSLY. THE ONLY CASE
;KNOWN IS ENDFILE, WHICH ENDS UP WRITING A NULL FILE, BUT
;WHOSE MODE IS ASCII.

SETMAF:	LOAD	T1,MODE(D)	;MODE SET YET?
	JUMPN	T1,SETFRM	;YES. GO SET FORM
	MOVEI	T1,MD.ASC	;NO. SET MODE TO ASCII
	STORE	T1,MODE(D)
	MOVEI	T1,FM.FORM	;AND SET FORM=FORMATTED
	STORE	T1,FORM(D)
	POPJ	P,		;WE'RE DONE

;IF MODE SET, SETUP DEFAULT FORM.
CHKMOD:	LOAD	T1,MODE(D)	;GET FILE MODE
	JUMPE	T1,%POPJ	;NONE. DON'T DEFAULT IT NOW
SETFRM:	LOAD	T1,FORM(D)	;FORM SET YET?
	JUMPN	T1,%POPJ	;ALREADY SET
	MOVEI	T1,FM.FORM	;ASSUME FORMATTED
	LOAD	T2,MODE(D)	;GET MODE
	CAIE	T2,MD.BIN	;BINARY?
	 CAIN	T2,MD.IMG	;OR IMAGE?
	  MOVEI	T1,FM.UNF	;YES. SET UNFORMATTED
	CAIN	T2,MD.DMP	;OR DUMP
	 MOVEI	T1,FM.UNF	;YES. SET UNFORMATTED
	STORE	T1,FORM(D)
	POPJ	P,

;SET MODE BY ACCESS TYPE. IF NEITHER MODE NOR FORM HAVE BEEN SET UP,
;SET MODE AND FORM BY ACCESS TYPE - FORMATTED AND ASCII IF SEQUENTIAL,
;UNFORMATTED AND BINARY IF RANDOM.
SMBA:	LOAD	T1,MODE(D)	;GET MODE
	JUMPN	T1,SETFRM	;IF SET, GO SET FORM
	LOAD	T1,FORM(D)	;GET FORM
	JUMPN	T1,SETMOD	;IF SET, GO SET MODE
	LOAD	T1,ACC(D)	;GET ACCESS
	MOVEI	T2,MD.ASC	;ASSUME ASCII
	CAIE	T1,AC.RIO	;RANDOM?
	 CAIN	T1,AC.RIN	;OR RANDIN?
	  MOVEI	T2,MD.BIN	;YES. SET TO BINARY
	STORE	T2,MODE(D)	;STORE MODE
	JRST	SETFRM		;GO SET FORM

DFPAD:	LOAD	T1,PADSP(U)	;WAS A PADCHAR SPECIFIED?
	JUMPN	T1,%POPJ	;YES. DON'T DEFAULT IT
	MOVEI	T1,40		;SPACE IS DEFAULT PADCHAR
	STORE	T1,PADCH(U)
	POPJ	P,

;FIXDEF DOES FINAL DEFAULT PROCESSING AFTER EVERYTHING IS IN PLACE
;INITIALIZES TTYW TO 72 OR RECORD SIZE, IF NOT YET SET UP

FIXDEF:	MOVE	T1,RECTP(D)	;[5000] GET RECORDTYPE
	CAIN	T1,RT.UNS	;[5000] ANY USER VALUE?
	 JRST	NORCTP		;[5000] NONE GIVEN, USE DEFAULT

;IF THE RECORDTYPE KEYWORD IS GIVEN, IT MEANS THAT THE NORMAL
;DEFAULTS OF CRLF TERMINATOR AND WORD-ALIGNED FIXED-LENGTH RECORDS
;ARE NO LONGER OPERATIVE. IF THE RECORDS ARE VARIABLE-LENGTH,
;EITHER THEY ARE BEING GIVEN TO US BY RMS, OR THEY HAVE A RECORD CONTROL
;WORD (RCW) AT THEIR BEGINNING (SUCH AS FOR INDUSTRY "D" FORMAT MAGTAPE)
;IF THEY ARE FIXED-LENGTH, THEY ARE RMS FIXED-LENGTH RECORDS
;OR ARE "F" FORMAT RECORDS ON A MAGTAPE.

	CAIN	T1,RT.FIX	;FIXED-LENGTH?
	 JRST	RECFIX		;YES. LEAVE RSIZE SET
	MOVE	T1,RSIZE(D)	;NO. SET MAXIMUM RECORDSIZE
	SKIPN	MRSIZE(D)	;[5000] UNLESS ALREADY SET BY RMS
	 MOVEM	T1,MRSIZE(D)	;[5000]
	SETZM	RSIZE(D)	;CLEAR THE FIXED RECORDSIZE
	JRST	TTWSET

NORCTP:	MOVEI	T1,RT.UND	;[5000] DEFAULT RECORDTYPE TO STREAM
	MOVEM	T1,RECTP(D)	;[5000]
	SKIPN	RSIZE(D)	;FIXED-LENGTH RECORDS?
	 JRST	TTWSET		;NO. NOTHING MORE TO DO HERE

RECFIX:	MOVE	T1,RSIZE(D)	;GET RECORDSIZE
	LOAD	T2,MODE(D)	;GET FILE MODE
	CAIE	T2,MD.ASL	;LINE-SEQUENCED ASCII?
	 JRST	NOTLSN		;NO
	ADDI	T1,6		;YES. ADD 6 FOR LSN AND TAB
	MOVEI	T3,6		;SAVE FOR RECORD OFFSET
	MOVEM	T3,ROFSET(D)
NOTLSN:	SKIPN	T1,MRSIZE(D)	;[5000] IF MRS ALREADY SET, USE IT
	 MOVE	T1,RSIZE(D)	;[5000] ELSE USE RECORDSIZE
	MOVEM	T1,FRSIZB(D)	;SAVE FORMATTED RECORDSIZE IN BYTES
	MOVE	T2,RSIZE(D)	;GET THE RECORDSIZE AGAIN
	SKIPN	IMGFLG(D)	;ASCII-ONLY DEVICE?
	 ADDI	T2,2		;NO. ADD 2 FOR LSCW'S
NOTBIN:	MOVEM	T2,URSIZW(D)	;SAVE UNFORMATTED RECSIZ IN WORDS
	IMUL	T2,BPW(D)	;GET UNFORMATTED RECSIZ IN BYTES
	MOVEM	T2,URSIZB(D)	;SAVE IT

	MOVE	T1,RECTP(D)	;[5000] GET RECORDTYP
	CAIE	T1,RT.UND	;[5000] STREAM FILE?
	 JRST	TTWSET		;[5000] NO
	MOVE	T1,FRSIZB(D)	;GET STORED RECORDSIZE AGAIN
	ADDI	T1,2		;YES. ADD 2 FOR CRLF
	ADD	T1,BPW(D)	;NOW ADD BPW-1 TO ROUND UP TO WORDS
	SUBI	T1,1
	IDIV	T1,BPW(D)	;GET # WORDS
	MOVEM	T1,FRSIZW(D)	;STORE RECORD SIZE IN WORDS
	IMUL	T1,BPW(D)	;GET IT IN BYTES
	MOVEM	T1,FRSIZB(D)	;SAVE ROUNDED-UP RECORD SIZE IN BYTES

TTWSET:	LOAD	T1,TTYW(D)	;GET LINE WIDTH
	JUMPN	T1,%POPJ	;GOT ONE ALREADY. LEAVE
	SKIPN	T1,RSIZE(D)	;USE RECSIZ IF SPECIFIED
	 MOVEI	T1,^D72		;OR 72 IF NOT
	STORE	T1,TTYW(D)	;SAVE LINE WIDTH FOR LIST-DIRECTED OUTPUT
	POPJ	P,

;
;  FIXCC - Routine to fixup U after OPEN is done.
;  Called with FIXDEF, for every "U" that applies.
;  SETS /CARRIAGE:DEVICE TO APPROPRIATE DEVICE DEFAULT
;
;  NAMELY, SETS IT TO:	CC=LIST for stream files, 
;			CC=FORTRAN for non-stream files
;			CC=TRANSLATED for TTY: and LPT:.
;
;  Also changes CC=FORTRAN to CC=TRANSLATED for TTY and LPT.
;

FIXCC:	LOAD	T2,CC(U)	;GET CC
	CAIN	T2,CC.FOR	;FORTRAN?
	 JRST	CTTYCC		;YES. CHECK IF TTY OR LPT
	CAIE	T2,CC.DEV	;DEVICE DEFAULT?
	  POPJ	P,		;NO, DONE
	MOVEI	T2,CC.LST	;FOR STREAM FILES, LIST IS THE DEFAULT
	SKIPN	T1,RECTP(D)	;[5000] GET RECORDTYP
	 JRST	CTTYCC		;[5000] NONE GIVEN, SO IT'S STREAM
	CAIE	T1,RT.UND	;[5000] NOT STREAM?
	 MOVEI	T2,CC.FOR	;YES. FORTRAN IS THE DEFAULT
CTTYCC:	LOAD	T1,DVTYP(D)	;GET DEVICE TYPE
	CAIE	T1,DT.TTY	;TERMINAL?
	 CAIN	T1,DT.LPT	;OR PRINTER?
	  MOVEI	T2,CC.TRN	;YES. TRANSLATED IS THE DEFAULT
	STORE	T2,CC(U)	;STORE DEFAULT CC
	POPJ	P,		;Return
	SUBTTL	FNDSWT - Look up switch in table
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine will search the switch table to find a DDB_key_value
;	which matches  the one given as an input parameter. If a match is
;	found the address of the string (for the switch) will be returned.
;	Else, the address of a null string will be returned.
; 
;       Format of the TBLUK table:
;	TABLE:	Number of entries in table,,Number of entries in table
;		Addr of switch name string,,Address of OTS flags
;		Addr of switch name string,,Address of OTS flags
;		 "    "   "     "     "       "     "   "    "
;	            /                                        \
;	           /                                          \
;	          /                                            \
;	[SIXBIT /Switch/]            [XWD Compatibility_Flag,,DDB_key_value]
;
;	The DDB_key_value are defined in FORPRM (DDB structure).
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,FNDSWT
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	 T1	DDB_key_value to find a match for.
;	 T2	Address of table in TBLUK JSYS Format (18-bits).
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	T1	ADDRESS of the switch string (from RH of table entry).
;
; SIDE EFFECTS:
;
;	Uses T1 thru T4.
;
;--	
FNDSWT:	HLRZ	T3,(T2)		;Get length of Switch_Table
	JUMPE	T3,FNDNUL	;If no entries, It's not a Switch_Table
	HRLI	T2,(IFIW (T3))	;Put T3 index in LH of T2

FSWLP:	HRRZ	T4,@T2		;Get address of flag word 
	HRRZ	T4,(T4)		;Get the DDB_key_value (RH).
	CAIE	T4,(T1)		;Does it match the one we want?
	 SOJG	T3,FSWLP	;No, Keep looking
	HLRZ	T4,@T2		;[4205] Yes, Get pointer to string
	MOVE	T4,(T4)		;[4205] GET STRING OR FLAG WORD
	TLNN	T4,774000	;[4205] ANY CHAR THERE?
	 SOJG	T3,FSWLP	;[4205] NO. THIS ENTRY IS NG
	HLRZ	T1,@T2		;Yes, Get pointer to string
	XMOVEI	T1,(T1)		;Make it a global address
	POPJ	P,		;Return to caller.

FNDNUL:	XMOVEI	T1,[0]		;Point to a NULL string
	POPJ	P,		;End of routine FNDSWT

	SUBTTL	DIALOG SCANNER

DFINQ:	PUSHJ	P,INQCTX	;[5001] INQUIRE DEFAULTFILE=
	JRST	DFCOM		;[5001] JOIN COMMON CODE
DFOPN:	PUSHJ	P,OPNCTX	;ENTER OPEN CONTEXT
DFCOM:	MOVE	T1,O.DFLT	;GET ARG POINTER
	MOVEM	T1,STRARG	;SAVE IT
	SETZM	DIARRY		;CANNOT BE AN ARRAY
	XMOVEI	T1,[ASCIZ /DEFAULTFILE=/] ;SAVE NAME FOR ERRORS

;[5020] New

COMFIL:	MOVEM	T1,%ARGNM	;SAVE NAME FOR ERRORS
IF10,<
	PUSHJ	P,COMSTR
	PJRST	RELJFN
> ;END IF10

IF20,<
	PUSHJ	P,SAVERR	;DIVERT ERR MSGS TO TTY
	PUSHJ	P,DIABLT	;FAKE A TEXTI
	SETZ	T1,
	IDPB	T1,T2		;END WITH NULL
	PUSHJ	P,SETJFN	;SETUP JFN BLOCK
	MOVX	T1,GJ%OFG	;PARSE-ONLY
	IORM	T1,JFNBLK+.GJGEN ;
	MOVX	T1,G1%SLN	;Don't expand logical names either
	IORM	T1,JFNBLK+.GJF2
	MOVEI	T1,JFNBLK	;POINT TO GTJFN BLOCK
	HRROI	T2,%TXTBF
	GTJFN%			;GET A JFN
	 ERJMP	CHKNET		;CAN'T, SEE WHY
	MOVEM	T1,IJFN(D)	;STORE JFN WITH FLAGS
	SETOM	FILPRS(D)	;SET FLAG FOR FILENAME PARSED
	PUSHJ	P,DOJFNS	;STORE NEW DEVICE, FILENAME, ... IN DDB
	PJRST	RELJFN

;HERE ON 1ST PASS GTJFN ERROR
CHKNET:	CAIE	T1,GJFX49	;NO. ?INVALID ATTR FOR THIS DEVICE?
	 JRST	CMDER2		;NO, GO FAIL

;HERE IF ERROR WAS ?INVALID ATTRIBUTE FOR THIS DEVICE.  THIS COULD MEAN
;	A) INVALID TAPE ATTRIBUTES WERE SUPPLIED BY THE USER
;	B) THE USER SUPPLIED NETWORK ATTRIBUTES BUT NO NODENAME, WHICH IS
;	   PERFECTLY LEGAL DURING A DEFAULTFILE PASS AT THE FULL FILESPEC.
;FOR CASE B) WE KLUDGE A CHECK FOR THE ";USERID" ATTRIBUTE IN THE USER
;STRING, AND IF PRESENT TEMPORARILY DEFAULT A NODENAME TO THE LOCAL NODE
;SO THE STRING WILL PARSE ON A SECOND GTJFN (IF *THAT* FAILS WE DIE). THIS
;TEMPORARY DEFAULTED NODE IS NOT RETAINED IN THE DDB.

	MOVE	T1,[POINT 7,%TXTBF] ;POINT AT STRING
CHKNLP:	ILDB	T2,T1		;LOOK FOR ";"
	CAIN	T2,12		;LF TERMINATES STRING
	 JRST	CMDER2
	CAIN	T2,""		;OVERLOOK QUOTED CHARACTERS
	 JRST	[ILDB T2,T1
		 JRST CHKNLP]
	CAIE	T2,";"		;ATTRIBUTE?
	 JRST	CHKNLP		;NO
	ILDB	T2,T1		;YES, GET NEXT CHAR
	CAIL	T2,140		;LOWERCASE?
	 SUBI	T2,40		;CONVERT TO UPPER
	CAIE	T2,"U"		;";U" for USERID?
	 JRST	CHKNLP		;NO

;HERE TO DEFAULT A LOCAL NODE
CHKNOD:	SKIPE	LOCNOD		;ALREADY HAVE A LOCAL NODE?
	 JRST	DFTNOD		;YES, GO STORE IN JFNBLK
	MOVX	T1,.NDGLN	;GET THE LOCAL NODE
	MOVE	T2,[POINT 7,LOCNOD]
	MOVEM	T2,NODPTR
	XMOVEI	T2,NODPTR
	NODE%
	 ERJMP	CMDER2		;CAN'T, GO FAIL
DFTNOD:	HRROI	T1,LOCNOD	;DEFAULT IT IN THE JFNBLK
	MOVEM	T1,JFNBLK+.GJNOD
	MOVEI	T1,JFNBLK	;POINT TO GTJFN BLOCK
	HRROI	T2,%TXTBF
	GTJFN%			;GET A JFN
	 ERJMP	CMDER2		;CAN'T
	MOVEM	T1,IJFN(D)	;STORE JFN WITH FLAGS
	SETOM	FILPRS(D)	;SET FLAG FOR FILENAME PARSED
	PUSHJ	P,DOJFNS	;STORE NEW DEVICE, FILENAME, ... IN DDB
	SETZM	NODNAM(D)	;BUT CLEAR A DEFAULTED NODENAME
	PJRST	RELJFN

	SEGMENT	DATA

NODPTR:	BLOCK	1
LOCNOD:	BLOCK	2

	SEGMENT	CODE

> ;END IF20

FILINQ:	SKIPN	O.FILE		;[5001] ALREADY SEEN DEFAULTFILE?
	 POPJ	P,		;[5001] YES
	PUSHJ	P,INQCTX	;ENTER INQUIRE CONTEXT
	JRST	FILCOM		;JOIN COMMON FILE= PARSER

FILCLS:	PUSHJ	P,CLSCTX	;ENTER CLOSE CONTEXT
	JRST	FILCOM		;JOIN COMMON FILE= PARSER

FILOPN:	PUSHJ	P,OPNCTX	;ENTER OPEN CONTEXT
FILCOM:	MOVE	T1,O.FILE	;GET ARG POINTER
	MOVEM	T1,STRARG	;SAVE IT
	SETZM	DIARRY		;CANNOT BE AN ARRAY
	XMOVEI	T1,[ASCIZ /FILE=/] ;SAVE NAME FOR ERRORS
	PJRST	COMFIL

NAMCLS:	PUSHJ	P,CLSCTX	;ENTER CLOSE CONTEXT
	JRST	NAMCOM		;JOIN COMMON NAME= PARSER

NAMOPN:	PUSHJ	P,OPNCTX	;ENTER OPEN CONTEXT
NAMCOM:	MOVE	T1,O.NAME	;GET NAME=STRING ARG POINTER
	MOVEM	T1,STRARG	;SAVE IT
	SETOM	DIARRY		;CAN BE AN ARRAY
	XMOVEI	T1,[ASCIZ /NAME=/] ;SAVE NAME FOR ERRORS
	PJRST	COMFIL

DLSCLS:	PUSHJ	P,CLSCTX	;ENTER CLOSE CONTEXT
	JRST	DLSCOM		;JOIN COMMON DIALOG= PARSER

DLSOPN:	PUSHJ	P,OPNCTX	;ENTER OPEN CONTEXT
DLSCOM:	MOVE	T1,O.DIAS	;GET DIALOG=STRING ARG POINTER
	MOVEM	T1,STRARG	;SAVE IT
	SETOM	DIARRY		;CAN BE AN ARRAY
	XMOVEI	T1,[ASCIZ /DIALOG=/] ;SAVE NAME FOR ERRORS
	MOVEM	T1,%ARGNM	;SAVE NAME FOR ERRORS
	PUSHJ	P,COMSTR	;CALL COMMON STRING PARSER
	PJRST	RELJFN		;RELEASE THE JFN

ASCFNS:	HRLI	T1,(POINT 7)	;MAKE IT A LOCAL BYTE POINTER
ASCFLP:	ILDB	T2,T1		;GET A CHAR
	JUMPE	T2,%POPJ	;LOOP UNTIL NULL
	IDPB	T2,FNSPNT	;DEPOSIT IN FILESTRING
	JRST	ASCFLP		;LOOP UNTIL NULL

DNFNS:	IDIVI	T1,^D10		;DIVIDE BY 10
	PUSH	P,T2		;PUSH REMAINDER
	JUMPE	T1,DNFNS1	;IF NO MORE DIGITS, GO DEPOSIT THEM
	PUSHJ	P,DNFNS		;RECURSIVE START
DNFNS1:	POP	P,T1		;GET A DIGIT
	ADDI	T1,60		;CONVERT TO ASCII
	IDPB	T1,FNSPNT	;DEPOSIT IN FILESTRING
	POPJ	P,		;LEAVE OR DO NEXT DIGIT

IF20,<
DIALOG:	XMOVEI	T1,[ASCIZ /DIALOG/]
	MOVEM	T1,%ARGNM	;SAVE NAME FOR ERRORS
	PUSHJ	P,SAVERR	;DIVERT ERR MSGS TO TTY
	SKIPN	EFSFLG		;SKIP IF PREFIX ALREADY TYPED
	 $ECALL EFS		;ENTER CORRECT FILE SPECS
	SETOM	EFSFLG		;SUPPRESS PROMPT NEXT TIME
	MOVE	T1,[.PRIIN,,.PRIOU] ;USE NORMAL JFNS
	MOVEM	T1,CSB+.CMIOJ
	PUSHJ	P,COMINT	;INITIALIZE COMMAND SCANNER
	PUSHJ	P,DIACOM	;DO COMMON DIALOG CODE
	PJRST	RELJFN		;RELEASE THE JFN

COMSTR:	PUSHJ	P,SAVERR	;DIVERT ERR MSGS TO TTY
	MOVE	T1,[.NULIO,,.NULIO] ;USE NO JFNS
	MOVEM	T1,CSB+.CMIOJ
	PUSHJ	P,COMINT	;INITIALIZE COMMAND SCANNER
	PUSHJ	P,DIABLT	;FAKE A TEXTI
DIACOM:	MOVEM	P,SAVEP		;SAVE P FOR REPARSE
	JRST	GOPARS		;AND GO PARSE FILESPEC OR SWITCHES

REPARS:	MOVE	P,SAVEP		;RESTORE P
	PUSHJ	P,RELJFN	;RELEASE JFN IF ANY

GOPARS:	PUSHJ	P,SETJFN	;FILL IN GTJFN BLOCK
	MOVX	T1,GJ%OFG	;DIALOG IS PARSE-ONLY FOR ALL DEVICES
	IORM	T1,JFNBLK+.GJGEN ;(Incase he changes /ACCESS after typing
				; the filespec).
	MOVX	T1,G1%SLN	;[2041] Don't expand logical names either
	IORM	T1,JFNBLK+.GJF2	;[2041] because file might be down under
	MOVEI	T1,CSB		;POINT TO CSB
	MOVEI	T2,FLDFNS	;Parse file name or switches
	SKIPN	SWTPNT		;ANY SWITCHES ALLOWED?
	 MOVEI	T2,FLDFN	;NO. PARSE ONLY FILE NAME
	PUSHJ	P,COMAND	;** Go do parse **
	HRRZ	T1,T3		;See what it was
	CAIE	T1,FLDCFS	;[4134] CONFIRM?
	 CAIN	T1,FLDCFM	;[4134] OR THE OTHER CONFIRM?
	  POPJ	P,		;Yes, just return
	CAIN	T1,FLDSWT	;Switch?
	 JRST	DIASWG		;Yes, go process

;Filename was parsed

DIAFNM:	MOVEM	T2,IJFN(D)	;[4135] STORE JFN IN DDB
	MOVEM	T2,OJFN(D)	;[4135] . .
	SETOM	FILPRS(D)	;SET FLAG FOR FILENAME PARSED
	PUSHJ	P,DOJFNS	;STORE NEW DEVICE, FILENAME, ... IN DDB

DIASWT:	MOVEI	T1,CSB		;POINT TO CSB
	MOVEI	T2,FLDCFS	;CONFIRM OR SWITCH
	SKIPN	SWTPNT		;[4134] UNLESS NO SWITCHES ALLOWED
	 MOVEI	T2,FLDCFM	;[4134] THEN ALLOW ONLY CONFIRM
	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:	HRRZ	T1,(T2)		;GET ADDRESS OF FLAGS,,KEYWORD NUMBER
	HRRZ	T1,(T1)		;GET KEYWORD NUMBER OF SWITCH
	MOVEM	T1,KEYVAL	;SAVE IT
	ADD	T1,DSPPNT	;POINT TO DISPATCH TABLE ENTRY
	HRRZ	T1,(T1)		;GET DISPATCH TABLE ENTRY
	MOVEM	T1,KWTADR	;SAVE IT
	MOVE	T3,(T1)		;GET ROUTINE ADDRESS OR TOP OF KEYWORD TABLE
	TLNN	T3,-1		;SEE WHICH IT IS
	 JRST	(T3)		;SUBROUTINE, GO TO IT

	MOVE	T1,KWTADR	;GET KEYWORD TABLE ENTRY
	MOVEM	T1,SWTDDB+.CMDAT ;STORE ADDRESS
	MOVEI	T1,CSB		;Point to COMND block
	MOVEI	T2,SWTDDB	;POINT TO KEYWORD FLDDB
	PUSHJ	P,COMAND	;PARSE SWITCH KEYWORD
	HRRZ	T2,(T2)		;GET ADDRESS OF FLAGS,,VALUE
	HRRZ	T2,(T2)		;GET VALUE
	MOVE	T1,KEYVAL	;GET KEYWORD NUMBER
	XCT	OPSTOR(T1)	;STORE IN DDB
	JRST	DIASWT		;LOOP

;ROUTINE TO INITIALIZE THE COMMAND SCANNER
COMINT:	MOVEI	T1,REPARSE	;FILL IN CSB
	MOVEM	T1,CSB+.CMFLG
	HRROI	T1,[ASCIZ /*/]	;PROMPT STRING
	MOVEM	T1,CSB+.CMRTY
	HRROI	T1,%TXTBF	;TEXT BUFFER
	MOVEM	T1,CSB+.CMBFP
	MOVEM	T1,CSB+.CMPTR
	MOVEI	T1,LTEXTC	;CHARS IN TEXT BUFFER
	MOVEM	T1,CSB+.CMCNT
	HRROI	T1,ATMBUF	;ATOM BUFFER
	MOVEM	T1,CSB+.CMABP
	MOVEI	T1,LATOMC-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
	MOVE	T1,SWTPNT	;GET APPROPRATE SWITCH TABLE ADDRESS
	MOVEM	T1,FLDSWT+.CMDAT ;Store in block

	MOVEI	T1,CSB		;POINT TO CSB
	MOVEI	T2,[FLDDB.(.CMINI)] ;INITIALIZE IT
	PJRST	COMAND

;Routine to ignore the next keyword
;KEYVAL = 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
	MOVEI	T1,CSB		;POINT TO COMMAND STATE BLOCK
	PUSHJ	P,COMAND
	MOVE	T1,KEYVAL	;GET KEY NUMBER
	XCT	OPSTOR(T1)	;STORE IN DDB
	JRST	DIASWT

DIACHR:	MOVEI	T1,CSB		;POINT TO COMMAND STATE BLOCK
	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
	MOVE	T1,KEYVAL	;GET KEY NUMBER
	XCT	OPSTOR(T1)	;STORE IN DDB
	JRST	DIASWT

DIASET:	MOVEI	T2,1		;SET BIT TO 1
	MOVE	T1,KEYVAL	;GET KEY NUMBER
	XCT	OPSTOR(T1)
	JRST	DIASWT


	SUBTTL	DIAKEY - Parse /KEY: in DIALOG mode
;++
; FUNCTIONAL DESCRIPTION:
;
;	Parses /KEY: arguments and allocates and/or constructs a
;	secondary argument list for XAB allocation. If D.KEY is non-
;	zero, reuses a previously allocated arglist. If D.KEY is zero,
;	allocates MAXKEY*KSPLEN+1 words for the arglist. Parses arguments
;	until a right paren is encountered, checks that total arguments
;	are equal to or less than MAXKEY. Calls %RMKOP to allocate a
;	XAB chain and deallocates the arglist.
;
;	Format of /KEY arguments:
;
;	/KEY:{NONE}(LB:UB{:type}{,LB:UB{:type}...})
;
;	where
;		NONE	terminates the parse and clears O.KEY
;		LB	is a decimal integer for lower bound
;		UB	is a decimal integer for upper bound
;		type	is either the word INTEGER or CHARACTER
;
;	Format of secondary argument list:
;
;		-N,,0			;N is KSPLEN*number_keys
;	xM:	IFIW	TP%UDF,LB	;primary key first char
;		IFIW	TP%UDF,UB	;primary key last char
;		IFIW	type,0		;type is TP%INT or TP%CHR
;		.....
;		IFIW	TP%UDF,LB	;last key first char
;		IFIW	TP%UDF,UB	;last key last char
;		IFIW	type,0		;type is integer or character
;
;	Note that LB and UB are immediate arguments, unlike a compiler-
;	generated secondary arglist.
;
;
; CALLING SEQUENCE:
;
;	JRST	DIAKEY
;	[Called from DIASWG only, JRSTs to DIASWT]
;	
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	D.KEY	-	Address of DIALOG secondary arglist if one already
;			exists
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	D.KEY	-	Address DIALOG secondary arglist
;	O.KEY	-	Address of OPEN secondary arglist, set to D.KEY
;
; FUNCTION VALUE:
;
;	None
;
; SIDE EFFECTS:
;
;	May allocate/deallocate MAXKEY*KSPLEN+1 words of memory and
;	call %RMKOP to allocate a XAB chain.
;
;--
;[5000] New

DIAKEY:	SKIPN	T1,D.KEY	;Any previous arglist?
	 JRST	DKYALC		;No, allocate one
	SETZM	-1(T1)		;Yes. Clear the count
	SETZM	(T1)		;Clear out arglist
	HRL	T2,T1		;address,,address+1
	HRRI	T2,1(T1)
	BLT	T2,MAXKEY*KSPLEN-1(T1)
	JRST	GETLP		;Go re-use

DKYALC:	MOVEI	T1,MAXKEY*KSPLEN+1 ;Maximum size
	PUSHJ	P,%GTBLK	;Get it
	 $ACALL	MFU		;Can't
	ADDI	T1,1		;Point past count word
	MOVEM	T1,D.KEY	;Store it

GETLP:	MOVE	P1,T1		;Get arglist pointer
	SETZ	T2,
	PUSHJ	P,DKDLB		;Initialize lower bound default
	SETZM	K.KCT		;Initialize specifier count

;Parse opening left paren

	MOVEI	T1,CSB		;Point to Command State Block
	MOVEI	T2,DKLP		;Look for "("
	PUSHJ	P,COMAND	;Parse it
	HRRZ	T3,T3		;Get FDB actually used
	CAIN	T3,DKNO		;"NONE"?
	 JRST	NOKEY		;Yes, quit right now

;Top of LB:UB{:type} loop

KEYLP:	AOS	T2,K.KCT	;Increment specifier count
	CAILE	T2,MAXKEY	;Beyond max?
	 $DCALL	TKS

;Here to parse lower bound

	MOVEI	T2,DKLB		;Parse lower bound
	PUSHJ	P,COMAND
	PUSHJ	P,%CHKBD	;Check validity
	 JRST	BADKEY		;Bad
	HRRZM	T2,LBO(P1)	;Store in arglist

	MOVEI	T2,DKCOL	;Look for ":"
	PUSHJ	P,COMAND

;Here to parse upper bound

	MOVEI	T2,DKUB		;Parse upper bound
	PUSHJ	P,COMAND
	PUSHJ	P,%CHKBD	;Check validity
	 JRST	BADKEY		;Bad
	HRRZM	T2,UBO(P1)	;Store in arglist
	PUSHJ	P,DKDLB		;Set LB default to last UB+1
	MOVEI	T1,CSB		;Restore State Block pointer

;Here to parse optional data type

	MOVEI	T2,TP%CHR	;Default data type to TP%CHR
	DPB	T2,[POINTR (DTO(P1),ARGTYP)]

	MOVEI	T2,DKCCP	;Look for ":", ",", or ")"
	PUSHJ	P,COMAND

	HRRZ	T3,T3		;Get FDB actually used
	CAIE	T3,DKCCP	;":" found?
	 JRST	CHKCOM		;No

;Here to parse key data type. 

	MOVEI	T2,DKTYP	;Parse keyword for type
	PUSHJ	P,COMAND

	HRRZ	T2,(T2)		;Get data type for keyword
	DPB	T2,[POINTR (DTO(P1),ARGTYP)] ;Set in arglist

	MOVEI	T2,DKCOM	;Look for "," or ")"
	PUSHJ	P,COMAND
	HRRZ	T3,T3		;Get FDB actually used

;Bottom of LB:UB{:type} loop

CHKCOM:	ADDI	P1,KSPLEN	;Point to next arglist section
	CAIN	T3,DKCOM	;Comma found?
	 JRST	KEYLP		;Yes, back for more
				;No, must be closing paren

;Here on right paren. Calculate arglist count, setup O.KEY, chain the XAB(s),
;deallocate the temporary arglist, and go do more DIALOG.

	MOVE	T1,K.KCT	;Get count of specifiers
	IMULI	T1,KSPLEN	;Calculate actual arglist length
	MOVN	T1,T1		;Make negative
	MOVSI	T1,(T1)		;Get arglist count -n,,0
	MOVE	T2,D.KEY	;Get arglist address
	MOVEM	T1,-1(T2)	;Set in count word
	MOVEM	T2,O.KEY	;Set O.KEY to this arglist
	PUSHJ	P,%RMKOP	;Go setup XAB(s)
	PUSHJ	P,%RMDKB	;Deallocate the temporary arglist
	JRST	DIASWT		;Continue parsing DIALOG

;Here on bad LB/UB values. There are 2 possibilities: a value greater
;than 17 bits ("Number too large"), or a value .LE. zero ("Number too
;small").

BADKEY:	MOVEI	T1,FLINX2	;Assume too small (.LE. zero)
	SKIPLE	T2		;Was it?
	 MOVEI	T1,FLINX3	;No, too big
	MOVEI	T2,(T1)		;Get error code in T2
	MOVEI	T1,.FHSLF	;This fork
	SETER%			;Make it current
	SETZM	O.KEY		;Clear pointer
	PUSHJ	P,%RMDKB	;Deallocate arglist
	PUSHJ	P,COL1		;Get to column 1
	XMOVEI	T5,ATMBUF	;Point at what was typed
	$DCALL	EDA		;Report error

;Here on KEY=NONE. Clear O.KEY and deallocate the arglist

NOKEY:	SETZM	O.KEY
	PUSHJ	P,%RMDKB
	JRST	DIASWT

;++	DKDLB	-	Default Lower Bound
;
;	T2/	Number (from .CMNUM COMND%) to increment for defaulting
;	Returns +1 with DLBBUF containing default string
;
;--

;[5000] New

DKDLB:	HRROI	T1,DLBBUF	;Point at default buffer
	MOVEI	T2,1(T2)	;Increment number
	MOVEI	T3,^D10		;Radix 10
	NOUT%
	 ERJMP	.+1		;Should not fail
	POPJ	P,		;Return

;COMND% functions for /KEY

;Parse a "(" token
DKLP:	FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ /(/]>,
<"(" followed by a list of KEY specifiers>,<(>,DKNO)

DKNO:	FLDDB. (.CMKEY,0,DKNOT,,)

;Parse Lower Bound number
DKLB:	FLD(.CMNUM,CM%FNC)+CM%DPP+CM%HPP+CM%SDH
	^D10
	POINT 7,[ASCIZ /decimal starting byte position of Key/]	
	POINT 7,DLBBUF		;Default string (previous UB+1)

;Parse a ":" token
DKCOL:	FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ /:/]>,
<":" followed by upper bound>,<:>)

;Parse Upper Bound number
DKUB:	FLDDB. (.CMNUM,CM%SDH,^D10,
<decimal ending byte position of Key>)

;Parse either ":", "," or ")" tokens
DKCCP:	FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ /:/]>,
<":" followed by Key data type>,<:>,DKCOM)

;Parse either "," or ")" tokens
DKCOM:	FLDDB. (.CMCMA,CM%SDH,,
<"," followed by more KEY specifiers>,,DKRP)

;Parse a ")" token
DKRP:	FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ /)/]>,
<")" to terminate list of specifiers>)

;Parse key data type keyword
DKTYP:	FLDDB. (.CMKEY,0,DKDTB,<Key data type,>,<CHARACTER>)


	DEFINE	X(KEYWORD,TYPE<TP%CHR>)<
	 XWD	[ASCIZ /KEYWORD/],TYPE
				  > ;End X
;Keyword table for key data types

DKDTB:	XWD	DTBL,DTBL
	X	CHARACTER		;Default is TP%CHR
	X	INTEGER,TP%INT
	DTBL==.-DKDTB-1

DKNOT:	XWD	DNTBL,DNTBL
	X	NONE,0
	DNTBL==.-DKNOT-1

	SEGMENT	DATA

D.KEY:	BLOCK	1		;ADDRESS OF USER 2NDARY ARGLIST FOR /KEY:
K.KCT:	BLOCK	1		;COUNT OF SPECIFIERS
DLBBUF:	BLOCK	2		;DEFAULT LOWER BOUND BUFFER


	SEGMENT	CODE
RELJFN:	SKIPN	T1,IJFN(D)	;GET JFN
	 POPJ	P,		;NOTHING TO DO IF NO JFN
	CAMN	T1,[-1]		;[5000] RMS "JFN"?
	 JRST	SETJF0		;[5000] YES, DON'T RELEASE IT
	CAIE	T1,.PRIIN	;If not real JFN,
	CAIN	T1,.PRIOU	;. .
	 JRST	SETJF0		;Don't release it
	RLJFN%
	 JSHALT			;SHOULD NOT FAIL

SETJF0:	SETZM	IJFN(D)		;CLEAR JFNS
	SETZM	OJFN(D)
	POPJ	P,

;Filespec or CRLF or switch for OPEN and CLOSE
;Filespec or CRLF for INQUIRE

FLDFN:	FLDDB. (.CMFIL,CM%SDH,,<file name>,,FLDCFM)
FLDCFM:	FLDDB. (.CMCFM,CM%SDH,,,,)

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

	SEGMENT	DATA

FLDSWT:	BLOCK	.CMDAT+1	;Allocate space for FLDDB. block

CSB:	BLOCK	12		;COMMAND STATE BLOCK

JFNBLK:	BLOCK	.GJNOD+1	;[5000] GTJFN ARG BLOCK

FDB:	BLOCK	1+.FBSIZ	;FDB, UP THROUGH FILE SIZE

SWTDDB:	BLOCK	2		;FLDDB FOR SWITCHES

SAVEP:	BLOCK	1		;TEMP FOR STACK POINTER

	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:	PUSHJ	P,COL1		;GET TO COLUMN 1
CMDER2:	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?
	 $ACALL	CEF		;YES. CANNOT RECOVER.

	XMOVEI	T5,ATMBUF	;POINT TO ATMBUF FOR ERROR MSGS
	CAIE	T1,NPXNOM	;"Does not match switch or keyword"?
	 CAIN	T1,NPXAMB	; or "Ambiguous"?
	  $DCALL EDA		;YES. PRINT MSG AND GO TO DIALOG
	$DCALL	EDS		;NEITHER. PRINT JSYS ERROR

;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:	HRRZ	T1,CSB+.CMIOJ	;GET OUTPUT JFN
	HRROI	T2,%CRLF	;GET TO COLUMN 1 BY TYPING CRLF
	MOVNI	T3,2		;2 CHARACTERS
	SOUTR%
	 JSHALT
	POPJ	P,		;RETURN

;ROUTINE TO FILL IN GTJFN BLOCK FROM DDB
;POINTS DEFAULTS AT THE STRINGS STORED IN THE DDB

;[5000] Re-written

SETJFN:	SKIPLE	IJFN(D)		;IF ANY JFN ALREADY
	 $SNH			;IT'S A BUG!

	SETZM	JFNBLK+.GJATR	;CLEAR ADDRESS OF ATTRIBUTE BLOCK

	HLLZ	T1,GEN(D)	;[4137] GET GENERATION
	TLZ	T1,17		;[4137] CLEAR ALL EXCEPT 2 FIRST CHARACTERS
	CAME	T1,[ASCIZ /*/]	;[4137] IS IT A FULL WILDCARD?
	 JRST	GENDEC		;[4137] NOT WILD-CARD. GO CONVERT TO BINARY
	MOVX	T1,.GJALL	;[4137] YES. USE WILD-CARD GENERATION NUMBER
	JRST	GOTGEN		;[4137] GO STORE IT

GENDEC:	XMOVEI	T1,GEN(D)	;[4137] POINT TO ASCIZ GENERATION NUMBER
	PUSHJ	P,ASCDEC	;CONVERT TO BINARY
	 $SNH			;SHOULDN'T GET ILLEGAL GENERATION HERE
GOTGEN:	MOVEI	T1,(T1)		;[4137] RIGHT HALF ONLY
	TXO	T1,GJ%MSG!GJ%XTN ;ALWAYS TYPE CONFIRMATION MESSAGE
				; and use extended GTJFN block
	SKIPE	TMPFIL(D)	;[4135] IS IT A TEMPORARY FILE?
	 TXO	T1,GJ%TMP	;[4135] YES. IT IS STICKY!
	MOVEM	T1,JFNBLK+.GJGEN ;STORE IN FLAG WORD
	MOVEI	T1,<.GJNOD-.GJF2> ;No flags,,# words to follow ext 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,DIRNAM(D)	;DIRECTORY
	  HRROI	T1,DIRNAM(D)
	MOVEM	T1,JFNBLK+.GJDIR

	SKIPE	T1,FILNAM(D)	;FILENAME
	  HRROI	T1,FILNAM(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

	SKIPN	NODNAM(D)	;NODENAME?
	 JRST	SETRAT		;NO, MAYBE ATTRIBUTES
	HRROI	T1,NODNAM(D)	;YES
	MOVEM	T1,JFNBLK+.GJNOD

SETRAT:	MOVE	T1,FNSPNT	;GET FNS POINTER
	MOVEM	T1,FNSPNS	;SAVE
	SETZM	FNSPNT		;CLEAR PNTR
	SETZM	RATBLK		;CLEAR COUNT
	SETZM	RATBLK+1	;CLEAR USERID PNTR
	SETZM	RATBLK+2	;AND PASSWORD PNTR
	SKIPN	USERID(D)	;ANY USERID?
	 JRST	SPASS		;NO
	MOVE	T1,[POINT 7,RATUSR]
	MOVEM	T1,RATBLK+1
	AOS	RATBLK
	MOVE	T1,[ASCIZ/USER:/] ;KEYWORD PREFIX
	MOVEM	T1,RATUSR	;STORE
	MOVE	T1,[POINT 7,RATUSR+1] ;POINT AT ARG STRING
	MOVEM	T1,FNSPNT
	MOVEI	T1,USERID(D)	;GET SOURCE PNTR
	PUSHJ	P,ASCFNS	;OUTPUT IT

SPASS:	SKIPN	PASWRD(D)	;ANY PASSWORD?
	 JRST	SATR		;NO, CHECK ATTRIBUTES
	MOVE	T1,[POINT 7,RATPAS]
	MOVEM	T1,RATBLK+2
	AOS	RATBLK
	MOVE	T1,[ASCIZ/PASS:/] ;KEYWORD PREFIX
	MOVEM	T1,RATPAS
	MOVE	T1,[POINT 7,RATPAS+1] ;ARG STRING
	MOVEM	T1,FNSPNT
	MOVEI	T1,PASWRD(D)	;GET SOURCE PNTR
	PUSHJ	P,ASCFNS	;OUTPUT IT

SATR:	SKIPE	RATBLK		;IF ATTRIBUTES,
	 AOS	RATBLK		;ADJUST COUNT WORD
	XMOVEI	T1,RATBLK	;GET ADDRESS OF REMOTE ATTRIBUTE BLK
	SKIPE	FNSPNT		;ANY ATTRIBUTES FOUND?
	 MOVEM	T1,JFNBLK+.GJATR ;YES, STORE ADDRESS
	MOVE	T1,FNSPNS	;GET SAVED PNTR
	MOVEM	T1,FNSPNT	;RESTORE
	POPJ	P,

	SEGMENT	DATA

RATBLK:	0			;COUNT OF WORDS ATTRIBUTE BLOCK.
	0			;PNTR TO USERID STRING
	0			;PNTR TO PASSWORD STRING
RATLEN==.-RATBLK


RATUSR:	BLOCK	LUIDW+1		;USER:userid
RATPAS:	BLOCK	LPWDW+1		;PASS:password
FNSPNS:	BLOCK	1		;SAVED FNS PNTR

	SEGMENT	CODE
;  MTAJFN checks type type of device; if it's a MAGTAPE unit then lets 
;  assume it's a labeled MAGTAPE. When doing a GTJFN on a labeled 
;  MAGTAPE we have to include the file specification attributes
;  like the BLOCK-SIZE, RECORD-LENGTH & Tape FORMAT.  If is a
;  MAGTAPE but not a labeled MAGTAPE tape these file attributes
;  will be ignored.
;
MTAJFN:	LOAD	T2,INDX(D)	;GET THE DEVICE TYPE
	CAIE	T2,DI.MTA	;IS IT A MAGTAPE
	 POPJ	P,		;NO. RETURN. 
	MOVE	T1,DVBTS(D)	;GET DEVICE BITS
	TXNN	T1,DV%MNT	;IS IT MOUNTED?
	 POPJ	P,		;NO. CAN'T SET ATTRIBUTES
;
;  Move the address of the GTJFN_Attributes_Block into the 
;  GTJFN_Argument_Block and clear out the old numbers if any.
;
	XMOVEI	T1,ATRBLK	;GET ADDRESS OF ATTRIBUTE BLOCK
	MOVEM	T1,JFNBLK+.GJATR	;STORE ADDRESS OF ATTRIBUTE BLOCK
	MOVE	T1,[ASCII /BLOC:/] ;SETUP BLOCK-LENGTH ATTRIBUTE STRING
	MOVEM	T1,ATRBKZ
	SETZM	ATRBKZ+1	;CLEAR THE BLOCK-SIZE ATTRIBUTE
	MOVE	T1,[ASCII /RECO:/] ;SETUP RECORD-LENGTH ATTRIBUTE STRING
	MOVEM	T1,ATRREC
	SETZM	ATRREC+1	;CLEAR THE RECORD-SIZE ATTRIBUTE
	MOVE	T1,[ASCII /FORM:/] ;SETUP FORMAT ATTRIBUTE STRING
	MOVEM	T1,ATRFMT

;
;  Set up the Block_Size
;
	LOAD	T1,BLKSZ(D)	;GET BLOCKSIZE
	MOVE	T2,[POINT 7,ATRBKZ+1] ;POINTER TO BLOCK SIZE ARG STRING
	PUSHJ	P,DECASC	;CONVERT BLOCK SIZE TO STRING
;
;  Set up the Record_Length
;
	SKIPN	T1,RSIZE(D)	;GET RECORDSIZE
	 LOAD	T1,BLKSZ(D)	;NONE. USE BLOCKSIZE
	MOVE	T2,[POINT 7,ATRREC+1] ;POINTER TO RECL ARG STRING
	PUSHJ	P,DECASC	;CONVERT RECORD LENGTH TO STRING
;
;  Set up the Tape_Format
;
	LOAD	T1,RECTP(D)	;GET THE RECORD FORMAT
	MOVE	T1,RECASC(T1)	;GET IT'S ASCIZ EQUIVALENT
	MOVEM	T1,ATRFMT+1	;SAVE AFTER "FORM:"
	POPJ	P,		;RETURN TO CALLER

ATRBLK:	EXP	ATRLEN		;[5002] COUNT OF WORDS ATTRIBUTE BLOCK.
	POINT	7,ATRBKZ	;BYTE POINTER TO BLOCK-LENGTH STRING.
	POINT	7,ATRREC	;BYTE POINTER TO RECORD-LENGTH STRING.
	POINT	7,ATRFMT	;BYTE POINTER TO FORMAT STRING.
ATRLEN==.-ATRBLK		;[5002]

RECASC:	ASCIZ	/U/		;UNSPECIFIED
	ASCIZ	/U/		;UNDEFINED
	ASCIZ	/F/		;FIXED
	ASCIZ	/D/		;DELIMITED
	ASCIZ	/S/		;SEGMENTED
	ASCIZ	/U/		;STREAM_CR
	ASCIZ	/U/		;STREAM_LF

	SEGMENT	DATA

ATRBKZ:	BLOCK	2		;BLOCK-LENGTH
ATRREC:	BLOCK	2		;RECORD-LENGTH
ATRFMT:	BLOCK	2		;FORMAT
ATRDEF:	BLOCK	1		;DEFAULT BLOCK-LENGTH FROM GETJI

	SEGMENT	CODE

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

;[5000] Re-written

DOJFNS:	SKIPE	T1,IJFN(D)	;GET JFN
	 CAIN	T1,.PRIIN	;IS IT AN OPEN CONTROLLING TTY:?
	  POPJ	P,		;NO JFN OR CONTROLLING TTY

%DOJFNS:
	SETZM	TMPFIL(D)	;[4135] ASSUME NOT A TEMPORARY FILE
	MOVE	T2,IJFN(D)	;[4135] GET JFN BITS
	TXNE	T2,GJ%TFS	;[4135] IS IT A TEMPORARY FILE?
	 SETOM	TMPFIL(D)	;[4135] YES. SAVE INFO FOR LATER

	HRROI	T1,DEV(D)	;STORE DEVICE AS SUBSEQUENT DEFAULT
	MOVE	T2,IJFN(D)	;GET JFN
	MOVX	T3,FLD(.JSAOF,JS%DEV)
	JFNS%

	HRROI	T1,DIRNAM(D)	;STORE DIRECTORY
	MOVE	T2,IJFN(D)	;GET JFN
	MOVX	T3,FLD(.JSAOF,JS%DIR)
	JFNS%

	HRROI	T1,FILNAM(D)	;STORE FILENAME
	MOVE	T2,IJFN(D)	;GET JFN
	MOVX	T3,FLD(.JSAOF,JS%NAM)
	JFNS%

	HRROI	T1,EXT(D)	;STORE EXTENSION
	MOVE	T2,IJFN(D)	;GET JFN
	MOVX	T3,FLD(.JSAOF,JS%TYP)
	JFNS%

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

	HRROI	T1,GEN(D)	;STORE GENERATION NUMBER IN ASCIZ
	MOVE	T2,IJFN(D)	;GET JFN
	MOVX	T3,FLD(.JSAOF,JS%GEN)
	JFNS%


	SETZM	TATBLK		;CLEAR THE TEMP ATRIBUTE BLOCK
	MOVE	T1,[TATBLK,,TATBLK+1]
	BLT	T1,TATBLK+TATMAX


	HRROI	T1,TNODE	;STORE NODE IN TEMP BLOCK
	MOVE	T2,IJFN(D)	;GET JFN AGAIN
	MOVX	T3,JS%NOD	;JUST THE NODE NAME, PLEASE
	JFNS%
	 ERJMP	.+1		;CAN'T. NO PROBLEM

	HRROI	T1,TPASWD	;STORE PASSWORD
	MOVE	T2,IJFN(D)	;GET JFN AGAIN
	MOVX	T3,FLD(.JSAOF,JS%AT1)
	MOVE	T4,[POINT 7,[ASCIZ /PASSWORD/]]
	JFNS%
	 ERJMP	.+1		;CAN'T. NO PROBLEM

	HRROI	T1,TACCT	;STORE ACCOUNT STRING
	MOVE	T2,IJFN(D)	;GET JFN AGAIN
	MOVX	T3,FLD(.JSAOF,JS%ACT)
	JFNS%
	 ERJMP	.+1		;CAN'T. NO PROBLEM

	HRROI	T1,TUSID	;STORE USERID
	MOVE	T2,IJFN(D)	;GET JFN AGAIN
	MOVX	T3,FLD(.JSAOF,JS%AT1)
	MOVE	T4,[POINT 7,[ASCIZ /USERID/]]
	JFNS%
	 ERJMP	.+1		;CAN'T. NO PROBLEM

;NOW CHECK ATTRIBUTES AND, IF NON-ZERO, RETURN THEM TO DDB

	SKIPN	TNODE		;ANY NODE?
	 JRST	WPASW		;NO, CHECK PASSWORD
	MOVE	T1,[POINT 7,NODNAM(D)]
	MOVEM	T1,FNSPNT	;DEST PNTR
	XMOVEI	T1,TNODE	;SOURCE
	PUSHJ	P,ASCFNS
	SETZ	T1,
	IDPB	T1,FNSPNT
WPASW:	SKIPN	TPASWD		;ANY PASSWORD?
	 JRST	WACCT		;NO, CHECK ACCOUNT
	MOVE	T1,[POINT 7,PASWRD(D)]
	MOVEM	T1,FNSPNT
	XMOVEI	T1,TPASWD
	PUSHJ	P,ASCFNS
	SETZ	T1,
	IDPB	T1,FNSPNT
WACCT:	SKIPN	TACCT		;ACCOUNT?
	 JRST	WUSID		;NO, CHECK USERID
	MOVE	T1,[POINT 7,ACCNT(D)]
	MOVEM	T1,FNSPNT
	XMOVEI	T1,TACCT
	PUSHJ	P,ASCFNS
	SETZ	T1,
	IDPB	T1,FNSPNT
WUSID:	SKIPN	TUSID		;ANY USERID?
	 POPJ	P,		;NO, ALL DONE
	MOVE	T1,[POINT 7,USERID(D)]
	MOVEM	T1,FNSPNT
	XMOVEI	T1,TUSID
	PUSHJ	P,ASCFNS
	SETZ	T1,
	IDPB	T1,FNSPNT
	POPJ	P,

	SEGMENT	DATA

;Temporary block for attributes

TATBLK:
TNODE:	BLOCK	LNODW		;NODE
TPASWD:	BLOCK	LPWDW		;PASSWORD
TACCT:	BLOCK	LACTW		;ACCOUNT
TUSID:	BLOCK	LUIDW		;USERID
TATMAX==.-TATBLK-1

	SEGMENT	CODE
ERGEN:	MOVE	T1,FNSPNT	;PUT JFNS STRING IN BLOCK
	MOVE	T2,IJFN(D)	;GET JFN
	LOAD	T4,INDX(D)	;GET DEVICE INDEX
	MOVE	T3,NDFBTS(T4)	;USE AN ALTERNATE SET OF BITS
	SKIPE	NODNAM(D)	;ANY NODE NAME IN DDB?
	 TXO	T3,JS%NOD	;YES. GET A NODE NAME TOO!
	JFNS%
	 JSHALT			;SHOULDN'T FAIL
	MOVEM	T1,FNSPNT	;UPDATE POINTER
	POPJ	P,		;DONE

GENFNS:
GTNAM:	SKIPE	IJFN(D)		;IS THERE A JFN ALREADY?
	 JRST	GTJFNS		;YES. GO GET FILE STRING

	PUSHJ	P,SETJFN	;SETUP JFN BLOCK
	MOVX	T1,GJ%OFG	;DEFERRED-OPEN FILES ARE PARSE-ONLY
	IORM	T1,JFNBLK+.GJGEN ;
	MOVX	T1,G1%SLN	;Don't expand logical names either
	IORM	T1,JFNBLK+.GJF2
	MOVEI	T1,JFNBLK	;POINT TO GTJFN BLOCK
	SETZ	T2,		;NO STRING
	GTJFN%			;GET A JFN
	 ERJMP	FNOJFN		;FOR SOME REASON, CAN'T GET ONE
	MOVEM	T1,IJFN(D)	;[4135] STORE JFN WITH FLAGS
	PUSHJ	P,GTJFNS	;GET JFNS STRING
	PJRST	RELJFN		;RELEASE JFN

FNOJFN:	SKIPN	DEV(D)		;ANY DEVICE?
	 POPJ	P,		;NO. NOTHING ELSE, EITHER
	SKIPN	NODNAM(D)	;ANY NODE NAME?
	 JRST	FNJDEV		;NO. GO OUTPUT DEVICE
	XMOVEI	T1,NODNAM(D)	;NO. OUTPUT NODE NAME
	PUSHJ	P,ASCFNS
	MOVEI	T1,":"		;DEPOSIT 2 COLONS
	IDPB	T1,FNSPNT
	IDPB	T1,FNSPNT

FNJDEV:	XMOVEI	T1,DEV(D)	;Put device
	PUSHJ	P,ASCFNS	;into buffer
	MOVEI	T1,":"
	IDPB	T1,FNSPNT	;DEPOSIT IN BUFFER
	SKIPN	DIRNAM(D)	;Directory known yet?
	 JRST	FLEXGN		;No

	MOVEI	T1,"<"		;OUTPUT FILESTRING LEFT BRACKET
	IDPB	T1,FNSPNT
	XMOVEI	T1,DIRNAM(D)
	PUSHJ	P,ASCFNS	;DIRECTORY
	MOVEI	T1,">"
	IDPB	T1,FNSPNT

;Here to finish putting out FILE.EXT.GEN

FLEXGN:	SKIPN	FILNAM(D)	;ANY FILE GIVEN?
	 POPJ	P,		;NO. NOTHING MORE TO PRINT
	XMOVEI	T1,FILNAM(D)	;OUTPUT FILENAME
	PUSHJ	P,ASCFNS
	MOVEI	T1,"."
	IDPB	T1,FNSPNT
	XMOVEI	T1,EXT(D)	;OUTPUT EXTENSION
	PUSHJ	P,ASCFNS
	MOVE	T2,FNSPNT	;[5000] SAVE GENERATION PNTR
	MOVEM	T2,%GNPNT	;[5000]
	MOVEI	T1,"."
	IDPB	T1,FNSPNT
	XMOVEI	T1,GEN(D)	;OUTPUT GENERATION
	PJRST	ASCFNS

GTJFNS:	MOVE	T1,FNSPNT	;PUT JFNS STRING IN BLOCK
	MOVE	T2,IJFN(D)	;GET JFN
	LOAD	T4,INDX(D)	;GET DEVICE INDEX
	MOVE	T3,FNSBTS(T4)	;GET PROPER BITS FOR THIS DEVICE
	SKIPE	NODNAM(D)	;ANY NODE NAME IN DDB?
	 TXO	T3,JS%NOD	;YES. GET A NODE NAME TOO!
	JFNS%
	 JSHALT			;SHOULDN'T FAIL
	MOVEM	T1,FNSPNT	;UPDATE POINTER
	POPJ	P,		;DONE


FNSBTS:	FLD(.JSAOF,JS%DEV)+JS%PAF ;TTY - DEVICE ONLY
	FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF	;DISK
	FLD(.JSAOF,JS%DEV)+JS%PAF ;MTA - DEVICE ONLY
	FLD(.JSAOF,JS%DEV)+JS%PAF ;OTHER - DEVICE ONLY
	FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF ;[5000] REMOTE STREAM FILE
	FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF ;[5000] RMS FILE
NDFBTS:	FLD(.JSAOF,JS%DEV)+JS%PAF ;TTY - DEVICE ONLY
	0			;DISK - NOTHING FOR DEFAULTS
	FLD(.JSAOF,JS%DEV)+JS%PAF ;MTA - DEVICE ONLY
	FLD(.JSAOF,JS%DEV)+JS%PAF ;OTHER - DEVICE ONLY
	FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF ;[5000] REMOTE STREAM FILE
	FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF ;[5000] RMS FILE

NDLOOK:
DLOOK:	PUSHJ	P,SETJFN	;SETUP FOR GTJFN
	MOVX	T1,GJ%OLD+GJ%IFG ;[4135] LOOKUP FILE
	IORM	T1,JFNBLK+.GJGEN
	MOVEI	T1,JFNBLK	;POINT TO JFN BLOCK
	SETZ	T2,
	GTJFN%			;SEE IF FILE EXISTS
	 ERJMP	%POPJ		;IT DOES NOT.
	MOVEI	T1,(T1)		;GET JUST THE JFN
	HRRZM	T1,IJFN(D)	;SAVE IT WITH NO FLAGS
	JRST	%POPJ1		;SKIP RETURN

> ;IF20
IF10,<

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

.CTTRM=<SIXBIT /TTY/>


;DLOOK AND NDLOOK - LOOKUP FILE
NDLOOK:	JRST	%POPJ1		;DEVICE MUST BE THERE

DLOOK:	MOVE	T1,[FO.PRV+FO.ASC+.FORED] ;SETUP FOR LOOKUP
	MOVEM	T1,FBLK(D)
	MOVEI	T1,.IODMP	;DUMP MODE, SO NO BUFFERS
	MOVEM	T1,FBLK+.FOIOS(D)
	SETZM	FBLK+.FONBF(D)	;DON'T LEAVE JUNK AROUND FOR HEADERS
	SETZM	FBLK+.FOBRH(D)
	PUSHJ	P,SETFB		;SETUP FILOP BLOCK

	MOVEI	T1,FBLK(D)	;POINT TO FILOP BLOCK
	HRLI	T1,.FOMAX	;SETUP FOR FILOP
	FILOP.	T1,		;LOOKUP FILE
	 JRST	DLERR		;NOT FOUND
LOOKOK:	AOS	(P)		;[4211] FOUND. SKIP RETURN
	PJRST	SETPPB		;[4134] POINT BACK TO PATH BLOCK AGAIN

DLERR:	CAIN	T1,ERPRT%	;PROTECTION FAILURE?
	 JRST	LOOKOK		;[4211] YES. WE REALLY FOUND THE FILE
	PUSH	P,T1		;[4211] SAVE ERROR CODE
	PUSHJ	P,RELJFN	;[4211] RELEASE THE CHANNEL (IT'S USELESS)
	POP	P,T1		;[4211] RESTORE ERROR CODE
	PJRST	SETPPB		;[4134] POINT BACK TO PATH BLOCK AGAIN

;SETFI - MOVE THE DDB INFO TO THE FILE BLOCKS

SETFI:	MOVEI	T1,DEV(D)	;GET ASCIZ DEVICE NAME POINTER
	HRLI	T1,(POINT 7)
	MOVEM	T1,SRCBP
	MOVEI	T1,LDEVC	;AND COUNT
	MOVEM	T1,SRCLEN
	XMOVEI	T1,[ASCIZ /device/]
	MOVEM	T1,%ARGNM
	PUSHJ	P,ASCSIX	;CONVERT TO SIXBIT
	 $DCALL	IDD		;ILLEGAL CHAR IN DEVICE
	MOVE	T1,ATMBUF	;GET DEVICE NAME
	MOVEM	T1,FBLK+.FODEV(D) ;SAVE IT
	MOVEM	T1,PTHB(D)	;[4211] ALSO IN PATH BLOCK IF FILOP FAILS

	SETZM	LKPB+.RBNAM(D)	;[4205] CLEAR FILENAME
	HRRZS	LKPB+.RBEXT(D)	;[4205] AND EXTENSION
	MOVE	T1,FILNAM(D)	;[4205] GET FILE NAME
	MOVE	T2,EXT(D)	;[4205] AND EXTENSION
	CAME	T1,[ASCIZ /*/]	;[4205] IS IT *.*?
	 CAMN	T2,[ASCIZ /*/]	;[4205] 
	  JRST	SETDIR		;[4205] YES. DON'T SETUP FILENAME/EXT
	MOVEI	T1,FILNAM(D)	;GET ASCIZ FILENAME POINTER
	HRLI	T1,(POINT 7)
	MOVEM	T1,SRCBP
	MOVEI	T1,LFILC	;AND COUNT
	MOVEM	T1,SRCLEN
	XMOVEI	T1,[ASCIZ /filename/]
	MOVEM	T1,%ARGNM
	PUSHJ	P,ASCSIX	;CONVERT TO SIXBIT
	 $DCALL	IDD		;ILLEGAL CHAR IN FILENAME
	MOVE	T1,ATMBUF	;GET FILENAME
	MOVEM	T1,LKPB+.RBNAM(D) ;SAVE IT

	MOVEI	T1,EXT(D)	;GET ASCIZ EXTENSION STRING
	HRLI	T1,(POINT 7)
	MOVEM	T1,SRCBP
	MOVEI	T1,3		;ONLY 3 CHARS ALLOWED FOR EXTENSION
	MOVEM	T1,SRCLEN
	XMOVEI	T1,[ASCIZ /extension/]
	MOVEM	T1,%ARGNM
	PUSHJ	P,ASCSIX	;CONVERT TO SIXBIT
	 $DCALL	IDD		;ILLEGAL CHAR IN EXTENSION
	MOVE	T1,ATMBUF	;GET EXTENSION
	HLLM	T1,LKPB+.RBEXT(D) ;SAVE IT

SETDIR:	SKIPN	DIRNAM(D)	;[4205] ANY DIRECTORY PATH SET?
	 JRST	SETCC		;[4174] NO. GO SET CARRIAGECONTROL
	MOVEI	T1,DIRNAM(D)	;GET ASCIZ DIRECTORY STRING
	HRLI	T1,(POINT 7)
	MOVEM	T1,SRCBP
	MOVEI	T1,LDIRC	;AND LENGTH
	MOVEM	T1,SRCLEN
	PUSHJ	P,DPTH		;TRANSLATE TO PATH
	 POPJ	P,		;ILLEGAL PATH

SETCC:	LOAD	T1,CC(U)	;[4171] GET CARRIAGE CONTROL VALUE
	CAIE	T1,CC.FOR	;[4171] FORTRAN?
	 JRST	%POPJ1		;[4171] NO. DONE
	MOVX	T1,RB.DEC	;[4171] TELL TOPS-10 TO PAY ATTENTION
	IORM	T1,LKPB+.RBTYP(D) ;[4171] 
	MOVEI	T1,.RBCFO	;[4171] AND SET FORTRAN CARRIAGE CONTROL
	DPB	T1,[POINTR (LKPB+.RBTYP(D),RB.DCC)] ;[4171] 

	JRST	%POPJ1		;DONE


;DOJFNS - PUT CERTAIN FILE INFORMATION FROM THE FILE BLOCKS
;BACK INTO THE DDB

DOJFNS:	LOAD	T1,INDX(D)	;[4141] GET DEVICE INDEX
	SKIPE	PTHB+.PTSTR(D)	;[4211] ANY RETURNED DEVICE?
	CAIE	T1,DI.DSK	;[4141] DISK?
	 POPJ	P,		;[4141] NO. NOTHING TO DO

	MOVEI	T1,DEV(D)	;PUT DEVICE BACK
	HRLI	T1,(POINT 7)
	MOVEM	T1,FNSPNT
	MOVE	T1,PTHB+.PTSTR(D) ;GET RETURNED DEVICE
	PUSHJ	P,SIXASC	;CONVERT TO ASCII
	SETZ	T1,
	IDPB	T1,FNSPNT	;END WITH NULL

	MOVEI	T1,FILNAM(D)	;PUT FILENAME BACK
	HRLI	T1,(POINT 7)
	MOVEM	T1,FNSPNT
	MOVE	T1,LKPB+.RBNAM(D) ;GET FILENAME
	PUSHJ	P,SIXASC	;CONVERT TO ASCII
	SETZ	T1,
	IDPB	T1,FNSPNT	;END WITH NULL

	MOVEI	T1,EXT(D)	;PUT EXTENSION BACK
	HRLI	T1,(POINT 7)
	MOVEM	T1,FNSPNT
	HLLZ	T1,LKPB+.RBEXT(D) ;GET EXTENSION
	PUSHJ	P,LHASC		;CONVERT TO ASCII
	SETZ	T1,
	IDPB	T1,FNSPNT	;END WITH NULL

	MOVEI	T1,DIRNAM(D)	;PUT DIRECTORY BACK
	HRLI	T1,(POINT 7)
	MOVEM	T1,FNSPNT
	PUSHJ	P,PTHASC
	SETZ	T1,		;END WITH NULL
	IDPB	T1,FNSPNT

	SETZM	GEN(D)		;NO GENERATIONS ON TOPS-10
	POPJ	P,		;DONE


;GENFNS & GTNAM - GET A FULL FILENAME STRING. IF THE FILE IS OPEN
;(I.E. FBLK(D).NE.0), RETURNS AN "EXPANDED" STRING, USING THE
;EXPANDED DEVICE NAME AND PATH. IF THE DEVICE IS
;NOT A DISK, JUST GETS THE EXPANDED DEVICE NAME.

FNOJFN:	SKIPN	DEV(D)		;ANY DEVICE?
	 POPJ	P,		;NO. NOTHING ELSE, EITHER
	SKIPN	NODNAM(D)	;ANY NODE NAME?
	 JRST	FNJDEV		;NO. GO OUTPUT DEVICE
	XMOVEI	T1,NODNAM(D)	;YES. OUTPUT NODE NAME
	PUSHJ	P,ASCFNS
	MOVEI	T1,":"		;DEPOSIT 2 COLONS
	IDPB	T1,FNSPNT
	IDPB	T1,FNSPNT

FNJDEV:	XMOVEI	T1,DEV(D)	;Put device
	PUSHJ	P,ASCFNS	;into buffer
	MOVEI	T1,":"
	IDPB	T1,FNSPNT	;DEPOSIT IN BUFFER
	SKIPE	NODNAM(D)	;ANY NODENAME?
	 PUSHJ	P,DIROUT	;YES. OUTPUT DIRECTORY HERE
	SKIPN	FILNAM(D)	;ANY FILE GIVEN?
	 POPJ	P,		;NO. NOTHING MORE TO PRINT
	XMOVEI	T1,FILNAM(D)
	PUSHJ	P,ASCFNS
	MOVEI	T1,"."
	IDPB	T1,FNSPNT
	XMOVEI	T1,EXT(D)	;OUTPUT EXTENSION
	PUSHJ	P,ASCFNS
	SKIPN	GEN(D)		;ANY GENERATION?
	 JRST	NOGEN		;NO. SKIP IT
	MOVEI	T1,"."
	IDPB	T1,FNSPNT
	XMOVEI	T1,GEN(D)	;OUTPUT GENERATION NUMBER
	PUSHJ	P,ASCFNS
NOGEN:	SKIPE	NODNAM(D)	;IS THERE A NODENAME?
	 POPJ	P,		;YES. DIRECTORY IS ALREADY OUT
DIROUT:	SKIPN	DIRNAM(D)	;ANY DIRECTORY SPECIFIED?
	 POPJ	P,		;NO. DONE
	MOVEI	T1,"["		;OUTPUT FILESTRING LEFT BRACKET
	IDPB	T1,FNSPNT
	XMOVEI	T1,DIRNAM(D)
	PUSHJ	P,ASCFNS	;DIRECTORY
	MOVEI	T1,"]"
	IDPB	T1,FNSPNT
	POPJ	P,		;DONE

ERGEN:	SKIPE	NODNAM(D)	;ANY NODE NAME?
	 JRST	FNOJFN		;YES. GIVE FULL FILESPEC FROM DDB
	MOVE	T1,PTHB+.PTSTR(D) ;GET DISK WHERE FILE WAS FOUND
	CAMN	T1,%JIBLK+.PTSTR ;SAME AS 'DSK' TOP DISK?
	 JRST	ERFIL		;YES. SKIP IT
	PUSHJ	P,SIXASC	;NO. OUTPUT IT
	MOVEI	T1,":"		;WITH A COLON
	IDPB	T1,FNSPNT
ERFIL:	MOVE	T1,LKPB+.RBNAM(D) ;GET FILENAME
	PUSHJ	P,SIXASC	;OUTPUT IT
	MOVEI	T1,"."		;OUTPUT PERIOD
	IDPB	T1,FNSPNT
	MOVE	T1,LKPB+.RBEXT(D) ;GET EXTENSION
	PUSHJ	P,LHASC		;OUTPUT IT
	XMOVEI	T2,PTHB+.PTPPN(D) ;POINT TO PATH BLOCK
	MOVEI	T3,%JIBLK+.PTPPN ;AND TO DEFAULT PATH BLOCK
	HRLI	T3,.PTPPN-.PTMAX ;GET # SFDS + PPN
ERFLP:	MOVE	T1,(T2)		;GET FILE PATH ELEMENT
	CAME	T1,(T3)		;SAME AS DEFAULT PATH?
	 JRST	GENPPN		;NO. GIVE ENTIRE PATH
	ADDI	T2,1		;INCR PATH BLOCK PNTR
	AOBJN	T3,ERFLP	;AND DEFAULT PATH POINTER
	POPJ	P,		;ALL THE SAME. NO PPN OUTPUT

GENFNS:	SKIPN	FBLK(D)		;IS FILE OPEN?
	 JRST	FNOJFN		;NO. USE DDB INFO
	SKIPN	NODNAM(D)	;ANY NODE NAME?
	 JRST	FNSNN		;NO
	XMOVEI	T1,NODNAM(D)	;YES. OUTPUT IT
	PUSHJ	P,ASCFNS
	MOVEI	T1,":"		;AND 2 COLONS
	IDPB	T1,FNSPNT
	IDPB	T1,FNSPNT
FNSNN:	MOVE	T1,PTHB+.PTSTR(D) ;YES. GET DEVICE FROM PATH BLOCK
	PUSHJ	P,SIXASC	;PUT INTO STRING BUFFER
	MOVEI	T1,":"		;PUT IN COLON
	IDPB	T1,FNSPNT
	MOVE	T1,LKPB+.RBNAM(D) ;GET FILENAME
	PUSHJ	P,SIXASC	;PUT INTO STRING BUFFER
	MOVEI	T1,"."		;PUT IN DOT
	IDPB	T1,FNSPNT
	MOVE	T1,LKPB+.RBEXT(D) ;GET EXTENSION
	PUSHJ	P,LHASC		;PUT INTO STRING BUFFER
GENPPN:	SKIPN	PTHB+.PTPPN(D)	;ANY PPN?
	 POPJ	P,		;NO. DONE
	MOVEI	T1,"["		;BRACKET THE PPN
	IDPB	T1,FNSPNT
	PUSHJ	P,PTHASC	;CONVERT PATH TO ASCII
	MOVEI	T1,"]"		;FINISH DIRECTORY
	IDPB	T1,FNSPNT
	POPJ	P,

GTNAM:	MOVEI	T1,DEV(D)	;GET DEVICE
	HRLI	T1,(POINT 7)
	MOVEM	T1,SRCBP
	MOVEI	T1,LDEVC	;AND ITS LENGTH
	MOVEM	T1,SRCLEN
	PUSHJ	P,ASCSIX	;CONVERT TO SIXBIT
	 $SNH			;SHOULD HAVE CAUGHT ILLEGAL CHAR BEFORE
	MOVE	T1,ATMBUF	;GET SIXBIT DEVICE NAME
	DEVNAM	T1,		;GET ITS EXPANDED NAME
	 $SNH			;SHOULD HAVE CAUGHT THIS BEFORE
	PJRST	SIXASC		;PUT INTO STRING BUFFER AND LEAVE

;RELJFN - IF FILE IS OPEN (FBLK(D).NE.0), RELEASE THE CHANNEL
RELJFN:	SKIPN	T2,FBLK(D)	;IS FILE OPEN?
	 POPJ	P,		;NO
	HRRI	T2,.FOREL	;GET RELEASE FUNCTION
	MOVE	T1,[1,,T2]	;SETUP FOR FILOP
	FILOP.	T1,		;RELEASE THE CHANNEL
	 TRN			;[4211] IT WAS ALREADY GONE!
	SETZM	FBLK(D)		;CLEAR EVIDENCE OF CHANNEL WORD
	POPJ	P,

PTHASC:	MOVE	T1,PTHB+.PTPPN(D) ;GET THE PPN
	PUSHJ	P,XWDASC	;PUT INTO STRING BUFFER
	MOVEI	T1,PTHB+.PTSFD(D) ;[4134] POINT TO SFDS
	HRLI	T1,-5		;[4134]MAX 5 OF THEM
GPTHLP:	MOVEM	T1,PTHPNT	;[4134] SAVE COUNT/POINTER
	SKIPN	T1,(T1)		;ANY SFD THERE?
	 POPJ	P,		;NONE LEFT
	MOVEI	T0,<",">	;YES. OUTPUT A COMMA
	IDPB	T0,FNSPNT
	PUSHJ	P,SIXASC	;PUT INTO STRING BUFFER
	MOVE	T1,PTHPNT	;[4134]GET POINTER AGAIN
	AOBJN	T1,GPTHLP	;[4134] LOOP FOR ALL SFDS
	POPJ	P,

LHASC:	MOVE	T2,[POINT 6,T1] ;POINT TO T1
	MOVEI	T3,3		;ONLY 3 CHARS
	JRST	SIXLP		;JOIN COMMON CODE

SIXASC:	MOVE	T2,[POINT 6,T1]	;POINT TO T1
	MOVEI	T3,6		;MAX OF 6 CHARACTERS
SIXLP:	ILDB	T0,T2		;GET A CHAR
	JUMPE	T0,%POPJ	;DONE IF ZERO
	ADDI	T0,40		;CONVERT TO ASCII
	IDPB	T0,FNSPNT	;DEPOSIT IN BUFFER
	SOJG	T3,SIXLP	;LOOP
	POPJ	P,

ASCASC:	ILDB	T3,T1		;GET A CHAR
	CAIE	T3,40		;SKIP SPACES
	 IDPB	T3,FNSPNT	;DEPOSIT IN BUFFER
	SOJG	T2,ASCASC	;LOOP FOR CHAR COUNT
	POPJ	P,

XWDASC:	MOVE	T2,[POINT 3,T1]	;POINT TO T1
	MOVEI	T3,6		;6 OCTAL DIGITS
XWDLP1:	ILDB	T0,T2		;GET A DIGIT
	JUMPN	T0,XWDGT1	;IF NON-ZERO, GO PRINT IT
	SOJG	T3,XWDLP1	;IF ZERO, SKIP IT
	JRST	XWDRH		;SHOULDN'T HAPPEN, BUT GO ON TO RH OF WORD

XWDLP2:	ILDB	T0,T2		;GET A DIGIT
XWDGT1:	ADDI	T0,60		;CONVERT TO ASCII
	IDPB	T0,FNSPNT	;DEPOSIT IN TEXT BUFFER
	SOJG	T3,XWDLP2	;LOOP

XWDRH:	MOVEI	T0,<",">	;PUT COMMA IN BUFFER
	IDPB	T0,FNSPNT
	MOVEI	T3,6		;SIX DIGITS AGAIN
XWDLP3:	ILDB	T0,T2		;GET A DIGIT
	JUMPN	T0,XWDGT4	;IF NON-ZERO, GO DEPOSIT IT
	SOJG	T3,XWDLP3	;IF ZERO, SKIP IT
	POPJ	P,		;NO DIGITS ENCODED

XWDLP4:	ILDB	T0,T2		;GET A DIGIT
XWDGT4:	ADDI	T0,60		;CONVERT TO ASCII
	IDPB	T0,FNSPNT	;DEPOSIT IN TEXT BUFFER
	SOJG	T3,XWDLP4	;LOOP
	POPJ	P,

DIALOG:	XMOVEI	T1,[ASCIZ/DIALOG/]
	MOVEM	T1,%ARGNM	;Store arg name incase errors
	PUSHJ	P,SAVERR	;DIVERT ERR MSGS TO TTY
	SKIPN	EFSFLG		;SKIP IF ALREADY TYPED ONCE
	 $ECALL EFS		;ENTER CORRECT FILE SPECS
	SETOM	EFSFLG		;SUPPRESS NEXT TIME

	OUTCHR	["*"]		;PROMPT

	SETZM	SRCLEN		;CLEAR TRANSFERRED SOURCE LENGTH
	MOVE	P3,[POINT 7,%TXTBF] ;POINT TO TEXT DESTINATION
	MOVEI	P4,LTEXTC-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
	AOS	SRCLEN		;INCREMENT TRANSFERRED SOURCE LENGTH
	SOJG	P4,DIAINP	;READ WHOLE STRING
	$DCALL	DTL		;DIALOG STRING TOO LONG



;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

	SETO	T1,		;DECR P3 TO OVERWRITE "-"
	ADJBP	T1,P3
	MOVE	P3,T1
	JRST	DIAINP		;KEEP READING

DIASC1:	SETZ	T1,		;FLAG END OF ASCIZ STRING
	IDPB	T1,P3
	MOVE	P3,[POINT 7,%TXTBF] ;POINT TO TEXT BUFFER
	MOVEM	P3,SRCBP
	PJRST	DIACOM		;JOIN COMMON CODE

;Now string has been stored in %TXTBF.
;SRCBP = current bp to source string.

COMSTR:	PUSHJ	P,SAVERR	;DIVERT ERR MSGS TO TTY
	PUSHJ	P,DIABLT	;COPY THE STRING

DIACOM:	PUSHJ	P,DPRS1		;Parse filename or device ...
	 POPJ	P,		;ERROR. GO TO DIALOG
	CAIN	T1,":"		;Colon terminator?
	 JRST	DIADEV		;Yes, we just got a device
DIASN1:	SKIPN	ATMBUF		;Filename?
	 JRST	DIANFN		;NO
	SETOM	FILPRS(D)	;SET FILESPEC PARSED
	MOVEI	T1,FILNAM(D)	;TRANSFER TO FILENAME
	HRLI	T1,ATMBUF
	BLT	T1,FILNAM+LFILW-1(D)
DIANFN:	LDB	T1,SRCBP	;GET LAST CHARACTER PARSED
	CAIN	T1,"."		;Extension coming?
	 JRST	DIAEXT		;Yes
	PJRST	DIACHK

;Got a device (":" was delimiter)

DIADEV:	SKIPN	ATMBUF		;DEV
	 $DCALL	NDI		;?Null device
	MOVSI	T1,ATMBUF	;TRANSFER TO TEMP BUFFER
	HRRI	T1,TMPBUF	;SO WE CAN CHECK FOR A NODE NAME
	BLT	T1,TMPBUF+LATOMW-1
	SETOM	FILPRS(D)	;SET FILESPEC PARSED
	PUSHJ	P,DPRS1		;Parse filename..
	 POPJ	P,		;ERROR. GO TO DIALOG
	CAIE	T1,":"		;COLON?
	 JRST	DIADV1		;No, ok
	SKIPE	ATMBUF		;ANY CHARS INTERVENING?
	 $DCALL	IDD		;YES. DOUBLE DEVICE NAME ILLEGAL

REPEAT 0,<			;[5000]
	MOVEI	T1,NODNAM(D)	;NO. WE GOT A NODE NAME
	HRLI	T1,TMPBUF
	BLT	T1,NODNAM+LNODW-1(D)
> ;End REPEAT 0 [5000]
	$ECALL	NNI		;[5000] "%Node name ignored"

	PUSHJ	P,DPRS1		;TRY AGAIN
	 POPJ	P,		;ERROR. GO TO DIALOG
	CAIE	T1,":"		;ANOTHER COLON?
	 JRST	DIASN1		;NO. ASSUME IT WAS A FILESPEC
	SKIPN	ATMBUF		;YES. ANY CHARS INTERVENING?
	 $DCALL	IDD		;NO. ILLEGAL CHAR
	MOVEI	T1,DEV(D)	;YES. RECORD DEVICE NAME
	HRLI	T1,ATMBUF
	BLT	T1,DEV+LDEVW-1(D)
	PUSHJ	P,DPRS1		;NOW PARSE YET AGAIN
	 POPJ	P,		;ERROR. GO TO DIALOG
	JRST	DIASN1		;AND ASSUME IT'S A FILESPEC

;THE FIRST ATOM REALLY WAS A DEVICE AND NOT A NODE NAME. MOVE
;THE TEMP BUFFER INTO DEV(D) AND ASSUME THE NEXT THING IS A FILENAME.

DIADV1:	MOVEI	T1,DEV(D)	;RECORD DEVICE NAME
	HRLI	T1,TMPBUF
	BLT	T1,DEV+LDEVW-1(D)
	JRST	DIASN1		;BACK TO FILENAME PARSER

;Next thing is extension ("." seen)

DIAEXT:	PUSHJ	P,DPRS2		;Parse extension
	 POPJ	P,		;ERROR. GO TO DIALOG
	SETOM	FILPRS(D)	;SET FILESPEC PARSED
	MOVEI	T1,EXT(D)	;TRANSFER EXTENSION
	HRLI	T1,ATMBUF
	BLT	T1,EXT+LEXTW-1(D)
	LDB	T1,SRCBP	;GET LAST CHARACTER PARSED
	CAIN	T1,"."		;GENERATION COMING?
	 JRST	DIAGEN		;YES
	PJRST	DIACHK		;GO CHECK END CHAR

DIAGEN:	PUSHJ	P,DPRS2		;PARSE GENERATION
	 POPJ	P,		;ERROR. GO TO DIALOG
	MOVEI	T1,GEN(D)	;TRANSFER GENERATION
	HRLI	T1,ATMBUF
	BLT	T1,GEN+LGENW-1(D)
DIACHK:	LDB	T1,SRCBP	;GET LAST CHARACTER PARSED
	JUMPE	T1,%POPJ	;RETURN IF AT END
	CAIN	T1,"["		;Path coming?
	 JRST	DIAPTH		;Yes
	CAIN	T1,.CHLAB	;Start of protection
	 JRST	DIAPRO
	CAIE	T1,"/"		;Switch coming?
	 $DCALL	IDD		;?Illegal character
	SKIPE	SWTPNT		;ANY SWITCHES ALLOWED?
	 JRST	DIASW1		;YES. GO PROCESS IT
	$DCALL	IDD		;No. Illegal character
;STILL IF10

;Parse a protection (Left angle bracket seen).

DIAPRO:	PUSHJ	P,DOCT		;Read protection
	DPB	T2,[POINTR (LKPB+.RBPRV(D),RB.PRV)] ;STORE IN DDB
	CAIE	T1,.CHRAB	;End of field?
	 $DCALL	IDD		;NO. ILLEGAL CHAR
	PUSHJ	P,DPRCHR	;GET NEXT CHAR
	JUMPE	T1,%POPJ	;Leave if null delimiter
	CAIN	T1,"/"		;Switch coming?
	 JRST	DIASW1		;Yes
	CAIE	T1,"["		;Start of PPN?
	 $DCALL	IDD		;OR IT IS A BAD CHAR

DIAPTH:	SETOM	FILPRS(D)	;SET FILE PARSED
	MOVEI	T1,DIRNAM(D)	;MOVE PATH TO DDB
	HRLI	T1,(POINT 7)
	MOVEM	T1,DSTBP
	MOVEI	T1,LDIRC
	MOVEM	T1,DSTLEN
	MOVEI	T2,"]"		;STOP ON RIGHT SQUARE BRACKET
	SETZM	DIARRY		;NOT AN ARRAY
	PUSHJ	P,MOVARG
	JUMPE	T1,%POPJ	;Return if at end
	PUSHJ	P,DPRS1		;GET NEXT ATOM
	 POPJ	P,		;ERROR. GO TO DIALOG
	JRST	DIASN1		;GO TRY FOR POSSIBLE FILENAME

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

DPTH:	PUSHJ	P,DOCT		;READ PPN
	JUMPN	T2,DPTH2	;GOT PROJECT IF NON-ZERO
	HLRZ	T2,%JIBLK+.PTPPN ;IF ZERO, MIGHT BE NULL PROJECT NUMBER
	CAIN	T1,","		;COMMA?
	 JRST	DPTH2		;YES. SUBSTITUTE THE USER'S PROJECT #
	JUMPE	T1,STOPPN	;IF NULL DELIMITER, STORE ZERO PPN
	 $DCALL IPP		;ILLEGAL PPN CHARACTER

DPTH2:	CAIE	T1,","
	  $DCALL IPP		;ILLEGAL DELIMITER FOR PPN
	PUSH	P,T2
	PUSHJ	P,DOCT
	CAIN	T2,0
	  HRRZ	T2,%JIBLK+.PTPPN
	HRLM	T2,(P)
	POP	P,T2
STOPPN:	MOVSM	T2,PTHB+.PTPPN(D)

	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,","		;COMMA MEANS SFDS COMING
	 $DCALL	IPP		;ELSE ILL DELIMITER IN DIALOG

	CAIL	P2,PTHB+.PTPPN+6(D) ;CHECK SFD COUNT
	  $DCALL TMF		;TOO MANY SFDS	
	PUSHJ	P,ASCSIX	;READ SFD NAME
	 $DCALL	IDD		;ILLEGAL CHAR
	SKIPN	T2,ATMBUF	;GET SFD
	 $DCALL NSI		;NULL SFD
	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 7,ATMBUF]
	SETZM	ATMBUF		;SET FIRST CHARS NULL
	MOVE	T1,[ATMBUF,,ATMBUF+1] ;NOW CLEAR THE REST
	BLT	T1,ATMBUF+LATOMW-1
DPRS1A:	PUSHJ	P,DPRCHR	;Get next char, ignore spaces
	JUMPE	T1,SWVNUL	;0 ok
	CAIE	T1,":"		;COLON
	CAIN	T1,"."		;Dot
	 JRST	SWVNUL		;Are ok
	CAIE	T1,"["		;Start of PPN
	CAIN	T1,"/"		;Start of switch
	 JRST	SWVNUL		;Are ok
	CAIN	T1,.CHLAB	;And start of protection
	 JRST	SWVNUL
	PUSHJ	P,DPRCHK	;CHECK FOR VALIDITY
	 POPJ	P,		;Problem, return
	IDPB	T1,T3		;Yes, store in BP
	JRST	DPRS1A		;Loop

;Same as DPRS1 except ":" is not legal delimiters

DPRS2:	MOVE	T3,[POINT 7,ATMBUF]
	SETZM	ATMBUF		;SET FIRST CHARS NULL
	MOVE	T1,[ATMBUF,,ATMBUF+1] ;NOW CLEAR THE REST
	BLT	T1,ATMBUF+LATOMW-1
DPRS2A:	PUSHJ	P,DPRCHR	;Get next char, ignore spaces
	JUMPE	T1,SWVNUL	;Return if done
	CAIE	T1,"["		;Start of PPN
	CAIN	T1,"/"		;Start of switch
	 JRST	SWVNUL		;Are ok
	CAIE	T1,"."		;Start of generation
	CAIN	T1,.CHLAB	;Start of protection
	 JRST	SWVNUL
	PUSHJ	P,DPRCHK	;CHECK FOR VALIDITY
	 POPJ	P,		;Problem, return
	IDPB	T1,T3		;Yes, store in BP
	JRST	DPRS2A		;Loop

;Parse a switch

DPRSWT:	MOVE	T3,[POINT 7,ATMBUF]
DPRSW1:	PUSHJ	P,DPRCHR	;Get char
	JUMPE	T1,SWVNUL	;End ok
	CAIE	T1,"="		;Delimiters for switch value ok
	CAIN	T1,":"
	 JRST	SWVNUL
	CAIN	T1,"/"		;Another switch ok
	 JRST	SWVNUL
	PUSHJ	P,DPRCHK	;CHECK FOR VALIDITY
	 POPJ	P,		;Error
	IDPB	T1,T3		;Store in BP
	JRST	DPRSW1		;Loop

;Parse a switch value

DPRSWV:	MOVE	T3,[POINT 7,ATMBUF]
DPRSV1:	PUSHJ	P,DPRCHR	;Get char
	JUMPE	T1,SWVNUL	;END ok
	CAIN	T1,"/"		;Another switch ok
	 JRST	SWVNUL
	PUSHJ	P,DPRCHK	;CHECK FOR VALIDITY
	 POPJ	P,		;?Error
	IDPB	T1,T3		;Store char
	JRST	DPRSV1		;Loop

SWVNUL:	SETZ	T2,		;DEPOSIT A NULL
	IDPB	T2,T3		;WITHOUT DISTURBING T1
	JRST	%POPJ1		;SKIP RETURN

DPRCHK:	CAIL	T1,140		;LOWER CASE CHAR?
	 SUBI	T1,40		;YES. CONVERT TO UPPER CASE
	CAIG	T1,"Z"		;ALPHANUMERIC?
	 CAIGE	T1,"A"
	CAIG	T1,"9"
	 CAIGE	T1,"0"
	  $DCALL IDD		;NO. GIVE ERROR
	JRST	%POPJ1		;YES. SKIP RETURN

;STILL IF10

DIASWT:	PUSHJ	P,DPRCHR	;Get next non-space char.
DIASW1:	LDB	T1,SRCBP	;NOW GET IT
	JUMPE	T1,%POPJ	;NONE, DONE
	CAIE	T1,"/"		;BEGINNING OF SWITCH?
	 $DCALL	IDD		;NO, BAD
	PUSHJ	P,DPRSWT	;Parse a switch
	 POPJ	P,		;ERROR

DSWOK:	MOVE	T1,SWTPNT	;GET APPROPRIATE SWITCH TABLE ADDRESS
	MOVEI	T2,ATMBUF
	HRLI	T2,(POINT 7)
	MOVEI	T5,ATMBUF	;Get string to type incase error
	PUSHJ	P,TABLK
	  $DCALL USW		;UNKNOWN
	  $DCALL ASW		;AMBIGUOUS
	HRRZ	T1,(T1)		;GET ADDRESS OF FLAGS,,KEYWORD NUMBER
	HRRZ	T1,(T1)		;GET KEYWORD NUMBER
	MOVEM	T1,KEYVAL	;SAVE IT
	ADD	T1,DSPPNT	;POINT TO DISPATCH TABLE ENTRY
	HRRZ	T1,(T1)		;GET DISPATCH TABLE ENTRY
	MOVEM	T1,KWTADR	;SAVE KWD TABLE ADDRESS
	MOVE	T3,(T1)		;GET ROUTINE ADDRESS OR KEYWORD TABLE
	TLNN	T3,-1		;SEE WHICH
	 JRST	(T3)		;ROUTINE, GO TO IT

	SETZM	ATMBUF		;Clear buffer
	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
	 POPJ	P,		;ERROR. GO AWAY

DIAKWW:	MOVE	T1,KWTADR	;GET KWD TABLE ADDRESS
	MOVEI	T2,ATMBUF
	PUSHJ	P,TABLK
	  JRST	KWDUNK		;UNKNOWN
	  JRST	KWDAMB		;AMBIGUOUS
	HRRZ	T2,(T1)		;GET ADDRESS OF FLAGS,,VALUE
	HRRZ	T2,(T2)		;GET VALUE
	MOVE	T1,KEYVAL	;GET KEYWORD NUMBER
	XCT	OPSTOR(T1)	;STORE IN TABLE
	JRST	DIASW1		;READ ON
;STILL IF10

DIAOCT:	PUSHJ	P,DOCT		;READ NUMBER, THEN RETURN TO LOOP
	MOVE	T1,KEYVAL	;GET KEYWORD NUMBER
	XCT	OPSTOR(T1)
	JRST	DIASW1

DIAINT:	PUSHJ	P,DINT
	MOVE	T1,KEYVAL	;GET KEYWORD NUMBER
	XCT	OPSTOR(T1)
	JRST	DIASW1

DOCT:	SKIPA	T5,[^D8]	;RADIX 8
DINT:	MOVEI	T5,^D10		;RADIX 10
	SETZ	T2,		;CLEAR RESULT
DINT1:	ILDB	T1,SRCBP	;GET CHAR
	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,DPRCHR	;Get char
	CAIE	T1,""""		;STARTING QUOTE?
EENQS:	  $DCALL NQS		;PADCHAR MUST BE QUOTED SINGLE CHAR
	PUSHJ	P,DPRCHR	;Get PAD char
	CAIN	T1,""		;QUOTING CHAR?
	 PUSHJ	P,DPRCHR	;YES, GET CHAR IT QUOTES
	JUMPE	T1,EENQS	;END OF STRING HERE IS AN ERROR
	MOVE	T1,KEYVAL	;GET KEYWORD NUMBER
	XCT	OPSTOR(T1)	;STORE IN DDB
	PUSHJ	P,DPRCHR	;Get closing quote
	CAIE	T1,""""		;CLOSING QUOTE?
	 $DCALL	NQS		;No, complain
	JRST	DIASWT

DIASET: MOVEI	T2,1		;SET BIT TO 1
	MOVE	T1,KEYVAL	;GET KEYWORD NUMBER
	XCT	OPSTOR(T1)
	JRST	DIASWT		;RETURN

;IGNORE THE ARGUMENT

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

	SEGMENT	DATA

PTHPNT:	BLOCK	1		;PATH POINTER
TMPBUF:	BLOCK	LATOMW		;TEMP BUFFER FOR DIALOG
TABADD:	BLOCK	1		;TABLK TABLE ADDRESS
TABCNT:	BLOCK	1		;TABLK TABLE COUNT
STRADD:	BLOCK	1		;TABLK STRING ADDRESS

	SEGMENT	CODE

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

SAVERR:	SKIPN	U.ERR		;ERR UNIT SET?
	  POPJ	P,		;NO, NOTHING TO DO
	POP	P,RETA		;GET RETURN ADDRESS
	PUSH	P,U.ERR		;SAVE ERROR UNIT
	SETZM	U.ERR		;CLEAR IT SO WE USE TTY
	PUSHJ	P,@RETA		;CALL CALLER
	POP	P,U.ERR		;RESTORE U.ERR
	POPJ	P,		;DONE

SATAB:	SA.UR		;UNKNOWN, SEQINOUT
	SA.OR		;UNKNOWN, SEQIN
	SA.UW		;UNKNOWN, SEQOUT
	SA.OR		;UNKNOWN, RANDIN
	SA.URW		;UNKNOWN, RANDOM
	SA.UA		;UNKNOWN, APPEND
	SA.URW		;UNKNOWN, KEYED		[5000]

	SA.OR		;OLD, SEQINOUT
	SA.OR		;OLD, SEQIN
	SA.OW		;OLD, SEQOUT
	SA.OR		;OLD, RANDIN
	SA.ORW		;OLD, RANDOM
	SA.OA		;OLD, APPEND
	SA.ORW		;OLD, KEYED		[5000]

	SA.NW		;NEW, SEQINOUT
	SA.ILL		;NEW, SEQIN
	SA.NW		;NEW, SEQOUT
	SA.ILL		;NEW, RANDIN
	SA.NW		;NEW, RANDOM
	SA.NW		;NEW, APPEND
	SA.NW		;NEW, KEYED		[5000]

	SA.SW		;SCRATCH, SEQINOUT
	SA.ILL		;SCRATCH, SEQIN
	SA.SW		;SCRATCH, SEQOUT
	SA.ILL		;SCRATCH, RANDIN
	SA.SW		;SCRATCH, RANDOM
	SA.ILL		;SCRATCH, APPEND
	SA.SW		;SCRATCH, KEYED		[5000]

			;DISPOSE & STATUS
DSTAB:	SD.NOU		;NOTHING, UNKNOWN
	SD.NOU		;NOTHING, OLD
	SD.NOU		;NOTHING, NEW
	SD.NOX		;NOTHING, SCRATCH
	SD.NOS		;NOTHING, SAVE
	SD.NOD		;NOTHING, DELETE
	SD.NOX		;NOTHING, EXPUNGE

	SD.NOS		;SAVE, UNKNOWN
	SD.NOS		;SAVE, OLD
	SD.NOS		;SAVE, NEW
	SD.ILL		;SAVE, SCRATCH
	SD.NOS		;SAVE, SAVE
	SD.ILL		;SAVE, DELETE
	SD.ILL		;SAVE, EXPUNGE

	SD.NOD		;DELETE, UNKNOWN
	SD.NOD		;DELETE, OLD
	SD.NOD		;DELETE, NEW
	SD.NOD		;DELETE, SCRATCH
	SD.ILL		;DELETE, SAVE
	SD.NOD		;DELETE, DELETE
	SD.NOX		;DELETE, EXPUNGE

	SD.NOX		;EXPUNGE, UNKNOWN
	SD.NOX		;EXPUNGE, OLD
	SD.NOX		;EXPUNGE, NEW
	SD.NOX		;EXPUNGE, SCRATCH
	SD.ILL		;EXPUNGE, SAVE
	SD.NOX		;EXPUNGE, DELETE
	SD.NOX		;EXPUNGE, EXPUNGE

	SD.PRU		;PRINT, UNKNOWN
	SD.PRU		;PRINT, OLD
	SD.PRU		;PRINT, NEW
	SD.PRX		;PRINT, SCRATCH
	SD.PRS		;PRINT, SAVE
	SD.PRD		;PRINT, DELETE
	SD.PRX		;PRINT, EXPUNGE

	SD.PRX		;LIST, UNKNOWN
	SD.PRX		;LIST, OLD
	SD.PRX		;LIST, NEW
	SD.PRX		;LIST, SCRATCH
	SD.PRS		;LIST, SAVE
	SD.PRD		;LIST, DELETE
	SD.PRX		;LIST, EXPUNGE

	SD.PUU		;PUNCH, UNKNOWN
	SD.PUU		;PUNCH, OLD
	SD.PUU		;PUNCH, NEW
	SD.PUX		;PUNCH, SCRATCH
	SD.PUS		;PUNCH, SAVE
	SD.PUD		;PUNCH, DELETE
	SD.PUX		;PUNCH, EXPUNGE

	SD.SUU		;SUBMIT, UNKNOWN
	SD.SUU		;SUBMIT, OLD
	SD.SUU		;SUBMIT, NEW
	SD.SUX		;SUBMIT, SCRATCH
	SD.SUS		;SUBMIT, SAVE
	SD.SUD		;SUBMIT, DELETE
	SD.SUX		;SUBMIT, EXPUNGE

	SD.PLU		;PLOT, UNKNOWN
	SD.PLU		;PLOT, OLD
	SD.PLU		;PLOT, NEW
	SD.PLX		;PLOT, SCRATCH
	SD.PLS		;PLOT, SAVE
	SD.PLD		;PLOT, DELETE
	SD.PLX		;PLOT, EXPUNGE

NEWDSP:	XWD	OD.NOT,OS.UNK	;NOTHING, UNKNOWN
	XWD	OD.NOT,OS.SAV	;NOTHING, SAVE
	XWD	OD.NOT,OS.DEL	;NOTHING, DELETE
	XWD	OD.NOT,OS.EXP	;NOTHING, EXPUNGE

	XWD	OD.PRI,OS.UNK	;PRINT, UNKNOWN
	XWD	OD.PRI,OS.SAV	;PRINT, SAVE
	XWD	OD.PRI,OS.DEL	;PRINT, DELETE
	XWD	OD.PRI,OS.EXP	;PRINT, EXPUNGE

	XWD	OD.PUN,OS.UNK	;PUNCH, UNKNOWN
	XWD	OD.PUN,OS.SAV	;PUNCH, SAVE
	XWD	OD.PUN,OS.DEL	;PUNCH, DELETE
	XWD	OD.PUN,OS.EXP	;PUNCH, EXPUNGE

	XWD	OD.SUB,OS.UNK	;SUBMIT, UNKNOWN
	XWD	OD.SUB,OS.SAV	;SUBMIT, SAVE
	XWD	OD.SUB,OS.DEL	;SUBMIT, DELETE
	XWD	OD.SUB,OS.EXP	;SUBMIT, EXPUNGE

	XWD	OD.PLT,OS.UNK	;PLOT, UNKNOWN
	XWD	OD.PLT,OS.SAV	;PLOT, SAVE
	XWD	OD.PLT,OS.DEL	;PLOT, DELETE
	XWD	OD.PLT,OS.EXP	;PLOT, EXPUNGE


DOPFLG:	D%IN			;UNKNOWN, READ
	D%OUT+D%MOD+D%WRT	;UNKNOWN, WRITE
	D%IN+D%OUT+D%MOD+D%WRT	;UNKNOWN, READ, WRITE
	D%OUT+D%MOD+D%WRT	;UNKNOWN, APPEND
	D%IN			;OLD, READ
	D%OUT+D%MOD+D%WRT	;OLD, WRITE
	D%IN+D%OUT+D%MOD+D%WRT	;OLD, READ, WRITE
	D%OUT+D%MOD+D%WRT	;OLD, APPEND
	D%OUT+D%MOD+D%WRT	;NEW, WRITE
	D%OUT+D%MOD+D%WRT	;SCRATCH, WRITE

	SUBTTL	DO OPEN

;Call:
;	MOVX	T1,D%IN or D%OUT
;	MOVX	T1,GTJFN bits GJ%NEW or GJ%FOU or 0
;	PUSHJ	P,DOOPEN
;	 <return here if error, O.DIAL set>
;	<return here if ok>

DOOPEN:	PUSHJ	P,SETMAF	;DO LAST MINUTE MODE AND FORM
	PUSHJ	P,CNFDEV	;CHECK FOR DEVICE CONFLICTS
	 POPJ	P,		;ERROR, GO DO DIALOG
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PUSHJ	P,OPNTAB(T1)	;OPEN DEVICE BY TYPE
	 PJRST	%RMECK		;[5007] ERROR, SEE IF RMS CLEANUP REQUIRED

	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PUSHJ	P,RFSTAB(T1)	;RETURN UPDATED FILESTRINGS TO DDB
	PUSHJ	P,FIXDEF	;Defaults after everything is in place.
	PUSHJ	P,DOCONS	;Do consolidation of DDB's if necessary
	MOVE	T1,DVICE(D)	;GET DEVICE DESIGNATOR
	CAME	T1,[.CTTRM]	;CONTROLLING TTY?
	 JRST	%POPJ1		;No. Skip return
	MOVEM	D,D.TTY		;Yes, store the TTY's DDB address
	MOVEM	U,U.TTY		;And unit block
	JRST	%POPJ1		;SKIP RETURN

OPNTAB:	JRST	TTYOPN		;TTY
	JRST	DSKOPN		;DSK
	JRST	MTAOPN		;MTA
	JRST	OTHOPN		;OTHER LOCAL DEVICE
IF20,<	JRST	%RMOPN		;[5000] REMOTE STREAM FILE
	JRST	%RMOPN		;[5000] RMS FILE
> ;End IF20

RFSTAB:	POPJ	P,		;TTY DOESN'T RETURN ANYTHING
	JRST	DOJFNS		;DISK DOES JFNS
	JRST	DOJFNS		;MTA DOES JFNS
	JRST	DOJFNS		;OTHER DOES JFNS
IF20,<	JRST	%RMRFS		;[5000] REMOTE STREAM FILE
	JRST	%RMRFS		;[5000] RMS FILE
> ;End IF20
;COMMON DISK BUFFER SETUP
DSKSET:	LOAD	T1,MODE(D)	;GET MODE
	CAIN	T1,MD.DMP	;DUMP?
	 JRST	DSKDMP		;YES. DON'T NEED BUFFERS
	PUSHJ	P,EOFSET	;SETUP EOFN
	LOAD	T1,BUFCT(D)	;GET BUFFERCOUNT
	PUSHJ	P,%GTPGS
	 $ACALL	MFU		;CAN'T. MEMORY FULL
	MOVEM	T1,WPTR(D)	;SAVE PAGE ADDR

	LOAD	T1,ACC(D)	;GET ACCESS
	CAIE	T1,AC.RIO	;RANDOM
	 CAIN	T1,AC.RIN	;OR RANDIN?
	  JRST	RANALC		;YES. ALLOCATE PAGES FOR WINDOWS

	MOVE	T1,WPTR(D)	;GET PAGE ADDR
	LSH	T1,9		;GET CORE ADDR
	HRRZM	T1,WADR(D)	;SAVE ADDR
	HRRZM	T1,BUFADR(D)	;AND AGAIN

	LOAD	T1,BUFCT(D)	;GET BUFFERCOUNT AGAIN
	LSH	T1,9		;GET # WORDS
	IMUL	T1,BPW(D)	;GET # BYTES IN IT
	MOVEM	T1,WSIZ(D)	;SAVE WINDOW SIZE

	LOAD	T1,ACC(D)	;GET ACCESS TYPE
	CAIE	T1,AC.APP	;APPEND?
	 POPJ	P,		;NO
	MOVEI	T1,AC.SOU	;YES. NOW IT'S SEQUENTIAL OUTPUT!
	STORE	T1,ACC(D)
	MOVE	T1,EOFN(D)	;GET # BYTES IN FILE
	MOVEM	T1,BYTN(D)	;SAVE AS BYTE NUMBER ALSO
	PJRST	%OSMAP		;GO MAP THE LAST PAGES

RANALC:	MOVE	T1,BPW(D)	;GET BYTES/WORD
	LSH	T1,9		;GET BYTES/PAGE
	MOVEM	T1,WSIZ(D)	;SAVE AS WINDOW SIZE
	
	LOAD	T1,BUFCT(D)	;GET BUFFERCOUNT AGAIN
	PUSHJ	P,%GTBLK	;ALLOCATE PAGE TABLE
	 $ACALL	MFU		;CAN'T
	MOVEM	T1,WTAB(D)	;SAVE IT
	LOAD	T2,BUFCT(D)	;GET BUFFERCOUNT YET AGAIN
DSETL:	SETOM	(T1)		;SET FILE BLOCK TO NG ONE
	ADDI	T1,1
	SOJG	T2,DSETL	;LOOP

	LOAD	T1,BUFCT(D)	;GET BUFFERCOUNT AGAIN!
	PUSHJ	P,%GTBLK	;ALLOCATE PAGE FLAG TABLE
	 $ACALL	MFU		;CAN'T
	MOVEM	T1,PFTAB(D)	;SAVE ADDR
	POPJ	P,

;[4146] NEW
;COMMON MAGTAPE APPEND CHECK
CHKAPP:	LOAD	T2,ACC(D)	;GET ACCESS
	CAIE	T2,AC.APP	;APPEND?
	 JRST	%POPJ1		;NO

	LOAD	T1,LTYP(D)	;[5006]Get label type
	CAIE	T1,LT.UNL	;[5006] If its' labeled give error
	 $ACALL	 ALT		;[5006] Labeled tapes can't

	MOVEI	T1,AC.SIO	;IF APPEND, SUBSTITUTE SEQINOUT
	STORE	T1,ACC(D)
	PUSHJ	P,%ISBUF	;READ THE FIRST BLOCK
	MOVE	T1,FLAGS(D)	;GET FLAGS
	TXZN	T1,D%END	;END OF FILE (TAPE MARK)?
	 JRST	DATSKP		;NO. GO SKIP OVER DATA
	MOVEM	T1,FLAGS(D)	;SAVE FLAGS WITH NO EOF
	PUSHJ	P,%MTBSB	;BACK OVER THE TAPE MARK
	PUSHJ	P,MTAOSW	;SWITCH TO OUTPUT
	PJRST	%POPJ1

DATSKP:	PUSHJ	P,%MTFSF	;SKIP OVER THE TAPE MARK
	PUSHJ	P,%MTBSA	;NOW BACK OVER IT AND READ PREVIOUS BLOCK
	PUSHJ	P,MTAOSW	;SWITCH TO OUTPUT
	PJRST	%POPJ1

;COMMON ROUTINE TO GET BPW, ETC., FOR ALL DEVICES.

MTABSZ:	LOAD	T2,UBSIZ(D)	;[4203] GET USER-SUPPLIED BYTESIZE
	STORE	T2,BSIZ(D)	;[4203] STORE IT
	JUMPN	T2,CHKBSZ	;[4203] GOT ONE

	LOAD	T1,TAPM(D)	;GET TAPEMODE
	MOVE	T2,IMPBS(T1)	;GET IMPLIED BYTESIZE
	STORE	T2,BSIZ(D)	;SAVE IT
	JRST	CHKBSZ		;[4203] GO CHECK FOR 36-BIT MODE

;IF THE DEVICE IS NOT A MAGTAPE, WE MUST DERIVE THE BYTESIZE
;FROM THE MODE.

GETBSZ:	LOAD	T2,UBSIZ(D)	;[4203] GET USER-SUPPLIED BYTESIZE
	STORE	T2,BSIZ(D)	;[4203] STORE IT
	JUMPN	T2,CHKBSZ	;[4203] GOT ONE

	LOAD	T1,MODE(D)	;GET /MODE
	MOVE	T2,BSTAB(T1)	;GET BYTE SIZE
	STORE	T2,BSIZ(D)	;[4203] SAVE IT

CHKBSZ:	LOAD	T2,BSIZ(D)	;[4203] GET BYTESIZE AGAIN
	CAIE	T2,^D36		;IS IT 36?
	 JRST	GOTBSZ		;NO. GO DEFAULT OTHER PARAMS
	SETOM	B36FLG(D)	;YES. SET 36-BIT MODE FLAG
	MOVEI	T2,IBSZ		;GET DEFAULT INTERNAL BYTESIZE
GOTBSZ:	MOVE	T1,BPTAB(T2)	;GET A RIGHT-JUSTIFIED BP
	STORE	T1,BYTPT(D)	;SAVE IT FOR FORIO
	MOVE	T1,SPCTAB(T2)	;GET A WORD OF SPACES
	MOVEM	T1,SPCWD(D)	;SAVE IT FOR RECORD FILL
	MOVEI	T1,^D36		;GET 36 BITS
	IDIVI	T1,(T2)		;GET BYTES/WORD
	MOVEM	T1,BPW(D)	;SAVE IT
	POPJ	P,		;Return

	SUBTTL	DEVICE-DEPENDENT OPEN ROUTINES

IF20,<

DSKDMP:	POPJ	P,		;NO DUMP MODE ON TOPS-20

;[4161] GET THE TAPEFORMAT SPECIFIED (IF ANY)
;IF NO TAPEFORMAT SPECIFIED, GET THE JOB'S DEFAULT TAPE FORMAT
;IF ANSI-ASCII OR INDUSTRY, SET IMGFLG TO PREVENT LSCWS.
MTADEF:	LOAD	T1,TAPM(D)	;GET TAPEFORMAT
	JUMPN	T1,GOTTF	;GOT ONE. GO STORE IMPLIED BYTESIZE
	MOVE	T1,RECTP(D)	;[5000] GET RECORDTYPE
	CAIE	T1,RT.UNS	;[5000] ANY GIVEN?
	 SKIPA	T1,[TM.IND]	;YES. DEFAULT TAPEFORMAT=INDUSTRY
	  MOVE	T1,%JIBLK+.JIDM	;NO. GET DEFAULT DATA MODE FOR THIS JOB
	STORE	T1,TAPM(D)	;SAVE DEFAULT TAPEFORMAT
GOTTF:	CAIE	T1,TM.ANS	;ANSI-ASCII?
	 CAIN	T1,TM.IND	;OR INDUSTRY-COMPATIBLE?
	  SETOM	IMGFLG(D)	;YES. ASCII-ONLY DEVICE
	POPJ	P,

DOPENF:	MOVE	T2,OPNBTS	;GET OPEN BITS
	OR	T2,DMABS(D)	;SET DATA MODE, BYTE SIZE
	MOVE	T1,IJFN(D)	;GET JFN
	OPENF%			;OPEN file
	 ERJMP	RELJFN		;Can't
	AOS	(P)		;SKIP RETURN FOR SUCCESS
	POPJ	P,

DOGTJF:	MOVE	T1,GJBTS	;Get JFN bits to set
	TXO	T1,GJ%XTN	;Extended GTJFN
	TXNE	T1,GJ%OLD	;[4135] IS IT FOR AN EXISTING FILE?
	 TXO	T1,GJ%IFG	;[4135] YES. ALLOW WILD-CARDS
	SKIPE	TMPFIL(D)	;[4135] TEMPORARY FILE?
	 TXO	T1,GJ%TMP	;[4135] YES. SETUP FOR IT
	HLLM	T1,JFNBLK+.GJGEN ;Store away
	MOVEI	T1,JFNBLK	;Get a JFN
	SETZ	T2,		;NO STRING
	GTJFN%
	 ERJMP	%POPJ		;Failure return

GTJOK:	HRRZM	T1,IJFN(D)	;STORE WITH NO FLAGS
	HRRZM	T1,OJFN(D)
	JRST	%POPJ1		;[5000]

;ROUTINE TO SET UP TERMINAL

TTYOPN:	PUSHJ	P,GETBSZ	;ESTABLISH BYTESIZE, BPW
	MOVE	T1,DVICE(D)	;GET DEVICE DESIGNATOR
	CAIE	T1,.CTTRM	;CONTROLLING TTY?
	 JRST	NCTRM		;NO
	MOVEI	T1,.PRIIN	;SETUP PRIIN AS INPUT
	MOVEM	T1,IJFN(D)
	MOVEI	T1,.PRIOU	;SETUP PRIOU AS OUTPUT
	MOVEM	T1,OJFN(D)
	JRST	TTYSET		;GO DO REST OF SETUP

NCTRM:	PUSHJ	P,SETJFN	;Setup JFN info
	SETZM	GJBTS		;NO GTJFN BITS
	PUSHJ	P,DOGTJF	;GET JFN
	 $DCALL	OPN		;REQUEST DIALOG
	MOVX	T1,OF%RD+OF%WR	;ALLOW READ AND WRITE ACCESS
	MOVEM	T1,OPNBTS	;SAVE FOR GTJFN
	PUSHJ	P,DOPENF	;OPEN TTY
	 $DCALL	OPN		;REQUEST DIALOG

TTYSET:	MOVX	T1,D%SEOL+D%IN+D%OUT ;[4220] No initial CRLF for terminals
	IORM	T1,FLAGS(D)	; . .

	SKIPE	T1,RSIZE(D)	;RECORD SIZE SPECIFIED?
	 JRST	STOTTW		;YES. GO STORE AS TTYW

	MOVE	T1,OJFN(D)	;GET JFN
	MOVEI	T2,.MORLW	;READ LINE WIDTH
	MTOPR%
	 ERJMP	TTY72		;CAN'T. USE 72
	CAIN	T3,0		;LINE WIDTH SET?
TTY72:	 MOVEI	T3,^D72		;NO, GUESS 72
STOTTW:	LOAD	T2,CC(U)	;[3400] GET CARRIAGE CONTROL
	CAIE	T2,CC.LST	;[3400] CC=FORTRAN OR TRANS?
	 CAIN	T2,CC.NON
	  JRST	NOEXSP		;NO
	ADDI	T3,1		;[3400] YES, BUMP TTY WIDTH 
NOEXSP:	STORE	T3,TTYW(D)	;STORE LINE SIZE FOR NAMELIST AND LIST-DIRECTED
	JRST	%POPJ1		;DONE

;ROUTINE TO OPEN DISK
;OPEN THE DISK FILE, THEN
;READ THE FDB, THEN CALCULATE EOFN, THE NUMBER OF
;FORTRAN CHARACTER BYTES IN THE FILE.

DSKOPN:	PUSHJ	P,GETBSZ	;GET BYTESIZE, BPW
	PUSHJ	P,SETJFN	;Setup JFN info
	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	PUSHJ	P,DOPTAB(T1)	;GO DO GTJFN, OPENF
	 $DCALL	OPN		;REQUEST DIALOG

	PUSHJ	P,RMSCHK	;[5000] SEE IF ACTUALLY AN RMS FILE
	 $DCALL	RMS		;[5000] YES, REQUEST DIALOG
	MOVE	T1,OPNBTS	;[5000] NO. GET BITS USED FOR OPENF
	TXNE	T1,OF%APP	;APPEND-ONLY ACCESS?
	 JRST	XXXSET		;YES. CAN'T TREAT IT LIKE A DISK

	TXNN	T1,OF%WR	;WRITE?
	 JRST	NOUFP		;NO. CAN'T UPDATE DIRECTORY ENTRY
	MOVE	T1,IJFN(D)	;GET JFN
	MOVSI	T1,(T1)		;IN LEFT HALF ONLY
	SETZ	T2,		;NO PAGES TO UPDATE
	UFPGS%			;MAKE FILE APPEAR IF NOT THERE ALREADY
	 JSHALT			;SHOULDN'T FAIL
NOUFP:	PUSHJ	P,DSKSET	;DO COMMON DISK SETUP
	JRST	%POPJ1		;RETURN SUCCESS

;[5000] New
;[5000] See if file we opened was actually an RMS file
RMSCHK:	HRRZ	T1,IJFN(D)	;[5000] GET JFN
	MOVE	T2,[XWD 1,.FBCTL] ;[5000] GET .FBCTL WORD
	MOVEI	T3,FDB+.FBCTL	;[5000]
	GTFDB%			;[5000]
	 ERJMP	%POPJ1		;[5000] CAN'T, WE TRIED.
	LDB	T1,[POINTR (FDB+.FBCTL,FB%FCF)] ;[5000] GET FILE CLASS FIELD
	CAIN	T1,.FBRMS	;[5000] RMS FILE?
	 PJRST	FICLOS		;[5000] YES. CLOSE FILE, RELEASE JFN, +1 RET
	JRST	%POPJ1		;[5000] NO, OK

EOFSET:	PUSHJ	P,FDBGET	;[5000] GET FDB
	 JSHALT			;[5000] FAILED
%RSEOF:	LDB	T1,[POINTR (FDB+.FBBYV,FB%BSZ)] ;GET FILE BYTE SIZE
	CAIE	T1,^D36		;36 BITS?
	 JUMPN	T1,DSKBSZ	;NO. GO STORE IT IF NONZERO
	MOVE	T3,FDB+.FBSIZ	;GET NUMBER OF WORDS IN THE FILE
	IMUL	T3,BPW(D)	;GET # INTERNAL BYTES
	MOVEM	T3,EOFN(D)	;SAVE # BYTES IN FILE
	POPJ	P,

DSKBSZ:	LOAD	T2,BSIZ(D)	;GET USER-SUPPLIED BYTESIZE
	CAIN	T2,^D36		;36 GIVEN OR IMPLIED BY MODE?
	 JRST	BSIZOK		;YES. ANYTHING IN FDB IS OK
	CAIE	T1,(T2)		;SAME AS ONE IN FDB?
	 $ECALL	BSC		;GIVE CONFLICT WARNING
BSIZOK:	STORE	T1,BSIZ(D)	;STORE NEW BYTE SIZE
	MOVE	T2,SPCTAB(T1)	;GET A WORD OF SPACES
	MOVEM	T2,SPCWD(D)	;SAVE IT
	MOVE	T2,BPTAB(T1)	;GET A RIGHT-JUSTIFIED BYTE POINTER
	STORE	T2,BYTPT(D)	;SAVE IT
	MOVEI	T2,^D36		;GET 36 BITS
	IDIVI	T2,(T1)		;GET # BYTES/WORD
	MOVEM	T2,BPW(D)	;SAVE IT
	MOVE	T3,FDB+.FBSIZ	;GET NUMBER OF BYTES IN THE FILE
	MOVEM	T3,EOFN(D)	;SAVE IT
	LOAD	T1,FORM(D)	;GET FORMAT OF FILE
	CAIE	T1,FM.UNF	;UNFORMATTED?
	 POPJ	P,		;NO. DONE
	ADD	T3,BPW(D)	;YES. ROUND UP TO NEAREST WORD
	SUBI	T3,1
	IDIV	T3,BPW(D)
	IMUL	T3,BPW(D)
	MOVEM	T3,EOFN(D)	;STORE ROUNDED # BYTES
	POPJ	P,

GTEOFN:	PUSHJ	P,FDBGET	;[5000] GET FDB
	 POPJ	P,		;[5000] COULDN'T
	LDB	T1,[POINTR (FDB+.FBBYV,FB%BSZ)] ;GET FILE BYTE SIZE
	JUMPE	T1,%POPJ	;IF NO SIZE, CAN'T CALCULATE ANYTHING
	MOVEI	T2,^D36		;DIVIDE 36 BY IT
	IDIVI	T2,(T1)		;TO GET BPW
	MOVEM	T2,BPW(D)	;AND SAVE IT
	MOVE	T1,FDB+.FBSIZ	;GET # BYTES
	MOVEM	T1,EOFN(D)	;SAVE IT
	POPJ	P,

FDBGET:	MOVE	T1,IJFN(D)	;[5000] GET JFN
	MOVSI	T2,1+.FBSIZ	;[5000] READ UP THROUGH FILE SIZE
	MOVEI	T3,FDB		;[5000] POINT TO DEST BUFFER
	GTFDB%			;[5000] READ FDB
	 ERJMP	%POPJ		;[5000] CAN'T
	JRST	%POPJ1		;[5000] OK

DOPTAB:	JRST	DOPUNK		;UNKNOWN, READ
	JRST	DOPSTN		;UNKNOWN, WRITE
	JRST	DOPSTN		;UNKNOWN, READ, WRITE
	JRST	DOPAPP		;UNKNOWN, APPEND
	JRST	DOPSTN		;OLD, READ
	JRST	DOPSTN		;OLD, WRITE
	JRST	DOPSTN		;OLD, READ, WRITE
	JRST	DOPAPP		;OLD, APPEND
	JRST	DOPSTN		;NEW, WRITE
	JRST	DOPSTN		;SCRATCH, WRITE

DOPSTN:	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	MOVE	T1,DGTBTS(T1)	;GET APPROPRIATE GTJFN BITS
	MOVEM	T1,GJBTS	;SAVE FOR GTJFN
	PUSHJ	P,DOGTJF	;GO DO GTJFN
	 POPJ	P,		;FAILED
	LOAD	T1,SAIDX(D)	;GET INDEX AGAIN
	MOVE	T1,DOPBTS(T1)	;GET APPROPRIATE OPENF BITS
	MOVEM	T1,OPNBTS	;SAVE FOR OPENF
	PUSHJ	P,DOPENF	;DO OPENF
	 POPJ	P,		;FAILED
	AOS	(P)		;SKIP RETURN FOR SUCCESS
	POPJ	P,

DGTBTS:	GJ%OLD			;UNKNOWN, READ
	GJ%FOU			;UNKNOWN, WRITE
	0			;UNKNOWN, READ, WRITE
	0			;UNKNOWN, APPEND
	GJ%OLD			;OLD, READ
	GJ%OLD			;OLD, WRITE
	GJ%OLD			;OLD, READ, WRITE
	GJ%OLD			;OLD, APPEND
	GJ%NEW+GJ%FOU		;NEW, WRITE
	GJ%FOU			;SCRATCH, WRITE

DOPBTS:	OF%RD			;UNKNOWN, READ
	OF%RD!OF%WR		;UNKNOWN, WRITE
	OF%RD+OF%WR		;UNKNOWN, READ, WRITE
	OF%RD+OF%WR		;UNKNOWN, APPEND (1ST TRY)
	OF%RD			;OLD, READ
	OF%RD+OF%WR		;OLD, WRITE
	OF%RD+OF%WR		;OLD, READ, WRITE
	OF%RD+OF%WR		;OLD, APPEND (1ST TRY)
	OF%RD+OF%WR		;NEW, WRITE
	OF%RD+OF%WR		;SCRATCH, WRITE

;[4135]
MOPBTS:	OF%RD			;UNKNOWN, READ
	OF%WR			;UNKNOWN, WRITE
	OF%WR			;UNKNOWN, READ, WRITE
	OF%APP			;UNKNOWN, APPEND
	OF%RD			;OLD, READ
	OF%WR			;OLD, WRITE
	OF%WR			;OLD, READ, WRITE
	OF%APP			;OLD, APPEND
	OF%WR			;NEW, WRITE
	OF%WR			;SCRATCH, WRITE

DOPUNK:	MOVE	T1,DGTBTS+SA.UR	;GET GTJFN BITS FOR UNKNOWN, READ
	MOVEM	T1,GJBTS	;SAVE FOR GTJFN
	PUSHJ	P,DOGTJF	;DO GTJFN
	 JRST	TRYCRE		;CAN'T. MIGHT HAVE TO CREATE IT
	MOVE	T1,DOPBTS+SA.UR	;GET OPENF BITS FOR READ
	MOVEM	T1,OPNBTS	;SAVE FOR OPENF
	PUSHJ	P,DOPENF	;DO OPENF
	 POPJ	P,		;FAILED FOR SOME OTHER REASON
	AOS	(P)		;SKIP RETURN FOR SUCCESS
	POPJ	P,

;IF THE GTJFN FAILS FOR ANY REASON (E.G. FILE NOT FOUND, NON-EXISTENT
;DEVICE) WE SET THE GTJFN BITS TO [UNKNOWN, WRITE], AND TRY AGAIN.
TRYCRE:	MOVE	T0,FLAGS(D)	;GET DDB FLAGS
	TXNN	T0,D%OPEN	;FILE PREVIOUSLY OPENED?
	 POPJ	P,		;NO. REPORT FAILURE
	MOVE	T1,DGTBTS+SA.UW	;TRY FOR UNKNOWN, WRITE
	MOVEM	T1,GJBTS	;SAVE FOR GTJFN
	PUSHJ	P,DOGTJF	;DO GTJFN AGAIN
	 POPJ	P,		;FAILED FOR SOME OTHER REASON
	MOVE	T1,DOPBTS+SA.UW	;TREAT AS IF IT'S UNKNOWN, WRITE
	MOVEM	T1,OPNBTS	;SAVE FOR OPENF
	PUSHJ	P,DOPENF	;DO OPENF
	 POPJ	P,		;FAILED FOR SOME OTHER REASON
	AOS	(P)		;SKIP RETURN FOR SUCCESS
	POPJ	P,

;DOPAPP - ACCESS=APPEND. TRY FIRST THE STANDARD
;BITS FOR READ, WRITE. IF THIS SUCCEEDS, MAP THE FILE AT EOF,
;AND SET THE ACCESS TO SEQOUT. IF IT FAILS, OPEN THE FILE FOR
;APPEND ACCESS, WHICH IS MUCH SLOWER.
DOPAPP:	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	MOVE	T1,DGTBTS(T1)	;GET GTJFN BITS
	MOVEM	T1,GJBTS	;SAVE FOR GTJFN
	PUSHJ	P,DOGTJF	;DO GTJFN
	 POPJ	P,		;FAILED
	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX AGAIN
	MOVE	T1,DOPBTS(T1)	;GET OPENF BITS
	MOVEM	T1,OPNBTS	;SAVE FOR OPENF
	PUSHJ	P,DOPENF	;DO OPENF
	 JRST	TRYAPP		;FAILED. GO TRY APPEND ACCESS
	AOS	(P)
	POPJ	P,

TRYAPP:	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	MOVE	T1,DGTBTS(T1)	;GET GTJFN BITS
	MOVEM	T1,GJBTS	;SAVE FOR GTJFN
	PUSHJ	P,DOGTJF	;DO GTJFN
	 POPJ	P,		;FAILED
	MOVX	T1,OF%APP	;TRY APPEND ACCESS
	MOVEM	T1,OPNBTS	;SAVE FOR OPENF
	PUSHJ	P,DOPENF	;DO OPENF
	 POPJ	P,		;FAILED
	AOS	(P)		;SKIP RETURN FOR SUCCESS
	POPJ	P,

;ROUTINE TO OPEN MTA

MTAOPN:	PUSHJ	P,MTABSZ	;GET BYTESIZE, BPW
	PUSHJ	P,SETJFN	;Setup JFN info
	PUSHJ	P,MTAJFN	;SETUP LABELED TAPE ATTRIBUTES
	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	MOVE	T1,DGTBTS(T1)	;GET GTJFN BITS
	MOVEM	T1,GJBTS	;SAVE FOR GTJFN
	PUSHJ	P,DOGTJF	;[5006]GO DO GTJFN
	 $DCALL	OPN		;FAILED. GIVE MESSAGE, GO TO DIALOG
	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX AGAIN
	CAIE	T1,SA.UA	;UNKNOWN, APPEND?
	 CAIN	T1,SA.OA	;OR OLD, APPEND?
	  MOVX	T1,SA.UR	;YES. PRETEND IT'S READ
	MOVE	T1,MOPBTS(T1)	;GET OPENF BITS
	MOVEM	T1,OPNBTS	;SAVE FOR OPENF
	PUSHJ	P,DOPENF	;GO DO OPENF
	 $DCALL	OPN		;FAILED. GIVE MESSAGE, GO TO DIALOG

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

	PUSHJ	P,%LABCK	;CHECK LABEL TYPE

	PUSHJ	P,%MTPRM	;SET MTA PARAMETERS
	PUSHJ	P,TFCHK		;CHECK TAPE FORMAT AGAINST USER'S
	PUSHJ	P,MTABLK	;SETUP MTA BLOCK
	PJRST	CHKAPP		;GO CHECK FOR APPEND

%LABCK:	MOVE	T1,IJFN(D)	;GET LABEL TYPE OF TAPE
	MOVEI	T2,.MORLI	;READ LABEL INFO
	MOVEI	T3,15		;SET ARG BLOCK LENGTH
	MOVEM	T3,LABINF
	XMOVEI	T3,LABINF	;POINT TO ARG BLOCK
	MTOPR%			;READ LABEL INFO
	  ERCAL	[MOVEI T3,.LTUNL ;CAN'T, ASSUME UNLABELED
		 MOVEM T3,LABINF+1
		 POPJ P,]
	MOVE	T1,LABINF+1	;GET LABEL TYPE
	STORE	T1,LTYP(D)	;STORE FOR LATER
	POPJ	P,

%MTPRM:	LOAD	T1,LTYP(D)	;GET LABEL TYPE
	CAIE	T1,.LTUNL	;UNLABELED?
	 POPJ	P,		;NO. CAN'T SETUP PARAMATERS!

	MOVE	T1,IJFN(D)	;GET JFN OF TAPE
	MOVEI	T2,.MOSDN	;SET DENSITY
	LOAD	T3,DEN(D)	;GET /DENSITY
	JUMPE	T3,SETPAR	;NONE. GO TRY PARITY
	MOVEI	T4,[ASCIZ /density/] ;GET TEXT FOR ERR MESSAGE
	MTOPR%			;SET IT
	 $EJCAL	UMO

SETPAR:	MOVEI	T2,.MOSPR	;SET PARITY
	LOAD	T3,PAR(D)	;GET /PARITY
	JUMPE	T3,SETTM	;NONE. TRY TAPEMODE
	MOVEI	T4,[ASCIZ /parity/]
	MTOPR%			;SET IT
	 $EJCAL	UMO

SETTM:	LOAD	T3,TAPM(D)	;GET /TAPEFORMAT 
	JUMPE	T3,SETBS	;[4256]NO EXPLICIT MODE
	MOVEI	T2,.MOSDM	;SET HARDWARE DATA MODE
	MOVEI	T4,[ASCIZ /data mode/]
	MTOPR%			;SET IT
	 $EJCAL	UMO

SETBS:	LOAD	T3,BLKSZ(D)	;[4256]GET /BLOCKSIZE
	JUMPE	T3,%POPJ	;[4256]NO EXPLICIT RECORD-SIZE
	MOVEI	T2,.MOSRS	;[4256]SET RECORD SIZE
	MOVEI	T4,[ASCIZ /block size/]	;[4256]
	MTOPR%			;[4256]SET IT
	 $EJCAL	UMO		;[4256]
	POPJ	P,
;
;SET UP THE FOROTS MAGTAPE BLOCK BASED ON THE TAPE FORMAT
;AND THE BLOCKSIZE SPECIFIED BY THE USER (OR SYSTEM DEFAULT).
MTABLK:	LOAD	T1,BLKSZ(D)	;GET THE BLOCK SIZE IN BYTES
	JUMPN	T1,GOTBLS	;IF SET, SKIP GETTING IT FROM MONITOR
	MOVE	T1,%JIBLK+.JIRS	;GET BLOCKSIZE FROM JOB INFO
	STORE	T1,BLKSZ(D)	;STORE IT
GOTBLS:	SKIPE	B36FLG(D)	;36-BIT MODE?
	 IMUL	T1,BPW(D)	;YES. BLOCKSIZE IS IN WORDS. MAKE IT BYTES
	MOVEM	T1,WSIZ(D)	;SAVE AS WINDOW SIZE

	ADD	T1,BPW(D)	;ROUND UP TO WORDS FOR BUFFER SIZE
	SUBI	T1,1
	IDIV	T1,BPW(D)	;GET # WORDS
	PUSHJ	P,%GTBLK	;ALLOCATE A BLOCK
	 $ACALL	MFU		;CAN'T
	HRRZM	T1,WADR(D)	;SAVE THE LOCAL ADDRESS OF THE BUFFER
	POPJ	P,

TFCHK:	MOVE	T1,IJFN(D)	;GET JFN
	MOVEI	T2,.MORDM	;GET DATA MODE
	MTOPR%
	 $EJCAL	UMO

	LOAD	T1,TAPM(D)	;GET USER-SPECIFIED OR IMPLIED TAPEMODE
	CAIE	T1,(T3)		;ONE THERE. SAME AS ACTUAL TAPE?
	 $ACALL	TFM		;TAPE FORMAT MISMATCH. TOO BAD
	POPJ	P,

; Open for all other devices

OTHOPN:	PUSHJ	P,GETBSZ	;SETUP BYTESIZE, BPW
	PUSHJ	P,SETJFN	;Setup JFN info
	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	MOVE	T1,DGTBTS(T1)	;GET GTJFN BITS
	MOVEM	T1,GJBTS	;SAVE THEM
	PUSHJ	P,DOGTJF	;GO DO GTJFN
	 $DCALL	OPN		;FAILED. GIVE MESSAGE, GO TO DIALOG
	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX AGAIN
	MOVE	T1,DOPBTS(T1)	;GET OPENF BITS
	MOVEM	T1,OPNBTS	;SAVE FOR OPENF
	PUSHJ	P,DOPENF	;GO DO OPENF
	 $DCALL	OPN		;FAILED. GIVE MESSAGE, GO TO DIALOG

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
	MOVEI	T2,(T1)		;COPY IT
	IMUL	T2,BPW(D)	;GET # BYTES/BUFFER
	MOVEM	T2,WSIZ(D)	;STORE AS WINDOW SIZE
	PUSHJ	P,%GTBLK
	 $ACALL	MFU		;CAN'T
	HRRZM	T1,WADR(D)	;STORE ADDRESS OF BUFFER
	JRST	%POPJ1		;ALL SET

	SEGMENT	DATA

LABINF:	BLOCK	15		;LABEL INFO

	SEGMENT	CODE


>;END IF20
IF10,<


;THIS IS THE SPECIAL DUMP-MODE OPEN CODE.
DSKDMP:	MOVE	T1,LKPB+.RBSIZ(D) ;GET # WORDS IN FILE
	ADDI	T1,177		;ROUND TO BLOCKS
	IDIVI	T1,200		;GET # BLOCKS
	IMULI	T1,200		;GET # WORDS ROUNDED
	IMUL	T1,BPW(D)	;GET # BYTES ROUNDED
	MOVEM	T1,EOFN(D)	;SAVE IT AS EOF

	LOAD	T1,ACC(D)	;GET ACCESS
	CAIE	T1,AC.APP	;APPEND?
	 POPJ	P,		;NO. DONE
	MOVEI	T1,AC.SOU	;YES. NOW IT'S SEQUENTIAL OUTPUT!
	STORE	T1,ACC(D)
	MOVE	T1,EOFN(D)	;GET # BYTES IN FILE
	MOVEM	T1,BYTN(D)	;SET CURRENT BYTE NUMBER

	MOVE	T2,FBLK(D)	;GET CHANNEL WORD
	HRRI	T2,.FOUSO	;SETUP FOR USETO
	MOVE	T3,LKPB+.RBSIZ(D) ;GET # WORDS IN FILE
	ADDI	T3,177		;ROUND TO # BLOCKS
	IDIVI	T3,200
	ADDI	T3,1		;POINT TO THE FIRST UNWRITTEN BLOCK
	MOVE	T1,[2,,T2]
	FILOP.	T1,
	 $ACALL	IOE
	POPJ	P,

;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:	SKIPE	T1,BUFADR(D)	;IF ANY BUFFER ALLOCATED
	 PUSHJ	P,%FREBLK	;DEALLOCATE IT
	SETZM	BUFADR(D)		;AND CLEAR ADDR
	SETZM	FBLK+.FONBF(D)	;Clear buffer counts
	SETZM	FBLK+.FOBRH(D)	;Clear buffer headers

;Deallocate stuff gotten by DSKSET

	MOVE	T1,WPTR(D)	;GET PAGE ADDR OF WINDOW PAGES
	JUMPE	T1,OFCLN2	;NONE
	LOAD	T2,BUFCT(D)	;YES. GET BUFFERCOUNT
	PUSHJ	P,%FREPGS	;FREE THEM
	SKIPE	T1,WTAB(D)	;Now free the page table
	 PUSHJ	P,%FREBLK	; . .
	SKIPE	T1,PFTAB(D)	;AND FREE THE PAGE FLAG TABLE
	 PUSHJ	P,%FREBLK
	SETZM	WPTR(D)		;Clear all indication that we had memory

OFCLN2:	SETZM	FBLK(D)		; Forget file was opened
	POPJ	P,		;Return
SETFB:	MOVEI	T2,LKPB(D)	;Set pointers
	MOVEM	T2,.FOLEB+FBLK(D)
	MOVEI	T2,.RBMAX
	MOVEM	T2,LKPB+.RBCNT(D)
	MOVEI	T2,PTHB(D)
	HRLI	T2,9
	MOVEM	T2,.FOPAT+FBLK(D)
	PJRST	SETPPB		;Set ptr to path block

;Routine to call the appropriate OPEN routine based on
; ACCESS and STATUS.
;Returns .+1 if error, O.DIAL set (unless ERR= taken)
;Returns .+2 if success, DDB flags set.

CALOF:	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	LOAD	T2,INDX(D)	;GET DEVICE INDEX
	CAIN	T2,DI.TTY	;TTY:?
	 MOVX	T1,SA.UW	;YES. USE UNKNOWN, SEQOUT
	PUSHJ	P,DOPTAB(T1)	;OPEN FILE
	 POPJ	P,		;FAILED. NON-SKIP RETURN
	JRST	%POPJ1		;Return success

DOPTAB:	JRST	OPUNK		;UNKNOWN, READ
	JRST	OPSW		;UNKNOWN, WRITE
	JRST	OPRU		;UNKNOWN, READ, WRITE
	JRST	OPAU		;UNKNOWN, APPEND
	JRST	OPRD		;OLD, READ
	JRST	OPSO		;OLD, WRITE
	JRST	OPRO		;OLD, READ, WRITE
	JRST	OPAO		;OLD, APPEND
	JRST	OPSWN		;NEW, WRITE
	JRST	OPRS		;SCRATCH, WRITE

;OPEN file that must exist for READ.

OPRD:	MOVX	T1,FO.ASC+FO.PRV+.FORED ;Simple READ function
	MOVEM	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:	MOVX	T1,FO.ASC+FO.PRV+.FOCRE ;CREATE function
	MOVEM	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
	MOVX	T1,FO.ASC+FO.PRV+.FOWRT ;OK, plain WRITE
	MOVEM	T1,FBLK(D)	;Set function
	PUSHJ	P,DOFLP
	 JRST	FLPFL		;?failed
	JRST	CLSSAU		;CLOSE, OPEN FOR RANDOM

;OPEN file that must not exist for WRITE

OPSWN:	MOVX	T1,FO.ASC+FO.PRV+.FOCRE ;Create function
	MOVEM	T1,FBLK(D)	;Set function
	PUSHJ	P,DOFLP
	 JRST	FLPFL		;?failed
; [4261]
; Check to see if the user is creating a .SFD file.  if we are 
; then don't do this close reopen stuff.  Cause we can't open
; an existing SFD for write (protection failure).
; [4261]

	HRRZ	T1,FBLK+.FOLEB(D);[4261]Get the address of the lookup blk
	HLRZ	T1,.RBEXT(T1)	;[4261]Get the extention from lookup blk
	CAIN	T1,634644	;[4261]Is it a .SFD file?
	 JRST	%POPJ1		;[4261]Yes, don't close & re-open!

	JRST	CLSSAU		;CLOSE FILE, OPEN FOR RANDOM

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

OPSW:	MOVX	T1,FO.ASC+FO.PRV+.FOWRT ;[4205] WRITE function
	MOVEM	T1,FBLK(D)	;Set it
	PUSHJ	P,DOFLP
	 JRST	FLPFL		;[4205] FAILED
	PJRST	CLSSAU		;CLOSE FILE, OPEN FOR RANDOM

;OPEN SEQINOUT (SEQUENTIAL) file with UNKNOWN status.
;See if file exists.
; If it exists, it will be opened for input.
; If it doesn't exist, and an OPEN statement has been done,
;  it will be created and opened for input.

OPUNK:	MOVX	T1,FO.ASC+FO.PRV+.FORED ;Try to read file
	MOVEM	T1,FBLK(D)
	PUSHJ	P,DOFLP		;If succeeds, set file opened for input
	 JRST	OPSIC1		;Failed, maybe file not found?
	JRST	%POPJ1		;Return

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

OPSIC1:	MOVE	T2,FLAGS(D)	;GET DDB FLAGS
	TXNE	T2,D%OPEN	;OPEN STATEMENT DONE?
	 CAIE	T1,ERFNF%	;File not found?
	  JRST	FLPFL		;No, bad error
	MOVX	T1,FO.ASC+FO.PRV+.FOWRT ;Create file
	MOVEM	T1,FBLK(D)
	PUSHJ	P,DOFLP		;** Do FILOP. **
	 JRST	FLPFL		;All errors are fatal
	JRST	CLSSAU		;CLOSE, OPEN FOR RANDOM

;OPEN APPEND file that must exist.

OPAO:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIE	T1,DI.MTA	;MAGTAPE?
	 JRST	OPRO		;NO.
	MOVX	T1,FO.ASC+FO.PRV+.FORED	;YES. SET READ MODE
	MOVEM	T1,FBLK(D)
	PUSHJ	P,DOFLP
	 JRST	FLPFL		;?failed
	JRST	%POPJ1		;Succeeded, return

;OPEN RANDOM file that must exist.
	
OPRO:	PUSHJ	P,CHKEXI	;Make sure file exists
	 POPJ	P,		;It doesn't
OPRGO:	MOVX	T1,FO.ASC+FO.PRV+.FOSAU ;OK, do an update
	MOVEM	T1,FBLK(D)
	PUSHJ	P,DOFLP
	 JRST	FLPFL		;?failed
	JRST	%POPJ1		;Succeeded, return


;CLOSE and OPEN file again for updating.

CLSSAU:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIE	T1,DI.DSK	;DISK?
	 JRST	%POPJ1		;NO. SHOULDN'T CLOSE/OPEN
	MOVEI	T2,.FOCLS
	HLL	T2,CHAN(D)
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 $ACALL CLS		;FAILED. TYPE MSG AND DIE
	MOVEI	T1,.FOSAU	;NOW OPEN FOR RANDOM I/O
	HRRM	T1,FBLK(D)
	PUSHJ	P,DOFLP
	 JRST	FLPFL
	JRST	%POPJ1		;SUCCESS


;OPEN APPEND file, STATUS='UNKNOWN'
;OPEN RANDOM file, STATUS='UNKNOWN'

OPAU:	MOVX	T1,FO.ASC+FO.PRV+.FORED ;SET READ FUNCTION
	LOAD	T2,INDX(D)	;GET DEVICE INDEX
	CAIE	T2,DI.MTA	;MAGTAPE?
OPRU:	 MOVX	T1,FO.ASC+FO.PRV+.FOCRE ;Set CREATE Function
	MOVEM	T1,FBLK(D)
	PUSHJ	P,DOFLP
	 JRST	OPRUCF		;Failed, go check error
	JRST	CLSSAU		;CLOSE, OPEN FOR RANDOM

;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 SCRATCH RANDOM file
OPRS:	PUSHJ	P,SETSCN	;Set scratch name
	SETZ	T3,		;Count # of tries

OPRS1:	MOVX	T1,FO.ASC+FO.PRV+.FOCRE ;Set CREATE function
	MOVEM	T1,FBLK(D)
	PUSHJ	P,DOFLP
	 JRST	OPRS2		;Maybe file does exist already
	JRST	CLSSAU		;CLOSE, OPEN FOR RANDOM

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 ASCII
	DMOVE	T1,ATMBUF
	DMOVEM	T1,FILNAM(D)
	MOVE	T1,[ASCIZ /TMP/] ;EXTENSION .TMP
	MOVEM	T1,EXT(D)

	MOVEI	T1,FILNAM(D)	;GET ASCIZ FILENAME POINTER
	HRLI	T1,(POINT 7)
	MOVEM	T1,SRCBP
	MOVEI	T1,LFILC	;AND COUNT
	MOVEM	T1,SRCLEN
	PUSHJ	P,ASCSIX	;CONVERT TO SIXBIT
	 $SNH			;SHOULD NOT FAIL
	MOVE	T1,ATMBUF	;GET FILENAME
	MOVEM	T1,LKPB+.RBNAM(D) ;SAVE IT

	MOVEI	T1,EXT(D)	;GET ASCIZ EXTENSION STRING
	HRLI	T1,(POINT 7)
	MOVEM	T1,SRCBP
	MOVEI	T1,3		;ONLY 3 CHARS ALLOWED FOR EXTENSION
	MOVEM	T1,SRCLEN
	PUSHJ	P,ASCSIX	;CONVERT TO SIXBIT
	 $SNH			;SHOULD NOT FAIL
	MOVE	T1,ATMBUF	;GET EXTENSION
	HLLM	T1,LKPB+.RBEXT(D) ;SAVE IT
	POPJ	P,		;Return

;Routine to get random ASCII name in ATMBUF

GTMWRD:	MOVE	T1,[POINT 7,ATMBUF] ;SETUP POINTER TO ATMBUF
	MOVEM	T1,FNSPNT
	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:	MOVE	T1,I.JOB	;Get job number in RH
	MOVEI	T2,3		;ENCODE 3 DIGITS
	PUSHJ	P,DECNAS	;TO ASCII
	MOVEI	T4,3		;# chars to get
GTMWR2:	PUSHJ	P,GTMCHR	;Get random char
	IDPB	T2,FNSPNT	;DEPOSIT IN FILENAME
	SOJG	T4,GTMWR2	;Loop
	SETZ	T1,		;END WITH A NULL
	IDPB	T1,FNSPNT
	POPJ	P,		;And return

;Routine to get random ASCII 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:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIE	T1,DI.DSK	;DISK?
	 JRST	%POPJ1		;NO. FILE ALWAYS EXISTS
	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 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
	MOVE	T1,BUFADR(D)	;Point .JBFF at buffers
	MOVEM	T1,.JBFF
	MOVEI	T1,FBLK(D)	;Point to FILOP. block
	HRLI	T1,.FOMAX	;Set length
	FILOP.	T1,		;** Do FILOP. **
	 JRST	DOFLP1		;Failed
	POP	P,.JBFF		;RESTORE .JBFF
	AOS	(P)		;SUCCESS. SKIP RETURN LATER
	SETZM	LKPB+.RBALC(D)	;  so it won't be an arg to further FILOP's
	PJRST	SETPPB		;SETUP PATH STUFF

DOFLP1:	POP	P,.JBFF		;Restore .JBFF
	PUSH	P,T1		;[4211] SAVE ERROR CODE
	PUSHJ	P,RELJFN	;[4211] RELEASE THE CHANNEL (IT'S USELESS)
	POP	P,T1		;[4211]
	SETZM	LKPB+.RBALC(D)	;  so it won't be an arg to further FILOP's
	SETZM	FBLK(D)		;SO ERROR HANDLER KNOWS FILE ISN'T OPEN

;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,LKPB+.RBPPN(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,
	 $ACALL CLS		;FAILED. TYPE MSG AND DIE
	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
	CAIN	T1,57		;[4247]Check for too many open units
	 $ACALL	OPN		;[4247]Yes,Don't call Dialog
	$DCALL	OPN		;FILOP. error - reason

;DEVICE-DEPENDENT OPEN ROUTINES

OTHOPN:	PUSHJ	P,GETBSZ	;GET BYTESIZE, BPW
	LOAD	T1,MODE(D)	;Get /MODE
	MOVE	T1,MODTAB(T1)	;AND DATA MODE
				;[4253]
	MOVEM	T1,FBLK+.FOIOS(D)

	MOVEI	T1,1		;BUFFERCOUNT IS ONE NO MATTER WHAT
	STORE	T1,BUFCT(D)

	MOVEI	T1,FBLK+.FOIOS(D) ;POINT TO DATA MODE
	DEVSIZ	T1,		;GET SIZE OF A BUFFER
	 $SNH			;SHOULD NEVER FAIL
	MOVEI	T1,(T1)		;GET BUFFER SIZE
	PUSHJ	P,%GTBLK	;ALLOCATE IT
	 $ACALL	MFU		;CAN'T
	MOVEM	T1,BUFADR(D)	;SAVE ITS ADDR
	ADDI	T1,3		;AND POINT TO 1ST DATA WORD
	MOVEM	T1,WADR(D)	;SAVE IT

	PUSHJ	P,SETFB		;SETUP FILOP BLOCK
	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	MOVE	T1,DOPFLG(T1)	;GET D%IN OR D%OUT
	MOVEI	T2,IBCB(D)	;SETUP FOR INPUT BUFFER ONLY
	LOAD	T3,BUFCT(D)	;GET BUFFERCOUNT ALSO
	TXNN	T1,D%OUT	;OPEN FOR OUTPUT?
	 JRST	STOBUF		;NO. STORE INFO AS IS
	MOVSI	T2,IBCB(D)	;YES. SETUP FOR OUTPUT BUFFER
	MOVSI	T3,(T3)		;AND PUT # BUFFERS IN CORRECT PLACE
STOBUF:	MOVEM	T2,FBLK+.FOBRH(D)
	MOVEM	T3,FBLK+.FONBF(D) ;SAVE # BUFFERS
	HXLZ	T1,BYTPT(D)	;GET BYTE POINTER
	MOVEM	T1,IPTR(D)	;SAVE IT
	PUSHJ	P,CALOF		;OPEN FILE
	 POPJ	P,		;error, return .+1
	JRST	%POPJ1

TTYOPN:	PUSHJ	P,GETBSZ	;SETUP BYTESIZE, ETC.
	MOVX	T1,D%SEOL+D%IN+D%OUT ;[4220] No initial CRLF for terminals
	IORM	T1,FLAGS(D)
	MOVEI	T1,1		;SET BUFFERCOUNT TO 1
	STORE	T1,BUFCT(D)

	MOVEI	T1,FBLK+.FOIOS(D) ;POINT TO DATA MODE
	DEVSIZ	T1,		;GET SIZE OF A BUFFER
	 $SNH			;SHOULD NEVER FAIL
	MOVEI	T1,(T1)		;GET BUFFER SIZE
	LSH	T1,1		;2 BUFFERS
	PUSHJ	P,%GTBLK	;ALLOCATE THEM
	 $ACALL	MFU		;CAN'T
	HRRZM	T1,BUFADR(D)	;SAVE THEIR ADDR
	ADDI	T1,3		;AND POINT TO 1ST DATA WORD IN OUTPUT BUFFER
	HRRZM	T1,WADR(D)	;SAVE IT

	SKIPE	T1,RSIZE(D)	;RECORD SIZE SPECIFIED?
	 JRST	STOTTW		;YES. STORE AS TTYW

	MOVE	T1,[2,,T2]	;LEN,,ADDRESS OF TRMOP BLOCK
	MOVEI	T2,.TOWID	;LINE WIDTH
	MOVE	T3,DVICE(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		;GUESS 72 COLS
STOTTW:	LOAD	T2,CC(U)	;[3400] GET CARRIAGE CONTROL
	CAIE	T2,CC.LST	;[3400] CC=FORTRAN OR TRANS?
	 CAIN	T2,CC.NON
	  JRST	NOEXSP		;NO
	ADDI	T1,1		;[3400] YES, BUMP TTY WIDTH 
NOEXSP:	STORE	T1,TTYW(D)	;STORE LINE SIZE FOR NAMELIST/LIST-DIRECTED

	PUSHJ	P,SETFB		;SETUP FILOP BLOCK
	MOVEI	T1,TBCB(D)	;SETUP FOR INPUT AND OUTPUT
	HRLI	T1,IBCB(D)
	MOVEM	T1,FBLK+.FOBRH(D)
	MOVE	T1,[1,,1]	;1 BUFFER FOR EACH DIRECTION
	MOVEM	T1,FBLK+.FONBF(D)
	HXLZ	T1,BYTPT(D)	;GET BYTE POINTER
	MOVEM	T1,IPTR(D)	;SAVE IT FOR OUTPUT
	MOVEM	T1,TPTR(D)	;AND FOR INPUT
	PUSHJ	P,CALOF		;OPEN FILE
	 POPJ	P,		;error, return .+1
	JRST	%POPJ1		;DONE


DSKOPN:	PUSHJ	P,GETBSZ	;GET BYTESIZE, BPW
	MOVEI	T1,.IODMP	;DISK I/O IS ALWAYS DUMP MODE
	MOVEM	T1,FBLK+.FOIOS(D) ;STORE IN FILOP BLOCK
	PUSHJ	P,SETFB		;SETUP FILOP BLOCK
	PUSHJ	P,CALOF		;OPEN FILE
	 POPJ	P,		;error, return .+1
	PUSHJ	P,DSKSET	;DO COMMON DISK SETUP
	JRST	%POPJ1		;RETURN SUCCESS

GTEOFN:	MOVE	T1,LKPB+.RBSIZ(D) ;GET # WORDS
	MOVEM	T1,EOFN(D)	;SAVE IT AS EOFN
	MOVEI	T1,1		;AND USE 1
	MOVEM	T1,BPW(D)	;AS THE NUMBER OF BYTES/WORD
	POPJ	P,

EOFSET:	MOVE	T1,LKPB+.RBSIZ(D) ;GET # WORDS
	IMUL	T1,BPW(D)	;GET # BYTES IN FILE
	MOVEM	T1,EOFN(D)	;SAVE IT
	POPJ	P,
MTAOPN:	PUSHJ	P,MTABSZ	;[4161] GET BYTESIZE, BPW
	PUSHJ	P,MTASET	;[4161] SETUP TAPE PARAMETERS (PERMANENTLY)

	MOVEI	T1,1		;BUFFERCOUNT IS ALWAYS 1
	STORE	T1,BUFCT(D)
	
	MOVX	T1,UU.IBC	;NO ZEROING OF BUFFER
	IORM	T1,FBLK+.FOIOS(D) ;SAVE IN FILOP BLOCK

	PUSHJ	P,MTABLK	;[4161] SETUP MTA BLOCK

	PUSHJ	P,SETFB		;SETUP FILOP BLOCK
	LOAD	T1,SAIDX(D)	;GET STATUS/ACCESS INDEX
	MOVEI	T2,IBCB(D)	;SETUP FOR INPUT BUFFER ONLY
	MOVEI	T3,1		;1 BUFFER ONLY
	CAIE	T1,SA.UA	;UNKNOWN, APPEND
	 CAIN	T1,SA.OA	;OR OLD, APPEND
	  JRST	STOBF2		;YES. TREAT AS IF INPUT
	MOVE	T1,DOPFLG(T1)	;GET D%IN OR D%OUT
	TXNN	T1,D%OUT	;OPEN FOR OUTPUT?
	 JRST	STOBF2		;NO. STORE INFO AS IS
	MOVSI	T2,IBCB(D)	;YES. SETUP FOR OUTPUT BUFFER
	MOVSI	T3,1		;AND PUT # BUFFERS IN CORRECT PLACE
STOBF2:	MOVEM	T2,FBLK+.FOBRH(D) ;SAVE BUFFER POINTER ADDRESSES
	MOVEM	T3,FBLK+.FONBF(D) ;SAVE # BUFFERS
	PUSHJ	P,CALOF		;OPEN FILE
	 POPJ	P,		;error, return .+1
	HXLZ	T1,BYTPT(D)	;GET BYTE POINTER
	MOVEM	T1,IPTR(D)	;SAVE IT
	MOVX	T1,BF.IBC	;PREVENT ZEROING OF THE BUFFER
	IORM	T1,IBCB(D)
	PJRST	CHKAPP		;GO CHECK FOR APPEND

;SETUP MAGTAPE BLOCK
MTABLK:	LOAD	T3,BLKSZ(D)	;GET /BLOCKSIZE, BYTES
	JUMPE	T3,MTAGB	;IF SET

	LOAD	T1,TAPM(D)	;GET TAPE MODE
	MOVE	T1,IMPBS(T1)	;GET IMPLIED BYTESIZE
	CAIN	T1,^D36		;36 BITS?
	 JRST	MTAGW		;YES. WE'VE GOT # WORDS ALREADY
	ADD	T3,BPW(D)	;NO. DIVIDE BY BYTES/WORD
	SUBI	T3,1		;TO GET # WORDS
	IDIV	T3,BPW(D)
MTAGW:	ADDI	T3,1		;ADD ONE, AS UUO WANTS IT THAT WAY

	MOVEI	T1,.TFBSZ+.TFSET ;SET BLOCK SIZE
	MOVE	T2,DVICE(D)	;GET DEVICE NAME AGAIN
	MOVEI	P1,[ASCIZ /block size/]
	MOVE	T0,[3,,T1]	;SET POINTER FOR TAPOP
	TAPOP.	T0,		;SET IT
	 JRST	TOPERR		;?Shouldn't fail

MTAGB:	MOVEI	T1,FBLK+.FOIOS(D) ;POINT TO DATA MODE
	DEVSIZ	T1,		;GET SIZE OF A BUFFER
	 POPJ	P,		;UNBUFFERED
	MOVEI	T1,(T1)		;GET BUFFER SIZE
	MOVEI	T2,(T1)		;COPY IT
	SUBI	T2,3		;SUBTRACT BUFFER HEADER WORDS
	IMUL	T2,BPW(D)	;GET # BYTES IN IT
	LOAD	T3,BLKSZ(D)	;GET ONE THERE ALREADY
	CAIN	T3,0		;AND IF IT ZERO
	 STORE	T2,BLKSZ(D)	;STORE A NEW ONE
	LOAD	T2,BLKSZ(D)	;GET IT AGAIN, POSSIBLY UPDATED
	MOVEM	T2,WSIZ(D)	;SAVE WINDOW SIZE
	PUSHJ	P,%GTBLK	;ALLOCATE IT
	 $ACALL	MFU		;CAN'T
	MOVEM	T1,BUFADR(D)	;SAVE ITS ADDR
	ADDI	T1,3		;AND POINT TO 1ST DATA WORD
	MOVEM	T1,WADR(D)	;SAVE IT
	POPJ	P,

;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
	$DCALL	UTO		;"? Unexpected TAPOP. error.."

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

%MTPRM:
%LABCK:	POPJ	P,

;[4161] SETUP TAPE FORMAT, DENSITY, ETC. IF ANSI-ASCII OR INDUSTRY,
;SET IMGFLG TO PREVENT LSCWS. IF INDUSTRY, SET THE BYTESIZE TO 8.
MTADEF:	LOAD	T0,TAPM(D)	;GET TAPE FORMAT
	JUMPN	T0,GOTTF	;GOT IT

	MOVEI	T1,.TFMOD	;GET DATA MODE
	MOVE	T2,DVICE(D)	;GET DEVICE NAME
	MOVE	T0,[2,,T1]	;[4141] SET POINTER FOR TAPOP
	TAPOP.	T0,
	 JFCL
	STORE	T0,TAPM(D)	;STORE IT

GOTTF:	CAIE	T0,TM.IND	;INDUSTRY?
	 CAIN	T0,TM.ANS	;OR ANSI-ASCII?
	  SETOM	IMGFLG(D)	;YES. SET IMAGE FLAG (NO LSCWS)
	POPJ	P,

MTASET:	MOVE	T2,DVICE(D)	;GET DEVICE NAME
	LOAD	T3,DEN(D)	;GET /DENSITY
	JUMPE	T3,NODEN	;IF UNIT DEFAULT, LEAVE ALONE
	CAIN	T3,DN.SYS	;SYSTEM DEFAULT?
	  MOVEI	T3,.TFD00	;YES, SET THAT
	MOVEI	T1,.TFDEN+.TFSET ;SET DENSITY
	MOVEI	P1,[ASCIZ /density/]
	MOVE	T0,[3,,T1]	;SET POINTER FOR TAPOP
	TAPOP.	T0,		;SET IT
	 $ECALL	UTO		;CAN'T

NODEN:	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	T1,.TFPAR+.TFSET ;SET PARITY
	MOVEI	P1,[ASCIZ /parity/]
	MOVE	T0,[3,,T1]	;SET POINTER FOR TAPOP
	TAPOP.	T0,		;SET IT
	 $ECALL	UTO		;CAN'T

NOPAR:	LOAD	T3,TAPM(D)	;GET /TAPEFORMAT
	JUMPE	T3,NOMODE	;NONE GIVEN. DON'T DO IT!
	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
	 $ECALL	UTO		;CAN'T

NOMODE:	LOAD	T0,TAPM(D)	;GET TAPEFORMAT
	CAIE	T0,TM.IND	;INDUSTRY?
	 POPJ	P,		;NO. DONE
	MOVX	T1,.IOBYT	;YES. SET BYTE I/O MODE
	MOVEM	T1,FBLK+.FOIOS(D) ;SAVE IN FILOP BLOCK
	POPJ	P,		;DONE

>;END IF10
;TABLES


IF20,<
IMPBS:	^D36	;(0) SYSTEM DEFAULT 
	^D36	;(1) CORE-DUMP (36-BIT BYTES)
	^D36	;(2) SIXBIT (7-TRACK)
	7	;(3) ANSI-ASCII
	^D8	;(4) INDUSTRY COMPATIBLE
	^D36	;(5) HIGH-DENSITY
> ;END IF20

IF10,<
IMPBS:	^D36	;(0) SYSTEM DEFAULT
	^D36	;(1) 9-TRACK CORE-DUMP
	^D8	;(2) INDUSTRY-COMPATIBLE
	^D36	;(3) 9-TRACK SIXBIT
	7	;(4) ANSI-ASCII
	^D36	;(5) SIXBIT (7-TRACK)
> ;END IF10

;BYTE SIZE, DATA MODE

BSTAB:	7	;NO MODE (ASSUME ASCII)
	^D36	;IMAGE
	^D36	;BINARY
	^D36	;DUMP
	7	;ASCII 7-BIT
	7	;LINED
	9	;ASCII 9-BIT

MODTAB:	0	;NO MODE (ASSUME ASCII)
	10	;IMAGE
	14	;BINARY
	17	;DUMP
	0	;ASCII 7-BIT
	0	;LINED
	0	;ASCII 9-BIT

SPCTAB:	0			;BYTESIZE=0
	0			;1
	0			;2
	0			;3
	0			;4
	0			;5
	0			;SIXBIT
	ASCII /     /		;7-BIT ASCII
	BYTE (8)" "," "," "," "	;8-BIT ASCII
	BYTE (9)" "," "," "," "	;9-BIT ASCII
	BYTE (10)" "," "," "	;10
	BYTE (11)" "," "," "	;11
	BYTE (12)" "," "," "	;12
	BYTE (13)" "," "	;13
	BYTE (14)" "," "	;14
	BYTE (15)" "," "	;15
	BYTE (16)" "," "	;16
	BYTE (17)" "," "	;17
	BYTE (18)" "," "	;18
	BYTE (19)" "		;19
	BYTE (20)" "		;20
	BYTE (21)" "		;21
	BYTE (22)" "		;22
	BYTE (23)" "		;23
	BYTE (24)" "		;24
	BYTE (25)" "		;25
	BYTE (26)" "		;26
	BYTE (27)" "		;27
	BYTE (28)" "		;28
	BYTE (29)" "		;29
	BYTE (30)" "		;30
	BYTE (31)" "		;31
	BYTE (32)" "		;32
	BYTE (33)" "		;33
	BYTE (34)" "		;34
	BYTE (35)" "		;35
	BYTE (36)" "		;36

BPTAB:	(POINT 36,0,35)
	(POINT 1,0,35)
	(POINT 2,0,35)
	(POINT 3,0,35)
	(POINT 4,0,35)
	(POINT 5,0,34)
	(POINT 6,0,35)
	(POINT 7,0,34)
	(POINT 8,0,31)
	(POINT 9,0,35)
	(POINT 10,0,29)
	(POINT 11,0,32)
	(POINT 12,0,35)
	(POINT 13,0,25)
	(POINT 14,0,27)
	(POINT 15,0,29)
	(POINT 16,0,31)
	(POINT 17,0,33)
	(POINT 18,0,35)
	(POINT 19,0,18)
	(POINT 20,0,19)
	(POINT 21,0,20)
	(POINT 22,0,21)
	(POINT 23,0,22)
	(POINT 24,0,23)
	(POINT 25,0,24)
	(POINT 26,0,25)
	(POINT 27,0,26)
	(POINT 28,0,27)
	(POINT 29,0,28)
	(POINT 30,0,29)
	(POINT 31,0,30)
	(POINT 32,0,31)
	(POINT 33,0,32)
	(POINT 34,0,33)
	(POINT 35,0,34)
	(POINT 36,0,35)

%OWGBT:	0		;0
	0		;1
	0		;2
	0		;3
	0		;4
	0		;5
	530000,,0	;6
	660000,,0	;7
	600000,,0	;8
	730000,,0	;9
	0		;10
	0		;11
	0		;12
	0		;13
	0		;14
	0		;15
	0		;16
	0		;17
	760000,,0	;18
	0		;19
	0		;20
	0		;21
	0		;22
	0		;23
	0		;24
	0		;25
	0		;26
	0		;27
	0		;28
	0		;29
	0		;30
	0		;31
	0		;32
	0		;33
	0		;34
	0		;35
	0		;36

	SUBTTL	SWITCH TABLES

	DEFINE	X (NAME,VAL,FLG) <
	XWD	[ASCIZ \NAME\],[FLG,,VAL]
> ;END X

	DEFINE	Y (NAME,ADR) <
	XWD	[CM%FW!CM%INV!CM%ABR
		ASCIZ \NAME\],ADR
> ;END Y


OPNSWT:	XWD	LSWT,LSWT
	X	ACCESS:,OK.ACC
	X	BLANK:,OK.BLNK
	X	BLOCKSIZE:,OK.BLK,ANSIDX
	X	BUFFERCOUNT:,OK.BFC,ANSIDX
	X	BYTESIZE:,OK.BYT,ANSIDX!VAXIDX
	X	CARRIAGECONTROL:,OK.CC,ANSIDX
	X	DENSITY:,OK.DEN,ANSIDX!VAXIDX
	X	DISPOSE:,OK.DISP,ANSIDX
	X	FILESIZE:,OK.FLS,ANSIDX!VAXIDX
	X	FORM:,OK.FORM
IF20,<	X	KEY:,OK.KEY,ANSIDX 		;[5000]>
	X	LIMIT:,OK.LIM,ANSIDX!VAXIDX
IF20,<	X	MAXREC:,OK.MRN,ANSIDX		;[5016]>
	X	MODE:,OK.MOD,ANSIDX!VAXIDX
IF20,<	X	NOSPANBLOCKS,OK.SPN,ANSIDX	;[5000]>
IF20,<	X	ORGANIZATION:,OK.ORG,ANSIDX	;[5000]>
	X	PADCHAR:,OK.PAD,ANSIDX!VAXIDX
	X	PARITY:,OK.PAR,ANSIDX!VAXIDX
	X	PROTECTION:,OK.PROT,ANSIDX!VAXIDX
	X	READONLY,OK.RO,ANSIDX
	X	RECL:,OK.REC
	Y	RECORD,OPNREC
OPNREC:	X	RECORDSIZE:,OK.REC,ANSIDX
	X	RECORDTYPE:,OK.RTP,ANSIDX
IF20,<	X	SHARED,OK.SHR,ANSIDX		;[5000]>
	X	STATUS:,OK.STAT
	X	TAPEFORMAT:,OK.TAPM,ANSIDX!VAXIDX
	X	VERSION:,OK.VER,ANSIDX!VAXIDX
LSWT==.-OPNSWT-1

;Legal DIALOG CLOSE switches

CLSSWT:	XWD	CSWT,CSWT
	X	DISPOSE:,OK.DISP,ANSIDX
	X	PROTECTION:,OK.PROT,ANSIDX!VAXIDX
	X	STATUS:,OK.STAT
CSWT==.-CLSSWT-1


SWACC:	XWD	LACC,LACC
	X	APPEND,AC.APP,ANSIDX
	X	DIRECT,AC.RIO
IF20,<	X	KEYED,AC.KEY,ANSIDX>		;[5000]
	X	RANDIN,AC.RIN,ANSIDX!VAXIDX
	X	RANDOM,AC.RIO,ANSIDX!VAXIDX
	X	SEQIN,AC.SIN,ANSIDX!VAXIDX
	X	SEQINOUT,AC.SIO,ANSIDX!VAXIDX
	X	SEQOUT,AC.SOU,ANSIDX!VAXIDX
	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,ANSIDX!VAXIDX
	X	FORTRAN,CC.FOR,ANSIDX
	X	LIST,CC.LST,ANSIDX
	X	NONE,CC.NON,ANSIDX
	X	TRANSLATED,CC.TRN,ANSIDX!VAXIDX
LCC==.-SWCC-1


SWDEN:	XWD	LDEN,LDEN
	X	1600,DN.1600
	X	200,DN.200
	X	556,DN.556
	X	6250,DN.6250
	X	800,DN.800
	X	SYSTEM,DN.SYS
LDEN==.-SWDEN-1

;OPEN DISPOSE values

SWDSPO:	XWD	LDISPO,LDISPO
	X	DELETE,DS.DEL
	X	EXPUNGE,DS.EXP,ANSIDX!VAXIDX
	X	KEEP,DS.SAVE
	X	LIST,DS.LIST,ANSIDX!VAXIDX
	X	PLOT,DS.PLT
	X	PRINT,DS.PRNT
	X	PUNCH,DS.PNCH,ANSIDX!VAXIDX
	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	PLOT,DS.PLT
	X	PRINT,DS.PRNT
	X	PUNCH,DS.PNCH
	X	RENAME,DS.NOT
	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


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


IF20,<
SWORG:	XWD	LORG,LORG
	X	INDEXED,OR.IDX			;[5000]
	X	RELATIVE,OR.REL			;[5000]
	X	SEQUENTIAL,OR.SEQ		;[5000]
	X	UNKNOWN,OR.UNK,VAXIDX		;[5000]
LORG==.-SWORG-1
> ;End IF20

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

	DEFINE	Z (NAME,VAL,FLG) <
	XWD	[CM%FW!CM%INV
		ASCIZ \NAME\],[FLG,,VAL]
> ;END Z

SWRECT:	XWD	LRECT,LRECT
	Z	DELIMITED,RT.DEL,VAXIDX
	X	FIXED,RT.FIX
	X	STREAM,RT.UND
	Z	UNDEFINED,RT.UND,VAXIDX
	X	UNKNOWN,RT.UNS,VAXIDX		;[5000]
	X	VARIABLE,RT.DEL
LRECT==.-SWRECT-1


;OPEN STATUS values

SWSTAT:	XWD	LSTAT,LSTAT
	X	DELETE,ST.DEL,ANSIDX!VAXIDX
	X	EXPUNGE,ST.EXP,ANSIDX!VAXIDX
	X	KEEP,ST.SAV,ANSIDX!VAXIDX
	X	NEW,ST.NEW
	X	OLD,ST.OLD
	X	SAVE,ST.SAV,ANSIDX!VAXIDX
	X	SCRATCH,ST.SCR
	X	UNKNOWN,ST.UNK
LSTAT==.-SWSTAT-1

;LEGAL STATUS VALUES FOR CLOSE

SWSTTC:	XWD	LSTTC,LSTTC
	X	DELETE,ST.DEL
	X	EXPUNGE,ST.EXP,ANSIDX!VAXIDX
	X	KEEP,ST.SAV
	X	SAVE,ST.SAV,ANSIDX!VAXIDX
LSTTC==.-SWSTTC-1


;/TAPEFORMAT

SWTAPM:	XWD	LTAPM,LTAPM
	X	CORE-DUMP,TM.DMP
	X	INDUSTRY,TM.IND
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)  BUFFERCOUNT=
	XWD	OPNINT,[DIAINT]	;(5)  BLOCKSIZE=
	XWD	ARGNOP,		;(6)  FILE=
	XWD	OPNINT,[DIAOCT] ;(7)  PROTECTION=
	XWD	OPNDIR,		;(10) DIRECTORY=
	XWD	OPNINT,[DIAINT]	;(11) LIMIT=
	XWD	OPNKWD,SWMODE	;(12) MODE=
	XWD	OPNINT,[DIAINT]	;(13) FILESIZE=
	XWD	OPNINT,[DIAINT]	;(14) RECORDSIZE=
	XWD	OPNKWD,SWDSPO	;(15) DISPOSE=
	XWD	OPNINT,[DIAOCT]	;(16) VERSION=
IF10,<	XWD	OPNERR,		;(17) ORGANIZATION=	[5000]>
IF20,<	XWD	OPNKWD,SWORG	;(17) ORGANIZATION=	[5000]>
IF10,<	XWD	OPNERR,		;(20) SHARED		[5000]>
IF20,<	XWD	OPNSET,[DIASET]	;(20) SHARED		[5000]>
	XWD	ARGNOP,		;(21) IOSTAT=
	XWD	OPNADR,		;(22) ASSOCIATEVARIABLE=
	XWD	OPNKWD,SWPAR	;(23) PARITY=
	XWD	OPNKWD,SWDEN	;(24) DENSITY=
	XWD	OPNKWD,SWBLNK	;(25) BLANK=
	XWD	OPNKWD,SWCC	;(26) CARRIAGECONTROL=
	XWD	OPNKWD,SWFORM	;(27) FORM=
	XWD	OPNINT,[DIAINT]	;(30) BYTESIZE=
	XWD	PADCHR,[DIACHR]	;(31) PADCHAR=
	XWD	OPNKWD,SWRECT	;(32) RECORDTYPE=
	XWD	OPNKWD,SWSTAT	;(33) STATUS=
	XWD	OPNKWD,SWTAPM	;(34) TAPEFORMAT=
	XWD	OPNSET,[DIASET]	;(35) READONLY
	XWD	ARGNOP,		;(36) UNIT=
	XWD	ARGNOP,		;(37) ERR=
	XWD	OPNERR,		;(40) EXIST=
	XWD	OPNERR,		;(41) FORMATTED=
	XWD	OPNERR,		;(42) NAMED=
	XWD	OPNERR,		;(43) NEXTREC=
	XWD	OPNERR,		;(44) NUMBER=
	XWD	OPNERR,		;(45) OPENED=
	XWD	OPNERR,		;(46) SEQUENTIAL=
	XWD	OPNERR,		;(47) UNFORMATTED=
	XWD	ARGNOP,		;(50) NAME=
IF10,<	XWD	OPNERR,		;(51) KEY= 		[5000]>
IF20,<	XWD	ARGNOP,[DIAKEY]	;(51) KEY= 		[5000]>
IF10,<	XWD	OPNERR,		;(52) USEROPEN= 	[5000]>
IF20,<	XWD	OPNADR,		;(52) USEROPEN= 	[5000]>
	XWD	ARGNOP,		;(53) DIALOG=
IF10,<	XWD	OPNERR,		;(54) DEFAULTFILE= 	[5000]>
IF20,<	XWD	ARGNOP,		;(54) DEFAULTFILE= 	[5000]>
	XWD	OPNERR,		;(55) KEYED=		[5000]
IF10,<	XWD	OPNERR,		;(56) NOSPANBLOCKS	[5000]>
IF20,<	XWD	OPNSET,[DIASET]	;(56) NOSPANBLOCKS	[5000]>
IF10,<	XWD	OPNERR,		;(57) MAXREC		[5016]>
IF20,<	XWD	OPNINT,[DIAINT]	;(57) MAXREC		[5016]>
OPNMAX==.-OPNDSP-1


;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	ARGNOP,		;(6) FILE=
	XWD	OPNINT,[DIAOCT]	;(7) PROTECTION=
	XWD	OPNDIR,		;(10) DIRECTORY=
	XWD	OPNINT,[DIAINT]	;(11) LIMIT=
	XWD	CLIGN,[DIAIGN]	;(12) MODE=
	XWD	CLIGN,[DIAIGN]	;(13) FILESIZE=
	XWD	CLIGN,[DIAIGN]	;(14) RECORDSIZE=
	XWD	OPNKWD,SWDISC	;(15) DISPOSE=
	XWD	CLIGN,[DIAIGN]	;(16) VERSION=
IF10,<	XWD	OPNERR,		;(17) ORGANIZATION=	[5000]>
IF20,<	XWD	CLIGN,[DIAIGN]	;(17) ORGANIZATION=	[5000]>
IF10,<	XWD	OPNERR,		;(20) SHARED		[5000]>
IF20,<	XWD	CLIGN,[DIAIGN]	;(20) SHARED		[5000]>
	XWD	ARGNOP,		;(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) BYTESIZE=
	XWD	CLIGN,[DIAIGN]	;(31) PADCHAR=
	XWD	CLIGN,[DIAIGN]	;(32) RECORDTYPE=
	XWD	OPNKWD,SWSTTC	;(33) STATUS=
	XWD	CLIGN,[DIAIGN]	;(34) TAPEFORMAT=
	XWD	CLIGN,[DIAIGN]	;(35) READONLY
	XWD	ARGNOP,		;(36) UNIT=
	XWD	ARGNOP,		;(37) ERR=
	XWD	OPNERR,		;
	XWD	OPNERR,		;
	XWD	OPNERR,		;
	XWD	OPNERR,		;
	XWD	OPNERR,		;
	XWD	OPNERR,		;
	XWD	OPNERR,		;
	XWD	OPNERR,		;
	XWD	ARGNOP,		;(50) NAME=
IF10,<	XWD	OPNERR,		;(51) KEY= 		[5000]>
IF20,<	XWD	CLIGN,[DIAIGN]	;(51) KEY= 		[5000]>
IF10,<	XWD	OPNERR,		;(52) USEROPEN=		[5000]>
IF20,<	XWD	CLIGN,[DIAIGN]	;(52) USEROPEN=		[5000]>
	XWD	ARGNOP,		;(53) DIALOG=
	XWD	OPNERR,		;(54) DEFAULTFILE=	[5000]
	XWD	OPNERR,		;(55) KEYED=		[5000]
IF10,<	XWD	OPNERR,		;(56) NOSPANBLOCKS	[5000]>
IF20,<	XWD	CLIGN,[DIAIGN]	;(56) NOSPANBLOCKS	[5000]>
	XWD	OPNERR,		;(57) MAXREC		[5016]
CLSMAX==.-CLSDSP-1

;Guard against developer 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,UBUFCT(D)	;(4)  BUFFERCOUNT=	[5000]
	STORE	T2,BLKSZ(D)	;(5)  BLOCKSIZE=
	$SNH			;(6)  FILE=
	PUSHJ	P,SETPROT	;(7)  PROTECTION=
	$SNH			;(10) DIRECTORY=
	STORE	T2,LIMIT(D)	;(11) LIMIT=
	STORE	T2,MODE(D)	;(12) MODE=
	PUSHJ	P,SETFSZ	;(13) FILESIZE=
	MOVEM	T2,RSIZE(D)	;(14) RECORDSIZE=
	STORE	T2,DISP(D)	;(15) DISPOSE=
	MOVEM	T2,VERN(D)	;(16) VERSION=
IF10,<	$SNH			;(17) ORGANIZATION=	[5000]>
IF20,<	STORE	T2,ORGAN(D)	;(17) ORGANIZATION=	[5000]>
IF10,<	$SNH			;(20) SHARED		[5000]>
IF20,<	STORE	T2,SHARE(D)	;(20) SHARED		[5000]>
	$SNH			;(21) IOSTAT=
	MOVEM	T2,AVAR(D)	;(22) ASSOCIATEVARIABLE=
	STORE	T2,PAR(D)	;(23) PARITY=
	STORE	T2,DEN(D)	;(24) DENSITY=
	STORE	T2,BLNK(U)	;(25) BLANK=
	STORE	T2,CC(U)	;(26) CARRIAGECONTROL=
	STORE	T2,FORM(D)	;(27) FORM=
	STORE	T2,UBSIZ(D)	;(30) BYTESIZE=
	STORE	T2,PADCH(U)	;(31) PADCHAR=
	STORE	T2,RECTP(D)	;(32) RECORDTYPE=
	STORE	T2,STAT(D)	;(33) STATUS=
	STORE	T2,TAPM(D)	;(34) TAPEFORMAT=
	STORE	T2,RO(D)	;(35) READONLY
	$SNH			;(36) UNIT=
	$SNH			;(37) ERR=
	$SNH			;(40) EXIST=
	$SNH			;(41) FORMATTED=
	$SNH			;(42) NAMED=
	$SNH			;(43) NEXTREC=
	$SNH			;(44) NUMBER=
	$SNH			;(45) OPENED=
	$SNH			;(46) SEQUENTIAL=
	$SNH			;(47) UNFORMATTED=
	$SNH			;(50) NAME=
	$SNH			;(51) KEY= 		[5000]
IF10,<	$SNH			;(52) USEROPEN=		[5000]>
IF20,<	MOVEM	T2,UOPN(D)	;(52) USEROPEN=		[5000]>
	$SNH			;(53) DIALOG=
	$SNH			;(54) DEFAULTFILE= 	[5000]
	$SNH			;(55) KEYED=		[5000]
IF10,<	$SNH			;(56) NOSPANBLOCKS	[5000]>
IF20,<	STORE	T2,SPAN(D)	;(56) NOSPANBLOCKS	[5000]>
IF10,<	$SNH			;(57) MAXREC		[5016]>
IF20,<	MOVEM	T2,MAXREC(D)	;(57) MAXREC		[5016]>

OPSTMX==.-OPSTOR-1

;Guard against developer errors

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

INQDSP:	XWD	OPNERR,		;(0)
	XWD	OPNERR,		;(1)  DIALOG=
	XWD	INQACC,		;(2)  ACCESS=
	XWD	OPNERR,		;(3)  DEVICE=
	XWD	OPNERR,		;(4)  BUFFER COUNT=
	XWD	OPNERR,		;(5)  BLOCK SIZE=
	XWD	ARGNOP,		;(6)  FILE=
	XWD	OPNERR,		;(7)  PROTECTION=
	XWD	INQDIR,		;(10) DIRECT=
	XWD	OPNERR,		;(11) LIMIT=
	XWD	OPNERR,		;(12) MODE=
	XWD	OPNERR,		;(13) FILE SIZE=
	XWD	INQRSZ,		;(14) RECORDSIZE=
	XWD	OPNERR,		;(15) DISPOSE=
	XWD	OPNERR,		;(16) VERSION=
IF10,<	XWD	OPNERR,		;(17) ORGANIZATION=	[5001]>
IF20,<	XWD	INQORG,		;(17) ORGANIZATION=	[5001]>
	XWD	OPNERR,		;(20) SHARED
	XWD	ARGNOP,		;(21) IOSTAT=
	XWD	OPNERR,		;(22) ASSOCIATEVARIABLE=
	XWD	OPNERR,		;(23) PARITY=
	XWD	OPNERR,		;(24) DENSITY=
	XWD	INQBLK,		;(25) BLANK=
	XWD	INQCC,		;(26) CARRIAGECONTROL=
	XWD	INQFRM,		;(27) FORM=
	XWD	INQBSZ,		;(30) BYTESIZE=		[5001]
	XWD	OPNERR,		;(31) PADCHAR=
	XWD	INQRTP,		;(32) RECORDTYPE=
	XWD	OPNERR,		;(33) STATUS=
	XWD	OPNERR,		;(34) TAPEFORMAT=
	XWD	OPNERR,		;(35) READONLY
	XWD	ARGNOP,		;(36) UNIT=
	XWD	ARGNOP,		;(37) ERR=
	XWD	INQXST,		;(40) EXIST=
	XWD	INQFMT,		;(41) FORMATTED=
	XWD	INQNMD,		;(42) NAMED=
	XWD	INQNRC,		;(43) NEXTREC=
	XWD	INQNBR,		;(44) NUMBER=
	XWD	INQOPN,		;(45) OPENED=
	XWD	INQSEQ,		;(46) SEQUENTIAL=
	XWD	INQUNF,		;(47) UNFORMATTED=
	XWD	INQNAM,		;(50) NAME=
	XWD	OPNERR,		;(51) KEY= 		[5001]
	XWD	OPNERR,		;(52) USEROPEN=		[5001]
	XWD	OPNERR,		;(53) DIALOG=
IF10,<	XWD	OPNERR,		;(54) DEFAULTFILE= 	[5001]>
IF20,<	XWD	ARGNOP,		;(54) DEFAULTFILE= 	[5001]>
IF10,<	XWD	OPNERR,		;(55) KEYED=		[5001]>
IF20,<	XWD	INQKEY,		;(55) KEYED=		[5001]>
	XWD	OPNERR,		;(56) NOSPANBLOCKS	[5001]
	XWD	OPNERR,		;(57) MAXREC		[5016]

INQMAX==.-INQDSP-1

;Guard against developer errors

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

	SEGMENT	DATA

OICBLK:
O.IGNO:	BLOCK	1	;(0)  IGNORED
O.DIAL:	BLOCK	1	;(1)  DIALOG
O.ACCE:	BLOCK	1	;(2)  ACCESS=
O.DEVI:	BLOCK	1	;(3)  DEVICE=
O.BUFF:	BLOCK	1	;(4)  BUFFERCOUNT=
O.BLOC:	BLOCK	1	;(5)  BLOCKSIZE=
O.FILE:	BLOCK	1	;(6)  FILE=
O.PROT:	BLOCK	1	;(7)  PROTECTION=
O.DIRE:	BLOCK	1	;(10) DIRECTORY=
O.LIMI:	BLOCK	1	;(11) LIMIT=
O.MODE:	BLOCK	1	;(12) MODE=
O.FILS:	BLOCK	1	;(13) FILESIZE=
O.RECS:	BLOCK	1	;(14) RECORDSIZE=
O.DISP:	BLOCK	1	;(15) DISPOSE=
O.VERS:	BLOCK	1	;(16) VERSION=
O.ORGA:	BLOCK	1	;(17) ORGANIZATION=
O.SHAR:	BLOCK	1	;(20) SHARED
O.IOS:	BLOCK	1	;(21) IOSTAT=
O.ASSO:	BLOCK	1	;(22) ASSOCIATEVARIABLE=
O.PARI:	BLOCK	1	;(23) PARITY=
O.DENS:	BLOCK	1	;(24) DENSITY=
O.BLAN:	BLOCK	1	;(25) BLANK=
O.CARR:	BLOCK	1	;(26) CARRIAGECONTROL=
O.FORM:	BLOCK	1	;(27) FORM=
O.BYTE:	BLOCK	1	;(30) BYTESIZE=
O.PADC:	BLOCK	1	;(31) PADCHAR=
O.RECT:	BLOCK	1	;(32) RECORDTYPE=
O.STAT:	BLOCK	1	;(33) STATUS=
O.TAPE:	BLOCK	1	;(34) TAPEFORMAT=
O.READ:	BLOCK	1	;(35) READONLY
O.UNIT:	BLOCK	1	;(36) UNIT=
O.ERR:	BLOCK	1	;(37) ERR=
O.EXIS:	BLOCK	1	;(40) EXIST=
O.FRMD:	BLOCK	1	;(41) FORMATTED=
O.NMED:	BLOCK	1	;(42) NAMED=
O.NEXT:	BLOCK	1	;(43) NEXTREC=
O.NUMB:	BLOCK	1	;(44) NUMBER=
O.OPEN:	BLOCK	1	;(45) OPENED=
O.SEQU:	BLOCK	1	;(46) SEQUENTIAL=
O.UNFO:	BLOCK	1	;(47) UNFORMATTED=
O.NAME:	BLOCK	1	;(50) NAME=
O.KEY:	BLOCK	1	;(51) KEY= 		[5000]
O.UOPN:	BLOCK	1	;(52) USEROPEN=		[5000]
O.DIAS:	BLOCK	1	;(53) DIALOG=
O.DFLT:	BLOCK	1	;(54) DEFAULTFILE= 	[5000]
O.KYD:	BLOCK	1	;(55) KEYED=		[5000]
O.SPAN:	BLOCK	1	;(56) NOSPANBLOCKS	[5000]
O.MRN:	BLOCK	1	;(57) MAXREC=		[5016]
OICMAX==.-OICBLK-1

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

	SEGMENT	CODE

;DEFAULT EXTENSION AND DEVICE NAME
DATEXT:	ASCIZ	/DAT/
DSKDEF:	ASCIZ	/DSK/

;DEFAULT DEVICE TABLE

	[ASCIZ	/PLOT/]		;-7
	[ASCIZ	/REREAD/]	;-6
	[ASCIZ	/READ/]		;-5: CDR
	[ASCIZ	/ACCEPT/]	;-4
	[ASCIZ	/PRINT/]	;-3
	[ASCIZ	/PUNCH/]	;-2
	[ASCIZ	/TYPE/]		;-1
%UNNAM=.

	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!FTVAX,<
	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
> ;END IFE FTDSK!FTVAX

IFN FTDSK,<
	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:
> ;[4225] END IFN FTDSK

IFN FTVAX,<			;ALL BUT UNIT=5 AND 6 IS DSK:
	X	DSK		;00	DISK
	X	DSK		;01	DISK
	X	DSK		;02	DISK
	X	DSK		;03	DISK
	X	DSK		;04	DISK
	X	TTY		;05	USER'S TTY (INPUT)
	X	TTY		;06	USER'S TTY (OUTPUT)
> ;END IFN FTVAX

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

	CAIE	T1,DT.NUL	;NUL: doesn't get consolidated
	 CAIN	T1,DT.DSK	;DSK: doesn't get consolidated
	  JRST	%POPJ1		;SKIP RETURN

;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
	JRST	%POPJ1		;SKIP RETURN

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
	 POPJ	P,		;SOMETHING NOT COMPATIBLE. NON-SKIP RETURN
	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

	MOVE	T1,CNSL1(T3)	;See if any consolidated yet..
	JUMPE	T1,NOTCYT	;No
	MOVEM	U,CNSL1(T3)	;Store new "next" link in old previous
				; unit block
	MOVEM	T3,CNSL2(U)	;Store new "previous" link in added unit block
	MOVEM	T1,CNSL1(U)	;Store new "next" link in added unit block
	MOVEM	U,CNSL2(T1)	;Store new "previous" link in old next
				; unit block
	JRST	%POPJ1		;SKIP 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:	MOVEM	T3,CNSL1(U)
	MOVEM	T3,CNSL2(U)
	MOVEM	U,CNSL1(T3)
	MOVEM	U,CNSL2(T3)
	JRST	%POPJ1		;SKIP RETURN

;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
	MOVEM	D,DDBAD(U)	;SAVE NEW DDB ADDRESS IN UDB
	AOS	USCNT(D)	;Increment use count
	JRST	%POPJ1		;AND SKIP RETURN

	SEGMENT	DATA

GJBTS:	BLOCK	1		;GTJFN bits for DOOPEN
OPNBTS:	BLOCK	1		;OPENF BITS FOR DOOPEN
CNSUNT:	BLOCK	1		;Address of the unit that might point
RETA:	BLOCK	1		;RETURN ADDRESS FOR SAVERR

	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:	MOVE	T1,CNSL1(U)	;Get "next" unit in chain, if any
	JUMPE	T1,%POPJ	;Return if none -- nothing to do.
	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

	MOVE	T1,CNSL1(P1)	;Get "next" unit in chain
	CAMN	T1,U		;Wrapped around to beginning?
	 JRST	DOCNS2		;Yes
	SETZM	CNSL1(P1)	;CLEAR THE LINKS
	SETZM	CNSL2(P1)	; . .
	MOVE	P1,T1		;P1= next unit
	JRST	DOCNS1		;Loop

;Clear links in the current unit block also.

DOCNS2:	SETZM	CNSL1(U)
	SETZM	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
	HXRE	T2,UNUM(T1)	;T2= unit number for error message [3111]
	MOVE	T1,DDBAD(T1)	;T1= DDB address to check
	MOVE	T3,RSIZE(T1)	;GET RECORDSIZE OF OLD DDB
	CAME	T3,RSIZE(D)	;MUST BE THE SAME AS THE NEW ONE
	 $DCALL	SDO		;NO. GIVE ERROR
	MOVE	T1,IMGFLG(T1)	;[4161] GET IMAGE-MODE FLAG OF ONE
	CAME	T1,IMGFLG(D)	;[4161] SAME AS THE OTHER?
	 $DCALL	SDO		;[4161] NO. GIVE ERROR
	JUMPN	T1,%POPJ1	;DON'T CHECK MODES IF MODE=IMAGE
	LOAD	T3,MODE(T1)	;Get old mode
	LOAD	T4,MODE(D)	;Get new mode
	JUMPE	T4,%POPJ1	;NOT SET UP IS OK
	CAME	T3,T4		;The same?
	 $DCALL	SDO		;?No, give error
	JRST	%POPJ1		;SKIP 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:	MOVE	T1,CNSL1(U)	;Get "next" link
	JUMPE	T1,%POPJ	;Return if none
	MOVE	T2,CNSL2(U)	;Get "previous" link
	CAMN	T1,T2		;The same? (just two unit blocks in link)
	 JRST	CLRCN1		;Yes, delete all ptrs.
	MOVEM	T1,CNSL1(T2)	;Store new "next" link in old previous
	MOVEM	T2,CNSL2(T1)	;Store new "previous" link in old next
	JRST	CLRCN2		;Delete links of this DDB

;Delete all ptrs.

CLRCN1:	SETZM	CNSL1(T1)	;
	SETZM	CNSL2(T1)	;

;Delete ptrs in this unit block.

CLRCN2:	SETZM	CNSL1(U)
	SETZM	CNSL2(U)
	POPJ	P,		;Return

	SUBTTL	CLOSE

	FENTRY	(CLOSE)
	PUSHJ	P,%SAVAC	;SAVE USER'S ACS
	PUSHJ	P,%CPARG	;AND COPY ARGS
	XMOVEI	T1,[ASCIZ /CLOSE/] ;SET STATEMENT NAME FOR ERR MESSAGES
	MOVEM	T1,%IONAM
	PUSHJ	P,CLCVAR	;CLEAR COMMON OPEN/CLOSE VARIABLES
	PUSHJ	P,CLSCNV	;CONVERT OLD ARG BLOCK FORMAT
	PUSHJ	P,OICCPY	;COPY ARGS TO KEYWORD BLOCK
	PUSHJ	P,UNRNGE	;Check for unit out of range
	MOVE	T1,%CUNIT	;GET THE UNIT
	SKIPN	U,%DDBTAB(T1)	;Get ptr to unit block
	 JRST	%SETAV		;NO FILE OPEN. CLOSE IS NOP. CLEAR %UDBAD
	MOVEM	U,%UDBAD	;SAVE FOR ERROR MESSAGES
	MOVEM	U,%OLUDB	;SAVE FOR LATER
	MOVE	D,DDBAD(U)	;GET DDB ADDR
	MOVEM	D,%OLDDB	;SAVE FOR LATER
	PUSHJ	P,CLOSE1	;CHECK IF FILE WAS OPENED
	 JRST	CLSCLN		;IT WAS NOT

	PUSHJ	P,GTRDDB	;GET NEW UDB/DDB, SAVE ADDRESSES

	SETZM	O.DIAL		;KLUDGE - FILLED IN BY OPNARG
	PUSHJ	P,CLSARG	;MOVE ARGS TO DDB

	SKIPE	O.FILE		;FILE=STRING SEEN?
	 PUSHJ	P,FILCLS	;YES. PROCESS IT
	SKIPE	O.NAME		;NAME=STRING SEEN?
	 PUSHJ	P,NAMCLS	;YES. PROCESS IT
	SKIPE	O.DIAS		;DIALOG=STRING SEEN?
	 PUSHJ	P,DLSCLS	;Yes, do it

CLOS.1:	SKIPN	%RNAMU		;ANY RENAME UDB?
	 PUSHJ	P,GTRDDB	;NO. GET ONE
	MOVE	U,%RNAMU	;SETUP U AND D
	MOVE	D,%RNAMD

	PUSHJ	P,CLSDLG	;Do DIALOG mode if necessary
	PUSHJ	P,CKCARG	;Check CLOSE args for problems,
	 JRST	CLOS.1		; (user has to fix stuff)

	MOVE	U,%OLUDB	;GET ORIGINAL UNIT BLOCK ADDR
	MOVE	D,%OLDDB	;AND ORIGINAL DEVICE BLOCK ADDR
	PJRST	CLSITA		;Go close an opened unit and return

	SUBTTL	%CLOSX: GENERIC CLOSE ROUTINE

;Routine to close an opened unit
;Call:
;	D/ ptr to DDB block
;	U/ ptr to unit block
;
%CLOSX:	PUSHJ	P,CLCVAR	;CLEAR COMMON OPEN/CLOSE VARIABLES
	MOVEM	U,%UDBAD	;TELL ERROR HANDLER WE HAVE A DDB
	MOVEM	U,%OLUDB	;SAVE OLD UDB
	MOVEM	D,%OLDDB	;AND DDB
	MOVEM	D,CLSDDB	;[4155] USE THIS ONE FOR DISPOSE AND STATUS
	SETZM	%RNAMU		;NO RENAME UDB OR DDB
	SETZM	%RNAMD
	SETZM	%NAMLN		;[4155] CLEAR THE "MESSAGE ALREADY OUT" FLAG
	PUSHJ	P,CLOSE1	;SEE IF UNIT HAS BEEN OPENED
	 JRST	CLSCLN		;HAS NOT. JUST CLEAN UP

;Here when file is open, to close it.

CLSITA:	MOVE	T1,USCNT(D)	;GET DDB USE COUNT
	CAILE	T1,1		;MORE THAN 1?
	 JRST	XCLSDN		;YES. DON'T DO ANYTHING NOW!
	LOAD	T1,INDX(D)	;GET DEV INDEX
	PUSHJ	P,CLSTAB(T1)	;CLOSE BY DEVICE
	PUSHJ	P,CHKREN	;CHECK ON RENAME
	 JRST	CLOS.1		;RENAME FAILED. TRY AGAIN
	LOAD	T1,INDX(D)	;GET DEVICE INDEX AGAIN
	PUSHJ	P,DPTAB(T1)	;AND DISPOSE OF FILE
	 JRST	CLOS.1		;FAILED. TRY AGAIN
XCLSDN:	HXRE	T1,UNUM(U)	;Get unit number
	MOVE	T2,[RRUNIT]	;GET FLAG FOR NO REREAD UNIT
	CAMN	T1,U.RERD	;Is it the last successful READ unit?
	 MOVEM	T2,U.RERD	;Yes, save flag so REREAD fails.
	PJRST	CLSCLN		;CLEANUP AND RETURN

;CLOSE1 - Entry from CLOSE statement
;We have to open the file if an explicit OPEN statement
; has been done.
;If the file is on Disk or DECtape, and
;an OPEN was done but the file is not open now,
;actually get the file opened.
;If file already exists, open for input.
;Else open for output.

CLOSE1:	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNE	T1,D%IN!D%OUT	;Was file ever opened?
	 JRST	%POPJ1		;YES. SKIP RETURN FOR REAL CLOSE
	TXNN	T1,D%OPEN	;Was explicit OPEN done?
	 POPJ	P,		;NO. NON-SKIP RETURN
	LOAD	T1,DVTYP(D)	;Not disk, but for DECtape have to do it too
	CAIE	T1,DT.DSK	;DISK?
	 CAIN	T1,DT.DTA	;DECTAPE?
	  JRST	CLSITY		;Yes, must do it.
	POPJ	P,		;NO. NON-SKIP RETURN FOR CLEANUP ONLY

CLSITY:	LOAD	T1,INDX(D)	;[5002] GET DEVICE TYPE
	PJRST	CLSYTB(T1)	;[5002] DO THINGS BY DEVICE

CLSYTB: JRST	CLYNRM		;[5002] TTY
	JRST	CLYNRM		;[5002] DISK
	JRST	CLYNRM		;[5002] MAGTAPE
	JRST	CLYNRM		;[5002] OTHER. CAN'T SWITCH TO INPUT
IF20,<	JRST	RMSITY		;[5002] REMOTE STREAM FILE
	JRST	RMSITY		;[5002] RMS FILE
> ;End IF20

CLYNRM:	PUSHJ	P,LOOKF		;[5002] LOOKUP THE FILE
	 JRST	DOPNY		;[4137] NOT THERE. GO OPEN IT
	PUSHJ	P,DOJFNS	;[4137] THERE. RETURN EXPANDED FILESPEC TO DDB
	PUSHJ	P,GTEOFN	;GET EOFN, BPW FOR DISPOSE=
	JRST	%POPJ1		;[4137] SKIP RETURN

DOPNY:	PUSHJ	P,OPENY		;[4137] NOT THERE. DO A FULL OPEN
	JRST	%POPJ1		;FILE IS NOW OPEN. SKIP RETURN TO CLOSE IT

IF20,<				;[5002]
RMSITY:	SKIPE	%ABFLG		;[5002] ARE WE ABORTING?
	 POPJ	P,		;[5002] YES, CLEANUP ONLY
	PUSHJ	P,%RMCSY	;[5002] LOOKUP THE FILE
	 JRST	DOPNY		;[5002] NOT THERE, GO OPEN IT
	PUSHJ	P,%RMRFS	;[5002] RETURN FILESPEC TO DDB
	JRST	%POPJ1		;[5002] SKIP RETURN
> ;End IF20
	
;GET A NEW DDB FOR A (POSSIBLE) RENAME FILESPEC, AND COPY
;THE FILE INFORMATION FROM THE OLD DDB.
GTRDDB:	MOVEI	T1,ULEN		;Allocate a blank unit
	PUSHJ	P,%GTBLK
	 $ACALL	MFU		;CAN'T
	MOVE	U,T1		;GET UDB ADDRESS
	MOVEM	U,%RNAMU
	MOVEI	T1,DLEN		; and DDB
	PUSHJ	P,%GTBLK
	 $ACALL	MFU		;CAN'T
	MOVE	D,T1		;GET DDB ADDRESS
	MOVEM	D,%RNAMD	;SAVE ADDRESS
	MOVEM	D,CLSDDB	;[4155] SETUP THIS DDB FOR STATUS AND DISPOSE
	MOVEM	D,DDBAD(U)	;SAVE IN UDB
	PUSHJ	P,COPFDD	;Copy file-spec info from old DDB
	SETZM	GEN(D)		;EXCEPT GENERATION NUMBER IS NOT DEFAULTED
	POPJ	P,

CLSTAB:	JRST	TTYCLS		;TTY
	JRST	DSKCLS		;DISK
	JRST	OTHCLS		;MTA
	JRST	OTHCLS		;OTHER LOCAL DEVICE
IF20,<	JRST	%RMCLS		;[5002] REMOTE STREAM FILE
	JRST	%RMCLS		;[5002] RMS FILE
> ;End IF20

DPTAB:	JRST	%POPJ1		;TTY - NO DISPOSITION
	JRST	DSKDSP		;DISK
	JRST	%POPJ1		;MTA - NO DISPOSITION
	JRST	OTHDSP		;OTHER
IF20,<	JRST	%RMDSP		;[5002] REMOTE STREAM FILE
	JRST	%RMDSP		;[5002] RMS FILE
> ;End IF20

TTYCLS:	LOAD	T1,CC(U)	;GET CARRIAGECONTROL
	CAIE	T1,CC.TRN	;TRANSLATED?
	 JRST	FICLOS		;NO. DONE
	MOVE	T1,FLAGS(D)	;GET FLAGS
	TXNN	T1,D%SEOL	;SUPPRESS CR/LF?
	 PUSHJ	P,%OCRLF	;NO. OUTPUT ENDING CRLF
	PJRST	FICLOS		;DONE

DSKCLS:	LOAD	T0,ACC(D)	;GET ACCESS
	CAIE	T0,AC.APP	;APPEND?
	 JRST	NOTAPP		;NO. GO FREE UP PAGES
	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNE	T1,D%OUT	;Was file open for output?
	 PUSHJ	P,%LSTBF	;YES. GO WRITE LAST BUFFER
	PJRST	FICLOS		;GO CLOSE FILE

NOTAPP:	PUSHJ	P,DSKFRE	;UNMAP FILE, FREE BUFFERS
	PJRST	FICLOS		;GO CLOSE FILE

OTHCLS:	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNE	T1,D%OUT	;Was file open for output?
	 PUSHJ	P,%LSTBF	;YES. GO WRITE LAST BUFFER
	PJRST	FICLOS		;GO CLOSE FILE

DSKDSP:	MOVE	T1,CLSDDB	;[4155] GET THE PROPER DDB FOR DISPOSE VALUE
	LOAD	T1,ODISP(T1)	;[4155] GET ORTHOGONAL DISPOSE VALUE
	JUMPN	T1,CLSQ		;IF NON-ZERO VALUE, MEANS QUEUED
	JRST	CLNOT		;OTHERWISE NO QUEUEING

OTHDSP:	LOAD	T1,DVTYP(D)	;GET DEVICE TYPE 
	CAIE	T1,DT.DTA	;DECTAPE?
	 JRST	%POPJ1		;NO. DONE
CLNOT:	MOVE	T1,CLSDDB	;[4155] GET THE PROPER DDB FOR STATUS VALUE
	LOAD	T1,OSTAT(T1)	;[4155] GET ORTHOGONAL CLOSE STATUS VALUE
	PUSHJ	P,CLNSTA(T1)	;CLOSE FILE
	 POPJ	P,		;FAILED. NON-SKIP RETURN
	JRST	%POPJ1		;SUCCESS. WE'RE DONE

CLNSTA:	JRST	%POPJ1		;UNKNOWN (DEFAULT IS SAVE)
	JRST	%POPJ1		;SAVE
	JRST	CLDEL		;DELETE
	JRST	CLEXP		;EXPUNGE

CHKREN:	SKIPE	T1,%RNAMD	;RENAME DDB?
	 SKIPN	FILPRS(T1)	;FILESPEC PARSED IN IT?
	  JRST	%POPJ1		;NO
	PUSHJ	P,CHKWLD	;[4137] CHECK WILCARD SPECS
	LOAD	T1,INDX(D)	;YES. GET DEVICE INDEX
	PUSHJ	P,RENTAB(T1)	;AND RENAME THE FILE NOW
	 POPJ	P,		;FAILED. GO GET NEW RENAME FILESPEC
	MOVE	T1,%RNAMD	;GET RENAME DDB AGAIN
	SETZM	FILPRS(T1)	;FILE IS RENAMED. NO TURNING BACK
	JRST	%POPJ1		;SKIP RETURN FOR SUCCESS

RENTAB:	JRST	%POPJ1		;CAN'T RENAME THE TTY
	JRST	DSKREN		;DISK
	JRST	%POPJ1		;CAN'T RENAME A MAGTAPE
	JRST	OTHREN		;OTHER - MIGHT BE A DECTAPE
IF20,<	JRST	%RMREN		;[5002] REMOTE STREAM FILE
	JRST	%RMREN		;[5002] RMS FILE
> ;End IF20
;[4137] new 
;++
; FUNCTIONAL DESCRIPTION:
;
;	This routine checks the rename filespec for wildcards.
;	If filename, extension, or directory are
;	specified exactly as '*', the corresponding part of the
;	old (previously OPENed) filespec is copied into the
;	rename DDB.
;
; CALLING SEQUENCE:
;
;	PUSHJ	P,CHKWLD
;
; INPUT PARAMETERS:
;
;	None
;
; IMPLICIT INPUTS:
;
;	 D	DDB of currently OPENed file
;	 %UDBAD	DDB of rename DDB
;
; OUTPUT PARAMETERS:
;
;	None
;
; IMPLICIT OUTPUTS:
;
;	DDB variables FILNAM, EXT, and DIRNAM in rename DDB.
;
; SIDE EFFECTS:
;
;	None
;
;--	
CHKWLD:	MOVE	T4,%RNAMD	;GET RENAME DDB ADDR
	HLLZ	T1,DIRNAM(T4)	;GET DIRECTORY
	TLZ	T1,17		;CLEAR ALL EXCEPT 2 FIRST CHARACTERS
	CAME	T1,[ASCIZ /*/]	;IS IT A FULL WILDCARD?
	 JRST	WLDFIL		;NO. GO CHECK FILENAME
	HRLI	T1,DIRNAM(D)	;YES. COPY OLD ONE
	HRRI	T1,DIRNAM(T4)
	BLT	T1,DIRNAM+LDIRW-1(T4)
WLDFIL:	HLLZ	T1,FILNAM(T4)	;GET 1ST WORD OF FILENAME
	TLZ	T1,17		;CLEAR ALL EXCEPT 2 FIRST CHARACTERS
	CAME	T1,[ASCIZ /*/]	;IS IT A FULL WILDCARD?
	 JRST	WLDEXT		;NO. GO CHECK EXTENSION
	HRLI	T1,FILNAM(D)	;YES. COPY OLD ONE
	HRRI	T1,FILNAM(T4)
	BLT	T1,FILNAM+LFILW-1(T4)
WLDEXT:	HLLZ	T1,EXT(T4)	;GET EXTENSION
	TLZ	T1,17		;CLEAR ALL EXCEPT 2 FIRST CHARACTERS
	CAME	T1,[ASCIZ /*/]	;IS IT A FULL WILDCARD?
	 POPJ	P,		;NO. DONE
	HRLI	T1,EXT(D)	;YES. COPY OLD ONE
	HRRI	T1,EXT(T4)
	BLT	T1,EXT+LEXTW-1(T4)
	POPJ	P,

;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
	CAME	D,D.TTY		;Is this the TTY DDB?
	 JRST	NOTETT		;NO
	SETZM	D.TTY		;Yes, no more.
	SETZM	U.TTY		;CLEAR UNIT BLOCK ADDR ALSO
NOTETT:	HRRZ	T1,IRBUF(D)	;GET INPUT REC ADDR-1
	JUMPE	T1,NOIRB	;NONE
	ADDI	T1,1		;CORRECT IT
	PUSHJ	P,%FREBLK	;DEALLOCATE BUFFER

NOIRB:	HRRZ	T1,ORBUF(D)	;GET OUTPUT REC ADDR-1
	JUMPE	T1,NOORB	;NONE
	ADDI	T1,1		;CORRECT IT
	PUSHJ	P,%FREBLK	;DEALLOCATE BUFFER

%CLSCL:
NOORB:	PUSHJ	P,%RMDAB	;[5000] Deallocate any RMS arg blocks
	SKIPE	T1,BUFADR(D)	;ANY BUFFER TO DEALLOCATE?
	 PUSHJ	P,%FREBLK	;YES. DO IT
	SETZM	BUFADR(D)	;Clear core pointer
	MOVEI	T1,(D)		;Throw away DDB
	PUSHJ	P,%FREBLK

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

CLSCL1:	HXRE	T2,UNUM(U)	;Get unit number
	SETZM	%DDBTAB(T2)	;Clear entry in DDBTAB
	MOVEI	T1,(U)		;Throw away unit block
	PUSHJ	P,%FREBLK
	SETZM	%UDBAD		;NO MORE DDB FOR THIS STATEMENT
	SKIPE	T1,%RNAMD
	 PUSHJ	P,%FREBLK	;Throw away blocks
	SKIPE	T1,%RNAMU
	 PUSHJ	P,%FREBLK
	SETZM	%RNAMD		;Clear ptrs
	SETZM	%RNAMU		; . .
	PJRST	%SETAV		;GO SET IOSTAT


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

COPFDD:	MOVE	P1,%OLUDB	;GET OLD UDB ADDR
	MOVE	P2,%OLDDB	;AND OLD DDB ADDR

	LOAD	T1,INDX(P2)	;Device index is copied
	STORE	T1,INDX(D)
	LOAD	T1,UNUM(P1)	;Unit number is copied
	STORE	T1,UNUM(U)
	HRLI	T1,FILSPC(P2)	;Copy a bunch of stuff
	HRRI	T1,FILSPC(D)
	BLT	T1,FILSPC+.FSSLN-1(D) ;. .

IF20,<	
	LOAD	T1,ORGAN(P2)	;[5002] Copy organization
	STORE	T1,ORGAN(D)	;[5002]
> ;End IF20

IF10,<
	HRRZ	T1,LKPB+.RBEXT(P2) ;High bits of creation date
	TXZ	T1,RB.ACD	;Clear out access date
	MOVEM	T1,LKPB+.RBEXT(D)
	MOVE	T1,LKPB+.RBPRV(P2) ;PROTECTION, MODE, 12-BIT CREATION DATE
	MOVEM	T1,LKPB+.RBPRV(D)
>;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 O.DIAL to get him to DIALOG mode.
;Inputs:
;	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,DSCALC	;CALCULATE DISPOSE/STATUS INDEX
	 POPJ	P,		;Error, return immediately
	LOAD	T1,OSTAT(D)	;GET ORTHOGONAL STATUS VALUE
	JUMPN	T1,NRSTAT	;IF ONE THERE, NONE IMPLIED
	MOVEI	T1,OS.SAV	;RENAME IMPILES STATUS=SAVE
	SKIPE	FILPRS(D)	;DID WE GET A RENAME?
	 STORE	T1,OSTAT(D)	;YES. SET ORTHOGONAL STATUS TO 'SAVE'

;[4155] NEW CODE - TRANSFER VALUES FROM OLD DDB TO NEW DDB
NRSTAT:	MOVE	T2,%OLDDB	;GET OLD DDB
	LOAD	T0,ODISP(T2)	;GET OLD ORTHOGONAL DISP
	LOAD	T1,ODISP(D)	;GET NEW ORTHOGONAL DISP
	CAIN	T1,0		;OVERLAY OLD OVER NEW IF NEW IS ZERO
	 STORE	T0,ODISP(D)	;SAVE IN NEW DDB
	LOAD	T0,OSTAT(T2)	;GET OLD ORTHOGONAL STATUS
	LOAD	T1,OSTAT(D)	;GET NEW ORTHOGONAL STATUS
	CAIN	T1,0		;OVERLAY OLD OVER NEW IF NEW IS ZERO
	 STORE 	T0,OSTAT(D)	;SAVE IN NEW DDB
	LOAD	T0,LIMIT(T2)	;GET OLD LIMIT VALUE
	LOAD	T1,LIMIT(D)	;GET NEW LIMIT VALUE
	CAIN	T1,0		;OVERLAY OLD OVER NEW IF NEW IS ZERO
	 STORE	T0,LIMIT(D)
	JRST	%POPJ1		;SKIP RETURN FOR SUCCESS

	SEGMENT	DATA

EFSFLG:	BLOCK	1	;FLAG FOR [Enter correct file specs]

%RNAMD:	BLOCK	1	;Address of DDB with rename filespec
%RNAMU:	BLOCK	1	;Address of UDB with rename filespec
%OLUDB:	BLOCK	1	;ADDRESS OF OLD UDB FOR CLOSE
%OLDDB:	BLOCK	1	;ADDRESS OF OLD DDB FOR CLOSE
CLSDDB:	BLOCK	1	;ADDRESS OF RENAME DDB, OR OLD DDB IF NONE

	SEGMENT	CODE

IF20,<

FICLOS:	MOVE	T1,IJFN(D)	;Get JFN
	GTSTS%
	JUMPGE	T2,RELJFN	;IF NOT OPEN, DON'T CLOSE IT

	MOVE	T1,IJFN(D)	;CLOSE FILE, TOSS JFN
	CLOSF%
	 $AJCAL	CLS		;SHOULD NOT FAIL
	SETZM	IJFN(D)		;SHOW WE TOSSED JFN
	SETZM	OJFN(D)
	MOVX	T1,D%IN+D%OUT+D%WRT+D%MOD ;[4155] TURN OFF THE I/O BITS
	ANDCAM	T1,FLAGS(D)
	POPJ	P,


; TOPS-20 /DISPOSE:DELETE and EXPUNGE

CLDEL:	PUSHJ	P,DLOOK		;LOOKUP FILE AGAIN
	 $DCALL	DEL		;CAN'T, SO WE CAN'T DELETE IT!
	MOVE	T1,IJFN(D)	;GET JFN
	DELF%			;DELETE FILE
	 ERJMP	RELDEL		;[4155] FAILED. GO RELEASE JFN, GIVE MSG
	JRST	%POPJ1		;OK. FILE DELETED

CLEXP:	PUSHJ	P,DLOOK		;LOOKUP FILE AGAIN
	 $DCALL	DEL		;CAN'T, SO WE CAN'T DELETE IT!
	MOVX	T1,DF%EXP	;SET TO EXPUNGE
	HRR	T1,IJFN(D)	;GET JFN
	DELF%			;DELETE FILE, MAYBE EXPUNGE
	 ERJMP	RELDEL		;[4155] FAILED. GO RELEASE JFN, GIVE MSG
	JRST	%POPJ1		;Ok, file deleted

RELDEL:	PUSHJ	P,RELJFN	;[4155] RELEASE JFN
	 $DCALL	DEL		;[4155] GIVE MSG AND LEAVE

;Routine to RENAME file after close.
;D/ U/ old DDB block.
;%RNAMD/ %RNAMU/ new DDB block.

OTHREN:	JRST	%POPJ1		;RENAME IS NOP FOR NON-DISK DEVICES

DSKREN:	PUSHJ	P,DLOOK		;LOOKUP FILE AGAIN
	 $DCALL	RNM		;CAN'T, SO WE CAN'T RENAME IT
	MOVE	D,%RNAMD	;SWITCH TO DATA SPECIFIED IN CLOSE STMT
	PUSHJ	P,SETJFN	;SET UP JFNBLK WITH FILENAME
	MOVE	D,%OLDDB
	MOVX	T1,GJ%FOU	;NEXT HIGHER GENERATION NUMBER ON
	HLLM	T1,JFNBLK+.GJGEN

	MOVEI	T1,JFNBLK	;GET JFN ON DESTINATION FILE
	SETZ	T2,		;NO STRING
	GTJFN%
	 ERJMP	RELRNM		;[4155] CAN'T. GO RELEASE JFN, GIVE ERROR

	MOVEI	T2,(T1)		;COPY DESTINATION JFN
	MOVE	T1,IJFN(D)	;GET SOURCE JFN
	RNAMF%			;RENAME THE FILE
	 ERJMP	RELRNB		;[4155] CAN'T. GO RELEASE BOTH JFNS, GIVE ERROR

	HRRZM	T2,IJFN(D)	;Store new JFN in old DDB
	HRRZM	T2,OJFN(D)	; The JFN is CLOSE'd.
	PUSHJ	P,DOJFNS	;RETURN FILESPEC TO DDB
	PUSHJ	P,RELJFN	;RELEASE THE JFN
	JRST	%POPJ1		;SKIP RETURN

;[4155] NEW CODE - RELEASE JFN(S), THEN ISSUE MESSAGE
RELRNB:	MOVEI	T1,(T2)		;GET NEW JFN BACK AGAIN
	RLJFN%			;RELEASE IT
	 JSHALT			;CAN'T. FOROTS BUG
RELRNM:	PUSHJ	P,RELJFN	;NOW RELEASE OLD FILE JFN
	$DCALL	RNM		;GIVE ERROR MSG, LEAVE

;TOPS-20 routine to prepare for disk close.
; It un-maps any mapped pages and throws away the core.

DSKFRE:	SKIPN	WPTR(D)		;ANYTHING TO DO HERE?
	 POPJ	P,		;NO
	SKIPE	WTAB(D)		;RANDOM FILE?
	 JRST	DSKUMP		;YES. GO UNMAP IT
	MOVE	T1,FLAGS(D)	;GET DDB FLAGS
	TXNE	T1,D%OUT	;LAST I/O OUTPUT?
	 PUSHJ	P,%OCLR		;YES. CLEAR UNUSED CHARS OF LAST WORD
DSKUMP:	MOVE	T2,WPTR(D)	;GET PAGE NUMBER OF 1ST PAGE
	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,WPTR(D)
	LOAD	T2,BUFCT(D)	;GET PAGE COUNT OF WINDOW
	PUSHJ	P,%FREPGS	;DEALLOCATE IT
	SETZM	WPTR(D)		;Note we threw it away
	SETZM	WADR(D)		;CLEAR LOCAL WINDOW ADDR

	SKIPE	T1,WTAB(D)	;FREE THE MAP TABLE, IF ANY
	 PUSHJ	P,%FREBLK
	SKIPE	T1,PFTAB(D)	;AND THE PAGE FLAG TABLE, IF ANY
	 PUSHJ	P,%FREBLK

	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNN	T1,D%MOD	;WAS FILE MODIFIED?
	  POPJ	P,		;NO, DONE

	LOAD 	T1,CC(U)	;GET CARRIAGECONTROL
	CAIE	T1,CC.FOR	;FORTRAN?
	 JRST	NOTFRT		;NO. DON'T SET ATTRIBUTE
	MOVE	T1,IJFN(D)	;GET FILE JFN
	HRLI	T1,.FBCTL+<(CF%NUD)> ;SET TO CHANGE FLAG WORD
	MOVEI	T2,FB%FOR	;GET THE FORTRAN BIT FOR MASK
	MOVEI	T3,FB%FOR	;GET THE FORTRAN BIT FOR VALUE
	CHFDB%			;CHANGE FDB
	 $EJCAL	CSF		;OH, WELL, MONITOR NOT UPDATED

NOTFRT:	MOVE	T1,IJFN(D)	;GET FILE JFN
	HRLI	T1,.FBBYV+<(CF%NUD)> ;SET TO CHANGE BYTE SIZE
	MOVX	T2,FB%BSZ	;SET FILE BYTE SIZE
	LOAD	T3,BSIZ(D)	;GET BYTE SIZE WE USED
	LSH	T3,^D24		;PUT IN POSITION
	CHFDB%			;CHANGE FDB
	 JSHALT

	MOVE	T1,IJFN(D)	;GET FILE JFN
	HRLI	T1,.FBBYV+<(CF%NUD)> ;SET TO CHANGE DATA MODE
	MOVX	T2,FB%MOD	;SET DATA MODE
	LOAD	T3,DMODE(D)	;GET DATA MODE
	MOVSI	T3,(T3)		;IN POSITION
	CHFDB%			;CHANGE FDB
	 JSHALT

	MOVE	T3,EOFN(D)	;GET FILE SIZE, BYTES
	LOAD	T1,BSIZ(D)	;GET BYTESIZE
	CAIE	T1,^D36		;36 BITS?
	 JRST	CLDFRM		;NO. USE EOFN AS IS
	ADD	T3,BPW(D)	;YES. ROUND UP
	SUBI	T3,1
	IDIV	T3,BPW(D)	;GET # WORDS
CLDFRM:	MOVE	T1,IJFN(D)	;GET FILE JFN
	HRLI	T1,.FBSIZ+<(CF%NUD)> ;SET FILE SIZE
	SETO	T2,		;WHOLE WORD
	CHFDB%			;CHANGE FDB

	MOVE	T1,BPW(D)	;GET BYTES PER WORD
	LSH	T1,^D9		;CONVERT TO BYTES PER PAGE
	MOVE	T2,EOFN(D)	;GET FILE SIZE IN BYTES AGAIN
	ADDI	T2,-1(T1)	;GET # PAGES IN FILE
	IDIVI	T2,(T1)		;IN T2
	SUBI	T2,1		;CALC TOP PAGE #

	MOVE	T1,IJFN(D)	;GET JFN
	HRLI	T1,(T1)		;IN LEFT HALF
	HRRI	T1,1(T2)	;START AT TOP PAGE+1
UNMPLP:	FFUFP%			;GET NEXT USED PAGE
	 POPJ	P,		;DONE. NO MORE USED PAGES
	PUSH	P,T1		;SAVE FOR NEXT CALL
	MOVE	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%
	 JSHALT			;SHOULD NOT FAIL
	POP	P,T1		;GET JFN,,PAGE BACK
	JRST	UNMPLP		;BACK FOR MORE

> ;IF20
IF10,<

;ROUTINE TO CLOSE THE FILE AND RELEASE THE CHANNEL
FICLOS:	SKIPN	T2,FBLK(D)	;IF FILE WAS NEVER OPENED 
	 POPJ	P,		;RETURN NOW 

FICLS0:	LOAD	T1,DVTYP(D)	;[4246]GET THE DEVICE TYPE
	CAIE	T1,DT.DSK	;[4246]IS IT A DISK
	 JRST	 FICLS2		;[4246]NO, JUST CLOSE DON'T RENAME
				;[4246]YES IT IS!
	MOVE	T1,FLAGS(D)	;[4251]IS IT OPENED FOR OUTPUT?
	TXNN	T1,D%OUT	;[4251]
	 JRST	 FICLS2		;[4251]NO, JUST CLOSE DON'T RENAME

FICLS1:	XMOVEI	T1,4		;[4251]Set arg block length
	MOVEM	T1,RNMBLK	;[4251]
	DMOVE	T1,LKPB+.RBPPN(D);[4251]Get the ppn and file name
	DMOVEM	T1,RNMBLK+.RBPPN ;[4251]Store it into the Rename block
	HLLZ	T2,LKPB+.RBEXT(D);[4251]Get the extention
	MOVEM	T2,RNMBLK+.RBEXT ;[4251]Store it into the Rename block

	SETZM	RNMBLK+.RBPRV	;[4251]Clear out old junk
	LDB	T2,[POINT 9,LKPB+.RBPRV(D),8] ;[4251]Get protection
	DPB	T2,[POINT 9,RNMBLK+.RBPRV,8];[42511]Store it
	LOAD	T2,MODE(D)	;[4244]Get data_mode in rename block
	MOVE	T2,MODTAB(T2)	;[4244]Lookup TOPS-10 equivalence
	DPB	T2,[POINT 4,RNMBLK+.RBPRV,12];[4244]Store it

	MOVEI	T1,FBLK(D)	;[4244]Get Address of FILOP. block
	MOVE	T2,.FOFNC(T1)	;[4244]Get function word	
	HRRI	T2,.FORNM	;[4244]Setup the function code
	TXO	T2,FO.UOC	;[4244]Specify file is open
	MOVEM	T2,.FOFNC(T1)	;[4244]and store it back again

	HRLZI	T2,RNMBLK	;[4251]get rename block address
	HLLM	T2,.FOLEB(T1)	;[4251]store into the lookup/enter block

	PUSH	P,.FOPAT(T1)	;[4260]Save for later.
	SETZM	.FOPAT(T1)	;[4260]Clear path-Don't return default.

	HRLI	T1,.FOMAX	;[4244]Set the argument count
	FILOP.	T1,		;[4244]and do the RENAME
	JRST	[MOVEI	T1,FBLK(D)	;[4251]Get Address of FILOP. block
		MOVE	T2,.FOLEB(T1)	;[4251]Get the lookup/enter block
		HRRZM	T2,.FOLEB(T1)	;[4251]Convert it back to lookup block
		POP	P,.FOPAT(T1)	;[4260]Restore path pointer
		JRST	FICLS2]		;[4251]and try to close it
	MOVE	T2,.FOLEB(T1)	;[4251]Get the lookup/enter block
	HRRZM	T2,.FOLEB(T1)	;[4251]Convert it back to lookup block
	POP	P,.FOPAT(T1)	;[4260]Restore path pointer
	JRST	FICLS3		;[4246]GO JOIN COMMON CODE

FICLS2:	MOVE	T2,FBLK(D)	;[4246]GET CHANNEL STUFF
	HRRI	T2,.FOCLS	;[4246]CLOSE THE FILE
	MOVE	T1,[1,,T2]	;[4246]WITH A FILOP
	FILOP.	T1,		;[4246]
	 $ACALL CLS		;[4246]FAILED. TYPE MSG AND DIE
;	JRST	FICLS3		;[4246]GO JOIN COMMON CODE

FICLS3:	MOVE	T2,FBLK(D)
	HRRI	T2,.FOREL	; AND RELEASE THE FILE
	MOVE	T1,[1,,T2]	;WITH A FILOP 
	FILOP.	T1, 
	 $ACALL CLS		;FAILED. TYPE MSG AND DIE
	SETZM	FBLK(D)		;[4155] CLEAR EVIDENCE OF FILE BEING OPENED
	MOVX	T1,D%IN+D%OUT+D%WRT+D%MOD ;[4155] TURN OFF THE I/O BITS
	ANDCAM	T1,FLAGS(D)	;[4155] 
	POPJ	P,

	SEGMENT DATA
RNMBLK:	BLOCK	5		;[4251]Rename block
	SEGMENT CODE

;"EXPUNGE" and "DELETE" are the same on TOPS-10
CLEXP:
CLDEL:				;[4211]
				;[4211]
	MOVE	T1,[FO.PRV+FO.ASC+.FODLT] ;[4211] DELETE THE FILE
	MOVEM	T1,FBLK(D)	;[4211]
	MOVEI	T1,FBLK(D)
	HRLI	T1,.FOMAX
	FILOP.	T1,
	 JRST	DFAIL		;[4211] FAILED. GO RELEASE CHANNEL

	MOVEI	T2,.FOREL	;Now release the channel
	HLL	T2,CHAN(D)
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 $ACALL	CLS		;FAILED. TYPE MSG AND DIE

	JRST	%POPJ1		;Ok, return

DFAIL:	PUSH	P,T1		;[4211] SAVE ERROR CODE
	PUSHJ	P,RELJFN	;[4211] RELEASE CHANNEL
	POP	P,T1		;[4211] RESTORE ERROR CODE
	$DCALL	DEL		;[4211] ISSUE ERROR MESSAGE AND RETURN

;TOPS-10 routine to RENAME after CLOSE.
;D/ U/ old DDB block.
;%RNAMD/ %RNAMU/ new DDB block

OTHREN:	LOAD	T1,DVTYP(D)	;GET DEVICE TYPE
	CAIE	T1,DT.DTA	;DECTAPE?
	 POPJ	P,		;NO. FOR OTHER DEVICES RENAME IS NOP
DSKREN:	MOVE	T1,%RNAMD	;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,.RBMAX	;SET LENGTH OF RENAME BLOCK
	MOVEM	T2,.RBCNT(T1)
	MOVE	D,%RNAMD	;[2112] POINT TO NEW DDB
	PUSHJ	P,SETPPB	;[2112] RESET THE PATH BLOCK
	MOVE	D,%OLDDB	;GET OLD DDB AGAIN
	MOVX	T1,FO.ASC+FO.PRV+.FORNM ;SET TO RENAME FILE
	MOVEM	T1,FBLK(D)
	MOVEI	T1,FBLK(D)	;DO THE RENAME
	HRLI	T1,.FOMAX
	FILOP.	T1,		;** Do RENAME, closes file **
	 JRST	RNFAIL		;[4155] FAILED
	MOVE	T1,%RNAMD	;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+.RBMAX-1(D) ;Find the file)!
	HRLI	T2,PTHB+.PTPPN(T1) ;Copy PATH. block From new DDB
	HRRI	T2,PTHB+.PTPPN(D) ;[4203] To old DDB
	BLT	T2,PTHB+.PTMAX-1(D) ; . .
	PUSHJ	P,SETPPB	;Reset path block
	HRRZS	FBLK+.FOLEB(D)	;CLEAR RENAME BLOCK POINTER
	PUSHJ	P,DOJFNS	;RETURN INFO TO DDB
	PUSHJ	P,RELJFN	;RELEASE CHANNEL
	JRST	%POPJ1		;SKIP RETURN

RNFAIL:	PUSH	P,T1		;[4174] SAVE THE ERROR CODE
	PUSHJ	P,RELJFN	;[4155] RELEASE CHANNEL
	POP	P,T1		;[4174] RESTORE ERROR CODE
	MOVE	T2,%RNAMD	;[4212] GET RENAME DDB ADDRESS
	MOVE	T3,LKPB+.RBEXT(D) ;[4212] RESTORE OLD DATE BITS
	HRRM	T3,LKPB+.RBEXT(T2) ;[4212] RENAME FAILURE BLEW THEM AWAY
	$DCALL	RNM		;[4155] AND GIVE ERROR MSG

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

DSKFRE:	SKIPN	WPTR(D)		;ANYTHING TO DO HERE?
	 POPJ	P,		;NO
	SKIPN	WTAB(D)		;RANDOM FILE?
	 JRST	SEQCLS		;NO. OUTPUT LAST BUFFER
	PUSHJ	P,%RANWR	;WRITE ALTERED PAGES
	MOVE	T1,WPTR(D)	;GET PAGE POINTER
	LOAD	T2,BUFCT(D)	;GET LENGTH IN PAGES
	PUSHJ	P,%FREPGS
	MOVE	T1,WTAB(D)	;POINT TO TABLE
	PUSHJ	P,%FREBLK	;FREE IT
	SKIPN	T1,PFTAB(D)	;FREE PAGE FLAG TABLE
	 PUSHJ	P,%FREBLK
	SETZM	WPTR(D)		;Note we threw it away
	SETZM	WADR(D)		;CLEAR BOOT PNTR
	POPJ	P,

SEQCLS:	MOVE	T1,FLAGS(D)	;GET DDB FLAGS
	TXNN	T1,D%OUT	;LAST I/O OUTPUT?
	 JRST	SEQFRE		;NO. GO FREE UP MEMORY
	PUSHJ	P,%OCLR		;YES. CLEAR UNUSED CHARS IN LAST WORD
	PUSHJ	P,%OSDSK	;OUTPUT LAST BUFFER
SEQFRE:	MOVE	T1,WPTR(D)	;GET PAGE ADDRESS
	LOAD	T2,BUFCT(D)	;GET COUNT
	PUSHJ	P,%FREPGS	;FREE THE PAGES
	SETZM	WPTR(D)		;CLEAR THE MARKERS
	SETZM	WADR(D)
	SETZM	BUFADR(D)
	POPJ	P,

> ;END IF10

	SUBTTL	QUASAR INTERFACE

;ROUTINE TO SEND A QUEUE REQUEST OFF TO QUASAR
;ARGS:	 JFN, QUEUE NUMBER
;RETURN: PACKET SENT


IF10,<
CLSQ:
;See if GALAXY V4 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
	MOVE	T1,CLSDDB	;[4155] GET PROPER DDB FOR DISPOSE
	LOAD	T1,ODISP(T1)	;[4155] GET ORTHOGONAL DISPOSE VALUE
	PUSH	P2,QFNC(T1)	;[4155] PUSH FUNCTION CODE
	MOVSI	T1,(QF.RSP)	;REQUEST RESPONSE
	IORM	T1,(P2)
	PUSH	P2,[-1]		;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,LKPB+.RBNAM(D) ;FILE NAME
	PUSH	T1,LKPB+.RBEXT(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

	MOVE	T1,EXT(D)	;[2062] GET EXTENSION
	CAME	T1,[ASCIZ /DAT/] ;[2062] IS IT ".DAT"
	  JRST	Q1NDAT		;[2062] NO
	PUSH	P2,[QA.IMM+.QBPTP] ;[2062] ARG IS FILE FORMAT
	PUSH	P2,[.QBPFR]	;[2062] SET /FILE:FORTRAN

Q1NDAT:	MOVE	T2,CLSDDB	;[4155] GET PROPER DDB FOR DISPOSE AND LIMIT
	LOAD	T1,LIMIT(T2)	;[4155] GET LIMIT VALUE FROM OPEN
	 JUMPN	T1,QLIM		;GO SET IT
	LOAD	T1,ODISP(T2)	;[4155] GET ORTHOGONAL DISPOSE VALUE
	CAIE	T1,OD.PRI	;PRINT?
	 JRST	NOCLIM		;NO. DON'T GIVE LIMIT VALUE
	MOVE	T1,EOFN(D)	;[3453] GET # BYTES IN FILE
	JUMPE	T1,NOCLIM	;[3453] IF NO SIZE, CAN'T SET LIMIT
	IDIV	T1,BPW(D)	;[3453] GET APPROX # WORDS
	ADDI	T1,177		;ROUND UP TO BLOCKS
	LSH	T1,-7		;CALC # BLOCKS
	ADDI	T1,10		;USE # BLOCKS + 8
QLIM:	PUSH	P2,[QA.IMM+.QBLIM] ;SET LIMIT
	PUSH	P2,T1

NOCLIM:	MOVE	T1,CLSDDB	;[4155] GET PROPER DDB FOR STATUS VALUE
	LOAD	T1,OSTAT(T1)	;[4155] GET ORTHOGONAL STATUS VALUE
	CAIE	T1,OS.DEL	;DELETE OR EXPUNGE?
	 CAIN	T1,OS.EXP
	  JRST	QDEL		;YES. SET QUEUE ENTRY FOR DELETE
	JRST	Q1NLST		;NO

QDEL:	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
	 $ECALL CQF,%POPJ1	;CAN'T. GIVE ERROR AND LEAVE

	XMOVEI	T1,%RESP	;GET ADDR OF RESPONSE MESSAGE
	MOVEI	T2,"["		;INFO ONLY
	MOVE	T3,%RESP	;GET FIRST WORD OF RESPONSE
	TLNE	T3,774000	;SEE IF ANY TEXT IS PRESENT
	 $ECALL	QUE
	JRST	%POPJ1		;Done

OLDGLX:	$ECALL	OGX		;GALAXY V2 NOT SUPPORTED
	POPJ	P,


QFNC:	0			;NOTHING
	EXP	.QUPRT		;PRINT
	EXP	.QUPTP		;PUNCH
	EXP	.QUBAT		;SUBMIT
	EXP	.QUPLT		;PLOT

> ;END IF10
;MAKE PACKET

IF20,<				;GALAXY RELEASE 4 PACKET FORMAT
CLSQ:	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

;The format of a Release 4 packet is the standard GALAXY header
;(3 words), a flag word, a count word, and then argument-type/argument-data
;pairs.

	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
	MOVE	T1,CLSDDB	;[4155] GET PROPER DDB FOR DISPOSE
	LOAD	T1,ODISP(T1)	;[4155] GET ORTHOGONAL DISPOSE VALUE
	PUSH	P2,QOT(T1)	;QUEUE TYPE DEPENDS ON DISPOSITION

	MOVE	T1,EXT(D)	;GET EXTENSION
	CAME	T1,[ASCIZ /DAT/] ;[2062] IS TYPE "DAT"
	  JRST	QNDAT		;[2062] NO
	AOS	.OARGC(P1)	;[2062] COUNT ARG
	PUSH	P2,[2,,.QCPTP]	;[2062] ARG IS FILE FORMAT
	PUSH	P2,[.FPFFO]	;[2062] SET /FILE:FORTRAN
QNDAT:				;[2062]

	AOS	.OARGC(P1)	;COUNT ARG
	PUSH	P2,[.QCFIL]	;ARG IS FILE DESCRIPTOR (FD)
	MOVEI	T1,.FDFIL(P2)	;POINT TO FILE SPEC DESTINATION
	HRLI	T1,(POINT 7)
	MOVEM	T1,FNSPNT
	PUSHJ	P,GENFNS	;GET A FILE STRING
	SETZ	T2,		;FOLLOW WITH A NULL
	IDPB	T2,FNSPNT

	MOVE	T1,FNSPNT	;GET POINTER TO THE NULL
	SUBI	T1,-1(P2)	;GET LENGTH OF FD
	HRLM	T1,.FDLEN(P2)	;STORE IN LENGTH WORD
	ADDI	P2,-1(T1)	;BUMP POINTER PAST FD

	MOVE	T1,CLSDDB	;[4155] GET PROPER DDB FOR DISPOSE
	LOAD	T1,OSTAT(T1)	;[4155] GET ORTHOGONAL STATUS VALUE
	CAIE	T1,OS.DEL	;DELETE OR EXPUNGE?
	 CAIN	T1,OS.EXP
	  JRST	SETQD		;YES. SET QUEUE ENTRY FOR DELETE
	JRST	QNLST		;NO

SETQD:	AOS	.OARGC(P1)	;COUNT ARG
	PUSH	P2,[2,,.QCODP]	;ARG IS DISPOSITION
	PUSH	P2,[1]		;DISP IS DELETE

QNLST:	MOVE	T2,CLSDDB	;[4155] GET PROPER DDB FOR LIMIT VALUE
	LOAD	T1,LIMIT(T2)	;[4155] GET LIMIT FROM OPEN STATEMENT
	 JUMPN	T1,SETLIM	;AND GO SET IT

	LOAD	T1,ODISP(T2)	;[4155] GET ORTHOGONAL DISPOSE VALUE
	CAIE	T1,OD.PRI	;PRINT?
	 JRST	NOCLIM		;NO. DON'T CALCULATE LIMIT

	MOVE	T1,EOFN(D)	;GET FILE SIZE IN BYTES
	JUMPE	T1,NOCLIM	;CAN'T SET LIMIT IF WE DON'T KNOW SIZE
	IDIV	T1,BPW(D)	;GET APPROX # WORDS
	ADDI	T1,777		;ROUND UP TO PAGES
	LSH	T1,-9		;CALC # PAGES
	IMULI	T1,G.LPTM	;DO QUEUE MAGIC TO GET LIMIT
	IDIVI	T1,G.LPTD
SETLIM:	AOS	.OARGC(P1)	;COUNT ARG
	PUSH	P2,[2,,.QCLIM]	;SET OUTPUT LIMIT
	PUSH	P2,T1

NOCLIM:	SUBI	P2,-1(P1)	;GET LENGTH OF MESSAGE
	HRLM	P2,(P1)		;STORE IN HEADER

	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


QOT:	0			;NOTHING
	EXP	.OTLPT		;PRINT
	EXP	.OTPTP		;PUNCH
	EXP	.OTBAT		;SUBMIT
	EXP	.OTPLT		;PLOT


;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
	 $ECALL	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(P1) ;GET ADDR OF ACTUAL MESSAGE
	MOVEI	T2,"["		;ASSUME INFO MESSAGE
	TXNE	P2,MF.FAT+MF.WRN ;ERROR?
	 MOVEI	T2,"%"		;YES, CHANGE PREFIX CHAR
	$ECALL	QUE		;OUTPUT MESSAGE

NOMSG:	TXNE	P2,MF.MOR	;MORE COMING?
	  JRST	RCVAGN		;YES, GO GET IT
	POPJ	P,		;NO, RETURN
> ;IF20

	SEGMENT	DATA

LRESP==20			;LENGTH OF RESPONSE BLOCK
%RESP::	BLOCK	LRESP		;RESPONSE BLOCK
QSRPID:	BLOCK	1		;QUASAR PID
IPCBLK:	BLOCK	4		;CONTROL BLOCK FOR IPCF FUNCTIONS

UNIPNT:	BLOCK	1		;UNIT POINTER/COUNT
EXITP:	BLOCK	1		;SAVED EXIT STACK POINTER


QBLK:	BLOCK	17		;QUEUE. BLOCK, LENGTH 3 + 2 MAX-POSSIBLE-ARGS
FD:	BLOCK	10		;FILE DESCRIPTOR


	SEGMENT	CODE
;ROUTINE TO CLOSE ALL FILES

	FENTRY	(EXIT1)
	SETZM	%UDBAD		;NO I/O IN PROGRESS
	PUSHJ	P,%SAVAC	;SAVE USER'S ACS
%EXIT1:	SETZ	F,		;CLEAR FLAG AC
	XMOVEI	T1,[ASCIZ /CLOSE/] ;FOR ERROR MESSAGES, WE'RE A CLOSE STMT
	MOVEM	T1,%IONAM
	SETZM	A.ERR		;[5004] NO ERR= ON EXIT

	MOVE	T1,[MINUNIT-MAXUNIT-1,,MINUNIT]	;LOOP THROUGH ALL UNITS
EX1L:	MOVEM	T1,UNIPNT	;SAVE IT
	MOVE	U,%DDBTAB(T1)	;GET A Unit block ADDRESS
	JUMPE	U,EX1E		;NONE, SKIP
	MOVE	D,DDBAD(U)	;Get DDB address
	HXRE	T1,UNUM(U)	;GET UNIT NUMBER
	MOVEM	T1,%CUNIT	;SAVE FOR ERROR MSGS
	MOVEM	P,EXITP		;SAVE STACK POINTER
	PUSHJ	P,%CLOSX	;Close the DDB
%EX1N:	MOVE	P,EXITP		;GET STACK POINTER AGAIN
EX1E:	MOVE	T1,UNIPNT	;GET UNIT POINTER/COUNT AGAIN
	AOBJN	T1,EX1L		;DO THEM ALL

IF20,<
	SKIPE	D.BSTP		;[3360] Skip if no DBMS loaded with FORLIB.
	 PUSHJ	P,@D.BSTP	;[3360] If DBMS around, leave databases in
> ;END IF20

	POPJ	P,		;DONE

	SUBTTL	INQUIRE BY UNIT

COMMENT	\

INQUIRE by unit is  extremely  straightforward  -  the  code
merely  looks at %DDBTA indexed by the unit provided to find
out if a DDB exists.  If it doesn't, there is no connection.
If  it  does,  the  code  must  determine  whether  an  OPEN
statement has been performed (D%OPEN set in the  flag  word)
or  any  I/O has been done (D%IN or D%OUT set in flag word).
If not, there is no connection yet (a REWIND or  other  MTOP
has  been  performed, but no file connection has been made).
If so, the file attributes are all lying around in  the  DDB
and  they  are merely returned in all the proper places (the
                                                      Page 2


V7 OPEN code establishes ALL attributes at the time  of  the
OPEN  statement  necessary  for INQUIRE).  If the INQUIRE is
issued between the time when an OPEN  with  STATUS='UNKNOWN'
is  executed and the first data transfer statement, the data
returned will merely be all the data that  we  have  so  far
about   the   file   (no   generation  number  if  wild-card
specified).  If the STATUS is explicit or I/O has been done,
then  the information returned will be more complete.  Since
the file is open, INQUIRE will  return  the  full,  expanded
filespec.   The  only  ambiguity  in  INQUIRE by unit is the
return value of EXISTS.  The Standard says to  return  'YES'
if the unit (!) exists.  In our implementation, units ALWAYS
exist,  and  we  will  return  'YES'.   (Unit  existence  is
different than file existence).
\
	FENTRY	(INQU)
	PUSHJ	P,%SAVAC	;SAVE USER'S ACS, COPY ARG LIST
	PUSHJ	P,%CPARG
	XMOVEI	T1,[ASCIZ /INQUIRE/] ;SETUP FOR ERROR MSGS
	MOVEM	T1,%IONAM
	PUSHJ	P,CLCVAR	;CLEAR COMMON OPEN/CLOSE VARIABLES
	PUSHJ	P,OICCPY	;COPY ARGS TO KEYWORD BLOCK
	PUSHJ	P,UNRNGE	;CHECK UNIT IN RANGE
	SETZM	INQPNT		;CLEAR RETURN FILENAME PNTR
	HLRE	T1,-1(L)	;GET ARG COUNT
	MOVEM	T1,ARGCNT	;SAVE IT
	SETOM	XSTFLG		;UNITS ALWAYS EXIST!
	MOVE	T1,%CUNIT	;GET UNIT NUMBER
	SKIPN	U,%DDBTA(T1)	;GET UDB ADDR
	 JRST	INQCRE		;NONE. GO PROCESS OTHER ARGS
	MOVE	D,DDBAD(U)	;GOT ONE. GET DDB ADDR
	MOVE	T1,[POINT 7,%TXTBF] ;POINT TO A BUFFER
	MOVEM	T1,INQPNT	;SET UP INQUIRE POINTER
	PUSHJ	P,%GTFNS	;GET FILE STRING
	PUSHJ	P,INQARG	;CHECK AND STORE ARGUMENTS
	PJRST	%SETAV		;GO SET IOSTAT, ETC.

INQCRE:	MOVEI	T1,ULEN		;CREATE UDB
	PUSHJ	P,%GTBLK
	 $ACALL	MFU		;CAN'T
	MOVEM	T1,INQUDB	;SAVE UDB ADDR FOR DEALLOCATION
	MOVE	U,T1		;GET ITS ADDR
	MOVEI	T1,DLEN		;CREATE DDB
	PUSHJ	P,%GTBLK
	 $ACALL	MFU		;CAN'T
	MOVE	D,T1		;GET ITS ADDR
	MOVEM	D,DDBAD(U)	;SAVE DDB ADDR IN UDB
	MOVE	T1,%CUNIT	;GET UNIT NUMBER
	STORE	T1,UNUM(U)	;SAVE IN UDB

	PUSHJ	P,DFFILE	;GET FILENAME
	PUSHJ	P,DFDEV		;GET DEFAULT DEVICE
	PUSHJ	P,DFDEV1	;GET DEVICE INFO
	 JRST	%ABORT		;BAD DEVICE
	MOVE	T1,[POINT 7,%TXTBF] ;POINT TO A BUFFER
	MOVEM	T1,INQPNT	;SET UP INQUIRE POINTER
	PUSHJ	P,%GTFNS	;GET FILE STRING

	PUSHJ	P,INQARG	;PROCESS INQUIRE ARGS
	PJRST	INQXIT		;TOSS UDB, DDB

	SUBTTL	INQUIRE BY FILE

COMMENT	\

INQUIRE by file is quite a bit more complex:

1.  The functionality of FORTRAN OPEN  is  changed  so  that
disk  files  OPEN for write are established (via UFPGS%
so that the file system can see them.

2.  If no device is given in the FILE= , use  a  default  of
DSK:.  Do NOT default anything else!

3.  Determine if the device specified is a disk.  If it is:

     a.  Find  out  if  a  file  exists  given  the  INQUIRE
     filespec.

     b.  Look at all  the  open  FORTRAN  logical  units  in
     ascending  order,  starting  with  zero.   If  an  OPEN
     statement has been executed  and  STATUS='UNKNOWN'  (so
     file   is   not   yet  actually  opened),  compare  the
     parse-only file string associated with  that  DDB  with
     the  parse-only file string associated with the INQUIRE
     statement.  If a file exists on disk which matches  the
     (expanded)  INQUIRE  filespec,  and the file associated
     with the DDB has actually been opened, compare the full
     file  string  associated  with  the  file with the full
     (expanded) file  string  associated  with  the  INQUIRE
     statement.   If  either  of  these  two comparisons are
     successful, return using the current unit number.

4.  If the INQUIRE is for  a  non-disk  device  and  is  not
device  TTY:,  do  the  same  as  step  3b (above), but only
compare the device names.

5.  If the INQUIRE is for device TTY:, only check to see  if
the device in the DDB is the user's TTY:.
\

	FENTRY	(INQF)
	PUSHJ	P,%SAVAC	;SAVE USER'S ACS, COPY ARG LIST
	PUSHJ	P,%CPARG
	XMOVEI	T1,[ASCIZ /INQUIRE/] ;SETUP FOR ERROR MSGS
	MOVEM	T1,%IONAM
	PUSHJ	P,CLCVAR	;CLEAR COMMON OPEN/CLOSE VARIABLES
	PUSHJ	P,OICCPY	;COPY ARGS TO KEYWORD BLOCK
	HRREI	T1,INQUNT	;MAKE IT SO NO UNIT NUMBER COMES OUT
	MOVEM	T1,%CUNIT
	SETZM	INQPNT		;CLEAR RETURN FILENAME POINTER
	SETZM	XSTFLG		;FILE DOESN'T EXIST YET
	SETZM	UNKXST		;[5001] CLEAR "EXIST=AMBIGUOUS" FLAG
	HLRE	T1,-1(L)	;GET ARG COUNT
	MOVEM	T1,ARGCNT	;SAVE IT
	PUSHJ	P,INQFIL	;EAT FILESPEC, SEARCH DDBS
	PUSHJ	P,INQARG	;PROCESS INQUIRE ARGS
INQXIT:	MOVE	T1,INQUDB	;GET UDB USED FOR INQUIRE
	MOVE	T1,DDBAD(T1)	;GET DDB
	PUSHJ	P,%FREBL	;FREE DDB
	MOVE	T1,INQUDB	;GET UDB ADDR
	PUSHJ	P,%FREBL	;FREE IT
	PJRST	%SETAV		;GO SET IOSTAT, ETC.

INQFIL:	MOVEI	T1,ULEN		;SETUP A UDB
	PUSHJ	P,%GTBLK
	 $ACALL	MFU		;CAN'T
	MOVE	U,T1		;PUT IT IN U
	MOVEI	T1,DLEN		;SETUP A DDB
	PUSHJ	P,%GTBLK
	 $ACALL	MFU		;CAN'T
	MOVE	D,T1		;PUT ADDR IN D
	MOVEM	D,DDBAD(U)	;AND IN U
	MOVEM	U,INQUDB	;SAVE INQUIRE UDB ADDRESS
	MOVEM	U,%UDBAD	;SAVE FOR MSGS
	MOVE	T1,DSKDEF	;SET DEFAULT DEVICE TO "DSK"
	MOVEM	T1,DEV(D)
	MOVE	T1,DATEXT	;SET DEFAULT EXTENSION TO "DAT"
	MOVEM	T1,EXT(D)
	SKIPE	O.DFLT		;[5001] DEFAULTFILE= seen?
	 PUSHJ	P,DFINQ		;[5001] Yes, process it first
	PUSHJ	P,FILINQ	;PARSE THE FILESPEC

INQFLP:	PUSHJ	P,INQDLG	;CHECK FOR ERRORS, USE DIALOG
	PUSHJ	P,DFDEV1	;GET DEVICE INDEX
	 JRST	INQFLP		;NO GOOD DEVICE

	MOVE	T1,[POINT 7,%TXTBF] ;POINT TO BUFFER FOR STRING
	PUSHJ	P,%GTFNS	;GET FULL FILESPEC STRING

;NOW TAKE THE RESULTANT PARSE-ONLY FILESPEC AND DO A LOOKUP
;TO SEE IF THE FILE EXISTS ON THE DISK.

	PUSHJ	P,LOOKF		;LOOKUP FILE
	 JRST	INQNO		;FILE NOT FOUND

	SETOM	XSTFLG		;YES. FLAG FILE EXISTENT
	MOVE	T1,[POINT 7,TXTBF1] ;POINT TO EXPANDED INQUIRE FILESPEC BUFFER
	PUSHJ	P,%GTFNS	;GET FULL EXPANDED FILESPEC
	PUSHJ	P,RELJFN	;RELEASE THE JFN. WE HAVE A FULL STRING

;NOW WE HAVE THE INQUIRE FILE= STRING IN %TXTBF AND THE
;FULL, EXPANDED FILESPEC (IF LOOKUP WAS SUCCESSFUL)
;IN TXTBF1.. IT'S TIME TO
;SCAN ALL THE DDBs FOR AN IDENTICAL STRING. FOR EACH DDB,
;FOR THOSE FILES WHICH ARE
;NOT YET OPEN, BUT WHICH HAVE D%OPEN SET (AN OPEN STATEMENT
;HAS BEEN DONE), CALL %GTFNS TO SET UP THE JFN BLOCK, DO
;AN UNEXPANDED FILE PARSE, AND PUT THE FILESPEC
;INTO TXTBF2 AND RELEASE THE JFN. COMPARE THE STRINGS IN
;%TXTBF AND TXTBF2. FOR THOSE FILES WHICH
;ARE ACTUALLY OPEN, CALL %GTFNS TO GET AN EXPANDED FILESTRING.
;DO A CMPSTR BETWEEN TXTBF1
;AND TXTBF2. RECORD THE LOWEST UNIT NUMBER FOR MATCH (POSITIVE
;UNITS ONLY!), IF ANY.

INQNO:	MOVSI	T1,-MAXUNIT	;[4134] GET NEGATIVE COUNT OF UNITS
INQL1:	MOVEM	T1,UNIPNT	;[4134] SAVE IT
	SKIPN	U,%DDBTA(T1)	;ANY FILE?
	 JRST	INQE1		;NO
	MOVE	D,DDBAD(U)	;GET DDB ADDR

	MOVE	T1,[POINT 7,TXTBF2] ;POINT TO DDB FILE BUFFER
	PUSHJ	P,%GTFNS	;GET FULL FILE STRING

	MOVE	T1,[POINT 7,TXTBF1] ;POINT TO EXPANDED INQUIRE FILESPEC
	SKIPN	XSTFLG		;DOES THE FILE EXIST ON DISK?
	 MOVE	T1,[POINT 7,%TXTBF] ;NO. POINT TO PARSE-ONLY INQUIRE FILESPEC

INQCMP:	MOVEI	T3,LTEXTC	;GET LENGTH OF TEXT BLOCKS
	MOVEI	T0,(T3)
	MOVE	T4,[POINT 7,TXTBF2]
	EXTEND	T0,[EXP <CMPSE>,0,0] ;COMPARE THE FILESPECS
	 JRST	INQE1		;THEY DON'T MATCH
	SKIPN	UNKXST		;[5001] EXISTENCE UNAMBIGUOUS?
	 SETOM	XSTFLG		;[5001] NO. FLAG FILE EXISTENT
	MOVE	T1,[POINT 7,TXTBF2] ;POINT TO DDB FILESPEC
	MOVEM	T1,INQPNT	;FOR RETURNING FILESPEC
	POPJ	P,		;WE'RE DONE!

INQE1:	MOVE	T1,UNIPNT	;[4134] GET RELATIVE UNIT TABLE POINTER AGAIN
	AOBJN	T1,INQL1	;[4134] LOOP

	MOVE	U,INQUDB	;NO MATCH. POINT TO INQUIRE DDB
	MOVE	D,DDBAD(U)
	MOVE	T1,[POINT 7,TXTBF1] ;POINT TO EXPANDED FILESPEC, IF ANY
	SKIPN	XSTFLG		;DOES FILE EXIST?
	 MOVE	T1,[POINT 7,%TXTBF] ;NO. POINT TO UNEXPANDED SPEC
	MOVEM	T1,INQPNT
	POPJ	P,

%ERFNS:	PUSHJ	P,FNSCLR	;SETUP POINTER, CLEAR BUFFER
	SKIPE	DVICE(D)	;[4134] IF DEVICE NOT FOUND YET
	 SKIPN	IJFN(D)		;OR IF NO JFN YET
	  JRST	FNOJFN		;USE INFO IN DDB
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PJRST	ERFTAB(T1)	;GET APPROPRIATE STRING

ERFTAB:	JRST	GETTY		;TTY - NAME ONLY
	JRST	ERGEN		;DSK - INCLUDE FILENAME
	JRST	GTNAM		;MTA - DEVICE ONLY
	JRST	GTNAM		;OTHER - DEVICE ONLY
IF20,<	JRST	%RMEFN		;[5002] REMOTE STREAM FILE
	JRST	%RMEFN		;[5002] RMS FILE
> ;End IF20

%GTFNS:	PUSHJ	P,FNSCLR	;SETUP POINTER, CLEAR BUFFER
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PJRST	GFTAB(T1)	;GET APPROPRIATE STRING

GFTAB:	JRST	GETTY		;TTY - NAME ONLY
	JRST	GENFNS		;DSK - INCLUDE FILENAME
	JRST	GTNAM		;MTA - DEVICE ONLY
	JRST	GTNAM		;OTHER - DEVICE ONLY
IF20,<	JRST	%RMGXF		;[5000] REMOTE STREAM FILE
	JRST	%RMGXF		;[5000] RMS FILE
> ;End IF20

FNSCLR:	MOVEM	T1,FNSPNT	;SAVE POINTER
	MOVEI	T1,(T1)		;GET LOCAL ADDR
	SETZM	(T1)		;CLEAR BUFFER
	HRLZI	T2,(T1)		;GET BEG ADDR
	HRRI	T2,1(T1)	;GET BEG ADDR+1
	BLT	T2,LTEXTW-1(T1)
	POPJ	P,

LOOKF:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PJRST	LOOKTB(T1)	;GO DO FILE LOOKUP BY DEVICE TYPE

LOOKTB:	JRST	TTLOOK		;TTY
	JRST	DLOOK		;DSK
	JRST	NDLOOK		;MTA
	JRST	NDLOOK		;OTHER
IF20,<	JRST	%RMLKP		;[5000] REMOTE STREAM FILE
	JRST	%RMLKP		;[5000] RMS FILE
> ;End IF20

TTLOOK:	MOVE	T1,DVICE(D)	;GET ACTUAL DEVICE
	CAME	T1,[.CTTRM]	;CONTROLLING TERMINAL?
	 JRST	NDLOOK		;NO
	AOS	(P)		;YES. JUST RETURN SUCCESS, DON'T OPEN IT
	POPJ	P,

GETTY:	MOVE	T1,DVICE(D)	;GET ACTUAL DEVICE
	CAME	T1,[.CTTRM]	;CONTROLLING TERMINAL?
	 JRST	GTNAM		;NO. GO GET A DEVICE NAME
	MOVE	T1,[POINT 7,[ASCIZ /TTY:/]] ;MAKE IT "TTY"
	MOVEI	T2,5		;IT HAS 4 CHARS IN IT PLUS A NULL
GTTYLP:	ILDB	T3,T1		;GET A CHAR
	IDPB	T3,FNSPNT	;DEPOSIT IN BUFFER
	SOJG	T2,GTTYLP	;DO IT 4 TIMES
	POPJ	P,

INQDIR:	SKIPN	INQPNT		;ANY NAME RETURNED?
	 JRST	RETUNK		;NO. RETURN "UNKNOWN"
	LOAD	T2,INDX(D)	;GET DEVICE INDEX
	CAIE	T2,DI.RMS	;[5001] IF RMS,
	CAIN	T2,DI.RSF	;[5001] OR RSF,
	 MOVEI	T2,DI.DSK	;[5001] TREAT LIKE DISK
	DMOVE	T0,[EXP 2,<POINT 7,[ASCII /NO/]>] ;MAKE IT 'NO'
	CAIN	T2,DI.DSK	;DISK FILE?
RETYES:	 DMOVE	T0,[EXP 3,<POINT 7,[ASCII /YES/]>] ;MAKE IT 'YES'
	JRST	RETSTR		;GO RETURN STRING

RETNUL:	SETZB	T0,T1		;NO SOURCE PNTR
	JRST	RETSTR		;FILL WITH SPACES

RETVS:	HRLI	T1,(POINT 7)	;MAKE T1 AN ASCII POINTER
	MOVE	T2,T1		;COPY IT
	SETZ	T0,		;CLEAR THE COUNT
RVSLP:	ILDB	T3,T2		;GET A CHAR
	CAIE	T3,0		;IF NON-ZERO
	 AOJA	T0,RVSLP	;INCREMENT THE COUNT
	JUMPN	T0,RETSTR	;IF NO CHARS, RETURN UNKNOWN

RETUNK:	DMOVE	T0,[EXP 7,<POINT 7,[ASCIZ /UNKNOWN/]>] ;RETURN 'UNKNOWN'
RETSTR:	DMOVE	T3,@(L)		;GET PNTR/COUNT
	EXCH	T3,T4		;MAKE IT COUNT/PNTR
	EXTEND	T0,[EXP <MOVSLJ>," "] ;TRANSFER THE ANSWER
	 NOP
	POPJ	P,

;INQSEQ, INQUNF,  AND INQFMT - RETURN 'YES',
;SINCE WE CAN ALWAYS ACCESS ALL FILES SEQUENTIALLY, AND
;EITHER UNFORMATTED OR FORMATTED

INQUNF:
INQSEQ:
INQFMT:	DMOVE	T3,@(L)		;YES. GET POINTER/COUNT
	EXCH	T3,T4		;MAKE IT COUNT/POINTER
	JRST	RETYES		;RETURN "YES"

;INQACC - RETURN EITHER 'SEQUENTIAL', 'DIRECT' OR 'KEYED' IF THERE IS
;A CONNECTION; DON'T TOUCH THE VARIABLE IF NO CONNECTION
INQACC:	PUSHJ	P,CHKOPN	;CHECK IF CONNECTION
	 JRST	RETUNK		;RETURN "UNKNOWN"
	DMOVE	T0,[EXP ^D10,<POINT 7,[ASCII /SEQUENTIAL/]>]
	SKIPE	WTAB(D)		;RANDOM FILE?
	 DMOVE	T0,[EXP 6,<POINT 7,[ASCII /DIRECT/]>] ;YES
IF20,<	LOAD	T2,ORGAN(D)	;[5001] GET ORGANIZATION
	CAIN	T2,OR.IDX	;[5001] INDEXED?
	 DMOVE	T0,[EXP ^D5,<POINT 7,[ASCII /KEYED/]>] ;[5001] YES
> ;End IF20
	JRST	RETSTR		;RETURN IT

;INQRTP - RETURN RECORDTYPE IF THERE IS A CONNECTION;
;OTHERWISE RETURN 'UNKNOWN'
INQRTP:	PUSHJ	P,CHKOPN	;CHECK IF CONNECTION
	 JRST	RETUNK		;NOT. RETURN UNKNOWN
	MOVE	T1,RECTP(D)	;GET RECORDTYPE
	MOVEI	T2,SWRECT	;GET SWITCH TABLE ADDRESS
	PUSHJ	P,FNDSWT	;GET ADDRESS OF STRING
	JRST	RETVS		;GET COUNT, RETURN STRING

;INQRSZ - RETURN RECORDSIZE IF THERE IS A CONNECTION;
;OTHERWISE RETURN ZERO
INQRSZ:
IF20,<
	LOAD	T1,INDX(D)	;[5001] GET FILE TYPE
	CAIN	T1,DI.RMS	;[5001] RMS?
	 JRST	IRSZRM		;[5001] YES
> ;End IF20

	MOVE	T1,RSIZE(D)	;[5001] GET RECORDSIZE
	MOVEM	T1,@(L)		;RETURN IT
	POPJ	P,

IF20,<
IRSZRM:	SETZ	T1,		;[5001] ASSUME FILE NOT OPEN
	PUSHJ	P,CHKOPN	;[5001] FILE OPEN?
	 JRST	RETRSZ		;[5001] NO. RETURN ZERO
	LOAD	T1,MRSIZE(D)	;[5001] YES. GET MRS VALUE
	LOAD	T2,FORM(D)	;[5001] GET FORM
	CAIN	T2,FM.FORM	;[5001] FORMATTED?
	 JRST	RETRSZ		;[5001] YES, RETURN IN BYTES
	ADD	T1,BPW(D)	;[5001] NO, ROUND UP TO WORDS
	SUBI	T1,1		;[5001]
	IDIV	T1,BPW(D)	;[5001] 
RETRSZ:	MOVEM	T1,@(L)		;[5001] RETURN IT
	POPJ	P,		;[5001]
> ;End IF20

INQCC:	PUSHJ	P,CHKOPN	;CHECK IF OPEN
	 JRST	RETUNK		;NOT. RETURN 'UNKNOWN'
	LOAD	T1,CC(U)	;GET CARRIAGECONTROL
	MOVEI	T2,SWCC		;GET ADDRESS OF CC SWITCH TABLE
	PUSHJ	P,FNDSWT	;GET STRING ADDRESS
	JRST	RETVS		;GO COMPUTE STRING LENGTH, RETURN STRING

INQBLK:	PUSHJ	P,CHKOPN	;CHECK IF OPEN
	 JRST	RETUNK		;NOT. RETURN 'UNKNOWN'
	DMOVE	T0,[EXP 4,<POINT 7,[ASCII /NULL/]>] ;ASSUME NULL
	LOAD	T2,BLNK(U)	;GET BLANK=
	CAIN	T2,BL.ZERO	;BLANK='ZERO'?
	 DMOVE	T0,[EXP 4,<POINT 7,[ASCII /ZERO/]>] ;YES
	JRST	RETSTR		;RETURN IT

INQFRM:	PUSHJ	P,CHKOPN	;CHECK IF OPEN
	 JRST	RETUNK		;RETURN "UNKNOWN"
	DMOVE	T0,[EXP ^D9,<POINT 7,[ASCII /FORMATTED/]>]
	LOAD	T2,FORM(D)	;GET FORM=
	CAIN	T2,FM.UNF	;UNFORMATTED?
	 DMOVE	T0,[EXP ^D11,<POINT 7,[ASCII /UNFORMATTED/]>]
	JRST	RETSTR		;RETURN IT

INQNMD:	SETZM	@(L)		;SET FALSE
	PUSHJ	P,CHKOPN	;FILE OPEN?
	 POPJ	P,		;NO. RETURN FALSE
	LOAD	T1,STAT(D)	;GET STATUS
	CAIE	T1,ST.SCR	;SCRATCH?
	 SETOM	@(L)		;NO. SET TRUE
	POPJ	P,

;INQNRC - RETURN NEXT RECORD NUMBER. IF FILE IS NOT OPEN, CREC(D)
;WILL BE ZERO, SO WE WILL RETURN 1.
INQNRC:	MOVE	T1,CREC(D)	;GET CURRENT RECORD NUMBER
	ADDI	T1,1		;GET NEXT RECORD NUMBER
	MOVEM	T1,@(L)		;RETURN IT
	POPJ	P,

;INQNBR - RETURN UNIT NUMBER ASSOCIATED WITH THIS FILE
INQNBR:	PUSHJ	P,CHKOPN	;FILE OPEN?
	 POPJ	P,		;NO. DON'T TOUCH VARIABLE
	LOAD	T1,UNUM(U)	;RETURN UNIT NUMBER
	MOVEM	T1,@(L)
	POPJ	P,

;INQOPN - RETURN TRUE IF FILE IS OPEN, FALSE IF NOT
INQOPN:	PUSHJ	P,CHKOPN	;IS FILE OPEN?
	 JRST	OPNFAL		;NO
	SETOM	@(L)		;YES. RETURN TRUE
	POPJ	P,

OPNFAL:	SETZM	@(L)		;NO. RETURN FALSE
	POPJ	P,

;EXIST= IF OPEN BY UNIT, RETURN TRUE. IF OPEN BY FILE,
;RETURN TRUE IF INQUIRE WAS SUCCESSFUL
INQXST:	SETOM	@(L)		;INITIALLY SET TRUE
	SKIPN	XSTFLG		;SUCCESSFUL?
	 SETZM	@(L)		;NO. RETURN FALSE
	POPJ	P,

INQNAM:	LOAD	T1,STAT(D)	;GET STATUS
	CAIN	T1,ST.SCR	;SCRATCH?
	 JRST	RETNUL		;YES. RETURN SPACES
	SKIPN	T1,INQPNT	;DID INQUIRE FIND AN OPEN OR EXISTENT FILE?
	 JRST	RETNUL		;NO. RETURN SPACES
	SETZ	T0,		;CLEAR CHAR COUNT
INQRLP:	ILDB	T3,T1		;GET A CHAR
	JUMPE	T3,INQR		;DONE. CHAR COUNT IN T0
	AOJA	T0,INQRLP

INQR:	MOVE	T1,INQPNT	;SETUP PNTR YET AGAIN
	DMOVE	T3,@(L)		;GET DEST
	EXCH	T3,T4		;GET COUNT/PNTR
	EXTEND	[EXP <MOVSLJ>," "] ;MOVE IT
	 NOP
	POPJ	P,

;[5001] New
;KEYED=. CHECK IF THE FILE IS OPENED FOR KEYED ACCESS (I.E. ORGANIZATION=
;INDEXED). IF YES, RETURN 'YES'; IF NO CONNECTION, RETURN 'UNKNOWN'; IF
;CONNECTED BUT NOT INDEXED, RETURN 'NO'.

IF20,<
INQKEY:	PUSHJ	P,CHKOPN	;[5001] FILE OPEN?
	 JRST	RETUNK		;[5001] NO, RETURN 'UNKNOWN'
	LOAD	T2,ORGAN(D)	;[5001] GET ORGANIZATION
	CAIN	T2,OR.IDX	;[5001] INDEXED?
	 JRST	RETYES		;[5001] YES, RETURN 'YES'
	DMOVE	T0,[EXP 2,<POINT 7,[ASCII /NO/]>] ;[5001] NO
	JRST	RETSTR		;[5001] RETURN STRING

;[5001] New
;ORGANIZATION=. RETURN THE ORGANIZATION OF THE FILE. IF NO ORGANIZATION
;WAS SPECIFIED (THE FILE IS NOT AN RMS FILE), OR THE FILE IS NOT CONNECTED,
;RETURN 'UNKNOWN'. OTHERWISE RETURN 'SEQUENTIAL','RELATIVE',OR 'INDEXED'.

INQORG:	PUSHJ	P,CHKOPN	;[5001] FILE OPEN?
	 JRST	RETUNK		;[5001] NO, RETURN 'UNKNOWN'
	LOAD	T1,ORGAN(D)	;[5001] GET ORGANIZATION
	JUMPE	T1,RETUNK	;[5001] NONE GIVEN, RETURN 'UNKNOWN'
	MOVEI	T2,SWORG	;[5001] GET SWITCH TABLE ADDRESS
	PUSHJ	P,FNDSWT	;[5001] GET ADDRESS OF STRING
	JRST	RETVS		;GET COUNT, RETURN STRING
> ;End IF20

;[5001] New
;BYTESIZE=. RETURN THE BYTESIZE TO USER'S VARIABLE.

INQBSZ:	LOAD	T1,BSIZ(D)	;[5001] RETURN BYTESIZE
	MOVEM	T1,@(L)		;[5001] TO USER
	POPJ	P,		;[5001] 
	
;CHECK IF THERE IS A CONNECTION, I.E., IF FILE IS OPEN
CHKOPN:	SKIPE	UNKXST		;[5001] COULDN'T DETERMINE EXISTENCE?
	 POPJ	P,		;[5001] YES, CAN'T RETURN ANYTHING USEFUL
	MOVE	T1,FLAGS(D)	;GET DDB FLAGS
	TXNE	T1,D%IN+D%OUT+D%OPEN ;IS FILE OPEN?
	 AOS	(P)		;YES. SKIP RETURN
	POPJ	P,

	SEGMENT	DATA

SWTPNT:	BLOCK	1		;SWITCH TABLE POINTER
DSPPNT:	BLOCK	1		;DISPATCH TABLE POINTER
XSTFLG:	BLOCK	1		;INQUIRE FILE EXISTENCE FLAG
UNKXST:	BLOCK	1		;[5001] INQUIRE FILE AMBIGUOUS EXISTENCE FLAG
INQPNT:	BLOCK	1		;POINTER TO APPROPRIATE INQUIRE FILESPEC
INQUDB:	BLOCK	1		;INQUIRE UDB ADDR
ARGCNT:	BLOCK	1		;FOROTS ARGUMENT COUNT
KWTADR:	BLOCK	1		;KEYWORD TABLE ADDRESS
KEYVAL:	BLOCK	1		;KEYWORD NUMBER
KEYADR:	BLOCK	1		;Keyword table_entry_address for KEYVAL.

FNSPNT:	BLOCK	1		;LOCAL POINTER FOR %GTFNS
%GNPNT:	BLOCK	1		;[5000] POINTER TO GENERATION IN FILESPEC
%TXTBF:	BLOCK	LTEXTW		;TEXT BUFFER
TXTBF1:	BLOCK	LTEXTW		;2ND TEXT BUFFER FOR INQUIRE
TXTBF2:	BLOCK	LTEXTW		;3RD TEXT BUFFER FOR INQUIRE

ATMBUF: BLOCK	LATOMW		;ATOM BUFFER

%IONAM:: BLOCK	1		;ADDRESS OF ASCIZ STATEMENT NAME

%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

	FORPRG
	END