!!  *** ESDLS ***   15/07/80
!! Updated for IMP8 27/11/81 and 01/03/83 (V3.3)
%BEGIN
%CONSTSTRING(31) VERSION="ESDL Compiler version 3.3 (APM)"

%systemstring (255) %fnspec itos(%integer v,p)
%systemstring (8) %fnspec date
!%include "inc:util.imp"
%EXTERNALINTEGERFNSPEC DEF STREAMS(%STRING(127) PARM, DEFAULTS)
%INTEGER RETURN CODE
%OWNSTRING(47) DEFAULTS=".SRC,.SRC,ESDL:ESDL.PRM/%I1.EIC,.LIS"

!**************************************************
!*                                                *
!* The Edinburgh Structural Description Language  *
!*                                                *
!**************************************************

!! predefined tokens - read from pre-definition file

! group1
%CONSTINTEGER GROUP1=1
%CONSTINTEGER DEFINE=1
%CONSTINTEGER GENERIC=2
! must be ordered SPEC, UNIT, CHIP, BOARD, PACK
! and numbered contiguously (UDEF)
%CONSTINTEGER A SPEC=3
%CONSTINTEGER A UNIT=4
%CONSTINTEGER CHIP=5
%CONSTINTEGER BOARD=6
%CONSTINTEGER PACK=7

!group2
%CONSTINTEGER GROUP2=2
%CONSTINTEGER ROUTE=130
%CONSTINTEGER END=8
%CONSTINTEGER EOL=NL;   ! =10 (ascii newline)
%CONSTINTEGER A TAG=9
%CONSTINTEGER WIRE=129

! group 3
%CONSTINTEGER FINISH=11

! group4

! group5
%CONSTINTEGER OPTION=13
%CONSTINTEGER PINS=14
!! Must be numbered contiguously in this order (UHEAD)
%CONSTINTEGER MAX PARMS=8
%CONSTINTEGER AT=15
%CONSTINTEGER ON=16
%CONSTINTEGER PACKAGE=17
%CONSTINTEGER SUBPACK=18
%CONSTINTEGER DELAY=19
%CONSTINTEGER VALUE=20
%CONSTINTEGER SIZE=21
%CONSTINTEGER PLACE=22
%CONSTINTEGER P9=23
%CONSTINTEGER PLAST=24

!! compiler control constants
%CONSTINTEGER COPTION=27
%CONSTINTEGER LISTON=28
%CONSTINTEGER LISTOFF=29
%CONSTINTEGER GENERATE=30
%CONSTINTEGER NOGENERATE=31

!! useful values
%CONSTINTEGER TRUE=1,   FALSE=2,   ERROR=3
%CONSTINTEGER OK=1,   NO=2,   YES=1
%CONSTINTEGER NULL=0,   BLANK=' ',   END OF FILE=9
%CONSTINTEGER UNSUBSCRIPTED=32767
%CONSTINTEGER CNTRL=128,   CNTRLCHAR='^',   EM=25
%STRING(255)%NAME NULL STRING

!! error message numbers
%CONSTINTEGER MAX ERRORS=25
%CONSTINTEGER NWARNINGS=4
%CONSTINTEGER W1=1,   W2=2,   W3=3,   W4=4
%CONSTINTEGER NERRORS=16
%CONSTINTEGER E1=11,   E2=12,   E3=13,   E4=14,   E5=15
%CONSTINTEGER E6=16,   E7=17,   E8=18,   E9=19,   E10=20,   E11=21
%CONSTINTEGER E12=22,  E13=23,  E14=24,  E15=25,  E16=26
%CONSTINTEGER NDISASTERS=3
%CONSTINTEGER D1=101,   D2=102,   D3=103

!! Parsing control variables
%OWNINTEGER IGNORE NLS = YES
%OWNINTEGER TOKEN=0
%OWNINTEGER PARSE=OK
%OWNINTEGER LEVEL=0
%CONSTINTEGER ONE=256

!! portability section - machine description constants
%CONSTINTEGER CPW  =4;   ! characters per word
%CONSTINTEGER LCPW =2;   ! log2 chars per word
%CONSTINTEGER BPW  =32;  ! bits per word
%CONSTINTEGER AUPW =4;   ! addressing units per word
%CONSTINTEGER LAUPW=2;   ! log2 addressing units per word

!! stack mapping record formats

%RECORDFORMATSPEC FTAGDEF

%RECORDFORMAT FTAG(%RECORD(FTAGDEF)%NAME TAGDEF,
                   %INTEGER HNEXT, TOKEN, %STRING(255) NAME)
%CONSTINTEGER TAGLEN=3

%RECORDFORMATSPEC FSPEC
%RECORDFORMATSPEC FFAN

%RECORDFORMAT FTAGDEF(%RECORD(FTAG)%NAME TAG,
                      %RECORD(FTAGDEF)%NAME PREV,
                     (%RECORD(FFAN)%NAME FAN %OR %c
                      %RECORD(FSPEC)%NAME SPEC %OR %c
                      %STRING(255)%NAME TEXT),
                      %INTEGER LEVEL, SUBSCRIPT)
%CONSTINTEGER TAGDEFLEN=5

%RECORDFORMAT FTERMINAL(%INTEGER INFO, %RECORD(FTAGDEF)%NAME NAME,
                        %STRING(255)%NAME PIN)
%CONSTINTEGER TERMINALLEN=3

!! COMPILER LIMITS
%CONSTINTEGER MAX WNAMES=32
%CONSTINTEGER MAX SIGNALS=512
%CONSTINTEGER MAX QUADS=32

%RECORDFORMAT FQUAD(%INTEGERARRAY COORD(1:4))
%CONSTINTEGER QUADLEN=4

%RECORDFORMAT FROUTE(%RECORD(FROUTE)%NAME NEXT, %INTEGER NQUADS,
      %RECORD(FTAGDEF)%NAME NAME,
      %RECORD(FQUAD)%ARRAY QUAD(1:MAX QUADS))
%CONSTINTEGER ROUTELEN=3

%RECORDFORMAT FSPEC(%RECORD(FSPEC)%NAME NEXT, PREV,
      %RECORD(FTAGDEF)%NAME UNAME, NAMEDEF,
      %INTEGER TYPE, OPTION, NIN, NOUT, NIO, NT,
      %STRING(255)%NAME %ARRAY PARM(1:MAX PARMS),
      %RECORD(FTERMINAL)%ARRAY T(1:MAX SIGNALS))
%CONSTINTEGER SPECLEN=10+MAX PARMS

%RECORDFORMAT FUNIT(%RECORD(FSPEC)%NAME INSTANCES,
                    %RECORD(FROUTE)%NAME ROUTES,
                    %INTEGER NSUBS)

%RECORDFORMAT FFAN((%INTEGER SUBNO %OR %RECORD(FTAGDEF)%NAME TAGDEF),
                   %INTEGER INFO, %RECORD(FFAN)%NAME NEXT)
%CONSTINTEGER FANLEN=3


!! Tag types
%CONSTINTEGER STYPE=1;      ! String - I.E. a Macro
%CONSTINTEGER PTYPE=2;      ! Pin - I.E. a Signal name
%CONSTINTEGER UTYPE=4;      ! Unit-name
%CONSTINTEGER UNAMETYPE=8;  ! Unique-name - I.E. an arbitrary Tag
%CONSTINTEGER GBLTYPE=16;   ! Name begins with a '.'
%CONSTINTEGER SCANNED=32;   ! Signals hung on this name have been output
%CONSTINTEGER ALIASED=64;   ! Signal is aliased
%CONSTINTEGER GENTYPE=8;    ! Generic Type for UNIT, CHIP, or BOARD

%CONSTINTEGER DEFINITION=1,   INSTANCE=2
%CONSTINTEGER DUMMY=0,   INPUT=1,   OUTPUT=2,   INOUT=3

!! ANOTHER PARSING CONTROL VARIABLE
%RECORD(FTAG)%NAME TOKEN VALUE

!! stack - used as workspace
%CONSTINTEGER STACKLEN=50000
%INTEGERARRAY STACK(0:STACKLEN)
%OWNINTEGER TOS,   STACKTOP

!! listing control variables and constants
%CONSTINTEGER END OF PAGE=61
%CONSTINTEGER PAGELEN=66
%CONSTINTEGER LINELEN=68
%OWNINTEGER LISTLEN=2
%OWNINTEGER LISTING=NO
%OWNINTEGER WARNINGS=0,   ERRORS=0,   SKIPPED=0,   TOKENS=0

!! object file description
%OWNINTEGER OCOL=0
%CONSTINTEGER OLINELEN=60

!! i/o streams
%CONSTINTEGER TELETYPE=0,   OBJECT=1,   LISTFILE=2,   DUMP=3
%OWNINTEGER MIN=3,   MOUT=OBJECT

!! compiler flags
%CONSTINTEGER DUMP1=1;      ! Dump keywords
%CONSTINTEGER DUMP2=2;      ! Dump stack at each UNIT end
%CONSTINTEGER DUMP3=4;      ! Dump stack at end of program
%CONSTINTEGER FORGET=8;     ! Forget SPECs after UNIT end
%CONSTINTEGER NOSTRCONVERT=16;! Don't convert strings to upper case
%CONSTINTEGER PUT SPECS=32;  ! put out SPECs into I-code
%CONSTINTEGER NOSIGNALS=64;! No RHS allowed
%OWNINTEGER CFLAGS=0


%ROUTINE SELOUT(%INTEGER STREAM)
   ! Selectoutput stream and remember it
   MOUT=STREAM
   SELECTOUTPUT(STREAM)
%END

!DIAGNOSTIC SECTION
!%ROUTINE PHEX(%INTEGER H)
!   ! routine to print a hexadecimal number
!   %INTEGER I,C
!   %FOR I=1,1,(BPW>>2) %CYCLE
!      C=H>>(BPW-4)
!      %IF C<10 %THEN C=C+'0' %ELSE C=C+'A'-10
!      PRINTSYMBOL(C)
!      H=H<<4
!   %REPEAT
!%END
!DIAGNOSTIC SECTION

!! HASHTABLE AND ITS LENGTH - USED BY READTAG AND CLEANUP
%CONSTINTEGER HASHTABLE LEN=127;   ! MUST BE 2**N-1
%OWNINTEGERARRAY HASHTABLE(0:HASHTABLE LEN)=NULL(*)

%ROUTINE DUMP STACK
   ! dump the stack in hex format, 16-BYTES to the line
   ! followed by character equivalent
!DIAGNOSTIC SECTION
!   %INTEGER P,   I,   Q,   L
!   %CONSTINTEGER MASK=15
!
!   %OWNBYTEINTEGERARRAY ASCII(0:127)='.'(32),
!   '.', '!','"','#','$','%','&', '''', '(',
!   ')', '*', '+', ',', '-', '.', '/', '0','1',
!   '2','3','4','5','6','7','8','9', ':', ';',
!    '<', '=', '>', '?', '@','A','B','C','D',
!   'E','F','G','H','I','J','K','L','M','N','O',
!   'P','Q','R','S','T','U','V','W','X','Y','Z',
!    '[', '^', ']', '^', '.', '.','a','b','c',
!   'd','e','f','g','h','i','j','k','l','m','n',
!   'o','p','q','r','s','t','u','v','w','x','y',
!   'z', '.'(5)
!
!   SELOUT(DUMP)
!   L=0
!   %FOR I=0,1,HASHTABLELEN %CYCLE
!      %IF HASHTABLE(I)#NULL %START
!         L=L+1
!         NEWLINE %AND L=0 %IF L&7=0
!         WRITE(I,3);PRINTSYMBOL(':')
!         PHEX(HASHTABLE(I))
!      %FINISH
!   %REPEAT
!   NEWLINE
!   P=ADDR(STACK(0));   Q=P
!   ! print the address
!   PHEX(P); PRINTSYMBOL(':')
!   %WHILE P#TOS %CYCLE
!      %IF P&MASK=0 %START
!         SPACES(4)
!         ! output character equivalent of line
!         L=(((P-Q)>>LAUPW)<<LCPW)-1
!         %FOR I=0,1,L %CYCLE
!            PRINTSYMBOL(ASCII(BYTEINTEGER(Q+I)&127))
!         %REPEAT
!         Q=P
!         NEWLINE
!         ! and print the address again
!         PHEX(P); PRINTSYMBOL(':')
!      %FINISH
!      SPACE; PHEX(INTEGER(P))
!      P=P+AUPW
!   %REPEAT
!   NEWLINE
!   SELOUT(LISTFILE)
!DIAGNOSTIC DECTION END
%END

%ROUTINESPEC STATISTICS(%INTEGER STREAM)
%ROUTINESPEC THROW(%INTEGER NLINES)

%ROUTINE STOP
   SELOUT(LISTFILE)
   THROW(2)
   STATISTICS(LISTFILE)
   STATISTICS(TELETYPE)
   DUMP STACK %IF CFLAGS&DUMP3#0
   %STOP
%END

%ROUTINE THROW(%INTEGER LINES)
   ! Routine to throw a line, taking into account 
   ! page boundaries.
   %IF LINES>0 %THEN NEWLINES(LINES)
   LISTLEN=LISTLEN+LINES
   %IF LISTLEN>END OF PAGE %START
      LISTLEN=PAGELEN-LISTLEN
      %IF LISTLEN>0 %START
         NEWLINES(LISTLEN)
         LISTLEN=0
      %FINISH %ELSE LISTLEN=0-LISTLEN
   %FINISH
%END

%ROUTINESPEC MSG(%INTEGER MSGNO)

%ROUTINE CLAIM(%INTEGER NWORDS)
   ! claim nwords of the stack
   TOS=TOS+(NWORDS<<LAUPW)
   MSG(D1) %IF TOS>>LAUPW>=STACKTOP
%END

!! character interface
!  Line remembers the last 1 or 2 tokens read
%OWNBYTEINTEGERARRAY LINE(0:159)=NL(*)
%OWNINTEGER LINENO=-1,   STMNT=0,   POS=0,   TOKENPOS=0,   COL=0
%OWNINTEGER CH=NL,   TOKEN END=0,   RECOVERING=NO

%ROUTINE NUMBER LINE
   ! Routine to output a line number and statement number
   ! The line number is obtained from the previous pass
   ! (if at all) and the statement number is maintained internally
   THROW(1)
   %IF LINENO>=0 %THEN WRITE(LINENO,4) %ELSE SPACES(5)
   WRITE(STMNT,4)
%END

%ROUTINE NEXT LINE
   ! Increment the statement count, and output the line
   ! number if we are listing the input
   STMNT=STMNT+1
   %IF LISTING=YES %START
      NUMBER LINE
      ! Flag ignored text with a '$'
      %IF RECOVERING=YES %THEN PRINTSYMBOL('$') %ELSE SPACE
      SPACE
   %FINISH
   COL=0
%END

%ROUTINE CONTINUE LINE(%INTEGER CCHAR)
   ! Output a continuation line number
   ! Number the same as the last line - followed by CCHAR
   %IF LISTING=YES %START
      NUMBER LINE
      PRINTSYMBOL(CCHAR); SPACE
   %FINISH
   COL=0
%END

%ROUTINE CLEAR LINE(%INTEGER START,END)
   ! Clear part of the line buffer -  that between
   ! START and END
   %INTEGER CH

   %WHILE START<END %CYCLE
      CH=LINE(START)
      %IF CH=NL %START
         ! found a newline so start next line
         NEXT LINE
      %FINISHELSESTART
         ! check for listing line-overflow
         CONTINUE LINE('+') %IF COL>=LINELEN
         COL=COL+1
         PRINTSYMBOL(CH) %IF LISTING=YES
      %FINISH
      START=START+1
   %REPEAT
%END

%ROUTINE PUT TOKEN(%INTEGER MARKER)
   ! Put out the last token read and any preceeding and following
   ! space chars (BLANK, NL) from the line buffer.
   ! Output the char MARKER immediately before the token. 
   %INTEGER L

   CLEAR LINE(1,TOKENPOS)
   L=TOKENEND-TOKENPOS
   %IF COL+L>=LINELEN %THEN CONTINUE LINE('+')
   PRINTSYMBOL(MARKER) %IF MARKER#0
   CLEAR LINE(TOKENPOS,POS)
   LINE(1)=LINE(POS)
   POS=1
   TOKENPOS=1
   TOKEN END=1
%END

%ROUTINE MSG(%INTEGER MSGNO)
   ! Output an error message identified by msgno
   %INTEGER SAVE
   %CONSTINTEGER SE=NWARNINGS,   SD=SE+NERRORS
   %SWITCH MESS(1:SD+NDISASTERS)

   SAVE=LISTING
   %IF LISTING=NO %START
      ! display erronious token - first output a line number
      LISTING=YES
      CONTINUE LINE(BLANK)
   %FINISH
   ! display the erronious token with preceeding marker
   PUT TOKEN('|'); THROW(1)
   PRINTSYMBOL('*');SPACE
   LISTING=SAVE

START:
   %IF MSGNO>100 %START
      PRINTSTRING("Disaster: ")
      ->MESS(MSGNO-100+SD)
   %FINISH

   %IF MSGNO>10 %START
      PRINTSTRING("Error: ")
      ->MESS(MSGNO-10+SE)
   %FINISH

   PRINTSTRING("Warning: ")
   ->MESS(MSGNO)

   !! warnings
MESS(W1): PRINTSTRING("unexpected end of input");   ->ENDWARN
MESS(W2): PRINTSTRING("missing ')'");               ->ENDWARN
MESS(W3): PRINTSTRING("missing '>'");               ->ENDWARN
MESS(W4): PRINTSTRING("missing '='");               ->ENDWARN
ENDWARN:
   WARNINGS=WARNINGS+1
   ->OUT

   !! errors
MESS(SE+1): PRINTSTRING("not recognised");          ->ENDERR
MESS(SE+2): PRINTSTRING("missing tag");             ->ENDERR
MESS(SE+3): PRINTSTRING("missing '->'");            ->ENDERR
MESS(SE+4): PRINTSTRING("invalid expression");      ->ENDERR
MESS(SE+5): PRINTSTRING("missing '('");             ->ENDERR
MESS(SE+6): PRINTSTRING("missing ')'");             ->ENDERR
MESS(SE+7): PRINTSTRING("missing, or invalid, expression"); ->ENDERR
MESS(SE+8): PRINTSTRING("invalid options");         ->ENDERR
MESS(SE+9): PRINTSTRING("missing '""'");            ->ENDERR
MESS(SE+10):PRINTSTRING("type conflict");            ->ENDERR
MESS(SE+11):PRINTSTRING("too many pins");            ->ENDERR
MESS(SE+12):PRINTSTRING("too few pins");             ->ENDERR
MESS(SE+13):PRINTSTRING("string too long");          ->ENDERR
MESS(SE+14):PRINTSTRING("missing END");              ->ENDERR
MESS(SE+15):PRINTSTRING("same PIN given for 2 terminals");  ->ENDERR
MESS(SE+16):PRINTSTRING("inout terminal has 2 PINs"); ->ENDERR
ENDERR:
   ERRORS=ERRORS+1
   %IF ERRORS>MAX ERRORS %START
      ! Too  many errors to cope with ! (so give up)
      MSGNO=D2
      THROW(1)
      ->START
   %FINISH
   ->OUT

   !! disasters
MESS(SD+1): PRINTSTRING("workspace full");          ->ENDDIS
MESS(SD+2): PRINTSTRING("too many errors");         ->ENDDIS
MESS(SD+3): PRINTSTRING("too many levels of DEFINE"); ->ENDDIS
ENDDIS:
   !! STOP IF JUST OUTPUT MESSAGE TO THE CONSOLE
   NEWLINE %AND STOP %IF MOUT=TELETYPE
OUT:
   ! must force a newline if listing things
   %IF LINE(1)#NL %START
      LINE(2)=LINE(1)
      LINE(1)=NL
      POS=2
      STMNT=STMNT-1;   ! Get the line numbers right
   %FINISH
   !! IF A DISASTER, THEN OUTPUT MESSAGE TO TERMINAL AND STOP
   %IF MSGNO>100 %START
      %IF MOUT#TELETYPE %START
         !! HAVEN'T OUTPUT TO CONSOLE YET
         SELOUT(TELETYPE)
         ->START
      %FINISH
   %FINISH
%END

%ROUTINE STATISTICS(%INTEGER STREAM)
   ! output a summary of statements compiled, no of errors,
   ! no of warnings, etc, on stream STREAM
   SELOUT(STREAM)
   SPACES(2)
   WRITE(STMNT,0)
   PRINTSTRING(" statements compiled");NEWLINE
   %IF SKIPPED>0 %START
      SPACES(2)
      PRINTSYMBOL('(')
      WRITE(SKIPPED,0);   PRINTSYMBOL('/');   WRITE(TOKENS,0)
      PRINTSTRING(" input ignored)")
      NEWLINE
   %FINISH
   %IF ERRORS>0 %START
      SPACES(2)
      WRITE(ERRORS,0)
      PRINTSTRING(" error")
      PRINTSYMBOL('s') %IF ERRORS>1
      NEWLINE
   %FINISH
   %IF WARNINGS>0 %START
      SPACES(2)
      WRITE(WARNINGS,0)
      PRINTSTRING(" warning")
      PRINTSYMBOL('s') %IF WARNINGS>1
      NEWLINE
   %FINISH
%END

!! macro interface
%RECORDFORMAT FMACRO(%STRING(255)%NAME TEXT, %INTEGER PCH, CH)
%CONSTINTEGER MAX MLEVEL=9
%RECORD(FMACRO)%ARRAY MACRO(1:MAX MLEVEL)
%OWNINTEGER MLEVEL=0,   MACRO EXPAND=NO,   MACRO CALL=YES

%ROUTINE RCH
  ! routine to read the next character from the input stream
  ! or from the currently selected macro
   %RECORD(FMACRO)%NAME M
   %INTEGER NCH

   %ROUTINE END FILE
      %SWITCH STREAM(1:3)

      ->STREAM(MIN)
STREAM(3):
      MIN=1
      STMNT=0
      TOKENS=0
      ->OUT
STREAM(1):
      MIN=2
      ->OUT
STREAM(2):
      MSG(W1)
      SELOUT(TELETYPE)
      PRINTSTRING("*Unexpected end of input");   NEWLINE
      STOP
OUT:
      SELECTINPUT(MIN)
   %END

   %ON %EVENT 3,END OF FILE %START
      END FILE
      ! fall through to rch again
   %FINISH

   %IF MLEVEL>0 %START
      ! in a macro
      M==MACRO(MLEVEL)
      %IF M_PCH=LENGTH(M_TEXT) %START
         ! at end of text so return
         CH=M_CH;       ! last ch read at prev level
         MLEVEL=MLEVEL-1
      %FINISHELSESTART
         ! get next macro char
         M_PCH=M_PCH+1
         CH=CHARNO(M_TEXT,M_PCH)
      %FINISH
      POS=POS+1 %AND LINE(POS)=CH %IF MACRO EXPAND=YES
   %FINISHELSESTART
      ! read from currently selected input stream min
      READSYMBOL(NCH)
      %IF CH=NL %START
         %IF NCH='@' %AND '0'<=NEXTSYMBOL<='9' %START
            ! read a line number
            READ(LINENO);SKIPSYMBOL
            READSYMBOL(NCH)
         %FINISHELSESTART
            ! no line numbers
            LINENO=-1
         %FINISH
      %FINISH
      CH=NCH
      POS=POS+1
      LINE(POS)=CH
   %FINISH
%END

%INTEGERFN CODEVAL
   ! This routine returns a coded value of a character
   ! '0'=0,...'9'=9,   'A'=10,... etc for use by RNUM
   ! In addition, CODEVAL>-2 only if the character is
   ! valid in a Tag. Thus CODEVAL =-1 if the character
   ! is not valid in a number, but is valid in a Tag
   %OWNSTRING(15) INTAG="!#%&'[].\_"
   %INTEGER I
   %RESULT=CH-'0' %IF '0'<=CH<='9'
   CH=CH-'a'+'A' %IF 'a'<=CH<='z';   !! convert to upper case
   %RESULT=CH-'A'+10 %IF 'A'<=CH<='Z'
   %FOR I=1,1,LENGTH(INTAG) %CYCLE
      %RESULT=-1 %IF CH=CHARNO(INTAG,I)
   %REPEAT
   %RESULT=-2
%END

%INTEGERFN RNUM(%INTEGER BASE)
   ! read a number in standard IMP77 format
   %INTEGER N,   CV
   N=0;   CV=CODEVAL
   %WHILE 0<=CV<BASE %CYCLE
      N=N*BASE+CV
      RCH;   CV=CODEVAL
   %REPEAT
   %IF CH='_' %THEN RCH %AND N=RNUM(N)
   %RESULT=N
%END

%ROUTINE MACRO AT(%STRING(255)%NAME TEXT)
   %RECORD(FMACRO)%NAME M
   MLEVEL=MLEVEL+1
   MSG(D3) %IF MLEVEL>MAX MLEVEL
   M==MACRO(MLEVEL)
   M_TEXT==TEXT
   M_PCH=0
   M_CH=CH
   POS=TOKENPOS-1 %IF MACRO EXPAND=YES
   TOKEN END=TOKENPOS
   CH=BLANK;   ! Fool NEXT ITEM
%END

%INTEGERFN NEXT ITEM
   ! Find the next significant character
   ! Ignore blanks, and usually ignore newlines
   %CYCLE
      %EXIT %IF CH>BLANK %OR (CH=NL %AND IGNORE NLS=NO)
      RCH
   %REPEAT
   %RESULT=CH
%END

%INTEGERFNSPEC EXPN
%RECORD(FTAG)%MAP %SPEC READTAG

%ROUTINE SKIP COMMENT
   RCH %UNTIL CH='$' %OR CH=NL
   PUT TOKEN(NULL)
   RCH
   TOKEN END=POS
%END

%ROUTINE READTOKEN
   ! Read the next token from the input stream
   ! We recognise pre-defined tokens, Tags, and Numbers.
   ! Comments are skipped, Macros are invoked, and compiler
   ! control tokens (COPTION etc) are absorbed.
   %SWITCH CONTROL(COPTION:NOGENERATE)
   %RECORD(FTAGDEF)%NAME TD

   ! count number of tokens read
   TOKENS=TOKENS+1

START:
   ! musn't output the token yet if in recovery mode and the
   ! last token was newline (NL only recognised in recovery mode)
   PUT TOKEN(NULL) %UNLESS TOKEN=EOL
   CH=NEXT ITEM
   TOKENPOS=POS

   !! skip any comments
   SKIP COMMENT %AND ->START %IF CH='$'

   %IF CODEVAL>-2 %START
      ! found a Tag
      TOKEN VALUE==READTAG;   ! TOKEN set as a side effect
      %IF TOKEN=A TAG %AND MACRO CALL=YES %START
         ! could be a macro call
         TD==TOKEN VALUE_TAGDEF
         %IF %NOT TD==RECORD(NULL) %START
            !  Tag is defined
            %IF TD_LEVEL&STYPE#0 %START
               ! got a macro definition
               MACRO AT(TD_TEXT)
               ->START
            %FINISH
         %FINISH
      %FINISH

      ->FIN
   %FINISH

   !! otherwise a separator
   TOKEN VALUE==RECORD(NULL)
   ! is it a null Tag?
   %IF CH='?' %THEN TOKEN=A TAG %AND TOKEN VALUE==RECORD(NULL) %C
   %ELSE TOKEN=CH
   RCH
   TOKEN END=POS
FIN:
   ! finished unless TOKEN is a compiler control token
   %RETURN %UNLESS COPTION<=TOKEN<=NOGENERATE
   ->CONTROL(TOKEN)

CONTROL(COPTION):
   READTOKEN
   CFLAGS=EXPN
   ->FIN

CONTROL(LISTON):
   ! Turn listing ON if not already On
   PUT TOKEN(NULL)
   %IF LISTING=NO %START
      LISTING=YES
      IGNORE NLS=NO
      CONTINUE LINE(BLANK) %UNLESS NEXT ITEM=NL
      IGNORE NLS=YES
   %FINISH
   ->START

CONTROL(LISTOFF):
   ! Turn listing OFF if curently ON
   PUT TOKEN(NULL);   ! CLEAR OUT LINE SO FAR
   LISTING=NO
   ->START

CONTROL(GENERATE):
   ! Turn macro expansion ON
   MACRO EXPAND=YES
   ->START

CONTROL(NOGENERATE):
   ! Turn macro expansion OFF
   MACRO EXPAND=NO
   ->START
%END

!! hashtable manipulation routines and hashtable
%RECORD(FTAG)%MAP READTAG
   ! Read a tag from the input on to the stack,
   ! and return its address on the stack
   %RECORD(FTAG)%NAME NEW,   OLD
   %INTEGER LEN,HASH
   %INTEGERNAME H

   NEW==RECORD(TOS);    ! map the Tag
   new_name=""; LEN=0;  HASH=0
   %CYCLE
      %EXIT %UNLESS CODEVAL>-2
      LEN=LEN+1
      HASH=HASH+CH
      new_name = new_name.tostring(ch) %if len <= 255
      RCH
   %REPEAT
   MSG(E13) %IF LEN>255

   !! now search hashtable for existing tags
   H==HASHTABLE(HASH&HASHTABLELEN)
   %WHILE H#NULL %CYCLE
      OLD==RECORD(H)
      %IF OLD_NAME=NEW_NAME %START
         TOKEN=OLD_TOKEN
         %RESULT==OLD
      %FINISH
      H==OLD_HNEXT
   %REPEAT

   !! define new tag
   H=TOS;            ! point to it
   NEW_HNEXT=NULL
   NEW_TAGDEF==RECORD(NULL)
   NEW_TOKEN=A TAG
   TOKEN=A TAG
   CLAIM(TAGLEN+(LEN+CPW)>>LCPW)
   %RESULT==NEW
%END

%ROUTINE CLEANUP(%INTEGER LEVEL)
   ! Clean up the dictionary by removing references
   ! to tag definitions, and tags, occurring at a
   ! lexical level greater than or equal to LEVEL
   %RECORD(FTAG)%NAME TAG
   %RECORD(FTAGDEF)%NAME TAGDEF
   %INTEGER I,   WTOS
   %OWNINTEGER ZERO=0
   %INTEGERNAME H,   HTOKEN

   HTOKEN==ZERO;   WTOS=TOS>>LAUPW
   %FOR I=0,1,HASHTABLELEN %CYCLE
      H==HASHTABLE(I);            ! for each hashtable entry
      %WHILE H#NULL %CYCLE;       ! with the same hash value
         TAG==RECORD(H)
         !! Remember where the current TAG is stored
         !! Relocate this if off top of stack frame
         HTOKEN==H %IF TAG==TOKEN VALUE
         TAGDEF==TAG_TAGDEF
         %CYCLE
            %EXIT %IF TAGDEF==RECORD(NULL)
            %EXIT %IF TAGDEF_LEVEL<LEVEL
            TAGDEF==TAGDEF_PREV
            TAG_TAGDEF==TAGDEF
         %REPEAT
         %IF H>>LAUPW>=WTOS %START
            !! TAG is off the top of the stack
            !! This can only happen when there is no TAGDEF
            H=TAG_HNEXT
         %ELSE
            H==TAG_HNEXT
         %FINISH
      %REPEAT
   %REPEAT
   !! Now relocate the current TAG, if required
   %IF ADDR(TOKEN VALUE)>>LAUPW>=WTOS %START
      !! only happens if tag is newly created ...
      TAG==RECORD(TOS)
      TAG_TAGDEF==RECORD(NULL)
      TAG_HNEXT=TOKENVALUE_HNEXT;   !! in case order of chaining is changed
      TAG_TOKEN=TOKENVALUE_TOKEN
      TAG_NAME=TOKENVALUE_NAME
      TOKEN VALUE==TAG
      HTOKEN=TOS
      CLAIM(TAGLEN+(LENGTH(TOKEN VALUE_NAME)+CPW)>>LCPW)
   %FINISH
%END

%STRING(255)%NAME VOUT

%ROUTINE PCH(%INTEGER CH)
   ! put out a character, possibly to a memory buffer
   ! count number of characters output if output is to
   ! the OBJECT file
   ! Control chars are output as ^CHAR.

   %IF %NOT VOUT==NULL STRING %START
      ! virtual output to core buffer
      vout = vout.tostring(ch)
   %FINISHELSESTART
      PRINTSYMBOL(CNTRLCHAR) %IF CH>=CNTRL
      PRINTSYMBOL(CH&127)
      OCOL=OCOL+1 %IF MOUT=OBJECT
   %FINISH
%END

%ROUTINE SEPARATE(%INTEGER CH)
   ! output a spacer character, possibly followed by a newline
   ! (if required by line overflow)
   PCH(CH) %UNLESS CH=0
   NEWLINE %AND OCOL=0 %IF OCOL>OLINELEN
%END

%ROUTINE PDEC(%INTEGER DEC,SEPARATOR)
   ! print out a decimal number, preceeded or followed
   ! by an appropriate spacer character

   SEPARATE(0-SEPARATOR) %IF SEPARATOR<0
   PCH('-') %AND DEC=0-DEC %IF DEC<0
   %IF VOUT==NULL STRING %START
      WRITE(DEC,0)
      OCOL=OCOL+2 %IF MOUT=OBJECT
   %ELSE
      VOUT=VOUT.ITOS(DEC,0)
   %FINISH
   SEPARATE(SEPARATOR) %IF SEPARATOR>0
%END

%ROUTINE PUT STR(%STRING(255)%NAME S, %INTEGER FLAG)
   ! put out a String, preceeded by its length
   ! if FLAG is YES
   %INTEGER LEN

   %IF S==NULL STRING %THEN LEN=0 %ELSE LEN=LENGTH(S)
   PDEC(LEN,':') %IF FLAG=YES
   %IF VOUT==NULL STRING %START
      PRINTSTRING(S) %UNLESS LEN=0
      OCOL=OCOL+LEN %IF MOUT=OBJECT
   %ELSE
      VOUT=VOUT.S %UNLESS LEN=0
   %FINISH
%END

%ROUTINE PUT TAG(%RECORD(FTAGDEF)%NAME TAGDEF)
   ! Put out a tag
   %IF %NOT TAGDEF==RECORD(NULL) %START
      PUT STR(TAGDEF_TAG_NAME,NO)
      ! put out the subscript if required
      %IF TAGDEF_SUBSCRIPT#UNSUBSCRIPTED %START
         PCH('<')
         PDEC(TAGDEF_SUBSCRIPT,0)
         PCH('>')
      %FINISH
   %FINISHELSESTART
      ! null Tag so print '?'
      PCH('?')
   %FINISH
   ! and output a newline if required (OBJECT file only)
   SEPARATE(0)
%END

%ROUTINE PUT AS STR(%RECORD(FTAGDEF)%NAME TAGDEF)
   ! put out a Tag as a String preceeded by its length
   %STRING(255) S
   S=""
   %IF %NOT TAGDEF==RECORD(NULL) %START
      ! output Tag to a memory buffer 
      VOUT==S
      PUT TAG(TAGDEF)
      VOUT==NULL STRING
   %FINISH
   ! and finally output the string
   PUT STR(S,YES)
%END

%RECORD(FTAGDEF)%MAP DEFINE TAG(%RECORD(FTAG)%NAME TAG,
                                 %INTEGER TYPE, SUBSCRIPT)
   ! Build a Tag definition  record for the tag pointed to by
   ! PTAG, of type TYPE, and subscript SUBSCRIPT.
   ! Maintain lexical LEVEL and check for type conflicts
   %RECORD(FTAGDEF)%NAME TAGDEF

   %RESULT==RECORD(NULL) %IF TAG==RECORD(NULL)
   TAGDEF==TAG_TAGDEF
   %WHILE %NOT TAGDEF==RECORD(NULL) %CYCLE
      %EXIT %IF TAGDEF_LEVEL<LEVEL
      ! at the correct level still
      %IF TAGDEF_SUBSCRIPT=SUBSCRIPT %START
         ! definition already exists at this level
         %IF TAGDEF_LEVEL&TYPE#0 %THEN %RESULT==TAGDEF
         ! else there is a type conflict
         MSG(E10) %UNLESS TYPE=UNAMETYPE %OR %C
            TAGDEF_LEVEL&UNAMETYPE#0
      %FINISH
      TAGDEF==TAGDEF_PREV
   %REPEAT

   ! build a new tag definition
   ! Flag as a global tag if begins with '.'
   TYPE=TYPE+GBLTYPE %IF CHARNO(TAG_NAME,1)='.'
   TAGDEF==RECORD(TOS)
   TAGDEF_TAG==TAG
   TAGDEF_PREV==TAG_TAGDEF
   TAGDEF_SPEC==RECORD(NULL)
   TAGDEF_LEVEL=LEVEL+TYPE
   TAGDEF_SUBSCRIPT=SUBSCRIPT
   TAG_TAGDEF==TAGDEF
   CLAIM(TAGDEFLEN)
   %RESULT==TAGDEF
%END

%ROUTINE READ KEYWORDS
   !  build dictionary of built-in keywords
   ! format is:  { "*" <Tag> <Number> NL }*
   READTOKEN
   %WHILE TOKEN='*' %CYCLE
      READTOKEN
      MSG(E2) %AND STOP %UNLESS TOKEN=A TAG
      READ(TOKEN VALUE_TOKEN)
      READTOKEN
   %REPEAT
%END

%STRING(255)%MAP RSTRING
   ! routine to read a string.
   ! Strings are either (1) enclosed in string quotes (") or
   !                    (2) are an arbitrary sequence of characters
   !                        terminated by NL, BLANK, COMMA, or ')'
   %INTEGER QUOTED,   LEN
   %STRING(255)%NAME S

START:
   CH=NEXT ITEM;   !! SKIP BLANKS ETC
   QUOTED=CH;   LEN=0;   S==STRING(TOS);  s = ""
   !! remove any preceding comments
   SKIP COMMENT %AND -> START %IF CH='$'
   RCH %IF CH='"'

   %CYCLE
      TOKENPOS=POS;         ! Maintain token position for error reports
      %IF QUOTED='"' %START
         ! String enclosed by " characters
         %IF CH=NL %THEN MSG(E9) %AND ->OUT
         %IF CH='"' %START
            RCH
            ! can be continued on next line of input
            %IF CH=NL %START
               PUT TOKEN(NULL);   ! clear input buffer so far
               %IF NEXT ITEM='"' %THEN ->AGAIN
               ->OUT
            %FINISH
            ->OUT %UNLESS CH='"'
         %FINISH
      %FINISHELSESTART
         ! not a quoted string
         %IF CH=NL %OR CH=',' %OR CH=')' %OR CH=BLANK %THEN ->OUT
      %FINISH
      LEN=LEN+1
      CH='|' %IF CH='^'
      CH=CH-'a'+'A' %IF (CFLAGS&NOSTRCONVERT=0) %AND ('a'<=CH<='z')
      s = s.tostring(ch) %if len <= 255
AGAIN:
      RCH
   %REPEAT
OUT:
   MSG(E13) %AND LEN = 255 %IF LEN>255
   ! and claim some workspace
   CLAIM((LEN+CPW)>>LCPW)
   READTOKEN;         ! to set next token for following parse
   %RESULT==S
%END

%ROUTINE DEFLIST
   !  define a list of tags
   ! format is : DEFLIST { Tag "=" String } { "," Tag "=" String }*
   %RECORD(FTAGDEF)%NAME TAGDEF

   %CYCLE
      MSG(E2) %AND ->RERR %UNLESS TOKEN=A TAG
      %IF NEXT ITEM='=' %THEN RCH %ELSE MSG(W4)
      TAGDEF==DEFINE TAG(TOKEN VALUE,STYPE,UNSUBSCRIPTED)
      MACRO CALL=YES
      TAGDEF_TEXT==RSTRING
      %EXIT %UNLESS TOKEN=','
      MACRO CALL=NO
      READTOKEN
   %REPEAT
   PARSE=OK
   %RETURN
RERR:
   PARSE=ERROR
%END

%INTEGERFN EXPN
   ! calculate the value of an expression
   ! unary '-' has highest priority
   ! otherwise '+' '-' '*' and '/' have equal precedence
   %INTEGER R,   OP,   VALUE
   %SWITCH ACT(0:4)

   R=0
   %IF TOKEN='-' %THEN OP=2 %ELSE OP=0
   %CYCLE
      %IF TOKEN='-' %THEN READTOKEN
      PARSE=ERROR %AND ->OUT %UNLESS TOKEN=A TAG
      MACRO AT(TOKEN VALUE_NAME)
      CH=NEXT ITEM
      VALUE=RNUM(10)
      ->ACT(OP)
ACT(0):
      R=VALUE
      ->NEXT
ACT(1):
      R=R+VALUE
      ->NEXT
ACT(2):
      R=R-VALUE
      ->NEXT
ACT(3):
      R=R*VALUE
      ->NEXT
ACT(4):
      PARSE=ERROR %AND ->OUT %IF VALUE=0
      R=R//VALUE
      ->NEXT
NEXT:
      READTOKEN
      %IF TOKEN='+' %START
         OP=1
      %FINISHELSESTART
         %IF TOKEN='-' %START
            OP=2
         %FINISHELSESTART
            %IF TOKEN='*' %START
               OP=3
            %FINISHELSESTART
               %IF TOKEN='/' %THEN OP=4 %ELSE %EXIT
            %FINISH
         %FINISH
      %FINISH
      READTOKEN
   %REPEAT
   PARSE=OK
OUT:
   %RESULT=R
%END

%INTEGERFN RECOVER
   !  Routine to recover from parsing errors
   ! there are two recovery points, known as GROUP1 and GROUP2
   ! GROUP1 is the start of a UNIT definition
   ! GROUP2 is anything inside a UNIT body that is not
   ! contained in GROUP1.
   %INTEGER R,   SAVE,   WAS,   TEMP

   IGNORE NLS = NO;   TEMP=TOKENS
   SAVE=LISTING;   LISTING=YES;   RECOVERING=YES
   %CYCLE
      WAS=TOKEN
      READTOKEN
AGAIN:
      %IF DEFINE<=TOKEN<=PACK %THEN R=GROUP1 %AND %EXIT
      %IF TOKEN=ROUTE %OR TOKEN=END %OR TOKEN=WIRE  %C
          %OR TOKEN=';' %THEN R=GROUP2 %AND %EXIT
      %IF TOKEN=EOL %START
         WAS=TOKEN
         READTOKEN
         R=GROUP2 %AND %EXIT %IF TOKEN=A TAG
         ->AGAIN
      %FINISH
   %REPEAT
   IGNORE NLS = YES
   LISTING=SAVE;   RECOVERING=NO
   PARSE=OK
   SKIPPED=SKIPPED+TOKENS-TEMP
   ! Number the next line unless just crossed a line boundary
   ! in which case it has already been numbered
   CONTINUE LINE('+') %UNLESS WAS=EOL
   %RESULT=R
%END

%RECORD(FTAGDEF)%MAP PSTAG(%INTEGER TYPE)
   ! read a possibly subscripted Tag
   %INTEGER SUBSCRIPT
   %RECORD(FTAG)%NAME TAG
   %RECORD(FTAGDEF)%NAME TAGDEF

   TAGDEF==RECORD(NULL)
   PARSE=FALSE %AND ->OUT %UNLESS TOKEN=A TAG
   TAG==TOKEN VALUE
   READTOKEN
   %IF TOKEN='<' %START
      ! subscripted
      READTOKEN
      SUBSCRIPT=EXPN
      %IF PARSE#OK %START
         MSG(E4)
         PARSE=ERROR
         ->OUT
      %FINISH
      %IF TOKEN='>' %THEN READTOKEN %ELSE MSG(W3)
   %FINISHELSESTART
      SUBSCRIPT=UNSUBSCRIPTED
   %FINISH
   ! define the Tag to be of type TYPE
   TAGDEF==DEFINE TAG(TAG,TYPE,SUBSCRIPT)
   PARSE=OK
OUT:
   %RESULT==TAGDEF
%END

%ROUTINE CHECK SPEC(%RECORD(FSPEC)%NAME INSTANCE)
   ! check that the instance pointed to by INSTANCE
   ! has a SPEC and corectly matches it.
   ! If not then the instance becomes a spec for future
   ! instances of the same name.
   %RECORD(FTAGDEF)%NAME TAGDEF
   %RECORD(FSPEC)%NAME SPEC
   %INTEGER I,   INFO,   TEMP,   NOSPEC
   %INTEGER DUMMIES
   %INTEGERNAME IINFO

   NOSPEC=YES
   TAGDEF==INSTANCE_NAMEDEF
   %WHILE %NOT TAGDEF==RECORD(NULL) %CYCLE
      ! for each lexical level of the instance
      ! escape if wrong Tag type
      %IF TAGDEF_LEVEL&UTYPE=0 %THEN ->CONTINUE

      SPEC==TAGDEF_SPEC
      %WHILE %NOT SPEC==RECORD(NULL) %CYCLE
         ! for each instance at this level
         NOSPEC=NO;   DUMMIES=0
         %IF SPEC_NT=INSTANCE_NT %START
            ! instance and spec have same no of terminals
            %FOR I=1,1,SPEC_NT %CYCLE
               INFO=SPEC_T(I)_INFO
               TEMP=INFO&INOUT;   ! input, output, or inout
               %IF SPEC_TYPE#0 %START
                 ! not an instance so invert signal types
                 INFO=(INFO!INOUT)-TEMP %IF TEMP=INPUT %OR TEMP=OUTPUT
               %FINISH
               IINFO==INSTANCE_T(I)_INFO
               IINFO=IINFO-(DUMMIES<<2)
               %IF TEMP=DUMMY %START
                  ! a dummy signal, so correct the instance
                  INSTANCE_T(INFO>>2)_INFO=INFO!INOUT
                  DUMMIES=DUMMIES+1;    ! count dummy signals
                  IINFO=INFO
               %FINISHELSESTART
                  ! check that terminal numbers and types match
                  %IF IINFO#INFO %AND %C
                      (IINFO!INOUT)#INFO %THEN ->NEXT SPEC
               %FINISH
            %REPEAT

            ! set no of inouts, no of outputs same as for SPEC
            INSTANCE_NOUT=SPEC_NOUT;   INSTANCE_NIO=SPEC_NIO

            ! found a spec that matches, so set default parms,
            ! option and pins.
            ! but not if the spec is an instance
            %RETURN %IF SPEC_TYPE=0
            %FOR I=1,1,MAX PARMS %CYCLE
               INSTANCE_PARM(I)==SPEC_PARM(I)
            %REPEAT
            INSTANCE_OPTION=SPEC_OPTION
            %FOR I=1,1,INSTANCE_NT %CYCLE
               INSTANCE_T(I)_PIN==SPEC_T(I)_PIN
            %REPEAT
            %RETURN
         %FINISH
NEXT SPEC:
         ! escape unless spec is generic
         ->OUT %UNLESS SPEC_TYPE&GENTYPE#0
         SPEC==SPEC_PREV
      %REPEAT
CONTINUE:
      TAGDEF==TAGDEF_PREV
      %EXIT %IF TAGDEF==RECORD(NULL)
   %REPEAT
OUT:
   THROW(1)
   ! set spec to be the instance if no spec was found
   %IF NOSPEC=YES %START
      INSTANCE_NAMEDEF_SPEC==INSTANCE
      PRINTSTRING("* no spec for ")
   %FINISHELSESTART
      PRINTSTRING("* wrong number of signals for ")
   %FINISH
   PUT TAG(INSTANCE_NAMEDEF)
   CONTINUE LINE('+')
   WARNINGS=WARNINGS+1
%END

%ROUTINE ADD CONNECTIONS(%RECORD(FSPEC)%NAME S,%INTEGER SUBNO)
   ! Add a list of connections to each signal name of
   ! an instance or header. Each connection is from subinstance
   ! SUBNO (0=enclosing UNIT).
   %RECORD(FTAGDEF)%NAME TAGDEF
   %RECORD(FFAN)%NAME FAN
   %RECORD(FTERMINAL)%NAME T,   IO
   %INTEGER I

   %FOR I=1,1,S_NT %CYCLE
      T==S_T(I)
      ! Don't add references to '?' (nowhere) signals
      ! or to dummy signals if a UNIT definition
      !! or if dummy signal and inout have same name
      %CONTINUE %IF T_NAME==RECORD(NULL)
      IO==S_T(T_INFO>>2)
      %CONTINUE %IF T_INFO&INOUT=DUMMY %AND %C
                   (S_TYPE#0 %OR IO_NAME==T_NAME)
      ! not a '?' nor a dummy terminal
      FAN==RECORD(TOS)
      CLAIM(FANLEN)
      %IF T_INFO&INOUT=DUMMY %AND S_TYPE=0 %AND %NOT IO_NAME==T_NAME %c
         %AND %NOT IO_NAME==RECORD(NULL) %START
         !! two nets get WIREd together
         !! but only if two different, non-null (?) nets are
         !! specified for the output (T_) and input (IO_)
         !! sides of the input-output.
         TAGDEF==IO_NAME
         FAN_TAGDEF==T_NAME
         FAN_INFO=0
      %ELSE
         TAGDEF==T_NAME
         FAN_SUBNO=SUBNO
         FAN_INFO=T_INFO
      %FINISH
      FAN_NEXT==TAGDEF_FAN
      TAGDEF_FAN==FAN
   %REPEAT
%END

%ROUTINE PUT HEAD(%RECORD(FSPEC)%NAME H)
   ! output a header (UNIT or instance) pointed to by PSPEC
   ! output is to intermediate-code.
   %RECORD(FTERMINAL)%NAME T
   %INTEGER I
   %STRING(255)%NAME P

   SELOUT(OBJECT)
   PCH(CNTRL+'H')
   PDEC(H_OPTION,BLANK)
   PDEC(H_NIN,BLANK);   PDEC(H_NOUT,BLANK)
   PDEC(H_NIO,BLANK);   PDEC(H_NT,BLANK)
   PUT AS STR(H_UNAME)
   PUT AS STR(H_NAMEDEF)

   ! output terminal information
   %FOR I=1,1,H_NT %CYCLE
      T==H_T(I)
      PCH(CNTRL+'T')
      PDEC(T_INFO,BLANK)
      PUT STR(T_PIN,YES)
      PUT AS STR(T_NAME)
   %REPEAT

   ! output the parameters (if any)
   %FOR I=1,1,MAX PARMS %CYCLE
      P==H_PARM(I)
      %IF %NOT P==NULL STRING %START
         PCH(CNTRL+'P')
         PDEC(I,BLANK)
         PUT STR(P,YES)
      %FINISH
   %REPEAT

   PCH(CNTRL+'G');   !! end of header

   I=H_TYPE&7;   ! Type of header
   %IF I=1 %OR I=5 %START
      ! SPEC, GENERIC SPEC, PACK, or GENERIC PACK
      PCH(CNTRL+'E');   NEWLINE;   OCOL=0
   %FINISH

   ! and back to the listing file
   SELOUT(LISTFILE)
%END

%ROUTINE PUT BODY(%RECORD(FUNIT)%NAME UNIT)
   ! output a UNIT definition. All subinstances, Nets, and Routes.
   ! Check for unused Signals (Nets) on the fly.
   ! Output is to the OBJECT file.
   %RECORD(FSPEC)%NAME S
   %RECORD(FROUTE)%NAME ROUTE
   %RECORD(FQUAD)%NAME Q
   %RECORD(FTERMINAL)%NAME T
   %RECORD(FTAGDEF)%NAME TAGDEF
   %INTEGER I,   WARNS,   F,   FANIN,   FANOUT

%ROUTINE PUT FAN(%RECORD(FTAGDEF)%NAME TAGDEF)
   %RECORD(FFAN)%NAME NEXT, FAN, HEAD, ALIAS
   %INTEGER NF
   TAGDEF_LEVEL=TAGDEF_LEVEL!SCANNED;      !! mark as done
   FAN==TAGDEF_FAN
   HEAD==RECORD(NULL);   ALIAS==RECORD(NULL);   NF=0
   %WHILE %NOT FAN==RECORD(NULL) %CYCLE
      NEXT==FAN_NEXT
      %IF FAN_INFO#0 %START
         !! not an ALIAS record
         NF=NF+1
         FANIN=FANIN+1 %IF FAN_INFO&INPUT#0
         FANOUT=FANOUT+1 %IF FAN_INFO&OUTPUT#0
         !! reverse the list order
         FAN_NEXT==HEAD
         HEAD==FAN
      %ELSE
         !! ALIAS element
         FAN_NEXT==ALIAS
         ALIAS==FAN
      %FINISH
      FAN==NEXT
   %REPEAT
   TAGDEF_FAN==HEAD

   PCH(CNTRL+'A')
   PUT AS STR(TAGDEF)
   PDEC(NF,0)
   %WHILE %NOT HEAD==RECORD(NULL) %CYCLE
      PDEC(HEAD_SUBNO,0-BLANK)
      PDEC(HEAD_INFO>>2,0-BLANK)
      HEAD==HEAD_NEXT
   %REPEAT

   F=F+NF;   !! return total fan so far

   !! deal with ALIASed nets (WIREd together)
   %WHILE %NOT ALIAS==RECORD(NULL) %CYCLE
      TAGDEF==ALIAS_TAGDEF
      ALIAS==ALIAS_NEXT
      %CONTINUE %IF TAGDEF_LEVEL&SCANNED#0
      !! not yet output
      PUT FAN(TAGDEF)
   %REPEAT
%END

   WARNS=0
   S==UNIT_INSTANCES
   SELOUT(OBJECT)

   ! output the subinstances - headers have already been output
   %FOR I=0,1,UNIT_NSUBS %CYCLE
      ! output number-of-subinstances in place of UNIT-header
      %IF I=0 %THEN PDEC(UNIT_NSUBS,0-(CNTRL+'J')) %ELSE PUT HEAD(S)
      S==S_NEXT
   %REPEAT

   ! now output the nets
   SELOUT(OBJECT);      ! reset to LISTFILE by PUT HEAD
   S==UNIT_INSTANCES
   %WHILE %NOT S==RECORD(NULL) %CYCLE
      ! for each subinstance and unit definition
      ! for each terminal of the instance
      %FOR I=1,1,S_NT %CYCLE
         T==S_T(I)
         ! Don't output references to '?' (nowhere) signals
         ! or to dummy signals from UNIT definitions
         %CONTINUE %IF T_NAME==RECORD(NULL) %OR %C
                      (S_TYPE#0 %AND T_INFO&INOUT=DUMMY)
         TAGDEF==T_NAME
         %CONTINUE %IF TAGDEF_LEVEL&(SCANNED+ALIASED)#0
         !  not a '?' or a dummy signal
         F=0;   FANIN=0;   FANOUT=0
         PCH(CNTRL+'N')
         PUT FAN(TAGDEF)
         %IF (F=1 %OR FANIN=0 %OR FANOUT=0) %AND %C
            UNIT_NSUBS>0 %AND %C
            TAGDEF_LEVEL&GBLTYPE=0 %START
            ! Tag has no fanin, no fanout, or is unused
            ! and is not a global tag
            SELOUT(LISTFILE)
            THROW(1)
            %IF F=1 %START
               ! unused?
               PRINTSTRING("* unused? ")
            %FINISHELSESTART
               %IF FANOUT=0 %START
                  PRINTSTRING("* no fan-in? ")
               %FINISHELSESTART
                  PRINTSTRING("* no fan-out? ")
               %FINISH
            %FINISH
            PUT TAG(T_NAME)
            WARNS=WARNS+1
            SELOUT(OBJECT)
         %FINISH

      %REPEAT
      S==S_NEXT
   %REPEAT

   ! output the route information
   ROUTE==UNIT_ROUTES
   %WHILE %NOT ROUTE==RECORD(NULL) %CYCLE
      ! for each route in the list
      PCH(CNTRL+'R')
      ! first output the Route name
      PUT AS STR(ROUTE_NAME)
      ! then the number of coordinate-quadruples
      PDEC(ROUTE_NQUADS,0)
      ! then the coordinates themselves
      %FOR I=1,1,ROUTE_NQUADS %CYCLE
         Q==ROUTE_QUAD(I)
         %FOR F=1,1,4 %CYCLE
            PDEC(Q_COORD(F),0-BLANK)
         %REPEAT
      %REPEAT
      ROUTE==ROUTE_NEXT
   %REPEAT

   ! end of UNIT, CHIP, or BOARD
   PCH(CNTRL+'E');   NEWLINE;   OCOL=0
   SELOUT(LISTFILE)
   %IF WARNS#0 %START
      WARNINGS=WARNINGS+WARNS
      CONTINUE LINE('+')
   %FINISH
%END

%ROUTINE WIRELIST
   ! Parse a WIRE stmnt, and alias the 
   ! appropriate Signals.
   ! Format is WIRE {name} ( namelist ) -> (WIRELIST)
   %RECORD(FTAGDEF)%NAME T,   UNAME
   %RECORD(FTAGDEF)%NAME %ARRAY NAME(1:MAX WNAMES)
   %RECORD(FFAN)%NAME FAN
   %INTEGER I,   N,   NEED RHS

   %ROUTINE PARSE NAMELIST
      %INTEGER BRA
      %IF TOKEN='(' %THEN READTOKEN %AND BRA=YES %ELSE BRA=NO
      %CYCLE
         N=N+1
         NAME(N)==PSTAG(PTYPE)
         MSG(E2) %IF PARSE=NO
         ->RERR %UNLESS PARSE=OK
         %EXIT %UNLESS TOKEN=','
         READTOKEN
      %REPEAT
      %IF BRA=YES %START
         %IF TOKEN=')' %THEN READTOKEN %ELSE MSG(W2)
      %FINISH
   RERR:
   %END

   UNAME==PSTAG(PTYPE);         ! unique net name ?
   N=0
   %IF %NOT UNAME==RECORD(NULL) %START
      ! yes, got one
      N=1
      NAME(1)==UNAME
   %FINISH

   %IF TOKEN='(' %START
      PARSE NAMELIST
      ->RERR %UNLESS PARSE=OK
      NEED RHS=NO
   %ELSE
      NEED RHS=YES
   %FINISH
   %IF TOKEN='-' %START
      !! GOT AN RHS ?
      READTOKEN
      ->MSGE3 %UNLESS TOKEN='>'
      READTOKEN
      PARSE NAMELIST
      ->RERR %UNLESS PARSE=OK
   %ELSE
      !! NO RHS
      ->MSGE3 %IF NEED RHS=YES
   %FINISH

   PARSE=OK
   UNAME==NAME(1)

   %FOR I=2,1,N %CYCLE
      T==NAME(I)
      %CONTINUE %IF T==UNAME
      !! got another net to WIRE
      FAN==RECORD(TOS)
      CLAIM(FANLEN)
      T_LEVEL=T_LEVEL!ALIASED
      FAN_TAGDEF==T
      FAN_INFO=0
      FAN_NEXT==UNAME_FAN
      UNAME_FAN==FAN
   %REPEAT
   ->OUT
MSGE3:
   MSG(E3)
RERR:
   PARSE=ERROR
OUT:
%END

%ROUTINE UDEF
!**********************************************
!*                                            *
!* MAIN RECURSIVE ROUTINE FOR DEFINING UNITS  *
!*                                            *
!**********************************************
%INTEGER OLDTOS,   R,   TYPE
%RECORD(FUNIT) UNIT
%RECORD(FSPEC)%NAME INST

%ROUTINE ROUTELIST
   ! Parse a ROUTE statement and build a list of
   ! coordinate quadruples.
   %RECORD(FROUTE)%NAME ROUTE
   %RECORD(FROUTE) TEMP
   %RECORD(FQUAD)%NAME QUAD
   %INTEGER I,   NQUADS

   %CYCLE
      TEMP_NAME==PSTAG(UNAMETYPE)
      MSG(E2) %IF PARSE=FALSE
      ->RERR %UNLESS PARSE=OK

      MSG(E5) %AND ->RERR %UNLESS TOKEN='('

      NQUADS=0
      READTOKEN
      %CYCLE
         MSG(E5) %AND ->RERR %UNLESS TOKEN='('
         READTOKEN

         ! read a 4-tuple
         NQUADS=NQUADS+1
         QUAD==TEMP_QUAD(NQUADS)
         %FOR I=1,1,4 %CYCLE
            QUAD_COORD(I)=EXPN
            MSG(E7) %AND ->RERR %UNLESS PARSE=OK
            %EXIT %IF I=4
            READTOKEN %IF TOKEN=','
         %REPEAT

         %UNLESS TOKEN='(' %OR TOKEN=')' %OR TOKEN=',' %START
            MSG(E6)
            ->RERR
         %FINISH

         %UNLESS TOKEN=')' %START
            MSG(W2)
            READTOKEN %IF TOKEN=','
         %FINISHELSESTART
            READTOKEN
            %EXIT %IF TOKEN=')'
            READTOKEN %IF TOKEN=','
         %FINISH
      %REPEAT

      ! remember the route information now
      ROUTE==RECORD(TOS)
      ROUTE_NEXT==UNIT_ROUTES
      UNIT_ROUTES==ROUTE
      CLAIM(ROUTELEN+NQUADS*QUADLEN)
      ROUTE_NAME==TEMP_NAME
      ROUTE_NQUADS=NQUADS

      ! copy the route info from temporary workspace
      %FOR I=1,1,NQUADS %CYCLE
         ROUTE_QUAD(I)=TEMP_QUAD(I)
      %REPEAT

      READTOKEN
      %EXIT %UNLESS TOKEN=','
      ! continue with another ROUTE
      READTOKEN
   %REPEAT
   PARSE=OK
   %RETURN
RERR:
   PARSE=ERROR
%END

%RECORD(FSPEC)%MAP UHEAD(%INTEGER HEADTYPE, TYPE)
   ! Parse a UNIT header or an instance
   ! HEADTYPE is 0 for an instance
   %INTEGER BRA,   WAS,   I,   N,   ABORT, NIN, NOUT, NIO, NT
   %SWITCH CASE(OPTION:PLAST)
   %RECORD(FSPEC)%NAME SPEC
   %RECORD(FTAGDEF)%NAME %ARRAY SIGNALS(1:MAX SIGNALS)
   %RECORD(FTAGDEF)%NAME UNAME,   NAMEDEF

   %ROUTINE CONLIST
      ! Parse a connection list
      ! References to Signal names are stored (temporarily)
      ! on the workstack.
      %RECORD(FTAG)%NAME TAG
      %INTEGER SUBSCRIPT,   LOWER,   UPPER,   INC
      !! Count total number of signals in Global NT
      %CYCLE
         MSG(E2) %AND ->RERR %UNLESS TOKEN=A TAG
         TAG==TOKEN VALUE
         READTOKEN
         %IF TOKEN='<' %START
            %CYCLE
               READTOKEN
               LOWER=EXPN
               UPPER=LOWER
               MSG(E4) %AND ->RERR %UNLESS PARSE=OK
               %IF TOKEN=':' %START
                  READTOKEN
                  UPPER=EXPN
                  MSG(E4) %AND ->RERR %UNLESS PARSE=OK
               %FINISH

               ! semantic processing
               %IF LOWER<=UPPER %THEN INC=1 %ELSE INC=-1
               ! Remember references to Tagdefs
               %FOR SUBSCRIPT=LOWER,INC,UPPER %CYCLE
                  NT=NT+1
                  SIGNALS(NT)==DEFINE TAG(TAG,PTYPE,SUBSCRIPT)
               %REPEAT

               %EXIT %UNLESS TOKEN=','
            %REPEAT

            %IF TOKEN='>' %THEN READTOKEN %ELSE MSG(W3)
         %FINISHELSESTART
            NT=NT+1
            SIGNALS(NT)==DEFINE TAG(TAG,PTYPE,UNSUBSCRIPTED)
         %FINISH

         %EXIT %UNLESS TOKEN=','
         READTOKEN
      %REPEAT
      PARSE=OK
      ->OUT
   RERR:
      PARSE=ERROR
   OUT:
   %END

   %ROUTINE RHS
      ! Parse the Right Hand  Side of an instance etc
      ! (I.E. '->' and what follows
      %INTEGER BRA

      %IF TOKEN#'-' %THEN ->MSGE3
      READTOKEN
      %IF TOKEN#'>' %THEN ->MSGE3
      READTOKEN
      %IF TOKEN='(' %THEN BRA=YES %AND READTOKEN %ELSE BRA=NO

      CONLIST
      %IF PARSE#OK %THEN ->RERR

      %IF BRA=YES %START
         %IF TOKEN=')' %THEN READTOKEN %ELSE MSG(W2)
      %FINISH

      PARSE=OK
      ->OUT
   MSGE3:
      !! Don't check for missing RHS if CFLAGS
      !! has the appropriate option set. This
      !! is a fiddle for BOARDS with no inputs and
      !! no outputs.
      %IF CFLAGS&NOSIGNALS#0 %THEN PARSE=OK %AND ->OUT
      MSG(E3)
   RERR:
      PARSE=ERROR
   OUT:
   %END

   %ROUTINE COPY TERMINAL(%INTEGER TNO,TYPE)
      ! copy a Terminal (Signal) NAME REFERENCE
      ! to permanent storage on the stack within a SPEC record.
      ! Input-outputs are dealt with at this stage.
      ! semantic routine - no parsing
      %RECORD(FTERMINAL)%NAME T,   T1
      %INTEGER I,   INFO

      ! GRAB THE TERMINAL REFERENCE
      T==SPEC_T(TNO)
      T_NAME==SIGNALS(TNO)
      T_PIN==NULL STRING
      %IF HEADTYPE=INSTANCE %THEN INFO=TYPE  %C
      %ELSE INFO=INOUT-TYPE
      T_INFO=INFO+(TNO-NIO)<<2

      ! deal with the possibility of an input-output
      %IF HEADTYPE=DEFINITION %AND TYPE=OUTPUT %C
         %AND %NOT T_NAME==RECORD(NULL) %START
         ! search list of input terminals
         ! for one of the same name
         %FOR I=1,1,NIN %CYCLE
            T1==SPEC_T(I)
            %IF T1_NAME==T_NAME %START
               ! found an input-output
               T_INFO=DUMMY+I<<2
               T1_INFO=INOUT+I<<2
               NIO=NIO+1
               %EXIT
            %FINISH
         %REPEAT
      %FINISH
    %END

   !**************************************************
   !*                                                *
   !*   START  OF  UHEAD  PROPER                     *
   !*                                                *
   !**************************************************

   SPEC==RECORD(NULL)
   %IF TOKEN=A TAG %START
      ! could have a unique name
      %IF NEXT ITEM=':' %START
         ! does have a unique name
         UNAME==DEFINE TAG(TOKEN VALUE,UNAMETYPE,UNSUBSCRIPTED)
         READTOKEN;   ! skip ':'
         READTOKEN;   !  read the next token
      %FINISHELSESTART
         UNAME==RECORD(NULL)
      %FINISH
   %FINISH

   ! get the name of the UNIT, instance, etc
   %IF %NOT TOKEN=A TAG %START
      LEVEL=LEVEL+ONE %IF HEADTYPE=DEFINITION
      MSG(E2)
      ->RERR
   %FINISH
   NAMEDEF==DEFINE TAG(TOKEN VALUE,UTYPE,UNSUBSCRIPTED)
   READTOKEN

   ! Increment lexical level after the UNIT name has been read
   LEVEL=LEVEL+ONE %IF HEADTYPE=DEFINITION

   NT=0
   %IF TOKEN='(' %START
      READTOKEN
      CONLIST
      NIN=NT
      %IF PARSE#OK %THEN ->RERR
      %IF TOKEN=')' %THEN READTOKEN %ELSE MSG(W2)

      NOUT=0
      %IF TOKEN='-' %START
         RHS
         NOUT=NT-NIN
         ->RERR %UNLESS PARSE=OK
      %FINISH
   %ELSE
      NIN=0
      RHS
      NOUT=NT
      ->RERR %UNLESS PARSE=OK
   %FINISH

   !! build a UNIT spec - all semantic processing
   SPEC==RECORD(TOS)
   %IF HEADTYPE=DEFINITION %START
      SPEC_PREV==NAMEDEF_SPEC
      NAMEDEF_SPEC==SPEC
   %FINISHELSESTART
      SPEC_PREV==RECORD(NULL)
   %FINISH

   SPEC_NEXT==RECORD(NULL)
   SPEC_UNAME==UNAME;   SPEC_NAMEDEF==NAMEDEF
   SPEC_TYPE=TYPE
   SPEC_OPTION=0

   ! copy terminals (Signals) from temporary workspace
   ! into the SPEC record. Deal with input-outputs on the fly
   NIO=0
   %FOR I=1,1,NIN %CYCLE
      COPY TERMINAL(I,INPUT)
   %REPEAT
   %FOR I=NIN+1,1,NT %CYCLE
      COPY TERMINAL(I,OUTPUT)
   %REPEAT

   NOUT=NOUT-NIO
   SPEC_NIN=NIN;   SPEC_NOUT=NOUT
   SPEC_NIO=NIO;   SPEC_NT=NT
   CLAIM(SPECLEN+TERMINALLEN*NT)

   ! set parameters to null before parsing PARMS
   %FOR I=1,1,MAX PARMS %CYCLE
      SPEC_PARM(I)==NULL STRING
   %REPEAT

   !  CHECK SPEC sets default parms, option, and pins as a side effect
   CHECK SPEC(SPEC) %IF HEADTYPE=INSTANCE

   ! look for and process PARMS
   %CYCLE
      %EXIT %UNLESS OPTION<=TOKEN<=PLAST
      WAS=TOKEN

      %IF NEXT ITEM='(' %THEN READTOKEN %AND BRA=YES %ELSE BRA=NO

      ->CASE(WAS)

CASE(OPTION):
      READTOKEN
      SPEC_OPTION=EXPN
      MSG(E8) %AND ->RERR %UNLESS PARSE=OK
      ->CONTINUE

CASE(PINS):
      N=0;   ABORT=NO
      %CYCLE
         N=N+1 %UNLESS ABORT=YES
         CH=NEXT ITEM
         %IF N>NT %START
            MSG(E11)
            ABORT=YES
            N=NT
         %FINISH
         SPEC_T(N)_PIN==RSTRING
         %EXIT %UNLESS TOKEN=','
      %REPEAT
      MSG(E12) %AND ->RERR  %UNLESS N=NT
      !! Now check that each terminal has a unique pin, except
      !! for input-outputs, which must have the appropriate pin
      %FOR N=1,1,NT-1 %CYCLE
        %FOR I=N+1,1,NT %CYCLE
          %IF SPEC_T(I)_PIN=SPEC_T(N)_PIN %THEN %START
            %UNLESS SPEC_T(I)_INFO>>2 = N %THEN MSG(E15) %AND ->RERR
          %FINISH %ELSE %START
            %IF SPEC_T(I)_INFO>>2 = SPEC_T(N)_INFO>>2 %THEN %C
                MSG(E16) %AND ->RERR
          %FINISH
        %REPEAT
      %REPEAT
      ->CONTINUE

CASE(AT):
CASE(ON):
CASE(PACKAGE):
CASE(SUBPACK):
CASE(DELAY):
CASE(VALUE):
CASE(SIZE):
CASE(PLACE):
CASE(P9):
CASE(PLAST):

      !!  note that these parameters are ordered alphabetically
      !!  as above, and numbered contiguously from AT
      CH=NEXT ITEM
      SPEC_PARM(WAS-AT+1)==RSTRING
      ->CONTINUE

CONTINUE:
      %IF BRA=YES %START
         %IF TOKEN=')' %THEN READTOKEN %ELSE MSG(W2)
      %FINISH
   %REPEAT

   PARSE=OK
   UNIT_NSUBS=UNIT_NSUBS+1 %IF HEADTYPE=INSTANCE
   ADD CONNECTIONS(SPEC,UNIT_NSUBS)

   %IF HEADTYPE=DEFINITION %START
      ! Put out header unless a SPEC and not required
      %UNLESS (SPEC_TYPE=1 %OR SPEC_TYPE=1+GENTYPE) %AND %C
               CFLAGS&PUT SPECS=0 %START
         SELOUT(OBJECT)
         PCH(CNTRL+'U')
         PDEC(SPEC_TYPE,0)
         PUT HEAD(SPEC)
      %FINISH
   %FINISH
   ->OUT
RERR:
   PARSE=ERROR
OUT:
   %RESULT==SPEC
%END

   !!*********************************************
   !!                                            *
   !! START OF MAIN UNIT DEFINITION ROUTINE      *
   !!                                            *
   !!*********************************************

   TYPE=0
   UNIT_INSTANCES==RECORD(NULL)
   UNIT_ROUTES==RECORD(NULL)
   UNIT_NSUBS=0

   %IF TOKEN=';' %THEN READTOKEN %AND ->OUT

   !! DEFINE stmnt
   %IF TOKEN=DEFINE %START
      MACRO CALL=NO;   ! no macro substitution in DEFINE stmnts
      READTOKEN
      DEFLIST
      MACRO CALL=YES
      PARSE=ERROR %UNLESS PARSE=OK
      ->OUT
   %FINISH

   !! GENERIC something?
   %IF TOKEN=GENERIC %START
      TYPE=GENTYPE
      READTOKEN
   %FINISH

   TYPE=TYPE+TOKEN-A SPEC+1
   OLDTOS=TOS;   !! RESET BY UHEAD TO SOMETHING MORE SENSIBLE

   !! SPEC ?
   %IF TOKEN=A SPEC %OR TOKEN=PACK %START
      READTOKEN
      UNIT_INSTANCES==UHEAD(DEFINITION,TYPE)
      ->RERR %UNLESS PARSE=OK
      OLDTOS=TOS
      ->ROK
   %FINISH

   !!  CHIP, UNIT, or BOARD ?
   %IF TOKEN=CHIP %OR TOKEN=A UNIT %OR TOKEN=BOARD %START
      ! UNIT, CHIP, and BOARD are numbered consecutively
      ! from SPEC+1
      READTOKEN
      UNIT_INSTANCES==UHEAD(DEFINITION,TYPE)
      ->RERR %IF PARSE=ERROR
      OLDTOS=TOS %IF CFLAGS&FORGET=0

      !! body of UNIT definition
      INST==UNIT_INSTANCES
      %CYCLE
         ! is it a UNIT definition next ?
         UDEF
         ->AGAIN %IF PARSE=OK;       ! yes it is
         ->GP2 %IF PARSE=FALSE;      ! no, so try ROUTE, END, etc

         !!error
RETRY:
         R=RECOVER
         ->AGAIN %IF R=GROUP1;     ! UNIT DEF, etc
         ->GP2 %IF R=GROUP2;       ! ROUTE, END, instance

GP2:
         !! ROUTE stmnt ?
         %IF TOKEN=ROUTE %START
            READTOKEN
            ROUTELIST
            %IF PARSE=OK %THEN ->AGAIN %ELSE ->RETRY
         %FINISH

         !! instance ?
         %IF TOKEN=A TAG %START
            INST_NEXT==UHEAD(INSTANCE,0)
            %IF PARSE=OK %THEN INST==INST_NEXT %AND-> AGAIN %ELSE ->RETRY
         %FINISH

         !! WIRE stmnt ?
         %IF TOKEN=WIRE %START
            READTOKEN
            WIRELIST
            %IF PARSE=OK %THEN ->AGAIN %ELSE ->RETRY
         %FINISH

         %IF TOKEN=';' %THEN READTOKEN %AND ->AGAIN

         !! end of UNIT ?
         %IF TOKEN=END %START
            PUT BODY(UNIT)
            DUMP STACK %IF CFLAGS&DUMP2#0
            READTOKEN
            ->ROK
         %FINISH

         !! else error - not a valid unit body
         %IF TOKEN=FINISH %THEN MSG(E14) %ELSE MSG(E1)
         ->RETRY
AGAIN:
      %REPEAT
   %FINISHELSESTART
      !! not a unit definition
      PARSE=FALSE
      ->OUT
   %FINISH
ROK:
   PARSE=OK
   ->FIN
RERR:
   PARSE=ERROR
FIN:
   TOS=OLDTOS
   CLEANUP(LEVEL)
   LEVEL=LEVEL-ONE
OUT:
%END

!*****************************************
!*                                       *
!*     ESDL   mainline                   *
!*                                       *
!*****************************************

!! initialisation
TOS=ADDR(STACK(0))
STACKTOP=ADDR(STACK(STACKLEN))>>LAUPW
NULL STRING==STRING(NULL)
VOUT==NULL STRING

RETURN CODE=DEF STREAMS(CLIPARAM,DEFAULTS)
->OUT %IF RETURN CODE#1

SELOUT(OBJECT)
PCH(CNTRL+'S');   PDEC(0,0)
SELECTINPUT(MIN);   SELOUT(LISTFILE)
NEWLINE;            SPACES(12)
PRINTSTRING(VERSION);   NEWLINES(2)

!! read in the keywords
READ KEYWORDS
DUMP STACK %IF CFLAGS&DUMP1#0
LEVEL=ONE

!! and process the input text
%CYCLE
   PUT TOKEN(NULL) %AND STOP %IF TOKEN=FINISH
   UDEF
   ->LOOP %IF PARSE=OK
   MSG(E1) %IF PARSE=FALSE
   %WHILE RECOVER#GROUP1 %CYCLE
      ! note side effect of recover
   %REPEAT
LOOP:
%REPEAT

OUT:
%ENDOFPROGRAM
