CS IMP Compiler for M68000.  Version  3.0d

   XPACKAGE  compiled on 27/05/87  at  17.43

    1  !! PACKAGE Updated to IMP8 27/11/81 and 01/03/83 (V3.6)
    2  !! PACKAGE program to assign elements to chips 03/10/79
    3  !!         Updated 27/11/81 - bug fix + change to IMP8
    4  !!         Some changes to the assignment algorithm
    5  !!         Constraint bug fixed 14/12/81
    6  !!         Error trap put in 5/6/85 JHB. (see {jhb})
    7  %BEGIN
    8  %CONSTSTRING(31) HEADING="PACKAGE version 3.7 (APM)"
    9  
   10  %systemstring (255) %fnspec itos(%integer v,p)
   11  !%EXTERNALROUTINESPEC RESET INPUT
   12  %EXTERNALINTEGERFNSPEC DEF STREAMS(%STRING(127) STREAMS, DEFAULTS)
   13  %INTEGER RETURN CODE
   14  %OWNSTRING(47) DEFAULTS=".FIC,.LIB,ESDL:TTL74.LIB/%I1.CIC"
   15  
   16  !!*******************************************************
   17  !! PACKAGE: Program to assign UNITS to CHIPs            *
   18  !! The list of UNITs is read in from stream 1.          *
   19  !! CHIPs are read in from streams 2 and 3. By           *
   20  !! convention stream 3 is used for the 'system library' *
   21  !! and stream 2 for a user provided library. The user   *
   22  !! library is searched first.                           *
   23  !!                                                      *
   24  !! ASSIGNment works by firstly doing a naive assignment *
   25  !! where UNITs are allocated to CHIPs as densely as     *
   26  !! is permitted by the constraints, and then this       *
   27  !! assignment is 'improved' by (a) cluster building     *
   28  !! and (b) optimising the use of 'empty slots'.         *
   29  !!*******************************************************
   30  
   31  !! all strings are stored in a chained hash-table so that
   32  !! commonly used strings are shared. strings may 'own'
   33  !! the object of which they are the name.
   34  %RECORDFORMAT FTAG(%RECORD(*)%NAME OWNER, %INTEGER HNEXT,
   35+                    %STRING(255) NAME)
   36  %CONSTINTEGER TAGLEN=2
   37  
   38  !! description of a terminal of a chip - consists of the
   39  !! logical terminal number<<2, flags, and the pin name
   40  %RECORDFORMAT FTERMINAL(%INTEGER INFO,
   41+                         %RECORD(FTAG)%NAME PIN)
   42  %CONSTINTEGER TERMINALLEN=2
   43  
   44  !! maximum number of parameters currently used by the system
   45  !! (largest value of PNO in ^P <PNO> )
   46  %CONSTINTEGER MAX PARMS=8
   47  
   48  !! description of a chip header. also used when re-reading
   49  !! the source file to produce the updated source.
   50  %RECORDFORMAT FHEAD(%INTEGER OPTIONS,
   51+                     %BYTEINTEGER NIN, NOUT, NIO, NT,
   52+                     %RECORD(FTAG)%NAME UNAME, NAME,
   53+                     %RECORD(FTAG)%NAME %ARRAY PARM(1:MAX PARMS),
   54+                     %RECORD(FTERMINAL)%ARRAY T(1:255))
   55  %CONSTINTEGER HEADLEN=5+MAXPARMS
   56  
   57  !! fan element. number of the subinstance and terminal of that
   58  !! subinstance which is being referenced.
   59  %RECORDFORMAT FFANEL(%INTEGER SUBNO, TNO)
   60  %CONSTINTEGER FANLEN=2
   61  
   62  !! A net is a list of net fragments. Each net fragment may
   63  !! have its own name and an unlimited (<32767) number of
   64  !! fan elements. A net is a list of all terminals (SUBNO,TNO)
   65  !! at the same electrical potential and has multiple names.
   66  %RECORDFORMAT FFRAGMENT(%RECORD(FTAG)%NAME NAME,
   67+                         %INTEGER FAN,
   68+                         %RECORD(FFANEL)%ARRAY F(1:1023))
   69  %CONSTINTEGER FRAGMENTLEN=2
   70  
   71  %RECORDFORMAT FNET(%RECORD(FNET)%NAME NEXT,
   72+                    %BYTEINTEGER FLAGS, NF, DUMMY1, DUMMY2,
   73+                    %RECORD(FFRAGMENT)%NAME %ARRAY F(1:255))
   74  %CONSTINTEGER NETLEN=2
   75  
   76  %RECORDFORMAT FTAGLIST(%INTEGER NT,
   77+                        %RECORD(FTAG)%NAME %ARRAY NAME(1:32767))
   78  %CONSTINTEGER TAGLISTLEN=1
   79  
   80  !! Description of a subunit. Note that not all parameters are
   81  !! stored, but only AT, ON, PACKAGE, and SUBPACK
   82  !! It is assumed that SUBPACK is an integer.
   83  %RecordFormatSpec Fpackage
   84  
   85  %RECORDFORMAT FSUBUNIT(%RECORD(FTAG)%NAME UNAME, NAME, ON, AT, PACKNAME,
   86+                        %BYTEINTEGER NIN, NOUT, NIO, NT,
   87+                        %BYTEINTEGER FLAGS, SUBPACK, DUMMY1, DUMMY2,
   88+                        %RECORD(FSUBUNIT)%NAME NEXT,
   89+                        %RECORD(FPACKAGE)%NAME PACK,
   90+                        %INTEGER SUBNO,
   91+                        %INTEGERARRAY INFO(1:255))
   92  %CONSTINTEGER SUBUNITLEN=10
   93  
   94  !! Reference to a chip's terminal.
   95  %RECORDFORMAT FTERMREF(%INTEGER INFO, %RECORD(FTERMINAL)%NAME T)
   96  %CONSTINTEGER TERMREFLEN=2
   97  
   98  %RECORDFORMAT FSUBCHIP(%RECORD(FTAG)%NAME UNAME, NAME,
   99+                        %BYTEINTEGER NIN,NOUT,NIO,NT,
  100+                        %RECORD(FTERMREF)%ARRAY TREF(1:254))
  101  %CONSTINTEGER SUBCHIPLEN=3
  102  
  103  !! Description of a CHIP. Chips contain SUBCHIPs to which UNITs
  104  !! are assigned.
  105  %RECORDFORMAT FCHIP(%RECORD(FTAG)%NAME NAME,
  106+                     %RECORD(FHEAD)%NAME HEADER,
  107+                     %RECORD(FNET)%NAME GNETS,
  108+                     %BYTEINTEGER FLAGS, NSUBS, DUMMY1, DUMMY2,
  109+                     %RECORD(FSUBCHIP)%NAME %ARRAY SUB(1:253))
  110  %CONSTINTEGER CHIPLEN=4
  111  
  112  !! Packages are instances of chips, and reference the relevant
  113  !! chip, as well as recording any constraints applicable to
  114  !! the instance of the chip (such as position or unique name).
  115  %RECORDFORMAT FPACKAGE(%RECORD(FPACKAGE)%NAME NEXT,
  116+                        %RECORD(FCHIP)%NAME CHIP,
  117+                        %RECORD(FTAG)%NAME AT, ON, PACKNAME,
  118+                        %INTEGER PNO,
  119+                        %RECORD(FSUBUNIT)%NAME %ARRAY SUB(1:252))
  120  %CONSTINTEGER PACKLEN=6
  121  
  122  %RECORDFORMAT FTASK(%RECORD(FSUBUNIT)%NAME %ARRAY S(1:3987))
  123  
  124  !! miscellaneous records used by ASSIGNment improvement
  125  !! routines. Essentially they are used to map the
  126  !! stack for these routines.
  127  %RECORDFORMAT FWORK(%RECORD(FSUBUNIT)%NAME S, %INTEGER C)
  128  %RECORDFORMAT FWORKLIST(%RECORD(FWORK)%ARRAY W(1:3985))
  129  %CONSTINTEGER WORKLEN=2
  130  
  131  !! working space
  132  %CONSTINTEGER STACKLEN=50000
  133  %INTEGERARRAY STACK(0:STACKLEN)
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  #$00030D44,D0        : 203C 0003 0D44
    MOVE.L  D0,-(A7)             : 2F00
  134  %OWNINTEGER TOS,   STACKTOP,   MAXTOS
  135  
  136  !! maximum number of fragments allowed in a net
  137  %CONSTINTEGER MAX FRAGS=20
  138  
  139  !! i/o streams and associated constants
  140  !! END OF FILE must be <0 and mask to NL.
  141  %CONSTINTEGER ENDFILE=9,   CNTRL=128,   END OF FILE=NL-CNTRL
  142  %CONSTINTEGER CNTRL CHAR='^'
  143  %CONSTINTEGER CONSOLE=0,   MIN=1,   MOUT=1,   SOUT=2
  144  %CONSTINTEGER USERLIB=2,   DEFAULTLIB=3
  145  %OWNINTEGER CH
  146  
  147  !! useful constants
  148  %CONSTINTEGER NULL=0
  149  %CONSTINTEGER AT=1,   ON=2,   SUB=4,   PACKNO=3
  150  %CONSTINTEGER SELECTED=1,   NOT SELECTED=2,   CONSTRAINT=4
  151  %CONSTINTEGER SUBCONSTRAINT=8
  152  %CONSTINTEGER GLOBAL=1,   YES=0,   NO=-1
  153  %CONSTINTEGER SELECT ERROR=8
  154  %RECORD(FTAG)%NAME NULL TAG
  155  
  156  !! Constants used by the assignment improvement routines
  157  %CONSTINTEGER INFINITY=32767
  158  %CONSTINTEGER IMPROVED=16,   SWOPPED=32
  159  %CONSTINTEGER OPTIMISED=64,   CONSIDERED=128
  160  %CONSTINTEGER FIXED=CONSTRAINT+NOT SELECTED+SELECT ERROR
  161  
  162  !! machine dependent constants
  163  %CONSTINTEGER CPW=4;    !! characters per word
  164  %CONSTINTEGER BPW=32;   !! bits per word
  165  %CONSTINTEGER LCPW=2;   !! log characters per word
  166  %CONSTINTEGER AUPW=4;   !! addressing units per word
  167  %CONSTINTEGER LAUPW=2;  !! log addressing units per word
  168  
  169  !! TAG types
  170  %CONSTINTEGER GENERAL   =0
  171  %CONSTINTEGER UNITNAME  =1
  172  %CONSTINTEGER CHIPNAME  =2
  173  %CONSTINTEGER PACKNAME  =3
  174  %CONSTINTEGER NETNAME   =4
  175  %CONSTINTEGER DISCARD=-1,   KEEP=0
  176  
  177  !! Error message numbers
  178  %CONSTINTEGER NERRORS=6
  179  %CONSTINTEGER D1=1,   D2=2,   D3=3,   D4=4,   D5=5,   D6=6
  180  
  181  !! variables used by FAIL etc.
  182  %OWNINTEGER INSTREAM=0
  183  %STRING(63) ERROR CONTEXT
  184  
  185  !!************************************************************
  186  !!    Start of utility routines  etc.                        *
  187  !!************************************************************
  188  
  189  !! remember the selected input stream
  190  %ROUTINE SELIN(%INTEGER STREAM)
  191     SELECTINPUT(STREAM)
    JSR     selectinput          : 4EB8 3E58
  192     INSTREAM=STREAM
    MOVE.L  stream,instream      : 2957 0040
  193  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  194  
  195  %ROUTINE BREAD(%BYTEINTEGERNAME B)
  196     %INTEGER I
  197     READ(I)
    JSR     read                 : 4EAC 0044
    MOVE.L  D0,i                 : 2F00
  198     B=I&255
    AND.L   #$00FF,D0            : C0BC 0000 00FF
    MOVEA.L b,A0                 : 206F 0004
    MOVE.B  D0,(A0)              : 1080
  199  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  200  
  201  %ROUTINESPEC FAIL(%INTEGER MSGNO)
  202  
  203  !! routine to claim NWORDS of the workspace (stack organised)
  204  !! and moan if no space is left.
  205  %ROUTINE CLAIM(%INTEGER NWORDS)
  206     TOS=TOS>>LAUPW+NWORDS
    MOVE.L  tos,D1               : 222C 0030
    LSR.L   #2,D1                : E489
    ADD.L   D0,D1                : D280
    MOVE.L  D1,tos               : 2941 0030
  207     FAIL(D4) %IF TOS>=STACKTOP
    CMP.L   stacktop,D1          : B2AC 0034
    BLT     L2                   : 6D00 0000
    MOVEQ   #4,D0                : 7004
    BSR     fail                 : 6100 01AB
L2
  208     MAXTOS=TOS %IF TOS>MAXTOS
    MOVE.L  tos,D0               : 202C 0030
    CMP.L   maxtos,D0            : B0AC 0038
    BLE     L2                   : 6F00 0000
    MOVE.L  D0,maxtos            : 2940 0038
L2
  209     TOS=TOS<<LAUPW
    MOVE.L  tos,D0               : 202C 0030
    LSL.L   #2,D0                : E588
    MOVE.L  D0,tos               : 2940 0030
  210  %END
^   MOVEQ   #-8,D4               : 78F8
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  211  
  212  %ROUTINE FAIL(%INTEGER MSGNO)
  213     %SWITCH MESS(1:NERRORS)
  214  
  215     SELECTOUTPUT(CONSOLE)
    MOVEQ   #0,D0                : 7000
    JSR     selectoutput         : 4EB8 3E52
  216     PRINTSTRING("* ")
    LEA     (PC),A0              : 41FA 00C6
    JSR     printstring          : 4EB8 3E6A
  217     ->MESS(MSGNO)
    MOVE.L  msgno,D0             : 2017
    LEA     3B_0806,A0           : 41FB 0806
    ADDA.L  D0,A0                : D1C0
    ADDA.W  (A0),A0              : D0D0
    JMP     (A0)                 : 4ED0
  218  
  219  MESS(1):
  220  MESS(2): PRINTSTRING("Invalid I-code");                ->ENDERR
    LEA     (PC),A0              : 41FA 00C9
    JSR     printstring          : 4EB8 3E6A
    BRA     enderr               : 6000 0000
  221  MESS(3): PRINTSTRING("No subunits to ASSIGN");         ->STOP
    LEA     (PC),A0              : 41FA 00D8
    JSR     printstring          : 4EB8 3E6A
    BRA     stop                 : 6000 0000
  222  MESS(4): PRINTSTRING("Workspace full");                ->ENDERR
    LEA     (PC),A0              : 41FA 00EE
    JSR     printstring          : 4EB8 3E6A
    BRA     enderr               : 6000 0023
  223  MESS(5): PRINTSTRING("Assignment abandonned");         ->STOP
    LEA     (PC),A0              : 41FA 00FD
    JSR     printstring          : 4EB8 3E6A
    BRA     stop                 : 6000 002A
  224  MESS(6): PRINTSTRING("Too many fragments in net");     ->ENDERR
    LEA     (PC),A0              : 41FA 0113
    JSR     printstring          : 4EB8 3E6A
    BRA     enderr               : 6000 0031
  225  ENDERR:
  226     %IF INSTREAM#CONSOLE %START
    MOVE.L  instream,D0          : 202C 0040
    BEQ     L2                   : 6700 0000
  227        PRINTSTRING(" reading stream ")
    LEA     (PC),A0              : 41FA 012D
    JSR     printstring          : 4EB8 3E6A
  228        WRITE(INSTREAM,0)
    MOVEQ   #0,D1                : 7200
    MOVE.L  instream,D0          : 202C 0040
    JSR     write                : 4EAC 004A
  229     %FINISH
L2
  230     PRINTSTRING(" (in ");   PRINTSTRING(ERROR CONTEXT);   PRINTSYMBOL(')')
    LEA     (PC),A0              : 41FA 013E
    JSR     printstring          : 4EB8 3E6A
    LEA     errorcontext,A0      : 41EC FFB0
    JSR     printstring          : 4EB8 3E6A
    MOVEQ   #41,D0               : 7029
    JSR     printsymbol          : 4EB8 3E70
  231  STOP:
  232     NEWLINE
    BSR     newline              : 6100 00B5
  233     %STOP
    CLR.L   D0                   : 4280
    JSR     SIGNAL               : 4EB8 3EFA
  234  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
  235  
  236  %ROUTINESPEC SKIP TO(%INTEGER WHERE)
  237  
  238  %ROUTINE RCH
  239     %INTEGER I,   LEN
  240  !! Read the next character from the input
  241  !! Ignore newlines, and build control characters
  242  !! from ^+character.
  243  !! Ignore I-code comments (^K ...)
  244  
  245     %ON %EVENT 3,ENDFILE %START
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D6,-(A7)             : 2F06
    MOVE.L  A4,-(A7)             : 2F0C
    PEA     10(PC)               : 487A 000A
    MOVE.L  (A5),-(A7)           : 2F15
    MOVE.L  A7,(A5)              : 2A8F
    BRA     L1                   : 6000 0000
    DC      $0208                : 0208
  246        CH=END OF FILE
    MOVEQ   #-118,D0             : 708A
    MOVE.L  D0,ch                : 2940 003C
  247        ->OUT
    BRA     out                  : 6000 0000
  248     %FINISH
L1
  249  START:
  250     %CYCLE
L1
  251        READSYMBOL(CH)
    JSR     readsymbol           : 4EB8 3E76
    MOVE.L  D0,ch                : 2940 003C
  252     %REPEAT %UNTIL CH#NL
    MOVEQ   #10,D1               : 720A
    CMP.L   D1,D0                : B081
    BEQ     L1                   : 6700 001A
  253  
  254     %IF CH=CNTRL CHAR %START
    MOVEQ   #94,D2               : 745E
    CMP.L   D2,D0                : B082
    BNE     L2                   : 6600 0000
  255        READSYMBOL(CH)
    JSR     readsymbol           : 4EB8 3E76
    MOVE.L  D0,ch                : 2940 003C
  256        CH=CH+CNTRL
    MOVEQ   #-128,D1             : 7280
    SUB.L   D1,ch                : 93AC 003C
  257     %FINISH
L2
  258     %IF CH=CNTRL+'K' %START
    CMPI.L  #$00CB,ch            : 0CAC 0000 00CB 003C
    BNE     L2                   : 6600 0000
  259        !! skip an I-code comment
  260        READ(LEN);   RCH
    JSR     read                 : 4EAC 0044
    MOVE.L  D0,len               : 2F40 0010
    BSR     rch                  : 6100 01AF
  261        RCH %FOR I=1,1,LEN
    MOVE.L  len,437              : 2F2F 0010
    CLR.L   i                    : 42AF 0018
L3  MOVE.L  i,D0                 : 202F 0018
    CMP.L   437,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0018
    BSR     rch                  : 6100 01AF
    BRA     L3                   : 6000 0045
L4  ADDQ.L  #4,A7                : 588F
  262        ->START
    BRA     start                : 6000 001A
  263     %FINISH
L2
  264  OUT:
  265  %END
    MOVE.L  -24(F1),(A5)         : 2A97
^   MOVEQ   #-36,D4              : 78DC
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  266  
  267  %ROUTINE ZERO(%INTEGER NWORDS)
  268     !! ZERO the top NWORDS of the stack
  269     %INTEGER I,   P
  270     P=TOS
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  tos,p                : 2F2C 0030
  271     %FOR I=1,1,NWORDS %CYCLE
    MOVE.L  D0,438               : 2F00
    CLR.L   i                    : 42AF 0008
L1  MOVE.L  i,D0                 : 202F 0008
    CMP.L   438,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0008
  272        INTEGER(P)=0
    MOVEA.L p,A0                 : 206F 0004
    CLR.L   0(A0)                : 4290
  273        P=P+AUPW
    ADDQ.L  #4,p                 : 58AF 0004
  274     %REPEAT
    BRA     L1                   : 6000 000F
L2  ADDQ.L  #4,A7                : 588F
  275  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  276  
  277  !!**********************************************
  278  !! hashtable manipulation routines             *
  279  !!**********************************************
  280  
  281  !! hashtable for cross referencing UNIT names, NET names, PIN names, etc.
  282  %CONSTINTEGER HASHTABLE LEN=255;   !! must be 2**N-1
  283  %OWNINTEGERARRAY HASHTABLE(0:HASHTABLE LEN)=NULL(*)
  284  
  285  %ROUTINE CLEANUP(%INTEGER STACKTOP)
  286  !! Remove references to objects in workspace above
  287  !! STACKTOP (I.E. references to objects which will
  288  !! be overwritten).
  289     %INTEGER I
  290     %INTEGERNAME H
  291     %RECORD(FTAG)%NAME TAG
  292     STACKTOP=STACKTOP>>LAUPW
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    LSR.L   #2,D0                : E488
    MOVE.L  D0,stacktop          : 2F40 000C
  293     %FOR I=0,1,HASHTABLE LEN %CYCLE
    MOVEQ   #-1,D1               : 72FF
    MOVE.L  D1,i                 : 2F41 0008
L1  ADDQ.L  #1,i                 : 52AF 0008
  294        !! for each hashtable entry
  295        H==HASHTABLE(I)
    MOVE.L  i,D0                 : 202F 0008
    ASL.L   #2,D0                : E580
    LEA     80(A4,D0.L),A0       : 41F4 0850
    MOVE.L  A0,h                 : 2F48 0004
  296        %WHILE H#NULL %CYCLE
L3  MOVEA.L h,A0                 : 206F 0004
    MOVE.L  (A0),D0              : 2010
    BEQ     L4                   : 6700 0000
  297           !! for each TAG that hashes to the same entry
  298           TAG==RECORD(H)
    MOVEA.L D0,A1                : 2240
    MOVE.L  A1,tag               : 2E89
  299           %IF H>>LAUPW>=STACKTOP %START
    LSR.L   #2,D0                : E488
    CMP.L   stacktop,D0          : B0AF 000C
    BLT     L6                   : 6D00 0000
  300              H=TAG_HNEXT
    MOVE.L  4(A1),(A0)           : 20A9 0004
  301           %ELSE
    BRA     L5                   : 6000 0000
L6
  302              H==TAG_HNEXT
    LEA     4(A1),A2             : 45E9 0004
    MOVE.L  A2,h                 : 2F4A 0004
  303           %FINISH
L5
  304        %REPEAT
    BRA     L3                   : 6000 001C
L4
  305     %REPEAT
L1  CMPI.L  #$00FF,i             : 0CAF 0000 00FF 0008
    BNE     L1                   : 6600 0012
  306     TOS=STACKTOP<<LAUPW
    MOVE.L  stacktop,D0          : 202F 000C
    LSL.L   #2,D0                : E588
    MOVE.L  D0,tos               : 2940 0030
  307  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  308  
  309  %RECORD(FTAG)%MAP READ TAG(%INTEGER TYPE)
  310     %RECORD(FTAG)%NAME OLD,   NEW
  311     %INTEGER HASH,   I,   LEN
  312     %INTEGERNAME H
  313  !! read a name on to the stack and return the name of its TAG.
  314  !! Create a new TAG if one doesn't exist. 
  315  !! Tags of different TYPEs are chained from different
  316  !! hashtable entries, so that a tag of one type can never
  317  !! be confused with an identical tag of another type.
  318  !! (This is important as tags sometimes point to the
  319  !! object of that name. Caveat chip and unit with same name).
  320     READ(LEN);   RCH
    MOVEQ   #5,D1                : 7205
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D1,#-4               : 51C9 FFFC
    JSR     read                 : 4EAC 0044
    MOVE.L  D0,len               : 2F40 0004
    BSR     rch                  : 6100 01AF
  321     %IF LEN>0 %START
    MOVE.L  len,D0               : 202F 0004
    BLE     L2                   : 6F00 0000
  322        !! Not a null string
  323        HASH=LEN
    MOVE.L  D0,hash              : 2F40 000C
  324        ZERO(TAGLEN)
    MOVEQ   #2,D0                : 7002
    BSR     zero                 : 6100 01B1
  325        NEW==RECORD(TOS);   new_name = ""
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,new               : 2F48 0010
    CLR.B   8(A0)                : 4228 0008
  326        %FOR I=1,1,LEN %CYCLE
    MOVE.L  len,448              : 2F2F 0004
    CLR.L   i                    : 42AF 000C
L3  MOVE.L  i,D0                 : 202F 000C
    CMP.L   448,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 000C
  327           RCH
    BSR     rch                  : 6100 01AF
  328           new_name = new_name.tostring(ch)
    MOVEA.L new,A0               : 206F 0014
    LEA     8(A0),A1             : 43E8 0008
    MOVE.L  ch,D0                : 202C 003C
    ADDQ.B  #1,(A1)              : 5211
    MOVE.B  (A1),D4              : 1811
    MOVE.B  D0,0(A1,D4.L)        : 1380 4800
  329           HASH=HASH+CH*i
    MOVE.L  i,D1                 : 222F 000C
    JSR     IMUL                 : 4EB8 3EF4
    ADD.L   D0,hash              : D1AF 0010
  330        %REPEAT
    BRA     L3                   : 6000 002A
L4  ADDQ.L  #4,A7                : 588F
  331     %FINISH
L2
  332     !! No TAG if name is null or to be thrown away.
  333     %RESULT==RECORD(NULL) %IF LEN=0 %OR TYPE=DISCARD
    MOVE.L  len,D0               : 202F 0004
    BEQ     L3                   : 6700 0000
    MOVEQ   #-1,D1               : 72FF
    CMP.L   type,D1              : B2AF 0018
    BNE     L2                   : 6600 0000
L3  SUBA.L  A0,A0                : 91C8
    BRA     L0                   : 6000 0000
L2
  334  
  335     !! Lookup the name
  336     HASH=HASH+TYPE
    MOVE.L  type,D2              : 242F 0018
    ADD.L   D2,hash              : D5AF 000C
  337     H==HASHTABLE(HASH & HASHTABLE LEN)
    MOVE.L  hash,D3              : 262F 000C
    AND.L   #$00FF,D3            : C6BC 0000 00FF
    ASL.L   #2,D3                : E583
    LEA     80(A4,D3.L),A0       : 41F4 3850
    MOVE.L  A0,h                 : 2E88
  338     %WHILE H#NULL %CYCLE
L1  MOVEA.L h,A0                 : 2057
    MOVE.L  (A0),D0              : 2010
    BEQ     L2                   : 6700 0000
  339        !! for each name that hashes to the same entry
  340        OLD==RECORD(H)
    MOVEA.L D0,A1                : 2240
    MOVE.L  A1,old               : 2F49 0014
  341        %RESULT==OLD %IF OLD_NAME=NEW_NAME
    LEA     8(A1),A2             : 45E9 0008
    MOVEA.L new,A3               : 266F 0010
    LEA     8(A3),A0             : 41EB 0008
    CLR.L   D1                   : 4281
    MOVE.B  (A2),D1              : 1212
    CMPM.B  (A2)+,(A0)+          : B10A
    DBNE    D1,#-4               : 56C9 FFFC
    BNE     L4                   : 6600 0000
    MOVEA.L A1,A0                : 2049
    BRA     L0                   : 6000 0056
L4
  342        H==OLD_HNEXT
    LEA     4(A1),A0             : 41E9 0004
    MOVE.L  A0,h                 : 2E88
  343     %REPEAT
    BRA     L1                   : 6000 0066
L2
  344  
  345     !! name not found, so enter into table and create a new TAG.
  346     H=TOS
    MOVE.L  tos,(A0)             : 20AC 0030
  347     CLAIM(TAGLEN+(LEN+CPW)>>LCPW);   !! Space for string
    MOVE.L  len,D0               : 202F 0004
    ADDQ.L  #4,D0                : 5880
    LSR.L   #2,D0                : E488
    ADDQ.L  #2,D0                : 5480
    BSR     claim                : 6100 01AC
  348     %RESULT==NEW
    MOVEA.L new,A0               : 206F 0010
    BRA     L0                   : 6000 007F
  349  %END
^   MOVEQ   #-40,D4              : 78D8
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  350  
  351  !!*******************************************
  352  !! more miscellaneous input and output      *
  353  !! routines. Used to read I-code objects,   *
  354  !! output I-code objects, and to skip past  *
  355  !! chunks of I-code.                        *
  356  !!*******************************************
  357  
  358  %ROUTINE SKIP TAG
  359     %RECORD(FTAG)%NAME GASH
  360     GASH==READ TAG(DISCARD)
    MOVEQ   #-1,D0               : 70FF
    BSR     readtag              : 6100 01B7
    MOVE.L  A0,gash              : 2F08
  361  %END
^   MOVEQ   #-12,D4              : 78F4
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
? 361  GASH underused  %END
  362  
  363  %RECORD(FHEAD)%MAP READ CHIP HEADER
  364  !! Read an I-code header and map it.
  365  !! This is used by SELECT A CHIP to read in chips.
  366     %RECORD(FHEAD)%NAME H
  367     %RECORD(FTERMINAL)%NAME T
  368     %INTEGER I,   PNO,   PTYPE
  369  
  370     ZERO(HEADLEN);         ! Clear the top of the stack
    MOVEQ   #4,D0                : 7004
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D0,#-4               : 51C8 FFFC
    MOVEQ   #13,D0               : 700D
    BSR     zero                 : 6100 01B1
  371     H==RECORD(TOS);      ! and map the header
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,h                 : 2F48 0010
  372     READ(H_OPTIONS);
    JSR     read                 : 4EAC 0044
    MOVEA.L h,A0                 : 206F 0010
    MOVE.L  D0,0(A0)             : 2080
  373     BREAD(H_NIN);   BREAD(H_NOUT);  BREAD(H_NIO);   BREAD(H_NT)
    LEA     4(A0),A0             : 41E8 0004
    BSR     bread                : 6100 01A8
    MOVEA.L h,A0                 : 206F 0010
    LEA     5(A0),A0             : 41E8 0005
    BSR     bread                : 6100 01A8
    MOVEA.L h,A0                 : 206F 0010
    LEA     6(A0),A0             : 41E8 0006
    BSR     bread                : 6100 01A8
    MOVEA.L h,A0                 : 206F 0010
    LEA     7(A0),A0             : 41E8 0007
    BSR     bread                : 6100 01A8
  374     !! claim space for the header record
  375     CLAIM(HEADLEN+H_NT*TERMINALLEN)
    MOVEA.L h,A0                 : 206F 0010
    MOVE.B  7(A0),D4             : 1828 0007
    MOVE.L  D4,D0                : 2004
    ADD.L   D0,D0                : D080
    MOVEQ   #13,D1               : 720D
    ADD.L   D1,D0                : D081
    BSR     claim                : 6100 01AC
  376  
  377     H_UNAME==READTAG(GENERAL);      ! Read the unique name of the instance
    MOVEQ   #0,D0                : 7000
    BSR     readtag              : 6100 01B7
    MOVEA.L h,A1                 : 226F 0010
    MOVE.L  A0,8(A1)             : 2348 0008
  378     H_NAME==READ TAG(CHIPNAME)
    MOVEQ   #2,D0                : 7002
    BSR     readtag              : 6100 01B7
    MOVEA.L h,A1                 : 226F 0010
    MOVE.L  A0,12(A1)            : 2348 000C
  379  
  380     !! Read in the terminal information
  381     %FOR I=1,1,H_NT %CYCLE
    MOVE.B  7(A1),D4             : 1829 0007
    MOVE.L  D4,450               : 2F04
    CLR.L   i                    : 42AF 000C
L1  MOVE.L  i,D0                 : 202F 000C
    CMP.L   450,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 000C
  382        RCH;            ! Skip ^T
    BSR     rch                  : 6100 01AF
  383        T==H_T(I)
    MOVE.L  i,D0                 : 202F 000C
    ASL.L   #3,D0                : E780
    MOVEA.L h,A0                 : 206F 0014
    LEA     40(A0,D0.L),A1       : 43F0 0828
    MOVE.L  A1,t                 : 2F49 0010
  384        READ(T_INFO)
    JSR     read                 : 4EAC 0044
    MOVEA.L t,A0                 : 206F 0010
    MOVE.L  D0,0(A0)             : 2080
  385        T_PIN==READTAG(GENERAL);   SKIP TAG
    MOVEQ   #0,D0                : 7000
    BSR     readtag              : 6100 01B7
    MOVEA.L t,A1                 : 226F 0010
    MOVE.L  A0,4(A1)             : 2348 0004
    BSR     skiptag              : 6100 01B9
  386     %REPEAT
    BRA     L1                   : 6000 0052
L2  ADDQ.L  #4,A7                : 588F
  387  
  388     !! Read in the parameter strings
  389     %CYCLE
L1
  390        RCH
    BSR     rch                  : 6100 01AF
  391        %EXIT %UNLESS CH=CNTRL+'P'
    CMPI.L  #$00D0,ch            : 0CAC 0000 00D0 003C
    BNE     L2                   : 6600 0000
  392        READ(PNO);   SKIPSYMBOL
    JSR     read                 : 4EAC 0044
    MOVE.L  D0,pno               : 2F40 0004
    JSR     skipsymbol           : 4EB8 3E76
  393        %IF PNO=ON %THEN PTYPE=PACKNAME %ELSE PTYPE=GENERAL
    MOVEQ   #2,D0                : 7002
    CMP.L   pno,D0               : B0AF 0004
    BNE     L4                   : 6600 0000
    MOVEQ   #3,D1                : 7203
    MOVE.L  D1,ptype             : 2E81
    BRA     L3                   : 6000 0000
L4  CLR.L   ptype                : 4297
L3
  394        H_PARM(PNO)==READ TAG(PTYPE)
    MOVE.L  ptype,D0             : 2017
    BSR     readtag              : 6100 01B7
    MOVE.L  pno,D0               : 202F 0004
    ASL.L   #2,D0                : E580
    MOVEA.L h,A1                 : 226F 0010
    MOVE.L  A0,12(A1,D0.L)       : 2388 080C
  395     %REPEAT
    BRA     L1                   : 6000 007A
L2
  396     RCH;   !! skip ^G
    BSR     rch                  : 6100 01AF
  397  
  398     !! CH is set to the next control character ^H, ^J, etc.
  399     %RESULT==H
    MOVEA.L h,A0                 : 206F 0010
    BRA     L0                   : 6000 0000
  400  %END
^   MOVEQ   #-32,D4              : 78E0
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  401  
  402  !! length and max length of an I-code line (for output)
  403  %OWNINTEGER LINECT=0
  404  %CONSTINTEGER LINELEN=60
  405  
  406  %ROUTINE PCH(%INTEGER CHAR)
  407  !! put a character to the I-code. Take care of control
  408  !! characters and increment the current line length.
  409     %IF CHAR>=CNTRL %START
    CMP.L   #$0080,D0            : B0BC 0000 0080
    BLT     L2                   : 6D00 0000
  410        PRINTSYMBOL(CNTRL CHAR)
    MOVEQ   #94,D0               : 705E
    JSR     printsymbol          : 4EB8 3E70
  411        LINECT=LINECT+1
    ADDQ.L  #1,linect            : 52AC 0450
  412     %FINISH
L2
  413     PRINTSYMBOL(CHAR&16_7F)
    MOVEQ   #127,D0              : 707F
    AND.L   char,D0              : C097
    JSR     printsymbol          : 4EB8 3E70
  414     LINECT=LINECT+1
    ADDQ.L  #1,linect            : 52AC 0450
  415  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  416  
  417  %ROUTINE SKIPCH
  418  !! Read and print a character. Print NL at end of file
  419     RCH
    BSR     rch                  : 6100 01AF
  420     PCH(CH)
    MOVE.L  ch,D0                : 202C 003C
    BSR     pch                  : 6100 01BF
  421  %END
^   MOVEQ   #-8,D4               : 78F8
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  422  
  423  %ROUTINE SKIP TO(%INTEGER WHERE)
  424  !! Skip to the character WHERE. Don't move if already there.
  425     %CYCLE
L1
  426        %EXIT %IF CH=WHERE %OR CH<0 %OR CH=CNTRL+'E'
    MOVE.L  ch,D0                : 202C 003C
    CMP.L   where,D0             : B097
    BEQ     L5                   : 6700 0000
    MOVE.L  D0,D0                : 2000
    BLT     L5                   : 6D00 000C
    CMP.L   #$00C5,D0            : B0BC 0000 00C5
    BNE     L4                   : 6600 0000
L5  BRA     L2                   : 6000 0000
L4
  427        RCH
    BSR     rch                  : 6100 01AF
  428     %REPEAT
    BRA     L1                   : 6000 0007
L2
  429  %END
^   MOVEQ   #-8,D4               : 78F8
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  430  
  431  %ROUTINE SKIP UNITS TO(%INTEGER WHERE)
  432  !! Skip past any UNITs to character WHERE.
  433  !! Don't move if already there.
  434     %CYCLE
L1
  435        %EXIT %IF CH=WHERE %OR CH<0
    MOVE.L  ch,D0                : 202C 003C
    CMP.L   where,D0             : B097
    BEQ     L5                   : 6700 0000
    MOVE.L  D0,D0                : 2000
    BGE     L4                   : 6C00 0000
L5  BRA     L2                   : 6000 0000
L4
  436        RCH
    BSR     rch                  : 6100 01AF
  437        SKIP UNITS TO(CNTRL+'E') %IF CH=CNTRL+'U'
    CMPI.L  #$00D5,ch            : 0CAC 0000 00D5 003C
    BNE     L4                   : 6600 0000
    MOVE.L  #$00C5,D0            : 203C 0000 00C5
    BSR     skipunitsto          : 6100 01C2
L4
  438     %REPEAT
    BRA     L1                   : 6000 0007
L2
  439  %END
^   MOVEQ   #-8,D4               : 78F8
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  440  
  441  %ROUTINE SEPARATE
  442  !! Put out a newline to the I-code if required.
  443     NEWLINE %AND LINECT=0 %IF LINECT>=LINELEN
    MOVEQ   #60,D0               : 703C
    CMP.L   linect,D0            : B0AC 0450
    BGT     L2                   : 6E00 0000
    BSR     newline              : 6100 00B5
    CLR.L   linect               : 42AC 0450
L2
  444  %END
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  445  
  446  %ROUTINE PUT TO(%INTEGER WHERE)
  447  !! Skip past characters, putting them out to the I-code
  448  !! until we get to character WHERE.
  449     %CYCLE
L1
  450        SEPARATE %IF CH>=CNTRL
    CMPI.L  #$0080,ch            : 0CAC 0000 0080 003C
    BLT     L4                   : 6D00 0000
    BSR     separate             : 6100 01C3
L4
  451        SKIPCH
    BSR     skipch               : 6100 01C0
  452        PUT TO(CNTRL+'E') %IF CH=CNTRL+'U'
    CMPI.L  #$00D5,ch            : 0CAC 0000 00D5 003C
    BNE     L4                   : 6600 0000
    MOVE.L  #$00C5,D0            : 203C 0000 00C5
    BSR     putto                : 6100 01C5
L4
  453        %EXIT %IF CH=WHERE %OR CH<0
    MOVE.L  ch,D0                : 202C 003C
    CMP.L   where,D0             : B097
    BEQ     L5                   : 6700 0000
    MOVE.L  D0,D0                : 2000
    BGE     L4                   : 6C00 0000
L5  BRA     L2                   : 6000 0000
L4
  454     %REPEAT
    BRA     L1                   : 6000 0007
L2
  455  %END
^   MOVEQ   #-8,D4               : 78F8
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  456  
  457  %ROUTINE PDEC(%INTEGER N)
  458  !! put a decimal number to the I-code
  459     WRITE(N,0)
    MOVEQ   #0,D1                : 7200
    JSR     write                : 4EAC 004A
  460     LINECT=LINECT+2;   ! approximate length
    ADDQ.L  #2,linect            : 54AC 0450
  461     SEPARATE
    BSR     separate             : 6100 01C3
  462  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  463  
  464  %ROUTINE BLANK
  465     PCH(' ')
    MOVEQ   #32,D0               : 7020
    BSR     pch                  : 6100 01BF
  466  %END
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  467  
  468  %ROUTINE PUT STR(%STRING(255)%NAME S)
  469     %INTEGER L
  470  !! print out a string in I-code format
  471     %IF S==STRING(NULL) %THEN L=0 %ELSE L=LENGTH(S)
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  A0,D0                : 2008
    BNE     L2                   : 6600 0000
    CLR.L   l                    : 4297
    BRA     L1                   : 6000 0000
L2  MOVE.B  0(A0),D4             : 1810
    MOVE.L  D4,l                 : 2E84
L1
  472     WRITE(L,0);   PCH(':')
    MOVEQ   #0,D1                : 7200
    MOVE.L  l,D0                 : 2017
    JSR     write                : 4EAC 004A
    MOVEQ   #58,D0               : 703A
    BSR     pch                  : 6100 01BF
  473     PRINTSTRING(S) %UNLESS L=0
    MOVE.L  l,D0                 : 2017
    BEQ     L2                   : 6700 0000
    MOVEA.L s,A0                 : 206F 0004
    JSR     printstring          : 4EB8 3E6A
L2
  474     LINECT=LINECT+L+2
    MOVE.L  linect,D0            : 202C 0450
    ADD.L   l,D0                 : D097
    ADDQ.L  #2,D0                : 5480
    MOVE.L  D0,linect            : 2940 0450
  475     SEPARATE
    BSR     separate             : 6100 01C3
  476  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  477  
  478  %ROUTINE PUT TAG(%RECORD(FTAG)%NAME T)
  479     %STRING(255)%NAME NAME
  480  !! print out a TAG's name in I-code format
  481     %IF T==RECORD(NULL) %THEN NAME==STRING(NULL) %ELSE NAME==T_NAME
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  A0,D0                : 2008
    BNE     L2                   : 6600 0000
    CLR.L   name                 : 4297
    BRA     L1                   : 6000 0000
L2  LEA     8(A0),A1             : 43E8 0008
    MOVE.L  A1,name              : 2E89
L1
  482     PUT STR(NAME)
    MOVEA.L name,A0              : 2057
    BSR     putstr               : 6100 01C9
  483  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  484  
  485  %ROUTINE SKIP NUM
  486     %INTEGER DISCARD
  487     READ(DISCARD)
    JSR     read                 : 4EAC 0044
    MOVE.L  D0,discard           : 2F00
  488  %END
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
? 488  DISCARD underused %END
  489  
  490  %ROUTINE COPY NUM
  491     %INTEGER N
  492     READ(N);   PDEC(N)
    JSR     read                 : 4EAC 0044
    MOVE.L  D0,n                 : 2F00
    BSR     pdec                 : 6100 01C6
  493  %END
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  494  
  495  %ROUTINE PUT HEAD(%RECORD(FHEAD)%NAME H)
  496  !! output a UNIT or instance header in I-code format
  497  !! This is used to output chip descriptions, and also
  498  !! when rescanning the primary input.
  499     %INTEGER I
  500     %RECORD(FTERMINAL)%NAME T
  501     %RECORD(FTAG)%NAME P
  502  
  503     PCH(CNTRL+'H')
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  #$00C8,D0            : 203C 0000 00C8
    BSR     pch                  : 6100 01BF
  504     PDEC(H_OPTIONS);   BLANK
    MOVEA.L h,A0                 : 206F 000C
    MOVE.L  0(A0),D0             : 2010
    BSR     pdec                 : 6100 01C6
    BSR     blank                : 6100 01C8
  505     PDEC(H_NIN);       BLANK
    MOVEA.L h,A0                 : 206F 000C
    MOVE.B  4(A0),D4             : 1828 0004
    MOVE.L  D4,D0                : 2004
    BSR     pdec                 : 6100 01C6
    BSR     blank                : 6100 01C8
  506     PDEC(H_NOUT);      BLANK
    MOVEA.L h,A0                 : 206F 000C
    MOVE.B  5(A0),D4             : 1828 0005
    MOVE.L  D4,D0                : 2004
    BSR     pdec                 : 6100 01C6
    BSR     blank                : 6100 01C8
  507     PDEC(H_NIO);       BLANK
    MOVEA.L h,A0                 : 206F 000C
    MOVE.B  6(A0),D4             : 1828 0006
    MOVE.L  D4,D0                : 2004
    BSR     pdec                 : 6100 01C6
    BSR     blank                : 6100 01C8
  508     PDEC(H_NT);        BLANK
    MOVEA.L h,A0                 : 206F 000C
    MOVE.B  7(A0),D4             : 1828 0007
    MOVE.L  D4,D0                : 2004
    BSR     pdec                 : 6100 01C6
    BSR     blank                : 6100 01C8
  509     PUT TAG(H_UNAME);   PUT TAG(H_NAME)
    MOVEA.L h,A0                 : 206F 000C
    MOVEA.L 8(A0),A0             : 2068 0008
    BSR     puttag               : 6100 01CC
    MOVEA.L h,A0                 : 206F 000C
    MOVEA.L 12(A0),A0            : 2068 000C
    BSR     puttag               : 6100 01CC
  510  
  511     !! output the TERMINALs
  512     %FOR I=1,1,H_NT %CYCLE
    MOVEA.L h,A0                 : 206F 000C
    MOVE.B  7(A0),D4             : 1828 0007
    MOVE.L  D4,473               : 2F04
    CLR.L   i                    : 42AF 000C
L1  MOVE.L  i,D0                 : 202F 000C
    CMP.L   473,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 000C
  513        T==H_T(I)
    MOVE.L  i,D0                 : 202F 000C
    ASL.L   #3,D0                : E780
    MOVEA.L h,A0                 : 206F 0010
    LEA     40(A0,D0.L),A1       : 43F0 0828
    MOVE.L  A1,t                 : 2F49 0008
  514        PCH(CNTRL+'T')
    MOVE.L  #$00D4,D0            : 203C 0000 00D4
    BSR     pch                  : 6100 01BF
  515        PDEC(T_INFO);   BLANK
    MOVEA.L t,A0                 : 206F 0008
    MOVE.L  0(A0),D0             : 2010
    BSR     pdec                 : 6100 01C6
    BSR     blank                : 6100 01C8
  516        PUT TAG(T_PIN);   PUT TAG(NULL TAG)
    MOVEA.L t,A0                 : 206F 0008
    MOVEA.L 4(A0),A0             : 2068 0004
    BSR     puttag               : 6100 01CC
    MOVEA.L nulltag,A0           : 206C FFF0
    BSR     puttag               : 6100 01CC
  517     %REPEAT
    BRA     L1                   : 6000 0055
L2  ADDQ.L  #4,A7                : 588F
  518  
  519     !! output the parameters, if present
  520     %FOR I=1,1,MAX PARMS %CYCLE
    CLR.L   i                    : 42AF 0008
L1  ADDQ.L  #1,i                 : 52AF 0008
  521        P==H_PARM(I)
    MOVE.L  i,D0                 : 202F 0008
    ASL.L   #2,D0                : E580
    MOVEA.L h,A0                 : 206F 000C
    MOVE.L  12(A0,D0.L),p        : 2EB0 080C
  522        %UNLESS P==RECORD(NULL) %START
    BEQ     L4                   : 6700 0000
  523           PCH(CNTRL+'P')
    MOVE.L  #$00D0,D0            : 203C 0000 00D0
    BSR     pch                  : 6100 01BF
  524           PDEC(I);   BLANK
    MOVE.L  i,D0                 : 202F 0008
    BSR     pdec                 : 6100 01C6
    BSR     blank                : 6100 01C8
  525           PUT TAG(P)
    MOVEA.L p,A0                 : 2057
    BSR     puttag               : 6100 01CC
  526        %FINISH
L4
  527     %REPEAT
L1  MOVEQ   #8,D0                : 7008
    CMP.L   i,D0                 : B0AF 0008
    BNE     L1                   : 6600 0086
  528     PCH(CNTRL+'G')
    MOVE.L  #$00C7,D0            : 203C 0000 00C7
    BSR     pch                  : 6100 01BF
  529  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  530  
  531  %INTEGERFN STOI(%STRING(255)%NAME S)
  532  !! Read a string as a (positive) integer
  533  !! Ignore characters that are not digits
  534     %INTEGER I,   N,   D
  535     N=0
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    CLR.L   n                    : 42AF 0004
  536     %FOR I=1,1,LENGTH(S) %CYCLE
    MOVE.B  0(A0),D4             : 1810
    MOVE.L  D4,476               : 2F04
    CLR.L   i                    : 42AF 000C
L1  MOVE.L  i,D0                 : 202F 000C
    CMP.L   476,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 000C
  537        D=CHARNO(S,I)-'0'
    MOVEA.L s,A0                 : 206F 0010
    MOVE.L  i,D0                 : 202F 000C
    MOVE.B  0(A0,D0.L),D4        : 1830 0800
    MOVE.L  D4,D1                : 2204
    MOVEQ   #-48,D2              : 74D0
    ADD.L   D2,D1                : D282
    MOVE.L  D1,d                 : 2F41 0004
  538        N=N*10+D %If 0<=D<=9
    BLT     L4                   : 6D00 0000
    MOVEQ   #9,D3                : 7609
    CMP.L   D3,D1                : B283
    BGT     L4                   : 6E00 0027
    MOVE.L  n,D0                 : 202F 0008
    ADD.L   D0,D0                : D080
    MOVE.L  D0,-(A7)             : 2F00
    ASL.L   #2,D0                : E580
    ADD.L   (A7)+,D0             : D09F
    ADD.L   D1,D0                : D081
    MOVE.L  D0,n                 : 2F40 0008
L4
  539     %REPEAT
    BRA     L1                   : 6000 0012
L2  ADDQ.L  #4,A7                : 588F
  540     %RESULT=N
    MOVE.L  n,D0                 : 202F 0004
    BRA     L0                   : 6000 0000
  541  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  542  
  543  %RECORD(FSUBUNIT)%MAP READ SUBUNIT
  544     %RECORD(FTAG)%NAME TAG
  545     %RECORD(FSUBUNIT)%NAME S
  546     %INTEGER PNO,   OPTIONS,   I
  547     %SWITCH PARM(AT:SUB)
  548  !! Read a subunit (including any enclosed subUNITs)
  549  !! from the primary input.
  550  !! Pin and terminal-name information is thrown away.
  551  !! Only AT, ON, PACKNO, and SUB parameters are retained.
  552     SKIP NUM
    MOVEQ   #4,D0                : 7004
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D0,#-4               : 51C8 FFFC
    BSR     skipnum              : 6100 01CF
  553     S==RECORD(TOS);  ZERO(SUBUNITLEN)
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,s                 : 2F48 000C
    MOVEQ   #10,D0               : 700A
    BSR     zero                 : 6100 01B1
  554     BREAD(S_NIN);   BREAD(S_NOUT);   BREAD(S_NIO);   BREAD(S_NT)
    MOVEA.L s,A0                 : 206F 000C
    LEA     20(A0),A0            : 41E8 0014
    BSR     bread                : 6100 01A8
    MOVEA.L s,A0                 : 206F 000C
    LEA     21(A0),A0            : 41E8 0015
    BSR     bread                : 6100 01A8
    MOVEA.L s,A0                 : 206F 000C
    LEA     22(A0),A0            : 41E8 0016
    BSR     bread                : 6100 01A8
    MOVEA.L s,A0                 : 206F 000C
    LEA     23(A0),A0            : 41E8 0017
    BSR     bread                : 6100 01A8
  555     CLAIM(SUBUNITLEN+S_NT)
    MOVEA.L s,A0                 : 206F 000C
    MOVE.B  23(A0),D4            : 1828 0017
    MOVE.L  D4,D0                : 2004
    MOVEQ   #10,D1               : 720A
    ADD.L   D1,D0                : D081
    BSR     claim                : 6100 01AC
  556     S_UNAME==READ TAG(GENERAL);   TAG==READ TAG(UNITNAME)
    MOVEQ   #0,D0                : 7000
    BSR     readtag              : 6100 01B7
    MOVEA.L s,A1                 : 226F 000C
    MOVE.L  A0,0(A1)             : 2288
    MOVEQ   #1,D0                : 7001
    BSR     readtag              : 6100 01B7
    MOVE.L  A0,tag               : 2F48 0010
  557     ERROR CONTEXT=TAG_NAME
    LEA     8(A0),A1             : 43E8 0008
    LEA     errorcontext,A2      : 45EC FFB0
    MOVE.B  (A1),D0              : 1011
    MOVE.B  (A1)+,(A2)+          : 14D9
    SUBQ.B  #1,D0                : 5300
    BCC     #-6                  : 64FA
  558     S_NAME==TAG;   S_NEXT==TAG_OWNER;   TAG_OWNER==S
    MOVEA.L s,A1                 : 226F 000C
    MOVE.L  A0,4(A1)             : 2348 0004
    MOVEA.L tag,A2               : 246F 0010
    MOVE.L  0(A2),28(A1)         : 2352 001C
    MOVE.L  A1,0(A2)             : 2489
  559  
  560     !! Skip terminals
  561     %FOR I=1,1,S_NT %CYCLE
    MOVEA.L s,A0                 : 206F 000C
    MOVE.B  23(A0),D4            : 1828 0017
    MOVE.L  D4,484               : 2F04
    CLR.L   i                    : 42AF 0004
L1  MOVE.L  i,D0                 : 202F 0004
    CMP.L   484,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0004
  562        RCH;   READ(S_INFO(I));   SKIP TAG;   SKIP TAG
    BSR     rch                  : 6100 01AF
    JSR     read                 : 4EAC 0044
    MOVE.L  i,D1                 : 222F 0004
    ASL.L   #2,D1                : E581
    MOVEA.L s,A0                 : 206F 0010
    MOVE.L  D0,36(A0,D1.L)       : 2180 1824
    BSR     skiptag              : 6100 01B9
    BSR     skiptag              : 6100 01B9
  563     %REPEAT
    BRA     L1                   : 6000 0060
L2  ADDQ.L  #4,A7                : 588F
  564  
  565     !! Get parameters if any. ON, AT, PACKNO, SUBPACK
  566     RCH
    BSR     rch                  : 6100 01AF
  567     %WHILE CH=CNTRL+'P' %CYCLE
L1  CMPI.L  #$00D0,ch            : 0CAC 0000 00D0 003C
    BNE     L2                   : 6600 0000
  568        READ(PNO)
    JSR     read                 : 4EAC 0044
    MOVE.L  D0,pno               : 2F40 0008
  569        %IF PNO>SUB %START
    MOVEQ   #4,D1                : 7204
    CMP.L   D1,D0                : B081
    BLE     L4                   : 6F00 0000
  570           SKIP TAG;   ->NEXT
    BSR     skiptag              : 6100 01B9
    BRA     next                 : 6000 0000
  571        %FINISH %ELSE %IF PNO=ON %START
L4  MOVEQ   #2,D2                : 7402
    CMP.L   D2,D0                : B082
    BNE     L4                   : 6600 0000
  572           OPTIONS=CHIPNAME
    MOVE.L  D2,options           : 2F42 0004
  573        %ELSE
    BRA     L3                   : 6000 0000
L4
  574           OPTIONS=GENERAL
    CLR.L   options              : 42AF 0004
  575        %FINISH
L3
  576        TAG==READ TAG(OPTIONS)
    MOVE.L  options,D0           : 202F 0004
    BSR     readtag              : 6100 01B7
    MOVE.L  A0,tag               : 2F48 0010
  577        ->PARM(PNO)
    MOVE.L  pno,D0               : 202F 0008
    LEA     3B_0806,A0           : 41FB 0806
    ADDA.L  D0,A0                : D1C0
    ADDA.W  (A0),A0              : D0D0
    JMP     (A0)                 : 4ED0
  578  PARM(AT):
  579        S_AT==TAG;   S_FLAGS=S_FLAGS!CONSTRAINT
    MOVEA.L s,A0                 : 206F 000C
    MOVE.L  tag,12(A0)           : 216F 0010 000C
    ORI.B   #4,24(A0)            : 0028 0004 0018
  580        ->NEXT
    BRA     next                 : 6000 0093
  581  PARM(ON):
  582        S_ON==TAG
    MOVEA.L s,A0                 : 206F 000C
    MOVE.L  tag,8(A0)            : 216F 0010 0008
  583        ->NEXT
    BRA     next                 : 6000 00C0
  584  PARM(PACKNO):
  585        S_PACKNAME==TAG;   S_FLAGS=S_FLAGS!CONSTRAINT
    MOVEA.L s,A0                 : 206F 000C
    MOVE.L  tag,16(A0)           : 216F 0010 0010
    ORI.B   #4,24(A0)            : 0028 0004 0018
  586        ->NEXT
    BRA     next                 : 6000 00C9
  587  PARM(SUB):
  588        S_SUBPACK=STOI(TAG_NAME);   S_FLAGS=CONSTRAINT+SUBCONSTRAINT
    MOVEA.L tag,A0               : 206F 0010
    LEA     8(A0),A0             : 41E8 0008
    BSR     stoi                 : 6100 01D6
    MOVEA.L s,A0                 : 206F 000C
    MOVE.B  D0,25(A0)            : 1140 0019
    MOVE.B  #12,24(A0)           : 117C 000C 0018
  589        ->NEXT
    BRA     next                 : 6000 00D5
  590  NEXT:
  591        RCH
    BSR     rch                  : 6100 01AF
  592     %REPEAT
    BRA     L1                   : 6000 007E
L2
  593     RCH;   !! skip ^G
    BSR     rch                  : 6100 01AF
  594     %RESULT==S
    MOVEA.L s,A0                 : 206F 000C
    BRA     L0                   : 6000 0000
  595  %END
^   MOVEQ   #-32,D4              : 78E0
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  596  
  597  %RECORD(FNET)%MAP READ NET
  598     %RECORD(FNET)%NAME NET
  599     %RECORD(FFRAGMENT)%NAME FRAG
  600     %RECORD(FFRAGMENT)%NAME %ARRAY TEMP(1:MAX FRAGS)
  601     %RECORD(FFANEL)%NAME F
  602     %RECORD(FTAG)%NAME TAG
  603     %INTEGER I, NF, GLOBALNET
  604  !! Read a NET from the I-code and map it. 
  605  !! A net consists of a number of net-fragments, each of
  606  !! which has a name and a list of fan-elements.
  607  !! A net containing any fragment with a name beginning with '.'
  608  !! is deemed to be 'global' and flagged as such. All global
  609  !! fragments must be collected together before being output.
  610     NF=0;   GLOBALNET=NO
    MOVEQ   #26,D0               : 701A
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D0,#-4               : 51C8 FFFC
    CLR.L   nf                   : 42AF 0004
    MOVEQ   #-1,D0               : 70FF
    MOVE.L  D0,globalnet         : 2E80
  611     !! CH=^N
  612     %CYCLE
L1
  613        RCH;   %EXIT %UNLESS CH=CNTRL+'A'
    BSR     rch                  : 6100 01AF
    CMPI.L  #$00C1,ch            : 0CAC 0000 00C1 003C
    BNE     L2                   : 6600 0000
  614        !! got a fragment
  615        TAG==READ TAG(NETNAME)
    MOVEQ   #4,D0                : 7004
    BSR     readtag              : 6100 01B7
    MOVE.L  A0,tag               : 2F48 000C
  616        GLOBALNET=YES %IF CHARNO(TAG_NAME,1)='.'
    CMPI.B  #46,9(A0)            : 0C28 002E 0009
    BNE     L4                   : 6600 0000
    CLR.L   globalnet            : 4297
L4
  617        FRAG==RECORD(TOS);   FRAG_NAME==TAG;   READ(FRAG_FAN)
    MOVEA.L tos,A1               : 226C 0030
    MOVE.L  A1,frag              : 2F49 0064
    MOVE.L  A0,0(A1)             : 2288
    JSR     read                 : 4EAC 0044
    MOVEA.L frag,A0              : 206F 0064
    MOVE.L  D0,4(A0)             : 2140 0004
  618        %FOR I=1,1,FRAG_FAN %CYCLE
    MOVE.L  D0,488               : 2F00
    CLR.L   i                    : 42AF 000C
L3  MOVE.L  i,D0                 : 202F 000C
    CMP.L   488,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 000C
  619           F==FRAG_F(I);      READ(F_SUBNO);   READ(F_TNO)
    MOVE.L  i,D0                 : 202F 000C
    ASL.L   #3,D0                : E780
    MOVEA.L frag,A0              : 206F 0068
    LEA     0(A0,D0.L),A0        : D1C0
    MOVE.L  A0,f                 : 2F48 0014
    JSR     read                 : 4EAC 0044
    MOVEA.L f,A0                 : 206F 0014
    MOVE.L  D0,0(A0)             : 2080
    JSR     read                 : 4EAC 0044
    MOVEA.L f,A0                 : 206F 0014
    MOVE.L  D0,4(A0)             : 2140 0004
  620        %REPEAT
    BRA     L3                   : 6000 0036
L4  ADDQ.L  #4,A7                : 588F
  621        CLAIM(FRAGMENTLEN+FRAG_FAN*FANLEN)
    MOVEA.L frag,A0              : 206F 0064
    MOVE.L  4(A0),D0             : 2028 0004
    ADD.L   D0,D0                : D080
    ADDQ.L  #2,D0                : 5480
    BSR     claim                : 6100 01AC
  622        NF=NF+1
    ADDQ.L  #1,nf                : 52AF 0004
  623        FAIL(D6) %IF NF>MAX FRAGS
    MOVEQ   #20,D0               : 7014
    CMP.L   nf,D0                : B0AF 0004
    BGE     L4                   : 6C00 0000
    MOVEQ   #6,D0                : 7006
    BSR     fail                 : 6100 01AB
L4
  624        TEMP(NF)==FRAG
    MOVE.L  nf,D1                : 222F 0004
    ASL.L   #2,D1                : E581
    MOVE.L  frag,16(A7,D1.L)     : 2FAF 0064 1810
  625     %REPEAT
    BRA     L1                   : 6000 0010
L2
  626  
  627     !! CH set to next control char (not ^A)
  628     NET==RECORD(TOS);   ZERO(NETLEN)
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,net               : 2F48 0068
    MOVEQ   #2,D0                : 7002
    BSR     zero                 : 6100 01B1
  629     CLAIM(NETLEN+NF)
    MOVE.L  nf,D0                : 202F 0004
    ADDQ.L  #2,D0                : 5480
    BSR     claim                : 6100 01AC
  630     %FOR I=1,1,NF %CYCLE
    MOVE.L  nf,489               : 2F2F 0004
    CLR.L   i                    : 42AF 000C
L1  MOVE.L  i,D0                 : 202F 000C
    CMP.L   489,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 000C
  631        NET_F(I)==TEMP(I)
    MOVE.L  i,D0                 : 202F 000C
    ASL.L   #2,D0                : E580
    MOVEA.L net,A0               : 206F 006C
    MOVE.L  20(A7,D0.L),4(A0,D0.L): 21B7 0814 0804
  632     %REPEAT
    BRA     L1                   : 6000 0087
L2  ADDQ.L  #4,A7                : 588F
  633     NET_NF=NF;   NET_FLAGS=GLOBAL %IF GLOBALNET=YES
    MOVEA.L net,A0               : 206F 0068
    MOVE.L  nf,D1                : 222F 0004
    MOVE.B  D1,5(A0)             : 1141 0005
    MOVE.L  globalnet,D2         : 2417
    BNE     L2                   : 6600 0000
    MOVE.B  #1,4(A0)             : 117C 0001 0004
L2
  634     %RESULT==NET
    BRA     L0                   : 6000 0000
  635  %END
^   MOVEQ   #-120,D4             : 7888
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  636  
  637  !!**************************************************
  638  !! start of routine used to select chips from the  *
  639  !! chip library.                                   *
  640  !!**************************************************
  641  
  642  %PREDICATE SAME KIND(%RECORD(FSUBUNIT)%NAME U, %RECORD(FSUBCHIP)%NAME S)
  643     %INTEGER I
  644  !! Decide whether or not a subUNIT and a subCHIP are of the same sort.
  645  !! They must have the same name, same number of terminals,
  646  !! and corresponding terminals must have the same type and number (INFO).
  647     %IF U_NAME==S_NAME %AND U_NT=S_NT %START
    MOVE.L  D7,-(A7)             : 2F07
    MOVEA.L 4(A0),A2             : 2468 0004
    CMPA.L  4(A1),A2             : B5E9 0004
    BNE     L2                   : 6600 0000
    MOVE.B  23(A0),D4            : 1828 0017
    CMP.B   11(A1),D4            : B829 000B
    BNE     L2                   : 6600 000E
  648        %FOR I=1,1,U_NT %CYCLE
    MOVE.L  D4,481               : 2F04
    CLR.L   i                    : 42AF 0004
L3  MOVE.L  i,D0                 : 202F 0004
    CMP.L   481,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0004
  649           ->OUT %UNLESS U_INFO(I)=S_TREF(I)_INFO
    MOVE.L  i,D0                 : 202F 0004
    ASL.L   #3,D0                : E780
    MOVEA.L s,A0                 : 206F 0008
    MOVE.L  4(A0,D0.L),D1        : 2230 0804
    MOVE.L  i,D2                 : 242F 0004
    ASL.L   #2,D2                : E582
    MOVEA.L u,A1                 : 226F 000C
    CMP.L   36(A1,D2.L),D1       : B2B1 2824
    BEQ     L6                   : 6700 0000
    ADDQ.L  #4,A7                : 588F
    BRA     out                  : 6000 0000
L6
  650        %REPEAT
    BRA     L3                   : 6000 0019
L4  ADDQ.L  #4,A7                : 588F
  651        %TRUE
    MOVEQ   #1,D0                : 7001
    BRA     L0                   : 6000 0000
  652     %FINISH
L2
  653  OUT:
  654     %FALSE
    MOVEQ   #0,D0                : 7000
    BRA     L0                   : 6000 003B
  655  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
^   MOVE.L  A1,-(A7)             : 2F09
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  656  
  657  !! Global variables for the selection and assignment processes
  658  %INTEGER NSUBUNITS,   NPACKAGES,   NO TO SELECT,   NO NOT SELECTED
  659  %RECORD(FTASK)%NAME TASK
  660  %RECORD(FPACKAGE)%NAME PACKAGES
  661  %RECORD(FNET)%NAME NETS
  662  
  663  %ROUTINE SELECT CHIPS
  664     %INTEGER FLAG,   OLDTOS,   OPTIONS,   TYPE,   LEN
  665     %INTEGER I,   J
  666     %RECORD(FSUBUNIT)%NAME U
  667     %RECORD(FNET)%NAME NET
  668     %RECORD(FCHIP)%NAME CHIP
  669     %RECORD(FSUBCHIP)%NAME SC
  670     %RECORD(FHEAD)%NAME H
  671  !! select chips from the I-code. A chip is selected if (a) it
  672  !! is explicitly named in an ON string or (b) there is a UNIT
  673  !! which has no ON string and which is the SAME KIND as some
  674  !! sub-element of the chip (subchip).
  675  
  676  %PREDICATE IN DICTIONARY(%RECORD(FTAG)%NAME TAG)
  677  !! decide whether TAG was already in dictionary
  678  !! before the last call of SELECT A CHIP.
  679     %TRUE %IF (ADDR(TAG)>>LAUPW) < (OLDTOS>>LAUPW)
    MOVE.L  A0,D0                : 2008
    LSR.L   #2,D0                : E488
    MOVE.L  oldtos,D1            : 222E FFF8
    LSR.L   #2,D1                : E489
    CMP.L   D1,D0                : B081
    BGE     L2                   : 6C00 0000
    MOVEQ   #1,D0                : 7001
    BRA     L0                   : 6000 0000
L2
  680     %FALSE
    MOVEQ   #0,D0                : 7000
    BRA     L0                   : 6000 0012
  681  %END
^   MOVE.L  8(A5),-(A7)          : 2F2D 0008
^   MOVE.L  A7,8(A5)             : 2B4F 0008
^   MOVE.L  A0,-(A7)             : 2F08
    MOVEA.L 8(A5),A7             : 2E6D 0008
    MOVE.L  (A7)+,8(A5)          : 2B5F 0008
    RTS                          : 4E75
  682  
  683  %ROUTINE XREF(%RECORD(FNET)%NAME NET)
  684     %RECORD(FFANEL)%NAME F,   F1
  685     %RECORD(FFRAGMENT)%NAME FR
  686     %RECORD(FHEAD)%NAME H
  687     %RECORD(FTERMINAL)%NAME TERMINAL
  688     %INTEGER I, N
  689  !! First find whether the net references an external terminal of the chip.
  690  !! If so then make all sub-chip terminals referenced by the net
  691  !! reference this external terminal. This provides a quick mapping
  692  !! between subUNIT logical terminal numbers and chip logical terminal
  693  !! numbers for later on when nets have to be 'relocated'.
  694     %FOR N=1,1,NET_NF %CYCLE
    MOVEQ   #6,D0                : 7006
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D0,#-4               : 51C8 FFFC
    MOVE.B  5(A0),D4             : 1828 0005
    MOVE.L  D4,514               : 2F04
    CLR.L   n                    : 42AF 0004
L1  MOVE.L  n,D0                 : 202F 0004
    CMP.L   514,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,n                 : 52AF 0004
  695        FR==NET_F(N)
    MOVE.L  n,D0                 : 202F 0004
    ASL.L   #2,D0                : E580
    MOVEA.L net,A0               : 206F 0020
    MOVE.L  4(A0,D0.L),fr        : 2F70 0804 0014
  696        %FOR I=1,1,FR_FAN %CYCLE
    MOVEA.L fr,A1                : 226F 0014
    MOVE.L  4(A1),515            : 2F29 0004
    CLR.L   i                    : 42AF 000C
L3  MOVE.L  i,D0                 : 202F 000C
    CMP.L   515,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 000C
  697           F==FR_F(I)
    MOVE.L  i,D0                 : 202F 000C
    ASL.L   #3,D0                : E780
    MOVEA.L fr,A0                : 206F 0018
    LEA     0(A0,D0.L),A0        : D1C0
    MOVE.L  A0,f                 : 2F48 0020
  698           ->GOT NET %IF F_SUBNO=0
    MOVE.L  0(A0),D1             : 2210
    BNE     L6                   : 6600 0000
    ADDQ.L  #8,A7                : 508F
    BRA     gotnet               : 6000 0000
L6
  699        %REPEAT
    BRA     L3                   : 6000 0028
L4  ADDQ.L  #4,A7                : 588F
  700     %REPEAT
    BRA     L1                   : 6000 0011
L2  ADDQ.L  #4,A7                : 588F
  701     !! net id completely internal to the chip
  702     %RETURN
    BRA     L0                   : 6000 0000
  703  GOT NET:
  704     !! make subchip terminals point at the relevant chip terminal
  705     !! taking care to point to the correct terminal in the
  706     !! presence of input-outputs
  707     H==CHIP_HEADER
    MOVEA.L chip,A0              : 206E FFD8
    MOVE.L  4(A0),h              : 2F68 0004 000C
  708     %FOR I=F_TNO,1,H_NT %CYCLE
    MOVEA.L h,A1                 : 226F 000C
    MOVE.B  7(A1),D4             : 1829 0007
    MOVE.L  D4,517               : 2F04
    MOVEA.L f,A2                 : 246F 001C
    MOVE.L  4(A2),D0             : 202A 0004
    SUBQ.L  #1,D0                : 5380
    MOVE.L  D0,i                 : 2F40 0008
L1  MOVE.L  i,D0                 : 202F 0008
    CMP.L   517,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0008
  709        TERMINAL==H_T(I)
    MOVE.L  i,D0                 : 202F 0008
    ASL.L   #3,D0                : E780
    MOVEA.L h,A0                 : 206F 0010
    LEA     40(A0,D0.L),A1       : 43F0 0828
    MOVE.L  A1,terminal          : 2F49 000C
  710        %EXIT %IF TERMINAL_INFO>>2 = F_TNO
    MOVE.L  0(A1),D1             : 2211
    LSR.L   #2,D1                : E489
    MOVEA.L f,A2                 : 246F 001C
    CMP.L   4(A2),D1             : B2AA 0004
    BEQ     L2                   : 6700 0061
  711     %REPEAT
    BRA     L1                   : 6000 005D
L2  ADDQ.L  #4,A7                : 588F
  712     %FOR N=1,1,NET_NF %CYCLE
    MOVEA.L net,A0               : 206F 001C
    MOVE.B  5(A0),D4             : 1828 0005
    MOVE.L  D4,518               : 2F04
    CLR.L   n                    : 42AF 0004
L1  MOVE.L  n,D0                 : 202F 0004
    CMP.L   518,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,n                 : 52AF 0004
  713        FR==NET_F(N)
    MOVE.L  n,D0                 : 202F 0004
    ASL.L   #2,D0                : E580
    MOVEA.L net,A0               : 206F 0020
    MOVE.L  4(A0,D0.L),fr        : 2F70 0804 0014
  714        %FOR I=1,1,FR_FAN %CYCLE
    MOVEA.L fr,A1                : 226F 0014
    MOVE.L  4(A1),519            : 2F29 0004
    CLR.L   i                    : 42AF 000C
L3  MOVE.L  i,D0                 : 202F 000C
    CMP.L   519,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 000C
  715           F1==FR_F(I)
    MOVE.L  i,D0                 : 202F 000C
    ASL.L   #3,D0                : E780
    MOVEA.L fr,A0                : 206F 0018
    LEA     0(A0,D0.L),A0        : D1C0
    MOVE.L  A0,f1                : 2F48 001C
  716           %CONTINUE %IF F1_SUBNO=0
    MOVE.L  0(A0),D1             : 2210
    BEQ     L3                   : 6700 009A
  717           !! got a reference to a subchip
  718           CHIP_SUB(F1_SUBNO)_TREF(F1_TNO)_T==TERMINAL
    MOVE.L  4(A0),D2             : 2428 0004
    ASL.L   #3,D2                : E782
    ASL.L   #2,D1                : E581
    MOVEA.L chip,A1              : 226E FFD8
    MOVEA.L 12(A1,D1.L),A2       : 2471 180C
    MOVE.L  terminal,8(A2,D2.L)  : 25AF 0010 2808
  719        %REPEAT
    BRA     L3                   : 6000 009A
L4  ADDQ.L  #4,A7                : 588F
  720     %REPEAT
    BRA     L1                   : 6000 0083
L2  ADDQ.L  #4,A7                : 588F
  721  %END
^   MOVE.L  8(A5),-(A7)          : 2F2D 0008
^   MOVE.L  A7,8(A5)             : 2B4F 0008
^   MOVE.L  A0,-(A7)             : 2F08
    MOVEA.L 8(A5),A7             : 2E6D 0008
    MOVE.L  (A7)+,8(A5)          : 2B5F 0008
    RTS                          : 4E75
  722  
  723     !! start of SELECT A CHIP
  724     RCH
    MOVEQ   #11,D0               : 700B
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D0,#-4               : 51C8 FFFC
    BSR     rch                  : 6100 01AF
  725     %RETURN %IF CH=END OF FILE
    MOVEQ   #-118,D0             : 708A
    CMP.L   ch,D0                : B0AC 003C
    BEQ     L0                   : 6700 0000
  726     !! Expect ^U or ^S
  727     %IF CH=CNTRL+'S' %THEN READ(FLAG) %AND RCH
    CMPI.L  #$00D3,ch            : 0CAC 0000 00D3 003C
    BNE     L2                   : 6600 0000
    JSR     read                 : 4EAC 0044
    MOVE.L  D0,flag              : 2F40 002C
    BSR     rch                  : 6100 01AF
L2
  728     FAIL(D2) %UNLESS CH=CNTRL+'U'
    CMPI.L  #$00D5,ch            : 0CAC 0000 00D5 003C
    BEQ     L2                   : 6700 0000
    MOVEQ   #2,D0                : 7002
    BSR     fail                 : 6100 01AB
L2
  729  
  730     !! read the chip header
  731     OLDTOS=TOS
    MOVE.L  tos,oldtos           : 2F6C 0030 0028
  732     READ(TYPE);   RCH
    JSR     read                 : 4EAC 0044
    MOVE.L  D0,type              : 2F40 0020
    BSR     rch                  : 6100 01AF
  733     H==READ CHIP HEADER
    BSR     readchipheader       : 6100 01BB
    MOVE.L  A0,h                 : 2E88
  734  
  735     !! ignore the chip if it is a duplicate
  736     %UNLESS H_NAME_OWNER==RECORD(NULL) %START
    MOVEA.L 12(A0),A1            : 2268 000C
    MOVE.L  0(A1),D0             : 2011
    BEQ     L2                   : 6700 0000
  737        PRINTSTRING("*Duplicate chip ")
    LEA     (PC),A0              : 41FA 0CD0
    JSR     printstring          : 4EB8 3E6A
  738        PRINTSTRING(H_NAME_NAME)
    MOVEA.L h,A0                 : 2057
    MOVEA.L 12(A0),A1            : 2268 000C
    LEA     8(A1),A0             : 41E9 0008
    JSR     printstring          : 4EB8 3E6A
  739        PRINTSTRING(" ignored");   NEWLINE
    LEA     (PC),A0              : 41FA 0CE1
    JSR     printstring          : 4EB8 3E6A
    BSR     newline              : 6100 00B5
  740        CLEANUP(OLDTOS)
    MOVE.L  oldtos,D0            : 202F 0028
    BSR     cleanup              : 6100 01B6
  741        ->OUT
    BRA     out                  : 6000 0000
  742     %FINISH
L2
  743  
  744     !! build the fixed part of the chip
  745     SKIP UNITS TO(CNTRL+'J')
    MOVE.L  #$00CA,D0            : 203C 0000 00CA
    BSR     skipunitsto          : 6100 01C2
  746     CHIP==RECORD(TOS);   ZERO(CHIPLEN)
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,chip              : 2F48 0008
    MOVEQ   #4,D0                : 7004
    BSR     zero                 : 6100 01B1
  747     BREAD(CHIP_NSUBS);   CLAIM(CHIPLEN+CHIP_NSUBS)
    MOVEA.L chip,A0              : 206F 0008
    LEA     13(A0),A0            : 41E8 000D
    BSR     bread                : 6100 01A8
    MOVEA.L chip,A0              : 206F 0008
    MOVE.B  13(A0),D4            : 1828 000D
    MOVE.L  D4,D0                : 2004
    ADDQ.L  #4,D0                : 5880
    BSR     claim                : 6100 01AC
  748     CHIP_HEADER==H;   CHIP_NAME==H_NAME
    MOVEA.L chip,A0              : 206F 0008
    MOVE.L  h,4(A0)              : 2157 0004
    MOVEA.L h,A1                 : 2257
    MOVE.L  12(A1),0(A0)         : 20A9 000C
  749     ERROR CONTEXT=CHIP_NAME_NAME
    MOVEA.L 0(A0),A2             : 2450
    LEA     8(A2),A3             : 47EA 0008
    LEA     errorcontext,A0      : 41EC FFB0
    MOVE.B  (A3),D0              : 1013
    MOVE.B  (A3)+,(A0)+          : 10DB
    SUBQ.B  #1,D0                : 5300
    BCC     #-6                  : 64FA
  750  
  751     !! Build the subchips
  752     FLAG=DISCARD
    MOVEQ   #-1,D0               : 70FF
    MOVE.L  D0,flag              : 2F40 002C
  753     %FOR I=1,1,CHIP_NSUBS %CYCLE
    MOVEA.L chip,A0              : 206F 0008
    MOVE.B  13(A0),D4            : 1828 000D
    MOVE.L  D4,508               : 2F04
    CLR.L   i                    : 42AF 001C
L1  MOVE.L  i,D0                 : 202F 001C
    CMP.L   508,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 001C
  754        !! get to the sub-element's header
  755        SKIP TO(CNTRL+'H');   Skip Num
    MOVE.L  #$00C8,D0            : 203C 0000 00C8
    BSR     skipto               : 6100 01AE
    BSR     skipnum              : 6100 01CF
  756        !! build the subchip record
  757        SC==RECORD(TOS);   CLAIM(SUBCHIPLEN)
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,sc                : 2F48 0008
    MOVEQ   #3,D0                : 7003
    BSR     claim                : 6100 01AC
  758        !! and reference it
  759        CHIP_SUB(I)==SC
    MOVE.L  i,D0                 : 202F 001C
    ASL.L   #2,D0                : E580
    MOVEA.L chip,A0              : 206F 000C
    MOVE.L  sc,12(A0,D0.L)       : 21AF 0008 080C
  760        BREAD(SC_NIN); BREAD(SC_NOUT); BREAD(SC_NIO); BREAD(SC_NT)
    MOVEA.L sc,A1                : 226F 0008
    LEA     8(A1),A0             : 41E9 0008
    BSR     bread                : 6100 01A8
    MOVEA.L sc,A0                : 206F 0008
    LEA     9(A0),A0             : 41E8 0009
    BSR     bread                : 6100 01A8
    MOVEA.L sc,A0                : 206F 0008
    LEA     10(A0),A0            : 41E8 000A
    BSR     bread                : 6100 01A8
    MOVEA.L sc,A0                : 206F 0008
    LEA     11(A0),A0            : 41E8 000B
    BSR     bread                : 6100 01A8
  761        !! claim and initialise space for the terminal references.
  762        LEN=SC_NT*TERMREFLEN;   ZERO(LEN);   CLAIM(LEN)
    MOVEA.L sc,A0                : 206F 0008
    MOVE.B  11(A0),D4            : 1828 000B
    MOVE.L  D4,D0                : 2004
    ADD.L   D0,D0                : D080
    MOVE.L  D0,len               : 2F40 0020
    BSR     zero                 : 6100 01B1
    MOVE.L  len,D0               : 202F 0020
    BSR     claim                : 6100 01AC
  763  
  764        !! read name of subchip
  765        SC_UNAME==READ TAG(GENERAL);   SC_NAME==READ TAG(UNITNAME)
    MOVEQ   #0,D0                : 7000
    BSR     readtag              : 6100 01B7
    MOVEA.L sc,A1                : 226F 0008
    MOVE.L  A0,0(A1)             : 2288
    MOVEQ   #1,D0                : 7001
    BSR     readtag              : 6100 01B7
    MOVEA.L sc,A1                : 226F 0008
    MOVE.L  A0,4(A1)             : 2348 0004
  766  
  767        !! read the terminal info. discard pin and terminal names
  768        %FOR J=1,1,SC_NT %CYCLE
    MOVE.B  11(A1),D4            : 1829 000B
    MOVE.L  D4,509               : 2F04
    CLR.L   j                    : 42AF 001C
L3  MOVE.L  j,D0                 : 202F 001C
    CMP.L   509,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,j                 : 52AF 001C
  769           RCH;   READ(SC_TREF(J)_INFO)
    BSR     rch                  : 6100 01AF
    JSR     read                 : 4EAC 0044
    MOVE.L  j,D1                 : 222F 001C
    ASL.L   #3,D1                : E781
    MOVEA.L sc,A0                : 206F 000C
    MOVE.L  D0,4(A0,D1.L)        : 2180 1804
  770           SKIP TAG;   SKIP TAG
    BSR     skiptag              : 6100 01B9
    BSR     skiptag              : 6100 01B9
  771        %REPEAT
    BRA     L3                   : 6000 00F3
L4  ADDQ.L  #4,A7                : 588F
  772  
  773        !! if the subchip has been referred to then possibly
  774        !! select it. select it only if the UNIT referencing
  775        !! the subchip explicitly requests this chip (ON string)
  776        !! or if the subchip is of the same kind as the UNIT.
  777        %IF IN DICTIONARY(SC_NAME) %START
    MOVEA.L sc,A0                : 206F 0008
    MOVEA.L 4(A0),A0             : 2068 0004
    BSR     indictionary         : 6100 01F5
    MOVE.B  D0,D0                : 1000
    BEQ     L4                   : 6700 0000
  778           U==SC_NAME_OWNER
    MOVEA.L sc,A0                : 206F 0008
    MOVEA.L 4(A0),A1             : 2268 0004
    MOVE.L  0(A1),u              : 2F51 0014
  779           !! select this chip for all UNITs of the same kind as U.
  780           %WHILE %NOT U==RECORD(NULL) %CYCLE
L5  MOVE.L  u,D0                 : 202F 0014
    BEQ     L6                   : 6700 0000
  781              %IF (U_ON==CHIP_NAME %OR U_ON==RECORD(NULL)) %AND %C
  782+                   SAME KIND(U,SC) %START
    MOVEA.L D0,A0                : 2040
    MOVEA.L 8(A0),A1             : 2268 0008
    MOVEA.L chip,A2              : 246F 000C
    CMPA.L  0(A2),A1             : B3D2
    BEQ     L9                   : 6700 0000
    MOVE.L  A1,D1                : 2209
    BNE     L8                   : 6600 0000
L9  MOVEA.L sc,A1                : 226F 0008
    BSR     samekind             : 6100 01DC
    BEQ     L8                   : 6700 0130
  783                 %IF U_FLAGS&SELECTED=0 %START
    MOVEA.L u,A0                 : 206F 0014
    BTST.B  #0,24(A0)            : 0828 0000 0018
    BNE     L10                  : 6600 0000
  784                    U_FLAGS=U_FLAGS!SELECTED
    ORI.B   #1,24(A0)            : 0028 0001 0018
  785                    U_ON==CHIP_NAME
    MOVEA.L chip,A1              : 226F 000C
    MOVE.L  0(A1),8(A0)          : 2151 0008
  786                    FLAG=KEEP;   !! and keep the chip
    CLR.L   flag                 : 42AF 0030
  787                    NO TO SELECT=NO TO SELECT - 1
    SUBQ.L  #1,notoselect        : 53AC FFA4
  788                 %FINISH
L10
  789              %FINISH
L8
  790              U==U_NEXT
    MOVEA.L u,A0                 : 206F 0014
    MOVE.L  28(A0),u             : 2F68 001C 0014
  791           %REPEAT
    BRA     L5                   : 6000 0120
L6
  792        %FINISH
L4
  793     %REPEAT
    BRA     L1                   : 6000 0097
L2  ADDQ.L  #4,A7                : 588F
  794  
  795     %IF FLAG=DISCARD %START
    MOVEQ   #-1,D1               : 72FF
    CMP.L   flag,D1              : B2AF 002C
    BNE     L2                   : 6600 0000
  796        !! Throw away the chip
  797        !! First see if anything was constrained to it.
  798        !! set SELECT ERROR if a UNIT was constrained to a chip
  799        !! containing no such sub-chip.
  800        %FOR I=1,1,CHIP_NSUBS %CYCLE
    MOVEA.L chip,A0              : 206F 0008
    MOVE.B  13(A0),D4            : 1828 000D
    MOVE.L  D4,510               : 2F04
    CLR.L   i                    : 42AF 001C
L3  MOVE.L  i,D0                 : 202F 001C
    CMP.L   510,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 001C
  801           U==CHIP_SUB(I)_NAME_OWNER
    MOVE.L  i,D0                 : 202F 001C
    ASL.L   #2,D0                : E580
    MOVEA.L chip,A0              : 206F 000C
    MOVEA.L 12(A0,D0.L),A1       : 2270 080C
    MOVEA.L 4(A1),A2             : 2469 0004
    MOVE.L  0(A2),u              : 2F52 0014
  802           %WHILE %NOT U==RECORD(NULL) %CYCLE
L5  MOVE.L  u,D0                 : 202F 0014
    BEQ     L6                   : 6700 0000
  803              %IF U_ON==CHIP_NAME %AND U_FLAGS&(SELECTED+SELECT ERROR)=0 %START
    MOVEA.L D0,A0                : 2040
    MOVEA.L 8(A0),A1             : 2268 0008
    MOVEA.L chip,A2              : 246F 000C
    CMPA.L  0(A2),A1             : B3D2
    BNE     L8                   : 6600 0000
    MOVE.B  24(A0),D4            : 1828 0018
    MOVEQ   #9,D1                : 7209
    AND.L   D1,D4                : C881
    BNE     L8                   : 6600 0189
  804                 U_FLAGS=U_FLAGS!SELECT ERROR
    ORI.B   #8,24(A0)            : 0028 0008 0018
  805                 NO TO SELECT=NO TO SELECT-1
    SUBQ.L  #1,notoselect        : 53AC FFA4
  806                 NO NOT SELECTED=NO NOT SELECTED+1
    ADDQ.L  #1,nonotselected     : 52AC FFA0
  807                 U_ON_OWNER==RECORD(DISCARD)
    MOVEA.L 8(A0),A1             : 2268 0008
    MOVEQ   #-1,D2               : 74FF
    MOVE.L  D2,0(A1)             : 2282
  808              %FINISH
L8
  809              U==U_NEXT
    MOVE.L  28(A0),u             : 2F68 001C 0014
  810           %REPEAT
    BRA     L5                   : 6000 017C
L6
  811        %REPEAT
    BRA     L3                   : 6000 0169
L4  ADDQ.L  #4,A7                : 588F
  812        !! remove dictionary entries (dangling references)
  813        CLEANUP(OLDTOS)
    MOVE.L  oldtos,D0            : 202F 0028
    BSR     cleanup              : 6100 01B6
  814        ->OUT
    BRA     out                  : 6000 005B
  815     %FINISH
L2
  816  
  817     !! keep the chip, so make its name own it, and
  818     !! read in all the nets local to the chip. Only
  819     !! 'global signals' (net name begins with '.')
  820     !! are kept, as these must be amalgamated with
  821     !! the other global signals at output time.
  822     CHIP_NAME_OWNER==CHIP
    MOVEA.L chip,A0              : 206F 0008
    MOVEA.L 0(A0),A1             : 2250
    MOVE.L  A0,0(A1)             : 2288
  823     SKIP TO(CNTRL+'N')
    MOVE.L  #$00CE,D0            : 203C 0000 00CE
    BSR     skipto               : 6100 01AE
  824     %WHILE CH=CNTRL+'N' %CYCLE
L1  CMPI.L  #$00CE,ch            : 0CAC 0000 00CE 003C
    BNE     L2                   : 6600 0000
  825        OLDTOS=TOS;   NET==READ NET
    MOVE.L  tos,oldtos           : 2F6C 0030 0028
    BSR     readnet              : 6100 01DA
    MOVE.L  A0,net               : 2F48 000C
  826        !! make all terminals referenced by the net reference the
  827        !! chip's terminals if this is possible.
  828        XREF(NET)
    BSR     xref                 : 6100 01F8
  829        %IF NET_FLAGS&GLOBAL#0 %START
    MOVEA.L net,A0               : 206F 000C
    BTST.B  #0,4(A0)             : 0828 0000 0004
    BEQ     L4                   : 6700 0000
  830           !! keep the net -  chain it to the chip
  831           NET_NEXT==CHIP_GNETS;   CHIP_GNETS==NET
    MOVEA.L chip,A1              : 226F 0008
    MOVE.L  8(A1),0(A0)          : 20A9 0008
    MOVE.L  A0,8(A1)             : 2348 0008
  832        %ELSE
    BRA     L3                   : 6000 0000
L4
  833           !! throw away the net and remove dangling references
  834           CLEANUP(OLDTOS)
    MOVE.L  oldtos,D0            : 202F 0028
    BSR     cleanup              : 6100 01B6
  835        %FINISH
L3
  836     %REPEAT
    BRA     L1                   : 6000 01BD
L2
  837  
  838  OUT:
  839     SKIP TO(CNTRL+'E')
    MOVE.L  #$00C5,D0            : 203C 0000 00C5
    BSR     skipto               : 6100 01AE
  840  %END
^   MOVEQ   #-64,D4              : 78C0
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
? 840  TYPE underused  %END
? 840  OPTIONS unused  %END
  841  
  842  %PREDICATE SAME(%RECORD(FSUBUNIT)%NAME U, V)
  843     %INTEGER I
  844  !! Decide whether U and V are the same kind of UNIT.
  845  !! To be the same U and V must have the same name,
  846  !! the same number of terminals, and corresponding
  847  !! terminals must have the same type and terminal number (INFO).
  848     %IF U_NAME==V_NAME %AND U_NT=V_NT %START
    MOVE.L  D7,-(A7)             : 2F07
    MOVEA.L 4(A0),A2             : 2468 0004
    CMPA.L  4(A1),A2             : B5E9 0004
    BNE     L2                   : 6600 0000
    MOVE.B  23(A0),D4            : 1828 0017
    CMP.B   23(A1),D4            : B829 0017
    BNE     L2                   : 6600 000E
  849        %FOR I=1,1,U_NT %CYCLE
    MOVE.L  D4,494               : 2F04
    CLR.L   i                    : 42AF 0004
L3  MOVE.L  i,D0                 : 202F 0004
    CMP.L   494,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0004
  850           ->OUT %UNLESS U_INFO(I)=V_INFO(I)
    MOVE.L  i,D0                 : 202F 0004
    ASL.L   #2,D0                : E580
    MOVEA.L u,A0                 : 206F 000C
    MOVE.L  36(A0,D0.L),D1       : 2230 0824
    MOVEA.L v,A1                 : 226F 0008
    CMP.L   36(A1,D0.L),D1       : B2B1 0824
    BEQ     L6                   : 6700 0000
    ADDQ.L  #4,A7                : 588F
    BRA     out                  : 6000 0000
L6
  851        %REPEAT
    BRA     L3                   : 6000 0019
L4  ADDQ.L  #4,A7                : 588F
  852        %TRUE
    MOVEQ   #1,D0                : 7001
    BRA     L0                   : 6000 0000
  853     %FINISH
L2
  854  OUT:
  855     %FALSE
    MOVEQ   #0,D0                : 7000
    BRA     L0                   : 6000 0038
  856  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
^   MOVE.L  A1,-(A7)             : 2F09
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  857  
  858  %RECORD(FTAG)%MAP UNKNOWN
  859     %OWNINTEGER P=NULL
  860     %RECORD(FTAG)%NAME TAG
  861  !! create a tag with name "UNKNOWN" if one
  862  !! hasn't already been created. Return its address
  863     %IF P=NULL %START
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  p,D0                 : 202C 0454
    BNE     L2                   : 6600 0000
  864        P=TOS;    TAG==RECORD(P);   ZERO(TAGLEN)
    MOVE.L  tos,p                : 296C 0030 0454
    MOVEA.L p,A0                 : 206C 0454
    MOVE.L  A0,tag               : 2E88
    MOVEQ   #2,D0                : 7002
    BSR     zero                 : 6100 01B1
  865        TAG_NAME="UNKNOWN";   CLAIM(TAGLEN+(7+CPW)>>LCPW)
    MOVEA.L tag,A0               : 2057
    LEA     8(A0),A1             : 43E8 0008
    LEA     (PC),A2              : 45FA 106C
    MOVE.B  (A2),D0              : 1012
    MOVE.B  (A2)+,(A1)+          : 12DA
    SUBQ.B  #1,D0                : 5300
    BCC     #-6                  : 64FA
    MOVEQ   #4,D0                : 7004
    BSR     claim                : 6100 01AC
  866     %ELSE
    BRA     L1                   : 6000 0000
L2
  867        TAG==RECORD(P)
    MOVEA.L D0,A0                : 2040
    MOVE.L  A0,tag               : 2E88
  868     %FINISH
L1
  869     %RESULT==TAG
    MOVEA.L tag,A0               : 2057
    BRA     L0                   : 6000 0000
  870  %END
^   MOVEQ   #-12,D4              : 78F4
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  871  
  872  %RECORD(FTAG)%MAP INT TO TAG(%INTEGER N)
  873     %RECORD(FTAG)%NAME TAG
  874  !! create a tag having the character value of N as name.
  875     TAG==RECORD(TOS);   ZERO(TAGLEN)
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,tag               : 2F08
    MOVEQ   #2,D0                : 7002
    BSR     zero                 : 6100 01B1
  876     TAG_NAME=ITOS(N,0)
    MOVEQ   #0,D1                : 7200
    MOVE.L  n,D0                 : 202F 0004
    JSR     itos                 : 4EAC 0458
    MOVEQ   #-1,D0               : 70FF
    BSR     STRTOSTK             : 6100 0079
    MOVEA.L tag,A0               : 206F 0100
    LEA     8(A0),A1             : 43E8 0008
    MOVEA.L A7,A0                : 204F
    MOVEQ   #-1,D0               : 70FF
    BSR     STRCOPY              : 6100 0078
    LEA     256(A7),A7           : 4FEF 0100
  877     CLAIM(TAGLEN+(LENGTH(TAG_NAME)+CPW)>>LCPW)
    MOVEA.L tag,A0               : 2057
    MOVE.B  8(A0),D4             : 1828 0008
    MOVE.L  D4,D0                : 2004
    ADDQ.L  #4,D0                : 5880
    LSR.L   #2,D0                : E488
    ADDQ.L  #2,D0                : 5480
    BSR     claim                : 6100 01AC
  878     %RESULT==TAG
    MOVEA.L tag,A0               : 2057
    BRA     L0                   : 6000 0000
  879  %END
^   MOVE.L  #$FEF0,D4            : 283C FFFF FEF0
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  880  
  881  %PREDICATE COMPATIBLE(%RECORD(FTAG)%NAME A, B)
  882  !! %TRUE if A=B, or A=null or B=null.
  883     %IF A==B %OR A==NULL TAG %OR B==NULL TAG %THEN %TRUE
    CMPA.L  A1,A0                : B1C9
    BEQ     L3                   : 6700 0000
    CMPA.L  nulltag,A0           : B1EC FFF0
    BEQ     L3                   : 6700 000A
    CMPA.L  nulltag,A1           : B3EC FFF0
    BNE     L2                   : 6600 0000
L3  MOVEQ   #1,D0                : 7001
    BRA     L0                   : 6000 0000
L2
  884     %FALSE
    MOVEQ   #0,D0                : 7000
    BRA     L0                   : 6000 0015
  885  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
^   MOVE.L  A1,-(A7)             : 2F09
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
  886  
  887  !!********************************************************
  888  !! Naive assignment. This routine assigns elements to    *
  889  !! packages in the order in which the elements occur in  *
  890  !! the source text. Packages are filled as fully as      *
  891  !! poossible subject to constraints. Constraints may be  *
  892  !! of two kinds: AT and PACKNO/SUBPACK. Two elements with*
  893  !! different constraints CANNOT be assigned to the same  *
  894  !! package. Two elements with the same constaints MUST be*
  895  !! assigned to the same package.                         *
  896  !!********************************************************
  897  
  898  %ROUTINE NAIVE ASSIGNMENT
  899     %INTEGER PASS,   I,   FLAGS
  900     %RECORD(FSUBUNIT)%NAME SU
  901     %CONSTINTEGER CONSTRAINED=1,   UNCONSTRAINED=2
  902  
  903  %ROUTINE ALLOCATE(%RECORD(FSUBUNIT)%NAME SU)
  904     %CONSTINTEGER OK=1,   WRONG SORT=2,   NO ROOM=3
  905     %RECORD(FCHIP)%NAME CHIP
  906     %RECORD(FPACKAGE)%NAME PACK,   LPACK
  907     %INTEGER RESULT,   LEN
  908  
  909     %ROUTINE PLACE(%RECORD(FSUBUNIT)%NAME U, %INTEGERNAME RESULT)
  910        %INTEGER I,   R,   SUBPACK
  911  !! place subunit U on the current chip if this is possible.
  912  !! RESULT takes the value NO ROOM if the chip is full, and
  913  !! the value WRONG SORT if there is no empty slot of the
  914  !! same kind as U (or no slots at all of kind U).
  915        R=NO ROOM;   SUBPACK=U_SUBPACK
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVEQ   #3,D0                : 7003
    MOVE.L  D0,r                 : 2F40 0004
    MOVE.B  25(A0),D4            : 1828 0019
    MOVE.L  D4,subpack           : 2E84
  916        %FOR I=1,1,CHIP_NSUBS %CYCLE
    MOVEA.L 8(A5),A3             : 266D 0008
    MOVEA.L chip,A2              : 246B FFF8
    MOVE.B  13(A2),D4            : 182A 000D
    MOVE.L  D4,527               : 2F04
    CLR.L   i                    : 42AF 000C
L1  MOVE.L  i,D0                 : 202F 000C
    CMP.L   527,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 000C
  917           %CONTINUE %IF SUBPACK#0 %AND SUBPACK#I
    MOVE.L  subpack,D0           : 202F 0004
    BEQ     L4                   : 6700 0000
    CMP.L   i,D0                 : B0AF 000C
    BNE     L1                   : 6600 001B
L4
  918           %IF PACK_SUB(I)==RECORD(NULL) %START
    MOVE.L  i,D1                 : 222F 000C
    ASL.L   #2,D1                : E581
    MOVEA.L 8(A5),A3             : 266D 0008
    MOVEA.L pack,A0              : 206B FFF4
    MOVE.L  20(A0,D1.L),D2       : 2430 1814
    BNE     L4                   : 6600 0000
  919              !! Got a free slot for the subUNIT
  920              R=WRONG SORT
    MOVEQ   #2,D3                : 7602
    MOVE.L  D3,r                 : 2F43 0008
  921              %IF SAME KIND(U,CHIP_SUB(I)) %START
    MOVEA.L chip,A1              : 226B FFF8
    MOVEA.L 12(A1,D1.L),A1       : 2271 180C
    MOVEA.L u,A0                 : 206F 0014
    BSR     samekind             : 6100 01DC
    BEQ     L6                   : 6700 0000
  922                 !! And the slot is of the right sort
  923                 R=OK;   PACK_SUB(I)==U
    MOVEQ   #1,D1                : 7201
    MOVE.L  D1,r                 : 2F41 0008
    MOVE.L  i,D0                 : 202F 000C
    ASL.L   #2,D0                : E580
    MOVEA.L 8(A5),A3             : 266D 0008
    MOVEA.L pack,A0              : 206B FFF4
    MOVE.L  u,20(A0,D0.L)        : 21AF 0014 0814
  924                 PACK_PACKNAME==SU_PACKNAME %IF PACK_PACKNAME==NULL TAG
    MOVEA.L 16(A0),A1            : 2268 0010
    CMPA.L  nulltag,A1           : B3EC FFF0
    BNE     L8                   : 6600 0000
    MOVEA.L su,A2                : 246B FFFC
    MOVE.L  16(A2),16(A0)        : 216A 0010 0010
L8
  925                 PACK_AT==SU_AT %IF PACK_AT==NULL TAG
    MOVEA.L 8(A0),A1             : 2268 0008
    CMPA.L  nulltag,A1           : B3EC FFF0
    BNE     L8                   : 6600 0000
    MOVEA.L su,A2                : 246B FFFC
    MOVE.L  12(A2),8(A0)         : 216A 000C 0008
L8
  926                 U_PACK==PACK;   U_SUBPACK=I
    MOVEA.L u,A1                 : 226F 0014
    MOVE.L  A0,32(A1)            : 2348 0020
    MOVE.L  i,D2                 : 242F 000C
    MOVE.B  D2,25(A1)            : 1342 0019
  927                 ->OUT
    ADDQ.L  #4,A7                : 588F
    BRA     out                  : 6000 0000
  928              %FINISH
L6
  929           %FINISH
L4
  930        %REPEAT
    BRA     L1                   : 6000 001B
L2  ADDQ.L  #4,A7                : 588F
  931     OUT:
  932        RESULT=R
    MOVEA.L result,A0            : 206F 000C
    MOVE.L  r,(A0)               : 20AF 0004
  933     %END
^   MOVE.L  12(A5),-(A7)         : 2F2D 000C
^   MOVE.L  A7,12(A5)            : 2B4F 000C
^   MOVE.L  A0,-(A7)             : 2F08
^   MOVE.L  A1,-(A7)             : 2F09
    MOVEA.L 12(A5),A7            : 2E6D 000C
    MOVE.L  (A7)+,12(A5)         : 2B5F 000C
    RTS                          : 4E75
  934  
  935  !! allocate subunit SU. First try to place it on an existing
  936  !! package. This may fail if all existing packages are full, if
  937  !! the constraints for U are incompatible with those of all
  938  !! existing packages, or if there is no element of kind U
  939  !! on any of the existing packages. In this case a new 
  940  !! package is constructed and added to the list of packages.
  941  
  942     PACK==PACKAGES
    MOVEQ   #4,D0                : 7004
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D0,#-4               : 51C8 FFFC
    MOVE.L  packages,pack        : 2F6C FF98 000C
  943     %WHILE %NOT PACK_NEXT==RECORD(NULL) %CYCLE
L1  MOVEA.L pack,A0              : 206F 000C
    MOVE.L  0(A0),D0             : 2010
    BEQ     L2                   : 6700 0000
  944        PACK==PACK_NEXT;   CHIP==PACK_CHIP
    MOVE.L  D0,pack              : 2F40 000C
    MOVEA.L D0,A0                : 2040
    MOVE.L  4(A0),chip           : 2F68 0004 0010
  945        !! check that element's ON string is compatible
  946        !! with the name of the package.
  947        %CONTINUE %UNLESS COMPATIBLE(SU_ON,CHIP_NAME)
    MOVEA.L su,A1                : 226F 0014
    MOVEA.L 8(A1),A0             : 2069 0008
    MOVEA.L chip,A2              : 246F 0010
    MOVEA.L 0(A2),A1             : 2252
    BSR     compatible           : 6100 01F1
    BEQ     L1                   : 6700 000F
  948        !! see if element is constrained or package is constrained.
  949        %IF (%NOT PACK_AT==NULL TAG %AND %NOT SU_AT==NULL TAG) %C
  950+      %OR (%NOT PACK_PACKNAME==NULL TAG %AND %NOT SU_PACKNAME==NULL TAG) %START
    MOVEA.L pack,A0              : 206F 000C
    MOVEA.L 8(A0),A1             : 2268 0008
    CMPA.L  nulltag,A1           : B3EC FFF0
    BEQ     L6                   : 6700 0000
    MOVEA.L su,A2                : 246F 0014
    MOVEA.L 12(A2),A3            : 266A 000C
    CMPA.L  nulltag,A3           : B7EC FFF0
    BNE     L5                   : 6600 0000
L6  MOVEA.L 16(A0),A2            : 2468 0010
    CMPA.L  nulltag,A2           : B5EC FFF0
    BEQ     L4                   : 6700 0000
    MOVEA.L su,A3                : 266F 0014
    MOVEA.L 16(A3),A0            : 206B 0010
    CMPA.L  nulltag,A0           : B1EC FFF0
    BEQ     L4                   : 6700 003E
L5
  951           !! both are constrained
  952           %IF SU_FLAGS&CONSTRAINT#0 %AND %C
  953+             ((SU_AT==PACK_AT %AND COMPATIBLE(SU_PACKNAME,PACK_PACKNAME)) %OR %C
  954+             (SU_PACKNAME==PACK_PACKNAME %AND COMPATIBLE(SU_AT,PACK_AT))) %START
    MOVEA.L su,A0                : 206F 0014
    BTST.B  #2,24(A0)            : 0828 0002 0018
    BEQ     L6                   : 6700 0000
    MOVEA.L 12(A0),A2            : 2468 000C
    CMPA.L  A1,A2                : B5C9
    BNE     L8                   : 6600 0000
    MOVEA.L 16(A0),A0            : 2068 0010
    MOVEA.L pack,A3              : 266F 000C
    MOVEA.L 16(A3),A1            : 226B 0010
    BSR     compatible           : 6100 01F1
    BNE     L7                   : 6600 0000
L8  MOVEA.L su,A0                : 206F 0014
    MOVEA.L 16(A0),A1            : 2268 0010
    MOVEA.L pack,A2              : 246F 000C
    CMPA.L  16(A2),A1            : B3EA 0010
    BNE     L6                   : 6600 004E
    MOVEA.L 12(A0),A0            : 2068 000C
    MOVEA.L 8(A2),A1             : 226A 0008
    BSR     compatible           : 6100 01F1
    BEQ     L6                   : 6700 0067
L7
  955  
  956              !! Element constrained to this pack
  957              PLACE(SU,RESULT)
    LEA     result,A1            : 43EF 0004
    MOVEA.L su,A0                : 206F 0014
    BSR     place                : 6100 0208
  958              ->OUT %IF RESULT=OK
    MOVEQ   #1,D0                : 7001
    CMP.L   result,D0            : B0AF 0004
    BEQ     out                  : 6700 0000
  959              !! can't meet the constraint.
  960              PRINTSTRING("* ")
    LEA     (PC),A0              : 41FA 1296
    JSR     printstring          : 4EB8 3E6A
  961              %IF RESULT=NO ROOM %START
    MOVEQ   #3,D0                : 7003
    CMP.L   result,D0            : B0AF 0004
    BNE     L8                   : 6600 0000
  962                 !! no room on package
  963                 PRINTSTRING("Too many elements constrained ")
    LEA     (PC),A0              : 41FA 1299
    JSR     printstring          : 4EB8 3E6A
  964                 %UNLESS SU_SUBPACK=0 %START
    MOVEA.L su,A0                : 206F 0014
    TST.B   25(A0)               : 4A28 0019
    BEQ     L10                  : 6700 0000
  965                    PRINTSTRING("to subposition ")
    LEA     (PC),A0              : 41FA 12B8
    JSR     printstring          : 4EB8 3E6A
  966                    WRITE(SU_SUBPACK,0)
    MOVEA.L su,A0                : 206F 0014
    MOVE.B  25(A0),D4            : 1828 0019
    MOVE.L  D4,D0                : 2004
    MOVEQ   #0,D1                : 7200
    JSR     write                : 4EAC 004A
  967                    %IF %NOT SU_PACKNAME==NULL TAG %START
    MOVEA.L su,A0                : 206F 0014
    MOVEA.L 16(A0),A1            : 2268 0010
    CMPA.L  nulltag,A1           : B3EC FFF0
    BEQ     L12                  : 6700 0000
  968                       PRINTSTRING(" on pack ")
    LEA     (PC),A0              : 41FA 12C8
    JSR     printstring          : 4EB8 3E6A
  969                       PRINTSTRING(SU_PACKNAME_NAME)
    MOVEA.L su,A0                : 206F 0014
    MOVEA.L 16(A0),A1            : 2268 0010
    LEA     8(A1),A0             : 41E9 0008
    JSR     printstring          : 4EB8 3E6A
  970                    %FINISH
L12
  971                    SU_SUBPACK=0
    MOVEA.L su,A0                : 206F 0014
    CLR.B   25(A0)               : 4228 0019
  972                 %FINISH
L10
  973                 %IF %NOT PACK_AT==NULL TAG %START
    MOVEA.L pack,A1              : 226F 000C
    MOVEA.L 8(A1),A2             : 2469 0008
    CMPA.L  nulltag,A2           : B5EC FFF0
    BEQ     L10                  : 6700 0000
  974                    PRINTSTRING(" at ")
    LEA     (PC),A0              : 41FA 12D2
    JSR     printstring          : 4EB8 3E6A
  975                    PRINTSTRING(PACK_AT_NAME)
    MOVEA.L pack,A0              : 206F 000C
    MOVEA.L 8(A0),A1             : 2268 0008
    LEA     8(A1),A0             : 41E9 0008
    JSR     printstring          : 4EB8 3E6A
  976                 %FINISH
L10
  977              %ELSE
    BRA     L7                   : 6000 0000
L8
  978                 !! constrained element to wrong sort of chip
  979                 PRINTSTRING(SU_NAME_NAME)
    MOVEA.L su,A0                : 206F 0014
    MOVEA.L 4(A0),A1             : 2268 0004
    LEA     8(A1),A0             : 41E9 0008
    JSR     printstring          : 4EB8 3E6A
  980                 PRINTSTRING(" is not on ")
    LEA     (PC),A0              : 41FA 12D7
    JSR     printstring          : 4EB8 3E6A
  981                 PRINTSTRING(CHIP_NAME_NAME)
    MOVEA.L chip,A0              : 206F 0010
    MOVEA.L 0(A0),A1             : 2250
    LEA     8(A1),A0             : 41E9 0008
    JSR     printstring          : 4EB8 3E6A
  982              %FINISH
L7
  983              NEWLINE
    BSR     newline              : 6100 00B5
  984              SU_FLAGS=SU_FLAGS&(\CONSTRAINT)
    MOVEA.L su,A0                : 206F 0014
    ANDI.B  #-5,24(A0)           : 0228 FFFB 0018
  985              ->OUT
    BRA     out                  : 6000 007C
  986           %FINISH
L6
  987        %ELSE
    BRA     L3                   : 6000 0000
L4
  988           !! Pack unconstrained, or subunit unconstrained
  989           !! Pack may be constrained to a particular subpackage posn.
  990           PLACE(SU,RESULT)
    LEA     result,A1            : 43EF 0004
    MOVEA.L su,A0                : 206F 0014
    BSR     place                : 6100 0208
  991           -> OUT %IF RESULT=OK
    MOVEQ   #1,D0                : 7001
    CMP.L   result,D0            : B0AF 0004
    BEQ     out                  : 6700 00F9
  992        %FINISH
L3
  993     %REPEAT
    BRA     L1                   : 6000 000F
L2
  994  
  995     !! Build a new package
  996     NPACKAGES=NPACKAGES+1;   PACK_NEXT==RECORD(TOS);   PACK==PACK_NEXT
    ADDQ.L  #1,npackages         : 52AC FFA8
    MOVEA.L tos,A1               : 226C 0030
    MOVE.L  A1,0(A0)             : 2089
    MOVE.L  A1,pack              : 2F49 000C
  997     CHIP==SU_ON_OWNER;   !! Must exist as all SELECTED units have chips 
    MOVEA.L su,A0                : 206F 0014
    MOVEA.L 8(A0),A2             : 2468 0008
    MOVE.L  0(A2),chip           : 2F52 0010
  998     LEN=PACKLEN+CHIP_NSUBS;   ZERO(LEN);   CLAIM(LEN)
    MOVEA.L chip,A3              : 266F 0010
    MOVE.B  13(A3),D4            : 182B 000D
    MOVE.L  D4,D0                : 2004
    ADDQ.L  #6,D0                : 5C80
    MOVE.L  D0,len               : 2E80
    BSR     zero                 : 6100 01B1
    MOVE.L  len,D0               : 2017
    BSR     claim                : 6100 01AC
  999     PACK_CHIP==CHIP;   PACK_ON==CHIP_HEADER_PARM(ON)
    MOVEA.L pack,A0              : 206F 000C
    MOVE.L  chip,4(A0)           : 216F 0010 0004
    MOVEA.L chip,A1              : 226F 0010
    MOVEA.L 4(A1),A2             : 2469 0004
    MOVE.L  20(A2),12(A0)        : 216A 0014 000C
 1000     PLACE(SU,RESULT);   !! RESULT must be OK !!!
    LEA     result,A1            : 43EF 0004
    MOVEA.L su,A0                : 206F 0014
    BSR     place                : 6100 0208
 1001     PACK_ON==UNKNOWN %IF PACK_ON==RECORD(NULL)
    MOVEA.L pack,A0              : 206F 000C
    MOVE.L  12(A0),D0            : 2028 000C
    BNE     L2                   : 6600 0000
    BSR     unknown              : 6100 01ED
    MOVEA.L pack,A1              : 226F 000C
    MOVE.L  A0,12(A1)            : 2348 000C
L2
 1002     LPACK==PACK_ON_OWNER;   LPACK==PACK %IF LPACK==RECORD(NULL)
    MOVEA.L pack,A0              : 206F 000C
    MOVEA.L 12(A0),A1            : 2268 000C
    MOVE.L  0(A1),lpack          : 2F51 0008
    BNE     L2                   : 6600 0000
    MOVE.L  A0,lpack             : 2F48 0008
L2
 1003     PACK_PNO=LPACK_PNO+1;   PACK_ON_OWNER==PACK
    MOVEA.L lpack,A0             : 206F 0008
    MOVE.L  20(A0),D0            : 2028 0014
    ADDQ.L  #1,D0                : 5280
    MOVEA.L pack,A2              : 246F 000C
    MOVE.L  D0,20(A2)            : 2540 0014
    MOVEA.L 12(A2),A1            : 226A 000C
    MOVE.L  A2,0(A1)             : 228A
 1004  OUT:
 1005  %END
^   MOVEQ   #-32,D4              : 78E0
^   BSR     STACKOK              : 6100 006D
^   MOVE.L  8(A5),-(A7)          : 2F2D 0008
^   MOVE.L  A7,8(A5)             : 2B4F 0008
^   MOVE.L  A0,-(A7)             : 2F08
    MOVEA.L 8(A5),A7             : 2E6D 0008
    MOVE.L  (A7)+,8(A5)          : 2B5F 0008
    RTS                          : 4E75
 1006  
 1007  !! NAIVE ASSIGNMENT: Firstly assign all the constrained elements.
 1008  !! then assign the unconstrained elements, packing them onto
 1009  !! packages as tightly as possible.
 1010     %FOR PASS=CONSTRAINED,1,UNCONSTRAINED %CYCLE
    CLR.L   pass                 : 42A7
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
L1  ADDQ.L  #1,pass              : 52AF 000C
 1011        %FOR I=1,1,NSUBUNITS %CYCLE
    MOVE.L  nsubunits,512        : 2F2C FFAC
    CLR.L   i                    : 42AF 000C
L3  MOVE.L  i,D0                 : 202F 000C
    CMP.L   512,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 000C
 1012           SU==TASK_S(I)
    MOVE.L  i,D0                 : 202F 000C
    ASL.L   #2,D0                : E580
    MOVEA.L task,A0              : 206C FF9C
    MOVE.L  -4(A0,D0.L),su       : 2F70 08FC 0004
 1013           FLAGS=SU_FLAGS
    MOVEA.L su,A1                : 226F 0004
    MOVE.B  24(A1),D4            : 1829 0018
    MOVE.L  D4,flags             : 2F44 0008
 1014           %IF FLAGS&SELECTED#0 %START
    BTST.L  #0,D4                : 0804 0000
    BEQ     L6                   : 6700 0000
 1015              %IF (PASS=CONSTRAINED %AND FLAGS&CONSTRAINT#0) %OR %C
 1016+              (PASS=UNCONSTRAINED %AND FLAGS&CONSTRAINT=0) %START
    MOVEQ   #1,D1                : 7201
    CMP.L   pass,D1              : B2AF 0010
    BNE     L10                  : 6600 0000
    BTST.L  #2,D4                : 0804 0002
    BNE     L9                   : 6600 0000
L10 MOVEQ   #2,D2                : 7402
    CMP.L   pass,D2              : B4AF 0010
    BNE     L8                   : 6600 0000
    BTST.L  #2,D4                : 0804 0002
    BNE     L8                   : 6600 003D
L9
 1017                 ALLOCATE(SU)
    MOVEA.L A1,A0                : 2049
    BSR     allocate             : 6100 01FD
 1018              %FINISH
L8
 1019           %FINISH
L6
 1020        %REPEAT
    BRA     L3                   : 6000 0013
L4  ADDQ.L  #4,A7                : 588F
 1021     %REPEAT
L1  MOVEQ   #2,D0                : 7002
    CMP.L   pass,D0              : B0AF 000C
    BNE     L1                   : 6600 000C
 1022  %END
^   MOVEQ   #-28,D4              : 78E4
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1023  
 1024  %ROUTINE COUNT PACKAGES
 1025     %RECORD(FPACKAGE)%NAME PACK
 1026     WRITE(NSUBUNITS-NO NOT SELECTED,0)
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  nsubunits,D0         : 202C FFAC
    SUB.L   nonotselected,D0     : 90AC FFA0
    MOVEQ   #0,D1                : 7200
    JSR     write                : 4EAC 004A
 1027     PRINTSTRING(" subunits assigned to ")
    LEA     (PC),A0              : 41FA 15CA
    JSR     printstring          : 4EB8 3E6A
 1028     WRITE(NPACKAGES,0); PRINTSTRING(" packages"); NEWLINE
    MOVEQ   #0,D1                : 7200
    MOVE.L  npackages,D0         : 202C FFA8
    JSR     write                : 4EAC 004A
    LEA     (PC),A0              : 41FA 15E1
    JSR     printstring          : 4EB8 3E6A
    BSR     newline              : 6100 00B5
 1029  
 1030     %IF NPACKAGES>0 %START
    MOVE.L  npackages,D0         : 202C FFA8
    BLE     L2                   : 6F00 0000
 1031        PRINTSTRING("Package requirements:"); NEWLINE
    LEA     (PC),A0              : 41FA 15EB
    JSR     printstring          : 4EB8 3E6A
    BSR     newline              : 6100 00B5
 1032        PACK==PACKAGES_NEXT
    MOVEA.L packages,A0          : 206C FF98
    MOVE.L  0(A0),pack           : 2E90
 1033        %WHILE %NOT PACK==RECORD(NULL) %CYCLE
L3  MOVE.L  pack,D0              : 2017
    BEQ     L4                   : 6700 0000
 1034           %IF PACK_ON_OWNER==PACK %START
    MOVEA.L D0,A0                : 2040
    MOVEA.L 12(A0),A1            : 2268 000C
    MOVEA.L 0(A1),A2             : 2451
    CMPA.L  A0,A2                : B5C8
    BNE     L6                   : 6600 0000
 1035              WRITE(PACK_PNO,3); SPACE
    MOVE.L  20(A0),D0            : 2028 0014
    MOVEQ   #3,D1                : 7203
    JSR     write                : 4EAC 004A
    BSR     space                : 6100 00B6
 1036              PRINTSTRING(PACK_ON_NAME); NEWLINE
    MOVEA.L pack,A0              : 2057
    MOVEA.L 12(A0),A1            : 2268 000C
    LEA     8(A1),A0             : 41E9 0008
    JSR     printstring          : 4EB8 3E6A
    BSR     newline              : 6100 00B5
 1037           %FINISH
L6
 1038           PACK==PACK_NEXT
    MOVEA.L pack,A0              : 2057
    MOVE.L  0(A0),pack           : 2E90
 1039        %REPEAT
    BRA     L3                   : 6000 0031
L4
 1040     %FINISH
L2
 1041  
 1042     %IF NO NOT SELECTED>0 %START
    MOVE.L  nonotselected,D0     : 202C FFA0
    BLE     L2                   : 6F00 0000
 1043        PRINTSTRING("* "); WRITE(NO NOT SELECTED,0)
    LEA     (PC),A0              : 41FA 1608
    JSR     printstring          : 4EB8 3E6A
    MOVEQ   #0,D1                : 7200
    MOVE.L  nonotselected,D0     : 202C FFA0
    JSR     write                : 4EAC 004A
 1044        PRINTSTRING(" elements not assigned to packages")
    LEA     (PC),A0              : 41FA 160B
    JSR     printstring          : 4EB8 3E6A
 1045        NEWLINE
    BSR     newline              : 6100 00B5
 1046     %FINISH
L2
 1047  %END
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1048  
 1049  !!*********************************************
 1050  !!  ASSIGNment improvement routines          *
 1051  !!*********************************************
 1052  
 1053  !!*** ROUTINES TO BUILD AND INTERROGATE A CONNECTIVITY MATRIX ***
 1054  !!*** THESE ARE HIGHLY MACHINE DEPENDENT (FOR EFFICIENCY)     ***
 1055  
 1056  %INTEGER MATRIX
 1057  
 1058  %BYTEINTEGERMAP C(%INTEGER I,J)
 1059  %OWNBYTEINTEGER ZERO=0
 1060     ZERO=0 %AND %RESULT==ZERO %IF I=J
    CMP.L   D1,D0                : B081
    BNE     L2                   : 6600 0000
    CLR.B   zero                 : 422C 045E
    LEA     zero,A0              : 41EC 045E
    BRA     L0                   : 6000 0000
L2
 1061     %IF I>J %THEN %RESULT==BYTEINTEGER(MATRIX+((I-1)*(I-2))>>1+J-1) %C
 1062+            %ELSE %RESULT==BYTEINTEGER(MATRIX+((J-1)*(J-2))>>1+I-1)
    BLE     L2                   : 6F00 0000
    SUBQ.L  #1,D0                : 5380
    MOVE.L  i,D1                 : 222F 0004
    SUBQ.L  #2,D1                : 5581
    JSR     IMUL                 : 4EB8 3EF4
    LSR.L   #1,D0                : E288
    MOVEA.L D0,A0                : 2040
    ADDA.L  matrix,A0            : D1EC FF90
    ADDA.L  j,A0                 : D1D7
    LEA     -1(A0),A0            : 41E8 FFFF
    BRA     L0                   : 6000 0010
L2  MOVE.L  D1,D0                : 2001
    SUBQ.L  #1,D0                : 5380
    SUBQ.L  #2,D1                : 5581
    JSR     IMUL                 : 4EB8 3EF4
    LSR.L   #1,D0                : E288
    MOVEA.L D0,A0                : 2040
    ADDA.L  matrix,A0            : D1EC FF90
    ADDA.L  i,A0                 : D1EF 0004
    LEA     -1(A0),A0            : 41E8 FFFF
    BRA     L0                   : 6000 0022
 1063  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
^   MOVE.L  D1,-(A7)             : 2F01
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1064  
 1065  %ROUTINE BUILD CONNECTIVITY MATRIX(%Integer NSUBS)
 1066     %INTEGER I, J, S1, S2, F, MATRIXLEN, LEN
 1067     %RECORD(FFRAGMENT)%NAME FR
 1068     %RECORD(FNET)%NAME NET
 1069     %BYTEINTEGERNAME CV
 1070  !! build a connectivity matrix.
 1071  !! this is done by scanning the nets which have been stored.
 1072  !! initisalise the matrix (machine dependent)
 1073     MATRIXLEN=((NSUBS-1)*NSUBS)>>1-1
    MOVEQ   #9,D1                : 7209
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D1,#-4               : 51C9 FFFC
    SUBQ.L  #1,D0                : 5380
    MOVE.L  nsubs,D1             : 222F 0028
    JSR     IMUL                 : 4EB8 3EF4
    LSR.L   #1,D0                : E288
    SUBQ.L  #1,D0                : 5380
    MOVE.L  D0,matrixlen         : 2F40 0010
 1074     MATRIX=TOS; LEN=(MATRIXLEN+AUPW)>>LAUPW
    MOVE.L  tos,matrix           : 296C 0030 FF90
    ADDQ.L  #4,D0                : 5880
    LSR.L   #2,D0                : E488
    MOVE.L  D0,len               : 2F40 000C
 1075     ZERO(LEN);  CLAIM(LEN)
    BSR     zero                 : 6100 01B1
    MOVE.L  len,D0               : 202F 000C
    BSR     claim                : 6100 01AC
 1076  
 1077     NET==NETS_NEXT
    MOVEA.L nets,A0              : 206C FF94
    MOVE.L  0(A0),net            : 2F50 0004
 1078     %WHILE %NOT NET==RECORD(NULL) %CYCLE
L1  MOVE.L  net,D0               : 202F 0004
    BEQ     L2                   : 6700 0000
 1079        %FOR F=1,1,NET_NF %CYCLE
    MOVEA.L D0,A0                : 2040
    MOVE.B  5(A0),D4             : 1828 0005
    MOVE.L  D4,520               : 2F04
    CLR.L   f                    : 42AF 0018
L3  MOVE.L  f,D0                 : 202F 0018
    CMP.L   520,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,f                 : 52AF 0018
 1080           FR==NET_F(F)
    MOVE.L  f,D0                 : 202F 0018
    ASL.L   #2,D0                : E580
    MOVEA.L net,A0               : 206F 0008
    MOVE.L  4(A0,D0.L),fr        : 2F70 0804 000C
 1081           %FOR I=1,1,FR_FAN %CYCLE
    MOVEA.L fr,A1                : 226F 000C
    MOVE.L  4(A1),521            : 2F29 0004
    CLR.L   i                    : 42AF 002C
L5  MOVE.L  i,D0                 : 202F 002C
    CMP.L   521,D0               : B097
    BEQ     L6                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 002C
 1082              S1=FR_F(I)_SUBNO
    MOVE.L  i,D0                 : 202F 002C
    ASL.L   #3,D0                : E780
    MOVEA.L fr,A0                : 206F 0010
    MOVE.L  0(A0,D0.L),s1        : 2F70 0800 0024
 1083              %CONTINUE %IF S1=0
    BEQ     L5                   : 6700 004C
 1084              !! get the row number for the matrix entry
 1085              S1=TASK_S(S1)_SUBNO
    MOVE.L  s1,D1                : 222F 0024
    ASL.L   #2,D1                : E581
    MOVEA.L task,A1              : 226C FF9C
    MOVEA.L -4(A1,D1.L),A2       : 2471 18FC
    MOVE.L  36(A2),s1            : 2F6A 0024 0024
 1086              %CONTINUE %IF S1=0;  ! Not selected for improvement
    BEQ     L5                   : 6700 004C
 1087              %FOR J=1,1,FR_FAN %CYCLE
    MOVE.L  4(A0),522            : 2F28 0004
    CLR.L   j                    : 42AF 002C
L7  MOVE.L  j,D0                 : 202F 002C
    CMP.L   522,D0               : B097
    BEQ     L8                   : 6700 0000
    ADDQ.L  #1,j                 : 52AF 002C
 1088                 S2=FR_F(J)_SUBNO
    MOVE.L  j,D0                 : 202F 002C
    ASL.L   #3,D0                : E780
    MOVEA.L fr,A0                : 206F 0014
    MOVE.L  0(A0,D0.L),s2        : 2F70 0800 0024
 1089                 %CONTINUE %IF S2=0
    BEQ     L7                   : 6700 0072
 1090                 S2=TASK_S(S2)_SUBNO
    MOVE.L  s2,D1                : 222F 0024
    ASL.L   #2,D1                : E581
    MOVEA.L task,A1              : 226C FF9C
    MOVEA.L -4(A1,D1.L),A2       : 2471 18FC
    MOVE.L  36(A2),s2            : 2F6A 0024 0024
 1091                 ! Continue if not selected for improvement (S2=0)
 1092                 %CONTINUE %IF S2=0 %OR S1>=S2
    BEQ     L11                  : 6700 0000
    MOVE.L  s1,D1                : 222F 0028
    CMP.L   s2,D1                : B2AF 0024
    BLT     L10                  : 6D00 0000
L11 BRA     L7                   : 6000 0072
L10
 1093                 CV==C(S1,S2)
    MOVE.L  s2,D1                : 222F 0024
    MOVE.L  s1,D0                : 202F 0028
    BSR     c                    : 6100 01F9
    MOVE.L  A0,cv                : 2F48 000C
 1094                 CV=CV+1
    ADDQ.B  #1,(A0)              : 5210
 1095              %REPEAT
    BRA     L7                   : 6000 0072
L8  ADDQ.L  #4,A7                : 588F
 1096           %REPEAT
    BRA     L5                   : 6000 004C
L6  ADDQ.L  #4,A7                : 588F
 1097        %REPEAT
    BRA     L3                   : 6000 0035
L4  ADDQ.L  #4,A7                : 588F
 1098        NET==NET_NEXT
    MOVEA.L net,A0               : 206F 0004
    MOVE.L  0(A0),net            : 2F50 0004
 1099     %REPEAT
    BRA     L1                   : 6000 0029
L2
 1100  %END
^   MOVEQ   #-64,D4              : 78C0
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1101  
 1102  !!*************************************************
 1103  !! routine to improve the assignment of elements  *
 1104  !! of one kind. The improvement is effected by    *
 1105  !! growing clusters of highly connected elements  *
 1106  !! on each package. During this process the empty *
 1107  !! slots are allowed to float around.             *
 1108  !!*************************************************
 1109  
 1110  %ROUTINE IMPROVE(%RECORD(FWORKLIST)%NAME SUBTASK, %INTEGER NSUBS)
 1111     %INTEGER I, J, CONN, SPJ
 1112     %RECORD(FWORK)%NAME WI, WJ, W
 1113     %RECORD(FWORK) TEMP
 1114     %RECORD(FSUBUNIT)%NAME SI, SJ, SLOT
 1115     %RECORD(FPACKAGE)%NAME PI, PJ
 1116     %BYTEINTEGERNAME CV
 1117  
 1118  %RECORD(FWORK)%MAP MOST CONNECTED TO(%INTEGER A)
 1119     %INTEGER MCOST, COST, I, NCTA, NCTB, NCBAB, NCBAS
 1120     %RECORD(FWORK)%NAME WA,   WB,   W
 1121  !! find the element most connected to element A.
 1122  !! connectivity is defined as the number of connections
 1123  !! to A + number of connections to the element - twice
 1124  !! the number of connections between A and the element.
 1125  !! Thus the most connected element to A should share
 1126  !! a package with A in order to minimise the total connectivity.
 1127     W==RECORD(NULL)
    MOVEQ   #8,D1                : 7208
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D1,#-4               : 51C9 FFFC
    CLR.L   w                    : 42A7
 1128     WA==SUBTASK_W(A)
    ASL.L   #3,D0                : E780
    MOVEA.L subtask,A0           : 206E FFFC
    LEA     -8(A0,D0.L),A1       : 43F0 08F8
    MOVE.L  A1,wa                : 2F49 0008
 1129     NCTA=WA_C;   !! no of connections to A
    MOVE.L  4(A1),ncta           : 2F69 0004 0018
 1130     MCOST=INFINITY;   NCBAS=0
    MOVE.L  #$7FFF,mcost         : 2F7C 0000 7FFF 0024
    CLR.L   ncbas                : 42AF 000C
 1131     %FOR I=A+1,1,NSUBS %CYCLE
    MOVE.L  nsubs,540            : 2F2E FFF8
    MOVE.L  a,i                  : 2F6F 002C 0020
L1  MOVE.L  i,D0                 : 202F 0020
    CMP.L   540,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0020
 1132        WB==SUBTASK_W(I)
    MOVE.L  i,D0                 : 202F 0020
    ASL.L   #3,D0                : E780
    MOVEA.L subtask,A0           : 206E FFFC
    LEA     -8(A0,D0.L),A1       : 43F0 08F8
    MOVE.L  A1,wb                : 2F49 0008
 1133        %CONTINUE %IF WB_S_FLAGS&SWOPPED#0
    MOVEA.L 0(A1),A2             : 2451
    BTST.B  #5,24(A2)            : 082A 0005 0018
    BNE     L1                   : 6600 0026
 1134        NCTB=WB_C;   !! no of connections to B
    MOVE.L  4(A1),nctb           : 2F69 0004 0018
 1135        NCBAB=C(WA_S_SUBNO,WB_S_SUBNO);   !! no of connections between A and B
    MOVEA.L wa,A3                : 266F 000C
    MOVEA.L 0(A3),A0             : 2053
    MOVE.L  36(A0),D0            : 2028 0024
    MOVE.L  36(A2),D1            : 222A 0024
    BSR     c                    : 6100 01F9
    MOVE.B  0(A0),D4             : 1810
    MOVE.L  D4,ncbab             : 2F44 0014
 1136        COST=NCTA+NCTB-NCBAB-NCBAB;   !! cost of swop
    MOVE.L  ncta,D0              : 202F 001C
    ADD.L   nctb,D0              : D0AF 0018
    SUB.L   D4,D0                : 9084
    SUB.L   D4,D0                : 9084
    MOVE.L  D0,cost              : 2F40 0024
 1137        %IF COST<MCOST %OR (COST=MCOST %AND NCBAB>NCBAS) %START
    CMP.L   mcost,D0             : B0AF 0028
    BLT     L5                   : 6D00 0000
    BNE     L4                   : 6600 0000
    CMP.L   ncbas,D4             : B8AF 0010
    BLE     L4                   : 6F00 005E
L5
 1138           MCOST=COST;   NCBAS=NCBAB
    MOVE.L  D0,mcost             : 2F40 0028
    MOVE.L  D4,ncbas             : 2F44 0010
 1139           W==WB
    MOVE.L  wb,w                 : 2F6F 0008 0004
 1140        %FINISH
L4
 1141     %REPEAT
    BRA     L1                   : 6000 0026
L2  ADDQ.L  #4,A7                : 588F
 1142     %RESULT==W
    MOVEA.L w,A0                 : 2057
    BRA     L0                   : 6000 0000
 1143  %END
^   MOVE.L  8(A5),-(A7)          : 2F2D 0008
^   MOVE.L  A7,8(A5)             : 2B4F 0008
^   MOVE.L  D0,-(A7)             : 2F00
    MOVEA.L 8(A5),A7             : 2E6D 0008
    MOVE.L  (A7)+,8(A5)          : 2B5F 0008
    RTS                          : 4E75
 1144  
 1145  !! firstly set up the total number of connections (star connectivity)
 1146  !! to each element in the list (SUBTASK).
 1147     %FOR I=1,1,NSUBS %CYCLE
    MOVEQ   #14,D0               : 700E
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D0,#-4               : 51C8 FFFC
    MOVE.L  nsubs,530            : 2F2F 003C
    CLR.L   i                    : 42AF 003C
L1  MOVE.L  i,D0                 : 202F 003C
    CMP.L   530,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 003C
 1148        CONN=0
    CLR.L   conn                 : 42AF 0034
 1149        %FOR J=1,1,NSUBS %CYCLE
    MOVE.L  nsubs,531            : 2F2F 0040
    CLR.L   j                    : 42AF 003C
L3  MOVE.L  j,D0                 : 202F 003C
    CMP.L   531,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,j                 : 52AF 003C
 1150           CONN=CONN+C(I,J)
    MOVE.L  j,D1                 : 222F 003C
    MOVE.L  i,D0                 : 202F 0040
    BSR     c                    : 6100 01F9
    MOVE.B  0(A0),D4             : 1810
    ADD.L   D4,conn              : D9AF 0038
 1151        %REPEAT
    BRA     L3                   : 6000 001F
L4  ADDQ.L  #4,A7                : 588F
 1152        SUBTASK_W(I)_C=CONN
    MOVE.L  i,D1                 : 222F 003C
    ASL.L   #3,D1                : E781
    MOVEA.L subtask,A0           : 206F 0044
    MOVE.L  conn,-4(A0,D1.L)     : 21AF 0034 18FC
 1153     %REPEAT
    BRA     L1                   : 6000 0010
L2  ADDQ.L  #4,A7                : 588F
 1154  
 1155  !! sort this list into order of descending connectivity
 1156  !! for convenience of later processing.
 1157     %FOR I=1,1,NSUBS %CYCLE
    MOVE.L  nsubs,532            : 2F2F 003C
    CLR.L   i                    : 42AF 003C
L1  MOVE.L  i,D0                 : 202F 003C
    CMP.L   532,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 003C
 1158        WI==SUBTASK_W(I)
    MOVE.L  i,D0                 : 202F 003C
    ASL.L   #3,D0                : E780
    MOVEA.L subtask,A0           : 206F 0044
    LEA     -8(A0,D0.L),A1       : 43F0 08F8
    MOVE.L  A1,wi                : 2F49 002C
 1159        W==WI
    MOVE.L  A1,w                 : 2F49 0024
 1160        %FOR J=1,1,NSUBS %CYCLE
    MOVE.L  nsubs,533            : 2F2F 0040
    CLR.L   j                    : 42AF 003C
L3  MOVE.L  j,D0                 : 202F 003C
    CMP.L   533,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,j                 : 52AF 003C
 1161           WJ==SUBTASK_W(J)
    MOVE.L  j,D0                 : 202F 003C
    ASL.L   #3,D0                : E780
    MOVEA.L subtask,A0           : 206F 0048
    LEA     -8(A0,D0.L),A1       : 43F0 08F8
    MOVE.L  A1,wj                : 2F49 002C
 1162           W==WJ %IF WJ_C>W_C
    MOVE.L  4(A1),D1             : 2229 0004
    MOVEA.L w,A2                 : 246F 0028
    CMP.L   4(A2),D1             : B2AA 0004
    BLE     L6                   : 6F00 0000
    MOVE.L  A1,w                 : 2F49 0028
L6
 1163        %REPEAT
    BRA     L3                   : 6000 005F
L4  ADDQ.L  #4,A7                : 588F
 1164        TEMP=WI;   WI=W;   W=TEMP
    MOVEA.L wi,A0                : 206F 002C
    LEA     temp,A1              : 43EF 001C
    MOVE.L  (A0)+,(A1)+          : 22D8
    MOVE.L  (A0)+,(A1)+          : 22D8
    MOVEA.L w,A0                 : 206F 0024
    MOVEA.L wi,A1                : 226F 002C
    MOVE.L  (A0)+,(A1)+          : 22D8
    MOVE.L  (A0)+,(A1)+          : 22D8
    LEA     temp,A0              : 41EF 001C
    MOVEA.L w,A1                 : 226F 0024
    MOVE.L  (A0)+,(A1)+          : 22D8
    MOVE.L  (A0)+,(A1)+          : 22D8
 1165     %REPEAT
    BRA     L1                   : 6000 0046
L2  ADDQ.L  #4,A7                : 588F
 1166  
 1167  !! for each element in turn that hasn't yet been swopped,
 1168  !! locate the package on which that element resides.
 1169  !! For each location on the package find the most connected
 1170  !! element (if there is one) and swop it with the slot.
 1171     %FOR I=1,1,NSUBS %CYCLE
    MOVE.L  nsubs,534            : 2F2F 003C
    CLR.L   i                    : 42AF 003C
L1  MOVE.L  i,D0                 : 202F 003C
    CMP.L   534,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 003C
 1172        WI==SUBTASK_W(I)
    MOVE.L  i,D0                 : 202F 003C
    ASL.L   #3,D0                : E780
    MOVEA.L subtask,A0           : 206F 0044
    LEA     -8(A0,D0.L),A1       : 43F0 08F8
    MOVE.L  A1,wi                : 2F49 002C
 1173        SI==WI_S
    MOVE.L  0(A1),si             : 2F51 0018
 1174        !! continue if already swopped or constrained to this sub-posn
 1175        %CONTINUE %IF SI_FLAGS&(SWOPPED+SUBCONSTRAINT)#0
    MOVEA.L si,A2                : 246F 0018
    MOVE.B  24(A2),D4            : 182A 0018
    MOVEQ   #40,D1               : 7228
    AND.L   D1,D4                : C881
    BNE     L1                   : 6600 009B
 1176        PI==SI_PACK
    MOVE.L  32(A2),pi            : 2F6A 0020 000C
 1177  
 1178        !! for each slot on the pack
 1179        %FOR J=1,1,PI_CHIP_NSUBS %CYCLE
    MOVEA.L pi,A3                : 266F 000C
    MOVEA.L 4(A3),A0             : 206B 0004
    MOVE.B  13(A0),D4            : 1828 000D
    MOVE.L  D4,535               : 2F04
    CLR.L   j                    : 42AF 003C
L3  MOVE.L  j,D0                 : 202F 003C
    CMP.L   535,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,j                 : 52AF 003C
 1180           SLOT==PI_SUB(J)
    MOVE.L  j,D0                 : 202F 003C
    ASL.L   #2,D0                : E580
    MOVEA.L pi,A0                : 206F 0010
    MOVE.L  20(A0,D0.L),slot     : 2F70 0814 0014
 1181           %CONTINUE %IF SLOT==SI %OR %NOT SAME KIND(SI,PI_CHIP_SUB(J))
    MOVEA.L slot,A1              : 226F 0014
    CMPA.L  si,A1                : B3EF 001C
    BEQ     L7                   : 6700 0000
    MOVEA.L 4(A0),A2             : 2468 0004
    MOVEA.L 12(A2,D0.L),A1       : 2272 080C
    MOVEA.L si,A0                : 206F 001C
    BSR     samekind             : 6100 01DC
    BNE     L6                   : 6600 0000
L7  BRA     L3                   : 6000 00C6
L6
 1182           %CONTINUE %UNLESS SLOT==RECORD(NULL) %OR SLOT_FLAGS&CONSTRAINT=0
    MOVE.L  slot,D1              : 222F 0014
    BEQ     L6                   : 6700 0000
    MOVEA.L D1,A0                : 2041
    BTST.B  #2,24(A0)            : 0828 0002 0018
    BNE     L3                   : 6600 00C6
L6
 1183           !! got a slot that is swoppable and not constrained
 1184           WJ==MOST CONNECTED TO(I)
    MOVE.L  i,D0                 : 202F 0040
    BSR     mostconnectedto      : 6100 020F
    MOVE.L  A0,wj                : 2F48 002C
 1185           %CONTINUE %IF WJ==RECORD(NULL)
    BEQ     L3                   : 6700 00C6
 1186           SJ==WJ_S;   PJ==SJ_PACK;   SPJ=SJ_SUBPACK
    MOVE.L  0(A0),sj             : 2F50 0018
    MOVEA.L sj,A1                : 226F 0018
    MOVE.L  32(A1),pj            : 2F69 0020 000C
    MOVE.B  25(A1),D4            : 1829 0019
    MOVE.L  D4,spj               : 2F44 0034
 1187           %IF PI==PJ %THEN {same package - no point in swop} %START
    MOVEA.L pi,A2                : 246F 0010
    CMPA.L  pj,A2                : B5EF 000C
    BNE     L6                   : 6600 0000
 1188              SJ_FLAGS=SJ_FLAGS!SWOPPED
    ORI.B   #32,24(A1)           : 0029 0020 0018
 1189              %CONTINUE
    BRA     L3                   : 6000 00C6
 1190           %FINISH
L6
 1191           !! different packages - swop unless constrained
 1192           %CONTINUE %UNLESS SJ_FLAGS&CONSTRAINT=0
    BTST.B  #2,24(A1)            : 0829 0002 0018
    BNE     L3                   : 6600 00C6
 1193           !! swop SJ with SLOT
 1194           PI_SUB(J)==SJ;   PJ_SUB(SPJ)==SLOT
    MOVE.L  j,D0                 : 202F 003C
    ASL.L   #2,D0                : E580
    MOVE.L  A1,20(A2,D0.L)       : 2589 0814
    MOVE.L  D4,D1                : 2204
    ASL.L   #2,D1                : E581
    MOVEA.L pj,A3                : 266F 000C
    MOVE.L  slot,20(A3,D1.L)     : 27AF 0014 1814
 1195           SJ_PACK==PI;     SJ_SUBPACK=J
    MOVEA.L sj,A0                : 206F 0018
    MOVE.L  A2,32(A0)            : 214A 0020
    MOVE.L  j,D2                 : 242F 003C
    MOVE.B  D2,25(A0)            : 1142 0019
 1196           %IF %NOT SLOT==RECORD(NULL) %START
    MOVE.L  slot,D3              : 262F 0014
    BEQ     L6                   : 6700 0000
 1197              SLOT_PACK==PJ;   SLOT_SUBPACK=SPJ
    MOVEA.L D3,A2                : 2443
    MOVE.L  A3,32(A2)            : 254B 0020
    MOVE.B  D4,25(A2)            : 1544 0019
 1198           %FINISH
L6
 1199           SJ_FLAGS=SJ_FLAGS!SWOPPED
    ORI.B   #32,24(A0)           : 0028 0020 0018
 1200        %REPEAT
    BRA     L3                   : 6000 00C6
L4  ADDQ.L  #4,A7                : 588F
 1201     %REPEAT
    BRA     L1                   : 6000 009B
L2  ADDQ.L  #4,A7                : 588F
 1202  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
?1202  CV unused       %END
 1203  
 1204  !!*********************************************************
 1205  !! optimise the use of empty slots. swop elements to empty*
 1206  !! slots if there is an overall reduction in connectivity *
 1207  !! as a result.                                           *
 1208  !!*********************************************************
 1209  
 1210  %ROUTINE OPTIMISE(%RECORD(FWORKLIST)%NAME SUBTASK, %INTEGER NSUBS)
 1211     %INTEGER I, J, K, MGAIN, GAIN
 1212     %RECORD(FSUBUNIT)%NAME SU, SA, SB
 1213     %RECORD(FPACKAGE)%NAME PACK
 1214     %RECORD(FCHIP)%NAME CHIP
 1215  
 1216  %INTEGERFN CONNECTIONS(%RECORD(FSUBUNIT)%NAME S, %RECORD(FPACKAGE)%NAME P)
 1217     %INTEGER NC, I, J
 1218     %RECORD(FSUBUNIT)%NAME SU
 1219  !! calculate the number of connections between the element S
 1220  !! and the elements of the package P.
 1221     I=S_SUBNO
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  36(A0),i             : 2F68 0024 0008
 1222     NC=0
    CLR.L   nc                   : 42AF 000C
 1223     %FOR J=1,1,P_CHIP_NSUBS %CYCLE
    MOVEA.L 4(A1),A2             : 2469 0004
    MOVE.B  13(A2),D4            : 182A 000D
    MOVE.L  D4,534               : 2F04
    CLR.L   j                    : 42AF 0008
L1  MOVE.L  j,D0                 : 202F 0008
    CMP.L   534,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,j                 : 52AF 0008
 1224        SU==P_SUB(J)
    MOVE.L  j,D0                 : 202F 0008
    ASL.L   #2,D0                : E580
    MOVEA.L p,A0                 : 206F 0014
    MOVE.L  20(A0,D0.L),su       : 2F70 0814 0004
 1225        %CONTINUE %IF SU==RECORD(NULL)
    BEQ     L1                   : 6700 001A
 1226        NC=NC+C(I,SU_SUBNO)
    MOVEA.L su,A1                : 226F 0004
    MOVE.L  36(A1),D1            : 2229 0024
    MOVE.L  i,D0                 : 202F 000C
    BSR     c                    : 6100 01F9
    MOVE.B  0(A0),D4             : 1810
    ADD.L   D4,nc                : D9AF 0010
 1227     %REPEAT
    BRA     L1                   : 6000 001A
L2  ADDQ.L  #4,A7                : 588F
 1228     %RESULT=NC
    MOVE.L  nc,D0                : 202F 000C
    BRA     L0                   : 6000 0000
 1229  %END
^   MOVE.L  8(A5),-(A7)          : 2F2D 0008
^   MOVE.L  A7,8(A5)             : 2B4F 0008
^   MOVE.L  A0,-(A7)             : 2F08
^   MOVE.L  A1,-(A7)             : 2F09
    MOVEA.L 8(A5),A7             : 2E6D 0008
    MOVE.L  (A7)+,8(A5)          : 2B5F 0008
    RTS                          : 4E75
 1230  
 1231  !! search for an empty slot. Then search for the
 1232  !! best element to fill it. Swop the element and
 1233  !! the empty slot if an overall reduction in 
 1234  !! connectivity results.
 1235     %FOR I=1,1,NSUBS %CYCLE
    MOVEQ   #9,D0                : 7009
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D0,#-4               : 51C8 FFFC
    MOVE.L  nsubs,530            : 2F2F 0028
    CLR.L   i                    : 42AF 0028
L1  MOVE.L  i,D0                 : 202F 0028
    CMP.L   530,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0028
 1236        SU==SUBTASK_W(I)_S
    MOVE.L  i,D0                 : 202F 0028
    ASL.L   #3,D0                : E780
    MOVEA.L subtask,A0           : 206F 0030
    MOVE.L  -8(A0,D0.L),su       : 2F70 08F8 0014
 1237        PACK==SU_PACK;   CHIP==PACK_CHIP
    MOVEA.L su,A1                : 226F 0014
    MOVE.L  32(A1),pack          : 2F69 0020 0008
    MOVEA.L pack,A2              : 246F 0008
    MOVE.L  4(A2),chip           : 2F6A 0004 0004
 1238        %FOR J=1,1,CHIP_NSUBS %CYCLE
    MOVEA.L chip,A3              : 266F 0004
    MOVE.B  13(A3),D4            : 182B 000D
    MOVE.L  D4,531               : 2F04
    CLR.L   j                    : 42AF 0028
L3  MOVE.L  j,D0                 : 202F 0028
    CMP.L   531,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,j                 : 52AF 0028
 1239           SA==PACK_SUB(J)
    MOVE.L  j,D0                 : 202F 0028
    ASL.L   #2,D0                : E580
    MOVEA.L pack,A0              : 206F 000C
    MOVE.L  20(A0,D0.L),sa       : 2F70 0814 0014
 1240           %UNLESS SA==RECORD(NULL) %START
    BEQ     L6                   : 6700 0000
 1241              SA_FLAGS=SA_FLAGS!CONSIDERED
    MOVEA.L sa,A1                : 226F 0014
    ORI.B   #$0080,24(A1)        : 0029 0080 0018
 1242              %CONTINUE
    BRA     L3                   : 6000 0033
 1243           %FINISH
L6
 1244           %CONTINUE %UNLESS SAME KIND(SU,CHIP_SUB(J))
    MOVEA.L chip,A1              : 226F 0008
    MOVEA.L 12(A1,D0.L),A1       : 2271 080C
    MOVEA.L su,A0                : 206F 0018
    BSR     samekind             : 6100 01DC
    BEQ     L3                   : 6700 0033
 1245           !! Got an empty slot of the correct kind
 1246           MGAIN=-1
    MOVEQ   #-1,D1               : 72FF
    MOVE.L  D1,mgain             : 2F41 0020
 1247           %FOR K=1,1,NSUBS %CYCLE
    MOVE.L  nsubs,532            : 2F2F 0030
    CLR.L   k                    : 42AF 0028
L5  MOVE.L  k,D0                 : 202F 0028
    CMP.L   532,D0               : B097
    BEQ     L6                   : 6700 0000
    ADDQ.L  #1,k                 : 52AF 0028
 1248              SA==SUBTASK_W(K)_S
    MOVE.L  k,D0                 : 202F 0028
    ASL.L   #3,D0                : E780
    MOVEA.L subtask,A0           : 206F 0038
    MOVE.L  -8(A0,D0.L),sa       : 2F70 08F8 0018
 1249              %CONTINUE %UNLESS SA_FLAGS&FIXED=0 %AND SAME(SA,SU)
    MOVEA.L sa,A1                : 226F 0018
    MOVE.B  24(A1),D4            : 1829 0018
    MOVEQ   #14,D1               : 720E
    AND.L   D1,D4                : C881
    BNE     L9                   : 6600 0000
    MOVEA.L su,A1                : 226F 001C
    MOVEA.L sa,A0                : 206F 0018
    BSR     same                 : 6100 01E9
    BNE     L8                   : 6600 0000
L9  BRA     L5                   : 6000 0063
L8
 1250              GAIN=CONNECTIONS(SA,PACK)-CONNECTIONS(SA,SA_PACK)
    MOVEA.L pack,A1              : 226F 0010
    MOVEA.L sa,A0                : 206F 0018
    BSR     connections          : 6100 020E
    MOVE.L  D0,-(A7)             : 2F00
    MOVEA.L sa,A0                : 206F 001C
    MOVEA.L 32(A0),A1            : 2268 0020
    BSR     connections          : 6100 020E
    MOVE.L  D0,D1                : 2200
    MOVE.L  (A7)+,D0             : 201F
    SUB.L   D1,D0                : 9081
    MOVE.L  D0,gain              : 2F40 0020
 1251              %IF GAIN>MGAIN %START
    CMP.L   mgain,D0             : B0AF 0024
    BLE     L8                   : 6F00 0000
 1252                 SB==SA;   MGAIN=GAIN
    MOVE.L  sa,sb                : 2F6F 0018 0014
    MOVE.L  D0,mgain             : 2F40 0024
 1253              %FINISH
L8
 1254           %REPEAT
    BRA     L5                   : 6000 0063
L6  ADDQ.L  #4,A7                : 588F
 1255           %IF MGAIN>0 %START
    MOVE.L  mgain,D1             : 222F 0020
    BLE     L6                   : 6F00 0000
 1256              !! benefit from a swop
 1257              SB_PACK_SUB(SB_SUBPACK)==RECORD(NULL)
    MOVEA.L sb,A0                : 206F 0010
    MOVE.B  25(A0),D4            : 1828 0019
    MOVE.L  D4,D2                : 2404
    ASL.L   #2,D2                : E582
    MOVEA.L 32(A0),A1            : 2268 0020
    CLR.L   20(A1,D2.L)          : 42B1 2814
 1258              SB_PACK==PACK;   SB_SUBPACK=J
    MOVE.L  pack,32(A0)          : 216F 000C 0020
    MOVE.L  j,D2                 : 242F 0028
    MOVE.B  D2,25(A0)            : 1142 0019
 1259              PACK_SUB(J)==SB
    MOVE.L  j,D3                 : 262F 0028
    ASL.L   #2,D3                : E583
    MOVEA.L pack,A1              : 226F 000C
    MOVE.L  A0,20(A1,D3.L)       : 2388 3814
 1260              SB_FLAGS=SB_FLAGS!CONSIDERED
    MOVEA.L sb,A2                : 246F 0010
    ORI.B   #$0080,24(A2)        : 002A 0080 0018
 1261           %FINISH
L6
 1262        %REPEAT
    BRA     L3                   : 6000 0033
L4  ADDQ.L  #4,A7                : 588F
 1263     %REPEAT
    BRA     L1                   : 6000 0010
L2  ADDQ.L  #4,A7                : 588F
 1264  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
^   MOVE.L  D0,-(A7)             : 2F00
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1265  
 1266  %ROUTINE IMPROVE KIND(%INTEGER INDEX, FLAG)
 1267     %RECORD(FSUBUNIT)%NAME SU, SA
 1268     %INTEGER I, OLDTOS, NSUBS,   LEN
 1269     %RECORD(FWORKLIST)%NAME SUBTASK
 1270  !! if FLAG is IMPROVED then improve the assignment of elements
 1271  !! of kind INDEX. Otherwise optimise the use of empty slots
 1272  !! on packages containing elements of kind INDEX.
 1273     SU==TASK_S(INDEX)
    MOVEQ   #6,D2                : 7406
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D2,#-4               : 51CA FFFC
    ASL.L   #2,D0                : E580
    MOVEA.L task,A0              : 206C FF9C
    MOVE.L  -4(A0,D0.L),su       : 2F70 08FC 0018
 1274     OLDTOS=TOS;   SUBTASK==RECORD(TOS)
    MOVE.L  tos,oldtos           : 2F6C 0030 000C
    MOVEA.L tos,A1               : 226C 0030
    MOVE.L  A1,subtask           : 2E89
 1275     NSUBS=0
    CLR.L   nsubs                : 42AF 0008
 1276     %FOR I=INDEX,1,NSUBUNITS %CYCLE
    MOVE.L  nsubunits,525        : 2F2C FFAC
    MOVE.L  index,D2             : 242F 0024
    SUBQ.L  #1,D2                : 5382
    MOVE.L  D2,i                 : 2F42 0014
L1  MOVE.L  i,D0                 : 202F 0014
    CMP.L   525,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0014
 1277        !! select subunits for improvement
 1278        SA==TASK_S(I)
    MOVE.L  i,D0                 : 202F 0014
    ASL.L   #2,D0                : E580
    MOVEA.L task,A0              : 206C FF9C
    MOVE.L  -4(A0,D0.L),sa       : 2F70 08FC 0018
 1279        !! Ignore if fixed or on wrong sort of chip
 1280        %CONTINUE %IF SA_FLAGS&FIXED#0 %OR %NOT SA_ON==SU_ON
    MOVEA.L sa,A1                : 226F 0018
    MOVE.B  24(A1),D4            : 1829 0018
    MOVEQ   #14,D1               : 720E
    AND.L   D1,D4                : C881
    BNE     L5                   : 6600 0000
    MOVEA.L 8(A1),A2             : 2469 0008
    MOVEA.L su,A3                : 266F 001C
    CMPA.L  8(A3),A2             : B5EB 0008
    BEQ     L4                   : 6700 0000
L5  BRA     L1                   : 6000 0024
L4
 1281        !! Ignore if element is of wrong kind (can only happen
 1282        !! if more than one kind of element on a package)
 1283        %CONTINUE %UNLESS SAME(SA,SU)
    MOVEA.L A3,A1                : 224B
    MOVEA.L sa,A0                : 206F 0018
    BSR     same                 : 6100 01E9
    BEQ     L1                   : 6700 0024
 1284        NSUBS=NSUBS+1
    ADDQ.L  #1,nsubs             : 52AF 000C
 1285        SUBTASK_W(NSUBS)_S==SA
    MOVE.L  nsubs,D0             : 202F 000C
    ASL.L   #3,D0                : E780
    MOVEA.L subtask,A0           : 206F 0004
    MOVE.L  sa,-8(A0,D0.L)       : 21AF 0018 08F8
 1286        SA_SUBNO=NSUBS
    MOVEA.L sa,A1                : 226F 0018
    MOVE.L  nsubs,36(A1)         : 236F 000C 0024
 1287        SA_FLAGS=SA_FLAGS!FLAG
    MOVE.L  flag,D1              : 222F 0020
    OR.B    D1,24(A1)            : 8329 0018
 1288        CLAIM(WORKLEN)
    MOVEQ   #2,D0                : 7002
    BSR     claim                : 6100 01AC
 1289     %REPEAT
    BRA     L1                   : 6000 0024
L2  ADDQ.L  #4,A7                : 588F
 1290     BUILD CONNECTIVITY MATRIX(NSUBS)
    MOVE.L  nsubs,D0             : 202F 0008
    BSR     buildconnectivitymatrix: 6100 01FB
 1291     %IF FLAG=IMPROVED %THEN IMPROVE(SUBTASK,NSUBS) %C
 1292+                      %ELSE OPTIMISE(SUBTASK,NSUBS)
    MOVEQ   #16,D0               : 7010
    CMP.L   flag,D0              : B0AF 001C
    BNE     L2                   : 6600 0000
    MOVE.L  nsubs,D0             : 202F 0008
    MOVEA.L subtask,A0           : 2057
    BSR     improve              : 6100 01FD
    BRA     L1                   : 6000 0000
L2  MOVE.L  nsubs,D0             : 202F 0008
    MOVEA.L subtask,A0           : 2057
    BSR     optimise             : 6100 0200
L1
 1293     SUBTASK_W(I)_S_SUBNO=0 %FOR I=1,1,NSUBS
    MOVE.L  nsubs,526            : 2F2F 0008
    CLR.L   i                    : 42AF 0014
L1  MOVE.L  i,D0                 : 202F 0014
    CMP.L   526,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0014
    MOVE.L  i,D0                 : 202F 0014
    ASL.L   #3,D0                : E780
    MOVEA.L subtask,A0           : 206F 0004
    MOVEA.L -8(A0,D0.L),A1       : 2270 08F8
    CLR.L   36(A1)               : 42A9 0024
    BRA     L1                   : 6000 008A
L2  ADDQ.L  #4,A7                : 588F
 1294     TOS=OLDTOS
    MOVE.L  oldtos,tos           : 296F 000C 0030
 1295  %END
^   MOVEQ   #-48,D4              : 78D0
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  D0,-(A7)             : 2F00
^   MOVE.L  D1,-(A7)             : 2F01
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
?1295  LEN unused      %END
 1296  
 1297  %ROUTINE IMPROVE ASSIGNMENT
 1298     %INTEGER I,   FLAG,   PASS
 1299     %RECORD(FSUBUNIT)%NAME SU
 1300     FLAG=IMPROVED
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVEQ   #16,D0               : 7010
    MOVE.L  D0,flag              : 2F40 0008
 1301     %FOR PASS=1,1,2 %CYCLE
    CLR.L   pass                 : 42AF 0004
L1  ADDQ.L  #1,pass              : 52AF 0004
 1302     !! on the first pass we improve the assignment of
 1303     !! particular kinds of subunits. On the second
 1304     !! pass we optimise the use of empty slots on
 1305     !! particular kinds of chip.
 1306     %FOR I=1,1,NSUBUNITS %CYCLE
    MOVE.L  nsubunits,522        : 2F2C FFAC
    CLR.L   i                    : 42AF 0010
L3  MOVE.L  i,D0                 : 202F 0010
    CMP.L   522,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0010
 1307        SU==TASK_S(I)
    MOVE.L  i,D0                 : 202F 0010
    ASL.L   #2,D0                : E580
    MOVEA.L task,A0              : 206C FF9C
    MOVE.L  -4(A0,D0.L),su       : 2F70 08FC 0004
 1308        %IF SU_FLAGS&(FIXED+FLAG)=0 %AND SU_PACK_CHIP_NSUBS>=2 %START
    MOVEA.L su,A1                : 226F 0004
    MOVE.B  24(A1),D4            : 1829 0018
    MOVEQ   #14,D1               : 720E
    ADD.L   flag,D1              : D2AF 000C
    AND.L   D1,D4                : C881
    BNE     L6                   : 6600 0000
    MOVEA.L 32(A1),A2            : 2469 0020
    MOVEA.L 4(A2),A3             : 266A 0004
    CMPI.B  #2,13(A3)            : 0C2B 0002 000D
    BCS     L6                   : 6500 0033
 1309           !! element is free to move, has not had its placement improved,
 1310           !! and lives on a package with at least 2 subpackages.
 1311           IMPROVE KIND(I,FLAG)
    MOVE.L  flag,D1              : 222F 000C
    MOVE.L  i,D0                 : 202F 0010
    BSR     improvekind          : 6100 0202
 1312        %FINISH
L6
 1313     %REPEAT
    BRA     L3                   : 6000 0019
L4  ADDQ.L  #4,A7                : 588F
 1314     FLAG=OPTIMISED
    MOVEQ   #64,D1               : 7240
    MOVE.L  D1,flag              : 2F41 0008
 1315     %REPEAT
L1  MOVEQ   #2,D0                : 7002
    CMP.L   pass,D0              : B0AF 0004
    BNE     L1                   : 6600 0012
 1316  %END
^   MOVEQ   #-28,D4              : 78E4
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1317  
 1318  !!**********************************************
 1319  !!          Output  Routines                   *
 1320  !! These must cope with outputting subUNITs,   *
 1321  !! net fragments, and with outputting global   *
 1322  !! nets. Global nets must have all fragments   *
 1323  !! of the same name amalgamated before they are*
 1324  !! output. This is a transitive closure        *
 1325  !! operation.
 1326  !!**********************************************
 1327  
 1328  !! variables used by output global nets routines
 1329  %RECORD(FTAGLIST)%NAME GTAGS,   WORKLIST
 1330  
 1331  %ROUTINE LOOKUP(%RECORD(FTAG)%NAME NAME, %RECORD(FTAGLIST)%NAME DICT)
 1332     %INTEGER I, NT
 1333  !! Assume that DICT is on the top of teh stack.
 1334  !! Lookup NAME in DICT and if not found the add NAME to DICT.
 1335  !! This is used to form the list of names of all global fragments,
 1336  !! and to form the list of names of all global fragments in a given
 1337  !! net.
 1338     NT=DICT_NT
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  0(A1),nt             : 2F11
 1339     %FOR I=1,1,NT %CYCLE
    MOVE.L  nt,526               : 2F17
    CLR.L   i                    : 42AF 0008
L1  MOVE.L  i,D0                 : 202F 0008
    CMP.L   526,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0008
 1340        %RETURN %IF DICT_NAME(I)==NAME
    MOVE.L  i,D0                 : 202F 0008
    ASL.L   #2,D0                : E580
    MOVEA.L dict,A0              : 206F 000C
    MOVEA.L 0(A0,D0.L),A1        : 2270 0800
    CMPA.L  name,A1              : B3EF 0010
    BNE     L4                   : 6600 0000
    ADDQ.L  #4,A7                : 588F
    BRA     L0                   : 6000 0000
L4
 1341     %REPEAT
    BRA     L1                   : 6000 000E
L2  ADDQ.L  #4,A7                : 588F
 1342     NT=NT+1
    ADDQ.L  #1,nt                : 5297
 1343     CLAIM(1)
    MOVEQ   #1,D0                : 7001
    BSR     claim                : 6100 01AC
 1344     DICT_NAME(NT)==NAME
    MOVE.L  nt,D0                : 2017
    ASL.L   #2,D0                : E580
    MOVEA.L dict,A0              : 206F 0008
    MOVE.L  name,0(A0,D0.L)      : 21AF 000C 0800
 1345     DICT_NT=NT
    MOVE.L  nt,0(A0)             : 2097
 1346  %END
^   MOVEQ   #-28,D4              : 78E4
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
^   MOVE.L  A1,-(A7)             : 2F09
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1347  
 1348  %ROUTINE GET GLOBAL NAMES
 1349     %RECORD(FPACKAGE)%NAME PACK
 1350     %RECORD(FCHIP)%NAME CHIP
 1351     %RECORD(FFRAGMENT)%NAME FR
 1352     %RECORD(FNET)%NAME NET
 1353     %INTEGER I
 1354  !! form the list of all global fragment names in the record GTAGS.
 1355  !! This is done by searching the list of CHIPs, and searching the
 1356  !! list of global nets hung off each CHIP.
 1357  !! Multiple PACKs may point at one CHIP, so the CHIP is flagged
 1358  !! once it has been CONSIDERED.
 1359     GTAGS==RECORD(TOS);   GTAGS_NT=0;   CLAIM(TAGLISTLEN)
    MOVEQ   #4,D0                : 7004
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D0,#-4               : 51C8 FFFC
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,gtags             : 2948 FF8C
    CLR.L   0(A0)                : 4290
    MOVEQ   #1,D0                : 7001
    BSR     claim                : 6100 01AC
 1360     PACK==PACKAGES_NEXT
    MOVEA.L packages,A0          : 206C FF98
    MOVE.L  0(A0),pack           : 2F50 0010
 1361     %WHILE %NOT PACK==RECORD(NULL) %CYCLE
L1  MOVE.L  pack,D0              : 202F 0010
    BEQ     L2                   : 6700 0000
 1362        PACK_PNO=0;   !! for later
    MOVEA.L D0,A0                : 2040
    CLR.L   20(A0)               : 42A8 0014
 1363        CHIP==PACK_CHIP
    MOVE.L  4(A0),chip           : 2F68 0004 000C
 1364        PACK==PACK_NEXT
    MOVE.L  0(A0),pack           : 2F50 0010
 1365        %CONTINUE %IF CHIP_FLAGS&CONSIDERED#0
    MOVEA.L chip,A0              : 206F 000C
    BTST.B  #7,12(A0)            : 0828 0007 000C
    BNE     L1                   : 6600 0019
 1366        CHIP_FLAGS=CONSIDERED
    MOVE.B  #$0080,12(A0)        : 117C 0080 000C
 1367        NET==CHIP_GNETS
    MOVE.L  8(A0),net            : 2F68 0008 0004
 1368        %WHILE %NOT NET==RECORD(NULL) %CYCLE
L3  MOVE.L  net,D0               : 202F 0004
    BEQ     L4                   : 6700 0000
 1369           %FOR I=1,1,NET_NF %CYCLE
    MOVEA.L D0,A0                : 2040
    MOVE.B  5(A0),D4             : 1828 0005
    MOVE.L  D4,531               : 2F04
    CLR.L   i                    : 42AF 0004
L5  MOVE.L  i,D0                 : 202F 0004
    CMP.L   531,D0               : B097
    BEQ     L6                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0004
 1370              FR==NET_F(I)
    MOVE.L  i,D0                 : 202F 0004
    ASL.L   #2,D0                : E580
    MOVEA.L net,A0               : 206F 0008
    MOVE.L  4(A0,D0.L),fr        : 2F70 0804 000C
 1371              LOOKUP(FR_NAME,GTAGS)
    MOVEA.L fr,A1                : 226F 000C
    MOVEA.L 0(A1),A0             : 2051
    MOVEA.L gtags,A1             : 226C FF8C
    BSR     lookup               : 6100 0208
 1372           %REPEAT
    BRA     L5                   : 6000 0045
L6  ADDQ.L  #4,A7                : 588F
 1373           NET==NET_NEXT
    MOVEA.L net,A0               : 206F 0004
    MOVE.L  0(A0),net            : 2F50 0004
 1374        %REPEAT
    BRA     L3                   : 6000 0039
L4
 1375     %REPEAT
    BRA     L1                   : 6000 0019
L2
 1376  %END
^   MOVEQ   #-32,D4              : 78E0
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1377  
 1378  %ROUTINE REMOVE NAME(%RECORD(FTAGLIST)%NAME LIST, %RECORD(FTAG)%NAME NAME)
 1379     %INTEGER I
 1380  !! Remove the name NAME from the list of tags LIST
 1381     %FOR I=1,1,LIST_NT %CYCLE
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  0(A0),531            : 2F10
    CLR.L   i                    : 42AF 0004
L1  MOVE.L  i,D0                 : 202F 0004
    CMP.L   531,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0004
 1382        %IF LIST_NAME(I)==NAME %START
    MOVE.L  i,D0                 : 202F 0004
    ASL.L   #2,D0                : E580
    MOVEA.L list,A0              : 206F 000C
    MOVEA.L 0(A0,D0.L),A1        : 2270 0800
    CMPA.L  name,A1              : B3EF 0008
    BNE     L4                   : 6600 0000
 1383           LIST_NAME(I)==LIST_NAME(LIST_NT)
    MOVE.L  0(A0),D1             : 2210
    ASL.L   #2,D1                : E581
    MOVE.L  0(A0,D1.L),0(A0,D0.L): 21B0 1800 0800
 1384           LIST_NT=LIST_NT-1
    SUBQ.L  #1,0(A0)             : 5390
 1385           %RETURN
    ADDQ.L  #4,A7                : 588F
    BRA     L0                   : 6000 0000
 1386        %FINISH
L4
 1387     %REPEAT
    BRA     L1                   : 6000 000C
L2  ADDQ.L  #4,A7                : 588F
 1388  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
^   MOVE.L  A1,-(A7)             : 2F09
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1389  
 1390  %ROUTINE REMOVE(%RECORD(FTAGLIST)%NAME A, B)
 1391     %INTEGER I
 1392  !! remove the list of global fragment names B from the list
 1393  !! of global fragment names A. This is used to remove the
 1394  !! contents of WORKLIST from GTAGS. Eventually GTAGS becomes
 1395  !! empty and there is no more work to do.
 1396     %FOR I=1,1,B_NT %CYCLE
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  0(A1),534            : 2F11
    CLR.L   i                    : 42AF 0004
L1  MOVE.L  i,D0                 : 202F 0004
    CMP.L   534,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0004
 1397        REMOVE NAME(A,B_NAME(I))
    MOVE.L  i,D0                 : 202F 0004
    ASL.L   #2,D0                : E580
    MOVEA.L b,A0                 : 206F 0008
    MOVEA.L 0(A0,D0.L),A1        : 2270 0800
    MOVEA.L a,A0                 : 206F 000C
    BSR     removename           : 6100 020E
 1398     %REPEAT
    BRA     L1                   : 6000 000C
L2  ADDQ.L  #4,A7                : 588F
 1399  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
^   MOVE.L  A1,-(A7)             : 2F09
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1400  
 1401  %INTEGERFN COUNT GLOBAL FAN(%RECORD(FTAG)%NAME NAME)
 1402     %INTEGER COUNT, I, J
 1403     %RECORD(FNET)%NAME NET
 1404     %RECORD(FFRAGMENT)%NAME FR
 1405     %RECORD(FPACKAGE)%NAME PACK
 1406  !! count the total number of terminals referenced from global
 1407  !! net fragments of name NAME. Only CHIP terminals are counted
 1408  !! (I.E. connections internal to a chip are ignored).
 1409     COUNT=0;   PACK==PACKAGES_NEXT
    CLR.L   count                : 42A7
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVE.L  D7,-(A7)             : 2F07
    MOVEA.L packages,A1          : 226C FF98
    MOVE.L  0(A1),pack           : 2F11
 1410     %WHILE %NOT PACK==RECORD(NULL) %CYCLE
L1  MOVE.L  pack,D0              : 2017
    BEQ     L2                   : 6700 0000
 1411        NET==PACK_CHIP_GNETS
    MOVEA.L D0,A0                : 2040
    MOVEA.L 4(A0),A1             : 2268 0004
    MOVE.L  8(A1),net            : 2F69 0008 0008
 1412        %WHILE %NOT NET==RECORD(NULL) %CYCLE
L3  MOVE.L  net,D0               : 202F 0008
    BEQ     L4                   : 6700 0000
 1413           %FOR I=1,1,NET_NF %CYCLE
    MOVEA.L D0,A0                : 2040
    MOVE.B  5(A0),D4             : 1828 0005
    MOVE.L  D4,541               : 2F04
    CLR.L   i                    : 42AF 0014
L5  MOVE.L  i,D0                 : 202F 0014
    CMP.L   541,D0               : B097
    BEQ     L6                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0014
 1414              FR==NET_F(I)
    MOVE.L  i,D0                 : 202F 0014
    ASL.L   #2,D0                : E580
    MOVEA.L net,A0               : 206F 000C
    MOVE.L  4(A0,D0.L),fr        : 2F70 0804 0008
 1415              %CONTINUE %UNLESS FR_NAME==NAME
    MOVEA.L fr,A1                : 226F 0008
    MOVEA.L 0(A1),A2             : 2451
    CMPA.L  name,A2              : B5EF 001C
    BNE     L5                   : 6600 0027
 1416              %FOR J=1,1,FR_FAN %CYCLE
    MOVE.L  4(A1),542            : 2F29 0004
    CLR.L   j                    : 42AF 0014
L7  MOVE.L  j,D0                 : 202F 0014
    CMP.L   542,D0               : B097
    BEQ     L8                   : 6700 0000
    ADDQ.L  #1,j                 : 52AF 0014
 1417                 COUNT=COUNT+1 %IF FR_F(J)_SUBNO=0
    MOVE.L  j,D0                 : 202F 0014
    ASL.L   #3,D0                : E780
    MOVEA.L fr,A0                : 206F 000C
    MOVE.L  0(A0,D0.L),D1        : 2230 0800
    BNE     L10                  : 6600 0000
    ADDQ.L  #1,count             : 52AF 001C
L10
 1418              %REPEAT
    BRA     L7                   : 6000 0044
L8  ADDQ.L  #4,A7                : 588F
 1419              ->NEXT PACK
    ADDQ.L  #4,A7                : 588F
    BRA     nextpack             : 6000 0000
 1420           %REPEAT
    BRA     L5                   : 6000 0027
L6  ADDQ.L  #4,A7                : 588F
 1421           NET==NET_NEXT
    MOVEA.L net,A0               : 206F 0008
    MOVE.L  0(A0),net            : 2F50 0008
 1422        %REPEAT
    BRA     L3                   : 6000 001B
L4
 1423  NEXT PACK:
 1424        PACK==PACK_NEXT
    MOVEA.L pack,A0              : 2057
    MOVE.L  0(A0),pack           : 2E90
 1425     %REPEAT
    BRA     L1                   : 6000 0010
L2
 1426     %RESULT=COUNT
    MOVE.L  count,D0             : 202F 0014
    BRA     L0                   : 6000 0000
 1427  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1428  
 1429  %ROUTINE PUT GLOBAL FAN(%RECORD(FTAG)%NAME NAME)
 1430     %RECORD(FNET)%NAME NET
 1431     %RECORD(FFRAGMENT)%NAME FR
 1432     %RECORD(FFANEL)%NAME F
 1433     %RECORD(FPACKAGE)%NAME PACK
 1434     %INTEGER I, J
 1435  !! output the list of terminals referenced by global net fragments
 1436  !! of name NAME. Only CHIP terminals are output. (references to
 1437  !! terminals internal to the chip are ignored).
 1438  !! At the same time the transitive closure of the net is formed
 1439  !! by adding all fragment names to WORKLIST if they are not 
 1440  !! already there. In this way WORKLIST comes to hold the names
 1441  !! of all global net fragments that are at the same electrical
 1442  !! potential as the fragment called NAME.
 1443     PACK==PACKAGES_NEXT
    MOVEQ   #5,D0                : 7005
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D0,#-4               : 51C8 FFFC
    MOVEA.L packages,A1          : 226C FF98
    MOVE.L  0(A1),pack           : 2F51 0008
 1444     %WHILE %NOT PACK==RECORD(NULL) %CYCLE
L1  MOVE.L  pack,D0              : 202F 0008
    BEQ     L2                   : 6700 0000
 1445        NET==PACK_CHIP_GNETS
    MOVEA.L D0,A0                : 2040
    MOVEA.L 4(A0),A1             : 2268 0004
    MOVE.L  8(A1),net            : 2F69 0008 0014
 1446        %WHILE %NOT NET==RECORD(NULL) %CYCLE
L3  MOVE.L  net,D0               : 202F 0014
    BEQ     L4                   : 6700 0000
 1447           %FOR I=1,1,NET_NF %CYCLE
    MOVEA.L D0,A0                : 2040
    MOVE.B  5(A0),D4             : 1828 0005
    MOVE.L  D4,543               : 2F04
    CLR.L   i                    : 42AF 0008
L5  MOVE.L  i,D0                 : 202F 0008
    CMP.L   543,D0               : B097
    BEQ     L6                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0008
 1448              FR==NET_F(I)
    MOVE.L  i,D0                 : 202F 0008
    ASL.L   #2,D0                : E580
    MOVEA.L net,A0               : 206F 0018
    MOVE.L  4(A0,D0.L),fr        : 2F70 0804 0014
 1449              %CONTINUE %UNLESS FR_NAME==NAME
    MOVEA.L fr,A1                : 226F 0014
    MOVEA.L 0(A1),A2             : 2451
    CMPA.L  name,A2              : B5EF 001C
    BNE     L5                   : 6600 0028
 1450              %FOR J=1,1,FR_FAN %CYCLE
    MOVE.L  4(A1),544            : 2F29 0004
    CLR.L   j                    : 42AF 0008
L7  MOVE.L  j,D0                 : 202F 0008
    CMP.L   544,D0               : B097
    BEQ     L8                   : 6700 0000
    ADDQ.L  #1,j                 : 52AF 0008
 1451                 F==FR_F(J)
    MOVE.L  j,D0                 : 202F 0008
    ASL.L   #3,D0                : E780
    MOVEA.L fr,A0                : 206F 0018
    LEA     0(A0,D0.L),A0        : D1C0
    MOVE.L  A0,f                 : 2F48 0014
 1452                 %CONTINUE %UNLESS F_SUBNO=0
    MOVE.L  0(A0),D1             : 2210
    BNE     L7                   : 6600 0045
 1453                 BLANK;   PDEC(PACK_PNO)
    BSR     blank                : 6100 01C8
    MOVEA.L pack,A0              : 206F 0010
    MOVE.L  20(A0),D0            : 2028 0014
    BSR     pdec                 : 6100 01C6
 1454                 BLANK;   PDEC(F_TNO)
    BSR     blank                : 6100 01C8
    MOVEA.L f,A0                 : 206F 0014
    MOVE.L  4(A0),D0             : 2028 0004
    BSR     pdec                 : 6100 01C6
 1455              %REPEAT
    BRA     L7                   : 6000 0045
L8  ADDQ.L  #4,A7                : 588F
 1456              !! form closure of set of names
 1457              %FOR J=1,1,NET_NF %CYCLE
    MOVEA.L net,A0               : 206F 0018
    MOVE.B  5(A0),D4             : 1828 0005
    MOVE.L  D4,545               : 2F04
    CLR.L   j                    : 42AF 0008
L7  MOVE.L  j,D0                 : 202F 0008
    CMP.L   545,D0               : B097
    BEQ     L8                   : 6700 0000
    ADDQ.L  #1,j                 : 52AF 0008
 1458                 %CONTINUE %IF J=I
    MOVE.L  j,D0                 : 202F 0008
    CMP.L   i,D0                 : B0AF 000C
    BEQ     L7                   : 6700 0077
 1459                 LOOKUP(NET_F(J)_NAME,WORKLIST)
    ASL.L   #2,D0                : E580
    MOVEA.L net,A0               : 206F 001C
    MOVEA.L 4(A0,D0.L),A1        : 2270 0804
    MOVEA.L 0(A1),A0             : 2051
    MOVEA.L worklist,A1          : 226C FF88
    BSR     lookup               : 6100 0208
 1460              %REPEAT
    BRA     L7                   : 6000 0077
L8  ADDQ.L  #4,A7                : 588F
 1461              ->NEXT PACK
    ADDQ.L  #4,A7                : 588F
    BRA     nextpack             : 6000 0000
 1462           %REPEAT
    BRA     L5                   : 6000 0028
L6  ADDQ.L  #4,A7                : 588F
 1463           NET==NET_NEXT
    MOVEA.L net,A0               : 206F 0014
    MOVE.L  0(A0),net            : 2F50 0014
 1464        %REPEAT
    BRA     L3                   : 6000 001C
L4
 1465  NEXT PACK:
 1466        PACK==PACK_NEXT
    MOVEA.L pack,A0              : 206F 0008
    MOVE.L  0(A0),pack           : 2F50 0008
 1467     %REPEAT
    BRA     L1                   : 6000 0010
L2
 1468  %END
^   MOVEQ   #-44,D4              : 78D4
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1469  
 1470  %ROUTINE PUT GNET(%RECORD(FTAGLIST)%NAME LIST)
 1471     %RECORD(FTAG)%NAME NAME
 1472     %INTEGER I
 1473  !! output a global net consisting of the set of fragments
 1474  !! named in WORKLIST. As each fragment is output by PUT GLOBAL FAN,
 1475  !! so new names (of fragments at the same electrical potential as
 1476  !! the fragment called NAME) may be added to the end of WORKLIST.
 1477  !! Eventually the transitive closure will have been formed, and from
 1478  !! this point onwards the values of I and WORKLIST_NT must converge.
 1479  !! (thus the process terminates).
 1480     I=0
    MOVE.L  D7,-(A7)             : 2F07
    CLR.L   i                    : 42A7
 1481     %WHILE I<LIST_NT %CYCLE
L1  MOVEA.L list,A0              : 206F 0008
    MOVE.L  0(A0),D0             : 2010
    CMP.L   i,D0                 : B097
    BLE     L2                   : 6F00 0000
 1482        I=I+1
    ADDQ.L  #1,i                 : 5297
 1483        NAME==LIST_NAME(I)
    MOVE.L  i,D1                 : 2217
    ASL.L   #2,D1                : E581
    MOVE.L  0(A0,D1.L),name      : 2F70 1800 0004
 1484        PCH(CNTRL+'A')
    MOVE.L  #$00C1,D0            : 203C 0000 00C1
    BSR     pch                  : 6100 01BF
 1485        PUT TAG(NAME)
    MOVEA.L name,A0              : 206F 0004
    BSR     puttag               : 6100 01CC
 1486        PDEC(COUNT GLOBAL FAN(NAME))
    MOVEA.L name,A0              : 206F 0004
    BSR     countglobalfan       : 6100 0214
    BSR     pdec                 : 6100 01C6
 1487        PUT GLOBAL FAN(NAME)
    MOVEA.L name,A0              : 206F 0004
    BSR     putglobalfan         : 6100 0216
 1488     %REPEAT
    BRA     L1                   : 6000 000A
L2
 1489  %END
^   MOVEQ   #-20,D4              : 78EC
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1490  
 1491  %ROUTINE PUT GLOBAL NETS
 1492     %INTEGER OLDTOS
 1493  !! output all global nets that have not already been output.
 1494  !! GTAGS contains the list of names of global net fragments
 1495  !! that remain to be output. This procedure operates by building
 1496  !! a WORKLIST of 1 name, and calling PUT GNET which forms the transitive
 1497  !! closure of this and outputs it. Thus after the call to PUT GNET
 1498  !! WORKLIST contains the list of net fragment names for all fragments
 1499  !! at the same electrical potential as GTAGS_NAME(1). This is then
 1500  !! removed from GTAGS. The procedure inevitably terminates as the
 1501  !! set GTAGS gets smaller at each step.
 1502     %WHILE GTAGS_NT>0 %CYCLE
    MOVE.L  D7,-(A7)             : 2F07
L1  MOVEA.L gtags,A0             : 206C FF8C
    MOVE.L  0(A0),D0             : 2010
    BLE     L2                   : 6F00 0000
 1503        PCH(CNTRL+'N')
    MOVE.L  #$00CE,D0            : 203C 0000 00CE
    BSR     pch                  : 6100 01BF
 1504        OLDTOS=TOS
    MOVE.L  tos,oldtos           : 2EAC 0030
 1505        WORKLIST==RECORD(TOS)
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,worklist          : 2948 FF88
 1506        WORKLIST_NT=1;   CLAIM(TAGLISTLEN+1)
    MOVEQ   #1,D0                : 7001
    MOVE.L  D0,0(A0)             : 2080
    MOVEQ   #2,D0                : 7002
    BSR     claim                : 6100 01AC
 1507        WORKLIST_NAME(1)==GTAGS_NAME(1)
    MOVEA.L gtags,A0             : 206C FF8C
    MOVEA.L worklist,A1          : 226C FF88
    MOVE.L  4(A0),4(A1)          : 2368 0004 0004
 1508        PUT GNET(WORKLIST)
    MOVEA.L A1,A0                : 2049
    BSR     putgnet              : 6100 0218
 1509        REMOVE(GTAGS,WORKLIST)
    MOVEA.L worklist,A1          : 226C FF88
    MOVEA.L gtags,A0             : 206C FF8C
    BSR     remove               : 6100 0211
 1510        TOS=OLDTOS
    MOVE.L  oldtos,tos           : 2957 0030
 1511     %REPEAT
    BRA     L1                   : 6000 0008
L2
 1512  %END
^   MOVEQ   #-12,D4              : 78F4
^   BSR     STACKOK              : 6100 006D
^   LINK    #0,A6                : 4E56 0000
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
 1513  
 1514  %ROUTINE PUT FRAGMENT(%RECORD(FFRAGMENT)%NAME FR)
 1515     %INTEGER TNO,   SUBNO,   I
 1516     %RECORD(FFANEL)%NAME F
 1517     %RECORD(FSUBUNIT)%NAME SU,ssu
 1518  !! output a non-global net fragment.
 1519  !! this is easy, except that if a fan-element (SUBNO,TNO)
 1520  !! references a subUNIT, then it must be translated so that
 1521  !! it references the appropriate package and pin numbers.
 1522  !! Logical pin numbers are obtained by following the chain from
 1523  !! PACKage to CHIP to SUBCHIP to SUBCHIP TERMINAL REFERENCE,
 1524  !! to CHIP TERMINAL.
 1525     %FOR I=1,1,FR_FAN %CYCLE
    MOVEQ   #5,D0                : 7005
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D0,#-4               : 51C8 FFFC
    MOVE.L  4(A0),550            : 2F28 0004
    CLR.L   i                    : 42AF 0010
L1  MOVE.L  i,D0                 : 202F 0010
    CMP.L   550,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AF 0010
 1526        F==FR_F(I)
    MOVE.L  i,D0                 : 202F 0010
    ASL.L   #3,D0                : E780
    MOVEA.L fr,A0                : 206F 001C
    LEA     0(A0,D0.L),A0        : D1C0
    MOVE.L  A0,f                 : 2F48 000C
 1527        SUBNO=F_SUBNO;   TNO=F_TNO
    MOVE.L  0(A0),subno          : 2F50 0014
    MOVE.L  4(A0),tno            : 2F68 0004 0018
 1528        %IF SUBNO>0 %START
    MOVE.L  subno,D1             : 222F 0014
    BLE     L4                   : 6F00 0000
 1529           !! reference to an element
 1530           !! must relocate the subinstance number.
 1531           SU==TASK_S(SUBNO)
    ASL.L   #2,D1                : E581
    MOVEA.L task,A1              : 226C FF9C
    MOVE.L  -4(A1,D1.L),su       : 2F71 18FC 0008
 1532           %IF SU_FLAGS=NOT SELECTED %START
    MOVEA.L su,A2                : 246F 0008
    CMPI.B  #2,24(A2)            : 0C2A 0002 0018
    BNE     L6                   : 6600 0000
 1533              !! element no assigned to a package
 1534              SUBNO=SU_SUBNO
    MOVE.L  36(A2),subno         : 2F6A 0024 0014
 1535           %ELSE
    BRA     L5                   : 6000 0000
L6
 1536              !! element is assigned - relocate the terminal number too
 1537              SUBNO=SU_PACK_PNO
    MOVEA.L 32(A2),A3            : 266A 0020
    MOVE.L  20(A3),subno         : 2F6B 0014 0014
 1538  {jhb}       %if subno>=1000 %or tno>=1000 %start
    CMPI.L  #$03E8,subno         : 0CAF 0000 03E8 0014
    BGE     L9                   : 6C00 0000
    CMPI.L  #$03E8,tno           : 0CAF 0000 03E8 0018
    BLT     L8                   : 6D00 0000
L9
 1539  {rwt}          selectoutput(0)
    MOVEQ   #0,D0                : 7000
    JSR     selectoutput         : 4EB8 3E52
 1540  {jhb}          printstring("Pin reference out of range, Subno = "); write(subno,-1)
    LEA     (PC),A0              : 41FA 22B6
    JSR     printstring          : 4EB8 3E6A
    MOVEQ   #-1,D1               : 72FF
    MOVE.L  subno,D0             : 202F 0014
    JSR     write                : 4EAC 004A
 1541  {jhb}          printstring(", tno = "); write(tno, -1); newline
    LEA     (PC),A0              : 41FA 22DB
    JSR     printstring          : 4EB8 3E6A
    MOVEQ   #-1,D1               : 72FF
    MOVE.L  tno,D0               : 202F 0018
    JSR     write                : 4EAC 004A
    BSR     newline              : 6100 00B5
 1542  {jhb}          %stop
    CLR.L   D0                   : 4280
    JSR     SIGNAL               : 4EB8 3EFA
 1543  {jhb}       %finish
L8
 1544              TNO=SU_PACK_CHIP_SUB(SU_SUBPACK)_TREF(TNO)_T_INFO>>2
    MOVE.L  tno,D1               : 222F 0018
    ASL.L   #3,D1                : E781
    MOVE.B  25(A2),D4            : 182A 0019
    MOVE.L  D4,D2                : 2404
    ASL.L   #2,D2                : E582
    MOVEA.L 4(A3),A0             : 206B 0004
    MOVEA.L 12(A0,D2.L),A0       : 2070 280C
    MOVEA.L 8(A0,D1.L),A0        : 2070 1808
    MOVE.L  0(A0),D3             : 2610
    LSR.L   #2,D3                : E48B
    MOVE.L  D3,tno               : 2F43 0018
 1545           %FINISH
L5
 1546        %FINISH
L4
 1547  {rwt}       %if subno>=1000 %or tno>=1000 %start
    CMPI.L  #$03E8,subno         : 0CAF 0000 03E8 0014
    BGE     L5                   : 6C00 0000
    CMPI.L  #$03E8,tno           : 0CAF 0000 03E8 0018
    BLT     L4                   : 6D00 0000
L5
 1548  {rwt}          selectoutput(0)
    MOVEQ   #0,D0                : 7000
    JSR     selectoutput         : 4EB8 3E52
 1549  {rwt}          printstring("Pin reference out of range, Subno = "); write(subno,-1)
    LEA     (PC),A0              : 41FA 22E4
    JSR     printstring          : 4EB8 3E6A
    MOVEQ   #-1,D1               : 72FF
    MOVE.L  subno,D0             : 202F 0014
    JSR     write                : 4EAC 004A
 1550  {rwt}          printstring(", tno = "); write(tno, -1); newline
    LEA     (PC),A0              : 41FA 2309
    JSR     printstring          : 4EB8 3E6A
    MOVEQ   #-1,D1               : 72FF
    MOVE.L  tno,D0               : 202F 0018
    JSR     write                : 4EAC 004A
    BSR     newline              : 6100 00B5
 1551  {rwt}          %stop
    CLR.L   D0                   : 4280
    JSR     SIGNAL               : 4EB8 3EFA
 1552  {rwt}       %finish
L4
 1553        BLANK;   PDEC(SUBNO)
    BSR     blank                : 6100 01C8
    MOVE.L  subno,D0             : 202F 0014
    BSR     pdec                 : 6100 01C6
 1554        BLANK;   PDEC(TNO)
    BSR     blank                : 6100 01C8
    MOVE.L  tno,D0               : 202F 0018
    BSR     pdec                 : 6100 01C6
 1555     %REPEAT
    BRA     L1                   : 6000 0010
L2  ADDQ.L  #4,A7                : 588F
 1556  %END
^   LINK    #0,A6                : 4E56 0000
^   MOVE.L  A0,-(A7)             : 2F08
    UNLK    A6                   : 4E5E
    RTS                          : 4E75
?1556  SSU unused      %END
 1557  
 1558  !!**********************************************
 1559  !!*           MAINLINE                         *
 1560  !!**********************************************
 1561  
 1562  %INTEGER OLDTOS,   I,   SUBNO,   J,   PNO
 1563  %RECORD(FFRAGMENT)%NAME FR
 1564  %RECORD(FNET)%NAME NET
 1565  %RECORD(FSUBUNIT)%NAME SU, U
 1566  %RECORD(FTAG)%NAME TAG
 1567  %RECORD(FHEAD)%NAME H
 1568  %RECORD(FPACKAGE)%NAME PACK
 1569  
 1570  RETURN CODE=DEF STREAMS(CLIPARAM,DEFAULTS)
    MOVEQ   #38,D0               : 7026
    MOVE.L  D7,-(A7)             : 2F07
    DBRA    D0,#-4               : 51C8 FFFC
    MOVE.L  stack,D0             : 202C FFF4
    BSR     AGET                 : 6100 0074
    MOVE.L  A7,stack             : 294F FFF4
    MOVE.L  A4,-(A7)             : 2F0C
    LEA     defaults,A1          : 43D4
    LEA     cliparam,A0          : 41ED 01D0
    JSR     defstreams           : 4EAC 0460
    MOVEA.L (A7)+,A4             : 285F
    MOVE.L  D0,returncode        : 2940 FFF8
 1571  ->OUT %UNLESS RETURN CODE=1
    MOVEQ   #1,D1                : 7201
    CMP.L   D1,D0                : B081
    BNE     out                  : 6600 0000
 1572  
 1573  !! initialisation of variables
 1574  MAXTOS=0;   NULL TAG==RECORD(NULL)
    CLR.L   maxtos               : 42AC 0038
    CLR.L   nulltag              : 42AC FFF0
 1575  TOS=ADDR(STACK(0));   STACKTOP=ADDR(STACK(STACKLEN))>>LAUPW
    MOVEA.L stack,A0             : 206C FFF4
    MOVE.L  A0,tos               : 2948 0030
    MOVEA.L stack,A1             : 226C FFF4
    ADDA.L  #$00030D40,A1        : D3FC 0003 0D40
    MOVE.L  A1,D2                : 2409
    LSR.L   #2,D2                : E48A
    MOVE.L  D2,stacktop          : 2942 0034
 1576  ERROR CONTEXT="?"
    LEA     (PC),A2              : 45FA 24A6
    LEA     errorcontext,A3      : 47EC FFB0
    MOVE.B  (A2),D3              : 1612
    MOVE.B  (A2)+,(A3)+          : 16DA
    SUBQ.B  #1,D3                : 5303
    BCC     #-6                  : 64FA
 1577  SELECTOUTPUT(CONSOLE);   PRINTSTRING(HEADING);   NEWLINE
    MOVEQ   #0,D0                : 7000
    JSR     selectoutput         : 4EB8 3E52
    LEA     heading,A0           : 41FA 0002
    JSR     printstring          : 4EB8 3E6A
    BSR     newline              : 6100 00B5
 1578  
 1579  !!**************************************************
 1580  !! Firstly read in the list of UNITs to be assigned*
 1581  !! to chips.                                       *
 1582  !!**************************************************
 1583  
 1584  !! Read and output the header for the 'board'
 1585  SELIN(MIN);   SELECTOUTPUT(MOUT)
    MOVEQ   #1,D0                : 7001
    BSR     selin                : 6100 01A6
    MOVEQ   #1,D0                : 7001
    JSR     selectoutput         : 4EB8 3E52
 1586  SKIPCH
    BSR     skipch               : 6100 01C0
 1587  %IF CH=CNTRL+'S' %START
    CMPI.L  #$00D3,ch            : 0CAC 0000 00D3 003C
    BNE     L2                   : 6600 0000
 1588     READ(I);   PDEC(2)
    JSR     read                 : 4EAC 0044
    MOVE.L  D0,i                 : 2940 FF80
    MOVEQ   #2,D0                : 7002
    BSR     pdec                 : 6100 01C6
 1589     SKIPCH
    BSR     skipch               : 6100 01C0
 1590  %FINISH
L2
 1591  FAIL(D1) %UNLESS CH=CNTRL+'U'
    CMPI.L  #$00D5,ch            : 0CAC 0000 00D5 003C
    BEQ     L2                   : 6700 0000
    MOVEQ   #1,D0                : 7001
    BSR     fail                 : 6100 01AB
L2
 1592  PUT TO(CNTRL+'J');   NEWLINE;   LINECT=0
    MOVE.L  #$00CA,D0            : 203C 0000 00CA
    BSR     putto                : 6100 01C5
    BSR     newline              : 6100 00B5
    CLR.L   linect               : 42AC 0450
 1593  FAIL(D1) %UNLESS CH=CNTRL+'J'
    CMPI.L  #$00CA,ch            : 0CAC 0000 00CA 003C
    BEQ     L2                   : 6700 0000
    MOVEQ   #1,D0                : 7001
    BSR     fail                 : 6100 01AB
L2
 1594  READ(NSUBUNITS)
    JSR     read                 : 4EAC 0044
    MOVE.L  D0,nsubunits         : 2940 FFAC
 1595  FAIL(D3) %UNLESS NSUBUNITS>0
    BGT     L2                   : 6E00 0000
    MOVEQ   #3,D0                : 7003
    BSR     fail                 : 6100 01AB
L2
 1596  
 1597  !! read in the list of elements to be assigned to packages
 1598  TASK==RECORD(TOS)
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,task              : 2948 FF9C
 1599  ZERO(NSUBUNITS)
    BSR     zero                 : 6100 01B1
 1600  CLAIM(NSUBUNITS)
    MOVE.L  nsubunits,D0         : 202C FFAC
    BSR     claim                : 6100 01AC
 1601  RCH
    BSR     rch                  : 6100 01AF
 1602  TASK_S(I)==READ SUBUNIT %FOR I=1,1,NSUBUNITS
    MOVE.L  nsubunits,557        : 2F2C FFAC
    CLR.L   i                    : 42AC FF80
L1  MOVE.L  i,D0                 : 202C FF80
    CMP.L   557,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AC FF80
    BSR     readsubunit          : 6100 01D8
    MOVE.L  i,D0                 : 202C FF80
    ASL.L   #2,D0                : E580
    MOVEA.L task,A1              : 226C FF9C
    MOVE.L  A0,-4(A1,D0.L)       : 2388 08FC
    BRA     L1                   : 6000 00A0
L2  ADDQ.L  #4,A7                : 588F
 1603  
 1604  !! read in the nets for the UNIT being assigned
 1605  NETS==RECORD(TOS);   ZERO(NETLEN);   CLAIM(NETLEN)
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,nets              : 2948 FF94
    MOVEQ   #2,D0                : 7002
    BSR     zero                 : 6100 01B1
    MOVEQ   #2,D0                : 7002
    BSR     claim                : 6100 01AC
 1606  ERROR CONTEXT="Nets"
    LEA     (PC),A0              : 41FA 24A8
    LEA     errorcontext,A1      : 43EC FFB0
    MOVE.B  (A0),D0              : 1010
    MOVE.B  (A0)+,(A1)+          : 12D8
    SUBQ.B  #1,D0                : 5300
    BCC     #-6                  : 64FA
 1607  NET==NETS
    MOVE.L  nets,net             : 296C FF94 FF6C
 1608  %WHILE CH=CNTRL+'N' %CYCLE
L1  CMPI.L  #$00CE,ch            : 0CAC 0000 00CE 003C
    BNE     L2                   : 6600 0000
 1609     NET_NEXT==READ NET
    BSR     readnet              : 6100 01DA
    MOVEA.L net,A1               : 226C FF6C
    MOVE.L  A0,0(A1)             : 2288
 1610     NET==NET_NEXT
    MOVE.L  A0,net               : 2948 FF6C
 1611  %REPEAT
    BRA     L1                   : 6000 00CB
L2
 1612  
 1613  !! check that all of input file has been used
 1614  SKIP TO(CNTRL+'E')
    MOVE.L  #$00C5,D0            : 203C 0000 00C5
    BSR     skipto               : 6100 01AE
 1615  RCH
    BSR     rch                  : 6100 01AF
 1616  SELECTOUTPUT(CONSOLE)
    MOVEQ   #0,D0                : 7000
    JSR     selectoutput         : 4EB8 3E52
 1617  %UNLESS CH=END OF FILE %START
    MOVEQ   #-118,D0             : 708A
    CMP.L   ch,D0                : B0AC 003C
    BEQ     L2                   : 6700 0000
 1618     PRINTSTRING("* Only part of input(1) used")
    LEA     (PC),A0              : 41FA 24AD
    JSR     printstring          : 4EB8 3E6A
 1619     NEWLINE
    BSR     newline              : 6100 00B5
 1620  %FINISH
L2
 1621  
 1622  !!***************************************************
 1623  !! now read in the chips needed. Firstly from the   *
 1624  !! user's own library, then from the system library.*
 1625  !!***************************************************
 1626  
 1627  NO TO SELECT=NSUBUNITS;   NO NOT SELECTED=0
    MOVE.L  nsubunits,notoselect : 296C FFAC FFA4
    CLR.L   nonotselected        : 42AC FFA0
 1628  SELIN(USERLIB)
    MOVEQ   #2,D0                : 7002
    BSR     selin                : 6100 01A6
 1629  ERROR CONTEXT="Userlib"
    LEA     (PC),A0              : 41FA 24CA
    LEA     errorcontext,A1      : 43EC FFB0
    MOVE.B  (A0),D0              : 1010
    MOVE.B  (A0)+,(A1)+          : 12D8
    SUBQ.B  #1,D0                : 5300
    BCC     #-6                  : 64FA
 1630  SELECT CHIPS %UNTIL NO TO SELECT=0 %OR CH=END OF FILE
L1  BSR     selectchips          : 6100 01E7
    MOVE.L  notoselect,D0        : 202C FFA4
    BEQ     L2                   : 6700 0000
    MOVEQ   #-118,D1             : 728A
    CMP.L   ch,D1                : B2AC 003C
    BNE     L1                   : 6600 010C
L2
 1631  %IF NO TO SELECT>0 %START
    MOVE.L  D0,D0                : 2000
    BLE     L2                   : 6F00 0000
 1632     ERROR CONTEXT="Defaultlib"
    LEA     (PC),A0              : 41FA 24D2
    LEA     errorcontext,A1      : 43EC FFB0
    MOVE.B  (A0),D1              : 1210
    MOVE.B  (A0)+,(A1)+          : 12D8
    SUBQ.B  #1,D1                : 5301
    BCC     #-6                  : 64FA
 1633     SELIN(DEFAULTLIB)
    MOVEQ   #3,D0                : 7003
    BSR     selin                : 6100 01A6
 1634     SELECT CHIPS %UNTIL NO TO SELECT=0 %OR CH=END OF FILE
L3  BSR     selectchips          : 6100 01E7
    MOVE.L  notoselect,D0        : 202C FFA4
    BEQ     L4                   : 6700 0000
    MOVEQ   #-118,D1             : 728A
    CMP.L   ch,D1                : B2AC 003C
    BNE     L3                   : 6600 0129
L4
 1635  %FINISH
L2
 1636  
 1637  !!**************************************************
 1638  !! Check that all elements have a chip to live on  *
 1639  !! and moan if this is not the case.               *
 1640  !!**************************************************
 1641  
 1642  SELIN(CONSOLE);   !! reset stream no for error routine FAIL
    MOVEQ   #0,D0                : 7000
    BSR     selin                : 6100 01A6
 1643  NO TO SELECT=NO TO SELECT+NO NOT SELECTED
    MOVE.L  nonotselected,D0     : 202C FFA0
    ADD.L   D0,notoselect        : D1AC FFA4
 1644  %FOR I=1,1,NSUBUNITS %CYCLE
    MOVE.L  nsubunits,558        : 2F2C FFAC
    CLR.L   i                    : 42AC FF80
L1  MOVE.L  i,D0                 : 202C FF80
    CMP.L   558,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AC FF80
 1645     %EXIT %IF NO TO SELECT=0
    MOVE.L  notoselect,D0        : 202C FFA4
    BEQ     L2                   : 6700 0147
 1646     SU==TASK_S(I)
    MOVE.L  i,D1                 : 222C FF80
    ASL.L   #2,D1                : E581
    MOVEA.L task,A0              : 206C FF9C
    MOVE.L  -4(A0,D1.L),su       : 2970 18FC FF68
 1647     ->NEXT %IF SU_FLAGS&(SELECTED+NOT SELECTED)#0
    MOVEA.L su,A1                : 226C FF68
    MOVE.B  24(A1),D4            : 1829 0018
    MOVEQ   #3,D2                : 7403
    AND.L   D2,D4                : C882
    BEQ     L4                   : 6700 0000
    ADDQ.L  #4,A7                : 588F
    BRA     next                 : 6000 0000
L4
 1648  
 1649     PRINTSTRING("* ")
    LEA     (PC),A0              : 41FA 24DD
    JSR     printstring          : 4EB8 3E6A
 1650     %IF SU_ON==RECORD(NULL) %START
    MOVEA.L su,A0                : 206C FF68
    MOVE.L  8(A0),D0             : 2028 0008
    BNE     L4                   : 6600 0000
 1651        PRINTSTRING(SU_NAME_NAME)
    MOVEA.L 4(A0),A1             : 2268 0004
    LEA     8(A1),A0             : 41E9 0008
    JSR     printstring          : 4EB8 3E6A
 1652        PRINTSTRING(" is not on any chip")
    LEA     (PC),A0              : 41FA 24E0
    JSR     printstring          : 4EB8 3E6A
 1653     %ELSE
    BRA     L3                   : 6000 0000
L4
 1654        %IF SU_ON_OWNER==RECORD(NULL) %START
    MOVEA.L D0,A1                : 2240
    MOVE.L  0(A1),D1             : 2211
    BNE     L6                   : 6600 0000
 1655           PRINTSTRING(SU_ON_NAME)
    LEA     8(A1),A0             : 41E9 0008
    JSR     printstring          : 4EB8 3E6A
 1656           PRINTSTRING(" is not in library")
    LEA     (PC),A0              : 41FA 24F4
    JSR     printstring          : 4EB8 3E6A
 1657        %ELSE
    BRA     L5                   : 6000 0000
L6
 1658           PRINTSTRING(SU_NAME_NAME)
    MOVEA.L 4(A0),A2             : 2468 0004
    LEA     8(A2),A0             : 41EA 0008
    JSR     printstring          : 4EB8 3E6A
 1659           PRINTSTRING(" is not on ")
    LEA     (PC),A0              : 41FA 2507
    JSR     printstring          : 4EB8 3E6A
 1660           PRINTSTRING(SU_ON_NAME)
    MOVEA.L su,A0                : 206C FF68
    MOVEA.L 8(A0),A1             : 2268 0008
    LEA     8(A1),A0             : 41E9 0008
    JSR     printstring          : 4EB8 3E6A
 1661        %FINISH
L5
 1662     %FINISH
L3
 1663     NEWLINE
    BSR     newline              : 6100 00B5
 1664     U==SU_NAME_OWNER
    MOVEA.L su,A0                : 206C FF68
    MOVEA.L 4(A0),A1             : 2268 0004
    MOVE.L  0(A1),u              : 2951 FF64
 1665     %WHILE %NOT U==RECORD(NULL) %CYCLE
L3  MOVE.L  u,D0                 : 202C FF64
    BEQ     L4                   : 6700 0000
 1666        %IF U_FLAGS&SELECTED=0 %AND SAME(U,SU) %START
    MOVEA.L D0,A0                : 2040
    BTST.B  #0,24(A0)            : 0828 0000 0018
    BNE     L6                   : 6600 0000
    MOVEA.L su,A1                : 226C FF68
    BSR     same                 : 6100 01E9
    BEQ     L6                   : 6700 01BB
 1667           U_FLAGS=NOT SELECTED
    MOVEA.L u,A0                 : 206C FF64
    MOVE.B  #2,24(A0)            : 117C 0002 0018
 1668           NO TO SELECT=NO TO SELECT - 1
    SUBQ.L  #1,notoselect        : 53AC FFA4
 1669           NO NOT SELECTED=NO NOT SELECTED+1
    ADDQ.L  #1,nonotselected     : 52AC FFA0
 1670        %FINISH
L6
 1671        U==U_NEXT
    MOVEA.L u,A0                 : 206C FF64
    MOVE.L  28(A0),u             : 2968 001C FF64
 1672     %REPEAT
    BRA     L3                   : 6000 01B0
L4
 1673  NEXT:
    ADDQ.L  #4,A7                : 588F
    SUBQ.L  #4,A7                : 598F
 1674  %REPEAT
    BRA     L1                   : 6000 0143
L2  ADDQ.L  #4,A7                : 588F
 1675  FAIL(D5) %IF NO NOT SELECTED>=NSUBUNITS
    MOVE.L  nonotselected,D0     : 202C FFA0
    CMP.L   nsubunits,D0         : B0AC FFAC
    BLT     L2                   : 6D00 0000
    MOVEQ   #5,D0                : 7005
    BSR     fail                 : 6100 01AB
L2
 1676  
 1677  !!*****************************************************
 1678  !! Now assign elements to packages. Firstly do a      *
 1679  !! Naive Assignment - pack them on to chips as tightly*
 1680  !! as the constraints allow. Then improve the assignment
 1681  !! by cluster-building and optimisation of the use of *
 1682  !! empty slots on the packages. Output a list of      *
 1683  !! package requirements after the Naive Assignment.   *
 1684  !!*****************************************************
 1685  
 1686  NPACKAGES=0
    CLR.L   npackages            : 42AC FFA8
 1687  PACKAGES==RECORD(TOS)
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,packages          : 2948 FF98
 1688  ZERO(PACKLEN);   CLAIM(PACKLEN)
    MOVEQ   #6,D0                : 7006
    BSR     zero                 : 6100 01B1
    MOVEQ   #6,D0                : 7006
    BSR     claim                : 6100 01AC
 1689  ERROR CONTEXT="Assignment"
    LEA     (PC),A0              : 41FA 2513
    LEA     errorcontext,A1      : 43EC FFB0
    MOVE.B  (A0),D0              : 1010
    MOVE.B  (A0)+,(A1)+          : 12D8
    SUBQ.B  #1,D0                : 5300
    BCC     #-6                  : 64FA
 1690  NAIVE ASSIGNMENT
    BSR     naiveassignment      : 6100 01F5
 1691  COUNT PACKAGES
    BSR     countpackages        : 6100 01F7
 1692  IMPROVE ASSIGNMENT
    BSR     improveassignment    : 6100 0204
 1693  
 1694  !!************************************************
 1695  !! Output any UNITs that couldn't be assigned    *
 1696  !! to packages (if there are such UNITs).        *
 1697  !!************************************************
 1698  
 1699  SELECTOUTPUT(MOUT)
    MOVEQ   #1,D0                : 7001
    JSR     selectoutput         : 4EB8 3E52
 1700  WRITE(NPACKAGES+NO NOT SELECTED,0)
    MOVE.L  npackages,D0         : 202C FFA8
    ADD.L   nonotselected,D0     : D0AC FFA0
    MOVEQ   #0,D1                : 7200
    JSR     write                : 4EAC 004A
 1701  SUBNO=0
    CLR.L   subno                : 42AC FF7C
 1702  %IF NO NOT SELECTED>0 %START
    MOVE.L  nonotselected,D0     : 202C FFA0
    BLE     L2                   : 6F00 0000
 1703     SELIN(MIN);   RESET INPUT;   RCH
    MOVEQ   #1,D0                : 7001
    BSR     selin                : 6100 01A6
    MOVE.L  A4,-(A7)             : 2F0C
    JSR     resetinput           : 4EAC 046C
    MOVEA.L (A7)+,A4             : 285F
    BSR     rch                  : 6100 01AF
 1704     SKIP TO(CNTRL+'J')
    MOVE.L  #$00CA,D0            : 203C 0000 00CA
    BSR     skipto               : 6100 01AE
 1705     %FOR I=1,1,NSUBUNITS %CYCLE
    MOVE.L  nsubunits,560        : 2F2C FFAC
    CLR.L   i                    : 42AC FF80
L3  MOVE.L  i,D0                 : 202C FF80
    CMP.L   560,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,i                 : 52AC FF80
 1706        SU==TASK_S(I)
    MOVE.L  i,D0                 : 202C FF80
    ASL.L   #2,D0                : E580
    MOVEA.L task,A0              : 206C FF9C
    MOVE.L  -4(A0,D0.L),su       : 2970 08FC FF68
 1707        SKIP TO(CNTRL+'H')
    MOVE.L  #$00C8,D0            : 203C 0000 00C8
    BSR     skipto               : 6100 01AE
 1708        %IF SU_FLAGS=NOT SELECTED %START
    MOVEA.L su,A0                : 206C FF68
    CMPI.B  #2,24(A0)            : 0C28 0002 0018
    BNE     L6                   : 6600 0000
 1709           SUBNO=SUBNO+1;   SU_SUBNO=SUBNO
    ADDQ.L  #1,subno             : 52AC FF7C
    MOVE.L  subno,36(A0)         : 216C FF7C 0024
 1710           PCH(CNTRL+'H')
    MOVE.L  #$00C8,D0            : 203C 0000 00C8
    BSR     pch                  : 6100 01BF
 1711           COPY NUM %AND BLANK %FOR J=1,1,5
    CLR.L   j                    : 42AC FF78
L7  ADDQ.L  #1,j                 : 52AC FF78
    BSR     copynum              : 6100 01D1
    BSR     blank                : 6100 01C8
    MOVEQ   #5,D0                : 7005
    CMP.L   j,D0                 : B0AC FF78
    BNE     L7                   : 6600 025E
 1712           SKIP TAG
    BSR     skiptag              : 6100 01B9
 1713           %IF SU_UNAME==RECORD(NULL) %START
    MOVEA.L su,A0                : 206C FF68
    MOVE.L  0(A0),D0             : 2010
    BNE     L8                   : 6600 0000
 1714              PUT TAG(INT TO TAG(SUBNO))
    MOVE.L  subno,D0             : 202C FF7C
    BSR     inttotag             : 6100 01EF
    BSR     puttag               : 6100 01CC
 1715           %ELSE
    BRA     L7                   : 6000 0000
L8
 1716              PUT TAG(SU_UNAME)
    MOVEA.L D0,A0                : 2040
    BSR     puttag               : 6100 01CC
 1717           %FINISH
L7
 1718           PUT TO(CNTRL+'G')
    MOVE.L  #$00C7,D0            : 203C 0000 00C7
    BSR     putto                : 6100 01C5
 1719        %FINISH
L6
 1720        CH=NULL;   !! to fool SKIP TO, if necessary
    CLR.L   ch                   : 42AC 003C
 1721     %REPEAT
    BRA     L3                   : 6000 0231
L4  ADDQ.L  #4,A7                : 588F
 1722  %FINISH
L2
 1723  
 1724  !!************************************************
 1725  !! Output the assigned UNIT in terms of chips    *
 1726  !! Then output the list of nets, relocating the  *
 1727  !! terminal references appropriately so they refer
 1728  !! to chip logical terminal numbers and not to   *
 1729  !! UNIT logical terminal numbers.                *
 1730  !!************************************************
 1731  
 1732  ERROR CONTEXT="Output"
    LEA     (PC),A0              : 41FA 251E
    LEA     errorcontext,A1      : 43EC FFB0
    MOVE.B  (A0),D0              : 1010
    MOVE.B  (A0)+,(A1)+          : 12D8
    SUBQ.B  #1,D0                : 5300
    BCC     #-6                  : 64FA
 1733  !! set all pack numbers to zero for the output code
 1734  GET GLOBAL NAMES
    BSR     getglobalnames       : 6100 020C
 1735  %FOR I=1,1,NSUBUNITS %CYCLE
    MOVE.L  nsubunits,561        : 2F2C FFAC
    CLR.L   i                    : 42AC FF80
L1  MOVE.L  i,D0                 : 202C FF80
    CMP.L   561,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AC FF80
 1736     PACK==TASK_S(I)_PACK
    MOVE.L  i,D0                 : 202C FF80
    ASL.L   #2,D0                : E580
    MOVEA.L task,A0              : 206C FF9C
    MOVEA.L -4(A0,D0.L),A1       : 2270 08FC
    MOVE.L  32(A1),pack          : 2969 0020 FF58
 1737     %CONTINUE %IF PACK==RECORD(NULL)
    BEQ     L1                   : 6700 029E
 1738     %CONTINUE %UNLESS PACK_PNO<=0
    MOVEA.L pack,A2              : 246C FF58
    MOVE.L  20(A2),D1            : 222A 0014
    BGT     L1                   : 6E00 029E
 1739     !! pack hasn't yet been output
 1740     SUBNO=SUBNO+1
    ADDQ.L  #1,subno             : 52AC FF7C
 1741     PACK_PNO=SUBNO
    MOVE.L  subno,20(A2)         : 256C FF7C 0014
 1742     H==PACK_CHIP_HEADER
    MOVEA.L 4(A2),A3             : 266A 0004
    MOVE.L  4(A3),h              : 296B 0004 FF5C
 1743     H_PARM(AT)==PACK_AT
    MOVEA.L h,A0                 : 206C FF5C
    MOVE.L  8(A2),16(A0)         : 216A 0008 0010
 1744     PACK_PACKNAME==INT TO TAG(SUBNO) %IF PACK_PACKNAME==NULL TAG
    MOVEA.L 16(A2),A0            : 206A 0010
    CMPA.L  nulltag,A0           : B1EC FFF0
    BNE     L4                   : 6600 0000
    MOVE.L  subno,D0             : 202C FF7C
    BSR     inttotag             : 6100 01EF
    MOVEA.L pack,A1              : 226C FF58
    MOVE.L  A0,16(A1)            : 2348 0010
L4
 1745     H_UNAME==PACK_PACKNAME
    MOVEA.L h,A1                 : 226C FF5C
    MOVE.L  A0,8(A1)             : 2348 0008
 1746     PUT HEAD(H)
    MOVEA.L A1,A0                : 2049
    BSR     puthead              : 6100 01D3
 1747  %REPEAT
    BRA     L1                   : 6000 029E
L2  ADDQ.L  #4,A7                : 588F
 1748  
 1749  !! and output all nets of the UNIT, appropriately relocated
 1750  NET==NETS_NEXT;   OLDTOS=TOS
    MOVEA.L nets,A0              : 206C FF94
    MOVE.L  0(A0),net            : 2950 FF6C
    MOVE.L  tos,oldtos           : 296C 0030 FF84
 1751  %WHILE %NOT NET==RECORD(NULL) %CYCLE
L1  MOVE.L  net,D0               : 202C FF6C
    BEQ     L2                   : 6700 0000
 1752     PCH(CNTRL+'N')
    MOVE.L  #$00CE,D0            : 203C 0000 00CE
    BSR     pch                  : 6100 01BF
 1753     WORKLIST==RECORD(TOS);   CLAIM(TAGLISTLEN)
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,worklist          : 2948 FF88
    MOVEQ   #1,D0                : 7001
    BSR     claim                : 6100 01AC
 1754     WORKLIST_NT=0
    MOVEA.L worklist,A0          : 206C FF88
    CLR.L   0(A0)                : 4290
 1755     %FOR I=1,1,NET_NF %CYCLE
    MOVEA.L net,A1               : 226C FF6C
    MOVE.B  5(A1),D4             : 1829 0005
    MOVE.L  D4,562               : 2F04
    CLR.L   i                    : 42AC FF80
L3  MOVE.L  i,D0                 : 202C FF80
    CMP.L   562,D0               : B097
    BEQ     L4                   : 6700 0000
    ADDQ.L  #1,i                 : 52AC FF80
 1756        FR==NET_F(I)
    MOVE.L  i,D0                 : 202C FF80
    ASL.L   #2,D0                : E580
    MOVEA.L net,A0               : 206C FF6C
    MOVE.L  4(A0,D0.L),fr        : 2970 0804 FF70
 1757        PCH(CNTRL+'A')
    MOVE.L  #$00C1,D0            : 203C 0000 00C1
    BSR     pch                  : 6100 01BF
 1758        PUT TAG(FR_NAME)
    MOVEA.L fr,A0                : 206C FF70
    MOVEA.L 0(A0),A0             : 2050
    BSR     puttag               : 6100 01CC
 1759        %IF NET_FLAGS&GLOBAL=0 %START
    MOVEA.L net,A0               : 206C FF6C
    BTST.B  #0,4(A0)             : 0828 0000 0004
    BNE     L6                   : 6600 0000
 1760           PDEC(FR_FAN)
    MOVEA.L fr,A1                : 226C FF70
    MOVE.L  4(A1),D0             : 2029 0004
    BSR     pdec                 : 6100 01C6
 1761        %ELSE
    BRA     L5                   : 6000 0000
L6
 1762           TAG==FR_NAME
    MOVEA.L fr,A1                : 226C FF70
    MOVE.L  0(A1),tag            : 2951 FF60
 1763           PDEC(FR_FAN+COUNT GLOBAL FAN(TAG))
    MOVEA.L tag,A0               : 206C FF60
    BSR     countglobalfan       : 6100 0214
    MOVEA.L fr,A0                : 206C FF70
    ADD.L   4(A0),D0             : D0A8 0004
    BSR     pdec                 : 6100 01C6
 1764           PUT GLOBAL FAN(TAG)
    MOVEA.L tag,A0               : 206C FF60
    BSR     putglobalfan         : 6100 0216
 1765           REMOVE NAME(GTAGS,TAG)
    MOVEA.L tag,A1               : 226C FF60
    MOVEA.L gtags,A0             : 206C FF8C
    BSR     removename           : 6100 020E
 1766        %FINISH
L5
 1767        PUT FRAGMENT(FR)
    MOVEA.L fr,A0                : 206C FF70
    BSR     putfragment          : 6100 021D
 1768     %REPEAT
    BRA     L3                   : 6000 0310
L4  ADDQ.L  #4,A7                : 588F
 1769     %IF NET_FLAGS&GLOBAL#0 %START
    MOVEA.L net,A0               : 206C FF6C
    BTST.B  #0,4(A0)             : 0828 0000 0004
    BEQ     L4                   : 6700 0000
 1770        PUT GNET(WORKLIST)
    MOVEA.L worklist,A0          : 206C FF88
    BSR     putgnet              : 6100 0218
 1771        REMOVE(GTAGS,WORKLIST)
    MOVEA.L worklist,A1          : 226C FF88
    MOVEA.L gtags,A0             : 206C FF8C
    BSR     remove               : 6100 0211
 1772     %FINISH
L4
 1773     TOS=OLDTOS
    MOVE.L  oldtos,tos           : 296C FF84 0030
 1774     NET==NET_NEXT
    MOVEA.L net,A0               : 206C FF6C
    MOVE.L  0(A0),net            : 2950 FF6C
 1775  %REPEAT
    BRA     L1                   : 6000 02F1
L2
 1776  
 1777  !! and output the global nets (names begin with '.')
 1778  PUT GLOBAL NETS
    BSR     putglobalnets        : 6100 021B
 1779  
 1780  PCH(CNTRL+'E');   NEWLINE
    MOVE.L  #$00C5,D0            : 203C 0000 00C5
    BSR     pch                  : 6100 01BF
    BSR     newline              : 6100 00B5
 1781  
 1782  !!*****************************************************
 1783  !! re-read the primary input file and produce the     *
 1784  !! updated input. This consists of the original input *
 1785  !! with ON strings, PACKAGE names, and SUBPACK numbers*
 1786  !! added. This can then be fed back into ASSIGN to    *
 1787  !! produce the identical CHIP and UPDATED outputs.    *
 1788  !!*****************************************************
 1789  
 1790  ERROR CONTEXT="Update"
    LEA     (PC),A0              : 41FA 2525
    LEA     errorcontext,A1      : 43EC FFB0
    MOVE.B  (A0),D0              : 1010
    MOVE.B  (A0)+,(A1)+          : 12D8
    SUBQ.B  #1,D0                : 5300
    BCC     #-6                  : 64FA
 1791  SELIN(MIN);   SELECTOUTPUT(SOUT)
    MOVEQ   #1,D0                : 7001
    BSR     selin                : 6100 01A6
    MOVEQ   #2,D0                : 7002
    JSR     selectoutput         : 4EB8 3E52
 1792  RESETINPUT;   LINECT=0
    MOVE.L  A4,-(A7)             : 2F0C
    JSR     resetinput           : 4EAC 046C
    MOVEA.L (A7)+,A4             : 285F
    CLR.L   linect               : 42AC 0450
 1793  
 1794  SKIPCH
    BSR     skipch               : 6100 01C0
 1795  %IF CH=CNTRL+'S' %START
    CMPI.L  #$00D3,ch            : 0CAC 0000 00D3 003C
    BNE     L2                   : 6600 0000
 1796     COPY NUM
    BSR     copynum              : 6100 01D1
 1797     SKIPCH
    BSR     skipch               : 6100 01C0
 1798  %FINISH
L2
 1799  
 1800  PUT TO(CNTRL+'J')
    MOVE.L  #$00CA,D0            : 203C 0000 00CA
    BSR     putto                : 6100 01C5
 1801  COPY NUM
    BSR     copynum              : 6100 01D1
 1802  
 1803  OLDTOS=TOS
    MOVE.L  tos,oldtos           : 296C 0030 FF84
 1804  %FOR I=1,1,NSUBUNITS %CYCLE
    MOVE.L  nsubunits,563        : 2F2C FFAC
    CLR.L   i                    : 42AC FF80
L1  MOVE.L  i,D0                 : 202C FF80
    CMP.L   563,D0               : B097
    BEQ     L2                   : 6700 0000
    ADDQ.L  #1,i                 : 52AC FF80
 1805     H==RECORD(TOS);   ZERO(HEADLEN);   CLAIM(HEADLEN)
    MOVEA.L tos,A0               : 206C 0030
    MOVE.L  A0,h                 : 2948 FF5C
    MOVEQ   #13,D0               : 700D
    BSR     zero                 : 6100 01B1
    MOVEQ   #13,D0               : 700D
    BSR     claim                : 6100 01AC
 1806     %CYCLE
L3
 1807        RCH
    BSR     rch                  : 6100 01AF
 1808        %EXIT %IF CH=CNTRL+'P' %OR CH=CNTRL+'G'
    CMPI.L  #$00D0,ch            : 0CAC 0000 00D0 003C
    BEQ     L7                   : 6700 0000
    CMPI.L  #$00C7,ch            : 0CAC 0000 00C7 003C
    BNE     L6                   : 6600 0000
L7  BRA     L4                   : 6000 0000
L6
 1809        SEPARATE %IF CH>=CNTRL
    CMPI.L  #$0080,ch            : 0CAC 0000 0080 003C
    BLT     L6                   : 6D00 0000
    BSR     separate             : 6100 01C3
L6
 1810        PCH(CH)
    MOVE.L  ch,D0                : 202C 003C
    BSR     pch                  : 6100 01BF
 1811     %REPEAT
    BRA     L3                   : 6000 03D9
L4
 1812     %WHILE CH=CNTRL+'P' %CYCLE
L3  CMPI.L  #$00D0,ch            : 0CAC 0000 00D0 003C
    BNE     L4                   : 6600 0000
 1813        READ(PNO)
    JSR     read                 : 4EAC 0044
    MOVE.L  D0,pno               : 2940 FF74
 1814        H_PARM(PNO)==READ TAG(GENERAL)
    MOVEQ   #0,D0                : 7000
    BSR     readtag              : 6100 01B7
    MOVE.L  pno,D0               : 202C FF74
    ASL.L   #2,D0                : E580
    MOVEA.L h,A1                 : 226C FF5C
    MOVE.L  A0,12(A1,D0.L)       : 2388 080C
 1815        RCH
    BSR     rch                  : 6100 01AF
 1816     %REPEAT
    BRA     L3                   : 6000 03FC
L4
 1817     SU==TASK_S(I)
    MOVE.L  i,D0                 : 202C FF80
    ASL.L   #2,D0                : E580
    MOVEA.L task,A0              : 206C FF9C
    MOVE.L  -4(A0,D0.L),su       : 2970 08FC FF68
 1818     %IF SU_FLAGS&NOT SELECTED=0 %START
    MOVEA.L su,A1                : 226C FF68
    BTST.B  #1,24(A1)            : 0829 0001 0018
    BNE     L4                   : 6600 0000
 1819        !! unit has been assigned to a chip
 1820        H_PARM(ON)==SU_ON
    MOVEA.L h,A2                 : 246C FF5C
    MOVE.L  8(A1),20(A2)         : 2569 0008 0014
 1821        H_PARM(SUB)==INT TO TAG(SU_SUBPACK) %IF SU_PACK_CHIP_NSUBS>1
    MOVEA.L 32(A1),A3            : 2669 0020
    MOVEA.L 4(A3),A0             : 206B 0004
    CMPI.B  #1,13(A0)            : 0C28 0001 000D
    BLS     L6                   : 6300 0000
    MOVE.B  25(A1),D4            : 1829 0019
    MOVE.L  D4,D0                : 2004
    BSR     inttotag             : 6100 01EF
    MOVEA.L h,A1                 : 226C FF5C
    MOVE.L  A0,28(A1)            : 2348 001C
L6
 1822        H_PARM(PACKNO)==SU_PACK_PACKNAME
    MOVEA.L su,A0                : 206C FF68
    MOVEA.L 32(A0),A1            : 2268 0020
    MOVEA.L h,A2                 : 246C FF5C
    MOVE.L  16(A1),24(A2)        : 2569 0010 0018
 1823     %FINISH
L4
 1824     %FOR PNO=1,1,MAX PARMS %CYCLE
    CLR.L   pno                  : 42AC FF74
L3  ADDQ.L  #1,pno               : 52AC FF74
 1825        TAG==H_PARM(PNO)
    MOVE.L  pno,D0               : 202C FF74
    ASL.L   #2,D0                : E580
    MOVEA.L h,A0                 : 206C FF5C
    MOVE.L  12(A0,D0.L),tag      : 2970 080C FF60
 1826        %unless tag==record(null) %start{*compiler bug*%CONTINUE %IF TAG==RECORD(NULL)
    BEQ     L6                   : 6700 0000
 1827           PCH(CNTRL+'P')
    MOVE.L  #$00D0,D0            : 203C 0000 00D0
    BSR     pch                  : 6100 01BF
 1828           PDEC(PNO);   BLANK
    MOVE.L  pno,D0               : 202C FF74
    BSR     pdec                 : 6100 01C6
    BSR     blank                : 6100 01C8
 1829           PUT TAG(TAG)
    MOVEA.L tag,A0               : 206C FF60
    BSR     puttag               : 6100 01CC
 1830        %finish{}
L6
 1831     %REPEAT
L3  MOVEQ   #8,D0                : 7008
    CMP.L   pno,D0               : B0AC FF74
    BNE     L3                   : 6600 0450
 1832     PCH(CNTRL+'G');   SKIP TO(CNTRL+'G')
    MOVE.L  #$00C7,D0            : 203C 0000 00C7
    BSR     pch                  : 6100 01BF
    MOVE.L  #$00C7,D0            : 203C 0000 00C7
    BSR     skipto               : 6100 01AE
 1833     CLEANUP(OLDTOS)
    MOVE.L  oldtos,D0            : 202C FF84
    BSR     cleanup              : 6100 01B6
 1834  %REPEAT
    BRA     L1                   : 6000 03C7
L2  ADDQ.L  #4,A7                : 588F
 1835  PUT TO(END OF FILE)
    MOVEQ   #-118,D0             : 708A
    BSR     putto                : 6100 01C5
 1836  
 1837  !!******************************************
 1838  !! report on usage of space                *
 1839  !!******************************************
 1840  
 1841  SELECTOUTPUT(CONSOLE)
    MOVEQ   #0,D0                : 7000
    JSR     selectoutput         : 4EB8 3E52
 1842  MAXTOS=MAXTOS-ADDR(STACK(0))>>LAUPW
    MOVEA.L stack,A0             : 206C FFF4
    MOVE.L  A0,D0                : 2008
    LSR.L   #2,D0                : E488
    SUB.L   D0,maxtos            : 91AC 0038
 1843  PRINTSTRING("Used ");   WRITE(MAXTOS,0)
    LEA     (PC),A0              : 41FA 252C
    JSR     printstring          : 4EB8 3E6A
    MOVEQ   #0,D1                : 7200
    MOVE.L  maxtos,D0            : 202C 0038
    JSR     write                : 4EAC 004A
 1844  PRINTSTRING(" out of ");WRITE(STACKLEN,0)
    LEA     (PC),A0              : 41FA 2532
    JSR     printstring          : 4EB8 3E6A
    MOVEQ   #0,D1                : 7200
    MOVE.L  #$0000C350,D0        : 203C 0000 C350
    JSR     write                : 4EAC 004A
 1845  PRINTSTRING(" words."); NEWLINE
    LEA     (PC),A0              : 41FA 253B
    JSR     printstring          : 4EB8 3E6A
    BSR     newline              : 6100 00B5
 1846  
 1847  OUT:
 1848  %ENDOFPROGRAM
^   MOVE.L  #$FF4C,D4            : 283C FFFF FF4C
^   BSR     STACKOK              : 6100 006D
    LEA     168(A7),A7           : 4FEF 00A8
    MOVEQ   #0,D0                : 7000
    JSR     SIGNAL               : 4EB8 3EFA
XPACKAGE compiled: 1375 statements (+ 457 comments) to 11518 bytes (+ 94)