*
* Program Name:  XBASIC
* Written By:    Kevin King
* Date:          29 Dec 1998
* Description:   This program will read an item to be BASIC compiled,
*                precompile it for a specific system, compile the updated
*                code, and rewrite the original code when complete.
*
*****************************************************************************
* Modifications:
*****************************************************************************
* Date.....  Changed By.....  Description of Change..........................
*
PROMPT ''
*
*****************************************************************************
* Equate(s)
*****************************************************************************
*
EQU AM TO CHAR(254)
EQU VM TO CHAR(253)
*
TRUE  = (1 EQ 1)
FALSE = NOT(TRUE)
*
GOSUB 1000 ;* Get the command parameters
GOSUB 2000 ;* Do the work for all items in the list
*
STOP
*
*****************************************************************************
1000 * Get the command parameters
*****************************************************************************
*
PROCREAD TCL ELSE TCL = ''
TCL = TRIM(TCL)
*
* The following section could have been written using CONVERT or CHANGE on
* certain platforms.  However, not all platforms support these commands.
* Secondly, on certain platforms, the PROCREAD buffer is returned with
* attribute marks between fields; other platforms return the buffer with
* spaces between fields. This code will ensure that the TCL input buffer
* is delimited with attribute marks.
*
LOOP
  SP = INDEX(TCL,' ',1)
UNTIL NOT(SP) DO
  TCL = TCL[0,SP - 1] : AM : TCL[SP + 1,32200]
REPEAT
*
* Extract the options for the compiler
*
COMPILE.OPTS = ''
TCL.CNT = DCOUNT(TCL,AM)
FOR TCL.LOOP = TCL.CNT TO 1 STEP -1
  WORD   = TCL<TCL.LOOP>
  LEADIN = WORD[1,1]
  IF (LEADIN EQ '(') OR (LEADIN EQ '-') THEN
    COMPILE.OPTS = COMPILE.OPTS : ' ' : WORD
    TCL = DELETE(TCL,TCL.LOOP,0,0)
  END
NEXT TCL.LOOP
*
FILE.NAME = TCL<2>
*
* Remove the command and file name, leaving the item IDs
*
FOR DEL.LOOP = 1 TO 2
  TCL = DELETE(TCL,1,0,0)
NEXT DEL.LOOP
*
ITEM.IDS = TCL
*
GOSUB 1100 ;* Open the file
*
IF (ITEM.IDS EQ '') THEN
  GOSUB 1200 ;* Get an item ID or list of IDs
END
*
GOSUB 1300 ;* Prompt for the OE
*
RETURN
*
*****************************************************************************
1100 * Open the file
*****************************************************************************
*
GOSUB 1110 ;* Verify the file name
*
LOOP
WHILE (FILE.NAME EQ '') DO
  PRINT 'File Name > ' :
  INPUT FILE.NAME
  *
  FILE.NAME = OCONV(FILE.NAME,'MCU')
  IF (FILE.NAME EQ 'END') THEN STOP
  *
  GOSUB 1110 ;* Verify the file name
REPEAT
*
RETURN
*
*****************************************************************************
1110 * Verify the file name
*****************************************************************************
*
OKAY = FALSE
IF (FILE.NAME NE '') THEN
  OPEN '',FILE.NAME TO F.IN THEN
    OKAY = TRUE
  END ELSE
    PRINT 'There is no file named "':FILE.NAME:'"'
  END
END
*
IF NOT(OKAY) THEN
  FILE.NAME = ''
END
*
RETURN
*
*****************************************************************************
1200 * Get an item ID or list of IDs
*****************************************************************************
*
* First, look for the list
*
EOF = FALSE
LOOP
  READNEXT ID ELSE EOF = TRUE
UNTIL EOF DO
  ITEM.IDS = INSERT(ITEM.IDS,-1,0,0,ID)
REPEAT
*
IF (ITEM.IDS EQ '') THEN
  LOOP
    PRINT 'Item Name > ' :
    INPUT ITEM.IDS
    *
    ITEM.ID = OCONV(ITEM.ID,'MCU')
    IF (ITEM.IDS EQ 'END') THEN STOP
    *
    OKAY = FALSE
    READ ITEM FROM F.IN,ITEM.IDS THEN
      OKAY = TRUE
    END
  UNTIL OKAY DO
    PRINT 'There is no item named "':ITEM.IDS:'"'
  REPEAT
END
*
RETURN
*
*****************************************************************************
1300 * Prompt for the OE
*****************************************************************************
*
LOOP
  PRINT 'Operating Environment > ' :
  INPUT OE
  *
  OE = OCONV(OE,'MCU')
  *
  IF (OE EQ 'END') THEN STOP
  *
  PRINT 'Precompile for ' : OE : '? (Y/<cr>=N) : ' :
  INPUT YORN
  *
  YORN = OCONV(YORN,'MCU')
  *
  IF (YORN EQ 'END') THEN STOP
UNTIL (YORN EQ 'Y') DO
REPEAT
*
TAG = '#IF ' : OE
*
RETURN
*
*****************************************************************************
2000 * Do the work for all items in the list
*****************************************************************************
*
ITEM.CNT = DCOUNT(ITEM.IDS,AM)
FOR ITEM.LOOP = 1 TO ITEM.CNT
  ITEM.ID = ITEM.IDS<ITEM.LOOP>
  GOSUB 3000 ;* Process this item
NEXT ITEM.LOOP
*
RETURN
*
*****************************************************************************
3000 * Process this item
*****************************************************************************
*
READ ITEM FROM F.IN,ITEM.ID THEN
  GOSUB 3100 ;* We have an item
END ELSE
  PRINT 'Item "':ITEM.ID:'" does not exist in "':FILE.NAME:'"'
END
*
RETURN
*
*****************************************************************************
3100 * We have an item loaded
*****************************************************************************
*
ITEM.ORIG = ITEM
*
GOSUB 3200 ;* Precompile the item
GOSUB 3300 ;* Compile the item
GOSUB 3400 ;* Write the original item back to the file
*
RETURN
*
*****************************************************************************
3200 * Precompile the item
*****************************************************************************
*
PRINT 'Precompiling ' : ITEM.ID : ' for ' : OE : '...'
*
ITEM.NEW = ''
*
KEEP = TRUE
LINE.CNT = DCOUNT(ITEM,AM)
FOR LINE.LOOP = 1 TO LINE.CNT
  IF NOT(MOD(LINE.LOOP,10)) THEN
    PRINT '.':
  END
  *
  KEEP.THIS  = KEEP
  ORIG.LN    = ITEM<LINE.LOOP>
  TRIM.LN    = TRIM(ORIG.LN)
  FIRST.WORD = FIELD(TRIM.LN,' ',1)
  BEGIN CASE
    CASE (FIRST.WORD EQ '#IF')
      TEST.OE = FIELD(TRIM.LN,' ',2)
      *
      LOOP
        SP = INDEX(TEST.OE,',',1)
      UNTIL NOT(SP) DO
        TEST.OE = TEST.OE[0,SP-1]:VM:TEST.OE[SP+1,32200]
      REPEAT
      *
      LOCATE(OE,TEST.OE,1;PTR) ELSE
        KEEP = FALSE
      END
      *
      KEEP.THIS = FALSE ;* We never include #IF directives
    CASE (FIRST.WORD EQ '#END')
      KEEP = TRUE
      KEEP.THIS = FALSE ;* We never include #END directives
 END CASE
 *
 IF NOT(KEEP.THIS) THEN
   ORIG.LN = '*' : ORIG.LN
 END
 *
 ITEM.NEW<LINE.LOOP> = ORIG.LN
NEXT LINE.LOOP
*
PRINT
*
WRITE ITEM.ORIG ON F.IN,ITEM.ID:'.ORIG'
WRITE ITEM.NEW  ON F.IN,ITEM.ID
*
RETURN
*
*****************************************************************************
3300 * Compile the item
*****************************************************************************
*
IF (COMPILE.OPTS NE '') THEN
  PRINT 'Compiling ' : ITEM.ID : ' with options' : COMPILE.OPTS : ' ...'
END ELSE
  PRINT 'Compiling ' : ITEM.ID : '...'
END
*
CMD = 'BASIC ' : FILE.NAME : ' ' : ITEM.ID
EXECUTE CMD
*
RETURN
*
*****************************************************************************
3400 * Write the original item back to the file
*****************************************************************************
*
WRITE ITEM.ORIG ON F.IN,ITEM.ID
DELETE F.IN,ITEM.ID:'.ORIG'
*
RETURN