1111 lines
29 KiB
Plaintext
Executable File
1111 lines
29 KiB
Plaintext
Executable File
subroutine DC.CORR.CONV( home.amc, pkey, psource, ucode, result )
|
|
*******************************************************************************
|
|
*
|
|
* Convert dictionary item(s) from Pick to Uni*Verse format:
|
|
* convert all correlatives to I descriptors,
|
|
* parse all conversions 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.
|
|
*
|
|
*******************************************************************************
|
|
*
|
|
*
|
|
* Arguments:
|
|
*
|
|
* home.amc - The AMC of the item being converted
|
|
*
|
|
* pkey - The data on which the conversion is to be performed
|
|
*
|
|
* psource - The Pick V/CORR or V/CONV code. It will be modified.
|
|
*
|
|
* ucode - The resulting Uni*Verse I-descriptor/conversion code.
|
|
*
|
|
* result - Boolean: returned "true" if process succeeds, "false"
|
|
* otherwise
|
|
*
|
|
************************************************************************
|
|
$options DEFAULT
|
|
$include UNIVERSE.INCLUDE DC.COMM.DECL
|
|
*
|
|
equ true to 1, false to 0
|
|
err.msg = ""
|
|
*
|
|
key = pkey ;* << We don't want to modify pkey >>
|
|
save.psource = psource
|
|
open.parens = 0
|
|
ucode = ""
|
|
if PARSE.ONLY then
|
|
word = "conversion"
|
|
end else
|
|
word = "correlative"
|
|
end
|
|
*
|
|
*
|
|
result = true
|
|
first.iteration = true
|
|
loop
|
|
real.code = false
|
|
loop
|
|
until real.code do
|
|
*
|
|
begin case
|
|
case psource[ 1, 1 ] = " "
|
|
psource = psource[ 2, len( psource )]
|
|
case psource[ 1, 1 ] = @VM or psource[ 1, 1 ] = "}" or psource[ 1, 1 ] = "]"
|
|
if PARSE.ONLY then
|
|
ucode := @VM ;* was " := ';'"
|
|
end
|
|
psource = psource[ 2, len( psource ) ]
|
|
if psource = "" and not( first.iteration ) then
|
|
call @DC.MESSAGE( "Multivalued " : word : " contains null value.", "" )
|
|
end
|
|
case psource[ 1, 1 ] = "("
|
|
open.parens += 1
|
|
if PARSE.ONLY then
|
|
ucode := "("
|
|
end
|
|
psource = psource[ 2, len( psource ) ]
|
|
case psource[ 1, 1 ] = ")"
|
|
open.parens -= 1
|
|
if PARSE.ONLY then
|
|
ucode := ")"
|
|
end
|
|
psource = psource[ 2, len( psource ) ]
|
|
case 1
|
|
real.code = true
|
|
end case
|
|
repeat
|
|
if not( result ) then return
|
|
*
|
|
while len( psource ) do
|
|
*
|
|
* << Strip leading blanks. Get the first letter, and dispatch off it. >>
|
|
*
|
|
*
|
|
first.iteration = false
|
|
|
|
first.letter = psource[ 1, 1 ]
|
|
index.type = index( "ACDFGLMPRSTU", first.letter, 1 )
|
|
corr.source = ""
|
|
conv.source = ""
|
|
if index.type < 1 then
|
|
call @DC.MESSAGE( "Unrecognizable " : word : " code: ", psource )
|
|
result = false
|
|
return
|
|
end
|
|
pos = 2
|
|
on index.type gosub 1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000, 9000, 10000, 11000, 12000
|
|
*
|
|
*
|
|
* << Since "key" is taken as the data to be converted, it is here >>
|
|
* << assigned the results of the previous conversion. In this way >>
|
|
* << multiple correlatives get nested. >>
|
|
*
|
|
if PARSE.ONLY then
|
|
ucode := conv.source
|
|
end else
|
|
if corr.source then
|
|
key = corr.source
|
|
end
|
|
end
|
|
*
|
|
repeat
|
|
|
|
if open.parens > 0 then
|
|
call @DC.MESSAGE( "Missing closing parenthesis: ", psource )
|
|
result = false
|
|
return
|
|
end
|
|
if open.parens < 0 then
|
|
call @DC.MESSAGE( "Extraneous closing parenthesis: ", psource )
|
|
result = false
|
|
return
|
|
end
|
|
if not( PARSE.ONLY ) then
|
|
ucode = key
|
|
end
|
|
return
|
|
*
|
|
*
|
|
*
|
|
************************
|
|
*
|
|
*
|
|
*************
|
|
1000
|
|
* We have an "A" correlative.
|
|
*
|
|
*************
|
|
*
|
|
call @DC.A( psource, conv.source, result )
|
|
if not( PARSE.ONLY ) then
|
|
corr.source = "OCONV( " : key : ", \" : conv.source : "\ )"
|
|
end
|
|
return
|
|
*
|
|
*
|
|
*
|
|
*************
|
|
2000
|
|
* We have a "C". Must be the concatenation correlative.
|
|
*
|
|
*************
|
|
* Form is:
|
|
* C*n
|
|
* Where
|
|
* * is the character to insert between concatenated attributes or
|
|
* literals. A ";" is reserved to mean no separation character
|
|
* n is any AMC; or any literal string enclosed in single quotation
|
|
* marks ('), double quotation marks ("), or backslashes (\); or any
|
|
* named attribute (e.g., "N(name)" ); or an asterisk.
|
|
*************
|
|
*
|
|
* << Skip the "C", and get the separator. >>
|
|
*
|
|
sep = psource[ 2, 1 ]
|
|
if sep matches "1N" or sep = '"' or sep = "'" then
|
|
sep = ""
|
|
pos = 2
|
|
end else
|
|
pos = 3
|
|
end
|
|
*
|
|
gosub 19000; * << Strip any leading blank. >>
|
|
*
|
|
*
|
|
* << Now see what we are to concatenate. >>
|
|
*
|
|
corr.source = "C" : sep
|
|
arg.count = 0
|
|
char1 = psource[ pos, 1 ]
|
|
loop
|
|
while pos <= len( psource ) and result and char1 <> "}" and char1 <> "]" and char1 <> @VM do
|
|
quote = ""
|
|
amc = ""
|
|
string = ""
|
|
temp = psource[ pos, 1 ]
|
|
begin case
|
|
case temp matches "1N"
|
|
*
|
|
* << It's an AMC. Get all the digits. >>
|
|
*
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp matches "1N" and pos <= len( psource) do
|
|
amc := temp
|
|
pos += 1
|
|
repeat
|
|
corr.source := amc
|
|
arg.count += 1
|
|
*
|
|
case temp = '"' or temp = "'" or temp = "\"
|
|
*
|
|
* << It's a quoted string. >>
|
|
*
|
|
quote = temp
|
|
loop
|
|
pos += 1
|
|
temp = psource[ pos, 1 ]
|
|
until temp = quote do
|
|
string := temp
|
|
if pos > len( psource ) then
|
|
call @DC.MESSAGE( "Quoted string missing closing quotation mark: ", psource )
|
|
result = false
|
|
corr.source = ""
|
|
return
|
|
end
|
|
repeat
|
|
corr.source := quote : string : quote
|
|
pos += 1
|
|
arg.count += 1
|
|
*
|
|
case psource[ pos, 2 ] = "N("
|
|
*
|
|
* << Attribute name: N(name) >>
|
|
*
|
|
name = ""
|
|
pos += 1
|
|
loop
|
|
pos += 1
|
|
temp = psource[ pos, 1 ]
|
|
until temp = "" or temp = ")" do
|
|
name := temp
|
|
repeat
|
|
if temp <> ")" then
|
|
call @DC.MESSAGE( '"N( name )" function missing right parenthesis:', psource )
|
|
result = false
|
|
return
|
|
end
|
|
pos += 1; * get past ")"
|
|
corr.source := "N(" : name : ")"
|
|
arg.count += 1
|
|
*
|
|
case psource[ pos, 1 ] = ";"
|
|
pos += 1;
|
|
corr.source := ";"
|
|
*
|
|
case 1
|
|
corr.source := temp
|
|
arg.count += 1
|
|
pos += 1
|
|
end case
|
|
repeat
|
|
*
|
|
if arg.count < 1 or not( result ) then
|
|
call @DC.MESSAGE( "Invalid concatenation code: ", psource )
|
|
corr.source = ""
|
|
result = false
|
|
return
|
|
end
|
|
*
|
|
* << Recode. >>
|
|
*
|
|
corr.source = "OCONVS( " : key : ', \' : corr.source : '\ )'
|
|
conv.source = psource[ 1, pos - 1 ]
|
|
*
|
|
* << Zap the psource. >>
|
|
*
|
|
psource = psource[ pos, len( psource )]
|
|
return
|
|
*
|
|
*
|
|
*
|
|
*************
|
|
3000
|
|
* We got a "D". Since D1/D2 associations have already been removed in
|
|
* DC, this must be Date specifier.
|
|
*
|
|
*************
|
|
* Forms:
|
|
* D [ n ][ dm ][ s ]
|
|
*
|
|
* Where n is the single-digit number of digits of the year to print,
|
|
* d is any nonnumeric, non-system delimiter field delimiter,
|
|
* m is the single-digit number of fields to skip
|
|
* s is any non-numeric, non-system delimiter character used
|
|
* to separate the month, day, and year fields on output, or
|
|
* a special one- or two-character format subcode (D, I, J, M, MA, Q,
|
|
* W, WA, or Y).
|
|
*
|
|
************
|
|
*
|
|
*
|
|
* Date conversions can't contain value marks, so let's extract
|
|
* the code we want to play with.
|
|
*
|
|
date.code = psource
|
|
N = ""; D = ""; M = ""; S = ""
|
|
pos = 2
|
|
loop
|
|
temp = date.code[ pos, 1 ]
|
|
while ( pos <= len( date.code )) and ( temp <> ")" ) and temp <> "}" and temp <> @VM and temp <> "]" do
|
|
begin case
|
|
case num( temp ) and N = ""
|
|
N = temp
|
|
pos += 1
|
|
case num( temp ) and N <> "" and D <> "" and M = ""
|
|
M = temp
|
|
pos += 1
|
|
case num( temp )
|
|
call @DC.MESSAGE( "Invalid date conversion:", date.code )
|
|
corr.source = ""
|
|
result = false
|
|
return
|
|
case index( "DMAQWAY", date.code[ pos, 1 ], 1 )
|
|
loop
|
|
while index( "DMAQWAY", date.code[ pos, 1 ], 1 ) and pos <= len( date.code ) do
|
|
S := date.code[ pos, 1 ]
|
|
pos += 1
|
|
repeat
|
|
case not( D )
|
|
D = temp
|
|
pos += 1
|
|
case N <> "" and D <> "" and M <> "" and S = ""
|
|
S = temp
|
|
pos += 1
|
|
case 1
|
|
call @DC.MESSAGE( "Invalid date conversion:", date.code )
|
|
corr.source = ""
|
|
result = false
|
|
return
|
|
end case
|
|
repeat
|
|
|
|
*
|
|
* Code it.
|
|
*
|
|
corr.source = "OCONVS( " : key : ', \D' : N : D : M : S : '\ )'
|
|
conv.source = psource[ 1, pos - 1 ]
|
|
result = true
|
|
*
|
|
psource = psource[ pos, len( psource )]
|
|
return
|
|
*
|
|
*
|
|
*
|
|
**************
|
|
4000
|
|
* We got an "F". Go parse the function correlative.
|
|
*
|
|
**************
|
|
call @DC.F( psource, corr.source, result )
|
|
if result and not( PARSE.ONLY ) then
|
|
corr.source = "OCONV( " : key : ", \" : corr.source : "\ )"
|
|
end else
|
|
conv.source = corr.source
|
|
end
|
|
return
|
|
*
|
|
*
|
|
*
|
|
**************
|
|
5000
|
|
* We got a "G". That means a group extraction.
|
|
*
|
|
**************
|
|
* Form is:
|
|
* Gmcn
|
|
* Gcn
|
|
* Where m is the number of segments to skip,
|
|
* c is the segment delimiter, and
|
|
* n is the number of segments to take.
|
|
*
|
|
*************
|
|
*
|
|
* << First find the m. >>
|
|
*
|
|
M = ""
|
|
N = ""
|
|
C = ""
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp matches "1N" and pos <= len( psource ) do
|
|
M := temp
|
|
pos += 1
|
|
repeat
|
|
*
|
|
* << Now get the delimiter character. >>
|
|
*
|
|
C = temp
|
|
pos += 1
|
|
*
|
|
* << Now get the n. >>
|
|
*
|
|
N = ""
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp matches "1N" and pos <= len( psource ) do
|
|
N := temp
|
|
pos += 1
|
|
repeat
|
|
*
|
|
if N = "" and M <> "" then
|
|
N = M
|
|
M = ""
|
|
end
|
|
|
|
if N < 1 then; * << n must be positive. >>
|
|
call @DC.MESSAGE( "Negative group extraction code:", psource )
|
|
corr.source = ""
|
|
result = false
|
|
return
|
|
end
|
|
*
|
|
* << Recode. >>
|
|
*
|
|
corr.source = "OCONVS( " : key : ', \' : "G" : M : C : N : '\ )'
|
|
conv.source = psource[ 1, pos - 1 ]
|
|
result = true
|
|
*
|
|
* << Zap the psource. >>
|
|
*
|
|
psource = psource[ pos, len( psource ) ]
|
|
return
|
|
*
|
|
*
|
|
*
|
|
**************
|
|
6000
|
|
* We got an "L" or length specification.
|
|
*
|
|
**************
|
|
* Forms:
|
|
* Lm
|
|
* Lm,n
|
|
* Where m is the maximum number of characters acceptable, and
|
|
* n is the minimum number of characters acceptable.
|
|
**************
|
|
*
|
|
* << First find the max. >>
|
|
*
|
|
m = ""
|
|
comma = ""
|
|
n = ""
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp matches "1N" do
|
|
m := temp
|
|
pos += 1
|
|
repeat
|
|
*
|
|
if m = "" then
|
|
call @DC.MESSAGE( "Invalid length " : word, psource )
|
|
corr.source = ""
|
|
result = false
|
|
return
|
|
end
|
|
*
|
|
if pos < len( psource ) then
|
|
*
|
|
gosub 19000; * << Strip any spaces. >>
|
|
*
|
|
* << Now see if there's a comma. >>
|
|
*
|
|
if temp = "," or temp = "-" then
|
|
comma = ","
|
|
pos += 1
|
|
*
|
|
* << Now get the n. >>
|
|
*
|
|
n = ""
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp matches "1N" do
|
|
n := temp
|
|
pos += 1
|
|
repeat
|
|
end
|
|
end
|
|
*
|
|
* << Fix the source, and code up the conversion. >>
|
|
*
|
|
corr.source = "OCONVS( ": key : ', \L' : m : comma : n : '\ )'
|
|
conv.source = psource[ 1, pos - 1 ]
|
|
psource = psource[ pos, len( psource )]
|
|
return
|
|
*
|
|
*
|
|
*
|
|
**************
|
|
7000
|
|
* We got an "M". Could be MD (mask decimal),
|
|
* ML (mask left),
|
|
* MR (mask right),
|
|
* MF (mask field -- UV does not handle this ),
|
|
* MP (packed decimal)
|
|
* MT (time),
|
|
* MCA (mask alphabetic),
|
|
* MCL (mask lower-case),
|
|
* MCN (mask numerics),
|
|
* MCP (make printable),
|
|
* MCT (capitalize all words),
|
|
* MCU (mask upper-case),
|
|
* MC/A (mask nonalphabetic),
|
|
* MC/N (mask nonnumerics),
|
|
* MX (hexadecimal/decimal),
|
|
* MCDX (decimal/hexadecimal),
|
|
* MCXD (hexadecimal/decimal),
|
|
* MX0C (hexadecimal/ASCII),
|
|
* MB (binary/decimal),
|
|
* MB0C (binary/ASCII),
|
|
* MO (octal/decimal),
|
|
* MO0C (octal/ASCII)
|
|
*
|
|
**************
|
|
*
|
|
temp2 = psource[ 1, 2 ]
|
|
temp3 = psource[ 1, 3 ]
|
|
temp4 = psource[ 1, 4 ]
|
|
begin case
|
|
case temp4 = "MTHS" or temp4 = "MTSH" or temp4 = "MO0C" or temp4 = "MB0C" or temp4 = "MX0C" or temp4 = "MCDX" or temp4 = "MCXD" or temp4 = "MC/N" or temp4 = "MC/A"
|
|
corr.source = "OCONVS( " : key : ', \' : temp4 : '\ )'
|
|
conv.source = psource[ 1, 4 ]
|
|
psource = psource[ 5, len( psource )]
|
|
result = true
|
|
|
|
case temp3 = "MTS" or temp3 = "MTH" or temp3 = "MCA" or temp3 = "MCL" or temp3 = "MCN" or temp3 = "MCP" or temp3 = "MCT" or temp3 = "MCU"
|
|
corr.source = "OCONVS( " : key : ', \' : temp3 : '\ )'
|
|
conv.source = psource[ 1, 3 ]
|
|
psource = psource[ 4, len( psource )]
|
|
result = true
|
|
|
|
case temp2 = "MD" or temp2 = "ML" or temp2 = "MR"
|
|
gosub 15000
|
|
|
|
case temp2 = "MF"
|
|
call @DC.MESSAGE( 'Incompatibility. Uni*Verse has no "MF" coversion', psource )
|
|
corr.source = ""
|
|
conv.source = ""
|
|
result = false
|
|
|
|
case temp2 = "MP" or temp2 = "MB" or temp2 = "MO" or temp2 = "MT"
|
|
corr.source = "OCONVS( " : key : ', \' : temp2 : '\ )'
|
|
conv.source = psource[ 1, 2 ]
|
|
psource = psource[ 3, len( psource )]
|
|
result = true
|
|
|
|
case temp2 = "MX"
|
|
call @DC.MESSAGE( '"MX" converted to "MCDX".', "" )
|
|
corr.source = "OCONVS( " : key : ", \MDCX\ )"
|
|
conv.source = "MCDX"
|
|
psource = psource[ 3, len( psource )]
|
|
result = true
|
|
|
|
case 1 ;* << It's bad. >>
|
|
call @DC.MESSAGE( '"Masked" ' : word : ' expected:', psource )
|
|
corr.source = ""
|
|
result = false
|
|
*
|
|
end case
|
|
return
|
|
*
|
|
*
|
|
*
|
|
**************
|
|
8000
|
|
* It's a pattern-match conversion.
|
|
*
|
|
**************
|
|
* Form:
|
|
* P (pattern)
|
|
* Where the pattern can contain one or more of the following codes:
|
|
* nN tests for n numeric characters
|
|
* nA tests for n alphabetic characters
|
|
* nX tests for n alphanumeric characters
|
|
* xxx tests for a literal string
|
|
*
|
|
* E.g., P(3N-2N-4N) returns a valid Social Security Number (stored with
|
|
* hyphens), or null.
|
|
*
|
|
**************
|
|
*
|
|
* Get the string up to a terminator:
|
|
* NULL
|
|
* @VM
|
|
* )
|
|
***************
|
|
pos = 3
|
|
mask = ""
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp <> "" and temp <> @VM and temp <> ")" do
|
|
mask := temp
|
|
pos += 1
|
|
repeat
|
|
*
|
|
* Now code it.
|
|
*
|
|
corr.source = 'OCONVS( ' : key : ', \P(' : mask : ')\ )'
|
|
conv.source = psource[ 1, pos - 1 ]
|
|
result = true
|
|
*
|
|
* Fix psource.
|
|
*
|
|
psource = psource[ pos + 1, len( psource )]
|
|
return
|
|
*
|
|
*
|
|
*
|
|
*
|
|
**************
|
|
9000
|
|
* We got an "R" or range specification.
|
|
*
|
|
**************
|
|
* Forms:
|
|
* Rn,m[;n,m;...]
|
|
* Where n is the minimum data value acceptable,
|
|
* m is the maximum data value acceptable.
|
|
*
|
|
**************
|
|
*
|
|
*
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
if temp = "-" then temp = ","
|
|
while pos <= len( psource ) do
|
|
if temp matches "1N" or temp = "," or temp = ";" or temp = " " then
|
|
corr.source := temp
|
|
end else
|
|
call @DC.MESSAGE( "Invalid range " : word, psource )
|
|
corr.source = ""
|
|
result = false
|
|
return
|
|
end
|
|
pos += 1
|
|
repeat
|
|
*
|
|
* << Fix the source, and code up the conversion. >>
|
|
*
|
|
corr.source = "OCONVS( ": key : ', \R' : trim( corr.source ) : '\ )'
|
|
conv.source = psource[ 1, pos - 1 ]
|
|
psource = psource[ pos, len( psource )]
|
|
return
|
|
*
|
|
*
|
|
*
|
|
**************
|
|
10000
|
|
* We got an "S" or substitution conversion.
|
|
*
|
|
**************
|
|
* Forms:
|
|
* S;amc1;'string'
|
|
* S;amc1;amc2
|
|
* S;amc1;*
|
|
* Where amc1 is the number of the field to test,
|
|
* 'string' is the replacement value in the event amc1 is null or zero,
|
|
* amc2 is the number of the attribute whose value is to be
|
|
* substituted in the event amc1 is null or zero
|
|
* * means to substitute the current value
|
|
* Actually, the S conversion processor will take damned near any syntax, so
|
|
* we can't afford to check too closely.
|
|
**************
|
|
*
|
|
*
|
|
conv.source = "S"
|
|
loop
|
|
char1 = psource[ pos, 1 ]
|
|
while char1 <> @VM and char1 <> "}" and char1 <> "]" and pos <= len( psource ) and not( char1 = ")" and pos = len( psource )) do
|
|
conv.source = conv.source : char1
|
|
pos += 1
|
|
repeat
|
|
*
|
|
*
|
|
* << Fix the source, and code up the conversion. >>
|
|
*
|
|
psource = psource[ pos, len( psource )]
|
|
corr.source = "OCONVS( " : key : ', \' : conv.source : '\)'
|
|
return
|
|
*
|
|
*
|
|
*
|
|
**************
|
|
11000
|
|
* We got a "T". Could be text or translate.
|
|
*
|
|
**************
|
|
*
|
|
punct = ""
|
|
tpos = 2
|
|
loop
|
|
while tpos <= len( psource ) and punct = "" do
|
|
tchar = psource[ tpos, 1 ]
|
|
begin case
|
|
case tchar = ";"
|
|
punct = ";"
|
|
case tchar = @VM or tchar = "]" or tchar = "}" or tchar = ","
|
|
punct = "*" ;* << or whatever >>
|
|
case 1
|
|
null
|
|
end case
|
|
tpos += 1
|
|
repeat
|
|
if punct = ";" then
|
|
gosub 17000 ;* << It's a Tfile >>
|
|
end else
|
|
gosub 16000 ;* << It's text. >>
|
|
end
|
|
return
|
|
*
|
|
*
|
|
*
|
|
**************
|
|
12000
|
|
* "U" code. On Pick systems, this names a frame containing assembler.
|
|
* We have implemented most of the standard user exits. Any others
|
|
* (user-written assembler, e.g.) we'll convert and issue a warning.
|
|
*
|
|
**************
|
|
*
|
|
frame = psource[ 2, 4 ]
|
|
if NO.UCODES then
|
|
if frame <> "20E0" and frame <> "307A" and frame <> "30E0" and frame <> "407A" and frame <> "50BB" and frame <> "60BB" and frame <> "60E0" and frame <> "70E0" and frame <> "7201" and frame <> "80E0" then
|
|
call @DC.MESSAGE( "Unable to verify user exit U" : frame : ".", "Item copied." )
|
|
end
|
|
end else
|
|
junk = ""
|
|
readv junk from UCODE.FV, frame, 1 else
|
|
call @DC.MESSAGE( "Unsupported user exit: U" : frame : ".", "Item copied." )
|
|
end
|
|
end
|
|
corr.source = "OCONVS( " : key : ', \U' : frame : '\)'
|
|
conv.source = "U" : frame
|
|
psource = psource[ 6, len( psource )]
|
|
return
|
|
*
|
|
*
|
|
*
|
|
*************
|
|
15000
|
|
* It's an MD (Masked Decimal) or ML (Mask Left) or MR (Mask Right)
|
|
* specification.
|
|
*
|
|
*************
|
|
* Get the string up to a terminator:
|
|
* NULL
|
|
* @VM
|
|
* )
|
|
***************
|
|
pos = 1
|
|
mask = ""
|
|
corr.source = psource[ 1, 2 ]; * "MD", "ML", or "MR"
|
|
which.code = '"' : corr.source : '" ' : word
|
|
pos = 3
|
|
escape = false
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
begin case
|
|
case temp matches "1N"
|
|
corr.source := temp
|
|
case index( "CDEMNPTZ$,-<", temp, 1 )
|
|
precision.scaling = 0
|
|
corr.source := temp
|
|
case temp = "("
|
|
mask.open.parens = 1
|
|
mask = temp
|
|
loop
|
|
pos += 1
|
|
temp = psource[ pos, 1 ]
|
|
while pos <= len( psource ) and mask.open.parens and temp <> "]" and temp <> "}" and temp <> @VM and temp <> "" do
|
|
mask := temp
|
|
if temp = "(" then
|
|
mask.open.parens += 1
|
|
end else
|
|
if temp = ")" then
|
|
mask.open.parens -= 1
|
|
end
|
|
end
|
|
repeat
|
|
if mask.open.parens > 0 then
|
|
call @DC.MESSAGE( which.code : " missing closing parenthesis: ", psource )
|
|
result = false
|
|
end else
|
|
if mask.open.parens < 0 then
|
|
call @DC.MESSAGE( "Extraneous closing parenthesis in " : which.code : ":", psource )
|
|
result = false
|
|
end else
|
|
pos -= 1
|
|
end
|
|
end
|
|
corr.source := mask
|
|
escape = true
|
|
case temp = "#" or temp = "*" or temp = "%" or temp = " "
|
|
mask = temp
|
|
loop
|
|
pos += 1
|
|
temp = psource[ pos, 1 ]
|
|
while pos <= len( psource ) and temp <> ")" and temp <> "}" and temp <> "]" and temp <> @VM and temp <> "" do
|
|
mask := temp
|
|
repeat
|
|
corr.source := mask
|
|
if temp = ")" then pos -= 1
|
|
escape = true
|
|
case temp = ")" and open.parens
|
|
escape = true
|
|
pos -= 1
|
|
case 1
|
|
call @DC.MESSAGE( 'Invalid option "' : temp : '" in ' : which.code : ":", psource )
|
|
result = false
|
|
end case
|
|
if not( result ) then return
|
|
pos += 1
|
|
until escape or pos > len( psource ) do
|
|
repeat
|
|
*
|
|
* << Now code it. >>
|
|
*
|
|
corr.source = "OCONVS( " : key : ', \' : corr.source : '\ )'
|
|
conv.source = psource[ 1, pos - 1 ]
|
|
result = true
|
|
*
|
|
* << Fix psource. >>
|
|
*
|
|
psource = psource[ pos, len( psource )]
|
|
return
|
|
*
|
|
*
|
|
*
|
|
*************
|
|
16000
|
|
* It's a Text extraction.
|
|
*
|
|
*************
|
|
* Forms:
|
|
* Tm,n
|
|
* Tn
|
|
* N.B.: 1st form is the same as [m,n].
|
|
* 2nd form depends on the V/TYPE
|
|
* If V/TYPE is "L" then it's the same as [1,n].
|
|
* If V/TYPE is "R" then it's the same as [n].
|
|
*
|
|
*************
|
|
m = ""
|
|
n = ""
|
|
*
|
|
* Get n. m is optional and is indicated if the following is stopped
|
|
* by a comma.
|
|
*
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp matches "1N" do
|
|
n := temp
|
|
pos += 1
|
|
repeat
|
|
*
|
|
* << So was there a comma? >>
|
|
*
|
|
if temp = "," then
|
|
*
|
|
* << Form is Tm,n . >>
|
|
*
|
|
m = n
|
|
n = ""
|
|
pos += 1
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
if temp = " " then
|
|
pos += 1
|
|
temp = psource[ pos, 1 ]
|
|
end
|
|
while temp matches "1N" do
|
|
n := temp
|
|
pos += 1
|
|
repeat
|
|
if m < 1 then m = 1
|
|
if len( n ) < 1 then
|
|
call @DC.MESSAGE( "Text extraction - missing or negative length:", psource )
|
|
corr.source = ""
|
|
result = false
|
|
return
|
|
end
|
|
*
|
|
* << Code for Tm,n. >>
|
|
*
|
|
corr.source = "OCONVS( " : key : ', \T' : m : "," : n : '\ )'
|
|
end else
|
|
*
|
|
* << Form is Tn. >>
|
|
*
|
|
corr.source = "OCONVS( " : key : ', \T' : n : '\ )'
|
|
end
|
|
conv.source = psource[ 1, pos - 1 ]
|
|
*
|
|
* << Fix psource. >>
|
|
*
|
|
psource = psource[ pos, len( psource )]
|
|
result = true
|
|
return
|
|
*
|
|
*
|
|
*
|
|
**************
|
|
17000
|
|
* It's a file translation.
|
|
*
|
|
**************
|
|
* Form:
|
|
* T [ * or DICT ] file ; c[ n ] ; i ; o [ ;b ]
|
|
* Where * is the DICT indicator (optional),
|
|
* file is the file name, with no imbedded ";",
|
|
* c is the translation failure action code,
|
|
* n is the (optional) value mark count to be returned if the
|
|
* item is multivalued
|
|
* i is the input AMC, and
|
|
* o is the output AMC.
|
|
* b is the (optional) AMC to be used instead of o in BREAK-ON and
|
|
* TOTAL lines
|
|
*
|
|
**************
|
|
*
|
|
* << Check for DICT indicator. >>
|
|
*
|
|
gosub 19000; * Strip leading blanks.
|
|
if psource[ pos, 1 ] = "*" then
|
|
dict = "DICT "
|
|
pos += 1
|
|
end else
|
|
if psource[ pos, 5 ] = "DICT " then
|
|
dict = "DICT "
|
|
pos += 5
|
|
end else
|
|
dict = ""
|
|
end
|
|
end
|
|
*
|
|
* << Get the file name. >>
|
|
*
|
|
tfile = ""
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp <> ";" and len( temp ) > 0 do
|
|
tfile := temp
|
|
pos += 1
|
|
repeat
|
|
pos += 1
|
|
tfile = trim( tfile )
|
|
*
|
|
* << Got a file name? >>
|
|
*
|
|
if len( tfile ) < 1 then
|
|
call @DC.MESSAGE( "TFILE " : word : " specifies no file name:", psource )
|
|
conv.source = ""
|
|
corr.source = ""
|
|
result = false
|
|
return
|
|
end
|
|
*
|
|
* Get the translation option.
|
|
*
|
|
gosub 19000; * Strip any leading blank
|
|
C = psource[ pos, 1 ]
|
|
pos += 1
|
|
if C = '"' or C = "'" or C = "\" and psource[ pos + 1, 1 ] = C then
|
|
C = psource[ pos, 1 ]; * In case they quoted the damned thing
|
|
pos += 2
|
|
end
|
|
*
|
|
* << Ensure that the option is valid. >>
|
|
*
|
|
begin case
|
|
case C = "I"
|
|
case C = "O"
|
|
case C = "C"
|
|
case C = "V"
|
|
case C = "X"
|
|
case 1
|
|
call @DC.MESSAGE( "TFILE " : word : " has invalid translation subcode:", psource )
|
|
corr.source = ""
|
|
conv.source = ""
|
|
result = false
|
|
return
|
|
end case
|
|
*
|
|
* << Get the value mark count, if any. >>
|
|
*
|
|
N = ""
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp # ";" and len( temp ) > 0 do
|
|
N := temp
|
|
pos += 1
|
|
repeat
|
|
pos += 1
|
|
if N = " " then N = ""
|
|
if N <> "" and not( N matches "0N" ) then
|
|
call @DC.MESSAGE( "TFILE " : word : " has invalid value mark count:", psource )
|
|
corr.source = ""
|
|
conv.source = ""
|
|
result = false
|
|
return
|
|
end
|
|
*
|
|
* << Get the input AMC. >>
|
|
*
|
|
I = ""
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp <> ";" and len( temp ) > 0 do
|
|
I := temp
|
|
pos += 1
|
|
repeat
|
|
pos += 1
|
|
if I = " " then I = ""
|
|
if I <> "" and not( I matches "0N" ) then
|
|
call @DC.MESSAGE( "TFILE " : word : " has invalid input AMC:", psource )
|
|
corr.source = ""
|
|
conv.source = ""
|
|
result = false
|
|
return
|
|
end
|
|
*
|
|
* << Get the output AMC. >>
|
|
*
|
|
O = ""
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp matches "1N" do
|
|
O := temp
|
|
pos += 1
|
|
repeat
|
|
*
|
|
* << Output AMC OK? >>
|
|
*
|
|
if len( O ) < 1 then
|
|
call @DC.MESSAGE( "TFILE " : word : " has invalid output AMC:", psource )
|
|
corr.source = ""
|
|
conv.source = ""
|
|
result = false
|
|
return
|
|
end
|
|
*
|
|
* << Get the BREAK-ON AMC, if any. >>
|
|
*
|
|
B = ""
|
|
if psource[ pos, 1 ] = ";" then
|
|
pos += 1
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp matches "1N" do
|
|
B := temp
|
|
pos += 1
|
|
repeat
|
|
end
|
|
*
|
|
* << Code it. >>
|
|
*
|
|
corr.source = "OCONVS( " : key : ", "
|
|
corr.source := '\T' : dict : tfile : ";" : C : N : ";" : I : ";" : O
|
|
if B then
|
|
corr.source := ";" : B
|
|
end
|
|
corr.source := '\ )'
|
|
conv.source = psource[ 1, pos - 1 ]
|
|
result = true
|
|
*
|
|
* << Fix psource. >>
|
|
*
|
|
psource = psource[ pos, len( psource )]
|
|
return
|
|
*
|
|
*
|
|
*
|
|
***************
|
|
19000
|
|
* Strip blanks.
|
|
*
|
|
***************
|
|
loop
|
|
temp = psource[ pos, 1 ]
|
|
while temp = " " do
|
|
psource = psource[ 1, pos - 1 ] : psource[ pos + 1, len( psource )]
|
|
repeat
|
|
return
|
|
*
|
|
*
|
|
*
|
|
end
|
|
|