.TITLE	DBSCPY ... Database Copier
.ident	/130883/
.enabl	lc
;
;
;
;	Written by	Ray Di Marco
;			13-Aug-83
;
;
;_____________________________________________________________________________
;
;
; This is the main module for the DBSMNG cusp DBSCPY, that is used to copy
; the contents of one database into another. The program is used when
;
;	* The original database was too small and has to be extented.
;	  In such a case a new larger database is created and the contents
;	  of the old one copied into it.
;	* The database has to be rearranged. In such a case a new database
;	  which is correctly arranged is created and the contents of the
;	  old one copied into it.
;
; The fields in the new database need not be exactly the same lenght or
; type. DBSCPY actually converts the contents of the original database into
; ASCII data and then reconverts is into the form needed by the second
; database. 
; 
; This program can be envoked as a CUSP from a DBSMNG MENU program, and will
; accept commands via core common.
;
;

.SBTTL	Declarations
;
.MCALL	.PRINT,.EXIT				; RT11
.MCALL	.PURGE,.SAVEST,.REOPEN			; RT11
.MCALL	FILSPT,CNAF,ABORT			; DBSLIB
.MCALL	.PUSH,.POP				; DBSLIB
;
	FILSPT					; Initialize file support
;
;
.GLOBL	$$FORM					; pointer to template
.GLOBL	DBSLDR					; template loader
;
.GLOBL	CON.ST,CON.EX				; CONIO
.GLOBL	FILINT,FIL.DW,FIL.KW,FIL.PW		; FILEIO
.GLOBL	FIL.DR,FIL.KR,FIL.PR			; FILEIO
.GLOBL	KEY$$B,KEY.OT				; KEYGEN
.GLOBL	FRM.ZP					; FRMIO
.GLOBL	LOCFLD					; LOCFLD
.GLOBL	ASCNUM					; ASCNUM
;
;
	.PSECT	CODE				; open code area
;	======	====
;

.SBTTL	Macro Definitions
;
;
.MACRO	LOAD	OFF,REG
	MOV	$$FORM,REG
	MOV	OFF(REG),REG
.ENDM	LOAD
;
.MACRO	PRINT	STR=R0
	.GLOBL	CON.LO
	MOV	STR,R0
	CALL	CON.LO
.ENDM	PRINT
;
.MACRO	GTLIN	BUF=R0,STR
	.IF	NB,STR
		.GLOBL	CON.LO
		MOV	STR,R0
		CALL	CON.LO
	.ENDC
	MOV	BUF,R0
	.GLOBL	CON.LI
	CALL	CON.LI
.ENDM	GTLIN
;

.SBTTL	Initialization Code
;
; Initialize terminal I/O subsystem and identify self
;
START:	CALL	CON.ST				;	ensure CONIO inited
	PRINT	#M.ID				;	identify program
;
; Get name of old database
;
	GTLIN	#BUF,#M.DB1			;	get TEMPLATE name
	MOV	#BUF,R0				; R0 ->	name
	CALL	DBSLDR				;	load TEMPLATE
	MOV	16(R0),R5			; R5 ->	FDB DDB1 PAR
	MOV	FDB.BF(R5),-(SP)		;	save DB1 PARFDB
	MOV	14(R0),RECNUM			; 	save DB1 size
	MOV	#DDB1,R1			; R1 ->	descriptor block #1
	CALL	ACTIVATE			;	activate database
;
; Get name of new database
;
	GTLIN	#BUF,#M.DB2			;	get TEMPLATE name
	MOV	#BUF,R0				; R0 ->	name
	CALL	DBSLDR				;	load TEMPLATE
	MOV	14(R0),-(SP)			; 	save DB2 size
	MOV	#DDB2,R1			; R1 ->	descriptor block #2
	CALL	ACTIVATE			;	activate database
;
; If all seems ok do copy
;
	CMP	(SP)+,RECNUM			;	DB2 >= DB1?
	ABORT	<New database smaller>,LO	;	 yes -> abort
	LOAD	16,R5				; R5 ->	DB2 PARFDB
	MOV	FDB.BF(R5),R0			; R0 ->	DB2 PAR FILE DATA
	CMP	(R0)+,#1			;	CN initialized?
	BNE	4110$				;	 no --> abort
	MOV	#400-1,R2			; R2 =	loop counter
4100$:	TST	(R0)+				;	insure
4110$:	ABORT	<New database not initialized>,NE;	 rest PAR
	SOB	R2,4100$			;	  zeroed
	MOV	(SP)+,FDB.BF(R5)		;	copy PARBLK
	JMP	DOCOPY				;	copy rest
;
;

.SBTTL	Main Loop Code
;
; Insure old database selected and use R0 as loop counter
;
DOCOPY:	MOV	#DDB1,R1			;	select
	CALL	SWITCH				;	 old database
	MOV	RECNUM,R0			; R0 =	number records to copy
;
; Read in old database keys looking for non-empty records. Exit if run out
; of records.
;
1000$:	CALL	FIL.KR				;	read in keys
	TST	KEY$$B				;	record active?
	BNE	2000$				;	 yes -> copy record
1700$:	SOB	R0,1000$			;	 no --> loop
	MOV	#DDB2,R1			;	select
	CALL	SWITCH				;	 new database
	CALL	FIL.PW				;	write out par file
	JMP	CON.EX				;	exit
;
; Copy contents of non-empty record in old database into new database.
; If then find all done exit else restart operation.
;
2000$:	MOV	R0,RECNUM			;	save for later
	CALL	FIL.DR				;	read in record
	MOV	#DDB2,R1			;	select
	CALL	SWITCH				;	 new database
	MOV	$$FORM,R0			; R0 ->	TEMPLATE
	MOV	(R0),R5				; R5 ->	record
	CALL	FRM.ZP				;	zero record
	CALL	COPY				;	copy data
	MOV	RECNUM,R0			; R0 =	desired record
	CALL	FIL.DW				;	write out par file
	CALL	KEY.OT				;	write out par file
	DEC	RECNUM				;	all done?
	BNE	DOCOPY				;	 no --> do next rec
	CALL	FIL.PW				;	write out par file
	JMP	CON.EX				;	exit

;

.SBTTL	Routine - "COPY"	...	copy record
;
; Here to copy contents of database 1 record into database 2 record
; Register setup
;			R5 -> database 1 record
;			R4 -> database 1 record desciptor table
;			R3 =  loop counter
;
COPY:	MOV	DDB1,R0				; R0 ->	TEMPLATE 1
	MOV	(R0)+,R5			; R5 ->	record buffer
	MOV	(R0)+,R4			; R4 ->	RDT
	MOV	(R0)+,R3			; R3 =	number fields
;
; load BUF with ascii equivalent of contents of next field
;
1000$:	MOV	2(R4),R2			; R2 =	field size
	MOV	R5,R1				; R1 ->	record
	ADD	4(R4),R1			; R1 ->	field data
	MOVB	(R4),R0				; R0 =	field type
	DEC	R0				;	convert to base 0
	BIC	#^C3,R0				;	discard unwanted bits
	ASL	R0				;	convert to word offset
	CALL	@2000$(R0)			;	load BUF with data
;
; see if field exists in new database
;
	MOV	22(R4),R1			; R1 =	field name
	MOV	DDB2,R0				; R0 ->	TEMPLATE 2
	CALL	LOCFLD				;	locate field
	BCS	1700$				;	skip if cannot
;
; copy data in BUF into new database
;
	MOV	2(R1),R2			; R2 =	field size
	MOVB	(R1),R0				; R0 =	field type
	MOV	4(R1),R1			; R1 =	offset to field
	ADD	@DDB2,R1			; R1 ->	field
	DEC	R0				;	convert to base 0
	BIC	#^C3,R0				;	discard unwanted bits
	ASL	R0				;	convert to word offset
	CALL	@4000$(R0)			;	copy BUF into record
;
; loop until all fields copied (if possible)
;
1700$:	ADD	#40,R4				; R4 ->	next FDB
	SOB	R3,1000$			;	loop till done
	RETURN					;	bye
;
;

; The 2000$ routines will load BUF with the ascii equivalent of the data
; contained in a field. The routines are called with R1 pointing to the
; data and R2 holding the field size.
;
2000$:	.WORD	2100$,2100$,2200$,2300$		;	bin->ascii conver tab
;
; ascii field
;
2100$:	MOV	#BUF,R0				; R0 ->	buffer
2110$:	MOVB	(R1)+,(R0)+			;	copy
	SOB	R2,2110$			;	 data
	BR	2700$				;	done
;
; numeric field
;
2200$:	CALL	2600$				; R2 =	data (R1->buffer)
	CNAF	FFFFD				;	convert to ascii
	BR	2710$				;	done
;
; date field
;
2300$:	CALL	2600$				; R2 =	data (R1->buffer)
	MOV	R2,-(SP)			; 	save DATE
	BIC	#^C31.,R2			; R2 =	days
	CNAF	DD				;	convert to ascii
	MOVB	#'-,(R1)+			; 	delimiter time
	MOV	(SP),R2				; R2 =	DATE
	ASH	#-5,R2				;	move month into LOBs
	BIC	#^C15.,R2			; R2 =	month
	CNAF					;	convert to ascii
	MOVB	#'-,(R1)+			; 	delimiter time
	MOV	(SP)+,R2			; R2 =	DATE
	ASH	#-11.,R2			;	move year into LOBs
	BIC	#^C15.,R2			; R2 =	month
	ADD	#72.,R2				; 	base 1972 -> base 1900
	CNAF					;	convert to ascii
	BR	2710$				;	done
;
; load R2 with numeric data and point R1 to BUF
;
2600$:	MOVB	(R1)+,R2			; R2 =	lob
	BIC	#^C377,R2			;	discard unwanted bits
	MOVB	(R1)+,R0			; R2 =	hob
	BIC	#^C377,R0			;	discard unwanted bits
	SWAB	R0				;	meger HOB
	BIS	R0,R2				;	 and LOB
	MOV	#BUF,R1				; R1 ->	buffer
	RETURN					;	done
;
; pad out buffer with spaces
;
2700$:	MOV	R0,R1				; R1 ->	buffer
2710$:	MOVB	#40,(R1)+			;	pad
	CMP	R1,#BUFE			;	 buffer
	BLO	2710$				;	  with spaces
	CLRB	(R1)				;	NULL at end
	RETURN					;	done

; The 4000$ routines will load the ascii data in BUF into the database
; record field. The routines are called with R1 pointing to the field
; and R2 holding the field size.
;
4000$:	.WORD	4100$,4100$,4200$,4300$		;	ascii -> bin routines
;
; ascii field
;
4100$:	MOV	#BUF,R0				; R0 ->	buffer
4110$:	MOVB	(R0)+,(R1)+			;	copy
	SOB	R2,4110$			;	 data
	RETURN					;	done
;
; numeric field
;
4200$:	MOV	R1,R2				;	save field address
	MOV	#BUF,R1				; R1 ->	buffer
	CALL	ASCNUM				; R0 =	number
	MOVB	R0,(R2)+			;	save LOB
	SWAB	R0				;	save
	MOVB	R0,(R2)+			;	 HOB
	RETURN					;	done
;
; date field
;
4300$:	MOV	R1,-(SP)			;	save field address
	CLR	R2				; R2 =	accumulator
	MOV	#BUF,R1				; R1 ->	buffer
	CALL	ASCNUM				; R0 =	number
	BIC	#^C31.,R0			;	insure valid
	BIS	R0,R2				;	add to sum
	CALL	ASCNUM				; R0 =	number
	BIC	#^C15.,R0			;	insure valid
	ASH	#5,R0				;	justify
	BIS	R0,R2				;	add to sum
	CALL	ASCNUM				; R0 =	number
	BIC	#^C31.,R0			;	insure valid
	ASH	#11,R0				;	justify
	BIS	R0,R2				;	add to sum
	MOV	(SP)+,R1			; R1 ->	field
	MOVB	R2,(R1)+			;	save LOB
	SWAB	R2				;	save
	MOVB	R2,(R1)+			;	 HOB
	RETURN					;	done
;

.SBTTL	Routine - "ACTIVATE"	...	activate TEMPLATE @R0 using DDB @R1
;
; This routine is called with R0 holding the address of a template and R1
; the address of a DDB (ie 1+3*5 words of free memory). This routine will
; activate the TEMPLATE for use and at the same time store all data needed
; to reactiavate the TEMPLATE at a later time in the DDB. All registers
; are preserved.
;
;
ACTIVA:	.PUSH	<R0,R1>		;	save
	MOV	R0,$$FORM	;	point to TEMPLATE
	MOV	R0,(R1)+	;	save TEMPLATE address
	CALL	CH.FRE		;	insure channels are purged
	CALL	FILINT		;	activate TEMPLATE
	CALL	CH.SAV		;	save channel data
	CALL	CH.REO		;	reopen channels
	.POP	<R1,R0>		;	restore
	RETURN			;	all done
;

.SBTTL	Routine - "SWITCH"	...	reactivate database whose DDB is @R1
;
; This routine is called to activate the TEMPLATE whose DDB is passed in
; register R1. All registers are preserved.
;
SWITCH:	.PUSH	<R1>		;	save
	CMP	(R1),$$FORM	;	TEMPLATE already selected?
	BEQ	700$		;	 yes -> skip
	CALL	CH.FRE		;	ensure channels are free
	MOV	(R1)+,$$FORM	;	select TEMPLATE
	CALL	CH.REO		;	re-open channels
700$:	.POP	<R1>		;	restore
	RETURN			;	all done
;

.SBTTL	Primitive - "CH.FRE"	...	free channels @CHNTAB
;
; This routine is called to insure that the channels used for accessing
; the database files are free.
;
;
CH.FRE:	.PUSH	<R0,R1,R2,R3>		;	save registers
	MOV	#CHNTAB,R3		; R3 ->	channel table
	MOV	#3.,R2			; R2 =	number of channels
100$:	.PURGE	(R3)			;	purge channel
	ADD	#2,R3			;	bump channel pointer
	SOB	R2,100$			;	loop
	.POP	<R3,R2,R1,R0>		;	restore
	RETURN				;	all done
;

.SBTTL	Primitive - "CH.SAV"	...	save channel data in DDB @R1
;
; This routine is called to save the database channel data in the 
; DDB, the address of the second word of which is passed in R1.
;
;
CH.SAV:	.PUSH	<R0,R1,R2,R3>		;	save registers
	MOV	#CHNTAB,R3		; R3 ->	channel table
	MOV	#3.,R2			; R2 =	number of channels
100$:	.SAVEST	#EMTBLK,(R3),R1		;	save channel data
	ADD	#2,R3			;	bump channel pointer
	ADD	#10.,R1			; R1 ->	next channel block
	SOB	R2,100$			;	loop
	.POP	<R3,R2,R1,R0>		;	restore
	RETURN				;	all done
;

.SBTTL	Primitive - "CH.REO"	...	reopen channels with data in DDB @R1
;
; This routine is called to reopen the database channels with the data in the 
; DDB, the address of the second word of which is passed in R1.
;
CH.REO:	.PUSH	<R0,R1,R2,R3>		;	save registers
	MOV	#CHNTAB,R3		; R3 ->	channel table
	MOV	#3.,R2			; R2 =	number of channels
100$:	.REOPEN	#EMTBLK,(R3),R1		;	reopen channel
	ADD	#2,R3			;	bump channel pointer
	ADD	#10.,R1			; R1 ->	next channel block
	SOB	R2,100$			;	loop
	.POP	<R3,R2,R1,R0>		;	restore
	RETURN				;	all done
;

.SBTTL	Primitive - "ABORT"	...	abort after printing message @R1
;
;
ABORT:	.PRINT	#7000$			;	DBSCPY-fatal-
	.PRINT	R1			;	reason
	.PRINT	#7100$			;	terminate
	.EXIT				;	abort
;
.nlist	bin
7000$:	.ASCII	|DBSCPY-fatal-|<200>
7100$:	.ASCIZ	|!|
.even
.list	bin
;

.SBTTL	Data Structures
;
$$FORM::.WORD	0			; holds address of TEMPLATE
CHNTAB:	.WORD	10,11,12		; database channels
DDB1:	.BLKW	1+<3*5>			; database 1 descriptor block
DDB2:	.BLKW	1+<3*5>			; database 2 descriptor block
RECNUM:	.WORD	0			; number records
EMTBLK:	.BLKW	10			; emt argument block
;
.nlist	bin
BUF:	.BLKB	100
M.ID:	.ASCIZ	|DBSCPY-info-RDM130883|
M.DB1:	.ASCII	|            Name of old database TEMPLATE: |<200>
M.DB2:	.ASCII	|            Name of new database TEMPLATE: |<200>
BUFE:	.BYTE
.END	START