lex.spt

-TITLE LEX: PHASE 1 TRANSLATION FROM MINIMAL TO LEXEMES (LEXEMES)
-STITL Initialization
* Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer.
* Copyright 2012 David Shields
* 
* This file is part of Macro SPITBOL.
* 
*     Macro SPITBOL 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 of the License, or
*     (at your option) any later version.
* 
*     Macro SPITBOL 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 Macro SPITBOL.  If not, see <http://www.gnu.org/licenses/>.
*
*
*	Usage:
*
*	SPITBOL -u "infile<sep>condfile<sep>outfile" lex
*
*	where:
*	 infile    - Minimal file name, less .min extension
*	 condfiile - Conditional file name, less .cnd extension
*	 outfile   - Output file name, less .lex extension.
*		     Default is infile.lex.
*	 <sep>	   - ; or :
*
*	note: <sep>outfile component is optional.
*
*  This program takes MINIMAL statements and parses them up into
*  a stream of lexemes, or lexemes. It performs EQU * substitution and
*  conditional assembly.
*
*  It is based on earlier translators written by David Shields, Steve Duff 
*  and Robert Goldberg.
*
*
-EJECT
*  Keyword initialization

        &ANCHOR = 1
*	&STLIMIT = -1
	&TRIM   = 1
	&ANCHOR = 1
	&ANCHOR  = 1
*  Useful constants

	MINLETS = 'ABCDEFGHIJKLMNOPQRSTUVWXY_'
	NOS     = '0123456789'
	P.NOS	= SPAN(NOS) RPOS(0)
	P.EXP	= 'E' ANY('+-') SPAN(NOS)
	P.REAL	= SPAN(NOS) '.' (SPAN(NOS) | NULL) (P.EXP | NULL) RPOS(0)
	TAB	= CHAR(9)

*  LOWER converts to upper case
	DEFINE('LOWER(S)')

*  ARGFORM classifies arguments
	DEFINE('ARGFORM(ARG)')

*  ARGTYPE checks argument types
	DEFINE('ARGTYPE(OP,TYP)')

*  CRACK parses STMT into a STMT data plex and returns it.
*  STMT is the common data plex used to hold the components of
*  a Minimal statement during processing.
*  It fails if there is a syntax error.
*
	DEFINE('CRACK(LINE)OPERANDS,OPERAND,CHAR')

*
*  Error is used to report an error for current statement
*
	DEFINE('ERROR(TEXT)')

*  REPORT writes summary message at end of translation
	
	DEFINE('REPORT(NUM,TEXT)')

*  LABENTER enters non-null LABEL in LABTAB
	DEFINE('LABENTER()TLAB')

*  OUTSTMT is used to send a target statement to the target code
*  output file (OUTFILE <=> LU2)
*
	DEFINE('OUTSTMT(LABEL,OPCODE,OP1,OP2,OP3,COMMENT)T,STMTOUT')

*  RDLINE is called to return the next non-comment line from
*  the Minimal input file (INFILE <=> LU1).   Note that it will
*  not fail on EOF, but it will return a Minimal END statement
*
	DEFINE('RDLINE()')
* 	Conditional assembly initialization

	DEFINE('TBLINI(STR)POS,CNT,INDEX,VAL,LASTVAL')
*  CATAB is the transfer vector for routing control to generators
*  for conditional assembly directives.
*
       CATAB = TABLE( 11,,.BADOP )
       CATAB['.DEF']   = .DEFOP; CATAB['.UNDEF'] = .UNDEFOP
       CATAB['.IF']    = .IFOP; CATAB['.THEN']  = .THENOP
       CATAB['.ELSE']  = .ELSEOP; CATAB['.FI']    = .FIOP

*  SYMTBL tracks defined conditional symbols.  (undefined symbols
*  are assigned null values in SYMTBL.)
*
       SYMTBL      = TABLE( 11 )
*
*  STATESTK maintains all state information while processing conditional
*  statements.  LEVEL indexes the top entry.  Another variable, TOP,
*  has a copy of SAVESTK[LEVEL].
*
       STATESTK    = ARRAY( 30 )
       LEVEL       = 0
       TOP         =
*
*  Each state entry in STATESTK contains state information about
*  the processing for each active .IF.  The state is maintained
*  as 2 fields:
*
*      RESULT    the result of the .IF expression evaluation-
*                TRUE, FALSE, OR BYPASS
*
*      MODE      Whether processing THEN or ELSE portion of .IF
*
       DATA( 'STATE(RESULT,MODE)' )
       FALSE    = 0
       TRUE     = 1
       BYPASS   = 2
       ELSE     = 0
       THEN     = 1
*
*  PROCESSREC is indexed by the current result and mode to determine
*  whether or not a statement should be processed and written to the
*  output file.
*
       PROCESSREC    = ARRAY( FALSE ':' BYPASS ',' ELSE ':' THEN,0 )
       PROCESSREC[TRUE,THEN]  = 1
       PROCESSREC[FALSE,ELSE] = 1
*
*  P.CONDASM breaks up conditional assembly directives.
*
       SEP      = ' '
       P.CONDASM      = ( BREAK(SEP) | REM ) . CONDCMD
.	          ( SPAN(SEP) | '' )
.	          ( BREAK(SEP) | REM ) . CONDVAR
*
*
	P.ARGSKEL1 = FENCE(BREAK(',') | REM) $ ARGTHIS *DIFFER(ARGTHIS)
	P.ARGSKEL2 = LEN(1) FENCE(BREAK(',') | REM) $ ARGTHIS *DIFFER(ARGTHIS)

*  ITYPTAB is table mapping from common operands to gross type

	ITYPTAB = TABLE(21)
	ITYPTAB['0'] = 1; ITYPTAB['1'] = 1; ITYPTAB['WA'] = 8
	ITYPTAB['WB'] = 8; ITYPTAB['WC'] = 8; ITYPTAB['XL'] = 7
	ITYPTAB['XR'] = 7; ITYPTAB['XS'] = 7; ITYPTAB['XT'] = 7
	ITYPTAB['(XL)'] = 9; ITYPTAB['(XR)'] = 9; ITYPTAB['(XS)'] = 9
	ITYPTAB['(XT)'] = 9; ITYPTAB['-(XL)'] = 11; ITYPTAB['-(XR)'] = 11
	ITYPTAB['-(XS)'] = 11; ITYPTAB['-(XT)'] = 11;
	ITYPTAB['(XL)+'] = 10;	ITYPTAB['(XR)+'] = 10;
	ITYPTAB['(XS)+'] = 10; ITYPTAB['(XT)+'] = 10

*  OPFORMTAB is table mapping general op formats to row index for
*  VALIDFORM array.
	OPFORMTAB = TBLINI(
+	'VAL[1]REG[2]OPC[3]OPS[4]OPW[5]OPN[6]OPV[7]ADDR[8]'
+	'X[9]W[10]PLBL[11](X)[12]INTEGER[13]REAL[14]'
+	'DTEXT[15]EQOP[16]INT[17]PNAM[18]')

*  VALIDFORM is ARRAY that validates general op formats (OPV, etc).
*  The first index is named type VAL=1 REG=2 OPC=3 OPS=4 OPW=5
*  OPN=6 OPV=7 ADDR=8 X=9 W=10 PLBL=11 (X)=12 INTEGER=13 REAL=14
*  DTEXT=15 EQOP=16 INT=17 PNAM=18
*  The second argument is gross type 01=INT 02=DLBL ... 27=DTEXT
*  The entry [i,j] is nonzero is gross type j is valid for named
*  type i.
   VALIDFORM = ARRAY('18,27',0)
   VALIDFORM[1,1] = 1
   VALIDFORM[1,2] = 1
   VALIDFORM[2,7] = 1
   VALIDFORM[2,8] = 1
   VALIDFORM[3,9] = 1
   VALIDFORM[3,10] = 1
   VALIDFORM[3,11] = 1
   VALIDFORM[4,3] = 1
   VALIDFORM[4,4] = 1
   VALIDFORM[4,9] = 1
   VALIDFORM[4,12] = 1
   VALIDFORM[4,13] = 1
   VALIDFORM[4,14] = 1
   VALIDFORM[4,15] = 1
   VALIDFORM[5,3] = 1
   VALIDFORM[5,4] = 1
   VALIDFORM[5,8] = 1
   VALIDFORM[5,9] = 1
   VALIDFORM[5,10] = 1
   VALIDFORM[5,11] = 1
   VALIDFORM[5,12] = 1
   VALIDFORM[5,13] = 1
   VALIDFORM[5,14] = 1
   VALIDFORM[5,15] = 1
   VALIDFORM[6,3] = 1
   VALIDFORM[6,4] = 1
   VALIDFORM[6,7] = 1
   VALIDFORM[6,8] = 1
   VALIDFORM[6,9] = 1
   VALIDFORM[6,10] = 1
   VALIDFORM[6,11] = 1
   VALIDFORM[6,12] = 1
   VALIDFORM[6,13] = 1
   VALIDFORM[6,14] = 1
   VALIDFORM[6,15] = 1
   VALIDFORM[7,3] = 1
   VALIDFORM[7,4] = 1
   VALIDFORM[7,7] = 1
   VALIDFORM[7,8] = 1
   VALIDFORM[7,9] = 1
   VALIDFORM[7,10] = 1
   VALIDFORM[7,11] = 1
   VALIDFORM[7,12] = 1
   VALIDFORM[7,13] = 1
   VALIDFORM[7,14] = 1
   VALIDFORM[7,15] = 1
   VALIDFORM[7,18] = 1
   VALIDFORM[7,19] = 1
   VALIDFORM[7,20] = 1
   VALIDFORM[7,21] = 1
   VALIDFORM[7,22] = 1
   VALIDFORM[8,1] = 1
   VALIDFORM[8,2] = 1
   VALIDFORM[8,3] = 1
   VALIDFORM[8,4] = 1
   VALIDFORM[8,5] = 1
   VALIDFORM[8,6] = 1
   VALIDFORM[9,7] = 1
   VALIDFORM[10,8] = 1
   VALIDFORM[11,6] = 1
   VALIDFORM[12,9] = 1
   VALIDFORM[13,16] = 1
   VALIDFORM[14,17] = 1
   VALIDFORM[15,27] = 1
   VALIDFORM[16,24] = 1
   VALIDFORM[17,1] = 1
   VALIDFORM[18,6] = 1
   VALIDFORM[18,23] = 1
*
*  Zero the counts
*
	LABCNT = NOUTLINES = NLINES = NSTMTS = NTARGET = NERRORS = 0
*
*  P.MINLABEL is a pattern matching a valid Minimal Source Label.
*
	P.MINLABEL = ANY(MINLETS) ANY(MINLETS) ANY(MINLETS NOS)
.	           ANY(MINLETS NOS) ANY(MINLETS NOS)
*
*  P.CSPARSE parses out the components of the input line in STMT,
*  and puts them into the locals: LABEL, OPCODE, OPERANDS, COMMENT
*
	P.CSPARSE = (((P.MINLABEL . LABEL) | ('     '  '' . LABEL)) '  '
.	  LEN(3) . OPCODE
.	  (('  ' (BREAK(' ') | RTAB(0)) . OPERANDS
.	      (SPAN(' ') | '') RTAB(0) . COMMENT)  |
.	      (RPOS(0) . OPERANDS . COMMENT)))  |
.	     ('.'  '' . LABEL  MINCOND . OPCODE
.	       ((TAB(7)  '.'  LEN(4) . OPERANDS) | (RPOS(0) . OPERANDS))
.	           '' . COMMENT)
*
*  P.CSOPERAND breaks out the next operand in the OPERANDS string.
*
	P.CSOPERAND = (BREAK(',') . OPERAND  ',')  |
.			((LEN(1) RTAB(0)) . OPERAND)
*
*  P.CSDTC is a pattern that handles the special case of the
*  MINIMAL DTC op
*
	P.CSDTC   = ((P.MINLABEL . LABEL)  |  ('     '  '' . LABEL))
.	          LEN(7) (LEN(1) $ CHAR  BREAK(*CHAR)  LEN(1)) . OPERAND
.	          (SPAN(' ') | '')  RTAB(0) . COMMENT
*
*  P.equ.rip is a pattern that parses out the components of an EQU
*  expression.
*
	P.EQU.RIP  = ( SPAN(NOS) . NUM1 | P.MINLABEL . SYM1 )
.		   ( ANY('+-') . OPRTR | '' )
.		   ( SPAN(NOS) . NUM2 | P.MINLABEL . SYM2 | '' )
.		   RPOS(0)

*  OPTAB is a table that maps opcodes into their argument
*  types and is used for argument checking and processing.
	OPTAB = TBLINI(
. 'FLC[W]'
. 'ADD[OPV,OPN]ADI[OPS]ADR[OPS]ANB[OPW,W]AOV[OPV,OPN,PLBL]ATN[NONE]'
. 'BOD[OPN,PLBL]BEV[OPN,PLBL]'
. 'BCT[W,PLBL]BEQ[OPN,OPV,PLBL]BGE[OPN,OPV,PLBL]BGT[OPN,OPV,PLBL]'
. 'BHI[OPN,OPV,PLBL]BLE[OPN,OPV,PLBL]BLO[OPN,OPV,PLBL]'
. 'BLT[OPN,OPV,PLBL]BNE[OPN,OPV,PLBL]BNZ[OPN,PLBL]BRN[PLBL]'
. 'BRI[OPN]BSW[X,VAL,*PLBL BSW]BTW[REG]'
. 'BZE[OPN,PLBL]CEQ[OPS,OPS,PLBL]'
. 'CHK[NONE]CHP[NONE]CMB[W]CMC[PLBL,PLBL]CNE[OPS,OPS,PLBL]COS[NONE]CSC[X]CTB[W,VAL]'
. 'CTW[W,VAL]CVD[NONE]CVM[PLBL]DAC[ADDR]DBC[VAL]DCA[OPN]DCV[OPN]'
. 'DEF[DEF]DIC[INTEGER]DRC[REAL]DTC[DTEXT]DVI[OPS]DVR[OPS]EJC[NONE]'
. 'ELSE[ELSE]END[NONE END]ENP[NONE]ENT[*VAL ENT]EQU[EQOP EQU]'
. 'ERB[INT,TEXT ERB]ERR[INT,TEXT ERR]ESW[NONE ESW]ETX[NONE]EXI[*INT]EXP[INT]FI[FI]'
. 'ICA[OPN]ICP[NONE]ICV[OPN]IEQ[PLBL]IF[IF]IFF[VAL,PLBL IFF]IGE[PLBL]'
. 'IGT[PLBL]ILE[PLBL]ILT[PLBL]INE[PLBL]INO[PLBL]INP[PTYP,INT INP]'
. 'INR[NONE]IOV[PLBL]ITR[NONE]JSR[PNAM]LCH[REG,OPC]LCT[W,OPV]LCP[REG]'
. 'LCW[REG]LDI[OPS]LDR[OPS]LEI[X]LNF[NONE]LSH[W,VAL]LSX[W,(X)]MCB[NONE]'
. 'MFI[OPN,*PLBL]MLI[OPS]MLR[OPS]MNZ[OPN]MOV[OPV,OPN]MTI[OPN]'
. 'MVC[NONE]MVW[NONE]MWB[NONE]NGI[NONE]NGR[NONE]NZB[W,PLBL]'
. 'ORB[OPW,W]PLC[X,*OPV]PPM[*PLBL]PRC[PTYP,VAL PRC]PSC[X,*OPV]REQ[PLBL]'
. 'RGE[PLBL]RGT[PLBL]RLE[PLBL]RLT[PLBL]RMI[OPS]RNE[PLBL]RNO[PLBL]'
. 'ROV[PLBL]RSH[W,VAL]RSX[W,(X)]RTI[*PLBL]RTN[NONE]SBI[OPS]'
. 'SBR[OPS]SCH[REG,OPC]SCP[REG]SEC[NONE SEC]SIN[NONE]SQR[NONE]SSL[OPW]SSS[OPW]'
. 'STI[OPS]STR[OPS]SUB[OPV,OPN]TAN[NONE]THEN[THEN]TRC[NONE]TTL[NONE TTL]'
. 'UNDEF[UNDEF]WTB[REG]XOB[OPW,W]ZER[OPN]ZGB[OPN]ZRB[W,PLBL]ZZZ[INT]' )


*  PRCTAB is table of procedures declared in INP that is used to
*  check for consistency of INP/PRC statements.
*
	PRCTAB = TABLE(60)
*
*  EQUATES is used by G.EQU and .  It contains a directory of
*  all labels that were defined by EQU instructions.
*
	EQUATES = TABLE(257)

*  LABTAB is a table that maps each label to the section in which
*  it is defined, except labels defined in the Definitions Section
*  (Section 2).

	LABTAB = TABLE(150,150)

*  BSW is a flag that indicates whether or not a BSW...ESW range
*  is being processed.
*
	BSW	= 0

-STITL MAIN PROGRAM
*  Here follows the driver code for the "main" program.

*
*  Loop until program exits via G.END
*
*  DOSTMT is invoked to initiate processing of the next line from
*  RDLINE.
*  After doing this, DOSTMT branches to the generator routine indicated
*  for this opcode if there is one.
*  The generators all have entry points beginning
*  with "G.", and can be considered a logical extension of the
*  DOSTMT routine.  The generators have the choice of branching back
*  to DSGEN to cause the THISSTMT plex to be sent to OUTSTMT, or
*  or branching to DSOUT, in which case the generator must output
*  all needed code itself.
*
*  The generators are listed in a separate section below.
	TRANDATE = DATE()
*	EXIT(-2)

*  START EXECUTION
*
*	Reads for xxx.min, writes to xxx.lex, where xxx is a command line parameter.
*	The command line parameter may optionally be expressed as xxx;yyy, where
*	yyy.cnd is the name of a file containing .DEFs to override those in
*	file xxx.min.
*
*  Get file name
*
*
*  Default the parameter string if none present
*
	ARCH = (DIFFER(HOST(0)) HOST(0), "x64")
	ARCH = LOWER(ARCH)
	PARM = "s"
	FILENAMC = PARM '.cnd'
	FILENAMI = PARM '.min'
	FILENAMO = PARM '.lex'
*
*  Get file name
*
*   FLCFLAG  = REPLACE( INPUT,'y','Y' )
	FLCFLAG = 'N'
	FLCFLAG = 'Y'
*  OUTPUT = 'Full line comments passed to LEXEME file? ' FLCFLAG
*
*  No page ejects without full line comments
*
*   OUTPUT = DIFFER(FLCFLAG,'N')
*   EJCFLAG  = REPLACE( (DIFFER(FLCFLAG,'N') INPUT, 'N'),'y','Y' )
	EJCFLAG = 'N'
	EJCFLAG = 'Y'
*  OUTPUT = 'EJCs passed to LEXEME file? ' EJCFLAG
*
*  Associate input file to LU1.  If a conditional file was specified,
*  read it first.
*
	INPUT(.INFILE,1,(DIFFER(FILENAMC) FILENAMC,FILENAMI))	:S(MAIN1)
        OUTPUT = DIFFER(FILENAMC) "Cannot open CONDITIONAL file: " FILENAMC
+						:S(END)
        OUTPUT = "Cannot open MINIMAL file: " FILENAMI        :(END)
*
*
*  Associate output file
*
MAIN1	OUTPUT(.OUTFILE,2,FILENAMO)		:S(MAIN2)
        OUTPUT = "Cannot open LEXEME file: " FILENAMO  :(END)
MAIN2

*  Patterns used by DOSTMT
	P.OPSK1 = (BREAK(' ') | REM) . ARGSKEL

-STITL Machine-Dependent Initializations
*  Initianlize configuration parameters common to all implementations
       EQU_DEFS = TBLINI(
. 'NSTMX[10]'
. 'CFP_S[9]'
. 'CFP_X[3]'
. 'E_SRS[100]'
. 'E_STS[1000]'
. 'E_CBS[500]'
. 'E_HNB[257]'
. 'E_HNW[6]'
. 'E_FSP[15]'
. 'E_SED[25]'
. 'CH_LA[065]CH_LB[066]CH_LC[067]CH_LD[068]CH_LE[069]CH_LF[070]'
. 'CH_LG[071]CH_LH[072]CH_LI[073]CH_LJ[074]CH_LK[075]CH_LL[076]'
. 'CH_LM[077]CH_LN[078]CH_LO[079]CH_LP[080]CH_LQ[081]CH_LR[082]'
. 'CH_LS[083]CH_LT[084]CH_LU[085]CH_LV[086]CH_LW[087]CH_LX[088]'
. 'CH_LY[089]CH_L_[090]'
. 'CH_D0[048]CH_D1[049]CH_D2[050]CH_D3[051]CH_D4[052]CH_D5[053]'
. 'CH_D6[054]CH_D7[055]CH_D8[056]CH_D9[057]CH__A[097]CH__B[098]'
. 'CH__C[099]CH__D[100]CH__E[101]CH__F[102]CH__G[103]CH__H[104]'
. 'CH__I[105]CH__J[106]CH__K[107]CH__L[108]CH__M[109]CH__N[110]'
. 'CH__O[111]CH__P[112]CH__Q[113]CH__R[114]CH__S[115]CH__T[116]'
. 'CH__U[117]CH__V[118]CH__W[119]CH__X[120]CH__Y[121]CH___[122]'
. 'CH_AM[038]CH_AS[042]CH_AT[064]CH_BB[060]CH_BL[032]CH_BR[124]'
. 'CH_CL[058]CH_CM[044]CH_DL[036]CH_DT[046]CH_DQ[034]CH_EQ[061]'
. 'CH_EX[033]CH_MN[045]CH_NM[035]CH_NT[126]CH_PC[037]CH_PL[043]'
. 'CH_PP[040]CH_RB[062]CH_RP[041]CH_QU[063]CH_SL[047]CH_SM[059]'
. 'CH_SQ[039]CH_UN[095]CH_OB[091]CH_CB[093]CH_HT[009]CH_VT[011]'
. 'CH_EY[094]IODEL[032]' )
* Set target-dependent configuration parameters 
	:($('CONFIG.' ARCH))

CONFIG.X32
	EQU_DEFS['CFP_A'] = '256'
	EQU_DEFS['CFP_B'] = '4'
	EQU_DEFS['CFP_C'] = '4'
	EQU_DEFS['CFP_F'] = '8'
	EQU_DEFS['CFP_I'] = '1'
	EQU_DEFS['CFP_L'] = '4294967295'
	EQU_DEFS['CFP_M'] = '2147483647'
	EQU_DEFS['CFP_N'] = '32'
 	EQU_DEFS['CFP_R'] = '2'
	EQU_DEFS['CFP_U'] = '128'
*	Use 6 words, or 24 characters, for hash in x32
	EQU_DEFS['E_HNW'] = '6'
	
							:(CONFIG.DONE)
CONFIG.X64
	EQU_DEFS['CFP_A'] = '256'
	EQU_DEFS['CFP_B'] = '8'
	EQU_DEFS['CFP_C'] = '8'
	EQU_DEFS['CFP_F'] = '16'
	EQU_DEFS['CFP_I'] = '1'
	EQU_DEFS['CFP_L'] = '18446744073709551616'
	EQU_DEFS['CFP_M'] = '18446744073709551615'
	EQU_DEFS['CFP_N'] = '64'
 	EQU_DEFS['CFP_R'] = '1'
	EQU_DEFS['CFP_U'] = '128'
*	Use 3 words, or 24 characters, for hash in x64
*	This is done so hashes for x32 and x64 should agree
	EQU_DEFS['E_HNW'] = '3'
CONFIG.DONE

*
  :(DSOUT)
  &TRACE = 4000
  &FTRACE = 4000
*  &PROFILE = 1
DSOUT
DOSTMT	THISLINE = RDLINE()
	CRACK(THISLINE)            		:F(DSOUT)
	DIFFER(LABEL) LABENTER()
	ARGERRS = 0

	OPSKEL = OPTAB[OPCODE]			:F(DS01)
	IDENT(OPSKEL) ERROR("OPCODE NOT KNOWN")
	OPSKEL P.OPSK1 =
	IDENT(ARGSKEL,'NONE')			:S(DOS10)

*  HERE IF ARGUMENTS TO VERIFY
DOS01	IDENT(ARGSKEL)				:S(DOS05)
	ARGSKEL P.ARGSKEL1 =
*  ACCEPT NULL ARGUMENT IF THIS ARGUMENT OPTIONAL
	ARGTHIS '*' IDENT(OP1)			:S(DOS05)
	TYP1 = ARGTYPE(OP1,ARGTHIS)
	ARGERRS = EQ(TYP1) ARGERRS + 1
	IDENT(ARGSKEL)				:S(DOS05)
	ARGSKEL P.ARGSKEL2 =
	ARGTHIS '*' IDENT(OP2)			:S(DOS05)
	TYP2 = ARGTYPE(OP2,ARGTHIS)
	ARGERRS = EQ(TYP2) ARGERRS + 1
	IDENT(ARGSKEL)				:S(DOS05)
	ARGSKEL P.ARGSKEL2 =
	ARGTHIS '*' IDENT(OP3)			:S(DOS05)
	TYP3 = ARGTYPE(OP3,ARGTHIS)		:(DOS05)
	ARGERRS = EQ(TYP3) ARGERRS + 1
DOS10
DOS05
	GT(ARGERRS) ERROR('ARG TYPE NOT KNOWN')
*  HERE IF AN ARGUMENT TYPE NOT RECOGNIZED
	OPSKEL ' ' =				:F(DSGEN)
*  Here if post-processing required
	            :($('G.' OPSKEL))
*
*  Get generator entry point (less "G." prefix)
*
  :(G.H)
*  Here if bad opcode
DS01	ERROR('BAD OP-CODE')			:(DSOUT)

*  GENERATE LEXEMES.
*
DS.TYPERR
	ERROR('OPERAND TYPE ZERO')		:(DSOUT)
DSGEN   OUTSTMT(LABEL,OPCODE,OP1,OP2,OP3,COMMENT) :(DSOUT)
-STITL ARGFORM(ARG)
ARGFORM
	ARGFORM = 0
*  DETERMINE OPERAND FORMAT TYPE as follows
	IDENT(T = ITYPTAB[ARG])			:S(ARGFORM1)
*  ITYPTAB has table of cases for types 07,08,09,10,11
*  If entry in this table, type immediately available:
*  W reg is 08 X reg is 07 (X)+ is 10 -(X) is 11 (X) is 09
	ARGFORM = T				:(RETURN)
ARGFORM1
	ARG P.NOS				:S(ARGFORM.INT)
	ARG '='					:S(ARGFORM.EQ)
	ARG '*'					:S(ARGFORM.STAR)
	ARG ANY('+-')				:S(ARGFORM.SNUM)
	ARG BREAK('(')				:S(ARGFORM.INDEX)
*  HERE IF THE ONLY POSSIBILITY REMAINING IS A NAME WHICH MUST BE LBL
*  IF THE LABEL NOT YET KNOWN, ASSUME IT IS A PLBL
	IDENT(T = LABTAB[ARG])			:S(ARGFORM.PLBL)
	ARGFORM = T				:(RETURN)
ARGFORM.PLBL LABTAB[ARG] = 6
	ARGFORM = 6				:(RETURN)
ARGFORM.EQ
	ARG LEN(1) REM . ITYPA
	ITYPA = LABTAB[ITYPA]
	ARGFORM = (EQ(ITYPA,2) 18, EQ(ITYPA,6) 22,
.	GT(ITYPA,2) ITYPA + 17) :S(RETURN)
*  if =LBL and LBL not known, it must be ELBL
	ARGFORM = 22
	LABTAB[ITYPA] = 5			:(RETURN)
ARGFORM.STAR
	ARG LEN(1) REM . T			:F(RETURN)
	EQ(LABTAB[T],2)				:F(RETURN)
	ARGFORM = 19				:(RETURN)
ARGFORM.INT	ARGFORM = 1			:(RETURN)
ARGFORM.SNUM	ARG LEN(1) P.NOS		:F(ARGFORM.SREAL)
		ARGFORM = 16			:(RETURN)
ARGFORM.SREAL	ARG LEN(1) P.REAL		:F(RETURN)
		ARGFORM = 17			:(RETURN)
ARGFORM.INDEX	ARG BREAK('(') . T '(X' ANY('LRST') ')' RPOS(0)
.						:F(RETURN)
	T P.NOS					:F(ARGFORM.INDEX1)
*  HERE IF INT(X)
	ARGFORM = 12				:(RETURN)
ARGFORM.INDEX1
	IDENT(T = LABTAB[T])			:S(RETURN)
	ARGFORM = (EQ(T,2) 13, EQ(T,3) 15, EQ(T,4) 14)	:(RETURN)
-STITL ARGTYPE(OP,TYP)
*  This module checks operand types of current operation,
*  prefixing each operand with type code as given in
*  Minimal definition.
*  Initially classify as one of following:
*  01=INT 02=DLBL  03=NAME 07=X  08=W  09=(X) 10=(X)+  11=-(X)
*  12=INT(X)  13=DLBL(X)  14=NAME(X)  16=SIGNED-INTEGER
*  17=REAL  18==DLBL  19=*DLBL 20==NAME  23=PNAM 24=EQOP
*  25=PTYP  26=TEXT  27=DTEXT
ARGTYPE
	ARGTYPE = 0
*  TYP MAY HAVE INITIAL'*' INDICATING ARGUMENT OPTIONAL. THIS
*  CODE REACHED ONLY IF ARGUMENT NOT NULL, SO REMOVE THE '*'.
	TYP '*' =

	IDENT(TYP,'TEXT') 			:S(ARG.TEXT)
	IDENT(TYP,'DTEXT') 			:S(ARG.DTEXT)
	IDENT(TYP,'PTYP')			:S(ARG.PTYP)
	IDENT(TYP,'EQOP')			:S(ARG.EQOP)
	ITYPE = ARGFORM(OP)
	OPFORM = OPFORMTAB<TYP>
	ARGTYPE = NE(VALIDFORM<+OPFORM,ITYPE>) ITYPE	:(RETURN)
*	ARGTYPE = ITYPE 			:(RETURN)

ARG.TEXT ARGTYPE = 26 				:(RETURN)
ARG.DTEXT ARGTYPE = 27				:(RETURN)
ARG.PTYP OP ANY('RNE')				:F(RETURN)
	ARGTYPE = 25				:(RETURN)
ARG.EQOP
	OP1 = IDENT(OP,'*')
.			EQU_DEFS[LABEL]
	ARGTYPE = 24				:(RETURN)

*
-STITL CRACK(LINE)OPERANDS,OPERAND,CHAR
*  CRACK is called to create a STMT plex containing the various
*  entrails of the Minimal Source statement in LINE.  For
*  conditional assembly ops, the opcode is the op, and OP1
*  is the symbol.  Note that DTC is handled as a special case to
*  assure that the decomposition is correct.
*
*  CRACK will print an error and fail if a syntax error occurs.
*
CRACK   NSTMTS  = NSTMTS + 1
	LINE    P.CSPARSE			:F(CS03)
	OP1 = OP2 = OP3 = TYP1 = TYP2 = TYP3 =
	IDENT(OPCODE,'DTC')			:S(CS02)
*
*  Now pick out operands until none left
*
	OPERANDS  P.CSOPERAND = 		:F(CS01)
	OP1 = OPERAND
	OPERANDS  P.CSOPERAND = 		:F(CS01)
	OP2 = OPERAND
	OPERANDS  P.CSOPERAND			:F(CS01)
	OP3 = OPERAND
CS01	:(RETURN)
*
*  DTC - Special case
*
CS02	LINE	P.CSDTC				:F(CS03)
	OP1 = OPERAND
						:(CS01)
*
*  Here on syntax error
*
CS03	ERROR('SOURCE LINE SYNTAX ERROR')	:(FRETURN)
-STITL ERROR(TEXT)
*  This module handles reporting of errors with the offending
*  statement text in THISLINE.  Comments explaining
*  the error are written to the listing (including error chain), and
*  the appropriate counts are updated.
*
ERROR
	OUTFILE = '* *???* ' THISLINE
	OUTFILE = '*       ' TEXT
.	          (IDENT(LASTERROR),'. LAST ERROR WAS LINE ' LASTERROR)
	LASTERROR = NOUTLINES
	NOUTLINES = NOUTLINES + 2
	NERRORS = NERRORS + 1
.	              			:(DSOUT)
-STITL LABENTER()TLAB
*  LABENTER is called to make entry in LABTAB for a label
*  Current classification is 3 for WLBL, 4 for CLBL and 5 for
*  other labels
LABENTER
	IDENT(LABEL)				:S(RETURN)
	LABTAB[LABEL] = (EQ(SECTNOW,2) 2, EQ(SECTNOW,3) 4,
.	EQ(SECTNOW,4) 3 , GT(SECTNOW,4)  6) 	:(RETURN)
-STITL OUTSTMT(LABEL,OPCODE,OP1,OP2,OP3,COMMENT)T,STMTOUT
*
OUTSTMT
*
*  Send text to OUTFILE
*
	OUTFILE = '{' LABEL '{' OPCODE '{'
.	(IDENT(TYP1), TYP1 ',') OP1 '{'
.	(IDENT(TYP2), TYP2 ',') OP2 '{'
.	(IDENT(TYP3), TYP3 ',') OP3 '{' COMMENT
.	'{' NLINES
	NTARGET = NTARGET + 1
	NOUTLINES = NOUTLINES + 1
.						:(RETURN)
-STITL RDLINE()
*  This routine returns the next statement line in the input file
*  to the caller.  It never fails.  If there is no more input,
*  then a Minimal END statement is returned.
*  Comments are passed through to the output file directly.
*  Conditional assembly is performed here.
*
*  If we were reading from FILENAMC (conditional DEFs), then the
*  input stream is switched to FILENAMI, and the flag IGNORE_DEFS
*  is set.
*
*  Lines beginning with ">" are treated as SNOBOL4 statements
*  and immediately executed.
*
RDLINE	RDLINE = INFILE				:F(RL02)
	NLINES  = NLINES + 1
	IDENT( RDLINE )				:S(RDLINE)
*
*  Transfer control to appropriate conditional assembly
*  directive generator or other statement generator.
*
	LEQ( SUBSTR( RDLINE,1,1 ),'.' )		:F(OTHER)
	RDLINE ? P.CONDASM			:S( $CATAB[CONDCMD] )
RL00	LEQ( SUBSTR( RDLINE,1,1 ),'*' )		:F(RL01)

*
*  Only print comment if requested.
*
	OUTFILE = IDENT(FLCFLAG,'Y') RDLINE	:F(RDLINE)
	NOUTLINES = NOUTLINES + 1		:(RDLINE)
*
*  Here if not a comment line
*
RL01	LEQ( SUBSTR( RDLINE,1,1 ),'>' )		:F(RETURN)

*
*  Here with SNOBOL4 line to execute
*
	C = CODE(SUBSTR( RDLINE, 2 ) "; :(RDLINE)") :S<C>
        OUTPUT = "Error compiling SNOBOL4 statement"
  						:(RL03)
*
*  Here on EOF.  FILENAMC is non-null if we were reading from it.
*
RL02	IDENT(FILENAMC)				:S(RL03)
	FILENAMC =
	IGNORE_DEFS = 1
	ENDFILE(1)
	INPUT(.INFILE,1,FILENAMI)		:S(RDLINE)
        OUTPUT = "Cannot open MINIMAL file: " FILENAMI        :(END)

RL03	RDLINE = '       END'			:(RL01)
*
*  syntax error handler.
*
SYNERR OUTPUT = INCNT '(SYNTAX ERROR):' RDLINE            :(RDLINE)
*
*  process define
*
DEFOP  IDENT( CONDVAR )				:S(SYNERR)
       DIFFER( IGNORE_DEFS )			:S(RDLINE)
       EQ( LEVEL )				:S(DEFOK)
       EQ( PROCESSREC[RESULT(TOP),MODE(TOP)] )	:S(RDLINE)
DEFOK  SYMTBL[CONDVAR] = 1			:(RDLINE)
*
*  process undefine
*
UNDEFOP
       IDENT( CONDVAR )				:S(SYNERR)
       EQ( LEVEL )				:S(UNDOK)
       EQ( PROCESSREC[RESULT(TOP),MODE(TOP)] )	:S(RDLINE)
UNDOK  SYMTBL[CONDVAR] =			:(RDLINE)
*
*  process if
*
IFOP   IDENT( CONDVAR )				:S(SYNERR)
       EQ( LEVEL )				:S(IFOK)
*
*  here for .IF encountered during bypass state.
*
       NE( PROCESSREC[RESULT(TOP),MODE(TOP)] )  :S(IFOK)
       LEVEL    = LEVEL + 1
       TOP      = STATESTK[LEVEL] = STATE(BYPASS,THEN)    :(RDLINE)
*
*  here for .IF to be processed normally.
*
IFOK   LEVEL    = LEVEL + 1
       TOP      = STATESTK[LEVEL] = STATE(
.	             ( DIFFER( SYMTBL[CONDVAR] ) TRUE,FALSE ),
.	             THEN )			:(RDLINE)
*
*  Process .THEN
*
THENOP	DIFFER(CONDVAR)				:S(SYNERR)
	EQ(LEVEL)				:S(SYNERR)F(RDLINE)
*
*  Process .ELSE
*
ELSEOP	DIFFER(CONDVAR)				:S(SYNERR)
	MODE(TOP) = NE( LEVEL ) ELSE		:S(RDLINE)F(SYNERR)
*
*  Process .FI
*
FIOP	DIFFER(CONDVAR)				:S(SYNERR)
	LEVEL = NE( LEVEL ) LEVEL - 1		:F(SYNERR)
	TOP   = ( NE( LEVEL ) STATESTK[LEVEL],'' )     :(RDLINE)
*
*  Process statements other than conditional directives.
*
OTHER	EQ( LEVEL )				:S(RL00)
	EQ( PROCESSREC[RESULT(TOP),MODE(TOP)] )	:S(RDLINE)F(RL00)
-STITL	TBLINI(STR)POS,CNT,INDEX,VAL,LASTVAL
*  This routine is called to initialize a table from a string of
*  index/value pairs.
*
TBLINI	POS     = 0
*
*  Count the number of "[" symbols to get an assessment of the table
*  size we need.
*
TIN01   STR     (TAB(*POS) BREAK('[') BREAK(']') *?(CNT = CNT + 1) @POS)
.	                              	:S(TIN01)
*
*  Allocate the table, and then fill it. Note that a small memory
*  optimisation is attempted here by trying to re-use the previous
*  value string if it is the same as the present one.
*
	TBLINI   = TABLE(CNT)
TIN02   STR     (BREAK('[') $ INDEX LEN(1) BREAK(']') $ VAL LEN(1)) =
.	                              	:F(RETURN)
	VAL     = CONVERT( VAL,'INTEGER' )
	VAL     = IDENT(VAL,LASTVAL) LASTVAL
	LASTVAL = VAL
	TBLINI[INDEX] = VAL			:(TIN02)
-STITL Generators
*
*  BSW processing begins by building an array that can hold all
*  IFF operands and comments.
*
G.BSW
*  save prior vms code in case needed
	UB = ( INTEGER( OP2 ) OP2, EQUATES[OP2] )
	IFFAR = INTEGER( UB )
.		ARRAY( '0:' UB - 1,'{{' )	:F(G.BSW1)
	DPLBL = OP3
	BSW   = 1				:(DSGEN)
G.BSW1	ERROR("NON-INTEGER LOWER BOUND FOR BSW")

*
*  IFF processing sets the iffar[] element to the current
*  value, plbl, and comment.
*
G.IFF
	(EQ( BSW ) ERROR("IFF WITHOUT BSW"))
	IFFTYP = ( INTEGER(OP1) '1', '2')
	IFFVAL = ( INTEGER( OP1 ) OP1, EQUATES[OP1] )
	IFFAR[IFFVAL] = INTEGER( IFFVAL )
.		IFFTYP ',' OP1 '{' TYP2 ',' OP2 '{'  COMMENT
.						:S(DSOUT)
	ERROR("NON-INTEGER IFF VALUE")
*
*  In order to support translation of MINIMAL operands and
*  BSW/IFF/ESW preprocessing, all EQU expressions must be
* 	evaluated and kept in a symbol table.
*
G.EQU
	EQUATES[LABEL] = IDENT(OP1,'*')
.			EQU_DEFS[LABEL]	:S(DSGEN)

	NUM1 = NUM2 = SYM1 = SYM2 = OPRTR =
	OP1 P.EQU.RIP				:F(G.EQU2)
	NUM1    = DIFFER(SYM1) EQUATES[SYM1]
	NUM2    = DIFFER(SYM2) EQUATES[SYM2]
	VAL     = (DIFFER(OPRTR) EVAL( NUM1 ' ' OPRTR ' ' NUM2 ), NUM1)	:F(G.EQU3)
G.EQU1	EQUATES[LABEL] = VAL				:(DSGEN)
G.EQU2	ERROR("EQU OPERAND SYNTAX ERROR")
G.EQU3	ERROR("EQU EVALUATION FAILED: " NUM1 ' ' OPRTR ' ' NUM2 ' "' OP1 '"' )
*
*  ESW processing generates an IFF for every value in the
*  BSW range.
*
G.ESW
	(EQ(BSW) ERROR("ESW WITHOUT BSW"))
	IFFINDX = 0
G.ESW1	IFFAR[IFFINDX] BREAK('{') $ VAL LEN(1)
.		BREAK( '{' ) $ PLBL LEN(1)
.		REM $ CMNT
.						:F(G.ESW2)
	VAL = IDENT( VAL ) '1,' IFFINDX
	PLBL = IDENT( PLBL ) '6,' DPLBL
	(IDENT(DPLBL) IDENT(PLBL) ERROR("MISSING IFF VALUE: "
.		 VAL " WITHOUT PLBL IN PRECEDING BSW"))
	OUTSTMT(,'IFF',VAL,PLBL,,CMNT)
	IFFINDX = IFFINDX + 1			:(G.ESW1)
G.ESW2  IFFAR =					:(DSGEN)

REPORT
	OUTPUT = LPAD(NUM,10) '  ' TEXT		:(RETURN)

*  END prints statistics on terminal then exits program
*
G.END   
	OUTSTMT(,'END',,,,COMMENT)
	(NE(LEVEL) ERROR("  unclosed IF conditional clause"))
        REPORT(NLINES,		'lines read')
        REPORT(NSTMTS, 		'statements processed')
        REPORT(NTARGET, 	'target code lines produced')
	REPORT(&STCOUNT, 	'spitbol statements executed')
        DIFFER(NERRORS) REPORT(NERRORS,'errors detected')
 	REPORT =
+	  DIFFER(LASTERROR) '  the last error was in line ' LASTERROR
	&CODE   = NE(NERRORS) 2001
        REPORT(COLLECT() * 5,	'free bytes')

	T = CONVERT(PRCTAB,'ARRAY')		:F(G.END.2)
*  Here if procedures declared by INP but not by PRC
        OUTPUT = '  procedures with INP, no PRC'
	I = 1
G.END.1 OUTPUT = T[I,1] ' ' T[I,2]            :F(G.END.2)
	I = I + 1				:(G.END.1)
G.END.2
						:(END)
G.ENT
*  NOTE PROGRAM ENTRY LABELS
*	ENTFILE = LABEL ',' OP1
	LABTAB[LABEL] = 5			:(DSGEN)
G.H						:(DSGEN)

*  Keep track of SEC statements

G.SEC	SECTNOW = SECTNOW + 1  		:(DSGEN)
G.TTL
	THISLINE LEN(10) REM . T
	T SPAN(' ') =
	OUTSTMT(,'TTL','27,' T)			:(DSOUT)
G.ERB
G.ERR	THISLINE BREAK(',') LEN(1) REM . T
	OUTSTMT(LABEL,OPCODE,OP1, T)		:(DSOUT)

G.INP
	IDENT(LABEL) ERROR('NO LABEL FOR INP')
	DIFFER(T = PRCTAB[LABEL]) ERROR('DUPLICATE INP')
	PRCTAB[LABEL] = OP1			:(DSGEN)

G.PRC
	IDENT(LABEL) ERROR('NO LABEL FOR PRC')
	IDENT(T = PRCTAB[LABEL]) ERROR('MISSING INP')
	DIFFER(T,OP1) ERROR('INCONSISTENT INP/PRC')
	PRCTAB[LABEL] =				:(DSGEN)
* Convert argument to upper case
LOWER
	LOWER = REPLACE(S,'ABCDEFGHIJKLMNOPQRSTUVWXYZ',
.			  'abcdefghijklmnopqrstuvwxyz')	:(RETURN)
END