.TITLE	INSRTD
	.IDENT	/V1/
	.IDENT	/V1.1/	;27-AUG-79 DBC                                          ;DBC  1
;
;
; WRITTEN BY D.B.CURTIS
; SOFTWARE SUPPORT GROUP (R.S.)
; 24-MAY-79
; FERMILAB
;
;
; VERSION 01
; EDIT NUMBER = 0002                                                            ;DBC  1
; EDITED BY: D.B.CURTIS  27 AUG 79  13:40                                       ;DBC  1
;                                                                               ;DBC  1
; MODIFICATIONS:                                                                ;DBC  1
;                                                                               ;DBC  1
;  D.B.CURTIS  27 AUG 79                                                        ;DBC  1
;	FIXED BUG IN COPY TO PROTECT AGINST ZERO LENGTH RECORDS (IE TI--<CR>)   ;DBC  1
;	WHICH WOULD CAUSE RMS CODE TO CRASH                                     ;DBC  1
;	EDITS ARE "DBC  1"                                                      ;DBC  1
;                                                                               ;**-4
;
;
;
;                                                                               ;DBC  1
; FILE DESCRIPTION
;+
; INSRTDOC - TASK TO INSERT DOCUMENT INFORMATION INTO DATATRIVE FILE
;
;	THIS TASK IS USED TO GENERATE AND INSERT A RECORD INTO THE
;	MACRDOCS.DAT FILE FOR USE BY  DATATRIEVE.
;	IT TAKES AS INPUT A FILE FROM [17,377]NEWDOC1.TRC;N
;	WHERE EACH VERSION IS READ AND DELEATED AS THE
;	RECORD IS INSERTED
;
;	THE INPUT FILE FORMAT IS:
;
;	TP--XXXXXX 6 CHAR TYPE
;	DA--DY-MON-YR
;	TI--UP TO 80 CHARATERS
;	AU--UP TO 40 CHAR
;	FI--[G,M]FILE.EXT
;	K1-- 20 CHAR KEY
;	K2-- DITTO
;	K3-- DITTO
;	K4-- DITTO
;	K5-- DITTO
;	NM--A 4 DIGIT DOCUMENT NUMBER
;
;	STATUS IS SET TO "INTERN"
;	VERSION IS SET TO 0000
;
;	THE INPUT RECORDS MAY BE IN ANY ORDER
;	ONLY NM MUST BE PRESENT
;
;	THE OUTPUT RECORD MUST MATCH THAT OF THE DATATRIEVE
;	FILE USED  (LB:[20,25]MACRDOCS.DAT)
;
; THE DATATRIVE RECORD IS SHOWN BELOW:
;
;DEFINE RECORD DOCUMENT
; 01 DOCUMENT.
;  03 NUM PIC ZZZ9.		;0,4
;  03 REV PIC ZZZ9.		;4,4
;  03 TYPE PIC X(6).		;8,6
;  03 TITLE PIC X(80).		;14,80
;  03 AUTHOR PIC X(40).		;94,40
;  03 RAUTHOR PIC X(40).	;134,40
;  03 DATE PIC X(8).		;174,8

;  03 SEP-DAT REDEFINES DATE.
;         05 DAY PIC Z99.
;         05 MONTH PIC XXX.
;         05 YEAR PIC 99.
;  03 RDATE PIC X(8).		;182,8
;  03 RSEP-DAT REDEFINES RDATE.
;         05 RDAY PIC Z99.
;         05 RMONTH PIC XXX.
;         05 RYEAR PIC 99.
;  03 STATUS PIC X(7).		;190,7
;  03 FILE PIC X(15).		;197,15
;  03 SEP-FILE REDEFINES FILE.
;       05 GROUP PIC ZZ9.
;       05 MEMBER PIC ZZ9.
;       05 FILENAME PIC X(9).
;  03 KEY.
;    05 KEY1 PIC X(20).		;212,20
;    05 KEY2 PIC X(20).		;232,20
;    05 KEY3 PIC X(20).		;252,20
;    05 KEY4 PIC X(20).		;272,20
;    05 KEY5 PIC X(20).		;292,20
;;
;
;	THE TOTAL RECORD SIZE = 312.
;-
;
	.PAGE
	.MCALL	$FETCH,$STORE,EXIT$S,$COMPARE,SAVRG
	.MCALL	ORG$,POOL$B,$INIT,FAB$B
	.MCALL	RAB$B,$FBCAL,$RBCAL

	$FBCAL
	$RBCAL
;
; FLAGS ETC.
;
FLAG::	.WORD	0		;FLAG WORD
OPNF = 1			;INPUT FILE OPEN

OTRSZ = 312.			;RECORD SIZE FOR OUTPUT


;
; RMS FILE BLOCK FOR INPUT
;
INPUT:	FAB$B
	F$DNA	DFINNM	;DEFAULT INPUT NAME
	F$DNS	DFINSZ	;DEFAULT INPUT NAME SIZE
	F$FAC	FB$GET	;READ ACCESS
	F$LCH	1	; ???
	F$ORG	FB$SEQ	;SEQUENCUAL ACCESS
	FAB$E
	.EVEN
;
; RMS FILE BLOCK FOR OUTPUT
;
OUTPUT:	FAB$B
	F$DNA	DFOTNM	;DEFAULT OUTPUT NAME
	F$DNS	DFOTSZ	;DEFAULT OUTPUT NAME SIZE
	F$FAC	FB$PUT	;WRITE ACCESS
	F$LCH	2	; ??
	F$ORG	FB$IDX	;INDEXED ACCESSED
	FAB$E
	.EVEN

;
; RMS RECORD BLOCK FOR INPUT
;
INREC:	RAB$B
	R$FAB	INPUT	;FOR INPUT FAB
	R$RAC	RB$SEQ	;SEQUENTUAL
	R$UBF	INBUF	;INPUT BUFFER
	R$USZ	INBUFZ	;INPUT BUFFER SIZE
	RAB$E
	.EVEN
;
; RMS RECORD BLOCK FOR OUTPUT
;
OTREC:	RAB$B
	R$FAB	OUTPUT	;FOR OUTPUT FAB
	R$RAC	RB$KEY	;KEYED ACCESS
	R$UBF	WBUF	;WORK BUFFER ADDRESS
	R$USZ	WBUFS	;WORK BUFFER SIZE
	RAB$E
	.EVEN

;
; RMS DYNAMIC AREA
;
	POOL$B
	P$FAB	2
	P$RABX	1,40
	P$IDX	6
	P$RAB	1
	P$BDB	3+6
	P$BUF	2*<512.*2>*2
	POOL$E

;
; RMS REQUIREMENTS
;
	ORG$	IDX,<PUT,UPD>
	ORG$	SEQ,<GET>

;
; DEFAULT FILE NAMES
;
DFINNM:	.ASCII	/LB:[17,377]NEWDOC1.TRC;0/
DFINSZ = .-DFINNM
	.EVEN

DFOTNM:	.ASCII	/LB:[20,25]MACRDOCS.DAT/
DFOTSZ = . - DFOTNM
	.EVEN

;
; BUFFERS
;
INBUF:	.BLKB	136
INBUFZ = .-INBUF

WBUF:	.BLKB	400.
WBUFS = .-WBUF

OUTBUF:	.BLKB	400.
OUTSZ = .-OUTBUF

	.PAGE
;+
;  **-INIT-ONE TIME INITALIZATION
;
; THIS MODULE IS USED TO DO ONE TIME INITALIZATION
; THE MACRDOCS.DAT FILE IS OPENED AND MADE READY TO BE WRITTEN
; ANY OTHER ONE TIME INITALIZATION IS DONE
;
; INPUTS:
;	R3 = POINTER TO INPUT RECORD
;	R4 = POINTER TO OUTPUT RECORD
;
;
; OUTPUTS:
;	CARRY SET IF INITALIZATION FALURE
;
; SIDE EFFECTS:
;
;    MODIFIED EXTERNALS
;
;    OTHER SIDE EFFECTS
;	LB:[20,25]MACRDOCS.DAT;1 IS OPENED
;
; STANDARD REGISTER USAGE
;
;-
;
; ROUTINES CALLED
;

;
; EQUATED SYMBOLS
;

;
; LOCAL MACROS
;

;
; LOCAL DATA
;

;	V E R S I O N   A N D   S T A T U S   I N I T S
;
VER:	.WORD	8.
	.ASCII	/LL--0000/
	.EVEN

STAT:	.WORD	10.
	.ASCII	/LA--INTERN/
	.EVEN
	.PAGE
INIT::
	SAVRG				;SAVE REGISTERS
	$INIT				;INITALIZE RMS
	MOV	#OUTPUT,R0
	$OPEN	R0			;OPEN OUTPUT FILE
	$FETCH	R1,STS,R0		;GET STATUS
	BPL	1$			;IF OPENED OK CONTINUE
	NOP
	SEC
	BR	2$
1$:	$CONNECT R4			;CONNECT TO OUTPUT RECORD
2$:	RETURN
	.PAGE
;+
;  **-INIT1-INPUT FILE INITALIZATION
;
; THIS ROUTINE IS USED TO CLEAN UP ANY PAST OPERATIONS
; IT OPENS THE OLDEST VERSION OF THE NEWDOC.TRC FILE
; IT PROCESSES THAT FILE TILL IT IS FINISHED
; AND THEN DELETES THAT FILE.
; THIS CONTINUES TILL ALL VERSIONS OF THE INPUT FILES ARE
; DELETED.
;
; INPUTS:
;	R3 = POINTER TO INPUT RECORD
;	R4 = POINTER TO OUTPUT RECORD
;
; OUTPUTS:
;	CARRY SET IF NO FILE
;
; SIDE EFFECTS:
;
;    MODIFIED EXTERNALS
;
;    OTHER SIDE EFFECTS
;	THE CURRENT INPUT FILE IS CLOSED AND DELETED
;	THE NEXT INPUT FILE IS OPENED
;	THE PROCESSING FILE FLAG IS SET
;
; STANDARD REGISTER USAGE
;
;-
;
; ROUTINES CALLED
;

;
; EQUATED SYMBOLS
;

;
; LOCAL MACROS
;

;
; LOCAL DATA
;
	.PAGE
INIT1::
	SAVRG			;SAVE REGISTERS
	BIT	#OPNF,FLAG		;CHECK IF A FILE IS OPEN
	BEQ	1$
	BIC	#OPNF,FLAG		;SHOW CLOSING FILE
	$DISCONNECT R3			;DISCONNECT FROM FILE
	MOV	#INPUT,R0
	$CLOSE	R0			;CLOSE INPUT FILE
	$ERASE	R0			;AND DELETE IT
	$FETCH	R1,STS,R0		;GET STATUS
	BPL	1$
	SEC
	BR	100$


1$:	$OPEN	#INPUT			;OPEN INPUT FILE
	BCS	100$			;IF ERROR ON FILE EXIT

	$CONNECT R3			;CONNECT TO IT
	BIS	#OPNF,FLAG		;SET FILE OPEN
	MOV	#OUTBUF,R0		;SET OUTPUT BUFFER TO BLANKS
	MOV	#OUTSZ,R1
10$:	MOVB	#' ,(R0)+
	SOB	R1,10$
100$:	RETURN
	.PAGE
;+
;  **-START-BASIC PROGRAM LOOP
;
;
; INPUTS:
;	NONE
;
; OUTPUTS:
;	NONE
;
; SIDE EFFECTS:
;
;    MODIFIED EXTERNALS
;
;    OTHER SIDE EFFECTS
;	NONE
;
; REGISTER USAGE:
;	R0,R1,R2 MAY CHANGE
;	R3 = POINTER TO INPUT RECORD
;	R4 = POINTER TO OUTPUT RECORD
;
;-
;
; ROUTINES CALLED
;

;
; EQUATED SYMBOLS
;

;
; LOCAL MACROS
;

;
; LOCAL DATA
;
	.PAGE
START::
	MOV	#OTREC,R4		;GET OUTPUT FILE ADDRESS
	MOV	#INREC,R3		;GET INPUT FILE ADDRESS
	CALL	INIT			;INITALIZE THINGS
	BCC	RSTRT			;IF OK DO FILE INITALIZATION
	JMP	EXIT			;ELSE LEAVE BUT ADD MESSAGE SOME DAY

RSTRT:	CALL	INIT1			;INITALIZE INPUT FILES
	BCC	1$			;IF OK CONTINUE ELSE
	JMP	EXIT			;ALL DONE SO EXIT

1$:	$GET	R3			;READ RECORD
	$COMPARE #ER$EOF,STS,R3		;CHECK FOR EOF
	BEQ	2$			;IF SO CLEAN UP FILE AND PUT RECORD
	$COMPARE #0,STS,R3		;SOME OTHER ERROR
	BPL	10$			;COMPARE GENERATES A TST INST
	JMP	EXIT

10$:	$FETCH	R0,RBF,R3		;GET THE BUFFER ADDRESS
	$FETCH	R1,RSZ,R3		;GET THE RECORD SIZE
	CALL	PROCES			;PROCESS THE RECORD
	BR	1$			;CONTINUE

2$:	MOV	#VER,R0			;INITALIZE THE VERSION
	MOV	(R0)+,R1		;GET CHARATERS
	CALL	PROCES			;AND PROCESS IT
	MOV	#STAT,R0		;ALSO DO STATUS
	MOV	(R0)+,R1
	CALL	PROCES

	$STORE	#OTRSZ,RSZ,R4		;LOAD THE RECORD SIZE
	$STORE	#OUTBUF,RBF,R4		;GET THE RECORD ADDRESS
	$PUT	R4			;WRITE THE CONSTRUCTED DTATRIVE REC
	$FETCH	R0,STS,R4		;GET THE STATUS
	BPL	20$
	NOP
	BR	EXIT
20$:	JMP	RSTRT

EXIT:	$DISCONNECT R4			;DISCONNECT FROM OUTPUT FILE
	$CLOSE	#OUTPUT			;CLOSE THE FILE
	EXIT$S



	.PAGE
;+
;  **-PROCES-PROCESSES AN INPUT LINE
;
; THIS MODULE PROCESSES AN INPUT LINE
; AND PLACES THE DATA IN THE OUTPUT RECORD
;
; INPUTS:
;	R0 = POINTER TO INPUT LINE
;	R1 = NUMBER OF CHARATERS IN THE INPUT LINE
;
; OUTPUTS:
;	CARRY SET IF LINE ILLEGAL CLEAR OTHERWISE
;
; SIDE EFFECTS:
;
;    MODIFIED EXTERNALS
;
;    OTHER SIDE EFFECTS
;	THE LINE IS DECODED, AND THE DATA IS PLACED IN THE INPUT RECORD
;
; STANDARD REGISTER USAGE
;
;-
;
; ROUTINES CALLED
;

;
; EQUATED SYMBOLS
;

;
; LOCAL MACROS
;

;
; LOCAL DATA
;
TEMP:	.BLKW	20
NUNP:	.BLKB	6		;NUMBER STORAGE

;
;	C O M M A N D S
;
COM:	.WORD	NUMC		;GET NUMBER OF COMMANDS
	.ASCII	/TP/		; TYPE 0
	.ASCII	/DA/		; TYPE 1
	.ASCII	/TI/		; TYPE 2
	.ASCII	/AU/		; TYPE 3
	.ASCII	/FI/		; TYPE 4
	.ASCII	/K1/		; TYPE 5
	.ASCII	/K2/		; TYPE 6
	.ASCII	/K3/		; TYPE 7
	.ASCII	/K4/		; TYPE 8
	.ASCII	/K5/		; TYPE 9
	.ASCII	/NM/		; TYPE 10
	.ASCII	/LL/		; TYPE 11
	.ASCII	/LA/		; TYPE 12
NUMC = <.-COM>/2 - 1

;
;	P L A C E M E N T   A N D   S I Z E
;
PLSZ:	.WORD	8.,6
	.WORD	174.,8.
	.WORD	14.,80.
	.WORD	94.,40.
	.WORD	197.,15.
	.WORD	212.,20.
	.WORD	232.,20.
	.WORD	252.,20.
	.WORD	272.,20.
	.WORD	292.,20.
	.WORD	0,4
	.WORD	4,4
	.WORD	190.,7

	.PAGE
PROCES::
	SAVRG				;SAVE REGISTERS
	MOV	#COM,R3			;GET ADDRESS OF THE COMMAND TABLE
	MOV	(R3)+,R4		;GET NUMBER OF COMMANDS
	MOV	(R0)+,R5		;GET COMMAND
1$:	CMP	R5,(R3)+		;CHECK COMMAND
	BEQ	2$
	SOB	R4,1$
	SEC
	JMP	100$

2$:	CMP	#"--,(R0)+		;CHECK VALID FORMAT
	BEQ	3$
	SEC
	JMP	100$

3$:	SUB	#4,R1			;ADJUST NUMBER OF CHAR IN LINE
	SUB	#COM+4,R3		; GENERATE OFFSET IN TO PLSZ
	ASL	R3			; MAKE DOUBLE WORD INDEX
	ADD	#PLSZ,R3		; NOW GEN POINTER TO FIELD DISCRIIPTION
	MOV	COM,R5			;GENERATE DISPATCH
	SUB	R4,R5
	ASL	R5			;ADJUST INDEX
	CALL	@4$(R5)
	RETURN

4$:	.WORD	COPY,20$,COPY,COPY,50$,COPY,COPY,COPY,COPY,COPY,30$
	.WORD	COPY,COPY
20$:
	MOV	#TEMP,R5		;GET POINTER TO TEMP
	MOVB	#' ,(R5)+		;PUT IN LEADING SPACE
	CALL	$CDTB			;CONVERT
	MOV	R0,-(SP)		;SAVE
	MOV	#NUNP,R0		;POINT TO NUMBER AREA
	MOV	#1,R2			;WANT ZEROS
	CALL	$CBDMG			;CONVERT TO ASCII
	MOVB	NUNP+3,(R5)+		;MOVE 2 LOWORDER VALUES
	MOVB	NUNP+4,(R5)+
	MOV	(SP)+,R0		;MOVE DATE
	NOP
	MOVB	(R0)+,(R5)+
	MOVB	(R0)+,(R5)+
	MOVB	(R0)+,(R5)+
	INC	R0			;SKIP "-"
	CALL	$CDTB			;GET THE YEAR
	MOV	#NUNP,R0
	MOV	#1,R2			;WANT ZEROS
	CALL	$CBDMG			;CONVERT
	MOVB	NUNP+3,(R5)+		;TRANSFER DATE
	MOVB	NUNP+4,(R5)+
	MOV	#TEMP,R0
	MOV	#8.,R1
	JMP	COPY
30$:
	MOV	R0,R2			;PLACE TERMINATOR AFTER NUMBER
	ADD	R1,R2
	MOVB	#' ,(R2)		;PLACED SPACE
	CALL	$COTB			;CONVERT THE NUMBER
	MOV	#TEMP,R0		;USE TEMP BUFFER
	MOV	#1,R2			;NO ZERO SUPPRESS
	CALL	$CBOMG			;CONVERT AGAIN IN STANDARD FORMAT
	MOV	#TEMP+2,R0		;GET THE START OF THE CHAR
	MOV	#4,R1			;AND THE NUMBER TO TRANSFER
	JMP	COPY			;AND COPY THE NUMBER

50$:
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	#TEMP,R5		;GET ADDRESS TO GENERATE NAME
	INC	R0			;SKIP "["
	CALL	$COTB			;CONVERT
	MOV	R0,-(SP)
	MOV	#1,R2
	MOV	#NUNP,R0		;POINT TO NUMBER AREA
	CALL	$CBOMG			;CONVERT IT BACK
	MOVB	NUNP+3,(R5)+		;TRANSFER THE NUMBER
	MOVB	NUNP+4,(R5)+
	MOVB	NUNP+5,(R5)+
	MOV	(SP)+,R0		;GET THE NEXT NUMBER
	CALL	$COTB
	MOV	R0,-(SP)		;SAVE POINTER TO INPUT AGAIN
	MOV	#NUNP,R0		;POINT TO WORK SPACE
	MOV	#1,R2
	CALL	$CBOMG
	MOVB	NUNP+3,(R5)+
	MOVB	NUNP+4,(R5)+
	MOVB	NUNP+5,(R5)+
	MOV	(SP)+,R0		;GET CURRENT ADDRESS
	MOV	(SP)+,R1		;GET ORIGINAL NUMBER OF CHAR
	SUB	R0,R1			;REMOVE CURRENT ADDRESS
	ADD	(SP)+,R1		;NOW HAVE NUMBER YET TO TRANSFER
55$:	MOVB	(R0)+,(R5)+
	SOB	R1,55$

	MOV	R5,R1			;GENERATE NUMBER TO COPY
	MOV	#TEMP,R0		;GET START OF BUFFER
	SUB	R0,R1
	CALL	COPY
100$:	RETURN
;
;+ COPY
; MOVES INPUT RECORD FROM INPUT BUFFER TO OUTPUT BUFFER
;
; INPUT
;	R0 = POINTER TO INPUT LINE
;	R1 = NUMBER OF CHAR TO TRANSFER
;	R3 = POINTER TO FIELD DISCRIPTION
;
;-
COPY:	SAVRG
	MOV	(R3)+,R5		;GET POSITION
	MOV	(R3),R4			;AND GET COUNT
	CMP	R4,R1			;CHECK IF COUNT IS IN LIMIT
	BHIS	2$                                                              ;DBC  1
	MOV	R4,R1			;UPDATE R1 TO BE LEGAL                  ;DBC  1
2$:	SUB	R1,R4			;GENERATE NUMBER OF SPACES FILLER       ;DBC  1
	ADD	#OUTBUF,R5		;POINT TO FIELD                         ;DBC  1
	TST	R1			;CHECK FOR 0 LENGTH                     ;DBC  1
	BEQ	1$			;AND IF SO SKIP FILL                    ;DBC  1
3$:	MOVB	(R0)+,(R5)+		;MOVE FIELD                             ;DBC  1
	SOB	R1,3$                                                           ;DBC  1
1$:	TST	R4			;CHECK IF NO FILL                       ;DBC  1
	BEQ	5$			;IF NONE SKIP FILL                      ;**-7
4$:	MOVB	#' ,(R5)+		;CLEAR OUT REST OF BUFFER
	SOB	R4,4$
5$:
	RETURN

	.END	START