home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PRECOM.ZIP / PRECOMP.MOD < prev    next >
Text File  |  1992-12-18  |  26KB  |  786 lines
  1. MODULE PreComp;
  2.  
  3. (****************************************************************************
  4.  
  5.  
  6.    Precompiler for Mod2 Programs written for the IBM Database Manager
  7.    Written by: Ed Ross
  8.    Date      : 9/24/92
  9.  
  10.  
  11.    Copyright Ed Ross, PMI 1992, All rights reserved
  12.  
  13.  
  14.    Some ramdom thoughts you will want to remove
  15.  
  16.    This precompile will process Mod2 programs with embedded SQL statements
  17.    and translate them to the appropiate calls to the IBM Database Manager.
  18.  
  19.    The DEFINITION modules must have the extention "SQD"
  20.    The IMPLEMENTATION modules must have the extention "SQM"
  21.  
  22.    The precomile MUST compile both the def and the mod files at the same
  23.    time.  (NOTE - the definition module is optional.  It is only included
  24.    so record types and variables can be shared.  The implementation module
  25.    must be present).  The definition module may only have the
  26.        EXEC SQL BEGIN DECLARE
  27.    and EXEC SQL END DECLARE sections.
  28.  
  29.    The input parameters are the same as the IBM precompile.  However, not
  30.    all options make sense in a MOD2 envirionment.
  31.  
  32.  
  33.    Only simple types are alowed in the DECLARE section.  Any complex type
  34.    is ignored.  (you can create complex types or objects by adding 
  35.    there definition to the table - then expanding them at compile time)
  36.  
  37.     I use a Genlis module that uses the Object extentions for JPI.  This could
  38.     easily be replaced with just record reads from a file or the GenList
  39.     from PMI.
  40.  
  41.  
  42.  NEW FEATURE
  43.    A mod file can "import" other def files to get additional host variables
  44.    by adding a (* SQLIMPORT filename *)  The file name is assumed not to have
  45.    any etentions
  46.  
  47.     N O T E  - this should be changed to use the redirection file from
  48.     the JPI stuff
  49.  
  50.  
  51. ***************************************************************)
  52.  
  53.  
  54. FROM Lists IMPORT GenList,StrElmt;
  55. FROM ParseVar IMPORT GetVars,RemoveComment,SQLStatement,PrepareSQL,GetVarName;
  56. FROM FIO IMPORT File,WrStr,WrLn,Create,WrCard,Close,StandardOutput,Exists;
  57. FROM FormIO IMPORT WrF1,WrF2,WrF3,WrF4,WrF5;
  58. FROM IO IMPORT WrStrRedirect;
  59. FROM Str IMPORT Copy,Pos,Append,Delete,Length,Subst,Caps,Compare;
  60. FROM Lib IMPORT Fill,ParamCount,ParamStr;
  61. FROM SQLCA IMPORT sqlca;
  62. FROM SQLStuff IMPORT SQLErrorHandler;
  63. IMPORT SQLPREP;
  64. FROM SQL IMPORT SQLGINTP;
  65. FROM SQLPREP IMPORT SQLA_START, SQLA_DECLARE, SQLA_INCLUDE, SQLA_ALLOC_INPUT,
  66.       SQLA_ALLOC_OUTPUT, SQLA_SETS, SQLA_USDA_INPUT, SQLA_USDA_OUTPUT, SQLA_CALL,
  67.       SQLA_DEALLOC, SQLA_STOP,     SQLA_SQLERROR,     SQLA_SQLWARNING, SQLA_NOT_FOUND;    
  68.  
  69.  
  70. CONST
  71.   MaxSqlStmLen = 2000;
  72.   MaxLineLength = 320;
  73.  
  74.  
  75. TYPE
  76.   ProcessType = (DefFile,ModFile,Done);
  77. VAR
  78.   Process : ProcessType;
  79.   TheString : StrElmt;
  80.   TheStr : ARRAY[0..MaxLineLength] OF CHAR;
  81.   TestStr : ARRAY[0..MaxLineLength] OF CHAR;
  82.   TheList : GenList;
  83.   J : CARDINAL;
  84.   Statement : ARRAY[0..MaxSqlStmLen] OF CHAR;
  85.   SectionNbr : CARDINAL;
  86.   SQLComment : CARDINAL;
  87.   Optimize   : BOOLEAN;  (* variable initialization *)
  88.  
  89.   InComment  : CARDINAL;
  90.   OutFile    : File;
  91.   InDeclare  : BOOLEAN;
  92.   MsgFile    : File;
  93.  
  94.   sqldaID    : CARDINAL;    (* needed for runtime services *)
  95.   InProgName : ARRAY[0..12] OF CHAR;
  96. (* data structures used by precompiler services *)
  97.  
  98.  
  99.   Options    : SQLPREP.sqla_options;
  100.   TaskArray  : SQLPREP.sqla_tasks;
  101.   TokenArray : SQLPREP.sqla_tokens;
  102.   ProgramRec : SQLPREP.sqla_program_id;
  103.   CA         : sqlca;
  104.  
  105.  
  106.  
  107. PROCEDURE  Intercept(Str : ARRAY OF CHAR);
  108. (* this routine will take the output of WrStr from IO and place it in
  109.    the global TheStr.  This is done so I can use the format IO mixed
  110.    with the regular file IO
  111.  
  112. *)
  113. BEGIN
  114.   Copy(TheStr,Str);
  115. END Intercept;
  116.  
  117.  
  118. PROCEDURE CalcOptionCnt(Opt : SQLPREP.sqla_options): LONGCARD;
  119. VAR
  120.   S : CARDINAL;
  121. BEGIN
  122.   S := SIZE(Opt) - SIZE(Opt.Header); (* size of options field*)
  123.   RETURN LONGCARD(S DIV SIZE(Opt.Option[1]))-1;
  124. END CalcOptionCnt;
  125.  
  126. PROCEDURE ParamType(InParam : ARRAY OF CHAR; VAR Typ : CHAR; VAR  Value : ARRAY OF CHAR);
  127.  
  128. BEGIN
  129.   Caps(InParam);
  130.   IF (Pos(InParam,'.') < MAX(CARDINAL))  (* no extention existed *)
  131.   THEN InParam[Pos(InParam,'.')] := 0C;  (* set to no extention *)
  132.   END;
  133.   Copy(Value,'');
  134.   Subst(InParam,'-','/');  (* allow either the '/' or '-' switch *)
  135.   IF Pos(InParam,'/') = MAX(CARDINAL)  (* no switch was supplied *)
  136.     THEN
  137.       Typ := 'D';   (* assume it was the database name *)
  138.       Copy(Value,InParam);
  139.       RETURN;
  140.     END;
  141.   Typ := InParam[1];  (* take the char after the switch *)
  142.   IF Pos(InParam,'=') = MAX(CARDINAL)
  143.     THEN RETURN;  (* no value supplied *)
  144.     END;
  145.   Copy(Value,InParam[Pos(InParam,'=')+1]);  (* copy the value *)
  146.  
  147.  
  148. END ParamType;
  149.  
  150.  
  151. PROCEDURE Usage();  (* if no parameters or less than two pramaeters specified*)
  152. BEGIN
  153.   WrStr(MsgFile,'  * * * * Modula 2 SQL Precompiler for IBM Database Manager ');
  154.   WrLn(MsgFile);
  155.   WrStr(MsgFile,'Usage is same as the IBM "SQLPREP" precompiler for "C"');
  156. END Usage;
  157.  
  158. PROCEDURE SetOption(VAR  Opt : SQLPREP.sqla_options; Type, Option : LONGCARD);
  159. VAR Idx : CARDINAL;
  160. BEGIN
  161.  INC(Opt.Header.used);  (* use next available option *)
  162.  Idx := CARDINAL(Opt.Header.used);
  163.  Opt.Option[Idx].type :=Type;
  164.  Opt.Option[Idx].value := Option;
  165. END SetOption;
  166.  
  167.  
  168. PROCEDURE Initialize();
  169. TYPE
  170.   Param = ARRAY[0..80] OF CHAR;
  171. VAR J : CARDINAL;
  172.   L1,L2,L3,L4,L5 : CARDINAL;
  173.  
  174.   OutProgName : ARRAY[0..12] OF CHAR;
  175.   BindFileName : ARRAY[0..12] OF CHAR;
  176.   InParams     : ARRAY[1..12] OF Param;
  177.   DataBaseName : ARRAY[0..12] OF CHAR;
  178.   Password     : ARRAY[0..12] OF CHAR;
  179.   MsgFileName  : ARRAY[0..12] OF CHAR;
  180.   TmpProgName  : ARRAY[0..12] OF CHAR;
  181.  
  182.   PT           : CHAR;
  183.   Value        : ARRAY[0..80] OF CHAR;
  184.  
  185.  
  186.  
  187. (* options used by database manager *)
  188.   Blocking,
  189.   BindFile,
  190.   Format,
  191.   Cursor,
  192.   Plan : LONGCARD;
  193.  
  194.  
  195. BEGIN
  196. (* assign defaults to the input parameters *)
  197.  
  198.   Optimize := FALSE;
  199.   Blocking := SQLPREP.SQLA_NO_BLOCK;
  200.   Format   := SQLPREP.SQLA_POA_DEF;
  201.   BindFile := SQLPREP.SQLA_NO_BIND_FILE;
  202.   Plan     := SQLPREP.SQLA_CREATE_PLAN;
  203.  
  204.   WrStrRedirect := Intercept;  (* intercept the results of formated IO *)
  205.   MsgFile := StandardOutput;
  206.   sqldaID := 0;
  207.   Fill(ADR(Options),SIZE(Options),0);
  208.   Fill(ADR(CA),SIZE(sqlca),0);
  209.   Fill(ADR(TaskArray),SIZE(TaskArray),0);
  210.   Fill(ADR(TokenArray),SIZE(TokenArray),0);
  211.  
  212.  
  213.   Options.Header.allocated := CalcOptionCnt(Options);
  214.   TaskArray.Header.allocated  := SQLPREP.MaxTasks;
  215.   TokenArray.Header.allocated := SQLPREP.MaxTokens;
  216.  
  217.  
  218.   (*
  219.  
  220.  
  221.   *)
  222.  
  223.  
  224.   FOR J := 1 TO ParamCount() DO  (* get input parameters *)
  225.     ParamStr(InParams[J],J);
  226.   END;
  227.  
  228.   IF J < 2
  229.     THEN
  230.       Usage();
  231.       HALT;
  232.     END;
  233.   Fill(ADR(ProgramRec),SIZE(ProgramRec),0);
  234.   Copy(InProgName,  InParams[1]);
  235.   InProgName[8] :=0C;   (* program name SIZE MAX 8 *)
  236.   Copy(DataBaseName,InParams[2]);
  237.   IF Length(DataBaseName) < 2
  238.     THEN Copy(DataBaseName,InProgName);
  239.     END;
  240.  
  241.  
  242.  
  243.   IF (Pos(InProgName,'.') < MAX(CARDINAL))  (* no extention existed *)
  244.     THEN InProgName[Pos(InProgName,'.')] := 0C;
  245.     END;
  246.  
  247.   Copy(TmpProgName,InProgName);
  248.   Copy(OutProgName,InProgName);
  249.   Copy(MsgFileName,InProgName);
  250.   Append(MsgFileName,'.log');
  251.   MsgFile := Create(MsgFileName);
  252.   WrStr(MsgFile,'Precompiler FOR - ');
  253.   WrStr(MsgFile,InProgName);
  254.   WrLn(MsgFile);
  255.   Append(TmpProgName,'.SQD');
  256.   IF Exists(TmpProgName)
  257.     THEN
  258.       Append(OutProgName,'.DEF');
  259.       Process := ModFile;    (* set up for next time *)
  260.     ELSE
  261.       Copy(TmpProgName,InProgName);
  262.       Append(TmpProgName,'.sqm');
  263.       IF NOT Exists(TmpProgName)
  264.         THEN
  265.           WrStr(MsgFile,'Not source specified ');
  266.           WrStr(MsgFile,InProgName);
  267.           Close(MsgFile);
  268.           HALT;
  269.         END;
  270.       Append(OutProgName,'.MOD');
  271.       Process := Done;       (* no def file - process the mod file *)
  272.   END;
  273.  
  274.  
  275.   Copy(BindFileName,InProgName);
  276.  
  277.   Append(BindFileName,'.bnd');
  278.  
  279.   J := 2;
  280.   LOOP
  281.    IF J > ParamCount()
  282.      THEN EXIT;
  283.      END;
  284.    ParamType(InParams[J],PT,Value);
  285.    CASE PT OF
  286.      'D' : Copy(DataBaseName,Value);   (* override database name *)
  287.  
  288.     |'B' : BindFile := SQLPREP.SQLA_CREATE_BIND_FILE;
  289.            IF Length(Value) > 0
  290.              THEN
  291.                Copy(BindFileName,Value);
  292.                Append(BindFileName,'.bnd');
  293.              END;
  294.     |'C' : (* nothing  what to do with include SQLCA/DA *)
  295.     |'F' : IF Pos(Value,'USA') < MAX(CARDINAL)
  296.              THEN Format := SQLPREP.SQLA_POA_USA;
  297.             ELSIF Pos(Value,'EUR') < MAX(CARDINAL)
  298.              THEN Format := SQLPREP.SQLA_POA_EUR;
  299.             ELSIF Pos(Value,'ISO') < MAX(CARDINAL)
  300.              THEN Format := SQLPREP.SQLA_POA_ISO;
  301.             ELSIF Pos(Value,'JIS') < MAX(CARDINAL)
  302.              THEN Format := SQLPREP.SQLA_POA_JIS;
  303.             ELSIF Pos(Value,'LOC') < MAX(CARDINAL)
  304.               THEN Format := SQLPREP.SQLA_POA_LOC;
  305.             ELSE Format := SQLPREP.SQLA_POA_DEF;   (* default *)
  306.             END;
  307.    |'I'  : IF Pos(Value,'RR') < MAX (CARDINAL)
  308.              THEN Cursor := SQLPREP.SQLA_REPEATABLE_READ;
  309.             ELSIF Pos(Value,'UR') < MAX(CARDINAL)
  310.              THEN Cursor := SQLPREP.SQLA_UNCOMMITTED_READ;
  311.             ELSE Cursor := SQLPREP.SQLA_CURSOR_STABILITY;
  312.            END;
  313.            SetOption(Options,SQLPREP.SQLA_ISOLATION,Cursor);
  314.    |'K'  : IF Pos(Value,'ALL') < MAX(CARDINAL)
  315.              THEN
  316.                Blocking := SQLPREP.SQLA_BLOCK_ALL;
  317.              ELSIF Pos(Value,'UNAMBIG') < MAX(CARDINAL)
  318.                THEN Blocking := SQLPREP.SQLA_BLOCK_UNAMBIG;
  319.              ELSE Blocking := SQLPREP.SQLA_NO_BLOCK;
  320.            END;
  321.            SetOption(Options,SQLPREP.SQLA_BLOCK,Blocking);
  322.    |'P'  : Plan := SQLPREP.SQLA_CREATE_PLAN;
  323.    |'M'  : MsgFile := Create(Value);
  324.    |'O'  : Optimize := TRUE;
  325.    END;
  326.    INC(J);
  327.  END;  (* end of loop *)
  328.  
  329. (* these three options must always be present in the initilaization *)
  330.  
  331.   SetOption(Options,SQLPREP.SQLA_FORMAT,Format);
  332.   SetOption(Options,SQLPREP.SQLA_ACCESS_PLAN,Plan);
  333.   SetOption(Options,SQLPREP.SQLA_BIND_FILE,BindFile);
  334.  
  335.   L1 := Length(InProgName);
  336.   L2 := Length(DataBaseName);
  337.   L3 := 0;
  338.   L4 := Length(BindFileName);
  339.  
  340.   WrStr(MsgFile,'Starting MOD2 precompiler for IBM Database Manager');
  341.   SQLPREP.SQLGINIT(L1,TmpProgName,
  342.                    L2,DataBaseName,
  343.                    L3,Password,
  344.                    L4,BindFileName,
  345.                    Options,
  346.                    ProgramRec,
  347.                    NIL,
  348.                    CA);
  349.  
  350.   IF CA.sqlcode < 0
  351.     THEN
  352.       SQLErrorHandler(MsgFile,'Initializing',CA);
  353.     END;
  354.   TheList.FileToList(TmpProgName);
  355.   OutFile := Create(OutProgName);
  356.  
  357. END Initialize;
  358.  
  359.  
  360.  
  361. PROCEDURE InitializeMod();
  362. VAR
  363.   OutProgName  : ARRAY[0..12] OF CHAR;
  364. BEGIN
  365.   Process := Done;
  366.   Copy(OutProgName,InProgName);
  367.   Append(OutProgName,'.mod');
  368.   Append(InProgName,'.sqm');   (* set up for mod file *)
  369.   TheList.DisposeList();
  370.  
  371.   TheList.FileToList(InProgName);
  372.   OutFile := Create(OutProgName);
  373.  
  374. END InitializeMod;
  375.  
  376.  
  377. VAR
  378.   InputSQLDA,OutputSQLDA : CARDINAL;
  379.  
  380. PROCEDURE GenCode();
  381.   (* use the task array to determine the type of code to generate *)
  382. CONST
  383.  
  384. VAR TaskNbr : CARDINAL;
  385.     J,K     : CARDINAL;
  386.     typ     : CARDINAL;
  387.     len     : CARDINAL;
  388.     VarName : ARRAY[0..30] OF CHAR;
  389.     CallType : CARDINAL;
  390.     val     : CARDINAL;
  391.     IndVar  : ARRAY[0..30] OF CHAR;
  392.     PID     : POINTER TO ARRAY[1..40] OF CHAR;
  393.  
  394.  
  395. PROCEDURE GenSetV(K, Index: CARDINAL);
  396. BEGIN
  397.     WrF4('    RC :=SQLPREP.SQLASETV(%u,%u,%u,SIZE(%s),',sqldaID,Index,typ,VarName);
  398.     WrStr(OutFile,TheStr);
  399.     IF (Compare(IndVar,'NIL') = 0)
  400.       THEN
  401.          WrF2('ADR(%s),%s,NIL);',VarName,IndVar)
  402.       ELSE
  403.          WrF2('ADR(%s),ADR(%s),NIL);',VarName,IndVar);
  404.       END;
  405.     WrStr(OutFile,TheStr);
  406.     WrLn(OutFile);
  407. END GenSetV;
  408.  
  409.  
  410. PROCEDURE GenSetVArray(InputVars : BOOLEAN);
  411. VAR V : CARDINAL;
  412.     IndTyp,IndLen : CARDINAL;
  413.     Idx : CARDINAL;
  414.  
  415. (* If an input or output SQLDA was allocated,
  416.    Associate each of the variables used to that SQLDA
  417.    using the SQLASETV procedure
  418.  
  419. *)
  420.  
  421.  
  422. BEGIN
  423.   Idx := 0;
  424.   INC(sqldaID);   (* make unique ID for this sql statement *)
  425.   IF InputVars
  426.     THEN InputSQLDA := sqldaID;
  427.     ELSE OutputSQLDA := sqldaID;
  428.   END;
  429.   WrF3('  RC := SQLPREP.SQLAALOC(%u,%u,%u,NIL);',sqldaID,val,sqldaID);
  430.   WrStr(OutFile,TheStr); (* results from formatio in thestr*)
  431.   WrLn(OutFile);
  432.  
  433.  
  434. (* one of the optimizations that can be done*)
  435. (* is to avoid redundent initialization of varaibles *)
  436. (* this optimization is only used if the optimize option was selected *)
  437.   IF Optimize
  438.     THEN
  439.        WrStr(OutFile,'  IF (SQLca.sqlcode =0)(* new sqlda?*) ');
  440.        WrLn(OutFile);
  441.        WrStr(OutFile,'  THEN  (* init vars *)');
  442.        WrLn(OutFile);
  443.     END;
  444.  
  445.  
  446.  
  447.  
  448.   FOR V := 1 TO CARDINAL(TokenArray.Header.used) DO  (* for each token *)
  449.   GetVarName(VarName,typ,len,TokenArray.Tokens[V].tokenID);
  450.   CASE InputVars OF
  451.     TRUE :
  452.           CASE CARDINAL(TokenArray.Tokens[V].use ) OF
  453.               SQLPREP.SQLA_INPUT_HVAR : Copy(IndVar,'NIL');
  454.                                             GenSetV(V,Idx);
  455.                                             INC(Idx);
  456.              |SQLPREP.SQLA_INPUT_WITH_IND:  GetVarName(IndVar,IndTyp,IndLen,TokenArray.Tokens[V+1].tokenID);
  457.                                             INC(typ);  (* make type to include nul indicator*)
  458.                                             GenSetV(V,Idx);
  459.                                             INC(Idx);
  460.              |SQLPREP.SQLA_INVALID_ID     : WrF1(' Invalid hostvariable ID - %u',
  461.                                                   TokenArray.Tokens[V].tokenID);
  462.                                             WrStr(MsgFile,TheStr);
  463.                                             WrLn(MsgFile);
  464.              |SQLPREP.SQLA_INVALID_USE    : WrF1(' Invalid use for token - %s ',VarName);
  465.                                             WrStr(MsgFile,TheStr);
  466.                                             WrLn(MsgFile);
  467.              |SQLPREP.SQLA_USER_SQLDA     :
  468.              |SQLPREP.SQLA_INDICATOR      :
  469.           END; (*case use of *)
  470.  
  471.    |FALSE :
  472.              CASE CARDINAL(TokenArray.Tokens[V].use ) OF
  473.               SQLPREP.SQLA_OUTPUT_HVAR    : Copy(IndVar,'NIL');
  474.                                             GenSetV(V,Idx);
  475.                                             INC(Idx);
  476.              |SQLPREP.SQLA_OUTPUT_WITH_IND: GetVarName(IndVar,IndTyp,IndLen,TokenArray.Tokens[V+1].tokenID);
  477.                                             INC(typ);  (* make type to include nul indicator*)
  478.                                             GenSetV(V,Idx);
  479.                                             INC(Idx);
  480.              |SQLPREP.SQLA_INVALID_ID     : WrF1(' Invalid hostvariable ID - %u',
  481.                                                   TokenArray.Tokens[V].tokenID);
  482.                                             WrStr(MsgFile,TheStr);
  483.                                             WrLn(MsgFile);
  484.              |SQLPREP.SQLA_INVALID_USE    : WrF1(' Invalid use for token - %s ',VarName);
  485.                                             WrStr(MsgFile,TheStr);
  486.                                             WrLn(MsgFile);
  487.              |SQLPREP.SQLA_USER_SQLDA     :
  488.              |SQLPREP.SQLA_INDICATOR      :
  489.           END;
  490.  
  491.  
  492.  
  493.           END;
  494.  
  495.  
  496.     END; (* end for *)
  497.     IF Optimize
  498.         THEN
  499.           WrStr(OutFile,' END;  (* end if new sqlda *) ');
  500.         END;
  501.     WrLn(OutFile);
  502. END GenSetVArray;
  503.  
  504. BEGIN
  505.   InputSQLDA := 0;
  506.   OutputSQLDA := 0;
  507.   FOR TaskNbr := 1 TO CARDINAL(TaskArray.Header.used) DO
  508.     WITH TaskArray.tasks[TaskNbr] DO
  509.       val := CARDINAL(value);
  510.       CASE  CARDINAL(func) OF
  511.  
  512.           SQLA_START         : WrStr(OutFile,'  RC := SQLPREP.SQLASTRT(ADR(xxProgName),NIL,SQLca); (* get semaphore*)');
  513.                                WrLn(OutFile);
  514.          |SQLA_DECLARE       : IF (val = SQLPREP.SQLA_BEGIN)
  515.                                   THEN InDeclare := TRUE
  516.                                   ELSE InDeclare := FALSE;
  517.                                END;
  518.          |SQLA_INCLUDE       : (* this option will include the needed vars, *)
  519.                                (* const, and structures into the source code *)
  520.                                WrStr(OutFile,'(***** included by precompiler *)');
  521.                                WrLn(OutFile);
  522.                                WrStr(OutFile,'FROM SQLDA IMPORT sqlda,sqldaPtr;');
  523.                                WrLn(OutFile);
  524.                                WrStr(OutFile,'FROM SQLCA IMPORT sqlca;');
  525.                                WrLn(OutFile);
  526.                                WrStr(OutFile,'FROM SQLStuff IMPORT AllocSQLDA, DeallocSQLDA,SQLErrorHandler;');
  527.                                WrLn(OutFile);
  528.  
  529.                                WrStr(OutFile,'CONST');
  530.                                WrLn(OutFile);
  531.                                WrStr(OutFile,"xxProgName = ");
  532.                                PID := ADR(ProgramRec);
  533.                                K := 0;
  534.                                FOR J := 1 TO 39 DO
  535.                                  WrF1('CHR(%u) +',ORD(PID^[J]));
  536.                                  WrStr(OutFile,TheStr);
  537.                                  INC(K);
  538.                                  IF (K MOD 8) = 0
  539.                                    THEN
  540.                                      WrLn(OutFile);
  541.                                      WrStr(OutFile,'        ');
  542.                                    END;
  543.                                END;
  544.                                WrF1('CHR(%u);',ORD(PID^[40]));
  545.                                WrStr(OutFile,TheStr);
  546.                                WrLn(OutFile);
  547.                                WrStr(OutFile,'VAR ');
  548.                                WrLn(OutFile);
  549.                                WrStr(OutFile,'  SQLca : sqlca; (* communications area*)');
  550.                                WrLn(OutFile);
  551.                                WrStr(OutFile,'  SQLda : sqldaPtr; (* data area (if needed ) *)');
  552.                                WrLn(OutFile);
  553.                                WrStr(OutFile,'  RC    : CARDINAL;');
  554.                                WrLn(OutFile);
  555.  
  556.  
  557.  
  558.  
  559.          |SQLA_ALLOC_INPUT   : GenSetVArray(TRUE);
  560.  
  561.          |SQLA_ALLOC_OUTPUT  : GenSetVArray(FALSE);
  562.  
  563.          |SQLA_SETS          :GetVarName(VarName,typ,len,value);
  564.                               WrF2('RC := SQLPREP.SQLASETS(Length(%s),%s,NIL);',VarName,VarName);
  565.                               WrStr(OutFile,TheStr);
  566.                               WrLn(OutFile);
  567.  
  568.          |SQLA_USDA_INPUT    :INC(sqldaID);   (* make unique ID for this sql statement *)
  569.                               InputSQLDA := sqldaID;
  570.                               GetVarName(VarName,typ,len,value);
  571.                               WrF2('RC := SQLPREP.SQLAUSDA(%u,%s,NIL);',sqldaID,VarName);
  572.                               WrStr(OutFile,TheStr);
  573.                               WrLn(OutFile);
  574.          |SQLA_USDA_OUTPUT   :INC(sqldaID);   (* make unique ID for this sql statement *)
  575.                               OutputSQLDA := sqldaID;
  576.                               GetVarName(VarName,typ,len,value);
  577.                               WrF2('RC := SQLPREP.SQLAUSDA(%u,%s,NIL);',sqldaID,VarName);
  578.                               WrStr(OutFile,TheStr);
  579.                               WrLn(OutFile);
  580.          |SQLA_CALL          :
  581.                               WrF4('  RC := SQLPREP.SQLACALL(%u,%u,%u,%u,NIL); ',
  582.                                     val,SectionNbr,InputSQLDA,OutputSQLDA);
  583.                               WrStr(OutFile,TheStr);
  584.                               WrLn(OutFile);
  585.          |SQLA_DEALLOC       :
  586.          |SQLA_STOP          : WrStr(OutFile,'  RC := SQLPREP.SQLASTOP(NIL);(* release semephore*)');
  587.                                WrLn(OutFile);
  588.  
  589.          |SQLA_SQLERROR      : WrStr(OutFile,' IF SQLca.sqlcode < 0');
  590.                                WrLn(OutFile);
  591.                                WrStr(OutFile,'   THEN SQLErrorHandler(0,"DATA BASE ERROR",SQLca);');
  592.                                WrLn(OutFile);
  593.                                WrStr(OutFile,'   END;');
  594.                                WrLn(OutFile);
  595.  
  596.          |SQLA_SQLWARNING    : WrStr(OutFile, 'IF ((SQLca.sqlcode > 0) AND'   );
  597.                                WrLn(OutFile);
  598.                                WrStr(OutFile, '    (SQLca.sqlcode <> 100)  OR');
  599.                                WrLn(OutFile);
  600.                                WrStr(OutFile, '   ((SQLca.sqlcode = 0  AND'   );
  601.                                WrLn(OutFile);
  602.                                WrStr(OutFile, "    (SQLca.sqlwarn[0] = 'W')"  );
  603.                                WrLn(OutFile);
  604.                                WrStr(OutFile,'   THEN');
  605.                                WrLn(OutFile);
  606.                                WrStr(OutFile,'     SQLErrorHandler(0,"DATA BASE ERROR ",SQLca);');
  607.                                WrLn(OutFile);
  608.                                WrStr(OutFile,'   END;');
  609.                                WrLn(OutFile);
  610.          |SQLA_NOT_FOUND     : WrStr(OutFile,'  UNTIL SQLca.sqlcode =100);'); (* not normally used *)
  611.                                WrLn(OutFile);  (* the not found indicates end of loop condition *)
  612.       END; (* end case of *)
  613.     END;
  614.  END;
  615.  
  616. END GenCode;
  617.  
  618. PROCEDURE CompileSQL(Stm : ARRAY OF CHAR);
  619. VAR
  620.   L,V : CARDINAL;
  621.   LineNbr : CARDINAL;
  622.  
  623.   StmtType : CARDINAL;
  624.   buf1,buf2,buf3 : SQLPREP.buf128;
  625.  
  626.   RC : CARDINAL;
  627.   VarName : ARRAY[0..30] OF CHAR;
  628.   typ    : CARDINAL;
  629.   len     : CARDINAL;
  630.  
  631. BEGIN
  632.   L := Length(Stm);
  633.   LineNbr := J;
  634.   RC := SQLPREP.SQLGCMPL(L,Stm,LineNbr,TaskArray,TokenArray,SectionNbr,StmtType,
  635.                          buf1,buf2,buf3,NIL,CA);
  636.   IF CA.sqlcode < 0
  637.     THEN
  638.       WrF1('* * * SQL ERROR \n Statement %s',Stm);
  639.       WrStr(MsgFile,TheStr);
  640.       WrLn(MsgFile);
  641.       SQLErrorHandler(MsgFile,'Statement',CA);
  642.       SQLErrorHandler(OutFile,'Statement',CA);  (* write the error inline *)
  643.  
  644.       WrLn(MsgFile);
  645.       WrStr(MsgFile,'Variables used ');
  646.       WrLn(MsgFile);
  647. (********** Diagnotic help in the event of compile error *)
  648.       FOR V := 1 TO CARDINAL(TokenArray.Header.used) DO  (* for each token *)
  649.         GetVarName(VarName,typ,len,TokenArray.Tokens[V].tokenID);
  650.         WrF3('  %15s   %u   %u',VarName,typ,len);
  651.         WrStr(MsgFile,TheStr);
  652.         WrLn(MsgFile);
  653.       END;
  654.         WrLn(MsgFile);
  655.         WrLn(MsgFile);
  656.     END;
  657.  
  658.  
  659. END CompileSQL;
  660.  
  661. PROCEDURE SQLImport(TheStr : ARRAY OF CHAR) : BOOLEAN;
  662. BEGIN
  663.   Caps(TheStr);
  664.   RETURN Pos(TheStr,'SQLIMPORT') < MAX(CARDINAL);
  665.  
  666.  
  667. END SQLImport;
  668.  
  669.  
  670. PROCEDURE Import(IncludeStr : ARRAY OF CHAR);
  671. (* include a def file to get additional host variables *)
  672. (* if in the modfile an (* SQLIMPORT modulename *) no extention *)
  673. (*  s encountered, *)
  674. (*   Then the def file (only) is included to pick up the additional *)
  675. (*   host variables that could be defined in other modules *)
  676. TYPE
  677.  CharSet = SET OF CHAR;
  678.  
  679. CONST
  680.   Alpha = CharSet{'A'..'Z'};
  681.  
  682. VAR
  683.   IncludeList : GenList;
  684.   J,K : CARDINAL;
  685.   FileName : ARRAY[0..40] OF CHAR;
  686.   TestStr : ARRAY[0..500] OF CHAR;
  687.   DeclareSec : BOOLEAN;
  688.   InComment : CARDINAL;
  689.  
  690. BEGIN
  691.     DeclareSec := InDeclare;
  692.     InComment := 0;
  693.     Subst(IncludeStr,'(*','');  (* get rid of comment part *)
  694.     Subst(IncludeStr,'*)','');
  695.     Subst(IncludeStr,'SQLIMPORT','');
  696.     Caps(IncludeStr);
  697.     Fill(ADR(FileName),SIZE(FileName),0);
  698.     K := 0;
  699.     FOR J := 0 TO Length(IncludeStr) DO
  700.       IF IncludeStr[J] IN Alpha
  701.          THEN
  702.           FileName[K] := IncludeStr[J];
  703.           INC(K);
  704.          END;
  705.     END;
  706.     FileName[8] := 0C;   (* the import name may be longer than 8 char *)
  707.     Append(FileName,'.SQD');
  708.     IncludeList.FileToList(FileName);
  709.     FOR J := 1 TO IncludeList.ListLength() DO
  710.       IncludeList.GetItem(TheString,J);
  711.       Copy(TestStr,TheString.TheStr);
  712.       RemoveComment(TestStr,InComment);
  713.       GetVars(TestStr,InComment); (* get host variables *)
  714.     END;
  715.   IncludeList.DisposeList();
  716. END Import;
  717.  
  718. BEGIN
  719.  
  720.  Process := DefFile;
  721.  
  722.  REPEAT
  723.   IF Process = DefFile
  724.      THEN Initialize();   (* get set up the envirionment and get the def file *)
  725.      ELSE InitializeMod();
  726.   END;
  727.  
  728.   FOR J := 1 TO TheList.ListLength() DO
  729.     TheList.GetItem(TheString,J);
  730.     Copy(TestStr,TheString.TheStr);
  731.     IF SQLImport(TestStr)
  732.       THEN
  733.         Import(TestStr);
  734.       END;
  735.     RemoveComment(TestStr,InComment);
  736.     IF SQLStatement(TestStr)
  737.       THEN
  738.         WrStr(OutFile,'(****');
  739.         WrLn(OutFile);
  740.  
  741.         Fill(ADR(Statement),SIZE(Statement),0);
  742.         Copy(Statement,TheString.TheStr);
  743.         WrStr(OutFile,TheString.TheStr);  (* copy original statement to file*)
  744.         WrLn(OutFile);
  745.         IF (Pos(Statement,';') = MAX(CARDINAL))  (* not end of statement ; wasn't there*)
  746.           THEN
  747.             REPEAT
  748.               INC(J);
  749.               TheList.GetItem(TheString,J);
  750.               Append(Statement,TheString.TheStr);
  751.               WrStr(OutFile,TheString.TheStr);  (* copy original statement to file*)
  752.               WrLn(OutFile);
  753.             UNTIL (Pos(TheString.TheStr,';') < MAX(CARDINAL))
  754.          END;  (* end if  end of statement *)
  755.  
  756.         WrStr(OutFile,'***)');
  757.         WrLn(OutFile);
  758.  
  759.           (* parse the sql command, compile and gen the code *)
  760.         PrepareSQL(Statement,TokenArray);
  761.         CompileSQL(Statement);
  762.         GenCode();
  763.  
  764.  
  765.       ELSE  (* this is not an sql statement - write normal *)
  766.         WrStr(OutFile,TheString.TheStr);
  767.         WrLn(OutFile);
  768.         IF InDeclare
  769.           THEN
  770.  
  771.              GetVars(TestStr,InComment); (* get host variables *)
  772.           END;
  773.       END;
  774.   END;
  775.   Close(OutFile);
  776.  UNTIL Process = Done;
  777.   J := SQLPREP.SQLA_SAVE;
  778.   SQLPREP.SQLGFINI(J,NIL,CA);
  779.   WrStr(MsgFile,'END of precompiler ');
  780. END PreComp.
  781. 
  782. 
  783. 
  784. 
  785. 
  786.