Google
 

Trailing-Edge - PDP-10 Archives - BB-D480G-SB_FORTRAN10_V11.0_short - forio.mac
There are 25 other files named forio.mac in the archive. Click here to see a list.
	SEARCH	MTHPRM,FORPRM
	TV	FORIO	I/O ROUTINES,11(5014)

;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

1263	JLC	09-Feb-81	QAR 10-05487
	Fix -10 backspace. SOJLE should be SOJGE.

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

1303	JLC	25-Feb-81
	Folded -10 code for %irec into the -20 code for DIREC, made
	it call %SAVE4 instead of %SAVE3 as it was clobbering P4.
	Save line sequence number in the DDB.

1306	DAW	26-Feb-81
	New arg-list format from %SAVE

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

1316	JLC	5-Mar-81
	Major changes for magtape handling, switching i/o direction.

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

1332	JLC	11-Mar-81
	Installed dump mode I/O for the -10.

1333	JLC	11-Mar-81
	Fix to backspace over eof.

1336	JLC	12-Mar-81
	Fix to dump mode I/O, removed extraneous saves of pntr/count
	for the -10, added one where crucial (just before FILOP in
	binary I/O).

1341	JLC	13-Mar-81
	Add code to handle rewind of file that hasn't been opened
	yet for the -10.

1343	DAW	16-Mar-81
	A few changes for extended addressing.

1346	JLC	16-Mar-81
	Fixes to -10 backspace file, skip file, and rewind.

1353	JLC	18-Mar-81
	More fixes for -10 magtape ops. BAKEOF was not backspacing
	over the last block of the file.

1357	JLC	19-Mar-81
	More fixes to magtape ops. BAKEOF was not handling null
	files correctly. Installed code to prevent creation of
	null file for rewind, skip file, backfile, or unload with
	no OPEN.

1360	EDS	19-Mar-81	Q10-05866
	Range check UNIT numbers used in I/O statements.

1361	JLC	20-Mar-81
	Fix some typos in code to prevent null file creation.

1363	JLC	24-Mar-81
	Minor fixes to magtape and error typout,
	added missing global (%iset) called from foropn.

1365	JLC	25-Mar-81
	Typo in WAIT FILOP.

1366	JLC	26-Mar-81
	Still more typos, plus BAKEOF bug, plus END FILE was not
	incrementing the block #.

1374	JLC	31-Mar-81
	Replace code to turn off D%END for terminals. Previous code
	was wiping T1, which contained valuable data.

1376	JLC	31-Mar-81
	Fix -10 backspace code to eliminate cache-sweep bugs for
	SMP (removed clearing of use-bits).

1377	JLC	01-Apr-81
	Change load/store FLGS to move/movem FLAGS, since it was
	a full word. Minor fix to -10 backspace. Minor changes
	to UNFO, moved check for empty window from end of loop
	to beginning of BLT code.

1401	JLC	30-Apr-81
	Put back code to clear use-bits, was merely masking another
	bug.

1402	JLC	06-Apr-81
	Transplant input record initialization to where it belongs,
	new subroutine called %IRINI. Move setting of CRLF suppression
	to %IREC.

1406	JLC	06-Apr-81
	Minor bug in backspace for -10, backspace beyond block 1
	sometimes would not work.

1410	JLC	07-Apr-81
	Move record buffer setup to %IRINI and %ORINI in preparation
	for separation of record buffer. Modify and separate EXPRB
	for same preparation.

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

1412	JLC	09-Apr-81
	Fix minor problem reading fixed-length record files. Fix
	backspace for the -20 for fixed-length record files.

1413	DAW	10-Apr-81
	Get rid of flag D%MTOP. FOROTS doesn't need to check
	whether or not its doing a magtape operation on every IO
	statement.

1414	DAW	10-Apr-81
	MTOP operations were ignoring ERR=.

1416	JLC	10-Apr-81
	Separate record buffers. Install DTA rewind and unload.

1422	JLC	13-Apr-81
	Typo in separate record buffers.

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

1424	JLC	14-Apr-81
	Typo in %IRINI made DECODE non-existent.

1427	JLC	15-Apr-81
	Changed RSIZ to be a word in the DDB. Make FORIO
	ignore MODE=DUMP if ACCESS=RANDOM.

1430	JLC	15-Apr-81
	Typo in -20 backspace broke it.

1432	JLC	16-Apr-81
	Was trashing returned AC T3 in DIREC. Changed code to return
	result in IRCNT(D) instead.

1433	JLC/CKS	16-Apr-81
	Fix for binary backspace.

1435	CKS	16-Apr-81
	More binary backspace fixes.

1436	JLC	16-Apr-81
	More of edit 1432. Return result in IRCNT for DECODE also.

1443	JLC	17-Apr-81
	Make EOFN(D) represent fixed number of bytes in file. EOF
	detected by comparing BYTN with EOFN.

1444	JLC	21-Apr-81
	Fix bug caused by edit 1443; it was smashing T1.

1445	DAW	21-Apr-81
	Rework code around UNFSW to make it more understandable.

1450	JLC	22-Apr-81
	Fix DECODE new record code.

1451	JLC	23-Apr-81
	Special code for dump mode I/O in mtops.

1453	JLC	24-Apr-81
	Make dump mode backspace and skiprecord work for magtape.
	Insert if20 end after EOFN setup code.

1454	JLC	24-Apr-81	QAR 20-01364
	Change EOFN if we switch from formatted to unformatted.

1455	JLC	27-Apr-81
	Fix bug from edit 1452. Must not set D%LIN/D%LOUT on the way
	out of magtape operations.

1460	JLC	28-Apr-81
	Fix typo in edit 1453. It thought most files were dump mode.

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

1464	DAW	21-May-81
	Error messages.

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

1474	JLC	22-May-81
	Bug in %PTOF, thought WSIZ was in words, was in bytes.

1476	JLC	26-May-81
	Bug in unformatted I/O, was looking at EOFN for non-disk files.

1501	JLC	27-May-81
	More bugs, this time in random I/O, caused by changed calling
	sequence for MAPW.

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

1505	JLC	01-Jun-81
	Many bug fixes in disk and magtape backspace operations.
	Turn off EOF and initialize things for BACKFILE and
	SKIPFILE.

1506	CKS	2-Jun-81
	Add SLST77 and ELST77, temporarily equated to F-66 equivalents,
	SLIST and ELIST.

1511	JLC	5-Jun-81
	More edits to magtape code, for SKIPFILE and BACKFILE.

1516	JLC	10-Jun-81
	Yet another bug, this time in disk backspace. WSIZ is not
	in words! Fix end-of-record handling for unformatted I/O.

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

1535	JLC	14-Jul-81
	EOF handling correction, both to zero arrays correctly
	and to handle IOSTAT correctly.

1536	JLC	15-Jul-81
	Minor edits.

1542	JLC	17-Jul-81
	Fix ERR and END processing and %MVBLK.

1546	JLC	20-Jul-81
	Fix DEC% to call DECINI. Fix TIREC for -20 to allocate
	record buffer if none there yet.

1547	DAW	20-Jul-81
	Replacement for old %CHKDR routine.

1550	JLC	20-Jul-81
	Fix DECODE, it had off-by-one error. Fix X format, it referenced
	stuff in DDB without D. Fix setup of record buffers - make sure
	it happens in %ORINI or %IRINI.

1553	JLC	23-Jul-81
	Fix ENCODE and DECODE again. Setup IRPTR properly in TIREC.
	Eliminate useless routine ENCINX.

1560	DAW	28-Jul-81
	OPEN rewrite: Base level 2

1567	JLC	30-Jul-81
	More fixes to ENCODE/DECODE, output buffer setup, prompting.

1572	JLC	31-Jul-81
	ENCODE - setup entire string with blanks for initialization.

1574	BL	3-Aug-81
	Missing IF20 conditional around G.PRP

1575	JLC	05-Aug-81
	Fix record zeroing again.

1577	DAW	11-Aug-81
	Create "ENDNUL" routine to make the "drop a null at EOR"
	hack work correctly.

1601	DAW	12-Aug-81
	ENDFILE to a disk file was trying to open it for input on the -20.

1604	DAW	12-Aug-81
	More of 1601-type stuff, for DIVERT.

1607	DAW	13-Aug-81
	Fix bug in FIND code.

1613	JLC	19-Aug-81	Q10-6390
	Use a character count, not a word count, in backspace of
	ASCII files.

1614	JLC	19-Aug-81
	Move setting of D%MOD into DOREC. Remove END= branching
	for end-of-record for files with no crlf at end, thus
	EOF becomes a valid record terminator, and the program
	will get END= at the next read.

1622	JLC	21-Aug-81
	Rewrite ENCODE/DECODE again, rework record positioning
	subroutines for output, so that X, T format reaaly work.

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

1627	DAW	24-Aug-81
	On TOPS-20, UNLOAD and REWIND no longer need a filename

1630	JLC	24-Aug-81
	Make illegal operations on magtape a fatal error.

1631	DAW	24-Aug-81
	Set D%MOD in UNFO.

1632	JLC	24-Aug-81
	Fixed OPAD to output spaces instead of random trash for X and
	T format.

1633	JLC	25-Aug-81
	On TOPS-20, SKIPFILE and BACKFILE no longer need a filename.

1634	JLC	25-Aug-81
	ORPOS was left set at FIXREC, caused records to be too large.

1635	JLC	25-Aug-81
	Fix for edit 1633, plus ENDFILE can't work that way.

1637	JLC	26-Aug-81
	DECODE bug. IRCNT was not getting set up properly.

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

1643	JLC	27-Aug-81
	More code for faster EOL handling. Modify IRBUF/ORBUF to be full
	words so ENCODE/DECODE will work with extended addressing.

1645	DAW	28-Aug-81
	Column 1 before errors in DIVERT'ed file.

1646	DAW	28-Aug-81
	DTA REWIND and UNLOAD used wrong channel.

1647	DAW	28-Aug-81
	DTA REWIND and UNLOAD to not require an existing file.

1652	DAW	1-Sep-81
	Fix DUMP mode I/O on TOPS-10; make "IOE" a "?" error.

1653	JLC	1-Sep-81
	Return -1 (illegal LSN) for non-LINED files and LINED files
	with no LSN.

1663	JLC	8-Sep-81
	Fixed ill mem read for non-existent pages in read-only file.
	Added code to record top page number, so unused pages can be
	unmapped.

1665	DAW	8-Sep-81
	Make a D.TTY hack to get error messages right; delete refs to U.TTY.

1676	DAW	9-Sep-81
	%OCRLF to always output a CRLF, and not use "U".

1702	JLC	10-Sep-81
	More fix to non-existent page stuff, unmapping unused pages.
	Add code to prevent expansion of random files on -10 by
	merely touching the page (not possible on -20).

1703	DAW	11-Sep-81
	Fix printing of too many CRLF's in errors when a TTY file is open.

1704	JLC	11-Sep-81
	Fix SETPOS not to pad a blank when we are at desired position.
	Also typo in RDW for -10 in edit 1702.

1705	JLC	11-Sep-81
	Fix more serious T-format bug. T1 was not working on output,
	as it got stored as position 0. Now ORPOS contains desired
	position of NEXT character.

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

1707	JLC	14-Sep-81
	Edit 1705 broke %IBACK.

1712	JLC	15-Sep-81
	Fixed more bugs in t-format, created IRPOS.
	Eliminated D%ERR!

1716	JLC	16-Sep-81
	Changed the names of ISPOS, OSPOS, etc., to make things less
	confusing. Fixed typo due to confusion.

1722	JLC	16-Sep-81
	Code for IRPOS more complicated than originally envisaged.

1730	JLC	18-Sep-81
	More fixes for T-format.

1735	DAW	22-Sep-81
	-20 DISK APPEND files now get EOF for READ.

1737	DAW	23-Sep-81
	Fix processing of REREAD error "RBR".

1740	DAW	23-Sep-81
	More REREAD code.

1745	JLC	24-Sep-81
	Made IRBLN, ORBLN, and IRLEN full words. Removed all refs
	to IRPOS, now unnecessary.

1761	JLC	5-Oct-81
	Fixed ENDFILE on disk, did not open file for output before.

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

1775	JLC	9-Oct-81
	Fix ^Z handling.

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

2005	JLC	15-Oct-81
	Fix unmapping of unused pages so it does it for random files.
	On -10, update .RBSIZ so we don't return zeroes for data
	that's there.

2006	JLC	15-Oct-81
	Control-Z change broke DECODE by meddling with IRCNT, which
	should be inviolate before the "device-dependent" call.

2010	JLC	19-Oct-81
	Make EOFN and BYTN live for the -10.

2016	JLC	20-Oct-81
	Fix SLISTs and ELISTs to differentiate between -66 and -77
	programs and give 1-trip (i.e., 1 entry) for zero-trip
	lists.

2033	DAW	19-Nov-81
	Change symbol "LTYPE" to "%LTYPE" to avoid conflict with
	user symbol.
	Give error if user tries to do random I/O without an OPEN
	statement with a RECORDSIZE specifier.
	Pay attention to ERR= and IOSTAT= for ENCODE and DECODE.
	Fix dollar format to make T and X format have some effect
	at end of record.

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

2042	TGS	2-FEB-82	20-17208
	Change NREC(D) to NREC(U) at RNRER1, MOPEND (inside IF20 conditional),
	and MOPEND (inside IF10 conditional) end-of-file routines so record
	counts are correctly incremented/decremented.
	Note: this was really done here by JLC during rework.

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

3003	JLC	26-Oct-81
	Add error msg for character I/O to unformatted file - not
	supported yet.

3012	JLC	4-Nov-81
	Rework FOROTS call arg copier. No more LTYPE.
	Small extended addressing change in SMAP - get extended
	address for page reference.

3014	JLC	5-Nov-81
	Fixed more bugs in SLIST.

3035	JLC	5-Feb-82
	Rework of binary I/O with characters.

3036	BL	10-Feb-82
	Inserted %OMBYT, routine to put out character strings.

3037	JLC	11-Feb-82
	Fixed dump mode I/O. Made all errors on magtape fatal.

3041	JLC	11-Feb-82
	Fixed character/binary I/O word-alignment bit-clearing; table
	was set up wrong (missing commas).

3042	JLC	12-Feb-82
	Fix ordinary binary I/O, broken by char/binary patch. Was
	calling UOALIN with pntr/count=0, which set 010700 lh in bp.

3043	JLC	18-Feb-82
	Fix internal files. Was getting address of descriptor for
	length (left out @), then stored wrong AC anyway.

3056	JLC	23-Mar-82
	Catch I/O within I/O. Give warning for attempt to write
	too much data in binary or image files with fixed-length
	records. Fix TTY EOF for multi-line input.

3104	JLC	8-Apr-82
	IALIGN had IDIV/IMUL backwards.

3105	JLC	9-Apr-82
	Fix dump-mode I/O to return properly via %SETAV.

3113	JLC	22-Apr-82
	Fix IWORD so it never calls ONXTW with a non-zero byte count.

3122	JLC	28-May-82
	Moved place where %UDBAD was getting set up. Changed some
	global refs. Moved POSEFL into FORIO.

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

3136	JLC	26-Jun-82
	Extensive rework of record output for improved performance.

3140	JLC	2-Jul-82
	Fix IMAP for -10 and -20 - EOF return was changed to non-skip.
	Fix %OMBYT so it doesn't try to MOVSLJ with 0 or negative byte
	counts.

3141	JLC	2-Jul-82
	Code at end of %EOREC was not restoring things properly.
	Fix ^Z in -20 code, was not appearing on its own line. Remove
	two-direction code from IRSET, move it to TIREC.

3150	JLC	12-Jul-82
	Fix input of fixed-length random records so it checks for
	record not written. Moved code that checks for EOF - it would not
	detect a second occurrence for fixed-length record files.
	Save P1 and P2 in sequential and random window routines.
	Fix -10 random write bug, was comparing something to EOFN
	with CAIG.

3152	JLC	14-Jul-82
	Reload P1/P2 in multiple places after calls to IMAP.

3153	JLC	20-Jul-82
	Fixed -10 problem caused by new EOF handling of RANDOM files.

3157	BL	9-Aug-82
	Fix backspace bug. When backspacing to beginning of binary
	sequential file, if the desired record was entirely within
	the previous window, UNFBSR attempted to PMAP the previous
	BUFCNT pages, whether or not they were in fact real pages
	within the file.

3161	JLC	16-Aug-82
	Fixed some extended addressing bugs for ENCODE/DECODE by
	adjusting the byte pointer separately rather than relying
	on the updated one provided by MOVSLJ, which ends up
	being 2-word on the KL. Installed V7 version of TSG patch
	for record numbers bigger than a half-word. Coded around
	microcode bug with MOVSLJ and padding with 0 byte count.
	Fixed %IBYTC so it doesn't do LDB on null record. Flush
	buffer for TOSTR on -10.

3165	JLC	28-Aug-82
	Recode part of random I/O handling so it can process files
	larger than 256K blocks long.

3166	JLC	31-Aug-82
	Eliminate multiply-defined symbol CHKEOL in -10 code.

3167	JLC	31-Aug-82
	Removed %SPEOL, as it accomplished nothing.

3170	AHM	1-Sep-82
	Fix bug in edit  3165.  Remove index  field from reference  to
	WPAGE at RECTPG to avoid ?Illegal memory READs in section 1.
	Module:		FORIO

3171	JLC	1-Sep-82
	Fix random I/O on the -10, wrong AC used (typo).

3172	JLC	2-Sep-82
	Fix random I/O on the -10. CLRPAG was clearing the ACs
	instead of the proper pages.

3173	JLC	3-Sep-82
	Another fix to -10 random I/O, was not calculating when to
	truncate block correctly, was not saving .RBSIZ when it
	should have been.

3174	JLC	4-Sep-82
	Fix TTY input on the -10, checked the wrong char for EOL,
	did not do record expansion correctly.

3200	JLC	24-Sep-82
	Store LSN for variable-length records. Fix -20 TTY input
	of large records. Use BPW calcs rather than assuming 1200
	bytes/block on the -10.

3201	JLC	4-Oct-82
	Move unit range check to before I/O within I/O check.

3202	JLC	26-Oct-82
	Fix many bugs, and provide basic support for ANSI (8-bit)
	tapes for TOPS-20, since most of the work is done by the
	monitor. Install new code to read and backspace fixed-
	length, non-word-aligned records.

3203	JLC	31-Oct-82
	Fix SPCWD problem.

3212	JLC	11-Nov-82
	Update and consolidate -20 magtape code so that B36FLG(D) controls
	whether formatted or unformatted I/O is done. Fix unformatted
	I/O routines for mixed-mode files.
	Fix CCOC handling logic - only change CCOC words when we
	are about to do TTY output, then restore them to just
	previous to the output. 

3213	JLC	12-Nov-82
	More consolidation, minor bug fixes - OWORD was assuming
	T1 was preserved, and it wasn't.

3215	JLC	15-Nov-82
	Fix magtape bugs, typos in FORIO and FOROPN.

3221	JLC	18-Nov-82
	Fix magtape bugs.

3222	JLC	19-Nov-82
	Fix more magtape bugs, plus binary backspace on the -10.

3223	JLC	22-Nov-82
	Fix more backspace bugs, EOFN for error output.

3225	JLC	24-Nov-82
	Fix yet more magtape bugs (namely, characters left at the
	end of the last word needed to be cleared). Type nulls as
	nulls, since they are more likely to appear more in V7.

3226	JLC	29-Nov-82
	Make BZ the default for ENCODE/DECODE and internal files.

3231	JLC	14-Dec-82
	Change error message for illegal length internal files
	to a valid error, since they can be user-initiated. For READ,
	simumulate TOPS-10 EXEC handling of <ESC> - output a CRLF,
	and treat it as an EOL character.

3237	JLC	18-Dec-82
	Fixed yet another bug in ENFILL.

3240	JLC	20-Dec-82
	Removed ENFILL, caused too many bugs and could not work in
	extended addressing.

3247	RJD	7-Jan-83
	Add ERJMPs after PMAP calls used to set up the file windows
	for sequential and random files.

3250	JLC	7-Jan-83
	Fix TOREC, was changing CCOC words and not changing them
	back if nothing in record.

3251	JLC	9-Jan-83
	In edit 3250, check ORCNT, not IRCNT.

3252	JLC	12-Jan-83
	Insert FORPRG macro call, to purge MONSYM-created global
	symbols which don't have "%" or ".".

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

3270	JLC	11-Feb-83
	When executing DIVERT code, check the character count
	before writing a message string	to enusre that nulls
	are not output.

3341	TGS	16-Aug-83	SPR:10-34074
	Internal file READ/WRITE errors erroneously reference a bogus
	current unit number.  IFI and IFO should store the internal
	unit number in %CUNIT for possible error processing.

3343	RJD	17-Aug-83	SPR:10-30961
	Error bit not being cleared after a READ ERROR has been
	detected with a card reader which results in the ERR=
	branch being taken for all subsequent reads.

3346	JLC	30-Aug-83	SPR:20-19447
	FOROTS attempted to read the character after the 5-digit
	line number and got the 1st character of data instead.

3401	RJD	16-Jan-84	SPR:20-19862
	When writing records which consist only of a CRLF and
	using CARRIAGECONTROL='FORTRAN', be sure the EOFN is
	updated for each CRLF record.

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

4000	JLC	22-Feb-82
	Enhance performance of all I/O some more.

4004	JLC	24-Feb-83
	Fix some bugs in the above enhancements.

4005	JLC	28-Feb-83
	More code enhancements.

4010	JLC	19-Apr-83
	Some performance enhancements, plus hooks for fast FLOUT.

4014	JLC	14-Jun-83
	CC='TRANSLATED' instead of CC='FORTRAN'. Implement
	image-mode TTY. Implement much of proper tape handling.

4016	JLC	22-Jun-83
	Fixed image mode to TTY to be consistent - now does word I/O
	for numeric variables regardless of how TTY is opened.

4023	JLC	29-Jun-83
	Fix some new magtape code. Add new routine OMBWP, to output
	multiple bytes with a specified fill character and possibly
	different source and destination sizes.

4036	JLC	3-Aug-83
	Allow binary (image) I/O to ASCII-only devices. Allow user
	"fixup" of asterisk output for field width too small by
	providing a pointer to the FOROTS record buffer.

4044	JLC	27-Sep-83
	Install a skeleton for RMS I/O. Fix a bug in %GOPTR, part
	of output field width overflow for extended addressing.

4052	JLC	12-Oct-83
	Fix magtape rewind, was clearing OCNT/OPTR, so data did not
	get written by OSWTCH. Minor performance enhancements.

4053	JLC	18-Oct-83
	Fix CC=FORTRAN for non-stream files, was not changing
	carriage-control character of next line for dollar format.

4054	JLC	25-Oct-83
	Code movement for RMS was no good. Move it back.
	Store U.RERD only after successful %IREC call.

4055	JLC	27-Oct-83
	Fix image-mode I/O for odd-size magtape blocks. Code
	previously assumed (and forced) word-aligned blocks.

4056	JLC	30-Oct-83
	Fix CC='NONE', was getting ignored. For STREAM files, now
	suppresses normal CRLF record terminator, simulating its
	effect on RMS files.

4060	JLC	2-Nov-83
	Fix magtape code, was not setting label type for REWIND.
	SKIPFILE for unopened units.

4061	JLC	4-Nov-83
	Fix IOSTAT bug, set %ERIOS instead of IOSTAT variable,
	set IOSTAT variable in %SETAV at end of I/O.

4063	JLC	8-Nov-83
	Fix OWG bug in returning "fixed-up" record pointer.

4064	JLC	14-Nov-83
	Fix IOSTAT processing. Modify names for new RMS keyword
	locations.

4065	JLC	6-Dec-83
	Prepare for RMS. Cleanup backspace code.

4066	JLC	11-Jan-84
	More cleanup of magtape code. More preparation for RMS interface.

4067	JLC	13-Jan-84
	Fix SKIP RECORD bug.

4070	JLC	16-Jan-84
	Clear D%STCR in CHKDOL, so that it is not sticky across
	records. Fix CCNON, which had misplaced code. Fix random
	I/O, which by a typo had an infinite loop.

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 Carriage control characters & Trailing spaces at end of rec.	

4102	JLC	17-Feb-83
	TOPS-10 image mode I/O code.

4104	JLC	22-Feb-84
	Slight mods to compatibility flagging code. Catch TTY output
	incompatibilities.

4105	JLC	28-Feb-84
	Modify the calling sequence for error calls.

4111	JLC	16-Mar-84
	Modify the calling sequence for error calls again.

4115	JLC	2-Apr-84
	Fix disk and magtape code for TOPS-10.

4116	JLC	4-Apr-84
	More fixes for TOPS-10. Fix common ENDFILE code.

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

4124	JLC	8-May-84
	Fix IOARG to calculate effective address of "delayed" args (ERR=,
	END=, IOSTAT=) immediately, as their pointers can reside in
	the copied arg block with /EXTEND.

4125	JLC	11-May-84
	Remove a subroutine CHKEF which is never called.

4127	JLC	15-May-84
	Fix TOPS-10 mapping code.

4131	JLC	12-Jun-84
	Modify %GTBLK, %MVBLK, %GTSPC, and %MVSPC calls to have a
	memory full non-skip return. Check only right half of IPTR
	to see if I/O has been done, since TOPS-10 puts stuff in
	the left half. If there is an error on a DIVERTed unit,
	type it on the TTY, avoiding really recursive errors.

4132	JLC	15-Jun-84
	Added entries in the IOLST processor for "new-style" SLISTs
	and ELISTs which have their increments in words and characters
	rather than in "entries".

4136	MRB	11-Jul-84
	Fix GETDEL to handle RCW's for magtape correctly. FORIO.MAC

4140	JLC	24-Jul-84
	Fix ELISTs and SLISTs so they get the right increment for
	the right situation.

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

4144	JLC	29-Aug-84
	Fix magtapes again, this time for null file at BOT.

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, added BSRDEL & BSRLAB, and modified COMBSR.

4156	JLC	23-Oct-84
	Fix %EOREC to save and set %UDBAD so that error messages deriving
	from errors writing to the DIVERT unit will be reported correctly.
	Separate disk and magtape backspace. Fix unformatted I/O to TTY
	for the -10.

4160	MRB	25-Oct-84	
	Disallow an unformatted, image device to do backspaces or skip
	records. (Give an error message.)

4161	JLC	1-Nov-84
	Change ASCFLG to IMGFLG, indicating that the device in question is
	an image-mode device which cannot have LSCWs. This will then include
	the ASCII-only devices. Remove all tests of MODE(D)=MD.IMG, since
	this test is not general enough; instead just check IMGFLG.

***** End V10 Development *****

4215	TGS	4-Jun-85
	Don't clear RECLEN flag for unformatted character data input. This
	fixes an undeserved "?Bad format binary file" error when FORIO
	looks for a nonexistent LSCW 3.

4217	RJD	16-Jul-85	SPR:10-35226
	When BACKSPACing a very large record, a half word calculation
	for the file pointer is insufficient.

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.

***** Begin V11 Development *****

5003	TGS	24-Oct-85
	Implement RMS READ.

5004	TGS	10-Nov-85
	Implement RMS WRITE

	MRB	2-Dec-85
5005	Initial cleanup of MTOP code in FORIO. Moved routine UNFSKP closer 
	to it's caller. Inserted code to do non-opened rewind for tapes.

	MRB	16-DEC-85
5006	Disallow file positoning statements that don't work for labeled
	tapes. (endfile,skipfile,backfile,backspace)

5014	MRB	4-JUNE-1986
	Implement RMS UNLOCK statement.

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


	INTERN	%IBYTE,%OBYTE,%IBYTC,%OMBYT,%OMSPC,%IMBYT,%CBDO,%OMPAD,%OMBWP
	INTERN	%IRECS,%OREC,%EOREC,%ORECS,%OCRLF,%GOPTR,%CDBO,%OCLR,%PTOF
	INTERN	%IBACK,%OSMAP,%OBUF,%ISBUF,%OSDSK,%SMAPW
	INTERN	%SETAV,%OFIN,%RTMSK,%CUNIT
	INTERN	%RIPOS,%SIPOS,%ROPOS,%SOPOS,%CIPOS,%COPOS
	INTERN	%MTFSF,%MTBSB,%MTEOF,%MTBSA
IF20,<	INTERN	GETIRB,EXPIRB,SETPTR,PAGNUM			;[5003]>
IF20,<	INTERN	A.REC,A.KVL,A.KRL,A.KID,RECLEN			;[5003]>
IF20,<	INTERN	GETORB,BYTUSD,ORINI,A.FMT			;[5004]>
	INTERN	%BAKEF						;[5013]
IF20,<	INTERN	A.IOS						;[5014]>

IF10,<	INTERN	%RANWR  >
	
	EXTERN	%FLIDX
	EXTERN	%UDBAD,%MSPAD,%MSLJ,%NAMLN,%ERIOS,%EOPTR,%EOCNT
	EXTERN	%POPJ,%POPJ1,%SAVE1,%SAVE2,%SAVE3,%SAVE4,%CPARG,%SAVAC,%SAVIO
	EXTERN	%PUSHT,%POPT,%JPOPT
	EXTERN	%IFSET,%OFSET,%IFORM,%OFORM,%LDI,%LDO,%NLI,%NLO,%LDIST,%LDOST
	EXTERN	%IOERR,%IONAM,%FSECT
	EXTERN	%SETIN,%SETOUT,%CRLF
	EXTERN	%GTBLK,%MVSPC,%GTSPC
	EXTERN	%ISAVE,%SIZTB,%HIINT,%LOINT,%DDBTA,%CLSOP,%MTPRM
	EXTERN	%EDDB,U.RERD,U.ERR,D.TTY,U.TTY,G.PRP
IF20,<	EXTERN	%OCCOC,%OCLIT,%CCMSK>
	EXTERN	%MTPRM,%LABCK 
	EXTERN	%OPENX,%LSTBF,%OWGBT
	EXTERN	%UNNAM
	EXTERN	IO.ADR,IO.NUM,IO.SIZ,IO.INC,IO.TYP,IO.INS
	EXTERN	%ALCHF,%DECHF
IF20,<	EXTERN	%IRMS,%ORMS,%UORMS,%RMREW,%RMBSR,%RMEND		;[5000]>
IF20,<	EXTERN	%RMRDW,%RMSIN,%RMSOU				;[5000]>
	EXTERN	%RMASV,%RMFND,O.KEY				;[5000]
IF20,<	EXTERN	%RMCRW,%FREBLK					;[5004]>
IF20,<	EXTERN	%RMCDL,%RMDEL					;[5013]>
IF20,<	EXTERN	%RMUNL,%RMCUL					;[5014]>

	SEGMENT	CODE
	SUBTTL	I/O SETUP

;Formatted read -- READ (u,f)
	FENTRY	(IN)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;AND COPY ARGS
	PUSHJ	P,FMTCNV	;CONVERT ARG LIST
	PUSHJ	P,FINGO		;GO DO I/O SETUP
	LDB	T1,[POINTR A.FMT,ARGTYP] ;GET FORMAT TYPE
	JUMPN	T1,%IFSET	;IF NON-ZERO, IT'S FORMATTED INPUT
	JRST	LDI.		;ZERO. IT'S LIST-DIRECTED INPUT

;Formatted write -- WRITE (u,f)
	FENTRY	(OUT)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;AND COPY ARGS
	PUSHJ	P,FMTCNV	;CONVERT ARG LIST
	PUSHJ	P,FOUTGO	;GO DO I/O SETUP
	LDB	T1,[POINTR A.FMT,ARGTYP] ;GET FORMAT TYPE
	JUMPN	T1,%OFSET	;IF NON-ZERO, IT'S FORMATTED OUTPUT
	JRST	LDO.		;ZERO. IT'S LIST-DIRECTED OUTPUT

;Unformatted read
	FENTRY	(RTB)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;AND COPY ARGS
	PUSHJ	P,UNFCNV	;CONVERT ARG LIST
	PUSHJ	P,UINGO		;GO DO I/O SETUP
	LOAD	T1,MODE(D)	;GET MODE
	CAIN	T1,MD.DMP	;DUMP?
	 JRST	RDUMP		;YES. GO SET IT UP
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIN	T1,DI.TTY	;TTY?
	 JRST	UISTTY		;YES. SETUP IS SPECIAL
	PJRST	UISET		;GO DO INITIAL SETUP

;Unformatted write
	FENTRY	(WTB)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;AND COPY ARGS
	PUSHJ	P,UNFCNV	;CONVERT ARG LIST
	PUSHJ	P,UOUTGO	;GO DO I/O SETUP
	LOAD	T1,MODE(D)	;GET MODE
	CAIN	T1,MD.DMP	;DUMP?
	 JRST	WDUMP		;YES. GO DO DUMP OUTPUT
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIN	T1,DI.TTY	;TTY?
	 JRST	UOSTTY		;YES. SETUP IS SPECIAL
	PJRST	UOSET		;GO DO INITIAL SETUP

;Namelist input
	FENTRY	(NLI)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;AND COPY ARGS
	PUSHJ	P,NMLCNV	;CONVERT ARG LIST
	PUSHJ	P,FINGO		;GO DO I/O SETUP
	PJRST	%NLI		;AND DO I/O

;Namelist output
	FENTRY	(NLO)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;AND COPY ARGS
	PUSHJ	P,NMLCNV	;CONVERT ARG LIST
	PUSHJ	P,FOUTGO	;GO DO I/O SETUP
	PJRST	%NLO		;AND THE I/O

;DECODE
	FENTRY	(DEC)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;AND COPY ARGS
	PUSHJ	P,ENCCNV	;CONVERT ARG LIST
	XMOVEI	T1,[ASCIZ /DECODE/]
	MOVEM	T1,%IONAM	;Set statement name
	PUSHJ	P,IOARG		;Move args to A.XXX
	PUSHJ	P,SETDE		;SET UP DDB POINTING TO STRING
	MOVX	T1,DECUNI	;STORE "UNIT"
	MOVEM	T1,%CUNIT	;FOR ERROR MSGS
	PUSHJ	P,DECINI	;INIT BUFFER PNTR
	XMOVEI	T1,DECODE	;SETUP DECODE FOR INPUT RECORDS
	MOVEM	T1,IOREC(D)
	PJRST	%IFSET		;GO ENCODE THE FORMAT

;ENCODE
	FENTRY	(ENC)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;AND COPY ARGS
	PUSHJ	P,ENCCNV	;CONVERT ARG LIST
	XMOVEI	T1,[ASCIZ /ENCODE/]
	MOVEM	T1,%IONAM	;Set statement name
	PUSHJ	P,IOARG		;Move args to A.XXX
	PUSHJ	P,SETDE		;SET UP DDB POINTING TO STRING
	MOVX	T1,ENCUNI	;STORE "UNIT"
	MOVEM	T1,%CUNIT	;FOR ERROR MSGS
	PUSHJ	P,ENCINI	;Init for ENCODE
	XMOVEI	T1,ENCODE	;SETUP FOR ENCODE FOR OUTPUT RECORDS
	MOVEM	T1,IOREC(D)
	XMOVEI	T1,%SETAV	;AND NOTHING MUCH FOR THE FIN CALL
	MOVEM	T1,IOFIN(D)
	PJRST	%OFSET		;GO ENCODE THE FORMAT

	FENTRY	(LDI)
	XMOVEI	T1,%LDI		;SETUP FOR IOLST CALLS
	MOVEM	T1,IOSUB(D)
	XMOVEI	T1,%SETAV	;SETUP FOR FIN CALL
	MOVEM	T1,IOFIN(D)
	PJRST	%LDIST		;DO LIST-DIRECTED INPUT SETUP

	FENTRY	(LDO)
	XMOVEI	T1,%LDO		;SETUP FOR IOLST CALLS
	MOVEM	T1,IOSUB(D)
	XMOVEI	T1,%OFIN	;SETUP FOR FIN CALL
	MOVEM	T1,IOFIN(D)
	PJRST	%LDOST		;DO LIST-DIRECTED OUTPUT SETUP

;INTERNAL FILE INPUT
;INTERNAL FILES ARE NOT REALLY FILES AT ALL - THEIR "RECORDS"
;ARE THE ELEMENT(S) OF A CHARACTER EXPRESSION, VARIABLE, OR ARRAY,
;GIVEN AS THE UNIT ARGUMENT IN A READ OR WRITE STATEMENT.
;THE FOLLOWING CODE SETS UP A FAKE DDB (OR USES ONE IF IT EXISTS
;ALREADY), SETS THE "DEVICE TYPE" TO INTERNAL FILE FOR %IREC
;CALLS, SETS THE FOROTS RECORD BUFFER POINTER/COUNT TO THE
;SPECIFIED CHARACTER VARIABLE OR ARRAY, AND STARTS UP FORMATTED I/O.

	FENTRY	(IFI)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;AND COPY ARGS
	XMOVEI	T1,[ASCIZ /READ/]
	MOVEM	T1,%IONAM	;Set statement name
	PUSHJ	P,IOARG		;Move args to A.XXX
	PUSHJ	P,SETDE		;SET UP DDB POINTING TO STRING
	MOVX	T1,IFIUNI	;STORE "UNIT"
	MOVEM	T1,%CUNIT	;[3341] FOR ERROR MSGS
	PUSHJ	P,IFINI		;INIT BUFFER PNTR
	XMOVEI	T1,IFIN		;SETUP FOR INTERNAL FILE FOR INPUT RECORDS
	MOVEM	T1,IOREC(D)
	PJRST	%IFSET		;GO ENCODE THE FORMAT

;INTERNAL FILE OUTPUT
;SAME AS INTERNAL FILE OUTPUT, BUT SETS UP FOR OUTPUT CALLS

	FENTRY	(IFO)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;AND COPY ARGS
	XMOVEI	T1,[ASCIZ /WRITE/]
	MOVEM	T1,%IONAM	;Set statement name
	PUSHJ	P,IOARG		;Move args to A.XXX
	PUSHJ	P,SETDE		;SET UP DDB POINTING TO STRING
	MOVX	T1,IFOUNI	;STORE "UNIT"
	MOVEM	T1,%CUNIT	;[3341] FOR ERROR MSGS
	PUSHJ	P,IFOINI	;INIT FOR INTERNAL FILE OUTPUT
	XMOVEI	T1,IFOUT	;SETUP FOR INTERNAL FILE FOR RECORD OUTPUT
	MOVEM	T1,IOREC(D)
	XMOVEI	T1,%SETAV	;AND NOTHING MUCH FOR FIN CALL
	MOVEM	T1,IOFIN(D)
	PJRST	%OFSET		;GO ENCODE THE FORMAT

IOARG:	SETZM	A.UNIT		;CLEAR BLOCK SO UNSPECIFIED ARGS ARE 0
	MOVE	T1,[A.UNIT,,A.UNIT+1]
	BLT	T1,IOARGS+MRWKWD
	HLRE	T3,-1(L)	;GET NEGATIVE COUNT

ARGLP:	LDB	T1,[POINTR ((L),RWKWD)] ;GET KWD OF ARGUMENT
	MOVE	T2,(L)		;GET ARG
	MOVEM	T2,IOARGS(T1)	;STORE ARG IN BLOCK
	ADDI	L,1		;INCR ARG PNTR
	AOJL	T3,ARGLP	;TRANSFER ENTIRE ARG BLOCK
	XMOVEI	T1,@A.END	;DO THE EA CALC FOR THE DELAYED ARGS
	MOVEM	T1,A.END	;END=
	XMOVEI	T1,@A.ERR
	MOVEM	T1,A.ERR	;ERR=
	XMOVEI	T1,@A.IOS
	MOVEM	T1,A.IOS	;IOSTAT=
	POPJ	P,		;DONE

	SEGMENT DATA

;COPIED ARGS, MUST BE CONSECUTIVE, IN ORDER ON KEYWORD NUMBER (IK.XXX)

IOARGS:	BLOCK	1		;(0) ZERO KEYWORD - SKIPPED ARG
A.UNIT: BLOCK	1		;(1) UNIT=		[ADDRESS OF VALUE]
A.FMT::	BLOCK	1		;(2) FMT=		[ADDRESS]
A.FMS::	BLOCK	1		;(3) FORMAT SIZE	[ADDRESS OF VALUE]
A.END::	BLOCK	1		;(4) END=		[ADDRESS]
A.ERR::	BLOCK	1		;(5) ERR=		[ADDRESS]
A.IOS::	BLOCK	1		;(6) IOSTAT=	[ADDRESS]
A.REC::	BLOCK	1		;(7) REC=		[ADDRESS]
A.NML::	BLOCK	1		;(10) NAMELIST ADDRESS [ADDRESS]
A.MTOP: BLOCK	1		;(11) REL OP OR MTA OP CODE [ADDRESS OF VALUE]
A.HSA::	BLOCK	1		;(12) ENCODE/DECODE ARRAY ADDRESS [ADDRESS]
A.HSL::	BLOCK	1		;(13) ENCODE/DECODE RECORD LENGTH [ADDRESS OF VALUE]
A.KRL:	BLOCK	1		;(14) KEY RELATIONAL [ADDRESS] 		;[5003]
A.KID:	BLOCK	1		;(15) KEY ID [ADDRESS OF VALUE] 	;[5003]
A.KVL:	BLOCK	1		;(16) KEY VALUE [ADDRESS OF VALUE] 	;[5003]
	BLOCK	1		;MORE ROOM IN RWKWD IF NEEDED
MRWKWD==.-IOARGS-1		;MAX LEGAL READ/WRITE ARG KWD NUMBER
IFN <<MRWKWD>B8-RWKWD>,<PRINTX ?READ/WRITE KEYWORD TABLE WRONG SIZE>

	SEGMENT CODE
FOUTGO:	XMOVEI	T1,[ASCIZ /WRITE/] ;Set statement name
	MOVEM	T1,%IONAM
	PUSHJ	P,IOARG		;MOVE ARGS TO A.XXX
	PUSHJ	P,CHKUNT	;Check unit number in range
	PUSHJ	P,SETFRM	;SET MODE TO ASCII IF ZERO
	PUSHJ	P,%SETOUT	;Get file opened for output.
	XMOVEI	T1,%OFIN	;AND SET OUTPUT OF FINAL RECORD
	MOVEM	T1,IOFIN(D)	;FOR FIN CALL
	XMOVEI	T1,%ORECS	;USE EXTERNAL I/O FOR RECORD OUTPUT
	MOVEM	T1,IOREC(D)
	SKIPN	ORBUF(D)	;ANY RECORD BUFFER YET?
	 PUSHJ	P,GETORB	;NO. CREATE ONE
	PUSHJ	P,ORINI		;INIT OUTPUT RECORD
	SKIPE	WTAB(D)		;RANDOM I/O?
	 JRST	FORMPW		;YES. MAP THE DESIRED RECORD
	SKIPN	A.REC		;NO. ILLEGAL IF RECORD NUMBER GIVEN
	 POPJ	P,
	$ACALL	CDR		;REPORT RANDOM I/O TO SEQ FILE

UOUTGO:	XMOVEI	T1,[ASCIZ /WRITE/] ;Set statement name
	MOVEM	T1,%IONAM
	PUSHJ	P,IOARG		;MOVE ARGS TO A.XXX
	PUSHJ	P,CHKUNT	;Check unit number in range
				; (Goes to ABORT% or ERR= if not).
	PUSHJ	P,SETUNF	;SET MODE TO BINARY IF ZERO
	PUSHJ	P,%SETOUT	;Get file opened for output.
	SKIPE	WTAB(D)		;RANDOM I/O?
	 PJRST	UORMPW		;YES. MAP THE DESIRED RECORD
	SKIPN	A.REC		;ILLEGAL IF RECORD NUMBER SPECIFIED
	 POPJ	P,
	$ACALL	CDR		;REPORT RANDOM I/O TO SEQ FILE


FINGO:	XMOVEI	T1,[ASCIZ /READ/]
	MOVEM	T1,%IONAM
	PUSHJ	P,IOARG		;MOVE ARGS TO A.XXX
	PUSHJ	P,CHKUNT	;Check unit number in range
	MOVE	T1,%CUNIT	;GET UNIT #
	CAME	T1,[RRUNIT]	;REREAD?
	 JRST	INGO1		;No
	MOVE	T1,U.RERD	;GET REREAD UNIT
	CAMN	T1,[RRUNIT]	;IS THERE ONE?
	 $ACALL	RBR		;NO. ?REREAD not preceded by READ
	MOVEM	T1,%CUNIT	;YES. USE IT
	MOVE	U,%DDBTA(T1)	;GET UDB ADDR
	MOVEM	U,%UDBAD	;WE HAVE STARTED AN I/O STATEMENT
	MOVE	D,DDBAD(U)	;GET DDB ADDR
	PUSHJ	P,%SETIN	;Get file opened for input.
	XMOVEI	T1,%IRECS	;USE EXTERNAL I/O FOR INPUT RECORDS
	MOVEM	T1,IOREC(D)
	PJRST	REREAD		;YES. POINT TO LAST RECORD

INGO1:	PUSHJ	P,SETFRM	;SET MODE TO ASCII IF ZERO
	PUSHJ	P,%SETIN	;Get file opened for input
	XMOVEI	T1,%IRECS	;USE EXTERNAL I/O FOR INPUT RECORDS
	MOVEM	T1,IOREC(D)
	SKIPE	WTAB(D)		;RANDOM I/O?
	 JRST	CHKRAN		;YES. GO MAP THE RECORD
	SKIPN	A.REC		;ILLEGAL IF ANY RECORD NUMBER GIVEN
	 JRST	INSEQ		;OK. GO READ A RECORD
	$ACALL	CDR		;REPORT RANDOM I/O TO SEQ FILE

CHKRAN:	PUSHJ	P,FIRMPW	;MAP THE DESIRED RECORD
INSEQ:	PUSHJ	P,%IREC		;GO READ A RECORD
	MOVE	T1,%CUNIT	;SAVE UNIT NUMBER FOR REREAD
	MOVEM	T1,U.RERD
	POPJ	P,

UINGO:	XMOVEI	T1,[ASCIZ /READ/]
	MOVEM	T1,%IONAM
	PUSHJ	P,IOARG		;MOVE ARGS TO A.XXX
	PUSHJ	P,CHKUNT	;Check unit number in range
				; (Goes to ABORT% or ERR= if not).
	PUSHJ	P,SETUNF	;SET MODE TO BINARY IF ZERO
	PUSHJ	P,%SETIN	;Get file opened for input.
	SKIPE	WTAB(D)		;RANDOM I/O?
	 JRST	UIRMPW		;YES. MAP THE DESIRED RECORD
	SKIPN	A.REC		;ILLEGAL IF RECORD NUMBER GIVEN
	 POPJ	P,
	$ACALL	CDR		;REPORT RANDOM I/O TO SEQ FILE

;Routine to check UNIT= to see if unit number is in range
;Call:
;	PUSHJ	P,CHKUNT
;	<return here if ok>
;If unit is out of range and ERR= or IOSTAT= was specified,
;  the program returns to the appropriate place.
;Otherwise, the error message is typed and the program is aborted.
;Uses T1,T2

CHKUNT:	HRRE	T2,@A.UNIT	;GET UNIT
	MOVEM	T2,%CUNIT	;SAVE AS CURRENT UNIT
	JUMPL	T2,NEGUNT	;GO CHECK IF NEGATIVE
	CAILE	T2,MAXUNIT	;IF UNIT BEYOND RANGE OF DDBTAB
	 $ACALL	IUN		;ILLEGAL UNIT NUMBER
	POPJ	P,		;OK

NEGUNT:	CAMGE	T2,[MINUNIT]	;RANGE CHECK. BELOW NEGATIVE UNITS
	 $ACALL	IUN		;ILLEGAL UNIT NUMBER
	HRRZ	T3,%UNNAM(T2)	;NEGATIVE, GET THE REAL NAME
	XMOVEI	T3,(T3)		;GET EXTENDED ADDR
	MOVEM	T3,%IONAM	;SAVE IT
	POPJ	P,		;Ok, return

;HERE FROM IOLST% OR FIN% WHEN I/O IS COMPLETE

%OFIN::	PUSHJ	P,%OREC		;OUTPUT THE RECORD
%SETAV:	MOVE	T1,%ERIOS	;GET 2ND ERROR NUMBER OR ZERO
	SKIPE	T2,A.IOS	;IOSTAT VARIABLE TO DEFINE?
	 MOVEM	T1,@T2		;YES. DEFINE IT
	MOVE	T1,%UDBAD	;[4161] GET UDB ADDRESS
	SETZM	%UDBAD		;[4161] NOW NO I/O IN PROGRESS
	JUMPL	T1,%POPJ	;[4161] IF IT WAS NEG, NOT A REAL UDB POINTER
	SKIPN	T2,AVAR(D)	;IS THERE AN ASSOCIATE VARIABLE?
	 POPJ	P,		;NO
	LOAD	T1,INDX(D)	;[5003] GET DEVICE TYPE
	CAIN	T1,DI.RMS	;[5003] RMS FILE?
	 PJRST	%RMASV		;[5003] YES, GO HANDLE ASSOCVAR
	MOVE	T1,CREC(D)	;GET CURRENT RECORD NUMBER
	ADDI	T1,1		;POINT TO NEXT ONE
	MOVEM	T1,(T2)		;There is one, store next record number
	POPJ	P,		;DONE. RETURN TO USER PROG

;ROUTINE TO SET UP A DDB FOR ENCODE/DECODE/IFI/IFO

SETDE:	SKIPE	U,%EDDB		;DDB ALREADY CREATED?
	 JRST	CLRDE		;YES. USE IT

	MOVEI	T1,ULEN		;Get length of unit block
	PUSHJ	P,%GTBLK
	 $ACALL	MFU		;[4131] CAN'T
	MOVE	U,T1		;Point U to it
	MOVEM	U,%EDDB		;Save for use on next ENCODE/DECODE
	MOVEI	T1,DLEN		;GET LENGTH OF DDB
	PUSHJ	P,%GTBLK	;GET AN EMPTY DDB
	 $ACALL	MFU		;[4131] CAN'T
	MOVEI	D,(T1)		;POINT D TO IT
	MOVEM	D,DDBAD(U)	;Remember it in the unit block
	MOVX	T1,ENCUNI	;[4131] GET ENCODE UNIT NUMBER
	STORE	T1,UNUM(U)	;[4131] SAVE IN UDB SO IT WON'T BE TOSSED

	MOVEI	T1," "		;PAD WITH SPACES
	STORE	T1,PADCH(U)
	MOVEI	T1,IBPW		;GET BYTES/WORD
	MOVEM	T1,BPW(D)	;SAVE IT IN DDB
	MOVE	T1,[ASCII /     /] ;GET A WORD OF SPACES
	MOVEM	T1,SPCWD(D)	;SAVE IT ALSO
	MOVEI	T1,(POINT 7,0,34) ;7-BIT BYTE POINTER
	STORE	T1,BYTPT(D)	;SAVE IT
	MOVEI	T1,BL.ZERO	;BZ FOR DECODE AND IFI
	STORE	T1,BLNK(U)

CLRDE:	MOVEM	U,%UDBAD	;FLAG WE'VE STARTED I/O
	MOVE	D,DDBAD(U)	;GET DDB ADDR
	POPJ	P,

;ROUTINES TO CONVERT POSITIONAL ARG BLOCKS TO KEYWORD ARG BLOCKS
	
FMTCNV:	LDB	T1,[POINTR ((L),ARGKWD)] ;GET KWD FIELD OF FIRST ARG
	JUMPN	T1,%POPJ	;NONZERO, NEW-STYLE CALL

	HLRE	T2,-1(L)	;GET ARG COUNT
	CAMLE	T2,[-4]		;AT LEAST 4 ARGS?
	  JRST	IOCNV1		;NO, SKIP /FMT
	MOVEI	T1,IK.FMT	;GET KWD NUMBER FOR /FMT
	DPB	T1,[POINTR (3(L),ARGKWD)] ;STORE IN LOCAL ARG LIST

	CAMLE	T2,[-5]		;AT LEAST 5 ARGS?
	  JRST	IOCNV1		;NO, SKIP FORMAT SIZE
	MOVEI	T1,IK.FMS	;GET KWD NUMBER FOR FORMAT SIZE
	DPB	T1,[POINTR (4(L),ARGKWD)] ;STORE IN LOCAL ARG LIST

IOCNV1:	CAMLE	T2,[-6]		;AT LEAST 6 ARGS?
	  JRST	IOCNV2		;NO, SKIP /REC
	MOVEI	T1,IK.REC	;GET KWD NUMBER FOR /REC
	DPB	T1,[POINTR (5(L),ARGKWD)] ;STORE IN LOCAL ARG LIST

IOCNV2:	MOVEI	T1,IK.UNIT	;GET KWD NUMBER FOR /UNIT
	DPB	T1,[POINTR ((L),ARGKWD)] ;STORE IN LOCAL ARG LIST

IOCNV3:	CAMLE	T2,[-2]		;AT LEAST 2 ARGS?
	  POPJ	P,		;NO, DONE
	MOVEI	T1,IK.END	;GET KWD NUMBER FOR /END
	DPB	T1,[POINTR (1(L),ARGKWD)] ;STORE IN LOCAL ARG LIST

	CAMLE	T2,[-3]		;AT LEAST 3 ARGS?
	  POPJ	P,		;NO, DONE
	MOVEI	T1,IK.ERR	;GET KWD NUMBER FOR /ERR
	DPB	T1,[POINTR (2(L),ARGKWD)] ;STORE IN LOCAL ARG LIST

	POPJ	P,		;DONE


UNFCNV:	LDB	T1,[POINTR ((L),ARGKWD)] ;GET KWD FIELD OF FIRST ARG
	JUMPN	T1,%POPJ	;NONZERO, NEW-STYLE CALL
	HLRE	T2,-1(L)	;GET ARG COUNT
	JRST	IOCNV1


NMLCNV:	LDB	T1,[POINTR ((L),ARGKWD)] ;GET KWD FIELD OF FIRST ARG
	JUMPN	T1,%POPJ	;NONZERO, NEW-STYLE CALL

	HLRE	T2,-1(L)	;GET ARG COUNT
	CAMLE	T2,[-4]		;AT LEAST 4 ARGS?
	  JRST	IOCNV2		;NO, NO NAMELIST ADDRESS
	MOVEI	T1,IK.NML	;GET KWD NUMBER FOR NAMELIST
	DPB	T1,[POINTR (3(L),ARGKWD)] ;STORE IN LOCAL ARG LIST
	JRST	IOCNV2		;GO DO STANDARD ARGS
ENCCNV:	LDB	T1,[POINTR ((L),ARGKWD)] ;GET KWD FIELD OF FIRST ARG
	JUMPN	T1,%POPJ	;NONZERO, NEW-STYLE CALL

	MOVEI	T1,IK.HSL	;GET KWD NUMBER FOR STRING LENGTH
	DPB	T1,[POINTR ((L),ARGKWD)] ;STORE IN LOCAL ARG LIST

	HLRE	T2,-1(L)	;GET ARG COUNT
	CAMLE	T2,[-4]		;AT LEAST 4 ARGS?
	  JRST	IOCNV3		;NO, SKIP /FMT
	MOVEI	T1,IK.FMT	;GET KWD NUMBER FOR /FMT
	DPB	T1,[POINTR (3(L),ARGKWD)] ;STORE IN LOCAL ARG LIST

	CAMLE	T2,[-5]		;AT LEAST 5 ARGS?
	  JRST	IOCNV3		;NO, SKIP FORMAT SIZE
	MOVEI	T1,IK.FMS	;GET KWD NUMBER FOR FORMAT SIZE
	DPB	T1,[POINTR (4(L),ARGKWD)] ;STORE IN LOCAL ARG LIST

	CAMLE	T2,[-6]		;AT LEAST 6 ARGS?
	  JRST	IOCNV3		;NO, SKIP STRING ADDRESS
	MOVEI	T1,IK.HSA	;GET KWD NUMBER FOR STRING ADDRESS
	DPB	T1,[POINTR (5(L),ARGKWD)] ;STORE IN LOCAL ARG LIST
	JRST	IOCNV3		;GO DO STANDARD ARGS


MTCNV:	LDB	T1,[POINTR ((L),ARGKWD)]	;GET KWD FIELD OF FIRST ARG
	JUMPN	T1,%POPJ	;NONZERO, NEW-STYLE CALL

	HLRE	T2,-1(L)	;GET ARG COUNT
	CAMLE	T2,[-4]		;AT LEAST 4 ARGS?
	  JRST	IOCNV2		;NO
	MOVEI	T1,IK.MTOP	;GET KWD NUMBER FOR MT OP CODE
	DPB	T1,[POINTR (3(L),ARGKWD)] ;STORE IN LOCAL ARG LIST
	JRST	IOCNV2		;GO CONVERT UNIT, ERR, END

;GETS A FRESH UDB AND DDB IF ONE DOESN'T ALREADY EXIST.
;IF RANDOM I/O, COMPLAINS, SINCE IT'S NECESSARY TO DO
;AN OPEN STATEMENT TO ESTABLISH RECORDSIZE.

GETD:	SETZM	O.KEY		;[5000]
	SKIPE	A.REC		;TRYING TO DO RANDOM I/O?
	 $ACALL	RR1		;YES. MUST SETUP RECORDSIZE IN OPEN!

	MOVEI	T1,ULEN		;Get length of unit block
	PUSHJ	P,%GTBLK	;Allocate it
	 $ACALL	MFU		;[4131] CAN'T
	MOVE	U,T1
	MOVEI	T1,DLEN		;GET LENGTH OF DDB
	PUSHJ	P,%GTBLK	;ALLOCATE IT
	 $ACALL	MFU		;[4131] CAN'T
	MOVE	D,T1		;SAVE IN D
	MOVEM	T1,DDBAD(U)	;SAVE DDB ADDR
	MOVE	T1,%CUNIT	;GET UNIT BACK
	STORE	T1,UNUM(U)	;SAVE UNIT NUMBER
	PJRST	%OPENX		;OPEN THE DDB

SETUNF:	MOVE	T1,%CUNIT	;GET UNIT NUMBER
	SKIPN	U,%DDBTA(T1)	;GET UDB ADDR
	 PUSHJ	P,GETD		;NONE. ESTABLISH A NEW ONE
	MOVEM	U,%UDBAD	;WE HAVE STARTED AN I/O STATEMENT
	MOVE	D,DDBAD(U)	;GET DDB ADDR
	LOAD	T1,FORM(D)	;GET FORM=
	JUMPN	T1,CHKUNF	;GOT ONE ALREADY
	MOVEI	T1,MD.BIN	;BINARY IS DEFAULT FOR UNFORMATTED
	STORE	T1,MODE(D)	;SAVE IT
	MOVEI	T1,FM.UNF	;SET FORM='UNFORMATTED'
	STORE	T1,FORM(D)
	POPJ	P,

CHKUNF:	CAIE	T1,FM.UNF	;UNFORMATTED?
	 SETOM	FUMXD(D)	;NO. SET MIXED-FORM FLAG
	POPJ	P,

SETFRM:	MOVE	T1,%CUNIT	;GET UNIT NUMBER
	SKIPN	U,%DDBTA(T1)	;GET UDB ADDR
	 PUSHJ	P,GETD		;NONE. ESTABLISH A NEW ONE
	MOVEM	U,%UDBAD	;WE HAVE STARTED AN I/O STATEMENT
	MOVE	D,DDBAD(U)	;GET DDB ADDR
	LOAD	T1,FORM(D)	;GET FORM=
	JUMPN	T1,CHKFRM	;GOT ONE ALREADY
	MOVEI	T1,MD.ASC	;DEFAULT IS ASCII
	STORE	T1,MODE(D)	;SAVE IT
	MOVEI	T1,FM.FORM	;SET FORM='FORMATTED'
	STORE	T1,FORM(D)
	POPJ	P,

CHKFRM:	CAIE	T1,FM.FORM	;FORMATTED?
	 SETOM	FUMXD(D)	;NO. SET MIXED-FORM FLAG
	POPJ	P,

	SUBTTL	BYTE I/O

	COMMENT	&

%IBYTE and %OBYTE are the basic routines for formatted I/O; they read or write
one byte in the current record.  %RxPOS returns the current position (column
number) within a record. %SxPOS sets the current position. %IREC reads the next
record from the file.  %OREC writes a record into the file.

Each open file has a record buffer which holds the current record.  (This makes
T format work and makes REREAD easier.)  There is one record buffer per open
file per direction.

Record buffer format:

Input:

	IRBEG			  IRPTR
	 v			   v
   --------------------------------------------------------------------
   !    !///////////////////////////!///////////////!                 !
   --------------------------------------------------------------------
				     <--- IRCNT ---->
         <---------------- IRLEN ------------------->
         <-------------------------- IRSIZ -------------------------->


Output:


	ORBEG			  ORPTR
	 v			   v
   --------------------------------------------------------------------
   !    !///////////////////////////!///////////////!                 !
   --------------------------------------------------------------------
				     <------------ ORCNT ------------>
         <---------------- ORLEN* ------------------>
         <-------------------------- ORSIZ -------------------------->

(*note:  on output, ORLEN is not kept up to date by OBYTE, since normally
ORPTR is at the end of the record so ORLEN changes every character.  ORLEN
is correct immediately after any positioning format.)

	&
;ROUTINE TO READ SINGLE BYTE
;RETURN: T1 = NEXT BYTE FROM INPUT RECORD
;DESTROYS NO ACS EXCEPT T1
;NOTE: IRCNT GOING NEGATIVE IS A LEGAL CONDITION. IT MERELY
;MEANS THAT WE ARE BEYOND THE END OF THE RECORD. T-FORMAT AND
;X-FORMAT WILL SET IT NEGATIVE IF THEY GO BEYOND THE END OF
;THE RECORD.

%IBYTE:	SOSGE	IRCNT(D)	;DECREMENT BYTE COUNT
	  JRST	EOR		;NONE LEFT, END OF BUFFER
	ILDB	T1,IRPTR(D)	;GET BYTE FROM BUFFER
	POPJ	P,		;DONE

EOR:	IBP	IRPTR(D)	;KEEP THE PNTR IN SYNCH FOR ADJBP
	MOVEI	T1," "		;EXTEND SHORT RECORDS WITH TRAILING SPACES
	POPJ	P,		;RETURN


;%IMBYT - READS MULTIPLE BYTES FROM THE RECORD BUFFER
;ARGS:	T0 = # CHARS TO READ, MUST BE .LE. DESTINATION SIZE
;	T3 = SIZE OF DESTINATION IN BYTES
;	T4 = BYTE POINTER OF DESTINATION

%IMBYT:	CAIN	T3,1		;ONE BYTE?
	 JRST	IMONE		;YES. DO IT WITH %IBYTE
	MOVE	T1,T0		;GET COUNT
	ADJBP	T1,IRPTR(D)	;GET UPDATED BYTE POINTER
	EXCH	T1,IRPTR(D)	;SAVE UPDATED ONE, GET OLD ONE AGAIN
	MOVN	T2,T0		;GET NEG COUNT OF CHARS TO READ
	ADDB	T2,IRCNT(D)	;UPDATE RECORD BYTE COUNT
	JUMPGE	T2,IMOK		;IF CHARS LEFT .GE. # TO READ, OK
	ADD	T0,IRCNT(D)	;SHORTEN # BYTES WE GET BY COUNT BEYOND RECORD
	CAIG	T0,0		;IF COUNT IS .LE. 0
	 SETZB	T0,T1		;NO SOURCE
IMOK:	EXTEND	T0,[EXP MOVSLJ," "] ;FILL WITH SPACES
	 $SNH			;SHOULD NEVER TRUNCATE
	POPJ	P,

IMONE:	PUSHJ	P,%IBYTE	;GET A BYTE
	IDPB	T1,T4		;STORE IT
	POPJ	P,

;%CDBO - CONVERT DECIMAL TO BINARY OFFSET
;READS CHARACTERS FROM THE RECORD BUFFER AND CONVERTS THEM TO BINARY
;
;ARGS:	 T0 = NUMBER OF CHARACTERS TO READ (MAX=^D21)
;
;SKIP RETURNS IF ALL CHARACTERS WERE DIGITS.
;NON-SKIP RETURNS IF A NON-DIGIT WAS ENCOUNTERED,
;RECORD POINTER/COUNT LEFT AT OFFENDING CHARACTER.
;
;RETURN: T0 = NUMBER OF CHARACTERS LEFT
;	 T1 = OFFENDING CHARACTER, IF NON-SKIP RETURN
;	 T3,T4 = 2-WORD BINARY INTEGER

%CDBO:	CAIE	T0,1		;ONE CHARACTER?
	 JRST	CDBONE		;YES. GO READ IT WITH %IBYTE

	CAILE	T1,IRCNT(D)	;ENOUGH CHARS IN RECORD?
	 JRST	CDBTRC		;NO. TRUNCATE INPUT
	MOVE	T1,T0		;COPY THE COUNT
	ADJBP	T1,IRPTR(D)	;GET UPDATED POINTER
	EXCH	T1,IRPTR(D)	;STORE UPDATED POINTER, GET OLD ONE BACK
	MOVN	T2,T0		;GET NEGATIVE COUNT
	ADDM	T2,IRCNT(D)	;UPDATE THE COUNT
	EXTEND	T0,[EXP <CVTDBO>,-60] ;CONVERT TO BINARY
	 JRST	CDBBC		;BAD CHAR. GO POINT TO IT
	AOS	(P)		;SUCCESS. SKIP RETURN
	POPJ	P,

CDBBC:	MOVE	T1,T0		;COPY LEFTOVER COUNT
	ADDM	T1,IRCNT(D)	;MODIFY THE RECORD COUNT
	ADJBP	T1,IRPTR(D)	;AND THE POINTER
	MOVEM	T1,IRPTR(D)	;SAVE UPDATED POINTER
	LDB	T1,T1		;GET THE OFFENDING CHARACTER
	POPJ	P,		;NON-SKIP RETURN

CDBTRC:	SKIPG	IRCNT(D)	;ANY CHARS LEFT IN RECORD?
	 SOJA	T1,%IBYTE	;NO. JUST RETURN A SPACE
	SUB	T0,IRCNT(D)	;GET # CHARS LEFT
	MOVE	T5,T0		;SAVE IT FOR LATER
	MOVE	T0,IRCNT(D)	;USE RECORD COUNT AS INPUT COUNT
	SETZM	IRCNT(D)	;AND SET RECORD COUNT TO ZERO
	MOVE	T1,T0		;COPY COUNT
	ADJBP	T1,IRPTR(D)	;UPDATE RECORD POINTER
	EXCH	T1,IRPTR(D)	;SVAE UPDATED ONE, GET ORIGINAL POINTER
	EXTEND	T0,[EXP <CVTDBO>,-60] ;CONVERT THE STRING TO BINARY
	 PUSHJ	P,CDBBC		;BAD CHARACTER. POINT TO IT
	ADD	T0,T5		;ADD LEFTOVER COUNT BEYOND RECORD
	POPJ	P,		;NON-SKIP RETURN

CDBONE:	PUSHJ	P,%IBYTE	;GET A BYTE FROM THE RECORD
	CAIG	T1,"9"		;IS IT A DIGIT?
	 CAIGE	T1,"0"
	  POPJ	P,		;NO. NON-SKIP RETURN
	SUBI	T1,60		;YES. CONVERT TO BINARY
	SETZ	T3,		;CLEAR HIGH WORD
	MOVE	T4,T1		;PUT IT IN THE CORRECT AC
	SETZ	T0,		;SET COUNT TO 0
	AOS	(P)		;SKIP RETURN
	POPJ	P,

;ROUTINE TO REREAD CURRENT BYTE
;RETURN: T1 = BYTE THAT IBYTE RETURNED ON MOST RECENT CALL
;DESTROYS NO ACS EXCEPT T1

%IBYTC:	SKIPE	IRLEN(D)	;NULL RECORD?
	 SKIPGE	IRCNT(D)	;NO. PAST RECORD END?
	  SKIPA	T1,[" "]	;YES, RETURN SPACE
	LDB	T1,IRPTR(D)	;NO, RETURN CURRENT CHAR
	POPJ	P,		;RETURN



;ROUTINE TO BACK UP INPUT BYTE POINTER
;NO ARGS
;ON RETURN, IBYTE WILL BE BACKSPACED ONE CHARACTER
;CAN BE CALLED REPEATEDLY

%IBACK:	MOVNI	T1,1		;ADJUST POINTER
	ADJBP	T1,IRPTR(D)	;BACK 1
	MOVEM	T1,IRPTR(D)	;SAVE IT
	AOS	IRCNT(D)	;INCREMENT COUNT OF CHARS LEFT
	POPJ	P,
;ROUTINE TO PUT SINGLE BYTE IN FILE
;ARGS:	 T1 = BYTE
;DESTROYS NO ACS

%OBYTE:
LOBYTE:	SETZM	ORPOS(D)	;FLAG THAT WE HAVE DEPOSITED CHARS HERE
	SOSGE	ORCNT(D)	;DECREMENT BYTE COUNT
	  JRST	OEXP		;BUFFER FULL, GO EXPAND IT
	IDPB	T1,ORPTR(D)	;STORE BYTE IN BUFFER
	POPJ	P,		;DONE

OEXP:	SKIPE	RSIZE(D)	;ANY RECORDSIZE TO LIMIT RECORD?
	 JRST	TRUNC		;YES, TRUNCATE RECORD INSTEAD OF EXPANDING
	AOS	ORCNT(D)	;NO. CLEAR -1 FROM %OBYTE
	PUSHJ	P,%PUSHT	;SAVE T ACS
	MOVM	T3,ORCNT(D)	;USE DISTANCE FROM RECORD AS MINIMUM
	PUSHJ	P,EXPORB	;EXPAND RECORD BUFFER
	PUSHJ	P,%POPT		;RESTORE T ACS
	JRST	LOBYTE		;GO STORE BYTE IN EXPANDED BUFFER

TRUNC:	IBP	ORPTR(D)	;KEEP POINTER IN SYNCH FOR POSITIONING
	MOVE	T0,ORCNT(D)	;GET THE COUNT
	CAMN	T0,[-1]		;ONLY COMPLAIN THE FIRST OVERRUN
	 $ECALL	ETL		;Attempt to WRITE beyond fixed-length record
	POPJ	P,

;%OMBYT - ROUTINE TO PUT A STRING OF BYTES TO THE BUFFER
	
;ARGS:
;	T0=source count
;	T1/T2=source string byte-pointer
;
;RETURNS:
;
;	T1/T2=byte-pointer to last byte moved
;	T3/T4/T5=trash

%OMSPC:	MOVEI	T1," "		;LOAD A SPACE
%OMPAD:	CAIN	T3,1		;ONE SPACE?
	 JRST	%OBYTE		;YES. DO IT WITH %OBYTE
	MOVEM	T1,%MSPAD	;SAVE PADDING CHARACTER
	SETZB	T0,T1		;NO SOURCE (PAD ONLY)
	JRST	OMCOM		;JOIN COMMON CODE

%OMBWP:	CAIN	T0,1		;ONE BYTE?
	 CAIE	T3,1		;AND ONE BYTE DESTINATION?
	  JRST	OMCOM		;NO. DO MOVSLJ
	JRST	OMONE		;YES. DO IT WITH %OBYTE

%OMBYT:	CAIN	T0,1		;ONE BYTE?
	 JRST	OMONE		;YES. DO IT WITH %OBYTE
	MOVEI	T5," "		;USE SPACE FOR PAD
	MOVEM	T5,%MSPAD
	MOVE	T3,T0		;SET DESTINATION COUNT=SOURCE COUNT
OMCOM:	MOVN	T5,T3		;MODIFY COUNT BEFORE ANYTHING ELSE
	ADDB	T5,ORCNT(D)	;SINCE T3 WILL BE ZERO AFTER MOVSLJ
	JUMPGE	T5,OMOK		;ENOUGH ROOM?
	SKIPN	RSIZE(D)	;RECORDSIZE?
	 JRST	OMEXP		;NO. EXPAND BUFFER, MOVE STRING

OMFRS:	MOVE	T4,T3		;COPY THE OFFSET
	ADJBP	T4,ORPTR(D)	;POINT BEYOND RECORD
	EXCH	T4,ORPTR(D)	;SAVE THE UPDATED POINTER, GET OLD ONE
	ADD	T3,ORCNT(D)	;SHORTEN DEST COUNT BY COUNT PAST RECORD
	JUMPE	T3,OMRE		;IF EXACTLY 0 CHARS LEFT, JUST REPORT ERROR
	JUMPL	T3,OMNCHR	;NOTHING TO TRANSFER IF .LE. 0
	MOVE	T0,T3		;SET SOURCE=DEST
	EXTEND	T0,%MSLJ	;MOVE THE STRING
	 $SNH			;SHOULD NEVER TRUNCATE
OMRE:	$ECALL	ETL		;ATTEMPT TO WRITE BEYOND FIXED-LENGTH RECORD
OMNCHR:	SETOM	ORPOS(D)	;FLAG WE HAVE NOT PUT CHARS HERE
	POPJ	P,

OMEXP:	PUSHJ	P,%PUSHT	;SAVE T ACS
	PUSHJ	P,EXPORB	;EXPAND BUFFER
	PUSHJ	P,%POPT		;RESTORE T ACS
OMOK:	MOVE	T4,T3		;GET COUNT AGAIN
	ADJBP	T4,ORPTR(D)	;GET UPDATED POINTER
	EXCH	T4,ORPTR(D)	;SAVE UPDATED ONE, GET OLD ONE BACK
	EXTEND	T0,%MSLJ	;MOVE THE STRING
	 $SNH			;TRUNCATION SHOULD NOT HAPPEN
	SETZM	ORPOS(D)	;FLAG WE HAVE PUT CHARS AT CURRENT POSITION
	POPJ	P,		;we are done, return

OMONE:	ILDB	T1,T1		;GET THE CHAR
	PJRST	%OBYTE		;OUTPUT IT

;%CBDO - CONVERT BINARY TO DECIMAL STRING, OUTPUT DIRECTLY
;INTO OUTPUT BUFFER. USES THE SAME TECHNIQUE AND RULES AS
;%OMBYT.
	
;ARGS:
;	T0/T1 = 2-word binary integer
;	T3 = destination byte count
;
;RETURNS:
;
;	T1-T5 = trash

%CBDO:	CAIN	T3,1		;ONE BYTE?
	 JRST	CBONE		;YES. DO IT WITH %OBYTE
	MOVN	T5,T3		;MODIFY COUNT BEFORE ANYTHING ELSE
	ADDB	T5,ORCNT(D)	;SINCE T3 WILL BE ZERO AFTER MOVSLJ
	JUMPGE	T5,CBOK		;ENOUGH ROOM?
	SKIPN	RSIZE(D)	;RECORDSIZE?
	 JRST	CBEXP		;NO. EXPAND BUFFER, MOVE STRING

	MOVE	T4,T3		;COPY THE OFFSET
	ADJBP	T4,ORPTR(D)	;POINT BEYOND RECORD
	EXCH	T4,ORPTR(D)	;SAVE THE UPDATED POINTER, GET OLD ONE
	ADD	T3,ORCNT(D)	;SHORTEN DEST COUNT BY COUNT PAST RECORD
	JUMPE	T3,CBRE		;IF EXACTLY 0 CHARS LEFT, JUST REPORT ERROR
	JUMPL	T3,CBNCHR	;NOTHING TO TRANSFER IF .LE. 0
	DMOVEM	T3,SAVE3	;SAVE # CHARS, BP
	MOVM	T5,ORCNT(D)	;GET # CHARS TRUNCATED
	DMOVE	T2,T0		;COPY INTEGER
	SETZB	T0,T1		;CLEAR HIGH WORDS
	MOVE	T4,%HIINT(T5)	;GET 2-WORD POWER OF TEN
	MOVE	T5,%LOINT(T5)
	DDIV	T0,T4		;TRUNCATE INTEGER
	DMOVE	T3,SAVE3	;GET BYTE COUNT, POINTER AGAIN
	TLO	T3,400000	;TURN ON LEADING PAD FLAG
	EXTEND	T0,[EXP <CVTBDO "0">,"0"] ;OUTPUT INTEGER, LEADING ZEROES
	 $SNH			;SHOULD ALWAYS SKIP	
CBRE:	$ECALL	ETL		;ATTEMPT TO WRITE BEYOND FIXED-LENGTH RECORD
CBNCHR:	SETOM	ORPOS(D)	;FLAG WE HAVE NOT PUT CHARS HERE
	POPJ	P,

CBEXP:	PUSHJ	P,%PUSHT	;SAVE T ACS
	PUSHJ	P,EXPORB	;EXPAND BUFFER
	PUSHJ	P,%POPT		;RESTORE T ACS
CBOK:	MOVE	T4,T3		;GET COUNT AGAIN
	ADJBP	T4,ORPTR(D)	;GET UPDATED POINTER
	EXCH	T4,ORPTR(D)	;SAVE UPDATED ONE, GET OLD ONE BACK
	TLO	T3,400000	;TURN ON LEADING PAD FLAG
	EXTEND	T0,[EXP <CVTBDO "0">,"0"] ;OUTPUT INTEGER, LEADING ZEROES
	 $SNH			;TRUNCATION SHOULD NOT HAPPEN
	SETZM	ORPOS(D)	;FLAG WE HAVE PUT CHARS AT CURRENT POSITION
	POPJ	P,		;we are done, return

CBONE:	ADDI	T1,"0"		;CONVERT DIGIT TO ASCII
	PJRST	%OBYTE		;OUTPUT IT

	SEGMENT	DATA

SAVE3:	BLOCK	1		;TEMP FOR SAVING CHAR COUNT

	SEGMENT	CODE
EXPIRB:	HRRZ	T1,IRBUF(D)	;GET OLD BUFFER PNTR-1
	ADDI	T1,1		;CORRECT IT
	MOVE	T2,IRBLN(D)	;GET OLD LENGTH IN BYTES
	PUSHJ	P,EXPRB		;EXPAND AND MOVE
	HRRZ	T2,IRBUF(D)	;GET OLD BUFFER ADDR-1
	SUBI	T2,-1(T1)	;GET OLD-NEW
	MOVN	T2,T2		;GET NEW-OLD
	ADDM	T2,IRPTR(D)	;MOVE PNTR TO NEW BUFFER
	SUBI	T1,1		;POINT AT PREVIOUS WORD
	HXL	T1,BYTPT(D)	;MAKE BYTE PNTR TO BEG BUFFER
	MOVEM	T1,IRBUF(D)	;STORE NEW BUFFER ADDR
	MOVE	T4,IRBLN(D)	;GET OLD SIZE AGAIN
	MOVEM	T3,IRBLN(D)	;STORE NEW SIZE
	SUB	T3,T4		;RETURN SIZE LEFT IN T3
	ADDM	T3,IRCNT(D)	;ADD TO CURRENT COUNT
	MOVE	T1,ROFSET(D)	;GET OFFSET TO REAL DATA BEG
	ADJBP	T1,IRBUF(D)	;CALC NEW PNTR
	MOVEM	T1,IRBEG(D)	;SAVE IT
	MOVE	T1,IRBLN(D)	;GET RECORD BUFFER SIZE
	SUB	T1,ROFSET(D)	;AND REDUCE IT
	MOVEM	T1,IRSIZ(D)	;AND SAVE IT
	POPJ	P,

GETIRB:	PUSHJ	P,GETRB		;GET A NEW BUFFER
	SUBI	T1,1		;POINT TO PREVIOUS WORD
	HXL	T1,BYTPT(D)	;MAKE BYTE PNTR TO BEG BUFFER
	MOVEM	T1,IRBUF(D)	;SAVE BUFFER PNTR
	MOVEM	T3,IRBLN(D)	;SAVE FIXED COUNT
	MOVE	T1,ROFSET(D)	;GET OFFSET TO REAL DATA BEG
	ADJBP	T1,IRBUF(D)	;CALC NEW PNTR
	MOVEM	T1,IRBEG(D)	;SAVE IT
	MOVE	T1,IRBLN(D)	;GET RECORD BUFFER SIZE
	SUB	T1,ROFSET(D)	;AND REDUCE IT
	MOVEM	T1,IRSIZ(D)	;AND SAVE IT
	POPJ	P,

EXPORB:	HRRZ	T1,ORBUF(D)	;GET OLD BUFFER PNTR-1
	ADDI	T1,1		;CORRECT IT
	MOVE	T2,ORBLN(D)	;GET OLD LENGTH IN BYTES
	PUSHJ	P,EXPRB		;EXPAND AND MOVE
	HRRZ	T2,ORBUF(D)	;GET OLD BUFFER ADDR
	SUBI	T2,-1(T1)		;GET OLD-NEW
	MOVN	T2,T2		;GET NEW-OLD
	ADDM	T2,ORPTR(D)	;MOVE PNTR TO NEW BUFFER
	SUBI	T1,1		;POINT TO PREVIOUS WORD
	HXL	T1,BYTPT(D)	;MAKE BYTE PNTR TO BEG BUFFER
	MOVEM	T1,ORBUF(D)	;STORE NEW BUFFER ADDR
	MOVE	T4,ORBLN(D)	;GET OLD SIZE AGAIN
	MOVEM	T3,ORBLN(D)	;STORE NEW SIZE
	SUB	T3,T4		;GET DIFF
	ADDM	T3,ORCNT(D)	;ADD TO CURRENT COUNT
	MOVE	T1,ROFSET(D)	;GET OFFSET TO REAL DATA BEG
	ADJBP	T1,ORBUF(D)	;CALC NEW PNTR
	MOVEM	T1,ORBEG(D)	;SAVE IT
	MOVE	T1,ORBLN(D)	;GET RECORD BUFFER SIZE
	SUB	T1,ROFSET(D)	;AND REDUCE IT
	MOVEM	T1,ORSIZ(D)	;AND SAVE IT
	POPJ	P,

GETORB:	PUSHJ	P,GETRB		;GET A NEW BUFFER
	SUBI	T1,1		;POINT TO PREVIOUS WORD
	HXL	T1,BYTPT(D)	;MAKE IT A BYTE PNTR
	MOVEM	T1,ORBUF(D)	;SAVE BUFFER PNTR
	MOVEM	T3,ORBLN(D)	;SAVE COUNT
	MOVE	T1,ROFSET(D)	;GET OFFSET TO REAL DATA BEG
	ADJBP	T1,ORBUF(D)	;CALC NEW PNTR
	MOVEM	T1,ORBEG(D)	;SAVE IT
	MOVE	T1,ORBLN(D)	;GET RECORD BUFFER SIZE
	SUB	T1,ROFSET(D)	;AND REDUCE IT
	MOVEM	T1,ORSIZ(D)	;AND SAVE IT
	POPJ	P,

;EXPRB - ROUTINE TO EXPAND A RECORD BUFFER
;CALL:
;	T1 = ADDR OF OLD BUFFER
;	T2 = OLD LENGTH IN BYTES
;	T3 = MINIMUM ADDITIONAL SIZE IN BYTES
;RETURN:
;	T1 = ADDR OF START OF MOVED RECORD BUFFER
;	T2 = ADDR OF FIRST FREE WORD IN MOVED RECORD BUFFER
;	T3 = NUMBER OF BYTES IN MOVED RECORD BUFFER

EXPRB:	MOVE	T4,T2		;COPY OLD SIZE
	LSH	T4,1		;DOUBLE IT
	ADD	T4,T3		;ADD MINIMUM SIZE
	IDIV	T2,BPW(D)	;GET # WORDS IN OLD BUFFER
	MOVE	T3,T4		;COPY NEW SIZE
	IDIV	T3,BPW(D)	;GET # WORDS IN NEW BUFFER
	PUSHJ	P,%MVSPC	;MOVE TO BIGGER BUFFER, FILL WITH SPACES
	 $ACALL RTL		;[4131] CAN'T
	MOVEI	T1,(T1)		;LOCAL ADDR
	IMUL	T3,BPW(D)	;CONVERT NEW # WORDS TO CHARS
	POPJ	P,		;RETURN

;GETRB - GET A RECORD BUFFER
;RETURN:
;	T1 = ADDR OF RECORD BUFFER
;	T2 = COPY OF T1
;	T3 = SIZE IN BYTES


GETRB:	SKIPN	T1,FRSIZB(D)	;IF FIXED-LENGTH, USE IT
	 MOVEI	T1,LRECBF	;VARIABLE, USE MINIMUM SIZE
	ADD	T1,BPW(D)	;ROUND UP TO WORDS
	SUBI	T1,1
	IDIV	T1,BPW(D)	;GET # WORDS
	PUSHJ	P,%GTSPC	;GET BLOCK, FILL WITH SPACES
	 $ACALL	MFU		;[4131] CAN'T
	MOVE	T2,T1		;COPY ADDR
	SKIPN	T3,FRSIZB(D)	;GET LENGTH AGAIN
	 MOVEI	T3,LRECBF
	POPJ	P,

	SUBTTL	INPUT

;%IREC - INITIAL RECORD INPUT. SETS UP THE BUFFER (IF NECESSARY) AND
;GOES TO THE APPROPRIATE ROUTINE. CALLED ONLY FROM FINGO.
%IREC:	SKIPN	IRBUF(D)	;ANY BUFFER YET?
	 PUSHJ	P,GETIRB	;NO. ALLOCATE THE BUFFER
	SETOM	LSNUM(D)	;SET UP ILLEGAL LINE SEQUENCE NUMBER
	AOS	CREC(D)		;INCREMENT RECORD NUMBER
	LOAD	T1,INDX(D)	;GET DEV INDEX
	PJRST	IDSP(T1)	;DO DEVICE-DEPENDENT INPUT

;%IRECS IS THE SAME AS %IREC, EXCEPT IT IS ONLY CALLED FROM WITHIN
;A FORMAT (FOR "/" AND INDEFINITE REPEAT) AND FOR MULTIRECORD INPUT
;IN NAMELIST AND LIST-DIRECTED I/O.
%IRECS:	SETOM	LSNUM(D)	;SET UP ILLEGAL LINE SEQUENCE NUMBER
	AOS	CREC(D)		;INCREMENT RECORD NUMBER
	LOAD	T1,INDX(D)	;GET DEV INDEX
	PJRST	IDSPS(T1)	;DO DEVICE-DEPENDENT INPUT

;IRSET - CALLED AFTER READING THE DATA FOR ALL "EXTERNAL" DEVICES
;TO SET UP THE POINTER AND COUNT FOR READING WITH %IBYTE.

IRSET:	MOVE	T1,IRBEG(D)	;GET RECORD BUFFER PNTR
	MOVEM	T1,IRPTR(D)	;STORE INITIALIZED BYTE PTR
	SKIPE	IRCNT(D)	;ANY CHARS IN RECORD?
	 POPJ	P,		;YES. WE'RE DONE
	MOVE	T0,FLAGS(D)	;Get current DDB flags
	TXNE	T0,D%END	;ZERO CHARS. EOF ALSO?
	 $ACALL	EOF		;YES. REPORT IT AND DIE
	POPJ	P,		;NO. JUST A NULL RECORD

REREAD:	MOVE	T1,IRBEG(D)
	MOVEM	T1,IRPTR(D)
	MOVE	T1,IRLEN(D)	;REREAD. SETUP PNTR/COUNT WITH OLD DATA
	MOVEM	T1,IRCNT(D)
	JUMPN	T1,%POPJ	;NOT EOF IF WE HAVE CHARS
	MOVE	T0,FLAGS(D)
	TXNE	T0,D%END	;END OF FILE?
	 $ACALL	EOF		;YES. REPORT IT AND DIE
	POPJ	P,		;Return


;ALL DEVICE-DEPENDENT INPUT ROUTINES HAVE THE SAME CALLING SEQUENCE:
;ARGS:	 IRBEG = BYTE POINTER TO START OF RECORD BUFFER
;	 IRSIZ = NUMBER OF BYTES IN RECORD BUFFER
;RETURN: NEXT RECORD FROM FILE READ INTO RECORD BUFFER
;	 IRCNT = NUMBER OF BYTES FOUND IN RECORD BUFFER

IDSP:	JRST	TIREC	;TTY
	JRST	XIREC	;DISK
	JRST	XIREC	;MTA
	JRST	XIREC	;OTHER
IF20,<	JRST	XIREC	;[5003] REMOTE STREAM FILE
	JRST	%IRMS	;[5003] RMS FILE
> ;End IF20

IDSPS:	JRST	TIRECS	;TTY
	JRST	XIREC	;DISK
	JRST	XIREC	;MTA
	JRST	XIREC	;OTHER
IF20,<	JRST	XIREC	;[5003] REMOTE STREAM FILE
	JRST	%IRMS	;[5003] RMS RECORD INPUT
> ;End IF20

IF20,<

;TTY

;TIREC - FOR INITIAL INPUT, EOF IS ALWAYS CLEARED FOR TTY, SINCE IT
;IS DEFINED AS A LINE-BY-LINE EOF (IS NOT "STICKY").
;TIRECS - FOR "/" FORMAT, INDEFINITE REPEAT, AND MULTIRECORD INPUT,
;EOF (CONTROL-Z) IS STICKY, AND WILL GET AN EOF RETURN.
TIREC:	MOVX	T0,D%END	;CLEAR EOF FOR TTY'S
	ANDCAM	T0,FLAGS(D)
TIRECS:	PUSHJ	P,T20INP	;END= STAYS ON
	PJRST	IRSET		;AND RETURNS IMMEDIATELY IF EOF

T20INP:	SETZM	IRCNT(D)	;CLEAR CHAR COUNT IN CASE EOF
	SETZM	IRLEN(D)	;AND RECORD LENGTH
	MOVE	T0,FLAGS(D)	;JUST LEAVE IF EOF
	TXNE	T0,D%END
	 POPJ	P,
	TXNN	T0,D%SEOL+D%PDOL ;PREV CRLF OR DOLLAR FORMAT?
	 PUSHJ	P,%OCRLF	;NO. OUTPUT CRLF
	MOVX	T0,D%SEOL+D%PDOL ;NOW CLEAR THEM
	ANDCAM	T0,FLAGS(D)

	MOVEI	T1,.RDBRK	;SET TEXTI BLOCK LENGTH
	MOVEM	T1,TXIBLK+.RDCWB

	MOVX	T1,RD%CRF+RD%JFN+RD%BBG ;SUPPRESS CR, READ FROM JFNS, BFP GIVEN
	MOVEM	T1,TXIBLK+.RDFLG ;STORE FLAGS

	MOVE	T1,IJFN(D)	;GET JFN
	HRLI	T1,(T1)		;IN BOTH HALVES
	MOVEM	T1,TXIBLK+.RDIOJ ;STORE IT

	MOVE	T1,IRBEG(D)	;GET RECORD BUFFER PNTR
	MOVEM	T1,TXIBLK+.RDDBP ;STORE DEST BYTE POINTER

	MOVE	T1,IRSIZ(D)	;GET RECORD BUFFER LENGTH
	MOVEM	T1,TXIBLK+.RDDBC ;STORE DEST BYTE COUNT

	SETZM	TXIBLK+.RDBFP	;NO WAKEUP ON ^U, ^W EDITING
	MOVE	T1,G.PRP	;SET POINTER TO PROMPT STRING
	MOVEM	T1,TXIBLK+.RDRTY

	MOVEI	T1,TXIBRK	;POINT TO BREAK MASK
	MOVEM	T1,TXIBLK+.RDBRK ;STORE IT

TCONT:	MOVEI	T1,TXIBLK	;POINT TO BLOCK
	TEXTI%			;READ A LINE
	 JSHALT		;SHOULD NOT FAIL

	MOVE	T1,TXIBLK+.RDFLG ;GET TEXTI FLAGS
	TXNN	T1,RD%BTM	;INPUT TERMINATED BY BREAK CHAR?
	 JRST	TEXP		;NO, EXPAND BUFFER AND CONTINUE

	MOVX	T0,D%END	;Get flag to set if CTRL-Z seen.
	LDB	T1,TXIBLK+.RDDBP ;GET TERMINATING CHAR
	CAIE	T1,32		;^Z?
	 MOVX	T0,D%SEOL+D%PDOL ;NO. INSTEAD SUPPRESS NEXT LEADING EOL
	IORM	T0,FLAGS(D)

	SETZM	G.PRP		;CLEAR PROMPT STRING FOR NEXT TIME
	AOS	T3,TXIBLK+.RDDBC ;RETURN COUNT OF LEFTOVER BYTES IN BUFFER
				;DISCARDING BREAK CHARACTER
	MOVE	T1,IRSIZ(D)	;GET SIZE OF RECORD BUFFER
	SUBI	T1,(T3)		;CALC # CHARS IN RECORD
	MOVEM	T1,IRCNT(D)	;SAVE FOR INPUT
	MOVEM	T1,IRLEN(D)	;SAVE LENGTH
	POPJ	P,		;DONE

TEXP:	MOVE	T1,TXIBLK+.RDDBP ;GET UPDATED POINTER
	MOVEM	T1,IRPTR(D)	;SAVE FOR EXPANSION
	MOVE	T1,TXIBLK+.RDDBC ;GET UPDATED COUNT
	MOVEM	T1,IRCNT(D)	;SAVE FOR EXPANSION
	SETZ	T3,		;NO MINIMUM EXPANSION
	PUSHJ	P,EXPIRB	;EXPAND RECORD BUFFER
	MOVE	T1,IRBEG(D)
	MOVEM	T1,TXIBLK+.RDBFP ;SET NEW POINTER TO START OF BUFFER
	MOVE	T1,IRPTR(D)
	MOVEM	T1,TXIBLK+.RDDBP ;SET POINTER TO DEST STRING
	MOVE	T1,IRCNT(D)
	MOVEM	T1,TXIBLK+.RDDBC ;SET BYTE COUNT OF DEST STRING
	JRST	TCONT		;DO ANOTHER TEXTI TO CONTINUE INPUT
;STILL IF20

;TEXTI BREAK TABLE FOR STANDARD FORTRAN CHAR SET

TXIBRK:	1B<^O12>+1B<^O13>+1B<^O14>+1B<^O32> ;BREAK ON LF, VT, FF, ^Z
	0			;AND NOTHING ELSE
	0
	0


	SEGMENT	DATA

TXIBLK:	BLOCK	1+.RDBRK	;TEXTI ARG BLOCK

	SEGMENT	CODE

>;END IF20
IF10,<

TIREC:	MOVX	T0,D%END	;CLEAR EOF FOR TTY'S
	ANDCAM	T0,FLAGS(D)	;Store updated flags
TIRECS:	PUSHJ	P,T10INP	;DO TOPS-10 TTY INPUT
	PJRST	IRSET		;AND GO DO SETUP

T10INP:	SETZM	IRCNT(D)	;CLEAR CHAR COUNT IN CASE EOF
	SETZM	IRLEN(D)	;AND RECORD LENGTH
	MOVE	T0,FLAGS(D)	;ARE WE AT EOF?
	TXNE	T0,D%END
	 POPJ	P,		;YES. GO NO FURTHER
	TXNN	T0,D%SEOL+D%PDOL ;PREV CRLF OR DOLLAR FORMAT?
	 PUSHJ	P,%OCRLF	;NO. OUTPUT CRLF
	MOVX	T0,D%SEOL+D%PDOL ;SUPPRESS NEXT CRLF
	IORM	T0,FLAGS(D)

	MOVE	T1,IRBEG(D)	;GET POINTER
	MOVEM	T1,IRPTR(D)	;SAVE FOR TRANSFER
	MOVE	T1,IRSIZ(D)	;AND COUNT
	MOVEM	T1,IRCNT(D)

TLP0:	SOSL	TCNT(D)		;ANY MORE BYTES?
	 JRST	TLPX1		;NO. GET MORE
	PUSHJ	P,IMAP
	 JRST	DIEOR		;GOT EOF
	JRST	TLP0		;KEEP IN SYNCH

TLPX1:	ILDB	T1,TPTR(D)	;GET A CHAR
	JUMPE	T1,TLP0		;SKIP IT IF NULL
	JRST	TLPGTC		;USE IT IF NOT NULL

TLP:	SOSL	TCNT(D)		;ANY MORE BYTES?
	 JRST	TLPX2		;YES
	PUSHJ	P,IMAP		;NO
	 JRST	DIEOR		;GOT EOF
	JRST	TLP		;KEEP IN SYNCH!

TLPX2:	ILDB	T1,TPTR(D)	;GET A BYTE
TLPGTC:	CAIGE	T1," "		;CHECK FOR SPECIAL BYTE
	 JRST	TCHKEL		;SPECIAL
TDPB:	SKIPE	IRCNT(D)	;ROOM IN RECORD BUFFER?
	 JRST	TDPB2		;YES
	SETZ	T3,		;NO MINIMUM EXPANSION
	PUSHJ	P,EXPIRB	;NO. EXPAND RECORD BUFFER
	LDB	T1,TPTR(D)	;AND GET THE CHAR AGAIN

TDPB2:	SOS	IRCNT(D)	;DECR RECORD BYTE COUNT
	IDPB	T1,IRPTR(D)	;DEPOSIT BYTE IN RECORD BUFFER
	JRST	TLP		;BACK FOR MORE

TCHKEL:	CAIN	T1,15		;CARRIAGE RETURN?
	 JRST	TGOTCR		;YES
	CAIG	T1,14		;STANDARD EOF CHARS ARE 12-14 (LF,VT,FF)
	 CAIGE	T1,12		;EOL CHAR?
	  JRST	NOTEOL		;NO. CHECK FOR TTY CONTROL-Z
	JRST	DIEOR		;YES. DECR COUNT AND END IT ALL

NOTEOL:	CAIE	T1,33		;ESCAPE?
	 JRST	NOTESC		;NO
	OUTSTR	%CRLF		;YES. OUTPUT A CRLF
	JRST	DIEOR		;AND END THE LINE

NOTESC:	CAIE	T1,32		;^Z?
	 JRST	TDPB		;NO. PASS IT THROUGH
	PUSHJ	P,IMAP		;YES. GET ANOTHER BUFFER
	 JRST	DIEOR		;SHOULD GET EOF
	$SNH			;UNLESS TOPS-10 CHANGES

TGOTCR:	DMOVE	T1,TPTR(D)	;GET PNTR/COUNT
TCRLP:	DMOVEM	T1,TPTR(D)	;SAVE PNTR/COUNT
	SOJGE	T2,TCRX2	;DECR COUNT. OK IF CHARS LEFT
	PUSHJ	P,IMAP		;NO. GET A BUFFERFUL
	 JRST	DIEOR		;GOT EOF
	JRST	TGOTCR		;KEEP IN SYNCH

TCRX2:	ILDB	T3,T1		;GET A CHAR
	JUMPE	T3,TCRLP	;SKIP NULLS
	CAIN	T3,15		;ANOTHER CARRIAGE RETURN?
	 JRST	TCRLP		;YES. IGNORE IT
	CAIG	T3,14		;VERT MOTION CHAR?
	 CAIGE	T3,12
	  JRST	DIEOR		;NO. DATA
	DMOVEM	T1,TPTR(D)	;YES. SAVE UPDATED PNTR/COUNT
	JRST	DIEOR		;AND END THE LINE

>;END IF10
XIREC:	PUSHJ	P,CIREC		;DO COMMON INPUT RECORD CODE
	PJRST	IRSET		;AND SETUP FOR GETTING BYTES FROM IT

CIREC:	SETZM	IRCNT(D)	;CLEAR CHAR COUNT IN CASE EOF
	SETZM	IRLEN(D)	;AND RECORD LENGTH
	MOVE	T1,FLAGS(D)	;ARE WE AT EOF?
	TXNE	T1,D%END
	 POPJ	P,		;YES. GO NO FURTHER

	SKIPE	FRSIZW(D)	;FIXED-LENGTH, WORD-ALIGNED RECORDS?
	 JRST	INBLT		;YES. READ WITH BLT
	SKIPE	FRSIZB(D)	;FIXED-LENGTH, NON-WORD-ALIGNED RECORDS?
	 JRST	INMSLJ		;YES. READ WITH MOVSLJ
	MOVE	T1,RECTP(D)	;[5000] GET RECORDTYPE
	CAIE	T1,RT.UND	;[5000] STREAM FILE?
	 JRST	INDELR		;NO. GO FIND OUT WHAT IT IS

	MOVE	T1,IRBEG(D)	;GET POINTER
	MOVEM	T1,IRPTR(D)	;SAVE FOR TRANSFER
	MOVE	T1,IRSIZ(D)	;AND COUNT
	MOVEM	T1,IRCNT(D)

NULP:	SOSL	ICNT(D)		;ANY CHARS IN BUFFER?
	 JRST	NULCHK		;YES
	PUSHJ	P,IMAP		;NO
	 JRST	DIEOR		;GOT EOF
	JRST	NULP		;KEEP IN SYNCH!

NULCHK:	ILDB	T1,IPTR(D)	;GET A CHAR
	JUMPE	T1,NULP		;SKIP NULLS
	LOAD	T2,MODE(D)	;GET FILE MODE
	CAIE	T2,MD.ASL	;LINED?
	 JRST	NULDEP		;NO. GO DEPOSIT CHAR
	HRRZ	T2,IPTR(D)	;YES. GET LOCAL ADDR OF BUFFER
	MOVE	T2,(T2)		;GET WORD
	TRNN	T2,1		;LINE NUMBER?
	 JRST	NULDEP		;NO. GO DEPOSIT CHAR
	MOVEM	T2,LSNUM(D)	;SAVE IT
	AOS	IPTR(D)		;YES. INCR BUFFER PNTR PAST IT
	MOVNI	T2,5		;AND DECR THE CHAR COUNT
	ADDB	T2,ICNT(D)
	JUMPG	T2,CHKTAB	;GO CHECK FOR TAB IF STILL CHARS
	PUSHJ	P,IMAP		;GET NEW BUFFER IF NOT
	 JRST	DIEOR		;GOT EOF
CHKTAB:	LDB	T1,IPTR(D)	;[3346] GET THE CHAR
	CAIN	T1,"	"	;TAB?
	 JRST	INSLP		;YES. SKIP IT
NULDEP:	CAIG	T1,15		;TERMINATOR?
	 CAIGE	T1,12
	  JRST	.+2		;NO. GO DEPOSIT CHAR
	JRST	CHKEOL		;YES. GO CHECK IT
	IDPB	T1,IRPTR(D)	;SAVE THE FIRST CHAR
	SOS	IRCNT(D)	;DECR THE COUNT

INSLP:	MOVE	T0,ICNT(D)	;GET BUFFER COUNT
	JUMPG	T0,INSOK	;IF SOME CHARS, CONTINUE
	PUSHJ	P,IMAP		;IF NOT, GET SOME
	 JRST	DIEOR		;GOT EOF
	MOVE	T0,ICNT(D)	;GET COUNT AGAIN
INSOK:	MOVE	T1,IPTR(D)	;GET PNTR
	MOVE	T3,IRCNT(D)	;GET RECORD ROOM AVAILABLE
	MOVE	T4,IRPTR(D)	;GET RECORD PNTR
	CAMGE	T0,T3		;SOURCE .GE. DEST?
	 MOVE	T3,T0		;NO. RESTRICT DEST TO SOURCE TO PREVENT FILL
	MOVEM	T3,LOCSIZ	;SAVE IT
	TLO	T0,(1B0)	;TURN ON TRANSLATION
	EXTEND	T0,[EXP <MOVST ASCTAB>," "] ;MOVE THE STRING
	 NOP			;DON'T TREAT TRUNCATION SPECIAL
	TLZ	T0,777000	;TURN OFF ALL BUT # CHARS
	MOVEM	T0,ICNT(D)	;STORE NEW COUNT
	MOVEM	T1,IPTR(D)	;SAVE UPDATED PNTR
	MOVEM	T4,IRPTR(D)	;AND RECORD PNTR
	MOVN	T2,LOCSIZ	;GET # CHARS WE WANTED TO TRANSFER
	ADD	T2,T3		;CALC ACTUAL # CHARS TRANSFERRED
	ADDB	T2,IRCNT(D)	;AND RECORD COUNT
	JUMPG	T3,CHKEOL	;IF WE TERMINATED, CHECK THE EOL CHAR
	JUMPG	T2,INSLP	;IF WE TRUNCATED, WE NEED MORE INPUT
	PUSHJ	P,EXPIRB	;RECORD COUNT NOW ZERO - EXPAND THE BUFFER
	JRST	INSLP		;AND CONTINUE

CHKEOL:	LDB	T1,IPTR(D)	;GET THE TERMINATOR CHARACTER
	CAIE	T1,15		;CR?
	 JRST	DIEOR		;NO. END OF RECORD
GOTCR:	DMOVE	T1,IPTR(D)	;GET PNTR/COUNT
CRLP:	DMOVEM	T1,IPTR(D)	;SAVE PNTR/COUNT
	SOJGE	T2,CRX2		;DECR COUNT. OK IF CHARS LEFT
	PUSHJ	P,IMAP		;NO. GET A BUFFERFUL
	 JRST	DIEOR		;GOT EOF
	JRST	GOTCR		;KEEP IN SYNCH

CRX2:	ILDB	T3,T1		;GET A CHAR
	JUMPE	T3,CRLP		;SKIP NULLS
	CAIN	T3,15		;ANOTHER CARRIAGE RETURN?
	 JRST	CRLP		;YES. IGNORE IT
	CAIG	T3,14		;VERT MOTION CHAR?
	 CAIGE	T3,12
	  JRST	DIEOR		;NO. DATA
	DMOVEM	T1,IPTR(D)	;YES. SAVE UPDATED PNTR/COUNT

DIEOR:	MOVE	T1,IRSIZ(D)	;GET RECORD BUFFER SIZE
	SUBB	T1,IRCNT(D)	;GET # CHARS IN RECORD
	MOVEM	T1,IRLEN(D)	;SAVE LENGTH
	POPJ	P,

ASCTAB:	BYTE (18)0,1,2,3,4,5,6,7
	BYTE (18)10,11,100012,100013,100014,100015,16,17
	BYTE (18)20,21,22,23,24,25,26,27,30,31,32,33,34,35,36,37
	BYTE (18)40,41,42,43,44,45,46,47,50,51,52,53,54,55,56,57
	BYTE (18)60,61,62,63,64,65,66,67,70,71,72,73,74,75,76,77
	BYTE (18)100,101,102,103,104,105,106,107
	BYTE (18)110,111,112,113,114,115,116,117
	BYTE (18)120,121,122,123,124,125,126,127
	BYTE (18)130,131,132,133,134,135,136,137
	BYTE (18)140,141,142,143,144,145,146,147
	BYTE (18)150,151,152,153,154,155,156,157
	BYTE (18)160,161,162,163,164,165,166,167
	BYTE (18)170,171,172,173,174,175,176,177

;INPUT OF FIXED-LENGTH, WORD-ALIGNED RECORDS IS ACCOMPLISHED
;BY READING WORDS DIRECTLY FROM THE FILE, REGARDLESS OF CONTENT.
;THE RECORD SIZE PARAMETERS ARE THEN SET FROM THE PRESET RECORDSIZE.
INBLT:	MOVE	T1,FRSIZW(D)	;GET RECORDSIZE
	MOVEM	T1,LOCSIZ	;SAVE FOR TRANSFER
	MOVE	T1,IRBUF(D)	;INIT RECORD POINTER
	MOVEM	T1,IRPTR(D)
INBLP:	MOVE	T4,ICNT(D)	;GET BUFFER COUNT
	IDIV	T4,BPW(D)	;GET # WORDS
	JUMPG	T4,INBOK	;OK IF SOME
	PUSHJ	P,IMAP		;GET MORE IF NONE
	 $ACALL	EOF		;EOF. REPORT IT IMMEDIATELY!
	MOVE	T4,ICNT(D)	;GET NEW COUNT
	IDIV	T4,BPW(D)	;GET # WORDS
INBOK:	MOVE	T3,LOCSIZ	;GET # WORDS TO TRANSFER
	CAILE	T3,(T4)		;.GT. NUMBER OF WORDS IN BUFFER
	 MOVEI	T3,(T4)		;YES. USE THE SMALLER ONE
	HRRZ	T5,IRPTR(D)	;GET RECORD ADDR-1
	ADDI	T5,1		;CORRECT IT
	HRRZ	T1,IPTR(D)	;GET INPUT BUFFER ADDR-1
	HRLZI	T1,1(T1)	;NOW GET ITS ADDRESS AS SOURCE
	HRRI	T1,(T5)		;DESTINATION IS RECORD BUFFER
	ADDI	T5,-1(T3)	;GET FINAL DEST
	BLT	T1,(T5)		;TRANSFER THE WORDS
	ADDM	T3,IRPTR(D)	;UPDATE RECORD PNTR
	ADDM	T3,IPTR(D)	;AND BUFFER POINTER
	SUBI	T4,(T3)		;AND BUFFER WORD COUNT
	IMUL	T4,BPW(D)	;GET BYTES LEFT
	MOVEM	T4,ICNT(D)	;SAVE IT
	MOVNI	T3,(T3)		;GET NEG # WORDS TRANSFERRED
	ADDB	T3,LOCSIZ	;UPDATE TOTAL WORD COUNT
	JUMPG	T3,INBLP	;IF MORE, TRY FOR MORE
	MOVE	T1,RSIZE(D)	;SETUP COUNT AND LENGTH
	MOVEM	T1,IRCNT(D)
	MOVEM	T1,IRLEN(D)

	SKIPN	WTAB(D)		;RANDOM FILE?
	 POPJ	P,		;NO. DON'T CHECK CONTENTS
	MOVN	T1,FRSIZW(D)	;GET NEG # WORDS IN RECORD
	HRLZI	T1,(T1)		;IN LEFT HALF
	HRR	T1,IRBUF(D)	;CREATE AOBJN POINTER TO RECORD-1
	ADDI	T1,1		;CORRECT IT
	MOVE	T3,(T1)		;GET 1ST WORD
	LOAD	T2,MODE(D)	;GET DATA MODE
	CAIN	T2,MD.ASL	;LINED?
	 MOVEM	T3,LSNUM(D)	;YES. SAVE LSN
INBCHK:	SKIPN	(T1)		;WORD NON-ZERO?
	 AOBJN	T1,INBCHK	;ZERO. TRY ANOTHER
	JUMPL	T1,%POPJ	;IF STILL IN RECORD, WE'RE OK
	$ACALL	RNR		;IF NOT, RECORD NOT WRITTEN

;INPUT OF NON-STREAM, VARIABLE-LENGTH FILES. IF IT IS
;AN UNLABELED MAGTAPE, GO READ THE DELIMITER AS THE RECORD LENGTH.
;IF IT IS A LABELED MAGTAPE, THE CURRENT ENTIRE BUFFER IS THE RECORD.
;INPUT OF DELIMITED (VARIABLE-LENGTH) RECORDS IS DONE
;BY READING THE DELIMITER TO DETERMINE THE RECORD LENGTH. IF
;NECESSARY, THE INPUT RECORD BUFFER IS EXPANDED.

INDELR:	PUSHJ	P,GETDEL		;GET DELIMITER
	MOVE	T3,IRLEN(D)	;GET LENGTH FROM DELIMITER
	CAMLE	T3,IRSIZ(D)	;BIGGER THAN CURRENT RECORD BUFFER?
	 PUSHJ	P,EXPIRB	;YES. EXPAND IT
	MOVE	T1,IRLEN(D)	;GET RECORD LENGTH AGAIN
	MOVEM	T1,IRCNT(D)	;SAVE THE RECORD SIZE
	JRST	INMCOM		;JOIN COMMON CODE

;INPUT OF FIXED-LENGTH NON-WORD-ALIGNED RECORDS IS READ WITHOUT
;REGARD TO DATA CONTENT WITH MOVSLJ. EXACTLY RSIZE CHARACTERS ARE
;READ INTO THE RECORD BUFFER. THE RECORD LENGTH PARAMETERS ARE
;SET TO THE PRESET RECORDSIZE.
;FOR NOW, RANDOM RECORDS ARE ALWAYS WORD-ALIGNED, AND THEREFORE
;ARE NOT READ HERE. IF THEY EVER ARE, WE MUST ADD A CHECK AT THE
;END FOR RECORD NOT WRITTEN (ALL CHARACTERS NULL). FOR EFFICIENCY,
;THIS WOULD PROBABLY REQUIRE THAT THE INITIAL RECORD BE NULLS,
;RATHER THAN SPACES, SO THAT WE CAN CHECK WITH AOBJN.

INMSLJ:	MOVE	T1,FRSIZB(D)	;GET RECORD LENGTH
	MOVEM	T1,IRCNT(D)
	MOVEM	T1,IRLEN(D)
INMCOM:	MOVE	T1,IRBEG(D)	;AND PNTR
	MOVEM	T1,IRPTR(D)

INMSLP:	MOVE	T0,ICNT(D)	;GET COUNT
	JUMPG	T0,INMSOK	;OK IF NON-ZERO
	PUSHJ	P,IMAP		;NO CHARS. GET A BUFFERFUL
	 $ACALL	EOF		;EOF. REPORT IT IMMEDIATELY!
	MOVE	T0,ICNT(D)	;GET UPDATED COUNT

INMSOK:	MOVE	T1,IPTR(D)	;GET BUFFER PNTR
	MOVE	T3,IRCNT(D)	;GET RECORD PNTR/COUNT
	MOVE	T4,IRPTR(D)
	CAIGE	T0,(T3)		;SOURCE .GE. DEST?
	 MOVE	T3,T0		;NO. RESTRICT DEST TO PREVENT FILL
	MOVNI	T2,(T3)		;UPDATE RECORD COUNT, AS MOVSLJ CLEARS IT
	ADDM	T2,IRCNT(D)
	EXTEND	T0,[EXP <MOVSLJ>,0] ;MOVE RECORD
	 NOP			;TRUNCATION HAPPENS MOST OF THE TIME
	MOVEM	T0,ICNT(D)	;SAVE UPDATED WINDOW COUNT
	MOVEM	T1,IPTR(D)	;AND POINTER
	MOVEM	T4,IRPTR(D)
	SKIPE	IRCNT(D)	;DID WE FINISH?
	 JRST	INMSLP		;NO. TRY AGAIN

	MOVE	T1,IRLEN(D)	;SETUP INPUT BYTE COUNT
	MOVEM	T1,IRCNT(D)
	POPJ	P,
IMAP:	MOVE	T0,FLAGS(D)	;Get DDB flags
	TXNE	T0,D%END	;EOF ALREADY?
	 POPJ	P,		;YES. NON-SKIP RETURN
	PUSHJ	P,INXTW		;NO. GET NEXT WINDOW
	MOVE	T0,FLAGS(D)	;Get DDB flags
	TXNN	T0,D%END	;IF FILE DID NOT END,
	 AOS	(P)		;SKIP RETURN
	POPJ	P,		;ELSE DONE
GETDEL:	LOAD	T1,LTYP(D)	;GET LABEL TYPE
	CAIN	T1,LT.UNL	;LABELED?
	 JRST	INGDEL		;NO. GO DO FURTHER CHECKING

	PUSHJ	P,IMAP		;YES (it's labeled). GET A RECORD
	 $ACALL	EOF		;REPORT EOF IMMEDIATELY
	MOVE	T1,ICNT(D)	;USE THE BUFFER COUNT
	MOVEM	T1,IRLEN(D)	;FOR THE RECORD LENGTH
	POPJ	P,

INGDEL:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIE	T1,DI.MTA	;MAGTAPE?
	 JRST	DELDSK		;NO. MUST BE A DISK

;+				[4136]
; Get the delimiter for Magnetic Tape devices
;-
DELMTA:	MOVE	T1,ICNT(D)	;GET number of CHARS LEFT IN BUFFER
	CAILE	T1,4		;[4136]More than 4 Chars(for Control Word)?
	 JRST	INGD		;YES
	PUSHJ	P,IMAP		;NO. GET ANOTHER BUFFERFUL
	 $ACALL	EOF		;REPORT EOF IMMEDIATELY

;+				[4136]
; Get the RCW ("Record Control Word" or "Delimiter") from the record.
; Update the record pointer (IPTR) to point to the first (real) character
; in the record (just after the 4 character RCW). Update the record length
; (IRLEN) to be the size specified in the RCW less the size of the RCW.
;-
INGD:	MOVEI	T0,4		;GET # BYTES IN DELIMITER (RCW)
	MOVEI	T1,4		;[4136]Update record pointer - 
	ADJBP	T1,IPTR(D)	;to point to (just) after the delimiter.
	EXCH	T1,IPTR(D)	;SAVE UPDATED ONE, GET ORIGINAL ONE
	EXTEND	T0,[<CVTDBO 777720>] ;Convert the RCW to binary
	 $ACALL	ICD		;ILLEGAL CHARACTER IN DELIMITER
	SUBI	T4,4		;[4136]Subtract size of delimiter
	MOVEM	T4,IRLEN(D)	;Save actual length of record (Not RCW)
	MOVNI	T1,4		;Update Count (not to include size of the RCW)
	ADDM	T1,ICNT(D)	;Free byte count
	POPJ	P,		;

;+				[4136]
; Get the delimiter for Disk devices
;-
DELDSK:	PUSHJ	P,IWORD		;GET A WORD QUANTITY
	 $ACALL	EOF		;REPORT EOF IMMEDIATELY
	MOVEM	T1,IRLEN(D)	;SAVE AS LENGTH OF RECORD
	MOVN	T1,BPW(D)	;UPDATE COUNT
	ADDM	T1,ICNT(D)
	MOVE	T1,BPW(D)	;AND POINTER
	ADJBP	T1,IPTR(D)
	MOVEM	T1,IPTR(D)	;SAVE UPDATED ONE
	POPJ	P,

;DECODE			

DECINI:	XMOVEI	T1,@A.HSA	;GET STRING ADDR
	$BLDBP	T1		;Build 7-bit byte ptr.
	LDB	T2,[POINTR A.HSA,ARGTYP] ;GET ARRAY TYPE
	CAIN	T2,TP%CHR	;CHARACTER?
	 MOVE	T1,@A.HSA	;YES. GET THE POINTER
	MOVEM	T1,IRPTR(D)
	MOVEM	T1,IRBUF(D)
	MOVEM	T1,IRBEG(D)
	SKIPG	T1,@A.HSL	;GET RECORD LENGTH
	 $ACALL	SLN		;RECORD LENGTH NOT POSITIVE
	MOVEM	T1,IRCNT(D)	;SAVE CHAR COUNT
	MOVEM	T1,RSIZE(D)	;AND RECORD SIZE
	MOVEM	T1,IRBLN(D)	;AND REC BUFFER LENGTH
	MOVEM	T1,IRSIZ(D)
	MOVEM	T1,BYTN(D)	;SET NEXT RECORD START
	MOVEM	T1,IRLEN(D)	;AND RECORD LENGTH
	POPJ	P,		;RETURN

DECODE:	MOVE	T1,BYTN(D)	;GET NEXT RECORD START
	ADJBP	T1,IRBUF(D)	;MOVE POINTER TO NEXT ENTRY
	MOVEM	T1,IRBEG(D)	;SAVE PNTR TO BEG OF RECORD
	MOVEM	T1,IRPTR(D)	;SAVE MOVING POINTER
	MOVE	T1,IRSIZ(D)	;GET ENTRY SIZE
	MOVEM	T1,IRCNT(D)	;SAVE IT
	ADDM	T1,BYTN(D)	;SET TO POINT TO NEXT RECORD
	POPJ	P,

;INTERNAL FILES - INPUT SETUP
;SETUP THE FOROTS INTERNAL BUFFER POINTER/COUNT TO
;THE CHARACTER VARIABLE/ARRAY. IRBUF(D) ALWAYS CONTAINS
;A POINTER TO THE BEGINNING OF THE ENTIRE VARIABLE/ARRAY.
;BYTN IS UPDATED AT THE INITIALIZATION AND EACH READ
;TO POINT TO THE RELATIVE POSITION (IN BYTES) OF THE
;NEXT RECORD.
IFINI:	XMOVEI	T1,@A.UNIT	;GET ADDRESS OF DESCRIPTOR
	MOVE	T2,(T1)		;GET BYTE POINTER
	MOVEM	T2,IRBUF(D)	;SAVE AS RECORD BUFFER POINTER
	MOVEM	T2,IRBEG(D)
	MOVEM	T2,IRPTR(D)	;AND MOVING POINTER
	MOVE	T2,1(T1)	;GET VARIABLE ENTRY SIZE
	MOVEM	T2,IRBLN(D)	;SAVE AS BUFFER LENGTH
	MOVEM	T2,IRSIZ(D)
	MOVEM	T2,IRCNT(D)	;AND MOVING COUNT
	MOVEM	T2,IRLEN(D)	;AND RECORD LENGTH
	MOVEM	T2,RSIZE(D)	;AND RECORDSIZE
	MOVEM	T2,BYTN(D)	;AND START OF NEXT RECORD
	MOVE	T3,@A.HSL	;GET TOTAL # CHARS IN ARRAY
	SKIPN	A.HSL		;UNLESS THERE IS NO KEYWORD
	 MOVE	T3,1(T1)	;NONE. GET IT FROM THE DESCRIPTOR
	MOVEM	T3,EOFN(D)	;SAVE IT
	JUMPG	T3,%POPJ	;NON-ZERO IS OK
	 $ACALL	ICE		;ILLEGAL CHARACTER EXPRESSION

;INPUT
;UPDATE THE POINTER TO POINT TO THE NEXT ARRAY ENTRY.
;IF MORE THAN ONE RECORD FOR A SCALAR OR EXPRESSION, OR
;BEYOND THE END OF AN ARRAY, REPORT END-OF-FILE.
IFIN:	MOVE	T1,BYTN(D)	;GET NEXT RECORD START
	CAML	T1,EOFN(D)	;END OF ARRAY?
	 $ACALL	EOF		;YES. REPORT END OF FILE
	ADJBP	T1,IRBUF(D)	;MOVE POINTER TO NEXT ENTRY
	MOVEM	T1,IRBEG(D)	;SAVE POINTER TO BEG OF RECORD
	MOVEM	T1,IRPTR(D)	;SAVE MOVING POINTER
	MOVE	T1,IRSIZ(D)	;GET ENTRY SIZE
	MOVEM	T1,IRCNT(D)	;SAVE IT
	ADDM	T1,BYTN(D)	;SET TO POINT TO NEXT RECORD
	POPJ	P,
	SUBTTL	OUTPUT

;%OREC IS CALLED AT THE FIN CALL AT THE END OF ALL FORMATTED I/O WRITES.
;%ORECS IS CALLED FROM FORFMT (FOR "/" FORMAT) AND NMLST/LDIO (TO
;OUTPUT AN INTERMEDIATE RECORD). %ORECS USES CODSP FOR ITS DISPATCH
;TABLE, WHICH, FOR ENCODE AND INTERNAL FILE OUTPUT,
;CALLS ENCODE OR IFOUT TO UPDATE THE RECORD POINTER/COUNT.

%ORECS:	AOS	CREC(D)		;COUNT RECORD
	LOAD 	T1,CC(U)	;GET CARRIAGECONTROL
	PUSHJ	P,CCTAB(T1)	;GO PREPARE OUTPUT RECORD BY CC TYPE
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PJRST	ODSPS(T1)	;OUTPUT THE RECORD, CHECK INT FILE OVERRUN

%OREC:	AOS	CREC(D)		;COUNT RECORD
	LOAD 	T1,CC(U)	;GET CARRIAGECONTROL
	PUSHJ	P,CCTAB(T1)	;GO PREPARE OUTPUT RECORD BY CC TYPE
	LOAD	T1,INDX(D)	;GET DEV INDEX
	PJRST	ODSP(T1)	;OUTPUT THE RECORD, AS APPROPRIATE FOR DEV

PUTSTR:	SKIPG	CHRCNT		;ANY CHARS TO GO?
	 POPJ	P,		;NO. NOTHING TO DO
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PUSHJ	P,OSTR(T1)	;OUTPUT CHARS
	PJRST	SEOFN		;GO SET EOFN

OSTR:	JRST	TOSTR		;TTY
	JRST	DOSTR		;DISK
	JRST	DOSTR		;MAGTAPE
	JRST	DOSTR		;OTHER
IF20,<	JRST	DOSTR		;[5004] REMOTE STREAM FILE
	$SNH			;[5004] RMS FILE - SHOULD NEVER GET HERE,
				;[5004]  SINCE CC=TRANSLATED IS NOT SUPPORTED
				;[5004]  FOR RMS FILES
> ;End IF20

;ORINI - RESETS THE POINTER/COUNT TO THE BEGINNING OF THE
;BUFFER FOR ALL "EXTERNAL" DEVICES (E.G. DISK, TTY)

ORINI:	SETZM	ORLEN(D)	;CLEAR RECORD LENGTH
	SETZM	ORPOS(D)	;CLEAR VIRTUAL POS
	MOVE	T1,ORBEG(D)	;RESET BYTE POINTER
	MOVEM	T1,ORPTR(D)
	MOVE	T2,ORSIZ(D)	;RESET BYTE COUNT
	MOVEM	T2,ORCNT(D)
	HRRZ	T1,ORBUF(D)	;POINT TO RECORD BUFFER-1
	ADDI	T1,1		;CORRECT IT
	MOVE	T3,SPCWD(D)	;GET A WORD OF SPACES
	MOVEM	T3,(T1)		;SET THE 1ST WORD
	MOVE	T2,ORBLN(D)	;GET FULL BUFFER SIZE
	ADD	T2,BPW(D)	;ROUND UP TO WORDS
	SUBI	T2,1
	IDIV	T2,BPW(D)	;GET # WORDS IN RECORD
	CAIG	T2,1		;MORE THAN 1?
	 POPJ	P,		;NO. WE'RE DONE
	ADDI	T2,-1(T1)	;GET END WORD ADDR
	HRLI	T1,(T1)		;SETUP FOR BLT
	ADDI	T1,1
	BLT	T1,(T2)		;FILL ENTIRE RECORD WITH SPACES
	POPJ	P,		;DONE, READY FOR NEXT OUTPUT

ODSP:	JRST	TOREC		;TTY
	JRST	COREC		;DISK
	JRST	MOREC		;MAGTAPE
	JRST	COREC		;OTHER
IF20,<	JRST	COREC		;[5004] REMOTE STREAM FILE
	JRST	%ORMS		;[5004] RMS FILE
> ; End IF20

ODSPS:	JRST	TORECS		;TTY
	JRST	CORECS		;DISK
	JRST	MORECS		;MTA
	JRST	CORECS		;OTHER
IF20,<	JRST	CORECS		;[5004] REMOTE STREAM FILE
	JRST	%ORMS		;[5004] RMS FILE
> ; End IF20

;ERROR MESSAGE OUTPUT
;ARGS:	 T1 = ADDRESS OF ASCIZ MESSAGE STRING
;IF THE ERROR OUTPUT IS TO A FILE (U.ERR .NE. 0), THE
;ERROR MESSAGE IS OUTPUT DIRECTLY TO THE FILE, WITHOUT
;ATTENTION PAID TO THE FORMAT OF THE FILE.
;THUS IT PAYS NO ATTENTION TO WHETHER THE RECORDS ARE FIXED-LENGTH,
;WHETHER THE RECORDS REALLY WANT CRLFS AT THEIR END, ETC.

%EOREC:	SKIPE	T1,U.ERR	;[4131] POINT TO ERR DDB
	 CAMN	T1,%UDBAD	;[4131] IF THE SAME AS UNIT WITH ERROR, USE TTY
	  JRST	ETTY		;USE PSOUT/OUTSTR
	
	PUSH	P,U		;SAVE U AND D
	PUSH	P,D
	PUSH	P,%UDBAD	;[4156] SAVE CURRENT UDB ADDRESS
	SETZ	F,		;NO FLAGS, PLEASE
	MOVE	U,U.ERR		;GET UNIT BLOCK ADDR
	MOVEM	U,%UDBAD	;SETUP FOR ERROR MSGS
	MOVE	D,DDBAD(U)	;Set up D
	PUSHJ	P,%SETOUT	;Set file open for output
	MOVE	T1,FLAGS(D)	;GET DDB FLAGS
	TXNN	T1,D%SEOL	;SUPPRESS LEADING CRLF?
	 PUSHJ	P,%OCRLF	;NO. MUST WANT ONE

	MOVE	T1,%EOCNT	;GET COUNT
	MOVEM	T1,CHRCNT	;SAVE COUNT
	MOVE	T1,%EOPTR	;GET ERROR POINTER
	MOVEM	T1,CHRPTR	;SAVE IT FOR PUTSTR
	PUSHJ	P,PUTSTR	;OUTPUT THE ERROR STRING DIRECTLY
	PUSHJ	P,%OCRLF	;END WITH CRLF, SUPPRESS NEXT LEADING ONE

	POP	P,%UDBAD	;[4156] RESTORE UDB ADDRESS
	POP	P,D		;RESTORE U AND D
	POP	P,U
	POPJ	P,
ETTY:	SKIPN	T1,D.TTY	;ANY TTY DDB?
	 JRST	EPSOUT		;NO. JUST GO OUTPUT MESSAGE
	MOVE	T0,FLAGS(T1)	;YES. GET FLAGS
	TXNE	T0,D%SEOL	;Suppress CRLF?
	 JRST	EPSOUT		;YES. JUST GO OUTPUT MESSAGE

IF20,<
	HRROI	T1,%CRLF
	PSOUT%
EPSOUT:	MOVE	T1,%EOPTR	;GET POINTER TO MESSAGE
	PSOUT%
	HRROI	T1,%CRLF	;END WITH CRLF
	PSOUT%
> ;END IF20

IF10,<
	OUTSTR	%CRLF
EPSOUT:	MOVE	T1,%EOPTR	;GET POINTER TO MESSAGE
	OUTSTR	(T1)		;TYPE MESSAGE
	OUTSTR	%CRLF		;END WITH CRLF
> ;END IF10

	SKIPN	T1,D.TTY	;AGAIN, ANY TTY DDB?
	 POPJ	P,		;NO. DONE
	MOVX	T2,D%SEOL	;SUPPRESS NEXT LEADING CRLF
	IORM	T2,FLAGS(T1)
	POPJ	P,		;DONE

	SEGMENT	DATA

%CUNIT:	BLOCK	1		;CURRENT UNIT IN USE
ERPTR:	BLOCK	1		;ERROR MESSAGE POINTER

	SEGMENT	CODE

;OUTPUT CARRIAGE CONTROL
;IF CARRIAGE CONTROL IS BEING DONE, SUBSTITUTES FOR FIRST CHAR
;IF FIXED-LENGTH RECORDS, PADS OR TRUNCATES RECORD TO CORRECT LENGTH

;THE CODE HERE IS REQUIRED TO SET OR CLEAR TWO FLAGS: D%SEOL,
;WHICH CONTROLS WHETHER ERROR MESSAGES ARE TO BE PRECEDED
;WITH A CRLF, AND D%PDOL, WHICH TELLS THIS ROUTINE ON THE
;NEXT RECORD WHETHER DOLLAR FORMAT WAS SPECIFIED IN THE
;CURRENT RECORD.

CCTAB:	$SNH			;CAN'T WAIT TILL NOW FOR CC
	JRST	CCFOR		;FORTRAN
	JRST	CCLST		;LIST
	JRST	CCNON		;NONE
	JRST	CCTRN		;TRANSLATED

;CC=NONE DOES EXACTLY THE SAME THING AS CC=LIST EXCEPT THAT
;FOR VARIABLE-LENGTH RECORDS THE CRLF IS NOT OUTPUT AND
;FOR FIXED-LENGTH RECORDS 2 NULLS ARE WRITTEN.
CCNON:	SETZM	G.PRP		;ASSUME NO PROMPTING
	MOVX	T1,D%SEOL	;DO NOT SUPPRESS NEXT CRLF
	ANDCAM	T1,FLAGS(D)
	SKIPN	RSIZE(D)	;FIXED-LENGTH RECORD?
	 JRST	VARNON		;NO
	PUSHJ	P,SFLEN		;UPDATE LENGTH, PAD
	PUSHJ	P,CHKDOL	;CHECK FOR DOLLAR FORMAT
	PUSHJ	P,SETNUL	;WRITE 2 NULLS WHERE CRLF WOULD BE
	PUSHJ	P,FIXEOL	;CLEAR UNUSED PART OF LAST WORD
	MOVE	T1,FRSIZB(D)	;GET FULL RECORDSIZE
	MOVEM	T1,ORLEN(D)	;SAVE RECORD LENGTH
	MOVEM	T1,ORCNT(D)	;SAVE FOR OUTPUT
	MOVE	T1,ORBUF(D)	;SETUP PNTR
	MOVEM	T1,ORPTR(D)
	POPJ	P,

VARNON:	PUSHJ	P,SVLEN		;SET PNTR/COUNT TO END OF RECORD
	PUSHJ	P,CHKDOL	;CHECK FOR $ FORMAT
	MOVE	T1,ORBUF(D)	;SETUP PNTR/COUNT
	MOVEM	T1,ORPTR(D)
	MOVE	T1,ORLEN(D)
	MOVEM	T1,ORCNT(D)
	POPJ	P,

;CC=FORTRAN IS SIMILAR TO CC=LIST, EXCEPT THAT
;A NULL IS SUBSTITUTED FOR THE CHAR IN COLUMN 1 IF
;THE PREVIOUS RECORD HAD DOLLAR FORMAT.
CCFOR:	MOVE	T1,FLAGS(D)	;GET DDB FLAGS
	TXNN	T1,D%PDOL	;PREVIOUS RECORD HAVE DOLLAR FORMAT?
	 JRST	CCFORL		;NO
	SETZ	T1,		;GET A NULL CHAR
	MOVE	T2,ORBEG(D)	;GET BEGINNING OF RECORD
	IDPB	T1,T2		;SUBSTITUTE NULL FOR 1ST CHAR

CCFORL:	SKIPE	%FLIDX		;[4100]FLAGGING ON?
	 PUSHJ	P,FLGCC		;[4100]YES. HANDLE COMPATIBILITY FLAGGING
CCLST:	SETZM	G.PRP		;ASSUME NO PROMPTING
	SKIPN	RSIZE(D)	;FIXED-LENGTH RECORD?
	 JRST	VARLST		;NO
	PUSHJ	P,SFLEN		;UPDATE LENGTH, PAD
	PUSHJ	P,STRCOM	;OUTPUT CRLF, HANDLE $ FORMAT
	PUSHJ	P,CHKDOL	;CHECK FOR DOLLAR FORMAT
	PUSHJ	P,FIXEOL	;CLEAR UNUSED PART OF LAST WORD
	MOVE	T1,FRSIZB(D)	;GET FULL RECORDSIZE
	MOVEM	T1,ORLEN(D)	;SAVE RECORD LENGTH
	MOVEM	T1,ORCNT(D)	;SAVE FOR OUTPUT
	MOVE	T1,ORBUF(D)	;SETUP PNTR
	MOVEM	T1,ORPTR(D)
	POPJ	P,

VARLST:	PUSHJ	P,SVLEN		;SET PNTR/COUNT TO END OF RECORD
	PUSHJ	P,STRCOM	;GO HANDLE $ FORMAT, PROMPTING, CRLF
	PUSHJ	P,CHKDOL	;CHECK FOR $ FORMAT
	MOVE	T1,ORBUF(D)	;SETUP PNTR/COUNT
	MOVEM	T1,ORPTR(D)
	MOVE	T1,ORLEN(D)
	MOVEM	T1,ORCNT(D)
	POPJ	P,

;CC=TRANSLATED. THE CHARACTER IN COLUMN 1 IS ACTUALLY TRANSLATED INTO
;THE CORRESPONDING CARRIAGE CONTROL CHARACTERS BEFORE OUTPUT.
;THIS IS HERE PRIMARILY FOR TTY'S, BUT CAN BE USED FOR OTHER
;DEVICES AS WELL.
;NOTE: THE CODE HERE ASSUMES THAT THE RECORDS ARE VARIABLE-LENGTH.
;FIXED-LENGTH RECORDS CANNOT BE SUPPORTED FOR CC=TRANSLATED, SINCE
;THE NUMBER OF CHARACTERS GENERATED BY THE CARRIAGE CONTROL TRANSLATION
;VARIES WIDELY.
CCTRN:	PUSHJ	P,CCDOL		;CHECK FOR $ CARRIAGE CONTROL
	PUSHJ	P,SVLEN		;UPDATE RECORD LENGTH
	PUSHJ	P,CCOUT		;OUTPUT CC CHARS
	PUSHJ	P,SETNUL	;AND END RECORD WITH NULLS
	PUSHJ	P,CHKDOL	;CHECK FOR DOLLAR FORMAT
	MOVX	T1,D%SEOL	;SETUP FOR LEADING CRLF ON ERROR MSGS
	ANDCAM	T1,FLAGS(D)
	MOVE	T1,ORBEG(D)	;GET POINTER TO RECORD
	IBP	T1		;INCR TO FIRST DATA CHARACTER
	MOVEM	T1,G.PRP	;SAVE FOR PROMPT
	MOVEM	T1,ORPTR(D)	;AND FOR OUTPUT ROUTINE
	MOVE	T1,ORLEN(D)	;GET RECORD LENGTH
	SUBI	T1,1		;REDUCE 1 FOR CC CHAR
	MOVEM	T1,ORCNT(D)	;SAVE FOR OUTPUT ROUTINE
	POPJ	P,

SVLEN:	SKIPN	ORPOS(D)	;CHARS DEPOSITED HERE?
	 JRST	SVOK		;YES. GO CHECK LENGTH
	MOVE	T1,FLAGS(D)	;NO. $ FORMAT?
	TXNN	T1,D%STCR
	 JRST	ENDSET		;NO. SET POINTER/COUNT TO PREVIOUS LENGTH
	SKIPL	ORCNT(D)	;YES. BEYOND PHYSICAL RECORD?
	 JRST	SVOK		;NO. JUST RESET LENGTH
	MOVM	T3,ORCNT(D)	;YES. EXPAND BUFFER
	PUSHJ	P,EXPORB
SVOK:	MOVE	T1,ORSIZ(D)	;CALCULATE CURRENT POSITION
	SUB	T1,ORCNT(D)
	CAMGE	T1,ORLEN(D)	;BEYOND OR AT PREVIOUSLY RECORDED LENGTH?
	 JRST	ENDSET		;NO. GO SET PNTR/COUNT TO END OF RECORD
	CAMG	T1,ORLEN(D)	;BEYOND RECORDED LENGTH?
	 POPJ	P,		;NO. RIGHT AT END. NOTHING TO DO
 	MOVEM	T1,ORLEN(D)	;YES. RECORD NEW LENGTH
	SKIPE	ORPOS(D)	;[4100]ARE THERE TRAILING SPACES
	 PUSHJ	P,FLGTS		;[4100]YES. DO COMPATIBILITY FLAGGING
	POPJ	P,
;
;  [4100] Compatibility flagging for "Trailing Spaces in output record"
;
FLGTS:	MOVEI	T1,VAXIDX+ANSIDX;Flag this as an incompatibility for both.
	TDNE	T1,%FLIDX	;Any flags the same?
	 $ECALL	CFT		;Yes. Display the error message
	POPJ	P,		;End of Routine FLGTS 
SFLEN:	SKIPN	ORPOS(D)	;CHARS DEPOSITED HERE?
	 JRST	SFOK		;YES. GO CHECK LENGTH
	MOVE	T1,FLAGS(D)	;NO. $ FORMAT?
	TXNN	T1,D%STCR
	 JRST	ORPAD		;NO. PAD AT PREVIOUSLY RECORDED END
	SKIPL	ORCNT(D)	;BEYOND PHYSICAL RECORD END?
	 JRST	SFOK		;NO. JUST CHECK LENGTH
	MOVE	T1,RSIZE(D)	;YES. SET TO FIXED RECORDSIZE
	MOVEM	T1,ORLEN(D)
	PJRST	%SOPOS

SFOK:	MOVE	T1,ORSIZ(D)	;CALCULATE CURRENT POSITION
	SUB	T1,ORCNT(D)
	CAMGE	T1,ORLEN(D)	;BEYOND OR AT PREVIOUSLY RECORDED LENGTH?
	 JRST	ORPAD		;NO. GO PAD IT THERE
	MOVEM	T1,ORLEN(D)	;YES. SAVE NEW ONE
	CAMN	T1,RSIZE(D)	;RECORD FILLED ALREADY?
	 POPJ	P,		;YES. NO NEED FOR PADDING!
ORPAD:	MOVE	T4,ORLEN(D)	;GET RECORDED LENGTH
	MOVE	T3,RSIZE(D)	;GET RECORD SIZE
	MOVEM	T3,ORLEN(D)	;SAVE AS UPDATED LENGTH
	SUB	T3,T4		;GET AMOUNT OF PAD NEEDED
	JUMPLE	T3,ENDSET	;IF NONE, LEAVE
	ADJBP	T4,ORBEG(D)	;GET BYTE POINTER TO CURRENT LENGTH POINT
	SETZB	T0,T1		;NO SOURCE
	LOAD	T2,PADCH(U)	;GET PAD CHAR
	MOVEM	T2,%MSPAD	;SAVE FOR MOVSLJ
	EXTEND	T0,%MSLJ	;PAD THE RECORD
	 $SNH
ENDSET:	MOVE	T1,ORLEN(D)	;GET LENGTH
	ADJBP	T1,ORBEG(D)	;GET POINTER TO END OF RECORD
	MOVEM	T1,ORPTR(D)	;SAVE IT
	MOVE	T1,ORSIZ(D)	;GET BUFFER LENGTH
	SUB	T1,ORLEN(D)	;GET # CHARS LEFT
	MOVEM	T1,ORCNT(D)	;SAVE IT
	POPJ	P,

FIXDEL:	LOAD	T1,LTYP(D)	;GET LABEL TYPE
	CAIE	T1,LT.UNL	;UNLABELED?
	 POPJ	P,		;NO. DON'T OUTPUT A DELIMITER
CWOUT:	MOVE	T1,ORCNT(D)	;GET OUTPUT RECORD SIZE
	ADDI	T1,4		;PLUS DELIMITER SIZE
	CAMLE	T1,ICNT(D)	;ROOM IN BUFFER FOR RECORD?
	 PUSHJ	P,OSBUF		;NO. OUTPUT CURRENT ONE, GET EMPTY ONE
	SETZ	T0,		;1ST WORD OF INTEGER IS ZERO
	MOVE	T1,ORCNT(D)	;2ND WORD IS RECORD SIZE
	ADDI	T1,4		;INCLUDE SIZE OF HEADER
	MOVEI	T3,4		;NUMBER OF BYTES TO CONVERT
	MOVE	T4,IPTR(D)	;BEG OF RECORD
	TLO	T3,400000	;TURN ON LEADING PAD FLAG
	EXTEND	T0,[EXP <CVTBDO "0">,"0"] ;TRANSLATE TO ASCII CHARS
	 $SNH			;SHOULDN'T HAPPEN
	MOVEM	T4,IPTR(D)	;SAVE UPDATED POINTER
	MOVNI	T1,4		;DECREMENT BUFFER COUNT FOR DELIMITER
	ADDM	T1,ICNT(D)
	POPJ	P,

CHKDOL:	MOVE	T1,FLAGS(D)	;GET DDB FLAGS
	TXZ	T1,D%PDOL	;CLEAR PREV DOLLAR FORMAT
	TXZE	T1,D%STCR	;DOLLAR FORMAT IN THIS RECORD?
	 TXO	T1,D%PDOL	;YES. SET FLAG FOR NEXT RECORD
	MOVEM	T1,FLAGS(D)	;SAVE UPDATED FLAGS
	POPJ	P,

;CCDOL - CHECK IF $ CARRIAGE CONTROL, WHICH IS SPACE CARRIAGE CONTROL
;AND $ FORMAT, I.E., SUPPRESS THE NEXT CRLF.
CCDOL:	MOVE	T2,ORBEG(D)	;GET POINTER TO RECORD
	ILDB	T3,T2		;GET THE 1ST CHARACTER
	MOVX	T1,D%STCR	;GET DOLLAR FORMAT BIT
	CAIN	T3,"$"		;DOLLAR CARRIAGE CONTROL?
	 IORM	T1,FLAGS(D)	;YES. PRETEND WE GOT DOLLAR FORMAT
	POPJ	P,

;CCOUT - TO GET CARRIAGE CONTROL CHARACTERS OUT BEFORE THE RECORD
;GOES OUT. FOR VARIABLE-LENGTH RECORDS, WE ONLY OUTPUT
;THE NUMBER OF CHARACTERS NECESSARY FOR THE CC CHARS.
CCOUT:	MOVE	T1,FLAGS(D)	;GET DDB FLAGS
	TXNE	T1,D%PDOL	;DOLLAR FORMAT IN PREVIOUS RECORD?
	 POPJ	P,		;YES. NO CARRIAGE CONTROL
	MOVE	T2,ORBEG(D)	;GET POINTER TO RECORD
	ILDB	T3,T2		;GET THE 1ST CHARACTER
	JUMPE	T3,%POPJ	;IF NULL, NO CARRIAGE CONTROL
	LOAD 	T1,INDX(D)	;GET DEVICE
	CAIE	T1,DI.TTY	;TERMINAL?
	 JRST	NOSCC		;NO. NOTHING TO WORRY ABOUT
	CAIN	T3,"*"		;YES. IS CC CHAR AN ASTERISK?
	 MOVEI	T3," "		;YES. SUBSTITUTE A SPACE
NOSCC:	MOVE	T1,CCCTAB-" "(T3) ;[4100]GET COMPATIBILITY FLAGS
	TDNE	T1,%FLIDX	;[4100]ANY FLAGS THE SAME?
	 $ECALL	CFC		;[4100]YES. OUTPUT MESSAGE IF INCOMPATIBLE
	CAIG	T3,"3"		;IF OUT OF RANGE, TREAT AS SPACE
	CAIGE	T3," "
	 MOVEI	T3," "		;SPACE IS JUST BEYOND LEGAL TABLE
	MOVE	T4,CCPTR-" "(T3) ;GET POINTER TO CARRIAGE CONTROL STRING
	MOVE	T5,CCLEN-" "(T3) ;GET # CHARS IN CC SUBSTITUTION
	MOVE	T1,FLAGS(D)	;GET FLAG REG
	TXNN	T1,D%SEOL	;[4220] CRLF PRECEDING THIS RECORD?
	 JRST	NOALTC		;[4220] NO
	MOVE	T4,CCALTP-" "(T3) ;[4220] GET ALT PNTR TO CC STRING
	MOVE	T5,CCALTL-" "(T3) ;[4220] AND ALT COUNT
NOALTC:	JUMPE	T5,%POPJ	;[4220] NO OUTPUT IF NO CHARS
	MOVEM	T5,CHRCNT	;SAVE PNTR/COUNT
	MOVEM	T4,CHRPTR
	PJRST	PUTSTR		;OUTPUT THE STRING

;FIXEOL - FOR FIXED-LENGTH STREAM RECORDS,
;OUTPUTS CRLF, CLEARS THE UNUSED BITS IN
;THE LAST DATA WORD.
FIXEOL:	LDB	T1,[POINT 6,ORPTR(D),5] ;GET # BITS TO RIGHT OF DATA
	MOVE	T1,RGTMSK(T1)	;GET MASK
	HRRZ	T2,ORPTR(D)	;GET LOCAL ADDR
	ANDCAM	T1,(T2)		;CLEAR BITS TO RIGHT OF DATA
	POPJ	P,

STRCOM:	MOVE	T1,RECTP(D)	;[5000] GET RECORDTYPE
	CAIE	T1,RT.UND	;[5000] STREAM FILE?
	 POPJ	P,		;NO. DON'T OUTPUT CARRIAGE CONTROL
	MOVE	T1,FLAGS(D)	;SEE IF $ FORMAT
	TXNN	T1,D%STCR
	 JRST	LISTCR		;NO. GO OUTPUT CRLF, ADD 2 TO LENGTH
	MOVX	T1,D%SEOL	;YES. NEED CRLF FOR INPUT, ERROR MSGS
	ANDCAM	T1,FLAGS(D)	;SO CLEAR THE "SUPPRESS EOL" FLAG
	MOVE	T1,ORBEG(D)	;GET RECORD POINTER
	MOVEM	T1,G.PRP	;SAVE FOR PROMPT
	SETZ	T1,		;APPEND 2 NULLS TO THE RECORD FOR PROMPTING
	PUSHJ	P,%OBYTE
	PJRST	%OBYTE

;[4156] MOVE SETNUL OUT OF THE STRCOM CODE AND DON'T OUTPUT THE NULLS
;IF RECORDTYPE IS NOT STREAM
SETNUL:	MOVE	T1,RECTP(D)	;[5000] GET RECORDTYPE
	CAIE	T1,RT.UND	;[5000] STREAM FILE?
	 POPJ	P,		;NO. DON'T OUTPUT THE DAMN NULLS
	SETZ	T1,		;APPEND 2 NULLS TO THE RECORD FOR PROMPTING
	PUSHJ	P,%OBYTE	;OR TO TAKE THE PLACE OF THE CRLF
	PJRST	%OBYTE
 
;LISTCR - FOR CC=LIST, OUTPUT A CRLF AT THE END OF THE RECORD.
LISTCR:	MOVX	T1,D%SEOL	;SUPPRESS CRLF FOR INPUT AND ERROR MSGS
	IORM	T1,FLAGS(D)
	MOVEI	T1,15		;OUTPUT CR/LF
	PUSHJ	P,%OBYTE
	MOVEI	T1,12
	PUSHJ	P,%OBYTE
	MOVEI	T1,2		;INCREMENT LENGTH
	ADDM	T1,ORLEN(D)
	POPJ	P,

; [4100]
; FLGCC - Compatibility flagging for incompatible CarriageControl Characters.
; Check for Incompatibilities with the Carriage Control Character between the
; 20 and the VAX (and also extentions to the ANSI standard).
;

FLGCC:	MOVE	T1,ORBEG(D)	;Get Byte Pointer to beginning of record
	ILDB	T1,T1		;Get the Carriage Control Character
	CAIG	T1,"3"		;Is it a valid CC char?
	 CAIGE	T1," "		;
	MOVEI	T1,"!"		;No, treat as an Ansi incompatibility
	MOVE	T1,CCCTAB-" "(T1);Get the flags for this CC char.
	TDNE	T1,%FLIDX	;Any flags the same?
	 $ECALL	CFC		;Yes. Display the error message
	POPJ	P,		;End of routine FLGCC

;
; The carriage control character lookup table. The table contains two flags. 
; Flags are VAXFLG(incompatible with VAX) and F77FLG(incompatible with ANSI).

CCCTAB:	0			;SPACE  Compatible with Both
	ANSIDX			;! 	Not really a CC Char
	ANSIDX			;" 	Not really a CC Char
	ANSIDX			;# 	Not really a CC Char
	ANSIDX			;$ 	Not compatible with ANSI
	ANSIDX			;% 	Not really a CC Char
	ANSIDX			;& 	Not really a CC Char
	ANSIDX			;' 	Not really a CC Char
	ANSIDX			;( 	Not really a CC Char
	ANSIDX			;) 	Not really a CC Char
	ANSIDX			;*	Not compatible with ANSI
	0			;+	Compatible both
	VAXIDX+ANSIDX		;,	Not compatible either
	VAXIDX+ANSIDX		;-	Not compatible either
	VAXIDX+ANSIDX		;.	Not compatible either
	VAXIDX+ANSIDX		;/	Not compatible either
	0			;0 	Compatible Both
	0			;1 	Compatible Both
	VAXIDX+ANSIDX		;2 	Not compatible either
	VAXIDX+ANSIDX		;3 	Not compatible either

CCPTR:	POINT 7,[BYTE(7)%CR,%LF]		;SPACE : CR,LF
	POINT 7,[BYTE(7)%CR,%LF]		;! : CR,LF
	POINT 7,[BYTE(7)%CR,%LF]		;" : CR,LF
	POINT 7,[BYTE(7)%CR,%LF]		;# : CR,LF
	POINT 7,[BYTE(7)%CR,%LF]		;$ : CR,LF
	POINT 7,[BYTE(7)%CR,%LF]		;% : CR,LF
	POINT 7,[BYTE(7)%CR,%LF]		;& : CR,LF
	POINT 7,[BYTE(7)%CR,%LF]		;' : CR,LF
	POINT 7,[BYTE(7)%CR,%LF]		;( : CR,LF
	POINT 7,[BYTE(7)%CR,%LF]		;) : CR,LF
	POINT 7,[BYTE(7)%CR,%DC3]		;* : CR,DC3
	POINT 7,[BYTE(7)%CR]			;+ : CR
	POINT 7,[BYTE(7)%CR,%DC1]		;, : CR,DC1
	POINT 7,[BYTE(7)%CR,%LF,%LF,%LF]	;- : CR,LF,LF,LF
	POINT 7,[BYTE(7)%CR,%DC2]		;. : CR,DC2
	POINT 7,[BYTE(7)%CR,%DC4]		;/ : CR,DC4
	POINT 7,[BYTE(7)%CR,%LF,%LF]		;0 : CR,LF,LF
	POINT 7,[BYTE(7)%CR,%FF]		;1 : CR,FF
	POINT 7,[BYTE(7)%CR,%DC0]		;2 : CR,DC0
	POINT 7,[BYTE(7)%CR,%VT]		;3 : CR,VT

CCLEN:	2	;SPACE : CR,LF
	2	;! : CR,LF
	2	;" : CR,LF
	2	;# : CR,LF
	2	;$ : CR,LF
	2	;% : CR,LF
	2	;& : CR,LF
	2	;' : CR,LF
	2	;( : CR,LF
	2	;) : CR,LF
	2	;* : CR,DC3
	1	;+ : CR
	2	;, : CR,DC1
	4	;- : CR,LF,LF,LF
	2	;. : CR,DC2
	2	;/ : CR,DC4
	3	;0 : CR,LF,LF
	2	;1 : CR,FF
	2	;2 : CR,DC0
	2	;3 : CR,VT

;[4220] THE FOLLOWING POINTERS AND COUNTS ARE USED IF DOLLAR FORMAT
;[4220] HAS BEEN SPECIFIED. THE CR AND ONE LF (IF ANY) IS REMOVED FROM
;[4220] EACH STRING.
CCALTP:	0				;[4220] SPACE :
	0				;[4220] ! :
	0				;[4220] " :
	0				;[4220] # :
	0				;[4220] $ :
	0				;[4220] % :
	0				;[4220] & :
	0				;[4220] ' :
	0				;[4220] ( :
	0				;[4220] ) :
	POINT 7,[BYTE(7)%DC3]		;[4220] * : DC3
	0				;[4220] + : 
	POINT 7,[BYTE(7)%DC1]		;[4220] , : DC1
	POINT 7,[BYTE(7)%LF,%LF]	;[4220] - : LF,LF
	POINT 7,[BYTE(7)%DC2]		;[4220] . : DC2
	POINT 7,[BYTE(7)%DC4]		;[4220] / : DC4
	POINT 7,[BYTE(7)%LF]		;[4220] 0 : LF
	POINT 7,[BYTE(7)%FF]		;[4220] 1 : FF
	POINT 7,[BYTE(7)%DC0]		;[4220] 2 : DC0
	POINT 7,[BYTE(7)%VT]		;[4220] 3 : VT
	0				;[4220] SPACE : 

CCALTL:	0	;[4220] SPACE :
	0	;[4220] ! :
	0	;[4220] " :
	0	;[4220] # :
	0	;[4220] $ :
	0	;[4220] % :
	0	;[4220] & :
	0	;[4220] ' :
	0	;[4220] ( :
	0	;[4220] ) :
	1	;[4220] * : DC3
	0	;[4220] + : 
	1	;[4220] , : DC1
	2	;[4220] - : LF,LF
	1	;[4220] . : DC2
	1	;[4220] / : DC4
	1	;[4220] 0 : LF
	1	;[4220] 1 : FF
	1	;[4220] 2 : DC0
	1	;[4220] 3 : VT
	0	;[4220] SPACE : LF

;ROUTINE TO NORMALIZE CRLF POSITION, BY TYPING PENDING CRLF, IF ANY
;
;WHEN WRITING A FILE WITH CC=TRANSLATED, THE CRLFS COME BEFORE THE
;RECORDS INSTEAD OF AFTER THEM.  THE REST OF THE WORLD PUTS CRLFS
;AFTER THEIR RECORDS.  THIS ROUTINE IS CALLED TO GET IN SYNC WITH THE
;OUTSIDE WORLD WHEN NECESSARY.
;
;CALLED:
;	WHEN SWITCHING FROM OUTPUT TO INPUT ON TTY IF $ FORMAT NOT SPECIFIED.
;	WHEN CLOSING THE TTY.
;	WHEN DIVERTING ERROR MESSAGES TO A FILE

%OCRLF:	MOVX	T0,D%SEOL	;Suppress next CRLF
	IORM	T0,FLAGS(D)

	MOVEI	T1,2		;SET BYTE COUNT, PTR
	MOVEM	T1,CHRCNT
	MOVE	T1,[POINT 7,%CRLF] ;POINT TO CRLF
	MOVEM	T1,CHRPTR

	SETZM	G.PRP		;SET NO PROMPT STRING AVAILABLE
	PJRST	PUTSTR		;OUTPUT THE CRLF



CORECS:	PUSHJ	P,COREC		;DO IT
	PJRST	ORINI		;AND INITIALIZE THE POINTER/COUNT

COREC:	SKIPE	FRSIZW(D)	;STREAM FIXED-LENGTH RECORDS?
	 JRST	OUTBLT		;YES. BLT THE RECORD OUT

	SKIPG	ORCNT(D)	;ANYTHING IN RECORD?
	 POPJ	P,		;NO. LEAVE

	JRST	COCONT		;SKIP UPDATING CODE

COUTLP:	MOVEM	T0,ORCNT(D)	;SAVE UPDATED REC COUNT
	MOVEM	T1,ORPTR(D)	;AND POINTER
	MOVEM	T4,IPTR(D)	;SAVE UPDATED BUFFER PNTR
COCONT:	SKIPG	ICNT(D)		;ANY ROOM IN WINDOW?
	 PUSHJ	P,ONXTW		;NO ROOM, OUTPUT A BUFFERFUL
	MOVE	T0,ORCNT(D)	;GET RECORD PNTR/COUNT
	MOVE	T1,ORPTR(D)
	MOVE	T3,ICNT(D)	;GET WINDOW PNTR/COUNT
	MOVE	T4,IPTR(D)
	CAIGE	T0,(T3)		;SOURCE .GE. DEST?
	 MOVE	T3,T0		;NO. RESTRICT DEST TO PREVENT FILL
	MOVNI	T2,(T3)		;UPDATE COUNT NOW, AS MOVSLJ CLEARS IT
	ADDM	T2,ICNT(D)
	EXTEND	T0,[EXP <MOVSLJ>,0] ;MOVE RECORD
	 JRST	COUTLP		;LOOP IF TRUNCATED
	MOVEM	T4,IPTR(D)

SEOFN:	MOVE	T1,BYTN(D)	;GET BYTE # OF NEXT WINDOW
	SUB	T1,ICNT(D)	;GET LAST BYTE IN USE
	SKIPE	WTAB(D)		;RANDOM FILE?
	 CAMLE	T1,EOFN(D)	;YES. ONLY STORE LARGER EOFN
	  MOVEM	T1,EOFN(D)	;SAVE AS EOF PNTR
	POPJ	P,		;DONE

OUTBLT:	MOVE	T1,FRSIZW(D)	;GET RECORDSIZE
	MOVEM	T1,LOCSIZ	;SAVE FOR TRANSFER
OUTBLP:	MOVE	T4,ICNT(D)	;GET BUFFER COUNT
	IDIV	T4,BPW(D)	;GET # WORDS LEFT
	JUMPG	T4,OUTBOK	;OK IF SOME
	PUSHJ	P,ONXTW		;GET MORE IF NONE
	MOVE	T4,ICNT(D)	;GET NEW COUNT
	IDIV	T4,BPW(D)	;IN WORDS
OUTBOK:	MOVE	T3,LOCSIZ	;GET # WORDS TO TRANSFER
	CAILE	T3,(T4)		;.GT. NUMBER OF WORDS IN BUFFER
	 MOVEI	T3,(T4)		;YES. USE THE SMALLER ONE
	HRRZ	T5,IPTR(D)	;GET OUTPUT BUFFER ADDR-1
	ADDI	T5,1		;CORRECT IT
	HRRZ	T1,ORPTR(D)	;GET RECORD ADDR-1
	HRLZI	T1,1(T1)	;GET ITS ADDRESS AS SOURCE
	HRRI	T1,(T5)		;DESTINATION IS OUTPUT BUFFER
	ADDI	T5,-1(T3)	;GET FINAL DEST
	BLT	T1,(T5)		;TRANSFER THE WORDS
	ADDM	T3,ORPTR(D)	;UPDATE RECORD PNTR
	ADDM	T3,IPTR(D)	;AND BUFFER POINTER
	SUBI	T4,(T3)		;AND BUFFER WORD COUNT
	IMUL	T4,BPW(D)	;UPDATE COUNT
	MOVEM	T4,ICNT(D)
	MOVNI	T3,(T3)		;GET NEG # WORDS TRANSFERRED
	ADDB	T3,LOCSIZ	;UPDATE TOTAL NUMBER
	JUMPG	T3,OUTBLP	;IF MORE, TRY FOR MORE

	MOVE	T1,BYTN(D)	;GET BYTE # OF NEXT WINDOW
	SUB	T1,ICNT(D)	;GET LAST BYTE IN USE
	SKIPE	WTAB(D)		;RANDOM FILE?
	 CAMLE	T1,EOFN(D)	;YES. ONLY STORE LARGER EOFN
	  MOVEM	T1,EOFN(D)	;SAVE AS EOF PNTR
	POPJ	P,

IF10,<
TOSTR:	PUSHJ	P,DOSTR		;PUT THE CHARS IN THE BUFFER
	PJRST	OSBUF		;GO OUTPUT BUFFER
> ;END IF10

DOSTR:
DSTRLP:	SKIPG	ICNT(D)		;ANY ROOM LEFT IN BUFFER?
	 PUSHJ	P,ONXTW		;NO. GET NEW WINDOW
	SOS	ICNT(D)		;DECR COUNT
	ILDB	T1,CHRPTR	;GET A CHAR
	IDPB	T1,IPTR(D)	;DEPOSIT IN FILE BUFFER
	SOSLE	CHRCNT		;DECR COUNT
	 JRST	DSTRLP		;BACK FOR MORE
	MOVE	T1,BYTN(D)	;UPDATE EOFN
	SUB	T1,ICNT(D)
	MOVEM	T1,EOFN(D)
	POPJ	P,

;MTA OUTPUT ROUTINES

MORECS:	PUSHJ	P,MOREC		;OUTPUT RECORD
	PJRST	ORINI		;INITIALIZE THE POINTER/COUNT

IF10,<
MOREC:	MOVE	T1,RECTP(D)	;[5000] GET RECORDTYPE
	CAIN	T1,RT.UND	;[5000] STREAM FILE?
	 JRST	COREC		;YES. JUST OUTPUT THE DATA
	CAIN	T1,RT.DEL	;DELIMITED?
	 PUSHJ	P,CWOUT		;YES. PUT CONTROL WORD INTO BUFFER
	PJRST	COREC		;NOW PUT DATA INTO BUFFER
> ;END IF10

IF20,<
MOREC:	MOVE	T1,RECTP(D)	;[5000] GET RECORDTYPE
	CAIN	T1,RT.UND	;[5000] STREAM FILE?
	 JRST	COREC		;YES. JUST OUTPUT THE DATA
	CAIN	T1,RT.DEL	;DELIMITED?
	 PUSHJ	P,FIXDEL	;YES. PUT CONTROL WORD INTO BUFFER
	PUSHJ	P,COREC		;NOW PUT DATA INTO BUFFER
	LOAD	T1,LTYP(D)	;GET LABEL TYPE
	CAIE	T1,LT.UNL	;LABELED TAPE?
	 PUSHJ	P,OSBUF		;YES. OUTPUT SINGLE RECORD
	POPJ	P,

> ;END IF20
;TTY OUTPUT ROUTINES

IF10,<
TORECS:	PUSHJ	P,COREC		;PUT RECORD INTO BUFFER
	PUSHJ	P,OSBUF		;OUTPUT RECORD
	PJRST	ORINI		;INITIALIZE THE POINTER/COUNT

TOREC:	PUSHJ	P,COREC		;PUT THE RECORD INTO THE OUTPUT BUFFER
	PJRST	OSBUF		;OUTPUT THE RECORD

>;END IF10

IF20,<

TORECS:	PUSHJ	P,TOREC		;OUTPUT THE RECORD
	PJRST	ORINI		;GO INIT THE POINTER/COUNT

TOREC:	SKIPG	ORCNT(D)	;ANY DATA IN RECORD?
	 POPJ	P,		;NO. NOTHING TO DO
	MOVE	T1,OJFN(D)	;GET JFN
	RFCOC%			;SAVE CCOC WORDS FOR USE DURING TEXTI

	DMOVEM	T2,TCCOC	;SAVE TEMPORARILY
	AND	T2,%CCMSK	;SET CCOC FOR CORRECT OUTPUT
	IOR	T2,%OCCOC	;LEAVE ^I AND ^L AS THEY WERE, SET OTHERS
	MOVE	T3,%OCCOC+1	; TO SEND LITERALLY
	SFCOC%

	MOVE	T1,OJFN(D)	;GET JFN
	MOVE	T2,ORPTR(D)	;GET POINTER TO START OF RECORD
	MOVN	T3,ORCNT(D)	;GET NEGATIVE OF BYTE COUNT
	MOVE	T1,OJFN(D)	;GET JFN
	SOUTR%			;OUTPUT THE STRING
	  ERJMP	OUTERR		;ERROR, GO TELL USER
	MOVE	T1,OJFN(D)	;GET JFN AGAIN
	DMOVE	T2,TCCOC	;GET ORIGINAL CONTENTS
	SFCOC%			;RESTORE CCOC WORDS
	POPJ	P,		;DONE

TOSTR:	MOVE	T1,OJFN(D)	;GET JFN
	RFCOC%			;SAVE CCOC WORDS FOR USE DURING TEXTI
	DMOVEM	T2,TCCOC	;SAVE TEMPORARILY
	AND	T2,%CCMSK	;SET CCOC FOR CORRECT OUTPUT
	IOR	T2,%OCCOC	;LEAVE ^I AND ^L AS THEY WERE, SET OTHERS
	MOVE	T3,%OCCOC+1	; TO SEND LITERALLY
	SFCOC%

	MOVE	T1,OJFN(D)	;GET JFN
	MOVE	T2,CHRPTR	;GET POINTER
	MOVN	T3,CHRCNT	;AND COUNT
	SOUTR%			;OUTPUT THE STRING
	 ERJMP	OUTERR		;ERROR, GO TELL USER

	MOVE	T1,OJFN(D)	;GET JFN AGAIN
	DMOVE	T2,TCCOC	;GET ORIGINAL CONTENTS
	SFCOC%			;RESTORE CCOC WORDS
	POPJ	P,

>;END IF20
;ENCODE

ENCINI:	XMOVEI	T1,@A.HSA	;GET STRING ADDR
	$BLDBP	T1		;Build 7-bit byte ptr.
	LDB	T2,[POINTR A.HSA,ARGTYP] ;GET ARRAY TYPE
	CAIN	T2,TP%CHR	;CHARACTER?
	 MOVE	T1,@A.HSA	;YES. GET THE POINTER
	MOVEM	T1,ORPTR(D)
	MOVEM	T1,ORBUF(D)
	MOVEM	T1,ORBEG(D)
	SKIPG	T1,@A.HSL	;GET STRING LENGTH
	 $ACALL	SLN		;RECORD LENGTH NOT POSITIVE
	MOVEM	T1,ORCNT(D)
	MOVEM	T1,RSIZE(D)	;AND RECORD SIZE
	MOVEM	T1,ORBLN(D)	;AND REC BUFFER LENGTH
	MOVEM	T1,ORSIZ(D)
	MOVEM	T1,BYTN(D)	;SET NEXT RECORD START
	MOVEM	T1,ORLEN(D)	;AND RECORD LENGTH
	PJRST	EFILL		;GO FILL WITH BLANKS

ENCODE:	MOVE	T1,BYTN(D)	;GET NEXT RECORD START
	ADJBP	T1,ORBUF(D)	;MOVE THE POINTER
	MOVEM	T1,ORBEG(D)	;SAVE PNTR TO BEG OF RECORD
	MOVEM	T1,ORPTR(D)	;AND MOVING POINTER
	MOVE	T1,ORSIZ(D)	;GET RECORD LENGTH
	MOVEM	T1,ORCNT(D)	;SAVE IN MOVING LENGTH
	ADDM	T1,BYTN(D)	;UPDATE NEXT RECORD START
	PJRST	EFILL		;GO FILL WITH BLANKS

;INTERNAL FILE OUTPUT INITIALIZATION. SIMILAR TO INPUT.
;SETUP THE POINTER/COUNT TO THE BEGINNING OF THE CHARACTER
;VARIABLE OR ARRAY.
IFOINI:	XMOVEI	T1,@A.UNIT	;GET DESCRIPTOR ADDRESS
	MOVE	T2,(T1)		;GET BYTE POINTER
	MOVEM	T2,ORBUF(D)	;SAVE AS BASE POINTER
	MOVEM	T2,ORBEG(D)
	MOVEM	T2,ORPTR(D)	;AND MOVING POINTER
	MOVE	T2,1(T1)	;GET SIZE
	MOVEM	T2,ORBLN(D)	;SAVE AS BUFFER SIZE
	MOVEM	T2,ORSIZ(D)
	MOVEM	T2,ORCNT(D)	;AND MOVING SIZE
	MOVEM	T2,ORLEN(D)	;AND RECORD LENGTH
	MOVEM	T2,RSIZE(D)	;AND RECORD SIZE
	MOVEM	T2,BYTN(D)	;SET NEXT RECORD START
	MOVE	T3,@A.HSL	;GET TOTAL # CHARS IN ARRAY
	SKIPN	A.HSL		;UNLESS THERE IS NO KEYWORD
	 MOVE	T3,1(T1)	;NONE. GET IT FROM THE DESCRIPTOR
	MOVEM	T3,EOFN(D)	;SAVE TO PREVENT OVERRUN
	JUMPG	T3,EFILL	;GO SPACE-FILL IF NON-ZERO
	 $ACALL	ICE		;ILLEGAL CHARACTER EXPRESSION

;INTERNAL FILE OUTPUT - MOVES THE POINTERS AND RESETS THE COUNT
;ONLY CALLED BY FORMATS WITH "/" OR INDEFINITE REPEAT.
;FILLS THE NEXT RECORD WITH SPACES.
;IF THE NEW RECORD IS BEYOND THE BOUNDS OF THE VARIABLE
;OR ARRAY, REPORT A FATAL ERROR.
IFOUT:	MOVE	T1,BYTN(D)	;GET NEXT RECORD START
	CAML	T1,EOFN(D)	;PAST END OF ARRAY?
	 $ACALL	WBA		;YES. WRITING BEYOND END OF ARRAY
	ADJBP	T1,ORBUF(D)	;MOVE THE POINTER
	MOVEM	T1,ORBEG(D)	;SAVE POINTER TO BEG OF RECORD
	MOVEM	T1,ORPTR(D)	;AND MOVING POINTER
	MOVE	T1,ORSIZ(D)	;GET RECORD LENGTH
	MOVEM	T1,ORCNT(D)	;SAVE IN MOVING LENGTH
	ADDM	T1,BYTN(D)	;UPDATE NEXT RECORD START
	
EFILL:	SETZB	T0,T1		;NO SOURCE
	MOVE	T3,ORSIZ(D)	;GET LENGTH OF ENTRY
	MOVE	T4,ORPTR(D)	;AND POINTER
	EXTEND	T0,[EXP <MOVSLJ>," "];FILL WITH BLANKS
	 $SNH			;SHOULD SKIP RETURN ALWAYS
	POPJ	P,

	SUBTTL	T FORMAT AND POSITIONING ROUTINES

;ROUTINE TO READ RECORD POSITION
;RETURN: T1 = BYTE NUMBER OF NEXT BYTE TO/FROM RECORD
;	      I.E., NUMBER OF BYTES ALREADY READ FROM RECORD OR STORED IN IT
;PRESERVES T2-T5

%RIPOS:	MOVE	T1,IRLEN(D)	;GET RECORD LENGTH
	SUB	T1,IRCNT(D)	;SUBTRACT # CHARS LEFT IN IT
	ADDI	T1,1		;BEG OF RECORD IS COL 1
	POPJ	P,

%ROPOS:	MOVE	T1,ORSIZ(D)	;GET RECORD BUFFER LENGTH
	SUB	T1,ORCNT(D)	;SUBTRACT EMPTY SPACE
	ADDI	T1,1		;BEG OF RECORD IS COL 1
	POPJ	P,		;RETURN WITH BYTE NUMBER

;ROUTINE TO GET THE BYTE POINTER/COUNT FOR THE OUTPUT RECORD BUFFER.
;IF IT IS A VARIABLE-LENGTH RECORD, RETURNS INFINITY FOR COUNT.
;RETURN: T0 = BYTE POINTER TO NEXT CHARACTER IN RECORD
;	 T1 = COUNT OF BYTES LEFT IN RECORD

%GOPTR:	HLRZ	T1,ORPTR(D)	;GET POINTER TO NEXT CHAR
	SKIPE	%FSECT		;RUNNING IN NON-ZERO SECTION?
	 CAILE	T1,444400	;LOCAL?
	  JRST	BPOK		;NO. OK AS IS
	LDB	T1,[POINT 6,ORPTR(D),11] ;GET BYTESIZE
	MOVE	T2,%OWGBT(T1)	;GET END OF WORD BYTE POINTER
	LDB	T3,[POINT 6,ORPTR(D),5] ;GET POSITION
	IDIVI	T3,(T1)		;GET # BYTES LEFT IN WORD
	LSH	T3,^D30		;SHIFT TO ADD TO OWG BASE
	SUB	T2,T3		;ADD IT
	HRRZ	T3,ORPTR(D)	;GET JUST THE LOCAL ADDRESS
	XMOVEI	T3,(T3)		;GET EXTENDED ADDR
	IOR	T2,T3		;CREATE THE OWGBP
	MOVE	T0,T2		;PUT IT WHERE IT BELONGS
	JRST	GOTBP		;SKIP LOADING POINTER

BPOK:	MOVE	T0,ORPTR(D)	;GET BYTE POINTER
GOTBP:	MOVE	T1,ORCNT(D)	;GET COUNT LEFT
	SKIPN	RSIZE(D)	;FIXED-LENGTH RECORDS?
	 HRLOI	T1,377777	;NO. RETURN INFINITY
	POPJ	P,

;ROUTINE TO SET RECORD POSITION
;ARG:	 T1 = BYTE NUMBER
;SETS SO THAT NEXT IBYTE/OBYTE CALL GETS OR STORES THE GIVEN BYTE

%CIPOS:	MOVE	T2,IRLEN(D)	;GET BUFFER SIZE
	SUB	T2,IRCNT(D)	;CALC CURRENT POSITION
	ADD	T1,T2		;CALC DESIRED POSITION
	JUMPGE	T1,SIPOK	;OK IF POS OR ZERO
	SETZ	T1,		;ELSE SET IT TO ZERO
	JRST	SIPOK

%SIPOS:	SOJGE	T1,SIPOK	;OK IF POSITIVE, DECR TO 1 BEFORE IT
	SETZ	T1,		;ELSE USE ZERO
SIPOK:	MOVE	T2,IRLEN(D)	;GET BUFFER SIZE
	SUB	T2,T1		;CALC # CHARS LEFT IN RECORD
	MOVEM	T2,IRCNT(D)	;SAVE IT
	ADJBP	T1,IRBEG(D)	;FIX POINTER
	MOVEM	T1,IRPTR(D)	;SAVE IT
	POPJ	P,

%COPOS:	MOVE	T2,ORSIZ(D)	;CALC CURRENT POSITION
	SUB	T2,ORCNT(D)
	ADD	T1,T2		;CALC DESIRED DESTINATION
	JUMPGE	T1,CHKPOS	;OK IF POS OR ZERO
	SETZ	T1,		;MAKE IT ZERO IF NOT
	JRST	CHKPOS

%SOPOS:	SOJGE	T1,SOPOK	;OK IF POS, DECR TO 1 BEFORE IT
	SETZ	T1,		;ELSE USE BEG OF RECORD
SOPOK:	MOVE	T2,ORSIZ(D)	;GET BUFFER SIZE
	SUB	T2,ORCNT(D)	;GET CURRENT POSITION
CHKPOS:	SKIPE	ORPOS(D)	;CHARS DEPOSITED HERE?
	 JRST	NOULEN		;NO. DON'T UPDATE RECORDED LENGTH
	CAMLE	T2,ORLEN(D)	;YES. BEYOND LAST RECORDED LENGTH?
	 MOVEM	T2,ORLEN(D)	;YES. SAVE NEW ONE
NOULEN:	SETOM	ORPOS(D)	;FLAG CHARS NOT DEPOSITED HERE
	MOVE	T2,ORSIZ(D)	;GET DATA BUFFER SIZE
	SUBI	T2,(T1)		;CALC COUNT OF CHARS LEFT
	MOVEM	T2,ORCNT(D)	;AND SAVE IT
	ADJBP	T1,ORBEG(D)	;FIX POINTER
	MOVEM	T1,ORPTR(D)	;SAVE IT
	POPJ	P,

	SEGMENT	DATA

TCCOC:	BLOCK	2		;CURRENT CCOC WORDS
CHRPTR:	BLOCK	1		;STRING BYTE POINTER
CHRCNT:	BLOCK	1		;COUNT

	SEGMENT	CODE
	SUBTTL	UNFORMATTED I/O

UISET:	XMOVEI	T1,UNFI		;SETUP FOR IOLST CALLS
	MOVEM	T1,IOSUB(D)
	XMOVEI	T1,UIEND	;SETUP FOR FIN CALL
	MOVEM	T1,IOFIN(D)
	AOS	CREC(D)		;UPDATE RECORD COUNT
	PUSHJ	P,ILSCW1	;READ START LSCW
	 $ACALL EOF		;EOF.
	SETZM	RECREM		;CLEAR CHAR REMAINDER
	POPJ	P,

UIASC:	XMOVEI	T1,UNFI		;SETUP FOR IOLST CALLS
	MOVEM	T1,IOSUB(D)
	XMOVEI	T1,%SETAV	;AND FOR FIN CALL
	MOVEM	T1,IOFIN(D)
	POPJ	P,

UNFI:	MOVE	T1,IO.TYP	;GET TYPE
	CAIN	T1,TP%CHR	;CHARACTER?
	 JRST	UICHR		;YES. GO DO IT
	SETZM	RECREM		;CLEAR CHAR REMAINDER
	MOVE	T1,IO.SIZ	;GET DATA SIZE
	CAME	T1,IO.INC	;IS IT THE SIMPLE CASE?
	 JRST	UIWRD		;NO. MUST BE DONE WORD BY WORD
	IMUL	T1,IO.NUM	;CALC # WORDS
	MOVEM	T1,IO.SIZ	;SAVE AS DATA SIZE
	MOVEI	T1,1		;SET DATA COUNT TO 1
	MOVEM	T1,IO.NUM
	SETZM	IO.INC		;WITH NO INCREMENT
	JRST	UIBLP		;GO DO THE BLT

UIWRD:	MOVN	T1,IO.SIZ	;ACCOUNT FOR THE INCREMENT
	ADDM	T1,IO.INC	;DONE FOR EACH ENTRY AUTOMATICALLY

UIBLP:	MOVE	T1,IO.SIZ	;GET DATA SIZE
	MOVEM	T1,LOCSIZ	;SET LOCAL SIZE

UIBLP1:	SKIPLE	RECLEN		;ANY WORDS LEFT IN SEGMENT?
	 JRST	UIWIN		;YES. GO DO BLT
	PUSHJ	P,ILSCWX	;NO. READ A NEW SEGMENT
	JUMPLE	T1,UIZERO	;NO DATA LEFT IF .LE. ZERO

UIWIN:	PUSHJ	P,UIALIN	;ALIGN THE PNTR/COUNT
	DMOVE	P1,IPTR(D)	;GET THE PNTR/COUNT
	IDIV	P2,BPW(D)	;GET # WORDS LEFT
	JUMPG	P2,UIBLT	;IF DATA LEFT IN WINDOW, CONTINUE WITH IT
	PUSHJ	P,UINXTW	;READ NEXT WINDOW
	 $ACALL	EOF		;REPORT EOF IMMEDIATELY
	DMOVE	P1,IPTR(D)	;GET PNTR/COUNT AGAIN
	IDIV	P2,BPW(D)	;GET # WORDS LEFT

UIBLT:	MOVE	T2,LOCSIZ	;GET MIN OF ARRAY LENGTH
	CAILE	T2,(P2)		; AND WINDOW LENGTH
	  MOVEI	T2,(P2)
	CAMLE	T2,RECLEN	; AND RECORD LENGTH
	  MOVE	T2,RECLEN

;IO.ADR/ Address of data
;P1/ local FOROTS address of data
;T2/ number of words to copy

	MOVE	T1,IO.ADR	;GET USER'S ARRAY ADDR
	TLNN	T1,-1		;Extended addressing?
	 JRST	UIBLT1		;No, normal BLT

	MOVE	T3,T2		;COPY # WORDS TO BLT
	MOVEI	T4,(P1)		;GET LOCAL ADDR
	XMOVEI	T4,1(T4)	;T4/ "From" -- get FOROTS address of data
	MOVE	T5,IO.ADR	;T5/ "To"-- user's array.
	EXTEND	T3,[XBLT]	;** Copy the data **
	JRST	UIBLT2		;Skip normal BLT

UIBLT1:	MOVE	T1,IO.ADR	;GET ARRAY ADDRESS
	MOVSI	T4,1(P1)	;GET BLT-FROM ADDRESS
	HRRI	T4,(T1)		;AND BLT-TO ADDRESS
	ADDI	T1,(T2)		;POINT TO END+1 OF BLT
	BLT	T4,-1(T1)	;MOVE DATA INTO ARRAY

UIBLT2:	MOVNI	P2,(T2)		;GET NEGATIVE # WORDS TRANSFERED
	IMUL	P2,BPW(D)	;GET # CHARS
	ADDM	P2,ICNT(D)	;DECREMENT COUNT
	ADDM	T2,IPTR(D)	;INCREMENT BUFFER POINTER
	ADDM	T2,IO.ADR	;INCR DATA ADDR
	MOVNI	T2,(T2)		;GET NEG # WORDS TRANSFERRED
	ADDM	T2,RECLEN	;AND RECORD LENGTH
	ADDB	T2,LOCSIZ	;AND NUMBER OF WORDS OF DATA
	JUMPG	T2,UIBLP1	;IF SOME LEFT, CONTINUE
	MOVE	T1,IO.INC	;GET INCREMENT
	ADDM	T1,IO.ADR	;ADD TO DATA ADDRESS
	SOSLE	T1,IO.NUM	;DECR COUNT
	 JRST	UIBLP		;MORE TO DO
	POPJ	P,		;ELSE RETURN

UIZLP:	MOVE	T1,IO.SIZ	;GET DATA SIZE
	MOVEM	T1,LOCSIZ	;SAVE IT LOCALLY

UIZERO:	MOVE	T1,IO.ADR	;GET DATA ADDRESS
	SETZM	(T1)		;CLEAR FIRST WORD
	MOVE	T2,LOCSIZ	;GET # WORDS TO CLEAR
	CAIG	T2,1		;MORE THAN 1 WORD?
	 POPJ	P,		;NO. DONE

	TLNN	T1,-1		;Extended addressing?
	 JRST	UZSKP1		;No, normal BLT

	MOVE	T3,T2		;T2/ # words to copy
	SUBI	T3,1		;ALREADY CLEARED ONE
	MOVE	T4,T1		;t3/ "from" the array
	XMOVEI	T5,1(T1)	;T4/ "to" array+1
	EXTEND	T3,[XBLT]	;** Zero array **
	JRST	UIZINC		;DONE WITH THIS BATCH

UZSKP1:	MOVSI	T4,(T1)		;SET BLT-FROM ADDRESS
	HRRI	T4,1(T1)	;AND BLT-TO ADDRESS
	ADDI	T1,(T2)		;POINT TO END+1 OF BLT
	  BLT	T4,-1(T1)	;CLEAR WHOLE ARRAY

UIZINC:	MOVE	T1,IO.INC	;GET INCREMENT
	ADDM	T1,IO.ADR	;INCR DATA ADDR
	SOSLE	IO.NUM		;DECR DATA COUNT
	 JRST	UIZLP		;MORE TO DO
	POPJ	P,		;DONE

UICHR:	MOVE	T1,RECLEN	;GET # WORDS LEFT IN RECORD
	IMUL	T1,BPW(D)	;GET # CHARS
	ADD	T1,RECREM	;ADD PREVIOUS REMAINDER
	MOVEM	T1,LOCREC	;SAVE LOCAL RECORD LENGTH

	MOVE	T1,IO.SIZ	;GET SIZE
	CAME	T1,IO.INC	;SIMPLE CASE?
	 JRST	UICHR1		;NO. DO IT CHAR BY CHAR
	IMUL	T1,IO.NUM	;GET TOTAL # CHARS
	MOVEM	T1,IO.SIZ	;MAKE IT LOOK LIKE 1 BIG VARIABLE
	MOVEI	T1,1		;DATA COUNT OF 1
	MOVEM	T1,IO.NUM
	SETZM	IO.INC		;NO INCREMENT NECESSARY
	JRST	UICBLP		;GO DO THE BLT

UICHR1:	MOVN	T1,IO.SIZ	;ACCOUNT FOR THE INCREMENT DONE
	ADDM	T1,IO.INC	;DONE FOR EACH ENTRY AUTOMATICALLY

UICBLP:	MOVE	T1,IO.SIZ	;GET ENTRY SIZE
	MOVEM	T1,LOCSIZ	;SET UP LOCAL ONE

UICBL1:	SKIPLE	LOCREC		;ANY DATA LEFT IN SEGMENT?
	 JRST	UICWIN		;YES. GO TRANSFER A CHAR
	PUSHJ	P,ILSCWX	;NO. GET A NEW SEGMENT
	JUMPLE	T1,UICBZ	;NO NEW DATA FOUND IF .LE. ZERO
	IMUL	T1,BPW(D)	;GET # CHARS
	MOVEM	T1,LOCREC	;SAVE IT

UICWIN:	SKIPLE	ICNT(D)		;ANY CHARS IN WINDOW
	 JRST	UICBLT		;YES. GO TRANSFER SOME
	PUSHJ	P,UINXTW	;NO. GET A NEW WINDOW
	 $ACALL	EOF		;EOF. REPORT IT IMMEDIATELY

UICBLT:	MOVE	T0,ICNT(D)	;GET MINIMUM OF WINDOW COUNT
	CAMLE	T0,LOCREC	;AND CHARS IN RECORD
	 MOVE	T0,LOCREC
	CAMLE	T0,LOCSIZ	;AND NUMBER OF CHARS TO TRANSFER
	 MOVE	T0,LOCSIZ
	MOVEM	T0,LOCNUM	;SAVE IT

	MOVE	T1,IPTR(D)	;GET THE INPUT PNTR
	MOVE	T3,T0		;COPY THE COUNT
	MOVE	T4,T0		;AND AGAIN
	ADJBP	T4,IO.ADR	;GET UPDATED POINTER
	EXCH	T4,IO.ADR	;SAVE UPDATED POINTER, GET ORIGINAL ONE
	EXTEND	T0,[EXP <MOVSLJ>,0] ;MOVE STRING LEFT-JUSTIFIED, ZERO FILL
	 $SNH			;SHOULD SKIP RETURN

	MOVEM	T1,IPTR(D)	;SAVE UPDATED BUFFER PNTR
	MOVN	T1,LOCNUM	;GET NEGATIVE CHARS TRANSFERRED
	ADDM	T1,LOCREC	;UPDATE # CHARS LEFT IN RECORD
	ADDM	T1,ICNT(D)	;UPDATE # CHARS LEFT IN WINDOW
	ADDB	T1,LOCSIZ	;UPDATE TOTAL # CHARS TO TRANSFER
	JUMPG	T1,UICBL1	;LOOP IF MORE TO TRANSFER

	SKIPN	T1,IO.INC	;GET INCREMENT
	 JRST	UICNI		;NONE
	ADJBP	T1,IO.ADR	;UPDATE PNTR
	MOVEM	T1,IO.ADR	;AND SAVE IT
UICNI:	SOSLE	IO.NUM		;ANY MORE ENTRIES?
	 JRST	UICBLP		;YES. GO DO THEM
	MOVE	T1,LOCREC	;GET LOCAL RECORD LENGTH LEFT
	IDIV	T1,BPW(D)	;GET WORDS AND BYTES
	DMOVEM	T1,RECLEN	;SAVE FOR NEXT CALL
	POPJ	P,		;NO. DONE WITH IOLST CALL

UICBZL:	MOVE	T1,IO.SIZ	;GET ENTRY SIZE
	MOVEM	T1,LOCSIZ	;SAVE LOCALLY
UICBZ:	SETZB	T0,T1		;NO SOURCE
	MOVE	T3,LOCSIZ	;DESTINATION # CHARS
	MOVE	T4,IO.ADR	;DEST PNTR
	EXTEND	[EXP <MOVSLJ>," "]	;FILL WITH SPACES
	 $SNH			;SHOULD SKIP RETURN
	SKIPN	T1,IO.INC	;GET INCREMENT
	 JRST	UICZNI		;NONE
	ADJBP	T1,IO.ADR	;UPDATE THE PNTR
	MOVEM	T1,IO.ADR	;SAVE IT BACK
UICZNI:	SOSLE	IO.NUM		;ANY MORE ENTRIES?
	 JRST	UICBZL		;YES. GO FILL THEM
				;[4215]
	SETZ	RECREM		;[4215] CLEAR BYTE REMAINDER
	POPJ	P,

UIEND:	PUSHJ	P,ILSCW3	;SKIP TO END LSCW
	MOVE	T0,FLAGS(D)	;Get DDB flags
	TXNN	T0,D%END	;REACH EOF?
	 PJRST	%SETAV		;NO. RETURN TO USER PROG
	SKIPN	IMGFLG(D)	;[4161] IS IT IMAGE MODE?
	 $ACALL	BBF		;NO. BAD FORMAT
	$ACALL	EOF		;YES. JUST EOF

UINXTW:	PUSHJ	P,INXTW		;MAP NEXT WINDOW
	MOVE	T0,FLAGS(D)
	TXNN	T0,D%END	;SEQUENTIAL FILE AND EOF?
	 AOS	(P)		;NO. SKIP RETURN
	POPJ	P,		;YES. JUST RETURN NON-SKIP

;IMAGE-MODE TTY
UISTTY:	XMOVEI	T1,UITTY	;DO TEXTI DIRECTLY TO VARIABLES
	MOVEM	T1,IOSUB(D)
	XMOVEI	T1,%SETAV	;DO NOTHING ON FIN CALL
	MOVEM	T1,IOFIN(D)
	POPJ	P,

UITTY:	PUSHJ	P,UOSCC		;SETUP CCOC WORDS FOR LITERAL ECHO
	MOVE	T1,IO.TYP	;GET DATA TYPE
	CAIN	T1,TP%CHR	;CHARACTER?
	 JRST	UITCHR		;YES
	MOVE	T1,IO.SIZ	;GET DATA SIZE
	CAME	T1,IO.INC	;IS IT THE SIMPLE CASE?
	 JRST	UITWRD		;NO. MUST BE DONE WORD BY WORD
	IMUL	T1,IO.NUM	;CALC # WORDS
	MOVEM	T1,IO.SIZ	;SAVE AS DATA SIZE
	MOVEI	T1,1		;SET DATA COUNT TO 1
	MOVEM	T1,IO.NUM
	SETZM	IO.INC		;WITH NO INCREMENT

UITWRD:	MOVE	T1,IO.ADR	;GET DATA ADDR
	MOVEM	T1,LOCPTR	;SAVE IT
	MOVE	T1,IO.SIZ	;GET # WORDS
	MOVEM	T1,LOCSIZ	;SAVE IT
	PUSHJ	P,UITBIN	;DO ONE CHARACTER PER WORD
	MOVE	T1,IO.INC	;GET INCREMENT
	ADDM	T1,IO.ADR	;INCR DATA ADDR
	SOSLE	IO.NUM		;DECR COUNT
	 JRST	UITWRD		;LOOP
	PJRST	UORCC		;GO RESTORE CCOC WORDS

UITCHR:	MOVE	T1,IO.SIZ	;GET SIZE
	CAME	T1,IO.INC	;SIMPLE CASE?
	 JRST	UITCH1		;NO. DO IT CHAR BY CHAR
	IMUL	T1,IO.NUM	;GET TOTAL # CHARS
	MOVEM	T1,IO.SIZ	;MAKE IT LOOK LIKE 1 BIG VARIABLE
	MOVEI	T1,1		;DATA COUNT OF 1
	MOVEM	T1,IO.NUM
	SETZM	IO.INC		;NO INCREMENT NECESSARY

UITCH1:	MOVE	T1,IO.SIZ	;GET SIZE
	MOVEM	T1,LOCSIZ	;SAVE IT LOCALLY
	MOVE	T1,IO.ADR	;GET POINTER
	MOVEM	T1,LOCPTR	;SAVE IT
	PUSHJ	P,UITXTI	;DO TEXTI
	MOVE	T1,IO.INC	;GET INCREMENT
	ADJBP	T1,IO.ADR	;UPDATE POINTER
	MOVEM	T1,IO.ADR
	SOSLE	IO.NUM		;DECR COUNT
	 JRST	UITCH1
	PJRST	UORCC		;GO RESTORE CCOC WORDS

IF20,<
UITBIN:	MOVE	T1,IJFN(D)	;GET JFN
UIBINL:	BIN%			;GET A BYTE
	 $AJCAL	IOE
	MOVEM	T2,@LOCPTR	;DEPOSIT THE BYTE
	AOS	LOCPTR		;INCR DATA ADDR
	SOSLE	LOCSIZ		;DECR # WORDS
	 JRST	UIBINL		;LOOP
	POPJ	P,

UITXTI:	MOVEI	T1,.RDDBC	;SET TEXTI BLOCK LENGTH
	MOVEM	T1,TXIBLK+.RDCWB

	MOVX	T1,RD%CRF+RD%JFN+RD%BBG ;SUPPRESS CR, READ FROM JFNS, BFP GIVEN
	MOVEM	T1,TXIBLK+.RDFLG ;STORE FLAGS

	MOVE	T1,IJFN(D)	;GET JFN
	HRLI	T1,(T1)		;IN BOTH HALVES
	MOVEM	T1,TXIBLK+.RDIOJ ;STORE IT

	MOVE	T1,LOCPTR	;GET RECORD BUFFER PNTR
	MOVEM	T1,TXIBLK+.RDDBP ;STORE DEST BYTE POINTER

	MOVE	T1,LOCSIZ	;GET RECORD BUFFER LENGTH
	MOVEM	T1,TXIBLK+.RDDBC ;STORE DEST BYTE COUNT

	MOVEI	T1,TXIBLK	;POINT TO BLOCK
	TEXTI%			;READ A LINE
	 JSHALT		;SHOULD NOT FAIL
	POPJ	P,

> ;END IF20

IF10,<

UITBIN:	INCHRW	@LOCPTR		;GET A CHAR
	AOS	LOCPTR		;[4156] INCR POINTER
	SOSLE	LOCSIZ		;DECR COUNT
	 JRST	UITBIN		;LOOP
	POPJ	P,

UITXTI:	INCHRW	T1		;GET A CHAR
	IDPB	T1,LOCPTR	;STORE IT
	SOSLE	LOCSIZ		;DECR COUNT
	 JRST	UITXTI		;LOOP
	POPJ	P,

> ;END IF10

;HERE AT START OF RECORD
;READ START LSCW
;0 MEANS RANDOM RECORD WAS NEVER WRITTEN

ILSCW1:	SKIPE	IMGFLG(D)	;[4161] IMAGE?
	 JRST	IMG1		;YES. NO LSCWS
	PUSHJ	P,IWORD		;GET WORD FROM BINARY FILE
	 POPJ	P,		;EOF. NON-SKIP RETURN
	CAIN	T1,0		;LSCW NON-ZERO?
	 $ACALL	RNR		;RECORD NOT WRITTEN
	LDB	T2,[POINT 9,T1,8] ;GET SEGMENT CONTROL WORD
	CAIE	T2,1		;START LSCW?
	 $ACALL	BBF		;?Bad format binary file
	TLZ	T1,777000	;GET SEGMENT LENGTH
	SUBI	T1,1		;REMOVE LSCW FROM COUNT
	SKIPN	T2,RSIZE(D)	;RECORD SIZE SPECIFIED?
	 JRST	SLSCW1		;NO
	CAIE	T2,(T1)		;EQUAL TO SIZE FOUND?
	 $ACALL	RSM		;NO. RECORD SIZE MISMATCH
SLSCW1:	MOVEM	T1,RECLEN	;SAVE COUNT
	JRST	%POPJ1		;RETURN

IMG1:	SKIPN	T1,RSIZE(D)	;GET RECORD SIZE IN WORDS
	 HRLOI	T1,37777	;HUGE RECORD IF NO RECSIZ
	MOVEM	T1,RECLEN	;SAVE IT
IF20,<	LOAD	T1,INDX(D)	;[5003] GET DEVICE INDEX
	CAIN	T1,DI.RMS	;[5003] RMS FILE?
	 PUSHJ	P,%IRMS		;[5003] YES, READ THE RECORD NOW
> ;End IF20
	JRST	%POPJ1		;DONE

;HERE WHEN START OR CONTINUE SEGMENT ENDS
;MUST SEE CONTINUATION OR END LSCW

ILSCWX:	SKIPE	IMGFLG(D)	;[4161] IMAGE?
	 JRST	IMG2		;YES. FAKE A CONTINUATION LSCW
	SKIPGE	T1,RECLEN	;IF SEG LEN NEG, THEN LCSW 3
	 POPJ	P,		;AREADY SEEN. RETURN NEGATIVE
	PUSHJ	P,IWORD		;GET WORD FROM BINARY FILE
	 $ACALL	BBF		;EOF: ?"Bad format binary file"
	SETO	T3,		;ASSUME 0 SEGMENT LENGTH
	LDB	T2,[POINT 9,T1,8] ;GET SEGMENT CONTROL WORD
	CAIN	T2,3		;END LSCW?
	 JRST	ILXEND		;YES. END OF LOGICAL RECORD
	CAIE	T2,2		;CONTINUATION LSCW?
	 $ACALL	BBF		;NO. BAD LSCW, BAD BINARY FILE
	MOVE	T3,T1		;GET THE LSCW
	TLZ	T3,777000	;GET THE SEGMENT LENGTH
	SUBI	T3,1		;REMOVE LSCW FROM COUNT
	SKIPE	RSIZE(D)	;ANY RECORDSIZE SPECIFIED?
	 $ACALL	FCL		;FOUND UNEXPECTED CONTINUATION LSCW
ILXEND:	MOVE	T1,T3		;RETURN LENGTH IN T1
	MOVEM	T1,RECLEN	;STORE SEGMENT LENGTH
	POPJ	P,

IMG2:	SETZ	T1,		;NO RECORD LENGTH LEFT
	MOVEM	T1,RECLEN
	POPJ	P,

;HERE AT END OF IO LIST
;POSITION FILE JUST AFTER END LSCW
;NUMBER OF WORDS TO DISCARD IS .GE. 0 IN RECLEN

ILSCW3:	SKIPE	IMGFLG(D)	;[4161] IMAGE?
	 JRST	IMG3		;YES. NO LSCW
	PUSHJ	P,UIALIN	;WORD-ALIGN THE PNTR/COUNT
	SKIPGE	P3,RECLEN	;GET SEGMENT LENGTH LEFT
	 POPJ	P,		;IF NEG, ALREADY READ LSCW 3
ILS3LP:	PUSHJ	P,IAWORD		;GET WORD FROM BINARY FILE
	 $ACALL	BBF		;EOF. FILE IN ERROR
	SOJGE	P3,ILS3LP	;SKIP TILL LSCW
	LDB	T2,[POINT 9,T1,8] ;GET SEGMENT CONTROL WORD
	CAIE	T2,2		;CONTINUE LSCW?
	 JRST	NLSCW2		;NO
	MOVE	P3,T1		;COPY THE LSCW
	TLZ	P3,777000	;GET THE SEGMENT LENGTH
	SOJA	P3,ILS3LP	;CONTINUE

NLSCW2:	CAIE	T2,3		;END LSCW?
	 $ACALL	BBF		;No, file in error.
	POPJ	P,		;DONE

IMG3:	SKIPN	RSIZE(D)	;RECORD SIZE SPECIFIED?
	 POPJ	P,		;NO - WE HAVE NO CLEANUP
	PUSHJ	P,UIALIN	;WORD-ALIGN THE PNTR/COUNT
	SKIPG	P4,RECLEN	;GET RECORD LENGTH LEFT
	 POPJ	P,		;NONE LEFT - WE'RE DONE
IMG3LP:	PUSHJ	P,IAWORD	;READ A WORD
	  SETZ	P4,		;EOF, OK
	SOJG	P4,IMG3LP	;LOOP BACK
	POPJ	P,		;RETURN

UIALIN:	HRRZ	T1,IPTR(D)	;[4131] GET ADDRESS OF DATA
	JUMPE	T1,%POPJ	;[4131] IF NO DATA, LEAVE
	MOVE	T1,IPTR(D)	;GET BUFFER POINTER
	MUL	T1,BPW(D)	;GET # BYTES LEFT IN WORD
	JUMPE	T1,%POPJ	;ALREADY ALIGNED IF ZERO
	CAMLE	T1,ICNT(D)	;GREATER THAN # BYTES LEFT?
	 MOVE	T1,ICNT(D)	;YES. USE # BYTES LEFT
	MOVNI	T2,(T1)		;GET NEGATIVE
	ADDM	T2,ICNT(D)	;ALIGN COUNT
	ADJBP	T1,IPTR(D)	;ALIGN POINTER
	MOVEM	T1,IPTR(D)	;SAVE IT
	POPJ	P,

IANXT:	PUSHJ	P,UINXTW	;NOTHING LEFT, GO MAP NEXT WINDOW
	 POPJ	P,		;EOF. NON-SKIP RETURN
IAWORD:	MOVE	T1,ICNT(D)	;GET BYTES LEFT
	CAMGE	T1,BPW(D)	;ANY WORDS LEFT?
	 JRST	IANXT		;NO
	MOVN	T1,BPW(D)	;REDUCE # BYTES
	ADDM	T1,ICNT(D)
	AOS	T1,IPTR(D)	;INCR PNTR BY A WORD
	MOVEI	T1,(T1)		;GET JUST ADDR
	MOVE	T1,(T1)		;GET THE DATA
	AOS	(P)		;SKIP RETURN
	POPJ	P,

INXT:	PUSHJ	P,UINXTW	;NOTHING LEFT, GO MAP NEXT WINDOW
	 POPJ	P,		;EOF. NON-SKIP RETURN
IWORD:	PUSHJ	P,UIALIN	;ALIGN THE PNTR/COUNT
	MOVE	T1,ICNT(D)	;GET COUNT
	CAMGE	T1,BPW(D)	;IS THERE AT LEAST A WORD LEFT?
	 JRST	INXT		;NO. GET A NEW BUFFERFUL
	SUB	T1,BPW(D)	;DECREMENT COUNT BY A WORD
	MOVEM	T1,ICNT(D)	;SAVE IT
	AOS	T1,IPTR(D)	;INCREMENT POINTER, GET IT
	MOVEI	T1,(T1)		;GET LOCAL ADDRESS ONLY
	MOVE	T1,(T1)		;GET THE WORD
	AOS	(P)		;SKIP RETURN
	POPJ	P,
				;[5005]

UOSET:	XMOVEI	T1,UNFO		;SETUP FOR IOLST CALLS
	MOVEM	T1,IOSUB(D)
	XMOVEI	T1,UOEND	;SETUP FOR FIN CALL
	MOVEM	T1,IOFIN(D)
	AOS	CREC(D)		;UPDATE RECORD COUNT
	PUSHJ	P,OLSCW1	;OUTPUT START LSCW
	SKIPN	T1,RSIZE(D)	;RECORD SIZE SPECIFIED?
	 HRLOI	T1,37777	;NO, SET BIG RECORDS
	MOVEM	T1,RECLEN	;SAVE IT FOR IOLST CALLS
	SETZM	RECREM		;CLEAR CHARACTER REMAINDER
	POPJ	P,

UNFO:	MOVE	T1,IO.TYP	;GET DATA TYPE
	CAIN	T1,TP%CHR	;CHARACTER?
	 JRST	UOCHR		;YES
	SETZM	RECREM		;CLEAR CHAR REMAINDER
	MOVE	T1,IO.SIZ	;GET DATA SIZE
	CAME	T1,IO.INC	;IS IT THE SIMPLE CASE?
	 JRST	UOWRD		;NO. MUST BE DONE WORD BY WORD
	IMUL	T1,IO.NUM	;CALC # WORDS
	MOVEM	T1,IO.SIZ	;SAVE AS DATA SIZE
	MOVEI	T1,1		;SET DATA COUNT TO 1
	MOVEM	T1,IO.NUM
	SETZM	IO.INC		;WITH NO INCREMENT
	JRST	UOBLP		;GO DO THE BLT

UOWRD:	MOVN	T1,IO.SIZ	;ACCOUNT FOR THE INCREMENT
	ADDM	T1,IO.INC	;DONE FOR EACH ENTRY AUTOMATICALLY

UOBLP:	MOVE	T1,IO.SIZ	;GET ENTRY SIZE
	MOVEM	T1,LOCSIZ	;SAVE LOCALLY

UOBLP1:	SKIPG	RECLEN		;ANY ROOM LEFT IN RECORD?
	 $ECALL	ETL,%POPJ	;NO. WARN USER AND DON'T OUTPUT MORE
	PUSHJ	P,UOALIN	;ALIGN THE POINTER/COUNT
	DMOVE	P1,IPTR(D)	;GET THE POINTER/COUNT
	IDIV	P2,BPW(D)	;GET # WORDS IN WINDOW
	JUMPG	P2,UOBLT	;OK IF WE HAVE ROOM IN WINDOW
	PUSHJ	P,OLSCWX	;FINISH LSCW, OUTPUT TYPE 2, GET NEW WINDOW
	DMOVE	P1,IPTR(D)	;GET PNTR/COUNT AGAIN
	IDIV	P2,BPW(D)	;GET # WORDS IN WINDOW

UOBLT:	MOVE	T2,LOCSIZ	;GET MIN OF ARRAY LENGTH
	CAILE	T2,(P2)		; AND WINDOW LENGTH
	  MOVEI	T2,(P2)
	CAMLE	T2,RECLEN	; AND RECORD LENGTH
	  MOVE	T2,RECLEN

;IO.ADR/ addr. of user's array.
;p1/ local FOROTS address of data.
;T2/ # words to copy

	MOVE	T1,IO.ADR	;GET USER'S ARRAY ADDRESS
	TLNN	T1,-1		;User's array in a non-zero section?
	 JRST	UOBLT2		;No, normal BLT

	MOVE	T3,T2		;COPY # WORDS TO COPY
	MOVE	T4,T1		;T4/ "from" -- user's array
	MOVEI	T5,(P1)		;GET LOCAL ADDR
	XMOVEI	T5,1(T5)	;T5/ "to"-- get Global FOROTS' address.
	EXTEND	T3,[XBLT]	;** COPY array **
	JRST	UOSKP

;Use BLT
UOBLT2:	MOVSI	T4,(T1)		;GET BLT-FROM ADDRESS
	HRRI	T4,1(P1)	;AND BLT-TO ADDRESS
	MOVEI	T3,(P1)		;GET ADDR-1 OF 1ST WORD IN WINDOW
	ADDI	T3,(T2)		;POINT TO END OF BLT
	BLT	T4,(T3)		;MOVE DATA INTO WINDOW

UOSKP:	MOVNI	P2,(T2)		;GET NEGATIVE # WORDS TRANSFERRED
	IMUL	P2,BPW(D)	;GET # CHARS
	ADDM	P2,ICNT(D)	;DECREMENT BUFFER COUNT
	ADDM	T2,IPTR(D)	;INCREMENT BUFFER POINTER
	ADDM	T2,IO.ADR	;INCREMENT DATA ADDRESS
	MOVNI	T2,(T2)		;GET NEG # WORDS TRANSFERRED
	ADDM	T2,RECLEN	;AND RECORD LENGTH
	ADDB	T2,LOCSIZ	;AND NUMBER OF WORDS OF DATA
	JUMPG	T2,UOBLP1	;IF SOME LEFT, CONTINUE
	MOVE	T1,IO.INC	;GET INCREMENT
	ADDM	T1,IO.ADR	;ADD TO DATA ADDRESS
	SOSLE	T1,IO.NUM	;DECR COUNT
	 JRST	UOBLP		;MORE TO DO
	POPJ	P,		;ELSE, LEAVE

UOCHR:	MOVE	T1,RECLEN	;GET # WORDS LEFT IN RECORD
	IMUL	T1,BPW(D)	;GET # CHARS
	ADD	T1,RECREM	;ADD PREVIOUS REMAINDER
	MOVEM	T1,LOCREC	;SAVE LOCAL RECORD LENGTH
	JUMPE	T1,UOCZER	;DONE IF NONE LEFT

	MOVE	T1,IO.SIZ	;GET SIZE
	CAME	T1,IO.INC	;SIMPLE CASE?
	 JRST	UOCHR1		;NO. DO IT CHAR BY CHAR
	IMUL	T1,IO.NUM	;GET TOTAL # CHARS
	MOVEM	T1,IO.SIZ	;MAKE IT LOOK LIKE 1 BIG VARIABLE
	MOVEI	T1,1		;DATA COUNT OF 1
	MOVEM	T1,IO.NUM
	SETZM	IO.INC		;NO INCREMENT NECESSARY
	JRST	UOCBLP		;GO DO THE BLT

UOCHR1:	MOVN	T1,IO.SIZ	;ACCOUNT FOR THE INCREMENT DONE
	ADDM	T1,IO.INC	;DONE FOR EACH ENTRY AUTOMATICALLY

UOCBLP:	MOVE	T1,IO.SIZ	;GET ENTRY SIZE
	MOVEM	T1,LOCSIZ	;SET UP LOCAL ONE

UOCBL1:	SKIPG	LOCREC		;ANY ROOM LEFT IN RECORD?
	 JRST	UOCZER		;NO. DONE

	SKIPG	ICNT(D)		;ANY CHARS IN WINDOW?
	 PUSHJ	P,OLSCWX	;NO. FINISH LSCW, OUTPUT TYPE 2, GET NEW WINDOW

UOCBLT:	MOVE	T0,ICNT(D)	;GET MINIMUM OF WINDOW COUNT
	CAMLE	T0,LOCREC	;AND CHARS IN RECORD
	 MOVE	T0,LOCREC
	CAMLE	T0,LOCSIZ	;AND NUMBER OF CHARS TO TRANSFER
	 MOVE	T0,LOCSIZ
	MOVEM	T0,LOCNUM	;SAVE IT

	MOVE	T1,T0		;COPY THE COUNT
	ADJBP	T1,IO.ADR	;GET UPDATED POINTER
	EXCH	T1,IO.ADR	;SAVE UPDATED POINTER, GET ORIGINAL ONE
	MOVE	T3,T0		;COPY THE COUNT
	MOVE	T4,IPTR(D)	;GET DEST PNTR
	EXTEND	T0,[EXP <MOVSLJ>,0] ;MOVE STRING LEFT-JUSTIFIED, ZERO FILL
	 $SNH			;SHOULD SKIP RETURN

	MOVEM	T4,IPTR(D)	;UPDATE BUFFER PNTR
	MOVN	T1,LOCNUM	;GET NEGATIVE CHARS TRANSFERRED
	ADDM	T1,LOCREC	;UPDATE # CHARS LEFT IN RECORD
	ADDM	T1,ICNT(D)	;UPDATE # CHARS LEFT IN WINDOW
	ADDB	T1,LOCSIZ	;UPDATE # CHARS TO TRANSFER
	JUMPG	T1,UOCBL1	;LOOP IF MORE TO TRANSFER

	SKIPN	T1,IO.INC	;GET INCREMENT
	 JRST	UOCNI		;NONE
	ADJBP	T1,IO.ADR	;UPDATE PNTR
	MOVEM	T1,IO.ADR	;AND SAVE IT
UOCNI:	SOSLE	IO.NUM		;ANY MORE ENTRIES?
	 JRST	UOCBLP		;YES. GO DO THEM
	MOVE	T1,LOCREC	;GET LOCAL RECORD LENGTH LEFT
	IDIV	T1,BPW(D)	;GET WORDS AND BYTES
	DMOVEM	T1,RECLEN	;SAVE FOR NEXT CALL
	POPJ	P,

;HERE IF NO ROOM LEFT IN RECORD BUT THE IOLST HAS SPECIFIED
;MORE OUTPUT. GIVE THE USER AN WARNING MESSAGE AND CLEAR THE
;RECORD COUNTS.
UOCZER:	$ECALL	ETL		;ATTEMPT TO WRITE BEYOND FIXED-LENGTH RECORD
	SETZM	RECLEN		;CLEAR ALL LENGTHS
	SETZM	RECREM
	POPJ	P,

UOEND:	SKIPN	RSIZE(D)	;RECORD SIZE?
	  JRST	UOXYZ		;NO, FINE
	PUSHJ	P,UOALIN	;WORD-ALIGN THE PNTR/COUNT
	MOVE	P3,RECLEN	;GET ROOM LEFT IN RECORD
	JUMPLE	P3,UOXYZ	;NO ZEROS NECESSARY, FINE
	SETZ	T1,		;GET A ZERO
	PUSHJ	P,OAWORD	;PUT IN FILE
	SOJG	P3,.-1		;PAD WHOLE RECORD

UOXYZ:
IF20,<				;[5004]
	LOAD	T1,INDX(D)	;[5004] GET FILE TYPE
	CAIN	T1,DI.RMS	;[5004] RMS?
	 PJRST	OLSCWR		;[5004] YES, GO OUTPUT RECORD
> ;END IF20

	PUSHJ	P,OLSCW3	;OUTPUT END LSCW OR CLEAR END OF WORD
	MOVE	T1,BYTN(D)	;GET BYTE # OF NEXT WINDOW
	SUB	T1,ICNT(D)	;GET LAST BYTE IN USE
	SKIPE	WTAB(D)		;RANDOM FILE?
	 CAMLE	T1,EOFN(D)	;YES. ONLY STORE LARGER EOFN
	  MOVEM	T1,EOFN(D)	;SAVE AS EOF PNTR
	PJRST	%SETAV		;RETURN TO USER PROG

UOSTTY:	XMOVEI	T1,UOTTY	;SETUP FOR TTY IMAGE OUTPUT
	MOVEM	T1,IOSUB(D)
	XMOVEI	T1,UOTFIN	;OUTPUT BUFFER ON FIN CALL
	MOVEM	T1,IOFIN(D)
	POPJ	P,

UOTTY:	PUSHJ	P,UOSCC		;SET CCOC WORDS FOR IMAGE OUTPUT
	MOVE	T1,IO.TYP	;GET DATA TYPE
	CAIN	T1,TP%CHR	;CHARACTER?
	 JRST	UOTCHR		;YES
	MOVE	T1,IO.SIZ	;GET DATA SIZE
	CAME	T1,IO.INC	;IS IT THE SIMPLE CASE?
	 JRST	UOTWRD		;NO. MUST BE DONE WORD BY WORD
	IMUL	T1,IO.NUM	;CALC # WORDS
	MOVEM	T1,IO.SIZ	;SAVE AS DATA SIZE
	MOVEI	T1,1		;SET DATA COUNT TO 1
	MOVEM	T1,IO.NUM
	SETZM	IO.INC		;WITH NO INCREMENT

UOTWRD:	MOVE	T1,IO.ADR	;GET DATA ADDR
	MOVEM	T1,LOCPTR	;SAVE IT
	MOVE	T1,IO.SIZ	;GET # WORDS
	MOVEM	T1,LOCSIZ	;SAVE IT
	PUSHJ	P,UOTBOU	;OUTPUT 1 CHARACTER PER WORD
	MOVE	T1,IO.INC	;GET INCREMENT
	ADDM	T1,IO.ADR	;INCR DATA ADDR
	SOSLE	IO.NUM		;DECR COUNT
	 JRST	UOTWRD		;LOOP
	PJRST	UORCC		;GO RESTORE CCOC WORDS

UOTCHR:	MOVE	T1,IO.SIZ	;GET SIZE
	CAME	T1,IO.INC	;SIMPLE CASE?
	 JRST	UOTCH1		;NO. DO IT CHAR BY CHAR
	IMUL	T1,IO.NUM	;GET TOTAL # CHARS
	MOVEM	T1,IO.SIZ	;MAKE IT LOOK LIKE 1 BIG VARIABLE
	MOVEI	T1,1		;DATA COUNT OF 1
	MOVEM	T1,IO.NUM
	SETZM	IO.INC		;NO INCREMENT NECESSARY

UOTCH1:	MOVE	T1,IO.SIZ	;GET SIZE
	MOVEM	T1,LOCSIZ	;SAVE IT LOCALLY
	MOVE	T1,IO.ADR	;GET POINTER
	MOVEM	T1,LOCPTR	;SAVE IT
	PUSHJ	P,UOSOUT	;DO SOUTR
	MOVE	T1,IO.INC	;GET INCREMENT
	ADJBP	T1,IO.ADR	;UPDATE POINTER
	MOVEM	T1,IO.ADR
	SOSLE	IO.NUM		;DECR COUNT
	 JRST	UOTCH1
	PJRST	UORCC		;RESTORE OLD CCOC WORDS

IF20,<
UORCC:	MOVE	T1,IJFN(D)	;GET JFN
	DMOVE	T2,TCCOC	;GET OLD CCOC WORDS
	RFCOC%			;RESTORE THEM
	POPJ	P,

UOSCC:	MOVE	T1,OJFN(D)	;GET JFN
	RFCOC%			;SAVE CCOC WORDS FOR USE DURING TEXTI
	DMOVEM	T2,TCCOC	;SAVE TEMPORARILY
	DMOVE	T2,%OCLIT	;DO EVERYTHING LITERALLY
	SFCOC%
	POPJ	P,

UOTBOU:	MOVE	T1,OJFN(D)	;GET JFN
UOTBLP:	MOVE	T2,@LOCPTR	;GET WORD
	BOUT%			;OUTPUT IT
	 $AJCAL	IOE
	AOS	LOCPTR		;INCR POINTER
	SOSLE	LOCSIZ		;DECR COUNT
	 JRST	UOTBLP		;LOOP
	POPJ	P,

UOSOUT:	MOVE	T1,OJFN(D)	;GET JFN
	MOVE	T2,LOCPTR	;GET POINTER
	MOVN	T3,LOCSIZ	;GET DATA SIZE
	SOUTR%			;OUTPUT THEM
	 $AJCAL	IOE
	POPJ	P,

UOTFIN:	PJRST	%SETAV		;FINISH OUTPUT CALL

> ;END IF20

IF10,<

UOSCC:	MOVE	T1,[2,,T2]	;[3414] READ TTY CHARACTERISTIC
	MOVEI	T2,.TONFC	;[3414] FOR FREE CRLF'S
	MOVE	T3,DVICE(D)	;GET DEVICE NAME
	IONDX.	T3,		;GET UDX
	 $SNH			;SHOULD NOT FAIL
	TRMOP.	T1,		;[3414]
	 SETZ	T1,		;[3414] FAILED, SET TO FREE CRLF'S
	MOVEM	T1,TCCOC	;[3414] SAVE IT FOR LATER RESTORE
	MOVE	T1,[3,,T2]	;[3414] SETUP TO SET NFC OFF
	ADDI	T2,.TOSET	;[3414] MAKE IT A "SET" CALL
	MOVEI	T4,1		;[3414] TURN OFF NFC BIT
	TRMOP.	T1,		;[3414]
	 JFCL			;[3414] FAILED
	POPJ	P,		;[3414]

UORCC:	MOVE	T1,[3,,T2]	;[3414] SETUP TO RESTORE TTY NFC
	MOVEI	T2,.TONFC+.TOSET ;[3414]
	MOVE	T3,DVICE(D)	;GET DEVICE NAME
	IONDX.	T3,		;GET UDX
	 $SNH			;SHOULD NOT FAIL
	MOVE	T4,TCCOC	;[3414] GET STORED TTY BIT
	TRMOP.	T1,		;[3414]
	 JFCL			;[3414] FAILED, DON'T CARE
	POPJ	P,		;[3414]

UOTBOU:	SKIPG	ICNT(D)		;ANY ROOM?
	 PUSHJ	P,OSBUF		;NO. OUTPUT BUFFERFUL
	MOVE	T1,@LOCPTR	;GET A CHAR
	IDPB	T1,IPTR(D)	;PUT INTO BUFFER
	AOS	LOCPTR		;[4156] INCR POINTER
	SOS	ICNT(D)		;DECREMENT COUNT
	SOSLE	LOCSIZ		;DECR COUNT
	 JRST	UOTBOU		;LOOP
	POPJ	P,

UOSOUT:	SKIPG	ICNT(D)		;ANY ROOM?
	 PUSHJ	P,OSBUF		;NO. OUTPUT BUFFERFUL
	ILDB	T1,LOCPTR	;GET A CHAR
	SOS	ICNT(D)		;DECREMENT COUNT
	IDPB	T1,IPTR(D)	;PUT INTO BUFFER
	SOSLE	LOCSIZ		;DECR SIZE
	 JRST	UOSOUT		;LOOP
	POPJ	P,

UOTFIN:	PUSHJ	P,OSBUF		;OUTPUT THE BUFFER
	PJRST	%SETAV		;AND FINISH OUTPUT CALL

> ;END IF10

;LSCW ROUTINES
;FORMAT OF BINARY RECORD:  (FORMAT OF BINARY RECORD)
;THERE IS NO NECESSARY RELATIONSHIP BETWEEN SEGMENT SIZE AND BUFFER SIZE

OLSCW1:	SKIPE	IMGFLG(D)	;[4161] IMAGE?
	 JRST	OLSCWB		;[5004] YES. ALMOST DONE
	SKIPE	T1,RSIZE(D)	;IS RECORD SIZE SPECIFIED?
	 ADDI	T1,1		;YES. ADD 1 FOR LSCW
	SETZM	SEGCNT		;CLEAR WORD COUNT OF SEGMENTS ALREADY IN FILE
	ADD	T1,[1B8]	;GET START LSCW
	PUSHJ	P,OWORD		;PUT WORD INTO FILE WINDOW
	HRRZ	T1,IPTR(D)	;GET BUFFER POINTER
	MOVEM	T1,CWADR	;STORE IN-CORE ADDRESS OF CONTROL WORD
	POPJ	P,

OLSCWB:	LOAD	T1,INDX(D)	;[5004] GET FILE TYPE
	CAIE	T1,DI.RMS	;[5004] RMS FILE?
	 POPJ	P,		;[5004] NO. DONE
	SETZM	ICNT(D)		;[5004] YES, SAY WE NEED AN OUTPUT BUFFER
	SETZM	IPTR(D)		;[5004]
	POPJ	P,		;[5004]

OLSCWX:	SKIPN	IMGFLG(D)	;[4161] IMAGE?
	 SKIPE	RSIZE(D)	;NO. WAS RECORD SIZE SPECIFIED?
	  JRST	ONXTW		;YES. JUST GO WRITE WINDOW, GET NEW ONE
	SKIPN	T2,CWADR	;GET ADDRESS OF TYPE 1 OR 2 CONTROL WORD
	 $SNH			;Already out in file, bug
	HRRZ	T1,IPTR(D)	;POINT TO LAST WORD WRITTEN
	SUBI	T1,-1(T2)	;GET DISTANCE FROM CONTROL WORD = SEG LENGTH
	HRRM	T1,(T2)		;STORE LENGTH IN CONTROL WORD
	ADDM	T1,SEGCNT	;ADD INTO TOTAL RECORD LENGTH
	MOVSI	T1,(2B8)	;GET CONTINUE LSCW
	PUSHJ	P,OAWORD		;PUT WORD INTO NEW FILE WINDOW
	HRRZ	T1,IPTR(D)	;GET BUFFER POINTER
	MOVEM	T1,CWADR	;STORE IN-CORE ADDRESS OF CONTROL WORD
	POPJ	P,


IF20,<
;[5004] New

OLSCWR:	PUSHJ	P,%OCLR		;CLEAR CHARS AT END OF LAST WD
	SKIPE	T1,FRSIZB(D)	;IF FIXED-LENGTH, USE IT
	 JRST	UOTRMS		;HAVE ONE
	MOVE	T2,ORBUF(D)	;GET BUFFER START
	HRRZ	T1,IPTR(D)	;GET ADR OF LAST WORD WRITTEN
	SUBI	T1,(T2)		;GET TOTAL WORDS IN RECORD
	IMUL	T1,BPW(D)	;NOW BYTES
UOTRMS:	MOVMM	T1,ORLEN(D)
	PUSHJ	P,%ORMS		;AND GO OUTPUT THE RECORD
	SETZM	BYTUSD		;CLEAR BYTES USED COUNT
	SETZM	ICNT(D)		;SAY WE NEED A NEW "WINDOW"
	SETZM	BYTN(D)
	PJRST	%SETAV

> ;End IF20

OLSCW3:	SKIPE	IMGFLG(D)	;[4161] IMAGE?
	  JRST	%OCLR		;YES. JUST CLEAR CHARS IN END OF CURRENT WORD
	SKIPE	RSIZE(D)	;WAS RECORD SIZE SPECIFIED?
	  JRST	O3FIX		;YES - START LSCW ALL DONE - DO TYPE 3 ONLY
	SKIPN	T2,CWADR	;GET ADDRESS OF TYPE 1 OR 2 CONTROL WORD
	 $SNH			;Already out in file, bug
	HRRZ	T1,IPTR(D)	;POINT TO LAST WORD WRITTEN
	SUBI	T1,-1(T2)	;GET DISTANCE FROM CONTROL WORD = SEG LENGTH
	HRRM	T1,(T2)		;STORE LENGTH IN START CONTROL WORD
	ADD	T1,SEGCNT	;ADD IN WORDS FROM OTHER SEGMENTS
	ADD	T1,[3B8+1]	;PUT IN TYPE-3 LSCW HEADER
	PJRST	OWORD		;PUT INTO FILE

O3FIX:	MOVE	T1,RSIZE(D)	;GET USER SPECIFIED RECORD SIZE
	ADD	T1,[3B8+2]	;SET UP END LSCW
	PJRST	OWORD		;PUT INTO FILE

UOALIN:	SKIPN	T1,IPTR(D)	;GET BUFFER POINTER
	 POPJ	P,		;NONE. NOTHING TO ALIGN
	MUL	T1,BPW(D)	;GET # BYTES LEFT IN WORD
	JUMPE	T1,%POPJ	;ALREADY ALIGNED IF ZERO
	CAMLE	T1,ICNT(D)	;MORE THAN LEFT IN BUFFER?
	 MOVE	T1,ICNT(D)	;YES. USE AMOUNT LEFT IN BUFFER
	MOVNI	T2,(T1)		;GET NEGATIVE
	ADDM	T2,ICNT(D)	;ALIGN THE COUNT
	HRRZ	T2,IPTR(D)	;GET LOCAL PNTR
	LDB	T3,[POINT 6,IPTR(D),5] ;GET # BITS TO RIGHT
	MOVE	T3,RGTMSK(T3)	;GET A MASK
	ANDCAM	T3,(T2)		;CLEAR THE BITS
	ADJBP	T1,IPTR(D)	;ALIGN THE POINTER
	MOVEM	T1,IPTR(D)	;SAVE IT
	POPJ	P,

;%OCLR - AT END OF EACH WRITE TO CLEAR THE REMAINING CHARACTERS IN
;THE CURRENT WORD, IF ANY.
%OCLR:	MOVE	T1,IPTR(D)	;GET BUFFER POINTER
	MUL	T1,BPW(D)	;GET # BYTES LEFT IN WORD
	JUMPE	T1,%POPJ	;ALREADY ALIGNED IF ZERO
	HRRZ	T1,IPTR(D)	;GET LOCAL PNTR
	LDB	T3,[POINT 6,IPTR(D),5] ;GET # BITS TO RIGHT
	MOVE	T3,RGTMSK(T3)	;GET A MASK
	ANDCAM	T3,(T1)		;CLEAR THE BITS
	POPJ	P,

;OAWORD - TO OUTPUT A WORD TO THE FILE, WITH THE ASSUMPTION THAT
;THE BYTE POINTER/COUNT HAVE ALREADY BEEN WORD-ALIGNED.
OANXT:	MOVEM	T1,TOWORD	;SAVE WORD TO OUTPUT
	PUSHJ	P,ONXTW		;NOTHING LEFT, GO MAP NEXT WINDOW
	MOVE	T1,TOWORD	;GET WORD BACK AGAIN
OAWORD:	SKIPG	ICNT(D)		;ANY WORDS LEFT?
	 JRST	OANXT		;NO. OUTPUT A WINDOW
	MOVN	T2,BPW(D)	;REDUCE BY BYTES
	ADDM	T2,ICNT(D)
	AOS	T2,IPTR(D)	;INCR PNTR BY A WORD
	MOVEI	T2,(T2)		;GET JUST LOCAL ADDR
	MOVEM	T1,(T2)		;OUTPUT THE DATA
	POPJ	P,

ONXT:	SETZM	ICNT(D)		;CLEAR THE COUNT
	PUSHJ	P,ONXTW		;NOTHING LEFT, GO MAP NEXT WINDOW
	JRST	OWORD1		;GO OUTPUT THE WORD
OWORD:	MOVEM	T1,TOWORD	;SAVE WORD TO OUTPUT
	PUSHJ	P,UOALIN	;ALIGN THE PNTR/COUNT
OWORD1:	MOVE	T1,ICNT(D)	;GET THE COUNT
	CAMGE	T1,BPW(D)	;IS THERE ROOM FOR A WORD?
	 JRST	ONXT		;NO. GET A BUFFERFUL
	SUB	T1,BPW(D)	;DECREMENT COUNT
	MOVEM	T1,ICNT(D)	;SAVE IT
	AOS	T1,IPTR(D)	;INCREMENT POINTER
	MOVEI	T1,(T1)		;MAKE IT A LOCAL POINTER
	MOVE	T2,TOWORD	;GET WORD BACK AGAIN
	MOVEM	T2,(T1)		;PUT WORD IN BUFFER
	POPJ	P,

%RTMSK:
RGTMSK:	0
	1
	3
	7
	17
	37
	77
	177
	377
	777
	1777
	3777
	7777
	17777
	37777
	77777
	177777
	377777
	777777
	1,,-1
	3,,-1
	7,,-1
	17,,-1
	37,,-1
	77,,-1
	177,,-1
	377,,-1
	777,,-1
	1777,,-1
	3777,,-1
	7777,,-1
	17777,,-1
	37777,,-1
	77777,,-1
	177777,,-1
	377777,,-1
	777777,,-1

	SEGMENT	DATA

RECLEN:	BLOCK	1		;RECORD OR SEGMENT LENGTH IN WORDS
RECREM:	BLOCK	1		;CHARACTER REMAINDER
LOCREC:	BLOCK	1		;RECORD OR SEGMENT LENGTH IN CHARACTERS
LOCNUM:	BLOCK	1		;LOCAL # WORDS OR CHARS TO TRANSFER
LOCSIZ:	BLOCK	1		;LOCAL CHARACTER SIZE
LOCPTR:	BLOCK	1		;LOCAL POINTER FOR TEXTI
CWADR:	BLOCK	1		;ADDRESS OF START LSCW
SEGCNT:	BLOCK	1		;COUNT OF WORDS OUT IN FILE IN PREVIOUS SEGMENTS
TOWORD:	BLOCK	1		;TEMP FOR OUTPUT WORD

	SUBTTL	DUMP MODE I/O
	SEGMENT	CODE

IF20,<
RDUMP:
WDUMP:	POPJ	P,
>;END IF20

IF10,<

DMPIN:	HRRZ	T1,DMPNTR	;GET PNTR TO LIST
	SETZM	(T1)		;CLEAR LAST WORD
	MOVEI	T2,.FOINP	;SET FOR INPUT
	HLL	T2,FBLK(D)	;Get channel stuff
	MOVEI	T3,DMPLST
	MOVE	T1,[2,,T2]
	FILOP.	T1,		;Do the INPUT
	 PUSHJ	P,EOFCHK	;Set D%END if EOF; else give error
	MOVE	T1,FLAGS(D)	;Get flags
	TXNE	T1,D%END	;End of file?
	 $ACALL	EOF		;Yes, give error
	JRST	%SETAV		;NO. RETURN

DMPOUT:	HRRZ	T1,DMPNTR	;GET PNTR TO LIST
	SETZM	(T1)		;CLEAR LAST WORD
	MOVEI	T2,.FOOUT	;SET FOR OUTPUT
	HLL	T2,FBLK(D)	;GET CHANNEL STUFF
	MOVEI	T3,DMPLST
	MOVE	T1,[2,,T2]
	FILOP.	T1,		;DO THE OUTPUT
	 $ACALL	IOE		;Error
	JRST	%SETAV		;RETURN PROPERLY

RDUMP:	XMOVEI	T1,LSTDMP	;SETUP FOR IOLST CALL
	MOVEM	T1,IOSUB(D)
	XMOVEI	T1,DMPIN	;SETUP FOR DUMP MODE INPUT
	MOVEM	T1,IOFIN(D)
	MOVE	T1,[-MAXARG,,DMPLST] ;SETUP DUMP MODE LIST PNTR
	MOVEM	T1,DMPNTR
	POPJ	P,

WDUMP:	XMOVEI	T1,LSTDMP	;SETUP FOR IOLST CALL
	MOVEM	T1,IOSUB(D)
	XMOVEI	T1,DMPOUT	;SETUP FOR DUMP MODE OUTPUT
	MOVEM	T1,IOFIN(D)
	MOVE	T1,[-MAXARG,,DMPLST] ;SETUP DUMP MODE LIST PNTR
	MOVEM	T1,DMPNTR
	POPJ	P,

LSTDMP:	MOVE	T1,IO.ADR	;GET I/O ADDR
	SUBI	T1,1		;GET ADDR-1
	SKIPN	T2,IO.INC	;GET INCREMENT
	 JRST	INCOK		;ZERO IS OK
	CAME	T2,IO.SIZ	;SAME AS SIZE?
	 $ACALL	IDI		;ILLEGAL DUMP-MODE I/O LIST
INCOK:	MOVE	T3,IO.SIZ	;GET SIZE
	IMUL	T3,IO.NUM	;GET # WORDS
	MOVNI	T2,(T3)		;NEGATIVE
	HRLI	T1,(T2)		;IN LEFT HALF
	MOVE	T2,DMPNTR	;GET THE PNTR
	MOVEM	T1,(T2)		;SAVE IN DUMP MODE LIST
	AOBJN	T2,.+2		;INCR
	 $ACALL	DLL		;DUMP I/O LIST TOO LONG
	MOVEM	T2,DMPNTR	;SAVE INCREMENTED PNTR
	ADDI	T3,177		;GET # BLOCKS
	IDIVI	T3,200		;ROUNDED UP
	IMULI	T3,200		;GET # WORDS ROUNDED UP
	IMUL	T3,BPW(D)	;GET # BYTES
	ADDM	T3,BYTN(D)	;ADD TO BYTE COUNT
	POPJ	P,

>;END IF10

	SUBTTL	DISK POSITIONING

	COMMENT &

TOPS-20 sequential disk files are read with PMAPs by moving a n-page window
through the file.  The file window always starts on a n-page boundary and is
moved only when the desired byte is not in the window.  The first process page
number of the window is in WPTR(D).  (The window size can be set to something
besides 4 pages with BUFFERCOUNT=).

TOPS-20 and TOPS-10 random files are similar, but there are n independent
one-page windows. If references to the file are well localized, the
windows will often contain the desired records.  For random files WTAB
contains a pointer to a n-word table, with each word giving the corresponding
file page number of a window.  The number of pages
can be set with BUFFERCOUNT=. On TOPS-10, PFTAB is an n-word table
of flags of whether the page has been modified.

TOPS-10 sequential disk files are like any other TOPS-10 sequential file.

	&


;ROUTINE TO MAP NEXT WINDOW OF FILE
;ARGS:	 BYTN = FILE BYTE NUMBER OF START OF WINDOW
;RETURN: P1 = BYTE POINTER TO FIRST MAPPED BYTE
;	 P2 = COUNT OF BYTES IN WINDOW
;	 BYTN = FILE BYTE NUMBER+1 OF END OF WINDOW
;		 I.E., STARTING BYTE OF FOLLOWING WINDOW

INXTW:	SKIPE	WTAB(D)		;RANDOM FILE?
	 JRST	IMAPW		;YES
	MOVE	T0,FLAGS(D)	;GET DDB FLAGS
	TXNE	T0,D%END	;END OF FILE ALREADY?
	 POPJ	P,		;YES. JUST LEAVE
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PJRST	ISTAB(T1)	;GO GET A WINDOW OR BUFFERFUL

ISTAB:	JRST	%ISBUF		;TTY
	JRST	%ISMAP		;DSK
	JRST	%ISBUF		;MTA
	JRST	%ISBUF		;OTHER LOCAL DEVICE
IF20,<	JRST	%RMSIN		;[5003] REMOTE STREAM FILE
	JRST	%IRMS		;[5003] RMS FILE
> ;End IF20

ONXTW:	MOVE	T1,BYTN(D)	;GET # BYTES WRITTEN SO FAR
	CAMLE	T1,EOFN(D)	;UPDATE EOF PNTR IF GREATER
	 MOVEM	T1,EOFN(D)
	SKIPE	WTAB(D)		;RANDOM FILE?
	 JRST	OMAPW		;YES
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	LOAD	T0,ACC(D)	;GET ACCESS
	CAIE	T0,AC.APP	;APPEND?
	 JRST	OSTAB(T1)	;NO. GO MAP NEXT WINDOW OR OUTPUT BUFFERFUL
	CAIN	T1,DI.DSK	;YES. DISK FILE?
	 MOVX	T1,DI.OTH	;YES. SUBSTITUTE 'OTHER'
	PJRST	OSTAB(T1)	;MAP OR WRITE NEXT BUFFERFUL

OSTAB:	JRST	OSBUF		;TTY
	JRST	%OSMAP		;DSK
	JRST	OSBUF		;MTA
	JRST	OSBUF		;OTHER LOCAL DEVICE
IF20,<	JRST	%RMSOU		;[5004] REMOTE STREAM FILE
	JRST	%UORMS		;[5004]
> ;End IF20

;ROUTINE TO GET NEXT BUFFER OF NON-DISK FILE

IF20,<

TISBUF:
%ISBUF:	SKIPE	B36FLG(D)	;OPENED IN 36-BIT MODE?
	 JRST	BISBUF		;YES. DO BINARY INPUT
	MOVE	T1,IJFN(D)	;GET FILE JFN
	MOVE	T2,WADR(D)	;GET POINTER TO BUFFER
	SUBI	T2,1		;POINT TO WORD-1
	HXL	T2,BYTPT(D)	;GET END-OF-WORD BYTE PNTR
	MOVN	T3,WSIZ(D)	;GET WINDOW SIZE IN BYTES

	SINR%			;READ STRING
	 ERCAL	EOFCHK		;ERROR, POSSIBLE EOF

	MOVE	T2,WADR(D)	;MAKE BYTE POINTER TO BUFFER
	SUBI	T2,1		;POINT TO BEG-1
	HXL	T2,BYTPT(D)
	ADD	T3,WSIZ(D)	;CALC # BYTES WE GOT
	ADDM	T3,BYTN(D)	;ADD TO # BYTES READ IN FILE
	DMOVEM	T2,IPTR(D)	;SAVE PNTR/COUNT
	POPJ	P,

BISBUF:	MOVE	T0,FLAGS(D)	;GET DDB FLAGS
	TXNE	T0,D%END	;END FILE ALREADY?
	 POPJ	P,		;YES. NOTHING TO DO
	MOVE	T1,IJFN(D)	;GET JFN
	MOVE	T2,WADR(D)	;GET ADDRESS OF BUFFER
	HRLI	T2,(POINT 36)	;GET BINARY POINTER
	MOVN	T3,WSIZ(D)	;GET WINDOW SIZE
	IDIV	T3,BPW(D)	;GET # WORDS

	SINR%			;READ
	  ERCAL	EOFCHK		;EOF OR ERROR

	IMUL	T3,BPW(D)	;GET LEFTOVERS IN BYTES
	MOVE	T2,WADR(D)	;POINT TO DATA
	SUBI	T2,1		;POINT TO WORD-1
	HXL	T2,BYTPT(D)	;ALIGN THE PNTR
	ADD	T3,WSIZ(D)	;CALC # BYTES WE GOT
	ADDM	T3,BYTN(D)	;ADD TO # BYTES WE'VE READ IN FILE
	DMOVEM	T2,IPTR(D)	;SAVE PNTR/COUNT
	POPJ	P,		;DONE

EOFCHK:	MOVE	T1,IJFN(D)	;[3343] GET THE STATUS
	GTSTS%			;[3343]
	TXNE	T2,GS%EOF	;[3343] EOF?
	 JRST	EOFCK1		;[3343] YES
	TXZ	T2,GS%ERR	;[3343] NO, CLEAR ERROR BIT
	STSTS%			;[3343]
	 $SNH			;[3343]
	$ACALL	IOE		;NO. REPORT ERROR
EOFCK1:	MOVX	T0,D%END	;[3343] EOF, tell caller
	IORM	T0,FLAGS(D)
	POPJ	P,

;NON-DISK OUTPUT
OSBUF:	PUSHJ	P,%OBUF		;OUTPUT BUFFERFUL
	JRST	OSKP		;AND SETUP BUFFER PNTR/COUNT

%OBUF:	SKIPE	B36FLG(D)	;OPENED IN 36-BIT MODE?
	 JRST	BOSBUF		;YES. DO BINARY OUTPUT
	HRRZ	T1,IPTR(D)	;[4131] GET ADDRESS OF DATA
	JUMPE	T1,%POPJ	;[4131] IF NO DATA, LEAVE
	MOVE	T1,OJFN(D)	;GET JFN
	MOVE	T2,WADR(D)	;GET WINDOW ADDR
	SUBI	T2,1		;POINT TO WORD-1
	HXL	T2,BYTPT(D)	;GET END-OF-WORD BYTE PNTR
	MOVE	T3,WSIZ(D)	;GET WINDOW SIZE IN BYTES
	SUB	T3,ICNT(D)	;DECREMENT ACTIVE BYTE COUNT
	ADDM	T3,BYTN(D)	;UPDATE # BYTES WRITTEN IN FILE
	MOVN	T3,T3		;GET NEGATIVE
	SOUTR%			;OUTPUT THE BLOCK
	  ERJMP	OUTERR		;ERROR, GO TELL USER
	POPJ	P,

BOSBUF:	MOVE	T3,WSIZ(D)	;GET WINDOW SIZE IN BYTES
	SUB	T3,ICNT(D)	;CALC # BYTES USED
	ADDM	T3,BYTN(D)	;UPDATE # BYTES WRITTEN IN FILE

	HRRZ	T1,IPTR(D)	;[4131] GET ADDRESS OF DATA
	JUMPE	T1,%POPJ	;[4131] IF NO DATA, LEAVE
	MOVE	T1,IJFN(D)	;GET JFN
	MOVE	T2,WADR(D)	;GET ADDRESS OF BUFFER
	HRLI	T2,(POINT 36)	;GET BINARY BYTE POINTER
	HRRZ	T3,IPTR(D)	;GET CURRENT PNTR
	SUB	T3,WADR(D)	;GET WORD OFFSET
	ADDI	T3,1		;GET # WORDS USED
	MOVN	T3,T3		;GET NEGATIVE
	SOUTR%			;WRITE BUFFER
	  ERJMP	OUTERR		;ERROR, TYPE MESSAGE
	POPJ	P,

OSKP:	MOVE	T1,WADR(D)	;POINT TO EMPTY BUFFER
	SUBI	T1,1		;POINT TO WORD-1
	HXL	T1,BYTPT(D)	;CREATE PNTR
	MOVE	T2,WSIZ(D)	;GET FULL WINDOW SIZE
	DMOVEM	T1,IPTR(D)	;SAVE PNTR/COUNT
	POPJ	P,

OUTERR:	MOVE	T1,IJFN(D)	;[3343] GET THE STATUS
	GTSTS%			;[3343]
	TXZ	T2,GS%ERR	;[3343] CLEAR ERROR BIT
	STSTS%			;[3343]
	 $SNH			;[3343]
	$ACALL	IOE		;GENERAL I/O ERROR

> ;END IF20

;ROUTINE TO MAP WINDOW CONTAINING FIRST BYTE OF RANDOM RECORD
;THINGS ARE LEFT SET UP FOR NXTW IN CASE RECORD SPANS WINDOWS
;ARGS:	 A.REC = RECORD NUMBER TO SET TO
;RETURN: IPTR = POINTER TO FIRST BYTE OF RECORD
;	 ICNT = BYTES IN WINDOW
;	 BYTN = NUMBER OF FIRST BYTE IN FOLLOWING WINDOW


FIRMPW:	SKIPG	WTAB(D)		;LOCAL RANDOM FILE
	 POPJ	P,		;NO, LET RMS HANDLE IT
	PUSHJ	P,FRMAPW	;SETUP DESIRED BYTE NUMBER
	JRST	IRMPW		;GO CHECK IF EOF

FORMPW:	SKIPG	WTAB(D)		;LOCAL RANDOM FILE?
	 POPJ	P,		;NO, LET RMS HANDLE IT
	PUSHJ	P,FRMAPW	;SETUP DESIRED BYTE NUMBER
	PJRST	OMAPW		;AND MAP IT

UIRMPW:	PUSHJ	P,URMAPW	;SETUP DESIRED BYTE NUMBER
IRMPW:	MOVE	T1,BYTN(D)	;GET BYTE NUMBER OF RECORD START
	CAMGE	T1,EOFN(D)	;PAST EOF?
	 PJRST	IMAPW		;NO. MAP IT
	AOS	CREC(D)		;INCR RECORD NUMBER FOR MSG
	$ACALL	RNR		;YES. RECORD NOT WRITTEN

UORMPW:	PUSHJ	P,URMAPW	;SETUP DESIRED BYTE NUMBER
	PJRST	OMAPW		;AND MAP IT

FRMAPW:	SKIPA	T2,FRSIZB(D)	;GET FORMATTED RECORD SIZE
URMAPW:	 MOVE	T2,URSIZB(D)	;GET UNFORMATTED RECORD SIZE
RMAPW:	SKIPN	T1,A.REC	;GET ADDRESS OF RECORD NUMBER
	 $ACALL	CDS		;CAN'T DO SEQUENTIAL I/O TO DIRECT FILE
	SKIPG	T1,@T1		;GET RECORD NUMBER
	 $ACALL	IRN		;ILLEGAL RECORD NUMBER
	SUBI	T1,1		;GET # RECS BEFORE THIS ONE
	MOVEM	T1,CREC(D)	;STORE PREVIOUS RECORD NUMBER
	IMUL	T1,T2		;GET # BYTES BEFORE THIS ONE
	MOVEM	T1,BYTN(D)	;WHICH IS THE BYTE NUMBER OF REC BEG
	POPJ	P,

;ROUTINE TO MAP A FILE WINDOW FOR A RANDOM FILE
;ARGS:	 BYTN = FILE ADDRESS
;RETURN: IPTR = PROCESS BYTE POINTER
;	 ICNT = NUMBER OF BYTES LEFT IN WINDOW

LWSIZ==9			;A PAGE IS
PSIZ==1000			;A PAGE IS A PAGE IS A PAGE

IMAPW:	LOAD	T1,INDX(D)	;[5003] GET DEVICE INDEX
	JRST	IMPTAB(T1)	;[5003]

IMPTAB:	$SNH			;[5003] TTY - NO RANDOM I/O
	JRST	IMAPWD		;[5003] DSK
	$SNH			;[5003] MTA - NO RANDOM I/O
	$SNH			;[5003] OTHER - NO RANDOM I/O
IF20,<	JRST	IMAPWD		;[5003] REMOTE STREAM FILE
	JRST	%IRMS		;[5003] RMS FILE
> ;End IF20

IMAPWD:	PUSHJ	P,%SAVE2	;[5003] SAVE P1,P2
	PUSHJ	P,GETPAG	;GET PAGE, SETUP PNTR/COUNT
	DMOVEM	P1,IPTR(D)	;SAVE PNTR/COUNT
	PUSHJ	P,PAGCHK	;CHECK THE PAGE
	PUSHJ	P,MAPUPD	;UPDATE NEXT PAGE TO CHANGE
	POPJ	P,

OMAPW:	LOAD	T1,INDX(D)	;[5004] GET DEVICE INDEX
	JRST	OMPTAB(T1)	;[5004] DO DEVICE-DEPENDENT OUTPUT

OMPTAB:	$SNH			;[5004] TTY - NO RANDOM I/O
	JRST	OMAPWD		;[5004] DSK
	$SNH			;[5004] MTA - NO RANDOM I/O
	$SNH			;[5004] OTHER - NO RANDOM I/O
IF20,<	JRST	OMAPWD		;[5004] REMOTE STREAM FILE
	JRST	%UORMS		;[5004] RMS FILE
> ;End IF20

OMAPWD:	PUSHJ	P,%SAVE2	;[5004] SAVE P1,P2
	PUSHJ	P,GETPAG	;GET PAGE, SETUP PNTR/COUNT
	DMOVEM	P1,IPTR(D)	;SAVE PNTR/COUNT
	PUSHJ	P,SETWRT	;FLAG PAGE IS WRITTEN
	PUSHJ	P,MAPUPD	;UPDATE NEXT PAGE TO CHANGE
	POPJ	P,

GETPAG:	MOVE	P1,BYTN(D)	;GET BYTE NUMBER
	IDIV	P1,WSIZ(D)	;GET PAGE #
	MOVE	T1,WTAB(D)	;GET POINTER TO WINDOW TABLE
	LOAD	T2,BUFCT(D)

FINDW:	CAMN	P1,(T1)		;MATCH?
	 JRST	PAGMAT		;YES
	ADDI	T1,1		;INCR TABLE PNTR
	SOJG	T2,FINDW	;LOOP
	LOAD	T1,INDX(D)	;NOT IN CORE. GET DEVICE INDEX
	PUSHJ	P,RDWTAB(T1)	;GET THE PAGE INTO CORE
PAGMAT:	MOVE	P1,T1		;GET PNTR TO CORRECT ENTRY IN LIST
	SUB	P1,WTAB(D)	;GET PAGE OFFSET
	MOVEM	P1,WPAGE	;SAVE IT
	ADD	P1,WPTR(D)	;GET CORRESPONDING CORE PAGE #
	LSH	P1,LWSIZ	;MAKE IT A WORD ADDR
	SUBI	P1,1		;SHOULD POINT AT DESIRED WORD -1
	HXL	P1,BYTPT(D)	;MAKE IT A BYTE PNTR
	MOVE	T2,WSIZ(D)	;GET # BYTES IN WINDOW
	SUBI	T2,(P2)		;GET # BYTES AVAILABLE
	EXCH	P1,P2		;PUT THE BYTE REMAINDER IN P1
	ADJBP	P1,P2		;UPDATE THE BYTE PNTR
	MOVEI	P2,(T2)		;GET BYTES AVAILABLE WHERE IT SHOULD BE
	ADDM	P2,BYTN(D)	;SET BYTE NUMBER TO AFTER THIS WINDOW
	POPJ	P,

RDWTAB:	$SNH			;[5003] TTY - NO RANDOM I/O
	JRST	RDW		;[5003] DSK
	$SNH			;[5003] MTA - NO RANDOM I/O
	$SNH			;[5003] OTHER - NO RANDOM I/O
IF20,<	JRST	%RMRDW		;[5003] REMOTE STREAM FILE
	$SNH			;[5003] RMS FILE
> ;End IF20

MAPUPD:	MOVE	T2,WADR(D)	;GET REFILL POINTER TO WINDOW TABLE
	CAME	T2,WPAGE	;IS IT POINTING TO PAGE WE JUST USED?
	 POPJ	P,		;NO. LEAVE IT WHERE IT IS
	SOJGE	T2,PTRRET	;YES. POINT IT 1 BEHIND THIS ONE
	LOAD	T2,BUFCT(D)	;PASSED BEGINNING OF TABLE. POINT TO END
	SUBI	T2,1
PTRRET:	MOVEM	T2,WADR(D)	;RESET REFILL POINTER
	POPJ	P,

	SEGMENT	DATA

WPAGE:	BLOCK	1		;OFFSET INTO WTAB FOR MATCHED PAGE #

;**** DO NOT SEPARATE THESE WORDS *****
PAGNUM:	BLOCK	1		;PAGE NUMBER OF DESIRED BYTE
BYTUSD:	BLOCK	1		;# BYTES USED WITHIN THE PAGE

	SEGMENT	CODE

SETWRT:	MOVE	T2,WPAGE	;GET PAGE OFFSET
	ADD	T2,PFTAB(D)	;POINT TO MODIFIED PAGE TABLE
	SETOM	(T2)		;SET PAGE MODIFIED
	POPJ	P,

IF10,<
CHKPGS:
PAGCHK:	POPJ	P,
>;END IF10

IF20,<
PAGCHK:	LOAD	T3,ACC(D)	;GET ACCESS
	CAIE	T3,AC.RIN	;RANDIN?
	 POPJ	P,		;NO. DON'T MIND IF IT'S CREATED
	MOVE	T2,WPAGE	;GET PAGE # IN QUESTION
	ADD	T2,WPTR(D)
	LSH	T2,LWSIZ	;MAKE IT AN ADDRESS
	SKIP	(T2)		;REFERENCE A WORD IN THE PAGE
	 ERJMP	UNMAPR		;UNMAP THE PAGE IF NON-EXISTENT
	POPJ	P,

UNMAPR:	LSH	T2,-LWSIZ	;MAKE IT A PAGE AGAIN
	HRLI	T2,.FHSLF	;THIS FORK
	SETO	T1,		;SETUP UNMAP FUNCTION
	SETZ	T3,		;WITH NO REPEAT COUNT
	PMAP%			;UNMAP IT, SO IT WILL BE 0
	POPJ	P,

RDW:	MOVE	T2,WADR(D)	;GET PROCESS PAGE NUMBER
	ADD	T2,WPTR(D)
	HRLI	T2,.FHSLF	;FORK HANDLE
	HRLZ	T1,IJFN(D)	;JFN
	HRRI	T1,(P1)		;FILE PAGE NUMBER
	MOVSI	T3,(PM%PLD+PM%RD+PM%WR)	;ACCESS BITS
	PMAP%			;MAP PAGE IN
	 ERJMP	PGERR		;[3247]
	MOVE	T1,WADR(D)	;GET PAGE TABLE OFFSET AGAIN
	ADD	T1,WTAB(D)	;POINT INTO PAGE TABLE
	MOVEM	P1,(T1)		;STORE NEW FILE PAGE NUMBER
	POPJ	P,		;LEAVE WITH TABLE PNTR IN T1

>;END IF20
IF10,<
RDW:	PUSHJ	P,WRTPG		;WRITE PAGE BACK IF MODIFIED

	MOVE	T4,WADR(D)	;GET PAGE TABLE OFFSET
	ADD	T4,WPTR(D)	;GET CORE PAGE NUMBER
	LSH	T4,LWSIZ	;CONVERT TO ADDRESS
	MOVE	T5,P1		;GET FILE PAGE NUMBER AGAIN
	ADDI	T5,1		;GET # PAGES
	LSH	T5,LWSIZ	;GET # WORDS IN THESE PAGES
	CAMG	T5,LKPB+.RBSIZ(D) ;BEYOND WRITTEN WORDS?
	 JRST	RDWRP		;NO. NOTHING TO CLEAR
	SUB	T5,LKPB+.RBSIZ(D) ;GET # WORDS BEYOND THOSE WRITTEN
	CAILE	T5,PSIZ		;MORE THAN A PAGE?
	 MOVEI	T5,PSIZ		;YES. JUST CLEAR A PAGE

	MOVEI	T1,(T4)		;COPY PAGE ADDRESS
	ADDI	T1,PSIZ		;POINT TO LAST ADDR OF PAGE + 1
	SUBI	T1,(T5)		;POINT TO 1ST WORD TO CLEAR
	SETZM	(T1)		;CLEAR IT
	CAIG	T5,1		;MORE TO CLEAR?
	 JRST	RDWNC		;NO
	HRLI	T1,(T1)		;MAKE IT A BLT PNTR
	ADDI	T1,1
	BLT	T1,PSIZ-1(T4)	;CLEAR THE REST OF THE BLOCK

RDWNC:	SUBI	T5,PSIZ		;SET NEGATIVE # WORDS TO READ
	JUMPE	T5,RDWNW	;NO INPUT IF NO WORDS TO READ
	HRLI	T4,(T5)		;GET INTO IOWD FORMAT
	JRST	RDWCOM

RDWRP:	HRLI	T4,-PSIZ	;READ AN ENTIRE PAGE
RDWCOM:	SUBI	T4,1		;ADDR-1 FOR IOWD
	MOVEM	T4,DMPLST	;SAVE FOR DUMP INPUT
	SETZM	DMPLST+1

	MOVE	T2,CHAN(D)	;SET CHANNEL NUMBER
	HRRI	T2,.FOUSI	;SET USETI FUNCTION
	MOVE	T3,P1		;GET PAGE NUMBER
	IMULI	T3,4		;4 BLOCKS/PAGE
	ADDI	T3,1		;MAKE IT A BLOCK NUMBER
	MOVE	T1,[2,,T2]	;SET TO DESIRED BLOCK
	FILOP.	T1,
	 $ACALL	IOE

	MOVEI	T3,DMPLST	;SET ADDRESS OF COMMAND LIST
	MOVE	T2,CHAN(D)	;SET CHANNEL NUMBER
	HRRI	T2,.FOINP	;SET INPUT FUNCTION
	MOVE	T1,[2,,T2]	;SET ARG BLOCK POINTER
	FILOP.	T1,		;DO FILOP
	 $ACALL	IOE

RDWNW:	MOVE	T1,WADR(D)	;RELOAD WTAB POINTER
	ADD	T1,WTAB(D)
	MOVEM	P1,(T1)		;STORE NEW FILE PAGE NUMBER
	POPJ	P,		;LEAVE WITH TABLE PNTR IN T1

WRTPG:	MOVE	T1,WADR(D)	;GET PAGE TABLE OFFSET
	ADD	T1,PFTAB(D)	;POINT TO PAGE FLAG TABLE
	SKIPL	(T1)		;MODIFIED?
	 POPJ	P,		;NOT MODIFIED, NO NEED TO WRITE

	SETZM	(T1)		;TURN OFF PAGE MODIFIED FLAG

	MOVE	T2,CHAN(D)	;GET CHANNEL NUMBER
	HRRI	T2,.FOUSO	;SET USETO FUNCTION
	MOVE	T4,WADR(D)	;GET PAGE TABLE OFFSET TO THIS PAGE
	ADD	T4,WTAB(D)	;POINT INTO PAGE TABLE
	MOVE	T3,(T4)		;GET PAGE NUMBER
	IMULI	T3,4		;4 BLOCKS/PAGE
	ADDI	T3,1		;SET TO BLOCK #
	MOVE	T1,[2,,T2]	;SET ARG BLOCK POINTER
	FILOP.	T1,		;SET TO DESIRED BLOCK
	 $ACALL	IOE

	MOVE	T3,(T4)		;GET PAGE NUMBER AGAIN
	ADDI	T3,1		;GET # PAGES
	IMUL	T3,WSIZ(D)	;GET # BYTES TO END OF THIS PAGE
	CAMLE	T3,EOFN(D)	;BEYOND EOF?
	 MOVE	T3,EOFN(D)	;YES. USE EOF
	ADD	T3,BPW(D)	;ROUND UP TO # WORDS
	SUBI	T3,1
	IDIV	T3,BPW(D)	;GET # WORDS TO EOF
	CAMLE	T3,LKPB+.RBSIZ(D) ;BEYOND RECORDED LENGTH?
	 MOVEM	T3,LKPB+.RBSIZ(D) ;YES. SAVE IN LOOKUP/ENTER BLOCK
	ANDI	T3,PSIZ-1	;GET # WORDS TO WRITE
	JUMPE	T3,WRSBLK	;IF NO REMAINDER, WRITE FULL PAGE
	MOVNI	T3,(T3)		;GET NEGATIVE
	JRST	DOBWRT		;GO WRITE THE PAGE

WRSBLK:	MOVNI	T3,PSIZ		;STANDARD SIZE PAGE
DOBWRT:	MOVE	T2,CHAN(D)	;GET CHANNEL NUMBER AGAIN
	HRRI	T2,.FOOUT	;SET OUTPUT FUNCTION
	MOVE	T4,WADR(D)	;POINT TO WTAB ENTRY AGAIN
	ADD	T4,WPTR(D)	;GET CORE PAGE ADDR
	LSH	T4,LWSIZ	;MAKE INTO WORD ADDRESS
	SUBI	T4,1		;-1 FOR IOWD
	HRLI	T4,(T3)		;PUT COUNT IN LH
	SETZ	T5,		;ZERO TO END COMMAND LIST
	MOVEI	T3,T4		;POINT TO COMMAND LIST
	MOVE	T1,[2,,T2]	;SET ARG BLOCK POINTER
	FILOP.	T1,		;DO FILOP OR OUT UUO
	 $ACALL	IOE
	POPJ	P,		;DONE

;HERE AT CLOSE TO WRITE MODIFIED PAGES

%RANWR:	PUSHJ	P,%SAVE1	;SAVE P1
	SETZM	WADR(D)		;POINT TO BEG OF PAGE TABLE
	LOAD	P1,BUFCT(D)	;GET # PAGES
	
RWLP:	PUSHJ	P,WRTPG		;WRITE IT IF MODIFIED
	AOS	WADR(D)		;POINT TO NEXT PAGE
	SOJG	P1,RWLP		;DO ALL PAGES

	POPJ	P,		;DONE

> ;IF10

;SEQUENTIAL CASE, ONE N-PAGE WINDOW
;ARGS:	 BYTN = BYTE NUMBER IN FILE
;	 BUFCT = LENGTH OF WINDOW, PAGES


%OSMAP:	PUSHJ	P,%OSDSK	;OUTPUT THE CURRENT WINDOW
	PUSHJ	P,%SMAPW	;MAP THE DESIRED WINDOW
	PJRST	SETPTR		;GO SETUP PNTR/COUNT

%ISMAP:	MOVE	T1,BYTN(D)	;GET DESIRED BYTE #
	CAML	T1,EOFN(D)	;PAST EOF?
	  JRST	SMEOF		;YES. GO SET EOF FLAG
	PUSHJ	P,%SMAPW	;MAP THE DESIRED WINDOW
	PUSHJ	P,CHKPGS	;CHECK PAGE EXISTENCE
	PUSHJ	P,SETPTR	;SETUP PNTR/COUNT
	MOVE	T2,BYTN(D)	;GET BYTE # OF NEXT WINDOW
	CAMG	T2,EOFN(D)	;PAST EOF?
	 POPJ	P,		;NO. DONE
	SUB	T2,EOFN(D)	;GET DIFF
	MOVNI	T2,(T2)		;GET NEGATIVE
	ADDM	T2,ICNT(D)	;DECR COUNT APPROPRIATELY
	POPJ	P,

SMEOF:	MOVX	T1,D%END	;SET EOF
	IORM	T1,FLAGS(D)
	POPJ	P,

IF20,<
;%OSDSK - OUTPUT THE CURRENT OUTPUT WINDOW. NOTHING TO
;DO ON TOPS-20, AS UNMAPPING THE FILE IN CLOSE CODE WILL
;WRITE IT.
%OSDSK==%POPJ			;NO NEED TO OUTPUT DISK PAGES

%SMAPW:	MOVE	T2,BYTN(D)	;GET BYTE # IN FILE
	MOVE	T1,BPW(D)	;GET # BYTES/WORD
	LSH	T1,LWSIZ	;GET # BYTES/PAGE
	IDIV	T2,T1		;GET PAGE #
	DMOVEM	T2,PAGNUM	;SAVE PAGE #, BYTES USED IN PAGE
	MOVSI	T2,.FHSLF	;THIS FORK
	HRR	T2,WPTR(D)	;PAGE NUMBER IN FORK
	MOVE	T1,PAGNUM	;PAGE NUMBER IN FILE
	HRL	T1,IJFN(D)
	LOAD	T3,BUFCT(D)	;PAGE COUNT
	HRLI	T3,(PM%CNT+PM%PLD+PM%RD+PM%WR) ;ACCESS BITS, READ PAGES NOW
	PMAP%			;MAP WINDOW INTO FILE
	 ERJMP	PGERR		;[3247]
	POPJ	P,

PGERR:	HLRZ	T1,T2		;[3247] GET PROCESS HANDLE
	GETER%			;[3247]
	HRRZ	T1,T2		;[3247] GET ERROR NUMBER
	CAIE	T1,LNGFX1	;[3247] PAGE TABLE ERROR?
	 $ECALL	IJE		;[3247] NO
	$ACALL	RNR		;RECORD NOT WRITTEN

CHKPGS:	LOAD	T4,BUFCT(D)	;GET BUFFER COUNT
	MOVNI	T4,(T4)		;NEGATIVE
	MOVSI	T4,(T4)		;IN LEFT HALF
	HRR	T4,WPTR(D)	;GET PAGE # OF BOTTOM PAGE
CHPLP:	MOVEI	T1,(T4)		;GET CORE ADDR
	LSH	T1,LWSIZ
	SKIP	(T1)
	ERJMP	UNMPG		;IF NOT THERE, GO UNMAP
	AOBJN	T4,CHPLP	;BACK FOR MORE
	POPJ	P,		;DONE

UNMPG:	SETO	T1,		;SET TO UNMAP IT
	MOVSI	T2,.FHSLF	;THIS FORK
	HRRI	T2,(T4)		;GET THE CORRECT PAGE TO TOSS
	SETZ	T3,		;NO REPEAT COUNT
	PMAP%			;UNMAP THE PAGE
	AOBJN	T4,CHPLP	;BACK FOR MORE
	POPJ	P,		;DONE

> ;END IF20

;SETPTR - SETS UP BYTE POINTER/COUNT FOR THE WINDOW

SETPTR:	MOVE	T2,WSIZ(D)	;GET # BYTES IN WINDOW
	SUB	T2,BYTUSD	;GET # BYTES AVAILABLE
	ADDM	T2,BYTN(D)	;SET BYTE NUMBER TO AFTER THIS WINDOW
	MOVE	T3,WADR(D)	;GET WINDOW ADDRESS
	SUBI	T3,1		;POINT TO WORD ADDR-1
	HXL	T3,BYTPT(D)	;MAKE IT A BYTE PNTR
	MOVE	T1,BYTUSD	;GET # BYTES USED
	ADJBP	T1,T3		;UPDATE THE BYTE POINTER
	DMOVEM	T1,IPTR(D)	;SAVE PNTR/COUNT
	POPJ	P,

IF10,<

;%OSDSK - OUTPUT THE CURRENT OUTPUT WINDOW TO THE DISK
%OSDSK:	HRRZ	T1,IPTR(D)	;[4131] GET ADDRESS OF DATA
	JUMPE	T1,%POPJ	;[4131] IF NO DATA, LEAVE
	SUB	T1,WADR(D)	;GET # WORDS TO WRITE -1
	AOJE	T1,%POPJ	;IF NONE TO WRITE, LEAVE

	MOVE	T3,BYTN(D)	;GET BYTE NUMBER OF NEXT WINDOW
	SUB	T3,WSIZ(D)	;GET BYTE NUMBER OF CURRENT WINDOW
				;WHICH IS # BYTES PREVIOUS TO THIS ONE
	MOVE	T2,BPW(D)	;GET # BYTES/WORD
	LSH	T2,7		;GET # BYTES/BLOCK
	IDIVI	T3,(T2)		;GET BLOCK # OF PREVIOUS BLOCK
	CAMN	T3,BLKN(D)	;IS IT THE LAST BLOCK WRITTEN?
	 JRST	OSNUS		;YES. NO NEED FOR USETO
	MOVE	T2,CHAN(D)	;NO. SETUP FOR USETO
	HRRI	T2,.FOUSO
	ADDI	T3,1		;SET BLOCK # FOR CURRENT WINDOW
	MOVE	T1,[2,,T2]
	FILOP.	T1,		;DO USETO
	 $ACALL	IOE		;FAILED

OSNUS:	MOVE	T1,EOFN(D)	;GET HIGHEST BYTE TO WRITE
	MOVE	T2,BPW(D)	;GET # BYTES/WORD
	LSH	T2,7		;GET # BYTES/BLOCK
	ADDI	T1,-1(T2)	;GET # BLOCKS WRITTEN
	IDIVI	T1,(T2)		;ROUNDED
	MOVEM	T1,BLKN(D)	;AND RECORD THE LAST BLOCK # WRITTEN

	HRRZ	T1,IPTR(D)	;GET CURRENT PNTR
	SUB	T1,WADR(D)	;GET WORD OFFSET
	ADDI	T1,1		;GET # WORDS USED
	MOVNI	T1,(T1)		;NEGATIVE
	HRLZI	T1,(T1)		;IN LEFT HALF
	HRR	T1,WADR(D)	;GET ADDR
	SUBI	T1,1		;IOWD FORMAT
	MOVEM	T1,DMPLST	;SAVE IT
	SETZM	DMPLST+1	;END THE LIST
	MOVE	T2,FBLK(D)	;GET CHANNEL STUFF
	HRRI	T2,.FOOUT
	MOVEI	T3,DMPLST	;POINT TO IOWD
	MOVE	T1,[2,,T2]	;DO FILOP
	FILOP.	T1,
	 JRST	ERRCHK
	POPJ	P,

%OBUF:
OSBUF:	MOVE	T1,WSIZ(D)	;INCREMENT BYTE COUNT
	SUB	T1,ICNT(D)	;WITH # BYTES USED IN THIS BUFFER
	ADDM	T1,BYTN(D)

	MOVE	T2,CHAN(D)	;WRITE CURRENT BLOCK
	HRRI	T2,.FOOUT
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 JRST	ERRCHK		;[3343] REPORT ERROR AND DIE
	MOVE	T1,WADR(D)	;[4141] SETUP POINTER CORRECTLY
	SUBI	T1,1		;[4141]
	HXL	T1,BYTPT(D)	;[4141]
	MOVEM	T1,IPTR(D)	;[4141] SAVE IT
	POPJ	P,		;DONE

%SMAPW:	MOVE	T3,BYTN(D)	;GET BYTE # DESIRED
	MOVE	T2,BPW(D)	;GET # BYTES/WORD
	LSH	T2,LWSIZ	;GET # BYTES/PAGE
	IDIVI	T3,(T2)		;GET PAGE #, # BYTES LEFTOVER
	DMOVEM	T3,PAGNUM	;SAVE THEM

	MOVE	T1,WSIZ(D)	;GET WINDOW SIZE AGAIN
	MOVEI	T2,(T1)		;COPY IT
	SUB	T2,BYTUSD	;DECR BY # BYTES USED
	ADD	T2,BYTN(D)	;CALC TOTAL # BYTES IF WINDOW IS FULL
	CAMG	T2,EOFN(D)	;PAST EOF?
	 JRST	GOTWS		;NO. READ ENTIRE WINDOW

	SUB	T2,EOFN(D)	;YES. GET DIFFERENCE
	SUBI	T1,(T2)		;DECR # BYTES TO BE READ
	JUMPE	T1,%POPJ	;IF NONE TO READ, LEAVE NOW
	ADD	T1,BPW(D)
	SUBI	T1,1		;ROUND TO WORDS
	IDIV	T1,BPW(D)	;GET # WORDS TO READ

	MOVE	T3,EOFN(D)	;GET # BYTES IN FILE
	MOVE	T4,BPW(D)	;GET # BYTES/WORD
	LSH	T4,7		;GET # BYTES/BLOCK
	ADDI	T3,-1(T4)	;GET ROUNDED # BLOCKS IN FILE
	IDIVI	T3,(T4)
	MOVEM	T3,BLKN(D)	;SAVE LAST BLOCK # READ
	JRST	ISDMP		;JOIN COMMON CODE

GOTWS:	MOVE	T3,BPW(D)	;GET # BYTES/WORD
	LSH	T3,7		;GET # BYTES/BLOCK
	IDIVI	T2,(T3)		;CALC LAST BLOCK # READ
	MOVEM	T2,BLKN(D)	;SAVE IT
	MOVE	T1,WSIZ(D)	;GET WINDOW SIZE
	IDIV	T1,BPW(D)	;GET # WORDS

ISDMP:	MOVNI	T1,(T1)		;GET NEGATIVE # WORDS TO READ
	HRLZI	T1,(T1)		;IN IOWD FORMAT
	HRR	T1,WADR(D)
	SUBI	T1,1
	MOVEM	T1,DMPLST	;SAVE FOR INPUT
	SETZM	DMPLST+1	;END THE LIST

	MOVE	T3,PAGNUM	;GET THE PAGE NUMBER AGAIN
	IMULI	T3,4		;GET BLOCK # OF PREVIOUS BLOCK
	CAMN	T3,BLKN(D)	;SAME AS PREVIOUS BLOCK READ OR WRITTEN?
	 JRST	%SNXTW		;YES. NO NEED FOR USETI
	ADDI	T3,1		;FIRST BLOCK IS 1
	MOVE	T2,FBLK(D)	;GET CHANNEL STUFF
	HRRI	T2,.FOUSI	;DO USETI TO POINT TO CORRECT PAGE
	MOVE	T1,[2,,T2]	;DO FILOP
	FILOP.	T1,
	 JRST	ERRCHK		;SHOULD NOT FAIL

%SNXTW:
	MOVE	T2,FBLK(D)	;GET CHANNEL STUFF
	HRRI	T2,.FOINP
	MOVEI	T3,DMPLST	;POINT TO IOWD
	MOVE	T1,[2,,T2]	;DO FILOP
	FILOP.	T1,
	 JRST	ERRCHK		;SHOULD NOT GET EOF!
	POPJ	P,

%ISBUF:	MOVE	T1,WSIZ(D)	;INCREMENT BYTE COUNT
	ADDM	T1,BYTN(D)
	MOVE	T2,CHAN(D)	;GET CHANNEL STUFF
	HRRI	T2,.FOINP	;READ NEXT BLOCK
	MOVE	T1,[1,,T2]
	FILOP.	T1,
	 PUSHJ	P,EOFCHK
	MOVE	T1,WADR(D)	;[4141] SETUP POINTER/COUNT
	SUBI	T1,1		;[4141] 
	HXL	T1,BYTPT(D)	;[4141]
	MOVEM	T1,IPTR(D)	;[4141] SAVE IT
	POPJ	P,

EOFCHK:	TXNN	T1,IO.EOF	;[3343] CHECK FOR EOF
	 JRST	ERRCHK		;[3343] NO
	LOAD	T2,INDX(D)	;GET DEV INDEX
	CAIE	T2,DI.TTY	;[3343] TERMINAL?
	  JRST	SETEOF		;[3343] YES

	MOVE	T2,[1,,T3]	;SET UP FOR CLOSE
	MOVEI	T3,.FOCLS
	HLL	T3,CHAN(D)
	FILOP.	T2,		;CLEAR EOF BIT, LEAVE TTY OPEN
	 $ACALL	IOE

SETEOF:	MOVX	T0,D%END	;[3343] Get EOF flag
	 IORM	T0,FLAGS(D)	;Yes, this file is ended
	POPJ	P,		;[3343]

ERRCHK:	MOVE	T2,CHAN(D)	;[3343] Set up for getting
	HRRI	T2,.FOGET	;[3343]   status bits
	MOVE	T1,[1,,T2]	;[3343] 
	FILOP.	T1,		;[3343]
	 $SNH			;[3343]
	MOVE	T4,T1		;[3343] Save the status
	TXZ	T1,IO.ERR	;[3343] Clear error bits
	MOVE	T3,T1		;[3343] Set up for setting
	HRRI	T2,.FOSET	;[3343]   status
	MOVE	T1,[2,,T2]	;[3343]
	FILOP.	T1,		;[3343]
	 $SNH			;[3343]
	MOVE	T1,T4		;[3343] Set up for abort
	 $ACALL	IOE

	SEGMENT	DATA

DMPNTR:	BLOCK	1		;DUMP LIST PNTR
DMPLST:	BLOCK	MAXARG+1	;DUMP I/O LIST
	BLOCK	1		;THE ZERO WORD (JUST IN CASE)

	SEGMENT	CODE
> ;IF10
	SUBTTL	MTOP - Tape Positioning
;++
; FUNCTIONAL DESCRIPTION:
;
;	These routines handle the positioning for the FORTRAN statements
;	REWIND, UNLOAD, BACKSPACE, BACKFILE, ENDFILE and SKIPRECORD. 
;	They are mostly used for magnetic tape; However they may (and are)
;	used for Disk operations.
;
; CALLING SEQUENCE:
;
;	MOVEI	16,ARGADR	;Address of standard format arg list
;	PUSHJ	P,MTOP		
;
; INPUT PARAMETERS:
;
;	Unknown
;
; IMPLICIT INPUTS:
;
;	Unknown
;
; OUTPUT PARAMETERS:
;
;	Unknown
;
; IMPLICIT OUTPUTS:
;
;	Unknown
;
; SIDE EFFECTS:
;
;	May issue fatal error messages. Also, may truncate existing files.
;
;--
	FENTRY	(MTOP)		;FORTRAN entry point
	PUSHJ	P,%SAVAC	;Save Accumulators
	PUSHJ	P,%CPARG	;Make copy of argument list
	PUSHJ	P,MTCNV		;Convert argument list (if necessary)
;
;  We don't know the name of the statement yet so make it a null
;
	XMOVEI	T1,[0]		;Make a pointer to a null string
	MOVEM	T1,%IONAM	;Save it as the statement name.

	PUSHJ	P,IOARG		;Move args to A.XXX
	PUSHJ	P,CHKUNT	;Check for unit number in range
				;(Goes to ABORT% if unit is bad)
;
;  Check the Operation Code Argument; Issue error if illegal.
;
	SKIPL	T1,@A.MTOP	;GET OPERATION CODE
	CAILE	T1,MOPMAX	;NEGATIVE OR TOO BIG?
	 $ACALL	IMV		;ILLEGAL MTOP VALUE

;
;  Set statement name from operation code. The statement name 
;  is used for the error message traceback.
;
	XMOVEI	T2,.		;Current section number in LH
	HRR	T2,MOPNAM(T1)	;Get global address of ASCIZ name
	MOVEM	T2,%IONAM	;Set statement name for error messages
;
;  Set up "U" and "D". These are pointers to the UDB (unit Device Block)
;  and the DDB (Device Data Block) which hold information about the unit
;  See FORPRM for a description of these structures.
;
	MOVE	T1,%CUNIT	;GET UNIT NUMBER
	SKIPN	U,%DDBTA(T1)	;GET UDB ADDR
	 PUSHJ	P,GETD		;NONE. ESTABLISH A NEW ONE
	MOVEM	U,%UDBAD	;WE HAVE STARTED AN I/O STATEMENT
	MOVE	D,DDBAD(U)	;GET DDB ADDR
;
;  Check to see if this is a RANDOM access file; File positioning
;  operations are ILLEGAL on a random file.
;
	SKIPE	WTAB(D)		;Random File?
	 $ACALL	POI		;Yes; Issue an error.
;
;  Dispatch each positioning operation by its "Operation Code" and
;  when finished performing the specific operation set the IOSTAT
;  and the ASSOCIATEVARIABLE (ect...) and return
;
	MOVE	T1,@A.MTOP	;Get back MTOP number
	PUSHJ	P,@MOPDSP(T1)	;GO DO OPERATION
	PJRST	%SETAV		;RETURN (possibly doing ERR=, etc.)
;
;  Table of statement names for each operation code
;
MOPNAM:	[ASCIZ /REWIND/]	;(0)
	[ASCIZ /UNLOAD/]	;(1)
	[ASCIZ /BACKSPACE/]	;(2)
	[ASCIZ /BACK FILE/]	;(3)
	[ASCIZ /ENDFILE/]	;(4)
	[ASCIZ /SKIP RECORD/]	;(5)
	[0]			;(6)
	[ASCIZ /SKIP FILE/]	;(7)
MOPMAX==.-MOPNAM
;
;  Dispatch table for each specific operation code
;
MOPDSP:	IFIW	MOPREW
	IFIW	MOPUNL
	IFIW	MOPBSR
	IFIW	MOPBSF
	IFIW	MOPEND
	IFIW	MOPSKR
	IFIW	%POPJ
	IFIW	MOPSKF		;End of routine MTOP
	SUBTTL	MOPREW - REWIND Tape Positioning

;++
;  When used for Disk files causes the specified file to be positioned 
;  at its initial point. 
;  For magnetic tape, positions the magtape unit at the Physical Begining
;  of Tape. 
;-

;
;  Perform the REWIND based on the type of device.
;
MOPREW:	LOAD	T1,INDX(D)	;GET DEV INDEX
	PJRST	REWTAB(T1)	;DO REWIND BY DEVICE
;
;  Dispatch table for device specific rewind code
;
REWTAB:	POPJ	P,		;(0) TTY:
	JRST	DSKREW		;(1) DSK:
	JRST	MTAREW		;(2) MTA:
	POPJ	P,		;(3) Anything Else
IF20,<	JRST	DSKREW		;(4) Remote Stream File 
	JRST	%RMREW		;(5) RMS File
> ;End IF20
;
;  REWIND for DISK devices
;
;  If the device was opened for OUTPUT we need to close the file and 
;  re-open the file for input. Now we're at the begining of the file.
;
DSKREW:	MOVX	T1,D%END	;SET NO EOF
	ANDCAB	T1,FLAGS(D)	;AND GET THEM
	TXNE	T1,D%OUT	;WAS IT OPEN FOR OUTPUT?
	 PUSHJ	P,%SETIN	;YES. SWITCH TO INPUT
;
;  Reset the pointers used by the I/O to the begining.
;
	SETZM	CREC(D)		;CLEAR RECORD NUMBER
	SETZM	IPTR(D)		;PRETEND NO I/O DONE
	SETZM	ICNT(D)		;NO BYTES IN BUFFER
	SETZM	BYTN(D)		;SET CURRENT BYTE NUMBER TO 0
	POPJ	P,		;End of DSKREW
;
;  REWIND for MAGTAPE devices.
;
MTAREW:	MOVE	T1,FLAGS(D)	;Get DDB flags

	TXNN	T1,D%IN+D%OUT	;If the unit is not open,
	 JRST	JSTREW		;DON'T CLOSE, OPEN FILE

	TXNE	T1,D%OUT+D%END	;is the unit OPEN FOR OUTPUT OR AT EOF?
	 PUSHJ	P,%MTCLI	;YES. CLOSE FILE, OPEN FOR INPUT

	SETZM	CREC(D)		;CLEAR RECORD NUMBER
	HXLZ	T1,BYTPT(D)	;[4131] GET BYTE POINTER
	MOVEM	T1,IPTR(D)	;[4131] SAVE IT
	SETZM	ICNT(D)		;NO BYTES IN BUFFER
	SETZM	BYTN(D)		;SET CURRENT BYTE NUMBER TO 0

	LOAD	T1,LTYP(D)	;GET LABEL TYPE
	CAIE	T1,LT.UNL	;is it an UNLABELED tape?
	 JRST	%MTBSF		;No, its labeled; Backspace 1 file.
	JRST	%MTREW		;YES. Go back to physical BOT 

;
;  Rewind a device which is not OPENed. If this a Labeled tape
;  then just go back to begining of current file.
;

JSTREW:	PUSHJ	P,MTAOJF	;Open JFN, aborts if fails
	PUSHJ	P,%MTREW	;NO. GO BACK 1 FILE INSTEAD
	PJRST	MTACJF		;Close file, release JFN, return
				;End of routine MOPREW

	SUBTTL	MOPUNL - UNLOAD Tape Positioning
;++
;  Rewind and unloads a magnetic tape on the specified unit.
;--

MOPUNL:	LOAD	T1,INDX(D)	;GET DEV INDEX
	PJRST	UNLTAB(T1)	;UNLOAD BY DEVICE TYPE

UNLTAB:	POPJ	P,		;TTY. UNLOAD THE RIBBON?
	JRST	DSKREW		;DSK. JUST LIKE A REWIND
	JRST	MTAUNL		;MTA
	POPJ	P,		;NO OTHER DEVICE CAN BE UNLOADED
IF20,<	JRST	DSKREW		;[5004] REMOTE STREAM FILE
	JRST	%RMREW		;[5004] RMS FILE
> ;End IF20

;
;  UNLOAD for MAGTAPE devices 
;

MTAUNL:	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNN	T1,D%IN+D%OUT	;If not opened yet,
	 JRST	JSTUNL		;Don't call "SETIN"
	TXNE	T1,D%OUT+D%END	;OPEN FOR OUTPUT OR AT EOF?
	 PUSHJ	P,%MTCLI	;CLOSE FILE, OPEN FOR INPUT
	HXLZ	T1,BYTPT(D)	;[4131] GET BYTE POINTER
	MOVEM	T1,IPTR(D)	;[4131] SAVE IT
	SETZM	ICNT(D)		;NO BYTES IN BUFFER
	SETZM	BYTN(D)		;SET CURRENT BYTE NUMBER TO 0
	SETZM	CREC(D)		;CLEAR RECORD COUNT
	PJRST	%MTUNL		;UNLOAD THE TAPE

;
;  Just UNLOAD (for a device which isn't OPENed).
;  TOPS-20 needs a JFN for the device. TOPS-10 doesn't.
;
JSTUNL:	PUSHJ	P,MTAOJF	;Get a JFN with no filename
	PUSHJ	P,%MTUNL	;UNLOAD it
	PJRST	MTACJF		;Close, release JFN and return
				;End of routine MOPUNL

	SUBTTL	MOPBSR - BACKSPACE Tape Positioning
;++
;  BACKSPACE Statement
;
;  Execution of the BACKSPACE statement causes the file connected to
;  the specified unit to be positioned before the precedeing record.
;  If there is no preceeding record, the position of the file is not 
;  changed. If the preceeding record is an ENDFILE record, the file
;  is positioned before the ENDFILE record.
;
;  The backspace statement cannot be used for direct-access files,
;  append-access or for list-directed files.
;--

MOPBSR:	SKIPE	FUMXD(D)	;MIXED-MODE FILE?
	 $ACALL	CDF		;YES. CAN'T DETERMINE FORM=

	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PJRST	BSRTAB(T1)	;DO BACKSPACE BY DEVICE TYPE

BSRTAB:	POPJ	P,		;TTY
	JRST	DSKBSR		;DISK
	JRST	MTABSR		;MAGTAPE
	POPJ	P,		;OTHER
IF20,<	JRST	DSKBSR		;[5013] REMOTE STREAM FILE
	JRST	%RMBSR		;[5013] RMS FILE
> ;End IF20

;[4156] SEPARATE (AND COPY) THIS FROM DISK CODE
MTABSR:
;
; [5006] Labeled tapes can't perform a backspace record
;
	LOAD	T1,LTYP(D)	;[5006]Get label type
	CAIE	T1,LT.UNL	;[5006] If its' labeled give error
	 $ACALL	 NLT		;[5006] Not allowed with Labeled Mag tape 

	PUSHJ	P,%SETIN	;Switch to input if necessary
	SKIPG	CREC(D)		;ARE WE AT BEG OF FILE?
	 POPJ	P,		;YES. CAN'T GO BACKWARDS

	MOVE	T0,FLAGS(D)
	TXNE	T0,D%END	;FILE AT END?
	 JRST	BAKEOF		;YES. JUST BACK OVER IT

	HRRZ	T1,IPTR(D)	;[4131] GET ADDRESS OF DATA
	JUMPE	T1,%POPJ	;[4131] IF NO DATA, LEAVE
	SOS	CREC(D)		;DECR RECORD COUNT
;
; [4151] Is this a labeled tape?
;
	LOAD	T1,LTYP(D)	;Get label type
	CAIE	T1,LT.UNL	;[4156] Is it an unlabeled tape?
	 JRST	BSRLAB		;No, it's labeled
;
; [4151] Is this tape using delimited records?
;
	LOAD	T1,RECTP(D)	;Get record type 
	CAIN	T1,RT.DEL	;Is it delimited?
	 JRST	BSRDEL		;Yes, go do a delimited backspace!
	JRST	COMBSR		;JOIN COMMON CODE

DSKBSR:	PUSHJ	P,%SETIN	;Switch to input if necessary
	SKIPG	CREC(D)		;ARE WE AT BEG OF FILE?
	 POPJ	P,		;YES. CAN'T GO BACKWARDS

	LOAD	T1,MODE(D)	;GET MODE
	CAIN	T1,MD.DMP	;DUMP?
	 POPJ	P,		;YES. A NOP

	MOVE	T0,FLAGS(D)
	TXNE	T0,D%END	;FILE AT END?
	 JRST	BAKEOF		;YES. JUST BACK OVER IT

	HRRZ	T1,IPTR(D)	;[4131] GET ADDRESS OF DATA
	JUMPE	T1,%POPJ	;[4131] IF NO DATA, LEAVE
	SOS	CREC(D)		;DECR RECORD COUNT

COMBSR:	LOAD	T0,FORM(D)	;GET FORM=
	CAIN	T0,FM.UNF	;UNFORMATTED?
	 JRST	UNFBSR		;YES.

	SKIPE	P3,FRSIZB(D)	;FIXED-LENGTH RECORDS?
	 JRST	BFCOM		;YES. JOIN COMMON CODE

BSRVAR:	PUSHJ	P,FBTST		;FIND CURRENT EOL
	HRRZ	T1,IPTR(D)
	CAMGE	T1,WADR(D)	;BEG OF WINDOW?
	 POPJ	P,		;BACKSPACED TO BEG OF FILE

FBSLP:	AOS	ICNT(D)		;INCR COUNT
	MOVNI	T1,1		;BACK 1 CHAR
	ADJBP	T1,IPTR(D)	;GET NEW PNTR
	MOVEM	T1,IPTR(D)	;SAVE IT BACK
FBTST:	HRRZ	T1,IPTR(D)	;GET ADDR PART OF PNTR
	CAMGE	T1,WADR(D)	;BEG OF WINDOW?
	 PUSHJ	P,PRVWIN	;YES. GET PREVIOUS ONE
	HRRZ	T1,IPTR(D)
	CAMGE	T1,WADR(D)	;STILL BEG OF WINDOW?
	 POPJ	P,		;BACKSPACED TO BEG OF FILE
	LDB	T1,IPTR(D)	;GET BYTE
	CAIL	T1,12		;LF, VT, FF?
	CAILE	T1,14
	 JRST	FBSLP		;NO
	POPJ	P,

;+				;[4151]
;  Routine to perform a backspace for delimited records
;  See if we're already at the begining of the window (or file)
;-
BSRDEL:	HRRZ	T1,IPTR(D)	;Get address of current Pointer
	CAMGE	T1,WADR(D)	;Is it the begining of the window?
	 PUSHJ	P,PRVWIN	;Yes. Get previous window.
	HRRZ	T1,IPTR(D)	;Get address of current Pointer, again
	CAMGE	T1,WADR(D)	;Are we still at the begining of window?
	 POPJ	P,		;Yes, must be at the begining of file.

	MOVE	T1,WADR(D)	;Make byte pointer to buffer
	SUBI	T1,1		;Point to begining -1
	HXL	T1,BYTPT(D)	;

;  Read out the RCW and convert it to binary
;  T0=Length of string, T1=Source string byte pointer, T4=Result

BSRDLP:	PUSH	P,T1		;Save the origional byte pointer
	MOVEI	T0,4		;GET # BYTES IN DELIMITER (RCW)
	EXTEND	T0,[<CVTDBO 777720>] ;Convert the RCW to binary
	 $ACALL	ICD		;Illegal character in delimiter
	POP	P,T1		;Restore the origional byte pointer

;  Advance the pointer by the number of characters in this record.
;  And check to see if we're back to the starting position. 


	MOVE	T2,T4		;Preserve record size in T4 (for later)
	ADJBP	T2,T1		;Adjust pointer to begining of next record.
	CAMN	T2,IPTR(D)	;Same place as before?
	 JRST   BSRDOK		;Yes. We're back to the begining, again
	MOVE	T1,T2		;No. Use this new byte pointer this time!
	SETZ	T2,		;For good clean fun!
	JRST	BSRDLP		;GO TRY NEXT RECORD.

;  Well we did all this to get the pointer to the previous record,
;  So, let's save all this info.

BSRDOK:	MOVEM	T1,IPTR(D)	;Save previous record position
	MOVEM	T4,ICNT(D)	;Save the record size (excluding RCW)
	POPJ	P,		;End of routine BSRDEL

;+				;[4151]
;  Backspace for labeled tapes
;-
BSRLAB:	SETZB	T1,IPTR(D)	;Zero the pointer.
	MOVEM	T1,ICNT(D)	;zero the count.
	PJRST	%MTBSB		;Go tell the monitor to do it 

;+
;  Get the previous window.
;-
PRVWIN:	LOAD	T1,INDX(D)	;GET DEV INDEX
	CAIN	T1,DI.MTA	;TAPE?
	  JRST	MTABSA		;YES

	PUSHJ	P,%PTOF		;GET FILE BYTE NUMBER OF CURRENT BYTE
	SUB	T1,BPW(D)	;GET BYTE NUMBER OF PREVIOUS WORD
	JUMPLE	T1,%POPJ	;SHOULD NEVER BE NEGATIVE IN FILE
	MOVEM	T1,BYTN(D)	;STORE FOR MAPPING
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PUSHJ	P,ISTAB(T1)	;GET THE DESIRED WINDOW
	AOS	IPTR(D)		;INCR THE POINTER
	MOVN	T1,BPW(D)	;AND DECR THE COUNT
	ADDM	T1,ICNT(D)
	POPJ	P,

%MTBSA:
MTABSA:	PUSHJ	P,%MTBSB	;BACKSPACE OVER THE CURRENT BLOCK
MTABS1:	PUSHJ	P,%MTBSB	;BACKSPACE OVER THE PREVIOUS BLOCK
	PUSHJ	P,%ISBUF		;READ IT
	MOVE	T1,ICNT(D)	;GET THE NUMBER OF BYTES FOUND
	MOVEM	T1,BYTUSD	;SAVE IT
	ADJBP	T1,IPTR(D)	;POINT TO THE END OF THE BUFFER
	MOVEM	T1,IPTR(D)	;AND SAVE IT
	SETZM	ICNT(D)		;CLEAR THE COUNT
	POPJ	P,

UNFBSR:	SKIPN	IMGFLG(D)	;[4161] IMAGE?
	 JRST	BINBSR		;NO. GO LOOK FOR LCSW TYPE 3

;IMAGE MODE. GET RECORDSIZE IN BYTES, GO TO COMMON CODE
	SKIPN	P3,URSIZB(D)	;RECORDSIZE SPECIFIED?
	 $ACALL	CBI		;CAN'T BACKSPACE IF NO RECSIZ
	JRST	BFCOM		;JOIN COMMON CODE

BINBSR:	HRRZ	T1,IPTR(D)	;GET ADDR IN CURRENT PNTR
	CAMGE	T1,WADR(D)	;AT BEG OF WINDOW?
	 PUSHJ	P,PRVWIN	;YES. MOVE BACK TO PREVIOUS WORD
	HRRZ	P3,IPTR(D)	;GET LOCAL ADDR
	MOVE	P3,(P3)		;GET END LSCW
	TLZ	P3,777000	;GET LENGTH IN WORDS
	IMUL	P3,BPW(D)	;GET # BYTES IN RECORD

;NOW WE CALCULATE THE NUMBER OF BYTES TO THE CURRENT BYTE POINTER IN THIS
;BUFFER. COMPARE IT WITH THE RECORDSIZE. IF BACKSPACE WILL STILL BE IN
;THIS BUFFER, WE CAN JUST DO AN ADJBP AND MODIFY THE COUNT. OTHERWISE
;WE HAVE TO REMAP (DISK) OR BACKSPACE ITERATIVELY (MTA).
BFCOM:	HRRZ	T1,IPTR(D)	;GET CURRENT ADDR
	SUB	T1,WADR(D)	;GET OFFSET FROM BEG
	ADDI	T1,1		;ADD THE CURRENT WORD
	IMUL	T1,BPW(D)	;GET BYTE OFFSET
	MOVE	T2,IPTR(D)	;GET POINTER PART
	MUL	T2,BPW(D)	;GET # BYTES LEFT IN CURRENT WORD
	SUBI	T1,(T2)		;GET # BYTES USED
	MOVEM	T1,BYTUSD	;SAVE IT
	CAIGE	T1,(P3)		;BACKSPACE WITHIN THIS WINDOW?
	 JRST	COMBAK		;NO. MAP DISK OR LOOP MAGTAPE

	ADDM	P3,ICNT(D)	;UPDATE COUNT
	MOVNI	P3,(P3)		;GET NEG BYTE DIFF
	ADJBP	P3,IPTR(D)	;UPDATE PNTR
	MOVEM	P3,IPTR(D)	;SAVE IT
	POPJ	P,

COMBAK:	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIN	T1,DI.MTA	;MAGTAPE?
	 JRST	MTABSW		;YES

	PUSHJ	P,%PTOF		;CALC FILE POINTER
	SUB	T1,P3		;[4217] CALC DESIRED FILE POINTER
	MOVEM	T1,BYTN(D)	;SAVE FOR MAPPING
	LOAD	T1,INDX(D)	;GET DEVICE INDEX AGAIN
	PJRST	ISTAB(T1)	;GO MAP THE WINDOW DESIRED

MTABSW:	SUB	P3,BYTUSD	;REDUCE # BYTES TO BACKSPACE
	PUSHJ	P,MTABSA	;BACKSPACE OVER CURRENT AND PREVIOUS, READ
	MOVE	T1,BYTUSD	;GET # BYTES IN THE BUFFER
	CAIGE	T1,(P3)		;BACKSPACE WITHIN THIS BLOCK?
	 JRST	MTABSW		;NO. TRY AGAIN
	ADDM	P3,ICNT(D)	;YES. ADJUST COUNT
	MOVNI	P3,(P3)		;AND POINTER
	ADJBP	P3,IPTR(D)
	MOVEM	P3,IPTR(D)	;SAVE UPDATED POINTER
	POPJ	P,

	SUBTTL	MOPBSF - BACKFILE Tape Positioning
;+
;  This statement is used only for magnetic tape operations. If an
;  end-of-file has been detected the tape will be positioned to the 
;  begining of that file. Otherwise, the tape will be positioned to
;  the begining of the previous file on the tape.
;-

MOPBSF:	LOAD	T1,INDX(D)	;GET DEV INDEX
	CAIE	T1,DI.MTA	;IS THIS A MAGTAPE?
	  POPJ	P,		;NO, BACKFILE IS NOP

	PUSHJ	P,%SETIN	;Make sure we're open for input
	HXLZ	T1,BYTPT(D)	;[4131] GET BYTE POINTER
	MOVEM	T1,IPTR(D)	;[4131] SAVE IT
	SETZM	ICNT(D)		;NO BYTES IN BUFFER
	SETZM	BYTN(D)		;SET CURRENT BYTE NUMBER TO 0
	SETZM	CREC(D)		;CLEAR RECORD COUNT

	MOVX	T1,D%END	;WE ARE NOW NOT AT EOF
	ANDCAM	T1,FLAGS(D)

	PUSHJ	P,%MTBSF	;BACKSPACE A FILE
	PUSHJ	P,%MTBSF	;AND ANOTHER
	PUSHJ	P,BOTCHK	;ARE WE AT BOT?
	 PUSHJ	P,%MTFSF	;NO. SKIP PAST A TAPE MARK
	PJRST	%MTCLI		;CLEAR EOF STATUS IF ANY
				;End of routine MOPBSF

	SUBTTL	MOPEND - ENDFILE Tape positioning
;+
;  Closes the file on the specified unit.
;  For disk and magtape units an 'endfile' record is written and 
;  positioned after the end of file mark.
;-

MOPEND:	AOS	CREC(D)		;INCR REC #
	LOAD	T1,INDX(D)	;GET DEV INDEX
	PJRST	ENDTAB(T1)	;ENDFILE BY DEVICE TYPE

ENDTAB:	POPJ	P,		;TTY
	JRST	DSKEND		;DSK
	JRST	MTAEND		;MTA
	POPJ	P,		;OTHER DEVICE
IF20,<	JRST	DSKEND		;[5004] REMOTE STREAM FILE
	JRST	%RMEND		;[5004] RMS FILE
> ;End IF20
;
; ENDFILE for MAGTAPE devices
;
MTAEND:
;
; [5006] Labeled tapes can't do an ENDFILE
;
	LOAD	T1,LTYP(D)	;[5006]Get label type
	CAIE	T1,LT.UNL	;[5006] If its' labeled give error
	 $ACALL	 NLT		;[5006] Not allowed with Labeled Mag tape 

	PUSHJ	P,%SETOUT	;Set to output
	PUSHJ	P,%MTCLI	;CLOSE FILE, OPEN FOR INPUT AGAIN
	MOVE	T1,FLAGS(D)
	TXO	T1,D%IN+D%END	;WE ARE OPEN FOR INPUT, AT EOF
	TXZ	T1,D%OUT	;NO LONGER DOING OUTPUT
	MOVEM	T1,FLAGS(D)
	POPJ	P,
;
; ENDFILE for DISK devices
;
DSKEND:	PUSHJ	P,%SETOUT	;SET TO OUTPUT
	PUSHJ	P,%SETIN	;AND THEN TO INPUT AGAIN
	MOVX	T1,D%END	;AT EOF
	IORM	T1,FLAGS(D)
	POPJ	P,		;DONE

	SUBTTL	MOPSKR - SKIPRECORD statement
;+
; Skips the next record in the file.  Cannot be used on 
; direct access files.
;-

MOPSKR:	SKIPE	FUMXD(D)	;MIXED-MODE FILE?
	 $ACALL	CDF		;YES. CAN'T DETERMINE FORM=

	PUSHJ	P,%SETIN	;Switch to input
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	PJRST	SKRTAB(T1)	;SKIP RECORD BY DEVICE

SKRTAB:	JRST	%IREC		;TTY
	JRST	GSKR		;DSK
	JRST	GSKR		;MTA
	JRST	GSKR		;OTHER
IF20,<	JRST	GSKR		;REMOTE STREAM FILE
	JRST	%IREC		;RMS FILE
> ;End IF20

GSKR:	LOAD	T1,MODE(D)
	CAIN	T1,MD.DMP	;DUMP MODE?
	 POPJ	P,		;YES. A NOP
	LOAD	T0,FORM(D)	;GET FORM=
	CAIE	T0,FM.FORM	;FORMATTED?
	 JRST	UNFSKP		;NO. UNFORMATTED SKIP
	PJRST	%IREC		;YES. JUST READ A RECORD

;				;[4160]
; Unformatted skip record
;
UNFSKP:	SKIPN	IMGFLG(D)	;Is it IMAGE mode?
	 JRST	BINSKP		;No (its binary). go look for LCSW's

	SKIPN	P3,URSIZB(D)	;Yes, Was RECORDSIZE specified?
	 $ACALL	CSI		;No, Can't SKIPRECORD if no RECSIZ

BINSKP:	AOS	CREC(D)		;UPDATE RECORD COUNT
	PUSHJ	P,ILSCW1	;READ START LSCW
	 $ACALL	EOF		;EOF
	PUSHJ	P,ILSCW3	;SKIP TO END LSCW
	MOVE	T0,FLAGS(D)	;Get DDB flags
	TXNN	T0,D%END	;REACH EOF?
	 POPJ	P,		;NO. DONE
	SKIPE	IMGFLG(D)	;[4161] IMAGE?
	 $ACALL	BBF		;NO. BAD FORMAT
	$ACALL	EOF		;YES. JUST EOF

	SUBTTL	MOPSKF - tape positioning for SKIPFILE statement
;++
;  Check to see if the device is a magtape unit, if not just return because
;  no other types of devices can perform a skipfile. 
;
;  Check to see if the unit is NOT opened, then jet a temporary JFN (ignored 
;  on TOPS-10) and have the monitor do the .TAPOP or MTOPR, give back the 
;  JFN and return to user code.
;
;  If there's a file opened, and it's opened for output, closing and re-opening
;  the unit will cause an EOF to be put down (thus positioning us after the
;  file). If it's opened for input, then do a skip file monitor call and close
;  open the unit.
;-

MOPSKF:	LOAD	T1,INDX(D)	;GET DEV INDEX
	CAIE	T1,DI.MTA	;TAPE?
	  POPJ	P,		;NO, SKIP FILE IS NOP
	MOVE	T0,FLAGS(D)	;GET FLAGS
	TXNN	T0,D%IN+D%OUT	;FILE OPEN?
	 JRST	JSTSKF		;NO. JUST SKIP A FILE
;
;  Skip File on an Opened Unit
;
	TXNN	T0,D%OUT	;OPEN FOR OUTPUT?
	 PUSHJ	P,%MTFSF	;NO. SKIP A FILE

	PUSHJ	P,%MTCLI	;MAKE SURE NO STUPID EOF BIT LEFT ON
	SETZM	CREC(D)		;CLEAR RECORD NUMBER
	HXLZ	T1,BYTPT(D)	;[4131] GET BYTE POINTER
	MOVEM	T1,IPTR(D)	;[4131] SAVE IT
	SETZM	ICNT(D)		;NO BYTES IN BUFFER
	SETZM	BYTN(D)		;SET CURRENT BYTE NUMBER TO 0
	POPJ	P,
;
;  Skip File on a Non-Opened Unit
;
JSTSKF:	PUSHJ	P,MTAOJF	;GET A JFN, OPEN MTA
	PUSHJ	P,%LABCK	;CHECK LABEL TYPE
	PUSHJ	P,%MTPRM	;SETUP TAPE PARAMETERS
	PUSHJ	P,%MTFSF	;DO A SKIP FILE MTOPR
	PJRST	MTACJF		;GO CLOSE FILE, RELEASE JFN, LEAVE
	SUBTTL	General subroutines for tape positioning
;+
;  Routine to back-up over the End-Of-File mark.
;-

%BAKEF:
BAKEOF:	MOVX	T0,D%END	;Clear EOF bit
	ANDCAM	T0,FLAGS(D)
	SETZM	ICNT(D)		;CLEAR INPUT COUNT
	LOAD	T1,INDX(D)	;GET DEVICE INDEX
	CAIE	T1,DI.MTA	;MTA?
	 POPJ	P,		;NO. NOTHING MORE TO DO
	PUSHJ	P,%MTBSF	;[4144] BACK OVER EOF MARK
	PUSHJ	P,%MTCLI	;[4144] CLEAR THE EOF STATUS
	SOSLE	CREC(D)		;[4144] DECR RECORD COUNT FOR EOF MARK
	 JRST	MTABS1		;[4144] DATA LEFT. GO READ PREVIOUS BLOCK
	POPJ	P,		;[4144] NO DATA LEFT. NOTHING MORE TO DO

;+
; Close/Open for input and set-up tape parameters 
;-

%MTCLI:	PUSHJ	P,%CLSOP	;[4141] CLOSE FILE, OPEN FOR INPUT
	PJRST	%MTPRM		;[4141] SETUP TAPE PARAMETERS

;+
;ROUTINES TO CONVERT BETWEEN FILE ADDRESSES AND PROCESS ADDRESSES
;
;%PTOF - CONVERT PROCESS ADDRESS TO FILE ADDRESS
;ARGS:	 P1 = ADDRESS, MUST BE IN THE MEMORY MAPPED TO THE FILE OPEN
;	      ON THE DDB POINTED TO BY D
;RETURN: P1 = CORRESPONDING BYTE NUMBER IN THE FILE
;-

%PTOF:	HRRZ	T1,IPTR(D)	;GET CURRENT ADDRESS
	JUMPE	T1,RBYTN	;[4131] IF NONE, RETURN BYTN FOR DUMP MODE
	SUB	T1,WADR(D)	;GET WORD OFFSET WITHIN WINDOW
	ADDI	T1,1		;GET # WORDS USED
	IMUL	T1,BPW(D)	;GET # BYTES USED
	MOVE	T2,IPTR(D)	;GET THE BP
	MUL	T2,BPW(D)	;GET # BYTES LEFT
	SUBI	T1,(T2)		;[4131] SUBTRACT UNUSED BYTES IN CURRENT WORD
	SUB	T1,WSIZ(D)	;[4131] SUBTRACT # BYTES IN CURRENT WINDOW
RBYTN:	ADD	T1,BYTN(D)	;[4131] ADD FILE OFFSET OF NEXT WINDOW
	POPJ	P,

	SUBTTL	TOPS-20 Tape Positioning Utilities
IF20,<
;+
;  Routine to check if tape is at Phyisical Begining_Of_Tape.
;  Does a skip return if the tape IS at the begining.
;-
BOTCHK:	MOVE	T1,IJFN(D)	;GET JFN
	GDSTS%			;GET STATUS
	TXNE	T2,MT%BOT	;BEG TAPE?
	 AOS	(P)		;YES. SKIP RETURN
	POPJ	P,

;+
; Routine to create a JFN to be used for magtape operations
; Returns .+1 if ok, JFN in IJFN(D). The JFN is opened for input.
; If fails, goes to %ABORT.
;-
MTAOJF:	SETZM	TMDEV		;[4144] CLEAR THE TEMP DEVICE NAME
	MOVE	T1,[TMDEV,,TMDEV+1] ;[4144]
	BLT	T1,TMEND	;[4144]
	MOVE	T1,[POINT 7,TMDEV] ;Get device name with ":"
	MOVEI	T2,DEV(D)	;From the DDB
	HRLI	T2,(POINT 7,)
MTAOJ1:	ILDB	T3,T2		;Get a byte
	JUMPE	T3,MTAOJ2	;Null, done
	IDPB	T3,T1		;Store
	JRST	MTAOJ1		;Loop until null found
MTAOJ2:	MOVEI	T3,":"		;Append a colon
	IDPB	T3,T1		;Now have DEV: in "TMDEV"

;Do our own GTJFN.

	MOVX	T1,GJ%SHT
	HRROI	T2,TMDEV
	GTJFN%
	 ERJMP	E.SNH		;?Dev must exist: OPENX was done!
	HRRZM	T1,IJFN(D)	;SAVE JFN

;Have to OPENF the file to do a MTOPR.

	MOVX	T2,OF%RD	;Read ACCESS, nothing else.
	OPENF%			;Get READ access to file
	 ERJMP	MTARWO		;?OPENF failed, give error
	POPJ	P,		;OK, return

;Here if OPENF failed

MTARWO:	MOVE	T1,IJFN(D)	;GET JFN
	RLJFN%			;RELEASE IT
	 ERJMP	.+1		;?Too bad
	SETZM	IJFN(D)		;CLEAR JFN
	$ACALL	OPN		;Give JSYS error and abort program





;+
;Routine to close and release JFN gotten by MTAOJF
;-
MTACJF:	MOVE	T1,IJFN(D)	;GET JFN
	CLOSF%
	 JSHALT			;?CLOSF failed, abort program
	SETZM	IJFN(D)		;CLEAR JFN
	POPJ	P,		;All worked, return

	SEGMENT DATA
TMDEV:	BLOCK	20		;Device name with ":"
TMEND==.-1
	SEGMENT CODE
;+
;  Some commonly used magnetic tape functions. Use these shorthand
;  functions to setup the operation code and perform the tape operation.
;-
%MTEOF:	MOVEI	T2,.MOEOF	;WRITE A TAPE MARK
	JRST	DOMTOP

%MTUNL:	MOVEI	T2,.MORUL	;UNLOAD TAPE
	JRST	DOMTOP

%MTREW:	MOVEI	T2,.MOREW	;REWIND TAPE
	JRST	DOMTOP

%MTBSF:	MOVEI	T2,.MOBKF	;BACKSPACE A FILE
	JRST	DOMTOP

%MTFSF:	MOVEI	T2,.MOFWF	;SKIP FILE
	JRST	DOMTOP

%MTBSB:	MOVEI	T2,.MOBKR	;BACKSPACE A RECORD
	JRST	DOMTOP

;+
;  Performs various device-dependant control functions. For TOPS-20
;  This routine requires that the device and a JFN assigned to your job.
;  The function code is specified in T2. See the MTOPR monitor call for
;  a description of the function code.
;-
DOMTOP:	MOVE	T1,IJFN(D)	;GET JFN
	MTOPR%			;DO OPERATION
	 $AJCAL	ILM
	POPJ	P,		;DONE

> ;END IF20
	SUBTTL	TOPS-10 Tape Positioning Utilities
IF10,<
;+
;  Routine to check if tape is at Phyisical Begining_Of_Tape.
;  Does a skip return if the tape IS at the begining.
;-
BOTCHK:	MOVEI	T2,.TFSTS	;GET STATUS OF TAPE UNIT
	PUSHJ	P,DOMTOP
	TXNE	T1,TF.BOT	;BEG TAPE?
	 AOS	(P)		;YES. SKIP RETURN
	POPJ	P,

;+
; Dummy functions for getting and returning a JFN.
;-
MTAOJF:
MTACJF:	POPJ	P,		;No JFN'S on TOPS-10

;+
;  Some commonly used magnetic tape functions. Use these shorthand
;  functions to setup the operation code and perform the tape operation.
;-
%MTEOF:	MOVEI	T2,.TFWTM	;WRITE A TAPE MARK
	PJRST	DOMTOP

%MTUNL:	MOVEI	T2,.TFUNL	;UNLOAD TAPE
	PJRST	DOMTOP

%MTREW:	MOVEI	T2,.TFREW	;REWIND TAPE
	PJRST	DOMTOP

%MTFSB:	MOVEI	T2,.TFFSB	;SKIP A BLOCK
	PJRST	DOMTOP

%MTBSB:	MOVEI	T2,.TFBSB	;BACKSPACE BLOCK
	PJRST	DOMTOP

%MTFSF:	MOVEI	T2,.TFFSF	;SKIP FILE
	PJRST	DOMTOP

%MTBSF:	MOVEI	T2,.TFBSF	;BACKSPACE FILE

;+
;  Perform various device-dependant control functions. The function 
;  code is specified in T2. See the TAPOP. monitor call call for a 
;  description of the function code.
;-
DOMTOP:	MOVE	T3,DVICE(D)	;GET DEVICE NAME
	MOVE	T1,[2,,T2]	;DO TAPOP
	TAPOP.	T1,
	 JRST	TAPERR		;GOT AN ERROR. ANALYZE IT
	MOVEI	T2,.TFWAT	;THEN A WAIT
	MOVE	T4,[2,,T2]
	TAPOP.	T4,
	 $ACALL	UTE
	POPJ	P,
;
;  The TAPOP call returned an error, Analyze the error and
;  issue an error message.
;
TAPERR:	CAIE	T1,TPNIA%	;NOT INITIALIZED?
	 CAIN	T1,TPIJN%	;OR DOESN'T BELONG TO ME?
	  $ACALL ITE		;YES. REPORT ONE OR THE OTHER
	$ACALL	UTE		;OTHERWISE IT IS UNEXPECTED

COMMENT &
OTHREW:	LOAD	T1,DVTYP(D)	;GET DEVICE TYPE
	CAIE	T1,.TYDTA	;DECTAPE?
	 POPJ	P,		;NO. NO OTHER DEVICE CAN REWIND
	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNN	T1,D%IN+D%OUT	;Is the DECTAPE open?
	 JRST	RWDEVO		;Yes, don't use filename
	PUSHJ	P,%SETIN	;OPEN for input.
	SETZM	BYTN(D)		;CLEAR BYTE NUMBER
	MOVE	T2,CHAN(D)	;LH= chan #
	HRRI	T2,.FOMTP	;MTAPE FILOP
	MOVX	T3,MTREW.	;REWIND
	MOVE	T1,[2,,T2]
	FILOP.	T1,
	 $ACALL	IOE
	POPJ	P,

;Here to REWIND a non-directory device that is not opened yet.
; Can't use FILOP.'s because you need a filename for them.

RWDEVO:	PUSHJ	P,OPDEVO	;Open the device only
	MOVE	T1,ASCHN	;Get channel #
	LSH	T1,^D23		;Shift to ac field
	IOR	T1,[MTREW.]	;Make instruction
	XCT	T1		;** REWIND the device **
	PJRST	CLDEVO		;Close device and return

;Routine to OPEN the device only, (on a low channel).
; FILOP. is not done, because no file can be specified.
;The assigned channel is stored in ASCHN.
;Returns .+1 or takes ERR= or goes to %ABORT (if errors)

OPDEVO:	SETZ	T1,		;Get a free channel
	PUSHJ	P,%ALCHF	;Get a channel
	 $ACALL	NFC		;?Too many OPEN units
	MOVEM	T1,ASCHN	;Save it
	LSH	T1,^D23		;Shift into AC position
	IOR	T1,[OPEN T2]	;Get instruction to XCT
	MOVEI	T2,.IODMP	;Set dump mode
	SETZ	T4,		;No buffers
	MOVE	T3,DEV(D)	;Get device
	XCT	T1		;** OPEN the device **
	 JRST	OPDVFL		;?Failed
	POPJ	P,		;OK, return

;The OPEN UUO failed. Either "No such device"
;or "Assigned to another job".

OPDVFL:	MOVE	T1,DEV(D)	;See if this device exists
	DEVTYP	T1,
	 JRST	OPDVNS		;?no such device
	JUMPE	T1,OPDVNS	;Or if 0 returned.
	SKIPA	T1,[ERDAJ%]	;"Device allocated to another job"
OPDVNS:	MOVEI	T1,ERNSD%	;"No such device"
	$ACALL	OPN		;Give error, abort if no ERR=

	SEGMENT DATA

ASCHN:	BLOCK	1		;Assigned channel for non-FILOP. I/O

	SEGMENT CODE

;Routine to CLOSE the device OPEN'ed by OPDEVO.
;Returns .+1 always

CLDEVO:	MOVE	T1,ASCHN	;Get assigned channel #
	LSH	T1,^D23		;Shift into ac position
	IOR	T1,[RELEAS 0]	;Get a RELEASE instruction
	XCT	T1		;Do it
	MOVE	T1,ASCHN	;Get channel #
	PUSHJ	P,%DECHF	;Deallocate it
	 $SNH			;?Not assigned, "can't happen"
	POPJ	P,		;Ok, return

;UNLOAD FOR DECTAPES

OTHUNL:	LOAD	T1,DVTYP(D)	;GET DEVICE TYPE
	CAIE	T1,.TYDTA	;DECTAPE?
	 POPJ	P,		;NO. NO OTHER DEVICE CAN UNLOAD
	MOVE	T1,FLAGS(D)	;Get DDB flags
	TXNN	T1,D%IN+D%OUT	;Is the DECTAPE open?
	 JRST	ULDEVO		;Yes, don't use filename
	TXNE	T1,D%OUT+D%END	;OUTPUT OR EOF?
	 PUSHJ	P,%CLSOP	;Open the dectape
	SETZM	CREC(D)		;CLEAR RECORD NUMBER
	HXLZ	T1,BYTPT(D)	;[4131] GET BYTE POINTER
	MOVEM	T1,IPTR(D)	;[4131] SAVE IT
	SETZM	ICNT(D)		;NO BYTES IN BUFFER
	SETZM	BYTN(D)		;SET CURRENT BYTE NUMBER TO 0
	MOVE	T2,CHAN(D)	;LH= chann #
	HRRI	T2,.FOMTP	;MTAPE FILOP
	MOVX	T3,MTUNL.	;UNLOAD
	MOVE	T1,[2,,T2]
	FILOP.	T1,
	 $ACALL	IOE
	POPJ	P,

;Here to UNLOAD a DECtape or magtape that is not opened yet.
; Can't use FILOP.'s because you need a filename for them.

ULDEVO:	PUSHJ	P,OPDEVO	;Open the device only
	MOVE	T1,ASCHN	;Get channel #
	LSH	T1,^D23		;Shift to ac field
	IOR	T1,[MTUNL.]	;Make instruction
	XCT	T1		;** UNLOAD the device **
	PJRST	CLDEVO		;Close device and return
END COMMENT &
> ;IF10
	SUBTTL	FIND

;FIND STATEMENT
;
;DOES NOT POSITION A RANDOM-ACCESS DISK FILE SO THAT SUBSEQUENT I/O
;WILL TAKE LESS TIME IF SUFFICIENT COMPUTATION INTERVENES BETWEEN
;THE FIND AND THE I/O.
;
;10:  A TIME-CONSUMING NOP
;
;20:  DITTO
;
;[5004] THIS STATEMENT IS ALMOST WORTHLESS.
;
;[5004] FOR RMS DIRECT-ACCESS RELATIVE FILES, ESTABLISHES THE CURRENT
;[5004] RECORD.

	FENTRY	(FIND)
	PUSHJ	P,%SAVAC	;SAVE USER'S ACS
	PUSHJ	P,%CPARG	;AND COPY ARGS
	PUSHJ	P,FMTCNV	;CONVERT OLD-STYLE ARG LIST
	XMOVEI	T1,[ASCIZ /FIND/] ;SET STATEMENT NAME FOR ERROR MESSAGES
	MOVEM	T1,%IONAM
	PUSHJ	P,IOARG		;MOVE ARGS TO A.XXX
	PUSHJ	P,CHKUNT	;Check unit number in range
				; (Goes to ABORT% or ERR= if not).
	MOVE	T1,%CUNIT	;GET UNIT NUMBER
	SKIPN	U,%DDBTA(T1)	;GET UDB ADDR
	 $ACALL	RR1		;NONE. MUST SETUP RECORDSIZE IN OPEN!
	MOVEM	U,%UDBAD	;WE HAVE STARTED AN I/O STATEMENT
	MOVE	D,DDBAD(U)	;GET DDB ADDR
	PUSHJ	P,%SETIN	;Get file opened for input
	SKIPE	A.REC		;MAKE SURE THERE IS A RECORD NUMBER
	 SKIPG	T1,@A.REC	;GET RECORD NUMBER
	 $ACALL	IRN		;ILLEGAL IF .LE. ZERO OR NO RECORD NUMBER
	MOVEM	T1,CREC(D)	;STORE IN DDB FOR ASSOCIATE VARIABLE
	LOAD	T1,INDX(D)	;[5004] GET DEVICE INDEX
	CAIN	T1,DI.RMS	;[5004] RMS FILE?
	 PJRST	%RMFND		;[5004] YES, MAYBE DO $FIND
	PJRST	%SETAV		;GO SET ASSOCIATE VARIABLE AND RETURN

	SUBTTL	IOLST

	FENTRY	(IOLST)
	PUSHJ	P,%SAVIO	;SAVE ACS
	PUSHJ	P,%ISAVE	;AND COPY ARGS
	SKIPN	U,%UDBAD	;RESTORE UDB ADDRESS
	 POPJ	P,		;NONE. I/O ABORTED
	MOVE	D,DDBAD(U)	;GET DDB ADDR

IOLP:	LDB	T2,[POINTR ((L),IOKWD)] ;GET TYPE OF ENTRY
	XCT	DATSUB(T2)	;GO TO APPROPRIATE DATA HANDLER
	JRST	IOLP		;CONTINUE UNTIL END OF LIST

;XCT TABLE
DATSUB:	JRST	ZKWD		;ZERO KEYWORD
	PUSHJ	P,FDATA
	PUSHJ	P,SLIST
	PUSHJ	P,ELIST
	JRST	@IOFIN(D)
	PUSHJ	P,SLST77
	PUSHJ	P,ELST77
	PUSHJ	P,NSLIST	;NEW SLIST ENTRY
	PUSHJ	P,NELIST	;NEW ELIST ENTRY
	PUSHJ	P,NSL77		;NEW SLIST-77 ENTRY
	PUSHJ	P,NEL77		;NEW ELIST-77 ENTRY
	$ACALL IOL		;REPORT ERROR FOR ARGS OUT OF RANGE
	$ACALL IOL		;REPORT ERROR FOR ARGS OUT OF RANGE
	$ACALL IOL		;REPORT ERROR FOR ARGS OUT OF RANGE
	$ACALL IOL		;REPORT ERROR FOR ARGS OUT OF RANGE
	$ACALL IOL		;REPORT ERROR FOR ARGS OUT OF RANGE

ZKWD:	SKIPN	(L)		;IS ENTRY ZERO?
	 POPJ	P,		;0 IS END OF LIST
	$ACALL	IOL		;NON-ZERO ARG, ZERO KWD - BAD I/O LIST

FDATA:	XMOVEI	T1,@(L)		;GET ADDR
	MOVEM	T1,IO.ADR	;SAVE THE DATA ADDR
	SETZM	IO.INC		;ZERO INCREMENT
	LDB	T2,[POINTR ((L),ARGTYP)]	;GET DATATYPE
	MOVEM	T2,IO.TYP	;SAVE IT
	MOVEI	T3,1		;1 ENTRY
	MOVEM	T3,IO.NUM
	CAIN	T2,TP%CHR	;CHARACTER?
	 JRST	DCHAR		;YES. GO HANDLE SEPARATELY
	MOVE	T3,%SIZTB(T2)	;SET "ARRAY" LENGTH TO DATUM SIZE
	MOVEM	T3,IO.SIZ	;SAVE IT
	AOJA	L,@IOSUB(D)	;DO I/O

DCHAR:	SKIPG	T3,1(T1)	;GET VARIABLE SIZE
	 $ACALL	ICE		;ZERO OR NEGATIVE SIZE (BAD SUBSTRING BOUNDS)
	MOVEM	T3,IO.SIZ	;SAVE IT
	MOVE	T1,(T1)		;GET PNTR
	MOVEM	T1,IO.ADR	;SAVE AS ADDR
	AOJA	L,@IOSUB(D)	;PROCESS SINGLE DATUM

;EXPLICIT FIN CALL
	FENTRY	(FIN)
	PUSHJ	P,%SAVIO	;SAVE USER'S ACS
	SKIPN	U,%UDBAD	;GET UDB
	 POPJ	P,		;NONE. I/O WAS ABORTED
	MOVE	D,DDBAD(U)	;GET DDB
	JRST	@IOFIN(D)	;GO FINISH UP

;[5004] New
;[5004] FORMATTED REWRITE
IF20,<
	FENTRY	(REWRF)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;COPY ARGS
	XMOVEI	T1,[ASCIZ/REWRITE/]
	MOVEM	T1,%IONAM
	PUSHJ	P,IOARG		;MOVE ARGS TO A.XXX
	PUSHJ	P,CHKUNT	;CHECK UNIT NUMBER IN RANGE
	PUSHJ	P,SETFRM	;SET MODE TO ASCII IF ZERO
	PUSHJ	P,%RMCRW	;CHECK IF REWRITE LEGAL
	MOVX	T0,D%RWI	;SET REWRITE FLAG
	IORM	T0,FLAGS(D)
	PUSHJ	P,%SETOUT	;GET FILE OPENED FOR OUTPUT.
	XMOVEI	T1,%OFIN	;AND SET OUTPUT OF FINAL RECORD
	MOVEM	T1,IOFIN(D)	;FOR FIN CALL
	XMOVEI	T1,%ORECS	;USE EXTERNAL I/O FOR RECORD OUTPUT
	MOVEM	T1,IOREC(D)
	SKIPN	ORBUF(D)	;ANY RECORD BUFFER YET?
	 PUSHJ	P,GETORB	;NO. CREATE ONE
	PUSHJ	P,ORINI		;INIT OUTPUT RECORD
	JRST	%OFSET

;[5004] New
;[5004] UNFORMATTED REWRITE

	FENTRY	(REWRU)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;COPY ARGS
	XMOVEI	T1,[ASCIZ/REWRITE/]
	MOVEM	T1,%IONAM
	PUSHJ	P,IOARG		;MOVE ARGS TO A.XXX
	PUSHJ	P,CHKUNT	;CHECK UNIT NUMBER IN RANGE
	PUSHJ	P,SETUNF	;SET MODE
	PUSHJ	P,%RMCRW	;SEE IF REWRITE LEGAL
	PUSHJ	P,%SETOUT	;GET FILE OPENED FOR OUTPUT.
	MOVX	T0,D%RWI	;SET REWRITE FLAG
	IORM	T0,FLAGS(D)
	PJRST	UOSET		;GO DO UNFORMATTED I/O

;[5013] New
;[5013] DELETE an RMS relative or indexed record.

	FENTRY	(DELTR)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;COPY ARGS
	XMOVEI	T1,[ASCIZ/DELETE/]
	MOVEM	T1,%IONAM
	PUSHJ	P,IOARG		;MOVE ARGS TO A.XXX
	PUSHJ	P,CHKUNT	;CHECK UNIT NUMBER IN RANGE
	PUSHJ	P,%RMCDL	;SEE IF DELETE IS LEGAL
	PUSHJ	P,%SETOUT	;GET FILE OPENED FOR OUTPUT.
	PJRST	%RMDEL		;GO DELETE RECORD

;[5014] New
;[5014] UNLOCK an RMS relative or indexed record.

	FENTRY	(UNLOC)
	PUSHJ	P,%SAVAC	;SAVE ACS
	PUSHJ	P,%CPARG	;COPY ARGS
	XMOVEI	T1,[ASCIZ/UNLOCK/]
	MOVEM	T1,%IONAM
	PUSHJ	P,IOARG		;MOVE ARGS TO A.XXX
	PUSHJ	P,CHKUNT	;CHECK UNIT NUMBER IN RANGE
	PUSHJ	P,%RMCUL	;SEE IF UNLOCK IS LEGAL
	PUSHJ	P,%SETIN	;GET FILE OPENED FOR INPUT.
	PJRST	%RMUNL		;GO UNLOCK THE RECORD

> ;End IF20

;[4140] REWRITTEN
NSL77:	SETOM	INCFLG		;[4132] INCREMENT IS IN WORDS OR CHARACTERS
	SKIPG	T1,@(L)		;IF COUNT IS ZERO OR NEGATIVE
	 JRST	SLZTRP		;IT IS ZERO TRIP
	MOVEM	T1,IO.NUM	;SAVE COUNT
	MOVE	T1,@1(L)	;GET A FULLWORD INCREMENT
	MOVEM	T1,IO.INC	;SAVE IT
	JRST	SLCOM		;JOIN COMMON CODE

;[4140] REWRITTEN
SLST77:	SETZM	INCFLG		;[4132] INCREMENT IS IN ENTRIES
	SKIPG	T1,@(L)		;GET THE COUNT
	 MOVEI	T1,(T1)		;NEG OR ZERO. TOSS AOBJN COUNT
	MOVEM	T1,IO.NUM	;SAVE COUNT
	HRRE	T1,@1(L)	;GET INCREMENT, WHICH MIGHT BE IMMEDIATE
	MOVEM	T1,IO.INC	;ASSUME IT'S AN OK INCR
	SKIPLE	IO.NUM		;ANY COUNT?
	 JRST	SLCOM		;YES. NOT ZERO-TRIP

;ZERO-TRIP SLIST. SKIP TO THE END OF THE LIST, WHICH IS
;A WORD WITH A NON-ZERO KEYWORD.
SLZTRP:	ADDI	L,1		;POINT TO NEXT WORD
SLZTLP:	MOVE	T1,(L)		;GET IT
	TXNE	T1,ARGKWD	;NON-ZERO KEYWORD?
	 POPJ	P,		;YES. END OF LIST
	JUMPE	T1,%POPJ	;ZERO IS OLD STYLE END
	AOJA	L,SLZTLP	;TRY AGAIN
	POPJ	P,		;AND LEAVE

;[4140] REWRITTEN
NSLIST:	SETOM	INCFLG		;[4132] INCREMENT IS IN CHARS OR WORDS
	SKIPG	T1,@(L)		;GET THE COUNT
	 MOVEI	T1,1		;ZERO-TRIP. USE 1-TRIP DO COUNT
	MOVEM	T1,IO.NUM	;SAVE COUNT
	MOVE	T1,@1(L)	;GET A FULLWORD INCREMENT
	MOVEM	T1,IO.INC	;SAVE IT
	JRST	SLCOM		;JOIN COMMON CODE

;[4140] REWRITTEN
SLIST:	SETZM	INCFLG		;[4132] INCREMENT IS IN ENTRIES
	SKIPG	T1,@(L)		;GET THE COUNT
	 MOVEI	T1,(T1)		;NEG OR ZERO. TOSS AOBJN COUNT
	CAIN	T1,0		;ZERO-TRIP?
	 MOVEI	T1,1		;ZERO-TRIP. USE 1-TRIP DO COUNT
	MOVEM	T1,IO.NUM	;STORE COUNT
	HRRE	T1,@1(L)	;GET INCREMENT
	MOVEM	T1,IO.INC	;ASSUME IT'S AN OK INCR

SLCOM:	MOVE	T1,3(L)		;GET WORD AFTER ARRAY ADDRESS
	TXNN	T1,ARGKWD	;IS IT ANOTHER ARRAY?
	 JUMPN	T1,SLP0		;YES, MUST DO ONE-BY-ONE THING

	LDB	T2,[POINTR (2(L),ARGTYP)] ;GET DATATYPE
	MOVEM	T2,IO.TYP	;SAVE IT
	CAIN	T2,TP%CHR	;CHARACTER?
	 JRST	SLCHR		;YES
	MOVE	T1,%SIZTB(T2)	;GET ENTRY SIZE
	MOVEM	T1,IO.SIZ	;SAVE IT
	SKIPN	INCFLG		;[4132] IF INCREMENT IS IN ENTRIES
	 IMULM	T1,IO.INC	;MAKE INCR IN WORDS
	XMOVEI	T1,@2(L)	;GET ADDRESS
	MOVEM	T1,IO.ADR	;SAVE IT
	MOVE	T1,[ADD T1,IO.ADR] ;DO NOTHING WITH ZERO INCREMENT
	MOVEM	T1,IO.INS	;INSTRUCTION FOR FORMATTED I/O
	ADDI	L,3		;SKIP OVER SLIST
	PJRST	@IOSUB(D)	;GO DO WHOLE ARRAY

SLCHR:	XMOVEI	T1,@2(L)	;GET ADDR OF DESCRIPTOR
	SKIPG	T2,1(T1)	;GET SIZE
	 $ACALL	ICE		;ZERO OR NEGATIVE SIZE (BAD SUBSTRING BOUNDS)
	MOVEM	T2,IO.SIZ	;SAVE IT
	SKIPN	INCFLG		;[4132] IF INCREMENT IS IN ENTRIES
	 IMULM	T2,IO.INC	;MAKE INCR IN BYTES
	MOVE	T1,(T1)		;GET PNTR
	MOVEM	T1,IO.ADR	;SUBSTITUTE THE BYTE PNTR
	MOVE	T1,[ADJBP T1,IO.ADR] ;GET INCREMENT INST
	MOVEM	T1,IO.INS	;SAVE FOR FORMATTED I/O
	ADDI	L,3		;SKIP OVER SLIST
	PJRST	@IOSUB(D)	;DO WHOLE ARRAY

SLP0:	MOVE	T1,IO.NUM	;GET COUNT AGAIN
	MOVEM	T1,LISCNT	;STORE IT LOCALLY
	MOVE	T1,IO.INC	;GET INCREMENT AGAIN
	MOVEM	T1,LINCR	;STORE LOCALLY
	SETZM	OFFS		;INITIALIZE OFFSET
	ADDI	L,2		;POINT TO FIRST ARRAY ADDRESS
	MOVEM	L,SAVEL		;SAVE FOR LOOP THROUGH ALL ARRAYS

SLP1:	MOVE	L,SAVEL		;RESET L TO START OF SLIST
SLP:	XMOVEI	T1,@(L)		;GET AN ARRAY BASE ADDRESS
	MOVE	T3,(L)
	TXNE	T3,ARGKWD	;IS IT AN ARRAY ADDRESS?
	  JRST	SLPE		;NO, END OF LOOP
	JUMPE	T3,SLPE		;ZERO IS END OF LIST, NOT VALID ADDRESS
	LDB	T2,[POINTR ((L),ARGTYP)] ;GET DATA TYPE OF ARRAY
	MOVEM	T2,IO.TYP	;SAVE IT
	MOVE	T3,OFFS		;GET OFFSET INTO ARRAY
	CAIN	T2,TP%CHR	;CHARACTER?
	 JRST	SCHAR		;YES. DO IT SEPARATELY
	MOVE	T4,%SIZTB(T2)	;GET ELEMENT SIZE
	MOVEM	T4,IO.SIZ	;SAVE IT
	SKIPN	INCFLG		;IF INCREMENT IS IN ENTRIES
	 IMULI	T3,(T4)		;TURN ELEMENTS INTO WORDS
	ADDI	T1,(T3)		;ADD OFFSET TO BASE ADDRESS
	JRST	NSCHAR		;JOIN COMMON CODE

SCHAR:	SKIPN	INCFLG		;IF INCREMENT IS IN ENTRIES
	 IMUL	T3,1(T1)	;GET CHARACTER OFFSET
	ADJBP	T3,(T1)		;CREATE NEW PNTR
	SKIPG	T5,1(T1)	;GET VAR SIZE
	 $ACALL	ICE		;ZERO OR NEGATIVE SIZE (BAD SUBSTRING BOUNDS)
	MOVEM	T5,IO.SIZ	;SAVE IT
	MOVE	T1,T3		;GET PNTR INTO T1
NSCHAR:	MOVEM	T1,IO.ADR	;SAVE IT
	MOVEI	T3,1		;SET # ELEMENTS TO 1
	MOVEM	T3,IO.NUM	;SAVE NUM ELEMENTS
	SETZM	IO.INC		;NO INCREMENT
	PUSHJ	P,@IOSUB(D)	;I/O THE ARRAY ELEMENT
	AOJA	L,SLP		;BUMP TO NEXT ARRAY ADDRESS, CONTINUE

SLPE:	MOVE	T1,LINCR	;GET INCREMENT
	ADDM	T1,OFFS		;BUMP OFFSET
	SOSLE	LISCNT		;DECREMENT COUNT
	  JRST	SLP1		;NOT YET ZERO, CONTINUE I/O

	POPJ	P,		;END OF SLIST
NEL77:	SETOM	INCFLG		;[4132] INCREMENT IS IN WORDS OR CHARACTERS
	SKIPG	T1,@(L)		;[4132] GET COUNT
	 JRST	ELZTLP		;[4132] IF ZERO OR NEGATIVE, IT IS ZERO TRIP
	JRST	ELNZ		;[4132] JOIN COMMON CODE

ELST77:	SETZM	INCFLG		;[4132] INCREMENT IS IN ENTRIES
	SKIPLE	T1,@(L)		;POSITIVE?
	 JRST	ELNZ		;YES. JOIN COMMON CODE
	MOVEI	T1,(T1)		;NO. AVOID AOBJN COUNTS (BUG IN COMPILER)
	JUMPG	T1,ELNZ		;IF NON-ZERO, ASSUME POSITIVE COUNT

;ZERO-TRIP ELIST. JUST GO TO THE END, WHICH IS A ZERO WORD (V5A) OR
;WORD WITH A NON-ZERO KEYWORD (POST-V5A) FOR AN "INCREMENT" WORD.
ELZTLP:	ADDI	L,1		;POINT TO INCR/ADDR PAIR
	MOVE	T1,(L)		;GET NEXT INCREMENT
	TXNE	T1,ARGKWD	;ANY KEYWORD?
	 POPJ	P,		;YES. END OF LIST
	JUMPE	T1,%POPJ	;ZERO IS ALSO END OF LIST
	AOJA	L,ELZTLP	;TRY AGAIN

NELIST:	SETOM	INCFLG		;[4132] INCREMENT IS IN WORDS OR CHARS
	SKIPG	T1,@(L)		;[4132] GET THE COUNT
	 MOVEI	T1,1		;[4132] IF ZERO-TRIP, MAKE IT 1-TRIP
	JRST	ELNZ		;[4132] JOIN COMMON CODE

ELIST:	SETZM	INCFLG		;[4132] INCREMENT IS IN ENTRIES
	SKIPLE	T1,@(L)		;GET THE COUNT
	 JRST	ELNZ		;OK
	MOVEI	T1,(T1)		;NEG OR ZERO. TOSS AOBJN COUNT
	JUMPG	T1,ELNZ		;PRODUCED BY BUG IN COMPILER
	 MOVEI	T1,1		;NO. 1-TRIP DO COUNT
ELNZ:	MOVEM	T1,LISCNT	;STORE COUNT

	SETZM	OFFS		;CLEAR OFFSET
	ADDI	L,1		;POINT TO FIRST INCR/ADDR PAIR
	MOVEM	L,SAVEL		;SAVE FOR LOOP

ELP1:	MOVE	L,SAVEL		;RESET L
ELP:	MOVE	T3,(L)		;Get arg type bits
	TXNE	T3,ARGKWD	;CHECK FOR 0 KEYWORD FIELD
	  JRST	ELPE		;NONZERO KEYWORD, END OF LOOP
	JUMPE	T3,ELPE		;ZERO IS END OF LIST
	MOVE	T1,@(L)		;[4140] GET AN INCREMENT
	LDB	T2,[POINTR ((L),ARGTYP)] ;[4140] GET ARG TYPE
	CAIN	T2,0		;[4140] IF NOT IMMEDIATE, USE FULLWORD INCREMENT
	 HRRE	T1,@(L)		;[4140] IMMEDIATE. EXTEND SIGN
	IMUL	T1,OFFS		;GET OFFSET INTO ARRAY

	LDB	T2,[POINTR (1(L),ARGTYP)] ;GET ARG TYPE OF ARRAY
	MOVEM	T2,IO.TYP	;SAVE IT
	CAIE	T2,TP%CHR	;CHARACTER?
	 JRST	ELNC		;NO
	XMOVEI	T3,@1(L)	;GET ADDR OF DESCRIPTOR
	SKIPG	T2,1(T3)	;GET SIZE OF VARIABLE
	 $ACALL	ICE		;ZERO OR NEGATIVE SIZE (BAD SUBSTRING BOUNDS)
	MOVEM	T2,IO.SIZ	;SAVE IT
	SKIPN	INCFLG		;[4132] IF INCREMENT IS IN ENTRIES
	 IMUL	T1,T2		;GET OFFSET IN CHARACTERS
	ADJBP	T1,(T3)		;INCR BYTE POINTER
	MOVEM	T1,IO.ADR	;SAVE FOR I/O ROUTINE
	JRST	ECOM2		;JOIN COMMON CODE

ELNC:	MOVE	T3,%SIZTB(T2)	;GET SIZE
	MOVEM	T3,IO.SIZ	;STORE IT
	SKIPN	INCFLG		;[4132] IF INCREMENT IS IN ENTRIES
	 IMULI	T1,(T3)		;MULTIPLY OFFSET BY ELEMENT SIZE
	XMOVEI	T3,@1(L)	;GET BASE ADDR
	ADD	T1,T3		;ADD BASE ADDRESS TO OFFSET
	MOVEM	T1,IO.ADR	;SAVE FOR FORMATTED I/O

ECOM2:	MOVEI	T3,1		;1 ENTRY
	MOVEM	T3,IO.NUM	;SAVE IT
	SETZM	IO.INC		;NO INCREMENT
	PUSHJ	P,@IOSUB(D)	;CALL I/O ROUTINE
	ADDI	L,2		;BUMP TO NEXT INCREMENT/ADDRESS PAIR, CONTINUE
	JRST	ELP

ELPE:	AOS	OFFS		;INCREMENT OFFSET
	SOSLE	LISCNT		;DECREMENT COUNT
	  JRST	ELP1		;IF NOT YET ZERO, CONTINUE

	POPJ	P,		;END OF ELIST

	SEGMENT	DATA

INCFLG:	BLOCK	1		;0=INCR IN ENTRIES, -1=INCR IN WORDS/CHARS
LINCR:	BLOCK	1		;LOCAL INCREMENT
LISCNT:	BLOCK	1		;LOCAL COUNT
OFFS:	BLOCK	1		;LOCAL OFFSET
SAVEL:	BLOCK	1		;FOROTS ARG LIST PNTR LOCAL

	SEGMENT	CODE

	FORPRG
	END