.TITLE	SRTFOR ... SRTMNG FORTRAN Interface
.IDENT	/070782/
.ENABL	LC
;
;
;
;
;	Written by	Ray Di Marco
;			7-Jul-82.
;
;
;	Version		070782/01.
;
;
;---------------------------------------------------------------------------
;
; This module contains the SRTFOR routine that allows a FORTRAN program to
; access DBSMNG SFL type files; such files are used by the SELECT, SORTER
; and REPORT CUSPs. The module entry points are
;
; 	SRTFOR ... general entry point
; 	SRTFIN ... special initialization entry point
;
; The SRTFIN entry is a special entry point that is used to initialize the
; SRTFOR module and obtain access to the SFL file; this entry is no longer
; required (as SRTFOR may be used to perform the equivalent function); it
; is provided to maintain compatiablity with the older version of this module.
;
; The FORTRAN instruction
;
;		CALL SRTFOR (ICODE,ARG1,....,ARGn)
;
; is used to invoke the SRTFOR routine. The first argument (ICODE) is an
; opcode that determines the operation to be performed. Opcodes are supported
; to
;
;

.SBTTL	Documentation
.IF	EQ,-1


This module contains the code for the SRTFOR routine; this routine allows the
FORTRAN programmer to access and manipulate DBSMNG SFL formatted files. The
SFL files consists of a one block header followed by a number of fixed lenght
records. Such files are can be loaded with data extracted from a DBSMNG
database using the SELECT CUSP, optionally sorted using SORTER or used as
input to the REPORT, BACKUP or INSPECT CUSPs. Use of this module uses up one
RT-11 channel; this may require the allocation of more channels. 

The calling convention for the routine is

		CALL SRTFOR (ICODE,ARG1,....,ARGn)

where	ICODE	is the opcode that determines the operation to perform
	ARG?	are optional arguments

The routine attempts to trap any invalid arguments; program execution is
aborted after the outputting of a message upon the detection of an error. The
following operations may be performed 

	CALL SRTFOR (0)				rewind/reset

This operation resets the SFL file I/O subsystem. The contents of the output
buffer are output and then both the input and output stream rewound to the
first entry in the file.

	CALL SRTFOR (1)				close

This operation closes the SFL file; the contents of the output buffer are
written out and the file is then closed. (Another SFL file may then be
openned.)

	CALL SRTFOR (2,ISIZE,NUMENT,ISTS,ICHN)	return paramters

This operation returns the number of bytes per entry, and the number of
entries in the file in ISIZE and NUMENT respectively. The ISTS and ICHN
paramters are set to 0 and are supported only for compatiablity with the
earlier version of SRTFOR.

	CALL SRTFOR (3,ISIZE,NUMENT,ISTS,NME)	setup paramters

This operation sets up the header block to indicate that the file consists of
NUMENT entries, each of ISIZE bytes; the ISTS and NME arguments are ignored
and are supported for compatiablity with the earlier version of SRTFOR. 

	CALL SRTFOR (4,BUF,NUM)			read data

This operation causes BUF to be loaded with the next NUM bytes in the input
stream.

	CALL SRTFOR (5,BUF,NUM)			write data

This operation causes NUM bytes from BUF to be written to the output stream.

	CALL SRTFOR (6)				chain to SORTER

This operation results in the SFL file being closed out and a chain to the
program SORTER.SAV on device LB: being performed.

	CALL SRTFOR (7,FILNME)			chain to another program

This operation results in the SFL file being closed out and a chain to the
program whose RAD50 file spec is in FILNME being performed.

	CALL SRTFOR (8,INDEX,BUF)		peek at header block byte

This operation results in the contents of byte INDEX (first byte is number 0)
being returned in BUF.

	CALL SRTFOR (9,INDEX,VAL)		poke into header block byte

This operation results in the value VAL being stored in the byte INDEX (first
byte is number 0) of the header block.

	CALL STRFOR (10,NAME)			open SFL file

This operation results in the SFL file whose .ASCIZ name is passed in NAME
being openned and initaialized.

	CALL SRTFOR (11,NUM)			position input stream

This operation results in the SFL input stream being position so that the next
read operation will return the data sorted in entry NUM; the first entry is
number 1. 
.ENDC

.SBTTL	Declarations
;
;
.MCALL	.PRINT,.EXIT				; used for error abort
.MCALL	.CHAIN					; used for chaining
.MCALL	.PUSH,.POP				; used for stacking
.MCALL	FILSPT					; used for File I/O
	FILSPT					; setup File I/O definitions
;
.GLOBL	SRTFOR,SRTFIN				; entry points
;
.GLOBL	SFLINT,SFLEND,SFLINP,SFLOUT		; SRTFIO entries
.GLOBL	SFLRST,SFLPSN				; SRTFIO entries
.GLOBL	SFLNME,SFLPAR				; SRTFIO data structures
.GLOBL	IGETC					; OTS - gets CHANNEL
;
	JSW	= 44				; RT-11 JSW
	JSW.CH	= 400				;	chain bit
;
	.PSECT	CODE				; open code section
;	======	====
;
;
.MACRO	ERROR	TEXT
	JSR	R5,ERROR
	.ASCII	/'TEXT'/<200>
.EVEN
.ENDM	ERROR
;
;

.SBTTL	Entry - "SRTFOR"	...	DBSMNG SFL File FORTRAN inteface
;
; This code ensures that the FORTRAN caller has specified a valid OPCODE,
; and that the right number of arguments have been passed. A program ABORT
; is performed if an error is detected.
;
SRTFOR:	CMPB	(R5),#1		; 	have at least 1 args?
	BLO	1000$		;	 no -> abort
	MOV	@2(R5),R0	; R0 =	opcode
	ASH	#2,R0		; R0 =	offset equivalent to opcode
	CMP	R0,#710$-700$	;	valid offset?
	BHI	1100$		;	 no -> abort
	CMPB	(R5),700$(R0)	;	right number of arguments?
	BNE	1200$		;	 no -> abort
	TST	INITFL		;	module initialized?
	BNE	600$		;	 yes -> skip
	CMP	@2(R5),#10.	;	initialization request?
	BLO	1300$		;	 no -> abort
600$:	JMP	@700$+2(R0)	;	pass control
;
;	This table relates the opcode to the number of arguments
;	needed and the address of routine that will perform the function
;
700$:	.WORD	1,SFLRST	; 0 -> Reset/rewind SFL file
	.WORD	1,CLOSER	; 1 -> Close out SFL file
	.WORD	5,GETPAR	; 2 -> Return SFL parameters
	.WORD	5,PUTPAR	; 3 -> Store SFL parameters
	.WORD	3,GETDAT	; 4 -> Return data from SFL file
	.WORD	3,PUTDAT	; 5 -> Write data to the SFL file
	.WORD	1,CHAINS	; 6 -> Chain to SORTER program
	.WORD	2,CHAINU	; 7 -> Chain to user specified Program
	.WORD	3,PEEKHD	; 8 -> Peek at header byte
	.WORD	3,POKEHD	; 9 -> Poke into header byte
	.WORD	2,INITLZ	; 10-> Initilaize SFL file
	.WORD	2,POSITN	; 11-> position at entry
710$:				; End Of Table
;
;	Control is passed here upon the detection of an error.
;
1000$:	ERROR	<no opcode>
1100$:	ERROR	<illegal opcode>
1200$:	ERROR	<argument mismatch>
1300$:	ERROR	<SFL file not initialized>
;

.SBTTL	Routine - "GETPAR"	...	Return SRT parameters
;
; This routine returns the ENTSIZ, NUMENT, STATUS and CHN parameters
; to the caller.
;
GETPAR:	MOV	SFLPAR+00,@4(R5)	;	return ENTSIZ
	MOV	SFLPAR+02,@6(R5)	;	return NUMENT
	CLR	@10(R5)			;	STATUS = 0
	MOV	@#JSW,@12(R5)		;	Return CHN ...
	BIC	#^CJSW.CH,@12(R5)	;	... bit of JSW
	RETURN				;	all done
;
;

.SBTTL	Routine - "PUTPAR"	...	Setup SRT parameters
;
;
; This routine stores the ENTSIZ, NUMENT and NME parmeters in the SFL
; header block; the STS and NME parameters are ignored.
;
PUTPAR:	MOV	#SFLPAR,R0		; R0 =	destination
	MOV	@4(R5),(R0)+		;	setup ENTSIZ
	MOV	@6(R5),(R0)+		;	setup NUMENT
	TST	@10(R5)			;	ignore STS
	TST	12(R5)			;	ignore NME
	RETURN				;	exit
;
;

.SBTTL	Routine - "GETDAT"	...	Input @6(R5) bytes into 4(R5) buffer
;
;
; This routines inputs the speciefied number of bytes into the user buffer
;
GETDAT:	MOV	4(R5),R0		; R0 ->	buffer
	MOV	@6(R5),R1		; R1 =	number bytes wanted
	JMP	SFLINP			;	input data
;
;

.SBTTL	Routine - "PUTDAT"	...	Output @6(R5) bytes from 4(R5) buffer
;
;
; This routines outputs the speciefied number of bytes from the user buffer
;
PUTDAT:	MOV	4(R5),R0		; R0 ->	buffer
	MOV	@6(R5),R1		; R1 =	number bytes wanted
	JMP	SFLOUT			;	output data
;
;

.SBTTL	Routine - "CHAIN?"	...	Chain to other program
;
; The CHAINS and CHAINU routines cause a chain to either SORTER.SAV or a
; user specified program; the CHAINU allows the user to specify the
; program to be chained to as a RAD50, 4 word string.
;
CHAINU:	MOV	4(R5),R0		; R0 ->	name
	BR	CHAIN			;	initiate chain
CHAINS:	MOV	#1000$,R0		; R0 ->	name
	BR	CHAIN			;	initiate chain
1000$:	.RAD50	/LB SORTERSAV/		;	defaul CHAIN file
;
CHAIN:	MOV	#500,R1			; R1 ->	destination
	MOV	#10,R2			; R2 =	counter
100$:	MOVB	(R0)+,(R1)+		;	setup name ...
	SOB	R2,100$			;	... file to chain too
	CALL	SFLEND			;	close SFL file
	.CHAIN				;	initiate chain
;
;

.SBTTL	Routine - "PEEKHD"	...	Peek at byte in header block
;
; This routine allows the user to peek at any byte in the HEADER block
;
PEEKHD:	MOV	@4(R5),R0		; R0 =	offset
	BIC	#^C777,R0		;	mask unwanted bits
	MOVB	SFLPAR(R0),@6(R5)	;	return byte
	RETURN				;	exit
;
;

.SBTTL	Routine - "POKEHD"	...	Poke into byte in header block
;
; This routine allows the user to poke data into any byte in the header
; block.
;
POKEHD:	MOV	@4(R5),R0		; R0 =	offset
	BIC	#^C777,R0		;	mask unwanted bits
	MOVB	@6(R5),SFLPAR(R0)	;	update byte
	RETURN				;	exit
;
;

.SBTTL	Routine - "POSITN"	...	position at entry @4(R5)
;
;
; This routine causes the SFL input stream to be position at the specified
; entry.
;
POSITN:	MOV	@4(R5),R0		; R0 =	entry number
	CMP	R0,SFLPAR+2		;	valid entry number?
	BHI	1000$			;	 no -> abort
	JMP	SFLPSN			;	position file
1000$:	ERROR	<invalid entry number>
;
;

.SBTTL	Routine - "INITLZ"	...	Obtain access to SFL file @4(R5)
;
; This routine is called to open the SFL file whose name is passed in the
; .ASCIZ string whose address is in 2(R5). This involves copying the name
; into the SFLNME buffer and then passing control to SRTFIN.
;
INITLZ:	MOV	#SFLNME,R0		; R0 ->	destination
	MOV	4(R5),R1		; R1 =	source
100$:	MOVB	(R1)+,(R0)+		;	copy
	BNE	100$			;	 loop
	JMP	SRTFIN			;	initialize normally
;
;

.SBTTL	Routine - "SRTFIN"	...	Obtain access to SFL File
;
; This routine causes the SFL file, whose name is the the SFLNME buffer
; to be initialized for access. The routine obtains a RT-11 channel number
; for use from the FORTRAN OTS and patchs the FDB channel entry for the SFL
; file, after which it passes control to the SFLINT routine.
;
SRTFIN:	TST	INITFL			;	initialized already?
	BGT	1000$			;	 yes -> logic error
	BMI	700$			;	 only partly -> skip
	CALL	IGETC			; R0 =	channel number
	MOV	R0,SFLPAR-62+FDB.CH	;	allocate a channel
	BMI	1100$			;	negative -> abort
700$:	MOV	#1,INITFL		;	fully initialized
	JMP	SFLINT			;	open file
;
1000$:	ERROR	<already initialized>
1100$:	ERROR	<out of RT-11 channels>
;

.SBTTL	Routine - "CLOSER"	...	Close out SFL File
;
CLOSER:	MOV	#-1,INITFL		;	no file open
	JMP	SFLEND			;	cose file
;
;

.SBTTL	Primitive - "ERROR"	...	abort because of error @R5
;
;
ERROR:	.PRINT	#ERRM00		;	identify module
	.PRINT	R5		;	show cause of error
	.PRINT	#ERRM01		;	terminate message
	TRAP	0		;	abort
;
.NLIST	BIN
ERRM00:	.ASCII	<12><12><15>/SRTFOR-fatal-/<200>
ERRM01:	.ASCII	/!/<200>
.EVEN
.LIST	BIN

.SBTTL	Data area
;
	.PSECT	DATA
;	======	====
;
INITFL:	.WORD	0		;	initialized flag (1->inited)
;
;
.END