.TITLE	EXTMT.MAC	82f17a		05-AUG-77/17-JUN-82.
;
;
;	AUTHOR: N. A. BOURGEOIS, JR.
;		SANDIA NATIONAL LABORATORIES
;		SYSTEMS ENGINEERING DIVISION 1738
;		PO BOX 5800
;		ALBUQUERQUE, NM 87185
;		505-844-8088
;		AV  244-8088
;
;	THIS SOFTWARE IS ISSUED BY SANDIA NATIONAL LABORATORIES,
;	OPERATED  FOR  THE UNITED STATES DEPARTMENT OF ENERGY BY
;	SANDIA CORPORATION.
;
;				NOTICE
;
;	THIS  SOFTWARE  WAS  SPONSORED  BY  THE  UNITED   STATES
;	GOVERNMENT.   NEITHER  THE  UNITED STATES GOVERNMENT NOR
;	THE UNITED STATES DEPARTMENT OF ENERGY, NOR ANY OF THEIR
;	EMPLOYEES, NOR ANY OF THEIR CONTRACTORS, SUBCONTRACTORS,
;	OR  THEIR  EMPLOYEES  MAKES  ANY  WARRANTY,  EXPRESS  OR
;	IMPLIED,    OR    ASSUMES   ANY   LEGAL   LIABILITY   OR
;	RESPONSIBILITY  FOR  THE   ACCURACY,   COMPLETENESS   OR
;	USEFULNESS  OF  ANY  INFORMATION,  APPARATUS, PRODUCT OR
;	PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD  NOT
;	INFRINGE PRIVATELY OWNED RIGHTS.
;
;	THIS WORK WAS SPONSORED AND FUNDED BY:
;
;		    HEADQUARTERS, ESD / OCB / STOP 36
;		    HANSCOM AIR FORCE BASE, MA 01731
;
;
.SBTTL                      ****************
.SBTTL                      *              *
.SBTTL                      * UNCLASSIFIED *
.SBTTL                      *              *
.SBTTL                      ****************
.PAGE
.SBTTL	DESCRIPTION			05-AUG-77/22-FEB-82.

;THE SUBROUTINE "EXTMT" IS A FORTRAN CALLABLE MAGNETIC TAPE HANDLER.
;IT IS CAPABLE OF READING OR WRITING TAPES IN ANY ARBITRARY FORMAT.
;AS HEREIN IMPLEMENTED, THE TAPE UNIT MUST BE DRIVE ZERO AND MUST BE
;TYPE "MT".  USE THE "SET" COMMAND TO SELECT TAPE DENSITY AND/OR
;LATERAL PARITY.  TO CHANGE THE UNIT NUMBER, IT IS NECESSARY TO
;CHANGE THE THE CONDITIONAL ASSEMBLY SWITCH "CHANGE" IN THE
;VARIABLES SECTION.  THE ROUTINE IS DESIGNED TO EXECUTE UNDER BOTH
;RT-11 AND TSX-PLUS.  UNDER RT-11 THE MT HANDLER MUST BE LOADED BEFORE
;THE APPLICATION PROGRAM IS EXECUTED.
;
;THE FORTRAN CALLING SEQUENCE IS AS FOLLOWS:
;
;	CALL EXTMT(ARG1[,ARG2[,ARG3[,ARG4]]])
;
;THIS FORTRAN CALLABLE SUBROUTINE CAUSES THE MAGNETIC TAPE UNIT TO
;PERFORM THE OPERATION SPECIFIED IN ARGUMENT ONE.  THE NUMBER OF
;CHARACTERS TO BE TRANSFERRED OR RECORDS TO BE SKIPPED MUST BE GIVEN
;IN ARGUMENT TWO.  AN EVEN NUMBER OF CHARACTERS SHOULD BE SPECIFIED IN
;ARGUMENT TWO.  IDENTIFICATION OF THE MEMORY BUFFER TO BE USED MUST
;BE STATED IN ARGUMENT THREE.  WHEN AN END-OF-FILE IS READ ON THE TAPE
;A ZERO IS RETURNED IN ARGUMENT FOUR, OTHERWISE THE ACTUAL NUMBER OF
;BYTES READ IS RETURNED.  ONLY THOSE ARGUMENTS REQUIRED FOR ANY GIVEN
;FUNCTION SHOULD BE INCLUDED IN THE CALL STATEMENT.  ALL ARGUMENTS
;ARE INTEGER.
;
;	ARG1 VALUES     FUNCTION	ARGS REQ'D
;		0	OFF LINE	1
;		1	READ		1, 2, 3, 4
;		2	WRITE		1, 2, 3
;		3	WRITE EOF	1
;		4	SPACE FORWARD	1, 2
;		5	SPACE REVERSE	1, 2
;		6	WRITE/ERG	1, 2, 3
;		7	REWIND		1

;APPENDIX A CONTAINS A TYPICAL SAMPLE FORTRAN PROGRAM WHICH IN TURN
;CALLS THIS MAGNETIC TAPE HANDLER.  THE SAMPLE PROGRAM READS AN RT-11
;STRUCTURED ASCII FILE AND WRITES A DATA GENERAL RDOS STRUCTURED ASCII
;FILE ON THE MAGNETIC TAPE.

;APPENDIX B CONTAINS THE RT-11 COMMAND STRINGS TO ASSEMBLE, COMPILE AND
;LINK THE SAMPLE PROGRAM AND THIS MAGNETIC TAPE HANDLER.
.PAGE
.SBTTL	DIRECTIVES			08-AUG-77/17-JUN-82.

	.PSECT	$EXTMT
	.IDENT	\82f17a\	;TELL LINKER OUR VERSION
	.NLIST	BEX,CND


.SBTTL	ASSIGNMENTS			08-AUG-77/16-FEB-82.

	BEL	=7		;ASCII BELL CHARACTER
	CHNL	=16		;I/O CHANNEL NUMBER
	CR	=15		;ASCII CARRIAGE RETURN
	DMYBRC	=4		;DUMMY BYTE RECORD COUNTER
	ERRBYT	=52		;EMT ERROR RETURN BYTE
	LF	=12		;ASCII LINE FEED


.SBTTL	MACROS				08-AUG-77/17-FEB-82.

	.MCALL	.EXIT		;TO RT-11 MONITOR
	.MCALL	.LOOKUP		;OPEN A CHANNEL TO A DEVICE
	.MCALL	.PRINT		;A MESSAGE ON THE CONSOLE TT:
	.MCALL	.SPFUN		;ISSUE A COMMAND TO A DEVICE


.SBTTL	MESSAGES			08-AUG-77/22-FEB-82.

MSG01:	.ASCIZ	<CR><LF>\EXTMT:  .LOOKUP ERROR\<BEL>
MSG02:	.ASCIZ	<CR><LF>\EXTMT:  NO ARGUMENTS\<BEL>
MSG03:	.ASCIZ	<CR><LF>\EXTMT:  TOO MANY ARGUMENTS\<BEL>
MSG04:	.ASCIZ	<CR><LF>\EXTMT:  FUNCTION ARGUMENT ERROR\<BEL>
MSG05:	.ASCIZ	<CR><LF>\EXTMT:  NO EOF DETECTED\<BEL>
MSG06:	.ASCIZ	<CR><LF>\EXTMT:  TAPE WRITE PROTECTED\<BEL>
MSG07:	.ASCIZ	<CR><LF>\EXTMT:  PARITY, BAD TAPE, OR HARDWARE ERROR\<BEL>
	.EVEN


.SBTTL	VARIABLES, FLAGS & BUFFERS	08-AUG-77/16-FEB-82.

.IIF NDF CHANGE, CHANGE	=0		;DEFAULT UNIT NUMBER
.IF EQ CHANGE
  DEVBLK: .RAD50 \MT0\			;DEVICE NAME AND NUMBER
  .IFF
  .IF EQ CHANGE-1
    DEVBLK: .RAD50 \MT1\		;DEVICE NAME AND NUMBER
    .IFF
    .IF EQ CHANGE-2
      DEVBLK: .RAD50 \MT2\		;DEVICE NAME AND NUMBER
      .IFF
      .IF EQ CHANGE-3
	DEVBLK: .RAD50 \MT3\		;DEVICE NAME AND NUMBER
	.IFF
	.IF EQ CHANGE-4
	  DEVBLK: .RAD50 \MT4\		;DEVICE NAME AND NUMBER
	  .IFF
	  .IF EQ CHANGE-5
	    DEVBLK: .RAD50 \MT5\	;DEVICE NAME AND NUMBER
	    .IFF
	    .IF EQ CHANGE-6
	      DEVBLK: .RAD50 \MT6\	;DEVICE NAME AND NUMBER
	      .IFF
	      .IF EQ CHANGE-7
		DEVBLK: .RAD50 \MT7\	;DEVICE NAME AND NUMBER
		.IFF
		.ERROR	;****************************************
			;* THE VARIABLE "CHANGE" MUST BE EITHER *
			;* UNDEFINED OR EQUAL TO 0, 1, 2, 3, 4, *
			;* 5, 6, OR 7.  USE THE "SET" COMMAND   *
			;* TO SELECT DENSITY AND/OR PARITY.     *
			;****************************************
		DEVBLK: .RAD50 \QQQ\	;ILLEGAL DEVICE NAME AND NUMBER
	      .ENDC
	    .ENDC
	  .ENDC
	.ENDC
      .ENDC
    .ENDC
  .ENDC
.ENDC
	.WORD	0,0,0
DMYBUF:	.BLKW	DMYBRC			;DUMMY BUFFER
EMTBLK:	.BLKW	6			;EMT ARGUMENT BLOCK
ERRBLK:	.WORD	0,0,0,0			;.SPFUN ERROR RETURN BLOCK
ERRFLG:	.WORD	0			;ERROR FLAG
FSTIME:	.WORD	0			;FIRST CALL FLAG
IBRC:	.WORD	0			;BYTE/RECORD COUNT
IFUN:	.WORD	0			;FUNCTION
SAIBUF:	.WORD	0			;SA DATA BUFFER
SAIRET:	.WORD	0			;SA RETURN ARGUMENT
.PAGE
.SBTTL	CONTROL MODULE			05-AUG-77/17-JUN-82.

;THIS SUBROUTINE CONTROLS THE OVERALL OPERATION OF THE GENERAL PURPOSE
;MAG TAPE HANDLER.  FIRST IT GETS THE ARGUMENTS FROM THE CALLER.  THEN
;IF THIS IS THE FIRST ENTRY INTO THIS ROUTINE IT CONNECTS THE HANDLER
;TO AN I/O CHANNEL WITHOUT MOVING THE MAG TAPE.  THEN IT DECODES THE
;REQUESTED FUNCTION.  FINALLY, IT EXECUTES THE FUNCTION.  IF AN ERROR
;CONDITION SHOULD OCCUR A SUITABLE ERROR MESSAGE IS OUTPUT AND THE
;ROUTINE EXITS TO THE MONITOR.

EXTMT::	JSR	PC	,GTARGS		;GET THE ARGUMENTS
	TST	ERRFLG			;ERROR?
	BNE	4$			; YES
	TST	FSTIME			;FIRST CALL TO EXTMT?
	BNE	1$			; NO
	INC	FSTIME			; YES, SO SET FIRST CALL FLAG
	.LOOKUP	#EMTBLK	,#CHNL,#DEVBLK,#-1	;CONNECT A CHANNEL
	BCS	3$				; IF ERROR
1$:	JSR	PC	,MTFUN		;RECODE THE FUNCTION
	TST	ERRFLG			;ERROR?
	BNE	4$			; YES
	.SPFUN	#EMTBLK	,#CHNL,IFUN,SAIBUF,IBRC,#ERRBLK	;EXECUTE IT
	BCC	2$			; IF NO ERROR
	JSR	PC	,SPFERR		; IF POSSIBLE ERROR
	TST	ERRFLG			;ERROR?
	BNE	4$			; YES
2$:	RTS	PC			; NO, SO RETURN TO CALLER

3$:	.PRINT	#MSG01			;.LOOKUP ERROR
4$:	.EXIT				;TO THE MONITOR
.PAGE
.SBTTL	GET THE ARGUMENTS		05-AUG-77/19-FEB-82.

;TRANSFER THE ARGUMENTS FROM THE CALLER'S ARGUMENT LIST TO LOCAL MEMORY
;LOCATIONS.

GTARGS:	CLR	IFUN			;START
	CLR	IBRC			; WITH
	CLR	SAIBUF			;  ALL
	CLR	SAIRET			;   CLEAN!
	MOV	(R5)+	,R0		;GET THE NUMBER
	BIC	#177400	,R0		; OF ARGUMENTS
	BEQ	4$			;  IF NONE
	MOV	@(R5)+	,IFUN		;GET THE FUNCTION
	DEC	R0			;ANY MORE ARGUMENTS?
	BEQ	1$			; NO
	MOV	@(R5)+	,IBRC		;GET THE BYTE RECORD COUNT
	DEC	R0			;ANY MORE ARGUMENTS?
	BEQ	2$			; NO
	MOV	(R5)+	,SAIBUF		;GET THE BUFFER ADDRESS
	DEC	R0			;ANY MORE ARGUMENTS?
	BEQ	3$			; NO
	MOV	(R5)	,SAIRET		;GET THE RETURN ARGUMENT ADDRESS
	DEC	R0			;ANY MORE ARGUMENTS?
	BEQ	3$			; NO
	BR	5$			; YES

1$:	MOV	#DMYBRC	,IBRC		;DUMMY ARGUMENT FOR TSX-PLUS
2$:	MOV	#DMYBUF	,SAIBUF		;DUMMY ARGUMENT FOR TSX-PLUS
	MOV	#DMYBUF	,SAIRET		;DUMMY ARGUMENT FOR TSX-PLUS
3$:	MOV	IBRC	,@SAIRET	;FOR NON ERROR RETURN
	RTS	PC

4$:	.PRINT	#MSG02			;NO ARGUMENTS
	BR	6$

5$:	.PRINT	#MSG03			;TOO MANY ARGUMENTS
6$:	INC	ERRFLG			;SET THE ERROR FLAG
	BR	3$
.PAGE
.SBTTL	RECODE THE FUNCTION		08-AUG-77/22-FEB-82.

;THIS SUBROUTINE TRANSLATES THE SINGLE DIGIT VALUE OF THE FUNCTION
;CODE INTO THE THREE DIGIT VALUE REQUIRED BY THE .SPFUN REQUEST.  THE
;ROUTINE ALSO CONVERTS CHARACTER (BYTE) COUNTS TO WORD COUNTS, PICKING
;UP AN EXTRA CHARACTER (BYTE) IF AN ODD NUMBER OF CHARACTERS HAS BEEN
;SPECIFIED.  IF THE FUNCTION CODE IS OUT OF RANGE AN ERROR MESSAGE IS
;OUTPUT AND THE ERROR FLAG IS SET.

MTFUN:	TST	IFUN			;OFFLINE/REWIND?
	BNE	1$			; NO
	MOV	#372	,IFUN		; YES
	BR	9$
1$:	CMP	#1	,IFUN		;READ?
	BNE	2$			; NO
	MOV	#370	,IFUN		; YES
	BR	8$
2$:	CMP	#2	,IFUN		;WRITE?
	BNE	3$			; NO
	MOV	#371	,IFUN		; YES
	BR	8$
3$:	CMP	#3	,IFUN		;WRITE EOF?
	BNE	4$			; NO
	MOV	#377	,IFUN		; YES
	BR	9$
4$:	CMP	#4	,IFUN		;SPACE FORWARD?
	BNE	5$			; NO
	MOV	#376	,IFUN		; YES
	BR	9$
5$:	CMP	#5	,IFUN		;SPACE REVERSE?
	BNE	6$			; NO
	MOV	#375	,IFUN		; YES
	BR	9$
6$:	CMP	#6	,IFUN		;WRITE WITH ERG?
	BNE	7$			; NO
	MOV	#374	,IFUN		; YES
	BR	8$
7$:	CMP	#7	,IFUN		;REWIND?
	BNE	10$			; NO
	MOV	#373	,IFUN		; YES
	BR	9$
8$:	ASR	IBRC			;CONVERT BYTES
	ADC	IBRC			; TO WORDS
9$:	RTS	PC

10$:	.PRINT	#MSG04			;FUNCTION ARGUMENT ERROR
	INC	ERRFLG			;SET THE ERROR FLAG
	BR	8$
.PAGE
.SBTTL	.SPFUN ERROR HANDLER		08-AUG-77/22-FEB-82.

;THIS SUBROUTINE OUTPUTS A SUITABLE ERROR MESSAGE IF ANY OF SEVERAL
;ERROR CONDITIONS PREVAIL.

SPFERR:	TSTB	@#ERRBYT		;ERROR BYTE = 0?
	BEQ	1$			; YES
	CMPB	#1	,@#ERRBYT	;ERROR BYTE = 1?
	BEQ	3$			; YES
	BR	5$			;ERROR BYTE => 2

1$:	ASR	ERRBLK			;EOF DETECTED?
	BCC	2$			; NO
	CLR	@SAIRET			; YES
	BR	7$

2$:	.PRINT	#MSG05			;BOT/EOT ERROR
	BR	6$

3$:	CMP	#4	,ERRBLK		;TAPE WRITE PROTECTED?
	BNE	4$			; NO
	.PRINT	#MSG06			; YES
	BR	6$

4$:	CMP	#6	,ERRBLK		;SHORT BLOCK READ?
	BNE	5$			; NO
	MOV	IBRC	,@SAIRET	; YES, SO CALCULATE
	SUB	ERRBLK+2,@SAIRET	;  THE NUMBER OF BYTES
	ASL	@SAIRET			;   ACTUALLY READ
	BR	7$

5$:	.PRINT	#MSG07			;BAD TAPE OR HARDWARE ERROR
6$:	INC	ERRFLG			;SET THE ERROR FLAG
7$:	RTS	PC
.PAGE
.SBTTL	SAMPLE FORTRAN PROGRAM		09-SEP-77/20-OCT-77.

;	C     SRCDAT		AUTHOR: W L JACKLIN
;	C
;	C     CREATES DG RDOS SOURCE LANGUAGE MAG TAPE FROM DEC RT-11
;	C     FILES
;	C
;	      LOGICAL*1 FNAM(10),INRCRD(82),CR,LF
;	C
;	      DATA CR/"015/,LF/"012/
;	C
;	    1 FORMAT (' FILE NUMBER (00-99) ? ',$)
;	    2 FORMAT (I2)
;	    3 FORMAT (' "DEV:FILNAM.EXT" ? ',$)
;	    4 FORMAT (80A1)
;	C
;	      TYPE 1
;	      ACCEPT 2, LFN
;	      TYPE 3
;	      CALL ASSIGN (30,FNAM,-10)
;	      CALL TAPWRT (INRCRD,-1,LFN)
;	C
;	  100 CONTINUE
;	      READ (30,4,END=120,ERR=110) INRCRD
;	      L = LEN(INRCRD)
;	      INRCRD(N+1) = CR
;	      INRCRD(N+2) = LF
;	      CALL TAPWRT (INRCRD,L+2,LFN)
;	      GO TO 100
;	C
;	  110 CONTINUE
;	      STOP 'SRCDMT: READ ERROR'
;	C
;	  120 CONTINUE
;	      CALL TAPWRT (INRCRD,0,LFN)
;	      CALL EXIT
;	      END
.PAGE
;	      SUBROUTINE TAPWRT (CHARS,NBYTES,LFN)
;	C
;	      LOGICAL*1 CHARS(2),OUTBFR(514)
;	C
;	      EQUIVALENCE (OUTBFR(511),ICTL1),(OUTBFR(513),ICTL2)
;	C
;	      IF (NBYTES) 100,200,300
;	C
;	  100 CONTINUE
;	      IPTR = 1
;	      RETURN
;	C
;	  200 CONTINUE
;	          DO 210  I = IPTR,510
;	          OUTBFR(I) = .FALSE.
;	  210     CONTINUE
;	      ICTL1 = LFN
;	      ICTL2 = LFN
;	      CALL EXTMT (2,514,OUTBFR)
;	      CALL EXTMT (3)
;	      CALL EXTMT (3)
;	      CALL EXTMT (5,1)
;	      RETURN
;	C
;	  300 CONTINUE
;	          DO 310  I = 1,NBYTES
;	          OUTBFR(IPTR) = CHARS(I)
;	          IPTR = IPTR + 1
;	          IF (IPTR .LT. 511) GO TO 310
;	C
;	          ICTL1 = LFN
;	          ICTL2 = LFN
;	          CALL EXTMT (2,514,OUTBFR)
;	C
;	  310     CONTINUE
;	      RETURN
;	C
;	      END
.PAGE
.SBTTL	RT-11 COMMAND STRINGS		09-SEP-77/22-FEB-82.

;	.RUN SY:MACRO
;	*EXTMT[,LP:]<[TT:,DK:]EXTMT[/C/N:TTM]
;	*[CHANGE=X]
;	*[^Z^Z]
;	*^C
;
;	.RUN SY:FORTRAN
;	*SRCDAT[,LP:]<SRCDAT[/L]/U/W
;	*^C
;
;	.RUN SY:LINK
;	*SRCDAT[,LP:]<SRCDAT,EXTMT,SYSLIB[/A/W]/F
;	*^C
;
;	.SET MT [NO]ODDPAR
;	.LOAD MT
;	.RUN SRCDAT


.SBTTL	EDIT RECORD			07-JUL-81/17-JUN-82.

;05-AUG-77	ORIGINAL CREATION.
;09-SEP-77	ADDED SAMPLE FORTRAN PROGRAM AND RT-11 COMMAND STRINGS.
;10-MAY-78	FIXED A BUG.
;08-JUL-81	MADE THE ROUTINE ALSO USABLE WITH OTHER THAN UNIT ZERO
;		VIA THE ASSEMBLY SWITCH "CHANGE".  GENERALLY REORGANIZED.
;12-FEB-82	COMPLETE REWRITE USING ".SPFUN" REQUEST TO PERMIT USE OF
;		EXTMT UNDER BOTH RT-11 AND TSX-PLUS.
;19-FEB-82	ADDED THREE NULL WORDS TO DEVBLK.  ELIMINATED THE .FETCH
;		CALL.  MOVED .LOOKUP AND .SPFUN TO THE CONTROL MODULE AND
;		ELIMINATED .CLOSE.  ELIMINATED THE EXFUN ROUTINE.  REDID
;		THE SPFERR ROUTINE.
;22-FEB-82	ADDED BYTE TO WORD CONVERSION IN MTFUN.  REVISED AND
;		RESEQUENCED ERROR MESSAGES.
;17-JUN-82	FIXED A BUG IN THE CONTROL MODULE.  UPDATED THE AUTHOR'S
;		ADDRESS.


.SBTTL	END				08-AUG-77/.

FINIS:	.END