.TITLE RMS$UTILITIES ;----------------------------------------------------------------------; ; SUBROUTINE: RMS$UTILITIES ; ;----------------------------------------------------------------------; ; LANGUAGE: VAX-11 MACRO ASSEMBLY LANGUAGE ; ; SYSTEM: VAX-11/780 ; ; MOSTEK CORPORATION ; ; COMPUTER AIDS TO DESIGN DIVISION ; ; 1215 WEST CROSBY ROAD ; ; CARROLLTON, TEXAS 75006 ; ; (214) 323-8813 ; ;----------------------------------------------------------------------; ; PROGRAMMER: KEVIN KLUGHART ; ;----------------------------------------------------------------------; ; DATE: 03-20-81 @ 06:00 CDST ; ;----------------------------------------------------------------------; ; PURPOSE: THIS IS A UTILITY SOFTWARE PACKAGE DESIGNED TO ; ; PROVIDE A UNIFORM AND CONSISTENT METHOD OF ; ; INTERFACING THE VAX/VMS RECORD MANAGEMENT ; ; SYSTEM (RMS) WITH THE GENERAL VAX FORTRAN OR ; ; COBOL APPLICATIONS PROGRAM. THIS PACKAGE ; ; EXTENDS THE HIGHER LEVEL LANGUAGE CAPABILITIES ; ; WITH RESPECT TO FILE MANAGEMENT AND INQUIRY. ; ; THE CURRENTLY SUPPORTED FUNCTIONS ARE: ; ; ; ; RMS$COPY - COPYS A FILE FROM A GIVEN FILE ; ; SPECIFICATION TO ANOTHER FILE ; ; SPECIFICATION USING BLOCK I/O ; ; RMS TRANSFERS, WHICH ARE ; ; TYPICALLY 30 TIMES FASTER THAN ; ; NORMAL RECORD I/O PROCESSING. ; ; ; ; RMS$EXPAND - EXPANDS A GIVEN FILE NAME INTO ; ; A FULLY QUALIFIED VAX/VMS FILE ; ; SPECIFICATION. THIS ROUTINE ; ; IS EQUIVALENT TO A CALL TO ; ; RMS$PARSE FOLLOWED BY A CALL TO ; ; RMS$SEARCH. ; ; ; ; RMS$PARSE - PARSES A GIVEN FILE NAME AND ; ; CHECKS FOR SYNTAX ERRORS, ETC. ; ; PREPARS FOR WILDCARD FILENAME ; ; PROCESSING BY RMS$SEARCH ; ; ; ; RMS$SEARCH - SEARCHES FOR THE FIRST FILENAME ; ; MATCHING THE WILDCARD SPECS ; ; DEFINED IN RMS$PARSE. SUBSEQUENT ; ; CALLS YIELD THE REMAINING FILE ; ; NAMES WHICH SATISFY THE WILDCARD ; ; SPECIFICATIONS. ; ; ; ; RMS$UIC - PRESETS THE OWNER UIC FOR A FILE ; ; WHICH IS TO BE CREATED BY ; ; RMS$CREATE IN CONJUNCTION WITH ; ; THE FORTRAN 'USEROPEN' FILE OPEN ; ; KEYWORD. ALSO USED IN RMS$COPY. ; ; ; ; RMS$CREATE - USED IN CONJUNCTION WITH THE ; ; FORTRAN 'USEROPEN' FILE OPEN ; ; KEYWORD TO PROVIDE A METHOD OF ; ; CREATING FILES WITH SPECIAL ; ; CHARACTERISTICS. IN THIS CASE ; ; THE UIC AND FILE PROTECTION MASK ; ; ARE MODIFIED. ; ;----------------------------------------------------------------------; ; NOTE: THIS PACKAGE IS INTENDED FOR LOCAL MOSTEK ; ; USE AND DESIGNED FOR FUTURE EXPANSION OF THE ; ; RMS TO HIGHER LEVEL LANGUAGE INTERFACE. ; ;----------------------------------------------------------------------; ; REFERENCES: THE INTERFACE SPECIFICATION FOR THE FORTRAN ; ; 'USEROPEN' KEYWORD MAY BE FOUND IN THE VAX-11 ; ; COMMON RUN-TIME PROCEDURE LIBRARY REFERENCE ; ; MANUAL, APPENDIX F. ; ;----------------------------------------------------------------------; .PAGE .SBTTL LOCAL SYMBOLS ;----------------------------------------------------------------------; ; ; ; LOCAL SYMBOLS ; ; ; ;----------------------------------------------------------------------; ; DEFINE OFTEN USED CHARACTERS ; ;----------------------------------------------------------------------; BLANK= 32. ; DEFINE ASCII BLANK FOR STRING PAD BLOCK= 512. ; DEFINE NUMBER OF BYTES/BLOCK BUFCNT= 16. ; DEFINE NUMBER OF BLOCKS IN LOCAL BUFFER BUFSIZ= BUFCNT*BLOCK ; DEFINE LOCAL BUFFER SIZE .PAGE .SBTTL RMS DATA STRUCTURES ;----------------------------------------------------------------------; ; ; ; RMS DATA STRUCTURES ; ; ; ;----------------------------------------------------------------------; ; DEFINE FILE ACCESS BLOCK OFFSETS ; ;----------------------------------------------------------------------; .PSECT RMS_TABLES NOEXE,RD,WRT,LONG .ALIGN LONG $FABDEF $RMSDEF ;----------------------------------------------------------------------; ; DEFINE FILE ACCESS BLOCK (FAB) FOR FILE ; ;----------------------------------------------------------------------; ; THIS FAB BLOCK IS FOR SEQUENTIAL I/O ; ;----------------------------------------------------------------------; .ALIGN LONG FABBLK: $FAB FOP=, -; OPEN BY NAME BLOCK AND NAM=NAMBLK ; ADDRESS OF NAME BLOCK ;----------------------------------------------------------------------; ; THESE FAB BLOCKS ARE FOR BLOCK I/O COPIES ; ;----------------------------------------------------------------------; .ALIGN LONG FABINP: $FAB FAC= ; BLOCK I/O ONLY ALLOWED .ALIGN LONG FABCPY: $FAB FOP=, - ; CREATE CONGIGUOUS IF POSSIBLE FAC=, -; BLOCK I/O ONLY ALLOWED XAB=XABPRO ; DEFINE PROTECTION FIELDS ;----------------------------------------------------------------------; ; DEFINE FILE NAME BLOCK ; ;----------------------------------------------------------------------; ; DEFINE FNB FOR RECORD I/O ; ;----------------------------------------------------------------------; .ALIGN LONG NAMBLK: $NAM RSA=RESNAM, - ; RESULT NAME ADDRESS RSS=NAM$C_MAXRSS, - ; RESULT NAME SIZE ESA=EXPNAM, - ; EXPANDED NAME ADDRESS ESS=NAM$C_MAXRSS ; EXPANDED NAME SIZE ;----------------------------------------------------------------------; ; DEFINE RECORD ACCESS BLOCK FOR BLOCK I/O ; ;----------------------------------------------------------------------; .ALIGN LONG RABINP: $RAB FAB=FABINP, - ; USE INPUT BLOCK I/O FAB ROP=BIO, - ; BLOCK I/O ONLY UBF=CPYBUF, - ; BUFFER ADDRESS USZ=BUFSIZ ; BUFFER SIZE .ALIGN LONG RABCPY: $RAB FAB=FABCPY, - ; USE BLOCK I/O FAB ROP=BIO, - ; BLOCK I/O ONLY RBF=CPYBUF, - ; RECORD BUFFER RSZ=BUFSIZ ; RECORD SIZE ;----------------------------------------------------------------------; ; DEFINE BUFFERS NECESSARY FOR NAME BLOCK ; ;----------------------------------------------------------------------; ; DEFINE USER FILE SPECIFICATION BUFFER ; ;----------------------------------------------------------------------; .ALIGN LONG FILNAM: .BLKB NAM$C_MAXRSS ; DEFINE USER FILE SPECIFICATION BUFFER ;----------------------------------------------------------------------; ; DEFINE RESULT FILENAME BUFFER ; ;----------------------------------------------------------------------; .ALIGN LONG RESNAM: .BLKB NAM$C_MAXRSS ; DEFINE RESULT FILENAME BUFFER ;----------------------------------------------------------------------; ; DEFINE EXPANDED FILENAME BUFFER ; ;----------------------------------------------------------------------; .ALIGN LONG EXPNAM: .BLKB NAM$C_MAXRSS ; DEFINE EXPANDED FILENAME BUFFER ;----------------------------------------------------------------------; ; ; ; DEFINE EXTENDED ATTRIBUTE BLOCK STRUCTURES ; ; ; ;----------------------------------------------------------------------; ; DEFINE XABPRO FILE PROTECTION BLOCK FOR FILE TO BE CREATED ; ;----------------------------------------------------------------------; .ALIGN LONG XABPRO: $XABPRO UIC=<0,0>, - ; DEFINE UIC BLOCK NXT=0 ; END OF XAB CHAIN ;----------------------------------------------------------------------; ; ; ; DEFINE BLOCK COPY BUFFER ; ; ; ;----------------------------------------------------------------------; CPYBUF: .BLKB BUFSIZ ; MAXIMUM RECORD LENGTH .PAGE .SBTTL RMS$COPY ;----------------------------------------------------------------------; ; ; ; ; ; RMS$COPY ; ; ; ; ; ;----------------------------------------------------------------------; ; THIS SUBROUTINE COPYS ONE FILE TO ANOTHER USING BLOCK I/O ; ; COPY WHICH IS CONSIDERABLY FASTER THAN A RECORD I/O COPY. ; ;----------------------------------------------------------------------; ; ARGUMENTS: 4(AP) - ADDRESS OF STRING DESCRIPTOR WHICH ; ; CONTAINS THE SOURCE USER FILENAME ; ; ; ; 8(AP) - ADDRESS OF STRING DESCRIPTOR WHICH ; ; CONTAINS THE DESTINATION USER FILENAME ; ; ; ; 12(AP) - ADDRESS OF A LONGWORD TO RECEIVE THE ; ; NUMBER OF BLOCKS COPIED. ; ; ; ; NOTE THAT THE COMPLETION STATUS IS RETURNED IN ; ; REGISTER R0 AND THAT ON A WRITE ERROR CONDITION, ; ; THE INPUT AND OUTPUT FILES ARE CLOSED BUT NOT ; ; DELETED. ; ;----------------------------------------------------------------------; ; NOTE THAT RMS$UIC MAY BE CALLED PRIOR TO RMS$COPY TO SET THE ; ; UIC OF THE FILE CREATED BY THIS SUBROUTINE. ; ;----------------------------------------------------------------------; ; PROCESS THE INPUT FILE SPECIFICATION ; ;----------------------------------------------------------------------; .PSECT RMS$COPY PIC,REL,LCL,NOSHR,EXE,RD,NOWRT .ENTRY RMS$COPY,^M ;----------------------------------------------------------------------; ; INITIALIZE THE BLOCKS TRANSFERRED COUNTER ; ;----------------------------------------------------------------------; CLRL @12(AP) ; CLEAR TRANSFER COUNTER ;----------------------------------------------------------------------; ; FILE ACCESS BLOCK INITIALIZATION ; ;----------------------------------------------------------------------; $FAB_STORE - ; INITIALIZE INPUT FAB FAB=FABINP, - ; SPECIFY FAB ADDRESS FAC= ; BLOCK I/O ONLY ALLOWED $FAB_STORE - ; INITIALIZE OUTPUT FAB FAB=FABCPY, - ; SPECIFY FAB ADDRESS FOP=, - ; CREATE CONTIGUOUS IF POSSIBLE FAC=, - ; BLOCK I/O ONLY ALLOWED XAB=XABPRO ; DEFINE PROTECTION FIELDS ;----------------------------------------------------------------------; ; RECORD ACCESS BLOCK INITIALIZATION ; ;----------------------------------------------------------------------; $RAB_STORE - ; INITIALIZE INPUT RAB RAB=RABINP, - ; SPECIFY RAB ADDRESS FAB=FABINP, - ; SPECIFY INPUT FAB ROP=BIO, - ; BLOCK I/O ONLY UBF=CPYBUF, - ; BUFFER ADDRESS USZ=#BUFSIZ ; BUFFER SIZE $RAB_STORE - ; INITIALIZE OUTPUT FAB RAB=RABCPY, - ; SPECIFY RAB ADDRESS FAB=FABCPY, - ; SPECIFY OUTPUT FAB ROP=BIO, - ; BLOCK I/O ONLY RBF=CPYBUF, - ; RECORD BUFFER RSZ=#BUFSIZ ; RECORD SIZE ;----------------------------------------------------------------------; ; COPY INPUT FILE SPECIFICATION DESCRIPTOR TO INPUT FAB ; ;----------------------------------------------------------------------; MOVL 4(AP),R1 ; GET ADDRESS OF DESCRIPTOR MOVB (R1),FABINP+FAB$B_FNS ; STORE LENGTH OF FILESPEC MOVL 4(R1),FABINP+FAB$L_FNA ; STORE ADDRESS OF FILESPEC ;----------------------------------------------------------------------; ; COPY OUTPUT FILE SPECIFICATION DESCRIPTOR TO OUTPUT FAB ; ;----------------------------------------------------------------------; MOVL 8(AP),R1 ; GET ADDRESS OF DESCRIPTOR MOVB (R1),FABCPY+FAB$B_FNS ; STORE LENGTH OF FILESPEC MOVL 4(R1),FABCPY+FAB$L_FNA ; STORE ADDRESS OF FILESPEC ;----------------------------------------------------------------------; ; OPEN THE INPUT FILE FOR BLOCK I/O ; ;----------------------------------------------------------------------; $OPEN FAB=FABINP ; OPEN INPUT FILE CMPL #RMS$_NORMAL,R0 ; CHECK FOR SUCCESS BNEQU 10$ ; EXIT ON ERROR $CONNECT RAB=RABINP ; CONNECT STREAM CMPL #RMS$_NORMAL,R0 ; CHECK FOR SUCCESS BNEQU 10$ ; EXIT ON ERROR ;----------------------------------------------------------------------; ; OPEN THE OUTPUT FILE FOR BLOCK I/O ; ;----------------------------------------------------------------------; ; LOAD THE OUTPUT FILE FAB WITH INPUT FILE SPECIFICATIONS ; ;----------------------------------------------------------------------; MOVB FABINP+FAB$B_RAT,FABCPY+FAB$B_RAT ; SET REC ATTRIBUTES MOVB FABINP+FAB$B_RFM,FABCPY+FAB$B_RFM ; SET REC FORMAT ;----------------------------------------------------------------------; ; NOW CREATE THE OUTPUT FILE ; ;----------------------------------------------------------------------; $CREATE FAB=FABCPY ; CREATE OUTPUT FILE CMPL #RMS$_NORMAL,R0 ; CHECK FOR SUCCESS BNEQU 10$ ; EXIT ON ERROR $CONNECT RAB=RABCPY ; CONNECT STREAM CMPL #RMS$_NORMAL,R0 ; CHECK FOR SUCCESS BEQLU 20$ ; EXIT ON ERROR ;----------------------------------------------------------------------; ; ; ; ERROR TRAP FOR $OPEN, $CREATE, AND $CONNECT RMS REQUESTS ; ; ; ;----------------------------------------------------------------------; 10$: RET ; RETURN TO USER ;----------------------------------------------------------------------; ; READ A BLOCK FROM INPUT FILE SPECIFICATION ; ;----------------------------------------------------------------------; 20$: MOVL @12(AP),RABINP+RAB$L_BKT ; SET INPUT BLOCK NUMBER MOVL @12(AP),RABCPY+RAB$L_BKT ; SET OUTPUT BLOCK NUMBER $READ RAB=RABINP ; READ A BLOCK CMPL #RMS$_NORMAL,R0 ; CHECK FOR SUCCESS BNEQU 30$ ; CHECK EOF ON ERROR ;----------------------------------------------------------------------; ; WRITE A BLOCK TO OUTPUT FILE SPECIFICATION ; ;----------------------------------------------------------------------; ; TRANSFER NUMBER OF BYTES READ TO TRANSFER COUNT IN OUTPUT RAB ; ;----------------------------------------------------------------------; MOVW RABINP+RAB$W_RSZ,RABCPY+RAB$W_RSZ ; SET TRANSFER LENGTH $WRITE RAB=RABCPY ; WRITE A BLOCK CMPL #RMS$_NORMAL,R0 ; CHECK FOR SUCCESS BNEQU 50$ ; EXIT ON ERROR ;----------------------------------------------------------------------; ; INCREMENT THE BLOCK COUNT AND COPY ANOTHER BLOCK ; ;----------------------------------------------------------------------; ADDL #BUFCNT,@12(AP) ; INCREMENT BLOCK COUNTER BRB 20$ ; PROCESS NEXT BLOCK ;----------------------------------------------------------------------; ; ; ; CHECK FOR END-OF-FILE ON INPUT ERROR ; ; ; ;----------------------------------------------------------------------; ; IF AN END-OF-FILE OCCURS, THEN CLOSE THE INPUT AND OUTPUT ; ; FILES. RETURN RMS$_NORMAL IF NO ERRORS. ; ;----------------------------------------------------------------------; 30$: CMPL #RMS$_EOF,R0 ; CHECK FOR END-OF-FILE BNEQU 50$ ; SOME OTHER ERROR ;----------------------------------------------------------------------; ; CLOSE INPUT AND OUTPUT FILES ; ;----------------------------------------------------------------------; $CLOSE FAB=FABINP ; CLOSE INPUT FILE CMPL #RMS$_NORMAL,R0 ; CHECK FOR SUCCESS BNEQU 40$ ; EXIT ON ERROR $CLOSE FAB=FABCPY ; CLOSE OUTPUT FILE ;----------------------------------------------------------------------; ; ; ; COMMON EXIT ROUTINE FOR RMS$COPY SUBROUTINE ; ; ; ;----------------------------------------------------------------------; 40$: RET ; RETURN TO USER ;----------------------------------------------------------------------; ; ; ; WRITE ERROR EXIT -- POSSIBLE FILLED DISK ; ; ; ;----------------------------------------------------------------------; 50$: MOVL R0,R2 ; SAVE ERROR STATUS $CLOSE FAB=FABINP ; CLOSE INPUT FILE $CLOSE FAB=FABCPY ; CLOSE OUTPUT FILE MOVL R2,R0 ; RESTORE ERROR STATUS RET ; RETURN TO USER .PAGE .SBTTL RMS$EXPAND ;----------------------------------------------------------------------; ; ; ; ; ; RMS$EXPAND ; ; ; ; ; ;----------------------------------------------------------------------; ; THIS SUBROUTINE EXPANDS A GIVEN USER FILE SPECIFICATION ; ; AND RETURNS THE FULLY QUALIFIED FILENAME TO THE USER. ; ;----------------------------------------------------------------------; ; ARGUMENTS: 4(AP) - ADDRESS OF STRING DESCRIPTOR WHICH ; ; CONTAINS THE USER FILE SPECIFICATION ; ; ; ; THIS ROUTINE RETURNS THE FULLY QUALIFIED; ; FILE SPECIFICATION IN THIS SAME STRING. ; ; IF AN ERROR OCCURS, THE STRING WILL BE ; ; BLANK AND THE ERROR WILL APPEAR IN R0. ; ;----------------------------------------------------------------------; .PSECT RMS$EXPAND PIC,REL,LCL,NOSHR,EXE,RD,NOWRT .ENTRY RMS$EXPAND,^M ;----------------------------------------------------------------------; ; COPY THE USER FILE SPECIFICATION INTO A SEARCH NAME BUFFER ; ;----------------------------------------------------------------------; MOVL 4(AP),R6 ; GET ADDRESS OF DESCRIPTOR MOVC5 (R6),@4(R6),#BLANK,#NAM$C_MAXRSS,FILNAM ; COPY TO BUFFER MOVC5 #0,@4(R6),#BLANK,(R6),@4(R6) ; BLANK OUT FILESPEC ;----------------------------------------------------------------------; ; CALCULATE THE TRUE LENGTH (MINUS BLANKS) OF THE USER FILENAME ; ;----------------------------------------------------------------------; MOVL #NAM$C_MAXRSS,R7 ; GET MAXIMUM LENGTH OF STRING 10$: DECL R7 ; DECREMENT LENGTH COUNTER MOVB FILNAM(R7),R1 ; GET CHARACTER FROM END OF STRING TSTL R7 ; CHECK FOR ZERO LENGTH BEQL 20$ ; YES, NULL STRING LENGTH CMPB #BLANK,R1 ; CHECK FOR BLANK BEQL 10$ ; YES, IGNORE CHARACTER 20$: INCL R7 ; ADJUST LENGTH COUNTER ;----------------------------------------------------------------------; ; MOVE FILE NAME STRING ADDRESS AND LENGTH INTO LOCAL FAB ; ;----------------------------------------------------------------------; MOVB R7,FABBLK+FAB$B_FNS ; STORE LENGTH OF FILESPEC MOVL #FILNAM,FABBLK+FAB$L_FNA ; STORE ADDRESS OF FILESPEC ;----------------------------------------------------------------------; ; PARSE THE USER FILESPEC ; ;----------------------------------------------------------------------; $PARSE FAB=FABBLK ; PARSE USER FILE NAME ; CHECK FOR NORMAL COMPLETION BLBS R0,30$ ; EXIT IF ERROR DETECTED RET ; ERROR CODE CONTAINED IN R0 ;----------------------------------------------------------------------; ; SEARCH THE SYSTEM FOR THE USER FILE - CREATE FULL FILENAME ; ;----------------------------------------------------------------------; 30$: $SEARCH FAB=FABBLK ; SEARCH FOR USER FILE ; CHECK FOR NORMAL COMPLETION BLBS R0,40$ ; EXIT IF ERROR DETECTED RET ; ERROR CODE CONTAINED IN R0 ;----------------------------------------------------------------------; ; RETURN THE FULL FILENAME TO THE USER ; ;----------------------------------------------------------------------; ; NOW THAT THE FULLY QUALIFIED USER FILE SPECIFICATION HAS ; ; BEEN DETERMINED, IT MUST BE TRANSFERRED BACK TO THE USER ; ; FILE STRING. TRUNCATION WILL OCCUR IF THE USER FILE STRING ; ; IS TOO SMALL TO CONTAIN THE FULLY QUALIFIED FILE SPECIFICATION.; ;----------------------------------------------------------------------; 40$: CLRL R6 ; CLEAR LENGTH OF RESULT NAME MOVB NAMBLK+NAM$B_RSL,R6 ; GET LENGTH OF RESULT NAME MOVL 4(AP),R7 ; GET ADDRESS OF RETURN BUFFER MOVC5 R6,RESNAM,#BLANK,(R7),@4(R7) ; TRANSFER FULL NAME TO USER STRING ;----------------------------------------------------------------------; ; END OF SUBROUTINE RMS$EXPAND ; ;----------------------------------------------------------------------; MOVL #RMS$_NORMAL,R0 ; INDICATE NORMAL SUCCESSFUL COMPLETION RET ; RETURN TO USER .PAGE .SBTTL RMS$PARSE ;----------------------------------------------------------------------; ; ; ; ; ; RMS$PARSE ; ; ; ; ; ;----------------------------------------------------------------------; ; THIS SUBROUTINE PARSES A USER-SUPPLIED FILE SPECIFICATION ; ; STRING IN PREPARATION FOR A LATER CALL TO THE RMS$SEARCH ; ; UTILITY WHICH PERFORMS WILDCARD FILE SEARCHES ; ;----------------------------------------------------------------------; ; ARGUMENTS: 4(AP) - ADDRESS OF A STRING DESCRIPTOR WHICH ; ; CONTAINS THE USER FILE SPECIFICATION ; ; TO BE PARSED. ; ; ; ; ANY ERROR CONDITIONS ARE RETURNED IN R0 ; ;----------------------------------------------------------------------; .PSECT RMS$PARSE PIC,REL,LCL,NOSHR,EXE,RD,NOWRT .ENTRY RMS$PARSE,^M ;----------------------------------------------------------------------; ; COPY THE USER FILE SPECIFICATION INTO A SEARCH NAME BUFFER ; ;----------------------------------------------------------------------; MOVL 4(AP),R6 ; GET ADDRESS OF DESCRIPTOR MOVC5 (R6),@4(R6),#BLANK,#NAM$C_MAXRSS,FILNAM ; COPY TO BUFFER ;----------------------------------------------------------------------; ; CALCULATE THE TRUE LENGTH (MINUS BLANKS) OF THE USER STRING ; ;----------------------------------------------------------------------; MOVL #NAM$C_MAXRSS,R7 ; GET MAXIMUM LENGTH OF STRING 10$: DECL R7 ; DECEMENT LENGTH COUNTER MOVB FILNAM(R7),R1 ; GET CHARACTER FROM END OF STRING TSTL R7 ; CHECK FOR ZERO LENGTH BEQL 20$ ; YES, NULL STRING LENGTH CMPB #BLANK,R1 ; CHECK FOR BLANK BEQL 10$ ; YES, IGNORE CHARACTER 20$: INCL R7 ; ADJUST LENGTH COUNTER ;----------------------------------------------------------------------; ; MOVE FILE NAME STRING ADDRESS AND LENGTH INTO LOCAL FAB ; ;----------------------------------------------------------------------; MOVB R7,FABBLK+FAB$B_FNS ; STORE LENGTH OF FILESPEC MOVL #FILNAM,FABBLK+FAB$L_FNA ; STORE ADDRESS OF FILESPEC ;----------------------------------------------------------------------; ; PARSE THE USER FILE SPECIFICATION AND REPORT ERRORS ; ;----------------------------------------------------------------------; $PARSE FAB=FABBLK ; PARSE USER FILE NAME BLBS R0,30$ ; NORMAL SUCCESSFUL COMPLETION? RET ; NO, RETURN TO USER ;----------------------------------------------------------------------; ; HANDLE THE STICKYNESS OF MULTIPLE FILENAMES. COPY THE ; ; EXPANDED FILENAME INTO THE RELATED NAME BLOCK AND CLEAR ; ; THE DEFAULT NAME STRING IN THE ORIGINAL FAB BLOCK. ; ;----------------------------------------------------------------------; 30$: MOVZBL NAMBLK+NAM$B_ESL,R2 ; GET LENGTH OF EXPANDED STRING BEQL 40$ ; STRING LENGTH ZERO? MOVL NAMBLK+NAM$L_RLF,R3 ; GET ADDRESS OF RELATED NAM BLOCK BEQL 40$ ; NO RELATED NAM BLOCK? MOVB R2,NAM$B_RSL(R3) ; SET LENGTH OF RELATED FILESPEC MOVL NAMBLK+NAM$L_ESA,NAM$L_RSA(R3) ; SET ADDRESS OF RELATED FILESPEC 40$: CLRB FABBLK+FAB$B_DNS ; DO NOT USE THE DEFAULT FILESPEC ;----------------------------------------------------------------------; ; END OF SUBROUTINE RMS$PARSE ; ;----------------------------------------------------------------------; RET ; RETURN WITH STATUS IN R0 .PAGE .SBTTL RMS$SEARCH ;----------------------------------------------------------------------; ; ; ; ; ; RMS$SEARCH ; ; ; ; ; ;----------------------------------------------------------------------; ; THIS SUBROUTINE SEARCHES THE SYSTEM USING THE WILDCARD FILE ; ; SPECIFICATION PARSED BY RMS$PARSE TO RETURN TO THE USER ; ; THE NEXT FILE WHICH MEETS ALL THE REQUIREMENTS OF THE WILDCARD.; ;----------------------------------------------------------------------; ; ARGUMENTS: 4(AP) - ADDRESS OF STRING DESCRIPTOR WHICH ; ; WILL CONTAIN THE NEXT FULLY QUALIFIED ; ; FILE SPECIFICATION WHICH MEETS THE ; ; WILDCARD REQUIREMENTS AS DEFINED IN THE ; ; CALL TO THE RMS$PARSE UTILITY. ; ; ; ; ANY ERROR CONDITIONS WILL BE RETURNED ; ; IN R0. THE STATUS CODE 'RMS$_NMF' ; ; INDICATES 'NO MORE FILES' WHICH MEET ; ; THE WILDCARD SPECIFICATION. ; ;----------------------------------------------------------------------; .PSECT RMS$SEARCH PIC,REL,LCL,NOSHR,EXE,RD,NOWRT .ENTRY RMS$SEARCH,^M ;----------------------------------------------------------------------; ; INITIALIZE THE USER STRING PASSED TO RECEIVE THE FILENAME ; ;----------------------------------------------------------------------; MOVL 4(AP),R6 ; GET ADDRESS OF DESCRIPTOR MOVC5 #0,@4(R6),#BLANK,(R6),@4(R6) ; BLANK OUT USER STRING ;----------------------------------------------------------------------; ; SEARCH THE SYSTEM FOR THE FIRST FILE MEETING THE WILDCARD ; ; SPECIFICATIONS PRESENT IN THE FAB AND PARSED BY RMS$PARSE ; ;----------------------------------------------------------------------; $SEARCH FAB=FABBLK ; SEARCH FOR USER FILE BLBS R0,10$ ; CHECK FOR NORMAL COMPLETION RET ; ERROR - RETURN STATUS IN R0 ;----------------------------------------------------------------------; ; RETURN THE FULLY QUALIFIED FILE SPECIFICATION TO THE USER ; ;----------------------------------------------------------------------; 10$: CLRL R6 ; CLEAR LENGTH OF RESULT NAME MOVB NAMBLK+NAM$B_RSL,R6 ; GET LENGTH OF RESULT NAME MOVL 4(AP),R7 ; GET ADDRESS OF RETURN BUFFER MOVC5 R6,RESNAM,#BLANK,(R7),@4(R7) ; TRANSFER FULL NAME TO STRING ;----------------------------------------------------------------------; ; END OF SUBROUTINE RMS$SEARCH ; ;----------------------------------------------------------------------; MOVL #RMS$_NORMAL,R0 ; INDICATE NORMAL SUCCESSFUL COMPLETION RET ; RETURN TO USER .PAGE .SBTTL RMS$UIC ;----------------------------------------------------------------------; ; ; ; ; ; RMS$UIC ; ; ; ; ; ;----------------------------------------------------------------------; ; SET UIC GROUP AND MEMBER NUMBER IN XAB PROTECTION BLOCK ; ;----------------------------------------------------------------------; .PSECT RMS$UIC PIC,REL,LCL,NOSHR,EXE,RD,NOWRT .ENTRY RMS$UIC,^M ;----------------------------------------------------------------------; ; INITIALIZE UIC IN LOCAL XABPRO BLOCK ; ;----------------------------------------------------------------------; MOVL @4(AP),XABPRO+XAB$L_UIC ; SET XAB UIC GROUP AND MEMBER ;----------------------------------------------------------------------; ; END OF SUBROUTINE RMS$UIC ; ;----------------------------------------------------------------------; RET ; RETURN TO CALLER .PAGE .SBTTL RMS$CREATE ;----------------------------------------------------------------------; ; ; ; ; ; RMS$CREATE ; ; ; ; ; ;----------------------------------------------------------------------; ; CREATE THE SPECIFIED FILE WITH THE SPECIFIED PROTECTION MASK ; ;----------------------------------------------------------------------; ; SEARCH DOWN THE EXISTING XAB CHAIN TO END-OF-XAB-CHAIN ; ;----------------------------------------------------------------------; .PSECT RMS$CREATE PIC,REL,LCL,NOSHR,EXE,RD,NOWRT .ENTRY RMS$CREATE,^M ;----------------------------------------------------------------------; ; LINK IN PROTECTION XAB INTO CURRENT XAB CHAIN FOR FILE FAB ; ;----------------------------------------------------------------------; MOVL 4(AP),R2 ; GET ADDRESS OF FAB MOVL FAB$L_XAB(R2),R3 ; GET ADDRESS OF XAB SEARCH: MOVL R3,R2 ; MOVE NEW XAB TO OLD XAB MOVL XAB$L_NXT(R2),R3 ; GET NEXT XAB ADDRESS BNEQU SEARCH ; SKIP TO END OF CHAIN ;----------------------------------------------------------------------; ; INSERT XAB PROTECTION BLOCK AT END OF XAB CHAIN ; ;----------------------------------------------------------------------; MOVL #XABPRO,XAB$L_NXT(R2) ; LINK IN PROTECT XAB ;----------------------------------------------------------------------; ; CREATE NEW FILE AND CONNECT THE STREAM TO THE FILE ; ;----------------------------------------------------------------------; $CREATE FAB=@4(AP) ; CREATE FILE BLBC R0,EXIT ; BRANCH IF ERROR $CONNECT RAB=@8(AP) ; CONNECT STREAM TO FILE ;----------------------------------------------------------------------; ; END OF SUBROUTINE RMS$CREATE ; ;----------------------------------------------------------------------; EXIT: RET ; RETURN WITH STATUS IN R0 .PAGE ;----------------------------------------------------------------------; ; ; ; END OF FORTRAN-CALLABLE RMS INTERFACE UTILITYS ; ; ; ;----------------------------------------------------------------------; .END