%EXTERNALROUTINE DCAPA(%STRING(63) PAR)
%ROUTINESPEC READ LINE
%INTEGERFNSPEC COMPARE(%INTEGER PSP)
%ROUTINESPEC SS
%ROUTINESPEC FILL(%SHORTINTEGERARRAYNAME D,%INTEGER FROM,TO,VAL)
%SHORTINTEGERARRAYFORMAT SF(0:32759)
%SHORTINTEGERARRAYNAME S,ED,AD,BD,CD
%SHORTINTEGERNAME SP,EDP,ADP,BDP
%SHORTINTEGERARRAY A,NP(1:1004)
%BYTEINTEGERARRAY T(1:1000)
%SHORTINTEGERARRAY IV(0:72)   ;! ALLOWS 8 NESTING LEVELS
%SHORTINTEGER IVP
%INTEGER AP,TP,I,J,DEF,FIRSTINFO,FAULTS,ELNUM,DUMMY,DCAPFAD
%OWNINTEGER LASTLINK=11
%EXTERNALROUTINESPEC DEFINE(%STRING(63) S)
%SYSTEMROUTINESPEC OUTFILE(%STRING(15) S,%INTEGER LENGTH,MAX,PROT, %C
 %INTEGERNAME CONAD,FLAG)
%STRING(63) P,Q,R,TAPE
%OWNSHORTINTEGERARRAY PS(-1000:-518)= %C
-997,-933,-522,-993,-678,-811,-522,-988,   1,  58,-852,-522,
-971, 195, 200, 201, 208, 196, 197, 198,   1,  40,-735,-721,
  41,  61,-715,-697,-522,-943, 194, 207, 193, 210, 196, 196,
 197, 198,   1,  40,-660,-585,  41,  60,  45, 193, 211, 211,
 197, 205, 194, 204, 217,  40,   1,  41,-522,-937, 197, 206,
 196,-528,-522,-934,   3,-522,   0,-928,-878,  45,  62,-878,
-911, 198, 207, 210,   1,  61,-572,  44,-572,  44,-572, 196,
 207,  91,-821,-817,  93,-891,   1,  40,-579,  44,-579,  41,
  60,  45, 195, 200, 201, 208,  40,   1,  41,  60,  45,-841,
-827,-882,   1,  40,-579,  41,  60,  45,   1,-864,-879,  33,
   3,   0,-875,-852,-847,-873, 206,-869, 199, 206, 196,-865,
 214, 195, 195,   0,-860,  40,-572,  41,-859,   0,-854,  46,
   1,-864,-853,   0,-848,   1,-864,-858,   0,-843,  44,-852,
-847,-842,   0,-837,   1,-864,-834,-835, 206,   0,-829,  46,
   1,-864,-834,-828,   0,-823,  44,-841,-827,-822,   0,-819,
-933,-818,   0,-813,-522,-821,-817,-812,   0,-802, 196, 197,
 198,   1,  40,-795,-790,  41,-796,  40,   1,  41,-764,-747,
   0,-791,-784,-764,-747,   0,-786,  44,-795,-790,-785,   0,
-778, 201, 206, 208, 213, 212,-771, 207, 213, 212, 208, 213,
 212,-765, 201, 206, 207, 213, 212,   0,-751, 193, 210, 210,
 193, 217,   1,-741,  40,   2,  58,   2,  41,-748,   1,-741,
   0,-743,  44,-764,-747,-742,   0,-737,  44,   1,-741,-736,
   0,-722, 197, 204, 197, 205, 197, 206, 212,  40,   1,  41,
-764,-747,   0,-717,  44,-735,-721,-716,   0,-710,  40,-691,
-684,  41,-708,-691,-706, 206,-702, 199, 206, 196,-698, 214,
 195, 195,   0,-693,  44,-715,-697,-692,   0,-685,   1,-864,
  46,   1,-864,   0,-680,  44,-691,-684,-679,   0,-670, 197,
 204, 197, 205, 197, 206, 212,-661, 193, 211, 211, 197, 205,
 194, 204, 217,   0,-653, 195, 200, 201, 208,-645,-625,-646,
 197, 196, 199, 197,-619,-604,   0,-626, 193, 210, 210, 193,
 217,   1,-741,  40,   2,  58,   2,-598,  44,   2,  58,   2,
-598,  41,   0,-621,  44,-645,-625,-620,   0,-605, 193, 210,
 210, 193, 217,   1,-741,  40,   2,  58,   2,-598,  41,   0,
-600,  44,-619,-604,-599,   0,-592,  47,  39,   4,-590,  39,
-591,   0,-587,   4,-590,-586,   0,-581,  44,-660,-585,-580,
   0,-577,-572,-573,  39,   4,  39,   0,-567,-566,-560,-551,
-540,   0,-564,  43,-562,  45,-561,   0,-558,   1,-556,   2,
-552,  40,-572,  41,   0,-547,-545,-560,-551,-546,   0,-543,
  42,-541,  47,   0,-535,-533,-560,-551,-540,-534,   0,-531,
  43,-529,  45,   0,-524, 196, 197, 198,-523,   0,-520,  59,
-518,  10,   0
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%UNLESS PAR->P.(',').PAR %THEN P=PAR %AND Q='' %AND R='' %AND TAPE='' %C
   %ELSE %START
 %UNLESS PAR->Q.(',').PAR %THEN Q=PAR %AND R='' %AND TAPE='' %ELSESTART
  %UNLESS PAR->R.(',').TAPE %THEN R='' %AND TAPE=''
 %FINISH
%FINISH
%IF P='' %THEN P='.TT'
%IF Q='' %THEN Q='DCAPLIST'
%IF R='' %THEN R='DCAPFILE'
%IF TAPE='' %THEN TAPE='DCAPTAPE'
DEFINE('STREAM01,'.P)
SELECT INPUT(1)
DEFINE('STREAM02,'.Q.',1000')
SELECT OUTPUT(2)
OUTFILE(R,65536,65536,0,DCAPFAD,J)
%UNLESS J=0 %THEN PRINT STRING('
OUTFILE FAILED') %AND WRITE(J,2) %AND %STOP
PRINT STRING('
            DCAP : DAVID''S CIRCUIT ASSIGNMENT PROGRAM

                    VERSION A, DATED 14/5/79


SOURCE: '.P.'
LISTING: '.Q.'
DATA STRUCTURE FILE: '.R.'
PAPER TAPE FILE: '.TAPE.'


')
S==ARRAY(DCAPFAD+INTEGER(DCAPFAD+4),SF)
SP==S(0)
FIRSTINFO=LASTLINK+5
FILL(S,1,4,LASTLINK)
FILL(S,5,FIRSTINFO-1,-1)
SP=FIRSTINFO
IV(0)=LASTLINK
FILL(IV,1,FIRSTINFO-1,-1)
IVP=FIRSTINFO
DEF=0
FAULTS=0
DUMMY=0   ;! TO MAKE DUMMY CHIP NAMES DIFFERENT
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%CYCLE
 READ LINE
 TP=1
 %CYCLE
  AP=1
  I=COMPARE(-1000)
  SS
  %IF T(TP-1)=NL %THEN %EXIT
 %REPEAT
%REPEAT
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE READ LINE
! LEXICAL PHASE - READ & CLEAN UP NEXT LINE OF TEXT
%ROUTINESPEC STORE(%INTEGER I)
%INTEGER SH,I,FOR
SH=0                                ;! % SHIFT VALUE TO 0
TP=1                                ;! POINTER TO TEXT ARRAY T
FOR=0
%CYCLE
 READ SYMBOL(I)
 PRINT SYMBOL(I)
 %IF I='%' %THEN SH=128 %ELSE %START
  %IF I<'A' %OR I>'Z' %THEN SH=0
  %UNLESS I=' ' %THEN %START                 ;! IGNORE SPACES
   STORE(I)
   %IF I=NL %THEN %START
    %IF TP>2 %THEN %START               ;! IGNORE BLANK LINES
     %IF T(TP-2)='&' %THEN TP=TP-2 %ELSE %START
      %IF FOR<=0 %THEN %RETURN
     %FINISH
    %FINISH %ELSE TP=1
   %FINISH %ELSE %START
    %IF I='[' %THEN FOR=FOR+1
    %IF I=']' %THEN FOR=FOR-1
   %FINISH
  %FINISH
 %FINISH
%REPEAT
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%ROUTINE STORE(%INTEGER I)
! STORE (POSSIBLY) SHIFTED CHAR IN TEXT ARRAY & CHECK LINE NOT TOO LONG
%IF TP>1000 %THEN PRINT STRING('
STATEMENT TOO LONG') %AND %STOP
T(TP)=I+SH                      ;! STORE CHAR IN TEXT ARRAY
TP=TP+1                         ;! MOVE TO NEXT POSITION
%END
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN COMPARE(%INTEGER PSP)
! ANALYSE PHRASE
%INTEGERFNSPEC NAME                   ;! BUILT-IN PHRASE <NAME>
%INTEGERFNSPEC CNST                   ;! BUILT-IN PHRASE <CNST>
%INTEGERFNSPEC LETT                   ;! BUILT-IN PHRASE <LETT>
%INTEGER APP,TPP,AE,N
TPP=TP                           ;! PRESERVE INITIAL TEXT POINTER
APP=AP                           ;! PRESERVE INITIAL ANAL REC PTR
A(AP)=1                          ;! ALTERNATIVE NO
%CYCLE                           ;! FOR EACH ALTERNATIVE
 AE=PS(PSP)
 PSP=PSP+1
 %CYCLE                          ;! FOR EACH ITEM
  %IF PSP=AE %THEN NP(APP)=AP+1 %AND %RESULT=1  ;! SUCCESS
  N=PS(PSP)
  PSP=PSP+1
  %IF N<0 %THEN %START             ;! SUB-PHRASE
   AP=AP+1
   %IF AP>1000 %THEN PRINT STRING('
ANALYSIS RECORD FULL') %AND %STOP
   %IF COMPARE(N)=0 %THEN %EXIT
  %FINISH %ELSE %START
   %IF N=1 %THEN %START
    %IF NAME=0 %THEN %EXIT
   %FINISH %ELSE %START
    %IF N=2 %THEN %START
     %IF CNST=0 %THEN %EXIT
    %FINISH %ELSE %START
     %IF N=3 %THEN %START               ;! <TEXT>
      %WHILE T(TP)#';' %AND T(TP)#NL %THEN TP=TP+1
     %FINISH %ELSE %START
      %IF N=4 %THEN %START
       %IF LETT=0 %THEN %EXIT
      %FINISH %ELSE %START
       %IF N=T(TP) %THEN TP=TP+1 %ELSE %EXIT
      %FINISH
     %FINISH
    %FINISH
   %FINISH
  %FINISH
 %REPEAT
 %IF PS(AE)=0 %THEN %RESULT=0     ;!FAILURE
 PSP=AE
 TP=TPP                           ;! BACKTRACK
 AP=APP
 A(AP)=A(AP)+1
%REPEAT
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%INTEGERFN NAME
! RECOGNISE NAME
%INTEGER CH,I,J,NAM
%UNLESS 'A'<=T(TP)<='Z' %THEN %RESULT=0    ;! FAILURE
AP=AP+1
%IF AP+3>1000 %THEN PRINT STRING('
ANALYSIS RECORD FULL') %AND %STOP
%CYCLE I=0,1,3
 NAM=0
 %CYCLE J=0,1,1
  CH=T(TP)
  %IF 'A'<=CH<='Z' %OR '0'<=CH<='9' %THEN TP=TP+1 %ELSE CH=0
  NAM=NAM<<8!CH
 %REPEAT
 A(AP+I)=NAM
%REPEAT
%WHILE 'A'<=T(TP)<='Z' %OR '0'<=T(TP)<='9' %THEN TP=TP+1 ;! IGNORE EXTRA
NP(AP)=AP+4
AP=AP+3
%RESULT=1                        ;! SUCCESS
%END
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%INTEGERFN CNST
! RECOGNISE INTEGER CONSTANT
%INTEGER I,J
%UNLESS '0'<=T(TP)<='9' %THEN %RESULT=0 ;! NOT A CONSTANT
I=T(TP)
J=0
%WHILE '0'<=I<='9' %THEN %CYCLE
 %IF J<3276 %OR (J=3276 %AND I<='7') %THEN J=10*J+I-'0' %ELSE %RESULT=0
 TP=TP+1
 I=T(TP)                             ;! NEXT CHAR
%REPEAT
AP=AP+1
%IF AP>1000 %THEN PRINT STRING('
ANALYSIS RECORD FULL') %AND %STOP
A(AP)=J                             ;! FILL IN VALUE OF CONSTANT
NP(AP)=AP+1                         ;! NEXT PHRASE
%RESULT=1                           ;! SUCCESS
%END
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%INTEGERFN LETT
%INTEGER I
%UNLESS 'A'<=T(TP)<='Z' %THEN %RESULT=0
I=T(TP)
TP=TP+1
AP=AP+1
%IF AP>1000 %THEN PRINT STRING('
ANALYSIS RECORD FULL') %AND %STOP
A(AP)=I
NP(AP)=AP+1
%RESULT=1
%END
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE SS
%SWITCH SSA(1:7)
%ROUTINESPEC LI
%INTEGERFNSPEC NIS(%INTEGER NAM,SNAM,%SHORTINTEGERARRAYNAME D, %C
  %INTEGER DLP,%SHORTINTEGERNAME DP)
%INTEGERFNSPEC EXPR
%INTEGERFNSPEC IOPARS(%SHORTINTEGERARRAYNAME D, %C
  %SHORTINTEGERNAME DLP,DP)
%ROUTINESPEC ELASDEC(%INTEGER NAM,DIM,L,U)
%INTEGERFNSPEC FINDNAMX(%INTEGER NAM,%SHORTINTEGERARRAYNAME D, %C
  %INTEGER DLP)
%INTEGERFNSPEC FINDELN(%INTEGER N)
%ROUTINESPEC FINDED(%SHORTINTEGERARRAYNAME D,%INTEGER P)
%ROUTINESPEC CHECKTERMS(%INTEGER P)
%ROUTINESPEC CHECKPINS(%INTEGER P)
%ROUTINESPEC GORVCHIP(%INTEGER GORV,%INTEGERNAME CP)
%INTEGERFNSPEC GETLDEF(%INTEGER LDEF,SIZE)
%INTEGERFNSPEC FILLBOARD(%INTEGER FELN)
%ROUTINESPEC GORVCONS(%INTEGER CAP,GORV)
%ROUTINESPEC XGORVCONS(%INTEGER GORV,CP,DCP)
%INTEGERFNSPEC FINDCD(%INTEGER CP)
%INTEGERFNSPEC PUSHDOWN(%INTEGER NAM,TAG,%SHORTINTEGERARRAYNAME D, %C
 %SHORTINTEGERNAME DLP,DP)
%ROUTINESPEC POPUP(%SHORTINTEGERARRAYNAME D,%SHORTINTEGERNAME DLP,DP)
%INTEGERFNSPEC FINDNAME(%INTEGER NAM,%SHORTINTEGERARRAYNAME D, %C
 %INTEGER DLP)
%ROUTINESPEC COPYNAME(%INTEGER NAM,%SHORTINTEGERARRAYNAME D,%INTEGER DP)
%ROUTINESPEC ARR(%ROUTINE ACTION)
%STRING(15)%FNSPEC STRTERM(%INTEGER TERM)
%STRING(63)%FNSPEC STRELT(%INTEGER ELT)
%STRING(31)%FNSPEC STRPIN(%INTEGER NAM,ROW,COL,PIN)
%STRING(63)%FNSPEC STRSP(%INTEGER N)
%STRING(15)%FNSPEC STRINT(%INTEGER N)
%STRING(8)%FNSPEC STRNAME(%SHORTINTEGERARRAYNAME D,%INTEGER DP)
%ROUTINESPEC FAULT(%STRING(255) F)
!%ROUTINESPEC DUMP(%SHORTINTEGERARRAYNAME D,%INTEGER DP)
%ROUTINESPEC WRITE4(%INTEGER N)
%ROUTINESPEC WRITE2(%INTEGER N)
%INTEGER SH,ELAS,DNAM,TERMS,P,PP,SNAM,NISP,NIST,ADPT,NETP,LINK,LEN, %C
  APP,PIN,ELTS,L1,U1,L2,U2,CE,TERM,TERMP,ELT,ELTP,DCP,GNDCP,VCCCP,CP, %C
  CPP,PINP,BDPP,BDPPI,N,CAP,ROW,COL,CAPP,EAP,EAPP,DCPP,LDEF1,LDEF2, %C
  APPP,WIRENO,XYCHECK,XPSN,YPSN,TAPEARRP,TAPEAD,NETCOUNT
%SHORTINTEGER ADPP
%OWNSHORTINTEGERARRAY WLENS(1:41)=0(41)
%STRING(63) STR
%BYTEINTEGERARRAYFORMAT TAPEARRF(0:65519)
%BYTEINTEGERARRAYNAME TAPEARR
%ROUTINESPEC TAPEOUT(%INTEGER N)
->SSA(A(1))
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SSA(1):! <LI>
AP=2
LI
%RETURN
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SSA(2):! <ELAS><DEF>
%IF A(3)=1 %THEN %START    ;! %DEF
 %UNLESS DEF=0 %THEN FAULT('NESTED DEF') %ELSE %START
  %IF A(2)=1 %THEN %START  ;! %ELEMENT
   SP=PUSHDOWN(4,X'15',S,S(1),SP)
   ED==ARRAY(ADDR(S(SP)),SF)
   EDP==ED(5)
   EDP=FIRSTINFO
   FILL(ED,6,EDP-1,-1)
   ED(7)=LASTLINK          ;! I/O DEFS LIST
   AP=8
   ED(6)=IOPARS(ED,ED(7),EDP)
   SP=SP+EDP
   !DUMP(ED,EDP)
  %FINISH %ELSE %START        ;! %ASSEMBLY
   SP=PUSHDOWN(4,X'16',S,S(2),SP)
   DEF=1
   AD==ARRAY(ADDR(S(SP)),SF)
   ADP==AD(5)
   FILL(AD,7,9,LASTLINK)
   FILL(AD,10,FIRSTINFO-1,-1)
   ADP=FIRSTINFO
   AP=8
   AD(6)=IOPARS(AD,AD(7),ADP)
   SH=2*AD(6)            ;! MOVE I/O DEFS UP
   %CYCLE P=ADP-1,-1,FIRSTINFO
    AD(P+SH)=AD(P)
   %REPEAT
   ADP=ADP+SH
   P=7
   %WHILE AD(P)#LASTLINK %THEN AD(P)=AD(P)+SH %AND P=AD(P)
   FILL(AD,FIRSTINFO,FIRSTINFO+SH-1,-1)
   ELNUM=1
  %FINISH
 %FINISH
%FINISH %ELSE %START    ;! DECLARATION
 %UNLESS DEF=1 %THEN FAULT('DECLARATION OUTSIDE ASSEMBLY DEF') %C
   %ELSE %START
  ELAS=A(2)
  DNAM=4
  P=FINDNAME(DNAM,S,S(ELAS))
  %IF P=0 %THEN FAULT(STRNAME(A,DNAM).' NOT A DEF NAME') %ELSE %START
   %IF P=SP %THEN FAULT('RECURSIVE ASSEMBLY DECLARATION') %ELSE %START
    TERMS=S(P+6)
    %IF ELAS=1 %THEN ELTS=1 %ELSE ELTS=S(P+10)
    AP=8
    ARR(ELASDEC)
   %FINISH
  %FINISH
 %FINISH
%FINISH
%RETURN
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SSA(3):! NET LABEL
%UNLESS DEF=1 %THEN FAULT('NET OUTSIDE ASSEMBLY DEF') %AND %RETURN
P=PUSHDOWN(2,4,AD,AD(9),ADP)
AD(P+5)=1
AD(P+6)=0
ADP=P+FIRSTINFO+2
FILL(AD,P+7,ADP-1,-1)
ADPP=ADP
AP=NP(11)             ;! <SNAM>
%IF A(AP)=1 %THEN SNAM=AP+1 %ELSE SNAM=0
I=NIS(7,SNAM,AD,AD(8),ADPP)
%IF ADPP=ADP %THEN %RETURN
NISP=AD(ADP)
NIST=AD(ADP+1)
PP=NISP+FIRSTINFO+2*(NIST-1)
ADPP=AD(PP)
ADPT=AD(PP+1)
%IF ADPT=0 %THEN %START
 %IF SNAM=0 %THEN STR='' %ELSE STR='.'.STRNAME(A,SNAM)
 FAULT(STRNAME(A,7).STR.' ALREADY SET AS NOT CONNECTED')
%FINISH
%IF ADPT<=0 %THEN AD(ADP-2)=NISP %AND AD(ADP-1)=NIST %ELSE %C
  AD(ADP-2)=ADPP %AND AD(ADP-1)=ADPT
AD(PP)=P
AD(PP+1)=1
%RETURN
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SSA(4):! CHIP DEF
%UNLESS DEF=0 %THEN FAULT('NESTED DEF') %AND %RETURN
SP=PUSHDOWN(2,X'17',S,S(3),SP)
AD==ARRAY(ADDR(S(SP)),SF)
ADP==AD(5)
ADP=FIRSTINFO
FILL(AD,6,ADP-1,-1)
AD(8)=LASTLINK
ELAS=1
ELNUM=1
AP=6
%CYCLE             ;! FOR EACH <CFP>
 APP=NP(AP)
 DNAM=AP+1
 P=FINDNAME(DNAM,S,S(1))
 %IF P=0 %THEN FAULT(STRNAME(A,DNAM).' NOT A DEF NAME') %ELSE %START
  TERMS=S(P+6)
  ELTS=1
  AP=DNAM+4
  ARR(ELASDEC)
 %FINISH
 AP=APP+1
 %IF A(APP)=2 %THEN %EXIT
%REPEAT
%CYCLE PIN=1,1,99    ;! FOR EACH <CT>
 APP=NP(AP)
 %IF A(AP)<=2 %THEN %START     ;! NAMED TERMINAL
  %CYCLE
   ADPP=ADP
   APPP=AP
   NIST=NIS(AP+2,NP(AP+6),AD,AD(8),ADPP)
   %UNLESS ADPP=ADP %THEN %START
    P=AD(ADP)+FIRSTINFO+2*(AD(ADP+1)-1)
    %UNLESS AD(P)<0 %THEN FAULT('TERMINAL HAS TWO PIN POSITIONS')
    AD(P)=0
    AD(P+1)=PIN
   %FINISH
   %IF A(APPP)=2 %THEN %EXIT
   AP=NP(APPP+1)
   %IF A(AP)=2 %THEN %EXIT
  %REPEAT
 %FINISH %ELSE %START
  %IF A(AP)=4 %THEN %START
   %UNLESS AD(9)<0 %THEN FAULT('%GND PIN SET TWICE')
   AD(9)=PIN
  %FINISH %ELSE %START
   %IF A(AP)=5 %THEN %START
    %UNLESS AD(10)<0 %THEN FAULT('%VCC PIN SET TWICE')
    AD(10)=PIN
   %FINISH
  %FINISH
 %FINISH
 AP=APP+1
 %IF A(APP)=2 %THEN %EXIT
%REPEAT
%UNLESS PIN&1=0 %THEN FAULT(STRINT(PIN).' PIN CHIP ?')
AD(6)=PIN
AD(7)=ELNUM-1
LINK=AD(8)    ;! ELEMENTS LIST
%WHILE LINK#LASTLINK %CYCLE
 P=LINK+1
 %IF AD(P+4)&X'20'=0 %THEN FINDED(AD,P) %AND CHECKPINS(P) %ELSE %START
 FINDED(AD,P+8)
  LEN=AD(P+7)
  %CYCLE PP=P+8,LEN,P+8+LEN*(AD(P+6)-AD(P+5))
   CHECKPINS(PP)
  %REPEAT
 %FINISH
 LINK=AD(LINK)
%REPEAT
SP=SP+ADP
!DUMP(AD,ADP)
%RETURN
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SSA(5):! BOARD
%UNLESS DEF=0 %THEN FAULT('NESTED DEF') %AND %RETURN
SP=PUSHDOWN(2,X'18',S,S(4),SP)
DEF=2
BD==ARRAY(ADDR(S(SP)),SF)
BDP==BD(5)
FILL(BD,6,FIRSTINFO-1,-1)
FILL(BD,8,10,LASTLINK)
BDP=FIRSTINFO+4
AP=6
%CYCLE         ;! FOR EACH <BFP>
 APP=NP(AP)
 CE=A(AP)
 AP=AP+1
 %CYCLE        ;! FOR EACH <AR?>
  APPP=NP(AP)
  P=NP(AP+5)
  L1=A(P)
  U1=A(P+1)
  %IF L1>U1 %THEN FAULT('BOUNDS INSIDE OUT') %AND L1=U1
  LEN=U1-L1+1
  LDEF1=P+2
  P=NP(LDEF1)
  %IF CE=1 %THEN %START
   L2=A(P)
   U2=A(P+1)
   %IF L2>U2 %THEN FAULT('BOUNDS INSIDE OUT') %AND L2=U2
   LEN=LEN*(U2-L2+1)
   LDEF2=P+2
  %FINISH
  %CYCLE       ;! FOR EACH <NAME>
   P=PUSHDOWN(AP+1,X'20'!(CE+8),BD,BD(CE+7),BDP)
   BD(P+5)=L1
   BD(P+6)=U1
   %IF CE=1 %THEN BD(P+7)=L2 %AND BD(P+8)=U2
   BDP=P+FIRSTINFO+LEN
   FILL(BD,P+11-2*CE,BDP-1,-1)
   %IF A(LDEF1)=1 %THEN BD(P+11-2*CE)=GETLDEF(LDEF1,U1-L1+1)
   %IF CE=1 %AND A(LDEF2)=1 %THEN BD(P+10)=GETLDEF(LDEF2,U2-L2+1)
   AP=AP+5
   %IF A(AP)=2 %THEN %EXIT
  %REPEAT
  AP=APPP+1
  %IF A(APPP)=2 %THEN %EXIT
 %REPEAT
 AP=APP+1
 %IF A(APP)=2 %THEN %EXIT
%REPEAT
COPYNAME(AP,BD,FIRSTINFO)
P=FINDNAME(AP,S,S(2))
%IF P=0 %THEN FAULT(STRNAME(A,AP).' NOT A DEF NAME') %AND DEF=0 %C
  %ELSE %START
 AD==ARRAY(ADDR(S(P)),SF)
 BD(6)=BDP
 BDP=BDP+2*AD(6)    ;! TERMINALS ARRAY
 FILL(BD,BD(6),BDP-1,-1)
 BD(7)=BDP
 BDP=BDP+2*AD(10)   ;! ELEMENTS ARRAY
 FILL(BD,BD(7),BDP-1,-1)
%FINISH
%RETURN
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SSA(6):! %END
%IF A(2)=2 %THEN %START
 %UNLESS DEF=0 %THEN FAULT('%END OUT OF PLACE')
 INTEGER(DCAPFAD)=2*SP+INTEGER(DCAPFAD+4)
 PRINT STRING('

'.STRINT(FAULTS).' WARNINGS
')
 !DUMP(S,SP)
 %STOP
%FINISH
%IF DEF=0 %THEN FAULT('%ENDDEF OUTOF PLACE') %AND %RETURN
%IF DEF=1 %THEN %START    ;! ASSEMBLY DEF
 NETP=0
 ED==AD
 CHECKTERMS(0)
 LINK=AD(8)    ;! ELEMENTS & ASSEMBLIES LIST
 %WHILE LINK#LASTLINK %CYCLE
  P=LINK+1
  %IF AD(P+4)&X'20'=0 %THEN FINDED(AD,P) %AND CHECKTERMS(P) %ELSE %START
   FINDED(AD,P+8)
   LEN=AD(P+7)
   %CYCLE PP=P+8,LEN,P+8+LEN*(AD(P+6)-AD(P+5))
    CHECKTERMS(PP)
   %REPEAT
  %FINISH
  LINK=AD(LINK)
 %REPEAT
 %IF ELNUM=1 %THEN FAULT('NO ELEMENTS IN ASSEMBLY ?')
 AD(10)=ELNUM-1
 SP=SP+ADP
 !DUMP(AD,ADP)
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%FINISH %ELSE %START    ;! BOARD DEF
 TERMP=BD(6)
 %CYCLE TERM=1,1,AD(6)
  %IF BD(TERMP)<0 %THEN ED==AD %AND FAULT('ASSEMBLY DEF TERMINAL '. %C
    STRTERM(TERM).' NOT ASSIGNED')
  TERMP=TERMP+2
 %REPEAT
 ELTP=BD(7)
 %CYCLE ELT=1,1,AD(10)
  %IF BD(ELTP)<0 %THEN ED==AD %AND FAULT('ELEMENT '. %C
    STRELT(ELT).' NOT ASSIGNED')
  ELTP=ELTP+2
 %REPEAT
 GORVCHIP(M'%GND',GNDCP)
 GORVCHIP(M'%VCC',VCCCP)
 ED==AD
 DCP=FILLBOARD(1)
 LINK=BD(10)      ;! REMOVE DUMMY CHIPS
 %WHILE LINK+1#DCP %CYCLE
  CP=LINK+1
  PP=CP+FIRSTINFO
  %CYCLE PIN=1,1,BD(CP+5)
   %IF BD(PP)>0 %THEN %START
    CPP=CP
    PINP=PIN
    %CYCLE
     P=CPP+FIRSTINFO+2*(PINP-1)
     CPP=BD(P)
     PINP=BD(P+1)
     %IF CPP=CP %AND PINP=PIN %THEN %EXIT
    %REPEAT
    BD(P)=BD(PP)
    BD(P+1)=BD(PP+1)
   %FINISH
   PP=PP+2
  %REPEAT
  LINK=BD(LINK)
  POPUP(BD,BD(10),BDP)
 %REPEAT
 BDPP=BDP      ;! ALLOCATE WRAP-COUNT & NET NUMBER HOLES
! LINK=BD(10)
 %WHILE LINK#LASTLINK %CYCLE  ;! FOR EACH CHIP
  CP=LINK+1
  BD(CP+13)=BDPP
  BDPP=BDPP+BD(CP+5)
  BD(CP+14)=BDPP
  BDPP=BDPP+BD(CP+5)
  LINK=BD(LINK)
 %REPEAT
 FILL(BD,BDP,BDPP-1,0)
 NEWPAGE
 LINK=BD(8)
 %WHILE LINK#LASTLINK %CYCLE    ;! FOR EACH CHIP ARRAY
  CAP=LINK+1
  PRINT STRING('


CHIP ARRAY  '.STRNAME(BD,CAP).'


CHIP ASSIGNMENTS


')
  CAPP=CAP+FIRSTINFO
  %CYCLE ROW=BD(CAP+5),1,BD(CAP+6)
   %CYCLE COL=BD(CAP+7),1,BD(CAP+8)
    PRINT STRING(STRPIN(CAP,ROW,COL,-1))
    CP=BD(CAPP)
    %IF CP<=0 %THEN PRINT STRING('UNOCCUPIED') %ELSE %C
      PRINT STRING(STRNAME(BD,CP+6))
    NEWLINE
    CAPP=CAPP+1
   %REPEAT
  %REPEAT
  GORVCONS(CAP,1)
  GORVCONS(CAP,2)
  LINK=BD(LINK)
 %REPEAT
 XGORVCONS(1,GNDCP,DCP)
 XGORVCONS(2,VCCCP,DCP)
 NEWPAGE
 PRINT STRING('

MAIN CONNECTIONS

 WIRE                                            TOP OR  WIRE-
NUMBER   FROM                   TO               BOTTOM  LENGTH

')
 OUTFILE(TAPE,65536,65536,0,TAPEAD,I)
 %UNLESS I=0 %THEN PRINT STRING('
OUTFILE FAILED') %AND WRITE(I,2) %AND %STOP
 TAPEARR==ARRAY(TAPEAD+INTEGER(TAPEAD+4),TAPEARRF)
 TAPEARRP=0
 TAPEOUT('S')
 TAPEOUT(13)
 TAPEOUT('M')
 TAPEOUT('6')
 TAPEOUT('9')
 TAPEOUT(13)
 TAPEOUT('T')
 XPSN=0
 YPSN=0
 WIRENO=1
  XYCHECK=0
 NETCOUNT=1
 BDPPI=BDPP
 LINK=BD(10)
 %WHILE LINK#LASTLINK %CYCLE
  CP=LINK+1
  PP=CP+FIRSTINFO
  %CYCLE PIN=1,1,BD(CP+5)
   %IF BD(PP)>0 %AND BD(BD(CP+13)+PIN-1)=0 %THEN %START
    CPP=CP
    PINP=PIN
    BDPP=BDPPI
    %UNTIL CPP=CP %AND PINP=PIN %CYCLE
     %IF BD(CPP+10)=0 %THEN %START
      %IF CPP=DCP %THEN %START
       P=BD(6)+2*(PINP-1)
       %IF BD(P)>0 %THEN %START
        BD(BDPP)=BD(P)        ;! EDGE NAME
        BD(BDPP+1)=BD(P+1)
        BD(BDPP+2)=-1
        BD(BDPP+3)=-1
        BD(BDPP+4)=-1
        BD(BDPP+5)=BD(CPP+13)+PINP-1
        BDPP=BDPP+6
       %FINISH %ELSE BD(BD(CPP+13)+PINP-1)=-1
      %FINISH
     %FINISH %ELSE %START
      %IF BD(CPP+10)>0 %THEN %START
       BD(BDPP)=BD(CPP+10)
       BD(BDPP+1)=BD(CPP+11)
       BD(BDPP+2)=BD(CPP+12)
       BD(BDPP+3)=PINP
       BD(BDPP+4)=BD(CPP+5)    ;! NO OF PINS IN CHIP
       BD(BDPP+5)=BD(CPP+13)+PINP-1
       BDPP=BDPP+6
      %FINISH
     %FINISH
     BD(BD(CPP+14)+PINP-1)=NETCOUNT
     P=CPP+FIRSTINFO+2*(PINP-1)
     CPP=BD(P)
     PINP=BD(P+1)
    %REPEAT
    N=(BDPP-BDPPI)//6
    %IF N>1 %THEN %START
     %BEGIN    ;! TRAVELLING SALESMAN
     %DYNAMICROUTINESPEC POSITION(%STRING(8) NAM,%INTEGER R,C,P,PINS, %C
       %REALNAME X,Y)
     %DYNAMICREALFNSPEC DISTANCE(%STRING(8) NAM1,%INTEGER R1,C1,P1, %C
       PINS1,%REAL X1,Y1,%STRING(8) NAM2,%INTEGER R2,C2,P2,PINS2, %C
       %REAL X2,Y2)
     %REALARRAY D,DD(1:N,1:N),X,Y(1:N)
     %INTEGERARRAY RT(1:2*N)
     %INTEGER E,I,J,IP,JP,LD,RD,LP,RP,LN,RN,WLI,XWK,YWK
     %INTEGER X1,Y1,X2,Y2,XX1,YY1,XX2,YY2
     %REAL M,LM,RM,LDD,RDD,DIJ
     %STRING(63) STRI,STRJ
     %STRING(1) TB
     IP=BDPPI
     %CYCLE I=1,1,N
      POSITION(STRNAME(BD,BD(IP)),BD(IP+1),BD(IP+2),BD(IP+3),BD(IP+4),%C
        X(I),Y(I))
      IP=IP+6
     %REPEAT
     IP=BDPPI
     %CYCLE I=1,1,N-1
      JP=IP+6
      %CYCLE J=I+1,1,N
       DIJ=DISTANCE(STRNAME(BD,BD(IP)),BD(IP+1),BD(IP+2),BD(IP+3), %C
         BD(IP+4),X(I),Y(I),STRNAME(BD,BD(JP)),BD(JP+1),BD(JP+2), %C
         BD(JP+3),BD(JP+4),X(J),Y(J))
       %IF DIJ<0.099 %THEN FAULT('DISTANCE BETWEEN '. %C
        STRPIN(BD(IP),BD(IP+1),BD(IP+2),BD(IP+3)).' AND '. %C
        STRPIN(BD(JP),BD(JP+1),BD(JP+2),BD(JP+3)).' LESS THAN 0.1" ?')%C
        %AND DIJ=0.1
       D(I,J)=DIJ
       D(J,I)=DIJ
       DD(I,J)=DIJ
       DD(J,I)=DIJ
       JP=JP+6
      %REPEAT
      IP=IP+6
     %REPEAT
     %CYCLE I=1,1,N
      DD(I,I)=99
     %REPEAT
     M=99
     %CYCLE I=1,1,N-1
      %CYCLE J=I+1,1,N
       %IF DD(I,J)<M %THEN LD=I %AND RD=J %AND M=DD(I,J)
      %REPEAT
     %REPEAT
     LP=N
     RT(LP)=LD
     RP=N+1
     RT(RP)=RD
     %CYCLE I=1,1,N
      DD(I,LD)=99
      DD(I,RD)=99
     %REPEAT
     %WHILE RP-LP+1<N %CYCLE
      LM=99
      %CYCLE I=1,1,N
       %IF DD(LD,I)<LM %THEN LN=I %AND LM=DD(LD,I)
      %REPEAT
      RM=99
      %CYCLE I=1,1,N
       %IF DD(RD,I)<RM %THEN RN=I %AND RM=DD(RD,I)
      %REPEAT
      %IF LM<RM %THEN LP=LP-1 %AND RT(LP)=LN %AND LD=LN %AND E=LN %C
                %ELSE RP=RP+1 %AND RT(RP)=RN %AND RD=RN %AND E=RN
      %CYCLE I=1,1,N
       DD(I,E)=99
      %REPEAT
     %REPEAT
     %IF N>3 %THEN %START
      %CYCLE J=1,1,N-3
       LD=RT(LP)
       LDD=D(LD,RT(LP+1))
       LM=0
       %CYCLE I=LP+2,1,RP-1
        M=LDD+D(RT(I),RT(I+1))-D(LD,RT(I))-D(LD,RT(I+1))
        %IF M>LM %THEN LM=M %AND LN=I
       %REPEAT
       %IF LM=0 %THEN %EXIT
       %CYCLE I=LP,1,LN-1
        RT(I)=RT(I+1)
       %REPEAT
       RT(LN)=LD
      %REPEAT
      %CYCLE J=1,1,N-3
       RD=RT(RP)
       RDD=D(RD,RT(RP-1))
       RM=0
       %CYCLE I=RP-2,-1,LP+1
        M=RDD+D(RT(I),RT(I-1))-D(RD,RT(I))-D(RD,RT(I-1))
        %IF M>RM %THEN RM=M %AND RN=I
       %REPEAT
       %IF RM=0 %THEN %EXIT
       %CYCLE I=RP,-1,RN+1
        RT(I)=RT(I-1)
       %REPEAT
       RT(RN)=RD
      %REPEAT
     %FINISH
     PRINT STRING('

  NET '.STRINT(NETCOUNT).'

')
     NETCOUNT=NETCOUNT+1
     TB='B'
     IP=BDPPI+6*(RT(LP)-1)
     STRI=STRPIN(BD(IP),BD(IP+1),BD(IP+2),BD(IP+3))
     %CYCLE J=LP+1,1,RP
      JP=BDPPI+6*(RT(J)-1)
      STRJ=STRPIN(BD(JP),BD(JP+1),BD(JP+2),BD(JP+3))
      WRITE(WIRENO+J-LP-1,4)
      PRINT STRING('    '.STRI.STRSP(19-LENGTH(STRI)). %C
        '->  '.STRJ.STRSP(21-LENGTH(STRJ)).TB)
      WLI=INTPT(2*(D(RT(J-1),RT(J))+0.99))
      PRINT(WLI/2,4,1)
      %IF WLI>40 %THEN WLI=41
      WLENS(WLI)=WLENS(WLI)+1
      NEWLINES(2)
      BD(BD(IP+5))=BD(BD(IP+5))+1    ;! WIRE WRAP COUNT
      BD(BD(JP+5))=BD(BD(JP+5))+1
      IP=JP
      STRI=STRJ
      %IF TB='B' %THEN TB='T' %ELSE TB='B'
     %REPEAT
     I=LP
     %WHILE I<=RP %CYCLE
      %IF I<RP %THEN %START
       WLI=INTPT(2*(D(RT(I),RT(I+1))+0.99))
       TAPEOUT(13)
       TAPEOUT('N')
       WRITE4(WIRENO+I-LP)
       TAPEOUT('M')
       WRITE2(WLI-2)
       XX1=INT(200*X(RT(I)))
       YY1=INT(200*Y(RT(I)))
       XX2=INT(200*X(RT(I+1)))
       YY2=INT(200*Y(RT(I+1)))
       %IF XX1<XX2 %OR (XX1=XX2 %AND YY1>YY2) %THEN X1=XX1 %AND %C
         Y1=YY1 %AND X2=XX2 %AND Y2=YY2 %ELSE X1=XX2 %AND Y1=YY2 %AND %C
         X2=XX1 %AND Y2=YY1
       TAPEOUT('X')
       XWK=XPSN
       XPSN=X1
       %IF XPSN>=XWK %THEN TAPEOUT('+') %AND WRITE4(XPSN-XWK) %C
         %ELSE TAPEOUT('-') %AND WRITE4(XWK-XPSN)
       TAPEOUT('Y')
       YWK=YPSN
       YPSN=Y1
       %IF YPSN>=YWK %THEN TAPEOUT('+') %AND WRITE4(YPSN-YWK) %C
         %ELSE TAPEOUT('-') %AND WRITE4(YWK-YPSN)
       TAPEOUT(13)
       TAPEOUT('T')
       TAPEOUT(13)
       TAPEOUT('M')
       TAPEOUT('6')
       TAPEOUT('8')
       TAPEOUT('X')
       XWK=XPSN
       XPSN=X2
       %IF XPSN>=XWK %THEN TAPEOUT('+') %AND WRITE4(XPSN-XWK) %C
         %ELSE TAPEOUT('-') %AND WRITE4(XWK-XPSN)
       TAPEOUT('Y')
       YWK=YPSN
       YPSN=Y2
       %IF YPSN>=YWK %THEN TAPEOUT('+') %AND WRITE4(YPSN-YWK) %C
         %ELSE TAPEOUT('-') %AND WRITE4(YWK-YPSN)
       TAPEOUT(13)
       TAPEOUT('T')
       XYCHECK=XYCHECK+1
       %IF XYCHECK=25 %THEN %START
        XYCHECK=0
        TAPEOUT(13)
        TAPEOUT('N')
        WRITE4(0)
        TAPEOUT('M')
        TAPEOUT('6')
        TAPEOUT('9')
        TAPEOUT('X')
        %IF XPSN<=0 %THEN TAPEOUT('+') %AND WRITE4(-XPSN) %ELSE %C
          TAPEOUT('-') %AND WRITE4(XPSN)
        XPSN=0
        TAPEOUT('Y')
        %IF YPSN<=0 %THEN TAPEOUT('+') %AND WRITE4(-YPSN) %ELSE %C
          TAPEOUT('-') %AND WRITE4(YPSN)
        YPSN=0
        TAPEOUT(13)
        TAPEOUT('T')
       %FINISH
      %FINISH
      %IF I>LP %THEN %START
       WLI=INTPT(2*(D(RT(I-1),RT(I))+0.99))
       TAPEOUT(13)
       TAPEOUT('N')
       WRITE4(WIRENO+I-LP-1)
       TAPEOUT('M')
       WRITE2(WLI-2)
       XX1=INT(200*X(RT(I)))
       YY1=INT(200*Y(RT(I)))
       XX2=INT(200*X(RT(I-1)))
       YY2=INT(200*Y(RT(I-1)))
       %IF XX1<XX2 %OR (XX1=XX2 %AND YY1>YY2) %THEN X1=XX1 %AND %C
         Y1=YY1 %AND X2=XX2 %AND Y2=YY2 %ELSE X1=XX2 %AND Y1=YY2 %C
         %AND X2=XX1 %AND Y2=YY1
       TAPEOUT('X')
       XWK=XPSN
       XPSN=X1
       %IF XPSN>=XWK %THEN TAPEOUT('+') %AND WRITE4(XPSN-XWK) %C
         %ELSE TAPEOUT('-') %AND WRITE4(XWK-XPSN)
       TAPEOUT('Y')
       YWK=YPSN
       YPSN=Y1
       %IF YPSN>=YWK %THEN TAPEOUT('+') %AND WRITE4(YPSN-YWK) %C
         %ELSE TAPEOUT('-') %AND WRITE4(YWK-YPSN)
       TAPEOUT(13)
       TAPEOUT('T')
       TAPEOUT(13)
       TAPEOUT('M')
       TAPEOUT('6')
       TAPEOUT('8')
       TAPEOUT('X')
       XWK=XPSN
       XPSN=X2
       %IF XPSN>=XWK %THEN TAPEOUT('+') %AND WRITE4(XPSN-XWK) %C
         %ELSE TAPEOUT('-') %AND WRITE4(XWK-XPSN)
       TAPEOUT('Y')
       YWK=YPSN
       YPSN=Y2
       %IF YPSN>=YWK %THEN TAPEOUT('+') %AND WRITE4(YPSN-YWK) %C
         %ELSE TAPEOUT('-') %AND WRITE4(YWK-YPSN)
       TAPEOUT(13)
       TAPEOUT('T')
       XYCHECK=XYCHECK+1
       %IF XYCHECK=25 %THEN %START
        XYCHECK=0
        TAPEOUT(13)
        TAPEOUT('N')
        WRITE4(0)
        TAPEOUT('M')
        TAPEOUT('6')
        TAPEOUT('9')
        TAPEOUT('X')
        %IF XPSN<=0 %THEN TAPEOUT('+') %AND WRITE4(-XPSN) %ELSE %C
          TAPEOUT('-') %AND WRITE4(XPSN)
        XPSN=0
        TAPEOUT('Y')
        %IF YPSN<=0 %THEN TAPEOUT('+') %AND WRITE4(-YPSN) %ELSE %C
          TAPEOUT('-') %AND WRITE4(YPSN)
        YPSN=0
        TAPEOUT(13)
        TAPEOUT('T')
       %FINISH
      %FINISH
      I=I+2
     %REPEAT
     WIRENO=WIRENO+RP-LP
     %END
    %FINISH
   %FINISH
   PP=PP+2
  %REPEAT
  LINK=BD(LINK)
 %REPEAT
 TAPEOUT(13)
 TAPEOUT('R')
 TAPEOUT(13)
 INTEGER(TAPEAD)=TAPEARRP+INTEGER(TAPEAD+4)
 NEWPAGE
 PRINT STRING('

WIRE-LENGTHS REQUIRED (EXCL. %GND & %VCC CONNECTIONS)

LENGTH  NUMBER

')
 %CYCLE N=1,1,40
  %IF WLENS(N)>0 %THEN %START
   PRINT(N/2,2,1)
   WRITE(WLENS(N),6)
   NEWLINE
  %FINISH
 %REPEAT
 %IF WLENS(41)>0 %THEN PRINT STRING('
PLUS '.STRINT(WLENS(41)).' LENGTHS OVER 20.0


NUMBER OF WIRES = '.STRINT(WIRENO-1).'

')
 NEWPAGE
 PRINT STRING('

WIRE-WRAPS PER PIN CHECK LIST
')
 LINK=BD(8)    ;! CHIP ARRAY LIST
 %WHILE LINK#LASTLINK %CYCLE
  CAP=LINK+1
  PRINT STRING('

CHIP ARRAY '.STRNAME(BD,CAP).'

')
  CAPP=CAP+FIRSTINFO
  %CYCLE ROW=BD(CAP+5),1,BD(CAP+6)
   %CYCLE COL=BD(CAP+7),1,BD(CAP+8)
    PRINT STRING(STRPIN(CAP,ROW,COL,-1))
    CP=BD(CAPP)
    %IF CP<=0 %THEN PRINT STRING('UNOCCUPIED') %ELSE %START
     CPP=BD(CP+13)
     %CYCLE PINP=CPP,1,CPP+BD(CP+5)-1
      %IF BD(PINP)#0 %THEN %START
       %CYCLE PINP=CPP,1,CPP+BD(CP+5)-1
        WRITE(BD(PINP),2)
       %REPEAT
       ->CONS
      %FINISH
     %REPEAT
     PRINT STRING('NO WRAPS')
CONS:%FINISH
    NEWLINES(2)
    CAPP=CAPP+1
   %REPEAT
  %REPEAT
  LINK=BD(LINK)
 %REPEAT
 DCPP=BD(DCP+13)
 LINK=BD(9)    ;! EDGE ARRAY LIST
 %WHILE LINK#LASTLINK %CYCLE
  EAP=LINK+1
  PRINT STRING('

EDGE ARRAY '.STRNAME(BD,EAP).'
')
   EAPP=BD(EAP+7)
   %IF EAPP>0 %THEN %START
    %CYCLE ROW=BD(EAP+5),1,BD(EAP+6)
     PRINT STRING('  '.STRING(ADDR(BD(EAPP))))
     EAPP=EAPP+1
    %REPEAT
    NEWLINE
   %FINISH
  EAPP=EAP+FIRSTINFO
  %CYCLE ROW=BD(EAP+5),1,BD(EAP+6)
   %IF BD(EAPP)<=0 %THEN WRITE(0,2) %ELSE WRITE(BD(DCPP+BD(EAPP)-1),2)
   EAPP=EAPP+1
  %REPEAT
  LINK=BD(LINK)
 %REPEAT
 %BEGIN
 %INTEGERARRAY STRELP,STRCHP,NETNUM(0:2047)
 %STRING(63) NAM,STRNET
 %INTEGER WKP,FLAG,P,PP,LINK,ASSTP,ASSTPP,I,J,CHPTR,PINP,CAP,CAPP, %C
  ROW,COL,GND,VCC,EAP,EAPP
 %ROUTINESPEC STRQSORT(%INTEGERARRAYNAME P,Q,R,%INTEGER A,B)
 %ROUTINESPEC QSORT(%INTEGERARRAYNAME P,Q,R,%INTEGER A,B)
 %INTEGERFNSPEC STORESTR(%STRING(63) S)
 %ROUTINESPEC ELCH(%SHORTINTEGERARRAYNAME AD,%STRING(63) ASS, %C
   %INTEGER FELN)
 OUTFILE('DCAPWORK',65536,65536,0,WKP,FLAG)
 %IF FLAG#0 %THEN PRINT STRING('
DCAPWORK OUTFILE FAILED') %AND WRITE(FLAG,2) %AND %STOP
 WKP=WKP+INTEGER(WKP+4)
 PP=0
 ELCH(AD,'',1)
 LINK=AD(7)    ;! ASS. TERM. DEFS
 %WHILE LINK#LASTLINK %CYCLE
  ASSTP=LINK+1
  NAM=STRNAME(AD,ASSTP)
  %IF AD(ASSTP+4)&X'20'=0 %THEN %START
   J=BD(BD(DCP+14)+AD(ASSTP+6)-1)
   %IF J#0 %THEN %START
    STRELP(PP)=STORESTR(NAM)
    P=BD(6)+2*(AD(ASSTP+6)-1)
    STRCHP(PP)=STORESTR(STRPIN(BD(P),BD(P+1),-1,-1))
    NETNUM(PP)=J
    PP=PP+1
   %FINISH
  %FINISH %ELSE %START
   ASSTPP=ASSTP+8
   %CYCLE I=AD(ASSTP+5),1,AD(ASSTP+6)
    J=BD(BD(DCP+14)+AD(ASSTPP+6)-1)
    %IF J#0 %THEN %START
     STRELP(PP)=STORESTR(NAM.'('.STRINT(I).')')
     P=BD(6)+2*(AD(ASSTPP+6)-1)
     STRCHP(PP)=STORESTR(STRPIN(BD(P),BD(P+1),-1,-1))
     NETNUM(PP)=J
     PP=PP+1
    %FINISH
    ASSTPP=ASSTPP+AD(ASSTP+7)
   %REPEAT
  %FINISH
  LINK=AD(LINK)
 %REPEAT
 STRQSORT(STRELP,STRCHP,NETNUM,0,PP-1)
 NEWPAGE
 PRINT STRING('
NAMES : NET NUMBERS : PIN POSITIONS

')
 %CYCLE I=0,1,PP-1
  STRNET=STRINT(NETNUM(I))
  %IF STRNET='0' %THEN STRNET=' '
  PRINT STRING(STRING(STRELP(I)).STRSP(15-LENGTH(STRING(STRELP(I)))).%C
  ':  '.STRNET.STRSP(5-LENGTH(STRNET)).':  '.STRING(STRCHP(I)).'
')
 %REPEAT
 QSORT(NETNUM,STRELP,STRCHP,0,PP-1)
 NEWPAGE
 PRINT STRING('
NET NUMBERS : NAMES : PIN POSITIONS

')
 %CYCLE I=0,1,PP-1
  %IF I=0 %OR NETNUM(I)#NETNUM(I-1) %THEN PRINT STRING('
  NET '.STRINT(NETNUM(I)).'

')
  PRINT STRING(STRING(STRELP(I)).STRSP(15-LENGTH(STRING(STRELP(I)))). %C
    ':  '.STRING(STRCHP(I)).'
')
 %REPEAT
 LINK=BD(8)
 %WHILE LINK#LASTLINK %CYCLE    ;! FOR EACH CHIP ARRAY
  CAP=LINK+1
  CAPP=CAP+FIRSTINFO
  %CYCLE ROW=BD(CAP+5),1,BD(CAP+6)
   %CYCLE COL=BD(CAP+7),1,BD(CAP+8)
    %IF BD(CAPP)<=0 %THEN %START
     STRCHP(PP)=STORESTR(STRPIN(CAP,ROW,COL,-1).'UNOCCUPIED')
     STRELP(PP)=STORESTR('')
     NETNUM(PP)=0
     PP=PP+1
    %FINISH %ELSE %START
     CHPTR=BD(CAPP)
     P=FINDCD(CHPTR)
     GND=CD(9)
     VCC=CD(10)
     PINP=CHPTR+FIRSTINFO+1
     %CYCLE I=1,1,BD(CHPTR+5)
      %IF I=GND %THEN %START
       STRCHP(PP)=STORESTR(STRPIN(CAP,ROW,COL,I))
       STRELP(PP)=STORESTR('%GND')
       NETNUM(PP)=0
       PP=PP+1
      %FINISH %ELSE %START
       %IF I=VCC %THEN %START
        STRCHP(PP)=STORESTR(STRPIN(CAP,ROW,COL,I))
        STRELP(PP)=STORESTR('%VCC')
        NETNUM(PP)=0
        PP=PP+1
       %FINISH
      %FINISH
      PINP=PINP+2
     %REPEAT
    %FINISH
    CAPP=CAPP+1
   %REPEAT
  %REPEAT
  LINK=BD(LINK)
 %REPEAT
 STRQSORT(STRCHP,STRELP,NETNUM,0,PP-1)
 NEWPAGE
 PRINT STRING('
PIN POSITIONS : NAMES : NET NUMBERS

')
 %CYCLE I=0,1,PP-1
  STRNET=STRINT(NETNUM(I))
  %IF STRNET='0' %THEN STRNET=' '
  PRINT STRING(STRING(STRCHP(I)).STRSP(22-LENGTH(STRING(STRCHP(I)))). %C
   ':  '.STRING(STRELP(I)).STRSP(15-LENGTH(STRING(STRELP(I)))).':  '. %C
    STRNET.'
')
 %REPEAT
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 %ROUTINE STRQSORT(%INTEGERARRAYNAME P,Q,R,%INTEGER A,B)
 %INTEGER L,U,PP,QP,RP
 %IF A>=B %THEN %RETURN
 L=A-1
 U=B
 PP=P(U)
 QP=Q(U)
 RP=R(U)
 %CYCLE
 UP: L=L+1
  %IF L=U %THEN %EXIT
  %IF STRING(P(L))<=STRING(PP) %THEN ->UP
  P(U)=P(L)
  Q(U)=Q(L)
 R(U)=R(L)
 DOWN: U=U-1
  %IF U=L %THEN %EXIT
 %IF STRING(P(U))>=STRING(PP) %THEN ->DOWN
  P(L)=P(U)
  Q(L)=Q(U)
 R(L)=R(U)
 %REPEAT
 P(U)=PP
 Q(U)=QP
 R(U)=RP
 STRQSORT(P,Q,R,A,L-1)
 STRQSORT(P,Q,R,U+1,B)
 %END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 %ROUTINE QSORT(%INTEGERARRAYNAME P,Q,R,%INTEGER A,B)
 %INTEGER L,U,PP,QP,RP
 %IF A>=B %THEN %RETURN
 L=A-1
 U=B
 PP=P(U)
 QP=Q(U)
 RP=R(U)
 %CYCLE
 UP: L=L+1
  %IF L=U %THEN %EXIT
  %IF P(L)<=PP %THEN ->UP
  P(U)=P(L)
  Q(U)=Q(L)
  R(U)=R(L)
 DOWN: U=U-1
  %IF U=L %THEN %EXIT
  %IF P(U)>=PP %THEN ->DOWN
  P(L)=P(U)
  Q(L)=Q(U)
  R(L)=R(U)
 %REPEAT
 P(U)=PP
 Q(U)=QP
 R(U)=RP
 QSORT(P,Q,R,A,L-1)
 QSORT(P,Q,R,U+1,B)
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 %INTEGERFN STORESTR(%STRING(63) S)
 %INTEGER I
 I=WKP
 STRING(WKP)=S
 WKP=WKP+LENGTH(S)+1
 %RESULT=I
 %END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 %ROUTINE ELCH(%SHORTINTEGERARRAYNAME AD,%STRING(63) ASS,%INTEGER FELN)
 %INTEGER LINK,ELAS,I,ELP
 %STRING(63) NAM
 %ROUTINESPEC TERMS(%SHORTINTEGERARRAYNAME ED,%STRING(63) ELNAM, %C
   %INTEGER ELP)
 %SHORTINTEGERARRAYNAME EDD
 LINK=AD(8)
 %WHILE LINK#LASTLINK %CYCLE    ;! FOR EACH EL. & ASS.
  ELAS=LINK+1
  NAM=STRNAME(AD,ELAS)
  %IF AD(ELAS+4)&15=5 %THEN %START    ;! ELEMENTS
   %IF AD(ELAS+4)&X'20'=0 %THEN %START
    FINDED(AD,ELAS)
    TERMS(ED,ASS.NAM,ELAS)
   %FINISH %ELSE %START
    ELP=ELAS+8
    FINDED(AD,ELP)
    EDD==ED
    %CYCLE I=AD(ELAS+5),1,AD(ELAS+6)
     TERMS(EDD,ASS.NAM.'('.STRINT(I).')',ELP)
     ELP=ELP+AD(ELAS+7)
    %REPEAT
   %FINISH
  %FINISH %ELSE %START    ;! ASSEMBLIES
   %IF AD(ELAS+4)&X'20'=0 %THEN %START
    FINDED(AD,ELAS)
    ELCH(ED,ASS.NAM.'.',FELN+AD(ELAS+10)-1)
   %FINISH %ELSE %START
    ELP=ELAS+8
    FINDED(AD,ELP)
    EDD==ED
    %CYCLE I=AD(ELAS+5),1,AD(ELAS+6)
     ELCH(EDD,ASS.NAM.'('.STRINT(I).').',FELN+AD(ELP+10)-1)
     ELP=ELP+AD(ELAS+7)
    %REPEAT
   %FINISH
  %FINISH
  LINK=AD(LINK)
 %REPEAT
 %RETURN
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE TERMS(%SHORTINTEGERARRAYNAME ED,%STRING(63) ELNAM, %C
  %INTEGER ELP)
 %INTEGER ELN,CHPTR,ELINCH,P,CDPTR,LINK,EDPTR,I,J,IOTP,PIN
 %STRING(63) NAM
 ELN=FELN+AD(ELP+10)-1
 P=BD(7)+2*(ELN-1)
 CHPTR=BD(P)
 %IF CHPTR<=0 %THEN STRELP(PP)=STORESTR(ELNAM) %AND STRCHP(PP)= %C
   STORESTR('NOT ASSIGNED') %AND NETNUM(PP)=0 %AND PP=PP+1 %AND %RETURN
 ELINCH=BD(P+1)
 P=FINDCD(CHPTR)
 LINK=CD(8)
 %WHILE LINK#LASTLINK %CYCLE    ;! FIND EL IN CHIP
  CDPTR=LINK+1
  %IF CD(CDPTR+4)=5 %THEN %START
   %IF CD(CDPTR+10)=ELINCH %THEN %EXIT
  %FINISH %ELSE %START
   %IF 0<=ELINCH-CD(CDPTR+18)<=CD(CDPTR+6)-CD(CDPTR+5) %THEN %C
    CDPTR=CDPTR+8+CD(CDPTR+7)*(ELINCH-CD(CDPTR+18)) %AND %EXIT
  %FINISH
  LINK=CD(LINK)
 %REPEAT
 LINK=ED(7)
 %WHILE LINK#LASTLINK %CYCLE    ;! FOR EACH TERMINAL
  EDPTR=LINK+1
  NAM=STRNAME(ED,EDPTR)
  %IF ED(EDPTR+4)&X'20'=0 %THEN %START
   PIN=CD(CDPTR+FIRSTINFO+2*ED(EDPTR+6)-1)
   J=BD(BD(CHPTR+14)+PIN-1)
   %IF J#0 %THEN %START
    STRELP(PP)=STORESTR(ELNAM.'.'.NAM)
    STRCHP(PP)=STORESTR(STRPIN(BD(CHPTR+10),BD(CHPTR+11), %C
     BD(CHPTR+12),PIN))
    NETNUM(PP)=J
    PP=PP+1
   %FINISH
  %FINISH %ELSE %START
   IOTP=EDPTR+8
   %CYCLE I=ED(EDPTR+5),1,ED(EDPTR+6)
    PIN=CD(CDPTR+FIRSTINFO+2*ED(IOTP+6)-1)
    J=BD(BD(CHPTR+14)+PIN-1)
    %IF J#0 %THEN %START
     STRELP(PP)=STORESTR(ELNAM.'.'.NAM.'('.STRINT(I).')')
     STRCHP(PP)=STORESTR(STRPIN(BD(CHPTR+10),BD(CHPTR+11), %C
      BD(CHPTR+12),PIN))
     NETNUM(PP)=J
     PP=PP+1
    %FINISH
    IOTP=IOTP+ED(EDPTR+7)
   %REPEAT
  %FINISH
  LINK=ED(LINK)
 %REPEAT
 %END
 %END
 %END
 NEWPAGE
 SP=SP+BDP
 !DUMP(BD,BDP)
%FINISH
DEF=0
%RETURN
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SSA(7):! <TEXT>
FAULT('SYNTAX ?')
%RETURN
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE LI
%ROUTINESPEC CONNECT
%ROUTINESPEC GORVNET(%INTEGER GORV)
%ROUTINESPEC FOR
%ROUTINESPEC CHIPASSIGN
%INTEGERFNSPEC FINDELT(%INTEGER NAM,%INTEGERNAME N)
%ROUTINESPEC EDGEASSIGN
%INTEGERFNSPEC LETTINDX(%INTEGER P,L,U)
%SHORTINTEGER ADPP
%SWITCH LIA(1:5)
AP=AP+1
->LIA(A(AP-1))
LIA(1):CONNECT
%RETURN
LIA(2):FOR
%RETURN
LIA(3):CHIPASSIGN
%RETURN
LIA(4):EDGEASSIGN
%RETURN
LIA(5):%RETURN
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%ROUTINE CONNECT
%INTEGER NAM,P,PP,APP,IO,SNAM,LP,RP,TT,PP2,TT2,I
%INTEGERARRAY CON(1:2)
%STRING(31) STR1,STR2
%OWNSTRING(31)%ARRAY FMESS(1:2)=' NOT AN INPUT TERMINAL',
  ' NOT AN OUTPUT TERMINAL'
%UNLESS DEF=1 %THEN FAULT('CONNECTION OUTSIDE ASSEMBLY DEF') %C
  %AND %RETURN
ADPP=ADP
%CYCLE IO=2,-1,1
 CON(IO)=A(AP)
 AP=AP+1
 %IF CON(IO)=1 %THEN %START
  %CYCLE         ;! FOR EACH <NIS>
   APP=NP(AP)
   NAM=AP+1
   AP=NP(AP+5)
   %IF A(AP)=1 %THEN SNAM=AP+1 %ELSE SNAM=0
   %IF NIS(NAM,SNAM,AD,AD(8),ADPP)&IO=0 %THEN %START
    STR1=STRNAME(A,NAM)
    %IF A(NAM+4)=1 %THEN AP=NAM+5 %AND STR1=STR1.'('.STRINT(EXPR).')'
    %IF SNAM=0 %THEN STR2='' %AND I=3-IO %ELSE %START
     STR2='.'.STRNAME(A,SNAM)
     %IF A(SNAM+4)=1 %THEN AP=SNAM+5 %AND STR2=STR2.'('.STRINT(EXPR).')'
     I=IO
    %FINISH
    FAULT(STR1.STR2.FMESS(I))
   %FINISH
   AP=APP+1
   %IF A(APP)=2 %THEN %EXIT
  %REPEAT
 %FINISH
%REPEAT
%IF CON(1)>1 %AND CON(2)>1 %THEN FAULT('SYNTAX ?')
%IF ADPP=ADP %THEN %RETURN
%IF CON(1)=2 %OR CON(2)=2 %THEN %START  ;! NOT CONNECTED LIST
 %CYCLE P=ADP,2,ADPP-2
  PP=AD(P)+FIRSTINFO+2*(AD(P+1)-1)
  %IF AD(PP+1)>0 %THEN FAULT('TERMINAL ALREADY SET AS CONNECTED') %C
    %ELSE AD(PP)=0 %AND AD(PP+1)=0
 %REPEAT
%FINISH %ELSE %START
 %IF CON(1)=3 %OR CON(2)=3 %THEN GORVNET(M'%GND')
 %IF CON(1)=4 %OR CON(2)=4 %THEN GORVNET(M'%VCC')
 %CYCLE P=ADP,2,ADPP-2  ;! MAKE INTO CIRCULAR LISTS
  PP=AD(P)+FIRSTINFO+2*(AD(P+1)-1)
  %IF AD(PP+1)=0 %THEN FAULT('TERMINAL ALREADY SET AS NOT CONNECTED')
  %IF AD(PP+1)<=0 %THEN AD(PP)=AD(P) %AND AD(PP+1)=AD(P+1)
 %REPEAT
 %IF ADPP>ADP+2 %THEN %START  ;! CONNECT UP LISTS
  %CYCLE P=ADP,2,ADPP-4
   PP=AD(P)    ;! CHECK ALREADY CONNECTED
   TT=AD(P+1)
   PP2=AD(P+2)
   TT2=AD(P+3)
   %UNTIL PP=AD(P) %AND TT=AD(P+1) %CYCLE
    %IF PP=PP2 %AND TT=TT2%THEN FAULT('TERMINALS ALREADY CONNECTED')%C
      %AND %EXIT
    LP=PP+FIRSTINFO+2*(TT-1)
    PP=AD(LP)
    TT=AD(LP+1)
   %REPEAT
   %UNLESS PP=PP2 %AND TT=TT2 %THEN %START
    LP=PP+FIRSTINFO+2*(TT-1)
    PP=AD(LP)
    TT=AD(LP+1)
    RP=PP2+FIRSTINFO+2*(TT2-1)
    AD(LP)=AD(RP)
    AD(LP+1)=AD(RP+1)
    AD(RP)=PP
    AD(RP+1)=TT
   %FINISH
  %REPEAT
 %FINISH
%FINISH
%END
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%ROUTINE GORVNET(%INTEGER GORV)
%INTEGER P,SH
A(1001)=GORV>>16
A(1002)=GORV&X'FFFF'
A(1003)=0
A(1004)=0
P=FINDNAME(1001,AD,AD(9))
%IF P=0 %THEN %START
 SH=FIRSTINFO+3    ;! ROOM FOR A NET(+LINK)
 %CYCLE P=ADPP-1,-1,ADP  ;! MOVE <TLST> DATA UP
  AD(P+SH)=AD(P)
 %REPEAT
 ADPP=ADPP+SH
 P=PUSHDOWN(1001,4,AD,AD(9),ADP)
 AD(P+5)=1
 ADP=P+FIRSTINFO+2
 FILL(AD,P+6,ADP-1,-1)
%FINISH
AD(ADPP)=P    ;! ADD %GND OR %VCC NET TO <TLST> DATA
AD(ADPP+1)=1
ADPP=ADPP+2
%END
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%ROUTINE FOR
%INTEGER NAM,F,I,L,N,M,IVPP,API,APP
NAM=AP
AP=AP+4
F=EXPR              ;! INITIAL VALUE
I=EXPR              ;! INCREMENT
%IF I=0 %THEN FAULT('%FOR LOOP ('.STRNAME(A,NAM).') INCREMENT ZERO') %C
  %AND %RETURN
L=EXPR              ;! FINAL VALUE
N=(L-F)//I
%IF N<0 %OR N*I#L-F %THEN FAULT('INVALID %FOR LOOP ('.STRNAME(A,NAM) %C
  .')') %AND %RETURN
%IF IVP>66 %THEN FAULT('%FOR NESTING TOO DEEP') %AND %RETURN
IVPP=PUSHDOWN(NAM,0,IV,IV(0),IVP)
IVP=IVP+2
API=AP
%CYCLE M=F,I,L
 IV(IVPP+5)=M
 AP=API
 %CYCLE                  ;! FOR EACH <LIN>
  APP=NP(AP)             ;! ON <RLIN>
  %IF A(AP)=1 %THEN AP=AP+1 %AND LI
  AP=APP+2
  %IF A(APP)=2 %THEN %EXIT
 %REPEAT
%REPEAT
POPUP(IV,IV(0),IVP)
%END
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%ROUTINE CHIPASSIGN
%INTEGER P,L1,U1,L2,U2,C1,C2,I,J,APP,CP,N,PP,NAM
%OWNINTEGER CHIP=1
%UNLESS DEF=2 %THEN FAULT('OUTSIDE BOARD DEF') %AND %RETURN
NAM=AP
P=FINDNAME(NAM,BD,BD(8))
%IF P=0 %THEN FAULT(STRNAME(A,NAM).' UNKNOWN') %AND %RETURN
L1=BD(P+5)
U1=BD(P+6)
L2=BD(P+7)
U2=BD(P+8)
AP=AP+4
%IF A(AP)=1 %THEN AP=AP+1 %AND C1=EXPR %ELSE C1=LETTINDX(BD(P+9),L1,U1)
%IF A(AP)=1 %THEN AP=AP+1 %AND C2=EXPR %ELSE C2=LETTINDX(BD(P+10),L2,U2)
%IF C1<0 %OR C2<0 %THEN %RETURN
%UNLESS L1<=C1<=U1 %AND L2<=C2<=U2 %THEN FAULT('BOUNDS EXCEEDED : '. %C
  STRNAME(A,NAM).'('.STRINT(C1).','.STRINT(C2).')') %AND %RETURN
I=P+FIRSTINFO+(C1-L1)*(U2-L2+1)+(C2-L2)
%UNLESS BD(I)<0 %THEN FAULT('CHIP POSITION '.STRNAME(A,NAM).'('. %C
  STRINT(C1).','.STRINT(C2).') ALREADY ASSIGNED') %AND %RETURN
PP=FINDNAME(AP,S,S(3))
%IF PP=0 %THEN FAULT(STRNAME(A,AP).' NOT A DEF NAME') %AND %RETURN
CD==ARRAY(ADDR(S(PP)),SF)
A(1001)=M'%C'
A(1002)=M'HI'
A(1003)='P'<<8
A(1004)=CHIP    ;! TO AVOID DUPLICATE NAME
CHIP=CHIP+1
CP=PUSHDOWN(1001,7,BD,BD(10),BDP)
BD(I)=CP
BD(CP+5)=CD(6)
COPYNAME(AP,BD,CP+6)
BD(CP+10)=P
BD(CP+11)=C1
BD(CP+12)=C2
BDP=CP+FIRSTINFO+2*CD(6)
FILL(BD,CP+13,BDP-1,-1)
AP=AP+4
%CYCLE I=1,1,99    ;! FOR EACH <ELT>
 APP=NP(AP)
 %IF A(AP)=1 %THEN %START    ;! NOT %N
  AP=AP+1
  N=0
  ED==AD
  P=FINDELT(AP,N)
  PP=FINDELN(I)
  %UNLESS P=0 %OR PP=0 %THEN %START
   %UNLESS ED(P+6)=CD(PP+6)%AND ED(P+7)=CD(PP+7) %AND ED(P+8)=CD(PP+8)%C
     %AND ED(P+9)=CD(PP+9) %THEN FAULT(STRNAME(A,AP).' INVALID TYPE') %C
     %ELSE %START
    J=BD(7)+2*(N-1)
    %UNLESS BD(J)<0 %THEN FAULT(STRNAME(A,AP).' ALREADY ASSIGNED') %C
      %ELSE BD(J)=CP %AND BD(J+1)=I
   %FINISH
  %FINISH
 %FINISH
 AP=APP+1
 %IF A(APP)=2 %THEN %EXIT
%REPEAT
%IF I#CD(7) %THEN FAULT(STRINT(I).' ELEMENTS ASSIGNED')
%END
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%INTEGERFN FINDELT(%INTEGER NAM,%INTEGERNAME N)
%INTEGER P,TAG,ENAM
P=FINDNAMX(NAM,ED,ED(8))
%IF P=0 %THEN FAULT(STRNAME(A,NAM).' UNKNOWN') %AND %RESULT=0
TAG=ED(P+4)
ENAM=NP(NAM+4)
N=N+ED(P+10)
%IF TAG=5 %THEN %START    ;! ELEMENT
 %IF A(ENAM)=1 %THEN FAULT('SUB-NAME INVALID FOR '.STRNAME(A,NAM))
 %RESULT=P
%FINISH %ELSE %START    ;! ASSEMBLY
 %IF A(ENAM)#1 %THEN FAULT('SUB-NAME MISSING FOR '.STRNAME(A,NAM)) %C
   %AND %RESULT=0
 FINDED(ED,P)
 N=N-1
 %RESULT=FINDELT(ENAM+1,N)
%FINISH
%END
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%ROUTINE EDGEASSIGN
%INTEGER P,L,U,C,I,J,PP,TERM,NAM
%UNLESS DEF=2 %THEN FAULT('OUTSIDE BOARD DEF') %AND %RETURN
NAM=AP
P=FINDNAME(NAM,BD,BD(9))
%IF P=0 %THEN FAULT(STRNAME(A,NAM).' UNKNOWN') %AND %RETURN
L=BD(P+5)
U=BD(P+6)
AP=AP+4
%IF A(AP)=1 %THEN AP=AP+1 %AND C=EXPR %ELSE C=LETTINDX(BD(P+7),L,U)
%IF C<0 %THEN %RETURN
%UNLESS L<=C<=U %THEN FAULT('BOUND EXCEEDED : '.STRNAME(A,NAM).'('. %C
  STRINT(C).')') %AND %RETURN
I=P+FIRSTINFO+C-L
%UNLESS BD(I)<0 %THEN FAULT('EDGE POSITION '.STRNAME(A,NAM).'('. %C
  STRINT(C).') ALREADY ASSIGNED') %AND %RETURN
PP=FINDNAMX(AP,AD,AD(7))
%IF PP=0 %THEN FAULT(STRNAME(A,AP).' UNKNOWN') %AND %RETURN
TERM=AD(PP+6)
J=BD(6)+2*(TERM-1)
%UNLESS BD(J)<0 %THEN %START
 %IF AD(PP+5)<0 %THEN STR='' %ELSE STR='('.STRINT(AD(PP+5)).')'
 FAULT(STRNAME(A,AP).STR.' ALREADY ASSIGNED')
 %RETURN
%FINISH
BD(I)=TERM
BD(J)=P
BD(J+1)=C
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN LETTINDX(%INTEGER P,L,U)
%INTEGER C,LETT,I
C=-1
LETT=A(AP+1)
AP=AP+2
%CYCLE I=L,1,U
 %IF BD(P)&X'FF'=LETT %THEN C=I %AND %EXIT
 P=P+1
%REPEAT
%IF C<0 %THEN FAULT('INVALID LETTER INDEX') %AND %RESULT=-1
%RESULT=I
%END
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN NIS(%INTEGER NAM,SNAM,%SHORTINTEGERARRAYNAME D, %C
  %INTEGER DLP,%SHORTINTEGERNAME DP)
%INTEGER P,PP,TERM,TAG
%IF SNAM#0 %THEN %START
 P=FINDNAMX(NAM,D,DLP)    ;! LOOK FOR EL. OR ASS. NAME
 %IF P=0 %THEN FAULT(STRNAME(A,NAM).' UNKNOWN') %AND %RESULT=3
 FINDED(AD,P)
 PP=FINDNAMX(SNAM,ED,ED(7))
 %IF PP=0 %THEN FAULT('SUB-NAME '.STRNAME(A,SNAM).' UNKNOWN') %C
   %AND %RESULT=3
 TERM=ED(PP+6)
 TAG=ED(PP+4)
%FINISH %ELSE %START    ;! NO SUB-NAME
 P=FINDNAMX(NAM,D,D(7))    ;! TRY ASSEMBLY DEF TERMINALS
 %IF P=0 %THEN %START
  P=FINDNAME(NAM,D,D(9))   ;! TRY NETS
  %IF P=0 %THEN FAULT(STRNAME(A,NAM).' UNKNOWN') %AND %RESULT=3
  TERM=1
  TAG=3
 %FINISH %ELSE %START
  TERM=D(P+6)
  TAG=3-D(P+4)        ;! INPUTS <-> OUTPUTS
  %IF TAG=0 %THEN TAG=3
  P=0
 %FINISH
%FINISH
D(DP)=P
D(DP+1)=TERM
DP=DP+2
%RESULT=TAG
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN EXPR
%INTEGER MDACC,MDOP,PMACC,PMOP,OPD,NAM,IVPP
PMACC=0
%IF A(AP+1)=2 %THEN PMOP=2 %ELSE PMOP=1
AP=AP+3                 ;! ON <OPD>+1
%CYCLE
 MDACC=1
 MDOP=1
 %CYCLE
  %IF A(AP-1)=1 %THEN %START
   NAM=AP
   AP=AP+4
   IVPP=FINDNAME(NAM,IV,IV(0))
   %IF IVPP=0 %THEN FAULT('INDEX VARIABLE '.STRNAME(A,NAM). %C
     ' UNDEFINED') %AND OPD=1 %ELSE OPD=IV(IVPP+5)
  %FINISH %ELSE %START
   %IF A(AP-1)=2 %THEN OPD=A(AP) %AND AP=AP+1 %ELSE OPD=EXPR
  %FINISH
  %IF MDOP=1 %THEN MDACC=MDACC*OPD %ELSE %START
   %IF OPD=0 %THEN FAULT('DIVISION BY ZERO') %ELSE MDACC=MDACC//OPD
  %FINISH
  %IF A(AP)=2 %THEN %EXIT          ;! <ROD1>
  MDOP=A(AP+1)
  AP=AP+3
 %REPEAT
 %IF PMOP=1 %THEN PMACC=PMACC+MDACC %ELSE PMACC=PMACC-MDACC
 %IF A(AP+1)=2 %THEN %EXIT         ;! <ROD2>
 PMOP=A(AP+2)
 AP=AP+4
%REPEAT
AP=AP+2
%RESULT=PMACC
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN IOPARS(%SHORTINTEGERARRAYNAME D,%SHORTINTEGERNAME DLP,DP)
%ROUTINESPEC IOP(%INTEGER NAM,DIM,L,U)
%INTEGER TERM,APP,I
TERM=1
%CYCLE         ;! FOR EACH <IOP>
 APP=NP(AP)
 I=A(AP+1)     ;! <IO>
 AP=AP+2
 ARR(IOP)
 AP=APP+1
 %IF A(APP)=2 %THEN %RESULT=TERM-1
%REPEAT
%ROUTINE IOP(%INTEGER NAM,DIM,L,U)
%INTEGER P,Q
P=PUSHDOWN(NAM,DIM<<5!I,D,DLP,DP)
%IF DIM=0 %THEN %START
 D(DP)=-1
 D(DP+1)=TERM
 DP=P+11
 FILL(D,P+7,DP-1,-1)
 TERM=TERM+1
%FINISH %ELSE %START
 D(DP)=L
 D(DP+1)=U
 D(DP+2)=11
 DP=DP+3
 %CYCLE Q=L,1,U
  P=DP
  DP=DP+11
  COPYNAME(NAM,D,P)
  D(P+4)=I
  D(P+5)=Q
  D(P+6)=TERM
  FILL(D,P+7,DP-1,-1)
  TERM=TERM+1
 %REPEAT
%FINISH
%END
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE ELASDEC(%INTEGER NAM,DIM,L,U)
%INTEGER P,Q,LEN
P=PUSHDOWN(NAM,DIM<<5!(ELAS+4),AD,AD(8),ADP)
%IF DIM=0 %THEN %START
 ADP=P+FIRSTINFO+2*TERMS
 FILL(AD,P+5,ADP-1,-1)
 COPYNAME(DNAM,AD,P+6)
 AD(P+10)=ELNUM
 ELNUM=ELNUM+ELTS
%FINISH %ELSE %START
 AD(ADP)=L
 AD(ADP+1)=U
 LEN=FIRSTINFO+2*TERMS
 AD(ADP+2)=LEN
 ADP=ADP+3
 %CYCLE Q=L,1,U
  P=ADP
  ADP=ADP+LEN
  COPYNAME(NAM,AD,P)
  AD(P+4)=ELAS+4
  AD(P+5)=Q
  COPYNAME(DNAM,AD,P+6)
  AD(P+10)=ELNUM
  FILL(AD,P+11,ADP-1,-1)
  ELNUM=ELNUM+ELTS
 %REPEAT
%FINISH
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN FINDNAMX(%INTEGER NAM,%SHORTINTEGERARRAYNAME D, %C
  %INTEGER DLP)
%INTEGER P,TAG,I,L,U,LEN
P=FINDNAME(NAM,D,DLP)
%IF P=0 %THEN %RESULT=0
TAG=D(P+4)
%IF TAG&X'20'=0 %THEN %START
 %IF A(NAM+4)=1 %THEN FAULT('INDEX PRESENT AFTER '.STRNAME(A,NAM))
%FINISH %ELSE %START
 %IF A(NAM+4)=2 %THEN FAULT('INDEX MISSING AFTER '.STRNAME(A,NAM). %C
   ' (ZERO ASSUMED)') %AND I=0 %ELSE AP=NAM+5 %AND I=EXPR
 L=D(P+5)
 U=D(P+6)
 LEN=D(P+7)
 %UNLESS L<=I<=U %THEN FAULT('BOUND EXCEEDED : '.STRNAME(A,NAM).'('. %C
   STRINT(I).')') %AND I=L
 P=P+8+LEN*(I-L)
%FINISH
%RESULT=P
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN FINDELN(%INTEGER N)
%INTEGER CDLP,CDP,TAG,L,U,LEN,FELN
%IF N>CD(7) %THEN %RESULT=0
CDLP=CD(8)
%WHILE CDLP#LASTLINK %CYCLE
 CDP=CDLP+1
 TAG=CD(CDP+4)
 %IF TAG&X'20'=0 %THEN %START
  %IF CD(CDP+10)=N %THEN %RESULT=CDP
 %FINISH %ELSE %START
  L=CD(CDP+5)
  U=CD(CDP+6)
  LEN=CD(CDP+7)
  FELN=CD(CDP+18)    ;! NO OF FIRST ELEMENT
  %IF FELN<=N<=FELN+U-L %THEN %RESULT=CDP+8+LEN*(N-FELN)
 %FINISH
 CDLP=CD(CDLP)
%REPEAT
FAULT('ELEMENT NOT FOUND - DISASTER')
%MONITORSTOP
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE FINDED(%SHORTINTEGERARRAYNAME D,%INTEGER DP)
%INTEGER P
A(1001)=D(DP+6)
A(1002)=D(DP+7)
A(1003)=D(DP+8)
A(1004)=D(DP+9)
P=FINDNAME(1001,S,S(D(DP+4)-4))
%IF P=0 %THEN FAULT('DEF NOT FOUND - DISASTER') %AND %MONITORSTOP
ED==ARRAY(ADDR(S(P)),SF)
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE CHECKTERMS(%INTEGER P)
%INTEGER TERM,PP,TT,PT,PPT,NETS,I
%STRING(255) S,T
PT=P+FIRSTINFO
S=''
%CYCLE TERM=1,1,ED(6)
 %IF AD(PT)<0 %THEN %START    ;! CONNECTION UNSPECIFIED
  T=' '.STRTERM(TERM)
  %IF LENGTH(S)+LENGTH(T)>255 %THEN FAULT(S) %AND S=''
  %IF S='' %THEN %START
   %IF P=0 %THEN S='ASSEMBLY DEF' %ELSE %START
    %IF AD(P+4)=5 %THEN S='ELEMENT ' %ELSE S='ASSEMBLY '
    S=S.STRNAME(AD,P)
    I=AD(P+5)
    %IF I>=0 %THEN S=S.'('.STRINT(I).')'
   %FINISH
   S=S.' TERMINAL NOT CONNECTED :'
  %FINISH
  S=S.T
 %FINISH %ELSE %START
  %IF AD(PT+1)>0 %THEN %START    ;! NOT NO CONNECTION
   NETS=0
   PP=P
   TT=TERM
   %UNTIL PP=P %AND TT=TERM %CYCLE
    %IF AD(PP+4)=4 %AND AD(PP+6)=0 %THEN %START
     %IF NETS=0 %THEN NETS=1 %ELSE AD(PP+6)=1
    %FINISH
    PPT=PP+FIRSTINFO+2*(TT-1)
    PP=AD(PPT)
    TT=AD(PPT+1)
   %REPEAT
   %IF NETS=0 %THEN %START
    %IF NETP=0 %THEN %START    ;! NO %NET YET
     A(1001)=M'%N'
     A(1002)=M'ET'
     A(1003)=0
     A(1004)=0
     NETP=PUSHDOWN(1001,4,AD,AD(9),ADP)
     AD(NETP+5)=0
     AD(NETP+6)=0
     ADP=NETP+FIRSTINFO
     FILL(AD,NETP+7,ADP-1,-1)
    %FINISH
    AD(ADP)=AD(PT)    ;! INSERT %NET
    AD(ADP+1)=AD(PT+1)
    ADP=ADP+2
    AD(NETP+5)=AD(NETP+5)+1
    AD(PT)=NETP
    AD(PT+1)=AD(NETP+5)
   %FINISH
  %FINISH
 %FINISH
 PT=PT+2
%REPEAT
%IF S#'' %THEN FAULT(S)
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE CHECKPINS(%INTEGER P)
%INTEGER TERM,PT,I
%STRING(63) S
PT=P+FIRSTINFO
%CYCLE TERM=1,1,ED(6)
 %IF AD(PT)<0 %THEN %START
  I=AD(P+5)
  %IF I>=0 %THEN S='('.STRINT(I).')' %ELSE S=''
  FAULT('ELEMENT TERMINAL '.STRNAME(AD,P).S.'.'.STRTERM(TERM). %C
    ' HAS NO PIN SPECIFIED')
 %FINISH
 PT=PT+2
%REPEAT
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE GORVCHIP(%INTEGER GORV,%INTEGERNAME CP)
A(1001)=GORV>>16
A(1002)=GORV&X'FFFF'
A(1003)=0
A(1004)=0
CP=PUSHDOWN(1001,7,BD,BD(10),BDP)
BD(CP+5)=1
BDP=CP+FIRSTINFO+2
FILL(BD,CP+6,BDP-1,-1)
BD(CP+10)=0
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN GETLDEF(%INTEGER LDEF,SIZE)
%INTEGER BDPP,LETT,I
BDPP=BDP
%CYCLE           ;! FOR EACH <LETT>
 LETT=A(LDEF+1)
 %IF BDP>BDPP %THEN %START
  %CYCLE I=BDPP,1,BDP-1
   %IF LETT=BD(I) %THEN FAULT('DUPLICATE IN LETTER DEFINITIONS')
  %REPEAT
 %FINISH
 BD(BDP)=X'100'!LETT       ;! IN STRING FORMAT
 BDP=BDP+1
 LDEF=LDEF+2
 %IF A(LDEF)=2 %THEN %EXIT
%REPEAT
%IF BDP-BDPP=SIZE %THEN %RESULT=BDPP
FAULT('WRONG NUMBER OF LETTERS IN DEFINITION')
BDP=BDPP
%RESULT=-1
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN FILLBOARD(%INTEGER FELN)
%INTEGER LINK,P,LEN,I,L,U,DCP,CP,PIN,BDPP,PP,TT,PP2,TT2,LP,RP,TERM,PPT
%ROUTINESPEC ELAS(%INTEGER P)
A(1001)=M'%D'    ;! CREATE DUMMY CHIP
A(1002)=M'UM'
A(1003)=M'MY'
A(1004)=DUMMY
DUMMY=DUMMY+1
DCP=PUSHDOWN(1001,7,BD,BD(10),BDP)
BD(DCP+5)=ED(6)
BDP=DCP+FIRSTINFO+2*ED(6)
FILL(BD,DCP+6,BDP-1,-1)
BD(DCP+10)=0
LINK=ED(8)
%WHILE LINK#LASTLINK %CYCLE
 P=LINK+1
 %IF ED(P+4)&X'20'=0 %THEN ELAS(P) %ELSE %START
  L=ED(P+5)
  U=ED(P+6)
  LEN=ED(P+7)
  P=P+8
  %CYCLE I=L,1,U
   ELAS(P)
   P=P+LEN
  %REPEAT
 %FINISH
 LINK=ED(LINK)
%REPEAT
LINK=ED(9)
%WHILE LINK#LASTLINK %CYCLE    ;! FOR EACH NET NAME
 P=LINK+1
 %IF ED(P+6)=0 %THEN %START    ;! NOT DUPLICATE NET
  %CYCLE TERM=1,1,ED(P+5)      ;! FOR EACH NET
   BDPP=BDP
   PP=P
   TT=TERM
   %UNTIL PP=P %AND TT=TERM %CYCLE  ;! FOR EACH TERMINAL IN NET
    %IF PP=0 %THEN %START      ;! ASSEMBLY DEF TERMINAL
     BD(BDPP)=DCP              ;! DUMMY CHIP PTR
     BD(BDPP+1)=TT
     BDPP=BDPP+2
    %FINISH %ELSE %START
     %IF ED(PP+4)=6 %THEN %START  ;! ASSEMBLY
      BD(BDPP)=ED(PP+11)
      BD(BDPP+1)=TT
      BDPP=BDPP+2
     %FINISH %ELSE %START
      %IF ED(PP+4)=5 %THEN %START  ;! ELEMENT
       CP=BD(BD(7)+2*(FELN+ED(PP+10)-2))
       %IF CP>0 %THEN %START
        CD==ARRAY(ADDR(S(BD(CP+13))),SF)
        %IF ED(PP+11)>0 %THEN %START
         PIN=CD(ED(PP+11)+FIRSTINFO+2*TT-1)
         %IF PIN>0 %THEN %START
          BD(BDPP)=CP
          BD(BDPP+1)=PIN
          BDPP=BDPP+2
         %FINISH
        %FINISH
       %FINISH
      %FINISH %ELSE %START
       %IF ED(PP+4)=4 %THEN %START    ;! NET
        %IF ED(PP)=M'%G' %AND ED(PP+1)=M'ND' %THEN %START
         BD(BDPP)=GNDCP
         BD(BDPP+1)=1
         BDPP=BDPP+2
        %FINISH %ELSE %START
         %IF ED(PP)=M'%V' %AND ED(PP+1)=M'CC' %THEN %START
          BD(BDPP)=VCCCP
          BD(BDPP+1)=1
          BDPP=BDPP+2
         %FINISH
        %FINISH
       %FINISH
      %FINISH
     %FINISH
    %FINISH
    PPT=PP+FIRSTINFO+2*(TT-1)
    PP=ED(PPT)
    TT=ED(PPT+1)
   %REPEAT
   %IF BDPP>BDP %THEN %START
    %CYCLE I=BDP,2,BDPP-2
     PP=BD(I)+FIRSTINFO+2*(BD(I+1)-1)
     %IF BD(PP)<0 %THEN BD(PP)=BD(I) %AND BD(PP+1)=BD(I+1)
    %REPEAT
    %IF BDPP>BDP+2 %THEN %START
     %CYCLE I=BDP,2,BDPP-4
      PP=BD(I)
      TT=BD(I+1)
      PP2=BD(I+2)
      TT2=BD(I+3)
      %UNTIL PP=BD(I) %AND TT=BD(I+1) %CYCLE
       %IF PP=PP2 %AND TT=TT2 %THEN %EXIT
       LP=PP+FIRSTINFO+2*(TT-1)
       PP=BD(LP)
       TT=BD(LP+1)
      %REPEAT
      %UNLESS PP=PP2 %AND TT=TT2 %THEN %START
       LP=PP+FIRSTINFO+2*(TT-1)
       PP=BD(LP)
       TT=BD(LP+1)
       RP=PP2+FIRSTINFO+2*(TT2-1)
       BD(LP)=BD(RP)
       BD(LP+1)=BD(RP+1)
       BD(RP)=PP
       BD(RP+1)=TT
      %FINISH
     %REPEAT
    %FINISH
   %FINISH
  %REPEAT
 %FINISH
 LINK=ED(LINK)
%REPEAT
%RESULT=DCP
! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
%ROUTINE ELAS(%INTEGER P)
%INTEGER PP,CP,ECN
%SHORTINTEGERARRAYNAME EDD
%IF ED(P+4)&15=5 %THEN %START    ;! ELEMENT
 PP=BD(7)+2*(FELN+ED(P+10)-2)
 CP=BD(PP)
 %IF CP<0 %THEN ED(P+11)=-1 %AND %RETURN  ;! ELT NOT ASSIGNED
 ECN=BD(PP+1)
 %IF BD(CP+13)<0 %THEN BD(CP+13)=FINDCD(CP) %ELSE %C
   CD==ARRAY(ADDR(S(BD(CP+13))),SF)
 ED(P+11)=FINDELN(ECN)
%FINISH %ELSE %START    ;! ASSEMBLY
 EDD==ED
 FINDED(EDD,P)
 EDD(P+11)=FILLBOARD(FELN+EDD(P+10)-1)
 ED==EDD
%FINISH
%END
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE GORVCONS(%INTEGER CAP,GORV)
%OWNSTRING(4)%ARRAY GV(1:2)='%GND','%VCC'
%INTEGER CAPP,ROW,COL,P,CP,PIN
PRINT STRING('

'.GV(GORV).' CONNECTIONS


')
CAPP=CAP+FIRSTINFO
%CYCLE ROW=BD(CAP+5),1,BD(CAP+6)
 %CYCLE COL=BD(CAP+7),1,BD(CAP+8)
  CP=BD(CAPP)
  PRINT STRING(STRPIN(CAP,ROW,COL,-1))
  %IF CP<0 %THEN PRINT STRING('UNOCCUPIED') %ELSE %START
   P=FINDCD(CP)
   PIN=CD(GORV+8)
   %IF PIN<0 %THEN PRINT STRING('NO '.GV(GORV).' PIN ?') %ELSE %START
    PRINT STRING('PIN '.STRINT(PIN))
    BD(BD(CP+13)+PIN-1)=1
   %FINISH
  %FINISH
  NEWLINE
  CAPP=CAPP+1
 %REPEAT
%REPEAT
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE XGORVCONS(%INTEGER GORV,CP,DCP)
%INTEGER P,PIN,PP
%OWNSTRING(4)%ARRAY GV(1:2)='%GND','%VCC'
%IF BD(CP+FIRSTINFO)<0 %THEN %RETURN
PRINT STRING('


EXTRA '.GV(GORV).' CONNECTIONS


')
P=CP
PIN=1
%UNTIL P=CP %AND PIN=1 %CYCLE
 %IF BD(P+10)=0 %THEN %START    ;! DUMMY CHIP
  %IF P=DCP %THEN %START
   PP=BD(6)+2*(PIN-1)
   PRINT STRING(STRPIN(BD(PP),BD(PP+1),-1,-1).'

')
  %FINISH
 %FINISH %ELSE %START
  %IF BD(P+10)>0 %THEN %START
   PRINT STRING(STRPIN(BD(P+10),BD(P+11),BD(P+12),PIN).'

')
  %FINISH
 %FINISH
 BD(BD(P+13)+PIN-1)=1
 PP=P+FIRSTINFO+2*(PIN-1)
 P=BD(PP)
 PIN=BD(PP+1)
%REPEAT
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN FINDCD(%INTEGER CP)
%INTEGER P
A(1001)=BD(CP+6)
A(1002)=BD(CP+7)
A(1003)=BD(CP+8)
A(1004)=BD(CP+9)
P=FINDNAME(1001,S,S(3))
%IF P=0 %THEN FAULT('CHIP DEF NOT FOUND - DISASTER') %AND %MONITORSTOP
CD==ARRAY(ADDR(S(P)),SF)
%RESULT=P
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN PUSHDOWN(%INTEGER NAM,TAG,%SHORTINTEGERARRAYNAME D, %C
 %SHORTINTEGERNAME DLP,DP)
%IF FINDNAME(NAM,D,DLP)#0 %THEN FAULT('NAME '.STRNAME(A,NAM).' REUSED')
D(DP)=DLP
DLP=DP
COPYNAME(NAM,D,DP+1)
D(DP+5)=TAG
DP=DP+6
%RESULT=DP-5
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE POPUP(%SHORTINTEGERARRAYNAME D,%SHORTINTEGERNAME DLP,DP)
DP=DLP
DLP=D(DLP)
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%INTEGERFN FINDNAME(%INTEGER NAM,%SHORTINTEGERARRAYNAME D,%INTEGER DLP)
COPYNAME(NAM,D,LASTLINK+1)    ;! DUMMY HOLE
%CYCLE
 %IF A(NAM)=D(DLP+1) %AND A(NAM+1)=D(DLP+2) %AND %C
   A(NAM+2)=D(DLP+3) %AND A(NAM+3)=D(DLP+4) %THEN %EXIT
 DLP=D(DLP)
%REPEAT
%IF DLP=LASTLINK %THEN %RESULT=0
%RESULT=DLP+1
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE COPYNAME(%INTEGER NAM,%SHORTINTEGERARRAYNAME D,%INTEGER DP)
D(DP)=A(NAM)
D(DP+1)=A(NAM+1)
D(DP+2)=A(NAM+2)
D(DP+3)=A(NAM+3)
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE ARR(%ROUTINE ACTION)
%ROUTINESPEC ACTION(%INTEGER NAM,DIM,L,U)
%INTEGER DIM,L,U,APP,NPP
%CYCLE           ;! FOR EACH <ARR>
 APP=NP(AP)
 %IF A(AP)=1 %THEN %START
  DIM=1
  NPP=NP(AP+5)
  L=A(NPP)
  U=A(NPP+1)
  %IF L>U %THEN FAULT(STRNAME(A,AP+1).' BOUNDS INSIDE OUT') %AND L=U
 %FINISH %ELSE DIM=0 %AND L=0 %AND U=0
 %CYCLE          ;! FOR EACH <NAME>
  ACTION(AP+1,DIM,L,U)
  AP=AP+5
  %IF A(AP)=2 %THEN %EXIT
 %REPEAT
 AP=APP+1
 %IF A(APP)=2 %THEN %RETURN
%REPEAT
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%STRING(15)%FN STRTERM(%INTEGER TERM)
%INTEGER LINK,P,L,U,T
LINK=ED(7)    ;! TERMINAL DEFS
%WHILE LINK#LASTLINK %CYCLE
 P=LINK+1
 %IF ED(P+4)&X'20'=0 %THEN %START    ;! SCALAR
  %IF ED(P+6)=TERM %THEN %RESULT=STRNAME(ED,P)
 %FINISH %ELSE %START
  L=ED(P+5)
  U=ED(P+6)
  T=ED(P+14)    ;! TERMINAL NO OF 1ST ARRAY ITEM
  %IF T<=TERM<=T+U-L %THEN%RESULT=STRNAME(ED,P).'('.STRINT(L+TERM-T).')'
 %FINISH
 LINK=ED(LINK)
%REPEAT
FAULT('TERMINAL NOT FOUND - DISASTER')
%MONITORSTOP
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%STRING(63)%FN STRELT(%INTEGER ELT)
%SHORTINTEGERARRAYNAME EDD
%INTEGER LINK,TAG,P,L,U,FELN,LEN
LINK=ED(8)    ;! ELTS & ASSES LIST
%WHILE LINK#LASTLINK %CYCLE
 P=LINK+1
 TAG=ED(P+4)
 %IF TAG&15=5 %THEN %START    ;! ELEMENT
  %IF TAG&X'20'=0 %THEN %START
   %IF ED(P+10)=ELT %THEN %RESULT=STRNAME(ED,P)
  %FINISH %ELSE %START
   L=ED(P+5)
   U=ED(P+6)
   FELN=ED(P+18)
   %IF FELN<=ELT<=FELN+U-L %THEN %RESULT=STRNAME(ED,P). %C
     '('.STRINT(ELT-FELN+L).')'
  %FINISH
 %FINISH %ELSE %START    ;! ASSEMBLY
  %IF TAG&X'20'=0 %THEN %START
   FELN=ED(P+10)
   %IF ELT>=FELN %THEN %START
    EDD==ED
    FINDED(EDD,P)
    %IF ELT<FELN+ED(10) %THEN %RESULT=STRNAME(EDD,P).'.'. %C
      STRELT(ELT-FELN+1)
    ED==EDD
   %FINISH
  %FINISH %ELSE %START
   FELN=ED(P+18)
   %IF ELT>=FELN %THEN %START
    EDD==ED
    FINDED(EDD,P+8)
    L=EDD(P+5)
    U=EDD(P+6)
    LEN=EDD(P+7)
    %IF ELT<FELN+ED(10)*(U-L+1) %THEN %START
     P=P+8+LEN*((ELT-FELN)//ED(10))
     %RESULT=STRNAME(EDD,P).'('.STRINT(EDD(P+5)).').'. %C
       STRELT(ELT-EDD(P+10)+1)
    %FINISH
    ED==EDD
   %FINISH
  %FINISH
 %FINISH
 LINK=ED(LINK)
%REPEAT
FAULT('ELEMENT NOT FOUND - DISASTER')
%MONITORSTOP
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%STRING(31)%FN STRPIN(%INTEGER NAM,ROW,COL,PIN)
%STRING(31) S
%IF NAM<0 %THEN %RESULT='??'
S=STRNAME(BD,NAM).'('
%IF COL<0 %THEN %START       ;! EDGE
 %IF BD(NAM+7)<0 %THEN %RESULT=S.STRINT(ROW).')'
 %RESULT=S.''''.STRING(ADDR(BD(BD(NAM+7)+ROW-BD(NAM+5)))).''')'
%FINISH
%IF BD(NAM+9)<0 %THEN S=S.STRINT(ROW) %ELSE %C
  S=S.''''.STRING(ADDR(BD(BD(NAM+9)+ROW-BD(NAM+5)))).''''
%IF BD(NAM+10)<0 %THEN S=S.','.STRINT(COL) %ELSE %C
  S=S.','''.STRING(ADDR(BD(BD(NAM+10)+COL-BD(NAM+7)))).''''
%IF PIN<0 %THEN %RESULT=S.') : '
S=S.') : PIN '
%IF PIN<10 %THEN S=S.' '
%RESULT=S.STRINT(PIN)
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%STRING(63)%FN STRSP(%INTEGER N)
%STRING(63) S
S=''
%WHILE N>0 %THEN S=S.' ' %AND N=N-1
%RESULT=S
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%STRING(15)%FN STRINT(%INTEGER N)
%OWNSTRING(1)%ARRAY STRDIG(0:9)='0','1','2','3','4','5','6','7','8','9'
%STRING(15) S
%INTEGER DV,FLAG,M
%IF N=0 %THEN %RESULT='0'
DV=1000000000
FLAG=0
%IF N<0 %THEN N=-N %AND S='-' %ELSE S=''
%WHILE DV#0 %CYCLE
 M=N//DV
 %UNLESS M=0 %AND FLAG=0 %THEN S=S.STRDIG(M) %AND FLAG=1
 N=N-M*DV
 DV=DV//10
%REPEAT
%RESULT=S
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%STRING(8)%FN STRNAME(%SHORTINTEGERARRAYNAME D,%INTEGER DP)
%STRING(8) S
%INTEGER SAVE,I,L
SAVE=D(DP-1)
L=0
%CYCLE I=0,1,3
 %IF D(DP+I)>>8=0 %THEN %EXIT %ELSE L=L+1
 %IF D(DP+I)&X'FF'=0 %THEN %EXIT %ELSE L=L+1
%REPEAT
D(DP-1)=L
S=STRING(ADDR(D(DP))-1)
D(DP-1)=SAVE
%RESULT=S
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE FAULT(%STRING(255) F)
PRINT STRING('**** '.F.'
')
FAULTS=FAULTS+1
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!%ROUTINE DUMP(%SHORTINTEGERARRAYNAME D,%INTEGER DP)
!%ROUTINESPEC PHEX(%INTEGER N)
!%INTEGER I,J
!I=0
!%CYCLE J=0,1,DP-1
!%IF I=0 %THEN NEWLINE %AND PHEX(J) %AND SPACES(3)
! PHEX(D(J))
! I=(I+1)&7
!%REPEAT
!NEWLINES(2)
!%RETURN
!%ROUTINE PHEX(%INTEGER N)
!%OWNINTEGERARRAY H(0:15)='0','1','2','3','4','5','6','7','8','9',
! 'A','B','C','D','E','F'
!%INTEGER I
!SPACES(2)
!%CYCLE I=12,-4,0
! PRINT SYMBOL(H(N>>I&15))
!%REPEAT
!%END
!%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE WRITE4(%INTEGER N)
%INTEGER I
%IF N>9999 %THEN N=9999
I=N//1000
TAPEOUT(I+'0')
N=N-I*1000
I=N//100
TAPEOUT(I+'0')
N=N-I*100
I=N//10
TAPEOUT(I+'0')
TAPEOUT(N-I*10+'0')
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE WRITE2(%INTEGER N)
%IF N>=39 %THEN TAPEOUT('5') %AND TAPEOUT('9') %ELSE %C
  TAPEOUT(N>>3+'0') %AND TAPEOUT(N&7+'0')
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE TAPEOUT(%INTEGER N)
TAPEARR(TAPEARRP)=N
TAPEARRP=TAPEARRP+1
%END
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE FILL(%SHORTINTEGERARRAYNAME D,%INTEGER FROM,TO,VAL)
%INTEGER DP
%RETURN %IF FROM>TO
%CYCLE DP=FROM,1,TO
 D(DP)=VAL
%REPEAT
%END
%END
%ENDOFFILE