MINICERN/packlib/kernlib/kerngen/tcgen/vaxsys/getarg.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:59  mclareni
   6 * Kernlib
   7 *
   8 *
   9       INTEGER FUNCTION GETARG (JARG,TEXT)
  10
  11 C CERN PROGLIB# Z265    GETARG          .VERSION KERNVAX  2.45  940228
  12 C ORIG. 16/02/94 MM+JS+JZ
  13
  14 C-    Simulate UNIX system calls GETARG, IARGC
  15
  16       INCLUDE '($JPIDEF)'
  17
  18       CHARACTER       CHWK*1024
  19       COMMON /CHSLAT/ CHWK
  20       COMMON /SLATE/ NDSLAT, NESLAT, ISLATE(38)
  21       CHARACTER    TEXT*(*)
  22       INTEGER*2    LGR
  23
  24       CHARACTER    COMD*256
  25       INTEGER      NARGS, NCOMD
  26       SAVE         NARGS, NCOMD, COMD
  27       DATA NARGS  / -1 /
  28
  29 C----              Doing GETARG
  30
  31       GETARG = 0
  32       MODE = 0
  33       IF (NARGS.LT.0)              GO TO 71
  34    22 TEXT = ' '
  35       IF (JARG.EQ.0)               GO TO 41
  36       IF (JARG.GT.NARGS)           RETURN
  37       IF (JARG.LE.0)               RETURN
  38
  39       JNX = 1
  40       JL  = 0
  41    24 JL  = JL + 1
  42       JGO = JNX
  43       JF  = ICNEXT (COMD,JGO,NCOMD)
  44       IF (COMD(JF:JF).EQ.'"')  THEN
  45           JF  = JF + 1
  46           JNX = ICFIND ('"', COMD,JF,NCOMD)
  47           N   = JNX - JF
  48           JNX = JNX + 1
  49         ELSE
  50           JNX = NESLAT
  51           N   = NDSLAT
  52         ENDIF
  53       IF (JL.LT.JARG)              GO TO 24
  54       IF (N.GT.0)  TEXT(1:N) = COMD(JF:JF+N-1)
  55       RETURN
  56
  57 C--           doing GETARG (0, TEXT), get image-name as for Unix
  58
  59    41 NDSLAT = LIB$GETJPI (JPI$_IMAGNAME,,,,CHWK,%REF(LENSTR))
  60       IF (.NOT.NDSLAT)             RETURN
  61       ISTAT = LIB$TRIM_FILESPEC (CHWK(1:LENSTR),TEXT,LEN(TEXT),)
  62       NDSLAT = 0
  63       RETURN
  64
  65 C----              Doing IARGC
  66
  67       ENTRY  IARGC()
  68
  69       MODE = 1
  70       IF (NARGS.LT.0)              GO TO 71
  71    68 IARGC = NARGS
  72       RETURN
  73
  74 C----              Load the calling command
  75
  76    71 COMD = ' '
  77       CALL LIB$GET_FOREIGN (COMD,,LGR)
  78
  79       NARGS = 0
  80       IF (LGR.EQ.0)                GO TO 77
  81
  82       NCOMD = LNBLNK (COMD(1:LGR))
  83       IF (NCOMD.EQ.0)              GO TO 77
  84
  85       JGO   = 1
  86    74 NARGS = NARGS + 1
  87       JF  = ICNEXT (COMD,JGO,NCOMD)
  88       IF (COMD(JF:JF).EQ.'"')  THEN
  89           JF  = JF + 1
  90           JGO = ICFIND ('"', COMD,JF,NCOMD) + 1
  91         ELSE
  92           JGO = NESLAT
  93         ENDIF
  94       IF (JGO.LE.NCOMD)            GO TO 74
  95
  96    77 IF (MODE.EQ.0)               GO TO 22
  97       GO TO 68
  98       END