PDP-10.its/src/wl/wlin.332

;<WIRELIST>WLIN.FAI.177, 26-NOV-75 10:22:37, EDIT BY HELLIWELL
SUBTTL	'WD'  'WPC'  'BAC'  'BEQ'	SETUP
;BACK PANEL EQUIVALENCE INPUT
READEQ:	MOVSI T,'BEQ'
	TRZ PCNOTD!DOPRTL
	TRO ISBACK!DOBEQ
	JRST WREAD

;BACK PANEL INPUT SETUP (OR JUST PARTS IN)
RDPART:	TROA DOPRTL
BREADD:	TRZ DOPRTL
	MOVSI T,'BAC'
	TRZ PCNOTD!DOBEQ
	TRO ISBACK
	JRST WREAD

;WIRE LIST EQUIVALENCE INPUT
RDWEQ:	MOVSI T,'WEQ'
	TRZ PCNOTD!ISBACK!DOPRTL
	TRO DOBEQ
	JRST WREAD

;WIRE LIST INPUT SETUP
WREADD:	MOVSI T,'WD '
	TRZ PCNOTD!ISBACK!DOBEQ!DOPRTL
	JRST WREAD

WREADP:	MOVSI T,'WPC'
	TRO PCNOTD
	TRZ ISBACK!DOBEQ!DOPRTL
WREAD:	MOVEM T,DEFEXT
	MOVE TT,[PUSHJ P,TTYOUT]
	MOVEM TT,PUTCHR
	MOVE L,DEFLST
	SKIPGE NOMTYP
	JRST [	OUTSTR[ASCIZ/NO NOMENCLATURE TYPE SET.
/]
		PUSHJ P,NOMSET
		SKIPGE NOMTYP
		JRST ERRET
		OUTSTR[ASCIZ/
/]
		JRST .+1]
	PUTSIX DEFEXT
	OUTSTR[ASCIZ/ INPUT FILENAME?/]
	PUSHJ P,MAKLST			;NEVER RETURNS HERE ON ERRORS
	HRRZ T,DIRLST
	JUMPE T,CPOPJ			;QUIT NOW IT NOTHING IN LIST
	TRNN DOWIE			;DOING WIRELIST ERROR FILE?
	JRST NOWIE			;NO, GO TO TTY
	MOVSI T,'WIE'			;WIRELIST INPUT ERRORS
	MOVEI TT,0
	MOVSI TTT,'DSK'			;FILE IT!
	PUSHJ P,OUTSET
	CAIA
	JRST GOTWIE
NOWIE:	SETOM TTYFLG
GOTWIE:	SKIPE TTYFLG
	RELEASE LST,			;IF TTY OUTPUT, WILL USE TTYUUO'S
	MOVE TT,[PUSHJ P,TTYOUT]		;START OUTPUTTING TO TTY
	MOVEM TT,PUTCHR
	TRNE ISBACK
	JRST XNDIPS			;DON'T NEED DIPS FOR BACK PANEL
	PUSHJ P,DIPCHK
	OUTSTR[ASCIZ/COULDN'T GET DIPS IN, WILL GO ON ANYWAY!
/]
XNDIPS:	TRNE DOBEQ			;EQUIVALENCE FILE INPUT?
	JRST [	PUSHJ P,IN0
		POPJ P,
		JRST IN0DON]
	PUSHJ P,IN10
	POPJ P,
;PROCESS EACH INPUT SPEC
;FALLS THRU
IN0DON:	HRRZ H,DIRLST
NXTDIR:	MOVEI G,RADDR(H,CVAR,NSLC)
	SETZM SLICEL
	SETZM CDSKPC			;CLEAR UN-CRDLOC'D COUNT
	FETCH(T,G,NSLC)			;DO NEXT SLICE CHECK NOW
	JUMPE T,NOSLC			;IS THERE EVEN ONE?
	MOVE G,T			;YES, USE IT
SLCNXT:	FETCH(T,G,CDLC)
	HRLZM T,SLICEL
	FETCH(T,G,VLST)
	JUMPE T,[SETZM VARLST
		MOVEI T,377777
		MOVEM T,UPPER
		MOVEM T,WIDTH
		MOVNI T,400000
		MOVEM T,LOWER
		JRST NOSLC]
	FETCH(TTT,G,LBND)
	MOVEM TTT,LOWER
	FETCH(TTT,G,UBND)
	MOVEM TTT,UPPER
	SUB TTT,LOWER
	ADDI TTT,1
	MOVEM TTT,WIDTH
	MOVEM T,VARLST
	SETZM VARERR		;NO ERRORS ON THIS LIST YET
NOSLC:	FETCH(T,H,DFIL)
	MOVEM T,FILNAM
	FETCH(T,H,DEXT)
	HRLZM T,FILEXT
	FETCH(T,H,DPPN)
	MOVEM T,FILPPN
	SETZM FILDAT
	MOVE T,[PUSHJ P,TTYIN]
	MOVEM T,GETCHR
	PUSHJ P,PTERM
	MOVE T,FILPPN
	LOOKUP DAT,FILNAM
	JRST [	OUTSTR[ASCIZ/, LOOKUP FAILED, CODE= /]
		HRRZ T,FILEXT
		PUSHJ P,DECOUT
		OUTSTR[ASCIZ/
/]
		FETCH(T,H,DIRNXT)
		JUMPE T,DIRDON
		PUSHJ P,IERR		;CHECK DSKIN ERROR
		ASK[ASCIZ/GO ON?/]
		JRST DIRDON
		JRST DIRDON
		JRST GOON]
	MOVEM T,FILPPN
	MOVE TT,[PUSHJ P,BYTIN]
	MOVEM TT,GETCHR
	PUSH P,H
	PUSH P,G			;THIS GETS CLOBBERED
	PUSHJ P,DOREAD
	MOVE T,[PUSHJ P,TTYOUT]		;OUTPUT TO TTY
	MOVEM T,PUTCHR
	POP P,G
	POP P,H
	FETCH(G,G,NSLC)			;NEXT SLICE BLOCK
	JUMPN G,SLCNXT
GOON:	TRNE ISBACK
	SKIPN T,CDSKPC
	JRST NOCDPN
	PUSHJ P,DECOUT
	OUTSTR[ASCIZ/ CARDS SKIPPED DUE TO NO LOC.
/]
NOCDPN:	FETCH(H,H,DIRNXT)
	JUMPN H,NXTDIR
DIRDON:	RELEASE DAT,
	POPJ P,


PSLICL:	PUSH P,A
	PUSH P,TTT
	HLRZ A,SLICEL
	PUSHJ P,SLTOUT
	POP P,TTT
	POP P,A
	POPJ P,

PTERM:	PUSH P,A
	MOVEI A,FILNAM
	PUSHJ P,FILPNT
	POP P,A
PSLVAR:	SKIPN SLICEL
	JRST NOLOCL
	PUTBYT 11
	PUSHJ P,PSLICL
NOLOCL:	SKIPN VARLST
	POPJ P,
	SKIPN SLICEL
	PUTBYT 11
	PUTBYT "("
	MOVE T,LOWER
	CAMN T,[-400000]
	JRST BTNUPR
	PUSHJ P,DECOUT
	PUTBYT 74
BTNUPR:	MOVE T,UPPER
	CAIN T,377777
	JRST BTNLP1
	PUSHJ P,DECOUT
	PUTBYT 76
BTNLP1:	SKIPN A,VARLST
	JRST NOVARS
	CAIA
BTNLOP:	PUTBYT ","
	FETCH(T,A,LET)
	PUTBYT @T
	PUTBYT "="
	FETCH(T,A,WID)
	MOVEM T,NDIG
	FETCH(T,A,VAL)
	PUSHJ P,NDECOUT
	FETCH(A,A,NVAR)
	JUMPN A,BTNLOP
NOVARS:	PUTSTR[ASCIZ/)/]
	POPJ P,
;		MAKE LIST, READ FILE INFO
;READ ONE SLICE OF A WIRE LIST
MAKHED:	PGETFS(W,WLBLOCK)
	BCLEAR(T,W,WLBLOCK)	;CLEAR OUT BLOCK
	MOVEI T,RADDR(W,WIRES,ALPH);INITIAL GENLAST
	HRL T,T
	STORE(T,W,HASHTB)	;0 WORD OF HASH TABLE IS INITED TO WIRE HEADER
	POPJ P,

DOREAD:	TRNE ISBACK
	 JRST BAKIN
	MOVEI W,RADDR(L,WIRL,NXTWL)
	TRNE PCNOTD
	 MOVEI W,RADDR(L,PCWL,NXTWL)
	TRNE DOBEQ
	 JRST FNDSLQ		;BACKPANEL EQUIV INPUT
	XCT GETCHR
	 JRST ILLEND
	TRNN PCNOTD
	 JRST CKWDVR
  ;RIGHT PC VERSION # ?
	CAIN TTT,WPCVER
	JRST CKCLOC
	OUTSTR[ASCIZ/
VERSION # MISMATCH, MAYBE YOU SHOULD REWRITE IT!
/]
	TRNN TTT,400000
	OUTSTR[ASCIZ/
THIS IS A 'WD' FILE, NOT A 'WPC' FILE!
/]
	JRST ERRET

;RIGHT D VERSION # ?
CKWDVR:	CAIN TTT,WDVER
	 JRST CKCLOC
	OUTSTR[ASCIZ/
VERSION # MISMATCH, MAYBE YOU SHOULD REWRITE IT!
/]
	TRNE TTT,400000
	 OUTSTR[ASCIZ/
THIS IS A 'WPC' FILE, NOT A 'WD' FILE!
/]
	JRST ERRET

CKCLOC:	XCT GETCHR
	 JRST ILLEND
	HLLZ TTT,TTT		;SOMEHOW THIS GOT CRUFT IN IT, GET RID OF THE CRUFT
	JUMPE TTT,FNDSL0
	EXCH TTT,SLICEL
	JUMPE TTT,FNDSLP
	CAMN TTT,SLICEL
	 JRST FNDSL0		;CARD LOC IN FILE = CARD LOC CALLED FOR?
	OUTSTR[ASCIZ/
CARD LOC FROM FILE = /]
	PUSH P,TTT
	PUSHJ P,PSLICL
	POP P,SLICEL		;USE WHAT HE TYPED
	OUTSTR[ASCIZ/, USING WHAT YOU TYPE INSTEAD!
/]
	JRST FNDSL0

FNDSLP:	OUTCHR[11]
	PUSHJ P,PSLICL
FNDSL0:	OUTSTR[ASCIZ/
/]
	JRST FNDSL1

;FNDSLQ - FIND WIRELIST THAT SLICE GOES INTO
FNDSLQ:	SKIPE SLICEL		;ZERO CARD LOC?
	 JRST FNDSL1		;NO
	FETCH(T,W,NXTWL)
	JUMPE T,FNDSL1
	FETCH(T,T,NXTWL)
	JUMPN T,FNDSL1		;MORE THAN ONE?
	FETCH(W,W,NXTWL)	;NO, USE SINGLE CARD
	FETCH(T,W,FCRD)
	HRLZM T,SLICEL
	OUTCHR[11]
	PUSHJ P,PSLICL
	JRST BODLP0		;MAKE OUTPUT TESTS
	
;find place in sorted list of WIRELISTs that this card goes
FNDSLC:	FETCH(T,W,FCRD)
	MOVS T,T
	CAML T,SLICEL		;IS THIS WHERE WE GO?
	JRST [	CAMN T,SLICEL	;YES, EXACT MATCH?
		JRST BODLP0	;YES
		JRST MAKHD1]
FNDSL1:	MOVE A,W
	FETCH(W,W,NXTWL)
	JUMPN W,FNDSLC
MAKHD1:	PUSHJ P,MAKHED
	FETCH(T,A,NXTWL)	;LINK IN SORTED
	STORE(T,W,NXTWL)
	STORE(W,A,NXTWL)
	HLRZ T,SLICEL
	STORE(T,W,FCRD)
;PROCESS SINGLE WIRELIST
;FALLS THRU
BODLP0:	PUSHJ P,WIESTR		;SETUP INPUT ERROR LISTING
	TRNE DOBEQ
	 JRST EQVSGW
	PGETFS(B,FBLK)
	BCLEAR(T,B,FBLK)
	MOVEM B,THSFIL		;CURRENT FILENAME!
	HLRZ T,SLICEL
	MOVEM T,PINLOC
	PUSHJ P,FVCOPY		;COPY CARDLOC AND VARIABLE STUFF INTO FILE BLOCK
	TRNE PCNOTD
	 JRST [	MOVE T,FILNAM
		STORE(T,B,FILN)
		HLRZ T,FILEXT
		STORE(T,B,FEXT)
		MOVE T,FILPPN
		STORE(T,B,FPPN)
		JRST PCONLY]
FOR I IN(FPOL,FDAT,FILN)
<	XCT GETCHR
	JRST ILLEND
	STORE(TTT,B,I)
>
	XCT GETCHR
	 JRST ILLEND
	HLRZ T,TTT		;EXT ONLY FOR NOW
	STORE(T,B,FEXT)
	XCT GETCHR
	 JRST ILLEND
	STORE(TTT,B,FPPN)
PCONLY:	MOVEI A,RADDR(W,FILS,FNXT)
	PUSHJ P,FILMER		;CHECK FOR DUPLICATE FILES
	FETCH(TTT,B,FPRF)
	JUMPE TTT,MORE5A	;PREFIX ?
	HRRZ T,(TTT)
	JUMPE T,MORE5A
	MOVE T,1(T)
	TRNE T,376
	 JRST MORE5B		;PREFIX TOO LONG
MORE5A:	FETCH(TTT,B,FMOD)
	JUMPE TTT,BODLOP
	HRRZ T,(TTT)
	JUMPE T,NOMDTL
MORE5B:	PUTSTR[ASCIZ\MODULE NAME AND/OR DRAWING PREFIX
WITH TOO MANY CHARS FROM FILE:
\]
	PUSHJ P,FBLKPN
	FETCH(TTT,B,FMOD)
NOMDTL:	TRZ FLAG		;NO OTHER STRINGS SEEN YET
	FETCH(A,W,FILS)
MODCK1:	CAIN A,(B)
	 JRST MODCK2		;DON'T CHECK US
	FETCH(T,A,FMOD)
	JUMPE T,MODCK2
	TRO FLAG		;SEEN ONE
	FETCH(TT,B,FMOD)
	PUSHJ P,TXTMAT
	 JFCL
	 SKIPA C,A
	JRST BODLOP
MODCK2:	FETCH(A,A,FNXT)
	JUMPN A,MODCK1
	TRNN FLAG
	 JRST BODLOP
	PUTSTR[ASCIZ/MULTIPLE MODULE NAMES ON THIS CARD FROM FILES:
/]
	PUSHJ P,FBLKPN
	MOVE B,C
	PUSHJ P,FBLKPN
;FALL INTO BODLOP
;		READ BODIES
BODLOP:	XCT GETCHR		;READ A WORD
	 JRST ILLEND
	JUMPE TTT,DOWIRES	;YES, GO DO WIRES
	PUSH P,TTT		;SAVE LH (LOC ON DRWING) FOR LATER
	HRRZM TTT,BID
	XCT GETCHR		;READ LOC (AND BODY BITS (PC))
	 JRST ILLEND
	HRRZM TTT,PINLOC
	TRNE PCNOTD
	 JRST [	HLRZM TTT,FACTR1	;STORE BODY BITS HERE
		SETZM STRTAB		;CLEAR BODY NAME
		POP P,TTT
		HLLM TTT,FACTR1		;STORE # OF PINS HERE
		JRST RDDIP]		;MAKE BODY AND READ DIP TYPE
	HRRI TTT,		;GET JUST BAY-RACK-SLOT
	JUMPE TTT,LOOKT1	;BLANK OR
	CAME TTT,SLICEL		;SAME CARD
	 JRST [	POP P,(P)		;NO, IGNORE THIS BODY
		XCT GETCHR		;SKIP BITS,,0
		 JRST ILLEND
		PUSHJ P,SKPSTR		;SKIP BODY NAME
		JFCL
	BDSKP1:	PUSHJ P,SKPSTR		;SKIP PACKAGE NAME, OR VALUE PART OF PROPERTY
		 JFCL
		PUSHJ P,SKPSTR		;SKIP PROPERTY NAME
		 JRST BDSKP1		;NOT NULL, SKIP VALUE ALSO
		JRST BODLOP]
LOOKT1:	POP P,T			;APPROX X,Y OF BODY ON DRWING
	XCT GETCHR		;GET BODY BITS
	 JRST ILLEND
	TRZ TTT,-1		;NOTHING IN RH
	HLRZ TT,T		;NOW STUFF X,Y POS INTO BITS
	JUMPE TT,XANYPS		;SKIP IF NONE
	SUBI TT,1001
	DPB TT,[POINT BXPOSL,TTT,35-BXPOSB];STO X POS
	LSH TT,-9
	DPB TT,[POINT BYPOSL,TTT,35-BYPOSB];STO Y POS
	TRO TTT,BANYPOS		;MARK AS HAVING POS BITS
XANYPS:	HRRZM TTT,FACTR1	;STORE BODY BITS AND POS HERE
	PUSHJ P,TRSTR		;READ BODY NAME INTO STRTAB
	 JRST ILLEND
	 JRST ILLEND		;SHOULDN'T HAPPEN
RDDIP:	PUSHJ P,BODFND
	 JRST RDDIP1		;NOT FOUND, AS IT SHOULD BE
	TRNE PCNOTD		;OK IF PC CARD
	 JRST RDDIP1
	PUTSTR[ASCIZ/LOSE BIG, BODY "/]
	PUTSTR STRTAB		;PRINT BODY NAME
	PUTSTR[ASCIZ/" ALREADY EXISTS AT BODY INPUT TIME!
/]
RDDIP1:	PUSHJ P,BODMK2		;MAKE AND LINK BODY, NAME WILL BE COPIED FROM STRTAB
	TRNE PCNOTD		;ONLY FOR D
	 JRST [	PUSHJ P,RSTR	;READ DIP NAME
		 JRST BODLOP	;NONE
		MOVEM T,STRING
		PUSHJ P,BODDIP	;GET DIP TYPE SETUP
		 JRST [	PUSHJ P,DPLOST
			JRST BODLOP]
		JRST RPRPDN]
	MOVE TTT,FACTR1
	STORE(TTT,A,BBIT)	;STORE BODY BITS (SHOULDN'T BE ANY OTHERS ON YET)

; Read D's idea of Package Name and compile into Package code
	PUSHJ P,RSTR		;GET PACKAGE NAME
	 JRST RDDIP8
	MOVE B,T		;SAVE STRING
	PUSH P,A		;SAVE BODY
	PUSHJ P,MATPAK
	 JRST [	PUTSTR [ASCIZ /UNKNOWN PACKAGE TYPE "/]
		MOVE T,B
		PUSHJ P,STROUT
		PUTSTR [ASCIZ /" ON /]
		MOVE A,(P)
		PUSHJ P,PBODY
		CRLF
		SETZ A,
		JRST .+1]
	PUSHJ P,PUTFS
	MOVE T,A		;PACKAGE CODE
	POP P,A
	STORE(T,A,BPAK)
; Read the bodies properties (including DIPTYPE)
RDDIP8:	PUSHJ P,GETPRP
	MOVE B,PRPLST
	STORE(B,A,PRPX)
	MOVE B,LSTPART
	STORE(B,A,PRTN)
	JUMPE B,RPRP12
	FETCH(T,B,PRBT)
	TRO T,PNUSED
	STORE(T,B,PRBT)
RPRP12:	MOVE B,LSTDIP
	STORE(B,A,DIPT)
	FETCH(T,A,PRPX)
	SKIPN T,PRPLST
	 JRST RPRPDN
	JUMPE T,RPRPDN		;JUMP IF NO EXTRA PROPERTIES
; See if this PROP list is already on this DIP
	SETZM TMPCN1
RPRPX0:	AOS TMPCN1
	FETCH(T,T,NXTT)
	JUMPN T,RPRPX0
   ;TRY TO INTERN THIS PRPLST, TO SAVE SPACE I SUPPOSE
	MOVEI G,RADDR(W,WBDY,NXTB)
RPRPX1:	FETCH(G,G,NXTB)
	JUMPE G,RPRPDN
RPRPX2:	CAIN G,(A)
	 JRST RPRPX1		;DON'T LOOK AT OURSELVES
	FETCH(T,G,BBIT)
	TRNE T,PRX2ND		;THE PRIME COPY ?
	 JRST RPRPX1		; PROBABLY WON'T BE NEW POSSIBILITY OTHERWISE
	FETCH(E,G,PRPX)
	JUMPE E,RPRPX1
	PUSHJ P,PRXMAT
	 JRST RPRPX1
	FETCH(F,G,PRPX)		;FOUND ALREADY THERE, COPY IT
	STORE(F,A,PRPX)
	FETCH(T,A,BBIT)		;MARK AS 2ND COPY
	TRO T,PRX2ND
	STORE(T,A,BBIT)
;READ BODIES - CHECK DIP TYPE
RPRPDN:	FETCH(B,A,DIPT)		;GET DIP TYPE POINTER BACK
	JUMPE B,BODLOP
	TRNN PCNOTD
	 JRST DOINVT		;GO INVENT POWER/GROUND
	FETCH(T,B,DPNN)
	HLRZ TT,FACTR1		;# OF PINS FROM PC
	CAMN TT,T		;PC AND WL AGREE ABOUT SIZE OF DIP ?
	 JRST BODLOP
	FETCH(A,B,DNAM)		;DIPNAME POINTER
	PUSHJ P,STROUT		;DIPNAME
	PUTSTR[ASCIZ/ (/]
	FETCH(T,B,DPNN)
	PUSHJ P,DECOUT		;# OF PINS ON DIP
	PUTSTR[ASCIZ/ PINS) IN /]
	HLRZ T,FACTR1
	PUSHJ P,DECOUT		;# OF PINS ON SOCKET
	PUTSTR[ASCIZ/ PIN SOCKET/]
	SKIPN PINLOC
	 JRST NCLOC
	PUTSTR[ASCIZ/ AT /]
	MOVE A,PINLOC
	PUSHJ P,LOCOUT		;LOC
NCLOC:	PUTSTR[ASCIZ/!
/]
	JRST BODLOP

DIPCHECK
DIPFND:	HLRZ T,(B)
	MOVE TT,STRING
	PUSHJ P,DSORT
	JFCL
	CAIA
	JRST CPOPJ1
	HRRZ B,(B)
	JUMPN B,DIPFND
	POPJ P,

BODDIP:	SKIPN B,DIPLST
	POPJ P,
DIPCHECK
	PUSHJ P,DIPFND
	POPJ P,
	STORE(B,A,DIPT)		;STORE DIP TYPE POINTER
	JRST CPOPJ1		;SUCCESS

DPLOST:	FETCH(A,A,BLOC)
	JUMPE A,[PUTSTR[ASCIZ/BODY WITH NO LOCATION/]
		JRST DPLST1]
	PUTSTR[ASCIZ/BODY AT LOCATION /]
	PUSHJ P,LOCOUT
DPLST1:	PUTSTR[ASCIZ/, DIPTYPE "/]
	MOVE A,STRING
	PUSHJ P,STROUT		;DIPNAME
	PUTSTR[ASCIZ/", NOT FOUND!
/]
	MOVE B,STRING
	JRST PUTFS
;CREATE INVENTED SIGNAL NAMES FOR GND, AND ALL FLAVORS OF PWR ON DIP
; The invented pins may be removed later if explicit drawing
  
DOINVT:	TRNE FLAG		;FIRST BODY IN THIS LOC?
	 JRST BODLOP		;NO, SKIP IT
	MOVEM A,BSLOT		;SAVE BODY POINTER HERE
	FETCH(A,B,DPIN)		;GET DIP PIN LIST
	JUMPE A,BODLOP		;QUIT IF NONE
DOINV1:	FETCH(T,A,DPBIT)	;GET PIN BITS
	TRNN T,PWR!GND		;POWER OR GROUND PIN?
	 JRST DOINV2		;NO, SKIP IT
	HRLM A,BSLOT		;SAVE PIN POINTER HERE
	SETZM PID
	SETZM PINTMP
	FETCH(TT,A,DPNM)
	MOVEM TT,PINNUM
	SETZB G,WQNWRD		;NO WIRE YET
	TRNE T,GND
	 JRST [	PUSHJ P,MAKGND
		JRST DOINV5]
	FETCH(T,A,LLOW)		;THE VOLTAGE
	PUSHJ P,MAKPWR
DOINV5:	HRRZ F,BSLOT		;GET BODY POINTER
	PUSHJ P,PMAKE
	PUSHJ P,PMERGE
	FETCH(T,E,PBIT)
	TRO T,INVENT
	STORE(T,E,PBIT)
	HLRZ A,BSLOT
DOINV2:	FETCH(A,A,DPNX)
	JUMPN A,DOINV1
	JRST BODLOP

;MAKPWR - GENERATE NEW SIGNAL FOR GND OR PWR RUN AND ADD TO CURRENT WIRE
;T = VOLTAGE
MAKGND:	MOVE T,[ASCII /GND/]
	MOVEM T,STRTAB		;THIS IS SIGNAL NAME "GND"
	JRST DOINV3

MAKPWR:	MOVE B,[POINT 7,STRTAB]	;CREATE SIGNAL NAME FOR PWR
	MOVEM B,TMPCN1
	MOVE B,[IDPB TTT,TMPCN1]
	EXCH B,PUTCHR
	SKIPL T
	PUTBYT "+"
	SKIPGE T
	PUTBYT "-"
	MOVM T,T
	IDIVI T,=100
	PUSH P,TT
	PUSHJ P,DECOUT
	PUTBYT "."
	POP P,T
	IDIVI T,=10
	PUTBYT "0"(T)
	SKIPE TT
	PUTBYT "0"(TT)
	PUTBYT "V"
	MOVEM B,PUTCHR		;RESTORE OLD PUTCHR
	MOVE T,TMPCN1
	SETZ TT,
DOINV4:	IDPB TT,T		;FILL OUT SIGNAL NAME WITH 0'S
	TLNE T,760000
	 JRST DOINV4
DOINV3:	PUSHJ P,TGRONK		;ADD NAME TO CURRENT WIRE
	POPJ P,
;		PROPERTY READING SUBRS
GETPRP:	SETZM LSTDIP
BAKPRP:	SETZM LSTPART
	SETZM PRPLST		;SAVE OTHER PROPERTIES HERE
; Read PROP-VALUE pairs into PRPLST (making values canonical)
RDDIP5:	PUSHJ P,RSTR
	 JRST RDDIP4		;ALL DONE
	MOVE B,T		;SAVE COPY OF STRING
	PUSHJ P,RSTR
	 JRST [	PUSHJ P,PUTFS		;RETURN PROPERTY NAME IF NO VALUE
		JRST RDDIP5]
	PUSHJ P,VALFIX			;FIX VALUE STRING (RETURNS STRING IN T)
	GETFS(TT,TBLK)			;GET TEMP BLOCK
	BCLEAR(TTT,TT,TBLK)		;CLEAR BLOCK
	STORE(B,TT,TLFT)		;STORE PROPERTY NAME HERE
	STORE(T,TT,TRHT)		;STORE PROPERTY VALUE HERE
	MOVE T,PRPLST
	STORE(T,TT,NXTT)		;LINK INTO LIST OF PROPERTIES
	MOVEM TT,PRPLST
	JRST RDDIP5

RDDIP4:	SKIPE DIPLST			;ANY DIPS IN?
	TRNE ISBACK
	 JRST BRPRP1
; Look for DIPTYPE property 
	MOVEI F,PRPLST-ADDR(0,NXTT)
RDDIP7:	MOVE E,F
	FETCH(F,F,NXTT)
	JUMPE F,BRPRP1
RDDIP6:	FETCH(T,F,TLFT)
	MOVEI TT,[ASCIZ/DIPTYPE/]
	PUSHJ P,ASCMAT		;IS THIS DIPTYPE ?
	 JRST GETPR1
	FETCH(T,F,TRHT)
	MOVEM T,STRING
	MOVE B,DIPLST
	PUSHJ P,DIPFND
	 JRST GETPR1
	MOVEM B,LSTDIP
	FETCH(B,F,TLFT)		;FOUND DIPTYPE,
	PUSHJ P,PUTFS		; REMOVE "DIPTYPE" FROM PRPLST
	FETCH(B,F,TRHT)
	PUSHJ P,PUTFS
	FETCH(B,F,NXTT)
	STORE(B,E,NXTT)
	FSTRET(F,TBLK)
	MOVE F,E
	JRST RDDIP7

GETPR1:	FETCH(T,F,TLFT)
	MOVEI TT,[ASCIZ/PACKAGE/]
	PUSHJ P,ASCMAT		;IS THIS "PACKAGE" ?
	 JRST RDDIP7
	FETCH(T,A,BBIT)		;MARK BODY HAS PACKAGE PROPERTY
	TRO T,BPACKP
	STORE(T,A,BBIT)
	JRST RDDIP7

;MATCH BODIES PROP LIST AGAINST DIP'S PROP/PART# DECISION TREE
;	Allow bodies properties to specify down tree, until
;	 1) next prop in tree not mentioned in PRPLST, and no default value
;	 2) next prop in tree mentioned, but value not equal to any of choices
;FALLS THRU
BRPRP1:	SKIPN B,LSTDIP
	 POPJ P,
	FETCH(H,B,PRPV)		;GET POINTER TO PROPERTY VALUES
	SETZ G,			;CLEAR PREVIOUS LEVEL
RPRP1:	JUMPE H,RPRP4
	MOVEI F,PRPLST-ADDR(0,NXTT)
	JRST RPRP2

; ASSQ down PRPLST, looking for next prop in tree
RPRP3:	FETCH(T,F,TVAL)		;GET FLAG
	JUMPN T,RPRP2		;SKIP IF ALREADY MATCHED
	FETCH(T,F,TLFT)		;GET PROPERTY NAME
	JUMPE T,RPRP2		;SKIP IF WAS DIPTYPE
	FETCH(TT,H,PRNB)
	FETCH(TT,TT,PRNS)
	PUSHJ P,TXTMAT
	 JRST RPRP2
	 JRST RPRP2
	SETO T,			;PROP WAS FOUND
	STORE(T,F,TVAL)		;FLAG THIS PROPERTY MATCHED
; Got a match on next decision, look for value match
RPRP7:
;	FETCH(T,H,PRBT)
;	TRNE T,NULVAL
;	 JRST RPRP8
	FETCH(T,F,TRHT)		;NOW GET VALUE STRING
	FETCH(TT,H,PRVS)
	PUSHJ P,VALMAT
	 JRST [RPRP8:	FETCH(H,H,PRNV)
		JUMPN H,RPRP7
		JRST RPRP4]
RPRP6:	MOVE G,H		;VALUE MATCHED TOO, STEP DOWN IN TREE
	FETCH(H,G,PRNP)
	JRST RPRP1


RPRP2:	FETCH(F,F,NXTT)		;NEXT TEMP BLOCK
	JUMPN F,RPRP3		;AND LOOP
; No item on PRPLST matches next node of tree, look for default value
RPRP5:	FETCH(T,H,PRBT)		;GET PROPERTY VALUE BITS
	TRNE T,DEFPRP		;IS IT THE DEFAULT?
	 JRST RPRP6		;YES, STEP DOWN TREE TO NEXT NODE
	FETCH(H,H,PRNV)
	JUMPN H,RPRP5
; Matched as far as we can
RPRP4:	JUMPE G,CPOPJ		;IF NOTHING FOUND,
	FETCH(T,G,PRBT)
	TRNN T,PARTNM		;DID WE GET ALL THE WAY TO THE PART NUMBER ?
	 POPJ P,
	MOVEM G,LSTPART		;YES, SOME MEASURE OF SUCCESS
	MOVEI F,PRPLST-ADDR(0,NXTT)
	JRST RPRP9		;DELETE ALL PRPLST ENTRIES THAT WERE USED TO MATCH

RPRP14:	FETCH(T,F,TVAL)		;USED TO MATCH PROP TREE ?
	JUMPE T,RPRP9
	FETCH(B,F,TLFT)		;YES, DELETE FROM PRPLST
	PUSHJ P,PUTFS
	FETCH(B,F,TRHT)
	PUSHJ P,PUTFS
	FETCH(B,F,NXTT)
	STORE(B,E,NXTT)
	FSTRET(F,TBLK)
	MOVE F,E
RPRP9:	MOVE E,F
	FETCH(F,F,NXTT)
	JUMPN F,RPRP14
	POPJ P,

;PRXMAT - MATCH TWO EXTRA-PROP LISTS
;F = TEST LIST
;E = LIST TO MATCH
;SKIPS, RECLAIMS TEST LIST IF MATCH FOUND

PRXMAT:	MOVE T,E
	SETZ TT,		;COUNT NUMBER OF EXTRA PROPS
RPRPX3:	ADDI TT,1
	FETCH(T,T,NXTT)
	JUMPN T,RPRPX3
	CAME TT,TMPCN1		;SAME NUMBER OF PROPERTIES?
	 POPJ P,
	MOVE F,PRPLST
RPRPX4:	MOVE D,E
RPRPX5:	FETCH(T,D,TLFT)		;PROPERTY NAME
	FETCH(TT,F,TLFT)
	PUSHJ P,TXTMAT		;SAME PROP NAME ?
	 JRST RPRPX6
	 JRST RPRPX6
	FETCH(T,D,TRHT)
	FETCH(TT,F,TRHT)
	PUSHJ P,VALMAT		;SAME PROP VALUE ?
	 POPJ P,		;LOSE ON THIS BODY
	JRST RPRPX7

RPRPX6:	FETCH(D,D,NXTT)
	JUMPN D,RPRPX5
	POPJ P,			;LOSE, PROPERTY NOT FOUND

RPRPX7:	FETCH(F,F,NXTT)
	JUMPN F,RPRPX4
	MOVE F,PRPLST		;FOUND SAME LIST, RETURN OTHER ONE
RPRPX8:	FETCH(B,F,TLFT)
	PUSHJ P,PUTFS
	FETCH(B,F,TRHT)
	PUSHJ P,PUTFS
	MOVE D,F
	FETCH(F,F,NXTT)
	FSTRET(D,TBLK)
	JUMPN F,RPRPX8
	JRST CPOPJ1
;		BACKPANEL FILE INFO INPUT
BAKIN:	TRNE DOBEQ
	 JRST EQVSIG
	OUTSTR[ASCIZ/
/]
	XCT GETCHR
	 JRST ILLEND
	CAIE TTT,BACVER		;CURRENT VERSION?
	JRST [	OUTSTR[ASCIZ/
VERSION # MISMATCH, MAYBE YOU SHOULD REWRITE THIS FILE!
/]
		JRST ERRET]
	PUSHJ P,WIESTR		;SETUP INPUT ERROR LISTING
	FETCH(W,L,BLST)		;GET BACK PANEL LIST POINTER
	JUMPN W,DOFILS		;IF ALREADY GOT HEADER, GO READ FILE BLOCKS
	PUSHJ P,MAKHED		;MAKE A HEADER BLOCK
	STORE(W,L,BLST)
DOFILS:	XCT GETCHR		;READ CARD LOC
	 JRST ILLEND
	JUMPL TTT,CPOPJ		;NEG IS END
	TRNE DOPRTL		;PARTS ONLY?
	JRST [	SETZM BSLOT	;YES, DON'T CARE ABOUT LOC
		JRST DOFIL1]
	SKIPN T,TTT		;ANY CARD LOC?
	 HLRZ T,SLICEL		;NO, USE WHAT HE TYPED
	JUMPE T,SKPFIL
	MOVEM T,PINLOC		;THIS IS WHERE SLOTFN LOOKS
	TRNE DOPRTL		;READING PARTS ONLY?
	 TDZA A,A		;YES, DON'T FIND SLOT
	 PUSHJ P,SLOTFN		;FIND OR MAKE SLOT BODY
	MOVEM A,BSLOT		;AND SAVE IT
DOFIL1:	XCT GETCHR
	 JRST ILLEND
	JUMPE TTT,FILDON		;DONE WITH FILES?, DO WIRES
	PGETFS(B,FBLK)			;MAKE A FILE BLOCK
	BCLEAR(T,B,FBLK)
	STORE(TTT,B,FILN)
	XCT GETCHR
	 JRST ILLEND
	HLRZ T,TTT			;EXT ONLY FOR NOW
	STORE(T,B,FEXT)
FOR I IN(FPPN,FDAT)
<	XCT GETCHR
	 JRST ILLEND
	STORE(TTT,B,I)
>
	PUSHJ P,FVCOPY		;COPY CARD LOC AND VARIABLE STUFF
	MOVEI A,RADDR(L,BKNM,FNXT)
	PUSHJ P,FILMER
	FETCH(T,B,FMOD)			;TAKE LAST MODULE NAME
	MOVEM T,MODULE			;AND SAVE FOR DIP COUNTS STUFF LATER
	JRST DOFIL1

FILDON:	TRNN DOPRTL			;PARTS ONLY?
	 JRST DOWIRES			;NO
	PUSHJ P,SKP2CNT			;SKIP TO DIP COUNTS
	JRST ENDIN			;AND READ THEM
;READ SIGNAL EQUIVALENTS, ALL SIGNALS ON LINE ARE EQUIV
EQVSIG:	SETZM BAKOLD
	SETZM BAKILD
	SETZM BAKSFL
	SETZM BAKBIT		;MAKE SURE NO BITS GET INTO WIRE HEADERS
	FETCH(W,L,BLST)		;GET BACK PANEL LIST POINTER
	JUMPN W,EQVSGB		;IF ALREADY GOT HEADER, GO READ WIRES
	PUSHJ P,MAKHED		;MAKE A HEADER BLOCK
	STORE(W,L,BLST)
EQVSGB:	SKIPE SLICEL		;DID HE GIVE A CARD SLOT?
	OUTSTR[ASCIZ/	IGNORING CARD SLOT!/]
EQVSGW:	OUTSTR[ASCIZ/
/]
EQVSG0:	SETZB G,WQNWRD
EQVSG1:	PUSHJ P,SIGIN		;READ A SIGNAL
	POPJ P,			;EOF
	PUSH P,TTT		;SAVE TERMINATOR
	PUSHJ P,TGRONK		;ADD NEW SIGNAL TO WIRE
	POP P,TTT
	CAIE TTT,12
	 JRST EQVSG1		;GET NEXT EQUIVALENT
	JRST EQVSG0		;EOL, GET NEXT SET OF EQUIVS
;SKIP OVER PORTIONS OF 'BAC' FILE

;SKPFIL - SKIP ALL AFTER WORD WITH CARD LOCN

SKPFIL:	AOS CDSKPC
SKPFL1:	XCT GETCHR		;DRWNAM ?
	 JRST ILLEND
	JUMPE TTT,SKPRUN
FOR I IN(FEXT,FPPN,FDAT)
<	XCT GETCHR
	 JRST ILLEND
>
FOR I IN(FREV,FMOD,FVAR,FPRF,AUTHOR,TIT1,TIT2,FPROJ,FPAGE,FOF,FNXH)
<	PUSHJ P,SKPSTR
	JFCL
>
	PUSHJ P,SKPSTR		;SKIP NOMENCLATURE TYPE
	JFCL
	PUSHJ P,SKPSTR		;SKIP BOARD TYPE
	JFCL
	JRST SKPFL1

SKPRUN:	PUSHJ P,SKP2CNT
SKPCNT:	PUSHJ P,SKPSTR		;DIPTYPE STRING?
	 JRST SKPCN1
	JRST DOFILS

SKPCN1:	XCT GETCHR		;APPROX COUNT
	 JRST ILLEND
	AOJE TTT,SKPCNT		;ENDS ON -1
	XCT GETCHR		;REAL COUNT
	 JRST ILLEND
SKPCN2:	PUSHJ P,SKPSTR		;PROP NAME, VALUE
	CAIA
	JRST SKPCN1
	PUSHJ P,SKPSTR
	JFCL
	JRST SKPCN2

; Skip to parts counts in BAC file
SKP2CNT:
	XCT GETCHR		;WBITS,,TBITS
	 JRST ILLEND
	JUMPE TTT,CPOPJ
	MOVEI T,2
SKPRN1:	XCT GETCHR		;IN, OUT LOADING
	 JRST ILLEND
	SOJG T,SKPRN1
	XCT GETCHR		;SOURCE PIN DRWING NAME,EXT,PPN ?
	 JRST ILLEND
	JUMPE TTT,SKPRN9	;NO
	XCT GETCHR		;EXT
	 JRST ILLEND
	XCT GETCHR		;PPN
	 JRST ILLEND
SKPRN9:	PUSHJ P,SKPSTR		;SIGNAL NAME(S)
	JRST .-1
SKPRN2:	XCT GETCHR		;PPS,,CPIN ?
	 JRST ILLEND
	JUMPE TTT,SKP2CNT
	MOVEI T,4		;X,Y NAME,EXT,PPN
SKPRN3:	XCT GETCHR
	JRST ILLEND
	SOJG T,SKPRN3
	JRST SKPRN2

SKPSTR:	XCT GETCHR
	JRST ILLEND
	JUMPE TTT,CPOPJ1
SKPST1:	TRNN TTT,376
	POPJ P,
	XCT GETCHR
	JRST ILLEND
	JRST SKPST1

;		SETUP INPUT ERROR FILE, FILE BLOCK SORT ROUTINE, READ BOARD TYPE
WIESTR:	SKIPN TTYFLG
	SKIPA T,[PUSHJ P,BYTOUT]
	MOVE T,[PUSHJ P,TTYOUT]
	MOVEM T,PUTCHR
	SKIPE TTYFLG		;IF TTY
	POPJ P,			;TERM ALREADY PRINTED
	PUSHJ P,PTERM
	PUTSTR[ASCIZ/
/]
	POPJ P,

;FILMER - MERGE NEW FILE BLOCK, CHECK FOR DUPLICATE FILE NAMES
FILMER:	TRNE PCNOTD
	JRST FILMR1
FOR I IN(FREV,FMOD,FVAR,FPRF,AUTHOR,TIT1,TIT2,FPROJ,FPAGE,FOF,FNXH)
<	PUSHJ P,RSTR		;READ STRING
	 SETZ T,
	STORE(T,B,I)
>
	PUSHJ P,RDNOM
	PUSHJ P,RDWW
	JRST FILMR1

FILMR2:	FETCH(T,A,FILN)
	CAMGE T,ADDR(B,FILN)
	 JRST FILMR1
	CAME T,ADDR(B,FILN)
	JRST FILMR3
	TRNN ISBACK
	JRST [	PUTSTR[ASCIZ/DRW FILES WITH SAME NAME:
/]
		JRST FILMR4]
	FETCH(T,A,FPPN)
	CAMN T,ADDR(B,FPPN)
	JRST [	FETCH(T,A,FEXT)
		FETCH(TTT,B,FEXT)
		CAMN T,TTT
		JRST FILMR3
		JRST .+1]
	PUTSTR[ASCIZ\DRW FILES WITH SAME NAME, BUT DIFFERENT EXTENSION AND/OR PPN:
\]
FILMR4:	PUSH P,TT
	PUSHJ P,FBLKPN
	EXCH A,B
	PUSHJ P,FBLKPN
	EXCH A,B
	POP P,TT
	FETCH(T,A,FEXT)
	FETCH(TTT,B,FEXT)
	CAMGE T,TTT
	 JRST FILMR1
	FETCH(T,A,FPPN)
	CAML T,ADDR(B,FPPN)
	 JRST FILMR3
FILMR1:	MOVE TT,A
	FETCH(A,A,FNXT)
	JUMPN A,FILMR2
FILMR3:	STORE(B,TT,FNXT)
	STORE(A,B,FNXT)
	POPJ P,

;HERE TO READ AND DECODE BOARD TYPE

RDNOM:	PUSH P,B		;SAVE POINTER TO THIS BLOCK
	PUSHJ P,RSTR
	JRST [	PUTSTR[ASCIZ/NO NOMENCLATURE TYPE FROM FILE:
/]
		JRST RDWNX1]
	STORE(T,B,FNOM)
	MOVE B,T
	PUSHJ P,FNDNOM
	JRST [	PUTSTR [ASCIZ /UNKNOWN NOMENCLATURE TYPE FROM FILE:
/]
		JRST RDWNX1]
	MOVEI C,-LNAMES(C)
	CAMN C,NOMTYP		;DO BOARD TYPES AGREE?
	JRST RDWNX2
	MOVE T,NOMTYP
	MOVE T,LOCTVV(T)	;GET NOMENCLATURE TABLE POINTER
	CAMN T,LOCTVV(C)	;SAME NOMENCLATURE?
	JRST RDWNX2		;YES
	PUTSTR [ASCIZ /NOMENCLATURE TYPE FROM FILE IS DIFFERENT FROM CURRENT ONE:
/]
	JRST RDWNX1

RDWW:	TRNE PCNOTD
	POPJ P,			;NO BOARD TYPE FOR PC
	PUSH P,B		;SAVE POINTER TO THIS BLOCK
	PUSHJ P,RSTR
	JRST [	SETO C,
		JRST RDWW1]
	STORE(T,B,FWWT)		;STORE STRING BOARD TYPE
	MOVE B,T
	PUSHJ P,FNDWW
	JRST [	PUTSTR [ASCIZ /UNKNOWN BOARD TYPE FROM FILE:
/]
		JRST RDWNX1]
	MOVEI C,-WNAMES(C)
RDWW1:	CAMN C,WWTYP		;DO BOARD TYPES AGREE?
	JRST RDWNX2
	PUTSTR [ASCIZ /BOARD TYPE FROM FILE IS DIFFERENT FROM CURRENT ONE:
/]
RDWNX1:	POP P,B
	JRST FBLKPN

RDWNX2:	POP P,B
	POPJ P,
;		READ SIGNAL NAMES
DIDWIR:	JUMPE G,DOWIRES		;ANY WIRE SEEN?
	FETCH(T,G,WBIT)
	TRNE T,GENSIG
	PUSHJ P,FINGEN		;FINISH GENERATED NAME
DOWIRES:SETZB G,WQNWRD		;INIT WIRE POINTER
	SETZM LOSBIT		;INIT GEN NAME CELLS
	SETZM LOSNAM
	TRNN ISBACK		;BACK PANEL INPUT?
	JRST DOTEXT
	XCT GETCHR
	JRST ILLEND
	JUMPE TTT,ENDIN		;END ON 0 HERE (THIS COUNTS ON BITS NEVER BEING 0)
	MOVEM TTT,BAKBIT	;SAVE BITS HERE
	XCT GETCHR
	JRST ILLEND
	MOVEM TTT,BAKOLD
	XCT GETCHR
	JRST ILLEND
	MOVEM TTT,BAKILD
	SETZM BID		;CLEAR THIS
	SETZM BAKSFL		;CLEAR SOURCE FILE POINTER
	XCT GETCHR
	JRST ILLEND
	JUMPE TTT,DOTEXT	;0 MEANS NO SOURCE
	MOVE E,TTT
	XCT GETCHR
	JRST ILLEND
	HLRZ F,TTT		;EXT ONLY FOR NOW
	XCT GETCHR
	JRST ILLEND
	EXCH F,TTT
	PUSHJ P,BPFFIL		;FIND FILE BLOCK
	MOVEM T,BAKSFL		;SAVE HERE
DOTEXT:	PUSHJ P,TRSTR
	JRST ILLEND
	JRST [	XCT GETCHR	;NULL, GET NEXT WORD
		JRST ILLEND
		JUMPN TTT,PINLPA	;ANY PINS?
		POPJ P,]		;NULL STRING AND NULL LIST, END
	JRST DOTXTS

DOTXTA:	PUSHJ P,TRSTR
	 JRST ILLEND
	 JRST [	TRNN ISBACK	;DONE, GO DO PINS
		 JRST PINLOP
		JRST BPINLP]
DOTXTS:	PUSHJ P,TGRONK
	JRST DOTXTA
;ASSEMBLE NAME (STRTAB) INTO CURRENT WIRE
;RETURNS
;G = CURRENT ACTIVE HEAD OF THIS WIRE

TGRONK:	MOVE A,[POINT 7,STRTAB]		;POINTER TO BEGINNING OF STRING
	PUSHJ P,PERMUT		;MAKE CONONICAL FORM, CONVERT VARIABLES
	SKIPN CMPWRD
	 JRST [	SKIPE WQNWRD	;DID WE PICKUP QN?
		JUMPN G,QNMERG	;YES, MERGE IF WE HAVE HEADER
		POPJ P,]	;NO (ALWAYS 0 IF NOT BP)
	MOVEI T,CMPWRD
	MOVEM T,SAVET
	PUSHJ P,TXTFND		;FIND THIS SIGNAL NAME OR WHERE IT GOES
	 JRST NEQ		;MUST INSERT NEW STRING
	 JRST ISEQV		;JUST MERGE COMMENTS!!!!!
; Name was found, merge it if we already have a wire (G)
WASEQ:	FETCH(T,C,WBIT)
	IOR T,SAVBIT		;ADD THESE BITS
	STORE(T,C,WBIT)
	JUMPN G,WASEQV		;WIRES TO MERGE?
	TRNN T,NAM2ND		;IS IT HEADER BLOCK?
	SKIPA G,C		; YES, MAKE IT THE CURRENT WIRE
	 FETCH(G,C,WPIN)	;NO, GET REAL HEAD
QNMERG:	TRNN ISBACK		;WR FOR BP ONLY
	 POPJ P,
	FETCH(T,G,WRN)
	HRRZ TT,WQNWRD
	PUSHJ P,WHCHRN
	PUSHJ P,WHERRP
	STORE(T,G,WRN)
	POPJ P,

; A second name for this wire (G) already had a wire of its own (C)
; Merge the two wires into one
WASEQV:	MOVE B,C
	FETCH(T,B,WBIT)
	TRNE T,NAM2ND
	 FETCH(B,B,WPIN)
	CAIE B,(G)		;ON CURRENT WIRE?
	PUSHJ P,LMERGE		;NO, MERGE THEM
	JRST QNMERG		;PICKUP QN

; This name is new, but is equivalent to an existing wire,
;  sort this name into signal list, and merge with the equivalent.
ISEQV:	PUSH P,E		;THE EQUIVALENT SIGNAL
	PUSH P,C
	PUSHJ P,NEQSET		;MAKE WIRE HEADER AND NAME
	POP P,C			; WHERE TO INSERT
	POP P,E			; WHERE EQUIVALENT NAME IS
	EXCH C,E		;C WANTS EQUIVALENT ONE REGARDLESS
	CAME C,E		;WILL EQUIVALENT ONE BE OUR NEXT ?
	 JRST ISEQV1		;NO, THEN WE CAN'T BE FIRST
	FETCH(T,C,WBIT)		;YES, GET ITS BITS
	TRZN T,SIG1		;IS IT SIG 1?
	 JRST ISEQV1		;NO, WE AREN'T EITHER
	STORE(T,C,WBIT)		;YES, TURN IT OFF
	JRST WASEQV		;NOW WE ARE FIRST

ISEQV1:	FETCH(T,G,WBIT)		;WE AREN'T FIRST, TURN OFF BIT
	TRZ T,SIG1
	STORE(T,G,WBIT)
	JRST WASEQV

; Completely new name, add to current wire
NEQ:	MOVE T,G
	SKIPE T
	 FETCH(T,G,WBIT)
	PUSH P,T		;SAVE OLD STATE OF SPWR
	PUSHJ P,NEQSET		;WILL TURN ON SIG1 WHICH IS CORRECT
	POP P,TT
	FETCH(T,G,WBIT)		;WIRE NOW IS A PWR RUN?
	TRNE T,SPWR
	TRNE TT,SPWR		;AND WASN'T BEFORE
	 JRST QNMERG
	FETCH(A,G,WVOL)		;THIS DOESN'T CHECK FOR TWO VOLTAGES ON SAME WIRE
	PUSHJ P,FNDPWR		;FIND CANONICAL FORM OF THAT PWR (+5.0V = +5.00V = VCC)
	 JRST [	FETCH(T,G,WVOL)	;DOESN'T EXIST, MAKE IT!
		JRST MAKPWR]
	JRST WASEQV		;YES, MERGE IT ONTO THAT POWER RUN

; Un-Interned name, enter it, as a 2nd name if wire already started
NEQSET:	JUMPE G,SETG		;NOT STARTED, JUST ENTER
	PUSH P,G
	PUSHJ P,SETG		;GET HEADER BLOCK FOR SECOND NAME
	FETCH(T,G,WBIT)
	TRO T,NAM2ND		;MARK AS SECOND BLOCK
	STORE(T,G,WBIT)
	MOVEM G,SAVET		;SAVE THIS POINTER HERE
	POP P,G			;RESTORE REAL WIRE POINTER
	JRST TMERGE		;SORT IN NEW SIGNAL NAME
;NULTXT - NO NAME FOR WIRE, CREATE ONE
;RETURNS
;G = CREATED WIRE HEADER

NULTXT:	PUSH P,TTT
	TRNN ISBACK
	 TRNN PCNOTD
	 SKIPA TT,[GENLEN+1+5]
	 MOVEI TT,GNPCLN+1+5	;ENOUGH FOR GEN NAME + % + 0
	PUSH P,TT
	FETCH(T,W,NGEN)		;IN CASE WE HAVE TO USE THIS
	ADDI T,1
	MOVEI TTT,1+5		;% + 0
NULTX1:	IDIVI T,=10
	ADDI TTT,1
	JUMPN T,NULTX1
	POP P,TT
	CAMGE TT,TTT
	MOVE TT,TTT		;USE LARGEST
	IDIVI TT,5
	SETOM CMPWRD
	SOS CMPWRD		;LEAVE US NOT GET THE LOW ORDER BIT ON
	MOVE T,[CMPWRD,,PERMTB]
	BLT T,CMPWRD-1(TT)	;MARK ENOUGH SPACE
	SETZM PERMTB-1(TT)	;FOR GEN NAME LATER
	SETZM SAVBIT		;SIMULATE BITS FROM PERMUT
	PUSHJ P,SETGEN		;WILL TURN ON SIG1 AS IT SHOULD
	CLEAR(G,NNAM)		;CLEAR NEXT NAME POINTER (THIS IS ONLY ONE)
	FETCH(TTT,G,WBIT)
	TRO TTT,GENSIG		;MARK AS GENERATED
	STORE(TTT,G,WBIT)
	POP P,TTT
	POPJ P,

;FINGEN - FINISH GENERATED NAME

FINGEN:	PUSHJ P,FNSNGL		;FIRST TRY TO FIND ANOTHER UNAMED RUN WITH SAME PIN
	 POPJ P,		;FOUND ONE
;Make generated name, try to make it the name of some pin on run
	MOVE B,[POINT 7,STRTAB]
	MOVE T,[IDPB TTT,B]
	EXCH T,PUTCHR
	MOVEM T,SVPTCH
	PUTBYT GENCHR
	FETCH(T,G,TBIT)		;WIRE TYPE BITS
	TRNE ISBACK
	 JRST FINGNC		;FOR BACK, BODY LOCN, PINN IS SLOT, PADDLE-PIN
	TRNN PCNOTD		;ONLY FOR WD FILES
	TRNN T,ANYCON		;AND CONNECTOR
	JRST FINGN0
	FETCH(A,W,FCRD)		;UNNAMED BACKPANEL RUN, ADD SLOT TO MAKE UNIQUE
	JUMPE A,FINGNA		; NO SLOT
	PUSHJ P,SLTOUT		;PREFIX SLOT ON NAME
	PUTBYT 40
FINGNA:	PUSHJ P,FINGN0		;FINISH NAME BEFORE PRINTING IT
FINGNB:	PUTSTR[ASCIZ/UNNAMED BACKPANEL RUN:
/]
	PUTSIG ADDR(G,SPNT)
	PUTSTR[ASCIZ/
/]
	POPJ P,

FINGNC:	PUSHJ P,FINGN5
	JRST FINGNB

FINGN5:	FETCH(A,G,WPIN)
	JUMPE A,FINGN3		;USE NUMBER IF NO PIN!!!!
	FETCH(T,A,PBDY)
	FETCH(T,T,BLOC)
	FETCH(A,A,PINN)
	HRL A,T
	SETZ T,			;NO OFFSET
	PUSHJ P,BPNPIN
	JRST FINGN1

FINGN3:	FETCH(T,W,NGEN)		;NOTHING BETTER THAN GENSYM
	ADDI T,1
	STORE(T,W,NGEN)
	PUSHJ P,DECOUT
	JRST FINGN1

FINGN0:	MOVE A,LOSNAM		;PIN#,,LOC OF BEST LABELING FOR THIS RUN
	JUMPE A,FINGN3		; NONE
	MOVE T,LOSBIT
	TRNE T,ANYCON		;CON?
	 JRST [	PUSHJ P,LOCPNC
		JRST FINGN1]
	PUSHJ P,LOCPIN
FINGN1:	SETZ T,			;FINISH OFF GENERATED NAME
	IDPB T,B
	TLNE B,760000
	JRST .-2
	MOVE T,SVPTCH
	MOVEM T,PUTCHR
	SETZM SAVBIT
	MOVE T,STRTAB
	STORE(T,G,SCMP)
	MOVEI T,-1+ADDR(G,SPNT)
	MOVEI TT,STRTAB-1
FINGN4:	ADDI T,1
	ADDI TT,1
	MOVE TTT,(TT)
	TRNN TTT,376
	JRST [	MOVEM TTT,(T)	;WIN
		JRST GALPH]
	EXCH TTT,(T)
	TRNE TTT,376		;DOES OLD STRING END?
	JRST FINGN4
	PUTSTR[ASCIZ/MOBY LOSSAGE, I THOUGHT I ALLOCATED ENOUGH SPACE
BUT I RAN OUT, TRUNCATED SIGNAL IS:
/]
	PUTSIG ADDR(G,SPNT)
	PUTSTR[ASCIZ/
/]
GALPH:	MOVEI T,ADDR(G,SCMP)
	MOVEM T,SAVET
	PUSHJ P,GENFND		;FIND PLACE FOR IT
	 JFCL			;DON'T CARE IF NEQ, EQV, EQU
	 JFCL
	STORE(G,B,ALPH)
	STORE(C,G,ALPH)		;LINK IN
	JRST GENHSH		;FIX HASH TABLE ENTRIES
;		FIND ANOTHER WSINGL!GENSIG WITH SAME PIN
FNSNGL:	FETCH(T,G,WBIT)
	TRNN T,WSINGL		;ARE WE SINGLE PIN?
	JRST CPOPJ1		;NO
	FETCH(E,G,WPIN)		;GET POINTER TO FIRST PIN
	FETCH(A,E,PBDY)
	FETCH(T,E,PINN)
	MOVEM T,PINNUM
	FETCH(T,E,PBIT)
	TRNE T,PIDPIN
	JRST CPOPJ1
	FETCH(T,A,BBIT)
	TRNN T,CBODY		;CON?
	JRST FNPBDY		;NO, FIND BODIES
	PUSHJ P,FNSNPN		;CHECK THIS BODY FOR PIN
	POPJ P,			;FOUND
	JRST CPOPJ1			;NOT FOUND, BUT NO MORE BODIES TO CHECK

FNPBDY:	FETCH(T,A,BLOC)
	JUMPE T,CPOPJ1
	MOVEM T,PINLOC
	FETCH(T,A,DIPT)
	MOVEM T,LSTDIP
	MOVEI A,RADDR(W,WBDY,NXTB)
	JRST FNPB1

FNPB2:	FETCH(T,A,BBIT)
	TRNE T,CBODY		;CON?
	JRST CPOPJ1			;YES, LOSE
	FETCH(T,A,BLOC)
	CAMGE T,PINLOC
	JRST FNPB1
	CAME T,PINLOC
	JRST CPOPJ1			;NO MORE BODIES
	FETCH(T,A,DIPT)
	CAME T,LSTDIP
	JRST FNPB1
	PUSHJ P,FNSNPN		;SEARCH FOR PIN
	POPJ P,			;FOUND AND MERGED
FNPB1:	FETCH(A,A,NXTB)
	JUMPN A,FNPB2
	JRST CPOPJ1

FNSNPN:	MOVEI C,RADDR(A,BPIN,NXBP)
	JRST FNPN1

FNPN2:	FETCH(T,C,PINN)
	CAMGE T,PINNUM
	JRST FNPN1
	CAME T,PINNUM
	JRST CPOPJ1
	FETCH(T,C,PBIT)
	TRNE T,PIDPIN
	JRST FNPN1
	FETCH(B,C,HPNT)
	CAIN B,(G)
	JRST FNPN1
	FETCH(T,B,WBIT)
	TRC T,WSINGL!GENSIG
	TRCN T,WSINGL!GENSIG
	JRST GENMER		;MERGE PINS
FNPN1:	FETCH(C,C,NXBP)
	JUMPN C,FNPN2
	JRST CPOPJ1		;NOT FOUND

GENMER:	EXCH B,G		;USE OLD ONE (MAY ALREADY HAVE MULTIPLE PINS)
	FETCH(T,B,WPIN)
	HRLM T,(P)		;SAVE PIN LIST HERE TO MERGE LATER
GENMR1:	HLRZ E,(P)
	JUMPE E,CPOPJ
	FETCH(T,E,NXTP)
	HRLM T,(P)
	PUSHJ P,PMERGE
	JRST GENMR1
;		SETG, TXTFND, TMERGE, LMERGE
SETGEN:	PGETFS(G,WHEAD)
	BCLEAR(T,G,WHEAD)
	JRST SETGN1

;SETG - splice in new Wire Header between B and C
; 	 uses contents of CMPWRD, PERMTB, VOLTAGE, and SAVBIT

SETG:	PGETFS (G,WHEAD)
	BCLEAR(T,G,WHEAD)	;CLEAR OUT BLOCK
	STORE(G,B,ALPH)
	STORE(C,G,ALPH)
	PUSHJ P,FIXHSH		;FIXUP HASH TABLE POINTERS
SETGN1:	MOVE TTT,CMPWRD
	MOVEM TTT,ADDR(G,SCMP)	;COMPARE WORD
	MOVEI T,PERMTB
	MOVEI TT,ADDR(G,SPNT)	;START OF PRINT NAME
SETG1:	MOVE TTT,(T)
	CAMLE TT,.JBREL
	 JSR MORCOR
	MOVEM TTT,(TT)
USAGE,<	AOS FSTCNT	>
	ADDI TT,1
	TRNE TTT,376
	 AOJA T,SETG1
USAGE,<	SOS FSTCNT	>
	MOVEM TT,FSTOP		;THIS COUNTS ON PGETFS BEING USED ABOVE
	MOVEI T,SIG1!WNULL	;ASSUME THESE (CALLER WILL FIX)
	IOR T,SAVBIT		;AND ADD THESE
	STORE(T,G,WBIT)		;STORE IN WIRE HEADER
	TRNN T,SPWR
	 POPJ P,
	MOVE T,VOLTAG
	STORE(T,G,WVOL)
	POPJ P,


;GENHSH, FIXHSH
;Fixup hash table pointers
;CMPWRD = asciz for entry just made
;B = previous pointer for the entry just made

GENHSH:	TDZA T,T
FIXHSH:	LDB T,[POINT HASHB,CMPWRD,HASHB-1]
	ADDI T,ADDR(W,HASHTB)
	SKIPN TTT,(T)
	 JRST [	HRLM B,(T)	;THIS IS LAST FOR LAST LIST
		JRST FXHSH1]	;NOW STORE US AS LAST FOR THIS LIST AND FIX NEXT BUCKET
	CAIE B,(TTT)		;IS OUR LAST THE OLD LAST FOR THIS LIST?
	 POPJ P,
FXHSH1:	HRRM G,(T)		;YES, MAKE US NEW LAST
	ADDI T,1		;ADVANCE TO NEXT BUCKET
FXHSH2:	CAIL T,HASHL+ADDR(W,HASHTB)	;NO MORE BUCKETS?
	 POPJ P,		;NOPE, LEAVE NOW
	SKIPN (T)		;FIND NEXT NON-ZERO BUCKET
	 AOJA T,FXHSH2		;KEEP LOOKING
	HRLM G,(T)		;FIX IT'S LAST LAST POINTER TO OUR LAST POINTER
	POPJ P,

;GENFND, TXTFND - Find cmpwrd in SAVET, PERMTB in hash table for wirelist (W)
; (May find SPWR in SAVBIT, use VOLTAG)
;	PUSHJ P,TXTFND
;	 Wasn't found - insert here
;	 Wasn't found, but equivalent is in E
;	 Found
; Returns C = matching wire header, or place to insert
;	  B = previous entry

GENFND:	SETZ T,
	JRST GENFN1

TXTFND:	MOVE T,SAVET
	LDB T,[POINT HASHB,(T),HASHB-1]	;GET HASH VALUE
GENFN1:	ADDI T,ADDR(W,HASHTB)		;ADD ADDRESS OF HASH TABLE
	SKIPN A,(T)			;PICKUP HASH TABLE ENTRY
	 JRST TXTFST			;THIS IS FIRST IN THIS BUCKET
	HLRZ C,A
	SETZ E,
	JRST TXTFN2

TXTFN1:	MOVEI TT,ADDR(C,SCMP)	;GET SIGNAL NAME POINTER
	MOVE T,SAVET
	PUSHJ P,ALPHA
	 JRST TXTFNT		;T LESS THAN TT, IT GOES HERE
	 JRST TXTFN2		;T GREATER THAN TT, KEEP LOOKING
	 JRST TXTFNF		;T EQV TT, T LESS THAN TT
	 JRST TXTFNE		;T EQV TT, TT LESS THAN T
	JRST CPOPJ2		;T EQUAL TT

TXTFNF:	MOVE E,C		;THIS IS THE ONE
	JRST CPOPJ1

TXTFNE:	MOVE E,C		;SAVE POINTER TO EQUIVALENT ONE
TXTFN2:	MOVE B,C
	FETCH(C,C,ALPH)
	CAIE B,(A)		;WAS THAT THE LAST ONE?
	JUMPN C,TXTFN1		;NO, END OF LIST?
TXTFNT:	JUMPN E,CPOPJ1		;IF EQUIVALENT SEEN, SKIP
	 POPJ P,		;NOT FOUND, B,C IS WHERE IT GOES

TXTFST:	MOVE A,T
	SKIPN B,(A)
	SOJA A,.-1		;BACK UP TO FIRST NON-ZERO ENTRY
	HLLI B,
	FETCH(C,B,ALPH)		;NEXT FROM HIM
	POPJ P,			;RETURN POINTERS

;FNDPWR - FIND AN SPWR SIGNAL WITH GIVEN VOLTAGE
;A = VOLTAGE
;SKIPS IF FOUND
;C = MATCHING SIGNAL

FNDPWR:	HRRZS A
	MOVEI C,RADDR(W,WIRES,ALPH)
	JRST FNDPW1

FNDPW2:	FETCH(T,C,WBIT)
	TRNE T,SCANON		;THE CANONICAL FORM?
	TRNN T,SPWR		;AND POWER?
	 JRST FNDPW1
	FETCH(TT,C,WVOL)
	CAIN A,(TT)
	 JRST CPOPJ1
FNDPW1:	FETCH(C,C,ALPH)
	JUMPN C,FNDPW2
	POPJ P,

;TMERGE - Merge signal block in SAVET into NAM2ND list of G

TMERGE:	PUSH P,B
	PUSH P,C
	MOVE B,G		;START HERE
TMERG1:	MOVEI TT,ADDR(B,SCMP)
	MOVE T,SAVET
	MOVEI T,ADDR(T,SCMP)
	PUSHJ P,ALPHA
	 JRST LNKTXT		;WE'RE HERE
	 JRST TMERG2		;NOT YET
	 JRST LNKTXT
	 JRST TMERG2
	FETCH(T,B,WBIT)
	TRNE T,GENSIG		;THESE MAY BE EQUAL
	JRST LNKTXT
	PUTSTR[ASCIZ/LOSE BIG, EQUAL RETURN FROM ALPHA AT TMERGE, SIGNAL IS :
	/]
	PUTSIG ADDR(B,SPNT)
	PUTSTR[ASCIZ/
/]
	JRST LNKTXT

TMERG2:	MOVE C,B
	FETCH(B,B,NNAM)
	JUMPN B,TMERG1		;NEXT?
LNKTXT:	CAIN B,(G)		;WILL NEW SIGNAL BE AHEAD OF G ?
	 JRST LNKTX1		;YES, IT'S THE NEW HEADER
; The new name is an altername of header (G), link in and absorb its wire 
	MOVE TTT,SAVET
LNKTX2:	STORE(B,TTT,NNAM)	;LINK NEW BLOCK INTO NAME LIST
	STORE(TTT,C,NNAM)
	TRNN ISBACK		;ONLY BP HAS WRN
	 JRST LNKT2A
	FETCH(T,G,WRN)		;MERGE WIRE-RULES
	FETCH(TT,TTT,WRN)
	PUSHJ P,WHCHRN
	PUSHJ P,WHERRP
	STORE(T,G,WRN)
LNKT2A:	FETCH(T,TTT,WBIT)	;MERGE SIGNAL BITS
	ANDI T,SIGBIT
	FETCH(TT,G,WBIT)
	IOR TT,T
	STORE(TT,G,WBIT)	;INTO HEADER BLOCK
	FETCH(T,TTT,WBIT)
	TRON T,NAM2ND		;MARK AS SECOND
	 JRST LNKTX3		;HAS WIRE, STORE BITS AND MERGE WIRES
	STORE(G,TTT,WPIN)	;ALREADY SECOND, LINK BACK TO NEW HEADER POINTER
TMERGX:	POP P,C
	POP P,B
	POPJ P,

; New signal is new wire header, replace old header, update 2ND name links
LNKTX1:	MOVE TTT,SAVET
	FETCH(T,TTT,WBIT)
	TRZE T,NAM2ND		;NEW WILL NO LONGER BE SECOND
	JRST [	CLEAR(TTT,WPIN)	;CLEAR POINTER IF WAS SECOND (NO PINS)
		TRZ T,WSINGL	;NOT SINGLE
		TRO T,WNULL	;AND IS NULL (TO START WITH)
		JRST .+1]
	STORE(T,TTT,WBIT)	;STORE BITS BACK
	FETCH(T,G,NNAM)		;COPY OVER HEADER'S LIST OF 2ND NAMES
	STORE(T,TTT,NNAM)
	JUMPE T,LNKTXA
LNKTXB:	STORE(TTT,T,WPIN)	;POINT SECOND NAMES TO NEW HEADER
	FETCH(T,T,NNAM)
	JUMPN T,LNKTXB
LNKTXA:	EXCH TTT,G		;MAKE NEW THE HEADER, AND MERGE OLD HEADER AFTER IT
	MOVE C,G		;SETUP LINKS
	FETCH(B,C,NNAM)
	JRST LNKTX2

; Absorb pins of new 2ND name onto header's wire
LNKTX3:	STORE(T,TTT,WBIT)	;STORE BACK BITS
	FETCH(E,TTT,WPIN)	;PIN LIST POINTER
	STORE(G,TTT,WPIN)	;REPLACE WITH HEADER POINTER
	JUMPE E,TMERGX		;DONE IF NO WIRES
LNKTX4:	FETCH(T,E,NXTP)
	HRLM T,(P)		;SAVE NXTP
	PUSHJ P,PMERGE		;MERGE PIN IN B INTO LIST G
	HLRZ E,(P)		;GET NXTP BACK
	JUMPN E,LNKTX4
	JRST TMERGX

;LMERGE - Merge 2 wires, pointer to current in G, other in B

LMERGE:	MOVEM B,SAVET
	FETCH(T,B,NNAM)		;GET NEXT LINK NOW
	HRLM T,(P)		;SAVE IT
	PUSHJ P,TMERGE		;MERGE, LOOKING FORWARD FROM HERE
	HLRZ B,(P)		;GET NEXT POINTER
	JUMPN B,LMERGE		;LOOP FOR ALL THE TEXT
	POPJ P,
;		READ PINS AND FIND THEIR BODIES

PINLOP:	XCT GETCHR		;READ NEXT PIN ON WIRE
	 JRST ILLEND
	JUMPN TTT,PINLP2	; MORE PINS?
	XCT GETCHR		;ALL PINS IN, GET 0,,RUNBITS
	 JRST ILLEND
	JUMPE G,DIDWIR		;NO PLACE TO PUT THEM IF NO RUN
	TRNN TTT,CABBDY		;THIS IS ONLY INTERESTING BIT FOR NOW
	 JRST DIDWIR
	FETCH(T,G,WBIT)
	TRO T,CABRUN		;FLAG AS CABLE RUN
	STORE(T,G,WBIT)
	JRST DIDWIR

PINLPA:	TRNE ISBACK		;ALREADY GOT FIRST WORD IN TTT
	 JRST BPNLP0		;BACK PANEL STUFF?
PINLP2:	SKIPN G			;ADD PIN TO WIRE BEING READ IN
	 PUSHJ P,NULTXT		;CREATE GENERATED WIRE (INTO G)
	TLNE TTT,-1		;CONNECTOR PIN?
	 JRST DOBODQ		; YES
	MOVEM TTT,BID		;NO, THIS IS BODY ID
	XCT GETCHR		;GET PIN ID,,PIN #
	 JRST ILLEND
	HRRZM TTT,PINNUM
	HLRZM TTT,PID
	SETZM PINTMP
	TRNE PCNOTD
	 JRST NOPTMP
	XCT GETCHR
	 JRST ILLEND
	HLLZM TTT,PINTMP	;STORE PIN BITS (NOTHING IN RIGHT HALF YET)
NOPTMP:	PUSHJ P,BODFNB		;FIND BY BID ALONE
	 JRST PINLOP		;NOT FOUND, MUST NOT BE ON THIS CARD, LOOP BACK
	JRST NCNPIN

DOBODQ:	MOVS TTT,TTT	;SWAP IT BACK
	MOVE T,TTT
	PUSHJ P,CPNSEP		;SEPARATE BODY LOC AND PIN NUMBER
	MOVEM TT,PINNUM
	MOVEM T,PINLOC
	SETZM BID
	PUSH P,TTT
	XCT GETCHR		;APPROX X,Y ,, CPIN ID
	 JRST ILLEND
	HRRZM TTT,PID
	HLRZM TTT,PINTMP
	TRNE PCNOTD
	 JRST DOBDQ1
	XCT GETCHR		;GET BITS,,0
	 JRST ILLEND
	HLLM TTT,PINTMP		;STORE BITS HERE
DOBDQ1:	POP P,TTT		;B-R-S,,CPIN LOC/PIN
	HRRI TTT,
	JUMPE TTT,BLNKCD	;BLANK OR
	CAME TTT,SLICEL		;RIGHT SLICE?
	 JRST PINLOP		;NO, SKIP IT
BLNKCD:	PUSHJ P,BODFNC		;FIND BODY FOR CON
NCNPIN:	MOVE F,A		;PUT BODY POINTER IN SAFE PLACE
	PUSHJ P,PMAKE		;NOW MAKE PIN BLOCK, AND SETUP TYPE POINTER
	PUSHJ P,PMERGE		;AND MERGE IT INTO THE WIRE
	JRST PINLOP

;	READ PINS (BACKPANEL)

BPINLP:	XCT GETCHR		;READ PPS,,CPIN ID
	 JRST ILLEND
	JUMPE TTT,DIDWIR	;QUIT ON 0
BPNLP0:	SKIPN G
	 PUSHJ P,NULTXT		;NO SIGNAL NAME BLOCK YET, MAKE ONE
	HRRZM TTT,PID
	HLRZM TTT,PINNUM
	XCT GETCHR
	 JRST ILLEND
	MOVEM TTT,PINTMP	;STORE 0,,APPROX X/Y
	XCT GETCHR		;FILENAME
	 JRST ILLEND
	MOVE E,TTT
	XCT GETCHR
	 JRST ILLEND
	HLRZ F,TTT		;EXT ONLY FOR NOW
	XCT GETCHR		;PPN
	 JRST ILLEND
	EXCH F,TTT
	PUSHJ P,BPFFIL		;FIND FILE BLOCK
	MOVEM T,THSFIL		;FILE POINTER
	MOVE F,BSLOT		;SLOT BODY POINTER
	PUSHJ P,PMAKE		;MAKE PIN BLOCK
	PUSHJ P,PMERGE		;MERGE WITH OTHERS
	JRST BPINLP		;AND LOOP BACK FOR MORE

;BPFFIL - FIND BP FILE BLOCK
;CALL WITH FILNAME IN E
;AND PPN IN F
BPFFIL:	MOVEI T,RADDR(L,BKNM,FNXT)
	PUSH P,TTT		;SAVE EXT ON STACK
	JRST BPNLP2

BPNLP1:	CAMGE E,ADDR(T,FILN)
	 JRST BPNLOS
	CAME E,ADDR(T,FILN)
	 JRST BPNLP2
	FETCH(TTT,T,FEXT)
	CAMLE TTT,(P)
	 JRST BPNLOS
	CAME TTT,(P)
	 JRST BPNLP2
	CAMGE F,ADDR(T,FPPN)
	 JRST BPNLOS
	CAMN F,ADDR(T,FPPN)
	 JRST [	POP P,(P)
		POPJ P,]
BPNLP2:	MOVE TT,T
	FETCH(T,T,FNXT)
	JUMPN T,BPNLP1
BPNLOS:	PGETFS(T,FBLK)
	BCLEAR(TTT,T,FBLK)
	FETCH(TTT,TT,FNXT)
	STORE(TTT,T,FNXT)
	STORE(T,TT,FNXT)
	STORE(E,T,FILN)
	POP P,TTT
	STORE(TTT,T,FEXT)
	STORE(F,T,FPPN)
	MOVE B,T
	PUTSTR[ASCIZ/NO FILE BLOCK FOR /]
	PUTSIX ADDR(B,FILN)
	PUTBYT "."
	FETCH(T,B,FEXT)
	HRLZ T,T
	PUTSIX T
	PUTBYT "["
	HLLZ TT,ADDR(B,FPPN)
	PUSHJ P,LSIXOUT
	PUTBYT ","
	HRLZ TT,ADDR(B,FPPN)
	PUSHJ P,LSIXOUT
	PUTBYT "]"
	PUTSTR[ASCIZ/, SO I MADE ONE!
/]
	MOVEI A,RADDR(L,BKNM,FNXT)
	PUSHJ P,FILMR1		;SORT INTO LIST
	MOVE T,B
	POPJ P,

;PMAKE - MAKE POINT ENTRY
;G = WIRE
;F =  BODY 
;WQNWRD = Qualifier/rule number stuff
;BAKBIT = Bits from on-board wirelist
;RETURNS PIN POINTER IN E

PMAKE:	TRNN ISBACK		;BACK PANEL?
	 JRST PMAKEA
	GETFS(E,BPHEAD)
	BCLEAR(TTT,E,BPHEAD)	;CLEAR OUT BLOCK
	SETZ TT,
	PUSHJ P,CAPPXY		;GET CON APPROX X,Y
	STORE(TT,E,PBIT)
	MOVE TTT,PINNUM
	STORE(TTT,E,PINN)
	HLRZ TT,WQNWRD		;ANY Q FOR THIS PIN?
	JUMPN TT,BPMAK0		;YES
	HLRZ TT,BAKBIT		;GET WBITS FROM BOARD WIRELIST
	TRNN TT,CABRUN		;CABLE RUN?
	 JRST BPMAK1		;NO
	FETCH(TT,E,PBIT)
	TRNE TT,QBITS		;ALREADY GOT Q LETTER?
	 JRST BPMAK1		;YES, SKIP
	MOVE TT,QL2N+"C"	;GET Q NUMBER FOR "C"
BPMAK0:	FETCH(TTT,E,PBIT)
	TRZ TTT,QBITS
	ANDI TT,QBITS
	TRO TTT,(TT)
	STORE(TTT,E,PBIT)
BPMAK1:	HRRZ TT,BAKBIT
	JUMPE TT,BACMAK
	HLLZS BAKBIT		;MAKE SURE ONLY ONE PIN PER CARD PER RUN
	STORE(TT,E,CBIT)	;STORE CON/CARD BITS
	HLRE T,BAKOLD		;HI IN
	STORE(T,E,HILD)
	HRRE T,BAKOLD		;LOW IN
	STORE(T,E,LILD)
	HLRE T,BAKILD		;HI OUT
	STORE(T,E,HOLD)
	HRRE T,BAKILD		;LOW OUT
	STORE(T,E,LOLD)
	MOVE T,BAKSFL
	STORE(T,E,FILO)		;STORE SOURCE FILE BLOCK POINTER
	JRST BACMAK

CAPPXY:	HRRZ TTT,PINTMP
	JUMPE TTT,CPOPJ
	TRO TT,CANYPOS
	SUBI TTT,1001
	DPB TTT,[POINT CXPOSL,TT,35-CXPOSB]
	LSH TTT,-9
	DPB TTT,[POINT CYPOSL,TT,35-CYPOSB]
	POPJ P,

PMAKEA:	PGETFS(E,PHEAD)
	BCLEAR(TTT,E,PHEAD)	;CLEAR OUT BLOCK
	FETCH(TT,F,BBIT)
	TRNE TT,CBODY
	 JRST [	LDB TT,[POINT CPNBSZ,PINTMP,CPNBPS]
		LSH TT,=18-(TRMBPS+1)	;POSITION TO ADD POS INFO
		PUSHJ P,CAPPXY
		JRST PMAKPN]
	MOVE TTT,PINTMP
	TLNN TTT,DEFPIN
	 TDZA TT,TT
	 MOVEI TT,PIDPIN
PMAKPN:	MOVE TTT,PINNUM
	STORE(TTT,E,PINN)
	STORE(TT,E,PBIT)	;STO BITS
	MOVE TTT,PID
	STORE(TTT,E,PID)
BACMAK:	MOVE TTT,THSFIL		;FILE POINTER
	STORE(TTT,E,FILP)
	STORE(F,E,PBDY)
;PMAKE - CONT'D
;NOW SORT INTO BODY PIN LIST BY PIN #
	MOVEI T,RADDR(F,BPIN,NXBP)
	JRST PMAKE1

PMAKE2:	FETCH(TTT,T,PINN)
	CAMGE TTT,PINNUM	;THERE YET?
	 JRST PMAKE1
	TRNN PCNOTD
	 CAME TTT,PINNUM
	 JRST PMAKE3		;YES, STICK US IN
PMAKE1:	MOVE TT,T
	FETCH(T,T,NXBP)
	JUMPN T,PMAKE2
PMAKE3:	FETCH(T,TT,NXBP)
	STORE(T,E,NXBP)
	STORE(E,TT,NXBP)
	TRNE ISBACK		;NOT FOR BACK PANEL LIST
	POPJ P,			;ALL DONE IF BACK PANEL LIST
;FALL INTO PTLINK
;PTLINK - FIND PIN TYPE POINTER --
; BODY IN F, PIN BLOCK IN E
;PIN # IN PINNUM
;(Returns T = 0 if link fails )

PTLINK:	FETCH(T,F,DIPT)		;DIP POINTER
	JUMPE T,CPOPJ		;LEAVE NOW IF NONE
	MOVEI T,RADDR(T,DPIN,DPNXT)
	JRST PTLNK2
PTLNK1:	FETCH(TTT,T,DPNM)
	CAMN TTT,PINNUM
	 JRST ISPNTR
PTLNK2:	FETCH(T,T,DPNXT)
	JUMPN T,PTLNK1
	POPJ P,

;Found pointer, store it and collect bits and pin types
ISPNTR:	STORE(T,E,PTYP)
	MOVEM T,TMPCN1		;SAVE FOR COMPARISON LATER
	FETCH(TT,T,DPBIT)	;GET DIP PIN TYPE BITS
	TRNN TT,PWR!GND		;ARE WE ADDING A POWER/GROUND PIN?
	 POPJ P,
; Remove invented PWR/GND pin if explicit in drawing
	FETCH(T,F,BLOC)		;GET BODY LOC
	MOVEM T,PINLOC		;SAVE HERE

	MOVEI T,RADDR(W,WBDY,NXTB)
	JRST UNINV2
UNINV1:	FETCH(TT,T,BBIT)
	TRNE TT,CBODY
	 JRST UNINV2
	FETCH(TT,T,BLOC)
	CAMGE TT,PINLOC		;GOT TO RIGHT LOC YET?
	 JRST UNINV2		;NO
	CAME TT,PINLOC		;YES, AT OR PAST?
	 JRST UNINVX		;PAST

	MOVEI TT,RADDR(T,BPIN,NXBP)
	JRST UNINV4
;Found body in same loc, look for invented version of same pin
UNINV3:	FETCH(TTT,TT,PBIT)
	TRNN TTT,INVENT		;INVENTED PIN?
	 JRST UNINV4		;NO
	FETCH(TTT,TT,PTYP)
	CAMN TTT,TMPCN1		;SAME DIP PIN?
	 JRST UNINV5		;YES
UNINV4:	MOVEM TT,TMPCN2
	FETCH(TT,TT,NXBP)
	JUMPN TT,UNINV3
UNINV2:	FETCH(T,T,NXTB)
	JUMPN T,UNINV1
UNINVX:	MOVE T,TMPCN1		;RETURN TYPE BLOCK
	POPJ P,

;Remove invented pin from Body's pin list
UNINV5:	MOVE T,TMPCN2
	FETCH(TTT,TT,NXBP)
	STORE(TTT,T,NXBP)	;LINK PIN OUT OF BODY LIST
	FETCH(T,TT,HPNT)	;GET WIRE HEADER
	MOVEI T,RADDR(T,WPIN,NXTP)
	JRST UNINV7

;Also remove invented pin from it's wire
UNINV6:	CAIN T,(TT)		;GET TO US YET?
	 JRST UNINV8
UNINV7:	MOVE TTT,T
	FETCH(T,T,NXTP)
	JUMPN T,UNINV6
	OUTSTR [ASCIZ /MOBY LOSSAGE - PIN NOT FOUND IN ITS WIRE AT UNINV7.
/]
	JRST UNINVX

UNINV8:	FETCH(T,TT,NXTP)
	STORE(T,TTT,NXTP)	;LINK PIN OUT OF WIRE
	FSTRET(TT,PHEAD)	;RETURN PIN
	JRST UNINVX

;PMERGE - MERGE PIN ONTO WIRE
;ENTER WITH PIN POINTER IN E, WIRE POINTER IN G

PMERGE:	FETCH(F,E,PBDY)		;BODY POINTER
	FETCH(T,F,BLOC)
	MOVEM T,PINLOC
	STORE(G,E,HPNT)
	FETCH(T,E,PINN)
	MOVEM T,PINNUM
;SORT INTO WIRE BY LOC AND PIN #
	MOVEI T,RADDR(G,WPIN,NXTP)
	FETCH(A,E,PBDY)
	FETCH(TT,A,DIPT)
	MOVEM TT,LSTDIP
	FETCH(A,A,BBIT)
MKPBK:	MOVE TT,T
	FETCH(T,TT,NXTP)
	JUMPE T,MKPBK1
	FETCH(TTT,T,PBDY)
	FETCH(TTT,TTT,BBIT)
	TRNN TTT,CBODY
	 JRST [	TRNE A,CBODY
		 JRST MKPBK	;NOT THERE YET
		JRST MKPBKC]
	TRNN A,CBODY
	 JRST MKPBK1
MKPBKC:	FETCH(TTT,T,PBDY)
	FETCH(TTT,TTT,BLOC)
	CAMLE TTT,PINLOC	;HAVE WE PASSED IT?
	 JRST MKPBK1		;YES
	CAME TTT,PINLOC		;EQUAL?
	 JRST MKPBK		;NO, GO ON
	FETCH(TTT,T,PINN)	;YES, CHECK PIN #
	CAMGE TTT,PINNUM	;THIS IT?
	 JRST MKPBK		;NO, LOOP
	FETCH(TTT,E,PBIT)
	TRNN TTT,PIDPIN		;NO DUP IF PID HERE
	 SKIPN PINLOC
	 JRST MKPBK1		;NO DUP IF NO LOC
	FETCH(TTT,T,PINN)	;SETUP PIN # AGAIN
	TRNN PCNOTD		;NO SUCH FEATURE FOR PC CARDS
	 CAME TTT,PINNUM		;SAME PIN AS WELL AS LOC?
	 JRST MKPBK1		;NO, DO NORMAL THING
	FETCH(TTT,T,PBIT)
	TRNE TTT,PIDPIN		;IF HE IS PID
	 JRST MKPBK		;THEN KEEP LOOKING
	FETCH(TTT,T,PBDY)
	FETCH(TTT,TTT,DIPT)
	CAME TTT,LSTDIP		;MUST BE SAME DIP TYPE
	 JRST MKPBK
	FETCH(A,E,PBIT)
	TRO A,DUP
	STORE(A,E,PBIT)
	FETCH(TT,T,NXTP)	;PUT IT AFTER MATCH PIN
	STORE(TT,E,NXTP)
	STORE(E,T,NXTP)
	POPJ P,

MKPBK1:	FETCH(TTT,G,WBIT)
	TRZE TTT,WNULL		;CERTAINLY NOT NULL ANY MORE
	TROA TTT,WSINGL		;IF WAS NULL, NOW IS SINGLE
	TRZ TTT,WSINGL		;APPARENTLY NOT SINGLE EITHER
	STORE(TTT,G,WBIT)
MKPBK2:	STORE(T,E,NXTP)
	STORE(E,TT,NXTP)
	TRNE ISBACK		;BACK PANEL DOESN'T DO THE REST
	 JRST BBITOR		;OR BITS INTO INTO HEADER
;LBCOPY - COPY BITS AND LOADING INTO HEADER
;ENTER WITH E POINTER TO PIN, G POINTER TO WIRE, SET PSHARE IF SECOND SHARE PIN!
;FALLS THRU

LBCOPY:	FETCH(TT,E,PBIT)
	TRNE TT,DUP
	 POPJ P,
	TRZ TT,PSHARE		;CLEAR THIS BIT
	STORE(TT,E,PBIT)
	FETCH(A,E,PTYP)
	JUMPE A,NSHARE		;NO SHARING IF NO POINTER
	FETCH(T,A,DPBIT)	;GET TYPE BITS
	TRNN T,SHARE		;SHARE PIN?
	 JRST NSHARE
	FETCH(TT,G,TBIT)
	TRNN TT,SHARE		;ANY SHARE PINS IN WIRE YET?
	 JRST NSHARE		;NO, SKIP REST OF THIS
	FETCH(T,A,PSWP)		;THIS IS SHARE #
	MOVEM T,SHRNUM		;SAVE HERE
	FETCH(F,E,PBDY)		;GET BODY
	MOVEI F,RADDR(F,BPIN,NXBP);FOLLOW BODY PIN LIST
	JRST LBCPY1

LBCPY2:	CAIN F,(E)		;THIS US?
	 JRST LBCPY3		;YES, GO TO OTHER LOOP
	FETCH(T,F,HPNT)
	CAIE T,(G)		;SAME WIRE?
	 JRST LBCPY1		;NO
	FETCH(T,F,PTYP)		;PIN TYPE POINTER
	JUMPE T,LBCPY1		;ANY?
	FETCH(TT,T,DPBIT)
	TRNN TT,SHARE		;SHARE PIN?
	 JRST LBCPY1		;NO
	FETCH(TT,T,PSWP)
	CAMN TT,SHRNUM		;SAME SHARE NUMBER?
	 JRST LBCPYS
LBCPY1:	FETCH(F,F,NXBP)
	JUMPN F,LBCPY2
	PUTSTR[ASCIZ/DIDN'T SEE OURSELVES AT LBCOPY!
/]
	JRST NSHARE

LBCPY4:	FETCH(T,F,HPNT)
	CAIE T,(G)		;SAME WIRE?
	 JRST LBCPY3		;NO
	FETCH(T,F,PTYP)
	JUMPE T,LBCPY3		;ANY TYPE POINTER?
	FETCH(TT,T,DPBIT)
	TRNN TT,SHARE		;SHARE PIN?
	 JRST LBCPY3
	FETCH(TT,T,PSWP)
	CAMN TT,SHRNUM
	 JRST LBCPYT
LBCPY3:	FETCH(F,F,NXBP)
	JUMPN F,LBCPY4
	JRST NSHARE

LBCPYT:	FETCH(T,F,PBIT)
	TRO T,PSHARE		;MAKE LATER ONE A SHARE PIN
	STORE(T,F,PBIT)
	JRST NSHARE

; SHARED PIN ?
LBCPYS:	FETCH(T,E,PBIT)
	TRO T,PSHARE
	STORE(T,E,PBIT)
NSHARE:	JUMPE A,CONCHK		;PIN TYPE POINTER? IF NOT, CHECK IF CON PIN
	FETCH(T,A,DPBITS)	;PIN TYPE BITS
	FETCH(B,G,TBIT)
	IOR B,T
	STORE(B,G,TBIT)
SETLOS:	FETCH(TTT,G,WBIT)
	TRNN TTT,GENSIG		;does this run need a generated signal name?
	 POPJ P,
; Try to remember something to make the name of this pin unique
; In order of preference: Loc of output, connector, input, any other pin
	MOVE TTT,LOSBIT		;get DPBITS from last pass thru STOLOS
	TRNE TTT,OUTLD
	 POPJ P,		;GOT GOOD GUY
	TRNE T,OUTLD
	 JRST STOLOS
	TRNE TTT,ANYCON
	 POPJ P,
	TRNE T,ANYCON
	 JRST STOLOS
	TRNE TTT,INLD
	 POPJ P,
	TRNE T,INLD
	 JRST STOLOS
	TRNE TTT,-1
	 POPJ P,
	TRNN T,-1
	 SKIPN LOSNAM
	 JRST STOLOS
	POPJ P,

STOLOS:	MOVEM T,LOSBIT		;TRY TO REMEMBER SOME LOCN TO LABEL RUN IF NONAME
	FETCH(T,E,PBDY)
	FETCH(T,T,BLOC)
	JUMPE T,CPOPJ		;DON'T USE IF NO BLOC
	HRRM T,LOSNAM
	FETCH(T,E,PINN)
	HRLM T,LOSNAM
	POPJ P,

CONCHK:	FETCH(F,E,PBDY)
	FETCH(TTT,F,BBIT)
	TRNN TTT,CBODY		;CON?
	 JRST [	SETZ T,
		JRST SETLOS]	;MAYBE USE THIS PIN IF NOTHING ELSE
	FETCH(T,G,TBIT)
	TRO T,ANYCON		;MARK AS HAVING CON IN RUN
	STORE(T,G,TBIT)
	JRST SETLOS		;STORE WORD WITH ANYCON ON IN LOSBIT

BBITOR:	FETCH(A,E,CBIT)
	JUMPE A,CPOPJ
	FETCH(TT,G,TBIT)
	IOR TT,A		;OR CON BITS INTO HEADER BITS
	STORE(TT,G,TBIT)
	POPJ P,
;		FIND BODIES, MAKE THEM
;FIND BODY BY BODY ID ONLY
BODFNB:	MOVEI A,RADDR(W,WBDY,NXTB)
	MOVE TTT,BID
	JRST BDFNB1

BDFNB2:	FETCH(T,A,BID)
	CAME TTT,T
	JRST BDFNB1		;NOT IT
	FETCH(T,A,FILB)
	CAMN T,THSFIL		;FROM THIS FILE?
	JRST CPOPJ1		;THIS IS IT
BDFNB1:	FETCH(A,A,NXTB)
	JUMPN A,BDFNB2
	POPJ P,			;NOT FOUND

;FIND BODY BY LOCATION
BODFND:	TRZ FLAG		;FLAG NO OTHER BODIES IN THIS LOC YET
	MOVEI A,RADDR(W,WBDY,NXTB)
BODFN2:	MOVE B,A		;SAVE PREVIOUS POINTER
	FETCH(A,A,NXTB)
	JUMPE A,CPOPJ		;END? GOES HERE
	FETCH(TT,A,BBIT)
	TRNE TT,CBODY
	 POPJ P,		;ALWAYS GOES BEFORE CONS
	FETCH(TT,A,BLOC)	;GET HIS LOC
	CAMGE TT,PINLOC		;ARE WE THERE YET?
	 JRST BODFN2		;NO
	CAME TT,PINLOC		;YES, SAME?
	 POPJ P,		;GOES HERE
	TRO FLAG		;FLAG LOC ALREADY EXISTS
	FETCH(T,A,BID)
	CAMGE T,BID
	 JRST BODFN2
	CAME T,BID
	 POPJ P,
	FETCH(TT,A,FILB)
	CAMGE TT,THSFIL
	 JRST BODFN2
	CAMN TT,THSFIL
	 AOS (P)		;THIS IS IT, SKIP
	POPJ P,

;FIND CONNECTOR BODY
BODFNC:	MOVEI A,RADDR(W,WBDY,NXTB)
BDFNC1:	MOVE B,A
	FETCH(A,A,NXTB)
	JUMPE A,BODMKC		;NOT FOUND, MAKE IT
	FETCH(T,A,BBIT)
	TRNN T,CBODY
	 JRST BDFNC1		;ALWAYS GOES AFTER BODIES
	FETCH(T,A,BLOC)
	CAMGE T,PINLOC
	 JRST BDFNC1
	CAMN T,PINLOC
	 POPJ P,		;FOUND IT
	JRST BODMKC

;FIND BACK PANEL SLOT BODY
SLOTFN:	MOVEI A,RADDR(W,WBDY,NXTB)
	JRST SLOTF1

SLOTF2:	FETCH(T,A,BLOC)
	CAML T,PINLOC
	JRST [	CAME T,PINLOC	;EXACT MATCH?
		JRST BODMK1	;NO, MAKE ONE
		POPJ P,]
SLOTF1:	MOVE B,A
	FETCH(A,A,NXTB)
	JUMPN A,SLOTF2
	JRST BODMK1

;MAKE BODIES
;B,A = POINT IN LIST TO INSERT BODY
BODMK0:	PGETFS(T,BHEAD)		;YES, MAKE NEW BODY
	BCLEAR(TTT,T,BHEAD)	;CLEAR OUT BLOCK
	STORE(T,B,NXTB)
	STORE(A,T,NXTB)
	MOVE A,T
	MOVE TTT,BID
	STORE(TTT,A,BID)
	MOVE TTT,PINLOC
	STORE(TTT,A,BLOC)
	POPJ P,

BODMK1:	PUSHJ P,BODMK0
	MOVE T,THSFIL		;NO, USE FILE POINTER
BDMKST:	STORE(T,A,FILB)
	POPJ P,

;MAKE A BODY BLOCK FOR A CONNECTOR PIN
BODMKC:	PUSHJ P,BODMK0
	PUSH P,A
	MOVE A,PINLOC
	PUSHJ P,QUPIN
	SKIPA T,[BEDGE]
	MOVEI T,BWILD
	POP P,A
	STORE(T,A,BBIT)
	MOVEI T,[0]		;POINTER TO 0 FILENAME(FILB)
	JRST BDMKST

;THIS COUNTS ON BODMK1 USING PGETFS, NOT GETFS, SO BODY NAME GOES AT FSTOP
BODMK2:	PUSHJ P,BODMK1		;MAKE AND LINK BASIC BODY BLOCK
	MOVEI T,ADDR(A,BNAM)	;POINTER TO WHERE TO PUT BODY NAME
	MOVEI TT,STRTAB
BODMK3:	MOVE TTT,(TT)
	CAMLE T,.JBREL
	JSR MORCOR		;NEED SOME MORE
	MOVEM TTT,(T)
USAGE,<	AOS FSTCNT	>
	ADDI T,1
	TRNE TTT,376		;END OF STRING?
	AOJA TT,BODMK3
	MOVEM T,FSTOP		;NEW FSTOP
USAGE,<	SOS FSTCNT	>
	POPJ P,

ILLEND:	PUTSTR[ASCIZ/ILLEGAL END OF INPUT FILE!
NO MORE INPUT WILL BE DONE!
/]
	JRST ERRET
;		READ DIP COUNTS FROM BAC FILE
ENDIN:	SKIPE MODULE		;THEORY HAS IT THIS WON'T HAPPEN
	SKIPN DIPLST
	JRST SKPCNT		;IF NO DIPS, SKIP COUNTS
	MOVEI A,MODLST-ADDR(0,MNXT)
	JRST MODLP1

MODLP2:	FETCH(T,A,MNAM)
	MOVE TT,MODULE
	PUSHJ P,TXTMAT
	JRST MODLP1
	JRST MODLP3
	JRST SKPCNT		;IF MODULE ALREADY IN LIST, SKIP IT
				;WE ONLY WANT COUNTS FOR ONE BOARD

MODLP1:	MOVE B,A
	FETCH(A,A,MNXT)
	JUMPN A,MODLP2
MODLP3:	PGETFS(A,BMOD)
	BCLEAR(T,A,BMOD)
	MOVE T,MODULE
	STORE(T,A,MNAM)
	FETCH(T,B,MNXT)
	STORE(T,A,MNXT)
	STORE(A,B,MNXT)
	MOVEM A,MODULE
ENDIN1:	PUSHJ P,RSTR		;READ STRING DIPNAME
	JRST DOFILS
	MOVEM T,STRING
	MOVE B,DIPLST
	PUSHJ P,DIPFND
	JRST [	MOVE A,STRING
		PUSHJ P,STROUT
		PUTSTR[ASCIZ/, DIPTYPE NOT FOUND!
/]
		SETZ B,
		JRST .+1]
	MOVEM B,LSTDIP
	MOVE B,STRING
	PUSHJ P,PUTFS
ENDIN2:	XCT GETCHR
	JRST ILLEND
	AOJE TTT,ENDIN1		;END IS -1
	SUBI TTT,1
	MOVEM TTT,TMPCN2	;SAVE APPROX COUNT HERE
	XCT GETCHR
	JRST ILLEND
	MOVEM TTT,TMPCN1	;SAVE REAL COUNT HERE
	PUSHJ P,BAKPRP		;READ PROPERTIES AND FIND PART NUMBER
	SKIPN LSTPART
	JRST ENDIN6		;USE NULL PART NUMBER BLOCK
	SKIPN H,PARTLIST
	JRST ENDIN4
ENDIN3:	FETCH(T,H,PLPT)
	CAMN T,LSTPART		;FIND OUR PART?
	JRST ENDIN5
	FETCH(H,H,NXPL)
	JUMPN H,ENDIN3
ENDIN4:	OUTSTR[ASCIZ/MOBY LOSSAGE, PART NUMBER NOT FOUND IN PARTLIST.
/]
ENDIN6:	MOVEI H,NULPART-ADDR(0,MDCN);SET NULL PART HEADER BLOCK
ENDIN5:	MOVEI G,RADDR(H,MDCN,MDNX)
	JRST ENDNA1

ENDNA2:	FETCH(TT,G,MDIP)
	SKIPN T,LSTDIP
	JRST [	JUMPN TT,ENDNA1
		JRST ENDNA4]
	JUMPE TT,ENDNA3
	FETCH(T,T,DNAM)
	FETCH(TT,TT,DNAM)
	PUSHJ P,DSORT
	JRST ENDNA3
	JRST ENDNA1
	JRST ENDNA4

ENDNA1:	MOVE F,G
	FETCH(G,G,MDNX)
	JUMPN G,ENDNA2
ENDNA3:	GETFS(T,MDBLOCK)
	BCLEAR(TT,T,MDBLOCK)
	MOVE TT,LSTDIP
	STORE(TT,T,MDIP)
	STORE(T,F,MDNX)
	STORE(G,T,MDNX)
	MOVE G,T
ENDNA4:	MOVEI E,RADDR(G,MXPT,MXNX)
	FETCH(F,G,MXPT)
	JUMPE F,ENDNB3
	SKIPE PRPLST
	JRST ENDNB2
	FETCH(T,F,MPRX)
	JUMPN T,ENDNB3
	JRST ENDNB4

ENDNB2:	FETCH(E,F,MPRX)
	PUSH P,F
	JUMPE E,ENDNB1
	PUSHJ P,PRXMAT
	JRST ENDNB1
	POP P,F
	JRST ENDNB4

ENDNB1:	POP P,E
	FETCH(F,E,MXNX)
	JUMPN F,ENDNB2
ENDNB3:	GETFS(T,MXBLOCK)
	BCLEAR(TT,T,MXBLOCK)
	MOVE TT,PRPLST
	STORE(TT,T,MPRX)
	STORE(T,E,MXNX)
	STORE(F,T,MXNX)
	MOVE F,T
ENDNB4:	MOVEI E,RADDR(F,MCPT,MCNX)
	JRST ENDNC1

ENDNC2:	FETCH(T,E,MODC)
	FETCH(T,T,MNAM)
	MOVE TT,MODULE
	FETCH(TT,TT,MNAM)
	PUSHJ P,TXTMAT
	JRST ENDNC1
	JRST ENDNC3
	JRST ENDNC4

ENDNC1:	MOVE D,E
	FETCH(E,E,MCNX)
	JUMPN E,ENDNC2
ENDNC3:	GETFS(T,MCBLOCK)
	BCLEAR(TT,T,MCBLOCK)
	MOVE TT,MODULE
	STORE(TT,T,MODC)
	STORE(T,D,MCNX)
	STORE(E,T,MCNX)
	MOVE E,T
ENDNC4:	FETCH(T,E,MREA)
	ADD T,TMPCN1
	STORE(T,E,MREA)
	FETCH(T,E,MAPP)
	ADD T,TMPCN2
	STORE(T,E,MAPP)
	JRST ENDIN2