SEARCH	SIMMAC,SIMMCR,SIMRPA
	SALL
	RTITLE	IO
;	Edit:	302
	SUBTTL	Written by Olof Bj`rner Dec 1973

	ERRMAC(IO)
	MACINIT
	PROCINIT(IO)

COMMENT ;

This module contains all initial actions required by a
file generation statement. There are three entries for each type
of file: INFILE, OUTFILE, PRINTFILE and DIRECTFILE.
The first entry, <filetype>%D, contains the declaration coding.
This entry consists chiefly of a branch to CPCD preceded by
loading of the prefix level to XSAC.
The second entry, <filetype>%S, contains the actions for this class.
The subroutine SETUPFILE is used for all common file actions.
The third entry, <filetype>%I,  is the INNER coding which
in this case consists of a branch to CPE0.
These three entries are also present for FILE but the
statement coding, IOFI%S is empty, i.e. all actions are
deferred to the INNER level.


MODULE ORGANIZATION:

1. Local subroutines
2. SIMULA procedures
3. File object generation code and symbol tables
;
	SUBTTL	RECORDS USED IN IO HANDLING

Comment ;

Name	Defined	Physical	Explanation
	  in	location

ZSW	SIMRPA	object prog	Runswitch record created by compiler
ZFS	SIMRPA	Static area	IOSPEC table
ZFI	SIMRPA	Dynamic area	File object
ZBH	SIMRPA	Static area	Buffer area containing buffer ring header
				and buffer ring
ZYS	SIMRPA	Dynamic area	SFD path argument
ZXB	SIMRPA	Dynamic area	Extended lookup/Enter block
ZFD	OCIN	Static area	File specification record


Organization of low segment:


I-------------------------I
I			  I
.			  .
.   SIMULA program	  .
.			  .
I			  I
I-------------------------I  <---  .JBOPS
I			  I
.			  .
.   Static area		  .
.			  .
I			  I
I-------------------------I  <---  YOCBST
I			  I
.			  .
.   Buffer areas	  .
.			  .
I			  I
I-------------------------I  <---  YIOSPC
I			  I
.			  .
.   IOSPEC table	  .
.			  .
I			  I
I-------------------------I
I			  I
.			  .
.   Buffer areas	  .
.   continued		  .
I			  I
I-------------------------I  <---  YSABOT
I			  I
.			  .
.   Dynamic area	  .
.			  .
I			  I
I-------------------------I  <---  YSATOP

	ZBH record - buffer area
	=========================

Word no:
	I------------------I------------------I
   0	I	ZBHLEN	   I	   ZBHLNK     I  Bit 0: ZBHFRE, Bit 18: ZBHCON
	I------------------I------------------I
   1	I		   I	   ZBHZBU     I  Bit 0: ZBHUSE
   	I------------------I------------------I
   2	I		ZBHBUP		      I
	I-------------------------------------I
   3	I		ZBHCNT		      I
	I-------------------------------------I
   4	I		ZBUSTA		      I
	I------------------I------------------I
   5	I	ZBUSIZ	   I	  ZBUZBU      I  Bit 0: ZBUUSE
	I------------------I------------------I
   6	I		   I	  ZBUWCT      I
	I------------------I------------------I
   7	I		ZBUDAT		      I
	I-------------------------------------I


Words 1-3 comprise the buffer ring header and are immediately
followed by the buffer ring.

Explanations:

ZBHFRE		=1 means that this buffer area is available
ZBHLEN		includes ZBHFRE and contains total length of
		this buffer area. The length is positive if
		the area is in use else negative.
ZBHCON		=1 if this area immediately follows the
		previous area (it might be preceded by the
		IOSPEC table)
ZBHLNK		pointer to next buffer area or -1 if
		it is the last buffer area
ZBHUSE		use bit for the buffer ring
ZBHZBU		pointer to current buffer
ZBHBUP		buffer byte pointer
ZBHCNT		no of bytes remaining in buffer
ZBUSTA		file status
ZBUUSE		use bit for this buffer
ZBUSIZ		file size
ZBUZBU		pointer to next buffer in the ring
ZBUWCT		word count for this buffer
ZBUDAT		data

	ZSW - runswitch record
	======================

Word no:
	I-------------------------------------I
   0	I		ZSWDEV		      I
	I-------------------------------------I
   1	I		ZSWFIL		      I
	I------------------I------------------I
   2	I	ZSWEXT	   I		      I
	I------------------I------------------I
   3	I				      I
	I-------------------------------------I
   4	I		ZSWPPN		      I
	I-------------------------------------I


Explanations:

Words 1-4 comprise the LOOKUP block for the
specification file, specified in the R-switch
during compilation.

ZSWDEV		device name, must be TTY or DSK(n)
ZSWFIL		file name
ZSWEXT		extension
ZSWPPN		ppn

ZFD - FILE DEFINITION RECORD
============================

This record is built during the scan of a file definition
and later moved to ZFS or ZFI.

	I-------------------------------------I
YOCFD:	I		ZFDDEV		      I
	I-------------------------------------I
   +1	I		ZFDFIL		      I
	I------------------I------------------I
   +2	I     ZFDEXT	   I		      I
	I------------------I------------------I
   +3	I				      I  Bits 0-8: ZFDPT
	I------------------I------------------I
   +4	I     ZFDPRJ	   I     ZFDPRG	      I
	I------------------I------------------I
   +5	I		ZFDPNT		      I
	I-------------------------------------I
   +6	I		ZFDSFD		      I
	I-------------------------------------I


Explanations

ZFDDEV	device name
ZFDFIL	file name
ZFDEXT	extension
ZFDPT	protection
ZFDPRJ	project number
ZFDPRT	programmer number
ZFDPNT	byte pointer to first SFD name in file descriptor
ZFDSFD	number of SFD names

	ZFI record - file object
	========================

Word no:
	I-------------------------------------I
	I				      I
   0-1	I	    record header	      I
	I				      I
	I------------------I------------------I
   2	I	ZFIFLN	   I	  ZFIFTR      I  Bits 0-36: ZFISPC
	I------------------I------------------I
   3	I				      I
	I-------------------------------------I
   4	I		ZFIIMG		      I
	I------------------I------------------I
   5	I		   I	  ZFIICP      I
	I------------------I------------------I
   6	I		 flags		      I
	I-------------------------------------I
   7	I		ZIFEND		      I  also ZDFEND
	I------------------I------------------I
  10	I		   I	  ZFIBUF      I  Bits 7-12: ZFICHN
	I------------------I------------------I
  11	I		ZFIKAR		      I
	I-------------------------------------I
  12	I		ZFISTI		      I
	I-------------------------------------I
  13	I		ZFIDVN		      I
	I------------------I------------------I
  14	I	ZFIOBH	   I	  ZFIIBH      I
	I------------------I------------------I
  15	I		ZFIFIL		      I
	I------------------I------------------I
  16	I	ZFIEXT	   I		      I
	I------------------I------------------I
  17	I				      I  Bits 0-8: ZFIPT
	I------------------I------------------I
  20	I	ZFIPRJ	   I	  ZFIPRG      I  Bits 0-35: ZFIARG
	I------------------I------------------I
  21	I		ZFINAM		      I
	I-------------------------------------I
  22	I		ZFIPPN		      I
	I-------------------------------------I
  23	I		ZFIBFS		      I
	I-------------------------------------I


Explanations:

Words 2-3 comprise the text reference variable to the file
specifications given at file creation (NEW ...file(specif)).
Words 4-5 contain the text reference variable to the image of
this file.
Words 12-14 contain the argument block to the OPEN UUO.
Words 15-20 contain the argument block to the LOOKUP/ENTER UUO:s.

ZFIFLN		is the length of the text variable
		containing the parameter to FILE.
ZFIFTR		pointer to this variable
ZFIIMG		text variable to image
ZFIICP		current position (POS-1) for image

Word 6 contains various flags:

bit no	name	meaning if 1
------	----	------------

0	ZFIOPN	file is open (set by .IOOP)
1	ZFIIF	file is an infile
2	ZFIOF	file is an outfile or a printfile
3	ZFIPF	file is a printfile
4	ZFIDF	file is a directfile
5	ZFIIN	file can do input (infile and directfile)
6	ZFIOUT	file can do output (outfile, printfile and directfile)
7	ZFISFD	file has a SFD path
8	ZFIDE	file has an extended LOOKUP/ENTER block (ZXB)
9	ZFIAPP	file is written in append mode
10	ZFIEND	temporary end of file reached
14	ZFIWDB	[24] image in file always starts on a word boundary
15	ZFINUM	[24] file has standard line numbers (LINED format). Implies ZFIWDB
16	ZFIRON	[24] File is read only (ACCESS:RONLY)

17	ZFILBO	[44] Last call was Breakoutimage, not Outimage
18	ZFIFND	[61] On for special call with no dialogue
19	ZFIPGT	[63] Put or Get in progress on file (Not Out- or Inimage)

ZIFEND		end of file flag
		(set by INIMAGE when INIMAGE is called
		and ZFIEND is set (infile only))
ZFICHN		channel number in AC position
ZFIBUF		number of buffers in buffer ring,
		obtained through the DEVSIZ UUO or
		from the B-switch
ZFIKAR		device characteristics, obtained through
		the DEVCHR UUO
ZFISTI		initial file status, 1 indicates ASCII file.
ZFIDVN		device name (SIXBIT)
ZFIOBH		address to output buffer header block
ZFIIBH		address to input buffer header block
ZFIFIL		file name (SIXBIT code), or, if 0 in left half,
		address to ZXB record
ZFIEXT		file extension
ZFIPT		protection code
ZFIPRJ		project number
ZFIPRG		programmer number
ZFIARG		address to SFD path (ZYS record)
ZFINAM		logical file name
ZFIPPN		save area for ppn between successive
		LOOKUP or ENTER UUO:s
ZFIBFS		buffer size, obtained from the DEVSIZ UUO.

	ZOF record - file object for outfile
	====================================

Word no:
	I------------------I------------------I
   0	I				      I
	.				      .
	.		   ZFI		      .
	.				      .
  23	I				      I
	I------------------I------------------I
  24	I	ZOFBLK	   I	  ZOFLIM      I
	I------------------I------------------I


Explanations:

ZOFBLK		number of written blocks
ZOFLIM		max no of blocks to be written
		(set by user through the L-switch)

	ZPF record - file object for printfile
	======================================

Word no:
	I-------------------------------------I
   0	I				      I
	.				      .
	.		  ZFI		      .
	.				      .
  23	I				      I
	I-------------------------------------I
  24	I		  ZOF		      I
	I------------------I------------------I
  25	I	ZPFSP	   I	  ZPFLP       I
	I------------------I------------------I
  26	I	ZPFLL	   I	  ZPFLIN      I
	I------------------I------------------I


Explanations:

ZPFSP		spacing amount, set by user with the
		SPACING procedure and defaulted to 1.
ZPFLP		linesperpage amount, set by user with
		the LINESPERPAGE procedure and
		defaulted to 60.
ZPFLL		number of last printed line
ZPFLIN		number of next line, value of LINE
		attribute.

	ZDF record - file object for directfile
	=======================================

Word no:
	I-------------------------------------I
   0	I				      I
	.				      .
	.		  ZFI		      .
	.				      .
  23	I				      I
	I------------------I------------------I
  24	I	ZDFIML	   I	  ZDFLIM      I
	I------------------I------------------I
  25	I	ZDFWCT	   I	  ZDFLOC      I
	I------------------I------------------I
  26	I		   I	  ZDFBLK      I  Bit 0: ZDFMOD
	I------------------I------------------I  Bit 1: ZDFOUT


Explanations:

ZDFIML		max image length
ZDFLIM		max valid location, i.e. last
		written record number
ZDFWCT		word count for directfile buffer
ZDFLOC		current value of LOCATION
ZDFMOD		on if OUTIMAGE has been done on
		current directfile buffer
ZDFOUT		on if OUTIMAGE was done last, not
		INIMAGE
ZDFBLK		current external block number in core

	ZYS record - SFD path
	=====================

Word no:
	I-------------------------------------I
  0-1	I				      I
	I	  record header		      I
	I				      I
	I-------------------------------------I
   2	I		ZYSARG		      I
	I-------------------------------------I
   3	I				      I
	I-------------------------------------I
   4	I		ZYSP1		      I
	I-------------------------------------I
   5	I		ZYSSFD		      I
	I-------------------------------------I
	.				      .
	.				      .


Explanations:

This record contains the SFD path for a file and
is pointed at from ZFIARG.
Note that this record can be 6 to 11 words depending
on the number of SFD:s. The last SFD entry is always zero.

ZYSARG		argument in SFD path
ZYSP1		ppn
ZYSSFD		first SFD name in SIXBIT

	ZXB record - extended LOOKUP/ENTER block
	========================================

Word no:
	I-------------------------------------I
   0	I				      I
	I	   record header	      I
   1	I				      I
	I-------------------------------------I
   2	I		ZXBARG		      I
	I-------------------------------------I
   3	I		ZXBP2		      I
	I-------------------------------------I
   4	I		ZXBFIL		      I
	I------------------I------------------I
   5	I	ZXBEXT	   I		      I
	I------------------I------------------I
   6	I		ZXBPRT		      I
	I-------------------------------------I
   7	I		ZXBLNG		      I
	I-------------------------------------I
  10	I				      I
	I-------------------------------------I
  11	I				      I
	I-------------------------------------I
  12	I		ZXBLEN		      I
	I-------------------------------------I
  13	I		ZXBALC		      I
	I-------------------------------------I


EXPLANATIONS

ZXBARG		number of words following this word
ZXBP2		ppn
ZXBFIL		file name
ZXBEXT		extension
ZXBPRT		protection code
ZXBLNG		file length in words
ZXBLEN		estimated file length
ZXBALC		allocated file length

	ZFS record - IOSPEC table entry
	===============================

Word no:
	I------------------I------------------I
  -1	I	ZFSLNK	   I		      I
	I------------------I------------------I
   0	I		ZFSNAM		      I
	I-------------------------------------I
   1	I		ZFSDEV		      I
	I------------------I------------------I
   2	I	ZFSSIZ	   I	  ZFSLIM      I
	I------------------I------------------I
   3	I	ZFSIML	   I	  flags	      I
	I------------------I------------------I
   4	I		ZFSFIL		      I
	I------------------I------------------I
   5	I	ZFSEXT	   I	  ZFSBUF      I
	I------------------I------------------I
   6	I				      I  Bits 0-8: ZFSPT
	I------------------I------------------I
   7	I	ZFSPRJ	   I	  ZFSPRG      I  Bits 0-35: ZFSADR
	I------------------I------------------I
  10	I		ZFSARG		      I
	I-------------------------------------I
  11	I				      I
	I-------------------------------------I
  12	I		ZFSPPN		      I
	I-------------------------------------I
  13	I		ZFSSFD		      I
	I-------------------------------------I


Explanations

ZFSLNK		pointer to next ZFS entry or -1 if last
ZFSNAM		logical file name
ZFSDEV		device name
ZFSSIZ		initial file size from S-switch
ZFSLIM		max file size from L-switch
ZFSIML		directfile image size from I-switch
ZFSAPP		append mode switch
ZFSSUB		SFD switch
ZFSNUM		[24] Line numbers on this file
ZFSWDB		[24] Word aligned images in buffer
ZFSRON		[24] Read only file
ZFSFIL		file name
ZFSEXT		extension
ZFSPT		protection code
ZFSPRJ		project number
ZFSPRG		programmer number
ZFSARG		argument in SFD path
ZFSPPN		ppn in SFD path
ZFSSFD		SFD name

;
	EXTERN	.TXST,.TXSU,.TXVA,.IOIC


	TWOSEG
	RELOC	400K

IFN QDEBUG,<
IOST:		;LABEL FOR DEBUGGING
>

DEFINE BREAKOUTIMAGE(A)=<
	SKPINC	;;CLEAR CONTROL-O
	NOP
	OUTSTR	[ASCIZ/A/]>

edit(24)
DEFINE NORMALIZE(xp)<;;[24] Change byte ptr [010700,,addr] and [700,,addr]
			;;  to [440700,,addr+1]
	IF
		TLNE	xp,400000	;;No change if already ok
		GOTO	FALSE
	THEN
		HRLI	xp,440700
		ADDI	xp,1
	FI
>

DEFINE OUTIMAGE(A)=<
	SKPINC
	NOP
	OUTSTR	[ASCIZ/A
/]>


edit(236)
IFN <%ZFIOP>,<PRINTX %ZFIOPN not bit 0 as assumed>	;[236]

DEFINE IFNOTOPEN(x)<;;[236]
	SKIPL	OFFSET(ZFIOPN)(x)
>
DEFINE IFOPEN(x)<;;[236]
	SKIPGE	OFFSET(ZFIOPN)(x)
>

COMMENT ;

ERROR MESSSAGES IN THIS MODULE:
===============================

NO	MESSAGE
--	-------

 0 	FILE NOT OPEN
 3	TRANSFER FAILURE
 4	FILE ALREADY OPEN
 5	FILE ALREADY CLOSED
 6	CLOSE FAILURE
 7	EOF IN INIMAGE
10	EXTERNAL IMAGE TOO LONG
11	TOO BIG IMAGE
12	EJECT ARGUMENT OUT OF RANGE
13	SPACING ARGUMENT OUT OF RANGE
14	OUTPUT FIELD WIDTH OUT OF RANGE
15	OUTPUT LIMIT EXCEEDED
16	LOCATION NOT POSITIVE
;
	SUBTTL	;[24] Local definitions

	edit(24)

BUP==	OFFSET(ZBHBUP)
CNT==	OFFSET(ZBHCNT)
IMG==	OFFSET(ZFIIMG)

XLB==	XK	;Length of contiguous field in a buffer
XLI==	XL	;Length of field remaining to be copied
	SUBTTL	SUBROUTINE/PROCEDURE NAME DEFINITIONS

COMMENT ;

a) Local subroutines used internally in the IO module
   or externally in other run-time modules.
   (names not defined here are defined in SIMRTS through
   the PROCINIT macro).
;

OPDEF	COMPBLOCK	[PUSHJ XPDP,.IOCB]	;Computes relative block no in a
						;DIRECTFILE
OPDEF	COMPPOINTER	[PUSHJ XPDP,IOCP]	;Computes image byte pointer
OPDEF	COMPSTART	[PUSHJ XPDP,.IOCS]	;Computes ext image start in buffer
OPDEF	FINDBLOCK	[PUSHJ XPDP,IOSETO]	;Positions a DIRECTFILE
OPDEF	GETCHR		[PUSHJ XPDP,IOGC]	;Picks up next input character
						edit(41)
INTERN	.IOCLA					;[41] Tests if any file open or
						;[41] Closes SYSIN and SYSOUT
						;Called at execution end
INTERN	.IOFD					;FIELD procedure
INTERN	.IOLN					;Checks if logical name already in use
						;Called by SIMDDT
OPDEF	PUTCHAR		[PUSHJ XPDP,.IOPC]
OPDEF	PUTOUT		[PUSHJ XPDP,.IOPUT]
OPDEF	READBLOCK	[PUSHJ XPDP,.IORB]	;Inputs next buffer
						edit(24)
OPDEF	READNEXT	[PUSHJ XPDP,IORN]	;[24] Inputs next buffer sequentially
OPDEF	SEEKNAME	[PUSHJ XPDP,IOSEEK]	;Seeks a logical name in file object


COMMENT ;

B) SIMULA PROCEDURES:
;

	INTERN	.IOCL	;CLOSE
	INTERN	.IOEJ	;EJECT
	INTERN	.IOIG	;INIMAGE
	INTERN	.IOLI	;LASTITEM
	INTERN	.IOLT	;LOCATE
	INTERN	.IOLP	;LINESPERPAGE
	INTERN	.IOOP	;OPEN
	INTERN	.IOOG	;OUTIMAGE
	INTERN	.IOBO	;BREAKOUTIMAGE
	INTERN	.IOSP	;SPACING
	SUBTTL	Local subroutine: COMPBLOCK

COMMENT ;

Purpose:	To compute the relative block number (ZDFBLK)
		from the ordinal image number (ZDFLOC) and the
		image size (ZDFIML).
		The expression:
		((ZDFIML//5)+1)*(LOC-1))//128
		is computed.
		The quotient+1 is the block number
		and the remainder is the offset within the buffer.
Entry:		.IOCB
Input argument:
		XWAC1 points to file object
Output arguments:
		X0 contains ZDFBLK
		X1 contains offset within buffer.
Normal exit:	RETURN
Error exit:	-
Call format:	COMPPOINTER
Used routines:	-
Used registers:	X0,X1,X2
Error messages:	-
;

.IOCB::
	LF	X0,ZDFIML(XWAC1)
	IDIVI	X0,5		;Convert to words
	CAIE	X1,0
	ADDI	X0,1
	LF	X2,ZDFLOC(XWAC1)
	IMULI	X0,-1(X2)
	IDIVI	X0,200
	ADDI	X0,1
	RETURN
	SUBTTL	Local subroutine: COMPPOINTER

	edit(24)
COMMENT ;[24] Changed to be quicker in the normal case

Purpose:	To compute a byte pointer to an image from the
		text reference.
Entry:		IOCP
Input:
		XWAC2-XWAC3 contain the text reference
Output:
		XIP contains the byte pointer
		XTAC is offset within word [24]
Normal exit:	RETURN
Error exit:	-
Call format:	COMPPOINTER
Used routines:	-
Used registers:
		XSAC,XTAC
Error messages:	-
;

IOCP:
	LI	XIP,2+OFFSET(ZTVZTE)(XWAC2)
	LF	XSAC,ZTVSP(,XWAC2)
	IF	;No offset
		JUMPN	XSAC,FALSE
	THEN
		HRLI	XIP,(POINT 7,0,-1)
		SETZ	XTAC,
		RETURN
	FI
	IDIVI	XSAC,5		;Offset within main text
	ADDI	XIP,(XSAC)	;Add offset to start of text
	HLL	XIP,   [POINT 7,0,-1
			POINT 7,0,6
			POINT 7,0,13
			POINT 7,0,20
			POINT 7,0,27](XTAC)	;Select byte pointer
	RETURN
	SUBTTL	Local subroutine: COMPSTART

COMMENT ;

Purpose:	To compute the start address in the buffer for
		a DIRECTFILE image.
		Note that a DIRECTFILE image always starts on
		a word boundary.
Entry:		.IOCS
Input arguments:
		XBH points to the buffer area
		-1(XPDP) contains offset to the image within the buffer
Output arguments:
		ZBHBUP and ZBHCNT are updated.
Normal exit:	RETURN
Error exit:	-
Call format:	COMPSTART
Used routines:	-
Used registers:	X0, X1
Error messages:	-
;

.IOCS::
	L	X1,-1(XPDP)
	LF	X0,ZBHZBU(XBH)	;Get address to buffer
	ADDI	X0,2(X1)	;Add offset + 2
	HRLI	X0,(POINT 7,0)	;Set up pointer
	SF	X0,ZBHBUP(XBH)
	LF	X0,ZBHZBU(XBH)	;Start of buffer
	LF	X1,ZBHBUP(XBH)	;Image start
	SUBI	X0,-202(X1)	;X0:=remainder of words in buffer
	IMULI	X0,5		;Convert to characters
	SF	X0,ZBHCNT(XBH)
	RETURN
	SUBTTL	Local subroutine: FINDBLOCK

COMMENT ;

PURPOSE:	TO DO A USETO TO PREPARE FOR OUTPUT OF A DIRECTFILE BLOCK
ENTRY:		IOSETO
INPUT ARGUMENTS:
		FILE REF IN XWAC1
OUTPUT ARGUMENTS:-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	FINDBLOCK
USED ROUTINES:	-
USED REGISTER:	X0
ERROR MESSAGES:	-
;

IOSETO:
	LF	X0,ZDFBLK(XWAC1)	;DO USETO WITH BLOCK NO
					;USED BY LATEST USETI
	CAIG	X0,0
	LI	X0,1			;BLOCK 0 NOT VALID
	FILOP	(USETO)
	RETURN
	SUBTTL	Local subroutine: GETCHR

	edit(24)
COMMENT ;[24] Some changes: Only used for Infile (GETCHD for directfile).
	 Restructured.

PURPOSE:	TO FETCH NEXT BYTE FROM THE INPUT BUFFER.
		ALL NULLS AND CARRIAGE RETURNS ARE IGNORED.
		THE END OF LINE FLAG IS TURNED ON IF A
		BREAK CHARACTER IS  FOUND OR IF END OF
		FILE OCCURS.
ENTRY:		IOGC
INPUT ARGUMENT:
		XBH POINTS TO THE BUFFER AREA.
OUTPUT ARGUMENT:
		X0 CONTAINS NEXT BYTE.
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	GETCHR
USED ROUTINES:	READBLOCK
USED REGISTERS:	X0, XTAC
ERROR MESSAGES:	-
;

IOGC:	PROC
L1():!	LOOP
		SOSGE	CNT(XBH)	;DECREASE BUFFER BYTE COUNTER
		GOTO	L2
		ILDB	BUP(XBH)	;FETCH NEXT BYTE
		CAILE	X0,033
		RETURN			;IF NOT BREAK CHARACTER
	AS	JUMPE	TRUE		;[24] Ignore null
		CAIN	X0,QCR
		GOTO	TRUE		;IGNORE CARRIAGE RETURN
	SA
	CAIN	X0,QLF
	GOTO	L9		;LF IS BREAK CHARACTER
	IF	;VT, ALTMODE OR FF
		CAIE	X0,013
		CAIN	X0,033
		GOTO	TRUE
		CAIE	X0,014
		GOTO	FALSE
	THEN	;BREAK CHARACTER WHICH IS TRANSFERRED TO IMAGE
		SETO	XTAC,
	ELSE	
			edit(14)
		IF	;[14] ^Z
			CAIE	X0,"Z"-"A"+1
			GOTO	FALSE
		THEN	;Ignore if TTY
			IFON	ZFITTY(XWAC1)
			GOTO	L1	;TO GET END OF FILE
	FI	FI
	RETURN	;if not LF or EOF


L2():!
	READBLOCK		;[24]
	IFOFF	ZFIEND(XWAC1)
	GOTO	L1

L9():!
	;HERE IF LINE FEED OR END OF FILE
	SETO	XTAC,		;FLAG END OF LINE
	LI	X0," " 		;PAD WITH BLANK
	RETURN
	EPROC
	SUBTTL	.IOCLA - Close and test opened files

Comment ;

		edit(41)
		edit(302)
Purpose:	[41] To scan through the channel table and 
	a)	test if any files except SYSIN, SYSOUT or
		any SIMDDT input or output file are open or
	b)	close those other files.
Entry:		.IOCLA
Input conditions:
		Called from OCEP at execution termination.
		Switch SDSCLO off if testing for open files
		Switch SDSCLO on  if special to be closed
Output arguments:
		X0 is 0 if no files open
		X0 is -1 if open files exist

		SYSIN, SYSOUT and other special files closed
		if switch SDSCLO on
Normal exit:	RETURN
Error exit:	-
Call format:	EXEC .IOCLA
Used routines:
		.IOCL
Used registers:
		X0	working register
		X1	address to channel table
		X4	no of elements in channel table
		XWAC1	file reference
		X1-X4 are saved.
Error messages:	-
;

.IOCLA:	PROC
	LOWADR
	CFORBID
	SAVE	<X1,X4,X5>
	LOWADR
			edit(15)
	LI	X5,1	;[15] Loop twice for TTY files
L1():!			;[15]
	LI	X1,YIOCHTB(XLOW);X1=address to channel table
	HRLI	X1,-^D16	;Count of elements in channel table
	LOOP	;Through channel table
		IF	;This channel still used
			SKIPN	XWAC1,(X1)	;[302]
			GOTO	FALSE
		THEN	;Close the file(s)
			TLNE	XWAC1,-1
			 HLRZ	XWAC1,XWAC1	;[302] Select output side
						edit(236)
			IFNOTOPEN(XWAC1)	;[236]
			 GOTO	L9
			
			IF	;Special file
				CAME	XWAC1,YSYSOU(XLOW)
				CAMN	XWAC1,YSYSIN(XLOW)
				 GOTO	TRUE
				CAME	XWAC1,YDSUFO(XLOW) ;SIMDDT USE file
				CAMN	XWAC1,YDSIFO(XLOW) ;SIMDDT @ file
				 GOTO	TRUE
				CAME	XWAC1,YDSDFO(XLOW)
				GOTO	FALSE
			THEN	;Ok if open, close if SDSCLO
				IFON	SDSCLO(XLOW)
				 EXEC	.IOCL
			ELSE	;A normal file was open
				IFON	SDSCLO(XLOW)
				 GOTO	L8		;EXIT
			FI

		FI
L9():!
	AS	AOBJN	X1,TRUE
	SA
				edit(15)
	SOJGE	X5,L1		;[15] Loop for TTY (or PTY) files
				; No special treatment of SYSOUT
	TDZA	X0,X0		;Return no open files
L8():!	 SETO	X0,
	CALLOW
	RETURN
	EPROC
	SUBTTL	.IOFD - FIELD

COMMENT ;

PURPOSE:	TO COMPUTE A TEXT REFERENCE TO A FIELD IN THE
		CURRENT OR NEXT OUTPUT IMAGE WHICH IS LARGE ENOUGH
		TO HOLD THE EDITED VALUE.
ENTRY:		.IOFD
CALLING FORMAT IN SIMULA (NOT DIRECTLY ACCESSIBLE):
		FIELD(W)
INPUT ARGUMENTS:
		XWAC1 CONTAINS THE FILE REFERENCE
		XWAC2 CONTAINS FIELD WIDTH, W
OUTPUT ARGUMENTS:
		XWAC1 CONTAINS ADDRESS TO NEW TEXT REFERENCE IN YTXZTV
NORMAL EXIT:	RETURN
ERROR EXIT:	IOERC	[41]
USED REGISTERS:	XWAC2-6	[76]
USED ROUTINES:
		.IOOG (OUTIMAGE), .TXSU(SUB).
ERROR MESSAGES:	FIELD ERROR
		FILE NOT OPEN
;

.IOFD:	PROC
	edit(76)
	SAVE	<XWAC2,XWAC3,XWAC4,XWAC5,XWAC6>	;[76]
	LD	XWAC3,IMG(XWAC1)
	LF	XWAC5,ZTVCP(,XWAC3);XWAC5:=POS-1
	edit(41)
L1():!				;[41]
	LF	X0,ZTVLNG(,XWAC3)
	SUBI	X0,(XWAC2)	;X0:=LENGTH-W
	IF	;FIELD WIDTH OUT OF RANGE, I.E.
		;W <= 0 OR W> LENGTH
		JUMPLE	XWAC2,TRUE
		JUMPGE	X0,FALSE
	THEN	;ERROR!
		ERRFILE
					edit(236)
		IFNOTOPEN(XWAC1)	;[41,236]
		IOERR	0,File not open
		edit(41)	;[41]:
		IOERC	QDSNIN,14,Output field width out of range
		NEWVALUE XWAC2		;[41]
		GOTO 	L1		;[41]
	FI
	CAMLE	XWAC5,X0	;IF POS > LENGTH-W
	EXEC	.IOOG		;DO OUTIMAGE
	LF	XWAC5,ZFIICP(XWAC1)	;Reload the position
	LI	XTAC,XWAC3	;XTAC:-TEXT REFERENCE
	ADDI	XWAC5,1
	LI	XWAC6,(XWAC2)	;XWAC6:=W
	EXEC	.TXSU		;IMAGE.SUB(POS,W)
	LOWADR
	STD	XWAC3,YTXZTV(XLOW);STORE NEW TEXT REFERENCE
	ADDM	XWAC2,OFFSET(ZFIICP)(XWAC1);SETPOS(POS+W)
	LI	XWAC1,YTXZTV(XLOW);ADDRESS TO NEW TEXT REFERENCE
	RETURN
	EPROC
	SUBTTL	.IOLN - Find logical name for USE command (SIMDDT)

COMMENT ;
PURPOSE:	TO CHECK IF THE LOGICAL NAME IN A SIMDDT
		USE COMMAND IS ALREADY USED.
ENTRY:		.IOLN
INPUT ARGUMENT:
		XWAC2-XWAC3 CONTAIN TEXT VARIABLE FOR THE USE OPERAND
OUTPUT ARGUMENTS:
		X2 CONTAINS FILE REF IF ALREADY USED LOGICAL NAME
		X2 = 0 IF NOT USED
		X2 = -1 IF "USE TTY:" COMMAND
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	EXEC .IOLN
USED ROUTINES:	GETNAME
		SEEKNAME
USED REGISTERS:	X1, X2, XWAC2
ERROR MESSAGES:	-
;

.IOLN:	PROC
	SAVE	<XNAME,XBYTE>
	HRLI	XWAC2,440700	;SET UP POINTER TO USE OPERAND
	ADDI	XWAC2,2
	ST	XWAC2,YOCPNT(XLOW)
	GETNAME	
	IF	;DEVICE WAS GIVEN
		CAIE	XBYTE,":"
		GOTO	FALSE
	THEN	IF	;IT WAS TTY
			CAME	XNAME,[SIXBIT/TTY/]
			GOTO	FALSE
		THEN	;FLAG TTY TO SIMDDT
			HRROI	X2,-1
			GOTO	L9
		FI
		GETNAME
	FI
	;NOW SEARCH FOR THE LOGICAL NAME
	MOVSI	X1,-20
	HRRI	X1,(XLOW)
	LOOP	;UNTIL END OF YIOCHTB
		;OR NAME FOUND
		HLRZ	X2,YIOCHTB(X1)
		SEEKNAME
		 GOTO	L9		;FOUND!
		HRRZ	X2,YIOCHTB(X1)
		SEEKNAME
		 GOTO	L9		;FOUND!
	AS	INCR	X1,TRUE
	SA
	LI	X2,0		;NOT FOUND
L9():!
	RETURN
	EPROC
	SUBTTL	Local macro: GETCHD

COMMENT;

PURPOSE:	To get next character from a directfile. Blank is substituted
		for null.

OUTPUT:		Next character in the parameter ac (default X0).
;

DEFINE	GETCHD(X)<
	SOSGE	CNT(XBH)
	EXEC	IOGDNB
	ILDB	X,BUP(XBH)
	IF	;;null
		JUMPN	X,FALSE
	THEN	;;Return " "
		LI	X," "
	ELSE	;;Save last char in XSAC
		L	XSAC,X
	FI
>

IOGDNB:	PROC
	SAVE	XSAC
	READNEXTBLOCK
	SOS	CNT(XBH)
	RETURN
	EPROC
	SUBTTL	Local subroutine: PUTCHAR

COMMENT ;

PURPOSE:	TO STORE A CHARACTER IN THE OUTPUT BUFFER.
		ON BUFFER OVERFLOW AN OUT UUO IS EXECUTED.
		IF IT IS A DIRECTFILE THE OUT UUO IS PRECEDED
		BY A USETO UUO AND READBLOCK IS CALLED TO READ
		IN THE NEXT CONSECUTIVE BLOCK IF ANY.
		PUTCHAR USES A SUBROUTINE .IONB
		WHICH WRITES THE OUTPUT BUFFER WHEN IT BECOMES
		FULL. IONB IS ALSO CALLED DIRECTLY FROM
		OUTIMAGE (.IOOG-.IOBO).
		NOTE THAT IONB ALWAYS RETURNS TO THE INSTRUCTION
		PRECEDING THE CALL!
INPUT ARGUMENT:
		X0 CONTAINS THE BYTE TO BE STORED
OUTPUT ARGUMENTS:-
NORMAL EXIT:	RETURN
ERROR EXIT:	IOERR
CALL FORMAT:	PUTCHAR
USED ROUTINES:	IONB
		ERRFILE
		PUTOUT
		FINDBLOCK
		READBLOCK
USED REGISTERS:	X0, X1, XBH
ERROR MESSAGE:	OUTPUT LIMIT EXCEEDED
;

.IOPC:
	SOSGE	CNT(XBH)
	EXEC	.IONB		;WRITE CURRENT BLOCK IF FULL
	IDPB	X0,BUP(XBH)
	RETURN

.IONB::	PROC
	SAVE	<X0>
L1():!	IF	;OUTFILE OR PRINTFILE
		IFOFF	ZFIOF(XWAC1)
		GOTO	FALSE
	THEN	LF	X0,ZOFLIM(XWAC1)
						edit(230)
		LF	X1,ZOFBLK(XWAC1)	;[230]
		IF	;A LIMIT WAS SET FOR THIS FILE
			JUMPE	X0,FALSE
		THEN	;Check against limit
			IF	;NO OF BLOCKS WRITTEN EQUALS LIMIT
				CAMGE	X1,X0
				GOTO	FALSE
			THEN	ERRFILE
				SETOFF	ZFIOPN(XWAC1)	;FLAG FILE CLOSED  [1C]
				edit(41)	;[41]:
				IOERC	QDSCON,15,Output limit exceeded
				SETON	ZFIOPN(XWAC1)	;Flag file open if proceed [41]
				ZF	ZOFLIM(XWAC1)	;and set no limit [41]
		FI	FI
					edit(230)
		ADDI	X1,1		;[230] Always update write count
		SF	X1,ZOFBLK(XWAC1);[230]
		PUTOUT
	ELSE
	IF	;DIRECTFILE
		IFOFF	ZFIDF(XWAC1)
		GOTO	FALSE
	THEN	FINDBLOCK		;DO USETO UUO
		PUTOUT			;AND WRITE BLOCK
		READNEXTBLOCK
		;NOW UPDATE BYTE COUNTER AND BYTE POINTER
		LF	X0,ZBHZBU(XBH)
		ADDI	X0,2
		HRLI	X0,(POINT 7,0)
		LI	X1,5*200
		STD	X0,BUP(XBH)
	FI	FI
	SOS	-1(XPDP)	;Special return!!
	SOS	-1(XPDP)
	RETURN
	EPROC
	SUBTTL	LOCAL SUBROUTINE: PUTOUT - OUTPUT NEXT BUFFER

COMMENT ;

PURPOSE:	TO OUTPUT NEXT BUFFER
ENTRY:		.IOPUT
INPUT ARGUMENT:
		FILE REF IN XWAC1
		BUFFER POINTER IN XBH FOR DIRECTFILE   [5]
OUTPUT ARGUMENTS:-
NORMAT EXIT:	RETURN
ERROR EXIT:	IOERR
CALL FORMAT:	PUTOUT
USED ROUTINE:	ERRFILE
USED REGISTERS:	X0, X1, XBH (=XWAC5) [24LE]
ERROR MESSAGE:	TRANSFER FAILURE
;

.IOPUT:
	IF	;DIRECTFILE
		IFOFF	ZFIDF(XWAC1)
		GOTO	FALSE
	THEN	edit(5)
		;[5] USE THE WORD COUNT ZDFWCT TO SET CURRENT WORD COUNT
		; ZBUWCT AND UPDATE ZDFWCT

		LF	X1,ZDFWCT(XWAC1)
		IF	;RECORD OVERLAPS BUFFER END
			CAIG	X1,200
			GOTO	FALSE
		THEN	;Modify count
			SUBI	X1,200
			SF	X1,ZDFWCT(XWAC1)
			LI	X1,200
		ELSE	;Nothing will be left to output
			ZF	ZDFWCT(XWAC1)
		FI
		SF	X1,ZBUWCT(XBH)

		LF	X1,ZFIOBH(XWAC1);BUFFER HEADER ADDRESS
		SETOFF	ZDFMOD(XWAC1)	;NO MODIFICATION
		LF	X0,ZBHZBU(X1,-1)
	ELSE
		edit(24)
		IF	;[24LE] XBH non-zero and byte pointer word address too large
			JUMPE	XBH,FALSE
			L	BUP(XBH)
			TLNN	400000
			GOTO	FALSE
		THEN	;Fix byte pointer
			SUBI	1
			HRLI	010700
			ST	BUP(XBH)
		FI	;[24LE]
		LI	X0,0
	FI
	FILOP	(OUT)
	IF	;[24] Not OK
		GOTO	FALSE
	THEN	;Error, flag file as closed, give message
		SETOFF	ZFIOPN(XWAC1)
		ERRFILE
		IOERR	3,Transfer failure
	FI	;[24]

	IF	;[24LE] XBH nonzero
		JUMPE	XBH,FALSE
		L	BUP(XBH)	;and byte pointer not
		TLNE	400000		;of the form 440700,,addr
		GOTO	FALSE
	THEN	;Make it
		HRLI	(POINT 7,0)
		ADDI	1	;Must add one to word addr
		ST	BUP(XBH)
	FI	;[24]
	RETURN
	SUBTTL	LOCAL SUBROUTINE: READBLOCK

COMMENT ;

PURPOSE:	TO READ NEXT BLOCK FROM AN INFILE OR DIRECTFILE.
		IF IT IS A DIRECTFILE THEN THE EXTERNAL BLOCK
		NUMBER IS CHECKED TO SEE IF IT IS A BLOCK IN THE FILE.
		IF IT IS NOT THEN THE END OF FILE FLAG IS TURNED ON,
		ELSE A USETI IS PERFORMED.
ENTRY:		.IORB
INPUT ARGUMENT:	XWAC1 POINTS TO FILE OBJECT
OUTPUT ARGUMENTS:-
NORMAL EXIT:	RETURN
ERROR EXIT:	IOERR
CALL FORMAT:	READBLOCK
USED ROUTINES:	COMPBLOCK
		IOUPD
		ERRFILE
USED REGISTERS:	X0, X1
ERROR MESSAGE:	TRANSFER FAILURE
;

.IORB::	PROC
	IF	;DIRECTFILE
		IFOFF	ZFIDF(XWAC1)
		GOTO	FALSE
	THEN	LF	X0,ZDFLOC(XWAC1)
		JUMPLE	X0,L1
		;NOW CHECK IF BLOCK OUT OF RANGE
		;THIS COULD BE THE CASE WHEN A
		;DIRECTFILE IS PROCESSED SEQUENTIALLY
		;AND NO LOCATE HAS BEEN DONE
		LF	X1,ZDFLIM(XWAC1)
		IF	;LOCATION GREATER THAN LIMIT
			CAMG	X0,X1
			GOTO	FALSE
		THEN	;TURN ON END-OF-FILE FLAGS
			SETON	ZIFEND(XWAC1)
			SETON	ZFIEND(XWAC1)
		FI
		IF	;SEQUENTIAL INPUT
			IFOFF	ZFINB(XWAC1)
			GOTO	FALSE
		THEN	;BLOCKNO:=PREVIOUS BLOCKNO +1
			LF	X0,ZDFBLK(XWAC1)
			ADDI	X0,1
		ELSE	;BLOCKNO:=COMPBLOCK
			COMPBLOCK
		FI
		EXEC	IOUPD		;PERFORM OUTPUT OF OLD BUFFER IF CHANGED
		SF	X0,ZDFBLK(XWAC1);UPDATE PREVIOUS BLOCKNO
		FILOP	(USETI)
		LF	X1,ZBHZBU(XBH);BUFFER ADDRESS
	ELSE
		LI	X1,0
	FI
	FILOP	(IN,X1)
		edit(24)
	IF	;[24] IN was not ok
		GOTO	FALSE
	THEN
		IF	;END OF FILE
			IOCHECK
			GOTO	FALSE
	L1():!	THEN	IF	;DIRECTFILE	;[1C]
				IFOFF	ZFIDF(XWAC1)
				GOTO	FALSE
			THEN	;CLEAR THE BUFFER
				Q==OFFSET(ZBUDAT)
				SETZM	Q(XBH)
				LI	X1,Q+1(XBH)
				HRLI	X1,-1(X1)
				BLT	X1,Q+200-1(XBH)
			edit(5) ;[5]	ZF	ZBUWCT(XBH)	;RESET WORD COUNT
				IF	;OUTIMAGE WAS CALLED
					IFOFF	ZDFOUT(XWAC1)
					GOTO	FALSE
				THEN	LF	X1,ZDFBLK(XWAC1)
					FILOP	(USETO,X1)
					GOTO	L9
				FI
				SETON	ZIFEND(XWAC1)
			FI
			SETON	ZFIEND(XWAC1)
			GOTO	L9
		FI
		;HERE WHEN TRANSFER FAILURE
		SETOFF	ZFIOPN(XWAC1)	;FLAG FILE CLOSED [1C]
		ERRFILE
		IOERR	3,Transfer failure
	FI	;[24]
L9():!	;[24] Make sure byte pointer is of right form
	L	BUP(XBH)
	IF	;Not of the form 440700,,addr
		TLNE	400000
		GOTO	FALSE
	THEN	;Make it
		HRLI	440700
		ADDI	1
		ST	BUP(XBH)
	FI
	RETURN
	EPROC
	SUBTTL	[24] Local subroutine: READNEXTBLOCK

	edit(24)

Comment;

Purpose:	Reads next block in sequence from a directfile or infile
Function:	Calls READBLOCK with the appropriate switch set on
Entry:		IORN
;

IORN:	SETON	ZFINB(XWAC1)
	READBLOCK
	SETOFF	ZFINB(XWAC1)
	RETURN
	SUBTTL	LOCAL SUBROUTINE: IOUPD

COMMENT;

PURPOSE:	TO OUTPUT THE LAST ACTIVE BUFFER IF OUTIMAGE WAS PERFORMED
		ON (PART OF) IT. USED BY DIRECTFILE.
ENTRY:		IOUPD
INPUT ARGUMENT:	X0 CONTAINS CURRENT BLOCK NO
OUTPUT ARGUMENTS:-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	EXEC IOUPD
USED ROUTINES:	FINDBLOCK
		PUTOUT
USED REGISTER:	X0
ERROR MESSAGES:	-
;

IOUPD:	PROC
	SAVE	X0
	LF	X0,ZDFBLK(XWAC1)
	IF	;NO LONGER SAME BLOCK AND THE OLD ONE WAS CHANGED
		CAMN	X0,(XPDP)
		GOTO	FALSE
		IFOFF	ZDFMOD(XWAC1)
		GOTO	FALSE
	THEN	;OUTPUT THE BLOCK BEFORE READING NEW BLOCK
		FINDBLOCK
		PUTOUT
	FI
	RETURN
	EPROC
	SUBTTL	LOCAL SUBROUTINE: SEEKNAME

COMMENT ;

PURPOSE:	TO SEE IF A LOGICAL FILE NAME EXISTS.
ENTRY:		IOSEEK
INPUT ARGUMENTS:
		XNAME CONTAINS THE SOUGHT LOGICAL NAME
		X2 CONTAINS POINTER TO THE FILE OBJECT
OUTPUT ARGUMENT:
		IMMEDIATE RETURN WHEN THE LOGICAL
		NAME WAS IN USE ELSE SKIP RETURN.
		ERROR MESSAGE ABOUT DOUBLE DEFINITION IS
		PRINTED ONLY WHEN SEEKNAME IS CALLED
		FROM SETUPFILE
NORMAL EXIT:	SKIP RETURN
ERROR EXIT:	IMMEDIATE RETURN
CALL FORMAT:	SEEKNAME
USED ROUTINES:	BREAKOUTIMAGE
		OUTIMAGE
		TYPENAME
USED REGISTERS:	X0, X2
ERROR MESSAGE:	LOGICAL NAME <...> ALREADY DEFINED
;

IOSEEK:
	IF	;NAME IS NOT SAME OR NO FILE OBJECT
		JUMPE	X2,TRUE
		CAMN	XNAME,OFFSET(ZFINAM)(X2)
		GOTO	FALSE
	THEN	AOS	(XPDP)
		RETURN
	FI
	IFON	YDSACT(XLOW)	;IF SIMDDT ACTIVE
	RETURN
	BREAKOUTIMAGE <Logical name: >
	L	X0,X6
	TYPENAME
	OUTIMAGE <already defined.>
	RETURN
	SUBTTL	SIMULA PROCEDURE: .IOCL - CLOSE

COMMENT ;

PURPOSE:	TO CLOSE A FILE. IF THE FILE IS CLOSED ALREADY A
		RUN TIME ERROR OCCURS, EXCEPT FOR SYSOUT OR SYSIN.
		IF OUTFILE OR PRINTFILE AND POS > 1 THE LAST IMAGE
		IS OUTPUT BY A CALL TO OUTIMAGE (.IOOG).
		THE CHANNEL IS RELEASED AND IOCHTB UPDATED.
		THE BUFFER AREA IS RELEASED (FREEBUFF). THE OPEN
		FLAG IS TURNED OFF.
INPUT ARGUMENTS:
		XWAC1 POINTS TO THE FILE OBJECT
OUTPUT ARGUMENTS:-
NORMAT EXIT:	RETURN
ERROR EXIT:	IOERC	[41]
CALL FORMAT:	EXEC	.IOCL
USED ROUTINES:	ERRFILE
		IOUPD
		.IOOG (OUTIMAGE)
		PUTCHAR
		FREEBUFF
USED REGISTERS:	X0, X1, XBH, XSW [61]
ERROR MESSAGES:	FILE ALREADY CLOSED
		CLOSE FAILURE
;

	edit(267)
	XCHN==XSW-1	;[267] Channel no
	XDVT==XCHN-1	;[267] DEVTYP word

.IOCL:	PROC
	edit(61)
	SAVE	<X1,XBH,XSW,XCHN,XDVT>	;[267] [61]

	LOWADR			;SET BASE REGISTER FOR STATIC AREA
	CDEFER
	L	XSW,OFFSET(ZFIFND)(XWAC1)	;[61]
	LF	XCHN,ZFICHN(XWAC1)	;[267]
	L	XDVT,XCHN
	DEVTYP	XDVT,
	 SETZ	XDVT,			;Error
	IF	;[61] Special call
		IFOFFA	ZFIFND(XSW)
		GOTO	FALSE
	THEN	;! Check channel first
		JUMPE	XDVT,L5	;[267] Channel not active
		GOTO	L3
	FI
	IF	;FILE ALREADY CLOSED
		IFONA	ZFIOPN(XSW)
		GOTO	FALSE
	THEN
		CAME	XWAC1,YSYSIN(XLOW)
		CAMN	XWAC1,YSYSOUT(XLOW)
		 GOTO	L9

		ERRFILE
		edit(41) ;[41]:
		IOERC	QDSCON,5,File already closed
		GOTO	L8		;Ignore CLOSE if user proceeds [41]
	FI
	IF	;THIS IS A FILE THAT CAN DO OUTPUT
		IFOFFA	ZFIOUT(XSW)
		GOTO	FALSE
	THEN
		edit(5)
		edit(44)
		;[5] [24] Set up buffer pointer in XBH.
		;Needed in PUTCHAR, PUTOUT (via IOUPD).
		LF	XBH,ZFIOBH(XWAC1)
		SUBI	XBH,1
		IF	;DIRECTFILE
			IFOFFA	ZFIDF(XSW)
			GOTO	FALSE
		THEN
			LI	X0,-1		;Fake a block number
			EXEC	IOUPD		;OUTPUT BLOCK IF MODIFIED
			GOTO	L5
		ELSE
			LF	X0,ZFIICP(XWAC1)	;CURRENT POSITION
			SKIPE	X0			;NOTHING IN IMAGE
			EXEC	.IOOG			;OUTIMAGE
		FI
		L	XSW,OFFSET(ZFIFO)(XWAC1)	;[61]
		IF	;Something was written
			IFOFFA	ZFIFO(XSW)
						edit(112)
			IFONA	ZFILBO(XSW)	;[112] but last call was
			GOTO	FALSE		;      not Breakoutimage
		THEN	;APPEND LAST LINE FEED
			LI	X0,QLF	
			PUTCHAR
	FI	FI
		edit(15)
L3():!	IF	;[15] Controlling terminal
		IFOFF	ZFITA(XWAC1)
		GOTO	FALSE
	THEN
		LF	X1,ZFICHN(XWAC1)
		ADD	X1,XLOW
		IF	;[15] ZERO RH IF INFILE AND LH IF OUTFILE IN YIOCHT
			IFONA	ZFIIF(XSW)
			GOTO	FALSE
		THEN
			HRRZS	YIOCHT(X1)
		ELSE
			HLLZS	YIOCHT(X1)
				edit(200)
			IF	;[200] ENDFILE was encountered
				IFOFF	ZIFEND(XWAC1)
				GOTO	FALSE
			THEN	;OPEN UUO to clear end-of-file condition
				LI	OFFSET(ZFISTI)(XWAC1)
				HLL	OFFSET(ZFICHN)(XWAC1)
				TLO	(OPEN)
				XCT
				 HALT
			FI	;[200]
		FI
		GOTO	L6		;SKIP CLOSE IF TTY FILE!
	FI
				edit(15)
	IFON ZFITTY(XWAC1)	;[15] Do not CLOSE a tty chnl
	 GOTO	L5		;[15] (but RELEASE when thru)
					edit(267)
	LDB	[POINT 6,XDVT,35] ;[267] TY.DEV field
	CAIN	.TYPTY
	 GOTO	L5		;[267] Do not CLOSE PTY channel (just release when thru)

				edit(230)
	SETZ	X1,		;[230] Normal close option
	IF	;OUTFILE ON DSK
		TRNE	XDVT,TY.DEV
		 GOTO	FALSE	;NOT DSK
		IFONA	ZFIDE(XSW)
		IFONA	ZFIAPP(XSW)	;[230] But not APPEND mode
		GOTO	FALSE
	THEN	;[230] Do not deallocate below SIZE argument
		LF	,ZOFBLK(XWAC1)
		LF	X1,ZFIFIL(XWAC1)
		IF	;Proper pointer
			TLNE	X1,-1
			GOTO	FALSE
		THEN	;It should point to an extended lookup block
			LF	X1,ZXBLEN(X1)
			IF	;Current size is greater than initial estimate
				; or estimate is at most 5
				CAIG	X1,5
				GOTO	TRUE
				CAIG	(X1)
				GOTO	FALSE
			THEN	;Release
				SETZ	X1,
			ELSE	;Keep all blocks when closing
				LI	X1,4
			FI
		ELSE	;Release superfluous blocks
			SETZ	X1,
	FI	FI
	IF	;[15]
		IFONA	ZFIIF(XSW)
		GOTO	FALSE
	THEN	;OUTFILE OR DIRECTFILE
		IFOFFA	ZFIDF(XSW)
		IORI	X1,2	;CLOSE ONLY OUTPUT SIDE IF NOT DIRECTFILE
	ELSE	;INPUT
		IORI	X1,1	;CLOSE ONLY INPUT SIDE
	FI
	L	X0,X1	;[15] END
	FILOP	(CLOSE)
	IF	IOCHECK
		GOTO	FALSE
	THEN	;CLOSE OK!
L5():!
				edit(61)
		JUMPE	XCHN,L9	;[61]
				edit(267)
		L	X1,XCHN	;[267]
		ADD	X1,XLOW
		;ZERO RH FOR INFILE, LH FOR OUTFILE AND BOTH HALVES
		; FOR DIRECTFILE IN YIOCHT
		IFOFFA	ZFIDF(XSW)
		IFONA	ZFIIF(XSW)
		 HLLZS	YIOCHT(X1)
		IFOFFA	ZFIIF(XSW)	;[302]
		 HRRZS	YIOCHT(X1)
		IF	;[15] Channel not used any more
			SKIPE	YIOCHT(X1)
			GOTO	FALSE
		THEN	edit(267) ;[267]
			FILOP	(RELEASE)
		FI
		HRROS	OFFSET(ZFICHN)(XWAC1)	;Flag file closed
L6():!
		IF	;OUTFILE OR PRINTFILE
			IFOFFA	ZFIOF(XSW)
			GOTO	FALSE
		THEN	LF	X1,ZFIOBH(XWAC1)
			ZF	ZOFBLK(XWAC1)	;RESET BLOCK COUNT
		ELSE
			LF	X1,ZFIIBH(XWAC1)
		FI
		IF	;[61] Address ok and not controlling tty
			SOJLE	X1,FALSE
			IFON	ZFITA(XWAC1)
			GOTO	FALSE
			edit(242)
		THEN	;[242]
			IFOFFA	ZFIBNW(XSW)
			FREEBUFF		;RELEASE BUFFER AREA
		FI
L9():!		SETZB	X0,X1
		STD	X0,IMG(XWAC1)	;IMAGE:-NOTEXT
		SETOFF	ZFIOPN(XWAC1)
		SETON	ZIFEND(XWAC1)	;FLAG END OF FILE
			edit(41)
L8():!			;[41]
		CENABLE
		RETURN
	FI

	;HERE IF CLOSE FAILURE
	SETOFF	ZFIOPN(XWAC1)	;FLAG FILE CLOSED [1C]
	ERRFILE
	edit(41) ;[41]:
	IOERC	QDSCON,6,CLOSE failure
	GOTO	L8		;If user proceeds [41]
	EPROC
	SUBTTL	SIMULA PROCEDURE: .IOEJ - EJECT

COMMENT ;

PURPOSE:	TO UPDATE LINE (ZPFLIN) IN THE FILE OBJECT.
		A RUN-TIME ERROR OCCURS IF THE ARGUMENT TO
		EJECT IS NOT POSITIVE.
ENTRY:		.IOEJ
INPUT ARGUMENTS:
		XWAC1 POINTS TO THE FILE OBJECT
		XWAC2 CONTAINS THE NEW VALUE OF LINE.
OUTPUT ARGUMENTS:
		ZFIECT:=TRUE, ZPFLIN:=XWAC2
NORMAL EXIT:	RETURN
ERROR EXIT:	IOERC		[41]
CALL FORMAT:	EXEC .IOEJ
USED ROUTINE:	ERRFILE
USED REGISTER:	X0
ERROR MESSAGE:	EJECT ARGUMENT OUT OF RANGE
;

.IOEJ:	IF	;EJECT ARGUMENT OUT OF RANGE
		JUMPG	XWAC2,FALSE
	THEN	;ERROR!
		ERRFILE
		edit(41) ;[41]:
		IOERC	QDSNIN,12,EJECT: argument out of range
		NEWVALUE XWAC2		;[41]
		GOTO	.IOEJ		;Try again with new argument [41]
	FI
	LF	X0,ZPFLP(XWAC1)	;LINESPERPAGE
	CAMGE	X0,XWAC2
	LI	XWAC2,1		;IF ARG > LINESPERPAGE THEN EJECT(1)
	SF	XWAC2,ZPFLIN(XWAC1)
	SETON	ZFIECT(XWAC1)
	RETURN
	SUBTTL	SIMULA PROCEDURE: .IOIG - INIMAGE

	edit(24)
COMMENT ;	[24] Several changes, especially for directfile

PURPOSE:	To copy data from the input buffer to the file Image.
		As a side effect, the next buffer may be input
		(more than one buffer for long images).
		A run time error occurs if ENDFILE was caused
		by the previous INIMAGE.
		INIMAGE works slightly differently for INFILE and
		DIRECTFILE.
	INFILE:
		Bytes are copied one at a time until a break character
		(LF, VT, FF or altmode) is encountered or Image is full.
		Nulls and CR characters are ignored. If the image becomes full
		and the next significant character (not null or CR) is not a
		break character, a run time error occurs. A break character
		other than LF is transferred to Image as well as causing end
		of transmission. The image is padded with blanks if necessary.
	DIRECTFILE:
		The imagesize given at file creation must match Image.Length
		exactly, or an error message is given. Image.Length bytes
		are always copied to Image, regardless of break characters.
		A BLT instruction is used if possible (Image word oriented).
		An empty image in the file (only zero words) is returned
		as the end of file image ("/*" padded with trailing blanks).
		ENDFILE is set if Loc<1 or Loc>max loc.
ENTRY:		.IOIG
INPUT ARGUMENTS:
		XWAC1 POINTS TO THE FILE OBJECT.
OUTPUT ARGUMENTS:-
NORMAL EXIT:	RETURN
ERROR EXIT:	IOERR
CALL FORMAT:	EXEC .IOIG
USED ROUTINES:
		COMPBLOCK,COMPPOINTER,COMPSTART,GETCHR,READBLOCK,
		ERRFILE, .IOLT (LOCATE)
USED REGISTERS:
		XWAC2-XWAC3 	TEXT REFERENCE
		XCC		LENGTH OF IMAGE
		XBH		POINTS TO BUFFER AREA
		XIP		BYTE POINTER TO IMAGE
		XTAC		END OF LINE FLAG
ERROR MESSAGES:	EOF IN INIMAGE
		EXTERNAL IMAGE TOO LONG
		IMAGE TOO LARGE
;

.IOIG:	PROC
	SAVE	<XWAC2,XWAC3,XCC,XBH,XIP,XL,XK>
	LOWADR
	CDEFER
	IF	;END OF FILE
		IFOFF	ZIFEND(XWAC1)
		GOTO	FALSE
	THEN	;ERROR
L1():!		ERRFILE
		IOERR	7,EOF in INIMAGE
	FI
	LI	XTAC,0		;XTAC IS USED AS END OF LINE FLAG
	LD	XWAC2,IMG(XWAC1)
	LF	XCC,ZTVLNG(,XWAC2)	;XCC=LENGTH OF IMAGE
	LF	XBH,ZFIIBH(XWAC1)
	SUBI	XBH,1		;XBH=POINTER TO BUFFER AREA
	IFOFF	ZFIDF(XWAC1)
	GOTO	IOIGIF	;[24]
;	GOTO	IOIGDF	;[24]
IOIGDF:	;DIRECTFILE
	;SEE IF THE WANTED BLOCK HAPPENS TO BE THE CURRENT
	SETOFF	ZDFOUT(XWAC1)	;Signal "INIMAGE called last" to READBLOCK
	COMPBLOCK	
	STACK	X1	;Note!!! Used by COMPSTART as parameter in the stack!
	LF	X1,ZDFBLK(XWAC1)
	CAIE	X0,(X1)		;CURRENT BLOCK?
	READBLOCK		;IF NOT READ THE WANTED BLOCK
	COMPSTART
	UNSTK	X1
					edit(24)
	LFE	,ZDFLOC(XWAC1)		;[24]
	LF	X1,ZDFLIM(XWAC1)	;[24]
	IF	;[24] Location <= 0 or > limit
		JUMPLE	TRUE
		CAIG	(X1)
		GOTO	FALSE
	THEN	;Return EOF image
		EXEC	IOIGEF
		GOTO	L6
	FI
	LF	XLI,ZDFIML(XWAC1)	;Required image length + 2
	SUBI	XLI,2
	CAILE	XLI,(XCC)		;Must fit in internal image
	GOTO	L5	;Error
	CAIE	XLI,(XCC)		;[24] Must be identical size
	GOTO	[ZF	ZFIICP(XWAC1)
		ERRFILE
		IOERR	11,Image too large
		]

	STACK	[0]			;[24] Marker for null image
	COMPPOINTER
	IF	;Image is big enough to bother and starts on a word boundary
		CAIG	XCC,5	;??
		GOTO	FALSE
		JUMPN	XTAC,FALSE
	THEN	;Copy whole words
		L	XLB,XCC
	L3():!	SETZ	XTAC,		;Use XTAC to flag buffer overlap
		IF	;Current buffer does not have all of image
			CAMGE	XLB,CNT(XBH)
			GOTO	FALSE
		THEN	;Excess length to XLI for next iteration
			L	XLB,CNT(XBH)
			SUBI	XLI,(XLB)
			LI	XTAC,1	;Flag buffer overlap
		FI
		L	XLB
		IDIVI	5
		ST	XLB
		IMUL	[-5]
		ADDM	CNT(XBH)
		L	X1,BUP(XBH)
		L	(X1)
		IF	;Zero word
			JUMPN	FALSE
		THEN	;May be null record
			L	[ASCII/     /]
			LOOP
				ST	(XIP)
				ADDI	X1,1
				ADDI	XIP,1
			AS
				SKIPN	(X1)
				SOJG	XLB,TRUE
						edit(33)
				JUMPG	XLB,L4	;[33] Overlap
			SA
		FI
		IF	;Still more to copy
			JUMPLE	XLB,FALSE	;[33]
		THEN
			L	(X1)
			IORM	(XPDP)
			MOVSI	(X1)
			HRRI	(XIP)
			ADDI	X1,(XLB)
			ADDI	XIP,(XLB)
			BLT	-1(XIP)
		FI
	L4():!	L	BUP(XBH)
		ST	X1,BUP(XBH)
		SUB	X1
		IMULI	5
		ADD	XCC,X0		;Account for characters treated
		LF	X0,ZTVLNG(XWAC1,IMG)
		IF	;Buffer overlap for this image
			JUMPE	XTAC,FALSE
		THEN	;Read new block, then move the rest
			READNEXTBLOCK
			IFON	ZFIEND(XWAC1)
			GOTO	L1
			L	XLB,XLI
			JUMPG	XLB,L3
	FI	FI
	UNSTK	XSAC
	WHILE
		SOJL	XCC,FALSE
	DO
		GETCHD
		IDPB	XIP
	OD
	IF	;Null image read
		JUMPN	XSAC,FALSE
	THEN	;Make EOF record
		COMPPOINTER
		LF	XCC,ZTVLNG(,XWAC2)
		CAILE	XCC,2		;Avoid padding once more
		LI	XCC,2
		EXEC	IOIGE1
	FI
L6():!	;Locate(LOC+1)
	LF	XWAC2,ZDFLOC(XWAC1)
	ADDI	XWAC2,1
	EXEC	.IOLT
	GOTO	L9
IOIGIF:	;INFILE

	COMPPOINTER
	IFOFF	ZFIEND(XWAC1)
	GETCHR			;SKIP ANY RESIDUAL NULLS IN BUFFER
	L	X1,X0
				edit(24)
	IFON	ZFIEND(XWAC1)	;[24] No more in the file?
	GOTO	L7		;if not

	edit(22)	;[22] Find out if file is line numbered

	SETOFF	SWLB35(XLOW)
	L	@BUP(XBH)
	TRNE	1
	SETON	SWLB35(XLOW)	;Found a line number!

	IDPB	X1,XIP
	WHILE	;NOT END OF IMAGE
		SOJLE	XCC,L8
		JUMPL	XTAC,FALSE	;And not end of line
	DO
		GETCHR
		IDPB	X0,XIP
	OD

	ST	XIP,YDSIGS(XLOW)	;[22] Save XIP pointer, used by SIMDDT

	EXEC	IOIGSP			;Put spaces at the end of the image
L8():!

	;NOW THE IMAGE IS FILLED WITH CHARACTERS AND
	;POSSIBLY PADDED WITH BLANKS TO THE RIGHT

	JUMPL	XTAC,L9	;[24] If end of line
	GETCHR		;[24] Possible break character
	JUMPL	XTAC,L9	;[24] If end of line

L5():!	ZF	ZFIICP(XWAC1)	;SETPOS(1) TO FACILITATE CLOSE VIA SIMDDT [1C]
	ERRFILE
		edit(41) ;[41] Make it possible to continue after this error
	STACK	XWAC1
	LI	XWAC1,IMG(XWAC1)		;XWAC1 pointer to IMAGE text var
	IOERC	QDSNIM,25,Too long input line
	UNSTK	XWAC1
	GOTO	L9
		;[41] end



			edit(24)
L7():!	EXEC	IOIGEF	;[24] Create end of file record

L9():!	;Common exit;
	ZF	ZFIICP(XWAC1)	;SETPOS(1)
	CENABLE
	RETURN
	EPROC	;Inimage


;[24]

IOIGEF:	;Make EOF record in image
	SETON	ZIFEND(XWAC1)
IOIGE1:	COMPPOINTER
	LI	X0,"/"		;SET END OF FILE RECORD
	IDPB	X0,XIP
	SOJLE	XCC,IOIGEN
	LI	X0,"*"
	IDPB	X0,XIP
	SOJG	XCC,IOIGSP	;[33]
IOIGEN:	RETURN


IOIGSP:	;[24] Pad end of image with spaces
	IF	;Enough characters left to bother
		CAIGE	XCC,2*5
		GOTO	FALSE
	THEN	;Adjust to next word boundary, then move whole words
		LI	X0," "
		Q==300000	;One of these bits is on iff byte ptr
				;is internal to a word
		WHILE	;Byte pointer in the middle of a word
			TLNN	XIP,Q
			GOTO	FALSE
		DO	;Insert space
			IDPB	X0,XIP
			SUBI	XCC,1
		OD
		NORMALIZE(XIP)
		L	[ASCII/     /]
		ST	(XIP)
		L	X0,XCC
		IDIVI	X0,5
		ST	X1,XCC
		LI	X1,1(XIP)
		HRLI	X1,(XIP)
		ADD	XIP,X0
		BLT	X1,-1(XIP)
	FI
	IF	;Any characters left to be blanked
		JUMPE	XCC,FALSE
	THEN	LI	" "
		LOOP	IDPB	XIP
		AS	SOJG	XCC,TRUE
		SA
	FI
	RETURN
	SUBTTL	SIMULA PROCEDURE: .IOLI - LASTITEM

COMMENT ;

PURPOSE:	To find the next non-blank character on an input file.
		If none is found, the value -1 is returned in the input
		parameter register, otherwise the value is 0.
		As a side effect, a number of spaces, tabs, and line feeds
		are scanned past, and Image.Pos indicates the first non-blank
		character.
ENTRY:		.IOLI
INPUT ARGUMENT:	XTAC points to the ac referencing the file object.
OUTPUT ARGUMENTS:-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	EXEC .IOLI
USED ROUTINES:
		INIMAGE,INCHAR.
USED REGISTERS:	X0, XWAC1-5
ERROR MESSAGES:	-
;

.IOLI:	PROC
	LOWADR
	CDEFER
	STACK	XTAC		;SAVE VALUE OF XTOP
	SAVE	<XWAC1,XWAC2,XWAC3,XWAC4,XWAC5>
	L	XWAC1,(XTAC)	;XWAC1 POINTS TO THE FILE OBJECT
L1():!
	IF	;END OF FILE
		IFOFF	ZIFEND(XWAC1)
		GOTO	FALSE
	THEN	;LASTITEM:=TRUE
		SETO	X0,
		GOTO	L9
	FI
	LOOP	IF	;NOT MORE
			LD	XWAC2,IMG(XWAC1)
			LF	X0,ZTVLNG(,XWAC2)
			CAILE	X0,(XWAC3)	;IF POS > LENGTH
			GOTO	FALSE
		THEN	;DO INIMAGE
			EXEC	.IOIG
			GOTO	L1
		FI
		L	XWAC5,XWAC1
		LI	XTAC,XWAC5
		EXEC	.IOIC		;DO INCHAR
	AS	CAIE	XWAC5," "	;IF SPACE
		CAIN	XWAC5,11	;OR TAB
		GOTO	TRUE
	SA
	SOS	OFFSET(ZFIICP)(XWAC1)	;SETPOS(POS-1)
	SETZ	X0,		;LASTITEM:=FALSE
L9():!
	RESTORE
	UNSTK	XTAC
	ST	X0,(XTAC)	;SET LASTITEM
	CENABLE
	RET

	EPROC
	SUBTTL	SIMULA PROCEDURE: .IOLP - LINESPERPAGE

COMMENT ;

PURPOSE:	TO UPDATE LINESPERPAGE IN THE FILE OBJECT.
		IF THE NEW VALUE IS ZERO THE
		DEFAULT VALUE IN YIOLP IS USED,
		IF IT IS NEGATIVE OR > 2**18-1
		THEN 2**18-1 IS USED.
ENTRY:		.IOLP
INPUT ARGUMENTS:
		XWAC1 POINTS TO THE FILE OBJECT
		XWAC2 CONTAINS THE NEW VALUE OF LINESPERPAGE
OUTPUT ARGUMENTS:-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	EXEC .IOLP
USED ROUTINES:	-
ERROR MESSAGES:	-
;

.IOLP:
	IF	;Zero
		JUMPN	XWAC2,FALSE
	THEN	;Set default
		LOWADR
		L	XWAC2,YIOLP(XLOW)
	FI
	TLNE	XWAC2,-1
	LI	XWAC2,377777		;MAX VALUE
	SF	XWAC2,ZPFLP(XWAC1)
	RETURN
	SUBTTL	SIMULA PROCEDURE: .IOLT - LOCATE

COMMENT ;

PURPOSE:	TO UPDATE ZDFLOC IN THE FILE OBJECT.
		ZDFEND AND ZFIEND ARE TURNED OFF IF THE ARGUMENT
		IS IN RANGE.
ENTRY:		.IOLT
INPUT ARGUMENTS:
		XWAC1 POINTS TO THE FILE OBJECT
		XWAC2 CONTAINS THE NEW VALUE OF LOCATION
OUTPUT ARGUMENTS:-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	EXEC .IOLT
USED ROUTINES:	-
USED REGISTER:	X0
ERROR MESSAGES:	-
;

.IOLT:
		edit(236)
	IF	;[236] File is not open
		IFOPEN	XWAC1
		GOTO	FALSE
	THEN	ERRFILE
		IOERR	0,File not open
	FI
	IF	;LOCATION IN RANGE, I.E.
		;LOC > 0 AND LOC < ZDFLIM
		JUMPLE	XWAC2,TRUE
		LF	X0,ZDFLIM(XWAC1)
		CAMGE	X0,XWAC2
		GOTO	FALSE
	THEN	;RESET END OF FILE
		SETOFF	ZDFEND(XWAC1)
		SETOFF	ZFIEND(XWAC1)
	FI
	SF	XWAC2,ZDFLOC(XWAC1)	;ZDFLOC:=NEW LOCATION
				edit(63)
	SETOFF	ZFIPGT(XWAC1)	;[63] No put or get on this buffer image yet
	RETURN
	SUBTTL	SIMULA PROCEDURE: .IOOP - OPEN

COMMENT ;

PURPOSE:	TO SET THE OPEN FLAG AND THE TEXT IMAGE REFERENCE.
		IF THE FILE ALREADY IS OPEN A RUN TIME ERROR OCCURS.
		IF THE FILE HAS BEEN CLOSED PREVIOUSLY (ZFICHN=-1)
		THEN REOPEN IS PERFORMED. IF THE FILE IS OUTFILE OR
		PRINTFILE AN INITIAL OUT UUO IS PERFORMED.
ENTRY:		.IOOP
INPUT ARGUMENTS:
		XWAC1 CONTAINS THE POINTER TO THE FILE OBJECT
		XWAC2-XWAC3 CONTAIN IMAGE REFERENCE.
OUTPUT ARGUMENTS:-
NORMAL EXIT:	RETURN
ERROR EXIT:	IOERC		[41]
CALL FORMAT:	EXEC .IOOP
USED ROUTINES:	ERRFILE
		REOPEN
		.IOLT (LOCATE)
		.TXVA
		PUTOUT
USED REGISTERS:	X0, X1, XWAC1-2
ERROR MESSAGE:	FILE ALREADY OPEN
;

.IOOP:	PROC
	LOWADR			;SET BASE REGISTER TO STATIC AREA
	CDEFER
	IF	;FILE IS OPEN
					edit(236)
		IFNOTOPEN(XWAC1)	;[236]
		GOTO	FALSE
	THEN	;ERROR!
		ERRFILE
		edit(41) ;[41]:
		IOERC	QDSCON,4,File already open
		GOTO	L9		;Ignore open if user proceeds! [41]
	FI
	STD	XWAC2,IMG(XWAC1)
				;SAVE IMAGE REFERENCE
	IF	;FILE CLOSED BEFORE
		HLRZ	X1,OFFSET(ZFICHN)(XWAC1)
		CAIE	X1,-1
		GOTO	FALSE
	THEN	;FILE MUST BE OPENED AGAIN
		REOPEN
	FI
	SETOFF	ZIFEND(XWAC1)	;FLAG NOT END OF FILE
	SETON	ZFIFO(XWAC1)	;FLAG FIRST OUTPUT
	SETON	ZFIOPN(XWAC1)
	SETOFF	ZFIEND(XWAC1)
	IF	;DIRECTFILE
		IFOFF	ZFIDF(XWAC1)
		GOTO	FALSE
	THEN
		SETOFF	ZDFOUT(XWAC1)
		SETOFF	ZDFMOD(XWAC1)
		ZF	ZDFBLK(XWAC1)
		edit(24)
		;[24] Begin (code moved from .IOCF and modified)
		LF	X0,ZDFIML(XWAC1)
		IF	;IMAGESIZE NOT DEFINED
			JUMPN	X0,FALSE
		THEN	;Take length from image
			LF	X0,ZTVLNG(XWAC1,IMG)
			ADDI	X0,2
			SF	X0,ZDFIML(XWAC1)	;DEFAULT FOR IMAGE SIZE
		FI
		;X0 NOW CONTAINS ZFIIML
		;COMPUTE NO OF WORDS IN THE LOGICAL RECORD
		IDIVI	X0,5		;NUMBER OF WORDS
		CAIE	X1,0
		ADDI	X0,1		;ADJUST IF NON-ZERO REMAINDER
		IMULI	X0,5		;X0=REAL NO OF BYTES IN RECORD
					;INCLUDED POSSIBLY PADDED NULLS
		LF	X1,ZFIFIL(XWAC1)
		;COMPUTE MAX RECORD NO
		LF	X1,ZXBLNG(X1)	;FILE LENGTH IN WORDS
		IMULI	X1,5		;FILE LENGTH IN BYTES
		IDIV	X1,X0
		SF	X1,ZDFLIM(XWAC1)	;AND STORE IN LIMIT
		;[24] End of code taken from .IOCF
		LI	XWAC2,1
		EXEC	.IOLT		;LOCATE(1)
					edit(5)
		ZF	ZDFWCT(XWAC1)	;[5] INITIAL WORD COUNT=0
		GOTO	L1
	FI
	IF	;OUTFILE, PRINTFILE OR DIRECTFILE
		IFOFF	ZFIOF(XWAC1)
		GOTO	FALSE
	THEN
						edit(252)
L1():!		LD	XWAC2,IMG(XWAC1)	;[252]
		ZF	ZFIICP(XWAC1)	;POS:=1
		IF	;SIMDDT INACTIVE
			IFON	YDSACT(XLOW)
			GOTO	FALSE
		THEN	SETZB	XWAC4,XWAC5	;IMAGE:=NOTEXT
			LI	XTAC,XWAC2
			EXEC	.TXVA
		FI
		IF	;NOT TTY
			IFON	ZFITTY(XWAC1)
			GOTO	FALSE
		THEN
			IF	;[24LE] Outfile or Printfile
				IFOFF	ZFIOF(XWAC1)
				GOTO	FALSE
			THEN	;Initial output
				SETZ	XBH,
				PUTOUT
			FI	;[24LE]
		FI
	ELSE
		HLRS	OFFSET(ZFIICP)(XWAC1)	;POS:=LENGTH+1
	FI
	IF	;PRINTFILE
		IFOFF	ZFIPF(XWAC1)
		GOTO	FALSE
	THEN	;INITIALIZE PRINTFILE CHARACTERISTICS
		IF	edit(266) ;[266] Sysout on TTY
			IFON	ZFITTY(XWAC1)
			CAME	XWAC1,YSYSOUT(XLOW)
			GOTO	FALSE
		THEN	;Linesperpage(-1)
			LI	X0,-1
		ELSE	;Standard value
			L	X0,YIOLP(XLOW)
		FI
		SF	X0,ZPFLP(XWAC1)	;LINESPERPAGE := DEFAULT
		LI	X0,1
		SF	X0,ZPFSP(XWAC1)	;SPACING := 1
		SF	X0,ZPFLIN(XWAC1);NEXT LINE := 1
		ZF	ZPFLL(XWAC1)	;LAST LINE := 0
	FI
L9():!			;[41]
	CENABLE
	RETURN
	EPROC	;IOOP
	SUBTTL	SIMULA PROCEDURE: .IOOG AND .IOBO - OUTIMAGE AND BREAKOUTIMAGE


	edit(24)
COMMENT ;	[24] Code reorganized and changed

PURPOSE:	TO MOVE THE INTERNAL IMAGE TO THE OUTPUT BUFFER.
		ONE OR MORE OUT UUO:S MAY OCCUR AS A SIDE EFFECT.
		IF IT IS A DIRECTFILE THEN THE EXTERNAL BLOCK
		NUMBER IS COMPUTED (COMPBLOCK) AND IF THIS IS
		NOT THE SAME AS THE BLOCK CURRENTLY IN CORE
		THEN THE WANTED BLOCK IS READ TO CORE (READBLOCK).
		THE CHARACTERS ARE MOVED FROM THE INTERNAL IMAGE
		TO THE BUFFER.
		FOR AN OUTFILE OR PRINTFILE -
		TO SAVE SPACE AND TIME, ONLY IMAGE.STRIP IS MOVED, UNLESS
		BREAKOUTIMAGE WAS CALLED AND POS GT IMAGE.STRIP.LENGTH,
		IN WHICH CASE POS-1 IS SUBSTITUTED FOR THE LENGTH.
ENTRIES:	.IOBO (BREAKOUTIMAGE)
		.IOOG (OUTIMAGE)
INPUT ARGUMENTS:
		XWAC1 POINTS TO FILE OBJECT
OUTPUT ARGUMENTS:-
NORMAL EXIT:	RETURN
ERROR EXIT:	IOERR
CALL FORMATS:	EXEC .IOBO (BREAKOUTIMAGE)
		EXEC .IOOG (OUTIMAGE)
USED ROUTINES:
		COMPBLOCK,COMPPOINTER,COMPSTART,READBLOCK,PUTCHAR,
		IONB, .IOLT (LOCATE)
		.TXST TO PERFORM IMAGE.STRIP
USED REGISTERS:
		XWAC2-XWAC3	TEXT REFERENCE
		XCC		LENGTH OF IMAGE
		XBH		POINTS TO BUFFER AREA
		XIP		BYTE POINTER TO IMAGE
		XTAC		ARGUMENT TO .TXST
		XSAC		BREAKOUTIMAGE FLAG
		XL		POINTER TO IMAGE
		XK		CONTAINS BLANK CHARACTER
ERROR MESSAGES:	FILE NOT OPEN
		IMAGE TOO LARGE
;

.IOBO:			;BREAKOUTIMAGE ENTRY
	PROC
	TDZA	XSAC,XSAC	;FLAG BREAKOUTIMAGE AND SKIP

.IOOG:			;OUTIMAGE ENTRY
	LI	XSAC,QCR	;FLAG OUTIMAGE
	LOWADR
	CDEFER
	SAVE	<XWAC2,XWAC3,XCC,XBH,XIP,XK,XL>
	IF	;FILE IS CLOSED
				edit(236)
		IFOPEN(XWAC1)	;[236]
		GOTO	FALSE
	THEN	;ERROR!
		ERRFILE
		IOERR	0,File not open
	FI
	LD	XWAC2,IMG(XWAC1)
					edit(24)
	LF	XCC,ZTVLNG(,XWAC2)	;[24] Image.Length
	LF	XBH,ZFIOBH(XWAC1)
	SUBI	XBH,1		;XBH=POINTER TO BUFFER AREA


	IF	;DIRECTFILE
		IFOFF	ZFIDF(XWAC1)
		GOTO	FALSE
	THEN
		IF	;[24] File is read only
			IFOFF	ZFIRON(XWAC1)
			GOTO	FALSE
		THEN	ERRFILE
			IOERR	17,File is read only
		FI	;[24]
		LF	XLI,ZDFIML(XWAC1)
		SUBI	XLI,2(XCC)
		IF	;IMAGE LENGTH INCORRECT
			JUMPE	XLI,FALSE
		THEN	;ERROR!!
			ERRFILE
			IF	;[24] Image too big
				JUMPG	XLI,FALSE
			THEN
				IOERR	11,Image too large
			ELSE
				IOERR	10,External image too long
		FI	FI
			edit(41)
L1():!			;[41]
		LFE	X0,ZDFLOC(XWAC1)
		IF	;LOC NON-POSITIVE
			JUMPG	X0,FALSE
		THEN	;ERROR!
			ERRFILE
			;[41]:
			IOERC	QDSNIN,16,LOCATION not positive
			NEWVALUE X0	;[41]
			SF	X0,ZDFLOC(XWAC1)	;[41]
			GOTO	L1			;[41]
		FI

		SETON	ZDFOUT(XWAC1)	;FLAG OUTIMAGE CALL FOR READBLOCK
		COMPBLOCK
		STACK	X1
		LF	X1,ZDFBLK(XWAC1)
		CAIE	(X1)
		READBLOCK		;IF BLOCK NOT IN BUFFER
		COMPSTART
		LF	X0,ZDFIML(XWAC1);COMPUTE LAST WORD NO OF IMAGE
		ADDI	X0,4
		IDIVI	X0,5
		ADD	X0,(XPDP)

		edit(5)
		;[5] USE ZDFWCT INSTEAD OF ZBUWCT
		LF	X1,ZDFWCT(XWAC1)
		IF	;GREATER THAN CURRENT WORD COUNT
			CAIGE	X0,(X1)
			GOTO	FALSE
		THEN	;UPDATE WORD COUNT FOR BUFFER
			;[5] USE ZDFWCT INSTEAD OF ZBUWCT
			; AND REMOVE TEST ON BUFFER LIMIT
			; (NOW PERFORMED IN PUTOUT)
			SF	X0,ZDFWCT(XWAC1)
		FI
		UNSTK	X1
					edit(24)
		EXEC	IOOG.M		;[24] Copy to buffer
		;Append CR-LF and nulls if required, mark this block as modified
		LI	X0,QCR
		PUTCHAR		;APPEND CR
		LI	X0,QLF
		PUTCHAR		;APPEND LF
		EXEC	IOOGWB	;[24] Insert nulls to next word boundary
		SETON	ZDFMOD(XWAC1)
		LF	XWAC2,ZDFLOC(XWAC1)
		LF	X1,ZDFLIM(XWAC1)
		CAMLE	XWAC2,X1		;IF LOC > LIMIT
		SF	XWAC2,ZDFLIM(XWAC1)	;THEN LIMIT:=LOC
		ADDI	XWAC2,1
		EXEC	.IOLT		;LOCATE(LOC+1)
	ELSE	;Outfile (Printfile)
		STACK	XSAC		;SAVE FLAG
		LI	XTAC,XWAC2
		EXEC	.TXST		;PERFORM IMAGE.STRIP
		LF	XCC,ZTVLNG(,XWAC2)	;XCC=IMAGE.STRIP.LENGTH
		IF	;BREAKOUTIMAGE
			SKIPE	(XPDP)
			GOTO	FALSE
		THEN	;Use the larger of Image.Pos-1,
			; Image.Strip.Length (XCC)
			LF	X0,ZFIICP(XWAC1)
			CAMLE	X0,XCC
			L	XCC,X0	;IF POS-1 LARGER
			IF	;STRIP GAVE NOTEXT
				JUMPN	XWAC2,FALSE
			THEN	;RESTORE OFFSET AND OBJECT ADDRESS FROM IMAGE
				WLF	XWAC2,ZFIIMG(XWAC1)
		FI	FI
		IF	;NOT PRINTFILE
			IFON	ZFIPF(XWAC1)
			GOTO	FALSE
		THEN	LI	XK,1
			IF	;FIRST OUTPUT
				IFOFF	ZFIFO(XWAC1)
				GOTO	FALSE
			THEN	;NO LINE FEED!
				SETOFF	ZFIFO(XWAC1)
				LI	XK,0
			FI
		ELSE	;POSITION THIS LINE ON THE PAGE
			;REGISTER NAMES:
			XNL=XK		;NEXT LINE NO
			XLL=XL		;LAST LINE NO
			XLPP=XTAC	;LINESPERPAGE
					edit(16)
			XLF=XWAC2	;LINE FEED OR NULL (IF TTY)	;[16]

			COMMENT ;
			THE FOLLOWING CASES MAY OCCUR:
			1.	THIS IS THE FIRST IMAGE (XLL=0).
				OUTPUT FORM FEED AND (XNL) -1  LINE FEED.
			2.	XNL=XLL
				A)	SPACING(0).
					APPEND NO LINE FEED.
				B)	EJECT(LINE-1).
					APPEND LINE FEED, FORM FEED.
					AND (XNL) -1  LINE FEEDS.
			3.	XLL < XNL < XLPP, I.E. NEXT LINE SHOULD
				BE PRINTED ON SAME PAGE.
				APPEND (XNL-XLL) LINE FEEDS.
			4.	XLL > XNL, I.E. NEXT IMAGE SHOULD BE
				PRINTED ON LINE XNL OF NEXT PAGE.
				OUTPUT LINE FEED, FORM FEED.
				AND (XNL) -1  LINE FEEDS.
				(SAME AS 2B).
			5.	XNL > XLPP
				A)	EJECT HAS BEEN DONE.
					SAME AS 2B.
				B)	EJECT HAS NOT BEEN DONE, I.E. NEXT
					LINE SHOULD BE PRINTED ON TOP OF NEXT PAGE.
					OUTPUT LINE FEED, FORM FEED.
					AND SET LINE TO 1.
			;
			
			DEFINE PUTFF=<
				L	X0,XLF		;[16]
				PUTCHAR			;[16]
				LI	X0,QFF
				PUTCHAR
			>
			
			LI	XLF,QLF		;[16] SET XLF TO QLF
			IFON	ZFITTY(XWAC1)
			SETZ	XLF,		; Change to null for tty

			SETOFF	ZFIFO(XWAC1)
			LF	XLPP,ZPFLP(XWAC1)
			LF	XLL,ZPFLL(XWAC1)
			LF	XNL,ZPFLIN(XWAC1)
			IF	;THIS IS THE FIRST IMAGE (CASE 1)
				JUMPN	XLL,FALSE
			THEN	;APPEND FF ONLY
				IF	;NOT TTY
					JUMPE	XLF,FALSE
				THEN	LI	X0,QFF		;[16]
					PUTCHAR			;[16]
					SUBI	XK,1		;[16]
				FI
			ELSE
			IF	;SAME LINE (CASE 2)
				CAME	XLL,XNL
				GOTO	FALSE
			THEN	IF	;SPACING(0) (CASE 2A)
					IFON	ZFIECT(XWAC1)
					GOTO	FALSE
				THEN	;NO LINE FEEDS AT ALL
					LI	XK,0
				ELSE	;MUST BE EJECT TO SAME LINE (CASE 2B)
					PUTFF
					SKIPE	XLF	;[16]
					SUBI	XK,1		;[16]
				FI
			ELSE
			IF	;NEXT LINE < LAST LINE (CASE 4)
				CAML	XNL,XLL
				GOTO	FALSE
			THEN	;OUTPUT FF
				PUTFF
				SKIPE	XLF	;[16]
				SUBI	XK,1		;[16]
			ELSE
			IF	;NEXT LINE > LINESPERPAGE (CASE 5)
				CAMG	XNL,XLPP
				GOTO	FALSE
			THEN	PUTFF
				IF	;EJECT HAS NOT BEEN DONE
					IFON	ZFIECT(XWAC1)
					GOTO	FALSE
				THEN	;CASE 5B
					LI	XK,0
					LI	X0,1
					SF	X0,ZPFLIN(XWAC1)	;LINE:=1
				FI
			ELSE	;MUST BE CASE 3!
				SUB	XK,XLL	;NO OF LINE FEEDS=NEXT LINE - LAST LINE
				;[1C] TAKE CARE OF EJECT(LINE) CASE
				IF	;NEXT LINE AFTER EJECT
					;I.E. EJECT(LINE) WAS DONE
					IFON	ZFIECT(XWAC1)
					CAIE	XK,1
					GOTO	FALSE
				THEN	;NEXT LINE ON NEW PAGE!
					PUTFF
					LF	XK,ZPFLIN(XWAC1)
					SKIPE	XLF	;[16]
					SUBI	XK,1		;[16]
				FI
				;END OF [1C]
		FI	FI	FI	FI	FI
		;XK NOW CONTAINS NO OF LINE FEEDS TO BE APPENDED
		;ADJUST XK FOR THE CASE OF TTY
							edit(44)
							edit(112)
		;or if LAST CALL WAS BREAKOUTIMAGE	[44] [112]
		IF	;[44] [112] Last call was outimage
			IFON	ZFILBO(XWAC1)
			GOTO	TRUE
			IFOFF	ZFITTY(XWAC1)	;or TTY output
			GOTO	FALSE
		THEN	;Take away one LF
			SUBI	XK,1
		FI	;[44] [112]
		WHILE	;MORE LINES
			SOJL	XK,FALSE
		DO	;APPEND LINE FEED
			LI	X0,QLF
			PUTCHAR
		OD
					edit(24)
		IFON	ZFIWDB(XWAC1)	;[24] Word alignment if specified
		EXEC	IOOGWB		;[24]
		EXEC	IOOG.M		;[24] Copy to buffer


		UNSTK	XK
		IF	;OUTIMAGE
			JUMPE	XK,FALSE
		THEN	;APPEND CR
						edit(44)
			SETOFF	ZFILBO(XWAC1)	;[44] flag last call as OUTIMAGE
			LI	X0,QCR
			PUTCHAR		;CR
						edit(63)
			SETOFF	ZFIPGT(XWAC1)	;[63] Tell put Outimage called
		ELSE
			SETON	ZFILBO(XWAC1)	;[44] flag last call as BREAKOUTIMAGE
		FI
		IF	;TTY
			IFOFF	ZFITTY(XWAC1)
			GOTO	FALSE
		THEN	;OUTPUT BUFFER IMMEDIATELY
			IF	;NOT BREAKOUTIMAGE OR SPACING(0)
				JUMPE	XK,FALSE
							edit(16)
				LF	X0,ZPFSP(XWAC1)	;[16]
				JUMPE	X0,FALSE	;[16] SPACING(0)
			THEN	LI	X0,QLF
				PUTCHAR			;BUT FIRST APPEND LINE FEED
			FI
			PUTOUT
		FI
		IF	;PRINTFILE
			IFOFF	ZFIPF(XWAC1)
			GOTO	FALSE
		THEN	SETOFF	ZFIECT(XWAC1)	;FLAG NO EJECT
			LF	X0,ZPFLIN(XWAC1)
			SF	X0,ZPFLL(XWAC1)	;UPDATE LAST PRINTED LINE
			LF	XK,ZPFSP(XWAC1)
			ADD	X0,XK		;ADD SPACING AMOUNT
			SF	X0,ZPFLIN(XWAC1);UPDATE NEXT LINE
	FI	FI
	ZF	ZFIICP(XWAC1)	;Setpos(1)
	CENABLE
	RETURN
	EPROC
	;END OF OUTIMAGE
	SUBTTL	IOOG.M	[24] Move image to output buffer

	edit(24)

IOOG.M:	PROC	;[24] MOVE THE IMAGE TO THE BUFFER
	L	XWAC2,IMG(XWAC1)	;Load image reference
	COMPPOINTER	;Compute XIP, XTAC=0 if word-aligned image
	IF	;Word-aligned image
		JUMPN	XTAC,FALSE
		HLLZ	BUP(XBH)	;AND image in buffer on word boundary
		TLNN	300000
		CAIG	XCC,5		;?? AND image big enough to bother
		GOTO	FALSE
	THEN	;Use BLT for most of the image
		L	XLI,XCC
		L	XLB,XLI
		IF	;Line numbers specified
			IFOFF	ZFINUM(XWAC1)
			GOTO	FALSE
		THEN	;Turn on last bit of first word of image
			LI	1
			IORM	(XIP)
		FI
L1():!		SKIPG	CNT(XBH)
		EXEC	.IONB
		SETZ	XTAC,		;Use XTAC as truncation flag
		IF	;Buffer cannot hold all of image
			CAMGE	XLB,CNT(XBH)
			GOTO	FALSE
		THEN	;Move the part that fits, compute length of rest
			L	XLB,CNT(XBH)
			SUBI	XLI,(XLB)
			LI	XTAC,1
		FI
		L	XLB
		IDIVI	5	;Convert to no of words
		ST	XLB
		IMUL	[-5]	;Negated no of characters corresp to full words
		ADDM	CNT(XBH)
		ADD	XCC,X0

		;Make BLT word in X0
		L	X1,BUP(XBH)
		NORMALIZE(X1)
		LI	(X1)
		HRLI	(XIP)
		ADDI	X1,(XLB)
		ST	X1,BUP(XBH)
		BLT	-1(X1)	;Move the info

		;Blank the copied part of image
		L	[ASCII/     /]
		ST	(XIP)
		LI	1(XIP)
		HRLI	(XIP)
		ADDI	XIP,(XLB)
		CAILE	XLB,1
		BLT	-1(XIP)

		IF	;Image did not fit into this buffer
			JUMPE	XTAC,FALSE
		THEN	;handle the rest in next buffer
			SKIPG	CNT(XBH)	;[24LE] For return from .IONB
			EXEC	.IONB
			L	XLB,XLI
			CAIL	XLB,5	;[24R]
			GOTO	L1	;[24R]
	FI	FI

	;Handle tail of image character by character

	LI	XK," "
	IF	;IMAGE NOT EMPTY
		JUMPLE	XCC,FALSE
	THEN	LOOP	;MOVE CHARACTERS FROM IMAGE TO BUFFER
			ILDB	X0,XIP	;GET NEXT BYTE
			DPB	XK,XIP	;AND BLANK IT IN IMAGE
			SOSGE	CNT(XBH)
			EXEC	.IONB		;WRITE CURRENT BLOCK IF FULL
			IDPB	X0,BUP(XBH)
		AS	SOJG	XCC,TRUE
		SA
	FI
	RETURN
	EPROC


IOOGWB:	;[24] Append nulls till next word boundary
	SETZ
	EXCH	X1,BUP(XBH)
	WHILE	;Not on word boundary
		TLNN	X1,300000	;These bits off iff full word byte ptr
		GOTO	FALSE
	DO
		IDPB	X1
		SOS	CNT(XBH)
	OD
	NORMALIZE(X1)
	EXCH	X1,BUP(XBH)
	RETURN
	SUBTTL	SIMULA PROCEDURE: .IOSP - SPACING

COMMENT ;

PURPOSE:	TO UPDATE SPACING (ZPFSP) IN THE FILE OBJECT.
		A RUN-TIME ERROR OCCURS IF THE NEW VALUE OF
		SPACING IS NEGATIVE OR GREATER THAN LINESPERPAGE.
ENTRY:		.IOSP
INPUT ARGUMENTS:
		XWAC1 POINTS TO THE FILE OBJECT
		XWAC2 CONTAINS THE NEW VALUE OF SPACING.
OUTPUT ARGUMENTS:-
NORMAL EXIT:	RETURN
ERROR EXIT:	IOERR
CALL FORMAT:	EXEC .IOSP
USED ROUTINE:	ERRFILE
USED REGISTER:	X0
ERROR MESSAGE:	SPACING ARGUMENT OUT OF RANGE
;

.IOSP:
	IF	;SPACING ARGUMENT OUT OF RANGE
		JUMPL	XWAC2,TRUE
		LF	X0,ZPFLP(XWAC1)	;LINESPERPAGE
		CAML	X0,XWAC2
		GOTO	FALSE
	THEN	;ERROR!
		ERRFILE
		edit(41) ;[41]:
		IOERC	QDSNIN,13,SPACING: argument out of range
		NEWVALUE XWAC2		;[41]
		GOTO	.IOSP		;Try again [41]
	FI
	SF	XWAC2,ZPFSP(XWAC1)	;UPDATE SPACING
	RETURN
	SUBTTL	IOFI ENTRIES
		edit(61)
.IOASL==1	;[61] ASCII line mode is standard

;DECLARATION ENTRY FOR FILE:

IOFI%D::
				edit(105)
	LF	,ZFIDMO(XCB)	;[105] Keep data mode if set already
	IF	;[105] Zero
		JUMPN	FALSE
	THEN	;ASCII line mode
		LI	.IOASL		;[61]
		SF	,ZFIDMO(XCB)
	FI	;[105]
	LI	XSAC,0		;LEVEL 0
	JSP	CPCD

;STATEMENT ENTRY FOR FILE:

IOFI%S::
	LI	XSAC,0
	JSP	CPCI

;INNER ENTRY FOR FILE:

IOFI%I::
	JSP	CPE0

;MAP FOR FILE

IOFI%M=:0

;SYMBOL TABLE FOR FILE

	DZSMCL	.FILE.,IOFI

	edit(22)
	;[22] ADD A NULL SECOND PARAMETER TO  ALL DZSD

	DZSD	NAME,,QTEXT,QVALUE,,OFFSET(ZFISPC)	;[1C]
	DZSD	IMAGE,,QTEXT,QVALUE,,IMG
	DZSD	OPEN,,QNOTYPE,,QPROCEDURE,0
	DZSD	CLOSE,,QNOTYPE,,QPROCEDURE,0
	DZSD	MORE,,QBOOLEAN,,QPROCEDURE,0
	DZSD	SETPOS,,QNOTYPE,,QPROCEDURE,0
	DZSD	POS,,QINTEGER,,QPROCEDURE,0
	DZSD	LENGTH,,QINTEGER,,QPROCEDURE,0
	Z
	SUBTTL	IOIN ENTRIES


;DECLARATION ENTRY FOR INFILE:

IOIN%D::
	edit(61)
	IFN	<OFFSET(ZFIIN)-OFFSET(ZFIIF)>,<CFAIL Wrong offsets IOIN%D> ;[61]
	L	[1B<%ZFIIN>+1B<%ZFIIF>]
	IORM	OFFSET(ZFIIN)(XCB)
	LI	XSAC,1		;LEVEL 1
	JSP	CPCD

;STATEMENT ENTRY FOR INFILE:

IOIN%S::
IOCA:
	ZEROSW
	SETUPFILE
	LI	XSAC,1
	JSP	CPCI

;INNER ENTRY FOR INFILE:

IOIN%I=:IOFI%I

;MAP FOR INFILE

IOIN%M=:0

;SYMBOL TABLE FOR INFILE

	DZSMCL	INFILE,IOIN
	DZSD	ENDFILE,,QBOOLEAN,,,OFFSET(ZIFEND)
	DZSD	LASTITEM,,QBOOLEAN,,QPROCEDURE,0
	DZSD	INCHAR,,QCHARACTER,,QPROCEDURE,0
	DZSD	ININT,,QINTEGER,,QPROCEDURE,0
	DZSD	INIMAGE,,QNOTYPE,,QPROCEDURE,0
	DZSD	INREAL,,QLREAL,,QPROCEDURE,0
	DZSD	INTEXT,,QTEXT,,QPROCEDURE,0
	DZSD	INFRAC,,QINTEGER,,QPROCEDURE,0
	Z
	SUBTTL	IOOU ENTRIES


;DECLARATION ENTRY FOR OUTFILE:

IOOU%D::
	edit(61)
	IFN	<OFFSET(ZFIOUT)-OFFSET(ZFIOF)>,<CFAIL Wrong offsets IOOU%D> ;[61]
	L	[1B<%ZFIOUT>+1B<%ZFIOF>]
	IORM	OFFSET(ZFIOUT)(XCB)
	LI	XSAC,1
	JSP	CPCD

;STATEMENT ENTRY FOR OUTFILE:

IOOU%S=:IOIN%S	;[61]


;INNER ENTRY FOR OUTFILE:

IOOU%I=:IOFI%I

;MAP FOR OUTFILE

IOOU%M=:0

;SYMBOL TABLE FOR OUTFILE

	DZSMCL	OUTFILE,IOOU
	DZSD	OUTCHAR,,QNOTYPE,,QPROCEDURE,0
	DZSD	OUTINT,,QNOTYPE,,QPROCEDURE,0
	DZSD	OUTIMAGE,,QNOTYPE,,QPROCEDURE,0
	DZSD	BREAKOUTIMAG,,QNOTYPE,,QPROCEDURE,0
	DZSD	OUTREAL,,QNOTYPE,,QPROCEDURE,0
	DZSD	OUTTEXT,,QNOTYPE,,QPROCEDURE,0
	DZSD	OUTFIX,,QNOTYPE,,QPROCEDURE,0
	DZSD	OUTFRAC,,QNOTYPE,,QPROCEDURE,0
	Z
	SUBTTL	IOPF ENTRIES


;DECLARATION ENTRY FOR PRINTFILE:

IOPF%D::
	SETON	ZFIPF(XCB)
	LI	XSAC,2
	JSP	CPCD


;STATEMENT ENTRY FOR PRINTFILE:

IOPF%S::
	LI	XSAC,2
	JSP	CPCI


;INNER ENTRY FOR PRINTFILE:

IOPF%I=:IOFI%I

;MAP FOR PRINTFILE

IOPF%M=:0

;SYMBOL TABLE FOR PRINTFILE

	DZSMCL	PRINTFILE,IOPF
	DZSD	LINE,,QINTEGER,,QPROCEDURE,0
	DZSD	LINESPERPAGE,,QNOTYPE,,QPROCEDURE,0
	DZSD	SPACING,,QNOTYPE,,QPROCEDURE,0
	DZSD	EJECT,,QNOTYPE,,QPROCEDURE,0
	Z
	SUBTTL	IODF ENTRIES



;DECLARATION ENTRY FOR DIRECTFILE:

IODF%D::
	edit(61)
	L	[1B<%ZFIDF>+1B<%ZFIIN>+1B<%ZFIOUT>+1B<%ZFIWDB>]	;[61]
	IORM	OFFSET(ZFIDF)(XCB)
	SETON	ZFIUWC(XCB)	;[61] Use word count
	LI	XSAC,1
	JSP	CPCD


;STATEMENT ENTRY FOR DIRECTFILE:

IODF%S=:IOIN%S	;[61]



;INNER ENTRY FOR DIRECTFILE:

IODF%I=:IOFI%I



;MAP FOR DIRECTFILE

IODF%M=:0

;SYMBOL TABLE FOR DIRECTFILE

	DZSMCL	DIRECTFILE,IODF
	DZSD	LOCATE,,QNOTYPE,,QPROCEDURE,0
	DZSD	LOCATION,,QINTEGER,,QPROCEDURE,0
	DZSD	ENDFILE,,QBOOLEAN,,,OFFSET(ZDFEND)
	DZSD	LASTITEM,,QBOOLEAN,,QPROCEDURE,0
	DZSD	INCHAR,,QCHARACTER,,QPROCEDURE,0
	DZSD	ININT,,QINTEGER,,QPROCEDURE,0
	DZSD	INIMAGE,,QNOTYPE,,QPROCEDURE,0
	DZSD	INREAL,,QLREAL,,QPROCEDURE,0
	DZSD	INTEXT,,QTEXT,,QPROCEDURE,0
	DZSD	INFRAC,,QINTEGER,,QPROCEDURE,0
	DZSD	OUTCHAR,,QNOTYPE,,QPROCEDURE,0
	DZSD	OUTINT,,QNOTYPE,,QPROCEDURE,0
	DZSD	OUTIMAGE,,QNOTYPE,,QPROCEDURE,0
	DZSD	OUTREAL,,QNOTYPE,,QPROCEDURE,0
	DZSD	OUTTEXT,,QNOTYPE,,QPROCEDURE,0
	DZSD	OUTFRAC,,QNOTYPE,,QPROCEDURE,0
	Z
	SUBTTL	LITERALS
	LIT
	END