tldm-universe/Ardent/UV/APP.PROGS/DC.F

subroutine DC.F( psource, ucode, result )
*******************************************************************************
*
*	Convert dictionary item(s) from Pick to Uni*Verse format:
*	parse F correlative/conversion for correct syntax
*
*	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/22/98 23801 SAP Change company name to Ardent
*	10/14/98 23801 SAP Change copyrights. 
*	07/25/88   -    -  Maintenence log purged at 5.2.1, see release 5.1.10.
*
*******************************************************************************
*
*	The basis for this Pick-to-Uni*Verse dictionary converter was a
*	Microdata-to-Prime converter written by J. Michael Cannady and
*	Thomas J. Rauschenbach of Fulcrum Computer Group, Inc.  Ardent 
*	was granted permission to use that code by Infocel, Inc., a successor
*	of Fulcrum.
*
*******************************************************************************
*
*    Parse F correlative/conversion for correct syntax
*
*    Arguments:
*	psource - the Pick dictionary item's correlative code
*	ucode   - the returned Uni*Verse I descriptor code
*	result  - Boolean: returned "true" if the conversion is successful,
*		  false otherwise
*
*******************************************************************************
*
$options DEFAULT
$include UNIVERSE.INCLUDE DC.COMM.DECL
*
*
      equ true to 1 , false to 0
      result = true
*
      if PARSE.ONLY then
	 word = "conversion"
      end else
	 word = "correlative"
      end
*
*     << Strip off the "F;" >>
*
      ucode = "F"
      psource = psource[ 2, len( psource )]
*
*     << Now process the bulk of the F correlative. >>
*
      loop
         char1 = psource[ 1, 1 ]
      until char1 = @VM or char1 = "" do
         char2 = psource[ 2, 1 ]
*
         begin case
*
	    case char1 = " "
		psource = psource[ 2, len( psource )]
*
	    case psource[ 1, 3 ] = "LPV"
		if PARSE.ONLY then
		    ucode := "LPV"
		end else
		    ucode := '""'
		    call @DC.MESSAGE( '"LPV" not supported in correlatives.  Null used.', "" )
		end
		psource = psource[ 4, len( psource )]
*
            case char1 matches "1N" 
*
*              << It's an attribute number.  Get all the digits. >>
*
               loop
                  temp = psource[ 1, 1 ]
               while temp matches "1N" do
                  ucode := temp
                  psource = psource[ 2, len( psource ) ]
               repeat
*
*              << Is there an "R" (multivalue reuse)? >>
*
               if temp = "R" then
                  psource = psource[ 2, len( psource ) ]
                  ucode := "R"
               end
*
            case char1 = "(" 
*
*              << It's some conversion.  Parse it for validity. >>
*
		hold.psource = psource
		conv.source = ""
		open.parens = 0
		hit.vm = false
		pos = 1
		loop
		    temp = psource[ pos, 1 ]
		    begin case
		    	case temp = "(" 
			    open.parens += 1
			case temp = ")" 
			    open.parens -= 1
			case temp = @VM and open.parens
*
*			    << If some asshole puts multivalued conversions >> 
*			    << into an F, change the "]" to ")(".	    >>
*
			    temp = ")"
			    hit.vm = true
			    open.parens -= 1
			case 1
			    null
		    end case
		    conv.source := temp
		    pos += 1
		until pos > len( psource ) or not( open.parens ) do
		repeat
		if open.parens then
		    call @DC.MESSAGE( "F " : word : " missing closing parenthesis: ", psource )
		    result = false
		    return
		end
		conv.code = ""
		save.parse = PARSE.ONLY
		PARSE.ONLY = true
		call @DC.CORR.CONV( "", "", conv.source, conv.code, result )
		PARSE.ONLY = save.parse
		if not( result ) then 
		    call @DC.MESSAGE( "Invalid conversion specification within F " : word : ":", ucode : " " : psource )
		    ucode = ""
		    return
		end
		ucode := conv.code
		if hit.vm then
		    psource = "(" : hold.psource[ pos, len( psource )]
		end else
		    psource = hold.psource[ pos, len( psource )]
		end
*
            case char1 = "[" and char2 = "]"
*
*              << Take a substring of Stack 3 value, using Stack 2 as >>
*              << starting character position and Stack 1 as length.  >>
*                 Put resulting substring in Stack 1. >>
*
		ucode := "[]"
		psource = psource[ 3, len( psource ) ]
*
	    case char1 = "'" or char1 = "\" or ( char1 = '"' and ( char2 <> "" and char2 <> ";" and char2 <> @VM and char2 <> ")" ))
*
*		<< Quoted string or constant.  Get it all. >>
*
		quote = char1
		loop
		    ucode := char1
		    psource = psource[ 2, len( psource )]
		    char1 = psource[ 1, 1 ]
		while len( psource ) and char1 <> quote do
		repeat
		if char1 <> quote then
		    call @DC.MESSAGE( "Quoted string missing closing quotation mark:", psource )
		    ucode = ""
		    result = 0
		    return
		end
		ucode := quote
		psource = psource[ 2, len( psource )]
*
            case char1 = "C" 
*
*              << Push a constant value onto the stack. >>
*
		loop
		    char1 = psource[ 1, 1 ]
 		until char1 = ";" or char1 = "" or char1 = @VM or char1 = "(" do
		    psource = psource[ 2, len( psource ) ]
		    ucode := char1
		repeat
*
	    case char1 = "N"
*
*		<< See if it's one of the special F code operands:   >>
*		<< current Break level, number of detail lines since >>
*		<< last BREAK, current item counter, current sub-    >>
*		<< multivalue counter, current multivalue counter.   >>
*
		if index( "BDISV", char2, 1 ) then
		    ucode := "@" : char1 : char2
		    psource = psource[ 3, len( psource )]
		end else
		    call @DC.MESSAGE( "Invalid special F code operand:", "N" : psource )
		    ucode = ""
		    result = false
		    return
		end
*
            case index( "-/R:", char1, 1 )
*
*		<< Subtract Stack 1 from Stack 2; divide Stack 2 by	 >>
*		<< Stack 1; get the remainder after dividing Stack 2 by  >>
*	 	<< Stack 1; concatenate Stack 1 onto the end of Stack 2. >>
*		<< Microdatas perform these operations backwards from    >>
*		<< other Pick systems, so if this is a Microdata, we'll  >>
*		<< add an exchange operator before adding the current	 >>
*		<< operator.						 >>
*
		if SOURCE.MACHINE = "M" then
		    ucode := "_;"
		end
		ucode := char1
		psource = psource[ 2, len( psource ) ]
*
            case index( ';DT+*SP_^][=#<>"&!', char1, 1 ) 
*
*		<< Semicolon delimiter,			>>
*		<< system date,				>>
*		<< system time,				>>
*		<< add Stack 1 and Stack 2		>>
*		<< multiply Stack 1 and Stack 2,	>>
*		<< sum multivalued Stack 1,		>>
*		<< push (duplicate) Stack 1 value,	>>
*		<< exchange Stack 1 and Stack 2,	>>
*		<< pop Stack 1 value off stack,		>>
*		<< greater than or equal to operator,	>>
*		<< less than or equal to operator,	>>
*		<< equality operator,			>>
*		<< inequality operator,			>>
*		<< push (duplicate) Stack 1 value,	>>
*		<< logical AND operator,		>>
*		<< logical OR operator,			>>
*		<< all are OK to add to our F code.	>>
*
		ucode := char1
		psource = psource[ 2, len( psource )]
*
            case 1
* 
*		<< Should be impossible to get here with a valid F-correl. >>
*
		call @DC.MESSAGE( "Invalid F " : word : ".", "" )
		ucode = ""
		result = false
		return
*
         end case
      repeat
      return
*
end