C+ C Title: TIZ - Task Image Zapper C Author: T. R. Wyant C Date: 7-Oct-82 C Modified: C 13-Jul-83 - T. R. Wyant - Modified algorithm to C determine where task priority stored. C 16-Mar-84 - T. R. Wyant - Add support for TKB C IDENT keyword. C Remarks: C TIZ is a task to simplify the modification of task C image files. It offers TKB-like keyword modifica- C tion of those task attributes that are represented C as values in label blocks 0-2. The keywords impli- C mented at the moment are: C /ASG=dev:lun - Change LUN device assignmnt C /[NO]CP - Enable/disable checkpoint C /[NO]DU - Dump label block after run C /HE - Help message C /IDENT=id - Task ident. C /[NO]IP - Warning when map I/O pg C /LIBR=nam:ac - Change library/common acces C /[NO]PM - Generate postmortem dump C /PAR=name - Change partition name C /PRI=n - Change priority C /[NO]RO - Don't update task image C /[NO]SL - Install with slave attrib C /TASK=name - Change task name C /XHR=NO - Don't install w/ extrnl hdr C =MAYBE - Allow external header C =YES - Install w/ external header C Those switches/keywords which can be negated are C negated by prefacing either "NO" or "-". C C TIZ can be invoked either as an MCR command, eg: C >TIZ MYTASK/-PM/XHR=YES/DU C in conversational mode, eg: C >TIZ (or RUN $TIZ) C Give task image file name: MYTASK C Give keyword: -PM C Give keyword: XHR=YES C Give keyword: DU C C Give keyword: C C Give task image file name: . C- C======================================================================= C C Type Declarations. C INTEGER*2 ABORT ! .TRUE. to abort a command. INTEGER*2 ASSERT ! .TRUE. if switch asserted. LOGICAL*1 BYTUIC(2) ! Task default UIC (Temporary). INTEGER*2 BUFLEN ! Command length. CHARACTER*1 CCBYTE ! Carriage control. CHARACTER*80 CMDLIN ! MCR command line. INTEGER*2 CNDABO ! .TRUE. if "Something's fishy" CHARACTER*80 DEFSWI ! Default switches. INTEGER*2 DOTS ! = RAD50 '...' INTEGER*2 DUMP ! .TRUE. to dump lbl blk at end INTEGER*2 DFLT ! .TRUE. if default proc. done. INTEGER*2 HDR ! .TRUE. if built with header. INTEGER*2 HDRBLK ! Block number of header. INTEGER*2 HDRUPD ! .TRUE. if header updated, INTEGER*2 HEADER(256) ! Task header. INTEGER*2 IBEG ! Begin of decode string. INTEGER*2 IEND ! End of decode string. INTEGER*2 IPRIL ! Index of task priority. INTEGER*4 JNAME ! RAD-50 name buffer. CHARACTER*4 LBFLG(16) ! Meanings of task flags. INTEGER*2 LBLBLK(256,3) ! Task label blocks. INTEGER*2 LIBLST ! Number of last /LIBR wildcard INTEGER*2 LIBNAM(2) ! Resident library name. INTEGER*2 LNAME(3) ! Library name (ASCII). INTEGER*2 LUNTBL(2,256) ! Luns for task INTEGER*2 NOLUNS ! Number of Luns in use. INTEGER*2 NSWIT ! Number of switches this file. CHARACTER*40 OUTFIL ! Output file name. CHARACTER*40 OUTDFL ! Default output file name. INTEGER*2 PROMPT ! .TRUE. for conversational. INTEGER*2 RDONLY ! .TRUE. to not update task file CHARACTER*10 SWABBR ! Switch abbreviation. CHARACTER*80 SWIERR ! Switch error text. CHARACTER*80 SWILST ! Switches. CHARACTER*40 SWITCH ! Individual switch value. INTEGER*2 TIDNT(3) ! Task Ident (ASCII). INTEGER*2 TNAME(3) ! Task name (ASCII). CHARACTER*40 TSKFIL ! Name of task file. CHARACTER*40 TSKDFL ! Defaults for task file name. INTEGER*2 TSKFLG ! Task flags word. C C======================================================================= C C Equivalence statements. C EQUIVALENCE (LBLBLK(8,1),BYTUIC(1)) EQUIVALENCE (LBLBLK(13,1),TSKFLG) EQUIVALENCE (LBLBLK(1,2),LUNTBL(1,1)) C C======================================================================= C C Data statements. C DATA DEFSWI /'/RO/DU'/ DATA DOTS /3R.../ DATA LBFLG /' PIC','-HDR',' ACP',' PMD',' SLV','-SND',' ', 1 ' PRV',' CMP','-CHK',' RES','-IOP',' SUP',' XHR', 2 '-XHR',' '/ C C======================================================================= C C Format Statements. C 90200 FORMAT ('SY:[',O3,',',O3,'].TSK') 92000 FORMAT (X,/,'$Give task image file name: ') 92020 FORMAT (Q,A) 93000 FORMAT ('$ Give keyword: ') 93220 FORMAT (A2,O6) 93240 FORMAT (O6) 93260 FORMAT (I10) 93520 FORMAT ('0Task File Name: ',A,/, 1 ' Task Name: ',3A2,/, 2 ' Task Ident: ',3A2,/, 3 ' Partition Name: ',3A2,/, 4 ' Task Flags: ',A,/ 5 ' Priority: ',I3,/, 6 ' Creation date: ',I2.2,'/',I2.2,'/',I2.2) 93530 FORMAT (2A,T32,' Created: ',2(I2.2,'/'),I2.2) 93540 FORMAT (X,A2,O,':') 93550 FORMAT (A,' LUN ',I3,':',A) 94000 FORMAT (' Error - Task image not modified due to above error.') 94010 FORMAT (' Warning - A task whose name is of the form ...xxx ', 1 'can not be installed slaved.') 94020 FORMAT (' Info - /RO switch asserted. Task image not modified.') 99000 FORMAT (' Error - Cannot open task file ',A) 99100 FORMAT (' Error - Keyword /'A,X,A) C C======================================================================= C C Mainline Code C C----------------------------------------------------------------------- C C Initialize and determine mode of operation. C PROMPT = .TRUE. ! Assume conversational mode. TSKFIL = ' ' ! Preset the file name SWILST = ' ' ! and the switch list. CALL GETTSK(LBLBLK(1,1)) ! Get the task params. I = BYTUIC(2) ! Get group number. I = I .AND. '377'O ! Clear high byte. J = BYTUIC(1) .AND. '377'O ! Get member number. J = J .AND. '377'O ! Clear high byte. WRITE (TSKDFL,90200) I, J ! Encode UIC into default name. CALL INPROC(40,TSKDFL,I) ! Get rid of blanks. CALL FILSTR(TSKDFL) ! Parse it into components. OUTDFL = 'SY:TIZ.PRT' ! Set up output file name. CALL FILSTR(OUTDFL) ! Parse it. CALL GETMCR(CMDLIN,BUFLEN) ! Get the MCR command line. IBEG = INDEX(CMDLIN,' ') + 1 ! Find end of task name. PROMPT = (BUFLEN .LE. 0 .OR. ! Determine mode of operation. 1 IBEG .LE. 1) C C----------------------------------------------------------------------- C C Get task file. C C....................................................................... C C If interactive, get task file name and switches if any. C 2000 ABORT = .FALSE. ! Assume not aborted. IF (PROMPT) THEN ! If interactive, WRITE (5,92000) ! Ask for file name. READ (5,92020,END=9990) BUFLEN, ! Read the file 1 CMDLIN ! name. IF (BUFLEN .LE. 0) GO TO 9990 ! If none, exit. IBEG = 1 ! No command name. END IF C C....................................................................... C C Set up default switches. C NSWIT = 0 ! Init. switch count. LIBLST = 0 ! Init. libr wildcard count. HDRUPD = .FALSE. ! Assume no update to hdr. DUMP = .FALSE. ! Init. the dump switch. RDONLY = .FALSE. ! Init. the readonly switch. DFLT = .FALSE. ! Init. the default flag. SWILST = ' ' ! Preset switch list TSKFIL = ' ' ! and file name. C C....................................................................... C C Separate task file name from switches. C BUFLEN = BUFLEN + 1 ! Adjust line length. CMDLIN(BUFLEN:) = '/' ! Slash to help parse. J = BUFLEN - IBEG + 1 ! Find line length. CALL INPROC(J,CMDLIN(IBEG: ! Uppercase the line, and get 1 BUFLEN),I) ! rid of spaces and tabs. BUFLEN = I + IBEG - 1 ! Reset the line length. J = INDEX(CMDLIN,'/') ! Find the first switch. IF ((J - 1) .GE. IBEG) ! If a file name was passed, 1 TSKFIL = CMDLIN(IBEG:J-1) ! save it. IF (BUFLEN .GE. (J + 1)) ! If there are any switches, 1 SWILST = CMDLIN(J+1:BUFLEN) ! save them. J = INDEX(TSKFIL,'=') ! Is there an output file? IF (J .GT. 0) THEN ! If so, IF (J .GT. 1) THEN ! If not null, OUTFIL = TSKFIL(:J-1) ! Save it ELSE ! else OUTFIL = ' ' ! Save spaces. END IF TSKFIL = TSKFIL(J+1:) ! Take it off the task file DUMP = .TRUE. ! Force a dump. ELSE ! If no output file, OUTFIL = 'TI:' ! Make it TI:. END IF C C...................................................................... C C Supply default file spec elements. C CALL FILSTR(OUTFIL) ! Parse the output file. CALL FILDEF(OUTFIL,OUTDFL) ! Fill in the defaults. IF (SWILST(1:2) .EQ. 'HE' 1 .AND. TSKFIL .EQ. ' ') 2 THEN ! If want help at this point, CALL HLPSUB(OUTFIL,DEFSWI) ! Give it, GO TO 9900 ! and exit. END IF CALL FILSTR(TSKFIL) ! Break name into components. CALL FILDEF(TSKFIL,TSKDFL) ! Plug in the defaults. C C....................................................................... C C Open task file and read in label blocks. C OPEN (UNIT=1,NAME=TSKFIL,TYPE='OLD', ! Open the task 1 ACCESS='DIRECT',ERR=9000) ! image file. DO 2760 I=1,3 ! Read label blocks. READ(1'I) (LBLBLK(J,I),J=1,256) 2760 CONTINUE IF (LBLBLK(233,1) .EQ. 0) THEN ! If #label blks not at hi loc, IPRIL = '346'O/2 + 1 ! must be only 7 libr slots ELSE ! if it is at hi loc, IPRIL = '706'O/2 + 1 ! must be 15 of them. END IF NOLUNS = LBLBLK(IPRIL+6,1) ! Get number of luns in use. IF (NOLUNS .GT. 0 .AND. ! If it has any, 1 LUNTBL(1,NOLUNS) .EQ. 'OV' ! If last one is overlay 2 .AND. LUNTBL(2,NOLUNS) .EQ. 0) ! load LUN, 3 NOLUNS = NOLUNS - 1 ! Don't modify it. HDRBLK = LBLBLK(IPRIL+4,1) + 1 ! Get block number of header. HDR = ((TSKFLG .AND. '40000'O) .EQ. 0) ! Have a header? IF (HDR) READ (1'HDRBLK) HEADER ! If so, read it. C C----------------------------------------------------------------------- C C Get and process switches and keywords. C C....................................................................... C C Ask for switches if interactive. C 3000 IF (PROMPT .AND. SWILST .EQ. ' ') THEN ! If interactive, WRITE (5,93000) ! Ask for switches. READ (5,92020,END=9990) BUFLEN, 1 SWILST ! Get them. IF (BUFLEN .LE. 0) GO TO 4000 ! If none, process. BUFLEN = BUFLEN + 1 ! Adjust length. SWILST(BUFLEN:) = '/' ! Slash for parse. CALL INPROC(BUFLEN,SWILST(: ! Uppercase & kill 1 BUFLEN),I) ! spaces&tabs. BUFLEN = I ! Reset line len. END IF C C...................................................................... C C Pick apart the list of switches. C 3200 IF (SWILST .EQ. ' ') GO TO 3900 ! If no switches left, finish. I = INDEX(SWILST,'/') ! Look for end of this switch. IF (I .GT. 1) ! If not null, 1 SWITCH = SWILST(:I-1) ! Peel it off. SWITCH(I:I) = ':' ! Trailing colon to help parse. SWILST = SWILST(I+1:) ! Drop it from list. IF (I .LE. 1) GO TO 3200 ! If null, go for next. NSWIT = NSWIT + 1 ! Processed another switch. C C....................................................................... C C Determine if switch is negated. C ASSERT = .TRUE. ! Assume switch is asserted. SWABBR = SWITCH(1:1) ! Check first char. IF (SWABBR .NE. '-') ! If not minus, 1 SWABBR = SWITCH(1:2) ! Check first two. IF (SWABBR .EQ. '-' .OR. ! If a negation, 1 SWABBR .EQ. 'NO') THEN ! ASSERT = .FALSE. ! Show not asserted. J = INDEX(SWABBR,' ') ! Find length of negate string. SWITCH = SWITCH(J:) ! Take it out. END IF ! C C....................................................................... C C Set up to process keywords. C SWIERR = 'may not be negated.\' ! Preset error message. SWABBR = ' ' ! Blank out switch abbr. IBEG = INDEX(SWITCH,'=') ! Find equals sign if any. IEND = 0 ! Assume not found. IF (IBEG .GT. 0) THEN ! If found, SWABBR = SWITCH(:IBEG-1) ! Set up abbrev. IBEG = IBEG + 1 ! Pass up equals sign. IEND = INDEX(SWITCH(IBEG:),':') ! Find colon. IF (IEND .GT. 0) ! If colon found, 1 IEND = IEND + IBEG - 2 ! Point to it. END IF C C....................................................................... C C /ASG=dev:lun - Change LUN's device assignment C IF (SWABBR .EQ. 'ASG') THEN ! If its the ASG keyword: IF (.NOT. ASSERT) GO TO 9100! It may not be negated. SWIERR = 'has missing or bad device spec.\' IF (IBEG .LE. 0) GO TO 9100 ! If missing spec, error. I = IEND - IBEG ! Length of dev. spec. IF (I .LE. 0) GO TO 9100 ! If not long enough, error. READ (SWITCH(IBEG:IEND),93220, ! Decode the device 1 ERR=9100) IDEV, IUNT ! spec. IF (I .EQ. 1) IUNT = 0 ! If no unit, make zero. IF (IUNT .LT. 0 .OR. IUNT ! If a bad unit number, 1 .GT. 255) ! then 2 GO TO 9100 ! error out. I = IDEV/'400'O ! Check device name for alfa IF (I .LT. '101'O .OR. I ! If not, error 1 .GT. '132'O) GO TO 9100 ! out. I = IDEV - I*'400'O ! Check second char. IF (I .LT. '101'O .OR. I ! If not alfa, error 1 .GT. '132'O) GO TO 9100 ! out. SWIERR = 'has invalid LUN.\' 3240 IBEG = IEND + 2 ! Skip the colon. IEND = INDEX(SWITCH(IBEG:),':') ! Find the next one. IF (IEND .LE. 0) GO TO 3200 ! If none, get next switch. IEND = IEND + IBEG - 2 ! Adjust string pos. READ (SWITCH(IBEG:IEND),93240, ! Get the LUN number. 1 ERR=9100) ILUN ! IF (ILUN .LE. 0 .OR. ILUN ! If a bad LUN number, 1 .GT. NOLUNS) ! then 2 GO TO 9100 ! error out. LUNTBL(1,ILUN) = IDEV ! Store the device name. LUNTBL(2,ILUN) = IUNT ! Store the unit number. GO TO 3240 ! Try for more. END IF C C....................................................................... C C /PRI=n - Change priority C IF (SWABBR .EQ. 'PRI') THEN ! If we have a priority change, IF (.NOT. ASSERT) GO TO 9100! It may not be negated. SWIERR = 'has invalid priority.\' IF (IBEG .LE. 0) GO TO 9100 ! If missing spec, error. READ (SWITCH(IBEG:IEND),93260, ! Read the 1 ERR=9100) IPRI ! priority. IF (IPRI .LT. 0 .OR. IPRI ! If out of range, 1 .GT. 250) GO TO 9100 ! error out. LBLBLK(IPRIL,1) = IPRI ! Set the new priority. GO TO 3200 ! Go get another switch. END IF C C....................................................................... C C /PAR=name - Change partition name. C /TASK=name - Change task name. C Plus any future keywords that revise two C RRAD-50 words in label block 0. C IX = 0 ! Assume not /TASK or /PAR IF (SWABBR .EQ. 'TASK') THEN ! If we have a task name change, IF (.NOT. ASSERT) GO TO 9100! It may not be negated. SWIERR = 'has invalid task name.\' IX = 1 ! Task name is at word 1. END IF IF (SWABBR .EQ. 'PAR') THEN ! If we have a partition name, IF (.NOT. ASSERT) GO TO 9100! It may not be negated. SWIERR = 'has invalid partition name.\' IX = 3 ! Partition name at word 3. END IF IF (IX .GT. 0) THEN ! If either task or partition, IF (IBEG .LE. 0) GO TO 9100 ! If missing spec, error. I = IEND - IBEG + 1 ! Get the number of chars. LBLBLK(IX,1) = 0 ! Clear out the LBLBLK(IX+1,1) = 0 ! name. IF (I .GT. 0) THEN ! If a task name was passed, J = IRAD50(I,SWITCH( ! Convert it to 1 IBEG:IEND), ! RAD-50 2 JNAME) ! (trial basis). IF (J .LT. I) ! If incomplete conversion, 1 GO TO 9100 ! Error out. J = IRAD50(I,SWITCH( ! Convert it to 1 IBEG:IEND), ! RAD-50 2 LBLBLK(IX,1)) ! for real. END IF GO TO 3200 ! Go handle next switch. END IF C C....................................................................... C C /IDENT=name - Change task ident. C Plus any future keywords that revise two C RRAD-50 words in the header. C IX = 0 ! Assume nothing to do. IX1 = 0 ! Assume only one loc to chg. IF (SWABBR .EQ. 'IDENT') THEN ! If we have an ident, IF (.NOT. ASSERT) GO TO 9100! It may not be negated. SWIERR = 'has invalid task identification.\' IX = 3 ! Ident at word 3. IX1 = -(HEADER(30)/2+1-4) ! Also in R3, R4 (reversed). END IF IF (IX .GT. 0) THEN ! If ident, IF (IBEG .LE. 0) GO TO 9100 ! If missing spec, error. IF (.NOT. HDR) THEN ! If built without header, SWIERR = 'invalid if no header.\' GO TO 9100 ! Can't do any of these. END IF I = IEND - IBEG + 1 ! Get the number of chars. HEADER(IX) = 0 ! Clear out the HEADER(IX+1) = 0 ! name. HDRUPD = .TRUE. ! Header updated. IF (I .GT. 0) THEN ! If an ident was passed, J = IRAD50(I,SWITCH( ! Convert it to 1 IBEG:IEND), ! RAD-50 2 JNAME) ! (trial basis). IF (J .LT. I) ! If incomplete conversion, 1 GO TO 9100 ! Error out. J = IRAD50(I,SWITCH( ! Convert it to 1 IBEG:IEND), ! RAD-50 2 HEADER(IX)) ! for real. IF (IX1 .NE. 0) THEN ! If need it another place, J = ABS(IX1) ! Find first loc. HEADER(J) = HEADER(IX) ! Fill it in. J = J + SIGN(1,IX1) ! Find second loc. HEADER(J) = HEADER(IX+1) ! Fill it in. END IF END IF GO TO 3200 ! Go handle next switch. END IF C C....................................................................... C C /LIBR=nam:ac - Change library/common acces C IF (SWABBR .EQ. 'LIBR') THEN ! If it's the LIBR switch, IF (.NOT. ASSERT) GO TO 9100! Cannot be negated. SWIERR = 'has invalid library/common name.\' IF (IBEG .LE. 0) GO TO 9100 ! If no name passed, error I = IEND - IBEG + 1 ! Get name length. IF (I .LE. 0) GO TO 9100 ! If null, error. LIBNAM(1) = 0 ! Init. the library/ LIBNAM(2) = 0 ! common name. IF (SWITCH(IBEG:IEND) .EQ. ! If wildcard, 1 '*') THEN ! LIBLST = NSWIT ! Make swit no current ELSE ! if not, J = IRAD50(I,SWITCH( ! Decode the 1 IBEG:IEND),LIBNAM) ! name. IF (J .LT. I) GO TO 9100! If an error, quit. END IF ! IBEG = IEND + 2 ! Skip over the name. SWIERR = 'has invalid access specification.\' IEND = INDEX(SWITCH(IBEG:), ! Find the access spec. 1 ':') IF (IEND .NE. 3) GO TO 9100 ! If not two chars, bad. IEND = IEND + IBEG - 2 ! Point to end of it. MASKS = 0 ! Initialize the MASKC = 0 ! masks. SWABBR = SWITCH(IBEG:IEND) ! Pick up access spec. IF (SWABBR .EQ. 'RO') THEN ! If readonly, MASKC = '100000'O ! set the mask. ELSE IF (SWABBR.EQ.'RW') THEN! If read/write, MASKS = '100000'O ! set the mask. ELSE GO TO 9100 ! If neither, an error. END IF END IF MASKC = .NOT. MASKC ! Put 'Clear' mask right. I = 3 ! Init. the index. 3280 I = I + 14 ! Go to next common. IF ((I .GT. IPRIL-5) .OR. ! If there is none, 1 (LBLBLK(I+5,1) .EQ. 0)) THEN IF (LIBLST .GE. NSWIT) ! If a wildcard, this 1 GO TO 3290 ! is normal exit. SWIERR = 'task not mapped to this library/common.\' GO TO 9100 ! Else, an error. END IF CNDABO = (((LBLBLK(I+10,1) ! Possible problem if 1 .AND. '10'O) .NE. 0) ! making supervisor 2 .AND. MASKS .NE. 0) ! library read/write. IF (LIBNAM(1) .EQ. 0) THEN ! If processing a wildcard IF (.NOT. CNDABO) ! Update mask if 1 LBLBLK(I+10,1) = ! reasonable. 2 (LBLBLK(I+10,1) 3 .AND. MASKC) 4 .OR. MASKS GO TO 3280 ! Go process next. END IF IF (LBLBLK(I,1) .NE. ! If this is not the 1 LIBNAM(1)) GO TO 3280 ! library/common IF (LBLBLK(I+1,1) .NE. ! desired, try the 1 LIBNAM(2)) GO TO 3280 ! next one. IF (CNDABO) THEN ! If something funny, SWIERR = 'supervisor mode library must be read-only.\' GO TO 9100 ! error out. END IF LBLBLK(I+10,1) = ! Flip the 1 (LBLBLK(I+10,1) .AND. ! access 2 MASKC) .OR. MASKS ! bit. 3290 LIBLST = LIBLST + 1 ! Update libr switch number GO TO 3200 ! Go for next keyword. END IF C C....................................................................... C C /XHR=NO - Don't install w/ extrnl hdr C =MAYBE - Allow external header C =YES - Install w/ external header C MASKS = 0 ! Task flag word mask. MASKC = 0 IF (SWABBR .EQ. 'XHR') THEN ! If the XHR switch, IF (.NOT. ASSERT) GO TO 9100! Cannot be negated. SWIERR = 'has invalid option.\' IF (IBEG .LE. 0) GO TO 9100 ! If no option passed, error I = IEND - IBEG + 1 ! Get name length. IF (I .LE. 0) GO TO 9100 ! If none, error. I = INDEX('=YES=NO=MAYBE', ! Validate the 1 SWITCH(IBEG-1:IEND)) ! keyword. IF (I .LE. 0) GO TO 9100 ! If invalid, error. IF (SWITCH(IBEG:IBEG) .EQ. 'Y')! If want xhr, 1 THEN MASKS = '4'O ! set the 'want' bit. MASKC = '2'O ! clear 'don't want'. END IF IF (SWITCH(IBEG:IBEG) .EQ. 'N')! If don't want xhr, 1 THEN MASKS = '2'O ! set 'don't want' bit. MASKC = '4'O ! clear 'want' bit. END IF IF (SWITCH(IBEG:IBEG) .EQ. 'M')! If don't care, 1 MASKC = '6'O ! clear both bits. END IF ! Fall to rest of flag code C C....................................................................... C C /[NO]CP - Enable/disable checkpointing C /[NO]IP - Kill warning when map I/O page. C /[NO]PM - Generate postmortem dump. C /[NO]SL - Install with slave attribute C SWABBR = SWITCH(:2) ! All 2-char abbrs. IF (SWABBR .EQ. 'CP') ! Handle the checkpoint switch. 1 MASKC = '100'O IF (SWABBR .EQ. 'IP') ! Handle the I/O page switch. 1 MASKC = '10'O IF (SWABBR .EQ. 'PM') ! Handle the PMD switch. 1 MASKS = '10000'O IF (SWABBR .EQ. 'SL') ! Handle the slave switch. 1 MASKS = '4000'O IF (.NOT. ASSERT) THEN ! If switch was negated, I = MASKS ! Swap MASKS = MASKC ! the MASKC = I ! mask END IF I = MASKS .OR. MASKC ! Save 'set bit' indicator. MASKC = .NOT. MASKC ! Invert the 'clear' mask. TSKFLG = (TSKFLG ! Set/clear the desired bit 1 .AND. MASKC) .OR. MASKS ! in the flags word. IF (I .NE. 0) GO TO 3200 ! If a bit flipped, go for more. C C....................................................................... C C /[NO]DU - Dump label block after run C IF (SWABBR .EQ. 'DU') THEN ! If the dump switch, IF (ASSERT) THEN ! If want a dump, OPEN (UNIT=4,NAME=OUTFIL, ! Open the dump 1 TYPE='UNKNOWN',ACCESS='APPEND') ! file. CALL R50ASC(6,LBLBLK(1,1),TNAME) ! Name to R50 CALL R50ASC(6,LBLBLK(3,1),LNAME) ! Par, too. IF (HDR) THEN ! If a header, CALL R50ASC(6,HEADER(3),TIDNT) ! Do ident. ELSE ! If no header, TIDNT(1) = 0 ! Blank out TIDNT(2) = 0 ! the TIDNT(3) = 0 ! ident. END IF J = TSKFLG ! Get flags. K = 1 ! Init. the SWITCH = ' ' ! swit buff. DO 3520 I=1,16 ! For each bit, IF (J .LT. 0) THEN ! If it's set SWITCH(K:) = LBFLG(I) ! save, K = K + 5 ! skip. END IF J = (J .AND. '77777'O)*2 ! Get next. 3520 CONTINUE K = K - 1 ! Adjust end. IF (K .LE. 0) K = 1 ! Fudge if null. I = INDEX(TSKFIL,' ') - 1 ! File name end WRITE (4,93520) TSKFIL(:I), TNAME, ! Write data 1 TIDNT,LNAME, SWITCH(:K), ! accum. 2 LBLBLK(IPRIL,1), LBLBLK(15,1), ! so 3 LBLBLK(16,1), LBLBLK(14,1) ! far. CCBYTE = '0' ! Dbl space first. I = 17 ! Inx of 1st comm GO TO 3540 ! Check for it. 3530 SWITCH = ' Libr:' ! Assume normal IF ((LBLBLK(I+10,1) .AND. '10'O) .NE. 0) ! If super, 1 SWITCH = ' Suplib:' ! say so. J = INDEX(SWITCH,':')+2 ! Space for name. IF (LBLBLK(I,1) .NE. 0) THEN ! If libr named, CALL R50ASC(6,LBLBLK(I,1),SWITCH(J:))! To ASCII ELSE ! otherwise SWITCH(J:) = '' ! say none. END IF J = INDEX(SWITCH(J:),' ') + J - 1 ! Find end. SWITCH(J:) = ':RO' ! Assume RO. IF (LBLBLK(I+10,1) .LT. 0) ! If read/write, 1 SWITCH(J+1:) = 'RW' ! say so. IF ((LBLBLK(I+10,1) .AND. '10'O) .NE. 0) ! If super, 1 SWITCH(J:) = ' ' ! No RO. J = INDEX(SWITCH(J:),' ') + J - 1 ! Find new end. WRITE (4,93530) CCBYTE, SWITCH(:J), ! Write it. 1 LBLBLK(I+12,1), LBLBLK(I+13,1), 2 LBLBLK(I+11,1) CCBYTE = ' ' ! Single space. I = I + 14 ! Next libr. 3540 IF (LBLBLK(I+5,1) .NE. 0) GO TO 3530 ! If more, get. CCBYTE = '0' ! Dbl space. DO 3550 I = 1,LBLBLK(IPRIL+6,1) ! For each LUN, SWITCH = ' :' ! Assume no assign. IF (LUNTBL(1,I) .GT. 0) THEN ! If an assign, J = 3 ! 3 dgt unt. IF (LUNTBL(2,I) .LT. 64) ! If < 100 octal 1 J = 2 ! 2 digits. IF (LUNTBL(2,I) .LT. 8) ! If < 10 octal 1 J = 1 ! 1 digit. WRITE (SWITCH,93540) ! Encode the 1 LUNTBL(1,I), LUNTBL(2,I)! assign. END IF J = INDEX(SWITCH,':') + 1 ! Find whole thing. WRITE (4,93550) CCBYTE, I, 1 SWITCH(:J) ! Write it. CCBYTE = ' ' ! single space. 3550 CONTINUE CLOSE (UNIT=4) ! Close file. END IF GO TO 3200 ! Go for more. END IF C C....................................................................... C C /[NO]RO - Don't update task image C IF (SWABBR .EQ. 'RO') THEN ! If the readonly switch, RDONLY = ASSERT ! set its state, GO TO 3200 ! go for more switches. END IF C C....................................................................... C C /HE - Print help message. C IF (SWABBR .EQ. 'HE') THEN ! If the help switch, CALL HLPSUB(OUTFIL,DEFSWI) ! print the message. GO TO 3200 ! go for more switches. END IF C C....................................................................... C C Illegal switch. C SWABBR = SWITCH ! Pick up entire sw. SWIERR = 'is not a legal switch.\' ! Unrecognized switch. GO TO 9100 ! Handle it. C C....................................................................... C C End of switches - Decide what to do. C 3900 IF (PROMPT .AND. .NOT. DFLT) GO TO 3000 ! If intractv, get more. C C----------------------------------------------------------------------- C C Write the label blocks back. C 4000 IF (NSWIT .LE. 0 .AND. DEFSWI .NE. ' ') ! If default processing, 1 THEN SWILST = DEFSWI ! Set up switches. CALL INPROC(LEN(SWILST),SWILST, ! Process just in 1 BUFLEN) ! case. BUFLEN = BUFLEN + 1 ! Add to buff. len. SWILST(BUFLEN:BUFLEN) = '/' ! Terminate buffer. NSWIT = NSWIT + 1 ! Prevent loop. DFLT = .TRUE. ! Default proc. GO TO 3200 ! Go process line. END IF IF (ABORT .AND. .NOT. PROMPT) THEN ! If a processing error, WRITE (5,94000) ! remind the user, GO TO 9900 ! and don't update. END IF IF (LBLBLK(1,1) .EQ. DOTS .AND. ! If spawnable and 1 (TSKFLG .AND. '4000'O) .NE. 0) ! slave, 2 WRITE (5,94010) ! warn user. IF (RDONLY) THEN ! If in readonly mode, WRITE (5,94020) ! remind user, GO TO 9900 ! and don't update. END IF DO 4080 I=1,3 ! Write back the WRITE (1'I) (LBLBLK(J,I),J=1,256) ! label blocks. 4080 CONTINUE IF (HDR .AND. HDRUPD) WRITE (1'HDRBLK) HEADER ! Write header. GO TO 9900 ! Go clean up. C C======================================================================= C C Error Handling. C C----------------------------------------------------------------------- C C Open error on task image file. C 9000 I = INDEX(TSKFIL,' ') - 1 ! Find end of task file name. WRITE (5,99000) TSKFIL(:I) ! Write the error. ABORT = .TRUE. ! Force an abort. GO TO 9900 ! Go die. C C----------------------------------------------------------------------- C C Switch/Keyword errors of all kinds. C 9100 I = INDEX(SWITCH,' ') ! Find end of switch. IF (I .GT. 0) I = MAX(I-2,1) ! If space found, take out. IF (I .LE. 0) I = LEN(SWITCH) ! If no space, use all. ABORT = .TRUE. ! Fatal error. J = INDEX(SWIERR,'\') - 1 ! Size the error message. IF (J .LE. 0) THEN ! If none, SWIERR = ' ' ! Fudge J = 1 ! one. END IF WRITE (5,99100) SWITCH(:I), ! Write the error 1 SWIERR(:J) ! message. GO TO 3200 ! Go for next switch. C C======================================================================= C C Exit C 9900 CLOSE (UNIT=1) ! Close task file if any. IF (PROMPT) GO TO 2000 ! If interactive, go again. 9990 CLOSE (UNIT=1) ! Close task file if any. CALL EXIT ! Exit. END SUBROUTINE INPROC(BUFLEN,BUF,LENOUT) INTEGER*2 BUFLEN ! Length of buffer. LOGICAL*1 BUF(BUFLEN) ! Buffer to convert. INTEGER*2 LENOUT ! Converted length. C LOGICAL*1 AYE ! = ASCII 'a'. LOGICAL*1 SPACE ! = ASCII . LOGICAL*1 ZEE ! = ASCII 'z'. C DATA AYE /'141'O/ DATA SPACE /'40'O/ DATA ZEE /'172'O/ C LENOUT = 0 ! Init the converted length. C DO 100 I=1,BUFLEN ! For each character, IF (BUF(I) .LE. SPACE) ! Ignore spaces and control 1 GO TO 100 ! characters. IF (BUF(I) .GE. AYE .AND. ! If it's a lower-case 1 BUF(I) .LE. ZEE) ! alphabetic, 2 BUF(I) = BUF(I) - '40'O ! convert to upper-case. LENOUT = LENOUT + 1 ! Count another character. BUF(LENOUT) = BUF(I) ! Move the character down. 100 CONTINUE C DO 200 I=LENOUT+1,BUFLEN ! Pad the remainder of the BUF(I) = SPACE ! string with spaces. 200 CONTINUE C RETURN END SUBROUTINE HLPSUB(OUTFIL,DEFSWI) CHARACTER*40 OUTFIL ! Output file name. CHARACTER*80 DEFSWI ! Default switches. C OPEN (UNIT=4,NAME=OUTFIL, ! Open the output 1 TYPE='UNKNOWN',ACCESS='APPEND') ! file. WRITE (4,100) ! Write the data. J = INDEX(DEFSWI,' ') - 1 ! Find end of deflts. IF (J .GT. 0) ! If defaults, 1 WRITE (4,200) DEFSWI(:J) ! write them out. CLOSE (UNIT=4) ! Close it. RETURN 100 FORMAT ( * '0TIZ is a task to simplify the modification of task',/, * ' image files. It offers TKB-like keyword modifica-',/, * ' tion of those task attributes that are represented',/, * ' as values in label blocks 0-2. The keywords impli-',/, * ' mented at the moment are:',/, * ' ',8X,'/ASG=dev:lun - Change LUN device assignment',/, * ' ',8X,'/[NO]CP - Enable/disable checkpointing',/, * ' ',8X,'/[NO]DU - Dump label block after run',/, * ' ',8X,'/HE - Help message',/, * ' ',8X,'/IDENT=idnt - Change task ident',/, * ' ',8X,'/[NO]IP - Warning when map I/O page',/, * ' ',8X,'/LIBR=nam:ac - Change library/common access',/, * ' ',8X,'/[NO]PM - Generate postmortem dump',/, * ' ',8X,'/PAR=name - Change partition name',/, * ' ',8X,'/PRI=n - Change priority',/, * ' ',8X,'/[NO]RO - Don''t update task image',/, * ' ',8X,'/[NO]SL - Install with slave attribute',/, * ' ',8X,'/TASK=name - Change task name',/, * ' ',8X,'/XHR=NO - Don''t install w/ external hdr',/, * ' ',8X,' =MAYBE - Allow external header',/, * ' ',8X,' =YES - Install with external header',/, * ' Those switches/keywords which can be negated are',/, * ' negated by prefacing either "NO" or "-".',/, * ' ',/, * ' TIZ can be invoked either as a command line or',/, * ' in conversational mode.',/, * ' ') 200 FORMAT ( * ' If no switches or keywords are specified, the follow-',/, * ' ing switches will be used:',/, * ' ',8X,A,/, * ' ') END SUBROUTINE FILDEF(NAME,DEF) CHARACTER*40 NAME,DEF C CHARACTER*40 SCR C INAM = 1 IDEF = 1 ISCR = 1 DO 100 I=1,5 JNAM = INDEX(NAME(INAM:),'\') + INAM - 2 JDEF = INDEX(DEF(IDEF:),'\') + IDEF - 2 IF (JNAM .GE. INAM) THEN SCR(ISCR:) = NAME(INAM:JNAM) ISCR = ISCR + JNAM - INAM + 1 ELSE IF (JDEF .GE. IDEF) THEN SCR(ISCR:) = DEF(IDEF:JDEF) ISCR = ISCR + JDEF - IDEF + 1 END IF END IF INAM = JNAM + 2 IDEF = JDEF + 2 100 CONTINUE NAME = SCR RETURN END SUBROUTINE FILSTR(NAME) CHARACTER*40 NAME C CHARACTER*10 ELEM(5) INAM = 1 MNAM = INDEX(NAME,' ') DO 10 I=1,5 ELEM(I) = ' ' 10 CONTINUE C MNAM = MNAM - 1 IF (MNAM .LT. INAM) GO TO 90 JNAM = INDEX(NAME(INAM:MNAM),':') + INAM - 1 IF (JNAM .GE. INAM) THEN ELEM(1) = NAME(INAM:JNAM) INAM = JNAM + 1 END IF C IF (MNAM .LT. INAM) GO TO 90 JNAM = INDEX(NAME(INAM:MNAM),']') + INAM - 1 IF (JNAM .GE. INAM) THEN ELEM(2) = NAME(INAM:JNAM) INAM = JNAM + 1 END IF C IF (MNAM .LT. INAM) GO TO 90 JNAM = INDEX(NAME(INAM:MNAM),';') + INAM - 1 IF (JNAM .GE. INAM) THEN ELEM(5) = NAME(JNAM:MNAM) MNAM = JNAM - 1 END IF C IF (MNAM .LT. INAM) GO TO 90 JNAM = INDEX(NAME(INAM:MNAM),'.') + INAM - 1 IF (JNAM .GE. INAM) THEN ELEM(4) = NAME(JNAM:MNAM) MNAM = JNAM - 1 END IF C IF (MNAM .LT. INAM) GO TO 90 ELEM(3) = NAME(INAM:MNAM) C 90 INAM = 1 DO 100 I = 1,5 JNAM = INDEX(ELEM(I),' ') - 1 IF (JNAM .GT. 0) THEN NAME(INAM:) = ELEM(I)(:JNAM) END IF INAM = INAM + JNAM + 1 NAME(INAM-1:) = '\' 100 CONTINUE RETURN END