tldm-universe/Ardent/UV/APP.PROGS/CATLG.GCI
2024-09-09 17:51:08 -04:00

99 lines
3.3 KiB
Plaintext
Executable File

*****************************************************************************
*
* Catalog GCI subroutines
*
* 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.
* 04/03/96 18026 PGW Added file name on cmd line, & setting @SYSTEM.SET
* 02/22/94 12300 LA Changed to scan GCI file and catalog any routines
* which contain a catalog prefix ("$", "!", "-" or "*")
* 10/27/89 5273 DSC Exit when given XX et al (formerly restarted)
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
*
*******************************************************************************
PROGRAM CATLG.GCI
ID = "@(#)%M% %I%"
$INCLUDE UNIVERSE.INCLUDE FILENAMES.H
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
*
prompt ""
cl = @(-4)
cl.err = @(0,23):cl
EQU bell TO CHAR(7)
err = cl.err:bell
msg10=err:PROD.NAMEU:' General Calling Interface is not installed.'
IF OS.TYPE = "UNIX" THEN
* Unix: this program can only be run in uvhome
OPEN '','DATA.TYPES' TO fvdata.types ELSE
PRINT msg10:
INPUT q: ; PRINT cl.err:
@SYSTEM.SET = -1
STOP
END
def.file.name = 'GCI'
END ELSE
* Windows NT: this program can be run in any account
OPENPATH UV.ROOT:'\DATA.TYPES' TO fvdata.types ELSE
PRINT msg10:
INPUT q: ; PRINT cl.err:
@SYSTEM.SET = -1
STOP
END
* 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
PRINT @( -1 )
PRINT @( 0, 0 ):"General Calling Interface Administration" : @( 69, 0 ) : "CATLG.GCI":
IF OS.TYPE = "UNIX" THEN
PRINT @( 23, 1): "Catalog GCI subroutines":
END ELSE
PRINT @( 23, 1): "Catalog GCI subroutines from GCI Definition File ":def.file.name:
END
PRINT @( 0, 2 ): STR( "-", 79 ):
PRINT @( 0, 4 ):
gci.fvar = ''
OPEN '', def.file.name TO gci.fvar ELSE
PRINT "Cannot open file ":def.file.name:".":
PRINT " Subroutines will not be cataloged."
@SYSTEM.SET = -1
GOTO exit.catlg.gci
END
SELECT gci.fvar
eof = 0
id.count = 0
LOOP
READNEXT id ELSE eof = 1
UNTIL eof
prefix = id[1,1]
IF prefix = "$" OR prefix = "!" OR prefix = "*" OR prefix = "-" THEN
PERFORM "CATALOG.GCI ":id
id.count += 1
END
REPEAT
CLOSE gci.fvar
@SYSTEM.SET = id.count
exit.catlg.gci:
END