SUBROUTINE SYSGCM ! Get command from command line. INCLUDE 'IPCOMM.FTN' CALL GETMCR(IPBUF,IPSLEN) ! Get the command from MCR. IPSLOC = 1 ! Init the location. IF (IPSLEN .GT. 0) ! If we have a line, 1 CALL UPCASE(IPSLEN,IPBUF) ! uppercase it. CALL IPR50(0) ! Strip the command name. RETURN END SUBROUTINE SYSHLP ! Issue a help command. INCLUDE 'FIGI01.FTN' INCLUDE 'IPCOMM.FTN' LOGICAL*1 HLPCMD(80) ! HELP command. LOGICAL*1 HLPCON(16) ! Constant part of command. INTEGER*2 IPXLOC ! Original location of HELP. INTEGER*2 IPHLOC ! Location of first keywd. INTEGER*2 IPHEND ! Location of end of cmd. INTEGER*2 HCLEN ! Length of help command. INTEGER*4 MCR ! Name of CLI to spawn. DATA HLPCON /'H','E','L','P','/','F','I','G',' ', 1 'F','I','G','U','R','E',' '/ DATA MCR /6RMCR.../ IPXLOC = IPLOC ! Save location of "HELP". IPHLOC = 0 ! Assume no arguments. 1000 IF (.NOT. IPANY()) GO TO 2000 ! If no more characters, die. IF (IPMCH .EQ. ';') GO TO 2000 ! If terminator, quit. IPHLOC = IPLOC ! Find the first parameter. 1100 IF (.NOT. IPANY()) GO TO 2000 ! If no more characters, die. IF (IPMCH .NE. ';') GO TO 1100 ! If not separator, continue. 2000 IPHEND = IPLOC - 1 ! Last valid character. IPLOC = IPXLOC ! Restore location. IPLEN = IPHEND - IPLOC ! Set up actual length. DO 2010 I=1,16 ! Loop thru constant part. HLPCMD(I) = HLPCON(I) ! Copy it in. 2010 CONTINUE ! Repeat as needed. HCLEN = 15 ! Assume that's all. IF (IPHLOC .EQ. 0) GO TO 3000 ! If no args, quit. HCLEN = 16 ! Pick up the space. DO 2110 I=IPHLOC,IPHEND ! Loop thru arguments. HCLEN = HCLEN + 1 ! Got another character. HLPCMD(HCLEN) = IPBUF(I) ! Stick it in the cmd. 2110 CONTINUE ! Repeat as needed. 3000 CONTINUE ! Now spawn the command. D WRITE (LUNOUT,3010) ! Display the D 1 (HLPCMD(I),I=1,HCLEN) ! generated command. D3010 FORMAT (' FIG - Debug - Generated HELP command is',/, D 1 15X,'"',A,'".') CALL SPAWN(MCR,,,1,,,, ! Spawn it to MCR. 1 HLPCMD,HCLEN) CALL WAITFR(1) ! Wait for completion. RETURN ! Return to caller. END ! End of module. SUBROUTINE SYSOPN(LUN,NAMLEN,NAM,IDSW) ! Open a file. INTEGER*2 LUN ! Logical unit. INTEGER*2 NAMLEN ! Length of name. LOGICAL*1 NAM(NAMLEN) ! Name. INTEGER*2 IDSW ! Status. LOGICAL*1 FILNAM(40) ! Real name. INTEGER*2 FILLEN ! Real length. INTEGER*2 SY ! = ASCII 'SY' LOGICAL*1 FIG(4) ! File type. INTEGER*2 TYPE ! .TRUE. if type found. INCLUDE 'FIGI01.FTN' DATA SY /'SY'/ DATA FIG /'.','F','I','G'/ TYPE = .FALSE. ! Type not found. INDEX = 0 ! Input index. FILLEN = 0 ! Output index. 1000 INDEX = INDEX + 1 ! Inc. input index. IF (NAM(INDEX) .EQ. '.') ! If type marker, 1 TYPE = .TRUE. ! we have type. IF (TYPE) GO TO 1800 ! If already have type. IF (NAM(INDEX) .NE. ';') ! If not to version yet, 1 GO TO 1800 ! go copy. 1200 DO 1290 I=1,4 ! Loop thru type, FILLEN = FILLEN + 1 ! Counting another char FILNAM(FILLEN) = FIG(I) ! and filling it in. 1290 CONTINUE ! Repeat until done. TYPE = .TRUE. ! We have type now. IF (INDEX .GT. NAMLEN) ! If no more name, 1 GO TO 1990 ! quit. 1800 FILLEN = FILLEN + 1 ! Got another character. FILNAM(FILLEN) = NAM(INDEX) ! Copy it. 1900 IF (INDEX .LT. NAMLEN) ! If more to copy, 1 GO TO 1000 ! go do it. INDEX = INDEX + 1 ! Inflate index. IF (.NOT. TYPE) GO TO 1200 ! If need type, handle. 1990 CONTINUE D WRITE (LUNOUT,1999) (FILNAM(J),J=1,FILLEN) ! Display file name. D1999 FORMAT (' Debug - Opening file "',A1,'".') FILLEN = FILLEN + 1 ! Increase by 1, and FILNAM(FILLEN) = 0 ! insert the null. CALL ASNLUN(LUN,SY,0,IDSW) ! Assign LUN. IF (IDSW .LT. 0) GO TO 9000 ! If failed. OPEN (UNIT=LUN,NAME=FILNAM, ! Open the 1 TYPE='OLD',READONLY,SHARED, ! desired 2 ERR=9000) ! file. IDSW = .TRUE. ! Success. GO TO 9900 ! Return. 9000 IDSW = .FALSE. ! Failure. 9900 RETURN ! Return. END