Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/diucmd.b36
There are 4 other files named diucmd.b36 in the archive. Click here to see a list.
%TITLE 'DIUCMD - COMND JSYS Interface for BLISS-36'

MODULE DIUCMD ( IDENT = '262',
                ENTRY(comand,           ! Parse a command line
                      rcline            ! Read the EXEC's command line
                      )) =
BEGIN
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1977, 1978, 1986.
!	ALL RIGHTS RESERVED.
!
!	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
!	COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
!	THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE  OR
!	ANY  OTHER  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
!	AVAILABLE TO ANY OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE
!	SOFTWARE IS HEREBY TRANSFERRED.
!
!	THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
!	NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
!	EQUIPMENT CORPORATION.
!
!	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
!	ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!++
! FACILITY: TOPS-20/10 COMND interface for BLISS programs
!
! ABSTRACT:
!   This module interfaces a BLISS  program to the COMND  JSYS.
!   This is  done by  specifying a  state table  with macros  in
!   COMAND.R36. This   table is  passed  to the  COMAND  routine
!   (defined  herein),  which   then  drives   the  COMND   JSYS
!   accordingly. Automatic  (but  optional)  error  recovery  is
!   provided, along with  a method  for the  action routines  to
!   specify "semantic feedback".
!
! ENVIRONMENT: To be loaded with a TOPS-20 user mode BLISS program.
!	Or, to be loaded with a TOPS-10 user mode BLISS program that
!	has already MERGE'd and initialized GLXLIB.
!
! AUTHOR: Bruce Dawson , CREATION DATE: 12-Sep-78
!
! MODIFIED BY: Doug Rayner, April, 1984
! REVISION HISTORY:
!
!  262  Remove code that is not needed and or not used.
!       Gregory A. Scott 7-Jul-86
!
!  257  Remove /VARIANT code; change LIBRARY BLI:MONSYM to just MONSYM.
!       Gregory A. Scott 7-Jul-86
!
!  253  Rename file to DIUCMD
!       Gregory A. Scott 1-Jul-86
!
!  203  Make multi line commands echo properly from take files.
!       Gregory A. Scott 23-May-86
!
! B. Dawson, 7-Oct-78 VERSION 2
! 02	- Made extensive changes to RCLINE. Turns out that I didn't
!	have to do everything that I did. Also, PRETTY'ed it up some.
!
! 03	- Made COMAND return a value.
!
!    B. Dawson, 21-Oct-79
! 04	- Made RCLINE smarter about reading the EXEC command line.
!
!    L. Campbell 7-Feb-82
! 05    - Fixed RSCAN bugs (typeahead discarded if RCLINE failed), and
!         improved error message.
! 06    - Added global CMDNPT, state to go to on a no-parse.
! 07    - Added magic next state -2 (meaningful for switch/keyword entries
!         only) which says to take next state from FLDDB block instead
!         of switch/keyword "dummy FLDDB" block.
!
!    L. Campbell 16-Mar-82
! 08    - Merged in Ray Marshall's $COMAND_OPTION enhancements, made
!         some names symbolic, added BREAK argument to $COMAND_STATE.
!
!    R. Marshall 16-Mar-82
! 09	- Converted from old to new JSYS linkage
!
!    R. Marshall 19-Mar-82
! 10	- Added CMDRPR.
!	- Added magical value of -2 for action routines on switch and keyword
!	  lists.  This will cause the action routine of the calling FLDDB to
!	  be used instead.
!	- Fixed bug in testing for the -2 magical value for the "next" value
!	  in switch and keyword lists.
!
!    A. Nourse 11-Aug-82
! 11    - Print out entire rest of line (not just atom buffer) on error
! 12    - Put in ENTRY points
!
!    D. Rayner 25-Apr-84
! 13    - Add TOPS-10 support
!
!    S. Clemens  3-Dec-85
! 14    - Add /VARIANT code for DIU "TAKE/ECHO" support.  Compile with
!         /VARIANT for DIU, without for RMS.
!
!    Gregory A. Scott
! 15    - Since MSG_FAO doesn't give a free CRLF any more, we can use PSOUT
!         when echoing the TAKE commands.
!
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
    checkecho : NOVALUE,                ! See if echo of take file needed
    comand,				! Parse a command line
    rcline,				! Read the EXEC's command line
    get_program_name : NOVALUE,         ! Gets the programs name into OWN
    discard_rscan_buffer,               ! Empties the RSCAN buffer
    comand_error : NOVALUE,             ! Types an error message
    move_ASCIZ,                         ! Move an ASCIZ string
    s_esout : NOVALUE;			! Do an ESOUT JSYS, or simulate one
!
! INCLUDE FILES:
!
LIBRARY 'DIUCOMMAND';
%IF %SWITCHES(TOPS20)
%THEN
      LIBRARY 'MONSYM';                 ! TOPS-20 monitor symbols
      REQUIRE 'JSYSDEF';                ! TOPS-20 jsys defs
%ELSE
      LIBRARY 'bli:uuosym';
      LIBRARY 'uuodef';
%IF %DECLARED($CMFLG) %THEN UNDECLARE $CMFLG; %FI
%FI

%IF %DECLARED($CHLFD) %THEN UNDECLARE $CHLFD; %FI
%IF %DECLARED($CHFFD) %THEN UNDECLARE $CHFFD; %FI
%IF %DECLARED($CHCRT) %THEN UNDECLARE $CHCRT; %FI

LIBRARY 'bli:tendef';

!
! MACROS:
!
%IF %SWITCHES (TOPS10) %THEN
BUILTIN
    UUO;
%FI

MACRO
    lh =				! Left half of a word
	18,18 %,
    rh =				! Right half of a word
	0,18 %;

!
! EQUATED SYMBOLS:
!
%IF %SWITCHES(TOPS10)
%THEN
LITERAL
    CR$RES = 1,				! These should come from GLXMAC
    CR$PDB = 2,				! but it causes many, many compiler
    CR$SIZ = 4,				! diagnostics if we LIBRARY GLXMAC
    RD_NEC = 1,

    $CMBRK = 4,				! These should come from MONSYM
    $CMFLG = 0,				! but it causes many compiler
    $CMPTR = 4,				! diagnostics if we LIBRARY both
    $CMFNP = 0,				! UUOSYM and MONSYM
    $CMKEY = 0,
    $CMSWI = 3,
    CM_RPT = %O'040000000000',
    CM_NOP = %O'200000000000',
    $RDDBC = 4,
    RD_JFN = %O'004000000000',
    RD_RIE = %O'002000000000',
    RD_RAI = %O'000200000000',
    $PRIIN = %O'377776',
    $PRIOU = %O'377777',

    EREOF$ = 1,			! GLXLIB EOF error code
    IOX4 = %O'600220';		! TOPS-20 EOF error code
%FI
LITERAL
    extra_word_1 = $CMBRK + 1,          ! Extra words appended to FLDDB block
    extra_word_2 = $CMBRK + 2;          ! by COMAND.R36 (contain ACTION,
                                        ! NEXT, and CONTEXT args)
!
! OWN STORAGE:
!
OWN
    dbused : REF VECTOR [6],            ! FLDDB actually used by COMND
    dbgiven : REF VECTOR [6],		! FLDDB given to COMND
    %IF %SWITCHES(TOPS10)
    %THEN
    cmrblk : REF VECTOR [CR$SIZ],	! S%SMND response block
    %FI
    oldstate,                           ! state coming from
    data,				! AC2 on return from COMND
    program_name : VECTOR [CH$ALLOCATION (7)],
    program_name_gotten : INITIAL (0),
    t1,                                ! Temporary storage locations
    t2,
    t3;


!
! EXTERNAL REFERENCES:
!
GLOBAL
    cmdsta,			! next state to parse
    cmderp,			! error message for no parse
    cmderr,			! return on error flag
    cmdrpt,             	! State to restart at on reparse
    cmdrpr,			! Addr. of routine to execute on reparse
    cmdnpt,             	! State to restart at on noparse
    cmdcji,			! Continuation of JFN Information
    cmdcjw;			! Continuation JFN Work area

EXTERNAL takeswitches,
         takeflag;
EXTERNAL ROUTINE
         S$CRIF: NOVALUE;

%IF %SWITCHES(TOPS10)
%THEN
LINKAGE
    GLXLIB = PUSHJ (REGISTER=1,REGISTER=2 ; REGISTER=1,REGISTER=2) :
	LINKAGE_REGS(15,14,0)
	NOPRESERVE(0,1,2,3,4,5,6)
	PRESERVE(7,8,9,10,11,12,13);

EXTERNAL ROUTINE
    %NAME('S%CMND') : GLXLIB,	! CMND JSYS simulator in GLXLIB-10
    %NAME('S%ERR')  : GLXLIB,	! Get last error message from GLXLIB-10
    %NAME('K%TPOS') : GLXLIB,	! RFPOS JSYS simulator in GLXLIB-10
    %NAME('K%BOUT') : GLXLIB,	! PBOUT JSYS simulator in GLXLIB-10
    %NAME('K%SOUT') : GLXLIB,	! PSOUT JSYS simulator in GLXLIB-10
    %NAME('K%TXTI') : GLXLIB;	! TEXTI JSYS simulator in GLXLIB-10

BIND ROUTINE
    S$CMND = %NAME('S%CMND') : GLXLIB,	! CMND JSYS simulator in GLXLIB-10
    S$ERR  = %NAME('S%ERR')  : GLXLIB,	! Get last error message from GLXLIB-10
    K$TPOS = %NAME('K%TPOS') : GLXLIB,	! RFPOS JSYS simulator in GLXLIB-10
    K$BOUT = %NAME('K%BOUT') : GLXLIB,	! PBOUT JSYS simulator in GLXLIB-10
    K$SOUT = %NAME('K%SOUT') : GLXLIB,	! PSOUT JSYS simulator in GLXLIB-10
    K$TXTI = %NAME('K%TXTI') : GLXLIB;	! TEXTI JSYS simulator in GLXLIB-10
%FI
%SBTTL 'Routine COMAND'
GLOBAL ROUTINE comand (start, stateblock, table) =
!++
! FUNCTIONAL DESCRIPTION:
!   This routine performs the COMND JSYS. It uses a state table
!   to describe the various  tokens to parse, where  to go on a
!   correct parse, action routines to call for each token, etc.
!   The routine automatically  prints an error  message on a No
!   Parse JSYS return, and will restart at a specified state on
!   a reparse  return.  (The  initial  state  is  the parameter
!   START).
!      The state  table  defines the  FLDDBs to use, the action
!   routines to invoke for each FLDDB, the next state to go  to
!   on a correct parse, and some context to pass to the  action
!   routine.
!      Each action routine is user defined and should have three
!   parameters.  COMAND invokes these  action routines with  the
!   first parameter being  the contents of  AC2 after the  JSYS,
!   the second parameter is the current state the parser is  in,
!   and the third parameter  is the context information  defined
!   with the FLDDBs. The context information is user defined and
!   is specified  when  the  state  table  is  designed.  It  is
!   intended  for  use  by  the  action  routines  so  they  can
!   precisely determine which state they are in.
!     If a  reparse occurs,  the  JSYS is  started at  the  state
!   specified in CMDRPT.  This is  to prevent  execution of  the
!   $CMINI function so the  user can utilize  the ^H feature  of
!   the COMND JSYS.
!
! FORMAL PARAMETERS:
!
!   START:  This is the state number of which to start at.  Usually this state
!	    contains only the $CMINI function.
!
!   STATEBLOCK:	This is the address of the block containing data such as the
!	    prompt string, atom buffer pointer, etc., and is specified in AC1
!	    when calling the COMND JSYS.
!
!   TABLE:  This is the address of the command state table.  It is a UPLIT of
!	    chained FLDDB addresses.  Each entry in this table corresponds to a
!	    state number.  This table is specified with the macros in
!	    COMAND.R36.
!
! IMPLICIT INPUTS:
!
!   CMDERP: This contains either zero or a CH$PTR to a string that the user 
!	    wants printed when a No Parse is returned by the JSYS. If zero is
!	    specified, then a canned error message is printed, (see the
!	    defintion of ERRMSG). In either case, the ESOUT JSYS is used to
!	    output the error message.
!
!   CMDERR: This contains either 1 or 0. 1 means to RETURN when either a No
!	    Parse, or a Reparse is returned by the JSYS. This feature helps
!	    when interfacing to an existing top-level command processor (such
!	    as the EXEC).
!
!   CMDSTA: A user action routine can set this to the next state he wants
!	    executed. However, this is done automatically by following the
!	    State table provided in the call. In either case, if this is ever
!	    set to -1 (by either the state table, or an action routine), then
!	    the COMAND routine will RETURN.
!
!   CMDRPT: Contains the state number to restart at if Reparse is returned.
!	    This should NOT point to the state containing $CMINI and MUST be
!	    specified if CMDERR equals zero.
!
!   CMDNPT: Contains the state number to restart at if Noparse is returned.
!	    During rescanned commands, this should be set to -1.  Otherwise,
!	    it should be the start state.
!
!   CMDRPR: If non-zero, contains the address of a routine to executed on a
!	    Reparse.
!
!   CMDCJI: Contains initial control information for Continuation JFN
!	    Information.  The format is:
!
!		+------------+------------+------------------------+
!		|   length   |      n     |  information  pointer  |
!		+------------+------------+------------------------+
!
!	    Where "information pointer" points to an option argument block for
!	    the JFN block; "n" is the number of options in the block; and
!	    "length" is the number of words in each option.  A typical option
!	    block might look like this:
!	    
!		+-------------------------+   <--- pointer points to here
!		|     .GJGEN (word 0)     |-\
!		+-------------------------+  \		length = 6
!		|     .GJSRC (word 1)     |   |
!		+-------------------------+   |		     n = 3
!		|     .GJDEV (word 2)     |   \
!		+-------------------------+    > first option
!		|     .GJDIR (word 3)     |   /
!		+-------------------------+   |
!		|     .GJNAM (word 4)     |   |
!		+-------------------------+  /
!		|     .GJEXT (word 5)     |-/
!		+-------------------------+
!		|     .GJGEN (word 0)     |-\
!		+-------------------------+  \
!		|     .GJSRC (word 1)     |   |
!		+-------------------------+   |
!		|     .GJDEV (word 2)     |   \
!		+-------------------------+    > second option
!		|     .GJDIR (word 3)     |   /
!		+-------------------------+   |
!		|     .GJNAM (word 4)     |   |
!		+-------------------------+  /
!		|     .GJEXT (word 5)     |-/
!		+-------------------------+
!		|     .GJGEN (word 0)     |-\
!		+-------------------------+  \
!		|     .GJSRC (word 1)     |   |
!		+-------------------------+   |
!		|     .GJDEV (word 2)     |   \
!		+-------------------------+    > third option
!		|     .GJDIR (word 3)     |   /
!		+-------------------------+   |
!		|     .GJNAM (word 4)     |   |
!		+-------------------------+  /
!		|     .GJEXT (word 5)     |-/
!		+-------------------------+
!
!
!   CMDCJW: Contains fields for Continuation JFN Working area.  Its format is:
!
!		+-------------------------+------------------------+
!		|		    n     |    working  pointer    |
!		+-------------------------+------------------------+
!
! IMPLICIT OUTPUTS:
!
!   CMDSTA: This is set to the next state that will be executed when the action
!	    routine returns. It is set before the action routine is called.
!
! ROUTINE VALUE:
!
!   0  if a transition to state -1 happens.  Otherwise a TOPS-20 error code.
!
! SIDE EFFECTS:
!
!   Monitor Calls:
!
!	COMND
!       ERSTR
!	ESOUT
!
!   Routine Calls:
!
!	The action routines are called.
!       If a noparse occurs, comand_error is called.
!--

    BEGIN
    MAP
	stateblock : REF VECTOR [10],
	table : REF VECTOR;

    IF NOT .program_name_gotten
    THEN
        get_program_name ();            ! Get name of program from monitor
    cmdsta = .start;
    UNTIL .cmdsta<rh, 1> EQL -1 DO
	BEGIN        
	%IF %SWITCHES(TOPS20)
	%THEN
	    IF NOT jsys_comnd( .stateblock, .table[.cmdsta] ; t1, data, t3 )
 	    THEN
		BEGIN
		LOCAL
		error_code;
		jsys_geter( $FHSLF; error_code);
		RETURN (.error_code<rh>);
		END;
            checkecho(.stateblock);
	    dbgiven = .t3<lh>;
	    dbused = .t3<rh>;

	%ELSE                           ! TOPS-10
	    !
	    !Call GLXSCN routine to simulate CMND
	    !
	    IF NOT S$CMND(.stateblock, .table[.cmdsta] ; t1,cmrblk)
	    THEN
		BEGIN
		IF .t1 EQL EREOF$
		THEN
		    t1 = IOX4;		! Change GLXLIB EOF to T-20 EOF
		RETURN(.t1);
		END;

	    dbgiven = .(cmrblk[CR$PDB])<lh>;
	    dbused = .(cmrblk[CR$PDB])<rh>;
	    data = .cmrblk[CR$RES];
	%FI                             ! End of TOPS-10 conditional

	SELECTONE 1 OF
	    SET

	    ! Noparse

	    [.pointr ((stateblock [$cmflg]), cm_nop)] :
		BEGIN
                !
                ! If user is handling errors, return the error code.
                !
		IF .cmderr
		THEN RETURN (.data);
                !
                ! Either output the user's message, or call our fancy routine.
                !
                IF .cmderp EQL 0
                THEN
                    comand_error (.stateblock)
                ELSE
		    s_esout(.cmderp);

		cmdsta = .cmdnpt
		END;

	    ! Reparse
	    [.pointr ((stateblock [$cmflg]), cm_rpt)] :

		BEGIN

                IF .cmdrpr NEQ 0 THEN	! If a reparse routine is specified by
		    (.cmdrpr)		!   the user, invoke it with:
			(.data,		!     AC2 returned from COMND JSYS,
			 .cmdsta,	!     Current state number, and
			 stateblock);	!     pointer to state block

		IF .cmderr THEN		! If user is handling errors,
		    RETURN (.data)	!   return with the value from AC2
		ELSE			! Otherwise,
		    cmdsta = .cmdrpt	!   set (cmdrpt) becomes the next state
                END;

	    [OTHERWISE] :
		BEGIN
                LOCAL
                    action,             ! Action routine address
                    next_state,         ! Next state
                    context_arg;        ! Context arg for action routine
                !
                ! If switch or keyword, action info comes not from FLDDB blk,
                ! but from associated switch/keyword table.
                !
		IF .(dbused [$cmfnp])<27, 9> EQL $cmkey OR
		    .(dbused [$cmfnp])<27, 9> EQL $cmswi
		THEN
		    BEGIN
		    LOCAL
			blk : REF VECTOR [2],
			l_switch : REF VECTOR [1];
                    !
                    ! Fetch context block address from switch data
                    !
		    l_switch = .data;
		    blk = .(l_switch [0])<rh>;
                    !
                    ! See if user wants action routine to come from FLDDB
                    ! block instead of switch block.
                    !
		    IF (action = .(blk [0])<rh,1>) EQL -2
                    THEN
                        action = .(dbused[extra_word_1])<rh>;
                    !
                    ! See if user wants next state to come from FLDDB
                    ! block instead of switch block.
                    !
		    IF (next_state = .(blk [0])<lh,1>) EQL -2
                    THEN
                        next_state = .(dbused[extra_word_1])<lh>;
		    context_arg = .blk [1];
		    END
                ELSE
                    BEGIN
                    !
                    ! Ordinary field, action info lives right in the FLDDB
                    !
                    action = .(dbused[extra_word_1])<rh>;
                    next_state = .(dbused[extra_word_1])<lh>;
                    context_arg = .dbused[extra_word_2]
                    END;
		oldstate = .cmdsta;
		cmdsta = .next_state;
                !
                ! Call action routine if any
                !
                IF .action NEQ 0
		THEN
		    (.action) (.data, .oldstate, .context_arg);
		END;
	    TES;

	END;
    RETURN 0;
    END;				! End of Routine COMAND
%SBTTL 'Routine CHECKECHO'
ROUTINE CHECKECHO (stateblock) : NOVALUE =
BEGIN
!++
! FUNCTIONAL DESCRIPTION
!
!       This routine checks to see that we need to echo the command line from a
!       take file and does it.  It reads ahead over a continuation line so that
!       we may echo it all at once here.
!
!--

MAP stateblock : REF VECTOR [10];       ! Command state block

LOCAL peek_chr,                         ! Character to peek with
      peek_ptr,                         ! Pointer to peek with
      chr_cnt,                          ! Unparsed character count
      chr_ptr,                          ! Unparsed character pointer
      status;                           ! Returned status
                
IF NOT .takeflag                        ! We are in a TAKE?
   OR  .takeswitches NEQ TAK_ECHO       ! Are we are echoing?
   OR .(dbgiven[$CMFNP])<27,9> NEQ $CMINI       ! We just CMINIed?
THEN RETURN;                            ! No echoing of commands needed

! See if we need to do anything because of continuation, and if we do read a
! string into the command buffer please.

WHILE 1
DO BEGIN                                ! Loop to see more continuation
   peek_ptr = CH$PLUS(.stateblock[$CMBFP],      ! Point to end of unparsed char
                  .stateblock[$CMINC]-1);       !  string to start
   IF CH$A_RCHAR(peek_ptr) EQL %C'-'    ! Were the characters after 
      AND CH$A_RCHAR(peek_ptr) EQL 13   ! the unparsed ones the
      AND CH$A_RCHAR(peek_ptr) EQL 10   ! famous hyphen, cr, lf
   THEN BEGIN                           ! Then we want to read another line
        peek_ptr = CH$PLUS(.stateblock[$CMBFP], ! Point to where we want
                  .stateblock[$CMINC]+3);       !  the appended string to start
        IF JSYS_SIN(.stateblock[$CMIOJ]<LH>,.peek_ptr,.stateblock[$CMCNT],10;
                    peek_chr,peek_ptr,chr_cnt)
        THEN BEGIN                      ! SIN worked, adjust the counts
             CH$WCHAR(0,.peek_ptr);     ! Insure that there is a null there
             stateblock[$CMINC] = .stateblock[$CMINC]   ! unparsed up
                                  +(.stateblock[$CMCNT]-.chr_cnt);
             stateblock[$CMCNT] = .chr_cnt;     ! space down
             END
        ELSE EXITLOOP                   ! Exit if the SIN punted
        END                             ! End of we see a continuation line
   ELSE EXITLOOP;                       ! Exit if no more contin lines
   END;                                 ! End of WHILE DO
                    
! Echo the command and return

IF .stateblock[$CMINC] NEQ 0            ! Any characters to print?
THEN BEGIN                              ! Yes
     S$CRIF();                          ! Go to left margin
     JSYS_PSOUT(.stateblock[$CMRTY]);   ! Output the prompt string
     JSYS_PSOUT(.stateblock[$CMBFP]);   ! Output the whole command text
     END;

END;
%SBTTL 'Routine RCLINE'
GLOBAL ROUTINE rcline =		! Read command line
!++
! FUNCTIONAL DESCRIPTION:
!  This routine rescans the command  line.  It deletes the  leading
! filespec from the command line, and  leaves the rest of the  line
! in the buffer for the COMND JSYS to pick up.  Furthermore, if the
! filename does  not  match the  program  name, then  there  is  no
! command, and zero is returned.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!   1 is returned if there was data for the program 
! in the command line. 0 is returned if there was an
! error or if there was no data.
!
! SIDE EFFECTS:
!   The RSCAN and TEXTI JSYSs are performed.
!
!--
    BEGIN

    LITERAL
	buflen = 325;

    LOCAL
        char,
	char_count,			! Count of chars in COMMAND
	namptr,				! CH$PTR to program name from monitor
	bufptr;				! CH$PTR to program name in BUF

    OWN
	onceonly : initial (0),         ! If =1, then don't run again
	buf : VECTOR [CH$ALLOCATION (BUFLEN)],	! Input buffer
	break_mask : VECTOR [4] INITIAL (	! Character scanner breakset
	    !  000000000011111111112222222222333333
	    !  012345678901234567890123456789012345

%IF %SWITCHES (TOPS20)
%THEN
	    %B'000000000010110000000000001100000000',
%ELSE
	    %B'000000000010100000000000001100000000',
%FI
	    %B'111100111101100100000000000001000000',
	    %B'100000000000000000000000000000000000',
	    %B'000000000000000000000000000000000000'),

	    !  44444444555555556666666677777777
	    !  00000000111111112222222233333333
	    !  01234567012345670123456701234567

%IF %SWITCHES (TOPS20) %THEN
	texti_blk : VECTOR [8] INITIAL (7, rd_jfn + rd_rie + rd_rai,
	    $cttrm^18 + $priou, CH$PTR(buf), BUFLEN, 0,    ![72] job c.t.
%ELSE
	texti_blk : VECTOR [8] INITIAL (7, rd_jfn + rd_rie + rd_rai + rd_nec,
	    $priin^18 + $priou, CH$PTR(buf), BUFLEN, 0,
%FI
	    CH$PTR(buf), break_mask);	! Parameters for the TEXTI JSYS

    IF .onceonly THEN return 0;
    onceonly = 1;

    IF NOT .program_name_gotten
    THEN
        get_program_name ();

    ! Read the command line

    %IF %SWITCHES(TOPS20)
    %THEN
	IF NOT jsys_rscan($rsini)
	THEN
	    RETURN 0;
    %ELSE
	IF RESCAN_UUO(1)
	THEN
	    RETURN 0;
    %FI

    ! Read the filespec of the program.
    %IF %SWITCHES(TOPS20)
    %THEN
	IF NOT jsys_texti(texti_blk)
	THEN
	    RETURN (discard_rscan_buffer ());
    %ELSE
	IF NOT K$TXTI(texti_blk)
	THEN
	    RETURN (discard_rscan_buffer ());
    %FI

    !	If the first token of the command line is not the name of the
    ! program, then we weren't invoked via @<filename> <commands>,
    ! in which case, there isn't a command line.
    namptr = CH$PTR (program_name);
    bufptr = CH$PTR (buf);
    INCR i FROM 1 TO MIN (6, (char_count = buflen - .texti_blk[$RDDBC] - 1))
    DO
        BEGIN
        !
	! Compare each character of the program name, stopping on null.
        !
        IF (char = CH$RCHAR_A (namptr)) EQL 0
        THEN
            EXITLOOP;
	IF CH$RCHAR_A (bufptr) NEQ .char
	THEN 
	    !
	    ! Now, if the buffer is terminated with CRLF then there
	    !  are no program commands.
	    !
	    IF CH$RCHAR(CH$PLUS(CH$PTR(buf),.char_count - 1)) NEQ %O'15'
	    THEN
            RETURN (discard_rscan_buffer ())
	ELSE
	    RETURN(0);
        END;
    !
    ! Read the number of characters left in the command line.
    ! If there are none, then return 0, otherwise return 1.
    !
    BEGIN
    %IF %SWITCHES(TOPS20)
    %THEN
	IF NOT jsys_rscan($RSCNT ; t1)
	THEN
	    RETURN (discard_rscan_buffer ());
	IF .t1 EQL 0 THEN
	    RETURN (0);
    %ELSE
	IF (NOT SKPINC_UUO(0) OR CH$RCHAR(.bufptr) EQL %O'15')
	THEN
	    RETURN (0);
    %FI
    END;

    RETURN (1);				! Say there is data.
    END;
%SBTTL 'Routine GET_PROGRAM_NAME'
ROUTINE get_program_name : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!   Gets the SIXBIT name of the program from the monitor, and copies
!   an ASCIZ version of it to PROGRAM_NAME.
!
! FORMAL PARAMETERS:
!   NONE
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   program_name        - gets ASCIZ program name
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   NONE
!
!--
    BEGIN

%IF %SWITCHES (TOPS10) %THEN
    REGISTER
	ac;		! Argument pointer #1
%FI

    LOCAL
        sixnam,
        char,
        src_ptr,
        dst_ptr;

    %IF %SWITCHES(TOPS20)
    %THEN
	jsys_getnm( ; sixnam);
    %ELSE
	ac = (-1 ^ 18 + $GTPRG);
	GETTAB_UUO(ac);
	sixnam = .ac;
    %FI
    src_ptr = CH$PTR (sixnam, 0, 6);
    dst_ptr = CH$PTR (program_name);
    INCR i FROM 1 TO 6
    DO
        BEGIN
        char = CH$RCHAR_A (src_ptr);
        IF .char EQL 0
        THEN
            EXITLOOP;
        CH$WCHAR_A ((.char + %O'40'), dst_ptr);
        END;
    CH$WCHAR (0, .dst_ptr);             ! Insure ASCIZ
    program_name_gotten = 1             ! Remember we've been here
    END;                                ! End of get_program_name
%SBTTL 'Routine DISCARD_RESCAN_BUFFER'
ROUTINE discard_rscan_buffer =
!++
! FUNCTIONAL DESCRIPTION:
!   Discards the input in the RSCAN buffer.
!
! FORMAL PARAMETERS:
!   NONE
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   Returns 0, so failures in RCLINE can RETURN (discard_rscan_buffer).
!
! SIDE EFFECTS:
!   NONE
!
!--
    BEGIN
    %IF %SWITCHES(TOPS20)
    %THEN
	jsys_rscan(CH$PTR(UPLIT(0)));
    %ELSE
	WHILE 1 DO
	BEGIN
	    !
	    ! Until we exhaust the input stream, or we see a break
	    ! character (<BELL>, <LF>, <FF>, <ESC>), eat all characters.
	    !
	    IF NOT INCHRS_UUO(t1)
	    THEN
		EXITLOOP;
	    IF .t1 EQL %O'7' OR .t1 EQL %O'10' OR .t1 EQL %O'12'
		OR .t1 EQL %O'27'
	    THEN
		EXITLOOP;
	END;
    %FI
    0
    END;                                ! discard_rscan_buffer
%SBTTL 'Routine COMAND_ERROR'
ROUTINE comand_error (P_stateblock) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!   Prints a message of the form:
!
!   ?<progname> command error: <TOPS-20 error string>: "<atom-buffer-contents>"
!
!   For a typical invalid command, this becomes, (assuming PROG is the program
!   name):
!
!   ?PROG command error:  Unrecognized switch or keyword:  "FOO"
!
! FORMAL PARAMETERS:
!   P_stateblock        - pointer to COMND JSYS state block
!
! IMPLICIT INPUTS:
!   The last error code for this fork.
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!   NONE
!
!--
    BEGIN

    BIND
        stateblock = .P_stateblock : VECTOR [10];

    LOCAL
        error_message_buffer : VECTOR [CH$ALLOCATION (255)],
        error_message_pointer,
        char;

    error_message_pointer = CH$PTR (error_message_buffer);
    move_ASCIZ (%REF (CH$PTR (program_name)),
                error_message_pointer);
    move_ASCIZ (%REF (CH$PTR (UPLIT (%ASCIZ ' command error: '))),
                error_message_pointer);

    %IF %SWITCHES(TOPS20)
    %THEN
	jsys_erstr( .error_message_pointer, ($FHSLF^18 + %O'777777'), 0 ;
		error_message_pointer  );
    %ELSE
	S$ERR(;t1);
	move_ASCIZ (%REF (CH$PTR (.t1)),
		error_message_pointer );
    %FI

    move_ASCIZ (%REF (CH$PTR (UPLIT (%ASCIZ ': "'))),
                error_message_pointer);
    move_ASCIZ (%REF (.stateblock[$CMPTR]),     ![11] Print out all the trash
                error_message_pointer);
    !
    ! Strip off vertical format effectors (CR, LF, FF) and escapes if present
    !
    WHILE ((char = CH$RCHAR (CH$PLUS (.error_message_pointer, -1))) EQL 13)
        OR .char EQL 10
        OR .char EQL 12
        OR .char EQL 27
    DO
        error_message_pointer = CH$PLUS (.error_message_pointer, -1);
    CH$WCHAR_A (%C'"', error_message_pointer);
    CH$WCHAR_A (0, error_message_pointer);

    s_esout(CH$PTR (error_message_buffer))

    END;                                !End of comand_error
%SBTTL 'Routine MOVE_ASCIZ'
ROUTINE move_ASCIZ (sptr, dptr) =
!++
! FUNCTIONAL DESCRIPTION:
!   Copies and ASCIZ string.
!
! FORMAL PARAMETERS:
!   sptr        - pointer to source byte pointer (returned untouched)
!   dptr        - pointer to destination byte pointer (returned updated)
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   Returns the number of characters copied, not counting the trailing null.
!
! SIDE EFFECTS:
!    NONE
!
!--
    BEGIN

    LOCAL
        sp,
        c;

    sp = ..sptr;                        !Make a copy of source pointer
    INCR len FROM 0 BY 1
    DO
	BEGIN
	IF (c =CH$RCHAR_A (sp)) EQL 0
        THEN
	    BEGIN
            CH$WCHAR (0, ..dptr);
            RETURN (.len)
            END;
        !
	! Make ASCIZ string of dest, but don't bump DPTR past null byte
        !
	CH$WCHAR_A (.c, .dptr)
	END
    END;                                !move_ASCIZ
%SBTTL 'Routine S_ESOUT'
ROUTINE s_esout (sptr) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!   Do an ESOUT JSYS or simluate one
!
! FORMAL PARAMETERS:
!   sptr        - pointer to error text
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   NONE
!
! SIDE EFFECTS:
!    NONE
!
!--
    BEGIN
    %IF %SWITCHES(TOPS20)
    %THEN
	jsys_esout(.sptr);
    %ELSE
	CLRBFI_UUO(0);
	OUTSTR_UUO(UPLIT(%ASCIZ %CHAR(13,10,%C'?')));
	OUTSTR_UUO((CH$PLUS(.sptr,1))<rh>);
    %FI
    END;			! s_esout
END
ELUDOM