* BCOMP
* BASIC compiler
* Copyright (c) 2007 Ladybridge Systems, All Rights Reserved
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
* 
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
* GNU General Public License for more details.
* 
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software Foundation,
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
* 
* Ladybridge Systems can be contacted via the www.openqm.com web site.
* 
* START-HISTORY:
* 17 Oct 07  2.6-5 0565 A line such as
*                     123 * This is a comment,
*                  would treat the trailing comma as an implicit
*                  continuation marker and join the next line on to the
*                  comment text.
* 07 Aug 07  2.5-7 Added @GID and @UID.
* 07 Aug 07  2.5-7 Allow $INSERT as a synonym for $INCLUDE.
* 03 Aug 07  2.5-7 Added tracking of label references for XREF option.
* 01 Aug 07  2.5-7 Added $PAGE
* 08 Jun 07  2.5-7 Added SET.BREAK.HANDLER and REMOVE.BREAK.HANDLER.
* 02 May 07  2.5-3 Added Pick style dimensioned arguments to FUNCTION and
*                  SUBROUTINE.
*                  Allowed SUB as shortform for SUBROUTINE.
* 11 Apr 07  2.5-2 Renamed ENCRYPT() as PWCRYPT(). Added ENCRYPT() and
*                  DECRYPT().
* 28 Feb 07  2.5-0 Added READONLY option to public variables.
* 15 Feb 07  2.4-20 Allow use of dimensioned matrix in FOR/NEXT.
* 11 Dec 06  2.4-17 Added RDNXINT variant of READNEXT.
* 29 Nov 06  2.4-17 Added PANNING mode to INPUT@ and INPUTFIELD.
* 21 Nov 06  2.4-17 Aded MAX.ARGS option to CLASS statement.
* 21 Nov 06  2.4-17 Added ... syntax to public function/subroutine arguments.
* 02 Nov 06  2.4-15 Dictionary record types now case insensitive.
* 25 Oct 06  2.4-15 Added APPEND mode to INPUTFIELD.
* 11 Oct 06  2.4-15 Added support for equated @variables.
* 11 Oct 06  2.4-15 Trap COMMON /"xxx"/.
* 08 Sep 06  2.4-13 0519 PRINT "ON" was treated as PRINT ON.
* 24 Aug 06  2.4-12 Added EDIT and OVERLAY flags to INPUT@ and INPUTFIELD.
* 17 Aug 06  2.4-11 Allow EQU to reference an equate token.
* 16 Aug 06  2.4-11 Added $NO.CATALOGUE.
* 20 Jul 06  2.4-10 0504 BREAK, ECHO, HUSH and MARK.MAPPING fix for 0144 was
*                   not handling single line IF/THEN/ELSE. Also, the side entry
*                   to expr was causing a compiler crash if these statements
*                   were the first use of an expression in the program.
* 20 Jul 06  2.4-10 0503 Allow "ON var GO TO".
* 18 Jul 06  2.4-10 Allow no second argument in SORTADD.
* 10 Jul 06  2.4-9 Modified "warnings as errors" behaviour to increment error
*                  count but otherwise follow normal warning path.
* 07 Jul 06  2.4-9 Added three argument variant of FOLD().
* 06 Jul 06  2.4-9 DEFFUN should not generate a debug call.
* 06 Jul 06  2.4-9 Local functions and subroutines now require an END.
* 30 Jun 06  2.4-6 Allow null argument list in public function.
* 30 Jun 06  2.4-6 Added SET.ARG
* 21 Jun 06  2.4-5 Added OBJINFO().
* 13 Jun 06  2.4-5 Allow over 255 labels in an ON GOTO / ON GOSUB.
* 11 May 06  2.4-4 Made CSVDQ() public.
* 10 May 06  2.4-4 Added MATREADCSV.
* 10 May 06  2.4-4 Use record name as default catalogue name.
* 05 May 06  2.4-4 Added LOGIN.PORT() restricted function.
* 01 May 06  2.4-2 Do not generate DEBUG statements for CLASS, GET, PRIVATE,
*                  PUBLIC and SET.
* 19 Apr 06  2.4-2 Added CONNECT.PORT().
* 19 Apr 06  2.4-1 0478 A program that ended with an INPUT statement hung the
*                  compiler looking for the THEN/ELSE clause.
* 17 Apr 06  2.4-1 Added DELETESEQ statement.
* 17 Apr 06  2.4-1 0474 DEBUGGING option in $BASIC.OPTIONS was ignored.
* 14 Apr 06  2.4-1 Added $MODE PICK.SUBSTRA.ASSIGN.
* 13 Apr 06  2.4-1 Added PAUSE and WAKE.
* 07 Apr 06  2.4-1 Added RTRANS().
* 06 Apr 06  2.4-1 Public functions/subroutines can now be declared var.args.
* 04 Apr 06  2.4-1 Allow matrices of objects.
* 30 Mar 06  2.3-9 Added $MODE TRAP.UNUSED.
* 29 Mar 06  2.3-9 Added ARG.COUNT() and ARG().
* 22 Mar 06  2.3-9 Added object programming features.
* 21 Mar 06  2.3-9 Added XLATE() as a synonym for TRANS().
* 17 Mar 06  2.3-8 Added IN as alternative to KEYIN().
* 15 Mar 06  2.3-8 0464 CALL @X miscompiled if X was an equated token.
* 10 Mar 06  2.3-8 Optimised function call by use of indirection variable.
* 24 Feb 06  2.3-7 Added TIMEOUT statement.
* 23 Feb 06  2.3-7 Added STATUS statement.
* 23 Feb 06  2.3-7 Added "EQU name TO var" for simple variable.
* 21 Feb 06  2.3-6 Added @USER as a synonym for @LOGNAME.
* 09 Feb 06  2.3-6 Added ISMV() restricted intrinsic (for query processor).
* 09 Feb 06  2.3-6 Modified get.call.name to allow use of operator names such
*                  as MATCHES as call names (to allow !MATCHES).
* 02 Feb 06  2.3-6 Added INPUTCSV, PRINTCSV, READCSV, WRITECSV.
* 02 Feb 06  2.3-6 Added FORMCSV() - Currently internal mode only.
* 25 Jan 06  2.3-5 0453 Moved setting of reserved words in INPUT so that colon
*                  is handled correctly in "INPUT X,1: HIDDEN".
* 06 Jan 06  2.3-4 Added TRANSACTION START/END/ABORT.
* 02 Jan 06  2.3-3 Changed DIM to PRIVATE in LOCAL declaration.
* 27 Dec 05  2.3-3 Removed trap for $CATALOGUE when already set by entry in
*                  $BASIC.OPTIONS as documentation says directive will override
*                  options record.
* 23 Dec 05  2.3-3 Allow underscore and colon to be in either order in INPUT.
* 22 Dec 05  2.3-3 Allow matrix reference before DIM statement.
* 20 Dec 05  2.3-3 Added SET.EXIT.STATUS.
* 15 Dec 05  2.3-2 0440 Check that token is a name before looking in FILE name
*                  table when processing WRITE.
* 14 Dec 05  2.3-2 CREATE.AK now takes collation map name and map.
* 02 Dec 05  2.2-18 Added WARNINGS.AS.ERRORS option.
* 02 Dec 05  2.2-18 Added LOCAL functions and subroutines.
* 30 Nov 05  2.2-18 Implemented the Pick style FILE statement and all the
*                   associated changes.
* 30 Nov 05  2.2-18 Allow CATALOG as alternative to CATALOGUE in $BASIC.OPTIONS
* 19 Oct 05  2.2-15 Added CSVDQ() restricted function.
* 17 Oct 05  2.2-15 Added UPCASE option to INPUT, INPUT@, INPUTFIELD.
* 11 Oct 05  2.2-14 CREATE.AK now takes two pathnames.
* 05 Oct 05  2.2-14 Added @SYS0 (restricted).
* 05 Oct 05  2.2-14 Added EXPAND.HF() restricted function.
* 29 Sep 05  2.2-13 0417 IF X THEN CLEARSELECT ELSE CONTINUE was treating ELSE
*                   as a variable name.
* 29 Sep 05  2.2-13 For compatibility with other systems, the PASSLIST option
*                   can be used without a qualifying name to use list 0.
* 28 Sep 05  2.2-13 Added OUTERJOIN().
* 28 Sep 05  2.2-13 Added DPARSE.CSV statement.
* 22 Sep 05  2.2-12 Allow use of STEP as a variable by treating as a reserved
*                   word only when processing TO expression of a FOR statement.
* 15 Sep 05  2.2-10 0409 Added CURRENT.LEVEL option to EXECUTE (restricted).
* 01 Sep 05  2.2-9 Added GET.MESSAGES().
* 26 Aug 05  2.2-8 0397 Commons array was maintained in sorted order but the
*                  symbol table relied on unchanging positions. This caused
*                  generation of the wrong code of Pick matrices in common.
* 24 Aug 05  2.2-8 Added hex numeric constants.
* 24 Aug 05  2.2-8 Added append and overwrite modes to OPENSEQ.
* 04 Aug 05  2.2-7 Added immediate argument to LOGOUT().
* 28 Jul 05  2.2-6 Added SET.SOCKET.MODE().
* 14 Jul 05  2.2-4 Return object code when compiling recursive.
* 30 Jun 05  2.2-3 Added socket functions.
* 29 Jun 05  2.2-1 Added Pick style ENTER and corresponding $MODE option.
* 17 Jun 05  2.2-1 Added FCONTROL().
* 15 Jun 05  2.2-1 Added $MODE COMPATIBLE.APPEND.
* 13 Jun 05  2.2-1 Allow SETTING/RETURNING clause of EXECUTE in any position.
* 06 Jun 05  2.2-1 Added PICK.SUBSTR mode.
* 27 May 05  2.2-0 0362 ABORT and STOP were fooled by literal strings that
*                  matched reserved words.
* 24 May 05  2.2-0 0360 CLEARSELECT with no list number gave error if followed
*                  by a semicolon.
* 06 May 05  2.1-13 Added SWAP() as a synonym for CHANGE().
* 27 Apr 05  2.1-13 0347 Ensure that symbol mode is returned to SYM.USE after
*                   an expression in an argument list otherwise literal values
*                   as arguments leave the next item reference as SYM.ARG.
* 11 Apr 05  2.1-12 0342 Check parenthesis depth in is.field.ref when deciding
*                   what to do with AND/OR/THEN element.
* 05 Apr 05  2.1-12 0337 Check token table space when converting >= to > and =
*                   in a field reference.
* 04 Apr 05  2.1-12 0336 Allow labels on the END of a conditioned block.
* 28 Mar 05  2.1-11 Added $MODE OPTIONAL.FINAL.END
* 28 Mar 05  2.1-11 Added SUBSTITUTE().
* 16 Mar 05  2.1-10 0326 Use OP.STORSYS when creating system variables so that
*                   CLEAR ignores them.
* 16 Mar 05  2.1-10 Added Pick style read mode ($MODE PICK.READ).
* 10 Mar 05  2.1-8 Removed SUPPRESS.FF flag.
* 10 Mar 05  2.1-8 Added READONLY to OPEN and OPENSEQ.
* 09 Mar 05  2.1-8 Added PICK.JUMP.RANGE mode for Pick style handling of out of
*                  range index in ON GOTO and ON GOSUB.
* 06 Mar 05  2.1-8 0321 Trap EQU to define a token already known as a variable.
* 04 Mar 05  2.1-8 0319 Reserved word check in emit.print.list was not ignoring
*                  quoted strings.
* 24 Feb 05  2.1-8 Added CHGPHANT.
* 18 Feb 05  2.1-7 Added DPARSE.
* 18 Feb 05  2.1-7 Added TCLREAD.
* 18 Jan 05  2.1-3 Added HIDDEN option to INPUT statements.
* 15 Jan 05  2.1-2 0303 Check for reserved name after STOP, ABORT, CRT, PRINT
*                  and RELEASE.
* 11 Jan 05  2.1-0 Emit object header in machine byte ordering.
* 02 Jan 05  2.1-0 Added @HOSTNAME.
* 24 Dec 04  2.1-0 Added dereferencing of arguments in SUBROUTINE and
*                   FUNCTION.
* 24 Dec 04  2.1-0 Added support for A/S-types in {name} construct.
* 22 Dec 04  2.1-0 Added CAPTURING clause to OS.EXECUTE.
* 17 Dec 04  2.1-0 Added PROC @variables.
* 07 Dec 04  2.1-0 Separated out as a callable compiler function.
* 25 Nov 04  2.0-11 0288 Call to emit.xref.entry in ST.IF ELSE clause
*                   processing is too early and causes line table to slip out
*                   of sync if there is no ELSE clause.
* 22 Nov 04  2.0-11 0287 Pick style LOCATE() should allow any valid expression
*                   as data to search.
* 14 Nov 04  2.0-10 Use IFL rather than IF conversion for LDFLOAT.
* 04 Nov 04  2.0-10 Trap use of ABORT, STOP and CHAIN in recursives.
* 29 Oct 04  2.0-9 (DBD) Added support for CCALL().
* 21 Oct 04  2.0-6 Allow # as alternative to $ in directive names.
* 20 Oct 04  2.0-6 0265 Added capability for statements to define a local set
*                  of reserved words. This was done for EXECUTE but may have
*                  much wider use.
* 19 Oct 04  2.0-6 Cannot use CHANGED with non-directory file source/object.
* 15 Oct 04  2.0-5 Added LOGMSG statement.
* 13 Oct 04  2.0-5 Use message handler.
* 11 Oct 04  2.0-5 SET.TRIGGER now takes mode argument.
* 11 Oct 04  2.0-5 0258 Nested user defined functions were not working as the
*                  function return variable got overwritten.
* 06 Oct 04  2.0-5 Allow source in dynamic file.
* 26 Sep 04  2.0-2 Remove trailing CR from source lines for cross-platform
*                  compatibility.
* 22 Sep 04  2.0-2 Delete composite pcode library when filing a recursive.
* 20 Sep 04  2.0-2 Recursives now generate dynamically loadable pcode.
* 16 Sep 04  2.0-1 Added MIN() and MAX().
* 16 Sep 04  2.0-1 OpenQM launch. Earlier history details suppressed.
* END-HISTORY
*
* START-DESCRIPTION:
*
* Note for GPL developers:
* This compiler uses a simple single pass approach. No doubt a clever compiler
* could produce better code but it just didn't seem worth the effort and
* experiment suggests that fancy optimisation doesn't produce the benefits
* that it does with languages where opcodes are simple actions.
* The only horrible bit is the resolution of the syntactic ambiguity of the
* < and > characters. We have been unable to find any written specification
* that sets out how these should be processed but our implementation works
* for every real program that we have tried.
*
* Adding new statements requires an entry in the STATEMENTS list and a
* corresponding entry in the ON GOSUB that uses this list.
*
* Adding a new intrinsic function requires entries in the INTRINSICS and
* INTRINSIC.OPCODES lists and a corresponding entry in that ON GOSUB.
*
* New opcodes should be defined in the C opcodes.h include file. The equivalent
* QMBasic include record is generated using the OPGEN program.
*
* The compiler uses a few internal features of QM, especially the binary tree
* variable type. We kept this type private because it is a bit weird to use
* and we thought it highly likely that we would change its implementation
* from time to time.
*
*
* Hidden variable names:
* _xxx        Direct call to subroutine xxx
* ~xxx        {xxx} object code
* __n         Temporary variable n (n is numeric)
* __name      File variable for file opened using FILE statement
* *n          Argument n to object routine. These will always end up as local
*             variables 0 upwards but must be in the symbol table
*             for the compiler to function correctly.
* *VARS       Pseudo-common for persistent variable array in object.
*
* Other special name formats:
* sss:xxx     Local variable xxx for LOCAL SUB sss
*
* Internally generated label names:
* *n          Get/Set/method routine n
*
* END-DESCRIPTION
*
* START-CODE

$internal
subroutine $bcomp(source.file.name,     ;* File name, null for C-type dict item
                  src.f,                ;* File var to source file
                  record.name,          ;* Record
                  is.ctype,             ;* Is this a C-type?
                  prog.source,          ;* Source text to compile
                  output.file.name,     ;* Target file name
                  listing.record.name,  ;* Listing record (null for C-type)
                  compiler.flags,
                  compiler.depth,       ;* Recursive compilation depth
                  catalogue.name,       ;* Out: Catalogue under this name...
                  catalogue.mode,       ;* Out: ... in this mode
                  object.code,          ;* Out: Compiled code
                  errors)               ;* Out: Error count
$catalog $BCOMP

$include syscom.h
$include tokens.h
$include opcodes.h
$include header.h
$include dictdict.h
$include int$keys.h
$include bcomp.h

$include err.h
$include keys.h

$define max.levels   10


* Values of mode (Bit positions)
$define M.UV.LOCATE             0
$define M.PICK.ERRMSG           1
$define M.STRING.LOCATE         2
$define M.COMPOSITE.READNEXT    3
$define M.SELECTV               4
$define M.PRCLOSE.DEFAULT.0     5
$define M.FOR.STORE.BEFORE.TEST 6
$define M.CASE.SENSITIVE        7
$define M.PMATRIX               8
$define M.PICK.JUMP.RANGE       9
$define M.PICK.READ            10
$define M.OPTIONAL.FINAL.END   11
$define M.PICK.SUBSTR          12
$define M.COMPAT.APPEND        13
$define M.PICK.ENTER           14
$define M.TRAP.UNUSED          15
$define M.PICK.SUBSTR.ASSIGN   16
$define M.UNASSIGNED.COMMON    17
* Corresponding names, value delimited, first name is bit 0 of mode flags
mode.names = "UV.LOCATEPICK.ERRMSGSTRING.LOCATECOMPOSITE.READNEXTSELECTV"
mode.names := "PRCLOSE.DEFAULT.0FOR.STORE.BEFORE.TEST"
mode.names := "CASE.SENSITIVEPICK.MATRIXPICK.JUMP.RANGEPICK.READ"
mode.names := "OPTIONAL.FINAL.ENDPICK.SUBSTRCOMPATIBLE.APPEND"
mode.names := "PICK.ENTERTRAP.UNUSEDPICK.SUBSTR.ASSIGN"
mode.names := "UNASSIGNED.COMMON"

*****************************************************************************

   * If this is a C-type, the {name} construct refers to the dictionary
   * holding the source. Otherwise, the {name} construct is not available
   * until the $DICT directive is used.

   if is.ctype then dict.f = src.f

   object.code = ''

   * Initialise constant data

   * Characters that are allowed in a QMBasic name

   name.chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.$%_'

   max.tokens = 100  ;* Initial size of token tables (tokens per line)

   dim btree.keys(1)

   dim op(TKN.HIGH.OPERATOR)          ;* Operator token / opcodes relationship
   dim op.priority(TKN.HIGH.OPERATOR) ;* Operator priorities.  Operators with
                                       * low priority values are applied first.
                                       * Values are (N * 10) + 1 where N is the
                                       * priority as shown in the user
                                       * documentation.  The + 1 is used to
                                       * allow the ** operator to be treated
                                       * as a special case in EXPR.

   op(TKN.PWR) = OP.PWR         ;   op.priority(TKN.PWR) = 21
   op(TKN.DIV) = OP.DIV         ;   op.priority(TKN.DIV) = 31
   op(TKN.IDIV) = OP.IDIV       ;   op.priority(TKN.IDIV) = 31
   op(TKN.MULT) = OP.MUL        ;   op.priority(TKN.MULT) = 31
   op(TKN.PLUS) = OP.ADD        ;   op.priority(TKN.PLUS) = 41
   op(TKN.MINUS) = OP.SUB       ;   op.priority(TKN.MINUS) = 41
   op(TKN.FMT) = OP.FMT         ;   op.priority(TKN.FMT) = 51
   op(TKN.COLON) = OP.CAT       ;   op.priority(TKN.COLON) = 61
   op(TKN.MATCHES) = OP.MATCHES ;   op.priority(TKN.MATCHES) = 71
   op(TKN.LT) = OP.LT           ;   op.priority(TKN.LT) = 71
   op(TKN.LTX) = OP.LT          ;   op.priority(TKN.LTX) = 71
   op(TKN.GT) = OP.GT           ;   op.priority(TKN.GT) = 71
   op(TKN.GTX) = OP.GT          ;   op.priority(TKN.GTX) = 71
   op(TKN.EQ) = OP.EQ           ;   op.priority(TKN.EQ) = 71
   op(TKN.NE) = OP.NE           ;   op.priority(TKN.NE) = 71
   op(TKN.NEX) = OP.NE          ;   op.priority(TKN.NEX) = 71
   op(TKN.LE) = OP.LE           ;   op.priority(TKN.LE) = 71   
   op(TKN.GE) = OP.GE           ;   op.priority(TKN.GE) = 71
   op(TKN.GEX) = OP.GE          ;   op.priority(TKN.GEX) = 71
   op(TKN.AND) = OP.AND         ;   op.priority(TKN.AND) = 81
   op(TKN.OR) = OP.OR           ;   op.priority(TKN.OR) = 81

   n = idiv(max.tokens, 2)      ;* Worst possible case (may resize later)
   dim operator.stack(n)        ;* Infix - postfix operator stack...
   dim priority.stack(n)        ;* ...and associated priority stack
$define STACK.MARK 9999         ;* Marks start of sub-expression
   priority.stack(0) = STACK.MARK


   * Source parsing

   dim tokens(max.tokens)        ; mat tokens = TKN.END
   dim token.strings(max.tokens) ; mat token.strings = ""

   mark.chars = @fm:@vm:@sm:@tm:@im:@fm:@sm ;* See EMIT.AT.VAR.LOAD for use

   * The AT.CONSTANTS list holds @ variables which are either constants or
   * have special code to produce the values.

* !!ATVAR!!
   at.constants = "FM":@fm:"VM":@fm:"SM":@fm:"TM":@fm:"IM":@fm:"AM":@fm:"SVM"
   at.constants := @fm:"FALSE":@fm:"TRUE":@fm:"QMSYS":@fm:"USERNO":@fm:"USER.NO"
   at.constants := @fm:"DAY":@fm:"MONTH":@fm:"YEAR":@fm:"YEAR4"
   at.constants := @fm:"LPTRHIGH":@fm:"LPTRWIDE":@fm:"CRTHIGH":@fm:"CRTWIDE"
   at.constants := @fm:"LEVEL":@fm:"TERM.TYPE":@fm:"TRANSACTION.ID"
   at.constants := @fm:"TRANSACTION.LEVEL":@fm:"IP.ADDR":@fm:"HOSTNAME"
   at.constants := @fm:"GID":@fm:"UID"

   * The AT.SYSCOM.VARS list contains @ variables which correspond to data
   * in the SYSCOM common block. The offset of the common variable is in
   * the AT.SYSCOM.OFFSETS list.

   at.syscom.vars = ""                       ; at.syscom.offsets = ""
   at.syscom.vars<-1> = "ABORT.CODE"         ; at.syscom.offsets<-1> = SYSCOM.ABORT.CODE
   at.syscom.vars<-1> = "ABORT.MESSAGE"      ; at.syscom.offsets<-1> = SYSCOM.ABORT.MESSAGE
   at.syscom.vars<-1> = "ANS"                ; at.syscom.offsets<-1> = SYSCOM.AT.ANS
   at.syscom.vars<-1> = "COMMAND"            ; at.syscom.offsets<-1> = SYSCOM.COMMAND
   at.syscom.vars<-1> = "COMMAND.STACK"      ; at.syscom.offsets<-1> = SYSCOM.COMMAND.STACK
   at.syscom.vars<-1> = "CONV"               ; at.syscom.offsets<-1> = SYSCOM.CONV
   at.syscom.vars<-1> = "DATA.PENDING"       ; at.syscom.offsets<-1> = SYSCOM.DATA.QUEUE
   at.syscom.vars<-1> = "DATE"               ; at.syscom.offsets<-1> = SYSCOM.CPROC.DATE
   at.syscom.vars<-1> = "DS"                 ; at.syscom.offsets<-1> = SYSCOM.DS
   at.syscom.vars<-1> = "FILE.NAME"          ; at.syscom.offsets<-1> = SYSCOM.QPROC.FILE.NAME
   at.syscom.vars<-1> = "ID"                 ; at.syscom.offsets<-1> = SYSCOM.QPROC.ID
   at.syscom.vars<-1> = "ITYPE.MODE"         ; at.syscom.offsets<-1> = SYSCOM.ITYPE.MODE
   at.syscom.vars<-1> = "LOGNAME"            ; at.syscom.offsets<-1> = SYSCOM.LOGNAME
   at.syscom.vars<-1> = "ND"                 ; at.syscom.offsets<-1> = SYSCOM.QPROC.ND
   at.syscom.vars<-1> = "NI"                 ; at.syscom.offsets<-1> = SYSCOM.QPROC.NI
   at.syscom.vars<-1> = "NS"                 ; at.syscom.offsets<-1> = SYSCOM.QPROC.NS
   at.syscom.vars<-1> = "NV"                 ; at.syscom.offsets<-1> = SYSCOM.QPROC.NV
   at.syscom.vars<-1> = "LPV"                ; at.syscom.offsets<-1> = SYSCOM.QPROC.LPV
   at.syscom.vars<-1> = "OPTION"             ; at.syscom.offsets<-1> = SYSCOM.OPTION
   at.syscom.vars<-1> = "PARASENTENCE"       ; at.syscom.offsets<-1> = SYSCOM.PARASENTENCE
   at.syscom.vars<-1> = "PATH"               ; at.syscom.offsets<-1> = SYSCOM.ACCOUNT.PATH
   at.syscom.vars<-1> = "PIB"                ; at.syscom.offsets<-1> = SYSCOM.PROC.IBUF:'.0'
   at.syscom.vars<-1> = "POB"                ; at.syscom.offsets<-1> = SYSCOM.PROC.OBUF:'.0'
   at.syscom.vars<-1> = "RECORD"             ; at.syscom.offsets<-1> = SYSCOM.QPROC.RECORD
   at.syscom.vars<-1> = "SELECTED"           ; at.syscom.offsets<-1> = SYSCOM.SELECTED
   at.syscom.vars<-1> = "SENTENCE"           ; at.syscom.offsets<-1> = SYSCOM.SENTENCE
   at.syscom.vars<-1> = "SIB"                ; at.syscom.offsets<-1> = SYSCOM.PROC.IBUF:'.1'
   at.syscom.vars<-1> = "SOB"                ; at.syscom.offsets<-1> = SYSCOM.PROC.OBUF:'.1'
   at.syscom.vars<-1> = "SYS.BELL"           ; at.syscom.offsets<-1> = SYSCOM.BELL
   at.syscom.vars<-1> = "SYS0"               ; at.syscom.offsets<-1> = SYSCOM.SYS0
   at.syscom.vars<-1> = "SYSTEM.RETURN.CODE" ; at.syscom.offsets<-1> = SYSCOM.SYSTEM.RETURN.CODE
   at.syscom.vars<-1> = "SYSTEM.SET"         ; at.syscom.offsets<-1> = SYSCOM.SYSTEM.RETURN.CODE
   at.syscom.vars<-1> = "TIME"               ; at.syscom.offsets<-1> = SYSCOM.CPROC.TIME
   at.syscom.vars<-1> = "TTY"                ; at.syscom.offsets<-1> = SYSCOM.TTY
   at.syscom.vars<-1> = "TRIGGER.RETURN.CODE"; at.syscom.offsets<-1> = SYSCOM.TRIGGER.RETURN.CODE
   at.syscom.vars<-1> = "USER.RETURN.CODE"   ; at.syscom.offsets<-1> = SYSCOM.USER.RETURN.CODE
   at.syscom.vars<-1> = "USER"               ; at.syscom.offsets<-1> = SYSCOM.LOGNAME
   at.syscom.vars<-1> = "USER0"              ; at.syscom.offsets<-1> = SYSCOM.USER0
   at.syscom.vars<-1> = "USER1"              ; at.syscom.offsets<-1> = SYSCOM.USER1
   at.syscom.vars<-1> = "USER2"              ; at.syscom.offsets<-1> = SYSCOM.USER2
   at.syscom.vars<-1> = "USER3"              ; at.syscom.offsets<-1> = SYSCOM.USER3
   at.syscom.vars<-1> = "USER4"              ; at.syscom.offsets<-1> = SYSCOM.USER4
   at.syscom.vars<-1> = "VOC"                ; at.syscom.offsets<-1> = SYSCOM.VOC
   at.syscom.vars<-1> = "WHO"                ; at.syscom.offsets<-1> = SYSCOM.WHO


   * The following @variables, also in the AT.SYSCOM.VARS list above, may be
   * used as lvalues in non-internal mode code.

   at.syscom.lvars = "USER.RETURN.CODE":@fm:"DATE":@fm:"TIME":@fm:"ID"
   at.syscom.lvars := @fm:"RECORD":@fm:"SELECTED":@fm:"TRIGGER.RETURN.CODE"
   at.syscom.lvars := @fm:"USER0":@fm:"USER1":@fm:"USER2":@fm:"USER3":@fm:"USER4"
   at.syscom.lvars := @fm:"ANS":@fm:"PIB":@fm:"SIB":@fm:"POB":@fm:"SOB"

   * Statement names.  All these statements generate DEBUG calls if debugging

   statements = "ABORT":@fm:"ABORTE":@fm:"ABORTM"
   statements := @fm:"BEGIN":@fm:"BREAK"
   statements := @fm:"CALL":@fm:"CASE":@fm:"CHAIN"
   statements := @fm:"CLEAR":@fm:"CLEARCOMMON"
   statements := @fm:"CLEARDATA":@fm:"CLEARFILE":@fm:"CLEARINPUT"
   statements := @fm:"CLEARSELECT":@fm:"CLOSE":@fm:"CLOSESEQ":@fm:"CLOSE.SOCKET"
   statements := @fm:"COMMIT":@fm:"CONTINUE":@fm:"CONVERT":@fm:"CREATE"
   statements := @fm:"CREATE.FILE":@fm:"CRT"
   statements := @fm:"DATA":@fm:"DEBUG":@fm:"DEL":@fm:"DELETE"
   statements := @fm:"DELETELIST":@fm:"DELETESEQ":@fm:"DELETEU"
   statements := @fm:"DIM":@fm:"DIMENSION":@fm:"DISINHERIT"
   statements := @fm:"DISPLAY":@fm:"DO":@fm:"DPARSE":@fm:"DPARSE.CSV"
   statements := @fm:"ECHO":@fm:"ELSE":@fm:"END":@fm:"ENTER":@fm:"ERRMSG"
   statements := @fm:"EXECUTE":@fm:"EXIT"
   statements := @fm:"FILE":@fm:"FILELOCK":@fm:"FILEUNLOCK":@fm:"FIND"
   statements := @fm:"FINDSTR":@fm:"FLUSH":@fm:"FOOTING":@fm:"FOR"
   statements := @fm:"FORMLIST"
   statements := @fm:"GETLIST":@fm:"GO":@fm:"GOSUB":@fm:"GOTO"
   statements := @fm:"HEADING":@fm:"HUSH"
   statements := @fm:"IF":@fm:"IN":@fm:"INCLUDE":@fm:"INHERIT"
   statements := @fm:"INPUT":@fm:"INPUTCLEAR"
   statements := @fm:"INPUTCSV"
   statements := @fm:"INPUTERR":@fm:"INPUTFIELD":@fm:"INS"
   statements := @fm:"KEYEDIT":@fm:"KEYEXIT":@fm:"KEYTRAP"
   statements := @fm:"LOCAL":@fm:"LOCATE":@fm:"LOCK":@fm:"LOGMSG":@fm:"LOOP"
   statements := @fm:"MARK.MAPPING":@fm:"MAT":@fm:"MATBUILD":@fm:"MATPARSE"
   statements := @fm:"MATREAD":@fm:"MATREADCSV":@fm:"MATREADL":@fm:"MATREADU"
   statements := @fm:"MATWRITE":@fm:"MATWRITEU"
   statements := @fm:"NAP":@fm:"NEXT":@fm:"NOBUF":@fm:"NULL"
   statements := @fm:"ON":@fm:"OPEN":@fm:"OPENPATH":@fm:"OPENSEQ"
   statements := @fm:"OS.EXECUTE"
   statements := @fm:"PAGE":@fm:"PAUSE"
   statements := @fm:"PERFORM":@fm:"PRECISION":@fm:"PRINT"
   statements := @fm:"PRINTER":@fm:"PRINTCSV":@fm:"PRINTERR"
   statements := @fm:"PROCREAD":@fm:"PROCWRITE":@fm:"PROMPT"
   statements := @fm:"RANDOMIZE":@fm:"READ":@fm:"READBLK":@fm:"READCSV"
   statements := @fm:"READL":@fm:"READLIST":@fm:"READNEXT":@fm:"READSEQ"
   statements := @fm:"READU":@fm:"READV":@fm:"READVL":@fm:"READVU"
   statements := @fm:"RECORDLOCKL":@fm:"RECORDLOCKU":@fm:"RELEASE":@fm:"REM"
   statements := @fm:"REMARK":@fm:"REMOVE":@fm:"REMOVE.BREAK.HANDLER"
   statements := @fm:"REPEAT":@fm:"RESTORE.SCREEN"
   statements := @fm:"RETURN":@fm:"ROLLBACK":@fm:"RQM"
   statements := @fm:"SAVELIST":@fm:"SEEK":@fm:"SELECT":@fm:"SELECTE"
   statements := @fm:"SELECTINDEX":@fm:"SELECTLEFT":@fm:"SELECTN"
   statements := @fm:"SELECTRIGHT":@fm:"SELECTV":@fm:"SENDMAIL":@fm:"SET.ARG"
   statements := @fm:"SET.BREAK.HANDLER"
   statements := @fm:"SET.EXIT.STATUS":@fm:"SETLEFT"
   statements := @fm:"SETNLS":@fm:"SETPU":@fm:"SETRIGHT":@fm:"SETREM"
   statements := @fm:"SLEEP":@fm:"SSELECT":@fm:"STATUS"
   statements := @fm:"STOP":@fm:"STOPE":@fm:"STOPM"
   statements := @fm:"TCLREAD":@fm:"TIMEOUT":@fm:"TRANSACTION":@fm:"TTYSET"
   statements := @fm:"UNLOCK":@fm:"UNTIL":@fm:"VOID"
   statements := @fm:"WAKE"
   statements := @fm:"WEOFSEQ":@fm:"WHILE":@fm:"WRITE":@fm:"WRITEBLK"
   statements := @fm:"WRITECSV"
   statements := @fm:"WRITESEQ":@fm:"WRITESEQF":@fm:"WRITEU":@fm:"WRITEV"
   statements := @fm:"WRITEVU"

   * Statements which do not generate DEBUG calls when debugging

   non.debug.statements = "CLASS":@fm:"COM":@fm:"COMMON":@fm:"DEFFUN"
   non.debug.statements := @fm:"EQU":@fm:"EQUATE"
   non.debug.statements := @fm:"FUNCTION":@fm:"GET":@fm:"PRIVATE":@fm:"PROGRAM"
   non.debug.statements := @fm:"PUBLIC":@fm:"SET":@fm:"SUB":@fm:"SUBROUTINE"

   * Internal (restricted) statements

   restricted.statements = "ADD":@fm:"AKCLEAR":@fm:"AKDELETE"
   restricted.statements := @fm:"AKENABLE":@fm:"AKREAD":@fm:"AKRELEASE"
   restricted.statements := @fm:"AKWRITE"
   restricted.statements := @fm:"BREAKPOINT"
   restricted.statements := @fm:"CALLV":@fm:"COMO":@fm:"CONFIGURE.FILE"
   restricted.statements := @fm:"CREATE.AK"
   restricted.statements := @fm:"DEBUG.OFF":@fm:"DEBUG.ON"
   restricted.statements := @fm:"DEBUG.SET":@fm:"DELETE.AK"
   restricted.statements := @fm:"DELETE.COMMON":@fm:"KEYBOARD.INPUT"
   restricted.statements := @fm:"MODIFY"
   restricted.statements := @fm:"QUIT"
   restricted.statements := @fm:"RELEASE.LOCK":@fm:"REMOVE.TOKEN"
   restricted.statements := @fm:"RESET.MODES":@fm:"REWIND":@fm:"RUN"
   restricted.statements := @fm:"SET.MODES":@fm:"SET.STATUS":@fm:"SET.TRIGGER"
   restricted.statements := @fm:"SET.UNASSIGNED"
   restricted.statements := @fm:"SORTADD":@fm:"SORTCLEAR":@fm:"SORTINIT"
   restricted.statements := @fm:"TRACE":@fm:"UNLOAD.OBJECT"
   restricted.statements := @fm:"VARSET"
   restricted.statements := @fm:"WATCH":@fm:"WRITEPKT"

   * Reserved names
   * This list starts out as the list of names that are reserved in all
   * usages. Individual statement processing routines can add a local
   * list of reserved names for that statement as field 2 but it is
   * essential that these are removed again. As a sanity check, the
   * error handler removes field 2 if it is present. Therefore, it is
   * not necessary to tidy up in error paths.

   reserved.names = "BEFORE"          ;* 0265
   reserved.names<1,-1> = "BY"
   reserved.names<1,-1> = "DO"
   reserved.names<1,-1> = "ELSE"
   reserved.names<1,-1> = "FROM"
   reserved.names<1,-1> = "GO"
   reserved.names<1,-1> = "IN"
   reserved.names<1,-1> = "LOCKED"
   reserved.names<1,-1> = "NEXT"
   reserved.names<1,-1> = "ON"
   reserved.names<1,-1> = "REPEAT"
   reserved.names<1,-1> = "SETTING"
   reserved.names<1,-1> = "THEN"
   reserved.names<1,-1> = "TO"
   reserved.names<1,-1> = "UNTIL"
   reserved.names<1,-1> = "WHILE"


   * Intrinsic function names and associated opcodes

   intrinsics = "ABS"                 ; intrinsic.opcodes = OP.ABS
   intrinsics<-1> = "ABSS"            ; intrinsic.opcodes<-1> = OP.ABSS
   intrinsics<-1> = "ACCEPT.SOCKET.CONNECTION" ; intrinsic.opcodes<-1> = OP.ACCPTSKT
   intrinsics<-1> = "ACOS"            ; intrinsic.opcodes<-1> = OP.ACOS
   intrinsics<-1> = "ALPHA"           ; intrinsic.opcodes<-1> = OP.ALPHA
   intrinsics<-1> = "ANDS"            ; intrinsic.opcodes<-1> = OP.ANDS
   intrinsics<-1> = "ARG"             ; intrinsic.opcodes<-1> = OP.ARG
   intrinsics<-1> = "ARG.COUNT"       ; intrinsic.opcodes<-1> = OP.ARGCT
   intrinsics<-1> = "ASCII"           ; intrinsic.opcodes<-1> = OP.ASCII
   intrinsics<-1> = "ASIN"            ; intrinsic.opcodes<-1> = OP.ASIN
   intrinsics<-1> = "ASSIGNED"        ; intrinsic.opcodes<-1> = OP.ASS
   intrinsics<-1> = "ATAN"            ; intrinsic.opcodes<-1> = OP.ATAN
   intrinsics<-1> = "BINDKEY"         ; intrinsic.opcodes<-1> = OP.BINDKEY
   intrinsics<-1> = "BITAND"          ; intrinsic.opcodes<-1> = OP.BITAND
   intrinsics<-1> = "BITNOT"          ; intrinsic.opcodes<-1> = OP.BITNOT
   intrinsics<-1> = "BITOR"           ; intrinsic.opcodes<-1> = OP.BITOR
   intrinsics<-1> = "BITRESET"        ; intrinsic.opcodes<-1> = OP.BITRESET
   intrinsics<-1> = "BITSET"          ; intrinsic.opcodes<-1> = OP.BITSET
   intrinsics<-1> = "BITTEST"         ; intrinsic.opcodes<-1> = OP.BITTEST
   intrinsics<-1> = "BITXOR"          ; intrinsic.opcodes<-1> = OP.BITXOR
   intrinsics<-1> = "CATALOGUED"      ; intrinsic.opcodes<-1> = OP.CHKCAT
   intrinsics<-1> = "CATS"            ; intrinsic.opcodes<-1> = OP.CATS
   intrinsics<-1> = "CCALL"           ; intrinsic.opcodes<-1> = OP.CCALL
   intrinsics<-1> = "CHANGE"          ; intrinsic.opcodes<-1> = OP.CHANGE
   intrinsics<-1> = "CHAR"            ; intrinsic.opcodes<-1> = OP.CHAR
   intrinsics<-1> = "CHECKSUM"        ; intrinsic.opcodes<-1> = OP.CHECKSUM
   intrinsics<-1> = "CHGPHANT"        ; intrinsic.opcodes<-1> = OP.CHGPHANT
   intrinsics<-1> = "COL1"            ; intrinsic.opcodes<-1> = OP.COL1
   intrinsics<-1> = "COL2"            ; intrinsic.opcodes<-1> = OP.COL2
   intrinsics<-1> = "COMPARE"         ; intrinsic.opcodes<-1> = OP.COMPARE
   intrinsics<-1> = "CONFIG"          ; intrinsic.opcodes<-1> = OP.CONFIG
   intrinsics<-1> = "CONNECT.PORT"    ; intrinsic.opcodes<-1> = OP.CNCTPORT
   intrinsics<-1> = "CONVERT"         ; intrinsic.opcodes<-1> = OP.FCONVERT
   intrinsics<-1> = "COS"             ; intrinsic.opcodes<-1> = OP.COS
   intrinsics<-1> = "COUNT"           ; intrinsic.opcodes<-1> = OP.COUNT
   intrinsics<-1> = "COUNTS"          ; intrinsic.opcodes<-1> = OP.COUNTS
   intrinsics<-1> = "CREATE.SERVER.SOCKET" ; intrinsic.opcodes<-1> = OP.SRVRSKT
   intrinsics<-1> = "CROP"            ; intrinsic.opcodes<-1> = OP.CROP
   intrinsics<-1> = "CSVDQ"           ; intrinsic.opcodes<-1> = OP.CSVDQ
   intrinsics<-1> = "DATE"            ; intrinsic.opcodes<-1> = OP.DATE
   intrinsics<-1> = "DCOUNT"          ; intrinsic.opcodes<-1> = OP.DCOUNT
   intrinsics<-1> = "DECRYPT"         ; intrinsic.opcodes<-1> = OP.DECRYPT
   intrinsics<-1> = "DELETE"          ; intrinsic.opcodes<-1> = OP.DEL
   intrinsics<-1> = "DIR"             ; intrinsic.opcodes<-1> = OP.DIR
   intrinsics<-1> = "DIV"             ; intrinsic.opcodes<-1> = OP.QUOTIENT
   intrinsics<-1> = "DOWNCASE"        ; intrinsic.opcodes<-1> = OP.DNCASE
   intrinsics<-1> = "DQUOTE"          ; intrinsic.opcodes<-1> = OP.QUOTE
   intrinsics<-1> = "DTX"             ; intrinsic.opcodes<-1> = OP.DTX
   intrinsics<-1> = "EBCDIC"          ; intrinsic.opcodes<-1> = OP.EBCDIC
   intrinsics<-1> = "ENCRYPT"         ; intrinsic.opcodes<-1> = OP.ENCRYPT
   intrinsics<-1> = "ENTER.PACKAGE"   ; intrinsic.opcodes<-1> = OP.PACKAGE
   intrinsics<-1> = "ENV"             ; intrinsic.opcodes<-1> = OP.ENV
   intrinsics<-1> = "EQS"             ; intrinsic.opcodes<-1> = OP.EQS
   intrinsics<-1> = "EXIT.PACKAGE"    ; intrinsic.opcodes<-1> = OP.PACKAGE
   intrinsics<-1> = "EXP"             ; intrinsic.opcodes<-1> = OP.EXP
   intrinsics<-1> = "EXTRACT"         ; intrinsic.opcodes<-1> = OP.EXTRACT
   intrinsics<-1> = "FIELD"           ; intrinsic.opcodes<-1> = OP.FIELD
   intrinsics<-1> = "FIELDS"          ; intrinsic.opcodes<-1> = OP.FIELDS
   intrinsics<-1> = "FIELDSTORE"      ; intrinsic.opcodes<-1> = OP.FLDSTORF
   intrinsics<-1> = "FILEINFO"        ; intrinsic.opcodes<-1> = OP.FILEINFO
   intrinsics<-1> = "FMT"             ; intrinsic.opcodes<-1> = OP.FMT
   intrinsics<-1> = "FMTS"            ; intrinsic.opcodes<-1> = OP.FMTS
   intrinsics<-1> = "FOLD"            ; intrinsic.opcodes<-1> = OP.FOLD
   intrinsics<-1> = "FOLDS"           ; intrinsic.opcodes<-1> = OP.FOLDS
   intrinsics<-1> = "GES"             ; intrinsic.opcodes<-1> = OP.GES
   intrinsics<-1> = "GET.MESSAGES"    ; intrinsic.opcodes<-1> = OP.GETMSG
   intrinsics<-1> = "GET.PORT.PARAMS" ; intrinsic.opcodes<-1> = OP.GETPORT
   intrinsics<-1> = "GETNLS"          ; intrinsic.opcodes<-1> = OP.GETNLS
   intrinsics<-1> = "GETPU"           ; intrinsic.opcodes<-1> = OP.GETPU
   intrinsics<-1> = "GETREM"          ; intrinsic.opcodes<-1> = OP.GETREM
   intrinsics<-1> = "GTS"             ; intrinsic.opcodes<-1> = OP.GTS
   intrinsics<-1> = "ICONV"           ; intrinsic.opcodes<-1> = OP.ICONV
   intrinsics<-1> = "ICONVS"          ; intrinsic.opcodes<-1> = OP.ICONVS
   intrinsics<-1> = "IDIV"            ; intrinsic.opcodes<-1> = OP.IDIV
   intrinsics<-1> = "IFS"             ; intrinsic.opcodes<-1> = OP.IFS
   intrinsics<-1> = "INDEX"           ; intrinsic.opcodes<-1> = OP.INDEX
   intrinsics<-1> = "INDEXS"          ; intrinsic.opcodes<-1> = OP.INDEXS
   intrinsics<-1> = "INDICES"         ; intrinsic.opcodes<-1> = OP.INDICES1
   intrinsics<-1> = "INMAT"           ; intrinsic.opcodes<-1> = OP.INMAT
   intrinsics<-1> = "INPUTBLK"        ; intrinsic.opcodes<-1> = OP.INPUTBLK
   intrinsics<-1> = "INSERT"          ; intrinsic.opcodes<-1> = OP.INSERT
   intrinsics<-1> = "INT"             ; intrinsic.opcodes<-1> = OP.INT
   intrinsics<-1> = "ITYPE"           ; intrinsic.opcodes<-1> = OP.ITYPE
   intrinsics<-1> = "KEYCODE"         ; intrinsic.opcodes<-1> = OP.KEYCODE
   intrinsics<-1> = "KEYIN"           ; intrinsic.opcodes<-1> = OP.KEYIN
   intrinsics<-1> = "KEYINC"          ; intrinsic.opcodes<-1> = OP.KEYINC
   intrinsics<-1> = "KEYINR"          ; intrinsic.opcodes<-1> = OP.KEYINR
   intrinsics<-1> = "KEYREADY"        ; intrinsic.opcodes<-1> = OP.KEYRDY
   intrinsics<-1> = "LEN"             ; intrinsic.opcodes<-1> = OP.LEN
   intrinsics<-1> = "LENS"            ; intrinsic.opcodes<-1> = OP.LENS
   intrinsics<-1> = "LES"             ; intrinsic.opcodes<-1> = OP.LES
   intrinsics<-1> = "LISTINDEX"       ; intrinsic.opcodes<-1> = OP.LISTINDX
   intrinsics<-1> = "LN"              ; intrinsic.opcodes<-1> = OP.LN
   intrinsics<-1> = "LOCATE"          ; intrinsic.opcodes<-1> = OP.LOCATEF
   intrinsics<-1> = "LOWER"           ; intrinsic.opcodes<-1> = OP.LOWER
   intrinsics<-1> = "LTS"             ; intrinsic.opcodes<-1> = OP.LTS
   intrinsics<-1> = "MATCHFIELD"      ; intrinsic.opcodes<-1> = OP.MATCHFLD
   intrinsics<-1> = "MAX"             ; intrinsic.opcodes<-1> = OP.MAX
   intrinsics<-1> = "MAXIMUM"         ; intrinsic.opcodes<-1> = OP.MAXIMUM
   intrinsics<-1> = "MIN"             ; intrinsic.opcodes<-1> = OP.MIN
   intrinsics<-1> = "MINIMUM"         ; intrinsic.opcodes<-1> = OP.MINIMUM
   intrinsics<-1> = "MOD"             ; intrinsic.opcodes<-1> = OP.MOD
   intrinsics<-1> = "MODS"            ; intrinsic.opcodes<-1> = OP.MODS
   intrinsics<-1> = "NEG"             ; intrinsic.opcodes<-1> = OP.NEG
   intrinsics<-1> = "NEGS"            ; intrinsic.opcodes<-1> = OP.NEGS
   intrinsics<-1> = "NES"             ; intrinsic.opcodes<-1> = OP.NES
   intrinsics<-1> = "NOT"             ; intrinsic.opcodes<-1> = OP.NOT
   intrinsics<-1> = "NOTS"            ; intrinsic.opcodes<-1> = OP.NOTS
   intrinsics<-1> = "NUM"             ; intrinsic.opcodes<-1> = OP.NUM
   intrinsics<-1> = "NUMS"            ; intrinsic.opcodes<-1> = OP.NUMS
   intrinsics<-1> = "OBJECT"          ; intrinsic.opcodes<-1> = OP.OBJECT
   intrinsics<-1> = "OBJINFO"         ; intrinsic.opcodes<-1> = OP.OBJINFO
   intrinsics<-1> = "OCONV"           ; intrinsic.opcodes<-1> = OP.OCONV
   intrinsics<-1> = "OCONVS"          ; intrinsic.opcodes<-1> = OP.OCONVS
   intrinsics<-1> = "OPEN.SOCKET"     ; intrinsic.opcodes<-1> = OP.OPENSKT
   intrinsics<-1> = "ORS"             ; intrinsic.opcodes<-1> = OP.ORS
   intrinsics<-1> = "OS.ERROR"        ; intrinsic.opcodes<-1> = OP.OSERROR
   intrinsics<-1> = "OUTERJOIN"       ; intrinsic.opcodes<-1> = OP.OJOIN
   intrinsics<-1> = "PRINTER.SETTING" ; intrinsic.opcodes<-1> = OP.PSET
   intrinsics<-1> = "PWR"             ; intrinsic.opcodes<-1> = OP.PWR
   intrinsics<-1> = "QUOTE"           ; intrinsic.opcodes<-1> = OP.QUOTE
   intrinsics<-1> = "RAISE"           ; intrinsic.opcodes<-1> = OP.RAISE
   intrinsics<-1> = "RDIV"            ; intrinsic.opcodes<-1> = OP.RDIV
   intrinsics<-1> = "READ.SOCKET"     ; intrinsic.opcodes<-1> = OP.READSKT
   intrinsics<-1> = "RECORDLOCKED"    ; intrinsic.opcodes<-1> = OP.RECLCKD
   intrinsics<-1> = "REM"             ; intrinsic.opcodes<-1> = OP.REM
   intrinsics<-1> = "REMOVE"          ; intrinsic.opcodes<-1> = OP.REMOVE
   intrinsics<-1> = "REPLACE"         ; intrinsic.opcodes<-1> = OP.REPLACE
   intrinsics<-1> = "REUSE"           ; intrinsic.opcodes<-1> = OP.REUSE
   intrinsics<-1> = "RND"             ; intrinsic.opcodes<-1> = OP.RND
   intrinsics<-1> = "RTRANS"          ; intrinsic.opcodes<-1> = OP.RTRANS
   intrinsics<-1> = "SAVE.SCREEN"     ; intrinsic.opcodes<-1> = OP.SAVESCRN
   intrinsics<-1> = "SELECTINFO"      ; intrinsic.opcodes<-1> = OP.SLCTINFO
   intrinsics<-1> = "SENTENCE"        ; intrinsic.opcodes<-1> = OP.NULL
   intrinsics<-1> = "SEQ"             ; intrinsic.opcodes<-1> = OP.SEQ
   intrinsics<-1> = "SERVER.ADDR"     ; intrinsic.opcodes<-1> = OP.SRVRADDR
   intrinsics<-1> = "SET.PORT.PARAMS" ; intrinsic.opcodes<-1> = OP.SETPORT
   intrinsics<-1> = "SET.SOCKET.MODE" ; intrinsic.opcodes<-1> = OP.SETSKT
   intrinsics<-1> = "SHIFT"           ; intrinsic.opcodes<-1> = OP.SHIFT
   intrinsics<-1> = "SIN"             ; intrinsic.opcodes<-1> = OP.SIN
   intrinsics<-1> = "SOCKET.INFO"     ; intrinsic.opcodes<-1> = OP.SKTINFO
   intrinsics<-1> = "SOUNDEX"         ; intrinsic.opcodes<-1> = OP.SOUNDEX
   intrinsics<-1> = "SOUNDEXS"        ; intrinsic.opcodes<-1> = OP.SOUNDEXS
   intrinsics<-1> = "SPACE"           ; intrinsic.opcodes<-1> = OP.SPACE
   intrinsics<-1> = "SPACES"          ; intrinsic.opcodes<-1> = OP.SPACES
   intrinsics<-1> = "SPLICE"          ; intrinsic.opcodes<-1> = OP.SPLICE
   intrinsics<-1> = "SQRT"            ; intrinsic.opcodes<-1> = OP.SQRT
   intrinsics<-1> = "SQUOTE"          ; intrinsic.opcodes<-1> = OP.SQUOTE
   intrinsics<-1> = "STATUS"          ; intrinsic.opcodes<-1> = OP.STATUS
   intrinsics<-1> = "STR"             ; intrinsic.opcodes<-1> = OP.STR
   intrinsics<-1> = "STRS"            ; intrinsic.opcodes<-1> = OP.STRS
   intrinsics<-1> = "SUBR"            ; intrinsic.opcodes<-1> = ''
   intrinsics<-1> = "SUBSTITUTE"      ; intrinsic.opcodes<-1> = OP.SUBST
   intrinsics<-1> = "SUBSTRINGS"      ; intrinsic.opcodes<-1> = OP.SUBSTRNG
   intrinsics<-1> = "SUM"             ; intrinsic.opcodes<-1> = OP.SUM
   intrinsics<-1> = "SUMMATION"       ; intrinsic.opcodes<-1> = OP.SUMMATION
   intrinsics<-1> = "SWAP"            ; intrinsic.opcodes<-1> = OP.CHANGE
   intrinsics<-1> = "SWAPCASE"        ; intrinsic.opcodes<-1> = OP.SWAPCASE
   intrinsics<-1> = "SYSMSG"          ; intrinsic.opcodes<-1> = OP.SYSMSG
   intrinsics<-1> = "SYSTEM"          ; intrinsic.opcodes<-1> = OP.SYSTEM
   intrinsics<-1> = "TAN"             ; intrinsic.opcodes<-1> = OP.TAN
   intrinsics<-1> = "TERMINFO"        ; intrinsic.opcodes<-1> = OP.TERMINFO
   intrinsics<-1> = "TIME"            ; intrinsic.opcodes<-1> = OP.TIME
   intrinsics<-1> = "TIMEDATE"        ; intrinsic.opcodes<-1> = OP.TIMEDATE
   intrinsics<-1> = "TRANS"           ; intrinsic.opcodes<-1> = OP.TRANS
   intrinsics<-1> = "TRIM"            ; intrinsic.opcodes<-1> = OP.TRIM
   intrinsics<-1> = "TRIMB"           ; intrinsic.opcodes<-1> = OP.TRIMB
   intrinsics<-1> = "TRIMBS"          ; intrinsic.opcodes<-1> = OP.TRIMBS
   intrinsics<-1> = "TRIMF"           ; intrinsic.opcodes<-1> = OP.TRIMF
   intrinsics<-1> = "TRIMFS"          ; intrinsic.opcodes<-1> = OP.TRIMFS
   intrinsics<-1> = "TRIMS"           ; intrinsic.opcodes<-1> = OP.TRIMS
   intrinsics<-1> = "TTYGET"          ; intrinsic.opcodes<-1> = OP.TTYGET
   intrinsics<-1> = "UMASK"           ; intrinsic.opcodes<-1> = OP.UMASK
   intrinsics<-1> = "UNASSIGNED"      ; intrinsic.opcodes<-1> = OP.UNASS
   intrinsics<-1> = "UPCASE"          ; intrinsic.opcodes<-1> = OP.UPCASE
   intrinsics<-1> = "VARTYPE"         ; intrinsic.opcodes<-1> = OP.VARTYPE
   intrinsics<-1> = "VSLICE"          ; intrinsic.opcodes<-1> = OP.VSLICE
   intrinsics<-1> = "WRITE.SOCKET"    ; intrinsic.opcodes<-1> = OP.WRITESKT
   intrinsics<-1> = "XLATE"           ; intrinsic.opcodes<-1> = OP.TRANS
   intrinsics<-1> = "XTD"             ; intrinsic.opcodes<-1> = OP.XTD


   intrinsic.stack = ""

   int.intrinsics = "ABORT.CAUSE"         ; int.intrinsic.opcodes = OP.ABTCAUSE
   int.intrinsics<-1> = "AKMAP"           ; int.intrinsic.opcodes<-1> = OP.AKMAP
   int.intrinsics<-1> = "ANALYSE"         ; int.intrinsic.opcodes<-1> = OP.ANALYSE
   int.intrinsics<-1> = "BREAK.COUNT"     ; int.intrinsic.opcodes<-1> = OP.BREAKCT
   int.intrinsics<-1> = "BTREE"           ; int.intrinsic.opcodes<-1> = OP.BTINIT
   int.intrinsics<-1> = "CHANGED"         ; int.intrinsic.opcodes<-1> = OP.CHANGED
   int.intrinsics<-1> = "DEBUG.INFO"      ; int.intrinsic.opcodes<-1> = OP.DBGINF
   int.intrinsics<-1> = "EVENTS"          ; int.intrinsic.opcodes<-1> = OP.EVENTS
   int.intrinsics<-1> = "EXPAND.HF"       ; int.intrinsic.opcodes<-1> = OP.EXPANDHF
   int.intrinsics<-1> = "FCONTROL"        ; int.intrinsic.opcodes<-1> = OP.FCONTROL
   int.intrinsics<-1> = "FIND"            ; int.intrinsic.opcodes<-1> = OP.BTFIND
   int.intrinsics<-1> = "FORMCSV"         ; int.intrinsic.opcodes<-1> = OP.FORMCSV
   int.intrinsics<-1> = "GETLOCKS"        ; int.intrinsic.opcodes<-1> = OP.GETLOCKS
   int.intrinsics<-1> = "GRPSTAT"         ; int.intrinsic.opcodes<-1> = OP.GRPSTAT
   int.intrinsics<-1> = "IS.SUBR"         ; int.intrinsic.opcodes<-1> = OP.ISSUBR
   int.intrinsics<-1> = "ISMV"            ; int.intrinsic.opcodes<-1> = OP.ISMV
   int.intrinsics<-1> = "KERNEL"          ; int.intrinsic.opcodes<-1> = OP.KERNEL
   int.intrinsics<-1> = "LIST.COMMON"     ; int.intrinsic.opcodes<-1> = OP.LISTCOM
   int.intrinsics<-1> = "LOAD.OBJECT"     ; int.intrinsic.opcodes<-1> = OP.LOADOBJ
   int.intrinsics<-1> = "LOADED"          ; int.intrinsic.opcodes<-1> = OP.LOADED
   int.intrinsics<-1> = "LOGIN"           ; int.intrinsic.opcodes<-1> = OP.LOGIN
   int.intrinsics<-1> = "LOGIN.PORT"      ; int.intrinsic.opcodes<-1> = OP.LGNPORT
   int.intrinsics<-1> = "LOGOUT"          ; int.intrinsic.opcodes<-1> = OP.LOGOUT
   int.intrinsics<-1> = "OPTION"          ; int.intrinsic.opcodes<-1> = OP.OPTION
   int.intrinsics<-1> = "OSPATH"          ; int.intrinsic.opcodes<-1> = OP.OSPATH
   int.intrinsics<-1> = "OSRENAME"        ; int.intrinsic.opcodes<-1> = OP.OSRENAME
   int.intrinsics<-1> = "PACKAGE"         ; int.intrinsic.opcodes<-1> = OP.PACKAGE
   int.intrinsics<-1> = "PCONFIG"         ; int.intrinsic.opcodes<-1> = OP.PCONFIG
   int.intrinsics<-1> = "PHANTOM"         ; int.intrinsic.opcodes<-1> = OP.PHANTOM
   int.intrinsics<-1> = "PROMPT"          ; int.intrinsic.opcodes<-1> = OP.GETPROMPT
   int.intrinsics<-1> = "PTERM"           ; int.intrinsic.opcodes<-1> = OP.PTERM
   int.intrinsics<-1> = "PWCRYPT"         ; int.intrinsic.opcodes<-1> = OP.PWCRYPT
   int.intrinsics<-1> = "READPKT"         ; int.intrinsic.opcodes<-1> = OP.READPKT
   int.intrinsics<-1> = "REMOVEF"         ; int.intrinsic.opcodes<-1> = OP.RMVF
   int.intrinsics<-1> = "SCAN"            ; int.intrinsic.opcodes<-1> = OP.BTSCAN
   int.intrinsics<-1> = "SORTDATA"        ; int.intrinsic.opcodes<-1> = OP.SORTDATA
   int.intrinsics<-1> = "SORTNEXT"        ; int.intrinsic.opcodes<-1> = OP.SORTNEXT
   int.intrinsics<-1> = "TESTLOCK"        ; int.intrinsic.opcodes<-1> = OP.TESTLOCK


   file.refs = ''     ;* Files referenced in the FILE statement (uppercase)...
   dim file.d(5)      ;* ...and dictionary file variables...
   file.fields = ''   ;* ...cached field names (case as written)...
   file.fld.nums = '' ;* ...and field numbers

   dim line.no(max.levels)
   dim listing(max.levels)
   dim include.record(max.levels)

*****************************************************************************

   level = 1
   include.record(1) = prog.source

   header.flags = 0                  ;* Option flags  (0201 moved)

   listing.used = @false
   catalogue.name = ''     ;* Set to '~' to take default name
   catalogue.mode = ''
   mode = 0
   warnings.as.errors = @false

   * Release 2.1-10 introduced the STORSYS opcode so that CLEAR did not
   * wipe out CALL indirection variables for direct calls. Because this is
   * not backwards compatible, only use STORSYS if CLEAR is used in the
   * program. Otherwise, stay with the old STOR.

   clear.used = @false

   debug = bitand(compiler.flags, BCOMP.DEBUG)
   emit.xref.tables = not(bitand(compiler.flags, BCOMP.NO.XREF.TABLES))
   list.xref = bitand(compiler.flags, BCOMP.LIST.XREF)
   listing.option = bitand(compiler.flags, BCOMP.LISTING)

   * Defined token table
   * Data part of element is:
   *    string : 0ssssss
   *    number : 1nnnnnn
   *    matref : 2name index1 index2
   *    char(n): 3n
   *    var    : 4name
   *    @var   : 5name (excluding @ character)
   btree.keys(1) = 0
   defined.tokens = btree(1, btree.keys)

   * Add standard tokens for environment
   add "QM", "10" to defined.tokens    ;* QM = integer 0
   add 'QM.':upcase(system(1010)), "10" to defined.tokens


   * Check for $BASIC.OPTIONS record, first in source file, then in VOC

   read voc.rec from src.f, "$BASIC.OPTIONS" else
      read voc.rec from @voc, "$BASIC.OPTIONS" else null
   end

   if upcase(voc.rec[1,1]) = 'X' then
      voc.rec = trim(voc.rec)
      loop
         del voc.rec<1>
      while len(voc.rec)
         s = upcase(field(voc.rec<1>, ' ', 1))
         begin case
            case s = "CATALOGUE" or s = "CATALOG"
               catalogue.name = '~'
               s = upcase(field(voc.rec<1>, ' ', 2))
               begin case
                  case s = 'LOCAL'  ; catalogue.mode = 'LOCAL'
                  case s = 'GLOBAL' ; catalogue.mode = 'GLOBAL'
               end case

            case s = 'DEFINE'
               define.token = field(voc.rec<1>, ' ', 2)
               if not(bittest(mode, M.CASE.SENSITIVE)) then define.token = upcase(define.token)

               s = field(voc.rec<1>, ' ', 3, 99)  ;* 0200
               c = s[1,1]
               if alpha(define.token[1,1]) and convert(name.chars, '', define.token) = '' then
                 begin case
                    case s = ''
                       n = 0
                    case num(s)
                       n = 1
                    case len(s) >= 2 and (c = '"' or c = "'" or c = '\') and s[1] = c and count(s, c) = 2
                       n = 0
                    case 1
                       display sysmsg(2813, define.token) ;* Invalid token value for xx in $BASIC.OPTIONS
                 end case
                 i = find(defined.tokens, define.token)
                 if status() then add define.token, n : s to defined.tokens
                 else display sysmsg(2814, define.token) ;* Duplicate token xx in $BASIC.OPTIONS
               end else
                  display sysmsg(2815, define.token) ;* Invalid token name xx in $BASIC.OPTIONS
               end

            case s = "DEBUGGING"
               debug = @true

            case s = "LISTING"
               listing.option = @true

            case s = "MODE"
               s = upcase(field(voc.rec<1>, ' ', 2))
               if s # '' then
                  locate s in mode.names<1,1> setting i then
                     mode = bitset(mode, i - 1)
                     gosub set.kernel.modes
                  end
               end

            case s = "NO.CATALOGUE" or s = "NO.CATALOG"
               catalogue.name = ''

            case s = "NOCASE.STRINGS"
               header.flags = bitor(header.flags, HDR.NOCASE)

            case s = "NOXREF"
               emit.xref.tables = @false

            case s = "WARNINGS.AS.ERRORS"
               warnings.as.errors = @true

            case s = "XREF"
               listing.option = @true
               list.xref = @true
         end case
      repeat
   end

   last.debug.line = -1
   errors = 0
   if is.ctype then header.flags = bitor(header.flags, HDR.CTYPE + HDR.ITYPE)
   gosub set.kernel.modes

   eof = @false
   line.no(1) = 0
   listing(0) = @true       ; listing(1) = listing.option
   if listing.option then gosub start.listing


   * Compiler control

   name.set = @false                  ;* Not seen PROGRAM or SUBROUTINE
   print.code = @false                ;* Expanded listing control
   star.printed = @false
   emit.symbol.table = emit.xref.tables
   emit.line.table = emit.xref.tables
   recursive = 0
   greatest.call.arg.count = 0
   final.end.seen = @false
   lsub.var.no = -1
   is.local.function = @false

   object.state = 0    ;* 0 = Not an object
                        * 1 = Is object. First Get/Set/Public still to be found
                        * 2 = Is object but not in property/method routine
                        * 3 = In Get routine / public function
                        * 4 = In Set routine / public subroutine
                        * 5 = In public function
                        * 6 = In public subroutine
   object.arg.names = ''    ;* Names of arguments to current object routine
   inherited.classes = ''

   skip.depth = 0         ;* Number of nested $ifdefs for which we are skipping
   skip.stack = ''
         * Value 1 = action : 0 = processing first statement group
         *                    1 = skipping first statement group
         *                    2 = processing $ELSE statement group
         *                    3 = skipping $ELSE statement group
         * Value 2 = line number of $IFDEF
         * Value 3 = level


   format.allowed.stack = ''

   * Object header information

   program.name = upcase(record.name[1,HDR.PROGRAM.NAME.LEN])
   subr.arg.count = 0                ;* Subroutine arguments
   var.count = 0                     ;* Number of local variables
   symbol.table.offset = 0           ;* Symbol table position
   line.table.offset = 0             ;* Line table position
   internal = @false

   * Expression processing

   op.stack.depth = 0
   unary.minus = @false

   * Symbol table (local variables and common block entries)

   btree.keys(1) = 0

   symbols = ''         ;* Names
   symbol.info = ''     ;* V1 : Local variable number
                         *      -ve for matrix until first referenced
                         * V2 : Common offset (-ve if local)
                         * V3 : Dimensions (0, 1 or 2. -1 if not known)
                         * V4 = Value index into COMMONS for common variable
   symbol.refs = ''     ;* Associated keys to various routines...
      $define SYM.CHK 0 ;* Just checking, don't record reference (must be 0)
      $define SYM.SET 1 ;* V1 : Line set
      $define SYM.USE 2 ;* V2 : Line used
      $define SYM.ARG 3 ;* V3 : Line used as subroutine argument
      $define SYM.DIM 4 ;* V4 : Line dimensioned
   symbol.mode = SYM.USE

   * Unless we are doing XREF, we have no need to track every line number
   * for each of the above uses. The symsv variable is used in dynamic array
   * references to either append a line number or replace a line number
   * depending on the state of the list.xref flag. By doing this, the
   * dynmamic array remains more compact on non-xref compilations.

   symsv = if list.xref then -1 else 1

   symbol.table = ""   ;* Ordered version for emission to object code
   matrix.stack = ''   ;* 0181 Used to handle nested array references

   * Common block table (block names and sizes)

   commons = ""                   ;* F1 = Names (Blank common is //)
                                   * F2 = Local variable number for common
                                   * F3 = Current size
                                   * F4 = Element names (subvalued)
                                   * F5 = Matrix rows (zero if scalar)
                                   * F6 = Matrix cols (zero if not 2 dims)
                                   * F7 = Pick matrix local var no, else null
                                   * F8 = VARSET arg? (true/null)
                                   * F9 = Leave uninitialised? (true/null)

   * VARSET names

   varsets = ''                   ;* F1 = Names
                                   * F2 = Local variable number for "common"
                                   * F3 = Argument number if is argument

   * Function table

   functions = ''                  ;* F1 = function name
                                    * F2 = call name, null for local function
                                    * F3 = arg types (S or M, scalar/matrix)
                                    * F4 = function key
                                    * F5 = var args?
   func.stack = ''                 ;* V1 = index to functions, V2 = arg no

   * Object name map

   object.name.map = ''            ;* F1 = names
                                    * F2 = attributes
                                    *      S1 = public var no (null if none)
                                    *      S2 = set routine key (null if none)
                                    *      S3 = get routine key (null if none)
                                    *      S4 = set argument count
                                    *      S5 = get argument count

   object.keys = 0

   * Internal subroutine tables

   int.subs = ''                   ;* Names, FM separated...
   int.sub.args = ''               ;* ...arg types (S or M, scalar/matrix)...
   int.sub.is.lsub = ''            ;* ...Seen as local subroutine/function?

   * Direct call table

   direct.calls = ""               ;* Subroutine names and...
   direct.call.vars = ""           ;* ...local variable number

   * Embedded object code for C-types

   embedded.objects = ''           ;* Names of dictionary items and...
   embedded.object.vars = ''       ;* ...corresponding local variable number

   * Label table and jump opcode control data
   * The label.refs data is only collected if we are using the list.xref option

   btree.keys(1) = BT.DATA
   label.tree = btree(1, btree.keys)

   label.refs = ''                  ;* F1 = name
                                     * F2 = mv reference line
                                     * F3 = declaration line

   jump.no = 0          ;* Next available jump number
   jump.stack = ""      ;* Nested construct stack
                        * V1 : Type  (must not use zero - see st.while)
$define J.LOOP                 1  ;* LOOP / REPEAT
$define J.FOR                  2  ;* FOR / NEXT
$define J.BACK.END             3  ;* ON ERROR / LOCKED / THEN / ELSE
$define J.CASE                 4  ;* CASE
$define J.IF                   5  ;* IF / THEN / ELSE
$define J.IF.EXPR              6  ;* IF / THEN / ELSE in expression
$define J.TXN                  7  ;* TRANSACTION
                        * V2 : Jump number
                        * V3 : Element number for CASE

   * Code generation control

   code.size = 64000
   code.image = str(char(0), code.size) ;* Final code image (char 1 = pc 0)
   pc = 0                            ;* PC of next byte to emit

   onerror.stack = ""
   testlock.stack = ""
   thenelse.stack = ""
   arg.count.stack = ""
   for.var = ""
   lock.opcode = 0

   xref = ""              ;* Cross-reference table information
   statement.start.pc = 0
   xref.line = 1

*****************************************************************************

   * Emit skeleton object header

   gosub emit.skeleton.header

* Process source to end of file

   end.source = @false

   gosub get.line              ;* Get first source line

   loop
   until end.source
      gosub proc.line
   repeat

   * Emit a STOP or RETURN opcode to kill the program
   * If we are in a local subroutine, we do a stop as this really is a bug.
   * In other cases, QM has always emitted a return.

   opcode.byte = if lsub.var.no >= 0 then OP.STOP else OP.RETURN
   gosub emit.simple

   * Check that final END was found

   if not(final.end.seen) and not(is.ctype) then
      if not(bittest(mode, M.OPTIONAL.FINAL.END)) then
         err.msg = sysmsg(2816)  ;* Final END statement is missing
         gosub warning
      end
   end

   * If this class has an inheritance list on the CLASS statement and
   * there is no CREATE.OBJECT method, create one that simply binds
   * the inherited objects.

   if inherited.classes # '' then
      locate 'CREATE.OBJECT' in object.name.map<1,1> setting obj.pos else
         object.name.map<1,obj.pos> = 'CREATE.OBJECT'
         object.keys += 1
         object.name.map<2,obj.pos,2> = object.keys
         object.name.map<2,obj.pos,4> = 0        ;* Argument count

         label.name = '*':object.keys ; gosub set.label
         gosub emit.inheritance
         opcode.byte = OP.RETURN ; gosub emit.simple
      end
   end

   * Append the final byte count to the cross-reference table

   n = pc - statement.start.pc
   if n < 255 then xref := char(n)
   else xref := char(255) : char(shift(n, 8)) : char(bitand(n, 255))

   * Check for unclosed constructs

   if jump.stack # "" then
      n = jump.stack<1,1>

      begin case
         case n = J.IF
            err.msg = sysmsg(2817)  ;* Unterminated IF statement

         case n = J.LOOP
            err.msg = sysmsg(2818)  ;* Unterminated LOOP statement

         case n = J.BACK.END
            err.msg = sysmsg(2819)  ;* Unterminated ON ERROR, LOCKED, THEN or ELSE clause

         case n = J.CASE
            err.msg = sysmsg(2820)  ;* Unterminated CASE statement

         case n = J.FOR
            err.msg = sysmsg(2821)  ;* Unterminated FOR statement

         case n = J.IF.EXPR
            err.msg = sysmsg(2822)  ;* Unterminated IF clause in expression

         case n = J.TXn
            err.msg = sysmsg(2823)  ;* Unterminated TRANSACTION statement
      end case
      gosub error
   end

   * Check for undimensioned matrices

   n = dcount(symbols, @fm)
   for i = 1 to n
      if symbol.info<i,3> < 0 then
         err.msg = sysmsg(3428, symbols<i>) ;* Matrix %1 is not referenced in a DIM statement
         gosub error
      end
   next i

   * Check for undefined labels

   rewind label.tree
   loop
      s = scan(label.tree, btree.keys)
   until status()
      if s < 0 then       ;* Undefined label
         s = btree.keys(1)
         if s[1,1] # "_" or internal then
            err.msg = sysmsg(2824, s) ;* Label xx referenced but not defined
            gosub error
         end
         else if not(errors) then errors = 1 ;* Ensure error set
      end
   repeat


   * Ensure we have enough space for prelude stuff

   if pc > code.size - 2000 then    ;* Getting too close for comfort
      code.size += 32000
      code.image := str(char(0), 32000)
   end

   * Emit prelude if program has:
   *   common block references
   *   direct calls

   new.start.pc = 0

   * ---------- Bind common blocks
   * The unnamed common has a name(!) of $.

   num.commons = dcount(commons<1>, @vm)
   for common.index = 1 to num.commons
      if commons<8,common.index> then continue  ;* VARSET argument
      if new.start.pc = 0 then new.start.pc = pc

      common.name = commons<1,common.index>
      if common.name[1] = ':' then continue ;* Not really a common at all...
                                            ;* ...it's a local variable pool

      symbol.var.no = commons<2,common.index>

      * Emit COMMON opcode

      if print.code then
         s = 'COMMON   ' : symbol.var.no : ', /' : common.name : '/, '
         s := commons<3,common.index>
         gosub show.code
      end
         
      opcode.byte = OP.COMMON ; gosub emit

      code.value = symbol.var.no     ;* Local variable number
      code.bytes = 2
      gosub emit.multibyte.value

      code.value = commons<3,common.index>    ;* Size
      code.bytes = 2
      gosub emit.multibyte.value

      opcode.byte = len(common.name) ;* Block name length
      * Do we need to set "uninitialised common" flag?
      if commons<9,common.index> then opcode.byte = bitor(opcode.byte, 0x80)
      gosub emit

      n = len(common.name)
      if (n > 0) then
         code.image[pc+1, n] = common.name
         pc += n
      end

      * Emit skip address for jump round dimcoms

      label.name = '_COM':common.index
      gosub emit.addr

      * Dimension common matrices

      num.com.var = dcount(commons<4, common.index>, @sm)
      for common.var.idx = 1 to num.com.var
         if commons<5, common.index, common.var.idx> > 0 then
            * Is it a Pick style matrix? If so, omit DIMCOM

            if commons<7, common.index, common.var.idx> then continue

            symbol.name = commons<4, common.index, common.var.idx>
            symbol.mode = SYM.CHK
            gosub find.var
            gosub emit.var.load

            n = commons<5, common.index, common.var.idx> + 0  ;* Rows
            gosub emit.numeric.load

            n = commons<6, common.index, common.var.idx> + 0  ;* Cols
            gosub emit.numeric.load

            opcode.byte = OP.DIMCOM  ; gosub emit.simple
         end
      next common.var.idx

      * Emit skip label for BINDCOM

      label.name = '_COM':common.index
      gosub set.label

      * Emit PMATRIX for Pick style matrices

      for common.var.idx = 1 to num.com.var
         if commons<5, common.index, common.var.idx> = 0 then continue

         * Is it a Pick style matrix?

         if not(commons<7, common.index, common.var.idx>) then continue

         opcode.byte = OP.PMATRIX ; gosub emit.simple

         * Local var number of PMATRIX item
         code.value = commons<7, common.index, common.var.idx>
         code.bytes = 2
         gosub emit.multibyte.value

         * Local var number of common block
         code.value = commons<2, common.index>
         code.bytes = 2
         gosub emit.multibyte.value

         * Offset into common of first matrix element
         code.value = common.var.idx
         code.bytes = 2
         gosub emit.multibyte.value

         * Row count
         code.value = commons<5, common.index, common.var.idx>
         code.bytes = 2
         gosub emit.multibyte.value

         * Column count (zero if single dimensional)
         code.value = commons<6, common.index, common.var.idx>
         code.bytes = 2
         gosub emit.multibyte.value
      next common.var.idx
   next common.index


   * ---------- Set up links for direct calls

   if len(direct.calls) then
      * Generate local variable initialisation for direct calls
      * For each direct called subroutine, generate 
      *           LDLCL  var
      *           LDSTR  name
      *           STOR

      if new.start.pc = 0 then new.start.pc = pc

      symbol.common.offset = -1      ;* Local variables

      loop
         remove symbol.var.no from direct.call.vars setting i
         remove opcode.string from direct.calls setting i

         if print.code then symbol.name = "_" : opcode.string
         gosub emit.var.load

         gosub emit.string.load

         opcode.byte = if clear.used then OP.STORSYS else OP.STOR
         gosub emit.simple
      while i
      repeat
      setrem 0 on direct.call.vars
      setrem 0 on direct.calls
   end

   * ---------- Set up loads for embedded object code

   if len(embedded.objects) then
      * For each direct called subroutine, generate 
      *           LDLCL  var
      *           LDSTR  object code
      *           STOR

      if new.start.pc = 0 then new.start.pc = pc

      symbol.common.offset = -1      ;* Local variables

      loop
         remove symbol.var.no from embedded.object.vars setting more.object
         remove s from embedded.objects setting more.object

         read dict.rec from dict.f, s then
            if print.code then symbol.name = "~" : s
            gosub emit.var.load

            opcode.string = field(dict.rec, @fm, DICT.ITYPE.OBJECT)
            gosub emit.string.load

            opcode.byte = if clear.used then OP.STORSYS else OP.STOR
            gosub emit.simple
         end else
            err.msg = sysmsg(3400, s) ;* Unable to load embedded object code for %1
            gosub error
         end

      while more.object
      repeat

      setrem 0 on embedded.object.vars
      setrem 0 on embedded.objects
   end

   if object.state then
      * Emit code to set up the name map. This is conditioned by the key
      * argument being zero. For a non-zero key, we skip past the map creation.

      n = 34 ; gosub emit.numeric.load
      n = 0 ; gosub emit.numeric.load
      opcode.byte = OP.KERNEL ; gosub emit.simple
      opcode.byte = OP.DUP ; gosub emit.simple
      opcode.byte = OP.JNZ ; label.name = '_KEYSPLIT' ; gosub emit.jump
      opcode.byte = OP.POP ; gosub emit.simple

      * Construct memory images of the property and method maps

      name.map = ''

      * Property map

      n = dcount(object.name.map<1>, @vm)
      for i = 1 to n
        s = object.name.map<1,i>
        z = object.name.map<2,i>
        
        name.map := char(if i # n then len(s) + 10 else 0) ;* Offset to next entry
        name.map := iconv(z<1,1,1> + 0, 'ISL') ;* Public variable number
        name.map := iconv(z<1,1,2> + 0, 'ISL') ;* Set routine key
        name.map := iconv(z<1,1,3> + 0, 'ISL') ;* Get routine key
        name.map := char(z<1,1,4>)             ;* Set arg count
        name.map := char(z<1,1,5>)             ;* Get arg count
        name.map := s:char(0)                  ;* Name
      next i

      opcode.byte = OP.OBJMAP ; gosub emit.simple
      code.value = len(name.map) ; code.bytes = 2 ; gosub emit.multibyte.value
      n = len(name.map)
      code.image[pc+1, n] = name.map
      pc += n

      * If there is a CREATE.OBJECT method defined, emit code to alter
      * the key value to link to that method. Otherwise, emit a RETURN.

      locate 'CREATE.OBJECT' in object.name.map<1,1> setting pos then
         if not(object.name.map<2,pos,2>) then
            err.msg = sysmsg(3452) ;* CREATE.OBJECT must be a PUBLIC SUBROUTINE
            gosub error
         end

         n = object.name.map<2,pos,2> ; gosub emit.numeric.load
      end else
         opcode.byte = OP.RETURN ; gosub emit.simple
      end
   end

   * For an object program, emit the ON GOTO split for the key value

   if object.state then
      label.name = '_KEYSPLIT' ; gosub set.label
      opcode.byte = OP.ONGOTO ; gosub emit.simple
      opcode.byte = object.keys ; gosub emit
      for i = 1 to object.keys
         label.name = '*':i ; gosub emit.addr
      next i
   end

   if new.start.pc then
      * Generate a jump to the original entry point of the program and then
      * replace the header start address by the address of the code just
      * emitted.

      opcode.byte = OP.JMP
      if print.code then
         * Show the code to be generated
         s = fmt(opcodes<1,opcode.byte + 1>, "9L"):oconv(start.pc, "MX")
         gosub show.code
      end
      gosub emit
      code.value = start.pc
      code.bytes = 3
      gosub emit.multibyte.value

      start.pc = new.start.pc
   end


   if list.xref then
      * Emit variable name cross reference table

      width = @crtwide - 1
      n = dcount(symbols, @fm)
      list.rec = ''
      gosub emit.listing
      list.rec = '===== VARIABLES ====='
      gosub emit.listing

      for i = 1 to n
         * Emit type
         z = symbol.info<i>
         if z<1,2> >= 0 then
            if symbol.refs<i> = '' then continue   ;* Ignore unreferenced common
            s = if commons<1,z<1,4>>[1,1] = '~' then 'Str ' else 'Com '
         end else
            s = ''
         end
         if z<1,3> then s := 'Mat'
         list.rec = fmt(s, '8L')

         * Emit symbol name
         s = symbols<i>
         c = s[1,1]
         if c = '_' then continue    ;* Ignore internal symbols
         if c = '~' then continue    ;* Ignore internal symbols
         list.rec := s : ' '

         * Work out placement of first reference
         k = len(s) + 9         ;* Chars output so far: 1 + (8 for type, symbol)
         if k < 24 then
            list.rec := space(24 - k)
            k = 24
         end else
            z = 7 - rem(k-1,8)
            list.rec := space(z)
            k += z
         end

         * Merge reference data

         ref.list = ''
         for j = 1 to 4
            z = symbol.refs<i,j>
            if z # '' then
               loop
                  s = remove(z,delim):('s ad'[j,1])
                  locate s in ref.list<1> by 'AR' setting pos else
                     ins s before ref.list<pos>
                  end
               while delim
               repeat
            end
         next j

         * Emit merged list

         if ref.list # '' then
            z = 0
            loop
               if k >= width then
                  gosub emit.listing
                  list.rec = space(24)
                  k = 24
                  z = 0
               end

               if z then list.rec := space(z)
               s = remove(ref.list, delim)
               list.rec := s
               z = 8 - len(s)    ;* Spaces to be emitted before next item
               k += 8
            while delim
            repeat
            setrem 0 on ref.list
         end
         gosub emit.listing
      next i

      * Emit label name cross reference table

      width = @crtwide - 1
      n = dcount(label.refs<1>, @vm)
      if n then
         list.rec = ''
         gosub emit.listing
         list.rec = '===== LABELS ====='
         gosub emit.listing

         w = min(maximum(lens(label.refs<1>)), 22)  ;* Longest name (limited)
         for i = 1 to n
            * Emit symbol name
            s = label.refs<1,i>
            if len(s) > 22 then
               list.rec = label.refs<1,i>
               gosub emit.listing
               list.rec = space(23)
            end else
               list.rec = fmt(label.refs<1,i>, (w+1):'L')
            end

            * Add declaration line number
            list.rec := fmt(label.refs<3,i>, '5R'):'s'

            * Add reference line numbers
            s = label.refs<2,i>
            if s # '' then
               loop
                  list.rec := '  ' : fmt(remove(s, more), '5R')
               while more
                  if len(list.rec) + 7 > width then
                     gosub emit.listing
                     list.rec = space(w+2+5)
                  end
               repeat
            end

            gosub emit.listing
         next i
      end
   end

   * Check for unset / unreferenced variables

   n = dcount(symbols, @fm)
   for i = 1 to n
      if symbol.info<i,2> >= 0 then continue        ;* Ignore common
      if symbol.refs<i,SYM.ARG> # '' then continue  ;* Used as argument
      s = symbols<i>
      c = s[1,1]
      if c = '_' then continue    ;* Ignore internal symbols
      if c = '~' then continue    ;* Ignore internal symbols

      if symbol.refs<i,SYM.SET> = '' then
         if symbol.info<i,3> and symbol.refs<i,SYM.USE> = '' then
            err.msg = sysmsg(2988, s) ;* Matrix %1 is not referenced
            gosub warning
         end else
            err.msg = sysmsg(2825, s) ;* %1 is not assigned a value
            gosub warning
         end
      end else if symbol.refs<i,SYM.USE> = '' then
         if internal or bittest(mode, M.TRAP.UNUSED) then
            err.msg = sysmsg(2826, s) ;* %1 is assigned a value but never used
            gosub warning
         end
      end
   next i

   * Check that all internal subroutines with arguments have been
   * found as local subroutines/functions

   n = dcount(int.subs, @fm)
   for i = 1 to n
      if int.sub.args<i> # '' and not(int.sub.is.lsub<i>) then
         err.msg = sysmsg(3427, int.subs<i>) ;* Arguments supplied in GOSUB to internal subroutine %1
         gosub error
      end
   next i

   if star.printed then
      display
      star.printed = @false
   end

   * Resolve default name for automatic cataloguing

   if catalogue.name = '~' then
      catalogue.name = record.name
      if upcase(catalogue.name) # upcase(program.name) then
         err.msg = sysmsg(2941)  ;* Default catalogue name differs from record name
         gosub error
      end
   end

   if not(is.ctype) then display sysmsg(2995, errors)    ;* %1 error(s)

   if not(errors) then
      * Emit the cross-reference (line) table

      if emit.line.table then
         if pc + len(xref) >= code.size then
            code.size += len(xref)
            code.image := str(char(0), len(xref))
         end

         line.table.offset = pc
         code.image[pc+1,len(xref)] = xref
         pc += len(xref)
      end

      * Emit the symbol table with value marks between items
      * nameVMnameVMname...FMnVMnameSMname...FMnVMnameSMname...NULL
      * <--local vars-->   <----Common--->   <----Common--->   End

      if emit.symbol.table then
         if symbol.table # "" then
            symbol.table.offset = pc

            loop
               remove s from symbol.table setting i
               s := @vm

               if pc + len(s) >= code.size then
                  code.size += len(s)
                  code.image := str(char(0), len(s))
               end

               code.image[pc+1,len(s)] = s
               pc += len(s)
            while i
            repeat

            setrem 0 on symbol.table
         end

         * Emit information for common blocks
         * @fm localvarno @vm name @sm name @sm name...

         common.index = 1
         loop
            n = commons<2,common.index>  ;* Local variable number
         while len(n)
            opcode.string = @fm : n : @vm : commons<4,common.index>

            if pc + len(opcode.string) >= code.size then
               code.size += len(opcode.string)
               code.image := str(char(0), len(opcode.string))
            end

            code.image[pc+1, len(opcode.string)] = opcode.string
            pc += len(opcode.string)
            common.index += 1
         repeat

         * Emit a zero byte to terminate the table

         code.image[pc+1,1] = char(0)
         pc += 1
      end

      * Go back and fill in the object header

      if debug then header.flags = bitor(header.flags, hdr.debug)
      gosub emit.final.header

      * Write the object file

      object.code = code.image[1,pc]

      * Dump the object code for a recursive

      begin case
         case recursive = 1  ;* Pcode file recursive
            * Delete entry from composite library if it exists
            openpath @qmsys:@ds:'bin' to bin.f then
               mark.mapping bin.f, off
               readu pcode from bin.f, 'pcode' then
                  if not(bitand(compiler.flags, BCOMP.RECURSIVE.BACKUP)) then
                     * This is the first (successful) recursive compilation
                     * in this run of the compiler. Make a backup copy of
                     * the existing pcode library.
                     write pcode to bin.f, 'pcode.old'
                  end
               end

               i = 0
               loop
                  s = field(pcode[i+HDR.PROGRAM.NAME, 999], char(0), 1)
                  j = bitand(oconv(pcode[i+HDR.OBJECT.SIZE, 4], 'IL') + 3, bitnot(3))

                  if s = program.name then ;* Found it
                     pcode = pcode[1,i] : pcode[i+j+1,999999]
                     exit
                  end

                  i += j
               while i < len(pcode)
               repeat

               * Now add the new entry on the end of the library file
               * We round the length to a multiple of 4 bytes to ensure
               * word alignment.

               pcode := code.image[1, bitand(pc + 3, bitnot(3))]

               write pcode to bin.f, 'pcode'
               close bin.f
            end
            compiler.flags = bitor(compiler.flags, BCOMP.RECURSIVE.BACKUP)

      end case

      i = events(-1, EVT$UNLOAD)
   end

   if listing.used and not(is.ctype) then closeseq list.f

   return

*****************************************************************************
* Get new source line and parse into TOKENS and TOKEN.STRINGS arrays

get.line:
   loop        ;* Until we have a non-blank line to process
      num.tokens = 0
      loop     ;* Until no further continuation lines
         src = trimb(removef(include.record(level), 1))
         eof = status() # 0

         * Remove trailing CR for cross-platform compatibility.

         if src[1] = char(13) then src = src[1,len(src)-1]

         * Check for continuation line marker

         continues.on.next.line = (src[1] = '~')

         if eof then   ;* End of source record - can backtrack a level
            * Ensure we are not in a $IFDEF construct
            loop
            while len(skip.stack)
            while skip.stack<1,3> = level
               err.msg = sysmsg(2827, skip.stack<1,2>) ;* Unterminated conditional compilation construct starting on line xx
               gosub error
               del skip.stack<1>
            repeat

            if level > 1 then
               include.record(level) = ''
               level -= 1
               eof = @false
               exit    ;* From continuation line loop
            end

            end.source = @true
            tokens(1) = TKN.END
            token.strings(1) = ""        ;* Needed for empty source file
         end else    ;* Not at end of source record
            line.no(level) += 1

            if listing(level) or print.code then
               if level > 1 then list.rec = fmt(level : "." : line.no(level), "7R")
               else list.rec = fmt(line.no(level), "7R")
               if skip.depth then list.rec := "* " : src
               else list.rec :=  "  " : src
               gosub emit.listing
            end

            if continues.on.next.line then src = src[1,len(src)-1]

            if not(rem(line.no(level), 10)) then
               if not(is.ctype) then
                  display "*":
                  star.printed = @true
               end
            end

            * Check for preprocessor directives ($IFDEF, $IFNDEF, $ELSE, $ENDIF)

            ss = field(trim(src), ' ', 1)
            c = ss[1,1]
            if c = '$' or c = '#' then
               ss = upcase(ss[2,99999])
               begin case
                  case ss ='IFDEF'
                     token.name = field(trim(src), ' ', 2)
                     if not(bittest(mode, M.CASE.SENSITIVE)) then token.name = upcase(token.name)
                     ss = find(defined.tokens, token.name)

                     n = (status() # 0)
                     * Set field 1 of the skip stack to show what we are doing.
                     * Value 1 = action : 0 = processing first statement group
                     *               or : 1 = skipping first statement group
                     * Value 2 = line number of $IFDEF
                     * Value 3 = level
                     ins n : @vm : line.no(level) : @vm : level before skip.stack<1>
                     skip.depth += n
                     exit    ;* From continuation line loop

                  case ss ='IFNDEF'
                     token.name = field(trim(src), ' ', 2)
                     if not(bittest(mode, M.CASE.SENSITIVE)) then token.name = upcase(token.name)
                     ss = find(defined.tokens, token.name)
                     n = (status() = 0)
   
                     * Set field 1 of the skip stack to show what we are doing.
                     * Value 1 = action : 0 = processing first statement group
                     *               or : 1 = skipping first statement group
                     * Value 2 = line number of $IFDEF
                     * Value 3 = level
                     ins n : @vm : line.no(level) : @vm : level before skip.stack<1>
                     skip.depth += n
                     exit    ;* From continuation line loop

                  case ss ='ELSE'
                     if len(skip.stack) = 0 then
                        err.msg = sysmsg(2828) ;* $ELSE without $IFDEF or $IFNDEF
                        gosub error
                     end else
                        n = skip.stack<1,1> + 0
                        begin case
                           case n = 0              ;* Processing first statement group...
                              skip.stack<1,1> = 3  ;* ...skip $ELSE statement group
                              skip.depth += 1
         
                           case n = 1              ;* Skipping first statement group...
                              skip.stack<1,1> = 2  ;* ...process $ELSE statement group
                              skip.depth -= 1
         
                           case 1
                              err.msg = sysmsg(2829, skip.stack<1,2>) ;* $ELSE already seen for conditional compilation starting on line 
                              gosub error
                        end case
                     end
                     exit    ;* From continuation line loop

                  case ss ='ENDIF'
                     if len(skip.stack) = 0 then
                        err.msg = sysmsg(2830) ;* $ENDIF without $IFDEF or $IFNDEF
                        gosub error
                     end else
                        if len(skip.stack) then
                           n = skip.stack<1,1> + 0
                           if n = 1 or n = 3 then skip.depth -= 1
                        end
                        del skip.stack<1>
                     end
                     exit    ;* From continuation line loop
               end case
            end

            if skip.depth then
               look.ahead.token = ''
            end else
               * Parse statement into tokens

               * Fetch first token

               remove.token s from src setting i

               c = s[1,1]
               if c = '*' or c = '!' then
                  continue    ;* 0135
*0135             tokens(1) = TKN.END  ;* Line is a comment
*0135             token.strings(1) = ""
               end else
                  loop
                     * Save this token

                     if num.tokens >= max.tokens then  ;* Must expand tables
                        gosub expand.token.tables
                     end
                     num.tokens += 1

                     token.strings(num.tokens) = s
                     tokens(num.tokens) = i

                  while i

                     * If the token was a semicolon, look ahead to the next token
                     * to see if the rest of the line is a comment

                     if i = TKN.SEMICOLON then
                        remove.token s from src setting i
                        c = s[1,1]
                        if i # TKN.STRING and (c = '*' or c = '!') then ;* 0199
                           * Rest of line is a comment
                           * Replace semicolon token by end token and exit loop
                           tokens(num.tokens) = TKN.END
                           token.strings(num.tokens) = ""
                           exit
                        end
                     end else
                        remove.token s from src setting i
                     end
                  repeat
               end
            end
         end

         if num.tokens > 1 then
            if tokens(num.tokens-1) = TKN.COMMA then
               * 0565 The final token on this line is a comma. The following
               * line is therefore a continuation unless this line begins with
               * a label immediately followed by a comment introducer.

               begin case
                  case tokens(1) = TKN.NAME and tokens(2) = TKN.COLON
                     n = 3
                  case tokens(1) = TKN.LABEL
                     n = 2
                  case tokens(1) = TKN.NUM or tokens(1) = TKN.FLOAT
                     n = if tokens(2) = TKN.COLON then 3 else 2
                  case 1
                     n = 0
               end case

               if n then
                  begin case
                     case token.strings(n) = '*'
                     case token.strings(n) = '!'
                     case tokens(n) = TKN.NAME and listindex('REM,REMARK', ',', upcase(token.strings(n)))
                     case 1
                        continues.on.next.line = @true
                  end case
               end else
                  continues.on.next.line = @true
               end
            end
         end
      while continues.on.next.line
         num.tokens -= 1
      repeat     ;* Until no further continuation lines
   until end.source
   until num.tokens > 1   ;* Line is not blank
   repeat  ;* Until we have a non-blank line to process


   look.ahead.token = tokens(1)
   look.ahead.token.string = token.strings(1)
   u.look.ahead.token.string = upcase(look.ahead.token.string)
   token.index = 1

   return

*****************************************************************************
* PROC.LINE  -  Process source line

proc.line:
   gosub get.token           ;* Get first token
proc.line.prefetched:
   gosub emit.xref.entry

   if pc > code.size - 500 then    ;* Getting too close for comfort
      code.size += 32000
      code.image := str(char(0), 32000)
   end

   gosub check.for.label     ;* Check for a label at the start of the line

   gosub proc.statement.group

   if look.ahead.token = TKN.END then
      gosub get.token       ;* Skip end of line token
   end

   return

* ======================================================================

check.for.label:
   begin case
   case token = TKN.NAME
      if look.ahead.token = TKN.COLON then
         label.name = token.string
         if lsub.var.no >= 0 then label.name = lsub.name:label.name
         gosub set.label
         gosub get.token     ;* Read colon token
         gosub get.token     ;* Get next token
         c = token.string[1,1]
         if c = '*' or c = '!' then gosub st.remark
      end

   case token = TKN.LABEL
      if token.string[1] = ':' then
         token.string = token.string[1, len(token.string) - 1]
      end
      label.name = token.string
      if lsub.var.no >= 0 then label.name = lsub.name:label.name
      gosub set.label
      gosub get.token     ;* Get next token
      c = token.string[1,1]
      if c = '*' or c = '!' then gosub st.remark

   case token = TKN.NUM or token = TKN.FLOAT
      label.name = token.string
      if lsub.var.no >= 0 then label.name = lsub.name:label.name
      gosub set.label
      gosub get.token     ;* Get next token
      if token = TKN.COLON then gosub get.token
      c = token.string[1,1]
      if c = '*' or c = '!' then gosub st.remark
   end case

   return

*****************************************************************************

emit.xref.entry:
   if (level = 1) and emit.line.table then
      n = pc - statement.start.pc
      if n < 255 then xref := char(n)
      else xref := char(255) : char(bitand(n, 255)) : char(shift(n, 8))

      i = line.no(1)
      loop
         xref.line += 1
      while xref.line <= i
         xref := char(0)
      repeat

      statement.start.pc = pc
   end
   return

*****************************************************************************
* PROC.STATEMENT.GROUP  -  Process statements delimited by semicolons

proc.statement.group:
   loop
      gosub proc.statement
   while look.ahead.token = TKN.SEMICOLON
      gosub get.token                      ;* Skip semicolon
      gosub get.token                      ;* Get next token
   repeat

   return

*****************************************************************************
* PROC.STATEMENT  -  Process statement

proc.statement:
   err = @false
   is.objref = @false

   begin case
   case token = TKN.NAME
      begin case
      case look.ahead.token = TKN.NAME      ;* Must be statement
         goto is.statement
      case look.ahead.token = TKN.EQ        ;* Assignment
      case look.ahead.token = TKN.ADDEQ     ;* += Assignment
      case look.ahead.token = TKN.SUBEQ     ;* -= Assignment
      case look.ahead.token = TKN.CATEQ     ;* := Assignment
      case look.ahead.token = TKN.LSQBR     ;* Substring assignment
      case look.ahead.token = TKN.LT        ;* Field assignment
      case look.ahead.token = TKN.MULTEQ    ;* *= Assignment
      case look.ahead.token = TKN.DIVEQ     ;* /= Assignment
      case look.ahead.token = TKN.OBJREF    ;* Object reference

      case 1                             ;* Statement
is.statement:
         locate u.token.string in statements<1> setting i then
            if debug then gosub generate.debug
            on i gosub st.abort,
                 st.aborte,
                 st.abortm,
                 st.begin,
                 st.break,
                 st.call,
                 st.case,
                 st.chain,
                 st.clear,
                 st.clearcommon,
                 st.cleardata,
                 st.clearfile,
                 st.clearinput,
                 st.clearselect,
                 st.close,
                 st.close,                     ;* CLOSESEQ
                 st.close.socket,
                 st.commit,
                 st.continue,
                 st.convert,
                 st.create,
                 st.create.file,
                 st.crt,
                 st.data,
                 st.debug,
                 st.del,
                 st.delete,
                 st.deletelist,
                 st.deleteseq,
                 st.deleteu,
                 st.dim,
                 st.dim,                       ;* DIMENSION
                 st.disinherit,
                 st.display,
                 st.do,
                 st.dparse,
                 st.dparse.csv,
                 st.echo,
                 st.misplaced,                 ;* ELSE
                 st.end,
                 st.enter,
                 st.errmsg,
                 st.execute,
                 st.exit,
                 st.file,
                 st.filelock,
                 st.fileunlock,
                 st.find,
                 st.findstr,
                 st.flush,
                 st.footing,
                 st.for,
                 st.formlist,
                 st.getlist,
                 st.go,
                 st.gosub,
                 st.goto,
                 st.heading,
                 st.hush,
                 st.if,
                 st.in,
                 st.include,
                 st.inherit,
                 st.input,
                 st.clearinput,                ;* INPUTCLEAR
                 st.inputcsv,
                 st.printerr,                  ;* INPUTERR
                 st.inputfield,
                 st.ins,
                 st.keyedit,
                 st.keyexit,
                 st.keytrap,
                 st.local,
                 st.locate,
                 st.lock,
                 st.logmsg,
                 st.loop,
                 st.mark.mapping,
                 st.mat,
                 st.matbuild,
                 st.matparse,
                 st.matread,
                 st.matreadcsv,
                 st.matreadl,
                 st.matreadu,
                 st.matwrite,
                 st.matwriteu,
                 st.nap,
                 st.next,
                 st.nobuf,
                 st.null,
                 st.on,
                 st.open,
                 st.openpath,
                 st.openseq,
                 st.os.execute,
                 st.page,
                 st.pause,
                 st.execute,                   ;* PERFORM
                 st.precision,
                 st.print,
                 st.printer,
                 st.printcsv,
                 st.printerr,
                 st.procread,
                 st.procwrite,
                 st.prompt,
                 st.randomize,
                 st.read,
                 st.readblk,
                 st.readcsv,
                 st.readl,
                 st.readlist,
                 st.readnext,
                 st.readseq,
                 st.readu,
                 st.readv,
                 st.readvl,
                 st.readvu,
                 st.recordlockl,
                 st.recordlocku,
                 st.release,
                 st.remark,                    ;* REM
                 st.remark,
                 st.remove,
                 st.remove.break.handler,
                 st.repeat,
                 st.restore.screen,
                 st.return,
                 st.rollback,
                 st.sleep,                     ;* RQM
                 st.savelist,
                 st.seek,
                 st.select,
                 st.selecte,
                 st.selectindex,
                 st.selectleft,
                 st.selectn,
                 st.selectright,
                 st.selectv,
                 st.sendmail,
                 st.set.arg,
                 st.set.break.handler,
                 st.set.exit.status,
                 st.setleft,
                 st.setnls,
                 st.setpu,
                 st.setright,
                 st.setrem,
                 st.sleep,
                 st.sselect,
                 st.status,
                 st.stop,
                 st.stope,
                 st.stopm,
                 st.tclread,
                 st.timeout,
                 st.transaction,
                 st.ttyset,
                 st.unlock,
                 st.until,
                 st.void,
                 st.wake,
                 st.weofseq,
                 st.while,
                 st.write,
                 st.writeblk,
                 st.writecsv,
                 st.writeseq,
                 st.writeseqf,
                 st.writeu,
                 st.writev,
                 st.writevu
         end else
            locate u.token.string in non.debug.statements<1> setting i then
               on i gosub st.class,      ;* CLASS
                          st.common,     ;* COM
                          st.common,     ;* COMMON
                          st.deffun,
                          st.equate,     ;* EQU
                          st.equate,
                          st.function,
                          st.get,
                          st.private,
                          st.program,
                          st.public,
                          st.set,
                          st.subroutine, ;* SUB
                          st.subroutine
            end else
               if internal then
                  locate u.token.string in restricted.statements<1> setting i then
                     if debug then gosub generate.debug
                     on i gosub st.add,
                          st.akclear,
                          st.akdelete,
                          st.akenable,
                          st.akread,
                          st.akrelease,
                          st.akwrite,
                          st.breakpoint,
                          st.callv,
                          st.como,
                          st.configure.file,
                          st.create.ak,
                          st.debug.off,
                          st.debug.on,
                          st.debug.set,
                          st.delete.ak,
                          st.delete.common,
                          st.keyboard.input,
                          st.modify,
                          st.quit,
                          st.release.lock,
                          st.remove.token,
                          st.reset.modes,
                          st.rewind,
                          st.run,
                          st.set.modes,
                          st.set.status,
                          st.set.trigger,
                          st.set.unassigned,
                          st.sortadd,
                          st.sortclear,
                          st.sortinit,
                          st.trace,
                          st.unload.object,
                          st.varset,
                          st.watch,
                          st.writepkt
                     goto exit.proc.statement
                  end
               end

               err.msg = sysmsg(2831)  ;* Unrecognised statement
               gosub error
            end
         end

         goto exit.proc.statement
      end case

   case token = TKN.NAME.lbr
      * Handle special cases: RETURN(value), LOCATE(...), RANDOMIZE(n)
      if u.token.string = 'RETURN' then goto is.statement
      if u.token.string = 'LOCATE' then goto is.statement
      if u.token.string = 'RANDOMIZE' then goto is.statement
      if u.token.string = 'SUB' then goto is.statement
      if u.token.string = 'SUBROUTINE' then goto is.statement   ;* 0243
      goto is.assignment

   case token = TKN.AT.NAME
      if debug then gosub generate.debug
      gosub get.token        ;* Get @variable name
      gosub emit.at.lvalue
      if err then return
      goto process.operator
      
   case token = TKN.END
      goto exit.proc.statement

   case token = TKN.SEMICOLON
      gosub get.token
      goto proc.statement            ;* Start again for leading semicolon

   case 1
      if (token.string = '$' or token.string = '#') and (token.index = 2) then
         gosub proc.directive
         return
      end

      err.msg = sysmsg(2831)  ;* Unrecognised statement
      gosub error
      goto exit.proc.statement
   end case

is.assignment:
   * It is an assignment of some sort
   if debug then gosub generate.debug

   * Check for special case of a name referenced in a FILE statement

   if look.ahead.token = TKN.LBR then
      if file.refs # '' then
         locate u.token.string in file.refs<1> setting pos then
            gosub get.token   ;* Skip bracket
            gosub get.token   ;* Get field name

            locate token.string in file.fields<pos,1> setting vpos then
               fno = file.fld.nums<pos,vpos>
            end else
               gosub get.file.ref
               if err then return
            end

            symbol.name = file.refs<pos>
            symbol.mode = SYM.SET
            gosub find.var

            if look.ahead.token # TKN.RBR then goto err.rbr
            gosub get.token   ;* Skip bracket

            gosub emit.var.load

            n = fno ; gosub emit.numeric.load

            * Check for "FILE(FIELD)<1,3> = xxx"

            if look.ahead.token = TKN.LT then
               gosub is.field.ref
               if ifr.index = 0 then
                  err.msg = sysmsg(2961) ;* Incorrectly formed field reference
                  gosub error
                  goto exit.proc.statement
               end

               loop
               until look.ahead.token = TKN.END.FIELD
               until look.ahead.token = TKN.COMMA
               until look.ahead.token = TKN.END
                  gosub get.token
               repeat

               if look.ahead.token = TKN.COMMA then
                  gosub get.token
                  gosub expr
               end else
                  n = 0 ; gosub emit.numeric.load
               end

               if look.ahead.token = TKN.COMMA then
                  gosub get.token
                  gosub expr
               end else
                  n = 0 ; gosub emit.numeric.load
               end

               if look.ahead.token # TKN.END.FIELD then
                  err.msg = sysmsg(2961) ;* Incorrectly formed field reference
                  gosub error
                  goto exit.proc.statement
               end
               gosub get.token
            end else
               n = 0 ; gosub emit.numeric.load
               n = 0 ; gosub emit.numeric.load
            end

            if look.ahead.token # TKN.EQ then
               err.msg = sysmsg(3420) ;* Illegal assignment operation
               gosub error
            end else
               gosub get.token
               gosub exprf
               opcode.byte = OP.REP ; gosub emit.simple
            end
                  
            goto exit.proc.statement
         end
      end
   end

   gosub emit.lvar.reference   ;* Set up a reference to the target variable

   * Is this an object reference?

   if look.ahead.token = TKN.OBJREF then
      loop
         is.objref = @true
         gosub get.token     ;* Skip -> operator
         gosub get.property.name ; if err then return
         opcode.byte = OP.OBJREF ; gosub emit.simple
         obj.mode.pc = pc
         opcode.byte = 1         ; gosub emit        ;* 1 = Get property

         object.arg.ct = 0
         if look.ahead.token = TKN.LBR then  ;* Arguments present
            gosub get.token
            loop
               gosub expr ; if err then goto exit.proc.statement
               object.arg.ct += 1
            while look.ahead.token = TKN.COMMA
               gosub get.token
            repeat

            if look.ahead.token # TKN.RBR then goto err.rbr
            gosub get.token
         end
      while look.ahead.token = TKN.OBJREF
         opcode.byte = OP.GET ; gosub emit.simple
         opcode.byte = object.arg.ct ; gosub emit
      repeat
      code.image[obj.mode.pc+1,1] = char(0)

      if look.ahead.token = TKN.EQ then
         gosub get.token
         gosub exprf
         opcode.byte = OP.VALUE ; gosub emit.simple
         object.arg.ct += 1
      end

      if look.ahead.token # TKN.END and look.ahead.token # TKN.SEMICOLON then
         err.msg = sysmsg(3458) ;* Invalid property reference
         gosub error
         goto exit.proc.statement
      end

      opcode.byte = OP.SET ; gosub emit.simple
      opcode.byte = object.arg.ct ; gosub emit
      goto exit.proc.statement
   end

process.operator:
   begin case
   case look.ahead.token = TKN.EQ     ;* Assignment
      gosub get.token
      if look.ahead.token = TKN.NUM then
         if look.ahead.token.string = 0 then
            if not(is.objref) then
               if tokens(token.index + 1) = TKN.END then
                  opcode.byte = OP.STZ ; gosub emit.simple
                  gosub get.token
                  goto exit.proc.statement
               end
            end
         end
      end

      if look.ahead.token = TKN.STRING then
         if look.ahead.token.string = '' then
            if tokens(token.index + 1) = TKN.END then
               if not(is.objref) then
                  opcode.byte = OP.STNULL; gosub emit.simple
                  gosub get.token
                  goto exit.proc.statement
               end
            end
         end
      end

      gosub exprf
      opcode.byte = OP.STOR  ; gosub emit.simple

   case look.ahead.token = TKN.ADDEQ     ;* += Assignment
      gosub get.token
      if look.ahead.token = TKN.NUM then
         if look.ahead.token.string = 1 then
            if not(is.objref) then
               if tokens(token.index + 1) = TKN.END then
                  opcode.byte = OP.INC ; gosub emit.simple
                  gosub get.token
                  goto exit.proc.statement
               end
            end
         end
      end
      opcode.byte = OP.DUP   ; gosub emit.simple
      gosub exprf
      opcode.byte = OP.ADD   ; gosub emit.simple
      opcode.byte = OP.STOR  ; gosub emit.simple

   case look.ahead.token = TKN.SUBEQ     ;* -= Assignment
      gosub get.token
      if look.ahead.token = TKN.NUM then
         if look.ahead.token.string = 1 then
            if not(is.objref) then
               if tokens(token.index + 1) = TKN.END then
                  gosub get.token
                  opcode.byte = OP.DEC ; gosub emit.simple
                  goto exit.proc.statement
               end
            end
         end
      end
      opcode.byte = OP.DUP   ; gosub emit.simple
      gosub exprf
      opcode.byte = OP.SUB   ; gosub emit.simple
      opcode.byte = OP.STOR  ; gosub emit.simple

   case look.ahead.token = TKN.CATEQ     ;* := Assignment
      gosub get.token
      gosub exprf
      opcode.byte = OP.APPEND  ; gosub emit.simple

   case look.ahead.token = TKN.MULTEQ    ;* *= Assignment
      gosub get.token
      opcode.byte = OP.DUP   ; gosub emit.simple
      gosub exprf
      opcode.byte = OP.MUL   ; gosub emit.simple
      opcode.byte = OP.STOR  ; gosub emit.simple

   case look.ahead.token = TKN.DIVEQ     ;* /= Assignment
      gosub get.token
      opcode.byte = OP.DUP   ; gosub emit.simple
      gosub exprf
      opcode.byte = OP.DIV   ; gosub emit.simple
      opcode.byte = OP.STOR  ; gosub emit.simple

   case look.ahead.token = TKN.LSQBR  ;* Substring assignment
      * This may be substring assignment s[x,y] = sss
      * or delimited substring assignment s[d,x,y] = sss

      gosub get.token     ;* Skip [ token
      gosub expr          ;* Process start position / delimiter 
      gosub check.comma
      gosub expr             ;* Process length expresssion / position

      if look.ahead.token = TKN.RSQBR then ;* Substring assignment
         gosub get.token        ;* Skip bracket

         if look.ahead.token # TKN.EQ then
            err.msg = sysmsg(2832) ;* Expected equals after substring lvalue expression
            goto error
         end

         gosub get.token

         * Process the rvalue expression
   
         gosub exprf

         * Store the result

         begin case
            case bittest(mode, M.PICK.SUBSTR.ASSIGN)
               opcode.byte = OP.PSUBSTRB
            case bittest(mode, M.PICK.SUBSTR)
               opcode.byte = OP.PSUBSTRA
            case 1
               opcode.byte = OP.SUBSTRA
         end case
         gosub emit.simple
      end else                           ;* Delimited substring assignment
         gosub check.comma
         gosub expr             ;* Process number of substrings expression

         if look.ahead.token # TKN.RSQBR then goto err.rsqbr

         gosub get.token        ;* Skip bracket

         if look.ahead.token # TKN.EQ then
            err.msg = sysmsg(2832) ;* Expected equals after substring lvalue expression
            goto error
         end

         gosub get.token
   
         gosub exprf  ;* Process the rvalue expression

         * Perform the fieldstore operation

         opcode.byte = OP.FLDSTOR ; gosub emit.simple
      end

   case look.ahead.token = TKN.LT     ;* Field assignment
      format.qualifier.allowed = @false
      gosub is.field.ref
      if ifr.index = 0 then
         err.msg = sysmsg(2833)  ;* Improperly formed field assignment
         gosub error
         goto exit.proc.statement
      end

      gosub get.token       ;* Skip < token
      gosub emit.field.reference
      if err then goto exit.proc.statement

      * Fetch and process operator

      begin case
         case look.ahead.token = TKN.EQ
            gosub get.token
            gosub exprf  ;* Process the rvalue expression
            opcode.byte = if bittest(mode, M.COMPAT.APPEND) then OP.COMPREP else OP.REP
            gosub emit.simple

         case look.ahead.token = TKN.ADDEQ  ;* += Assignment
            gosub get.token
            gosub exprf  ;* Process the rvalue expression
            opcode.byte = OP.REPADD
            gosub emit.simple

         case look.ahead.token = TKN.SUBEQ  ;* -= Assignment
            gosub get.token
            gosub exprf  ;* Process the rvalue expression
            opcode.byte = OP.REPSUB
            gosub emit.simple

         case look.ahead.token = TKN.CATEQ  ;* := Assignment
            gosub get.token
            gosub exprf  ;* Process the rvalue expression
            opcode.byte = OP.REPCAT
            gosub emit.simple

         case look.ahead.token = TKN.MULTEQ  ;* *= Assignment
            gosub get.token
            gosub exprf  ;* Process the rvalue expression
            opcode.byte = OP.REPMUL
            gosub emit.simple

         case look.ahead.token = TKN.DIVEQ  ;* /= Assignment
            gosub get.token
            gosub exprf  ;* Process the rvalue expression
            opcode.byte = OP.REPDIV
            gosub emit.simple

         case look.ahead.token = TKN.LSQBR    ;* Substring assignment
            * The only valid style is var<f,v,s>[p,q] = xxx

            gosub get.token     ;* Skip [ token
            gosub expr          ;* Process start position
            gosub check.comma
            gosub expr             ;* Process length expresssion

            if look.ahead.token # TKN.RSQBR then
               gosub err.rsqbr
               goto exit.proc.statement
            end

            gosub get.token        ;* Skip bracket

            if look.ahead.token # TKN.EQ then
               err.msg = "Illegal operator"
               gosub error
               goto exit.proc.statement
            end

            gosub get.token        ;* Skip = operator

            gosub exprf  ;* Process the rvalue expression
            opcode.byte = OP.REPSUBST
            gosub emit.simple

         case 1
            err.msg = sysmsg(2834) ;* Illegal operator after field expression
            gosub error
            goto exit.proc.statement
      end case
   end case

exit.proc.statement:

   return

*****************************************************************************
* PROC.DIRECTIVE  -  Process compiler directive

proc.directive:
      gosub get.token
      directive.name = u.token.string

      begin case
      ************************ CATALOGUE ************************

      case (u.token.string = "CATALOGUE" or u.token.string = "CATALOG") and not(is.ctype)
         begin case
!            case catalogue.name # ''
!               err.msg = sysmsg(3413, u.token.string) ;* Multiple use of $%1
!               gosub error
!               goto exit.proc.directive
               
            case look.ahead.token = TKN.STRING 
               gosub get.token
               catalogue.name = token.string
            case (look.ahead.token = TKN.NAME) or (look.ahead.token = TKN.NAME.LBR) or (look.ahead.token.string = '!')  or (look.ahead.token.string = '*') or (look.ahead.token = TKN.DOLLAR)
               gosub get.call.name       ;* Read name token
               catalogue.name = s
            case 1
               catalogue.name = '~'
         end case

         begin case
            case look.ahead.token = TKN.END
               if catalogue.name = 'LOCAL' or catalogue.name = 'GLOBAL' then
                  * Not really a catalogue name at all
                  catalogue.mode = catalogue.name
                  catalogue.name = '~'
               end
            case u.look.ahead.token.string = 'LOCAL'
               catalogue.mode = u.look.ahead.token.string
            case u.look.ahead.token.string = 'GLOBAL'
               catalogue.mode = u.look.ahead.token.string
            case 1
               err.msg = sysmsg(2835, directive.name) ;* Misformed $xx
               gosub error
               goto exit.proc.directive
         end case

         * Validate the name

         if catalogue.name # '~' then
!!CALLNAME!!
            if len(catalogue.name) > 1 and index("*!_$", catalogue.name[1,1], 1) then n = 2
            else n = 1

            if len(catalogue.name) > MAX.CALL.NAME.LEN or convert("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.%$_-", "", catalogue.name[n,99]) # '' then
               err.msg = sysmsg(2836) ;* Illegal catalogue name
               gosub error
               goto exit.proc.directive
            end
         end


      ************************** DEBUG **************************

      case u.token.string = "DEBUG" and not(is.ctype)
         if pc # start.pc then
            err.msg = sysmsg(2837, u.token.string) ;* $%1 must appear before any executable statements
            goto error
         end

         if not(debug) then
            gosub emit.debug.header
            debug = @true
         end

      ************************* DEFINE **************************

      case u.token.string = "DEFINE"
         if look.ahead.token # TKN.NAME then
            err.msg = sysmsg(2838) ;* Misformed $DEFINE
            gosub error
            goto exit.proc.directive
         end

         gosub get.token         ;* Get token name
         define.token = token.string

         begin case
         case look.ahead.token = TKN.END
            n = '0'

         case look.ahead.token = TKN.NUM
            n = '1'

         case look.ahead.token = TKN.HEXNUM
            look.ahead.token.string = xtd(look.ahead.token.string)
            n = '1'

         case look.ahead.token = TKN.STRING
            n = '0'

         case look.ahead.token = TKN.FLOAT
            n = '1'

         case look.ahead.token = TKN.PLUS
            gosub get.token
            if look.ahead.token # TKN.NUM and look.ahead.token # TKN.FLOAT then
               err.msg = sysmsg(2838) ;* Misformed $DEFINE
               gosub error
               goto exit.proc.directive
            end
            n = 1

         case look.ahead.token = TKN.MINUS
            gosub get.token
            if look.ahead.token # TKN.NUM and look.ahead.token # TKN.FLOAT then
               err.msg = sysmsg(2838) ;* Misformed $DEFINE
               gosub error
               goto exit.proc.directive
            end
            look.ahead.token.string = "-" : look.ahead.token.string
            n = 1

         case 1
            err.msg = sysmsg(2838) ;* Misformed $DEFINE
            gosub error
            goto exit.proc.directive
         end case

         * 0321 Check if this token is already known as a variable

         locate define.token in symbols<1> by 'AL' setting i then
            err.msg = sysmsg(3408, define.token) ;* Token is already defined as a variable
            goto error
         end

         s = find(defined.tokens, define.token)
         if not(status()) then
            err.msg = sysmsg(2839) ;* Duplicate $DEFINE token
            gosub error
            goto exit.proc.directive
         end

         add define.token, n : look.ahead.token.string to defined.tokens
         gosub get.token

      ************************** DICT **************************

      case u.token.string = "DICT" and not(is.ctype)
         if assigned(dict.f) then
            err.msg = sysmsg(3405) ;* $DICT can only appear once in a program
            gosub error
         end else if look.ahead.token = TKN.END then
            gosub err.syntax
         end else
            open 'DICT', look.ahead.token.string to dict.f else
               open 'DICT', u.look.ahead.token.string to dict.f else
                  err.msg = sysmsg(2012) ;* Cannot open dictionary
                  gosub error
               end
            end
         end

      ************************ EXECUTE **************************

      case u.token.string = "EXECUTE"
         if (look.ahead.token # TKN.STRING) then
            err.msg = sysmsg(2835, directive.name) ;* Misformed $xx
            gosub error
            goto exit.proc.directive
         end

         gosub get.token

         execute token.string

      ************************* EXPLIST *************************

      case u.token.string = "EXPLIST" & kernel(K$INTERNAL, -1)
         gosub get.token
         print.code = u.token.string # "OFF"
         if print.code then gosub start.listing

      ************************** FLAGS **************************

      case internal and u.token.string = "FLAGS"
         loop
         while look.ahead.token # TKN.END
            gosub get.token
            begin case
               case u.token.string = "ALLOW.BREAK"
                  header.flags = bitor(header.flags, hdr.allow.break)
               case u.token.string = "CPROC"
                  header.flags = bitor(header.flags, hdr.is.cproc)
               case u.token.string = "DEBUGGER"
                  header.flags = bitor(header.flags, hdr.is.debugger)
               case u.token.string = "NETFILES"
                  header.flags = bitor(header.flags, hdr.netfiles)
               case u.token.string = "TRUSTED"
                  header.flags = bitor(header.flags, hdr.is.trusted)
               case 1
                  err.msg = sysmsg(2843, token.string) ;* Unrecognised token
                  gosub error
                  exit
            end case
         repeat

      ******************** INCLUDE / INSERT *********************

      case u.token.string = "INCLUDE" or u.token.string = "INSERT"
         gosub process.include

      ************************ INTERNAL *************************

      case u.token.string = "INTERNAL" & kernel(K$INTERNAL, -1)
         header.flags = bitor(header.flags, hdr.internal)
         internal = @true

      ************************** LIST ***************************

      case u.token.string = "LIST"
         if not(is.ctype) then
            begin case
               case upcase(look.ahead.token.string) = "OFF"
                  gosub get.token
                  listing(level) = @false

               case (upcase(look.ahead.token.string) = "ON") or (look.ahead.token = TKN.END)
                  if look.ahead.token # TKN.END then gosub get.token
                  listing(level) = listing(level - 1)
                  if listing(level) then gosub start.listing

               case 1
                  err.msg = sysmsg(2840)  ;* Unexpected text after $LIST
                  gosub error
            end case
         end

      ************************** MODE ***************************

      case u.token.string = "MODE"
         if upcase(look.ahead.token.string) = "DEFAULT" then
            mode = 0
         end else
            if look.ahead.token = TKN.MINUS then
               reset.mode = @true
               gosub get.token
            end else
               reset.mode = @false
            end

            if look.ahead.token = TKN.END then
               err.msg = sysmsg(2841) ;* Mode name required after $MODE
               gosub error
            end else
               gosub get.token
               locate u.token.string in mode.names<1,1> setting i then
                  if reset.mode then
                     mode = bitreset(mode, i - 1)
                  end else
                     mode = bitset(mode, i - 1)
                  end
               end else
                  err.msg = sysmsg(2842) ;* Unrecognised mode name
                  gosub error
               end
            end
         end

         gosub set.kernel.modes

      ********************** NOCASE.STRINGS *********************

      case u.token.string = "NOCASE.STRINGS"
         if pc # start.pc then
            err.msg = sysmsg(2837, u.token.string) ;* $%1 must appear before any executable statements
            goto error
         end

         header.flags = bitor(header.flags, HDR.NOCASE)

      ************************ NO.SYMBOLS ***********************

      case u.token.string = "NO.SYMBOLS"
         if not(debug) then emit.symbol.table = @false

      ************************ NO.XREF **************************

      case u.token.string = "NO.XREF"
         if not(debug) then emit.line.table = @false

      *************************** PAGE ***************************

      case u.token.string = "PAGE"
         list.pg = char(12)

      ************************** QMCALL **************************

      case u.token.string = "QMCALL" and not(is.ctype)
         header.flags = bitor(header.flags, HDR.QMCALL.ALLOWED)

      ************************ RECURSIVE *************************

      case u.token.string = "RECURSIVE" & kernel(K$INTERNAL, -1)
         recursive = 1
         header.flags = bitor(header.flags, hdr.recursive)

      case 1
         err.msg = sysmsg(2844) ;* Unrecognised compiler directive
         gosub error
      end case

exit.proc.directive:
   loop
   while token
      gosub get.token
   repeat

   return

* *****************************************************************************
* Process a $INCLUDE directive or an INCLUDE statement

process.include:
   * Because the rules governing operating system names are different
   * from the BASIC variable name rules, we must parse this line
   * using special processing. Thus, we work directly from the SRC variable
   * rather than using the token system.

   if level = max.levels then
      err.msg = sysmsg(2845) ;* Include files nested too deeply
      goto error
   end

   src = trim(field(src, ';', 1))
   n = dcount(src, ' ')
   begin case
      case n = 1
         err.msg = sysmsg(2846) ;* Expected include file or record name
         goto error

      case n = 2
         if not(is.ctype) then
            include.file.name = source.file.name
            include.record.name = field(src, ' ', 2)
            ignore.not.found = @true
            gosub open.include.record
         end else
            err = @true    ;* Treat as error to force path below
         end

         if err then            ;* Try SYSCOM
            err = @false
            include.file.name = "SYSCOM"
            include.error.name = include.record.name
            ignore.not.found = @false
            gosub open.include.record
            if err then return
         end

      case n = 3
         include.file.name = field(src, ' ', 2)
         include.record.name = field(src, ' ', 3)
         include.error.name = include.file.name : " " : include.record.name
         ignore.not.found = @false
         gosub open.include.record
         if err then return

      case 1
         err.msg = sysmsg(2847) ;* Unexpected text after $INCLUDE
         goto error
   end case

   line.no(level) = 0
   listing(level) = listing(level - 1)

   return

*****************************************************************************
* OPEN.INCLUDE.RECORD  -  Attempt to open an include record

open.include.record:
   open include.file.name to incl.file else
      open upcase(include.file.name) to incl.file else
         if ignore.not.found then err = @true
         else
            err.msg = sysmsg(2848, include.file.name) ;* Include file xx not found
            gosub error
         end
         return
      end
      include.file.name = upcase(include.file.name)
   end

   level += 1
   read include.record(level) from incl.file, include.record.name else
      read include.record(level) from incl.file, upcase(include.record.name) else
         level -= 1
         if ignore.not.found then err = @true
         else
            err.msg = sysmsg(2849, include.error.name) ;* Include record xx not found
            gosub error
         end
      end
      include.record.name = upcase(include.record.name)
   end    

   return

*****************************************************************************
* GET.TOKEN  -  Get next token from pre-parsed source token array

get.token:
   token = look.ahead.token
   token.string = look.ahead.token.string
   u.token.string = u.look.ahead.token.string

   if token then
      token.index += 1
      look.ahead.token = tokens(token.index)
      look.ahead.token.string = token.strings(token.index)
      u.look.ahead.token.string = upcase(look.ahead.token.string)
   end else
      gosub get.line
   end

   return

*****************************************************************************
* GET.VAR.NAME  -  Read variable name from source

get.var.name:
   if (look.ahead.token # TKN.NAME) and (look.ahead.token # TKN.NAME.LBR) then
      goto err.var
   end

   gosub get.token

   return

*****************************************************************************
* GET.NAME, GET.CALL.NAME  -  Get a name with possible prefix character.
* GET.NAME       Used for PROGRAM and COMMON names
* GET.CALL.NAME  Used for CALL and SUBROUTINE statements

get.call.name:
   s = ""

   if look.ahead.token.string = '!' or look.ahead.token.string = '*' then
      s = look.ahead.token.string
      gosub get.token
      goto get.name.common.path
   end

get.name:
   s = ""

   if internal then
      if (look.ahead.token = TKN.DOLLAR) or (look.ahead.token = TKN.UNDERSCORE) or (look.ahead.token = TKN.OR) then
         s = look.ahead.token.string
         gosub get.token
      end
   end

get.name.common.path:
   if look.ahead.token = TKN.STRING then goto err.name

   gosub get.token

   * Because we need to allow for operator names used as call names
   * (e.g. !MATCHES), simply check that the token string contains only
   * characters that are permissible in QMBasic call names.

   if convert(name.chars, '', u.token.string) # '' then goto err.name

   s := u.token.string    ;* Call names are always uppercase

   return

*****************************************************************************
* GET.LABEL.NAME  -  Read a label name from the source stream

get.label.name:
   begin case
   case look.ahead.token = TKN.LABEL
      gosub get.token
      if token.string[1] = ":" then
         token.string = token.string[1, len(token.string) - 1]
      end
      label.name = token.string

   case (look.ahead.token = TKN.NAME) or (look.ahead.token = TKN.NUM) ~
         or (look.ahead.token = TKN.FLOAT) or (look.ahead.token = TKN.NAME.LBR)
      gosub get.token
      label.name = token.string
* 1.1-1 Was testing TKN.SEMICOLON.  This doesn't seem to make sense
      if look.ahead.token = TKN.COLON then
         gosub get.token
      end

   case 1
      err.msg = sysmsg(2851) ;* Label name not found where expected
      gosub error
   end case

   return

*****************************************************************************
* SET.LABEL  -  Generate source label

set.label:
   if print.code then
      list.rec = "         ":fmt(oconv(pc, "MX"), "6'0'R"):": ":label.name
      gosub emit.listing
   end

   * Search label table for this label name

   jump.addr = find(label.tree, label.name) + 0
   if status() then       ;* Label not found - add it
      add label.name, pc to label.tree
   end else               ;* Label found
      if jump.addr < 0 then              ;* It is a forward reference
         update.addr = -jump.addr
         modify label.tree, pc           ;* Correct the label table entry.

         * Go back and fill in the jump chain.

         loop
            * Fetch next jump chain address from jump opcode, replacing by
            * actual address as we go.

            code.value = pc
            code.bytes = 3
            jump.addr = 0
            shift.len = 0

            loop
               jump.addr += shift(seq(code.image[update.addr + 1, 1]), shift.len)
               code.image[update.addr + 1, 1] = char(code.value)
               code.value = shift(code.value, 8)
               update.addr += 1
               code.bytes -= 1
            while code.bytes
               shift.len -= 8
            repeat
         while jump.addr
            update.addr = jump.addr
         repeat
      end else            ;* It is not a forward reference. Flag an error.
         err.msg = sysmsg(2852) ;* Duplicate label
         gosub error
      end
   end

   if list.xref then
      if label.name[1,1] # '_' then
         if label.name[1,1] # '*' then
            locate label.name in label.refs<1,1> by 'AL' setting lblpos then
               label.refs<3,lblpos> = line.no(1)           ;* Declaration
            end else
               ins label.name before label.refs<1,lblpos>  ;* Name
               ins '' before label.refs<2,lblpos>          ;* References
               ins line.no(1) before label.refs<3,lblpos>  ;* Declaration
            end
         end
      end
   end

   return
              
*****************************************************************************
* EMIT.JUMP  -  Emit a jump opcode
* OPCODE.BYTE holds jump opcode
* LABEL.NAME holds target label

emit.jump:
   if print.code then
      * Show the code to be generated
      s = fmt(opcodes<1,opcode.byte + 1>, "9L"):label.name
      gosub show.code
   end

   * Emit the jump opcode
   gosub emit
   gosub emit.jump.addr

   return

**********************************************************************
* EMIT.JUMP.ADDR  -  Emit 3 byte jump address
* LABEL.NAME contains target label

emit.addr:
   if print.code then
      * Show the code to be generated
      s = '&':label.name
      gosub show.code
   end

emit.jump.addr:
   * Find label in symbol table

   jump.addr = find(label.tree, label.name) + 0
   if status() then       ;* Label not found - add it as forward reference
      add label.name, -pc to label.tree
      jump.addr = 0
   end else               ;* Label found
      if jump.addr < 0 then
         * This is a forward reference. Update the label table to point to
         * this jump to build a chain through all forward references.

         modify label.tree, -pc
         jump.addr = - jump.addr
      end
   end

   * Emit the jump address
   code.value = jump.addr
   code.bytes = 3
   gosub emit.multibyte.value


   if list.xref then
      if label.name[1,1] # '_' then
         if label.name[1,1] # '*' then
            locate label.name in label.refs<1,1> by 'AL' setting lblpos then
               label.refs<2,lblpos,-1> = line.no(1)        ;* References
            end else
               ins label.name before label.refs<1,lblpos>  ;* Name
               ins line.no(1) before label.refs<2,lblpos>  ;* References
               ins '' before label.refs<3,lblpos>          ;* Declaration
            end
         end
      end
   end

   return

*****************************************************************************
* EMIT.DIRECT.CALL.REFERENCE  -  Emit call to name in S

emit.direct.call.reference:
   * Check to see if we already know this subroutine name. If not, add it
   * to the list of direct calls and create a local variable for it.

   symbol.common.offset = -1           ;* Local variable

   locate s in direct.calls<1> setting i then
      symbol.var.no = direct.call.vars<i>   ;* Variable number
      symbol.name = "_" : s
   end else
      symbol.name = "_" : s
      symbol.dim = 0
      symbol.mode = SYM.SET
      gosub make.var

      ins s before direct.calls<i>
      ins symbol.var.no before direct.call.vars<i>
   end

   gosub emit.var.load

   return

*****************************************************************************
* Emit return argument

emit.function.return.argument:
   symbol.name = "_FUNC"
   symbol.mode = SYM.SET
   gosub find.var
   if symbol.var.no < 0 then
      symbol.dim = 0
      gosub make.var
   end
   gosub emit.var.load

   return

*****************************************************************************
* Load function result

emit.function.result.load:
   symbol.name = "_FUNC"
   gosub find.var
   gosub emit.var.load

   * 0258 Dereference so that _FUNC can be used again for any later arguments.
   opcode.byte = OP.VALUE ; gosub emit.simple

   return

*****************************************************************************
* FIND.VAR  -  Search symbol table for variable

* Input:
*    SYMBOL.NAME = symbol to find
*    SYMBOL.MODE = What are we doing with this symbol?
* Output:
*    SYMBOL.VAR.NO         -ve if not found
*    SYMBOL.COMMON.OFFSET  -ve if local variable, else common offset
*    SYMBOL.DIM            Dimensions (0 if scalar, 1 or 2 for array,
*                                      -1 if array but dimensions not yet known)
*    SYMBOL.COMMON.INDEX   Index into COMMONS for common variable

find.var:
   if lsub.var.no >= 0 then ;* Try local symbols first
      locate lsub.name:symbol.name in symbols<1> setting sympos then
         var.data = symbol.info<sympos>
         symbol.var.no = remove(var.data, k) + 0
         symbol.common.offset = remove(var.data, k) + 0
         symbol.dim = remove(var.data, k) + 0
         symbol.common.index = remove(var.data, k) + 0
         if symbol.mode then symbol.refs<sympos,symbol.mode,symsv> = line.no(1)
         return
      end
   end

   if object.arg.names # '' then  ;* Try object argument names
      locate symbol.name in object.arg.names<1> setting sympos then
         symbol.var.no = sympos - 1  ;* Map to local vars 0 onwards (arg 1+)
         symbol.common.offset = -1   ;* Local variable
         symbol.dim = 0              ;* Always scalar
         symbol.common.index = 0
         return
      end
   end

   locate symbol.name in symbols<1> setting sympos then
      var.data = symbol.info<sympos>
      symbol.var.no = remove(var.data, k) + 0
      symbol.common.offset = remove(var.data, k) + 0
      symbol.dim = remove(var.data, k) + 0
      symbol.common.index = remove(var.data, k) + 0
      if symbol.mode then symbol.refs<sympos,symbol.mode,symsv> = line.no(1)
   end else
      symbol.dim = 0
      symbol.var.no = -1
      symbol.common.offset = -1
      symbol.common.index = -1
   end

   symbol.mode = SYM.USE

   return

*****************************************************************************
* MAKE.VAR  -  Add new symbol table entry for variable

* Input:
*    SYMBOL.NAME = symbol to add (must not exist)
*    SYMBOL.COMMON.OFFSET  -ve if local variable, else common offset
*    SYMBOL.DIM            Dimensions (0 if scalar, 1 or 2 for array
*                                      -1 if array dimensions nt yet known)
*    SYMBOL.MODE = What are we doing with this symbol?
* Output:
*    SYMBOL.VAR.NO         Local variable number

make.var:
   locate symbol.name in symbols<1> by 'AL' setting sympos else
      symbol.var.no = var.count
      var.count += 1
      var.data = symbol.var.no : @vm : symbol.common.offset : @vm :  symbol.dim
      ins symbol.name before symbols<sympos>
      ins var.data before symbol.info<sympos>
      ins '' before symbol.refs<sympos>
      symbol.table<-1> = symbol.name
      if symbol.mode then symbol.refs<sympos,symbol.mode,symsv> = line.no(1)
   end

   symbol.mode = SYM.USE

   return

*****************************************************************************
* EMIT.VAR.REFERENCE  -  Emit LDLCL or LDCOM for variable reference
* and index handling if it is an array.
* Variable name is current token


simple.lvar.reference:
   lvar = @true
   goto simple.var.reference.common

simple.var.reference:
   lvar = @false

simple.var.reference.common:
   * The reference must be a scalar or array element, not an expression,
   * substring or dynamic array field extraction

   if look.ahead.token = TKN.AT or look.ahead.token = TKN.AT.NAME then
      gosub get.token            ;* Skip @ token
      if look.ahead.token # TKN.NAME then
         err.msg = sysmsg(2853) ;* Incorrectly formed @ variable name
         goto error
      end

      gosub get.token
      gosub emit.at.var.load
      return
   end

   gosub get.var.name
   if err then return

   function.allowed = @false
   goto emit.var.reference.common


emit.lvar.reference:
   lvar = @true
   function.allowed = @false
   goto emit.var.reference.common

emit.var.reference:
   lvar = @false
   function.allowed = @true

emit.var.reference.common:
   * Check to see if it is a defined token.

   s = find(defined.tokens, token.string)
   if not(status()) then
      n = s[1,1] + 0
      begin case
         case n = 0  ;* String
            if lvar then goto err.var
            opcode.string = s[2,99999]
            gosub emit.string.load
            return

         case n = 1  ;* Number token
            if lvar then goto err.var
            n = s[2, 99999] + 0
            gosub emit.numeric.load
            return

         case n = 2  ;* Matrix reference
            i = index(s, " ", 1)
            symbol.name = s[2, i - 2]
            equate.index = s[i + 1, 9999]
            if lvar then symbol.mode = SYM.SET
            gosub find.var
            if symbol.var.no < 0 then
               err.msg = sysmsg(2863) ;* Equate token references undimensioned matrix
               goto error
            end
            if symbol.dim = 0 then
               err.msg = sysmsg(2864) ;* Equate token references scalar variable
               goto error
            end
            if symbol.dim # ((index(equate.index," ",1) # 0) + 1) then
               err.msg = sysmsg(2865) ;* Equate token references matrix with wrong number of dimensions
               goto error
            end
            gosub emit.var.load

            n = matchfield(equate.index, "0N0X", 1)
            gosub emit.numeric.load

            if symbol.dim = 2 then
               n = matchfield(equate.index, "0N 0N", 3)
               gosub emit.numeric.load
               opcode.byte = OP.INDX2
            end else
               opcode.byte = OP.INDX1
            end
            gosub emit.simple
            return

         case n = 3  ;* Character sequence token
            if lvar then goto err.var
            opcode.string = char(s[2,99999])
            gosub emit.string.load
            return

         case n = 4  ;* Simple variable reference
            token.string = s[2, 99999]
            u.token.string = upcase(token.string)

         case n = 5  ;* @-variable
            token.string = s[2, 99999]
            u.token.string = upcase(token.string)
            gosub emit.at.var.load
            return
      end case
   end

   * If this is a CLASS routine, the token ME has special meaning

   if object.state then
      if u.token.string = 'ME' then
         opcode.byte = OP.ME ; gosub emit.simple
         return
      end
   end

   if lvar then symbol.mode = SYM.SET
   possible.function = (token = TKN.NAME.LBR)   ;* 0118
   symbol.name = token.string
   saved.symbol.mode = symbol.mode
   gosub find.var

   if symbol.var.no < 0 or symbol.dim = 0 then
      * Not known as a matrix

      if possible.function then     ;* Bracket follows name
         if function.allowed then
            * Check for functions. Any array should have been mentioned
            * in a DIM statement by now.

            * Try as a user declared function. These may be case sensitive

            locate symbol.name in functions<1,1> by 'AL' setting func.index then
               ins func.index : @vm : 0 before func.stack<1>
               gosub get.token           ; * Skip left bracket

               s = functions<2,func.index>
               if s # '' then   ;* External function
                  gosub emit.direct.call.reference
               end

               gosub emit.function.return.argument  ;* Emit return argument

               * If this function has a key, emit it as the second argument

               if functions<4,func.index> # '' then
                  n = functions<4,func.index>
                  if n matches '1N0N' then
                     gosub emit.numeric.load
                  end else
                     opcode.string = n ; gosub emit.string.load
                  end
               end

               * Emit function arguments

               if look.ahead.token # TKN.RBR then
                  loop
                     if look.ahead.token = TKN.END then
                        del func.stack<1>
                        err.msg = sysmsg(2854) ;* Function argument not found where expected
                        goto error
                     end

                     func.index = func.stack<1,1>
                     i = func.stack<1,2> + 1
                     func.stack<1,2> = i
                     function.args = functions<3,func.index>

                     if function.args[i,1] = 'M' then  ;* Expect MAT
                        if upcase(look.ahead.token.string) # 'MAT' then
                           del func.stack<1>
                           err.msg = sysmsg(2855) ;* Argument type mismatch in function call
                           goto error
                        end
                        gosub get.token  ;* Skip MAT

                        if look.ahead.token # TKN.NAME then
                           del func.stack<1>
                           err.msg = sysmsg(2856) ;* Matrix name required
                           goto error
                        end

                        gosub get.token
                        symbol.name = token.string
                        symbol.mode = SYM.ARG
                        gosub find.var

                        if (symbol.var.no < 0) or (symbol.dim = 0) then
                           del func.stack<1>
                           err.msg = sysmsg(2856) ;* Matrix name required
                           goto error
                        end

                        gosub emit.var.load
                     end else   ;* Not a matrix argument
                        if upcase(look.ahead.token.string) = 'MAT' then
                           del func.stack<1>
                           err.msg = sysmsg(2855) ;* Argument type mismatch in function call
                           goto error
                        end

                        symbol.mode = SYM.ARG
                        gosub exprf
                        symbol.mode = SYM.USE  ;* 0347
                        if err then
                           del func.stack<1>
                           return
                        end
                     end

                  while look.ahead.token = TKN.COMMA

                     gosub get.token
                  repeat

                  if look.ahead.token # TKN.RBR then
                     del func.stack<1>
                     goto err.rbr
                  end
               end

               gosub get.token  ;* Skip bracket

               * Check argument count

               func.index = func.stack<1,1>
               func.arg.count = func.stack<1,2>
               del func.stack<1>

               if not(functions<5,func.index>) then
                  function.args = functions<3,func.index>
                  if len(function.args) # func.arg.count then
                     err.msg = sysmsg(2857) ;* Argument count mismatch in function call
                     goto error
                  end
               end

               if functions<4,func.index> # '' then func.arg.count += 1
               func.arg.count += 1  ;* Allow for return argument

               if functions<2,func.index> # '' then  ;* External function
                  * Emit call
                  if print.code then
                     s = "CALL     (" : func.arg.count : " arguments)"
                     gosub show.code
                  end

                  opcode.byte = OP.CALL ; gosub emit
                  opcode.byte = func.arg.count ; gosub emit
               end else                               ;* Internal function
                  label.name = functions<1,func.index>
                  opcode.byte = OP.GOSUB
                  gosub emit.jump
               end

               gosub emit.function.result.load

               return
            end

            * Try as an intrinsic function.  If we don't recognise it
            * we will jump to not.an.intrinsic.

            * If we are in case sensitive mode, map the symbol to uppercase
            * as intrinsics have uppercase names.

            if bittest(mode, M.CASE.SENSITIVE) then x.symbol.name = upcase(symbol.name)
            else x.symbol.name = symbol.name

            locate x.symbol.name in intrinsics<1> by 'AL' setting i else
               * Try restricted functions if in internal mode
               if internal then
                  locate x.symbol.name in int.intrinsics<1> by 'AL' setting i then
                     gosub get.token           ; * Skip left bracket
                     intrinsic.stack = int.intrinsic.opcodes<i> : @fm : intrinsic.stack 
                     on i goto in.none,       ;* ABORT.CAUSE
                               in.two,        ;* AKMAP
                               in.one,        ;* ANALYSE
                               in.none,       ;* BREAK.COUNT
                               in.btree,      ;* BTREE
                               in.one,        ;* CHANGED
                               in.two,        ;* DEBUG.INFO
                               in.two,        ;* EVENTS
                               in.three,      ;* EXPANDHF
                               in.three,      ;* FCONTROL
                               in.two,        ;* FIND
                               in.one,        ;* FORMCSV
                               in.two,        ;* GETLOCKS
                               in.two,        ;* GRPSTAT
                               in.one,        ;* IS.SUBR
                               in.one,        ;* ISMV
                               in.two,        ;* KERNEL
                               in.none,       ;* LIST.COMMON
                               in.one,        ;* LOAD.OBJECT
                               in.one,        ;* LOADED
                               in.two,        ;* LOGIN
                               in.two,        ;* LOGIN.PORT
                               in.two,        ;* LOGOUT
                               in.one,        ;* OPTION
                               in.two,        ;* OSPATH
                               in.two,        ;* OSRENAME
                               in.three,      ;* PACKAGE
                               in.two,        ;* PCONFIG
                               in.none,       ;* PHANTOM
                               in.none,       ;* PROMPT
                               in.two,        ;* PTERM
                               in.one,        ;* PWCRYPT
                               in.none,       ;* READPKT
                               in.removef,    ;* REMOVEF
                               in.scan,       ;* SCAN
                               in.none,       ;* SORTDATA
                               in.sortnext,   ;* SORTNEXT
                               in.one         ;* TESTLOCK
                  end
               end
               goto not.an.intrinsic
            end

            gosub get.token           ; * Skip left bracket
            intrinsic.stack = intrinsic.opcodes<i> : @fm : intrinsic.stack 
            on i goto in.one,         ;* ABS
                      in.one,         ;* ABSS
                      in.two,         ;* ACCEPT.SOCKET.CONNECTION
                      in.one,         ;* ACOS
                      in.one,         ;* ALPHA
                      in.two,         ;* ANDS
                      in.one,         ;* ARG
                      in.none,        ;* ARGCT
                      in.one,         ;* ASCII
                      in.one,         ;* ASIN
                      in.one,         ;* ASSIGNED
                      in.one,         ;* ATAN
                      in.two,         ;* BINDKEY
                      in.two,         ;* BITAND
                      in.one,         ;* BITNOT
                      in.two,         ;* BITOR
                      in.two,         ;* BITRESET
                      in.two,         ;* BITSET
                      in.two,         ;* BITTEST
                      in.two,         ;* BITXOR
                      in.one,         ;* CATALOGUED
                      in.two,         ;* CATS
                      in.two,         ;* CCALL
                      in.change,      ;* CHANGE
                      in.one,         ;* CHAR
                      in.one,         ;* CHECKSUM
                      in.none,        ;* CHGPHANT
                      in.none,        ;* COL1
                      in.none,        ;* COL2
                      in.compare,     ;* COMPARE
                      in.one,         ;* CONFIG
                      in.five,        ;* CONNECT.PORT
                      in.three,       ;* CONVERT
                      in.one,         ;* COS
                      in.two,         ;* COUNT
                      in.two,         ;* COUNTS
                      in.create.socket.server, ;* CREATE.SERVER.SOCKET
                      in.one,         ;* CROP
                      in.csvdq,       ;* CSVDQ
                      in.none,        ;* DATE
                      in.two,         ;* DCOUNT
                      in.two,         ;* DECRYPT
                      in.delete,      ;* DELETE
                      in.one,         ;* DIR
                      in.two,         ;* DIV
                      in.one,         ;* DOWNCASE
                      in.one,         ;* DQUOTE
                      in.dtx,         ;* DTX
                      in.one,         ;* EBCDIC
                      in.two,         ;* ENCRYPT
                      in.enter.package, ;* ENTER.PACKAGE
                      in.one,         ;* ENV
                      in.two,         ;* EQS
                      in.exit.package,;* EXIT.PACKAGE
                      in.one,         ;* EXP
                      in.extract,     ;* EXTRACT
                      in.field,       ;* FIELD
                      in.field,       ;* FIELDS
                      in.five,        ;* FIELDSTORE
                      in.fvar.two,    ;* FILEINFO
                      in.two,         ;* FMT
                      in.two,         ;* FMTS
                      in.fold,        ;* FOLD
                      in.fold,        ;* FOLDS
                      in.two,         ;* GES
                      in.none,        ;* GET.MESSAGES
                      in.one,         ;* GET.PORT.PARAMS
                      in.one,         ;* GETNLS
                      in.two,         ;* GETPU
                      in.one,         ;* GETREM
                      in.two,         ;* GTS
                      in.two,         ;* ICONV
                      in.two,         ;* ICONVS
                      in.two,         ;* IDIV
                      in.three,       ;* IFS
                      in.three,       ;* INDEX
                      in.three,       ;* INDEXS
                      in.indices,     ;* INDICES
                      in.inmat,       ;* INMAT      (Special case for matrix name)
                      in.one,         ;* INPUTBLK
                      in.insert,      ;* INSERT
                      in.one,         ;* INT
                      in.itype,       ;* ITYPE
                      in.keyin,       ;* KEYCODE
                      in.keyin,       ;* KEYIN
                      in.keyin,       ;* KEYINC
                      in.keyin,       ;* KEYINR
                      in.none,        ;* KEYREADY
                      in.one,         ;* LEN
                      in.one,         ;* LENS
                      in.two,         ;* LES
                      in.three,       ;* LISTINDEX
                      in.one,         ;* LN
                      in.locate,      ;* LOCATE
                      in.one,         ;* LOWER
                      in.two,         ;* LTS
                      in.three,       ;* MATCHFIELD
                      in.two,         ;* MAX
                      in.one,         ;* MAXIMUM
                      in.two,         ;* MIN
                      in.one,         ;* MINIMUM
                      in.two,         ;* MOD
                      in.two,         ;* MODS
                      in.one,         ;* NEG
                      in.one,         ;* NEGS
                      in.two,         ;* NES
                      in.one,         ;* NOT
                      in.one,         ;* NOTS
                      in.one,         ;* NUM
                      in.one,         ;* NUMS
                      in.object,      ;* OBJECT
                      in.two,         ;* OBJINFO
                      in.two,         ;* OCONV
                      in.two,         ;* OCONVS
                      in.open.socket, ;* OPEN.SOCKET
                      in.two,         ;* ORS
                      in.none,        ;* OS.ERROR
                      in.three,       ;* OUTERJOIN
                      in.three,       ;* PRINTER.SETTING
                      in.two,         ;* PWR
                      in.one,         ;* QUOTE
                      in.one,         ;* RAISE
                      in.two,         ;* RDIV
                      in.four,        ;* READ.SOCKET
                      in.fvar.two,    ;* RECORDLOCKED
                      in.two,         ;* REM
                      in.remove,      ;* REMOVE
                      in.replace,     ;* REPLACE
                      in.one,         ;* REUSE
                      in.one,         ;* RND
                      in.trans,       ;* RTRANS
                      in.four,        ;* SAVE.SCREEN
                      in.two,         ;* SELECTINFO
                      in.sentence,    ;* SENTENCE
                      in.one,         ;* SEQ
                      in.one,         ;* SERVER.ADDR
                      in.two,         ;* SET.PORT.PARAMS
                      in.three,       ;* SET.SOCKET.MODE
                      in.two,         ;* SHIFT
                      in.one,         ;* SIN
                      in.two,         ;* SOCKETINFO
                      in.one,         ;* SOUNDEX
                      in.one,         ;* SOUNDEXS
                      in.one,         ;* SPACE
                      in.one,         ;* SPACES
                      in.three,       ;* SPLICE
                      in.one,         ;* SQRT
                      in.one,         ;* SQUOTE
                      in.none,        ;* STATUS
                      in.two,         ;* STR
                      in.two,         ;* STRS
                      in.subr,        ;* SUBR
                      in.subst,       ;* SUBSTITUTE
                      in.three,       ;* SUBSTRINGS
                      in.one,         ;* SUM
                      in.one,         ;* SUMMATION
                      in.change,      ;* SWAP
                      in.one,         ;* SWAPCASE
                      in.sysmsg,      ;* SYSMSG
                      in.one,         ;* SYSTEM
                      in.one,         ;* TAN
                      in.terminfo,    ;* TERMINFO
                      in.none,        ;* TIME
                      in.none,        ;* TIMEDATE
                      in.trans,       ;* TRANS
                      in.trim,        ;* TRIM
                      in.one,         ;* TRIMB
                      in.one,         ;* TRIMBS
                      in.one,         ;* TRIMF
                      in.one,         ;* TRIMFS
                      in.trim,        ;* TRIMS
                      in.none,        ;* TTYGET
                      in.one,         ;* UMASK
                      in.one,         ;* UNASSIGNED
                      in.one,         ;* UPCASE
                      in.one,         ;* VARTYPE
                      in.two,         ;* VSLICE
                      in.four,        ;* WRITE.SOCKET
                      in.trans,       ;* XLATE
                      in.one          ;* XTD

in.one:
            gosub exprf
            goto intrinsic.common

in.two:
            arg.count = 2 ; gosub get.args
            goto intrinsic.common

in.three:
            arg.count = 3 ; gosub get.args
            goto intrinsic.common

in.four:
            arg.count = 4 ; gosub get.args
            goto intrinsic.common

in.five:
            arg.count = 5 ; gosub get.args
            goto intrinsic.common

in.six:
            arg.count = 6 ; gosub get.args
            goto intrinsic.common

in.seven:
            arg.count = 7 ; gosub get.args
            goto intrinsic.common

*** BTREE()  First is key count, second is one dimensional array
in.btree:
            gosub expr
            gosub check.comma
            if look.ahead.token # TKN.NAME then
               gosub err.var
               return
            end
            gosub get.token
            symbol.name = token.string
            gosub find.var
            if (symbol.var.no < 0) or (symbol.dim # 1) then
               err.msg = sysmsg(2858) ;* One dimensional matrix name required
               goto error
            end
            gosub emit.var.load
            goto intrinsic.common

*** CHANGE()   3, 4 or 5 arguments. Arg 4 defaults to -1, arg 5 to 1
in.change:
            arg.count = 3 ; gosub get.args

            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
            end else
               n = -1 ; gosub emit.numeric.load
            end

            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
            end else
               n = 1 ; gosub emit.numeric.load
            end
            goto intrinsic.common

*** COMPARE()   2 or 3 arguments, absent arg defaults to "L"
in.compare:
            arg.count = 2 ; gosub get.args
            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
            end else
               opcode.string = "L" ; gosub emit.string.load
            end
            goto intrinsic.common

*** CREATE.SOCKET.SERVER   2 or 3 arguments, absent arg defaults to zero.
in.create.socket.server:
            arg.count = 2 ; gosub get.args
            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
            end else
               n = 0 ; gosub emit.numeric.load
            end
            goto intrinsic.common


*** CSVDQ()  1 or 2 arguments, arg 2 defaulting to a comma
in.csvdq:
            gosub exprf
            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
            end else
               opcode.string = ',' ; gosub emit.string.load
            end
            goto intrinsic.common

*** DELETE()   2, 3 or 4 arguments. Absent args default to zero
*** EXTRACT()   2, 3 or 4 arguments. Absent args default to zero
in.delete:
in.extract:
            arg.count = 2 ; gosub get.args

            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
            end else
               n = 0 ; gosub emit.numeric.load
            end

            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
            end else
               n = 0 ; gosub emit.numeric.load
            end

            goto intrinsic.common

*** DTX()  1 or 2 arguments. Second defaults to 0 if omitted.
in.dtx:
            gosub expr        ;* Value to convert

            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub expr
            end else
               n = 0 ; gosub emit.numeric.load
            end
            goto intrinsic.common

in.enter.package:
            gosub exprf
            n = 1 ; gosub emit.numeric.load   ;* Mode
            n = 0 ; gosub emit.numeric.load   ;* Qualifier (unused)
            goto intrinsic.common

in.exit.package:
            gosub exprf
            n = 0 ; gosub emit.numeric.load   ;* Mode
            n = 0 ; gosub emit.numeric.load   ;* Qualifier (unused)
            goto intrinsic.common

*** FIELD()   3 or 4 arguments, absent arg defaults to 1
in.field:
            arg.count = 3 ; gosub get.args
            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
            end else
               n = 1 ; gosub emit.numeric.load
            end
            goto intrinsic.common

*** FILEINFO()       } Two args, first is file variable
*** RECORDLOCKED()   }
in.fvar.two:
            gosub convert.pick.file.reference
            gosub expr
            gosub check.comma
            gosub exprf
            goto intrinsic.common

*** FOLD()/FOLDS()  Two or three arguments
in.fold:
            arg.count = 2 ; gosub get.args
            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
               * Replace opcode on intrinsic stack
               if intrinsic.stack<1> = OP.FOLD then
                  intrinsic.stack<1> = OP.FOLD3
               end else
                  intrinsic.stack<1> = OP.FOLDS3
               end
            end
            goto intrinsic.common
            
*** INDICES()  One or two args (different opcode required)
in.indices:
            gosub convert.pick.file.reference
            gosub expr

            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
               intrinsic.stack<1> = OP.INDICES2
            end
            goto intrinsic.common

*** INMAT()  No args or one arg as matrix name (different opcode required)
in.inmat:
            if look.ahead.token # TKN.NAME then goto intrinsic.common

            gosub get.token
            symbol.name = token.string
            gosub find.var
            if (symbol.var.no < 0) or (symbol.dim = 0) then
               err.msg = sysmsg(2860) ;* Matrix name required
               goto error
            end
            gosub emit.var.load

            opcode.byte = OP.INMATA
            gosub emit.simple
            goto intrinsic.end

*** ITYPE()   1 or 2 args. 2 arg version only allowed in internal mode
in.itype:
            gosub expr        ;* Itype expression

            if look.ahead.token = TKN.COMMA and internal then
               intrinsic.stack<1> = OP.ITYPE2

               * Process second argument (TOTAL() function count)
               gosub get.token
               gosub expr
            end
            goto intrinsic.common

*** KEYIN()  No args or one arg as timeout value (different opcode required)
*** KEYINC()
*** KEYCODE()
in.keyin:
            if look.ahead.token = TKN.RBR then goto intrinsic.common

            gosub expr

            i = intrinsic.stack<1>
            begin case
               case i = OP.KEYIN   ; intrinsic.stack<1> = OP.KEYINT
               case i = OP.KEYINC  ; intrinsic.stack<1> = OP.KEYINCT
               case i = OP.KEYCODE ; intrinsic.stack<1> = OP.KEYCODET
               case i = OP.KEYINR  ; intrinsic.stack<1> = OP.KEYINRT
            end case
            goto intrinsic.common

*** OBJECT()  Object name plus optional arguments.
in.object:
            gosub exprf
            ins "0" before func.stack<1>  ;* Track arg count
            loop
            while look.ahead.token = TKN.COMMA
               func.stack<1> = func.stack<1> + 1
               gosub get.token
               gosub exprf
            until err
            repeat

            if print.code then
               s = "OBJECT   (" : func.stack<1> : " additional arguments)"
               gosub show.code
            end

            opcode.byte = intrinsic.stack<1> ; gosub emit.simple
            opcode.byte = func.stack<1> + 0 ; gosub emit.simple
            del func.stack<1>
            if err then return
            goto intrinsic.end

*** OPEN.SOCKET()   3 or 4 arguments, absent arg defaults to 0
in.open.socket:
            arg.count = 3 ; gosub get.args
            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
            end else
               n = 0 ; gosub emit.numeric.load
            end
            goto intrinsic.common

*** REMOVE()   2 args, second must be simple var reference
in.remove:
            gosub exprf                ;* Source item
            gosub check.comma
            gosub simple.lvar.reference     ;* Emit delimiter variable reference
            goto intrinsic.common

*** REMOVEF()   1 or 2 args, second defaults to one
in.removef:
            gosub exprf                ;* Source item

            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
            end else
               n = 1 ; gosub emit.numeric.load
            end
            goto intrinsic.common

*** INSERT()  3, 4 or 5 args, args 2 and 4 default to zero
*** REPLACE()  3, 4 or 5 args, args 2 and 4 default to zero
***          final arg may have semicolon delimiter.
in.insert:
            if bittest(mode, M.COMPAT.APPEND) then intrinsic.stack<1> = OP.COMPINSRT
            goto in.ins.rep
in.replace:
            if bittest(mode, M.COMPAT.APPEND) then intrinsic.stack<1> = OP.COMPREPLC
in.ins.rep:
            arg.count = 2       ;* Source string and field number
            gosub get.args

            if look.ahead.token = TKN.COMMA then    ;* Value number present
               gosub get.token
               gosub exprf
            end else
               n = 0 ; gosub emit.numeric.load
            end

            if look.ahead.token = TKN.COMMA then    ;* Subvalue number present
               gosub get.token
               gosub exprf
            end else
               n = 0 ; gosub emit.numeric.load
            end

            if (look.ahead.token # TKN.COMMA) and (look.ahead.token # TKN.SEMICOLON) then
               err.msg = sysmsg(2861) ;* Expected comma or semicolon
               goto error
            end

            gosub get.token
            gosub exprf                ;* New string value
            goto intrinsic.common

*** LOCATE()  3, 4 or 5 args. Final arg may have semicolon delimiter.
in.locate:
            arg.count = 3       ;* Search string, dynamic array, field pos
            gosub get.args

            if look.ahead.token = TKN.COMMA then    ;* Value number present
               gosub get.token
               gosub exprf
            end else
               n = 0 ; gosub emit.numeric.load
            end

            if look.ahead.token = TKN.COMMA then    ;* Subvalue number present
               gosub get.token
               gosub exprf
            end else
               n = 0 ; gosub emit.numeric.load
            end

            if (look.ahead.token = TKN.COMMA) or (look.ahead.token = TKN.SEMICOLON) then
               gosub get.token
               gosub exprf                ;* Order code
            end else
               opcode.string = '' ; gosub emit.string.load
            end

            goto intrinsic.common

*** SCAN()  Two variants:
*                 SCAN(var)            Use OP.BTSCAN
*                 SCAN(var, matrix)    Use OP.BTSCANA
in.scan:
            gosub exprf
            if look.ahead.token # TKN.COMMA then goto intrinsic.common
            gosub get.token         ;* Skip comma
            if look.ahead.token # TKN.NAME then
               gosub err.var
               return
            end
            gosub get.token
            symbol.name = token.string
            gosub find.var
            if (symbol.var.no < 0) or (symbol.dim # 1) then
               err.msg = sysmsg(2858) ;* One dimensional matrix name required
               goto error
            end
            gosub emit.var.load
            opcode.byte = OP.BTSCANA ; gosub emit.simple
            goto intrinsic.end

*** SENTENCE()
in.sentence:
            n = syscom.sentence ; gosub emit.ldsysv
            goto intrinsic.end

*** SORTNEXT()
in.sortnext:
            if look.ahead.token # TKN.NAME then
               gosub err.var
               return
            end
            gosub get.token
            symbol.name = token.string
            symbol.mode = SYM.SET
            gosub find.var
            if (symbol.var.no < 0) or (symbol.dim # 1) then
               err.msg = sysmsg(2858) ;* One dimensional matrix name required
               goto error
            end
            gosub emit.var.load
            opcode.byte = OP.SORTNEXT ; gosub emit.simple
            goto intrinsic.end

*** SUBR(name [, arg1 [,arg2...]])
in.subr:
            gosub expr   ;* Subroutine name expression

            gosub emit.function.return.argument  ;* Emit return argument

            ins "1" before func.stack<1>  ;* Track arg count
            loop
            while look.ahead.token = TKN.COMMA
               func.stack<1> = func.stack<1> + 1
               gosub get.token  ;* Skip comma
               gosub exprf
               if err then
                 del func.stack<1>
                 return
               end
            repeat

            * Emit call

            func.arg.count = func.stack<1> + 0
            del func.stack<1>

            if print.code then
               s = "CALL     (" : func.arg.count : " arguments)"
               gosub show.code
            end

            opcode.byte = OP.CALL ; gosub emit
            opcode.byte = func.arg.count ; gosub emit
            gosub emit.function.result.load  ;* Load result
            goto intrinsic.end

*** SUBSTITUTE()   3 or 4 arguments, absent arg defaults to @vm
in.subst:
            arg.count = 3 ; gosub get.args
            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub expr
            end else
               opcode.string = @vm ; gosub emit.string.load
            end
            goto intrinsic.common

*** SYSMSG()  1 to 4 arguments
in.sysmsg:  gosub expr          ;* Emit message number
            if look.ahead.token # TKN.COMMA then
               n = 0
               goto in.sysmsg.end
            end

            * Much as a loop look attractive, we must allow for the
            * unlikely case of recursive SYSMSG() usage.

            gosub get.token     ;* Skip comma
            gosub expr          ;* Emit first substitution parameter
            if look.ahead.token # TKN.COMMA then
               n = 1
               goto in.sysmsg.end
            end

            gosub get.token     ;* Skip comma
            gosub expr          ;* Emit second substitution parameter
            if look.ahead.token # TKN.COMMA then
               n = 2
               goto in.sysmsg.end
            end

            gosub get.token     ;* Skip comma
            gosub expr          ;* Emit third substitution parameter
            if look.ahead.token # TKN.COMMA then
               n = 3
               goto in.sysmsg.end
            end

            gosub get.token     ;* Skip comma
            gosub expr          ;* Emit fourth substitution parameter
            n = 4

in.sysmsg.end:
            if print.code then
               s = "SYSMSG   " : n
               gosub show.code
            end

            opcode.byte = OP.SYSMSG ; gosub emit
            opcode.byte = n ; gosub emit
            goto intrinsic.end

*** TERMINFO()  No args or one arg (terminfo capability name)
in.terminfo:
            if look.ahead.token # TKN.RBR then
               arg.count = 1
               gosub get.args
            end else
               opcode.string = ''
               gosub emit.string.load
            end

            goto intrinsic.common

in.trans:
            if (look.ahead.token = TKN.NAME) and (upcase(look.ahead.token.string) = "DICT") then
               gosub get.token
               opcode.string = 'DICT ' ; gosub emit.string.load
               gosub exprf                     ;* Process file name expression
               opcode.byte = OP.CAT    ; gosub emit.simple
            end else
               gosub exprf                     ;* Process file name expression
            end

            gosub check.comma
            gosub exprf                     ;* ID expression
            gosub check.comma
            gosub exprf                     ;* Field number expression
            gosub check.comma
            gosub exprf                          ;* Code expression
            goto intrinsic.common

*** TRIM()   1, 2 or 3 args
in.trim:
            gosub exprf                ;* Source item

            if look.ahead.token # TKN.COMMA then   ;* TRIM(s)
               goto intrinsic.common
            end

            if intrinsic.stack<1> = OP.TRIM then   ;* TRIM -> TRIMX
               intrinsic.stack<1> = OP.TRIMX
            end else                               ;* TRIMS -> TRIMXS
               intrinsic.stack<1> = OP.TRIMXS
            end

            * Process second argument (trim character)
            gosub get.token
            gosub exprf

            * Look for optional third argument, defaulting to null string
            if look.ahead.token = TKN.COMMA then
               gosub get.token
               gosub exprf
            end else
               opcode.string = '' ; gosub emit.string.load
            end

            goto intrinsic.common

in.none:
intrinsic.common:
            opcode.byte = intrinsic.stack<1>
            gosub emit.simple

intrinsic.end:
            del intrinsic.stack<1>

intrinsic.end.check:
            if look.ahead.token # TKN.RBR then goto err.rbr

            gosub get.token      ;* Skip right bracket

            return

not.an.intrinsic:
            * Is it a FILE reference?

            if not(lvar) and symbol.var.no >= 0 and file.refs # '' then
               if look.ahead.token = TKN.LBR then
                  locate upcase(symbol.name) in file.refs<1> setting pos then
                     gosub get.token   ;* Skip bracket
                     gosub get.token   ;* Get field name

                     locate token.string in file.fields<pos,1> setting vpos then
                        fno = file.fld.nums<pos,vpos>
                     end else
                        gosub get.file.ref
                        if err then return
                     end

                     symbol.name = file.refs<pos>
                     symbol.mode = SYM.USE
                     gosub find.var

                     gosub emit.var.load
                     n = fno ; gosub emit.numeric.load
                     n = 0 ; gosub emit.numeric.load
                     n = 0 ; gosub emit.numeric.load
                     opcode.byte = OP.EXTRACT ; gosub emit.simple                  

                     if look.ahead.token # TKN.RBR then goto err.rbr
                     gosub get.token   ;* Skip bracket

                     return
                  end
               end
            end

!2.3-3      err.msg = sysmsg(2862, symbol.name) ;* Unrecognised function xx
!2.3-3      gosub error
         end  ;* if function.allowed

         * The symbol doesn't seem to be a function so assume that it
         * is a yet to be dimensioned matrix.

         symbol.mode = if lvar then SYM.SET else SYM.USE
         symbol.dim = -1          ;* Indicate not yet known
         symbol.common.offset = -1
         gosub make.var
      end     ;* if possible.function (i.e. was TKN.LBR)
   end

   if symbol.var.no < 0 then   ;* Don't know this variable
      * Create new variable

      symbol.mode = saved.symbol.mode   ;* Restore for variable creation
      symbol.common.offset = -1
      symbol.dim = 0
      if lvar then symbol.mode = SYM.SET
      gosub make.var
   end

   * Generate LDLCL or LDCOM

   gosub emit.var.load

   * Is it an array reference?

   if symbol.dim # 0 then
     if look.ahead.token = TKN.LBR then     ;* Subscript present
        gosub get.token     ;* Skip left bracket

        * Generate indexing code and check right number of dimensions

        ins symbol.dim before matrix.stack<1>   ;* 0181  Stack dimension...
        gosub exprf
        symbol.dim = matrix.stack<1>            ;* 0181  ...and restore
        del matrix.stack<1>

        if look.ahead.token = TKN.COMMA then  ;* Two indices present

           gosub get.token           ;* Skip comma
           gosub exprf
           opcode.byte = OP.INDX2
           gosub emit.simple
        end else                              ;* Only one index present
           opcode.byte = OP.INDX1
           gosub emit.simple
        end

        if look.ahead.token # TKN.RBR then goto err.rbr

        gosub get.token
     end else                               ;* No subscript present
        err.msg = sysmsg(2867) ;* Matrix reference requires index
        goto error
     end
   end

   return

*****************************************************************************
* get.numeric.constant  -  Returns n as numeric value
*
* Returns:
*   n = value
*   gnc.err = error flag (Message will already have been emited)

get.numeric.constant:
   unary.minus = @FALSE
   gnc.err = @false
   gosub get.token

gnc.again:
   begin case
      case token = TKN.NAME
         s = find(defined.tokens, token.string)
         if not(status()) then
            n = s[1,1] + 0
            begin case
               case n = 0  ;* String
                  if num(s[2,99999]) then n = s[2,99999] + 0
                  else
                     err.msg = sysmsg(2868) ;* Numeric constant required
                     gosub error
                     gnc.err = @true
                  end

               case n = 1  ;* Number token
                  n = s[2, 99999] + 0

               case 1
                  err.msg = sysmsg(2868) ;* Numeric constant required
                  gosub error
                  gnc.err = @true
            end case
         end

      case token = TKN.NUM
         n = token.string + 0
         if unary.minus then
            n = -n
            unary.minus = @false
         end

      case token = TKN.HEXNUM
         n = xtd(token.string)
         if unary.minus then
            n = -n
            unary.minus = @false
         end

      case token = TKN.STRING
         if num(token.string) then n = token.string + 0
         else
            err.msg = sysmsg(2868) ;* Numeric constant required
            gosub error
            gnc.err = @true
         end

      case token = TKN.PLUS               ;* Unary plus
         gosub get.token
         goto gnc.again

      case token = TKN.MINUS              ;* Unary minus
         unary.minus = not(unary.minus)
         gosub get.token
         goto gnc.again

      case 1
         err.msg = sysmsg(2868) ;* Numeric constant required
         gosub error
         gnc.err = @true
   end case

   return

*****************************************************************************
* EMIT.VAR.LOAD  -  Emit LDLCL or LDCOM for var in SYMBOL.VAR.NO etc

emit.var.load:
   if symbol.common.offset >= 0 then   ;* Common variable
      if commons<7,symbol.common.index,symbol.common.offset> then
         symbol.var.no = commons<7,symbol.common.index,symbol.common.offset>
         symbol.name = commons<4,symbol.common.index,symbol.common.offset>
      end else
         if print.code then
            s = "LDCOM    " : symbol.var.no : ", " : symbol.name
            gosub show.code
         end

         opcode.byte = OP.LDCOM
         gosub emit

         code.value = symbol.var.no
         code.bytes = 2
         gosub emit.multibyte.value

         code.value = symbol.common.offset
         code.bytes = 2
         gosub emit.multibyte.value
         return
      end
   end

   * Local variable

   if symbol.var.no < 256 then       ;* Use LDSLCL
      if print.code then
         s = "LDSLCL   " : symbol.name
         gosub show.code
      end

      opcode.byte = OP.LDSLCL
      gosub emit
      opcode.byte = symbol.var.no
      gosub emit
   end else                          ;* Use LDLCL
      if print.code then
         s = "LDLCL    " : symbol.name
         gosub show.code
      end

      opcode.byte = OP.LDLCL
      gosub emit
      code.value = symbol.var.no
      code.bytes = 2
      gosub emit.multibyte.value
   end

   return

*****************************************************************************
* EMIT.AT.VAR.LOAD  -  Emit code to load an @variable

emit.at.var.load:
   locate u.token.string in at.constants<1> setting i then
      on i goto at.mark,at.mark,at.mark,at.mark,at.mark,at.mark,at.mark,
           at.false,
           at.true,
           at.qmsys,
           at.userno,
           at.userno,
           at.day,
           at.month,
           at.year,
           at.year4,
           at.lptrhigh,
           at.lptrwide,
           at.crthigh,
           at.crtwide,
           at.level,
           at.term.type,
           at.transaction.id,
           at.transaction.level,
           at.ip.addr,
           at.hostname,
           at.gid,
           at.uid
               
at.mark:                                    ;* FM, VM, SM, TM, IM, AM, SVM
      opcode.string = mark.chars[i,1] ; gosub emit.string.load
      return

at.false:
      n = 0 ; gosub emit.numeric.load
      return

at.true:
      n = 1 ; gosub emit.numeric.load
      return

at.qmsys:                                   ;* @QMSYS  -  QMSYS pathname
      opcode.byte = OP.SYSDIR ; gosub emit.simple
      return

at.userno:                                  ;* @USERNO
      opcode.byte = OP.USERNO ; gosub emit.simple
      return

at.day:                                     ;* @DAY
      n = syscom.cproc.date ; gosub emit.ldsysv
      opcode.string = "DD" ; gosub emit.string.load
      opcode.byte = OP.OCONV ; gosub emit.simple
      return

at.month:                                   ;* @MONTH
      n = syscom.cproc.date ; gosub emit.ldsysv
      opcode.string = "DM[2]" ; gosub emit.string.load
      opcode.byte = OP.OCONV ; gosub emit.simple
      return

at.year:                                    ;* @YEAR
      n = syscom.cproc.date ; gosub emit.ldsysv
      opcode.string = "D2Y" ; gosub emit.string.load
      opcode.byte = OP.OCONV ; gosub emit.simple
      return

at.year4:                                   ;* @YEAR4
      n = syscom.cproc.date ; gosub emit.ldsysv
      opcode.string = "D4Y" ; gosub emit.string.load
      opcode.byte = OP.OCONV ; gosub emit.simple
      return

at.lptrhigh:
      n = K$LPTRHIGH ; gosub emit.numeric.load
      n = 0 ; gosub emit.numeric.load
      opcode.byte = OP.KERNEL ; gosub emit.simple
      return

at.lptrwide:
      n = K$LPTRWIDE ; gosub emit.numeric.load
      n = 0 ; gosub emit.numeric.load
      opcode.byte = OP.KERNEL ; gosub emit.simple
      return

at.crthigh:
      n = K$CRTHIGH ; gosub emit.numeric.load
      n = 0 ; gosub emit.numeric.load
      opcode.byte = OP.KERNEL ; gosub emit.simple
      return

at.crtwide:
      n = K$CRTWIDE ; gosub emit.numeric.load
      n = 0 ; gosub emit.numeric.load
      opcode.byte = OP.KERNEL ; gosub emit.simple
      return

at.level:
      n = K$CPROC.LEVEL ; gosub emit.numeric.load
      n = 0 ; gosub emit.numeric.load
      opcode.byte = OP.KERNEL ; gosub emit.simple
      return

at.term.type:
      n = K$TERM.TYPE ; gosub emit.numeric.load
      opcode.byte = OP.LDNULL ; gosub emit.simple
      opcode.byte = OP.KERNEL ; gosub emit.simple
      return

at.transaction.id:
      n = 1007 ; gosub emit.numeric.load
      opcode.byte = OP.SYSTEM ; gosub emit.simple
      return

at.transaction.level:
      n = 1008 ; gosub emit.numeric.load
      opcode.byte = OP.SYSTEM ; gosub emit.simple
      return

at.ip.addr:
      n = 42 ; gosub emit.numeric.load
      opcode.byte = OP.SYSTEM ; gosub emit.simple
      return

at.hostname:
      n = 1015 ; gosub emit.numeric.load
      opcode.byte = OP.SYSTEM ; gosub emit.simple
      return

at.gid:
      n = 29 ; gosub emit.numeric.load
      opcode.byte = OP.SYSTEM ; gosub emit.simple
      return

at.uid:
      n = 27 ; gosub emit.numeric.load
      opcode.byte = OP.SYSTEM ; gosub emit.simple
      return
   end

   * Not a constant @ token, try the SYSCOM variables.

   gosub emit.at.value

   return

* *****************************************************************************
*  Emit LDSYS for @variable as lvalue (name in token)

emit.at.lvalue: 
   locate u.token.string in at.syscom.vars<1> setting i then
      if not(internal) then  ;* Check can be used as lvalue
         locate u.token.string in at.syscom.lvars<1> setting j else goto err.at.lvar
      end

      n = at.syscom.offsets<i>
      sysv.index = field(n, '.', 2)
      n = field(n, '.', 1)
      gosub emit.ldsys

      * Is this a reference to an array element?

      if sysv.index # '' then
         n = sysv.index ; gosub emit.numeric.load
         opcode.byte = OP.INDX1 ; gosub emit.simple
      end
   end else
      goto err.at.var
   end

   return

* *****************************************************************************
*  Emit LDSYS or LDSYSV for @variable (name in token)

emit.at.value:
   locate u.token.string in at.syscom.vars<1> setting i then
      n = at.syscom.offsets<i>

      if internal then gosub emit.ldsys
      else
         locate u.token.string in at.syscom.lvars<1> setting i then gosub emit.ldsys
         else gosub emit.ldsysv
      end
   end else
      goto err.at.var
   end

   return

* *****************************************************************************
* Emit LDSYSV opcode, offset is in n
* Emit LDSYS opcode, offset is in n

emit.ldsysv:
   ldsys.opcode = OP.LDSYSV
   s = 'LDSYSV   '
   goto emit.ldsys.common

emit.ldsys:
   ldsys.opcode = OP.LDSYS
   s = 'LDSYS    '

emit.ldsys.common:
   sysv.index = field(n, '.', 2)
   n = field(n, '.', 1)

   if print.code then
      s := n
      gosub show.code
   end

   opcode.byte = ldsys.opcode ; gosub emit
   opcode.byte = n ; gosub emit

   * Is this a reference to an array element?

   if sysv.index # '' then
      n = sysv.index ; gosub emit.numeric.load
      opcode.byte = OP.INDX1 ; gosub emit.simple
   end

   return

*****************************************************************************
* EMIT.TEMP.REF  -  Emit load of temporary variable N

emit.temp.ref:
   symbol.name = '__':n
   symbol.mode = SYM.SET
   gosub find.var
   if symbol.var.no < 0 then
      symbol.dim = 0
      gosub make.var
   end
   gosub emit.var.load
   return

*****************************************************************************
* EMIT.NUMERIC.LOAD  -  Emit LDSINT or LDLINT
* Value to load is in N and is not changed

emit.numeric.load:
   if vartype(n) = V$FLOATNUM then   ;* 0087
      if print.code then
         * Show the code to be generated
         s = "LDFLOAT  ":n
         gosub show.code
      end

      * Emit LDFLOAT opcode
      opcode.byte = OP.LDFLOAT
      gosub emit
      code.image[pc+1, 8] = iconv(n, 'IFL')
      pc += 8

      return
   end

   if (n > -129) and (n < 128) then     ;* Use LDSINT or LD0/LD1
      if n = 0 then
         opcode.byte = OP.LD0 ; gosub emit.simple
         return
      end

      if n = 1 then
         opcode.byte = OP.LD1 ; gosub emit.simple
         return
      end

      if print.code then
         * Show the code to be generated
         s = "LDSINT   ":n
         gosub show.code
      end

      * Emit LDSINT opcode
      opcode.byte = OP.LDSINT ; gosub emit
      opcode.byte = n ; gosub emit
   end else                         ;* Use LDLINT
      if print.code then
         * Show the code to be generated
         s = "LDLINT   ":n
         gosub show.code
      end

      * Emit LDLINT opcode
      opcode.byte = OP.LDLINT ; gosub emit
      code.value = n ; code.bytes = 4 ; gosub emit.multibyte.value
   end

  return

*****************************************************************************
* EMIT.STRING.LOAD  -  Emit string in OPCODE.STRING

emit.string.load:
   if len(opcode.string) = 0 then
      opcode.byte = OP.LDNULL
      gosub emit.simple
   end else
      * If the string is less than 256 characters long we can load it in
      * one go. Otherwise we must concatenate short chunks.

      k = @false           ;* K is true for second and subsequent fragments
      loop
         n = len(opcode.string)
         if n > 255 then n = 255

         if print.code then
            s = 'LDSTR    "' : oconv(opcode.string[1, 60], 'MCP')
            if n <= 60 then s := '"'
            gosub show.code
         end

         opcode.byte = OP.LDSTR ; gosub emit
         opcode.byte = n ; gosub emit
         code.image[pc+1, n] = opcode.string
         pc += n
         if k then
            * Emit a CAT opcode
            opcode.byte = OP.CAT ; gosub emit.simple
         end
         k = @true
         opcode.string = opcode.string[n + 1, len(opcode.string)]
      while len(opcode.string) > 0
         n = len(opcode.string) + 300
         if pc + n >= code.size then
            code.size += n
            code.image := str(char(0), n)
         end
      repeat
   end

   return

*****************************************************************************
* EMIT.SIMPLE - Emit a simple opcode
* Opcode is in OPCODE.BYTE

emit.simple:
   if opcode.byte > 256 then
      prefixed.opcode = opcode.byte

      if print.code then
         * Show the code to be generated

         locate prefixed.opcode in prefixed.opcode.values<1,1> setting ppos then
            s = prefixed.opcodes<1,ppos>
         end else
            s = 'OP_' : oconv(prefixed.opcode, 'MX')
         end
         gosub show.code
      end

      opcode.byte = shift(prefixed.opcode, 8)
      gosub emit

      opcode.byte = bitand(prefixed.opcode, 255)
      gosub emit

      return
   end

   if print.code then
      * Show the code to be generated
      s = opcodes<1,opcode.byte + 1>
      gosub show.code
   end

*********************************************
***** FALL THROUGH FROM ABOVE INTO EMIT *****
*********************************************

**********************************************************************
* EMIT  -  Emit byte from OPCODE.BYTE

emit:
   pc += 1   ;* Do increment first as we need PC+1 to index code.image
   code.image[pc,1] = char(opcode.byte)

   return

**********************************************************************
* EMIT.MULTIBYTE.VALUE  -  Emit multi-byte value
* CODE.VALUE   = Value to emit
* CODE.BYTES   = Number of bytes

emit.multibyte.value:
   loop
      opcode.byte = bitand(code.value, 255)
      code.value = shift(code.value, 8)
      pc += 1
      code.image[pc,1] = char(opcode.byte)
      code.bytes -= 1
   while code.bytes
   repeat

   return

**********************************************************************
* UPDATE.CODE  -  Update memory image
* CODE.VALUE   = Value to emit
* CODE.BYTES = Number of bytes
* UPDATE.ADDR  = Code address of update

update.code:
   loop
      byte.value = char(bitand(code.value, 255))
      code.value = shift(code.value, 8)
      code.image[update.addr+1, 1] = byte.value
      update.addr += 1
      code.bytes -= 1
   while code.bytes
   repeat

   return

**********************************************************************
* SHOW.CODE  -  Report emitted code
* Code string is in S

show.code:
   list.rec = "         ":fmt(oconv(pc, "MX"), "6'0'R"):":       ":s
   gosub emit.listing

   return

*****************************************************************************
*****                   STATEMENT PROCESSING ROUTINES                   *****
*****************************************************************************

*****************************************************************************
* Various statements which take no qualifying information
*
* ST.AKRELEASE       - Release the AK record lock (restricted)
* ST.SORTCLEAR       - Clear the sort system (restricted)
* ST.PAUSE           - Pause until awoken

st.akrelease:
   opcode = OP.AKRELEASE
   goto no.arg.common

st.sortclear:
   opcode = OP.SORTCLR
   goto no.arg.common

no.arg.common:
   opcode.byte = opcode ; gosub emit.simple
   return

*****************************************************************************
* Various statements which take a single expression
*
* ST.DELETE.COMMON   -  DELETE.COMMON statement (restricted)
* ST.DELETELIST      -  DELETELIST statement
* ST.DISINHERIT      -  DISINHERIT
* ST.INHERIT         -  INHERIT
* ST.LOGMSG          -  LOGMSG
* ST.NAP             -  NAP
* ST.PRECISION       -  PRECISION statement
* ST.PRINTERR        -  PRINTERR statement
* ST.PROMPT          -  PROMPT statement
* ST.RESET.MODES     -  RESET.MODES statement (restricted)
* ST.RUN             -  RUN statement (restricted)
* ST.SET.MODES       -  SET.MODES statement (restricted)
* ST.SET.STATUS      -  SET.STATUS statement (restricted)
* ST.WAKE            -  WAKE
* ST.WRITEPKT        -  WRITEPKT statement (restricted)

st.delete.common:
   opcode = OP.DELCOM ; goto common.path

st.deletelist:
   opcode = OP.DELLIST ; goto common.path

st.disinherit:
   if not(object.state) then goto err.class
   opcode = OP.DISINH ; goto common.path

st.inherit:
   if not(object.state) then goto err.class
   opcode = OP.INHERIT ; goto common.path

st.logmsg:
   opcode = OP.LOGMSG ; goto common.path

st.nap:
   opcode = OP.NAP ; goto common.path

st.precision:
   opcode = OP.PRECISION ; goto common.path

st.printerr:
   opcode = OP.PRINTERR ; goto common.path

st.prompt:
   opcode = OP.PROMPT ; goto common.path

st.reset.modes:
   opcode = OP.CLRMODE ; goto common.path

st.run:
   opcode = OP.RUN ; goto common.path

st.set.modes:
   opcode = OP.SETMODE ; goto common.path

st.set.status:
   opcode = OP.SETSTAT ; goto common.path

st.wake:
   opcode = OP.WAKE ; goto common.path

st.writepkt:
   opcode = OP.WRITEPKT ; goto common.path

common.path:
   gosub exprf
   opcode.byte = opcode ; gosub emit.simple
   return

*****************************************************************************
* Statements that take two comma separated expressions
* ST.BREAKPOINT  -  BREAKPOINT statement (restricted)
* ST.SETNLS      -  SETNLS

st.breakpoint:
   opcode = OP.DBGBRK
   goto st2.common

st.setnls:
   opcode = OP.SETNLS
   goto st2.common

st2.common:
   gosub exprf
   gosub check.comma
   gosub exprf
   opcode.byte = opcode ; gosub emit.simple
   return

*****************************************************************************
* Statements that take var reference, optional ON ERROR, mandatory THEN/ELSE

* ST.CREATE     -  CREATE statement

st.create:
   opcode = OP.CREATESQ
   goto st.var.thenelse

st.var.thenelse:
   gosub simple.var.reference   ;* Emit file variable

   * Perform common back-end processing

   ins '1' before onerror.stack<1>        ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>       ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>       ;* THEN / ELSE clause required
   goto back.end

*****************************************************************************
* ST.ADD  -  ADD statement (restricted)
* ADD keys {,data} TO btree

st.add:
   if look.ahead.token = TKN.NAME then
      gosub get.token
      symbol.name = token.string
      gosub find.var

      if symbol.var.no < 0 then
         err.msg = sysmsg(2869) ;* Key variable symbol must be defined before ADD statement
         goto error
      end

      begin case
         case symbol.dim = 0
            opcode = OP.BTADD

         case symbol.dim = 1
            opcode = OP.BTADDA

         case 1
            err.msg = sysmsg(2870) ;* Scalar or one dimensional matrix name required
            goto error
      end case

      gosub emit.var.load
   end else
      gosub exprf
      opcode = OP.BTADD
   end

   if look.ahead.token = TKN.COMMA then
      gosub get.token        ;* Skip comma
      gosub exprf            ;* Process data expression
   end else
      opcode.string = '' ; gosub emit.string.load
   end

   if upcase(u.look.ahead.token.string) # 'TO' then goto err.to
   gosub get.token             ;* Skip 'TO'

   gosub simple.lvar.reference  ;* BTree variable
   opcode.byte = opcode ; gosub emit.simple
   return

*****************************************************************************
* ST.ABORT -  ABORT statement

st.abort:
   pick.style.message = bittest(mode, M.PICK.ERRMSG)
   goto st.abort.common
st.abortm:
   pick.style.message = @false
   goto st.abort.common
st.aborte:
   pick.style.message = @true
st.abort.common:

   if recursive then goto err.recursive

   * The ABORT statement may optionally have an associated text message.
   * Check the next token to see if we have a message.

   opcode.byte = OP.ABORT
   if look.ahead.token and (look.ahead.token # TKN.SEMICOLON) then
      n = 0
      if look.ahead.token = TKN.NAME then  ;* 0362
         find u.look.ahead.token.string in reserved.names setting n else null
      end
      if n = 0 then
         gosub exprf
         if pick.style.message then
            gosub emit.errmsg.args
            opcode.byte = OP.PABORT
         end else
            opcode.byte = OP.ABORTMSG
         end
      end
   end
   gosub emit.simple

   return

*****************************************************************************
* ST.AKCLEAR  -  AKCLEAR statement (Restricted)
* ST.AKENABLE -  AKENABLE statement (Restricted)

st.akclear:
   opcode = OP.AKCLEAR
   goto st.ak.common

st.akenable:
   opcode = OP.AKENABLE

st.ak.common:
   gosub expr            ;* Get file
   gosub check.comma
   gosub exprf           ;* Get AK number
   opcode.byte = opcode ; gosub emit.simple
   return

*****************************************************************************
* ST.AKDELETE  -  AKDELETE statement (Restricted)

st.akdelete:
   if u.look.ahead.token.string = "FROM" then
      gosub get.token      ;* Skip FROM token
      gosub expr            ;* Get file
      gosub check.comma
   end else
      opcode.byte = OP.LDUNASS
      gosub emit.simple
   end

   gosub exprf           ;* Get AK number
   gosub check.comma
   gosub exprf           ;* Get record id

   opcode = OP.AKDELETE
   ins '0' before onerror.stack<1>      ;* No ON ERROR clause
   ins '0' before testlock.stack<1>     ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>     ;* THEN / ELSE required
   goto back.end

*****************************************************************************
* ST.AKREAD  -  AKREAD statement (Restricted)

st.akread:
   gosub simple.lvar.reference  ;* Emit target variable
   if u.look.ahead.token.string = "FROM" then
      gosub get.token      ;* Skip FROM token
      gosub expr            ;* Get file
      gosub check.comma
   end else
      opcode.byte = OP.LDUNASS
      gosub emit.simple
   end

   gosub exprf           ;* Get AK number
   gosub check.comma
   gosub exprf           ;* Get record id

   opcode = OP.AKREAD
   ins '0' before onerror.stack<1>      ;* No ON ERROR clause
   ins '0' before testlock.stack<1>     ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>     ;* THEN / ELSE required
   goto back.end

*****************************************************************************
* ST.AKWRITE  -  AKWRITE statement (Restricted)

st.akwrite:
   gosub expr            ;* Get record to write

   if (u.look.ahead.token.string = "TO") or (u.look.ahead.token.string = "ON") then
      gosub get.token      ;* Skip TO/ON token
      gosub expr            ;* Get file
      gosub check.comma
   end else
      opcode.byte = OP.LDUNASS
      gosub emit.simple
   end

   gosub exprf           ;* Get AK number
   gosub check.comma
   gosub exprf           ;* Get record id

   opcode = OP.AKWRITE
   ins '0' before onerror.stack<1>      ;* No ON ERROR clause
   ins '0' before testlock.stack<1>     ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>     ;* THEN / ELSE required
   goto back.end

*****************************************************************************
* ST.BEGIN  -  BEGIN CASE statement (Entered from keyword BEGIN)

st.begin:
   gosub get.token          ;* Get next token

   begin case
* ------------------------- BEGIN CASE -------------------------
      case u.token.string = "CASE"
         if look.ahead.token then
            err.msg = sysmsg(2871) ;* Unexpected text after BEGIN CASE
            goto error
         end

         gosub get.token
     
         * Add new entry to jump stack

         ins J.CASE:@vm:jump.no:@vm:'0' before jump.stack<1>
         jump.no += 1

         * Process CASE statements

         loop
            * If this is not the first CASE, emit a jump to the exit label
            * and then label this CASE statement.

            if jump.stack<1,3> # '0' then
               label.name = "_":jump.stack<1,2>:"X"
               opcode.byte = OP.JMP ; gosub emit.jump

               * Emit a label for this CASE group

               label.name = "_":jump.stack<1,2>:"C":jump.stack<1,3>
               gosub set.label
            end

            jump.stack<1,3> = jump.stack<1,3> + 1       

         until (u.look.ahead.token.string = "END") or end.source

            gosub emit.xref.entry

            * The next statement should be a CASE
      
            if u.look.ahead.token.string # "CASE" then
               err.msg = sysmsg(2872) ;* CASE statement not found where expected
               gosub error
               goto exit.case
            end

            gosub get.token

            gosub exprf            ;*  Process the conditional expression

            * Check that the top of the jump stack is a CASE statement

            if jump.stack<1,1> # J.CASE then
               err.msg = sysmsg(2873) ;* Incorrectly formed CASE expression
               gosub error
               goto exit.case
            end

            * Emit a jump to the next CASE element if the condition is not met

            label.name = "_":jump.stack<1,2>:"C":jump.stack<1,3>
            opcode.byte = OP.JFALSE ; gosub emit.jump

            * Process source lines to the next that begins CASE or END

            if look.ahead.token = TKN.SEMICOLON then
               gosub get.token         ;* Skip semicolon
               if look.ahead.token then
                  gosub get.token
                  gosub proc.statement.group
               end
            end else
               if look.ahead.token then
                  err.msg = sysmsg(2873) ;* Incorrectly formed CASE expression
                  gosub error
                  goto exit.case
               end
            end

            if look.ahead.token = TKN.END then gosub get.token   ;* 0219

            loop
            until u.look.ahead.token.string = "CASE"
            until u.look.ahead.token.string = "END"
            until end.source
               gosub proc.line
               if look.ahead.token = TKN.END then gosub get.token
            repeat
              
         until end.source
         repeat

         * Flag an error if we are at the end of the source

         if end.source then
            err.msg = sysmsg(2874) ;* Unterminated CASE construct
            gosub error
            goto exit.case
         end

         * Check that the END token is followed by CASE

         gosub get.token             ;* Skip END token

         if u.look.ahead.token.string # "CASE" then
            err.msg = sysmsg(2875) ;* Expected CASE after END
            gosub error
            goto exit.case
         end

         gosub get.token              ;* Skip CASE token

         * Emit the exit label
         label.name = "_":jump.stack<1,2>:"X"
         gosub set.label

exit.case:
         del jump.stack<1>

* ---------------------- BEGIN TRANSACTION ---------------------
      case u.token.string = "TRANSACTION"
         if look.ahead.token then
            err.msg = sysmsg(2876) ;* Unexpected text after BEGIN TRANSACTION
            goto error
         end
   
         opcode.byte = OP.TXNBGN ; gosub emit.simple

         * Add new entry to jump stack

         ins J.TXN:@vm:jump.no:@vm:'0' before jump.stack<1>
         jump.no += 1

         * Process transaction body

         loop
         until (u.look.ahead.token.string = "END") or end.source
            * Process source lines to the next that begins END

            if look.ahead.token = TKN.SEMICOLON then
               gosub get.token         ;* Skip semicolon
               if look.ahead.token then
                  gosub get.token
                  gosub proc.statement.group
               end
            end else
               if look.ahead.token then
                  err.msg = sysmsg(2877) ;* Incorrectly formed transaction
                  gosub error
                  goto exit.txn
               end
            end

            gosub get.token

            loop
            until u.look.ahead.token.string = "END"
               gosub proc.line
               if look.ahead.token = TKN.END then gosub get.token
            repeat
         until end.source
         repeat

         * Flag an error if we are at the end of the source

         if end.source then
            err.msg = sysmsg(2878) ;* Unterminated transaction construct
            gosub error
            goto exit.txn
         end

         * Check that the END token is followed by TRANSACTION

         gosub get.token             ;* Skip END token

         if u.look.ahead.token.string # "TRANSACTION" then
            err.msg = sysmsg(2879) ;* Expected TRANSACTION after END
            gosub error
            goto exit.txn
         end

         gosub get.token              ;* Skip TRANSACTION token

         * Check that the top entry on the jump stack is our transaction.
         * If not, the END TRANSACTION is in a conditional block.

         if jump.stack<1,1> # J.TXN then
            err.msg = sysmsg(2880) ;* Incorrectly paired BEGIN/END TRANSACTION
            gosub error
            goto exit.txn
         end

         * Emit the end label
         label.name = "_":jump.stack<1,2>:"E"
         gosub set.label

         opcode.byte = OP.TXNEND ; gosub emit.simple

         * Emit the exit label
         label.name = "_":jump.stack<1,2>:"X"
         gosub set.label

exit.txn:
         del jump.stack<1>

      case 1
         err.msg = sysmsg(2881) ;* Expected CASE or TRANSACTION after BEGIN
         gosub error
   end case

   return

*****************************************************************************
* ST.BREAK  -  BREAK statement

st.break:
   if u.look.ahead.token.string = "KEY" then gosub get.token

   if look.ahead.token = TKN.END then
      err.msg = sysmsg(2882) ;* Expected ON, OFF, CLEAR or expression
      goto error
   end


   begin case
      case (u.look.ahead.token.string = "ON") ;* 0504
         gosub get.token
         n = 1 ; gosub emit.numeric.load

      case (u.look.ahead.token.string = "OFF") ;* 0504
         gosub get.token
         n = 0 ; gosub emit.numeric.load

      case (u.look.ahead.token.string = "CLEAR") ;* 0504
         gosub get.token
         n = -1 ; gosub emit.numeric.load

      case 1
         gosub expr
   end case

   opcode.byte = OP.BREAK ; gosub emit.simple
   return

*****************************************************************************
* ST.CALL  -  CALL statement

st.call:
   if look.ahead.token = TKN.AT.name then      ;* Indirect call
      gosub get.token    ;* Skip @ token

      * We cannot always use simple.var.reference to emit the indirection
      * variable as this will see a subroutine with arguments as being a
      * reference to an as yet undimensioned matrix. To minimise the impact
      * of a syntax ambiguity we look the name up in the symbol table here.
      * If we find it as a matrix, we let simple.var.reference do the rest
      * of the job as this will sort out indexing. If we do not find the
      * symbol or it is defined but not as a matrix, we do all the processing
      * here.

      locate look.ahead.token.string in symbols<1> setting pos then
         if symbol.info<pos,3> then    ;* It's a matrix
            gosub simple.var.reference
            if err then return
         end else                      ;* Known, but not a matrix
            gosub get.token
            symbol.name = token.string
            symbol.mode = SYM.USE
            gosub find.var   
            gosub emit.var.load
         end
      end else                         ;* Symbol not already known
         gosub get.token 

         * 0464 Check to see if it is a defined token.

         s = find(defined.tokens, token.string)
         if not(status()) then
            n = s[1,1] + 0
            begin case
               case n = 2  ;* Matrix reference
                  i = index(s, " ", 1)
                  symbol.name = s[2, i - 2]
                  equate.index = s[i + 1, 9999]
                  if lvar then symbol.mode = SYM.SET
                  gosub find.var
                  if symbol.var.no < 0 then
                     err.msg = sysmsg(2863) ;* Equate token references undimensioned matrix
                     goto error
                  end
                  if symbol.dim = 0 then
                     err.msg = sysmsg(2864) ;* Equate token references scalar variable
                     goto error
                  end
                  if symbol.dim # ((index(equate.index," ",1) # 0) + 1) then
                     err.msg = sysmsg(2865) ;* Equate token references matrix with wrong number of dimensions
                     goto error
                  end
                  gosub emit.var.load

                  n = matchfield(equate.index, "0N0X", 1)
                  gosub emit.numeric.load

                  if symbol.dim = 2 then
                     n = matchfield(equate.index, "0N 0N", 3)
                     gosub emit.numeric.load
                     opcode.byte = OP.INDX2
                  end else
                     opcode.byte = OP.INDX1
                  end
                  gosub emit.simple
                  goto st.call.args

               case n = 4  ;* Simple variable reference
                  token.string = s[2, 99999]

               case 1
                  goto err.name
            end case
         end

         symbol.name = token.string
         symbol.mode = SYM.USE
         symbol.common.offset = -1
         symbol.dim = 0
         gosub make.var
         gosub emit.var.load
      end
   end
   else if (look.ahead.token = TKN.NAME) or (look.ahead.token = TKN.NAME.LBR) or (look.ahead.token.string = '!')  or (look.ahead.token.string = '*') or (look.ahead.token = TKN.DOLLAR) then
      * Direct call

      gosub get.call.name                 ;* Read name token
      gosub emit.direct.call.reference
   end else
      err.msg = sysmsg(2883) ;* Expected direct or indirect subroutine reference
      goto error
   end

st.call.args:
   * Process arguments (if any)

   call.arg.count = 0

   if look.ahead.token = TKN.LBR then       ;* Arguments present
      gosub get.token

      loop
      while look.ahead.token # TKN.RBR
         if u.look.ahead.token.string = "MAT" then
            gosub get.token
            if look.ahead.token # TKN.NAME then
               err.msg = sysmsg(2856) ;* Matrix name required
               goto error
            end

            gosub get.token
            symbol.name = token.string
            symbol.mode = SYM.ARG
            gosub find.var

            if (symbol.var.no < 0) or (symbol.dim = 0) then
               err.msg = sysmsg(2856) ;* Matrix name required
               goto error
            end

            gosub emit.var.load
         end else if u.look.ahead.token.string = "VARSET" then
            gosub get.token
            if look.ahead.token # TKN.NAME then
               err.msg = sysmsg(3453)  ;* VARSET name required
               goto error
            end

            gosub get.token

            locate u.token.string in varsets<1,1> setting pos else
               err.msg = sysmsg(3454)  ;* Undefined VARSET name
               goto error
            end

            symbol.var.no = varsets<2,pos>
            symbol.common.offset = -1
            gosub emit.var.load
         end else
            deref = (look.ahead.token = TKN.LBR)
            symbol.mode = SYM.ARG
            gosub exprf
            symbol.mode = SYM.USE  ;* 0347
            if err then return
            if deref then
               opcode.byte = OP.VALUE ; gosub emit.simple
            end
         end

         call.arg.count += 1

      while look.ahead.token = TKN.COMMA
         gosub get.token
      repeat

      if call.arg.count > 255 then
         err.msg = sysmsg(2884) ;* Too many arguments in CALL
         goto error
      end

      if look.ahead.token # TKN.RBR then goto err.rbr

      gosub get.token     ;* Skip close bracket
   end

   if call.arg.count > greatest.call.arg.count then
      greatest.call.arg.count = call.arg.count
   end

   if print.code then
      s = "CALL     (" : call.arg.count : " arguments)"
      gosub show.code
    end

   opcode.byte = OP.CALL ; gosub emit
   opcode.byte = call.arg.count ; gosub emit

   return

*****************************************************************************
* ST.CALLV  -  CALLV statement (restricted)

st.callv:
   if look.ahead.token = TKN.AT.NAME then      ;* Indirect call
      gosub get.token    ;* Skip @ token
      gosub simple.var.reference
      if err then return
   end
   else if (look.ahead.token = TKN.NAME) or (look.ahead.token = TKN.NAME.LBR) or (look.ahead.token.string = '!')  or (look.ahead.token.string = '*') or (look.ahead.token = TKN.DOLLAR) then
      * Direct call

      gosub get.call.name                 ;* Read name token
      gosub emit.direct.call.reference
   end else
      err.msg = sysmsg(2883) ;* Expected direct or indirect subroutine reference
      goto error
   end

   * Load argument count onto stack

   gosub check.comma
   gosub expr

   * Load argument matrix pointer onto stack

   gosub check.comma

   if look.ahead.token # TKN.NAME then
      err.msg = sysmsg(2856) ;* Matrix name required
      goto error
   end

   gosub get.token
   symbol.name = token.string
   symbol.mode = SYM.ARG
   gosub find.var

   if (symbol.var.no < 0) or (symbol.dim = 0) then
      err.msg = sysmsg(2856) ;* Matrix name required
      goto error
   end

   gosub emit.var.load
   opcode.byte = OP.CALLV ; gosub emit.simple

   greatest.call.arg.count = 255   ;* Allow for worst case
   return

*****************************************************************************
* ST.CASE  -  Misplaced CASE statement

st.case:
   err.msg = sysmsg(3407)  ;* Misplaced CASE statement
   goto error

*****************************************************************************
* ST.CHAIN    -  CHAIN statement

st.chain:
   if recursive then goto err.recursive

   n = syscom.xeq.command ; gosub emit.ldsys
   gosub exprf
   opcode.byte = OP.STOR  ; gosub emit.simple
   opcode.byte = OP.CHAIN ; gosub emit.simple
   return

*****************************************************************************
* ST.CLASS  -  CLASS statement

st.class:
   if is.ctype then goto err.ctype
   if name.set then goto err.name.set

   if pc # start.pc then
      err.msg = sysmsg(3440) ;* CLASS must appear before any executable statements
      goto error
   end

   * Get name of program

   gosub get.name
   program.name = s[1,HDR.PROGRAM.NAME.LEN]
   if len(s) > HDR.PROGRAM.NAME.LEN then
      err.msg = sysmsg(2919) ;* Name has been truncated for cataloguing
      gosub warning
   end

   name.set = @true
   object.state = 1
   objargs = 32        ;* Default optional argument count
   header.flags = bitor(header.flags, HDR.VAR.ARGS)
   header.flags = bitor(header.flags, HDR.IS.CLASS)

   * Check for MAX.ARGS option

   if look.ahead.token = TKN.NAME and u.look.ahead.token.string = 'MAX.ARGS' then
      gosub get.token
      gosub get.token
      if token # TKN.NUM or not(token.string matches '1-3N') or token.string < 1 or token.string > 255 then
         err.msg = sysmsg(3461) ;* MAX.ARGS argument count missing or invalid
         goto error
      end
      objargs = token.string + 0
   end

   subr.arg.count = objargs

   * Now reserve hidden names for the argument variables

   for i = 1 to objargs
      symbol.name = '*Arg':fmt(i,'R%3')
      symbol.common.offset = -1
      symbol.dim = 0
      symbol.mode = SYM.ARG
      gosub make.var
   next i

   * Reserve a pseudo common variable for the persistent variable array

   commons<1,-1> = '*VARS'
   commons<2,-1> = var.count
   commons<3,-1> = '0'
   var.count += 1
   symbol.table<-1> = '*VARS'

   * Check for inheritance

   if look.ahead.token = TKN.NAME and u.look.ahead.token.string = 'INHERITS' then
      gosub get.token
      loop
         gosub get.call.name                 ;* Read name token
         inherited.classes<-1> = s

         * Create a PRIVATE variable of the same name as the class
         symbol.name = s
         if not(alpha(s[1,1])) then
            s = s[2,999] ;* Remove global catalogue prefix character
         end

         locate '*VARS' in commons<1,1> setting common.index else
            stop 'Internal error - *VARS not found'
         end

         symbol.var.no = commons<2,common.index>
         symbol.common.offset = commons<3,common.index> + 1
         commons<3,common.index> = symbol.common.offset
         symbol.dim = 0

         * Make new symbol table entry, checking for duplicate definitions

         locate symbol.name in symbols<1> by 'AL' setting sympos then
            err.msg = sysmsg(2890, symbol.name) ;* Duplicate symbol 'xx'
            goto error
         end

         var.data = symbol.var.no : @vm : symbol.common.offset : @vm : symbol.dim : @vm : common.index
         ins symbol.name before symbols<sympos>
         ins var.data before symbol.info<sympos>
         ins '' before symbol.refs<sympos>

         commons<4,common.index,symbol.common.offset> = symbol.name
         commons<5,common.index,symbol.common.offset> = 0
         commons<6,common.index,symbol.common.offset> = 0
      while look.ahead.token = TKN.COMMA
         gosub get.token
      repeat
   end

   return   

*****************************************************************************
* ST.CLEAR        -  CLEAR statement
* ST.CLEARCOMMON  -  CLEARCOMMON statement

st.clear:
   if u.look.ahead.token.string = "COMMON" then
      gosub get.token
      goto st.clearcommon
   end

   opcode.byte = OP.CLEAR ; gosub emit.simple
   clear.used = @true

   return

st.clearcommon:
   opcode.byte = OP.CLRCOM ; gosub emit.simple

   return

*****************************************************************************
* ST.CLEARDATA  -  CLEARDATA statement

st.cleardata:
   n = syscom.data.queue ; gosub emit.ldsys
   opcode.string = ''    ; gosub emit.string.load
   opcode.byte = OP.STOR ; gosub emit.simple
   return

*****************************************************************************
* ST.CLEARFILE  -  CLEARFILE statement

st.clearfile:
   gosub convert.pick.file.reference
   gosub simple.var.reference      ;* Emit file variable

   opcode = OP.CLRFILE
   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>     ;* No LOCKED clause
   ins '0' before thenelse.stack<1>     ;* No THEN / ELSE clause
   goto back.end

*****************************************************************************
* ST.CLEARINPUT  -  CLEARINPUT statement

st.clearinput:
   opcode.byte = OP.CLRINPUT ; gosub emit.simple
   return

*****************************************************************************
* ST.CLEARSELECT  -  CLEARSELECT statement

st.clearselect:
   if u.look.ahead.token.string = "ALL" then
      gosub get.token

      opcode.byte = OP.CLEARALL ; gosub emit.simple
   end else
      find u.look.ahead.token.string in reserved.names setting n else n = 0 ;* 0417
      if n or look.ahead.token = TKN.END or look.ahead.token = TKN.SEMICOLON then ;* 0360
         n = 0 ; gosub emit.numeric.load
      end else
         gosub exprf
      end

      opcode.byte = OP.CLEARSEL ; gosub emit.simple
   end

   return

*****************************************************************************
* ST.CLOSE      -  CLOSE statement
* ST.CLOSESEQ   -  CLOSESEQ statement
*

st.close:
   if look.ahead.token # TKN.NAME and look.ahead.token # TKN.NAME.LBR then goto err.var
   gosub convert.pick.file.reference
   gosub get.token
   gosub emit.var.reference             ;* Emit file variable

   opcode = OP.CLOSE
   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>     ;* No LOCKED clause
   ins '0' before thenelse.stack<1>     ;* No THEN or ELSE clause
   goto back.end

*****************************************************************************
* ST.CLOSE.SOCKET  -  CLOSE.SOCKET statement

st.close.socket:
   if look.ahead.token # TKN.NAME and look.ahead.token # TKN.NAME.LBR then goto err.var
   gosub get.token
   gosub emit.var.reference             ;* Emit file variable

   opcode.byte = OP.CLOSESKT ; gosub emit.simple
   return

*****************************************************************************
* ST.COMMIT  -  COMMIT statement

st.commit:
   opcode.byte = OP.TXNCMT ; gosub emit.simple

   * Walk back down the jump stack to find the associated transaction

   i = 1
   loop
      s = jump.stack<i>
   until s<1,1> = J.TXN
      if s = '' then
         err.msg = sysmsg(2885) ;* COMMIT not in transaction
         goto error
      end
      i += 1
   repeat

   label.name = "_":s<1,2>:"X"
   opcode.byte = OP.JMP ; gosub emit.jump
   return

*****************************************************************************
* ST.COMMON  -  Define common variable
* ST.VARSET  -  Define a varset (restricted)

st.varset:
   gosub get.name
   locate s in varsets<1,1> setting pos then
      if not(varsets<3,pos>) then    ;* Not an argument
         err.msg = sysmsg(3455)  ;* Duplicate VARSET name
         goto error
      end
      varset.arg.no = varsets<2,pos>
   end else
      varset.arg.no = -1
      varsets<1,pos> = s
      varsets<2,pos> = var.count
   end
   common.name = '~':s
   goto st.common.common

st.common:
   varset.arg.no = -1
   common.name = ""

   if look.ahead.token = TKN.IDIV then     ;* 0182  Allow for COMMON // A,B,C        
      gosub get.token
   end else if look.ahead.token = TKN.DIV then  ;* Named common
      gosub get.token
      gosub get.name
      common.name = s

      if look.ahead.token # TKN.DIV then
         err.msg = sysmsg(2886) ;* Expected / after common block name
         goto error
      end

      gosub get.token
   end

st.common.common:
   loop
      * Find common block

      if len(common.name) then s = common.name
      else s = "$"

      * 0397 commons array was scanned with AL sort but symbol table relied
      * on position not changing. Removed the sort clause.
      
      locate s in commons<1,1> setting common.index then
         symbol.var.no = commons<2,common.index>
         symbol.common.offset = commons<3,common.index> + 1
         commons<3,common.index> = symbol.common.offset
      end else
         * Make new common block
         if varset.arg.no >= 0 then
            symbol.var.no = varset.arg.no
         end else
            symbol.var.no = var.count
            var.count += 1
         end

         symbol.common.offset = 1      ;* Offset 0 holds common block name
         symbol.table<-1> = s

         commons<1,common.index> = s
         commons<2,common.index> = symbol.var.no
         commons<3,common.index> = '1'
         if bittest(mode, M.UNASSIGNED.COMMON) then commons<9,common.index> = @true
         if varset.arg.no >= 0 then commons<8,common.index> = @true
      end

      * Process variables

      rows = 0
      cols = 0

      begin case
      case look.ahead.token = TKN.NAME       ;* Scalar variable
         gosub get.token
         symbol.name = token.string
         symbol.dim = 0

      case look.ahead.token = TKN.NAME.LBR   ;* Matrix
         gosub get.token
         symbol.name = token.string

         gosub get.token             ;* Skip over left bracket

         gosub get.numeric.constant
         if gnc.err then return
         rows = n

         if rows < 1 then
            err.msg = sysmsg(2887) ;* Illegal row dimension in common matrix
            goto error
         end

         if look.ahead.token = TKN.COMMA then     ;* Two dimensions
            gosub get.token          ;* Skip over comma

            gosub get.numeric.constant
            if gnc.err then return
            cols = n + 0

            if cols < 1 then
               err.msg = sysmsg(2888) ;* Illegal column dimension in common matrix
               goto error
            end

            symbol.dim = 2
         end else                                 ;* Single dimension
            cols = 0
            symbol.dim = 1
         end

         if look.ahead.token # TKN.RBR then goto err.rbr

         gosub get.token   ;* Skip over right bracket

      case 1
         err.msg = sysmsg(2889) ;* Common variable name not found where expected
         goto error
      end case

      * Make new symbol table entry, checking for duplicate definitions

      locate symbol.name in symbols<1> by 'AL' setting sympos then
         err.msg = sysmsg(2890, symbol.name) ;* Duplicate symbol 'xx'
         goto error
      end

      var.data = symbol.var.no : @vm : symbol.common.offset : @vm : symbol.dim : @vm : common.index
      ins symbol.name before symbols<sympos>
      ins var.data before symbol.info<sympos>
      ins '' before symbol.refs<sympos>

      commons<4,common.index,symbol.common.offset> = symbol.name
      commons<5,common.index,symbol.common.offset> = rows
      commons<6,common.index,symbol.common.offset> = cols

      if bittest(mode, M.PMATRIX) and symbol.dim # 0 then
         * This is a Pick style matrix. Leave space for the elements.

         commons<7,common.index,symbol.common.offset> = var.count
         var.count += 1
         symbol.table<-1> = symbol.name
         n = if cols then rows * cols else rows
         commons<3,common.index> += n - 1
      end

   while look.ahead.token = TKN.COMMA

      gosub get.token  ;* Read comma token
   repeat

   return

*****************************************************************************
* ST.COMO  -  COMO statement

st.como:
   gosub exprf

   opcode = OP.COMO
   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>     ;* No LOCKED clause
   ins '0' before thenelse.stack<1>     ;* No THEN / ELSE clause
   goto back.end

*****************************************************************************
* ST.CONFIGURE.FILE  -  CONFIGURE.FILE statement
*
*     CONFIGURE.FILE file.var   {BIG.REC.SIZE big rec size}
*                               {MIN.MODULUS min modulus}
*                               {SPLIT.LOAD split load}
*                               {MERGE.LOAD merge load}

st.configure.file:
   gosub simple.var.reference    ;* Emit file variable
   if err then return
   
   dh.params = "BIG.REC.SIZE":@FM:"MIN.MODULUS":@FM:"SPLIT.LOAD":@FM:"MERGE.LOAD"
   loop
      remove z from dh.params setting param.delimiter
      if u.look.ahead.token.string = z then
         gosub get.token
         gosub expr
      end else      ;* Use default
         n = -1
         gosub emit.numeric.load
      end
   while param.delimiter
   repeat

   opcode = OP.CONFIGFL

   ins '0' before onerror.stack<1>     ;* No ON ERROR clause
   ins '0' before testlock.stack<1>    ;* No LOCKED clause allowed
   ins '2' before thenelse.stack<1>    ;* Optional THEN / ELSE clause allowed
   goto back.end

*****************************************************************************
* ST.CONTINUE  -  CONTINUE statement
* ST.EXIT      -  EXIT statement

st.continue:
   label.name = "R"
   goto st.continue.exit.common

st.exit:
   label.name = "X"

st.continue.exit.common:

   * Work down jump stack until we find a LOOP or FOR construct
   i = 1
   loop
      n = jump.stack<i,1> + 0
   until (n = J.LOOP) or (n = J.FOR)
      if n = 0 then
         err.msg = sysmsg(2891, token.string) ;* Misplaced xx
         goto error
      end
      i += 1
   repeat

   label.name = "_":jump.stack<i,2>:label.name
   opcode.byte = OP.JMP ; gosub emit.jump
   return

*****************************************************************************
* ST.CONVERT  -  CONVERT statement

st.convert:
   gosub exprf                  ;* Characters to replace

   if u.look.ahead.token.string # "TO" then goto err.to
   gosub get.token             ;* Skip TO
   gosub exprf                  ;* Replacement characters
   if u.look.ahead.token.string # "IN" then goto err.in
   gosub get.token             ;* Skip IN
   gosub simple.lvar.reference  ;* Variable to update
   opcode.byte = OP.CONVERT ; gosub emit.simple

   return

*****************************************************************************
* ST.CREATE.AK  -  CREATE.AK statement (restricted)

st.create.ak:
   gosub expr ; if err then return  ;* Emit file pathname expression
   gosub check.comma
   gosub expr ; if err then return  ;* Emit AK pathname expression
   gosub check.comma
   gosub expr ; if err then return  ;* Emit AK field name expression
   gosub check.comma
   gosub expr ; if err then return  ;* Emit flags expression
   gosub check.comma
   gosub expr ; if err then return  ;* Emit field number expression
   gosub check.comma
   gosub expr ; if err then return  ;* Emit I-type code
   gosub check.comma
   gosub expr ; if err then return  ;* Emit collation map name
   gosub check.comma
   gosub expr ; if err then return  ;* Emit collation map

   opcode = OP.CREATEAK

   ins '0' before onerror.stack<1>     ;* No ON ERROR clause
   ins '0' before testlock.stack<1>    ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>    ;* THEN / ELSE clause required
   goto back.end

*****************************************************************************
* ST.CREATE.FILE  -  CREATE.FILE statement
*
*     CREATE.FILE path {DIRECTORY
*                      {DYNAMIC 
*                               {GROUP.SIZE group size}
*                               {BIG.REC.SIZE big rec size}
*                               {MIN.MODULUS min modulus}
*                               {SPLIT.LOAD split load}
*                               {MERGE.LOAD merge load}
*                               {FLAGS flags}
*                               {VERSION vno}
*                      }
st.create.file:
   gosub expr                      ;* Emit file path name expression
   if err then return
   
   begin case
   case u.look.ahead.token.string = "DIRECTORY"
      gosub get.token

      opcode = OP.CREATET1

   case u.look.ahead.token.string = "DYNAMIC"
      gosub get.token

      dh.params = "GROUP.SIZE":@FM:"BIG.REC.SIZE":@FM:"MIN.MODULUS":@FM:"SPLIT.LOAD":@FM:"MERGE.LOAD":@FM:"FLAGS":@FM:"VERSION"

      loop
         remove z from dh.params setting param.delimiter
         if u.look.ahead.token.string = z then
            gosub get.token
            gosub expr
         end else      ;* Use default
            n = -1 ; gosub emit.numeric.load
         end
      while param.delimiter
      repeat

      opcode = OP.CREATEDH

   case 1
      err.msg = sysmsg(2892) ;* Expected DIRECTORY or DYNAMIC after path name
      goto error
   end case

   ins '1' before onerror.stack<1>     ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>    ;* No LOCKED clause allowed
   ins '0' before thenelse.stack<1>    ;* No THEN / ELSE clause allowed
   goto back.end

*****************************************************************************
* ST.DATA  -  DATA statement

st.data:
   loop
      gosub exprf                     ;* Data to set
      opcode.byte = OP.DATA ; gosub emit.simple
   while look.ahead.token = TKN.COMMA
      gosub get.token
   repeat

   return

*****************************************************************************
* ST.DEBUG  -  DEBUG statement
* ST.DEBUG.ON  -  DEBUG.ON statement (restricted)

st.debug:
   if is.ctype then goto err.ctype

   if not(debug) then
      err.msg = sysmsg(2893) ;* DEBUG statement ignored - not compiling in debug mode
      gosub warning
   end

st.debug.on:
   opcode.byte = OP.DBGON ; gosub emit.simple
   return

*****************************************************************************
* ST.DEBUG.OFF  -  DEBUG.OFF statement (restricted)

st.debug.off:
   opcode.byte = OP.DBGOFF ; gosub emit.simple
   return

*****************************************************************************
* ST.DEBUG.SET  -  DEBUG.SET statement (restricted)
*    DEBUG.SET var {, qualifier} TO value

st.debug.set:
   gosub expr

   if look.ahead.token = TKN.COMMA then
      gosub get.token
      gosub expr
   end else
      opcode.byte = OP.LD0 ; gosub emit.simple
   end

   if u.look.ahead.token.string # 'TO' then goto err.to
   gosub get.token

   gosub expr
   opcode.byte = OP.DBGSET ; gosub emit.simple
   return

*****************************************************************************
* ST.DEFFUN  -  DEFFUN statement

st.deffun:
   gosub get.token
   if token # TKN.NAME and token # TKN.NAME.LBR then
      err.msg = "Expected function name after DEFFUN"
      goto error
   end

   function.name = token.string
   locate function.name in functions<1,1> by 'AL' setting func.index then
      err.msg = sysmsg(2894) ;* Duplicate function name 'xx'
      goto error
   end

   function.call.name = function.name
   function.args = ''
   function.key = ''
   var.args = @false

   st.work = 0   ;* 1 = external feature used, 2 = internal feature used

   if look.ahead.token = TKN.LBR then
      gosub get.token  ;* Skip bracket
      if look.ahead.token = TKN.NAME then
         loop
            gosub get.token

            if u.token.string = 'MAT' then
               function.args := 'M'
               gosub get.token
            end else
               function.args := 'S'
            end

            if token # TKN.NAME then
               err.msg = sysmsg(2895) ;* Function argument name not found where expected
               goto error
            end

         while look.ahead.token = TKN.COMMA
            gosub get.token
         repeat
      end

      gosub get.token
      if token # TKN.RBR then goto err.rbr
   end

   loop
      begin case
         case u.look.ahead.token.string = "CALLING"
            gosub get.token  ;* Skip CALLING
            gosub get.token
            if token # TKN.STRING then
               err.msg = sysmsg(2896) ;* Expected quoted call name after CALLING
               goto error
            end

            function.call.name = u.token.string
            st.work = bitor(st.work, 1)

         case u.look.ahead.token.string = "KEY"
            gosub get.token  ;* Skip KEY
            gosub get.token
            if token # TKN.NUM and token # TKN.STRING then
               err.msg = sysmsg(3410) ;* Expected function key after KEY
               goto error
            end

            if token.string = '' then
               err.msg = sysmsg(3411) ;* Function key cannot be a null string
               goto error
            end

            function.key = token.string

         case u.look.ahead.token.string = "LOCAL"
            gosub get.token  ;* Skip LOCAL
            function.call.name = ''
            st.work = bitor(st.work, 2)

         case u.look.ahead.token.string = "VAR.ARGS"
            gosub get.token  ;* Skip VAR.ARGS
            var.args = @true
            st.work = bitor(st.work, 1)

         case 1
            exit
      end case
   repeat

   if look.ahead.token # TKN.END or st.work = 3 then
      err.msg = sysmsg(2897) ;* Misformed DEFFUN
      goto error
   end

   if len(function.args) > 254 then
      err.msg = sysmsg(2898) ;* Too many arguments is function definition
      goto error
   end

   if function.args > greatest.call.arg.count then
      greatest.call.arg.count = len(function.args)
   end

   ins function.name before functions<1,func.index>
   ins function.call.name before functions<2,func.index>
   ins function.args before functions<3,func.index>
   ins function.key before functions<4,func.index>
   ins var.args before functions<5,func.index>

   if function.call.name = '' then   ;* Internal function
      function.args = 'S':function.args   ;* Insert return argument
      locate function.name in int.subs<1> setting pos then
         if function.args # int.sub.args<pos> then
            err.msg = sysmsg(3426) ;* Inconsistent argument lists in internal subroutine reference
            goto error
         end
      end else
         ins function.name before int.subs<1>     ;* Insert at front so that...
         ins function.args before int.sub.args<1> ;* ...null entries work
         ins @false before int.sub.is.lsub<1>
      end
   end

   return

*****************************************************************************
* ST.DEL  -  DEL statement

st.del:
   gosub simple.lvar.reference ; if err then return
   opcode.byte = OP.DUP ; gosub emit.simple

   if look.ahead.token # TKN.LT then
      err.msg = sysmsg(2899) ;* Field reference not found where expected
      goto error
   end

   format.qualifier.allowed = @false
   gosub is.field.ref  ;* Find matching >

   gosub get.token

   gosub emit.field.reference ; if err then return
   opcode.byte = OP.DEL ; gosub emit.simple
   opcode.byte = OP.STOR ; gosub emit.simple

   return

*****************************************************************************
* ST.DELETE   -  DELETE statement
* ST.DELETEU  -  DELETEU statement

st.deleteu:
   lock.opcode = OP.ULOCK

st.delete:
   opcode = OP.DELETE

   * Emit file var

   gosub convert.pick.file.reference
   gosub exprf
   gosub check.comma
   gosub exprf           ;* Emit record id expresssion

   * Perform common back-end processing

   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>     ;* No LOCKED clause
   ins '0' before thenelse.stack<1>     ;* No THEN or ELSE clause
   goto back.end

*****************************************************************************
* ST.DELETE.AK  -  DELETE.AK statement (restricted)

st.delete.ak:
   gosub expr ; if err then return  ;* Emit pathname expression
   gosub check.comma
   gosub expr ; if err then return  ;* Emit AK number expression

   opcode = OP.DELETEAK

   ins '0' before onerror.stack<1>     ;* No ON ERROR clause
   ins '0' before testlock.stack<1>    ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>    ;* THEN / ELSE clause required
   goto back.end

*****************************************************************************
* ST.DELETESEQ

st.deleteseq:
   * Emit file expresssion
   gosub exprf
    
   if look.ahead.token = TKN.COMMA then
      gosub get.token      ;* Skip comma
      gosub exprf          ;* Emit record expresssion
   end else
      opcode.byte = OP.LDNULL ; gosub emit.simple
   end

   * Perform common back-end processing

   opcode = OP.DELSEQ
   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins '1' before thenelse.stack<1>     ;* THEN / ELSE required
   goto back.end

*****************************************************************************
* ST.DIM  -  DIM statement

st.dim:
!   if lsub.var.no >= 0 then
!      err.msg = sysmsg(3422) ;* Statement not allowed inside a LOCAL subroutine or function
!      goto error
!   end

   loop
      * Get name of array variable

      gosub get.token
      if token # TKN.NAME.LBR then
         err.msg = sysmsg(2900) ;* Matrix dimensions required
         goto error
      end

      * Save the symbol name as the dimension processing may overwrite it
      dim.symbol.name = token.string

      symbol.name = token.string
      symbol.mode = SYM.DIM
      gosub find.var
      if symbol.var.no >= 0 then  ;* Exists
         * Is it a Pick style matrix?
         if symbol.common.offset >= 0 and commons<7,symbol.common.index,symbol.common.offset> then
            err.msg = sysmsg(2973) ;* Cannot redimension a Pick style common matrix
            goto error
         end
      end else                    ;* Make new variable
         symbol.dim = -1          ;* Indicate not yet known
         symbol.common.offset = -1
         symbol.mode = SYM.DIM
         gosub make.var
      end

      gosub emit.var.load         ;* Emit LDLCL
      gosub get.token             ;* Skip over left bracket
      gosub exprf                  ;* Load first dimension

      if look.ahead.token = TKN.COMMA then     ;* Two dimensions
         dim.dimensions = 2

         gosub get.token          ;* Skip over comma
         gosub exprf               ;* Load second dimension
      end else                                 ;* Single dimension
         dim.dimensions = 1

         * Emit load of zero for second dimension

         n = 0 ; gosub emit.numeric.load
      end

      * Skip over right bracket
      gosub get.token

      * Find symbol table entry again

      symbol.name = dim.symbol.name
      symbol.mode = SYM.CHK
      gosub find.var

      * Check number of dimensions is correct
      if symbol.dim < 0 then
         var.data = symbol.var.no : @vm : symbol.common.offset : @vm : dim.dimensions
         symbol.info<sympos> = var.data
      end else
         if symbol.dim # dim.dimensions then
            err.msg = sysmsg(2901) ;* Number of dimensions differs from previous use
            goto error
         end
      end

      if symbol.var.no < subr.arg.count then
         * Ignore actual redimensioning by popping ADDR and subscripts
         * Much as we'd like simply to ignore the values of the subscripts,
         * these could feasibly be expressions and it is easier just to let
         * the system evaulate them and then throw the result away than to try
         * to do anything clever to skip the expressions.

         opcode.byte = OP.POP
         gosub emit.simple
         gosub emit.simple
         gosub emit.simple
      end else
         * Emit DIMLCL or DIMLCLP opcode

         opcode.byte = if bittest(mode, M.PMATRIX) then OP.DIMLCLP else OP.DIMLCL
         gosub emit.simple
      end

   while look.ahead.token = TKN.COMMA
      gosub get.token     ;* 0084
   repeat

   return

*****************************************************************************
* ST.DISPLAY  -  DISPLAY and CRT statements

st.crt:
st.display:
   print.opcode = OP.DSP ; gosub emit.print.list
   return

*****************************************************************************
* ST.DO  -  DO statement

st.do:
   * Work down jump stack until we find a LOOP or FOR construct
   j.index = 1
   loop
      n = jump.stack<j.index,1> + 0
   until (n = j.loop) or (n = j.for)
      if n = 0 then
         err.msg = sysmsg(2891, token.string) ;* Misplaced xx
         goto error
      end
      j.index += 1
   repeat

   return

*****************************************************************************
* ST.DPARSE  -  DPARSE statement

st.dparse:
   * Save string to parse in temp var 1

   n = 1 ; gosub emit.temp.ref
   gosub expr
   opcode.byte = OP.STOR ; gosub emit.simple

   gosub check.comma

   * Save delimiter in temp var 2

   n = 2 ; gosub emit.temp.ref
   gosub expr
   opcode.byte = OP.STOR ; gosub emit.simple

   gosub check.comma

   * Emit code to parse each item

   dparse.ct = 0
   loop
      dparse.ct += 1

      * Emit target

      if look.ahead.token # TKN.NAME and look.ahead.token # TKN.NAME.LBR then
         goto err.var
      end
      gosub get.token

      gosub emit.lvar.reference

      if look.ahead.token = TKN.LT then   ;* It's a field reference
         dparse.field.ref = @true
         format.qualifier.allowed = @false
         gosub is.field.ref
         if ifr.index = 0 then
            err.msg = sysmsg(2833)  ;* Improperly formed field assignment
            goto error
         end

         gosub get.token       ;* Skip < token
         gosub emit.field.reference
         if err then return
      end else
         dparse.field.ref = @false
      end

      n = 1 ; gosub emit.temp.ref      ;* String
      n = 2 ; gosub emit.temp.ref      ;* Delimiter
      n = dparse.ct ; gosub emit.numeric.load  ;* Components index
      n = 1 ; gosub emit.numeric.load  ;* Number of components
      opcode.byte = OP.FIELD ; gosub emit.simple

      if dparse.field.ref then
         opcode.byte = OP.REP ; gosub emit.simple
      end else
         opcode.byte = OP.STOR ; gosub emit.simple
      end

   while look.ahead.token = TKN.COMMA
      gosub get.token
   repeat

   return

*****************************************************************************
* ST.DPARSE.CSV  -  DPARSE.CSV statement

st.dparse.csv:
   * Convert and save string to parse in temp var 1

   n = 1 ; gosub emit.temp.ref
   gosub expr                                    ;* Source string
   gosub check.comma
   gosub expr                                    ;* Delimiter

   opcode.byte = OP.CSVDQ ; gosub emit.simple
   opcode.byte = OP.STOR ; gosub emit.simple

   gosub check.comma

st.dparse.input:     ;* Enter here from INPUTCSV and READCSV
   * Emit code to parse each item

   dparse.ct = 0
   loop
      dparse.ct += 1

      * Emit target

      if look.ahead.token # TKN.NAME and look.ahead.token # TKN.NAME.LBR then
         goto err.var
      end
      gosub get.token

      gosub emit.lvar.reference

      if look.ahead.token = TKN.LT then   ;* It's a field reference
         dparse.field.ref = @true
         format.qualifier.allowed = @false
         gosub is.field.ref
         if ifr.index = 0 then
            err.msg = sysmsg(2833)  ;* Improperly formed field assignment
            goto error
         end

         gosub get.token       ;* Skip < token
         gosub emit.field.reference
         if err then return
      end else
         dparse.field.ref = @false
      end

      n = 1 ; gosub emit.temp.ref      ;* String
      n = 1 ; gosub emit.numeric.load
      opcode.byte = OP.RMVF ; gosub emit.simple

      if dparse.field.ref then
         opcode.byte = OP.REP ; gosub emit.simple
      end else
         opcode.byte = OP.STOR ; gosub emit.simple
      end
   while look.ahead.token = TKN.COMMA
      gosub get.token
   repeat

   return

*****************************************************************************
* ST.ECHO  -  ECHO statement

st.echo:
   if look.ahead.token = TKN.END then
      err.msg = sysmsg(2902) ;* Expected ON, OFF or expression
      goto error
   end

   n = syscom.echo.input ; gosub emit.ldsys

   begin case
      case (u.look.ahead.token.string = "ON") ;* 0504
         gosub get.token
         n = 1 ; gosub emit.numeric.load

      case (u.look.ahead.token.string = "OFF") ;* 0504
         gosub get.token
         n = 0 ; gosub emit.numeric.load

      case 1
         gosub expr
         opcode.byte = OP.INT ; gosub emit.simple
   end case

   opcode.byte = OP.STOR ; gosub emit.simple

   return

*****************************************************************************
* ST.END

st.end:
   begin case
      case lsub.var.no >= 0  ;* In a local function/subroutine
         opcode.byte = OP.STOP ; gosub emit.simple
         lsub.var.no = -1

      case object.state = 3  ;* GET or PUBLIC FUNCTION
         opcode.byte = OP.LDUNASS ; gosub emit.simple
         opcode.byte = OP.RETURN ; gosub emit.simple
         object.state = 2
         object.arg.names = ''

      case object.state = 4  ;* SET or PUBLIC SUBROUTINE
         opcode.byte = OP.RETURN ; gosub emit.simple
         object.state = 2
         object.arg.names = ''

      case 1
         * All other uses of END except the end of the program are trapped
         * elsewhere. There must be nothing but comments (hence blank lines as
         * returned by the parser) to the end of the source.

         final.end.seen = @true

         loop
         until end.source
            if look.ahead.token then
               err.msg = sysmsg(2903) ;* Non-comment text found after final END statement
               gosub error
               end.source = @true    ;* Force end of processing
               exit
            end
            gosub get.token
         repeat
   end case
   
   return

*****************************************************************************
* ST.ENTER  -  ENTER statement

st.enter:
   if not(bittest(mode, M.PICK.ENTER)) then goto st.call

   begin case
      case look.ahead.token = TKN.AT.NAME      ;* Indirect call
         gosub get.token    ;* Skip @ token
         gosub simple.var.reference
         if err then return

      case (look.ahead.token = TKN.NAME) or (look.ahead.token.string = '!')  or (look.ahead.token.string = '*') or (look.ahead.token = TKN.DOLLAR)
         * Direct call

         gosub get.call.name                 ;* Read name token
         gosub emit.direct.call.reference

      case 1
         err.msg = sysmsg(2883) ;* Expected direct or indirect subroutine reference
         goto error
   end case

   opcode.byte = OP.ENTER ; gosub emit.simple

   return

*****************************************************************************
* ST.EQUATE  -  EQUATE statement

st.equate:
   loop
      if look.ahead.token # TKN.NAME then
         err.msg = sysmsg(2904) ;* Equate token name not found where expected
         goto error
      end

      gosub get.token
      define.token = token.string

      if u.look.ahead.token.string # "TO" then goto err.to
      gosub get.token

      gosub get.token
      begin case
         case token = TKN.NUM
            equate.token.data = '1' : token.string

         case token = TKN.HEXNUM
            equate.token.data = '0':xtd(token.string)

         case token = TKN.STRING
            equate.token.data = '0' : token.string

         case token = TKN.FLOAT
            equate.token.data = '1' : token.string

         case token = TKN.PLUS
            gosub get.token
            if token # TKN.NUM and token # TKN.FLOAT then
               err.msg = sysmsg(2905) ;* Misformed EQUATE
               goto error
            end
            equate.token.data = '1' : token.string

         case token = TKN.MINUS
            gosub get.token
            if token # TKN.NUM and token # TKN.FLOAT then
               err.msg = sysmsg(2905) ;* Misformed EQUATE
               goto error
            end
            equate.token.data = '1-' : token.string

         case token = TKN.NAME.LBR
            if u.token.string = 'CHAR' then
               gosub get.token          ;* Skip bracket
               gosub get.token
               if token # TKN.NUM then
                  err.msg = sysmsg(2906) ;* Expected character number
                  goto error
               end
               if token.string < 0 or token.string > 255 then
                  err.msg = sysmsg(2907) ;* Character number must be in range 0 to 255
                  goto error
               end
               equate.token.data = '3' : token.string
            end else
               equate.token.data = '2' : token.string   ;* Matrix name
               gosub get.token          ;* Skip bracket
               if look.ahead.token # TKN.NUM then
                  err.msg = sysmsg(2908) ;* Matrix index not found where expected
                  goto error
               end
               gosub get.token
               equate.token.data := ' ' : token.string
               if look.ahead.token = TKN.COMMA then
                  gosub get.token      ;* Skip comma
                  if look.ahead.token # TKN.NUM then
                     err.msg = sysmsg(2908) ;* Matrix index not found where expected
                     goto error
                  end
                  gosub get.token
                  equate.token.data := ' ' : token.string
               end
            end

            if look.ahead.token # TKN.RBR then goto err.rbr
            gosub get.token   ;* 0187 Moved from before WHILE below

         case token = TKN.NAME
            equate.token.data = '4' : token.string   ;* Variable name

            * Check to see if this is a defined token
            s = find(defined.tokens, token.string)
            if not(status()) then equate.token.data = s

         case token = TKN.AT.NAME
            gosub get.token
            equate.token.data = '5' : token.string

         case 1
            err.msg = sysmsg(2905) ;* Misformed EQUATE
            goto error
      end case

      * 0321 Check if this token is already known as a variable

      locate define.token in symbols<1> by 'AL' setting i then
         err.msg = sysmsg(3408, define.token) ;* Token is already defined as a variable
         goto error
      end

      * Check if this token is already known as an equated token

      s = find(defined.tokens, define.token)
      if not(status()) then
         err.msg = sysmsg(2839) ;* Duplicate EQUATE / $DEFINE token
         goto error
      end

      add define.token, equate.token.data to defined.tokens
   while look.ahead.token = TKN.COMMA
      gosub get.token
   repeat

   return

*****************************************************************************
* ST.ERRMSG  -  ERRMSG statement

st.errmsg:
   gosub exprf
   gosub emit.errmsg.args
   opcode.byte = OP.ERRMSG ; gosub emit.simple
   return

*****************************************************************************
* ST.EXECUTE  -  EXECUTE statement
* EXECUTE xxx {TRAPPING ABORTS}        Options may be in any order
*             {CAPTURING var}
*             {PASSLIST var}
*             {RTNLIST var}
*             {SETTING | RETURNING var}
*             {CURRENT.LEVEL}            (restricted)

st.execute:
   n = syscom.xeq.command
   gosub emit.ldsys

   * 0265 Add local reserved names
   reserved.names<2> = "CAPTURINGPASSLISTRETURNINGRTNLISTTRAPPINGCURRENT.LEVEL"

   gosub exprf
   opcode.byte = OP.STOR ; gosub emit.simple

   execute.flags = 0

   * Look for options

   loop
      begin case
         case u.look.ahead.token.string = "CURRENT.LEVEL" and internal
            gosub get.token
            execute.flags = bitor(execute.flags, 0x20)

         case u.look.ahead.token.string = "TRAPPING"

            if bitand(execute.flags, 1) then
               err.msg = sysmsg(2909) ;* Multiple instances of TRAPPING clause
               goto error
            end

            gosub get.token
            if u.look.ahead.token.string # "ABORTS" then
               err.msg = sysmsg(2910) ;* Expected ABORTS after TRAPPING
               goto error
            end

            gosub get.token
            execute.flags = bitor(execute.flags, 1)

         case u.look.ahead.token.string = "CAPTURING"
            if bitand(execute.flags, 2) then
               err.msg = sysmsg(2911) ;* Multiple instances of CAPTURING clause
               goto error
            end

            gosub get.token
            gosub simple.lvar.reference   ;* Emit LDLCL etc for target
            opcode.byte = OP.DUP ; gosub emit.simple
            opcode.byte = OP.LDNULL ; gosub emit.simple
            opcode.byte = OP.STOR ; gosub emit.simple
            execute.flags = bitor(execute.flags, 2)

            if bitand(execute.flags, 4) then
               * We have found a CAPTURING after a RTNLIST. The addresses
               * on the stack must be swapped to be in the order that
               * op_execute() expects them.
               opcode.byte = OP.SWAP ; gosub emit.simple
            end

         case u.look.ahead.token.string = "PASSLIST"
            gosub get.token

            * 2.2-13 For compatibility with other systems, the PASSLIST option
            * can be used without a qualifying name. This implies that list 0
            * is to be passed in to the executed command. Given that this is
            * the default behaviour of QM anyway, we simply ignore the PASSLIST
            * if there is no qualifier.

            if look.ahead.token # TKN.END and look.ahead.token # TKN.SEMICOLON then
               find u.look.ahead.token.string in reserved.names setting i else
                  if bitand(execute.flags, 8) then
                     err.msg = sysmsg(2912) ;* Multiple instances of PASSLIST clause
                     goto error
                  end

                  gosub simple.var.reference   ;* Emit LDLCL etc for source
                  opcode.byte = OP.PASSLIST ; gosub emit.simple
                  execute.flags = bitor(execute.flags, 8)
               end
            end

         case u.look.ahead.token.string = "SETTING" or u.look.ahead.token.string = "RETURNING"
            if bitand(execute.flags, 16) then
               err.msg = sysmsg(3409) ;* Multiple instances of SETTING/RETURNING clause
               goto error
            end

            n = 1 ; gosub emit.temp.ref
            gosub get.token
            gosub simple.lvar.reference   ;* Emit LDLCL etc for target
            opcode.byte = OP.SAVEADDR ; gosub emit.simple
            execute.flags = bitor(execute.flags, 16)

         case u.look.ahead.token.string = "RTNLIST"
            if bitand(execute.flags, 4) then
               err.msg = sysmsg(2913) ;* Multiple instances of RTNLIST clause
               goto error
            end

            gosub get.token
            gosub simple.lvar.reference   ;* Emit LDLCL etc for target
            opcode.byte = OP.DUP ; gosub emit.simple
            opcode.byte = OP.LDNULL ; gosub emit.simple
            opcode.byte = OP.STOR ; gosub emit.simple
            execute.flags = bitor(execute.flags, 4)

         case 1
            exit
      end case
   repeat

   del reserved.names<2>

   if print.code then
      s = "EXECUTE  " : execute.flags
      gosub show.code
    end

   opcode.byte = OP.EXECUTE ; gosub emit
   opcode.byte = execute.flags ; gosub emit

   if bitand(execute.flags, 4) then  ;* Transfer select list 0 to var
      opcode.byte = OP.RTNLIST ; gosub emit.simple
   end

   if bitand(execute.flags, 2) then  ;* Transfer captured command output
      opcode.byte = OP.CAPTURE ; gosub emit.simple
   end

   if bitand(execute.flags, 16) then  ;* Transfer @system.return.code
      n = 1 ; gosub emit.temp.ref
      n = syscom.system.return.code ; gosub emit.ldsys      
      opcode.byte = OP.STOR ; gosub emit.simple
   end

   return

*****************************************************************************
* ST.FILE  -  FILE statement

st.file:
   loop
      gosub get.token      ;* Get file name
      file.statement.name = token.string
      open 'DICT', file.statement.name to file.d(0) else
         file.statement.name = upcase(file.statement.name)
         open 'DICT', file.statement.name to file.d(0) else
            err.msg = sysmsg(7018, token.string) ;* Cannot open dictionary for file %1
            goto error
         end
      end

      locate upcase(file.statement.name) in file.refs<1> setting pos then
         err.msg = sysmsg(3412, file.statement.name) ;* File %1 is referenced more than once in FILE statements      end
         goto error
      end

      i = dcount(file.refs, @fm) + 1
      file.refs<i> = upcase(file.statement.name)
      n = inmat(file.d) ; if i > n then dim file.d(n + 5)
      file.d(i) = file.d(0) ; file.d(0) = 0

      * Reserve a variable for the data record

      symbol.name = file.statement.name
      symbol.mode = SYM.CHK
      gosub find.var
      if symbol.var.no >= 0 then goto err.file
      symbol.dim = 0
      symbol.common.offset = -1
      symbol.mode = SYM.CHK
      gosub make.var

      * Allocate the file variable and emit code to open the file

      opcode.string = '' ; gosub emit.string.load
      opcode.string = file.statement.name ; gosub emit.string.load

      symbol.name = '__':file.statement.name
      symbol.mode = SYM.SET
      gosub find.var
      if symbol.var.no >= 0 then goto err.file
      symbol.dim = 0
      symbol.common.offset = -1
      symbol.mode = SYM.SET
      gosub make.var
      gosub emit.var.load

      opcode.byte = OP.OPEN ; gosub emit.simple
      * Discard the error flag (there is no error handling)
      opcode.byte = OP.POP ; gosub emit.simple

   while look.ahead.token = TKN.COMMA
      gosub get.token
   repeat

   return

*****************************************************************************
* ST.FILELOCK    -  FILELOCK statement
* ST.FILEUNLOCK  -  FILEUNLOCK statement

st.filelock:
   opcode = OP.FILELOCK
   goto st.filelock.common

st.fileunlock:
   opcode = OP.FLUNLOCK

st.filelock.common:
   gosub convert.pick.file.reference
   gosub simple.var.reference   ;* Emit file variable
   if err then return

   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins '1' before testlock.stack<1>     ;* Optional LOCKED clause
   ins '0' before thenelse.stack<1>     ;* No THEN / ELSE clause
   goto back.end

*****************************************************************************
* ST.FIND  -  FIND statement
* ST.FINDSTR  -  FINDSTR statement

st.find:
   opcode = OP.FIND
   goto st.find.common

st.findstr:
   opcode = OP.FINDSTR

st.find.common:
   gosub exprf                         ;* Emit search expression

   if u.look.ahead.token.string # "IN" then goto err.in
   gosub get.token                    ;* Skip IN

   gosub exprf                         ;* Emit dynamic array reference
   if err then return

   if look.ahead.token = TKN.COMMA then
      gosub get.token                  ;* Skip comma
      gosub exprf                      ;* Emit occurrence expression
   end else
      n = 1 ; gosub emit.numeric.load  ;* Default occurrence = 1
   end

   if u.look.ahead.token.string # "SETTING" then
      err.msg = sysmsg(2914) ;* SETTING not found where expected
      goto error
   end
   gosub get.token                    ;* Skip SETTING

   gosub simple.lvar.reference         ;* Field variable
   if err then return

   if look.ahead.token = TKN.COMMA then
      gosub get.token
      gosub simple.lvar.reference      ;* Value variable
      if err then return
   end else
      opcode.byte = OP.LD0  ; gosub emit.simple
   end

   if look.ahead.token = TKN.COMMA then
      gosub get.token
      gosub simple.lvar.reference      ;* Subvalue variable
      if err then return
   end else
      opcode.byte = OP.LD0  ; gosub emit.simple
   end

   opcode.byte = opcode ; gosub emit.simple

   goto st.if.back.end           ;* Join IF statement for THEN / ELSE

*****************************************************************************
* ST.FLUSH   -  FLUSH statement

st.flush:
   gosub simple.var.reference   ;* Emit file variable

   * Perform common back-end processing

   opcode = OP.FLUSH
   ins '0' before onerror.stack<1>        ;* No ON ERROR clause
   ins '0' before testlock.stack<1>       ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>       ;* THEN / ELSE clause required
   goto back.end

*****************************************************************************
* ST.FOOTING  -  FOOTING statement
* ST.HEADING  -  HEADING statement

st.footing:
   opcode = OP.FOOTING
   goto head.foot.common

st.heading:
   opcode = OP.HEADING

   if u.look.ahead.token.string = 'NO.EJECT' then
      gosub get.token
      opcode = OP.HEADINGN
   end

head.foot.common:
   if u.look.ahead.token.string = "ON" then
      gosub get.token            ;* Skip "ON"

      gosub expr
   end else
      n = 0 ; gosub emit.numeric.load
   end

   gosub exprf
   opcode.byte = opcode ; gosub emit.simple

   return

*****************************************************************************
* ST.FOR  -  FOR statement

st.for:
   * Add new entry to jump stack
   ins j.for:@vm:jump.no before jump.stack<1>
   jump.no += 1

   * Read and hold on to loop control variable name

   if look.ahead.token # TKN.NAME and look.ahead.token # TKN.NAME.LBR then
      err.msg = sysmsg(2915) ;* FOR loop control variable name not found where expected
      goto error
   end

   * Save control variable name and its position in the token list

   ins look.ahead.token.string:@vm:token.index:@vm:token.index before for.var<1>
   gosub get.token

   * If this is a dimensioned array reference, remember start of index
   * expression

   if look.ahead.token = TKN.LBR then
      gosub get.token

      * Skip forwards to a corresponding right bracket
      n = 1
      loop
         gosub get.token
         if token = TKN.END then goto err.rbr
         if token = TKN.LBR then n += 1
         if token = TKN.RBR then n -= 1
      while n
      repeat
      for.var<1,3> = token.index - 1  ;* Points to right bracket
   end

   * Check for "=" token

   if look.ahead.token # TKN.EQ then
      err.msg = sysmsg(2916) ;* Expected '=' after FOR loop control variable name
      goto error
   end
   gosub get.token            ;* Skip "="
   gosub expr                 ;* Emit initial value

   * Emit FORINIT opcode

   opcode.byte = OP.FORINIT ; gosub emit.simple

   * Generate repeat label
   label.name = "_" : (jump.no - 1) : "R"
   gosub set.label
   
   * Check for TO
   * This is done here because the emit.var.reference call below would go
   * wrong if the look-ahead token was a left bracket.

   if u.look.ahead.token.string # "TO" then goto err.to

   * Emit load of control variable
   * This is nasty. Because we need to allow for complex expression such as
   *  FOR A(B+2) = 1 TO 10
   * we cannot just grab hold of the index item above. Instead, we must now
   * process the index expression that we skipped over earlier by rewinding
   * the token processing position, generating the expression and then putting
   * it all back as it was.

   for.pos = token.index
   token.index = for.var<1,2>
   tokens(for.var<1,3> + 1) = TKN.END  ;* Replace = with end marker
   look.ahead.token = tokens(token.index)
   look.ahead.token.string = token.strings(token.index)
   u.look.ahead.token.string = upcase(look.ahead.token.string)
   gosub get.token
   
   gosub emit.lvar.reference

   token.index = for.pos
   look.ahead.token = tokens(token.index)
   look.ahead.token.string = token.strings(token.index)
   u.look.ahead.token.string = upcase(look.ahead.token.string)

   * Emit final value

   gosub get.token            ;* Skip TO
   reserved.names<2> = "STEP"
   gosub expr
   del reserved.names<2>

   * Emit step value   

   if u.look.ahead.token.string = "STEP" then
      gosub get.token         ;* Skip STEP
      gosub expr
      if bittest(mode, M.FOR.STORE.BEFORE.TEST) then opcode.byte = OP.FORLOOPS
      else opcode.byte = OP.FORLOOP
      gosub emit.simple
   end else
      if bittest(mode, M.FOR.STORE.BEFORE.TEST) then opcode.byte = OP.FOR1S
      else opcode.byte = OP.FOR1
      gosub emit.simple
   end

   label.name = "_":jump.stack<1,2>:"X"
   gosub emit.addr

   if look.ahead.token = TKN.NAME then
      begin case
         case u.look.ahead.token.string = 'WHILE'
         case u.look.ahead.token.string = 'UNTIL'
         case 1
            goto err.syntax
      end case
   end
   
   return

*****************************************************************************
* ST.FORMLIST   -  FORMLIST statement

st.formlist:
   * Emit source expression

   gosub exprf

   if u.look.ahead.token.string = "TO" then
      gosub get.token       ;* Skip TO
      gosub exprf            ;* Emit list number expression
   end else     ;* Use default select list
      n = 0 ; gosub emit.numeric.load
   end

   opcode.byte = OP.FORMLIST ; gosub emit.simple
   return

*****************************************************************************
* ST.FUNCTION  -  FUNCTION statement

st.function:
   if is.ctype then goto err.ctype
   if name.set then goto err.name.set

   if pc # start.pc then
      err.msg = sysmsg(2918) ;* FUNCTION must appear before any executable statements
      goto error
   end

   * Get name of function

   if look.ahead.token # TKN.LBR then
      gosub get.call.name
      program.name = s[1,HDR.PROGRAM.NAME.LEN]
      if len(s) > HDR.PROGRAM.NAME.LEN then
         err.msg = sysmsg(2919) ;* Function name has been truncated for catalogue name
         gosub warning
      end
   end

   name.set = @true

   * Insert implicit return argument

   symbol.name = "_FUNCRET"
   symbol.dim = 0
   symbol.common.offset = -1
   symbol.mode = SYM.SET
   gosub make.var

   header.flags = bitor(header.flags, hdr.is.function)
   subr.arg.count = 1

   * Process any further arguments

   if look.ahead.token = TKN.LBR then
      gosub get.token

      if look.ahead.token # TKN.RBR then   ;* Arguments present
         loop
            deref.argument = @false

            if u.look.ahead.token.string = "MAT" then
               dim.dimensions = -1   ;* Indicates not yet known
               gosub get.token
               if err then return
               if look.ahead.token # TKN.NAME then goto err.var
            end else
               dim.dimensions = 0

               if look.ahead.token = TKN.LBR then
                  * Need to dereference this argument
                  deref.argument = @true
                  gosub get.token
               end
            end

            gosub get.var.name              ;* Get argument variable name
         until err

            * Check that variable is not present twice in argument list

            symbol.name = token.string
            symbol.mode = SYM.ARG
            gosub find.var

            if symbol.var.no >= 0 then
               err.msg = sysmsg(2920, symbol.name) ;* Duplicate argument name 'xx'
               goto error
            end

            if look.ahead.token = TKN.LBR then  ;* Matrix dimensions
               gosub get.arg.mat.dimensions
            end

            * Make variable for argument

            symbol.common.offset = -1
            symbol.dim = dim.dimensions
            symbol.mode = SYM.ARG
            gosub make.var

            if deref.argument then
               if look.ahead.token # TKN.RBR then goto err.rbr
               gosub get.token
               gosub emit.var.load
               opcode.byte = OP.DEREF ; gosub emit.simple
            end

            subr.arg.count += 1

         while look.ahead.token = TKN.COMMA
            gosub get.token
            if look.ahead.token = TKN.END then gosub get.token
         repeat

         if subr.arg.count > 255 then
            err.msg = sysmsg(2898) ;* Too many arguments in function definition
            goto error
         end

         if look.ahead.token # TKN.RBR then goto err.rbr
      end

      gosub get.token     ;* Skip close bracket
   end

   if u.look.ahead.token.string = 'VAR.ARGS' then
      gosub get.token
      header.flags = bitor(header.flags, HDR.VAR.ARGS)
   end

   return

*****************************************************************************
* ST.GOSUB  -  GOSUB statement

st.gosub:
   gosub get.label.name

   int.sub.call.args = ''
   if look.ahead.token = TKN.LBR then       ;* Arguments present
      gosub process.int.sub.args
      if err then return
   end

   locate label.name in int.subs<1> setting pos then
      if int.sub.call.args # int.sub.args<pos> then
         err.msg = sysmsg(3426) ;* Inconsistent argument lists in internal subroutine reference
         goto error
      end
   end else
      ins label.name before int.subs<1>        ;* Insert at front so that...
      ins int.sub.call.args before int.sub.args<1> ;* ...null entries work
      ins @false before int.sub.is.lsub<1>
   end

   opcode.byte = OP.GOSUB ; gosub emit.jump

   if look.ahead.token # TKN.END and look.ahead.token # TKN.SEMICOLON then
      find u.look.ahead.token.string in reserved.names setting n else
         goto err.syntax
      end
   end
   return

*****************************************************************************
* ST.GOTO  -  GOTO statement

st.go:
   if u.look.ahead.token.string = "TO" then
      gosub get.token
   end

st.goto:
   gosub get.label.name
   if lsub.var.no >= 0 then label.name = lsub.name:label.name
   opcode.byte = OP.JMP ; gosub emit.jump

   return

*****************************************************************************
* ST.GETLIST  -  GETLIST statement

st.getlist:
   gosub exprf
   if u.look.ahead.token.string = 'TO' then
      gosub get.token
      gosub exprf
   end else
      n = 0 ; gosub emit.numeric.load
   end
   opcode.byte = OP.GETLIST ; gosub emit.simple
   goto st.if.back.end           ;* Join IF statement for THEN / ELSE

*****************************************************************************
* ST.HUSH  -  HUSH statement

st.hush:
   if look.ahead.token = TKN.END then
      err.msg = "Expected ON, OFF or expression"
      goto error
   end


   begin case
      case (u.look.ahead.token.string = "ON") ;* 0504
         gosub get.token
         n = 1 ; gosub emit.numeric.load

      case (u.look.ahead.token.string = "OFF") ;* 0504
         gosub get.token
         n = 0 ; gosub emit.numeric.load

      case 1
         gosub expr
   end case

   opcode.byte = OP.HUSH ; gosub emit.simple

   if u.look.ahead.token.string = "SETTING" then
      gosub get.token            ;* Skip SETTING

      gosub simple.var.reference ; if err then return
      opcode.byte = OP.STATUS ; gosub emit.simple
      opcode.byte = OP.STOR ; gosub emit.simple
   end

   return

*****************************************************************************
* ST.IF  -  IF statement
*
st.if:
   gosub exprf      ;* Process conditional expression

st.if.back.end:

   * Add new entry to jump stack
   ins j.if:@vm:jump.no before jump.stack<1>

   jump.no += 1

   * Look for a THEN token on the current line

   if look.ahead.token = TKN.END then     ;* Nothing further on this line
      gosub get.token
      gosub emit.xref.entry
   end

   gosub get.token
   if u.token.string # "THEN" then          ;* No THEN clause
      if u.token.string # "ELSE" then
         err.msg = sysmsg(2921) ;* Expected THEN or ELSE clause
         gosub error
         goto exit.if
      end

      * ELSE clause present without THEN clause. 
      * Generate jump to exit label
      label.name = "_":jump.stack<1,2>:"X"
      opcode.byte = OP.JTRUE ; gosub emit.jump
      goto if.else.clause
   end

   * Generate jump to ELSE clause (or end if no ELSE)
   label.name = "_":jump.stack<1,2>:"E"
   opcode.byte = OP.JFALSE ; gosub emit.jump

   if look.ahead.token = TKN.END then     ;* THEN / END construct
      gosub get.token
      loop
         if end.source then
            err.msg = sysmsg(2922) ;* Unterminated THEN clause
            gosub error
            goto exit.if
         end

         * 0336 Check for a label
         * We must treat these as a special case here as otherwise a labelled
         * END will not be trapped below and will cause the END to be paired
         * up incorrectly

         gosub get.token
         gosub check.for.label

      until u.token.string = "END"
         gosub proc.line.prefetched
      repeat
   end else                               ;* Conditional statement on same line
      gosub get.token
      gosub proc.statement.group
   end

   * Look for an ELSE clause

   if look.ahead.token = TKN.END then    ;* Nothing further on this line
      gosub get.token
!0288      gosub emit.xref.entry
   end

   if u.look.ahead.token.string = "ELSE" then   ;* ELSE clause present
      gosub emit.xref.entry   ;* 0288 Moved from above
      gosub get.token        ;* Skip ELSE token

      * Check that the top of the jump stack is an IF construct
      if jump.stack<1,1> # j.if then
         err.msg = sysmsg(2924) ;* Misplaced ELSE
         gosub error
         goto exit.if
      end

      * Emit jump to exit label
      label.name = "_":jump.stack<1,2>:"X"
      opcode.byte = OP.JMP ; gosub emit.jump

      * Set label for head of ELSE clause
      label.name = "_":jump.stack<1,2>:"E"
      gosub set.label

if.else.clause:

      if look.ahead.token = TKN.END then     ;* ELSE / END construct
         gosub get.token
         loop
            if end.source then
               err.msg = sysmsg(2923) ;* Unterminated ELSE clause
               gosub error
               goto exit.if
            end

            * 0336 Check for a label
            gosub get.token
            gosub check.for.label

            until u.token.string = "END"
            gosub proc.line.prefetched
         repeat
      end else                           ;* Conditional statement on same line
         gosub get.token
         gosub proc.statement.group
      end

      * Check that the top of the jump stack is an IF construct
      if jump.stack<1,1> # j.if then
         err.msg = sysmsg(2926) ;* Incorrectly formed ELSE clause
         gosub error
         goto exit.if
      end

      * Set "X" label at end of construct
      label.name = "_":jump.stack<1,2>:"X"
      gosub set.label
   end else                          ;* No ELSE clause present
      * Check that the top of the jump stack is an IF construct
      if jump.stack<1,1> # j.if then
         err.msg = sysmsg(2925) ;* Incorrectly formed THEN clause
         gosub error
         goto exit.if
      end

      * Set "E" label at end of construct
      label.name = "_":jump.stack<1,2>:"E"
      gosub set.label
   end

exit.if:
   del jump.stack<1>

   return

*****************************************************************************
* ST.IN

st.in:
   gosub get.token            ;* Get name of target variable
   gosub emit.lvar.reference

   if u.look.ahead.token.string = 'FOR' then      ;* Timeout clause present
      gosub get.token               ;* Skip FOR
      opcode.byte = OP.DUP ; gosub emit.simple
      gosub expr
      opcode.byte = OP.IN ; gosub emit.simple
      opcode.byte = OP.STOR   ; gosub emit.simple
      if u.look.ahead.token.string = 'THEN' or u.look.ahead.token.string = 'ELSE' then
         goto st.if.back.end
      end
      opcode.byte = OP.POP ; gosub emit.simple
   end else
      opcode.byte = OP.LD0 ; gosub emit.simple
      opcode.byte = OP.IN ; gosub emit.simple
      opcode.byte = OP.STOR  ; gosub emit.simple
   end

   return

*****************************************************************************
* ST.INCLUDE  -  INCLUDE statement (not $INCLUDE directive)

st.include:
   * The INCLUDE statement has to be processed directly from the source
   * rather than via the token parser as the format of operating system
   * file names may clash with our token definitions. To allow for labels,
   * strip off everything before the "INCLUDE".

   s = upcase(src)
   i = index(s, 'INCLUDE', 1)
   src = src[i,99999]

   gosub process.include

   * Now, kill off the rest of this line

   loop while token do gosub get.token repeat

   return

*****************************************************************************
* ST.INPUT  -  INPUT statement
* ST.INPUTFIELD  -  INPUT.FIELD statement
* ST.KEYBOARD.INPUT  -  KEYBOARD.INPUT statement (restricted)

st.input:
   input.flags = 0
   goto st.input.common

st.inputfield:
   input.flags = IN$FIELD.MODE
   goto st.input.common

st.keyboard.input:
   input.flags = IN$NOT.DATA

st.input.common:
   if look.ahead.token = TKN.AT then         ;* INPUT @
      gosub get.token   ;* Skip @ token
      if look.ahead.token # TKN.LBR then goto err.lbr

      gosub get.token   ;* Skip left bracket
      gosub exprf        ;* Get column expression
      gosub check.comma
      gosub exprf        ;* Get row expression

      if look.ahead.token # TKN.RBR then goto err.rbr

      gosub get.token   ;* Skip right bracket

      * Skip comma if present

      if look.ahead.token = TKN.COMMA then gosub get.token

      * Look for colon (display existing data)

      if look.ahead.token = TKN.COLON then
         input.flags += in$display
         gosub get.token
      end

      * Emit reference to target variable

      gosub simple.lvar.reference
      if err then return

      * Emit maximum input string length

      if look.ahead.token = TKN.COMMA then
         gosub get.token     ;* Skip comma
         gosub expr1
      end else
         if bitand(input.flags, IN$FIELD.MODE) then
            err.msg = sysmsg(2928) ;* Length is mandatory in INPUTFIELD
            goto error
         end

         n = 0 ; gosub emit.numeric.load
      end

      * Check for underscore

      if look.ahead.token = TKN.UNDERSCORE then
         gosub get.token
         input.flags += IN$NOCRLF
      end

      * Check for trailing colon

      if look.ahead.token = TKN.COLON then
         gosub get.token
         input.flags += IN$NOLF
      end

      reserved.names<2> = "APPENDEDITFORHIDDENOVERLAYPANNINGTIMEOUTUPCASEWAITING"

      * Check for mask

      if look.ahead.token # TKN.END and look.ahead.token # TKN.SEMICOLON then
         find u.look.ahead.token.string in reserved.names setting i else
            gosub expr
            input.flags += IN$MASK
         end
      end

      * Handle any special input options

      loop
         begin case
            case u.look.ahead.token.string = 'APPEND'
               gosub get.token
               input.flags = bitor(input.flags, IN$EDIT + IN$APPEND)

            case u.look.ahead.token.string = 'EDIT'
               gosub get.token
               input.flags = bitor(input.flags, IN$EDIT)

            case listindex('FOR,TIMEOUT,WAITING', ',', u.look.ahead.token.string)
               gosub get.token
               input.flags = bitor(input.flags, IN$TIMEOUT)
               gosub expr

            case u.look.ahead.token.string = 'HIDDEN'
               gosub get.token
               input.flags = bitor(input.flags, IN$PASSWORD)

            case u.look.ahead.token.string = 'OVERLAY'
               gosub get.token
               input.flags = bitor(input.flags, IN$OVERLAY)

            case u.look.ahead.token.string = 'PANNING'
               gosub get.token
               input.flags = bitor(input.flags, IN$PANNING + IN$NOCRLF)

            case u.look.ahead.token.string = 'UPCASE'
               gosub get.token
               input.flags = bitor(input.flags, IN$UPCASE)

            case 1
               exit
         end case
      repeat

      opcode = OP.INPUTAT
   end else                                  ;* INPUT
      * Emit reference to target variable

      gosub simple.lvar.reference
      if err then return

      reserved.names<2> = "FORHIDDENTIMEOUTUPCASEWAITING"

      * Emit maximum input string length

      if look.ahead.token = TKN.COMMA then
         gosub get.token     ;* Skip comma
         * 1.1-9 The line below was GOSUB EXPR1 but was changed to allow
         * an expression for the length.  We can do this for INPUT but not
         * for INPUT @ because
         *    INPUT @(10,5):VAR,N:"5R"
         * is ambiguous.

         gosub expr
      end else
         n = 0 ; gosub emit.numeric.load
      end

      * Check for underscore and/or colon and special input options
      * (allowed in any order)

      loop
         begin case
            case look.ahead.token = TKN.UNDERSCORE
               gosub get.token
               input.flags += IN$NOCRLF

            case look.ahead.token = TKN.COLON
               gosub get.token
               input.flags += IN$NOLF

            case u.look.ahead.token.string = 'HIDDEN'
               gosub get.token
               input.flags = bitor(input.flags, IN$PASSWORD)

            case u.look.ahead.token.string = 'UPCASE'
               gosub get.token
               input.flags = bitor(input.flags, IN$UPCASE)

            case listindex('FOR,TIMEOUT,WAITING', ',', u.look.ahead.token.string)
               gosub get.token
               input.flags = bitor(input.flags, IN$TIMEOUT)
               gosub expr

            case 1
               exit
         end case
      repeat

      opcode = OP.INPUT
   end

   del reserved.names<2>

   loop
   while look.ahead.token = TKN.END
   until end.source          ;* 0478
      gosub get.token
   repeat

   if u.look.ahead.token.string = 'THEN' or u.look.ahead.token.string = 'ELSE' then
      input.flags = bitor(input.flags, IN$THENELSE)
   end

   * Emit flags

   n = input.flags ; gosub emit.numeric.load
   opcode.byte = opcode ; gosub emit.simple
   
   if input.flags = bitor(input.flags, IN$THENELSE) then goto st.if.back.end

   return

*****************************************************************************
* ST.INPUTCSV  -  INPUTCSV statement

st.inputcsv:
   n = 1 ; gosub emit.temp.ref        ;* Temp var used by DPARSE.CSV
   n = 2 ; gosub emit.temp.ref        ;* Temporary variable for input data
   n = 0 ; gosub emit.numeric.load    ;* No input length limit
   n = 0 ; gosub emit.numeric.load    ;* Flags all off
   opcode.byte = OP.INPUT ; gosub emit.simple
   n = 2 ; gosub emit.temp.ref        ;* Load input data onto stack
   opcode.string = ',' ; gosub emit.string.load  ;* Delimiter
   opcode.byte = OP.CSVDQ ; gosub emit.simple
   opcode.byte = OP.STOR ; gosub emit.simple
   goto st.dparse.input

*****************************************************************************
* ST.INS  -  INS statement

st.ins:
   gosub exprf

   if u.look.ahead.token.string # "BEFORE" then
      err.msg = sysmsg(2929) ;* BEFORE not found where expected
      goto error
   end

   gosub get.token          ;* Skip BEFORE

   gosub simple.lvar.reference ; if err then return

   if look.ahead.token # TKN.LT then
      err.msg = sysmsg(2899) ;* Field reference not found where expected
      goto error
   end

   format.qualifier.allowed = @false
   gosub is.field.ref  ;* Find matching >

   gosub get.token

   gosub emit.field.reference ; if err then return

   opcode.byte = if bittest(mode, M.COMPAT.APPEND) then OP.COMPINS else OP.ins
   gosub emit.simple

   return

*****************************************************************************
* ST.KEYEDIT  -  KEYEDIT statement

st.keyedit:
   opcode = OP.KEYEDIT
   goto keyedit.common

st.keyexit:
   opcode = OP.KEYEXIT
   goto keyedit.common

st.keytrap:
   opcode = OP.KEYTRAP

keyedit.common:
   loop
      gosub get.token
      if token # TKN.LBR then goto err.lbr
      gosub expr
      gosub check.comma
      gosub expr
      gosub get.token
      if token # TKN.RBR then goto err.rbr
      opcode.byte = opcode ; gosub emit.simple
   while look.ahead.token = TKN.COMMA
      gosub get.token
   repeat

   return

*****************************************************************************
* ST.LOCAL  -  LOCAL SUBROUTINE / FUNCTION statement
*
*    OP.LOCAL
*    Reference variable number  (2 bytes)
*    Number of local variables  (2 bytes)
*    Number of args (1 byte)
*    Number of matrices (2 bytes)
*       Variable number (2 bytes)   } Repeated for
*       Rows (2 bytes)              } each matrix to
*       Cols (2 bytes)              } be dimensioned

st.local:
   begin case
      case lsub.var.no >= 0
         err.msg = sysmsg(3446) ;* Previous local function/subroutine requires END
         gosub warning
         lsub.var.no  =-1
      case object.state > 2
         err.msg = sysmsg(3445) ;* Previous public function/subroutine requires END
         gosub warning
         object.state = 2
   end case

   begin case
      case u.look.ahead.token.string = 'FUNCTION'
         is.local.function = @true
      case u.look.ahead.token.string = 'SUBROUTINE'
         is.local.function = @false
      case u.look.ahead.token.string = 'SUB'
         is.local.function = @false
      case 1
         err.msg = sysmsg(3421) ;* Expected FUNCTION or SUBROUTINE after LOCAL
         goto error
   end case
   gosub get.token

   * Emit a STOP so that it is impossible to fall into the subroutine

   opcode.byte = OP.STOP ; gosub emit.simple

   * Get name of subroutine/function

   gosub get.label.name
   lsub.name = label.name:':'
   gosub set.label

   * Reserve a variable to link to the local pool. This looks just like
   * a common block.

   lvar.no = var.count ; var.count += 1
   symbol.table<-1> = lsub.name
   lsub.var.no = lvar.no

   common.index = dcount(commons<1>, @vm) + 1
   commons<1,common.index> = lsub.name
   commons<2,common.index> = lvar.no
   commons<3,common.index> = '1'

   symbol.common.offset = 0

   function.args = ''
   deref.arg.list = ''     ;* List of variable numbers

   if is.local.function then
      * Insert implicit return argument

      function.args := 'S'
      symbol.name = lsub.name:':_FUNCRET'
      symbol.dim = 0
      symbol.common.offset += 1
      symbol.mode = SYM.SET
      var.data = lvar.no : @vm : symbol.common.offset : @vm : symbol.dim
      ins symbol.name before symbols<sympos>
      ins var.data before symbol.info<sympos>
      ins '' before symbol.refs<sympos>
   end

   if look.ahead.token = TKN.LBR then  ;* Arguments present
      gosub get.token

      if look.ahead.token # TKN.RBR then   ;* Arguments present
         loop
            deref.argument = @false

            if u.look.ahead.token.string = "MAT" then
               function.args := 'M'
               symbol.dim = -1   ;* Indicates not yet known
               gosub get.token
               if look.ahead.token # TKN.NAME then goto err.var
            end else
               function.args := 'S'
               symbol.dim = 0

               if look.ahead.token = TKN.LBR then
                  deref.argument = @true
                  gosub get.token
               end
            end

            gosub get.var.name              ;* Get argument variable name
         until err
            symbol.name = lsub.name:token.string

            * Make new symbol table entry, checking for duplicate definitions

            locate symbol.name in symbols<1> by 'AL' setting sympos then
               err.msg = sysmsg(2890, symbol.name) ;* Duplicate symbol 'xx'
               goto error
            end

            symbol.common.offset += 1
            var.data = lvar.no : @vm : symbol.common.offset : @vm : symbol.dim
            ins symbol.name before symbols<sympos>
            ins var.data before symbol.info<sympos>
            ins '' before symbol.refs<sympos>

            if deref.argument then
               * Need to dereference this argument
               * We cannot do this at this stage because it must happen
               * after we dimension the pseudo-common block that holds
               * the local variables. Just remember the argument name.

               deref.arg.list<-1> = symbol.name

               if look.ahead.token # TKN.RBR then goto err.rbr
               gosub get.token
            end

         while look.ahead.token = TKN.COMMA
            gosub get.token
            if look.ahead.token = TKN.END then gosub get.token
         repeat

         if len(function.args) > 255 then
            err.msg = sysmsg(2898) ;* Too many arguments...
            goto error
         end

         if look.ahead.token # TKN.RBR then goto err.rbr
      end

      gosub get.token     ;* Skip close bracket
   end

   locate label.name in int.subs<1> setting pos then
      if int.sub.args<pos> # function.args then
         err.msg = sysmsg(3426) ;* Inconsistent argument lists in internal subroutine reference
         goto error
      end
      int.sub.is.lsub<pos> = @true
   end else
      ins label.name before int.subs<1>         ;* Insert at front so that...
      ins function.args before int.sub.args<1>  ;* ...null entries work
      ins @true before int.sub.is.lsub<1>
   end

   opcode.byte = OP.LOCAL ; gosub emit.simple

   * Emit reference variable number
   code.value = lvar.no ; code.bytes = 2 ; gosub emit.multibyte.value

   opcode.string = ''  ;* Use this to build the matrix information

   * Process local variable declarations

   loop
      loop
      while look.ahead.token = TKN.END
         gosub get.token  ;* Wrap to next line
      repeat
   while u.look.ahead.token.string = 'PRIVATE'
      gosub get.token  ;* Skip PRIVATE

      rows = 0
      cols = 0

      loop
         symbol.common.offset += 1
         begin case
         case look.ahead.token = TKN.NAME       ;* Scalar variable
            gosub get.token
            symbol.name = lsub.name:token.string
            symbol.dim = 0

         case look.ahead.token = TKN.NAME.LBR   ;* Matrix
            gosub get.token
            symbol.name = lsub.name:token.string

            gosub get.token             ;* Skip over left bracket

            gosub get.numeric.constant
            if gnc.err then return
            rows = n

            if rows < 1 then
               err.msg = sysmsg(3423) ;* Illegal row dimension in LOCAL matrix
               goto error
            end

            if look.ahead.token = TKN.COMMA then     ;* Two dimensions
               gosub get.token          ;* Skip over comma

               gosub get.numeric.constant
               if gnc.err then return
               cols = n + 0

               if cols < 1 then
                  err.msg = sysmsg(3424) ;* Illegal column dimension in LOCAL matrix
                  goto error
               end

               symbol.dim = 2
            end else                                 ;* Single dimension
               cols = 0
               symbol.dim = 1
            end

            opcode.string<-1> = symbol.common.offset:@vm:rows:@vm:cols

            if look.ahead.token # TKN.RBR then goto err.rbr

            gosub get.token   ;* Skip over right bracket

         case 1
            err.msg = sysmsg(3425) ;* Local variable name not found where expected
            goto error
         end case

         * Make new symbol table entry, checking for duplicate definitions

         locate symbol.name in symbols<1> by 'AL' setting sympos then
            err.msg = sysmsg(2890, symbol.name) ;* Duplicate symbol 'xx'
            goto error
         end

         var.data = lvar.no : @vm : symbol.common.offset : @vm : symbol.dim
         ins symbol.name before symbols<sympos>
         ins var.data before symbol.info<sympos>
         ins '' before symbol.refs<sympos>

         commons<4,common.index,symbol.common.offset> = symbol.name
         commons<5,common.index,symbol.common.offset> = rows
         commons<6,common.index,symbol.common.offset> = cols
      while look.ahead.token = TKN.COMMA
         gosub get.token  ;* Skip comma
      repeat
   repeat

   * Emit local variable count
   code.value = symbol.common.offset ; code.bytes = 2 ; gosub emit.multibyte.value

   * Emit argument count
   code.value = len(function.args) ; code.bytes = 1 ; gosub emit.multibyte.value

   * Emit matrix count
   n = dcount(opcode.string, @fm)
   code.value = n ; code.bytes = 2 ; gosub emit.multibyte.value

   for i = 1 to n
      * Emit matrix variable number
      code.value = opcode.string<i,1> ; code.bytes = 2 ; gosub emit.multibyte.value
      * Emit matrix rows
      code.value = opcode.string<i,2> ; code.bytes = 2 ; gosub emit.multibyte.value
      * Emit matrix columns
      code.value = opcode.string<i,3> ; code.bytes = 2 ; gosub emit.multibyte.value
   next i

   * Finally, insert code to dereference any arguments that need it

   if deref.arg.list # '' then
      loop
         symbol.name = remove(deref.arg.list, more)
         symbol.mode = SYM.CHK
         gosub find.var
         gosub emit.var.load
         opcode.byte = OP.DEREF ; gosub emit.simple
      while more
      repeat
   end

   return

*****************************************************************************
* ST.LOCATE  -  LOCATE statement

st.locate:
   if look.ahead.token = TKN.LBR then    ;* Pick style
      gosub get.token     ;* Skip bracket

      * Emit search expression

      gosub exprf
      gosub check.comma

      * Emit dynamic array reference

      gosub expr                         ;* 0287
!0287    gosub simple.var.reference
!0287    if err then return

      locate.level = 0
      if look.ahead.token = TKN.COMMA then  ;* Field position present
         gosub get.token
         gosub expr
         locate.level = 1
      end

      if look.ahead.token = TKN.COMMA then  ;* Value position present
         gosub get.token
         gosub expr
         locate.level = 2
      end

      * Emit start position - always 1 in this style

      n = 1 ; gosub emit.numeric.load

      loop
      while locate.level < 2
         n = 0 ; gosub emit.numeric.load
         locate.level += 1
      repeat

      * Emit reference to variable to receive position

      if look.ahead.token # TKN.SEMICOLON then goto err.semicolon
      gosub get.token          ;* Skip semicolon
      gosub simple.lvar.reference
      if err then return

      if look.ahead.token = TKN.SEMICOLON then  ;* Ordering expression present
         gosub get.token          ;* Skip semicolon
         gosub exprf              ;* Emit ordering expression
      end else
         opcode.string = '' ; gosub emit.string.load
      end

      * Swap top two items on the stack

      opcode.byte = OP.SWAP ; gosub emit.simple

      if look.ahead.token # TKN.RBR then goto err.rbr
      gosub get.token          ;* Skip bracket

   end else    ;* Not Pick style
      * Emit search expression

      gosub exprf

      if u.look.ahead.token.string # "IN" then goto err.in

      gosub get.token          ;* Skip IN

      gosub simple.var.reference ; if err then return

      if bittest(mode, M.UV.LOCATE) then
         locate.level = 0
         if look.ahead.token = TKN.LT then
            gosub get.token                ;* Skip < token

            format.qualifier.allowed = @false
            gosub is.field.ref
            if ifr.index  = 0 then goto err.field

            * Field position
            gosub expr
            locate.level = 1

            * Value position
            if look.ahead.token = TKN.COMMA then
               gosub get.token             ;* Skip comma
               gosub expr
               locate.level = 2
            end

            if look.ahead.token # TKN.END.FIELD then goto err.field
            gosub get.token  ;* Skip >
         end

         * Start position

         if look.ahead.token = TKN.COMMA then
            gosub get.token
            gosub expr
         end else
            n = 1 ; gosub emit.numeric.load
         end

         loop
         while locate.level < 2
            n = 0 ; gosub emit.numeric.load
            locate.level += 1
         repeat
      end else
         if look.ahead.token # TKN.LT then
            err.msg = sysmsg(2899) ;* Field reference not found where expected
            goto error
         end
         gosub get.token                ;* Skip < token

         format.qualifier.allowed = @false
         gosub is.field.ref ; if ifr.index  = 0 then goto err.field

         gosub emit.field.reference ; if err then return
      end

      if u.look.ahead.token.string = "BY" then
         gosub get.token          ;* Skip BY
         gosub exprf               ;* Emit ordering expression
      end else
         opcode.string = '' ; gosub emit.string.load
      end

      if u.look.ahead.token.string # "SETTING" then
         err.msg = sysmsg(2914) ;* SETTING not found where expected
         goto error
      end

      gosub get.token          ;* Skip SETTING
      gosub simple.lvar.reference ; if err then return
   end

   if bittest(mode, M.STRING.LOCATE) then opcode.byte = OP.LOCATES
   else opcode.byte = OP.LOCATE
   gosub emit.simple

   goto st.if.back.end           ;* Join IF statement for THEN / ELSE

*****************************************************************************
* ST.LOCK  -  LOCK statement

st.lock:
   * Add new entry to jump stack
   ins j.back.end:@vm:jump.no before jump.stack<1>
   jump.no += 1

   * Set label for repeat of LOCK if no ELSE clause
   label.name = "_":jump.stack<1,2>:"R"
   gosub set.label
   gosub exprf

   opcode.byte = OP.LOCK ; gosub emit.simple

   * Look for THEN and ELSE clauses, both of which are optional

   if look.ahead.token = TKN.END then gosub get.token

   if u.look.ahead.token.string = "THEN" then
      gosub get.token           ;* Skip "THEN" token

      * Generate jump to ELSE clause (or end if no ELSE)
      label.name = "_":jump.stack<1,2>:"E"
      opcode.byte = OP.JNZ ; gosub emit.jump

      if look.ahead.token = TKN.END then     ;* THEN / END construct
         gosub get.token
         loop
            if end.source then
               err.msg = sysmsg(2922) ;* Unterminated THEN clause
               gosub error
               goto exit.st.lock
            end
         until u.look.ahead.token.string = "END"
            gosub proc.line
         repeat
         gosub get.token
      end else                            ;* Conditional statement on same line
         gosub get.token
         gosub proc.statement.group
      end

     * Check that the top of the jump stack is a back end jump
      if jump.stack<1,1> # j.back.end then
         err.msg = sysmsg(2925) ;* Incorrectly formed THEN clause
         gosub error
         goto exit.st.lock
      end

      * Generate jump to exit point
      label.name = "_":jump.stack<1,2>:"X"
      opcode.byte = OP.JMP ; gosub emit.jump
   end else                          ;* No THEN clause
      * Generate jump to exit point if would have taken THEN clause
      label.name = "_":jump.stack<1,2>:"X"
      opcode.byte = OP.JZE ; gosub emit.jump
   end

   * Look for ELSE clause. If not present, provide default ELSE clause.

   * Set label for head of ELSE clause
   label.name = "_":jump.stack<1,2>:"E"
   gosub set.label

   if look.ahead.token = TKN.END then gosub get.token

   if u.look.ahead.token.string = "ELSE" then
      gosub get.token              ;* Skip the ELSE token

      if look.ahead.token = TKN.END then     ;* ELSE / END construct
         gosub get.token
         loop
            if end.source then
               err.msg = sysmsg(2923) ;* Unterminated ELSE clause
               gosub error
               goto exit.st.lock
            end
         until u.look.ahead.token.string = "END"
            gosub proc.line
         repeat
      gosub get.token
      end else                           ;* Conditional statement on same line
         gosub get.token
         gosub proc.statement.group
      end

      * Check that the top of the jump stack is a back end jump
      if jump.stack<1,1> # j.back.end then
         err.msg = sysmsg(2926) ;* Incorrectly formed ELSE clause
         gosub error
         goto exit.st.lock
      end
   end else
      * Generate a default ELSE clause
      * LD1
      * SLEEP
      * JMP _nR

      n = 1 ; gosub emit.numeric.load
      opcode.byte = OP.SLEEP ; gosub emit.simple
      label.name = "_":jump.stack<1,2>:"R"
      opcode.byte = OP.JMP ; gosub emit.jump
   end

   * Set the exit label

   label.name = "_":jump.stack<1,2>:"X"
   gosub set.label

exit.st.lock:
   del jump.stack<1>

   return

*****************************************************************************
* ST.LOOP  -  LOOP statement

st.loop:

   * Add new entry to jump stack
   ins j.loop:@vm:jump.no before jump.stack<1>

   * Generate label
   label.name = "_":jump.no:"R"
   gosub set.label
              
   * Increment JUMP.NO
   jump.no += 1
   return

*****************************************************************************
* ST.MARK.MAPPING  -  MARK.MAPPING statement

st.mark.mapping:
   * Emit file var

   gosub convert.pick.file.reference
   gosub exprf
   gosub check.comma

   if look.ahead.token = TKN.END then
      err.msg = "Expected ON, OFF or expression"
      goto error
   end

   begin case
      case (u.look.ahead.token.string = "ON") ;* 0504
         gosub get.token
         n = 1 ; gosub emit.numeric.load

      case (u.look.ahead.token.string = "OFF") ;* 0504
         gosub get.token
         n = 0 ; gosub emit.numeric.load

      case 1
         gosub expr
         opcode.byte = OP.INT ; gosub emit.simple
   end case

   opcode.byte = OP.MAPMARKS ; gosub emit.simple

   return

***************************************************************************
* ST.MAT  -  MAT statement

st.mat:
   * Get name of target variable

   gosub get.token

   * Check it is a matrix

   symbol.name = token.string
   symbol.mode = SYM.SET
   gosub find.var
   if (symbol.var.no < 0) or (symbol.dim <= 0) then   ;* Not a matrix
      err.msg = "Target for MAT must be DIMensioned as a matrix"
      goto error
   end

   gosub emit.var.load           ;* Emit LDLCL or LDCOM for target matrix

   if look.ahead.token # TKN.EQ then
      err.msg = sysmsg(2930) ;* Expected = after MAT target variable
      goto error ; return
   end

   gosub get.token               ;* Skip equals sign

   if u.look.ahead.token.string = "MAT" then   ;* Matrix to matrix copy
      gosub get.token            ;* Skip MAT
      
      * Get name of source variable

      gosub get.token

      * Check it is a matrix

      symbol.name = token.string
      gosub find.var
      if (symbol.var.no < 0) or (symbol.dim = 0) then   ;* Not a matrix
         err.msg = sysmsg(2931) ;* Dimensioned matrix required
         goto error
      end

      gosub emit.var.load        ;* Emit LDLCL or LDCOM for target matrix
      opcode.byte = OP.MATCOPY ; gosub emit.simple
   end else                                  ;* Scalar to matrix copy
      gosub exprf
      opcode.byte = OP.MATFILL ; gosub emit.simple
   end

   return

***************************************************************************
* ST.MATBUILD  -  MATBUILD statement

st.matbuild:
   * Get name of target variable

   gosub get.token
   gosub emit.lvar.reference

   if u.look.ahead.token.string # "FROM" then goto err.from
   gosub get.token               ;* Skip FROM

   gosub get.token               ;* Get source matrix name

   * Check it is a matrix

   symbol.name = token.string
   gosub find.var
   if (symbol.var.no < 0) or (symbol.dim = 0) then   ;* Not a matrix
      err.msg = sysmsg(2931) ;* Dimensioned matrix required
      goto error
   end

   gosub emit.var.load           ;* Emit LDLCL or LDCOM for source matrix

   if look.ahead.token = TKN.COMMA then  ;* Bounds present
      gosub get.token            ;* Skip comma
      gosub exprf                 ;* Starting index

      if look.ahead.token = TKN.COMMA then  ;* Ending index present
         gosub get.token         ;* Skip comma
         gosub exprf              ;* Ending index
      end else
         n = 0 ; gosub emit.numeric.load ;* Ending index
      end
   end else                      ;* Set bounds as "unset" (0)
      n = 0 ; gosub emit.numeric.load    ;* Starting index
      gosub emit.numeric.load    ;* Ending index
   end

   if u.look.ahead.token.string = "USING" then
      gosub get.token            ;* Skip USING
      gosub exprf                 ;* Process delimiter expression
   end else
      opcode.string = @fm ; gosub emit.string.load
   end

   opcode.byte = OP.MATBUILD ; gosub emit.simple
   opcode.byte = OP.STOR ; gosub emit.simple

   return

***************************************************************************
* ST.MATPARSE  -  MATPARSE statement

st.matparse:
   * Get name of target variable

   gosub get.token

   * Check it is a matrix

   symbol.name = token.string
   symbol.mode = SYM.SET
   gosub find.var
   if (symbol.var.no < 0) or (symbol.dim = 0) then   ;* Not a matrix
      err.msg = sysmsg(2931) ;* Dimensioned matrix required
      goto error
   end

   gosub emit.var.load           ;* Emit LDLCL or LDCOM for target matrix

   if u.look.ahead.token.string # "FROM" then goto err.from
   gosub get.token               ;* Skip FROM

   gosub expr                    ;* Process source expression

   if look.ahead.token # TKN.COMMA and u.look.ahead.token.string # 'USING' then
      err.msg = sysmsg(2934) ;* Expected comma or USING
      goto error
   end

   gosub get.token               ;* Skip comma / USING
   gosub exprf                   ;* Process delimiter expression
   opcode.byte = OP.MATPARSE ; gosub emit.simple

   return

***************************************************************************
* ST.MATREAD  -  MATREAD statement
* ST.MATREADL  -  MATREADL statement
* ST.MATREADU  -  MATREADU statement

st.matreadl:
   lock.opcode = OP.LLOCK
   goto st.matread

st.matreadu:
   lock.opcode = OP.ULOCK

st.matread:
   gosub get.token   ;* Get name of target variable

   * Check it is a matrix

   symbol.name = token.string
   symbol.mode = SYM.SET
   gosub find.var
   if (symbol.var.no < 0) or (symbol.dim = 0) then   ;* Not a matrix
      err.msg = sysmsg(2931) ;* Dimensioned matrix required
      goto error
   end

   gosub emit.var.load           ;* Emit LDLCL or LDCOM for target matrix

   if u.look.ahead.token.string # "FROM" then goto err.from

   gosub get.token      ;* Skip FROM token

   * Emit file variable

   gosub simple.var.reference ; if err then return
   gosub check.comma

   * Emit record key expression
   gosub exprf

   if bittest(mode, M.PICK.READ) then
      opcode.byte = OP.PICKREAD ; gosub emit.simple
   end

   opcode = OP.MATREAD
   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins (lock.opcode # 0) before testlock.stack<1>  ;* LOCKED clause allowed?
   ins '1' before thenelse.stack<1>     ;* THEN / ELSE required
   goto back.end

***************************************************************************
* MATREADCSV

st.matreadcsv:
   * Get name of target variable

   gosub get.token

   * Check it is a matrix

   symbol.name = token.string
   symbol.mode = SYM.SET
   gosub find.var
   if (symbol.var.no < 0) or (symbol.dim = 0) then   ;* Not a matrix
      err.msg = sysmsg(2931) ;* Dimensioned matrix required
      goto error
   end

   gosub emit.var.load           ;* Emit LDLCL or LDCOM for target matrix

   n = 1 ; gosub emit.temp.ref        ;* To receive raw input data

   if u.look.ahead.token.string # "FROM" then goto err.from
   gosub get.token      ;* Skip FROM token
   gosub simple.var.reference ; if err then return

   opcode.byte = OP.READSEQ ; gosub emit.simple
   opcode.byte = OP.NOT ; gosub emit.simple      ;* TRUE/FALSE -> THEN/ELSE
   opcode.byte = OP.DUP ; gosub emit.simple
   label.name = '_':jump.no ; jump.no += 1
   opcode.byte = OP.JZE ; gosub emit.jump        ;* Skip parsing if error
   opcode.byte = OP.POP ; gosub emit.simple

   n = 1 ; gosub emit.temp.ref
   opcode.string = ',' ; gosub emit.string.load  ;* Delimiter
   opcode.byte = OP.CSVDQ ; gosub emit.simple

   opcode.string = @fm ; gosub emit.string.load
   opcode.byte = OP.MATPARSE ; gosub emit.simple
   opcode.byte = OP.LD1 ; gosub emit.simple

   gosub set.label

   goto st.if.back.end

***************************************************************************
* ST.MATWRITE  -  MATWRITE statement
* ST.MATWRITEU  -  MATWRITEU statement

st.matwriteu:
   lock.opcode = OP.ULOCK

st.matwrite:
   gosub get.token   ;* Get name of source variable

   * Check it is a matrix

   symbol.name = token.string
   gosub find.var
   if (symbol.var.no < 0) or (symbol.dim = 0) then   ;* Not a matrix
      err.msg = sysmsg(2931) ;* Dimensioned matrix required
      goto error
   end

   gosub emit.var.load           ;* Emit LDLCL or LDCOM for matrix

   * Emit sequence to do MATBUILD of source matrix onto e-stack

   n = 0                     ; gosub emit.numeric.load
   n = 0                     ; gosub emit.numeric.load
   opcode.string = @fm       ; gosub emit.string.load
   opcode.byte = OP.MATBUILD ; gosub emit.simple

   if u.look.ahead.token.string # "TO" and u.look.ahead.token.string # "ON" then goto err.to
   gosub get.token      ;* Skip TO / ON token

   * Emit file variable

   gosub simple.var.reference ; if err then return
   gosub check.comma

   * Emit record key expression

   gosub exprf

   opcode = OP.WRITE
   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>     ;* No LOCKED clause allowed
   ins '0' before thenelse.stack<1>     ;* No THEN / ELSE required
   goto back.end

*****************************************************************************
* ST.MISPLACED  -  Misplaced statement

st.misplaced:
  err.msg = sysmsg(2891, token.string) ;* Misplaced xx
  goto error

*****************************************************************************
* ST.MODIFY  -  MODIFY statement (restricted)
* MODIFY btree, data

st.modify:
   gosub simple.lvar.reference  ;* BTree variable
   gosub check.comma
   gosub exprf
   opcode.byte = OP.BTMODIFY ; gosub emit.simple
   return

*****************************************************************************
* ST.NEXT  -  NEXT statement

st.next:
   * Check control variable name

   if look.ahead.token then
     gosub get.token
     symbol.name = for.var<1,1>
     if token.string # symbol.name then
        err.msg = sysmsg(2932) ;* Mismatched FOR / NEXT control variables
        gosub error
        * Do not return as we must tidy up for.var stack
     end
   end

   * Look up variable simply to set use flag
   symbol.mode = SYM.USE ; gosub find.var

   del for.var<1>

   * The item at the top of the jump stack must be a FOR construct

   if jump.stack<1,1> # J.FOR then
      err.msg = sysmsg(2933) ;* NEXT not matched by FOR
      goto error
   end                

   * Set up label name for jump to head of loop
   label.name = "_":jump.stack<1,2>:"R"
   opcode.byte = OP.JMP ; gosub emit.jump

   * Generate loop exit label
   label.name = "_":jump.stack<1,2>:"X"
   gosub set.label
   del jump.stack<1>

   * Skip forwards to end of line or semicolon so that we ignore any subscript
   * on the control variable.

   loop
      until look.ahead.token = TKN.END
      until look.ahead.token = TKN.SEMICOLON
      gosub get.token
   repeat

   return

*****************************************************************************
* ST.NOBUF   -  NOBUF statement

st.nobuf:
   gosub simple.var.reference   ;* Emit file variable

   * Perform common back-end processing

   opcode = OP.NOBUF
   ins '0' before onerror.stack<1>        ;* No ON ERROR clause
   ins '0' before testlock.stack<1>       ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>       ;* THEN / ELSE clause required
   goto back.end

***************************************************************************
* ST.NULL  -  NULL statement

st.null:
   return

***************************************************************************
* ST.ON  -  ON GOSUB and ON GOTO statements

st.on:
   * Emit value expression

   reserved.names<2> = "GOSUBGOTOGO"  ;* 0265
   gosub exprf
   del reserved.names<2>

   begin case
      case u.look.ahead.token.string = "GOSUB"
         gosub get.token
         opcode.byte = if bittest(mode, M.PICK.JUMP.RANGE) then OP.ONGOSUBP else OP.ONGOSUB
         is.on.gosub = @true

      case u.look.ahead.token.string = "GOTO"
         gosub get.token
         opcode.byte = if bittest(mode, M.PICK.JUMP.RANGE) then OP.ONGOTOP else OP.ONGOTO
         is.on.gosub = @false

      case u.look.ahead.token.string = "GO"
         gosub get.token
         if u.look.ahead.token.string = "TO" then gosub get.token  ;* 0503
         opcode.byte = if bittest(mode, M.PICK.JUMP.RANGE) then OP.ONGOTOP else OP.ONGOTO
         is.on.gosub = @false

      case 1
         err.msg = sysmsg(2935) ;* Expected GOSUB, GOTO or GO
         goto error
   end case

   gosub emit.simple


   * Emit jump list

   jump.list = ''
   loop
      gosub get.label.name
      if err then return

      if lsub.var.no >= 0 then label.name = lsub.name:label.name

      if is.on.gosub then
         locate label.name in int.subs<1> setting pos then
            if int.sub.args<pos> # '' then
               err.msg = sysmsg(3426) ;* Inconsistent argument lists in internal subroutine reference
               goto error
            end
         end else
            ins label.name before int.subs<1>    ;* Insert at front so that...
            ins '' before int.sub.args<1>        ;* ...null entries work
            ins @false before int.sub.is.lsub<1>
         end
      end

      jump.list<-1> = label.name
   until look.ahead.token # TKN.COMMA
      gosub get.token      ;* Skip comma token
      if look.ahead.token = TKN.END then
         gosub get.token
      end
   repeat

   * Now that we have the list of labels, we can work out whether we need
   * an extended label count.

   jump.count = dcount(jump.list, @fm)
   if jump.count <= 255 then
      opcode.byte = jump.count ; gosub emit
   end else
      opcode.byte = 0 ; gosub emit
      code.value = jump.count ; code.bytes = 2 ; gosub emit.multibyte.value
   end

   * Emit the jump addresses

   loop
      label.name = remove(jump.list, more)
      gosub emit.jump.addr
   while more
   repeat

   return

*****************************************************************************
* ST.OPEN  -  OPEN and OPENPATH statements

st.openpath:
   reserved.names<2> = "READONLY"
   opcode = OP.OPENPATH
   gosub exprf               ;* Emit file name expression
   goto open.common

st.open:
   reserved.names<2> = "READONLY"
   opcode = OP.OPEN

   * Emit first expresssion (file or dict flag)
   gosub exprf

   if look.ahead.token = TKN.COMMA then
      gosub get.token      ;* Skip comma

      * Emit filename expresssion
      gosub exprf
   end else
      * There was only one expression. Therefore it was the filename. We
      * must emit a null string load and exchange the top two items on
      * the evaluation stack.

      opcode.string = '' ; gosub emit.string.load
      opcode.byte = OP.EXCH ; gosub emit.simple
   end

open.common:
   del reserved.names<2>

   if u.look.ahead.token.string = 'READONLY' then
      gosub get.token
      opcode.byte = OP.READONLY  ; gosub emit.simple
   end

   if u.look.ahead.token.string # "TO" then goto err.to
   gosub get.token      ;* Skip "TO"
   if (look.ahead.token # TKN.NAME) and (look.ahead.token # TKN.NAME.LBR) then
      goto err.fvar
   end

   gosub get.token
   gosub emit.lvar.reference

   * Perform common back-end processing

   ins '1' before onerror.stack<1>       ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>      ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>      ;* Requires THEN or ELSE
   goto back.end

*****************************************************************************
* ST.OPENSEQ   -  OPENSEQ statement

st.openseq:
   opcode = OP.OPENSEQ

   reserved.names<2> = "APPENDOVERWRITEREADONLY"

   * Emit file expresssion
   gosub exprf
    
   if look.ahead.token = TKN.COMMA then
      gosub get.token      ;* Skip comma
      gosub exprf           ;* Emit record expresssion
   end else
      opcode = OP.OPENSEQP
   end

   del reserved.names<2>

   begin case
      case u.look.ahead.token.string = 'APPEND'
         gosub get.token
         opcode.byte = OP.SETFLAGS  ; gosub emit.simple
         code.value = 0x100 ; code.bytes = 2 ; gosub emit.multibyte.value

      case u.look.ahead.token.string = 'OVERWRITE'
         gosub get.token
         opcode.byte = OP.SETFLAGS  ; gosub emit.simple
         code.value = 0x200 ; code.bytes = 2 ; gosub emit.multibyte.value

      case u.look.ahead.token.string = 'READONLY'
         gosub get.token
         opcode.byte = OP.READONLY  ; gosub emit.simple
   end case
         
   if u.look.ahead.token.string # "TO" then goto err.to

   gosub get.token      ;* Skip "TO"

   * Emit file variable 
   if (look.ahead.token # TKN.NAME) and (look.ahead.token # TKN.NAME.LBR) then
      goto err.fvar
   end

   gosub get.token
   gosub emit.lvar.reference

   * Emit a NULL opcode which may be replaced by a TESTLOCK later
   ins pc before testlock.stack<1>
   opcode.byte = OP.NULL ; gosub emit.simple

   * Perform common back-end processing
   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins '1' before thenelse.stack<1>     ;* THEN / ELSE required
   goto back.end

*****************************************************************************
* ST.OS.EXECUTE      -  OS.EXECUTE statement

st.os.execute:
   * Add local reserved name
   reserved.names<2> = "CAPTURING"
   gosub exprf
   del reserved.names<2>

   * Look for CAPTURING option

   if u.look.ahead.token.string = "CAPTURING" then
      gosub get.token
      gosub simple.lvar.reference   ;* Emit LDLCL etc for target
      opcode.byte = OP.SHCAP ; gosub emit.simple
   end else
      opcode.byte = OP.SH ; gosub emit.simple
   end

   return

*****************************************************************************
* ST.PAGE  -  PAGE statement

st.page:
   if u.look.ahead.token.string = "ON" then
      gosub get.token            ;* Skip "ON"
      gosub expr
   end else
      n = 0 ; gosub emit.numeric.load
   end

   find u.look.ahead.token.string in reserved.names setting i else i = 0 ;* 0265
   if i = 0 and look.ahead.token and look.ahead.token # TKN.SEMICOLON then
      gosub exprf     ;* Process new page number
   end else
      n = -1 ; gosub emit.numeric.load
   end

   opcode.byte = OP.PAGE ; gosub emit.simple

   return

*****************************************************************************
* ST.PAUSE

st.pause:
   find u.look.ahead.token.string in reserved.names setting i else i = 0
   if i or look.ahead.token = TKN.END or look.ahead.token = TKN.SEMICOLON then
      n = 0 ; gosub emit.numeric.load
   end else
     gosub expr
   end

   opcode.byte = OP.PAUSE ; gosub emit.simple
   return

*****************************************************************************
* ST.PRINT  -  PRINT statement

st.print:
   if look.ahead.token = TKN.NAME and u.look.ahead.token.string = "ON" then ;* 0519
      gosub get.token            ;* Skip "ON"
      gosub expr
   end else
      n = 0 ; gosub emit.numeric.load
   end

   print.opcode = OP.PRNT ; gosub emit.print.list

   return

*****************************************************************************
* ST.PRINTCSV  -  PRINTCSV statement

st.printcsv:
   if u.look.ahead.token.string = "ON" then
      gosub get.token            ;* Skip "ON"
      gosub expr
   end else
      n = 0 ; gosub emit.numeric.load
   end

   gosub emit.csv.list ; if err then return
   if look.ahead.token = TKN.COLON then
      gosub get.token
      opcode.byte = OP.PRNT
   end else
      opcode.byte = OP.PRNL
   end
   gosub emit.simple

   return

*****************************************************************************
* ST.PRINTER  -  PRINTER {ON | OFF | CLOSE | RESET | SETTING | FILE | NAME | DISPLAY}

st.printer:
   gosub get.token

   begin case
*** PRINTER OFF ***
      case u.token.string = "OFF"
         opcode.byte = OP.PROFF ; gosub emit.simple

*** PRINTER ON ***
      case u.token.string = "ON"
         opcode.byte = OP.PRON ; gosub emit.simple

*** PRINTER SETTING ***
      case u.token.string = "SETTING"
         if u.look.ahead.token.string = "ON" then
            gosub get.token            ;* Skip "ON"
            gosub expr
         end else
            n = 0 ; gosub emit.numeric.load
         end

         gosub exprf                                 ;* Get parameter number
         gosub check.comma
         gosub exprf                                 ;* Get new value
         opcode.byte = OP.PSET ; gosub emit.simple
         opcode.byte = OP.POP  ; gosub emit.simple   ;* Discard result
         

*** PRINTER FILE ***
      case u.token.string = "FILE"
         if u.look.ahead.token.string = "ON" then
            gosub get.token            ;* Skip "ON"
            gosub expr
         end else
            n = 0 ; gosub emit.numeric.load
         end

         gosub exprf                    ;* Get file name
         gosub check.comma
         gosub exprf                    ;* Get record name

         * Handle ON ERROR / THEN / ELSE

         opcode = OP.PRFILE
         ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
         ins '0' before testlock.stack<1>     ;* No LOCKED clause allowed
         ins '2' before thenelse.stack<1>     ;* Optional THEN / ELSE clause
         goto back.end

*** PRINTER NAME ***
      case u.token.string = "NAME"
         if u.look.ahead.token.string = "ON" then
            gosub get.token            ;* Skip "ON"
            gosub expr
         end else
            n = 0 ; gosub emit.numeric.load
         end

         gosub exprf                    ;* Get printer name

         * Handle ON ERROR / THEN / ELSE

         opcode = OP.PRNAME
         ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
         ins '0' before testlock.stack<1>     ;* No LOCKED clause allowed
         ins '2' before thenelse.stack<1>     ;* Optional THEN / ELSE clause
         goto back.end

*** PRINTER DISPLAY ***
      case u.token.string = "DISPLAY"
         if u.look.ahead.token.string = "ON" then
            gosub get.token            ;* Skip "ON"
            gosub expr
         end else
            n = 0 ; gosub emit.numeric.load
         end

         * Handle ON ERROR / THEN / ELSE

         opcode = OP.PRDISP
         ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
         ins '0' before testlock.stack<1>     ;* No LOCKED clause allowed
         ins '2' before thenelse.stack<1>     ;* Optional THEN / ELSE clause
         goto back.end

*** PRINTER CLOSE ***
      case u.token.string = "CLOSE"
         if u.look.ahead.token.string = "ON" then
            gosub get.token            ;* Skip "ON"
            gosub expr
         end else
            n = if bittest(mode, M.PRCLOSE.DEFAULT.0) then 0 else -2
            gosub emit.numeric.load
         end

         opcode.byte = OP.PRCLOSE ; gosub emit.simple

*** PRINTER RESET ***
      case u.token.string = "RESET"
         opcode.byte = OP.PRRESET ; gosub emit.simple

      case 1
         err.msg = sysmsg(2937) ;* Expected OFF, ON, SETTING, FILE, CLOSE or RESET
         goto error
   end case

   return

*****************************************************************************
* ST.PRIVATE
* ST.PUBLIC

st.get:
   is.public = @true
   is.public.function = @true
   goto st.get.set.entry

st.set:
   is.public = @true
   is.public.function = @false
   goto st.get.set.entry

st.private:
   is.public = @false
   goto st.private.common

st.public:
   is.public = @true

   if listindex('FUNCTION,SUB,SUBROUTINE', ',', u.look.ahead.token.string) then
      gosub get.token
      is.public.function = (u.token.string = 'FUNCTION')

st.get.set.entry:
      begin case
         case lsub.var.no >= 0
            err.msg = sysmsg(3446) ;* Previous local function/subroutine requires END
            gosub warning
            lsub.var.no  =-1

         case object.state > 2
            err.msg = sysmsg(3445) ;* Previous public function/subroutine requires END
            gosub warning
            object.state = 2

         case object.state = 0
            goto err.class

         case object.state = 1    ;* Not yet found first Get/Set/Public
            if pc # start.pc then
               err.msg = sysmsg(3448) ;* GET, SET and PUBLIC routines must appear before any other executable code
               goto error
            end
      end case

      * Get function/subroutine name

      gosub get.token
      if token # TKN.NAME and token # TKN.NAME.LBR then
         goto err.name
      end

      is.create.object.subroutine = is.public and u.token.string = 'CREATE.OBJECT'

      locate u.token.string in object.name.map<1,1> setting obj.pos then
         i = if is.public.function then 3 else 2
         if object.name.map<2,obj.pos,i> then
            err.msg = sysmsg(3457) ;* This method or property name has already been defined
            goto error
         end
      end else
         object.name.map<1,obj.pos> = u.token.string
      end

      object.keys += 1
      if is.public.function then
         object.name.map<2,obj.pos,3> = object.keys
      end else
         object.name.map<2,obj.pos,2> = object.keys
      end

      * Emit a RETURN to prevent "falling into" the get routine

      opcode.byte = OP.RETURN ; gosub emit.simple

      * Create a label for this routine

      label.name = '*':object.keys ; gosub set.label

      object.arg.names = ''
      obj.arg.count = 0
      if look.ahead.token = TKN.LBR then  ;* Arguments present
         gosub process.object.arg.list ; if err then return
      end

      if is.public.function then
         object.name.map<2,obj.pos,5> = obj.arg.count
         object.state = 3
      end else
         object.name.map<2,obj.pos,4> = obj.arg.count
         object.state = 4
      end

      * If this is the CREATE.OBJECT subroutine and we have a list of
      * inherited classes from the CLASS statement, generate code to
      * do the inheritance.

      if is.create.object.subroutine and inherited.classes # '' then
         gosub emit.inheritance
      end

      return
   end

st.private.common:
   if not(object.state) or pc # start.pc then
      err.msg = sysmsg(2891, token.string) ;* Misplaced xx
      goto error
   end

   loop
      locate '*VARS' in commons<1,1> setting common.index else
         stop 'Internal error - *VARS not found'
      end

      symbol.var.no = commons<2,common.index>
      symbol.common.offset = commons<3,common.index> + 1
      commons<3,common.index> = symbol.common.offset

      * Process variables

      rows = 0
      cols = 0

      begin case
      case look.ahead.token = TKN.NAME       ;* Scalar variable
         gosub get.token
         symbol.name = u.token.string
         symbol.dim = 0

      case look.ahead.token = TKN.NAME.LBR   ;* Matrix
         gosub get.token
         symbol.name = u.token.string

         gosub get.token             ;* Skip over left bracket

         gosub get.numeric.constant
         if gnc.err then return
         rows = n

         if rows < 1 then
            err.msg = sysmsg(3441) ;* Illegal row dimension in matrix
            goto error
         end

         if look.ahead.token = TKN.COMMA then     ;* Two dimensions
            gosub get.token          ;* Skip over comma

            gosub get.numeric.constant
            if gnc.err then return
            cols = n + 0

            if cols < 1 then
               err.msg = sysmsg(3442) ;* Illegal column dimension in matrix
               goto error
            end

            symbol.dim = 2
         end else                                 ;* Single dimension
            cols = 0
            symbol.dim = 1
         end

         if look.ahead.token # TKN.RBR then goto err.rbr

         gosub get.token   ;* Skip over right bracket

      case 1
         err.msg = sysmsg(2957) ;* Variable name not found where expected
         goto error
      end case


      if is.public then
         * Is this a read-only variable?
         read.only = look.ahead.token = TKN.NAME and u.look.ahead.token.string = 'READONLY'
         if read.only then gosub get.token
      end

      * Make new symbol table entry, checking for duplicate definitions

      locate symbol.name in symbols<1> by 'AL' setting sympos then
         err.msg = sysmsg(2890, symbol.name) ;* Duplicate symbol 'xx'
         goto error
      end

      var.data = symbol.var.no : @vm : symbol.common.offset : @vm : symbol.dim : @vm : common.index
      ins symbol.name before symbols<sympos>
      ins var.data before symbol.info<sympos>
      ins '' before symbol.refs<sympos>

      commons<4,common.index,symbol.common.offset> = symbol.name
      commons<5,common.index,symbol.common.offset> = rows
      commons<6,common.index,symbol.common.offset> = cols

      if is.public then   ;* Make object name map entry
         object.name.map<1,-1> = symbol.name
         if read.only then
            object.name.map<2,-1> = -symbol.common.offset
         end else
            object.name.map<2,-1> = symbol.common.offset
         end
      end

   while look.ahead.token = TKN.COMMA

      gosub get.token  ;* Read comma token
   repeat

   return

*****************************************************************************
* ST.PROCREAD  -  PROCREAD statement

st.procread:
   gosub simple.lvar.reference  ;* Emit target variable

   * Perform common back-end processing

   opcode = OP.PROCREAD
   ins '0' before onerror.stack<1>        ;* No ON ERROR clause
   ins '0' before testlock.stack<1>       ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>       ;* THEN / ELSE clause required
   goto back.end

*****************************************************************************
* ST.PROCWRITE  -  PROCWRITE statement

st.procwrite:
   n = SYSCOM.PROC.IBUF:'.0' ; gosub emit.ldsys
   gosub exprf
   opcode.byte = OP.STOR ; gosub emit.simple
   return

*****************************************************************************
* ST.PROGRAM  -  PROGRAM statement

st.program:
   if is.ctype then goto err.ctype
   if name.set then goto err.name.set

   if pc # start.pc then
      err.msg = sysmsg(2938) ;* PROGRAM must appear before any executable statements
      goto error
   end

   * Get name of program

   gosub get.name
   program.name = s[1,HDR.PROGRAM.NAME.LEN]
   if len(s) > HDR.PROGRAM.NAME.LEN then
      err.msg = sysmsg(2919) ;* Name has been truncated for cataloguing
      gosub warning
   end
   name.set = @true

   return   

*****************************************************************************
* ST.QUIT  -  QUIT statement (Restricted)

st.quit:
   opcode.byte = OP.QUIT ; gosub emit.simple
   return

*****************************************************************************
* ST.RANDOMIZE

st.randomize:
   if look.ahead.token = TKN.END then
      opcode.byte = OP.TIME ; gosub emit.simple
   end else
      gosub exprf
   end

   opcode.byte = OP.SEED ; gosub emit.simple

   return

*****************************************************************************
* ST.READ    -  READ statement
* ST.READBLK -  READBLK statement
* ST.READL   -  READL statement
* ST.READU   -  READU statement
* ST.READV   -  READV statement
* ST.READVL  -  READVL statement
* ST.READVU  -  READVU statement

st.readblk:
   opcode = OP.READBLK
   goto st.read.common

st.readvl:
   lock.opcode = OP.LLOCK
   goto st.readv

st.readvu:
   lock.opcode = OP.ULOCK
st.readv:
   opcode = OP.READV
   goto st.read.common

st.readl:
   lock.opcode = OP.LLOCK
   goto st.read

st.readu:
   lock.opcode = OP.ULOCK
st.read:
   opcode = OP.READ

st.read.common:
   * Is this a reference to a file defined by a FILE statement?

   locate u.look.ahead.token.string in file.refs<1> setting pos then
      * Emit target variable reference

      gosub get.token
      symbol.name = token.string
      symbol.mode = SYM.USE
      gosub find.var
      gosub emit.var.load      

      * Emit file variable reference

      symbol.name = '__':token.string
      symbol.mode = SYM.USE
      gosub find.var
      gosub emit.var.load      

      if u.look.ahead.token.string # "FROM" then goto err.from
      gosub get.token      ;* Skip FROM token
   end else
      * Emit target variable

      gosub simple.lvar.reference

      if u.look.ahead.token.string # "FROM" then goto err.from
      gosub get.token      ;* Skip FROM token

      * Emit file variable

      gosub simple.var.reference ; if err then return
      gosub check.comma
   end

   * Emit record key expression (block size for readblk)
   gosub exprf

   if opcode = OP.READV then
      gosub check.comma
      gosub exprf ;* Emit field number expression
   end

   if bittest(mode, M.PICK.READ) then
      opcode.byte = OP.PICKREAD ; gosub emit.simple
   end

   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins (lock.opcode # 0) before testlock.stack<1>  ;* LOCKED clause allowed?
   ins '1' before thenelse.stack<1>     ;* THEN / ELSE required
   goto back.end

*****************************************************************************
* ST.READCSV  -  READCSV statement

st.readcsv:
   n = 2 ; gosub emit.temp.ref        ;* To receive raw input data

   if u.look.ahead.token.string # "FROM" then goto err.from
   gosub get.token      ;* Skip FROM token
   gosub simple.var.reference ; if err then return

   opcode.byte = OP.READSEQ ; gosub emit.simple
   opcode.byte = OP.NOT ; gosub emit.simple      ;* TRUE/FALSE -> THEN/ELSE
   opcode.byte = OP.DUP ; gosub emit.simple      ;* Duplicate return status
   label.name = '_':jump.no ; jump.no += 1
   opcode.byte = OP.JZE ; gosub emit.jump        ;* Skip parsing if error

   if u.look.ahead.token.string # "TO" then goto err.to
   gosub get.token      ;* Skip TO token

   n = 1 ; gosub emit.temp.ref                   ;* Variable for parsed data
   n = 2 ; gosub emit.temp.ref                   ;* Retrieve input data
   opcode.string = ',' ; gosub emit.string.load  ;* Delimiter
   opcode.byte = OP.CSVDQ ; gosub emit.simple
   opcode.byte = OP.STOR ; gosub emit.simple

   gosub st.dparse.input

   gosub set.label

   goto st.if.back.end

   return

*****************************************************************************
* ST.READLIST   -  READLIST statement

st.readlist:
   * Emit file variable

   gosub simple.lvar.reference

   if u.look.ahead.token.string = "FROM" then
      gosub get.token       ;* Skip FROM
      gosub exprf            ;* Emit list number expression
   end else     ;* Use default select list
      n = 0 ; gosub emit.numeric.load
   end

   * Perform common back-end processing

   opcode = OP.READLIST
   ins '0' before onerror.stack<1>        ;* No ON ERROR clause
   ins '0' before testlock.stack<1>       ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>       ;* THEN / ELSE clause required
   goto back.end

*****************************************************************************
* ST.READNEXT  -  READNEXT statement

st.readnext:
   * Emit target variable

   gosub simple.lvar.reference

   if look.ahead.token = TKN.COMMA then      ;* Exploded form
      opcode = OP.RDNXEXP
      gosub get.token
      gosub simple.lvar.reference            ;* Value position variable
      if look.ahead.token = TKN.COMMA then
         gosub get.token
         gosub simple.lvar.reference         ;* Subvalue position variable
         if look.ahead.token = TKN.COMMA then
            opcode = OP.RDNXINT
            gosub get.token
            gosub simple.lvar.reference      ;* Internal data variable
         end
      end else
         opcode.byte = OP.LDUNASS ; gosub emit.simple
      end
   end else
      opcode = if bittest(mode, M.COMPOSITE.READNEXT) then OP.RDNXPOS else OP.READNEXT
   end

   if u.look.ahead.token.string = "FROM" then
      gosub get.token       ;* Skip FROM
      gosub exprf            ;* Emit list number expression
   end else     ;* Use default select list
      n = 0 ; gosub emit.numeric.load
   end

   * Perform common back-end processing

   ins '1' before onerror.stack<1>        ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>       ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>       ;* THEN / ELSE clause required
   goto back.end

*****************************************************************************
* ST.READSEQ  -  READSEQ statement

st.readseq:
   * Emit target variable

   if (look.ahead.token # TKN.NAME) and (look.ahead.token # TKN.NAME.LBR) then
      goto err.var
   end

   gosub get.token
   gosub emit.lvar.reference

   if u.look.ahead.token.string # "FROM" then goto err.from
   gosub get.token      ;* Skip FROM token

   * Emit file expresssion
   gosub expr

   * Perform common back-end processing

   opcode = OP.READSEQ
   ins '1' before onerror.stack<1>        ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>       ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>       ;* THEN / ELSE required
   goto back.end

*****************************************************************************
* ST.RECORDLOCKL  -  RECORDLOCKL statement
* ST.RECORDLOCKU  -  RECORDLOCKU statement

st.recordlockl:
   lock.opcode = OP.LLOCK
   goto st.record.lock.common

st.recordlocku:
   lock.opcode = OP.ULOCK

st.record.lock.common:

   gosub convert.pick.file.reference
   gosub simple.var.reference ; if err then return    ;* Emit file variable
   gosub check.comma
   gosub exprf           ;* Emit record id expresssion

   * Perform common back-end processing

   opcode = OP.LOCKREC
   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins '1' before testlock.stack<1>     ;* Optional LOCKED clause
   ins '0' before thenelse.stack<1>     ;* No THEN or ELSE clause
   goto back.end

*****************************************************************************
* ST.RELEASE  -  RELEASE statement

st.release:
   gosub convert.pick.file.reference
   find u.look.ahead.token.string in reserved.names setting i else i = 0 ;* 0303

   if look.ahead.token and (look.ahead.token # TKN.SEMICOLON) and (u.look.ahead.token.string # "ON") and i = 0 then
      * File variable and/or record id present

      gosub simple.var.reference ; if err then return  ;* Emit file variable

      if look.ahead.token = TKN.COMMA then     ;* Record id supplied
         gosub get.token
         gosub exprf
         opcode = OP.RELEASE
      end else
         opcode = OP.RLSFILE    ;* 0245
      end
   end
   else opcode = OP.RLSALL

   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>     ;* No LOCKED clause
   ins '0' before thenelse.stack<1>     ;* No THEN or ELSE clause
   goto back.end

*****************************************************************************
* ST.RELEASE.LOCK  -  RELEASE.LOCK statement (Restricted)

st.release.lock:
   gosub exprf         ;* File no
   gosub check.comma
   gosub exprf         ;* User no

   if look.ahead.token = TKN.COMMA then
      gosub get.token
      gosub exprf         ;* Record id
      opcode.byte = OP.UNLK ; gosub emit.simple
   end else
      opcode.byte = OP.UNLKFL ; gosub emit.simple
   end

   return

*****************************************************************************
* ST.REMARK  -  REMARK (comment) statement
* Also entered from proc.line for comment immediately after label

st.remark:
   loop
   while token
      gosub get.token
   repeat

   return

*****************************************************************************
* ST.REMOVE  -  REMOVE and REMOVE.TOKEN statements

st.remove:
   opcode = OP.REMOVE
   goto st.remove.common

st.remove.token:
   opcode = OP.RMVTKN

st.remove.common:

   * Emit target variable reference

   gosub simple.lvar.reference ; if err then return
   if u.look.ahead.token.string # "FROM" then goto err.from
   gosub get.token     ;* Skip FROM token

   * Emit source variable reference

   gosub simple.var.reference ; if err then return

   if u.look.ahead.token.string # "SETTING" then
      err.msg = sysmsg(2914) ;* SETTING not found where expected
      goto error
   end

   gosub get.token     ;* Skip token

   * Emit delimiter or offset variable reference

   gosub simple.lvar.reference ; if err then return

   * Emit REMOVE or RMVTKN opcode

   opcode.byte = opcode ; gosub emit.simple

   * Store result substring

   opcode.byte = OP.STOR ; gosub emit.simple

   return

*****************************************************************************
* ST.REMOVE.BREAK.HANDLER

st.remove.break.handler:
   n = K$BREAK.HANDLER ; gosub emit.numeric.load
   opcode.byte = OP.LDNULL ; gosub emit.simple
   opcode.byte = OP.KERNEL ; gosub emit.simple

   return

*****************************************************************************
* ST.REPEAT  -  REPEAT statement

st.repeat:
   * The item at the top of the jump stack must be a loop construct
   if jump.stack<1,1> = j.loop then

      * Set up label name for loop repeat jump
      label.name = "_":jump.stack<1,2>:"R"
      opcode.byte = OP.JMP ; gosub emit.jump

      * Generate loop exit label
      label.name = "_":jump.stack<1,2>:"X"
      gosub set.label
      del jump.stack<1>
   end else
      err.msg = sysmsg(2939) ;* REPEAT not matched by LOOP
      gosub error
   end                
   return

*****************************************************************************
* ST.RESTORE.SCREEN  -  Restore screen image

st.restore.screen:
   gosub simple.var.reference      ;* Screen image variable
   gosub check.comma
   gosub exprf                      ;* Full or partial restore?
   opcode.byte = OP.RSTSCRN ; gosub emit.simple

   return

*****************************************************************************
* ST.RETURN  -  RETURN statement
*    Variants:
*       RETURN                      Return from GOSUB or CALL
*       RETURN TO label             Jump to label, removing call level
*                                   Acts as RETURN if not in GOSUB
*       RETURN VALUE expression     Leave value on e-stack (restricted)

st.return:
   find u.look.ahead.token.string in reserved.names setting i else i = 0

   begin case
      case u.look.ahead.token.string = "TO"
         if lsub.var.no >= 0 then
            err.msg = sysmsg(3422) ;* Statement not allowed inside a LOCAL subroutine or function
            goto error
         end
         gosub get.token
         gosub get.label.name
         opcode.byte = OP.RETURNTO ; gosub emit.jump
         return

      case u.look.ahead.token.string = "VALUE" and internal
         gosub get.token               ;* Read VALUE token
         gosub exprf
         opcode.byte = OP.VALUE ; gosub emit.simple

      case i or look.ahead.token = TKN.END or look.ahead.token = TKN.SEMICOLON
         if object.state = 3 then
            err.msg = sysmsg(3447) ;* A GET routine or PUBLIC FUNCTION must return a value
            goto error
         end

      case 1
         begin case
            case object.state = 3
               * GET routine / Public function - Treat as RETURN VALUE
               gosub exprf
               opcode.byte = OP.VALUE ; gosub emit.simple
               goto exit.st.return

            case is.local.function
               symbol.name = lsub.name:':_FUNCRET'

            case bitand(header.flags, hdr.is.function)
               symbol.name = "_FUNCRET"

            case 1
               err.msg = sysmsg(2940) ;* Return value only allowed in functions
               goto error
         end case

         symbol.mode = SYM.SET
         gosub find.var
         gosub emit.var.load
         gosub exprf
         opcode.byte = OP.STOR ; gosub emit.simple
   end case

   if lsub.var.no >= 0  then
      opcode.byte = OP.DELLCL ; gosub emit.simple
      code.value = lsub.var.no ; code.bytes = 2 ; gosub emit.multibyte.value
   end

exit.st.return:
   opcode.byte = OP.RETURN ; gosub emit.simple

   return

*****************************************************************************
* ST.REWIND  -  REWIND statement (restricted)

st.rewind:
   gosub simple.var.reference  ;* BTree variable
   opcode.byte = OP.BTRESET
   gosub emit.simple
   return

*****************************************************************************
* ST.ROLLBACK  -  ROLLBACK statement

st.rollback:
   if internal and u.look.ahead.token.string = 'ALL' then
      gosub get.token
      opcode.byte = OP.TXNRBK
      gosub emit.simple
      return
   end

   * Walk back down the jump stack to find the associated transaction

   i = 1
   loop
      s = jump.stack<i>
   until s<1,1> = J.TXN
      if s = '' then
         err.msg = sysmsg(2942) ;* ROLLBACK not in a transaction
         goto error
      end
      i += 1
   repeat

   label.name = "_":s<1,2>:"E"
   opcode.byte = OP.JMP ; gosub emit.jump

   return

*****************************************************************************
* ST.SAVELIST -  SAVELIST statement

st.savelist:
   gosub exprf
   if u.look.ahead.token.string = 'FROM' then
      gosub get.token
      gosub exprf
   end else
      n = 0 ; gosub emit.numeric.load
   end
   opcode.byte = OP.SAVELIST ; gosub emit.simple
   goto st.if.back.end           ;* Join IF statement for THEN / ELSE

*****************************************************************************
* ST.SEEK   -  SEEK statement

st.seek:
   gosub simple.var.reference   ;* Emit file variable

   if look.ahead.token = TKN.COMMA then   ;* Offset
      gosub get.token
      gosub exprf
   end else
      n = 0 ; gosub emit.numeric.load
   end

   if look.ahead.token = TKN.COMMA then   ;* Relto
      gosub get.token
      gosub exprf
   end else
      n = 0 ; gosub emit.numeric.load
   end

   * Perform common back-end processing

   opcode = OP.SEEK
   ins '0' before onerror.stack<1>        ;* No ON ERROR clause
   ins '0' before testlock.stack<1>       ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>       ;* THEN / ELSE clause required
   goto back.end

*****************************************************************************
* ST.SELECT   -  SELECT statement
* ST.SELECTN  -  SELECTN statement
* ST.SELECTV  -  SELECTV statement
* ST.SSELECT  -  SSELECT statement

st.sselect:
   opcode = OP.SSELECT
   goto st.select.common

st.selectn:
   opcode = OP.SELECT
   goto st.select.common

st.selectv:
   opcode = OP.SELECTV
   goto st.select.common

st.select:
   opcode = if bittest(mode, M.SELECTV) then OP.SELECTV else OP.SELECT

st.select.common:
   * Emit file variable / dynamic array reference

   gosub convert.pick.file.reference
   gosub expr    ;* 0208

   if u.look.ahead.token.string = "TO" then
      gosub get.token       ;* Skip TO
      if opcode = OP.SELECTV then
         gosub simple.lvar.reference
      end else
         gosub exprf            ;* Emit list number expression
      end
   end else     ;* Use default select list
      if opcode = OP.SELECTV then goto err.to
      n = 0 ; gosub emit.numeric.load
   end

   * Perform common back-end processing

   ins '1' before onerror.stack<1>        ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>       ;* No LOCKED clause allowed
   ins '0' before thenelse.stack<1>       ;* No THEN / ELSE clause
   goto back.end

*****************************************************************************
* ST.SELECTE   -  SELECTE statement

st.selecte:
   if u.look.ahead.token.string # "TO" then goto err.to
   gosub get.token       ;* Skip TO
   gosub simple.lvar.reference
   opcode.byte = OP.SELECTE
   gosub emit.simple
   return

*****************************************************************************
* ST.SELECTINDEX   -  SELECTINDEX statement

st.selectindex:
   opcode = OP.SELINDX
   gosub expr                  ;* Emit index name

   if look.ahead.token = TKN.COMMA then
      opcode = OP.SELINDXV
      gosub get.token          ;* Skip comma
      gosub expr               ;* Emit indexed value
   end

   if u.look.ahead.token.string # 'FROM' then goto err.from
   gosub get.token

   gosub convert.pick.file.reference
   gosub simple.var.reference  ;* Emit file variable

   if u.look.ahead.token.string = "TO" then
      gosub get.token          ;* Skip TO
      gosub exprf              ;* Emit list number expression
   end else                    ;* Use default select list
      n = 0 ; gosub emit.numeric.load
   end

   opcode.byte = opcode ; gosub emit.simple
   return

*****************************************************************************
* ST.SELECTLEFT   -  SELECTLEFT statement
* ST.SELECTRIGHT  -  SELECTRIGHT statement

st.selectleft:
   opcode = OP.SELLEFT
   goto st.selectleftright

st.selectright:
   opcode = OP.SELRIGHT

st.selectleftright:
   gosub expr                  ;* Emit index name

   if u.look.ahead.token.string # 'FROM' then goto err.from
   gosub get.token

   gosub convert.pick.file.reference
   gosub simple.var.reference  ;* Emit file variable

   if u.look.ahead.token.string = 'SETTING' then
      gosub get.token          ;* Skip SETTING
      gosub simple.lvar.reference
      if err then return
   end else
      opcode.byte = OP.LDUNASS
      gosub emit.simple
   end

   if u.look.ahead.token.string = "TO" then
      gosub get.token          ;* Skip TO
      gosub exprf              ;* Emit list number expression
   end else                    ;* Use default select list
      n = 0 ; gosub emit.numeric.load
   end

   opcode.byte = opcode ; gosub emit.simple
   return

*****************************************************************************
* ST.SENDMAIL
* SENDMAIL sender,recipients,cc,bcc,subject,text,attachments

st.sendmail:
   gosub expr ;*  Sender
   gosub check.comma
   gosub expr ;*  Recipients
   gosub check.comma
   gosub expr ;*  Cc recipients
   gosub check.comma
   gosub expr ;*  Bcc recipients
   gosub check.comma
   gosub expr ;*  Subject
   gosub check.comma
   gosub expr ;*  Text
   gosub check.comma
   gosub expr ;*  Attachments
   opcode.byte = OP.SENDMAIL ; gosub emit.simple

   return

*****************************************************************************
* SET.ARG

st.set.arg:
   gosub expr
   opcode.byte = OP.ARG ; gosub emit.simple
   gosub check.comma
   gosub expr
   opcode.byte = OP.STOR ; gosub emit.simple
   return

*****************************************************************************
* ST.SET.BREAK.HANDLER

st.set.break.handler:
   n = K$BREAK.HANDLER ; gosub emit.numeric.load
   gosub expr
   opcode.byte = OP.KERNEL ; gosub emit.simple

   return

*****************************************************************************
* ST.SET.EXIT.STATUS  -  SET.EXIT.STATUS statement

st.set.exit.status:
   n = K$EXIT.STATUS ; gosub emit.numeric.load
   gosub expr
   opcode.byte = OP.KERNEL ; gosub emit.simple
   return

*****************************************************************************
* ST.SETLEFT   -  SETLEFT statement
* ST.SETRIGHT  -  SETRIGHT statement

st.setleft:
   opcode = OP.SETLEFT
   goto st.setleftright

st.setright:
   opcode = OP.SETRIGHT

st.setleftright:
   gosub expr                  ;* Emit index name

   if u.look.ahead.token.string # 'FROM' then goto err.from
   gosub get.token

   gosub convert.pick.file.reference
   gosub simple.var.reference  ;* Emit file variable

   opcode.byte = opcode ; gosub emit.simple
   return

*****************************************************************************
* ST.SETPU

st.setpu:
   gosub expr    ;* Action key
   gosub check.comma
   gosub expr    ;* Print unit
   gosub check.comma
   gosub exprf   ;* New value
   opcode.byte = OP.SETPU ; gosub emit.simple
   return

*****************************************************************************
* ST.SETREM  -  SETREM statement

st.setrem:
   gosub exprf        ;* Process remove pointer position expression

   if u.look.ahead.token.string # "ON" then
      err.msg = sysmsg(2943) ;* ON not found where expected
      goto error
   end

   gosub get.token            ;* Skip "ON"

   gosub get.token
   gosub emit.lvar.reference  ;* Emit target variable reference

   opcode.byte = OP.SETREM ; gosub emit.simple

   return

*****************************************************************************
* ST.SET.TRIGGER -  SET.TRIGGER statement (restricted)

st.set.trigger:
   gosub expr          ;* File name
   gosub check.comma
   gosub expr          ;* Trigger function name
   gosub check.comma
   gosub expr          ;* Modes
   opcode.byte = OP.SETTRIG ; gosub emit.simple
   return

*****************************************************************************
* ST.SET.UNASSIGNED - SET.UNASSIGNED (restricted)

st.set.unassigned:
   gosub get.token
   symbol.name = token.string
   symbol.mode = SYM.SET
   gosub find.var
   if symbol.var.no < 0 then
      symbol.dim = 0
      symbol.mode = SYM.SET
      gosub make.var
   end
   gosub emit.var.load
   opcode.byte = OP.SETUNASS ; gosub emit.simple

   return

*****************************************************************************
* ST.SLEEP  -  SLEEP / RQM statements

st.sleep:
   find u.look.ahead.token.string in reserved.names setting i else i = 0  ;* 0142, 0265
   if i or look.ahead.token = TKN.END or look.ahead.token = TKN.SEMICOLON then
      n = 1 ; gosub emit.numeric.load
   end else
      gosub exprf
   end

   opcode.byte = OP.SLEEP ; gosub emit.simple
   return

*****************************************************************************
* ST.SORTADD  -  SORTADD statement (Restricted)

st.sortadd:
   if look.ahead.token # TKN.NAME then goto err.var
   gosub get.token
   symbol.name = token.string
   gosub find.var
   if (symbol.var.no < 0) or (symbol.dim # 1) then
      err.msg = sysmsg(2858) ;* One dimensional matrix name required
      goto error
   end
   gosub emit.var.load    ;* Emit key array
   if look.ahead.token = TKN.COMMA then
      gosub get.token
      gosub exprf            ;* Emit data
   end else
      opcode.byte = OP.LDUNASS ; gosub emit.simple
   end
   opcode.byte = OP.SORTADD ; gosub emit.simple
   return

*****************************************************************************
* ST.SORTINIT -  SORTINIT statement (Restricted)

st.sortinit:
   gosub expr    ;* Emit key count

   gosub check.comma
   if look.ahead.token # TKN.NAME then goto err.var

   gosub get.token
   symbol.name = token.string
   gosub find.var
   if (symbol.var.no < 0) or (symbol.dim # 1) then
      err.msg = sysmsg(2858) ;* One dimensional matrix name required
      goto error
   end
   gosub emit.var.load    ;* Emit key array

   opcode.byte = OP.SORTINIT ; gosub emit.simple

   return
 
*****************************************************************************
* ST.STATUS  -  STATUS statement

st.status:
   gosub simple.lvar.reference
   if u.look.ahead.token.string # 'FROM' then goto err.from
   gosub get.token
   gosub simple.var.reference
   n = FL$STATUS ; gosub emit.numeric.load
   opcode.byte = OP.FILEINFO ; gosub emit.simple
   opcode.byte = OP.STOR ; gosub emit.simple
   opcode.byte = OP.LD1 ; gosub emit.simple   ;* Always take THEN clause
   goto st.if.back.end           ;* Join IF statement for THEN / ELSE

*****************************************************************************
* ST.STOP -  STOP statement

st.stop:
   pick.style.message = bittest(mode, M.PICK.ERRMSG)
   goto st.stop.common
st.stopm:
   pick.style.message = @false
   goto st.stop.common
st.stope:
   pick.style.message = @true
st.stop.common:

   if recursive then goto err.recursive

   * The STOP statement may optionally have an associated text message.
   * Check the next token to see if we have a message.


   if look.ahead.token and (look.ahead.token # TKN.SEMICOLON) then
      n = 0
      if look.ahead.token = TKN.NAME then  ;* 0362
         find u.look.ahead.token.string in reserved.names setting n else null
      end
      if n = 0 then
         if pick.style.message then
            gosub exprf
            gosub emit.errmsg.args
            opcode.byte = OP.ERRMSG ; gosub emit.simple
         end else
            * Emit code to print the string by merging with PRINT opcode
            print.opcode = OP.DSP ; gosub emit.print.list
         end
      end
   end

   opcode.byte = OP.STOP ; gosub emit.simple

   return

*****************************************************************************
* ST.SUBROUTINE  -  SUBROUTINE statement

st.subroutine:
   if is.ctype then goto err.ctype
   if name.set then goto err.name.set

   if pc # start.pc then
      err.msg = sysmsg(2944) ;* SUBROUTINE must appear before any executable statements
      goto error
   end

   * Get name of subroutine

   if look.ahead.token # TKN.END and look.ahead.token # TKN.SEMICOLON then ;* 0243
      if look.ahead.token # TKN.LBR then
         gosub get.call.name
         program.name = s[1,HDR.PROGRAM.NAME.LEN]
         if len(s) > HDR.PROGRAM.NAME.LEN then
            err.msg = sysmsg(2919) ;* Name has been truncated for cataloguing
            gosub warning
         end
      end
   end

   name.set = @true

   if look.ahead.token = TKN.LBR then
      gosub get.token

      if look.ahead.token # TKN.RBR then   ;* Arguments present
         loop
            deref.argument = @false

            if u.look.ahead.token.string = "MAT" then
               dim.dimensions = -1   ;* Indicates not yet known
               gosub get.token
               if look.ahead.token # TKN.NAME then goto err.var
            end else if u.look.ahead.token.string = "VARSET" then
               gosub get.token
               if look.ahead.token # TKN.NAME then goto err.var
               gosub get.var.name              ;* Get argument structure name
               locate u.token.string in varsets<1,1> setting pos then
                  err.msg = sysmsg(3455)  ;* Duplicate VARSET name
                  goto error
               end
               varsets<1,pos> = u.token.string
               varsets<2,pos> = var.count
               varsets<3,pos> = @true
               var.count += 1
               goto st.subroutine.varset.continue
            end else
               dim.dimensions = 0

               if look.ahead.token = TKN.LBR then
                  * Need to dereference this argument
                  deref.argument = @true
                  gosub get.token
               end
            end

            gosub get.var.name              ;* Get argument variable name
         until err

            * Check that variable is not present twice in argument list

            symbol.name = token.string
            symbol.mode = SYM.ARG
            gosub find.var

            if symbol.var.no >= 0 then
               err.msg = sysmsg(2920, symbol.name) ;* Duplicate argument name 'xx'
               goto error
            end

            if look.ahead.token = TKN.LBR then  ;* Matrix dimensions
               gosub get.arg.mat.dimensions
            end

            * Make variable for argument

            symbol.common.offset = -1
            symbol.dim = dim.dimensions
            symbol.mode = SYM.ARG
            gosub make.var

            if deref.argument then
               if look.ahead.token # TKN.RBR then goto err.rbr
               gosub get.token
               gosub emit.var.load
               opcode.byte = OP.DEREF ; gosub emit.simple
            end

st.subroutine.varset.continue:
            subr.arg.count += 1

         while look.ahead.token = TKN.COMMA
            gosub get.token
            if look.ahead.token = TKN.END then gosub get.token
         repeat

         if subr.arg.count > 255 then
            err.msg = sysmsg(2898) ;* Too many arguments...
            goto error
         end

         if look.ahead.token # TKN.RBR then goto err.rbr
      end

      gosub get.token     ;* Skip close bracket
   end

   if u.look.ahead.token.string = 'VAR.ARGS' then
      gosub get.token
      header.flags = bitor(header.flags, HDR.VAR.ARGS)
   end

   return

*****************************************************************************
* TCLREAD

st.tclread:
   gosub simple.lvar.reference ;* Emit target variable
   n = SYSCOM.SENTENCE ; gosub emit.ldsys
   opcode.byte = OP.STOR ; gosub emit.simple   
   return

*****************************************************************************
* ST.TIMEOUT

st.timeout:
   gosub simple.var.reference ; if err then return  ;* Emit file variable
   gosub check.comma
   gosub expr                                       ;* Emit timeout period
   opcode.byte = OP.TIMEOUT ; gosub emit.simple
   return

*****************************************************************************
* ST.TRANSACTION

st.transaction:
   gosub get.token
   begin case
      case u.token.string = 'START'
         * TRANSACTION START (and TRANSACTION END below) are defined as
         * having a THEN/ELSE clause. Strangely, the UniVerse documentation
         * says that success executes the THEN clause and failure causes a
         * run time error so there doesn't seem to be a path into the ELSE
         * clause. We support an optional THEN/ELSE clause but cheat by
         * forcing our way into the THEN clause.

         opcode.byte = OP.TXNBGN ; gosub emit.simple
         opcode = OP.LD0
         ins '0' before onerror.stack<1>      ;* No ON ERROR clause
         ins '0' before testlock.stack<1>     ;* No LOCKED clause
         ins '2' before thenelse.stack<1>     ;* Optional THEN / ELSE clause
         goto back.end
         
      case u.token.string = 'COMMIT'
         opcode.byte = OP.TXNCMT ; gosub emit.simple
         opcode = OP.LD0
         ins '0' before onerror.stack<1>      ;* No ON ERROR clause
         ins '0' before testlock.stack<1>     ;* No LOCKED clause
         ins '2' before thenelse.stack<1>     ;* Optional THEN / ELSE clause
         goto back.end
         
      case u.token.string = 'ABORT'
         opcode.byte = OP.TXNEND ; gosub emit.simple

      case 1
         err.msg = sysmsg(3439) ;* Expected START, END or ABORT after TRANSACTION
         goto error
   end case

   return

*****************************************************************************
* ST.TTYSET

st.ttyset:
   gosub exprf
   opcode.byte = OP.TTYSET ; gosub emit.simple
   return

*****************************************************************************
* ST.TRACE  -  TRACE statement (Restricted)

st.trace:
   opcode.byte = OP.TRACE ; gosub emit.simple
   return

*****************************************************************************
* ST.UNLOAD.OBJECT  -  UNLOAD.OBJECT statement (Restricted)

st.unload.object:
   opcode.byte = OP.UNLOAD ; gosub emit.simple
   return

*****************************************************************************
* ST.UNLOCK  -  UNLOCK statement

st.unlock:
   gosub exprf

   opcode = OP.UNLOCK
   ins '0' before onerror.stack<1>      ;* No ON ERROR clause
   ins '0' before testlock.stack<1>     ;* No LOCKED clause
   ins '2' before thenelse.stack<1>     ;* Optional THEN / ELSE clause
   goto back.end

*****************************************************************************
* ST.UNTIL  -  UNTIL statement
* ST.WHILE  -  WHILE statement

st.until:
   opcode = OP.JTRUE
   goto st.while.until.common

st.while:
   opcode = OP.JFALSE

st.while.until.common:
   * Work down jump stack until we find a LOOP or FOR construct
   j.index = 1
   loop
      n = jump.stack<j.index,1> + 0
   until (n = j.loop) or (n = j.for)
      if n = 0 then
         err.msg = sysmsg(2891, token.string) ;* Misplaced xx
         goto error
      end
      j.index += 1
   repeat

   gosub exprf
   label.name = "_":jump.stack<j.index,2>:"X"
   opcode.byte = opcode ; gosub emit.jump

   if u.look.ahead.token.string = "DO" then gosub get.token

   return

*****************************************************************************
* ST.VOID  -  VOID statement

st.void:
   gosub expr
   opcode.byte = OP.POP ; gosub emit.simple
   return

*****************************************************************************
* ST.WATCH           -  WATCH statement (restricted)

st.watch:
   gosub expr
   if look.ahead.token = TKN.COMMA then
      gosub get.token
      gosub expr
   end else
      opcode.byte = OP.LD0 ; gosub emit.simple
   end

   opcode.byte = OP.DBGWATCH ; gosub emit.simple
   return

*****************************************************************************
* ST.WEOFSEQ  -  WEOFSEQ statement

st.weofseq:
   gosub expr  ;* Emit file variable expresssion

   * Perform common back-end processing

   opcode = OP.WEOFSEQ
   ins '1' before onerror.stack<1>        ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>       ;* No LOCKED clause allowed
   ins '0' before thenelse.stack<1>       ;* No THEN / ELSE allowed
   goto back.end

*****************************************************************************
* ST.WRITE    -  WRITE statement
* ST.WRITEU   -  WRITEU statement
* ST.WRITEV   -  WRITEV statement
* ST.WRITEVU  -  WRITEVU statement

st.writevu:
   lock.opcode = OP.ULOCK
st.writev:
   opcode = OP.WRITEV
   goto st.write.common

st.writeu:
   lock.opcode = OP.ULOCK
st.write:
   opcode = OP.WRITE

st.write.common:
   * Is this a reference to a file defined by a FILE statement?

   if look.ahead.token = TKN.NAME then
      locate u.look.ahead.token.string in file.refs<1> setting pos else pos = 0
   end else
      pos = 0
   end

   if pos then
      * Emit source variable reference

      gosub get.token
      symbol.name = token.string
      symbol.mode = SYM.USE
      gosub find.var
      gosub emit.var.load      

      * Emit file variable reference

      symbol.name = '__':token.string
      symbol.mode = SYM.USE
      gosub find.var
      gosub emit.var.load      

      if (u.look.ahead.token.string # "TO") & (u.look.ahead.token.string # "ON") then goto err.to.on
      gosub get.token      ;* Skip TO token
   end else
      gosub exprf           ;* Get record to write

      if (u.look.ahead.token.string # "TO") & (u.look.ahead.token.string # "ON") then goto err.to.on
      gosub get.token      ;* Skip TO/ON token

      * Emit file variable

      gosub simple.var.reference ; if err then return
      gosub check.comma
   end

   gosub exprf           ;* Get record id

   if opcode = OP.WRITEV then
      gosub check.comma
      gosub exprf  ;* Emit field number expression
   end

   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>     ;* No LOCKED clause allowed
   ins '0' before thenelse.stack<1>     ;* No THEN / ELSE required
   goto back.end

*****************************************************************************
* ST.WRITEBLK   -  WRITEBLK statement
* ST.WRITESEQ   -  WRITESEQ statement
* ST.WRITESEQF  -  WRITESEQF statement
* ST.WRITECSV   -  WRITECSV statement

st.writeblk:
   opcode = OP.WRITEBLK
   goto st.write.seq.common

st.writecsv:
   gosub emit.csv.list
   if err then return
   opcode = OP.WRITESEQ
   goto st.write.seq.common2

st.writeseq:
   opcode = OP.WRITESEQ
   goto st.write.seq.common

st.writeseqf:
   opcode = OP.WRITESEQF

st.write.seq.common:
   gosub exprf           ;* Get record to write

st.write.seq.common2:
   if (u.look.ahead.token.string # "TO") & (u.look.ahead.token.string # "ON") then goto err.to.on
   gosub get.token        ;* Skip TO / ON

   * Emit file variable 

   gosub simple.var.reference ; if err then return

   ins '1' before onerror.stack<1>      ;* Optional ON ERROR clause
   ins '0' before testlock.stack<1>     ;* No LOCKED clause allowed
   ins '1' before thenelse.stack<1>     ;* THEN / ELSE clause required
   goto back.end

*****************************************************************************
*****           COMMON PATHS FOR STATEMENT PROCESSING ROUTINES          *****
*****************************************************************************

*****************************************************************************
* Pick style errmsg argument processing for STOP and ABORT

emit.errmsg.args:
   if look.ahead.token = TKN.COMMA then
      gosub get.token
      gosub expr
      loop
      while look.ahead.token = TKN.COMMA
         gosub get.token
         opcode.string = @IM  ; gosub emit.string.load
         opcode.byte = OP.CAT ; gosub emit.simple
         gosub expr
         opcode.byte = OP.CAT ; gosub emit.simple
      repeat
   end else
      opcode.byte = OP.LDNULL ; gosub emit.simple
   end

   return

*****************************************************************************
* back.end  -  Common paths for ON ERROR / LOCKED / THEN / ELSE clauses
*
* The opcode we are to emit is in OPCODE as we need to know if we have
* an ONERROR opcode to emit first.
*
* Entry from statements that test only for THEN and ELSE clauses can emit
* the opcode before entry, setting OPCODE to -1.
*
* LOCK.OPCODE will be non-zero if a ULOCK or LLOCK opcode is to be emitted.

back.end:
   * Add new entry to jump stack
   ins j.back.end:@vm:jump.no before jump.stack<1>

   jump.no += 1

   * Emit lock opcode if required

   if lock.opcode then
      opcode.byte = lock.opcode ; gosub emit.simple
      lock.opcode = 0
   end

   * If this opcode takes an optional LOCKED clause, emit a NULL opcode which
   * will overwritten later with the TESTLOCK opcode if we find a LOCKED clause.

   if testlock.stack<1> then
      opcode.byte = OP.NULL ; gosub emit.simple
      testlock.stack<1> = pc - 1    ;* Save address for possible overwrite
   end

   * Look for ON ERROR clause
   
   if onerror.stack<1> then
      if look.ahead.token = TKN.END then gosub get.token

      * 0074  Need to check for ON ERROR, not just ON otherwise a WRITE
      * followed by an ON GOTO is misinterpretted.

      if u.look.ahead.token.string = "ON" and upcase(token.strings(token.index + 1)) = "ERROR" then
         gosub get.token    ;* Skip "ON"
         gosub get.token    ;* Skip "ERROR"

         * Emit        ONERROR
         *             opcode
         *             DUP
         *             JPZ    L1
         *             POP
         *             Conditioned statements
         *         L1

         opcode.byte = OP.ONERROR ; gosub emit.simple
         opcode.byte = opcode ; gosub emit.simple
         opcode.byte = OP.DUP ; gosub emit.simple

         * Generate jump around ON ERROR clause
         label.name = "_":jump.stack<1,2>:"A"
         opcode.byte = OP.JPZ ; gosub emit.jump

         opcode.byte = OP.POP ; gosub emit.simple

         if look.ahead.token = TKN.END then     ;* ON ERROR / END construct
            gosub get.token
            loop
               if end.source then
                  err.msg = sysmsg(2946) ;* Unterminated ON ERROR clause
                  gosub error
                  goto exit.back.end
               end
               * 0336 Check for a label
               gosub get.token
               gosub check.for.label

            until u.token.string = "END"
               gosub proc.line.prefetched
            repeat
         end else                        ;* Conditional statement on same line
            gosub get.token
            gosub proc.statement.group
         end

         * Check that the top of the jump stack is a back end jump
         if jump.stack<1,1> #j.back.end then
            err.msg = sysmsg(2947) ;* Incorrectly formed ON ERROR clause
            gosub error
            goto exit.back.end
         end

         * Generate jump to end of entire construct
         label.name = "_":jump.stack<1,2>:"X"
         opcode.byte = OP.JMP ; gosub emit.jump

         * Set label at end of construct
         label.name = "_":jump.stack<1,2>:"A"
         gosub set.label
      end else        ;* No ON ERROR clause present
         opcode.byte = opcode ; gosub emit.simple
      end
   end else        ;* No ON ERROR clause alowed
      if opcode >= 0 then
         opcode.byte = opcode ; gosub emit.simple
      end
   end

   * Look for LOCKED clause

   if testlock.stack<1> then
      if look.ahead.token = TKN.END then gosub get.token

      if u.look.ahead.token.string = "LOCKED" then
         gosub get.token    ;* Skip "LOCKED"

         * Go back and insert a NOWAIT opcode at the address on the stack
         update.addr = testlock.stack<1>
         code.value = OP.NOWAIT
         code.bytes = 1
         gosub update.code

         * Emit        DUP
         *             LDLINT ER$LCK
         *             EQ
         *             JZE    L1
         *             POP
         *             Conditioned statements
         *         L1

         opcode.byte = OP.DUP ; gosub emit.simple
         n = ER$LCK ; gosub emit.numeric.load
         opcode.byte = OP.EQ ; gosub emit.simple

         * Generate jump around LOCKED clause
         label.name = "_":jump.stack<1,2>:"B"
         opcode.byte = OP.JZE ; gosub emit.jump

         opcode.byte = OP.POP ; gosub emit.simple
         if look.ahead.token = TKN.END then     ;* LOCKED / END construct
            gosub get.token
            loop
               if end.source then
                  err.msg = sysmsg(2948) ;* Unterminated LOCKED clause
                  gosub error
                  goto exit.back.end
               end
               * 0336 Check for a label
               gosub get.token
               gosub check.for.label
            until u.token.string = "END"
               gosub proc.line.prefetched
            repeat
         end else                        ;* Conditional statement on same line
            gosub get.token
            gosub proc.statement.group
         end

         * Check that the top of the jump stack is a back end jump
         if jump.stack<1,1> # j.back.end then
            err.msg = sysmsg(2949) ;* Incorrectly formed LOCKED clause
            gosub error
            goto exit.back.end
         end

         * Generate jump to end of entire construct
         label.name = "_":jump.stack<1,2>:"X"
         opcode.byte = OP.JMP ; gosub emit.jump

         * Set label at end of construct
         label.name = "_":jump.stack<1,2>:"B"
         gosub set.label
      end
   end

   if thenelse.stack<1> then

      * Look for THEN and ELSE clauses
      * If thenelse.stack entry = 1 at least one of which must be present
      * If thenelse.stack entry = 2 THEN and ELSE are optional

      if look.ahead.token = TKN.END then gosub get.token

      if thenelse.stack<1> = 2 then   ;* THEN/ELSE is optional
         if (u.look.ahead.token.string # "THEN") and (u.look.ahead.token.string # "ELSE") then
            goto no.then.or.else.clause
         end
      end

      if u.look.ahead.token.string = "ELSE" then   ;* ELSE without THEN
         gosub get.token              ;* Skip the ELSE token

         * Generate jump to exit point if would have taken THEN clause
         label.name = "_":jump.stack<1,2>:"X"
         opcode.byte = OP.JZE ; gosub emit.jump

         goto process.else.clause
      end

      if u.look.ahead.token.string # "THEN" then          ;* No THEN clause
         err.msg = sysmsg(2921) ;* Expected THEN or ELSE
         gosub error
         goto exit.back.end
      end

      gosub get.token           ;* Skip "THEN" token

      * Generate jump to ELSE clause (or end if no ELSE)
      label.name = "_":jump.stack<1,2>:"E"
      opcode.byte = OP.JNZ ; gosub emit.jump

      if look.ahead.token = TKN.END then     ;* THEN / END construct
         gosub get.token
         loop
            if end.source then
               err.msg = sysmsg(2922) ;* Unterminated THEN clause
               gosub error
               goto exit.back.end
            end
            * 0336 Check for a label
            gosub get.token
            gosub check.for.label
         until u.token.string = "END"
            gosub proc.line.prefetched
         repeat
      end else                          ;* Conditional statement on same line
         gosub get.token
         gosub proc.statement.group
      end

      * Look for an ELSE clause

      if look.ahead.token = TKN.END then gosub get.token

      if u.look.ahead.token.string = "ELSE" then   ;* ELSE clause present
         gosub get.token        ;* Skip ELSE token

         * Check that the top of the jump stack is a back end jump
         if jump.stack<1,1> # j.back.end then
            err.msg = sysmsg(2924) ;* Misplaced ELSE
            gosub error
            goto exit.back.end
         end

         * Emit jump to exit label
         label.name = "_":jump.stack<1,2>:"X"
         opcode.byte = OP.JMP ; gosub emit.jump

         * Set label for head of ELSE clause
         label.name = "_":jump.stack<1,2>:"E"
         gosub set.label

process.else.clause:

         if look.ahead.token = TKN.END then     ;* ELSE / END construct
            gosub get.token
            loop
               if end.source then
                  err.msg = sysmsg(2923) ;* Unterminated ELSE clause
                  gosub error
                  goto exit.back.end
               end
               * 0336 Check for a label
               gosub get.token
               gosub check.for.label
            until u.token.string = "END"
               gosub proc.line.prefetched
            repeat
         end else                        ;* Conditional statement on same line
            gosub get.token
            gosub proc.statement.group
         end

         * Check that the top of the jump stack is a back end jump
         if jump.stack<1,1> # j.back.end then
            err.msg = sysmsg(2926) ;* Incorrectly formed ELSE clause
            gosub error
            goto exit.back.end
         end
      end else                          ;* No ELSE clause present
         * Check that the top of the jump stack is a back end jump
         if jump.stack<1,1> # j.back.end then
            err.msg = sysmsg(2925) ;* Incorrectly formed THEN clause
            gosub error
            goto exit.back.end
         end

         * Set "E" label at end of construct
         label.name = "_":jump.stack<1,2>:"E"
         gosub set.label
      end
   end else       ;* Statement does not take a THEN or ELSE clause
no.then.or.else.clause: 
      * Pop the status from the stack
      opcode.byte = OP.POP ; gosub emit.simple
   end

   * Set the exit label here for use by ON ERROR or LOCKED
   label.name = "_":jump.stack<1,2>:"X"
   gosub set.label

exit.back.end:
   del jump.stack<1>
   del onerror.stack<1>
   del testlock.stack<1>
   del thenelse.stack<1>

   return

*****************************************************************************
* EXPR  -  Process expression
*
* ------  +  ----------  (  ---  expr  ---  )  ---|
*   |---  -  ---|   |-------  var  -------------------  op  ---  expr  ---
*   |-----------|   |-------  const  -------------| |-------------------|
*

exprf:
   format.qualifier.allowed = @true
   goto expr.common:

expr:
   format.qualifier.allowed = @false
expr.common:
   gosub get.token

   if unary.minus then
      op.stack.depth += 1
      operator.stack(op.stack.depth) = OP.NEG
      priority.stack(op.stack.depth) = 1
      unary.minus = @false
   end

   op.stack.depth += 1
   priority.stack(op.stack.depth) = STACK.MARK

   loop
      gosub get.expr.item
      if err then return

      if format.qualifier.allowed then
         * Check for a format qualifier

         if look.ahead.token = TKN.NAME then
            find u.look.ahead.token.string in reserved.names setting n then ;* 0265
               goto not.format.qualifier
            end
         end else
            if look.ahead.token # TKN.NAME.LBR and look.ahead.token # TKN.STRING and look.ahead.token # TKN.LBR then
               goto not.format.qualifier
            end
         end

         * Insert a pseudo operator at this point

         token = TKN.FMT
         goto insert.pseudo.operator

not.format.qualifier:
      end

      * Check for other operators using look ahead

   until look.ahead.token < TKN.LOW.OPERATOR
   until look.ahead.token > TKN.HIGH.OPERATOR

      * Special case for colon operator.
      * Because the colon has special meaning in DISPLAY and INPUT, we need to
      * try to identify if this colon is an operator or a special use (or a
      * syntax error).  As a best guess, we check to see if what follows it
      * looks like a valid expression element.

      if look.ahead.token = TKN.COLON then
         i = token.index + 1
         j = tokens(i)

         begin case
            case j = TKN.NAME
               k = upcase(token.strings(i))
               find k in reserved.names setting n then exit ;* 0265
            case j = TKN.NAME.LBR
            case j = TKN.NUM
            case j = TKN.HEXNUM
            case j = TKN.STRING
            case j = TKN.FLOAT
            case j = TKN.AT.NAME
            case j = TKN.AT
            case j = TKN.LBR
            case j = TKN.PLUS               ;* Unary plus
            case j = TKN.MINUS              ;* Unary minus
            case j = TKN.LCBR
            case 1
               * Does not appear to be followed by an expression item.
               exit
         end case
      end

      gosub get.token              ;* Read operator token

insert.pseudo.operator:
      priority = op.priority(token)

      loop
      while priority >= priority.stack(op.stack.depth)
         opcode.byte = operator.stack(op.stack.depth)
         gosub emit.simple
         op.stack.depth -= 1
      repeat

      op.stack.depth += 1
      operator.stack(op.stack.depth) =  op(token) ;* Opcode
      if look.ahead.token = TKN.PWR then
         * The ** operator associates right to left. Save a slightly higher
         * priority on the stack to force this action.
         priority.stack(op.stack.depth) = priority + 1            ;* Priority
      end
      else priority.stack(op.stack.depth) = priority              ;* Priority

      gosub get.token              ;* Get next data item token
   repeat

   * Apply remaining operators from stack

   loop
   while priority.stack(op.stack.depth) # STACK.MARK
      opcode.byte = operator.stack(op.stack.depth)
      gosub emit.simple
      op.stack.depth -= 1
   repeat

   if op.stack.depth then op.stack.depth -= 1    ;* Remove STACK.MARK

   return

* ======================================================================
* Single item "expression".
* May use brackets around inner expression but otherwise is a single item

expr1:
   gosub get.token
   format.qualifier.allowed = @false
   gosub get.expr.item
   return

* ======================================================================

get.expr.item:
   ins format.qualifier.allowed before format.allowed.stack<1>
   unary.minus = @FALSE

get.expr.item.again:
   begin case
      case token = TKN.NAME
         if u.token.string = "IF" then
            gosub exprf          ;* Process condition

            * Add new entry to jump stack

            ins J.IF.EXPR:@vm:jump.no:@vm:'0' before jump.stack<1>
            label.name = "_":jump.no:"E"
            jump.no += 1
            opcode.byte = OP.JFALSE ; gosub emit.jump

            * Emit THEN clause

            if u.look.ahead.token.string # "THEN" then
               err.msg = sysmsg(2950) ;* THEN not found where expected in conditional expression
               gosub error
               goto if.then.else.expr.abort
            end
            gosub get.token

            gosub exprf          ;* Process THEN clause

            * Emit jump to exit label

            label.name = "_":jump.stack<1,2>:"X"
            opcode.byte = OP.JMP ; gosub emit.jump

            * Emit ELSE clause

            label.name = "_":jump.stack<1,2>:"E"
            gosub set.label

            if u.look.ahead.token.string # "ELSE" then
               err.msg = sysmsg(2951) ;* ELSE not found where expected in conditional expression
               gosub error
               goto if.then.else.expr.abort
            end
            gosub get.token

            gosub exprf          ;* Process ELSE clause

            * Emit exit label
            label.name = "_":jump.stack<1,2>:"X"
            gosub set.label

if.then.else.expr.abort:
            del jump.stack<1>
         end else
            gosub emit.var.reference

            loop
            while look.ahead.token = TKN.OBJREF
               gosub expr.item.is.objref ; if err then goto exit.get.expr.item
            repeat
         end

      case token = TKN.NAME.LBR
         gosub emit.var.reference

         loop
         while look.ahead.token = TKN.OBJREF
            gosub expr.item.is.objref ; if err then goto exit.get.expr.item
         repeat

      case token = TKN.NUM or token = TKN.FLOAT
         n = token.string + 0
         if unary.minus then
            n = -n
            unary.minus = @false
         end
         gosub emit.numeric.load

      case token = TKN.HEXNUM
         n = xtd(token.string)
         if unary.minus then
            n = -n
            unary.minus = @false
         end
         gosub emit.numeric.load

      case token = TKN.STRING
         opcode.string = token.string ; gosub emit.string.load

      case token = TKN.AT.NAME
         gosub get.token
         gosub emit.at.var.load

      case token = TKN.AT
         begin case
            case look.ahead.token = TKN.LBR  ;* @(n) function
               gosub get.token         ;* Skip left bracket
               gosub exprf      ;* Load first argument
               if look.ahead.token = TKN.COMMA then     ;* Two arguments
                  gosub get.token
                  if look.ahead.token = TKN.END then
                     err.msg = sysmsg(2952) ;* Argument missing in @ function"
                     gosub error
                     goto exit.get.expr.item
                  end
                  gosub exprf   ;* Load second argument
               end else               ;* Single argument - Set second as -1
                  n = -1 ; gosub emit.numeric.load
               end

               opcode.byte = OP.AT ; gosub emit.simple

               if look.ahead.token # TKN.RBR then goto err.rbr

               gosub get.token         ;* Skip close bracket

            case 1
               err.msg = sysmsg(2953) ;* Unrecognised @ function
               gosub error
               goto exit.get.expr.item
         end case

      case token = TKN.LBR
         * Call EXPR recursively to process the content of the brackets

         gosub exprf

         * Check that the next token is a close bracket

         gosub get.token
         if token # TKN.RBR then
            err.msg = sysmsg(2954) ;* Mismatched brackets
            gosub error
            goto exit.get.expr.item
         end

      case token = TKN.PLUS               ;* Unary plus
         gosub get.token
         goto get.expr.item.again

      case token = TKN.MINUS              ;* Unary minus
         unary.minus = not(unary.minus)
         gosub get.token
         goto get.expr.item.again

      case token = TKN.LCBR               ;* {name}
         if unassigned(dict.f) then
            err.msg = sysmsg(3406) ;* {name} requires use of $DICT compiler directive
            gosub error
            goto exit.get.expr.item
         end

         if look.ahead.token # TKN.NAME then
            gosub err.field.name
            goto exit.get.expr.item
         end

         gosub get.token
         read dict.rec from dict.f, token.string else
            token.string = upcase(token.string)
            read dict.rec from dict.f, token.string else
               gosub err.field.name
               goto exit.get.expr.item
            end
         end

         z = upcase(dict.rec[1,1])
         begin case
            case z = 'D' or ((z = 'A' or z = 'S') and dict.rec<8> = '')
               if not(dict.rec<2> matches '1N0N') then
                  err.msg = sysmsg(3286, token.string)  ;* %1 dictionary item has no field number
                  gosub error
                  goto exit.get.expr.item
               end

               if dict.rec<2> = 0 then
                  n = SYSCOM.QPROC.ID ; gosub emit.ldsys
               end else
                  n = SYSCOM.QPROC.RECORD ; gosub emit.ldsys
                  n = dict.rec<2> ; gosub emit.numeric.load
                  n = 0 ; gosub emit.numeric.load
                  n = 0 ; gosub emit.numeric.load
                  opcode.byte = OP.EXTRACT ; gosub emit.simple
               end

            case z = 'C' or z = 'I' or ((z = 'A' or z = 'S') and dict.rec<8> = '')
               * Unlike nested I-types, C-types that reference other
               * compiled items do this as a run time subroutine call
               * using ITYPE() to execute embedded object code.

               if len(dict.rec<DICT.ITYPE.OBJECT>) = 0 ~
               or checksum(replace(dict.rec, DICT.SYS.INFO, 1;'')) # dict.rec<DICT.SYS.INFO,1> then
                  * Need to compile nested item

                  if compiler.depth > 10 then
                     err.msg = sysmsg(2998) ;* Compiled dictionary items nested too deeply
                     gosub error
                     goto exit.get.expr.item
                  end

                  call $dcomp(dict.f,             ;* File var to source file
                              token.string,       ;* Record name
                              dict.rec,           ;* Record to compile
                              z,                  ;* I-type format
                              z,                  ;* I-type conversion
                              z,                  ;* I-type S/M flag
                              z,                  ;* I-type association
                              z,                  ;* I-type is constant
                              compiler.depth + 1) ;* Recursive compilation depth

                  if dict.rec<DICT.ITYPE.OBJECT> = '' then
                     err.msg = sysmsg(2612, token.string) ;* Compilation error in %1
                     gosub error
                     goto exit.get.expr.item
                  end

                  write dict.rec to dict.f, token.string
               end

               * Check to see if we have already loaded this object code.

               symbol.common.offset = -1           ;* Local variable
               symbol.name = "~" : token.string
               locate token.string in embedded.objects<1> setting i then
                  symbol.var.no = embedded.object.vars<i> ;* Variable number
               end else
                  symbol.dim = 0
                  symbol.mode = SYM.SET
                  gosub make.var

                  ins token.string before embedded.objects<i>
                  ins symbol.var.no before embedded.object.vars<i>
               end

               gosub emit.var.load
               opcode.byte = OP.ITYPE ; gosub emit.simple
               
            case 1
               goto err.field.name
         end case

         if look.ahead.token # TKN.RCBR then
            err.msg = sysmsg(2997) ;* Format error in {name} construct
            gosub error
            goto exit.get.expr.item
         end
         gosub get.token

      case 1
         err.msg = sysmsg(2955) ;* Data item or constant not found where expected
         gosub error
         goto exit.get.expr.item
   end case

   * Check for field / substring extractions in any order, possibly repeated

   loop
      begin case
         case look.ahead.token = TKN.LT    ;* Field extraction
            gosub is.field.ref
            if not(ifr.index) then exit

            gosub get.token   ;* Skip < token
            gosub emit.field.reference
            if err then goto exit.get.expr.item
            opcode.byte = OP.EXTRACT ; gosub emit.simple

         case look.ahead.token = TKN.LSQBR ;* Substring or group extraction
            gosub get.token     ;* Skip [ token
            gosub exprf          ;* Process first (or only) bound
            if look.ahead.token = TKN.COMMA then  ;* Two bounds present
               gosub get.token    ;* Skip comma
               gosub exprf         ;* Get substring length
               if look.ahead.token = TKN.COMMA then  ;* Three items, group extraction
                  gosub get.token  ;* Skip comma
                  gosub exprf      ;* Get field count
                  opcode.byte = OP.FIELD
                  gosub emit.simple
               end else
                  opcode.byte = OP.SUBSTR
                  gosub emit.simple
               end
            end else                            ;* Trailing substring extraction
               opcode.byte = OP.SUBSTRE
               gosub emit.simple
            end
            if look.ahead.token # TKN.RSQBR then goto err.rsqbr
            gosub get.token        ;* Skip bracket

         case 1
            exit
      end case
   repeat

   if unary.minus then
      opcode.byte = OP.NEG ; gosub emit.simple
      unary.minus = @false
   end

exit.get.expr.item:
   format.qualifier.allowed = format.allowed.stack<1>
   del format.allowed.stack<1>

   return

* ======================================================================

expr.item.is.objref:
   gosub get.token     ;* Skip -> operator
   gosub get.property.name ; if err then return
   opcode.byte = OP.OBJREF ; gosub emit.simple
   opcode.byte = 1         ; gosub emit        ;* 1 = Get property

   if look.ahead.token = TKN.LBR then  ;* Arguments present
      gosub get.token  ;* Skip left bracket

      ins 0 : @vm : 0 before func.stack<1>

      * Emit function arguments (if any)

      if look.ahead.token # TKN.RBR then
         loop
            if look.ahead.token = TKN.END then
               del func.stack<1>
               err.msg = sysmsg(2854) ;* Function argument not found where expected
               gosub error
               return
            end

            func.stack<1,2> += 1   ;* Accumulate argument count

            if upcase(look.ahead.token.string) = 'MAT' then
               gosub get.token  ;* Skip MAT

               if look.ahead.token # TKN.NAME then
                  del func.stack<1>
                  err.msg = sysmsg(2856) ;* Matrix name required
                  gosub error
                  return
               end

               gosub get.token
               symbol.name = token.string
               symbol.mode = SYM.ARG
               gosub find.var

               if (symbol.var.no < 0) or (symbol.dim = 0) then
                  del func.stack<1>
                  err.msg = sysmsg(2856) ;* Matrix name required
                  gosub error
                  return
               end

               gosub emit.var.load
            end else   ;* Not a matrix argument
               symbol.mode = SYM.ARG
               gosub exprf
               symbol.mode = SYM.USE  ;* 0347
               if err then
                  del func.stack<1>
                  return
               end
            end
         while look.ahead.token = TKN.COMMA
            gosub get.token
         repeat

         if look.ahead.token # TKN.RBR then
            del func.stack<1>
            gosub err.rbr
            return
         end
      end

      gosub get.token  ;* Skip bracket

      func.arg.count = func.stack<1,2>
      del func.stack<1>
   end else
      func.arg.count = 0
   end

   * Resolve property value
   opcode.byte = OP.GET ; gosub emit.simple
   opcode.byte = func.arg.count ; gosub emit

   return

*****************************************************************************
* IS.FIELD.REF  -  Establish the role of a < token
*
* On entry, the < token is in the look-ahead.  Examine subsequent tokens
* to establish whether this is a field reference or not.

* It is a field reference if
*    we find a matching > taking into account pairing of other < tokens
*    and round brackets found on the way
* unless
*    the > token is followed by
*      a name except for reserved tokens (THEN, ELSE, SETTING, BY, GO, GOTO,
*      GOSUB, BEFORE)
*      a name.lbr
*      a number
*      a string
*    or the enclosed expression includes the THEN, AND or OR keywords
*
* If it is a field reference, the > token is replaced by TKN.END.FIELD and
* its position is returned in IFR.INDEX. Otherwise, IFR.INDEX is set to zero.
*
is.field.ref:
   ifr.first = token.index + 1  ;* Point after < token
   i = 0                        ;* Current bracket depth
   j = 1                        ;* Current field depth
   ifr.index = 0

   n = ifr.first
   loop
      k = tokens(n)

      begin case
      case k = TKN.END            ;* End of source line
         goto exit.is.field.ref

      case k = TKN.LT
         if i = 0 then j += 1

      case k = TKN.GT
         if i = 0 then j -= 1

      case k = TKN.GE or k = TKN.NEX
         if i = 0 then j -= 1

      case k = TKN.LBR
         i += 1

      case k = TKN.RBR
         i -= 1
         if i < 0 then goto exit.is.field.ref

      case k = TKN.AND
         if i = 0 then goto exit.is.field.ref   ;* 0342

      case k = TKN.OR
         if i = 0 then goto exit.is.field.ref   ;* 0342

      case upcase(token.strings(n)) = 'THEN'    ;* 0143
        if i = 0 then goto exit.is.field.ref    ;* 0342

      end case

   until (i = 0) and (j = 0)

      n += 1
   repeat
   
   * We have found a matching > token. Now look to see what follows it.

   begin case
      case k = TKN.GE
      case k = TKN.NEX
      case 1                   ; k = tokens(n + 1)
   end case

   i = n - ifr.first   ;* Number of tokens between < and >
   if i # 1 then
      begin case
         case k = TKN.NAME
            if not(format.qualifier.allowed) then
               find upcase(token.strings(n + 1)) in reserved.names setting z ;* 0265
               else goto exit.is.field.ref
            end

         case k = TKN.NAME.LBR
            if not(format.qualifier.allowed) then goto exit.is.field.ref

         case k = TKN.NUM
            goto exit.is.field.ref

         case k = TKN.HEXNUM
            goto exit.is.field.ref

         case k = TKN.FLOAT
            goto exit.is.field.ref

         case k = TKN.STRING
            if not(format.qualifier.allowed) then goto exit.is.field.ref
      end case
   end

   ifr.index = n

   begin case
      case tokens(n) = TKN.GE
         if num.tokens >= max.tokens then  ;* Must expand tables
            gosub expand.token.tables   ;* 0337
         end
         for k = num.tokens to n step -1     ;* 0129
            tokens(k+1) = tokens(k)
            token.strings(k+1) = token.strings(k)
         next k
         tokens(n+1) = TKN.EQ
         token.strings(n+1) = '='
         num.tokens += 1

      case tokens(n) = TKN.NEX           ;* ><
         if token.strings(n+1) = '=' then   ;* 0113: a<b><=c  ->  a<b> <= c
            tokens(n+1) = TKN.LE
            token.strings(n+1) = '<='
         end else                           ;* a<b><c (etc)
            if num.tokens >= max.tokens then  ;* Must expand tables
               gosub expand.token.tables   ;* 0337
            end
            for k = num.tokens to n step -1    ;* -129
               tokens(k+1) = tokens(k)
               token.strings(k+1) = token.strings(k)
            next k
            tokens(n+1) = TKN.LT
            token.strings(n+1) = '<'
            num.tokens += 1
         end
   end case

   tokens(n) = TKN.END.FIELD

exit.is.field.ref:
   return

*****************************************************************************
* EMIT.FIELD.REFERENCE  -  Process <f,v,s> construct
* On entry, we are positioned after the < token
* On exit, we will be positioned after the > token

emit.field.reference:
   gosub exprf     ;* Get field position

   * Get value position
   if look.ahead.token = TKN.COMMA then
      gosub get.token
      gosub exprf
   end else
      * Emit a zero value position reference
      n = 0
     gosub emit.numeric.load
   end

   * Get subvalue position
   if look.ahead.token = TKN.COMMA then
      gosub get.token
      gosub exprf
   end else
      * Emit a zero subvalue position reference
      n = 0
      gosub emit.numeric.load
   end

   if look.ahead.token # TKN.END.FIELD then goto err.field
   gosub get.token        ;* Skip > token

   return

*****************************************************************************
* GET.ARGS  -  Emit multiple comma separated expressions
* ARG.COUNT holds required number of expressions

get.args:
   ins arg.count before arg.count.stack<1>

   loop
      gosub exprf
      arg.count = arg.count.stack<1> - 1
   while arg.count
      arg.count.stack<1> = arg.count
      gosub check.comma
   repeat

   del arg.count.stack<1>

   return

*****************************************************************************
* EMIT.PRINT.LIST  -  Emit a list of print items and opcode to print it
*
* PRINT.OPCODE contains either OP.DSP or OP.PRNT.  The related "with newline"
* opcode can be found by adding one to this opcode value.

emit.print.list:
   n = 0
   if look.ahead.token = TKN.NAME then  ;* 0319
      find u.look.ahead.token.string in reserved.names setting n else null ;*0303
   end

   if look.ahead.token = TKN.END or look.ahead.token = TKN.SEMICOLON or n then
      opcode.string = '' ; gosub emit.string.load
      opcode.byte = print.opcode + 1 ; gosub emit.simple
   end else
      gosub exprf               ;* Emit first expression

      loop
      until look.ahead.token = TKN.END or look.ahead.token = TKN.SEMICOLON
      while look.ahead.token = TKN.COMMA

         gosub get.token

         * Emit code to append a tab to the string
         opcode.string = char(9) ; gosub emit.string.load
         opcode.byte = OP.CAT ; gosub emit.simple
         gosub exprf
         opcode.byte = OP.CAT ; gosub emit.simple
      repeat

      if look.ahead.token = TKN.COLON then
         gosub get.token
      end else
         print.opcode = print.opcode + 1
      end

      opcode.byte = print.opcode ; gosub emit.simple
   end

   return

*****************************************************************************
* EMIT.CSV.LIST  -  Emit items for PRINTCSV and WRITECSV
*
emit.csv.list:
   first.csv.item = @true
   loop
      if look.ahead.token = TKN.NAME then
         find u.look.ahead.token.string in reserved.names setting n then exit
      end

      if not(first.csv.item) then
         opcode.string = ',' ; gosub emit.string.load
         opcode.byte = OP.CAT ; gosub emit.simple
      end

      gosub expr ; if err then return
      opcode.byte = OP.FORMCSV ; gosub emit.simple

      if not(first.csv.item) then
         opcode.byte = OP.CAT ; gosub emit.simple
      end
      first.csv.item = @false

   until look.ahead.token # TKN.COMMA
      gosub get.token
   repeat

   return

**********************************************************************

generate.debug:
   if level = 1 then
      n = line.no(1)
      if n = last.debug.line then debug.sub.ref += 1
      else
         last.debug.line = n
         debug.sub.ref = 0
      end

      if print.code then
         * Show the code to be generated
         s = "DEBUG    " : n : "." : debug.sub.ref
         gosub show.code
      end

      * Emit the debug opcode
      opcode.byte = OP.DEBUG       ; gosub emit
      opcode.byte = shift(n, 8)    ; gosub emit
      opcode.byte = bitand(n, 255) ; gosub emit
      opcode.byte = debug.sub.ref  ; gosub emit
   end
   return

**********************************************************************
* Emit skeleton object header

emit.skeleton.header:
   opcode.byte = 0
   z = if is.ctype then itype.object.header.size else object.header.size
   loop
   until pc = z
      gosub emit
   repeat

   if debug then gosub emit.debug.header

   start.pc = pc

   return

* ======================================================================
* Emit debugger header immediately after fixed header

emit.debug.header:
   s = fileinfo(src.f, fl$path) : @ds : record.name : char(0)
   n = len(s)
   code.image[pc+1, n] = s
   pc += n
   start.pc = pc
   return

*****************************************************************************
* EMIT.FINAL.HEADER  -  Update object header at end of compilation

emit.final.header:
   * Magic number. Offset 0, 1 byte
   i = if system(1009) then HDR.MAGIC.NO.B else HDR.MAGIC.NO.L
   code.image[HDR.MAGIC,1] = char(i)

   * Object revision. 1 byte
   code.image[HDR.REV,1] = char(HDR.REVISION)

   * Start PC. 4 bytes
   code.image[HDR.START.OFFSET,4] = iconv(start.pc, 'IL')

   * Argument count. 2 bytes
   code.image[HDR.ARGS,2] = iconv(subr.arg.count, 'IS')

   * Local variable count. 2 bytes
   code.image[HDR.NO.VARS,2] = iconv(var.count, 'IS')

   * Stack depth. 2 bytes
   i = 100 + greatest.call.arg.count
   code.image[HDR.STACK.DEPTH,2] = iconv(i, 'IS')

   * Symbol table offset. 4 bytes
   code.image[HDR.SYM.TAB.OFFSET,4] = iconv(symbol.table.offset, 'IL')

   * Line table offset. 4 bytes
   code.image[HDR.LIN.TAB.OFFSET,4] = iconv(line.table.offset, 'IL')

   * Object size. 4 bytes
   code.image[HDR.OBJECT.SIZE,4] = iconv(pc, 'IL')

   * Flags. 2 bytes
   code.image[HDR.FLAGS,2] = iconv(header.flags, 'IS')

   * Compile time. 2 bytes
   code.image[HDR.COMPILE.TIME,4] = iconv(system(1005), 'IL')

   if not(is.ctype) then
      * Program name
      code.image[HDR.PROGRAM.NAME, len(program.name)] = program.name
   end

   return

* ======================================================================
check.comma:
   if look.ahead.token # TKN.COMMA then goto err.comma
   gosub get.token
   return

*****************************************************************************
* Error routines

err.at.lvar:
   err.msg = sysmsg(2968) ;* Illegal use of @ variable as lvalue
   goto error

err.at.var:
   err.msg = sysmsg(2967) ;* Unrecognised @ variable
   goto error

err.class:
   err.msg = sysmsg(3443) ;* Statement is only allowed in a CLASS module
   goto error

err.comma:
   err.msg = sysmsg(2959) ;* Comma not found where expected
   goto error

err.ctype:
   err.msg = sysmsg(2994) ;* Statement/function not allowed in a C-type record
   goto error

err.field:
   err.msg = sysmsg(2961) ;* Incorrectly formed field reference
   goto error

err.field.name:
   err.msg = sysmsg(2996) ;* Field name required in {name} construct
   goto error

err.file:
   err.msg = sysmsg(3414) ;* FILE statement must appear before any use of associated variables
   goto error

err.from:
   err.msg = sysmsg(2965) ;* FROM not found where expected
   goto error

err.fvar:
   err.msg = sysmsg(2958) ;* File variable name not found where expected
   goto error

err.in:
   err.msg = sysmsg(2966) ;* IN not found where expected
   goto error

err.lbr:
   err.msg = sysmsg(2962) ;* Left bracket not found where expected
   goto error

err.name:
   err.msg = sysmsg(2850) ;* Name not found where expected
   goto error

err.name.set:
   err.msg = sysmsg(2969) ;* A PROGRAM, SUBROUTINE, FUNCTION or CLASS statement has already been processed
   goto error

err.recursive:
   err.msg = sysmsg(2993) ;* Statement/function not allowed in a recursive program
   goto error

err.rbr:
   err.msg = sysmsg(2963) ;* Right bracket not found where expected
   goto error

err.rsqbr:
   err.msg = sysmsg(2964) ;* Right square bracket not found where expected
   goto error

err.semicolon:
   err.msg = sysmsg(2960) ;* Semicolon not found where expected
   goto error

err.syntax:
   err.msg = sysmsg(2956) ;* Syntax error
   goto error

err.to:
   err.msg = sysmsg(2917) ;* TO not found where expected
   goto error

err.to.on:
   err.msg = sysmsg(2945) ;* TO or ON not found where expected
   goto error

err.var:
   err.msg = sysmsg(2957) ;* Variable name not found where expected
   goto error

*****************************************************************************
* START.LISTING  -  Activate program listing record

start.listing:
   if not(listing.used) then
      if not(is.ctype) then
         openseq output.file.name, listing.record.name to list.f else
            if status() then
               stop sysmsg(2971, status()) ;* "Error xx creating listing record
            end
         end
      end
      listing.used = @true
      list.pg = ''
   end
   return

* ======================================================================

emit.listing:
   if is.ctype then
      display list.rec
   end else
      writeseq list.pg:list.rec to list.f else null
      list.pg = ''
   end
   return


* ======================================================================
* Reassess kernel modes after $MODE or equivalent

set.kernel.modes:
   * Case sensitivity of names
   i = bittest(mode, M.CASE.SENSITIVE)
   if i then header.flags = bitor(header.flags, hdr.case.sensitive)
   j = kernel(k$case.sensitive, i)

   return

* ======================================================================
* Expand token tables for complex source line

expand.token.tables:
   max.tokens += 100
   ntok = idiv(max.tokens, 2)
   dim operator.stack(ntok)
   dim priority.stack(ntok)
   dim tokens(max.tokens)
   dim token.strings(max.tokens)
   for ntok = num.tokens + 1 to max.tokens
      tokens(ntok) = ''
      token.strings(ntok) = ''
   next ntok

   return

* ======================================================================
* GET.FILE.REF  -  Process reference to name defined using FILE
*
* In:  pos = index into file.refs and associated tables
*      vpos = position at which to insert in field lists
* Out: fno = field number (also inserted into lists)

get.file.ref:
   err = @false

   read dict.rec from file.d(pos), token.string else
      read dict.rec from file.d(pos), upcase(token.string) else
         err.msg = sysmsg(3415, token.string)  ;* Field name %1 is not in the dictionary
         goto error
      end
      token = upcase(token.string)
   end

   s = upcase(dict.rec[1,1])
   begin case
      case s = 'D'
         fno = dict.rec<2>

      case s = 'A' or s = 'S'
         if dict.rec<DICT.A.CORRELATIVE> # '' then
            err.msg = sysmsg(3417, token.string) ;* %1 has a correlative expression
            goto error
         end
         fno = dict.rec<2>

      case 1
         err.msg = sysmsg(3416, token.string) ;* %1 is not a D, A or S-type dictionary item
         goto error
   end case

   if not(fno matches '1N0N') then
      err.msg = sysmsg(3418, token.string) ;* Dictionary item %1 has a non-numeric field position
      goto error
   end

   if fno = 0 then
      err.msg = sysmsg(3419, token.string) ;* Dictionary item %1 is a record id reference
      goto error
   end

   ins token.string before file.fields<pos,vpos>
   ins fno before file.fld.nums<pos,vpos>

   return

* ======================================================================

convert.pick.file.reference:
   locate u.look.ahead.token.string in file.refs<1> setting pos then
      look.ahead.token.string = '__':look.ahead.token.string
   end
   return

* ======================================================================

process.int.sub.args:
   err = @false
   call.arg.count = 0

   gosub get.token   ;* Skip left bracket

   loop
   while look.ahead.token # TKN.RBR

      if u.look.ahead.token.string = "MAT" then
         gosub get.token
         if look.ahead.token # TKN.NAME then
            err.msg = sysmsg(2856) ;* Matrix name required
            goto error
         end

         gosub get.token
         symbol.name = token.string
         symbol.mode = SYM.ARG
         gosub find.var

         if (symbol.var.no < 0) or (symbol.dim = 0) then
            err.msg = sysmsg(2856) ;* Matrix name required
            goto error
         end

         gosub emit.var.load
         int.sub.call.args := 'M'
      end else
         deref = (look.ahead.token = TKN.LBR)
         symbol.mode = SYM.ARG
         gosub exprf
         symbol.mode = SYM.USE
         if err then return
         if deref then
            opcode.byte = OP.VALUE
            gosub emit.simple
         end
         int.sub.call.args := 'S'
      end

      call.arg.count += 1

   while look.ahead.token = TKN.COMMA
      gosub get.token
   repeat

   if call.arg.count > 255 then
      err.msg = sysmsg(2884) ;* Too many arguments in CALL
      goto error
   end

   if look.ahead.token # TKN.RBR then goto err.rbr

   gosub get.token     ;* Skip close bracket

   if call.arg.count > greatest.call.arg.count then
      greatest.call.arg.count = call.arg.count
   end

   return

* ======================================================================
* Get a property name for an object reference

get.property.name:
   gosub get.token
   begin case
      case token = TKN.LBR    ;* Property name expression
         gosub expr       ;* Emit property name
         if look.ahead.token # TKN.RBR then goto err.rbr
         gosub get.token      
      case 1        
         opcode.string = u.token.string ; gosub emit.string.load
   end case

   return

* ====================================================================
* Process arguments to PUBLIC function/subroutine, SET and GET
*
* Returns
*   object.arg.names = FM delimited argument name list
*   obj.arg.count    = Arg count, possible with VAR.ARGS flag set

process.object.arg.list:
   object.arg.names = ''
   gosub get.token
   if look.ahead.token # TKN.RBR then ;* Not a null argument list
      loop
         gosub get.token
         if token = TKN.LABEL and token.string = '...' then
            * Special syntax for max length unnamed argument list
            * Add dummy arguments for the missing items
            for obj.arg.count = dcount(object.arg.names,@fm) + 1 to objargs
               object.arg.names<-1> = '*Arg':fmt(obj.arg.count,'R%3')
            next obj.arg.count
            obj.arg.count = bitor(obj.arg.count, 0x80)
            if look.ahead.token # TKN.RBR then goto err.rbr
            gosub get.token
            return
         end

         if token = TKN.LBR then  ;* Dereference argument
            deref = @true
            gosub get.token
         end else deref = @false

         if token # TKN.NAME then goto err.name

         locate u.token.string in object.arg.names<1> setting pos then
            err.msg = sysmsg(3456) ;* Duplicate argument name
            goto error
         end

         object.arg.names<-1> = u.token.string

         if deref then
            symbol.name = '*Arg':fmt(dcount(object.arg.names, @fm), 'R%3')

            symbol.mode = SYM.CHK
            gosub find.var
            gosub emit.var.load
            opcode.byte = OP.DEREF ; gosub emit.simple
         end

         if deref then
            if look.ahead.token # TKN.RBR then goto err.rbr
            gosub get.token
         end
      while look.ahead.token = TKN.COMMA
         gosub get.token
      repeat

      if dcount(object.arg.names, @fm) > objargs then
         err.msg = sysmsg(3444) ;* Too many arguments in public function/subroutine
         goto error
      end

      if look.ahead.token # TKN.RBR then goto err.rbr
   end

   gosub get.token

   obj.arg.count = dcount(object.arg.names, @fm)
   if u.look.ahead.token.string = 'VAR.ARGS' then
      obj.arg.count = bitor(obj.arg.count, 0x80)
      gosub get.token
   end

   return

* ======================================================================
* Process function/subroutine dimensioned argument

get.arg.mat.dimensions:
   gosub get.token  ;* Skip bracket
   gosub get.token  ;* Get first dimension
   if token # TKN.NUM then
      err.msg = sysmsg(2900) ;* Matrix dimensions required
      goto error
   end

   if look.ahead.token = TKN.COMMA then
      gosub get.token  ;* Skip comma
      gosub get.token  ;* Get second dimension
      if token # TKN.NUM then
         err.msg = sysmsg(2900) ;* Matrix dimensions required
         goto error
      end
      dim.dimensions = 2
   end else
      dim.dimensions = 1
   end
 
   if look.ahead.token # TKN.RBR then goto err.rbr

   gosub get.token

   return

*****************************************************************************
* Emit inheritance code for inherited objects

emit.inheritance:
   setrem 0 on inherited.classes
   loop
      inherited.class = remove(inherited.classes, more.inheritance)
      token.string = inherited.class ; gosub emit.lvar.reference
      opcode.string = inherited.class ; gosub emit.string.load
      opcode.byte = OP.OBJECT ; gosub emit.simple
      opcode.byte = 0 ; gosub emit.simple
      opcode.byte = OP.STOR ; gosub emit.simple
      token.string = inherited.class ; gosub emit.var.reference
      opcode.byte = OP.INHERIT ; gosub emit.simple
   while more.inheritance
   repeat

   return

*****************************************************************************
* ERROR  -  Report error

local sub error:
   private i, s

   del reserved.names<2>   ;* 0265 Ensure no "local" reserved names left active

   format.allowed.stack = ''

   if star.printed then
      display
      star.printed = @false
   end

   * An attempt to tidy this up by not displaying line numbers for errors
   * detected at the end of the source failed. It prevented SED's BASIC
   * command recognising errors and cutting them into the source.

   s = line.no(1)
   for i = 2 to level
      s := "." : line.no(i)
   next i
   err.msg = s : ': ' : err.msg

   display err.msg
   if listing(level) or print.code then
      list.rec = err.msg
      gosub emit.listing
   end

   errors += 1
   err = @true

   lock.opcode = 0            ;* Clear any unprocessed lock opcode
   op.stack.depth = 0         ;* Clear all stacked expression operators
   unary.minus = @false

   loop
   while look.ahead.token
      gosub get.token
   repeat

   return
end

* ======================================================================

local sub warning:
   private i, s

   if warnings.as.errors then errors += 1

   if star.printed then
      display
      star.printed = @false
   end

   if end.source then
      s = ''
   end else
      s = line.no(1)
      for i = 2 to level
         s := "." : line.no(i)
      next i
      s := ': '
   end
   err.msg = s : sysmsg(2970) : ': ' :err.msg

   display err.msg
   if listing(level) or print.code then
      list.rec = err.msg
      gosub emit.listing
   end

   return
end
end

* END-CODE
