      REM PLZ
*PIC-LAN
*
*ALL
*PC
*N
*
*
*
******************************************************************************
******************************************************************************
***                                                                        ***
*** (C) Copyright 1990-2005 Doug Dumitru, All Rights Reserved.             ***
***                                                                        ***
*** This program is licensed under the terms of the GNU General Public     ***
*** License, version 2.0 with attached notices.                            ***
***                                                                        ***
*** The full text can be found in the LICENSE.TXT file in the              ***
*** PLIP.BP database file (the /usr/qmweb/PLIP.BP/PLIP.BP directory).      ***
***                                                                        ***
******************************************************************************
******************************************************************************
*
* State structure
*
* Base record        nnn - 001 Activity Time
*                          002 Expiration Time
*                          003 State random number stamp
*                          004 State ID number
*                          005 Stack
*
* Extension attr     nnn.nnn
* Local variables    nnn*nnn
*
*
*
      INCLUDE SYS.TYPE.INCLUDE
*
      INCLUDE PL.COMMON
      INCLUDE PL.COMMON.DEFS
      INCLUDE PL.DEFS
      INCLUDE PLIP.COMMON
      INCLUDE PLW.COMMON
      INCLUDE PL.INIT.INCLUDE
*
      INCLUDE PLZ.COMMON
*
      Z.OPT = NOT( INDEX(SENT<2>,'Z',1) <> 0 )
      I.OPT = NOT( INDEX(SENT<2>,'I',1) <> 0 )
      J.OPT = NOT( INDEX(SENT<2>,'J',1) <> 0 )
*
      RELEASE
      PRINT
*
      CALL PLIP.INIT.SUB
*
      OPEN 'PLIP.BP,TEMPLATES' TO BP.FD ELSE CALL PLXX.STOP(201,'PLIP.BP,TEMPLATES')
*
      S = DELETE(SENT<1>,1,1,0)
      S = PL_REPL(S,VM,' ')
      CALL PLZ.PARSE.FILENAME(S,TP,P1,P2)
      NO.PGMS = DCOUNT(P2,AM)
      FOR PGM.NO = 1 TO NO.PGMS
         BEGIN CASE
            CASE TP = 'FILE'
               SS = 'FILE ' : P1 : ' ' : P2<PGM.NO>
            CASE TP = 'HOST'
               SS = 'HOST ' : P2<PGM.NO>
         END CASE
         GOSUB 100
      NEXT PGM.NO
*
      STOP
*
100   REM process a module
*
      LAB.N = 0
      P.VARS = ''
      C.VARS = ''
      F.LIST = ''
      PG.VARS = ''
      SUB.VARS = ''
      PG.BASE = ''
      SRC.FILE = ''
      IMG.LST = ''
*
      D = '==> ' : SS : '   ' : STR('=',70)
      PRINT D 'L#79'
      CALL PLZ.SUB(SS,0,APP.SRC,R.ERR)
      IF R.ERR <> '' THEN
         PRINT R.ERR
         PRINT
         RETURN
      END
*
      I1 = DCOUNT(PG.VARS,AM)
      FOR I = 1 TO I1
         LOCATE(PG.VARS<I>,C.VARS;DUMMY) ELSE
            LOCATE(PG.VARS<I>,P.VARS;DUMMY) ELSE
               P.VARS<-1> = PG.VARS<I>
            END
         END
      NEXT I
*
      I1 = DCOUNT(SUB.VARS,AM)
      FOR I = 1 TO I1
         LOCATE(SUB.VARS<I>,C.VARS;DUMMY) ELSE
            LOCATE(SUB.VARS<I>,P.VARS;DUMMY) ELSE
               P.VARS<-1> = SUB.VARS<I>
            END
         END
      NEXT I
*
      PRINT
      PRINT 'CVAR :' 'L#10' :
      IF C.VARS = '' THEN
         PRINT 'none'
      END ELSE
         I1 = DCOUNT(C.VARS,AM)
         FOR I = 1 TO I1
            IF I >1 AND ( MOD(I,7) = 1 ) THEN
               PRINT SPACE(10) :
            END
            PRINT C.VARS<I> 'L#9' :
            IF MOD(I,7) THEN
               PRINT ' ' :
            END ELSE
               PRINT
            END
         NEXT I
         IF MOD(I1,7) THEN
            PRINT
         END
      END
*
      PRINT 'PVAR :' 'L#10' :
      IF P.VARS = '' THEN
         PRINT 'none'
      END ELSE
         I1 = DCOUNT(P.VARS,AM)
         FOR I = 1 TO I1
            IF I >1 AND ( MOD(I,7) = 1 ) THEN
               PRINT SPACE(10) :
            END
            PRINT P.VARS<I> 'L#9' :
            IF MOD(I,7) THEN
               PRINT ' ' :
            END ELSE
               PRINT
            END
         NEXT I
         IF MOD(I1,7) THEN
            PRINT
         END
      END
*
      FOR I = DCOUNT(APP.SRC,AM) TO 1 STEP -1
         IF APP.SRC<I> = '*___*' THEN
            APP.SRC = DELETE(APP.SRC,I,0,0)
         END
      NEXT I
*
      IF NOT(SUB.FLG) THEN
         READ SRC.HEAD FROM BP.FD , 'PLZ.HEAD.TEMPLATE' ELSE CALL PLXX.STOP(202,'PLZ.HEAD.TEMPLATE')
      END ELSE
         READ SRC.HEAD FROM BP.FD , 'PLZ.SUB.TEMPLATE' ELSE CALL PLXX.STOP(202,'PLZ.SUB.TEMPLATE')
      END
      READ SRC.INCL FROM BP.FD , 'PLZ.INCLUDE.TEMPLATE' ELSE CALL PLXX.STOP(202,'PLZ.INCLUDE.TEMPLATE')
      READ SRC FROM BP.FD , 'PLZ.TEMPLATE' ELSE CALL PLXX.STOP(202,'PLZ.TEMPLATE')
*
      S = ''
*
      IF C.VARS <> '' THEN
         I1 = DCOUNT(C.VARS,AM)
         S<-1> = '      EQUATE C$VARS$I0  TO 6'
         S<-1> = '      EQUATE C$VARS$I1  TO ' : ( 6 + I1 - 1 )
         S<-1> = '      EQUATE C$VARS$CNT TO ' : I1
         S<-1> = '      DIM    C$VARS(' : (I1+6) : ')'
         FOR I = 1 TO I1
            S<-1> = '      EQUATE ' : C.VARS<I> : ' TO C$VARS(' : ( I + 5 ) : ')'
         NEXT I
      END ELSE
         S<-1> = '      EQUATE C$VARS$I0 TO 6'
         S<-1> = '      EQUATE C$VARS$I1 TO 5'
         S<-1> = '      EQUATE C$VARS$CNT TO 0'
         S<-1> = '      DIM    C$VARS(6)'
      END
*
      S<-1> = '*'
*
      IF P.VARS <> '' THEN
         I1 = DCOUNT(P.VARS,AM)
         S<-1> = '      EQUATE P$VARS$I0  TO 6'
         S<-1> = '      EQUATE P$VARS$I1  TO ' : ( 6 + I1 - 1 )
         S<-1> = '      EQUATE P$VARS$CNT TO ' : I1
         S<-1> = '      DIM    P$VARS(' : (I1+6) : ')'
         FOR I = 1 TO I1
            S<-1> = '      EQUATE ' : P.VARS<I> : ' TO P$VARS(' : ( I + 5 ) : ')'
         NEXT I
      END ELSE
         S<-1> = '      EQUATE P$VARS$I0 TO 6'
         S<-1> = '      EQUATE P$VARS$I1 TO 5'
         S<-1> = '      EQUATE P$VARS$CNT TO 0'
         S<-1> = '      DIM    P$VARS(6)'
      END
*
      S<-1> = '*'
      SRC.INCL = PL_REPL(SRC.INCL,'###DEFS###',S)
      WRITE SRC.INCL ON DST.FD , '__' : APP.NAME : '.INCLUDE'
*
      S = '      INCLUDE ' : APP.FILE : ' __' : APP.NAME : '.INCLUDE'
      SRC.HEAD = PL_REPL(SRC.HEAD,'###VARS###',S)
*
      SRC.HEAD = PL_REPL(SRC.HEAD,'###PGM###',A.NAME)
*
      S = '* File opens'
      FOR I = 1 TO DCOUNT(F.LIST,AM)
         FVAR  = FIELD(F.LIST<I>,' ',1)
         FNAME = OCONV(F.LIST<I>,'G1 99')
         S<-1> = '      OPEN "' : FNAME : '" TO ' : FVAR : ' ELSE'
         S<-1> = '         R.ERR = "500 INTERNAL ERROR;The application could not open the file ' : FNAME : '"'
         S<-1> = '         RETURN'
         S<-1> = '      END'
      NEXT I
      SRC.HEAD = PL_REPL(SRC.HEAD,'###OPEN###',S)
*
      SRC.HEAD = PL_REPL(SRC.HEAD,'###RETURN###',S.RTN )
      SRC.HEAD = PL_REPL(SRC.HEAD,'###CALL###'  ,S.CALL)
*
      S = ''
      FOR I = 1 TO LAB.N
         S = S : ',' : ( 9000000 + I )
      NEXT I
      SRC.HEAD = PL_REPL(SRC.HEAD,'###ONSTGOTO###',S)
      WRITE SRC.HEAD ON DST.FD , '__' : APP.NAME : '.HEAD'
*
      S = '      INCLUDE ' : APP.FILE : ' __' : APP.NAME : '.HEAD'
      SRC = PL_REPL(SRC,'###HEAD###',S)
      SRC = PL_REPL(SRC,'###CW###','* Copyright 1998 Modular Software Coporation.  Generated ' : TIMEDATE())
      SRC = PL_REPL(SRC,'###CODE###',APP.SRC)
*
      IF Z.OPT THEN
         DST = ''
         I1 = DCOUNT(SRC,AM)
         FOR I = 1 TO I1
            L = TRIM(SRC<I>)
            W = FIELD(L,' ',1)
            IF W = 'INCLUDE' THEN
               ID = FIELD(L,' ',3)
               READ T FROM DST.FD , ID THEN
                  DST<-1> = '*### INCLUDE ' : ID : ' ###' : AM : T : AM : '*##########*'
                  DELETE DST.FD , ID
               END ELSE
                  DST<-1> = SRC<I>
               END
            END ELSE
               DST<-1> = SRC<I>
            END
         NEXT I
      END ELSE
         DST = SRC
      END
*
      D = DST
      DST = ''
      CCC = ''
*
      I1 = DCOUNT(D,AM)
      FOR I = 1 TO I1
         W = FIELD(TRIM(D<I>),' ',1)
         BEGIN CASE
            CASE W = 'COMMON'
               CCC<-1> = D<I>
            CASE YES
               DST<-1> = D<I>
         END CASE
      NEXT I
*
      EOF = 0
      FOR I = 1 TO 9999 UNTIL EOF > 10
         READ D FROM DST.FD , '__' : APP.NAME : '.' : I THEN
            EOF = 0
            INC = ''
            FOR J = 1 TO DCOUNT(D,AM)
               W = FIELD(TRIM(D<J>),' ',1)
               BEGIN CASE
                  CASE W = 'COMMON'
                     CCC<-1> = D<J>
                  CASE YES
                     INC<-1> = D<J>
               END CASE
            NEXT J
            WRITE INC ON DST.FD , '__' : APP.NAME : '.' : I
         END ELSE
            EOF = EOF + 1
         END
      NEXT I
*
      T = ''
      T<-1> = '*'
      T<-1> = '* - - - - - - - - - - - - - - - - - - - - - - - - - - - - *'
      T<-1> = '* Relocated COMMON'
      T<-1> = '*'
      T<-1> = CCC
      T<-1> = '* - - - - - - - - - - - - - - - - - - - - - - - - - - - - *'
*
      DST = PL_REPL(DST,'###COMMONANDEQUATES###',T)
*
      WRITE DST ON DST.FD , A.NAME
*
      READ DST FROM DST.FD , '__' : APP.NAME : '.HEAD' THEN
         DST = PL_REPL(DST,'###COMMONANDEQUATES###',T)
         WRITE DST ON DST.FD , '__' : APP.NAME : '.HEAD'
      END
*
      PRINT
*
      RETURN
   END
