TITLE	CRENAM
	SUBTTL	RENAME-FILE-VIA-COBOL, HH/DEC/1-6-75

;
;	THE RUNNING PROCEDURE:
;	
;	.LOAD PROGRM.CBL,CRENAM.MAC
;
;	.SAVE PROGRM
;
;	.RUN PROGRM
;	...
;	...
;	...
;
;
;	COBOL PROGRAM(THE CALLING PROGRAM - PROGRM.CBL):
;
;	IN WORKING-STORAGE:
;	*	THE RENAME-BLK MUST BE IN THIS FORM...
;	01 RENAME-BLOCK.
;	02 RENAM-TST PIC 9(4) COMP VALUE ZEROS.
;	02 OLD-FILE DISPLAY-6.
;	  03 OLD-NAME PIC X(6).
;	  03 OLD-EXT PIC X(3).
;	  03 FILLER PIC X(3).
;	02 NEW-FILE DISPLAY-6.
;	  03 NEW-NAME PIC X(6).
;	  03 NEW-EXT PIC X(3).
;	  03 FILLER PIC X(3).
;
;	IN PROCEDURE DIVISION:
;	...
;	ENTER MACRO CRENAM USING RENAME-BLOCK.
;	IF (RENAM-TST = 0) GO TO OKAY.
;	MOVE ZERO TO RENAM-TST.
;	DISPLAY ' CANNOT RENAME ', OLD-FILE, ' !'.
;	...
;	OKAY.
;	...
;
;	IN CRENAM:
;	1)  GET PARAMETERS FROM THE CALLING PROGRAM
;	2)  OPEN DEVICE, LOOKUP OLD-FILE, RENAME AND THEN, RELEASE
;	3)  RETURN TO THE CALLING PROGRAM( WITH ERROR-FLAG, IF ANY)
;
;	REGISTERS:
	AC5=5
	PP=17

	CHAN==17	;USE LAST CHAN#

	ENTRY CRENAM
;
;
	XWD	0,.+3
SAVAC:	XWD	0,.+2	;SAVE ALL ACS
	XWD	.+1,0
	BLOCK	17
;
;
CRENAM:
	EXCH	PP,SAVAC
	BLT	PP,SAVAC+20	;SAVE ALL REG'S
	MOVE	PP,SAVAC
; TO GET PARAMETERS
GPARAM:	MOVE	AC5,@(16)	;RENAME-BLOCK
	MOVE	4,1(5)	;OLD-FILE NAME
	MOVEM	4,OLDBLK
	MOVE	4,2(5)	;OLD-EXT
	HLLM	4,OLDBLK+1
	MOVE	4,3(5)	;NEW FILE NAME
	MOVEM	4,NEWBLK
	MOVE	4,4(5)	;NEW-EXT
	HLLM	4,NEWBLK+1
;  TO INITIALIZE THE DEVICE(OPEN)
OPNCR:	OPEN	CHAN,OPNBLK	;USING CHANNEL (#17)
	JRST	CRERR	;ERROR RETURN
LKPCR:	LOOKUP	CHAN,OLDBLK
	JRST	CRERR
	GETPPN	4,		;GET PPN USED
	JFCL
	MOVEM	4,NEWBLK+3
	MOVE	4,OLDBLK+2	;PROTECTION CODE
	MOVEM	4,NEWBLK+2
	HRRZ	4,OLDBLK+1
	HRRM	4,NEWBLK+1
;  RENAME THE FILE
RENCR:	RENAME	CHAN,NEWBLK
	JRST	CRERR
	JRST	RLSCR
;
CRERR:	MOVEI	4,1	;SET ERROR FLAG
	MOVEM	4,(5)	;IN RENAM-TST OF RENAME-BLOCK
; RELEASE DEVICE, FREE CHANNEL (#17)
RLSCR:	RELEASE	17,
;
;  RETURN TO CALLING COBOL PROGRAM
RETCBL:	MOVE	PP,SAVAC+1	;RESTORE REG'S(ACS)
	BLT	PP,16
	MOVE	PP,SAVAC-1
	EXCH	PP,SAVAC	;RESTORE PP & SAVAC
	POPJ	PP,
;  DATA AREA...
OLDBLK:	BLOCK	4	;OLD NAME
			;EXT + ETC.
			;PROT + ETC.
			;PPN
;
;
NEWBLK:	BLOCK	4	;NEW NAME
			;EXT + ETC.
			;PROT + ETC.
			;PPN
;
;
OPNBLK:	14
	SIXBIT	/DSK/
	XWD	0,0
;
;
	END