;
;  COMMAND FILE TO BUILD GETTSK TASK
;
.OPEN GETTSK.FTN;100
.ENABLE DATA
      PROGRAM GETTSK
C+
C GETTSK PROGRAM
C	PROGRAM TO READ TASK HEADER AND RETURN TASK
C	INFORMATION TO LIST FILE
C
C  WRITTEN BY:  DAVID J. STRAIT      17-JAN-82
C               APPLIED DYNAMICS INTERNATIONAL
C
C  REVISION: 19-JAN-82     BY: DJS
C  REVISION: 15-MAY-82     BY: DJS
C
C  INPUT:
C	>RRM $GETTSK LSTFILE=TASKFILE
C	OR
C	>RUN $GETTSK
C	GETTSK>LSTFILE=TASKFILE
C
C	IF NO "=" LIST GOES TO TI:
C
C   OUTPUT:
C	FILE NAMED GETS TASK INFORMATION
C
C  SUBS CALLED:
C	SETEXT	- SET FILE EXTENSION
C-
      LOGICAL*1 TSKPAR(12),LIBNAM(6),CMDBUF(80)
      INTEGER*2 CMDBEG,CMDLEN,LSTSIZ,TSKBEG
      INTEGER*2 NBLOCK,BLOCK(256),SIZE,I,LST,TSK
      EQUIVALENCE (TSKPAR(1),LIBNAM(1))
      REAL*4 MONTH(12)
      DATA LST,TSK/3RLST,3RTSK/
      DATA MONTH/'JAN-','FEB-','MAR-','APR-','MAY-','JUN-',
     1 'JUL-','AUG-','SEP-','OCT-','NOV-','DEC-'/
C
C  GET COMMAND LINE
C
      CMDBEG = 1
   5  CALL ASSIGN(1,'TI:',3)
      CALL GETMCR(CMDBUF,CMDLEN)
      IF (CMDLEN.LE.0) GO TO 20
      DO 10 I = 1,CMDLEN
         CMDBEG = CMDBEG + 1
         IF (CMDBUF(I).EQ.' ') GO TO 25
  10  CONTINUE
C
  20  WRITE(1,1001)
1001  FORMAT('$GETTSK>')
      READ(1,1000,END=9999) CMDLEN,CMDBUF
1000  FORMAT(Q,80A1)
C
C  FIND IF AN EQUALS
C
  25  DO 30 I = CMDBEG,CMDLEN
        IF (CMDBUF(I).NE.'=') GO TO 30
          LSTSIZ = I - CMDBEG
          TSKBEG = I + 1
          CALL ASSIGN(1,'SY:',3)
          CALL ASSIGN(1,CMDBUF(CMDBEG),LSTSIZ)
          CALL SETEXT(1,LST)
          GO TO 35
  30  CONTINUE
      TSKBEG = CMDBEG
C
C  OPEN TASK FILE
C
  35  WRITE(1,1010) (CMDBUF(I),I=TSKBEG,CMDLEN)
1010  FORMAT(' DISPLAY OF TASK FILE ',80A1)
      CALL ASSIGN(2,CMDBUF(TSKBEG),CMDLEN-TSKBEG+1)
      CALL SETEXT(2,TSK)
      CALL FDBSET(2,'R')
      DEFINE FILE 2("77777,256,U,NBLOCK)
C
C  READ FIRST BLOCK
C
      READ(2'1,ERR=9010) BLOCK
C
C  WRITE TASK, PARTITION NAMES ECT.
C
      CALL R50ASC(12,BLOCK,TSKPAR)
      WRITE(1,1020) TSKPAR,BLOCK(16),MONTH(BLOCK(15)),BLOCK(14)+1900
1020  FORMAT(' TASK NAME = ',6A1,/,' PARTITION NAME = ',6A1,
     1 /,' CREATION DATE = ',I2,'-',1A4,I4)
      WRITE(1,1025) BLOCK(5),BLOCK(6)
1025  FORMAT(' TASK ADDRESS LIMITS ',2O7)
      ISIZE = ((BLOCK(6)-BLOCK(5)+1)/2) .AND. "77777
      WRITE(1,1030) BLOCK(116),BLOCK(117),BLOCK(118),ISIZE,
     1 ISIZE+BLOCK(118)*32
1030  FORMAT(' PRIORITY = ',I3,'.',/,' TRANSFER ADDRESS = ',O6,
     1 /,' TASK EXTENSION = ',I6,'.',/,' TASK SIZE IN WORDS = ',I6,'.',
     2 /,' TASK SIZE WITH EXTENSION =',I6,'.')
C
C  PRINT LIBRARY / COMMON INFRO
C
      IPNT = 17
  40  IF (BLOCK(IPNT).EQ.0) GO TO 50
        CALL R50ASC(6,BLOCK(IPNT),LIBNAM)
        WRITE(1,1040) LIBNAM,BLOCK(IPNT+2),BLOCK(IPNT+13),
     1   MONTH(BLOCK(IPNT+12)),BLOCK(IPNT+11)+1900
1040    FORMAT('0LIBARY / COMMON NAME =',6A1,/,'  BASE ADDRESS = ',O6,
     1   /,'  CREATION DATE = ',I2,'-',A4,I4)
        IPNT = IPNT + 14
        GO TO 40
  50  CONTINUE
C
C  PRINT LUNS
C
      NLUNS = BLOCK(122)
      IF (NLUNS.EQ.0) GO TO 100
      WRITE(1,1050)
1050  FORMAT('0LUNS')
      READ(2'2) BLOCK
      IPNT = 1
      DO 60 I =1,NLUNS
        WRITE(1,1060) I,BLOCK(IPNT),BLOCK(IPNT+1)
1060    FORMAT(2X,I3,' - ',A2,I3,':')
        IPNT = IPNT + 2
        IF (I.NE.128) GO TO 60
          READ(2'3) BLOCK
          IPNT = 1
  60    CONTINUE
C
C  CLOSE FILE AND EXIT
C
 100  CALL CLOSE(1)
      CALL CLOSE(2)
      IF (CMDBEG.EQ.1) GO TO 5
      GO TO 9999
C
C
C  ERRORS
C
9000  CALL CLOSE(1)
      CALL ASSIGN(1,'TI:')
      WRITE(1,1900) (CMDBUF(I), I = CMDBEG,CMDBEG+LSTSIZ-1)
1900  FORMAT(' GETLEN - ERROR, WRITING LIST FILE -',80A1)
      GO TO 9999
C
9010  CALL CLOSE(1)
      CALL ASSIGN(1,'TI:')
      WRITE(1,1910) (CMDBUF(I),I=TSKBEG,CMDLEN)
1910  FORMAT(' GETLEN - ERROR, READING TASK FILE - ',40A1)
C
C  EXIT
C
9999  CALL EXIT
      END
.DISABLE DATA
.CLOSE
.OPEN SETEXT.MAC;100
.ENABLE DATA
	.TITLE	SETEXT - SET DEFAULT EXTENTION
	.IDENT	/16AUG9/
	.MCALL	FDOF$L
	FDOF$L
;
;  SETEXT ROUTINE
;	ROUTINE TO SET FILE EXTENSION FOR A FORTRAN LUN
;
;  CALL PROCEDURE: FORTRAN
;	INTEGER*2 EXT
;	DATA EXT/3REXT/
;	...
;	CALL SETEXT(LUN,EXT)
;
SETEXT::
	MOV	@2(R5),R2	; GET LUN
	MOV	#$OTSVA,R3	; FORTRAN JUNK AREA
	JSR	PC,$FCHNL	; GET FORTRAN HEADER
	ADD	#F.FDB-S.FDB,R0	; REMOVE FTN HEADER FROM FDB
	BIT	#S.FTYP,F.FNB+N.STAT(R0); TYPE SPECIFIED?
	BNE	1$		; YES, FORGET IT
	MOV	@4(R5),F.FNB+N.FTYP(R0); MOVE IN DEFAULT FILENAME
	BIS	#S.FTYP,F.FNB+N.STAT(R0); MARK TYPE SET
1$:
	RTS	PC		; ALL DONE!!!
	.END
.DISABLE DATA
.CLOSE
.OPEN GETTSK.TKB;100
.ENABLE DATA
GETTSK;1/CP,GETTSK;1/-SP/-WI=GETTSK,SETEXT,LB:[1,1]FOROTS/LB:$SHORT
,LB:[1,1]FOROTS/LB
/
UNITS=2
ACTFIL=2
TASK=...GTS
;LIBR=FCSRES:RO
MAXBUF=512
//
.DISABLE DATA
.CLOSE
.;
.;
FOR GETTSK;1=GETTSK/-SN/CD:THR
MAC SETEXT;1=SETEXT
.;
.;
TKB @GETTSK.TKB
.;
PIP GETTSK.OBJ;1,GETTSK.FTN;100,GETTSK.TKB;100/DE
PIP SETEXT.MAC;100,SETEXT.OBJ;1/DE