270 lines
8.3 KiB
Plaintext
270 lines
8.3 KiB
Plaintext
|
********************************************************************************
|
||
|
|
*
|
||
|
|
* Program to convert PI/open GCI definition file to uniVerse format
|
||
|
|
*
|
||
|
|
* 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.
|
||
|
|
* 09/06/96 19192 ALC Corrected use of OS.TYPE
|
||
|
|
* 04/03/96 18026 PGW For Windows NT, allow GCI file name on command line
|
||
|
|
* 03/25/94 12300 LA Changed to handle all PI/open variable types.
|
||
|
|
* 02/17/94 12300 LA Initial implementation.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Program Description:
|
||
|
|
*
|
||
|
|
* Called from the GCI administration menu to take a PI/open GCI
|
||
|
|
* definition file and put the subroutine definitions contained therein
|
||
|
|
* into the (or a) uniVerse GCI definition file.
|
||
|
|
*
|
||
|
|
* NOTE: The PI/open GCI definition file must have been converted to
|
||
|
|
* a uniVerse format file by the account conversion tools before
|
||
|
|
* it can be read by this program.
|
||
|
|
*
|
||
|
|
* Calling Sequence:
|
||
|
|
*
|
||
|
|
* Unix: RUN APP.PROGS GCI.CONVPI.B
|
||
|
|
*
|
||
|
|
* NT: RUN APP.PROGS GCI.CONVPI.B file.name
|
||
|
|
*
|
||
|
|
* where file.name is the name of the GCI Definition File into which
|
||
|
|
* the converted definitions will be written.
|
||
|
|
*
|
||
|
|
* The program prompts for the pathname of the PI/open GCI definition file.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
|
||
|
|
PROGRAM GCI.CONVPI.B
|
||
|
|
|
||
|
|
ID = "@(#)%M% %I%"
|
||
|
|
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
|
||
|
|
|
||
|
|
EQUATE PI.EXT TO 1
|
||
|
|
EQUATE PI.LANG TO 2
|
||
|
|
EQUATE PI.TYPE TO 4
|
||
|
|
EQUATE PI.DIRECTION TO 5
|
||
|
|
EQUATE PI.LENGTH TO 6
|
||
|
|
EQUATE PI.ROWS TO 7
|
||
|
|
EQUATE PI.COLS TO 8
|
||
|
|
EQUATE PI.ARG.DESC TO 9
|
||
|
|
EQUATE PI.SUB.DESC TO 10
|
||
|
|
EQUATE PI.RET.VAL TO 12
|
||
|
|
|
||
|
|
EQUATE UV.LANG TO 1
|
||
|
|
EQUATE UV.EXT TO 2
|
||
|
|
EQUATE UV.RET.VAL TO 3
|
||
|
|
EQUATE UV.NO.ARGS TO 4
|
||
|
|
EQUATE UV.TYPE TO 5
|
||
|
|
EQUATE UV.DIRECTION TO 6
|
||
|
|
EQUATE UV.MODULE TO 7
|
||
|
|
EQUATE UV.SUB.DESC TO 8
|
||
|
|
EQUATE UV.LENGTH TO 9
|
||
|
|
EQUATE UV.ROWS TO 10
|
||
|
|
EQUATE UV.COLS TO 11
|
||
|
|
EQUATE UV.ARG.DESC TO 12
|
||
|
|
|
||
|
|
pi.fvar = '' ;* File variable for PI/open GCI defn. file
|
||
|
|
voc.fvar = ''
|
||
|
|
gci.fvar = ''
|
||
|
|
eof = 0
|
||
|
|
vocrec.id = 'PIOPEN.GCI'
|
||
|
|
pi.mark.chars = char(26):char(28):char(29):char(30):char(31)
|
||
|
|
verify.mark = char(26)
|
||
|
|
verify.chars = str(verify.mark, len(pi.mark.chars))
|
||
|
|
|
||
|
|
* Open GCI file
|
||
|
|
if OS.TYPE = "UNIX" then
|
||
|
|
def.file.name = 'GCI'
|
||
|
|
end else
|
||
|
|
* Windows NT:
|
||
|
|
* You can specify the definition file by putting its name on the
|
||
|
|
* command line, otherwise it defaults to 'GCI'
|
||
|
|
cmd = convert(" ", @fm, trim(@sentence))
|
||
|
|
def.file.name = cmd<4>
|
||
|
|
if def.file.name = "" then def.file.name = 'GCI'
|
||
|
|
end
|
||
|
|
|
||
|
|
open def.file.name TO gci.fvar else
|
||
|
|
print 'Failed to open uniVerse file "':def.file.name:'"'
|
||
|
|
stop
|
||
|
|
end
|
||
|
|
|
||
|
|
prompt ""
|
||
|
|
print "Enter pathname of PI/open definition file: ":
|
||
|
|
input pathname
|
||
|
|
|
||
|
|
* Create a VOC entry for the PI/open file so that we can access it
|
||
|
|
|
||
|
|
open "VOC" to voc.fvar
|
||
|
|
else stop "Cannot open voc"
|
||
|
|
vocrec = 'F':@FM:pathname
|
||
|
|
|
||
|
|
write vocrec to voc.fvar, vocrec.id
|
||
|
|
else stop "Cannot write record to VOC"
|
||
|
|
|
||
|
|
* Now open the file and do a select on it so we have a list of the record
|
||
|
|
* id's to access
|
||
|
|
|
||
|
|
open vocrec.id to pi.fvar
|
||
|
|
else stop "Cannot open PI/open definition file"
|
||
|
|
ftype = status()
|
||
|
|
|
||
|
|
select pi.fvar
|
||
|
|
loop
|
||
|
|
readnext recid
|
||
|
|
then
|
||
|
|
|
||
|
|
* Check subroutine with same name doesn't already exist
|
||
|
|
|
||
|
|
read tmp from gci.fvar, recid
|
||
|
|
then
|
||
|
|
print "Subroutine '":recid:"' already exists."
|
||
|
|
continue
|
||
|
|
end
|
||
|
|
|
||
|
|
read pi.defn from pi.fvar, recid
|
||
|
|
then
|
||
|
|
print "Processing subroutine '":recid:"'"
|
||
|
|
|
||
|
|
* Check for PI/open mark characters if this is a type 1/19 file
|
||
|
|
|
||
|
|
if ftype = 1 or ftype = 19 then
|
||
|
|
mark.found = 0
|
||
|
|
tmp.rec = pi.defn
|
||
|
|
convert pi.mark.chars to verify.chars in tmp.rec
|
||
|
|
mark.found = index(tmp.rec, verify.mark, 1)
|
||
|
|
if mark.found then
|
||
|
|
no.fields = dcount(pi.defn, @FM)
|
||
|
|
tmp.rec = ''
|
||
|
|
for i = 1 to no.fields
|
||
|
|
tmp.rec<i> = iconv(pi.defn<i>, 'ECS')
|
||
|
|
next i
|
||
|
|
pi.defn = tmp.rec
|
||
|
|
end
|
||
|
|
end
|
||
|
|
|
||
|
|
uv.defn = ""
|
||
|
|
begin case
|
||
|
|
case pi.defn<PI.LANG>[1,1] = "C"
|
||
|
|
uv.defn<UV.LANG> = "c"
|
||
|
|
case pi.defn<PI.LANG> = "F77"
|
||
|
|
uv.defn<UV.LANG> = "f77"
|
||
|
|
case 1
|
||
|
|
print "Unsupported language: ":pi.defn<PI.LANG>
|
||
|
|
stop
|
||
|
|
end case
|
||
|
|
uv.defn<UV.EXT> = pi.defn<PI.EXT>
|
||
|
|
uv.defn<UV.RET.VAL> = downcase(pi.defn<PI.RET.VAL>)
|
||
|
|
if uv.defn<UV.RET.VAL> = "" then
|
||
|
|
uv.defn<UV.RET.VAL> = "void"
|
||
|
|
end
|
||
|
|
|
||
|
|
* Map PI/open definition data to its corresponding uniVerse values.
|
||
|
|
|
||
|
|
uv.defn<UV.DIRECTION> = pi.defn<PI.DIRECTION>
|
||
|
|
uv.defn<UV.NO.ARGS> = dcount(pi.defn<PI.TYPE>, @VM)
|
||
|
|
for i = 1 to uv.defn<UV.NO.ARGS>
|
||
|
|
dir = uv.defn<UV.DIRECTION, i>
|
||
|
|
|
||
|
|
* Map "IO" to "B" for direction
|
||
|
|
|
||
|
|
if dir = "IO" then
|
||
|
|
dir = "B"
|
||
|
|
end
|
||
|
|
type = pi.defn<PI.TYPE, i>
|
||
|
|
|
||
|
|
* Now convert data types by language
|
||
|
|
|
||
|
|
begin case
|
||
|
|
case uv.defn<UV.LANG> = "f77"
|
||
|
|
begin case
|
||
|
|
case type = "INTEGER*2"
|
||
|
|
type = "integer2"
|
||
|
|
case type = "INTEGER*4"
|
||
|
|
type = "integer4"
|
||
|
|
case type = "REAL*4"
|
||
|
|
type = "real4"
|
||
|
|
case type = "REAL*8"
|
||
|
|
type = "real8"
|
||
|
|
case type = "LOGICAL"
|
||
|
|
type = "logical"
|
||
|
|
case type = "CHARACTER"
|
||
|
|
type = "character"
|
||
|
|
case 1
|
||
|
|
print "Invalid data type found: ":type
|
||
|
|
end case
|
||
|
|
case uv.defn<UV.LANG> = "c"
|
||
|
|
begin case
|
||
|
|
case type = "CHAR[N]"
|
||
|
|
if dir = "I" then type = "char*"
|
||
|
|
else type = "lchar*"
|
||
|
|
case type = "CHAR*"
|
||
|
|
if dir ne "I" then type = "lchar*" else type = "char*"
|
||
|
|
case type = "CHAR-VAR*"
|
||
|
|
type = "charvar*"
|
||
|
|
case type[1,3] = "INT"
|
||
|
|
pos = index(type, "*", 1) ;* check for input pointer
|
||
|
|
if pos and dir = "I" then dir = "B"
|
||
|
|
type = "int"
|
||
|
|
case type[1,9] = "SHORT-INT"
|
||
|
|
pos = index(type, "*", 1) ;* check for input pointer
|
||
|
|
if pos and dir = "I" then dir = "B"
|
||
|
|
type = "short"
|
||
|
|
case type[1,8] = "LONG-INT"
|
||
|
|
pos = index(type, "*", 1) ;* check for input pointer
|
||
|
|
if pos and dir = "I" then dir = "B"
|
||
|
|
type = "long"
|
||
|
|
case type[1,5] = "FLOAT"
|
||
|
|
pos = index(type, "*", 1) ;* check for input pointer
|
||
|
|
if pos and dir = "I" then dir = "B"
|
||
|
|
type = "float"
|
||
|
|
case type[1,6] = "DOUBLE"
|
||
|
|
pos = index(type, "*", 1) ;* check for input pointer
|
||
|
|
if pos and dir = "I" then dir = "B"
|
||
|
|
type = "double"
|
||
|
|
case 1
|
||
|
|
print "Invalid data type found: "type
|
||
|
|
end case
|
||
|
|
end case
|
||
|
|
|
||
|
|
uv.defn<UV.TYPE, i> = type
|
||
|
|
uv.defn<UV.DIRECTION, i> = dir
|
||
|
|
next i
|
||
|
|
|
||
|
|
uv.defn<UV.SUB.DESC> = pi.defn<PI.SUB.DESC>
|
||
|
|
uv.defn<UV.LENGTH> = pi.defn<PI.LENGTH>
|
||
|
|
uv.defn<UV.ROWS> = pi.defn<PI.ROWS>
|
||
|
|
uv.defn<UV.COLS> = pi.defn<PI.COLS>
|
||
|
|
uv.defn<UV.ARG.DESC> = pi.defn<PI.ARG.DESC>
|
||
|
|
uv.defn<UV.MODULE> = pi.defn<PI.EXT>
|
||
|
|
|
||
|
|
uv.recid = "$":recid
|
||
|
|
|
||
|
|
write uv.defn to gci.fvar, uv.recid
|
||
|
|
else print "Failed to write '":uv.recid:"' to GCI file"
|
||
|
|
|
||
|
|
end else
|
||
|
|
print "Failed to read record: ":recid
|
||
|
|
end
|
||
|
|
end else eof = 1
|
||
|
|
until eof
|
||
|
|
|
||
|
|
repeat
|
||
|
|
|
||
|
|
close pi.fvar
|
||
|
|
delete voc.fvar, vocrec.id
|
||
|
|
|
||
|
|
END
|