!!   *** DCODES ***   30/06/80
!!  V3.1 [01/03/83]: mods for IMP8
%BEGIN
%EXTERNALINTEGERFNSPEC DEF STREAMS(%STRING(127) STREAMS, DEFAULTS)
%CONSTSTRING(63) HEADING="$ Decoded from ESDL I-code by DCODE version 3.1"

!! useful values
%CONSTINTEGER KEEP=1
%CONSTINTEGER NO=2,   YES=1
%CONSTINTEGER NULL=0,   END OF FILE=9
%CONSTINTEGER CNTRL=128,   CNTRLCHAR='^'

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

!! input/output streams
%CONSTINTEGER TELETYPE=0,   MIN=1,   MOUT=1

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

!! Constants and variables controlling the output
%CONSTINTEGER LINELEN=68,   PAGELEN=66,   LEFT=3
%OWNINTEGER CH,   COL=LEFT,   INDENT=LEFT

%CONSTINTEGER MAX PARMS=10
%OWNSTRING(9) %ARRAY PARM(1:MAX PARMS)= %C
   "AT", "ON", "PACKAGE", "SUBPACK", "DELAY", "VALUE",
   "SIZE","PLACE","?"(2)

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

%recordformatspec fcomment
%RECORDFORMAT FHEAD(%INTEGER TYPE, OPTION, PINS, NIN, NOUT, NIO, NT,
                    %STRING(255)%NAME UNAME, NAME,
                    %RECORD(FCOMMENT)%NAME COMMENTS,
                    %STRING(255)%NAME %ARRAY PARM(1:MAX PARMS),
                    %RECORD(FTERMINAL)%ARRAY T(1:256))
%CONSTINTEGER HEADLEN=10+MAX PARMS

%RECORDFORMAT FUNIT(%RECORD(FHEAD)%NAME %ARRAY H(0:1000))

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

%RECORDFORMAT FSPEC(%RECORD(FSPEC)%NAME NEXT, %INTEGER CODE,
                    %STRING(255) NAME)
%CONSTINTEGER SPECLEN=2

%STRING(255)%NAME NULL STRING

%ROUTINE STOP
   %STOP
%END

%ROUTINE NULINE
   %OWNINTEGER LINE=2
   NEWLINE
   LINE=LINE+1
   NEWLINES(2) %AND LINE=2 %IF LINE=PAGELEN
   COL=0
%END

%ROUTINE CLAIM(%INTEGER NWORDS)
   ! claim nwords of the stack
   TOS=TOS>>LAUPW+NWORDS
   %IF TOS<0 %OR TOS>STACKTOP %START
      SELECTOUTPUT(TELETYPE)
      PRINTSTRING("Workspace overflow");NEWLINE
      STOP
   %FINISH
   TOS=TOS<<LAUPW
%END

%STRING(255)%MAP %SPEC RSTRING(%INTEGER FLAG)

%RECORD(FCOMMENT) COMMENTS
%RECORD(FCOMMENT)%NAME COMMENT

%ROUTINE RCH
   !! Read the next character from the input.
   !! this may require reading a comment from the I-code
   !! in which case RCH is called recursively to read it.
   !! on end of file the output is closed off with a FINISH.
   %ROUTINE END FILE
      SPACES(LEFT)
      PRINTSTRING("FINISH")
      NEWLINE
      STOP
   %END

   %ON %EVENT 3,END OF FILE %START
      END FILE
   %FINISH
START:
   %CYCLE
      READSYMBOL(CH)
      %EXIT %IF CH#NL
   %REPEAT
   %IF CH=CNTRLCHAR %START
      READSYMBOL(CH)
      CH=CH+CNTRL
      %IF CH=CNTRL+'K' %START
         COMMENT_NEXT==RECORD(TOS)
         CLAIM(COMMENTLEN)
         COMMENT==COMMENT_NEXT
         COMMENT_NEXT==RECORD(NULL)
         COMMENT_TEXT==RSTRING(KEEP)
         ->START
      %FINISH
   %FINISH
%END

%STRING(255)%MAP RSTRING(%INTEGER FLAG)
   !! Read a self defining STRING from the I-code
   !! and map it on the work-stack as an IMP string.
   %INTEGER LEN,   I
   %STRING(255)%NAME S

   READ(LEN);   RCH
   %IF LEN>0 %START
      S==STRING(TOS)
      s = ""
      %FOR I=1,1,LEN %CYCLE
         RCH
         s = s.tostring(ch)
      %REPEAT
      CLAIM((LEN+CPW)>>LCPW) %IF FLAG=KEEP
   %FINISH
   S==NULL STRING %IF FLAG#KEEP %OR LEN=0
   %RESULT==S
%END

%ROUTINE PCH(%INTEGER CH)
   !! Print a character and keep count of the column posn
   PRINTSYMBOL(CH)
   COL=COL+1
%END

%ROUTINE TAB
   !! Tabulate to the current tab position (INDENT)
   !! and remember where we are on the output page (COL).
   SPACES(INDENT)
   COL=INDENT
%END

%ROUTINE SEPARATE(%INTEGER CHAR)
   !! Take the oportunity to break a long line at a
   !! sensible place (I.E. just after a separator.
   PCH(CHAR) %IF CHAR#0
   NULINE %AND TAB %IF COL>LINELEN
%END

%ROUTINE PSTRING(%STRING(255) S)
   !! Print a string. Keep track of the column position reached.
   !! Also handle the case of a NULL string (print '?').
   %IF S=NULL STRING %START
      PCH('?')
   %ELSE
      COL=COL+LENGTH(S)
      NULINE %AND TAB %IF COL>LINELEN
      PRINTSTRING(S)
   %FINISH
%END

%ROUTINE PUT COMMENT(%STRING(255)%NAME TEXT)
   SPACES(LEFT);   PCH('$');   SPACE
   PSTRING(TEXT)
   NULINE
%END

%ROUTINE PUT HEAD(%RECORD(FHEAD)%NAME H)
   !! Output a UNIT or instance header in I-code format.
   !! Also output all outstanding comments.
   %SWITCH C(1:5)
   %RECORD(FCOMMENT)%NAME COMMENT
   %RECORD(FTERMINAL)%NAME T
   %INTEGER I

   !! Output all outstanding comments.
   COMMENT==H_COMMENTS
   %WHILE %NOT COMMENT==RECORD(NULL) %CYCLE
      PUT COMMENT(COMMENT_TEXT)
      COMMENT==COMMENT_NEXT
   %REPEAT

   TAB
   ->NAMES %IF H_TYPE=0;   ! an instance
   %IF H_TYPE>=8 %START
      PSTRING("GENERIC ")
      H_TYPE=H_TYPE-8
   %FINISH
   ->C(H_TYPE)

C(1): PSTRING("SPEC ");   ->NAMES
C(2): PSTRING("UNIT ");   ->NAMES
C(3): PSTRING("CHIP ");   ->NAMES
C(4): PSTRING("BOARD ");  ->NAMES
C(5): PSTRING("PACK ");   ->NAMES
NAMES:
   %UNLESS H_UNAME==NULL STRING %START
      PSTRING(H_UNAME)
      PCH(':')
   %FINISH
   PSTRING(H_NAME)

   INDENT=INDENT+6

   !! Output a list of INPUT terminals.
   %IF H_NIN#0 %START
      PCH('(')
      %FOR I=1,1,H_NIN %CYCLE
         PSTRING(H_T(I)_NAME)
         SEPARATE(',') %UNLESS I=H_NIN
      %REPEAT
      PCH(')')
   %FINISH

   !! Output a list of OUTPUT terminals.
   %IF H_NIN#H_NT %START
      PCH('-');   SEPARATE('>')
      %FOR I=H_NIN+1,1,H_NT %CYCLE
         PSTRING(H_T(I)_NAME)
         SEPARATE(',') %UNLESS I=H_NT
      %REPEAT
   %FINISH

   !! If we have INPUT-OUTPUTs then the signal list must be compacted.
   %IF H_TYPE#0 %AND H_NIO#0 %START
      ! overwrite dummy signals - compact signal list
      %FOR I=H_NIN+1,1,H_NT %CYCLE
         T==H_T(I)
         %IF T_INFO#0 %START
            T_NAME==H_T(T_INFO)_NAME
         %FINISH
      %REPEAT
   %FINISH

   NULINE

   %IF H_PINS=YES %START
      TAB
      PSTRING("PINS(")
      %FOR I=1,1,H_NT %CYCLE
         PSTRING(H_T(I)_PIN)
         SEPARATE(',') %UNLESS I=H_NT
      %REPEAT
      PCH(')');   NULINE
   %FINISH

   %IF H_OPTION#0 %START
      TAB
      PSTRING("OPTION ");   WRITE(H_OPTION,0)
      NULINE
   %FINISH

   %FOR I=1,1,MAX PARMS %CYCLE
      %UNLESS H_PARM(I)==NULL STRING %START
         TAB
         PSTRING(PARM(I));   SPACE
         PCH('"');   PSTRING(H_PARM(I));   PCH('"')
         NULINE
      %FINISH
   %REPEAT
   INDENT=INDENT-6
%END

%PREDICATE BEGINS(%STRING(255)%NAME S, %STRING(7) HEAD)
   %INTEGER I
   %FALSE %IF LENGTH(HEAD)>LENGTH(S)
   %FOR I=1,1,LENGTH(HEAD) %CYCLE
      %FALSE %UNLESS CHARNO(S,I)=CHARNO(HEAD,I)
   %REPEAT
   %TRUE
%END

!! name of UNIT header returned from READ A UNIT
%RECORD(FHEAD)%NAME H0

%ROUTINE READ A UNIT(%RECORD(FSPEC)%NAME SPECS)
   !! Read a UNIT from the I-code. This routine may
   !! be called recursively to read UNITs within UNITs.
   %OWNINTEGER I,   J,   TYPE,   NSUBS
   %OWNINTEGER FAN,   SUBNO,   TNO,   NQUADS,   COORD
   %INTEGER  OLDTOS
   %RECORD(FUNIT)%NAME UNIT
   %RECORD(FHEAD)%NAME H
   %STRING(255)%NAME NAME,   NETNAME
   %STRING(255) ROUTENAME
   %RECORD(FTERMINAL)%NAME T
   %RECORD(FCOMMENT)%NAME PREV,   ENDOF

   %RECORD(FHEAD)%MAP HEAD(%INTEGER TYPE)
      !! Read a UNIT or instance header from the I-code.
      %INTEGER I
      %RECORD(FHEAD)%NAME H
      %RECORD(FTERMINAL)%NAME T,   T1

      !! Map the header and pick up the chain of outstanding comments.
      H==RECORD(TOS)
      H_COMMENTS==COMMENTS_NEXT
      COMMENTS_NEXT==RECORD(NULL)
      COMMENT==COMMENTS

      H_TYPE=TYPE
      READ(H_OPTION)
      READ(H_NIN);   READ(H_NOUT)
      READ(H_NIO);   READ(H_NT)
      CLAIM(HEADLEN+H_NT*TERMINALLEN)
      H_UNAME==RSTRING(KEEP)
      H_NAME==RSTRING(KEEP)

      !! Read in the TERMINALS and PINS (if present).
      !! record whether or not PINS are present.
      H_PINS=NO
      %FOR I=1,1,H_NT %CYCLE
         RCH;  !  skip CNTRL+'T'
         T==H_T(I)
         READ(J)
         T_INFO=0
         T1==H_T(J>>2)
         T1_INFO=I %IF I>H_NIN
         T_PIN==RSTRING(KEEP)
         H_PINS=YES %UNLESS T_PIN==NULL STRING
         %IF TYPE=0 %START
            T_NAME==RSTRING(NO)
         %FINISHELSESTART
            T_NAME==RSTRING(KEEP)
         %FINISH
      %REPEAT

      !! Read in the PARaMeters, if any are there.
      %FOR I=1,1,MAX PARMS %CYCLE
         H_PARM(I)==NULL STRING
      %REPEAT

      RCH
      %WHILE CH=CNTRL+'P' %CYCLE
         READ(I)
         H_PARM(I)==RSTRING(KEEP)
         RCH
      %REPEAT

      RCH;   !! skip ^G
      %RESULT==H
   %END

%PREDICATE EXISTS SPEC(%RECORD(FHEAD)%NAME H)
   !! decide whether there is a spec already
   !! output (and in scope) for the instance H
   !! which is assumed to have input-outputs
   %RECORD(FSPEC)%NAME SPEC
   %INTEGER CODE
   CODE=(H_NIN<<10)!((H_NOUT&31)<<5)!(H_NIO&31)
   SPEC==SPECS
   %WHILE %NOT SPEC==RECORD(NULL) %CYCLE
      %TRUE %IF SPEC_CODE=CODE %AND SPEC_NAME=H_NAME
      SPEC==SPEC_NEXT
   %REPEAT
   %FALSE
%END

%ROUTINE ADD SPEC(%RECORD(FHEAD)%NAME H)
   !! add a spec for the header H to the list of
   !! specs currently in scope
   %RECORD(FSPEC)%NAME SPEC
   %STRING(255) NAME
   %INTEGER CODE
   !! H may be unprotected, beyond the stack frame
   NAME=H_NAME
   CODE=(H_NIN<<10)!((H_NOUT&31)<<5)!(H_NIO&31)
   SPEC==RECORD(TOS)
   CLAIM(SPECLEN+(LENGTH(NAME)+CPW)>>LCPW)
   SPEC_NEXT==SPECS;   SPECS==SPEC
   SPEC_CODE=CODE;   SPEC_NAME=NAME
%END

%ROUTINE PUT NAME(%INTEGER N)
!! create a name for the Nth formal parameter
   %INTEGER D
   D=N//26
   PCH('A'-1+N-D*26)
   PCH('0'+D) %IF D>0
%END

%ROUTINE PUT SPEC(%RECORD(FHEAD)%NAME H)
   !! create a spec for the instance H
   %INTEGER NIO, TNO, INFO
   TAB
   PSTRING("SPEC ")
   %UNLESS H_UNAME==NULL STRING %START
      PSTRING(H_UNAME);   PCH(':')
   %FINISH
   PSTRING(H_NAME)
   ADD SPEC(H);   !! record that a spec has been output
   INDENT=INDENT+6
   !! a unit with inouts must have at least 1 input
   !! and one output
   PCH('(')
   %FOR TNO=1,1,H_NIN %CYCLE
      !! output the inputs   
      INFO=H_T(TNO)_INFO
      !! 0 => not an inout
      %IF INFO=0 %THEN PCH('?') %ELSE PUT NAME(TNO)
      SEPARATE(',') %UNLESS TNO=H_NIN
   %REPEAT
   PCH(')')
   PCH('-');   PCH('>')
   %FOR TNO=H_NIN+1,1,H_NT %CYCLE
      !! and now the outputs
      %FOR NIO=1,1,H_NIN %CYCLE
         !! find which symbol to output
         %IF TNO=H_T(NIO)_INFO %THEN PUT NAME(NIO) %AND ->NEXT
      %REPEAT
      PCH('?')
NEXT:
      SEPARATE(',') %UNLESS TNO=H_NT
   %REPEAT
   INDENT=INDENT-6
   NULINE
%END

   !! start of READ A UNIT
   !! Read the UNIT header and output it.
   OLDTOS=TOS
   READ(TYPE)
   RCH
   H0==HEAD(TYPE)
   PUT HEAD(H0)

   ! Return if a SPEC or GENERIC SPEC
   RCH %AND ->OUT %IF CH=CNTRL+'E'

   !! Read all the contained UNITs.
   INDENT=INDENT+3
   %WHILE CH=CNTRL+'U' %CYCLE
      READ A UNIT(SPECS)
      ADD SPEC(H0) %IF H0_NIO#0
   %REPEAT

   !! Read the number of subinstances.
   !! Read the list of subinstances, and remember them.
   READ(NSUBS);   RCH
   UNIT==RECORD(TOS);   UNIT_H(0)==H0
   CLAIM(NSUBS+1)
   %FOR I=1,1,NSUBS %CYCLE
      UNIT_H(I)==HEAD(0)
   %REPEAT

   !! pick up the closing comment bracket here, if there is one
   %IF BEGINS(COMMENT_TEXT,"End") %START
      ENDOF==COMMENT
      PREV==COMMENTS
      PREV==PREV_NEXT %WHILE %NOT PREV_NEXT==ENDOF
      PREV_NEXT==RECORD(NULL)
   %ELSE
      ENDOF==RECORD(NULL)
   %FINISH

   !! Read in the NETs and fix up the actual signal names
   !! used at each terminal of the subinstances.
   %WHILE CH=CNTRL+'N' %CYCLE
      NETNAME==NULL STRING
      RCH;   !! read ^A
      %WHILE CH=CNTRL+'A' %CYCLE
         NAME==RSTRING(YES)
         NETNAME==NAME %IF NETNAME==NULL STRING
         %IF %NOT NAME==NETNAME %START
            !! got a WIRE
            TAB
            PSTRING("WIRE ");   PSTRING(NETNAME)
            PSTRING("->");     PSTRING(NAME)
            NETNAME==NAME
            NULINE
         %FINISH
         READ(FAN)
         %FOR I=1,1,FAN %CYCLE
            READ(SUBNO);   READ(TNO)
            H==UNIT_H(SUBNO)
            T==H_T(TNO)
            %IF SUBNO#0 %START
               !! Reference to a subinstance.
               !! Fix up INPUT-OUTPUT names here (INFO#0).
               T_NAME==NAME %IF T_NAME==NULL STRING
               H_T(T_INFO)_NAME==NAME %UNLESS T_INFO=0
            %FINISH
         %REPEAT
         RCH
      %REPEAT
   %REPEAT

   !! output the list of subinstances with the correct terminal names.
   %FOR I=1,1,NSUBS %CYCLE
      H==UNIT_H(I)
      %IF H_NIO#0 %START
         PUT SPEC(H) %UNLESS EXISTS SPEC(H)
      %FINISH
      PUT HEAD(H)
   %REPEAT

   !! Read and output ROUTES if present in the I-code.
   NULINE %IF CH=CNTRL+'R'
   %WHILE CH=CNTRL+'R' %CYCLE
      TAB
      PSTRING("ROUTE ")
      ROUTENAME=RSTRING(KEEP)
      PSTRING(ROUTENAME)
      PCH('(')
      READ(NQUADS)
      %FOR I=1,1,NQUADS %CYCLE
         PCH('(')
         %FOR J=1,1,4 %CYCLE
            READ(COORD);   WRITE(COORD,0)
            PCH(',') %UNLESS J=4
         %REPEAT
         PCH(')') %IF I=NQUADS
         SEPARATE(')')
      %REPEAT
      NULINE
      RCH
   %REPEAT

   PUT COMMENT(ENDOF_TEXT) %UNLESS ENDOF==RECORD(NULL)

   INDENT=INDENT-3
   TAB;   PSTRING("END");   NULINE;   NULINE
OUT:
   TOS=OLDTOS
   RCH
%END

!mainline
%INTEGER FLAG,   RC

RC=DEF STREAMS(CLIPARAM,"")
->OUT %UNLESS RC=1

!! ***   initialisation ***
SELECTINPUT(MIN);   SELECTOUTPUT(MOUT)
TOS=ADDR(STACK(0));   STACKTOP=ADDR(STACK(STACKLEN))>>LAUPW
NULL STRING==STRING(TOS);   NULL STRING=""
CLAIM(1)
COMMENTS_NEXT==RECORD(NULL);   COMMENTS_TEXT==NULL STRING
COMMENT==COMMENTS

!! Output heading as a comment.
SPACES(LEFT);   PRINTSTRING(HEADING);   NULINE;   NULINE

RCH
!! Read and decode the list of UNITs.
%CYCLE
   %IF CH=CNTRL+'S' %START
      !! discard the file header
      READ(FLAG)
      RCH
   %FINISH
   %EXIT %UNLESS CH=CNTRL+'U'
   READ A UNIT(RECORD(NULL))
%REPEAT

!! error if we get here
!! because should run off end of file first.
SELECTOUTPUT(TELETYPE)
PRINTSTRING("Not a valid I-code file.");   NULINE

OUT:
%ENDOFPROGRAM