C SUBROUTINE BPDINI.FOR C+ C; BPDINI IS THE INITIALIZATION SUBROUTINE FOR PROGRAM "BPD". C- CD+ C; THIS SUBROUTINE WILL DETERMINE THE RECORD NUMBER OF THE PICTORIAL C;DISPLAY THAT IS TO BE BACKED-UP AS A VAX-11 RMS FILE (OR THE FACT THAT C;ALL DEFINED DISPLAYS ARE TO BE BACKED-UP). THIS INFORMATION MUST C;EXIST IN A "FOREIGN COMMAND-LINE" IN THE EXACT FORMAT DESCRIBED C;BELOW: C; C; BPD XXX C; C; WHERE; "XXX" IS THE RECORD NUMBER IN THE PICTORIAL FILE THAT IS TO C; BE BACKED-UP. "XXX" MAY BE ANY NUMBER OF DECIMAL DIGITS C; BETWEEN ONE AND SIX. LEADING ZEROES ARE OPTIONAL AND C; IGNORED. A TRAILING DECIMAL-POINT IS OPTIONAL AND IGNORED. C; THE THREE-CHARACTER STRING "ALL" MAY BE SUPPLIED INSTEAD, C; IN WHICH CASE ALL DEFINED DISPLAYS WILL BE BACKED-UP. C; C; CD- C; WRITTEN BY E. NICHOLAS CUPERY 26 AUGUST 1981 C*+ SUBROUTINE BPDINI(TI,ALLFLG,RECNUM,STATUS) C* C* ARGUMENT INPUTS: C* TI = INITIATING TERMINAL LUN (NOT USED) [WORD] C* C* INPUTS FROM COMMON: C* (NONE) C* C* ARGUMENT OUTPUTS: C* ALLFLG = BACKUP-ALL-DISPLAYS FLAG (0=NO) [WORD] C* RECNUM = RECORD NUMBER IN PICTORIAL FILE (IF ALLFLG=0) [LONGWORD] C* STATUS = RETURN STATUS (+1 = SUCCESS) [WORD] C* C* OUTPUTS TO COMMON: C* (NONE) C* C*- C C C INTEGER*2 TI !INITIATING TERMINAL LUN INTEGER*2 ALLFLG !BACKUP-ALL-DISPLAYS FLAG (0=NO) INTEGER*4 RECNUM !RECORD NUMBER IN PICTORIAL FILE INTEGER*2 STATUS !RETURN STATUS FOR CALLER C INTEGER*4 I !LOCAL DO-LOOP COUNTER INTEGER*4 J !LOCAL DO-LOOP COUNTER CHARACTER*84 CHRBUF !CHARACTER BUFFER FOR "LIB$GET_FOREIGN" BYTE FILSPC(84) !ASCII ARRAY FOR COMMAND-LINE INTEGER*2 NCHARS !COMMAND-LINE CHARACTER-COUNT INTEGER*2 NUMDIG !NUMBER OF DIGITS IN RECORD NUMBER INTEGER*4 SYSTAT !STATUS VALUE FOR "GET-FOREIGN-COMMAND-LINE" INTEGER*4 LIB$GET_FOREIGN !"GET-FOREIGN-COMMAND-LINE" FUNCTION INTEGER*4 LIB$CVT_DTB !"CONVERT-DECIMAL-TO-BINARY" FUNCTION C EQUIVALENCE (CHRBUF,FILSPC) C C C C C C$INDENT C C SET BAD RETURN STATUS FOR CALLER STATUS = -1 C C ASSUME SPECIFICATION IS NOT "ALL" ALLFLG = 0 C C GET "FOREIGN" COMMAND-LINE SYSTAT = LIB$GET_FOREIGN(CHRBUF,,NCHARS) C C IF ANY ERROR OCCURRED IF (SYSTAT) GO TO 10 C C DECLARE ERROR GETTING COMMAND-LINE WRITE (*,5) 5 FORMAT(' BPD -- ERROR GETTING COMMAND-LINE',/) C C BREAK -- RETURN IMMEDIATELY GO TO 999 C C ENDI 10 CONTINUE C C IF SPECIFICATION IS "ALL IF (FILSPC(1) .NE. 'A' .OR. FILSPC(2) .NE. 'L' *.OR. FILSPC(3) .NE. 'L' .OR. NCHARS .NE. 3) GO TO 20 C C SET THE "BACKUP-ALL-DISPLAYS" FLAG ALLFLG = 1 C C SET A GOOD RETURN STATUS FOR CALLER STATUS = 1 C C BREAK -- RETURN TO CALLER NOW GO TO 999 C C ENDI 20 CONTINUE C C C C C C CALCULATE NUMBER OF DIGITS IN THE RECORD NUMBER NUMDIG = NCHARS C C IF THE DIGIT-COUNT IS ILLEGAL IF (NUMDIG .GT. 0 .AND. NUMDIG .LE. 6) GO TO 30 C C BREAK -- DECLARE SYNTAX ERROR GO TO 888 C C ENDI 30 CONTINUE C C CONVERT DECIMAL ASCII DIGITS TO BINARY SYSTAT = LIB$CVT_DTB(%VAL(NUMDIG),FILSPC(1),RECNUM) C C IF ANY ERROR OCCURRED IF (SYSTAT) GO TO 40 C C DECLARE SYNTAX ERROR 888 WRITE (*,889) 889 FORMAT(' BPD -- COMMAND-LINE SYNTAX ERROR ', * '(NEED DISPLAY NUMBER OR "ALL")',/) C C BREAK -- RETURN TO CALLER GO TO 999 C C ENDI 40 CONTINUE C C SET GOOD RETURN STATUS FOR CALLER STATUS = 1 C C RETURN TO CALLER 999 RETURN C C END OF SUBROUTINE END