home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
c2pli.zip
/
C2PLI.CMD
next >
Wrap
OS/2 REXX Batch file
|
1998-04-20
|
363KB
|
11,573 lines
/****************************** Module Header *******************/
/* */
/* Module Name: C2PLI.CMD */
/* C to PL/I Conversion Aid */
/* */
/* Copyright (c) International Business Machines Corporation 1994 */
/* */
/* ===========================================================*/
/* REXX PROGRAM */
signal on syntax
signal on notready
call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs
options exmode
/*************************************************************************
* Utility to convert C header files to PL/I include files *
* This utility is called C2pli and takes the c header file name as *
* argument. This utility is only an aid to conversion. The user needs *
* to manually complete the conversion. Undetected unsupported *
* features may be mapped incorrectly. This utility is not a parser. *
* *
**************************************************************************/
parse source how why inputfile
say how
say why
say inputfile
parse arg allargs
/************
Set Options
************/
P_opt = OFF
T_opt = OFF
graphicOpt = OFF
left_margin = 2
right_margin = 72
arglist = ''
do until words(allargs) == 0
arg1 = translate(strip(word(allargs, 1),'both'))
if arg1 == '-P' then
P_opt = ON
else if arg1 == '-T' then
T_opt = ON
else if arg1 == '-G' then
graphicOpt = ON
else if arg1 == '-RM' then do
allargs = subword(allargs,2)
right_margin = strip(word(allargs, 1), 'both')
end
else if arg1 == '-LM' then do
allargs = subword(allargs,2)
left_margin = strip(word(allargs, 1), 'both')
end
else
arglist = arglist arg1
allargs = subword(allargs,2)
end
inputfile = arglist
if P_opt == OFF & T_opt == OFF then T_opt = ON /* default */
z = ""
do left_margin - 1
z = z || " "
end
listfile = ""
infile = inputfile
/*************************
* Invocation format *
*************************/
if inputfile = "" | inputfile = '?' then do
say "C to PL/I header file conversion aid. See cread.me for more information."
say
say "Usage: c2pli [-opts] inputfile [outputfile]"
say
say " inputfile: The C header file to be translated. Should have"
say " a filetype of h. "
say " outputfile: The name of the PL/I file to be generated. If "
say " omitted, defaults to the same name as the inputfile"
say " with a filetype of cpy. "
say " opts: "
say " t - Preserves C typecasts (default)"
say " p - Preserves statements as preprocessor declares"
say " g - Causes the M suffix to be used on string literals in "
say " the generated PL/I code (for DBCS strings). "
say " lm - Left margin "
say " rm - Right margin "
say " Using both the t and p options will produce two translations "
say " for some statements."
say
say "Examples: c2pli fn.h"
say " c2pli -t fn.h"
say " c2pli -p -g -lm 1 -rm 100 fn.h fn.inc"
exit
end
/*********************************************************/
/* !!!!!!! IMPORTANT !!!!!!! */
/* PLEASE READ THE FOLLOWING NOTE BELOW IF YOUR FILE USES */
/* PREDEFINED SYSTEM LINKAGE CONVENTIONS AND MAKE CHANGES */
/* AS REQUIRED. */
/**********************************************************/
/***********************************************************************/
/* Please include your predefined system linkage conventions below if */
/* it is not already in the list below: */
/* */
/* ex: If you defined CALLP16 to be _Far16 _Pascal then the following */
/* would be the mapping: */
/* ex in C: #define CALLP16 _Far16 _Pascal */
/* ex in PL/I : %dcl CALLP16 char scan; */
/* %CALLP16 = options(linkage(pascal16) byvalue nodescriptor) external;*/
/* */
/* If you then used CALLP16 in a function declaration you would need to manually */
/* add it to the list below in order for the aid to recognize the predefined linkage */
/* name. */
/* ex in C : int CALLP16 fun1( ); */
/* ex in PL/I: dcl fun1 entry ( ) */
/* returns (fixed bin(31) byvalue) */
/* CALLP16 */
/* */
/* The list below will look like the following after CALLP16 is added to the list: */
/* linkages = "_System _Optlink _Pascal", */
/* "_Far16 _Pascal _Far16 _Cdecl", */
/* "_Far16 _Fastcall _Far16", */
/* "APIENTRY EXPENTRY APIENTRY16", */
/* "PASCAL16 CDECL16 DSQ_API_FN", */
/* "SQL_API_FN _Seg16 SOMLINK", */
/* "CALLP16" */
/* */
/************************************************************************/
/********************************************************
* Please include your predefined system linkage conventions below if* *
* it is not already in the list below: *
* *
*********************************************************/
linkages = "_System _Optlink _Pascal",
"_Far16 _Pascal _Far16 _Cdecl",
"_Far16 _Fastcall _Far16",
"APIENTRY EXPENTRY APIENTRY16",
"PASCAL16 CDECL16 DSQ_API_FN",
"SQL_API_FN _Seg16 SOMLINK"
/********************************************************
* Scans the number of arguments the aid was invoked with. * *
*********************************************************/
num_args = words(inputfile)
if num_args = 2 then
do
fname = word(inputfile,num_args)
inputfile = word(inputfile,1)
end
else do
fname = word(inputfile,1)
inputfile = fname
end
orig_retain = inputfile
is_one = stream(inputfile, "C", "query exists");
If is_one \= '' Then
Do;
len = pos(".",inputfile)
tmp_file = substr(inputfile,1,len)||"#tm"
"copy" inputfile tmp_file
End;
else do
say "Inputfile "inputfile "not found"
exit
end
/********************************************************
* Scans file to see if C++ coments are used. If a C++ comment is * *
* encountered then the comments are converted to C comments. *
* *
*********************************************************/
say "Converting "inputfile " to PL/I "
call SysFileSearch "//", tmp_file, 'file'
if file.0 > 0 then
call change_comments inputfile tmp_file
/********************************************************
* Checks to see if the aid was invoked with two arguments or one * *
* and assigns filenames accordingly. *
* *
*********************************************************/
if inputfile \= "" then do
if num_args = 1 then
do
parse var inputfile fname '.' ext junk
end
else do
parse var infile inputfile fname
inputfile = strip(inputfile)
fname = strip(fname)
parse var inputfile inputfile "." ext
end
/********************************************************
* Checks to see if the extension is .h. If not a message is issued * *
* program exits. *
* *
*********************************************************/
ext = strip(ext)
if translate(ext) \= "H" & translate(ext) \= "MRI" then
do
say "Input File should be a .h file"
say "This utility can only convert a .h file"
exit
end
/********************************************************
* Makes back up copy of the existing cpy files or user defined file. * *
*********************************************************/
if num_args = 1 then
do
if translate(ext) = "H" then
do
incname = fname||".cpy"
oldname = fname||".bak"
end
else if translate(ext) = "MRI" then
do
oldname = fname||".bak"
incname = fname||".mrp"
end
end
if num_args = 2 then
do
if translate(ext) = "H" then
do
incname = fname
parse var fname tmp "." ext
oldname = tmp".bak"
end
else if translate(ext) = "MRI" then
do
incname = fname
parse var fname tmp "." ext
oldname = tmp||".bak"
end
end
is_one = stream(oldname, "C", "query exists");
If is_one \= '' Then
Do;
call SysFileDelete oldname
End;
/* If name.inc already exists, rename to name.bakw no message */
is_one = stream(incname, "C", "query exists");
If is_one \= '' Then
Do;
tmpname = translate(is_one, " ", "\")
num_words = words(tmpname)
tmpname = word(tmpname, num_words)
parse var tmpname justname"." .
just_name = justname || ".bak"
"Rename" incname just_name
End;
outputfile = incname
rc = stream(outputfile,"C","OPEN WRITE")
inputfile = tmp_file
/* end */
/*******************************************************
* Set up counter to control indentation line number and right margins*
********************************************************/
counter = 0
indent = 0
indentation = " "
strt_counter = 1
line_num = 0
i = 0
j = 0
k = 0
array.i.k = ""
c. = ""
comment. = ""
out_line = z"/**********************************************************"
rc = lineout(outputfile,out_line)
out_line = z"* CREATED BY C2PLI CONVERSION UTILITY *"
rc = lineout(outputfile,out_line)
out_line = z"**********************************************************/"
rc = lineout(outputfile,out_line)
/********************************************
* Open the input file. Read each line and *
* call a routine to process the line *
********************************************/
rc = stream(inputfile, "C", "OPEN")
do while lines(inputfile)
line = linein(inputfile)
line_num = line_num + 1
line =strip(line)
/********************************************
* If the line continues to the next line, *
* append the second line to the first, etc. *
********************************************/
len = lastpos("\",line)
if len > 0 & len = length(line) then
do
do while len > 0
parse var line line "\"
line = line || linein(inputfile)
line = strip(line)
line_num = line_num + 1
len = lastpos("\",line)
end
end
call process_line line
end
/******************************************************
* Close the outputfile and end the conversion process *
******************************************************/
rc = stream(outputfile, "C", "CLOSE")
rc = stream(inputfile, "C", "CLOSE")
say "CONVERSION OF "infile" to PL/I IS COMPLETE."
end
rc = SysFileDelete(tmp_file)
exit
/********************************************************
* Routine to convert C++ comments to C comments. * *
*********************************************************/
change_comments:
parse arg fn nfn
if fn = '?' | fn= '' then
do
say 'Usage: COMMENT fn'
say ''
say 'Replaces //... with /*...*/'
exit
end
rc = stream(nfn,'C','OPEN')
do while lines(fn) > 0
len = 0
change=0
l = linein(fn)
len = lastpos("//",l)
if len > 0 then
do
do while pos('//', l) > 0
l=overlay('/*', l, pos('//', l))
change=1
end
end
if change=1 then
do
if lastpos("*/",l) = 0 & len > 0 then
l = l||' */'
end
call lineout nfn,l
end
call lineout fn /* Closes file */
call lineout nfn /* Closes file */
return
/********************************************************
* Routine invoked when severe error occurs .. program terminates * *
*********************************************************/
syntax:
say 'REXX syntax error ' rc 'in line' sigl':' errortext(rc)
say sourceline(sigl)
trace ?r; nop
notready:
out_line = z"%note('Error 1: Unsupported syntax encountered',4);"
rc = lineout(outputfile,out_line)
out_line = z"/* Severe Error occured while processing the file */"
rc = lineout(outputfile,out_line)
out_line = z"/* Program is terminated */"
rc = lineout(outputfile,out_line)
out_line = z"/* The original line in the .h file is: "line_num" */"
rc = lineout(outputfile,out_line)
out_line = ""
rc = lineout(outputfile,out_line)
say = "Terminating error occured "
exit
/********************************************************
* Routine called by the aid to write information to the .inc file and *
* check the return code for a successful write. If the write failed an *
* error message is issued the .inc file is closed and program ends. * *
*********************************************************/
do_writeout:
parse arg outputline
len = length(outputline)
if len > right_margin then
rc = do_format1(outputline)
else do
rc = lineout(outputfile,outputline)
end
if rc \= 0 then
do
out_line = z"%note('Error 2: Unsupported syntax encountered',4);"
rc = lineout(outputfile,out_line)
out_line = z"/* Severe Error occured while processing the file */"
rc = lineout(outputfile,out_line)
out_line = z"/* Program is terminated */"
rc = lineout(outputfile,out_line)
out_line = z"/* The original line in the .h file is: "line_num" */"
rc = lineout(outputfile,out_line)
out_line = ""
rc = lineout(outputfile,out_line)
say = "Terminating error occured "
rc =stream(inputfile".inc",'C','CLOSE')
exit
end
return
/*******************************************************************
* Subroutine to process a line in the input file *
********************************************************************/
process_line:
parse arg line
/*****************************************
* Remove white space from the beginning *
* of the input line *
*****************************************/
line = strip(line)
if left(line,1,5) = "const" & left(line,6) = " " then
do
parse var line "const" line
line = strip(line)
end
else
/***************************
* Check for a comment line *
***************************/
if substr(line,1,2) = "/*" then call do_comment(line)
/*************************
* Check for a blank line *
*************************/
else if line = "" then do
call do_blank
end /* Do */
/***************************************
* Parse out the first word in the line *
***************************************/
else do
parse var line first rest
/***************************************************
* Remove spaces between ex:# define ... if it exists*
***************************************************/
if first = "#" then
do
parse var rest first1 rest
if datatype(first1) = "NUM" then
do
first = first
rest = first1
end
else
first = first||first1
end
else nop /* comes in here most of the times. */
first = strip(first)
/*********************************************
* Determine the type of statement to convert *
*********************************************/
select
when translate(first) = "#UNDEF" then call do_undef(rest)
when translate(first) = "#INCLUDE" then call do_include(rest)
when translate(first) = "#DEFINE" then call do_define(rest)
when translate(first) = "UNION" then do
i = 1 /* i & j act as counters to keep track of the level of nesting */
j = 1
call do_union(rest)
end /* Do */
when translate(first) = "TYPEDEF" then do
flag = "typedef"
tflag = "on"
i = 1 /* i & j act as counters to keep track of the level of nesting */
j = 1
call do_typedef(rest)
end /* Do */
when translate(first) = "STRUCT" then do
tflag = "off"
i = 1 /* i & j act as counters to keep track of the level of nesting */
j = 1
call do_real_struct(rest)
end /* Do */
when translate(first) = "ENUM" then call do_enum(rest)
when translate(first) = "#IFDEF" then call do_ifdef(rest)
when translate(first) = "#IF" then call do_if(rest)
when translate(first) = "#IFNDEF" then call do_ifndef(rest)
when translate(first) = "#ENDIF" then call do_endif(rest)
when translate(first) = "#PRAGMA" then call do_pragma(rest)
when translate(first) = "#ELSE" then call do_else(rest)
when translate(first) = "#ERROR" then call do_error(rest)
when translate(first) = "#LINE" | translate(first) = "#" then call do_line(rest)
when translate(first) = "SOMEXTERN" then call do_som(rest)
when translate(first) = "#ELSEIF" then call do_elseif(rest)
when translate(first) = "#ELIF" then call do_elif(rest)
otherwise do
/********************************************
* If the line contains none of the previous *
* commands, check if it is a variable or *
* function definition *
********************************************/
org_line = line
call do_variable_or_function(line)
if result = false then
do
say " Problem encountered "org_line
cpos = pos("/*",org_line)
if cpos \= 0 then
do
comment = substr(org_line,cpos)
line = delstr(org_line,cpos)
end
else
line = org_line
out_line = z"%note('Error 3: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This definition is not supported by this utility. */ "
call do_writeout(out_line)
out_line = z"/* Error: "line" */ "
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
end
end
end /* select */
end
return
exit
/********************************************************************
* Subroutine to process a blank line *
********************************************************************/
/******************************
* If there is a blank line, *
* output a blank line to the *
* converted header file *
******************************/
do_blank:
rc = lineout(outputfile,line)
return
/********************************************************************
* Subroutine to process #undef statement *
********************************************************************/
/********************************
* Routine called to deactivate a statement *
********************************/
do_undef:
parse arg rest
cpos = pos("/*",rest)
if cpos \= 0 then
do
rest = substr(rest,cpos)
comment = delstr(rest,cpos)
end
parse var rest name
name = check_name(name)
out_line = z"%deact "name";"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
return
/********************************************************
* Routine used to format line > right margin in length.
*********************************************************/
do_format1:
parse arg rest_o
len = length(rest_o)
all = rest_o
if substr(rest_o,right_margin) = "*/" then
do
rest1 = substr(rest_o,1,right_margin-1)
rest_o = rest1" */"
all = rest_o
o_line =dbleft(rest_o,right_margin)
end
else
o_line =dbleft(rest_o,right_margin)
rc = lineout(outputfile,o_line)
rest_o = z || dbrleft(all,right_margin)
flag_done = false
do while flag_done=false
if rest_o \= "" then
do
if substr(rest_o,right_margin) = "*/" then
do
rest1 = substr(rest_o,1,right_margin-1)
rest_o = rest1" */"
o_line = dbleft(rest_o,right_margin)
end
else
o_line = dbleft(rest_o,right_margin)
rc = lineout(outputfile,o_line)
rest_o = z || dbrleft(rest_o,right_margin)
end
if rest_o \= "" then
flag_done = false
else do
flag_done = true
rest_o = ""
end
end
return rc
/********************************************************************
* Subroutine to process #include statement *
********************************************************************/
do_include:
parse arg rest
/******************************
* Parse the include statement *
******************************/
cpos=pos('/*', rest)
if cpos\=0 then
do
comment=substr(rest,cpos)
rest=delstr(rest,cpos)
end
f_name = strip(rest)
/******************************************
* Translate the include statement to PL/I *
******************************************/
parse value f_name with f_name '.' extension
f_name = substr(f_name,2)
f_name= check_name(f_name)
/* change '/' to '\' for os/2 */
do while (pos('/',f_name) \= 0)
pos_slash = pos('/',f_name)
f_name = overlay('\',f_name, pos_slash)
end /* do while (pos('/',f_name) \= 0) */
o_line = z"%include" f_name";"
o_line = do_indent(o_line)
call do_writeout(o_line)
if cpos \= 0 then
call do_comment(comment)
return
/********************************************************************
* Subroutine to process #define statement *
********************************************************************/
do_define:
parse arg rest
/**********************************************
* Separate comments from the rest of the line *
**********************************************/
cpos=pos('/*', rest)
if cpos\=0 then
do
comment=substr(rest,cpos)
comment = strip(comment)
rest=delstr(rest,cpos)
end
parse var rest name val
if left(val,1) == '"' then do
notop = 0
leftshift = 0
rightshift = 0
oropr = 0
end
else do
notop = pos("~",val)
leftshift = pos("<<",val)
rightshift = pos(">>",val)
oropr = pos("|",val)
end
numeric digits 10
num = ""
flag = ""
max_val = "2147483647"
/************************************************
* Remove the __ prefix from the definition name *
************************************************/
if substr(name,1,1) = "_" then
name = check_name(name)
/*********************************************
* If it is simply a definition which defines *
* xxx=XXX then ignore it *
*********************************************/
val1st = left(strip(val),1)
if translate(name) = val |,
name = translate(val) |,
pos("[",name) \= 0 |,
(pos("[",val) \= 0 & val1st \= "'" & val1st \= '"'),
then do
out_line = z"%note('Error 4: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This definition is not supported by this utility. */ "
call do_writeout(out_line)
out_line = z"/* Error: #define "name" "val" */ "
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
/************************************************
* Processing for left shift and right shift is done below. *
************************************************/
select
when leftshift \= 0 & pos("(",name) = 0 then do
call do_shift(name" "val)
if cpos \= 0 then
call do_comment(comment)
val = done
return val
end
when rightshift \= 0 & pos("(",name) = 0 then do
call do_shift(name" "val)
if cpos \= 0 then
call do_comment(comment)
val = done
return val
end
/************************************************
* Error messages for Or Not is provided. *
************************************************/
when oropr \= 0 & pos("(",name) = 0 then do
out_line = z"%note('Error 5: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Or operator is not supported by this utility. */ "
call do_writeout(out_line)
out_line = z"/* Error: #define "name" "val" */ "
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
val = done
return val
end
when notop \= 0 & substr(val,1) = "~" & pos("(",name) = 0 then do
val = strip(val)
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line = z"%dcl @"name" char ext;"
call do_writeout(out_line)
out_line = z"%@"name"='@"val"';"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
val = done
return val
end
otherwise
nop /* okay to come here */
end
parse var val val
val = strip(val)
/**************************************************
* In case it is a array convert to PL/I array mapping. *
**************************************************/
if pos("[",name) \= 0 then
do
if pos("][",name) \= 0 then
do
name= convert_bracket(name)
name = convert_finalbracket(name)
end
else
name = convert_finalbracket(name)
end
/********************************
* Check for pointer definition *
* by looking for a * *
********************************/
if val = "*" then return
if substr(val,1,1) = "*" then do
val = "pointer"
end
/*******************************************
* Check to see if the definition sets a *
* value, or simply declares a variable as *
* defined. If there is no value, set the *
* variable = 'Y' *
*******************************************/
if val = "" then
do
out_line1 = z"%dcl "name" char ext;"
out_line = z"%"name" = 'Y';"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line=""
if cpos \= 0 then
call do_comment(comment)
val = done
if val = done then return
end
/************************************************
* Check to see if the value is of a special kind then *
* use %dcl syntax since the value needs to be substituted *
*************************************************/
sys_lc = "_System * _Seg16 _Far16 _Far16 _Pascal void _Far16 _Cdecl",
"_Pascal _Optlink _Far16 _Fastcall"
if wordpos(val,sys_lc) > 0 then
do
val = special_value(val)
out_line1 = z"%dcl "name" char scan;"
out_line = z"%"name" = '"val"';"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line=""
if cpos \= 0 then
call do_comment(comment)
val = done
if val = done then return
end
/*****************************************************
* Check to see if the value is an alias to a C datatype then *
* use define alias syntax. *
******************************************************/
datatypes = " long short char int unsigned short long int short int unsigned int ",
" unsigned char unsigned long signed short signed int signed long signed char "
if wordpos(val,datatypes) > 0 then
do
val = process_rtype(val)
out_line = z"define alias "name" "val";"
out_line= do_indent(out_line)
call do_writeout(out_line)
out_line1 = z"define alias @"name" pointer;"
out_line= do_indent(out_line1)
call do_writeout(out_line1)
out_line = ""
out_line1 = ""
val = done
if cpos \= 0 then
call do_comment(comment)
if val = done then return
end
/************************************************
* Check to see if the name in #define is FAR or NEAR then*
* give it the pointer attribute. *
*************************************************/
if (translate(name) = "FAR" | translate(name) = "NEAR") & (val \= "" )then
do
val = special_value(val)
out_line1 = z"define alias "name" pointer;"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
val = done
if cpos \= 0 then
call do_comment(comment)
if val = done then return
end
/*****************************************************
* If there are parentheses in the definition, or value is typecasted*
* call a routine to handle them. *
*****************************************************/
if pos('(', val) \= 0 | pos('(',name) \= 0 then
do
val = do_typecasts(name,val)
if cpos \= 0 then
call do_comment(comment)
val = done
if val = done then return
end
/*****************************************************
* If the value is a hexadecimal value then call a routine called *
* do_hex to map the value to the PL/I equivalent. *
*****************************************************/
if pos("0X",val) \= 0 | pos("0x",val) \= 0 then
do
call do_hex(name" "val)
if cpos \= 0 then
call do_comment(comment)
val = done
if val = done then return
end
/*****************************************************
* If the value is none of the above call special_value to see if *
* val is converted. *
*****************************************************/
val = special_value(val)
operators = "\ ** "
addpos = pos("+",val)
subbpos = pos("-",val)
/*****************************************************
* If the value is directly defined then check to see if it is a char,*
* string, number, pointer etc and use the appropriate declare *
* statement. If the value is a integer data type and has "UL","L" *
* or "US" or "S" then assigns the approriate data type. *
******************************************************/
select
when (addpos \= 0 | subbpos \= 0 )then do
out_line1 = z"%dcl "name" char ext;"
out_line2 = z"%"name" = '"val"';"
addpos = ""
subbpos = ""
end
when wordpos(val,operators) > 0 then do
out_line1 = z"/* This utility does not support this kind of operation */"
out_line2 = z"/* Error:"first" "name" "val"*/"
end
when pos('"',val) \= 0 then do
if T_opt == ON then
do
if graphicOpt == ON then
out_line1 = z"dcl "name" char value("val"M);"
else
out_line1 = z"dcl "name" char value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
if graphicOpt == ON then
out_line = z"%"name" = '"val"M';"
else
out_line = z"%"name" = '"val"';"
call do_writeout(out_line)
out_line= ""
end
end
when pos("'",val) \= 0 then do
if T_opt == ON then
do
out_line1 = z"dcl "name" char value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'val'";'
call do_writeout(out_line)
out_line= ""
end
end
when datatype(val) = "NUM" & val <= max_val then do
if T_opt == ON then
do
out_line1 = z"dcl "name" fixed bin(31) value("val");"
out_line2= ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z"%"name" = "val";"
call do_writeout(out_line)
out_line= ""
end
end
when datatype(val) = "NUM" & val > max_val then do
numeric digits 10
val = D2X(val)
val = "'"val"'xn"
if T_opt == ON then
do
out_line1 = z"dcl "name" fixed bin(31) value("val");"
out_line2= ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z"%"name" = "val";"
call do_writeout(out_line)
out_line= ""
end
end
/**************************************************
* Conversion of constants with UL. *
**************************************************/
when translate(right(val,2)) = "UL" then do
len = length(val)
val = strip(val)
val = delstr(val,(len - 1),2)
if datatype(val) = "NUM" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" unsigned fixed bin(31) value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z"%"name" = "val";"
call do_writeout(out_line)
out_line= ""
end
end
else do
val = val||UL
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line1 = z"%dcl @"name" char ext;"
out_line2 = z"%@"name"='@"val"';"
end
end
/**************************************************
* Conversion of constants with L. *
**************************************************/
when translate(right(val,1)) = L then do
len = length(val)
val = delstr(val,len,1)
if datatype(val) = "NUM" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" fixed bin(31) value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z"%"name" = "val";"
call do_writeout(out_line)
out_line= ""
end
end
else do
val = val||L
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line1 = z"%dcl @"name" char ext;"
out_line2 = z"%@"name"='@"val"';"
end
end
/**************************************************
* Conversion of constants with U. *
**************************************************/
when translate(right(val,1)) = "U" then do
len = length(val)
val = delstr(val,len,1)
if datatype(val) = "NUM" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" unsigned fixed bin(31) value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z"%"name" = "val";"
call do_writeout(out_line)
out_line= ""
end
end
else do
val = val||U
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line1 = z"%dcl @"name" char ext;"
out_line2 = z"%@"name"='@"val"';"
end
end
/**************************************************
* Conversion of constants with US. *
**************************************************/
when translate(right(val,2)) = "US" then do
len = length(val)
val = delstr(val,(len - 1),2)
if datatype(val) = "NUM" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" unsigned fixed bin(16) value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z"%"name" = "val";"
call do_writeout(out_line)
out_line= ""
end
end
else do
val = val||US
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line1 = z"%dcl @"name" char ext;"
out_line2 = z"%@"name"='@"val"';"
end
end
/**************************************************
* Conversion of constants with S. *
**************************************************/
when translate(right(val,1)) = "S" then do
len = length(val)
val = delstr(val,len,1)
if datatype(val) = "NUM" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" signed fixed bin(15) value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z"%"name" = "val";"
call do_writeout(out_line)
out_line= ""
end
end
else do
val = val||S
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line1 = z"%dcl @"name" char ext;"
out_line2 = z"%@"name"='@"val"';"
end
end
when val = "POINTER" | val = "pointer" then do
out_line1 = z"define alias "name" "val";"
out_line2 = ""
end
when val \= "" then do
val = check_name(val)
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line1 = z"%dcl @"name" char ext;"
out_line2 = z"%@"name"='@"val"';"
if val = false | val = true then
val = done
end
otherwise
nop /* okay to come here */
val = done
end /* Select */
num = ""
/*******************************************
* If the paren routine could not *
* convert the line, issue an error message *
*******************************************/
if val = false then
do
out_line = "%note('Error 6: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Or operator is not supported by this utility. */ "
call do_writeout(out_line)
out_line = z"/* Error: "rest"*/"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
/***********************************
* Output the definition statements *
***********************************/
if out_line1 \= "OUT_LINE1" & out_line1 \= "" then
do
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line1 = ""
end
if out_line2 \= "OUT_LINE2" & out_line2 \= "" then
do
out_line2 = do_indent(out_line2)
call do_writeout(out_line2)
out_line2 = ""
end
/************************************
* If there was a comment at the end *
* of the line, convert it *
************************************/
if cpos \= 0 then do
call do_comment(comment)
end
return
/***********************************
* Outputs the hexadecimal statements *
***********************************/
do_hex:
parse arg rest
parse var rest name val
/**************************************************
* Conversion of expressions with hex constants. (+)*
**************************************************/
select
when pos("0X",val) \= 0 & pos("+",val) \=0 & substr(val,1,1) \= "+" then do
parse var val val "+" val2
val = strip(val)
val2 = strip(val2)
if pos("0X",val) \= 0 then
do
val = convert_hexval1(val)
end
else
val2= convert_hexval1(val2)
val = val||"+"||val2
out_line1 = z"%dcl "name" char ext;"
call do_writeout(out_line1)
out_line1 = z'%'name'="'val'";'
call do_writeout(out_line1)
val = done
end
when pos("0x",val) \= 0 & pos("+",val) \=0 & substr(val,1,1) \= "+" then do
parse var val val "+" val2
val = strip(val)
val2 = strip(val2)
if pos("0x",val) \= 0 then
do
val = convert_hexval1(val)
end
else
val2= convert_hexval1(val2)
val = val||"+"||val2
out_line1 = z"%dcl "name" char ext;"
call do_writeout(out_line1)
out_line1 = z'%'name'="'val'";'
call do_writeout(out_line1)
val = done
if val = done then return
end
/**************************************************
* Conversion of expressions with hex constants. (-)*
**************************************************/
when pos("0X",val) \= 0 & pos("-",val) \=0 & substr(val,1,1) \= "-" then do
parse var val val "-" val2
val = strip(val)
val2 = strip(val2)
if pos("0X",val) \= 0 then
do
val = convert_hexval1(val)
end
else
val2= convert_hexval1(val2)
val = val||"-"||val2
out_line1 = z"%dcl "name" char ext;"
call do_writeout(out_line1)
out_line1 = z'%'name'="'val'";'
call do_writeout(out_line1)
end
when pos("0x",val) \= 0 & pos("-",val) \=0 & substr(val,1,1) \= "-" then do
parse var val val "-" val2
val = strip(val)
val2 = strip(val2)
if pos("0x",val) \= 0 then
do
val = convert_hexval1(val)
end
else
val2= convert_hexval1(val2)
val = val||"-"||val2
out_line1 = z"%dcl "name" char ext;"
call do_writeout(out_line1)
out_line1 = z'%'name'="'val'";'
call do_writeout(out_line1)
end
/**************************************************
* Conversion of expressions with hex constants. (-)*
**************************************************/
when pos("0X",val) \= 0 & substr(val,1,1) = "-" then do
parse var val "-" val
if pos("-",val) \= 0 then
do
parse var val val "-" val2
val = strip(val)
val2 = strip(val2)
val= convert_hexval1("-"||val)
val = val||" - "||val2
end
else if pos("+",val) \= 0 then
do
parse var val val "+" val2
val = strip(val)
val2 = strip(val2)
val= convert_hexval1("+"||val)
val = val||" + "||val2
end
else do
val = "-"||val
val = convert_hexval1(val)
end
out_line1 = z"%dcl "name" char ext;"
call do_writeout(out_line1)
out_line1 = z'%'name'="'val'";'
call do_writeout(out_line1)
out_line1 = ""
val = done
end
/**************************************************
* Conversion of expressions with hex constants. (-)*
**************************************************/
when pos("0x",val) \= 0 & substr(val,1,1) = "-" then do
parse var val "-" val
if pos("-",val) \= 0 then
do
parse var val val "-" val2
val = strip(val)
val2 = strip(val2)
val= convert_hexval1("-"||val)
val = val||" - "||val2
end
else if pos("+",val) \= 0 then
do
parse var val val "+" val2
val = strip(val)
val2 = strip(val2)
val= convert_hexval1("+"||val)
val = val||" + "||val2
end
else do
val = "-"||val
val = convert_hexval1(val)
end /* Do */
out_line1 = z"%dcl "name" char ext;"
call do_writeout(out_line1)
out_line1 = z'%'name'="'val'";'
call do_writeout(out_line1)
val = done
end
/**************************************************
* Conversion of expressions with hex constants. (+)*
**************************************************/
when pos("0X",val) \= 0 & substr(val,1,1) = "+" then do
parse var val "+" val
if pos("-",val) \= 0 then
do
parse var val val "-" val2
val = strip(val)
val2 = strip(val2)
val= convert_hexval1("-"||val)
val = val||" - "||val2
end
else if pos("+",val) \= 0 then
do
parse var val val "+" val2
val = strip(val)
val2 = strip(val2)
val= convert_hexval1("+"||val)
val = val||" + "||val2
end
else do
val = "+"||val
val = convert_hexval1(val)
end /* Do */
out_line1 = z"%dcl "name" char ext;"
call do_writeout(out_line1)
out_line1 = z'%'name'="'val'";'
call do_writeout(out_line1)
end
/**************************************************
* Conversion of expressions with hex constants. (+)*
**************************************************/
when pos("0x",val) \= 0 & substr(val,1,1) = "+" then do
parse var val "+" val
if pos("-",val) \= 0 then
do
parse var val val "-" val2
val = strip(val)
val2 = strip(val2)
val= convert_hexval1("-"||val)
val = val||" - "||val2
end
else if pos("+",val) \= 0 then
do
parse var val val "+" val2
val = strip(val)
val2 = strip(val2)
val= convert_hexval1("+"||val)
val = val||" + "||val2
end
else do
val = "+"||val
val = convert_hexval1(val)
end /* Do */
out_line1 = z"%dcl "name" char ext;"
call do_writeout(out_line1)
out_line1 = z'%'name'="'val'";'
call do_writeout(out_line1)
end
/**************************************************
* Conversion of expressions with hex constants. *
**************************************************/
when pos("0X",val) \= 0 | pos("0x",val) \= 0 then do
call convert_hexval( name" "val)
end
otherwise nop /* okay to come here */
end
return
/**************************************************
* Replaces leading underscores in identifiers with leading # *
***************************************************/
check_name:
parse arg n1
select
when substr(n1,1,1) = "_" then do
n1 = delstr(n1,1,1)
n1 = "#"||n1
end /* Do */
when substr(n1,1,2) = "__" then do
n1 = delstr(n1,1,2)
n1 = "#_"||n1
end /* Do */
otherwise nop /* okay to come here */
end /* select */
return n1
/**************************************************
* Processes expressions with right and left shifts. *
***************************************************/
do_shift:
parse arg line
parse var line name val
if pos("(",val) \=0 then
do
parse var val "(" val
if pos("(",val) \= 0 then
parse var val "(" val ")" num ")"
else
parse var val val ")" num
end
if num = "" then
parse var val n1 shift n2
else
if num \= "" then
do
parse var num n1 shift n2
end /* Do */
if pos("<<",n1) \= 0 then
do
parse var n1 n1 "<<" n2
shift ="<<"
end
if pos(">>",n1) \= 0 then
do
parse var n1 n1 ">>" n2
shift =">>"
end
shift = strip(shift)
n1 = strip(n1)
n2 = strip(n2)
select
when shift = "<<" then do
out_line1 = z"%dcl "name" char ext;"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line1 = z"%"name"='raise2("n1","n2")';"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
end
when shift = ">>" then do
out_line1 = z"%dcl "name" char ext;"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line1 = z"%"name"='lower2("n1","n2")';"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
end
otherwise nop /* okay to come here */
end /* select */
return
/********************************************************************
* Subroutine to handle a definition with typecasts. *
********************************************************************/
do_typecasts:
flag_PSZ = false
parse arg name, val
notop = pos("~",val)
parse var val tilda "(" val
val = strip(val)
leftshift = pos("<<",val)
rightshift = pos(">>",val)
oropr = pos("|",val)
len = length(name)
addpos = pos("+",val)
subbpos = pos("-",val)
/*****************************************************
* If the value is directly defined then check to see if it is a char,*
* string, number, pointer etc and use the appropriate declare *
* statement. If the value is a integer data type and has "UL","L" *
* or "US" or "S" then assigns the approriate data type. *
******************************************************/
tmp_val = val
len = pos(")",tmp_val)
if pos("0x",val) = 0 & pos("0x",val) = 0 & pos("(",name) = 0 then
if addpos \= 0 | subbpos \= 0 then
do
val = process_exp(val)
out_line1 = z"%dcl "name" char ext;"
call do_writeout(out_line1)
out_line2 = z"%"name" = '"val"';"
call do_writeout(out_line2)
addpos = ""
subbpos = ""
out_line1 =""
out_line2 = ""
val = done
return val
end
select
/*******************************************
* If there is a left paren in the name, *
* then assume it is a macro definition. *
* Macros are not converted by this utility *
*******************************************/
when pos("(", name) \= 0 then do
new_file = infile
out_line = z"%note('Error 7: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Macros are not supported by this utility. */ "
call do_writeout(out_line)
out_line = z"/* Error: "name" ("val"*/"
call do_writeout(out_line)
macrofile = "Macros.h"
rc = stream(macrofile,"C","OPEN WRITE")
if counter = 0 then
do
out_line = ""
rc = lineout(macrofile,out_line)
out_line = "File : "orig_retain
rc = lineout(macrofile,out_line)
counter = 1
end
out_line = z"/* The original line in the .h file is: "line_num" */"
rc = lineout(macrofile,out_line)
out_line = z"#define "name" ("val
rc = lineout(macrofile,out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
cpos = 0
val = done
return val
end
/***********************************************
* If the line defines a PSZ whith a hex value, remove the *
* parenthesis and call convert_hexval for hexadecimal *
* conversion. *
***********************************************/
when pos("PSZ", val) \= 0 & pos("0X", val) \= 0 then do
parse var val "PSZ)" val ")"
flag_PSZ = true
nval = name" "val
call convert_hexval(nval)
val = done
return val
end
when pos("PSZ", val) \= 0 & pos("0x", val) \= 0 then do
parse var val "PSZ)" val ")"
flag_PSZ = true
nval = name" "val
call convert_hexval(nval)
val = done
return val
end
/****************************************************
* If the value is simply enclosed in parens, just convert it. *
* convert it ex: #define val ((unsigned long) 10) - double parens.*
****************************************************/
when pos("(",val) \= 0 & oropr \= 0 then
do
out_line = z"%note('Error 8: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Or operator is not supported by this utility. */ "
call do_writeout(out_line)
out_line = z"/* Error: "rest"*/"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
val = done
return val
end
when pos("(",val) \= 0 & verifyval(val) = 0 then
parse var val "(" val ")" num ")"
when pos("(",val) \= 0 & verifyval(val) > 0 then do
parse var val "(" val ")" num ")"
num = strip(num)
if pos("+",num) \= 0 & substr(num,1,1) \= "+" then nop
else
if pos("-",num) \= 0 & substr(num,1,1) \= "-" then nop
else do
val = val" "num
num = ""
end
end
when pos("(",val) \= 0 & notop \= 0 then do
parse var val "(" val ")" num ")"
val = "~"||val" "num
num = ""
end
/****************************************************
* If the value is simply enclosed in parens, just convert it. *
* convert it ex: #define val (unsigned long) 10 - single parens. *
****************************************************/
when pos("(",val) = 0 then
parse var val val ")" num
otherwise
nop /* okay to come here */
end /* select */
num = strip(num)
/*****************************************************
* If num is not empty and is a hex value call do_hex to convert *
* num. (it is associated with a typecast.) * *
*****************************************************/
if pos("0X",num) = 0 & pos("0x",num)= 0 then
do
if translate(right(num,1)) = "L" | translate(right(num,1)) = "U" | translate(right(num,1)) = "S" ,
| translate(right(num,2)) = "UL" | translate(right(num,2)) = "US" then
do
num = do_value1(num)
end
end
if num \= "" & pos("0x",num) \= 0 & substr(num,1,1) \= "+" & pos("+",num) \= 0 then
do
call do_hex(name" "num)
val = done
if val = done then return val
end
if num \= "" & pos("0X",num) \= 0 & substr(num,1,1) \= "+" & pos("+",num) \= 0 then
do
call do_hex(name" "num)
val = done
if val = done then return val
end
if num \= "" & pos("0x",num) \= 0 & substr(num,1,1) \= "-" & pos("-",num) \= 0 then
do
call do_hex(name" "num)
val = done
if val = done then return val
end
if num \= "" & pos("0X",num) \= 0 & substr(num,1,1) \= "-" & pos("-",num) \= 0 then
do
call do_hex(name" "num)
val = done
if val = done then return val
end
/*****************************************************
* If num is empty and val is a hex value call do_hex to convert *
* val. (it is not associated with a typecast.) * *
*****************************************************/
if num = "" & pos("0x",val) \= 0 then
do
call do_hex(name" "val)
val = done
if val = done then return val
end
if num = "" & pos("0X",val) \= 0 then
do
call do_hex(name" "val)
val = done
if val = done then return val
end
if num = "" then
do
val = do_value(val)
if val = done then return val
end
val = strip(val)
val = space(val,1)
val = special_value(val)
if pos("0X",num) \= 0 | pos("0x",num) \= 0 then
num = convert_hexval1(num)
num = strip(num)
addpos = pos("+",num)
subbpos = pos("-",num)
addval = pos("+",val)
subval = pos("-",val)
/****************************************************/
/* call the appropriate statement to define the correct data type */
/* after value is evaluated. */
/****************************************************/
if substr(num,1,1) = "*" then
do
out_line1 = z"define alias "name" pointer;"
end
else if datatype(num) = "NUM" & flag_pointer = true then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" pointer value(ptrvalue("num"));"
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'num'";'
call do_writeout(out_line)
out_line = ""
end
end
else if flag_pointer = true & translate(right(num,2)) = "XN" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" pointer value(ptrvalue("num"));"
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'num'";'
call do_writeout(out_line)
out_line = ""
end
end
else if right(num,2) = "xn" & flag = "typedval" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" type "val " value("num");"
flag = ""
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'num'";'
call do_writeout(out_line)
out_line= ""
end
end
else if datatype(num) = "NUM" & flag = "typedval" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" type "val" value("num");"
flag = ""
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'='num';'
call do_writeout(out_line)
out_line= ""
end
end
else if (addpos \= 0 | subbpos \= 0) & flag ="typedval" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" type "val " value("num");"
flag = ""
addpos = ""
subbpos = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'num'";'
call do_writeout(out_line)
out_line = ""
end /* Do */
end
else if (addval \= 0 | subval \= 0) & flag ="typedval" then
do
out_line1 = z"%dcl "name" char ext;"
out_line2 = z"%"name" = '("val")';"
flag = ""
addval = ""
subval = ""
end
else if datatype(num) = "NUM" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" "val" value("num");"
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'='num';'
call do_writeout(out_line)
out_line= ""
end
end
else if val = "POINTER" | val = "pointer" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" "val";"
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'val'";'
call do_writeout(out_line)
out_line = ""
end
end
else if num = "" & wordpos(val,datatypes) = 0 then
do
out_line1 = z"%dcl "name" char ext;"
out_line2 = z"%"name" = '("val")';"
flag = ""
end
else if num \= "" & wordpos(val,datatypes) = 0 ,
& flag = "typedval" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" type "val " value("num");"
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'num'";'
call do_writeout(out_line)
out_line = ""
end /* Do */
end
else if num \= "" then do
if T_opt == ON then
do
out_line1 = z"dcl "name" "val" value("num");"
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'num'";'
call do_writeout(out_line)
out_line = ""
end /* Do */
end
num = ""
/***********************************
* Output the definition statements *
***********************************/
if out_line1 \= "" & out_line1 \= "OUT_LINE1" then
do
call do_writeout(out_line1)
out_line1 = ""
end
if out_line2 \= "" & out_line2 \= "OUT_LINE2" then
do
out_line2 = do_indent(out_line2)
call do_writeout(out_line2)
end /* Do */
return val
/****************************************************
* verifies if '+ or - ' is found in val and process expressions *
* of the form (int (a+b)) or (int) a+b-c *
****************************************************/
process_exp:
parse arg val
select
/***********************************************
* If the line defines (unsigned long) a+b remove the *
* parenthesis and process the expression depending on *
* whether val is a C data type or userdefined type *
***********************************************/
when pos("(",val) = 0 then do
parse var val val ")" lval
lval = strip(lval)
if wordpos(val,datatypes) > 0 then
do
lval = check_val(lval)
val = lval
end
else
if wordpos(val,datatypes) = 0 & lval \= "" then
do
lval = check_val(lval)
val = lval
end
else
if val \= "" & lval = "" then
do
val = check_val(val)
val = val
end
end /* Do for when pos (" = 0*/
when pos("(",val) \= 0 then do
if left(val,1) = "(" then
do
parse var val "(" val ")" lval ")"
if wordpos(val,datatypes) > 0 then
do
lval = check_val(lval)
val = lval
end
else
if wordpos(val,datatypes) = 0 & lval \= "" then
do
lval = check_val(lval)
val = lval
end
else
if val \= "" & lval = "" then
do
val = check_val(val)
val = val
end
end /* Do */
else val = "("||val
end
otherwise do
val = "("||val
end
end /* select */
return val
/****************************************************
* verifies if '+ or - ' is found in val and parses the expressions *
* of the required form for processing. *
****************************************************/
check_val:
parse arg lval
addpos = "+"
subpos = "-"
lval = strip(lval)
if substr(lval,1,1) = "+" | substr(lval,1,1) = "-" then
do
sign = delstr(lval,2,length(lval))
lval = substr(lval,2,length(lval))
end
else
sign = ""
lval = check_name(lval)
origlval = lval
if pos("+",lval) \= 0 | pos("-",lval) \= 0 then
do
select
when pos("+",lval) \= 0 then do
len = pos("+",lval)
if len > 0 then
do
lval = substr(lval,1,len)
left1 = delstr(origlval,1,len)
left1 = check_name(left1)
lval = lval||left1
end
end
when pos("-",lval) \= 0 then do
len = pos("-",lval)
if len > 0 then
do
lval = substr(lval,1,len)
left1 = delstr(origlval,1,len)
left1 = check_name(left1)
lval = lval||left1
end
end
otherwise nop /* okay to come here */
end
end
return sign||lval
/****************************************
* Returns 1 or 0 depending on the sign involved *
****************************************/
verifyval:
parse arg rest
parse var rest rval
select
when pos("+",rval) \= 0 then
rval = 1
when pos("-",rval) \= 0 then
rval = 1
otherwise
rval = 0
end
return rval
/************************************************
* Checks for a positive, negative or a UL or L subscripted *
* hexadecimal value and do the appropriate conversion and *
* output the values. *
*************************************************/
convert_hexval:
parse arg rest
parse var rest name val
neg = ""
val1 = ""
select
when substr(val,1,1) = "+" then
val = delstr(val,1,1)
when substr(val,1,1) = "-" then
do
neg = "-"
val = delstr(val,1,1)
end
otherwise
nop
end /* select */
/****************************************
* Checks for UL followed by hex constant *
****************************************/
if translate(substr(val,1,2)) = "0X" then
do
val = substr(val, 3)
val = strip(val)
lpos = translate(right(val,2))
if lpos = "UL" then
do
len = length(val)
val = delstr(val,len-1,2)
val1 = ' unsigned fixed bin(31) '
end
/****************************************
* Checks for L followed by hex constant *
****************************************/
l1pos = translate(right(val,1))
if l1pos = "L" then
do
len = length(val)
val = delstr(val,len,1)
val1 = 'fixed bin(31)'
end
/****************************************
* Checks for U followed by hex constant *
****************************************/
l1pos = translate(right(val,1))
if l1pos = "U" then
do
len = length(val)
val = delstr(val,len,1)
val1 = 'unsigned fixed bin(31)'
end
/****************************************
* Checks for US followed by hex constant *
****************************************/
l1pos = translate(right(val,2))
if l1pos = "US" then
do
len = length(val)
val = delstr(val,len-1,2)
val1 = ' unsigned fixed bin(15)'
end
/****************************************
* Checks for S followed by hex constant *
****************************************/
l1pos = translate(right(val,1))
if l1pos = "S" then
do
len = length(val)
val = delstr(val,len,1)
val1 = 'signed fixed bin(15)'
end
val = "'"val"'xn"
if neg \= "" then
val = neg||val
neg = ""
end
if val1 = "" then
do
lenval = length(val)
if neg \= "" then val = neg || val
if lenval >= 9 then
val1 = 'fixed bin(31)'
else
val1 = 'fixed bin(15)'
end
/***********************************************
* If the line defines a PSZ wth a hex value, remove the *
* parenthesis and processes for hexadecimal *
* conversion. *
***********************************************/
if flag_PSZ = true then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" pointer value(ptrvalue("val"));"
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'val'";'
call do_writeout(out_line)
out_line = ""
flag_PSZ = false
end
end
else do
if T_opt == ON then
do
out_line1 = z"dcl "name val1" value("val");"
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'val'";'
call do_writeout(out_line)
out_line = ""
end
end
if out_line1 \= "" & out_line1 \= "OUT_LINE1" then
do
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line1 = ""
end
val = done
if val = done then return
/************************************************
* Checks for a positive, negative or a UL or L subscripted *
* value and does the appropriate conversion and *
* output the values. *
*************************************************/
do_value:
parse arg val
parse var val val
operators = "\ ** "
addpos = pos("+",val)
subbpos = pos("-",val)
/*****************************************************
* If the value is directly defined then check to see if it is a char,*
* string, number, pointer etc and use the appropriate declare *
* statement. If the value is a integer data type and has "UL","L" *
* or "US" or "S" then assigns the approriate data type. *
******************************************************/
select
/****************************************
* Checks for UL followed by a constant *
* or user defined type *
***************************************/
when translate(right(val,2)) = "UL" then do
len = length(val)
val = strip(val)
val = delstr(val,(len - 1),2)
if datatype(val) = "NUM" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" unsigned fixed bin(31) value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan ;"
call do_writeout(out_line)
out_line = z'%'name'='val';'
call do_writeout(out_line)
out_line= ""
end
end
else do
val = val||UL
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line1 = z"%dcl @"name" char ext;"
out_line2 = z"%@"name"='@"val"';"
end
end
/****************************************
* Checks for L followed by a constant *
* or user defined type *
***************************************/
when translate(right(val,1)) = "L" then do
len = length(val)
val = delstr(val,len,1)
if datatype(val) = "NUM" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" fixed bin(31) value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'='val';'
call do_writeout(out_line)
out_line= ""
end
end
else do
val = val||L
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line1 = z"%dcl @"name" char ext;"
out_line2 = z"%@"name"='@"val"';"
end
end
/****************************************
* Checks for U followed by a constant *
* or user defined type *
***************************************/
when translate(right(val,1)) = "U" then do
len = length(val)
val = delstr(val,len,1)
if datatype(val) = "NUM" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" unsigned fixed bin(31) value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'='val';'
call do_writeout(out_line)
out_line= ""
end
end
else do
val = val||U
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line1 = z"%dcl @"name" char ext;"
out_line2 = z"%@"name"='@"val"';"
end
end
/****************************************
* Checks for US followed by a constant *
* or user defined type *
***************************************/
when translate(right(val,2)) = "US" then do
len = length(val)
val = delstr(val,(len - 1),2)
if datatype(val) = "NUM" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" unsigned fixed bin(16) value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'='val';'
call do_writeout(out_line)
out_line= ""
end
end
else do
val = val||US
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line1 = z"%dcl @"name" char ext;"
out_line2 = z"%@"name"='@"val"';"
end
end
/****************************************
* Checks for S followed by a constant *
* or user defined type *
***************************************/
when translate(right(val,1)) = "S" then do
len = length(val)
val = delstr(val,len,1)
if datatype(val) = "NUM" then
do
if T_opt == ON then
do
out_line1 = z"dcl "name" signed fixed bin(15) value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'='val';'
call do_writeout(out_line)
out_line= ""
end
end
else do
val = val||S
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line1 = z"%dcl @"name" char ext;"
out_line2 = z"%@"name"='@"val"';"
end
end
/****************************************
* Checks for addittion or subtraction symbols *
***************************************/
when addpos \= 0 | subbpos \= 0 then do
out_line1 = z"%dcl "name" char ext;"
out_line2 = z"%"name" = '"val"';"
addpos = ""
subbpos = ""
end
when wordpos(val,operators) > 0 then do
out_line1 = z"/* This utility does not support this kind of operation */"
out_line2 = z"/* Error:"first" "name" "val"*/"
end
when pos('"',val) \= 0 then do
if T_opt == ON then
do
out_line1 = z"dcl "name" char value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'val'";'
call do_writeout(out_line)
out_line = ""
end
end
when pos("'",val) \= 0 then do
if T_opt == ON then
do
out_line1 = z"dcl "name" char value("val");"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'val'";'
call do_writeout(out_line)
out_line = ""
end
end
when datatype(val) = "NUM" & val <= max_val then do
if T_opt == ON then
do
out_line1 = z"dcl "name" fixed bin(31) value("val");"
out_line2= ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" fixed ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'='val';'
call do_writeout(out_line)
out_line= ""
end
end
when datatype(val) = "NUM" & val > max_val then do
numeric digits 10
val = D2X(val)
val = "'"val"'xn"
if T_opt == ON then
do
out_line1 = z"dcl "name" fixed bin(31) value("val");"
out_line2= ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'val'";'
call do_writeout(out_line)
out_line = ""
end
end
when val = "POINTER" | val = "pointer" then do
if T_opt == ON then
do
out_line1 = z"define alias "name" "val";"
out_line2 = ""
end
if P_opt == ON then
do
out_line = z"%dcl "name" char ext noscan;"
call do_writeout(out_line)
out_line = z'%'name'="'val'";'
call do_writeout(out_line)
out_line = ""
end
end
when val \= "" then do
val = check_name(val)
out_line = z"%dcl "name" char ext;"
call do_writeout(out_line)
out_line = z"%"name"='"val"';"
call do_writeout(out_line)
out_line1 = z"%dcl @"name" char ext;"
out_line2 = z"%@"name"='@"val"';"
end
otherwise
nop /* okay to come here */
val = done
end /* Select */
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
if out_line2 \= "" | out_line2 \= OUT_LINE2 then
do
out_line2 = do_indent(out_line2)
call do_writeout(out_line2)
out_line2 = ""
end
val = done
return val
do_value1:
parse arg num
/*****************************************************
* If the value is directly defined then check to see if it is a char,*
* string, number, pointer etc and use the appropriate declare *
* statement. If the value is a integer data type and has "UL","L" *
* or "US" or "S" then assigns the approriate data type, and returns*
* the value to be output.
******************************************************/
select
/****************************************
* Checks for UL followed by a constant *
* or user defined type *
***************************************/
when translate(right(num,2)) = "UL" then do
len = length(num)
num = strip(num)
num = delstr(num,(len - 1),2)
if datatype(num) = "NUM" then
nop /* will do nothing in some cases */
else
num = num||UL
end
/****************************************
* Checks for L followed by a constant *
* or user defined type *
***************************************/
when translate(right(num,1)) = "L" then do
len = length(num)
num = delstr(num,len,1)
if datatype(num) = "NUM" then
nop /* will do nothing in some cases */
else
num = num||L
end
/****************************************
* Checks for U followed by a constant *
* or user defined type *
***************************************/
when translate(right(num,1)) = "U" then do
len = length(num)
num = delstr(num,len,1)
if datatype(num) = "NUM" then
nop /* will do nothing in some cases */
else
num = num||U
end
/****************************************
* Checks for US followed by a constant *
* or user defined type *
***************************************/
when translate(right(num,2)) = "US" then do
len = length(num)
num = delstr(num,(len - 1),2)
if datatype(num) = "NUM" then
nop /* will do nothing in some cases */
else
num = num||US
end
/****************************************
* Checks for US followed by a constant *
* or user defined type *
***************************************/
when translate(right(num,1)) = "S" then do
len = length(num)
num = delstr(num,len,1)
if datatype(num) = "NUM" then
nop
else
num = num||S
end
otherwise nop /* okay to come here */
end /* do */
return num
/************************************************
* Checks for a positive, negative or a UL or L subscripted *
* hexadecimal value and do the appropriate conversion and *
* does not output the values, but returns the value to the *
* invoked procedure.
*************************************************/
convert_hexval1:
parse arg rest
parse var rest num
neg = ""
val1 = ""
select
when substr(num,1,1) = "+" then
num = delstr(num,1,1)
when substr(num,1,1) = "-" then do
neg = "-"
num = delstr(num,1,1)
end
otherwise
nop /* okay to come here */
end /* select */
if translate(substr(num,1,2)) = "0X" then
do
num = substr(num, 3)
lpos = translate(right(num,2))
if lpos = "UL" then
do
len = length(num)
num = delstr(num,len-1,2)
val1 = ' unsigned fixed bin(31) '
end
l1pos = translate(right(num,1))
if l1pos = "L" then
do
len = length(num)
num = delstr(num,len,1)
val1 = 'fixed bin(31)'
end
l1pos = translate(right(num,1))
if l1pos = "U" then
do
len = length(num)
num = delstr(num,len,1)
val1 = 'unsigned fixed bin(31)'
end
lpos = translate(right(num,2))
if lpos = "US" then
do
len = length(num)
num = delstr(num,len-1,2)
val1 = ' unsigned fixed bin(16) '
end
l1pos = translate(right(num,1))
if l1pos = "S" then
do
len = length(num)
num = delstr(num,len,1)
val1 = 'fixed bin(15)'
end
num = "'"num"'xn"
if neg \= "" then
num = neg||num
neg = ""
end
if val1 = "" then
do
lenval = length(num)
if neg \= "" then num = neg || num
end
return num
/********************************************************************
* Subroutine to process Typedef statement *
********************************************************************/
do_typedef:
parse arg rest
datatypes = "long short char int unsigned long unsigned short unsigned char",
"signed long signed short signed char unsigned signed unsigned int signed int void"
set = "STRUCT ENUM UNION"
set1 = "struct enum union"
cpos=pos('/*', rest)
if cpos\=0 then
do
comment=substr(rest,cpos)
rest=delstr(rest,cpos)
end
rest = space(rest,1)
kind2 = ""
kind3 = ""
/************************************
* If there is a left paren on this line, *
* it is probably a function typedef. These *
* are not currently converted by this utility *
*************************************/
if pos("(", rest) \= 0 then
do
n_lparen = num_left_paren(rest)
/* parse var rest lstr '(' tmp_line ')' rstr */
parse var rest lstr '(' tmp_line ')' rstr
if (n_lparen < 2 | n_lparen > 2 | pos("*",tmp_line) = 0 ) then
do
call unsupport_typedef_function rest
return
end
else do
out_line = z'/*C>typedef '||rest||' <*/'
call do_writeout(out_line)
/******* make up 'rest', pretending it is a regular function prototype *********/
/* ex: typedef Return_type (*Function)(parm1, parm2, parm3); */
/* is going to send to call do_variable_or_function with: */
/* <Return_type Function(parm1, parm2, parm3)> */
/* remove '*' in rest(pos1:pos2) */
do while (pos('*',tmp_line) \=0)
pos_star = pos('*',tmp_line)
tmp_line = overlay(' ',tmp_line,pos_star)
end /* do while (pos('*',tmp_line) \=0) */
rest = lstr || tmp_line || rstr
/******** get ready to call do_variable_or_function **********/
/* preserve the original outputfile */
o_outputfile = outputfile
/* write convertion of this makeup function to ##tmp */
outputfile='##tmp'
rc = stream(outputfile,"C","OPEN WRITE")
call do_variable_or_function(rest)
/******** change the converted code from:
<dcl Function entry (.....) external;> to:
<define alias Function limited entry(....);>
**************************************************/
rc = stream(outputfile,"C",CLOSE)
/* read from ##tmp, write to original outputfile */
n_infile = outputfile
outputfile = o_outputfile /* restore original outputfile */
rc = stream(n_infile,"C","OPEN READ")
tmp_line = linein(n_infile)
parse var tmp_line 'dcl' tmp_name 'entry' tmp_line
tmp_line = z'define alias '||tmp_name||'limited entry '||tmp_line
rc = lineout(outputfile, tmp_line)
do while lines(n_infile)
tmp_line = linein(n_infile)
if (pos('external;', tmp_line) \= 0) then
do
ext = pos('external;', tmp_line)
tmp_line = substr(tmp_line,1, ext-1)||";"
end
rc = lineout(outputfile, tmp_line)
end /* do while lines(n_infile) */
rc = stream(n_infile,"C",CLOSE)
'del 'n_infile
out_line = z"define alias @"name" pointer;"
call do_writeout(out_line)
end /* else do */
return
end
parse var rest kind rest
/****************************************
* Typedefs with arrays not supported. *
***************************************/
if substr(kind,1,1) = "*" | pos("[",rest) \= 0 then
do
out_line = z"%note('Error 9: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* typedefs of this format is not converted by this utility. */"
call do_writeout(out_line)
out_line = z"/* Error: typedef " kind rest"*/"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
/****************************************
* Checks for near or far attributs and pointer *
***************************************/
if translate(kind) \= "STRUCT" & translate(kind) \= "UNION" & ,
translate(kind) \= "ENUM" then
do
linkcon = word(rest,2)
if pos("*",kind) \= 0 | pos("*",rest) \= 0 & wordpos(linkcon,linkages) = 0 then
do
select
when left(rest,4) = "near" | left(rest,3) = "far" then do
parse var rest attribute name val ";"
if right(name,1) = "*" then
name = val
if pos("*",name) \= 0 then
do
do while pos("*",name) \= 0
parse var name "*" name
end
end
name = strip(name)
if substr(name,1,1) = "_" then
name = check_name(name)
end
/****************************************
* Checks for pointer symbol in rest *
***************************************/
when pos("*",rest) \= 0 then do
parse var rest "*" name val ";"
if right(name,1) = "*" then
name=val
if pos("*",name) \= 0 then
do
do while pos("*",name) \= 0
parse var name "*" name
end
end
name = strip(name)
if substr(name,1,1) = "_" then
name = check_name(name)
end
/****************************************
* Checks for pointer symbol in kind *
***************************************/
when pos("*",kind) \= 0 then do
parse var rest name val ";"
if right(kind,1) = "*" then
do
do while pos("*",kind) \= 0
parse var kind kind "*"
end
end
name = strip(name)
if substr(name,1,1) = "_" then
name = check_name(name)
end
otherwise nop /* okay to come here */
end /* Do */
/****************************************
* Convert arrays to PLI syntax *
***************************************/
if pos("][",name) \= 0 then
do
name= convert_bracket(name)
name = convert_finalbracket(name)
end
name = convert_finalbracket(name)
/****************************************
* Convert to define alias if val is a C data type *
***************************************/
if wordpos(kind,datatypes) > 0 & pos("*",line) \= 0 then
do
if pos("*",name) \= 0 then
do
do while pos("*",name) \= 0
parse var name "*" name
end
end
name = check_name(name)
out_line1 = z"define alias "name" pointer;"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line1 = z"define alias @"name" pointer;"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
end
/****************************************
* Convert to user defined type *
***************************************/
else if wordpos(kind, datatypes) = 0 & pos("*",line) \= 0 then
do
kind = strip(kind)
kind = check_name(kind)
out_line1 = z"define alias "name" type @"kind";"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line1 = z"define alias @"name" pointer;"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
end
if cpos \= 0 then
call do_comment(comment)
return
end
end
/**********************************************
* If the kind is UNSIGNED, STATIC, or SIGNED, *
* then the kind consists of 2 words, so read *
* in another word *
**********************************************/
if kind = "unsigned" | kind = "signed" | kind = "static" then
parse var rest kind2 rest
if kind2 = "long" | kind2 = "short" then
do
parse var rest name
if substr(name,1,4) = "int " then
parse var name temp name
end
if kind2 = "int" | kind2 = "char" then do
parse var rest name
end
if kind = "short" | kind = "long" | kind = "int" then
do
parse var rest name
if substr(name,1,4) = "int " then
parse var name temp name
else
parse var name name
end
/*******************************************
* All of the structures are converted *
* to unaligned PL/I structures which *
* are the equivalent of _Packed structures *
*******************************************/
if kind = "_Packed" then
parse var rest kind rest
/********************************************************************
* kind is not any of the above mentioned types then parse rest into name & other *
*********************************************************************/
if kind = "unsigned" | kind = "signed" | kind = "static" kind = "_Packed",
| kind = "long" | kind = "short" | kind = "int" then
nop /* do not do anything in the above cases */
else
parse var rest name other
if name = "*" then do
parse var other name1 other
if name1 = "_Seg16" then do
val = false
if val = false then
do
out_line = z"%note('Error 10: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This utility does not support this declaration */"
call do_writeout(out_line)
out_line = z"/* Error: typedef "kind" "rest"*/"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
end
end
else
/*****************************************
* Far pointers are not supported in PL/I *
*****************************************/
if name = "FAR" | name = "NEAR" then
do
parse var other name1
if name1 \= "" then
name = name1
end /* Do */
/***************************
* Remove ';' from the line *
***************************/
parse var name name ';'
/*******************************************
* Remove the _ prefix from structure names *
*******************************************/
if substr(name,1,1) = "_" then
name = check_name(name)
parse var kind
/************************************************
* If this is a structure or union typedef, call *
* a routine to handle it *
************************************************/
if translate(kind) = "STRUCT" | translate(kind) = "UNION" | translate(kind),
= "ENUM" then
do
last_struct_name = name
/*************************************************
* If there is a semicolon on the line, then it *
* names a structure or defines a pointer to a *
* structure, but it does not actually define the *
* structure type *
*************************************************/
if pos(';', line) \= 0 & pos("}",line) = 0 then
do
parse var other s_name ";" comment
/************************************************
* Check to see if the typedef defines a pointer *
* to a structure *
************************************************/
if pos('*', s_name) \= 0 | right(name,1) = "*" then
call name_a_ptrstructure(name" "s_name)
/****************************************************
* Otherwise call a routine to simply declare a name *
* for a previously defined structure type *
****************************************************/
else do
switchflag = kind||"#"
call name_a_structure(s_name" "name)
switchflag = ""
end
return
end
end
/*******************************************************
* These lines actually declare the first level of the *
* structure or union *
*******************************************************/
if translate(kind) = "STRUCT" then
do
call do_real_struct(name||" "||comment)
if cpos \= 0 then
call do_comment(c.i.j)
c. = ""
tflag = "off"
return
end
/*******************************************************
* These lines actually declare the first level of the *
* structure or union *
*******************************************************/
if translate(kind) = "UNION" then
do
comment1 = comment
call do_union(name)
if cpos \= 0 then
call do_comment(c.i.j)
c. = ""
tflag="off"
return
end
/*******************************************************
* These lines actually declare the first level of the *
* enum *
*******************************************************/
if translate(kind) = "ENUM" then
do
comment1 = comment
call do_enum(rest)
tflag = "off"
if cpos \= 0 then
call do_comment(comment1)
return
end
else do
/*********************************************************
* If this is just a typedef which assigns a new name to *
* an existing type, call the #define routine, as this *
* involves the same conversion as a #define equating the *
* two types *
*********************************************************/
define_string = name" "kind" "kind2
call do_define1(define_string)
end
flag = ""
if cpos \= 0 then
call do_comment(comment)
return
/************************************************************/
/* Error message for unsupported typedef function */
/************************************************************/
unsupport_typedef_function:
parse arg rest
out_line = z"%note('Error 11: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Function typedefs are not converted by this utility. */"
call do_writeout(out_line)
out_line = z"/* Error: typedef "rest" */"
call do_writeout(out_line)
do while pos(")", rest) = 0
rest = linein(inputfile)
line_num = line_num + 1
end
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
/*************************************************************************
num_left_paren: return number of left parenthesis for the given argument
*************************************************************************/
num_left_paren: procedure expose null
parse arg line
nlp = 0
t_line = strip(line)
do while (pos('(',t_line) \= 0)
nlp = nlp + 1
parse var t_line junk '(' t_line
end
return nlp;
/****************************/
/* do_define1 is called by typedef */
/****************************/
/********************************************************************
* Subroutine to process #define statement *
********************************************************************/
do_define1:
parse arg rest
parse var rest name val
datatypes = "long short char int unsigned short long int short int unsigned int",
"unsigned char unsigned long signed short signed int signed long signed char"
/************************************************
* Remove the __ prefix from the definition name *
************************************************/
if substr(name,1,1) = "_"then
name = check_name(name)
/************************************************
* Remove the __ prefix from the definition name *
************************************************/
if wordpos(val,datatypes) = 0 then
do
if translate(name) = val | name = translate(val) then
do
out_line = z"%note('Error 12: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This kind of definition is not supported by this utility. */ "
call do_writeout(out_line)
out_line = z"/* Error: typedef "val" "name" */ "
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
end
parse var val val
val = strip(val)
/********************************
* Check for pointer definition *
* by looking for a * *
********************************/
if name = "*" then
do
parse var val name1 val
name = name||name1
end /* Do */
if substr(name,1,1) = "*" & substr(name,3,3) \= "_" then
do
parse var name "*" name
oldval = val
val = "pointer"
end
/*******************************************
* Check to see if the definition sets a *
* value, or simply declares a variable as *
* defined. If there is no value, set the *
* variable = 'Y' *
*******************************************/
if val = "" then
do
out_line1 = z"%dcl "name" char ext;"
out_line = z"%"name" = 'Y';"
end
else do
/**********************************************
* If there are parentheses in the definition, *
* call a routine to handle them *
**********************************************/
if pos('(', val) \= 0 | pos('(',name) \= 0 then
do
val = do_paren(name,val)
if val = done then return
end
/*******************************************
* If the paren routine could not *
* convert the line, issue an error message *
*******************************************/
if val = false then
do
out_line = z"%note('Error 13: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This utility does not support this declaration */"
call do_writeout(out_line)
out_line = z"/* Error: "rest"*/"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
/********************************
* Convert to PL/I array mapping. *
********************************/
if pos("[",name) \= 0 then
do
if pos("][",name) \= 0 then
do
name= convert_bracket(name)
name = convert_finalbracket(name)
end
else
name = convert_finalbracket(name)
end
/******************************************
* Check to see if the value is a one dim char array *
* then it must be uniquely defined *
* such as a C type which is *
* not specifically defined in PL/I *
*******************************************/
val = special_value(val)
if pos("(",name) \= 0 & pos(",",name) = 0 & (val = "char") then
do
lpos = pos('(',name)
bounds = substr(name,lpos)
name = substr(name,1,(lpos - 1))
val = val||bounds
end
/*********************************************
* If it is simply a definition which defines *
* xxx=XXX then ignore it *
*********************************************/
if val = name then return
/********************************
* Check for a hexadecimal value *
********************************/
if substr(val,1,2) = "0X" | substr(val,1,2) = "0x" then
do
val = substr(val, 3)
val = "''"val"''xn"
lpos = pos("L", val)
if lpos \= 0 then
val = delstr(val,lpos,1)
end /* If */
/*******************************************
* The appropriate declarations for different typedefs *
* depending on whether they were pointer, regular *
* C data type or user defined data type are made. *
********************************************/
if flag = "typedval" then
do
out_line1 = z"define alias "name" type "val";"
out_line2 = z"define alias @"name" type @"val";"
end
else if val = "POINTER" then
do
datatypes = "unsigned long unsigned short unsigned char",
"unsigned int signed long signed short signed char char int short long"
if wordpos(oldval,datatypes) > 0 then
do
out_line1 = z"define alias "name" "val";"
out_line2 = z"define alias @"name" pointer;"
end
else do
out_line1 = z"define alias "name" type @"oldval";"
out_line2 = z"define alias @"name" "val";"
end
end
else do
out_line1 = z"define alias "name" "val";"
out_line2 = z"define alias @"name" pointer;"
end /* Do */
/***********************************
* Output the definition statements *
***********************************/
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line2 = do_indent(out_line2)
call do_writeout(out_line2)
out_line1 = ""
out_line2 = ""
tflag =""
/************************************
* If there was a comment at the end *
* of the line, convert it *
************************************/
return
check_comments:
parse arg stline
cpos = pos("/*",stline)
if cpos \= 0 then
stline = 0
else
stline = 1
return stline
/********************************************************************
* Subroutine to process Structure declarations *
********************************************************************/
do_struct:
go = true
out_line = ""
var_name = ""
old_kind = ""
types = "int long char short"
list = "struct enum union"
c.i.j = ""
scanline = " volatile "
/********************************************************
* I is a counter used as the index into array outline.i *
* which keeps track of the order in which to output the *
* lines in the structure *
********************************************************/
/************************************************
* Read in each line of the structure definition *
* and convert it to PL/I *
************************************************/
do while go = true
line = linein(inputfile)
line_num = line_num + 1
line = strip(line)
if line = "" then
do
do while line = ""
line = linein(inputfile)
line_num = line_num + 1
line = strip(line)
end
end
/************************************************
* Read in each line of the structure after the } brace and *
* concatenate it to a single line. *
************************************************/
if substr(line,1,2) \= "/*" & pos("}",line) \= 0 & pos(";",line) = 0 then
do
line1 = linein(inputfile)
line_num = line_num + 1
line1 = strip(line1)
do while pos(";",line1) = 0
line = line||line1
line1 = linein(inputfile)
line_num = line_num + 1
line1=strip(line1)
end
line = line||line1
end
/*******************
* skip blank lines *
*******************/
do while line = ""
line = linein(inputfile)
line_num = line_num + 1
end
orig = line
/*********************************/
/* Issue message for bit fields. */
/*********************************/
if pos(":",orig) \= 0 then
do
cpos = pos("/*",line)
if cpos \= 0 then
do
c.i.j = substr(line,cpos)
line = delstr(line,cpos)
end
end
do while pos(":",line) \= 0
line = orig
array.i.j = ""
c.i.j = z"%note('Error 14: Unsupported syntax encountered',4);"
j = j + 1
c.i.j = z"/* This utility does not support Bit fields. */"
array.i.j = ""
j = j + 1
if pos("*/",line) = 0 then
c.i.j = z"/* Error: "line"*/"
else
c.i.j = z"/* Error: "line
array.i.j = ""
j = j + 1
c.i.j = z"/* The original line in the .h file is: "line_num" */"
array.i.j = ""
j = j + 1
line = linein(inputfile)
line_num = line_num + 1
line = strip(line)
orig = line
if line = "" then
do
array.i.j = ""
c.i.j = ""
j = j +1
line = linein(inputfile)
line_num = line_num + 1
line = strip(line)
orig = line
end
if substr(line,1,2) = "/*" & pos(":",line) \= 0 then
do
do while pos("*/",line) = 0
line1 = linein(inputfile)
line_num = line_num + 1
line1 = space(line1,1)
line = line||line1
c.i.j = line
end
c.i.j = line
array.i.j = ""
j = j + 1
line = linein(inputfile)
orig = line
line_num = line_num + 1
if line = "" then
do
array.i.j = ""
c.i.j = ""
j = j +1
line = linein(inputfile)
line_num = line_num + 1
end
end /* do */
end
if pos(":",line) = 0 & pos(":",c.i.j) \= 0 then
line = orig
line = strip(line)
cpos = pos("/*",line)
/************************************************
* Read in lines and check to see if it is a comment block *
* then read in till next statement to be processed is *
* encountered. *
*************************************************/
if cpos \= 0 then
do
c.i.j = substr(line,cpos)
c.i.j = space(c.i.j,1)
line = delstr(line,cpos)
line = strip(line)
if line \= "" & pos("*/",orig) = 0 then
do
len = pos("*/",line)
do while len = 0
line1 = linein(inputfile)
line_num = line_num + 1
c.i.j = c.i.j ||line1
len = pos("*/",c.i.j)
end
c.i.j = space(c.i.j,1)
end
if line = "" then
do
array.i.j = ""
len = pos("*/",c.i.j)
if len = 0 then
inloop = true
else
inloop = false
/****************************************
* process until ending comment is encountered *
****************************************/
do while len = 0
j = j + 1
line1 = linein(inputfile)
line_num = line_num + 1
len = pos("*/",line1)
c.i.j = line1
array.i.j =""
end
end
end
else if substr(line,1,1) = "*" then
do
c.i.j = line
line = ""
end /* Do */
else if substr(line,1,1) \= "*" & cpos = 0 & right(line,1) \= ";" & line \= "" & left(line,1) \= "#",
& pos("{",line) = 0 & translate(left(line,6)) \= "STRUCT" & translate(left(line,5)) \= "UNION" then
do
c.i.j = line
c.i.j = space(c.i.j,1)
line = ""
end
else
c.i.j = ""
/***************************
* volatile changed to abnormal *
***************************/
if wordpos(scanline,line) > 0 then
do
vpos=pos("volatile",line)
line = overlay("abnormal",line,vpos)
end
line = space(line,1)
org_line = line
/*******************************
* checks for far and near attributes. *
*******************************/
line = check_ptrtype(line)
parse var line kind line
if right(kind,1) = ";" then
line = ";"
if left(kind,1) = "}" & left(kind,2) \= "} " & left(kind,2) \= "};" then
do
kind = kind||line
line = ";"
end /* Do */
if translate(kind) = "CONST" then
parse var line kind line
/*****************************************
* If kind is unsigned, signed, or static *
* another word must be read for the kind *
*****************************************/
if kind = "unsigned" | kind = "signed" | kind = "static" then
parse var line kind2 line
if right(kind2,1) = ":" then
do
len = pos(":",kind2)
kind2 = delstr(kind2,len,1)
line = ":"||line
end
if pos("far",line) \= 0 | pos("near",line) \= 0 then
do
parse var line "*" line
line=strip(line)
line = "*"||line
end /* Do */
parse var line name
/****************************************
* Remove the ; and white space from the *
* variable name, remove leading underscores. *
****************************************/
parse var name name ";" other
name = strip(name)
if substr(name,1,1) = "_" then
name = check_name(name)
/**********************************
* Change [] to () for PL/I arrays *
**********************************/
if pos(",",name) = 0 then
do
if pos("][",name) \= 0 then
do
name= convert_bracket(name)
name = convert_finalbracket(name)
end
name = convert_finalbracket(name)
end
kind = strip(kind)
if wordpos(kind,list) = 0 & substr(kind,1,1) \= "}" & pos("*",org_line) \= 0 then
do
select
when kind \= "}" & kind = "/*" | kind = "*" | kind = "*/" then do
if substr(name,1,1) = "_" then
name = check_name(name)
array.i.j = kind" "name
j = j + 1
end /* Do */
/**********************************
* Check for pointers. *
**********************************/
when kind \= "}" & substr(name,1,1) = "*" then do
do while pos("*",name) \= 0
parse var name "*" name
end
len = pos("abnormal",name)
/**********************************
* Check for abnormal attribute. *
**********************************/
if len > 0 then
do
parse var name "abnormal" name
name = name||" abnormal"
end
name = strip(name)
if substr(name,1,1) = "_" then
name = check_name(name)
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" pointer"
j = j + 1
end
/**********************************
* Output pointer definition *
**********************************/
when kind \= "}" & right(kind,1) = "*" & left(kind,1) \= "/" then do
if substr(name,1,1) = "_" then
name = check_name(name)
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" pointer"
j = j + 1
end
/**********************************
* Output pointer definition *
**********************************/
when kind \= "}" & right(kind2,1) = "*" & left(kind2,1) \= "/" then do
if substr(name,1,1) = "_" then
name = check_name(name)
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" pointer"
j = j + 1
end
/**********************************
* Output pointer definition *
**********************************/
when substr(kind,1,1) \= "}" & wordpos(kind,list) = 0 & pos("*",name) \= 0 then do
parse var name "*" name
if substr(name,1,1) = "_" then
name = check_name(name)
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" pointer"
j = j + 1
end
otherwise
nop /* Error in processing */
end /* select */
end /* if then do */
else
select
/***********************************************
* Handle the beginning brace for the structure *
***********************************************/
when kind = "{" then do
nop
end
/*********************************************
* Handle the ending brace for the structures *
*********************************************/
when kind = "};" then do
go = false
end
/***********************************************************************
* Handle the ending ; for the structures if the brace and ; occured on different lines *
***********************************************************************/
when kind = ";" then do
go = false
if old_kind = "}" then old_kind = ""
end
/*********************************************
* Handle preprocessor #ifdef inside a struct union *
*********************************************/
when kind = "#ifdef" then
do
array.i.j = do_functifdef(kind||" "||name)
j = j + 1
end
/*********************************************
* Handle preprocessor #ifndef inside a struct union *
*********************************************/
when kind = "#ifndef" then
do
array.i.j = do_functifndef(kind||" "||name)
j = j + 1
end
/*********************************************
* Handle preprocessor #else inside a struct union *
*********************************************/
when kind = "#else" then
do
array.i.j = do_felse(kind)
j = j + 1
end
/*********************************************
* Handle preprocessor #endif inside a struct union *
*********************************************/
when kind = "#endif" then
do
array.i.j = "%end;"
j = j + 1
end
/*********************************************
* Handle preprocessor #if inside a struct union *
*********************************************/
when kind = "#if" then
do
array.i.j = do_functif(kind||" "||name)
j = j + 1
end
/***********************************************
* Handle a single comment line if it exists. *
***********************************************/
when kind = "" & c.i.j \= "" then do
array.i.j= ""
j = j + 1
end
/***********************************************
* Output if kind is already processed. *
***********************************************/
when kind = "/*" | kind = "*" | kind = "*/" | substr(kind,1,2) = "/*" then do
array.i.j = kind" "name
j = j + 1
end /* Do */
/********************************************************************
* Handle the ending brace for the structures and if there is a variable declaration *
* list following the ending brace store it in a variable called var_name to process *
* the list. If there are nested structures all the levels of the structure variable *
* list except level 1 is processed here. level 1 variable list processing is done in *
* do_struct. *
********************************************************************/
when kind = "}" & pos(";",line) = 0 then
old_kind = "}"
when old_kind = "}" then do
select
when right(kind,1) = ";" then
var_name = kind
when right(kind,1) = "," then do
kind = kind||line
var_name = kind
end /* Do */
otherwise
nop
end /* select */
/**************************************************
* If level of structure is first then output information and *
* go back to do_real_struct for processing variables. *
**************************************************/
if i = 1 then
do
go = false
old_kind = ""
end
/**************************************************
* If level of structure is nested then process the varible list *
* if one exists else go back to process next input line. *
***************************************************/
else if i > 1 then
var_name = kind
if var_name \= "" then
parse var array.i.2 num1 ss_name u_name","
if var_name \= "" & i > 1 then
do
l = i - 1
m = index.l
done = false
do while done=false
if var_name \= "" then do
/***********************************************
* Processing for multiple variables declared. *
***********************************************/
select
when pos(",",var_name) \= 0 then do
parse var var_name var1 "," var_name
var1 = strip(var1)
if pos("][",var1) \= 0 then
do
var1= convert_bracket(var1)
var1 = convert_finalbracket(var1)
end
else if pos("[",var1) \= 0 then
var1 = convert_finalbracket(var1)
end
/***********************************************
* Processing for single variable declared. *
***********************************************/
when pos(",",var_name) = 0 then do
parse var var_name var1 ";"
var1 = strip(var1)
if pos("][",var1) \= 0 then
do
var1= convert_bracket(var1)
var1 = convert_finalbracket(var1)
end
else if pos("[",var1) \= 0 then
var1 = convert_finalbracket(var1)
var_name = ""
done = true
end
otherwise
nop /* okay to come here */
end
/***********************************************
* Processing for pointer to a struct. *
***********************************************/
if substr(var1,1,1) = "*" | substr(var1,1,2) = "**" then
do
var1 = space(var1,0)
do while pos("*",var1) \= 0
parse var var1 "*" var1
end
if substr(var1,1,1) = "_" then
var1 = check_name(var1)
if substr(ss_name,1,1) = "_" then
ss_name = check_name(ss_name)
array.l.m = z"2 "var1" handle" ss_name
c.l.m = ""
index.l = index.l + 1
m = index.l
end
/***********************************************
* Processing for regular variable of type struct *
***********************************************/
else
if substr(var1,1,1) \= "*" then
do
if substr(var1,1,1) = "_" then
var1 = check_name(var1)
if substr(ss_name,1,1) = "_" then
ss_name = check_name(ss_name)
array.l.m = z"2 "var1" type" ss_name
c.l.m = ""
index.l = index.l + 1
m = index.l
end
else if var1 = "" then
done = true;
end
end
end
go = false
old_kind = ""
end
/********************************************************
* Processing as above but kind and variable list occur on same line *
********************************************************/
when kind = "}" | substr(kind,1,1) = "}" & pos(";",line) \= 0 then do
len = length(kind)
if len > 1 & pos("}",kind) \= 0 then
do
parse var kind "}" name1
parse var line line";"
name = name1" "line
end
/***********************************************
* Processing for multiple variables declared. *
***********************************************/
if name \= "" then
var_name = name||";"
parse var array.i.2 num1 ss_name u_name","
if var_name \= "" & i > 1 then
do
l = i - 1
m = index.l
done = false
do while done=false
if var_name \= "" then
do
/***********************************************
* Processing for multiple variables declared. *
***********************************************/
select
when pos(",",var_name) \= 0 then do
parse var var_name var1 "," var_name
var1 = strip(var1)
if pos("][",var1) \= 0 then
do
var1= convert_bracket(var1)
var1 = convert_finalbracket(var1)
end
else if pos("[",var1) \= 0 then
var1 = convert_finalbracket(var1)
end
/***********************************************
* Processing for single variables declared. *
***********************************************/
when pos(",",var_name) = 0 then do
parse var var_name var1 ";"
var1 = strip(var1)
if pos("][",var1) \= 0 then
do
var1= convert_bracket(var1)
var1 = convert_finalbracket(var1)
end
else if pos("[",var1) \= 0 then
var1 = convert_finalbracket(var1)
var_name = ""
done = true
end
otherwise
nop /* okay to come here */
end
/***********************************************
* Processing for pointer to a struct. *
***********************************************/
if substr(var1,1,1) = "*" | substr(var1,1,2) = "**" then
do
var1 = space(var1,0)
do while pos("*",var1) \= 0
parse var var1 "*" var1
end
if substr(var1,1,1) = "_" then
var1 = check_name(var1)
if substr(ss_name,1,1) = "_" then
ss_name = check_name(ss_name)
array.l.m = z"2 "var1" handle" ss_name
c.l.m = " "
index.l = index.l + 1 /* incr j value of level l */
m = index.l
end
else
/***********************************************
* Processing for regular variable of type struct *
***********************************************/
if substr(var1,1,1) \= "*" then
do
if substr(var1,1,1) = "_" then
var1 = check_name(var1)
if substr(ss_name,1,1) = "_" then
ss_name = check_name(ss_name)
array.l.m = z"2 "var1" type" ss_name
c.l.m =" "
index.l = index.l + 1 /* incr j value of level l */
m = index.l
end
else if var1 = "" then
done = true;
end
end /* Do */
end
go = false
end
/******************************************************
* Handle INT or LONG definitions within the structure *
******************************************************/
when kind = "int" & pos(":",name) = 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" fixed bin(31)"
j = j + 1
end
/******************************************
* Handle int array definitions within the structure *
******************************************/
when kind = "int" & pos(":",name) \= 0 & pos("(",name) \= 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" fixed bin(31)"
j = j + 1
end
/******************************************
* Handle int array definitions within the structure *
******************************************/
when kind = "long" & pos(":",name) = 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" fixed bin(31)"
j = j + 1
end
/******************************************
* Handle int array definitions within the structure *
******************************************/
when kind = "long" & pos(":",name) \= 0 & pos("(",name) \= 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" fixed bin(31)"
j = j + 1
end
/******************************************
* Handle int bit definitions within the structure *
******************************************/
when kind = "int" & pos(":",name) \= 0 & pos("(",name) = 0 then do
parse var name name ":" bit_length ";"
name = strip(name)
bit_length = strip(bit_length)
array.i.j = z"2 "name" bit("bit_length")"
j = j + 1
end /* Do */
/******************************************
* Handle char bit definitions within the structure *
******************************************/
when kind = "char" & pos(":",name) \= 0 & pos("(",name) = 0 then do
parse var name name ":" bit_length ";"
bit_length = strip(bit_length)
array.i.j = z"2 "name" bit("bit_length")"
j = j + 1
end /* Do */
/********************************************************
* Handle CHAR variables or array definitions within the structure. *
********************************************************/
when kind = "char" then do
if pos("(",name) = 0 | pos(",",name) \= 0 then
do
if pos("(",name) = 0 then
do
array.i.j = z"2 "name" char"
j = j + 1
end
else if pos(",",name) \= 0 then
do
parse var name name "(" nam1
name = name||" dim("||nam1
array.i.j = z"2 "name" char"
j = j + 1
end
end
/**********************************************************
* Special processing for one dimensional character array. *
**********************************************************/
else do
if pos("(",name) \= 0 & pos(",",name) = 0 then
do
lpos = pos('(',name)
bounds = substr(name,lpos)
name = substr(name,1,(lpos - 1))
bounds = check_char(bounds)
array.i.j = z"2 "name" char"bounds" varyingz"
j = j + 1
end
end
end
/********************************************************
* Handle PSZ variable definitions within the structure. *
********************************************************/
when kind = "PSZ" then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" type PSZ"
j = j + 1
end
/*****************************************
* Handle SHORT definitions within the structure *
*****************************************/
when kind = "short" then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" fixed bin(15)"
j = j + 1
end
/*********************************************************************
* Handle a STRUCT definition as a field (no pointer)in the structure declarations. *
*********************************************************************/
when translate(kind) = "STRUCT" & pos(" ",name) \= 0 & pos("*",name) =,
0 then do
parse var name name strt_name
strt_name=space(strt_name,0)
if substr(strt_name,1,1) = "_" then
strt_name = check_name(strt_name)
if substr(name,1,1) = "_" then
name = check_name(name)
if pos("(",strt_name) \= 0 then
strt_name = do_ptrname(strt_name)
array.i.j = z"2 "strt_name" type "name
j = j + 1
end
/**********************************************************
* Handle a STRUCT definition as a field in the structure declarations. *
**********************************************************/
when translate(kind) = "STRUCT" & pos("*",name) \= 0 then do
parse var name name strt_name
if strt_name = "" then
parse var name name "*" strt_name
strt_name=space(strt_name,0)
if pos("*",name) \= 0 then
do
do while pos("*",name) \= 0
parse var name name "*"
end
end
/**********************************************************
* Handle abnormal attribute and remove pointer symbol *
**********************************************************/
do while pos("*",strt_name) \= 0
parse var strt_name "*" strt_name
end
if pos("abnormal",strt_name) \= 0 then
do
parse var strt_name "abnormal" strt_name
strt_name = strt_name||" abnormal"
end
if substr(strt_name,1,1) = "_" then
strt_name = check_name(strt_name)
if pos("(",strt_name) \= 0 then
strt_name = do_ptrname(strt_name)
array.i.j = z"2 "strt_name" handle "name
j = j + 1
end
/**********************************************************
* Handle a UNION definition as a field in the structure declarations. *
**********************************************************/
when translate(kind) = "UNION" & pos(" ",name) \= 0 & pos("*",name) = 0 then do
parse var name name strt_name
if substr(strt_name,1,1) = "_" then
strt_name = check_name(strt_name)
if substr(name,1,1) = "_" then
name = check_name(name)
if pos("(",strt_name) \= 0 then
strt_name = do_ptrname(strt_name)
array.i.j = z"2 "strt_name" type "name
j = j + 1
end
/********************************************************************
* Handle a UNION definition as a field in the structure declarations.(with pointers) *
********************************************************************/
when translate(kind) = "UNION" & pos("*",name) \= 0 then do
parse var name name strt_name
if strt_name = "" then
parse var name name "*" strt_name
strt_name=space(strt_name,0)
/**********************************************
* Handle pointer on either syntax. name or strt_name *
**********************************************/
if pos("*",name) \= 0 then do
do while pos("*",name) \= 0
parse var name name "*"
end
end
do while pos("*",strt_name) \= 0
parse var strt_name "*" strt_name
end
/******************************************
* Remove leading underscores from name. *
******************************************/
if substr(strt_name,1,1) = "_" then
strt_name = check_name(strt_name)
if substr(name,1,1) = "_" then
name = check_name(name)
if pos("(",strt_name) \= 0 then
strt_name = do_ptrname(strt_name)
array.i.j = z"2 "strt_name" handle "name
j = j + 1
end
/**********************************************************************
* Handle a ENUM definition as a field in the structure declarations.(with pointers) *
**********************************************************************/
when translate(kind) = "ENUM" & pos("*",name) \= 0 then do
parse var name name strt_name
if strt_name = "" then
parse var name name "*" strt_name
if struct_name = "" then
parse var name name "*" strt_name
strt_name=space(strt_name,0)
if pos("*",name) \= 0 then
do
do while pos("*",name) \= 0
parse var name name "*"
end
end
do while pos("*",strt_name) \= 0
parse var strt_name "*" strt_name
end
if substr(strt_name,1,1) = "_" then
strt_name = check_name(strt_name)
if substr(name,1,1) = "_" then
name = check_name(name)
if pos("(",strt_name) \= 0 then
strt_name = do_ptrname(strt_name)
array.i.j = z"2 "strt_name" handle "name
j = j + 1
end
/**********************************************************
* Handle a UNION definition as a field in the structure declarations. *
**********************************************************/
when translate(kind) = "ENUM" & pos(" ",name) \= 0 & pos("*",name) =,
0 & pos("{",name) = 0 then do
parse var name name strt_name
strt_name=space(strt_name,0)
if substr(strt_name,1,1) = "_" then
strt_name = check_name(strt_name)
if substr(name,1,1) = "_" then
name = check_name(name)
if pos("(",strt_name) \= 0 then
strt_name = do_ptrname(strt_name)
array.i.j = z"2 "strt_name" ordinal "name
j = j + 1
end
/***********************************************************
* Issue error message for enum definition nested inside struct or union.*
***********************************************************/
when translate(kind) = "ENUM" & pos("{",name) \= 0 then do
select
when pos("}",org_line) \= 0 & pos(";",org_line) \= 0 then do
c.i.j = "/* "kind" "name" : not supported by this utility */"||c.i.j
array.i.j = ""
j = j + 1
end /* Do */
when pos("{",org_line) \= 0 & pos(";",org_line) = 0 then do
c.i.j = "/* "kind" "name" :not supported by this utility */"||c.i.j
array.i.j = ""
j = j + 1
/************************************************************
* Read until entire definition is complete and put it in a comment block.*
************************************************************/
do while pos(";",line) = 0
line = linein(inputfile)
line_num = line_num + 1
line=strip(line)
cpos = pos("/*",line)
if cpos \= 0 then
do
c.i.j = substr(line,cpos)
line = delstr(line,cpos)
end
else c.i.j = ""
if line \= "" then
c.i.j = "/* "line" not supported by this utility */"||c.i.j
else
c.i.j = c.i.j
array.i.j= ""
j = j + 1
end
end
otherwise nop /* okay to come here */
end
end /* Do */
/**********************************************
* If kind is unsigned, kind2 is tested for the appropriate *
* declaration. *
***********************************************/
when kind = "unsigned" then do
select
when wordpos(kind2,types) = 0 & pos(":",org_line) = 0 then do
parse var kind2 kind2 ";"
name = kind2
if substr(name,1,1) = "_" then
name = check_name(name)
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" unsigned fixed bin(31) "
j = j + 1
end /* Do */
/*****************************************************
* Handle LONG or INT definitions labeled as unsigned *
*****************************************************/
when kind2 = "long" & pos(":",name) = 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" unsigned fixed bin(31) "
j = j + 1
end
when kind2 = "long" & pos(":",name) \= 0 & pos("(",name) \= 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" unsigned fixed bin(31)"
j = j + 1
end
when kind2 = "int" & pos(":",name) = 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" unsigned fixed bin(31) "
j = j + 1
end
when kind2 = "int" & pos(":",name) \= 0 & pos("(",name) \= 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" unsigned fixed bin(31)"
j = j + 1
end
/***********************************************
* Handle SHORT definitions labeled as unsigned *
***********************************************/
when kind2 = "short" & pos(":",name) = 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" unsigned fixed bin(16) "
j = j + 1
end
when kind2 = "short" & pos(":",name) \= 0 & pos("(",name) \= 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" unsigned fixed bin(31)"
j = j + 1
end
/**********************************************
* Handle CHAR definitions labeled as unsigned *
**********************************************/
when kind2 = "char" then do
if pos("(",name) = 0 | pos(",",name) \= 0 then
do
if pos("(",name) = 0 then
do
array.i.j = z"2 "name" char"
j = j + 1
end
else if pos(",",name) \= 0 then
do
parse var name name "(" nam1
name = name||" dim("||nam1
array.i.j = z"2 "name" char"
j = j + 1
end
end
else do
if pos("(",name) \= 0 & pos(",",name) = 0 then
do
lpos = pos('(',name)
bounds = substr(name,lpos)
name = substr(name,1,(lpos - 1))
bounds = check_char(bounds)
array.i.j = z"2 "name" char"bounds" varyingz"
j = j + 1
end
end
end
/***********************************
* Handle a unsigned char bit definition *
***********************************/
when kind2 = "char" | kind2 = "int" & pos("(",name) = 0 & pos(":",name) \= 0 then do
parse var name name ":" bit_length ";"
parse var line ":" bit_length ";"
name = strip(name)
bit_length = strip(bit_length)
array.i.j = z"2 "name" bit("bit_length")"
j = j + 1
end /* Do */
when pos(":",kind2) \= 0 & kind2 \= ":" & substr(kind2,1,1) \= ":" then do
parse var kind2 name ":" bit_length ";"
name = strip(name)
bit_length = strip(bit_length)
array.i.j = z"2 "name" bit("bit_length")"
j = j + 1
end /* Do */
/*********************
* Handle a bit field *
*********************/
otherwise do
if kind2 = ":" | substr(kind2,1,1) = ":" then
do
line = kind2" "name
kind2 = ""
end
parse var line ":" bit_length ";"
bit_length = strip(bit_length)
array.i.j = z"2 "kind2" bit("bit_length")"
j = j + 1
end
end
end
/**********************************************
* If kind is signed, kind2 is tested for the appropriate *
* declaration. *
***********************************************/
when kind = "signed" then do
select
/*****************************************************
* Handle LONG or INT definitions labeled as signed *
*****************************************************/
when wordpos(kind2,types) = 0 & pos(":",org_line) = 0 then do
parse var kind2 kind2 ";"
name = kind2
if substr(name,1,1) = "_" then
name = check_name(name)
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" signed fixed bin(31) "
j = j + 1
end /* Do */
when kind2 = "long" | kind2 = "int" & pos(":",name) = 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" signed fixed bin(31) "
j = j + 1
end
when kind2 = "long" | kind2 = "int" & pos(":",name) \= 0 & pos("(",name) \= 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" signed fixed bin(31)"
j = j + 1
end
when kind2 = "short" & pos(":",name) \= 0 & pos("(",name) \= 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" signed fixed bin(15)"
j = j + 1
end
/***********************************************
* Handle SHORT definitions labeled as signed *
***********************************************/
when kind2 = "short" & pos(":",name) = 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" signed fixed bin(15) "
j = j + 1
end
/**********************************************
* Handle CHAR definitions labeled as signed *
**********************************************/
when kind2 = "char" & pos(":",name) = 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" signed fixed bin(7) "
j = j + 1
end
when kind2 = "char" & pos(":",name) \= 0 & pos("(",name) \= 0 then do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" signed fixed bin(7)"
j = j + 1
end
when kind2 = "char" | kind2 = "int" & pos(":",name) \= 0 & pos("(",name) = 0 then do
parse var name name ":" bit_length ";"
parse var line ":" bit_length ";"
name = strip(name)
bit_length = strip(bit_length)
array.i.j = z"2 "name" bit("bit_length")"
j = j + 1
end /* Do */
when pos(":",kind2) \= 0 & kind2 \= ":" & substr(kind2,1,1) \= ":" then do
parse var kind2 name ":" bit_length ";"
name = strip(name)
bit_length = strip(bit_length)
array.i.j = z"2 "name" bit("bit_length")"
j = j + 1
end /* Do */
/*********************
* Handle a bit field *
*********************/
otherwise do
if kind2 = ":" | substr(kind2,1,1) = ":" then
do
line = kind2" "name
kind2 = ""
end
parse var line ":" bit_length ";"
bit_length = strip(bit_length)
array.i.j = z"2 "kind2" bit("bit_length")"
j = j + 1
end
end
end
/***************************************************************
* If there are nested structures or unions within a structure then the routine *
* do_struct or do_union is called to process the declaration. The values to be *
* output are stored in a two dimensional array. The variable 'i' refers to the *
* ith level of the structure and the variable j refers to the jth declarations in *
* the ith level of the structure. *
****************************************************************/
when translate(kind) = "STRUCT" | translate(kind) = "UNION" then do
index.i = j /* save old j values in index.i */
/* val of index.i where old j values are stored: index.i */
i = i + 1 /* i is 2 */
j = 1 /* reset j to 1 to start from begining */
recursive = true
rest = name
/**********************************************************
* Give nested struct without tag the name of the outer level || with #*
**********************************************************/
if translate(kind) = "STRUCT" then
do
rest = strip(rest)
if rest = "" | rest = "{" then
do
rest1 = s_name||"#"
rest = rest1
count = 1
end
else if right(rest1,1) = "#" then
do
rest1 = rest1||"#"
rest = rest1
end
/****************************************
* Call do_real_struct to process initial definition.*
****************************************/
call do_real_struct(rest)
i = i - 1 /* to get ist level */
/* inside after call to do-realstruct i decre is: i */
j = index.i /* get old val of j stored in level 1 */
/* old level j valus of earlier level is retrived: j */
end
/**********************************************************
* Give nested union without tag the name of the outer level || with #*
**********************************************************/
else do
rest = strip(rest)
if rest = "" | rest = "{"then
do
rest1 = s_name||"#"
rest = rest1
count = 1
end
else if right(rest1,1) = "#" then
do
rest1 = rest1||"#"
rest = rest1
end
/************************************
* Call do_union to process initial definition.*
************************************/
call do_union(rest)
i = i - 1 /* to get ist level */
j = index.i /* get old val of j stored in level 1 */
end
go = true
end /* when */
otherwise
/*****************************************************
* Handle user defined types. *
*****************************************************/
if line \= "" & pos(":",org_line) = 0 & kind \= "unsigned" & kind \= "signed" & kind \="static",
& kind \= "{" & kind \= "}" & kind \= "int" & kind \= "long",
& kind \= "char" & kind \= "PSZ" ,
& kind \= "short" ,
& kind \= "struct" & kind \= "union" & kind \= "enum" then
do
if pos("(",name) \= 0 then
name = do_ptrname(name)
array.i.j = z"2 "name" type "kind
j = j + 1
end
/****************************************
* Process userdefined bit fields. *
****************************************/
else do
parse var org_line type name":" bit_length ";"
bit_length = strip(bit_length)
name = strip(name)
bit_length=strip(bit_length)
array.i.j = z"2 "name" bit("bit_length")"
j = j + 1
end /* Do */
end /* select */
end /* do while outer loop*/
/****************************
* Output the PL/I Structure *
****************************/
do k = 1 to j - 1
if array.i.k \= "" & left(array.i.k,1) \= "%" then
do
m = k
end
end
do k = 1 to j - 1
if k = j - 1 & array.i.k \= "" & c.i.k = "" then
do
if pos(";",array.i.k) = 0 then
array.i.k = array.i.k||";"
else
array.i.k = array.i.k
array.i.k = do_indent(array.i.k)
array.i.k = indentation||array.i.k
end
else if k = j - 1 & array.i.k = "" & c.i.k \= "" then
do
array.i.k = array.i.k||c.i.k
array.i.k = do_indent(array.i.k)
array.i.k = indentation||array.i.k
end /* Do */
else if k = j - 1 & array.i.k \= "" & c.i.k \= "" then
do
array.i.k = array.i.k";"||c.i.k
array.i.k = do_indent(array.i.k)
array.i.k = indentation||array.i.k
end /* Do */
else if (k = 1 | k = 2) then
array.i.k = array.i.k
else do
if k = m then
do
array.i.k = array.i.k||";"||c.i.k
array.i.k = do_indent(array.i.k)
array.i.k = indentation||array.i.k
end /* Do */
else if array.i.k \= "" then
do
if left(array.i.k,1) \= "%" then
array.i.k = array.i.k||","||c.i.k
else
array.i.k = array.i.k
array.i.k = do_indent(array.i.k)
array.i.k = indentation||array.i.k
end
else if array.i.k = "" & c.i.k \= "" then
do
array.i.k = c.i.k
array.i.k = do_indent(array.i.k)
array.i.k = indentation||array.i.k
end
end
call do_writeout(array.i.k)
end
outline = ""
call do_writeout(outline)
rest1 = ""
return
/****************************
* add dim attribute to array. *
****************************/
do_ptrname:
parse arg ptname
if pos("(",ptname) \= 0 then
do
parse var ptname ptname "(" tmp
ptname = ptname||" dim("||tmp
end
return ptname
end /* do */
/***********************************************
* Handle C declaration of arrays ex: array1[2|[4|[6| *
***********************************************/
convert_bracket:
parse arg name
parse var name nm "[" name
name = "["||name
done = false
do while done = false
if pos("][",name) \= 0 then
do
lrbracket = pos("][", name)
name = overlay(", ", name, lrbracket)
space = pos(" ",name)
if space \= 0 then
name =delstr(name,space,1)
if pos("][",name) \= 0 then
done = false
end
else
done = true
end
done = false
do while done = false
comma = pos(",,",name)
/****************************************
* Handle single dimension || 0: *
****************************************/
if comma \= 0 then
do
len = length(name)
name = substr(name,1,comma)||"0:*"||substr(name,comma+1,len)
end
else
done = true
end
/****************************************
* Handle ending case in multi dimensional array *
****************************************/
comma = pos(",]",name)
if comma \= 0 then
do
len = length(name)
name = substr(name,1,comma)||"0:*"||substr(name,comma+1,len)
end
name = space(name,0)
comma = pos("[,",name)
if comma \= 0 then
do
len = length(name)
name = substr(name,1,comma)||"0:*"||substr(name,comma+1,len)
end
name = space(name,0)
if nm \= "" | nm \= "NM" then
name = nm||name
/***********************************************
* Add -1 to exisiting dimension to be compatible with C *
***********************************************/
if pos("[", name) \= 0 then
do
name = change_dimension(name)
end
return name
/***********************************************
* Handle the final array declaration ex: array1[2,4,6| *
************************************************/
convert_finalbracket:
parse arg name1
if pos("[",name1) \= 0 then
do
parse var name1 name1 "[" name
name = "["||name
lbracket = pos("[", name)
if lbracket \= 0 then
do
rbracket = pos("]", name)
name = overlay("(", name, lbracket)
name = overlay(")", name, rbracket)
end
/****************************************
* Handle single dimension || 0: *
****************************************/
if substr(name,1,1) = "(" & substr(name,2,1) = ")" then
do
name = "(0:*)"
end
if pos(",",name) = 0 & pos("*",name) = 0 & pos("(",name) \= 0 then
do
parse var name "(" name ")"
name = "(0:"||name||"-1)"
end
if name1 \= "" & name1 \= "NAME1" then
name = name1||name
end
else nop /* okay to come here */
return name
/********************************************
* Add -1 to all array dimensions to map to C arrays *
********************************************/
change_dimension:
parse arg name
if pos("[",name) \= 0 then
do
done = false
parse var name temp "[" name
if temp \= "" | temp \= "TEMP" then
temp = temp||"["
else
temp = "["
name1=""
len = pos("]",name)
name = overlay(",",name,len)
/****************************************
* Do loop to process all dimensions. *
****************************************/
do while pos(",",name) \= 0
parse var name chain "," name "]"
if substr(chain,1,1) = "_" then
chain = check_name(chain)
if pos("*",chain) = 0 & chain \= "" then
name1 = name1||"0:"||chain"-1,"
else if pos("*",chain) \= 0 then
name1 = name1||chain","
else if pos(",",name) = 0 then
do
name = ""
done = true
end
end /* do */
len = lastpos(",",name1)
name = overlay("]",name1,len)
name = temp||name
end
return name
/********************************************************************
* Subroutine to define a structure of a given type *
********************************************************************/
name_a_structure:
/**************************************************************
* Declare a structure with name s_name of structure type name *
**************************************************************/
parse arg all
parse var all s_name name
/************************************************
* Remove the __ prefix from the definition name *
************************************************/
if substr(name,1,1) = "_"then
name = check_name(name)
/**************************************************************
* if struct tag name and variable name are same (lowercase & uppercase)*
* then PLI is case insensitive so issue error message. *
**************************************************************/
if translate(name) = translate(s_name) | translate(s_name) = translate(name) then
do
out_line = z"%note('Error 15: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This kind of definition is not supported by this utility. */"
call do_writeout(out_line)
out_line = z"/* Error: typedef struct "name" "s_name" */ "
call do_writeout(out_line)
if cpos \= 0 then do
call do_comment(comment)
end
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
/****************************************
* Output struct declarartion *
****************************************/
out_line = z"define alias "s_name" type "name";"
out_line1 = z"define alias @"s_name" handle "name";"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
tflag = "off"
switchflag = ""
return
/**************************************************************
* Declare a pointer to a structure with name & s_name *
**************************************************************/
name_a_ptrstructure:
parse arg all
all = space(all,1)
parse var all name s_name
name = strip(name)
s_name = strip(s_name)
/**************************************************************
* Declare a pointer to a struct and eliminates all pointer symbols. *
**************************************************************/
if pos("*",name) \= 0 | pos("*",s_name) \= 0 then
do
if left(s_name,4) = "near" | left(s_name,3) = "far" then
do
parse var s_name attribute s_name ";"
s_name = space(s_name,0)
if pos("*",s_name) \= 0 then
do
do while pos("*",s_name) \= 0
parse var s_name "*" s_name
s_name = strip(s_name)
end
end
end
if pos("*",name) \= 0 then do
parse var name name "*"
name = strip(name)
end
end
else
s_name=space(s_name,0)
if pos("*",s_name) \= 0 then
do
do while pos("*",s_name) \= 0
parse var s_name "*" s_name
s_name = strip(s_name)
end
end
/******************************
* Remove leading underscores. *
******************************/
if pos("_",name) \= 0 | pos("_",s_name) \= 0 then do
name = check_name(name)
s_name = check_name(s_name)
end
out_line = z"define alias "s_name" handle "name";"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line = z"define alias @"s_name" handle "name";"
out_line = do_indent(out_line)
call do_writeout(out_line)
tflag = "off"
return
/********************************************************************
* Subroutine to handle a #if statement *
********************************************************************/
do_if:
parse arg rest
cpos=pos('/*', rest)
if cpos\=0 then
do
comment=substr(rest,cpos)
rest=delstr(rest,cpos)
end
if pos("defined",rest) = 0 then
do
out_line = z"%dcl "rest" fixed ext;"
call do_writeout(out_line)
out_line = z"%if "rest" ^= 0 %then %do"
call do_writeout(out_line)
if cpos \= 0 then do
call do_comment(comment)
end
return
end
rest = translate(rest, '^', '!')
sympos=pos('||',rest)
do while(sympos\=0)
rest=delstr(rest,sympos,1)
sympos=pos('||',rest)
end
sympos=pos('&&',rest)
do while(sympos\=0)
rest=delstr(rest,sympos,1)
sympos=pos('&&',rest)
end
sympos=pos('DEFINED',translate(rest))
do while(sympos\=0)
first=delstr(rest,sympos)
rest=substr(rest,sympos+length('DEFINED')-1)
parse var rest '(' varname ')' rest
varname=check_name(varname)
rest=first||'('varname"^='')"rest
out_line = z"%dcl "varname" char ext;"
call do_writeout(out_line)
sympos=pos('DEFINED',translate(rest))
end
out_line = z"%if "rest" %then "
/*******************************************
* Output the condition of the if statement *
*******************************************/
out_line = do_indent(out_line)
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z" %do;"
out_line = do_indent(out_line)
call do_writeout(out_line)
indent = indent + 1
return
/********************************************************************
* Subroutine to process #ifdef statement *
********************************************************************/
do_ifdef:
parse arg rest
parse var rest name extra
/*******************************************
* Remove the __ prefix from constant names *
*******************************************/
if substr(name,1,1) = "_" then do
name = check_name(name)
end
/**********************************
* Check for a comment in the line *
**********************************/
comment = pos('/*', extra)
/*******************************************
* Check for errors in the #ifdef statement *
*******************************************/
if (comment = 0) & (extra \= "") then
say "Warning : Invalid #ifdef statement"
else do
/***********************************************
* Output an if statement which tests to see *
* if the constant in question equals 'Y'. If *
* it does, that means it was defined earlier *
* with a #define, and thus the ifdef is true *
***********************************************/
out_line = z"%dcl "name" char ext;"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line = z"%if "name" ^= '' %then "
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line = z" %do;"
out_line = do_indent(out_line)
call do_writeout(out_line)
indent = indent + 1
end
return
/********************************************************************
* Subroutine to handle a #else statement *
********************************************************************/
do_else:
parse arg extra
/**********************************
* Check for a comment on the line *
**********************************/
comment = pos('/*', extra)
/******************************************
* Check for errors in the #else statement *
******************************************/
if (comment = 0) & (extra \= "") then
say "Warning : Invalid #else statement"
else do
/*******************************************************
* Output a %end statement because the %else statement *
* always follows a completed %then %do statement which *
* must be ended *
*******************************************************/
indent = indent - 1
out_line = z" %end;"
out_line = do_indent(out_line)
call do_writeout(out_line)
indent = indent - 1
/********************************
* Output an %else %do statement *
********************************/
out_line = z" %else"
out_line = do_indent(out_line)
call do_writeout(out_line)
indent = indent + 1
out_line = z" %do;"
out_line = do_indent(out_line)
call do_writeout(out_line)
indent = indent - 1
end
return
/********************************************************************
* Subroutine to process #endif statement *
********************************************************************/
do_endif:
parse arg rest
parse var rest extra
/**********************************
* Check for a comment on the line *
**********************************/
comment = pos('/*', extra)
/*******************************************
* Check for errors in the #endif statement *
*******************************************/
if (comment = 0) & (extra \= "") then
say "Warning: Invalid #endif statement"
else do
/**************************
* Output a %end statement *
**************************/
out_line = z" %end;"
indent = indent - 1
out_line = do_indent(out_line)
call do_writeout(out_line)
if comment \= 0 then
call do_comment(extra)
end
return
/********************************************************************
* Subroutine to process #ifndef statement *
********************************************************************/
do_ifndef:
parse arg rest
parse var rest name extra
/*********************************************
* Remove the __ prefix from the #ifndef name *
*********************************************/
if substr(name,1,1) = "_" then
name = check_name(name)
/**********************************
* Check for a comment on the line *
**********************************/
comment = pos('/*', extra)
/********************************************
* Check for errors in the #ifndef statement *
********************************************/
if (comment = 0) & (extra \= "") then
say "Warning: Invalid #ifndef statement"
/*******************************************************
* Output an %if statement which checks if the constant *
* in question is not equal to 'Y' *
*******************************************************/
else do
out_line = z"%dcl "name" char ext;"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line = z"%if "name" = '' %then "
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line = z" %do;"
out_line = do_indent(out_line)
call do_writeout(out_line)
indent = indent + 1
end
return
/********************************************************************
* Subroutine to process a comment line *
********************************************************************/
do_comment:
parse arg comment_line
tmp_line = ""
/************************************************
* Insert a space because the first column of a *
* PL/I file is reserved *
************************************************/
stat_line = pos("*/",comment_line)
if stat_line \= 0 then
do
tmp_line = substr(comment_line,stat_line+2)
comment_line = substr(comment_line,1,stat_line+1)
end
/**************************************************
* Keep reading lines and outputting comment lines *
* until and end of comment symbol is reached *
**************************************************/
done = false
do while done = false
comment_line=z || comment_line
len = length(comment_line)
if len > right_margin then do
call do_format1(comment_line)
end
else do
rc = lineout(outputfile,comment_line)
end
end_comment = pos("*/", comment_line)
if end_comment = 0 then
do
comment_line = linein(inputfile)
line_num = line_num + 1
comment_line = z || comment_line
done = false
end
else
done = true
end
if tmp_line \= "" & tmp_line \= "TMP_LINE" then
call process_line tmp_line
return
/********************************************************************
* Subroutine to ignore pragma statements *
********************************************************************/
do_pragma:
parse arg rest
cpos=pos('/*', rest)
if cpos\=0 then
do
comment=substr(rest,cpos)
rest=delstr(rest,cpos)
end
out_line = z"%note('Error 16: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Pragma directives are not converted. */"
call do_writeout(out_line)
out_line = z"/* Error: #Pragma "rest" */"
call do_writeout(out_line)
if cpos \= 0 then do
call do_comment(comment)
end
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
/*****************************************/
/* Subroutine to handle Enumerated definitions. */
/*****************************************/
do_enum:
parse arg line
cflag = "off"
if pos("(",line) \= 0 then
do
cpos = pos("/*",line)
if cpos \= 0 then
do
line = substr(line,cpos)
comment = delstr(line,cpos)
end
else line = rest
/******************************************************************
* Gather the entire enum definition in to one line if it extends to multiple lines. *
******************************************************************/
if pos(";",line) = 0 then
do
line1 = linein(inputfile)
line_num = line_num + 1
cpos = pos("/*",line1)
if cpos \= 0 then do
line1 = substr(line1,1,cpos-1)
comment = delstr(line1,1,cpos-1)
end
else
comment = ""
line1 = strip(line1)
do while pos(";",line1) = 0 then
line = line||line1
line1 = linein(inputfile)
line_num = line_num + 1
cpos = pos("/*",line1)
if cpos \= 0 then do
line1 = substr(line1,1,cpos-1)
comment = delstr(line1,1,cpos-1)
end
else comment = ""
line1=strip(line1)
end
line = line||line1
end
/******************************************************************
* Issue a error message since functions with return type enum is not supported.*
******************************************************************/
out_line = z"%note('Error 17: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This utility does not support declarations with */"
call do_writeout(out_line)
out_line = z"/* return type struct, enum, or union */"
call do_writeout(out_line)
out_line = z"/* Error: "first" "line" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end /* Do */
/**************************************************/
/* Handle enumerated variable declarations or definitions */
/**************************************************/
select
when pos(";",line) \= 0 & pos("{",line) = 0 then do
cpos = pos('/*',line)
if cpos \= 0 then
do
comment = substr(line,cpos)
line=delstr(line,cpos)
end
parse var line s_name var_name
s_name = check_name(s_name)
/**************************************************************
* Issue a error message since PL/I does not support forward declarations. *
**************************************************************/
if var_name = "" then
do
out_line = z"%note('Error 18: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This utility does not support forward declarations */"
call do_writeout(out_line)
out_line = z"/* Error:"first" "s_name" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment1)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
call dcl_enumvar(var_name)
if cpos \= 0 then
call do_comment(comment)
end
/*****************************************
* Call process_enum to process enum definition. *
*****************************************/
when pos(";",line) \= 0 & pos("{",line) \= 0 then do
compos = pos('/*',line)
if compos \= 0 then
do
comment1 = substr(line,compos)
line=delstr(line,compos)
end
line = space(line,0)
line = check_separator(line)
call process_enum(line)
if compos \= 0 then
call do_comment(comment1)
end /* Do */
/***********************************************
* Gather all lines if no ; is found at the end of the line. *
***********************************************/
when pos(";",line) = 0 then do
cpos = pos('/*',line)
if cpos \= 0 then
do
comment = substr(line,cpos)
if pos("{",comment) \= 0 then
do
len = pos("{",comment)
comment = overlay("X",comment,len)
end
line=delstr(line,cpos)
end
line = space(line,0)
if cpos \= 0 then
line = line" "comment
line1= linein(inputfile)
line_num = line_num + 1
cpos = pos('/*',line1)
if cpos \= 0 then
do
comment = substr(line1,cpos)
if pos("{",comment) \= 0 then
do
len = pos("{",comment)
comment = overlay("X",comment,len)
end
line1=delstr(line1,cpos)
end
line1 = line1||"~"
/************************
* Do loop to gather all lines *
*************************/
do while pos(";",line1) = 0
line1= space(line1,0)
if cpos \= 0 then
line1 = line1" "comment
line = line||line1
line1 = linein(inputfile)
line_num = line_num + 1
cpos = pos('/*',line1)
if cpos \= 0 then
do
comment = substr(line1,cpos)
if pos("{",comment) \= 0 then
do
len = pos("{",comment)
comment = overlay("X",comment,pos)
end
line1=delstr(line1,cpos)
end
line1 = line1||"~"
end /* Do */
line1 = space(line1,0)
if cpos \= 0 then
line1 = line1" "comment
line = line||line1
line = check_separator(line)
call process_enum(line)
end
otherwise
nop /* will do nothing in some cases */
end /* select */
return
/************************************************************/
/* This routine is called by process enum to process preprocessor */
/* definitions inside enum definitions. */
/************************************************************/
process_pre: procedure expose null
parse arg rest
parse var rest
select
when substr(rest,1,6) = "#ifdef" then do
len = length(rest)
left = delstr(rest,1,6)
rest = do_functifdef(substr(rest,1,6)||" "||left)
end
when substr(rest,1,7) = "#ifndef" then do
len = length(rest)
left = delstr(rest,1,7)
rest = do_functifndef(substr(rest,1,7)||" "||left)
end
when substr(rest,1,3) = "#if" then do
len = length(rest)
left = delstr(rest,1,3)
rest = do_functif(substr(rest,1,3)||" "||left)
end
when substr(rest,1,5) = "#else" then
rest = do_felse(rest)
when substr(rest,1,6) = "#endif" then
rest = "%end;"
otherwise nop
end
return rest
/*******************************************************/
/* Subroutine to process and output Enumerated definitions. */
/*******************************************************/
process_enum:
parse arg line
ss_name = "dummy#"
len = pos("{",line)
if len \= 0 then
do
if substr(line,len+1,1) = "~" then
line = delstr(line,len+1,1)
end
len = lastpos("}",line)
if len \= 0 then
do
if substr(line,len+1,1) = "~" then
line = delstr(line,len+1,1)
end
parse var line name "{" token "~" list "}" rest
name = strip(name)
len = length(name)
do while pos("~",name) \= 0
parse var name name "~" name1
name = name || name1
end
if name = "" then
do
name = ss_name||strt_counter
strt_counter = strt_counter+1
end
name = check_name(name)
token = check_name(token)
if pos("}",token) \= 0 then
do
parse var token token "}" rest
token = check_name(token)
rest = "}"||rest
end
else
rest = "}"||rest
/********************************************
* The first line declares the function name *
********************************************/
out_line.0 = z"define "
out_line.1 = z"ordinal"
out_line.1 = indentation||out_line.1
out_line.2 = name
out_line.2 = indentation||indentation||name
i = 2
done = false
do while done = false
i = i + 1
if pos("=",token) \= 0 then
token = process_token(token)
orig_token = token
if token \= "" & token \= "TOKEN" then
do
if left(token,1) = "#" then
do
token = process_pre(token)
if i = 3 then
out_line.i = "( "token
else
out_line.i = token
end
else
if i = 3 & pos(",",orig_token) \= 0 then
out_line.i = "( "token
else if i = 3 & pos(",",orig_token) = 0 then
out_line.i = "( "token
else if i \= 3 & pos(",",orig_token) \= 0 then
out_line.i = token
else
out_line.i = token
parse var list token "~" list
token = check_name(token)
cpos = pos('/*',token)
if cpos \= 0 then
do
epos =pos('*/',token)
comment = substr(token,cpos,epos)
token = delstr(token,cpos,epos)
token = check_name(token)
out_line.i = out_line.i||comment
end
end
else do
done= true
out_line.i = ");"
end
end
/**************************************************
* Output the PL/I enum definitions. *
**************************************************/
do j = 0 to i
if pos("X",out_line.j) \= 0 then
out_line.j = check_changes(out_line.j)
j = j + 1
end
do j = 0 to i
if j = 0 | j = 1 | j = 2 then
do
out_line.j = do_indent(out_line.j)
call do_writeout(out_line.j)
end
else do
out_line.j = indentation||indentation||indentation||out_line.j
out_line.j = do_indent(out_line.j)
call do_writeout(out_line.j)
out_line.j = ""
end
end
var_name=rest
if pos("~",var_name) \ = 0 then
do
do while pos("~",var_name) \= 0
len = pos("~",var_name)
var_name = delstr(var_name,len,1)
end
end
var_name = strip(var_name)
/**************************************************************
* Process enum variable declartion list after enclosing } braces. *
**************************************************************/
if var_name \= "" & var_name \= "};" then
do
cpos = pos('/*',var_name)
if cpos \= 0 then
do
comment = substr(var_name,cpos)
var_name = delstr(var_name,cpos)
end
if var_name \= "};" then
do
parse var var_name "}" var_name
s_name = out_line.2
call dcl_enumvar(var_name)
end
if cpos \= 0 then
call do_comment(comment)
end
track = ""
track2 = ""
/*************************************
* Return TRUE or FALSE depending on *
* whether or not the statement was *
* understood and converted *
*************************************/
if done \= true then return false
else
return true
/************************************/
/* check changes called by process_enum */
/************************************/
check_changes:
parse arg st
cpos = pos("/*",st)
if cpos \= 0 then
do
comment = substr(st,cpos)
st = delstr(st,cpos)
end
else
comment = ""
/*********************/
/* convert X to { braces */
/*********************/
if pos("X",comment) \= 0 then
do
len = pos("X",comment)
comment = overlay("{",comment,len)
end
st = st||comment
return st
/********************************************************************
* Subroutine to process value initialized in enum declaration *
********************************************************************/
process_token:
parse arg token
if pos(",",token) \= 0 then
pos_comma = 1
else
pos_comma = 0
parse var token token "=" val ","
token = token" value("val")"
if pos_comma = 1 then
token = token||","
token = strip(token)
return token
/********************************************************************
* Subroutine to handle a function or variable declaration *
********************************************************************/
do_variable_or_function:
parse arg line
org_line = line
retype = ""
ans = ""
ret = ""
cpos = pos("/*",line)
if cpos \= 0 then
do
epos =pos('*/',line)
len = epos - cpos
comment = substr(line,cpos,len+2)
rest = delstr(line,1,epos+1)
rest = strip(rest)
line = delstr(line,cpos,epos)
if rest \= "" then
line = line||rest
end
else do
comment = ""
line = line
end
select
/**************************************
* If there is no left paren, then it is probably a*
* variable declaration. *
**************************************/
when pos('(', line) = 0 & pos(";",line) \= 0 then do
call process_var(org_line);
result = true
end
/********************************
* If there are parens then this *
* is a function definition *
********************************/
when pos('(', line) \= 0 & pos(";",line) \= 0 then do
cpos = pos("/*",line)
org_line = check_separator(org_line)
ans = process_functions(org_line)
if ans = true then result = true
else
result = false
end
/********************************************************
* If there are parens and function continues to next line gather them *
* into one statement to be processed. *
********************************************************/
when pos('(', line) \= 0 & pos(";",line) = 0 then do
statement= gather_routine(org_line)
statement = check_separator(statement)
ans = process_functions(statement)
if ans = true then result = true
else
result = false
end
/********************************************************
* If there are no parens and function or variable declaration continues *
* to next line gather them into one statement to be processed. * *
*********************************************************/
when pos('(', line) = 0 & pos(";",line) = 0 then do
statement= gather_routine(org_line)
if pos("(",statement) \= 0 then
do
statement = check_separator(statement)
ans = process_functions(statement)
if ans = true then
result = true
else
result = false
end
else do
comment= comment.1.0
call process_var(statement||comment)
result = true
end
end
otherwise
nop /* will do nothing in some cases */
end /* outer select */
return result
/****************************************************/
/* Add separator after every comma for uniform processing in */
/* function declarations, enums etc, because a line is parsed */
/* looking for a ~ as end of a parameter or enum list. */
/****************************************************/
check_separator:
parse arg str
i = 0
do while lastpos(",",str) \= 0
parse var str lstr "," other
if left(lstr,1) \= "~" then
lstr.i = "~"||lstr","
else
lstr.i = lstr","
i = i + 1
str = other
str = strip(str)
end
if left(str,1) \= "~" then
lstr.i = "~"||str
else
lstr.i = str
str = ""
do j = 0 to i
str = str||lstr.j
end
if left(str,1) = "~" then
parse var str "~" str
return str
/********************************
* If the function or variable declaration *
* extends beyond one line this routine *
* gathers them into one line for uniform*
* processing. *
********************************/
gather_routine:
parse arg line
statement = ""
comment. = ""
count = 0
i = 0
j = 0
line = strip(line)
/****************************************
* process comments from line before processing*
****************************************/
cpos = pos("/*",line)
if cpos \= 0 then
do
temp_comment = substr(line,cpos)
if pos(")",temp_comment) \= 0 then
do
len = pos(")",temp_comment)
temp_comment = overlay("X",temp_comment,len)
end
temp_line = delstr(line,cpos)
end
else do
temp_line = line
temp_comment=""
end
/******************************************************************
* Issue a error message and terminate since executable statement was found. *
******************************************************************/
if pos("{",temp_line) \= 0 & pos("=",temp_line) = 0 then
do
say "Executable st found or format not supported -- Program terminated"
say "/*Approximate line of termination is expected to be line# "line_num "in the .h file*/"
out_line = z"%note('Error 19: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Utility does not support executable statements */"
call do_writeout(out_line)
out_line = z"/* or format encountered is not supported. */"
call do_writeout(out_line)
out_line = z"/* Error: "temp_line" */"
len = length(out_line)
if len > right_margin then
call do_format1(out_line)
else
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(temp_comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
exit
end /* Do */
line.i = temp_line
comment.i.j = temp_comment
/*********************************************/
/* get next inputline for processing. */
/*********************************************/
line=linein(inputfile)
line_num = line_num + 1
line = strip(line)
cpos = pos("/*",line)
if cpos \= 0 then
do
temp_comment = substr(line,cpos)
if pos(")",temp_comment) \= 0 then
do
len = pos(")",temp_comment)
temp_comment = overlay("X",temp_comment,len)
end
temp_line = delstr(line,cpos)
end
else do
temp_line = line
temp_comment= ""
end
/**************************************************************
* If a definition is followed by only a comment line then || the two. *
**************************************************************/
if temp_line \= "" then
do
i = i + 1
line.i = temp_line
j = 0
comment.i.j = temp_comment
end
else do
j = j + 1
comment.i.j = temp_comment
end
/******************************************************************
* Issue a error message and terminate since executable statement was found. *
******************************************************************/
line = line.i
if pos("{",line) \= 0 & pos("=",line) = 0 then
do
say "Executable st found or format not supported -- Program terminated"
say "/*Approximate line of termination is expected to be line# "line_num "in the .h file*/"
out_line = z"%note('Error 20: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Utility does not support executable statements */"
call do_writeout(out_line)
out_line = z"/* or format encountered is not supported. */"
call do_writeout(out_line)
out_line = z"/* Error: "line" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment.i.j)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
exit
end /* Do */
/*********************************************/
/* get next inputline for processing. */
/*********************************************/
do while pos(";",line) = 0
line = linein(inputfile)
line_num = line_num + 1
line = strip(line)
cpos = pos("/*",line)
if cpos \= 0 then
do
temp_comment = substr(line,cpos)
if pos(")",temp_comment) \= 0 then
do
len = pos(")",temp_comment)
temp_comment = overlay("X",temp_comment,len)
end
temp_line = delstr(line,cpos)
end
else do
temp_line = line
temp_comment=""
end
/**************************************************************
* If a definition is followed by only a comment line then || the two. *
**************************************************************/
if temp_line \= "" then
do
i = i + 1
line.i = temp_line
j = 0
comment.i.j = temp_comment
end
else do
j = j + 1
count = j
comment.i.j = temp_comment
end
line = line.i
/******************************************************************
* Issue a error message and terminate since executable statement was found. *
******************************************************************/
if pos("{",line) \= 0 & pos("=",line) = 0 then
do
say "Executable st found or format not supported -- Program terminated"
say "/*Approximate line of termination is expected to be line# "line_num "in the .h file*/"
out_line = z"%note('Error 21: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Utility does not support executable statements */"
call do_writeout(out_line)
out_line = z"/* or format encountered is not supported. */"
call do_writeout(out_line)
out_line = z"/* Error: "line" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment.i.j)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
exit
end /* Do */
end
/********************************************
* Concatenate the entire definition into a single line. *
*********************************************/
do j = 0 to i
if line.j \= "" then
line.j = line.j||"~"
end /* do */
do j = 0 to i
statement = statement" "line.j
statement=space(statement,1)
end /* do */
return statement
/***********************************************************
* process_function calls the different functions appropriate for the one *
* being processed. System linkage conventions need to be included here. *
************************************************************/
process_functions:
parse arg line
line = space(line,1)
line = check_attribute(line)
line = space(line,1)
ori_line = line
parse var line first line
val1 = ""
result = ""
datatypes = "int long short char void unsigned long unsigned short",
"unsigned int unsigned char signed long signed short signed char signed int"
ptr_types ="int* long* short* char* void* "
/***************************************************/
/* Please include your system linkage conventions in the list */
/* below after the last one before the closing " in the last line.*/
/***************************************************/
select
when translate(first) = "STATIC" then do
cpos = pos("/*",line)
out_line= z"/* static functions not supported by this utility */"
call do_writeout(out_line)
say "static functions not supported"
val1 = false
end /* Do */
when translate(first) = "EXTERN" then do
val1 = do_extern(line)
end
when first = "*" then do
val1 = do_ptrfunct(first" "line)
end /* Do */
when substr(first,1,1) = "*" then do
first = "*"
line = delstr(ori_line,1,1)
val1 = do_ptrfunct(first" "line)
end /* Do */
when wordpos(first,datatypes) > 0 then do
val1 = do_extern(first" "line)
end /* Do */
when wordpos(first,ptr_types) > 0 then do
val1 = do_extern(first" "line)
end /* Do */
when wordpos(first,linkages) > 0 then do
line = first" "line
val1 = do_linkconventions(line)
end /* Do */
when pos("(",first) \= 0 | substr(line,1,1) = "(" then do
val1 = do_funct(first" "line)
end /* Do */
when wordpos(first,datatypes) = 0 & wordpos(first,linkages) = 0 ,
& first \= "*" then do
val1 = do_typefunct(first" "line)
return val1
end /* Do */
otherwise
nop /* Error in processing */
end /* select EXTERN */
return val1
/*********************************************************/
/* check for far and near attributes and process them appropriately */
/*********************************************************/
check_attribute:
parse arg line
org_line = line
parse var line line "(" line1
if pos("near",line) = 0 & pos("far",line) = 0 then
do
line = org_line
return line
end
if pos("far",line) \= 0 then
do
parse var line line "far" temp
line = line||temp
line = line||" ("||line1
end
if pos("near",line) \= 0 then
do
parse var line line "near" temp
line = line||temp
line = line||" ("||line1
end
return line
/********************************************************/
/* procedure to process all functions that have extern as first word*/
/*********************************************************/
do_extern:
parse arg line
parse var line type rest
lc = "_Cdecl _Pascal _Fastcall"
oldtype = type
temp = type
if right(temp,1,1) = "*" then
do
len = length(temp)
type = delstr(temp,len,1)
if wordpos(type,datatypes) = 0 then
type = temp
end
/***************************************************/
/* process C datatypes specified as return types. */
/***************************************************/
select
when wordpos(type,datatypes) > 0 then do
if right(temp,1) = "*" then
do
token1 = "*"
other = rest
end
if right(temp,1) \= "*" then
do
if type = "unsigned" | type = "signed" then
do
parse var rest type1 rest
retype = process_rtype(type" "type1)
end
else do
retype = process_rtype(type)
end
parse var rest token1 other
end
if substr(token1,1,1) = "(" then
do
say "this kind of funct decl is not supported"
out_line = z"/* Utility does not support this kind of func decl. */"
call do_writeout(out_line)
return false
end
/********************************************
* Process pointer attribute if it exists. *
*********************************************/
select
when token1 = "*" then do
ptr_flag=process_pointer(token1)
parse var other token2 rest
select
/********************************************
* Process linkage convention if it exists. *
********************************************/
when wordpos(token2,linkages) > 0 then do
if token2 = "_Far16" then
do
old_val = rest
parse var rest temp rest
if wordpos(temp,lc) > 0 then
token2 = token2" "temp
else do
token2 = token2
rest = old_val
end
end
linkconv = process_linkconv(token2)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret1(linkconv"%")
if val = true then result = true
return result
end /* Do */
/********************************************
* Process function declaration. *
*********************************************/
when pos("(",token2) \= 0 | substr(rest,1,1) = "(" then do
ret = dcl_function(other)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end /* Do */
otherwise
nop /* Error in processing */
end /* select token2*/
end /* when token1 = * */
/********************************************
* Process linkage convention if it exists. *
********************************************/
when wordpos(token1,linkages) > 0 then do
parse var other rest
if token1 = "_Far16" then
do
old_val = rest
parse var rest temp rest
if wordpos(temp,lc) > 0 then
token1 = token1" "temp
else do
token1 = token1
rest = old_val
end
end
linkconv = process_linkconv(token1)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret3(retype"%"linkconv"%")
if val = true then result = true
return result
end /* Do */
when pos("*",token1) = 0 & pos("(",token1) \= 0 then do
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret4(retype"%")
if val = true then result = true
return result
end /* Do */
when pos("*",token1) = 0 & substr(other,1,1) = "(" then do
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret4(retype"%")
if val = true then result = true
return result
end /* Do */
when pos("*",token1) \= 0 & pos("(",token1) \= 0 then do
rest = delstr(rest,1,1)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end /* Do */
when pos("*",token1) \= 0 & substr(other,1,1) = "(" then do
rest = delstr(rest,1,1)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end /* Do */
otherwise
nop /* Error in processing */
end /* select for token1*/
end /* type = datatype */
/********************************************
* Process linkage convention if it exists. *
********************************************/
when wordpos(type,linkages) > 0 then do
if type = "_Far16" then
do
old_val = rest
parse var rest temp rest
if wordpos(temp,lc) > 0 then
type = type" "temp
else do
type = type
rest = old_val
end
end
linkconv = process_linkconv(type)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret5(linkconv"%")
if val = true then result = true
return result
end /* Do */
when pos("(",type) \= 0 | left(rest,1) = "(" then do
if substr(type,1,1) \= "*" then
do
ret = dcl_function(line)
if ret \= true then
do
result = false
return result
end
val = print_ret6()
if val = true then result = true
return result
end /* Do */
else
if substr(type,1,1) = "*" & pos("(",type) \= 0 then
do
type = delstr(type,1,1)
type = type" "||rest
type = space(type,1)
ret = dcl_function(type)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end /* usertype *name */
else
if substr(type,1,1) = "*" & left(rest,1) = "(" then
do
type = delstr(type,1,1)
type = type||rest
ret = dcl_function(type)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end /* usertype *name */
end /* pos "(" type */
when type = "*" | substr(type,1,1) = "*" then do
if type = "*" then
ptr_flag=process_pointer(type)
else
if left(type,1,1) = "*" then
do
temp = delstr(type,1,1)
type = "*"
rest = temp||rest
end
/********************************************
* Process linkage convention if it exists. *
********************************************/
parse var rest token2 other
if wordpos(token2,linkages) > 0 then
do
if token2 = "_Far16" then
do
old_val = other
parse var other temp other
if wordpos(temp,lc) > 0 then
token2 = token2" "temp
else do
token2 = token2
other = old_val
end
end
linkconv = process_linkconv(token2)
ret = dcl_function(other)
if ret \= true then
do
result = false
return result
end
val = print_ret1(linkconv"%")
if val = true then result = true
return result
end /* Do */
else
if pos("(",rest) \= 0 then
do
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end
end /* type = * */
when type = "*" & pos("(",rest) \= 0 then do
ptr_flag=process_pointer(type)
if pos("(",rest) \= 0 then
do
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end
end /* Do */
/********************************************
* Process userdefined datatypes *
********************************************/
when wordpos(type,linkages) = 0 & wordpos(type,datatypes) = 0 then do
if right(type,1) = "*" then do
checkname = "*"
parse var rest left
end
else
parse var rest checkname left
select
when pos("(",checkname) \= 0 & substr(checkname,1,1) \= "*" then do
retype = type
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret7(retype"%")
if val = true then result = true
return result
end /* usertype nopointer and function */
when left(left,1) = "(" & substr(checkname,1,1) \= "*" then do
retype = type
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret7(retype"%")
if val = true then result = true
return result
end /* usertype nopointer and function */
when substr(checkname,1,1) = "*" & pos("(",checkname) \= 0 then do
checkname = delstr(checkname,1,1)
retype = type
rest = delstr(rest,1,1)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end /* usertype *name */
when substr(checkname,1,1) = "*" & substr(left,1,1) = "(" then do
checkname = delstr(checkname,1,1)
retype = type
rest = delstr(rest,1,1)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end /* usertype *name */
when checkname = "*" then do
ptr_flag=process_pointer(checkname)
parse var left token2 rest
select
when wordpos(token2,linkages) > 0 then do
if token2 = "_Far16" then
do
old_val = rest
parse var rest temp rest
if wordpos(temp,lc) > 0 then
token2 = token2" "temp
else do
token2 = token2
rest = old_val
end
end
linkconv = process_linkconv(token2)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret1(linkconv"%")
if val = true then result = true
return result
end /* Do */
/********************************************
* Process linkage convention if it exists. *
********************************************/
when wordpos(token2,linkages) = 0 then do
ret = dcl_function(left)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end /* token2 lc or funct */
end /* usertype * name */
end /* checkname */
/********************************************
* Check to make sure the calling convention *
* specified is one which has been defined *
********************************************/
when wordpos(checkname,linkages) > 0 then do
if checkname = "_Far16" then
do
old_val = left
parse var left temp left
if wordpos(temp,lc) > 0 then
checkname = checkname" "temp
else do
checkname = checkname
left = old_val
end
end
linkconv = process_linkconv(checkname)
retype = type
ret = dcl_function(left)
if ret \= true then
do
result = false
return result
end
val = print_ret8(retype"%"linkconv"%")
if val = true then result = true
return result
end /* Do */ /* usertype lc name */
otherwise
nop /* Error in processing */
end /* select for pos("(",checkname */
end /* wordpos type linkages */
/********************************************
* Process userdefined data types as return types. *
********************************************/
when wordpos(type,linkages) = 0 & wordpos(type,datatypes) = 0 then do
parse var rest checkname left
if pos("*",checkname) \= 0 then
do
retype = type
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret7(retype"%")
if val = true then result = true
return result
end
end
otherwise
nop /*Error in processing */
end /* select for type*/
return result
/*************************************
* If the type is unsigned, then it *
* is necessary to read another word *
* for the type (return type or parmeter type) *
*************************************/
process_rtype:
parse arg rtype
parse var rtype type type1 pname
arr = ""
dtypes = "int long char short"
if pos("[",rtype) \= 0 & pos("*",rtype) = 0 then
do
arr = check_array(rtype)
end
else
arr = ""
select
when pos("*",pname) \= 0 | right(type,1) = "*" then
do
if pos("[",rtype) \= 0 then
do
arr = check_array(rtype)
arr = strip(arr)
type = arr" pointer"
end
else
type = "pointer"
end
when type = "int" | type = "long" then
type = "fixed bin(31)"||arr
when type = "short" then
type = "fixed bin(15)"||arr
when type = "void" then
type = " "
when type = "char" then
do
if pos(",",arr) \= 0 then
type = "char"||arr
else
if pos(",",arr) = 0 & pos("(",arr) \= 0 then
do
parse var arr "dim" arr
parse var arr arr ")"
arr = arr||")"
arr = check_char(arr)
type = "char"||arr||" varyingz"
end
else
type = "char"
end
/********************************************
* Process unsigned return types. . *
********************************************/
when type = "unsigned" then do
select
when right(type1,1) = "*" then do
if pos("[",type1) \= 0 then
do
do while pos("*",type1) \= 0
parse var type1 type1 "*"
end
arr = check_array(type1)
arr = strip(arr)
type = arr" pointer"
end
else
type = "pointer"
end /* Do */
when type1 = "int" | type1 = "long" then
type = "unsigned fixed bin(31)"||arr
when type1 = "short" then
type = "unsigned fixed bin(16)"||arr
when type1 = "char" then do
if pos(",",arr) \= 0 then
type = "char"||arr
else
if pos(",",arr) = 0 & pos("(",arr) \= 0 then
do
parse var arr "dim" arr
arr = check_char(arr)
type = "char"||arr||" varyingz"
end
else
type = "char"
end
when wordpos(type1,dtypes) = 0 & pos("[",type1) = 0 then
type = "unsigned fixed bin(31)"||arr
otherwise
nop /* okay to come here */
end /* select */
end /* Do */
/********************************************
* Process signed datatypes. . *
********************************************/
when type = "signed" then do
select
when right(type1,1) = "*" then do
if pos("[",type1) \= 0 then
do
do while pos("*",type1) \= 0
parse var type1 type1 "*"
end
arr = check_array(type1)
arr = strip(arr)
type = arr" pointer"
end
else
type = "pointer"
end /* Do */
when type1 = "int" | type1 = "long" then
type = "signed fixed bin(31)"||arr
when type1 = "short" then
type = "signed fixed bin(15)"||arr
when type1 = "char" then
type = "signed fixed bin(7)"||arr
when wordpos(type1,dtypes) = 0 & pos("[",type1) = 0 then
type = "signed fixed bin(31)"||arr
otherwise
nop /* okay to come here */
end /* select */
end /* Do */
/********************************************
* Process userdefined data types. . *
********************************************/
otherwise
type = "type "type" "arr
end /* select */
return type
/********************************************
* Strip spaces in array dimensions. *
********************************************/
process_array:
parse arg v1
len = length(v1)
old = v1
bpos = pos("[",v1)
if bpos \= 0 then
do
endpos = lastpos("]",v1)
arrpos = substr(v1,bpos,endpos)
arrpos = space(arrpos,0)
arrpos = strip(arrpos)
end
old1 = substr(v1,1,bpos-1)
old1 = space(old1,1)
old2 = substr(endpos,len)
new = old1||arrpos||old2
return new
/******************************************************
* Process the dimensions for array return types in parameter list *
*******************************************************/
check_array:
parse arg rtype1
parse var rtype1 type type1 pname
dtypes = "short long char int"
arr = ""
if pname = "]" & type1 \= "" then /* unsig int[2][ ] */
do
pname = ""
type1 = type1||"]"
end
if pos("[",pname) \= 0 & type1 \= "" then /* unsig int a1[3] */
do
parse var pname "[" pname
type1 = type1||"["||pname
pname = ""
end
if pname = "" then
do
if pos("[",type1) \= 0 then do /* unsign int[3][4] */
if type = "unsigned" | type = "signed" then
do
parse var type1 type1 "[" arr
arr = "["||arr
if pos("][",arr) \= 0 then
do
arr= convert_bracket(arr)
arr = convert_finalbracket(arr)
end
arr = convert_finalbracket(arr)
arr = " dim"||arr
end
/********************************************
* Process array dimension for C datatypes. *
********************************************/
else if wordpos(type,dtypes) > 0 & pos("[",type1) \= 0 then
do
parse var type1 "[" type1
arr= "["||type1
if pos("][",arr) \= 0 then
do
arr= convert_bracket(arr)
arr = convert_finalbracket(arr)
end
arr = convert_finalbracket(arr)
arr = " dim"||arr
end
/******************************************************
* Process array dimension for C userdefined datatypes. *
*******************************************************/
else if wordpos(type,dtypes) = 0 & pos("[",type1) \= 0 then
do
parse var type1 "[" type1
arr= "["||type1
if pos("][",arr) \= 0 then
do
arr= convert_bracket(arr)
arr = convert_finalbracket(arr)
end
arr = convert_finalbracket(arr)
arr = " dim"||arr
end
end
else
if pos("[",type) \= 0 then /* int[3] */
do
bpos = pos("[",type)
if bpos \= 0 then
do
word = substr(type,1,bpos-1)
end
if wordpos(word,dtypes) > 0 | wordpos(word,dtypes) = 0 then
do
parse var type type "[" arr
arr = "["||arr
if pos("][",arr) \= 0 then
do
arr= convert_bracket(arr)
arr = convert_finalbracket(arr)
end
arr = convert_finalbracket(arr)
arr = " dim"||arr
end
end
end
return arr
/*************************************
* If the type is pointer, then process_pointer *
* sets the pointer flag on. *
*************************************/
process_pointer:
parse arg rest1
parse var rest1 ptr_flag
if ptr_flag = "*" then do
ptr_flag = "on"
end
return ptr_flag
/*************************************
* If there exists a linkage convention then this*
* routine sets the appropriate linkage. *
*************************************/
process_linkconv:
parse arg lcon
parse var lcon calling_convention name
if calling_convention = "_Far16" then
do
if wordpos(name,lc) > 0 then
do
name = strip(name)
calling_convention = calling_convention" "name
end
end
select
when calling_convention = "_System" then
calling_convention = "options(linkage(system) byvalue nodescriptor)"
when calling_convention = "_Pascal" then
calling_convention = "options(linkage(system) byvalue nodescriptor)"
when calling_convention = "_Far16" | calling_convention =,
"_Far16 _Cdecl" then
calling_convention = "options(linkage(cdecl16) byvalue nodescriptor)"
when calling_convention = "_Far16 _Pascal" then
calling_convention = "options(linkage(pascal16) byvalue nodescriptor)"
when calling_convention = "_Far16 _Fastcall" then
calling_convention = "options(linkage(fastcall16) byvalue nodescriptor)"
when calling_convention = "_Optlink" then
calling_convention = "options(linkage(optlink) byvalue nodescriptor)"
otherwise
calling_convention = calling_convention
end /* select */
return calling_convention
do_felse:
parse arg type
type = "%end; %else %do;"
return type
/************************************************************/
/* Routine called by struct union enum and functions to process #ifdef */
/* as fields, or function parameters. */
/************************************************************/
do_functifdef:
parse arg rest
parse var rest extra name
/*******************************************
* Remove the __ prefix from constant names *
*******************************************/
if substr(name,1,1) = "_" then do
name = check_name(name)
end
type = "%dcl "name" char ext;"
type = type||" %if "name" ^= '' %then "
type = type||" %do;"
return type
/************************************************************/
/* Routine called by struct union enum and functions to process #ifndef */
/* as fields, or function parameters. */
/************************************************************/
do_functifndef:
parse arg rest
parse var rest extra name
/*******************************************
* Remove the __ prefix from constant names *
*******************************************/
if substr(name,1,1) = "_" then do
name = check_name(name)
end
type = "%dcl "name" char ext;"
type = type||" %if "name" = '' %then "
type = type||" %do;"
return type
/************************************************************/
/* Routine called by struct union enum and functions to process #if */
/* as fields, or function parameters. */
/************************************************************/
do_functif:
parse arg rest
parse var rest extra name
/*******************************************
* Remove the __ prefix from constant names *
*******************************************/
if substr(name,1,1) = "_" then do
name = check_name(name)
end
type = "%dcl "name" fixed ext;"
type = type||" %if "name" ^= 0 %then "
type = type||" %do;"
return type
/**********************************************
* Routine is used to process parameter types in function *
* declaration. *
**********************************************/
process_userdifftypes:
parse arg difftypes
/*******************************************************
* Issue error message if mutiple function declarations are found. *
*******************************************************/
if pos("(",difftypes) \= 0 then
do
out_line = z"%note('Error 22: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Utility does not support multiple function declarations. */"
call do_writeout(out_line)
out_line = z"/* Error: "difftypes") */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
say "/* multiple funct decl not supported */"
difftypes = z"/* "||difftypes||")"
return difftypes
end
if substr(difftypes,1,1) = "#" then
do
select
when substr(difftypes,1,6) = "#ifdef" then
ptype = do_functifdef(difftypes)
when substr(difftypes,1,7) = "#ifndef" then
ptype = do_functifndef(difftypes)
when substr(difftypes,1,3) = "#if" then
ptype = do_functif(difftypes)
when substr(difftypes,1,5) = "#else" then
ptype = do_felse(difftypes)
when substr(difftypes,1,6) = "#endif" then
ptype = "%end;"
otherwise nop
end
return ptype
end
list = "enum struct union"
list1 = "ENUM STRUCT UNION"
if pos("*",difftypes) \= 0 & wordpos(list,difftypes) = 0 then
do
if pos("far",difftypes) \= 0 | pos("near",difftypes) \= 0 then
difftypes= check_ptrtype(difftypes)
end
if translate(left(difftypes,1,5)) = "CONST" then
parse var difftypes "const" difftypes
if pos("[",difftypes) \= 0 then
difftypes=process_array(difftypes)
parse var difftypes param_type pname
/****************************************************
* Remove closing parenthesis from parameter type if last one. *
****************************************************/
if pos(")",pname) \= 0 then
do
parse var pname pname ")"
end /* Do */
if pos(")",param_type) \= 0 then
do
parse var param_type param_type ")"
end /* Do */
/****************************************************************
* Output the different parameter types depending on the different conditions.*
*****************************************************************/
select
when pos("...",param_type) \= 0 then
ptype = "*"
when right(param_type,1) = "*" then do
do while pos("*",param_type) \= 0
parse var param_type param_type "*"
end
if wordpos(param_type,datatypes) > 0 & pos("[",param_type) = 0 then
ptype = "pointer"
else
if wordpos(param_type,datatypes) = 0 & pos("[",param_type) = 0 then
ptype = "type @"param_type
else do
parse var param_type param_type "[" left
left = "["||left
if wordpos(param_type,datatypes) > 0 then
do
left = process_strtarray(left)
ptype = left" pointer"
end
else do
left = process_strtarray(left)
ptype = left" type @"param_type
end
end
end /* Do */
when translate(param_type) = "CONST" then do
parse var pname param_type pname
if substr(pname,1,1) = "*" then
ptype = "pointer"
else
ptype = process_rtype(param_type)
end
when (substr(pname,1,1) = "*" | substr(pname,1,2) = "**" ) ,
& wordpos(param_type,datatypes) > 0 then do
pname = space(pname,0)
do while pos("*",pname) \= 0
parse var pname "*" pname
end
pname = process_strtarray(pname)
if pos("(",pname) \= 0 then
ptype = pname" pointer"
else
ptype = "pointer"
end
when translate(pname) = "FAR" | translate(pname) = "NEAR" then
ptype = "pointer"
when (pos("*",pname) \= 0 & wordpos(translate(param_type),list1) > 0 ) then do
parse var pname pname sname
if pos("*",pname) \= 0 then
do
do while pos("*",pname) \= 0
parse var pname pname "*"
end
end
if pos("[",sname) \= 0 then
do
sname = process_strtarray(sname)
pname = strip(pname)
if pos("_",pname) \= 0 then
pname = check_name(pname)
ptype = sname "handle "pname
end
else
if pos("[",sname) = 0 & pos("[",pname) \= 0 then
do
parse var pname pname "[" rest
rest = "["||rest
rest = process_strtarray(rest)
ptype = rest "handle "pname
end
else
if pos("[",sname) = 0 then
do
if pos("_",pname) \= 0 then
pname = check_name(pname)
ptype = "handle "pname
end
end
/******************************
* Process STRUCT parameter type *
******************************/
when translate(param_type ) = "STRUCT" & pos(" ",pname) \= 0 then do
parse var pname pname sname temp
if pos("[",sname) \= 0 then
do
sname = process_strtarray(sname)
pname = strip(pname)
if pos("_",pname) \= 0 then
pname = check_name(pname)
ptype = "type "pname" "sname
end
else do
if pos("_",pname) \= 0 then
pname = check_name(pname)
ptype = "type "pname
end
end
when translate(param_type) = "STRUCT" & pos(" ",pname) = 0 then do
if pos("[",pname) \= 0 then
do
parse var pname str "[" pname
pname = "["||pname
pname = process_strtarray(pname)
str = strip(str)
if pos("_",str) \= 0 then
str = check_name(str)
ptype = "type "str" "pname
end
else do
if pos("_",pname) \= 0 then
pname = check_name(pname)
ptype = "type "pname
end
end
/*****************************
* Process ENUM parameter type *
*****************************/
when (pos("*",pname) \= 0) & translate(param_type) = "ENUM" then do
parse var pname pname sname
if pos("*",pname) \= 0 then
do
do while pos("*",pname) \= 0
parse var pname pname "*"
end
end
ptype = "handle "pname
end
when pos(" ",pname) \= 0 & translate(param_type) = "ENUM" then do
parse var pname pname sname
if pos("[",sname) \= 0 then
do
sname = process_strtarray(sname)
pname = strip(pname)
if pos("_",pname) \= 0 then
pname = check_name(pname)
ptype = "ordinal "pname" "sname
end
else do
if pos("_",pname) \= 0 then
pname = check_name(pname)
ptype = "ordinal "pname
end
end
when translate(param_type) = "ENUM" & pos(" ",pname) = 0 then do
if pos("[",pname) \= 0 then
do
parse var pname str "[" pname
pname = "["||pname
pname = process_strtarray(pname)
str = strip(str)
if pos("_",str) \= 0 then
str = check_name(str)
ptype = "ordinal "str" "pname
end
else do
if pos("_",pname) \= 0 then
pname = check_name(pname)
ptype = "ordinal "pname
end
end
/*****************************
* Process UNION parameter type *
*****************************/
when (pos("*",pname) \= 0 | pos("**",pname) \= 0 ) & translate(param_type) = "UNION" then do
parse var pname pname sname
if pos("*",pname) \= 0 then do
do while pos("*",pname) \= 0
parse var pname pname "*"
end
end
ptype = "handle "pname
end
when pos(" ",pname) \= 0 & translate(param_type) = "UNION" then do
parse var pname pname sname
if pos("[",sname) \= 0 then
do
sname = process_strtarray(sname)
pname = strip(pname)
if pos("_",pname) \= 0 then
pname = check_name(pname)
ptype = "type "pname" "sname
end
else do
if pos("_",pname) \= 0 then
pname = check_name(pname)
ptype = "type "pname
end
end
when translate(param_type) = "UNION" & pos(" ",pname) = 0 then do
if pos("[",pname) \= 0 then
do
parse var pname str "[" pname
pname = "["||pname
pname = process_strtarray(pname)
str = strip(str)
if pos("_",str) \= 0 then
str = check_name(str)
ptype = "type "str" "pname
end
else do
if pos("_",pname) \= 0 then
pname = check_name(pname)
ptype = "type "pname
end
end
/*************************************
* Process pointer to userdefined data type. *
**************************************/
when substr(pname,1,1) = "*" & wordpos(param_type,datatypes) = 0 then do
if pos("_",param_type) \= 0 then
param_type = check_name(param_type)
if pos("[",pname) \= 0 then
do
parse var pname "[" rest
rest = "["||rest
rest = process_strtarray(rest)
ptype = rest "type @"param_type
end
else
ptype = "type @"param_type
end
when ( param_type \= "long" & param_type \= "short" & param_type \= "char" ,
& param_type \= "unsigned" & param_type \= "signed" & param_type \= "PSZ" &,
param_type \= "int" ) & (substr(pname,1,1) \= "*" ) & right(param_type,1) ,
\= "*" & pos("[",param_type) = 0 & pos("[",pname) = 0 & param_type \= "void" then do
if pos("_",param_type) \= 0 then
param_type = check_name(param_type)
ptype = "type "param_type
end
/*****************************
* Process PSZ parameter type *
*****************************/
when param_type = "PSZ" | param_type = "psz" then
ptype = "char (*) varyingz byaddr"
otherwise do
/********************************************
* Call process_rtype to process C intrinsic data type. *
*********************************************/
if param_type = "unsigned" | param_type = "signed" then
do
parse var pname type1 pname
ptype = process_rtype(param_type" "type1" "pname)
end /* Do */
else
ptype = process_rtype(param_type" "pname)
end
end
return ptype
/**********************************************************
* Process array dimension in STRUCT UNION ENUM (parameter type ) *
**********************************************************/
process_strtarray:
parse arg st
if pos("[",st) \= 0 then
do
parse var st temp "[" st
st = "["||st
if pos("][",st) \= 0 then
do
st= convert_bracket(st)
st = convert_finalbracket(st)
end
st = convert_finalbracket(st)
st = "dim"||st
end
return st
/*****************************
* Process far and near attributs. *
*****************************/
check_ptrtype:
parse arg info
if pos("far",info) \= 0 then
do
parse var info info "far" left
info = info||left
info = strip(info)
info = space(info,1)
end
if pos("near",info) \= 0 then
do
parse var info info "near" left
info = info||left
info = strip(info)
info = space(info,1)
end
return info
/*************************************************
* If it is a legal calling convention, read in lines *
* until the close paren is encountered. As lines are *
* read, parse them into parameter defintitions and output *
* this as a PL/I function prototype. *
*************************************************/
dcl_function:
parse arg line
line = space(line,1)
if translate(count) = "COUNT" then
count = 0
cpos=pos("/*",line)
if cpos \= 0 then
do
i = 0
j = 0
epos =pos('*/',line)
len = epos - cpos
comment.i.j = substr(line,cpos,len+2)
rest = delstr(line,1,epos+1)
rest = strip(rest)
line = substr(line,1,cpos-1)
if rest \= "" then
line = line||rest
end
else do
if comment.i.j = "" & substr(comment.i.j,1,7) = "COMMENT" then
comment.i.j = ""
line = line
end
if pos("{",line) \= 0 then
do
say "Executable st found or format not supported -- Program terminated"
say "/*Approximate line of termination is expected to be line# "line_num "in the .h file*/"
out_line = z"%note('Error 23: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Utility does not support executable statements */"
call do_writeout(out_line)
out_line = z"/* or format encountered is not supported. */"
call do_writeout(out_line)
out_line = z"/* Error: "line" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(" "||comment.i.j)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
exit
end /* Do */
if substr(line,1,1) = "(" then
do
say "this kind of funct decl is not supported"
out_line = z"%note('Error 24: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Utility does not support this kind of func decl. */"
call do_writeout(out_line)
return false
end
ptype = ""
len = pos("(",line)
if substr(line,len+1,1) = "~" | (substr(line,len+1,1) = "" & substr(line,len+2,1) = "~")then
do
if substr(line,len+1,1) = "~" then
line = delstr(line,len+1,1)
else
line = delstr(line,len+2,1)
end
paren = pos(")",line)
len = lastpos("~",line)
comma = pos(",",line)
if len \= 0 & len > paren & comma < paren then
do
line = delstr(line,len,1)
end
parse var line name "(" param_type pname "~" param ";"
param_type =strip(param_type)
if left(name,1) = "*" then
do
do while pos("*",name) \= 0
parse var name "*" name
end /* do */
end
if substr(name,1,1) = "_" then
name = check_name(name)
if pos(");",param_type) \= 0 then
parse var param_type param_type ")"
if (param_type = "" & param = "" ) then param_type = ")"
else
if pos(")",param_type) \= 0 & pos("(",param_type) \= 0 then
do
say "this kind of parameter type in funct decl is not supported"
out_line = z"%note('Error 25: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Utility does not support this kind of func decl. */"
call do_writeout(out_line)
out_line = z"/* Error: "line" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return false
end
done = false
out_line.0 = z"dcl "name" entry ("
i = 0
j = 0
do while done = false
if param_type = ")" | param_type = ");" then
do
out_line.0 = out_line.0" )"
call do_writeout(out_line.0)
out_line.0 = ""
if cpos \= 0 then do
comment.i.j = check_changes1(comment.i.j)
comment.i.j = z||comment.i.j
call do_comment(comment.i.j)
end /* end for cpos */
if pos("(",param) \= 0 then
do
out_line = z"%note('Error 26: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Utility does not support multiple function declarations. */"
call do_writeout(out_line)
out_line = z"/* Error: "param" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(" "||comment.i.j)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
say "/* multiple funct decl not supported */"
end /* end for pos ("(" param) */
done = true
return true
end /* end for param_type = ")" | ");" */
if param_type = "" & param = ")" then
do
len = lastpos(",",out_line.i)
if len \= 0 & pos("dim",out_line.i) = 0 then
out_line.i = delstr(out_line.i,len,1)
out_line.i = out_line.i" )"
done = true
do j = 0 to i+1
do k = 0 to count+1
if comment.j.k \= "" & substr(comment.j.k,1,7) \= "COMMENT" then
comment.j.k = check_changes1(comment.j.k)
if substr(out_line.j,1,8) \= "OUT_LINE" then
out_line.j = out_line.j
else
out_line.j = ""
if out_line.j \= "" then
do
out_line.j = do_indent(out_line.j)
call do_writeout(out_line.j)
out_line.j = ""
end /* end for out_line.j \= "" */
if comment.j.k \= "" & substr(comment.j.k,1,7) \= "COMMENT" then
call do_writeout(comment.j.k)
comment.j.k =""
end /* end for do k = 0 to count */
end /* end for do j = 0 to i + 1 */
return true
end /* end for param_type = "" & param = ) */
else if param_type \= "" & param = ")" then
do
i = i + 1
orig_param = param_type" "pname
if pos(",",orig_param) \= 0 then
do
if pos(",",pname) \= 0 then
do
len = pos(",",pname)
pname = delstr(pname,len,1)
end /* end for pos(",",pname) */
else
if pos(",",param_type) \= 0 then
do
len = pos(",",param_type)
param_type = delstr(param_type,len,1)
end /* end for pos(",",param_type) */
end /* end for pos(",",orig_param) */
ptype = process_userdifftypes(param_type" "pname)
out_line.i = z" "ptype" "
out_line.i = overlay(")",out_line.i,length(out_line.i))
if pos("(",difftypes) \= 0 then
do
len = length(out_line.i)
out_line.i = delstr(out_line.i,len,1)
out_line.i = out_line.i||" */"
i = i - 1
len = length(out_line.i)
out_line.i = delstr(out_line.i,len,1)
out_line.i = overlay(")",out_line.i,length(out_line.i)+1)
i = i + 1
end /* end for pos("(",difftypes) */
done = true
param_type = ""
do j = 0 to i+1
do k = 0 to count+1
if comment.j.k \= "" & substr(comment.j.k,1,7) \= "COMMENT" then
comment.j.k = check_changes1(comment.j.k)
if substr(out_line.j,1,8) \= "OUT_LINE" then
out_line.j = out_line.j
else
out_line.j = ""
if out_line.j \= "" then
do
out_line.j = do_indent(out_line.j)
call do_writeout(out_line.j)
out_line.j = ""
end /* end for out_line.j \= "" */
if comment.j.k \= "" & substr(comment.j.k,1,7) \= "COMMENT" then
call do_writeout(" "||comment.j.k)
comment.j.k =""
end /* end for do k = 0 to count */
end /* end for j = 0 to i + 1 */
return true
end /* end for param_type \= "" & param = ")" */
i = i + 1
if param = ")" then
do
ptype = process_userdifftypes(param_type" "pname)
out_line.i = z" "ptype" "
out_line.i = overlay(")",out_line.i,length(out_line.i))
done = true
param_type = ""
do j = 0 to i+1
do k = 0 to count+1
if comment.j.k \= "" & substr(comment.j.k,1,7) \= "COMMENT" then
comment.j.k = check_changes1(comment.j.k)
else if substr(out_line.j,1,8) \= "OUT_LINE" then
out_line.j = out_line.j
else
out_line.j = ""
if out_line.j \= "" then
do
out_line.j = do_indent(out_line.j)
call do_writeout(out_line.j)
out_line.j = ""
end /* end for out_line.j \= "" */
if comment.j.k \= "" & substr(comment.j.k,1,7) \= "COMMENT" then
call do_writeout(comment..kj)
comment.j =""
end /* end for do k = 0 to count */
end /* end for do j = 0 to i + 1 */
return true
end /* end for param = "(" */
orig_param = param_type" "pname
if pos(",",orig_param) \= 0 then
do
if pos(",",pname) \= 0 then
do
len = pos(",",pname)
pname = delstr(pname,len,1)
end
else
if pos(",",param_type) \= 0 then
do
len = pos(",",param_type)
param_type = delstr(param_type,len,1)
end
end /* end for pos(",",orig_param) */
if param_type \= ")" then do
ptype = process_userdifftypes(param_type" "pname)
end
/********************************************
* Subsequent lines indicate parameter names *
********************************************/
if pos(",",orig_param) \= 0 then
out_line.i = z" "ptype","
else
out_line.i = z" "ptype
if pos("~",param) = 0 then
do
parse var param param_type pname ")"
param = ")"
end
else
parse var param param_type pname "~" param
done = false
end
do j = 0 to i
do k = 0 to count+1
if pos("X",comment.j.k) \= 0 then
out_line.j = check_changes1(comment.j.k)
j = j + 1
end /* do */
end
do j = 0 to i+1
if out_line.j \= "" then
do
out_line.j = do_indent(out_line.j)
call do_writeout(out_line.j)
out_line.j = ""
end
do k = 0 to count+1
if comment.j.k \= "" & substr(comment.j.k,1,7) \= "COMMENT" then
call do_writeout(comment.j.k)
comment.j.k =""
end
end
j = 0
i = 0
comment. = ""
return true
/**********************************/
/*check changes called by process_enum */
/*to make sure comments are unchanged */
/*********************************/
check_changes1:
parse arg st
cpos = pos("/*",st)
if cpos \= 0 then
do
comment = substr(st,cpos)
st = delstr(st,cpos)
end
else
comment = ""
if pos("X",comment) \= 0 then
do
len = pos("X",comment)
comment = overlay(")",comment,len)
end
st = st||comment
return st
/*************************************************************
* This routine prints the appropriate return type: ptr & linkage convention *
**************************************************************/
print_ret1:
parse arg lc
parse var lc lc "%"
done =""
out_line1 = z" returns(ptr byvalue)"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line2 = z" "lc" external;"
out_line2 = do_indent(out_line2)
call do_writeout(out_line2)
out_line1 = ""
out_line2 = ""
done = true
return done
/***************************************************************
* This routine prints the appropriate return type: ptr & no linkage convention *
****************************************************************/
print_ret2:
done =""
out_line1 = z" returns(ptr byvalue)"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line2 = z" options (byvalue nodescriptor) external;"
out_line2 = do_indent(out_line2)
call do_writeout(out_line2)
out_line1 = ""
out_line2 = ""
done = true
return done
/***************************************************************
* This routine prints the appropriate return type & linkage convention *
****************************************************************/
print_ret3:
parse arg process
parse var process retype "%" lc "%"
done = ""
if retype \= "" then
do
out_line1 = z" returns( "retype" byvalue )"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
end
out_line2 = z" "lc" external;"
out_line2 = do_indent(out_line2)
call do_writeout(out_line2)
out_line1 = ""
out_line2 = ""
done = true
return done
/***************************************************************
* This routine prints the appropriate return type: & no linkage convention *
****************************************************************/
print_ret4:
parse arg process
parse var process retype "%"
done = ""
if retype \= "" then
do
out_line1 = z" returns( "retype" byvalue)"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
end
out_line2 = z" options (byvalue nodescriptor) external;"
out_line2 = do_indent(out_line2)
call do_writeout(out_line2)
out_line1 = ""
out_line2 = ""
done = true
return done
/***************************************************************
* This routine prints the appropriate return type: int & linkage convention *
****************************************************************/
print_ret5:
parse arg process
parse var process lc "%"
done = ""
out_line1 = z" returns( fixed bin(31) byvalue)"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line2 = z" "lc" external;"
out_line2 = do_indent(out_line2)
call do_writeout(out_line2)
out_line1 = ""
out_line2 = ""
done = true
return done
/***************************************************************
* This routine prints the appropriate return type: int & no linkage convention *
****************************************************************/
print_ret6:
done =""
out_line1 = z" returns( fixed bin(31) byvalue)"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line2 = z" options (byvalue nodescriptor) external;"
out_line2 = do_indent(out_line2)
call do_writeout(out_line2)
out_line1 = ""
out_line2 = ""
done = true
return done
/***************************************************************
* This routine prints the appropriate return type & no linkage convention *
****************************************************************/
print_ret7:
parse arg process
parse var process retype "%"
done = ""
out_line1 = z" returns( byvalue optional type "retype" )"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line2 = z" options (byvalue nodescriptor) external;"
out_line2 = do_indent(out_line2)
call do_writeout(out_line2)
out_line1 = ""
out_line2 = ""
done = true
return done
/***************************************************************
* This routine prints the appropriate return type & linkage convention *
****************************************************************/
print_ret8:
parse arg process
parse var process retype "%" lc "%"
done = ""
out_line1 = z" returns( byvalue optional type "retype" )"
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
out_line2 = z" "lc" external;"
out_line2 = do_indent(out_line2)
call do_writeout(out_line2)
out_line1 = ""
out_line2 = ""
done = true
return done
/**************************************************************/
/* This routine processes functions that start with linkage conventions. */
/**************************************************************/
do_linkconventions:
parse arg line
parse var line type rest
lc = " _Pascal _Fastcall _Cdecl "
if wordpos(type,linkages) > 0 then
do
if type = "_Far16" then
do
old_val = rest
parse var rest temp rest
if wordpos(temp,lc) > 0 then
type = type" "temp
else do
type = type
rest = old_val
end
end
linkconv = process_linkconv(type)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret5(linkconv"%")
if val = true then result = true
return result
end /* Do */
return result
/******************************************************************/
/* This routine processes functions that have nothing preceding the function name*/
/******************************************************************/
do_funct:
parse arg line
if pos("(",line) \= 0 then
do
ret = dcl_function(line)
if ret \= true then
do
result = false
return result
end
val = print_ret6()
if val = true then result = true
return result
end /* Do */
return result
/******************************************************************/
/* This routine processes functions that have userdefined types for return types. */
/******************************************************************/
do_typefunct:
parse arg line
parse var line type rest
rest = strip(rest)
lc = " _Pascal _Fastcall _Cdecl "
if wordpos(type,linkages) = 0 & wordpos(type,datatypes) = 0 then
do
if right(type,1) = "*" then do
checkname = "*"
parse var rest left
end
else
parse var rest checkname left
select
when pos("(",checkname) \= 0 & substr(checkname,1,1) \= "*" then do
retype = type
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret7(retype"%")
if val = true then result = true
return result
end
when pos("(",checkname) = 0 & substr(checkname,1,1) \= "*" & substr(left,1,1) = "(" then do
retype = type
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret7(retype"%")
if val = true then result = true
return result
end
when substr(checkname,1,1) = "*" & pos("(",checkname) \= 0 then do
checkname = delstr(checkname,1,1)
retype = type
rest = delstr(rest,1,1)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end
when substr(checkname,1,1) = "*" & substr(left,1,1) = "(" then do
checkname1 = "*"
ptr_flag=process_pointer(checkname1)
checkname = delstr(checkname,1,1)
retype = type
retype = ""
rest = delstr(rest,1,1)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end
/*************************************
* Process userdefined types with pointers. *
*************************************/
when checkname = "*" then do
ptr_flag=process_pointer(checkname)
parse var left token2 rest
select
when wordpos(token2,linkages) > 0 then do
if token2 = "_Far16" then
do
old_val = rest
parse var rest temp rest
if wordpos(temp,lc) > 0 then
token2 = token2" "temp
else do
token2 = token2
rest = old_val
end
end
linkconv = process_linkconv(token2)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret1(linkconv"%")
if val = true then result = true
return result
end /* Do */
when wordpos(token2,linkages) = 0 then do
ret = dcl_function(left)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end /* token2 lc or funct */
end /* select */
end /* usertype * name */
when wordpos(checkname,linkages) > 0 then do
if checkname = "_Far16" then
do
old_val = left
parse var left temp left
if wordpos(temp,lc) > 0 then
checkname = checkname" "temp
else do
checkname = checkname
left = old_val
end
end
linkconv = process_linkconv(checkname)
retype = type
ret = dcl_function(left)
if ret \= true then
do
result = false
return result
end
val = print_ret8(retype"%"linkconv"%")
if val = true then result = true
return result
end /* Do */ /* usertype lc name */
otherwise
nop /* error in processing */
end /* select for pos("(",checkname */
end /* wordpos type linkages */
return result
/******************************************************************/
/* This routine processes functions that have pointers for return types. */
/******************************************************************/
do_ptrfunct:
parse arg line
parse var line token1 other
lc = " _Pascal _Fastcall _Cdecl "
if token1 = "*" then
do
ptr_flag=process_pointer(token1)
parse var other token2 rest
select
when wordpos(token2,linkages) > 0 then do
if token2 = "_Far16" then
do
old_val = rest
parse var rest temp rest
if wordpos(temp,lc) > 0 then
token2 = token2" "temp
else do
token2 = token2
rest = old_val
end
end
linkconv = process_linkconv(token2)
ret = dcl_function(rest)
if ret \= true then
do
result = false
return result
end
val = print_ret1(linkconv"%")
if val = true then result = true
return result
end /* Do */
when pos("(",token2) \= 0 | substr(rest,1,1) = "(" then do
ret = dcl_function(other)
if ret \= true then
do
result = false
return result
end
val = print_ret2()
if val = true then result = true
return result
end /* Do */
otherwise
nop /* error processing */
end /* select token2*/
end /* when token1 = * */
return val
/***********************************************/
/* Subroutine to process a variable declaration. The data */
/* type could be any user defined data type or any regular */
/* C data type. */
/***********************************************/
process_var:
types = "int long short char"
scanline = " volatile "
val = ""
parse arg line
parse arg rest
do while pos("~",line) \= 0
parse var line line "~" l1
line = line||l1
end
rest = line
def_val = ""
cpos = pos("/*",line)
if cpos \= 0 then
do
comment = substr(line,cpos)
rest = delstr(rest,cpos)
end /* Do */
if wordpos(scanline,rest) > 0 then
do
vpos=pos("volatile",rest)
rest = overlay("abnormal",rest,vpos)
end
sdecl = pos(";",rest)
origrest = rest
rest = substr(rest,1,sdecl)
mdecl = substr(origrest,sdecl + 1,cpos)
if pos(";",mdecl) \= 0 & pos(" ",mdecl) \= 0 then
do
say "multiple decl not supported by this utility"
out_line = z"%note('Error 27: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This utility does not support multiple declarations. */"
call do_writeout(out_line)
out_line = z"/* Error: "rest" "mdecl "*/"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
/******************************************
* Issue error message for { braces. *
******************************************/
if pos("{",rest) \= 0 & pos("=",rest) = 0 then
do
say "Executable st found or format not supported -- Program terminated"
say "/*Approximate line of termination is expected to be line# "line_num "in the .h file*/"
out_line = z"%note('Error 28: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Utility does not support executable statements */"
call do_writeout(out_line)
out_line = z"/* or format encountered is not supported. */"
call do_writeout(out_line)
out_line = z"/* Error: "rest" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment.i)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
exit
end
/******************************************
* Issue error message for initialization expression. *
******************************************/
if pos("{",rest) \= 0 & pos("=",rest) \= 0 then
do
say "Initialization statement found or format not supported "
say "/*Approximate line is expected to be line# "line_num "in the .h file*/"
out_line = z"%note('Error 29: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Utility does not support initialization statements */"
call do_writeout(out_line)
out_line = z"/* or format encountered is not supported. */"
call do_writeout(out_line)
out_line = z"/* Error: "rest" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment.i)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
/******************************************
* Eliminate const from variable declarations. *
******************************************/
if substr(rest,1,6) = "const" then
do
parse var rest "const" rest
rest = strip(rest)
end
kind2 = ""
kind3 = ""
/**********************************************
* Issue error message for multiplevariable declarations.*
**********************************************/
rest = space(rest,1)
parse var rest kind rest
if pos("_",kind) \= 0 then
kind = check_name(kind)
if pos(",",rest) \= 0 & pos("[",rest) = 0 then
do
say "multiple decl not supported by this utility"
out_line = z"%note('Error 30: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This utility does not support multiple declarations. */"
call do_writeout(out_line)
out_line = z"/* Error: "rest" "mdecl "*/"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
/***************************************************
* Issue error message for user defined FAR and NEAR values. *
****************************************************/
if left(rest,4) = "NEAR" | left(rest,3) ="FAR" then
do
out_line = z"%note('Error 31: Unsupported syntax encountered',4);"
call do_writeout(out_line)
say "Variable dcls with NEAR or FAR is not supported */"
out_line = z"/* Declarations with NEAR or FAR are not supported. */"
call do_writeout(out_line)
out_line = z"/* Error: "rest" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
/******************************************
* Process if * exists for pointer declaration. *
******************************************/
if pos("*",kind) \= 0 | pos("*",rest) \= 0 then
do
select
when left(rest,4) = "near" | left(rest,3) = "far" then do
parse var rest attribute name val ";"
if right(name,1) = "*" & pos("*",val) = 0 then
name = val
else if right(name,1) = "*" & pos("*",val) \= 0 then
do
name = name||val
name = space(name,0)
do while pos("*",name) \= 0
parse var name "*" name
end
end
else if pos("*",name) \= 0 then
do
do while pos("*",name) \= 0
parse var name "*" name
end
end
if substr(name,1,1) = "_" then
name = check_name(name)
end
when pos("*",rest) \= 0 then
do
parse var rest "*" name val ";"
if name = "abnormal" then
name = val" "name
else
if right(name,1) = "*" then
name=val
if pos("*",name) \= 0 then
do
do while pos("*",name) \= 0
parse var name "*" name
end
end
name = strip(name)
if substr(name,1,1) = "_" then
name = check_name(name)
end
when pos("*",kind) \= 0 then do
parse var rest name val ";"
if substr(name,1,1) = "_" then
name = check_name(name)
end
otherwise nop
end /* Do */
/******************************************
* Convert brackets to PL/I mapping. *
******************************************/
if pos("][",name) \= 0 then
do
name= convert_bracket(name)
name = convert_finalbracket(name)
end
name = convert_finalbracket(name)
out_line1 = z"dcl "name" pointer;"
call do_writeout(out_line1)
if cpos \= 0 then
call do_comment(comment)
return
end
/**********************************************
* If the kind is UNSIGNED, STATIC, or SIGNED, *
* then the kind consists of 2 words, so read *
* in another word *
**********************************************/
if translate(kind) = "CONST" then
parse var rest kind rest
/********************************************
* Issue error message for static variable declarations. *
*********************************************/
if translate(kind) = "STATIC" then
do
out_line = z"%note('Error 32: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Error: Static variables are not supported. */"
call do_writeout(out_line)
out_line = z"/* Error: "rest" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end
/******************************************
* Process for non pointer variable declarations. *
******************************************/
if kind = "unsigned" | kind = "signed" then
parse var rest kind2 rest
if kind2 = "long" | kind2 = "short" then
do
parse var rest name '/*' other
if substr(name,1,4) = "int " then
parse var name temp name
end
if kind2 = "int" | kind2 = "char" then
do
parse var rest name '/*' other
end
if kind = "unsigned" | kind = "signed" then
do
if wordpos(kind2,types) = 0 then
do
name = kind2
kind2 = "int"
end
end
if kind = "short" | kind = "long" | kind = "int" | kind = "char" then
do
parse var rest name '/*' other
if substr(name,1,4) = "int " then
parse var name temp name
else
parse var name name
end
if translate(kind) = "CONST" | translate(kind) = "EXTERN" then
parse var rest kind name rest
/*******************************************
* All of the structures are converted *
* to unaligned PL/I structures which *
* are the equivalent of _Packed structures *
*******************************************/
if kind = "_Packed" then
parse var rest kind rest
/**********************************************
* Separate comments from the rest of the line *
**********************************************/
if kind ="unsigned" | kind = "signed" | kind = "_Packed" | kind = "long" | kind = "short" | kind = "int" | kind = "char" then
nop
else
parse var rest name '/*' other
name=space(name,0)
/**********************************************************
* Remove ';' from the line and convert square brackets to PL/I brackets*
**********************************************************/
parse var name name ';'
if pos("][",name) \= 0 then
do
name= convert_bracket(name)
name = convert_finalbracket(name)
end
name = convert_finalbracket(name)
/******************************
* Remove the _ prefix from names *
******************************/
if substr(name,1,1) = "_" then
name = check_name(name)
/*********************************************************
* If kind or kind2 is of character data then routine process_char is *
* invoked to handle all cases of character variable declaration else the *
* routine do_define_var is called to prcocess all other variable *
* declarations. *
*********************************************************/
if kind2 = "char" | kind = "char" then
do
name=space(name,0)
select
when kind = "char" then do
def_val = name
call process_char(def_val);
end
when kind2 = "char" then do
def_val = name" "kind" "kind2
call do_define_var(def_val)
end /* Do */
otherwise
nop /* okay to come here */
end
end
/*********************************************************
* call do_define_var to process any other data type other then char. *
**********************************************************/
else do
define_string = name" "kind" "kind2
call do_define_var(define_string)
end
if cpos \= 0 then
call do_comment(comment)
return
/************************************************************/
/* Remove 0: from character arrays with varyingz syntax. */
/************************************************************/
check_char:
parse arg ar1
parse var ar1 ar1 "(" rest
if substr(rest,1,1) = 0 then
do
len = length(rest)
rest = delstr(rest,1,2)
ar1 = "("||rest
end
return ar1
/************************************************************/
/* Subroutine to process all character variable declarations. */
/************************************************************/
process_char:
parse arg rest
parse var rest name other
if substr(name,1,1) = "*" | substr(name,1,2) = "**" then
do
select
when substr(name,1,2) = "**" & pos("(",name) = 0 then do
name = delstr(name,1,2)
val = "pointer"
end
when substr(name,1,1) = "*" & pos("(",name) = 0 then do
name = delstr(name,1,1)
val="pointer"
end
otherwise
/**********************************************/
/* Issue error message for unsupported syntax */
/**********************************************/
if pos("(",name) \= 0 & pos("*",name) \=0 then
do
say "this kind of definition is not supported"
out_line = z"%note('Error 33: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Utility does not support this kind of definition. */"
call do_writeout(out_line)
out_line = z"/* Error: "line" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end /* Do */
end /* select */
end /* Do */
if pos("(",name) = 0 & val \= "pointer" then
out_line1= z"dcl "name" char;"
else if pos("(",name) = 0 & val = "pointer" then
out_line1= z"dcl "name" pointer;"
else
if pos(',',name) = 0 then
do
lpos = pos('(',name)
bounds = substr(name,lpos)
name = substr(name,1,(lpos - 1))
bounds = check_char(bounds)
if pos("(",bounds) = 1 then
do
len = pos("(",bounds)
if substr(bounds,len+1,1) = ")" then
bounds = "(*)"
end
out_line1= z"dcl "name" character "bounds" varyingz;"
end
else
out_line1 = z"dcl "name" char;"
/***********************************
* Output the definition statements *
***********************************/
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
/************************************
* If there was a comment at the end *
* of the line, convert it *
************************************/
return
/*******************************************************/
/* subroutine to process all other variable declarations */
/*******************************************************/
do_define_var:
parse arg rest
parse var rest name val
if name = "*" then
do
parse var rest ptr name val
name = ptr||name
end
/**********************************************
* Separate comments from the rest of the line *
**********************************************/
parse var val val "/*" other
val = strip(val)
h_val = "char"
/********************************
* Check for pointer definition *
* by looking for a * *
********************************/
if substr(name,1,1) = "*" | substr(name,1,2) = "**" then
do
select
when substr(name,1,2) = "**" & pos("(",name) = 0 then do
name = delstr(name,1,2)
if substr(name,1,1) = "_" then
name = check_name(name)
val = "pointer"
end
when substr(name,1,1) = "*" & pos("(",name) = 0 then do
name = delstr(name,1,1)
if substr(name,1,1) = "_" then
name = check_name(name)
val="pointer"
end
otherwise
if pos("(",name) \= 0 & pos("*",name) \=0 then
do
say "this kind of definition is not supported"
out_line = z"%note('Error 34: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Utility does not support this kind of definition. */"
call do_writeout(out_line)
out_line = z"/* Error: "rest" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end /* Do */
end /* select */
end /* Do */
/*****************************************
* Check to see if the value is *
* one which must be uniquely defined *
*****************************************/
val = special_value(val)
if substr(val,1,1) = "_" then
val = check_name(val)
if pos("abnormal",name) \= 0 then
do
parse var name "abnormal" name
name = name||" abnormal"
end
/***************************************
* Defines the appropriate output statements. *
***************************************/
if flag = "typedval" then
do
out_line1 = z"dcl "name" type "val";"
end
else
out_line1 = z"dcl "name" "val";"
/***********************************
* Output the definition statements *
***********************************/
out_line1 = do_indent(out_line1)
call do_writeout(out_line1)
/************************************
* If there was a comment at the end *
* of the line, convert it *
************************************/
return
/********************************************************************
* Subroutine to indent a line *
********************************************************************/
do_indent:
parse arg line
if indent <= 0 then return line
/**************************************************
* Indent indentation number or spaces for each *
* value of indent. If indentation = 3 and indent *
* = 4 then indent 12 spaces. *
**************************************************/
do indent
line = indentation||line
end
return line
/********************************************************************
* Subroutine to handle a special value in a declaration *
********************************************************************/
special_value:
parse arg val
flag =""
flag_pointer = ""
/***********************************
* This is the PL/I syntax for the different *
* linkage convention *
***********************************/
select
when val = "_Optlink" then
val = "options(linkage (optlink) byvalue nodescriptor) "
when val = "_Far16 _Pascal" then
val = "options(linkage (pascal16) byvalue nodescriptor) "
when val = "_Far16 _Fastcall" then
val = "options(linkage (fastcall16) byvalue nodescriptor) "
when val = "_Far16 _Cdecl" | val = "_Far16" then
val = "options(linkage (cdecl16) byvalue nodescriptor) "
when val = "* _Seg16" then
val = "pointer segmented"
/*****************************************
* This is the PL/I syntax for the System *
* linkage convention *
*****************************************/
when val = "_System" then
val = "options(linkage(system) byvalue nodescriptor) "
when val = "_Pascal" then
val = "options(linkage(pascal) byvalue nodescriptor) "
when val = "void" then
val = " "
when val = "void far *" | val = "void *" | val = "void near *" ,
| val = "far" | val = "near" | val = "void*" then do
val = " pointer"
flag_pointer = true
end
/*******************************************
* This is the PL/I mapping for different C data types*
* linkage convention *
********************************************/
when val = "unsigned" | val = "unsigned long" | val = "unsigned int" then
val = "unsigned fixed bin(31)"
when val = "unsigned short" then
val = "unsigned fixed bin(16)"
when val = "long" then
val = "fixed bin(31)"
when val = "short" then
val = "fixed bin(15)"
when val = "int" then
val = "fixed bin(31)"
when val = "unsigned char" then
val = "char"
when val = "signed char" then
val = "signed fixed bin(7)"
when val = "signed int" | val = "signed long" | val= "signed" then
val = "signed fixed bin(31)"
when val = "signed short" then
val = "signed fixed bin(16)"
when val = "char" then
val = "char"
when val \= "pointer" then flag = "typedval"
otherwise
nop
end
return val
/********************************************************************
* Subroutine to handle a definition with parens *
********************************************************************/
do_paren:
flag_PSZ = false
parse arg name, val
parse var val tilda "(" val
val = strip(val)
len = length(name)
select
/*******************************************
* If there is a left paren in the name, *
* then assume it is a macro definition. *
* Macros are not converted by this utility *
*******************************************/
when pos("(", name) \= 0 then do
out_line = z"%note('Error 35: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Macros are not supported by this utility. */ "
call do_writeout(out_line)
out_line = z"/* Error: "name" "val" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
val = done
end
/***************************************
* If there is a * in the value, assume *
* it is a pointer definition *
***************************************/
when pos("*",val) \= 0 then
val = pointer
/***********************************************
* If the line defines a PSZ whith a hex value, *
* remove the parens *
***********************************************/
when pos("PSZ", val) \= 0 & pos("0X", val) \= 0 then do
parse var val "PSZ)" val ")"
flag_PSZ = true
end
/**************************************************
* If the value is simply enclosed in parens, just *
* convert it *
**************************************************/
when substr(val,1,1) = "(" then do
parse var val "(" val ")" num ")"
val = special_value(val)
num = strip(num)
out_line = z"dcl "name" value ("num")" val";"
out_line = do_indent(out_line)
call do_writeout(out_line)
val = done
end
/***************************************
* Change the ~ to a ^ to conform with *
* PL/I syntax *
***************************************/
when tilda = "~" then
val = "^("val
/*******************************************
* If the value contains an underscore or *
* defines a USHORT, then remove the parens *
*******************************************/
when substr(val,1,1) = "-" then
parse var val val ")"
/***************************************
* Otherwise put the left paren back in *
***************************************/
otherwise do
val = "("val
end
end
/*************************************
* Return the new value as determined *
* by this function *
*************************************/
return val
/********************************************************************
* Subroutine to interpret the condition of an if statement *
********************************************************************/
define_command:
parse arg com
/*************************************
* Check for defined and !defined as *
* conditions for the if statement *
*************************************/
if translate(com) = "DEFINED" | translate(com) = "(DEFINED" then
newcom = " ^= ''"
else if translate(com) = "!DEFINED" | translate(com) = "(!DEFINED" then
newcom = " = ''"
/**********************************************
* If they are not found, keep the C condition *
**********************************************/
else
newcom = com
return newcom
/********************************************************************
* Subroutine to ignore the #error statement *
********************************************************************/
do_error:
parse arg rest
cpos = pos("/*",rest)
if cpos \= 0 then do
comment = substr(rest,cpos)
rest = delstr(rest,cpos)
end
say
say "The #Error command is not converted by this utility"
say "#Error "rest
out_line = z"%note('Error 36: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This definition is not supported by this utility. */ "
call do_writeout(out_line)
out_line = z"/* Error: #Error "rest"*/"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
/********************************************************************
* Subroutine to handle a struct statement or entire declaration of structures unions * *
********************************************************************/
do_real_struct:
/**************************************************
* Start the structure conversion process *
* if a struct statement is used instead of *
* a typedef struct statement. This is similar to *
* the struct case in the do_typedef function *
**************************************************/
parse arg rest
scanline = "volatile"
rest = check_ptrtype(rest)
if pos("(",rest) \= 0 then
do
cpos = pos("/*",rest)
if cpos \= 0 then
do
line = substr(rest,1,cpos-1)
comment = delstr(rest,cpos)
end
else line = rest
if pos(";",line) = 0 then
do
line1 = linein(inputfile)
line_num = line_num + 1
cpos = pos("/*",line1)
if cpos \= 0 then do
line1 = substr(line1,1,cpos-1)
comment = delstr(line1,1,cpos-1)
end
else
comment = ""
line1 = strip(line1)
do while pos(";",line1) = 0
line = line||line1
line1 = linein(inputfile)
line_num = line_num + 1
cpos = pos("/*",line1)
if cpos \= 0 then do
line1 = substr(line1,1,cpos-1)
comment = delstr(line1,1,cpos-1)
end
else comment = ""
line1=strip(line1)
end
line = line||line1
end
/*********************************************
* Error message issued when function return type is *
* struct. *
*********************************************/
out_line = z"%note('Error 37: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This utility does not support declarations with */"
call do_writeout(out_line)
out_line = z"/* return type struct, enum, or union */"
call do_writeout(out_line)
out_line = z"/* Error: "first" "line" */"
call do_writeout(out_line)
if cpos \= 0 & comment \= "" then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end /* Do */
if wordpos(scanline,rest) > 0 then
do
vpos=pos("volatile",rest)
rest = overlay("abnormal",rest,vpos)
end
/*******************************************************
* Single level of struct without tag is given dummy# as tag name. *
********************************************************/
ss_name = "dummy#"
cpos = pos("/*",rest)
if cpos \= 0 then do
comment1 = substr(rest,cpos)
rest = delstr(rest,cpos)
end
rest = space(rest,1)
parse var rest s_name comment
old_sname = s_name
s_name=strip(s_name)
if s_name = "{" | s_name = "" then
do
s_name = ss_name||strt_counter
strt_counter = strt_counter + 1
end
if substr(s_name,1,1) = "_" then
s_name = check_name(s_name);
if pos(";",s_name) \= 0 | substr(comment,1,1) = ";" then
do
cpos = pos("/*",comment)
if cpos \= 0 then do
comment1 = substr(comment,cpos)
comment = delstr(comment,cpos)
end
/*********************************************
* Issue error message for struct forward declarations. *
**********************************************/
out_line = z"%note('Error 38: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This utility does not support forward declarations */"
call do_writeout(out_line)
out_line = z"/* Error:"first" "s_name" "comment" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment1)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end /* Do */
else do
/*********************************************
* Output the initial definition for structure. *
**********************************************/
select
when pos(";",comment) =0 then do
array.i.j = z"define structure "
j = j + 1
if cpos \= 0 then
array.i.j = z" 1 "s_name", "||comment1
else
array.i.j = z" 1 "s_name","
j = j + 1
/*********************************************
* Call do_struct to process rest of the fields. *
**********************************************/
call do_struct
/*********************************************************
* Issue additional define alias statement if struct had typedef struct. *
**********************************************************/
if tflag = "on" & i = 1 then
do
parse var array.1.2 num s_name ","
s_name=strip(s_name)
out_line = z"define alias @"s_name" handle "s_name";"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line =""
if var_name \= "" then
do
parse var array.1.2 num s_name ","
call define_type(var_name)
end
end
/*****************************************************
* If not a typedef struct then process variable list after struct.. *
*****************************************************/
if tflag \= "on" & var_name \= "" then
if i = 1 then
do
parse var array.1.2 num s_name ","
call dcl_structvar(var_name)
end
end
/*********************************************
* processing for just struct variable declarations. *
**********************************************/
when pos(";",comment) \= 0 then do
parse var comment var_name "\*" comment
parse var var_name var_name ";"
call dcl_structvar(var_name)
end /* Do */
otherwise
nop /* error in processing */
end
end
return
/**************************************************************/
/* Structures without tag require a dcl statement rather than a define . */
/**************************************************************/
do_notag:
parse arg rest
parse var rest s_name comment
array.i.j = z"dcl "
j = j + 1
array.i.j = z" 1 * ,"
j = j + 1
call do_struct
return
/***********************************************************/
/* Subroutine to declare structure variables. */
/***********************************************************/
dcl_structvar:
if var_name \= "" then
dflag = false
do while dflag = false
if var_name \= "" then
do
/*********************************************
* Process multiple variable declarations. *
**********************************************/
select
when pos(",",var_name) \= 0 then do
parse var var_name var1 "," var_name
var1 = strip(var1)
end
/********************************
* Process single variable declaration.. *
********************************/
when pos(",",var_name) = 0 then do
parse var var_name var1 ";"
var1 = strip(var1)
if left(var1,1) = "}" then
var1 = delstr(var1,1,1)
var_name = ""
dflag = true
end
otherwise
nop /* error in processing */
end
/************************
* Process pointer definition.. *
************************/
if substr(var1,1,1) = "*" | right(s_name,1,1) = "*" then
do
var1 = space(var1,0)
do while pos("*",var1) \= 0
parse var var1 "*" var1
end
if pos("*",s_name) \= 0 then
do
do while pos("*",s_name) \= 0
parse var s_name s_name "*"
end
end
if substr(var1,1,1) = "_" then
var1 = check_name(var1)
if substr(s_name,1,1) = "_" then
s_name = check_name(s_name)
if pos("abnormal",var1) \= 0 then
do
parse var var1 "abnormal" var1
var1 = var1||" abnormal"
end
/********************************
* Process array definition if it exists.. *
********************************/
if pos("[",var1) \= 0 then
do
if pos("][",var1) \= 0 then
do
var1= convert_bracket(var1)
var1 = convert_finalbracket(var1)
end
else
var1 = convert_finalbracket(var1)
end
out_line = z"dcl "var1" handle" s_name";"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line =""
end
else
if substr(var1,1,1) \= "*" then
do
if pos("[",var1) \= 0 then
do
if pos("][",var1) \= 0 then
do
var1= convert_bracket(var1)
var1 = convert_finalbracket(var1)
end
else
var1 = convert_finalbracket(var1)
end
if substr(var1,1,1) = "_"then
var1 = check_name(var1)
if substr(s_name,1,1) = "_" then
s_name= check_name(s_name)
/*******************************
* Process non pointer struct variable. *
********************************/
out_line = z"dcl "var1" type" s_name";"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line =""
if var_name = "" then dflag = true
end
else if var1 = "" then
dflag = true
end
end
return
/***********************************************************
* Process enum variable declarations because it requires ordinal type. *
***********************************************************/
dcl_enumvar:
if var_name \= "" then do
done1 = false
do while done1=false
if var_name \= "" then
do
/*********************************************
* Process multiple variable declarations. *
**********************************************/
select
when pos(",",var_name) \= 0 then do
parse var var_name var1 "," var_name
var1 = strip(var1)
end
/********************************
* Process single variable declaration.. *
********************************/
when pos(",",var_name) = 0 then do
parse var var_name var1 ";"
var1 = strip(var1)
if left(var1,1) = "}" then
var1 = delstr(var1,1,1)
var_name = ""
done1 = true
end
otherwise
nop
end
/********************************
* Process array definition if it exists.. *
********************************/
if pos("[",var1) \= 0 then
do
if pos("][",var1) \= 0 then
do
var1= convert_bracket(var1)
var1 = convert_finalbracket(var1)
end
else
var1 = convert_finalbracket(var1)
end
/************************
* Process pointer definition.. *
************************/
if substr(var1,1,1) = "*" | right(s_name,1,1) = "*" then
do
var1 = space(var1,0)
do while pos("*",var1) \= 0
parse var var1 "*" var1
end
if pos("*",s_name) \= 0 then
do
do while pos("*",s_name) \= 0
parse var s_name s_name "*"
end /* do */
end
if substr(var1,1,1) = "_" then
var1 = check_name(var1)
if substr(s_name,1,1) = "_" then
s_name = check_name(s_name)
var1 = strip(var1)
s_name = strip(s_name)
out_line = z"dcl "var1" handle" s_name";"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line =""
end
else
if substr(var1,1,1) \= "*" & right(s_name,1,1) \= "*" then
do
if pos("[",var1) \= 0 then
do
if pos("][",var1) \= 0 then
do
var1= convert_bracket(var1)
var1 = convert_finalbracket(var1)
end
else
var1 = convert_finalbracket(var1)
end
/*******************************
* Process non pointer enum variable. *
********************************/
var1 = check_name(var1)
s_name = check_name(s_name)
var1 = strip(var1)
s_name = strip(s_name)
out_line = z"dcl "var1" ordinal" s_name";"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line =""
if var_name ="" then
done1 = true
end
else if var1 = "" then
done1 = true;
end
end
end
return
/**************************************************************
* Process typedef list followed by typedef struct union or enum definition. *
***************************************************************/
define_type:
if var_name \= "" then
done2 = false
do while done2=false
if var_name \= "" then
do
select
when pos(",",var_name) \= 0 then do
parse var var_name var1 "," var_name
var1 = strip(var1)
end
when pos(",",var_name) = 0 then do
parse var var_name var1 ";"
var1 = strip(var1)
var_name = ""
done2 = true
end
otherwise
nop /* error in processing */
end
if substr(var1,1,1) = "*" then
do
var1 = space(var1,0)
do while pos("*",var1) \= 0
parse var var1 "*" var1
end
if pos("*",s_name) \= 0 then
do
do while pos("*",s_name) \= 0
parse var s_name s_name "*"
end /* do */
end
if substr(var1,1,1) = "_" then
var1 = check_name(var1)
if substr(s_name,1,1) = "_" then
s_name = check_name(s_name)
/*******************************
* Process pointer typedefs. *
********************************/
out_line = z"define alias "var1" handle" s_name";"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line =""
end
else
if substr(var1,1,1) \= "*" & translate(var1) \= translate(s_name) then
do
var1 = check_name(var1)
var1 = strip(var1)
s_name = strip(s_name)
/*******************************
* Process non pointer typedef *
********************************/
out_line = z"define alias "var1" type "s_name";"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line = z"define alias @"var1" type @"s_name";"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line =""
end
else if var1 = "" then
done2 = true;
end
end
return
/**************************************************
* Start the UNION conversion process. *
***************************************************/
do_union:
parse arg rest
if pos("(",rest) \= 0 then
do
cpos = pos("/*",rest)
if cpos \= 0 then do
line = substr(rest,1,cpos-1)
comment = delstr(rest,1,cpos-1)
end
else line = rest
if pos(";",line) = 0 then
do
line1 = linein(inputfile)
line_num = line_num + 1
cpos = pos("/*",line1)
if cpos \= 0 then
do
line1 = substr(line1,1,cpos-1)
comment = ""
cpos = 0
end
line1 = strip(line1)
do while pos(";",line1) = 0
line = line||line1
line1 = linein(inputfile)
line_num = line_num + 1
cpos = pos("/*",line1)
if cpos \= 0 then
do
line1 = substr(line1,1,cpos-1)
comment = ""
cpos = 0
end
line1=strip(line1)
end
line = line||line1
end
/*****************************************************
* Issue error message for functions with return types as union. *
*****************************************************/
out_line = z"%note('Error 39: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This utility does not support declarations with */"
call do_writeout(out_line)
out_line = z"/* return type struct, enum, or union */"
call do_writeout(out_line)
out_line = z"/* Error: "first" "line" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end /* Do */
parse var rest s_name comment
ss_name ="dummy#"
s_name = strip(s_name)
s_name = check_name(s_name)
/********************************************
* Issue error message for enum forward declaration. *
********************************************/
if pos(";",s_name) \= 0 | substr(comment,1,1) = ";" then
do
cpos = pos("/*",comment)
if cpos \= 0 then do
comment1 = substr(comment,cpos)
comment = delstr(comment,cpos)
end
out_line = z"%note('Error 40: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* This utility does not support forward declarations */"
call do_writeout(out_line)
out_line = z"/* Error:"first" "s_name" "comment" */"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment1)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
end /* Do */
/*******************************
* Union without tag give dummy name*
********************************/
if s_name = "" | s_name = "{" then
do
s_name = ss_name||strt_counter
strt_counter = strt_counter + 1
end
select
when pos(";",comment) =0 then do
array.i.j = z"define structure "
j = j + 1
array.i.j = z"1 "s_name" union,"
j = j + 1
call do_struct
if tflag = "on" & i = 1 then
do
parse var array.1.2 num s_name junk
s_name = strip(s_name)
s_name=check_name(s_name)
out_line = z"define alias @"s_name" handle "s_name";"
out_line = do_indent(out_line)
call do_writeout(out_line)
out_line =""
if var_name \= "" then
do
parse var array.1.2 num s_name ","
parse var s_name s_name temp
call define_type(var_name)
end
end
if i = 1 & tflag \= "on" then
do
parse var array.1.2 num s_name u_name","
call dcl_structvar(var_name)
end
end
when pos(";",comment) \= 0 then do
parse var comment var_name "\*" comment
parse var var_name var_name ";"
call dcl_structvar(var_name)
end /* Do */
otherwise
nop /* error in processing */
end
return
/**************************************************************/
/* #elseif statements are not supported by this utility. */
/**************************************************************/
do_elseif:
parse arg rest
cpos = pos("/*",rest)
if cpos \= 0 then
do
comment = substr(rest,cpos)
rest = delstr(rest,cpos)
end /* Do */
out_line = z"%note('Error 41: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Error: #elseif statements are not supported by this utility. */"
call do_writeout(out_line)
out_line = z"/* Error: #elseif "rest"*/"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
/**************************************************************/
/* #line statements are not supported by this utility. */
/**************************************************************/
do_line:
parse arg rest
cpos = pos("/*",rest)
if cpos \= 0 then
do
comment = substr(rest,cpos)
rest = delstr(rest,cpos)
end /* Do */
out_line = z"%note('Error 42: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Error: #line or # statements are not supported by this utility. */"
call do_writeout(out_line)
out_line = z"/* Error: #line or # "rest"*/"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = " "
call do_writeout(out_line)
return
/**************************************************************/
/* #elif statements are not supported by this utility. */
/**************************************************************/
do_elif:
parse arg rest
cpos = pos("/*",rest)
if cpos \= 0 then
do
comment = substr(rest,cpos)
rest = delstr(rest,cpos)
end /* Do */
out_line = z"%note('Error 43: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Error: #elif statements are not supported by this utility. */"
call do_writeout(out_line)
out_line = z"/* Error: #elif "rest"*/"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
return
/**************************************************************/
/* Somextern statements are not supported by this utility. */
/**************************************************************/
do_som:
parse arg rest
cpos = pos("/*",rest)
if cpos \= 0 then
do
comment = substr(rest,cpos)
rest = delstr(rest,cpos)
end /* Do */
out_line = z"%note('Error 44: Unsupported syntax encountered',4);"
call do_writeout(out_line)
out_line = z"/* Error: Somextern statements are not supported by this utility. */"
call do_writeout(out_line)
out_line = z"/* Error: Somextern "rest"*/"
call do_writeout(out_line)
if cpos \= 0 then
call do_comment(comment)
out_line = z"/* The original line in the .h file is: "line_num" */"
call do_writeout(out_line)
out_line = ""
call do_writeout(out_line)
exit
