C	PROGRAM MIO.FT
C	-------------
C
C
	FUNCTION MIO(IDEVICE,FN,EXT,IOPR)
C
C
C	P. LEMKIN
C	NCI, NIH
C	BETHESDA, MD 20014
C
C
C	REV AUG 12, 1976 - FIXED CLOSE
C	REV AUG 10, 1976- FIXED 15,16 RETURNS
C	REVISED AUGUST 4, 1976 - ADDED 14,15 RENAMED MIO.FT
C	REVISED MARCH 24, 1975
C	REVISED APRIL 1, 1975
C	REVISED APRIL 10, 1975
C	REVISED APRIL 23, 1975
C	REVISED MAY 7, 1975
C	REVISED JUNE 26, 1975 (IO2.FT)
C	REVISED JULY 2, 1975
C	REVISED AUGUST 14, 1975 IO3.FT
C	REVISED SEPTEMBER 22, 1975
C	REVISED SEPTEMBER 24, 1975
C	REVISED SEPT 25, 1975
C	REVISED SEPT 26, 1975
C	REVISED OCT 21, 1975
C	REVISED OCT 29, 1975
C	REVISED OCT 30, 1975
C	REVISED NOV 10, 1975
C	REVISED NOV 20, 1975
C
C
C	INTRODUCTION
C	------------
C		MIO.FT DOES 8-BIT CHARACTER AND BLOCK  I/O  USING
C	USING  SUBROUTINES ISETDEV (TO FETCH, AND LOOKUP A
C	FILE ON THE SPECIFIED DEVICE,  GETC  (TO  GET  THE
C	NEXT  CHARACTER  OF  THE  FILE).  OSETDEV SETS THE
C	OUTPUT DEVICE AND ENTERS THE FILENAME, WHILE  PUTC
C	WILL PUT THE OUTPUT CHARACTER IN THE OUTPUT BUFFER
C	AND DUMP THE BUFFER WHEN NEEDED. NOTE: CHARACTER
C	I/O IS NOT CHECKED FOR CONTROL/Z EOF.
C
C		MIO.FT  "MUST" BE LOADED INTO FIELD 0 BECAUSE
C	DEVICE HANDLERS ONLY WORK IN FIELD 0.  ERRORS  ARE
C	NOTED  BY RETURNING THE VALUE -1.  ANY OTHER VALUE
C	IS NOT AN ERROR. ONCE  THE  CHANNELS  ARE  OPENED,
C	CHARACTER  I/O  MAY  BE  DONE  QUICKLY THROUGH THE
C	ALTERNATE ENTRY POINTS "INNC"  AND  "OUTC".  NOTE:
C	MIO.RL MUST BE LOADED INTO FIELD 0!!!
C
C		MIO.FT SUPPORTS 1 INPUT AND 1 OUTPUT CHANNEL 
C	BOTH OF WHICH MAY BE DIFFERENT DEVICES.
C
C		THE OTHER INPUT AND OUTPUT CHANNELS MAY BE ANY 
C	(DIFFERENT 1 PAGE ) DEVICES.
C
C	IOPR 	FUNCTION
C	---- 	--------
C	1 		OPEN THE INPUT DEVICE AND "LOOKUP" THE FILE.
C		 	IO RETURNS -1 ON A LOOKUP ERROR.
C
C	2 		"GET" THE NEXT CHARACTER AND RETURN WITH IT 
C			IN "IO". THERE IS AN ALTERNATE ENTRY POINT 
C			"INNC" FOR FAST GETC RESPONSE WHICH  RETURNS
C			WITH THE CHARACTER IN THE AC.
C
C	3 		OPEN THE OUTPUT DEVICE AND "ENTER" THE FILE.
C		 	IO RETURNS -1 ON AN ENTER ERROR.
C
C	4 		"PUT" THE NEXT CHARACTER (IN "IDEVICE") INTO THE 
C			FILE. [THERE IS AN ALTERNATE ENTRY POINT "OUTC" 
C			FOR FAST PUTC REPONSE CALLED WITH THE 
C			CHARACTER IN THE ACCUMULATOR. ON RETURN,
C			THE ACC.] =-1 IF ERROR, ELSE 0. IO RETURNS -1
C			IF THERE IS A WRITE ERROR (NOT ENOUGH SPACE
C			FOR FILE).
C
C	5 		"CLOSE" OUTPUT FILE. IO RETURNS -1 ON A CLOSE
C		 	ERROR. IF IDEVICE=-1 THEN DO NOT OUTPUT
C			THE REST OF THE CHARACTER BUFFER
C			BEFORE DOING THE CLOSE.

C
C	6		"READ" "IDEVICE" NUMBER OF BLOCKS INTO
C			ADDRESS "FN". IF I/O ERROR, THEN
C			MIO=-1 ELSE MIO=0. NOTE THAT THE
C			INPUT CHANNEL IS OPENED WITH IOPR=1
C			AND THAT THE SAME BLOCK COUNTER IS USED.
C
C	7		"WRITE" "IDEVICE" NUMBER OF BLOCKS FROM
C			ADDRESS "FN". IF I/O ERROR, THEN
C			MIO=-1 ELSE MIO=0. NOTE THAT THE
C			OUTPUT CHANNEL IS OPENED WITH IOPR=3
C			AND CLOSED WITH IOPR=5,
C			AND THAT THE SAME BLOCK COUNTER IS USED.
C
C	8		LOOKUP "SYS:SVDDTG.DA", READ COMMON
C			BACK INTO CORE, "READ" 32 PAGES FROM
C			THE FILE INTO FIELD 7. NOTE THAT COMMON
C			SIZE IS DEFINED BY THE MIO.FT VARIABLE
C			"ICMNSIZE".
C
C	9		ENTER "SYS:SVDDTG.DA", WRITE COMMON,
C			"WRITE" 32 PAGES INTO THE FILE FROM
C			FIELD 7, CLOSE THE FILE. NOTE THAT COMMON
C			SIZE IS DEFINED BY THE MIO.FT VARIABLE "ICMNSIZE".
C
C       10              SET READ-NEXT-BLOCK POINTER TO IDEVICE VALUE.
C                       NOTE THAT THE BLOCK ADDRESS IS ABSOLUTE BLOCK #.
C                       ALSO RESET CHARACTER COUNTERS SO THAT CHARACTER
C                       INPUT MAY BE DONE FROM THE START OF THE BLOCK.
C
C       11              SET WRITE-NEXT-BLOCK POINTER TO IDEVICE VALUE.
C                       NOTE THAT THE BLOCK ADDRESS IS ABSOLUTE BLOCK #.
C                       ALSO RESET CHARACTER COUNTERS SO THAT CHARACTER
C                       OUTPUT MAY BE DONE INTO THE START OF THE BLOCK.
C			NOTE THAT THE OUTPUT DEVICE AND FILE ARE
C			SPECIFIED BY DOING A LOOKUP AND USING
C			THE ABSOLUTE BLOCK NUMBER (IOPR=12 CALL)
C			WITH THE USER COMPUTE THE ABSOLUTE BLOCK ADDRESS
C			TAKING THE OFFSET INTO ACCOUNT.
C			NO ENTER OR CLOSE IS USED WITH RANDOM WRITES
C			AS THE FILE MUST EXIST PREVIOUSLY (I.E. VIA LOOKUP).

C      12              RETURN IN (IO,IDEVICE,FN,EXT) THE INTEGER ARRAY
C                       (INPUT DEV#, NEXT ABSOLUTE INPUT BLOCK #, OUTPUT
C                       DEV#, NEXT ABSOLUTE OUTPUT BLOCK #).
C
C      13              RETURN IN (IDEVICE,FN,EXT) INTEGER ARRAY
C			(INPUT DEV#, NEXT ABS INPUT BLOCK #,
C			-FILE SIZE IN BLOCKS)
C
C
C      14              RETURN IN (IDEVICE,FN,EXT) INTEGER ARRAY
C			(OUTPUT DEV#, NEXT ABS OUTPUT BLOCK #,
C			- MAXIMUM FILE SIZE IN BLOCKS)
C
C
C
C	15		FETCH THE READ DEVICE HANDLER IN "IDEVICE"
C
C	16		FETCH THE WRITE DEVICE HANDLER IN "IDEVICE"

C
C	ARGUMENTS (SEE INDIVIDUAL FUNCTIONS ABOVE FOR DETAILS)
C	---------
C	IDEVICE - OS8 DEVICE NUMBER OR ASCII DEVICE NAME (ONLY 1 AND 3)
C	FN	- FILE NAME
C	EXT	- FILE EXTENSION
C	IOPR	- MIO.FT OPERATIONS (SEE ABOVE TABLE).
C
C
C
C	INTERNAL SUBROUTINES
C	--------------------
C	THERE ARE TWO TYPES OF INTERNAL SUBROUTINES. THOSE
C	WHICH ARE TRULY INTERNAL AND ARE  CALLED WITH A "JMS",
C	AND THOSE WHICH ARE FORTRAN CALLABLE AND ARE
C	MARKED WITH THE SYMBOL *EX*.
C	1. ISETDEV - FETCHES THE INPUT DEVICE HANDLER
C	2. OSETDEV - FETCHES THE OUTPUT DEVICE HANDLER
C	3. R - READ 1 BLOCK INTO IBUF BUFFER
C	4. W - WRITE 1 BLOCK FROM JBUF BUFFER
C	5. GETC - GET NEXT CHARACTER FROM IBUF
C	6. PUTC -  PUT NEXT CHARACTER INTO JBUF
C	7. INNC - *EX* EXTERNAL CALL TO GETC
C	8. OUTC - *EX* EXTERNAL CALL TO PUTC, ERROR IN AC.
C
C
C	ERROR MESSAGES
C	--------------
C	*****ERROR #1 BAD IOPR***
C	*****ERROR #2 - INQUIRE ERROR***
C	*****ERROR #3 - CLOSE FILE ERROR*****
C	*****ERROR #4 - WRITE BLOCK OUPUT ERROR****
C	*****ERROR #5 - FETCH INPUT HANDLER ERROR****
C	*****ERROR #6 - LOOKUP FAILED *****
C	*****ERROR #7 - FETCH OUTPUT DEVICE ERROR*****
C	*****ERROR #8 - ENTER FILE FAILED*****
C	*****ERROR #9 - READ ERROR ****
C	*****ERROR #10 - WRITE I/O ERROR****
C	*****ERROR #11 - WRITE FILE TOO LONG, FORGET IT****
C
C
C
C	EXTERNAL ENTRY POINTS
C	---------------------
C	INNC - CALL TO GET NEXT INPUT FILE CHAR. IN THE ACC
C	OUTC - CALL WITH CHAR. IN ACC TO PUT IN OUTPUT FILE
C
C
C
C
C
C	**********************************************
C	*L O C A L  D I M E N S I O N E D   VARIABLES*
C	**********************************************
  	DIMENSION IDEV(256),IBUF(256),JDEV(256),JBUF(256)
C		IDEV - SPACE FOR INPUT DEVICE HANDLER
C		IBUF - SPACE FOR INPUT DATA BUFFER
C		JDEV - SPACE FOR OUTPUT DEVICE HANDLER
C		JBUF - SPACE FOR OUTPUT DEVICE HANDLER
C
	DIMENSION FILENAME(2),ENAME(2)
C		FILENAME - LOCAL COPY OF LOOKUP (FILE,EXT)
C		ENAME - LOCAL COPY OF ENTER (FILE,EXT).
C		IOD - INPUT DEVICE INTERNAL NUMBER
C		JOD - OUTPUT DEVICE INTERNAL NUMBER
C		IBLOCK - RELATIVE INPUT BLOCK NUMBER
C		JBLOCK - RELATIVE OUTPUT BLOCK NUMBER
C		BARG2 - ABSOLUTE STARTING INPUT BLOCK NUMBER
C		EARG2 - ABSOLUTE STARTING OUTPUT BLOCK NUMBER
C		ARG3 - INPUT DEVICE STARTING ADDRESS
C		CARG - OUTPUT DEVICE STARTING ADDRESS
C		ICOUNT - INPUT BUFFER CHARACTER COUNTER
C		JCOUNT - OUTPUT BUFFER CHARACTER COUNTER
C		IOPR - DISPATCH OPERATOR
C		IOERR - ERROR CODE USED IN INTERAL ERROR PRINTOUT
	EQUIVALENCE (FILENAME(2),F2),(ENAME(2),E2)
C
C
C
C
C	[0] COPY ARGUMENTS AND THEN FETCH THE CHARACTER
C	CLEAR THE RETURN ARG
	MIO=0
C	****DEFINE "ICMNSIZE" THE SIZE OF COMMON FOR IOPR=8,9****
C	IT IS THE SIZE OF COMMON ROUNDED OFF TO THE NUMBER OF BLOCKS
C	TO STORE IT.
C	%%%% AS OF 11/20/75 COMMON MAX=3220.==> 3400 WORDS,
C	%%%% OR 3400/400 (400 WORDS/BLOCK) = 7 PAGES.
C	NOTE: START I/O AT 10000.
	ICMNSIZE=7
C
C	CHECK IF A LEGAL OPR
C	TEST IF LEGAL AND ALSO IF A 1 OR 3 (LOOKUP OR ENTER)
C		IF LOOKUP OR ENTER THEN TEST IF DO INQUIRE ON ASCII
C			NAME.
	IF(IOPR-1)2000,13,12
C	TEST IF AN ENTER (3)
12	IF(IOPR-3)10,13,10
C	FINISH LEGALITY TESTING.
10	IF(IOPR-14)11,11,17
17	IF(IOPR-16)13,13,2000
C
11	GOTO(111,222,333,444,555,666,777,888,999,1010,1111,1222
     1,1333,1444,111,333),IOPR
C	****ERROR #1 BAD IOPR***
2000	IOERR=1
	GOTO 2040
C
C
C
C		[0.1] TEST IF A LOOKUP (1) OR ENTER(3)
C		THEN SETUP THE IOD/JOD DEVICE CHANNEL #
C		BY COPYING IDEVICE IF IDEVICE.AND.7700 =0000
C		ELSE DOING AN INQUIRE ON THE DEVICE NAME.
13		KDEVICE=IDEVICE
S		TAD \KDEVICE
S		AND (7700 /LOOKFOR HIGH ORDER ASCII INFORMATION
S		SZA CLA
S		JMP INQU /NEED TO DO THE INQUIRE
C		DO NOT NEED TO DO THE INQUIRE
16		IF(IOPR-15)18,14,15
18		IF(IOPR-3)14,15,15
14		IOD=KDEVICE
		GOTO 11
15		JOD=KDEVICE
		GOTO 11
C
C
C			[0.1.1] INQUIRE WHERE THE DEVICE IS (INTERNAL
C			DEVICE NUMBER).
S INQU,			TAD I \IDEVICE /COPY THE DEVICE NAME IN 2 FETCHES
S			DCA DEVNAM
S			INC \IDEVICE# /INCR THE POINTER
S			TAD I \IDEVICE
S			DCA DEVNAM#
S			6201 /MAKE SURE THE CALL IS FROM FIELD 0
S			CPAGE 10
S			6212 /CIF 10
S			JMS 7700 /USR
S			12 /INQUIRE WHEREABOUTS OF DEVICE
S DEVNAM,		0 /NAME CHAR 1:2
S			0 /NAME CHAR 3:4, DEV NUMBER RETURNED HERE.
S			0 /LOC OF DEV HANDLER RETURNED HERE IF EXISTS
S			JMP INQUERROR
S			TAD DEVNAM# /GET THE DEVICE NUMBER AND SAVE IT
S			DCA \KDEVICE
C			NOW SET UP IOD/JOD
			GOTO 16
C
C
C				[0.1.1.1] *****ERROR #2 - INQUIRE ERROR***
S INQUERROR,				CLA
				IOERR=2
				GOTO 2040
C
C	[1] OPEN UP THE FILE.
111	IW1=0
	IW2=0
	IW3=0
	FILENAME(1)=FN
S	TAD I \EXT
S	DCA \F2
S	JMS ISETDEV /FETCH DEV HANDLER AND OPEN FILE
	RETURN
C
C
C
C	[2] GET THE NEXT CHARACTER
S\222,	JMS GETC
	RETURN
C
C
C
C		[2.1] ALTERNATE GETC ENTRY
S		ENTRY INNC
S INNC,		BLOCK 2
S		JMS GETC
S		TAD \MIO /RETURN THE CHARACTER
S		RETRN INNC
C
C
C
C
C	[3] GET OUTPUT DEVICE HANDLER AND ENTER THE FILE
333	JW1=0
	JW2=0
	ENAME=FN
S	TAD I \EXT
S	DCA \E2
S	JMS OSETDEV /SET THE OUTPUT DEVICE HANDLER AND ENTER THE FILE.
	RETURN
C
C
C
C	[4] GET THE NEXT CHARACTER
S \444,	TAD I \IDEVICE /GET THE OUTPUT CHARACTER
S	JMS PUTC
	RETURN
C
C
C
C		[4.1] ALTERNATE PUTC ENTRY POINT
S		ENTRY OUTC
S OUTC,		BLOCK 2
S		JMS PUTC
S		TAD \MIO /RETURN THE VALUE...
S		RETRN OUTC
C
C
C
C	[5] CLOSE THE OUTPUT FILE.
555	JBB=JBLOCK
C	IF IDEVICE=-1 THEN DO CLOSE WITHOUT FORCING CHAR BUFFER
	IF(IDEVICE+1)556,558,556
C
C
C		[5.1] OUTPUT CONTROL/Z'S UNTIL FILL JBUF, THEN
C		WRITE OUT THE BUFFER. WHEN JBLOCK INCREMENTS
C		STOP.
556		IF(JBB-JBLOCK)558,557,557
S \557,		TAD (032 /CONTROL/Z
S		JMS PUTC
		GOTO 556
C
C
C		[5.2] CALL USR TO CLOSE THE OUTPUT FILE.
S \558,		CLA CMA /-1 SINCE JBLOCK IS # BLOCKS+1
S		TAD \JBLOCK
S		DCA CL2
S		TAD \JOD /DEVICE
S		CPAGE 10
S		6212 /CIF 10
S		JMS 7700
S		4 /CLOSE
S		\ENAME /POINTER TO FILENAME
S CL2,		0 /# BLOCKS
		GOTO 161
		RETURN
C
C
C
C		[5.3] CLOSE ERROR
S \161,		CLA
C		*****ERROR #3 - CLOSE FILE ERROR*****
		IOERR=3
		GOTO 2047
C
C
C
C	[6.] READ "IDEVICE" BLOCKS FROM THE INPUT DEVICE
C	INTO BUFFER ADDRESS "FN".
666	MIO=0
C
C
C		[6.1] SET UP THE FUNCTION WORD FOR THE "READ"
S		TAD I \IDEVICE /GET THE NUMBER OF BLOCKS
S		CLL RTL; RTL;RTL
S		RAL /PAGE*2=BLOCKS.
S		AND (3700
S		DCA R6A1
S		TAD \FN /GET THE FIELD FROM DUMMY VARIABLE
S		AND (0070
S		TAD R6A1 /OR IT INTO FUNCTION WORD
S		DCA R6A1 /SAVE IT.. IT IS BUILT
C
C
C		[6.2] SETUP THE CURRENT BUFFER ADDRESS
S		TAD \FN# /GET BUFFER ADDRESS
S		DCA R6A2
C
C
C		[6.3] SETUP THE STARTING BLOCK #
S		TAD BARG2
S		DCA \KKK
		IBN=KKK+IBLOCK-1
S		TAD \IBN
S		DCA R6A3 /SAVE STARTING BLOCK #
C
C
C		[6.4] SET UP THE HANDLER ADDRESS
S		TAD ARG3
S		DCA 7 
S		CPAGE 7
S		JMS I 7 /IT IS IN FIELD 0...
S R6A1,		0 /FUNCTION WORD
S R6A2,		0 /BUFFER ADDRESS
S R6A3,		0 /STARTING BLOCK #
S		JMP \511 /ERROR MESSAGE FOR CHARACTER READ
C
C
C		[6.5] UPDATE BLOCK COUNT AND EXIT
		IBLOCK=IBLOCK+IDEVICE
		RETURN
C
C

C
C	[7.] WRITE "IDEVICE" BLOCKS FROM THE INPUT DEVICE
C	INTO BUFFER ADDRESS "FN".
777	MIO=0
C
C
C		[7.1] SET UP THE FUNCTION WORD FOR THE "WRITE"
S		TAD I \IDEVICE /GET THE NUMBER OF BLOCKS
S		CLL RTL; RTL;RTL
S		RAL /PAGE*2=BLOCKS.
S		AND (3700
S		TAD (4000 /FORCE WRITE BIT ON
S		DCA R7A1
S		TAD \FN /GET THE FIELD FROM DUMMY VARIABLE
S		AND (0070
S		TAD R7A1 /OR IT INTO FUNCTION WORD
S		DCA R7A1 /SAVE IT.. IT IS BUILT
C
C
C		[7.2] SETUP THE CURRENT BUFFER ADDRESS
S		TAD \FN# /GET BUFFER ADDRESS
S		DCA R7A2
C
C
C		[7.3] SETUP THE STARTING BLOCK #
S		TAD EARG2
S		DCA \KKK
		IBN=KKK+JBLOCK-1
S		TAD \IBN
S		DCA R7A3 /SAVE STARTING BLOCK #
C
C
C			[7.3.1] TEST IF FILE WILL BE TOO LARGE FOR DEVICE
C			I.E. IF BLOW THE MAX ALLOWED FILE LENGTH
S			TAD EARG3 /-MAX FILE LENGTH
S			SMA CLA /TEST IF >2047
S			JMP S74 /YES, OK...
S			TAD EARG3 /CONTINUE TESTING, <2047.
S			TAD (D20 /PROTECTION!!
S			TAD \JBLOCK /FILE SIZE SO FAR
S			TAD I \IDEVICE /NUMBER OF BLOCKS TO WRITE
S			SMA CLA
S			JMP \713 /OVERFLOW ERROR
C
C
C		[7.4] SET UP THE HANDLER ADDRESS
S S74,		TAD CARG
S		DCA 7 
S		CPAGE 7
S		JMS I 7 /IT IS IN FIELD 0...
S R7A1,		0 /FUNCTION WORD
S R7A2,		0 /BUFFER ADDRESS
S R7A3,		0 /STARTING BLOCK #
S		JMP \701 /ERROR MESSAGE FOR  WRITE
C
C
C		[7.5] UPDATE BLOCK COUNT AND EXIT
		JBLOCK=JBLOCK+IDEVICE
		RETURN
C
C
C
C
C		[7.6] FATAL ERROR MESSAGE
S\701,		CLA
C		*****ERROR #4 - WRITE BLOCK OUPUT ERROR****
		IOERR=4
		GOTO 2047
C
C

C
C	[8]  LOOKUP "SYS:SVDDTG.DA", READ COMMON
C	 BACK INTO CORE, "READ" 32 PAGES FROM
C	 THE FILE INTO FIELD 7.
C		[8.1] FETCH THE SYS: AND LOOKUP "SVDDTG.DA"
888		IOD=1
		FILENAME(1)='SVDDTG'
S		TAD (0401 /"DA"
S		DCA \F2
S		JMS ISETDEV /FETCH SYS: AND LOOKUP THE FILE.
S		TAD BARG2 /GET THE CURRENT BLOCK#
S		DCA \IBN
S		TAD \IBN
S		DCA READ0
S		TAD ARG3 /SET UP THE ENTRY POINT
S		DCA 7
C
C		COMPUTE THE NUMBER OF PAGES TO TRANSFER
S		TAD \ICMNSIZE /IN BLOCKS
S		CLL RTL; RTL; RTL; /GET IN LEFT BYTE
S		RAL /CONVERT BLOCKS TO PAGES
S		TAD (0010 /ADD THE READ FIELD 1 INFO.
S		DCA RDSV /SAVE THE INSTRUCTION
C
C
C		[8.2] READ FIRST "ICMNSIZE" BLOCKS INTO COMMON.
S		CPAGE 7
S		JMS I 7
S RDSV,		0010 /READ "ICMNSIZE" PAGES INTO COMMON
S		0000 /START OF COMMON FIELD
S READ0,	0 /START OF BLOCK #
S		JMP \511 /ERROR
		IBN=IBN+ICMNSIZE
C
C
C
C
C		[8.3] READ THE 1ST HALF OF FIELD 7
S		TAD \IBN
S		DCA READ1
S		CPAGE 7
S		JMS I 7 /CALL HANDLER
S		2070 /READ 16 PAGES INTO FIELD 7
S		0000 /STARTING ADDRESS
S READ1,	 0   /STARTING BLOCK #
S		JMP \511 /ERROR
		IBN=IBN+8
C
C
C		[8.4] READ THE 2ND HALF OF FIELD 7
S		TAD \IBN
S		DCA READ2
S		CPAGE 7
S		JMS I 7 /CALL HANDLER
S		2070 /READ 16 PAGES INTO FIELD 7
S		4000 /STARTING ADDRESS
S READ2,	 0   /STARTING BLOCK #
S		JMP \511 /ERROR
C
C
	RETURN
C
C	[9] ENTER "SYS:SVDDTG.DA", WRITE COMMON,
C	"WRITE" 32 PAGES INTO THE FILE FROM FIELDS 7,
C	CLOSE THE FILE.
C		[9.1] FETCH THE SYS: THEN ENTER THE FILE
999		JOD=1
		ENAME(1)='SVDDTG'
S		TAD (0401 /"DA"
S		DCA \E2
S		JMS OSETDEV /FETCH THE SYS AND ENTER THE FILE
S		TAD EARG2 /GET THE CURRENT BLOCK#
S		DCA \IBN
S		TAD \IBN
S		DCA WRITE0
C
C		COMPUTE THE NUMBER OF PAGES TO TRANSFER
S		TAD \ICMNSIZE /IN BLOCKS
S		CLL RTL; RTL; RTL; /GET IN LEFT BYTE
S		RAL /CONVERT BLOCKS TO PAGES
S		TAD (4010 /ADD THE WRITE FIELD 1 INFO.
S		DCA WTSV /SAVE THE INSTRUCTION
C
C
C			[9.1.1] MAKE SURE THAT THERE IS ENOUGH ROOM ON
C			THE DISK TO SAVE IT
S			TAD EARG3 /-#BLOCKS FREE IN THE TENTATIVE FILE
S			SMA CLA /TEST IF > 2047
S			JMP S91 /YES, OK
S			TAD EARG3 /NO, CONTINUE TESTING
S			TAD (D51 /WORST CASE 31 +20 PROTECTION BLOCKS TO BE WRITTEN
S			SMA CLA
S			JMP \713 /NO DICE, WOULD BLOW THE DISK IF DID IT.
S S91,			TAD CARG /SET UP THE ENTRY POINT
S			DCA 7
C
C
C		[9.2] WRITE FIRST "ICMNSIZE" BLOCKS FROM COMMON
S		CPAGE 7
S		JMS I 7
S WTSV,		4010 /WRITE ICMNSIZE BLOCKS FROM COMMON
S		0000 /START OF COMMON FIELD
S WRITE0,	0 /STARTING BLOCK #
S		JMP \701 /ERROR
		IBN=IBN+ICMNSIZE
C
C
C		[9.3] WRITE THE 1ST HALF OF FIELD 7
S		TAD \IBN
S		DCA WRITE1
S		CPAGE 7
S		JMS I 7 /CALL HANDLER
S		6070 /WRITE 16 PAGES INTO FIELD 7
S		0000 /STARTING ADDRESS
S WRITE1,       0   /STARTING BLOCK #
S		JMP \701 /ERROR
		IBN=IBN+8
C
C
C		[9.4] WRITE THE 2ND HALF OF FIELD 7
S		TAD \IBN
S		DCA WRITE2
S		CPAGE 7
S		JMS I 7 /CALL HANDLER
S		6070 /WRITE 16 PAGES INTO FIELD 7
S		4000 /STARTING ADDRESS
S WRITE2,        0   /STARTING BLOCK #
S		JMP \701 /ERROR
		JBLOCK=16+ICMNSIZE
C
C
C		[9.6] CLOSE THE FILE
		GOTO 558
C
C
C
C	[10] SET THE READ NEXT BLOCK POINTER TO IDEVICE
1010	IBLOCK=1
S	TAD I \IDEVICE /ABSOLUTE BLOCK NUMBER
S	DCA BARG2 /INPUT STARTING BLOCK NUMBER
C	SET THE CHARACTER COUNT TO EMPTY SO CAN ALSO DO 8BIT INPUT
	ICOUNT=384
	RETURN
C
C
C
C	[11] SET THE WRITE NEXT BLOCK POINTER TO IDEVICE
1111	JBLOCK=1
S	TAD I \IDEVICE /ABSOLUTE BLOCK NUMBER
S	DCA EARG2 /OUTPUT STARTING BLOCK NUMBER
S	TAD BARG3 /SET THE OUTPUT FILE SIZE TO THAT OF THE INPUT FILE
S	DCA EARG3
C	SET THE CHARACTER COUNT TO EMPTY SO CAN ALSO DO 8BIT OUTPUT
	JCOUNT=0
	MOUNT=-3
	JW1W2=0
	RETURN
C	ALSO SET THE OUTPUT DEVICE AND DEVICE POINTER FOR WRITE
C	TO BE THE SAME AS FOR THE READ. 
S	TAD ARG3 /INPUT DEVICE POINTER
S	DCA CARG /OUTPUT DEVICE POINTER
	JOD=IOD
C
C
C      [12]  RETURN IN (IO,IDEVICE,FN,EXT) THE INTEGER ARRAY
C	(INPUT DEV#, NEXT ABSOLUTE INPUT BLOCK #, OUTPUT
C	DEV#, NEXT ABSOLUTE OUTPUT BLOCK #).
1222	MIO=IOD
S	TAD BARG2 /STARTING BLOCK NUMBER OF INPUT FILE
S	DCA I \IDEVICE 
S	TAD \JOD /OUTPUT DEVICE NUMBER
S	DCA I \FN /SAVE IT AS INTEGER NOT FLOATING POINT !!!!!
S	TAD EARG2 /STARTING BLOCK NUMBER OF OUTPUT FILE
S	DCA I \EXT /SAVE IT AS INTEGER NOT FLOATING POINT !!!!!
	RETURN
C
C
C      [13]  RETURN IN (IO,IDEVICE,FN,EXT) THE INTEGER ARRAY
C	(INPUT DEV#, NEXT ABSOLUTE INPUT BLOCK #, - FILE SIZE IN 
C	BLOCKS).
1333	IDEVICE=IOD
S	TAD BARG2 /STARTING BLOCK NUMBER OF INPUT FILE
S	DCA I \FN /SAVE IT AS INTEGER NOT FLOATING POINT !!!!!
S	TAD BARG3 / - INPUT FILE SIZE
S	DCA I \EXT /SAVE IT AS INTEGER NOT FLOATING POINT !!!!!
	RETURN
C
C
C      [14]  RETURN IN (IO,IDEVICE,FN,EXT) THE INTEGER ARRAY
C	(OUTPUT DEV#, NEXT ABSOLUTE OUTPUT BLOCK #, - FILE SIZE IN 
C	BLOCKS).
1444	IDEVICE=JOD
S	TAD EARG2 /STARTING BLOCK NUMBER OF OUTPUT FILE
S	DCA I \FN /SAVE IT AS INTEGER NOT FLOATING POINT !!!!!
S	TAD EARG3 / - POTENTIAL MAXIMIMUMOUTPUT FILE SIZE
S	DCA I \EXT /SAVE IT AS INTEGER NOT FLOATING POINT !!!!!
	RETURN
C
C
C
C	***********************************************
C	*****S U B R O U T I N E    I S E T D E V   ***
C	***********************************************
C	FETCHES THE INPUT DEVICE HANDLER INTO ARRAY IDEV(256)
C	WITH THE DEVICE NUMBER IN IOD. IT THEN
C	LOOKS UP THE FILE NAME CONTAINED IN ARRAY FILNAME(2)
C	AND INITIALIZES THE BUFFER.
C
S	CPAGE 3
S RISETDEV,	JMP I ISETDEV
S ISETDEV,	0 /ENTRY
C	[IS.1] LOAD THE	"DSK" HANDLER INTO CORE.
	IBLOCK=1
S	TAD PIDEV
S	AND (7600
S	IAC /ENABLE 2 PAGE HANDLERS
S	DCA ARG3
S	TAD \IOD
S	CPAGE 7
S	6212	/CIF 10
S	JMS 7700	/USR
S	1	/FETCH
SARG3,	0
S	JMP FTCHERROR /CLOSE ERROR
	GOTO 133
C
C
C	[IS.2] FETCH ERROR - NON FATAL ERROR
S FTCHERROR,	CLA
C	*******ERROR #5 - FETCH INPUT HANDLER ERROR****
	IOERR=5
	GOTO 2040
C
C
C	[IS.3] LOOKUP THE FILE ON DEVICE DSK:.
S\133,	CLA CMA /-1
S	TAD I \IOPR
S	SZA CLA
S	JMP \42 /RETURN SINCE IOPR=15
S	TAD PFILENAME /SET UP FILENAME POINTER
S	DCA BARG2
S	TAD \IOD /GET DEVICE #
S	CPAGE 7
S	6212 /CIF 10
S	JMS 7700 /USR
S	2 /LOOKUP
SBARG2,	0 /POINTER TO FILE NAME, WILL BE ST. BLK #.
SBARG3,	0 /WILL BE -FILE LENGTH
	GOTO 141
	GOTO 42
C
C
C		[IS.3.1] LOOKUP ERROR - SKIP THIS FILE AND RETURN.
S \141,		CLA
C		******ERROR #6 - LOOKUP FAILED *****
		IOERR=6
		GOTO 2040
C
C
C
C		[IS.3.2] NOW RESET THE CHARACTER COUNTER TO 384C
C		AND RETURN.
42		ICOUNT=384
S		JMP RISETDEV
C
C
C
C

C
C	***********************************************
C	*****S U B R O U T I N E    O S E T D E V ***
C	***********************************************
C	FETCHES THE OUTPUT DEVICE HANDLER INTO ARRAY JDEV(256)
C	WITH THE DEVICE NUMBER IN JOD. IT THEN
C	ENTERS THE FILE NAME CONTAINED IN ARRAY ENAME(2)
C	AND INITIALIZES THE BUFFER.
C
S	CPAGE 3
S ROSETDEV,	JMP I OSETDEV
S OSETDEV,	0 /ENTRY
C	[OS.1] LOAD THE	"DSK" HANDLER INTO CORE.
	JBLOCK=1
S	TAD PJDEV
S	AND (7600
S	IAC /ENABLE 2 PAGE HANDLERS
S	DCA CARG
S	TAD \JOD
S	CPAGE 7
S	6212	/CIF 10
S	JMS 7700	/USR
S	1	/FETCH
SCARG,	0
	GOTO 611
	GOTO 633
C
C	[OS.2] FETCH ERROR - FATAL ERROR
S \611,	CLA
C	****ERROR #7 - FETCH OUTPUT DEVICE ERROR*****
	IOERR=7
	GOTO 2040
C
C
C
C	[OS.3] ENTER THE FILE ON DEVICE JOD:.
S\633,	CLA
S	TAD I \IOPR
S	TAD (-3
S	SZA CLA
S	JMP \682 /RETURN, SINCE IOPR=16
S	TAD PENAME /SET UP ENAME POINTER
S	DCA EARG2
S	TAD \JOD /GET DEVICE #
S	CPAGE 7
S	6212 /CIF 10
S	JMS 7700 /USR
S	3 /ENTER
SEARG2,	0 /POINTER TO FILE NAME, WILL BE ST. BLK #.
SEARG3,	0 /WILL HAVE - TENTATIVE FILE LENGTH.
	GOTO 641
	GOTO 682
C
C
C		[OS.3.1] ENTER ERROR - SKIP THIS FILE AND RETURN.
S \641,		CLA
C		******ERROR #8 - ENTER FILE FAILED*****
		IOERR=8
		GOTO 2040
C
C
C
C
C		[OS.3.2] NOW RESET THE CHARACTER COUNTER TO 0
C		AND RETURN.
682		JCOUNT=0
		MOUNT=-3
		JW1W2=0
S		JMP ROSETDEV
C
C
C

C	***********************************************
C	****S U B R O U T I N E    R ****
C	***********************************************
C	READ THE NEXT BLOCK INTO COMMON ARRAY IBUF(256)
C	THE CURRENT BLOCK # IN IN IBLOCK. THE STARTING BLOCK
C	NUMBER WAS DEFINED AT ISETDEV IN BARG2.
C
C	[R.1]  READ ONE BLOCK FROM THE FILE INTO IBUF.
S	CPAGE 3
S RR,	JMP I R
S R,	0 /ENTRY
C
C
C		[R.1.1] SETUP BLOCK NUMBER
S		CLA
S		TAD BARG2
S		DCA \KKK
		IBN=KKK+IBLOCK-1
S		TAD \IBN		/START BLOCK NO.
S		DCA CARG3
C
C
C		[R.1.2] SETUP THE BUFFER ADDRESS
S		TAD PIBUF
S		DCA CARG2
C
C
C		[R.1.3] SETUP DEVICE HANDLER POINTER
S		TAD ARG3 / DSK ENTRY POINT
S		DCA 7
C
C
C	[R.2] READ 1 BLOCK INTO IBUF[1:256].
S	CPAGE 7
S	JMS I 7
SCARG1,	0200 /FUNCTION WORD. ONE BLOCK READ.
SCARG2, 0   /BUFFER ADDRESS
SCARG3, 0    /STARTING BLOCK NUMBER
	GOTO 511
C
C
C	[R.3] INCREMENT FOR NEXT TIME
	IBLOCK=IBLOCK+1
S	JMP RR
C
C
C
C	[R.4] DATA READ ERROR. TRY AGAIN.
S \511,	CLA
C	*****ERROR #9 - READ ERROR ****
	IOERR=9
	GOTO 2047
C
C

C
C	***********************************************
C	****S U B R O U T I N E    W ****
C	***********************************************
C	WRITES	THE NEXT BLOCK FROM COMMON ARRAY JBUF(256)
C	THE CURRENT BLOCK # IN IN JBLOCK. THE STARTING BLOCK
C	NUMBER WAS DEFINED AT OSETDEV IN EARG2.
C
C	[W.1] WRITE ONE BLOCK FROM THE FILE INTO JBUF.
S	CPAGE 3
S RW,	JMP I W
S W,	0 /ENTRY
C
C	TESTIF BLOW THE DISK
S	ISZ EARG3 /- # FREE BLOCKS ON DISK
S	SKP
	GOTO 713
C
C
C		[W.1.1] SETUP THE BLOCK NUMBER
S RETRY,		CLA
S		TAD EARG2
S		DCA \KKK
		IBN=KKK+JBLOCK-1
S		TAD \IBN		/START BLOCK NO.
S		DCA DARG3
C
C
C		[W.1.2] SETUP THE BUFFER ADDRESS
S		TAD PJBUF
S		DCA DARG2
C
C
C		[W.1.3] SETUP HANDLER POINTER
S		TAD CARG / DSK ENTRY POINT
S		DCA 7
S		CLA
S		6201 /CDF 00
C
C
C	[W.2] WRITE 1 BLOCK FROM JBUF[1:256]
S	CPAGE 7
S	JMS I 7
SDARG1,	4200 /FUNCTION WORD. ONE BLOCK WRITE.
SDARG2, 0   /BUFFER ADDRESS
SDARG3, 0   /STARTING BLOCK NUMBER
	GOTO 711
C
C
C	[W.3] INCREMENT FOR NEXT TIME
	JBLOCK=JBLOCK+1
S	JMP RW /RETURN
C
C
C
C	[W.5]  DATA WRITE ERROR. TRY AGAIN.
S \711,	CLA
C	*****ERROR #10 - WRITE I/O ERROR****
	IOERR=10
	GOTO 2047
C
C
C
C
C	[W.6] THE DATA FILE WAS TOO LONG. TELL THEM AND RETURN ERROR
C	******ERROR #11 - WRITE FILE TOO LONG, FORGET IT****
713	IOERR=11
	GOTO 2040
C
C	***********************************************
C	******S U B R O U T I N E     G E T C  *****
C	***********************************************
C	GET THE NEXT INPUT CHARACTER.
C	GETS A NEW INPUT BUFFER WHEN NEEDED. GETS AND TESTS EACH
C	CHARACTER FOR CONTROL/Z (SETS FLAG IF FOUND) THEN RETURNS
C	THE CHARACTER IN THE AC.
S	CPAGE 3
S RGETC,	JMP I GETC
S GETC,	0
C	[G.1] TEST IF "IBUF" EMPTY
	IF(ICOUNT-384)800,801,801
C
C
C	[G.2] YES, GET NEW BUFFER
S\801,	JMS R /GET NEW BUFFER
	ICOUNT=0
	KOUNT=-3
C
C
C		[G.2.1] ZERO THE W1/W2 POINTER
		IW1W2=0
C
C
C		[G.2.2] INCREMENT THE CHARACTER COUNTER
C		THE FOLLOWING IS FALL THROUGH CODE TO DECODE THE
C		 INPUT BUFFER
800		ICOUNT=ICOUNT+1
C
C
C		[G.2.3] GET NEXT BYTE
S		ISZ \KOUNT
S		JMP W1W2 /NOT W3
C
C
C	[G.3] YES W3, RESET KOUNT
	KOUNT=-3
C
C
C		[G.3.1] MAKE W3 FROM W1, W2
S		TAD \IW1
S		RTR
S		RTR
S		AND (0360
S		DCA \IW3
S		TAD \IW2
S		RTL
S		RTL
S		RAL
S		AND (0017
S		TAD \IW3
S		DCA \IW3
C
C
C		[G.3.2] GO TEST FOR CONTROL/Z
S		TAD \IW3 
S		JMP G5
C
C
C	[G.4] IT WAS W1 OR W2
SW1W2,	TAD \KOUNT
S	TAD (1 /WILL BE 2 FOR W1
S	SZA CLA
S	JMP DOW1 /DO W1
C
C
C		[G.4.1] PROCESS W2
C		SET UP POINTER
S		TAD \IW1W2
S		TAD PIBUF /BUFFER POINTER
S		DCA 7
C
C
C			[G.4.1.1] INCREMENT THE BUFFER POINTER
S			INC \IW1W2
S			TAD I 7
S			6201 /CDF 00
S			DCA \IW2
S			TAD \IW2
S			JMP G5
C
C
C		[G.4.2] PROCESS W1
S DOW1,		TAD \IW1W2
S		TAD PIBUF
S		DCA 7
C
C
C			[G.4.2.1] INCREMENT THE BUFFER POINTER
S			INC \IW1W2
S			TAD I 7
S			DCA \IW1
S			TAD \IW1
C
C
C	[G.5] RETURN CHARACTER IN "IO"
S G5,	AND (377 /ONLY POSITIVE DATA
S	DCA \MIO /SAVE IT
S	JMP RGETC
C
C

C
C
C	***********************************************
C	*****S U B R O U T I N E    P U T C****
C	***********************************************
C	SAVE THE NEXT INPUT CHARACTER.
C	SAVES A NEW INPUT BUFFER WHEN NEEDED.
S	CPAGE 3
S RPUTC,	JMP I PUTC
S PUTC,	0
C	[P.1] SAVE 8 BIT DATA
S	DCA CSAVE
C
C
C	[P.2] TEST IF THE BUFFER IS "FULL"
	IF(JCOUNT-384)900,901,901
C
C
C		[P.2.1] YES, GO WRITE OUT THE BUFFER
S\901,		JMS W /SAVE NEW BUFFER
		JCOUNT=0
		MOUNT=-3
C
C
C			[P.2.1.1] ZERO THE BUFFER POINTER
			JW1W2=0
C
C
C	[P.3] INCREMENT THE CHARACTER COUNTER
C	THE FOLLOWING IS FALL THROUGH CODE TO DECODE THE INPUT BUFFER
900	JCOUNT=JCOUNT+1
C
C
C		[P.3.1] CODE THE NEXT BYTE. TEST WHICH OF 3 BYTES IT IS.
S		ISZ \MOUNT
S		JMP Y1Y2 /NOT W3
C
C
C		[P.3.2] YES W3, RESET MOUNT
		MOUNT=-3
C
C
C		[P.3.3] DECODE W3 INTO W1 AND W2 THEN PUSH W1, W2
C
C			[P.3.3.1] PACK HIGH OF W3 INTO W1 AND SAVE W1.
S			TAD CSAVE /GET HIGH BITS W3
S			RTL
S			RTL
S			AND (7400 /BITS 0-3
S			TAD \JW1
S			DCA \JW1
S			TAD PJBUF
S			TAD \JW1W2
S			DCA 7
S			TAD \JW1
S			DCA I 7
C
C
C			[P.3.3.2] PACK LOW OF W3 INTO W2 AND SAVE W2.
S			INC \JW1W2 /INCREMENT THE BUFFER POINTER
S			TAD CSAVE
S			RTR
S			RTR
S			RAR /MOVE LOW 4 BITS TO HIGH 4 BITS
S			AND (7400
S			TAD \JW2
S			DCA \JW2
S			TAD PJBUF
S			TAD \JW1W2
S			DCA 7
S			INC \JW1W2 /INCREMEENT THE BUFFER POINTER
S			TAD \JW2
S			DCA I 7
C
C
C		[P.3.4] DONE, RETURN
S		JMP RPUTC /DID W3 AND SOCKED IT OUT
C
C
C	[P.4] IT WAS W1 OR W2. TEST WHICH ONE.
SY1Y2,	TAD \MOUNT
S	TAD (1 /WILL BE 2 FOR W1
S	SZA CLA
S	JMP DOY1 /DO W1
C
C
C		[P.4.1] PROCESS IN W2
S		TAD CSAVE /SAVE THE 2ND BYTE.
S		AND (0377
S		DCA \JW2
C
C
C			[P.4.1.1] RETURN
S			JMP RPUTC
C
C
C		[P.4.2] PROCESS IN W1
S DOY1,		TAD CSAVE /GET 1ST BYTE
S		AND (0377
S		DCA \JW1
C
C
C			[P.4.2.1] RETURN
S			JMP RPUTC
C
C
C	*****************************************
C	*E R R O R    H A N D L E R            *
C	*****************************************
C	ERRORS HAVE ERROR NUMBERS 1 TO +N AND ARE LABELED
C	IN MIO.FT AS ******ERROR #N - <COMMENT>******.
C	THERE ARE TWO TYPES OF ERRORS. FATAL AND NON-FATAL.
C	FATAL ERRORS GOTO 2047 WHILE NON-FATAL ERRORS
C	GOTO 2040. THE ERROR NUMBER IS PASSED THROUGH "IOERR".
C	FATAL ENTRY POINT
2047	IFTL=1
	GOTO 2041
C	NON-FATAL ENTRY POINT
2040	IFTL=0
2041	WRITE(1,2042)IOERR
2042	FORMAT(' "IO.FT ERR=',I5)
C
	IF(IFTL)2043,2044,2043
C	TAKE FATAL EXIT
2043	CALL EXIT
C	TAKE ERROR RETURN FOR MIO.FT
2044	MIO=-1
	RETURN

C
C	****POINTERS****
S PIBUF,	\IBUF
S PIDEV,	\IDEV
S PFILENAME, \FILENAME
S PJBUF,	\JBUF
S PJDEV,	\JDEV
S PENAME, 	\ENAME
S CSAVE,	0 /SAVE OUT CHAR
C
C
	END