Trailing-Edge
-
PDP-10 Archives
-
decuslib20-06
-
decus/20-153/crenam.mac
There is 1 other file named crenam.mac in the archive. Click here to see a list.
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