263 lines
7.6 KiB
Fortran
Executable File
263 lines
7.6 KiB
Fortran
Executable File
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
|