*******************************************************************************
*
*	Support the Ultimate get statement.  This routine is called by
*	calls inserted into user's code by the basic compiler.
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	10/14/98 23801 SAP Change copyrights. 
*	01/24/96 17671 LAG Remove \ as quoted argument on Win9X and WINNT
*	08/11/92 9308  PVW Add check mode 1, if i=argnum-1 and userval#""
*	10/16/91 8698  DTM Correct \ as quoted argument
*	08/10/88 6710  JWT recognize quoted args
*	07/25/88   -    -  Maintenence log purged at 5.2.1, see release 5.1.10.
*
*******************************************************************************

$OPTIONS DEFAULT

      SUBROUTINE	GET(rtncode, argnum, userval, mode )

$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME

*
* This routine will be called by code generated by the BASIC
* compiler.   The variable 'rtncode' will be set to success ('1')
* or failure ('0'). The variable 'mode' tells the routine whether
* to 
* 1) set up the initial argumnet string
* 2) return the next argument
* 3) set the remove pointer to a specific argument

      EQU SUCCESS TO 1
      EQU FAILURE TO 0
      EQU INITTED TO @RECUR0
      EQU UEOF TO @RECUR1
      EQU UARGS TO @RECUR2
	

      OPEN "","VOC" TO fv ELSE
         PRINT "subroutine *GET is unable to OPEN your VOC"
         STOP
      END

      BEGIN CASE
         CASE mode = 0
* called to find the arguments and initialize uarg
            IF INITTED = 0 THEN
               INITTED = 1
		tempsen = TRIMF(@SENTENCE)
		temp = ""
		LOOP
		UNTIL tempsen = "" do

		******************
		** Windows NT port
		**
		IF OS.TYPE = "UNIX"
		THEN

			BEGIN CASE

			CASE tempsen[1,1] = "'"
				qpos = index(tempsen[2,999],"'",1)
				if qpos = 0 then qpos = len(tempsen)+1
				temp := tempsen[2,qpos-1]
				tempsen = TRIMF(tempsen[qpos+2,999])

			CASE tempsen[1,1] = "\"
				qpos = index(tempsen[2,999],"\",1)
				if qpos = 0 then qpos = len(tempsen)+1
				temp := tempsen[2,qpos-1]
				tempsen = TRIMF(tempsen[qpos+2,999])

			CASE tempsen[1,1] = '"'
				qpos = index(tempsen[2,999],'"',1)
				if qpos = 0 then qpos = len(tempsen)+1
				temp := tempsen[2,qpos-1]
				tempsen = TRIMF(tempsen[qpos+2,999])

			CASE 1
				qpos = 1000
				tpos = index(tempsen[1,999],"'",1)
				if tpos and tpos < qpos then qpos = tpos
				tpos = index(tempsen[1,999],'"',1)
				if tpos and tpos < qpos then qpos = tpos
				tpos = index(tempsen[1,999],"\",1)
				if tpos and tpos < qpos then qpos = tpos
				tpos = index(tempsen[1,999],"	",1)
				if tpos and tpos < qpos then qpos = tpos
				tpos = index(tempsen[1,999]," ",1)
				if tpos and tpos < qpos then qpos = tpos
				temp := tempsen[1,qpos-1]
				tempsen = TRIMF(tempsen[qpos,999])
			END CASE

		END
		ELSE

			BEGIN CASE

			CASE tempsen[1,1] = "'"
				qpos = index(tempsen[2,999],"'",1)
				if qpos = 0 then qpos = len(tempsen)+1
				temp := tempsen[2,qpos-1]
				tempsen = TRIMF(tempsen[qpos+2,999])

			CASE tempsen[1,1] = '"'
				qpos = index(tempsen[2,999],'"',1)
				if qpos = 0 then qpos = len(tempsen)+1
				temp := tempsen[2,qpos-1]
				tempsen = TRIMF(tempsen[qpos+2,999])

			CASE 1
				qpos = 1000
				tpos = index(tempsen[1,999],"'",1)
				if tpos and tpos < qpos then qpos = tpos
				tpos = index(tempsen[1,999],'"',1)
				if tpos and tpos < qpos then qpos = tpos
				tpos = index(tempsen[1,999],"	",1)
				if tpos and tpos < qpos then qpos = tpos
				tpos = index(tempsen[1,999]," ",1)
				if tpos and tpos < qpos then qpos = tpos
				temp := tempsen[1,qpos-1]
				tempsen = TRIMF(tempsen[qpos,999])
			END CASE

		END
		**
		******************

			if tempsen # "" then temp := @FM
		REPEAT

               READV verbtype FROM fv,temp<1>,3 ELSE
                  verbtype = "B"
               END
               verbtype = UPCASE(verbtype[1,1])
               argc = DCOUNT(temp,@FM)
               IF verbtype = "I" THEN
* RUN command or synonym
                  IF argc < 4 THEN
* no arguments
                     UARGS = ""
                     UEOF = 1
                     rtncode = FAILURE
                  END ELSE
                     UARGS = FIELD(temp,@FM,4,999)
                     UEOF = 0
                     rtncode = SUCCESS
                  END
               END ELSE
* CATALOGed program
                  UARGS = FIELD(temp,@FM,2,999)
                  UEOF = DCOUNT(UARGS,@FM) # 0
                  rtncode = SUCCESS
               END
            END ELSE
               RETURN
            END


         CASE mode = 1
* called to get next or specific argument
	    save = userval
            IF argnum THEN
               UARGS = UARGS            ;* reset REMOVE pointer
               UEOF = 0;
	       i = 0
	       LOOP
	       WHILE i < argnum
                  REMOVE userval FROM UARGS SETTING delim
                  if delim = 0 THEN UEOF = 1
	       UNTIL UEOF DO
		  i+=1
	       REPEAT

               IF UEOF THEN
			BEGIN CASE
			CASE (i=argnum-1 AND userval#"")
				rtncode = SUCCESS
			CASE 1
                  		rtncode = FAILURE
		  		userval = save
			END CASE
               END ELSE
                  rtncode = SUCCESS
               END
            END ELSE
               REMOVE userval FROM UARGS SETTING delim
               if delim = 0 THEN UEOF = 1
               IF userval # "" THEN
                  rtncode = SUCCESS
               END ELSE
                  rtncode = FAILURE
		  userval = save
               END
            END
         CASE mode = 2
* called to set the remove pointer to some value
            IF argnum THEN
               UARGS = UARGS            ;* reset REMOVE pointer
               UEOF = 0;
               FOR i = 1 TO argnum-1 UNTIL UEOF
                  REMOVE dummy FROM UARGS SETTING delim
                  if delim = 0 THEN UEOF = 1
               NEXT i
               rtncode = NOT(UEOF)
            END ELSE
               IF UEOF THEN 
                  rtncode = 0
               END ELSE
                  REMOVE dummy FROM UARGS SETTING delim
                  if delim = 0 THEN UEOF = 1
                  rtncode = NOT(UEOF)
               END
            END
            
         CASE mode = 3
            rtncode = UEOF

         CASE 1
            rtncode = FAILURE
            
      END CASE

      RETURN