REM PC
*PRE-COMPILER
*
*DEV TRIAL RT
*BASIC (CS
*N
*     PRECISION 6
*
************************************************************************
************************************************************************
***                                                                  ***
*** PICK PARSING PRE-COMPILER SYSTEM                                 ***
***                                                                  ***
*** COPYRIGHT 1988 MODULAR SOFTWARE                                  ***
***                P.O. BOX 204                                      ***
***                ATLANTA, GA  30291                                ***
***                (404) 964 - 7171                                  ***
***                                                                  ***
*** THIS PROGRAM IS PROPRIETARY TO MODULAR SOFTWARE AND MAY NOT BE   ***
*** USED, COPIED, EXAMINED, OR DISCLOSED WITHOUT A VALID LICENSE     ***
*** FROM MODULAR SOFTWARE.                                           ***
***                                                                  ***
************************************************************************
************************************************************************
*
* Programs to pre-compile one or more source items and place them into
* a destination file
*
* Execution syntax:
*
*        PC filename itemlist =runtime.options =syntax=file.option
*
*  run-time.options are:      C - use alternate syntax table
*                             D - Do not delete the destination item
*                             B - Do not BASIC the destination item
*                             E - Edit the destination item
*                             Q - Squash the destination item
*                             A - Compile the program with a (C) option
*                             M - Compile the program with a (M) option
*                             S - Compile the program with a (S) option
*                             V - Compile the program with the COMPILE verb
*                             X - Capture output to capture file
*
* This routine has been modified to run with both FULL-VIEW and
* SMART-TREE on a number of systems with only minor program modifications.
*
* Several constant assignments are used to handle these functions.
*
* Program executes out of syntax files defined in DICT FV.BP OBJ.FILE
*
* Attr 1 specifies default file.
* Attr 2 specifies file to use with |C option.
*
*
*
      $INCLUDE PC.COMMON
*
*----------------------------------------------------------------------
*
* Options for this program that vary depending on what machine it is
* running on.
*
*
*
*
      OPEN 'WWW.CTRL' TO MD.FD ELSE STOP 201,'WWW.CTRL'
      MATREAD OPT.ARRAY FROM MD.FD , 'PC-CONTROL' ELSE STOP 202,'PC-CONTROL'
*
*$*   TCLREAD S
      CALL PC.SENTENCE(S)
*
*----------------------------------------------------------------------
*
*
*
      BAD.INCL.LIST = 'THENýELSEýLOCKEDýLOOPýWHILEýUNTILýREPEATýFORýNEXTýCASEýEND'
      NO.BAD.INCL = DCOUNT(BAD.INCL.LIST,VM)
*
      OPTIONS = FIELD(S,'=',2)
      OPTIONS = OCONV(OPTIONS,'MCU')
      SYNTAX.FILE.DEF = FIELD(S,'=',3)<1>
      S = FIELD(S,'=',1)
*
      A.OPT = INDEX(OPTIONS,'A',1)
      M.OPT = INDEX(OPTIONS,'M',1)
      S.OPT = INDEX(OPTIONS,'S',1)
      B.OPT = INDEX(OPTIONS,'B',1)
      C.OPT = INDEX(OPTIONS,'C',1)
      D.OPT = INDEX(OPTIONS,'D',1)
      E.OPT = INDEX(OPTIONS,'E',1)
      Q.OPT = INDEX(OPTIONS,'Q',1)
      T.OPT = INDEX(OPTIONS,'T',1)
      V.OPT = INDEX(OPTIONS,'V',1)
      R.OPT = INDEX(OPTIONS,'R',1)
      O.OPT = INDEX(OPTIONS,'O',1)
      IF O.OPT.DEF THEN O.OPT = NOT(O.OPT)
      IF Q.OPT.DEF THEN Q.OPT = NOT(Q.OPT)
      Q.OPT = INCLUDE.OPT * Q.OPT
      X.OPT = INDEX(OPTIONS,'X',1)
      IF X.OPT THEN
         OPEN CAPT.FILE TO X.OPT.FD ELSE STOP 201,CAPT.FILE
         X.OPT.ID = 'PC*' : FIELD(OCONV('','U50BB'),' ',1)
         DELETE X.OPT.FD , X.OPT.ID
      END
*
      PORT = FIELD(OCONV('','U50BB'),' ',1)
*
      BEGIN CASE
         CASE SYNTAX.FILE.DEF <> ''
         CASE C.OPT
            SYNTAX.FILE.DEF = SYNTAX.FILE2
         CASE YES
            SYNTAX.FILE.DEF = SYNTAX.FILE1
      END CASE
*
      PGM.FILE = S<2>
*
      IF PGM.FILE = 'B' THEN
         PGM.FILE = 'PLIP.BP,PLIP.SOURCE'
      END
*
      OPEN PGM.FILE TO SOURCE.FD ELSE STOP 201,PGM.FILE
      PGM.ROOT = FIELD(PGM.FILE,',',1)
      OPEN 'GEN.BP' TO DEST.FD ELSE STOP 201,'GEN.BP'
*
      IDS = S
      IDS = DELETE(IDS,1,0,0)
      IDS = DELETE(IDS,1,0,0)
*
      ID.LIST = ''
      BEGIN CASE
         CASE IDS<1> = '*'
            SELECT SOURCE.FD
            EOF = NO
            LOOP
               READNEXT ID ELSE EOF = YES
            UNTIL EOF DO
               LOCATE ID IN ID.LIST<1> BY 'AL' SETTING LOC ELSE
                  ID.LIST = INSERT(ID.LIST,LOC,0,0,ID)
               END
            REPEAT
         CASE IDS = ''
            EOF = NO
            LOOP
               READNEXT ID ELSE EOF = YES
            UNTIL EOF DO
               LOCATE ID IN ID.LIST<1> BY 'AL' SETTING LOC ELSE
                  ID.LIST = INSERT(ID.LIST,LOC,0,0,ID)
               END
            REPEAT
         CASE YES
            I1 = DCOUNT(IDS,AM)
            FOR I = 1 TO I1
               ID = IDS<I>
               IF ID <> '' THEN
                  LOCATE ID IN ID.LIST<1> BY 'AL' SETTING LOC ELSE
                     ID.LIST = INSERT(ID.LIST,LOC,0,0,ID)
                  END
               END
            NEXT I
      END CASE
*
      NO.PROGRAMS = DCOUNT(ID.LIST,AM)
      FOR PGM.NO = 1 TO NO.PROGRAMS
         PGM.NAME = ID.LIST<PGM.NO>
         GOSUB 100
      NEXT PGM.NO
*
      STOP
*
100 REM COMPILE A SINGLE ITEM
*
      RECUR.LEVEL = 0
      DEF.SYMBOLS = '1'
      DEF.NEST.CNT = 0
*
      CALL PC.1(PGM.FILE,PGM.NAME:"",PGM.NAME:"")
*
      IF R.OPT THEN
         CALL PC.INSTRUMENT(PGM.FILE,PGM.NAME)
      END
      CALL PC.COMBINE.INCLUDE(PGM.NAME:"",O)
      WRITE O ON DEST.FD , PGM.NAME
*
      IF NOT(B.OPT) AND NOT(T.OPT) THEN
         IF NOT(X.OPT) THEN
            PRINT CR : LINE.NO(1) 'R#4' : SPACE(6) : PGM.NO 'R#3' : ' ' : PGM.NAME 'L#30' : ' BASIC '
         END
         IF V.OPT THEN
            S = 'COMPILE '
         END ELSE
            S = 'BASIC '
         END
         S = S : 'GEN.BP ' : PGM.NAME
         IF A.OPT OR M.OPT OR S.OPT OR O.OPT THEN
            S = S : ' ('
            IF A.OPT THEN S = S : 'C'
            IF M.OPT THEN S = S : 'M'
            IF S.OPT THEN S = S : 'S'
            IF O.OPT THEN S = S : 'O'
         END
         EXECUTE S
         IF MICRODATA.FLG THEN
            READ DATA FROM DEST.FD , '$' : PGM.NAME THEN
               WRITE DATA ON SOURCE.FD , '$' : PGM.NAME
               DELETE DEST.FD , '$' : PGM.NAME
            END
            READ DATA FROM DEST.FD , '*' : PGM.NAME THEN
               WRITE DATA ON SOURCE.FD , '*' : PGM.NAME
               DELETE DEST.FD , '*' : PGM.NAME
            END
         END
      END ELSE
         PRINT
      END
*
      IF E.OPT THEN
         IF MICRODATA.FLG THEN
            EXECUTE 'ED ST.WORKFILE ' : PGM.NAME
         END ELSE
            EXECUTE 'ED GEN.BP ' : PGM.NAME
         END
      END
*
      IF NOT(D.OPT) AND NOT(T.OPT) THEN
         DELETE DEST.FD , PGM.NAME
         SELECT DEST.FD
         EOF = NO
         LOOP
            READNEXT ID ELSE EOF = YES
         UNTIL EOF DO
            IF FIELD(ID,'.',1) = 'INCL' AND FIELD(ID,'.',2) = PORT THEN
               DELETE DEST.FD , ID
            END
         REPEAT
      END
*
      RETURN
*
      CW = '(C) Copyright 1985-1989 Modular Software.  All rights reserved.'
   END
