diff --git a/src/win32k/kKrnlLib/tools/ProcessZip.cmd b/src/win32k/kKrnlLib/tools/ProcessZip.cmd index 10c896b..952537d 100644 --- a/src/win32k/kKrnlLib/tools/ProcessZip.cmd +++ b/src/win32k/kKrnlLib/tools/ProcessZip.cmd @@ -1,329 +1,329 @@ -/* $Id: ProcessZip.cmd,v 1.1 2002-04-07 01:44:47 bird Exp $ - * - * Testcase Zipped Kernel Processer. - * - * Copyright (c) 2002 knut st. osmundsen (bird@anduin.net) - * - * GPL - * - */ - -/* - * Config. - */ -sSyms = 'h:\kernels\syms'; -sSDFs = 'h:\kernels\sdfs'; -sPMDF = 'f:\pmdf'; - -/* Temp dir. */ -sTmp = value('TMP',,'OS2ENVIRONMENT'); -if (sTmp = '') then - sTmp = value('TEMP',,'OS2ENVIRONMENT'); -if (sTmp = '') then - sTmp = value('TMPDIR',,'OS2ENVIRONMENT'); -if (sTmp = '') then -do - say 'No TMP/TEMP/TMPDIR env variable.' - exit(2); -end - - -/* - * Input - */ -parse arg sZip sDummy - -if ((sZip = '') | (sDummy <> '') | (stream(sZip, 'c', 'query exist') = '')) then -do - say 'Syntax error or invalid filename!' - say 'Syntax: ProcessZip.cmd ' - exit(1); -end - - -/* - * zip type? - */ -if (translate(substr(filespec('name', sZip), 1, 2)) = 'DF' ) then - rc = ProcessDumpFormatterZip(sZip); -else - rc = ProcessKernelZip(sZip); -exit rc; - - - -/** - * Extracts os2krnl and os2krnl.sym to the syms directory. - */ -ProcessKernelZip: procedure expose sSyms; - parse arg sZip - /* - * Get the build number. - */ - queTmp = RxQueue('Create'); - queOld = RxQueue('Set', queTmp); - Address CMD 'unzip -p' sZip 'os2krnl | grep "Internal revision" | sed "s/.*Internal revision[ \t]*//" | cut -b1-10 | RxQueue' queTmp - sBuild = ''; - if (queued() > 0) then - parse pull sBuild - call RxQueue 'Delete', RxQueue('Set', queOld); - if (sBuild = '') then - do - say 'couldn''t determin build number.' sZip - return(3); - end - rc = InterpretInternalRevision(sBuild); - - - /* get kernel build type */ - queTmp = RxQueue('Create'); - queOld = RxQueue('Set', queTmp); - Address CMD 'unzip -p' sZip 'os2krnl | grep "SAB KNL" | sed "s/.*SAB KNL//" | cut -b1 | RxQueue' queTmp - chBuildType = ''; - if (queued() > 0) then - pull chBuildType - call RxQueue 'Delete', RxQueue('Set', queOld); - if (sBuild = '') then - do - say 'couldn''t determin build type.' sZip - return(3); - end - - - /* - * Construct base filename - */ - sBase = sSyms||'\'||uBuild||chBuildType||chType||chRev - say sBase - - - /* - * Skip if allready exists. - */ - if ( (stream(sBase||'.sym', 'c', 'query exist') <> '') & (stream(sBase, 'c', 'query exist') <> '') ) then - do - say 'nothing to do' sZip; - return(0); - end - - /* - * Extract the files. - */ - rcExit = 0; - Address CMD 'unzip -p' sZip 'os2krnl >' sBase - if (rc <> 0) then - do - say 'Error: failed to extract kernel file. rc='rc; - rcExit = rc; - end - else - Address CMD 'attrib +r' sBase - - Address CMD 'unzip -p' sZip 'os2krnl.sym >' sBase||'.sym' - if (rc <> 0) then - do - say 'Error: failed to extract symbol file. rc='rc; - rcExit = rc; - end - else - Address CMD 'attrib +r' sBase||'.sym' - -return(rcExit); - - - - -/** - * Extracts the .sdf files to the sdfs directory. - * Extracts all the stuff to the pmdf directory and updates pmdfvers.lst. - */ -ProcessDumpFormatterZip: procedure expose sSDFs sPMDF sTmp; - parse arg sZip - - /* - * Get content list and extract the first .exe file. - */ - rc = ListZip(sZip); - - iExe = 0; - do i = 1 to asFiles.0 - if (translate(right(asFiles.i, 4)) = '.EXE') then - do - iExe = i; - leave; - end - end - if (iExe = 0) then - do - say 'Invalid zip, didn''t find any .exe files.' sZip; - return 10; - end - - Address CMD 'unzip -p' sZip asFiles.iExe '>' sTmp'\Tmpdf.exe'; - - /* - * Get the build number. - */ - queTmp = RxQueue('Create'); - queOld = RxQueue('Set', queTmp); - Address CMD sTmp'\Tmpdf.exe | grep "Internal revision" | sed "s/.*Internal revision[ \t]*//" | RxQueue' queTmp - sBuild = ''; - if (queued() > 0) then - parse pull sBuild - call RxQueue 'Delete', RxQueue('Set', queOld); - if (sBuild = '') then - do - say 'couldn''t determin build number.' sZip - return(3); - end - rc = InterpretInternalRevision(sBuild); - - - /* - * Extract the .sdf. - */ - do i = 1 to asFiles.0 - if (translate(right(asFiles.i, 4)) = '.SDF') then - do - /* - * Type. - */ - chType = translate(substr(asFiles.i, 1, 1)); - if (chType = 'W') then - chType = 'W4'; - else if ((chType <> 'S') & (chType <> 'U')) then - do - say 'invalid sub directory:' asFiles.i; - return 11; - end - - /* - * Construct filename - */ - sFilename = sSdfs||'\'||uBuild||'_'||chType'_'; - if (chRev <> '') then - sFilename = sFilename||chRev||'_'; - sFilename = sFilename || filespec('name', asFiles.i); - say sFilename; - if (stream(sFilename, 'c', 'query exist') = '') then - do - Address CMD 'unzip -p' sZip asFiles.i '>' sFilename; - if (rc <> 0) then - do - say 'extract of' asFiles.i '->' sFilename' failed. rc='rc; - rcExit = rc; - end - Address CMD 'attrib +r' sFilename; - end - end - end - - - - /* - * PMDF. - */ - sPMDFListDirs = ''; - fSkipDir = 1; - do i = 1 to asFiles.0 - /* - * Is the first file in that directory? - */ - sDir = strip(strip(filespec('path', asFiles.i), 'B', '\'), 'B', '/'); - if (pos(sDir, sPMDFListDirs) <= 0) then - do - sPMDFListDirs = sPMDFListDirs ||' ; '||sDir; - - /* - * Check if df_ret.exe exists - if so, nothing to do. - */ - if (stream(sPMDF||'\'||sDir||'df_ret.exe', 'c', 'query exist') <> '') then - fSkipDir = 1; - else - fSkipDir = 0; - - /* - * Create directory and add it to pmdfvers.lst. - */ - if (\fSkipDir) then - do - Address CMD 'mkdir' sPMDF||'\'||sDir; - Address CMD 'echo' sDir||';'||sBuild||';'||sBuild '>>' sPMDF'\pmdfvers.lst'; - end - end - - /* - * Extract the file. - */ - if (\fSkipDir) then - do - Address CMD 'unzip -p' sZip asFiles.i '>' sPMDF||'\'||sDir||'\'||filespec('name', asFiles.i); - end - end - -return(rcExit); - - - -/** - * Gets the zip content listing. - */ -ListZip: procedure expose asFiles.; - parse arg sZip - queTmp = RxQueue('Create'); - queOld = RxQueue('Set', queTmp); - Address CMD 'unzip -v' sZip '| RxQueue' queTmp - asFiles.0 = 0; - fFiles = 0; - do while (queued() > 0) - parse pull sLine - sLine = strip(sLine); - /* check for start/end of file listing */ - if (substr(sLine, 1, 1) = '-') then - do - fFiles = fFiles + 1; - iterate; - end - - /* in file listing? */ - if (fFiles = 1) then - do - asFiles.0 = asFiles.0 + 1; - i = asFiles.0; - parse var sLine . . . . . . . asFiles.i - asFiles.i = strip(asFiles.i, 'L'); - end - end - call RxQueue 'Delete', RxQueue('Set', queOld); -return 0; - - -/** - * Get build number, revision and type. - */ -InterpretInternalRevision: procedure expose uBuild chRev chType; - parse arg sBuild - - /* got a 10 byte string like 14.086c_UN */ - parse upper var sBuild iHigh'.'sLow'_'sType with - uBuild = substr(sLow, 1, 3) + iHigh*1000; - chRev = '' - if (length(sLow) > 3) then - chRev = substr(sLow, 4, 1); - - select - when (substr(sType, 1, 1) = 'U') then - chType = 'U' - when (substr(sType, 1, 1) = 'S') then - chType = 'S' - when (substr(sType, 1, 1) = 'W') then - chType = '4' - otherwise - do - say 'fatal error: unknown kernel type: '''sType'''' - say 'sBulid =' sBuild - exit(4); - end - end -return 0; - +/* $Id: ProcessZip.cmd,v 1.1 2002-04-07 01:44:47 bird Exp $ + * + * Testcase Zipped Kernel Processer. + * + * Copyright (c) 2002 knut st. osmundsen (bird@anduin.net) + * + * GPL + * + */ + +/* + * Config. + */ +sSyms = 'h:\kernels\syms'; +sSDFs = 'h:\kernels\sdfs'; +sPMDF = 'f:\pmdf'; + +/* Temp dir. */ +sTmp = value('TMP',,'OS2ENVIRONMENT'); +if (sTmp = '') then + sTmp = value('TEMP',,'OS2ENVIRONMENT'); +if (sTmp = '') then + sTmp = value('TMPDIR',,'OS2ENVIRONMENT'); +if (sTmp = '') then +do + say 'No TMP/TEMP/TMPDIR env variable.' + exit(2); +end + + +/* + * Input + */ +parse arg sZip sDummy + +if ((sZip = '') | (sDummy <> '') | (stream(sZip, 'c', 'query exist') = '')) then +do + say 'Syntax error or invalid filename!' + say 'Syntax: ProcessZip.cmd ' + exit(1); +end + + +/* + * zip type? + */ +if (translate(substr(filespec('name', sZip), 1, 2)) = 'DF' ) then + rc = ProcessDumpFormatterZip(sZip); +else + rc = ProcessKernelZip(sZip); +exit rc; + + + +/** + * Extracts os2krnl and os2krnl.sym to the syms directory. + */ +ProcessKernelZip: procedure expose sSyms; + parse arg sZip + /* + * Get the build number. + */ + queTmp = RxQueue('Create'); + queOld = RxQueue('Set', queTmp); + Address CMD 'unzip -p' sZip 'os2krnl | grep "Internal revision" | sed "s/.*Internal revision[ \t]*//" | cut -b1-10 | RxQueue' queTmp + sBuild = ''; + if (queued() > 0) then + parse pull sBuild + call RxQueue 'Delete', RxQueue('Set', queOld); + if (sBuild = '') then + do + say 'couldn''t determin build number.' sZip + return(3); + end + rc = InterpretInternalRevision(sBuild); + + + /* get kernel build type */ + queTmp = RxQueue('Create'); + queOld = RxQueue('Set', queTmp); + Address CMD 'unzip -p' sZip 'os2krnl | grep "SAB KNL" | sed "s/.*SAB KNL//" | cut -b1 | RxQueue' queTmp + chBuildType = ''; + if (queued() > 0) then + pull chBuildType + call RxQueue 'Delete', RxQueue('Set', queOld); + if (sBuild = '') then + do + say 'couldn''t determin build type.' sZip + return(3); + end + + + /* + * Construct base filename + */ + sBase = sSyms||'\'||uBuild||chBuildType||chType||chRev + say sBase + + + /* + * Skip if allready exists. + */ + if ( (stream(sBase||'.sym', 'c', 'query exist') <> '') & (stream(sBase, 'c', 'query exist') <> '') ) then + do + say 'nothing to do' sZip; + return(0); + end + + /* + * Extract the files. + */ + rcExit = 0; + Address CMD 'unzip -p' sZip 'os2krnl >' sBase + if (rc <> 0) then + do + say 'Error: failed to extract kernel file. rc='rc; + rcExit = rc; + end + else + Address CMD 'attrib +r' sBase + + Address CMD 'unzip -p' sZip 'os2krnl.sym >' sBase||'.sym' + if (rc <> 0) then + do + say 'Error: failed to extract symbol file. rc='rc; + rcExit = rc; + end + else + Address CMD 'attrib +r' sBase||'.sym' + +return(rcExit); + + + + +/** + * Extracts the .sdf files to the sdfs directory. + * Extracts all the stuff to the pmdf directory and updates pmdfvers.lst. + */ +ProcessDumpFormatterZip: procedure expose sSDFs sPMDF sTmp; + parse arg sZip + + /* + * Get content list and extract the first .exe file. + */ + rc = ListZip(sZip); + + iExe = 0; + do i = 1 to asFiles.0 + if (translate(right(asFiles.i, 4)) = '.EXE') then + do + iExe = i; + leave; + end + end + if (iExe = 0) then + do + say 'Invalid zip, didn''t find any .exe files.' sZip; + return 10; + end + + Address CMD 'unzip -p' sZip asFiles.iExe '>' sTmp'\Tmpdf.exe'; + + /* + * Get the build number. + */ + queTmp = RxQueue('Create'); + queOld = RxQueue('Set', queTmp); + Address CMD sTmp'\Tmpdf.exe | grep "Internal revision" | sed "s/.*Internal revision[ \t]*//" | RxQueue' queTmp + sBuild = ''; + if (queued() > 0) then + parse pull sBuild + call RxQueue 'Delete', RxQueue('Set', queOld); + if (sBuild = '') then + do + say 'couldn''t determin build number.' sZip + return(3); + end + rc = InterpretInternalRevision(sBuild); + + + /* + * Extract the .sdf. + */ + do i = 1 to asFiles.0 + if (translate(right(asFiles.i, 4)) = '.SDF') then + do + /* + * Type. + */ + chType = translate(substr(asFiles.i, 1, 1)); + if (chType = 'W') then + chType = 'W4'; + else if ((chType <> 'S') & (chType <> 'U')) then + do + say 'invalid sub directory:' asFiles.i; + return 11; + end + + /* + * Construct filename + */ + sFilename = sSdfs||'\'||uBuild||'_'||chType'_'; + if (chRev <> '') then + sFilename = sFilename||chRev||'_'; + sFilename = sFilename || filespec('name', asFiles.i); + say sFilename; + if (stream(sFilename, 'c', 'query exist') = '') then + do + Address CMD 'unzip -p' sZip asFiles.i '>' sFilename; + if (rc <> 0) then + do + say 'extract of' asFiles.i '->' sFilename' failed. rc='rc; + rcExit = rc; + end + Address CMD 'attrib +r' sFilename; + end + end + end + + + + /* + * PMDF. + */ + sPMDFListDirs = ''; + fSkipDir = 1; + do i = 1 to asFiles.0 + /* + * Is the first file in that directory? + */ + sDir = strip(strip(filespec('path', asFiles.i), 'B', '\'), 'B', '/'); + if (pos(sDir, sPMDFListDirs) <= 0) then + do + sPMDFListDirs = sPMDFListDirs ||' ; '||sDir; + + /* + * Check if df_ret.exe exists - if so, nothing to do. + */ + if (stream(sPMDF||'\'||sDir||'df_ret.exe', 'c', 'query exist') <> '') then + fSkipDir = 1; + else + fSkipDir = 0; + + /* + * Create directory and add it to pmdfvers.lst. + */ + if (\fSkipDir) then + do + Address CMD 'mkdir' sPMDF||'\'||sDir; + Address CMD 'echo' sDir||';'||sBuild||';'||sBuild '>>' sPMDF'\pmdfvers.lst'; + end + end + + /* + * Extract the file. + */ + if (\fSkipDir) then + do + Address CMD 'unzip -p' sZip asFiles.i '>' sPMDF||'\'||sDir||'\'||filespec('name', asFiles.i); + end + end + +return(rcExit); + + + +/** + * Gets the zip content listing. + */ +ListZip: procedure expose asFiles.; + parse arg sZip + queTmp = RxQueue('Create'); + queOld = RxQueue('Set', queTmp); + Address CMD 'unzip -v' sZip '| RxQueue' queTmp + asFiles.0 = 0; + fFiles = 0; + do while (queued() > 0) + parse pull sLine + sLine = strip(sLine); + /* check for start/end of file listing */ + if (substr(sLine, 1, 1) = '-') then + do + fFiles = fFiles + 1; + iterate; + end + + /* in file listing? */ + if (fFiles = 1) then + do + asFiles.0 = asFiles.0 + 1; + i = asFiles.0; + parse var sLine . . . . . . . asFiles.i + asFiles.i = strip(asFiles.i, 'L'); + end + end + call RxQueue 'Delete', RxQueue('Set', queOld); +return 0; + + +/** + * Get build number, revision and type. + */ +InterpretInternalRevision: procedure expose uBuild chRev chType; + parse arg sBuild + + /* got a 10 byte string like 14.086c_UN */ + parse upper var sBuild iHigh'.'sLow'_'sType with + uBuild = substr(sLow, 1, 3) + iHigh*1000; + chRev = '' + if (length(sLow) > 3) then + chRev = substr(sLow, 4, 1); + + select + when (substr(sType, 1, 1) = 'U') then + chType = 'U' + when (substr(sType, 1, 1) = 'S') then + chType = 'S' + when (substr(sType, 1, 1) = 'W') then + chType = '4' + otherwise + do + say 'fatal error: unknown kernel type: '''sType'''' + say 'sBulid =' sBuild + exit(4); + end + end +return 0; + diff --git a/src/win32k/kKrnlLib/tools/TestKernels.cmd b/src/win32k/kKrnlLib/tools/TestKernels.cmd index cde7eed..d0acbc0 100644 --- a/src/win32k/kKrnlLib/tools/TestKernels.cmd +++ b/src/win32k/kKrnlLib/tools/TestKernels.cmd @@ -1,138 +1,138 @@ -/* $Id: TestKernels.cmd,v 1.1 2002-03-31 19:30:41 bird Exp $ - * - * This script loops thru a set of different kernels running testcase 1. - * Note: The kernels and symbols files are in a single directory - * Name format - * nnnn[n]bk[.SYM] - * - * nnnn[n] Build number. (4 or 5 digits). (ex. 9036) - * b Build type: A - allstrict; H - halfstrict; R - retail (GA) - * k Kernel type: U - uniprocess; S - smp; 4 - warp 4 fixpack 13+ - * [.SYM] Kernel files has no extention while the symbol files has .SYM. - */ - - call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; - call SysLoadFuncs; - - parse arg sR3Tst sDir sdummy - if (sR3Tst = '' | sDir = '' | sDir = '-?' | sDir = '/?' | sDir = '-h' | sDir = '-H' , - | sDir = '/h' | sDir = '/H' | sDir = '--help') then - do - call syntax; - exit -1; - end - - /* - * Read directory - */ - rc = SysFileTree(sDir'\*', 'asFiles', 'FO'); - if (rc <> 0) then - do - say 'SysFileTree failed with rc='rc'.'; - exit -2; - end - if (asFiles.0 <= 0) then - do - say 'No files found'; - exit -3; - end - - iRetCode = 0; - do i = 1 to asFiles.0 - /* - * Interpret name (get build no., kernel type and build type). - */ - sName = translate(filespec('name', asFiles.i)); - if (lastpos('.', sName) > 0) then - do - sExt = substr(sName, lastpos('.', sName) + 1); - sName = substr(sName, 1, lastpos('.', sName) - 1); - end - else - sExt = ''; - - if (sExt <> '') then - iterate - - if (substr(sName, 5, 1) <= '9') then cchBuild = 5; - else cchBuild = 4; - iBuild = substr(sName, 1, cchBuild); - chBuildType = substr(sName, cchBuild + 1, 1); - chKernelType = substr(sName, cchBuild + 2, 1); - chRev = substr(sName, cchBuild + 3, 1); - - /* - * Validate name. - */ - do j = 1 to length(iBuild) - if (substr(iBuild, j, 1) < '0' | substr(iBuild, j, 1) > '9') then - do - j = -1; - leave; - end - end - if (j = -1) then - iterate; - - if (chBuildType <> 'A' & chBuildType <> 'H' & chBuildType <> 'R') then - do - say 'invalid build type char:' chBuildType '('asFiles.i')'; - exit -4; - end - - if (chKernelType <> 'U' & chKernelType <> 'S' & chKernelType <> '4') then - do - say 'invalid kernel type char:' chKernelType '('asFiles.i')'; - exit -4; - end - - /* - * Determin version number (based on build number). - */ - iVerMajor = 2; - if (iBuild >= 14000) then - iVerMinor = 45; - else if (iBuild >= 9000) then - iVerMinor = 40; - else if (iBuild >= 8000) then - iVerMinor = 30; - else if (iBuild >= 6200) then - iVerMinor = 21; - else - do - say 'unsupported build number:' iBuild '('asFiles.i')'; - exit(-5); - end - - /* - * Process it - */ - say; - say; - say 'Processing' asFiles.i'....'; - if (chBuildType = 'R') then - sCmd = sR3Tst '1' asFiles.i iVerMajor iVerMinor iBuild chKernelType chBuildType chRev; - else - sCmd = sR3Tst '1' asFiles.i iVerMajor iVerMinor iBuild chKernelType chBuildType chRev asFiles.i||'.SYM'; - say sCmd; - sCmd; - if (rc <> 0) then - do - say 'failed... rc='rc; - say 'cmd:' sCmd - exit rc; - end - - end - - exit(0); - - - - -/* - * Write syntax: - */ -syntax: procedure; - say 'TestKernels.cmd '; +/* $Id: TestKernels.cmd,v 1.1 2002-03-31 19:30:41 bird Exp $ + * + * This script loops thru a set of different kernels running testcase 1. + * Note: The kernels and symbols files are in a single directory + * Name format + * nnnn[n]bk[.SYM] + * + * nnnn[n] Build number. (4 or 5 digits). (ex. 9036) + * b Build type: A - allstrict; H - halfstrict; R - retail (GA) + * k Kernel type: U - uniprocess; S - smp; 4 - warp 4 fixpack 13+ + * [.SYM] Kernel files has no extention while the symbol files has .SYM. + */ + + call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; + call SysLoadFuncs; + + parse arg sR3Tst sDir sdummy + if (sR3Tst = '' | sDir = '' | sDir = '-?' | sDir = '/?' | sDir = '-h' | sDir = '-H' , + | sDir = '/h' | sDir = '/H' | sDir = '--help') then + do + call syntax; + exit -1; + end + + /* + * Read directory + */ + rc = SysFileTree(sDir'\*', 'asFiles', 'FO'); + if (rc <> 0) then + do + say 'SysFileTree failed with rc='rc'.'; + exit -2; + end + if (asFiles.0 <= 0) then + do + say 'No files found'; + exit -3; + end + + iRetCode = 0; + do i = 1 to asFiles.0 + /* + * Interpret name (get build no., kernel type and build type). + */ + sName = translate(filespec('name', asFiles.i)); + if (lastpos('.', sName) > 0) then + do + sExt = substr(sName, lastpos('.', sName) + 1); + sName = substr(sName, 1, lastpos('.', sName) - 1); + end + else + sExt = ''; + + if (sExt <> '') then + iterate + + if (substr(sName, 5, 1) <= '9') then cchBuild = 5; + else cchBuild = 4; + iBuild = substr(sName, 1, cchBuild); + chBuildType = substr(sName, cchBuild + 1, 1); + chKernelType = substr(sName, cchBuild + 2, 1); + chRev = substr(sName, cchBuild + 3, 1); + + /* + * Validate name. + */ + do j = 1 to length(iBuild) + if (substr(iBuild, j, 1) < '0' | substr(iBuild, j, 1) > '9') then + do + j = -1; + leave; + end + end + if (j = -1) then + iterate; + + if (chBuildType <> 'A' & chBuildType <> 'H' & chBuildType <> 'R') then + do + say 'invalid build type char:' chBuildType '('asFiles.i')'; + exit -4; + end + + if (chKernelType <> 'U' & chKernelType <> 'S' & chKernelType <> '4') then + do + say 'invalid kernel type char:' chKernelType '('asFiles.i')'; + exit -4; + end + + /* + * Determin version number (based on build number). + */ + iVerMajor = 2; + if (iBuild >= 14000) then + iVerMinor = 45; + else if (iBuild >= 9000) then + iVerMinor = 40; + else if (iBuild >= 8000) then + iVerMinor = 30; + else if (iBuild >= 6200) then + iVerMinor = 21; + else + do + say 'unsupported build number:' iBuild '('asFiles.i')'; + exit(-5); + end + + /* + * Process it + */ + say; + say; + say 'Processing' asFiles.i'....'; + if (chBuildType = 'R') then + sCmd = sR3Tst '1' asFiles.i iVerMajor iVerMinor iBuild chKernelType chBuildType chRev; + else + sCmd = sR3Tst '1' asFiles.i iVerMajor iVerMinor iBuild chKernelType chBuildType chRev asFiles.i||'.SYM'; + say sCmd; + sCmd; + if (rc <> 0) then + do + say 'failed... rc='rc; + say 'cmd:' sCmd + exit rc; + end + + end + + exit(0); + + + + +/* + * Write syntax: + */ +syntax: procedure; + say 'TestKernels.cmd '; return; \ No newline at end of file diff --git a/src/win32k/kKrnlLib/tools/pmdfrexx/pm.cmd b/src/win32k/kKrnlLib/tools/pmdfrexx/pm.cmd index 5fac2ce..16d6772 100644 --- a/src/win32k/kKrnlLib/tools/pmdfrexx/pm.cmd +++ b/src/win32k/kKrnlLib/tools/pmdfrexx/pm.cmd @@ -1,1578 +1,1578 @@ -/**/ - - -/* - * Init stuff. - */ -signal on NoValue Name SignalHanlder_NoValue; -NUMERIC DIGITS 11 - - -/* - * Globals - */ -sGlobals = 'ulHandleTable aProc. sGlobals'; -ulHandleTable = 0; -aProc.0 = 0; /* process table */ - - -/* - * Args - */ -parse arg sCmd sArgs -sCmd = lowercase(sCmd); -sArg = lowercase(sArgs); -say ''; - - -/* - * Operation - */ -select - /* - * pmsems - */ - when (sCmd = 'pmsemcheck') then - return pmsemCheck(sArgs); - when (sCmd = 'pmsemdump') then - return pmsemDump(sArgs); - when (sCmd = 'pmsemdumpall') then - return PmsemDumpAll(sArgs); - - /* - * Windows Structures. - */ - when (sCmd = 'wnddump') then - return wndDump(sArgs); - - /* - * Window handles. - */ - when (sCmd = 'hwnd') then - return hwnd2PWND(sArgs); - - /* - * PM stuff - */ - when (sCMD = 'pmstatus') then - return PmStatus(sArgs); - - /* - * Generic dump - */ - when (sCmd = 'dump' | sCmd = '.d') then - do - parse var sArgs sStruct sDumperArgs - select - when (sStruct = 'mq') then - return MqDump(sDumperArgs); - when (sStruct = 'pmsem') then - return PmsemDump(sDumperArgs); - when (sStruct = 'qmsg') then - return QmsgDump(sDumperArgs); - when (sStruct = 'sms') then - return SmsDump(sDumperArgs); - when (sStruct = 'sqmsg') then - return SqmsgDump(sDumperArgs); - when (sStruct = 'wnd') then - return WndDump(sDumperArgs); - - otherwise - say 'syntax error: no or invalid structure name.'; - return syntax(sArgs); - end - end - - - /* - * Help and syntax error. - */ - when (sCmd = '?' | sCmd = 'help' | sCmd = '-?' | sCmd = '/?' | sCmd = '-h' | sCmd = '/h' | sCmd = '--help') then - return syntax(sArgs); - otherwise - say 'syntax error: no or invalid command' - return syntax(sArgs); - end -exit(0) - -/** - * Display usage syntax: - */ -syntax: procedure; - parse source . . sSource; - sName = filespec('name', sSource); - say 'PMDF PM Rexx Utils v0.0.1'; - say 'syntax: %'sName' [args]'; - say 'command:' - say ' checksems Check the PM semaphores'; -return -1; - -/* Procedure which we signals on user syntax errors. */ -synatxerror: - say 'syntax error!' - call syntax; -return -1; - - - -/* - * PMSEMS/GRESEMS - * PMSEMS/GRESEMS - * PMSEMS/GRESEMS - * PMSEMS/GRESEMS - * PMSEMS/GRESEMS - * PMSEMS/GRESEMS - * PMSEMS/GRESEMS - * PMSEMS/GRESEMS - * PMSEMS/GRESEMS - */ -/* access functions */ -pmsemSize: procedure expose(sGlobals); return 32; -pmsemIdent: procedure expose(sGlobals); parse arg iSem, sMem; return memString(iSem * 32, 7, 1, sMem); -pmsem386: procedure expose(sGlobals); parse arg iSem, sMem; return memByte( iSem * 32 + 7, sMem); -pmsemPid: procedure expose(sGlobals); parse arg iSem, sMem; return memWord( iSem * 32 + 8, sMem); -pmsemTid: procedure expose(sGlobals); parse arg iSem, sMem; return memWord( iSem * 32 + 10, sMem); -pmsemPTid: procedure expose(sGlobals); parse arg iSem, sMem; return memDWord(iSem * 32 + 8, sMem); -pmsemNested: procedure expose(sGlobals); parse arg iSem, sMem; return memDword(iSem * 32 + 12, sMem); -pmsemWaiting: procedure expose(sGlobals); parse arg iSem, sMem; return memDword(iSem * 32 + 16, sMem); -pmsemUseCount: procedure expose(sGlobals); parse arg iSem, sMem; return memDword(iSem * 32 + 20, sMem);/*debug*/ -pmsemHEV: procedure expose(sGlobals); parse arg iSem, sMem; return memDword(iSem * 32 + 24, sMem); -pmsemCallAddr: procedure expose(sGlobals); parse arg iSem, sMem; return memDword(iSem * 32 + 28, sMem);/*debug*/ - - -/** - * Structure dumper. - * @param sSemMem 32 byte memory block (at least) containing the PMSEM to dump. - * @parma sMsg Optional description message. (optional) - * @param iSem The sem we're dumping. (optional) - */ -pmsemDump1: procedure expose(sGlobals) -parse arg sSemMem, sMsg, iSem - if (iSem <> '') then - say sMsg 'PMSEM/GRESEM -' pmsemGetName(iSem); - else - say sMsg 'PMSEM/GRESEM'; - say ' acIdent:' pmsemIdent(0, sSemMem); - say ' fcSet:' pmsem386(0, sSemMem); - say ' Tid:' d2x(pmsemTid(0, sSemMem),4); - say ' Pid:' d2x(pmsemPid(0, sSemMem),4); - say 'ulNestedUseCount:' d2x(pmsemNested(0, sSemMem),8); - say ' ulWaitingCount:' d2x(pmsemWaiting(0, sSemMem),8); - say ' ulUseCount:' d2x(pmsemUseCount(0, sSemMem),8); - say ' ulEventHandle:' d2x(pmsemHEV(0, sSemMem),8); - say ' ulCallerAddr:' d2x(pmsemCallAddr(0, sSemMem),8); -return 0; - - - - - -/** - * Check if any of the PM sems are taken or have bogus state. - * @returns 0 on success. -1 on error. - */ -PmsemCheck: procedure expose(sGlobals) - sMem = dfReadMem('pmsemaphores', 35 * pmsemSize()) - if (sMem <> '') then - do - /* loop thru them all listing the taken/bogus ones */ - cDumps = 0; - say 'info: checking pm/gre sems' - do iSem = 0 to 34 - rc = pmsemValidate(iSem, sMem); - if (rc <> 1) then - do - if (cDumps = 0) then say ''; - cDumps = cDumps + 1; - if rc = 0 then sMsg = 'Taken'; - else sMsg = 'Bogus'; - call pmsemDump1 memCopy(iSem * pmsemSize(), pmsemSize(), sMem), sMsg, iSem; - end - end - if (cDumps = 0) then - say 'info: pm/gre sems are all free and ok.' - else - say 'info: 'cDumps 'semaphores was taken or bogus.'; - end - else - say 'error: failed to read semaphore table.'; -return -1; - - -/** - * Dump a number of pm/gre sems. - * @returns 0 on success. -1 on error. - */ -PmsemDump: procedure expose(sGlobals) -parse arg sAddr cCount - /* defaults and param validation */ - if (cCount = '' | datatype(cCount) <> 'NUM') then - cCount = 1; - if (sAddr = '') then - signal SyntaxError - - /* read memory and do the dump */ - sMem = dfReadMem(sAddr, cCount * pmsemSize()) - if (sMem <> '') then - do - do i = 0 to cCount - 1 - call pmsemDump1 memCopy(i * pmsemSize(), pmsemSize(), sMem); - end - end - else - say 'error: failed to read semaphore table.'; -return -1; - - -/** - * Dumps all PM/GRE sems - * @returns 0 on success. -1 on error. - */ -PmsemDumpAll: procedure expose(sGlobals) - /* read memory and do the dump */ - sMem = dfReadMem('pmsemaphores', 35 * pmsemSize()) - if (sMem <> '') then - do - do i = 0 to 34 - call pmsemDump1 memCopy(i * pmsemSize(), pmsemSize(), sMem),, i; - end - end - else - say 'error: failed to read semaphore table.'; -return -1; - - -/** - * Checks a give PM sem is free and not bogus. - * @returns 1 if free and not bogus. - * 0 if taken. - * -1 if bogus. - * @param iSem Semaphore index. - * @param sMem Memory containging the semaphore array. - * (If no array use iSem=0) - */ -pmsemValidate: procedure expose(sGlobals) -parse arg iSem, sMem - if (pmsemPTid(iSem, sMem) <> 0) then - return 0; - if (pos(pmsemIdent(iSem, sMem), "PMSEM;;;;;GRESEM") < 0) then - return -1; - if (pmsemWaiting(iSem, sMem) > 0) then - return -1; - if (pmsemHEV(iSem, sMem) = 0) then - return -1; -return 1; - - -/** - * Gives us the name of the pmsem at a given index. - * @returns Namestring. - * @param i Index - */ -pmsemGetName: procedure expose(sGlobals) -parse arg i - select - when i = 0 then return 'PMSEM_ATOM'; - when i = 1 then return 'PMSEM_USER'; - when i = 2 then return 'PMSEM_VISLOCK'; - when i = 3 then return 'PMSEM_DEBUG'; - when i = 4 then return 'PMSEM_HOOK'; - when i = 5 then return 'PMSEM_HEAP'; - when i = 6 then return 'PMSEM_DLL'; - when i = 7 then return 'PMSEM_THUNK'; - when i = 8 then return 'PMSEM_XLCE'; - when i = 9 then return 'PMSEM_UPDATE'; - when i = 10 then return 'PMSEM_CLIP'; - when i = 11 then return 'PMSEM_INPUT'; - when i = 12 then return 'PMSEM_DESKTOP'; - when i = 13 then return 'PMSEM_HANDLE'; - when i = 14 then return 'PMSEM_ALARM'; - when i = 15 then return 'PMSEM_STRRES'; - when i = 16 then return 'PMSEM_TIMER'; - when i = 17 then return 'PMSEM_CONTROLS'; - when i = 18 then return 'GRESEM_GREINIT'; - when i = 19 then return 'GRESEM_AUTOHEAP'; - when i = 20 then return 'GRESEM_PDEV'; - when i = 21 then return 'GRESEM_LDEV'; - when i = 22 then return 'GRESEM_CODEPAGE'; - when i = 23 then return 'GRESEM_HFONT'; - when i = 24 then return 'GRESEM_FONTCNTXT'; - when i = 25 then return 'GRESEM_FNTDRVR'; - when i = 26 then return 'GRESEM_SHMALLOC'; - when i = 27 then return 'GRESEM_GLOBALDATA'; - when i = 28 then return 'GRESEM_DBCSENV'; - when i = 29 then return 'GRESEM_SRVLOCK'; - when i = 30 then return 'GRESEM_SELLOCK'; - when i = 31 then return 'GRESEM_PROCLOCK'; - when i = 32 then return 'GRESEM_DRIVERSEM'; - when i = 33 then return 'GRESEM_SEMLFICACHE'; - when i = 34 then return 'GRESEM_SEMFONTTABLE'; - otherwise - end -return 'Unknown-'i; - - - -/* - * WINDOW STRUCTURE (WND) - * WINDOW STRUCTURE (WND) - * WINDOW STRUCTURE (WND) - * WINDOW STRUCTURE (WND) - * WINDOW STRUCTURE (WND) - * WINDOW STRUCTURE (WND) - * WINDOW STRUCTURE (WND) - * WINDOW STRUCTURE (WND) - * WINDOW STRUCTURE (WND) - * WINDOW STRUCTURE (WND) - */ -/* size and access functions */ -wndSize: procedure expose(sGlobals); return 144; /* guesswork! */ - -wndNext: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('00'), sMem); -wndParent: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('04'), sMem); -wndChild: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('08'), sMem); -wndOwner: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('0c'), sMem); -wndRecs: procedure expose(sGlobals); parse arg iWord,sMem;return memWord( x2d('10') + iWord*2, sMem); -wndStyle: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('18'), sMem); -wndId: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('1c'), sMem); -wndReserved0: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('20'), sMem); -wndReserved1: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('24'), sMem); -wndMsgQueue: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('28'), sMem); -wndHWND: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('2c'), sMem); -wndModel: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('30'), sMem); -wndProc: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('34'), sMem); -wndThunkProc: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('38'), sMem); -wndPresParams: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('40'), sMem); -wndFocus: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('44'), sMem); -wndWPSULong: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('48'), sMem); -wndInstData: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('50'), sMem); -wndOpen32: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('58'), sMem); -/* -wndWord: procedure expose(sGlobals); parse arg iWord,sMem;return memDword(96 + iWord*4, sMem); -*/ -/** dump one wnd structure */ -wndDump1: procedure expose(sGlobals) -parse arg sMem, sMsg - if (sMsg <> '') then - say sMsg - say ' pwndNext:' d2x(wndNext(sMem),8); - say ' pwndParent:' d2x(wndParent(sMem),8); - say ' pwndChild:' d2x(wndChild(sMem),8); - say ' pwndOwner:' d2x(wndOwner(sMem),8); - say ' rcsWindow: xl='wndRecs(0, sMem)',yl='wndRecs(1, sMem), - 'xr='wndRecs(2, sMem)',yr='wndRecs(3, sMem) '(decimal)' - say ' ulStyle:' d2x(wndStyle(sMem),8); - say ' id:' d2x(wndId(sMem),8); - say ' Reserved0:' d2x(wndReserved0(sMem),8); - say ' Reserved1:' d2x(wndReserved1(sMem),8); - say ' pmqMsgQueue:' d2x(wndMsgQueue(sMem),8); - say ' hwnd:' d2x(wndHWND(sMem),8); - say ' fModel16bit:' d2x(wndModel(sMem),8); - say ' pfnWinProc:' d2x(wndProc(sMem),8) '('dfNear('%'d2x(wndProc(sMem),8))')' - if (wndThunkProc(sMem) = 0) then - say ' pfnThunkProc:' d2x(wndThunkProc(sMem),8) - else - say ' pfnThunkProc:' d2x(wndThunkProc(sMem),8) ' ('dfNear('%'d2x(wndThunkProc(sMem),8))')' - say ' ppresParams:' d2x(wndPresParams(sMem),8); - say ' pwndFocus:' d2x(wndFocus(sMem),8); - say ' ulWPS:' d2x(wndWPSULong(sMem),8) '('dfNear('%'d2x(wndWPSULong(sMem),8))')' - say ' pInstData:' d2x(wndInstData(sMem),8); - say ' ??:' d2x(memDword(x2d('54'), sMem),8); - say ' pOpen32:' d2x(wndOpen32(sMem),8); -/* This aint right! - i = 0; - do while (i < 12) - say ' aulWin['d2x(i,2)'-'d2x(i+3,2)']: '||, - d2x(wndWord(i+0, sMem), 8) d2x(wndWord(i+1, sMem), 8), - d2x(wndWord(i+2, sMem), 8) d2x(wndWord(i+3, sMem), 8) - i = i + 4; - end -*/ -return 0; - - -/** - * Dump window structures. - */ -WndDump: procedure expose(sGlobals) -parse arg sAddr cCount - /*defaults and param validation */ - if (cCount = '' | datatype(cCount) <> 'NUM') then - cCount = 1; - if (sAddr = '') then - signal SyntaxError - if (hwndIsHandle(sAddr)) then - do - ulPWND = hwnd2PWND(sAddr); - if (ulPWND > 0) then - sAddr = '%'d2x(ulPWND); - end - - /* read memory */ - sMem = dfReadMem(sAddr, cCount * wndSize()) - if (sMem <> '') then - do - /* loop thru them all listing the taken/bogus ones */ - do i = 0 to cCount - 1 - call wndDump1 memCopy(i * wndSize(), wndSize(), sMem); - end - end - else - say 'error: failed to read window structure at '''sAddr'''.'; -return 0; - - - - -/* - * WINDOW HANDLE (HWND) - * WINDOW HANDLE (HWND) - * WINDOW HANDLE (HWND) - * WINDOW HANDLE (HWND) - * WINDOW HANDLE (HWND) - * WINDOW HANDLE (HWND) - * WINDOW HANDLE (HWND) - * WINDOW HANDLE (HWND) - */ -hwnd2PWND: procedure expose(sGlobals) -parse arg sHwnd sDummy - ulIndex = x2d(right(sHwnd, 4)); - ulBase = hwndpHandleTable(); - if (ulBase = 0) then - return 0; - - ulHandleEntry = ulBase + ulIndex * 8 + 32; -return dfReadDword('%'d2x(ulHandleEntry, 8), 4); - - -/** - * Checks if a value is a hwnd. - * @returns true/false. - * @param sValue Value in question. - */ -hwndIsHandle: procedure expose(sGlobals) -parse arg sValue sDummy - - /* Paranoid check if this is a number or hex value or whatever*/ - sValue = strip(sValue); - if (sValue = '') then - return 0; - if (datatype(sValue) <> 'NUM') then - do /* assumes kind of hexx */ - sValue = translate(sValue); - if (left(sValue, 2) = '0X') then - sValue = substr(sValue, 3); - if (right(sValue,1) = 'H') then - sValue = substr(sValue, 1, length(sValue) - 1); - if (sValue = '') then - return 0; - if (strip(translate(sValue, '', '123456767ABCDEF')) <> '') then - return 0; - ulValue = x2d(sValue); - end - else - do /* check if decimal value, if not try hex */ - if (sValue >= x2d('80000001') & sValue < x2d('8000ffff')) then - return 1; - ulValue = x2d(sValue); - end - - /* Check for valid handle range. */ -return ulValue >= x2d('80000001') & ulValue < x2d('8000ffff'); - - -/** - * Gets the pointer to the handle table. - */ -hwndpHandleTable: procedure expose(sGlobals) - if (ulHandleTable > 0) then - return ulHandleTable; - - ulHandleTable = dfReadDword('pHandleTable', 4); - if (ulHandleTable > 0) then - return ulHandleTable - say 'error-hwndpHandleTable: failed to read pHandleTable'; -return 0; - - - -/* - * MESSAGE QUEUE STRUCTURE (MQ) - * MESSAGE QUEUE STRUCTURE (MQ) - * MESSAGE QUEUE STRUCTURE (MQ) - * MESSAGE QUEUE STRUCTURE (MQ) - * MESSAGE QUEUE STRUCTURE (MQ) - * MESSAGE QUEUE STRUCTURE (MQ) - * MESSAGE QUEUE STRUCTURE (MQ) - * MESSAGE QUEUE STRUCTURE (MQ) - * MESSAGE QUEUE STRUCTURE (MQ) - */ -mqSize: procedure expose(sGlobals); return x2d('b0'); -mqNext: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('00'), sMem); -mqEntrySize: procedure expose(sGlobals); parse arg sMem; return memWord(x2d('04'), sMem); -/*mqQueue: procedure expose(sGlobals); parse arg sMem; return memWord(x2d('06'), sMem);*/ -mqMessages: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('08'), sMem); -/* ?? */ -mqMaxMessages: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('0c'), sMem); -mqPid: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('18'), sMem); -mqTid: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('1c'), sMem); -mqFirstMsg: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('20'), sMem); -mqLastMsg: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('24'), sMem); -mqSGid: procedure expose(sGlobals); parse arg sMem; return memWord(x2d('28'), sMem); -mqHev: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('2c'), sMem); -mqSent: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('3c'), sMem); -mqCurrent: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('40'), sMem); - -mqBadPwnd: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('68'), sMem); -mqBadQueue: procedure expose(sGlobals); parse arg sMem; return memByte(x2d('6c'), sMem); -mqCountTimers: procedure expose(sGlobals); parse arg sMem; return memByte(x2d('6d'), sMem); -mqHeap: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('70'), sMem); -mqHAccel: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('74'), sMem); - -mqShutdown: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('90'), sMem); - -mqRcvdSMSList: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('98'), sMem); -mqSlot: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('a0'), sMem); - -/** dump one mq structure */ -mqDump1: procedure expose(sGlobals) -parse arg sMem; - say ' pmqNext:' d2x(mqNext(sMem), 8); - say ' cbEntry:' d2x(mqEntrySize(sMem), 8); - say ' cMessages:' d2x(mqMessages(sMem), 8); - say 'cMaxMessages:' d2x(mqMaxMessages(sMem), 8); - say ' Tid:' d2x(mqTid(sMem), 8); - say ' Pid:' d2x(mqPid(sMem), 8); - say 'psmsFirstMsg:' d2x(mqFirstMsg(sMem), 8); - say ' psmsLastMsg:' d2x(mqLastMsg(sMem), 8); - say ' SGId:' d2x(mqSGid(sMem), 8); - say ' hev:' d2x(mqHev(sMem), 8); - say ' psmsSent:' d2x(mqSent(sMem), 8); - say ' psmsCurrent:' d2x(mqCurrent(sMem), 8); - say ' pwndBad:' d2x(mqBadPWND(sMem), 8); - say ' fBadQueue:' d2x(mqBadQueue(sMem), 2); - say ' cTimers:' d2x(mqCountTimers(sMem), 2); - say ' pHeap:' d2x(mqHeap(sMem), 8); - say ' HACCEL:' d2x(mqHAccel(sMem), 8); - say ' fchShutdown:' d2x(mqShutdown(sMem), 2); - say ' RcvdSMSList:' d2x(mqRcvdSMSList(sMem), 8); - say ' Slot:' d2x(mqSlot(sMem), 4); -return 0; - - -/** - * Message queue dumper. - * @param sAddr Address expression of a MQ struct, or a window - * which message queue you wanna dump. - * @returns 0 - */ -mqDump: procedure expose(sGlobals) -parse arg sAddr cCount - /*defaults and param validation */ - if (cCount = '' | datatype(cCount) <> 'NUM') then - cCount = 1; - if (sAddr = '') then - signal SyntaxError - - /* - * The user might have passed in an window handle. - * If so we'll dump it's queue. - */ - if (hwndIsHandle(sAddr)) then - do /* input is a hwnd, we will try dump it's queue */ - ulPWND = hwnd2PWND(sAddr); - if (ulPWND > 0) then - do - sMem = dfReadMem('%'d2x(ulPWND), wndSize()); - if (sMem <> '') then - do - ulMQ = wndMsgQueue(sMem); - if (ulMq > 0) then - sAddr = '%'d2x(ulPWND); - end - drop sMem; - end - end - - /* read memory */ - sMem = dfReadMem(sAddr, cCount * mqSize()) - if (sMem <> '') then - do - /* loop thru them all listing the taken/bogus ones */ - do i = 0 to cCount - 1 - call mqDump1 memCopy(i * mqSize(), mqSize(), sMem); - end - end - else - say 'error: failed to read window structure at '''sAddr'''.'; -return 0; - - -/* - * SENDMSG STRUCTRURE (SMS) - * SENDMSG STRUCTRURE (SMS) - * SENDMSG STRUCTRURE (SMS) - * SENDMSG STRUCTRURE (SMS) - * SENDMSG STRUCTRURE (SMS) - * SENDMSG STRUCTRURE (SMS) - * SENDMSG STRUCTRURE (SMS) - */ -smsSize: procedure expose(sGlobals); return 64; -smsNextMaster: procedure expose(sGlobals); parse arg sMem; return memDword(0, sMem); -smsSendHead: procedure expose(sGlobals); parse arg sMem; return memDword(4, sMem); -smsReserved0: procedure expose(sGlobals); parse arg sMem; return memDword(8, sMem); -smsReceiveNext: procedure expose(sGlobals); parse arg sMem; return memDword(12, sMem); -smsTime: procedure expose(sGlobals); parse arg sMem; return memDword(16, sMem); -smsSenderPMQ: procedure expose(sGlobals); parse arg sMem; return memDword(20, sMem); -smsReceiverPMQ: procedure expose(sGlobals); parse arg sMem; return memDword(24, sMem); -smsResult: procedure expose(sGlobals); parse arg sMem; return memDword(28, sMem); -smsReserved1: procedure expose(sGlobals); parse arg sMem; return memDword(32, sMem); -smsPWND: procedure expose(sGlobals); parse arg sMem; return memDword(36, sMem); -smsMsgId: procedure expose(sGlobals); parse arg sMem; return memDword(40, sMem); -smsMP1: procedure expose(sGlobals); parse arg sMem; return memDword(44, sMem); -smsMP2: procedure expose(sGlobals); parse arg sMem; return memDword(48, sMem); -smsReserved2: procedure expose(sGlobals); parse arg sMem; return memDword(52, sMem); -smsReserved3: procedure expose(sGlobals); parse arg sMem; return memDword(56, sMem); -smsReserved4: procedure expose(sGlobals); parse arg sMem; return memDword(60, sMem); - -/** Dumps one sms structure */ -smsDump1: procedure expose(sGlobals) -parse arg sMem - say ' psmsMasterNext:' d2x(smsNextMaster(sMem),8) - say ' psmsSendHead:' d2x(smsSendHead(sMem),8) - say ' Reserved0:' d2x(smsReserved0(sMem),8) - say 'psmsReceiveNext:' d2x(smsReceiveNext(sMem),8) - say ' Time:' d2x(smsTime(sMem),8) - say ' pmqSender:' d2x(smsSenderPMQ(sMem),8) - say ' pmqReceiver:' d2x(smsReceiverPMQ(sMem),8) - say ' ulResult:' d2x(smsResult(sMem),8) - say ' Reserved1:' d2x(smsReserved1(sMem),8) - say ' pWnd:' d2x(smsPWND(sMem),8) - say ' ulMsgId:' d2x(smsMsgId(sMem),8) '('msgMsgIdToText(smsMsgId(sMem))')' - say ' MP1:' d2x(smsMP1(sMem),8) - say ' MP2:' d2x(smsMP2(sMem),8) - say ' Reserved2:' d2x(smsReserved2(sMem),8) - say ' Reserved3:' d2x(smsReserved3(sMem),8) - say ' Reserved4:' d2x(smsReserved4(sMem),8) -return 0; - - -/** - * Send message struct (SMS) dumper. - * @param sAddr Address expression of a sms struct. - * @returns 0 - */ -SmsDump: procedure expose(sGlobals) -parse arg sAddr cCount - /*defaults and param validation */ - if (cCount = '' | datatype(cCount) <> 'NUM') then - cCount = 1; - if (sAddr = '') then - signal SyntaxError - - /* read memory */ - sMem = dfReadMem(sAddr, cCount * smsSize()) - if (sMem <> '') then - do - /* loop thru them all listing the taken/bogus ones */ - do i = 0 to cCount - 1 - call smsDump1 memCopy(i * smsSize(), smsSize(), sMem); - end - end - else - say 'error: failed to read SMS structure at '''sAddr'''.'; -return 0; - - -/* - * PM QUEUE MESSAGE STRUCTURE (QMSG) - * PM QUEUE MESSAGE STRUCTURE (QMSG) - * PM QUEUE MESSAGE STRUCTURE (QMSG) - * PM QUEUE MESSAGE STRUCTURE (QMSG) - * PM QUEUE MESSAGE STRUCTURE (QMSG) - * PM QUEUE MESSAGE STRUCTURE (QMSG) - * PM QUEUE MESSAGE STRUCTURE (QMSG) - */ -qmsgSize: procedure expose(sGlobals); return 32; -qmsgHwnd: procedure expose(sGlobals); parse arg sMem; return memDword(0, sMem); -qmsgMsgId: procedure expose(sGlobals); parse arg sMem; return memDword(4, sMem); -qmsgMP1: procedure expose(sGlobals); parse arg sMem; return memDword(8, sMem); -qmsgMP2: procedure expose(sGlobals); parse arg sMem; return memDword(12, sMem); -qmsgTime: procedure expose(sGlobals); parse arg sMem; return memDword(16, sMem); -qmsgPtlX: procedure expose(sGlobals); parse arg sMem; return memDword(20, sMem); -qmsgPtlY: procedure expose(sGlobals); parse arg sMem; return memDword(24, sMem); -qmsgReserved: procedure expose(sGlobals); parse arg sMem; return memDword(28, sMem); - -qmsgDump1: procedure expose(sGlobals); -parse arg sMem - say ' Hwnd:' d2x(qmsgHwnd(sMem),8) - say ' MsgId:' d2x(qmsgMsgId(sMem),8) '('msgMsgIdToText(qmsgMsgId(sMem))')' - say ' MP1:' d2x(qmsgMP1(sMem),8) - say ' MP2:' d2x(qmsgMP2(sMem),8) - say ' Time:' d2x(qmsgTime(sMem),8) - say ' Ptl.x:' d2x(qmsgPtlX(sMem),8) - say ' Ptl.y:' d2x(qmsgPtlY(sMem),8) - say ' Reserved:' d2x(qmsgReserved(sMem),8) -return 0; - - -/** - * Queue message struct (QMSG) dumper. - * @param sAddr Address expression of a sms struct. - * @returns 0 - */ -QmsgDump: procedure expose(sGlobals) -parse arg sAddr cCount - /*defaults and param validation */ - if (cCount = '' | datatype(cCount) <> 'NUM') then - cCount = 1; - if (sAddr = '') then - signal SyntaxError - - /* read memory */ - sMem = dfReadMem(sAddr, cCount * qmsgSize()) - if (sMem <> '') then - do - /* loop thru them all listing the taken/bogus ones */ - do i = 0 to cCount - 1 - call qmsgDump1 memCopy(i * qmsgSize(), qmsgSize(), sMem); - end - end - else - say 'error: failed to read QMSG structure at '''sAddr'''.'; -return 0; - - -/* - * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) - * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) - * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) - * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) - * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) - * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) - * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) - * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) - */ -sqmsgSize: procedure expose(sGlobals); return 32; -sqmsgMsgId: procedure expose(sGlobals); parse arg sMem; return memDword(0, sMem); -sqmsgMP1: procedure expose(sGlobals); parse arg sMem; return memDword(4, sMem); -sqmsgMP2: procedure expose(sGlobals); parse arg sMem; return memDword(8, sMem); -sqmsgTime: procedure expose(sGlobals); parse arg sMem; return memDword(12, sMem); -sqmsgReserved0: procedure expose(sGlobals); parse arg sMem; return memDword(16, sMem); -sqmsgReserved1: procedure expose(sGlobals); parse arg sMem; return memDword(20, sMem); -sqmsgReserved2: procedure expose(sGlobals); parse arg sMem; return memDword(24, sMem); -sqmsgReserved3: procedure expose(sGlobals); parse arg sMem; return memDword(28, sMem); - -sqmsgDump1: procedure expose(sGlobals); -parse arg sMem - say ' MsgId:' d2x(sqmsgMsgId(sMem),8) '('msgMsgIdToText(sqmsgMsgId(sMem))')' - say ' MP1:' d2x(sqmsgMP1(sMem),8) - say ' MP2:' d2x(sqmsgMP2(sMem),8) - say ' Time:' d2x(sqmsgTime(sMem),8) - say 'Reserved0:' d2x(sqmsgReserved0(sMem),8) - say 'Reserved1:' d2x(sqmsgReserved1(sMem),8) - say 'Reserved2:' d2x(sqmsgReserved2(sMem),8) - say 'Reserved3:' d2x(sqmsgReserved3(sMem),8) -return 0; - - -/** - * System Queue message struct (SQMSG) dumper. - * @param sAddr Address expression of a sqmsg struct. - * @returns 0 - */ -SqmsgDump: procedure expose(sGlobals) -parse arg sAddr cCount - /*defaults and param validation */ - if (cCount = '' | datatype(cCount) <> 'NUM') then - cCount = 1; - if (sAddr = '') then - signal SyntaxError - - /* read memory */ - sMem = dfReadMem(sAddr, cCount * sqmsgSize()) - if (sMem <> '') then - do - /* loop thru them all listing the taken/bogus ones */ - do i = 0 to cCount - 1 - call sqmsgDump1 memCopy(i * sqmsgSize(), sqmsgSize(), sMem); - end - end - else - say 'error: failed to read SQMSG structure at '''sAddr'''.'; -return 0; - - -/* - * MSG HELPERS - * MSG HELPERS - * MSG HELPERS - * MSG HELPERS - * MSG HELPERS - * MSG HELPERS - * MSG HELPERS - * MSG HELPERS - */ - -/** - * translates a message ID into a message define string - * @param iMsgId The message id in question. - * @returns Symbol name. - * '' if unknown. - */ -msgMsgIdToText: procedure -parse arg iMsgId - select - when (iMsgId = x2d('0000')) then return 'WM_NULL'; - when (iMsgId = x2d('0001')) then return 'WM_CREATE'; - when (iMsgId = x2d('0002')) then return 'WM_DESTROY'; - /*when (iMsgId == x2d('0003')) then return '';*/ - when (iMsgId = x2d('0004')) then return 'WM_ENABLE'; - when (iMsgId = x2d('0005')) then return 'WM_SHOW'; - when (iMsgId = x2d('0006')) then return 'WM_MOVE'; - when (iMsgId = x2d('0007')) then return 'WM_SIZE'; - when (iMsgId = x2d('0008')) then return 'WM_ADJUSTWINDOWPOS'; - when (iMsgId = x2d('0009')) then return 'WM_CALCVALIDRECTS'; - when (iMsgId = x2d('000a')) then return 'WM_SETWINDOWPARAMS'; - when (iMsgId = x2d('000b')) then return 'WM_QUERYWINDOWPARAMS'; - when (iMsgId = x2d('000c')) then return 'WM_HITTEST'; - when (iMsgId = x2d('000d')) then return 'WM_ACTIVATE'; - when (iMsgId = x2d('000f')) then return 'WM_SETFOCUS'; - when (iMsgId = x2d('0010')) then return 'WM_SETSELECTION'; - when (iMsgId = x2d('0011')) then return 'WM_PPAINT'; - when (iMsgId = x2d('0012')) then return 'WM_PSETFOCUS'; - when (iMsgId = x2d('0013')) then return 'WM_PSYSCOLORCHANGE'; - when (iMsgId = x2d('0014')) then return 'WM_PSIZE'; - when (iMsgId = x2d('0015')) then return 'WM_PACTIVATE'; - when (iMsgId = x2d('0016')) then return 'WM_PCONTROL'; - when (iMsgId = x2d('0020')) then return 'WM_COMMAND'; - when (iMsgId = x2d('0021')) then return 'WM_SYSCOMMAND'; - when (iMsgId = x2d('0022')) then return 'WM_HELP'; - when (iMsgId = x2d('0023')) then return 'WM_PAINT'; - when (iMsgId = x2d('0024')) then return 'WM_TIMER'; - when (iMsgId = x2d('0025')) then return 'WM_SEM1'; - when (iMsgId = x2d('0026')) then return 'WM_SEM2'; - when (iMsgId = x2d('0027')) then return 'WM_SEM3'; - when (iMsgId = x2d('0028')) then return 'WM_SEM4'; - when (iMsgId = x2d('0029')) then return 'WM_CLOSE'; - when (iMsgId = x2d('002a')) then return 'WM_QUIT'; - when (iMsgId = x2d('002b')) then return 'WM_SYSCOLORCHANGE'; - when (iMsgId = x2d('002d')) then return 'WM_SYSVALUECHANGED'; - when (iMsgId = x2d('002e')) then return 'WM_APPTERMINATENOTIFY'; - when (iMsgId = x2d('002f')) then return 'WM_PRESPARAMCHANGED'; - when (iMsgId = x2d('0030')) then return 'WM_CONTROL'; - when (iMsgId = x2d('0031')) then return 'WM_VSCROLL'; - when (iMsgId = x2d('0032')) then return 'WM_HSCROLL'; - when (iMsgId = x2d('0033')) then return 'WM_INITMENU'; - when (iMsgId = x2d('0034')) then return 'WM_MENUSELECT'; - when (iMsgId = x2d('0035')) then return 'WM_MENUEND'; - when (iMsgId = x2d('0036')) then return 'WM_DRAWITEM'; - when (iMsgId = x2d('0037')) then return 'WM_MEASUREITEM'; - when (iMsgId = x2d('0038')) then return 'WM_CONTROLPOINTER'; - when (iMsgId = x2d('003a')) then return 'WM_QUERYDLGCODE'; - when (iMsgId = x2d('003b')) then return 'WM_INITDLG'; - when (iMsgId = x2d('003c')) then return 'WM_SUBSTITUTESTRING'; - when (iMsgId = x2d('003d')) then return 'WM_MATCHMNEMONIC'; - when (iMsgId = x2d('003e')) then return 'WM_SAVEAPPLICATION'; - when (iMsgId = x2d('0490')) then return 'WM_SEMANTICEVENT'; - when (iMsgId = x2d('1000')) then return 'WM_USER'; - when (iMsgId = x2d('007e')) then return 'WM_VRNDISABLED'; - when (iMsgId = x2d('007f')) then return 'WM_VRNENABLED'; - when (iMsgId = x2d('007a')) then return 'WM_CHAR'; - when (iMsgId = x2d('007b')) then return 'WM_VIOCHAR'; - when (iMsgId = x2d('0070')) then return 'WM_MOUSEMOVE'; - when (iMsgId = x2d('0071')) then return 'WM_BUTTON1DOWN'; - when (iMsgId = x2d('0072')) then return 'WM_BUTTON1UP'; - when (iMsgId = x2d('0073')) then return 'WM_BUTTON1DBLCLK'; - when (iMsgId = x2d('0074')) then return 'WM_BUTTON2DOWN'; - when (iMsgId = x2d('0075')) then return 'WM_BUTTON2UP'; - when (iMsgId = x2d('0076')) then return 'WM_BUTTON2DBLCLK'; - when (iMsgId = x2d('0077')) then return 'WM_BUTTON3DOWN'; - when (iMsgId = x2d('0078')) then return 'WM_BUTTON3UP'; - when (iMsgId = x2d('0079')) then return 'WM_BUTTON3DBLCLK'; - when (iMsgId = x2d('007D')) then return 'WM_MOUSEMAP'; - when (iMsgId = x2d('0410')) then return 'WM_CHORD'; - when (iMsgId = x2d('0411')) then return 'WM_BUTTON1MOTIONSTART'; - when (iMsgId = x2d('0412')) then return 'WM_BUTTON1MOTIONEND'; - when (iMsgId = x2d('0413')) then return 'WM_BUTTON1CLICK'; - when (iMsgId = x2d('0414')) then return 'WM_BUTTON2MOTIONSTART'; - when (iMsgId = x2d('0415')) then return 'WM_BUTTON2MOTIONEND'; - when (iMsgId = x2d('0416')) then return 'WM_BUTTON2CLICK'; - when (iMsgId = x2d('0417')) then return 'WM_BUTTON3MOTIONSTART'; - when (iMsgId = x2d('0418')) then return 'WM_BUTTON3MOTIONEND'; - when (iMsgId = x2d('0419')) then return 'WM_BUTTON3CLICK'; - when (iMsgId = x2d('0420')) then return 'WM_BEGINDRAG'; - when (iMsgId = x2d('0421')) then return 'WM_ENDDRAG'; - when (iMsgId = x2d('0422')) then return 'WM_SINGLESELECT'; - when (iMsgId = x2d('0423')) then return 'WM_OPEN'; - when (iMsgId = x2d('0424')) then return 'WM_CONTEXTMENU'; - when (iMsgId = x2d('0425')) then return 'WM_CONTEXTHELP'; - when (iMsgId = x2d('0426')) then return 'WM_TEXTEDIT'; - when (iMsgId = x2d('0427')) then return 'WM_BEGINSELECT'; - when (iMsgId = x2d('0428')) then return 'WM_ENDSELECT'; - when (iMsgId = x2d('0429')) then return 'WM_PICKUP'; - /*when (iMsgId = x2d('')) then return ' - when (iMsgId = x2d('')) then return ' - when (iMsgId = x2d('')) then return ' - when (iMsgId = x2d('')) then return ' - when (iMsgId = x2d('')) then return ' - when (iMsgId = x2d('')) then return ' - when (iMsgId = x2d('')) then return ' - when (iMsgId = x2d('')) then return '*/ - when (iMsgId >= x2d('04c0') & iMsgId <= x2d('04ff')) then return 'WM_PENxxx'; - when (iMsgId >= x2d('0500') & iMsgId <= x2d('05ff')) then return 'WM_MMPMxxx'; - when (iMsgId >= x2d('0600') & iMsgId <= x2d('065f')) then return 'WM_STDDLGxxx'; - when (iMsgId >= x2d('0bd0') & iMsgId <= x2d('0bff')) then return 'WM_BIDIxxx'; - when (iMsgId >= x2d('0f00') & iMsgId <= x2d('0fff')) then return 'WM_HELPMGRxxx'; - otherwise - end -return ''; - - -/* - * PM - * PM - * PM - * PM - * PM - * PM - * PM - * PM - * PM - * PM - * PM - * PM - */ -PmStatus: procedure expose(sGlobals) -parse arg sArgs - - say 'PM Status:' - say ' fBadAppDialog:' d2x(dfReadDword('fBadAppDialog'), 8) - sMem = dfReadMem('qhpsBadApp', 8); - say ' qhpsBadApp: tid='d2x(memWord(0, sMem), 4)','||, - 'pid='d2x(memWord(2, sMem), 4)','||, - 'flags='d2x(memWord(4, sMem), 4)','||, - 'sgid='d2x(memWord(6, sMem), 4); - say '- Focus & Locks -' - pwndFocus = dfReadDword('pwndfocus'); - say ' pwndFocus:' d2x(pwndFocus, 8); - sMem = dfReadMem('%'||d2x(pwndFocus), wndSize()); - if (sMem <> '') then - do - say ' pwndFocus.hwnd :' d2x(wndHwnd(sMem), 8); - say ' pwndFocus.mq :' d2x(wndMsgQueue(sMem), 8); - sMem = dfReadMem('%'||d2x(wndMsgQueue(sMem)), mqSize()); - if (sMem <> '') then - do - say ' pwndFocus.mq.slot:' d2x(mqSlot(sMem), 4); - say ' pwndFocus.mq.tid :' d2x(mqTid(sMem), 8); - say ' pwndFocus.mq.pid :' d2x(mqPid(sMem), 8); - end - end - say ' pmqsyslock:' d2x(dfReadDword('pmqsyslock'), 8); - say ' pmqVisLock:' d2x(dfReadDword('pmqVisLock'), 8) - say ' pwndSysModal:' d2x(dfReadDword('pwndSysModal'), 8) - say ' pmqTrack:' d2x(dfReadDword('pmqTrack'), 8) - say ' pmqLockUpdate:' d2x(dfReadDword('pmqLockUpdate'), 8) - say '- Event Receivers -' - say ' pmqMouseWake:' d2x(dfReadDword('pmqMouseWake'), 8); - say ' pmqKeyWake:' d2x(dfReadDword('pmqKeyWake'), 8) - say ' pmqEventWake:' d2x(dfReadDword('pmqEventWake'), 8) - say '- Lists -' - say ' pSysqueue:' d2x(dfReadDword('pSysqueue'), 8) - say ' pmqList:' d2x(dfReadDword('pmqList'), 8) - say '- Misc Variables -' - say ' pwndDesktop:' d2x(dfReadDword('pwndDesktop'), 8) - say ' pwndObject:' d2x(dfReadDword('pwndObject'), 8) - say ' pmqShell:' d2x(dfReadDword('pmqShell'), 8) - say ' pmqShell2:' d2x(dfReadDword('pmqShell2'), 8) - say ' pmqShutdown:' d2x(dfReadDword('pmqShutdown'), 8) - say ' paAABRegs:' d2x(dfReadDword('paAABRegs'), 8) - - -return 0; - - -/* - * PMDF WORKERS - * PMDF WORKERS - * PMDF WORKERS - * PMDF WORKERS - * PMDF WORKERS - * PMDF WORKERS - * PMDF WORKERS - * PMDF WORKERS - * PMDF WORKERS - * PMDF WORKERS - * PMDF WORKERS - * PMDF WORKERS - */ - - - -/** - * Read memory. - * @param sStartExpr Expression giving the address where to read from. - * @param cbLength Number of _bytes_ to read. - * @returns The memory we have read. (internal format!) - */ -dfReadMem: procedure expose(sGlobals) -parse arg sStartExpr, cbLength - - /* dump memory */ - if ((cbLength // 4) = 0) then - do /* optimized read */ - /*say 'dbg-df: dd' sStartExpr 'L'cbLength/4'T'*/ - Address df 'CMD' 'asOut' 'dd' sStartExpr 'L'cbLength/4'T' - /*say 'dbg-df: rc='rc' asOut.0='asOut.0;*/ - if (rc = 0) then - do - /* interpret output */ - j = 0; - sMem = ''; - do i = 1 to asOut.0 - /* format: - * 0000:00000000 45534D50 0000004D 00000000 00000000 - */ - parse var asOut.i .' 'ch.0' 'ch.1' 'ch.2' 'ch.3 - /*say 'dbg:' asOut.i - say 'dbg:' ch.0','ch.1','ch.2','ch.3*/ - k = 0; - ch.4 = ''; - do while(k <= 3 & strip(ch.k) <> '') - sMem = sMem || substr(ch.k,7,2)||substr(ch.k,5,2)||substr(ch.k,3,2)||substr(ch.k,1,2); - j = j + 4; - k = k + 1; - end - end - if (j <> 0) then - return d2x(j,8)||sMem; - end - - end - else - do /* slower (more output) byte by byte read */ - /*say 'dbg-df: db' sStartExpr 'L'cbLength'T'*/ - Address df 'CMD' 'asOut' 'db' sStartExpr 'L'cbLength'T' - /*say 'dbg-df: rc='rc' asOut.0='asOut.0;*/ - if (rc = 0) then - do - /* interpret output */ - j = 0; - sMem = ''; - do i = 1 to asOut.0 - /* format: - * 9f47:0000af00 50 4d 53 45 4d 00 00 00-00 00 00 00 00 00 00 00 PMSEM........... - */ - ch.16 = ''; - parse var asOut.i .' 'ch.0' 'ch.1' 'ch.2' 'ch.3' 'ch.4' 'ch.5' 'ch.6' 'ch.7'-'ch.8' 'ch.9' 'ch.10' 'ch.11' 'ch.12' 'ch.13' 'ch.14' 'ch.15' '. - k = 0; - /*say 'dbg:' asOut.i - say 'dbg:' ch.0','ch.1','ch.2','ch.3','ch.4','ch.5','ch.6','ch.7','ch.8','ch.9','ch.10','ch.11','ch.12','ch.13','ch.14','ch.15*/ - do while(k <= 15 & strip(ch.k) <> '') - sMem = sMem || ch.k; - j = j + 1; - k = k + 1; - end - end - if (j <> 0) then - return d2x(j,8)||sMem; - end - end -return ''; - - -/** - * Reads a DWord at a given address. - * @param sAddr Address expression. - * @return The value of the dword at given address. - * -1 on error. - */ -dfReadByte: procedure expose(sGlobals) -parse arg sAddr - sMem = dfReadMem(sAddr, 4); - if (sMem <> '') then - return memByte(0, sMem); -return -1; - - -/** - * Reads a Word at a given address. - * @param sAddr Address expression. - * @return The value of the dword at given address. - * -1 on error. - */ -dfReadWord: procedure expose(sGlobals) -parse arg sAddr - sMem = dfReadMem(sAddr, W); - if (sMem <> '') then - return memWord(0, sMem); -return -1; - - -/** - * Reads a DWord at a given address. - * @param sAddr Address expression. - * @return The value of the dword at given address. - * -1 on error. - */ -dfReadDWord: procedure expose(sGlobals) -parse arg sAddr - sMem = dfReadMem(sAddr, 4); - if (sMem <> '') then - return memDword(0, sMem); -return -1; - - -/** - * Get near symbol. - * @param sAddr Address expression. - * @return Near output. - * '' on error. - */ -dfNear: procedure expose(sGlobals) -parse arg sAddr - Address df 'CMD' 'asOut' 'ln' sAddr - if (rc = 0 & asOut.0 > 0) then - do - if (pos('symbols found', asOut.1) <= 0) then - do - parse var asOut.1 .' 'sRet; - return strip(sRet); - end - end -return ''; - - -/** - * Read all processes into global variable. - */ -dfProcessReadAll: procedure expose(sGlobals) -parse arg fBlockInfo - if (\fBlockInfo) then - do - say '[reading processes]' - Address df 'CMD' 'asOut' '.p'; - say '[done]' - if (rc = 0 & asOut.0 > 0) then - do - j = 0; - do i = 1 to asOut.0 - if (word(asOut.i,1) = 'Slot' | strip(asOut.i) = '') then - iterate; - /* 0074 0033 0000 0033 0002 blk 0500 f88e6000 fe62d220 f9a0b7e8 1e9c 12 muglrqst - * 000a 0001 0000 0000 000a blk 081e f8812000 ffdba880 f99f7840 1e94 00 *jitdaem - * *000b# 001d 0001 001d 0001 blk 0500 f8814000 fe6270a0 f99f7b44 1e9c 01 pmshell - */ - j = j + 1; - aProc.j.sType = '0'; - aProc.j.hxBlockId = '0'; - asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); - parse var asOut.i aProc.j.hxSlot, - aProc.j.hxPid, - aProc.j.hxPPid, - aProc.j.hxCsid, - aProc.j.hxOrd, - aProc.j.sState, - aProc.j.hxPri, - aProc.j.hxpTSD, - aProc.j.hxpPTDA, - aProc.j.hxpPCB, - aProc.j.hxDisp, - aProc.j.hxSG, - aProc.j.sName; - if (strip(aProc.j.hxSlot) = '') then - j = j - 1; - end - aProc.0 = j; - end - end - else - do - say '[reading processes]' - Address df 'CMD' 'asOut' '.pb'; - say '[done]' - if (rc = 0 & asOut.0 > 0) then - do - j = 0; - do i = 1 to asOut.0 - if (word(asOut.i,1) = 'Slot' | strip(asOut.i) = '') then - iterate; - /* 0044 blk fd436cf8 4os2 Sem32 8001 005d hevResultCodeSet - * *000b# blk fd436190 pmshell - * 0073 blk 0b008cbe msrv SysSem - */ - asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); - j = j + 1; - aProc.j.hxPid = '0'; - aProc.j.hxPPid = '0'; - aProc.j.hxCsid = '0'; - aProc.j.hxOrd = '0'; - aProc.j.hxPri = '0'; - aProc.j.hxpTSD = '0'; - aProc.j.hxpPTDA = '0'; - aProc.j.hxpPCB = '0'; - aProc.j.hxDisp = '0'; - aProc.j.hxSG = '0'; - parse var asOut.i aProc.j.hxSlot, - aProc.j.sState, - aProc.j.hxBlockId, - aProc.j.sName, - aProc.j.sType .; - if (strip(aProc.j.hxSlot) = '') then - j = j - 1; - end - aProc.0 = j; - end - end -return -1; - - -/** - * Gets the blockId of a process from the dumpformatter. - * @param iSlot The slot to query. - * @returns Block id (hex string). - * '0' if failure. - */ -dfProcessBlockId: procedure expose(sGlobals) -parse arg iSlot - Address df 'CMD' 'asOut' '.pb' iSlot; - if (rc = 0 & asOut.0 > 0) then - do - /* *000b# blk fd436190 pmshell */ - asOut.2 = strip(asOut.2); - parse var asOut.2 .' 'sState' 'sBlockId' 'sProcName - sBlockId = strip(sBlockId) /* needed??? */ - if (sBlockId <> '') then - return sBlockId; - end -return '0'; - - -/** - * Gets the PTDA of a process. - * @param sSlot Slot or special chars '*' and '#'. - * @return Hex pointer to the PTDA. - */ -dfProcPTDA: procedure expose(sGlobals) -parse arg iSlot - Address df 'CMD' 'asOut' '.p' iSlot; - if (rc = 0 & asOut.0 > 0) then - do - /* 0074 0033 0000 0033 0002 blk 0500 f88e6000 fe62d220 f9a0b7e8 1e9c 12 muglrqst - * 000a 0001 0000 0000 000a blk 081e f8812000 ffdba880 f99f7840 1e94 00 *jitdaem - * *000b# 001d 0001 001d 0001 blk 0500 f8814000 fe6270a0 f99f7b44 1e9c 01 pmshell - */ - i = 2; - asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); - parse var asOut.i . . . . . . . hxTSD hxPTDA hxPCB . . .; - hxPTDA = strip(hxPTDA) /* needed??? */ - if (hxPTDA <> '') then - return hxPTDA; - end -return '0'; - - -/** - * Gets a byte from the memory array aMem. - * @param iIndex Byte offset into the array. - */ -memByte: procedure expose(sGlobals) -parse arg iIndex, sMem - cb = memSize(sMem); - if (iIndex < cb) then - do - return x2d(substr(sMem, (iIndex * 2) + 9 + 0, 2)); - end - say 'error-memByte: access out of range. cb='cb ' iIndex='iIndex; -return -1; - - -/** - * Gets a word from the memory array aMem. - * @param iIndex Byte offset into the array. - */ -memWord: procedure expose(sGlobals) -parse arg iIndex, sMem - cb = memSize(sMem); - if (iIndex + 1 < cb) then - do - return x2d(substr(sMem, (iIndex * 2) + 9 + 2, 2)||, - substr(sMem, (iIndex * 2) + 9 + 0, 2)); - end - say 'error-memWord: access out of range. cb='cb ' iIndex='iIndex; -return -1; - - -/** - * Gets a dword from the passed in memory block. - * @param iIndex Byte offset into the array. - * @param sMem Memory block. - * @remark note problems with signed! - */ -memDword: procedure expose(sGlobals) -parse arg iIndex, sMem - cb = memSize(sMem); - if (iIndex + 3 < cb) then - do - iIndex = iIndex*2 + 9; - return x2d(substr(sMem, iIndex + 6, 2)||, - substr(sMem, iIndex + 4, 2)||, - substr(sMem, iIndex + 2, 2)||, - substr(sMem, iIndex + 0, 2)); - end - say 'error-memDword: access out of range. cb='cb ' iIndex='iIndex; -return -1; - - -/** - * Gets a string from the memory array aMem. - * @return String. - * @param iIndex Byte offset into the array aMem. - * @param cchLength Length of the string. (optional) - * If not specified we'll stop at '\0' or end of aMem. - * @param fStoppAtNull Flag that we'll stop at '\0' even when lenght is specifed. (optional) - * Default is to fetch cchLength if cchLength is specifed. - */ -memString: procedure expose(sGlobals) -parse arg iIndex, cchLength, fStoppAtNull, sMem - cb = memSize(sMem); - if (iIndex < cb) then - do - /* handle optional parameters */ - if (fStoppAtNull = '') then - fStoppAtNull = (cchLength = ''); - if (cchLength = '') then - cchLength = cb - iIndex; - else if (cchLength + iIndex > cb) then - cchLength = cb - iIndex; - - /* fetch string */ - sStr = ''; - i = iIndex; - do i = iIndex to iIndex + cchLength - ch = substr(sMem, i*2 + 9, 2); - if (fStoppAtNull) then - if (ch = '00') then - leave; - sStr = sStr||x2c(ch); - end - return sStr; - end - say 'error-memWord: access out of range. cb='cb ' cbLength='cbLength; -return ''; - - -/** - * Dumps a byte range of the given memory to screen. - * @return 0 on success. -1 on failure. - * @paran iIndex Index into the memory block. - * @paran cbLength Length to dump. - * @paran sMem Memory block. - */ -memDumpByte: procedure expose(sGlobals) -parse arg iIndex, cbLength, sMem - cb = memSize(sMem); - if (iIndex < cb & iIndex + cbLength <= cb) then - do - iOff = 0; - do while (cbLength > 0) - i = 0; - sLine = '0000:'||d2x(iOff,8); - do i = 0 to 15 - if (cbLength - i > 0) then - do - if (i = 8) then - sLine = sLine || '-' || d2x(memByte(i + iOff, sMem),2); - else - sLine = sLine || ' ' || d2x(memByte(i + iOff, sMem),2); - end - else - sLine = sLine || ' '; - end - sLine = sLine || ' '; - do i = 0 to 15 - if (cbLength - i <= 0) then - leave; - iCh = memByte(i + iOff, sMem); - if (iCh >= 32) then - sLine = sLine || d2c(iCh); - else - sLine = sLine || '.'; - end - say sLine - iOff = iOff + 16; - cbLength = cbLength - 16; - end - - return 0; - end - say 'error-memDumpByte: access out of range. cb='cb 'iIndex='iIndex 'cbLength='cbLength; -return -1; - - -/** - * Dumps a word range of the given memory to screen. - * @return 0 on success. -1 on failure. - * @paran iIndex Index into the memory block. - * @paran cbLength Length to dump. - * @paran sMem Memory block. - */ -memDumpWord: procedure expose(sGlobals) -parse arg iIndex, cbLength, sMem - cb = memSize(sMem); - if (iIndex < cb & iIndex + cbLength <= cb) then - do - iOff = 0; - do while (cbLength > 0) - i = 0; - sLine = '0000:'||d2x(iOff,8)||' '; - do i = 0 to 7 - if (cbLength - i > 0) then - sLine = sLine || ' ' || d2x(memWord(i*2 + iOff, sMem),4); - else - sLine = sLine || ' '; - end - - say sLine - iOff = iOff + 16; - cbLength = cbLength - 16; - end - - return 0; - end - say 'error-memDumpWord: access out of range. cb='cb ' cbLength='cbLength; -return -1; - - -/** - * Dumps a dword range of the given memory to screen. - * @return 0 on success. -1 on failure. - * @paran iIndex Index into the memory block. - * @paran cbLength Length to dump. - * @paran sMem Memory block. - */ -memDumpDword: procedure expose(sGlobals) -parse arg iIndex, cbLength, sMem - cb = memSize(sMem); - if (iIndex < cb & iIndex + cbLength <= cb) then - do - iOff = 0; - do while (cbLength > 0) - i = 0; - sLine = '0000:'||d2x(iOff, 8)||' '; - do i = 0 to 3 - if (cbLength - i > 0) then - sLine = sLine || ' ' || d2x(memDWord(i*4 + iOff, sMem),8); - else - sLine = sLine || ' '; - end - - say sLine - iOff = iOff + 16; - cbLength = cbLength - 16; - end - - return 0; - end - say 'error-memDumpDword: access out of range. cb='cb ' cbLength='cbLength; -return -1; - - -/** - * Copies a portion of a memory block. - * @param iIndex Index into the memory block. - * @param cbLength Bytes to copy. - * @param sMem Source block. - */ -memCopy: procedure expose(sGlobals) -parse arg iIndex, cbLength, sMem - cb = memSize(sMem); - if (iIndex < cb & iIndex + cbLength <= cb) then - do - sCopy = d2x(cbLength,8)||substr(sMem, 9 + iIndex * 2, cbLength * 2); - return sCopy - end - say 'error-memCopy: access out of range. cb='cb ' cbLength='cbLength; -return -1; - - -/** - * Gets the size of a memory block. - * @param sMem The memory block in question. - */ -memSize: procedure expose(sGlobals) -parse arg sMem -/* debug assertions - start - comment out when stable! */ -if (length(sMem) - 8 <> x2d(left(sMem, 8)) * 2) then -do - say 'fatal assert: memSize got a bad memoryblock' - say ' length(sMem) =' length(sMem); - say ' cb = ' x2d(left(sMem,8)); - exit(16); -end -/* debug assertions - end - comment out when stable! */ -return x2d(left(sMem,8)); - - - -/** - * Dump all processes. (debug more or less) - */ -procDumpAll: procedure expose(sGlobals) - say 'Processes:' - do i = 1 to aProc.0 - say 'slot='aProc.i.hxSlot 'pid='aProc.i.hxPid 'blkid='aProc.i.hxBlockId 'name='aProc.i.sName - end -return 0; - - -/** - * Searches thru the process list looking for a process - * by it's pid and tid. - * @returns Index of the process. - * @param pid Process Id. (Decimal value) - * @param tid Thread Id. (Decimal value) - */ -procFindByPidTid: procedure expose(sGlobals) -parse arg pid, tid - do i = 1 to aProc.0 - if (x2d(aProc.i.hxPid) = pid & x2d(aProc.i.hxTid) = tid) then - return i; - end -return 0; - - -/** - * Searches thru the process list looking for a process - * by it's slot number. - * @returns Index of the process. - * @param iSlot Thread slot number. (Decimal value) - */ -procFindByPidTid: procedure expose(sGlobals) -parse arg iSlot - do i = 1 to aProc.0 - if (x2d(aProc.i.hxSlot) = iSlot) then - return i; - end -return 0; - - -/** - * Novaluehandler. - */ -SignalHanlder_NoValue: - say 'fatal error: novalue signal SIGL='SIGL; -exit(16); - - -/** - * Lowercases a string. - * @param sString String to fold down. - * @returns Lowercase version of sString. - */ -lowercase: procedure expose(sGlobals) -parse arg sString -return translate(sString,, - 'abcdefghijklmnopqrstuvwxyz',, - 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); +/**/ + + +/* + * Init stuff. + */ +signal on NoValue Name SignalHanlder_NoValue; +NUMERIC DIGITS 11 + + +/* + * Globals + */ +sGlobals = 'ulHandleTable aProc. sGlobals'; +ulHandleTable = 0; +aProc.0 = 0; /* process table */ + + +/* + * Args + */ +parse arg sCmd sArgs +sCmd = lowercase(sCmd); +sArg = lowercase(sArgs); +say ''; + + +/* + * Operation + */ +select + /* + * pmsems + */ + when (sCmd = 'pmsemcheck') then + return pmsemCheck(sArgs); + when (sCmd = 'pmsemdump') then + return pmsemDump(sArgs); + when (sCmd = 'pmsemdumpall') then + return PmsemDumpAll(sArgs); + + /* + * Windows Structures. + */ + when (sCmd = 'wnddump') then + return wndDump(sArgs); + + /* + * Window handles. + */ + when (sCmd = 'hwnd') then + return hwnd2PWND(sArgs); + + /* + * PM stuff + */ + when (sCMD = 'pmstatus') then + return PmStatus(sArgs); + + /* + * Generic dump + */ + when (sCmd = 'dump' | sCmd = '.d') then + do + parse var sArgs sStruct sDumperArgs + select + when (sStruct = 'mq') then + return MqDump(sDumperArgs); + when (sStruct = 'pmsem') then + return PmsemDump(sDumperArgs); + when (sStruct = 'qmsg') then + return QmsgDump(sDumperArgs); + when (sStruct = 'sms') then + return SmsDump(sDumperArgs); + when (sStruct = 'sqmsg') then + return SqmsgDump(sDumperArgs); + when (sStruct = 'wnd') then + return WndDump(sDumperArgs); + + otherwise + say 'syntax error: no or invalid structure name.'; + return syntax(sArgs); + end + end + + + /* + * Help and syntax error. + */ + when (sCmd = '?' | sCmd = 'help' | sCmd = '-?' | sCmd = '/?' | sCmd = '-h' | sCmd = '/h' | sCmd = '--help') then + return syntax(sArgs); + otherwise + say 'syntax error: no or invalid command' + return syntax(sArgs); + end +exit(0) + +/** + * Display usage syntax: + */ +syntax: procedure; + parse source . . sSource; + sName = filespec('name', sSource); + say 'PMDF PM Rexx Utils v0.0.1'; + say 'syntax: %'sName' [args]'; + say 'command:' + say ' checksems Check the PM semaphores'; +return -1; + +/* Procedure which we signals on user syntax errors. */ +synatxerror: + say 'syntax error!' + call syntax; +return -1; + + + +/* + * PMSEMS/GRESEMS + * PMSEMS/GRESEMS + * PMSEMS/GRESEMS + * PMSEMS/GRESEMS + * PMSEMS/GRESEMS + * PMSEMS/GRESEMS + * PMSEMS/GRESEMS + * PMSEMS/GRESEMS + * PMSEMS/GRESEMS + */ +/* access functions */ +pmsemSize: procedure expose(sGlobals); return 32; +pmsemIdent: procedure expose(sGlobals); parse arg iSem, sMem; return memString(iSem * 32, 7, 1, sMem); +pmsem386: procedure expose(sGlobals); parse arg iSem, sMem; return memByte( iSem * 32 + 7, sMem); +pmsemPid: procedure expose(sGlobals); parse arg iSem, sMem; return memWord( iSem * 32 + 8, sMem); +pmsemTid: procedure expose(sGlobals); parse arg iSem, sMem; return memWord( iSem * 32 + 10, sMem); +pmsemPTid: procedure expose(sGlobals); parse arg iSem, sMem; return memDWord(iSem * 32 + 8, sMem); +pmsemNested: procedure expose(sGlobals); parse arg iSem, sMem; return memDword(iSem * 32 + 12, sMem); +pmsemWaiting: procedure expose(sGlobals); parse arg iSem, sMem; return memDword(iSem * 32 + 16, sMem); +pmsemUseCount: procedure expose(sGlobals); parse arg iSem, sMem; return memDword(iSem * 32 + 20, sMem);/*debug*/ +pmsemHEV: procedure expose(sGlobals); parse arg iSem, sMem; return memDword(iSem * 32 + 24, sMem); +pmsemCallAddr: procedure expose(sGlobals); parse arg iSem, sMem; return memDword(iSem * 32 + 28, sMem);/*debug*/ + + +/** + * Structure dumper. + * @param sSemMem 32 byte memory block (at least) containing the PMSEM to dump. + * @parma sMsg Optional description message. (optional) + * @param iSem The sem we're dumping. (optional) + */ +pmsemDump1: procedure expose(sGlobals) +parse arg sSemMem, sMsg, iSem + if (iSem <> '') then + say sMsg 'PMSEM/GRESEM -' pmsemGetName(iSem); + else + say sMsg 'PMSEM/GRESEM'; + say ' acIdent:' pmsemIdent(0, sSemMem); + say ' fcSet:' pmsem386(0, sSemMem); + say ' Tid:' d2x(pmsemTid(0, sSemMem),4); + say ' Pid:' d2x(pmsemPid(0, sSemMem),4); + say 'ulNestedUseCount:' d2x(pmsemNested(0, sSemMem),8); + say ' ulWaitingCount:' d2x(pmsemWaiting(0, sSemMem),8); + say ' ulUseCount:' d2x(pmsemUseCount(0, sSemMem),8); + say ' ulEventHandle:' d2x(pmsemHEV(0, sSemMem),8); + say ' ulCallerAddr:' d2x(pmsemCallAddr(0, sSemMem),8); +return 0; + + + + + +/** + * Check if any of the PM sems are taken or have bogus state. + * @returns 0 on success. -1 on error. + */ +PmsemCheck: procedure expose(sGlobals) + sMem = dfReadMem('pmsemaphores', 35 * pmsemSize()) + if (sMem <> '') then + do + /* loop thru them all listing the taken/bogus ones */ + cDumps = 0; + say 'info: checking pm/gre sems' + do iSem = 0 to 34 + rc = pmsemValidate(iSem, sMem); + if (rc <> 1) then + do + if (cDumps = 0) then say ''; + cDumps = cDumps + 1; + if rc = 0 then sMsg = 'Taken'; + else sMsg = 'Bogus'; + call pmsemDump1 memCopy(iSem * pmsemSize(), pmsemSize(), sMem), sMsg, iSem; + end + end + if (cDumps = 0) then + say 'info: pm/gre sems are all free and ok.' + else + say 'info: 'cDumps 'semaphores was taken or bogus.'; + end + else + say 'error: failed to read semaphore table.'; +return -1; + + +/** + * Dump a number of pm/gre sems. + * @returns 0 on success. -1 on error. + */ +PmsemDump: procedure expose(sGlobals) +parse arg sAddr cCount + /* defaults and param validation */ + if (cCount = '' | datatype(cCount) <> 'NUM') then + cCount = 1; + if (sAddr = '') then + signal SyntaxError + + /* read memory and do the dump */ + sMem = dfReadMem(sAddr, cCount * pmsemSize()) + if (sMem <> '') then + do + do i = 0 to cCount - 1 + call pmsemDump1 memCopy(i * pmsemSize(), pmsemSize(), sMem); + end + end + else + say 'error: failed to read semaphore table.'; +return -1; + + +/** + * Dumps all PM/GRE sems + * @returns 0 on success. -1 on error. + */ +PmsemDumpAll: procedure expose(sGlobals) + /* read memory and do the dump */ + sMem = dfReadMem('pmsemaphores', 35 * pmsemSize()) + if (sMem <> '') then + do + do i = 0 to 34 + call pmsemDump1 memCopy(i * pmsemSize(), pmsemSize(), sMem),, i; + end + end + else + say 'error: failed to read semaphore table.'; +return -1; + + +/** + * Checks a give PM sem is free and not bogus. + * @returns 1 if free and not bogus. + * 0 if taken. + * -1 if bogus. + * @param iSem Semaphore index. + * @param sMem Memory containging the semaphore array. + * (If no array use iSem=0) + */ +pmsemValidate: procedure expose(sGlobals) +parse arg iSem, sMem + if (pmsemPTid(iSem, sMem) <> 0) then + return 0; + if (pos(pmsemIdent(iSem, sMem), "PMSEM;;;;;GRESEM") < 0) then + return -1; + if (pmsemWaiting(iSem, sMem) > 0) then + return -1; + if (pmsemHEV(iSem, sMem) = 0) then + return -1; +return 1; + + +/** + * Gives us the name of the pmsem at a given index. + * @returns Namestring. + * @param i Index + */ +pmsemGetName: procedure expose(sGlobals) +parse arg i + select + when i = 0 then return 'PMSEM_ATOM'; + when i = 1 then return 'PMSEM_USER'; + when i = 2 then return 'PMSEM_VISLOCK'; + when i = 3 then return 'PMSEM_DEBUG'; + when i = 4 then return 'PMSEM_HOOK'; + when i = 5 then return 'PMSEM_HEAP'; + when i = 6 then return 'PMSEM_DLL'; + when i = 7 then return 'PMSEM_THUNK'; + when i = 8 then return 'PMSEM_XLCE'; + when i = 9 then return 'PMSEM_UPDATE'; + when i = 10 then return 'PMSEM_CLIP'; + when i = 11 then return 'PMSEM_INPUT'; + when i = 12 then return 'PMSEM_DESKTOP'; + when i = 13 then return 'PMSEM_HANDLE'; + when i = 14 then return 'PMSEM_ALARM'; + when i = 15 then return 'PMSEM_STRRES'; + when i = 16 then return 'PMSEM_TIMER'; + when i = 17 then return 'PMSEM_CONTROLS'; + when i = 18 then return 'GRESEM_GREINIT'; + when i = 19 then return 'GRESEM_AUTOHEAP'; + when i = 20 then return 'GRESEM_PDEV'; + when i = 21 then return 'GRESEM_LDEV'; + when i = 22 then return 'GRESEM_CODEPAGE'; + when i = 23 then return 'GRESEM_HFONT'; + when i = 24 then return 'GRESEM_FONTCNTXT'; + when i = 25 then return 'GRESEM_FNTDRVR'; + when i = 26 then return 'GRESEM_SHMALLOC'; + when i = 27 then return 'GRESEM_GLOBALDATA'; + when i = 28 then return 'GRESEM_DBCSENV'; + when i = 29 then return 'GRESEM_SRVLOCK'; + when i = 30 then return 'GRESEM_SELLOCK'; + when i = 31 then return 'GRESEM_PROCLOCK'; + when i = 32 then return 'GRESEM_DRIVERSEM'; + when i = 33 then return 'GRESEM_SEMLFICACHE'; + when i = 34 then return 'GRESEM_SEMFONTTABLE'; + otherwise + end +return 'Unknown-'i; + + + +/* + * WINDOW STRUCTURE (WND) + * WINDOW STRUCTURE (WND) + * WINDOW STRUCTURE (WND) + * WINDOW STRUCTURE (WND) + * WINDOW STRUCTURE (WND) + * WINDOW STRUCTURE (WND) + * WINDOW STRUCTURE (WND) + * WINDOW STRUCTURE (WND) + * WINDOW STRUCTURE (WND) + * WINDOW STRUCTURE (WND) + */ +/* size and access functions */ +wndSize: procedure expose(sGlobals); return 144; /* guesswork! */ + +wndNext: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('00'), sMem); +wndParent: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('04'), sMem); +wndChild: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('08'), sMem); +wndOwner: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('0c'), sMem); +wndRecs: procedure expose(sGlobals); parse arg iWord,sMem;return memWord( x2d('10') + iWord*2, sMem); +wndStyle: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('18'), sMem); +wndId: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('1c'), sMem); +wndReserved0: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('20'), sMem); +wndReserved1: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('24'), sMem); +wndMsgQueue: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('28'), sMem); +wndHWND: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('2c'), sMem); +wndModel: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('30'), sMem); +wndProc: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('34'), sMem); +wndThunkProc: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('38'), sMem); +wndPresParams: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('40'), sMem); +wndFocus: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('44'), sMem); +wndWPSULong: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('48'), sMem); +wndInstData: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('50'), sMem); +wndOpen32: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('58'), sMem); +/* +wndWord: procedure expose(sGlobals); parse arg iWord,sMem;return memDword(96 + iWord*4, sMem); +*/ +/** dump one wnd structure */ +wndDump1: procedure expose(sGlobals) +parse arg sMem, sMsg + if (sMsg <> '') then + say sMsg + say ' pwndNext:' d2x(wndNext(sMem),8); + say ' pwndParent:' d2x(wndParent(sMem),8); + say ' pwndChild:' d2x(wndChild(sMem),8); + say ' pwndOwner:' d2x(wndOwner(sMem),8); + say ' rcsWindow: xl='wndRecs(0, sMem)',yl='wndRecs(1, sMem), + 'xr='wndRecs(2, sMem)',yr='wndRecs(3, sMem) '(decimal)' + say ' ulStyle:' d2x(wndStyle(sMem),8); + say ' id:' d2x(wndId(sMem),8); + say ' Reserved0:' d2x(wndReserved0(sMem),8); + say ' Reserved1:' d2x(wndReserved1(sMem),8); + say ' pmqMsgQueue:' d2x(wndMsgQueue(sMem),8); + say ' hwnd:' d2x(wndHWND(sMem),8); + say ' fModel16bit:' d2x(wndModel(sMem),8); + say ' pfnWinProc:' d2x(wndProc(sMem),8) '('dfNear('%'d2x(wndProc(sMem),8))')' + if (wndThunkProc(sMem) = 0) then + say ' pfnThunkProc:' d2x(wndThunkProc(sMem),8) + else + say ' pfnThunkProc:' d2x(wndThunkProc(sMem),8) ' ('dfNear('%'d2x(wndThunkProc(sMem),8))')' + say ' ppresParams:' d2x(wndPresParams(sMem),8); + say ' pwndFocus:' d2x(wndFocus(sMem),8); + say ' ulWPS:' d2x(wndWPSULong(sMem),8) '('dfNear('%'d2x(wndWPSULong(sMem),8))')' + say ' pInstData:' d2x(wndInstData(sMem),8); + say ' ??:' d2x(memDword(x2d('54'), sMem),8); + say ' pOpen32:' d2x(wndOpen32(sMem),8); +/* This aint right! + i = 0; + do while (i < 12) + say ' aulWin['d2x(i,2)'-'d2x(i+3,2)']: '||, + d2x(wndWord(i+0, sMem), 8) d2x(wndWord(i+1, sMem), 8), + d2x(wndWord(i+2, sMem), 8) d2x(wndWord(i+3, sMem), 8) + i = i + 4; + end +*/ +return 0; + + +/** + * Dump window structures. + */ +WndDump: procedure expose(sGlobals) +parse arg sAddr cCount + /*defaults and param validation */ + if (cCount = '' | datatype(cCount) <> 'NUM') then + cCount = 1; + if (sAddr = '') then + signal SyntaxError + if (hwndIsHandle(sAddr)) then + do + ulPWND = hwnd2PWND(sAddr); + if (ulPWND > 0) then + sAddr = '%'d2x(ulPWND); + end + + /* read memory */ + sMem = dfReadMem(sAddr, cCount * wndSize()) + if (sMem <> '') then + do + /* loop thru them all listing the taken/bogus ones */ + do i = 0 to cCount - 1 + call wndDump1 memCopy(i * wndSize(), wndSize(), sMem); + end + end + else + say 'error: failed to read window structure at '''sAddr'''.'; +return 0; + + + + +/* + * WINDOW HANDLE (HWND) + * WINDOW HANDLE (HWND) + * WINDOW HANDLE (HWND) + * WINDOW HANDLE (HWND) + * WINDOW HANDLE (HWND) + * WINDOW HANDLE (HWND) + * WINDOW HANDLE (HWND) + * WINDOW HANDLE (HWND) + */ +hwnd2PWND: procedure expose(sGlobals) +parse arg sHwnd sDummy + ulIndex = x2d(right(sHwnd, 4)); + ulBase = hwndpHandleTable(); + if (ulBase = 0) then + return 0; + + ulHandleEntry = ulBase + ulIndex * 8 + 32; +return dfReadDword('%'d2x(ulHandleEntry, 8), 4); + + +/** + * Checks if a value is a hwnd. + * @returns true/false. + * @param sValue Value in question. + */ +hwndIsHandle: procedure expose(sGlobals) +parse arg sValue sDummy + + /* Paranoid check if this is a number or hex value or whatever*/ + sValue = strip(sValue); + if (sValue = '') then + return 0; + if (datatype(sValue) <> 'NUM') then + do /* assumes kind of hexx */ + sValue = translate(sValue); + if (left(sValue, 2) = '0X') then + sValue = substr(sValue, 3); + if (right(sValue,1) = 'H') then + sValue = substr(sValue, 1, length(sValue) - 1); + if (sValue = '') then + return 0; + if (strip(translate(sValue, '', '123456767ABCDEF')) <> '') then + return 0; + ulValue = x2d(sValue); + end + else + do /* check if decimal value, if not try hex */ + if (sValue >= x2d('80000001') & sValue < x2d('8000ffff')) then + return 1; + ulValue = x2d(sValue); + end + + /* Check for valid handle range. */ +return ulValue >= x2d('80000001') & ulValue < x2d('8000ffff'); + + +/** + * Gets the pointer to the handle table. + */ +hwndpHandleTable: procedure expose(sGlobals) + if (ulHandleTable > 0) then + return ulHandleTable; + + ulHandleTable = dfReadDword('pHandleTable', 4); + if (ulHandleTable > 0) then + return ulHandleTable + say 'error-hwndpHandleTable: failed to read pHandleTable'; +return 0; + + + +/* + * MESSAGE QUEUE STRUCTURE (MQ) + * MESSAGE QUEUE STRUCTURE (MQ) + * MESSAGE QUEUE STRUCTURE (MQ) + * MESSAGE QUEUE STRUCTURE (MQ) + * MESSAGE QUEUE STRUCTURE (MQ) + * MESSAGE QUEUE STRUCTURE (MQ) + * MESSAGE QUEUE STRUCTURE (MQ) + * MESSAGE QUEUE STRUCTURE (MQ) + * MESSAGE QUEUE STRUCTURE (MQ) + */ +mqSize: procedure expose(sGlobals); return x2d('b0'); +mqNext: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('00'), sMem); +mqEntrySize: procedure expose(sGlobals); parse arg sMem; return memWord(x2d('04'), sMem); +/*mqQueue: procedure expose(sGlobals); parse arg sMem; return memWord(x2d('06'), sMem);*/ +mqMessages: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('08'), sMem); +/* ?? */ +mqMaxMessages: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('0c'), sMem); +mqPid: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('18'), sMem); +mqTid: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('1c'), sMem); +mqFirstMsg: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('20'), sMem); +mqLastMsg: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('24'), sMem); +mqSGid: procedure expose(sGlobals); parse arg sMem; return memWord(x2d('28'), sMem); +mqHev: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('2c'), sMem); +mqSent: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('3c'), sMem); +mqCurrent: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('40'), sMem); + +mqBadPwnd: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('68'), sMem); +mqBadQueue: procedure expose(sGlobals); parse arg sMem; return memByte(x2d('6c'), sMem); +mqCountTimers: procedure expose(sGlobals); parse arg sMem; return memByte(x2d('6d'), sMem); +mqHeap: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('70'), sMem); +mqHAccel: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('74'), sMem); + +mqShutdown: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('90'), sMem); + +mqRcvdSMSList: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('98'), sMem); +mqSlot: procedure expose(sGlobals); parse arg sMem; return memDword(x2d('a0'), sMem); + +/** dump one mq structure */ +mqDump1: procedure expose(sGlobals) +parse arg sMem; + say ' pmqNext:' d2x(mqNext(sMem), 8); + say ' cbEntry:' d2x(mqEntrySize(sMem), 8); + say ' cMessages:' d2x(mqMessages(sMem), 8); + say 'cMaxMessages:' d2x(mqMaxMessages(sMem), 8); + say ' Tid:' d2x(mqTid(sMem), 8); + say ' Pid:' d2x(mqPid(sMem), 8); + say 'psmsFirstMsg:' d2x(mqFirstMsg(sMem), 8); + say ' psmsLastMsg:' d2x(mqLastMsg(sMem), 8); + say ' SGId:' d2x(mqSGid(sMem), 8); + say ' hev:' d2x(mqHev(sMem), 8); + say ' psmsSent:' d2x(mqSent(sMem), 8); + say ' psmsCurrent:' d2x(mqCurrent(sMem), 8); + say ' pwndBad:' d2x(mqBadPWND(sMem), 8); + say ' fBadQueue:' d2x(mqBadQueue(sMem), 2); + say ' cTimers:' d2x(mqCountTimers(sMem), 2); + say ' pHeap:' d2x(mqHeap(sMem), 8); + say ' HACCEL:' d2x(mqHAccel(sMem), 8); + say ' fchShutdown:' d2x(mqShutdown(sMem), 2); + say ' RcvdSMSList:' d2x(mqRcvdSMSList(sMem), 8); + say ' Slot:' d2x(mqSlot(sMem), 4); +return 0; + + +/** + * Message queue dumper. + * @param sAddr Address expression of a MQ struct, or a window + * which message queue you wanna dump. + * @returns 0 + */ +mqDump: procedure expose(sGlobals) +parse arg sAddr cCount + /*defaults and param validation */ + if (cCount = '' | datatype(cCount) <> 'NUM') then + cCount = 1; + if (sAddr = '') then + signal SyntaxError + + /* + * The user might have passed in an window handle. + * If so we'll dump it's queue. + */ + if (hwndIsHandle(sAddr)) then + do /* input is a hwnd, we will try dump it's queue */ + ulPWND = hwnd2PWND(sAddr); + if (ulPWND > 0) then + do + sMem = dfReadMem('%'d2x(ulPWND), wndSize()); + if (sMem <> '') then + do + ulMQ = wndMsgQueue(sMem); + if (ulMq > 0) then + sAddr = '%'d2x(ulPWND); + end + drop sMem; + end + end + + /* read memory */ + sMem = dfReadMem(sAddr, cCount * mqSize()) + if (sMem <> '') then + do + /* loop thru them all listing the taken/bogus ones */ + do i = 0 to cCount - 1 + call mqDump1 memCopy(i * mqSize(), mqSize(), sMem); + end + end + else + say 'error: failed to read window structure at '''sAddr'''.'; +return 0; + + +/* + * SENDMSG STRUCTRURE (SMS) + * SENDMSG STRUCTRURE (SMS) + * SENDMSG STRUCTRURE (SMS) + * SENDMSG STRUCTRURE (SMS) + * SENDMSG STRUCTRURE (SMS) + * SENDMSG STRUCTRURE (SMS) + * SENDMSG STRUCTRURE (SMS) + */ +smsSize: procedure expose(sGlobals); return 64; +smsNextMaster: procedure expose(sGlobals); parse arg sMem; return memDword(0, sMem); +smsSendHead: procedure expose(sGlobals); parse arg sMem; return memDword(4, sMem); +smsReserved0: procedure expose(sGlobals); parse arg sMem; return memDword(8, sMem); +smsReceiveNext: procedure expose(sGlobals); parse arg sMem; return memDword(12, sMem); +smsTime: procedure expose(sGlobals); parse arg sMem; return memDword(16, sMem); +smsSenderPMQ: procedure expose(sGlobals); parse arg sMem; return memDword(20, sMem); +smsReceiverPMQ: procedure expose(sGlobals); parse arg sMem; return memDword(24, sMem); +smsResult: procedure expose(sGlobals); parse arg sMem; return memDword(28, sMem); +smsReserved1: procedure expose(sGlobals); parse arg sMem; return memDword(32, sMem); +smsPWND: procedure expose(sGlobals); parse arg sMem; return memDword(36, sMem); +smsMsgId: procedure expose(sGlobals); parse arg sMem; return memDword(40, sMem); +smsMP1: procedure expose(sGlobals); parse arg sMem; return memDword(44, sMem); +smsMP2: procedure expose(sGlobals); parse arg sMem; return memDword(48, sMem); +smsReserved2: procedure expose(sGlobals); parse arg sMem; return memDword(52, sMem); +smsReserved3: procedure expose(sGlobals); parse arg sMem; return memDword(56, sMem); +smsReserved4: procedure expose(sGlobals); parse arg sMem; return memDword(60, sMem); + +/** Dumps one sms structure */ +smsDump1: procedure expose(sGlobals) +parse arg sMem + say ' psmsMasterNext:' d2x(smsNextMaster(sMem),8) + say ' psmsSendHead:' d2x(smsSendHead(sMem),8) + say ' Reserved0:' d2x(smsReserved0(sMem),8) + say 'psmsReceiveNext:' d2x(smsReceiveNext(sMem),8) + say ' Time:' d2x(smsTime(sMem),8) + say ' pmqSender:' d2x(smsSenderPMQ(sMem),8) + say ' pmqReceiver:' d2x(smsReceiverPMQ(sMem),8) + say ' ulResult:' d2x(smsResult(sMem),8) + say ' Reserved1:' d2x(smsReserved1(sMem),8) + say ' pWnd:' d2x(smsPWND(sMem),8) + say ' ulMsgId:' d2x(smsMsgId(sMem),8) '('msgMsgIdToText(smsMsgId(sMem))')' + say ' MP1:' d2x(smsMP1(sMem),8) + say ' MP2:' d2x(smsMP2(sMem),8) + say ' Reserved2:' d2x(smsReserved2(sMem),8) + say ' Reserved3:' d2x(smsReserved3(sMem),8) + say ' Reserved4:' d2x(smsReserved4(sMem),8) +return 0; + + +/** + * Send message struct (SMS) dumper. + * @param sAddr Address expression of a sms struct. + * @returns 0 + */ +SmsDump: procedure expose(sGlobals) +parse arg sAddr cCount + /*defaults and param validation */ + if (cCount = '' | datatype(cCount) <> 'NUM') then + cCount = 1; + if (sAddr = '') then + signal SyntaxError + + /* read memory */ + sMem = dfReadMem(sAddr, cCount * smsSize()) + if (sMem <> '') then + do + /* loop thru them all listing the taken/bogus ones */ + do i = 0 to cCount - 1 + call smsDump1 memCopy(i * smsSize(), smsSize(), sMem); + end + end + else + say 'error: failed to read SMS structure at '''sAddr'''.'; +return 0; + + +/* + * PM QUEUE MESSAGE STRUCTURE (QMSG) + * PM QUEUE MESSAGE STRUCTURE (QMSG) + * PM QUEUE MESSAGE STRUCTURE (QMSG) + * PM QUEUE MESSAGE STRUCTURE (QMSG) + * PM QUEUE MESSAGE STRUCTURE (QMSG) + * PM QUEUE MESSAGE STRUCTURE (QMSG) + * PM QUEUE MESSAGE STRUCTURE (QMSG) + */ +qmsgSize: procedure expose(sGlobals); return 32; +qmsgHwnd: procedure expose(sGlobals); parse arg sMem; return memDword(0, sMem); +qmsgMsgId: procedure expose(sGlobals); parse arg sMem; return memDword(4, sMem); +qmsgMP1: procedure expose(sGlobals); parse arg sMem; return memDword(8, sMem); +qmsgMP2: procedure expose(sGlobals); parse arg sMem; return memDword(12, sMem); +qmsgTime: procedure expose(sGlobals); parse arg sMem; return memDword(16, sMem); +qmsgPtlX: procedure expose(sGlobals); parse arg sMem; return memDword(20, sMem); +qmsgPtlY: procedure expose(sGlobals); parse arg sMem; return memDword(24, sMem); +qmsgReserved: procedure expose(sGlobals); parse arg sMem; return memDword(28, sMem); + +qmsgDump1: procedure expose(sGlobals); +parse arg sMem + say ' Hwnd:' d2x(qmsgHwnd(sMem),8) + say ' MsgId:' d2x(qmsgMsgId(sMem),8) '('msgMsgIdToText(qmsgMsgId(sMem))')' + say ' MP1:' d2x(qmsgMP1(sMem),8) + say ' MP2:' d2x(qmsgMP2(sMem),8) + say ' Time:' d2x(qmsgTime(sMem),8) + say ' Ptl.x:' d2x(qmsgPtlX(sMem),8) + say ' Ptl.y:' d2x(qmsgPtlY(sMem),8) + say ' Reserved:' d2x(qmsgReserved(sMem),8) +return 0; + + +/** + * Queue message struct (QMSG) dumper. + * @param sAddr Address expression of a sms struct. + * @returns 0 + */ +QmsgDump: procedure expose(sGlobals) +parse arg sAddr cCount + /*defaults and param validation */ + if (cCount = '' | datatype(cCount) <> 'NUM') then + cCount = 1; + if (sAddr = '') then + signal SyntaxError + + /* read memory */ + sMem = dfReadMem(sAddr, cCount * qmsgSize()) + if (sMem <> '') then + do + /* loop thru them all listing the taken/bogus ones */ + do i = 0 to cCount - 1 + call qmsgDump1 memCopy(i * qmsgSize(), qmsgSize(), sMem); + end + end + else + say 'error: failed to read QMSG structure at '''sAddr'''.'; +return 0; + + +/* + * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) + * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) + * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) + * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) + * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) + * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) + * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) + * PM SYSSTEM QUEUE MESSAGE STRUCTURE (SQMSG) + */ +sqmsgSize: procedure expose(sGlobals); return 32; +sqmsgMsgId: procedure expose(sGlobals); parse arg sMem; return memDword(0, sMem); +sqmsgMP1: procedure expose(sGlobals); parse arg sMem; return memDword(4, sMem); +sqmsgMP2: procedure expose(sGlobals); parse arg sMem; return memDword(8, sMem); +sqmsgTime: procedure expose(sGlobals); parse arg sMem; return memDword(12, sMem); +sqmsgReserved0: procedure expose(sGlobals); parse arg sMem; return memDword(16, sMem); +sqmsgReserved1: procedure expose(sGlobals); parse arg sMem; return memDword(20, sMem); +sqmsgReserved2: procedure expose(sGlobals); parse arg sMem; return memDword(24, sMem); +sqmsgReserved3: procedure expose(sGlobals); parse arg sMem; return memDword(28, sMem); + +sqmsgDump1: procedure expose(sGlobals); +parse arg sMem + say ' MsgId:' d2x(sqmsgMsgId(sMem),8) '('msgMsgIdToText(sqmsgMsgId(sMem))')' + say ' MP1:' d2x(sqmsgMP1(sMem),8) + say ' MP2:' d2x(sqmsgMP2(sMem),8) + say ' Time:' d2x(sqmsgTime(sMem),8) + say 'Reserved0:' d2x(sqmsgReserved0(sMem),8) + say 'Reserved1:' d2x(sqmsgReserved1(sMem),8) + say 'Reserved2:' d2x(sqmsgReserved2(sMem),8) + say 'Reserved3:' d2x(sqmsgReserved3(sMem),8) +return 0; + + +/** + * System Queue message struct (SQMSG) dumper. + * @param sAddr Address expression of a sqmsg struct. + * @returns 0 + */ +SqmsgDump: procedure expose(sGlobals) +parse arg sAddr cCount + /*defaults and param validation */ + if (cCount = '' | datatype(cCount) <> 'NUM') then + cCount = 1; + if (sAddr = '') then + signal SyntaxError + + /* read memory */ + sMem = dfReadMem(sAddr, cCount * sqmsgSize()) + if (sMem <> '') then + do + /* loop thru them all listing the taken/bogus ones */ + do i = 0 to cCount - 1 + call sqmsgDump1 memCopy(i * sqmsgSize(), sqmsgSize(), sMem); + end + end + else + say 'error: failed to read SQMSG structure at '''sAddr'''.'; +return 0; + + +/* + * MSG HELPERS + * MSG HELPERS + * MSG HELPERS + * MSG HELPERS + * MSG HELPERS + * MSG HELPERS + * MSG HELPERS + * MSG HELPERS + */ + +/** + * translates a message ID into a message define string + * @param iMsgId The message id in question. + * @returns Symbol name. + * '' if unknown. + */ +msgMsgIdToText: procedure +parse arg iMsgId + select + when (iMsgId = x2d('0000')) then return 'WM_NULL'; + when (iMsgId = x2d('0001')) then return 'WM_CREATE'; + when (iMsgId = x2d('0002')) then return 'WM_DESTROY'; + /*when (iMsgId == x2d('0003')) then return '';*/ + when (iMsgId = x2d('0004')) then return 'WM_ENABLE'; + when (iMsgId = x2d('0005')) then return 'WM_SHOW'; + when (iMsgId = x2d('0006')) then return 'WM_MOVE'; + when (iMsgId = x2d('0007')) then return 'WM_SIZE'; + when (iMsgId = x2d('0008')) then return 'WM_ADJUSTWINDOWPOS'; + when (iMsgId = x2d('0009')) then return 'WM_CALCVALIDRECTS'; + when (iMsgId = x2d('000a')) then return 'WM_SETWINDOWPARAMS'; + when (iMsgId = x2d('000b')) then return 'WM_QUERYWINDOWPARAMS'; + when (iMsgId = x2d('000c')) then return 'WM_HITTEST'; + when (iMsgId = x2d('000d')) then return 'WM_ACTIVATE'; + when (iMsgId = x2d('000f')) then return 'WM_SETFOCUS'; + when (iMsgId = x2d('0010')) then return 'WM_SETSELECTION'; + when (iMsgId = x2d('0011')) then return 'WM_PPAINT'; + when (iMsgId = x2d('0012')) then return 'WM_PSETFOCUS'; + when (iMsgId = x2d('0013')) then return 'WM_PSYSCOLORCHANGE'; + when (iMsgId = x2d('0014')) then return 'WM_PSIZE'; + when (iMsgId = x2d('0015')) then return 'WM_PACTIVATE'; + when (iMsgId = x2d('0016')) then return 'WM_PCONTROL'; + when (iMsgId = x2d('0020')) then return 'WM_COMMAND'; + when (iMsgId = x2d('0021')) then return 'WM_SYSCOMMAND'; + when (iMsgId = x2d('0022')) then return 'WM_HELP'; + when (iMsgId = x2d('0023')) then return 'WM_PAINT'; + when (iMsgId = x2d('0024')) then return 'WM_TIMER'; + when (iMsgId = x2d('0025')) then return 'WM_SEM1'; + when (iMsgId = x2d('0026')) then return 'WM_SEM2'; + when (iMsgId = x2d('0027')) then return 'WM_SEM3'; + when (iMsgId = x2d('0028')) then return 'WM_SEM4'; + when (iMsgId = x2d('0029')) then return 'WM_CLOSE'; + when (iMsgId = x2d('002a')) then return 'WM_QUIT'; + when (iMsgId = x2d('002b')) then return 'WM_SYSCOLORCHANGE'; + when (iMsgId = x2d('002d')) then return 'WM_SYSVALUECHANGED'; + when (iMsgId = x2d('002e')) then return 'WM_APPTERMINATENOTIFY'; + when (iMsgId = x2d('002f')) then return 'WM_PRESPARAMCHANGED'; + when (iMsgId = x2d('0030')) then return 'WM_CONTROL'; + when (iMsgId = x2d('0031')) then return 'WM_VSCROLL'; + when (iMsgId = x2d('0032')) then return 'WM_HSCROLL'; + when (iMsgId = x2d('0033')) then return 'WM_INITMENU'; + when (iMsgId = x2d('0034')) then return 'WM_MENUSELECT'; + when (iMsgId = x2d('0035')) then return 'WM_MENUEND'; + when (iMsgId = x2d('0036')) then return 'WM_DRAWITEM'; + when (iMsgId = x2d('0037')) then return 'WM_MEASUREITEM'; + when (iMsgId = x2d('0038')) then return 'WM_CONTROLPOINTER'; + when (iMsgId = x2d('003a')) then return 'WM_QUERYDLGCODE'; + when (iMsgId = x2d('003b')) then return 'WM_INITDLG'; + when (iMsgId = x2d('003c')) then return 'WM_SUBSTITUTESTRING'; + when (iMsgId = x2d('003d')) then return 'WM_MATCHMNEMONIC'; + when (iMsgId = x2d('003e')) then return 'WM_SAVEAPPLICATION'; + when (iMsgId = x2d('0490')) then return 'WM_SEMANTICEVENT'; + when (iMsgId = x2d('1000')) then return 'WM_USER'; + when (iMsgId = x2d('007e')) then return 'WM_VRNDISABLED'; + when (iMsgId = x2d('007f')) then return 'WM_VRNENABLED'; + when (iMsgId = x2d('007a')) then return 'WM_CHAR'; + when (iMsgId = x2d('007b')) then return 'WM_VIOCHAR'; + when (iMsgId = x2d('0070')) then return 'WM_MOUSEMOVE'; + when (iMsgId = x2d('0071')) then return 'WM_BUTTON1DOWN'; + when (iMsgId = x2d('0072')) then return 'WM_BUTTON1UP'; + when (iMsgId = x2d('0073')) then return 'WM_BUTTON1DBLCLK'; + when (iMsgId = x2d('0074')) then return 'WM_BUTTON2DOWN'; + when (iMsgId = x2d('0075')) then return 'WM_BUTTON2UP'; + when (iMsgId = x2d('0076')) then return 'WM_BUTTON2DBLCLK'; + when (iMsgId = x2d('0077')) then return 'WM_BUTTON3DOWN'; + when (iMsgId = x2d('0078')) then return 'WM_BUTTON3UP'; + when (iMsgId = x2d('0079')) then return 'WM_BUTTON3DBLCLK'; + when (iMsgId = x2d('007D')) then return 'WM_MOUSEMAP'; + when (iMsgId = x2d('0410')) then return 'WM_CHORD'; + when (iMsgId = x2d('0411')) then return 'WM_BUTTON1MOTIONSTART'; + when (iMsgId = x2d('0412')) then return 'WM_BUTTON1MOTIONEND'; + when (iMsgId = x2d('0413')) then return 'WM_BUTTON1CLICK'; + when (iMsgId = x2d('0414')) then return 'WM_BUTTON2MOTIONSTART'; + when (iMsgId = x2d('0415')) then return 'WM_BUTTON2MOTIONEND'; + when (iMsgId = x2d('0416')) then return 'WM_BUTTON2CLICK'; + when (iMsgId = x2d('0417')) then return 'WM_BUTTON3MOTIONSTART'; + when (iMsgId = x2d('0418')) then return 'WM_BUTTON3MOTIONEND'; + when (iMsgId = x2d('0419')) then return 'WM_BUTTON3CLICK'; + when (iMsgId = x2d('0420')) then return 'WM_BEGINDRAG'; + when (iMsgId = x2d('0421')) then return 'WM_ENDDRAG'; + when (iMsgId = x2d('0422')) then return 'WM_SINGLESELECT'; + when (iMsgId = x2d('0423')) then return 'WM_OPEN'; + when (iMsgId = x2d('0424')) then return 'WM_CONTEXTMENU'; + when (iMsgId = x2d('0425')) then return 'WM_CONTEXTHELP'; + when (iMsgId = x2d('0426')) then return 'WM_TEXTEDIT'; + when (iMsgId = x2d('0427')) then return 'WM_BEGINSELECT'; + when (iMsgId = x2d('0428')) then return 'WM_ENDSELECT'; + when (iMsgId = x2d('0429')) then return 'WM_PICKUP'; + /*when (iMsgId = x2d('')) then return ' + when (iMsgId = x2d('')) then return ' + when (iMsgId = x2d('')) then return ' + when (iMsgId = x2d('')) then return ' + when (iMsgId = x2d('')) then return ' + when (iMsgId = x2d('')) then return ' + when (iMsgId = x2d('')) then return ' + when (iMsgId = x2d('')) then return '*/ + when (iMsgId >= x2d('04c0') & iMsgId <= x2d('04ff')) then return 'WM_PENxxx'; + when (iMsgId >= x2d('0500') & iMsgId <= x2d('05ff')) then return 'WM_MMPMxxx'; + when (iMsgId >= x2d('0600') & iMsgId <= x2d('065f')) then return 'WM_STDDLGxxx'; + when (iMsgId >= x2d('0bd0') & iMsgId <= x2d('0bff')) then return 'WM_BIDIxxx'; + when (iMsgId >= x2d('0f00') & iMsgId <= x2d('0fff')) then return 'WM_HELPMGRxxx'; + otherwise + end +return ''; + + +/* + * PM + * PM + * PM + * PM + * PM + * PM + * PM + * PM + * PM + * PM + * PM + * PM + */ +PmStatus: procedure expose(sGlobals) +parse arg sArgs + + say 'PM Status:' + say ' fBadAppDialog:' d2x(dfReadDword('fBadAppDialog'), 8) + sMem = dfReadMem('qhpsBadApp', 8); + say ' qhpsBadApp: tid='d2x(memWord(0, sMem), 4)','||, + 'pid='d2x(memWord(2, sMem), 4)','||, + 'flags='d2x(memWord(4, sMem), 4)','||, + 'sgid='d2x(memWord(6, sMem), 4); + say '- Focus & Locks -' + pwndFocus = dfReadDword('pwndfocus'); + say ' pwndFocus:' d2x(pwndFocus, 8); + sMem = dfReadMem('%'||d2x(pwndFocus), wndSize()); + if (sMem <> '') then + do + say ' pwndFocus.hwnd :' d2x(wndHwnd(sMem), 8); + say ' pwndFocus.mq :' d2x(wndMsgQueue(sMem), 8); + sMem = dfReadMem('%'||d2x(wndMsgQueue(sMem)), mqSize()); + if (sMem <> '') then + do + say ' pwndFocus.mq.slot:' d2x(mqSlot(sMem), 4); + say ' pwndFocus.mq.tid :' d2x(mqTid(sMem), 8); + say ' pwndFocus.mq.pid :' d2x(mqPid(sMem), 8); + end + end + say ' pmqsyslock:' d2x(dfReadDword('pmqsyslock'), 8); + say ' pmqVisLock:' d2x(dfReadDword('pmqVisLock'), 8) + say ' pwndSysModal:' d2x(dfReadDword('pwndSysModal'), 8) + say ' pmqTrack:' d2x(dfReadDword('pmqTrack'), 8) + say ' pmqLockUpdate:' d2x(dfReadDword('pmqLockUpdate'), 8) + say '- Event Receivers -' + say ' pmqMouseWake:' d2x(dfReadDword('pmqMouseWake'), 8); + say ' pmqKeyWake:' d2x(dfReadDword('pmqKeyWake'), 8) + say ' pmqEventWake:' d2x(dfReadDword('pmqEventWake'), 8) + say '- Lists -' + say ' pSysqueue:' d2x(dfReadDword('pSysqueue'), 8) + say ' pmqList:' d2x(dfReadDword('pmqList'), 8) + say '- Misc Variables -' + say ' pwndDesktop:' d2x(dfReadDword('pwndDesktop'), 8) + say ' pwndObject:' d2x(dfReadDword('pwndObject'), 8) + say ' pmqShell:' d2x(dfReadDword('pmqShell'), 8) + say ' pmqShell2:' d2x(dfReadDword('pmqShell2'), 8) + say ' pmqShutdown:' d2x(dfReadDword('pmqShutdown'), 8) + say ' paAABRegs:' d2x(dfReadDword('paAABRegs'), 8) + + +return 0; + + +/* + * PMDF WORKERS + * PMDF WORKERS + * PMDF WORKERS + * PMDF WORKERS + * PMDF WORKERS + * PMDF WORKERS + * PMDF WORKERS + * PMDF WORKERS + * PMDF WORKERS + * PMDF WORKERS + * PMDF WORKERS + * PMDF WORKERS + */ + + + +/** + * Read memory. + * @param sStartExpr Expression giving the address where to read from. + * @param cbLength Number of _bytes_ to read. + * @returns The memory we have read. (internal format!) + */ +dfReadMem: procedure expose(sGlobals) +parse arg sStartExpr, cbLength + + /* dump memory */ + if ((cbLength // 4) = 0) then + do /* optimized read */ + /*say 'dbg-df: dd' sStartExpr 'L'cbLength/4'T'*/ + Address df 'CMD' 'asOut' 'dd' sStartExpr 'L'cbLength/4'T' + /*say 'dbg-df: rc='rc' asOut.0='asOut.0;*/ + if (rc = 0) then + do + /* interpret output */ + j = 0; + sMem = ''; + do i = 1 to asOut.0 + /* format: + * 0000:00000000 45534D50 0000004D 00000000 00000000 + */ + parse var asOut.i .' 'ch.0' 'ch.1' 'ch.2' 'ch.3 + /*say 'dbg:' asOut.i + say 'dbg:' ch.0','ch.1','ch.2','ch.3*/ + k = 0; + ch.4 = ''; + do while(k <= 3 & strip(ch.k) <> '') + sMem = sMem || substr(ch.k,7,2)||substr(ch.k,5,2)||substr(ch.k,3,2)||substr(ch.k,1,2); + j = j + 4; + k = k + 1; + end + end + if (j <> 0) then + return d2x(j,8)||sMem; + end + + end + else + do /* slower (more output) byte by byte read */ + /*say 'dbg-df: db' sStartExpr 'L'cbLength'T'*/ + Address df 'CMD' 'asOut' 'db' sStartExpr 'L'cbLength'T' + /*say 'dbg-df: rc='rc' asOut.0='asOut.0;*/ + if (rc = 0) then + do + /* interpret output */ + j = 0; + sMem = ''; + do i = 1 to asOut.0 + /* format: + * 9f47:0000af00 50 4d 53 45 4d 00 00 00-00 00 00 00 00 00 00 00 PMSEM........... + */ + ch.16 = ''; + parse var asOut.i .' 'ch.0' 'ch.1' 'ch.2' 'ch.3' 'ch.4' 'ch.5' 'ch.6' 'ch.7'-'ch.8' 'ch.9' 'ch.10' 'ch.11' 'ch.12' 'ch.13' 'ch.14' 'ch.15' '. + k = 0; + /*say 'dbg:' asOut.i + say 'dbg:' ch.0','ch.1','ch.2','ch.3','ch.4','ch.5','ch.6','ch.7','ch.8','ch.9','ch.10','ch.11','ch.12','ch.13','ch.14','ch.15*/ + do while(k <= 15 & strip(ch.k) <> '') + sMem = sMem || ch.k; + j = j + 1; + k = k + 1; + end + end + if (j <> 0) then + return d2x(j,8)||sMem; + end + end +return ''; + + +/** + * Reads a DWord at a given address. + * @param sAddr Address expression. + * @return The value of the dword at given address. + * -1 on error. + */ +dfReadByte: procedure expose(sGlobals) +parse arg sAddr + sMem = dfReadMem(sAddr, 4); + if (sMem <> '') then + return memByte(0, sMem); +return -1; + + +/** + * Reads a Word at a given address. + * @param sAddr Address expression. + * @return The value of the dword at given address. + * -1 on error. + */ +dfReadWord: procedure expose(sGlobals) +parse arg sAddr + sMem = dfReadMem(sAddr, W); + if (sMem <> '') then + return memWord(0, sMem); +return -1; + + +/** + * Reads a DWord at a given address. + * @param sAddr Address expression. + * @return The value of the dword at given address. + * -1 on error. + */ +dfReadDWord: procedure expose(sGlobals) +parse arg sAddr + sMem = dfReadMem(sAddr, 4); + if (sMem <> '') then + return memDword(0, sMem); +return -1; + + +/** + * Get near symbol. + * @param sAddr Address expression. + * @return Near output. + * '' on error. + */ +dfNear: procedure expose(sGlobals) +parse arg sAddr + Address df 'CMD' 'asOut' 'ln' sAddr + if (rc = 0 & asOut.0 > 0) then + do + if (pos('symbols found', asOut.1) <= 0) then + do + parse var asOut.1 .' 'sRet; + return strip(sRet); + end + end +return ''; + + +/** + * Read all processes into global variable. + */ +dfProcessReadAll: procedure expose(sGlobals) +parse arg fBlockInfo + if (\fBlockInfo) then + do + say '[reading processes]' + Address df 'CMD' 'asOut' '.p'; + say '[done]' + if (rc = 0 & asOut.0 > 0) then + do + j = 0; + do i = 1 to asOut.0 + if (word(asOut.i,1) = 'Slot' | strip(asOut.i) = '') then + iterate; + /* 0074 0033 0000 0033 0002 blk 0500 f88e6000 fe62d220 f9a0b7e8 1e9c 12 muglrqst + * 000a 0001 0000 0000 000a blk 081e f8812000 ffdba880 f99f7840 1e94 00 *jitdaem + * *000b# 001d 0001 001d 0001 blk 0500 f8814000 fe6270a0 f99f7b44 1e9c 01 pmshell + */ + j = j + 1; + aProc.j.sType = '0'; + aProc.j.hxBlockId = '0'; + asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); + parse var asOut.i aProc.j.hxSlot, + aProc.j.hxPid, + aProc.j.hxPPid, + aProc.j.hxCsid, + aProc.j.hxOrd, + aProc.j.sState, + aProc.j.hxPri, + aProc.j.hxpTSD, + aProc.j.hxpPTDA, + aProc.j.hxpPCB, + aProc.j.hxDisp, + aProc.j.hxSG, + aProc.j.sName; + if (strip(aProc.j.hxSlot) = '') then + j = j - 1; + end + aProc.0 = j; + end + end + else + do + say '[reading processes]' + Address df 'CMD' 'asOut' '.pb'; + say '[done]' + if (rc = 0 & asOut.0 > 0) then + do + j = 0; + do i = 1 to asOut.0 + if (word(asOut.i,1) = 'Slot' | strip(asOut.i) = '') then + iterate; + /* 0044 blk fd436cf8 4os2 Sem32 8001 005d hevResultCodeSet + * *000b# blk fd436190 pmshell + * 0073 blk 0b008cbe msrv SysSem + */ + asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); + j = j + 1; + aProc.j.hxPid = '0'; + aProc.j.hxPPid = '0'; + aProc.j.hxCsid = '0'; + aProc.j.hxOrd = '0'; + aProc.j.hxPri = '0'; + aProc.j.hxpTSD = '0'; + aProc.j.hxpPTDA = '0'; + aProc.j.hxpPCB = '0'; + aProc.j.hxDisp = '0'; + aProc.j.hxSG = '0'; + parse var asOut.i aProc.j.hxSlot, + aProc.j.sState, + aProc.j.hxBlockId, + aProc.j.sName, + aProc.j.sType .; + if (strip(aProc.j.hxSlot) = '') then + j = j - 1; + end + aProc.0 = j; + end + end +return -1; + + +/** + * Gets the blockId of a process from the dumpformatter. + * @param iSlot The slot to query. + * @returns Block id (hex string). + * '0' if failure. + */ +dfProcessBlockId: procedure expose(sGlobals) +parse arg iSlot + Address df 'CMD' 'asOut' '.pb' iSlot; + if (rc = 0 & asOut.0 > 0) then + do + /* *000b# blk fd436190 pmshell */ + asOut.2 = strip(asOut.2); + parse var asOut.2 .' 'sState' 'sBlockId' 'sProcName + sBlockId = strip(sBlockId) /* needed??? */ + if (sBlockId <> '') then + return sBlockId; + end +return '0'; + + +/** + * Gets the PTDA of a process. + * @param sSlot Slot or special chars '*' and '#'. + * @return Hex pointer to the PTDA. + */ +dfProcPTDA: procedure expose(sGlobals) +parse arg iSlot + Address df 'CMD' 'asOut' '.p' iSlot; + if (rc = 0 & asOut.0 > 0) then + do + /* 0074 0033 0000 0033 0002 blk 0500 f88e6000 fe62d220 f9a0b7e8 1e9c 12 muglrqst + * 000a 0001 0000 0000 000a blk 081e f8812000 ffdba880 f99f7840 1e94 00 *jitdaem + * *000b# 001d 0001 001d 0001 blk 0500 f8814000 fe6270a0 f99f7b44 1e9c 01 pmshell + */ + i = 2; + asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); + parse var asOut.i . . . . . . . hxTSD hxPTDA hxPCB . . .; + hxPTDA = strip(hxPTDA) /* needed??? */ + if (hxPTDA <> '') then + return hxPTDA; + end +return '0'; + + +/** + * Gets a byte from the memory array aMem. + * @param iIndex Byte offset into the array. + */ +memByte: procedure expose(sGlobals) +parse arg iIndex, sMem + cb = memSize(sMem); + if (iIndex < cb) then + do + return x2d(substr(sMem, (iIndex * 2) + 9 + 0, 2)); + end + say 'error-memByte: access out of range. cb='cb ' iIndex='iIndex; +return -1; + + +/** + * Gets a word from the memory array aMem. + * @param iIndex Byte offset into the array. + */ +memWord: procedure expose(sGlobals) +parse arg iIndex, sMem + cb = memSize(sMem); + if (iIndex + 1 < cb) then + do + return x2d(substr(sMem, (iIndex * 2) + 9 + 2, 2)||, + substr(sMem, (iIndex * 2) + 9 + 0, 2)); + end + say 'error-memWord: access out of range. cb='cb ' iIndex='iIndex; +return -1; + + +/** + * Gets a dword from the passed in memory block. + * @param iIndex Byte offset into the array. + * @param sMem Memory block. + * @remark note problems with signed! + */ +memDword: procedure expose(sGlobals) +parse arg iIndex, sMem + cb = memSize(sMem); + if (iIndex + 3 < cb) then + do + iIndex = iIndex*2 + 9; + return x2d(substr(sMem, iIndex + 6, 2)||, + substr(sMem, iIndex + 4, 2)||, + substr(sMem, iIndex + 2, 2)||, + substr(sMem, iIndex + 0, 2)); + end + say 'error-memDword: access out of range. cb='cb ' iIndex='iIndex; +return -1; + + +/** + * Gets a string from the memory array aMem. + * @return String. + * @param iIndex Byte offset into the array aMem. + * @param cchLength Length of the string. (optional) + * If not specified we'll stop at '\0' or end of aMem. + * @param fStoppAtNull Flag that we'll stop at '\0' even when lenght is specifed. (optional) + * Default is to fetch cchLength if cchLength is specifed. + */ +memString: procedure expose(sGlobals) +parse arg iIndex, cchLength, fStoppAtNull, sMem + cb = memSize(sMem); + if (iIndex < cb) then + do + /* handle optional parameters */ + if (fStoppAtNull = '') then + fStoppAtNull = (cchLength = ''); + if (cchLength = '') then + cchLength = cb - iIndex; + else if (cchLength + iIndex > cb) then + cchLength = cb - iIndex; + + /* fetch string */ + sStr = ''; + i = iIndex; + do i = iIndex to iIndex + cchLength + ch = substr(sMem, i*2 + 9, 2); + if (fStoppAtNull) then + if (ch = '00') then + leave; + sStr = sStr||x2c(ch); + end + return sStr; + end + say 'error-memWord: access out of range. cb='cb ' cbLength='cbLength; +return ''; + + +/** + * Dumps a byte range of the given memory to screen. + * @return 0 on success. -1 on failure. + * @paran iIndex Index into the memory block. + * @paran cbLength Length to dump. + * @paran sMem Memory block. + */ +memDumpByte: procedure expose(sGlobals) +parse arg iIndex, cbLength, sMem + cb = memSize(sMem); + if (iIndex < cb & iIndex + cbLength <= cb) then + do + iOff = 0; + do while (cbLength > 0) + i = 0; + sLine = '0000:'||d2x(iOff,8); + do i = 0 to 15 + if (cbLength - i > 0) then + do + if (i = 8) then + sLine = sLine || '-' || d2x(memByte(i + iOff, sMem),2); + else + sLine = sLine || ' ' || d2x(memByte(i + iOff, sMem),2); + end + else + sLine = sLine || ' '; + end + sLine = sLine || ' '; + do i = 0 to 15 + if (cbLength - i <= 0) then + leave; + iCh = memByte(i + iOff, sMem); + if (iCh >= 32) then + sLine = sLine || d2c(iCh); + else + sLine = sLine || '.'; + end + say sLine + iOff = iOff + 16; + cbLength = cbLength - 16; + end + + return 0; + end + say 'error-memDumpByte: access out of range. cb='cb 'iIndex='iIndex 'cbLength='cbLength; +return -1; + + +/** + * Dumps a word range of the given memory to screen. + * @return 0 on success. -1 on failure. + * @paran iIndex Index into the memory block. + * @paran cbLength Length to dump. + * @paran sMem Memory block. + */ +memDumpWord: procedure expose(sGlobals) +parse arg iIndex, cbLength, sMem + cb = memSize(sMem); + if (iIndex < cb & iIndex + cbLength <= cb) then + do + iOff = 0; + do while (cbLength > 0) + i = 0; + sLine = '0000:'||d2x(iOff,8)||' '; + do i = 0 to 7 + if (cbLength - i > 0) then + sLine = sLine || ' ' || d2x(memWord(i*2 + iOff, sMem),4); + else + sLine = sLine || ' '; + end + + say sLine + iOff = iOff + 16; + cbLength = cbLength - 16; + end + + return 0; + end + say 'error-memDumpWord: access out of range. cb='cb ' cbLength='cbLength; +return -1; + + +/** + * Dumps a dword range of the given memory to screen. + * @return 0 on success. -1 on failure. + * @paran iIndex Index into the memory block. + * @paran cbLength Length to dump. + * @paran sMem Memory block. + */ +memDumpDword: procedure expose(sGlobals) +parse arg iIndex, cbLength, sMem + cb = memSize(sMem); + if (iIndex < cb & iIndex + cbLength <= cb) then + do + iOff = 0; + do while (cbLength > 0) + i = 0; + sLine = '0000:'||d2x(iOff, 8)||' '; + do i = 0 to 3 + if (cbLength - i > 0) then + sLine = sLine || ' ' || d2x(memDWord(i*4 + iOff, sMem),8); + else + sLine = sLine || ' '; + end + + say sLine + iOff = iOff + 16; + cbLength = cbLength - 16; + end + + return 0; + end + say 'error-memDumpDword: access out of range. cb='cb ' cbLength='cbLength; +return -1; + + +/** + * Copies a portion of a memory block. + * @param iIndex Index into the memory block. + * @param cbLength Bytes to copy. + * @param sMem Source block. + */ +memCopy: procedure expose(sGlobals) +parse arg iIndex, cbLength, sMem + cb = memSize(sMem); + if (iIndex < cb & iIndex + cbLength <= cb) then + do + sCopy = d2x(cbLength,8)||substr(sMem, 9 + iIndex * 2, cbLength * 2); + return sCopy + end + say 'error-memCopy: access out of range. cb='cb ' cbLength='cbLength; +return -1; + + +/** + * Gets the size of a memory block. + * @param sMem The memory block in question. + */ +memSize: procedure expose(sGlobals) +parse arg sMem +/* debug assertions - start - comment out when stable! */ +if (length(sMem) - 8 <> x2d(left(sMem, 8)) * 2) then +do + say 'fatal assert: memSize got a bad memoryblock' + say ' length(sMem) =' length(sMem); + say ' cb = ' x2d(left(sMem,8)); + exit(16); +end +/* debug assertions - end - comment out when stable! */ +return x2d(left(sMem,8)); + + + +/** + * Dump all processes. (debug more or less) + */ +procDumpAll: procedure expose(sGlobals) + say 'Processes:' + do i = 1 to aProc.0 + say 'slot='aProc.i.hxSlot 'pid='aProc.i.hxPid 'blkid='aProc.i.hxBlockId 'name='aProc.i.sName + end +return 0; + + +/** + * Searches thru the process list looking for a process + * by it's pid and tid. + * @returns Index of the process. + * @param pid Process Id. (Decimal value) + * @param tid Thread Id. (Decimal value) + */ +procFindByPidTid: procedure expose(sGlobals) +parse arg pid, tid + do i = 1 to aProc.0 + if (x2d(aProc.i.hxPid) = pid & x2d(aProc.i.hxTid) = tid) then + return i; + end +return 0; + + +/** + * Searches thru the process list looking for a process + * by it's slot number. + * @returns Index of the process. + * @param iSlot Thread slot number. (Decimal value) + */ +procFindByPidTid: procedure expose(sGlobals) +parse arg iSlot + do i = 1 to aProc.0 + if (x2d(aProc.i.hxSlot) = iSlot) then + return i; + end +return 0; + + +/** + * Novaluehandler. + */ +SignalHanlder_NoValue: + say 'fatal error: novalue signal SIGL='SIGL; +exit(16); + + +/** + * Lowercases a string. + * @param sString String to fold down. + * @returns Lowercase version of sString. + */ +lowercase: procedure expose(sGlobals) +parse arg sString +return translate(sString,, + 'abcdefghijklmnopqrstuvwxyz',, + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); diff --git a/src/win32k/kKrnlLib/tools/pmdfrexx/sem.cmd b/src/win32k/kKrnlLib/tools/pmdfrexx/sem.cmd index 146b544..4176ed1 100644 --- a/src/win32k/kKrnlLib/tools/pmdfrexx/sem.cmd +++ b/src/win32k/kKrnlLib/tools/pmdfrexx/sem.cmd @@ -1,909 +1,909 @@ -/**/ - - -/* - * Init stuff. - */ -signal on NoValue Name SignalHanlder_NoValue; -NUMERIC DIGITS 11 - - -/* - * Globals - */ -sGlobals = 'ulShSemTbl aProc. sGlobals'; -ulShSemTbl = 0; -aProc.0 = 0; /* process table */ - - -/* - * Args - */ -parse arg sCmd sArgs -sCmd = lowercase(sCmd); -sArg = lowercase(sArgs); -say ''; - - -/* - * Operation - */ -select - /* - * - */ - when (sCmd = 'hsem') then - return Hsem2psem(sArgs); - when (sCmd = 'hsemdump') then - return HsemDump(sArgs); - - /* - * Sem32 - */ - when (sCmd = 'sem32check') then - return Sem32Check(sArgs); - - - /* - * Generic dump - */ - when (sCmd = 'dump' | sCmd = '.d') then - do - parse var sArgs sStruct sDumperArgs - select - - otherwise - say 'syntax error: no or invalid structure name.'; - return syntax(sArgs); - end - end - - - /* - * Help and syntax error. - */ - when (sCmd = '?' | sCmd = 'help' | sCmd = '-?' | sCmd = '/?' | sCmd = '-h' | sCmd = '/h' | sCmd = '--help') then - return syntax(sArgs); - otherwise - say 'syntax error: no or invalid command' - return syntax(sArgs); - end -exit(0) - -/** - * Display usage syntax: - */ -syntax: procedure; - parse source . . sSource; - sName = filespec('name', sSource); - say 'PMDF SEM Rexx Utils v0.0.1'; - say 'syntax: %'sName' [args]'; - say 'command:' -return -1; - -/* Procedure which we signals on user syntax errors. */ -synatxerror: - say 'syntax error!' - call syntax; -return -1; - -/* - * HSEM GENERIC SEM HANDLE WORKERS - * HSEM GENERIC SEM HANDLE WORKERS - * HSEM GENERIC SEM HANDLE WORKERS - * HSEM GENERIC SEM HANDLE WORKERS - * HSEM GENERIC SEM HANDLE WORKERS - * HSEM GENERIC SEM HANDLE WORKERS - */ - -/** - * Checks if a handle is private or shared. - * @param iHandle Decimal handle value. - * @returns true/false - */ -hsemIsPrivate: procedure expose(sGlobals) -parse arg iHandle; -return iHandle < x2d('80000000'); /*??*/ - - -/** - * Returns the index part of the handle. - * @param iHandle Decimal handle value. - * @returns Index. - */ -hsemGetIndex: procedure expose(sGlobals) -parse arg iHandle; -return iHandle // 65536; - - -/** - * Returns the index part of the handle. - * @param sHandle Handle. - * @returns Index. - */ -hsemIsHexHandle: procedure expose(sGlobals) -parse arg sHandle; -fResult = (left(sHandle, 4) = '8001') | (left(sHandle, 4) = '8003') | (left(sHandle, 4) = '0001'); -return fResult; - - -/** - * Get shared sem table base address - * @returns ulShSemTbl. - * 0/-1 on error. - */ -hsemShSemTbl: procedure expose(sGlobals) - if (ulShSemTbl > 0) then - return ulShSemTbl; - ulShSemTbl = dfReadDword('_pShSemTbl'); -return ulShSemTbl - - -/** - * Converts a semaphore handle to a sem structure pointer. - * @returns Linear address of sem structure. - * 0 on failure. - * @param Semaphore handle. - */ -Hsem2psem: procedure expose(sGlobals) -parse arg sHSEM - sHSEM = strip(sHSEM); - /* argument stuff. */ - if (hsemIsHexHandle(sHSEM)) then - iHandle = x2d(sHSEM); - else - iHandle = sHSEM; - - /* lookup the index */ - iIdx = hsemGetIndex(iHandle); - ulSem = 0; - if (hsemIsPrivate(iHandle)) then - do /* private sem lookup */ - ulPTDA = dfProcPTDA('#'); - if (dfReadDword('%'ulPTDA '+ (%ulPrTotUsed - %ptda_start)') > iIdx) then - ulSem = dfReadDword('%(dw(%'ulPTDA '+ (%pPrSemTbl - %ptda_start))+'d2x(iIdx*4)')'); - else - say 'error-Hsem2psem: Invalid semaphore index. ('sHSEM')' - end - else - do /* global sem lookup */ - ulAddr = hsemShSemTbl() + iIdx*4; - ulSem = dfReadDword('%'d2x(ulAddr)); - end - - say 'Hsem2psem:' sHSEM '<=>' d2x(ulSem, 8) -return ulSem; - - -/** - * Dump a sem based by handle value. - * @param sHSEM Semaphore handle to dump. - */ -HsemDump: procedure expose(sGlobals) -parse arg sHSEM - - ulSem = hsem2psem(sHSEM); - if (ulSem > 0) then - do - rc = sem32Dump1Ext(ulSem); - return 0; - end -return -1; - - -/** - * Dumps a sem32 structure. - * @param ulAddr Decimal address of the sem32 structure. - */ -sem32Dump1Ext: procedure expose(sGlobals) -parse arg ulAddr - - Address df 'CMD' 'asOut' '.d sem32 %'||d2x(ulAddr); - - do i = 1 to asOut.0; - if (pos('ADDR:', translate(asOut.i)) > 0) then - do - sAddr = strip(substr(asOut.i, pos(':', asOut.i) + 1)) - if (x2d(sAddr) > 0) then - asOut.i = asOut.i '('dfNear(sAddr)')'; - end - if (pos(':', asOut.i) > 0) then - say asOut.i; - end -return 0; - - -/** - * Reads a sem32 structure. - * @param ulAddr Decimal address of the sem32 structure. - */ -sem32Read: procedure expose(sGlobals) -parse arg ulAddr - sSem = ''; - Address df 'CMD' 'asOut' '.d sem32 %'||d2x(ulAddr); - do i = 1 to asOut.0; - asOut.i = strip(translate(asOut.i, '=', ': '||'0d0a'x)); - j = pos(' ', asOut.i); - do while (j > 0) - asOut.i = substr(asOut.i, 1, j-1) || substr(asOut.i, j+1); - j = pos(' ', asOut.i); - end - if (pos('=', asOut.i) > 0) then - do - sSem = sSem||';'asOut.i; - end - end - /*say 'dbg-sem32Read:' sSem;*/ -return sSem; - -/* access methods */ -sem32IsEvent: procedure expose(sGlobals); parse arg sSem; return pos('Event;', sSem) > 0; -sem32IsMutex: procedure expose(sGlobals); parse arg sSem; return pos('Mutex;', sSem) > 0; -sem32IsPrivate: procedure expose(sGlobals); parse arg sSem; return pos('Private', sSem) > 0; -sem32IsShared: procedure expose(sGlobals); parse arg sSem; return pos('Shared', sSem) > 0; -sem32Flags: procedure expose(sGlobals); parse arg sSem; -i = pos('Flags', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); -return ''; -sem32CreateAddr: procedure expose(sGlobals); parse arg sSem; -i = pos('CreateAddr', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); -return ''; -sem32CallerAddr: procedure expose(sGlobals); parse arg sSem; -i = pos('CallerAddr', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); -return ''; -sem32MuxQ: procedure expose(sGlobals); parse arg sSem; -i = pos('pMuxQ', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); -return ''; -sem32OpenCt: procedure expose(sGlobals); parse arg sSem; -i = pos('OpenCount', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); -return '00'; - -sem32mtxIsOwned: procedure expose(sGlobals); parse arg sSem; return sem32mtxOwner(sSem) <> '0000'; -sem32mtxOwner: procedure expose(sGlobals); parse arg sSem; -i = pos('Owner', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); -return '00'; -sem32mtxRequestCt: procedure expose(sGlobals); parse arg sSem; -i = pos('RequestCt', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); -return '00'; -sem32mtxRequesterCt:procedure expose(sGlobals); parse arg sSem; -i = pos('RequesterCt', sSem);if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); -return '00'; - -sem32evtIsPosted: procedure expose(sGlobals); parse arg sSem; return sem32Flags(sSem) = 'Posted'; -sem32evtIsReset: procedure expose(sGlobals); parse arg sSem; return sem32Flags(sSem) = 'Reset'; -sem32evtPostCount: procedure expose(sGlobals); parse arg sSem; -i = pos('PostCount', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); -return ''; - - -/** - * Display all the sems which this process is holding. - * Only private sems are implemented currently. - */ -Sem32Check: procedure expose(sGlobals) - ulPTDA = dfProcPTDA('#'); - - cPr = dfReadDWord('%'ulPTDA '+ (ulPrTotUsed-ptda_start)'); - if (cPr > 0) then - do - sPrTabMem = dfReadMem('%(dw(%'ulPTDA '+(pPrSemTbl-ptda_start)))', cPr*4); - if (sPrTabMem <> '') then - do - do i = 0 to cPr - 1 - if (i // 20 = 0) then - say 'info:' right(i-0,length(cPr)) 'of' cPr 'private sems processed...' - ulSem = memDword(i*4, sPrTabMem); - if (ulSem >= '10000'x) then - do - sSem = sem32Read(ulSem); - if (sSem <> '') then - do - fOk = 1; - if (sem32IsMutex(sSem)) then - do /* mutex*/ - if (sem32mtxIsOwned(sSem)) then - fOk = 0; - end - else if (sem32IsEvent(sSem)) then - do /* event */ - if (sem32evtIsReset(sSem)) then - fOk = 0; - end - else fOk = 0; - if (\fOk) then - call sem32Dump1Ext ulSem; - end - end - end - end - else - say 'error-Sem32Check: failed to read private sem table.' - end - -return 0; - - - -/* - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - */ - - - -/** - * Read memory. - * @param sStartExpr Expression giving the address where to read from. - * @param cbLength Number of _bytes_ to read. - * @returns The memory we have read. (internal format!) - */ -dfReadMem: procedure expose(sGlobals) -parse arg sStartExpr, cbLength - - /* dump memory */ - if ((cbLength // 4) = 0) then - do /* optimized read */ - /*say 'dbg-df: dd' sStartExpr 'L'cbLength/4'T'*/ - Address df 'CMD' 'asOut' 'dd' sStartExpr 'L'cbLength/4'T' - /*say 'dbg-df: rc='rc' asOut.0='asOut.0;*/ - if (rc = 0) then - do - /* interpret output */ - j = 0; - sMem = ''; - do i = 1 to asOut.0 - /* format: - * 0000:00000000 45534D50 0000004D 00000000 00000000 - */ - parse var asOut.i .' 'ch.0' 'ch.1' 'ch.2' 'ch.3 - /*say 'dbg:' asOut.i - say 'dbg:' ch.0','ch.1','ch.2','ch.3*/ - k = 0; - ch.4 = ''; - do while(k <= 3 & strip(ch.k) <> '') - sMem = sMem || substr(ch.k,7,2)||substr(ch.k,5,2)||substr(ch.k,3,2)||substr(ch.k,1,2); - j = j + 4; - k = k + 1; - end - end - if (j <> 0) then - return d2x(j,8)||sMem; - end - - end - else - do /* slower (more output) byte by byte read */ - /*say 'dbg-df: db' sStartExpr 'L'cbLength'T'*/ - Address df 'CMD' 'asOut' 'db' sStartExpr 'L'cbLength'T' - /*say 'dbg-df: rc='rc' asOut.0='asOut.0;*/ - if (rc = 0) then - do - /* interpret output */ - j = 0; - sMem = ''; - do i = 1 to asOut.0 - /* format: - * 9f47:0000af00 50 4d 53 45 4d 00 00 00-00 00 00 00 00 00 00 00 PMSEM........... - */ - ch.16 = ''; - parse var asOut.i .' 'ch.0' 'ch.1' 'ch.2' 'ch.3' 'ch.4' 'ch.5' 'ch.6' 'ch.7'-'ch.8' 'ch.9' 'ch.10' 'ch.11' 'ch.12' 'ch.13' 'ch.14' 'ch.15' '. - k = 0; - /*say 'dbg:' asOut.i - say 'dbg:' ch.0','ch.1','ch.2','ch.3','ch.4','ch.5','ch.6','ch.7','ch.8','ch.9','ch.10','ch.11','ch.12','ch.13','ch.14','ch.15*/ - do while(k <= 15 & strip(ch.k) <> '') - sMem = sMem || ch.k; - j = j + 1; - k = k + 1; - end - end - if (j <> 0) then - return d2x(j,8)||sMem; - end - end -return ''; - - -/** - * Reads a DWord at a given address. - * @param sAddr Address expression. - * @return The value of the dword at given address. - * -1 on error. - */ -dfReadByte: procedure expose(sGlobals) -parse arg sAddr - sMem = dfReadMem(sAddr, 4); - if (sMem <> '') then - return memByte(0, sMem); -return -1; - - -/** - * Reads a Word at a given address. - * @param sAddr Address expression. - * @return The value of the dword at given address. - * -1 on error. - */ -dfReadWord: procedure expose(sGlobals) -parse arg sAddr - sMem = dfReadMem(sAddr, W); - if (sMem <> '') then - return memWord(0, sMem); -return -1; - - -/** - * Reads a DWord at a given address. - * @param sAddr Address expression. - * @return The value of the dword at given address. - * -1 on error. - */ -dfReadDword: procedure expose(sGlobals) -parse arg sAddr - sMem = dfReadMem(sAddr, 4); - if (sMem <> '') then - return memDword(0, sMem); -return -1; - - -/** - * Get near symbol. - * @param sAddr Address expression. - * @return Near output. - * '' on error. - */ -dfNear: procedure expose(sGlobals) -parse arg sAddr - Address df 'CMD' 'asOut' 'ln' sAddr - if (rc = 0 & asOut.0 > 0) then - do - if (pos('symbols found', asOut.1) <= 0) then - do - parse var asOut.1 .' 'sRet; - return strip(sRet); - end - end -return ''; - - -/** - * Read all processes into global variable. - */ -dfProcessReadAll: procedure expose(sGlobals) -parse arg fBlockInfo - if (\fBlockInfo) then - do - say '[reading processes]' - Address df 'CMD' 'asOut' '.p'; - say '[done]' - if (rc = 0 & asOut.0 > 0) then - do - j = 0; - do i = 1 to asOut.0 - if (word(asOut.i,1) = 'Slot' | strip(asOut.i) = '') then - iterate; - /* 0074 0033 0000 0033 0002 blk 0500 f88e6000 fe62d220 f9a0b7e8 1e9c 12 muglrqst - * 000a 0001 0000 0000 000a blk 081e f8812000 ffdba880 f99f7840 1e94 00 *jitdaem - * *000b# 001d 0001 001d 0001 blk 0500 f8814000 fe6270a0 f99f7b44 1e9c 01 pmshell - */ - j = j + 1; - aProc.j.sType = '0'; - aProc.j.hxBlockId = '0'; - asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); - parse var asOut.i aProc.j.hxSlot, - aProc.j.hxPid, - aProc.j.hxPPid, - aProc.j.hxCsid, - aProc.j.hxOrd, - aProc.j.sState, - aProc.j.hxPri, - aProc.j.hxpTSD, - aProc.j.hxpPTDA, - aProc.j.hxpPCB, - aProc.j.hxDisp, - aProc.j.hxSG, - aProc.j.sName; - if (strip(aProc.j.hxSlot) = '') then - j = j - 1; - end - aProc.0 = j; - end - end - else - do - say '[reading processes]' - Address df 'CMD' 'asOut' '.pb'; - say '[done]' - if (rc = 0 & asOut.0 > 0) then - do - j = 0; - do i = 1 to asOut.0 - if (word(asOut.i,1) = 'Slot' | strip(asOut.i) = '') then - iterate; - /* 0044 blk fd436cf8 4os2 Sem32 8001 005d hevResultCodeSet - * *000b# blk fd436190 pmshell - * 0073 blk 0b008cbe msrv SysSem - */ - asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); - j = j + 1; - aProc.j.hxPid = '0'; - aProc.j.hxPPid = '0'; - aProc.j.hxCsid = '0'; - aProc.j.hxOrd = '0'; - aProc.j.hxPri = '0'; - aProc.j.hxpTSD = '0'; - aProc.j.hxpPTDA = '0'; - aProc.j.hxpPCB = '0'; - aProc.j.hxDisp = '0'; - aProc.j.hxSG = '0'; - parse var asOut.i aProc.j.hxSlot, - aProc.j.sState, - aProc.j.hxBlockId, - aProc.j.sName, - aProc.j.sType .; - if (strip(aProc.j.hxSlot) = '') then - j = j - 1; - end - aProc.0 = j; - end - end -return -1; - - -/** - * Gets the blockId of a process from the dumpformatter. - * @param iSlot The slot to query. - * @returns Block id (hex string). - * '0' if failure. - */ -dfProcessBlockId: procedure expose(sGlobals) -parse arg iSlot - Address df 'CMD' 'asOut' '.pb' iSlot; - if (rc = 0 & asOut.0 > 0) then - do - /* *000b# blk fd436190 pmshell */ - asOut.2 = strip(asOut.2); - parse var asOut.2 .' 'sState' 'sBlockId' 'sProcName - sBlockId = strip(sBlockId) /* needed??? */ - if (sBlockId <> '') then - return sBlockId; - end -return '0'; - - -/** - * Gets the PTDA of a process. - * @param sSlot Slot or special chars '*' and '#'. - * @return Hex pointer to the PTDA. - */ -dfProcPTDA: procedure expose(sGlobals) -parse arg iSlot - Address df 'CMD' 'asOut' '.p' iSlot; - if (rc = 0 & asOut.0 > 0) then - do - /* 0074 0033 0000 0033 0002 blk 0500 f88e6000 fe62d220 f9a0b7e8 1e9c 12 muglrqst - * 000a 0001 0000 0000 000a blk 081e f8812000 ffdba880 f99f7840 1e94 00 *jitdaem - * *000b# 001d 0001 001d 0001 blk 0500 f8814000 fe6270a0 f99f7b44 1e9c 01 pmshell - */ - i = 2; - asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); - parse var asOut.i . . . . . . . hxTSD hxPTDA hxPCB . . .; - hxPTDA = strip(hxPTDA) /* needed??? */ - if (hxPTDA <> '') then - return hxPTDA; - end -return '0'; - - -/** - * Gets a byte from the memory array aMem. - * @param iIndex Byte offset into the array. - */ -memByte: procedure expose(sGlobals) -parse arg iIndex, sMem - cb = memSize(sMem); - if (iIndex < cb) then - do - return x2d(substr(sMem, (iIndex * 2) + 9 + 0, 2)); - end - say 'error-memByte: access out of range. cb='cb ' iIndex='iIndex; -return -1; - - -/** - * Gets a word from the memory array aMem. - * @param iIndex Byte offset into the array. - */ -memWord: procedure expose(sGlobals) -parse arg iIndex, sMem - cb = memSize(sMem); - if (iIndex + 1 < cb) then - do - return x2d(substr(sMem, (iIndex * 2) + 9 + 2, 2)||, - substr(sMem, (iIndex * 2) + 9 + 0, 2)); - end - say 'error-memWord: access out of range. cb='cb ' iIndex='iIndex; -return -1; - - -/** - * Gets a dword from the passed in memory block. - * @param iIndex Byte offset into the array. - * @param sMem Memory block. - * @remark note problems with signed! - */ -memDword: procedure expose(sGlobals) -parse arg iIndex, sMem - cb = memSize(sMem); - if (iIndex + 3 < cb) then - do - iIndex = iIndex*2 + 9; - return x2d(substr(sMem, iIndex + 6, 2)||, - substr(sMem, iIndex + 4, 2)||, - substr(sMem, iIndex + 2, 2)||, - substr(sMem, iIndex + 0, 2)); - end - say 'error-memDword: access out of range. cb='cb ' iIndex='iIndex; -return -1; - - -/** - * Gets a string from the memory array aMem. - * @return String. - * @param iIndex Byte offset into the array aMem. - * @param cchLength Length of the string. (optional) - * If not specified we'll stop at '\0' or end of aMem. - * @param fStoppAtNull Flag that we'll stop at '\0' even when lenght is specifed. (optional) - * Default is to fetch cchLength if cchLength is specifed. - */ -memString: procedure expose(sGlobals) -parse arg iIndex, cchLength, fStoppAtNull, sMem - cb = memSize(sMem); - if (iIndex < cb) then - do - /* handle optional parameters */ - if (fStoppAtNull = '') then - fStoppAtNull = (cchLength = ''); - if (cchLength = '') then - cchLength = cb - iIndex; - else if (cchLength + iIndex > cb) then - cchLength = cb - iIndex; - - /* fetch string */ - sStr = ''; - i = iIndex; - do i = iIndex to iIndex + cchLength - ch = substr(sMem, i*2 + 9, 2); - if (fStoppAtNull) then - if (ch = '00') then - leave; - sStr = sStr||x2c(ch); - end - return sStr; - end - say 'error-memWord: access out of range. cb='cb ' cbLength='cbLength; -return ''; - - -/** - * Dumps a byte range of the given memory to screen. - * @return 0 on success. -1 on failure. - * @paran iIndex Index into the memory block. - * @paran cbLength Length to dump. - * @paran sMem Memory block. - */ -memDumpByte: procedure expose(sGlobals) -parse arg iIndex, cbLength, sMem - cb = memSize(sMem); - if (iIndex < cb & iIndex + cbLength <= cb) then - do - iOff = 0; - do while (cbLength > 0) - i = 0; - sLine = '0000:'||d2x(iOff,8); - do i = 0 to 15 - if (cbLength - i > 0) then - do - if (i = 8) then - sLine = sLine || '-' || d2x(memByte(i + iOff, sMem),2); - else - sLine = sLine || ' ' || d2x(memByte(i + iOff, sMem),2); - end - else - sLine = sLine || ' '; - end - sLine = sLine || ' '; - do i = 0 to 15 - if (cbLength - i <= 0) then - leave; - iCh = memByte(i + iOff, sMem); - if (iCh >= 32) then - sLine = sLine || d2c(iCh); - else - sLine = sLine || '.'; - end - say sLine - iOff = iOff + 16; - cbLength = cbLength - 16; - end - - return 0; - end - say 'error-memDumpByte: access out of range. cb='cb 'iIndex='iIndex 'cbLength='cbLength; -return -1; - - -/** - * Dumps a word range of the given memory to screen. - * @return 0 on success. -1 on failure. - * @paran iIndex Index into the memory block. - * @paran cbLength Length to dump. - * @paran sMem Memory block. - */ -memDumpWord: procedure expose(sGlobals) -parse arg iIndex, cbLength, sMem - cb = memSize(sMem); - if (iIndex < cb & iIndex + cbLength <= cb) then - do - iOff = 0; - do while (cbLength > 0) - i = 0; - sLine = '0000:'||d2x(iOff,8)||' '; - do i = 0 to 7 - if (cbLength - i > 0) then - sLine = sLine || ' ' || d2x(memWord(i*2 + iOff, sMem),4); - else - sLine = sLine || ' '; - end - - say sLine - iOff = iOff + 16; - cbLength = cbLength - 16; - end - - return 0; - end - say 'error-memDumpWord: access out of range. cb='cb ' cbLength='cbLength; -return -1; - - -/** - * Dumps a dword range of the given memory to screen. - * @return 0 on success. -1 on failure. - * @paran iIndex Index into the memory block. - * @paran cbLength Length to dump. - * @paran sMem Memory block. - */ -memDumpDword: procedure expose(sGlobals) -parse arg iIndex, cbLength, sMem - cb = memSize(sMem); - if (iIndex < cb & iIndex + cbLength <= cb) then - do - iOff = 0; - do while (cbLength > 0) - i = 0; - sLine = '0000:'||d2x(iOff, 8)||' '; - do i = 0 to 3 - if (cbLength - i > 0) then - sLine = sLine || ' ' || d2x(memDWord(i*4 + iOff, sMem),8); - else - sLine = sLine || ' '; - end - - say sLine - iOff = iOff + 16; - cbLength = cbLength - 16; - end - - return 0; - end - say 'error-memDumpDword: access out of range. cb='cb ' cbLength='cbLength; -return -1; - - -/** - * Copies a portion of a memory block. - * @param iIndex Index into the memory block. - * @param cbLength Bytes to copy. - * @param sMem Source block. - */ -memCopy: procedure expose(sGlobals) -parse arg iIndex, cbLength, sMem - cb = memSize(sMem); - if (iIndex < cb & iIndex + cbLength <= cb) then - do - sCopy = d2x(cbLength,8)||substr(sMem, 9 + iIndex * 2, cbLength * 2); - return sCopy - end - say 'error-memCopy: access out of range. cb='cb ' cbLength='cbLength; -return -1; - - -/** - * Gets the size of a memory block. - * @param sMem The memory block in question. - */ -memSize: procedure expose(sGlobals) -parse arg sMem -/* debug assertions - start - comment out when stable! */ -if (length(sMem) - 8 <> x2d(left(sMem, 8)) * 2) then -do - say 'fatal assert: memSize got a bad memoryblock' - say ' length(sMem) =' length(sMem); - say ' cb = ' x2d(left(sMem,8)); - exit(16); -end -/* debug assertions - end - comment out when stable! */ -return x2d(left(sMem,8)); - - - -/** - * Dump all processes. (debug more or less) - */ -procDumpAll: procedure expose(sGlobals) - say 'Processes:' - do i = 1 to aProc.0 - say 'slot='aProc.i.hxSlot 'pid='aProc.i.hxPid 'blkid='aProc.i.hxBlockId 'name='aProc.i.sName - end -return 0; - - -/** - * Searches thru the process list looking for a process - * by it's pid and tid. - * @returns Index of the process. - * @param pid Process Id. (Decimal value) - * @param tid Thread Id. (Decimal value) - */ -procFindByPidTid: procedure expose(sGlobals) -parse arg pid, tid - do i = 1 to aProc.0 - if (x2d(aProc.i.hxPid) = pid & x2d(aProc.i.hxTid) = tid) then - return i; - end -return 0; - - -/** - * Searches thru the process list looking for a process - * by it's slot number. - * @returns Index of the process. - * @param iSlot Thread slot number. (Decimal value) - */ -procFindByPidTid: procedure expose(sGlobals) -parse arg iSlot - do i = 1 to aProc.0 - if (x2d(aProc.i.hxSlot) = iSlot) then - return i; - end -return 0; - - -/** - * Novaluehandler. - */ -SignalHanlder_NoValue: - say 'fatal error: novalue signal SIGL='SIGL; -exit(16); - - -/** - * Lowercases a string. - * @param sString String to fold down. - * @returns Lowercase version of sString. - */ -lowercase: procedure expose(sGlobals) -parse arg sString -return translate(sString,, - 'abcdefghijklmnopqrstuvwxyz',, - 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); - +/**/ + + +/* + * Init stuff. + */ +signal on NoValue Name SignalHanlder_NoValue; +NUMERIC DIGITS 11 + + +/* + * Globals + */ +sGlobals = 'ulShSemTbl aProc. sGlobals'; +ulShSemTbl = 0; +aProc.0 = 0; /* process table */ + + +/* + * Args + */ +parse arg sCmd sArgs +sCmd = lowercase(sCmd); +sArg = lowercase(sArgs); +say ''; + + +/* + * Operation + */ +select + /* + * + */ + when (sCmd = 'hsem') then + return Hsem2psem(sArgs); + when (sCmd = 'hsemdump') then + return HsemDump(sArgs); + + /* + * Sem32 + */ + when (sCmd = 'sem32check') then + return Sem32Check(sArgs); + + + /* + * Generic dump + */ + when (sCmd = 'dump' | sCmd = '.d') then + do + parse var sArgs sStruct sDumperArgs + select + + otherwise + say 'syntax error: no or invalid structure name.'; + return syntax(sArgs); + end + end + + + /* + * Help and syntax error. + */ + when (sCmd = '?' | sCmd = 'help' | sCmd = '-?' | sCmd = '/?' | sCmd = '-h' | sCmd = '/h' | sCmd = '--help') then + return syntax(sArgs); + otherwise + say 'syntax error: no or invalid command' + return syntax(sArgs); + end +exit(0) + +/** + * Display usage syntax: + */ +syntax: procedure; + parse source . . sSource; + sName = filespec('name', sSource); + say 'PMDF SEM Rexx Utils v0.0.1'; + say 'syntax: %'sName' [args]'; + say 'command:' +return -1; + +/* Procedure which we signals on user syntax errors. */ +synatxerror: + say 'syntax error!' + call syntax; +return -1; + +/* + * HSEM GENERIC SEM HANDLE WORKERS + * HSEM GENERIC SEM HANDLE WORKERS + * HSEM GENERIC SEM HANDLE WORKERS + * HSEM GENERIC SEM HANDLE WORKERS + * HSEM GENERIC SEM HANDLE WORKERS + * HSEM GENERIC SEM HANDLE WORKERS + */ + +/** + * Checks if a handle is private or shared. + * @param iHandle Decimal handle value. + * @returns true/false + */ +hsemIsPrivate: procedure expose(sGlobals) +parse arg iHandle; +return iHandle < x2d('80000000'); /*??*/ + + +/** + * Returns the index part of the handle. + * @param iHandle Decimal handle value. + * @returns Index. + */ +hsemGetIndex: procedure expose(sGlobals) +parse arg iHandle; +return iHandle // 65536; + + +/** + * Returns the index part of the handle. + * @param sHandle Handle. + * @returns Index. + */ +hsemIsHexHandle: procedure expose(sGlobals) +parse arg sHandle; +fResult = (left(sHandle, 4) = '8001') | (left(sHandle, 4) = '8003') | (left(sHandle, 4) = '0001'); +return fResult; + + +/** + * Get shared sem table base address + * @returns ulShSemTbl. + * 0/-1 on error. + */ +hsemShSemTbl: procedure expose(sGlobals) + if (ulShSemTbl > 0) then + return ulShSemTbl; + ulShSemTbl = dfReadDword('_pShSemTbl'); +return ulShSemTbl + + +/** + * Converts a semaphore handle to a sem structure pointer. + * @returns Linear address of sem structure. + * 0 on failure. + * @param Semaphore handle. + */ +Hsem2psem: procedure expose(sGlobals) +parse arg sHSEM + sHSEM = strip(sHSEM); + /* argument stuff. */ + if (hsemIsHexHandle(sHSEM)) then + iHandle = x2d(sHSEM); + else + iHandle = sHSEM; + + /* lookup the index */ + iIdx = hsemGetIndex(iHandle); + ulSem = 0; + if (hsemIsPrivate(iHandle)) then + do /* private sem lookup */ + ulPTDA = dfProcPTDA('#'); + if (dfReadDword('%'ulPTDA '+ (%ulPrTotUsed - %ptda_start)') > iIdx) then + ulSem = dfReadDword('%(dw(%'ulPTDA '+ (%pPrSemTbl - %ptda_start))+'d2x(iIdx*4)')'); + else + say 'error-Hsem2psem: Invalid semaphore index. ('sHSEM')' + end + else + do /* global sem lookup */ + ulAddr = hsemShSemTbl() + iIdx*4; + ulSem = dfReadDword('%'d2x(ulAddr)); + end + + say 'Hsem2psem:' sHSEM '<=>' d2x(ulSem, 8) +return ulSem; + + +/** + * Dump a sem based by handle value. + * @param sHSEM Semaphore handle to dump. + */ +HsemDump: procedure expose(sGlobals) +parse arg sHSEM + + ulSem = hsem2psem(sHSEM); + if (ulSem > 0) then + do + rc = sem32Dump1Ext(ulSem); + return 0; + end +return -1; + + +/** + * Dumps a sem32 structure. + * @param ulAddr Decimal address of the sem32 structure. + */ +sem32Dump1Ext: procedure expose(sGlobals) +parse arg ulAddr + + Address df 'CMD' 'asOut' '.d sem32 %'||d2x(ulAddr); + + do i = 1 to asOut.0; + if (pos('ADDR:', translate(asOut.i)) > 0) then + do + sAddr = strip(substr(asOut.i, pos(':', asOut.i) + 1)) + if (x2d(sAddr) > 0) then + asOut.i = asOut.i '('dfNear(sAddr)')'; + end + if (pos(':', asOut.i) > 0) then + say asOut.i; + end +return 0; + + +/** + * Reads a sem32 structure. + * @param ulAddr Decimal address of the sem32 structure. + */ +sem32Read: procedure expose(sGlobals) +parse arg ulAddr + sSem = ''; + Address df 'CMD' 'asOut' '.d sem32 %'||d2x(ulAddr); + do i = 1 to asOut.0; + asOut.i = strip(translate(asOut.i, '=', ': '||'0d0a'x)); + j = pos(' ', asOut.i); + do while (j > 0) + asOut.i = substr(asOut.i, 1, j-1) || substr(asOut.i, j+1); + j = pos(' ', asOut.i); + end + if (pos('=', asOut.i) > 0) then + do + sSem = sSem||';'asOut.i; + end + end + /*say 'dbg-sem32Read:' sSem;*/ +return sSem; + +/* access methods */ +sem32IsEvent: procedure expose(sGlobals); parse arg sSem; return pos('Event;', sSem) > 0; +sem32IsMutex: procedure expose(sGlobals); parse arg sSem; return pos('Mutex;', sSem) > 0; +sem32IsPrivate: procedure expose(sGlobals); parse arg sSem; return pos('Private', sSem) > 0; +sem32IsShared: procedure expose(sGlobals); parse arg sSem; return pos('Shared', sSem) > 0; +sem32Flags: procedure expose(sGlobals); parse arg sSem; +i = pos('Flags', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); +return ''; +sem32CreateAddr: procedure expose(sGlobals); parse arg sSem; +i = pos('CreateAddr', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); +return ''; +sem32CallerAddr: procedure expose(sGlobals); parse arg sSem; +i = pos('CallerAddr', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); +return ''; +sem32MuxQ: procedure expose(sGlobals); parse arg sSem; +i = pos('pMuxQ', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); +return ''; +sem32OpenCt: procedure expose(sGlobals); parse arg sSem; +i = pos('OpenCount', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); +return '00'; + +sem32mtxIsOwned: procedure expose(sGlobals); parse arg sSem; return sem32mtxOwner(sSem) <> '0000'; +sem32mtxOwner: procedure expose(sGlobals); parse arg sSem; +i = pos('Owner', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); +return '00'; +sem32mtxRequestCt: procedure expose(sGlobals); parse arg sSem; +i = pos('RequestCt', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); +return '00'; +sem32mtxRequesterCt:procedure expose(sGlobals); parse arg sSem; +i = pos('RequesterCt', sSem);if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); +return '00'; + +sem32evtIsPosted: procedure expose(sGlobals); parse arg sSem; return sem32Flags(sSem) = 'Posted'; +sem32evtIsReset: procedure expose(sGlobals); parse arg sSem; return sem32Flags(sSem) = 'Reset'; +sem32evtPostCount: procedure expose(sGlobals); parse arg sSem; +i = pos('PostCount', sSem); if (i > 0) then return substr(sSem, pos('=', sSem, i)+1, 4); +return ''; + + +/** + * Display all the sems which this process is holding. + * Only private sems are implemented currently. + */ +Sem32Check: procedure expose(sGlobals) + ulPTDA = dfProcPTDA('#'); + + cPr = dfReadDWord('%'ulPTDA '+ (ulPrTotUsed-ptda_start)'); + if (cPr > 0) then + do + sPrTabMem = dfReadMem('%(dw(%'ulPTDA '+(pPrSemTbl-ptda_start)))', cPr*4); + if (sPrTabMem <> '') then + do + do i = 0 to cPr - 1 + if (i // 20 = 0) then + say 'info:' right(i-0,length(cPr)) 'of' cPr 'private sems processed...' + ulSem = memDword(i*4, sPrTabMem); + if (ulSem >= '10000'x) then + do + sSem = sem32Read(ulSem); + if (sSem <> '') then + do + fOk = 1; + if (sem32IsMutex(sSem)) then + do /* mutex*/ + if (sem32mtxIsOwned(sSem)) then + fOk = 0; + end + else if (sem32IsEvent(sSem)) then + do /* event */ + if (sem32evtIsReset(sSem)) then + fOk = 0; + end + else fOk = 0; + if (\fOk) then + call sem32Dump1Ext ulSem; + end + end + end + end + else + say 'error-Sem32Check: failed to read private sem table.' + end + +return 0; + + + +/* + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + */ + + + +/** + * Read memory. + * @param sStartExpr Expression giving the address where to read from. + * @param cbLength Number of _bytes_ to read. + * @returns The memory we have read. (internal format!) + */ +dfReadMem: procedure expose(sGlobals) +parse arg sStartExpr, cbLength + + /* dump memory */ + if ((cbLength // 4) = 0) then + do /* optimized read */ + /*say 'dbg-df: dd' sStartExpr 'L'cbLength/4'T'*/ + Address df 'CMD' 'asOut' 'dd' sStartExpr 'L'cbLength/4'T' + /*say 'dbg-df: rc='rc' asOut.0='asOut.0;*/ + if (rc = 0) then + do + /* interpret output */ + j = 0; + sMem = ''; + do i = 1 to asOut.0 + /* format: + * 0000:00000000 45534D50 0000004D 00000000 00000000 + */ + parse var asOut.i .' 'ch.0' 'ch.1' 'ch.2' 'ch.3 + /*say 'dbg:' asOut.i + say 'dbg:' ch.0','ch.1','ch.2','ch.3*/ + k = 0; + ch.4 = ''; + do while(k <= 3 & strip(ch.k) <> '') + sMem = sMem || substr(ch.k,7,2)||substr(ch.k,5,2)||substr(ch.k,3,2)||substr(ch.k,1,2); + j = j + 4; + k = k + 1; + end + end + if (j <> 0) then + return d2x(j,8)||sMem; + end + + end + else + do /* slower (more output) byte by byte read */ + /*say 'dbg-df: db' sStartExpr 'L'cbLength'T'*/ + Address df 'CMD' 'asOut' 'db' sStartExpr 'L'cbLength'T' + /*say 'dbg-df: rc='rc' asOut.0='asOut.0;*/ + if (rc = 0) then + do + /* interpret output */ + j = 0; + sMem = ''; + do i = 1 to asOut.0 + /* format: + * 9f47:0000af00 50 4d 53 45 4d 00 00 00-00 00 00 00 00 00 00 00 PMSEM........... + */ + ch.16 = ''; + parse var asOut.i .' 'ch.0' 'ch.1' 'ch.2' 'ch.3' 'ch.4' 'ch.5' 'ch.6' 'ch.7'-'ch.8' 'ch.9' 'ch.10' 'ch.11' 'ch.12' 'ch.13' 'ch.14' 'ch.15' '. + k = 0; + /*say 'dbg:' asOut.i + say 'dbg:' ch.0','ch.1','ch.2','ch.3','ch.4','ch.5','ch.6','ch.7','ch.8','ch.9','ch.10','ch.11','ch.12','ch.13','ch.14','ch.15*/ + do while(k <= 15 & strip(ch.k) <> '') + sMem = sMem || ch.k; + j = j + 1; + k = k + 1; + end + end + if (j <> 0) then + return d2x(j,8)||sMem; + end + end +return ''; + + +/** + * Reads a DWord at a given address. + * @param sAddr Address expression. + * @return The value of the dword at given address. + * -1 on error. + */ +dfReadByte: procedure expose(sGlobals) +parse arg sAddr + sMem = dfReadMem(sAddr, 4); + if (sMem <> '') then + return memByte(0, sMem); +return -1; + + +/** + * Reads a Word at a given address. + * @param sAddr Address expression. + * @return The value of the dword at given address. + * -1 on error. + */ +dfReadWord: procedure expose(sGlobals) +parse arg sAddr + sMem = dfReadMem(sAddr, W); + if (sMem <> '') then + return memWord(0, sMem); +return -1; + + +/** + * Reads a DWord at a given address. + * @param sAddr Address expression. + * @return The value of the dword at given address. + * -1 on error. + */ +dfReadDword: procedure expose(sGlobals) +parse arg sAddr + sMem = dfReadMem(sAddr, 4); + if (sMem <> '') then + return memDword(0, sMem); +return -1; + + +/** + * Get near symbol. + * @param sAddr Address expression. + * @return Near output. + * '' on error. + */ +dfNear: procedure expose(sGlobals) +parse arg sAddr + Address df 'CMD' 'asOut' 'ln' sAddr + if (rc = 0 & asOut.0 > 0) then + do + if (pos('symbols found', asOut.1) <= 0) then + do + parse var asOut.1 .' 'sRet; + return strip(sRet); + end + end +return ''; + + +/** + * Read all processes into global variable. + */ +dfProcessReadAll: procedure expose(sGlobals) +parse arg fBlockInfo + if (\fBlockInfo) then + do + say '[reading processes]' + Address df 'CMD' 'asOut' '.p'; + say '[done]' + if (rc = 0 & asOut.0 > 0) then + do + j = 0; + do i = 1 to asOut.0 + if (word(asOut.i,1) = 'Slot' | strip(asOut.i) = '') then + iterate; + /* 0074 0033 0000 0033 0002 blk 0500 f88e6000 fe62d220 f9a0b7e8 1e9c 12 muglrqst + * 000a 0001 0000 0000 000a blk 081e f8812000 ffdba880 f99f7840 1e94 00 *jitdaem + * *000b# 001d 0001 001d 0001 blk 0500 f8814000 fe6270a0 f99f7b44 1e9c 01 pmshell + */ + j = j + 1; + aProc.j.sType = '0'; + aProc.j.hxBlockId = '0'; + asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); + parse var asOut.i aProc.j.hxSlot, + aProc.j.hxPid, + aProc.j.hxPPid, + aProc.j.hxCsid, + aProc.j.hxOrd, + aProc.j.sState, + aProc.j.hxPri, + aProc.j.hxpTSD, + aProc.j.hxpPTDA, + aProc.j.hxpPCB, + aProc.j.hxDisp, + aProc.j.hxSG, + aProc.j.sName; + if (strip(aProc.j.hxSlot) = '') then + j = j - 1; + end + aProc.0 = j; + end + end + else + do + say '[reading processes]' + Address df 'CMD' 'asOut' '.pb'; + say '[done]' + if (rc = 0 & asOut.0 > 0) then + do + j = 0; + do i = 1 to asOut.0 + if (word(asOut.i,1) = 'Slot' | strip(asOut.i) = '') then + iterate; + /* 0044 blk fd436cf8 4os2 Sem32 8001 005d hevResultCodeSet + * *000b# blk fd436190 pmshell + * 0073 blk 0b008cbe msrv SysSem + */ + asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); + j = j + 1; + aProc.j.hxPid = '0'; + aProc.j.hxPPid = '0'; + aProc.j.hxCsid = '0'; + aProc.j.hxOrd = '0'; + aProc.j.hxPri = '0'; + aProc.j.hxpTSD = '0'; + aProc.j.hxpPTDA = '0'; + aProc.j.hxpPCB = '0'; + aProc.j.hxDisp = '0'; + aProc.j.hxSG = '0'; + parse var asOut.i aProc.j.hxSlot, + aProc.j.sState, + aProc.j.hxBlockId, + aProc.j.sName, + aProc.j.sType .; + if (strip(aProc.j.hxSlot) = '') then + j = j - 1; + end + aProc.0 = j; + end + end +return -1; + + +/** + * Gets the blockId of a process from the dumpformatter. + * @param iSlot The slot to query. + * @returns Block id (hex string). + * '0' if failure. + */ +dfProcessBlockId: procedure expose(sGlobals) +parse arg iSlot + Address df 'CMD' 'asOut' '.pb' iSlot; + if (rc = 0 & asOut.0 > 0) then + do + /* *000b# blk fd436190 pmshell */ + asOut.2 = strip(asOut.2); + parse var asOut.2 .' 'sState' 'sBlockId' 'sProcName + sBlockId = strip(sBlockId) /* needed??? */ + if (sBlockId <> '') then + return sBlockId; + end +return '0'; + + +/** + * Gets the PTDA of a process. + * @param sSlot Slot or special chars '*' and '#'. + * @return Hex pointer to the PTDA. + */ +dfProcPTDA: procedure expose(sGlobals) +parse arg iSlot + Address df 'CMD' 'asOut' '.p' iSlot; + if (rc = 0 & asOut.0 > 0) then + do + /* 0074 0033 0000 0033 0002 blk 0500 f88e6000 fe62d220 f9a0b7e8 1e9c 12 muglrqst + * 000a 0001 0000 0000 000a blk 081e f8812000 ffdba880 f99f7840 1e94 00 *jitdaem + * *000b# 001d 0001 001d 0001 blk 0500 f8814000 fe6270a0 f99f7b44 1e9c 01 pmshell + */ + i = 2; + asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); + parse var asOut.i . . . . . . . hxTSD hxPTDA hxPCB . . .; + hxPTDA = strip(hxPTDA) /* needed??? */ + if (hxPTDA <> '') then + return hxPTDA; + end +return '0'; + + +/** + * Gets a byte from the memory array aMem. + * @param iIndex Byte offset into the array. + */ +memByte: procedure expose(sGlobals) +parse arg iIndex, sMem + cb = memSize(sMem); + if (iIndex < cb) then + do + return x2d(substr(sMem, (iIndex * 2) + 9 + 0, 2)); + end + say 'error-memByte: access out of range. cb='cb ' iIndex='iIndex; +return -1; + + +/** + * Gets a word from the memory array aMem. + * @param iIndex Byte offset into the array. + */ +memWord: procedure expose(sGlobals) +parse arg iIndex, sMem + cb = memSize(sMem); + if (iIndex + 1 < cb) then + do + return x2d(substr(sMem, (iIndex * 2) + 9 + 2, 2)||, + substr(sMem, (iIndex * 2) + 9 + 0, 2)); + end + say 'error-memWord: access out of range. cb='cb ' iIndex='iIndex; +return -1; + + +/** + * Gets a dword from the passed in memory block. + * @param iIndex Byte offset into the array. + * @param sMem Memory block. + * @remark note problems with signed! + */ +memDword: procedure expose(sGlobals) +parse arg iIndex, sMem + cb = memSize(sMem); + if (iIndex + 3 < cb) then + do + iIndex = iIndex*2 + 9; + return x2d(substr(sMem, iIndex + 6, 2)||, + substr(sMem, iIndex + 4, 2)||, + substr(sMem, iIndex + 2, 2)||, + substr(sMem, iIndex + 0, 2)); + end + say 'error-memDword: access out of range. cb='cb ' iIndex='iIndex; +return -1; + + +/** + * Gets a string from the memory array aMem. + * @return String. + * @param iIndex Byte offset into the array aMem. + * @param cchLength Length of the string. (optional) + * If not specified we'll stop at '\0' or end of aMem. + * @param fStoppAtNull Flag that we'll stop at '\0' even when lenght is specifed. (optional) + * Default is to fetch cchLength if cchLength is specifed. + */ +memString: procedure expose(sGlobals) +parse arg iIndex, cchLength, fStoppAtNull, sMem + cb = memSize(sMem); + if (iIndex < cb) then + do + /* handle optional parameters */ + if (fStoppAtNull = '') then + fStoppAtNull = (cchLength = ''); + if (cchLength = '') then + cchLength = cb - iIndex; + else if (cchLength + iIndex > cb) then + cchLength = cb - iIndex; + + /* fetch string */ + sStr = ''; + i = iIndex; + do i = iIndex to iIndex + cchLength + ch = substr(sMem, i*2 + 9, 2); + if (fStoppAtNull) then + if (ch = '00') then + leave; + sStr = sStr||x2c(ch); + end + return sStr; + end + say 'error-memWord: access out of range. cb='cb ' cbLength='cbLength; +return ''; + + +/** + * Dumps a byte range of the given memory to screen. + * @return 0 on success. -1 on failure. + * @paran iIndex Index into the memory block. + * @paran cbLength Length to dump. + * @paran sMem Memory block. + */ +memDumpByte: procedure expose(sGlobals) +parse arg iIndex, cbLength, sMem + cb = memSize(sMem); + if (iIndex < cb & iIndex + cbLength <= cb) then + do + iOff = 0; + do while (cbLength > 0) + i = 0; + sLine = '0000:'||d2x(iOff,8); + do i = 0 to 15 + if (cbLength - i > 0) then + do + if (i = 8) then + sLine = sLine || '-' || d2x(memByte(i + iOff, sMem),2); + else + sLine = sLine || ' ' || d2x(memByte(i + iOff, sMem),2); + end + else + sLine = sLine || ' '; + end + sLine = sLine || ' '; + do i = 0 to 15 + if (cbLength - i <= 0) then + leave; + iCh = memByte(i + iOff, sMem); + if (iCh >= 32) then + sLine = sLine || d2c(iCh); + else + sLine = sLine || '.'; + end + say sLine + iOff = iOff + 16; + cbLength = cbLength - 16; + end + + return 0; + end + say 'error-memDumpByte: access out of range. cb='cb 'iIndex='iIndex 'cbLength='cbLength; +return -1; + + +/** + * Dumps a word range of the given memory to screen. + * @return 0 on success. -1 on failure. + * @paran iIndex Index into the memory block. + * @paran cbLength Length to dump. + * @paran sMem Memory block. + */ +memDumpWord: procedure expose(sGlobals) +parse arg iIndex, cbLength, sMem + cb = memSize(sMem); + if (iIndex < cb & iIndex + cbLength <= cb) then + do + iOff = 0; + do while (cbLength > 0) + i = 0; + sLine = '0000:'||d2x(iOff,8)||' '; + do i = 0 to 7 + if (cbLength - i > 0) then + sLine = sLine || ' ' || d2x(memWord(i*2 + iOff, sMem),4); + else + sLine = sLine || ' '; + end + + say sLine + iOff = iOff + 16; + cbLength = cbLength - 16; + end + + return 0; + end + say 'error-memDumpWord: access out of range. cb='cb ' cbLength='cbLength; +return -1; + + +/** + * Dumps a dword range of the given memory to screen. + * @return 0 on success. -1 on failure. + * @paran iIndex Index into the memory block. + * @paran cbLength Length to dump. + * @paran sMem Memory block. + */ +memDumpDword: procedure expose(sGlobals) +parse arg iIndex, cbLength, sMem + cb = memSize(sMem); + if (iIndex < cb & iIndex + cbLength <= cb) then + do + iOff = 0; + do while (cbLength > 0) + i = 0; + sLine = '0000:'||d2x(iOff, 8)||' '; + do i = 0 to 3 + if (cbLength - i > 0) then + sLine = sLine || ' ' || d2x(memDWord(i*4 + iOff, sMem),8); + else + sLine = sLine || ' '; + end + + say sLine + iOff = iOff + 16; + cbLength = cbLength - 16; + end + + return 0; + end + say 'error-memDumpDword: access out of range. cb='cb ' cbLength='cbLength; +return -1; + + +/** + * Copies a portion of a memory block. + * @param iIndex Index into the memory block. + * @param cbLength Bytes to copy. + * @param sMem Source block. + */ +memCopy: procedure expose(sGlobals) +parse arg iIndex, cbLength, sMem + cb = memSize(sMem); + if (iIndex < cb & iIndex + cbLength <= cb) then + do + sCopy = d2x(cbLength,8)||substr(sMem, 9 + iIndex * 2, cbLength * 2); + return sCopy + end + say 'error-memCopy: access out of range. cb='cb ' cbLength='cbLength; +return -1; + + +/** + * Gets the size of a memory block. + * @param sMem The memory block in question. + */ +memSize: procedure expose(sGlobals) +parse arg sMem +/* debug assertions - start - comment out when stable! */ +if (length(sMem) - 8 <> x2d(left(sMem, 8)) * 2) then +do + say 'fatal assert: memSize got a bad memoryblock' + say ' length(sMem) =' length(sMem); + say ' cb = ' x2d(left(sMem,8)); + exit(16); +end +/* debug assertions - end - comment out when stable! */ +return x2d(left(sMem,8)); + + + +/** + * Dump all processes. (debug more or less) + */ +procDumpAll: procedure expose(sGlobals) + say 'Processes:' + do i = 1 to aProc.0 + say 'slot='aProc.i.hxSlot 'pid='aProc.i.hxPid 'blkid='aProc.i.hxBlockId 'name='aProc.i.sName + end +return 0; + + +/** + * Searches thru the process list looking for a process + * by it's pid and tid. + * @returns Index of the process. + * @param pid Process Id. (Decimal value) + * @param tid Thread Id. (Decimal value) + */ +procFindByPidTid: procedure expose(sGlobals) +parse arg pid, tid + do i = 1 to aProc.0 + if (x2d(aProc.i.hxPid) = pid & x2d(aProc.i.hxTid) = tid) then + return i; + end +return 0; + + +/** + * Searches thru the process list looking for a process + * by it's slot number. + * @returns Index of the process. + * @param iSlot Thread slot number. (Decimal value) + */ +procFindByPidTid: procedure expose(sGlobals) +parse arg iSlot + do i = 1 to aProc.0 + if (x2d(aProc.i.hxSlot) = iSlot) then + return i; + end +return 0; + + +/** + * Novaluehandler. + */ +SignalHanlder_NoValue: + say 'fatal error: novalue signal SIGL='SIGL; +exit(16); + + +/** + * Lowercases a string. + * @param sString String to fold down. + * @returns Lowercase version of sString. + */ +lowercase: procedure expose(sGlobals) +parse arg sString +return translate(sString,, + 'abcdefghijklmnopqrstuvwxyz',, + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); + diff --git a/src/win32k/kKrnlLib/tools/pmdfrexx/stack.cmd b/src/win32k/kKrnlLib/tools/pmdfrexx/stack.cmd index abb65f0..a3f8951 100644 --- a/src/win32k/kKrnlLib/tools/pmdfrexx/stack.cmd +++ b/src/win32k/kKrnlLib/tools/pmdfrexx/stack.cmd @@ -1,729 +1,729 @@ -/**/ - - -/* - * Init stuff. - */ -signal on NoValue Name SignalHanlder_NoValue; -NUMERIC DIGITS 11 - - -/* - * Globals - */ -sGlobals = 'ulShSemTbl aProc. sGlobals'; -ulShSemTbl = 0; -aProc.0 = 0; /* process table */ - - -/* - * Args - */ -parse arg sCmd sArgs -sCmd = lowercase(sCmd); -sArg = lowercase(sArgs); -say ''; - - -/* - * Operation - */ -select - /* - * - */ - when (sCmd = 'unwind') then - return Unwind(sArgs); - - - /* - * Generic dump - */ - when (sCmd = 'dump' | sCmd = '.d') then - do - parse var sArgs sStruct sDumperArgs - select - - otherwise - say 'syntax error: no or invalid structure name.'; - return syntax(sArgs); - end - end - - - /* - * Help and syntax error. - */ - when (sCmd = '?' | sCmd = 'help' | sCmd = '-?' | sCmd = '/?' | sCmd = '-h' | sCmd = '/h' | sCmd = '--help') then - return syntax(sArgs); - otherwise - say 'syntax error: no or invalid command' - return syntax(sArgs); - end -exit(0) - -/** - * Display usage syntax: - */ -syntax: procedure; - parse source . . sSource; - sName = filespec('name', sSource); - say 'PMDF Stack Rexx Utils v0.0.1'; - say 'syntax: %'sName' [args]'; - say 'command:' -return -1; - -/* Procedure which we signals on user syntax errors. */ -synatxerror: - say 'syntax error!' - call syntax; -return -1; - -/** - * Unwinds a stack from a given ebp value. - * @param hxEBP EBP hex value. - * @param hxSS SS hex value or blank for flat stack. - * @remark doesn't work on 16bit stacks. - */ -Unwind: procedure expose(sGlobals) -parse arg hxEBP hxSS dummy - cbWordSize = 4; - - do while (hxEBP > 0) - /* try read stack frame */ - if (hxSS <> '') then - sAddr = hxSS':'hxEBP; - else - sAddr = '%'hxEBP; - cbMem = cbWordSize*6; - sMem = dfReadMem(sAddr, cbMem); - do while (sMem = '' & cbMem > cbWordSize * 2) - cbMem = cbMem - cbWordSize; - sMem = dfReadMem(sAddr, cbMem); - end - if (sMem = '') then - leave - - /* display stackframe */ - if (cbWordSize = 4) then - iEIP = memDword(cbWordSize, sMem); - else - iEIP = memWord(cbWordSize, sMem); - sLine = 'ret='d2x(iEIP, cbWordSize * 2)' '; - - if (cbWordSize = 4) then - iEBP = memDword(0, sMem); - else - iEBP = memWord(0, sMem); - sLine = sLine || 'nextebp='d2x(iEBP, cbWordSize * 2)' '; - - do i = 2 to memSize(sMem) / cbWordSize - 1 - if (cbWordSize = 4) then - iParm = memDword(cbWordSize * i, sMem); - else - iParm = memWord(cbWordSize * i, sMem); - sLine = sLine || ' ' || d2x(iParm, cbWordSize*2); - end - sSymbol = dfNear('%'d2x(iEIP)); - if (sSymbol <> '') then - sLine = sLine || ' ' || sSymbol; - say sLine; - - /* - * Next - */ - if (iEBP <= 0) then - leave; - hxEBP = d2x(iEBP,cbWordSize*2); - end - - say '*end of stack*' -return 0; - - - -/* - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - * PMDF WORKERS - COMMON COMMON COMMON - */ - - - -/** - * Read memory. - * @param sStartExpr Expression giving the address where to read from. - * @param cbLength Number of _bytes_ to read. - * @returns The memory we have read. (internal format!) - */ -dfReadMem: procedure expose(sGlobals) -parse arg sStartExpr, cbLength - - /* dump memory */ - if ((cbLength // 4) = 0) then - do /* optimized read */ - /*say 'dbg-df: dd' sStartExpr 'L'cbLength/4'T'*/ - Address df 'CMD' 'asOut' 'dd' sStartExpr 'L'cbLength/4'T' - /*say 'dbg-df: rc='rc' asOut.0='asOut.0;*/ - if (rc = 0) then - do - /* interpret output */ - j = 0; - sMem = ''; - do i = 1 to asOut.0 - /* format: - * 0000:00000000 45534D50 0000004D 00000000 00000000 - */ - parse var asOut.i .' 'ch.0' 'ch.1' 'ch.2' 'ch.3 - /*say 'dbg:' asOut.i - say 'dbg:' ch.0','ch.1','ch.2','ch.3*/ - k = 0; - ch.4 = ''; - do while(k <= 3 & strip(ch.k) <> '') - sMem = sMem || substr(ch.k,7,2)||substr(ch.k,5,2)||substr(ch.k,3,2)||substr(ch.k,1,2); - j = j + 4; - k = k + 1; - end - end - if (j <> 0) then - return d2x(j,8)||sMem; - end - - end - else - do /* slower (more output) byte by byte read */ - /*say 'dbg-df: db' sStartExpr 'L'cbLength'T'*/ - Address df 'CMD' 'asOut' 'db' sStartExpr 'L'cbLength'T' - /*say 'dbg-df: rc='rc' asOut.0='asOut.0;*/ - if (rc = 0) then - do - /* interpret output */ - j = 0; - sMem = ''; - do i = 1 to asOut.0 - /* format: - * 9f47:0000af00 50 4d 53 45 4d 00 00 00-00 00 00 00 00 00 00 00 PMSEM........... - */ - ch.16 = ''; - parse var asOut.i .' 'ch.0' 'ch.1' 'ch.2' 'ch.3' 'ch.4' 'ch.5' 'ch.6' 'ch.7'-'ch.8' 'ch.9' 'ch.10' 'ch.11' 'ch.12' 'ch.13' 'ch.14' 'ch.15' '. - k = 0; - /*say 'dbg:' asOut.i - say 'dbg:' ch.0','ch.1','ch.2','ch.3','ch.4','ch.5','ch.6','ch.7','ch.8','ch.9','ch.10','ch.11','ch.12','ch.13','ch.14','ch.15*/ - do while(k <= 15 & strip(ch.k) <> '') - sMem = sMem || ch.k; - j = j + 1; - k = k + 1; - end - end - if (j <> 0) then - return d2x(j,8)||sMem; - end - end -return ''; - - -/** - * Reads a DWord at a given address. - * @param sAddr Address expression. - * @return The value of the dword at given address. - * -1 on error. - */ -dfReadByte: procedure expose(sGlobals) -parse arg sAddr - sMem = dfReadMem(sAddr, 4); - if (sMem <> '') then - return memByte(0, sMem); -return -1; - - -/** - * Reads a Word at a given address. - * @param sAddr Address expression. - * @return The value of the dword at given address. - * -1 on error. - */ -dfReadWord: procedure expose(sGlobals) -parse arg sAddr - sMem = dfReadMem(sAddr, W); - if (sMem <> '') then - return memWord(0, sMem); -return -1; - - -/** - * Reads a DWord at a given address. - * @param sAddr Address expression. - * @return The value of the dword at given address. - * -1 on error. - */ -dfReadDword: procedure expose(sGlobals) -parse arg sAddr - sMem = dfReadMem(sAddr, 4); - if (sMem <> '') then - return memDword(0, sMem); -return -1; - - -/** - * Get near symbol. - * @param sAddr Address expression. - * @return Near output. - * '' on error. - */ -dfNear: procedure expose(sGlobals) -parse arg sAddr - Address df 'CMD' 'asOut' 'ln' sAddr - if (rc = 0 & asOut.0 > 0) then - do - if (pos('symbols found', asOut.1) <= 0) then - do - parse var asOut.1 .' 'sRet; - return strip(sRet); - end - end -return ''; - - -/** - * Read all processes into global variable. - */ -dfProcessReadAll: procedure expose(sGlobals) -parse arg fBlockInfo - if (\fBlockInfo) then - do - say '[reading processes]' - Address df 'CMD' 'asOut' '.p'; - say '[done]' - if (rc = 0 & asOut.0 > 0) then - do - j = 0; - do i = 1 to asOut.0 - if (word(asOut.i,1) = 'Slot' | strip(asOut.i) = '') then - iterate; - /* 0074 0033 0000 0033 0002 blk 0500 f88e6000 fe62d220 f9a0b7e8 1e9c 12 muglrqst - * 000a 0001 0000 0000 000a blk 081e f8812000 ffdba880 f99f7840 1e94 00 *jitdaem - * *000b# 001d 0001 001d 0001 blk 0500 f8814000 fe6270a0 f99f7b44 1e9c 01 pmshell - */ - j = j + 1; - aProc.j.sType = '0'; - aProc.j.hxBlockId = '0'; - asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); - parse var asOut.i aProc.j.hxSlot, - aProc.j.hxPid, - aProc.j.hxPPid, - aProc.j.hxCsid, - aProc.j.hxOrd, - aProc.j.sState, - aProc.j.hxPri, - aProc.j.hxpTSD, - aProc.j.hxpPTDA, - aProc.j.hxpPCB, - aProc.j.hxDisp, - aProc.j.hxSG, - aProc.j.sName; - if (strip(aProc.j.hxSlot) = '') then - j = j - 1; - end - aProc.0 = j; - end - end - else - do - say '[reading processes]' - Address df 'CMD' 'asOut' '.pb'; - say '[done]' - if (rc = 0 & asOut.0 > 0) then - do - j = 0; - do i = 1 to asOut.0 - if (word(asOut.i,1) = 'Slot' | strip(asOut.i) = '') then - iterate; - /* 0044 blk fd436cf8 4os2 Sem32 8001 005d hevResultCodeSet - * *000b# blk fd436190 pmshell - * 0073 blk 0b008cbe msrv SysSem - */ - asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); - j = j + 1; - aProc.j.hxPid = '0'; - aProc.j.hxPPid = '0'; - aProc.j.hxCsid = '0'; - aProc.j.hxOrd = '0'; - aProc.j.hxPri = '0'; - aProc.j.hxpTSD = '0'; - aProc.j.hxpPTDA = '0'; - aProc.j.hxpPCB = '0'; - aProc.j.hxDisp = '0'; - aProc.j.hxSG = '0'; - parse var asOut.i aProc.j.hxSlot, - aProc.j.sState, - aProc.j.hxBlockId, - aProc.j.sName, - aProc.j.sType .; - if (strip(aProc.j.hxSlot) = '') then - j = j - 1; - end - aProc.0 = j; - end - end -return -1; - - -/** - * Gets the blockId of a process from the dumpformatter. - * @param iSlot The slot to query. - * @returns Block id (hex string). - * '0' if failure. - */ -dfProcessBlockId: procedure expose(sGlobals) -parse arg iSlot - Address df 'CMD' 'asOut' '.pb' iSlot; - if (rc = 0 & asOut.0 > 0) then - do - /* *000b# blk fd436190 pmshell */ - asOut.2 = strip(asOut.2); - parse var asOut.2 .' 'sState' 'sBlockId' 'sProcName - sBlockId = strip(sBlockId) /* needed??? */ - if (sBlockId <> '') then - return sBlockId; - end -return '0'; - - -/** - * Gets the PTDA of a process. - * @param sSlot Slot or special chars '*' and '#'. - * @return Hex pointer to the PTDA. - */ -dfProcPTDA: procedure expose(sGlobals) -parse arg iSlot - Address df 'CMD' 'asOut' '.p' iSlot; - if (rc = 0 & asOut.0 > 0) then - do - /* 0074 0033 0000 0033 0002 blk 0500 f88e6000 fe62d220 f9a0b7e8 1e9c 12 muglrqst - * 000a 0001 0000 0000 000a blk 081e f8812000 ffdba880 f99f7840 1e94 00 *jitdaem - * *000b# 001d 0001 001d 0001 blk 0500 f8814000 fe6270a0 f99f7b44 1e9c 01 pmshell - */ - i = 2; - asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); - parse var asOut.i . . . . . . . hxTSD hxPTDA hxPCB . . .; - hxPTDA = strip(hxPTDA) /* needed??? */ - if (hxPTDA <> '') then - return hxPTDA; - end -return '0'; - - -/** - * Gets a byte from the memory array aMem. - * @param iIndex Byte offset into the array. - */ -memByte: procedure expose(sGlobals) -parse arg iIndex, sMem - cb = memSize(sMem); - if (iIndex < cb) then - do - return x2d(substr(sMem, (iIndex * 2) + 9 + 0, 2)); - end - say 'error-memByte: access out of range. cb='cb ' iIndex='iIndex; -return -1; - - -/** - * Gets a word from the memory array aMem. - * @param iIndex Byte offset into the array. - */ -memWord: procedure expose(sGlobals) -parse arg iIndex, sMem - cb = memSize(sMem); - if (iIndex + 1 < cb) then - do - return x2d(substr(sMem, (iIndex * 2) + 9 + 2, 2)||, - substr(sMem, (iIndex * 2) + 9 + 0, 2)); - end - say 'error-memWord: access out of range. cb='cb ' iIndex='iIndex; -return -1; - - -/** - * Gets a dword from the passed in memory block. - * @param iIndex Byte offset into the array. - * @param sMem Memory block. - * @remark note problems with signed! - */ -memDword: procedure expose(sGlobals) -parse arg iIndex, sMem - cb = memSize(sMem); - if (iIndex + 3 < cb) then - do - iIndex = iIndex*2 + 9; - return x2d(substr(sMem, iIndex + 6, 2)||, - substr(sMem, iIndex + 4, 2)||, - substr(sMem, iIndex + 2, 2)||, - substr(sMem, iIndex + 0, 2)); - end - say 'error-memDword: access out of range. cb='cb ' iIndex='iIndex; -return -1; - - -/** - * Gets a string from the memory array aMem. - * @return String. - * @param iIndex Byte offset into the array aMem. - * @param cchLength Length of the string. (optional) - * If not specified we'll stop at '\0' or end of aMem. - * @param fStoppAtNull Flag that we'll stop at '\0' even when lenght is specifed. (optional) - * Default is to fetch cchLength if cchLength is specifed. - */ -memString: procedure expose(sGlobals) -parse arg iIndex, cchLength, fStoppAtNull, sMem - cb = memSize(sMem); - if (iIndex < cb) then - do - /* handle optional parameters */ - if (fStoppAtNull = '') then - fStoppAtNull = (cchLength = ''); - if (cchLength = '') then - cchLength = cb - iIndex; - else if (cchLength + iIndex > cb) then - cchLength = cb - iIndex; - - /* fetch string */ - sStr = ''; - i = iIndex; - do i = iIndex to iIndex + cchLength - ch = substr(sMem, i*2 + 9, 2); - if (fStoppAtNull) then - if (ch = '00') then - leave; - sStr = sStr||x2c(ch); - end - return sStr; - end - say 'error-memWord: access out of range. cb='cb ' cbLength='cbLength; -return ''; - - -/** - * Dumps a byte range of the given memory to screen. - * @return 0 on success. -1 on failure. - * @paran iIndex Index into the memory block. - * @paran cbLength Length to dump. - * @paran sMem Memory block. - */ -memDumpByte: procedure expose(sGlobals) -parse arg iIndex, cbLength, sMem - cb = memSize(sMem); - if (iIndex < cb & iIndex + cbLength <= cb) then - do - iOff = 0; - do while (cbLength > 0) - i = 0; - sLine = '0000:'||d2x(iOff,8); - do i = 0 to 15 - if (cbLength - i > 0) then - do - if (i = 8) then - sLine = sLine || '-' || d2x(memByte(i + iOff, sMem),2); - else - sLine = sLine || ' ' || d2x(memByte(i + iOff, sMem),2); - end - else - sLine = sLine || ' '; - end - sLine = sLine || ' '; - do i = 0 to 15 - if (cbLength - i <= 0) then - leave; - iCh = memByte(i + iOff, sMem); - if (iCh >= 32) then - sLine = sLine || d2c(iCh); - else - sLine = sLine || '.'; - end - say sLine - iOff = iOff + 16; - cbLength = cbLength - 16; - end - - return 0; - end - say 'error-memDumpByte: access out of range. cb='cb 'iIndex='iIndex 'cbLength='cbLength; -return -1; - - -/** - * Dumps a word range of the given memory to screen. - * @return 0 on success. -1 on failure. - * @paran iIndex Index into the memory block. - * @paran cbLength Length to dump. - * @paran sMem Memory block. - */ -memDumpWord: procedure expose(sGlobals) -parse arg iIndex, cbLength, sMem - cb = memSize(sMem); - if (iIndex < cb & iIndex + cbLength <= cb) then - do - iOff = 0; - do while (cbLength > 0) - i = 0; - sLine = '0000:'||d2x(iOff,8)||' '; - do i = 0 to 7 - if (cbLength - i > 0) then - sLine = sLine || ' ' || d2x(memWord(i*2 + iOff, sMem),4); - else - sLine = sLine || ' '; - end - - say sLine - iOff = iOff + 16; - cbLength = cbLength - 16; - end - - return 0; - end - say 'error-memDumpWord: access out of range. cb='cb ' cbLength='cbLength; -return -1; - - -/** - * Dumps a dword range of the given memory to screen. - * @return 0 on success. -1 on failure. - * @paran iIndex Index into the memory block. - * @paran cbLength Length to dump. - * @paran sMem Memory block. - */ -memDumpDword: procedure expose(sGlobals) -parse arg iIndex, cbLength, sMem - cb = memSize(sMem); - if (iIndex < cb & iIndex + cbLength <= cb) then - do - iOff = 0; - do while (cbLength > 0) - i = 0; - sLine = '0000:'||d2x(iOff, 8)||' '; - do i = 0 to 3 - if (cbLength - i > 0) then - sLine = sLine || ' ' || d2x(memDWord(i*4 + iOff, sMem),8); - else - sLine = sLine || ' '; - end - - say sLine - iOff = iOff + 16; - cbLength = cbLength - 16; - end - - return 0; - end - say 'error-memDumpDword: access out of range. cb='cb ' cbLength='cbLength; -return -1; - - -/** - * Copies a portion of a memory block. - * @param iIndex Index into the memory block. - * @param cbLength Bytes to copy. - * @param sMem Source block. - */ -memCopy: procedure expose(sGlobals) -parse arg iIndex, cbLength, sMem - cb = memSize(sMem); - if (iIndex < cb & iIndex + cbLength <= cb) then - do - sCopy = d2x(cbLength,8)||substr(sMem, 9 + iIndex * 2, cbLength * 2); - return sCopy - end - say 'error-memCopy: access out of range. cb='cb ' cbLength='cbLength; -return -1; - - -/** - * Gets the size of a memory block. - * @param sMem The memory block in question. - */ -memSize: procedure expose(sGlobals) -parse arg sMem -/* debug assertions - start - comment out when stable! */ -if (length(sMem) - 8 <> x2d(left(sMem, 8)) * 2) then -do - say 'fatal assert: memSize got a bad memoryblock' - say ' length(sMem) =' length(sMem); - say ' cb = ' x2d(left(sMem,8)); - exit(16); -end -/* debug assertions - end - comment out when stable! */ -return x2d(left(sMem,8)); - - - -/** - * Dump all processes. (debug more or less) - */ -procDumpAll: procedure expose(sGlobals) - say 'Processes:' - do i = 1 to aProc.0 - say 'slot='aProc.i.hxSlot 'pid='aProc.i.hxPid 'blkid='aProc.i.hxBlockId 'name='aProc.i.sName - end -return 0; - - -/** - * Searches thru the process list looking for a process - * by it's pid and tid. - * @returns Index of the process. - * @param pid Process Id. (Decimal value) - * @param tid Thread Id. (Decimal value) - */ -procFindByPidTid: procedure expose(sGlobals) -parse arg pid, tid - do i = 1 to aProc.0 - if (x2d(aProc.i.hxPid) = pid & x2d(aProc.i.hxTid) = tid) then - return i; - end -return 0; - - -/** - * Searches thru the process list looking for a process - * by it's slot number. - * @returns Index of the process. - * @param iSlot Thread slot number. (Decimal value) - */ -procFindByPidTid: procedure expose(sGlobals) -parse arg iSlot - do i = 1 to aProc.0 - if (x2d(aProc.i.hxSlot) = iSlot) then - return i; - end -return 0; - - -/** - * Novaluehandler. - */ -SignalHanlder_NoValue: - say 'fatal error: novalue signal SIGL='SIGL; -exit(16); - - -/** - * Lowercases a string. - * @param sString String to fold down. - * @returns Lowercase version of sString. - */ -lowercase: procedure expose(sGlobals) -parse arg sString -return translate(sString,, - 'abcdefghijklmnopqrstuvwxyz',, - 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); - - +/**/ + + +/* + * Init stuff. + */ +signal on NoValue Name SignalHanlder_NoValue; +NUMERIC DIGITS 11 + + +/* + * Globals + */ +sGlobals = 'ulShSemTbl aProc. sGlobals'; +ulShSemTbl = 0; +aProc.0 = 0; /* process table */ + + +/* + * Args + */ +parse arg sCmd sArgs +sCmd = lowercase(sCmd); +sArg = lowercase(sArgs); +say ''; + + +/* + * Operation + */ +select + /* + * + */ + when (sCmd = 'unwind') then + return Unwind(sArgs); + + + /* + * Generic dump + */ + when (sCmd = 'dump' | sCmd = '.d') then + do + parse var sArgs sStruct sDumperArgs + select + + otherwise + say 'syntax error: no or invalid structure name.'; + return syntax(sArgs); + end + end + + + /* + * Help and syntax error. + */ + when (sCmd = '?' | sCmd = 'help' | sCmd = '-?' | sCmd = '/?' | sCmd = '-h' | sCmd = '/h' | sCmd = '--help') then + return syntax(sArgs); + otherwise + say 'syntax error: no or invalid command' + return syntax(sArgs); + end +exit(0) + +/** + * Display usage syntax: + */ +syntax: procedure; + parse source . . sSource; + sName = filespec('name', sSource); + say 'PMDF Stack Rexx Utils v0.0.1'; + say 'syntax: %'sName' [args]'; + say 'command:' +return -1; + +/* Procedure which we signals on user syntax errors. */ +synatxerror: + say 'syntax error!' + call syntax; +return -1; + +/** + * Unwinds a stack from a given ebp value. + * @param hxEBP EBP hex value. + * @param hxSS SS hex value or blank for flat stack. + * @remark doesn't work on 16bit stacks. + */ +Unwind: procedure expose(sGlobals) +parse arg hxEBP hxSS dummy + cbWordSize = 4; + + do while (hxEBP > 0) + /* try read stack frame */ + if (hxSS <> '') then + sAddr = hxSS':'hxEBP; + else + sAddr = '%'hxEBP; + cbMem = cbWordSize*6; + sMem = dfReadMem(sAddr, cbMem); + do while (sMem = '' & cbMem > cbWordSize * 2) + cbMem = cbMem - cbWordSize; + sMem = dfReadMem(sAddr, cbMem); + end + if (sMem = '') then + leave + + /* display stackframe */ + if (cbWordSize = 4) then + iEIP = memDword(cbWordSize, sMem); + else + iEIP = memWord(cbWordSize, sMem); + sLine = 'ret='d2x(iEIP, cbWordSize * 2)' '; + + if (cbWordSize = 4) then + iEBP = memDword(0, sMem); + else + iEBP = memWord(0, sMem); + sLine = sLine || 'nextebp='d2x(iEBP, cbWordSize * 2)' '; + + do i = 2 to memSize(sMem) / cbWordSize - 1 + if (cbWordSize = 4) then + iParm = memDword(cbWordSize * i, sMem); + else + iParm = memWord(cbWordSize * i, sMem); + sLine = sLine || ' ' || d2x(iParm, cbWordSize*2); + end + sSymbol = dfNear('%'d2x(iEIP)); + if (sSymbol <> '') then + sLine = sLine || ' ' || sSymbol; + say sLine; + + /* + * Next + */ + if (iEBP <= 0) then + leave; + hxEBP = d2x(iEBP,cbWordSize*2); + end + + say '*end of stack*' +return 0; + + + +/* + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + * PMDF WORKERS - COMMON COMMON COMMON + */ + + + +/** + * Read memory. + * @param sStartExpr Expression giving the address where to read from. + * @param cbLength Number of _bytes_ to read. + * @returns The memory we have read. (internal format!) + */ +dfReadMem: procedure expose(sGlobals) +parse arg sStartExpr, cbLength + + /* dump memory */ + if ((cbLength // 4) = 0) then + do /* optimized read */ + /*say 'dbg-df: dd' sStartExpr 'L'cbLength/4'T'*/ + Address df 'CMD' 'asOut' 'dd' sStartExpr 'L'cbLength/4'T' + /*say 'dbg-df: rc='rc' asOut.0='asOut.0;*/ + if (rc = 0) then + do + /* interpret output */ + j = 0; + sMem = ''; + do i = 1 to asOut.0 + /* format: + * 0000:00000000 45534D50 0000004D 00000000 00000000 + */ + parse var asOut.i .' 'ch.0' 'ch.1' 'ch.2' 'ch.3 + /*say 'dbg:' asOut.i + say 'dbg:' ch.0','ch.1','ch.2','ch.3*/ + k = 0; + ch.4 = ''; + do while(k <= 3 & strip(ch.k) <> '') + sMem = sMem || substr(ch.k,7,2)||substr(ch.k,5,2)||substr(ch.k,3,2)||substr(ch.k,1,2); + j = j + 4; + k = k + 1; + end + end + if (j <> 0) then + return d2x(j,8)||sMem; + end + + end + else + do /* slower (more output) byte by byte read */ + /*say 'dbg-df: db' sStartExpr 'L'cbLength'T'*/ + Address df 'CMD' 'asOut' 'db' sStartExpr 'L'cbLength'T' + /*say 'dbg-df: rc='rc' asOut.0='asOut.0;*/ + if (rc = 0) then + do + /* interpret output */ + j = 0; + sMem = ''; + do i = 1 to asOut.0 + /* format: + * 9f47:0000af00 50 4d 53 45 4d 00 00 00-00 00 00 00 00 00 00 00 PMSEM........... + */ + ch.16 = ''; + parse var asOut.i .' 'ch.0' 'ch.1' 'ch.2' 'ch.3' 'ch.4' 'ch.5' 'ch.6' 'ch.7'-'ch.8' 'ch.9' 'ch.10' 'ch.11' 'ch.12' 'ch.13' 'ch.14' 'ch.15' '. + k = 0; + /*say 'dbg:' asOut.i + say 'dbg:' ch.0','ch.1','ch.2','ch.3','ch.4','ch.5','ch.6','ch.7','ch.8','ch.9','ch.10','ch.11','ch.12','ch.13','ch.14','ch.15*/ + do while(k <= 15 & strip(ch.k) <> '') + sMem = sMem || ch.k; + j = j + 1; + k = k + 1; + end + end + if (j <> 0) then + return d2x(j,8)||sMem; + end + end +return ''; + + +/** + * Reads a DWord at a given address. + * @param sAddr Address expression. + * @return The value of the dword at given address. + * -1 on error. + */ +dfReadByte: procedure expose(sGlobals) +parse arg sAddr + sMem = dfReadMem(sAddr, 4); + if (sMem <> '') then + return memByte(0, sMem); +return -1; + + +/** + * Reads a Word at a given address. + * @param sAddr Address expression. + * @return The value of the dword at given address. + * -1 on error. + */ +dfReadWord: procedure expose(sGlobals) +parse arg sAddr + sMem = dfReadMem(sAddr, W); + if (sMem <> '') then + return memWord(0, sMem); +return -1; + + +/** + * Reads a DWord at a given address. + * @param sAddr Address expression. + * @return The value of the dword at given address. + * -1 on error. + */ +dfReadDword: procedure expose(sGlobals) +parse arg sAddr + sMem = dfReadMem(sAddr, 4); + if (sMem <> '') then + return memDword(0, sMem); +return -1; + + +/** + * Get near symbol. + * @param sAddr Address expression. + * @return Near output. + * '' on error. + */ +dfNear: procedure expose(sGlobals) +parse arg sAddr + Address df 'CMD' 'asOut' 'ln' sAddr + if (rc = 0 & asOut.0 > 0) then + do + if (pos('symbols found', asOut.1) <= 0) then + do + parse var asOut.1 .' 'sRet; + return strip(sRet); + end + end +return ''; + + +/** + * Read all processes into global variable. + */ +dfProcessReadAll: procedure expose(sGlobals) +parse arg fBlockInfo + if (\fBlockInfo) then + do + say '[reading processes]' + Address df 'CMD' 'asOut' '.p'; + say '[done]' + if (rc = 0 & asOut.0 > 0) then + do + j = 0; + do i = 1 to asOut.0 + if (word(asOut.i,1) = 'Slot' | strip(asOut.i) = '') then + iterate; + /* 0074 0033 0000 0033 0002 blk 0500 f88e6000 fe62d220 f9a0b7e8 1e9c 12 muglrqst + * 000a 0001 0000 0000 000a blk 081e f8812000 ffdba880 f99f7840 1e94 00 *jitdaem + * *000b# 001d 0001 001d 0001 blk 0500 f8814000 fe6270a0 f99f7b44 1e9c 01 pmshell + */ + j = j + 1; + aProc.j.sType = '0'; + aProc.j.hxBlockId = '0'; + asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); + parse var asOut.i aProc.j.hxSlot, + aProc.j.hxPid, + aProc.j.hxPPid, + aProc.j.hxCsid, + aProc.j.hxOrd, + aProc.j.sState, + aProc.j.hxPri, + aProc.j.hxpTSD, + aProc.j.hxpPTDA, + aProc.j.hxpPCB, + aProc.j.hxDisp, + aProc.j.hxSG, + aProc.j.sName; + if (strip(aProc.j.hxSlot) = '') then + j = j - 1; + end + aProc.0 = j; + end + end + else + do + say '[reading processes]' + Address df 'CMD' 'asOut' '.pb'; + say '[done]' + if (rc = 0 & asOut.0 > 0) then + do + j = 0; + do i = 1 to asOut.0 + if (word(asOut.i,1) = 'Slot' | strip(asOut.i) = '') then + iterate; + /* 0044 blk fd436cf8 4os2 Sem32 8001 005d hevResultCodeSet + * *000b# blk fd436190 pmshell + * 0073 blk 0b008cbe msrv SysSem + */ + asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); + j = j + 1; + aProc.j.hxPid = '0'; + aProc.j.hxPPid = '0'; + aProc.j.hxCsid = '0'; + aProc.j.hxOrd = '0'; + aProc.j.hxPri = '0'; + aProc.j.hxpTSD = '0'; + aProc.j.hxpPTDA = '0'; + aProc.j.hxpPCB = '0'; + aProc.j.hxDisp = '0'; + aProc.j.hxSG = '0'; + parse var asOut.i aProc.j.hxSlot, + aProc.j.sState, + aProc.j.hxBlockId, + aProc.j.sName, + aProc.j.sType .; + if (strip(aProc.j.hxSlot) = '') then + j = j - 1; + end + aProc.0 = j; + end + end +return -1; + + +/** + * Gets the blockId of a process from the dumpformatter. + * @param iSlot The slot to query. + * @returns Block id (hex string). + * '0' if failure. + */ +dfProcessBlockId: procedure expose(sGlobals) +parse arg iSlot + Address df 'CMD' 'asOut' '.pb' iSlot; + if (rc = 0 & asOut.0 > 0) then + do + /* *000b# blk fd436190 pmshell */ + asOut.2 = strip(asOut.2); + parse var asOut.2 .' 'sState' 'sBlockId' 'sProcName + sBlockId = strip(sBlockId) /* needed??? */ + if (sBlockId <> '') then + return sBlockId; + end +return '0'; + + +/** + * Gets the PTDA of a process. + * @param sSlot Slot or special chars '*' and '#'. + * @return Hex pointer to the PTDA. + */ +dfProcPTDA: procedure expose(sGlobals) +parse arg iSlot + Address df 'CMD' 'asOut' '.p' iSlot; + if (rc = 0 & asOut.0 > 0) then + do + /* 0074 0033 0000 0033 0002 blk 0500 f88e6000 fe62d220 f9a0b7e8 1e9c 12 muglrqst + * 000a 0001 0000 0000 000a blk 081e f8812000 ffdba880 f99f7840 1e94 00 *jitdaem + * *000b# 001d 0001 001d 0001 blk 0500 f8814000 fe6270a0 f99f7b44 1e9c 01 pmshell + */ + i = 2; + asOut.i = translate(left(asOut.i, 10), ' ', '#*') || substr(asOut.i, 11); + parse var asOut.i . . . . . . . hxTSD hxPTDA hxPCB . . .; + hxPTDA = strip(hxPTDA) /* needed??? */ + if (hxPTDA <> '') then + return hxPTDA; + end +return '0'; + + +/** + * Gets a byte from the memory array aMem. + * @param iIndex Byte offset into the array. + */ +memByte: procedure expose(sGlobals) +parse arg iIndex, sMem + cb = memSize(sMem); + if (iIndex < cb) then + do + return x2d(substr(sMem, (iIndex * 2) + 9 + 0, 2)); + end + say 'error-memByte: access out of range. cb='cb ' iIndex='iIndex; +return -1; + + +/** + * Gets a word from the memory array aMem. + * @param iIndex Byte offset into the array. + */ +memWord: procedure expose(sGlobals) +parse arg iIndex, sMem + cb = memSize(sMem); + if (iIndex + 1 < cb) then + do + return x2d(substr(sMem, (iIndex * 2) + 9 + 2, 2)||, + substr(sMem, (iIndex * 2) + 9 + 0, 2)); + end + say 'error-memWord: access out of range. cb='cb ' iIndex='iIndex; +return -1; + + +/** + * Gets a dword from the passed in memory block. + * @param iIndex Byte offset into the array. + * @param sMem Memory block. + * @remark note problems with signed! + */ +memDword: procedure expose(sGlobals) +parse arg iIndex, sMem + cb = memSize(sMem); + if (iIndex + 3 < cb) then + do + iIndex = iIndex*2 + 9; + return x2d(substr(sMem, iIndex + 6, 2)||, + substr(sMem, iIndex + 4, 2)||, + substr(sMem, iIndex + 2, 2)||, + substr(sMem, iIndex + 0, 2)); + end + say 'error-memDword: access out of range. cb='cb ' iIndex='iIndex; +return -1; + + +/** + * Gets a string from the memory array aMem. + * @return String. + * @param iIndex Byte offset into the array aMem. + * @param cchLength Length of the string. (optional) + * If not specified we'll stop at '\0' or end of aMem. + * @param fStoppAtNull Flag that we'll stop at '\0' even when lenght is specifed. (optional) + * Default is to fetch cchLength if cchLength is specifed. + */ +memString: procedure expose(sGlobals) +parse arg iIndex, cchLength, fStoppAtNull, sMem + cb = memSize(sMem); + if (iIndex < cb) then + do + /* handle optional parameters */ + if (fStoppAtNull = '') then + fStoppAtNull = (cchLength = ''); + if (cchLength = '') then + cchLength = cb - iIndex; + else if (cchLength + iIndex > cb) then + cchLength = cb - iIndex; + + /* fetch string */ + sStr = ''; + i = iIndex; + do i = iIndex to iIndex + cchLength + ch = substr(sMem, i*2 + 9, 2); + if (fStoppAtNull) then + if (ch = '00') then + leave; + sStr = sStr||x2c(ch); + end + return sStr; + end + say 'error-memWord: access out of range. cb='cb ' cbLength='cbLength; +return ''; + + +/** + * Dumps a byte range of the given memory to screen. + * @return 0 on success. -1 on failure. + * @paran iIndex Index into the memory block. + * @paran cbLength Length to dump. + * @paran sMem Memory block. + */ +memDumpByte: procedure expose(sGlobals) +parse arg iIndex, cbLength, sMem + cb = memSize(sMem); + if (iIndex < cb & iIndex + cbLength <= cb) then + do + iOff = 0; + do while (cbLength > 0) + i = 0; + sLine = '0000:'||d2x(iOff,8); + do i = 0 to 15 + if (cbLength - i > 0) then + do + if (i = 8) then + sLine = sLine || '-' || d2x(memByte(i + iOff, sMem),2); + else + sLine = sLine || ' ' || d2x(memByte(i + iOff, sMem),2); + end + else + sLine = sLine || ' '; + end + sLine = sLine || ' '; + do i = 0 to 15 + if (cbLength - i <= 0) then + leave; + iCh = memByte(i + iOff, sMem); + if (iCh >= 32) then + sLine = sLine || d2c(iCh); + else + sLine = sLine || '.'; + end + say sLine + iOff = iOff + 16; + cbLength = cbLength - 16; + end + + return 0; + end + say 'error-memDumpByte: access out of range. cb='cb 'iIndex='iIndex 'cbLength='cbLength; +return -1; + + +/** + * Dumps a word range of the given memory to screen. + * @return 0 on success. -1 on failure. + * @paran iIndex Index into the memory block. + * @paran cbLength Length to dump. + * @paran sMem Memory block. + */ +memDumpWord: procedure expose(sGlobals) +parse arg iIndex, cbLength, sMem + cb = memSize(sMem); + if (iIndex < cb & iIndex + cbLength <= cb) then + do + iOff = 0; + do while (cbLength > 0) + i = 0; + sLine = '0000:'||d2x(iOff,8)||' '; + do i = 0 to 7 + if (cbLength - i > 0) then + sLine = sLine || ' ' || d2x(memWord(i*2 + iOff, sMem),4); + else + sLine = sLine || ' '; + end + + say sLine + iOff = iOff + 16; + cbLength = cbLength - 16; + end + + return 0; + end + say 'error-memDumpWord: access out of range. cb='cb ' cbLength='cbLength; +return -1; + + +/** + * Dumps a dword range of the given memory to screen. + * @return 0 on success. -1 on failure. + * @paran iIndex Index into the memory block. + * @paran cbLength Length to dump. + * @paran sMem Memory block. + */ +memDumpDword: procedure expose(sGlobals) +parse arg iIndex, cbLength, sMem + cb = memSize(sMem); + if (iIndex < cb & iIndex + cbLength <= cb) then + do + iOff = 0; + do while (cbLength > 0) + i = 0; + sLine = '0000:'||d2x(iOff, 8)||' '; + do i = 0 to 3 + if (cbLength - i > 0) then + sLine = sLine || ' ' || d2x(memDWord(i*4 + iOff, sMem),8); + else + sLine = sLine || ' '; + end + + say sLine + iOff = iOff + 16; + cbLength = cbLength - 16; + end + + return 0; + end + say 'error-memDumpDword: access out of range. cb='cb ' cbLength='cbLength; +return -1; + + +/** + * Copies a portion of a memory block. + * @param iIndex Index into the memory block. + * @param cbLength Bytes to copy. + * @param sMem Source block. + */ +memCopy: procedure expose(sGlobals) +parse arg iIndex, cbLength, sMem + cb = memSize(sMem); + if (iIndex < cb & iIndex + cbLength <= cb) then + do + sCopy = d2x(cbLength,8)||substr(sMem, 9 + iIndex * 2, cbLength * 2); + return sCopy + end + say 'error-memCopy: access out of range. cb='cb ' cbLength='cbLength; +return -1; + + +/** + * Gets the size of a memory block. + * @param sMem The memory block in question. + */ +memSize: procedure expose(sGlobals) +parse arg sMem +/* debug assertions - start - comment out when stable! */ +if (length(sMem) - 8 <> x2d(left(sMem, 8)) * 2) then +do + say 'fatal assert: memSize got a bad memoryblock' + say ' length(sMem) =' length(sMem); + say ' cb = ' x2d(left(sMem,8)); + exit(16); +end +/* debug assertions - end - comment out when stable! */ +return x2d(left(sMem,8)); + + + +/** + * Dump all processes. (debug more or less) + */ +procDumpAll: procedure expose(sGlobals) + say 'Processes:' + do i = 1 to aProc.0 + say 'slot='aProc.i.hxSlot 'pid='aProc.i.hxPid 'blkid='aProc.i.hxBlockId 'name='aProc.i.sName + end +return 0; + + +/** + * Searches thru the process list looking for a process + * by it's pid and tid. + * @returns Index of the process. + * @param pid Process Id. (Decimal value) + * @param tid Thread Id. (Decimal value) + */ +procFindByPidTid: procedure expose(sGlobals) +parse arg pid, tid + do i = 1 to aProc.0 + if (x2d(aProc.i.hxPid) = pid & x2d(aProc.i.hxTid) = tid) then + return i; + end +return 0; + + +/** + * Searches thru the process list looking for a process + * by it's slot number. + * @returns Index of the process. + * @param iSlot Thread slot number. (Decimal value) + */ +procFindByPidTid: procedure expose(sGlobals) +parse arg iSlot + do i = 1 to aProc.0 + if (x2d(aProc.i.hxSlot) = iSlot) then + return i; + end +return 0; + + +/** + * Novaluehandler. + */ +SignalHanlder_NoValue: + say 'fatal error: novalue signal SIGL='SIGL; +exit(16); + + +/** + * Lowercases a string. + * @param sString String to fold down. + * @returns Lowercase version of sString. + */ +lowercase: procedure expose(sGlobals) +parse arg sString +return translate(sString,, + 'abcdefghijklmnopqrstuvwxyz',, + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); + + diff --git a/src/win32k/lib/Makefile.kmk b/src/win32k/lib/Makefile.kmk index 2815a5b..9606e4d 100644 --- a/src/win32k/lib/Makefile.kmk +++ b/src/win32k/lib/Makefile.kmk @@ -1,31 +1,31 @@ -## @file -# Win32K static API library. -# - -SUB_DEPTH = ../../.. -include $(KBUILD_PATH)/subheader.kmk - -#$(call odin_implib,ntdll) - -LIBRARIES += win32k -win32k_TEMPLATE = OdinCxx - -win32K_DEFS = RING3 WIN32KLIB - -win32k_SOURCES = \ - libInit.c \ - libTerm.c \ - libWin32kInstalled.c \ - libWin32kQueryOptionsStatus.c \ - libWin32kSetOptions.c \ - libWin32kSetEnvironment.c \ - libDosAllocMemEx.c \ - libDosKillProcessEx.c \ - libW32kHandleSystemEvent.c \ - libW32kQueryOTEs.c \ - libW32kQuerySystemMemInfo.c \ - libW32kProcessReadWrite.c \ - libGetCS.asm \ - libCallThruCallGate.asm - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# Win32K static API library. +# + +SUB_DEPTH = ../../.. +include $(KBUILD_PATH)/subheader.kmk + +#$(call odin_implib,ntdll) + +LIBRARIES += win32k +win32k_TEMPLATE = OdinCxx + +win32K_DEFS = RING3 WIN32KLIB + +win32k_SOURCES = \ + libInit.c \ + libTerm.c \ + libWin32kInstalled.c \ + libWin32kQueryOptionsStatus.c \ + libWin32kSetOptions.c \ + libWin32kSetEnvironment.c \ + libDosAllocMemEx.c \ + libDosKillProcessEx.c \ + libW32kHandleSystemEvent.c \ + libW32kQueryOTEs.c \ + libW32kQuerySystemMemInfo.c \ + libW32kProcessReadWrite.c \ + libGetCS.asm \ + libCallThruCallGate.asm + +include $(FILE_KBUILD_SUB_FOOTER) diff --git a/src/win32k/makedesc.cmd b/src/win32k/makedesc.cmd index f23e8b5..50045ba 100644 --- a/src/win32k/makedesc.cmd +++ b/src/win32k/makedesc.cmd @@ -1,563 +1,563 @@ -/* $Id: makedesc.cmd,v 1.2 2000-12-16 23:20:18 bird Exp $ - * - * Adds a Description string to the given .def-file. - * Fills in default values; like build time and host. - * - */ - -call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; -call SysLoadFuncs; - -/* - * Set default parameter values. - */ -sDefFileIn = ''; -sDefFileOut = ''; -sASDFeatureId = ''; -sCountryCode = ''; -sDateTime = left(' 'date()' 'time(), 26); -sDescription = 'Odin32'; -sFixPakVer = ''; -sHostname = strip(substr(VALUE('HOSTNAME',,'OS2ENVIRONMENT'), 1, 11)); -sLanguageCode = ''; -sMiniVer = ''; -sVendor = 'Project Odin'; -sVersion = '0.5'; - - -/* - * Parse parameters. - */ -parse arg sArgs -if (sArgs = '') then -do - call syntax; - exit(1); -end - -do while (sArgs <> '') - sArgs = strip(sArgs); - if (substr(sArgs, 1, 1) = '-' | substr(sArgs, 1, 1) = '/') then - do /* - * Option. - */ - ch = translate(substr(sArgs, 2, 1)); - if (pos(ch, 'ACDHLMNPRTV') < 1) then - do - say 'invalid option:' substr(sArgs, 1, 2); - call syntax; - exit(2); - end - - /* get value and advance sArgs to next or to end. */ - if (substr(sArgs, 3, 1) = '"') then - do - iNext = pos('"', sArgs, 4); - fQuote = 1; - end - else - do - iNext = pos(' ', sArgs, 3); - if (iNext <= 0) then - iNext = length(sArgs); - fQuote = 0; - end - - if (iNext > 3 | ch = 'R') then - do - sValue = substr(sArgs, 3 + fQuote, iNext - 3 - fQuote); - sArgs = strip(substr(sArgs, iNext+1)); - /*say 'iNext:' iNext 'sValue:' sValue 'sArgs:' sArgs; */ - - /* check if we're gonna search for something in an file. */ - if (sValue <> '' & pos('#define=', sValue) > 0) then - sValue = LookupDefine(sValue); - end - else - do - say 'syntax error near' substr(sArgs, 1, 2)'.'; - call syntax; - exit(3); - end - - - /* set value */ - select - when (ch = 'A') then /* ASD Feature Id */ - sASDFeatureId = sValue; - - when (ch = 'C') then /* Country code */ - sCountryCode = sValue; - - when (ch = 'D') then /* Description */ - sDescription = sValue; - - when (ch = 'H') then /* Hostname */ - sHostname = sValue; - - when (ch = 'L') then /* Language code */ - sLanguageCode = sValue; - - when (ch = 'M') then /* MiniVer */ - sMiniVer = sValue; - - when (ch = 'N') then /* Vendor */ - sVendor = sValue; - - when (ch = 'R') then /* Vendor */ - sDescription = ReadDescription(sValue, sDefFile); - - when (ch = 'P') then /* Fixpak version */ - sFixPakVer = sValue; - - when (ch = 'T') then /* Date Time */ - sDateTime = sValue; - - when (ch = 'V') then /* Version */ - sVersion = sValue; - - /* Otherwise it's an illegal option */ - otherwise: - say 'invalid option:' substr(sArgs, 1, 2); - call syntax; - exit(2); - end /* select */ - end - else - do /* - * Defition file... - */ - if (sDefFileOut <> '') then - do - say 'Syntax error: Can''t specify more than two defintion files!'; - exit(4); - end - if (sDefFileIn = '') then - parse value sArgs with sDefFileIn' 'sArgs - else - parse value sArgs with sDefFileOut' 'sArgs - sArgs = strip(sArgs); - end -end - - -/* check that a defintion file was specified. */ -if (sDefFileIn = '') then -do - say 'Syntax error: Will have to specify a .def-file to update.'; - call syntax; - exit(5); -end - - -/* - * Trim strings to correct lengths. - */ -sVendor = strip(substr(sVendor, 1, 31)); -if (substr(sDateTime, 1, 1) <> ' ') then - sDateTime = ' ' || sDateTime; -sDateTime = left(sDateTime, 26); -sHostname = strip(substr(sHostname, 1, 11)); -sMiniVer = strip(substr(sMiniVer, 1, 11)); -sDescription = strip(substr(sDescription, 1, 80)); -sCountryCode = strip(substr(sCountryCode, 1, 4)); -sLanguageCode = strip(substr(sLanguageCode, 1, 4)); -sASDFeatureId = strip(substr(sASDFeatureId, 1, 11)); -sFixPakVer = strip(substr(sFixPakVer, 1, 11)); - - -/* - * Signature - */ -sEnhSign = '##1##' - -/* - * Build description string. - */ -sDescription = '@#'sVendor':'sVersion'#@'sEnhSign||, - sDateTime||sHostname||, - ':'sASDFeatureId':'sLanguageCode':'sCountryCode':'sMiniVer||, - '::'sFixPakVer'@@'sDescription; - -/* - * Update .def-file. - */ -rc = UpdateDefFile(sDefFileIn, sDefFileOut, sDescription); -exit(rc); - - -/** - * Display script syntax. - */ -syntax: procedure - say 'Syntax: MakeDesc.cmd [options] [options]' - say ' Defitionfile which will have an DESCRIPTION appended.' - say 'Options:' - say ' -A ASD Feature Id.' - say ' -C Country code.' - say ' -D Description.' - say ' -R[deffile] Read description from .def file.' - say ' -H Hostname.' - say ' -L Language code.' - say ' -M MiniVer.' - say ' -N Vendor.' - say ' -P Fixpak version.' - say ' -T Date Time.' - say ' -V Version.' - say ' could be a double qoute qouted string or a single word.' - say ' You could also reference #defines in C/C++ include files.' - say ' The string should then have this form:' - say ' "#define=,"' - say ''; - - return; - - -/** - * Search for a #define in an C/C++ header or source file. - * - * @returns String containing the defined value - * found for the define in the header file. - * Quits on fatal errors. - * @param A string on the form: "#define=DEFINETOFIND,includefile.h" - * @remark Write only code... - let's hope it works. - */ -LookupDefine: procedure - parse arg '#'sDefine'='sMacro','sIncludeFile - - /* - * Validate parameters. - */ - sMacro = strip(sMacro); - sIncludeFile = strip(sIncludeFile); - if (sMacro = '') then - do - say 'syntax error: #define=,.'; - say ' was empty.'; - exit(-20); - end - if (sIncludeFile = '') then - do - say 'syntax error: #define=,.'; - say ' was empty.'; - exit(-20); - end - - - sIllegal = translate(translate(sMacro),, - '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!',, - 'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_'); - - if (strip(translate(sIllegal, ' ', '!')) <> '') then - do - say 'syntax error: #define=,.'; - say ' contains illegal charater(s).' - say ' 'sMacro; - say ' 'translate(sIllegal, ' ', '!'); - exit(-20); - end - - /* - * Open include file. - */ - sRc = stream(sIncludeFile, 'c', 'open read'); - if (pos('READY', sRc) <> 1) then - do /* search INCLUDE variable */ - sFile = SysSearchPath('INCLUDE', sIncludeFile); - if (sFile = '') then - do - say 'Can''t find include file 'sIncludeFile'.'; - exit(-20); - end - sIncludeFile = sFile; - - sRc = stream(sIncludeFile, 'c', 'open read'); - if (pos('READY', sRc) <> 1) then - do - say 'Failed to open include file' sIncludeFile'.'; - exit(-20); - end - end - - /* - * Search the file line by line. - * We'll check for lines starting with a hash (#) char. - * Then check that the word after the hash is 'define'. - * Then match the next word with the macro name. - * Then then get the next rest of the line to comment or continuation char. - * (continuation is not supported) - * Finally strip quotes. - */ - sValue = ''; - do while (lines(sIncludeFile) > 0) - sLine = strip(linein(sIncludeFile)); - if (sLine = '') then - iterate; - if (substr(sLine, 1, 1) <> '#') then - iterate; - sLine = substr(sLine, 2); - if (word(sLine, 1) <> 'define') then - iterate; - sLine = strip(substr(sLine, wordpos(sLine, 1) + length('define')+1)); - if ( substr(sLine, 1, length(sMacro)) <> sMacro, - | substr(sLine, length(sMacro)+1, 1) <> ' ') then - iterate; - sLine = strip(substr(sLine, length(sMacro) + 1)); - if (sLine = '') then - do - say 'error: #define' sMacro' is empty.'; - call stream sIncludeFile, 'c', 'close'; - exit(-20); - end - - chQuote = substr(sLine, 1, 1); - if (chQuote = '"' | chQuote = "'") then - do /* quoted string */ - iLastQuote = 0; - do forever - iLast = pos(chQuote, sLine, 2); - if (iLast <= 0) then - leave; - if (substr(sLine, iLast, 1) = '\') then - iterate; - iLastQuote = iLast; - leave; - end - - if (iLastQuote <= 0) then - do - say 'C/C++ syntax error in 'sIncludefile': didn''t find end quote.'; - call stream sIncludeFile, 'c', 'close'; - exit(-20); - end - - call stream sIncludeFile, 'c', 'close'; - sValue = substr(sLine, 2, iLastQuote - 2); - say 'Found 'sMacro'='sValue; - return sValue; - end - else - do - iCommentCPP = pos('//',sLine); - iCommentC = pos('/*',sLine); - if (iCommentC > 0 & iCommentCPP > 0 & iCommentC > iCommentCPP) then - iComment = iCommentCPP; - else if (iCommentC > 0 & iCommentCPP > 0 & iCommentC < iCommentCPP) then - iComment = iCommentC; - else if (iCommentCPP > 0) then - iComment = iCommentCPP; - else if (iCommentC > 0) then - iComment = iCommentC; - else - iComment = 0; - - if (iComment > 0) then - sValue = strip(substr(sLine, 1, iComment-1)); - else - sValue = strip(sLine); - - if (sValue <> '') then - do - if (substr(sValue, length(sValue)) = '\') then - do - say 'Found continuation char: Multiline definitions are not supported!\n'; - call stream sIncludeFile, 'c', 'close'; - exit(-20); - end - end - - if (sValue = '') then - say 'warning: The #define has no value.'; - - call stream sIncludeFile, 'c', 'close'; - say 'Found 'sMacro'='sValue; - return sValue; - end - end - - call stream sIncludeFile, 'c', 'close'; - say 'error: didn''t find #define' sMacro'.'; - exit(-20); - - - -/** - * Reads the description line for a .def-file. - * @returns The Description string, with quotes removed. - * Empty string is acceptable. - * On error we'll terminate the script. - * @param sDefFile Filaname of .def-file to read the description from. - * @param sDefFile2 Used if sDefFile is empty. - * @author knut st. osmundsen (knut.stange.osmundsen@mynd.no) - */ -ReadDescription: procedure; - parse arg sDefFile, sDefFile2 - - /* - * Validate parameters. - */ - if (sDefFile = '') then - sDefFile = sDefFile2; - if (sDefFile = '') then - do - say 'error: no definition file to get description from.' - exit(-1); - end - - /* - * Open file - */ - rc = stream(sDefFile, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - do - say 'error: failed to open deffile file.'; - exit(-1); - end - - - /* - * Search for the 'DESCRIPTION' line. - */ - do while (lines(sDefFile) > 0) - sLine = strip(linein(sDefFile)); - if (sLine = '') then - iterate; - if (translate(word(sLine, 1)) <> 'DESCRIPTION') then - iterate; - sLine = strip(substr(sLine, wordpos(sLine, 1) + length('DESCRIPTION')+1)); - - ch = substr(sLine, 1, 1); - if (ch <> "'" & ch <> '"') then - do - say 'syntax error: description line in' sDefFile 'is misformed.'; - call stream sDefFile, 'c', 'close'; - exit(-10); - end - - iEnd = pos(ch, sLine, 2); - if (iEnd <= 0) then - do - say 'syntax error: description line in' sDefFile 'is misformed.'; - call stream sDefFile, 'c', 'close'; - exit(-10); - end - - call stream sDefFile, 'c', 'close'; - sValue = substr(sLine, 2, iEnd - 2); - say 'Found Description:' sValue; - return sValue; - end - - call stream sDefFile, 'c', 'close'; - say 'info: Didn''t find description line in' sDefFile'.'; - return ''; - - -/** - * This is a function which reads sDefFileIn into and - * internal array and changes the DESCRIPTION text if found. - * If DESCRIPTION isn't found, it is added at the end. - * The array is written to sDefFileOut. - * @returns 0 on succes. - * Errorcode on error. - * @param sDefFileIn Input .def-file. - * @param sDefFileOut Output .def-file. Overwritten. - * @param sDescription New description string. - * @author knut st. osmundsen (knut.stange.osmundsen@mynd.no) - */ -UpdateDefFile: procedure; - parse arg sDefFileIn, sDefFileOut, sDescription - - /* - * Validate parameters. - */ - if (sDefFileOut = '') then - sDefFileOut = sDefFileIn; - - /* - * Open file input file. - */ - rc = stream(sDefFileIn, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - do - say 'error: failed to open' sDefFileIn 'file.'; - return 110; - end - - - /* - * Search for the 'DESCRIPTION' line. - */ - i = 0; - fDescription = 0; - do while (lines(sDefFileIn) > 0) - /* - * Read line. - */ - i = i + 1; - asFile.i = strip(linein(sDefFileIn)); - - /* - * Look for DESCRIPTION; - */ - if (asFile.i = '') then - iterate; - if (translate(word(asFile.i, 1)) <> 'DESCRIPTION') then - iterate; - if (fDescription) then - do - say 'warning: multiple descriptions lines. Line' i 'removed'; - i = i - 1; - iterate; - end - - /* - * Found description - replace with new description. - */ - asFile.i = "DESCRIPTION '"||sDescription||"'"; - fDescription = 1; - end - - /* - * Add description is none was found. - */ - if (\fDescription) then - do - i = i + 1; - asFile.i = "DESCRIPTION '"||sDescription||"'"; - end - asFile.0 = i; - - - /* - * Close input file and open output file. - */ - call stream sDefFileIn, 'c', 'close'; - call SysFileDelete(sDefFileOut); - rc = stream(sDefFileOut, 'c', 'open write'); - if (pos('READY', rc) <> 1) then - do - say 'error: failed to open outputfile' sDefFileOut 'file.'; - return 110; - end - - /* - * Make firstline and write all the lines to the output file. - */ - call lineout sDefFileOut, '; Updated by makedesc.cmd', 1; - do i = 1 to asFile.0 - rc = lineout(sDefFileOut, asFile.i); - if (rc > 0) then - do - say 'error: failed to write line' i 'to' sDefFileOut'.' - call stream sDefFileOut, 'c', 'close'; - return 5; - end - end - - /* - * Close output file and return succesfully. - */ - call stream sDefFileOut, 'c', 'close'; - return 0; - +/* $Id: makedesc.cmd,v 1.2 2000-12-16 23:20:18 bird Exp $ + * + * Adds a Description string to the given .def-file. + * Fills in default values; like build time and host. + * + */ + +call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; +call SysLoadFuncs; + +/* + * Set default parameter values. + */ +sDefFileIn = ''; +sDefFileOut = ''; +sASDFeatureId = ''; +sCountryCode = ''; +sDateTime = left(' 'date()' 'time(), 26); +sDescription = 'Odin32'; +sFixPakVer = ''; +sHostname = strip(substr(VALUE('HOSTNAME',,'OS2ENVIRONMENT'), 1, 11)); +sLanguageCode = ''; +sMiniVer = ''; +sVendor = 'Project Odin'; +sVersion = '0.5'; + + +/* + * Parse parameters. + */ +parse arg sArgs +if (sArgs = '') then +do + call syntax; + exit(1); +end + +do while (sArgs <> '') + sArgs = strip(sArgs); + if (substr(sArgs, 1, 1) = '-' | substr(sArgs, 1, 1) = '/') then + do /* + * Option. + */ + ch = translate(substr(sArgs, 2, 1)); + if (pos(ch, 'ACDHLMNPRTV') < 1) then + do + say 'invalid option:' substr(sArgs, 1, 2); + call syntax; + exit(2); + end + + /* get value and advance sArgs to next or to end. */ + if (substr(sArgs, 3, 1) = '"') then + do + iNext = pos('"', sArgs, 4); + fQuote = 1; + end + else + do + iNext = pos(' ', sArgs, 3); + if (iNext <= 0) then + iNext = length(sArgs); + fQuote = 0; + end + + if (iNext > 3 | ch = 'R') then + do + sValue = substr(sArgs, 3 + fQuote, iNext - 3 - fQuote); + sArgs = strip(substr(sArgs, iNext+1)); + /*say 'iNext:' iNext 'sValue:' sValue 'sArgs:' sArgs; */ + + /* check if we're gonna search for something in an file. */ + if (sValue <> '' & pos('#define=', sValue) > 0) then + sValue = LookupDefine(sValue); + end + else + do + say 'syntax error near' substr(sArgs, 1, 2)'.'; + call syntax; + exit(3); + end + + + /* set value */ + select + when (ch = 'A') then /* ASD Feature Id */ + sASDFeatureId = sValue; + + when (ch = 'C') then /* Country code */ + sCountryCode = sValue; + + when (ch = 'D') then /* Description */ + sDescription = sValue; + + when (ch = 'H') then /* Hostname */ + sHostname = sValue; + + when (ch = 'L') then /* Language code */ + sLanguageCode = sValue; + + when (ch = 'M') then /* MiniVer */ + sMiniVer = sValue; + + when (ch = 'N') then /* Vendor */ + sVendor = sValue; + + when (ch = 'R') then /* Vendor */ + sDescription = ReadDescription(sValue, sDefFile); + + when (ch = 'P') then /* Fixpak version */ + sFixPakVer = sValue; + + when (ch = 'T') then /* Date Time */ + sDateTime = sValue; + + when (ch = 'V') then /* Version */ + sVersion = sValue; + + /* Otherwise it's an illegal option */ + otherwise: + say 'invalid option:' substr(sArgs, 1, 2); + call syntax; + exit(2); + end /* select */ + end + else + do /* + * Defition file... + */ + if (sDefFileOut <> '') then + do + say 'Syntax error: Can''t specify more than two defintion files!'; + exit(4); + end + if (sDefFileIn = '') then + parse value sArgs with sDefFileIn' 'sArgs + else + parse value sArgs with sDefFileOut' 'sArgs + sArgs = strip(sArgs); + end +end + + +/* check that a defintion file was specified. */ +if (sDefFileIn = '') then +do + say 'Syntax error: Will have to specify a .def-file to update.'; + call syntax; + exit(5); +end + + +/* + * Trim strings to correct lengths. + */ +sVendor = strip(substr(sVendor, 1, 31)); +if (substr(sDateTime, 1, 1) <> ' ') then + sDateTime = ' ' || sDateTime; +sDateTime = left(sDateTime, 26); +sHostname = strip(substr(sHostname, 1, 11)); +sMiniVer = strip(substr(sMiniVer, 1, 11)); +sDescription = strip(substr(sDescription, 1, 80)); +sCountryCode = strip(substr(sCountryCode, 1, 4)); +sLanguageCode = strip(substr(sLanguageCode, 1, 4)); +sASDFeatureId = strip(substr(sASDFeatureId, 1, 11)); +sFixPakVer = strip(substr(sFixPakVer, 1, 11)); + + +/* + * Signature + */ +sEnhSign = '##1##' + +/* + * Build description string. + */ +sDescription = '@#'sVendor':'sVersion'#@'sEnhSign||, + sDateTime||sHostname||, + ':'sASDFeatureId':'sLanguageCode':'sCountryCode':'sMiniVer||, + '::'sFixPakVer'@@'sDescription; + +/* + * Update .def-file. + */ +rc = UpdateDefFile(sDefFileIn, sDefFileOut, sDescription); +exit(rc); + + +/** + * Display script syntax. + */ +syntax: procedure + say 'Syntax: MakeDesc.cmd [options] [options]' + say ' Defitionfile which will have an DESCRIPTION appended.' + say 'Options:' + say ' -A ASD Feature Id.' + say ' -C Country code.' + say ' -D Description.' + say ' -R[deffile] Read description from .def file.' + say ' -H Hostname.' + say ' -L Language code.' + say ' -M MiniVer.' + say ' -N Vendor.' + say ' -P Fixpak version.' + say ' -T Date Time.' + say ' -V Version.' + say ' could be a double qoute qouted string or a single word.' + say ' You could also reference #defines in C/C++ include files.' + say ' The string should then have this form:' + say ' "#define=,"' + say ''; + + return; + + +/** + * Search for a #define in an C/C++ header or source file. + * + * @returns String containing the defined value + * found for the define in the header file. + * Quits on fatal errors. + * @param A string on the form: "#define=DEFINETOFIND,includefile.h" + * @remark Write only code... - let's hope it works. + */ +LookupDefine: procedure + parse arg '#'sDefine'='sMacro','sIncludeFile + + /* + * Validate parameters. + */ + sMacro = strip(sMacro); + sIncludeFile = strip(sIncludeFile); + if (sMacro = '') then + do + say 'syntax error: #define=,.'; + say ' was empty.'; + exit(-20); + end + if (sIncludeFile = '') then + do + say 'syntax error: #define=,.'; + say ' was empty.'; + exit(-20); + end + + + sIllegal = translate(translate(sMacro),, + '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!',, + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_'); + + if (strip(translate(sIllegal, ' ', '!')) <> '') then + do + say 'syntax error: #define=,.'; + say ' contains illegal charater(s).' + say ' 'sMacro; + say ' 'translate(sIllegal, ' ', '!'); + exit(-20); + end + + /* + * Open include file. + */ + sRc = stream(sIncludeFile, 'c', 'open read'); + if (pos('READY', sRc) <> 1) then + do /* search INCLUDE variable */ + sFile = SysSearchPath('INCLUDE', sIncludeFile); + if (sFile = '') then + do + say 'Can''t find include file 'sIncludeFile'.'; + exit(-20); + end + sIncludeFile = sFile; + + sRc = stream(sIncludeFile, 'c', 'open read'); + if (pos('READY', sRc) <> 1) then + do + say 'Failed to open include file' sIncludeFile'.'; + exit(-20); + end + end + + /* + * Search the file line by line. + * We'll check for lines starting with a hash (#) char. + * Then check that the word after the hash is 'define'. + * Then match the next word with the macro name. + * Then then get the next rest of the line to comment or continuation char. + * (continuation is not supported) + * Finally strip quotes. + */ + sValue = ''; + do while (lines(sIncludeFile) > 0) + sLine = strip(linein(sIncludeFile)); + if (sLine = '') then + iterate; + if (substr(sLine, 1, 1) <> '#') then + iterate; + sLine = substr(sLine, 2); + if (word(sLine, 1) <> 'define') then + iterate; + sLine = strip(substr(sLine, wordpos(sLine, 1) + length('define')+1)); + if ( substr(sLine, 1, length(sMacro)) <> sMacro, + | substr(sLine, length(sMacro)+1, 1) <> ' ') then + iterate; + sLine = strip(substr(sLine, length(sMacro) + 1)); + if (sLine = '') then + do + say 'error: #define' sMacro' is empty.'; + call stream sIncludeFile, 'c', 'close'; + exit(-20); + end + + chQuote = substr(sLine, 1, 1); + if (chQuote = '"' | chQuote = "'") then + do /* quoted string */ + iLastQuote = 0; + do forever + iLast = pos(chQuote, sLine, 2); + if (iLast <= 0) then + leave; + if (substr(sLine, iLast, 1) = '\') then + iterate; + iLastQuote = iLast; + leave; + end + + if (iLastQuote <= 0) then + do + say 'C/C++ syntax error in 'sIncludefile': didn''t find end quote.'; + call stream sIncludeFile, 'c', 'close'; + exit(-20); + end + + call stream sIncludeFile, 'c', 'close'; + sValue = substr(sLine, 2, iLastQuote - 2); + say 'Found 'sMacro'='sValue; + return sValue; + end + else + do + iCommentCPP = pos('//',sLine); + iCommentC = pos('/*',sLine); + if (iCommentC > 0 & iCommentCPP > 0 & iCommentC > iCommentCPP) then + iComment = iCommentCPP; + else if (iCommentC > 0 & iCommentCPP > 0 & iCommentC < iCommentCPP) then + iComment = iCommentC; + else if (iCommentCPP > 0) then + iComment = iCommentCPP; + else if (iCommentC > 0) then + iComment = iCommentC; + else + iComment = 0; + + if (iComment > 0) then + sValue = strip(substr(sLine, 1, iComment-1)); + else + sValue = strip(sLine); + + if (sValue <> '') then + do + if (substr(sValue, length(sValue)) = '\') then + do + say 'Found continuation char: Multiline definitions are not supported!\n'; + call stream sIncludeFile, 'c', 'close'; + exit(-20); + end + end + + if (sValue = '') then + say 'warning: The #define has no value.'; + + call stream sIncludeFile, 'c', 'close'; + say 'Found 'sMacro'='sValue; + return sValue; + end + end + + call stream sIncludeFile, 'c', 'close'; + say 'error: didn''t find #define' sMacro'.'; + exit(-20); + + + +/** + * Reads the description line for a .def-file. + * @returns The Description string, with quotes removed. + * Empty string is acceptable. + * On error we'll terminate the script. + * @param sDefFile Filaname of .def-file to read the description from. + * @param sDefFile2 Used if sDefFile is empty. + * @author knut st. osmundsen (knut.stange.osmundsen@mynd.no) + */ +ReadDescription: procedure; + parse arg sDefFile, sDefFile2 + + /* + * Validate parameters. + */ + if (sDefFile = '') then + sDefFile = sDefFile2; + if (sDefFile = '') then + do + say 'error: no definition file to get description from.' + exit(-1); + end + + /* + * Open file + */ + rc = stream(sDefFile, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + do + say 'error: failed to open deffile file.'; + exit(-1); + end + + + /* + * Search for the 'DESCRIPTION' line. + */ + do while (lines(sDefFile) > 0) + sLine = strip(linein(sDefFile)); + if (sLine = '') then + iterate; + if (translate(word(sLine, 1)) <> 'DESCRIPTION') then + iterate; + sLine = strip(substr(sLine, wordpos(sLine, 1) + length('DESCRIPTION')+1)); + + ch = substr(sLine, 1, 1); + if (ch <> "'" & ch <> '"') then + do + say 'syntax error: description line in' sDefFile 'is misformed.'; + call stream sDefFile, 'c', 'close'; + exit(-10); + end + + iEnd = pos(ch, sLine, 2); + if (iEnd <= 0) then + do + say 'syntax error: description line in' sDefFile 'is misformed.'; + call stream sDefFile, 'c', 'close'; + exit(-10); + end + + call stream sDefFile, 'c', 'close'; + sValue = substr(sLine, 2, iEnd - 2); + say 'Found Description:' sValue; + return sValue; + end + + call stream sDefFile, 'c', 'close'; + say 'info: Didn''t find description line in' sDefFile'.'; + return ''; + + +/** + * This is a function which reads sDefFileIn into and + * internal array and changes the DESCRIPTION text if found. + * If DESCRIPTION isn't found, it is added at the end. + * The array is written to sDefFileOut. + * @returns 0 on succes. + * Errorcode on error. + * @param sDefFileIn Input .def-file. + * @param sDefFileOut Output .def-file. Overwritten. + * @param sDescription New description string. + * @author knut st. osmundsen (knut.stange.osmundsen@mynd.no) + */ +UpdateDefFile: procedure; + parse arg sDefFileIn, sDefFileOut, sDescription + + /* + * Validate parameters. + */ + if (sDefFileOut = '') then + sDefFileOut = sDefFileIn; + + /* + * Open file input file. + */ + rc = stream(sDefFileIn, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + do + say 'error: failed to open' sDefFileIn 'file.'; + return 110; + end + + + /* + * Search for the 'DESCRIPTION' line. + */ + i = 0; + fDescription = 0; + do while (lines(sDefFileIn) > 0) + /* + * Read line. + */ + i = i + 1; + asFile.i = strip(linein(sDefFileIn)); + + /* + * Look for DESCRIPTION; + */ + if (asFile.i = '') then + iterate; + if (translate(word(asFile.i, 1)) <> 'DESCRIPTION') then + iterate; + if (fDescription) then + do + say 'warning: multiple descriptions lines. Line' i 'removed'; + i = i - 1; + iterate; + end + + /* + * Found description - replace with new description. + */ + asFile.i = "DESCRIPTION '"||sDescription||"'"; + fDescription = 1; + end + + /* + * Add description is none was found. + */ + if (\fDescription) then + do + i = i + 1; + asFile.i = "DESCRIPTION '"||sDescription||"'"; + end + asFile.0 = i; + + + /* + * Close input file and open output file. + */ + call stream sDefFileIn, 'c', 'close'; + call SysFileDelete(sDefFileOut); + rc = stream(sDefFileOut, 'c', 'open write'); + if (pos('READY', rc) <> 1) then + do + say 'error: failed to open outputfile' sDefFileOut 'file.'; + return 110; + end + + /* + * Make firstline and write all the lines to the output file. + */ + call lineout sDefFileOut, '; Updated by makedesc.cmd', 1; + do i = 1 to asFile.0 + rc = lineout(sDefFileOut, asFile.i); + if (rc > 0) then + do + say 'error: failed to write line' i 'to' sDefFileOut'.' + call stream sDefFileOut, 'c', 'close'; + return 5; + end + end + + /* + * Close output file and return succesfully. + */ + call stream sDefFileOut, 'c', 'close'; + return 0; + diff --git a/src/win32k/rexx/tst.cmd b/src/win32k/rexx/tst.cmd index c0ef743..6036c3a 100644 --- a/src/win32k/rexx/tst.cmd +++ b/src/win32k/rexx/tst.cmd @@ -1,9 +1,9 @@ -/* rexx */ - - parse source sSource; - parse arg sArgs - say 'parse source:' sSource - say 'parse arg :' sArgs - say 'exit rc :' 1; - exit(1); - +/* rexx */ + + parse source sSource; + parse arg sArgs + say 'parse source:' sSource + say 'parse arg :' sArgs + say 'exit rc :' 1; + exit(1); + diff --git a/src/win32k/test/TestKernels.cmd b/src/win32k/test/TestKernels.cmd index 5d9bed9..9e72ca3 100644 --- a/src/win32k/test/TestKernels.cmd +++ b/src/win32k/test/TestKernels.cmd @@ -1,141 +1,141 @@ -/* $Id: TestKernels.cmd,v 1.4 2002-12-06 02:58:57 bird Exp $ - * - * This script loops thru a set of different kernels running testcase 1. - * Note: The kernels and symbols files are in a single directory - * Name format - * nnnn[n]bk[.SYM] - * - * nnnn[n] Build number. (4 or 5 digits). (ex. 9036) - * b Build type: A - allstrict; H - halfstrict; R - retail (GA) - * k Kernel type: U - uniprocess; S - smp; 4 - warp 4 fixpack 13+ - * [.SYM] Kernel files has no extention while the symbol files has .SYM. - */ - - call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; - call SysLoadFuncs; - - parse arg sDir sdummy - if (sDir = '' | sDir = '-?' | sDir = '/?' | sDir = '-h' | sDir = '-H' | sDir = '/h' | sDir = '/H' | sDir = '--help') then - do - call syntax; - exit -1; - end - - /* - * Read directory - */ - rc = SysFileTree(sDir'\*', 'asFiles', 'FO'); - if (rc <> 0) then - do - say 'SysFileTree failed with rc='rc'.'; - exit -2; - end - if (asFiles.0 <= 0) then - do - say 'No files found'; - exit -3; - end - - iRetCode = 0; - do i = 1 to asFiles.0 - /* - * Interpret name (get build no., kernel type and build type). - */ - sName = translate(filespec('name', asFiles.i)); - if (lastpos('.', sName) > 0) then - do - sExt = substr(sName, lastpos('.', sName) + 1); - sName = substr(sName, 1, lastpos('.', sName) - 1); - end - else - sExt = ''; - - if (sExt <> '') then - iterate - - if (substr(sName, 5, 1) <= '9') then cchBuild = 5; - else cchBuild = 4; - iBuild = substr(sName, 1, cchBuild); - chBuildType = substr(sName, cchBuild + 1, 1); - chKernelType = substr(sName, cchBuild + 2, 1); - chRev = substr(sName, cchBuild + 3, 1); - - /* - * Validate name. - */ - do j = 1 to length(iBuild) - if (substr(iBuild, j, 1) < '0' | substr(iBuild, j, 1) > '9') then - do - j = -1; - leave; - end - end - if (j = -1) then - iterate; - - if (chBuildType <> 'A' & chBuildType <> 'H' & chBuildType <> 'R' & chBuildType <> 'B') then - do - say 'invalid build type char:' chBuildType '('asFiles.i')'; - exit -4; - end - - if (chKernelType <> 'U' & chKernelType <> 'S' & chKernelType <> '4') then - do - say 'invalid kernel type char:' chKernelType '('asFiles.i')'; - exit -4; - end - - /* - * Determin version number (based on build number). - */ - iVerMajor = 2; - if (iBuild >= 14000) then - iVerMinor = 45; - else if (iBuild >= 9000) then - iVerMinor = 40; - else if (iBuild >= 8000) then - iVerMinor = 30; - else if (iBuild >= 6200) then - iVerMinor = 21; - else - do - say 'unsupported build number:' iBuild '('asFiles.i')'; - exit(-5); - end - - /* - * Process it - */ - say; - say; - say 'Processing' asFiles.i'....'; - if (chBuildType = 'R') then - do - sCmd = 'win32ktst.exe 1' asFiles.i iVerMajor iVerMinor iBuild chKernelType chBuildType chRev ; - say sCmd; - sCmd; - if (rc = 0) then - iterate; - end - sCmd = 'win32ktst.exe 1' asFiles.i iVerMajor iVerMinor iBuild chKernelType chBuildType chRev asFiles.i||'.SYM'; - say sCmd; - sCmd; - if (rc <> 0) then - do - say 'failed... rc='rc; - exit rc; - end - - end - - exit(0); - - - - -/* - * Write syntax: - */ -syntax: procedure; - say 'TestKernels.cmd '; +/* $Id: TestKernels.cmd,v 1.4 2002-12-06 02:58:57 bird Exp $ + * + * This script loops thru a set of different kernels running testcase 1. + * Note: The kernels and symbols files are in a single directory + * Name format + * nnnn[n]bk[.SYM] + * + * nnnn[n] Build number. (4 or 5 digits). (ex. 9036) + * b Build type: A - allstrict; H - halfstrict; R - retail (GA) + * k Kernel type: U - uniprocess; S - smp; 4 - warp 4 fixpack 13+ + * [.SYM] Kernel files has no extention while the symbol files has .SYM. + */ + + call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; + call SysLoadFuncs; + + parse arg sDir sdummy + if (sDir = '' | sDir = '-?' | sDir = '/?' | sDir = '-h' | sDir = '-H' | sDir = '/h' | sDir = '/H' | sDir = '--help') then + do + call syntax; + exit -1; + end + + /* + * Read directory + */ + rc = SysFileTree(sDir'\*', 'asFiles', 'FO'); + if (rc <> 0) then + do + say 'SysFileTree failed with rc='rc'.'; + exit -2; + end + if (asFiles.0 <= 0) then + do + say 'No files found'; + exit -3; + end + + iRetCode = 0; + do i = 1 to asFiles.0 + /* + * Interpret name (get build no., kernel type and build type). + */ + sName = translate(filespec('name', asFiles.i)); + if (lastpos('.', sName) > 0) then + do + sExt = substr(sName, lastpos('.', sName) + 1); + sName = substr(sName, 1, lastpos('.', sName) - 1); + end + else + sExt = ''; + + if (sExt <> '') then + iterate + + if (substr(sName, 5, 1) <= '9') then cchBuild = 5; + else cchBuild = 4; + iBuild = substr(sName, 1, cchBuild); + chBuildType = substr(sName, cchBuild + 1, 1); + chKernelType = substr(sName, cchBuild + 2, 1); + chRev = substr(sName, cchBuild + 3, 1); + + /* + * Validate name. + */ + do j = 1 to length(iBuild) + if (substr(iBuild, j, 1) < '0' | substr(iBuild, j, 1) > '9') then + do + j = -1; + leave; + end + end + if (j = -1) then + iterate; + + if (chBuildType <> 'A' & chBuildType <> 'H' & chBuildType <> 'R' & chBuildType <> 'B') then + do + say 'invalid build type char:' chBuildType '('asFiles.i')'; + exit -4; + end + + if (chKernelType <> 'U' & chKernelType <> 'S' & chKernelType <> '4') then + do + say 'invalid kernel type char:' chKernelType '('asFiles.i')'; + exit -4; + end + + /* + * Determin version number (based on build number). + */ + iVerMajor = 2; + if (iBuild >= 14000) then + iVerMinor = 45; + else if (iBuild >= 9000) then + iVerMinor = 40; + else if (iBuild >= 8000) then + iVerMinor = 30; + else if (iBuild >= 6200) then + iVerMinor = 21; + else + do + say 'unsupported build number:' iBuild '('asFiles.i')'; + exit(-5); + end + + /* + * Process it + */ + say; + say; + say 'Processing' asFiles.i'....'; + if (chBuildType = 'R') then + do + sCmd = 'win32ktst.exe 1' asFiles.i iVerMajor iVerMinor iBuild chKernelType chBuildType chRev ; + say sCmd; + sCmd; + if (rc = 0) then + iterate; + end + sCmd = 'win32ktst.exe 1' asFiles.i iVerMajor iVerMinor iBuild chKernelType chBuildType chRev asFiles.i||'.SYM'; + say sCmd; + sCmd; + if (rc <> 0) then + do + say 'failed... rc='rc; + exit rc; + end + + end + + exit(0); + + + + +/* + * Write syntax: + */ +syntax: procedure; + say 'TestKernels.cmd '; return; \ No newline at end of file diff --git a/src/winmm/Makefile.kmk b/src/winmm/Makefile.kmk index 8f3849c..d00dada 100644 --- a/src/winmm/Makefile.kmk +++ b/src/winmm/Makefile.kmk @@ -1,59 +1,59 @@ -## @file -# WINMM and supplemental libraries -# - -SUB_DEPTH = ../.. -include $(KBUILD_PATH)/subheader.kmk - -# -# Include sub-makefiles. -# -include $(PATH_SUB_CURRENT)/mcicda/Makefile.kmk -include $(PATH_SUB_CURRENT)/mciwave/Makefile.kmk - -$(call odin_implib_2,winmm) - -DLLS += winmm -winmm_TEMPLATE = OdinDLL - -winmm_SOURCES = \ - os2timer.cpp \ - waveout.cpp \ - waveoutdart.cpp \ - waveoutbase.cpp \ - waveinoutbase.cpp \ - waveoutdaud.cpp \ - waveindart.cpp \ - wavein.cpp \ - time.cpp \ - auxiliary.cpp \ - auxos2.cpp \ - mixer.cpp \ - mixeros2.cpp \ - mixerdata.cpp \ - midi.cpp \ - irtmidi.cpp \ - midistrm.cpp \ - mci.cpp \ - joy.cpp \ - mmio.cpp \ - driver.c \ - playsound.cpp \ - joyos2.cpp \ - waveoutflash.cpp \ - dbglocal.cpp \ - initterm.cpp \ - winmmrsrc.orc - -winmm_SOURCES.release += \ - winmm.def -winmm_SOURCES.debug += \ - dbgwrap.cpp \ - winmmdbg.def - -winmm_LIBS = \ - $(PATH_STAGE_LIB)/libwrap.lib \ - $(PATH_STAGE_LIB)/kernel32.lib \ - $(PATH_STAGE_LIB)/user32.lib - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# WINMM and supplemental libraries +# + +SUB_DEPTH = ../.. +include $(KBUILD_PATH)/subheader.kmk + +# +# Include sub-makefiles. +# +include $(PATH_SUB_CURRENT)/mcicda/Makefile.kmk +include $(PATH_SUB_CURRENT)/mciwave/Makefile.kmk + +$(call odin_implib_2,winmm) + +DLLS += winmm +winmm_TEMPLATE = OdinDLL + +winmm_SOURCES = \ + os2timer.cpp \ + waveout.cpp \ + waveoutdart.cpp \ + waveoutbase.cpp \ + waveinoutbase.cpp \ + waveoutdaud.cpp \ + waveindart.cpp \ + wavein.cpp \ + time.cpp \ + auxiliary.cpp \ + auxos2.cpp \ + mixer.cpp \ + mixeros2.cpp \ + mixerdata.cpp \ + midi.cpp \ + irtmidi.cpp \ + midistrm.cpp \ + mci.cpp \ + joy.cpp \ + mmio.cpp \ + driver.c \ + playsound.cpp \ + joyos2.cpp \ + waveoutflash.cpp \ + dbglocal.cpp \ + initterm.cpp \ + winmmrsrc.orc + +winmm_SOURCES.release += \ + winmm.def +winmm_SOURCES.debug += \ + dbgwrap.cpp \ + winmmdbg.def + +winmm_LIBS = \ + $(PATH_STAGE_LIB)/libwrap.lib \ + $(PATH_STAGE_LIB)/kernel32.lib \ + $(PATH_STAGE_LIB)/user32.lib + +include $(FILE_KBUILD_SUB_FOOTER) diff --git a/src/winmm/mciwave/Makefile.kmk b/src/winmm/mciwave/Makefile.kmk index 429710e..c35e8f3 100644 --- a/src/winmm/mciwave/Makefile.kmk +++ b/src/winmm/mciwave/Makefile.kmk @@ -1,24 +1,24 @@ -## @file -# MCIWAVE library -# - -SUB_DEPTH = ../../.. -include $(KBUILD_PATH)/subheader.kmk - -$(call odin_implib,mciwave) - -DLLS += mciwave -mciwave_TEMPLATE = OdinSimpleDLL - -mciwave_SOURCES = \ - mciwave.c \ - mciwaversrc.orc \ - mciwave.def - -mciwave_LIBS = \ - $(PATH_STAGE_LIB)/libwrap.lib \ - $(PATH_STAGE_LIB)/kernel32.lib \ - $(PATH_STAGE_LIB)/user32.lib \ - $(PATH_STAGE_LIB)/winmm.lib - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# MCIWAVE library +# + +SUB_DEPTH = ../../.. +include $(KBUILD_PATH)/subheader.kmk + +$(call odin_implib,mciwave) + +DLLS += mciwave +mciwave_TEMPLATE = OdinSimpleDLL + +mciwave_SOURCES = \ + mciwave.c \ + mciwaversrc.orc \ + mciwave.def + +mciwave_LIBS = \ + $(PATH_STAGE_LIB)/libwrap.lib \ + $(PATH_STAGE_LIB)/kernel32.lib \ + $(PATH_STAGE_LIB)/user32.lib \ + $(PATH_STAGE_LIB)/winmm.lib + +include $(FILE_KBUILD_SUB_FOOTER) diff --git a/testapp/encodings/Makefile.kmk b/testapp/encodings/Makefile.kmk index 1ff8c54..60316a3 100644 --- a/testapp/encodings/Makefile.kmk +++ b/testapp/encodings/Makefile.kmk @@ -1,17 +1,17 @@ -## @file -# - -SUB_DEPTH = ../.. -include $(KBUILD_PATH)/subheader.kmk - -PROGRAMS += encodings -encodings_TEMPLATE = OdinTestApp - -encodings_SOURCES = \ - test.c - -encodings_LIBS = \ - $(PATH_STAGE_LIB)/kernel32.lib \ - $(PATH_STAGE_LIB)/user32.lib - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# + +SUB_DEPTH = ../.. +include $(KBUILD_PATH)/subheader.kmk + +PROGRAMS += encodings +encodings_TEMPLATE = OdinTestApp + +encodings_SOURCES = \ + test.c + +encodings_LIBS = \ + $(PATH_STAGE_LIB)/kernel32.lib \ + $(PATH_STAGE_LIB)/user32.lib + +include $(FILE_KBUILD_SUB_FOOTER) diff --git a/testapp/exceptions/GuardPages/Makefile.kmk b/testapp/exceptions/GuardPages/Makefile.kmk index c6196df..137c2c1 100644 --- a/testapp/exceptions/GuardPages/Makefile.kmk +++ b/testapp/exceptions/GuardPages/Makefile.kmk @@ -1,12 +1,12 @@ -## @file -# - -SUB_DEPTH = ../../.. -include $(KBUILD_PATH)/subheader.kmk - -PROGRAMS += GuardPages -GuardPages_TEMPLATE = OdinTestApp -GuardPages_SOURCES = main.cpp -GuardPages_LIBS = $(PATH_STAGE_LIB)/kernel32.lib - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# + +SUB_DEPTH = ../../.. +include $(KBUILD_PATH)/subheader.kmk + +PROGRAMS += GuardPages +GuardPages_TEMPLATE = OdinTestApp +GuardPages_SOURCES = main.cpp +GuardPages_LIBS = $(PATH_STAGE_LIB)/kernel32.lib + +include $(FILE_KBUILD_SUB_FOOTER) diff --git a/testapp/gui/fileopen/Makefile.kmk b/testapp/gui/fileopen/Makefile.kmk index 3c0731a..a9c392f 100644 --- a/testapp/gui/fileopen/Makefile.kmk +++ b/testapp/gui/fileopen/Makefile.kmk @@ -1,20 +1,20 @@ -## @file -# - -SUB_DEPTH = ../../.. -include $(KBUILD_PATH)/subheader.kmk - -PROGRAMS += fileopen -fileopen_TEMPLATE = OdinTestApp - -fileopen_SOURCES = \ - fileopen.cpp - -fileopen_DEFS = UNICODE - -fileopen_LIBS = \ - $(PATH_STAGE_LIB)/kernel32.lib \ - $(PATH_STAGE_LIB)/comdlg32.lib \ - $(PATH_STAGE_LIB)/user32.lib - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# + +SUB_DEPTH = ../../.. +include $(KBUILD_PATH)/subheader.kmk + +PROGRAMS += fileopen +fileopen_TEMPLATE = OdinTestApp + +fileopen_SOURCES = \ + fileopen.cpp + +fileopen_DEFS = UNICODE + +fileopen_LIBS = \ + $(PATH_STAGE_LIB)/kernel32.lib \ + $(PATH_STAGE_LIB)/comdlg32.lib \ + $(PATH_STAGE_LIB)/user32.lib + +include $(FILE_KBUILD_SUB_FOOTER) diff --git a/testapp/gui/input/Makefile.kmk b/testapp/gui/input/Makefile.kmk index c9719e7..4fc24e6 100644 --- a/testapp/gui/input/Makefile.kmk +++ b/testapp/gui/input/Makefile.kmk @@ -1,20 +1,20 @@ -## @file -# - -SUB_DEPTH = ../../.. -include $(KBUILD_PATH)/subheader.kmk - -PROGRAMS += input_a -input_a_TEMPLATE = OdinTestApp -input_a_SOURCES = input.c -input_a_LIBS = $(PATH_STAGE_LIB)/kernel32.lib \ - $(PATH_STAGE_LIB)/user32.lib \ - $(PATH_STAGE_LIB)/comctl32.lib - -PROGRAMS += input_w -input_w_TEMPLATE = OdinTestApp -input_w_DEFS = UNICODE -input_w_SOURCES = $(input_a_SOURCES) -input_w_LIBS = $(input_a_LIBS) - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# + +SUB_DEPTH = ../../.. +include $(KBUILD_PATH)/subheader.kmk + +PROGRAMS += input_a +input_a_TEMPLATE = OdinTestApp +input_a_SOURCES = input.c +input_a_LIBS = $(PATH_STAGE_LIB)/kernel32.lib \ + $(PATH_STAGE_LIB)/user32.lib \ + $(PATH_STAGE_LIB)/comctl32.lib + +PROGRAMS += input_w +input_w_TEMPLATE = OdinTestApp +input_w_DEFS = UNICODE +input_w_SOURCES = $(input_a_SOURCES) +input_w_LIBS = $(input_a_LIBS) + +include $(FILE_KBUILD_SUB_FOOTER) diff --git a/testapp/gui/systray/Makefile.kmk b/testapp/gui/systray/Makefile.kmk index 5c8635f..9a7a1e8 100644 --- a/testapp/gui/systray/Makefile.kmk +++ b/testapp/gui/systray/Makefile.kmk @@ -1,16 +1,16 @@ -## @file -# - -SUB_DEPTH = ../../.. -include $(KBUILD_PATH)/subheader.kmk - -PROGRAMS += StealthDialog -StealthDialog_TEMPLATE = OdinTestApp -StealthDialog_SOURCES = StealthDialog.cpp StealthDialog.orc - -StealthDialog_LIBS = $(PATH_STAGE_LIB)/kernel32.lib \ - $(PATH_STAGE_LIB)/user32.lib \ - $(PATH_STAGE_LIB)/comctl32.lib \ - $(PATH_STAGE_LIB)/shell32.lib - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# + +SUB_DEPTH = ../../.. +include $(KBUILD_PATH)/subheader.kmk + +PROGRAMS += StealthDialog +StealthDialog_TEMPLATE = OdinTestApp +StealthDialog_SOURCES = StealthDialog.cpp StealthDialog.orc + +StealthDialog_LIBS = $(PATH_STAGE_LIB)/kernel32.lib \ + $(PATH_STAGE_LIB)/user32.lib \ + $(PATH_STAGE_LIB)/comctl32.lib \ + $(PATH_STAGE_LIB)/shell32.lib + +include $(FILE_KBUILD_SUB_FOOTER) diff --git a/tools/DailyBuild/job.cmd b/tools/DailyBuild/job.cmd index 09fef4f..d215d5e 100644 --- a/tools/DailyBuild/job.cmd +++ b/tools/DailyBuild/job.cmd @@ -1,181 +1,181 @@ -/* $Id: job.cmd,v 1.11 2003-08-05 00:16:17 bird Exp $ - * - * Main job for building OS/2. - * - * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - - /* Load rexxutils functions */ - if (RxFuncQuery('SysLoadFuncs') = 1) then - do - rc = RxFuncAdd('SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'); - if (rc <> 0) then - do - say 'RxFuncAdd -> 'rc''; - do i = 1 to 1000 - rc = RxFuncAdd('SysDropFuncs', 'RexxUtil', 'SysDropFuncs'); - call SysDropFuncs; - rc = RxFuncAdd('SysDropFuncs', 'RexxUtil', 'SysDropFuncs'); - call SysDropFuncs; - end - rc = RxFuncAdd('SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'); - end - call SysLoadFuncs; - end - - /* - * Get and set the build date. - */ - parse arg sDate sType sDummy - fOk = 1; - if (sDate <> '') then - do - parse var sDate sYear'-'sMonth'-'sDay - sType = substr(translate(sType), 1, 1); - if ( (length(sYear) <> 4) | (strip(translate(sYear, '','0123456789')) <> ''), - | (length(sMonth) <>2) | (strip(translate(sMonth, '','0123456789')) <> ''), - | (length(sDay) <> 2) | (strip(translate(sDay, '','0123456789')) <> ''), - | ((sType <> 'W') & (sType <> 'D'))) then - fOk = 0; - else - sDate = sYear||sMonth||sDay; - end - else - do - sDate = date('S'); - sType = 'D'; - if (Date('B')//7 = 3) then /* weekly on Thursdays */ - sType = 'W'; - end - - if (\fOk) then - do - say 'Hey mister! you''ve given me a bad date or build type!!!'; - say 'Date='sYear'-'sMonth'-'sDay - say 'Buildtype='sType; - exit(16); - end - call value 'BUILD_DATE', sDate, 'OS2ENVIRONMENT'; - call value 'BUILD_TYPE', sType, 'OS2ENVIRONMENT'; - - - /* - * Get source directory of this script - */ - parse source sd1 sd2 sScript - sScriptDir = filespec('drive', sScript) || filespec('path', sScript); - sStateDir = sScriptDir||'State'||sType; - sLogFile = sScriptDir || 'Logs\' || sDate || '.log'; - sTree = sScriptDir || '..\tree' || sDate; - 'call' sScriptDir||'bin\CreatePath.cmd 'sScriptDir||'Logs' - 'call' sScriptDir||'bin\CreatePath.cmd 'sScriptDir||'DBBackup' - 'call' sScriptDir||'bin\CreatePath.cmd 'sStateDir; - - /* - * Clean tree, get it and build it. - */ - 'mkdir' sTree - filespec('drive', sScript); - 'cd' sTree; - if (rc <> 0) then call failure rc, '', 'cd 'sTree 'failed.'; - 'call' sScriptDir || 'odin32env.cmd' - if (rc <> 0) then call failure rc, '', 'Env failed.'; - if (IsChangeLogModified(sStateDir)) then - do - say 'Nothing to do. ChangeLog unmodified.' - 'echo ChangeLog unmodified >' sLogFile; - exit(0); - end - 'call' sScriptDir || 'odin32clean.cmd' - if (rc <> 0) then call failure rc, sStateDir, 'Clean failed.'; - 'call' sScriptDir || 'odin32get.cmd' - if (rc <> 0) then call failure rc, sStateDir, 'Get failed.'; - 'call' sScriptDir || 'odin32bldnr.cmd inc' - if (rc <> 0) then call failure rc, sStateDir, 'Build Nr inc failed.'; - 'call' sScriptDir || 'odin32build.cmd 2>&1 | tee /a ' || sLogFile; /* 4OS/2 tee command. */ - if (rc <> 0) then call failure rc, sStateDir, 'Build failed.'; - 'call' sScriptDir || 'odin32bldnr.cmd commit' - if (rc <> 0) then call failure rc, sStateDir, 'Build Nr commit failed.'; - - /* - * Pack and upload it. - */ - 'call' sScriptDir || 'odin32pack.cmd 2>&1 | tee /a ' || sLogFile; /* 4OS/2 tee command. */ - if (rc <> 0) then call failure rc, sStateDir, 'Packing failed.'; - 'call' sScriptDir || 'odin32ftp2.cmd'; - if (rc <> 0) then call failure rc, sStateDir, 'Upload failed!'; - - - /* - * database update - */ - /* - sScriptDir || 'odin32db.cmd 2>&1 | tee /a ' || sLogFile; /* 4OS/2 tee command. */ - if (rc <> 0) then call failure rc, '', 'db failed.'; - */ - - /* successfull exit */ - exit(0); - - -/* - * fatal failures terminates here!. - */ -failure: procedure -parse arg rc, sStateDir, sText; - say 'rc='rc sText - if (sStateDir <> '') then - call ForceNextBuild sStateDir; - exit(rc); - - -/* - * Checks if the change log is up to date or not. - */ -IsChangeLogModified: procedure -parse arg sStateDir; - - sDir = directory(); - 'cd' sStateDir - if (rc <> 0) then call failure rc, 'cd 'sStateDir' failed!'; - - if (stream(sStateDir'\ChangeLog', 'c', 'query exist') == '') then - do - /* no such file: check it out. */ - fUpToDate = 0; - end - else - do - /* check if up to date. */ - 'cvs status ChangeLog | grep -q "Status: Up-to-date"'; - if (rc <> 0) then - fUpToDate = 0; - else - fUpToDate = 1; - end - - /* - * Check out the latest ChangeLog. - */ - if (\fUpToDate) then - do - /* check if up to date. */ - 'if exist ChangeLog del ChangeLog'; - 'call cvs checkout ChangeLog'; - end - - call directory sDir; -return fUpToDate; - - -/* - * Force build next time. - * Called when we fail. - */ -ForceNextBuild: procedure -parse arg sStateDir; - 'if exist 'sStateDir'\ChangeLog del 'sStateDir'\ChangeLog'; -return rc; +/* $Id: job.cmd,v 1.11 2003-08-05 00:16:17 bird Exp $ + * + * Main job for building OS/2. + * + * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + + /* Load rexxutils functions */ + if (RxFuncQuery('SysLoadFuncs') = 1) then + do + rc = RxFuncAdd('SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'); + if (rc <> 0) then + do + say 'RxFuncAdd -> 'rc''; + do i = 1 to 1000 + rc = RxFuncAdd('SysDropFuncs', 'RexxUtil', 'SysDropFuncs'); + call SysDropFuncs; + rc = RxFuncAdd('SysDropFuncs', 'RexxUtil', 'SysDropFuncs'); + call SysDropFuncs; + end + rc = RxFuncAdd('SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'); + end + call SysLoadFuncs; + end + + /* + * Get and set the build date. + */ + parse arg sDate sType sDummy + fOk = 1; + if (sDate <> '') then + do + parse var sDate sYear'-'sMonth'-'sDay + sType = substr(translate(sType), 1, 1); + if ( (length(sYear) <> 4) | (strip(translate(sYear, '','0123456789')) <> ''), + | (length(sMonth) <>2) | (strip(translate(sMonth, '','0123456789')) <> ''), + | (length(sDay) <> 2) | (strip(translate(sDay, '','0123456789')) <> ''), + | ((sType <> 'W') & (sType <> 'D'))) then + fOk = 0; + else + sDate = sYear||sMonth||sDay; + end + else + do + sDate = date('S'); + sType = 'D'; + if (Date('B')//7 = 3) then /* weekly on Thursdays */ + sType = 'W'; + end + + if (\fOk) then + do + say 'Hey mister! you''ve given me a bad date or build type!!!'; + say 'Date='sYear'-'sMonth'-'sDay + say 'Buildtype='sType; + exit(16); + end + call value 'BUILD_DATE', sDate, 'OS2ENVIRONMENT'; + call value 'BUILD_TYPE', sType, 'OS2ENVIRONMENT'; + + + /* + * Get source directory of this script + */ + parse source sd1 sd2 sScript + sScriptDir = filespec('drive', sScript) || filespec('path', sScript); + sStateDir = sScriptDir||'State'||sType; + sLogFile = sScriptDir || 'Logs\' || sDate || '.log'; + sTree = sScriptDir || '..\tree' || sDate; + 'call' sScriptDir||'bin\CreatePath.cmd 'sScriptDir||'Logs' + 'call' sScriptDir||'bin\CreatePath.cmd 'sScriptDir||'DBBackup' + 'call' sScriptDir||'bin\CreatePath.cmd 'sStateDir; + + /* + * Clean tree, get it and build it. + */ + 'mkdir' sTree + filespec('drive', sScript); + 'cd' sTree; + if (rc <> 0) then call failure rc, '', 'cd 'sTree 'failed.'; + 'call' sScriptDir || 'odin32env.cmd' + if (rc <> 0) then call failure rc, '', 'Env failed.'; + if (IsChangeLogModified(sStateDir)) then + do + say 'Nothing to do. ChangeLog unmodified.' + 'echo ChangeLog unmodified >' sLogFile; + exit(0); + end + 'call' sScriptDir || 'odin32clean.cmd' + if (rc <> 0) then call failure rc, sStateDir, 'Clean failed.'; + 'call' sScriptDir || 'odin32get.cmd' + if (rc <> 0) then call failure rc, sStateDir, 'Get failed.'; + 'call' sScriptDir || 'odin32bldnr.cmd inc' + if (rc <> 0) then call failure rc, sStateDir, 'Build Nr inc failed.'; + 'call' sScriptDir || 'odin32build.cmd 2>&1 | tee /a ' || sLogFile; /* 4OS/2 tee command. */ + if (rc <> 0) then call failure rc, sStateDir, 'Build failed.'; + 'call' sScriptDir || 'odin32bldnr.cmd commit' + if (rc <> 0) then call failure rc, sStateDir, 'Build Nr commit failed.'; + + /* + * Pack and upload it. + */ + 'call' sScriptDir || 'odin32pack.cmd 2>&1 | tee /a ' || sLogFile; /* 4OS/2 tee command. */ + if (rc <> 0) then call failure rc, sStateDir, 'Packing failed.'; + 'call' sScriptDir || 'odin32ftp2.cmd'; + if (rc <> 0) then call failure rc, sStateDir, 'Upload failed!'; + + + /* + * database update + */ + /* + sScriptDir || 'odin32db.cmd 2>&1 | tee /a ' || sLogFile; /* 4OS/2 tee command. */ + if (rc <> 0) then call failure rc, '', 'db failed.'; + */ + + /* successfull exit */ + exit(0); + + +/* + * fatal failures terminates here!. + */ +failure: procedure +parse arg rc, sStateDir, sText; + say 'rc='rc sText + if (sStateDir <> '') then + call ForceNextBuild sStateDir; + exit(rc); + + +/* + * Checks if the change log is up to date or not. + */ +IsChangeLogModified: procedure +parse arg sStateDir; + + sDir = directory(); + 'cd' sStateDir + if (rc <> 0) then call failure rc, 'cd 'sStateDir' failed!'; + + if (stream(sStateDir'\ChangeLog', 'c', 'query exist') == '') then + do + /* no such file: check it out. */ + fUpToDate = 0; + end + else + do + /* check if up to date. */ + 'cvs status ChangeLog | grep -q "Status: Up-to-date"'; + if (rc <> 0) then + fUpToDate = 0; + else + fUpToDate = 1; + end + + /* + * Check out the latest ChangeLog. + */ + if (\fUpToDate) then + do + /* check if up to date. */ + 'if exist ChangeLog del ChangeLog'; + 'call cvs checkout ChangeLog'; + end + + call directory sDir; +return fUpToDate; + + +/* + * Force build next time. + * Called when we fail. + */ +ForceNextBuild: procedure +parse arg sStateDir; + 'if exist 'sStateDir'\ChangeLog del 'sStateDir'\ChangeLog'; +return rc; diff --git a/tools/DailyBuild/odin32bldnr.cmd b/tools/DailyBuild/odin32bldnr.cmd index 4defeb5..20e3be4 100644 --- a/tools/DailyBuild/odin32bldnr.cmd +++ b/tools/DailyBuild/odin32bldnr.cmd @@ -1,167 +1,167 @@ -/* $Id: odin32bldnr.cmd,v 1.5 2002-06-26 22:07:15 bird Exp $ - * - * Build number update script. - * - * Two operations: - * 1. Increment the build number. - * 2. Commit the build number file. - * - * Assumes that current directory is the root. - * - * Copyright (c) 2001-2002 knut st. osmundsen (bird@anduin.net) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - -call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; -call SysLoadFuncs; - -/* get build settings */ -sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); -sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); -if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end - - -/* - * Parse parameters. - */ -parse arg sOperation sIgnore - -/* - * Save and change directory. - */ -sTree = directory(); -'cd include'; -if (rc <> 0) then call failure rc, 'cd include failed.'; - - -/* - * Do operation. - */ -if (substr(sOperation, 1, 3) = 'inc') then -do - /* - * Scan the odinbuild.h file for ODIN32_BUILD_NR. - */ - sOut = 'odinbuild.h'; - sIn = 'odinbuild.h.backup'; - call SysFileDelete('odinbuild.h.backup'); - 'copy' sOut sIn; - if (rc) then call failure rc, 'backup copy failed'; - call SysFileDelete('odinbuild.h'); - - rcIn = stream(sIn, 'c', 'open read'); - rcOut = stream(sOut, 'c', 'open write'); - if (pos('READY', rcIn) <> 1 | pos('READY', rcOut) <> 1) then - do - call stream(sIn, 'c', 'close'); - call stream(sOut, 'c', 'close'); - call failure 5, 'failed to open in or/and out file. rcIn='rcIn 'rcOut='rcOut; - end - - /* - * Copy loop which updates ODIN32_BUILD_NR when found. - */ - fFound = 0; - do while (lines(sIn)) - sLine = linein(sIn); - if (\fFound & substr(strip(sLine), 1, 24) = '#define ODIN32_BUILD_NR ') then - do - parse var sLine '#define ODIN32_BUILD_NR' iBuildNr sComment; - iBuildNr = strip(iBuildNr); - sComment = strip(sComment); - iBuildNr = iBuildNr + 1; - sLine = '#define ODIN32_BUILD_NR '||iBuildNr||' '||sComment; - say 'newln:' sLine; - fFound = 1; - end - call lineout sOut, sLine; - end - call lineout sOut, ''; - call stream sIn, 'c', 'close'; - call stream sOut, 'c', 'close'; - rc = 0; -end -else if (sOperation = 'svn') then -do - - /* get svn revision */ - 'rxqueue /clear' - 'svn info | grep "Revision:" | cut -d" " -f2 | rxqueue' - iBuildNr = LineIn("QUEUE:") - - /* - * Scan the odinbuild.h file for ODIN32_BUILD_NR. - */ - sOut = 'odinbuild.h'; - sIn = 'odinbuild.h.backup'; - call SysFileDelete('odinbuild.h.backup'); - 'copy' sOut sIn; - if (rc) then call failure rc, 'backup copy failed'; - call SysFileDelete('odinbuild.h'); - - rcIn = stream(sIn, 'c', 'open read'); - rcOut = stream(sOut, 'c', 'open write'); - if (pos('READY', rcIn) <> 1 | pos('READY', rcOut) <> 1) then - do - call stream(sIn, 'c', 'close'); - call stream(sOut, 'c', 'close'); - call failure 5, 'failed to open in or/and out file. rcIn='rcIn 'rcOut='rcOut; - end - - /* - * Copy loop which updates ODIN32_BUILD_NR when found. - */ - fFound = 0; - do while (lines(sIn)) - sLine = linein(sIn); - if (\fFound & substr(strip(sLine), 1, 24) = '#define ODIN32_BUILD_NR ') then - do - parse var sLine '#define ODIN32_BUILD_NR' iOldBuildNr sComment; - sComment = strip(sComment); - sLine = '#define ODIN32_BUILD_NR '||iBuildNr||' '||sComment; - say 'newln:' sLine; - fFound = 1; - end - call lineout sOut, sLine; - end - call lineout sOut, ''; - call stream sIn, 'c', 'close'; - call stream sOut, 'c', 'close'; - rc = 0; -end -else if (sOperation = 'commit') then -do - /* - * Commit the build nr. file. - */ - if (sType = 'W') then - 'cvs commit -m "Weekly build - 'sDate'" odinbuild.h'; - else - 'cvs commit -m "Daily build - 'sDate'" odinbuild.h'; - if (rc <> 0) then call failed rc, 'failed to commit odinbuild.h' -end -else -do - say 'invalid operation' sOperation'. Should be commit or inc.' - rc = 87; -end - - -/* - * Restore directory. - */ -call directory(sTree); - -exit(rc); - - -/* - * Fatal failures terminates here!. - */ -failure: procedure -parse arg rc, sText; - say 'rc='rc sText - exit(rc); - +/* $Id: odin32bldnr.cmd,v 1.5 2002-06-26 22:07:15 bird Exp $ + * + * Build number update script. + * + * Two operations: + * 1. Increment the build number. + * 2. Commit the build number file. + * + * Assumes that current directory is the root. + * + * Copyright (c) 2001-2002 knut st. osmundsen (bird@anduin.net) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + +call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; +call SysLoadFuncs; + +/* get build settings */ +sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); +sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); +if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end + + +/* + * Parse parameters. + */ +parse arg sOperation sIgnore + +/* + * Save and change directory. + */ +sTree = directory(); +'cd include'; +if (rc <> 0) then call failure rc, 'cd include failed.'; + + +/* + * Do operation. + */ +if (substr(sOperation, 1, 3) = 'inc') then +do + /* + * Scan the odinbuild.h file for ODIN32_BUILD_NR. + */ + sOut = 'odinbuild.h'; + sIn = 'odinbuild.h.backup'; + call SysFileDelete('odinbuild.h.backup'); + 'copy' sOut sIn; + if (rc) then call failure rc, 'backup copy failed'; + call SysFileDelete('odinbuild.h'); + + rcIn = stream(sIn, 'c', 'open read'); + rcOut = stream(sOut, 'c', 'open write'); + if (pos('READY', rcIn) <> 1 | pos('READY', rcOut) <> 1) then + do + call stream(sIn, 'c', 'close'); + call stream(sOut, 'c', 'close'); + call failure 5, 'failed to open in or/and out file. rcIn='rcIn 'rcOut='rcOut; + end + + /* + * Copy loop which updates ODIN32_BUILD_NR when found. + */ + fFound = 0; + do while (lines(sIn)) + sLine = linein(sIn); + if (\fFound & substr(strip(sLine), 1, 24) = '#define ODIN32_BUILD_NR ') then + do + parse var sLine '#define ODIN32_BUILD_NR' iBuildNr sComment; + iBuildNr = strip(iBuildNr); + sComment = strip(sComment); + iBuildNr = iBuildNr + 1; + sLine = '#define ODIN32_BUILD_NR '||iBuildNr||' '||sComment; + say 'newln:' sLine; + fFound = 1; + end + call lineout sOut, sLine; + end + call lineout sOut, ''; + call stream sIn, 'c', 'close'; + call stream sOut, 'c', 'close'; + rc = 0; +end +else if (sOperation = 'svn') then +do + + /* get svn revision */ + 'rxqueue /clear' + 'svn info | grep "Revision:" | cut -d" " -f2 | rxqueue' + iBuildNr = LineIn("QUEUE:") + + /* + * Scan the odinbuild.h file for ODIN32_BUILD_NR. + */ + sOut = 'odinbuild.h'; + sIn = 'odinbuild.h.backup'; + call SysFileDelete('odinbuild.h.backup'); + 'copy' sOut sIn; + if (rc) then call failure rc, 'backup copy failed'; + call SysFileDelete('odinbuild.h'); + + rcIn = stream(sIn, 'c', 'open read'); + rcOut = stream(sOut, 'c', 'open write'); + if (pos('READY', rcIn) <> 1 | pos('READY', rcOut) <> 1) then + do + call stream(sIn, 'c', 'close'); + call stream(sOut, 'c', 'close'); + call failure 5, 'failed to open in or/and out file. rcIn='rcIn 'rcOut='rcOut; + end + + /* + * Copy loop which updates ODIN32_BUILD_NR when found. + */ + fFound = 0; + do while (lines(sIn)) + sLine = linein(sIn); + if (\fFound & substr(strip(sLine), 1, 24) = '#define ODIN32_BUILD_NR ') then + do + parse var sLine '#define ODIN32_BUILD_NR' iOldBuildNr sComment; + sComment = strip(sComment); + sLine = '#define ODIN32_BUILD_NR '||iBuildNr||' '||sComment; + say 'newln:' sLine; + fFound = 1; + end + call lineout sOut, sLine; + end + call lineout sOut, ''; + call stream sIn, 'c', 'close'; + call stream sOut, 'c', 'close'; + rc = 0; +end +else if (sOperation = 'commit') then +do + /* + * Commit the build nr. file. + */ + if (sType = 'W') then + 'cvs commit -m "Weekly build - 'sDate'" odinbuild.h'; + else + 'cvs commit -m "Daily build - 'sDate'" odinbuild.h'; + if (rc <> 0) then call failed rc, 'failed to commit odinbuild.h' +end +else +do + say 'invalid operation' sOperation'. Should be commit or inc.' + rc = 87; +end + + +/* + * Restore directory. + */ +call directory(sTree); + +exit(rc); + + +/* + * Fatal failures terminates here!. + */ +failure: procedure +parse arg rc, sText; + say 'rc='rc sText + exit(rc); + diff --git a/tools/DailyBuild/odin32build.cmd b/tools/DailyBuild/odin32build.cmd index aa140ce..5943d91 100644 --- a/tools/DailyBuild/odin32build.cmd +++ b/tools/DailyBuild/odin32build.cmd @@ -1,39 +1,39 @@ -/* $Id: odin32build.cmd,v 1.2 2002-06-26 22:08:32 bird Exp $ - * - * Builds debug and release editions of Odin32. - * - * Copyright (c) 1999-2000 knut st. osmundsen (knut.stange.osmundsen@mynd.no) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - /* get build settings */ - /*sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); - sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); - if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end - */ - -/* - * Parse parameters. - */ -parse arg sSMP - - /* debug build */ - 'SET DEBUG=1'; - 'nmake dep'; - if (RC <> 0) then call failure rc, 'Make failed (dep).'; - 'nmake NODEBUGINFO=1 'sSMP; - if (RC <> 0) then call failure rc, 'Make debug failed.'; - - /* release build */ - 'SET DEBUG='; - 'nmake 'sSMP; - if (RC <> 0) then call failure rc, 'Make release failed .'; - - exit(0); - -failure: procedure -parse arg rc, sText; - say 'rc='rc sText - exit(rc); - +/* $Id: odin32build.cmd,v 1.2 2002-06-26 22:08:32 bird Exp $ + * + * Builds debug and release editions of Odin32. + * + * Copyright (c) 1999-2000 knut st. osmundsen (knut.stange.osmundsen@mynd.no) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + /* get build settings */ + /*sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); + sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); + if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end + */ + +/* + * Parse parameters. + */ +parse arg sSMP + + /* debug build */ + 'SET DEBUG=1'; + 'nmake dep'; + if (RC <> 0) then call failure rc, 'Make failed (dep).'; + 'nmake NODEBUGINFO=1 'sSMP; + if (RC <> 0) then call failure rc, 'Make debug failed.'; + + /* release build */ + 'SET DEBUG='; + 'nmake 'sSMP; + if (RC <> 0) then call failure rc, 'Make release failed .'; + + exit(0); + +failure: procedure +parse arg rc, sText; + say 'rc='rc sText + exit(rc); + diff --git a/tools/DailyBuild/odin32clean.cmd b/tools/DailyBuild/odin32clean.cmd index af79a87..5ffbe1c 100644 --- a/tools/DailyBuild/odin32clean.cmd +++ b/tools/DailyBuild/odin32clean.cmd @@ -1,46 +1,46 @@ -/* $Id: odin32clean.cmd,v 1.5 2003-02-06 21:03:43 bird Exp $ - * - * Removes trees. WARNING!!!!! All tree directories are removed - * if .nodelete is not found in the root of them. - * - * (Delpath is a "deltree" clone I've made, use your own.) - * - * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - - /* get build settings */ - sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); - sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); - if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end - - call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; - call SysloadFuncs; - - sTree = 'tree' || sDate; - - /* - * We assume currentdirectory is the current tree. - */ - rc = SysFileTree('..\tree'||substr(sDate,1,4)||'*.', 'asTrees', 'DO'); - if (rc = 0) then - do - do i = 1 to asTrees.0 - if (stream(asTrees.i||'\.nodelete', 'c', 'query exists') = '') then - do - parse source . . sSrc - filespec('drive', sSrc)||filespec('path', sSrc)||'\bin\rm -rF "'asTrees.i'"'; - end - say asTrees.i - end - end -exit(0); - - -failure: procedure -parse arg rc, sText; - say 'rc='rc sText -exit(rc); - +/* $Id: odin32clean.cmd,v 1.5 2003-02-06 21:03:43 bird Exp $ + * + * Removes trees. WARNING!!!!! All tree directories are removed + * if .nodelete is not found in the root of them. + * + * (Delpath is a "deltree" clone I've made, use your own.) + * + * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + + /* get build settings */ + sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); + sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); + if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end + + call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; + call SysloadFuncs; + + sTree = 'tree' || sDate; + + /* + * We assume currentdirectory is the current tree. + */ + rc = SysFileTree('..\tree'||substr(sDate,1,4)||'*.', 'asTrees', 'DO'); + if (rc = 0) then + do + do i = 1 to asTrees.0 + if (stream(asTrees.i||'\.nodelete', 'c', 'query exists') = '') then + do + parse source . . sSrc + filespec('drive', sSrc)||filespec('path', sSrc)||'\bin\rm -rF "'asTrees.i'"'; + end + say asTrees.i + end + end +exit(0); + + +failure: procedure +parse arg rc, sText; + say 'rc='rc sText +exit(rc); + diff --git a/tools/DailyBuild/odin32db.cmd b/tools/DailyBuild/odin32db.cmd index dcf0b93..d369a78 100644 --- a/tools/DailyBuild/odin32db.cmd +++ b/tools/DailyBuild/odin32db.cmd @@ -1,228 +1,228 @@ -/* $Id: odin32db.cmd,v 1.7 2002-06-26 22:09:59 bird Exp $ - * - * Updates the Odin32 API database. - * - * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - /* get build settings */ - sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); - sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); - if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end - - - /* load rexxutils functions and Ftp Utils. */ - call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; - call SysloadFuncs; - call RxFuncAdd 'FtpLoadFuncs','rxFtp','FtpLoadFuncs'; - call FtpLoadFuncs; - - /* - * Get source directory of this script - */ - parse source sd1 sd2 sScript - sScriptDir = filespec('drive', sScript) || filespec('path', sScript); - sDir = directory(); - 'cd tools\database'; - if rc <> 0 then call failure rc, 'cd db failed'; - 'nmake'; - if rc <> 0 then call failure rc, 'nmake db failed'; - 'cd ..\..\src'; - if rc <> 0 then call failure rc, 'cd src failed'; - 'nmake apiimport'; - if rc <> 0 then call failure rc, 'apiimport failed'; - 'nmake stateupd 2>&1'; - if rc <> 0 then call failure rc, 'stateupd failed'; - - /* create database backup */ - filespec('drive', getMySqlDataDir()); - if rc <> 0 then call failure rc, 'c: failed'; - 'cd' getMySqlDataDir()||'\odin32'; - if rc <> 0 then call failure rc, 'cd <> failed'; - 'mysqladmin refresh'; - 'rar a -m5 ' || sScriptDir || 'dbbackup\db'||sDate||'.rar *' - if rc <> 0 then call failure rc, 'rar db failed'; - 'cd \'; - 'd:'; - 'cd ..'; - - /* dump database and install the dump at netlabs */ - call directory sDir; - 'mkdir db' - 'mysqldump --no-create-db --add-drop-table --allow-keywords -Tdb odin32' - if (rc <> 0) then call failure rc, 'mysqldump failed'; - '@rm -f odin32db.dump' - 'mysqldump --no-create-db --add-drop-table --allow-keywords -e odin32 > odin32db.dump' - if (rc <> 0) then call failure rc, 'mysqldump (2) failed'; - 'zip -9 odin32db.zip odin32db.dump' - if (rc <> 0) then call failure rc, 'createing odin32db.zip failed'; - rc = SysFileTree('db\*', 'asFiles', 'O'); - if (rc <> 0) then call failure rc, 'listing db\* failed'; - do i = 1 to asFiles.0 - rc = putRexxFtp(asFiles.i, '/dev/12345678', '/daily/db', 'ftp.netlabs.org'); - if (rc <> 0) then call failure rc, 'uploading of 'asFiles.i' failed'; - end - rc = putRexxFtp('odin32db.zip', '/dev/12345678', '/daily/db', 'ftp.netlabs.org'); - if (rc <> 0) then call failure rc, 'uploading of 'asFiles.i' failed'; - - sPwdDummy = GetPassword('odin32dbupdate'); - parse var sPwdDummy sPasswd':'sDummy - 'wget -O /dev/con http://www.netlabs.org/odin/odin32dbtest/Odin32DBUpdate.phtml?sPasswd='||sPasswd - if (rc <> 0) then call failure rc, 'wget failed'; - - - exit(0); - -failure: procedure -parse arg rc, sText; - say 'rc='rc sText -exit(rc); - -failure2: procedure -parse arg rc, sText; - say 'rc='rc sText -return 0; - - -/* - * Get the MySql data directory. - */ -getMySqlDataDir: procedure - - /* Get mysql variables */ - '@mysqladmin variables | rxqueue /lifo' - - /* Get datadir */ - sDataDir = ''; - do queued() - pull s; - if (pos(' DATADIR ', s) > 0) then - do - sDataDir = strip( substr( s, pos('|',s,3) + 1 ) ); - sDataDir = strip( substr(sDataDir, 1, length(sDataDir)-1) ); - leave; - end - end - - /* Drain queue */ - do queued() - pull s - end - drop s; - - /* If failure set default directory. */ - if (sDataDir = '') then - sDataDir = 'd:\knut\Apps\MySql\data\'; -return sDataDir; - -/* - * - * From odin32ftp2.cmd - * From odin32ftp2.cmd - * From odin32ftp2.cmd - * From odin32ftp2.cmd - * From odin32ftp2.cmd - * From odin32ftp2.cmd - * - */ - - -/* - * Reads the password file (passwd) in the script directory to - * get a password and userid for a given site. - * - * Format of the passwd file is: - * - * Lines starting with '#' is ignored. - * - * @param sSite name of the site. - * @returns String on the form ':' if found. - * Empty string if not found. - */ -GetPassword: procedure; - parse upper arg sSiteToFind - parse source sd1 sd2 sScript - sPasswd = filespec('drive', sScript) || filespec('path', sScript)||'\passwd'; - - rc = stream(sPasswd, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - do - say 'failed to open ftp password file - rc='rc; - return ''; - end - - sRet = ''; - do while (lines(sPasswd) > 0) - sLine = strip(linein(sPasswd)); - if (sLine = '' | substr(sLine, 1, 1) = '#') then - iterate; - - parse var sLine sSite' 'sUser' 'sPassword' 'sDummy - sSite = translate(strip(sSite)); - sUser = strip(sUser); - sPassword = strip(sPassword); - if (sSite = '' | sPassword = '' | sUser = '') then - say 'warning! misformed password line!'; - if (sSite = sSiteToFind) then - do - sRet = sUser||':'||sPassword; - leave - end - end - call stream sPasswd, 'c', 'close'; -return sRet; - - -/* - * REXX FTP put function. - */ -putRexxFtp: procedure - parse arg sFile, sLockFile, sRemoteDir, sSite - - /* check for done-lock */ - if stream(sLockFile,'c','query exists') = '' then - do - say '--- put' sFile '->' sRemoteDir'/'sFile '---'; - - /* get password */ - sPasswdString = GetPassword(sSite); - if (sPasswdString = '') then - do - call failure rc, 'Can''t find userid/password for' sSite'.', -1; - return -1; - end - parse var sPasswdString sUser':'sPasswd; - - /* log on the ftp site */ - rc = FtpSetUser(sSite, sUser, sPasswd); - if (rc = 1) then - do - /* put file, delete it if we fail */ - say sSite sUser sPasswd sFile sRemoteDir'/'filespec('name', sFile) 'Binary' - rcPut = FtpPut(sFile, sRemoteDir'/'filespec('name',sFile), 'Binary'); - /* - if (rcPut <> 0) then - rc = FtpDelete(sRemoteDir'/'filespec('name', sFile)); - */ - - /* Logoff and make lock file. */ - rc = FtpLogoff(); - if (rcPut = 0) then - 'echo ok ' || sLockFile; /* changed - no lockfile */ - else - call failure2 rc, 'FtpPut failed -' sSite , FTPERRNO; - rc = rcPut; - end - else - do - call failure2 rc, 'Logon failed -' sSite, FTPERRNO; - if rc = 0 then rc = -1; - end - end - else - rc = 0; -return 0; - - +/* $Id: odin32db.cmd,v 1.7 2002-06-26 22:09:59 bird Exp $ + * + * Updates the Odin32 API database. + * + * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + /* get build settings */ + sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); + sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); + if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end + + + /* load rexxutils functions and Ftp Utils. */ + call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; + call SysloadFuncs; + call RxFuncAdd 'FtpLoadFuncs','rxFtp','FtpLoadFuncs'; + call FtpLoadFuncs; + + /* + * Get source directory of this script + */ + parse source sd1 sd2 sScript + sScriptDir = filespec('drive', sScript) || filespec('path', sScript); + sDir = directory(); + 'cd tools\database'; + if rc <> 0 then call failure rc, 'cd db failed'; + 'nmake'; + if rc <> 0 then call failure rc, 'nmake db failed'; + 'cd ..\..\src'; + if rc <> 0 then call failure rc, 'cd src failed'; + 'nmake apiimport'; + if rc <> 0 then call failure rc, 'apiimport failed'; + 'nmake stateupd 2>&1'; + if rc <> 0 then call failure rc, 'stateupd failed'; + + /* create database backup */ + filespec('drive', getMySqlDataDir()); + if rc <> 0 then call failure rc, 'c: failed'; + 'cd' getMySqlDataDir()||'\odin32'; + if rc <> 0 then call failure rc, 'cd <> failed'; + 'mysqladmin refresh'; + 'rar a -m5 ' || sScriptDir || 'dbbackup\db'||sDate||'.rar *' + if rc <> 0 then call failure rc, 'rar db failed'; + 'cd \'; + 'd:'; + 'cd ..'; + + /* dump database and install the dump at netlabs */ + call directory sDir; + 'mkdir db' + 'mysqldump --no-create-db --add-drop-table --allow-keywords -Tdb odin32' + if (rc <> 0) then call failure rc, 'mysqldump failed'; + '@rm -f odin32db.dump' + 'mysqldump --no-create-db --add-drop-table --allow-keywords -e odin32 > odin32db.dump' + if (rc <> 0) then call failure rc, 'mysqldump (2) failed'; + 'zip -9 odin32db.zip odin32db.dump' + if (rc <> 0) then call failure rc, 'createing odin32db.zip failed'; + rc = SysFileTree('db\*', 'asFiles', 'O'); + if (rc <> 0) then call failure rc, 'listing db\* failed'; + do i = 1 to asFiles.0 + rc = putRexxFtp(asFiles.i, '/dev/12345678', '/daily/db', 'ftp.netlabs.org'); + if (rc <> 0) then call failure rc, 'uploading of 'asFiles.i' failed'; + end + rc = putRexxFtp('odin32db.zip', '/dev/12345678', '/daily/db', 'ftp.netlabs.org'); + if (rc <> 0) then call failure rc, 'uploading of 'asFiles.i' failed'; + + sPwdDummy = GetPassword('odin32dbupdate'); + parse var sPwdDummy sPasswd':'sDummy + 'wget -O /dev/con http://www.netlabs.org/odin/odin32dbtest/Odin32DBUpdate.phtml?sPasswd='||sPasswd + if (rc <> 0) then call failure rc, 'wget failed'; + + + exit(0); + +failure: procedure +parse arg rc, sText; + say 'rc='rc sText +exit(rc); + +failure2: procedure +parse arg rc, sText; + say 'rc='rc sText +return 0; + + +/* + * Get the MySql data directory. + */ +getMySqlDataDir: procedure + + /* Get mysql variables */ + '@mysqladmin variables | rxqueue /lifo' + + /* Get datadir */ + sDataDir = ''; + do queued() + pull s; + if (pos(' DATADIR ', s) > 0) then + do + sDataDir = strip( substr( s, pos('|',s,3) + 1 ) ); + sDataDir = strip( substr(sDataDir, 1, length(sDataDir)-1) ); + leave; + end + end + + /* Drain queue */ + do queued() + pull s + end + drop s; + + /* If failure set default directory. */ + if (sDataDir = '') then + sDataDir = 'd:\knut\Apps\MySql\data\'; +return sDataDir; + +/* + * + * From odin32ftp2.cmd + * From odin32ftp2.cmd + * From odin32ftp2.cmd + * From odin32ftp2.cmd + * From odin32ftp2.cmd + * From odin32ftp2.cmd + * + */ + + +/* + * Reads the password file (passwd) in the script directory to + * get a password and userid for a given site. + * + * Format of the passwd file is: + * + * Lines starting with '#' is ignored. + * + * @param sSite name of the site. + * @returns String on the form ':' if found. + * Empty string if not found. + */ +GetPassword: procedure; + parse upper arg sSiteToFind + parse source sd1 sd2 sScript + sPasswd = filespec('drive', sScript) || filespec('path', sScript)||'\passwd'; + + rc = stream(sPasswd, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + do + say 'failed to open ftp password file - rc='rc; + return ''; + end + + sRet = ''; + do while (lines(sPasswd) > 0) + sLine = strip(linein(sPasswd)); + if (sLine = '' | substr(sLine, 1, 1) = '#') then + iterate; + + parse var sLine sSite' 'sUser' 'sPassword' 'sDummy + sSite = translate(strip(sSite)); + sUser = strip(sUser); + sPassword = strip(sPassword); + if (sSite = '' | sPassword = '' | sUser = '') then + say 'warning! misformed password line!'; + if (sSite = sSiteToFind) then + do + sRet = sUser||':'||sPassword; + leave + end + end + call stream sPasswd, 'c', 'close'; +return sRet; + + +/* + * REXX FTP put function. + */ +putRexxFtp: procedure + parse arg sFile, sLockFile, sRemoteDir, sSite + + /* check for done-lock */ + if stream(sLockFile,'c','query exists') = '' then + do + say '--- put' sFile '->' sRemoteDir'/'sFile '---'; + + /* get password */ + sPasswdString = GetPassword(sSite); + if (sPasswdString = '') then + do + call failure rc, 'Can''t find userid/password for' sSite'.', -1; + return -1; + end + parse var sPasswdString sUser':'sPasswd; + + /* log on the ftp site */ + rc = FtpSetUser(sSite, sUser, sPasswd); + if (rc = 1) then + do + /* put file, delete it if we fail */ + say sSite sUser sPasswd sFile sRemoteDir'/'filespec('name', sFile) 'Binary' + rcPut = FtpPut(sFile, sRemoteDir'/'filespec('name',sFile), 'Binary'); + /* + if (rcPut <> 0) then + rc = FtpDelete(sRemoteDir'/'filespec('name', sFile)); + */ + + /* Logoff and make lock file. */ + rc = FtpLogoff(); + if (rcPut = 0) then + 'echo ok ' || sLockFile; /* changed - no lockfile */ + else + call failure2 rc, 'FtpPut failed -' sSite , FTPERRNO; + rc = rcPut; + end + else + do + call failure2 rc, 'Logon failed -' sSite, FTPERRNO; + if rc = 0 then rc = -1; + end + end + else + rc = 0; +return 0; + + diff --git a/tools/DailyBuild/odin32dbupl.cmd b/tools/DailyBuild/odin32dbupl.cmd index 4c0b7ce..54f4fd1 100644 --- a/tools/DailyBuild/odin32dbupl.cmd +++ b/tools/DailyBuild/odin32dbupl.cmd @@ -1,178 +1,178 @@ -/* $Id: odin32dbupl.cmd,v 1.2 2002-06-26 22:10:23 bird Exp $ - * - * Updates the Odin32 API database. - * - * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - - /* get build settings */ - sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); - sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); - if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end - - /* load rexxutils functions */ - call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; - call SysloadFuncs; - - sPwdDummy = GetPassword('odin32dbupdate'); - parse var sPwdDummy sPasswd':'sDummy - 'wget -O /dev/con http://www.netlabs.org/odin/odin32dbtest/Odin32DBUpdate.phtml?sPasswd='||sPasswd - if (rc <> 0) then call failure rc, 'wget failed'; - - - exit(0); - -failure: procedure -parse arg rc, sText; - say 'rc='rc sText - exit(rc); - -failure2: procedure -parse arg rc, sText; - say 'rc='rc sText - return 0; - - -/* - * Get the MySql data directory. - */ -getMySqlDataDir: procedure - - /* Get mysql variables */ - '@mysqladmin variables | rxqueue /lifo' - - /* Get datadir */ - sDataDir = ''; - do queued() - pull s; - if (pos(' DATADIR ', s) > 0) then - do - sDataDir = strip( substr( s, pos('|',s,3) + 1 ) ); - sDataDir = strip( substr(sDataDir, 1, length(sDataDir)-1) ); - leave; - end - end - - /* Drain queue */ - do queued() - pull s - end - drop s; - - /* If failure set default directory. */ - if (sDataDir = '') then - sDataDir = 'd:\knut\Apps\MySql\data\'; - return sDataDir; - -/* - * - * From odin32ftp2.cmd - * From odin32ftp2.cmd - * From odin32ftp2.cmd - * From odin32ftp2.cmd - * From odin32ftp2.cmd - * From odin32ftp2.cmd - * - */ - - -/* - * Reads the password file (passwd) in the script directory to - * get a password and userid for a given site. - * - * Format of the passwd file is: - * - * Lines starting with '#' is ignored. - * - * @param sSite name of the site. - * @returns String on the form ':' if found. - * Empty string if not found. - */ -GetPassword: procedure; - parse upper arg sSiteToFind - parse source sd1 sd2 sScript - sPasswd = filespec('drive', sScript) || filespec('path', sScript)||'\passwd'; - - rc = stream(sPasswd, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - do - say 'failed to open ftp password file - rc='rc; - return ''; - end - - sRet = ''; - do while (lines(sPasswd) > 0) - sLine = strip(linein(sPasswd)); - if (sLine = '' | substr(sLine, 1, 1) = '#') then - iterate; - - parse var sLine sSite' 'sUser' 'sPassword' 'sDummy - sSite = translate(strip(sSite)); - sUser = strip(sUser); - sPassword = strip(sPassword); - if (sSite = '' | sPassword = '' | sUser = '') then - say 'warning! misformed password line!'; - if (sSite = sSiteToFind) then - do - sRet = sUser||':'||sPassword; - leave - end - end - call stream sPasswd, 'c', 'close'; - return sRet; - - -/* - * REXX FTP put function. - */ -putRexxFtp: procedure - parse arg sFile, sLockFile, sRemoteDir, sSite - - /* check for done-lock */ - if stream(sLockFile,'c','query exists') = '' then - do - say '--- put' sFile '->' sRemoteDir'/'sFile '---'; - - /* get password */ - sPasswdString = GetPassword(sSite); - if (sPasswdString = '') then - do - call failure rc, 'Can''t find userid/password for' sSite'.', -1; - return -1; - end - parse var sPasswdString sUser':'sPasswd; - - /* log on the ftp site */ - rc = FtpSetUser(sSite, sUser, sPasswd); - if (rc = 1) then - do - /* put file, delete it if we fail */ - say sSite sUser sPasswd sFile sRemoteDir'/'filespec('name', sFile) 'Binary' - rcPut = FtpPut(sFile, sRemoteDir'/'filespec('name',sFile), 'Binary'); - /* - if (rcPut <> 0) then - rc = FtpDelete(sRemoteDir'/'filespec('name', sFile)); - */ - - /* Logoff and make lock file. */ - rc = FtpLogoff(); - if (rcPut = 0) then - 'echo ok ' || sLockFile; /* changed - no lockfile */ - else - call failure2 rc, 'FtpPut failed -' sSite , FTPERRNO; - rc = rcPut; - end - else - do - call failure2 rc, 'Logon failed -' sSite, FTPERRNO; - if rc = 0 then rc = -1; - end - end - else - rc = 0; - return 0; - - +/* $Id: odin32dbupl.cmd,v 1.2 2002-06-26 22:10:23 bird Exp $ + * + * Updates the Odin32 API database. + * + * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + + /* get build settings */ + sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); + sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); + if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end + + /* load rexxutils functions */ + call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; + call SysloadFuncs; + + sPwdDummy = GetPassword('odin32dbupdate'); + parse var sPwdDummy sPasswd':'sDummy + 'wget -O /dev/con http://www.netlabs.org/odin/odin32dbtest/Odin32DBUpdate.phtml?sPasswd='||sPasswd + if (rc <> 0) then call failure rc, 'wget failed'; + + + exit(0); + +failure: procedure +parse arg rc, sText; + say 'rc='rc sText + exit(rc); + +failure2: procedure +parse arg rc, sText; + say 'rc='rc sText + return 0; + + +/* + * Get the MySql data directory. + */ +getMySqlDataDir: procedure + + /* Get mysql variables */ + '@mysqladmin variables | rxqueue /lifo' + + /* Get datadir */ + sDataDir = ''; + do queued() + pull s; + if (pos(' DATADIR ', s) > 0) then + do + sDataDir = strip( substr( s, pos('|',s,3) + 1 ) ); + sDataDir = strip( substr(sDataDir, 1, length(sDataDir)-1) ); + leave; + end + end + + /* Drain queue */ + do queued() + pull s + end + drop s; + + /* If failure set default directory. */ + if (sDataDir = '') then + sDataDir = 'd:\knut\Apps\MySql\data\'; + return sDataDir; + +/* + * + * From odin32ftp2.cmd + * From odin32ftp2.cmd + * From odin32ftp2.cmd + * From odin32ftp2.cmd + * From odin32ftp2.cmd + * From odin32ftp2.cmd + * + */ + + +/* + * Reads the password file (passwd) in the script directory to + * get a password and userid for a given site. + * + * Format of the passwd file is: + * + * Lines starting with '#' is ignored. + * + * @param sSite name of the site. + * @returns String on the form ':' if found. + * Empty string if not found. + */ +GetPassword: procedure; + parse upper arg sSiteToFind + parse source sd1 sd2 sScript + sPasswd = filespec('drive', sScript) || filespec('path', sScript)||'\passwd'; + + rc = stream(sPasswd, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + do + say 'failed to open ftp password file - rc='rc; + return ''; + end + + sRet = ''; + do while (lines(sPasswd) > 0) + sLine = strip(linein(sPasswd)); + if (sLine = '' | substr(sLine, 1, 1) = '#') then + iterate; + + parse var sLine sSite' 'sUser' 'sPassword' 'sDummy + sSite = translate(strip(sSite)); + sUser = strip(sUser); + sPassword = strip(sPassword); + if (sSite = '' | sPassword = '' | sUser = '') then + say 'warning! misformed password line!'; + if (sSite = sSiteToFind) then + do + sRet = sUser||':'||sPassword; + leave + end + end + call stream sPasswd, 'c', 'close'; + return sRet; + + +/* + * REXX FTP put function. + */ +putRexxFtp: procedure + parse arg sFile, sLockFile, sRemoteDir, sSite + + /* check for done-lock */ + if stream(sLockFile,'c','query exists') = '' then + do + say '--- put' sFile '->' sRemoteDir'/'sFile '---'; + + /* get password */ + sPasswdString = GetPassword(sSite); + if (sPasswdString = '') then + do + call failure rc, 'Can''t find userid/password for' sSite'.', -1; + return -1; + end + parse var sPasswdString sUser':'sPasswd; + + /* log on the ftp site */ + rc = FtpSetUser(sSite, sUser, sPasswd); + if (rc = 1) then + do + /* put file, delete it if we fail */ + say sSite sUser sPasswd sFile sRemoteDir'/'filespec('name', sFile) 'Binary' + rcPut = FtpPut(sFile, sRemoteDir'/'filespec('name',sFile), 'Binary'); + /* + if (rcPut <> 0) then + rc = FtpDelete(sRemoteDir'/'filespec('name', sFile)); + */ + + /* Logoff and make lock file. */ + rc = FtpLogoff(); + if (rcPut = 0) then + 'echo ok ' || sLockFile; /* changed - no lockfile */ + else + call failure2 rc, 'FtpPut failed -' sSite , FTPERRNO; + rc = rcPut; + end + else + do + call failure2 rc, 'Logon failed -' sSite, FTPERRNO; + if rc = 0 then rc = -1; + end + end + else + rc = 0; + return 0; + + diff --git a/tools/DailyBuild/odin32env.cmd b/tools/DailyBuild/odin32env.cmd index 6e97e35..52c5f90 100644 --- a/tools/DailyBuild/odin32env.cmd +++ b/tools/DailyBuild/odin32env.cmd @@ -1,31 +1,31 @@ -/* $Id: odin32env.cmd,v 1.32 2003-04-14 22:23:47 bird Exp $ - * - * Sets the build environment. - * - * Copyright (c) 1999-2003 knut st. osmundsen (bird@anduin.net) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - -/* - * Source dir. - */ -parse source . . sSrc -sDir = filespec('drive', sSrc) || filespec('path', sSrc); - -/* base env */ -'Set PATH='||sDir||'bin'||';%PATH%'; -sOldDir = directory(); -call directory sDir||'bin'; -call BuildEnv 'warpin mysql perl~ cvs ddkbase mscv6-16 emx gcc321 vac365õ watcomc11cõ vac40õ vac308 toolkit40 debug' -call directory sOldDir; - -/* minor adjustments. */ -'Set CVSROOT=:pserver:bird@www.netlabs.org:/netlabs.cvs/odin32'; -'Set MULTIJOBS=1'; -'Set BUILD_SETUP_MAK='; -'Set EMX=%PATH_EMXPGCC%'; - -exit(0); - +/* $Id: odin32env.cmd,v 1.32 2003-04-14 22:23:47 bird Exp $ + * + * Sets the build environment. + * + * Copyright (c) 1999-2003 knut st. osmundsen (bird@anduin.net) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + +/* + * Source dir. + */ +parse source . . sSrc +sDir = filespec('drive', sSrc) || filespec('path', sSrc); + +/* base env */ +'Set PATH='||sDir||'bin'||';%PATH%'; +sOldDir = directory(); +call directory sDir||'bin'; +call BuildEnv 'warpin mysql perl~ cvs ddkbase mscv6-16 emx gcc321 vac365õ watcomc11cõ vac40õ vac308 toolkit40 debug' +call directory sOldDir; + +/* minor adjustments. */ +'Set CVSROOT=:pserver:bird@www.netlabs.org:/netlabs.cvs/odin32'; +'Set MULTIJOBS=1'; +'Set BUILD_SETUP_MAK='; +'Set EMX=%PATH_EMXPGCC%'; + +exit(0); + diff --git a/tools/DailyBuild/odin32ftp.cmd b/tools/DailyBuild/odin32ftp.cmd index 7694968..e7826f8 100644 --- a/tools/DailyBuild/odin32ftp.cmd +++ b/tools/DailyBuild/odin32ftp.cmd @@ -1,232 +1,232 @@ -/* $Id: odin32ftp.cmd,v 1.3 2002-06-26 22:10:45 bird Exp $ - * - * Old FTP routines using only RexxFTP. - * - * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ -/*Trace 'A'*/ - -/* get build settings */ -sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); -sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); -if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end - - -rc = RxFuncAdd('FtpLoadFuncs','rxFtp','FtpLoadFuncs'); -rc = FtpLoadFuncs(); - -parse arg sLoc - -do i = 1 to 7 - sFile = 'odin32bin-'|| sDate; - sDelete = 'odin32bin-'|| DateSub(sDate, 7); - sFileDbg = sFile || '-debug.zip'; - sDeleteDbg = sDelete || '-debug.zip'; - sFileRel = sFile || '-release.zip'; - sDeleteRel = sDelete || '-release.zip'; - - if (sLoc = '' | sLoc = 'os2') then - do - /* (sFile, sFileRemote, sDelete, sLockFile, sSite); */ - rc = putfunction(sFileDbg, '/daily/'sFileDbg, '/daily/'sDeleteDbg, 'os2-debug', 'ftp.os2.org'); - rc = putfunction(sFileRel, '/daily/'sFileRel, '/daily/'sDeleteRel, 'os2-release', 'ftp.os2.org'); - rc = putfunction('ChangeLog', '/daily/Changelog', '/daily/'sDeleteRel, 'os2-Change', 'ftp.os2.org'); - end - - if (sLoc = '' | sLoc = 'netlabs') then - do - /* (sFile, sFileRemote, sDelete, sLockFile, sSite); */ - rc = putfunction(sFileDbg, '/odinftp/daily/'sFileDbg, '/odinftp/daily/'sDeleteDbg, 'netlabs-debug', 'ftp.netlabs.org'); - rc = putfunction(sFileRel, '/odinftp/daily/'sFileRel, '/odinftp/daily/'sDeleteRel, 'netlabs-release', 'ftp.netlabs.org'); - rc = putfunction('ChangeLog','/odinftp/daily/ChangeLog', '/odinftp/daily/'sDeleteRel,'netlabs-changelog', 'ftp.netlabs.org'); - end -end - -exit(0); - -putfunction: procedure - parse arg sFile, sFileRemote, sDelete, sLockFile, sSite - if stream(sLockFile,'c','query exists') = '' then - do - say '---' - say sFile - say sFileRemote; - say sDelete - say sLockFile - say sSite - - /* get password */ - sPasswdString = GetPassword(sSite); - if (sPasswdString = '') then - do - call failure rc, 'Can''t find userid/password for' sSite'.', -1; - return -1; - end - parse var sPasswdString sUser':'sPasswd; - /* - say sUser - say sPasswd */ - - say sSite':' sFile '-> ' sFileRemote; - rc = FtpSetUser(sSite, sUser, sPasswd); - if (rc = 1) then - do - rc = 0; - if (sType <> 'D') then - rc = FtpDelete(sFileRemote); - rcPut = FtpPut(sFile, sFileRemote, 'Binary'); - if (rcPut <> 0) then - rc = FtpDelete(sFileRemote); - rc = FtpDelete(sDelete) - say sDelete ' - ' rc - rc = FtpLogoff(); - if (rcPut = 0) then - 'echo ok > ' || sLockFile; - else - call failure rc, 'FtpPut failed -' sSite , FTPERRNO; - rc = rcPut; - end - else - do - call failure rc, 'Logon failed -' sSite, FTPERRNO; - if rc = 0 then rc = -1; - end - end - else - rc = 0; - - return 0; - - - - - -failure: procedure -parse arg rc, sText, iftperrno; - say 'rc='rc sText - say 'FTPerrno:'||iftperrno -return; - - - - - -/* - * Reads the password file (passwd) in the script directory to - * get a password and userid for a given site. - * - * Format of the passwd file is: - * - * Lines starting with '#' is ignored. - * - * @param sSite name of the site. - * @returns String on the form ':' if found. - * Empty string if not found. - */ -GetPassword: procedure; - parse upper arg sSiteToFind - parse source sd1 sd2 sScript - sPasswd = filespec('drive', sScript) || filespec('path', sScript)||'\passwd'; - - rc = stream(sPasswd, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - do - say 'failed to open ftp password file - rc='rc; - return ''; - end - - sRet = ''; - do while (lines(sPasswd) > 0) - sLine = strip(linein(sPasswd)); - if (sLine = '' | substr(sLine, 1, 1) = '#') then - iterate; - - parse var sLine sSite' 'sUser' 'sPassword' 'sDummy - sSite = translate(strip(sSite)); - sUser = strip(sUser); - sPassword = strip(sPassword); - if (sSite = '' | sPassword = '' | sUser = '') then - say 'warning! misformed password line!'; - if (sSite = sSiteToFind) then - do - sRet = sUser||':'||sPassword; - leave - end - end - call stream sPasswd, 'c', 'close'; -return sRet; - - -/** - * Finds date seven days ago. - * @returns yyyymmdd date - * @param sDate Date on the yyyymmdd format. - * @param cDays Number of days to subtract. - * @remark Works only for dates between 1000-01-01 and 9999-12-31 - * including the limits. - */ -DateSub: procedure -parse arg sDate, cDays - - /* subtraction loop which updates sDate and cDays for each iteration. */ - do while (cDays > 0) - /* - * Get the day in month of sDate. - * Do a simple subtraction is this is higher than the number of days to subtract. - */ - iDayInMonth = substr(sDate, 7, 2); - if (iDayInMonth > cDays) then - return sDate - cDays; - - /* - * Determin previous month and the number of days in it. - */ - iMonth = substr(sDate, 5, 2); - iYear = substr(sDate, 1, 4); - if (iMonth > 1) then - iPrvMonth = iMonth - 1; - else - iPrvMonth = 12; - cDaysPrvMonth = DateGetDaysInMonth(iYear, iPrvMonth); - - /* - * Update date and days left to subtract. - */ - cDays = cDays - iDayInMonth; - if (iMonth > 1) then - sDate = sDate - iDayInMonth - 100 + cDaysPrvMonth; /* last day of previous month */ - else - sDate = sDate - iDayInMonth - 8869; /* last day of last year */ - end -return sDate; - - -/* - * Gets the number of days in a given month. - * @param iYear the year. - * @param iMonth the month. - */ -DateGetDaysInMonth: procedure - parse arg iYear, iMonth - - select - when (iMonth = 4 | iMonth = 6 | iMonth = 9 | iMonth = 11) then - cDays = 30; - - when (iMonth = 2) then - do - if ((iYear // 4) = 0) & (((iYear // 400) <> 0) | ((iYear // 2000) = 0)) then - cDays = 29; - else - cDays = 28; - end - - otherwise - cDays = 31; - end /* select */ -return cDays; - - +/* $Id: odin32ftp.cmd,v 1.3 2002-06-26 22:10:45 bird Exp $ + * + * Old FTP routines using only RexxFTP. + * + * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ +/*Trace 'A'*/ + +/* get build settings */ +sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); +sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); +if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end + + +rc = RxFuncAdd('FtpLoadFuncs','rxFtp','FtpLoadFuncs'); +rc = FtpLoadFuncs(); + +parse arg sLoc + +do i = 1 to 7 + sFile = 'odin32bin-'|| sDate; + sDelete = 'odin32bin-'|| DateSub(sDate, 7); + sFileDbg = sFile || '-debug.zip'; + sDeleteDbg = sDelete || '-debug.zip'; + sFileRel = sFile || '-release.zip'; + sDeleteRel = sDelete || '-release.zip'; + + if (sLoc = '' | sLoc = 'os2') then + do + /* (sFile, sFileRemote, sDelete, sLockFile, sSite); */ + rc = putfunction(sFileDbg, '/daily/'sFileDbg, '/daily/'sDeleteDbg, 'os2-debug', 'ftp.os2.org'); + rc = putfunction(sFileRel, '/daily/'sFileRel, '/daily/'sDeleteRel, 'os2-release', 'ftp.os2.org'); + rc = putfunction('ChangeLog', '/daily/Changelog', '/daily/'sDeleteRel, 'os2-Change', 'ftp.os2.org'); + end + + if (sLoc = '' | sLoc = 'netlabs') then + do + /* (sFile, sFileRemote, sDelete, sLockFile, sSite); */ + rc = putfunction(sFileDbg, '/odinftp/daily/'sFileDbg, '/odinftp/daily/'sDeleteDbg, 'netlabs-debug', 'ftp.netlabs.org'); + rc = putfunction(sFileRel, '/odinftp/daily/'sFileRel, '/odinftp/daily/'sDeleteRel, 'netlabs-release', 'ftp.netlabs.org'); + rc = putfunction('ChangeLog','/odinftp/daily/ChangeLog', '/odinftp/daily/'sDeleteRel,'netlabs-changelog', 'ftp.netlabs.org'); + end +end + +exit(0); + +putfunction: procedure + parse arg sFile, sFileRemote, sDelete, sLockFile, sSite + if stream(sLockFile,'c','query exists') = '' then + do + say '---' + say sFile + say sFileRemote; + say sDelete + say sLockFile + say sSite + + /* get password */ + sPasswdString = GetPassword(sSite); + if (sPasswdString = '') then + do + call failure rc, 'Can''t find userid/password for' sSite'.', -1; + return -1; + end + parse var sPasswdString sUser':'sPasswd; + /* + say sUser + say sPasswd */ + + say sSite':' sFile '-> ' sFileRemote; + rc = FtpSetUser(sSite, sUser, sPasswd); + if (rc = 1) then + do + rc = 0; + if (sType <> 'D') then + rc = FtpDelete(sFileRemote); + rcPut = FtpPut(sFile, sFileRemote, 'Binary'); + if (rcPut <> 0) then + rc = FtpDelete(sFileRemote); + rc = FtpDelete(sDelete) + say sDelete ' - ' rc + rc = FtpLogoff(); + if (rcPut = 0) then + 'echo ok > ' || sLockFile; + else + call failure rc, 'FtpPut failed -' sSite , FTPERRNO; + rc = rcPut; + end + else + do + call failure rc, 'Logon failed -' sSite, FTPERRNO; + if rc = 0 then rc = -1; + end + end + else + rc = 0; + + return 0; + + + + + +failure: procedure +parse arg rc, sText, iftperrno; + say 'rc='rc sText + say 'FTPerrno:'||iftperrno +return; + + + + + +/* + * Reads the password file (passwd) in the script directory to + * get a password and userid for a given site. + * + * Format of the passwd file is: + * + * Lines starting with '#' is ignored. + * + * @param sSite name of the site. + * @returns String on the form ':' if found. + * Empty string if not found. + */ +GetPassword: procedure; + parse upper arg sSiteToFind + parse source sd1 sd2 sScript + sPasswd = filespec('drive', sScript) || filespec('path', sScript)||'\passwd'; + + rc = stream(sPasswd, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + do + say 'failed to open ftp password file - rc='rc; + return ''; + end + + sRet = ''; + do while (lines(sPasswd) > 0) + sLine = strip(linein(sPasswd)); + if (sLine = '' | substr(sLine, 1, 1) = '#') then + iterate; + + parse var sLine sSite' 'sUser' 'sPassword' 'sDummy + sSite = translate(strip(sSite)); + sUser = strip(sUser); + sPassword = strip(sPassword); + if (sSite = '' | sPassword = '' | sUser = '') then + say 'warning! misformed password line!'; + if (sSite = sSiteToFind) then + do + sRet = sUser||':'||sPassword; + leave + end + end + call stream sPasswd, 'c', 'close'; +return sRet; + + +/** + * Finds date seven days ago. + * @returns yyyymmdd date + * @param sDate Date on the yyyymmdd format. + * @param cDays Number of days to subtract. + * @remark Works only for dates between 1000-01-01 and 9999-12-31 + * including the limits. + */ +DateSub: procedure +parse arg sDate, cDays + + /* subtraction loop which updates sDate and cDays for each iteration. */ + do while (cDays > 0) + /* + * Get the day in month of sDate. + * Do a simple subtraction is this is higher than the number of days to subtract. + */ + iDayInMonth = substr(sDate, 7, 2); + if (iDayInMonth > cDays) then + return sDate - cDays; + + /* + * Determin previous month and the number of days in it. + */ + iMonth = substr(sDate, 5, 2); + iYear = substr(sDate, 1, 4); + if (iMonth > 1) then + iPrvMonth = iMonth - 1; + else + iPrvMonth = 12; + cDaysPrvMonth = DateGetDaysInMonth(iYear, iPrvMonth); + + /* + * Update date and days left to subtract. + */ + cDays = cDays - iDayInMonth; + if (iMonth > 1) then + sDate = sDate - iDayInMonth - 100 + cDaysPrvMonth; /* last day of previous month */ + else + sDate = sDate - iDayInMonth - 8869; /* last day of last year */ + end +return sDate; + + +/* + * Gets the number of days in a given month. + * @param iYear the year. + * @param iMonth the month. + */ +DateGetDaysInMonth: procedure + parse arg iYear, iMonth + + select + when (iMonth = 4 | iMonth = 6 | iMonth = 9 | iMonth = 11) then + cDays = 30; + + when (iMonth = 2) then + do + if ((iYear // 4) = 0) & (((iYear // 400) <> 0) | ((iYear // 2000) = 0)) then + cDays = 29; + else + cDays = 28; + end + + otherwise + cDays = 31; + end /* select */ +return cDays; + + diff --git a/tools/DailyBuild/odin32ftp2.cmd b/tools/DailyBuild/odin32ftp2.cmd index f0ea724..048aceb 100644 --- a/tools/DailyBuild/odin32ftp2.cmd +++ b/tools/DailyBuild/odin32ftp2.cmd @@ -1,460 +1,460 @@ -/* $Id: odin32ftp2.cmd,v 1.21 2003-04-14 22:08:04 bird Exp $ - * - * Uploads the relase and debug builds to the FTP sites. - * - * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ -/*Trace 'A'*/ - -/* get build settings */ -sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); -sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); -if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end - - -rc = RxFuncAdd('FtpLoadFuncs','rxFtp','FtpLoadFuncs'); -rc = FtpLoadFuncs(); - -parse arg sLoc - -/* - * Determin files to upload and files to delete. - */ -if (sType = 'W') then -do /* weekly .wpi build */ - asUploads.0 = 3; - asUploads.1 = 'ChangeLog'; - asUploads.2 = 'odin32bin-'sDate'-release.wpi'; - asUploads.3 = 'odin32bin-'sDate'-debug.wpi'; - sDirectory = 'weekly'; -end -else -do /* daily .zip build */ - asUploads.0 = 3; - asUploads.1 = 'ChangeLog'; - asUploads.2 = 'odin32bin-'sDate'-release.zip'; - asUploads.3 = 'odin32bin-'sDate'-debug.zip'; - sDirectory = 'daily'; -end - -asDelete.0 = 25; -do i = 1 to 12 - j = i * 2; - asDelete.j = 'odin32bin-'DateSub(sDate, 31+i)'-release.zip'; - j = j + 1; - asDelete.j = 'odin32bin-'DateSub(sDate, 31+i)'-debug.zip'; -end - - -/* - * Execution loop. - */ -do i = 1 to 5 /* (Retries 5 times) */ - /* - * Put files to SourceForge. - */ - /* - rc = cleanSF(); - do j = 1 to asUploads.0 - rc = putSF(asUploads.j, 'SF-'||asUploads.j); - end - */ - - /* - * Forwards files from sourceforge(t) to os2.ftp.org - */ - /* - if (sLoc = '' | sLoc = 'os2') then - do - rc = cleanFtp('os2-delete', '/daily', 'www.os2.org'); - do j = 1 to asUploads.0 - rc = putFtp(asUploads.j, 'os2-'||asUploads.j, '/'||sDirectory, 'www.os2.org'); - /*rc = putRexxFtp(asUploads.j, 'os2-'||asUploads.j, '/'||sDirectory, 'www.os2.org');*/ - /*rc = forwardSF(asUploads.j, 'os2-'||asUploads.j, '/'||sDirectory, 'www.os2.org');*/ - end - end - */ - - /* - * Upload files to netlabs. - */ - if (sLoc = '' | sLoc = 'netlabs') then - do - rc = cleanFtp('netlabs-delete', '/daily', 'ftp.netlabs.org'); - do j = 1 to asUploads.0 - rc = putFtp(asUploads.j, 'netlabs-'||asUploads.j, '/'||sDirectory, 'ftp.netlabs.org'); - /*rc = putRexxFtp(asUploads.j, 'netlabs-'||asUploads.j, '/'||sDirectory, 'ftp.netlabs.org');*/ - /*rc = forwardSF(asUploads.j, 'netlabs-'||asUploads.j, '/'||sDirectory, 'ftp.netlabs.org');*/ - end - end -end - -exit(0); - - -/* - * Deletes all the files in /pub/kTaskMgr/daily. - */ -cleanSF: procedure - - sLockFile = 'SF-delete'; - if (stream(sLockFile,'c','query exists') = '') then - do - sSFDir = '/home/groups/ftp/pub/ktaskmgr/daily/'; - 'ssh -f -n -l stknut kTaskMgr.sourceforge.net rm -f' sSFDir||'*'; - if (rc <> 0) then - do - say 'rm -f <>/* failed. rc='rc; - return rc; - end - 'echo ok >' sLockFile - end -return 0; - - - -/* - * Upload a file to source forge - */ -putSF: procedure - parse arg sFile, sLockFile - - sSFDir = '/home/groups/ftp/pub/ktaskmgr/daily/'; - - if (stream(sLockFile,'c','query exists') = '') then - do - 'ssh -f -n -l stknut kTaskMgr.sourceforge.net rm -f' sSFDir||sFile; - 'scp' sFile 'stknut@kTaskMgr.sourceforge.net:'||sSFDir||sFile; - if (rc <> 0) then - do - say 'scp' sFile 'failed. rc='rc; - return rc; - end - 'echo ok >' sLockFile - end -return 0; - - - -/* - * Forward file from SourceForge to ftp site. - */ -forwardSF: procedure - parse arg sFile, sLockFile, sRemoteDir, sSite - - sSFDir = '/home/groups/ftp/pub/ktaskmgr/daily/'; - - if (stream(sLockFile,'c','query exists') = '') then - do - /* get password */ - sPasswdString = GetPassword(sSite); - if (sPasswdString = '') then - do - call failure rc, 'Can''t find userid/password for' sSite'.', -1; - return -1; - end - parse var sPasswdString sUser':'sPasswd; - - /* invoke forward process on SourceForge(t). */ - 'cls' - say 'ssh -l stknut kTaskMgr.sourceforge.net upload' sUser sPasswd sSite sRemoteDir sFile; - 'ssh -l stknut kTaskMgr.sourceforge.net ./upload' sUser sPasswd sSite sRemoteDir sFile; - if (rc <> 0) then - do - say 'ssh failed with rc='rc; - return rc; - end - 'echo ok >' sLockFile; - end -return 0; - - - -/* - * Puts a file to a ftp site using ncftpput from ncftp v3.0 beta. - */ -putFtp: procedure - parse arg sFile, sLockFile, sRemoteDir, sSite - - /* check for done-lock */ - if stream(sLockFile,'c','query exists') = '' then - do - say '--- put' sFile '->' sRemoteDir'/'sFile '---'; - - /* get password */ - sPasswdString = GetPassword(sSite); - if (sPasswdString = '') then - do - call failure rc, 'Can''t find userid/password for' sSite'.', -1; - return -1; - end - parse var sPasswdString sUser':'sPasswd; - - /* do the put */ - say 'ncftpput -u' sUser '-p' sPasswd '-z' sSite sRemoteDir sFile; - 'ncftpput -u' sUser '-p' sPasswd '-z -F' sSite sRemoteDir sFile; - if (rc == 0) then - 'echo ok >' sLockFile; - else - do - asErrors.0 = 7; - asErrors.1 = 'Could not connect to remote host.'; - asErrors.2 = 'Could not connect to remote host - timed out.'; - asErrors.3 = 'Transfer failed.'; - asErrors.4 = 'Transfer failed - timed out.'; - asErrors.5 = 'Directory change failed.'; - asErrors.6 = 'Directory change failed - timed out.'; - asErrors.7 = 'Malformed URL.'; - if (rc < asErrors.0) then - say 'ncftpput failed with rc='rc'-' asErrors.rc; - else - say 'ncftpput failed with rc='rc; - end - end - else - rc = 0; -return 0; - - - -/* - * Delete the files in asDelete on a given ftp site. - */ -cleanFtp: procedure expose asDelete.; - parse arg sLockFile, sRemoteDir, sSite - - if (stream(sLockFile,'c','query exists') = '') then - do - say '--- deleting old files at 'sSite' ---' - - /* get password */ - sPasswdString = GetPassword(sSite); - if (sPasswdString = '') then - do - call failure rc, 'Can''t find userid/password for' sSite'.', -1; - return -1; - end - parse var sPasswdString sUser':'sPasswd; - - /* start ftp'ing */ - rc = FtpSetUser(sSite, sUser, sPasswd); - if (rc = 1) then - do - cErrors = 0; - do i = 1 to asDelete.0 - rc = FtpDelete(sRemoteDir||'/'||asDelete.i) - if (rc <> 0 & FTPERRNO = 'FTPCOMMAND') then /* happens when the file don't exists... too. */ - rc = 0; - if (rc <> 0) then - do - call failure rc, 'FtpDelete failed - 'sRemoteDir||'/'||asDelete.i' -' sSite , FTPERRNO; - cErrors = cErrors + 1; - end - end - - if (cErrors = 0) then - 'echo ok >' sLockFile; - else - say 'delete failed with 'cErrors' times.'; - call FtpLogoff; - end - else - do - call failure rc, 'Logon failed -' sSite, FTPERRNO; - if (rc = 0) then rc = -1; - end - end - else - rc = 0; -return rc; - - - -/* - * REXX FTP put function. - */ -putRexxFtp: procedure - parse arg sFile, sLockFile, sRemoteDir, sSite - - /* check for done-lock */ - if stream(sLockFile,'c','query exists') = '' then - do - say '--- put' sFile '->' sRemoteDir'/'sFile '---'; - - /* get password */ - sPasswdString = GetPassword(sSite); - if (sPasswdString = '') then - do - call failure rc, 'Can''t find userid/password for' sSite'.', -1; - return -1; - end - parse var sPasswdString sUser':'sPasswd; - - /* log on the ftp site */ - rc = FtpSetUser(sSite, sUser, sPasswd); - if (rc = 1) then - do - /* put file, delete it if we fail */ - say sSite sUser sPasswd sFile sRemoteDir'/'sFile 'Binary' - rcPut = FtpPut(sFile, sRemoteDir'/'sFile, 'Binary'); - /* - if (rcPut <> 0) then - rc = FtpDelete(sRemoteDir'/'sFile); - */ - - /* Logoff and make lock file. */ - rc = FtpLogoff(); - if (rcPut = 0) then - 'echo ok > ' || sLockFile; - else - call failure rc, 'FtpPut failed -' sSite , FTPERRNO; - rc = rcPut; - end - else - do - call failure rc, 'Logon failed -' sSite, FTPERRNO; - if rc = 0 then rc = -1; - end - end - else - rc = 0; -return 0; - - -/* - * Report error. (non-fatal) - */ -failure: procedure -parse arg rc, sText, iftperrno; - say 'rc='rc sText - say 'FTPerrno:'||iftperrno -return; - - -/* - * Reads the password file (passwd) in the script directory to - * get a password and userid for a given site. - * - * Format of the passwd file is: - * - * Lines starting with '#' is ignored. - * - * @param sSite name of the site. - * @returns String on the form ':' if found. - * Empty string if not found. - */ -GetPassword: procedure; - parse upper arg sSiteToFind - parse source sd1 sd2 sScript - sPasswd = filespec('drive', sScript) || filespec('path', sScript)||'\passwd'; - - rc = stream(sPasswd, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - do - say 'failed to open ftp password file - rc='rc; - return ''; - end - - sRet = ''; - do while (lines(sPasswd) > 0) - sLine = strip(linein(sPasswd)); - if (sLine = '' | substr(sLine, 1, 1) = '#') then - iterate; - - parse var sLine sSite' 'sUser' 'sPassword' 'sDummy - sSite = translate(strip(sSite)); - sUser = strip(sUser); - sPassword = strip(sPassword); - if (sSite = '' | sPassword = '' | sUser = '') then - say 'warning! misformed password line!'; - if (sSite = sSiteToFind) then - do - sRet = sUser||':'||sPassword; - leave - end - end - call stream sPasswd, 'c', 'close'; -return sRet; - - -testdatesub: procedure - sDate='20010131'; - - do i = 1 to 365*2+1 - say sDate '-' i '=' DateSub(sDate, i); - end -exit; - - -/** - * Finds date seven days ago. - * @returns yyyymmdd date - * @param sDate Date on the yyyymmdd format. - * @param cDays Number of days to subtract. - * @remark Works only for dates between 1000-01-01 and 9999-12-31 - * including the limits. - */ -DateSub: procedure -parse arg sDate, cDays - - /* subtraction loop which updates sDate and cDays for each iteration. */ - do while (cDays > 0) - /* - * Get the day in month of sDate. - * Do a simple subtraction is this is higher than the number of days to subtract. - */ - iDayInMonth = substr(sDate, 7, 2); - if (iDayInMonth > cDays) then - return sDate - cDays; - - /* - * Determin previous month and the number of days in it. - */ - iMonth = substr(sDate, 5, 2); - iYear = substr(sDate, 1, 4); - if (iMonth > 1) then - iPrvMonth = iMonth - 1; - else - iPrvMonth = 12; - cDaysPrvMonth = DateGetDaysInMonth(iYear, iPrvMonth); - - /* - * Update date and days left to subtract. - */ - cDays = cDays - iDayInMonth; - if (iMonth > 1) then - sDate = sDate - iDayInMonth - 100 + cDaysPrvMonth; /* last day of previous month */ - else - sDate = sDate - iDayInMonth - 8869; /* last day of last year */ - end -return sDate; - - -/* - * Gets the number of days in a given month. - * @param iYear the year. - * @param iMonth the month. - */ -DateGetDaysInMonth: procedure - parse arg iYear, iMonth - - select - when (iMonth = 4 | iMonth = 6 | iMonth = 9 | iMonth = 11) then - cDays = 30; - - when (iMonth = 2) then - do - if ((iYear // 4) = 0) & (((iYear // 400) <> 0) | ((iYear // 2000) = 0)) then - cDays = 29; - else - cDays = 28; - end - - otherwise - cDays = 31; - end /* select */ -return cDays; - +/* $Id: odin32ftp2.cmd,v 1.21 2003-04-14 22:08:04 bird Exp $ + * + * Uploads the relase and debug builds to the FTP sites. + * + * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ +/*Trace 'A'*/ + +/* get build settings */ +sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); +sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); +if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end + + +rc = RxFuncAdd('FtpLoadFuncs','rxFtp','FtpLoadFuncs'); +rc = FtpLoadFuncs(); + +parse arg sLoc + +/* + * Determin files to upload and files to delete. + */ +if (sType = 'W') then +do /* weekly .wpi build */ + asUploads.0 = 3; + asUploads.1 = 'ChangeLog'; + asUploads.2 = 'odin32bin-'sDate'-release.wpi'; + asUploads.3 = 'odin32bin-'sDate'-debug.wpi'; + sDirectory = 'weekly'; +end +else +do /* daily .zip build */ + asUploads.0 = 3; + asUploads.1 = 'ChangeLog'; + asUploads.2 = 'odin32bin-'sDate'-release.zip'; + asUploads.3 = 'odin32bin-'sDate'-debug.zip'; + sDirectory = 'daily'; +end + +asDelete.0 = 25; +do i = 1 to 12 + j = i * 2; + asDelete.j = 'odin32bin-'DateSub(sDate, 31+i)'-release.zip'; + j = j + 1; + asDelete.j = 'odin32bin-'DateSub(sDate, 31+i)'-debug.zip'; +end + + +/* + * Execution loop. + */ +do i = 1 to 5 /* (Retries 5 times) */ + /* + * Put files to SourceForge. + */ + /* + rc = cleanSF(); + do j = 1 to asUploads.0 + rc = putSF(asUploads.j, 'SF-'||asUploads.j); + end + */ + + /* + * Forwards files from sourceforge(t) to os2.ftp.org + */ + /* + if (sLoc = '' | sLoc = 'os2') then + do + rc = cleanFtp('os2-delete', '/daily', 'www.os2.org'); + do j = 1 to asUploads.0 + rc = putFtp(asUploads.j, 'os2-'||asUploads.j, '/'||sDirectory, 'www.os2.org'); + /*rc = putRexxFtp(asUploads.j, 'os2-'||asUploads.j, '/'||sDirectory, 'www.os2.org');*/ + /*rc = forwardSF(asUploads.j, 'os2-'||asUploads.j, '/'||sDirectory, 'www.os2.org');*/ + end + end + */ + + /* + * Upload files to netlabs. + */ + if (sLoc = '' | sLoc = 'netlabs') then + do + rc = cleanFtp('netlabs-delete', '/daily', 'ftp.netlabs.org'); + do j = 1 to asUploads.0 + rc = putFtp(asUploads.j, 'netlabs-'||asUploads.j, '/'||sDirectory, 'ftp.netlabs.org'); + /*rc = putRexxFtp(asUploads.j, 'netlabs-'||asUploads.j, '/'||sDirectory, 'ftp.netlabs.org');*/ + /*rc = forwardSF(asUploads.j, 'netlabs-'||asUploads.j, '/'||sDirectory, 'ftp.netlabs.org');*/ + end + end +end + +exit(0); + + +/* + * Deletes all the files in /pub/kTaskMgr/daily. + */ +cleanSF: procedure + + sLockFile = 'SF-delete'; + if (stream(sLockFile,'c','query exists') = '') then + do + sSFDir = '/home/groups/ftp/pub/ktaskmgr/daily/'; + 'ssh -f -n -l stknut kTaskMgr.sourceforge.net rm -f' sSFDir||'*'; + if (rc <> 0) then + do + say 'rm -f <>/* failed. rc='rc; + return rc; + end + 'echo ok >' sLockFile + end +return 0; + + + +/* + * Upload a file to source forge + */ +putSF: procedure + parse arg sFile, sLockFile + + sSFDir = '/home/groups/ftp/pub/ktaskmgr/daily/'; + + if (stream(sLockFile,'c','query exists') = '') then + do + 'ssh -f -n -l stknut kTaskMgr.sourceforge.net rm -f' sSFDir||sFile; + 'scp' sFile 'stknut@kTaskMgr.sourceforge.net:'||sSFDir||sFile; + if (rc <> 0) then + do + say 'scp' sFile 'failed. rc='rc; + return rc; + end + 'echo ok >' sLockFile + end +return 0; + + + +/* + * Forward file from SourceForge to ftp site. + */ +forwardSF: procedure + parse arg sFile, sLockFile, sRemoteDir, sSite + + sSFDir = '/home/groups/ftp/pub/ktaskmgr/daily/'; + + if (stream(sLockFile,'c','query exists') = '') then + do + /* get password */ + sPasswdString = GetPassword(sSite); + if (sPasswdString = '') then + do + call failure rc, 'Can''t find userid/password for' sSite'.', -1; + return -1; + end + parse var sPasswdString sUser':'sPasswd; + + /* invoke forward process on SourceForge(t). */ + 'cls' + say 'ssh -l stknut kTaskMgr.sourceforge.net upload' sUser sPasswd sSite sRemoteDir sFile; + 'ssh -l stknut kTaskMgr.sourceforge.net ./upload' sUser sPasswd sSite sRemoteDir sFile; + if (rc <> 0) then + do + say 'ssh failed with rc='rc; + return rc; + end + 'echo ok >' sLockFile; + end +return 0; + + + +/* + * Puts a file to a ftp site using ncftpput from ncftp v3.0 beta. + */ +putFtp: procedure + parse arg sFile, sLockFile, sRemoteDir, sSite + + /* check for done-lock */ + if stream(sLockFile,'c','query exists') = '' then + do + say '--- put' sFile '->' sRemoteDir'/'sFile '---'; + + /* get password */ + sPasswdString = GetPassword(sSite); + if (sPasswdString = '') then + do + call failure rc, 'Can''t find userid/password for' sSite'.', -1; + return -1; + end + parse var sPasswdString sUser':'sPasswd; + + /* do the put */ + say 'ncftpput -u' sUser '-p' sPasswd '-z' sSite sRemoteDir sFile; + 'ncftpput -u' sUser '-p' sPasswd '-z -F' sSite sRemoteDir sFile; + if (rc == 0) then + 'echo ok >' sLockFile; + else + do + asErrors.0 = 7; + asErrors.1 = 'Could not connect to remote host.'; + asErrors.2 = 'Could not connect to remote host - timed out.'; + asErrors.3 = 'Transfer failed.'; + asErrors.4 = 'Transfer failed - timed out.'; + asErrors.5 = 'Directory change failed.'; + asErrors.6 = 'Directory change failed - timed out.'; + asErrors.7 = 'Malformed URL.'; + if (rc < asErrors.0) then + say 'ncftpput failed with rc='rc'-' asErrors.rc; + else + say 'ncftpput failed with rc='rc; + end + end + else + rc = 0; +return 0; + + + +/* + * Delete the files in asDelete on a given ftp site. + */ +cleanFtp: procedure expose asDelete.; + parse arg sLockFile, sRemoteDir, sSite + + if (stream(sLockFile,'c','query exists') = '') then + do + say '--- deleting old files at 'sSite' ---' + + /* get password */ + sPasswdString = GetPassword(sSite); + if (sPasswdString = '') then + do + call failure rc, 'Can''t find userid/password for' sSite'.', -1; + return -1; + end + parse var sPasswdString sUser':'sPasswd; + + /* start ftp'ing */ + rc = FtpSetUser(sSite, sUser, sPasswd); + if (rc = 1) then + do + cErrors = 0; + do i = 1 to asDelete.0 + rc = FtpDelete(sRemoteDir||'/'||asDelete.i) + if (rc <> 0 & FTPERRNO = 'FTPCOMMAND') then /* happens when the file don't exists... too. */ + rc = 0; + if (rc <> 0) then + do + call failure rc, 'FtpDelete failed - 'sRemoteDir||'/'||asDelete.i' -' sSite , FTPERRNO; + cErrors = cErrors + 1; + end + end + + if (cErrors = 0) then + 'echo ok >' sLockFile; + else + say 'delete failed with 'cErrors' times.'; + call FtpLogoff; + end + else + do + call failure rc, 'Logon failed -' sSite, FTPERRNO; + if (rc = 0) then rc = -1; + end + end + else + rc = 0; +return rc; + + + +/* + * REXX FTP put function. + */ +putRexxFtp: procedure + parse arg sFile, sLockFile, sRemoteDir, sSite + + /* check for done-lock */ + if stream(sLockFile,'c','query exists') = '' then + do + say '--- put' sFile '->' sRemoteDir'/'sFile '---'; + + /* get password */ + sPasswdString = GetPassword(sSite); + if (sPasswdString = '') then + do + call failure rc, 'Can''t find userid/password for' sSite'.', -1; + return -1; + end + parse var sPasswdString sUser':'sPasswd; + + /* log on the ftp site */ + rc = FtpSetUser(sSite, sUser, sPasswd); + if (rc = 1) then + do + /* put file, delete it if we fail */ + say sSite sUser sPasswd sFile sRemoteDir'/'sFile 'Binary' + rcPut = FtpPut(sFile, sRemoteDir'/'sFile, 'Binary'); + /* + if (rcPut <> 0) then + rc = FtpDelete(sRemoteDir'/'sFile); + */ + + /* Logoff and make lock file. */ + rc = FtpLogoff(); + if (rcPut = 0) then + 'echo ok > ' || sLockFile; + else + call failure rc, 'FtpPut failed -' sSite , FTPERRNO; + rc = rcPut; + end + else + do + call failure rc, 'Logon failed -' sSite, FTPERRNO; + if rc = 0 then rc = -1; + end + end + else + rc = 0; +return 0; + + +/* + * Report error. (non-fatal) + */ +failure: procedure +parse arg rc, sText, iftperrno; + say 'rc='rc sText + say 'FTPerrno:'||iftperrno +return; + + +/* + * Reads the password file (passwd) in the script directory to + * get a password and userid for a given site. + * + * Format of the passwd file is: + * + * Lines starting with '#' is ignored. + * + * @param sSite name of the site. + * @returns String on the form ':' if found. + * Empty string if not found. + */ +GetPassword: procedure; + parse upper arg sSiteToFind + parse source sd1 sd2 sScript + sPasswd = filespec('drive', sScript) || filespec('path', sScript)||'\passwd'; + + rc = stream(sPasswd, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + do + say 'failed to open ftp password file - rc='rc; + return ''; + end + + sRet = ''; + do while (lines(sPasswd) > 0) + sLine = strip(linein(sPasswd)); + if (sLine = '' | substr(sLine, 1, 1) = '#') then + iterate; + + parse var sLine sSite' 'sUser' 'sPassword' 'sDummy + sSite = translate(strip(sSite)); + sUser = strip(sUser); + sPassword = strip(sPassword); + if (sSite = '' | sPassword = '' | sUser = '') then + say 'warning! misformed password line!'; + if (sSite = sSiteToFind) then + do + sRet = sUser||':'||sPassword; + leave + end + end + call stream sPasswd, 'c', 'close'; +return sRet; + + +testdatesub: procedure + sDate='20010131'; + + do i = 1 to 365*2+1 + say sDate '-' i '=' DateSub(sDate, i); + end +exit; + + +/** + * Finds date seven days ago. + * @returns yyyymmdd date + * @param sDate Date on the yyyymmdd format. + * @param cDays Number of days to subtract. + * @remark Works only for dates between 1000-01-01 and 9999-12-31 + * including the limits. + */ +DateSub: procedure +parse arg sDate, cDays + + /* subtraction loop which updates sDate and cDays for each iteration. */ + do while (cDays > 0) + /* + * Get the day in month of sDate. + * Do a simple subtraction is this is higher than the number of days to subtract. + */ + iDayInMonth = substr(sDate, 7, 2); + if (iDayInMonth > cDays) then + return sDate - cDays; + + /* + * Determin previous month and the number of days in it. + */ + iMonth = substr(sDate, 5, 2); + iYear = substr(sDate, 1, 4); + if (iMonth > 1) then + iPrvMonth = iMonth - 1; + else + iPrvMonth = 12; + cDaysPrvMonth = DateGetDaysInMonth(iYear, iPrvMonth); + + /* + * Update date and days left to subtract. + */ + cDays = cDays - iDayInMonth; + if (iMonth > 1) then + sDate = sDate - iDayInMonth - 100 + cDaysPrvMonth; /* last day of previous month */ + else + sDate = sDate - iDayInMonth - 8869; /* last day of last year */ + end +return sDate; + + +/* + * Gets the number of days in a given month. + * @param iYear the year. + * @param iMonth the month. + */ +DateGetDaysInMonth: procedure + parse arg iYear, iMonth + + select + when (iMonth = 4 | iMonth = 6 | iMonth = 9 | iMonth = 11) then + cDays = 30; + + when (iMonth = 2) then + do + if ((iYear // 4) = 0) & (((iYear // 400) <> 0) | ((iYear // 2000) = 0)) then + cDays = 29; + else + cDays = 28; + end + + otherwise + cDays = 31; + end /* select */ +return cDays; + diff --git a/tools/DailyBuild/odin32get.cmd b/tools/DailyBuild/odin32get.cmd index 191a32c..1974363 100644 --- a/tools/DailyBuild/odin32get.cmd +++ b/tools/DailyBuild/odin32get.cmd @@ -1,32 +1,32 @@ -/* $Id: odin32get.cmd,v 1.6 2003-06-19 20:29:42 bird Exp $ - * - * Gets the CVS tree from netlabs. - * - * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - - /* get build settings */ - /* - sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); - sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); - if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end - */ - - sDrive = filespec('drive', directory()); - 'cache386 /LAZY:'sDrive'OFF'; - 'cvs checkout .' - iRc = rc; - 'cache386 /LAZY:'sDrive'ON'; - if (iRc <> 0) then call failure iRc, 'CVS checkout . failed'; - 'copy ..\scripts\bin\buildenv.cmd.paths tools\bin\buildenv.cmd.paths' - exit(0); - - -failure: procedure -parse arg rc, sText; - say 'rc='rc sText - exit(rc); - +/* $Id: odin32get.cmd,v 1.6 2003-06-19 20:29:42 bird Exp $ + * + * Gets the CVS tree from netlabs. + * + * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + + /* get build settings */ + /* + sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); + sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); + if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end + */ + + sDrive = filespec('drive', directory()); + 'cache386 /LAZY:'sDrive'OFF'; + 'cvs checkout .' + iRc = rc; + 'cache386 /LAZY:'sDrive'ON'; + if (iRc <> 0) then call failure iRc, 'CVS checkout . failed'; + 'copy ..\scripts\bin\buildenv.cmd.paths tools\bin\buildenv.cmd.paths' + exit(0); + + +failure: procedure +parse arg rc, sText; + say 'rc='rc sText + exit(rc); + diff --git a/tools/DailyBuild/odin32pack.cmd b/tools/DailyBuild/odin32pack.cmd index a9d111c..466cd7f 100644 --- a/tools/DailyBuild/odin32pack.cmd +++ b/tools/DailyBuild/odin32pack.cmd @@ -1,217 +1,217 @@ -/* $Id: odin32pack.cmd,v 1.25 2003-04-15 00:34:35 bird Exp $ - * - * Make the two zip files. - * - * NOTE! This requires 4OS/2 for the DEL commands. - * - * Copyright (c) 1999-2000 knut st. osmundsen (knut.stange.osmundsen@mynd.no) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - sStartDir = directory(); - sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); - sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); - if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end - - if (sType = 'W') then - sTypeOdinCMD = '-Weekly'; - else - sTypeOdinCMD = '-Daily'; - - - /* - * Make .WPI files. - */ - call ChDir 'tools\install'; - 'call odin.cmd 'sTypeOdinCMD' debug' - if (RC <> 0) then call failure rc, 'odin.cmd debug failed.'; - 'call odin.cmd 'sTypeOdinCMD' release' - if (RC <> 0) then call failure rc, 'odin.cmd release failed.'; - 'move *.wpi' sStartDir; - if (RC <> 0) then call failure rc, 'failed to move the *.wpi ->' sStartDir; - call ChDir '..\..'; - - /* - * Make .ZIP files. - */ - call packdir 'bin\debug', 'debug' - /*call packdir3dx 'bin\debug\glide', 'glide-debug' */ - call packdir 'bin\release', 'release' - /*call packdir3dx 'bin\release\glide', 'glide-release'*/ - - /* - * Make copy. - */ - /* - if (sType = 'W') then - 'copy *.wpi e:\DailyBuildArchive\' - else - 'copy *.zip e:\DailyBuildArchive\' - */ - - /* return successfully */ - exit(0); - - -packdir: procedure expose sStartDir sDate sType; -parse arg sDir, sBldType; - - sZipFile = directory() || '\odin32bin-' || sDate || '-' || sBldType || '.zip'; - - /* - * Change into the directory we're to pack and do some fixups - */ - sRoot = directory(); - call ChDir sDir - 'del /Q /Y /Z *.cmd > nul 2>&1' - 'del /Q /Y /Z /X CVS > nul 2>&1' - 'del /Q /Y /Z /X .\glide\CVS > nul 2>&1' - 'del /Q /Y /Z /X .\glide\Voodoo1\CVS > nul 2>&1' - 'del /Q /Y /Z /X .\glide\Voodoo2\CVS > nul 2>&1' - 'del /Q /Y /Z /X .\Voodoo1\CVS > nul 2>&1' - 'del /Q /Y /Z /X .\Voodoo1 > nul 2>&1' - 'del /Q /Y /Z /X .\Voodoo2\CVS > nul 2>&1' - 'del /Q /Y /Z /X .\Voodoo2 > nul 2>&1' - 'rmdir .\Voodoo2 > nul 2>&1' - 'rmdir .\Voodoo1 > nul 2>&1' - - /* - * Create a pack directory in /bin and go into it. - * (Don't test on return from mkdir while the directory might exist.) - */ - 'mkdir ..\pack' - call ChDir '..\pack' - 'del /Q /Y /Z *' /* Perform some cleanup */ - - /* Copy root files into the pack directory. */ - call copy sRoot'\LICENSE.txt'; - call copy sRoot'\WGSS50.lic'; - call copy sRoot'\ChangeLog'; - call copy sRoot'\doc\Readme.txt'; - call copy sRoot'\doc\odin.ini.txt' - call copy sRoot'\doc\Logging.txt'; - call copy sRoot'\doc\ReportingBugs.txt'; - call copy sRoot'\doc\ChangeLog-2001'; - call copy sRoot'\doc\ChangeLog-2000'; - call copy sRoot'\doc\ChangeLog-1999'; - - /* - * Move (=rename) the /bin/ dir into /pack/system32 - * and pack it. - */ - 'ren' sRoot'\'sDir '.\system32' - if (RC <> 0) then call failure rc, 'renaming' sDir'->system32 failed'; - 'if exist .\system32\glide ren .\system32\glide ..\glide_tmp' - /* - if (RC <> 0) then - do - rc2 = rc; - call backout sDir, sBldType, sRoot; - call failure rc2, 'renaming system32\glide -> ..\glide_tmp failed'; - end - */ - - call copy sRoot'\bin\wgss50.dll', 'system32\wgss50.dll'; - /*call copy sRoot'\bin\odin.ini', 'system32\Odin.ini';*/ - if (pos('debug', sBldType) > 0) then - do - call copy sRoot'\bin\release\odincrt.dll', 'system32\odincrt.dll' - call copy sRoot'\bin\release\odincrt.sym', 'system32\odincrt.sym' - end - - say 'zip -9 -R' sZipFile '* -xCVS'; - 'zip -9 -R' sZipFile '* -xCVS'; - if (RC <> 0) then - do - rc2 = rc; - call backout sDir, sBldType, sRoot; - call failure rc2, 'zip...'; - end - - /* resotre */ - call backout sDir, sBldType, sRoot; - - /* restore directory */ - call directory(sRoot); - return; - -/* backout procedure for packdir */ -backout: procedure; - parse arg sDir, sBldType, sRoot - if (pos('debug', sBldType) > 0) then - do - 'del system32\odincrt.dll' - 'del system32\odincrt.sym' - end - 'ren ..\glide_tmp .\system32\glide' - 'ren .\system32' sRoot'\'sDir - return; - -/* - * Pack the 3dx dlls. - */ -packdir3dx: procedure expose sStartDir sDate sType; -parse arg sDir, sBldType; - sZipFile = directory()||'\odin32bin-' || sDate || '-' || sBldType || '.zip'; - - sRoot = directory(); - call ChDir sDir - say 'zip -9 -R' sZipFile '* -xCVS'; - 'zip -9 -R' sZipFile '* -xCVS'; - if (rc <> 0) then call failure rc, 'zip...'; - - /* restore directory */ - call directory(sRoot); - return; - - -/* - * Changes the directory. - * On error we will call failure. - */ -ChDir: procedure expose sStartDir; - parse arg sDir - - 'cd' sDir - if (rc <> 0) then - do - call failure rc, 'Failed to ChDir into' sDir '(CWD='directory()').' - return rc; - end - return 0; - - -/* - * Copy a file. - * On error we will call failure. - */ -Copy: procedure expose sStartDir - parse arg sSrc, sDst, fNotFatal - - /* if no sDst set default */ - if (sDst = '') then sDst='.'; - if (fNotFatal = '') then fNotFatal = 0; - - 'copy' sSrc sDst - if (rc <> 0 & \fNotFatal) then - do - call failure rc, 'Copying' sSrc 'to' sDst 'failed.' - return rc; - end - return 0; - - -/* - * Complain about a failure and exit the script. - * Note. Uses the global variable sStartDir to restore the current - * directory where the script was started from. - * @param rc Error code to write. (usually RC) - * @param sText Description. - */ -failure: procedure expose sStartDir; -parse arg rc, sText; - say 'rc='rc sText - call directory sStartDir; - exit(rc); - +/* $Id: odin32pack.cmd,v 1.25 2003-04-15 00:34:35 bird Exp $ + * + * Make the two zip files. + * + * NOTE! This requires 4OS/2 for the DEL commands. + * + * Copyright (c) 1999-2000 knut st. osmundsen (knut.stange.osmundsen@mynd.no) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + sStartDir = directory(); + sDate = value('BUILD_DATE',, 'OS2ENVIRONMENT'); + sType = value('BUILD_TYPE',, 'OS2ENVIRONMENT'); + if ((sDate = '') | (sType = '')) then do say 'BUILD_DATE/BUILD_TYPE unset, you didn''t start job.cmd.'; exit(16); end + + if (sType = 'W') then + sTypeOdinCMD = '-Weekly'; + else + sTypeOdinCMD = '-Daily'; + + + /* + * Make .WPI files. + */ + call ChDir 'tools\install'; + 'call odin.cmd 'sTypeOdinCMD' debug' + if (RC <> 0) then call failure rc, 'odin.cmd debug failed.'; + 'call odin.cmd 'sTypeOdinCMD' release' + if (RC <> 0) then call failure rc, 'odin.cmd release failed.'; + 'move *.wpi' sStartDir; + if (RC <> 0) then call failure rc, 'failed to move the *.wpi ->' sStartDir; + call ChDir '..\..'; + + /* + * Make .ZIP files. + */ + call packdir 'bin\debug', 'debug' + /*call packdir3dx 'bin\debug\glide', 'glide-debug' */ + call packdir 'bin\release', 'release' + /*call packdir3dx 'bin\release\glide', 'glide-release'*/ + + /* + * Make copy. + */ + /* + if (sType = 'W') then + 'copy *.wpi e:\DailyBuildArchive\' + else + 'copy *.zip e:\DailyBuildArchive\' + */ + + /* return successfully */ + exit(0); + + +packdir: procedure expose sStartDir sDate sType; +parse arg sDir, sBldType; + + sZipFile = directory() || '\odin32bin-' || sDate || '-' || sBldType || '.zip'; + + /* + * Change into the directory we're to pack and do some fixups + */ + sRoot = directory(); + call ChDir sDir + 'del /Q /Y /Z *.cmd > nul 2>&1' + 'del /Q /Y /Z /X CVS > nul 2>&1' + 'del /Q /Y /Z /X .\glide\CVS > nul 2>&1' + 'del /Q /Y /Z /X .\glide\Voodoo1\CVS > nul 2>&1' + 'del /Q /Y /Z /X .\glide\Voodoo2\CVS > nul 2>&1' + 'del /Q /Y /Z /X .\Voodoo1\CVS > nul 2>&1' + 'del /Q /Y /Z /X .\Voodoo1 > nul 2>&1' + 'del /Q /Y /Z /X .\Voodoo2\CVS > nul 2>&1' + 'del /Q /Y /Z /X .\Voodoo2 > nul 2>&1' + 'rmdir .\Voodoo2 > nul 2>&1' + 'rmdir .\Voodoo1 > nul 2>&1' + + /* + * Create a pack directory in /bin and go into it. + * (Don't test on return from mkdir while the directory might exist.) + */ + 'mkdir ..\pack' + call ChDir '..\pack' + 'del /Q /Y /Z *' /* Perform some cleanup */ + + /* Copy root files into the pack directory. */ + call copy sRoot'\LICENSE.txt'; + call copy sRoot'\WGSS50.lic'; + call copy sRoot'\ChangeLog'; + call copy sRoot'\doc\Readme.txt'; + call copy sRoot'\doc\odin.ini.txt' + call copy sRoot'\doc\Logging.txt'; + call copy sRoot'\doc\ReportingBugs.txt'; + call copy sRoot'\doc\ChangeLog-2001'; + call copy sRoot'\doc\ChangeLog-2000'; + call copy sRoot'\doc\ChangeLog-1999'; + + /* + * Move (=rename) the /bin/ dir into /pack/system32 + * and pack it. + */ + 'ren' sRoot'\'sDir '.\system32' + if (RC <> 0) then call failure rc, 'renaming' sDir'->system32 failed'; + 'if exist .\system32\glide ren .\system32\glide ..\glide_tmp' + /* + if (RC <> 0) then + do + rc2 = rc; + call backout sDir, sBldType, sRoot; + call failure rc2, 'renaming system32\glide -> ..\glide_tmp failed'; + end + */ + + call copy sRoot'\bin\wgss50.dll', 'system32\wgss50.dll'; + /*call copy sRoot'\bin\odin.ini', 'system32\Odin.ini';*/ + if (pos('debug', sBldType) > 0) then + do + call copy sRoot'\bin\release\odincrt.dll', 'system32\odincrt.dll' + call copy sRoot'\bin\release\odincrt.sym', 'system32\odincrt.sym' + end + + say 'zip -9 -R' sZipFile '* -xCVS'; + 'zip -9 -R' sZipFile '* -xCVS'; + if (RC <> 0) then + do + rc2 = rc; + call backout sDir, sBldType, sRoot; + call failure rc2, 'zip...'; + end + + /* resotre */ + call backout sDir, sBldType, sRoot; + + /* restore directory */ + call directory(sRoot); + return; + +/* backout procedure for packdir */ +backout: procedure; + parse arg sDir, sBldType, sRoot + if (pos('debug', sBldType) > 0) then + do + 'del system32\odincrt.dll' + 'del system32\odincrt.sym' + end + 'ren ..\glide_tmp .\system32\glide' + 'ren .\system32' sRoot'\'sDir + return; + +/* + * Pack the 3dx dlls. + */ +packdir3dx: procedure expose sStartDir sDate sType; +parse arg sDir, sBldType; + sZipFile = directory()||'\odin32bin-' || sDate || '-' || sBldType || '.zip'; + + sRoot = directory(); + call ChDir sDir + say 'zip -9 -R' sZipFile '* -xCVS'; + 'zip -9 -R' sZipFile '* -xCVS'; + if (rc <> 0) then call failure rc, 'zip...'; + + /* restore directory */ + call directory(sRoot); + return; + + +/* + * Changes the directory. + * On error we will call failure. + */ +ChDir: procedure expose sStartDir; + parse arg sDir + + 'cd' sDir + if (rc <> 0) then + do + call failure rc, 'Failed to ChDir into' sDir '(CWD='directory()').' + return rc; + end + return 0; + + +/* + * Copy a file. + * On error we will call failure. + */ +Copy: procedure expose sStartDir + parse arg sSrc, sDst, fNotFatal + + /* if no sDst set default */ + if (sDst = '') then sDst='.'; + if (fNotFatal = '') then fNotFatal = 0; + + 'copy' sSrc sDst + if (rc <> 0 & \fNotFatal) then + do + call failure rc, 'Copying' sSrc 'to' sDst 'failed.' + return rc; + end + return 0; + + +/* + * Complain about a failure and exit the script. + * Note. Uses the global variable sStartDir to restore the current + * directory where the script was started from. + * @param rc Error code to write. (usually RC) + * @param sText Description. + */ +failure: procedure expose sStartDir; +parse arg rc, sText; + say 'rc='rc sText + call directory sStartDir; + exit(rc); + diff --git a/tools/Makefile.kmk b/tools/Makefile.kmk index f7684a9..120c7b0 100644 --- a/tools/Makefile.kmk +++ b/tools/Makefile.kmk @@ -1,16 +1,16 @@ -## @file -# Support tools -# - -SUB_DEPTH = .. -include $(KBUILD_PATH)/subheader.kmk - -# -# Include sub-makefiles. -# -include $(PATH_SUB_CURRENT)/common/Makefile.kmk -include $(PATH_SUB_CURRENT)/impdef/Makefile.kmk -include $(PATH_SUB_CURRENT)/wrc/Makefile.kmk -include $(PATH_SUB_CURRENT)/install/Makefile.kmk - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# Support tools +# + +SUB_DEPTH = .. +include $(KBUILD_PATH)/subheader.kmk + +# +# Include sub-makefiles. +# +include $(PATH_SUB_CURRENT)/common/Makefile.kmk +include $(PATH_SUB_CURRENT)/impdef/Makefile.kmk +include $(PATH_SUB_CURRENT)/wrc/Makefile.kmk +include $(PATH_SUB_CURRENT)/install/Makefile.kmk + +include $(FILE_KBUILD_SUB_FOOTER) diff --git a/tools/bin/APIImport.cmd b/tools/bin/APIImport.cmd index 6fd7078..13c1a83 100644 --- a/tools/bin/APIImport.cmd +++ b/tools/bin/APIImport.cmd @@ -1,82 +1,82 @@ -/* $Id: APIImport.cmd,v 1.7 2001-01-26 21:33:13 phaller Exp $ - * - * Helper script which invokes APIImport.exe with the correct .def file. - * - * Copyright (c) 2000 knut st. osmundsen - * - */ - -if RxFuncQuery('SysFileDelete')=1 THEN - call RxFuncAdd 'SysFileDelete', 'RexxUtil', 'SysFileDelete'; - -if RxFuncQuery('SysFileFree')=1 THEN - call RxFuncAdd 'SysFileTree', 'RexxUtil', 'SysFileTree'; - - sDllName = filespec('name', directory()); - - parse source sD1 sD2 sSrc; - - sSrc = filespec('drive', sSrc) || filespec('path', sSrc); - sAPIImport= sSrc||'APIImport.exe -e+ '; - if (sDllName = 'msvcrt') then - do - call MakeTempDeffile sDllName, 'APIImport.def'; - call MakeTempDeffile sDllName||'20', 'APIImport20.def'; - call MakeTempDeffile sDllName||'40', 'APIImport40.def'; - sAPIImport || ' APIImport.def APIImport20.def APIImport40.def'; - end - else - do - if (translate(sDllName) = 'WNETAP32') then - sDllName = 'netapi32'; - else if (translate(sDllName) = 'OPENGL') then - do - 'copy mesa\opengl32.def'; - sDllName = 'opengl32'; - end - - call MakeTempDeffile sDllName, 'APIImport.def'; - sAPIImport || ' APIImport.def'; - end - exit(rc); - - -MakeTempDeffile: procedure; - parse arg sDllName, sTmpName - - call SysFileDelete sTmpName; - sOrgDef = sDllName||'.def'; - rc = stream(sOrgDef, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - do - rc = SysFileTree('*.def', 'asFiles', 'FO'); - if rc = 0 then - do - do i = 1 to asFiles.0 - if translate(substr(asFiles.i, length(asFiles.i) - 7, 7)) <> 'EXP.DEF' then - do - sOrgDef = asFiles.i; - rc = stream(sOrgDef, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - say 'APIImport.cmd: failiure (2) rc='||rc; - else - i = asFiles.0; - end - end - end - else - say 'APIImport.cmd: failiure (1) rc='||rc; - end - rc = stream(sTmpName, 'c', 'open write'); - - do while (lines(sOrgDef) > 0) - sLine = linein(sOrgDef); - if (pos('LIBRARY ', translate(strip(sLine))) = 1 ) then - call lineout sTmpName, 'LIBRARY '||sDllName; - else - call lineout sTmpName, sLine; - end - - rc = stream(sOrgDef, 'c', 'close'); - rc = stream(sTmpName, 'c', 'close'); - return 0; +/* $Id: APIImport.cmd,v 1.7 2001-01-26 21:33:13 phaller Exp $ + * + * Helper script which invokes APIImport.exe with the correct .def file. + * + * Copyright (c) 2000 knut st. osmundsen + * + */ + +if RxFuncQuery('SysFileDelete')=1 THEN + call RxFuncAdd 'SysFileDelete', 'RexxUtil', 'SysFileDelete'; + +if RxFuncQuery('SysFileFree')=1 THEN + call RxFuncAdd 'SysFileTree', 'RexxUtil', 'SysFileTree'; + + sDllName = filespec('name', directory()); + + parse source sD1 sD2 sSrc; + + sSrc = filespec('drive', sSrc) || filespec('path', sSrc); + sAPIImport= sSrc||'APIImport.exe -e+ '; + if (sDllName = 'msvcrt') then + do + call MakeTempDeffile sDllName, 'APIImport.def'; + call MakeTempDeffile sDllName||'20', 'APIImport20.def'; + call MakeTempDeffile sDllName||'40', 'APIImport40.def'; + sAPIImport || ' APIImport.def APIImport20.def APIImport40.def'; + end + else + do + if (translate(sDllName) = 'WNETAP32') then + sDllName = 'netapi32'; + else if (translate(sDllName) = 'OPENGL') then + do + 'copy mesa\opengl32.def'; + sDllName = 'opengl32'; + end + + call MakeTempDeffile sDllName, 'APIImport.def'; + sAPIImport || ' APIImport.def'; + end + exit(rc); + + +MakeTempDeffile: procedure; + parse arg sDllName, sTmpName + + call SysFileDelete sTmpName; + sOrgDef = sDllName||'.def'; + rc = stream(sOrgDef, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + do + rc = SysFileTree('*.def', 'asFiles', 'FO'); + if rc = 0 then + do + do i = 1 to asFiles.0 + if translate(substr(asFiles.i, length(asFiles.i) - 7, 7)) <> 'EXP.DEF' then + do + sOrgDef = asFiles.i; + rc = stream(sOrgDef, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + say 'APIImport.cmd: failiure (2) rc='||rc; + else + i = asFiles.0; + end + end + end + else + say 'APIImport.cmd: failiure (1) rc='||rc; + end + rc = stream(sTmpName, 'c', 'open write'); + + do while (lines(sOrgDef) > 0) + sLine = linein(sOrgDef); + if (pos('LIBRARY ', translate(strip(sLine))) = 1 ) then + call lineout sTmpName, 'LIBRARY '||sDllName; + else + call lineout sTmpName, sLine; + end + + rc = stream(sOrgDef, 'c', 'close'); + rc = stream(sTmpName, 'c', 'close'); + return 0; diff --git a/tools/bin/BldLevelInf.cmd b/tools/bin/BldLevelInf.cmd index ebcde3d..8a556f8 100644 --- a/tools/bin/BldLevelInf.cmd +++ b/tools/bin/BldLevelInf.cmd @@ -1,604 +1,604 @@ -/* $Id: BldLevelInf.cmd,v 1.6 2002-08-24 04:36:04 bird Exp $ - * - * Adds a Description string to the given .def-file. - * Fills in default values; like build time and host. - * - */ - -signal on novalue name NoValueHandler - -if RxFuncQuery('SysLoadFuncs') = 1 then -do - call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; - call SysLoadFuncs; -end - - -/* - * Set default parameter values. - */ -sDefFileIn = ''; -sDefFileOut = ''; -sASDFeatureId = ''; -sCountryCode = ''; -sDateTime = left(' 'date()' 'time(), 26); -sDescription = 'Odin32'; -sFixPakVer = ''; -sHostname = strip(substr(VALUE('HOSTNAME',,'OS2ENVIRONMENT'), 1, 11)); -sLanguageCode = ''; -sMiniVer = ''; -sVendor = 'Project Odin'; -sVersion = '0.5'; - - -/* - * Config stuff. - */ -iVerbose = 1; /* 0, 1 or 2. */ -if (getenv("BUILD_QUIET") <> '') then - iVerbose = 0; -else if (getenv("BUILD_VERBOSE") <> '') then - iVerbose = 2; -sGlobals = 'iVerbose' - -/* - * Parse parameters. - */ -parse arg sArgs -if (sArgs = '') then -do - call syntax; - exit(1); -end - -do while (sArgs <> '') - sArgs = strip(sArgs); - if (substr(sArgs, 1, 1) = '-' | substr(sArgs, 1, 1) = '/') then - do /* - * Option. - */ - ch = translate(substr(sArgs, 2, 1)); - if (pos(ch, 'ACDHLMNPRTV') < 1) then - do - say 'invalid option:' substr(sArgs, 1, 2); - call syntax; - exit(2); - end - - /* get value and advance sArgs to next or to end. */ - if (substr(sArgs, 3, 1) = '"') then - do - iNext = pos('"', sArgs, 4); - fQuote = 1; - end - else - do - iNext = pos(' ', sArgs, 3); - if (iNext <= 0) then - iNext = length(sArgs); - fQuote = 0; - end - - if (iNext > 3 | ch = 'R') then - do - sValue = substr(sArgs, 3 + fQuote, iNext - 3 - fQuote); - sArgs = strip(substr(sArgs, iNext+1)); - /*say 'iNext:' iNext 'sValue:' sValue 'sArgs:' sArgs; */ - - /* check if we're gonna search for something in an file. */ - if (sValue <> '' & pos('#define=', sValue) > 0) then - sValue = LookupDefine(sValue); - end - else - do - say 'syntax error near' substr(sArgs, 1, 2)'.'; - call syntax; - exit(3); - end - - - /* set value */ - select - when (ch = 'A') then /* ASD Feature Id */ - sASDFeatureId = sValue; - - when (ch = 'C') then /* Country code */ - sCountryCode = sValue; - - when (ch = 'D') then /* Description */ - sDescription = sValue; - - when (ch = 'H') then /* Hostname */ - sHostname = sValue; - - when (ch = 'L') then /* Language code */ - sLanguageCode = sValue; - - when (ch = 'M') then /* MiniVer */ - sMiniVer = sValue; - - when (ch = 'N') then /* Vendor */ - sVendor = sValue; - - when (ch = 'R') then /* Description */ - sDescription = ReadDescription(sValue, sDefFileIn); - - when (ch = 'P') then /* Fixpak version */ - sFixPakVer = sValue; - - when (ch = 'T') then /* Date Time */ - sDateTime = sValue; - - when (ch = 'V') then /* Version */ - sVersion = sValue; - - /* Otherwise it's an illegal option */ - otherwise - say 'invalid option:' substr(sArgs, 1, 2); - call syntax; - exit(2); - end /* select */ - end - else - do /* - * Defition file... - */ - if (sDefFileOut <> '') then - do - say 'Syntax error: Can''t specify more than two defintion files!'; - exit(4); - end - if (sDefFileIn = '') then - parse value sArgs with sDefFileIn' 'sArgs - else - parse value sArgs with sDefFileOut' 'sArgs - sArgs = strip(sArgs); - end -end - - -/* check that a defintion file was specified. */ -if (sDefFileIn = '') then -do - say 'Syntax error: Will have to specify a .def-file to update.'; - call syntax; - exit(5); -end - - -/* - * Trim strings to correct lengths. - */ -sVendor = strip(substr(sVendor, 1, 31)); -if (substr(sDateTime, 1, 1) <> ' ') then - sDateTime = ' ' || sDateTime; -sDateTime = left(sDateTime, 26); -sHostname = strip(substr(sHostname, 1, 11)); -sMiniVer = strip(substr(sMiniVer, 1, 11)); -sDescription = strip(substr(sDescription, 1, 80)); -sCountryCode = strip(substr(sCountryCode, 1, 4)); -sLanguageCode = strip(substr(sLanguageCode, 1, 4)); -sASDFeatureId = strip(substr(sASDFeatureId, 1, 11)); -sFixPakVer = strip(substr(sFixPakVer, 1, 11)); - - -/* - * Signature - */ -sEnhSign = '##1##' - -/* - * Build description string. - */ -sDescription = '@#'sVendor':'sVersion'#@'sEnhSign||, - sDateTime||sHostname||, - ':'sASDFeatureId':'sLanguageCode':'sCountryCode':'sMiniVer||, - '::'sFixPakVer'@@'sDescription; - -/* - * Update .def-file. - */ -rc = UpdateDefFile(sDefFileIn, sDefFileOut, sDescription); -if (rc = 0 & iVerbose >= 1) then - say 'BldLevelInf: Applied build info to '''sDefFileOut'''.'; -exit(rc); - - -/** - * Display script syntax. - */ -syntax: procedure expose (sGlobals); - say 'Syntax: MakeDesc.cmd [options] [options]' - say ' Defitionfile which will have an DESCRIPTION appended.' - say 'Options:' - say ' -A ASD Feature Id.' - say ' -C Country code.' - say ' -D Description.' - say ' -R[deffile] Read description from .def file.' - say ' -H Hostname.' - say ' -L Language code.' - say ' -M MiniVer.' - say ' -N Vendor.' - say ' -P Fixpak version.' - say ' -T Date Time.' - say ' -V Version.' - say ' could be a double qoute qouted string or a single word.' - say ' You could also reference #defines in C/C++ include files.' - say ' The string should then have this form:' - say ' "#define=,"' - say ''; - - return; - - -/** - * Search for a #define in an C/C++ header or source file. - * - * @returns String containing the defined value - * found for the define in the header file. - * Quits on fatal errors. - * @param A string on the form: "#define=DEFINETOFIND,includefile.h" - * @remark Write only code... - let's hope it works. - */ -LookupDefine: procedure expose (sGlobals); - parse arg '#'sDefine'='sMacro','sIncludeFile - - /* - * Validate parameters. - */ - sMacro = strip(sMacro); - sIncludeFile = strip(sIncludeFile); - if (sMacro = '') then - do - say 'syntax error: #define=,.'; - say ' was empty.'; - exit(-20); - end - if (sIncludeFile = '') then - do - say 'syntax error: #define=,.'; - say ' was empty.'; - exit(-20); - end - - - sIllegal = translate(translate(sMacro),, - '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!',, - 'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_'); - - if (strip(translate(sIllegal, ' ', '!')) <> '') then - do - say 'syntax error: #define=,.'; - say ' contains illegal charater(s).' - say ' 'sMacro; - say ' 'translate(sIllegal, ' ', '!'); - exit(-20); - end - - /* - * Open include file. - */ - sRc = stream(sIncludeFile, 'c', 'open read'); - if (pos('READY', sRc) <> 1) then - do /* search INCLUDE variable */ - sFile = SysSearchPath('INCLUDE', sIncludeFile); - if (sFile = '') then - do - say 'Can''t find include file 'sIncludeFile'.'; - exit(-20); - end - sIncludeFile = sFile; - - sRc = stream(sIncludeFile, 'c', 'open read'); - if (pos('READY', sRc) <> 1) then - do - say 'Failed to open include file' sIncludeFile'.'; - exit(-20); - end - end - - /* - * Search the file line by line. - * We'll check for lines starting with a hash (#) char. - * Then check that the word after the hash is 'define'. - * Then match the next word with the macro name. - * Then then get the next rest of the line to comment or continuation char. - * (continuation is not supported) - * Finally strip quotes. - */ - sValue = ''; - do while (lines(sIncludeFile) > 0) - sLine = strip(linein(sIncludeFile)); - if (sLine = '') then - iterate; - if (substr(sLine, 1, 1) <> '#') then - iterate; - sLine = substr(sLine, 2); - if (word(sLine, 1) <> 'define') then - iterate; - sLine = strip(substr(sLine, wordpos(sLine, 1) + length('define')+1)); - if ( substr(sLine, 1, length(sMacro)) <> sMacro, - | substr(sLine, length(sMacro)+1, 1) <> ' ') then - iterate; - sLine = strip(substr(sLine, length(sMacro) + 1)); - if (sLine = '') then - do - say 'error: #define' sMacro' is empty.'; - call stream sIncludeFile, 'c', 'close'; - exit(-20); - end - - chQuote = substr(sLine, 1, 1); - if (chQuote = '"' | chQuote = "'") then - do /* quoted string */ - iLastQuote = 0; - do forever - iLast = pos(chQuote, sLine, 2); - if (iLast <= 0) then - leave; - if (substr(sLine, iLast, 1) = '\') then - iterate; - iLastQuote = iLast; - leave; - end - - if (iLastQuote <= 0) then - do - say 'C/C++ syntax error in 'sIncludefile': didn''t find end quote.'; - call stream sIncludeFile, 'c', 'close'; - exit(-20); - end - - call stream sIncludeFile, 'c', 'close'; - sValue = substr(sLine, 2, iLastQuote - 2); - if (iVerbose >= 2) then - say 'Found 'sMacro'='sValue; - return sValue; - end - else - do - iCommentCPP = pos('//',sLine); - iCommentC = pos('/*',sLine); - if (iCommentC > 0 & iCommentCPP > 0 & iCommentC > iCommentCPP) then - iComment = iCommentCPP; - else if (iCommentC > 0 & iCommentCPP > 0 & iCommentC < iCommentCPP) then - iComment = iCommentC; - else if (iCommentCPP > 0) then - iComment = iCommentCPP; - else if (iCommentC > 0) then - iComment = iCommentC; - else - iComment = 0; - - if (iComment > 0) then - sValue = strip(substr(sLine, 1, iComment-1)); - else - sValue = strip(sLine); - - if (sValue <> '') then - do - if (substr(sValue, length(sValue)) = '\') then - do - say 'Found continuation char: Multiline definitions are not supported!\n'; - call stream sIncludeFile, 'c', 'close'; - exit(-20); - end - end - - if (sValue = '') then - say 'warning: The #define has no value.'; - - call stream sIncludeFile, 'c', 'close'; - if (iVerbose >= 2) then - say 'Found 'sMacro'='sValue; - return sValue; - end - end - - call stream sIncludeFile, 'c', 'close'; - say 'error: didn''t find #define' sMacro'.'; - exit(-20); - - - -/** - * Reads the description line for a .def-file. - * @returns The Description string, with quotes removed. - * Empty string is acceptable. - * On error we'll terminate the script. - * @param sDefFile Filaname of .def-file to read the description from. - * @param sDefFile2 Used if sDefFile is empty. - * @author knut st. osmundsen (knut.stange.osmundsen@mynd.no) - */ -ReadDescription: procedure expose (sGlobals); - parse arg sDefFile, sDefFile2 - - /* - * Validate parameters. - */ - if (sDefFile = '') then - sDefFile = sDefFile2; - if (sDefFile = '') then - do - say 'error: no definition file to get description from.' - exit(-1); - end - - /* - * Open file - */ - rc = stream(sDefFile, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - do - say 'error: failed to open deffile file.'; - exit(-1); - end - - - /* - * Search for the 'DESCRIPTION' line. - */ - do while (lines(sDefFile) > 0) - sLine = strip(linein(sDefFile)); - if (sLine = '') then - iterate; - if (translate(word(sLine, 1)) <> 'DESCRIPTION') then - iterate; - sLine = strip(substr(sLine, wordpos(sLine, 1) + length('DESCRIPTION')+1)); - - ch = substr(sLine, 1, 1); - if (ch <> "'" & ch <> '"') then - do - say 'syntax error: description line in' sDefFile 'is misformed.'; - call stream sDefFile, 'c', 'close'; - exit(-10); - end - - iEnd = pos(ch, sLine, 2); - if (iEnd <= 0) then - do - say 'syntax error: description line in' sDefFile 'is misformed.'; - call stream sDefFile, 'c', 'close'; - exit(-10); - end - - call stream sDefFile, 'c', 'close'; - sValue = substr(sLine, 2, iEnd - 2); - if (iVerbose >= 2) then - say 'Found Description:' sValue; - return sValue; - end - - call stream sDefFile, 'c', 'close'; - if (iVerbose >= 1) then - say 'info: Didn''t find description line in' sDefFile'.'; - return ''; - - -/** - * This is a function which reads sDefFileIn into and - * internal array and changes the DESCRIPTION text if found. - * If DESCRIPTION isn't found, it is added at the end. - * The array is written to sDefFileOut. - * @returns 0 on succes. - * Errorcode on error. - * @param sDefFileIn Input .def-file. - * @param sDefFileOut Output .def-file. Overwritten. - * @param sDescription New description string. - * @author knut st. osmundsen (knut.stange.osmundsen@mynd.no) - */ -UpdateDefFile: procedure expose (sGlobals); - parse arg sDefFileIn, sDefFileOut, sDescription - - /* - * Validate parameters. - */ - if (sDefFileOut = '') then - sDefFileOut = sDefFileIn; - - /* - * Open file input file. - */ - rc = stream(sDefFileIn, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - do - say 'error: failed to open' sDefFileIn 'file.'; - return 110; - end - - - /* - * Search for the 'DESCRIPTION' line. - */ - i = 0; - fDescription = 0; - do while (lines(sDefFileIn) > 0) - /* - * Read line. - */ - i = i + 1; - asFile.i = strip(linein(sDefFileIn)); - - /* - * Look for DESCRIPTION; - */ - if (asFile.i = '') then - iterate; - if (translate(word(asFile.i, 1)) <> 'DESCRIPTION') then - iterate; - if (fDescription) then - do - say 'warning: multiple descriptions lines. Line' i 'removed'; - i = i - 1; - iterate; - end - - /* - * Found description - replace with new description. - */ - asFile.i = "DESCRIPTION '"||sDescription||"'"; - fDescription = 1; - end - - /* - * Add description is none was found. - */ - if (\fDescription) then - do - i = i + 1; - asFile.i = "DESCRIPTION '"||sDescription||"'"; - end - asFile.0 = i; - - - /* - * Close input file and open output file. - */ - call stream sDefFileIn, 'c', 'close'; - call SysFileDelete(sDefFileOut); - rc = stream(sDefFileOut, 'c', 'open write'); - if (pos('READY', rc) <> 1) then - do - say 'error: failed to open outputfile' sDefFileOut 'file.'; - return 110; - end - - /* - * Make firstline and write all the lines to the output file. - */ - call lineout sDefFileOut, '; Updated by makedesc.cmd', 1; - do i = 1 to asFile.0 - rc = lineout(sDefFileOut, asFile.i); - if (rc > 0) then - do - say 'error: failed to write line' i 'to' sDefFileOut'.' - call stream sDefFileOut, 'c', 'close'; - return 5; - end - end - - /* - * Close output file and return succesfully. - */ - call stream sDefFileOut, 'c', 'close'; - return 0; - - -/** - * Get environment variable value. - * @returns Environment variable value if set. - * '' if not set. - * @param sVar Variable name. - */ -getenv: procedure -parse arg sVar -return value(sVar,,'OS2ENVIRONMENT'); - - -/** - * No value handler - */ -NoValueHandler: - say 'NoValueHandler: line 'SIGL; -return 0; - +/* $Id: BldLevelInf.cmd,v 1.6 2002-08-24 04:36:04 bird Exp $ + * + * Adds a Description string to the given .def-file. + * Fills in default values; like build time and host. + * + */ + +signal on novalue name NoValueHandler + +if RxFuncQuery('SysLoadFuncs') = 1 then +do + call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; + call SysLoadFuncs; +end + + +/* + * Set default parameter values. + */ +sDefFileIn = ''; +sDefFileOut = ''; +sASDFeatureId = ''; +sCountryCode = ''; +sDateTime = left(' 'date()' 'time(), 26); +sDescription = 'Odin32'; +sFixPakVer = ''; +sHostname = strip(substr(VALUE('HOSTNAME',,'OS2ENVIRONMENT'), 1, 11)); +sLanguageCode = ''; +sMiniVer = ''; +sVendor = 'Project Odin'; +sVersion = '0.5'; + + +/* + * Config stuff. + */ +iVerbose = 1; /* 0, 1 or 2. */ +if (getenv("BUILD_QUIET") <> '') then + iVerbose = 0; +else if (getenv("BUILD_VERBOSE") <> '') then + iVerbose = 2; +sGlobals = 'iVerbose' + +/* + * Parse parameters. + */ +parse arg sArgs +if (sArgs = '') then +do + call syntax; + exit(1); +end + +do while (sArgs <> '') + sArgs = strip(sArgs); + if (substr(sArgs, 1, 1) = '-' | substr(sArgs, 1, 1) = '/') then + do /* + * Option. + */ + ch = translate(substr(sArgs, 2, 1)); + if (pos(ch, 'ACDHLMNPRTV') < 1) then + do + say 'invalid option:' substr(sArgs, 1, 2); + call syntax; + exit(2); + end + + /* get value and advance sArgs to next or to end. */ + if (substr(sArgs, 3, 1) = '"') then + do + iNext = pos('"', sArgs, 4); + fQuote = 1; + end + else + do + iNext = pos(' ', sArgs, 3); + if (iNext <= 0) then + iNext = length(sArgs); + fQuote = 0; + end + + if (iNext > 3 | ch = 'R') then + do + sValue = substr(sArgs, 3 + fQuote, iNext - 3 - fQuote); + sArgs = strip(substr(sArgs, iNext+1)); + /*say 'iNext:' iNext 'sValue:' sValue 'sArgs:' sArgs; */ + + /* check if we're gonna search for something in an file. */ + if (sValue <> '' & pos('#define=', sValue) > 0) then + sValue = LookupDefine(sValue); + end + else + do + say 'syntax error near' substr(sArgs, 1, 2)'.'; + call syntax; + exit(3); + end + + + /* set value */ + select + when (ch = 'A') then /* ASD Feature Id */ + sASDFeatureId = sValue; + + when (ch = 'C') then /* Country code */ + sCountryCode = sValue; + + when (ch = 'D') then /* Description */ + sDescription = sValue; + + when (ch = 'H') then /* Hostname */ + sHostname = sValue; + + when (ch = 'L') then /* Language code */ + sLanguageCode = sValue; + + when (ch = 'M') then /* MiniVer */ + sMiniVer = sValue; + + when (ch = 'N') then /* Vendor */ + sVendor = sValue; + + when (ch = 'R') then /* Description */ + sDescription = ReadDescription(sValue, sDefFileIn); + + when (ch = 'P') then /* Fixpak version */ + sFixPakVer = sValue; + + when (ch = 'T') then /* Date Time */ + sDateTime = sValue; + + when (ch = 'V') then /* Version */ + sVersion = sValue; + + /* Otherwise it's an illegal option */ + otherwise + say 'invalid option:' substr(sArgs, 1, 2); + call syntax; + exit(2); + end /* select */ + end + else + do /* + * Defition file... + */ + if (sDefFileOut <> '') then + do + say 'Syntax error: Can''t specify more than two defintion files!'; + exit(4); + end + if (sDefFileIn = '') then + parse value sArgs with sDefFileIn' 'sArgs + else + parse value sArgs with sDefFileOut' 'sArgs + sArgs = strip(sArgs); + end +end + + +/* check that a defintion file was specified. */ +if (sDefFileIn = '') then +do + say 'Syntax error: Will have to specify a .def-file to update.'; + call syntax; + exit(5); +end + + +/* + * Trim strings to correct lengths. + */ +sVendor = strip(substr(sVendor, 1, 31)); +if (substr(sDateTime, 1, 1) <> ' ') then + sDateTime = ' ' || sDateTime; +sDateTime = left(sDateTime, 26); +sHostname = strip(substr(sHostname, 1, 11)); +sMiniVer = strip(substr(sMiniVer, 1, 11)); +sDescription = strip(substr(sDescription, 1, 80)); +sCountryCode = strip(substr(sCountryCode, 1, 4)); +sLanguageCode = strip(substr(sLanguageCode, 1, 4)); +sASDFeatureId = strip(substr(sASDFeatureId, 1, 11)); +sFixPakVer = strip(substr(sFixPakVer, 1, 11)); + + +/* + * Signature + */ +sEnhSign = '##1##' + +/* + * Build description string. + */ +sDescription = '@#'sVendor':'sVersion'#@'sEnhSign||, + sDateTime||sHostname||, + ':'sASDFeatureId':'sLanguageCode':'sCountryCode':'sMiniVer||, + '::'sFixPakVer'@@'sDescription; + +/* + * Update .def-file. + */ +rc = UpdateDefFile(sDefFileIn, sDefFileOut, sDescription); +if (rc = 0 & iVerbose >= 1) then + say 'BldLevelInf: Applied build info to '''sDefFileOut'''.'; +exit(rc); + + +/** + * Display script syntax. + */ +syntax: procedure expose (sGlobals); + say 'Syntax: MakeDesc.cmd [options] [options]' + say ' Defitionfile which will have an DESCRIPTION appended.' + say 'Options:' + say ' -A ASD Feature Id.' + say ' -C Country code.' + say ' -D Description.' + say ' -R[deffile] Read description from .def file.' + say ' -H Hostname.' + say ' -L Language code.' + say ' -M MiniVer.' + say ' -N Vendor.' + say ' -P Fixpak version.' + say ' -T Date Time.' + say ' -V Version.' + say ' could be a double qoute qouted string or a single word.' + say ' You could also reference #defines in C/C++ include files.' + say ' The string should then have this form:' + say ' "#define=,"' + say ''; + + return; + + +/** + * Search for a #define in an C/C++ header or source file. + * + * @returns String containing the defined value + * found for the define in the header file. + * Quits on fatal errors. + * @param A string on the form: "#define=DEFINETOFIND,includefile.h" + * @remark Write only code... - let's hope it works. + */ +LookupDefine: procedure expose (sGlobals); + parse arg '#'sDefine'='sMacro','sIncludeFile + + /* + * Validate parameters. + */ + sMacro = strip(sMacro); + sIncludeFile = strip(sIncludeFile); + if (sMacro = '') then + do + say 'syntax error: #define=,.'; + say ' was empty.'; + exit(-20); + end + if (sIncludeFile = '') then + do + say 'syntax error: #define=,.'; + say ' was empty.'; + exit(-20); + end + + + sIllegal = translate(translate(sMacro),, + '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!',, + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_'); + + if (strip(translate(sIllegal, ' ', '!')) <> '') then + do + say 'syntax error: #define=,.'; + say ' contains illegal charater(s).' + say ' 'sMacro; + say ' 'translate(sIllegal, ' ', '!'); + exit(-20); + end + + /* + * Open include file. + */ + sRc = stream(sIncludeFile, 'c', 'open read'); + if (pos('READY', sRc) <> 1) then + do /* search INCLUDE variable */ + sFile = SysSearchPath('INCLUDE', sIncludeFile); + if (sFile = '') then + do + say 'Can''t find include file 'sIncludeFile'.'; + exit(-20); + end + sIncludeFile = sFile; + + sRc = stream(sIncludeFile, 'c', 'open read'); + if (pos('READY', sRc) <> 1) then + do + say 'Failed to open include file' sIncludeFile'.'; + exit(-20); + end + end + + /* + * Search the file line by line. + * We'll check for lines starting with a hash (#) char. + * Then check that the word after the hash is 'define'. + * Then match the next word with the macro name. + * Then then get the next rest of the line to comment or continuation char. + * (continuation is not supported) + * Finally strip quotes. + */ + sValue = ''; + do while (lines(sIncludeFile) > 0) + sLine = strip(linein(sIncludeFile)); + if (sLine = '') then + iterate; + if (substr(sLine, 1, 1) <> '#') then + iterate; + sLine = substr(sLine, 2); + if (word(sLine, 1) <> 'define') then + iterate; + sLine = strip(substr(sLine, wordpos(sLine, 1) + length('define')+1)); + if ( substr(sLine, 1, length(sMacro)) <> sMacro, + | substr(sLine, length(sMacro)+1, 1) <> ' ') then + iterate; + sLine = strip(substr(sLine, length(sMacro) + 1)); + if (sLine = '') then + do + say 'error: #define' sMacro' is empty.'; + call stream sIncludeFile, 'c', 'close'; + exit(-20); + end + + chQuote = substr(sLine, 1, 1); + if (chQuote = '"' | chQuote = "'") then + do /* quoted string */ + iLastQuote = 0; + do forever + iLast = pos(chQuote, sLine, 2); + if (iLast <= 0) then + leave; + if (substr(sLine, iLast, 1) = '\') then + iterate; + iLastQuote = iLast; + leave; + end + + if (iLastQuote <= 0) then + do + say 'C/C++ syntax error in 'sIncludefile': didn''t find end quote.'; + call stream sIncludeFile, 'c', 'close'; + exit(-20); + end + + call stream sIncludeFile, 'c', 'close'; + sValue = substr(sLine, 2, iLastQuote - 2); + if (iVerbose >= 2) then + say 'Found 'sMacro'='sValue; + return sValue; + end + else + do + iCommentCPP = pos('//',sLine); + iCommentC = pos('/*',sLine); + if (iCommentC > 0 & iCommentCPP > 0 & iCommentC > iCommentCPP) then + iComment = iCommentCPP; + else if (iCommentC > 0 & iCommentCPP > 0 & iCommentC < iCommentCPP) then + iComment = iCommentC; + else if (iCommentCPP > 0) then + iComment = iCommentCPP; + else if (iCommentC > 0) then + iComment = iCommentC; + else + iComment = 0; + + if (iComment > 0) then + sValue = strip(substr(sLine, 1, iComment-1)); + else + sValue = strip(sLine); + + if (sValue <> '') then + do + if (substr(sValue, length(sValue)) = '\') then + do + say 'Found continuation char: Multiline definitions are not supported!\n'; + call stream sIncludeFile, 'c', 'close'; + exit(-20); + end + end + + if (sValue = '') then + say 'warning: The #define has no value.'; + + call stream sIncludeFile, 'c', 'close'; + if (iVerbose >= 2) then + say 'Found 'sMacro'='sValue; + return sValue; + end + end + + call stream sIncludeFile, 'c', 'close'; + say 'error: didn''t find #define' sMacro'.'; + exit(-20); + + + +/** + * Reads the description line for a .def-file. + * @returns The Description string, with quotes removed. + * Empty string is acceptable. + * On error we'll terminate the script. + * @param sDefFile Filaname of .def-file to read the description from. + * @param sDefFile2 Used if sDefFile is empty. + * @author knut st. osmundsen (knut.stange.osmundsen@mynd.no) + */ +ReadDescription: procedure expose (sGlobals); + parse arg sDefFile, sDefFile2 + + /* + * Validate parameters. + */ + if (sDefFile = '') then + sDefFile = sDefFile2; + if (sDefFile = '') then + do + say 'error: no definition file to get description from.' + exit(-1); + end + + /* + * Open file + */ + rc = stream(sDefFile, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + do + say 'error: failed to open deffile file.'; + exit(-1); + end + + + /* + * Search for the 'DESCRIPTION' line. + */ + do while (lines(sDefFile) > 0) + sLine = strip(linein(sDefFile)); + if (sLine = '') then + iterate; + if (translate(word(sLine, 1)) <> 'DESCRIPTION') then + iterate; + sLine = strip(substr(sLine, wordpos(sLine, 1) + length('DESCRIPTION')+1)); + + ch = substr(sLine, 1, 1); + if (ch <> "'" & ch <> '"') then + do + say 'syntax error: description line in' sDefFile 'is misformed.'; + call stream sDefFile, 'c', 'close'; + exit(-10); + end + + iEnd = pos(ch, sLine, 2); + if (iEnd <= 0) then + do + say 'syntax error: description line in' sDefFile 'is misformed.'; + call stream sDefFile, 'c', 'close'; + exit(-10); + end + + call stream sDefFile, 'c', 'close'; + sValue = substr(sLine, 2, iEnd - 2); + if (iVerbose >= 2) then + say 'Found Description:' sValue; + return sValue; + end + + call stream sDefFile, 'c', 'close'; + if (iVerbose >= 1) then + say 'info: Didn''t find description line in' sDefFile'.'; + return ''; + + +/** + * This is a function which reads sDefFileIn into and + * internal array and changes the DESCRIPTION text if found. + * If DESCRIPTION isn't found, it is added at the end. + * The array is written to sDefFileOut. + * @returns 0 on succes. + * Errorcode on error. + * @param sDefFileIn Input .def-file. + * @param sDefFileOut Output .def-file. Overwritten. + * @param sDescription New description string. + * @author knut st. osmundsen (knut.stange.osmundsen@mynd.no) + */ +UpdateDefFile: procedure expose (sGlobals); + parse arg sDefFileIn, sDefFileOut, sDescription + + /* + * Validate parameters. + */ + if (sDefFileOut = '') then + sDefFileOut = sDefFileIn; + + /* + * Open file input file. + */ + rc = stream(sDefFileIn, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + do + say 'error: failed to open' sDefFileIn 'file.'; + return 110; + end + + + /* + * Search for the 'DESCRIPTION' line. + */ + i = 0; + fDescription = 0; + do while (lines(sDefFileIn) > 0) + /* + * Read line. + */ + i = i + 1; + asFile.i = strip(linein(sDefFileIn)); + + /* + * Look for DESCRIPTION; + */ + if (asFile.i = '') then + iterate; + if (translate(word(asFile.i, 1)) <> 'DESCRIPTION') then + iterate; + if (fDescription) then + do + say 'warning: multiple descriptions lines. Line' i 'removed'; + i = i - 1; + iterate; + end + + /* + * Found description - replace with new description. + */ + asFile.i = "DESCRIPTION '"||sDescription||"'"; + fDescription = 1; + end + + /* + * Add description is none was found. + */ + if (\fDescription) then + do + i = i + 1; + asFile.i = "DESCRIPTION '"||sDescription||"'"; + end + asFile.0 = i; + + + /* + * Close input file and open output file. + */ + call stream sDefFileIn, 'c', 'close'; + call SysFileDelete(sDefFileOut); + rc = stream(sDefFileOut, 'c', 'open write'); + if (pos('READY', rc) <> 1) then + do + say 'error: failed to open outputfile' sDefFileOut 'file.'; + return 110; + end + + /* + * Make firstline and write all the lines to the output file. + */ + call lineout sDefFileOut, '; Updated by makedesc.cmd', 1; + do i = 1 to asFile.0 + rc = lineout(sDefFileOut, asFile.i); + if (rc > 0) then + do + say 'error: failed to write line' i 'to' sDefFileOut'.' + call stream sDefFileOut, 'c', 'close'; + return 5; + end + end + + /* + * Close output file and return succesfully. + */ + call stream sDefFileOut, 'c', 'close'; + return 0; + + +/** + * Get environment variable value. + * @returns Environment variable value if set. + * '' if not set. + * @param sVar Variable name. + */ +getenv: procedure +parse arg sVar +return value(sVar,,'OS2ENVIRONMENT'); + + +/** + * No value handler + */ +NoValueHandler: + say 'NoValueHandler: line 'SIGL; +return 0; + diff --git a/tools/bin/CVSRemoveDeletedDirs.cmd b/tools/bin/CVSRemoveDeletedDirs.cmd index 9fd836a..7d98052 100644 --- a/tools/bin/CVSRemoveDeletedDirs.cmd +++ b/tools/bin/CVSRemoveDeletedDirs.cmd @@ -1,177 +1,177 @@ -/* - * Cleanup script for directories we removed recently. - * Run from root of your odin32 tree. - * - * Specify 'remove' on the commandline to remove the dirs too. - * Default action is only to remove them from the CVS\Entries file. - */ - -/* - * Import helper functions - */ -call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; -call SysLoadFuncs; - - -/* - * Check that current directory is root of Odin32 tree. - */ -if ( \fnExists('.\ChangeLog'), - | \fnExists('.\LICENSE.TXT'), - | \fnExists('.\Configure.cmd'), - | \fnExists('.\rartree.cmd'), - | \fnExists('.\ziptree.cmd'), - | \fnExists('.\makeall.cmd'), - ) then -do - say 'Error: You''re not located in the root of the Odin32 tree!' - exit(-1); -end - - -/* - * Parse arguments. - */ -parse arg sArg1 sArg2 - -fRemoveDir = 0; -if (translate(sArg1) = 'REMOVE') then - fRemoveDir = 1; - - -/* - * Directories to remove. - */ -asDirs.0 = 5 -asDirs.1 = 'src\ws2help' -asDirs.2 = 'src\win32k\object' -asDirs.3 = 'src\win32k\list' -asDirs.4 = 'bin\debug' -asDirs.5 = 'bin\release' - - -/* - * Remove the directories. - */ -do i = 1 to asDirs.0 - sSubDir = substr(asDirs.i, lastpos('\', asDirs.i) + 1); - sParentCVSEntries = substr(asDirs.i, 1, lastpos('\', asDirs.i)), - || 'CVS\Entries'; - - if (fnExists(sParentCVSEntries)) then - do - /* - * Remove the entry for the given directory. - */ - if (fnReadFile(sParentCVSEntries)) then - do - sMatch = translate('D/'||sSubDir||'/'); - do j = 1 to asLines.0 - if (sMatch = translate(substr(asLines.j, 1, length(sMatch)))) then - leave - end - do k = j+1 to asLines.0 - j = k - 1; - asLines.j = asLines.k; - end - if (j < asLines.0) then /* if directory entry was found. */ - asLines.0 = j; - if (fnWriteFile(sParentCVSEntries)) then - do - say 'info: removed '''asDirs.i''''; - end - else - say 'error: failed to write'''||sParentCVSEntries||''''; - end - else - say 'error: failed to read '''||sParentCVSEntries||''''; - - /* - * If requested try delete the directory tree. - */ - if (fRemoveDir) then - do - call fnRemoveDir asDirs.i; - say 'info: removed the directory(tree) '''asDirs.i''''; - end - end - else - say 'warning: '''||sParentCVSEntries||''' was not found.'; -end - -exit(0); - - - -/** - * Checks if a file exists. - * @param sFile - * @returns TRUE if file exists. - * FALSE if file doesn't exists. - */ -fnExists: procedure - parse arg sFile - rc = stream(sFile, 'c', 'query exist'); -return rc <> ''; - - -/** - * Read a given file into asLines.. - * @returns Success indicator. - * @param sFile Filename to read. - */ -fnReadFile: procedure expose asLines.; - parse arg sFile - - asLines.0 = 0; - - rc = stream(sFile, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - return 0; - - iLine = 0; - do while lines(sFile) > 0 - iLine = iLine + 1; - asLines.iLine = linein(sFile); - end - asLines.0 = iLine; - - call stream sFile, 'c', 'close'; -return 1; - - -/** - * Write the file in asLines. to a real file. - * @returns Success indicator. - * @param sFile Filename to write it to. - */ -fnWriteFile: procedure expose asLines.; - parse arg sFile - - rc = SysFileDelete(sFile); - if (rc <> 0) then - say 'sysfiledelete('sFile') -> rc='rc; - rc = stream(sFile, 'c', 'open write'); - if (pos('READY', rc) <> 1) then - return 0; - do iLine = 1 to asLines.0 - call lineout sFile, asLines.iLine - end - - call stream sFile, 'c', 'close'; -return 1; - - -/** - * Removes a given directory tree. - * Currently we use 'rm -Rf' for this. - * - * @returns Successindicator. - * @param sDir Directory tree to remove. - */ -fnRemoveDir: procedure; - parse arg sDir; - 'rm -Rf 'sDir -return rc; - - +/* + * Cleanup script for directories we removed recently. + * Run from root of your odin32 tree. + * + * Specify 'remove' on the commandline to remove the dirs too. + * Default action is only to remove them from the CVS\Entries file. + */ + +/* + * Import helper functions + */ +call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; +call SysLoadFuncs; + + +/* + * Check that current directory is root of Odin32 tree. + */ +if ( \fnExists('.\ChangeLog'), + | \fnExists('.\LICENSE.TXT'), + | \fnExists('.\Configure.cmd'), + | \fnExists('.\rartree.cmd'), + | \fnExists('.\ziptree.cmd'), + | \fnExists('.\makeall.cmd'), + ) then +do + say 'Error: You''re not located in the root of the Odin32 tree!' + exit(-1); +end + + +/* + * Parse arguments. + */ +parse arg sArg1 sArg2 + +fRemoveDir = 0; +if (translate(sArg1) = 'REMOVE') then + fRemoveDir = 1; + + +/* + * Directories to remove. + */ +asDirs.0 = 5 +asDirs.1 = 'src\ws2help' +asDirs.2 = 'src\win32k\object' +asDirs.3 = 'src\win32k\list' +asDirs.4 = 'bin\debug' +asDirs.5 = 'bin\release' + + +/* + * Remove the directories. + */ +do i = 1 to asDirs.0 + sSubDir = substr(asDirs.i, lastpos('\', asDirs.i) + 1); + sParentCVSEntries = substr(asDirs.i, 1, lastpos('\', asDirs.i)), + || 'CVS\Entries'; + + if (fnExists(sParentCVSEntries)) then + do + /* + * Remove the entry for the given directory. + */ + if (fnReadFile(sParentCVSEntries)) then + do + sMatch = translate('D/'||sSubDir||'/'); + do j = 1 to asLines.0 + if (sMatch = translate(substr(asLines.j, 1, length(sMatch)))) then + leave + end + do k = j+1 to asLines.0 + j = k - 1; + asLines.j = asLines.k; + end + if (j < asLines.0) then /* if directory entry was found. */ + asLines.0 = j; + if (fnWriteFile(sParentCVSEntries)) then + do + say 'info: removed '''asDirs.i''''; + end + else + say 'error: failed to write'''||sParentCVSEntries||''''; + end + else + say 'error: failed to read '''||sParentCVSEntries||''''; + + /* + * If requested try delete the directory tree. + */ + if (fRemoveDir) then + do + call fnRemoveDir asDirs.i; + say 'info: removed the directory(tree) '''asDirs.i''''; + end + end + else + say 'warning: '''||sParentCVSEntries||''' was not found.'; +end + +exit(0); + + + +/** + * Checks if a file exists. + * @param sFile + * @returns TRUE if file exists. + * FALSE if file doesn't exists. + */ +fnExists: procedure + parse arg sFile + rc = stream(sFile, 'c', 'query exist'); +return rc <> ''; + + +/** + * Read a given file into asLines.. + * @returns Success indicator. + * @param sFile Filename to read. + */ +fnReadFile: procedure expose asLines.; + parse arg sFile + + asLines.0 = 0; + + rc = stream(sFile, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + return 0; + + iLine = 0; + do while lines(sFile) > 0 + iLine = iLine + 1; + asLines.iLine = linein(sFile); + end + asLines.0 = iLine; + + call stream sFile, 'c', 'close'; +return 1; + + +/** + * Write the file in asLines. to a real file. + * @returns Success indicator. + * @param sFile Filename to write it to. + */ +fnWriteFile: procedure expose asLines.; + parse arg sFile + + rc = SysFileDelete(sFile); + if (rc <> 0) then + say 'sysfiledelete('sFile') -> rc='rc; + rc = stream(sFile, 'c', 'open write'); + if (pos('READY', rc) <> 1) then + return 0; + do iLine = 1 to asLines.0 + call lineout sFile, asLines.iLine + end + + call stream sFile, 'c', 'close'; +return 1; + + +/** + * Removes a given directory tree. + * Currently we use 'rm -Rf' for this. + * + * @returns Successindicator. + * @param sDir Directory tree to remove. + */ +fnRemoveDir: procedure; + parse arg sDir; + 'rm -Rf 'sDir +return rc; + + diff --git a/tools/bin/CreatePath.cmd b/tools/bin/CreatePath.cmd index 60de5c1..da664ec 100644 --- a/tools/bin/CreatePath.cmd +++ b/tools/bin/CreatePath.cmd @@ -1,31 +1,31 @@ -/* $Id: CreatePath.cmd,v 1.4 2002-05-16 11:50:22 bird Exp $ - * - * Createpath.cmd - * - * Creates a path. - * - */ - -if RxFuncQuery('SysMkDir')=1 THEN - call RxFuncAdd 'SysMkDir', 'RexxUtil', 'SysMkDir' - - parse arg sArgs - return createpath(strip(sArgs)); - -createpath: procedure - parse arg sDir - - /* - * Any directories above this? If so we'll have to make sure they exists! - */ - sPath = filespec('path', sDir); - if (length(sPath) > 0 & sPath <> '\') then - rc = createpath(filespec('drive', sDir) || substr(sPath, 1, length(sPath)-1)); - - /* - * Create this directory. - */ - rc = SysMkDir(sDir); - /*say 'dir:' sDir '- rc='rc;*/ - - return 0; +/* $Id: CreatePath.cmd,v 1.4 2002-05-16 11:50:22 bird Exp $ + * + * Createpath.cmd + * + * Creates a path. + * + */ + +if RxFuncQuery('SysMkDir')=1 THEN + call RxFuncAdd 'SysMkDir', 'RexxUtil', 'SysMkDir' + + parse arg sArgs + return createpath(strip(sArgs)); + +createpath: procedure + parse arg sDir + + /* + * Any directories above this? If so we'll have to make sure they exists! + */ + sPath = filespec('path', sDir); + if (length(sPath) > 0 & sPath <> '\') then + rc = createpath(filespec('drive', sDir) || substr(sPath, 1, length(sPath)-1)); + + /* + * Create this directory. + */ + rc = SysMkDir(sDir); + /*say 'dir:' sDir '- rc='rc;*/ + + return 0; diff --git a/tools/bin/DoDirs.cmd b/tools/bin/DoDirs.cmd index 98bfde7..a4b15d7 100644 --- a/tools/bin/DoDirs.cmd +++ b/tools/bin/DoDirs.cmd @@ -1,118 +1,118 @@ -/* $Id: DoDirs.cmd,v 1.7 2002-08-29 11:49:36 bird Exp $ - * - * Rexx script which executes a given command in each of the given - * directories. It will fail when a command failes in one of the - * directories or if it failes to change to one of the directories. - * - * Syntax: ProcessDirs.cmd "" - * - * Copyright (c) 2000 knut st. osmundsen (knut.stange.osmundsen@mynd.no) - * - * Project Odin Software License can be found in LICENSE.TXT - */ -signal on novalue name NoValueHandler -Address CMD '@echo off' - -parse arg '"'sDirs'" 'sCommand - -/* - * Color config. - */ -if ((getenv('BUILD_NOCOLORS') = '') & (getenv('SLKRUNS') = '')) then -do - sClrMak = '' - sClrErr = '' - sClrRst = '' -end -else -do - sClrMak = '' - sClrErr = '' - sClrRst = '' -end - - -/* - * Build Pass - */ -sPass = getenv('_BUILD_PASS'); -if (sPass <> '') then - sPass = 'Pass '||sPass||' - ' - - -/* - * Save current directory. - */ -sCurrentDir = directory(); - - -/* - * Loop thru each directory. - * The directories are space separated. - */ -iRc = 0; /* Returncode */ -iStart = 1; /* Subdirectory Index */ -do while (iStart <= length(sDirs)) - iEnd = pos(' ', sDirs, iStart); - if (iEnd <= 0 & iStart <= length(sDirs)) then - iEnd = length(sDirs) + 1; - - if (iEnd > 0) then - do - /* - * Copy out the directory from sDirs. Iterate if empty name. - * Move iStart forward to the next directory i sDirs. - * Try change directory. Complain and fail if this failes. - * Execute command. - * Check return code. Complain and fail if this failes. - */ - sDir = substr(sDirs, iStart, iEnd - iStart); - iStart = iEnd + 1; - if (sDir = ' ' | sDir = '') then/* If empty directory name iterate. */ - iterate; - if (directory(sDir) <> '') then - do - say sClrMak||'['||sPass||'Entering Directory:' directory()||']'||sClrRst; - sCommand - if (rc <> 0) then - do - say sClrErr||'['||sPass||'Failed rc='rc' directory:' directory()||']'||sClrRst; - exit(rc); - end - say sClrMak||'['||sPass||'Leaving Directory:' directory()||']'||sClrRst; - end - else - do - say sClrErr||'['||sPass||'Failed to change directory to' sDir||']'||sClrRst; - exit(267); /* ERROR_DIRECTORY */ - end - call directory sCurrentDir; /* Restore start directory. */ - end - else - leave; /* No more directories left. */ -end - - -/* - * Return successfully. - */ -exit(0); - - -/** - * Get environment variable value. - * @returns Environment variable value if set. - * '' if not set. - * @param sVar Variable name. - */ -getenv: procedure -parse arg sVar -return value(sVar,,'OS2ENVIRONMENT'); - -/** - * No value handler - */ -NoValueHandler: - say 'NoValueHandler: line 'SIGL; -return 0; - +/* $Id: DoDirs.cmd,v 1.7 2002-08-29 11:49:36 bird Exp $ + * + * Rexx script which executes a given command in each of the given + * directories. It will fail when a command failes in one of the + * directories or if it failes to change to one of the directories. + * + * Syntax: ProcessDirs.cmd "" + * + * Copyright (c) 2000 knut st. osmundsen (knut.stange.osmundsen@mynd.no) + * + * Project Odin Software License can be found in LICENSE.TXT + */ +signal on novalue name NoValueHandler +Address CMD '@echo off' + +parse arg '"'sDirs'" 'sCommand + +/* + * Color config. + */ +if ((getenv('BUILD_NOCOLORS') = '') & (getenv('SLKRUNS') = '')) then +do + sClrMak = '' + sClrErr = '' + sClrRst = '' +end +else +do + sClrMak = '' + sClrErr = '' + sClrRst = '' +end + + +/* + * Build Pass + */ +sPass = getenv('_BUILD_PASS'); +if (sPass <> '') then + sPass = 'Pass '||sPass||' - ' + + +/* + * Save current directory. + */ +sCurrentDir = directory(); + + +/* + * Loop thru each directory. + * The directories are space separated. + */ +iRc = 0; /* Returncode */ +iStart = 1; /* Subdirectory Index */ +do while (iStart <= length(sDirs)) + iEnd = pos(' ', sDirs, iStart); + if (iEnd <= 0 & iStart <= length(sDirs)) then + iEnd = length(sDirs) + 1; + + if (iEnd > 0) then + do + /* + * Copy out the directory from sDirs. Iterate if empty name. + * Move iStart forward to the next directory i sDirs. + * Try change directory. Complain and fail if this failes. + * Execute command. + * Check return code. Complain and fail if this failes. + */ + sDir = substr(sDirs, iStart, iEnd - iStart); + iStart = iEnd + 1; + if (sDir = ' ' | sDir = '') then/* If empty directory name iterate. */ + iterate; + if (directory(sDir) <> '') then + do + say sClrMak||'['||sPass||'Entering Directory:' directory()||']'||sClrRst; + sCommand + if (rc <> 0) then + do + say sClrErr||'['||sPass||'Failed rc='rc' directory:' directory()||']'||sClrRst; + exit(rc); + end + say sClrMak||'['||sPass||'Leaving Directory:' directory()||']'||sClrRst; + end + else + do + say sClrErr||'['||sPass||'Failed to change directory to' sDir||']'||sClrRst; + exit(267); /* ERROR_DIRECTORY */ + end + call directory sCurrentDir; /* Restore start directory. */ + end + else + leave; /* No more directories left. */ +end + + +/* + * Return successfully. + */ +exit(0); + + +/** + * Get environment variable value. + * @returns Environment variable value if set. + * '' if not set. + * @param sVar Variable name. + */ +getenv: procedure +parse arg sVar +return value(sVar,,'OS2ENVIRONMENT'); + +/** + * No value handler + */ +NoValueHandler: + say 'NoValueHandler: line 'SIGL; +return 0; + diff --git a/tools/bin/DoMakes.cmd b/tools/bin/DoMakes.cmd index 147e32e..9b42fc0 100644 --- a/tools/bin/DoMakes.cmd +++ b/tools/bin/DoMakes.cmd @@ -1,101 +1,101 @@ -/* $Id: DoMakes.cmd,v 1.4 2002-08-29 11:49:36 bird Exp $ - * - * Rexx script which executes a given command with each of - * the spesified makefiles using the option -f. - * - * Syntax: DoMakes.cmd "" - * - * Copyright (c) 2001 knut st. osmundsen (knut.stange.osmundsen@mynd.no) - * - * Project Odin Software License can be found in LICENSE.TXT - */ -signal on novalue name NoValueHandler -Address CMD '@echo off' - -parse arg '"'sMakefiles'" 'sCommand - -/* - * Color config. - */ -if ((getenv('BUILD_NOCOLORS') = '') & (getenv('SLKRUNS') = '')) then -do - sClrMak = '' - sClrErr = '' - sClrRst = '' -end -else -do - sClrMak = '' - sClrErr = '' - sClrRst = '' -end - - -/* - * Build Pass - */ -sPass = getenv('_BUILD_PASS'); -if (sPass <> '') then - sPass = 'Pass '||sPass||' - ' - - -/* - * Loop thru each directory. - * The directories are space separated. - */ -iRc = 0; /* Returncode */ -iStart = 1; /* Subdirectory Index */ -do while (iStart <= length(sMakefiles)) - iEnd = pos(' ', sMakefiles, iStart); - if (iEnd <= 0 & iStart <= length(sMakefiles)) then - iEnd = length(sMakefiles) + 1; - - if (iEnd > 0) then - do - /* - * Copy out the makefile from sMakefiles. Iterate if empty name. - * Move iStart forward to the next directory i sMakefiles. - * Execute command with makefile as -f argument. - * Check return code. Complain and fail if this failes. - */ - sMakefile = substr(sMakefiles, iStart, iEnd - iStart); - iStart = iEnd + 1; - if (sMakefile = ' ' | sMakefile = '') then/* If empty directory name iterate. */ - iterate; - say sClrMak||'['||sPass||'Processing Makefile:' sMakefile||']'||sClrRst; - sCommand '-f' sMakefile - if (rc <> 0) then - do - say sClrErr||'['||sPass||'Failed rc='rc' makefile:' sMakefile||']'||sClrRst; - exit(rc); - end - say sClrMak||'['||sPass||'Completed Makefile:' sMakefile||']'||sClrRst; - end - else - leave; /* No more directories left. */ -end - - -/* - * Return successfully. - */ -exit(0); - - -/** - * Get environment variable value. - * @returns Environment variable value if set. - * '' if not set. - * @param sVar Variable name. - */ -getenv: procedure -parse arg sVar -return value(sVar,,'OS2ENVIRONMENT'); - -/** - * No value handler - */ -NoValueHandler: - say 'NoValueHandler: line 'SIGL; -return 0; - +/* $Id: DoMakes.cmd,v 1.4 2002-08-29 11:49:36 bird Exp $ + * + * Rexx script which executes a given command with each of + * the spesified makefiles using the option -f. + * + * Syntax: DoMakes.cmd "" + * + * Copyright (c) 2001 knut st. osmundsen (knut.stange.osmundsen@mynd.no) + * + * Project Odin Software License can be found in LICENSE.TXT + */ +signal on novalue name NoValueHandler +Address CMD '@echo off' + +parse arg '"'sMakefiles'" 'sCommand + +/* + * Color config. + */ +if ((getenv('BUILD_NOCOLORS') = '') & (getenv('SLKRUNS') = '')) then +do + sClrMak = '' + sClrErr = '' + sClrRst = '' +end +else +do + sClrMak = '' + sClrErr = '' + sClrRst = '' +end + + +/* + * Build Pass + */ +sPass = getenv('_BUILD_PASS'); +if (sPass <> '') then + sPass = 'Pass '||sPass||' - ' + + +/* + * Loop thru each directory. + * The directories are space separated. + */ +iRc = 0; /* Returncode */ +iStart = 1; /* Subdirectory Index */ +do while (iStart <= length(sMakefiles)) + iEnd = pos(' ', sMakefiles, iStart); + if (iEnd <= 0 & iStart <= length(sMakefiles)) then + iEnd = length(sMakefiles) + 1; + + if (iEnd > 0) then + do + /* + * Copy out the makefile from sMakefiles. Iterate if empty name. + * Move iStart forward to the next directory i sMakefiles. + * Execute command with makefile as -f argument. + * Check return code. Complain and fail if this failes. + */ + sMakefile = substr(sMakefiles, iStart, iEnd - iStart); + iStart = iEnd + 1; + if (sMakefile = ' ' | sMakefile = '') then/* If empty directory name iterate. */ + iterate; + say sClrMak||'['||sPass||'Processing Makefile:' sMakefile||']'||sClrRst; + sCommand '-f' sMakefile + if (rc <> 0) then + do + say sClrErr||'['||sPass||'Failed rc='rc' makefile:' sMakefile||']'||sClrRst; + exit(rc); + end + say sClrMak||'['||sPass||'Completed Makefile:' sMakefile||']'||sClrRst; + end + else + leave; /* No more directories left. */ +end + + +/* + * Return successfully. + */ +exit(0); + + +/** + * Get environment variable value. + * @returns Environment variable value if set. + * '' if not set. + * @param sVar Variable name. + */ +getenv: procedure +parse arg sVar +return value(sVar,,'OS2ENVIRONMENT'); + +/** + * No value handler + */ +NoValueHandler: + say 'NoValueHandler: line 'SIGL; +return 0; + diff --git a/tools/bin/DoWithDirs.cmd b/tools/bin/DoWithDirs.cmd index 4f717f1..368c6b0 100644 --- a/tools/bin/DoWithDirs.cmd +++ b/tools/bin/DoWithDirs.cmd @@ -1,300 +1,300 @@ -/* $Id: DoWithDirs.cmd,v 1.15 2002-08-29 11:49:37 bird Exp $ - * - * Syntax: dowithdirs.cmd [-e] [-c] [-i] [-l] [-r] - * -e Exclude directories. - * is a INCLUDE-path styled list of directories. - * -c CD into the directory and execute the command. - * Default action is to pass the directory name as last argument. - * -i Ignore command failure (rc=0) - * -r Process diretories in reverse order. - * -l Lock directories for other dowithdirs.cmd processes. (-c required!) - * Processing stops (rc=0) on the first locked directory. - * is a name of the lock. - * -s Skip locked directories in stead of stopping. - * - * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) - */ -signal on novalue name NoValueHandler -Address CMD '@echo off' - -if (RxFuncQuery('SysLoadFuncs') = 1) then -do - call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs' - call SysLoadFuncs -end - - -/* - * Color config. - */ -if ((getenv('BUILD_NOCOLORS') = '') & (getenv('SLKRUNS') = '')) then -do - sClrMak = '' - sClrErr = '' - sClrRst = '' -end -else -do - sClrMak = '' - sClrErr = '' - sClrRst = '' -end - - -/* - * Build Pass - */ -sPass = getenv('_BUILD_PASS'); -if (sPass <> '') then - sPass = 'Pass '||sPass||' - ' - - -/* init options */ -fIgnoreFailure = 0; -asIgnore.0 = 0; -fCD = 0; -fLocking = 0; -fDontStop = 0; -fReverse = 0; -fExitOnLock = 1; -sLockTag = ''; - -/* parse arguments */ -parse arg sArg.1 sArg.2 sArg.3 sArg.4 sArg.5 sArg.6 sArg.7 sArg.8 sArg.9 -sArg.0 = 9; -do i = 1 to sArg.0 - if (sArg.i <> '') then - do - if (substr(sArg.i, 1, 1) = '-') then - do - ch = translate(substr(sArg.i, 2, 1)); - select - when ch = 'E' then - do - sLeft = substr(sArg.i, 3); - do while (sLeft <> '' & sLeft <> ';') - j = asIgnore.0 + 1; - iPos = pos(';', sLeft); - if (iPos < 1) then do - asIgnore.j = sLeft; - sLeft = ''; - asIgnore.0 = j; - end - else do - asIgnore.j = substr(sLeft, 1, iPos - 1); - sLeft = substr(sLeft, iPos + 1); - asIgnore.0 = j; - end - end - /* - do j = 1 to asIgnore.0 - say 'dbg:' asIgnore.j; - end - */ - end - - when ch = 'C' then - do - fCD = 1; - end - - when ch = 'I' then - do - fIgnoreFailure = 1; - end - - when ch = 'R' then - do - fReverse = 1; - end - - when ch = 'L' then - do - fLocking = 1; - sLockTag = substr(sArg.i, 3); - end - - when ch = 'S' then - do - fExitOnLock = 0; - end - - otherwise - say 'unknown argument:' sArg.i; - call syntax; - end - end - else - do /* the rest of the args is part of the cmd */ - sCmds = ''; - do j = i to sArg.0; - if (sArg.j <> '') then - sCmds = sCmds || ' ' || sArg.j; - end - i = sArg.0; - end - end - else - do - say 'missing cmd.'; - call syntax; - end -end - -/* sanity check */ -if (fLocking & \fCD) then -do - say '-l (Locking) requires -cd to be specified!'; - call syntax; -end - -/* process directories */ -rc = SysFileTree('*.', 'asDirs', 'DO'); -if rc <> 0 then do - say sClrErr||'SysFileTree failed rc='rc||sClrRst; - exit(rc); -end - -sArgDirs = ' '; -do ii = 1 to asDirs.0 - /* calculate index */ - if (fReverse) then - i = asDirs.0 - ii + 1; - else - i = ii; - - /* ignore the directory? */ - fFound = 0; - do j = 1 to asIgnore.0 - if translate(asIgnore.j) = translate(filespec('name', asDirs.i)) then - do - fFound = 1; - leave; - end - end - - if \fFound then - do - /* switch execution type. */ - if (fCD) then - do - /* exectute the command in the directory */ - say sClrMak||'['||sPass||'Entering Directory: '||asDirs.i']'||sClrRst; - /* save old dir and enter the new dir. */ - sOldDir = directory(); - call directory asDirs.i; - - /* Lock the directory? */ - fOK = 1; - if (fLocking) then - if (\lockdir(sLockTag)) then - do - if (fExitOnLock) then - do - /* restore old directory and return sucessfully */ - call directory sOldDir; - say sClrMak||'['||sPass||'!Lock found, stops processing.'||']'||sClrRst; - exit(0); - end - say sClrMak||'['||sPass||'!Skipping '||asDirs.i||' - Directory was locked.'||']'||sClrRst; - fOK = 0; - end - - /* continue only if locking was successful. */ - if (fOK) then - do - /* execute command */ - 'call' sCmds; - ret = rc; - - /* unlock directory */ - if (fLocking & fOk) then - call unlockdir sLockTag; - - /* check for return? */ - if (ret <> 0) then - do - /* complain and fail if errors aren't ignored. */ - if (\fIgnoreFailure) then - do - say sClrErr||'['||sPass||'rc = 'ret' '||asDirs.i||']'||sClrErr; - exit(rc); - end - say sClrMak||'['||sPass||'rc = 'ret' '||asDirs.i||']'||sClrRst; - end - end - - /* restore old directory */ - say sClrMak||'['||sPass||'Leaving Directory:' directory()||']'||sClrRst; - call directory sOldDir; - end - else - do - /* execute the command with the directory as the last parameter */ - 'call' sCmds filespec('name', asDirs.i); - if (rc <> 0) then - do - say sClrErr||'['||sPass||'rc = '||rc||']'||sClrRst; - if (\fIgnoreFailure) then - exit(rc); - end - end - end /* loop */ -end - -exit(rc); - - -syntax: - say 'Syntax: dowithdirs.cmd [-e] [-c] [-i] [-l] [-r] '; - say ' -e Exclude directories.'; - say ' is a INCLUDE-path styled list of directories.'; - say ' -c CD into the directory and execute the command.'; - say ' Default action is to pass the directory name as last argument.'; - say ' -i Ignore command failure (rc=0)'; - say ' -r Process diretories in reverse order.'; - say ' -l Lock directories for other dowithdirs.cmd processes. (-c required!)'; - say ' Processing stops (rc=0) on the first locked directory.'; - say ' is a name of the lock.'; - say ' -s Skip locked directories in stead of stopping.' - exit(-1) - - -/* - * Locks the directory by creating a .dirlocked file in the directory. - * Returns 1 on success - * 0 on error - */ -lockdir: procedure - parse arg sTag - rc = stream('.dirlocked' || sTag, 'c', 'open write'); - return substr(rc, 1, 5) = 'READY'; - - -/* - * Unlocks thedirectory by deleting the .dirlocked file. - */ -unlockdir: procedure - parse arg sTag - rc = stream('.dirlocked' || sTag, 'c', 'close'); - call SysFileDelete '.dirlocked' || sTag; - return 0; - - -/** - * Get environment variable value. - * @returns Environment variable value if set. - * '' if not set. - * @param sVar Variable name. - */ -getenv: procedure -parse arg sVar -return value(sVar,,'OS2ENVIRONMENT'); - -/** - * No value handler - */ -NoValueHandler: - say 'NoValueHandler: line 'SIGL; -return 0; - +/* $Id: DoWithDirs.cmd,v 1.15 2002-08-29 11:49:37 bird Exp $ + * + * Syntax: dowithdirs.cmd [-e] [-c] [-i] [-l] [-r] + * -e Exclude directories. + * is a INCLUDE-path styled list of directories. + * -c CD into the directory and execute the command. + * Default action is to pass the directory name as last argument. + * -i Ignore command failure (rc=0) + * -r Process diretories in reverse order. + * -l Lock directories for other dowithdirs.cmd processes. (-c required!) + * Processing stops (rc=0) on the first locked directory. + * is a name of the lock. + * -s Skip locked directories in stead of stopping. + * + * Copyright (c) 1999-2002 knut st. osmundsen (bird@anduin.net) + */ +signal on novalue name NoValueHandler +Address CMD '@echo off' + +if (RxFuncQuery('SysLoadFuncs') = 1) then +do + call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs' + call SysLoadFuncs +end + + +/* + * Color config. + */ +if ((getenv('BUILD_NOCOLORS') = '') & (getenv('SLKRUNS') = '')) then +do + sClrMak = '' + sClrErr = '' + sClrRst = '' +end +else +do + sClrMak = '' + sClrErr = '' + sClrRst = '' +end + + +/* + * Build Pass + */ +sPass = getenv('_BUILD_PASS'); +if (sPass <> '') then + sPass = 'Pass '||sPass||' - ' + + +/* init options */ +fIgnoreFailure = 0; +asIgnore.0 = 0; +fCD = 0; +fLocking = 0; +fDontStop = 0; +fReverse = 0; +fExitOnLock = 1; +sLockTag = ''; + +/* parse arguments */ +parse arg sArg.1 sArg.2 sArg.3 sArg.4 sArg.5 sArg.6 sArg.7 sArg.8 sArg.9 +sArg.0 = 9; +do i = 1 to sArg.0 + if (sArg.i <> '') then + do + if (substr(sArg.i, 1, 1) = '-') then + do + ch = translate(substr(sArg.i, 2, 1)); + select + when ch = 'E' then + do + sLeft = substr(sArg.i, 3); + do while (sLeft <> '' & sLeft <> ';') + j = asIgnore.0 + 1; + iPos = pos(';', sLeft); + if (iPos < 1) then do + asIgnore.j = sLeft; + sLeft = ''; + asIgnore.0 = j; + end + else do + asIgnore.j = substr(sLeft, 1, iPos - 1); + sLeft = substr(sLeft, iPos + 1); + asIgnore.0 = j; + end + end + /* + do j = 1 to asIgnore.0 + say 'dbg:' asIgnore.j; + end + */ + end + + when ch = 'C' then + do + fCD = 1; + end + + when ch = 'I' then + do + fIgnoreFailure = 1; + end + + when ch = 'R' then + do + fReverse = 1; + end + + when ch = 'L' then + do + fLocking = 1; + sLockTag = substr(sArg.i, 3); + end + + when ch = 'S' then + do + fExitOnLock = 0; + end + + otherwise + say 'unknown argument:' sArg.i; + call syntax; + end + end + else + do /* the rest of the args is part of the cmd */ + sCmds = ''; + do j = i to sArg.0; + if (sArg.j <> '') then + sCmds = sCmds || ' ' || sArg.j; + end + i = sArg.0; + end + end + else + do + say 'missing cmd.'; + call syntax; + end +end + +/* sanity check */ +if (fLocking & \fCD) then +do + say '-l (Locking) requires -cd to be specified!'; + call syntax; +end + +/* process directories */ +rc = SysFileTree('*.', 'asDirs', 'DO'); +if rc <> 0 then do + say sClrErr||'SysFileTree failed rc='rc||sClrRst; + exit(rc); +end + +sArgDirs = ' '; +do ii = 1 to asDirs.0 + /* calculate index */ + if (fReverse) then + i = asDirs.0 - ii + 1; + else + i = ii; + + /* ignore the directory? */ + fFound = 0; + do j = 1 to asIgnore.0 + if translate(asIgnore.j) = translate(filespec('name', asDirs.i)) then + do + fFound = 1; + leave; + end + end + + if \fFound then + do + /* switch execution type. */ + if (fCD) then + do + /* exectute the command in the directory */ + say sClrMak||'['||sPass||'Entering Directory: '||asDirs.i']'||sClrRst; + /* save old dir and enter the new dir. */ + sOldDir = directory(); + call directory asDirs.i; + + /* Lock the directory? */ + fOK = 1; + if (fLocking) then + if (\lockdir(sLockTag)) then + do + if (fExitOnLock) then + do + /* restore old directory and return sucessfully */ + call directory sOldDir; + say sClrMak||'['||sPass||'!Lock found, stops processing.'||']'||sClrRst; + exit(0); + end + say sClrMak||'['||sPass||'!Skipping '||asDirs.i||' - Directory was locked.'||']'||sClrRst; + fOK = 0; + end + + /* continue only if locking was successful. */ + if (fOK) then + do + /* execute command */ + 'call' sCmds; + ret = rc; + + /* unlock directory */ + if (fLocking & fOk) then + call unlockdir sLockTag; + + /* check for return? */ + if (ret <> 0) then + do + /* complain and fail if errors aren't ignored. */ + if (\fIgnoreFailure) then + do + say sClrErr||'['||sPass||'rc = 'ret' '||asDirs.i||']'||sClrErr; + exit(rc); + end + say sClrMak||'['||sPass||'rc = 'ret' '||asDirs.i||']'||sClrRst; + end + end + + /* restore old directory */ + say sClrMak||'['||sPass||'Leaving Directory:' directory()||']'||sClrRst; + call directory sOldDir; + end + else + do + /* execute the command with the directory as the last parameter */ + 'call' sCmds filespec('name', asDirs.i); + if (rc <> 0) then + do + say sClrErr||'['||sPass||'rc = '||rc||']'||sClrRst; + if (\fIgnoreFailure) then + exit(rc); + end + end + end /* loop */ +end + +exit(rc); + + +syntax: + say 'Syntax: dowithdirs.cmd [-e] [-c] [-i] [-l] [-r] '; + say ' -e Exclude directories.'; + say ' is a INCLUDE-path styled list of directories.'; + say ' -c CD into the directory and execute the command.'; + say ' Default action is to pass the directory name as last argument.'; + say ' -i Ignore command failure (rc=0)'; + say ' -r Process diretories in reverse order.'; + say ' -l Lock directories for other dowithdirs.cmd processes. (-c required!)'; + say ' Processing stops (rc=0) on the first locked directory.'; + say ' is a name of the lock.'; + say ' -s Skip locked directories in stead of stopping.' + exit(-1) + + +/* + * Locks the directory by creating a .dirlocked file in the directory. + * Returns 1 on success + * 0 on error + */ +lockdir: procedure + parse arg sTag + rc = stream('.dirlocked' || sTag, 'c', 'open write'); + return substr(rc, 1, 5) = 'READY'; + + +/* + * Unlocks thedirectory by deleting the .dirlocked file. + */ +unlockdir: procedure + parse arg sTag + rc = stream('.dirlocked' || sTag, 'c', 'close'); + call SysFileDelete '.dirlocked' || sTag; + return 0; + + +/** + * Get environment variable value. + * @returns Environment variable value if set. + * '' if not set. + * @param sVar Variable name. + */ +getenv: procedure +parse arg sVar +return value(sVar,,'OS2ENVIRONMENT'); + +/** + * No value handler + */ +NoValueHandler: + say 'NoValueHandler: line 'SIGL; +return 0; + diff --git a/tools/bin/ExecExcl.cmd b/tools/bin/ExecExcl.cmd index b493652..4f0c348 100644 --- a/tools/bin/ExecExcl.cmd +++ b/tools/bin/ExecExcl.cmd @@ -1,85 +1,85 @@ -/* $Id: ExecExcl.cmd,v 1.1 2000-11-20 03:49:59 bird Exp $ - * - * Exclusive execute. Intented to fix ILINK problem. - * - * Copyright (c) 2000 knut st. osmundsen (knut.stange.osmundsen@mynd.no) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - -parse arg sLockFile sCmd - -if (sCmd = '') then -do - call syntax; - exit(1); -end - -/* - * Try get the lockfile. - * 25 retries, with 3 seconds wait inbetween. - */ -fLocked = 0; -do i = 1 to 25 - rc = stream(sLockFile, 'c', 'open write'); - if (substr(rc, 1, 5) = 'READY') then do - fLocked = 1; - leave; - end - if (i = 1) then - call RxFuncAdd 'SysSleep', 'RexxUtil', 'SysSleep'; - call SysSleep 3; /* Sleep for three seconds before retrying. */ -end -if (\fLocked) then -do - say 'Error: Failed to get hold of the lockfile "' ||sLockFile|| '"."'; - exit(2); /* We exit here! */ -end - - -/* - * Execute the command and save the result. - */ -sCmd -retRc = rc; - - -/* - * Unlock the file and return saved result. - */ -rc = stream(sLockFile, 'c', 'close'); -exit(retRc); - - - - -/** - * Display syntax. - */ -syntax: procedure - say 'ExecExcl.cmd ' - return; - - - -/* - * Establishes the lock. - * Returns 1 on success - * 0 on error - */ -lock: procedure - parse arg sTag - rc = stream('.dirlocked' || sTag, 'c', 'open write'); - return substr(rc, 1, 5) = 'READY'; - - -/* - * Releases the lock. - */ -unlock: procedure - parse arg sTag - rc = stream('.dirlocked' || sTag, 'c', 'close'); - call SysFileDelete '.dirlocked' || sTag; - return 0; - +/* $Id: ExecExcl.cmd,v 1.1 2000-11-20 03:49:59 bird Exp $ + * + * Exclusive execute. Intented to fix ILINK problem. + * + * Copyright (c) 2000 knut st. osmundsen (knut.stange.osmundsen@mynd.no) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + +parse arg sLockFile sCmd + +if (sCmd = '') then +do + call syntax; + exit(1); +end + +/* + * Try get the lockfile. + * 25 retries, with 3 seconds wait inbetween. + */ +fLocked = 0; +do i = 1 to 25 + rc = stream(sLockFile, 'c', 'open write'); + if (substr(rc, 1, 5) = 'READY') then do + fLocked = 1; + leave; + end + if (i = 1) then + call RxFuncAdd 'SysSleep', 'RexxUtil', 'SysSleep'; + call SysSleep 3; /* Sleep for three seconds before retrying. */ +end +if (\fLocked) then +do + say 'Error: Failed to get hold of the lockfile "' ||sLockFile|| '"."'; + exit(2); /* We exit here! */ +end + + +/* + * Execute the command and save the result. + */ +sCmd +retRc = rc; + + +/* + * Unlock the file and return saved result. + */ +rc = stream(sLockFile, 'c', 'close'); +exit(retRc); + + + + +/** + * Display syntax. + */ +syntax: procedure + say 'ExecExcl.cmd ' + return; + + + +/* + * Establishes the lock. + * Returns 1 on success + * 0 on error + */ +lock: procedure + parse arg sTag + rc = stream('.dirlocked' || sTag, 'c', 'open write'); + return substr(rc, 1, 5) = 'READY'; + + +/* + * Releases the lock. + */ +unlock: procedure + parse arg sTag + rc = stream('.dirlocked' || sTag, 'c', 'close'); + call SysFileDelete '.dirlocked' || sTag; + return 0; + diff --git a/tools/bin/ExecTestcase.cmd b/tools/bin/ExecTestcase.cmd index 7eabefb..17abf70 100644 --- a/tools/bin/ExecTestcase.cmd +++ b/tools/bin/ExecTestcase.cmd @@ -1,62 +1,62 @@ -/* $Id: ExecTestcase.cmd,v 1.2 2002-06-20 02:30:31 bird Exp $ - * - * Executes a testcase writing result to the logfile. - * - * Note. The testcase succeeds if rc=0. - * - * The makefile is appended with the -f option to the commandline. - */ - -/* - * Parse arguments. - */ -parse arg sLogfile sMakefile '"'sDescription'"' sCmd -sMakefile = strip(sMakefile); -sLogFile = strip(sLogFile); -sCmd = strip(sCmd); -sDescription = strip(sDescription); -if (sCmd = '' | sDescription = '') then -do /*usage*/ - say 'syntax error!' - say 'syntax: ExecTestcase.cmd "" ' - exit(16); -end - - -/* - * Color config. - */ -if ( (value('BUILD_NOCOLOR',,'OS2ENVIRONMENT') = ''), - & (value('SLKRUNS',,'OS2ENVIRONMENT') = '')) then -do - sClrMak = '' - sClrErr = '' - sClrRst = '' -end -else -do - sClrMak = '' - sClrErr = '' - sClrRst = '' -end - - -/* - * Execute testcase and log the result. - * Allways return 0. - */ -say sClrMak' ! Executing testcase 'sMakefile'/'sDescription'...'sClrRst -Address CMD sCmd '-f' sMakefile -rcCmd = rc; -if (rcCmd = '0') then -do - Address CMD '@echo Ok -' sMakefile'/'sDescription' >> 'sLogfile - say sClrMak' ! Ok! ('sMakefile'/'sDescription')'sClrRst -end -else -do - Address CMD '@echo Failed - 'sMakefile'/'sDescription' (rc='rcCmd') >> 'sLogfile - say sClrErr' ! Failed! ('sMakefile'/'sDescription')'sClrRst -end -exit(0); - +/* $Id: ExecTestcase.cmd,v 1.2 2002-06-20 02:30:31 bird Exp $ + * + * Executes a testcase writing result to the logfile. + * + * Note. The testcase succeeds if rc=0. + * + * The makefile is appended with the -f option to the commandline. + */ + +/* + * Parse arguments. + */ +parse arg sLogfile sMakefile '"'sDescription'"' sCmd +sMakefile = strip(sMakefile); +sLogFile = strip(sLogFile); +sCmd = strip(sCmd); +sDescription = strip(sDescription); +if (sCmd = '' | sDescription = '') then +do /*usage*/ + say 'syntax error!' + say 'syntax: ExecTestcase.cmd "" ' + exit(16); +end + + +/* + * Color config. + */ +if ( (value('BUILD_NOCOLOR',,'OS2ENVIRONMENT') = ''), + & (value('SLKRUNS',,'OS2ENVIRONMENT') = '')) then +do + sClrMak = '' + sClrErr = '' + sClrRst = '' +end +else +do + sClrMak = '' + sClrErr = '' + sClrRst = '' +end + + +/* + * Execute testcase and log the result. + * Allways return 0. + */ +say sClrMak' ! Executing testcase 'sMakefile'/'sDescription'...'sClrRst +Address CMD sCmd '-f' sMakefile +rcCmd = rc; +if (rcCmd = '0') then +do + Address CMD '@echo Ok -' sMakefile'/'sDescription' >> 'sLogfile + say sClrMak' ! Ok! ('sMakefile'/'sDescription')'sClrRst +end +else +do + Address CMD '@echo Failed - 'sMakefile'/'sDescription' (rc='rcCmd') >> 'sLogfile + say sClrErr' ! Failed! ('sMakefile'/'sDescription')'sClrRst +end +exit(0); + diff --git a/tools/bin/Exists.cmd b/tools/bin/Exists.cmd index a73ee7d..c307b20 100644 --- a/tools/bin/Exists.cmd +++ b/tools/bin/Exists.cmd @@ -1,29 +1,29 @@ -/* $Id: Exists.cmd,v 1.3 2002-05-16 11:50:23 bird Exp $ - * - * Simple rexx util which checks if a file or directory exists. - * - * Syntax: exists.cmd - * Return code: 0 - file exists - * 1 - file doesn't exist. - * - * Copyright (c) 2000-2002 knut st. osmundsen (bird@anduin.net) - * - * GPL - * - */ - parse arg sFile - - if (sFile = '.' | sFile = '..') then - exit(0); - - if (stream(sFile, 'c', 'query exists') = '') then - do /* directory ? */ - if (RxFuncQuery('SysFileTree') = 1) then - call RxFuncAdd 'SysFileTree', 'RexxUtil', 'SysFileTree'; - rc = SysFileTree(sFile, 'sDirs', 'DO'); - if (rc = 0 & sDirs.0 = 1) then - exit(0); - exit(1); - end - exit(0); - +/* $Id: Exists.cmd,v 1.3 2002-05-16 11:50:23 bird Exp $ + * + * Simple rexx util which checks if a file or directory exists. + * + * Syntax: exists.cmd + * Return code: 0 - file exists + * 1 - file doesn't exist. + * + * Copyright (c) 2000-2002 knut st. osmundsen (bird@anduin.net) + * + * GPL + * + */ + parse arg sFile + + if (sFile = '.' | sFile = '..') then + exit(0); + + if (stream(sFile, 'c', 'query exists') = '') then + do /* directory ? */ + if (RxFuncQuery('SysFileTree') = 1) then + call RxFuncAdd 'SysFileTree', 'RexxUtil', 'SysFileTree'; + rc = SysFileTree(sFile, 'sDirs', 'DO'); + if (rc = 0 & sDirs.0 = 1) then + exit(0); + exit(1); + end + exit(0); + diff --git a/tools/bin/MakeBldLevelInfo.cmd b/tools/bin/MakeBldLevelInfo.cmd index 2e60dc6..d5897da 100644 --- a/tools/bin/MakeBldLevelInfo.cmd +++ b/tools/bin/MakeBldLevelInfo.cmd @@ -1,566 +1,566 @@ -/* $Id: MakeBldLevelInfo.cmd,v 1.4 2001-01-26 21:34:28 phaller Exp $ - * - * Adds a Description string to the given .def-file. - * Fills in default values; like build time and host. - * - */ - -if RxFuncQuery('SysLoadFuncs')=1 THEN -DO - call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; - call SysLoadFuncs; -END - -/* - * Set default parameter values. - */ -sDefFileIn = ''; -sDefFileOut = ''; -sASDFeatureId = ''; -sCountryCode = ''; -sDateTime = left(' 'date()' 'time(), 26); -sDescription = 'Odin32'; -sFixPakVer = ''; -sHostname = strip(substr(VALUE('HOSTNAME',,'OS2ENVIRONMENT'), 1, 11)); -sLanguageCode = ''; -sMiniVer = ''; -sVendor = 'Project Odin'; -sVersion = '0.5'; - - -/* - * Parse parameters. - */ -parse arg sArgs -if (sArgs = '') then -do - call syntax; - exit(1); -end - -do while (sArgs <> '') - sArgs = strip(sArgs); - if (substr(sArgs, 1, 1) = '-' | substr(sArgs, 1, 1) = '/') then - do /* - * Option. - */ - ch = translate(substr(sArgs, 2, 1)); - if (pos(ch, 'ACDHLMNPRTV') < 1) then - do - say 'invalid option:' substr(sArgs, 1, 2); - call syntax; - exit(2); - end - - /* get value and advance sArgs to next or to end. */ - if (substr(sArgs, 3, 1) = '"') then - do - iNext = pos('"', sArgs, 4); - fQuote = 1; - end - else - do - iNext = pos(' ', sArgs, 3); - if (iNext <= 0) then - iNext = length(sArgs); - fQuote = 0; - end - - if (iNext > 3 | ch = 'R') then - do - sValue = substr(sArgs, 3 + fQuote, iNext - 3 - fQuote); - sArgs = strip(substr(sArgs, iNext+1)); - /*say 'iNext:' iNext 'sValue:' sValue 'sArgs:' sArgs; */ - - /* check if we're gonna search for something in an file. */ - if (sValue <> '' & pos('#define=', sValue) > 0) then - sValue = LookupDefine(sValue); - end - else - do - say 'syntax error near' substr(sArgs, 1, 2)'.'; - call syntax; - exit(3); - end - - - /* set value */ - select - when (ch = 'A') then /* ASD Feature Id */ - sASDFeatureId = sValue; - - when (ch = 'C') then /* Country code */ - sCountryCode = sValue; - - when (ch = 'D') then /* Description */ - sDescription = sValue; - - when (ch = 'H') then /* Hostname */ - sHostname = sValue; - - when (ch = 'L') then /* Language code */ - sLanguageCode = sValue; - - when (ch = 'M') then /* MiniVer */ - sMiniVer = sValue; - - when (ch = 'N') then /* Vendor */ - sVendor = sValue; - - when (ch = 'R') then /* Vendor */ - sDescription = ReadDescription(sValue, sDefFile); - - when (ch = 'P') then /* Fixpak version */ - sFixPakVer = sValue; - - when (ch = 'T') then /* Date Time */ - sDateTime = sValue; - - when (ch = 'V') then /* Version */ - sVersion = sValue; - - /* Otherwise it's an illegal option */ - otherwise: - say 'invalid option:' substr(sArgs, 1, 2); - call syntax; - exit(2); - end /* select */ - end - else - do /* - * Defition file... - */ - if (sDefFileOut <> '') then - do - say 'Syntax error: Can''t specify more than two defintion files!'; - exit(4); - end - if (sDefFileIn = '') then - parse value sArgs with sDefFileIn' 'sArgs - else - parse value sArgs with sDefFileOut' 'sArgs - sArgs = strip(sArgs); - end -end - - -/* check that a defintion file was specified. */ -if (sDefFileIn = '') then -do - say 'Syntax error: Will have to specify a .def-file to update.'; - call syntax; - exit(5); -end - - -/* - * Trim strings to correct lengths. - */ -sVendor = strip(substr(sVendor, 1, 31)); -if (substr(sDateTime, 1, 1) <> ' ') then - sDateTime = ' ' || sDateTime; -sDateTime = left(sDateTime, 26); -sHostname = strip(substr(sHostname, 1, 11)); -sMiniVer = strip(substr(sMiniVer, 1, 11)); -sDescription = strip(substr(sDescription, 1, 80)); -sCountryCode = strip(substr(sCountryCode, 1, 4)); -sLanguageCode = strip(substr(sLanguageCode, 1, 4)); -sASDFeatureId = strip(substr(sASDFeatureId, 1, 11)); -sFixPakVer = strip(substr(sFixPakVer, 1, 11)); - - -/* - * Signature - */ -sEnhSign = '##1##' - -/* - * Build description string. - */ -sDescription = '@#'sVendor':'sVersion'#@'sEnhSign||, - sDateTime||sHostname||, - ':'sASDFeatureId':'sLanguageCode':'sCountryCode':'sMiniVer||, - '::'sFixPakVer'@@'sDescription; - -/* - * Update .def-file. - */ -rc = UpdateDefFile(sDefFileIn, sDefFileOut, sDescription); -exit(rc); - - -/** - * Display script syntax. - */ -syntax: procedure - say 'Syntax: MakeDesc.cmd [options] [options]' - say ' Defitionfile which will have an DESCRIPTION appended.' - say 'Options:' - say ' -A ASD Feature Id.' - say ' -C Country code.' - say ' -D Description.' - say ' -R[deffile] Read description from .def file.' - say ' -H Hostname.' - say ' -L Language code.' - say ' -M MiniVer.' - say ' -N Vendor.' - say ' -P Fixpak version.' - say ' -T Date Time.' - say ' -V Version.' - say ' could be a double qoute qouted string or a single word.' - say ' You could also reference #defines in C/C++ include files.' - say ' The string should then have this form:' - say ' "#define=,"' - say ''; - - return; - - -/** - * Search for a #define in an C/C++ header or source file. - * - * @returns String containing the defined value - * found for the define in the header file. - * Quits on fatal errors. - * @param A string on the form: "#define=DEFINETOFIND,includefile.h" - * @remark Write only code... - let's hope it works. - */ -LookupDefine: procedure - parse arg '#'sDefine'='sMacro','sIncludeFile - - /* - * Validate parameters. - */ - sMacro = strip(sMacro); - sIncludeFile = strip(sIncludeFile); - if (sMacro = '') then - do - say 'syntax error: #define=,.'; - say ' was empty.'; - exit(-20); - end - if (sIncludeFile = '') then - do - say 'syntax error: #define=,.'; - say ' was empty.'; - exit(-20); - end - - - sIllegal = translate(translate(sMacro),, - '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!',, - 'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_'); - - if (strip(translate(sIllegal, ' ', '!')) <> '') then - do - say 'syntax error: #define=,.'; - say ' contains illegal charater(s).' - say ' 'sMacro; - say ' 'translate(sIllegal, ' ', '!'); - exit(-20); - end - - /* - * Open include file. - */ - sRc = stream(sIncludeFile, 'c', 'open read'); - if (pos('READY', sRc) <> 1) then - do /* search INCLUDE variable */ - sFile = SysSearchPath('INCLUDE', sIncludeFile); - if (sFile = '') then - do - say 'Can''t find include file 'sIncludeFile'.'; - exit(-20); - end - sIncludeFile = sFile; - - sRc = stream(sIncludeFile, 'c', 'open read'); - if (pos('READY', sRc) <> 1) then - do - say 'Failed to open include file' sIncludeFile'.'; - exit(-20); - end - end - - /* - * Search the file line by line. - * We'll check for lines starting with a hash (#) char. - * Then check that the word after the hash is 'define'. - * Then match the next word with the macro name. - * Then then get the next rest of the line to comment or continuation char. - * (continuation is not supported) - * Finally strip quotes. - */ - sValue = ''; - do while (lines(sIncludeFile) > 0) - sLine = strip(linein(sIncludeFile)); - if (sLine = '') then - iterate; - if (substr(sLine, 1, 1) <> '#') then - iterate; - sLine = substr(sLine, 2); - if (word(sLine, 1) <> 'define') then - iterate; - sLine = strip(substr(sLine, wordpos(sLine, 1) + length('define')+1)); - if ( substr(sLine, 1, length(sMacro)) <> sMacro, - | substr(sLine, length(sMacro)+1, 1) <> ' ') then - iterate; - sLine = strip(substr(sLine, length(sMacro) + 1)); - if (sLine = '') then - do - say 'error: #define' sMacro' is empty.'; - call stream sIncludeFile, 'c', 'close'; - exit(-20); - end - - chQuote = substr(sLine, 1, 1); - if (chQuote = '"' | chQuote = "'") then - do /* quoted string */ - iLastQuote = 0; - do forever - iLast = pos(chQuote, sLine, 2); - if (iLast <= 0) then - leave; - if (substr(sLine, iLast, 1) = '\') then - iterate; - iLastQuote = iLast; - leave; - end - - if (iLastQuote <= 0) then - do - say 'C/C++ syntax error in 'sIncludefile': didn''t find end quote.'; - call stream sIncludeFile, 'c', 'close'; - exit(-20); - end - - call stream sIncludeFile, 'c', 'close'; - sValue = substr(sLine, 2, iLastQuote - 2); - say 'Found 'sMacro'='sValue; - return sValue; - end - else - do - iCommentCPP = pos('//',sLine); - iCommentC = pos('/*',sLine); - if (iCommentC > 0 & iCommentCPP > 0 & iCommentC > iCommentCPP) then - iComment = iCommentCPP; - else if (iCommentC > 0 & iCommentCPP > 0 & iCommentC < iCommentCPP) then - iComment = iCommentC; - else if (iCommentCPP > 0) then - iComment = iCommentCPP; - else if (iCommentC > 0) then - iComment = iCommentC; - else - iComment = 0; - - if (iComment > 0) then - sValue = strip(substr(sLine, 1, iComment-1)); - else - sValue = strip(sLine); - - if (sValue <> '') then - do - if (substr(sValue, length(sValue)) = '\') then - do - say 'Found continuation char: Multiline definitions are not supported!\n'; - call stream sIncludeFile, 'c', 'close'; - exit(-20); - end - end - - if (sValue = '') then - say 'warning: The #define has no value.'; - - call stream sIncludeFile, 'c', 'close'; - say 'Found 'sMacro'='sValue; - return sValue; - end - end - - call stream sIncludeFile, 'c', 'close'; - say 'error: didn''t find #define' sMacro'.'; - exit(-20); - - - -/** - * Reads the description line for a .def-file. - * @returns The Description string, with quotes removed. - * Empty string is acceptable. - * On error we'll terminate the script. - * @param sDefFile Filaname of .def-file to read the description from. - * @param sDefFile2 Used if sDefFile is empty. - * @author knut st. osmundsen (knut.stange.osmundsen@mynd.no) - */ -ReadDescription: procedure; - parse arg sDefFile, sDefFile2 - - /* - * Validate parameters. - */ - if (sDefFile = '') then - sDefFile = sDefFile2; - if (sDefFile = '') then - do - say 'error: no definition file to get description from.' - exit(-1); - end - - /* - * Open file - */ - rc = stream(sDefFile, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - do - say 'error: failed to open deffile file.'; - exit(-1); - end - - - /* - * Search for the 'DESCRIPTION' line. - */ - do while (lines(sDefFile) > 0) - sLine = strip(linein(sDefFile)); - if (sLine = '') then - iterate; - if (translate(word(sLine, 1)) <> 'DESCRIPTION') then - iterate; - sLine = strip(substr(sLine, wordpos(sLine, 1) + length('DESCRIPTION')+1)); - - ch = substr(sLine, 1, 1); - if (ch <> "'" & ch <> '"') then - do - say 'syntax error: description line in' sDefFile 'is misformed.'; - call stream sDefFile, 'c', 'close'; - exit(-10); - end - - iEnd = pos(ch, sLine, 2); - if (iEnd <= 0) then - do - say 'syntax error: description line in' sDefFile 'is misformed.'; - call stream sDefFile, 'c', 'close'; - exit(-10); - end - - call stream sDefFile, 'c', 'close'; - sValue = substr(sLine, 2, iEnd - 2); - say 'Found Description:' sValue; - return sValue; - end - - call stream sDefFile, 'c', 'close'; - say 'info: Didn''t find description line in' sDefFile'.'; - return ''; - - -/** - * This is a function which reads sDefFileIn into and - * internal array and changes the DESCRIPTION text if found. - * If DESCRIPTION isn't found, it is added at the end. - * The array is written to sDefFileOut. - * @returns 0 on succes. - * Errorcode on error. - * @param sDefFileIn Input .def-file. - * @param sDefFileOut Output .def-file. Overwritten. - * @param sDescription New description string. - * @author knut st. osmundsen (knut.stange.osmundsen@mynd.no) - */ -UpdateDefFile: procedure; - parse arg sDefFileIn, sDefFileOut, sDescription - - /* - * Validate parameters. - */ - if (sDefFileOut = '') then - sDefFileOut = sDefFileIn; - - /* - * Open file input file. - */ - rc = stream(sDefFileIn, 'c', 'open read'); - if (pos('READY', rc) <> 1) then - do - say 'error: failed to open' sDefFileIn 'file.'; - return 110; - end - - - /* - * Search for the 'DESCRIPTION' line. - */ - i = 0; - fDescription = 0; - do while (lines(sDefFileIn) > 0) - /* - * Read line. - */ - i = i + 1; - asFile.i = strip(linein(sDefFileIn)); - - /* - * Look for DESCRIPTION; - */ - if (asFile.i = '') then - iterate; - if (translate(word(asFile.i, 1)) <> 'DESCRIPTION') then - iterate; - if (fDescription) then - do - say 'warning: multiple descriptions lines. Line' i 'removed'; - i = i - 1; - iterate; - end - - /* - * Found description - replace with new description. - */ - asFile.i = "DESCRIPTION '"||sDescription||"'"; - fDescription = 1; - end - - /* - * Add description is none was found. - */ - if (\fDescription) then - do - i = i + 1; - asFile.i = "DESCRIPTION '"||sDescription||"'"; - end - asFile.0 = i; - - - /* - * Close input file and open output file. - */ - call stream sDefFileIn, 'c', 'close'; - call SysFileDelete(sDefFileOut); - rc = stream(sDefFileOut, 'c', 'open write'); - if (pos('READY', rc) <> 1) then - do - say 'error: failed to open outputfile' sDefFileOut 'file.'; - return 110; - end - - /* - * Make firstline and write all the lines to the output file. - */ - call lineout sDefFileOut, '; Updated by makedesc.cmd', 1; - do i = 1 to asFile.0 - rc = lineout(sDefFileOut, asFile.i); - if (rc > 0) then - do - say 'error: failed to write line' i 'to' sDefFileOut'.' - call stream sDefFileOut, 'c', 'close'; - return 5; - end - end - - /* - * Close output file and return succesfully. - */ - call stream sDefFileOut, 'c', 'close'; - return 0; - +/* $Id: MakeBldLevelInfo.cmd,v 1.4 2001-01-26 21:34:28 phaller Exp $ + * + * Adds a Description string to the given .def-file. + * Fills in default values; like build time and host. + * + */ + +if RxFuncQuery('SysLoadFuncs')=1 THEN +DO + call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; + call SysLoadFuncs; +END + +/* + * Set default parameter values. + */ +sDefFileIn = ''; +sDefFileOut = ''; +sASDFeatureId = ''; +sCountryCode = ''; +sDateTime = left(' 'date()' 'time(), 26); +sDescription = 'Odin32'; +sFixPakVer = ''; +sHostname = strip(substr(VALUE('HOSTNAME',,'OS2ENVIRONMENT'), 1, 11)); +sLanguageCode = ''; +sMiniVer = ''; +sVendor = 'Project Odin'; +sVersion = '0.5'; + + +/* + * Parse parameters. + */ +parse arg sArgs +if (sArgs = '') then +do + call syntax; + exit(1); +end + +do while (sArgs <> '') + sArgs = strip(sArgs); + if (substr(sArgs, 1, 1) = '-' | substr(sArgs, 1, 1) = '/') then + do /* + * Option. + */ + ch = translate(substr(sArgs, 2, 1)); + if (pos(ch, 'ACDHLMNPRTV') < 1) then + do + say 'invalid option:' substr(sArgs, 1, 2); + call syntax; + exit(2); + end + + /* get value and advance sArgs to next or to end. */ + if (substr(sArgs, 3, 1) = '"') then + do + iNext = pos('"', sArgs, 4); + fQuote = 1; + end + else + do + iNext = pos(' ', sArgs, 3); + if (iNext <= 0) then + iNext = length(sArgs); + fQuote = 0; + end + + if (iNext > 3 | ch = 'R') then + do + sValue = substr(sArgs, 3 + fQuote, iNext - 3 - fQuote); + sArgs = strip(substr(sArgs, iNext+1)); + /*say 'iNext:' iNext 'sValue:' sValue 'sArgs:' sArgs; */ + + /* check if we're gonna search for something in an file. */ + if (sValue <> '' & pos('#define=', sValue) > 0) then + sValue = LookupDefine(sValue); + end + else + do + say 'syntax error near' substr(sArgs, 1, 2)'.'; + call syntax; + exit(3); + end + + + /* set value */ + select + when (ch = 'A') then /* ASD Feature Id */ + sASDFeatureId = sValue; + + when (ch = 'C') then /* Country code */ + sCountryCode = sValue; + + when (ch = 'D') then /* Description */ + sDescription = sValue; + + when (ch = 'H') then /* Hostname */ + sHostname = sValue; + + when (ch = 'L') then /* Language code */ + sLanguageCode = sValue; + + when (ch = 'M') then /* MiniVer */ + sMiniVer = sValue; + + when (ch = 'N') then /* Vendor */ + sVendor = sValue; + + when (ch = 'R') then /* Vendor */ + sDescription = ReadDescription(sValue, sDefFile); + + when (ch = 'P') then /* Fixpak version */ + sFixPakVer = sValue; + + when (ch = 'T') then /* Date Time */ + sDateTime = sValue; + + when (ch = 'V') then /* Version */ + sVersion = sValue; + + /* Otherwise it's an illegal option */ + otherwise: + say 'invalid option:' substr(sArgs, 1, 2); + call syntax; + exit(2); + end /* select */ + end + else + do /* + * Defition file... + */ + if (sDefFileOut <> '') then + do + say 'Syntax error: Can''t specify more than two defintion files!'; + exit(4); + end + if (sDefFileIn = '') then + parse value sArgs with sDefFileIn' 'sArgs + else + parse value sArgs with sDefFileOut' 'sArgs + sArgs = strip(sArgs); + end +end + + +/* check that a defintion file was specified. */ +if (sDefFileIn = '') then +do + say 'Syntax error: Will have to specify a .def-file to update.'; + call syntax; + exit(5); +end + + +/* + * Trim strings to correct lengths. + */ +sVendor = strip(substr(sVendor, 1, 31)); +if (substr(sDateTime, 1, 1) <> ' ') then + sDateTime = ' ' || sDateTime; +sDateTime = left(sDateTime, 26); +sHostname = strip(substr(sHostname, 1, 11)); +sMiniVer = strip(substr(sMiniVer, 1, 11)); +sDescription = strip(substr(sDescription, 1, 80)); +sCountryCode = strip(substr(sCountryCode, 1, 4)); +sLanguageCode = strip(substr(sLanguageCode, 1, 4)); +sASDFeatureId = strip(substr(sASDFeatureId, 1, 11)); +sFixPakVer = strip(substr(sFixPakVer, 1, 11)); + + +/* + * Signature + */ +sEnhSign = '##1##' + +/* + * Build description string. + */ +sDescription = '@#'sVendor':'sVersion'#@'sEnhSign||, + sDateTime||sHostname||, + ':'sASDFeatureId':'sLanguageCode':'sCountryCode':'sMiniVer||, + '::'sFixPakVer'@@'sDescription; + +/* + * Update .def-file. + */ +rc = UpdateDefFile(sDefFileIn, sDefFileOut, sDescription); +exit(rc); + + +/** + * Display script syntax. + */ +syntax: procedure + say 'Syntax: MakeDesc.cmd [options] [options]' + say ' Defitionfile which will have an DESCRIPTION appended.' + say 'Options:' + say ' -A ASD Feature Id.' + say ' -C Country code.' + say ' -D Description.' + say ' -R[deffile] Read description from .def file.' + say ' -H Hostname.' + say ' -L Language code.' + say ' -M MiniVer.' + say ' -N Vendor.' + say ' -P Fixpak version.' + say ' -T Date Time.' + say ' -V Version.' + say ' could be a double qoute qouted string or a single word.' + say ' You could also reference #defines in C/C++ include files.' + say ' The string should then have this form:' + say ' "#define=,"' + say ''; + + return; + + +/** + * Search for a #define in an C/C++ header or source file. + * + * @returns String containing the defined value + * found for the define in the header file. + * Quits on fatal errors. + * @param A string on the form: "#define=DEFINETOFIND,includefile.h" + * @remark Write only code... - let's hope it works. + */ +LookupDefine: procedure + parse arg '#'sDefine'='sMacro','sIncludeFile + + /* + * Validate parameters. + */ + sMacro = strip(sMacro); + sIncludeFile = strip(sIncludeFile); + if (sMacro = '') then + do + say 'syntax error: #define=,.'; + say ' was empty.'; + exit(-20); + end + if (sIncludeFile = '') then + do + say 'syntax error: #define=,.'; + say ' was empty.'; + exit(-20); + end + + + sIllegal = translate(translate(sMacro),, + '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!',, + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_'); + + if (strip(translate(sIllegal, ' ', '!')) <> '') then + do + say 'syntax error: #define=,.'; + say ' contains illegal charater(s).' + say ' 'sMacro; + say ' 'translate(sIllegal, ' ', '!'); + exit(-20); + end + + /* + * Open include file. + */ + sRc = stream(sIncludeFile, 'c', 'open read'); + if (pos('READY', sRc) <> 1) then + do /* search INCLUDE variable */ + sFile = SysSearchPath('INCLUDE', sIncludeFile); + if (sFile = '') then + do + say 'Can''t find include file 'sIncludeFile'.'; + exit(-20); + end + sIncludeFile = sFile; + + sRc = stream(sIncludeFile, 'c', 'open read'); + if (pos('READY', sRc) <> 1) then + do + say 'Failed to open include file' sIncludeFile'.'; + exit(-20); + end + end + + /* + * Search the file line by line. + * We'll check for lines starting with a hash (#) char. + * Then check that the word after the hash is 'define'. + * Then match the next word with the macro name. + * Then then get the next rest of the line to comment or continuation char. + * (continuation is not supported) + * Finally strip quotes. + */ + sValue = ''; + do while (lines(sIncludeFile) > 0) + sLine = strip(linein(sIncludeFile)); + if (sLine = '') then + iterate; + if (substr(sLine, 1, 1) <> '#') then + iterate; + sLine = substr(sLine, 2); + if (word(sLine, 1) <> 'define') then + iterate; + sLine = strip(substr(sLine, wordpos(sLine, 1) + length('define')+1)); + if ( substr(sLine, 1, length(sMacro)) <> sMacro, + | substr(sLine, length(sMacro)+1, 1) <> ' ') then + iterate; + sLine = strip(substr(sLine, length(sMacro) + 1)); + if (sLine = '') then + do + say 'error: #define' sMacro' is empty.'; + call stream sIncludeFile, 'c', 'close'; + exit(-20); + end + + chQuote = substr(sLine, 1, 1); + if (chQuote = '"' | chQuote = "'") then + do /* quoted string */ + iLastQuote = 0; + do forever + iLast = pos(chQuote, sLine, 2); + if (iLast <= 0) then + leave; + if (substr(sLine, iLast, 1) = '\') then + iterate; + iLastQuote = iLast; + leave; + end + + if (iLastQuote <= 0) then + do + say 'C/C++ syntax error in 'sIncludefile': didn''t find end quote.'; + call stream sIncludeFile, 'c', 'close'; + exit(-20); + end + + call stream sIncludeFile, 'c', 'close'; + sValue = substr(sLine, 2, iLastQuote - 2); + say 'Found 'sMacro'='sValue; + return sValue; + end + else + do + iCommentCPP = pos('//',sLine); + iCommentC = pos('/*',sLine); + if (iCommentC > 0 & iCommentCPP > 0 & iCommentC > iCommentCPP) then + iComment = iCommentCPP; + else if (iCommentC > 0 & iCommentCPP > 0 & iCommentC < iCommentCPP) then + iComment = iCommentC; + else if (iCommentCPP > 0) then + iComment = iCommentCPP; + else if (iCommentC > 0) then + iComment = iCommentC; + else + iComment = 0; + + if (iComment > 0) then + sValue = strip(substr(sLine, 1, iComment-1)); + else + sValue = strip(sLine); + + if (sValue <> '') then + do + if (substr(sValue, length(sValue)) = '\') then + do + say 'Found continuation char: Multiline definitions are not supported!\n'; + call stream sIncludeFile, 'c', 'close'; + exit(-20); + end + end + + if (sValue = '') then + say 'warning: The #define has no value.'; + + call stream sIncludeFile, 'c', 'close'; + say 'Found 'sMacro'='sValue; + return sValue; + end + end + + call stream sIncludeFile, 'c', 'close'; + say 'error: didn''t find #define' sMacro'.'; + exit(-20); + + + +/** + * Reads the description line for a .def-file. + * @returns The Description string, with quotes removed. + * Empty string is acceptable. + * On error we'll terminate the script. + * @param sDefFile Filaname of .def-file to read the description from. + * @param sDefFile2 Used if sDefFile is empty. + * @author knut st. osmundsen (knut.stange.osmundsen@mynd.no) + */ +ReadDescription: procedure; + parse arg sDefFile, sDefFile2 + + /* + * Validate parameters. + */ + if (sDefFile = '') then + sDefFile = sDefFile2; + if (sDefFile = '') then + do + say 'error: no definition file to get description from.' + exit(-1); + end + + /* + * Open file + */ + rc = stream(sDefFile, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + do + say 'error: failed to open deffile file.'; + exit(-1); + end + + + /* + * Search for the 'DESCRIPTION' line. + */ + do while (lines(sDefFile) > 0) + sLine = strip(linein(sDefFile)); + if (sLine = '') then + iterate; + if (translate(word(sLine, 1)) <> 'DESCRIPTION') then + iterate; + sLine = strip(substr(sLine, wordpos(sLine, 1) + length('DESCRIPTION')+1)); + + ch = substr(sLine, 1, 1); + if (ch <> "'" & ch <> '"') then + do + say 'syntax error: description line in' sDefFile 'is misformed.'; + call stream sDefFile, 'c', 'close'; + exit(-10); + end + + iEnd = pos(ch, sLine, 2); + if (iEnd <= 0) then + do + say 'syntax error: description line in' sDefFile 'is misformed.'; + call stream sDefFile, 'c', 'close'; + exit(-10); + end + + call stream sDefFile, 'c', 'close'; + sValue = substr(sLine, 2, iEnd - 2); + say 'Found Description:' sValue; + return sValue; + end + + call stream sDefFile, 'c', 'close'; + say 'info: Didn''t find description line in' sDefFile'.'; + return ''; + + +/** + * This is a function which reads sDefFileIn into and + * internal array and changes the DESCRIPTION text if found. + * If DESCRIPTION isn't found, it is added at the end. + * The array is written to sDefFileOut. + * @returns 0 on succes. + * Errorcode on error. + * @param sDefFileIn Input .def-file. + * @param sDefFileOut Output .def-file. Overwritten. + * @param sDescription New description string. + * @author knut st. osmundsen (knut.stange.osmundsen@mynd.no) + */ +UpdateDefFile: procedure; + parse arg sDefFileIn, sDefFileOut, sDescription + + /* + * Validate parameters. + */ + if (sDefFileOut = '') then + sDefFileOut = sDefFileIn; + + /* + * Open file input file. + */ + rc = stream(sDefFileIn, 'c', 'open read'); + if (pos('READY', rc) <> 1) then + do + say 'error: failed to open' sDefFileIn 'file.'; + return 110; + end + + + /* + * Search for the 'DESCRIPTION' line. + */ + i = 0; + fDescription = 0; + do while (lines(sDefFileIn) > 0) + /* + * Read line. + */ + i = i + 1; + asFile.i = strip(linein(sDefFileIn)); + + /* + * Look for DESCRIPTION; + */ + if (asFile.i = '') then + iterate; + if (translate(word(asFile.i, 1)) <> 'DESCRIPTION') then + iterate; + if (fDescription) then + do + say 'warning: multiple descriptions lines. Line' i 'removed'; + i = i - 1; + iterate; + end + + /* + * Found description - replace with new description. + */ + asFile.i = "DESCRIPTION '"||sDescription||"'"; + fDescription = 1; + end + + /* + * Add description is none was found. + */ + if (\fDescription) then + do + i = i + 1; + asFile.i = "DESCRIPTION '"||sDescription||"'"; + end + asFile.0 = i; + + + /* + * Close input file and open output file. + */ + call stream sDefFileIn, 'c', 'close'; + call SysFileDelete(sDefFileOut); + rc = stream(sDefFileOut, 'c', 'open write'); + if (pos('READY', rc) <> 1) then + do + say 'error: failed to open outputfile' sDefFileOut 'file.'; + return 110; + end + + /* + * Make firstline and write all the lines to the output file. + */ + call lineout sDefFileOut, '; Updated by makedesc.cmd', 1; + do i = 1 to asFile.0 + rc = lineout(sDefFileOut, asFile.i); + if (rc > 0) then + do + say 'error: failed to write line' i 'to' sDefFileOut'.' + call stream sDefFileOut, 'c', 'close'; + return 5; + end + end + + /* + * Close output file and return succesfully. + */ + call stream sDefFileOut, 'c', 'close'; + return 0; + diff --git a/tools/bin/MapSym.cmd b/tools/bin/MapSym.cmd index cf74d99..c187eaf 100644 --- a/tools/bin/MapSym.cmd +++ b/tools/bin/MapSym.cmd @@ -1,692 +1,692 @@ -/* $Id: MapSym.cmd,v 1.8 2002-08-29 10:04:10 bird Exp $ - * - * Helper script for calling MAPSYM.EXE. - * - * Copyright (c) 2002 knut st. osmundsen (bird@anduin.net) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - -/* - * Configuration. - */ -sWatcom = ';wat11c;wat11;watcom;wat11c-16;wat11-16;wlink;wlink.exe;' -sIBMOld = ';vac3xx;vac365;vac308;emx;emxpgcc;mscv6;mscv6-16;ilink;ilink.exe;link386;link386.exe;link;link.exe;ibmold;' -sVAC40 = ';vac40;' -sLinkers = strip(sVAC40, 'T', ';')||strip(sIBMOld, 'T', ';')||strip(sWatcom, 'T', ';')||';' -/* look for 4os2 */ -f4OS2 = 0; -Address CMD 'set 4os2test_env=%@eval[2 + 2]'; -if (value('4os2test_env',, 'OS2ENVIRONMENT') = '4') then - f4OS2 = 1; -sCopy = '@copy' -if (f4OS2) then - sCopy = '@copy /Q' - -/* - * Parse arguments. - */ -parse arg sLinker sMapfile sSymFile sDummy - -if ( (sDummy <> '') , - | (sMapFile = '') , - | (pos(';'translate(sLinker)';', translate(sLinkers)) <= 0) , - ) -then -do - say 'syntax error'; - call syntax; - exit(16); -end -if (stream(sMapFile, 'c', 'query exist') = '') then -do - say 'error: the mapfile '''sMapFile''' doesn''t exist.'; - call syntax; - exit(16); -end - -sMapBaseName = filespec('name', sMapFile); -if (pos('.', sMapBaseName) > 0) then - sMapBaseName = left(sMapBaseName, pos('.', sMapBaseName) - 1); - -if (sSymFile = '') then -do - if (lastpos('.', filespec('name', sMapFile)) > 0) then - sSymFile = left(sMapFile, lastpos('.', sMapFile)) || 'sym'; - else - sSymFile = sMapFile || '.sym'; -end - - -/* - * Convert linker input. - */ -sLinker = translate(sLinker); /* easier to compare */ -if (pos(';'||sLinker||';', translate(sWatcom)) > 0) then - sLinker = 'WATCOM'; -if (pos(';'||sLinker||';', translate(sIBMOld)) > 0) then - sLinker = 'IBMOLD'; -if (pos(';'||sLinker||';', translate(sVAC40)) > 0) then - sLinker = 'VAC40'; - -/* - * Load rexxutil functions. - */ -call RxFuncAdd 'SysLoadFuncs','RexxUtil','SysLoadFuncs' -call SysLoadFuncs - - -/* - * Get the temp directory. - */ -sTmp = value('TMP',, 'OS2ENVIRONMENT'); -if (sTmp = '') then - sTmp = value('TEMP',, 'OS2ENVIRONMENT'); -if (sTmp = '') then - sTmp = value('TMPDIR',, 'OS2ENVIRONMENT'); -if (sTmp = '') then - sTmp = value('TEMPDIR',, 'OS2ENVIRONMENT'); -if (sTmp = '') then -do - say 'Fatal error: Hey mister! don''t you have a tmp directory?' - exit(16); -end -sTmp = strip(strip(sTmp, 'T', '\'), 'T','/'); - - -/* - * Make temporary filename. - * (We'll make a workcopy, modified for some linkers, of the mapfile - * to this file. And call mapsym on it.) - */ -sTmpMapFile = SysTempFileName(sTmp'\'||sMapBaseName||'.???'); -if (sTmpMapFile = '') then -do - say 'error: failed to make temporary file!'; - exit(16); -end - - -/* - * Do pre mapsym.exe processing of the sym file. - */ -select - when (sLinker = 'IBMOLD') then - do - sCopy sMapFile sTmpMapFile - if (rc <> 0) then - do - say 'error: failed to copy '''sMapFile''' to '''sTmpMapFile'''. (rc='rc')'; - exit(16); - end - end - - when (sLinker = 'WATCOM') then - do - /*sTmpMapFile = 'watos2.map'*/ - rc = wat2map(sMapFile, sTmpMapFile); - if (rc <> 0) then - do - say 'error: wat2map failed. (rc='rc')'; - exit(16); - end - end - - when (sLinker = 'VAC40') then - do - rc = vac40conv(sMapFile, sTmpMapFile); - if (rc <> 0) then - do - say 'error: vac40conv failed. (rc='rc')'; - exit(16); - end - end - - otherwise - say 'bad linker, sLinker='sLinker; - exit(16); -end - - -/* - * Call mapsym.exe - */ -sOldDir = directory(); -call directory(sTmp); -'@mapsym.exe' sTmpMapFile -if (rc <> 0) then -do - say 'error: mapsym.exe '''sTmpMapFile''' failed with rc='rc'.'; - call directory(sOldDir); - exit(rc); -end -call directory(sOldDir); - - - -/* - * Copy the symfile to the target path. - */ -sCopy left(sTmpMapFile, length(sTmpMapFile) - 4)||'.sym' sSymFile; -if (rc <> 0) then -do - say 'error: failed to copy '''left(sTmpMapFile, length(sTmpMapFile) - 4)||'.sym'' to '''sSymFile'''. (rc='rc')'; - exit(16); -end - -/* - * Delete temporary files. - */ -call SysFileDelete sTmpMapFile; -call SysFileDelete left(sTmpMapFile, length(sTmpMapFile) - 4)||'.sym'; - -exit(0); - - - -/******************************************************************************* -* Function Area * -*******************************************************************************/ - - -/** - * Display usage info. - */ -syntax: procedure; - say 'syntax: MapSym.cmd [symfile]'; - say ' linker watcom, vac3xx, link386 or vac40. All $(BUILD_ENV).'; - say ' mapfile Name of the input map file.'; - say ' symfile Name of the output sym file. If not specified'; - say ' mapfile is used as a base name.'; -return 0; - - -/** - * Converts a vac40 mapfile to a file readable for mapsym.exe. - * @returns 0 on success. - * !0 on error. - * @param sInFile Input vac40 mapfile. - * @param sOutFile Output filename. - * @status completely implemented. - * @author knut st. osmundsen (bird@anduin.net) - * @remark Make some assume about the module name. Not sure if it matters. - */ -vac40conv: procedure; - parse arg sInFile, sOutFile; - - /* - * variables. - */ - rc = 0; - sState = 'Init'; /* shows the current content status. */ - - /* - * Read file line by line. - */ - do while ((rc = 0) & (lines(sInFile) > 0)) - /* - * Read the line and look for state change. - */ - sLine = linein(sInFile); - sNewState = vac40ProbeState(sState, sLine); - - /* - * State switch. - */ - select - /* - * First line. - */ - when (sState = 'Init') then - do - if (pos('Link Map...', sLine) <= 0) then - do - say 'error: Not VAC40 map file.' - rc = 1; - end - - call lineout sOutFile, ''; - sModName = translate(filespec('name',sInFile)); - if (lastpos('.', sModName) > 0) then sModName = left(sModName, lastpos('.', sModName) - 1); - call lineout sOutFile, ' '||sModName; - call lineout sOutFile, ''; - sNewState = 'AnyState'; - end - - /* - * Segments - let's try copy then raw. - */ - when ((sNewState = 'Segments') | (sState = 'Segments')) then - do - if (sState <> 'Segments') then - do - sSegment = ''; - cbSegment = 0; - call lineout sOutFile, ' Start Length Name Class' - end - else - do - if (pos('at offset', sLine) > 0) then - do /* - * At offset line: - * at offset 000006A8 bytes 00006H for "@197" - */ - parse var sLine . 'offset' sOffset 'bytes' sLength'H' . . - /*say 'off='sOffset 'len='sLength 'line:' left(sLine, 40);*/ - cbSegment = HexToDec(sOffset) + HexToDec(sLength); - end - else if ( (sNewState = 'Segments') & (sSegment = ''), - & (strip(sLine) <> '') & (pos(':', sLine) > 0) ) then - do /* - * New segment. - */ - /*say 'NewSeg:' sLine*/ - sSegment = sLine; - end - else if ((strip(sLine) = '') & (sSegment <> '')) then - do /* - * Time to write segment line: - * 0001:00000000 DATA32 DATA - */ - sSegment = translate(sSegment, ' ', '09'x); - parse var sSegment iSeg':'iSegOffset sSegName sSegClass - /*say 'SegLn: seg='iSeg 'off='iSegOffset 'name='sSegName 'class='sSegClass; say sSegment*/ - if (length(sSegName) < 22) then sSegName = left(sSegName, 22, ' '); - call lineout sOutFile, ' '||strip(iSeg)':'iSegOffset right(DecToHex(cbSegment), 9, '0'), - ||'H '||sSegName||' '||strip(sSegClass); - sSegment = ''; - cbSegment = 0; - end - end - end - - /* - * Publics by value - filter out some of the stupid stuff. - */ - when ((sNewState = 'PublicValue') | (sState = 'PublicValue')) then - do - if (sState = sNewState) then - do - sLine = translate(sLine, '', '"'||d2c(9)); - if ((strip(sLine) <> '') & (pos('|', sLine) <= 0) & (pos('@', sLine) <= 0)) then - call lineout sOutFile, ' '||word(sLine, 1)||' '||word(sLine, 2); - end - else if (sNewState = 'PublicValue') then - do /* first call */ - call lineout sOutFile, ''; - call lineout sOutFile, ' Address Publics by Value'; - end - end - - /* - * Entry pointe - raw copy. - */ - when (sNewState = 'EntryPoint') then - do - call lineout sOutFile, ''; - call lineout sOutFile, sLine; - sNewState = 'Stop'; - end - - /* - * Got to next state. - */ - when (sState = 'AnyState') then - do - if (strip(sLine) = '') then - iterate; - if (sNewState = sState) then - do - say 'state error, bad input?'; - rc = 2; - end - end - - /* - * Skips till we hit a new state. - */ - when (sState = 'Skip') then - nop; - /* debug */ - when ((sState = 'ImportsName') | (sState = 'PublicNames') | (sState = 'ImportLibs') | (sState = 'ConstDest')) then - nop; - - /* - * Final. - */ - when (sState = 'Stop') then - leave; - - /* - * Should not happen. - */ - otherwise - do - say 'bad state, sState='sState; - rc = 3; - end - end /* select */ - - /* - * next state - */ - /*say 'state debug:' sState '->' sNewState 'ln:' left(sLine, 40)*/ - sState = sNewState; - end /* do while */ - - /* - * cleanup. - */ - call stream sOutFile, 'c', 'close' - call stream sMapfile, 'c', 'close' - -return rc; - - -/** - * Checks if this line is recognizes as a state change line. - * @returns New state. - * @param sState The current state. - * @param sLine The input line we're processing. - */ -vac40ProbeState: procedure - parse arg sState, sLine - select - when (pos('...Options...', sLine) > 0) then sState = 'Skip'; - when (pos('...Segments...', sLine) > 0) then sState = 'Segments'; - when (pos('...Constructor/Destructor pairs to run...', sLine) > 0) then sState = 'ConstDest'; - when (pos('Imports by name', sLine) > 0) then sState = 'ImportsName'; - when (pos('Publics by name', sLine) > 0) then sState = 'PublicNames'; - when (pos('Publics by value', sLine) > 0) then sState = 'PublicValue'; - when (pos('...Import library list...', sLine) > 0) then sState = 'ImportLibs'; - when (pos('Line numbers for', sLine) > 0) then sState = 'Skip'; - when (pos('Program entry point', sLine) > 0) then sState = 'EntryPoint'; - otherwise - nop; - end -return sState; - - - -/** - * Converts a hex string (no prefix/postfix) to a decimal value. - * @returns decimal value. - * @param sStringHex Hexstring to convert. (no 0x prefix or H postfix!) - * @status completely implemented. - * @author knut st. osmundsen (bird@anduin.net) - */ -HexToDec: procedure - parse arg sStringHex -/* say 'HexToDec('sStringHex'):' strip(strip(sStringHex), 'L', '0')*/ - sStringHex = strip(strip(sStringHex), 'L', '0'); - if (sStringHex = '') then - sStringHex = 0; -return x2d(sStringHex); - - -/** - * Converts a dec string to a hex string. - * @returns hex string value. - * @param sStringDec Decstring to convert. - * @status completely implemented. - * @author knut st. osmundsen (bird@anduin.net) - */ -DecToHex: procedure - parse arg sStringDec - sStringDec = strip(strip(sStringDec), 'L', '0'); - if (sStringDec = '') then - sStringDec = 0; -return d2x(sStringDec); - - -/* SCCSID = %W% %E% */ -/**************************************************************************** - * * - * Copyright (c) IBM Corporation 1994 - 1997. * - * * - * The following IBM OS/2 source code is provided to you solely for the * - * the purpose of assisting you in your development of OS/2 device drivers. * - * You may use this code in accordance with the IBM License Agreement * - * provided in the IBM Device Driver Source Kit for OS/2. * - * * - ****************************************************************************/ -/**@internal %W% - * WAT2MAP - translate symbol map from Watcom format to MS format. - * @version %I% - * @context - * Unless otherwise noted, all interfaces are Ring-0, 16-bit, kernel stack. - * @notes - * Usage: WAT2MAP ms_mapfile - * - or - - * type watcom_mapfile | WAT2MAP >ms_mapfile - * - * Reads from stdin, writes to stdout. Will accept the Watcom map filename - * as an argument (in place of reading from stdin). Eg., - * - * WAT2MAP watcom_mapfile >ms_mapfile - * - * Notes: - * 1.) The symbol handling in the debug kernel won't work for some of the - * characters used in the C++ name space. WAT2MAP handles these symbols - * as follows. - * Scoping operator symbol '::' is translated to '__'. - * Destructor symbol '~' is translated to 'd'. - * Symbols for operators '::operator' are not provided. - * - * Eg., for user defined class 'A', the symbol for constructor A::A is - * translated to A__A, and the destructor symbol A::~A becomes A__dA, and - * the assignment operator, 'A::operator =', is not translated. - * - * 2.) Bug - C++ provides for defining multiple functions with same fn name - * but different function signatures (different parameter lists). This - * utility just translates all the address / symbol combinations it finds, - * so you can end up with several addresses for a given fn name. - * @history -*/ -/* - don't modify this string - used to flag end of help. */ -/****************************************************************************/ - -wat2map: procedure -Parse Arg arg1, arg2 -If (Length( arg1 ) = 0) | (Verify( arg1, '/-?' ) = 0) Then Do; - Do i = 1 to 1000 - helpText = Sourceline(i) - If Pos( '', helpText ) <> 0 Then Leave; /* quit loop */ - Say helpText - End; - Return 1 -End; -If Length( arg2 ) = 0 Then Do; - Say " Way to go Beaver... How about an out-put file name ?" - Return 2 -End; -mapFile = arg1 /* Can be Null, in which case we pull from stdin. */ -outFile = arg2 -fFlatMode = 0; - -/* erase outfile */ /* kill the old map file */ -rc=SysFileDelete(outfile) - - -/*--- 1. Find & translate module name. ---*/ -Do While Lines( mapFile ) <> 0 - watcomText = LineIn( mapFile ) - /*Parse Value watcomText With "Executable Image: " fileName "." fileExt*/ - Parse Value watcomText With "Executable Image: " sFilename - If (sFilename <> '') Then Do; - sFilename = filespec('name', sFilename); - Parse Var sFilename fileName "." fileExt - If fileName <> "" Then Do; /* Found match */ - call lineout outfile ,' ' - call lineout outfile ,' ' || fileName - call lineout outfile ,' ' - Leave; /* Break from loop. */ - End; - End; -End -If Lines( mapFile ) = 0 Then Do; /* If end of file ... */ - Say "Error: Expected to find line with text 'Executable Image:' " - Return 3 -End - -/*--- 2. Skip the group definitions - Rob's notes say we don't need them. -*/ - -/*--- 3. Skip to the start of the segment table. ---*/ -Do While Lines( mapFile ) <> 0 - watcomText = LineIn( mapFile ) - Parse Value watcomText With "Segment" header_2_3 "Address" header_5 - If Strip( header_5 ) = "Size" Then Leave; /* Found header line for Segment table. */ -End -If Lines( mapFile ) = 0 Then Do; /* If end of file ... */ - Say "Error: Expected to find line with text 'Segments ... Size' " - Return 4 -End - - -junk = LineIn( mapFile ) /* Discard a couple lines of formatting. */ -junk = LineIn( mapFile ) /* Discard a couple lines of formatting. */ -/*--- 4. Translate segment table. ---*/ -/*"Segment Class Group Address Size"*/ -iClass = pos('Class', watcomText); -iGroup = pos('Group', watcomText); -iAddress = pos('Address', watcomText); -iSize = pos('Size', watcomText); - -call lineout outfile , " Start Length Name Class" /* bird bird bird fixed!!! */ -Do While Lines( mapFile ) <> 0 - watcomText = LineIn( mapFile ) - /* do it the hard way to make sure we support spaces segment names. */ - segName = strip(substr(watcomText, 1, iClass-1)); - If segName = "" Then Leave; /* Empty line, break from loop. */ - className = strip(substr(watcomText, iClass, iGroup-iClass)); - groupName = strip(substr(watcomText, iGroup, iAddress-iGroup)); - address = strip(substr(watcomText, iAddress, iSize-iAddress)); - size = strip(substr(watcomText, iSize)); - if (pos(':', address) <= 0) then /* NT binaries doesn't have a segment number. */ - do - fFlatMode = 1; - address = '0001:'||address; - end - length = right(strip(strip(size), 'L', '0'), 9, '0') || 'H ' - segName = Left( segName, 23 ) - call lineout outfile ,' ' || address || ' ' || length || segName || className -End -call lineout outfile ,' ' /* Extra line feed. */ - - -/*--- 5. For all remaining lines in the input file: if the line starts - with a 16:16 address, assume it's a symbol declaration and translate - it into MS format. ---*/ - -call lineout outfile ,' Address Publics by Value' -/* call lineout outfile ,' '*/ - -Do While Lines( mapFile ) <> 0 - watcomText = LineIn( mapFile ) - Parse Value watcomText With seg ':' ofs 14 . 16 declaration - if (fFlatMode) then - do - seg = '0001'; - Parse Value watcomText With ofs 9 . 16 declaration - end - else - do /* kso: more workarounds */ - if (is_Hex(seg) & length(ofs) > 4 & \is_Hex(substr(ofs,5,1))) then - ofs = '0000'||left(ofs,4); - end - /*say ofs '-'declaration*/ - is_Adress = (is_Hex(seg) = 1) & (is_Hex(ofs) = 1) - If ((is_Adress = 1) & (seg <> '0000')) Then Do; /* bird: skip symbols with segment 0. (__DOSseg__) */ - /*--- Haven't done the work to xlate operator symbols - skip the line. */ - If Pos( '::operator', declaration ) <> 0 Then Iterate; - - /*--- Strip any arguement list if this is a function prototype. */ - declaration = StripMatchedParen( declaration ) - - /*--- Strip array brackets if this is an array. */ - sqBracket = Pos( '[', declaration ) - If sqBracket <> 0 - Then declaration = Substr(declaration, 1, sqBracket-1); - - /*--- Strip leading tokens from the function name. - Eg., remove function return type, near/far, etc. */ - declaration = Word( declaration, Words(declaration) ) - - /*--- Strip any remaining parens around function name. ---*/ - declaration = ReplaceSubstr( '(', ' ', declaration ) - declaration = ReplaceSubstr( ')', ' ', declaration ) - - /*--- Debug kernel doesn't like symbol for scoping operator "::" - in symbol names. Replace :: with double underscore "__". ---*/ - declaration = ReplaceSubstr( '::', '__', declaration ) - - /*--- Debug kernel doesn't like symbol for destructor "~" - in symbol names. Replace ~ with character "d" for "destructor. - Note destructor for a class will translate "A::~A" -> "A__dA". ---*/ - declaration = ReplaceSubstr( '~', 'd', declaration ) - - call lineout outfile ,' ' || seg || ':' || ofs || ' ' || declaration - End; - - /* check for entry point, if found we add it and quit. */ - if (pos('Entry point address', watcomText) > 0) then - do - parse var watcomText 'Entry point address:' sEntryPoint - if (pos(':', sEntryPoint) <= 0) then - sEntryPoint = '0001:'||strip(sEntryPoint); - call lineout outfile, '' - call lineout outfile, 'Program entry point at' strip(sEntryPoint) - leave; - end -End; /* End While through symbol section, end of input file. */ - -call stream outfile, 'c', 'close'; -call stream mapfile, 'c', 'close'; - -Return 0; /* End of program. */ - -/*--- Helper subroutines. ---*/ - -StripMatchedParen: -/* Strips matched "( )" from end of string. Returns - a substring with the trailing, matched parens deleted. */ - - Parse Arg string - - ixOpenParen = LastPos( "(", string ); - ixCloseParen = LastPos( ")", Substr( string, 1, Length(string)-1 )); - - If (ixOpenParen = 0) /* No match. */ - Then Return string - Else If ixCloseParen < ixOpenParen /* Found match, no imbedded "()". */ - Then Return Substr( string, 1, ixOpenParen-1 ) - Else Do; /* Imbedded (), must skip over them. */ - /* Parse Value string With first ixCloseParen+1 rest */ - first = Substr( string, 1, ixCloseParen) - rest = Substr( string, ixCloseParen+1 ) - string = StripMatchedParen( first ) || rest - Return StripMatchedParen( string ) - End; -End; - -ReplaceSubstr: -/* Replaces oldPat (old pattern) with newPat (new pattern) in string. */ - - Parse Arg oldPat , newPat , string - - ix = Pos( oldPat, string ) - if ix <> 0 Then Do; - first = Substr( string, 1, ix-1 ) - rest = Substr( string, ix + Length( oldPat ) ) - string = first || newPat || rest - End; - Return string -End; - -is_Hex: -/* Returns 1 if String is valid hex number, 0 otherwise. */ - Parse Arg string - Return (Length(string) > 0) & (Verify( string, '0123456789abcdefABCDEF' ) = 0) -End; - +/* $Id: MapSym.cmd,v 1.8 2002-08-29 10:04:10 bird Exp $ + * + * Helper script for calling MAPSYM.EXE. + * + * Copyright (c) 2002 knut st. osmundsen (bird@anduin.net) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + +/* + * Configuration. + */ +sWatcom = ';wat11c;wat11;watcom;wat11c-16;wat11-16;wlink;wlink.exe;' +sIBMOld = ';vac3xx;vac365;vac308;emx;emxpgcc;mscv6;mscv6-16;ilink;ilink.exe;link386;link386.exe;link;link.exe;ibmold;' +sVAC40 = ';vac40;' +sLinkers = strip(sVAC40, 'T', ';')||strip(sIBMOld, 'T', ';')||strip(sWatcom, 'T', ';')||';' +/* look for 4os2 */ +f4OS2 = 0; +Address CMD 'set 4os2test_env=%@eval[2 + 2]'; +if (value('4os2test_env',, 'OS2ENVIRONMENT') = '4') then + f4OS2 = 1; +sCopy = '@copy' +if (f4OS2) then + sCopy = '@copy /Q' + +/* + * Parse arguments. + */ +parse arg sLinker sMapfile sSymFile sDummy + +if ( (sDummy <> '') , + | (sMapFile = '') , + | (pos(';'translate(sLinker)';', translate(sLinkers)) <= 0) , + ) +then +do + say 'syntax error'; + call syntax; + exit(16); +end +if (stream(sMapFile, 'c', 'query exist') = '') then +do + say 'error: the mapfile '''sMapFile''' doesn''t exist.'; + call syntax; + exit(16); +end + +sMapBaseName = filespec('name', sMapFile); +if (pos('.', sMapBaseName) > 0) then + sMapBaseName = left(sMapBaseName, pos('.', sMapBaseName) - 1); + +if (sSymFile = '') then +do + if (lastpos('.', filespec('name', sMapFile)) > 0) then + sSymFile = left(sMapFile, lastpos('.', sMapFile)) || 'sym'; + else + sSymFile = sMapFile || '.sym'; +end + + +/* + * Convert linker input. + */ +sLinker = translate(sLinker); /* easier to compare */ +if (pos(';'||sLinker||';', translate(sWatcom)) > 0) then + sLinker = 'WATCOM'; +if (pos(';'||sLinker||';', translate(sIBMOld)) > 0) then + sLinker = 'IBMOLD'; +if (pos(';'||sLinker||';', translate(sVAC40)) > 0) then + sLinker = 'VAC40'; + +/* + * Load rexxutil functions. + */ +call RxFuncAdd 'SysLoadFuncs','RexxUtil','SysLoadFuncs' +call SysLoadFuncs + + +/* + * Get the temp directory. + */ +sTmp = value('TMP',, 'OS2ENVIRONMENT'); +if (sTmp = '') then + sTmp = value('TEMP',, 'OS2ENVIRONMENT'); +if (sTmp = '') then + sTmp = value('TMPDIR',, 'OS2ENVIRONMENT'); +if (sTmp = '') then + sTmp = value('TEMPDIR',, 'OS2ENVIRONMENT'); +if (sTmp = '') then +do + say 'Fatal error: Hey mister! don''t you have a tmp directory?' + exit(16); +end +sTmp = strip(strip(sTmp, 'T', '\'), 'T','/'); + + +/* + * Make temporary filename. + * (We'll make a workcopy, modified for some linkers, of the mapfile + * to this file. And call mapsym on it.) + */ +sTmpMapFile = SysTempFileName(sTmp'\'||sMapBaseName||'.???'); +if (sTmpMapFile = '') then +do + say 'error: failed to make temporary file!'; + exit(16); +end + + +/* + * Do pre mapsym.exe processing of the sym file. + */ +select + when (sLinker = 'IBMOLD') then + do + sCopy sMapFile sTmpMapFile + if (rc <> 0) then + do + say 'error: failed to copy '''sMapFile''' to '''sTmpMapFile'''. (rc='rc')'; + exit(16); + end + end + + when (sLinker = 'WATCOM') then + do + /*sTmpMapFile = 'watos2.map'*/ + rc = wat2map(sMapFile, sTmpMapFile); + if (rc <> 0) then + do + say 'error: wat2map failed. (rc='rc')'; + exit(16); + end + end + + when (sLinker = 'VAC40') then + do + rc = vac40conv(sMapFile, sTmpMapFile); + if (rc <> 0) then + do + say 'error: vac40conv failed. (rc='rc')'; + exit(16); + end + end + + otherwise + say 'bad linker, sLinker='sLinker; + exit(16); +end + + +/* + * Call mapsym.exe + */ +sOldDir = directory(); +call directory(sTmp); +'@mapsym.exe' sTmpMapFile +if (rc <> 0) then +do + say 'error: mapsym.exe '''sTmpMapFile''' failed with rc='rc'.'; + call directory(sOldDir); + exit(rc); +end +call directory(sOldDir); + + + +/* + * Copy the symfile to the target path. + */ +sCopy left(sTmpMapFile, length(sTmpMapFile) - 4)||'.sym' sSymFile; +if (rc <> 0) then +do + say 'error: failed to copy '''left(sTmpMapFile, length(sTmpMapFile) - 4)||'.sym'' to '''sSymFile'''. (rc='rc')'; + exit(16); +end + +/* + * Delete temporary files. + */ +call SysFileDelete sTmpMapFile; +call SysFileDelete left(sTmpMapFile, length(sTmpMapFile) - 4)||'.sym'; + +exit(0); + + + +/******************************************************************************* +* Function Area * +*******************************************************************************/ + + +/** + * Display usage info. + */ +syntax: procedure; + say 'syntax: MapSym.cmd [symfile]'; + say ' linker watcom, vac3xx, link386 or vac40. All $(BUILD_ENV).'; + say ' mapfile Name of the input map file.'; + say ' symfile Name of the output sym file. If not specified'; + say ' mapfile is used as a base name.'; +return 0; + + +/** + * Converts a vac40 mapfile to a file readable for mapsym.exe. + * @returns 0 on success. + * !0 on error. + * @param sInFile Input vac40 mapfile. + * @param sOutFile Output filename. + * @status completely implemented. + * @author knut st. osmundsen (bird@anduin.net) + * @remark Make some assume about the module name. Not sure if it matters. + */ +vac40conv: procedure; + parse arg sInFile, sOutFile; + + /* + * variables. + */ + rc = 0; + sState = 'Init'; /* shows the current content status. */ + + /* + * Read file line by line. + */ + do while ((rc = 0) & (lines(sInFile) > 0)) + /* + * Read the line and look for state change. + */ + sLine = linein(sInFile); + sNewState = vac40ProbeState(sState, sLine); + + /* + * State switch. + */ + select + /* + * First line. + */ + when (sState = 'Init') then + do + if (pos('Link Map...', sLine) <= 0) then + do + say 'error: Not VAC40 map file.' + rc = 1; + end + + call lineout sOutFile, ''; + sModName = translate(filespec('name',sInFile)); + if (lastpos('.', sModName) > 0) then sModName = left(sModName, lastpos('.', sModName) - 1); + call lineout sOutFile, ' '||sModName; + call lineout sOutFile, ''; + sNewState = 'AnyState'; + end + + /* + * Segments - let's try copy then raw. + */ + when ((sNewState = 'Segments') | (sState = 'Segments')) then + do + if (sState <> 'Segments') then + do + sSegment = ''; + cbSegment = 0; + call lineout sOutFile, ' Start Length Name Class' + end + else + do + if (pos('at offset', sLine) > 0) then + do /* + * At offset line: + * at offset 000006A8 bytes 00006H for "@197" + */ + parse var sLine . 'offset' sOffset 'bytes' sLength'H' . . + /*say 'off='sOffset 'len='sLength 'line:' left(sLine, 40);*/ + cbSegment = HexToDec(sOffset) + HexToDec(sLength); + end + else if ( (sNewState = 'Segments') & (sSegment = ''), + & (strip(sLine) <> '') & (pos(':', sLine) > 0) ) then + do /* + * New segment. + */ + /*say 'NewSeg:' sLine*/ + sSegment = sLine; + end + else if ((strip(sLine) = '') & (sSegment <> '')) then + do /* + * Time to write segment line: + * 0001:00000000 DATA32 DATA + */ + sSegment = translate(sSegment, ' ', '09'x); + parse var sSegment iSeg':'iSegOffset sSegName sSegClass + /*say 'SegLn: seg='iSeg 'off='iSegOffset 'name='sSegName 'class='sSegClass; say sSegment*/ + if (length(sSegName) < 22) then sSegName = left(sSegName, 22, ' '); + call lineout sOutFile, ' '||strip(iSeg)':'iSegOffset right(DecToHex(cbSegment), 9, '0'), + ||'H '||sSegName||' '||strip(sSegClass); + sSegment = ''; + cbSegment = 0; + end + end + end + + /* + * Publics by value - filter out some of the stupid stuff. + */ + when ((sNewState = 'PublicValue') | (sState = 'PublicValue')) then + do + if (sState = sNewState) then + do + sLine = translate(sLine, '', '"'||d2c(9)); + if ((strip(sLine) <> '') & (pos('|', sLine) <= 0) & (pos('@', sLine) <= 0)) then + call lineout sOutFile, ' '||word(sLine, 1)||' '||word(sLine, 2); + end + else if (sNewState = 'PublicValue') then + do /* first call */ + call lineout sOutFile, ''; + call lineout sOutFile, ' Address Publics by Value'; + end + end + + /* + * Entry pointe - raw copy. + */ + when (sNewState = 'EntryPoint') then + do + call lineout sOutFile, ''; + call lineout sOutFile, sLine; + sNewState = 'Stop'; + end + + /* + * Got to next state. + */ + when (sState = 'AnyState') then + do + if (strip(sLine) = '') then + iterate; + if (sNewState = sState) then + do + say 'state error, bad input?'; + rc = 2; + end + end + + /* + * Skips till we hit a new state. + */ + when (sState = 'Skip') then + nop; + /* debug */ + when ((sState = 'ImportsName') | (sState = 'PublicNames') | (sState = 'ImportLibs') | (sState = 'ConstDest')) then + nop; + + /* + * Final. + */ + when (sState = 'Stop') then + leave; + + /* + * Should not happen. + */ + otherwise + do + say 'bad state, sState='sState; + rc = 3; + end + end /* select */ + + /* + * next state + */ + /*say 'state debug:' sState '->' sNewState 'ln:' left(sLine, 40)*/ + sState = sNewState; + end /* do while */ + + /* + * cleanup. + */ + call stream sOutFile, 'c', 'close' + call stream sMapfile, 'c', 'close' + +return rc; + + +/** + * Checks if this line is recognizes as a state change line. + * @returns New state. + * @param sState The current state. + * @param sLine The input line we're processing. + */ +vac40ProbeState: procedure + parse arg sState, sLine + select + when (pos('...Options...', sLine) > 0) then sState = 'Skip'; + when (pos('...Segments...', sLine) > 0) then sState = 'Segments'; + when (pos('...Constructor/Destructor pairs to run...', sLine) > 0) then sState = 'ConstDest'; + when (pos('Imports by name', sLine) > 0) then sState = 'ImportsName'; + when (pos('Publics by name', sLine) > 0) then sState = 'PublicNames'; + when (pos('Publics by value', sLine) > 0) then sState = 'PublicValue'; + when (pos('...Import library list...', sLine) > 0) then sState = 'ImportLibs'; + when (pos('Line numbers for', sLine) > 0) then sState = 'Skip'; + when (pos('Program entry point', sLine) > 0) then sState = 'EntryPoint'; + otherwise + nop; + end +return sState; + + + +/** + * Converts a hex string (no prefix/postfix) to a decimal value. + * @returns decimal value. + * @param sStringHex Hexstring to convert. (no 0x prefix or H postfix!) + * @status completely implemented. + * @author knut st. osmundsen (bird@anduin.net) + */ +HexToDec: procedure + parse arg sStringHex +/* say 'HexToDec('sStringHex'):' strip(strip(sStringHex), 'L', '0')*/ + sStringHex = strip(strip(sStringHex), 'L', '0'); + if (sStringHex = '') then + sStringHex = 0; +return x2d(sStringHex); + + +/** + * Converts a dec string to a hex string. + * @returns hex string value. + * @param sStringDec Decstring to convert. + * @status completely implemented. + * @author knut st. osmundsen (bird@anduin.net) + */ +DecToHex: procedure + parse arg sStringDec + sStringDec = strip(strip(sStringDec), 'L', '0'); + if (sStringDec = '') then + sStringDec = 0; +return d2x(sStringDec); + + +/* SCCSID = %W% %E% */ +/**************************************************************************** + * * + * Copyright (c) IBM Corporation 1994 - 1997. * + * * + * The following IBM OS/2 source code is provided to you solely for the * + * the purpose of assisting you in your development of OS/2 device drivers. * + * You may use this code in accordance with the IBM License Agreement * + * provided in the IBM Device Driver Source Kit for OS/2. * + * * + ****************************************************************************/ +/**@internal %W% + * WAT2MAP - translate symbol map from Watcom format to MS format. + * @version %I% + * @context + * Unless otherwise noted, all interfaces are Ring-0, 16-bit, kernel stack. + * @notes + * Usage: WAT2MAP ms_mapfile + * - or - + * type watcom_mapfile | WAT2MAP >ms_mapfile + * + * Reads from stdin, writes to stdout. Will accept the Watcom map filename + * as an argument (in place of reading from stdin). Eg., + * + * WAT2MAP watcom_mapfile >ms_mapfile + * + * Notes: + * 1.) The symbol handling in the debug kernel won't work for some of the + * characters used in the C++ name space. WAT2MAP handles these symbols + * as follows. + * Scoping operator symbol '::' is translated to '__'. + * Destructor symbol '~' is translated to 'd'. + * Symbols for operators '::operator' are not provided. + * + * Eg., for user defined class 'A', the symbol for constructor A::A is + * translated to A__A, and the destructor symbol A::~A becomes A__dA, and + * the assignment operator, 'A::operator =', is not translated. + * + * 2.) Bug - C++ provides for defining multiple functions with same fn name + * but different function signatures (different parameter lists). This + * utility just translates all the address / symbol combinations it finds, + * so you can end up with several addresses for a given fn name. + * @history +*/ +/* - don't modify this string - used to flag end of help. */ +/****************************************************************************/ + +wat2map: procedure +Parse Arg arg1, arg2 +If (Length( arg1 ) = 0) | (Verify( arg1, '/-?' ) = 0) Then Do; + Do i = 1 to 1000 + helpText = Sourceline(i) + If Pos( '', helpText ) <> 0 Then Leave; /* quit loop */ + Say helpText + End; + Return 1 +End; +If Length( arg2 ) = 0 Then Do; + Say " Way to go Beaver... How about an out-put file name ?" + Return 2 +End; +mapFile = arg1 /* Can be Null, in which case we pull from stdin. */ +outFile = arg2 +fFlatMode = 0; + +/* erase outfile */ /* kill the old map file */ +rc=SysFileDelete(outfile) + + +/*--- 1. Find & translate module name. ---*/ +Do While Lines( mapFile ) <> 0 + watcomText = LineIn( mapFile ) + /*Parse Value watcomText With "Executable Image: " fileName "." fileExt*/ + Parse Value watcomText With "Executable Image: " sFilename + If (sFilename <> '') Then Do; + sFilename = filespec('name', sFilename); + Parse Var sFilename fileName "." fileExt + If fileName <> "" Then Do; /* Found match */ + call lineout outfile ,' ' + call lineout outfile ,' ' || fileName + call lineout outfile ,' ' + Leave; /* Break from loop. */ + End; + End; +End +If Lines( mapFile ) = 0 Then Do; /* If end of file ... */ + Say "Error: Expected to find line with text 'Executable Image:' " + Return 3 +End + +/*--- 2. Skip the group definitions - Rob's notes say we don't need them. -*/ + +/*--- 3. Skip to the start of the segment table. ---*/ +Do While Lines( mapFile ) <> 0 + watcomText = LineIn( mapFile ) + Parse Value watcomText With "Segment" header_2_3 "Address" header_5 + If Strip( header_5 ) = "Size" Then Leave; /* Found header line for Segment table. */ +End +If Lines( mapFile ) = 0 Then Do; /* If end of file ... */ + Say "Error: Expected to find line with text 'Segments ... Size' " + Return 4 +End + + +junk = LineIn( mapFile ) /* Discard a couple lines of formatting. */ +junk = LineIn( mapFile ) /* Discard a couple lines of formatting. */ +/*--- 4. Translate segment table. ---*/ +/*"Segment Class Group Address Size"*/ +iClass = pos('Class', watcomText); +iGroup = pos('Group', watcomText); +iAddress = pos('Address', watcomText); +iSize = pos('Size', watcomText); + +call lineout outfile , " Start Length Name Class" /* bird bird bird fixed!!! */ +Do While Lines( mapFile ) <> 0 + watcomText = LineIn( mapFile ) + /* do it the hard way to make sure we support spaces segment names. */ + segName = strip(substr(watcomText, 1, iClass-1)); + If segName = "" Then Leave; /* Empty line, break from loop. */ + className = strip(substr(watcomText, iClass, iGroup-iClass)); + groupName = strip(substr(watcomText, iGroup, iAddress-iGroup)); + address = strip(substr(watcomText, iAddress, iSize-iAddress)); + size = strip(substr(watcomText, iSize)); + if (pos(':', address) <= 0) then /* NT binaries doesn't have a segment number. */ + do + fFlatMode = 1; + address = '0001:'||address; + end + length = right(strip(strip(size), 'L', '0'), 9, '0') || 'H ' + segName = Left( segName, 23 ) + call lineout outfile ,' ' || address || ' ' || length || segName || className +End +call lineout outfile ,' ' /* Extra line feed. */ + + +/*--- 5. For all remaining lines in the input file: if the line starts + with a 16:16 address, assume it's a symbol declaration and translate + it into MS format. ---*/ + +call lineout outfile ,' Address Publics by Value' +/* call lineout outfile ,' '*/ + +Do While Lines( mapFile ) <> 0 + watcomText = LineIn( mapFile ) + Parse Value watcomText With seg ':' ofs 14 . 16 declaration + if (fFlatMode) then + do + seg = '0001'; + Parse Value watcomText With ofs 9 . 16 declaration + end + else + do /* kso: more workarounds */ + if (is_Hex(seg) & length(ofs) > 4 & \is_Hex(substr(ofs,5,1))) then + ofs = '0000'||left(ofs,4); + end + /*say ofs '-'declaration*/ + is_Adress = (is_Hex(seg) = 1) & (is_Hex(ofs) = 1) + If ((is_Adress = 1) & (seg <> '0000')) Then Do; /* bird: skip symbols with segment 0. (__DOSseg__) */ + /*--- Haven't done the work to xlate operator symbols - skip the line. */ + If Pos( '::operator', declaration ) <> 0 Then Iterate; + + /*--- Strip any arguement list if this is a function prototype. */ + declaration = StripMatchedParen( declaration ) + + /*--- Strip array brackets if this is an array. */ + sqBracket = Pos( '[', declaration ) + If sqBracket <> 0 + Then declaration = Substr(declaration, 1, sqBracket-1); + + /*--- Strip leading tokens from the function name. + Eg., remove function return type, near/far, etc. */ + declaration = Word( declaration, Words(declaration) ) + + /*--- Strip any remaining parens around function name. ---*/ + declaration = ReplaceSubstr( '(', ' ', declaration ) + declaration = ReplaceSubstr( ')', ' ', declaration ) + + /*--- Debug kernel doesn't like symbol for scoping operator "::" + in symbol names. Replace :: with double underscore "__". ---*/ + declaration = ReplaceSubstr( '::', '__', declaration ) + + /*--- Debug kernel doesn't like symbol for destructor "~" + in symbol names. Replace ~ with character "d" for "destructor. + Note destructor for a class will translate "A::~A" -> "A__dA". ---*/ + declaration = ReplaceSubstr( '~', 'd', declaration ) + + call lineout outfile ,' ' || seg || ':' || ofs || ' ' || declaration + End; + + /* check for entry point, if found we add it and quit. */ + if (pos('Entry point address', watcomText) > 0) then + do + parse var watcomText 'Entry point address:' sEntryPoint + if (pos(':', sEntryPoint) <= 0) then + sEntryPoint = '0001:'||strip(sEntryPoint); + call lineout outfile, '' + call lineout outfile, 'Program entry point at' strip(sEntryPoint) + leave; + end +End; /* End While through symbol section, end of input file. */ + +call stream outfile, 'c', 'close'; +call stream mapfile, 'c', 'close'; + +Return 0; /* End of program. */ + +/*--- Helper subroutines. ---*/ + +StripMatchedParen: +/* Strips matched "( )" from end of string. Returns + a substring with the trailing, matched parens deleted. */ + + Parse Arg string + + ixOpenParen = LastPos( "(", string ); + ixCloseParen = LastPos( ")", Substr( string, 1, Length(string)-1 )); + + If (ixOpenParen = 0) /* No match. */ + Then Return string + Else If ixCloseParen < ixOpenParen /* Found match, no imbedded "()". */ + Then Return Substr( string, 1, ixOpenParen-1 ) + Else Do; /* Imbedded (), must skip over them. */ + /* Parse Value string With first ixCloseParen+1 rest */ + first = Substr( string, 1, ixCloseParen) + rest = Substr( string, ixCloseParen+1 ) + string = StripMatchedParen( first ) || rest + Return StripMatchedParen( string ) + End; +End; + +ReplaceSubstr: +/* Replaces oldPat (old pattern) with newPat (new pattern) in string. */ + + Parse Arg oldPat , newPat , string + + ix = Pos( oldPat, string ) + if ix <> 0 Then Do; + first = Substr( string, 1, ix-1 ) + rest = Substr( string, ix + Length( oldPat ) ) + string = first || newPat || rest + End; + Return string +End; + +is_Hex: +/* Returns 1 if String is valid hex number, 0 otherwise. */ + Parse Arg string + Return (Length(string) > 0) & (Verify( string, '0123456789abcdefABCDEF' ) = 0) +End; + diff --git a/tools/bin/PreloadTools.cmd b/tools/bin/PreloadTools.cmd index 18af127..c9755fc 100644 --- a/tools/bin/PreloadTools.cmd +++ b/tools/bin/PreloadTools.cmd @@ -1,46 +1,46 @@ -/* $Id: PreloadTools.cmd,v 1.2 2001-12-19 01:50:06 bird Exp $ - * - * Preloads all the tools which we might turn into using. - * Specify '-u' to unload the tools. - */ -'@echo off' - -/* - * Parse argument(s). - */ -parse arg '-'chUnload - -sEmxloadArgs = '-e'; -if (translate(substr(chUnload,1,1)) = 'U') then - sEmxloadArgs = '-u'; - - -/* - * Find the tools directory. - */ -parse source sOS sCMD sSrc; -sToolsDir = filespec('drive', sSrc) || filespec('path', sSrc); /* with slash */ - - -/* - * Do the preloading or unloading. - */ -'emxload' sEmxloadArgs 'rm.exe'; -'emxload' sEmxloadArgs, - sToolsDir'impdef.exe', - sToolsDir'lxlite.exe', - sToolsDir'fastdep.exe', - sToolsDir'wrc.exe'; - -/* - * Compiler specific stuff. - */ -sCCEnv = translate(value('CCENV',,'OS2ENVIRONMENT')); -if (sCCEnv = '') then sCCenv = 'VAC3'; - -/* Visual Age */ -if ((sCCEnv = 'VAC3') | (sCCEnv = 'VAC36')) then - 'emxload' sEmxloadArgs 'implib.exe ilib.exe nmake.exe alp.exe rc.exe'; - - - +/* $Id: PreloadTools.cmd,v 1.2 2001-12-19 01:50:06 bird Exp $ + * + * Preloads all the tools which we might turn into using. + * Specify '-u' to unload the tools. + */ +'@echo off' + +/* + * Parse argument(s). + */ +parse arg '-'chUnload + +sEmxloadArgs = '-e'; +if (translate(substr(chUnload,1,1)) = 'U') then + sEmxloadArgs = '-u'; + + +/* + * Find the tools directory. + */ +parse source sOS sCMD sSrc; +sToolsDir = filespec('drive', sSrc) || filespec('path', sSrc); /* with slash */ + + +/* + * Do the preloading or unloading. + */ +'emxload' sEmxloadArgs 'rm.exe'; +'emxload' sEmxloadArgs, + sToolsDir'impdef.exe', + sToolsDir'lxlite.exe', + sToolsDir'fastdep.exe', + sToolsDir'wrc.exe'; + +/* + * Compiler specific stuff. + */ +sCCEnv = translate(value('CCENV',,'OS2ENVIRONMENT')); +if (sCCEnv = '') then sCCenv = 'VAC3'; + +/* Visual Age */ +if ((sCCEnv = 'VAC3') | (sCCEnv = 'VAC36')) then + 'emxload' sEmxloadArgs 'implib.exe ilib.exe nmake.exe alp.exe rc.exe'; + + + diff --git a/tools/bin/StateUpd.cmd b/tools/bin/StateUpd.cmd index 84e02eb..15f031f 100644 --- a/tools/bin/StateUpd.cmd +++ b/tools/bin/StateUpd.cmd @@ -1,46 +1,46 @@ -/* $Id: StateUpd.cmd,v 1.4 2000-08-02 20:25:50 bird Exp $ - * - * Helper script which invokes StateUpd.cmd. - * This was created to hold special rules for dirs like OpenGl. - * - * Copyright (c) 2000 knut st. osmundsen - * - */ - /* find (possible) dll name from directory name */ - sDllName = filespec('name', directory()); - - /* find StateUpd exe path assuming it's in the same dir as this script. */ - parse source sD1 sD2 sSrc; - sSrc = filespec('drive', sSrc) || filespec('path', sSrc); - sStateUpd = sSrc||'StateUpd.exe'; - - /* parse arguments */ - parse arg sAllArgs - - /* apecial cases and general case */ - if (translate(sDllName) = 'OPENGL') then - do - /* save dir and change dir into mesa */ - /*sOldDir = directory(); - call directory('mesa'); */ - - /* execute update */ - sStateUpd || ' -dll:opengl32 -s ' || sAllArgs; - lRc = rc; - - /* restore dir */ - /*call directory sOldDir;*/ - end - else if (translate(sDllName) = 'WNETAP32') then - do - /* execute update */ - sStateUpd || ' -dll:netapi32 ' || sAllArgs; - lRc = rc; - end - else - do - /* execute update */ - sStateUpd || ' ' || sAllArgs; - lRc = rc; - end - exit(lRc); +/* $Id: StateUpd.cmd,v 1.4 2000-08-02 20:25:50 bird Exp $ + * + * Helper script which invokes StateUpd.cmd. + * This was created to hold special rules for dirs like OpenGl. + * + * Copyright (c) 2000 knut st. osmundsen + * + */ + /* find (possible) dll name from directory name */ + sDllName = filespec('name', directory()); + + /* find StateUpd exe path assuming it's in the same dir as this script. */ + parse source sD1 sD2 sSrc; + sSrc = filespec('drive', sSrc) || filespec('path', sSrc); + sStateUpd = sSrc||'StateUpd.exe'; + + /* parse arguments */ + parse arg sAllArgs + + /* apecial cases and general case */ + if (translate(sDllName) = 'OPENGL') then + do + /* save dir and change dir into mesa */ + /*sOldDir = directory(); + call directory('mesa'); */ + + /* execute update */ + sStateUpd || ' -dll:opengl32 -s ' || sAllArgs; + lRc = rc; + + /* restore dir */ + /*call directory sOldDir;*/ + end + else if (translate(sDllName) = 'WNETAP32') then + do + /* execute update */ + sStateUpd || ' -dll:netapi32 ' || sAllArgs; + lRc = rc; + end + else + do + /* execute update */ + sStateUpd || ' ' || sAllArgs; + lRc = rc; + end + exit(lRc); diff --git a/tools/bin/buildenv.cmd b/tools/bin/buildenv.cmd index 33ab8a8..3600e03 100644 --- a/tools/bin/buildenv.cmd +++ b/tools/bin/buildenv.cmd @@ -1,4259 +1,4259 @@ -/* $Id: buildenv.cmd,v 1.59 2006-03-31 21:47:03 bird Exp $ - * - * This is the master tools environment script. It contains environment - * configurations for many development tools. Each tool can be installed - * and uninstalled from the environment interchangably. - * - * Note: Of historic reasons, there are some environments here which - * isn't normally used by normal code trees. - * - * - * Known problems: - * - LANG is set to en_US by both VAC36 and TOOLKIT45. When unsetting - * those the original value, for example of no_NO, is not restored. - * - Same goes for some other stuff, we have no stack of previous values. - * - * Copyright (c) 1999-2005 knut st. osmundsen (bird@anduin.net) - * - * GPL v2 - * - */ - - Address CMD '@echo off'; - - signal on novalue name NoValueHandler - - /* - * Version - */ - sVersion = '1.1.4 [2005-12-18]'; - - /* - * Create argument array with lowercase arguments. - */ - parse arg sEnv.1 sEnv.2 sEnv.3 sEnv.4 sEnv.5 sEnv.6 sEnv.7 sEnv.8 sEnv.9 sEnv.10 sEnv.11 sEnv.12 sEnv.13 sEnv.14 sEnv.15 sEnv.16 sEnv.17 sEnv.18 sEnv.19 sEnv.20 sEnv.21 sEnv.22 sEnv.23 - - i = 1; - do while (sEnv.i <> '') - sEnv.i = translate(strip(sEnv.i), 'abcdefghijklmnopqrstuvwxyz‘›†', 'ABCDEFGHIJKLMNOPQRSTUVWXYZ’'); - i = i + 1; - end - sEnv.0 = i - 1; - - /* - * Syntax - */ - if (sEnv.0 = 0) then - do - say 'BuildEnv v'||sVersion - say '-------------------------------' - say '' - say 'Synopsis: Environment configuration utility written to maintain' - say 'many different versions of compilers and toolkits on the same' - say 'workstation. ' - say '' - say 'Syntax: BuildEnv.cmd [action]' - say '' - say 'Actions:' - say ' + Install tool in environment. Default action.' - say ' ~ Install tool in environment if it''s configured.' - say ' - Remove tool from environment.' - say ' õ Remove tool from environment if it''s configured.' - say ' * Configure tool if needed.' - say ' ! Forced tool configuretion.' - say ' @ Verify tool configuration.' - say ' ? Query if a tool is configured.' - say '' - say 'Special environments (commands):' - say ' allconfig Configure all tools which fails verify.' - say ' allreconfig Reconfigure all tools.' - say ' allverify Verify all configured tools.' - say ' alluninstall Removed all configured tools from environment.' - say ' showall Show all tools.' - say ' showconfigured Show all configured tools.' - say ' shownotconfigured Show all tools which isn''t configured.' - say '' - say 'Copyright (c) 1999-2003 knut st. osmundsen' - say 'Published under GPL v2' - return 8; - end - - /* - * Load REXX Util Functions. - * (Need Sys[Query|Set]ExtLibPath.) - */ - if (RxFuncQuery('SysLoadFuncs') = 1) then - do - call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; - call SysLoadFuncs; - end - - - /* - * Apply CMD.EXE workaround. - */ - call FixCMDEnv; - - - /* - * Configuration - sorted please! - */ - aPath.0 = 0; - - i = 1; - /* Tool id The tool's group The function with args. Optional verify data. increment index */ - aCfg.i.sId = 'cvs'; aCfg.i.sGrp = 'version'; aCfg.i.sSet = 'CVS'; aCfg.i.sDesc = 'CVS v1.10 or later'; i = i + 1; - aCfg.i.sId = 'db2v52'; aCfg.i.sGrp = 'database'; aCfg.i.sSet = 'db2v52'; aCfg.i.sDesc = 'DB2 v5.2 Dev Edition'; i = i + 1; - aCfg.i.sId = 'ddk'; aCfg.i.sGrp = 'ddk'; aCfg.i.sSet = 'DDK'; aCfg.i.sDesc = 'OS/2 DDK (recent)'; i = i + 1; - aCfg.i.sId = 'ddkbase'; aCfg.i.sGrp = 'ddk'; aCfg.i.sSet = 'DDKBase'; aCfg.i.sDesc = 'DDK Base (recent)'; i = i + 1; - aCfg.i.sId = 'ddkvideo'; aCfg.i.sGrp = 'ddk'; aCfg.i.sSet = 'DDKVideo'; aCfg.i.sDesc = 'DDK Video (recent)'; i = i + 1; - aCfg.i.sId = 'doxygen'; aCfg.i.sGrp = 'doc'; aCfg.i.sSet = 'DoxyGen'; aCfg.i.sDesc = 'Doxygen v1.2.11 for OS/2'; i = i + 1; - aCfg.i.sId = 'emx'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'EMX'; aCfg.i.sDesc = 'EMX v0.9d fixpack 04'; i = i + 1; - aCfg.i.sId = 'emxpgcc'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'EMXPGCC'; aCfg.i.sDesc = 'Pentium Optimized GCC/EMX v1.1.1 r2 with binutils 2.9.1'; i = i + 1; - aCfg.i.sId = 'freetypeemx'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'FreeTypeEMX'; aCfg.i.sDesc = 'FreeType v1.3.1 for EMX.'; i = i + 1; - aCfg.i.sId = 'gcc302'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC3xx,''gcc302'''; aCfg.i.sDesc = 'GCC/EMX v3.0.2beta with binutils 2.11.2'; i = i + 1; - aCfg.i.sId = 'gcc303'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC3xx,''gcc303'''; aCfg.i.sDesc = 'GCC/EMX v3.0.3beta with binutils 2.11.2'; i = i + 1; - aCfg.i.sId = 'gcc321'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC3xx,''gcc321'''; aCfg.i.sDesc = 'GCC/EMX v3.2.1beta with binutils 2.11.2'; i = i + 1; - aCfg.i.sId = 'gcc322'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC322plus,''gcc322'''; aCfg.i.sDesc = 'Innotek GCC v3.2.2'; i = i + 1; - aCfg.i.sId = 'gcc334'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC322plus,''gcc334'''; aCfg.i.sDesc = 'Innotek GCC v3.3.4'; i = i + 1; - aCfg.i.sId = 'gcc335'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC322plus,''gcc335'''; aCfg.i.sDesc = 'Innotek GCC v3.3.4'; i = i + 1; - aCfg.i.sId = 'gcc343'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC322plus,''gcc343'''; aCfg.i.sDesc = 'Innotek GCC v3.4.3'; i = i + 1; - aCfg.i.sId = 'icatgam'; aCfg.i.sGrp = 'debugger'; aCfg.i.sSet = 'ICATGam'; aCfg.i.sDesc = 'ICAT for OS/2 latest'; i = i + 1; - aCfg.i.sId = 'icatgam406rc1'; aCfg.i.sGrp = 'debugger'; aCfg.i.sSet = 'ICATGam406RC1'; aCfg.i.sDesc = 'ICAT for OS/2 v4.0.6 release candidate 1'; i = i + 1; - aCfg.i.sId = 'icatpe'; aCfg.i.sGrp = 'debugger'; aCfg.i.sSet = 'ICATPe'; aCfg.i.sDesc = 'ICAT for OS/2 with PE support (test version)'; i = i + 1; - aCfg.i.sId = 'ida'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'IDA414'; aCfg.i.sDesc = 'Interactive DisAssembler (IDA) (latest)'; i = i + 1; - aCfg.i.sId = 'ida38'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'IDA38'; aCfg.i.sDesc = 'Interactive DisAssembler (IDA) v3.80 (historical)'; i = i + 1; - aCfg.i.sId = 'ida40'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'IDA40'; aCfg.i.sDesc = 'Interactive DisAssembler (IDA) v4.0 (historical)'; i = i + 1; - aCfg.i.sId = 'ida414'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'IDA414'; aCfg.i.sDesc = 'Interactive DisAssembler (IDA) v4.14'; i = i + 1; - aCfg.i.sId = 'idasdk'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'IDASDK'; aCfg.i.sDesc = 'Interactive DisAssembler (IDA) SDK'; i = i + 1; - aCfg.i.sId = 'icsdebug'; aCfg.i.sGrp = 'debugger'; aCfg.i.sSet = 'icsdebug'; aCfg.i.sDesc = 'icsdebug from VAC308'; i = i + 1; - aCfg.i.sId = 'idebug'; aCfg.i.sGrp = 'debugger'; aCfg.i.sSet = 'idebug'; aCfg.i.sDesc = 'idebug from VAC365'; i = i + 1; - aCfg.i.sId = 'java131'; aCfg.i.sGrp = 'java'; aCfg.i.sSet = 'Java131'; aCfg.i.sDesc = 'Java v1.3.1 (co131-20020710)'; i = i + 1; - aCfg.i.sId = 'jitdbg'; aCfg.i.sGrp = 'debugger'; aCfg.i.sSet = 'jitdbg'; aCfg.i.sDesc = 'jitdbg (secret)'; i = i + 1; - aCfg.i.sId = 'jpeg'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'JPEG'; aCfg.i.sDesc = '(lib)JPEG v6b'; i = i + 1; - aCfg.i.sId = 'mode12050'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'Mode,120,50'; aCfg.i.sDesc = 'mode 120,50'; i = i + 1; - aCfg.i.sId = 'mode8050'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'Mode,80,50'; aCfg.i.sDesc = 'mode 80,50'; i = i + 1; - aCfg.i.sId = 'mscv6'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'MSCV6_32'; aCfg.i.sDesc = 'MicroSoft C v6.0 32-bit'; i = i + 1; - aCfg.i.sId = 'mscv6-16'; aCfg.i.sGrp = 'comp16'; aCfg.i.sSet = 'MSCV6_16'; aCfg.i.sDesc = 'MicroSoft C v6.0a 16-bit'; i = i + 1; - aCfg.i.sId = 'mscv7-16'; aCfg.i.sGrp = 'comp16'; aCfg.i.sSet = 'MSCV7_16'; aCfg.i.sDesc = 'MicroSoft C v7.0 16-bit with OS/2 support'; i = i + 1; - aCfg.i.sId = 'mysql'; aCfg.i.sGrp = 'database'; aCfg.i.sSet = 'mySQL'; aCfg.i.sDesc = 'MySql any version (latest from Yuri is recommended)'; i = i + 1; - aCfg.i.sId = 'nasm9833'; aCfg.i.sGrp = 'asm'; aCfg.i.sSet = 'NASM,''nasm9833'''; aCfg.i.sDesc = 'NASM version 0.98.33 compiled on May 28 2002'; i = i + 1; - aCfg.i.sId = 'netqos2'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'NetQOS2'; aCfg.i.sDesc = 'NetQOS2 - help system for VAC40,VAC365,DB2 and more.'; i = i + 1; - aCfg.i.sId = 'odin32testcase'; aCfg.i.sGrp = 'tests'; aCfg.i.sSet = 'Odin32Testcase'; aCfg.i.sDesc = 'Odin32 testcase setup'; i = i + 1; - aCfg.i.sId = 'owc14'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'OpenWatcomC14,32,'; aCfg.i.sDesc = 'Open Watcom C/C++ v1.4 32-bit'; i = i + 1; - aCfg.i.sId = 'owc14-16'; aCfg.i.sGrp = 'comp16'; aCfg.i.sSet = 'OpenWatcomC14,16,'; aCfg.i.sDesc = 'Open Watcom C/C++ v1.4 16-bit'; i = i + 1; - aCfg.i.sId = 'perl'; aCfg.i.sGrp = 'script'; aCfg.i.sSet = 'Perl580'; aCfg.i.sDesc = 'Perl v5.8.0'; i = i + 1; - aCfg.i.sId = 'perl580'; aCfg.i.sGrp = 'script'; aCfg.i.sSet = 'Perl580'; aCfg.i.sDesc = 'Perl v5.8.0'; i = i + 1; - aCfg.i.sId = 'perl50053'; aCfg.i.sGrp = 'script'; aCfg.i.sSet = 'Perl50xxx'; aCfg.i.sDesc = 'Perl v5.0053'; i = i + 1; - aCfg.i.sId = 'python'; aCfg.i.sGrp = 'script'; aCfg.i.sSet = 'Python'; aCfg.i.sDesc = 'Python v1.5'; i = i + 1; - aCfg.i.sId = 'svn'; aCfg.i.sGrp = 'version'; aCfg.i.sSet = 'Subversion'; aCfg.i.sDesc = 'Subversion 1.0.6 or later.'; i = i + 1; - aCfg.i.sId = 'toolkit40'; aCfg.i.sGrp = 'tlktos2'; aCfg.i.sSet = 'Toolkit40'; aCfg.i.sDesc = 'Toolkit v4.0 CSD 4'; i = i + 1; - aCfg.i.sId = 'toolkit40'; aCfg.i.sGrp = 'tlktos2'; aCfg.i.sSet = 'Toolkit40'; aCfg.i.sDesc = 'Toolkit v4.0 CSD 4'; i = i + 1; - aCfg.i.sId = 'toolkit45'; aCfg.i.sGrp = 'tlktos2'; aCfg.i.sSet = 'Toolkit45'; aCfg.i.sDesc = 'Toolkit v4.5'; i = i + 1; - aCfg.i.sId = 'toolkit451'; aCfg.i.sGrp = 'tlktos2'; aCfg.i.sSet = 'Toolkit451'; aCfg.i.sDesc = 'Toolkit v4.5.1'; i = i + 1; - aCfg.i.sId = 'toolkit452'; aCfg.i.sGrp = 'tlktos2'; aCfg.i.sSet = 'Toolkit452'; aCfg.i.sDesc = 'Toolkit v4.5.2'; i = i + 1; - aCfg.i.sId = 'unix'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'Unix'; aCfg.i.sDesc = 'Misc unix stuff.'; i = i + 1; - aCfg.i.sId = 'vac308'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'VAC308'; aCfg.i.sDesc = 'VisualAge for C++ v3.08'; i = i + 1; - aCfg.i.sId = 'vac365'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'VAC365'; aCfg.i.sDesc = 'VisualAge for C++ v3.6.5 FP2 with latest optimizer fixes.'; i = i + 1; - aCfg.i.sId = 'vac40'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'VAC40'; aCfg.i.sDesc = 'VisualAge for C++ v4.0 FP2(??)'; i = i + 1; - aCfg.i.sId = 'warpin'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'WarpIn'; aCfg.i.sDesc = 'WarpIn 0.9.18+ (for Odin32 18 with fix is required)'; i = i + 1; - aCfg.i.sId = 'watcomc11'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'WatcomC11,32,'; aCfg.i.sDesc = 'Watcom C/C++ v11.0 32-bit (no fixes)'; i = i + 1; - aCfg.i.sId = 'watcomc11-16'; aCfg.i.sGrp = 'comp16'; aCfg.i.sSet = 'WatcomC11,16'; aCfg.i.sDesc = 'Watcom C/C++ v11.0 16-bit (no fixes)'; i = i + 1; - aCfg.i.sId = 'watcomc11c'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'WatcomC11c,32'; aCfg.i.sDesc = 'Watcom C/C++ v11.0c 32-bit (beta)'; i = i + 1; - aCfg.i.sId = 'watcomc11c-16'; aCfg.i.sGrp = 'comp16'; aCfg.i.sSet = 'WatcomC11c,16'; aCfg.i.sDesc = 'Watcom C/C++ v11.0c 16-bit (beta)'; i = i + 1; - aCfg.0 = i - 1; - - - - /* - * Parse arguments - */ - do i = 1 to sEnv.0 - /* uses dash to mark end of arguments */ - if ((sEnv.i = '-') | (sEnv.i = '*')) then - leave; - - /* - * Get last char. - * Dash means remove, pluss means add, asterix means verify and configure. - * Pluss is default and optional. - * - */ - ch = substr(sEnv.i, length(sEnv.i), 1); - if (pos(ch, '+~-õ*!?@') > 0) then - sEnv.i = substr(sEnv.i, 1, length(sEnv.i) - 1); - else - ch = '+'; - fRM = (ch = '-' | ch = 'õ'); - fOptional = (ch = '~' | ch = 'õ') - fCfg = (ch = '*'); - fForcedCfg = (ch = '!'); - fVerify = (ch = '@') - fQuery = (ch = '?') - - /* - * do the switch. - */ - rc = 0; - select - - /* - * Multi tool operations. - */ - when (sEnv.i = 'allconfig') then do - do j = 1 to aCfg.0 - if (CfgVerify(j, 0, 1) <> 0) then - do - rc = CfgConfigure(j, 1); - if (rc >= 8) then - exit(rc); - end - end - end - - when (sEnv.i = 'allreconfig') then do - do j = 1 to aCfg.0 - rc = CfgConfigure(j, 1); - if (rc >= 8) then - exit(rc); - end - end - - when (sEnv.i = 'allverify') then do - do j = 1 to aCfg.0 - if (CfgIsConfigured(j)) then - call CfgVerify j, 0, 1; - end - end - - when (sEnv.i = 'alluninstall') then do - do j = 1 to aCfg.0 - if (CfgIsConfigured(j)) then - call CfgInstallUninstall j, 1; - end - end - - when (sEnv.i = 'showall') then do - do j = 1 to aCfg.0 - say left(aCfg.j.sId, 15) '-' left(aCfg.j.sGrp, 8) '-' aCfg.j.sDesc - sPath = PathQuery(aCfg.j.sId, aCfg.j.sId, 'quietisconfig'); - if (sPath <> '') then - say ' 'sPath; - end - end - when (sEnv.i = 'showconfigured') then do - do j = 1 to aCfg.0 - if (CfgIsConfigured(j)) then - do - say left(aCfg.j.sId, 15) '-' left(aCfg.j.sGrp, 8) '-' aCfg.j.sDesc - sPath = PathQuery(aCfg.j.sId, aCfg.j.sId, 'quietisconfig'); - if (sPath <> '') then - say ' 'sPath; - end - end - end - - when (sEnv.i = 'shownotconfigured') then do - do j = 1 to aCfg.0 - if (\CfgIsConfigured(j)) then - say left(aCfg.j.sId, 15) '-' left(aCfg.j.sGrp, 8) '-' aCfg.j.sDesc - end - end - - - /* - * Special 'tools'. - */ - when (sEnv.i = 'debug') then do - rc = EnvSet(0, 'DEBUG','1'); - rc = EnvSet(0, 'RELEASE',''); - rc = EnvSet(0, 'BUILD_MODE','DEBUG'); - end - when (sEnv.i = 'profile') then do - rc = EnvSet(0, 'DEBUG','1'); - rc = EnvSet(0, 'RELEASE',''); - rc = EnvSet(0, 'BUILD_MODE','PROFILE'); - end - when (sEnv.i = 'release') then do - rc = EnvSet(0, 'DEBUG',''); - rc = EnvSet(0, 'RELEASE','1'); - rc = EnvSet(0, 'BUILD_MODE','RELEASE'); - end - - when (sEnv.i = 'buildsetup') then - rc = EnvSet(0, 'BUILD_SETUP_MAK','make\setup.mak'); - - /* - * Generic - */ - otherwise - do - fFound = 0; - do j = 1 to aCfg.0 - if (aCfg.j.sId = sEnv.i) then - do - /* - * Found the environment. - */ - fFound = 1; - - /* - * Take requested action. - */ - rc = -16; - if (fCfg | fForcedCfg) then - rc = CfgConfigure(j, fForcedCfg); - else if (fVerify) then - rc = CfgVerify(j, 0, 1); - else if (fQuery) then - do - rc = 0; - if (\CfgIsConfigured(j)) then - return 3; - end - else - do - if (\fOptional) then - rc = CfgInstallUninstall(j, fRM); - else if (CfgIsConfigured(j)) then - rc = CfgInstallUninstall(j, fRM); - end - leave; - end - end /* loop */ - - if (\fFound) then - do - say 'error: unknown tool! - 'sEnv.i; - call SysSleep 2; - exit(16) - end - end /* otherwise */ - end /* select */ - end /* sEnv.i loop */ - - - /* - * Check for command to execute. - * (I.e. if there are more arguments left. after the dash/star.) - */ - if (i < sEnv.0) then - do - chType = sEnv.i; - - sCmd = ''; - do while (i < sEnv.0) - i = i + 1; - sCmd = sCmd ||' '||sEnv.i; - end - - if (chType = '-') then - do - Address CMD 'start /F' sCMD; - Address CMD 'exit'; - end - else - Address CMD sCMD; - exit(rc); - end - -exit(0); - - -/** - * No value handler - */ -NoValueHandler: - say 'NoValueHandler: line 'SIGL; -exit(16); - - - -/** - * Get the description of an tool. - * @returns Description string. - * '' if not found. - * @param sToolId Tool id. - */ -CfgDesc: procedure expose aCfg. aPath. - parse arg sToolId - do i = 1 to aCfg.0 - if (aCfg.i.sId = sToolId) then - return aCfg.i.sDesc; - end -return sToolId; - - -/** - * Lookups up an env. config in the aCfg. array. - * @return Index of sToolId. - * aCfg.0+1 on error. - * @param sToolId Tool id. - */ -CfgLookup: procedure expose aCfg. aPath. - parse arg sToolId - iTool = 1; - do while ((iTool <= aCfg.0) & (aCfg.iTool.sId <> sToolId)) - iTool = iTool + 1; - end -return iTool; - - -/** - * Verifies a configuration. - * @returns 0 on success. - * 4 on error/warnings which is continuable. - * 8 or higher or on fatal errors. - * @param iTool The tool index in aCfg. - * @param fRM If set we'll uninstall the tool from the environment. - */ -CfgInstallUninstall: procedure expose aCfg. aPath. - parse arg iTool, fRM - - /* make rexx expression */ - if (pos(',', aCfg.iTool.sSet) > 0) then - sRexx = substr(aCfg.iTool.sSet, 1, pos(',', aCfg.iTool.sSet) - 1) || '(aCfg.iTool.sId,sOperation,fRM,fQuiet', - || substr(aCfg.iTool.sSet, pos(',', aCfg.iTool.sSet)) || ')'; - else - sRexx = aCfg.iTool.sSet || '(aCfg.iTool.sId,sOperation,fRM,fQuiet)'; - fQuiet = 0; - if (\fRM) then sOperation = 'install'; - else sOperation = 'uninstall'; - - /* call the tool procedure with a verify operation. */ - interpret 'iRc = '||sRexx; - - /* On failure we'll complain and quietly uninstall the tool. */ - if (iRc <> 0) then - do - /* complain */ - if (\fQuiet) then - do - select - when (iRc = 1) then - say 'error - 'aCfg.iTool.sId': 'sOperation' not configured - ie. no path.'; - when (iRc = 2) then - say 'error - 'aCfg.iTool.sId': 'sOperation' failed ''cause some vital file/dir wasn''t found.'; - when (iRc = 49) then - say 'error - 'aCfg.iTool.sId': 'sOperation' failed ''cause some vital command didn''t return as expected.'; - when (iRc = 99) then - say 'error - 'aCfg.iTool.sId': 'sOperation' failed ''cause some vital command didn''t return the expected output.'; - otherwise - say 'internal error- 'aCfg.iTool.sId': bad return code from '''sRexx''' rc=' iRc'.'; - end - end - - /* uninstall silently */ - fRM = 1; - fQuiet = 1; - sOperation = 'quietuninstall'; - interpret 'rcignore = '||sRexx; - end -return iRc; - - - - -/** - * Configures an tool. - * @returns 0 on success. - * 4 on error/warnings which is continuable. - * 8 or higher or on fatal errors. - * @param iTool The tool configuration to configure. - * @param fForced If set, we'll force a reconfiguration of the tool. - */ -CfgConfigure: procedure expose aCfg. aPath. - parse arg iTool, fForced - - /* - * First verfiy the configuration quietly, we don't have to do anything if it's ok. - */ - if (\fForced & (CfgVerify(iTool, 1, 1) = 0)) then - return 0; - - /* - * We have to configure it! - */ - say '- Config of the 'aCfg.iTool.sId' ('CfgDesc(aCfg.iTool.sId)') tool.'; - - /* make rexx expression */ - if (pos(',', aCfg.iTool.sSet) > 0) then - sRexx = substr(aCfg.iTool.sSet, 1, pos(',', aCfg.iTool.sSet) - 1) || '(aCfg.iTool.sId,sOperation,fRM,fQuiet', - || substr(aCfg.iTool.sSet, pos(',', aCfg.iTool.sSet)) || ')'; - else - sRexx = aCfg.iTool.sSet || '(aCfg.iTool.sId,sOperation,fRM,fQuiet)'; - if (fForced) then sOperation = 'forcedconfig'; - else sOperation = 'config'; - fRM = 0; - fQuiet = 0; - - - /* - * Loop till rc=0 or user gives up. - */ - rc = -1 - do while (rc <> 0) - /* configure */ - interpret 'rc = '||sRexx; - - if (rc <> 0) then do - say 'warning: The user refused to give a path, continuing.'; - return 4; - end - - /* verifying */ - rc = CfgVerify(iTool, 0, 1); - sOperation = 'verify'; - if (rc = 0) then - leave; - - /* Retry the config if the user wanna do so. */ - say '' - say 'Retry configuring the tool' aCfg.iTool.sId '('CfgDesc(aCfg.iTool.sId)')? (y/N)'; - sAnswer = PullUser(1); - if (substr(strip(sAnswer),1,1) <> 'Y') then - return 4; - sOperation = 'forcedconfig'; - end - - /* - * Write path file and return successfully. - */ - call PathWrite; -return 0; - - -/** - * Verifies a configuration. - * @returns Return code from the environment procedure. - * @param iTool The tool index in aCfg. - * @param fQuiet If set we'll to a quiet verify. - * @param fCleanup If set we'll clean properly. - */ -CfgVerify: procedure expose aCfg. aPath. - parse arg iTool, fQuiet, fCleanup - - /* make rexx expression */ - if (pos(',', aCfg.iTool.sSet) > 0) then - sRexx = substr(aCfg.iTool.sSet, 1, pos(',', aCfg.iTool.sSet) - 1) || '(aCfg.iTool.sId,sOperation,fRM,fQuiet', - || substr(aCfg.iTool.sSet, pos(',', aCfg.iTool.sSet)) || ')'; - else - sRexx = aCfg.iTool.sSet || '(aCfg.iTool.sId,sOperation,fRM,fQuiet)'; - if (fQuiet) then sOperation = 'quietverify'; - else sOperation = 'verify'; - fRM = 0; - - /* call the tool procedure with a verify operation. */ - interpret 'iRc = '||sRexx; - - /* On failure we'll complain and quietly uninstall the tool. */ - if (iRc <> 0) then - do - /* complain */ - if (\fQuiet) then - do - select - when (iRc = 1) then - say 'warning - 'aCfg.iTool.sId': The user refused to give a path, continuing.'; - when (iRc = 2) then - say 'error - 'aCfg.iTool.sId': verify failed ''cause some vital file/dir wasn''t found.'; - when (iRc = 49) then - say 'error - 'aCfg.iTool.sId': verify failed ''cause some vital command didn''t return as expected.'; - when (iRc = 99) then - say 'error - 'aCfg.iTool.sId': verify failed ''cause some vital command didn''t return the expected output.'; - otherwise - say 'internal error- 'aCfg.iTool.sId': bad return code from '''sRexx''' iRc=' iRc'.'; - end - end - fCleanup = 1; - end - - /* uninstall */ - if (fCleanup) then - do - fRM = 1; - fQuiet = 1; - sOperation = 'quietuninstall'; - interpret 'rcignore = '||sRexx; - end -return iRc; - - -/** - * Verifies a configuration. - * @returns True if configured. - * False if not configured. - * @param iTool The tool index in aCfg. - * @param fQuiet If set we'll to a quiet verify. - */ -CfgIsConfigured: procedure expose aCfg. aPath. - parse arg iTool - - /* make rexx expression */ - if (pos(',', aCfg.iTool.sSet) > 0) then - sRexx = substr(aCfg.iTool.sSet, 1, pos(',', aCfg.iTool.sSet) - 1) || '(aCfg.iTool.sId,''quietisconfig'',0,1', - || substr(aCfg.iTool.sSet, pos(',', aCfg.iTool.sSet)) || ')'; - else - sRexx = aCfg.iTool.sSet || '(aCfg.iTool.sId,''quietisconfig'',0,1)'; - interpret 'iRc = '||sRexx; -return (iRc = 0); - - - -/** - * Checks if a file exists. - * @param sFile Name of the file to look for. - * @param fQuiet Flag which tells whether to be quiet or not. - * @param fOptional Flag to say that this file is optional. - * @returns TRUE if file exists. - * FALSE if file doesn't exists. - */ -CfgVerifyFile: procedure expose aCfg. aPath. - parse arg sFile, fQuiet, fOptional - if (fOptional = '') then fOptional = 0; - rc = stream(sFile, 'c', 'query exist'); - if ((rc = '') & \fQuiet) then - do - if (fOptional) then - say 'Warning: Installation is missing '''sFile'''.'; - else - say 'Verify existance of '''sFile''' failed.'; - end -return rc <> '' | fOptional; - - -/** - * Checks if a directory exists. - * @param sDir Name of the dir to look for. - * @param fQuiet Flag which tells whether to be quiet or not. - * @returns TRUE if file exists. - * FALSE if file doesn't exists. - */ -CfgVerifyDir: procedure expose aCfg. aPath. - parse arg sDir, fQuiet - rc = SysFileTree(sDir, 'sDirs', 'DO'); - if (rc = 0 & sDirs.0 = 1) then - return 1; - if (\fQuiet) then - say 'Verify existance of '''sDir''' failed.'; -return 0; - - - - - -/** - * The Directory Configuration Function. - * - * @returns Lower cased, absolute, backward slashed, path to program. - * @param sPathId Program identifier. (lowercase!) - */ -PathQuery: procedure expose aCfg. aPath. - parse arg sPathId, sToolId, sOperation, fOptional - - if (fOptional = '') then - fOptional = 0; - - if (aPath.0 = 0) then - do /* - * Read path config file - */ - call PathRead; - - /* - * If no data found fill in defaults (if known host). - */ - if (aPath.0 = 0) then - do - call PathSetDefault; - call PathWrite; - end - end - - /* - * Check for forced config. - */ - if (sOperation = 'forcedconfig') then - call PathRemove sPathId; - else - do - /* - * Search for the path. - */ - do i = 1 to aPath.0 - if (aPath.i.sPId = sPathId) then - do - return aPath.i.sPath; - leave; - end - end - end - - /* - * Path wasn't found! - */ - - /* for quiet verify, configured test and uninstall, fail sliently. */ - if ((sOperation = 'quietisconfig') | (sOperation = 'quietverify') | (sOperation = 'quietuninstall')) then - return ''; - - /* if configure operation the configure it. */ - if (pos('config', sOperation) > 0) then - return PathConfig(sOperation, sPathId, sToolId); - - /* elsewise this is an fatal error */ - if (\fOptional) then - do - say 'Fatal error: Path information for '''sPathId''' was not found.'; - call SysSleep 5; - exit(16); - end - -return ''; - - -/** - * Determins the full name of the path file to use. - * @returns Path to the pathfile to use. The file may not exist. - */ -PathGetFile: procedure - - /* - * Project Specific? - */ - parse source . . sPathFile . - sPathFile = sPathFile||'.paths'; - if (FileExists(sPathFile)) then - return sPathFile; - - /* - * ETC? - */ - sEtc = EnvGet('ETC'); - if (sEtc <> '') then - return sEtc||'\BuildEnv.cfg'; -return sPathFile; - - -/** - * Reads the path file into the 'aPath.' stem. - */ -PathRead: procedure expose aCfg. aPath. - - i = 1; /* Path index */ - iLine = 0; /* Line # in file */ - - - sPathFile = PathGetFile(); - - /* - * Read loop. - */ - do while (lines(sPathFile) > 0) - iLine = iLine + 1; - sLine = strip(linein(sPathFile)); - - /* - * Skip empty lines and comment lines, ie. starting with '#' or ';'. - */ - if ((sLine <> '') & (substr(sLine, 1, 1) <> '#') & (substr(sLine, 1, 1) <> ';')) then - do - /* - * Parse the line. - */ - parse var sLine aPath.i.sPId '=' aPath.i.sPath - aPath.i.sPId = strip(aPath.i.sPId); - aPath.i.sPath = strip(aPath.i.sPath); - - /* - * Validate the input. - */ - if ((aPath.i.sPath = '') | (aPath.i.sPId = '') | (translate(sLine,'','#!$@%|<>;õ&Ï') <> sLine) ) then - do - say 'fatal error: missformed line in path file at line 'iLine'!' - call stream sPathFile, 'c', 'close'; - call SysSleep 5; - exit(16); - end - i = i + 1; - end - end - call stream sPathFile, 'c', 'close'; - aPath.0 = i - 1; -return 0; - - -/** - * Writes the path file from what's in the 'aPath.' stem. - */ -PathWrite: procedure expose aCfg. aPath. - sPathFile = PathGetFile(); - call SysFileDelete(sPathFile); - do i = 1 to aPath.0 - /* skip if already written */ - j = 1; - do while (aPath.j.sPId <> aPath.i.sPId) - j = j + 1; - end - if (j >= i) then - call lineout sPathFile, aPath.i.sPId'='aPath.i.sPath; - end - call stream sPathFile, 'c', 'close'; -return 0; - - -/** - * Remove a path from the 'aPath.' stem. - * @returns 0 - * @param sPathId The id of the path to remove. - */ -PathRemove: procedure expose aCfg. aPath. - parse arg sPathId - - /* - * Find. - */ - i = 1; - do while (i <= aPath.0) - if (aPath.i.sPId = sPathId) then - leave; - i = i + 1; - end - - /* - * Move. - */ - if (i <= aPath.0) then - do - j = i + 1; - do while (j <= aPath.0) - aPath.i.sPId = aPath.j.sPId; - aPath.i.sPath = aPath.j.sPath; - j = j + 1; - i = i + 1; - end - aPath.0 = aPath.0 - 1; - end -return 0; - - -/** - * Sets a given path. - * @param sPathId Path id. - * @param sNewPath Path. - */ -PathSet: procedure expose aCfg. aPath. -parse arg sPathId, sNewPath - - /* - * Search for the path. - */ - do i = 1 to aPath.0 - if (aPath.i.sPId = sPathId) then - do - aPath.i.sPath = sNewPath; - return 0; - end - end - - /* - * Not found, so add it. - */ - i = aPath.0 + 1; - aPath.i.sPId = sPathId; - aPath.i.sPath = sNewPath; - aPath.0 = i; -return 0; - - - -/** - * Fills 'aPath.' with default settings overwriting anything in the table. - */ -PathSetDefault: procedure expose aCfg. aPath. - i = 1; - - /* - * Bird: home boxes. - */ - if ((translate(EnvGet('HOSTNAME')) = 'UNIVAC') | (translate(EnvGet('HOSTNAME')) = 'ENIAC')) then - do - say 'Info: No or empty path file, using birds defaults.'; - aPath.i.sPId = 'cvs'; aPath.i.sPath = 'f:\cvs\v1.11.2_os2'; i = i + 1; - aPath.i.sPId = 'db2v52'; aPath.i.sPath = 'f:\sqllib52'; i = i + 1; - aPath.i.sPId = 'ddk'; aPath.i.sPath = 'f:\DDK_os2\200204'; i = i + 1; - aPath.i.sPId = 'ddkbase'; aPath.i.sPath = 'f:\DDK_os2\200204\base'; i = i + 1; - aPath.i.sPId = 'ddkvideo'; aPath.i.sPath = 'f:\DDK_os2\200204\video'; i = i + 1; - aPath.i.sPId = 'doxygen'; aPath.i.sPath = 'f:\doxygen\v1.2.11-OS2'; i = i + 1; - aPath.i.sPId = 'emx'; aPath.i.sPath = 'f:\emx'; i = i + 1; - aPath.i.sPId = 'emxpgcc'; aPath.i.sPath = 'f:\GCC\v2.95.3_os2'; i = i + 1; - aPath.i.sPId = 'freetypeemx'; aPath.i.sPath = 'f:\Freetype\v1.3.1-emx\emx'; i = i + 1; - aPath.i.sPId = 'gcc302'; aPath.i.sPath = 'f:\GCC\v3.0.2beta_os2\emx'; i = i + 1; - aPath.i.sPId = 'gcc303'; aPath.i.sPath = 'f:\GCC\v3.0.3beta_os2\emx'; i = i + 1; - aPath.i.sPId = 'gcc321'; aPath.i.sPath = 'f:\GCC\v3.2.1beta_os2\emx'; i = i + 1; - aPath.i.sPId = 'gcc322'; aPath.i.sPath = 'f:\GCC\v3.2.2beta2_os2\usr'; i = i + 1; - aPath.i.sPId = 'home'; aPath.i.sPath = 'e:\user\kso'; i = i + 1; - aPath.i.sPId = 'icatgam'; aPath.i.sPath = 'f:\Icat\v4.0.6rc1_os2'; i = i + 1; - aPath.i.sPId = 'icatgam406rc1'; aPath.i.sPath = 'f:\Icat\v4.0.6rc1_os2'; i = i + 1; - aPath.i.sPId = 'icatpe'; aPath.i.sPath = 'f:\Icat\v4.0.5pe'; i = i + 1; - aPath.i.sPId = 'ida38'; aPath.i.sPath = 'f:\ida\v3.8'; i = i + 1; - aPath.i.sPId = 'ida40'; aPath.i.sPath = 'f:\ida\v4.0.1'; i = i + 1; - aPath.i.sPId = 'ida414'; aPath.i.sPath = 'f:\ida\v4.1.4'; i = i + 1; - aPath.i.sPId = 'idasdk'; aPath.i.sPath = 'f:\idasdk'; i = i + 1; - aPath.i.sPId = 'java131'; aPath.i.sPath = 'e:\java131'; i = i + 1; - aPath.i.sPId = 'jpeg'; aPath.i.sPath = 'f:\jpeg\v6b'; i = i + 1; - aPath.i.sPId = 'mscv6-16'; aPath.i.sPath = 'f:\msc\v6.0a_ibm'; i = i + 1; - aPath.i.sPId = 'mscv7-16'; aPath.i.sPath = 'f:\msc\v7.0'; i = i + 1; - aPath.i.sPId = 'mysql'; aPath.i.sPath = 'f:\mysql2'; i = i + 1; - aPath.i.sPId = 'nasm9833'; aPath.i.sPath = 'f:\nasm\v0.98.33_os2'; i = i + 1; - aPath.i.sPId = 'netqos2'; aPath.i.sPath = 'f:\netqos2'; i = i + 1; - aPath.i.sPId = 'perl50xxx'; aPath.i.sPath = 'f:\perl\v5.005_53_os2'; i = i + 1; - aPath.i.sPId = 'perl580'; aPath.i.sPath = 'f:\perl\v5.8.0_os2'; i = i + 1; - aPath.i.sPId = 'python'; aPath.i.sPath = 'f:\python\v1.5.2_os2'; i = i + 1; - aPath.i.sPId = 'svn'; aPath.i.sPath = 'f:\subversion\v1.0.6_os2'; i = i + 1; - aPath.i.sPId = 'toolkit40'; aPath.i.sPath = 'f:\toolkit\v4.0csd4'; i = i + 1; - aPath.i.sPId = 'toolkit45'; aPath.i.sPath = 'f:\toolkit\v4.5'; i = i + 1; - aPath.i.sPId = 'toolkit451'; aPath.i.sPath = 'f:\toolkit\v4.51'; i = i + 1; - aPath.i.sPId = 'toolkit452'; aPath.i.sPath = 'f:\toolkit\v4.52'; i = i + 1; - aPath.i.sPId = 'unixroot'; aPath.i.sPath = 'e:\unix'; i = i + 1; - aPath.i.sPId = 'vac308'; aPath.i.sPath = 'f:\VACpp\v3.08_os2'; i = i + 1; - aPath.i.sPId = 'vac365'; aPath.i.sPath = 'f:\VACpp\v3.65_os2'; i = i + 1; - aPath.i.sPId = 'vac40'; aPath.i.sPath = 'f:\VACpp\v4.0_os2'; i = i + 1; - aPath.i.sPId = 'warpin'; aPath.i.sPath = 'f:\WarpIn\current'; i = i + 1; - aPath.i.sPId = 'watcom11'; aPath.i.sPath = 'f:\watcom\v11.0'; i = i + 1; - aPath.i.sPId = 'watcom11c'; aPath.i.sPath = 'f:\watcom\v11.0c'; i = i + 1; - aPath.i.sPId = 'xfree86'; aPath.i.sPath = 'e:\xfree86'; i = i + 1; - aPath.i.sPId = 'testcase_drive_unused'; aPath.i.sPath = 'l'; /* reqired */ i = i + 1; - aPath.i.sPId = 'testcase_drive_fixed'; aPath.i.sPath = 'c'; /* reqired */ i = i + 1; - aPath.i.sPId = 'testcase_drive_floppy'; aPath.i.sPath = 'a'; /* reqired */ i = i + 1; - aPath.i.sPId = 'testcase_drive_cdrom'; aPath.i.sPath = 'i'; /* optional */ i = i + 1; - aPath.i.sPId = 'testcase_drive_network'; aPath.i.sPath = 'y'; /* optional */ i = i + 1; - aPath.i.sPId = 'testcase_drive_ramdisk'; aPath.i.sPath = 'r'; /* optional */ i = i + 1; - /*aPath.i.sPId = ''; aPath.i.sPath = i = i + 1;*/ - end - - - /* - * Bird: laptop box. - */ - if (translate(EnvGet('HOSTNAME')) = 'DELIRIUM') then - do - say 'Info: No or empty path file, using birds work defaults.'; - aPath.i.sPId = 'cvs'; aPath.i.sPath = 'e:\dev\cvs\v11.1'; i = i + 1; - aPath.i.sPId = 'emx'; aPath.i.sPath = 'e:\emx'; i = i + 1; - aPath.i.sPId = 'emxpgcc'; aPath.i.sPath = 'e:\dev\emxpgcc\v2.95.2'; i = i + 1; - aPath.i.sPId = 'gcc303'; aPath.i.sPath = 'e:\dev\gcc\v3.0.3\emx'; i = i + 1; - aPath.i.sPId = 'gcc321'; aPath.i.sPath = 'e:\dev\gcc\v3.2.1\emx'; i = i + 1; - /*aPath.i.sPId = 'db2v52'; aPath.i.sPath = 'e:\sqllib52'; i = i + 1; - aPath.i.sPId = 'icatgam'; aPath.i.sPath = 'e:\icatos2'; i = i + 1; - aPath.i.sPId = 'icatgam406rc1'; aPath.i.sPath = 'e:\icatos2.4.0.6.rc1'; i = i + 1; - aPath.i.sPId = 'icatpe'; aPath.i.sPath = 'e:\icatpe'; i = i + 1; - aPath.i.sPId = 'ida38'; aPath.i.sPath = 'e:\ida38'; i = i + 1; - aPath.i.sPId = 'ida40'; aPath.i.sPath = 'e:\ida401'; i = i + 1; */ - aPath.i.sPId = 'ida414'; aPath.i.sPath = 'e:\dev\ida\v414'; i = i + 1; - /*aPath.i.sPId = 'idasdk'; aPath.i.sPath = 'e:\idasdk'; i = i + 1; */ - aPath.i.sPId = 'ddk'; aPath.i.sPath = 'e:\dev\ddk\june02'; i = i + 1; - aPath.i.sPId = 'ddkbase'; aPath.i.sPath = 'e:\dev\ddk\june02\base'; i = i + 1; - aPath.i.sPId = 'ddkvideo'; aPath.i.sPath = 'e:\dev\ddk\june02\video'; i = i + 1; - aPath.i.sPId = 'home'; aPath.i.sPath = 'e:\home'; i = i + 1; - aPath.i.sPId = 'mscv6-16'; aPath.i.sPath = 'e:\dev\ddktools\toolkits\msc60'; i = i + 1; - /*aPath.i.sPId = 'mscv7-16'; aPath.i.sPath = 'e:\msc\v7.0'; i = i + 1; - aPath.i.sPId = 'mysql'; aPath.i.sPath = 'e:\mysql2'; i = i + 1; - aPath.i.sPId = 'netqos2'; aPath.i.sPath = 'e:\netqos2'; i = i + 1; - aPath.i.sPId = 'perl50xxx'; aPath.i.sPath = 'e:\perllib'; i = i + 1; - aPath.i.sPId = 'perl580'; aPath.i.sPath = 'e:\dev\perl\v5.8.0'; i = i + 1; - aPath.i.sPId = 'python'; aPath.i.sPath = 'e:\python'; i = i + 1; - aPath.i.sPId = 'toolkit40'; aPath.i.sPath = 'e:\toolkit'; i = i + 1; - aPath.i.sPId = 'toolkit45'; aPath.i.sPath = 'e:\toolkit45'; i = i + 1; - aPath.i.sPId = 'toolkit451'; aPath.i.sPath = 'e:\toolkit451'; i = i + 1; */ - aPath.i.sPId = 'toolkit452'; aPath.i.sPath = 'e:\dev\toolkit\v452'; i = i + 1; - aPath.i.sPId = 'unixroot'; aPath.i.sPath = 'e:\unix'; i = i + 1; - aPath.i.sPId = 'xfree86'; aPath.i.sPath = 'e:\xfree86'; i = i + 1; - aPath.i.sPId = 'vac308'; aPath.i.sPath = 'e:\dev\vacpp\v308'; i = i + 1; - aPath.i.sPId = 'vac365'; aPath.i.sPath = 'e:\dev\vacpp\v365'; i = i + 1; - /*aPath.i.sPId = 'vac40'; aPath.i.sPath = 'e:\ibmcpp40'; i = i + 1;*/ - aPath.i.sPId = 'warpin'; aPath.i.sPath = 'e:\warpin'; i = i + 1; - /*aPath.i.sPId = 'watcom11'; aPath.i.sPath = 'e:\watcom'; i = i + 1;*/ -/* aPath.i.sPId = 'watcom11c'; aPath.i.sPath = 'e:\dev\watcom\v11c'; i = i + 1; */ - aPath.i.sPId = 'testcase_drive_unused'; aPath.i.sPath = 't'; /* reqired */ i = i + 1; - aPath.i.sPId = 'testcase_drive_fixed'; aPath.i.sPath = 'd'; /* reqired */ i = i + 1; - aPath.i.sPId = 'testcase_drive_floppy'; aPath.i.sPath = 'a'; /* reqired */ i = i + 1; - aPath.i.sPId = 'testcase_drive_cdrom'; aPath.i.sPath = 'f'; /* optional */ i = i + 1; - aPath.i.sPId = 'testcase_drive_network'; aPath.i.sPath = 'x'; /* optional */ i = i + 1; - /*aPath.i.sPId = 'testcase_drive_ramdisk'; aPath.i.sPath = ''; /* optional */ i = i + 1;*/ - /*aPath.i.sPId = ''; aPath.i.sPath = i = i + 1;*/ - end - - - /* - * Bird: work boxes. - */ - if ((translate(EnvGet('HOSTNAME')) = 'DREAM') | (translate(EnvGet('HOSTNAME')) = 'DESPAIR')) then - do - say 'Info: No or empty path file, using birds work defaults.'; - aPath.i.sPId = 'cvs'; aPath.i.sPath = 'd:\dev\cvs\v11.1'; i = i + 1; - aPath.i.sPId = 'emx'; aPath.i.sPath = 'd:\emx'; i = i + 1; - aPath.i.sPId = 'emxpgcc'; aPath.i.sPath = 'd:\dev\emxpgcc\v2.95.2'; i = i + 1; - aPath.i.sPId = 'gcc303'; aPath.i.sPath = 'd:\dev\gcc\v3.0.3\emx'; i = i + 1; - aPath.i.sPId = 'gcc321'; aPath.i.sPath = 'd:\dev\gcc\v3.2.1\emx'; i = i + 1; - /*aPath.i.sPId = 'db2v52'; aPath.i.sPath = 'e:\sqllib52'; i = i + 1; - aPath.i.sPId = 'icatgam'; aPath.i.sPath = 'e:\icatos2'; i = i + 1; - aPath.i.sPId = 'icatgam406rc1'; aPath.i.sPath = 'e:\icatos2.4.0.6.rc1'; i = i + 1; - aPath.i.sPId = 'icatpe'; aPath.i.sPath = 'e:\icatpe'; i = i + 1; - aPath.i.sPId = 'ida38'; aPath.i.sPath = 'e:\ida38'; i = i + 1; - aPath.i.sPId = 'ida40'; aPath.i.sPath = 'e:\ida401'; i = i + 1; */ - aPath.i.sPId = 'ida414'; aPath.i.sPath = 'd:\dev\ida\v414'; i = i + 1; - /*aPath.i.sPId = 'idasdk'; aPath.i.sPath = 'e:\idasdk'; i = i + 1; */ - aPath.i.sPId = 'java131'; aPath.i.sPath = 'd:\java131'; i = i + 1; - aPath.i.sPId = 'ddk'; aPath.i.sPath = 'd:\dev\ddk\june02'; i = i + 1; - aPath.i.sPId = 'ddkbase'; aPath.i.sPath = 'd:\dev\ddk\june02\base'; i = i + 1; - aPath.i.sPId = 'ddkvideo'; aPath.i.sPath = 'd:\dev\ddk\june02\video'; i = i + 1; - aPath.i.sPId = 'home'; aPath.i.sPath = 'd:\home\bird'; i = i + 1; - aPath.i.sPId = 'mscv6-16'; aPath.i.sPath = 'd:\dev\ddktools\toolkits\msc60'; i = i + 1; - aPath.i.sPId = 'mscv7-16'; aPath.i.sPath = 'd:\dev\msc\v7.0'; i = i + 1; - aPath.i.sPId = 'mysql'; aPath.i.sPath = 'd:\apps\mysql\v3.23.50b1'; i = i + 1; - /*aPath.i.sPId = 'netqos2'; aPath.i.sPath = 'e:\netqos2'; i = i + 1;*/ - aPath.i.sPId = 'perl50xxx'; aPath.i.sPath = 'd:\dev\perl\v5.00455'; i = i + 1; - aPath.i.sPId = 'perl580'; aPath.i.sPath = 'd:\dev\perl\v5.8.0'; i = i + 1; - /*aPath.i.sPId = 'python'; aPath.i.sPath = 'e:\python'; i = i + 1;*/ - aPath.i.sPId = 'svn'; aPath.i.sPath = 'd:\dev\subversion\v1.0.6'; i = i + 1; - aPath.i.sPId = 'toolkit40'; aPath.i.sPath = 'd:\dev\toolkit\v40csd1'; i = i + 1; - /*aPath.i.sPId = 'toolkit45'; aPath.i.sPath = 'e:\toolkit45'; i = i + 1; - aPath.i.sPId = 'toolkit451'; aPath.i.sPath = 'e:\toolkit451'; i = i + 1; */ - aPath.i.sPId = 'toolkit452'; aPath.i.sPath = 'd:\dev\toolkit\v452'; i = i + 1; - aPath.i.sPId = 'unixroot'; aPath.i.sPath = 'd:\unix'; i = i + 1; - aPath.i.sPId = 'xfree86'; aPath.i.sPath = 'd:\xfree86'; i = i + 1; - aPath.i.sPId = 'vac308'; aPath.i.sPath = 'd:\dev\VACpp\v308'; i = i + 1; - aPath.i.sPId = 'vac365'; aPath.i.sPath = 'd:\dev\VACpp\v365'; i = i + 1; - aPath.i.sPId = 'vac40'; aPath.i.sPath = 'd:\dev\VACpp\v40ga'; i = i + 1; - aPath.i.sPId = 'warpin'; aPath.i.sPath = 'c:\warpin'; i = i + 1; - aPath.i.sPId = 'watcom11'; aPath.i.sPath = 'd:\dev\watcom\v110'; i = i + 1; - aPath.i.sPId = 'watcom11c'; aPath.i.sPath = 'd:\dev\watcom\v110c'; i = i + 1; - aPath.i.sPId = 'testcase_drive_unused'; aPath.i.sPath = 't'; /* reqired */ i = i + 1; - aPath.i.sPId = 'testcase_drive_fixed'; aPath.i.sPath = 'f'; /* reqired */ i = i + 1; - aPath.i.sPId = 'testcase_drive_floppy'; aPath.i.sPath = 'a'; /* reqired */ i = i + 1; - aPath.i.sPId = 'testcase_drive_cdrom'; aPath.i.sPath = 'g'; /* optional */ i = i + 1; - aPath.i.sPId = 'testcase_drive_network'; aPath.i.sPath = 'x'; /* optional */ i = i + 1; - aPath.i.sPId = 'testcase_drive_ramdisk'; aPath.i.sPath = 'r'; /* optional */ i = i + 1; - /*aPath.i.sPId = ''; aPath.i.sPath = i = i + 1;*/ - end - - /* add your own stuff here.. */ - aPath.0 = i - 1; -return 0; - - -/** - * Configure a path. - * @returns Path on success. - * '' on failure. - * @param sOperation The operation - 'config' or 'forcedconfig' - * @param sPathId The path to configure. - * @param sToolId The tool Id. - */ -PathConfig: procedure expose aCfg. aPath. - parse arg sOperation, sPathId, sToolId - - /* - * If not forced we'll ask first. - */ - if (sOperation <> 'forcedconfig') then - do - say 'Do you want to configure the path '''sPathId''/* for the '''sToolId'''('CfgDesc(sToolId)') tool?*/ '(y/N)'; - sAnswer = PullUser(1); - if (substr(strip(sAnswer),1,1) <> 'Y') then - return ''; - end - - /* - * Config loop. - */ - do i = 1 to 128 - - say 'Give us the path for '''sPathId'''('''sToolId'''/'CfgDesc(sToolId)'):' - sThePath = translate(strip(strip(strip(PullUser()), 'T','\'),'T','/'), '\', '/'); - /*say 'Debug: sThePath='sThePath;*/ - if ((sThePath <> '') & (sThePath = translate(sThePath,'','#!$@%|<>;õ&Ï='))) then - do - /* - * Add it to internal struct. - */ - call PathRemove(sPathId); - j = aPath.0 + 1; - aPath.j.sPId = strip(sPathId); - aPath.j.sPath = translate(strip(strip(strip(sThePath), 'T','\'),'T','/'), '\', '/'); - aPath.0 = j; - return sThePath; - end - else - say 'error: invalid path name.'; - say 'Debug 9' - - /* ask if retry */ - if (i >= 2) then - say 'You''re not trying hard, are you?'; - say 'Wanna try giving us an *valid* path for the path '''sPathId''' for the '''sToolId'''('CfgDesc(sToolId)') tool? (y/N)'; - sAnswer = PullUser(1); - if (substr(strip(sAnswer),1,1) <> 'Y') then - leave; - end - - say 'Giving up!'; -return ''; - - -/** - * Get user response and empties the input queue. - * @returns User input. - * @param fUpper If present and set uppercase the user response. - */ -PullUser: procedure - parse arg fUpper - if (fUpper = '') then - fUpper = 0; - - signal on halt name PullUser_Handler - signal on syntax name PullUser_Handler - signal on notready name PullUser_Handler - parse pull sAnswer; - signal off syntax - signal off halt - signal off notready - /*say 'Debug: sAnswer='c2x(sAnswer); - sAnswer = strip(strip(sAnswer, 'T', '0A'x), 'T', '0D'x);*/ - - if (fUpper) then - sAnswer = translate(sAnswer); - /* flush input */ - do while (Queued()) - pull dummy; - end -return sAnswer; - - -/** - * No value handler - */ -PullUser_Handler: - say 'fatal error: Believe Ctrl-Break/C might have been pressed.'; - signal off syntax - signal off halt - signal off syntax - signal off notready - do while (Queued()) - pull dummy; - end -exit(16); - - -/** - * Checks if a file exists. - * @param sFile Name of the file to look for. - * @param sComplain Complaint text. Complain if non empty and not found. - * @returns TRUE if file exists. - * FALSE if file doesn't exists. - */ -FileExists: procedure - parse arg sFile, sComplain - rc = stream(sFile, 'c', 'query exist'); - if ((rc = '') & (sComplain <> '')) then - say sComplain ''''sFile'''.'; -return rc <> ''; - - -/** - * Checks if a directory exists. - * @param sDir Name of the directory to look for. - * @param sComplain Complaint text. Complain if non empty and not found. - * @returns TRUE if file exists. - * FALSE if file doesn't exists. - */ -DirExists: procedure - parse arg sDir, sComplain - rc = SysFileTree(sDir, 'sDirs', 'DO'); - if (rc = 0 & sDirs.0 = 1) then - return 1; - if (sComplain <> '') then do - say sComplain ''''sDir'''.'; -return 0; - - -/** - * Add sToAdd in front of sEnvVar. - * Note: sToAdd now is allowed to be alist! - * - * Known features: Don't remove sToAdd from original value if sToAdd - * is at the end and don't end with a ';'. - */ -EnvAddFront: procedure - parse arg fRM, sEnvVar, sToAdd, sSeparator - - /* sets default separator if not specified. */ - if (sSeparator = '') then sSeparator = ';'; - - /* checks that sToAdd ends with an ';'. Adds one if not. */ - if (substr(sToAdd, length(sToAdd), 1) <> sSeparator) then - sToAdd = sToAdd || sSeparator; - - /* check and evt. remove ';' at start of sToAdd */ - if (substr(sToAdd, 1, 1) = ';') then - sToAdd = substr(sToAdd, 2); - - /* loop thru sToAdd */ - rc = 0; - i = length(sToAdd); - do while i > 1 & rc = 0 - j = lastpos(sSeparator, sToAdd, i-1); - rc = EnvAddFront2(fRM, sEnvVar, substr(sToAdd, j+1, i - j), sSeparator); - i = j; - end - -return rc; - -/** - * Add sToAdd in front of sEnvVar. - * - * Known features: Don't remove sToAdd from original value if sToAdd - * is at the end and don't end with a ';'. - */ -EnvAddFront2: procedure - parse arg fRM, sEnvVar, sToAdd, sSeparator - - /* sets default separator if not specified. */ - if (sSeparator = '') then sSeparator = ';'; - - /* checks that sToAdd ends with a separator. Adds one if not. */ - if (substr(sToAdd, length(sToAdd), 1) <> sSeparator) then - sToAdd = sToAdd || sSeparator; - - /* check and evt. remove the separator at start of sToAdd */ - if (substr(sToAdd, 1, 1) = sSeparator) then - sToAdd = substr(sToAdd, 2); - - /* Get original variable value */ - sOrgEnvVar = EnvGet(sEnvVar); - - /* Remove previously sToAdd if exists. (Changing sOrgEnvVar). */ - i = pos(translate(sToAdd), translate(sOrgEnvVar)); - if (i > 0) then - sOrgEnvVar = substr(sOrgEnvVar, 1, i-1) || substr(sOrgEnvVar, i + length(sToAdd)); - - /* set environment */ - if (fRM) then - return EnvSet(0, sEnvVar, sOrgEnvVar); -return EnvSet(0, sEnvVar, sToAdd||sOrgEnvVar); - - -/** - * Add sToAdd as the end of sEnvVar. - * Note: sToAdd now is allowed to be alist! - * - * Known features: Don't remove sToAdd from original value if sToAdd - * is at the end and don't end with a ';'. - */ -EnvAddEnd: procedure - parse arg fRM, sEnvVar, sToAdd, sSeparator - - /* sets default separator if not specified. */ - if (sSeparator = '') then sSeparator = ';'; - - /* checks that sToAdd ends with a separator. Adds one if not. */ - if (substr(sToAdd, length(sToAdd), 1) <> sSeparator) then - sToAdd = sToAdd || sSeparator; - - /* check and evt. remove ';' at start of sToAdd */ - if (substr(sToAdd, 1, 1) = sSeparator) then - sToAdd = substr(sToAdd, 2); - - /* loop thru sToAdd */ - rc = 0; - i = length(sToAdd); - do while i > 1 & rc = 0 - j = lastpos(sSeparator, sToAdd, i-1); - rc = EnvAddEnd2(fRM, sEnvVar, substr(sToAdd, j+1, i - j), sSeparator); - i = j; - end - -return rc; - -/** - * Add sToAdd as the end of sEnvVar. - * - * Known features: Don't remove sToAdd from original value if sToAdd - * is at the end and don't end with a ';'. - */ -EnvAddEnd2: procedure - parse arg fRM, sEnvVar, sToAdd, sSeparator - - /* sets default separator if not specified. */ - if (sSeparator = '') then sSeparator = ';'; - - /* checks that sToAdd ends with a separator. Adds one if not. */ - if (substr(sToAdd, length(sToAdd), 1) <> sSeparator) then - sToAdd = sToAdd || sSeparator; - - /* check and evt. remove separator at start of sToAdd */ - if (substr(sToAdd, 1, 1) = sSeparator) then - sToAdd = substr(sToAdd, 2); - - /* Get original variable value */ - sOrgEnvVar = EnvGet(sEnvVar); - - if (sOrgEnvVar <> '') then - do - /* Remove previously sToAdd if exists. (Changing sOrgEnvVar). */ - i = pos(translate(sToAdd), translate(sOrgEnvVar)); - if (i > 0) then - sOrgEnvVar = substr(sOrgEnvVar, 1, i-1) || substr(sOrgEnvVar, i + length(sToAdd)); - - /* checks that sOrgEnvVar ends with a separator. Adds one if not. */ - if (sOrgEnvVar = '') then - if (right(sOrgEnvVar,1) <> sSeparator) then - sOrgEnvVar = sOrgEnvVar || sSeparator; - end - - /* set environment */ - if (fRM) then return EnvSet(0, sEnvVar, sOrgEnvVar); -return EnvSet(0, sEnvVar, sOrgEnvVar||sToAdd); - - -/** - * Sets sEnvVar to sValue. - */ -EnvSet: procedure - parse arg fRM, sEnvVar, sValue - - /* if we're to remove this, make valuestring empty! */ - if (fRM) then - sValue = ''; - sEnvVar = translate(sEnvVar); - - /* - * Begin/EndLibpath fix: - * We'll have to set internal these using both commandline 'SET' - * and internal VALUE in order to export it and to be able to - * get it (with EnvGet) again. - */ - if ((sEnvVar = 'BEGINLIBPATH') | (sEnvVar = 'ENDLIBPATH')) then - do - if (length(sValue) >= 1024) then - say 'Warning: 'sEnvVar' is too long,' length(sValue)' char.'; - return SysSetExtLibPath(sValue, substr(sEnvVar, 1, 1)); - end - - if (length(sValue) >= 1024) then - do - say 'Warning: 'sEnvVar' is too long,' length(sValue)' char.'; - say ' This may make CMD.EXE unstable after a SET operation to print the environment.'; - end - sRc = VALUE(sEnvVar, sValue, 'OS2ENVIRONMENT'); -return 0; - -/** - * Gets the value of sEnvVar. - */ -EnvGet: procedure - parse arg sEnvVar - if ((translate(sEnvVar) = 'BEGINLIBPATH') | (translate(sEnvVar) = 'ENDLIBPATH')) then - return SysQueryExtLibPath(substr(sEnvVar, 1, 1)); -return value(sEnvVar,, 'OS2ENVIRONMENT'); - - -/** - * Workaround for bug in CMD.EXE. - * It messes up when REXX have expanded the environment. - */ -FixCMDEnv: procedure - /* check for 4OS2 first */ - Address CMD 'set 4os2test_env=%@eval[2 + 2]'; - if (value('4os2test_env',, 'OS2ENVIRONMENT') = '4') then - return 0; - - /* force environment expansion by setting a lot of variables and freeing them. */ - do i = 1 to 100 - Address CMD '@set dummyenvvar'||i'=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'; - end - do i = 1 to 100 - Address CMD '@set dummyenvvar'||i'='; - end -return 0; - - -/** - * Execute a command and match output and return code. - * - * @returns 0 on match. - * 49 on return code mismatch. - * 99 on output mistmatch. - * @param sCmd The command to execute. - * @param rcCmdExepcted The expected return code from the command. - * @param sOutputPartExpected A 'needle' of the output 'haystack'. - */ -CheckCmdOutput: procedure - parse arg sCmd, rcCmdExpected, fQuiet, sOutputPartExpected - - /* - * Try execute the command - */ - queTmp = RxQueue('Create'); - queOld = RxQueue('Set', queTmp); - Address CMD sCmd || ' 2>&1 | RxQueue' queTmp; - rcCmd = rc; - - /* get output */ - sOutput = ''; - do while (queued() > 0) - parse pull sLine - sOutput = sOutput || sLine || '0d0a'x - end - call RxQueue 'Delete', RxQueue('Set', queOld); - - /* - * If command - */ - rc = 0; - if (/*rcCmd = rcCmdExpected*/ 1) then /* doesn't work with cmd.exe */ - do - if (pos(sOutputPartExpected, sOutput) <= 0) then - do - say 'Debug - start' - say 'Debug:' sOutputPartExpected - say 'Debug: not found in:' - say sOutput - say 'Debug - end' - rc = 99 - end - end - else - rc = 49 - - if (\fQuiet & rc <> 0) then - say 'Debug:' sCmd 'rc='rc' rcCmd='rcCmd 'rcCmdExpected='rcCmdExpected; -return rc; - - -/** - * Checks syslevel info. - * @returns 0 if match. - * <>0 if mismatch. - * @param sFile Name of the syslevel file. - * @param fQuiet Quiet / verbose flag. - * @param sMatchCid Component id. (optional) - * @param sMatchVer Version id. (optional) - * @param sMatchLevel Current Level. (optional) - * @param sMatchTitle Product title. (optional) - * @param sMatchKind Product kind. (optional) - * @param sMatchType Product type. (optional) - */ -CheckSyslevel: procedure -parse arg sFile, fQuiet, sMatchCId,sMatchVer,sMatchLevel,sMatchTitle,iMatchKind,sMatchType,dummy - - iRc = -1; - - /* Open the file */ - rc = stream(sFile, 'c', 'open read'); - if (pos('READY', rc) = 1) then - do - if (charin(sFile, 1, 11) = 'FF'x'FF'x'SYSLEVEL'||'00'x) then - do - /* read base offset (binary long) */ - iBase = c2x(charin(sFile, 34, 4)); - iBase = 1 + x2d(right(iBase,2)||substr(iBase,5,2)||substr(iBase,3,2)||left(iBase,2)); - - /* Read fields... - * - * typedef struct _SYSLEVELDATA { offset - * unsigned char d_reserved1[2]; 0 - * unsigned char d_kind; 2 - * unsigned char d_version[2]; 3 - * unsigned char d_reserved2[2]; 5 - * unsigned char d_clevel[7]; 7 - * unsigned char d_reserved3; 14 - * unsigned char d_plevel[7]; 15 - * unsigned char d_reserved4; 22 - * unsigned char d_title[80]; 23 - * unsigned char d_cid[9]; 103 - * unsigned char d_revision; 112 - * unsigned char d_type[1]; 113 - * } SYSLEVELDATA; - */ - iKind = c2d(charin(sFile, iBase+ 2, 1)); - iVer = charin(sFile, iBase+ 3, 2); - sCurLevel = strip(charin(sFile, iBase+ 7, 7), 'T', '00'x); - sPreLevel = strip(charin(sFile, iBase+ 15, 7), 'T', '00'x); - sTitle = strip(charin(sFile, iBase+ 23, 80), 'T', '00'x); - sCId = charin(sFile, iBase+103, 9); - iRev = charin(sFile, iBase+112, 1); - sType = strip(charin(sFile, iBase+113, 10), 'T', '00'x); - - sVer = substr(c2x(substr(iVer, 1, 1)), 1, 1)||, - '.'||, - substr(c2x(substr(iVer, 1, 1)), 2, 1)||, - d2c(c2d(substr(iVer, 2, 1)) + 48); - if (iRev <> 0) then - sVer = sVer ||'.'|| d2c(c2d(iRev) + 48); - - /* - * Compare. - */ - iRc = 0; - if (sMatchCId <> '' & sMatchCId <> sCid) then - do - if (\fQuiet) then - say 'syslevel '''sFile''': cid '''sCId''' != '''sMatchCId'''.'; - iRc = 2; - end - if (sMatchVer <> '' & sMatchVer <> sVer) then - do - if (\fQuiet) then - say 'syslevel '''sFile''': ver '''sVer''' != '''sMatchVer'''.'; - iRc = 3; - end - if (sMatchLevel <> '' & sMatchLevel <> sCurLevel) then - do - if (\fQuiet) then - say 'syslevel '''sFile''': level '''sCurLevel''' != '''sMatchLevel'''.'; - iRc = 4; - end - if (sMatchTitle <> '' & sMatchTitle <> sTitle) then - do - if (\fQuiet) then - say 'syslevel '''sFile''': title '''sTitle''' != '''sMatchTitle'''.'; - iRc = 5; - end - if (iMatchKind <> '' & iMatchKind <> iKind) then - do - if (\fQuiet) then - say 'syslevel '''sFile''': kind '''iKind''' != '''iMatchKind'''.'; - iRc = 6; - end - if (sMatchType <> '' & sMatchType <> sType) then - do - if (\fQuiet) then - say 'syslevel '''sFile''': type '''sType''' != '''sMatchType'''.'; - iRc = 7; - end - /* - say 'debug:' - say 'iKind =' iKind - say 'sCurLevel =' sCurLevel - say 'sPreLevel =' sPreLevel - say 'sTitle =' sTitle - say 'sCId =' sCId - say 'sType =' sType - say 'sVer =' sVer - */ - end - else - say 'bad signature'; - - /* finished, close file */ - call stream sFile, 'c', 'close'; - end - else say 'open failed, rc='rc; -return iRc; - - - -/** - * Tool procedures section - * @returns 0 on success. - * 1 if PathQuery() failed. - * 2 if some vital file/dir wasn't found in the config verify. - * 49 if verify command rc mismatched. - * 99 if verify command output mismatched. - **/ - - -/* - * Concurrent Versions System (CVS) - */ -CVS: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - - /* - * The directories. - */ - sPathCVS = PathQuery('cvs', sToolId, sOperation); - if (sPathCVS = '') then - return 1; - sPathHome = PathQuery('home', sToolId, sOperation); - if (sPathHome = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_CVS', sPathCVS; - call EnvAddFront fRM, 'path', sPathCVS'\bin;' - call EnvAddFront fRM, 'bookshelf', sPathCVS'\book;' - call EnvAddFront fRM, 'bookshelf', sPathCVS'\book;' - call EnvSet fRM, 'home', translate(sPathHome, '/','\'); - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - - if (\CfgVerifyFile(sPathCVS'\bin\cvs.exe',fQuiet)) then - return 2; - if (length(sPathHome) <= 2) then - do - if (\fQuiet) then - say 'Error: The home directory is to short!'; - return 2; - end - if (\CfgVerifyDir(sPathHome, fQuiet)) then - return 2; -return CheckCmdOutput('cvs --version', 0, fQuiet, 'Concurrent Versions System (CVS) 1.1'); - - -/* - * EMX - */ -EMX: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * EMX/GCC main directory. - */ - sEMX = PathQuery('emx', sToolId, sOperation); - if (sEMX = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - sEMXBack = translate(sEMX, '\', '/'); - sEMXForw = translate(sEMX, '/', '\'); - call EnvSet fRM, 'PATH_EMX', sEMXBack; - call EnvSet fRM, 'CCENV', 'EMX' - call EnvSet fRM, 'BUILD_ENV', 'EMX' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - - call EnvAddFront fRM, 'BEGINLIBPATH', sEMXBack'\dll;' - call EnvAddFront fRM, 'PATH', sEMXBack'\bin;' - call EnvAddFront fRM, 'DPATH', sEMXBack'\book;' - call EnvAddFront fRM, 'BOOKSHELF', sEMXBack'\book;' - call EnvAddFront fRM, 'HELP', sEMXBack'\help;' - call EnvAddFront fRM, 'C_INCLUDE_PATH', sEMXForw'/include' - call EnvAddFront fRM, 'LIBRARY_PATH', sEMXForw'/lib' - call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sEMXForw'/include/cpp;'sEMXForw'/include' - call EnvSet fRM, 'PROTODIR', sEMXForw'/include/cpp/gen' - call EnvSet fRM, 'OBJC_INCLUDE_PATH', sEMXForw'/include' - call EnvSet fRM, 'GCCLOAD', '5' - call EnvSet fRM, 'GCCOPT', '-pipe' - call EnvAddFront fRM, 'INFOPATH', sEMXForw'/info' - call EnvSet fRM, 'EMXBOOK', 'emxdev.inf+emxlib.inf+emxgnu.inf+emxbsd.inf' - call EnvAddFront fRM, 'HELPNDX', 'emxbook.ndx', '+', 1 - call EnvSet fRM, 'EMXOPT', '-c -n -h1024' - if EnvGet('TERM') = '' then do - call EnvSet fRM, 'TERM', 'ansi' - call EnvSet fRM, 'TERMCAP', sEMXForw'/etc/termcap.dat' - end - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sEmxBack'\bin\gcc.exe', fQuiet), - | \CfgVerifyFile(sEmxBack'\bin\emxomf.exe', fQuiet), - | \CfgVerifyFile(sEmxBack'\bin\emxrev.cmd', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\mt\c.a', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\mt\c.lib', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\mt\sys.lib', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\mt\emx.a', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\mt\emx.lib', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\mt\c_import.a', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\mt\c_import.lib', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\c_alias.a', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\c_alias.lib', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\emx2.a', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\emx2.lib', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('gcc --version', 0, fQuiet, '2.8.1'); - if (rc = 0) then - rc = CheckCmdOutput('emxrev.cmd', 0, fQuiet,, - 'EMX : revision = 61'||'0d0a'x ||, - 'EMXIO : revision = 60'||'0d0a'x||, - 'EMXLIBC : revision = 63'||'0d0a'x||, - 'EMXLIBCM : revision = 64'||'0d0a'x||, - 'EMXLIBCS : revision = 64'||'0d0a'x||, - 'EMXWRAP : revision = 60'||'0d0a'x); - return rc; -return 0; - - -/* - * EMX PGCC - must be installed on to the ordinar EMX. - */ -EMXPGCC: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * EMX/GCC main directory. - */ - sEMXPGCC = PathQuery('emxpgcc', sToolId, sOperation); - if (sEMXPGCC = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - sEMXBack = translate(sEMXPGCC, '\', '/'); - sEMXForw = translate(sEMXPGCC, '/', '\'); - call EnvSet fRM, 'PATH_EMXPGCC', sEMXBack; - call EnvSet fRM, 'CCENV', 'EMX' - call EnvSet fRM, 'BUILD_ENV', 'EMX' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - - call EnvAddFront fRM, 'BEGINLIBPATH', sEMXBack'\dll;' - call EnvAddFront fRM, 'PATH', sEMXBack'\bin;' - call EnvAddFront fRM, 'DPATH', sEMXBack'\book;' - call EnvAddFront fRM, 'BOOKSHELF', sEMXBack'\book;' - call EnvAddFront fRM, 'HELP', sEMXBack'\help;' - call EnvAddFront fRM, 'C_INCLUDE_PATH', sEMXForw'/include' - call EnvAddFront fRM, 'LIBRARY_PATH', sEMXForw'/lib' - call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sEMXForw'/include/cpp;'sEMXForw'/include' - call EnvSet fRM, 'PROTODIR', sEMXForw'/include/cpp/gen' - call EnvSet fRM, 'OBJC_INCLUDE_PATH', sEMXForw'/include' - call EnvAddFront fRM, 'INFOPATH', sEMXForw'/info' - call EnvSet fRM, 'EMXBOOK', 'emxdev.inf+emxlib.inf+emxgnu.inf+emxbsd.inf' - call EnvAddFront fRM, 'HELPNDX', 'emxbook.ndx', '+', 1 - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sEmxBack'\bin\gcc.exe', fQuiet), - | \CfgVerifyFile(sEmxBack'\bin\g++.exe', fQuiet), - | \CfgVerifyFile(sEmxBack'\bin\as.exe', fQuiet), - | \CfgVerifyFile(sEmxBack'\bin\emxomf.exe', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\gcc29160.a', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\gcc29160.lib', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\iberty.a', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\iberty.lib', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\iberty_s.a', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\iberty_s.lib', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\opcodes.a', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\opcodes.lib', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\opcodes_s.a', fQuiet), - | \CfgVerifyFile(sEmxBack'\lib\opcodes_s.lib', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('gcc --version', 0, fQuiet, 'pgcc-2.95.2'); - if (rc = 0) then - rc = CheckCmdOutput('g++ --version', 0, fQuiet, 'pgcc-2.95.2'); - if (rc = 0) then - rc = CheckCmdOutput('as --version', 0, fQuiet, 'GNU assembler 2.9.1'); -return rc; - - -/* - * FreeType v1.3.1 EMX release. - */ -FreeTypeEMX: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - sPathFreeType = PathQuery('freetypeemx', sToolId, sOperation); - if (sPathFreeType = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - call EnvSet fRm, 'PATH_FREETYPE', sPathFreeType; - call EnvAddFront fRm, 'beginlibpath',sPathFreeType'\dll;' - call EnvAddFront fRm, 'path', sPathFreeType'\bin;' - call EnvAddFront fRM, 'include', sPathFreeType'\include;' - call EnvAddFront fRM, 'C_INCLUDE_PATH', sPathFreeType'\include;' - call EnvAddFront fRM, 'lib', sPathFreeType'\lib;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - - if ( \CfgVerifyFile(sPathFreeType'\bin\ftsbit.exe', fQuiet), - | \CfgVerifyFile(sPathFreeType'\bin\ftzoom.exe', fQuiet), - | \CfgVerifyFile(sPathFreeType'\dll\ttf.dll', fQuiet), - ) then - return 2; -return 0; - - -/* - * IBM DB2 v5.2 - */ -db2v52: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - sPathDB2 = PathQuery('db2v52', sToolId, sOperation); - if (sPathDB2 = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - call EnvSet fRm, 'PATH_DB2', sPathDB2; - call EnvSet fRm, 'db2path', sPathDB2; - call EnvAddFront fRm, 'beginlibpath',sPathDB2'\dll;'sPathDB2'\alt;' - call EnvAddFront fRm, 'path', sPathDB2'\bin;'sPathDB2'\alt;' - call EnvAddFront fRm, 'dpath', sPathDB2'\bin;'sPathDB2';' - call EnvAddFront fRm, 'help', sPathDB2'\help;' - call EnvAddEnd fRm, 'classpath', '.;'sPathDB2'\JAVA\DB2JAVA.ZIP;'sPathDB2'\JAVA\RUNTIME.ZIP;'sPathDB2'\JAVA\SQLJ.ZIP;' - call EnvSet fRM, 'db2instace', 'DB2' - /*call EnvSet fRM, 'odbc_path', 'f:\odbc' -- huh? what's this? */ - call EnvAddFront fRM, 'cobcpy', sPathDB2'\include\cobol_mf' - call EnvSet fRM, 'finclude', sPathDB2'\include' - call EnvAddFront fRM, 'include', sPathDB2'\include;' - call EnvAddFront fRM, 'lib', sPathDB2'\lib;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - - if ( \CfgVerifyFile(sPathDB2'\bin\db2.exe', fQuiet), - | \CfgVerifyFile(sPathDB2'\bin\sqlbind.exe', fQuiet), - | \CfgVerifyFile(sPathDB2'\bin\sqlprep.exe', fQuiet), - | \CfgVerifyFile(sPathDB2'\lib\db2api.lib', fQuiet), - | \CfgVerifyFile(sPathDB2'\lib\db2cli.lib', fQuiet), - | \CfgVerifyFile(sPathDB2'\lib\db2gmf32.lib', fQuiet), - | \CfgVerifyFile(sPathDB2'\include\sql.h', fQuiet), - | \CfgVerifyFile(sPathDB2'\include\sqlcodes.h', fQuiet), - | \CfgVerifyFile(sPathDB2'\include\sqlsystm.h', fQuiet), - | \CfgVerifyFile(sPathDB2'\include\sqlcli.h', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('echo quit | db2', 0, fQuiet, 'Command Line Processor for DB2 SDK 5.2.0'); -return rc; - - - -/* - * Device Driver Kit (DDK) base. - */ -DDK: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Device Driver Kit (DDK) (v4.0+) Main Directory. - */ - sPathDDK = PathQuery('ddk', sToolId, sOperation); - if (sPathDDK = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - do - /* Set the ddk subpaths */ - if (PathQuery('ddkbase', 'ddkbase', 'quietisconfig') = '') then - call PathSet 'ddkbase', sPathDDK'\base'; - if (PathQuery('ddkvideo', 'ddkvideo', 'quietisconfig') = '') then - call PathSet 'ddkvideo', sPathDDK'\video'; - if (PathQuery('ddkprint', 'ddkvideo', 'quietisconfig') = '') then - call PathSet 'ddkprint', sPathDDK'\print'; - return 0; - end - call EnvSet fRM, 'PATH_DDK', sPathDDK; - rc = DDKBase('ddkbase',sOperation,fRM,fQuiet) - if (rc = 0) then - rc = DDKVideo('ddkvideo',sOperation,fRM,fQuiet) -return rc; - - -/* - * Device Driver Kit (DDK) base. - */ -DDKBase: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Device Driver Kit (DDK) (v4.0+) base (important not main) directory. - */ - sPathDDKBase = PathQuery('ddkbase', sToolId, sOperation); - if (sPathDDKBase = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - call EnvSet fRM, 'PATH_DDKBASE',sPathDDKBase; - call EnvAddFront fRM, 'path', sPathDDKBase'\tools;' - call EnvAddFront fRM, 'include', sPathDDKBase'\h;'sPathDDKBase'\inc;'sPathDDKBase'\inc32;' - call EnvAddFront fRM, 'include16', sPathDDKBase'\h;' - call EnvAddFront fRM, 'lib', sPathDDKBase'\lib;' - call EnvAddFront fRM, 'bookshelf', sPathDDKBase'\..\docs;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathDDKBase'\tools\link.exe', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\tools\link386.exe', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\tools\cl386.exe', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\tools\masm.exe', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\tools\h2inc.exe', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\tools\lib.exe', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\lib\os2286.lib', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\lib\os2286p.lib', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\lib\os2386.lib', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\lib\os2386p.lib', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\lib\doscalls.lib', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\lib\dhcalls.lib', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\lib\addcalls.lib', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\lib\rmcalls.lib', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\lib\vdh.lib', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\h\infoseg.h', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\h\include.h', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\h386\pmddi.h', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\h386\pmddim.h', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\h386\limits.h', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\h386\string.h', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\inc\v8086.inc', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\inc\sas.inc', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\inc\pmwinx.inc', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\inc\infoseg.inc', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\inc\devhlp.inc', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\inc\devhlpp.inc', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('cl386', 0, fQuiet, 'Microsoft (R) Microsoft 386 C Compiler. Version 6.00.054'); - if (rc = 0) then - rc = CheckCmdOutput('masm nul,nul,nul,nul;', 2, fQuiet, 'Microsoft (R) Macro Assembler Version 5.10A.15 Jul 07 15:25:03 1989'); - if (rc = 0) then - rc = CheckCmdOutput('h2inc -?', 0, fQuiet, 'h2inc - .H to .INC file translator (version 13.29)'); - if (rc = 0) then - rc = CheckCmdOutput('type' sPathDDKBase'\inc\devhlp.inc', 0, fQuiet, 'DevHlp_ReadFileAt'); -return rc; - - -/* - * Device Driver Kit (DDK) Video. - */ -DDKVideo: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Device Driver Kit (DDK) (v4.0+) Video (important not main) directory. - */ - sPathDDKVideo = PathQuery('ddkvideo', sToolId, sOperation); - if (sPathDDKVideo = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - call EnvSet fRM, 'PATH_DDKVIDEO',sPathDDKVideo; - call EnvAddFront fRM, 'path', sPathDDKVideo'\tools\os2.386\bin;'sPathDDKVideo'\tools\os2.386\lx.386\bin;' /* might not need this... */ - call EnvAddFront fRM, 'include', sPathDDKVideo'\rel\os2c\include\base\os2;'/*sPathDDKVideo'\rel\os2c\include\base\os2\16bit;'sPathDDKVideo'\rel\os2c\include\base\os2\inc;'sPathDDKVideo'\rel\os2c\include\base\os2\inc32;' /* might be over kill!! */ - it is! */ - call EnvAddFront fRM, 'include16', sPathDDKVideo'\rel\os2c\include\base\os2\16bit;' - call EnvAddFront fRM, 'lib', sPathDDKVideo'\rel\os2c\lib\os2;'sPathDDKVideo'\rel\os2c\lib\os2\priv;' - call EnvAddFront fRM, 'bookshelf', sPathDDKVideo'\..\docs;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\doscalls.lib', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\gradd.lib', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\os2386.lib', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\libh.lib', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\vdh.lib', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\thunkrt.lib', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\dbcs32.lib', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\priv\pmwp.lib', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\priv\os2286p.lib', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\vvga.def', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\vvga.def', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\include\base\os2\gradd.h', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\include\base\os2\pmwp.h', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\include\base\os2\os2p.h', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\include\base\os2\pmgpip.h', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\include\base\os2\pmdevp.h', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\include\base\os2\inc32\pmp.inc', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\bin\rc.exe', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\bin\nmake.exe', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\bin\h2inc.exe', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\lx.386\bin\link386.exe', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\lx.386\bin\masm.exe', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\lx.386\bin\masm.exe', fQuiet), - | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\lx.386\bin\mcl386\bin\c3_386.exe', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('nmake -?', 0, fQuiet, 'Version 2.001.000 Jan 28 1994'); - if (rc = 0) then - rc = CheckCmdOutput('masm nul,nul,nul,nul;', 2, fQuiet, 'Microsoft (R) Macro Assembler Version 5.10A.15 Jul 07 15:25:03 1989'); - if (rc = 0) then - rc = CheckCmdOutput('h2inc -?', 0, fQuiet, 'h2inc - .H to .INC file translator (version 13.29)'); - if (rc = 0) then - rc = CheckCmdOutput('type 'sPathDDKVideo'\rel\os2c\include\base\os2\gradd.h', 0, fQuiet, 'GHI_CMD_POLYGON'); -return rc; - - -/* - * Doxygen v1.2.11.1 for OS/2. - */ -DoxyGen: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Get base directory. - */ - sPathDoxyGen = PathQuery('doxygen', sToolId, sOperation); - if (sPathDoxyGen = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - call EnvSet fRM, 'PATH_DOXYGEN',sPathDoxyGen; - call EnvAddFront fRM, 'path', sPathDoxyGen'\bin;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathDoxyGen'\bin\dot.exe', fQuiet), - | \CfgVerifyFile(sPathDoxyGen'\bin\doxygen.exe', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('doxygen', 1, fQuiet, 'Doxygen version 1.2.11.1'); -return rc; - - -/* - * EMX/GCC 3.x.x - this environment must be used 'on' the ordinary EMX. - * Note! bin.new has been renamed to bin! - * Note! make .lib of every .a! in 4OS2: for /R %i in (*.a) do if not exist %@NAME[%i].lib emxomf %i - */ -GCC3xx: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet,sPathId - - /* - * EMX/GCC main directory. - */ - sGCC = PathQuery(sPathId, sToolId, sOperation); - if (sGCC = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - sGCCBack = translate(sGCC, '\', '/'); - sGCCForw = translate(sGCC, '/', '\'); - call EnvSet fRM, 'PATH_EMXPGCC', sGCCBack; - call EnvSet fRM, 'CCENV', 'EMX' - call EnvSet fRM, 'BUILD_ENV', 'EMX' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - - call EnvAddFront fRM, 'BEGINLIBPATH', sGCCBack'\dll;' - call EnvAddFront fRM, 'PATH', sGCCBack'\bin.new;'sGCCBack'\bin;' - call EnvAddFront fRM, 'DPATH', sGCCBack'\book;' - call EnvAddFront fRM, 'BOOKSHELF', sGCCBack'\book;' - call EnvAddFront fRM, 'HELP', sGCCBack'\help;' - call EnvAddFront fRM, 'C_INCLUDE_PATH', sGCCForw'/include' - call EnvAddFront fRM, 'LIBRARY_PATH', sGCCForw'/lib' - call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sGCCForw'/include/cpp;'sGCCForw'/include' - call EnvSet fRM, 'PROTODIR', sGCCForw'/include/cpp/gen' - call EnvSet fRM, 'OBJC_INCLUDE_PATH', sGCCForw'/include' - call EnvAddFront fRM, 'INFOPATH', sGCCForw'/info' - call EnvSet fRM, 'EMXBOOK', 'emxdev.inf+emxlib.inf+emxgnu.inf+emxbsd.inf' - call EnvAddFront fRM, 'HELPNDX', 'emxbook.ndx', '+', 1 - - /* - * Verify. - */ - chMajor = '3'; - chMinor = left(right(sToolId, 2), 1); - chRel = right(sToolId, 1); - sVer = chMajor'.'chMinor'.'chRel - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sGCCBack'\bin.new\gcc.exe', fQuiet), - | \CfgVerifyFile(sGCCBack'\bin.new\g++.exe', fQuiet), - | \CfgVerifyFile(sGCCBack'\bin.new\as.exe', fQuiet), - | \CfgVerifyFile(sGCCBack'\bin.new\readelf.exe', fQuiet), - | \CfgVerifyFile(sGCCBack'\bin.new\emxomf.exe', fQuiet), - | \CfgVerifyFile(sGCCBack'\dll\bfd211.dll', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\iberty.a', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\iberty.lib', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\iberty_s.a', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\iberty_s.lib', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\opcodes.a', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\opcodes.lib', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\opcodes_s.a', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\opcodes_s.lib', fQuiet), - ) then - return 2; - - if (chMinor > 0) then - do - if ( \CfgVerifyFile(sGCCBack'\lib\gcc-lib\i386-pc-os2-emx\'sVer'\st\'sToolId'.lib', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\i386-pc-os2-emx\'sVer'\st\stdcxx.lib', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\i386-pc-os2-emx\'sVer'\st\stdcxx.a', fQuiet), - ) then - return 2; - end - else - do - if ( \CfgVerifyFile(sGCCBack'\lib\gcc-lib\i386-pc-os2_emx\'sVer'\st\gcc_dll.lib', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\i386-pc-os2_emx\'sVer'\st\stdcxx.lib', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\i386-pc-os2_emx\'sVer'\st\stdcxx.a', fQuiet), - ) then - return 2; - end - - - rc = CheckCmdOutput('gcc --version', 0, fQuiet, sVer); - if (rc = 0) then - rc = CheckCmdOutput('g++ --version', 0, fQuiet, sVer); - if (rc = 0) then - do - sVerAS = '2.11.2'; - rc = CheckCmdOutput('as --version', 0, fQuiet, 'GNU assembler 'sVerAS); - end -return rc; - - -/* - * Innotek GCC 3.2.x and higher - this environment is EMX RT free. - * Note! make .lib of every .a! in 4OS2: for /R %i in (*.a) do if not exist %@NAME[%i].lib emxomf %i - */ -GCC322plus: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet,sPathId - - /* - * EMX/GCC main directory. - */ - sGCC = PathQuery(sPathId, sToolId, sOperation); - if (sGCC = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* parse out the version / constants */ - chMajor = '3'; - chMinor = left(right(sToolId, 2), 1); - chRel = right(sToolId, 1); - sVer = chMajor'.'chMinor'.'chRel - sVerShrt= chMajor||chMinor||chRel; - sTrgt = 'i386-pc-os2-emx' - - sGCCBack = translate(sGCC, '\', '/'); - sGCCForw = translate(sGCC, '/', '\'); - call EnvSet fRM, 'PATH_IGCC', sGCCBack; - call EnvSet fRM, 'CCENV', 'IGCC' - call EnvSet fRM, 'BUILD_ENV', 'IGCC' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - - call EnvAddFront fRM, 'BEGINLIBPATH', sGCCBack'\'sTrgt'\lib;'sGCCBack'\lib;' - call EnvAddFront fRM, 'DPATH', sGCCBack'\lib;' - /*call EnvAddFront fRM, 'HELP', sGCCBack'\lib;'*/ - call EnvAddFront fRM, 'PATH', sGCCForw'\'sTrgt'\bin;'sGCCBack'\'sTrgt'\bin;'sGCCForw'\bin;'sGCCBack'\bin;' - /*call EnvAddFront fRM, 'DPATH', sGCCBack'\book;' - call EnvAddFront fRM, 'BOOKSHELF', sGCCBack'\book;' - call EnvAddFront fRM, 'HELP', sGCCBack'\help;' */ - call EnvAddFront fRM, 'C_INCLUDE_PATH', sGCCForw'/include;' - call EnvAddFront fRM, 'C_INCLUDE_PATH', sGCCForw'/lib/gcc-lib/'sTrgt'/'sVer'/include;' - call EnvAddFront fRM, 'C_INCLUDE_PATH', sGCCForw'/lib/gcc-lib/'sTrgt'/'sVer'/include;' - call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sGCCForw'/include;' - call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sGCCForw'/include/c++/'sVer'/backward;' - call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sGCCForw'/include/c++/'sVer'/'sTrgt';' - call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sGCCForw'/include/c++/'sVer'/;' - call EnvAddFront fRM, 'LIBRARY_PATH', sGCCForw'/lib' - call EnvAddFront fRM, 'LIBRARY_PATH', sGCCForw'/lib/gcc-lib/'sTrgt'/'sVer';' - call EnvAddFront fRM, 'INFOPATH', sGCCForw'/info' - /* is this used? */ - call EnvSet fRM, 'PROTODIR', sGCCForw'/include/c++/gen' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sGCCBack'\bin\gcc.exe', fQuiet), - | \CfgVerifyFile(sGCCBack'\bin\g++.exe', fQuiet), - | \CfgVerifyFile(sGCCBack'\bin\as.exe', fQuiet), - | \CfgVerifyFile(sGCCBack'\bin\readelf.exe', fQuiet), - | \CfgVerifyFile(sGCCBack'\bin\emxomf.exe', fQuiet), - | \CfgVerifyFile(sGCCBack'\bin\ilink.exe', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\bfd2E.dll', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc'sVerShrt'.dll', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\libiberty.a', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\libiberty.lib', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\opcode2E.dll', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\libopcodes.a', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\libopcodes.lib', fQuiet), - | \CfgVerifyFile(sGCCBack'\include\unikbd.h', fQuiet), - | \CfgVerifyFile(sGCCBack'\include\c++\'sVer'\streambuf', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\specs', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\cc1plus.exe', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\gcc'sVerShrt'.a', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\gcc'sVerShrt'.lib', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\libgcc.a', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\libgcc.lib', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\libgcc_eh.a', fQuiet), - | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\libgcc_eh.lib', fQuiet), - ) then - return 2; - - rc = CheckCmdOutput('gcc --version', 0, fQuiet, sVer); - if (rc = 0) then - rc = CheckCmdOutput('g++ --version', 0, fQuiet, sVer); - if (rc = 0) then - do - sVerAS = '2.14'; - rc = CheckCmdOutput('as --version', 0, fQuiet, 'GNU assembler 'sVerAS); - end - if (rc = 0) then - rc = CheckCmdOutput('ilink /?', 0, fQuiet, 'IBM(R) Linker for OS/2(R), Version 5.0'); - -return rc; - - -/* - * ICAT Debugger - */ -ICATGam: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - sPathICAT = PathQuery('icatgam', sToolId, sOperation); - if (sPathICAT = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRm, 'PATH_ICATGAM', sPathICAT; - call EnvAddFront fRm, 'beginlibpath',sPathICAT'\dll;' - call EnvAddFront fRm, 'path', sPathICAT'\bin;' - call EnvAddFront fRm, 'dpath', sPathICAT'\help;' - call EnvAddFront fRm, 'help', sPathICAT'\help;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathICAT'\bin\icatgam.exe', fQuiet), - | \CfgVerifyFile(sPathICAT'\dll\gamoou3.dll', fQuiet), - | \CfgVerifyFile(sPathICAT'\dll\gam5lde.dll', fQuiet), - | \CfgVerifyFile(sPathICAT'\dll\gam5cx.dll', fQuiet), - ) then - return 2; -return 0; - - -/* - * ICAT Debugger - */ -ICATGam406RC1: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - sPathICAT = PathQuery('icatgam406rc1', sToolId, sOperation); - if (sPathICAT = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRm, 'PATH_ICATGAM', sPathICAT; - call EnvAddFront fRm, 'beginlibpath',sPathICAT'\dll;' - call EnvAddFront fRm, 'path', sPathICAT'\bin;' - call EnvAddFront fRm, 'dpath', sPathICAT'\help;' - call EnvAddFront fRm, 'help', sPathICAT'\help;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathICAT'\bin\icatgam.exe', fQuiet), - | \CfgVerifyFile(sPathICAT'\dll\gamoou3.dll', fQuiet), - | \CfgVerifyFile(sPathICAT'\dll\gam5lde.dll', fQuiet), - | \CfgVerifyFile(sPathICAT'\dll\gam5cx.dll', fQuiet), - ) then - return 2; -return 0; - - - -/* - * ICAT Debugger for PE images. - */ -ICATPe: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - sPathICAT = PathQuery('icatgam', sToolId, sOperation); - if (sPathICAT = '') then - return 1; - sPathICATPe = PathQuery('icatpe', sToolId, sOperation); - if (sPathICATPe = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRm, 'PATH_ICATGAM',sPathICAT; - call EnvSet fRm, 'PATH_ICATPE', sPathICATPe; - call EnvAddFront fRm, 'beginlibpath',sPathICATPe'\bin;'sPathICAT'\dll;' - call EnvAddFront fRm, 'path', sPathICATPe'\bin;'sPathICAT'\bin;' - call EnvAddFront fRm, 'dpath', sPathICATPe'\bin;'sPathICAT'\help;' - call EnvAddFront fRm, 'help', sPathICATPe'\bin;'sPathICAT'\help;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathICAT'\bin\icatgam.exe', fQuiet), - | \CfgVerifyFile(sPathICAT'\dll\gamoou3.dll', fQuiet), - | \CfgVerifyFile(sPathICAT'\dll\gam5lde.dll', fQuiet), - | \CfgVerifyFile(sPathICAT'\dll\gam5cx.dll', fQuiet), - | \CfgVerifyFile(sPathICATPe'\bin\icatgam.exe', fQuiet), - | \CfgVerifyFile(sPathICATPe'\bin\gamoou3.dll', fQuiet), - | \CfgVerifyFile(sPathICATPe'\bin\gam5lde.dll', fQuiet), - | \CfgVerifyFile(sPathICATPe'\bin\gam5cx.dll', fQuiet), - ) then - return 2; -return 0; - - - -/* - * Interactive Disassembler (IDA) v3.80a - */ -IDA38: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - /* - * IDA main directory. - */ - sPathIDA = PathQuery('ida38', sToolId, sOperation); - if (sPathIDA = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_IDA', sPathIDA - call EnvAddFront fRM, 'path', sPathIDA - call EnvAddFront fRM, 'beginlibpath', sPathIDA - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathIDA'\ida2.exe', fQuiet), - | \CfgVerifyFile(sPathIDA'\idaw.exe', fQuiet), - | \CfgVerifyFile(sPathIDA'\ida.dll', fQuiet), - | \CfgVerifyFile(sPathIDA'\pc.dll', fQuiet), - ) then - return 2; -return 0; - - -/* - * Interactive Disassembler (IDA) v4.01 - */ -IDA40: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - /* - * IDA main directory. - */ - sPathIDA = PathQuery('ida40', sToolId, sOperation); - if (sPathIDA = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_IDA', sPathIDA - call EnvAddFront fRM, 'path', sPathIDA - call EnvAddFront fRM, 'beginlibpath', sPathIDA - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathIDA'\ida2.exe', fQuiet), - | \CfgVerifyFile(sPathIDA'\idaw.exe', fQuiet), - | \CfgVerifyFile(sPathIDA'\ida.dll', fQuiet), - | \CfgVerifyFile(sPathIDA'\pc.dll', fQuiet), - ) then - return 2; -return 0; - - -/* - * Interactive Disassembler (IDA) v4.14 - */ -IDA414: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - /* - * IDA main directory. - */ - sPathIDA = PathQuery('ida414', sToolId, sOperation); - if (sPathIDA = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_IDA', sPathIDA - call EnvAddFront fRM, 'path', sPathIDA - call EnvAddFront fRM, 'beginlibpath', sPathIDA - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathIDA'\ida2.exe', fQuiet), - | \CfgVerifyFile(sPathIDA'\idaw.exe', fQuiet), - | \CfgVerifyFile(sPathIDA'\ida.dll', fQuiet), - | \CfgVerifyFile(sPathIDA'\pc.dll', fQuiet), - ) then - return 2; -return 0; - - -/* - * Interactive Disassembler (IDA) Plugin SDK (v5.0?) - */ -IDASDK: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - /* - * IDA main directory. - */ - sPathIDASDK = PathQuery('idasdk', sToolId, sOperation); - if (sPathIDASDK = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_IDASDK', sPathIDASDK - call EnvAddFront fRM, 'include', sPathIDASDK'\include;' - call EnvAddFront fRM, 'lib', sPathIDASDK'\libwat.os2;' - call EnvAddFront fRM, 'path', sPathIDASDK'\bin\os2;' - call EnvAddFront fRM, 'beginlibpath', sPathIDASDK'\bin\os2;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathIDASDK'\os2wat.cfg', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\d32wat.cfg', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\include\exehdr.h', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\include\ida.hpp', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\include\vm.hpp', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\libwat.os2\ida.lib', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\libwat.d32\ida.lib', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\libwat.d32\INIRT386.OBJ', fQuiet), - /* | \CfgVerifyFile(sPathIDASDK'\libbor.d32\ida.lib', fQuiet)*/, - ) then - return 2; -return 0; - - -/* - * Interactive Disassembler (IDA) Plugin SDK (v5.0?) - */ -IDASDK: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - /* - * IDA main directory. - */ - sPathIDASDK = PathQuery('idasdk', sToolId, sOperation); - if (sPathIDASDK = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_IDASDK', sPathIDASDK - call EnvAddFront fRM, 'include', sPathIDASDK'\include;' - call EnvAddFront fRM, 'lib', sPathIDASDK'\libwat.os2;' - call EnvAddFront fRM, 'path', sPathIDASDK'\bin\os2;' - call EnvAddFront fRM, 'beginlibpath', sPathIDASDK'\bin\os2;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathIDASDK'\os2wat.cfg', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\d32wat.cfg', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\include\exehdr.h', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\include\ida.hpp', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\include\vm.hpp', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\libwat.os2\ida.lib', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\libwat.d32\ida.lib', fQuiet), - | \CfgVerifyFile(sPathIDASDK'\libwat.d32\INIRT386.OBJ', fQuiet), - /* | \CfgVerifyFile(sPathIDASDK'\libbor.d32\ida.lib', fQuiet)*/, - ) then - return 2; -return 0; - -/* - * icsdebug (IBM Visual Age for C++ v3.08 for OS/2) - */ -icsdebug: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * icsdebug (IBM Visual Age for C++ Version 3.08) main directory. - */ - sPath = PathQuery('icsdebug', sToolId, sOperation); - if (sPath = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_ICSDEBUG', sPath - - call EnvAddFront fRM, 'beginlibpath', sPath'\DLL;' - call EnvAddFront fRM, 'path', sPath'\BIN;' - call EnvAddFront fRM, 'dpath', sPath'\HELP;'sPath';'sPath'\LOCALE;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPath'\bin\icsdebug.exe', fQuiet), - | \CfgVerifyFile(sPath'\help\dde4.msg', fQuiet), - | \CfgVerifyFile(sPath'\help\dde4lde.msg', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppibs30.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppom30.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppoob3.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppood3.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppoou3.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\dde4brsc.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\dde4cr.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\dde4cx.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\dde4dsl.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\dde4lde.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\dde4modl.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\dde4mth.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\dde4pmdb.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\dde4prt.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\dde4ress.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\dde4tk.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\dde4trib.dll', fQuiet), - ) then - return 2; -return 0; - - -/* - * idebug (Visual Age / C and C++ tools v3.6.5 for OS/2) - */ -idebug: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * IBM C/C++ Compiler and Tools Version 3.6.5 main directory. - */ - sPath = PathQuery('idebug', sToolId, sOperation); - if (sPath = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_IDEBUG', sPath; - - call EnvAddFront fRM, 'path', sPath'\bin;' - call EnvAddFront fRM, 'dpath', sPath'\local;'sPath'\help;' - call EnvAddFront fRM, 'beginlibpath',sPath'\dll;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPath'\bin\idebug.exe', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppbhg36.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppbpg36.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppddle1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppddpm1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppdfer1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppdfhp1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppdfiw1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppdfpw1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppdftk1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppdqmq1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppdrq1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppdrx1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppdtcp1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppdunf1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppdxcx1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppdxsm1.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cpprdi36.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cpprmi36.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cpptb30.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cpptd30.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cpptu30.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppxb30.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppxd30.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppxm30.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppxm36.dll', fQuiet), - | \CfgVerifyFile(sPath'\dll\cppxu30.dll', fQuiet), - | \CfgVerifyFile(sPath'\help\cppdmg1.msg', fQuiet), - | \CfgVerifyFile(sPath'\msg\cppdcc1.cat', fQuiet), - ) then - return 2; -return 0; - - -/* - * JAVA v1.3.1 (latest) - */ -Java131: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - /* - * JAVA main directory. - */ - sPathJava = PathQuery('java131', sToolId, sOperation); - if (sPathJava = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_JAVA', sPathJava - call EnvSet fRM, 'PATH_JAVA131', sPathJava - call EnvAddFront fRM, 'path', sPathJava'\bin;'sPathJava'\jre\bin;' - call EnvAddFront fRM, 'beginlibpath', sPathJava'\jre\dll;'sPathJava'\jre\bin;'sPathJava'\icatjava\dll;' -/* call EnvAddFront fRM, 'classpath', sPathJava'\jre\dll;'sPathJava'\jre\bin;'sPathJava'\icatjava\dll;' -*/ - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathJava'\bin\javac.exe', fQuiet), - | \CfgVerifyFile(sPathJava'\bin\jar.exe', fQuiet), - | \CfgVerifyFile(sPathJava'\lib\tools.jar', fQuiet), - | \CfgVerifyFile(sPathJava'\lib\javai.lib', fQuiet), - | \CfgVerifyFile(sPathJava'\jre\dll\jv12mi36.dll', fQuiet), - | \CfgVerifyFile(sPathJava'\jre\bin\java.exe', fQuiet), - | \CfgVerifyFile(sPathJava'\jre\bin\jitc.dll', fQuiet), - | \CfgVerifyFile(sPathJava'\jre\bin\javaw.exe', fQuiet), - | \CfgVerifyFile(sPathJava'\jre\bin\rmid.exe', fQuiet), - | \CfgVerifyFile(sPathJava'\jre\bin\classic\jvm.dll', fQuiet), - | \CfgVerifyFile(sPathJava'\include\int64_md.h', fQuiet), - | \CfgVerifyFile(sPathJava'\include\jawt.h', fQuiet), - | \CfgVerifyFile(sPathJava'\include\jawt_md.h', fQuiet), - | \CfgVerifyFile(sPathJava'\include\jni.h', fQuiet), - | \CfgVerifyFile(sPathJava'\include\jniproto_md.h', fQuiet), - | \CfgVerifyFile(sPathJava'\include\jni_md.h', fQuiet), - | \CfgVerifyFile(sPathJava'\include\jvmdi.h', fQuiet), - | \CfgVerifyFile(sPathJava'\include\jvmpi.h', fQuiet), - | \CfgVerifyFile(sPathJava'\jre\bin\jitc_g.dll', fQuiet, 1), - | \CfgVerifyFile(sPathJava'\jre\bin\classic\jvm_g.dll', fQuiet, 1), - ) then - return 2; - -return 0; - - -/* - * jitdbg (secret) - */ -jitdbg: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * IBM C/C++ Compiler and Tools Version 3.6.5 main directory. - */ - sPath = PathQuery('jitdbg', sToolId, sOperation); - if (sPath = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_JITDBG', sPath; - - call EnvAddFront fRM, 'path', sPath'\bin;' - call EnvAddFront fRM, 'dpath', sPath'\msg;'sPath'\help;' - call EnvAddFront fRM, 'beginlibpath',sPath'\dll;'sPath'\extradlls;' - call EnvAddFront fRM, 'help', sPath'\help;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPath'\bin\idbug.exe', fQuiet), - ) then - return 2; -return 0; - - -/* - * (lib) JPEG v6b port. - */ -JPEG: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - sPathJPEG = PathQuery('jpeg', sToolId, sOperation); - if (sPathJPEG = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - call EnvSet fRm, 'PATH_JPEG', sPathJPEG; - call EnvAddFront fRm, 'beginlibpath',sPathJPEG'\dll;' - call EnvAddFront fRm, 'path', sPathJPEG'\bin;' - call EnvAddFront fRM, 'include', sPathJPEG'\include;' - call EnvAddFront fRM, 'C_INCLUDE_PATH', sPathJPEG'\include;' - call EnvAddFront fRM, 'lib', sPathJPEG'\lib;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - - if ( \CfgVerifyFile(sPathJPEG'\bin\cjpeg.exe', fQuiet), - | \CfgVerifyFile(sPathJPEG'\dll\jpeg.dll', fQuiet), - | \CfgVerifyFile(sPathJPEG'\include\jpeglib.h', fQuiet), - | \CfgVerifyFile(sPathJPEG'\lib\jpeg.a', fQuiet), - | \CfgVerifyFile(sPathJPEG'\lib\jpeg.lib', fQuiet), - ) then - return 2; -return 0; - - - - -/* - * Mode commandline. - */ -Mode: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet,cols,rows - - if (pos('install', sOperation) > 0 & pos('uninstall', sOperation) <= 0) then - do - say "ok!" - Address CMD 'mode' cols','rows - end - /* TODO - else if ((pos('uninstall', sOperation) > 0) | \fRM) then - do - say 'Huh?' - cols = 80; - rows = 25; - end - */ -return 0; - - -/* - * Microsoft C v6.0a 16-bit - */ -MSCV6_16: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Microsoft C v6.0a main directory. - */ - sPathMSC = PathQuery('mscv6-16', sToolId, sOperation); - if (sPathMSC = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'BUILD_ENV', 'MSCV6-16' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - call EnvSet fRM, 'PATH_MSC', sPathMSC; - call EnvAddFront fRM, 'path', sPathMSC'\binp;' - call EnvAddFront fRM, 'endlibpath', sPathMSC'\dll;' - call EnvAddFront fRM, 'helpfiles', sPathMSC'\help;' - call EnvAddFront fRM, 'include', sPathMSC'\include;' - call EnvAddFront fRM, 'include16', sPathMSC'\include;' - call EnvAddFront fRM, 'lib', sPathMSC'\lib;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathMSC'\binp\cl.exe', fQuiet), - | \CfgVerifyFile(sPathMSC'\lib\clibcep.lib', fQuiet), - | \CfgVerifyFile(sPathMSC'\lib\llibcep.lib', fQuiet), - | \CfgVerifyFile(sPathMSC'\lib\mlibcep.lib', fQuiet), - | \CfgVerifyFile(sPathMSC'\lib\slibcep.lib', fQuiet), - | \CfgVerifyFile(sPathMSC'\include\sysbits.h', fQuiet), - | \CfgVerifyFile(sPathMSC'\include\dos.h', fQuiet), - | \CfgVerifyFile(sPathMSC'\include\bios.h', fQuiet), - | \CfgVerifyFile(sPathMSC'\include\string.h', fQuiet), - | \CfgVerifyFile(sPathMSC'\include\stdio.h', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('cl', 0, fQuiet, 'Microsoft (R) C Optimizing Compiler Version 6.00A.04'); -return rc; - - -/* - * Microsoft C v6.0a 32-bit - */ -MSCV6_32: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Microsoft C v6.0a 32-bit main directory. - */ - sPathDDKBase = PathQuery('ddkbase', sToolId, sOperation); - if (sPathDDKBase = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * This is where the compiler really is. - */ - call DDKBase 'ddkbase',sOperation,fRM,fQuiet; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'BUILD_ENV', 'MSCV6' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - call EnvSet fRM, 'PATH_MSC', sPathDDKBase; - call EnvAddFront fRM, 'include', sPathDDKBase'\h386;' - call EnvAddFront fRM, 'lib', sPathDDKBase'\lib;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathDDKBase'\tools\cl386.exe', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\h386\limits.h', fQuiet), - | \CfgVerifyFile(sPathDDKBase'\h386\string.h', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('cl386', 0, fQuiet, 'Microsoft (R) Microsoft 386 C Compiler. Version 6.00.054'); -return rc; - - -/* - * Microsoft C v7.0 16-bit with OS/2 support. - */ -MSCV7_16: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Microsoft C v6.0a main directory. - */ - sPathMSC = PathQuery('mscv7-16', sToolId, sOperation); - if (sPathMSC = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'BUILD_ENV', 'MSCV7-16' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - call EnvSet fRM, 'PATH_MSC', sPathMSC; - call EnvAddFront fRM, 'path', sPathMSC'\binp;' - call EnvAddFront fRM, 'endlibpath', sPathMSC'\dll;' - call EnvAddFront fRM, 'helpfiles', sPathMSC'\help;' - call EnvAddFront fRM, 'include', sPathMSC'\include;' - call EnvAddFront fRM, 'include16', sPathMSC'\include;' - call EnvAddFront fRM, 'lib', sPathMSC'\lib;' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathMSC'\binp\cl.exe', fQuiet), - | \CfgVerifyFile(sPathMSC'\binp\link.exe', fQuiet), - | \CfgVerifyFile(sPathMSC'\binp\ilink.exe', fQuiet), - /* | \CfgVerifyFile(sPathMSC'\lib\clibcep.lib', fQuiet), - | \CfgVerifyFile(sPathMSC'\lib\llibcep.lib', fQuiet), - | \CfgVerifyFile(sPathMSC'\lib\mlibcep.lib', fQuiet), - | \CfgVerifyFile(sPathMSC'\lib\slibcep.lib', fQuiet)*/, - | \CfgVerifyFile(sPathMSC'\include\dos.h', fQuiet), - | \CfgVerifyFile(sPathMSC'\include\bios.h', fQuiet), - | \CfgVerifyFile(sPathMSC'\include\locale.h', fQuiet), - | \CfgVerifyFile(sPathMSC'\include\stdiostr.h', fQuiet), - | \CfgVerifyFile(sPathMSC'\include\string.h', fQuiet), - | \CfgVerifyFile(sPathMSC'\include\vmemory.h', fQuiet), - | \CfgVerifyFile(sPathMSC'\include\stdio.h', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('cl', 0, fQuiet, 'Microsoft (R) C/C++ Optimizing Compiler Version 7.00'); -return rc; - - - - -/* - * mySQL Database system - */ -mySQL: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * mySQL Database system main directory. - */ - sPathMySQL = PathQuery('mysql', sToolId, sOperation); - if (sPathMySQL = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_MYSQL', sPathMySQL; - call EnvAddFront fRM, 'path', sPathMySQL'\bin;' - call EnvAddFront fRM, 'beginlibpath', sPathMySQL'\dll;' - call EnvAddFront fRM, 'include', sPathMySQL'\include;' - call EnvAddFront fRM, 'bookshelf', sPathMySQL'\doc;'sPathMySQL'\book'; - /*call EnvAddFront fRM, 'lib', sPathMySQL'\lib;'*/ - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathMySQL'\bin\mysql.exe', fQuiet), - | \CfgVerifyFile(sPathMySQL'\bin\mysqld.exe', fQuiet), - | \CfgVerifyFile(sPathMySQL'\bin\mysqladmin.exe', fQuiet), - | \CfgVerifyFile(sPathMySQL'\dll\mysql.dll', fQuiet), - | \CfgVerifyFile(sPathMySQL'\include\mysql.h', fQuiet), - | \CfgVerifyFile(sPathMySQL'\include\mysql_com.h', fQuiet), - | \CfgVerifyFile(sPathMySQL'\include\mysql_version.h', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('mysql --version', 0, fQuiet, ', for '); -return rc; - - - -/* - * NASM - NetWide Assembler (all versions) - */ -NASM: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet,sPathId - - /* - * Get NASM directory - */ - sPathNASM = PathQuery(sPathId, sToolId, sOperation); - if (sPathNASM = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_NASM', sPathNASM; - call EnvAddFront fRM, 'path', sPathNASM - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathNASM'\nasm.exe', fQuiet), - | \CfgVerifyFile(sPathNASM'\ndisasm.exe', fQuiet), - ) then - return 2; - select - when (sPathId = 'nasm9833') then sVer = '0.98.33 compiled'; - otherwise do; say 'internal error invalid pathid! sPathId='sPathId; exit(16); end - end - rc = CheckCmdOutput('nasm -version', 0, fQuiet, 'NASM version '||sVer); - if (rc = 0) then - rc = CheckCmdOutput('ndisasm -version', 0, fQuiet, 'NDISASM version '||sVer); -return rc; - - - -/* - * NetQOS2 - help subsystem++ for VAC 3.6.5 and VAC 4.0 - */ -NetQOS2: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - sPathNetQOS2 = PathQuery('netqos2', sToolId, sOperation); - if (sPathNetQOS2 = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_NETQOS2', sPathNetQOS2 - call EnvAddFront fRM, 'path', sPathNetQOS2';' - call EnvAddFront fRM, 'dpath', sPathNetQOS2';' - call EnvAddFront fRM, 'beginlibpath', sPathNetQOS2';' - call EnvSet fRM, 'imndatasrv', sPathNetQOS2'\DATA' - call EnvSet fRM, 'imndatacl', sPathNetQOS2'\DATA' - call EnvSet fRM, 'imnworksrv', sPathNetQOS2'\WORK' - call EnvSet fRM, 'imnworkcl', sPathNetQOS2'\WORK' - call EnvSet fRM, 'imnnlpssrv', sPathNetQOS2 - call EnvSet fRM, 'imnnlpscl', sPathNetQOS2 - call EnvSet fRM, 'imncccfgfile', 'NETQ.CFG' - call EnvSet fRM, 'imncscfgfile', 'NETQ.CFG' - call EnvSet fRM, 'imqconfigsrv', sPathNetQOS2'\instance' - call EnvSet fRM, 'imqconfigcl', sPathNetQOS2'\instance\dbcshelp' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathNetQOS2'\netq.exe', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('netq', 999, fQuiet, 'NETQ {START | STOP'); -return rc; - - -/* - * Odin32 testcase setup. - */ -Odin32Testcase: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - if ( PathQuery('testcase_drive_unused', sToolId, sOperation) = '', - | PathQuery('testcase_drive_fixed', sToolId, sOperation) = '', - | PathQuery('testcase_drive_floppy', sToolId, sOperation) = '', - | PathQuery('testcase_drive_cdrom', sToolId, sOperation) = '', - ) then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'odin32_testcase_drive_unused', PathQuery('testcase_drive_unused', sToolId, sOperation); - call EnvSet fRM, 'odin32_testcase_drive_fixed', PathQuery('testcase_drive_fixed', sToolId, sOperation); - call EnvSet fRM, 'odin32_testcase_drive_floppy', PathQuery('testcase_drive_floppy', sToolId, sOperation); - call EnvSet fRM, 'odin32_testcase_drive_cdrom', PathQuery('testcase_drive_cdrom', sToolId, sOperation); - call EnvSet fRM, 'odin32_testcase_drive_network', PathQuery('testcase_drive_network', sToolId, sOperation, 1); - call EnvSet fRM, 'odin32_testcase_drive_ramdisk', PathQuery('testcase_drive_ramdisk', sToolId, sOperation, 1); - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; -return 0; - - -/* - * PERL 5005_53 or 5.004_55 - */ -Perl50xxx: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Perl main directory. - */ - sPathPerl = PathQuery('perl50xxx', sToolId, sOperation); - if (sPathPerl = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - sPathPerlForw = translate(sPathPerl, '/', '\'); - call EnvSet fRM, 'PATH_PERL', sPathPerl; - call EnvAddFront fRM, 'path', sPathPerl'\bin;' - call EnvAddFront fRM, 'beginlibpath', sPathPerl'\dll;' - call EnvAddEnd fRM, 'bookshelf', sPathPerl'\book;' - call EnvSet fRM, 'perllib_prefix', sPathPerlForw'/lib;'sPathPerlForw'/lib' - call EnvSet fRM, 'perl_sh_dir', sPathPerlForw'/bin_sh' - call EnvSet fRM, 'manpath', sPathPerlForw'/man' - call EnvSet fRM, 'perl5lib', sPathPerlForw'/lib' - call EnvSet fRM, 'perl_badlang', '0' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - - sPerlDLL = 'perl.dll'; - sVer = '5.004_55'; - f5005_53 = FileExists(sPathPerl'\dll\perlE0AC.dll'); - if (f5005_53) then - do - sPerlDLL = 'perlE0AC.dll'; - sVer = '5.005_53'; - end - if ( \CfgVerifyFile(sPathPerl'\bin\perl.exe', fQuiet), - | \CfgVerifyFile(sPathPerl'\dll\'||sPerlDLL, fQuiet), - ) then - return 2; - rc = CheckCmdOutput('perl --version', 0, fQuiet, 'This is perl, version '||sVer||' built for os2'); -return rc; - - -/* - * PERL v5.8.0 - */ -Perl580: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Perl main directory. - */ - sPathPerl = PathQuery('perl580', sToolId, sOperation); - if (sPathPerl = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - sPathPerlForw = translate(sPathPerl, '/', '\'); - call EnvSet fRM, 'PATH_PERL', sPathPerl; - call EnvAddFront fRM, 'path', sPathPerl'\bin\5.8.0;' - call EnvAddFront fRM, 'beginlibpath', sPathPerl'\lib;' - call EnvAddEnd fRM, 'bookshelf', sPathPerl'\doc;' - call EnvSet fRM, 'perllib_prefix', 'L:/Perl/lib;'sPathPerlForw'/lib' - call EnvSet fRM, 'perl_sh_dir', sPathPerlForw'/bin/5.8.0' - call EnvSet fRM, 'manpath', sPathPerlForw'/man' - call EnvSet fRM, 'perl_badlang', '0' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - - if ( \CfgVerifyFile(sPathPerl'\bin\5.8.0\perl.exe', fQuiet), - | \CfgVerifyFile(sPathPerl'\lib\perlB12E.dll', fQuiet), - | \CfgVerifyFile(sPathPerl'\bin\5.8.0\sh.exe', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('perl --version', 0, fQuiet, 'This is perl, v5.8.0 built for os2_emx'); - -return rc; - - -/* - * Python/2 v1.5.2 - */ -Python: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * The Python Home directory - */ - sPythonHome = PathQuery('python', sToolId, sOperation); - if (sPythonHome = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_PYTHON', sPythonHome - call EnvSet fRM, 'pythonhome', sPythonHome - call EnvSet fRM, 'pythonpath', '.;'sPythonHome'\Lib;'sPythonHome'\Lib\plat-win;'sPythonHome'\Lib\lib-tk;'sPythonHome'\Lib\lib-dynload;'sPythonHome'\Lib\site-packages;'sPythonHome'\Lib\dos-8x3' - call EnvAddFront fRM, 'beginlibpath', sPythonHome - call EnvAddFront fRM, 'path', sPythonHome - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPythonHome'\Python.exe', fQuiet), - | \CfgVerifyFile(sPythonHome'\Python15.dll', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('echo print "hello world" | python', 0, fQuiet, 'hello world'); -return rc; - - -/* - * Subversion (svn) - */ -Subversion: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - - /* - * The directories. - */ - sPathCVS = PathQuery('svn', sToolId, sOperation); - if (sPathCVS = '') then - return 1; - sPathHome = PathQuery('home', sToolId, sOperation); - if (sPathHome = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_SVN', sPathCVS; - call EnvAddFront fRM, 'path', sPathCVS';' - call EnvSet fRM, 'home', translate(sPathHome, '/','\'); - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - - if (\CfgVerifyFile(sPathCVS'\svn.exe',fQuiet)) then - return 2; - if (length(sPathHome) <= 2) then - do - if (\fQuiet) then - say 'Error: The home directory is to short!'; - return 2; - end - if (\CfgVerifyDir(sPathHome, fQuiet)) then - return 2; -return CheckCmdOutput('svn.exe --version', 0, fQuiet, 'svn, version 1.'); - - - -/* - * OS/2 Programmers Toolkit v4.0 (CSD1/4) - */ -Toolkit40: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Toolkit (4.0) main directory. - */ - sPathTK = PathQuery('toolkit40', sToolId, sOperation); - if (sPathTK = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_TOOLKIT', sPathTK; - call EnvAddFront fRM, 'beginlibpath', sPathTK'\archived;'sPathTK'\SAMPLES\MM\DLL;'sPathTK'\SAMPLES\OPENDOC\PARTS\DLL;'sPathTK'\SOM\COMMON\DLL;'sPathTK'\SOM\LIB;'sPathTK'\OPENDOC\BASE\DLL;'sPathTK'\OPENDOC\BASE\LOCALE\EN_US;'sPathTK'\DLL;' - call EnvAddFront fRM, 'path', sPathTK'\archived;'sPathTK'\SOM\COMMON;'sPathTK'\SOM\BIN;.;'sPathTK'\OPENDOC\BASE\BIN;'sPathTK'\BIN;' - call EnvAddFront fRM, 'dpath', sPathTK'\SOM\COMMON\SYSTEM;'sPathTK'\SOM\MSG;'sPathTK'\OPENDOC\BASE\MSG;'sPathTK'\BOOK;'sPathTK'\MSG;' - call EnvAddFront fRM, 'help', sPathTK'\archived;'sPathTK'\OPENDOC\BASE\LOCALE\EN_US;'sPathTK'\HELP;' - call EnvAddFront fRM, 'bookshelf', sPathTK'\archived;'sPathTK'\BOOK;'sPathTK'\ARCHIVED;' - call EnvAddFront fRM, 'somir', sPathTK'\SOM\COMMON\ETC\214\SOM.IR;'sPathTK'\OPENDOC\BASE\AVLSHELL.IR;' - call EnvAddEnd fRM, 'somir', sPathTK'\OPENDOC\CUSTOM\OD.IR;'sPathTK'\SAMPLES\REXX\SOM\ANIMAL\ORXSMP.IR;' -/* call EnvAddFront fRM, 'include', sPathTK'\SPEECH\H;''sPathTK'\SAMPLES\OPENDOC\PARTS\INCLUDE;'sPathTK'\SOM\INCLUDE;'sPathTK'\INC;'sPathTK'\H\GL;'sPathTK'\H;' */ - call EnvAddFront fRM, 'include', /*sPathTK'\SPEECH\H;'*/sPathTK'\SAMPLES\OPENDOC\PARTS\INCLUDE;'sPathTK'\SOM\INCLUDE;'sPathTK'\INC;'sPathTK'\H\GL;'sPathTK'\H;' - call EnvAddEnd fRM, 'include', sPathTK'\H\LIBC;.;' - call EnvAddFront fRM, 'lib', sPathTK'\SPEECH\LIB;'sPathTK'\SAMPLES\MM\LIB;'sPathTK'\LIB;'sPathTK'\SOM\LIB;'sPathTK'\OPENDOC\BASE\LIB;' - call EnvAddFront fRM, 'nlspath', sPathTK'\OPENDOC\BASE\LOCALE\EN_US\%N;'sPathTK'\MSG\%N;C:\MPTN\MSG\NLS\%N;C:\TCPIP\msg\ENUS850\%N;' - call EnvAddFront fRM, 'locpath', sPathTK'\OPENDOC\BASE\LOCALE;' - call EnvAddFront fRM, 'ipfc', sPathTK'\IPFC;' - call EnvSet fRM, 'odbase', sPathTK'\OPENDOC\BASE' - call EnvSet fRM, 'odlang', 'en_US' - call EnvAddFront fRM, 'odbasepaths', sPathTK'\OPENDOC\BASE;' - call EnvSet fRM, 'odcfg', sPathTK'\OPENDOC\CUSTOM' - call EnvSet fRM, 'odtmp', EnvGet('tmp'); - call EnvSet fRM, 'sombase', sPathTK'\SOM' - call EnvSet fRM, 'somruntime', sPathTK'\SOM\COMMON' - - call EnvSet fRM, 'cpref', 'CP1.INF+CP2.INF+CP3.INF' - call EnvSet fRM, 'gpiref', 'GPI1.INF+GPI2.INF+GPI3.INF+GPI4.INF' - call EnvSet fRM, 'mmref', 'MMREF1.INF+MMREF2.INF+MMREF3.INF' - call EnvSet fRM, 'pmref', 'PM1.INF+PM2.INF+PM3.INF+PM4.INF+PM5.INF' - call EnvSet fRM, 'wpsref', 'WPS1.INF+WPS2.INF+WPS3.INF' - call EnvAddFront fRM, 'sminclude', sPathTK'\H;'sPathTK'\IDL;'sPathTK'\SOM\INCLUDE;.;'sPathTK'\OPENDOC\BASE\INCLUDE;'sPathTK'\SAMPLES\OPENDOC\PARTS\INCLUDE;' - call EnvSet fRM, 'smaddstar', '1' - call EnvSet fRM, 'smemit', 'h;ih;c' - call EnvSet fRM, 'smtmp', EnvGet('tmp'); - call EnvSet fRM, 'smclasses', 'WPTYPES.IDL' - call EnvSet fRM, 'odparts', sPathTK'\SAMPLES\OPENDOC\PARTS' - call EnvSet fRM, 'odsrc', sPathTK'\SAMPLES\OPENDOC\PARTS' - call EnvAddFront fRM, 'odpartspaths', sPathTK'\SAMPLES\OPENDOC\PARTS;' - call EnvAddFront fRM, 'odsrcpaths', sPathTK'\SAMPLES\OPENDOC\PARTS;' - /* - call EnvSet fRM, 'CAT_MACHINE=COM1:57600' - call EnvSet fRM, 'CAT_HOST_BIN_PATH='sPathTK'\BIN' - call EnvSet fRM, 'CAT_COMMUNICATION_TYPE=ASYNC_SIGBRK' - call EnvAddFront fRM, 'CAT_HOST_SOURCE_PATH='sPathTK'\BIN;' - */ - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathTK'\bin\alp.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\rc.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\ipfc.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\implib.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\mkmsgf.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\mapsym.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\lib\os2386.lib', fQuiet), - | \CfgVerifyFile(sPathTK'\lib\pmbidi.lib', fQuiet), - | \CfgVerifyFile(sPathTK'\lib\tcpip32.lib', fQuiet), - | \CfgVerifyFile(sPathTK'\h\os2.h', fQuiet), - | \CfgVerifyFile(sPathTK'\h\os2win.h', fQuiet), - | \CfgVerifyFile(sPathTK'\h\stack16\pmwsock.h', fQuiet), - | \CfgVerifyFile(sPathTK'\som\bin\sc.exe', fQuiet), - ) then - return 2; - - rc = CheckSyslevel(sPathTK||'\bin\syslevel.tlk', fQuiet,,,,, - 'IBM Developer''s Toolkit for OS/2 Warp Version 4',, - 15, '0'); - if (rc = 0) then - rc = CheckCmdOutput('sc -V', -1, fQuiet, '", Version: 2.54.'); - if (rc = 0) then - rc = CheckCmdOutput('rc', 0, fQuiet, 'IBM RC (Resource Compiler) Version 5.00.00'); - if (rc = 0) then - rc = CheckCmdOutput('ipfc', 0, fQuiet, 'Version 4.00.00'); - -return rc; - - - -/* - * OS/2 Programmers Toolkit v4.5 - */ -Toolkit45: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Toolkit (4.5) main directory. - */ - sPathTK = PathQuery('toolkit45', sToolId, sOperation); - if (sPathTK = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_TOOLKIT', sPathTK; - call EnvAddFront fRM, 'path', sPathTK'\bin;' - call EnvAddFront fRM, 'dpath', sPathTK'\book;' - call EnvAddFront fRM, 'dpath', sPathTK'\msg;' - call EnvAddFront fRM, 'beginlibpath', sPathTK'\dll;' - call EnvAddFront fRM, 'help', sPathTK'\help;' - call EnvAddFront fRM, 'bookshelf', sPathTK'\archived;' - call EnvAddFront fRM, 'bookshelf', sPathTK'\book;' - call EnvAddFront fRM, 'nlspath', sPathTK'\msg\%N;' - call EnvAddEnd fRM, 'ulspath', sPathTK'\language;' - call EnvAddFront fRM, 'include', sPathTK'\H;' -/* call EnvAddFront fRM, 'include', sPathTK'\H\GL;' */ -/* call EnvAddFront fRM, 'include', sPathTK'\SPEECH\H;' includes tend to get too long :-( */ - call EnvAddFront fRM, 'include', sPathTK'\H\RPC;' - call EnvAddFront fRM, 'include', sPathTK'\H\NETNB;' - call EnvAddFront fRM, 'include', sPathTK'\H\NETINET;' - call EnvAddFront fRM, 'include', sPathTK'\H\NET;' - call EnvAddFront fRM, 'include', sPathTK'\H\ARPA;' - call EnvAddFront fRM, 'include', sPathTK'\INC;' - call EnvAddEnd fRM, 'lib', sPathTK'\SAMPLES\MM\LIB;' - call EnvAddEnd fRM, 'lib', sPathTK'\SPEECH\LIB;' - call EnvAddFront fRM, 'lib', sPathTK'\lib;' - call EnvAddFront fRM, 'helpndx', 'EPMKWHLP.NDX+', '+' - call EnvAddFront fRM, 'ipfc', sPathTK'\ipfc;' - call EnvSet fRM, 'LANG', 'en_us' - call EnvSet fRM, 'CPREF', 'CP1.INF+CP2.INF+CP3.INF' - call EnvSet fRM, 'GPIREF', 'GPI1.INF+GPI2.INF+GPI3.INF+GPI4.INF' - call EnvSet fRM, 'MMREF', 'MMREF1.INF+MMREF2.INF+MMREF3.INF' - call EnvSet fRM, 'PMREF', 'PM1.INF+PM2.INF+PM3.INF+PM4.INF+PM5.INF' - call EnvSet fRM, 'WPSREF', 'WPS1.INF+WPS2.INF+WPS3.INF' - /* - call EnvSet fRM, 'CAT_MACHINE', 'COM1:57600' - call EnvSet fRM, 'CAT_HOST_BIN_PATH', TKMAIN'\BIN' - call EnvSet fRM, 'CAT_COMMUNICATION_TYPE', 'ASYNC_SIGBRK' - call EnvSet fRM, 'CAT_HOST_SOURCE_PATH',TKMAIN'\BIN;' - */ - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathTK'\bin\alp.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\rc.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\ipfc.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\implib.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\mkmsgf.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\mapsym.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\lib\os2386.lib', fQuiet), - | \CfgVerifyFile(sPathTK'\lib\pmbidi.lib', fQuiet), - | \CfgVerifyFile(sPathTK'\lib\tcpip32.lib', fQuiet), - | \CfgVerifyFile(sPathTK'\h\os2.h', fQuiet), - | \CfgVerifyFile(sPathTK'\h\os2win.h', fQuiet), - | \CfgVerifyFile(sPathTK'\h\stack16\pmwsock.h', fQuiet), - | FileExists(sPathTK'\som\bin\sc.exe'), - ) then - return 2; - - rc = CheckSyslevel(sPathTK||'\bin\syslevel.tlk', fQuiet,, - '5639F9300', '4.50.0', 'XR04500',, - 'IBM OS/2 Developer''s Toolkit Version 4.5',, - 15, '0'); - if (rc = 0) then - rc = CheckCmdOutput('rc', 0, fQuiet, 'IBM RC (Resource Compiler) Version 5.00.004'); - if (rc = 0) then - rc = CheckCmdOutput('ipfc', 0, fQuiet, 'Version 4.00.006 July 21 1998'); -return rc; - - -/* - * OS/2 Programmers Toolkit v4.5.1 - */ -Toolkit451: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Toolkit (4.5.1) main directory. - */ - sPathTK = PathQuery('toolkit451', sToolId, sOperation); - if (sPathTK = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_TOOLKIT', sPathTK; - call EnvAddFront fRM, 'path', sPathTK'\bin;'sPathTK'\som\common;'sPathTK'\som\bin' - call EnvAddFront fRM, 'dpath', sPathTK'\msg;'sPathTK'\book;'sPathTK'\SOM\COMMON\SYSTEM;'sPathTK'\SOM\MSG;' - call EnvAddFront fRM, 'beginlibpath', sPathTK'\dll;'sPathTK'\som\common\dll;'sPathTK'\som\lib;' - call EnvAddFront fRM, 'help', sPathTK'\help;' - call EnvAddFront fRM, 'bookshelf', sPathTK'\book;'sPathTK'\archived;' - call EnvAddFront fRM, 'somir', sPathTK'\SOM\COMMON\ETC\214\SOM.IR;' - call EnvAddEnd fRM, 'somir', sPathTK'\SAMPLES\REXX\SOM\ANIMAL\ORXSMP.IR;' - call EnvAddFront fRM, 'nlspath', sPathTK'\msg\%N;' - call EnvAddEnd fRM, 'ulspath', sPathTK'\language;' - /*call EnvAddFront fRM, 'include', sPathTK'\H\ARPA;'sPathTK'\H\NET;'sPathTK'\H\NETINET;'sPathTK'\H\NETNB;'sPathTK'\H\RPC;'sPathTK'\SPEECH\H;'sPathTK'\H\GL;'sPathTK'\H;'sPathTK'\SOM\INCLUDE;'sPathTK'\INC;'*/ - call EnvAddFront fRM, 'include', sPathTK'\H\ARPA;'sPathTK'\H\NET;'sPathTK'\H\NETINET;'sPathTK'\H\NETNB;'sPathTK'\H\RPC;'/*sPathTK'\SPEECH\H;'sPathTK'\H\GL;'*/sPathTK'\H;'sPathTK'\SOM\INCLUDE;'sPathTK'\INC;' - call EnvAddFront fRM, 'lib', sPathTK'\lib;'sPathTK'\som\lib;' - call EnvAddEnd fRM, 'lib', sPathTK'\SAMPLES\MM\LIB;'sPathTK'\SPEECH\LIB;' - call EnvAddFront fRM, 'helpndx', 'EPMKWHLP.NDX+', '+' - call EnvAddFront fRM, 'ipfc', sPathTK'\ipfc;' - call EnvSet fRM, 'sombase', sPathTK'\SOM' - call EnvSet fRM, 'somruntime', sPathTK'\SOM\COMMON' - call EnvSet fRM, 'LANG', 'en_us' - - call EnvSet fRM, 'CPREF', 'CP1.INF+CP2.INF+CP3.INF' - call EnvSet fRM, 'GPIREF', 'GPI1.INF+GPI2.INF+GPI3.INF+GPI4.INF' - call EnvSet fRM, 'MMREF', 'MMREF1.INF+MMREF2.INF+MMREF3.INF' - call EnvSet fRM, 'PMREF', 'PM1.INF+PM2.INF+PM3.INF+PM4.INF+PM5.INF' - call EnvSet fRM, 'WPSREF', 'WPS1.INF+WPS2.INF+WPS3.INF' - call EnvAddFront fRM, 'sminclude', sPathTK'\H;'sPathTK'\IDL;'sPathTK'\SOM\INCLUDE;.;' - call EnvSet fRM, 'smaddstar', '1' - call EnvSet fRM, 'smemit', 'h;ih;c' - call EnvSet fRM, 'smtmp', EnvGet('tmp'); - call EnvSet fRM, 'smclasses', 'WPTYPES.IDL' - /* - call EnvSet fRM, 'CAT_MACHINE', 'COM1:57600' - call EnvSet fRM, 'CAT_HOST_BIN_PATH', TKMAIN'\BIN' - call EnvSet fRM, 'CAT_COMMUNICATION_TYPE', 'ASYNC_SIGBRK' - call EnvSet fRM, 'CAT_HOST_SOURCE_PATH',TKMAIN'\BIN;' - */ - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathTK'\bin\alp.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\rc.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\ipfc.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\implib.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\mkmsgf.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\mapsym.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\nmake.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\nmake32.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\lib\os2386.lib', fQuiet), - | \CfgVerifyFile(sPathTK'\lib\pmbidi.lib', fQuiet), - | \CfgVerifyFile(sPathTK'\lib\tcpip32.lib', fQuiet), - | \CfgVerifyFile(sPathTK'\h\os2.h', fQuiet), - | \CfgVerifyFile(sPathTK'\h\os2win.h', fQuiet), - | \CfgVerifyFile(sPathTK'\h\stack16\pmwsock.h', fQuiet), - | \CfgVerifyFile(sPathTK'\som\bin\sc.exe', fQuiet), - ) then - return 2; - - rc = CheckSyslevel(sPathTK||'\bin\syslevel.tlk', fQuiet,, - '5639F9300', '4.50.1', 'XR04510',, - 'IBM OS/2 Developer''s Toolkit Version 4.5',, - 15, '0'); - if (rc = 0) then - rc = CheckCmdOutput('sc -V', -1, fQuiet, '", Version: 2.54.'); - if (rc = 0) then - rc = CheckCmdOutput('rc', 0, fQuiet, 'IBM RC (Resource Compiler) Version 5.00.006 Oct 20 2000'); - if (rc = 0) then - rc = CheckCmdOutput('ipfc', 0, fQuiet, 'Version 4.00.007 Oct 02 2000'); - if (rc = 0) then - rc = CheckCmdOutput('nmake -?', 0, fQuiet, 'Version 4.00.000 Oct 20 2000'); - if (rc = 0) then - rc = CheckCmdOutput('nmake32 -?', 0, fQuiet, 'Version 5.00.003 Oct 20 2000'); -return rc; - - - -/* - * OS/2 Programmers Toolkit v4.5.2 - */ -Toolkit452: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Toolkit (4.5.1) main directory. - */ - sPathTK = PathQuery('toolkit452', sToolId, sOperation); - if (sPathTK = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_TOOLKIT', sPathTK; - call EnvAddFront fRM, 'path', sPathTK'\bin;'sPathTK'\som\common;'sPathTK'\som\bin' - call EnvAddFront fRM, 'dpath', sPathTK'\msg;'sPathTK'\book;'sPathTK'\SOM\COMMON\SYSTEM;'sPathTK'\SOM\MSG;' - call EnvAddFront fRM, 'beginlibpath', sPathTK'\dll;'sPathTK'\som\common\dll;'sPathTK'\som\lib;' - call EnvAddFront fRM, 'help', sPathTK'\help;' - call EnvAddFront fRM, 'bookshelf', sPathTK'\book;'sPathTK'\archived;' - call EnvAddFront fRM, 'somir', sPathTK'\SOM\COMMON\ETC\214\SOM.IR;' - call EnvAddEnd fRM, 'somir', sPathTK'\SAMPLES\REXX\SOM\ANIMAL\ORXSMP.IR;' - call EnvAddFront fRM, 'nlspath', sPathTK'\msg\%N;' - call EnvAddEnd fRM, 'ulspath', sPathTK'\language;' - /*call EnvAddFront fRM, 'include', sPathTK'\H\ARPA;'sPathTK'\H\NET;'sPathTK'\H\NETINET;'sPathTK'\H\NETNB;'sPathTK'\H\RPC;'sPathTK'\SPEECH\H;'sPathTK'\H\GL;'sPathTK'\H;'sPathTK'\SOM\INCLUDE;'sPathTK'\INC;'*/ - /* the include mustn't be too long :-/ */ - call EnvAddFront fRM, 'include', sPathTK'\H\ARPA;'sPathTK'\H\NET;'sPathTK'\H\NETINET;'sPathTK'\H\NETNB;'sPathTK'\H\RPC;'/*sPathTK'\SPEECH\H;'sPathTK'\H\GL;'*/sPathTK'\H;'sPathTK'\SOM\INCLUDE;'sPathTK'\INC;' - call EnvAddFront fRM, 'lib', sPathTK'\lib;'sPathTK'\som\lib;' - call EnvAddEnd fRM, 'lib', sPathTK'\SAMPLES\MM\LIB;'sPathTK'\SPEECH\LIB;' - call EnvAddFront fRM, 'helpndx', 'EPMKWHLP.NDX+', '+' - call EnvAddFront fRM, 'ipfc', sPathTK'\ipfc;' - call EnvSet fRM, 'sombase', sPathTK'\SOM' - call EnvSet fRM, 'somruntime', sPathTK'\SOM\COMMON' - call EnvSet fRM, 'LANG', 'en_us' - - call EnvSet fRM, 'CPREF', 'CP1.INF+CP2.INF+CP3.INF' - call EnvSet fRM, 'GPIREF', 'GPI1.INF+GPI2.INF+GPI3.INF+GPI4.INF' - call EnvSet fRM, 'MMREF', 'MMREF1.INF+MMREF2.INF+MMREF3.INF' - call EnvSet fRM, 'PMREF', 'PM1.INF+PM2.INF+PM3.INF+PM4.INF+PM5.INF' - call EnvSet fRM, 'WPSREF', 'WPS1.INF+WPS2.INF+WPS3.INF' - call EnvAddFront fRM, 'sminclude', sPathTK'\H;'sPathTK'\IDL;'sPathTK'\SOM\INCLUDE;.;' - call EnvSet fRM, 'smaddstar', '1' - call EnvSet fRM, 'smemit', 'h;ih;c' - call EnvSet fRM, 'smtmp', EnvGet('tmp'); - call EnvSet fRM, 'smclasses', 'WPTYPES.IDL' - /* - call EnvSet fRM, 'CAT_MACHINE', 'COM1:57600' - call EnvSet fRM, 'CAT_HOST_BIN_PATH', TKMAIN'\BIN' - call EnvSet fRM, 'CAT_COMMUNICATION_TYPE', 'ASYNC_SIGBRK' - call EnvSet fRM, 'CAT_HOST_SOURCE_PATH',TKMAIN'\BIN;' - */ - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathTK'\bin\alp.exe', fQuiet), - /*| \CfgVerifyFile(sPathTK'\bin\rc.exe', fQuiet)*/, - | \CfgVerifyFile(sPathTK'\bin\rc16.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\ipfc.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\implib.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\mkmsgf.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\mapsym.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\nmake.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\bin\nmake32.exe', fQuiet), - | \CfgVerifyFile(sPathTK'\lib\os2386.lib', fQuiet), - | \CfgVerifyFile(sPathTK'\lib\pmbidi.lib', fQuiet), - | \CfgVerifyFile(sPathTK'\lib\tcpip32.lib', fQuiet), - | \CfgVerifyFile(sPathTK'\h\os2.h', fQuiet), - | \CfgVerifyFile(sPathTK'\h\os2win.h', fQuiet), - | \CfgVerifyFile(sPathTK'\h\stack16\pmwsock.h', fQuiet), - | \CfgVerifyFile(sPathTK'\som\bin\sc.exe', fQuiet), - ) then - return 2; - - rc = CheckSyslevel(sPathTK||'\bin\syslevel.tlk', fQuiet,, - '5639F9300', '4.50.2', 'XR04520',, - 'IBM OS/2 Developer''s Toolkit Version 4.5',, - 15, '0'); - if (rc = 0) then - rc = CheckCmdOutput('sc -V', -1, fQuiet, '", Version: 2.54.'); - /*if (rc = 0) then - rc = CheckCmdOutput('rc', 1, fQuiet, 'Version 4.00.011 Oct 04 2001');*/ - if (rc = 0) then - rc = CheckCmdOutput('rc16', 1, fQuiet, 'Version 4.00.011 Oct 04 2001'); - if (rc = 0) then - rc = CheckCmdOutput('ipfc', 0, fQuiet, 'Version 4.00.007 Oct 02 2000'); - if (rc = 0) then - rc = CheckCmdOutput('nmake -?', 0, fQuiet, 'Version 4.00.001 Oct 4 2001'); - if (rc = 0) then - rc = CheckCmdOutput('nmake32 -?', 0, fQuiet, 'Version 5.00.003 Oct 4 2001'); -return rc; - - - -/** - * This will envolve into an full UNIX like environment some day perhaps... - */ -Unix: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * Unix root directory and XFree86 main directory. - */ - sUnixBack = PathQuery('unixroot', sToolId, sOperation); - if (sUnixBack = '') then - return 1; - sXF86Back = PathQuery('xfree86', sToolId, sOperation); - if (sXF86Back = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - sUnixForw = translate(sUnixBack, '/', '\'); - call EnvSet fRM, 'PATH_UNIX', sUnixBack - call EnvSet fRM, 'unixroot', sUnixBack - call EnvAddFront fRM, 'path', sUnixBack'\bin;'sUnixBack'\usr\local\bin;' - call EnvAddFront fRM, 'beginlibpath', sUnixBack'\dll;' - call EnvSet fRM, 'groff_font_path', sUnixForw'/lib/groff/font' - call EnvSet fRM, 'groff_tmac_path', sUnixForw'/lib/groff/tmac' - call EnvSet fRM, 'refer', sUnixForw'/lib/groff/dict/papers/ind' - -/* call EnvSet fRM, 'editor', 'TEDIT' - don't change it */ - - sXF86Forw = translate(sXF86Back, '/', '\'); - call EnvSet fRM, 'PATH_XFREE86', sXF86Back - call EnvAddFront fRM, 'C_INCLUDE_PATH', sXF86Forw'/include' - call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sXF86Forw'/include' - call EnvSet fRM, 'OBJC_INCLUDE_PATH', sXF86Forw'/include' - call EnvAddFront fRM, 'LIBRARY_PATH', sXF86Forw'/lib' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sUnixBack'\bin\bash.exe', fQuiet, 1), - | \CfgVerifyFile(sUnixBack'\bin\sh.exe', fQuiet), - | \CfgVerifyFile(sUnixBack'\bin\yes.exe', fQuiet), - | \CfgVerifyFile(sUnixBack'\bin\rm.exe', fQuiet), - | \CfgVerifyFile(sUnixBack'\bin\cp.exe', fQuiet, 1), - | \CfgVerifyFile(sUnixBack'\bin\mv.exe', fQuiet. 1), - | \CfgVerifyFile(sXF86Back'\bin\xf86config.exe', fQuiet, 1), - ) then - return 2; -return 0; - - - -/* - * IBM Visual Age for C++ v3.08 for OS/2 - */ -VAC308: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * IBM Visual Age for C++ Version 3.08 main directory. - */ - sPathCPP = PathQuery('vac308', sToolId, sOperation); - if (sPathCPP = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_VAC308', sPathCPP - call EnvSet fRM, 'CCENV', 'VAC3' - call EnvSet fRM, 'BUILD_ENV', 'VAC308' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - - call EnvAddFront fRM, 'beginlibpath', sPathCPP'\DLL;'sPathCPP'\SAMPLES\TOOLKIT\DLL;' - call EnvAddFront fRM, 'path', sPathCPP'\BIN;'sPathCPP'\SMARTS\SCRIPTS;'sPathCPP'\HELP;' - call EnvAddFront fRM, 'dpath', sPathCPP'\HELP;'sPathCPP';'sPathCPP'\LOCALE;'sPathCPP'\MACROS;'sPathCPP'\BND;' - call EnvAddFront fRM, 'help', sPathCPP'\HELP;'sPathCPP'\SAMPLES\TOOLKIT\HELP;' - call EnvAddFront fRM, 'bookshelf', sPathCPP'\HELP;' - call EnvAddFront fRM, 'somir', sPathCPP'\ETC\SOM.IR;' - call EnvAddFront fRM, 'cpphelp_ini', 'C:\OS2\SYSTEM' - call EnvAddFront fRM, 'locpath', sPathCPP'\LOCALE;%LOCPATH%;' - call EnvAddFront fRM, 'include', sPathCPP'\INCLUDE;'sPathCPP'\INCLUDE\OS2;'sPathCPP'\INC;'sPathCPP'\INCLUDE\SOM;' - call EnvAddFront fRM, 'sminclude', sPathCPP'\INCLUDE\OS2;'sPathCPP'\INCLUDE;'sPathCPP'\INCLUDE\SOM;' - - call EnvAddFront fRM, 'vbpath', '.;'sPathCPP'\DDE4VB;' - call EnvSet fRM, 'tmpdir', EnvGet('tmp') - call EnvSet fRM, 'lxevfref', 'EVFELREF.INF+LPXCREF.INF' - call EnvSet fRM, 'lxevfhdi', 'EVFELHDI.INF+LPEXHDI.INF' - call EnvAddFront fRM, 'lpath', sPathCPP'\MACROS;' - call EnvAddFront fRM, 'codelpath', sPathCPP'\CODE\MACROS;'sPathCPP'\MACROS;' - call EnvSet fRM, 'clref', 'CPPCLRF.INF+CPPDAT.INF+CPPAPP.INF+CPPWIN.INF+CPPCTL.INF+CPPADV.INF+CPP2DG.INF+CPPDDE.INF+CPPDM.INF+CPPMM.INF+CPPCLRB.INF' - call EnvAddFront fRM, 'ipfc', sPathCPP'\IPFC' - call EnvAddFront fRM, 'lib', sPathCPP'\LIB;'sPathCPP'\DLL;' - call EnvSet fRM, 'cpplocal', sPathCPP - call EnvSet fRM, 'cppmain', sPathCPP - call EnvSet fRM, 'cppwork', sPathCPP - call EnvSet fRM, 'iwf.default_prj','CPPDFTPRJ' - - call EnvSet fRM, 'iwf.solution_lang_support', 'CPPIBS30;ENG' - call EnvSet fRM, 'vacpp_shared' 'FALSE' - call EnvSet fRM, 'iwfhelp', 'IWFHDI.INF' - call EnvSet fRM, 'iwfopt', sPathCPP - - call EnvSet fRM, 'somruntime', sPathCPP'\DLL' - call EnvSet fRM, 'smaddstar', '1' - call EnvSet fRM, 'smemit', 'h;ih;c' - call EnvSet fRM, 'sombase', sPathCPP - call EnvSet fRM, 'smtmp', EnvGet('tmp') - call EnvSet fRM, 'smclasses', 'WPTYPES.IDL' - - call EnvAddFront fRM, 'helpndx', 'EPMKWHLP.NDX+CPP.NDX+CPPBRS.NDX', '+' - call EnvAddFront fRM, 'ipf_keys', 'SHOWNAV' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathCPP'\bin\icc.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\bin\ilib.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\bin\ilink.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\bin\icsperf.exe', fQuiet,1), - | \CfgVerifyFile(sPathCPP'\bin\icsdebug.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\bin\cppfilt.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\bin\dllrname.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\lib\demangl.lib', fQuiet), - | \CfgVerifyFile(sPathCPP'\lib\cppom30.lib', fQuiet), - | \CfgVerifyFile(sPathCPP'\lib\cppom30i.lib', fQuiet), - | \CfgVerifyFile(sPathCPP'\lib\cppom30o.lib', fQuiet), - | \CfgVerifyFile(sPathCPP'\lib\cppon30i.lib', fQuiet), - | \CfgVerifyFile(sPathCPP'\lib\cppon30o.lib', fQuiet), - | \CfgVerifyFile(sPathCPP'\lib\_doscall.lib', fQuiet, 1), - | \CfgVerifyFile(sPathCPP'\lib\_pmwin.lib', fQuiet, 1), - | \CfgVerifyFile(sPathCPP'\include\builtin.h', fQuiet), - | \CfgVerifyFile(sPathCPP'\include\conio.h', fQuiet), - | \CfgVerifyFile(sPathCPP'\include\ismkss.h', fQuiet), - | FileExists(sPathCPP'\include\os2.h'), - | FileExists(sPathCPP'\include\os2win.h'), - | FileExists(sPathCPP'\include\pm.h'), - | \CfgVerifyFile(sPathCPP'\include\sys\utime.h', fQuiet), - | \CfgVerifyFile(sPathCPP'\help\cpplib.inf', fQuiet), - ) then - return 2; - - - rc = CheckSyslevel(sPathCPP||'\syslevel\syslevel.ct3', fQuiet,'562201703',,'CTC308',); - if (rc = 0) then - rc = CheckSyslevel(sPathCPP||'\syslevel\syslevel.ct4', fQuiet,'562201704',,'CTU308',); - /*if (rc = 0) then - rc = CheckCmdOutput('syslevel '||sPathCPP||'\syslevel', 0, fQuiet, 'Version 3.00 Component ID 562201707'||'0d0a'x||'Current CSD level: CTV308'); - if (rc = 0) then - rc = CheckSyslevel(sPathCPP||'\syslevel\syslevel.ct8', fQuiet,'562201708',,'CTD308',); - */ - if (rc = 0) then - rc = CheckSyslevel(sPathCPP||'\syslevel\syslevel.wf5', fQuiet,'562201605',,'CTC308',); - /*if (rc = 0) then - rc = CheckSyslevel(sPathCPP||'\syslevel\syslevel.wf2', fQuiet,'562201602',,'CTO308',); - */ - if (rc = 0) then - rc = CheckCmdOutput('icc', 0, fQuiet, 'IBM VisualAge C++ for OS/2, Version 3'); - if (rc = 0) then - rc = CheckCmdOutput('ilink', 16, fQuiet, 'IBM(R) Linker for OS/2(R), Version 01.08.r1a_CTC308c'); - if (rc = 0) then - rc = CheckCmdOutput('ilib /?', 8, fQuiet, 'IBM(R) Library Manager for OS/2(R), Version 01.00.03 cc_CTC308c'); -return rc; - - - -/* - * Visual Age / C and C++ tools v3.6.5 for OS/2 - */ -VAC365: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * IBM C/C++ Compiler and Tools Version 3.6.5 main directory. - */ - sPathCxx = PathQuery('vac365', sToolId, sOperation); - if (sPathCxx = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_VAC365', sPathCxx; - call EnvSet fRM, 'CCENV', 'VAC36' - call EnvSet fRM, 'BUILD_ENV', 'VAC365' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - - call EnvSet fRM, 'cxxmain', sPathCxx; - call EnvAddFront fRM, 'path', sPathCxx'\bin;' - call EnvAddFront fRM, 'dpath', sPathCxx'\local;'sPathCxx'\help;' - call EnvAddFront fRM, 'beginlibpath',sPathCxx'\dll;'sPathCxx'\runtime;' - call EnvAddFront fRM, 'nlspath', sPathCxx'\msg\%N;' - call EnvAddFront fRM, 'include', sPathCxx'\include;' - call EnvAddFront fRM, 'lib', sPathCxx'\lib;' - call EnvAddFront fRM, 'ipfc', sPathCxx'\ipfc;' - call EnvSet fRM, 'LANG', 'en_us' - call EnvSet fRM, 'CPP_DBG_LANG', 'CPP' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathCxx'\bin\icc.exe', fQuiet), - | \CfgVerifyFile(sPathCxx'\bin\ilib.exe', fQuiet), - | \CfgVerifyFile(sPathCxx'\bin\ilink.exe', fQuiet), - | \CfgVerifyFile(sPathCxx'\bin\idebug.exe', fQuiet), - | \CfgVerifyFile(sPathCxx'\bin\cppfilt.exe', fQuiet), - | \CfgVerifyFile(sPathCxx'\bin\dllrname.exe', fQuiet), - | \CfgVerifyFile(sPathCxx'\bin\cppcbe36.exe', fQuiet), - | \CfgVerifyFile(sPathCxx'\lib\cpprms36.lib', fQuiet), - | \CfgVerifyFile(sPathCxx'\lib\cpprmi36.lib', fQuiet), - | \CfgVerifyFile(sPathCxx'\lib\cpprmo36.lib', fQuiet), - | \CfgVerifyFile(sPathCxx'\lib\cpprni36.lib', fQuiet), - | \CfgVerifyFile(sPathCxx'\lib\cpprds36.lib', fQuiet), - | \CfgVerifyFile(sPathCxx'\include\builtin.h', fQuiet), - | \CfgVerifyFile(sPathCxx'\include\conio.h', fQuiet), - | \CfgVerifyFile(sPathCxx'\include\ismavl.h', fQuiet), - | FileExists(sPathCxx'\include\os2.h'), - | FileExists(sPathCxx'\include\os2win.h'), - | FileExists(sPathCxx'\include\pm.h'), - | \CfgVerifyFile(sPathCxx'\include\sys\utime.h', fQuiet), - | \CfgVerifyFile(sPathCxx'\help\cpplbm36.msg', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('icc', 0, fQuiet, 'IBM* C and C++ Compilers for OS/2*, AIX* and for Windows NT**, Version 3.6'); - if (rc = 0) then - rc = CheckCmdOutput('ilink', 16, fQuiet, 'IBM(R) Linker for OS/2(R), Version 03.06.PPK1010917.011116ilink'); - if (rc = 0) then - rc = CheckCmdOutput('ilib /?', 0, fQuiet, 'IBM Librarian for OS/2(R) Version 03.99.PPK1001123'); - if (stream(sPathCxx'\bin\cppcbe36.exe', 'c', 'query size') <> 603122) then - do - say 'Error!!! Get latest vac365 optimizer fixes from the OS2 Mozilla project.'; - say ' http://www.mozilla.org/ports/os2/setup.html'; - rc = 99; - end -return rc; - - -/* - * Visual Age for C++ v4.0 for OS/2 - */ -VAC40: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * IBM VisualAge for C++ v4.0 main directory. - */ - sPathCPP = PathQuery('vac40', sToolId, sOperation); - if (sPathCPP = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_VAC40', sPathCPP; - call EnvSet fRM, 'CCENV', 'VAC40' - call EnvSet fRM, 'BUILD_ENV', 'VAC40' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - - call EnvAddFront fRM, 'path', sPathCPP'\bin;' - call EnvAddFront fRM, 'dpath', sPathCPP'\etc;'sPathCPP'\help;' - call EnvAddFront fRM, 'beginlibpath',sPathCPP'\dll;'sPathCPP'\runtime;' - call EnvAddFront fRM, 'help', sPathCPP'\help;' - call EnvAddFront fRM, 'nlspath', sPathCPP'\msg\%N;' - call EnvAddFront fRM, 'locpath', sPathCPP'\locale;'sPathCPP'\runtime\locale;' - call EnvAddFront fRM, 'include', sPathCPP'\ivb;'sPathCPP'\include;' - call EnvAddFront fRM, 'lib', sPathCPP'\lib;' - call EnvAddFront fRM, 'ipfc', sPathCPP'\bin;' - call EnvAddFront fRM, 'cpplpath4', sPathCPP'\macros;' - call EnvSet fRM, 'system_ice', sPathCPP'\etc\system.ice' - call EnvSet fRM, 'vbpath', sPathCPP'\ivb' - call EnvSet fRM, 'vacppmain', sPathCPP; - call EnvSet fRM, 'os2', '1' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathCPP'\bin\iccv4.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\bin\ilib.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\bin\ire.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\bin\vacide.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\bin\cppfilt.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\bin\dllrname.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\bin\patrace.exe', fQuiet), - | \CfgVerifyFile(sPathCPP'\lib\cpprms40.lib', fQuiet), - | \CfgVerifyFile(sPathCPP'\lib\cpprmi40.lib', fQuiet), - | \CfgVerifyFile(sPathCPP'\lib\cpprmo40.lib', fQuiet), - | \CfgVerifyFile(sPathCPP'\lib\cpprni40.lib', fQuiet), - | \CfgVerifyFile(sPathCPP'\lib\cpprds40.lib', fQuiet), - | \CfgVerifyFile(sPathCPP'\include\builtin.h', fQuiet), - | \CfgVerifyFile(sPathCPP'\include\conio.h', fQuiet), - | \CfgVerifyFile(sPathCPP'\include\ismavl.h', fQuiet), - | FileExists(sPathCPP'\include\os2.h'), - | FileExists(sPathCPP'\include\os2win.h'), - | FileExists(sPathCPP'\include\pm.h'), - | \CfgVerifyFile(sPathCPP'\include\sys\utime.h', fQuiet), - | \CfgVerifyFile(sPathCPP'\help\cpplbm40.msg', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('iccv4', 0, fQuiet, 'IBM VisualAge for C++ Version 4.0 C Compiler'); - if (rc = 0) then - rc = CheckCmdOutput('ilib /?', 0, fQuiet, 'IBM Librarian for OS/2(R) Version 03.99.cc_981110'); /* is this really FP2?????? */ - if (rc = 0) then - rc = CheckCmdOutput('vacbld -?', 0, fQuiet, 'IBM(R) VisualAge(R) C++ Professional, Version 4.0 (981117)'); /* is this really FP2?????? */ -return rc; - - - - -/* - * WarpIn - */ -WarpIn: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet - - /* - * WarpIn main directory. - */ - sPathWarpIn = PathQuery('warpin', sToolId, sOperation); - if (sPathWarpIn = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_WARPIN', sPathWarpIn; - call EnvAddFront fRM, 'path', sPathWarpIn';' - call EnvAddFront fRM, 'beginlibpath',sPathWarpIn';' - call EnvAddFront fRM, 'bookshelf', sPathWarpIn';' - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathWarpIn'\wic.exe', fQuiet), - | \CfgVerifyFile(sPathWarpIn'\wpirtl.dll', fQuiet), - | \CfgVerifyFile(sPathWarpIn'\warpin.exe', fQuiet), - ) then - return 2; - rc = CheckCmdOutput('wic', 1, fQuiet, '2002 - WarpIn archive creation and maintenance'); -return rc; - - - -/* - * Watcom C/C++ v11.0 - */ -WatcomC11: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet, iBits - - /* - * Watcom C/C++ v11.0 main directory - */ - sPathWatcom = PathQuery('watcom11', sToolId, sOperation); - if (sPathWatcom = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_WATCOM', sPathWatcom - call EnvSet fRM, 'CCENV', 'WAT' - call EnvSet fRM, 'BUILD_ENV', 'WAT11' - if (iBits == 16) then - call EnvSet fRM, 'BUILD_ENV', 'WAT11-16' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - - call EnvSet fRM, 'watcom', sPathWatcom - call EnvAddFront fRM, 'path', sPathWatcom'\binp;'sPathWatcom'\binw;' - call EnvAddFront fRM, 'beginlibpath',sPathWatcom'\binp\dll;' - call EnvAddFront fRM, 'help', sPathWatcom'\binp\help;' - call EnvAddEnd fRM, 'bookshelf', sPathWatcom'\binp\help;' - call EnvAddFront fRM, 'include', sPathWatcom'\h;'sPathWatcom'\h\os2;'sPathWatcom'\h\nt;' - call EnvAddFront fRM, 'lib', sPathWatcom'\lib386;'sPathWatcom'\lib386\os2;'sPathWatcom'\lib286;'sPathWatcom'\lib286\os2;' - call EnvSet fRM, 'edpath', sPathWatcom'EDDAT;' - /* - rem detach %watcom%\BINP\BATSERV.EXE - rem detach %watcom%\BINP\NMPBIND.EXE - */ - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathWatcom'\binp\wpp.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\binp\wcc.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\binp\wcc386.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\binp\wpp386.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\binp\wlink.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\lib286\os2\os2.lib', fQuiet), - | \CfgVerifyFile(sPathWatcom'\lib386\os2\clbrdll.lib', fQuiet), - | \CfgVerifyFile(sPathWatcom'\lib386\os2\clib3r.lib', fQuiet), - | \CfgVerifyFile(sPathWatcom'\lib386\nt\kernel32.lib', fQuiet,1), - | \CfgVerifyFile(sPathWatcom'\lib386\nt\clbrdll.lib', fQuiet,1), - | \CfgVerifyFile(sPathWatcom'\lib386\nt\clib3r.lib', fQuiet,1), - ) then - return 2; - rc = CheckCmdOutput('wcc', 8, fQuiet, 'Watcom C16 Optimizing Compiler Version 11.0 '||'0d0a'x); - if (rc = 0) then - rc = CheckCmdOutput('wpp', 8, fQuiet, 'Watcom C++16 Optimizing Compiler Version 11.0 '||'0d0a'x); - if (rc = 0) then - rc = CheckCmdOutput('wcc386', 8, fQuiet, 'Watcom C32 Optimizing Compiler Version 11.0 '||'0d0a'x); - if (rc = 0) then - rc = CheckCmdOutput('wpp386', 8, fQuiet, 'Watcom C++32 Optimizing Compiler Version 11.0 '||'0d0a'x); - if (rc = 0) then - rc = CheckCmdOutput('wlink form ELF', 1, fQuiet, 'WATCOM Linker Version 11.0'||'0d0a'x); -return rc; - - -/* - * Watcom C/C++ v11.0c - */ -WatcomC11c: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet, iBits - - /* - * Watcom C/C++ v11.0c main directory - */ - sPathWatcom = PathQuery('watcom11c', sToolId, sOperation); - if (sPathWatcom = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_WATCOM', sPathWatcom - call EnvSet fRM, 'CCENV', 'WAT' - call EnvSet fRM, 'BUILD_ENV', 'WAT11C' - if (iBits = 16) then - call EnvSet fRM, 'BUILD_ENV', 'WAT11C-16' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - - call EnvSet fRM, 'watcom', sPathWatcom - call EnvAddFront fRM, 'path', sPathWatcom'\binp;'sPathWatcom'\binw;' - call EnvAddFront fRM, 'beginlibpath',sPathWatcom'\binp\dll;' - call EnvAddFront fRM, 'help', sPathWatcom'\binp\help;' - call EnvAddEnd fRM, 'bookshelf', sPathWatcom'\binp\help;' - if (iBits = 16) then - call EnvAddFront fRM, 'include', sPathWatcom'\h;'sPathWatcom'\h\os21x;' - else - call EnvAddFront fRM, 'include', sPathWatcom'\h;'sPathWatcom'\h\os2;'sPathWatcom'\h\nt;' - call EnvAddFront fRM, 'lib', sPathWatcom'\lib386;'sPathWatcom'\lib386\os2;'sPathWatcom'\lib286;'sPathWatcom'\lib286\os2;' - call EnvSet fRM, 'edpath', sPathWatcom'EDDAT;' - /* - rem detach %watcom%\BINP\BATSERV.EXE - rem detach %watcom%\BINP\NMPBIND.EXE - */ - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathWatcom'\binp\wpp.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\binp\wcc.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\binp\wcc386.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\binp\wpp386.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\binp\wlink.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\lib286\os2\os2.lib', fQuiet, 1), - | \CfgVerifyFile(sPathWatcom'\lib386\os2\clbrdll.lib', fQuiet), - | \CfgVerifyFile(sPathWatcom'\lib386\os2\clib3r.lib', fQuiet), - | \CfgVerifyFile(sPathWatcom'\lib386\nt\kernel32.lib', fQuiet, 1), - | \CfgVerifyFile(sPathWatcom'\lib386\nt\clbrdll.lib', fQuiet, 1), - | \CfgVerifyFile(sPathWatcom'\lib386\nt\clib3r.lib', fQuiet, 1), - ) then - return 2; - rc = CheckCmdOutput('wcc', 8, fQuiet, 'Watcom C16 Optimizing Compiler Version 11.0c'); - if (rc = 0) then - rc = CheckCmdOutput('wpp', 8, fQuiet, 'Watcom C++16 Optimizing Compiler Version 11.0c'); - if (rc = 0) then - rc = CheckCmdOutput('wcc386', 8, fQuiet, 'Watcom C32 Optimizing Compiler Version 11.0c'); - if (rc = 0) then - rc = CheckCmdOutput('wpp386', 8, fQuiet, 'Watcom C++32 Optimizing Compiler Version 11.0c'); - if (rc = 0) then - rc = CheckCmdOutput('wlink form ELF', 1, fQuiet, 'WATCOM Linker Version 11.0c'); -return rc; - - -/* - * Open Watcom C/C++ v1.4 and higher - */ -OpenWatcomC14: procedure expose aCfg. aPath. - parse arg sToolId,sOperation,fRM,fQuiet, iBits - - /* - * Watcom C/C++ v1.4 (and higher) main directory - */ - sPathId = sToolId; - if (pos('-', sToolId) > 0) then - sPathId = substr(sToolId, 1, pos('-', sToolId)); - sPathWatcom = PathQuery(sPathId, sToolId, sOperation); - if (sPathWatcom = '') then - return 1; - /* If config operation we're done now. */ - if (pos('config', sOperation) > 0) then - return 0; - - /* - * Installing the environment variables. - */ - call EnvSet fRM, 'PATH_WATCOM', sPathWatcom - call EnvSet fRM, 'CCENV', 'WAT' - call EnvSet fRM, 'BUILD_ENV', 'OW14' - if (iBits = 16) then - call EnvSet fRM, 'BUILD_ENV', 'OW14-16' - call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' - - call EnvSet fRM, 'watcom', sPathWatcom - call EnvAddFront fRM, 'path', sPathWatcom'\binp;'sPathWatcom'\binw;' - call EnvAddFront fRM, 'beginlibpath',sPathWatcom'\binp\dll;' - call EnvAddFront fRM, 'help', sPathWatcom'\binp\help;' - call EnvAddEnd fRM, 'bookshelf', sPathWatcom'\binp\help;' - if (iBits = 16) then - call EnvAddFront fRM, 'include', sPathWatcom'\h;'sPathWatcom'\h\os21x;' - else - call EnvAddFront fRM, 'include', sPathWatcom'\h;'sPathWatcom'\h\os2;'sPathWatcom'\h\nt;' - call EnvAddFront fRM, 'lib', sPathWatcom'\lib386;'sPathWatcom'\lib386\os2;'sPathWatcom'\lib286;'sPathWatcom'\lib286\os2;' - call EnvSet fRM, 'edpath', sPathWatcom'EDDAT;' - /* - rem detach %watcom%\BINP\BATSERV.EXE - rem detach %watcom%\BINP\NMPBIND.EXE - */ - - /* - * Verify. - */ - if (pos('verify', sOperation) <= 0) then - return 0; - if ( \CfgVerifyFile(sPathWatcom'\binp\wpp.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\binp\wcc.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\binp\wcc386.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\binp\wpp386.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\binp\wlink.exe', fQuiet), - | \CfgVerifyFile(sPathWatcom'\lib286\os2\os2.lib', fQuiet, 1), - | \CfgVerifyFile(sPathWatcom'\lib386\os2\clbrdll.lib', fQuiet), - | \CfgVerifyFile(sPathWatcom'\lib386\os2\clib3r.lib', fQuiet), - | \CfgVerifyFile(sPathWatcom'\lib386\nt\kernel32.lib', fQuiet, 1), - | \CfgVerifyFile(sPathWatcom'\lib386\nt\clbrdll.lib', fQuiet, 1), - | \CfgVerifyFile(sPathWatcom'\lib386\nt\clib3r.lib', fQuiet, 1), - ) then - return 2; - rc = CheckCmdOutput('wcc', 8, fQuiet, 'Open Watcom C16 Optimizing Compiler Version 1.4'); - if (rc = 0) then - rc = CheckCmdOutput('wpp', 8, fQuiet, 'Open Watcom C++16 Optimizing Compiler Version 1.4'); - if (rc = 0) then - rc = CheckCmdOutput('wcc386', 8, fQuiet, 'Open Watcom C32 Optimizing Compiler Version 1.4'); - if (rc = 0) then - rc = CheckCmdOutput('wpp386', 8, fQuiet, 'Open Watcom C++32 Optimizing Compiler Version 1.4'); - if (rc = 0) then - rc = CheckCmdOutput('wlink form ELF', 1, fQuiet, 'Open Watcom Linker Version 1.4'); -return rc; - +/* $Id: buildenv.cmd,v 1.59 2006-03-31 21:47:03 bird Exp $ + * + * This is the master tools environment script. It contains environment + * configurations for many development tools. Each tool can be installed + * and uninstalled from the environment interchangably. + * + * Note: Of historic reasons, there are some environments here which + * isn't normally used by normal code trees. + * + * + * Known problems: + * - LANG is set to en_US by both VAC36 and TOOLKIT45. When unsetting + * those the original value, for example of no_NO, is not restored. + * - Same goes for some other stuff, we have no stack of previous values. + * + * Copyright (c) 1999-2005 knut st. osmundsen (bird@anduin.net) + * + * GPL v2 + * + */ + + Address CMD '@echo off'; + + signal on novalue name NoValueHandler + + /* + * Version + */ + sVersion = '1.1.4 [2005-12-18]'; + + /* + * Create argument array with lowercase arguments. + */ + parse arg sEnv.1 sEnv.2 sEnv.3 sEnv.4 sEnv.5 sEnv.6 sEnv.7 sEnv.8 sEnv.9 sEnv.10 sEnv.11 sEnv.12 sEnv.13 sEnv.14 sEnv.15 sEnv.16 sEnv.17 sEnv.18 sEnv.19 sEnv.20 sEnv.21 sEnv.22 sEnv.23 + + i = 1; + do while (sEnv.i <> '') + sEnv.i = translate(strip(sEnv.i), 'abcdefghijklmnopqrstuvwxyz‘›†', 'ABCDEFGHIJKLMNOPQRSTUVWXYZ’'); + i = i + 1; + end + sEnv.0 = i - 1; + + /* + * Syntax + */ + if (sEnv.0 = 0) then + do + say 'BuildEnv v'||sVersion + say '-------------------------------' + say '' + say 'Synopsis: Environment configuration utility written to maintain' + say 'many different versions of compilers and toolkits on the same' + say 'workstation. ' + say '' + say 'Syntax: BuildEnv.cmd [action]' + say '' + say 'Actions:' + say ' + Install tool in environment. Default action.' + say ' ~ Install tool in environment if it''s configured.' + say ' - Remove tool from environment.' + say ' õ Remove tool from environment if it''s configured.' + say ' * Configure tool if needed.' + say ' ! Forced tool configuretion.' + say ' @ Verify tool configuration.' + say ' ? Query if a tool is configured.' + say '' + say 'Special environments (commands):' + say ' allconfig Configure all tools which fails verify.' + say ' allreconfig Reconfigure all tools.' + say ' allverify Verify all configured tools.' + say ' alluninstall Removed all configured tools from environment.' + say ' showall Show all tools.' + say ' showconfigured Show all configured tools.' + say ' shownotconfigured Show all tools which isn''t configured.' + say '' + say 'Copyright (c) 1999-2003 knut st. osmundsen' + say 'Published under GPL v2' + return 8; + end + + /* + * Load REXX Util Functions. + * (Need Sys[Query|Set]ExtLibPath.) + */ + if (RxFuncQuery('SysLoadFuncs') = 1) then + do + call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; + call SysLoadFuncs; + end + + + /* + * Apply CMD.EXE workaround. + */ + call FixCMDEnv; + + + /* + * Configuration - sorted please! + */ + aPath.0 = 0; + + i = 1; + /* Tool id The tool's group The function with args. Optional verify data. increment index */ + aCfg.i.sId = 'cvs'; aCfg.i.sGrp = 'version'; aCfg.i.sSet = 'CVS'; aCfg.i.sDesc = 'CVS v1.10 or later'; i = i + 1; + aCfg.i.sId = 'db2v52'; aCfg.i.sGrp = 'database'; aCfg.i.sSet = 'db2v52'; aCfg.i.sDesc = 'DB2 v5.2 Dev Edition'; i = i + 1; + aCfg.i.sId = 'ddk'; aCfg.i.sGrp = 'ddk'; aCfg.i.sSet = 'DDK'; aCfg.i.sDesc = 'OS/2 DDK (recent)'; i = i + 1; + aCfg.i.sId = 'ddkbase'; aCfg.i.sGrp = 'ddk'; aCfg.i.sSet = 'DDKBase'; aCfg.i.sDesc = 'DDK Base (recent)'; i = i + 1; + aCfg.i.sId = 'ddkvideo'; aCfg.i.sGrp = 'ddk'; aCfg.i.sSet = 'DDKVideo'; aCfg.i.sDesc = 'DDK Video (recent)'; i = i + 1; + aCfg.i.sId = 'doxygen'; aCfg.i.sGrp = 'doc'; aCfg.i.sSet = 'DoxyGen'; aCfg.i.sDesc = 'Doxygen v1.2.11 for OS/2'; i = i + 1; + aCfg.i.sId = 'emx'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'EMX'; aCfg.i.sDesc = 'EMX v0.9d fixpack 04'; i = i + 1; + aCfg.i.sId = 'emxpgcc'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'EMXPGCC'; aCfg.i.sDesc = 'Pentium Optimized GCC/EMX v1.1.1 r2 with binutils 2.9.1'; i = i + 1; + aCfg.i.sId = 'freetypeemx'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'FreeTypeEMX'; aCfg.i.sDesc = 'FreeType v1.3.1 for EMX.'; i = i + 1; + aCfg.i.sId = 'gcc302'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC3xx,''gcc302'''; aCfg.i.sDesc = 'GCC/EMX v3.0.2beta with binutils 2.11.2'; i = i + 1; + aCfg.i.sId = 'gcc303'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC3xx,''gcc303'''; aCfg.i.sDesc = 'GCC/EMX v3.0.3beta with binutils 2.11.2'; i = i + 1; + aCfg.i.sId = 'gcc321'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC3xx,''gcc321'''; aCfg.i.sDesc = 'GCC/EMX v3.2.1beta with binutils 2.11.2'; i = i + 1; + aCfg.i.sId = 'gcc322'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC322plus,''gcc322'''; aCfg.i.sDesc = 'Innotek GCC v3.2.2'; i = i + 1; + aCfg.i.sId = 'gcc334'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC322plus,''gcc334'''; aCfg.i.sDesc = 'Innotek GCC v3.3.4'; i = i + 1; + aCfg.i.sId = 'gcc335'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC322plus,''gcc335'''; aCfg.i.sDesc = 'Innotek GCC v3.3.4'; i = i + 1; + aCfg.i.sId = 'gcc343'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'GCC322plus,''gcc343'''; aCfg.i.sDesc = 'Innotek GCC v3.4.3'; i = i + 1; + aCfg.i.sId = 'icatgam'; aCfg.i.sGrp = 'debugger'; aCfg.i.sSet = 'ICATGam'; aCfg.i.sDesc = 'ICAT for OS/2 latest'; i = i + 1; + aCfg.i.sId = 'icatgam406rc1'; aCfg.i.sGrp = 'debugger'; aCfg.i.sSet = 'ICATGam406RC1'; aCfg.i.sDesc = 'ICAT for OS/2 v4.0.6 release candidate 1'; i = i + 1; + aCfg.i.sId = 'icatpe'; aCfg.i.sGrp = 'debugger'; aCfg.i.sSet = 'ICATPe'; aCfg.i.sDesc = 'ICAT for OS/2 with PE support (test version)'; i = i + 1; + aCfg.i.sId = 'ida'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'IDA414'; aCfg.i.sDesc = 'Interactive DisAssembler (IDA) (latest)'; i = i + 1; + aCfg.i.sId = 'ida38'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'IDA38'; aCfg.i.sDesc = 'Interactive DisAssembler (IDA) v3.80 (historical)'; i = i + 1; + aCfg.i.sId = 'ida40'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'IDA40'; aCfg.i.sDesc = 'Interactive DisAssembler (IDA) v4.0 (historical)'; i = i + 1; + aCfg.i.sId = 'ida414'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'IDA414'; aCfg.i.sDesc = 'Interactive DisAssembler (IDA) v4.14'; i = i + 1; + aCfg.i.sId = 'idasdk'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'IDASDK'; aCfg.i.sDesc = 'Interactive DisAssembler (IDA) SDK'; i = i + 1; + aCfg.i.sId = 'icsdebug'; aCfg.i.sGrp = 'debugger'; aCfg.i.sSet = 'icsdebug'; aCfg.i.sDesc = 'icsdebug from VAC308'; i = i + 1; + aCfg.i.sId = 'idebug'; aCfg.i.sGrp = 'debugger'; aCfg.i.sSet = 'idebug'; aCfg.i.sDesc = 'idebug from VAC365'; i = i + 1; + aCfg.i.sId = 'java131'; aCfg.i.sGrp = 'java'; aCfg.i.sSet = 'Java131'; aCfg.i.sDesc = 'Java v1.3.1 (co131-20020710)'; i = i + 1; + aCfg.i.sId = 'jitdbg'; aCfg.i.sGrp = 'debugger'; aCfg.i.sSet = 'jitdbg'; aCfg.i.sDesc = 'jitdbg (secret)'; i = i + 1; + aCfg.i.sId = 'jpeg'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'JPEG'; aCfg.i.sDesc = '(lib)JPEG v6b'; i = i + 1; + aCfg.i.sId = 'mode12050'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'Mode,120,50'; aCfg.i.sDesc = 'mode 120,50'; i = i + 1; + aCfg.i.sId = 'mode8050'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'Mode,80,50'; aCfg.i.sDesc = 'mode 80,50'; i = i + 1; + aCfg.i.sId = 'mscv6'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'MSCV6_32'; aCfg.i.sDesc = 'MicroSoft C v6.0 32-bit'; i = i + 1; + aCfg.i.sId = 'mscv6-16'; aCfg.i.sGrp = 'comp16'; aCfg.i.sSet = 'MSCV6_16'; aCfg.i.sDesc = 'MicroSoft C v6.0a 16-bit'; i = i + 1; + aCfg.i.sId = 'mscv7-16'; aCfg.i.sGrp = 'comp16'; aCfg.i.sSet = 'MSCV7_16'; aCfg.i.sDesc = 'MicroSoft C v7.0 16-bit with OS/2 support'; i = i + 1; + aCfg.i.sId = 'mysql'; aCfg.i.sGrp = 'database'; aCfg.i.sSet = 'mySQL'; aCfg.i.sDesc = 'MySql any version (latest from Yuri is recommended)'; i = i + 1; + aCfg.i.sId = 'nasm9833'; aCfg.i.sGrp = 'asm'; aCfg.i.sSet = 'NASM,''nasm9833'''; aCfg.i.sDesc = 'NASM version 0.98.33 compiled on May 28 2002'; i = i + 1; + aCfg.i.sId = 'netqos2'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'NetQOS2'; aCfg.i.sDesc = 'NetQOS2 - help system for VAC40,VAC365,DB2 and more.'; i = i + 1; + aCfg.i.sId = 'odin32testcase'; aCfg.i.sGrp = 'tests'; aCfg.i.sSet = 'Odin32Testcase'; aCfg.i.sDesc = 'Odin32 testcase setup'; i = i + 1; + aCfg.i.sId = 'owc14'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'OpenWatcomC14,32,'; aCfg.i.sDesc = 'Open Watcom C/C++ v1.4 32-bit'; i = i + 1; + aCfg.i.sId = 'owc14-16'; aCfg.i.sGrp = 'comp16'; aCfg.i.sSet = 'OpenWatcomC14,16,'; aCfg.i.sDesc = 'Open Watcom C/C++ v1.4 16-bit'; i = i + 1; + aCfg.i.sId = 'perl'; aCfg.i.sGrp = 'script'; aCfg.i.sSet = 'Perl580'; aCfg.i.sDesc = 'Perl v5.8.0'; i = i + 1; + aCfg.i.sId = 'perl580'; aCfg.i.sGrp = 'script'; aCfg.i.sSet = 'Perl580'; aCfg.i.sDesc = 'Perl v5.8.0'; i = i + 1; + aCfg.i.sId = 'perl50053'; aCfg.i.sGrp = 'script'; aCfg.i.sSet = 'Perl50xxx'; aCfg.i.sDesc = 'Perl v5.0053'; i = i + 1; + aCfg.i.sId = 'python'; aCfg.i.sGrp = 'script'; aCfg.i.sSet = 'Python'; aCfg.i.sDesc = 'Python v1.5'; i = i + 1; + aCfg.i.sId = 'svn'; aCfg.i.sGrp = 'version'; aCfg.i.sSet = 'Subversion'; aCfg.i.sDesc = 'Subversion 1.0.6 or later.'; i = i + 1; + aCfg.i.sId = 'toolkit40'; aCfg.i.sGrp = 'tlktos2'; aCfg.i.sSet = 'Toolkit40'; aCfg.i.sDesc = 'Toolkit v4.0 CSD 4'; i = i + 1; + aCfg.i.sId = 'toolkit40'; aCfg.i.sGrp = 'tlktos2'; aCfg.i.sSet = 'Toolkit40'; aCfg.i.sDesc = 'Toolkit v4.0 CSD 4'; i = i + 1; + aCfg.i.sId = 'toolkit45'; aCfg.i.sGrp = 'tlktos2'; aCfg.i.sSet = 'Toolkit45'; aCfg.i.sDesc = 'Toolkit v4.5'; i = i + 1; + aCfg.i.sId = 'toolkit451'; aCfg.i.sGrp = 'tlktos2'; aCfg.i.sSet = 'Toolkit451'; aCfg.i.sDesc = 'Toolkit v4.5.1'; i = i + 1; + aCfg.i.sId = 'toolkit452'; aCfg.i.sGrp = 'tlktos2'; aCfg.i.sSet = 'Toolkit452'; aCfg.i.sDesc = 'Toolkit v4.5.2'; i = i + 1; + aCfg.i.sId = 'unix'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'Unix'; aCfg.i.sDesc = 'Misc unix stuff.'; i = i + 1; + aCfg.i.sId = 'vac308'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'VAC308'; aCfg.i.sDesc = 'VisualAge for C++ v3.08'; i = i + 1; + aCfg.i.sId = 'vac365'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'VAC365'; aCfg.i.sDesc = 'VisualAge for C++ v3.6.5 FP2 with latest optimizer fixes.'; i = i + 1; + aCfg.i.sId = 'vac40'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'VAC40'; aCfg.i.sDesc = 'VisualAge for C++ v4.0 FP2(??)'; i = i + 1; + aCfg.i.sId = 'warpin'; aCfg.i.sGrp = 'misc'; aCfg.i.sSet = 'WarpIn'; aCfg.i.sDesc = 'WarpIn 0.9.18+ (for Odin32 18 with fix is required)'; i = i + 1; + aCfg.i.sId = 'watcomc11'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'WatcomC11,32,'; aCfg.i.sDesc = 'Watcom C/C++ v11.0 32-bit (no fixes)'; i = i + 1; + aCfg.i.sId = 'watcomc11-16'; aCfg.i.sGrp = 'comp16'; aCfg.i.sSet = 'WatcomC11,16'; aCfg.i.sDesc = 'Watcom C/C++ v11.0 16-bit (no fixes)'; i = i + 1; + aCfg.i.sId = 'watcomc11c'; aCfg.i.sGrp = 'comp32'; aCfg.i.sSet = 'WatcomC11c,32'; aCfg.i.sDesc = 'Watcom C/C++ v11.0c 32-bit (beta)'; i = i + 1; + aCfg.i.sId = 'watcomc11c-16'; aCfg.i.sGrp = 'comp16'; aCfg.i.sSet = 'WatcomC11c,16'; aCfg.i.sDesc = 'Watcom C/C++ v11.0c 16-bit (beta)'; i = i + 1; + aCfg.0 = i - 1; + + + + /* + * Parse arguments + */ + do i = 1 to sEnv.0 + /* uses dash to mark end of arguments */ + if ((sEnv.i = '-') | (sEnv.i = '*')) then + leave; + + /* + * Get last char. + * Dash means remove, pluss means add, asterix means verify and configure. + * Pluss is default and optional. + * + */ + ch = substr(sEnv.i, length(sEnv.i), 1); + if (pos(ch, '+~-õ*!?@') > 0) then + sEnv.i = substr(sEnv.i, 1, length(sEnv.i) - 1); + else + ch = '+'; + fRM = (ch = '-' | ch = 'õ'); + fOptional = (ch = '~' | ch = 'õ') + fCfg = (ch = '*'); + fForcedCfg = (ch = '!'); + fVerify = (ch = '@') + fQuery = (ch = '?') + + /* + * do the switch. + */ + rc = 0; + select + + /* + * Multi tool operations. + */ + when (sEnv.i = 'allconfig') then do + do j = 1 to aCfg.0 + if (CfgVerify(j, 0, 1) <> 0) then + do + rc = CfgConfigure(j, 1); + if (rc >= 8) then + exit(rc); + end + end + end + + when (sEnv.i = 'allreconfig') then do + do j = 1 to aCfg.0 + rc = CfgConfigure(j, 1); + if (rc >= 8) then + exit(rc); + end + end + + when (sEnv.i = 'allverify') then do + do j = 1 to aCfg.0 + if (CfgIsConfigured(j)) then + call CfgVerify j, 0, 1; + end + end + + when (sEnv.i = 'alluninstall') then do + do j = 1 to aCfg.0 + if (CfgIsConfigured(j)) then + call CfgInstallUninstall j, 1; + end + end + + when (sEnv.i = 'showall') then do + do j = 1 to aCfg.0 + say left(aCfg.j.sId, 15) '-' left(aCfg.j.sGrp, 8) '-' aCfg.j.sDesc + sPath = PathQuery(aCfg.j.sId, aCfg.j.sId, 'quietisconfig'); + if (sPath <> '') then + say ' 'sPath; + end + end + when (sEnv.i = 'showconfigured') then do + do j = 1 to aCfg.0 + if (CfgIsConfigured(j)) then + do + say left(aCfg.j.sId, 15) '-' left(aCfg.j.sGrp, 8) '-' aCfg.j.sDesc + sPath = PathQuery(aCfg.j.sId, aCfg.j.sId, 'quietisconfig'); + if (sPath <> '') then + say ' 'sPath; + end + end + end + + when (sEnv.i = 'shownotconfigured') then do + do j = 1 to aCfg.0 + if (\CfgIsConfigured(j)) then + say left(aCfg.j.sId, 15) '-' left(aCfg.j.sGrp, 8) '-' aCfg.j.sDesc + end + end + + + /* + * Special 'tools'. + */ + when (sEnv.i = 'debug') then do + rc = EnvSet(0, 'DEBUG','1'); + rc = EnvSet(0, 'RELEASE',''); + rc = EnvSet(0, 'BUILD_MODE','DEBUG'); + end + when (sEnv.i = 'profile') then do + rc = EnvSet(0, 'DEBUG','1'); + rc = EnvSet(0, 'RELEASE',''); + rc = EnvSet(0, 'BUILD_MODE','PROFILE'); + end + when (sEnv.i = 'release') then do + rc = EnvSet(0, 'DEBUG',''); + rc = EnvSet(0, 'RELEASE','1'); + rc = EnvSet(0, 'BUILD_MODE','RELEASE'); + end + + when (sEnv.i = 'buildsetup') then + rc = EnvSet(0, 'BUILD_SETUP_MAK','make\setup.mak'); + + /* + * Generic + */ + otherwise + do + fFound = 0; + do j = 1 to aCfg.0 + if (aCfg.j.sId = sEnv.i) then + do + /* + * Found the environment. + */ + fFound = 1; + + /* + * Take requested action. + */ + rc = -16; + if (fCfg | fForcedCfg) then + rc = CfgConfigure(j, fForcedCfg); + else if (fVerify) then + rc = CfgVerify(j, 0, 1); + else if (fQuery) then + do + rc = 0; + if (\CfgIsConfigured(j)) then + return 3; + end + else + do + if (\fOptional) then + rc = CfgInstallUninstall(j, fRM); + else if (CfgIsConfigured(j)) then + rc = CfgInstallUninstall(j, fRM); + end + leave; + end + end /* loop */ + + if (\fFound) then + do + say 'error: unknown tool! - 'sEnv.i; + call SysSleep 2; + exit(16) + end + end /* otherwise */ + end /* select */ + end /* sEnv.i loop */ + + + /* + * Check for command to execute. + * (I.e. if there are more arguments left. after the dash/star.) + */ + if (i < sEnv.0) then + do + chType = sEnv.i; + + sCmd = ''; + do while (i < sEnv.0) + i = i + 1; + sCmd = sCmd ||' '||sEnv.i; + end + + if (chType = '-') then + do + Address CMD 'start /F' sCMD; + Address CMD 'exit'; + end + else + Address CMD sCMD; + exit(rc); + end + +exit(0); + + +/** + * No value handler + */ +NoValueHandler: + say 'NoValueHandler: line 'SIGL; +exit(16); + + + +/** + * Get the description of an tool. + * @returns Description string. + * '' if not found. + * @param sToolId Tool id. + */ +CfgDesc: procedure expose aCfg. aPath. + parse arg sToolId + do i = 1 to aCfg.0 + if (aCfg.i.sId = sToolId) then + return aCfg.i.sDesc; + end +return sToolId; + + +/** + * Lookups up an env. config in the aCfg. array. + * @return Index of sToolId. + * aCfg.0+1 on error. + * @param sToolId Tool id. + */ +CfgLookup: procedure expose aCfg. aPath. + parse arg sToolId + iTool = 1; + do while ((iTool <= aCfg.0) & (aCfg.iTool.sId <> sToolId)) + iTool = iTool + 1; + end +return iTool; + + +/** + * Verifies a configuration. + * @returns 0 on success. + * 4 on error/warnings which is continuable. + * 8 or higher or on fatal errors. + * @param iTool The tool index in aCfg. + * @param fRM If set we'll uninstall the tool from the environment. + */ +CfgInstallUninstall: procedure expose aCfg. aPath. + parse arg iTool, fRM + + /* make rexx expression */ + if (pos(',', aCfg.iTool.sSet) > 0) then + sRexx = substr(aCfg.iTool.sSet, 1, pos(',', aCfg.iTool.sSet) - 1) || '(aCfg.iTool.sId,sOperation,fRM,fQuiet', + || substr(aCfg.iTool.sSet, pos(',', aCfg.iTool.sSet)) || ')'; + else + sRexx = aCfg.iTool.sSet || '(aCfg.iTool.sId,sOperation,fRM,fQuiet)'; + fQuiet = 0; + if (\fRM) then sOperation = 'install'; + else sOperation = 'uninstall'; + + /* call the tool procedure with a verify operation. */ + interpret 'iRc = '||sRexx; + + /* On failure we'll complain and quietly uninstall the tool. */ + if (iRc <> 0) then + do + /* complain */ + if (\fQuiet) then + do + select + when (iRc = 1) then + say 'error - 'aCfg.iTool.sId': 'sOperation' not configured - ie. no path.'; + when (iRc = 2) then + say 'error - 'aCfg.iTool.sId': 'sOperation' failed ''cause some vital file/dir wasn''t found.'; + when (iRc = 49) then + say 'error - 'aCfg.iTool.sId': 'sOperation' failed ''cause some vital command didn''t return as expected.'; + when (iRc = 99) then + say 'error - 'aCfg.iTool.sId': 'sOperation' failed ''cause some vital command didn''t return the expected output.'; + otherwise + say 'internal error- 'aCfg.iTool.sId': bad return code from '''sRexx''' rc=' iRc'.'; + end + end + + /* uninstall silently */ + fRM = 1; + fQuiet = 1; + sOperation = 'quietuninstall'; + interpret 'rcignore = '||sRexx; + end +return iRc; + + + + +/** + * Configures an tool. + * @returns 0 on success. + * 4 on error/warnings which is continuable. + * 8 or higher or on fatal errors. + * @param iTool The tool configuration to configure. + * @param fForced If set, we'll force a reconfiguration of the tool. + */ +CfgConfigure: procedure expose aCfg. aPath. + parse arg iTool, fForced + + /* + * First verfiy the configuration quietly, we don't have to do anything if it's ok. + */ + if (\fForced & (CfgVerify(iTool, 1, 1) = 0)) then + return 0; + + /* + * We have to configure it! + */ + say '- Config of the 'aCfg.iTool.sId' ('CfgDesc(aCfg.iTool.sId)') tool.'; + + /* make rexx expression */ + if (pos(',', aCfg.iTool.sSet) > 0) then + sRexx = substr(aCfg.iTool.sSet, 1, pos(',', aCfg.iTool.sSet) - 1) || '(aCfg.iTool.sId,sOperation,fRM,fQuiet', + || substr(aCfg.iTool.sSet, pos(',', aCfg.iTool.sSet)) || ')'; + else + sRexx = aCfg.iTool.sSet || '(aCfg.iTool.sId,sOperation,fRM,fQuiet)'; + if (fForced) then sOperation = 'forcedconfig'; + else sOperation = 'config'; + fRM = 0; + fQuiet = 0; + + + /* + * Loop till rc=0 or user gives up. + */ + rc = -1 + do while (rc <> 0) + /* configure */ + interpret 'rc = '||sRexx; + + if (rc <> 0) then do + say 'warning: The user refused to give a path, continuing.'; + return 4; + end + + /* verifying */ + rc = CfgVerify(iTool, 0, 1); + sOperation = 'verify'; + if (rc = 0) then + leave; + + /* Retry the config if the user wanna do so. */ + say '' + say 'Retry configuring the tool' aCfg.iTool.sId '('CfgDesc(aCfg.iTool.sId)')? (y/N)'; + sAnswer = PullUser(1); + if (substr(strip(sAnswer),1,1) <> 'Y') then + return 4; + sOperation = 'forcedconfig'; + end + + /* + * Write path file and return successfully. + */ + call PathWrite; +return 0; + + +/** + * Verifies a configuration. + * @returns Return code from the environment procedure. + * @param iTool The tool index in aCfg. + * @param fQuiet If set we'll to a quiet verify. + * @param fCleanup If set we'll clean properly. + */ +CfgVerify: procedure expose aCfg. aPath. + parse arg iTool, fQuiet, fCleanup + + /* make rexx expression */ + if (pos(',', aCfg.iTool.sSet) > 0) then + sRexx = substr(aCfg.iTool.sSet, 1, pos(',', aCfg.iTool.sSet) - 1) || '(aCfg.iTool.sId,sOperation,fRM,fQuiet', + || substr(aCfg.iTool.sSet, pos(',', aCfg.iTool.sSet)) || ')'; + else + sRexx = aCfg.iTool.sSet || '(aCfg.iTool.sId,sOperation,fRM,fQuiet)'; + if (fQuiet) then sOperation = 'quietverify'; + else sOperation = 'verify'; + fRM = 0; + + /* call the tool procedure with a verify operation. */ + interpret 'iRc = '||sRexx; + + /* On failure we'll complain and quietly uninstall the tool. */ + if (iRc <> 0) then + do + /* complain */ + if (\fQuiet) then + do + select + when (iRc = 1) then + say 'warning - 'aCfg.iTool.sId': The user refused to give a path, continuing.'; + when (iRc = 2) then + say 'error - 'aCfg.iTool.sId': verify failed ''cause some vital file/dir wasn''t found.'; + when (iRc = 49) then + say 'error - 'aCfg.iTool.sId': verify failed ''cause some vital command didn''t return as expected.'; + when (iRc = 99) then + say 'error - 'aCfg.iTool.sId': verify failed ''cause some vital command didn''t return the expected output.'; + otherwise + say 'internal error- 'aCfg.iTool.sId': bad return code from '''sRexx''' iRc=' iRc'.'; + end + end + fCleanup = 1; + end + + /* uninstall */ + if (fCleanup) then + do + fRM = 1; + fQuiet = 1; + sOperation = 'quietuninstall'; + interpret 'rcignore = '||sRexx; + end +return iRc; + + +/** + * Verifies a configuration. + * @returns True if configured. + * False if not configured. + * @param iTool The tool index in aCfg. + * @param fQuiet If set we'll to a quiet verify. + */ +CfgIsConfigured: procedure expose aCfg. aPath. + parse arg iTool + + /* make rexx expression */ + if (pos(',', aCfg.iTool.sSet) > 0) then + sRexx = substr(aCfg.iTool.sSet, 1, pos(',', aCfg.iTool.sSet) - 1) || '(aCfg.iTool.sId,''quietisconfig'',0,1', + || substr(aCfg.iTool.sSet, pos(',', aCfg.iTool.sSet)) || ')'; + else + sRexx = aCfg.iTool.sSet || '(aCfg.iTool.sId,''quietisconfig'',0,1)'; + interpret 'iRc = '||sRexx; +return (iRc = 0); + + + +/** + * Checks if a file exists. + * @param sFile Name of the file to look for. + * @param fQuiet Flag which tells whether to be quiet or not. + * @param fOptional Flag to say that this file is optional. + * @returns TRUE if file exists. + * FALSE if file doesn't exists. + */ +CfgVerifyFile: procedure expose aCfg. aPath. + parse arg sFile, fQuiet, fOptional + if (fOptional = '') then fOptional = 0; + rc = stream(sFile, 'c', 'query exist'); + if ((rc = '') & \fQuiet) then + do + if (fOptional) then + say 'Warning: Installation is missing '''sFile'''.'; + else + say 'Verify existance of '''sFile''' failed.'; + end +return rc <> '' | fOptional; + + +/** + * Checks if a directory exists. + * @param sDir Name of the dir to look for. + * @param fQuiet Flag which tells whether to be quiet or not. + * @returns TRUE if file exists. + * FALSE if file doesn't exists. + */ +CfgVerifyDir: procedure expose aCfg. aPath. + parse arg sDir, fQuiet + rc = SysFileTree(sDir, 'sDirs', 'DO'); + if (rc = 0 & sDirs.0 = 1) then + return 1; + if (\fQuiet) then + say 'Verify existance of '''sDir''' failed.'; +return 0; + + + + + +/** + * The Directory Configuration Function. + * + * @returns Lower cased, absolute, backward slashed, path to program. + * @param sPathId Program identifier. (lowercase!) + */ +PathQuery: procedure expose aCfg. aPath. + parse arg sPathId, sToolId, sOperation, fOptional + + if (fOptional = '') then + fOptional = 0; + + if (aPath.0 = 0) then + do /* + * Read path config file + */ + call PathRead; + + /* + * If no data found fill in defaults (if known host). + */ + if (aPath.0 = 0) then + do + call PathSetDefault; + call PathWrite; + end + end + + /* + * Check for forced config. + */ + if (sOperation = 'forcedconfig') then + call PathRemove sPathId; + else + do + /* + * Search for the path. + */ + do i = 1 to aPath.0 + if (aPath.i.sPId = sPathId) then + do + return aPath.i.sPath; + leave; + end + end + end + + /* + * Path wasn't found! + */ + + /* for quiet verify, configured test and uninstall, fail sliently. */ + if ((sOperation = 'quietisconfig') | (sOperation = 'quietverify') | (sOperation = 'quietuninstall')) then + return ''; + + /* if configure operation the configure it. */ + if (pos('config', sOperation) > 0) then + return PathConfig(sOperation, sPathId, sToolId); + + /* elsewise this is an fatal error */ + if (\fOptional) then + do + say 'Fatal error: Path information for '''sPathId''' was not found.'; + call SysSleep 5; + exit(16); + end + +return ''; + + +/** + * Determins the full name of the path file to use. + * @returns Path to the pathfile to use. The file may not exist. + */ +PathGetFile: procedure + + /* + * Project Specific? + */ + parse source . . sPathFile . + sPathFile = sPathFile||'.paths'; + if (FileExists(sPathFile)) then + return sPathFile; + + /* + * ETC? + */ + sEtc = EnvGet('ETC'); + if (sEtc <> '') then + return sEtc||'\BuildEnv.cfg'; +return sPathFile; + + +/** + * Reads the path file into the 'aPath.' stem. + */ +PathRead: procedure expose aCfg. aPath. + + i = 1; /* Path index */ + iLine = 0; /* Line # in file */ + + + sPathFile = PathGetFile(); + + /* + * Read loop. + */ + do while (lines(sPathFile) > 0) + iLine = iLine + 1; + sLine = strip(linein(sPathFile)); + + /* + * Skip empty lines and comment lines, ie. starting with '#' or ';'. + */ + if ((sLine <> '') & (substr(sLine, 1, 1) <> '#') & (substr(sLine, 1, 1) <> ';')) then + do + /* + * Parse the line. + */ + parse var sLine aPath.i.sPId '=' aPath.i.sPath + aPath.i.sPId = strip(aPath.i.sPId); + aPath.i.sPath = strip(aPath.i.sPath); + + /* + * Validate the input. + */ + if ((aPath.i.sPath = '') | (aPath.i.sPId = '') | (translate(sLine,'','#!$@%|<>;õ&Ï') <> sLine) ) then + do + say 'fatal error: missformed line in path file at line 'iLine'!' + call stream sPathFile, 'c', 'close'; + call SysSleep 5; + exit(16); + end + i = i + 1; + end + end + call stream sPathFile, 'c', 'close'; + aPath.0 = i - 1; +return 0; + + +/** + * Writes the path file from what's in the 'aPath.' stem. + */ +PathWrite: procedure expose aCfg. aPath. + sPathFile = PathGetFile(); + call SysFileDelete(sPathFile); + do i = 1 to aPath.0 + /* skip if already written */ + j = 1; + do while (aPath.j.sPId <> aPath.i.sPId) + j = j + 1; + end + if (j >= i) then + call lineout sPathFile, aPath.i.sPId'='aPath.i.sPath; + end + call stream sPathFile, 'c', 'close'; +return 0; + + +/** + * Remove a path from the 'aPath.' stem. + * @returns 0 + * @param sPathId The id of the path to remove. + */ +PathRemove: procedure expose aCfg. aPath. + parse arg sPathId + + /* + * Find. + */ + i = 1; + do while (i <= aPath.0) + if (aPath.i.sPId = sPathId) then + leave; + i = i + 1; + end + + /* + * Move. + */ + if (i <= aPath.0) then + do + j = i + 1; + do while (j <= aPath.0) + aPath.i.sPId = aPath.j.sPId; + aPath.i.sPath = aPath.j.sPath; + j = j + 1; + i = i + 1; + end + aPath.0 = aPath.0 - 1; + end +return 0; + + +/** + * Sets a given path. + * @param sPathId Path id. + * @param sNewPath Path. + */ +PathSet: procedure expose aCfg. aPath. +parse arg sPathId, sNewPath + + /* + * Search for the path. + */ + do i = 1 to aPath.0 + if (aPath.i.sPId = sPathId) then + do + aPath.i.sPath = sNewPath; + return 0; + end + end + + /* + * Not found, so add it. + */ + i = aPath.0 + 1; + aPath.i.sPId = sPathId; + aPath.i.sPath = sNewPath; + aPath.0 = i; +return 0; + + + +/** + * Fills 'aPath.' with default settings overwriting anything in the table. + */ +PathSetDefault: procedure expose aCfg. aPath. + i = 1; + + /* + * Bird: home boxes. + */ + if ((translate(EnvGet('HOSTNAME')) = 'UNIVAC') | (translate(EnvGet('HOSTNAME')) = 'ENIAC')) then + do + say 'Info: No or empty path file, using birds defaults.'; + aPath.i.sPId = 'cvs'; aPath.i.sPath = 'f:\cvs\v1.11.2_os2'; i = i + 1; + aPath.i.sPId = 'db2v52'; aPath.i.sPath = 'f:\sqllib52'; i = i + 1; + aPath.i.sPId = 'ddk'; aPath.i.sPath = 'f:\DDK_os2\200204'; i = i + 1; + aPath.i.sPId = 'ddkbase'; aPath.i.sPath = 'f:\DDK_os2\200204\base'; i = i + 1; + aPath.i.sPId = 'ddkvideo'; aPath.i.sPath = 'f:\DDK_os2\200204\video'; i = i + 1; + aPath.i.sPId = 'doxygen'; aPath.i.sPath = 'f:\doxygen\v1.2.11-OS2'; i = i + 1; + aPath.i.sPId = 'emx'; aPath.i.sPath = 'f:\emx'; i = i + 1; + aPath.i.sPId = 'emxpgcc'; aPath.i.sPath = 'f:\GCC\v2.95.3_os2'; i = i + 1; + aPath.i.sPId = 'freetypeemx'; aPath.i.sPath = 'f:\Freetype\v1.3.1-emx\emx'; i = i + 1; + aPath.i.sPId = 'gcc302'; aPath.i.sPath = 'f:\GCC\v3.0.2beta_os2\emx'; i = i + 1; + aPath.i.sPId = 'gcc303'; aPath.i.sPath = 'f:\GCC\v3.0.3beta_os2\emx'; i = i + 1; + aPath.i.sPId = 'gcc321'; aPath.i.sPath = 'f:\GCC\v3.2.1beta_os2\emx'; i = i + 1; + aPath.i.sPId = 'gcc322'; aPath.i.sPath = 'f:\GCC\v3.2.2beta2_os2\usr'; i = i + 1; + aPath.i.sPId = 'home'; aPath.i.sPath = 'e:\user\kso'; i = i + 1; + aPath.i.sPId = 'icatgam'; aPath.i.sPath = 'f:\Icat\v4.0.6rc1_os2'; i = i + 1; + aPath.i.sPId = 'icatgam406rc1'; aPath.i.sPath = 'f:\Icat\v4.0.6rc1_os2'; i = i + 1; + aPath.i.sPId = 'icatpe'; aPath.i.sPath = 'f:\Icat\v4.0.5pe'; i = i + 1; + aPath.i.sPId = 'ida38'; aPath.i.sPath = 'f:\ida\v3.8'; i = i + 1; + aPath.i.sPId = 'ida40'; aPath.i.sPath = 'f:\ida\v4.0.1'; i = i + 1; + aPath.i.sPId = 'ida414'; aPath.i.sPath = 'f:\ida\v4.1.4'; i = i + 1; + aPath.i.sPId = 'idasdk'; aPath.i.sPath = 'f:\idasdk'; i = i + 1; + aPath.i.sPId = 'java131'; aPath.i.sPath = 'e:\java131'; i = i + 1; + aPath.i.sPId = 'jpeg'; aPath.i.sPath = 'f:\jpeg\v6b'; i = i + 1; + aPath.i.sPId = 'mscv6-16'; aPath.i.sPath = 'f:\msc\v6.0a_ibm'; i = i + 1; + aPath.i.sPId = 'mscv7-16'; aPath.i.sPath = 'f:\msc\v7.0'; i = i + 1; + aPath.i.sPId = 'mysql'; aPath.i.sPath = 'f:\mysql2'; i = i + 1; + aPath.i.sPId = 'nasm9833'; aPath.i.sPath = 'f:\nasm\v0.98.33_os2'; i = i + 1; + aPath.i.sPId = 'netqos2'; aPath.i.sPath = 'f:\netqos2'; i = i + 1; + aPath.i.sPId = 'perl50xxx'; aPath.i.sPath = 'f:\perl\v5.005_53_os2'; i = i + 1; + aPath.i.sPId = 'perl580'; aPath.i.sPath = 'f:\perl\v5.8.0_os2'; i = i + 1; + aPath.i.sPId = 'python'; aPath.i.sPath = 'f:\python\v1.5.2_os2'; i = i + 1; + aPath.i.sPId = 'svn'; aPath.i.sPath = 'f:\subversion\v1.0.6_os2'; i = i + 1; + aPath.i.sPId = 'toolkit40'; aPath.i.sPath = 'f:\toolkit\v4.0csd4'; i = i + 1; + aPath.i.sPId = 'toolkit45'; aPath.i.sPath = 'f:\toolkit\v4.5'; i = i + 1; + aPath.i.sPId = 'toolkit451'; aPath.i.sPath = 'f:\toolkit\v4.51'; i = i + 1; + aPath.i.sPId = 'toolkit452'; aPath.i.sPath = 'f:\toolkit\v4.52'; i = i + 1; + aPath.i.sPId = 'unixroot'; aPath.i.sPath = 'e:\unix'; i = i + 1; + aPath.i.sPId = 'vac308'; aPath.i.sPath = 'f:\VACpp\v3.08_os2'; i = i + 1; + aPath.i.sPId = 'vac365'; aPath.i.sPath = 'f:\VACpp\v3.65_os2'; i = i + 1; + aPath.i.sPId = 'vac40'; aPath.i.sPath = 'f:\VACpp\v4.0_os2'; i = i + 1; + aPath.i.sPId = 'warpin'; aPath.i.sPath = 'f:\WarpIn\current'; i = i + 1; + aPath.i.sPId = 'watcom11'; aPath.i.sPath = 'f:\watcom\v11.0'; i = i + 1; + aPath.i.sPId = 'watcom11c'; aPath.i.sPath = 'f:\watcom\v11.0c'; i = i + 1; + aPath.i.sPId = 'xfree86'; aPath.i.sPath = 'e:\xfree86'; i = i + 1; + aPath.i.sPId = 'testcase_drive_unused'; aPath.i.sPath = 'l'; /* reqired */ i = i + 1; + aPath.i.sPId = 'testcase_drive_fixed'; aPath.i.sPath = 'c'; /* reqired */ i = i + 1; + aPath.i.sPId = 'testcase_drive_floppy'; aPath.i.sPath = 'a'; /* reqired */ i = i + 1; + aPath.i.sPId = 'testcase_drive_cdrom'; aPath.i.sPath = 'i'; /* optional */ i = i + 1; + aPath.i.sPId = 'testcase_drive_network'; aPath.i.sPath = 'y'; /* optional */ i = i + 1; + aPath.i.sPId = 'testcase_drive_ramdisk'; aPath.i.sPath = 'r'; /* optional */ i = i + 1; + /*aPath.i.sPId = ''; aPath.i.sPath = i = i + 1;*/ + end + + + /* + * Bird: laptop box. + */ + if (translate(EnvGet('HOSTNAME')) = 'DELIRIUM') then + do + say 'Info: No or empty path file, using birds work defaults.'; + aPath.i.sPId = 'cvs'; aPath.i.sPath = 'e:\dev\cvs\v11.1'; i = i + 1; + aPath.i.sPId = 'emx'; aPath.i.sPath = 'e:\emx'; i = i + 1; + aPath.i.sPId = 'emxpgcc'; aPath.i.sPath = 'e:\dev\emxpgcc\v2.95.2'; i = i + 1; + aPath.i.sPId = 'gcc303'; aPath.i.sPath = 'e:\dev\gcc\v3.0.3\emx'; i = i + 1; + aPath.i.sPId = 'gcc321'; aPath.i.sPath = 'e:\dev\gcc\v3.2.1\emx'; i = i + 1; + /*aPath.i.sPId = 'db2v52'; aPath.i.sPath = 'e:\sqllib52'; i = i + 1; + aPath.i.sPId = 'icatgam'; aPath.i.sPath = 'e:\icatos2'; i = i + 1; + aPath.i.sPId = 'icatgam406rc1'; aPath.i.sPath = 'e:\icatos2.4.0.6.rc1'; i = i + 1; + aPath.i.sPId = 'icatpe'; aPath.i.sPath = 'e:\icatpe'; i = i + 1; + aPath.i.sPId = 'ida38'; aPath.i.sPath = 'e:\ida38'; i = i + 1; + aPath.i.sPId = 'ida40'; aPath.i.sPath = 'e:\ida401'; i = i + 1; */ + aPath.i.sPId = 'ida414'; aPath.i.sPath = 'e:\dev\ida\v414'; i = i + 1; + /*aPath.i.sPId = 'idasdk'; aPath.i.sPath = 'e:\idasdk'; i = i + 1; */ + aPath.i.sPId = 'ddk'; aPath.i.sPath = 'e:\dev\ddk\june02'; i = i + 1; + aPath.i.sPId = 'ddkbase'; aPath.i.sPath = 'e:\dev\ddk\june02\base'; i = i + 1; + aPath.i.sPId = 'ddkvideo'; aPath.i.sPath = 'e:\dev\ddk\june02\video'; i = i + 1; + aPath.i.sPId = 'home'; aPath.i.sPath = 'e:\home'; i = i + 1; + aPath.i.sPId = 'mscv6-16'; aPath.i.sPath = 'e:\dev\ddktools\toolkits\msc60'; i = i + 1; + /*aPath.i.sPId = 'mscv7-16'; aPath.i.sPath = 'e:\msc\v7.0'; i = i + 1; + aPath.i.sPId = 'mysql'; aPath.i.sPath = 'e:\mysql2'; i = i + 1; + aPath.i.sPId = 'netqos2'; aPath.i.sPath = 'e:\netqos2'; i = i + 1; + aPath.i.sPId = 'perl50xxx'; aPath.i.sPath = 'e:\perllib'; i = i + 1; + aPath.i.sPId = 'perl580'; aPath.i.sPath = 'e:\dev\perl\v5.8.0'; i = i + 1; + aPath.i.sPId = 'python'; aPath.i.sPath = 'e:\python'; i = i + 1; + aPath.i.sPId = 'toolkit40'; aPath.i.sPath = 'e:\toolkit'; i = i + 1; + aPath.i.sPId = 'toolkit45'; aPath.i.sPath = 'e:\toolkit45'; i = i + 1; + aPath.i.sPId = 'toolkit451'; aPath.i.sPath = 'e:\toolkit451'; i = i + 1; */ + aPath.i.sPId = 'toolkit452'; aPath.i.sPath = 'e:\dev\toolkit\v452'; i = i + 1; + aPath.i.sPId = 'unixroot'; aPath.i.sPath = 'e:\unix'; i = i + 1; + aPath.i.sPId = 'xfree86'; aPath.i.sPath = 'e:\xfree86'; i = i + 1; + aPath.i.sPId = 'vac308'; aPath.i.sPath = 'e:\dev\vacpp\v308'; i = i + 1; + aPath.i.sPId = 'vac365'; aPath.i.sPath = 'e:\dev\vacpp\v365'; i = i + 1; + /*aPath.i.sPId = 'vac40'; aPath.i.sPath = 'e:\ibmcpp40'; i = i + 1;*/ + aPath.i.sPId = 'warpin'; aPath.i.sPath = 'e:\warpin'; i = i + 1; + /*aPath.i.sPId = 'watcom11'; aPath.i.sPath = 'e:\watcom'; i = i + 1;*/ +/* aPath.i.sPId = 'watcom11c'; aPath.i.sPath = 'e:\dev\watcom\v11c'; i = i + 1; */ + aPath.i.sPId = 'testcase_drive_unused'; aPath.i.sPath = 't'; /* reqired */ i = i + 1; + aPath.i.sPId = 'testcase_drive_fixed'; aPath.i.sPath = 'd'; /* reqired */ i = i + 1; + aPath.i.sPId = 'testcase_drive_floppy'; aPath.i.sPath = 'a'; /* reqired */ i = i + 1; + aPath.i.sPId = 'testcase_drive_cdrom'; aPath.i.sPath = 'f'; /* optional */ i = i + 1; + aPath.i.sPId = 'testcase_drive_network'; aPath.i.sPath = 'x'; /* optional */ i = i + 1; + /*aPath.i.sPId = 'testcase_drive_ramdisk'; aPath.i.sPath = ''; /* optional */ i = i + 1;*/ + /*aPath.i.sPId = ''; aPath.i.sPath = i = i + 1;*/ + end + + + /* + * Bird: work boxes. + */ + if ((translate(EnvGet('HOSTNAME')) = 'DREAM') | (translate(EnvGet('HOSTNAME')) = 'DESPAIR')) then + do + say 'Info: No or empty path file, using birds work defaults.'; + aPath.i.sPId = 'cvs'; aPath.i.sPath = 'd:\dev\cvs\v11.1'; i = i + 1; + aPath.i.sPId = 'emx'; aPath.i.sPath = 'd:\emx'; i = i + 1; + aPath.i.sPId = 'emxpgcc'; aPath.i.sPath = 'd:\dev\emxpgcc\v2.95.2'; i = i + 1; + aPath.i.sPId = 'gcc303'; aPath.i.sPath = 'd:\dev\gcc\v3.0.3\emx'; i = i + 1; + aPath.i.sPId = 'gcc321'; aPath.i.sPath = 'd:\dev\gcc\v3.2.1\emx'; i = i + 1; + /*aPath.i.sPId = 'db2v52'; aPath.i.sPath = 'e:\sqllib52'; i = i + 1; + aPath.i.sPId = 'icatgam'; aPath.i.sPath = 'e:\icatos2'; i = i + 1; + aPath.i.sPId = 'icatgam406rc1'; aPath.i.sPath = 'e:\icatos2.4.0.6.rc1'; i = i + 1; + aPath.i.sPId = 'icatpe'; aPath.i.sPath = 'e:\icatpe'; i = i + 1; + aPath.i.sPId = 'ida38'; aPath.i.sPath = 'e:\ida38'; i = i + 1; + aPath.i.sPId = 'ida40'; aPath.i.sPath = 'e:\ida401'; i = i + 1; */ + aPath.i.sPId = 'ida414'; aPath.i.sPath = 'd:\dev\ida\v414'; i = i + 1; + /*aPath.i.sPId = 'idasdk'; aPath.i.sPath = 'e:\idasdk'; i = i + 1; */ + aPath.i.sPId = 'java131'; aPath.i.sPath = 'd:\java131'; i = i + 1; + aPath.i.sPId = 'ddk'; aPath.i.sPath = 'd:\dev\ddk\june02'; i = i + 1; + aPath.i.sPId = 'ddkbase'; aPath.i.sPath = 'd:\dev\ddk\june02\base'; i = i + 1; + aPath.i.sPId = 'ddkvideo'; aPath.i.sPath = 'd:\dev\ddk\june02\video'; i = i + 1; + aPath.i.sPId = 'home'; aPath.i.sPath = 'd:\home\bird'; i = i + 1; + aPath.i.sPId = 'mscv6-16'; aPath.i.sPath = 'd:\dev\ddktools\toolkits\msc60'; i = i + 1; + aPath.i.sPId = 'mscv7-16'; aPath.i.sPath = 'd:\dev\msc\v7.0'; i = i + 1; + aPath.i.sPId = 'mysql'; aPath.i.sPath = 'd:\apps\mysql\v3.23.50b1'; i = i + 1; + /*aPath.i.sPId = 'netqos2'; aPath.i.sPath = 'e:\netqos2'; i = i + 1;*/ + aPath.i.sPId = 'perl50xxx'; aPath.i.sPath = 'd:\dev\perl\v5.00455'; i = i + 1; + aPath.i.sPId = 'perl580'; aPath.i.sPath = 'd:\dev\perl\v5.8.0'; i = i + 1; + /*aPath.i.sPId = 'python'; aPath.i.sPath = 'e:\python'; i = i + 1;*/ + aPath.i.sPId = 'svn'; aPath.i.sPath = 'd:\dev\subversion\v1.0.6'; i = i + 1; + aPath.i.sPId = 'toolkit40'; aPath.i.sPath = 'd:\dev\toolkit\v40csd1'; i = i + 1; + /*aPath.i.sPId = 'toolkit45'; aPath.i.sPath = 'e:\toolkit45'; i = i + 1; + aPath.i.sPId = 'toolkit451'; aPath.i.sPath = 'e:\toolkit451'; i = i + 1; */ + aPath.i.sPId = 'toolkit452'; aPath.i.sPath = 'd:\dev\toolkit\v452'; i = i + 1; + aPath.i.sPId = 'unixroot'; aPath.i.sPath = 'd:\unix'; i = i + 1; + aPath.i.sPId = 'xfree86'; aPath.i.sPath = 'd:\xfree86'; i = i + 1; + aPath.i.sPId = 'vac308'; aPath.i.sPath = 'd:\dev\VACpp\v308'; i = i + 1; + aPath.i.sPId = 'vac365'; aPath.i.sPath = 'd:\dev\VACpp\v365'; i = i + 1; + aPath.i.sPId = 'vac40'; aPath.i.sPath = 'd:\dev\VACpp\v40ga'; i = i + 1; + aPath.i.sPId = 'warpin'; aPath.i.sPath = 'c:\warpin'; i = i + 1; + aPath.i.sPId = 'watcom11'; aPath.i.sPath = 'd:\dev\watcom\v110'; i = i + 1; + aPath.i.sPId = 'watcom11c'; aPath.i.sPath = 'd:\dev\watcom\v110c'; i = i + 1; + aPath.i.sPId = 'testcase_drive_unused'; aPath.i.sPath = 't'; /* reqired */ i = i + 1; + aPath.i.sPId = 'testcase_drive_fixed'; aPath.i.sPath = 'f'; /* reqired */ i = i + 1; + aPath.i.sPId = 'testcase_drive_floppy'; aPath.i.sPath = 'a'; /* reqired */ i = i + 1; + aPath.i.sPId = 'testcase_drive_cdrom'; aPath.i.sPath = 'g'; /* optional */ i = i + 1; + aPath.i.sPId = 'testcase_drive_network'; aPath.i.sPath = 'x'; /* optional */ i = i + 1; + aPath.i.sPId = 'testcase_drive_ramdisk'; aPath.i.sPath = 'r'; /* optional */ i = i + 1; + /*aPath.i.sPId = ''; aPath.i.sPath = i = i + 1;*/ + end + + /* add your own stuff here.. */ + aPath.0 = i - 1; +return 0; + + +/** + * Configure a path. + * @returns Path on success. + * '' on failure. + * @param sOperation The operation - 'config' or 'forcedconfig' + * @param sPathId The path to configure. + * @param sToolId The tool Id. + */ +PathConfig: procedure expose aCfg. aPath. + parse arg sOperation, sPathId, sToolId + + /* + * If not forced we'll ask first. + */ + if (sOperation <> 'forcedconfig') then + do + say 'Do you want to configure the path '''sPathId''/* for the '''sToolId'''('CfgDesc(sToolId)') tool?*/ '(y/N)'; + sAnswer = PullUser(1); + if (substr(strip(sAnswer),1,1) <> 'Y') then + return ''; + end + + /* + * Config loop. + */ + do i = 1 to 128 + + say 'Give us the path for '''sPathId'''('''sToolId'''/'CfgDesc(sToolId)'):' + sThePath = translate(strip(strip(strip(PullUser()), 'T','\'),'T','/'), '\', '/'); + /*say 'Debug: sThePath='sThePath;*/ + if ((sThePath <> '') & (sThePath = translate(sThePath,'','#!$@%|<>;õ&Ï='))) then + do + /* + * Add it to internal struct. + */ + call PathRemove(sPathId); + j = aPath.0 + 1; + aPath.j.sPId = strip(sPathId); + aPath.j.sPath = translate(strip(strip(strip(sThePath), 'T','\'),'T','/'), '\', '/'); + aPath.0 = j; + return sThePath; + end + else + say 'error: invalid path name.'; + say 'Debug 9' + + /* ask if retry */ + if (i >= 2) then + say 'You''re not trying hard, are you?'; + say 'Wanna try giving us an *valid* path for the path '''sPathId''' for the '''sToolId'''('CfgDesc(sToolId)') tool? (y/N)'; + sAnswer = PullUser(1); + if (substr(strip(sAnswer),1,1) <> 'Y') then + leave; + end + + say 'Giving up!'; +return ''; + + +/** + * Get user response and empties the input queue. + * @returns User input. + * @param fUpper If present and set uppercase the user response. + */ +PullUser: procedure + parse arg fUpper + if (fUpper = '') then + fUpper = 0; + + signal on halt name PullUser_Handler + signal on syntax name PullUser_Handler + signal on notready name PullUser_Handler + parse pull sAnswer; + signal off syntax + signal off halt + signal off notready + /*say 'Debug: sAnswer='c2x(sAnswer); + sAnswer = strip(strip(sAnswer, 'T', '0A'x), 'T', '0D'x);*/ + + if (fUpper) then + sAnswer = translate(sAnswer); + /* flush input */ + do while (Queued()) + pull dummy; + end +return sAnswer; + + +/** + * No value handler + */ +PullUser_Handler: + say 'fatal error: Believe Ctrl-Break/C might have been pressed.'; + signal off syntax + signal off halt + signal off syntax + signal off notready + do while (Queued()) + pull dummy; + end +exit(16); + + +/** + * Checks if a file exists. + * @param sFile Name of the file to look for. + * @param sComplain Complaint text. Complain if non empty and not found. + * @returns TRUE if file exists. + * FALSE if file doesn't exists. + */ +FileExists: procedure + parse arg sFile, sComplain + rc = stream(sFile, 'c', 'query exist'); + if ((rc = '') & (sComplain <> '')) then + say sComplain ''''sFile'''.'; +return rc <> ''; + + +/** + * Checks if a directory exists. + * @param sDir Name of the directory to look for. + * @param sComplain Complaint text. Complain if non empty and not found. + * @returns TRUE if file exists. + * FALSE if file doesn't exists. + */ +DirExists: procedure + parse arg sDir, sComplain + rc = SysFileTree(sDir, 'sDirs', 'DO'); + if (rc = 0 & sDirs.0 = 1) then + return 1; + if (sComplain <> '') then do + say sComplain ''''sDir'''.'; +return 0; + + +/** + * Add sToAdd in front of sEnvVar. + * Note: sToAdd now is allowed to be alist! + * + * Known features: Don't remove sToAdd from original value if sToAdd + * is at the end and don't end with a ';'. + */ +EnvAddFront: procedure + parse arg fRM, sEnvVar, sToAdd, sSeparator + + /* sets default separator if not specified. */ + if (sSeparator = '') then sSeparator = ';'; + + /* checks that sToAdd ends with an ';'. Adds one if not. */ + if (substr(sToAdd, length(sToAdd), 1) <> sSeparator) then + sToAdd = sToAdd || sSeparator; + + /* check and evt. remove ';' at start of sToAdd */ + if (substr(sToAdd, 1, 1) = ';') then + sToAdd = substr(sToAdd, 2); + + /* loop thru sToAdd */ + rc = 0; + i = length(sToAdd); + do while i > 1 & rc = 0 + j = lastpos(sSeparator, sToAdd, i-1); + rc = EnvAddFront2(fRM, sEnvVar, substr(sToAdd, j+1, i - j), sSeparator); + i = j; + end + +return rc; + +/** + * Add sToAdd in front of sEnvVar. + * + * Known features: Don't remove sToAdd from original value if sToAdd + * is at the end and don't end with a ';'. + */ +EnvAddFront2: procedure + parse arg fRM, sEnvVar, sToAdd, sSeparator + + /* sets default separator if not specified. */ + if (sSeparator = '') then sSeparator = ';'; + + /* checks that sToAdd ends with a separator. Adds one if not. */ + if (substr(sToAdd, length(sToAdd), 1) <> sSeparator) then + sToAdd = sToAdd || sSeparator; + + /* check and evt. remove the separator at start of sToAdd */ + if (substr(sToAdd, 1, 1) = sSeparator) then + sToAdd = substr(sToAdd, 2); + + /* Get original variable value */ + sOrgEnvVar = EnvGet(sEnvVar); + + /* Remove previously sToAdd if exists. (Changing sOrgEnvVar). */ + i = pos(translate(sToAdd), translate(sOrgEnvVar)); + if (i > 0) then + sOrgEnvVar = substr(sOrgEnvVar, 1, i-1) || substr(sOrgEnvVar, i + length(sToAdd)); + + /* set environment */ + if (fRM) then + return EnvSet(0, sEnvVar, sOrgEnvVar); +return EnvSet(0, sEnvVar, sToAdd||sOrgEnvVar); + + +/** + * Add sToAdd as the end of sEnvVar. + * Note: sToAdd now is allowed to be alist! + * + * Known features: Don't remove sToAdd from original value if sToAdd + * is at the end and don't end with a ';'. + */ +EnvAddEnd: procedure + parse arg fRM, sEnvVar, sToAdd, sSeparator + + /* sets default separator if not specified. */ + if (sSeparator = '') then sSeparator = ';'; + + /* checks that sToAdd ends with a separator. Adds one if not. */ + if (substr(sToAdd, length(sToAdd), 1) <> sSeparator) then + sToAdd = sToAdd || sSeparator; + + /* check and evt. remove ';' at start of sToAdd */ + if (substr(sToAdd, 1, 1) = sSeparator) then + sToAdd = substr(sToAdd, 2); + + /* loop thru sToAdd */ + rc = 0; + i = length(sToAdd); + do while i > 1 & rc = 0 + j = lastpos(sSeparator, sToAdd, i-1); + rc = EnvAddEnd2(fRM, sEnvVar, substr(sToAdd, j+1, i - j), sSeparator); + i = j; + end + +return rc; + +/** + * Add sToAdd as the end of sEnvVar. + * + * Known features: Don't remove sToAdd from original value if sToAdd + * is at the end and don't end with a ';'. + */ +EnvAddEnd2: procedure + parse arg fRM, sEnvVar, sToAdd, sSeparator + + /* sets default separator if not specified. */ + if (sSeparator = '') then sSeparator = ';'; + + /* checks that sToAdd ends with a separator. Adds one if not. */ + if (substr(sToAdd, length(sToAdd), 1) <> sSeparator) then + sToAdd = sToAdd || sSeparator; + + /* check and evt. remove separator at start of sToAdd */ + if (substr(sToAdd, 1, 1) = sSeparator) then + sToAdd = substr(sToAdd, 2); + + /* Get original variable value */ + sOrgEnvVar = EnvGet(sEnvVar); + + if (sOrgEnvVar <> '') then + do + /* Remove previously sToAdd if exists. (Changing sOrgEnvVar). */ + i = pos(translate(sToAdd), translate(sOrgEnvVar)); + if (i > 0) then + sOrgEnvVar = substr(sOrgEnvVar, 1, i-1) || substr(sOrgEnvVar, i + length(sToAdd)); + + /* checks that sOrgEnvVar ends with a separator. Adds one if not. */ + if (sOrgEnvVar = '') then + if (right(sOrgEnvVar,1) <> sSeparator) then + sOrgEnvVar = sOrgEnvVar || sSeparator; + end + + /* set environment */ + if (fRM) then return EnvSet(0, sEnvVar, sOrgEnvVar); +return EnvSet(0, sEnvVar, sOrgEnvVar||sToAdd); + + +/** + * Sets sEnvVar to sValue. + */ +EnvSet: procedure + parse arg fRM, sEnvVar, sValue + + /* if we're to remove this, make valuestring empty! */ + if (fRM) then + sValue = ''; + sEnvVar = translate(sEnvVar); + + /* + * Begin/EndLibpath fix: + * We'll have to set internal these using both commandline 'SET' + * and internal VALUE in order to export it and to be able to + * get it (with EnvGet) again. + */ + if ((sEnvVar = 'BEGINLIBPATH') | (sEnvVar = 'ENDLIBPATH')) then + do + if (length(sValue) >= 1024) then + say 'Warning: 'sEnvVar' is too long,' length(sValue)' char.'; + return SysSetExtLibPath(sValue, substr(sEnvVar, 1, 1)); + end + + if (length(sValue) >= 1024) then + do + say 'Warning: 'sEnvVar' is too long,' length(sValue)' char.'; + say ' This may make CMD.EXE unstable after a SET operation to print the environment.'; + end + sRc = VALUE(sEnvVar, sValue, 'OS2ENVIRONMENT'); +return 0; + +/** + * Gets the value of sEnvVar. + */ +EnvGet: procedure + parse arg sEnvVar + if ((translate(sEnvVar) = 'BEGINLIBPATH') | (translate(sEnvVar) = 'ENDLIBPATH')) then + return SysQueryExtLibPath(substr(sEnvVar, 1, 1)); +return value(sEnvVar,, 'OS2ENVIRONMENT'); + + +/** + * Workaround for bug in CMD.EXE. + * It messes up when REXX have expanded the environment. + */ +FixCMDEnv: procedure + /* check for 4OS2 first */ + Address CMD 'set 4os2test_env=%@eval[2 + 2]'; + if (value('4os2test_env',, 'OS2ENVIRONMENT') = '4') then + return 0; + + /* force environment expansion by setting a lot of variables and freeing them. */ + do i = 1 to 100 + Address CMD '@set dummyenvvar'||i'=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'; + end + do i = 1 to 100 + Address CMD '@set dummyenvvar'||i'='; + end +return 0; + + +/** + * Execute a command and match output and return code. + * + * @returns 0 on match. + * 49 on return code mismatch. + * 99 on output mistmatch. + * @param sCmd The command to execute. + * @param rcCmdExepcted The expected return code from the command. + * @param sOutputPartExpected A 'needle' of the output 'haystack'. + */ +CheckCmdOutput: procedure + parse arg sCmd, rcCmdExpected, fQuiet, sOutputPartExpected + + /* + * Try execute the command + */ + queTmp = RxQueue('Create'); + queOld = RxQueue('Set', queTmp); + Address CMD sCmd || ' 2>&1 | RxQueue' queTmp; + rcCmd = rc; + + /* get output */ + sOutput = ''; + do while (queued() > 0) + parse pull sLine + sOutput = sOutput || sLine || '0d0a'x + end + call RxQueue 'Delete', RxQueue('Set', queOld); + + /* + * If command + */ + rc = 0; + if (/*rcCmd = rcCmdExpected*/ 1) then /* doesn't work with cmd.exe */ + do + if (pos(sOutputPartExpected, sOutput) <= 0) then + do + say 'Debug - start' + say 'Debug:' sOutputPartExpected + say 'Debug: not found in:' + say sOutput + say 'Debug - end' + rc = 99 + end + end + else + rc = 49 + + if (\fQuiet & rc <> 0) then + say 'Debug:' sCmd 'rc='rc' rcCmd='rcCmd 'rcCmdExpected='rcCmdExpected; +return rc; + + +/** + * Checks syslevel info. + * @returns 0 if match. + * <>0 if mismatch. + * @param sFile Name of the syslevel file. + * @param fQuiet Quiet / verbose flag. + * @param sMatchCid Component id. (optional) + * @param sMatchVer Version id. (optional) + * @param sMatchLevel Current Level. (optional) + * @param sMatchTitle Product title. (optional) + * @param sMatchKind Product kind. (optional) + * @param sMatchType Product type. (optional) + */ +CheckSyslevel: procedure +parse arg sFile, fQuiet, sMatchCId,sMatchVer,sMatchLevel,sMatchTitle,iMatchKind,sMatchType,dummy + + iRc = -1; + + /* Open the file */ + rc = stream(sFile, 'c', 'open read'); + if (pos('READY', rc) = 1) then + do + if (charin(sFile, 1, 11) = 'FF'x'FF'x'SYSLEVEL'||'00'x) then + do + /* read base offset (binary long) */ + iBase = c2x(charin(sFile, 34, 4)); + iBase = 1 + x2d(right(iBase,2)||substr(iBase,5,2)||substr(iBase,3,2)||left(iBase,2)); + + /* Read fields... + * + * typedef struct _SYSLEVELDATA { offset + * unsigned char d_reserved1[2]; 0 + * unsigned char d_kind; 2 + * unsigned char d_version[2]; 3 + * unsigned char d_reserved2[2]; 5 + * unsigned char d_clevel[7]; 7 + * unsigned char d_reserved3; 14 + * unsigned char d_plevel[7]; 15 + * unsigned char d_reserved4; 22 + * unsigned char d_title[80]; 23 + * unsigned char d_cid[9]; 103 + * unsigned char d_revision; 112 + * unsigned char d_type[1]; 113 + * } SYSLEVELDATA; + */ + iKind = c2d(charin(sFile, iBase+ 2, 1)); + iVer = charin(sFile, iBase+ 3, 2); + sCurLevel = strip(charin(sFile, iBase+ 7, 7), 'T', '00'x); + sPreLevel = strip(charin(sFile, iBase+ 15, 7), 'T', '00'x); + sTitle = strip(charin(sFile, iBase+ 23, 80), 'T', '00'x); + sCId = charin(sFile, iBase+103, 9); + iRev = charin(sFile, iBase+112, 1); + sType = strip(charin(sFile, iBase+113, 10), 'T', '00'x); + + sVer = substr(c2x(substr(iVer, 1, 1)), 1, 1)||, + '.'||, + substr(c2x(substr(iVer, 1, 1)), 2, 1)||, + d2c(c2d(substr(iVer, 2, 1)) + 48); + if (iRev <> 0) then + sVer = sVer ||'.'|| d2c(c2d(iRev) + 48); + + /* + * Compare. + */ + iRc = 0; + if (sMatchCId <> '' & sMatchCId <> sCid) then + do + if (\fQuiet) then + say 'syslevel '''sFile''': cid '''sCId''' != '''sMatchCId'''.'; + iRc = 2; + end + if (sMatchVer <> '' & sMatchVer <> sVer) then + do + if (\fQuiet) then + say 'syslevel '''sFile''': ver '''sVer''' != '''sMatchVer'''.'; + iRc = 3; + end + if (sMatchLevel <> '' & sMatchLevel <> sCurLevel) then + do + if (\fQuiet) then + say 'syslevel '''sFile''': level '''sCurLevel''' != '''sMatchLevel'''.'; + iRc = 4; + end + if (sMatchTitle <> '' & sMatchTitle <> sTitle) then + do + if (\fQuiet) then + say 'syslevel '''sFile''': title '''sTitle''' != '''sMatchTitle'''.'; + iRc = 5; + end + if (iMatchKind <> '' & iMatchKind <> iKind) then + do + if (\fQuiet) then + say 'syslevel '''sFile''': kind '''iKind''' != '''iMatchKind'''.'; + iRc = 6; + end + if (sMatchType <> '' & sMatchType <> sType) then + do + if (\fQuiet) then + say 'syslevel '''sFile''': type '''sType''' != '''sMatchType'''.'; + iRc = 7; + end + /* + say 'debug:' + say 'iKind =' iKind + say 'sCurLevel =' sCurLevel + say 'sPreLevel =' sPreLevel + say 'sTitle =' sTitle + say 'sCId =' sCId + say 'sType =' sType + say 'sVer =' sVer + */ + end + else + say 'bad signature'; + + /* finished, close file */ + call stream sFile, 'c', 'close'; + end + else say 'open failed, rc='rc; +return iRc; + + + +/** + * Tool procedures section + * @returns 0 on success. + * 1 if PathQuery() failed. + * 2 if some vital file/dir wasn't found in the config verify. + * 49 if verify command rc mismatched. + * 99 if verify command output mismatched. + **/ + + +/* + * Concurrent Versions System (CVS) + */ +CVS: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + + /* + * The directories. + */ + sPathCVS = PathQuery('cvs', sToolId, sOperation); + if (sPathCVS = '') then + return 1; + sPathHome = PathQuery('home', sToolId, sOperation); + if (sPathHome = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_CVS', sPathCVS; + call EnvAddFront fRM, 'path', sPathCVS'\bin;' + call EnvAddFront fRM, 'bookshelf', sPathCVS'\book;' + call EnvAddFront fRM, 'bookshelf', sPathCVS'\book;' + call EnvSet fRM, 'home', translate(sPathHome, '/','\'); + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + + if (\CfgVerifyFile(sPathCVS'\bin\cvs.exe',fQuiet)) then + return 2; + if (length(sPathHome) <= 2) then + do + if (\fQuiet) then + say 'Error: The home directory is to short!'; + return 2; + end + if (\CfgVerifyDir(sPathHome, fQuiet)) then + return 2; +return CheckCmdOutput('cvs --version', 0, fQuiet, 'Concurrent Versions System (CVS) 1.1'); + + +/* + * EMX + */ +EMX: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * EMX/GCC main directory. + */ + sEMX = PathQuery('emx', sToolId, sOperation); + if (sEMX = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + sEMXBack = translate(sEMX, '\', '/'); + sEMXForw = translate(sEMX, '/', '\'); + call EnvSet fRM, 'PATH_EMX', sEMXBack; + call EnvSet fRM, 'CCENV', 'EMX' + call EnvSet fRM, 'BUILD_ENV', 'EMX' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + + call EnvAddFront fRM, 'BEGINLIBPATH', sEMXBack'\dll;' + call EnvAddFront fRM, 'PATH', sEMXBack'\bin;' + call EnvAddFront fRM, 'DPATH', sEMXBack'\book;' + call EnvAddFront fRM, 'BOOKSHELF', sEMXBack'\book;' + call EnvAddFront fRM, 'HELP', sEMXBack'\help;' + call EnvAddFront fRM, 'C_INCLUDE_PATH', sEMXForw'/include' + call EnvAddFront fRM, 'LIBRARY_PATH', sEMXForw'/lib' + call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sEMXForw'/include/cpp;'sEMXForw'/include' + call EnvSet fRM, 'PROTODIR', sEMXForw'/include/cpp/gen' + call EnvSet fRM, 'OBJC_INCLUDE_PATH', sEMXForw'/include' + call EnvSet fRM, 'GCCLOAD', '5' + call EnvSet fRM, 'GCCOPT', '-pipe' + call EnvAddFront fRM, 'INFOPATH', sEMXForw'/info' + call EnvSet fRM, 'EMXBOOK', 'emxdev.inf+emxlib.inf+emxgnu.inf+emxbsd.inf' + call EnvAddFront fRM, 'HELPNDX', 'emxbook.ndx', '+', 1 + call EnvSet fRM, 'EMXOPT', '-c -n -h1024' + if EnvGet('TERM') = '' then do + call EnvSet fRM, 'TERM', 'ansi' + call EnvSet fRM, 'TERMCAP', sEMXForw'/etc/termcap.dat' + end + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sEmxBack'\bin\gcc.exe', fQuiet), + | \CfgVerifyFile(sEmxBack'\bin\emxomf.exe', fQuiet), + | \CfgVerifyFile(sEmxBack'\bin\emxrev.cmd', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\mt\c.a', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\mt\c.lib', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\mt\sys.lib', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\mt\emx.a', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\mt\emx.lib', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\mt\c_import.a', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\mt\c_import.lib', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\c_alias.a', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\c_alias.lib', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\emx2.a', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\emx2.lib', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('gcc --version', 0, fQuiet, '2.8.1'); + if (rc = 0) then + rc = CheckCmdOutput('emxrev.cmd', 0, fQuiet,, + 'EMX : revision = 61'||'0d0a'x ||, + 'EMXIO : revision = 60'||'0d0a'x||, + 'EMXLIBC : revision = 63'||'0d0a'x||, + 'EMXLIBCM : revision = 64'||'0d0a'x||, + 'EMXLIBCS : revision = 64'||'0d0a'x||, + 'EMXWRAP : revision = 60'||'0d0a'x); + return rc; +return 0; + + +/* + * EMX PGCC - must be installed on to the ordinar EMX. + */ +EMXPGCC: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * EMX/GCC main directory. + */ + sEMXPGCC = PathQuery('emxpgcc', sToolId, sOperation); + if (sEMXPGCC = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + sEMXBack = translate(sEMXPGCC, '\', '/'); + sEMXForw = translate(sEMXPGCC, '/', '\'); + call EnvSet fRM, 'PATH_EMXPGCC', sEMXBack; + call EnvSet fRM, 'CCENV', 'EMX' + call EnvSet fRM, 'BUILD_ENV', 'EMX' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + + call EnvAddFront fRM, 'BEGINLIBPATH', sEMXBack'\dll;' + call EnvAddFront fRM, 'PATH', sEMXBack'\bin;' + call EnvAddFront fRM, 'DPATH', sEMXBack'\book;' + call EnvAddFront fRM, 'BOOKSHELF', sEMXBack'\book;' + call EnvAddFront fRM, 'HELP', sEMXBack'\help;' + call EnvAddFront fRM, 'C_INCLUDE_PATH', sEMXForw'/include' + call EnvAddFront fRM, 'LIBRARY_PATH', sEMXForw'/lib' + call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sEMXForw'/include/cpp;'sEMXForw'/include' + call EnvSet fRM, 'PROTODIR', sEMXForw'/include/cpp/gen' + call EnvSet fRM, 'OBJC_INCLUDE_PATH', sEMXForw'/include' + call EnvAddFront fRM, 'INFOPATH', sEMXForw'/info' + call EnvSet fRM, 'EMXBOOK', 'emxdev.inf+emxlib.inf+emxgnu.inf+emxbsd.inf' + call EnvAddFront fRM, 'HELPNDX', 'emxbook.ndx', '+', 1 + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sEmxBack'\bin\gcc.exe', fQuiet), + | \CfgVerifyFile(sEmxBack'\bin\g++.exe', fQuiet), + | \CfgVerifyFile(sEmxBack'\bin\as.exe', fQuiet), + | \CfgVerifyFile(sEmxBack'\bin\emxomf.exe', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\gcc29160.a', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\gcc29160.lib', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\iberty.a', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\iberty.lib', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\iberty_s.a', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\iberty_s.lib', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\opcodes.a', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\opcodes.lib', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\opcodes_s.a', fQuiet), + | \CfgVerifyFile(sEmxBack'\lib\opcodes_s.lib', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('gcc --version', 0, fQuiet, 'pgcc-2.95.2'); + if (rc = 0) then + rc = CheckCmdOutput('g++ --version', 0, fQuiet, 'pgcc-2.95.2'); + if (rc = 0) then + rc = CheckCmdOutput('as --version', 0, fQuiet, 'GNU assembler 2.9.1'); +return rc; + + +/* + * FreeType v1.3.1 EMX release. + */ +FreeTypeEMX: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + sPathFreeType = PathQuery('freetypeemx', sToolId, sOperation); + if (sPathFreeType = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + call EnvSet fRm, 'PATH_FREETYPE', sPathFreeType; + call EnvAddFront fRm, 'beginlibpath',sPathFreeType'\dll;' + call EnvAddFront fRm, 'path', sPathFreeType'\bin;' + call EnvAddFront fRM, 'include', sPathFreeType'\include;' + call EnvAddFront fRM, 'C_INCLUDE_PATH', sPathFreeType'\include;' + call EnvAddFront fRM, 'lib', sPathFreeType'\lib;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + + if ( \CfgVerifyFile(sPathFreeType'\bin\ftsbit.exe', fQuiet), + | \CfgVerifyFile(sPathFreeType'\bin\ftzoom.exe', fQuiet), + | \CfgVerifyFile(sPathFreeType'\dll\ttf.dll', fQuiet), + ) then + return 2; +return 0; + + +/* + * IBM DB2 v5.2 + */ +db2v52: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + sPathDB2 = PathQuery('db2v52', sToolId, sOperation); + if (sPathDB2 = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + call EnvSet fRm, 'PATH_DB2', sPathDB2; + call EnvSet fRm, 'db2path', sPathDB2; + call EnvAddFront fRm, 'beginlibpath',sPathDB2'\dll;'sPathDB2'\alt;' + call EnvAddFront fRm, 'path', sPathDB2'\bin;'sPathDB2'\alt;' + call EnvAddFront fRm, 'dpath', sPathDB2'\bin;'sPathDB2';' + call EnvAddFront fRm, 'help', sPathDB2'\help;' + call EnvAddEnd fRm, 'classpath', '.;'sPathDB2'\JAVA\DB2JAVA.ZIP;'sPathDB2'\JAVA\RUNTIME.ZIP;'sPathDB2'\JAVA\SQLJ.ZIP;' + call EnvSet fRM, 'db2instace', 'DB2' + /*call EnvSet fRM, 'odbc_path', 'f:\odbc' -- huh? what's this? */ + call EnvAddFront fRM, 'cobcpy', sPathDB2'\include\cobol_mf' + call EnvSet fRM, 'finclude', sPathDB2'\include' + call EnvAddFront fRM, 'include', sPathDB2'\include;' + call EnvAddFront fRM, 'lib', sPathDB2'\lib;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + + if ( \CfgVerifyFile(sPathDB2'\bin\db2.exe', fQuiet), + | \CfgVerifyFile(sPathDB2'\bin\sqlbind.exe', fQuiet), + | \CfgVerifyFile(sPathDB2'\bin\sqlprep.exe', fQuiet), + | \CfgVerifyFile(sPathDB2'\lib\db2api.lib', fQuiet), + | \CfgVerifyFile(sPathDB2'\lib\db2cli.lib', fQuiet), + | \CfgVerifyFile(sPathDB2'\lib\db2gmf32.lib', fQuiet), + | \CfgVerifyFile(sPathDB2'\include\sql.h', fQuiet), + | \CfgVerifyFile(sPathDB2'\include\sqlcodes.h', fQuiet), + | \CfgVerifyFile(sPathDB2'\include\sqlsystm.h', fQuiet), + | \CfgVerifyFile(sPathDB2'\include\sqlcli.h', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('echo quit | db2', 0, fQuiet, 'Command Line Processor for DB2 SDK 5.2.0'); +return rc; + + + +/* + * Device Driver Kit (DDK) base. + */ +DDK: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Device Driver Kit (DDK) (v4.0+) Main Directory. + */ + sPathDDK = PathQuery('ddk', sToolId, sOperation); + if (sPathDDK = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + do + /* Set the ddk subpaths */ + if (PathQuery('ddkbase', 'ddkbase', 'quietisconfig') = '') then + call PathSet 'ddkbase', sPathDDK'\base'; + if (PathQuery('ddkvideo', 'ddkvideo', 'quietisconfig') = '') then + call PathSet 'ddkvideo', sPathDDK'\video'; + if (PathQuery('ddkprint', 'ddkvideo', 'quietisconfig') = '') then + call PathSet 'ddkprint', sPathDDK'\print'; + return 0; + end + call EnvSet fRM, 'PATH_DDK', sPathDDK; + rc = DDKBase('ddkbase',sOperation,fRM,fQuiet) + if (rc = 0) then + rc = DDKVideo('ddkvideo',sOperation,fRM,fQuiet) +return rc; + + +/* + * Device Driver Kit (DDK) base. + */ +DDKBase: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Device Driver Kit (DDK) (v4.0+) base (important not main) directory. + */ + sPathDDKBase = PathQuery('ddkbase', sToolId, sOperation); + if (sPathDDKBase = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + call EnvSet fRM, 'PATH_DDKBASE',sPathDDKBase; + call EnvAddFront fRM, 'path', sPathDDKBase'\tools;' + call EnvAddFront fRM, 'include', sPathDDKBase'\h;'sPathDDKBase'\inc;'sPathDDKBase'\inc32;' + call EnvAddFront fRM, 'include16', sPathDDKBase'\h;' + call EnvAddFront fRM, 'lib', sPathDDKBase'\lib;' + call EnvAddFront fRM, 'bookshelf', sPathDDKBase'\..\docs;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathDDKBase'\tools\link.exe', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\tools\link386.exe', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\tools\cl386.exe', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\tools\masm.exe', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\tools\h2inc.exe', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\tools\lib.exe', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\lib\os2286.lib', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\lib\os2286p.lib', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\lib\os2386.lib', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\lib\os2386p.lib', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\lib\doscalls.lib', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\lib\dhcalls.lib', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\lib\addcalls.lib', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\lib\rmcalls.lib', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\lib\vdh.lib', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\h\infoseg.h', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\h\include.h', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\h386\pmddi.h', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\h386\pmddim.h', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\h386\limits.h', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\h386\string.h', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\inc\v8086.inc', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\inc\sas.inc', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\inc\pmwinx.inc', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\inc\infoseg.inc', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\inc\devhlp.inc', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\inc\devhlpp.inc', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('cl386', 0, fQuiet, 'Microsoft (R) Microsoft 386 C Compiler. Version 6.00.054'); + if (rc = 0) then + rc = CheckCmdOutput('masm nul,nul,nul,nul;', 2, fQuiet, 'Microsoft (R) Macro Assembler Version 5.10A.15 Jul 07 15:25:03 1989'); + if (rc = 0) then + rc = CheckCmdOutput('h2inc -?', 0, fQuiet, 'h2inc - .H to .INC file translator (version 13.29)'); + if (rc = 0) then + rc = CheckCmdOutput('type' sPathDDKBase'\inc\devhlp.inc', 0, fQuiet, 'DevHlp_ReadFileAt'); +return rc; + + +/* + * Device Driver Kit (DDK) Video. + */ +DDKVideo: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Device Driver Kit (DDK) (v4.0+) Video (important not main) directory. + */ + sPathDDKVideo = PathQuery('ddkvideo', sToolId, sOperation); + if (sPathDDKVideo = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + call EnvSet fRM, 'PATH_DDKVIDEO',sPathDDKVideo; + call EnvAddFront fRM, 'path', sPathDDKVideo'\tools\os2.386\bin;'sPathDDKVideo'\tools\os2.386\lx.386\bin;' /* might not need this... */ + call EnvAddFront fRM, 'include', sPathDDKVideo'\rel\os2c\include\base\os2;'/*sPathDDKVideo'\rel\os2c\include\base\os2\16bit;'sPathDDKVideo'\rel\os2c\include\base\os2\inc;'sPathDDKVideo'\rel\os2c\include\base\os2\inc32;' /* might be over kill!! */ - it is! */ + call EnvAddFront fRM, 'include16', sPathDDKVideo'\rel\os2c\include\base\os2\16bit;' + call EnvAddFront fRM, 'lib', sPathDDKVideo'\rel\os2c\lib\os2;'sPathDDKVideo'\rel\os2c\lib\os2\priv;' + call EnvAddFront fRM, 'bookshelf', sPathDDKVideo'\..\docs;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\doscalls.lib', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\gradd.lib', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\os2386.lib', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\libh.lib', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\vdh.lib', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\thunkrt.lib', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\dbcs32.lib', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\priv\pmwp.lib', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\priv\os2286p.lib', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\vvga.def', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\lib\os2\vvga.def', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\include\base\os2\gradd.h', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\include\base\os2\pmwp.h', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\include\base\os2\os2p.h', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\include\base\os2\pmgpip.h', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\include\base\os2\pmdevp.h', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\rel\os2c\include\base\os2\inc32\pmp.inc', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\bin\rc.exe', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\bin\nmake.exe', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\bin\h2inc.exe', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\lx.386\bin\link386.exe', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\lx.386\bin\masm.exe', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\lx.386\bin\masm.exe', fQuiet), + | \CfgVerifyFile(sPathDDKVideo'\tools\os2.386\lx.386\bin\mcl386\bin\c3_386.exe', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('nmake -?', 0, fQuiet, 'Version 2.001.000 Jan 28 1994'); + if (rc = 0) then + rc = CheckCmdOutput('masm nul,nul,nul,nul;', 2, fQuiet, 'Microsoft (R) Macro Assembler Version 5.10A.15 Jul 07 15:25:03 1989'); + if (rc = 0) then + rc = CheckCmdOutput('h2inc -?', 0, fQuiet, 'h2inc - .H to .INC file translator (version 13.29)'); + if (rc = 0) then + rc = CheckCmdOutput('type 'sPathDDKVideo'\rel\os2c\include\base\os2\gradd.h', 0, fQuiet, 'GHI_CMD_POLYGON'); +return rc; + + +/* + * Doxygen v1.2.11.1 for OS/2. + */ +DoxyGen: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Get base directory. + */ + sPathDoxyGen = PathQuery('doxygen', sToolId, sOperation); + if (sPathDoxyGen = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + call EnvSet fRM, 'PATH_DOXYGEN',sPathDoxyGen; + call EnvAddFront fRM, 'path', sPathDoxyGen'\bin;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathDoxyGen'\bin\dot.exe', fQuiet), + | \CfgVerifyFile(sPathDoxyGen'\bin\doxygen.exe', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('doxygen', 1, fQuiet, 'Doxygen version 1.2.11.1'); +return rc; + + +/* + * EMX/GCC 3.x.x - this environment must be used 'on' the ordinary EMX. + * Note! bin.new has been renamed to bin! + * Note! make .lib of every .a! in 4OS2: for /R %i in (*.a) do if not exist %@NAME[%i].lib emxomf %i + */ +GCC3xx: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet,sPathId + + /* + * EMX/GCC main directory. + */ + sGCC = PathQuery(sPathId, sToolId, sOperation); + if (sGCC = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + sGCCBack = translate(sGCC, '\', '/'); + sGCCForw = translate(sGCC, '/', '\'); + call EnvSet fRM, 'PATH_EMXPGCC', sGCCBack; + call EnvSet fRM, 'CCENV', 'EMX' + call EnvSet fRM, 'BUILD_ENV', 'EMX' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + + call EnvAddFront fRM, 'BEGINLIBPATH', sGCCBack'\dll;' + call EnvAddFront fRM, 'PATH', sGCCBack'\bin.new;'sGCCBack'\bin;' + call EnvAddFront fRM, 'DPATH', sGCCBack'\book;' + call EnvAddFront fRM, 'BOOKSHELF', sGCCBack'\book;' + call EnvAddFront fRM, 'HELP', sGCCBack'\help;' + call EnvAddFront fRM, 'C_INCLUDE_PATH', sGCCForw'/include' + call EnvAddFront fRM, 'LIBRARY_PATH', sGCCForw'/lib' + call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sGCCForw'/include/cpp;'sGCCForw'/include' + call EnvSet fRM, 'PROTODIR', sGCCForw'/include/cpp/gen' + call EnvSet fRM, 'OBJC_INCLUDE_PATH', sGCCForw'/include' + call EnvAddFront fRM, 'INFOPATH', sGCCForw'/info' + call EnvSet fRM, 'EMXBOOK', 'emxdev.inf+emxlib.inf+emxgnu.inf+emxbsd.inf' + call EnvAddFront fRM, 'HELPNDX', 'emxbook.ndx', '+', 1 + + /* + * Verify. + */ + chMajor = '3'; + chMinor = left(right(sToolId, 2), 1); + chRel = right(sToolId, 1); + sVer = chMajor'.'chMinor'.'chRel + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sGCCBack'\bin.new\gcc.exe', fQuiet), + | \CfgVerifyFile(sGCCBack'\bin.new\g++.exe', fQuiet), + | \CfgVerifyFile(sGCCBack'\bin.new\as.exe', fQuiet), + | \CfgVerifyFile(sGCCBack'\bin.new\readelf.exe', fQuiet), + | \CfgVerifyFile(sGCCBack'\bin.new\emxomf.exe', fQuiet), + | \CfgVerifyFile(sGCCBack'\dll\bfd211.dll', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\iberty.a', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\iberty.lib', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\iberty_s.a', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\iberty_s.lib', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\opcodes.a', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\opcodes.lib', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\opcodes_s.a', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\opcodes_s.lib', fQuiet), + ) then + return 2; + + if (chMinor > 0) then + do + if ( \CfgVerifyFile(sGCCBack'\lib\gcc-lib\i386-pc-os2-emx\'sVer'\st\'sToolId'.lib', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\i386-pc-os2-emx\'sVer'\st\stdcxx.lib', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\i386-pc-os2-emx\'sVer'\st\stdcxx.a', fQuiet), + ) then + return 2; + end + else + do + if ( \CfgVerifyFile(sGCCBack'\lib\gcc-lib\i386-pc-os2_emx\'sVer'\st\gcc_dll.lib', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\i386-pc-os2_emx\'sVer'\st\stdcxx.lib', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\i386-pc-os2_emx\'sVer'\st\stdcxx.a', fQuiet), + ) then + return 2; + end + + + rc = CheckCmdOutput('gcc --version', 0, fQuiet, sVer); + if (rc = 0) then + rc = CheckCmdOutput('g++ --version', 0, fQuiet, sVer); + if (rc = 0) then + do + sVerAS = '2.11.2'; + rc = CheckCmdOutput('as --version', 0, fQuiet, 'GNU assembler 'sVerAS); + end +return rc; + + +/* + * Innotek GCC 3.2.x and higher - this environment is EMX RT free. + * Note! make .lib of every .a! in 4OS2: for /R %i in (*.a) do if not exist %@NAME[%i].lib emxomf %i + */ +GCC322plus: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet,sPathId + + /* + * EMX/GCC main directory. + */ + sGCC = PathQuery(sPathId, sToolId, sOperation); + if (sGCC = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* parse out the version / constants */ + chMajor = '3'; + chMinor = left(right(sToolId, 2), 1); + chRel = right(sToolId, 1); + sVer = chMajor'.'chMinor'.'chRel + sVerShrt= chMajor||chMinor||chRel; + sTrgt = 'i386-pc-os2-emx' + + sGCCBack = translate(sGCC, '\', '/'); + sGCCForw = translate(sGCC, '/', '\'); + call EnvSet fRM, 'PATH_IGCC', sGCCBack; + call EnvSet fRM, 'CCENV', 'IGCC' + call EnvSet fRM, 'BUILD_ENV', 'IGCC' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + + call EnvAddFront fRM, 'BEGINLIBPATH', sGCCBack'\'sTrgt'\lib;'sGCCBack'\lib;' + call EnvAddFront fRM, 'DPATH', sGCCBack'\lib;' + /*call EnvAddFront fRM, 'HELP', sGCCBack'\lib;'*/ + call EnvAddFront fRM, 'PATH', sGCCForw'\'sTrgt'\bin;'sGCCBack'\'sTrgt'\bin;'sGCCForw'\bin;'sGCCBack'\bin;' + /*call EnvAddFront fRM, 'DPATH', sGCCBack'\book;' + call EnvAddFront fRM, 'BOOKSHELF', sGCCBack'\book;' + call EnvAddFront fRM, 'HELP', sGCCBack'\help;' */ + call EnvAddFront fRM, 'C_INCLUDE_PATH', sGCCForw'/include;' + call EnvAddFront fRM, 'C_INCLUDE_PATH', sGCCForw'/lib/gcc-lib/'sTrgt'/'sVer'/include;' + call EnvAddFront fRM, 'C_INCLUDE_PATH', sGCCForw'/lib/gcc-lib/'sTrgt'/'sVer'/include;' + call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sGCCForw'/include;' + call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sGCCForw'/include/c++/'sVer'/backward;' + call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sGCCForw'/include/c++/'sVer'/'sTrgt';' + call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sGCCForw'/include/c++/'sVer'/;' + call EnvAddFront fRM, 'LIBRARY_PATH', sGCCForw'/lib' + call EnvAddFront fRM, 'LIBRARY_PATH', sGCCForw'/lib/gcc-lib/'sTrgt'/'sVer';' + call EnvAddFront fRM, 'INFOPATH', sGCCForw'/info' + /* is this used? */ + call EnvSet fRM, 'PROTODIR', sGCCForw'/include/c++/gen' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sGCCBack'\bin\gcc.exe', fQuiet), + | \CfgVerifyFile(sGCCBack'\bin\g++.exe', fQuiet), + | \CfgVerifyFile(sGCCBack'\bin\as.exe', fQuiet), + | \CfgVerifyFile(sGCCBack'\bin\readelf.exe', fQuiet), + | \CfgVerifyFile(sGCCBack'\bin\emxomf.exe', fQuiet), + | \CfgVerifyFile(sGCCBack'\bin\ilink.exe', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\bfd2E.dll', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc'sVerShrt'.dll', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\libiberty.a', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\libiberty.lib', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\opcode2E.dll', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\libopcodes.a', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\libopcodes.lib', fQuiet), + | \CfgVerifyFile(sGCCBack'\include\unikbd.h', fQuiet), + | \CfgVerifyFile(sGCCBack'\include\c++\'sVer'\streambuf', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\specs', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\cc1plus.exe', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\gcc'sVerShrt'.a', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\gcc'sVerShrt'.lib', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\libgcc.a', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\libgcc.lib', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\libgcc_eh.a', fQuiet), + | \CfgVerifyFile(sGCCBack'\lib\gcc-lib\'sTrgt'\'sVer'\libgcc_eh.lib', fQuiet), + ) then + return 2; + + rc = CheckCmdOutput('gcc --version', 0, fQuiet, sVer); + if (rc = 0) then + rc = CheckCmdOutput('g++ --version', 0, fQuiet, sVer); + if (rc = 0) then + do + sVerAS = '2.14'; + rc = CheckCmdOutput('as --version', 0, fQuiet, 'GNU assembler 'sVerAS); + end + if (rc = 0) then + rc = CheckCmdOutput('ilink /?', 0, fQuiet, 'IBM(R) Linker for OS/2(R), Version 5.0'); + +return rc; + + +/* + * ICAT Debugger + */ +ICATGam: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + sPathICAT = PathQuery('icatgam', sToolId, sOperation); + if (sPathICAT = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRm, 'PATH_ICATGAM', sPathICAT; + call EnvAddFront fRm, 'beginlibpath',sPathICAT'\dll;' + call EnvAddFront fRm, 'path', sPathICAT'\bin;' + call EnvAddFront fRm, 'dpath', sPathICAT'\help;' + call EnvAddFront fRm, 'help', sPathICAT'\help;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathICAT'\bin\icatgam.exe', fQuiet), + | \CfgVerifyFile(sPathICAT'\dll\gamoou3.dll', fQuiet), + | \CfgVerifyFile(sPathICAT'\dll\gam5lde.dll', fQuiet), + | \CfgVerifyFile(sPathICAT'\dll\gam5cx.dll', fQuiet), + ) then + return 2; +return 0; + + +/* + * ICAT Debugger + */ +ICATGam406RC1: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + sPathICAT = PathQuery('icatgam406rc1', sToolId, sOperation); + if (sPathICAT = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRm, 'PATH_ICATGAM', sPathICAT; + call EnvAddFront fRm, 'beginlibpath',sPathICAT'\dll;' + call EnvAddFront fRm, 'path', sPathICAT'\bin;' + call EnvAddFront fRm, 'dpath', sPathICAT'\help;' + call EnvAddFront fRm, 'help', sPathICAT'\help;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathICAT'\bin\icatgam.exe', fQuiet), + | \CfgVerifyFile(sPathICAT'\dll\gamoou3.dll', fQuiet), + | \CfgVerifyFile(sPathICAT'\dll\gam5lde.dll', fQuiet), + | \CfgVerifyFile(sPathICAT'\dll\gam5cx.dll', fQuiet), + ) then + return 2; +return 0; + + + +/* + * ICAT Debugger for PE images. + */ +ICATPe: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + sPathICAT = PathQuery('icatgam', sToolId, sOperation); + if (sPathICAT = '') then + return 1; + sPathICATPe = PathQuery('icatpe', sToolId, sOperation); + if (sPathICATPe = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRm, 'PATH_ICATGAM',sPathICAT; + call EnvSet fRm, 'PATH_ICATPE', sPathICATPe; + call EnvAddFront fRm, 'beginlibpath',sPathICATPe'\bin;'sPathICAT'\dll;' + call EnvAddFront fRm, 'path', sPathICATPe'\bin;'sPathICAT'\bin;' + call EnvAddFront fRm, 'dpath', sPathICATPe'\bin;'sPathICAT'\help;' + call EnvAddFront fRm, 'help', sPathICATPe'\bin;'sPathICAT'\help;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathICAT'\bin\icatgam.exe', fQuiet), + | \CfgVerifyFile(sPathICAT'\dll\gamoou3.dll', fQuiet), + | \CfgVerifyFile(sPathICAT'\dll\gam5lde.dll', fQuiet), + | \CfgVerifyFile(sPathICAT'\dll\gam5cx.dll', fQuiet), + | \CfgVerifyFile(sPathICATPe'\bin\icatgam.exe', fQuiet), + | \CfgVerifyFile(sPathICATPe'\bin\gamoou3.dll', fQuiet), + | \CfgVerifyFile(sPathICATPe'\bin\gam5lde.dll', fQuiet), + | \CfgVerifyFile(sPathICATPe'\bin\gam5cx.dll', fQuiet), + ) then + return 2; +return 0; + + + +/* + * Interactive Disassembler (IDA) v3.80a + */ +IDA38: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + /* + * IDA main directory. + */ + sPathIDA = PathQuery('ida38', sToolId, sOperation); + if (sPathIDA = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_IDA', sPathIDA + call EnvAddFront fRM, 'path', sPathIDA + call EnvAddFront fRM, 'beginlibpath', sPathIDA + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathIDA'\ida2.exe', fQuiet), + | \CfgVerifyFile(sPathIDA'\idaw.exe', fQuiet), + | \CfgVerifyFile(sPathIDA'\ida.dll', fQuiet), + | \CfgVerifyFile(sPathIDA'\pc.dll', fQuiet), + ) then + return 2; +return 0; + + +/* + * Interactive Disassembler (IDA) v4.01 + */ +IDA40: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + /* + * IDA main directory. + */ + sPathIDA = PathQuery('ida40', sToolId, sOperation); + if (sPathIDA = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_IDA', sPathIDA + call EnvAddFront fRM, 'path', sPathIDA + call EnvAddFront fRM, 'beginlibpath', sPathIDA + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathIDA'\ida2.exe', fQuiet), + | \CfgVerifyFile(sPathIDA'\idaw.exe', fQuiet), + | \CfgVerifyFile(sPathIDA'\ida.dll', fQuiet), + | \CfgVerifyFile(sPathIDA'\pc.dll', fQuiet), + ) then + return 2; +return 0; + + +/* + * Interactive Disassembler (IDA) v4.14 + */ +IDA414: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + /* + * IDA main directory. + */ + sPathIDA = PathQuery('ida414', sToolId, sOperation); + if (sPathIDA = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_IDA', sPathIDA + call EnvAddFront fRM, 'path', sPathIDA + call EnvAddFront fRM, 'beginlibpath', sPathIDA + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathIDA'\ida2.exe', fQuiet), + | \CfgVerifyFile(sPathIDA'\idaw.exe', fQuiet), + | \CfgVerifyFile(sPathIDA'\ida.dll', fQuiet), + | \CfgVerifyFile(sPathIDA'\pc.dll', fQuiet), + ) then + return 2; +return 0; + + +/* + * Interactive Disassembler (IDA) Plugin SDK (v5.0?) + */ +IDASDK: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + /* + * IDA main directory. + */ + sPathIDASDK = PathQuery('idasdk', sToolId, sOperation); + if (sPathIDASDK = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_IDASDK', sPathIDASDK + call EnvAddFront fRM, 'include', sPathIDASDK'\include;' + call EnvAddFront fRM, 'lib', sPathIDASDK'\libwat.os2;' + call EnvAddFront fRM, 'path', sPathIDASDK'\bin\os2;' + call EnvAddFront fRM, 'beginlibpath', sPathIDASDK'\bin\os2;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathIDASDK'\os2wat.cfg', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\d32wat.cfg', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\include\exehdr.h', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\include\ida.hpp', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\include\vm.hpp', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\libwat.os2\ida.lib', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\libwat.d32\ida.lib', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\libwat.d32\INIRT386.OBJ', fQuiet), + /* | \CfgVerifyFile(sPathIDASDK'\libbor.d32\ida.lib', fQuiet)*/, + ) then + return 2; +return 0; + + +/* + * Interactive Disassembler (IDA) Plugin SDK (v5.0?) + */ +IDASDK: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + /* + * IDA main directory. + */ + sPathIDASDK = PathQuery('idasdk', sToolId, sOperation); + if (sPathIDASDK = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_IDASDK', sPathIDASDK + call EnvAddFront fRM, 'include', sPathIDASDK'\include;' + call EnvAddFront fRM, 'lib', sPathIDASDK'\libwat.os2;' + call EnvAddFront fRM, 'path', sPathIDASDK'\bin\os2;' + call EnvAddFront fRM, 'beginlibpath', sPathIDASDK'\bin\os2;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathIDASDK'\os2wat.cfg', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\d32wat.cfg', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\include\exehdr.h', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\include\ida.hpp', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\include\vm.hpp', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\libwat.os2\ida.lib', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\libwat.d32\ida.lib', fQuiet), + | \CfgVerifyFile(sPathIDASDK'\libwat.d32\INIRT386.OBJ', fQuiet), + /* | \CfgVerifyFile(sPathIDASDK'\libbor.d32\ida.lib', fQuiet)*/, + ) then + return 2; +return 0; + +/* + * icsdebug (IBM Visual Age for C++ v3.08 for OS/2) + */ +icsdebug: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * icsdebug (IBM Visual Age for C++ Version 3.08) main directory. + */ + sPath = PathQuery('icsdebug', sToolId, sOperation); + if (sPath = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_ICSDEBUG', sPath + + call EnvAddFront fRM, 'beginlibpath', sPath'\DLL;' + call EnvAddFront fRM, 'path', sPath'\BIN;' + call EnvAddFront fRM, 'dpath', sPath'\HELP;'sPath';'sPath'\LOCALE;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPath'\bin\icsdebug.exe', fQuiet), + | \CfgVerifyFile(sPath'\help\dde4.msg', fQuiet), + | \CfgVerifyFile(sPath'\help\dde4lde.msg', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppibs30.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppom30.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppoob3.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppood3.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppoou3.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\dde4brsc.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\dde4cr.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\dde4cx.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\dde4dsl.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\dde4lde.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\dde4modl.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\dde4mth.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\dde4pmdb.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\dde4prt.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\dde4ress.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\dde4tk.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\dde4trib.dll', fQuiet), + ) then + return 2; +return 0; + + +/* + * idebug (Visual Age / C and C++ tools v3.6.5 for OS/2) + */ +idebug: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * IBM C/C++ Compiler and Tools Version 3.6.5 main directory. + */ + sPath = PathQuery('idebug', sToolId, sOperation); + if (sPath = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_IDEBUG', sPath; + + call EnvAddFront fRM, 'path', sPath'\bin;' + call EnvAddFront fRM, 'dpath', sPath'\local;'sPath'\help;' + call EnvAddFront fRM, 'beginlibpath',sPath'\dll;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPath'\bin\idebug.exe', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppbhg36.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppbpg36.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppddle1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppddpm1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppdfer1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppdfhp1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppdfiw1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppdfpw1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppdftk1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppdqmq1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppdrq1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppdrx1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppdtcp1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppdunf1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppdxcx1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppdxsm1.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cpprdi36.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cpprmi36.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cpptb30.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cpptd30.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cpptu30.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppxb30.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppxd30.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppxm30.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppxm36.dll', fQuiet), + | \CfgVerifyFile(sPath'\dll\cppxu30.dll', fQuiet), + | \CfgVerifyFile(sPath'\help\cppdmg1.msg', fQuiet), + | \CfgVerifyFile(sPath'\msg\cppdcc1.cat', fQuiet), + ) then + return 2; +return 0; + + +/* + * JAVA v1.3.1 (latest) + */ +Java131: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + /* + * JAVA main directory. + */ + sPathJava = PathQuery('java131', sToolId, sOperation); + if (sPathJava = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_JAVA', sPathJava + call EnvSet fRM, 'PATH_JAVA131', sPathJava + call EnvAddFront fRM, 'path', sPathJava'\bin;'sPathJava'\jre\bin;' + call EnvAddFront fRM, 'beginlibpath', sPathJava'\jre\dll;'sPathJava'\jre\bin;'sPathJava'\icatjava\dll;' +/* call EnvAddFront fRM, 'classpath', sPathJava'\jre\dll;'sPathJava'\jre\bin;'sPathJava'\icatjava\dll;' +*/ + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathJava'\bin\javac.exe', fQuiet), + | \CfgVerifyFile(sPathJava'\bin\jar.exe', fQuiet), + | \CfgVerifyFile(sPathJava'\lib\tools.jar', fQuiet), + | \CfgVerifyFile(sPathJava'\lib\javai.lib', fQuiet), + | \CfgVerifyFile(sPathJava'\jre\dll\jv12mi36.dll', fQuiet), + | \CfgVerifyFile(sPathJava'\jre\bin\java.exe', fQuiet), + | \CfgVerifyFile(sPathJava'\jre\bin\jitc.dll', fQuiet), + | \CfgVerifyFile(sPathJava'\jre\bin\javaw.exe', fQuiet), + | \CfgVerifyFile(sPathJava'\jre\bin\rmid.exe', fQuiet), + | \CfgVerifyFile(sPathJava'\jre\bin\classic\jvm.dll', fQuiet), + | \CfgVerifyFile(sPathJava'\include\int64_md.h', fQuiet), + | \CfgVerifyFile(sPathJava'\include\jawt.h', fQuiet), + | \CfgVerifyFile(sPathJava'\include\jawt_md.h', fQuiet), + | \CfgVerifyFile(sPathJava'\include\jni.h', fQuiet), + | \CfgVerifyFile(sPathJava'\include\jniproto_md.h', fQuiet), + | \CfgVerifyFile(sPathJava'\include\jni_md.h', fQuiet), + | \CfgVerifyFile(sPathJava'\include\jvmdi.h', fQuiet), + | \CfgVerifyFile(sPathJava'\include\jvmpi.h', fQuiet), + | \CfgVerifyFile(sPathJava'\jre\bin\jitc_g.dll', fQuiet, 1), + | \CfgVerifyFile(sPathJava'\jre\bin\classic\jvm_g.dll', fQuiet, 1), + ) then + return 2; + +return 0; + + +/* + * jitdbg (secret) + */ +jitdbg: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * IBM C/C++ Compiler and Tools Version 3.6.5 main directory. + */ + sPath = PathQuery('jitdbg', sToolId, sOperation); + if (sPath = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_JITDBG', sPath; + + call EnvAddFront fRM, 'path', sPath'\bin;' + call EnvAddFront fRM, 'dpath', sPath'\msg;'sPath'\help;' + call EnvAddFront fRM, 'beginlibpath',sPath'\dll;'sPath'\extradlls;' + call EnvAddFront fRM, 'help', sPath'\help;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPath'\bin\idbug.exe', fQuiet), + ) then + return 2; +return 0; + + +/* + * (lib) JPEG v6b port. + */ +JPEG: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + sPathJPEG = PathQuery('jpeg', sToolId, sOperation); + if (sPathJPEG = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + call EnvSet fRm, 'PATH_JPEG', sPathJPEG; + call EnvAddFront fRm, 'beginlibpath',sPathJPEG'\dll;' + call EnvAddFront fRm, 'path', sPathJPEG'\bin;' + call EnvAddFront fRM, 'include', sPathJPEG'\include;' + call EnvAddFront fRM, 'C_INCLUDE_PATH', sPathJPEG'\include;' + call EnvAddFront fRM, 'lib', sPathJPEG'\lib;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + + if ( \CfgVerifyFile(sPathJPEG'\bin\cjpeg.exe', fQuiet), + | \CfgVerifyFile(sPathJPEG'\dll\jpeg.dll', fQuiet), + | \CfgVerifyFile(sPathJPEG'\include\jpeglib.h', fQuiet), + | \CfgVerifyFile(sPathJPEG'\lib\jpeg.a', fQuiet), + | \CfgVerifyFile(sPathJPEG'\lib\jpeg.lib', fQuiet), + ) then + return 2; +return 0; + + + + +/* + * Mode commandline. + */ +Mode: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet,cols,rows + + if (pos('install', sOperation) > 0 & pos('uninstall', sOperation) <= 0) then + do + say "ok!" + Address CMD 'mode' cols','rows + end + /* TODO + else if ((pos('uninstall', sOperation) > 0) | \fRM) then + do + say 'Huh?' + cols = 80; + rows = 25; + end + */ +return 0; + + +/* + * Microsoft C v6.0a 16-bit + */ +MSCV6_16: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Microsoft C v6.0a main directory. + */ + sPathMSC = PathQuery('mscv6-16', sToolId, sOperation); + if (sPathMSC = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'BUILD_ENV', 'MSCV6-16' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + call EnvSet fRM, 'PATH_MSC', sPathMSC; + call EnvAddFront fRM, 'path', sPathMSC'\binp;' + call EnvAddFront fRM, 'endlibpath', sPathMSC'\dll;' + call EnvAddFront fRM, 'helpfiles', sPathMSC'\help;' + call EnvAddFront fRM, 'include', sPathMSC'\include;' + call EnvAddFront fRM, 'include16', sPathMSC'\include;' + call EnvAddFront fRM, 'lib', sPathMSC'\lib;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathMSC'\binp\cl.exe', fQuiet), + | \CfgVerifyFile(sPathMSC'\lib\clibcep.lib', fQuiet), + | \CfgVerifyFile(sPathMSC'\lib\llibcep.lib', fQuiet), + | \CfgVerifyFile(sPathMSC'\lib\mlibcep.lib', fQuiet), + | \CfgVerifyFile(sPathMSC'\lib\slibcep.lib', fQuiet), + | \CfgVerifyFile(sPathMSC'\include\sysbits.h', fQuiet), + | \CfgVerifyFile(sPathMSC'\include\dos.h', fQuiet), + | \CfgVerifyFile(sPathMSC'\include\bios.h', fQuiet), + | \CfgVerifyFile(sPathMSC'\include\string.h', fQuiet), + | \CfgVerifyFile(sPathMSC'\include\stdio.h', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('cl', 0, fQuiet, 'Microsoft (R) C Optimizing Compiler Version 6.00A.04'); +return rc; + + +/* + * Microsoft C v6.0a 32-bit + */ +MSCV6_32: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Microsoft C v6.0a 32-bit main directory. + */ + sPathDDKBase = PathQuery('ddkbase', sToolId, sOperation); + if (sPathDDKBase = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * This is where the compiler really is. + */ + call DDKBase 'ddkbase',sOperation,fRM,fQuiet; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'BUILD_ENV', 'MSCV6' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + call EnvSet fRM, 'PATH_MSC', sPathDDKBase; + call EnvAddFront fRM, 'include', sPathDDKBase'\h386;' + call EnvAddFront fRM, 'lib', sPathDDKBase'\lib;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathDDKBase'\tools\cl386.exe', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\h386\limits.h', fQuiet), + | \CfgVerifyFile(sPathDDKBase'\h386\string.h', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('cl386', 0, fQuiet, 'Microsoft (R) Microsoft 386 C Compiler. Version 6.00.054'); +return rc; + + +/* + * Microsoft C v7.0 16-bit with OS/2 support. + */ +MSCV7_16: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Microsoft C v6.0a main directory. + */ + sPathMSC = PathQuery('mscv7-16', sToolId, sOperation); + if (sPathMSC = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'BUILD_ENV', 'MSCV7-16' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + call EnvSet fRM, 'PATH_MSC', sPathMSC; + call EnvAddFront fRM, 'path', sPathMSC'\binp;' + call EnvAddFront fRM, 'endlibpath', sPathMSC'\dll;' + call EnvAddFront fRM, 'helpfiles', sPathMSC'\help;' + call EnvAddFront fRM, 'include', sPathMSC'\include;' + call EnvAddFront fRM, 'include16', sPathMSC'\include;' + call EnvAddFront fRM, 'lib', sPathMSC'\lib;' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathMSC'\binp\cl.exe', fQuiet), + | \CfgVerifyFile(sPathMSC'\binp\link.exe', fQuiet), + | \CfgVerifyFile(sPathMSC'\binp\ilink.exe', fQuiet), + /* | \CfgVerifyFile(sPathMSC'\lib\clibcep.lib', fQuiet), + | \CfgVerifyFile(sPathMSC'\lib\llibcep.lib', fQuiet), + | \CfgVerifyFile(sPathMSC'\lib\mlibcep.lib', fQuiet), + | \CfgVerifyFile(sPathMSC'\lib\slibcep.lib', fQuiet)*/, + | \CfgVerifyFile(sPathMSC'\include\dos.h', fQuiet), + | \CfgVerifyFile(sPathMSC'\include\bios.h', fQuiet), + | \CfgVerifyFile(sPathMSC'\include\locale.h', fQuiet), + | \CfgVerifyFile(sPathMSC'\include\stdiostr.h', fQuiet), + | \CfgVerifyFile(sPathMSC'\include\string.h', fQuiet), + | \CfgVerifyFile(sPathMSC'\include\vmemory.h', fQuiet), + | \CfgVerifyFile(sPathMSC'\include\stdio.h', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('cl', 0, fQuiet, 'Microsoft (R) C/C++ Optimizing Compiler Version 7.00'); +return rc; + + + + +/* + * mySQL Database system + */ +mySQL: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * mySQL Database system main directory. + */ + sPathMySQL = PathQuery('mysql', sToolId, sOperation); + if (sPathMySQL = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_MYSQL', sPathMySQL; + call EnvAddFront fRM, 'path', sPathMySQL'\bin;' + call EnvAddFront fRM, 'beginlibpath', sPathMySQL'\dll;' + call EnvAddFront fRM, 'include', sPathMySQL'\include;' + call EnvAddFront fRM, 'bookshelf', sPathMySQL'\doc;'sPathMySQL'\book'; + /*call EnvAddFront fRM, 'lib', sPathMySQL'\lib;'*/ + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathMySQL'\bin\mysql.exe', fQuiet), + | \CfgVerifyFile(sPathMySQL'\bin\mysqld.exe', fQuiet), + | \CfgVerifyFile(sPathMySQL'\bin\mysqladmin.exe', fQuiet), + | \CfgVerifyFile(sPathMySQL'\dll\mysql.dll', fQuiet), + | \CfgVerifyFile(sPathMySQL'\include\mysql.h', fQuiet), + | \CfgVerifyFile(sPathMySQL'\include\mysql_com.h', fQuiet), + | \CfgVerifyFile(sPathMySQL'\include\mysql_version.h', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('mysql --version', 0, fQuiet, ', for '); +return rc; + + + +/* + * NASM - NetWide Assembler (all versions) + */ +NASM: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet,sPathId + + /* + * Get NASM directory + */ + sPathNASM = PathQuery(sPathId, sToolId, sOperation); + if (sPathNASM = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_NASM', sPathNASM; + call EnvAddFront fRM, 'path', sPathNASM + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathNASM'\nasm.exe', fQuiet), + | \CfgVerifyFile(sPathNASM'\ndisasm.exe', fQuiet), + ) then + return 2; + select + when (sPathId = 'nasm9833') then sVer = '0.98.33 compiled'; + otherwise do; say 'internal error invalid pathid! sPathId='sPathId; exit(16); end + end + rc = CheckCmdOutput('nasm -version', 0, fQuiet, 'NASM version '||sVer); + if (rc = 0) then + rc = CheckCmdOutput('ndisasm -version', 0, fQuiet, 'NDISASM version '||sVer); +return rc; + + + +/* + * NetQOS2 - help subsystem++ for VAC 3.6.5 and VAC 4.0 + */ +NetQOS2: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + sPathNetQOS2 = PathQuery('netqos2', sToolId, sOperation); + if (sPathNetQOS2 = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_NETQOS2', sPathNetQOS2 + call EnvAddFront fRM, 'path', sPathNetQOS2';' + call EnvAddFront fRM, 'dpath', sPathNetQOS2';' + call EnvAddFront fRM, 'beginlibpath', sPathNetQOS2';' + call EnvSet fRM, 'imndatasrv', sPathNetQOS2'\DATA' + call EnvSet fRM, 'imndatacl', sPathNetQOS2'\DATA' + call EnvSet fRM, 'imnworksrv', sPathNetQOS2'\WORK' + call EnvSet fRM, 'imnworkcl', sPathNetQOS2'\WORK' + call EnvSet fRM, 'imnnlpssrv', sPathNetQOS2 + call EnvSet fRM, 'imnnlpscl', sPathNetQOS2 + call EnvSet fRM, 'imncccfgfile', 'NETQ.CFG' + call EnvSet fRM, 'imncscfgfile', 'NETQ.CFG' + call EnvSet fRM, 'imqconfigsrv', sPathNetQOS2'\instance' + call EnvSet fRM, 'imqconfigcl', sPathNetQOS2'\instance\dbcshelp' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathNetQOS2'\netq.exe', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('netq', 999, fQuiet, 'NETQ {START | STOP'); +return rc; + + +/* + * Odin32 testcase setup. + */ +Odin32Testcase: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + if ( PathQuery('testcase_drive_unused', sToolId, sOperation) = '', + | PathQuery('testcase_drive_fixed', sToolId, sOperation) = '', + | PathQuery('testcase_drive_floppy', sToolId, sOperation) = '', + | PathQuery('testcase_drive_cdrom', sToolId, sOperation) = '', + ) then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'odin32_testcase_drive_unused', PathQuery('testcase_drive_unused', sToolId, sOperation); + call EnvSet fRM, 'odin32_testcase_drive_fixed', PathQuery('testcase_drive_fixed', sToolId, sOperation); + call EnvSet fRM, 'odin32_testcase_drive_floppy', PathQuery('testcase_drive_floppy', sToolId, sOperation); + call EnvSet fRM, 'odin32_testcase_drive_cdrom', PathQuery('testcase_drive_cdrom', sToolId, sOperation); + call EnvSet fRM, 'odin32_testcase_drive_network', PathQuery('testcase_drive_network', sToolId, sOperation, 1); + call EnvSet fRM, 'odin32_testcase_drive_ramdisk', PathQuery('testcase_drive_ramdisk', sToolId, sOperation, 1); + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; +return 0; + + +/* + * PERL 5005_53 or 5.004_55 + */ +Perl50xxx: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Perl main directory. + */ + sPathPerl = PathQuery('perl50xxx', sToolId, sOperation); + if (sPathPerl = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + sPathPerlForw = translate(sPathPerl, '/', '\'); + call EnvSet fRM, 'PATH_PERL', sPathPerl; + call EnvAddFront fRM, 'path', sPathPerl'\bin;' + call EnvAddFront fRM, 'beginlibpath', sPathPerl'\dll;' + call EnvAddEnd fRM, 'bookshelf', sPathPerl'\book;' + call EnvSet fRM, 'perllib_prefix', sPathPerlForw'/lib;'sPathPerlForw'/lib' + call EnvSet fRM, 'perl_sh_dir', sPathPerlForw'/bin_sh' + call EnvSet fRM, 'manpath', sPathPerlForw'/man' + call EnvSet fRM, 'perl5lib', sPathPerlForw'/lib' + call EnvSet fRM, 'perl_badlang', '0' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + + sPerlDLL = 'perl.dll'; + sVer = '5.004_55'; + f5005_53 = FileExists(sPathPerl'\dll\perlE0AC.dll'); + if (f5005_53) then + do + sPerlDLL = 'perlE0AC.dll'; + sVer = '5.005_53'; + end + if ( \CfgVerifyFile(sPathPerl'\bin\perl.exe', fQuiet), + | \CfgVerifyFile(sPathPerl'\dll\'||sPerlDLL, fQuiet), + ) then + return 2; + rc = CheckCmdOutput('perl --version', 0, fQuiet, 'This is perl, version '||sVer||' built for os2'); +return rc; + + +/* + * PERL v5.8.0 + */ +Perl580: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Perl main directory. + */ + sPathPerl = PathQuery('perl580', sToolId, sOperation); + if (sPathPerl = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + sPathPerlForw = translate(sPathPerl, '/', '\'); + call EnvSet fRM, 'PATH_PERL', sPathPerl; + call EnvAddFront fRM, 'path', sPathPerl'\bin\5.8.0;' + call EnvAddFront fRM, 'beginlibpath', sPathPerl'\lib;' + call EnvAddEnd fRM, 'bookshelf', sPathPerl'\doc;' + call EnvSet fRM, 'perllib_prefix', 'L:/Perl/lib;'sPathPerlForw'/lib' + call EnvSet fRM, 'perl_sh_dir', sPathPerlForw'/bin/5.8.0' + call EnvSet fRM, 'manpath', sPathPerlForw'/man' + call EnvSet fRM, 'perl_badlang', '0' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + + if ( \CfgVerifyFile(sPathPerl'\bin\5.8.0\perl.exe', fQuiet), + | \CfgVerifyFile(sPathPerl'\lib\perlB12E.dll', fQuiet), + | \CfgVerifyFile(sPathPerl'\bin\5.8.0\sh.exe', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('perl --version', 0, fQuiet, 'This is perl, v5.8.0 built for os2_emx'); + +return rc; + + +/* + * Python/2 v1.5.2 + */ +Python: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * The Python Home directory + */ + sPythonHome = PathQuery('python', sToolId, sOperation); + if (sPythonHome = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_PYTHON', sPythonHome + call EnvSet fRM, 'pythonhome', sPythonHome + call EnvSet fRM, 'pythonpath', '.;'sPythonHome'\Lib;'sPythonHome'\Lib\plat-win;'sPythonHome'\Lib\lib-tk;'sPythonHome'\Lib\lib-dynload;'sPythonHome'\Lib\site-packages;'sPythonHome'\Lib\dos-8x3' + call EnvAddFront fRM, 'beginlibpath', sPythonHome + call EnvAddFront fRM, 'path', sPythonHome + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPythonHome'\Python.exe', fQuiet), + | \CfgVerifyFile(sPythonHome'\Python15.dll', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('echo print "hello world" | python', 0, fQuiet, 'hello world'); +return rc; + + +/* + * Subversion (svn) + */ +Subversion: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + + /* + * The directories. + */ + sPathCVS = PathQuery('svn', sToolId, sOperation); + if (sPathCVS = '') then + return 1; + sPathHome = PathQuery('home', sToolId, sOperation); + if (sPathHome = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_SVN', sPathCVS; + call EnvAddFront fRM, 'path', sPathCVS';' + call EnvSet fRM, 'home', translate(sPathHome, '/','\'); + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + + if (\CfgVerifyFile(sPathCVS'\svn.exe',fQuiet)) then + return 2; + if (length(sPathHome) <= 2) then + do + if (\fQuiet) then + say 'Error: The home directory is to short!'; + return 2; + end + if (\CfgVerifyDir(sPathHome, fQuiet)) then + return 2; +return CheckCmdOutput('svn.exe --version', 0, fQuiet, 'svn, version 1.'); + + + +/* + * OS/2 Programmers Toolkit v4.0 (CSD1/4) + */ +Toolkit40: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Toolkit (4.0) main directory. + */ + sPathTK = PathQuery('toolkit40', sToolId, sOperation); + if (sPathTK = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_TOOLKIT', sPathTK; + call EnvAddFront fRM, 'beginlibpath', sPathTK'\archived;'sPathTK'\SAMPLES\MM\DLL;'sPathTK'\SAMPLES\OPENDOC\PARTS\DLL;'sPathTK'\SOM\COMMON\DLL;'sPathTK'\SOM\LIB;'sPathTK'\OPENDOC\BASE\DLL;'sPathTK'\OPENDOC\BASE\LOCALE\EN_US;'sPathTK'\DLL;' + call EnvAddFront fRM, 'path', sPathTK'\archived;'sPathTK'\SOM\COMMON;'sPathTK'\SOM\BIN;.;'sPathTK'\OPENDOC\BASE\BIN;'sPathTK'\BIN;' + call EnvAddFront fRM, 'dpath', sPathTK'\SOM\COMMON\SYSTEM;'sPathTK'\SOM\MSG;'sPathTK'\OPENDOC\BASE\MSG;'sPathTK'\BOOK;'sPathTK'\MSG;' + call EnvAddFront fRM, 'help', sPathTK'\archived;'sPathTK'\OPENDOC\BASE\LOCALE\EN_US;'sPathTK'\HELP;' + call EnvAddFront fRM, 'bookshelf', sPathTK'\archived;'sPathTK'\BOOK;'sPathTK'\ARCHIVED;' + call EnvAddFront fRM, 'somir', sPathTK'\SOM\COMMON\ETC\214\SOM.IR;'sPathTK'\OPENDOC\BASE\AVLSHELL.IR;' + call EnvAddEnd fRM, 'somir', sPathTK'\OPENDOC\CUSTOM\OD.IR;'sPathTK'\SAMPLES\REXX\SOM\ANIMAL\ORXSMP.IR;' +/* call EnvAddFront fRM, 'include', sPathTK'\SPEECH\H;''sPathTK'\SAMPLES\OPENDOC\PARTS\INCLUDE;'sPathTK'\SOM\INCLUDE;'sPathTK'\INC;'sPathTK'\H\GL;'sPathTK'\H;' */ + call EnvAddFront fRM, 'include', /*sPathTK'\SPEECH\H;'*/sPathTK'\SAMPLES\OPENDOC\PARTS\INCLUDE;'sPathTK'\SOM\INCLUDE;'sPathTK'\INC;'sPathTK'\H\GL;'sPathTK'\H;' + call EnvAddEnd fRM, 'include', sPathTK'\H\LIBC;.;' + call EnvAddFront fRM, 'lib', sPathTK'\SPEECH\LIB;'sPathTK'\SAMPLES\MM\LIB;'sPathTK'\LIB;'sPathTK'\SOM\LIB;'sPathTK'\OPENDOC\BASE\LIB;' + call EnvAddFront fRM, 'nlspath', sPathTK'\OPENDOC\BASE\LOCALE\EN_US\%N;'sPathTK'\MSG\%N;C:\MPTN\MSG\NLS\%N;C:\TCPIP\msg\ENUS850\%N;' + call EnvAddFront fRM, 'locpath', sPathTK'\OPENDOC\BASE\LOCALE;' + call EnvAddFront fRM, 'ipfc', sPathTK'\IPFC;' + call EnvSet fRM, 'odbase', sPathTK'\OPENDOC\BASE' + call EnvSet fRM, 'odlang', 'en_US' + call EnvAddFront fRM, 'odbasepaths', sPathTK'\OPENDOC\BASE;' + call EnvSet fRM, 'odcfg', sPathTK'\OPENDOC\CUSTOM' + call EnvSet fRM, 'odtmp', EnvGet('tmp'); + call EnvSet fRM, 'sombase', sPathTK'\SOM' + call EnvSet fRM, 'somruntime', sPathTK'\SOM\COMMON' + + call EnvSet fRM, 'cpref', 'CP1.INF+CP2.INF+CP3.INF' + call EnvSet fRM, 'gpiref', 'GPI1.INF+GPI2.INF+GPI3.INF+GPI4.INF' + call EnvSet fRM, 'mmref', 'MMREF1.INF+MMREF2.INF+MMREF3.INF' + call EnvSet fRM, 'pmref', 'PM1.INF+PM2.INF+PM3.INF+PM4.INF+PM5.INF' + call EnvSet fRM, 'wpsref', 'WPS1.INF+WPS2.INF+WPS3.INF' + call EnvAddFront fRM, 'sminclude', sPathTK'\H;'sPathTK'\IDL;'sPathTK'\SOM\INCLUDE;.;'sPathTK'\OPENDOC\BASE\INCLUDE;'sPathTK'\SAMPLES\OPENDOC\PARTS\INCLUDE;' + call EnvSet fRM, 'smaddstar', '1' + call EnvSet fRM, 'smemit', 'h;ih;c' + call EnvSet fRM, 'smtmp', EnvGet('tmp'); + call EnvSet fRM, 'smclasses', 'WPTYPES.IDL' + call EnvSet fRM, 'odparts', sPathTK'\SAMPLES\OPENDOC\PARTS' + call EnvSet fRM, 'odsrc', sPathTK'\SAMPLES\OPENDOC\PARTS' + call EnvAddFront fRM, 'odpartspaths', sPathTK'\SAMPLES\OPENDOC\PARTS;' + call EnvAddFront fRM, 'odsrcpaths', sPathTK'\SAMPLES\OPENDOC\PARTS;' + /* + call EnvSet fRM, 'CAT_MACHINE=COM1:57600' + call EnvSet fRM, 'CAT_HOST_BIN_PATH='sPathTK'\BIN' + call EnvSet fRM, 'CAT_COMMUNICATION_TYPE=ASYNC_SIGBRK' + call EnvAddFront fRM, 'CAT_HOST_SOURCE_PATH='sPathTK'\BIN;' + */ + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathTK'\bin\alp.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\rc.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\ipfc.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\implib.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\mkmsgf.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\mapsym.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\lib\os2386.lib', fQuiet), + | \CfgVerifyFile(sPathTK'\lib\pmbidi.lib', fQuiet), + | \CfgVerifyFile(sPathTK'\lib\tcpip32.lib', fQuiet), + | \CfgVerifyFile(sPathTK'\h\os2.h', fQuiet), + | \CfgVerifyFile(sPathTK'\h\os2win.h', fQuiet), + | \CfgVerifyFile(sPathTK'\h\stack16\pmwsock.h', fQuiet), + | \CfgVerifyFile(sPathTK'\som\bin\sc.exe', fQuiet), + ) then + return 2; + + rc = CheckSyslevel(sPathTK||'\bin\syslevel.tlk', fQuiet,,,,, + 'IBM Developer''s Toolkit for OS/2 Warp Version 4',, + 15, '0'); + if (rc = 0) then + rc = CheckCmdOutput('sc -V', -1, fQuiet, '", Version: 2.54.'); + if (rc = 0) then + rc = CheckCmdOutput('rc', 0, fQuiet, 'IBM RC (Resource Compiler) Version 5.00.00'); + if (rc = 0) then + rc = CheckCmdOutput('ipfc', 0, fQuiet, 'Version 4.00.00'); + +return rc; + + + +/* + * OS/2 Programmers Toolkit v4.5 + */ +Toolkit45: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Toolkit (4.5) main directory. + */ + sPathTK = PathQuery('toolkit45', sToolId, sOperation); + if (sPathTK = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_TOOLKIT', sPathTK; + call EnvAddFront fRM, 'path', sPathTK'\bin;' + call EnvAddFront fRM, 'dpath', sPathTK'\book;' + call EnvAddFront fRM, 'dpath', sPathTK'\msg;' + call EnvAddFront fRM, 'beginlibpath', sPathTK'\dll;' + call EnvAddFront fRM, 'help', sPathTK'\help;' + call EnvAddFront fRM, 'bookshelf', sPathTK'\archived;' + call EnvAddFront fRM, 'bookshelf', sPathTK'\book;' + call EnvAddFront fRM, 'nlspath', sPathTK'\msg\%N;' + call EnvAddEnd fRM, 'ulspath', sPathTK'\language;' + call EnvAddFront fRM, 'include', sPathTK'\H;' +/* call EnvAddFront fRM, 'include', sPathTK'\H\GL;' */ +/* call EnvAddFront fRM, 'include', sPathTK'\SPEECH\H;' includes tend to get too long :-( */ + call EnvAddFront fRM, 'include', sPathTK'\H\RPC;' + call EnvAddFront fRM, 'include', sPathTK'\H\NETNB;' + call EnvAddFront fRM, 'include', sPathTK'\H\NETINET;' + call EnvAddFront fRM, 'include', sPathTK'\H\NET;' + call EnvAddFront fRM, 'include', sPathTK'\H\ARPA;' + call EnvAddFront fRM, 'include', sPathTK'\INC;' + call EnvAddEnd fRM, 'lib', sPathTK'\SAMPLES\MM\LIB;' + call EnvAddEnd fRM, 'lib', sPathTK'\SPEECH\LIB;' + call EnvAddFront fRM, 'lib', sPathTK'\lib;' + call EnvAddFront fRM, 'helpndx', 'EPMKWHLP.NDX+', '+' + call EnvAddFront fRM, 'ipfc', sPathTK'\ipfc;' + call EnvSet fRM, 'LANG', 'en_us' + call EnvSet fRM, 'CPREF', 'CP1.INF+CP2.INF+CP3.INF' + call EnvSet fRM, 'GPIREF', 'GPI1.INF+GPI2.INF+GPI3.INF+GPI4.INF' + call EnvSet fRM, 'MMREF', 'MMREF1.INF+MMREF2.INF+MMREF3.INF' + call EnvSet fRM, 'PMREF', 'PM1.INF+PM2.INF+PM3.INF+PM4.INF+PM5.INF' + call EnvSet fRM, 'WPSREF', 'WPS1.INF+WPS2.INF+WPS3.INF' + /* + call EnvSet fRM, 'CAT_MACHINE', 'COM1:57600' + call EnvSet fRM, 'CAT_HOST_BIN_PATH', TKMAIN'\BIN' + call EnvSet fRM, 'CAT_COMMUNICATION_TYPE', 'ASYNC_SIGBRK' + call EnvSet fRM, 'CAT_HOST_SOURCE_PATH',TKMAIN'\BIN;' + */ + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathTK'\bin\alp.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\rc.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\ipfc.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\implib.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\mkmsgf.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\mapsym.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\lib\os2386.lib', fQuiet), + | \CfgVerifyFile(sPathTK'\lib\pmbidi.lib', fQuiet), + | \CfgVerifyFile(sPathTK'\lib\tcpip32.lib', fQuiet), + | \CfgVerifyFile(sPathTK'\h\os2.h', fQuiet), + | \CfgVerifyFile(sPathTK'\h\os2win.h', fQuiet), + | \CfgVerifyFile(sPathTK'\h\stack16\pmwsock.h', fQuiet), + | FileExists(sPathTK'\som\bin\sc.exe'), + ) then + return 2; + + rc = CheckSyslevel(sPathTK||'\bin\syslevel.tlk', fQuiet,, + '5639F9300', '4.50.0', 'XR04500',, + 'IBM OS/2 Developer''s Toolkit Version 4.5',, + 15, '0'); + if (rc = 0) then + rc = CheckCmdOutput('rc', 0, fQuiet, 'IBM RC (Resource Compiler) Version 5.00.004'); + if (rc = 0) then + rc = CheckCmdOutput('ipfc', 0, fQuiet, 'Version 4.00.006 July 21 1998'); +return rc; + + +/* + * OS/2 Programmers Toolkit v4.5.1 + */ +Toolkit451: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Toolkit (4.5.1) main directory. + */ + sPathTK = PathQuery('toolkit451', sToolId, sOperation); + if (sPathTK = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_TOOLKIT', sPathTK; + call EnvAddFront fRM, 'path', sPathTK'\bin;'sPathTK'\som\common;'sPathTK'\som\bin' + call EnvAddFront fRM, 'dpath', sPathTK'\msg;'sPathTK'\book;'sPathTK'\SOM\COMMON\SYSTEM;'sPathTK'\SOM\MSG;' + call EnvAddFront fRM, 'beginlibpath', sPathTK'\dll;'sPathTK'\som\common\dll;'sPathTK'\som\lib;' + call EnvAddFront fRM, 'help', sPathTK'\help;' + call EnvAddFront fRM, 'bookshelf', sPathTK'\book;'sPathTK'\archived;' + call EnvAddFront fRM, 'somir', sPathTK'\SOM\COMMON\ETC\214\SOM.IR;' + call EnvAddEnd fRM, 'somir', sPathTK'\SAMPLES\REXX\SOM\ANIMAL\ORXSMP.IR;' + call EnvAddFront fRM, 'nlspath', sPathTK'\msg\%N;' + call EnvAddEnd fRM, 'ulspath', sPathTK'\language;' + /*call EnvAddFront fRM, 'include', sPathTK'\H\ARPA;'sPathTK'\H\NET;'sPathTK'\H\NETINET;'sPathTK'\H\NETNB;'sPathTK'\H\RPC;'sPathTK'\SPEECH\H;'sPathTK'\H\GL;'sPathTK'\H;'sPathTK'\SOM\INCLUDE;'sPathTK'\INC;'*/ + call EnvAddFront fRM, 'include', sPathTK'\H\ARPA;'sPathTK'\H\NET;'sPathTK'\H\NETINET;'sPathTK'\H\NETNB;'sPathTK'\H\RPC;'/*sPathTK'\SPEECH\H;'sPathTK'\H\GL;'*/sPathTK'\H;'sPathTK'\SOM\INCLUDE;'sPathTK'\INC;' + call EnvAddFront fRM, 'lib', sPathTK'\lib;'sPathTK'\som\lib;' + call EnvAddEnd fRM, 'lib', sPathTK'\SAMPLES\MM\LIB;'sPathTK'\SPEECH\LIB;' + call EnvAddFront fRM, 'helpndx', 'EPMKWHLP.NDX+', '+' + call EnvAddFront fRM, 'ipfc', sPathTK'\ipfc;' + call EnvSet fRM, 'sombase', sPathTK'\SOM' + call EnvSet fRM, 'somruntime', sPathTK'\SOM\COMMON' + call EnvSet fRM, 'LANG', 'en_us' + + call EnvSet fRM, 'CPREF', 'CP1.INF+CP2.INF+CP3.INF' + call EnvSet fRM, 'GPIREF', 'GPI1.INF+GPI2.INF+GPI3.INF+GPI4.INF' + call EnvSet fRM, 'MMREF', 'MMREF1.INF+MMREF2.INF+MMREF3.INF' + call EnvSet fRM, 'PMREF', 'PM1.INF+PM2.INF+PM3.INF+PM4.INF+PM5.INF' + call EnvSet fRM, 'WPSREF', 'WPS1.INF+WPS2.INF+WPS3.INF' + call EnvAddFront fRM, 'sminclude', sPathTK'\H;'sPathTK'\IDL;'sPathTK'\SOM\INCLUDE;.;' + call EnvSet fRM, 'smaddstar', '1' + call EnvSet fRM, 'smemit', 'h;ih;c' + call EnvSet fRM, 'smtmp', EnvGet('tmp'); + call EnvSet fRM, 'smclasses', 'WPTYPES.IDL' + /* + call EnvSet fRM, 'CAT_MACHINE', 'COM1:57600' + call EnvSet fRM, 'CAT_HOST_BIN_PATH', TKMAIN'\BIN' + call EnvSet fRM, 'CAT_COMMUNICATION_TYPE', 'ASYNC_SIGBRK' + call EnvSet fRM, 'CAT_HOST_SOURCE_PATH',TKMAIN'\BIN;' + */ + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathTK'\bin\alp.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\rc.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\ipfc.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\implib.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\mkmsgf.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\mapsym.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\nmake.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\nmake32.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\lib\os2386.lib', fQuiet), + | \CfgVerifyFile(sPathTK'\lib\pmbidi.lib', fQuiet), + | \CfgVerifyFile(sPathTK'\lib\tcpip32.lib', fQuiet), + | \CfgVerifyFile(sPathTK'\h\os2.h', fQuiet), + | \CfgVerifyFile(sPathTK'\h\os2win.h', fQuiet), + | \CfgVerifyFile(sPathTK'\h\stack16\pmwsock.h', fQuiet), + | \CfgVerifyFile(sPathTK'\som\bin\sc.exe', fQuiet), + ) then + return 2; + + rc = CheckSyslevel(sPathTK||'\bin\syslevel.tlk', fQuiet,, + '5639F9300', '4.50.1', 'XR04510',, + 'IBM OS/2 Developer''s Toolkit Version 4.5',, + 15, '0'); + if (rc = 0) then + rc = CheckCmdOutput('sc -V', -1, fQuiet, '", Version: 2.54.'); + if (rc = 0) then + rc = CheckCmdOutput('rc', 0, fQuiet, 'IBM RC (Resource Compiler) Version 5.00.006 Oct 20 2000'); + if (rc = 0) then + rc = CheckCmdOutput('ipfc', 0, fQuiet, 'Version 4.00.007 Oct 02 2000'); + if (rc = 0) then + rc = CheckCmdOutput('nmake -?', 0, fQuiet, 'Version 4.00.000 Oct 20 2000'); + if (rc = 0) then + rc = CheckCmdOutput('nmake32 -?', 0, fQuiet, 'Version 5.00.003 Oct 20 2000'); +return rc; + + + +/* + * OS/2 Programmers Toolkit v4.5.2 + */ +Toolkit452: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Toolkit (4.5.1) main directory. + */ + sPathTK = PathQuery('toolkit452', sToolId, sOperation); + if (sPathTK = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_TOOLKIT', sPathTK; + call EnvAddFront fRM, 'path', sPathTK'\bin;'sPathTK'\som\common;'sPathTK'\som\bin' + call EnvAddFront fRM, 'dpath', sPathTK'\msg;'sPathTK'\book;'sPathTK'\SOM\COMMON\SYSTEM;'sPathTK'\SOM\MSG;' + call EnvAddFront fRM, 'beginlibpath', sPathTK'\dll;'sPathTK'\som\common\dll;'sPathTK'\som\lib;' + call EnvAddFront fRM, 'help', sPathTK'\help;' + call EnvAddFront fRM, 'bookshelf', sPathTK'\book;'sPathTK'\archived;' + call EnvAddFront fRM, 'somir', sPathTK'\SOM\COMMON\ETC\214\SOM.IR;' + call EnvAddEnd fRM, 'somir', sPathTK'\SAMPLES\REXX\SOM\ANIMAL\ORXSMP.IR;' + call EnvAddFront fRM, 'nlspath', sPathTK'\msg\%N;' + call EnvAddEnd fRM, 'ulspath', sPathTK'\language;' + /*call EnvAddFront fRM, 'include', sPathTK'\H\ARPA;'sPathTK'\H\NET;'sPathTK'\H\NETINET;'sPathTK'\H\NETNB;'sPathTK'\H\RPC;'sPathTK'\SPEECH\H;'sPathTK'\H\GL;'sPathTK'\H;'sPathTK'\SOM\INCLUDE;'sPathTK'\INC;'*/ + /* the include mustn't be too long :-/ */ + call EnvAddFront fRM, 'include', sPathTK'\H\ARPA;'sPathTK'\H\NET;'sPathTK'\H\NETINET;'sPathTK'\H\NETNB;'sPathTK'\H\RPC;'/*sPathTK'\SPEECH\H;'sPathTK'\H\GL;'*/sPathTK'\H;'sPathTK'\SOM\INCLUDE;'sPathTK'\INC;' + call EnvAddFront fRM, 'lib', sPathTK'\lib;'sPathTK'\som\lib;' + call EnvAddEnd fRM, 'lib', sPathTK'\SAMPLES\MM\LIB;'sPathTK'\SPEECH\LIB;' + call EnvAddFront fRM, 'helpndx', 'EPMKWHLP.NDX+', '+' + call EnvAddFront fRM, 'ipfc', sPathTK'\ipfc;' + call EnvSet fRM, 'sombase', sPathTK'\SOM' + call EnvSet fRM, 'somruntime', sPathTK'\SOM\COMMON' + call EnvSet fRM, 'LANG', 'en_us' + + call EnvSet fRM, 'CPREF', 'CP1.INF+CP2.INF+CP3.INF' + call EnvSet fRM, 'GPIREF', 'GPI1.INF+GPI2.INF+GPI3.INF+GPI4.INF' + call EnvSet fRM, 'MMREF', 'MMREF1.INF+MMREF2.INF+MMREF3.INF' + call EnvSet fRM, 'PMREF', 'PM1.INF+PM2.INF+PM3.INF+PM4.INF+PM5.INF' + call EnvSet fRM, 'WPSREF', 'WPS1.INF+WPS2.INF+WPS3.INF' + call EnvAddFront fRM, 'sminclude', sPathTK'\H;'sPathTK'\IDL;'sPathTK'\SOM\INCLUDE;.;' + call EnvSet fRM, 'smaddstar', '1' + call EnvSet fRM, 'smemit', 'h;ih;c' + call EnvSet fRM, 'smtmp', EnvGet('tmp'); + call EnvSet fRM, 'smclasses', 'WPTYPES.IDL' + /* + call EnvSet fRM, 'CAT_MACHINE', 'COM1:57600' + call EnvSet fRM, 'CAT_HOST_BIN_PATH', TKMAIN'\BIN' + call EnvSet fRM, 'CAT_COMMUNICATION_TYPE', 'ASYNC_SIGBRK' + call EnvSet fRM, 'CAT_HOST_SOURCE_PATH',TKMAIN'\BIN;' + */ + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathTK'\bin\alp.exe', fQuiet), + /*| \CfgVerifyFile(sPathTK'\bin\rc.exe', fQuiet)*/, + | \CfgVerifyFile(sPathTK'\bin\rc16.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\ipfc.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\implib.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\mkmsgf.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\mapsym.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\nmake.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\bin\nmake32.exe', fQuiet), + | \CfgVerifyFile(sPathTK'\lib\os2386.lib', fQuiet), + | \CfgVerifyFile(sPathTK'\lib\pmbidi.lib', fQuiet), + | \CfgVerifyFile(sPathTK'\lib\tcpip32.lib', fQuiet), + | \CfgVerifyFile(sPathTK'\h\os2.h', fQuiet), + | \CfgVerifyFile(sPathTK'\h\os2win.h', fQuiet), + | \CfgVerifyFile(sPathTK'\h\stack16\pmwsock.h', fQuiet), + | \CfgVerifyFile(sPathTK'\som\bin\sc.exe', fQuiet), + ) then + return 2; + + rc = CheckSyslevel(sPathTK||'\bin\syslevel.tlk', fQuiet,, + '5639F9300', '4.50.2', 'XR04520',, + 'IBM OS/2 Developer''s Toolkit Version 4.5',, + 15, '0'); + if (rc = 0) then + rc = CheckCmdOutput('sc -V', -1, fQuiet, '", Version: 2.54.'); + /*if (rc = 0) then + rc = CheckCmdOutput('rc', 1, fQuiet, 'Version 4.00.011 Oct 04 2001');*/ + if (rc = 0) then + rc = CheckCmdOutput('rc16', 1, fQuiet, 'Version 4.00.011 Oct 04 2001'); + if (rc = 0) then + rc = CheckCmdOutput('ipfc', 0, fQuiet, 'Version 4.00.007 Oct 02 2000'); + if (rc = 0) then + rc = CheckCmdOutput('nmake -?', 0, fQuiet, 'Version 4.00.001 Oct 4 2001'); + if (rc = 0) then + rc = CheckCmdOutput('nmake32 -?', 0, fQuiet, 'Version 5.00.003 Oct 4 2001'); +return rc; + + + +/** + * This will envolve into an full UNIX like environment some day perhaps... + */ +Unix: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * Unix root directory and XFree86 main directory. + */ + sUnixBack = PathQuery('unixroot', sToolId, sOperation); + if (sUnixBack = '') then + return 1; + sXF86Back = PathQuery('xfree86', sToolId, sOperation); + if (sXF86Back = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + sUnixForw = translate(sUnixBack, '/', '\'); + call EnvSet fRM, 'PATH_UNIX', sUnixBack + call EnvSet fRM, 'unixroot', sUnixBack + call EnvAddFront fRM, 'path', sUnixBack'\bin;'sUnixBack'\usr\local\bin;' + call EnvAddFront fRM, 'beginlibpath', sUnixBack'\dll;' + call EnvSet fRM, 'groff_font_path', sUnixForw'/lib/groff/font' + call EnvSet fRM, 'groff_tmac_path', sUnixForw'/lib/groff/tmac' + call EnvSet fRM, 'refer', sUnixForw'/lib/groff/dict/papers/ind' + +/* call EnvSet fRM, 'editor', 'TEDIT' - don't change it */ + + sXF86Forw = translate(sXF86Back, '/', '\'); + call EnvSet fRM, 'PATH_XFREE86', sXF86Back + call EnvAddFront fRM, 'C_INCLUDE_PATH', sXF86Forw'/include' + call EnvAddFront fRM, 'CPLUS_INCLUDE_PATH', sXF86Forw'/include' + call EnvSet fRM, 'OBJC_INCLUDE_PATH', sXF86Forw'/include' + call EnvAddFront fRM, 'LIBRARY_PATH', sXF86Forw'/lib' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sUnixBack'\bin\bash.exe', fQuiet, 1), + | \CfgVerifyFile(sUnixBack'\bin\sh.exe', fQuiet), + | \CfgVerifyFile(sUnixBack'\bin\yes.exe', fQuiet), + | \CfgVerifyFile(sUnixBack'\bin\rm.exe', fQuiet), + | \CfgVerifyFile(sUnixBack'\bin\cp.exe', fQuiet, 1), + | \CfgVerifyFile(sUnixBack'\bin\mv.exe', fQuiet. 1), + | \CfgVerifyFile(sXF86Back'\bin\xf86config.exe', fQuiet, 1), + ) then + return 2; +return 0; + + + +/* + * IBM Visual Age for C++ v3.08 for OS/2 + */ +VAC308: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * IBM Visual Age for C++ Version 3.08 main directory. + */ + sPathCPP = PathQuery('vac308', sToolId, sOperation); + if (sPathCPP = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_VAC308', sPathCPP + call EnvSet fRM, 'CCENV', 'VAC3' + call EnvSet fRM, 'BUILD_ENV', 'VAC308' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + + call EnvAddFront fRM, 'beginlibpath', sPathCPP'\DLL;'sPathCPP'\SAMPLES\TOOLKIT\DLL;' + call EnvAddFront fRM, 'path', sPathCPP'\BIN;'sPathCPP'\SMARTS\SCRIPTS;'sPathCPP'\HELP;' + call EnvAddFront fRM, 'dpath', sPathCPP'\HELP;'sPathCPP';'sPathCPP'\LOCALE;'sPathCPP'\MACROS;'sPathCPP'\BND;' + call EnvAddFront fRM, 'help', sPathCPP'\HELP;'sPathCPP'\SAMPLES\TOOLKIT\HELP;' + call EnvAddFront fRM, 'bookshelf', sPathCPP'\HELP;' + call EnvAddFront fRM, 'somir', sPathCPP'\ETC\SOM.IR;' + call EnvAddFront fRM, 'cpphelp_ini', 'C:\OS2\SYSTEM' + call EnvAddFront fRM, 'locpath', sPathCPP'\LOCALE;%LOCPATH%;' + call EnvAddFront fRM, 'include', sPathCPP'\INCLUDE;'sPathCPP'\INCLUDE\OS2;'sPathCPP'\INC;'sPathCPP'\INCLUDE\SOM;' + call EnvAddFront fRM, 'sminclude', sPathCPP'\INCLUDE\OS2;'sPathCPP'\INCLUDE;'sPathCPP'\INCLUDE\SOM;' + + call EnvAddFront fRM, 'vbpath', '.;'sPathCPP'\DDE4VB;' + call EnvSet fRM, 'tmpdir', EnvGet('tmp') + call EnvSet fRM, 'lxevfref', 'EVFELREF.INF+LPXCREF.INF' + call EnvSet fRM, 'lxevfhdi', 'EVFELHDI.INF+LPEXHDI.INF' + call EnvAddFront fRM, 'lpath', sPathCPP'\MACROS;' + call EnvAddFront fRM, 'codelpath', sPathCPP'\CODE\MACROS;'sPathCPP'\MACROS;' + call EnvSet fRM, 'clref', 'CPPCLRF.INF+CPPDAT.INF+CPPAPP.INF+CPPWIN.INF+CPPCTL.INF+CPPADV.INF+CPP2DG.INF+CPPDDE.INF+CPPDM.INF+CPPMM.INF+CPPCLRB.INF' + call EnvAddFront fRM, 'ipfc', sPathCPP'\IPFC' + call EnvAddFront fRM, 'lib', sPathCPP'\LIB;'sPathCPP'\DLL;' + call EnvSet fRM, 'cpplocal', sPathCPP + call EnvSet fRM, 'cppmain', sPathCPP + call EnvSet fRM, 'cppwork', sPathCPP + call EnvSet fRM, 'iwf.default_prj','CPPDFTPRJ' + + call EnvSet fRM, 'iwf.solution_lang_support', 'CPPIBS30;ENG' + call EnvSet fRM, 'vacpp_shared' 'FALSE' + call EnvSet fRM, 'iwfhelp', 'IWFHDI.INF' + call EnvSet fRM, 'iwfopt', sPathCPP + + call EnvSet fRM, 'somruntime', sPathCPP'\DLL' + call EnvSet fRM, 'smaddstar', '1' + call EnvSet fRM, 'smemit', 'h;ih;c' + call EnvSet fRM, 'sombase', sPathCPP + call EnvSet fRM, 'smtmp', EnvGet('tmp') + call EnvSet fRM, 'smclasses', 'WPTYPES.IDL' + + call EnvAddFront fRM, 'helpndx', 'EPMKWHLP.NDX+CPP.NDX+CPPBRS.NDX', '+' + call EnvAddFront fRM, 'ipf_keys', 'SHOWNAV' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathCPP'\bin\icc.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\bin\ilib.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\bin\ilink.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\bin\icsperf.exe', fQuiet,1), + | \CfgVerifyFile(sPathCPP'\bin\icsdebug.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\bin\cppfilt.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\bin\dllrname.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\lib\demangl.lib', fQuiet), + | \CfgVerifyFile(sPathCPP'\lib\cppom30.lib', fQuiet), + | \CfgVerifyFile(sPathCPP'\lib\cppom30i.lib', fQuiet), + | \CfgVerifyFile(sPathCPP'\lib\cppom30o.lib', fQuiet), + | \CfgVerifyFile(sPathCPP'\lib\cppon30i.lib', fQuiet), + | \CfgVerifyFile(sPathCPP'\lib\cppon30o.lib', fQuiet), + | \CfgVerifyFile(sPathCPP'\lib\_doscall.lib', fQuiet, 1), + | \CfgVerifyFile(sPathCPP'\lib\_pmwin.lib', fQuiet, 1), + | \CfgVerifyFile(sPathCPP'\include\builtin.h', fQuiet), + | \CfgVerifyFile(sPathCPP'\include\conio.h', fQuiet), + | \CfgVerifyFile(sPathCPP'\include\ismkss.h', fQuiet), + | FileExists(sPathCPP'\include\os2.h'), + | FileExists(sPathCPP'\include\os2win.h'), + | FileExists(sPathCPP'\include\pm.h'), + | \CfgVerifyFile(sPathCPP'\include\sys\utime.h', fQuiet), + | \CfgVerifyFile(sPathCPP'\help\cpplib.inf', fQuiet), + ) then + return 2; + + + rc = CheckSyslevel(sPathCPP||'\syslevel\syslevel.ct3', fQuiet,'562201703',,'CTC308',); + if (rc = 0) then + rc = CheckSyslevel(sPathCPP||'\syslevel\syslevel.ct4', fQuiet,'562201704',,'CTU308',); + /*if (rc = 0) then + rc = CheckCmdOutput('syslevel '||sPathCPP||'\syslevel', 0, fQuiet, 'Version 3.00 Component ID 562201707'||'0d0a'x||'Current CSD level: CTV308'); + if (rc = 0) then + rc = CheckSyslevel(sPathCPP||'\syslevel\syslevel.ct8', fQuiet,'562201708',,'CTD308',); + */ + if (rc = 0) then + rc = CheckSyslevel(sPathCPP||'\syslevel\syslevel.wf5', fQuiet,'562201605',,'CTC308',); + /*if (rc = 0) then + rc = CheckSyslevel(sPathCPP||'\syslevel\syslevel.wf2', fQuiet,'562201602',,'CTO308',); + */ + if (rc = 0) then + rc = CheckCmdOutput('icc', 0, fQuiet, 'IBM VisualAge C++ for OS/2, Version 3'); + if (rc = 0) then + rc = CheckCmdOutput('ilink', 16, fQuiet, 'IBM(R) Linker for OS/2(R), Version 01.08.r1a_CTC308c'); + if (rc = 0) then + rc = CheckCmdOutput('ilib /?', 8, fQuiet, 'IBM(R) Library Manager for OS/2(R), Version 01.00.03 cc_CTC308c'); +return rc; + + + +/* + * Visual Age / C and C++ tools v3.6.5 for OS/2 + */ +VAC365: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * IBM C/C++ Compiler and Tools Version 3.6.5 main directory. + */ + sPathCxx = PathQuery('vac365', sToolId, sOperation); + if (sPathCxx = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_VAC365', sPathCxx; + call EnvSet fRM, 'CCENV', 'VAC36' + call EnvSet fRM, 'BUILD_ENV', 'VAC365' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + + call EnvSet fRM, 'cxxmain', sPathCxx; + call EnvAddFront fRM, 'path', sPathCxx'\bin;' + call EnvAddFront fRM, 'dpath', sPathCxx'\local;'sPathCxx'\help;' + call EnvAddFront fRM, 'beginlibpath',sPathCxx'\dll;'sPathCxx'\runtime;' + call EnvAddFront fRM, 'nlspath', sPathCxx'\msg\%N;' + call EnvAddFront fRM, 'include', sPathCxx'\include;' + call EnvAddFront fRM, 'lib', sPathCxx'\lib;' + call EnvAddFront fRM, 'ipfc', sPathCxx'\ipfc;' + call EnvSet fRM, 'LANG', 'en_us' + call EnvSet fRM, 'CPP_DBG_LANG', 'CPP' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathCxx'\bin\icc.exe', fQuiet), + | \CfgVerifyFile(sPathCxx'\bin\ilib.exe', fQuiet), + | \CfgVerifyFile(sPathCxx'\bin\ilink.exe', fQuiet), + | \CfgVerifyFile(sPathCxx'\bin\idebug.exe', fQuiet), + | \CfgVerifyFile(sPathCxx'\bin\cppfilt.exe', fQuiet), + | \CfgVerifyFile(sPathCxx'\bin\dllrname.exe', fQuiet), + | \CfgVerifyFile(sPathCxx'\bin\cppcbe36.exe', fQuiet), + | \CfgVerifyFile(sPathCxx'\lib\cpprms36.lib', fQuiet), + | \CfgVerifyFile(sPathCxx'\lib\cpprmi36.lib', fQuiet), + | \CfgVerifyFile(sPathCxx'\lib\cpprmo36.lib', fQuiet), + | \CfgVerifyFile(sPathCxx'\lib\cpprni36.lib', fQuiet), + | \CfgVerifyFile(sPathCxx'\lib\cpprds36.lib', fQuiet), + | \CfgVerifyFile(sPathCxx'\include\builtin.h', fQuiet), + | \CfgVerifyFile(sPathCxx'\include\conio.h', fQuiet), + | \CfgVerifyFile(sPathCxx'\include\ismavl.h', fQuiet), + | FileExists(sPathCxx'\include\os2.h'), + | FileExists(sPathCxx'\include\os2win.h'), + | FileExists(sPathCxx'\include\pm.h'), + | \CfgVerifyFile(sPathCxx'\include\sys\utime.h', fQuiet), + | \CfgVerifyFile(sPathCxx'\help\cpplbm36.msg', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('icc', 0, fQuiet, 'IBM* C and C++ Compilers for OS/2*, AIX* and for Windows NT**, Version 3.6'); + if (rc = 0) then + rc = CheckCmdOutput('ilink', 16, fQuiet, 'IBM(R) Linker for OS/2(R), Version 03.06.PPK1010917.011116ilink'); + if (rc = 0) then + rc = CheckCmdOutput('ilib /?', 0, fQuiet, 'IBM Librarian for OS/2(R) Version 03.99.PPK1001123'); + if (stream(sPathCxx'\bin\cppcbe36.exe', 'c', 'query size') <> 603122) then + do + say 'Error!!! Get latest vac365 optimizer fixes from the OS2 Mozilla project.'; + say ' http://www.mozilla.org/ports/os2/setup.html'; + rc = 99; + end +return rc; + + +/* + * Visual Age for C++ v4.0 for OS/2 + */ +VAC40: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * IBM VisualAge for C++ v4.0 main directory. + */ + sPathCPP = PathQuery('vac40', sToolId, sOperation); + if (sPathCPP = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_VAC40', sPathCPP; + call EnvSet fRM, 'CCENV', 'VAC40' + call EnvSet fRM, 'BUILD_ENV', 'VAC40' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + + call EnvAddFront fRM, 'path', sPathCPP'\bin;' + call EnvAddFront fRM, 'dpath', sPathCPP'\etc;'sPathCPP'\help;' + call EnvAddFront fRM, 'beginlibpath',sPathCPP'\dll;'sPathCPP'\runtime;' + call EnvAddFront fRM, 'help', sPathCPP'\help;' + call EnvAddFront fRM, 'nlspath', sPathCPP'\msg\%N;' + call EnvAddFront fRM, 'locpath', sPathCPP'\locale;'sPathCPP'\runtime\locale;' + call EnvAddFront fRM, 'include', sPathCPP'\ivb;'sPathCPP'\include;' + call EnvAddFront fRM, 'lib', sPathCPP'\lib;' + call EnvAddFront fRM, 'ipfc', sPathCPP'\bin;' + call EnvAddFront fRM, 'cpplpath4', sPathCPP'\macros;' + call EnvSet fRM, 'system_ice', sPathCPP'\etc\system.ice' + call EnvSet fRM, 'vbpath', sPathCPP'\ivb' + call EnvSet fRM, 'vacppmain', sPathCPP; + call EnvSet fRM, 'os2', '1' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathCPP'\bin\iccv4.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\bin\ilib.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\bin\ire.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\bin\vacide.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\bin\cppfilt.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\bin\dllrname.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\bin\patrace.exe', fQuiet), + | \CfgVerifyFile(sPathCPP'\lib\cpprms40.lib', fQuiet), + | \CfgVerifyFile(sPathCPP'\lib\cpprmi40.lib', fQuiet), + | \CfgVerifyFile(sPathCPP'\lib\cpprmo40.lib', fQuiet), + | \CfgVerifyFile(sPathCPP'\lib\cpprni40.lib', fQuiet), + | \CfgVerifyFile(sPathCPP'\lib\cpprds40.lib', fQuiet), + | \CfgVerifyFile(sPathCPP'\include\builtin.h', fQuiet), + | \CfgVerifyFile(sPathCPP'\include\conio.h', fQuiet), + | \CfgVerifyFile(sPathCPP'\include\ismavl.h', fQuiet), + | FileExists(sPathCPP'\include\os2.h'), + | FileExists(sPathCPP'\include\os2win.h'), + | FileExists(sPathCPP'\include\pm.h'), + | \CfgVerifyFile(sPathCPP'\include\sys\utime.h', fQuiet), + | \CfgVerifyFile(sPathCPP'\help\cpplbm40.msg', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('iccv4', 0, fQuiet, 'IBM VisualAge for C++ Version 4.0 C Compiler'); + if (rc = 0) then + rc = CheckCmdOutput('ilib /?', 0, fQuiet, 'IBM Librarian for OS/2(R) Version 03.99.cc_981110'); /* is this really FP2?????? */ + if (rc = 0) then + rc = CheckCmdOutput('vacbld -?', 0, fQuiet, 'IBM(R) VisualAge(R) C++ Professional, Version 4.0 (981117)'); /* is this really FP2?????? */ +return rc; + + + + +/* + * WarpIn + */ +WarpIn: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet + + /* + * WarpIn main directory. + */ + sPathWarpIn = PathQuery('warpin', sToolId, sOperation); + if (sPathWarpIn = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_WARPIN', sPathWarpIn; + call EnvAddFront fRM, 'path', sPathWarpIn';' + call EnvAddFront fRM, 'beginlibpath',sPathWarpIn';' + call EnvAddFront fRM, 'bookshelf', sPathWarpIn';' + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathWarpIn'\wic.exe', fQuiet), + | \CfgVerifyFile(sPathWarpIn'\wpirtl.dll', fQuiet), + | \CfgVerifyFile(sPathWarpIn'\warpin.exe', fQuiet), + ) then + return 2; + rc = CheckCmdOutput('wic', 1, fQuiet, '2002 - WarpIn archive creation and maintenance'); +return rc; + + + +/* + * Watcom C/C++ v11.0 + */ +WatcomC11: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet, iBits + + /* + * Watcom C/C++ v11.0 main directory + */ + sPathWatcom = PathQuery('watcom11', sToolId, sOperation); + if (sPathWatcom = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_WATCOM', sPathWatcom + call EnvSet fRM, 'CCENV', 'WAT' + call EnvSet fRM, 'BUILD_ENV', 'WAT11' + if (iBits == 16) then + call EnvSet fRM, 'BUILD_ENV', 'WAT11-16' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + + call EnvSet fRM, 'watcom', sPathWatcom + call EnvAddFront fRM, 'path', sPathWatcom'\binp;'sPathWatcom'\binw;' + call EnvAddFront fRM, 'beginlibpath',sPathWatcom'\binp\dll;' + call EnvAddFront fRM, 'help', sPathWatcom'\binp\help;' + call EnvAddEnd fRM, 'bookshelf', sPathWatcom'\binp\help;' + call EnvAddFront fRM, 'include', sPathWatcom'\h;'sPathWatcom'\h\os2;'sPathWatcom'\h\nt;' + call EnvAddFront fRM, 'lib', sPathWatcom'\lib386;'sPathWatcom'\lib386\os2;'sPathWatcom'\lib286;'sPathWatcom'\lib286\os2;' + call EnvSet fRM, 'edpath', sPathWatcom'EDDAT;' + /* + rem detach %watcom%\BINP\BATSERV.EXE + rem detach %watcom%\BINP\NMPBIND.EXE + */ + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathWatcom'\binp\wpp.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\binp\wcc.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\binp\wcc386.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\binp\wpp386.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\binp\wlink.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\lib286\os2\os2.lib', fQuiet), + | \CfgVerifyFile(sPathWatcom'\lib386\os2\clbrdll.lib', fQuiet), + | \CfgVerifyFile(sPathWatcom'\lib386\os2\clib3r.lib', fQuiet), + | \CfgVerifyFile(sPathWatcom'\lib386\nt\kernel32.lib', fQuiet,1), + | \CfgVerifyFile(sPathWatcom'\lib386\nt\clbrdll.lib', fQuiet,1), + | \CfgVerifyFile(sPathWatcom'\lib386\nt\clib3r.lib', fQuiet,1), + ) then + return 2; + rc = CheckCmdOutput('wcc', 8, fQuiet, 'Watcom C16 Optimizing Compiler Version 11.0 '||'0d0a'x); + if (rc = 0) then + rc = CheckCmdOutput('wpp', 8, fQuiet, 'Watcom C++16 Optimizing Compiler Version 11.0 '||'0d0a'x); + if (rc = 0) then + rc = CheckCmdOutput('wcc386', 8, fQuiet, 'Watcom C32 Optimizing Compiler Version 11.0 '||'0d0a'x); + if (rc = 0) then + rc = CheckCmdOutput('wpp386', 8, fQuiet, 'Watcom C++32 Optimizing Compiler Version 11.0 '||'0d0a'x); + if (rc = 0) then + rc = CheckCmdOutput('wlink form ELF', 1, fQuiet, 'WATCOM Linker Version 11.0'||'0d0a'x); +return rc; + + +/* + * Watcom C/C++ v11.0c + */ +WatcomC11c: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet, iBits + + /* + * Watcom C/C++ v11.0c main directory + */ + sPathWatcom = PathQuery('watcom11c', sToolId, sOperation); + if (sPathWatcom = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_WATCOM', sPathWatcom + call EnvSet fRM, 'CCENV', 'WAT' + call EnvSet fRM, 'BUILD_ENV', 'WAT11C' + if (iBits = 16) then + call EnvSet fRM, 'BUILD_ENV', 'WAT11C-16' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + + call EnvSet fRM, 'watcom', sPathWatcom + call EnvAddFront fRM, 'path', sPathWatcom'\binp;'sPathWatcom'\binw;' + call EnvAddFront fRM, 'beginlibpath',sPathWatcom'\binp\dll;' + call EnvAddFront fRM, 'help', sPathWatcom'\binp\help;' + call EnvAddEnd fRM, 'bookshelf', sPathWatcom'\binp\help;' + if (iBits = 16) then + call EnvAddFront fRM, 'include', sPathWatcom'\h;'sPathWatcom'\h\os21x;' + else + call EnvAddFront fRM, 'include', sPathWatcom'\h;'sPathWatcom'\h\os2;'sPathWatcom'\h\nt;' + call EnvAddFront fRM, 'lib', sPathWatcom'\lib386;'sPathWatcom'\lib386\os2;'sPathWatcom'\lib286;'sPathWatcom'\lib286\os2;' + call EnvSet fRM, 'edpath', sPathWatcom'EDDAT;' + /* + rem detach %watcom%\BINP\BATSERV.EXE + rem detach %watcom%\BINP\NMPBIND.EXE + */ + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathWatcom'\binp\wpp.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\binp\wcc.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\binp\wcc386.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\binp\wpp386.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\binp\wlink.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\lib286\os2\os2.lib', fQuiet, 1), + | \CfgVerifyFile(sPathWatcom'\lib386\os2\clbrdll.lib', fQuiet), + | \CfgVerifyFile(sPathWatcom'\lib386\os2\clib3r.lib', fQuiet), + | \CfgVerifyFile(sPathWatcom'\lib386\nt\kernel32.lib', fQuiet, 1), + | \CfgVerifyFile(sPathWatcom'\lib386\nt\clbrdll.lib', fQuiet, 1), + | \CfgVerifyFile(sPathWatcom'\lib386\nt\clib3r.lib', fQuiet, 1), + ) then + return 2; + rc = CheckCmdOutput('wcc', 8, fQuiet, 'Watcom C16 Optimizing Compiler Version 11.0c'); + if (rc = 0) then + rc = CheckCmdOutput('wpp', 8, fQuiet, 'Watcom C++16 Optimizing Compiler Version 11.0c'); + if (rc = 0) then + rc = CheckCmdOutput('wcc386', 8, fQuiet, 'Watcom C32 Optimizing Compiler Version 11.0c'); + if (rc = 0) then + rc = CheckCmdOutput('wpp386', 8, fQuiet, 'Watcom C++32 Optimizing Compiler Version 11.0c'); + if (rc = 0) then + rc = CheckCmdOutput('wlink form ELF', 1, fQuiet, 'WATCOM Linker Version 11.0c'); +return rc; + + +/* + * Open Watcom C/C++ v1.4 and higher + */ +OpenWatcomC14: procedure expose aCfg. aPath. + parse arg sToolId,sOperation,fRM,fQuiet, iBits + + /* + * Watcom C/C++ v1.4 (and higher) main directory + */ + sPathId = sToolId; + if (pos('-', sToolId) > 0) then + sPathId = substr(sToolId, 1, pos('-', sToolId)); + sPathWatcom = PathQuery(sPathId, sToolId, sOperation); + if (sPathWatcom = '') then + return 1; + /* If config operation we're done now. */ + if (pos('config', sOperation) > 0) then + return 0; + + /* + * Installing the environment variables. + */ + call EnvSet fRM, 'PATH_WATCOM', sPathWatcom + call EnvSet fRM, 'CCENV', 'WAT' + call EnvSet fRM, 'BUILD_ENV', 'OW14' + if (iBits = 16) then + call EnvSet fRM, 'BUILD_ENV', 'OW14-16' + call EnvSet fRM, 'BUILD_PLATFORM', 'OS2' + + call EnvSet fRM, 'watcom', sPathWatcom + call EnvAddFront fRM, 'path', sPathWatcom'\binp;'sPathWatcom'\binw;' + call EnvAddFront fRM, 'beginlibpath',sPathWatcom'\binp\dll;' + call EnvAddFront fRM, 'help', sPathWatcom'\binp\help;' + call EnvAddEnd fRM, 'bookshelf', sPathWatcom'\binp\help;' + if (iBits = 16) then + call EnvAddFront fRM, 'include', sPathWatcom'\h;'sPathWatcom'\h\os21x;' + else + call EnvAddFront fRM, 'include', sPathWatcom'\h;'sPathWatcom'\h\os2;'sPathWatcom'\h\nt;' + call EnvAddFront fRM, 'lib', sPathWatcom'\lib386;'sPathWatcom'\lib386\os2;'sPathWatcom'\lib286;'sPathWatcom'\lib286\os2;' + call EnvSet fRM, 'edpath', sPathWatcom'EDDAT;' + /* + rem detach %watcom%\BINP\BATSERV.EXE + rem detach %watcom%\BINP\NMPBIND.EXE + */ + + /* + * Verify. + */ + if (pos('verify', sOperation) <= 0) then + return 0; + if ( \CfgVerifyFile(sPathWatcom'\binp\wpp.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\binp\wcc.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\binp\wcc386.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\binp\wpp386.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\binp\wlink.exe', fQuiet), + | \CfgVerifyFile(sPathWatcom'\lib286\os2\os2.lib', fQuiet, 1), + | \CfgVerifyFile(sPathWatcom'\lib386\os2\clbrdll.lib', fQuiet), + | \CfgVerifyFile(sPathWatcom'\lib386\os2\clib3r.lib', fQuiet), + | \CfgVerifyFile(sPathWatcom'\lib386\nt\kernel32.lib', fQuiet, 1), + | \CfgVerifyFile(sPathWatcom'\lib386\nt\clbrdll.lib', fQuiet, 1), + | \CfgVerifyFile(sPathWatcom'\lib386\nt\clib3r.lib', fQuiet, 1), + ) then + return 2; + rc = CheckCmdOutput('wcc', 8, fQuiet, 'Open Watcom C16 Optimizing Compiler Version 1.4'); + if (rc = 0) then + rc = CheckCmdOutput('wpp', 8, fQuiet, 'Open Watcom C++16 Optimizing Compiler Version 1.4'); + if (rc = 0) then + rc = CheckCmdOutput('wcc386', 8, fQuiet, 'Open Watcom C32 Optimizing Compiler Version 1.4'); + if (rc = 0) then + rc = CheckCmdOutput('wpp386', 8, fQuiet, 'Open Watcom C++32 Optimizing Compiler Version 1.4'); + if (rc = 0) then + rc = CheckCmdOutput('wlink form ELF', 1, fQuiet, 'Open Watcom Linker Version 1.4'); +return rc; + diff --git a/tools/bin/lxlite.cmd b/tools/bin/lxlite.cmd index 2bbb443..3460f79 100644 --- a/tools/bin/lxlite.cmd +++ b/tools/bin/lxlite.cmd @@ -1,22 +1,22 @@ -/* $Id: lxlite.cmd,v 1.1 2002-08-24 22:33:46 bird Exp $ - * - * LXLite wrapper to fix EA problem on LAN Server volumes with JFS. - * - * Copyright (c) 2002 knut st. osmundsen (bird@anduin.net) - * - */ - -/* get input&output filename */ -parse arg sFilename - -/* get lxlite directory */ -parse source . . sSource -sDir = filespec('drive', sSource) || filespec('path', sSource); - -/* stripp of EAs to avoid errors */ -'eautil' sFilename 'nul /s' - -/* call lxlite */ -sDir||'lxlite.exe' sFilename -return rc; - +/* $Id: lxlite.cmd,v 1.1 2002-08-24 22:33:46 bird Exp $ + * + * LXLite wrapper to fix EA problem on LAN Server volumes with JFS. + * + * Copyright (c) 2002 knut st. osmundsen (bird@anduin.net) + * + */ + +/* get input&output filename */ +parse arg sFilename + +/* get lxlite directory */ +parse source . . sSource +sDir = filespec('drive', sSource) || filespec('path', sSource); + +/* stripp of EAs to avoid errors */ +'eautil' sFilename 'nul /s' + +/* call lxlite */ +sDir||'lxlite.exe' sFilename +return rc; + diff --git a/tools/bin/mapsymWat.cmd b/tools/bin/mapsymWat.cmd index 6590865..55b387f 100644 --- a/tools/bin/mapsymWat.cmd +++ b/tools/bin/mapsymWat.cmd @@ -1,92 +1,92 @@ -/* $Id: mapsymWat.cmd,v 1.1 2000-11-21 04:34:58 bird Exp $ - * - * Script which makes .sym file from Watcom Map file. - * Requires: wat2map - which didn't work. - * Currently it only make a dummy .sym file. - * - * Copyright (c) 2000 knut st. osmundsen (knut.stange.osmundsen@mynd.no) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - -/* - * Parse input and make sSym filename. - */ -parse arg sMap sDummy - -iExtPos = lastpos('.', sMap); -if (sMap = '' | substr(sMap, 1, 1) = '-' | iExtPos <= 0 | sDummy <> '') then -do - say 'syntax error'; - say 'mapsymWat.cmd '; - exit(1); -end -sSym = substr(sMap, 1, iExtPos)||'sym'; - -/* - * Determin temporary directory. - */ -sTmp = VALUE('TMP',,'OS2ENVIRONMENT'); -if (sTmp = '') then - sTmp = VALUE('TEMP',,'OS2ENVIRONMENT'); -if (sTmp = '') then - sTmp = '.'; - -/* - * Make temporary filename. - */ -call RxFuncAdd 'SysTempFileName', 'RexxUtil', 'SysTempFileName' -call RxFuncAdd 'SysFileDelete', 'RexxUtil', 'SysFileDelete' -/* start: remove this code when the rest of the scrip is working again. */ -call SysFileDelete sSym; -call stream sSym, 'c', 'open write'; -call stream sSym, 'c', 'close'; -exit(0); -/* end */ -sTempFile = SysTempFileName(sTmp'\mapsymw.???'); -if (sTempFile = '') then -do - say 'error: failed to make temporary file!'; - exit(2); -end -sTempSymFile = substr(sTempFile, 1, length(sTempFile)-3)||'sym'; - -/* - * Convert the Watcom mapfile to a mapfile mapsym likes. - */ -'wat2map' sMap sTempFile -if (rc <> 0) then do - say 'error: Wat2Map failed with rc='rc'.'; - exit(rc); -end - -/* - * Run mapsym. - */ -sOldDir = directory(); -call directory(sTmp); -'mapsym' sTempFile -retrc = rc; -call directory(sOldDir); -if (retrc <> 0) then -do - say 'error: mapsym failed with rc='rc'.'; - call SysFileDelete sTempFile - call SysFileDelete sTempSymFile - exit(retrc); -end - -/* - * Copy result sym file to target sym file. - */ -'copy' sTempSymFile sSym -retrc = rc; -if (rc <> 0) then - say 'error: copy failed with rc='rc'.'; - -/* Cleanup and exit */ -call SysFileDelete sTempFile -call SysFileDelete sTempSymFile -exit(retrc); - +/* $Id: mapsymWat.cmd,v 1.1 2000-11-21 04:34:58 bird Exp $ + * + * Script which makes .sym file from Watcom Map file. + * Requires: wat2map - which didn't work. + * Currently it only make a dummy .sym file. + * + * Copyright (c) 2000 knut st. osmundsen (knut.stange.osmundsen@mynd.no) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + +/* + * Parse input and make sSym filename. + */ +parse arg sMap sDummy + +iExtPos = lastpos('.', sMap); +if (sMap = '' | substr(sMap, 1, 1) = '-' | iExtPos <= 0 | sDummy <> '') then +do + say 'syntax error'; + say 'mapsymWat.cmd '; + exit(1); +end +sSym = substr(sMap, 1, iExtPos)||'sym'; + +/* + * Determin temporary directory. + */ +sTmp = VALUE('TMP',,'OS2ENVIRONMENT'); +if (sTmp = '') then + sTmp = VALUE('TEMP',,'OS2ENVIRONMENT'); +if (sTmp = '') then + sTmp = '.'; + +/* + * Make temporary filename. + */ +call RxFuncAdd 'SysTempFileName', 'RexxUtil', 'SysTempFileName' +call RxFuncAdd 'SysFileDelete', 'RexxUtil', 'SysFileDelete' +/* start: remove this code when the rest of the scrip is working again. */ +call SysFileDelete sSym; +call stream sSym, 'c', 'open write'; +call stream sSym, 'c', 'close'; +exit(0); +/* end */ +sTempFile = SysTempFileName(sTmp'\mapsymw.???'); +if (sTempFile = '') then +do + say 'error: failed to make temporary file!'; + exit(2); +end +sTempSymFile = substr(sTempFile, 1, length(sTempFile)-3)||'sym'; + +/* + * Convert the Watcom mapfile to a mapfile mapsym likes. + */ +'wat2map' sMap sTempFile +if (rc <> 0) then do + say 'error: Wat2Map failed with rc='rc'.'; + exit(rc); +end + +/* + * Run mapsym. + */ +sOldDir = directory(); +call directory(sTmp); +'mapsym' sTempFile +retrc = rc; +call directory(sOldDir); +if (retrc <> 0) then +do + say 'error: mapsym failed with rc='rc'.'; + call SysFileDelete sTempFile + call SysFileDelete sTempSymFile + exit(retrc); +end + +/* + * Copy result sym file to target sym file. + */ +'copy' sTempSymFile sSym +retrc = rc; +if (rc <> 0) then + say 'error: copy failed with rc='rc'.'; + +/* Cleanup and exit */ +call SysFileDelete sTempFile +call SysFileDelete sTempSymFile +exit(retrc); + diff --git a/tools/bin/runmapsym.cmd b/tools/bin/runmapsym.cmd index 8398d43..8e199b9 100644 --- a/tools/bin/runmapsym.cmd +++ b/tools/bin/runmapsym.cmd @@ -1,162 +1,162 @@ -/* REXX */ -/* - * Works around stupid mapsym dumbness regarding the output .sym path. - * - * (c) too simple to be copyrighted - */ - -'@echo off' - -if (RxFuncQuery('SysLoadFuncs')) then do - call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs' - call SysLoadFuncs -end - -parse arg aArgs -call TokenizeString aArgs, 'G.!args' - -if (G.!args.0 < 3) then do - say "Usage: runmapsym " - exit 255 -end - -aMapSymEXE = translate(G.!args.1, '\' , '/') -aMapFile = translate(G.!args.2, '\' , '/') -aSymFile = translate(G.!args.3, '\' , '/') - -curDir = directory() - -mapSymExeDir = filespec('D', aMapSymEXE)||filespec('P', aMapSymEXE) -if (mapSymExeDir \== '') then do - if (right(mapSymExeDir, 2) \== ':\') then - mapSymExeDir = strip(mapSymExeDir, 'T', '\') - mapSymExeDir = directory(mapSymExeDir) - if (mapSymExeDir == '') then do - say 'ERROR: Directory of "'aMapSymEXE'" does not exist.' - exit 255 - end - if (right(mapSymExeDir, 2) \== ':\') then - mapSymExeDir = mapSymExeDir'\' - mapSymExe = mapSymExeDir||filespec('N', aMapSymEXE) -end -else do - mapSymExe = aMapSymEXE -end - -call directory curDir - -mapFile = stream(aMapFile, 'C', 'QUERY EXISTS') -if (mapFile == '') then do - say 'ERROR: Cannot find file "'aMapFile'".' - exit 255 -end - -symDir = filespec('D', aSymFile)||filespec('P', aSymFile) -if (symDir == '') then symDir = '.' -else if (right(symDir, 2) \== ':\') then symDir = strip(symDir, 'T', '\') -symDir = directory(symDir) -if (symDir == '') then do - say 'ERROR: Directory of "'aSymFile'" does not exist.' - exit 255 -end - -symFile = fileSpec('N', aSymFile) - -'call' mapSymExe mapFile - -if (rc \== 0) then do - say 'ERROR: Executing "'aMapSymExe'" failed with exit code 'rc'.' -end -else do - dumbSymFile = filespec('N', mapFile) - lastDot = lastpos('.', dumbSymFile) - if (lastDot > 0) then dumbSymFile = left(dumbSymFile, lastDot - 1) - dumbSymFile = dumbSymFile'.sym' - if (translate(symFile) \== translate(dumbSymFile)) then do - 'del' symFile '1>nul 2>nul' - 'rename' dumbSymFile symFile - if (rc \== 0) then do - say 'ERROR: Renaming "'dumbSymFile'" to "'symFile'"', - 'failed with exit code 'rc'.' - end - end -end - -call directory curDir - -exit rc - -/** - * Returns a list of all words from the string as a stem. - * Delimiters are spaces, tabs and new line characters. - * Words containg spaces must be enclosed with double - * quotes. Double quote symbols that need to be a part - * of the word, must be doubled. - * - * @param string the string to tokenize - * @param stem - * the name of the stem. The stem must be global - * (i.e. its name must start with 'G.!'), for example, - * 'G.!wordlist'. - * @param leave_ws - * 1 means whitespace chars are considered as a part of words they follow. - * Leading whitespace (if any) is always a part of the first word (if any). - * - * @version 1.1 - */ -TokenizeString: procedure expose G. - - parse arg string, stem, leave_ws - leave_ws = (leave_ws == 1) - - delims = '20090D0A'x - quote = '22'x /* " */ - - num = 0 - token = '' - - len = length(string) - last_state = '' /* D - in delim, Q - in quotes, W - in word */ - seen_QW = 0 - - do i = 1 to len - c = substr(string, i, 1) - /* determine a new state */ - if (c == quote) then do - if (last_state == 'Q') then do - /* detect two double quotes in a row */ - if (substr(string, i + 1, 1) == quote) then i = i + 1 - else state = 'W' - end - else state = 'Q' - end - else if (verify(c, delims) == 0 & last_state \== 'Q') then do - state = 'D' - end - else do - if (last_state == 'Q') then state = 'Q' - else state = 'W' - end - /* process state transitions */ - if ((last_state == 'Q' | state == 'Q') & state \== last_state) then c = '' - else if (state == 'D' & \leave_ws) then c = '' - if (last_state == 'D' & state \== 'D' & seen_QW) then do - /* flush the token */ - num = num + 1 - call value stem'.'num, token - token = '' - end - token = token||c - last_state = state - seen_QW = (seen_QW | state \== 'D') - end - - /* flush the last token if any */ - if (token \== '' | seen_QW) then do - num = num + 1 - call value stem'.'num, token - end - - call value stem'.0', num - - return +/* REXX */ +/* + * Works around stupid mapsym dumbness regarding the output .sym path. + * + * (c) too simple to be copyrighted + */ + +'@echo off' + +if (RxFuncQuery('SysLoadFuncs')) then do + call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs' + call SysLoadFuncs +end + +parse arg aArgs +call TokenizeString aArgs, 'G.!args' + +if (G.!args.0 < 3) then do + say "Usage: runmapsym " + exit 255 +end + +aMapSymEXE = translate(G.!args.1, '\' , '/') +aMapFile = translate(G.!args.2, '\' , '/') +aSymFile = translate(G.!args.3, '\' , '/') + +curDir = directory() + +mapSymExeDir = filespec('D', aMapSymEXE)||filespec('P', aMapSymEXE) +if (mapSymExeDir \== '') then do + if (right(mapSymExeDir, 2) \== ':\') then + mapSymExeDir = strip(mapSymExeDir, 'T', '\') + mapSymExeDir = directory(mapSymExeDir) + if (mapSymExeDir == '') then do + say 'ERROR: Directory of "'aMapSymEXE'" does not exist.' + exit 255 + end + if (right(mapSymExeDir, 2) \== ':\') then + mapSymExeDir = mapSymExeDir'\' + mapSymExe = mapSymExeDir||filespec('N', aMapSymEXE) +end +else do + mapSymExe = aMapSymEXE +end + +call directory curDir + +mapFile = stream(aMapFile, 'C', 'QUERY EXISTS') +if (mapFile == '') then do + say 'ERROR: Cannot find file "'aMapFile'".' + exit 255 +end + +symDir = filespec('D', aSymFile)||filespec('P', aSymFile) +if (symDir == '') then symDir = '.' +else if (right(symDir, 2) \== ':\') then symDir = strip(symDir, 'T', '\') +symDir = directory(symDir) +if (symDir == '') then do + say 'ERROR: Directory of "'aSymFile'" does not exist.' + exit 255 +end + +symFile = fileSpec('N', aSymFile) + +'call' mapSymExe mapFile + +if (rc \== 0) then do + say 'ERROR: Executing "'aMapSymExe'" failed with exit code 'rc'.' +end +else do + dumbSymFile = filespec('N', mapFile) + lastDot = lastpos('.', dumbSymFile) + if (lastDot > 0) then dumbSymFile = left(dumbSymFile, lastDot - 1) + dumbSymFile = dumbSymFile'.sym' + if (translate(symFile) \== translate(dumbSymFile)) then do + 'del' symFile '1>nul 2>nul' + 'rename' dumbSymFile symFile + if (rc \== 0) then do + say 'ERROR: Renaming "'dumbSymFile'" to "'symFile'"', + 'failed with exit code 'rc'.' + end + end +end + +call directory curDir + +exit rc + +/** + * Returns a list of all words from the string as a stem. + * Delimiters are spaces, tabs and new line characters. + * Words containg spaces must be enclosed with double + * quotes. Double quote symbols that need to be a part + * of the word, must be doubled. + * + * @param string the string to tokenize + * @param stem + * the name of the stem. The stem must be global + * (i.e. its name must start with 'G.!'), for example, + * 'G.!wordlist'. + * @param leave_ws + * 1 means whitespace chars are considered as a part of words they follow. + * Leading whitespace (if any) is always a part of the first word (if any). + * + * @version 1.1 + */ +TokenizeString: procedure expose G. + + parse arg string, stem, leave_ws + leave_ws = (leave_ws == 1) + + delims = '20090D0A'x + quote = '22'x /* " */ + + num = 0 + token = '' + + len = length(string) + last_state = '' /* D - in delim, Q - in quotes, W - in word */ + seen_QW = 0 + + do i = 1 to len + c = substr(string, i, 1) + /* determine a new state */ + if (c == quote) then do + if (last_state == 'Q') then do + /* detect two double quotes in a row */ + if (substr(string, i + 1, 1) == quote) then i = i + 1 + else state = 'W' + end + else state = 'Q' + end + else if (verify(c, delims) == 0 & last_state \== 'Q') then do + state = 'D' + end + else do + if (last_state == 'Q') then state = 'Q' + else state = 'W' + end + /* process state transitions */ + if ((last_state == 'Q' | state == 'Q') & state \== last_state) then c = '' + else if (state == 'D' & \leave_ws) then c = '' + if (last_state == 'D' & state \== 'D' & seen_QW) then do + /* flush the token */ + num = num + 1 + call value stem'.'num, token + token = '' + end + token = token||c + last_state = state + seen_QW = (seen_QW | state \== 'D') + end + + /* flush the last token if any */ + if (token \== '' | seen_QW) then do + num = num + 1 + call value stem'.'num, token + end + + call value stem'.0', num + + return diff --git a/tools/bin/spec2def.cmd b/tools/bin/spec2def.cmd index 16b6526..85ed127 100644 --- a/tools/bin/spec2def.cmd +++ b/tools/bin/spec2def.cmd @@ -1,104 +1,104 @@ -/* - */ -'@echo off' - -/* - * Parse argument(s). - */ -parse arg inFileSpec - -dllName = substr(inFileSpec,1,pos('.', inFileSpec)-1); -outFileDef = dllName".def" - -rc = stream(inFileSpec, 'c', 'open read'); - -if (pos('READY', rc) <> 1) then -do - say 'Failed to open include file' inFileSpec'.'; - exit(-20); -end - -rc = stream(outFileDef, 'c', 'open write'); - -if (pos('READY', rc) <> 1) then -do - say 'Failed to open include file' outFileDef'.'; - exit(-20); -end - -ordinal = 0 - -Call LINEOUT outFileDef, "LIBRARY "TRANSLATE(dllName)" INITINSTANCE" -Call LINEOUT outFileDef, "DESCRIPTION 'Odin32 System DLL - "dllName"'" -Call LINEOUT outFileDef, "DATA MULTIPLE NONSHARED" -Call LINEOUT outFileDef, "" -Call LINEOUT outFileDef, "EXPORTS" -Call LINEOUT outFileDef, "" - -do while (lines(inFileSpec) > 0) - varSize = 0; - comment = 0; - sLine = strip(linein(inFileSpec)); - if (sLine = '') then - iterate; - if (substr(sLine, 1, 1) <> '@') then - iterate; - ordinal = ordinal + 1; - sLine1 = sLine; - sLine = substr(sLine, 3); - if (word(sLine, 1) = 'stdcall') then - sLine = substr(sLine, 8); - if (word(sLine, 1) = 'stub') then - do - sLine = substr(sLine, 5); - comment = 1 - end - sLine = strip(sLine); - if (word(sLine, 1) = '#') then - sLine = substr(sLine, 2); - sLine = strip(sLine); - if (word(sLine, 1) = '-private') then - sLine = substr(sLine, 9); - openSkobkaPos = pos('(',sLine); - if (openSkobkaPos > 0) then - do - funcName = strip(substr(sLine,1,openSkobkaPos-1)); - ordinalFuncName = funcName; - closeSkobkaPos = pos(')',sLine); - sLine = substr(sLine,openSkobkaPos+1, closeSkobkaPos-openSkobkaPos-1); - /* now sLine contains parameters */ - say '"'sLine'"' words(sLine) - varSize = words(sLine)*4; - end - else - do - funcName = strip(sLine); - end - - /* check if ordinal name is differ from real func name */ - funcNamePos = pos(funcName, word(sLine1, words(sLine1))); - if (funcNamePos > 0) then - do - /* found different func name. get last word as funcname */ - funcName = word(sLine1, words(sLine1)); - /* strip brackets */ - openSkobkaPos1 = pos('(',funcName); - if (openSkobkaPos1 > 0) then - do - funcName = strip(substr(funcName,1,openSkobkaPos1-1)); - end - end - - if (comment == 1) then - outStr = ";"ordinalFuncName" = _"funcName; - else - outStr = ordinalFuncName" = _"funcName; - if (varSize > 0 | openSkobkaPos > 0) then - outStr = outStr"@"varSize; - outStr = outStr" @"ordinal; - Call LINEOUT outFileDef, outStr - /* say outStr */ -end - -call stream inFileSpec, 'c', 'close'; -call stream outFileDef, 'c', 'close'; +/* + */ +'@echo off' + +/* + * Parse argument(s). + */ +parse arg inFileSpec + +dllName = substr(inFileSpec,1,pos('.', inFileSpec)-1); +outFileDef = dllName".def" + +rc = stream(inFileSpec, 'c', 'open read'); + +if (pos('READY', rc) <> 1) then +do + say 'Failed to open include file' inFileSpec'.'; + exit(-20); +end + +rc = stream(outFileDef, 'c', 'open write'); + +if (pos('READY', rc) <> 1) then +do + say 'Failed to open include file' outFileDef'.'; + exit(-20); +end + +ordinal = 0 + +Call LINEOUT outFileDef, "LIBRARY "TRANSLATE(dllName)" INITINSTANCE" +Call LINEOUT outFileDef, "DESCRIPTION 'Odin32 System DLL - "dllName"'" +Call LINEOUT outFileDef, "DATA MULTIPLE NONSHARED" +Call LINEOUT outFileDef, "" +Call LINEOUT outFileDef, "EXPORTS" +Call LINEOUT outFileDef, "" + +do while (lines(inFileSpec) > 0) + varSize = 0; + comment = 0; + sLine = strip(linein(inFileSpec)); + if (sLine = '') then + iterate; + if (substr(sLine, 1, 1) <> '@') then + iterate; + ordinal = ordinal + 1; + sLine1 = sLine; + sLine = substr(sLine, 3); + if (word(sLine, 1) = 'stdcall') then + sLine = substr(sLine, 8); + if (word(sLine, 1) = 'stub') then + do + sLine = substr(sLine, 5); + comment = 1 + end + sLine = strip(sLine); + if (word(sLine, 1) = '#') then + sLine = substr(sLine, 2); + sLine = strip(sLine); + if (word(sLine, 1) = '-private') then + sLine = substr(sLine, 9); + openSkobkaPos = pos('(',sLine); + if (openSkobkaPos > 0) then + do + funcName = strip(substr(sLine,1,openSkobkaPos-1)); + ordinalFuncName = funcName; + closeSkobkaPos = pos(')',sLine); + sLine = substr(sLine,openSkobkaPos+1, closeSkobkaPos-openSkobkaPos-1); + /* now sLine contains parameters */ + say '"'sLine'"' words(sLine) + varSize = words(sLine)*4; + end + else + do + funcName = strip(sLine); + end + + /* check if ordinal name is differ from real func name */ + funcNamePos = pos(funcName, word(sLine1, words(sLine1))); + if (funcNamePos > 0) then + do + /* found different func name. get last word as funcname */ + funcName = word(sLine1, words(sLine1)); + /* strip brackets */ + openSkobkaPos1 = pos('(',funcName); + if (openSkobkaPos1 > 0) then + do + funcName = strip(substr(funcName,1,openSkobkaPos1-1)); + end + end + + if (comment == 1) then + outStr = ";"ordinalFuncName" = _"funcName; + else + outStr = ordinalFuncName" = _"funcName; + if (varSize > 0 | openSkobkaPos > 0) then + outStr = outStr"@"varSize; + outStr = outStr" @"ordinal; + Call LINEOUT outFileDef, outStr + /* say outStr */ +end + +call stream inFileSpec, 'c', 'close'; +call stream outFileDef, 'c', 'close'; diff --git a/tools/bin/wmapsym.cmd b/tools/bin/wmapsym.cmd index 07a99b6..af934f0 100644 --- a/tools/bin/wmapsym.cmd +++ b/tools/bin/wmapsym.cmd @@ -1,454 +1,454 @@ -/* REXX */ -/* - * Creates a .SYM file from the Watcom .MAP file using IBM MAPSYM. - * - * Copyright (C) 2010-2011 Dmitriy Kuminov - * - * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE - * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - */ - -signal on syntax -signal on halt -signal on novalue -trace off -numeric digits 12 -'@echo off' - - -/*------------------------------------------------------------------------------ - globals -------------------------------------------------------------------------------*/ - -/* all globals to be exposed in procedures */ -Globals = 'G. Opt. Static.' - - -/*------------------------------------------------------------------------------ - startup + main + termination -------------------------------------------------------------------------------*/ - -/* init system REXX library */ -if (RxFuncQuery('SysLoadFuncs')) then do - call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs' - call SysLoadFuncs -end - -/* detect script file and directory */ -parse source . . G.ScriptPath -G.ScriptDir = FixDir(filespec('D', G.ScriptPath) || filespec('P', G.ScriptPath)) -G.ScriptFile = FixDir(filespec('N', G.ScriptPath)) -G.StartDir = directory() - -parse arg aArgs -if (aArgs == '') then do - say - say 'Creates a .SYM file from the Watcom .MAP file using IBM MAPSYM' - say 'Version 1.1 (2011-12-18)' - say 'Copyright (C) 2011 Dmitriy Kuminov' - say - say 'Usage: ' - say - say ' 'G.ScriptFile' ' - - call Done 0 -end - -G.WatMapFile = aArgs - -call Main - -call Done 0 - - -/*------------------------------------------------------------------------------ - functions -------------------------------------------------------------------------------*/ - -/** - * Just do the job. - */ -Main: procedure expose (Globals) - - GroupHeader.0 = 5 - GroupHeader.1 = '+------------+' - GroupHeader.2 = '| Groups |' - GroupHeader.3 = '+------------+' - GroupHeader.4 = 'Group Address Size' - GroupHeader.5 = '===== ======= ====' - - SegmentHeader.0 = 5 - SegmentHeader.1 = '+--------------+' - SegmentHeader.2 = '| Segments |' - SegmentHeader.3 = '+--------------+' - SegmentHeader.4 = 'Segment Class Group Address Size' - SegmentHeader.5 = '======= ===== ===== ======= ====' - - MemMapHeader.0 = 7 - MemMapHeader.1 = '+----------------+' - MemMapHeader.2 = '| Memory Map |' - MemMapHeader.3 = '+----------------+' - MemMapHeader.4 = '* = unreferenced symbol' - MemMapHeader.5 = '+ = symbol only referenced locally' - MemMapHeader.6 = 'Address Symbol' - MemMapHeader.7 = '======= ======' - - ImportHeader.0 = 5 - ImportHeader.1 = '+----------------------+' - ImportHeader.2 = '| Imported Symbols |' - ImportHeader.3 = '+----------------------+' - ImportHeader.4 = 'Symbol Module' - ImportHeader.5 = '====== ======' - - state = '' - state2 = 1 - inMap = 0 - - segments.0 = 0 - groups.0 = 0 - image = '' - - G.IbmMapFile = G.WatMapFile - i = lastpos('.', G.IbmMapFile) - if (i > 0) then - G.IbmMapFile = left(G.IbmMapFile, i - 1) - G.IbmMapFile = SysTempFileName(G.IbmMapFile'.?????-map') - - do while lines(G.WatMapFile) - line = strip(linein(G.WatMapFile)) - if (line == '') then iterate - select - when state == '' then do - str = 'Executable Image: ' - if (StartsWith(line, str)) then - image = filespec('N', substr(line, length(str) + 1)) - i = pos('.', image) - if (i > 0) then do - image = left(image, i - 1) - end - else - if (line == GroupHeader.state2) then do - if (state2 == GroupHeader.0) then do - state = 'g' - state2 = 1 - iterate - end - state2 = state2 + 1 - end - else state2 = 1 - end - when state == 'g' then do - if (line == SegmentHeader.state2) then do - if (state2 == SegmentHeader.0) then do - state = 's' - state2 = 1 - iterate - end - state2 = state2 + 1 - end - else do - parse value Normalize(line) with name addr size - i = groups.0 + 1 - groups.i.!name = name - groups.i.!addr = addr - groups.i.!size = size - groups.0 = i - end - end - when state == 's' then do - if (line == MemMapHeader.state2) then do - if (state2 == MemMapHeader.0) then do - state = 'm' - state2 = 1 - iterate - end - state2 = state2 + 1 - end - else do - parse value Normalize(line) with name rest - i = words(rest) - if (i == 2) then parse var rest addr size - else if (i == 3) then parse var rest group addr size - else parse var rest class group addr size - i = segments.0 + 1 - segments.i.!name = name - segments.i.!class = class - segments.i.!group = group - segments.i.!addr = addr - segments.i.!size = size - segments.0 = i - end - end - when state == 'm' then do - if (line == ImportHeader.state2) then do - if (state2 == ImportHeader.0) then do - state = 'rest' - state2 = 1 - iterate - end - state2 = state2 + 1 - end - else do - if (\inMap) then do - inMap = 1 - if (image \== '') then do - call lineout G.IbmMapFile, '' - call lineout G.IbmMapFile, ' 'image - end - call lineout G.IbmMapFile, '' - call lineout G.IbmMapFile, ' Start Length Name Class' - do i = 1 to segments.0 - call lineout G.IbmMapFile, ' 'segments.i.!addr' 0'segments.i.!size'H 'segments.i.!name - end - call lineout G.IbmMapFile, '' - call lineout G.IbmMapFile, ' Origin Group' - do i = 1 to groups.0 - parse var groups.i.!addr seg':'addr - addr = strip(addr, 'L', '0') - if (addr == '') then addr = '0' - call lineout G.IbmMapFile, ' 'seg':'addr' 'groups.i.!name - end - call lineout G.IbmMapFile, '' - call lineout G.IbmMapFile, ' Address Publics by Value' - call lineout G.IbmMapFile, '' - end - if (StartsWith(line, 'Module: ')) then iterate - parse value Normalize(line) with addr name - addr = strip(addr, 'T', '*') - addr = strip(addr, 'T', '+') - if (addr == '0000:00000000') then iterate - call lineout G.IbmMapFile, ' 'addr' 'name - end - end - when state == 'rest' then do - str = 'Entry point address: ' - if (StartsWith(line, str)) then do - call lineout G.IbmMapFile, '' - call lineout G.IbmMapFile, 'Program entry point at 'substr(line, length(str) + 1) - end - end - otherwise nop - end - - end - call lineout G.WatMapFile - call lineout G.IbmMapFile - - cmdline = 'mapsym.exe' G.IbmMapFile - cmdline - - if (rc \= 0) then do - call SayErr 'Executing "'cmdline'" failed with code 'rc'.' - call SayErr 'Please check the contents of "'G.IbmMapFile'".' - call Done rc - end - - call DeleteFile G.IbmMapFile - - return - -/*------------------------------------------------------------------------------ - utility functions -------------------------------------------------------------------------------*/ - -/** - * Normalizes the given string by removing leading, trailing and extra spaces - * in the middle so that words in the returned string are separated with exactly - * one space. - * - * @param aStr String to normalize. - * @return Resulting string. - */ -Normalize: procedure expose (Globals) - parse arg aStr - result = "" - do i = 1 to words(aStr) - if (result == "") then result = word(aStr, i) - else result = result" "word(aStr, i) - end - return result - -/** - * Returns 1 if the given string @a aStr1 starts with the string @a aStr2 and - * 0 otherwise. If @a aStr2 is null or empty, 0 is returned. - * - * @param aStr1 String to search in. - * @param aStr2 String to search for. - * @return 1 or 0. - */ -StartsWith: procedure expose (Globals) - parse arg aStr1, aStr2 - len = length(aStr2) - if (len == 0) then return 0 - if (length(aStr1) < len) then return 0 - return (left(aStr1, len) == aStr2) - -/** - * Returns 1 if the given string @a aStr1 ends with the string @a aStr2 and - * 0 otherwise. If @a aStr2 is null or empty, 0 is returned. - * - * @param aStr1 String to search in. - * @param aStr2 String to search for. - * @return 1 or 0. - */ -EndsWith: procedure expose (Globals) - parse arg aStr1, aStr2 - len = length(aStr2) - if (len == 0) then return 0 - if (length(aStr1) < len) then return 0 - return (right(aStr1, len) == aStr2) - -DeleteFile: procedure expose (Globals) - parse arg file - rc = SysFileDelete(file) - if (rc \= 0 & rc \= 2) then do - call SayErr 'FATAL: Could not delete file '''file'''!' - call SayErr 'SysFileDelete returned 'rc - call Done 1 - end - return - -/** - * Prefixes all lines of text with the given prefix. - * - * @param aLines Text to prefix. - * @param aPrefix Prefix. - * - * @return Prefixed text. - */ -PrefixLines: procedure expose (Globals) - parse arg aLines, aPrefix - return aPrefix||Replace(aLines, G.EOL, G.EOL||aPrefix) - -SaySayEx: procedure expose (Globals) - parse arg str, prefix, noeol - noeol = (noeol == 1) - if (noeol) then call charout, str - else say str - return - -SaySay: procedure expose (Globals) - parse arg str, noeol - noeol = (noeol == 1) - if (noeol) then call charout, str - else say str - return - -SayWrn: procedure expose (Globals) - parse arg str, noeol - str = 'WARNING: 'str - call SaySay str, noeol - return - -SayErr: procedure expose (Globals) - parse arg str, noeol - str = 'ERROR: 'str - call SaySay str, noeol - return - -/** - * Fixes the directory path by a) converting all slashes to back - * slashes and b) ensuring that the trailing slash is present if - * the directory is the root directory, and absent otherwise. - * - * @param dir the directory path - * @param noslash - * optional argument. If 1, the path returned will not have a - * trailing slash anyway. Useful for concatenating it with a - * file name. - */ -FixDir: procedure expose (Globals) - parse arg dir, noslash - noslash = (noslash = 1) - dir = translate(dir, '\', '/') - if (right(dir, 1) == '\' &, - (noslash | \(length(dir) == 3 & (substr(dir, 2, 1) == ':')))) then - dir = substr(dir, 1, length(dir) - 1) - return dir - -/** - * Shortcut to FixDir(dir, 1) - */ -FixDirNoSlash: procedure expose (Globals) - parse arg dir - return FixDir(dir, 1) - -/** - * NoValue signal handler. - */ -NoValue: - errl = sigl - say - say - say 'EXPRESSION HAS NO VALUE at line #'errl'!' - say - say 'This is usually a result of a misnamed variable.' - say 'Please contact the author.' - call Done 252 - -/** - * Nonsense handler. - */ -Nonsense: - errl = sigl - say - say - say 'NONSENSE at line #'errl'!' - say - say 'The author decided that this point of code should' - say 'have never been reached, but it accidentally had.' - say 'Please contact the author.' - call Done 253 - -/** - * Syntax signal handler. - */ -Syntax: - errn = rc - errl = sigl - say - say - say 'UNEXPECTED PROGRAM TERMINATION!' - say - say 'REX'right(errn , 4, '0')': 'ErrorText(rc)' at line #'errl - say - say 'Possible reasons:' - say - say ' 1. Some of REXX libraries are not found but required.' - say ' 2. You have changed this script and made a syntax error.' - say ' 3. Author made a mistake.' - say ' 4. Something else...' - call Done 254 - -/** - * Halt signal handler. - */ -Halt: - say - say 'CTRL-BREAK pressed, exiting.' - call Done 255 - -/** - * Always called at the end. Should not be called directly. - * @param the exit code - */ -Done: procedure expose (Globals) - parse arg code - /* protect against recursive calls */ - if (value('G.Done_done') == 1) then exit code - call value 'G.Done_done', 1 - /* cleanup stuff goes there */ - if (symbol('G.AtExit.0') == 'VAR') then do - /* run all AtExit slots */ - do i = 1 to G.AtExit.0 - if (symbol('G.AtExit.'i) == 'VAR') then - call RunAtExitSlot i - end - end - drop G.AtExit. - /* finally, exit */ - if (code \= 0) then do - call SaySay G.ScriptFile': FAILED with exit code 'code - end - exit code - +/* REXX */ +/* + * Creates a .SYM file from the Watcom .MAP file using IBM MAPSYM. + * + * Copyright (C) 2010-2011 Dmitriy Kuminov + * + * This file is provided AS IS with NO WARRANTY OF ANY KIND, INCLUDING THE + * WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + */ + +signal on syntax +signal on halt +signal on novalue +trace off +numeric digits 12 +'@echo off' + + +/*------------------------------------------------------------------------------ + globals +------------------------------------------------------------------------------*/ + +/* all globals to be exposed in procedures */ +Globals = 'G. Opt. Static.' + + +/*------------------------------------------------------------------------------ + startup + main + termination +------------------------------------------------------------------------------*/ + +/* init system REXX library */ +if (RxFuncQuery('SysLoadFuncs')) then do + call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs' + call SysLoadFuncs +end + +/* detect script file and directory */ +parse source . . G.ScriptPath +G.ScriptDir = FixDir(filespec('D', G.ScriptPath) || filespec('P', G.ScriptPath)) +G.ScriptFile = FixDir(filespec('N', G.ScriptPath)) +G.StartDir = directory() + +parse arg aArgs +if (aArgs == '') then do + say + say 'Creates a .SYM file from the Watcom .MAP file using IBM MAPSYM' + say 'Version 1.1 (2011-12-18)' + say 'Copyright (C) 2011 Dmitriy Kuminov' + say + say 'Usage: ' + say + say ' 'G.ScriptFile' ' + + call Done 0 +end + +G.WatMapFile = aArgs + +call Main + +call Done 0 + + +/*------------------------------------------------------------------------------ + functions +------------------------------------------------------------------------------*/ + +/** + * Just do the job. + */ +Main: procedure expose (Globals) + + GroupHeader.0 = 5 + GroupHeader.1 = '+------------+' + GroupHeader.2 = '| Groups |' + GroupHeader.3 = '+------------+' + GroupHeader.4 = 'Group Address Size' + GroupHeader.5 = '===== ======= ====' + + SegmentHeader.0 = 5 + SegmentHeader.1 = '+--------------+' + SegmentHeader.2 = '| Segments |' + SegmentHeader.3 = '+--------------+' + SegmentHeader.4 = 'Segment Class Group Address Size' + SegmentHeader.5 = '======= ===== ===== ======= ====' + + MemMapHeader.0 = 7 + MemMapHeader.1 = '+----------------+' + MemMapHeader.2 = '| Memory Map |' + MemMapHeader.3 = '+----------------+' + MemMapHeader.4 = '* = unreferenced symbol' + MemMapHeader.5 = '+ = symbol only referenced locally' + MemMapHeader.6 = 'Address Symbol' + MemMapHeader.7 = '======= ======' + + ImportHeader.0 = 5 + ImportHeader.1 = '+----------------------+' + ImportHeader.2 = '| Imported Symbols |' + ImportHeader.3 = '+----------------------+' + ImportHeader.4 = 'Symbol Module' + ImportHeader.5 = '====== ======' + + state = '' + state2 = 1 + inMap = 0 + + segments.0 = 0 + groups.0 = 0 + image = '' + + G.IbmMapFile = G.WatMapFile + i = lastpos('.', G.IbmMapFile) + if (i > 0) then + G.IbmMapFile = left(G.IbmMapFile, i - 1) + G.IbmMapFile = SysTempFileName(G.IbmMapFile'.?????-map') + + do while lines(G.WatMapFile) + line = strip(linein(G.WatMapFile)) + if (line == '') then iterate + select + when state == '' then do + str = 'Executable Image: ' + if (StartsWith(line, str)) then + image = filespec('N', substr(line, length(str) + 1)) + i = pos('.', image) + if (i > 0) then do + image = left(image, i - 1) + end + else + if (line == GroupHeader.state2) then do + if (state2 == GroupHeader.0) then do + state = 'g' + state2 = 1 + iterate + end + state2 = state2 + 1 + end + else state2 = 1 + end + when state == 'g' then do + if (line == SegmentHeader.state2) then do + if (state2 == SegmentHeader.0) then do + state = 's' + state2 = 1 + iterate + end + state2 = state2 + 1 + end + else do + parse value Normalize(line) with name addr size + i = groups.0 + 1 + groups.i.!name = name + groups.i.!addr = addr + groups.i.!size = size + groups.0 = i + end + end + when state == 's' then do + if (line == MemMapHeader.state2) then do + if (state2 == MemMapHeader.0) then do + state = 'm' + state2 = 1 + iterate + end + state2 = state2 + 1 + end + else do + parse value Normalize(line) with name rest + i = words(rest) + if (i == 2) then parse var rest addr size + else if (i == 3) then parse var rest group addr size + else parse var rest class group addr size + i = segments.0 + 1 + segments.i.!name = name + segments.i.!class = class + segments.i.!group = group + segments.i.!addr = addr + segments.i.!size = size + segments.0 = i + end + end + when state == 'm' then do + if (line == ImportHeader.state2) then do + if (state2 == ImportHeader.0) then do + state = 'rest' + state2 = 1 + iterate + end + state2 = state2 + 1 + end + else do + if (\inMap) then do + inMap = 1 + if (image \== '') then do + call lineout G.IbmMapFile, '' + call lineout G.IbmMapFile, ' 'image + end + call lineout G.IbmMapFile, '' + call lineout G.IbmMapFile, ' Start Length Name Class' + do i = 1 to segments.0 + call lineout G.IbmMapFile, ' 'segments.i.!addr' 0'segments.i.!size'H 'segments.i.!name + end + call lineout G.IbmMapFile, '' + call lineout G.IbmMapFile, ' Origin Group' + do i = 1 to groups.0 + parse var groups.i.!addr seg':'addr + addr = strip(addr, 'L', '0') + if (addr == '') then addr = '0' + call lineout G.IbmMapFile, ' 'seg':'addr' 'groups.i.!name + end + call lineout G.IbmMapFile, '' + call lineout G.IbmMapFile, ' Address Publics by Value' + call lineout G.IbmMapFile, '' + end + if (StartsWith(line, 'Module: ')) then iterate + parse value Normalize(line) with addr name + addr = strip(addr, 'T', '*') + addr = strip(addr, 'T', '+') + if (addr == '0000:00000000') then iterate + call lineout G.IbmMapFile, ' 'addr' 'name + end + end + when state == 'rest' then do + str = 'Entry point address: ' + if (StartsWith(line, str)) then do + call lineout G.IbmMapFile, '' + call lineout G.IbmMapFile, 'Program entry point at 'substr(line, length(str) + 1) + end + end + otherwise nop + end + + end + call lineout G.WatMapFile + call lineout G.IbmMapFile + + cmdline = 'mapsym.exe' G.IbmMapFile + cmdline + + if (rc \= 0) then do + call SayErr 'Executing "'cmdline'" failed with code 'rc'.' + call SayErr 'Please check the contents of "'G.IbmMapFile'".' + call Done rc + end + + call DeleteFile G.IbmMapFile + + return + +/*------------------------------------------------------------------------------ + utility functions +------------------------------------------------------------------------------*/ + +/** + * Normalizes the given string by removing leading, trailing and extra spaces + * in the middle so that words in the returned string are separated with exactly + * one space. + * + * @param aStr String to normalize. + * @return Resulting string. + */ +Normalize: procedure expose (Globals) + parse arg aStr + result = "" + do i = 1 to words(aStr) + if (result == "") then result = word(aStr, i) + else result = result" "word(aStr, i) + end + return result + +/** + * Returns 1 if the given string @a aStr1 starts with the string @a aStr2 and + * 0 otherwise. If @a aStr2 is null or empty, 0 is returned. + * + * @param aStr1 String to search in. + * @param aStr2 String to search for. + * @return 1 or 0. + */ +StartsWith: procedure expose (Globals) + parse arg aStr1, aStr2 + len = length(aStr2) + if (len == 0) then return 0 + if (length(aStr1) < len) then return 0 + return (left(aStr1, len) == aStr2) + +/** + * Returns 1 if the given string @a aStr1 ends with the string @a aStr2 and + * 0 otherwise. If @a aStr2 is null or empty, 0 is returned. + * + * @param aStr1 String to search in. + * @param aStr2 String to search for. + * @return 1 or 0. + */ +EndsWith: procedure expose (Globals) + parse arg aStr1, aStr2 + len = length(aStr2) + if (len == 0) then return 0 + if (length(aStr1) < len) then return 0 + return (right(aStr1, len) == aStr2) + +DeleteFile: procedure expose (Globals) + parse arg file + rc = SysFileDelete(file) + if (rc \= 0 & rc \= 2) then do + call SayErr 'FATAL: Could not delete file '''file'''!' + call SayErr 'SysFileDelete returned 'rc + call Done 1 + end + return + +/** + * Prefixes all lines of text with the given prefix. + * + * @param aLines Text to prefix. + * @param aPrefix Prefix. + * + * @return Prefixed text. + */ +PrefixLines: procedure expose (Globals) + parse arg aLines, aPrefix + return aPrefix||Replace(aLines, G.EOL, G.EOL||aPrefix) + +SaySayEx: procedure expose (Globals) + parse arg str, prefix, noeol + noeol = (noeol == 1) + if (noeol) then call charout, str + else say str + return + +SaySay: procedure expose (Globals) + parse arg str, noeol + noeol = (noeol == 1) + if (noeol) then call charout, str + else say str + return + +SayWrn: procedure expose (Globals) + parse arg str, noeol + str = 'WARNING: 'str + call SaySay str, noeol + return + +SayErr: procedure expose (Globals) + parse arg str, noeol + str = 'ERROR: 'str + call SaySay str, noeol + return + +/** + * Fixes the directory path by a) converting all slashes to back + * slashes and b) ensuring that the trailing slash is present if + * the directory is the root directory, and absent otherwise. + * + * @param dir the directory path + * @param noslash + * optional argument. If 1, the path returned will not have a + * trailing slash anyway. Useful for concatenating it with a + * file name. + */ +FixDir: procedure expose (Globals) + parse arg dir, noslash + noslash = (noslash = 1) + dir = translate(dir, '\', '/') + if (right(dir, 1) == '\' &, + (noslash | \(length(dir) == 3 & (substr(dir, 2, 1) == ':')))) then + dir = substr(dir, 1, length(dir) - 1) + return dir + +/** + * Shortcut to FixDir(dir, 1) + */ +FixDirNoSlash: procedure expose (Globals) + parse arg dir + return FixDir(dir, 1) + +/** + * NoValue signal handler. + */ +NoValue: + errl = sigl + say + say + say 'EXPRESSION HAS NO VALUE at line #'errl'!' + say + say 'This is usually a result of a misnamed variable.' + say 'Please contact the author.' + call Done 252 + +/** + * Nonsense handler. + */ +Nonsense: + errl = sigl + say + say + say 'NONSENSE at line #'errl'!' + say + say 'The author decided that this point of code should' + say 'have never been reached, but it accidentally had.' + say 'Please contact the author.' + call Done 253 + +/** + * Syntax signal handler. + */ +Syntax: + errn = rc + errl = sigl + say + say + say 'UNEXPECTED PROGRAM TERMINATION!' + say + say 'REX'right(errn , 4, '0')': 'ErrorText(rc)' at line #'errl + say + say 'Possible reasons:' + say + say ' 1. Some of REXX libraries are not found but required.' + say ' 2. You have changed this script and made a syntax error.' + say ' 3. Author made a mistake.' + say ' 4. Something else...' + call Done 254 + +/** + * Halt signal handler. + */ +Halt: + say + say 'CTRL-BREAK pressed, exiting.' + call Done 255 + +/** + * Always called at the end. Should not be called directly. + * @param the exit code + */ +Done: procedure expose (Globals) + parse arg code + /* protect against recursive calls */ + if (value('G.Done_done') == 1) then exit code + call value 'G.Done_done', 1 + /* cleanup stuff goes there */ + if (symbol('G.AtExit.0') == 'VAR') then do + /* run all AtExit slots */ + do i = 1 to G.AtExit.0 + if (symbol('G.AtExit.'i) == 'VAR') then + call RunAtExitSlot i + end + end + drop G.AtExit. + /* finally, exit */ + if (code \= 0) then do + call SaySay G.ScriptFile': FAILED with exit code 'code + end + exit code + diff --git a/tools/common/Makefile.kmk b/tools/common/Makefile.kmk index f691636..280381f 100644 --- a/tools/common/Makefile.kmk +++ b/tools/common/Makefile.kmk @@ -1,27 +1,27 @@ -## @file -# COMMON library makefile. -# - -SUB_DEPTH = ../.. -include $(KBUILD_PATH)/subheader.kmk - -LIBRARIES += common -common_TEMPLATE = OdinCxx - -common_INCS = . - -common_SOURCES = \ - kFileDEF.cpp \ - kFileLX.cpp \ - kFilePE.cpp \ - kFileSDF.cpp \ - kFileFormatBase.cpp \ - kFile.cpp \ - kFileInterfaces.cpp \ - kAssert.c \ - kError.cpp - -common_LIBS += \ - $(PATH_STAGE_LIB)/unicode.lib - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# COMMON library makefile. +# + +SUB_DEPTH = ../.. +include $(KBUILD_PATH)/subheader.kmk + +LIBRARIES += common +common_TEMPLATE = OdinCxx + +common_INCS = . + +common_SOURCES = \ + kFileDEF.cpp \ + kFileLX.cpp \ + kFilePE.cpp \ + kFileSDF.cpp \ + kFileFormatBase.cpp \ + kFile.cpp \ + kFileInterfaces.cpp \ + kAssert.c \ + kError.cpp + +common_LIBS += \ + $(PATH_STAGE_LIB)/unicode.lib + +include $(FILE_KBUILD_SUB_FOOTER) diff --git a/tools/impdef/Makefile.kmk b/tools/impdef/Makefile.kmk index 8b4234c..53b675c 100644 --- a/tools/impdef/Makefile.kmk +++ b/tools/impdef/Makefile.kmk @@ -1,25 +1,25 @@ -## @file -# IMPDEF makefile. -# - -SUB_DEPTH = ../.. -include $(KBUILD_PATH)/subheader.kmk - -BLDPROGS += impdef -impdef_TEMPLATE = OdinBin - -# @todo: the need of this for BLDPROGS looks like a kBuild bug to me -impdef_INST = bin/ -impdef_INSTTYPE = stage - -impdef_INCS = \ - ../common - -impdef_SOURCES = \ - ImpDef.cpp \ - ImpDef.def - -impdef_LIBS = \ - $(PATH_STAGE_LIB)/common.lib - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# IMPDEF makefile. +# + +SUB_DEPTH = ../.. +include $(KBUILD_PATH)/subheader.kmk + +BLDPROGS += impdef +impdef_TEMPLATE = OdinBin + +# @todo: the need of this for BLDPROGS looks like a kBuild bug to me +impdef_INST = bin/ +impdef_INSTTYPE = stage + +impdef_INCS = \ + ../common + +impdef_SOURCES = \ + ImpDef.cpp \ + ImpDef.def + +impdef_LIBS = \ + $(PATH_STAGE_LIB)/common.lib + +include $(FILE_KBUILD_SUB_FOOTER) diff --git a/tools/install/Makefile.kmk b/tools/install/Makefile.kmk index 099378a..5b43523 100644 --- a/tools/install/Makefile.kmk +++ b/tools/install/Makefile.kmk @@ -1,22 +1,22 @@ -## @file -# ODININST makefile. -# - -SUB_DEPTH = ../.. -include $(KBUILD_PATH)/subheader.kmk - -PROGRAMS += odininst -odininst_TEMPLATE = OdinApp - -odininst_SOURCES = \ - odininst.cpp \ - regapi.c \ - tz.c \ - odininst.def - -odininst_LIBS += \ - $(PATH_STAGE_LIB)/kernel32.lib \ - $(PATH_STAGE_LIB)/user32.lib \ - $(PATH_STAGE_LIB)/advapi32.lib - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# ODININST makefile. +# + +SUB_DEPTH = ../.. +include $(KBUILD_PATH)/subheader.kmk + +PROGRAMS += odininst +odininst_TEMPLATE = OdinApp + +odininst_SOURCES = \ + odininst.cpp \ + regapi.c \ + tz.c \ + odininst.def + +odininst_LIBS += \ + $(PATH_STAGE_LIB)/kernel32.lib \ + $(PATH_STAGE_LIB)/user32.lib \ + $(PATH_STAGE_LIB)/advapi32.lib + +include $(FILE_KBUILD_SUB_FOOTER) diff --git a/tools/pebuild/mkn.cmd b/tools/pebuild/mkn.cmd index 6c51fc4..49efc3e 100644 --- a/tools/pebuild/mkn.cmd +++ b/tools/pebuild/mkn.cmd @@ -1,5 +1,5 @@ -@rem tools\bin\cmdqd init 5 -@rem set MULTIJOBS=1 -SET EMX=e:\devtools\emx -nmake DEBUG=1 +@rem tools\bin\cmdqd init 5 +@rem set MULTIJOBS=1 +SET EMX=e:\devtools\emx +nmake DEBUG=1 copy bin\debug\pebuild.exe \ No newline at end of file diff --git a/tools/profilerfix/ApplyDiff.cmd b/tools/profilerfix/ApplyDiff.cmd index 8537c5b..c0ede7c 100644 --- a/tools/profilerfix/ApplyDiff.cmd +++ b/tools/profilerfix/ApplyDiff.cmd @@ -1,104 +1,104 @@ -/* $Id: ApplyDiff.cmd,v 1.1 2002-04-19 07:05:53 bird Exp $ - * - * Applies any .diff file to a binary file. - * - * Copyright (c) 2002 knut st. osmundsen (bird@anduin.net) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - - -/* - * Arguments. - */ -parse arg sDiffFile sFilename sDummy -if ((sFilename = '') | (sDummy <> '')) then -do - say 'syntax error'; - exit(1); -end - - - -/* - * Read the diff file. - */ -aDiff.0 = 0; -do while (lines(sDiffFile) > 0) - sLine = translate(linein(sDiffFile),, - ' ',, - x2c('000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f')) - if (word(sLine, 1) <> 'mismatch') then - leave; - parse var sLine 'mismatch at' sOffset '-' sTo'('.') !=' sFrom'('. - if ((sTo = '') | (sFrom = '') | (sOffset = '')) then - do - /*say 'dbg1:' sTo - say 'dbg1:' sFrom - say 'dbg1:' sOffset - say sLine - */ - leave; - end - - /* add it */ - i = aDiff.0 + 1; - aDiff.0 = i; - aDiff.i.iOffset = HexToDec(sOffset); - aDiff.i.chTo = x2c(strip(sTo)) - aDiff.i.chFrom = x2c(strip(sFrom)) -end - -say 'Read 'aDiff.0' differences from' sDiffFile'.' -if (aDiff.0 <= 0) then -do - say ' No differences in the difffile, ' sDiffFile'!'; - exit(3); -end - - -/* - * Apply the diffeneces. - */ -iRet = 0; -do i = 1 to aDiff.0 - /* say 'diff 'i':' aDiff.i.iOffset '-' c2x(aDiff.i.chFrom)' -> 'c2x(aDiff.i.chTo); */ - ch = charin(sFilename, aDiff.i.iOffset + 1, 1); - if (ch <> aDiff.i.chFrom) then - do - if (ch <> aDiff.i.chTo) then - do - say 'patch mismatch at offset' aDiff.i.iOffset; - iRet = iRet + 1; - leave; - end - end - else - do - irc = charout(sFilename, aDiff.i.chTo, aDiff.i.iOffset + 1); - if (irc <> 0) then - do - say 'Error: failed to apply fix. rc='irc; - iRet = iRet + 1; - end - end -end - - -/* - * Print indicator message. - */ -if (iRet > 0) then - say iRet 'errors occured during applying of the patch.' -else - say 'Successfully patched '''sFilename'''.'; - -exit(iRet); - - - - -HexToDec: procedure - parse arg sStringHex -return x2d(strip(strip(sStringHex), 'L', '0')); +/* $Id: ApplyDiff.cmd,v 1.1 2002-04-19 07:05:53 bird Exp $ + * + * Applies any .diff file to a binary file. + * + * Copyright (c) 2002 knut st. osmundsen (bird@anduin.net) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + + +/* + * Arguments. + */ +parse arg sDiffFile sFilename sDummy +if ((sFilename = '') | (sDummy <> '')) then +do + say 'syntax error'; + exit(1); +end + + + +/* + * Read the diff file. + */ +aDiff.0 = 0; +do while (lines(sDiffFile) > 0) + sLine = translate(linein(sDiffFile),, + ' ',, + x2c('000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f')) + if (word(sLine, 1) <> 'mismatch') then + leave; + parse var sLine 'mismatch at' sOffset '-' sTo'('.') !=' sFrom'('. + if ((sTo = '') | (sFrom = '') | (sOffset = '')) then + do + /*say 'dbg1:' sTo + say 'dbg1:' sFrom + say 'dbg1:' sOffset + say sLine + */ + leave; + end + + /* add it */ + i = aDiff.0 + 1; + aDiff.0 = i; + aDiff.i.iOffset = HexToDec(sOffset); + aDiff.i.chTo = x2c(strip(sTo)) + aDiff.i.chFrom = x2c(strip(sFrom)) +end + +say 'Read 'aDiff.0' differences from' sDiffFile'.' +if (aDiff.0 <= 0) then +do + say ' No differences in the difffile, ' sDiffFile'!'; + exit(3); +end + + +/* + * Apply the diffeneces. + */ +iRet = 0; +do i = 1 to aDiff.0 + /* say 'diff 'i':' aDiff.i.iOffset '-' c2x(aDiff.i.chFrom)' -> 'c2x(aDiff.i.chTo); */ + ch = charin(sFilename, aDiff.i.iOffset + 1, 1); + if (ch <> aDiff.i.chFrom) then + do + if (ch <> aDiff.i.chTo) then + do + say 'patch mismatch at offset' aDiff.i.iOffset; + iRet = iRet + 1; + leave; + end + end + else + do + irc = charout(sFilename, aDiff.i.chTo, aDiff.i.iOffset + 1); + if (irc <> 0) then + do + say 'Error: failed to apply fix. rc='irc; + iRet = iRet + 1; + end + end +end + + +/* + * Print indicator message. + */ +if (iRet > 0) then + say iRet 'errors occured during applying of the patch.' +else + say 'Successfully patched '''sFilename'''.'; + +exit(iRet); + + + + +HexToDec: procedure + parse arg sStringHex +return x2d(strip(strip(sStringHex), 'L', '0')); diff --git a/tools/profilerfix/prfpatch.cmd b/tools/profilerfix/prfpatch.cmd index 3e1fe58..add4e94 100644 --- a/tools/profilerfix/prfpatch.cmd +++ b/tools/profilerfix/prfpatch.cmd @@ -1,48 +1,48 @@ -/* $Id: prfpatch.cmd,v 1.1 2002-04-11 21:04:07 bird Exp $ - * - * Applies fix the VAC308 profiler .obj. - * - * Copyright (c) 2002 knut st. osmundsen (bird@anduin.net) - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - - -/* - * Arguments. - */ -parse arg sFilename sDummy -if ((sFilename = '') | (sDummy <> '')) then -do - say 'syntax error'; - exit(1); -end - -/* - * Apply the patch. - */ -say 'Changing DosLoadModule to prfLoadModule...' -sDosLoadModule = charin(sFilename, 229, 13); -if (sDosLoadModule = 'DosLoadModule') then -do - irc = charout(sFilename, 'prfLoadModule', 229); - if (irc <> 0) then - say 'Error: failed to apply fix. rc='irc; - else - say 'Fix applied.' - exit(irc); -end -else if (sDosLoadModule = 'prfLoadModule') then -do - say 'Fix is allready applied.' - exit(0); -end - -/* - * Error - */ -say 'invalid file?' -say 'sDosLoadModule='c2x(sDosLoadModule); -exit(1); - +/* $Id: prfpatch.cmd,v 1.1 2002-04-11 21:04:07 bird Exp $ + * + * Applies fix the VAC308 profiler .obj. + * + * Copyright (c) 2002 knut st. osmundsen (bird@anduin.net) + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + + +/* + * Arguments. + */ +parse arg sFilename sDummy +if ((sFilename = '') | (sDummy <> '')) then +do + say 'syntax error'; + exit(1); +end + +/* + * Apply the patch. + */ +say 'Changing DosLoadModule to prfLoadModule...' +sDosLoadModule = charin(sFilename, 229, 13); +if (sDosLoadModule = 'DosLoadModule') then +do + irc = charout(sFilename, 'prfLoadModule', 229); + if (irc <> 0) then + say 'Error: failed to apply fix. rc='irc; + else + say 'Fix applied.' + exit(irc); +end +else if (sDosLoadModule = 'prfLoadModule') then +do + say 'Fix is allready applied.' + exit(0); +end + +/* + * Error + */ +say 'invalid file?' +say 'sDosLoadModule='c2x(sDosLoadModule); +exit(1); + diff --git a/tools/vslick/genproject.cmd b/tools/vslick/genproject.cmd index 712f9bf..2f93dd3 100644 --- a/tools/vslick/genproject.cmd +++ b/tools/vslick/genproject.cmd @@ -1,233 +1,233 @@ -/* $Id: genproject.cmd,v 1.5 2000-11-15 00:20:44 bird Exp $ - * - * This script generates a Visual Slick project of the source and include - * files found in the directory tree starting at the current directory. - * - * Copyright (c) 1999-2000 knut st. osmundsen - * - * Project Odin Software License can be found in LICENSE.TXT - * - */ - call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; - call SysLoadFuncs; - - parse arg sArg - - sIncludes = ''; - sProjFile = ''; - fFullDir = 1; - fRecursive = 0; - - sArgs.0 = 0; - i = 0; - do while sArg \= '' - i = i + 1; - ipos = pos(' ', sArg); - if ipos == 0 then do - sArgs.i = substr(sArg, 1); - sArg = ''; - end - else do - sArgs.i = substr(sArg, 1, ipos); - /* next */ - sArg = substr(sArg, ipos); - do while substr(sArg, 1, 1) == ' ' | substr(sArg, 1, 1) == '\t' - sArg = substr(sArg, 2); - end - end - end - sArgs.0 = i; - - /* check if no parameters */ - if i = 0 then - do - say 'error: no arguments!'; - call syntax; - end - - /* parse arguments */ - do i = 1 to sArgs.0 - sArg = sArgs.i; - if substr(sArg, 1, 1) == '-' | substr(sArg, 1, 1) == '/' then do - /* option */ - chArg = substr(sArg, 2, 1); - sArg = strip(substr(sArg, 3)); - select - when chArg = 'I' | chArg = 'i' then do - if (sArg <> '' & substr(sArg, length(sArg), 1) <> ';') then - sincludes = sIncludes || sArg || ';'; - else - sIncludes = sIncludes || sArg; - end - - when chArg = 'f' | chArg = 'F' then do - fFullDir = 1; - end - - when chArg = 'r' | chArg = 'R' then do - fFullDir = 0; - end - - when chArg = 'h' | chArg = '?' | sArg = '-help' then do - call syntax; - end - - when chArg = 's' | chArg = 'S' then do - fRecursive = 1; - end - - otherwise do - say 'illegal option: 'chArg||sArg - call syntax; - end - end - end - else do - if sProjFile = '' then - sProjFile = sArg; - else do - say 'error! multiple project names!' - call syntax; - end - end - end /* do */ - - say 'Will now generate :' sProjFile - say 'Includes specified:' sIncludes - - /* delete old target files */ - call SysFileDelete sProjFile; - if lastpos('.', sProjFile) > 0 then /* tag file */ - call SysFileDelete substr(sProjFile, 1, lastpos('.', sProjFile))'vtg' - - /* open target file */ - if (stream(sProjFile, 'c', 'open write' ) <> '') then do - call lineout sProjFile, '[COMPILER]' - call lineout sProjFile, 'MACRO=odin32_setcurrentdir();\nodin32_maketagfile();\n' - call lineout sProjFile, 'FILTEREXPANSION=1 1 0 0 1' - call lineout sProjFile, 'compile=concur|capture|clear|:Compile:&Compile,nmake .\bin\debug\%n.obj' - call lineout sProjFile, 'make=concur|capture|clear|:Build:&Build,nmake' - call lineout sProjFile, 'rebuild=concur|capture|clear|:Rebuild:&Rebuild,nmake -a' - call lineout sProjFile, 'debug=:Debug:&Debug,' - call lineout sProjFile, 'execute=:Execute:E&xecute,' - call lineout sProjFile, 'user1=hide|:User 1:User 1,' - call lineout sProjFile, 'user2=hide|:User 2:User 2,' - call lineout sProjFile, 'usertool_resource_editor=hide|:Resource Editor:Resource Editor,dlgedit' - call lineout sProjFile, 'workingdir='directory() - /* TODO */ - call lineout sProjFile, 'includedirs='||sIncludes||'%(INCLUDE)' - call lineout sProjFile, 'tagfiles=' - call lineout sProjFile, 'reffile=' - - call lineout sProjFile, '[FILES]' - call processDirTree sProjFile, directory(), directory(), fRecursive, fFullDir; - call lineout sProjFile, '[ASSOCIATION]' - call lineout sProjFile, '[STATE]' - call lineout sProjFile, 'FILEHIST: 0' - call lineout sProjFile, 'PRINTER: 2' - - call stream sIncFile, 'c', 'close'; - end - else do - say 'oops, failed to open outputfile,' sProjFile; - exit 1; - end - - exit (0); - - - - - - -/*********************/ -/* procedure section */ -/*********************/ - -syntax: procedure - say 'Syntax: genproject.cmd [-I]' - say ' switches: -s Recursivly scan subdirectories too.' - say ' (default: Current dir only)' - say ' -f Full filenames. (default)' - say ' -r Relative filenames. (default: -f)' - say ' -I Include directories.' - say 'Copyright (c) 1999-2000 knut st. osmundsen' - exit (1); - -/* processes an directory tree */ -processDirTree: procedure - parse arg sProjFile, sDirectory, sRoot, fRecursive, fFullDir - - rc = SysFileTree(sDirectory'\*', sFiles, 'FO'); - if rc == 0 then do - do i = 1 to sFiles.0 - if filterFile(sFiles.i) then - do - if (fFullDir) then - call lineout sProjFile, sFiles.i; - else - call lineout sProjFile, substr(sFiles.i, length(sRoot)+2); - end - end - end - - if (fRecursive) then - do - rc = SysFileTree(sDirectory'\*', sDirs, 'DO'); - if rc == 0 then do - do i = 1 to sDirs.0 - if filterDirectory(sDirs.i) then - call processDirTree sProjFile, sDirs.i, sRoot, fRecursive, fFullDir - end - end - end - - - return; - - -/* returns boolean, TRUE if include; false if exclude */ -filterFile: procedure - parse arg sFile - - if lastpos('\', sFile) < lastpos('.', sFile) then do - sIncludeExt = 'c;cpp;h;hpp;inc;asm;rc;mak;cmd;mk;def;txt;orc;dlg;doc;ipf;' - sExt = substr(sFile, lastpos('.', sFile)+1); - - /* look for sExt in sIncludeExt */ - do while pos(';', sIncludeExt) > 0 - ipos = pos(';', sIncludeExt) - if sExt == substr(sIncludeExt, 1, ipos-1) then - return 1; - sIncludeExt = substr(sIncludeExt, ipos+1); - end - - end - else - return 1; /* all file without extension is included. */ - - return 0; - -/* returns boolean, TRUE if include; false if exclude */ -filterDirectory: procedure - parse arg sDir - - i = lastpos('\', sDir) - if i == 0 then - i = length(sDir); - else - i = i + 1; - sDir = substr(sDir, i); - - sExcludeDir = 'CVS;old;new;object;list;bin;obj;'; - - /* look for sExt in sIncludeExt */ - do while pos(';', sExcludeDir) > 0 - ipos = pos(';', sExcludeDir) - if sDir == substr(sExcludeDir, 1, ipos-1) then - return 0; - sExcludeDir = substr(sExcludeDir, ipos+1); - end - - return 1; - +/* $Id: genproject.cmd,v 1.5 2000-11-15 00:20:44 bird Exp $ + * + * This script generates a Visual Slick project of the source and include + * files found in the directory tree starting at the current directory. + * + * Copyright (c) 1999-2000 knut st. osmundsen + * + * Project Odin Software License can be found in LICENSE.TXT + * + */ + call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'; + call SysLoadFuncs; + + parse arg sArg + + sIncludes = ''; + sProjFile = ''; + fFullDir = 1; + fRecursive = 0; + + sArgs.0 = 0; + i = 0; + do while sArg \= '' + i = i + 1; + ipos = pos(' ', sArg); + if ipos == 0 then do + sArgs.i = substr(sArg, 1); + sArg = ''; + end + else do + sArgs.i = substr(sArg, 1, ipos); + /* next */ + sArg = substr(sArg, ipos); + do while substr(sArg, 1, 1) == ' ' | substr(sArg, 1, 1) == '\t' + sArg = substr(sArg, 2); + end + end + end + sArgs.0 = i; + + /* check if no parameters */ + if i = 0 then + do + say 'error: no arguments!'; + call syntax; + end + + /* parse arguments */ + do i = 1 to sArgs.0 + sArg = sArgs.i; + if substr(sArg, 1, 1) == '-' | substr(sArg, 1, 1) == '/' then do + /* option */ + chArg = substr(sArg, 2, 1); + sArg = strip(substr(sArg, 3)); + select + when chArg = 'I' | chArg = 'i' then do + if (sArg <> '' & substr(sArg, length(sArg), 1) <> ';') then + sincludes = sIncludes || sArg || ';'; + else + sIncludes = sIncludes || sArg; + end + + when chArg = 'f' | chArg = 'F' then do + fFullDir = 1; + end + + when chArg = 'r' | chArg = 'R' then do + fFullDir = 0; + end + + when chArg = 'h' | chArg = '?' | sArg = '-help' then do + call syntax; + end + + when chArg = 's' | chArg = 'S' then do + fRecursive = 1; + end + + otherwise do + say 'illegal option: 'chArg||sArg + call syntax; + end + end + end + else do + if sProjFile = '' then + sProjFile = sArg; + else do + say 'error! multiple project names!' + call syntax; + end + end + end /* do */ + + say 'Will now generate :' sProjFile + say 'Includes specified:' sIncludes + + /* delete old target files */ + call SysFileDelete sProjFile; + if lastpos('.', sProjFile) > 0 then /* tag file */ + call SysFileDelete substr(sProjFile, 1, lastpos('.', sProjFile))'vtg' + + /* open target file */ + if (stream(sProjFile, 'c', 'open write' ) <> '') then do + call lineout sProjFile, '[COMPILER]' + call lineout sProjFile, 'MACRO=odin32_setcurrentdir();\nodin32_maketagfile();\n' + call lineout sProjFile, 'FILTEREXPANSION=1 1 0 0 1' + call lineout sProjFile, 'compile=concur|capture|clear|:Compile:&Compile,nmake .\bin\debug\%n.obj' + call lineout sProjFile, 'make=concur|capture|clear|:Build:&Build,nmake' + call lineout sProjFile, 'rebuild=concur|capture|clear|:Rebuild:&Rebuild,nmake -a' + call lineout sProjFile, 'debug=:Debug:&Debug,' + call lineout sProjFile, 'execute=:Execute:E&xecute,' + call lineout sProjFile, 'user1=hide|:User 1:User 1,' + call lineout sProjFile, 'user2=hide|:User 2:User 2,' + call lineout sProjFile, 'usertool_resource_editor=hide|:Resource Editor:Resource Editor,dlgedit' + call lineout sProjFile, 'workingdir='directory() + /* TODO */ + call lineout sProjFile, 'includedirs='||sIncludes||'%(INCLUDE)' + call lineout sProjFile, 'tagfiles=' + call lineout sProjFile, 'reffile=' + + call lineout sProjFile, '[FILES]' + call processDirTree sProjFile, directory(), directory(), fRecursive, fFullDir; + call lineout sProjFile, '[ASSOCIATION]' + call lineout sProjFile, '[STATE]' + call lineout sProjFile, 'FILEHIST: 0' + call lineout sProjFile, 'PRINTER: 2' + + call stream sIncFile, 'c', 'close'; + end + else do + say 'oops, failed to open outputfile,' sProjFile; + exit 1; + end + + exit (0); + + + + + + +/*********************/ +/* procedure section */ +/*********************/ + +syntax: procedure + say 'Syntax: genproject.cmd [-I]' + say ' switches: -s Recursivly scan subdirectories too.' + say ' (default: Current dir only)' + say ' -f Full filenames. (default)' + say ' -r Relative filenames. (default: -f)' + say ' -I Include directories.' + say 'Copyright (c) 1999-2000 knut st. osmundsen' + exit (1); + +/* processes an directory tree */ +processDirTree: procedure + parse arg sProjFile, sDirectory, sRoot, fRecursive, fFullDir + + rc = SysFileTree(sDirectory'\*', sFiles, 'FO'); + if rc == 0 then do + do i = 1 to sFiles.0 + if filterFile(sFiles.i) then + do + if (fFullDir) then + call lineout sProjFile, sFiles.i; + else + call lineout sProjFile, substr(sFiles.i, length(sRoot)+2); + end + end + end + + if (fRecursive) then + do + rc = SysFileTree(sDirectory'\*', sDirs, 'DO'); + if rc == 0 then do + do i = 1 to sDirs.0 + if filterDirectory(sDirs.i) then + call processDirTree sProjFile, sDirs.i, sRoot, fRecursive, fFullDir + end + end + end + + + return; + + +/* returns boolean, TRUE if include; false if exclude */ +filterFile: procedure + parse arg sFile + + if lastpos('\', sFile) < lastpos('.', sFile) then do + sIncludeExt = 'c;cpp;h;hpp;inc;asm;rc;mak;cmd;mk;def;txt;orc;dlg;doc;ipf;' + sExt = substr(sFile, lastpos('.', sFile)+1); + + /* look for sExt in sIncludeExt */ + do while pos(';', sIncludeExt) > 0 + ipos = pos(';', sIncludeExt) + if sExt == substr(sIncludeExt, 1, ipos-1) then + return 1; + sIncludeExt = substr(sIncludeExt, ipos+1); + end + + end + else + return 1; /* all file without extension is included. */ + + return 0; + +/* returns boolean, TRUE if include; false if exclude */ +filterDirectory: procedure + parse arg sDir + + i = lastpos('\', sDir) + if i == 0 then + i = length(sDir); + else + i = i + 1; + sDir = substr(sDir, i); + + sExcludeDir = 'CVS;old;new;object;list;bin;obj;'; + + /* look for sExt in sIncludeExt */ + do while pos(';', sExcludeDir) > 0 + ipos = pos(';', sExcludeDir) + if sDir == substr(sExcludeDir, 1, ipos-1) then + return 0; + sExcludeDir = substr(sExcludeDir, ipos+1); + end + + return 1; + diff --git a/tools/wrc/Makefile.kmk b/tools/wrc/Makefile.kmk index f83161a..a25916f 100644 --- a/tools/wrc/Makefile.kmk +++ b/tools/wrc/Makefile.kmk @@ -1,39 +1,39 @@ -## @file -# WRC makefile. -# -# Note. If you wanna recompile everything you'll need flex and bison. -# Both are found at hobbes. See original makefiles. -# - -SUB_DEPTH = ../.. -include $(KBUILD_PATH)/subheader.kmk - -# Note: while the tool is originally named wrc in Wine, we -# name it winerc to avoid the naming conflict with Watcom RC - -BLDPROGS += winerc -winerc_TEMPLATE = OdinBin - -# @todo: the need of this for BLDPROGS looks like a kBuild bug to me -winerc_INST = bin/ -winerc_INSTTYPE = stage - -winerc_SOURCES = \ - dumpres.c \ - genres.c \ - newstruc.c \ - preproc.c \ - readres.c \ - utils.c \ - wrc.c \ - y.tab.c \ - lexyy.c \ - ppy.tab.c \ - lex.ppl.c \ - writeres.c \ - wrc.def - -winerc_LIBS += \ - $(PATH_STAGE_LIB)/unicode.lib - -include $(FILE_KBUILD_SUB_FOOTER) +## @file +# WRC makefile. +# +# Note. If you wanna recompile everything you'll need flex and bison. +# Both are found at hobbes. See original makefiles. +# + +SUB_DEPTH = ../.. +include $(KBUILD_PATH)/subheader.kmk + +# Note: while the tool is originally named wrc in Wine, we +# name it winerc to avoid the naming conflict with Watcom RC + +BLDPROGS += winerc +winerc_TEMPLATE = OdinBin + +# @todo: the need of this for BLDPROGS looks like a kBuild bug to me +winerc_INST = bin/ +winerc_INSTTYPE = stage + +winerc_SOURCES = \ + dumpres.c \ + genres.c \ + newstruc.c \ + preproc.c \ + readres.c \ + utils.c \ + wrc.c \ + y.tab.c \ + lexyy.c \ + ppy.tab.c \ + lex.ppl.c \ + writeres.c \ + wrc.def + +winerc_LIBS += \ + $(PATH_STAGE_LIB)/unicode.lib + +include $(FILE_KBUILD_SUB_FOOTER)