BPTest

Back to Source Code page

This program is designed to run BASIC code from ECL/TCL.

!
** Run BASIC code from TCL (command line)
** (C) Copyright 1985-2007, Advantos Systems, Inc.  All Rights Reserved.
!
** Last Modified: 12 Jan 2006, wph
** First Created: 25 Feb 2001, wph
** Program Type-: Utility
!
** Notes:
**
** This process simply builds a BASIC program from the command line,
** compiles it, runs it, decatalogs it, then deletes it.  Multiple
** lines can be created at 'TCL' by separating them with a ';'.
**
** This program will parse out each line and create it as a separate
** line in the temporary program.  Of course, a ';' can be part of
** a quoted string but cannot be part of a comment.
**
** It's always a good idea to use 'END' statements, e.g.
**
** :BPTEST PROMPT '' ; C.BCK = @(-9) ; TEST = "NOW IS THE TIME" ; ANS = '' ;
**  LOOP UNTIL ANS = 'X' DO ; ECHO OFF ; INPUT ANS,1 : ; ECHO ON ; IF ANS 
**  NE "<" THEN CRT ANS : ELSE CRT C.BCK : ; REPEAT ; END
**
**-------------------------------------------------------------------**
**                                                                   **
**                    I N I T I A L I Z A T I O N                    **
**                                                                   **
**-------------------------------------------------------------------**
*
** Initialize local variables
*$OPTIONS EXT                  ; ** D3 version
NULL$ = ''
SP1   = ' '
aList = 0                     ; ** is a list active?

** set unique key for bp item
[[BpId]] = '[[BpTest_]]' : SYSTEM(12) : SYSTEM(16)

** parse tcl sentence to get BASIC commands
[[TclLine]] = @SENTENCE           ; ** UD version
*[[TclLine]] = @COMMAND            ; ** UV version
*TCLREAD [[TclLine]]               ; ** D3 version
[[TclLine]]   = [[TclLine]][7,9999]   ; ** remove the command
HELP.CMD  = FIELD(TRIM([[TclLine]]), ' ', 1)
IF HELP.CMD = '?' THEN GOTO DISPLAY.HELP

** Open File(s)f
FName = 'SAVEDLISTS'          ; ** U2 version
*FName = 'DTATEMP'             ; ** D3 version
OPEN '', FName TO [[BpTemp]].fv ELSE STOP 201, FName
*
**-------------------------------------------------------------------**
**                                                                   **
**                 S T A R T   P R O G R A M   R U N                 **
**                                                                   **
**-------------------------------------------------------------------**
*
** save any active list to get later
IF SYSTEM(11) THEN
   aList = 1
   EXECUTE \SAVE-LIST \ : [[BpId]] CAPTURING Output
END

** convert program to separate lines
[[QuoteStr]]   = '"\' : "'"        ; ** list of quote characters
[[InQuotes]]   = NULL$             ; ** we're not in a quote section yet
[[InFunction]] = NULL$             ; ** we're not in a function section
[[OrigProg]]   = [[TclLine]]
[[NewProg]]    = NULL$
xHigh      = LEN([[OrigProg]])

** parse through looking for separate lines of code
FOR X = 1 TO xHigh
   [[TestChar]] = [[OrigProg]][X,1]
   IF INDEX([[QuoteStr]], [[TestChar]], 1) THEN
      IF [[InQuotes]] = NULL$ THEN
         [[InQuotes]] = [[TestChar]]
      END ELSE
         IF [[InQuotes]] = [[TestChar]] THEN [[InQuotes]] = NULL$
      END
   END ELSE
      IF [[TestChar]] = '(' THEN
         IF [[InFunction]] = NULL$ THEN [[InFunction]] = [[TestChar]]
      END
      IF [[TestChar]] = ')' THEN
         IF [[InFunction]] NE NULL$ THEN [[InFunction]] = NULL$
      END
   END
   IF [[TestChar]] = ';' THEN
      IF [[InQuotes]] = NULL$ AND [[InFunction]] = NULL$ THEN [[TestChar]] = @AM
   END
   [[NewProg]] := [[TestChar]]
NEXT X

** start program run
WRITE [[NewProg]] ON [[BpTemp]].fv, [[BpId]]
EXECUTE \COMPILE \ : FName : SP1 : [[BpId]] RETURNING [[ErrNo]]
IF [[ErrNo]] NE 0   THEN                                        ; ** U2 version
*IF [[ErrNo]] =  241 THEN                                        ; ** D3 version
   IF aList THEN
      EXECUTE \GET-LIST \ : [[BpId]] CAPTURING Output
   END
   EXECUTE \RUN \ : FName : SP1 : [[BpId]]
   EXECUTE \DELETE \ : FName : SP1 : '_' : [[BpId]] CAPTURING Output  ; ** UD version
*  EXECUTE \DELETE \ : FName : '.O' : [[BpId]] CAPTURING Output       ; ** UV version
*  EXECUTE \DECATALOG \ : FName : SP1 : [[BpId]] CAPTURING Output     ; ** D3 version
END
EXECUTE \DELETE \    : FName : SP1 : [[BpId]] CAPTURING Output
*
GOTO END.OF.PROGRAM
*
**----------------------------------------------------------------**
**                                                                **
**                     S U B R O U T I N E S                      **
**                                                                **
**----------------------------------------------------------------**
*
** Help display
***************
DISPLAY.HELP:
***************
*
CRT
CRT 'Utility to execute BASIC code.  This is a simple way to run BASIC'
CRT 'code.  If you want to run multiple lines, simply separate lines of'
CRT 'code with ";", which is the same as you would do in a program'
CRT
CRT "Syntax:"
CRT "  BPTEST {BASIC command(s)}"
CRT
CRT "Example:"
CRT "  BPTEST EXECUTE \TERM\ CAPTURING OUTPUT; CRT OUTPUT"
CRT
CRT "^ terminal name: [[ActIbmpc]].c1^ product name: [[AccuTerm]] IBM PC Color"
CRT "^ terminal width: 80    printer width: 146^          depth: "
CRT "25            depth: 61^ lineskip:    0^ lf delay:    1^ ff "
CRT "delay:    1^ back space:  8^"
CRT
STOP
*
**----------------------------------------------------------------**
**                                                                **
**                  E N D   O F   P R O G R A M                   **
**                                                                **
**----------------------------------------------------------------**
*
***************
END.OF.PROGRAM:
***************
*
END

Back to Source Code page