!! FLATTEN program to expand ESDL descriptions 05/11/79
!! V3.2 [01/03/83]: mods for IMP8
%BEGIN
%CONSTSTRING(31) VERSION="FLATTEN version 3.2 (APM)"

%systemstring (255) %fnspec itos(%integer v,p)
%EXTERNALINTEGERFNSPEC DEF STREAMS(%STRING(127) STREAMS, DEFAULTS)
%INTEGER RETURN CODE
%OWNSTRING(23) DEFAULTS=".EIC,.LIB/%I1.FIC"

!!*******************************************************
!! Program to expand and link an ESDL I-code description*
!! The description to be expanded is read from stream 1 *
!! Any references to UNITs not described in this I-code *
!! can be resolved from a library of UNITs provided on  *
!! stream 2. Only those UNITs actually referenced will  *
!! be stored or used.                                   *
!!*******************************************************

%recordformatspec ftagdef
%RECORDFORMAT FTAG(%STRING(255)%NAME NAME, %RECORD(FTAGDEF)%NAME TAGDEF,
                   %INTEGER MODIFIER, HNEXT)
%CONSTINTEGER TAGLEN=4

%recordformatspec funit
%RECORDFORMAT FTAGDEF(%INTEGER LEVEL,  REFS, %RECORD(FUNIT)%NAME UNIT,
                      %RECORD(FTAGDEF)%NAME PREV)
%CONSTINTEGER TAGDEFLEN=4

%RECORDFORMAT FCOMMENT(%RECORD(FCOMMENT)%NAME NEXT, %STRING(255) TEXT)
%CONSTINTEGER COMMENTLEN=1

%recordformatspec fnet
%RECORDFORMAT FTERMINAL(%INTEGER INFO,
                        %RECORD(FNET)%NAME NET, 
                        %RECORD(FTAG)%NAME PIN, NAME)
%CONSTINTEGER TERMINALLEN=4

%CONSTINTEGER MAX PARMS=8
%RECORDFORMAT FHEAD(%RECORD(FTAGDEF)%NAME TAGDEF,
                    %RECORD(FCOMMENT)%NAME COMMENTS,
                    %INTEGER FLAGS, OFFSET,
                    %INTEGER OPTIONS, NIN, NOUT, NIO, NT,
                    %RECORD(FTAG)%NAME UNAME, NAME,
                    %RECORD(FTAG)%NAME %ARRAY PARM(1:MAX PARMS),
                    %RECORD(FTERMINAL)%ARRAY T(1:999))
%CONSTINTEGER HEADLEN=11+MAXPARMS

%RECORDFORMAT FFANEL(%INTEGER SUBNO, TNO)
%CONSTINTEGER FANLEN=2

%RECORDFORMAT FNET(%RECORD(FNET)%NAME NEXT, SAME,
                   %RECORD(FTAG)%NAME NAME,
                   %INTEGER FAN,
                   %RECORD(FFANEL)%ARRAY F(1:1000))
%CONSTINTEGER NETLEN=4

%RECORDFORMAT FUNIT(%RECORD(FUNIT)%NAME NEXT, %INTEGER TYPE, NSUBS,
                    %RECORD(FNET)%NAME NETS,
                    %RECORD(FHEAD)%NAME %ARRAY H(0:999))
%CONSTINTEGER UNITLEN=5

!! working space
%CONSTINTEGER STACKLEN=45000
%INTEGERARRAY STACK(0:STACKLEN)
%OWNINTEGER TOS,   STACKTOP,   MAXTOS

!! i/o streams and associated constants
%CONSTINTEGER ENDFILE=9,   END OF FILE=-1,  CNTRL=128
%CONSTINTEGER CNTRL CHAR='^'
%CONSTINTEGER CONSOLE=0,   MIN=1,   SIN=2,   MOUT=1,   DUMP=2
%OWNINTEGER CH

!! The lexical level at which to declare a TAG
%OWNINTEGER LEVEL

!! useful constants
%CONSTINTEGER NULL=0,   ONE=256,   FLATTENED=1,   NO EXPAND=1
%CONSTINTEGER DISCARD=-1,   EXPANDIT=16_8000
%CONSTINTEGER PULLED UP=16_2000,   WIRED=16_8000,   COUNTED=16_1000
%CONSTINTEGER YES=0,   NO=-1
%CONSTINTEGER MORE THAN ONE=2,   MULTIREF=16_4000

!! machine dependent constants
%CONSTINTEGER CPW=4;    !! characters per word
%CONSTINTEGER BPW=32;   !! bits per word
%CONSTINTEGER LCPW=2;   !! log characters per word
%CONSTINTEGER AUPW=4;   !! addressing units per word
%CONSTINTEGER LAUPW=2;  !! log addressing units per word

%ROUTINE CLAIM(%INTEGER NWORDS)
   !! claim NWORDS words of the workspace (stack).
   TOS=(TOS>>LAUPW)+NWORDS
   %IF TOS>STACKTOP %START
      SELECTOUTPUT(CONSOLE)
      PRINTSTRING("Workspace full.");   NEWLINE
      %STOP
   %FINISH
   MAXTOS=TOS %IF TOS>MAXTOS
   TOS=TOS<<LAUPW
%END

%ROUTINE FAIL(%INTEGER STREAM)
   !! Invalid I-code on stream STREAM.
   SELECTOUTPUT(CONSOLE)
   PRINTSTRING("Invalid I-code on stream ")
   WRITE(STREAM,0);   NEWLINE
   %STOP
%END

!! COMMENTS_NEXT points to a chain of I-code comments, read by RCH
%RECORD(FCOMMENT) COMMENTS
!! COMMENT points to the last comment read
%RECORD(FCOMMENT)%NAME COMMENT

%ROUTINE RCH
   !! Read the next character from the input
   %INTEGER I,   L

   %ON %EVENT 3,ENDFILE %START
      CH=END OF FILE
      ->OUT
   %FINISH
START:
   %CYCLE
      READSYMBOL(CH)
   %REPEAT %UNTIL CH#NL

   %IF CH=CNTRL CHAR %START
      READSYMBOL(CH)
      CH=CH+CNTRL
   %FINISH
   %IF CH=CNTRL+'K' %START
      !! read an I-code comment and add to the list of comments
      COMMENT_NEXT==RECORD(TOS)
      CLAIM(COMMENTLEN)
      COMMENT==COMMENT_NEXT
      COMMENT_NEXT==RECORD(NULL)
      !! Read the comment text (self defining string)
      READ(L);   RCH
      comment_text = ""
      %FOR I=1,1,L %CYCLE
         RCH
         comment_text = comment_text.tostring(ch)
      %REPEAT
      !! Claim space for the string
      CLAIM((L+CPW)>>LCPW)
      ->START
   %FINISH
OUT:
%END

%ROUTINE ZERO(%INTEGER NWORDS)
   !! ZERO the top NWORDS of the stack
   %INTEGER I,   P
   P=TOS
   %FOR I=1,1,NWORDS %CYCLE
      INTEGER(P)=0
      P=P+AUPW
   %REPEAT
%END

!! hashtable for cross referencing UNIT names, NET names, PIN names, etc.
%CONSTINTEGER HASHTABLE LEN=127;   !! must be 2**N-1
%OWNINTEGERARRAY HASHTABLE(0:HASHTABLE LEN)=NULL(*)

!DIAGNOSTICS
!%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
!
!%ROUTINE DUMP STACK
!   ! dump the stack in hex format, 8-words to the line
!   ! followed by character equivalent
!   %INTEGER P,   I,   Q,   L
!   %CONSTINTEGER MASK=(AUPW<<3)-1
!
!   %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)
!
!   SELECTOUTPUT(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
!   SELECTOUTPUT(MOUT)
!%END
!DIAGNOSTIC END

%ROUTINE CLEAN DICTIONARY
   %INTEGER I
   %INTEGERNAME H
   %RECORD(FTAG)%NAME TAG
   %RECORD(FTAGDEF)%NAME TAGDEF
!! Remove all references to TAGs at a greater lexical level than LEVEL
   %FOR I=0,1,HASHTABLE LEN %CYCLE
      !! for each hashtable entry
      H==HASHTABLE(I)
      %WHILE H#NULL %CYCLE
         !! for each TAG that hashes to the same entry
         TAG==RECORD(H)
         TAGDEF==TAG_TAGDEF
         %CYCLE
            !! unchain references at a greater lexical level
            %EXIT %IF TAGDEF==RECORD(NULL)
            %EXIT %IF TAGDEF_LEVEL<LEVEL
            TAGDEF==TAGDEF_PREV
         %REPEAT
         TAG_TAGDEF==TAGDEF
         H==TAG_HNEXT
      %REPEAT
   %REPEAT
%END

%ROUTINE CLEANUP(%INTEGER STACKTOP)
!! remove references to objects in the workspace
!! that have been allocated above STACKTOP
   %INTEGER I
   %INTEGERNAME H
   %RECORD(FTAG)%NAME TAG
   STACKTOP=STACKTOP>>LAUPW
   %FOR I=0,1,HASHTABLELEN %CYCLE
      H==HASHTABLE(I)
      %WHILE H#NULL %CYCLE
         TAG==RECORD(H)
         %IF (H>>LAUPW)>STACKTOP %START
            H=TAG_HNEXT
         %ELSE
            H==TAG_HNEXT
         %FINISH
      %REPEAT
   %REPEAT
   TOS=STACKTOP<<LAUPW
%END

%RECORD(FTAG)%MAP READ TAG(%INTEGER MODIFIER)
   %RECORD(FTAG)%NAME OLD,   NEW
   %INTEGER HASH,   I,   LEN
   %INTEGERNAME H
   %STRING(255)%NAME S
!! read a name on to the stack and return the name of its TAG.
!! Create a new TAG if one doesn't exist. MODIFIER is used to
!! make GENERIC names unique, E.G. AND with 2 inputs, AND with
!! 3 inputs, etc. MODIFIER may be NULL if this uniqueness is
!! unimportant.
   READ(LEN);   RCH
   %IF LEN>0 %START
      !! Not a null string
      HASH=LEN+MODIFIER
      S==STRING(TOS);   s = ""
      %FOR I=1,1,LEN %CYCLE
         RCH
         s = s.tostring(ch)
         HASH=HASH+CH
      %REPEAT
   %FINISH
   !! No TAG if name is null or to be thrown away.
   %RESULT==RECORD(NULL) %IF LEN=0 %OR MODIFIER=DISCARD

   !! Lookup the name
   H==HASHTABLE(HASH & HASHTABLE LEN)
   %WHILE H#NULL %CYCLE
      !! for each name that hashes to the same entry
      OLD==RECORD(H)
      %RESULT==OLD %IF OLD_NAME=S %AND OLD_MODIFIER=MODIFIER
      H==OLD_HNEXT
   %REPEAT

   !! name not found, so enter into table and create a new TAG.
   CLAIM((LEN+CPW)>>LCPW);   !! Space for string
   NEW==RECORD(TOS);   !! new TAG
   H=TOS
   ZERO(TAGLEN)
   CLAIM(TAGLEN)
   NEW_NAME==S
   NEW_MODIFIER=MODIFIER
   %RESULT==NEW
%END

%RECORD(FTAGDEF)%MAP REF OR DEF(%RECORD(FTAG)%NAME TAG, %INTEGER TYPE)
   %RECORD(FTAGDEF)%NAME TAGDEF,   PTAGDEF
   %INTEGER L
!! Create a TAG DEFinition for the given TAG, or reference the
!! existing definition as appropriate. TAGDEF_LEVEL is set to
!! (lexical level)<<8+(no of UNITs of same name currently in scope)
!! so that UNIQUE TAG can create unique names for NETs.
   PTAGDEF==TAG_TAGDEF;   ! Existing TAGDEF
   %IF PTAGDEF==RECORD(NULL) %OR (TYPE#0 %AND %C
      (PTAGDEF_LEVEL<LEVEL %OR %NOT PTAGDEF_UNIT==RECORD(NULL))) %START
      !! No existing definition, or (TYPE#0) new header
      !! to be declared for UNITs of this name (TAG)
      !! and either existing definition is at wrong level
      !! or existing definition already points to a UNIT.
      ZERO(TAGDEFLEN)
      TAGDEF==RECORD(TOS);   CLAIM(TAGDEFLEN)
      !! Declare a new UNIT (TYPE#0) at the existing lexical level
      !! Declare a reference to a UNIT not yet defined at outermost level.
      %IF TYPE#0 %THEN L=LEVEL %ELSE L=ONE
      !! Record number of units of same name that are currently in scope.
      %UNLESS PTAGDEF==RECORD(NULL) %START
         L=L+1+PTAGDEF_LEVEL&16_FF
      %FINISH
      TAGDEF_PREV==PTAGDEF
      TAG_TAGDEF==TAGDEF
      TAGDEF_LEVEL=L
   %ELSE
      !! a TAG DEF already exists, and, either need to reference it,
      !! or, filling in a definition for an earlier reference
      !! which has not yet been defined at this level.
      TAGDEF==TAG_TAGDEF
   %FINISH
   !! reference the definition if TYPE indicates an instance.
   TAGDEF_REFS=TAGDEF_REFS+1 %IF TYPE=0
   %RESULT==TAGDEF
%END

%RECORD(FHEAD)%MAP READ HEAD(%INTEGER TYPE)
   !! Read an I-code header and map it.
   !! TYPE is 0 for an instance head (sub-unit)
   !! and #0 for a unit header (unit definition)
   %RECORD(FHEAD)%NAME H
   %RECORD(FTAG)%NAME TAG
   %RECORD(FTERMINAL)%NAME T
   %INTEGER I,   PNO

   ZERO(HEADLEN);         ! Clear the top of the stack
   H==RECORD(TOS);      ! and map the header

   READ(H_OPTIONS);
   READ(H_NIN);   READ(H_NOUT)
   READ(H_NIO);   READ(H_NT)

   !! Remember the chain of comments
   H_COMMENTS==COMMENTS_NEXT
   !! and empty it
   COMMENTS_NEXT==RECORD(NULL)
   COMMENT==COMMENTS

   !! claim space for the header record
   CLAIM(HEADLEN+H_NT*TERMINALLEN)

   H_UNAME==READTAG(NULL);      ! Read the unique name of the instance
   !! read the header name (UNIT or instance). The modifier
   !! allows for the difference between 2 input AND, 3 input
   !! AND, etc. Note that MODIFIER is not guaranteed to be unique
   !! because the various fields in it are MOD 64, MOD 16, etc.
   TAG==READTAG((H_NIN<<10)!(H_NOUT&63)<<4!(H_NIO&15))
   H_NAME==TAG
   H_TAGDEF==REF OR DEF(TAG,TYPE)

   !! Read in the terminal infozmation
   %FOR I=1,1,H_NT %CYCLE
      RCH;            ! Skip ^T
      T==H_T(I)
      READ(T_INFO);   T_NET==RECORD(NULL)
      T_PIN==READTAG(NULL);   T_NAME==READTAG(NULL)
   %REPEAT

   !! Read in the parameter strings
   %CYCLE
      RCH
      %EXIT %UNLESS CH=CNTRL+'P'
      READ(PNO);   SKIPSYMBOL
      H_PARM(PNO)==READTAG(NULL)
   %REPEAT
   RCH;   !! Skip ^G

   !! CH is set to the next control character ^H, ^J, etc.
   %RESULT==H
%END

%RECORD(FUNIT)%MAP READ A UNIT
   !! Read a unit from the I-code
   %INTEGER TYPE,   I,   NSUBS,   NQ,   Q
   %RECORD(FHEAD)%NAME H
   %RECORD(FUNIT)%NAME UNIT
   %RECORD(FNET)%NAME NET,   N
   %RECORD(FTAG)%NAME TAG
   %RECORD(FFANEL)%NAME F

   READ(TYPE);   RCH
   !! read the UNIT header
   H==READ HEAD(TYPE)

   !! declare all TAGs inside the UNIT at the next lexical level
   LEVEL=LEVEL+ONE

   !! read any contained UNITs
   %WHILE CH=CNTRL+'U' %CYCLE
      UNIT==READ A UNIT
      RCH
   %REPEAT

   !! read the number of subinstances and claim space for the UNIT.
   READ(NSUBS);   RCH
   UNIT==RECORD(TOS)
   CLAIM(UNITLEN+NSUBS)

   !! build the UNIT record
   UNIT_NEXT==RECORD(NULL)
   UNIT_TYPE=TYPE;   UNIT_NSUBS=NSUBS
   UNIT_H(0)==H

   !! point the UNIT's TAG DEFinition at the UNIT
   H_TAGDEF_UNIT==UNIT
   UNIT_NETS==RECORD(NULL)

   !! Read in the subunits
   %FOR I=1,1,NSUBS %CYCLE
      UNIT_H(I)==READ HEAD(0)
   %REPEAT

   !! Read in the nets
   %WHILE CH=CNTRL+'N' %CYCLE
      RCH
      NET==RECORD(NULL)
      %WHILE CH=CNTRL+'A' %CYCLE
         TAG==READTAG(NULL)
         !! build the fixed part of a NET
         N==RECORD(TOS)
         ZERO(NETLEN);   CLAIM(NETLEN)
         N_NAME==TAG
         NET==N %IF NET==RECORD(NULL)
         !! and add the list of connections
         READ(N_FAN)
         %FOR I=1,1, N_FAN %CYCLE
            F==N_F(I)
            READ(F_SUBNO);   READ(F_TNO)
            !! make the referenced TERMINAL point at the
            !! NET referencing it (used later by ADD FANELS
            UNIT_H(F_SUBNO)_T(F_TNO)_NET==N
            CLAIM(FANLEN)
         %REPEAT
         !! build side-chain of nets (circular chain)
         N_SAME==NET_SAME
         NET_SAME==N
         RCH
      %REPEAT
      !! add whole NET to main-chain of nets
      NET_NEXT==UNIT_NETS
      UNIT_NETS==NET
   %REPEAT

   !! Cleanup the dictionary
   CLEAN DICTIONARY
   LEVEL=LEVEL-ONE

   !! Discard any ROUTE information
   %WHILE CH=CNTRL+'R' %CYCLE
      TAG==READTAG(DISCARD)
      READ(NQ)
      %WHILE NQ>0 %CYCLE
         READ(Q) %FOR I=1,1,4
         NQ=NQ-1
      %REPEAT
      RCH
   %REPEAT

   %RESULT==UNIT
%END

!! length and max length of an I-code line (for output)
%OWNINTEGER LINECT=0
%CONSTINTEGER LINELEN=60

%ROUTINE PCH(%INTEGER CHAR)
   !! put a character to the I-code. Take care of control
   !! characters and increment the current line length.
   %IF CHAR>=CNTRL %START
      PRINTSYMBOL(CNTRL CHAR)
      LINECT=LINECT+1
   %FINISH
   PRINTSYMBOL(CHAR&16_7F)
   LINECT=LINECT+1
%END

%ROUTINE SEPARATE
   !! put out a newline to the I-code if required
   NEWLINE %AND LINECT=0 %IF LINECT>=LINELEN
%END

%ROUTINE PDEC(%INTEGER N)
   !! put a decimal number to the I-code
   WRITE(N,0)
   LINECT=LINECT+2;   ! approximate length
   SEPARATE
%END

%ROUTINE BLANK
   PCH(' ')
%END

%ROUTINE PUT STR(%STRING(255)%NAME S)
   %INTEGER L
   !! print out a string in I-code format
   %IF S==STRING(NULL) %THEN L=0 %ELSE L=LENGTH(S)
   WRITE(L,0);   PCH(':')
   PRINTSTRING(S) %UNLESS L=0
   LINECT=LINECT+L+2
   SEPARATE
%END

%ROUTINE PUT TAG(%RECORD(FTAG)%NAME T)
   %STRING(255)%NAME NAME
   !! print out a TAG's name in I-code format
   %IF T==RECORD(NULL) %THEN NAME==STRING(NULL) %ELSE NAME==T_NAME
   PUT STR(NAME)
%END

%ROUTINE PUT HEAD(%RECORD(FHEAD)%NAME H)
   !! output a UNIT or instance header in I-code format
   %INTEGER I
   %RECORD(FTERMINAL)%NAME T
   %RECORD(FTAG)%NAME P
   %RECORD(FCOMMENT)%NAME COMMENT

   !! Output the chain of comments, if any
   COMMENT==H_COMMENTS
   %WHILE %NOT COMMENT==RECORD(NULL) %CYCLE
      PCH(CNTRL+'K')
      PUT STR(COMMENT_TEXT)
      COMMENT==COMMENT_NEXT
   %REPEAT

   PCH(CNTRL+'H')
   PDEC(H_OPTIONS);   BLANK
   PDEC(H_NIN);       BLANK
   PDEC(H_NOUT);      BLANK
   PDEC(H_NIO);       BLANK
   PDEC(H_NT);        BLANK
   PUT TAG(H_UNAME);   PUT TAG(H_NAME)

   !! output the TERMINALs
   %FOR I=1,1,H_NT %CYCLE
      T==H_T(I)
      PCH(CNTRL+'T')
      PDEC(T_INFO&16_3FFF);   BLANK
      PUT TAG(T_PIN);   PUT TAG(T_NAME)
   %REPEAT

   !! output the parameters, if present
   %FOR I=1,1,MAX PARMS %CYCLE
      P==H_PARM(I)
      %UNLESS P==RECORD(NULL) %START
         PCH(CNTRL+'P')
         PDEC(I);   BLANK
         PUT TAG(P)
      %FINISH
   %REPEAT
   PCH(CNTRL+'G');   !! End of header
%END

%INTEGERFN COUNT SUBINSTS(%RECORD(FUNIT)%NAME UNIT)
   %RECORD(FHEAD)%NAME H
   %RECORD(FUNIT)%NAME DEFN
   %INTEGER N,   I
!! Count the number of subinstances to be output (recursive).
!! Set flags in each INSTANCE (not UNIT header) to say
!!   (a) whether to expand this instance,   and
!!   (b) whether it instances a UNIT which is multiply instanced
   N=0;   ! offset of first subinstance within the UNIT
   %FOR I=1,1,UNIT_NSUBS %CYCLE
      H==UNIT_H(I)
      H_OFFSET=N
      DEFN==H_TAGDEF_UNIT
      %IF %NOT DEFN==RECORD(NULL) %AND %C
          H_OPTIONS & NO EXPAND = 0 %AND %C
         DEFN_NSUBS>0 %AND DEFN_H(0)_OPTIONS & NO EXPAND = 0 %START
         !! expand this instance
         H_FLAGS=H_FLAGS!EXPANDIT
         %IF H_TAGDEF_REFS>1 %START
            !! multiply instanced
            H_FLAGS=H_FLAGS!MULTIREF
         %FINISH
         !! to recurse is divine
         N=N+COUNT SUBINSTS(DEFN)
      %ELSE
         !! instance not expanded - offset incremented by 1.
         N=N+1
      %FINISH
   %REPEAT
   %RESULT=N
%END

%ROUTINE EXPAND(%RECORD(FHEAD)%NAME H)
   %RECORD(FUNIT)%NAME DEFN
   %INTEGER I
   %STRING(255) COMMENT
!! output headers for all lowest level subinstances.
   %IF H_FLAGS&EXPANDIT=0 %START
      !! No expansion of this instance, so output its header
      PUT HEAD(H)
   %ELSE
      H_TAGDEF_REFS=0;   H_FLAGS=H_FLAGS&16_E000
      DEFN==H_TAGDEF_UNIT
      !! output a comment to say where come from
      COMMENT=H_NAME_NAME
      PCH(CNTRL+'K');   PUT STR(COMMENT)
      !! output headers for all lowest level subinstances
      !! of this subinstance's definition.
      %FOR I=1,1,DEFN_NSUBS %CYCLE
         EXPAND(DEFN_H(I))
      %REPEAT
      COMMENT="End of ".COMMENT
      PCH(CNTRL+'K');   PUT STR(COMMENT)
   %FINISH
%END

%ROUTINE SET REFERENCE COUNTS(%RECORD(FUNIT)%NAME UNIT)
   %INTEGER I
   %INTEGERNAME REFS,   FLAGS
   %RECORD(FHEAD)%NAME H
   FLAGS==UNIT_H(0)_FLAGS
   %FOR I=1,1,UNIT_NSUBS %CYCLE
      H==UNIT_H(I)
      %IF H_FLAGS&EXPANDIT#0 %START
         REFS==H_TAGDEF_REFS
         REFS=REFS+1
         !! only remember count if not been down this path before
         H_FLAGS=H_FLAGS!REFS %IF FLAGS&COUNTED=0
         SET REFERENCE COUNTS(H_TAGDEF_UNIT)
      %FINISH
   %REPEAT
   FLAGS=FLAGS!COUNTED;   !! delat with this subtree
%END

%PREDICATE SAME(%RECORD(FNET)%NAME FRAG1, FRAG2)
!! decide whether FRAG1 and FRAG2 belong to the same NET
   %RECORD(FNET)%NAME N
   N==FRAG1
   %CYCLE
      %TRUE %IF N==FRAG2
      N==N_SAME
   %REPEAT %UNTIL N==FRAG1
   %FALSE
%END

%ROUTINE PULL UP WIRES(%RECORD(FUNIT)%NAME UNIT)
   %RECORD(FHEAD)%NAME H,   DH
   %RECORD(FUNIT)%NAME DEFN
   %RECORD(FTERMINAL)%NAME TJ,   T,   TTNO
   %RECORD(FNET)%NAME JNET,   NET
   %INTEGER SUBNO,   TNO,   J,   NT
!! this routine merges nets that become joined by a WIRE
!! or an input-output (equivalently) in a lower level
!! UNIT. WIREs are in effect "pulled up". The routine is
!! recursive and pulls up WIREs from the lowest levels first.

%ROUTINE MERGE NETS(%RECORD(FNET)%NAME A, B)
   %RECORD(FNET)%NAME N,   P
!! Remove B from this list and add it to the side-chain of A.
!! Each terminal referenced by B is made to point at A

   !! find B
   N==UNIT_NETS
   %WHILE %NOT N==RECORD(NULL) %CYCLE
      %EXIT %IF N==B
      P==N
      N==N_NEXT
   %REPEAT
   %RETURN %IF N==RECORD(NULL);   !! not found
   !! unchain B
   %IF B==UNIT_NETS %THEN UNIT_NETS==B_NEXT %ELSE P_NEXT==B_NEXT
   B_NEXT==RECORD(NULL)
   !! get to end of side-chain of A
   N==A
   %CYCLE
      %EXIT %IF N_SAME==A
      N==N_SAME
   %REPEAT
   !! make end of A-chain point at B
   N_SAME==B
   !! get to end of B
   %CYCLE
      %EXIT %IF B_SAME==N_SAME;   !! end of B
      B==B_SAME
   %REPEAT
   !! B points at end of list
   B_SAME==A
%END

   !! start of PULL UP WIRES
   %FOR SUBNO=1,1,UNIT_NSUBS %CYCLE
      H==UNIT_H(SUBNO)
      %IF H_FLAGS&EXPANDIT#0 %START
         DEFN==H_TAGDEF_UNIT
         DH==DEFN_H(0)
         %IF DH_FLAGS&PULLED UP=0 %START
            PULL UP WIRES(DEFN)
            DH_FLAGS=DH_FLAGS!PULLED UP
         %FINISH
      %FINISH
   %REPEAT

   !! merge all nets that have been WIREd together from below
   %FOR SUBNO=1,1,UNIT_NSUBS %CYCLE
      H==UNIT_H(SUBNO)
      %CONTINUE %IF H_FLAGS&EXPANDIT=0
      DEFN==H_TAGDEF_UNIT;   !! definition of subunit
      DH==DEFN_H(0)
      NT=DH_NIN+DH_NOUT
      %FOR J=1,1,NT %CYCLE
         JNET==H_T(J)_NET
         %CONTINUE %IF JNET==RECORD(NULL)
         TJ==DH_T(J)
         %FOR TNO=J+1,1,NT %CYCLE
            TTNO==H_T(TNO)
            NET==TTNO_NET
            !! Ignore ? terminals
            %CONTINUE %IF NET==RECORD(NULL) %OR SAME(NET,JNET)
            T==DH_T(TNO)
            %CONTINUE %UNLESS SAME(T_NET,TJ_NET)
            !! two nets NET and JNET must be merged
            T_INFO=T_INFO!WIRED
            TTNO_INFO=TTNO_INFO!WIRED
            MERGE NETS(JNET,NET)
         %REPEAT
      %REPEAT
   %REPEAT
%END

%RECORD(FHEAD)%NAME %ARRAY INST STACK(0:25)

%RECORD(FTAG)%MAP UNIQUE TAG(%RECORD(FTAG)%NAME TAG)
   %RECORD(FTAGDEF)%NAME TAGDEF
   %RECORD(FHEAD)%NAME INSTANCE
   %STRING(255)%NAME S
   %INTEGER COPY,   L
!! generate an unambiguous prefix for a NET name. Use the name
!! of the enclosing UNIT, modified in 2 ways
!!   (1) add #n if this is the nth UNIT in scope with the same name.
!!   (2) add [m] if this is the mth instance of the UNIT.
   S==STRING(TOS);   S=""
   %FOR L=LEVEL,-1,1 %CYCLE
      INSTANCE==INST STACK(L)
      TAGDEF==INSTANCE_TAGDEF
      COPY=TAGDEF_LEVEL&16_FF
      %CONTINUE %IF L<LEVEL %AND COPY=0 %AND INSTANCE_FLAGS&MULTIREF=0
      !! L=LEVEL or COPY#0 or Multiply Referenced
      !! therefore must have a name extension added
      S="_".S
      %IF INSTANCE_FLAGS&MULTIREF#0 %START
         !! Multiple refs to this instance
         !! value set up by OUTPUT NETS
         S="[".ITOS(INSTANCE_FLAGS&16_0FFF,0)."]".S
      %FINISH
      %IF COPY>0 %THEN S="#".ITOS(COPY+1,0).S
      S=INSTANCE_NAME_NAME.S
   %REPEAT
   S=S.TAG_NAME
   CLAIM((LENGTH(S)+CPW)>>LCPW)
   TAG==RECORD(TOS)
   ZERO(TAGLEN);   CLAIM(TAGLEN)
   TAG_NAME==S
   %RESULT==TAG
%END

!! head of list of Global nets (names begin with '.')
%RECORD(FNET)%NAME GLOBALS
!! current NET used as workspace, or to store part of a Global NET.
%RECORD(FNET)%NAME OUT,   WORK
%OWNINTEGER GLOBAL NET

%ROUTINE ADD FANELS(%RECORD(FNET)%NAME NET, %C
                    %RECORD(FUNIT)%NAME UNIT, %INTEGER OFFSET)
   %RECORD(FFANEL)%NAME F,   O
   %RECORD(FHEAD)%NAME H
   %RECORD(FUNIT)%NAME DEFN
   %INTEGER I
!! build up a connection list. Elements of the form [0,n]
!! are ignored and handled specially by OUTPUT NETS.
!! Elements of the form [m,n] refer to subinstance m of UNIT.
!! OFFSET is used to relocate subinstance numbers as we traverse the tree.
   %FOR I=1,1,NET_FAN %CYCLE
      F==NET_F(I)
      %CONTINUE %IF F_SUBNO=0
      !! Connection is to a subinstance
      H==UNIT_H(F_SUBNO)
      %IF H_FLAGS&EXPANDIT#0 %START
         !! subinstance must be expanded
         DEFN==H_TAGDEF_UNIT
         !! locate the NET referred to by this connection by
         !! using the appropriate TERMINAL of the UNIT being instanced.
         ADD FANELS(DEFN_H(0)_T(F_TNO)_NET,DEFN,OFFSET+H_OFFSET)
      %ELSE
         WORK_FAN=WORK_FAN+1
         !! no expansion of the referenced subinstance so add
         !! the connection to the NET, relocating subinstance
         !! numbers as we go.
         O==WORK_F(WORK_FAN)
         O_SUBNO=H_OFFSET+OFFSET+1
         O_TNO=F_TNO
         CLAIM(FANLEN)
      %FINISH
   %REPEAT
%END

%ROUTINE PUT FAN(%RECORD(FNET)%NAME NET)
   !! outut the list of connections from a NET.
   %INTEGER I
   %RECORD(FFANEL)%NAME F
   %FOR I=1,1,NET_FAN %CYCLE
      F==NET_F(I)
      BLANK;   PDEC(F_SUBNO)
      BLANK;   PDEC(F_TNO)
   %REPEAT
%END

%ROUTINE EXPAND NET(%RECORD(FNET)%NAME NET, %RECORD(FUNIT)%NAME UNIT,
                    %RECORD(FHEAD)%NAME INSTANCE, %INTEGER OFFSET)
   %RECORD(FNET)%NAME N
   %RECORD(FTAG)%NAME TAG
   %RECORD(FUNIT)%NAME DEFN
   %RECORD(FHEAD)%NAME H
   %RECORD(FFANEL)%NAME F
   %INTEGER FAN,   OLDTOS

   INST STACK(LEVEL)==INSTANCE

   !! first expand the directly reachable portion
   N==NET;   OLDTOS=TOS
   %CYCLE
      !! for each fragment of the net
      WORK==RECORD(TOS);   ZERO(NETLEN)
      !! see if net already processed from level above
      %FOR FAN=1,1,N_FAN %CYCLE
         F==N_F(FAN)
         %IF F_SUBNO=0 %START
            !! ref to containing UNIT
            %IF LEVEL>0 %START
               !! not most global level
               ->NEXT FRAGMENT %UNLESS INSTANCE_T(F_TNO)_NET==RECORD(NULL)
            %ELSE
               !! add connection to net
               WORK_FAN=WORK_FAN+1
               WORK_F(WORK_FAN)=F
            %FINISH
         %FINISH
      %REPEAT
      CLAIM(NETLEN+OUT_FAN*FANLEN)
      WORK_SAME==OUT_SAME;   OUT_SAME==WORK
      ADD FANELS(N,UNIT,OFFSET)
      TAG==N_NAME
      %IF CHARNO(TAG_NAME,1)='.' %START
         GLOBAL NET=YES
      %ELSE 
         TAG==UNIQUE TAG(TAG) %IF LEVEL>0
      %FINISH
      WORK_NAME==TAG
      N_FAN=0-N_FAN;   !! mark as needing attention
NEXT FRAGMENT:
      N==N_SAME
   %REPEAT %UNTIL N==NET

   !! delete whole net unless it contains more than one 
   !! terminal reference, is at the outermost level, or
   !! is a fragment of a global net.
   TOS=OLDTOS %UNLESS WORK_FAN>1 %OR LEVEL=0 %OR GLOBAL NET=YES

   !! expand indirectly reachable parts of net
   LEVEL=LEVEL+1
   %CYCLE
      ->DONE %IF N_FAN>=0
      N_FAN=0-N_FAN
      %FOR FAN=1,1,N_FAN %CYCLE
         F==N_F(FAN)
         %CONTINUE %IF F_SUBNO=0
         INSTANCE==UNIT_H(F_SUBNO)
         %CONTINUE %IF INSTANCE_FLAGS&EXPANDIT=0
         !! ignore if ref to terminal is WIRED at higher level
         %CONTINUE %IF INSTANCE_T(F_TNO)_INFO&WIRED#0
         DEFN==INSTANCE_TAGDEF_UNIT
         H==DEFN_H(0)
         EXPAND NET(H_T(F_TNO)_NET,DEFN,INSTANCE,OFFSET+INSTANCE_OFFSET)
      %REPEAT
DONE:
      N==N_SAME
   %REPEAT %UNTIL N==NET
   LEVEL=LEVEL-1
%END

%ROUTINE MERGE GLOBALS(%RECORD(FNET)%NAME NET)
   %RECORD(FNET)%NAME N,   G,   GLOBAL,   P
   %RECORD(FTAG)%NAME TAG
!! merge all global nets referred to from NET
!! add NET to list of globals (or to merged NET)

%ROUTINE SIDECHAIN(%RECORD(FNET)%NAME NET, TO)
   %RECORD(FNET)%NAME N
   %RECORD(FTAG)%NAME TAG
!! sidechain the net NET to the net TO
   N==NET
   %CYCLE
      TAG==N_NAME
      TAG_MODIFIER=ADDR(TO) %IF CHARNO(TAG_NAME,1)='.'
      %EXIT %IF N_SAME==NET
      N==N_SAME
   %REPEAT
   !! N points at end of NET
   N_SAME==TO_SAME;   TO_SAME==NET
%END

   !! start of merge globals
   N==NET;   GLOBAL==RECORD(NULL)
   %CYCLE
      !! for each net fragment
      TAG==N_NAME
      N==N_SAME
      -> repeat %UNLESS CHARNO(TAG_NAME,1)='.'
      !! got a global fragment
      G==RECORD(TAG_MODIFIER)
      TAG_MODIFIER=ADDR(NET) %AND %CONTINUE %IF G==RECORD(NULL)
      !! got some fragments to merge?
      %IF GLOBAL==RECORD(NULL) %START
         GLOBAL==G
      %FINISH %ELSE %IF %NOT G==GLOBAL %START
         !! fragments to merge
         !! first unhook G
         %IF GLOBALS==G %START
            GLOBALS==G_NEXT
         %ELSE
            P==GLOBALS_NEXT
            P==P_NEXT %WHILE %NOT P_NEXT==G
            !! P is predecessor of G
            P_NEXT==G_NEXT
         %FINISH
         G_NEXT==RECORD(NULL)
         SIDECHAIN(G,GLOBAL)
      %FINISH
repeat:
   %REPEAT %UNTIL N==NET

   !! now add NET to GLOBALS
   %IF GLOBAL==RECORD(NULL) %START
      NET_NEXT==GLOBALS
      GLOBALS==NET
   %ELSE
      SIDECHAIN(NET,GLOBAL)
   %FINISH
%END

%ROUTINE OUTPUT NETS(%RECORD(FHEAD)%NAME INSTANCE, %INTEGER OFFSET,
                     %RECORD(FUNIT)%NAME UNIT)
   %RECORD(FNET)%NAME NET,   N
   %INTEGER SUBNO,   OLDTOS

   NET==UNIT_NETS
   %WHILE %NOT NET==RECORD(NULL) %CYCLE
      GLOBAL NET=NO
      OLDTOS=TOS
      OUT==RECORD(TOS);   ZERO(NETLEN)
      EXPAND NET(NET,UNIT,INSTANCE,OFFSET)
      NET==NET_NEXT
      %CONTINUE %IF TOS=OLDTOS;   !! no net built
      %IF GLOBAL NET=YES %START
         MERGE GLOBALS(OUT)
      %ELSE
         PCH(CNTRL+'N')
         N==OUT
         %CYCLE
            PCH(CNTRL+'A')
            PUT TAG(N_NAME)
            PDEC(N_FAN)
            PUT FAN(N)
            N==N_SAME
         %REPEAT %UNTIL N==OUT
         TOS=OLDTOS;   !! reclaim store used for OUT
      %FINISH
   %REPEAT

   LEVEL=LEVEL+1
   %FOR SUBNO=1,1,UNIT_NSUBS %CYCLE
      INSTANCE==UNIT_H(SUBNO)
      %CONTINUE %IF INSTANCE_FLAGS&EXPANDIT=0
      OUTPUT NETS(INSTANCE,OFFSET+INSTANCE_OFFSET,INSTANCE_TAGDEF_UNIT)
   %REPEAT
   LEVEL=LEVEL-1
%END

%ROUTINE PUT GLOBAL NETS(%RECORD(FNET)%NAME HEAD)
   !! output the list of global NETs.
   %RECORD(FNET)%NAME NET,   N
   %RECORD(FTAG)%NAME NETNAME
   %INTEGER FAN
   %WHILE %NOT HEAD==RECORD(NULL) %CYCLE
      !! for each differently named NET
      PCH(CNTRL+'N')
      NET==HEAD
      %CYCLE
         PCH(CNTRL+'A')
         NETNAME==NET_NAME
         PUT TAG(NETNAME)
         NETNAME_MODIFIER=NULL
         FAN=0;   N==NET
         !! count the fanout
         %CYCLE
            FAN=FAN+N_FAN %IF N_NAME==NETNAME
            N==N_SAME
         %REPEAT %UNTIL N==NET
         PDEC(FAN)
         %CYCLE
            PUT FAN(N) %AND N_NAME==RECORD(NULL) %IF N_NAME==NETNAME
            N==N_SAME
         %REPEAT %UNTIL N==NET
         %WHILE NET_NAME==RECORD(NULL) %CYCLE
            NET==NET_SAME
            %EXIT %IF NET==HEAD
         %REPEAT
      %REPEAT %UNTIL NET==HEAD
      HEAD==HEAD_NEXT
   %REPEAT
%END

!!**********************************************
!!*           MAINLINE                         *
!!**********************************************

%RECORD(FHEAD)%NAME H
%RECORD(FUNIT)%NAME PUNITS, UNIT
%INTEGER FLAGS,   I,   OLDTOS

RETURN CODE=DEF STREAMS(CLIPARAM,DEFAULTS)
->DONE %UNLESS RETURN CODE=1

!! Initialisation
SELECTOUTPUT(CONSOLE)
PRINTSTRING(VERSION);   NEWLINE
SELECTINPUT(MIN);   SELECTOUTPUT(MOUT)
TOS=ADDR(STACK(0));   STACKTOP=(ADDR(STACK(STACKLEN)))>>LAUPW
MAXTOS=TOS>>LAUPW
LEVEL=ONE;   PUNITS==RECORD(NULL)
COMMENTS_NEXT==RECORD(NULL);   COMMENT==COMMENTS

!! read the UNITs to be expanded from stream MIN
%CYCLE
   RCH
   READ(FLAGS) %AND RCH %IF CH=CNTRL+'S'
   %EXIT %UNLESS CH=CNTRL+'U'
   !! chain most global UNITs together
   %IF PUNITS==RECORD(NULL) %START
      PUNITS==READ A UNIT
      UNIT==PUNITS
   %ELSE
      UNIT_NEXT==READ A UNIT
      UNIT==UNIT_NEXT
   %FINISH
%REPEAT
UNIT_NEXT==RECORD(NULL)
FAIL(MIN) %UNLESS CH=END OF FILE

!! Read library input from stream SIN - only keep referenced UNITs.
SELECTINPUT(SIN)
%CYCLE
   RCH
   READ(FLAGS) %AND RCH %IF CH=CNTRL+'S'
   %EXIT %UNLESS CH=CNTRL+'U'
   !! throw away the UNIT (by resetting TOS) if it isn't referenced.
   OLDTOS=TOS
   UNIT==READ A UNIT
   CLEANUP(OLDTOS) %UNLESS UNIT_H(0)_TAGDEF_REFS>0
%REPEAT
FAIL(SIN) %UNLESS CH=END OF FILE

!! output the flattened description
PCH(CNTRL+'S');   PDEC(FLATTENED)
UNIT==PUNITS

OLDTOS=TOS;   LEVEL=0
%CYCLE
   %EXIT %IF UNIT==RECORD(NULL)
   H==UNIT_H(0)
   !! for each most global UNIT that isn't instanced
   %IF H_OPTIONS & NO EXPAND = 0 %AND H_TAGDEF_REFS=0 %START
      !! output the UNIT header
      PCH(CNTRL+'U');   PDEC(UNIT_TYPE)
      PUT HEAD(H)
      !! count and output the number of subinstances.
      !! COUNT SUBINSTS sets expansion and reference flags
      !! and calculates subinstance offsets.
      PCH(CNTRL+'J')
      PDEC(COUNT SUBINSTS(UNIT))
      !! expand each subinstance
      %FOR I=1,1,UNIT_NSUBS %CYCLE
         EXPAND(UNIT_H(I))
      %REPEAT
      !! Initialisation for OUTPUT NETS
      SET REFERENCE COUNTS(UNIT)
      GLOBALS==RECORD(NULL)
      OUT==RECORD(TOS)
      ZERO(NETLEN)
      PULL UP WIRES(UNIT)
      LEVEL=0
      OUTPUT NETS(RECORD(NULL),0,UNIT)
      !! output the Global NETs, if present
      PUT GLOBAL NETS(GLOBALS)
      !! Reclaim the workspace used for Global NETs
      TOS=OLDTOS
      PCH(CNTRL+'E')
   %FINISH
   UNIT==UNIT_NEXT
%REPEAT
NEWLINE

SELECTOUTPUT(CONSOLE)
MAXTOS = MAXTOS - ADDR(STACK(0)) >> LAUPW
PRINTSTRING("Used "); WRITE(MAXTOS,0)
PRINTSTRING(" out of "); WRITE(STACKLEN,0)
PRINTSTRING(" words."); newline

DONE:
%ENDOFPROGRAM