.ADD(ALLLOCS,MUPAC,MUPACV)
MDWL,<
.ADD(ALLWW,MUPAC,MUPATV)
>;MDWL
;Note! These .ADD's must be outside of block structure

COMMENT 

The MUPAC Model # 3244806-01 wire wrap board:

The board has 6 rows of sockets, 20 in each row.

However, between columns 10 and 15, there is a kludgey
universal pattern. Each universal column is 59 pins high,
spaced out:
	(11) - .2" - (12) - .1" - (13) - .3" - (14)


The DIP slot nomenclature is:

		   %DIPG   	%DIPS
   ----------	-----------------------------
   "standard"	<D,E,F,G,H,J>	<01:10, 15:24>
   "universal"	<01:59>		<11:14>

Dip D01 is at upper left, viewed fom DIP side,
with the front edge connectors at the top

The board uses 16 pin DIP sockets, with a "G" pin just
below pin 8, and a "V" pin above pin 16. (Actually, some
are "V1" and some are "V2" pins, but the are all treated as +5V).
It is also assumed that pin 8 has been grounded on the board.

There are two front connectors, each with 3 rows of 36 pins.
There is one back connector, with 3 rows of 18 pins.

The connector nomenclature is:

		 %CONN		%CONP
   ----------	------------------------------
   "front"	<1:2><A,B,C>	<01:36>
   "back"	<X,Y,Z>		<01:18>

	where the "2" front connector is flagged
	by %CONN having the 40 bit on.


BEGIN MUPAC

%DIPG__<POINT 6,,23>-=18		;DIP GROUP (The letter)
%DIPS__<POINT 6,,29>-=18		;DIP SLOT  (The number)
%DIPOF__<POINT 6,,35>-=18		;DIP OFFSET

define DIPSLT(letter,number)
<	ifdif<letter><J><<"letter"+1-"A">=12 + =number6>
	ifidn<letter><J><<"letter"+1-"A"-1>=12 + =number6>
  >


%CONN__<POINT 6,,23>-=18		;CONNECTOR NUMBER (LETTER OR JACK #)
%CONP__<POINT 12,,35>-=18		;CONNECTOR PIN #

define CONLOC(num1,letter,number)
<	ifidn<num1><><<"letter"+l.x-"X">=12 + =number >
	ifidn<num1><1><<"letter"+1-"A">=12 + =number >
	ifidn<num1><2><<"letter"+41-"A">=12 + =number >
>


GPIN__0					;"G" PIN, JUST BELOW PIN 8
VPIN__=17				;"V" PIN, JUST ABOVE PIN 16
BRDGND__8				; PIN 8 IS GROUNDED

;TABLE TO TEST FOR UNIVERSAL DIP COLUMNS (%DIPS)

UNICOL:	FOR I_0,=10
<	0
>
	FOR I_=11,=14
<	1B0
>
	FOR I_=15,=24
<	0
>
MXDIPS__=24		;MAX %DIPS
;L.D through L.J are the legal %DIPG for normal
MXUDPG__=59		;MAX %DIPG FOR UNIVERSAL

;EDGE CONNECTORS
MXFRONT__=36		;MAX 36 PINS PER ROW IN FRONT
MXBACK__=18		;MAX 18 PINS PER ROW IN BACK


;THE TRANSFER VECTOR FOR THE MUPAC WW BOARD

^MUPACV:
	JRST LCINIT		;BOARD INITIALIZATION
	JRST QUPIN		;CHECKS FOR WILD CONNECTOR BODIES (UNUSED)
	JRST $SLTOUT		;PRINTS CARD LOC (B-R-S)
	JRST $GETSLT		;READS CARD LOC (B-R-S)
	JRST PRNLOC		;PRINTS SOCKET, DIP, OR CONNECTOR LOC
	JRST PRNPIN		;PRINTS SOCKET, DIP, OR CONNECTOR PIN
	JRST CPNSEP		;SEPARATE CONNECTORS LOC/PIN PARTS FROM 18 BIT FORM
	JRST CPNMER		;MERGE CONN LOC/PIN PARTS BACK
	JRST CPNMAP		;MAP CARD LOC, CPIN-LOC INTO BACKPANEL PIN LOC
MDWL,<	JRST MAPOST  >		;CONVERT FROM DIP-LOC/PIN TO POST

MDPC,<
	JRST GTSLTL		;READS (B-R-S) AND BODY LOCN
MD,<	JRST GTCONP		;READS (B-R-S) AND CONNECTOR PIN
	JRST CPOPJ		;LOCFUK - FOR UPCONVERTING OLD DRWVERS
>;MD
>;MDPC

MWL,<
	JRST GETLOC		;READS EITHER DIP LOC, OR CONNECTOR LOC
	JRST RAYDIP		;PRINTS DIP, OR CONNECTOR LOC IN FORTRAN FORM
	JRST CPARTP		; (PRINT EDGE PIN TO PARTITION FILE)
	JRST SEQLOC		;TESTS FOR BODY LOCS BEING SEQUENTIAL 
	JRST CONGIN		;GENERATE NEXT INVENTED PIN TO REPLACE "U" PINS
	JRST $GTSLTT		;GETSLT, BUT WITH FIRST CHAR IN CHRREG
>;MWL
	[ASCIZ/B-R-S (#)/]	; CUE FOR BOARD SLOT
	[ASCIZ /#/]		; CUE FOR BOARD PIN
MDPC,<	[ASCIZ/#<A,B,C># or <X,Y,Z># /]	;CUE FOR CONNECTOR PIN
	[ASCIZ/L# or L#@# or #-#/]		;CUE FOR BODY LOC
	[ASCID /D01/]		;PROTOTYPE FOR BODY LOC
>;MDPC
MWL,<	[ASCIZ/L# or #-#/]	;WIRELISTER BODY CUE
	[ASCIZ/#L or L/]	;WIRELISTER CONNECTOR BODY CUE
>;MWL
CHECK MUPACV,LTVLEN

L2NSUB:	BLOCK L2NLEN			;*******
N2LSUB:	REPEAT N2LLEN, < "?"
>
EN2L__.

NNN__1
FOR I IN(A,B,C,D,E,F,G,H,J,K,L,M,N,P,R,S,T,U,V,W)
<	L2N2L I,0
>

L.X__NNN
FOR I IN(X,Y,Z)
<	L2N2L I,0
>

FOR I IN (I,O,Q)
<	L2N2L I,1B0
>

N2LMAX__NNN-1

L.D__4		;D IS 4TH LETTER
L.J__L.D+5	;D,E,F,G,H,J

ORG EN2L


LCINIT:	MOVE T,[L2NSUB,,L2N]
	BLT T,L2N+L2NLEN+N2LLEN-1
	MOVEI T,N2LMAX
	MOVEM T,MAXN2L
	POPJ P,



;Print Socket or DIP loc.
;A=  (MAPCON),,loc
;  returns TT the seperator charbetween loc-pin, if any

PRNLOC:	SETZ TT,
	JUMPE A,CPOPJ
	MOVEI T,2			;SETUP FOR 2 DIGIT NUMBER PRINT
	MOVEM T,NDIG
	JUMPL A,CNLOC			
	LDB T,[%DIPS,,A]		;DIP COLUMN
	SKIPGE UNICOL(T)		;IN UNIVERSAL AREA?
	 JRST [	PUSH P,T		;YES, SAVE COLUMN
		LDB T,[%DIPG,,A]	;PRINT ROW 01-59
		PUSHJ P,NPUTDEC
		PUTBYT "-"
		POP P,T			;NOW COL 11-14
		PUSHJ P,NPUTDEC
		JRST PRNLC1]
;In normal DIP sockets, print Letter-number
	LDB T,[%DIPG,,A]		;GROUP LETTER
	PUTBYT @N2L(T)			;CONVERT TO LETTER AND PRINT
	LDB T,[%DIPS,,A]		;SLOT NUMBER WITHIN GROUP
	PUSHJ P,NPUTDEC			;PRINT IT OUT
	LDB T,[%DIPOF,,A]		;ANY SLOT OFFSET?
	JUMPE T,PRNLC1
	PUTBYT "@"
MWL,<	PUSHJ P,NPUTDEC >
MDPC,<	PUSHJ P,PUTDEC >
PRNLC1:	MOVEI TT,"-"
	POPJ P,

CNLOC:	LDB T,[%CONN,,A]		;CONNECTOR NUMBER
	MOVEI TT,"1"
	TRZE T,40
	 MOVEI TT,"2"
	CAIGE T,L.D			;A,B,C is front conn
	 PUTBYT (TT)			; "1 or 2"
	PUTBYT @N2L(T)			; "A,B,C  X,Y,Z"
	SETZ TT,		;NO SEPARATOR NECESSARY
	POPJ P,

PRNPIN:	LDB T,[%%PINN,,A]
	JUMPL A,PRNPN1			;a connector pin?
	CAIN T,VPIN		;No, check for V,G
	 JRST [	PUTBYT "V" 	POPJ P,]
	CAIN T,GPIN
	 JRST [	PUTBYT "G" 	POPJ P,]
PRNPN1:	MOVEI TT,2
	MOVEM TT,NDIG
	JRST NPUTDEC

;CONVERT PIN-SPEC TO POST-SPEC
;MAPOST (DWL) - CONVERT FROM DIP-LOC,PIN# TO SOCKET-LOC, PIN#
;A = MBIT+PIN#,,LOC
;B = PACKAGE
;Skips if can map, with MAPSOC set.
; Possibly MAPPWR or MAPGND if V or G posts on board
;A = New MBIT+PIN#,,LOC
;B = FLAGS,,PIN CHANGE
;	%MPLOC	;LOC WAS CHANGED
;	%MPPIN	;PIN WAS CHANGED, DIFFERENCE IN RH (TO CHECK FOR +1)
;	%MPPL1	;PIN NUMBER CHANGED BY 1 (KLUDGE)

MDWL,<
MAPOST:	TLNN A,CRDPIN		;SHOULDN'T BE ON
	TLOE A,MAPSOC
	 OUTSTR [ASCIZ /PIN ALREADY MAPPED TO POST???
/]
	JUMPL A,[SETZ B,	;CONNECTOR, NO CHANGE
		JRST CPOPJ1]
	PUSH P,C
	PUSH P,D
	PUSH P,A
	LDB C,[%DIPS,,A]	;DIP COLUMN
	LDB D,[%DIPG,,A]	;DIP ROW
	LDB A,[%%PINN,,A]	;PIN#
	JUMPE A,MAPOS1		;SPECIAL HACK JUST TO FLUSH %DIPOF
	SKIPGE UNICOL(C)	;IN UNIVERSAL AREA?
	 JRST MUPUNI		; YES
;Dip is in 16 pin socket area of board, call standard
;mapper routine which handles DIPs/SIPs/Adaptors and DIP-offsets.
	SKIPE ILLPAK(B)		;CAN PACKAGE FIT IN DIP SOCKET?
	 JRST MAPOSX		; NOT QUITE
	LDB D,[%DIPOF,,(P)]	;OFFSET FIELD WITHIN SOCKET
	MOVEI C,=16		;BOARD HAS 16 PIN SOCKETS
	PUSHJ P,MAPPER		;RETURNS (PIN,FLAGS,HORIZ-OFF,VER-OFF)
	 JRST MAPOSX
	LDB T,[%DIPS,,(P)]	;NOW OFFSET SLOT
	MOVE TT,T
	ADD TT,C
	SKIPL UNICOL(TT)	;FALLS INTO UNIVERSAL COLMNS?
	CAILE TT,MXDIPS		;FALLS OFF end of board?
	 JRST MAPOSX
	ADD T,C
	DPB T,[%DIPS,,(P)]
	LDB T,[%DIPG,,(P)]	;FIRST ROW IS A (=1)
	ADD T,D			;DOES OFFSET OVERFLOW NO. OF ROWS?
	CAILE T,L.J		;LEGAL ROW #
	 JRST MAPOSX
	DPB T,[%DIPG,,(P)]
MAPOS1:	SETZ T,
	DPB T,[%DIPOF,,(P)]	;WITHIN SOCKET OFFSET GOES AWAY
	DPB A,[%%PINN,,(P)]
	AOS -3(P)
MAPOSX:	POP P,A
	POP P,D
	POP P,C
	POPJ P,

;Package is in universal area of board,
;A = Pin#
;B = package
;C = column (11-14)
;D = row (1-59)
;Check for legal packages, then make new location,
; with pin# equal to 0, the post location is entirely
; specified by "DIP" loc which is row-column.

MUPUNI:	HRRZ T,MAPDSP(B)	;WHAT TYPE OF PACKAGE?
	CAIN B,K.SGR1		;KLUDGEY S.GRAY 20 PIN DIP ADAPT
	 JRST [	CAIE C,=11	;ONLY IN COL 11
		 JRST MAPOSX
		CAIG A,=10	;2ND LEG?
		 JRST MAP1ST
		SUBI A,=20+1
		MOVNS A
		AOJA C,MAP1ST]
	CAIN T,SIP
	 JRST MAP1ST		;LIKE 1ST ROW OF DIP
	CAIE T,DIP		;IS DIP?
	 JRST MAPOSX		; NO, ILLEGAL THEN
;Is a DIP, check for legal columns depending on DIP leg spacing,
; then map column if pin is in 2nd row of DIP pins
	HRRZ TT,PACKPN(B)
	ASH TT,-1		;# PINS ON ONE SIDE OF DIP
	HRRZ T,DIPLEG(B)	;HOW FAR APART DIP legs?
	CAIN T,=400
	 JRST [	CAIE C,=12	;ONLY IN COL 12
		 JRST MAPOSX
		CAMG A,TT	;FIRST ROW OF PINS?
		 JRST MAP1ST
		MOVEI C,=14	;MAPS INTO COL 14
		JRST MAP2ND]
	CAIN T,=600
	 JRST [	CAIE C,=11
		 JRST MAPOSX
		CAMG A,TT	;FIRST ROW OF PINS?
		 JRST MAP1ST
		MOVEI C,=14	;MAPS INTO COL 14
		JRST MAP2ND]
	CAIE T,=300		; .3" SPACING?
	 JRST MAPOSX		;NO, LOSE
;Standard .3" DIP
	CAIE C,=11		; ONLY LEGAL IN 11 OR 13
	CAIN C,=13
	 CAIA
	 JRST MAPOSX
	CAMG A,TT		;WHICH ROW OF DIP PINS?
	 JRST MAP1ST		; FIRST
	CAIN C,=13		;SECOND, 13 GOES TO 14
	 MOVEI C,=14
	CAIN C,=11		;11 GOES TO 13
	 MOVEI C,=13
MAP2ND:	SUB A,PACKPN(B)
	SUB D,A			; 16-PIN# IS DISPLACEMENT
	CAIA
MAP1ST:	 ADDI D,-1(A)		;OFFSET ROW BY PIN#
	skipl d
	caile d,=59
	 jrst maposx
	DPB C,[%DIPS,,(P)]
	DPB D,[%DIPG,,(P)]
	SETZ A,		;NULL PIN #, ALL IS IN LOC
	MOVSI B,%MPLOC!%MPUNI	;UNIVERSAL LOC INCLUDES PIN#
	JRST MAPOS1

;Test for an illegal package in this board

ILLPAK:	BLOCK NPACK
	FOR @' I IN (18,20,22,24,36,40,48,64,624aug,624xug)
	<ORG ILLPAK+K.'I 	-1		;ILLEGAL IN THIS BOARD
	>
ORG ILLPAK+NPACK


>;MDWL

;THIS SHOULD CHECKFOR B-R-S ??
;Read a body locn into DESTIN.
;returns -	FAIL
;		CRLF ONLY
;		OK
;		B-R-S seen

MDPC,<
GTSLTL:	PUSH P,A
	MOVEI A,[[ASCIZ /L#./]
		 [asciz /#-#./]	;UNIVERSAL LOCN
		 0]
	PUSHJ P,LNPARS
	 JRST GTSL0
	 JRST GTSL1
	PUSHJ P,GATLOC
	 JRST GTSL0
	CAIE CHRREG,"@"
	 JRST GTSL2
	PUSH P,TT
	GETNUM
	POP P,TT
	JUMPE NUMREG,GTSL0
	DPB NUMREG,[%DIPOF,,TT]
GTSL2:	MOVEM TT,DESTIN
	AOS -1(P)
GTSL1:	AOS -1(P)
GTSL0:	POP P,A
	POPJ P,
>;MDPC

;Assemble loc from parsed argument

GATLOC:	SETZ TT,
	CAIN A,1	;UNIVERSAL STUFF?
	 JRST [	MOVE T,ARG3	;#-#
		CAIL T,=11	;MUST BE COLS 11-14
		CAILE T,=14
		 POPJ P,
		DPB T,[%DIPS,,TT]
		MOVE T,ARG1		;MUST BE 1-59
		CAILE T,MXUDPG
		 POPJ P,
		DPB T,[%DIPG,,TT]
		JRST CPOPJ1]
	MOVE T,ARG2	;L#
	CAILE T,MXDIPS		;MUST BE 1-10,15-24
	 POPJ P,
	CAIL T,=11
	CAILE T,=14
	 CAIA
	 POPJ P,
	DPB T,[%DIPS,,TT]	;DIP ROW, LETTER OR 1-59
	MOVE T,ARG1
	CAIL T,L.D
	CAILE T,L.J
	 POPJ P,
	DPB T,[%DIPG,,TT]	;DIP COLUMN, 1-24
	JRST CPOPJ1


MD,<
;Read connector locn
;  (This should probably try for B-R-S also, but...?)

GTCONP:	PUSH P,A
	MOVEI A,[[ASCIZ /L#/]
		 [ASCIZ /#L#/]
		 0]
	PUSHJ P,LNPARSE
	 JRST GTCON0
	 JRST GTCON1			;NULL INPUT
	PUSHJ P,GATCON		;GET JACK OR PADDLE PART OF LOC
	 JRST GTCON0
	MOVE T,ARG2
	CAIE A,0
	 MOVE T,ARG3
GTCON3:	DPB T,[%CONP,,TT]
	HRRZM TT,DESTIN
	AOS -1(P)
GTCON1:	AOS -1(P)
GTCON0:	POP P,A
	POPJ P,

>;MD

GATCON:	SETZ TT,
	JUMPE A,[
		MOVE T,ARG1
		CAIGE T,L.X	;BETTER BE X,Y,Z
		 POPJ P,
		JRST GTCN2]
	MOVE T,ARG2
	CAIL T,L.D		;BETTER BE A,B,C
	 POPJ P,
	SOSLE ARG1
	 TRO T,40
GTCN2:	DPB T,[%CONN,,TT]
	TLO TT,MAPCON
	JRST CPOPJ1

MWL,<

GETLOC:	MOVEI A,[[ASCIZ /L#/]	;0 - DIP or back connector
		 [ASCIZ /#-#/]	;1 - DIP in universal columns
		 [ASCIZ /L#@#/]	;2 - DIP with offset
		 [ASCIZ /L/]	;3 - BACK CONNECTOR
		 [ASCIZ /#L/]	;4 - front connector
		 0]
	PUSHJ P,LNPARSE
	 POPJ P,
	 POPJ P,
	CAIL A,3		;CONN OR DIP?
	 JRST [	SUBI A,3
		JRST GATCON]
	PUSHJ P,GATLOC
	 POPJ P,
	MOVE T,ARG4
	CAIN A,2		;L#@#
	 DPB T,[%DIPOF,,TT]
	JRST CPOPJ1

;Print location for fixed format card image
;8 cols wide, with "group" left justified, "pin number" right justified
RAYDIP:	TLNN A,MAPSOC
	 PUSHJ P,FUCKUP
	PUTBYT "?"		;FOR NOW
	POPJ P,

FOR NAME IN (CPARTP:,CONGIN:)
<NOTYET(NAME)
>
>;MWL

CPNSEP:	LDB TT,[%CONP,,T]
	MOVEI TTT,0
	DPB TTT,[%CONP,,T]
	POPJ P,

CPNMER:	PUSH P,A
	LDB T,[%CONN,,T]
	SKIPN T
	SKIPE TT
	 JRST CPNMR1
	MOVEI TT,1		;INITITIALZE, PIN1
	MOVEI T,1		;A
CPNMR1:	MOVE TTT,T
	TRZ TTT,40		;1A OR 2A
	CAIL TTT,L.D		;A,B,C?
	 JRST CPNBAK
	CAILE TT,MXFRONT
	 JRST [	MOVEI TT,1
		AOS T
		CAIN T,L.D
		 MOVEI T,41
		CAIN T,L.D+40
		 MOVEI T,L.X
		JRST .+1]
CPNMR2:	DPB T,[%CONN,,T]
	DPB TT,[%CONP,,T]
	POP P,A
	POPJ P,

CPNBAK:	CAIGE TT,MXBACK
	 JRST CPNMR2
	MOVEI TT,1
	AOS T
	JRST CPNMR2

QUPIN:	SETZ A,			;NO RULE NUMBER
	POPJ P,			;AND IT'S NOT WILD
NOTYET(CPNMAP:)

MWL,<
SUBTTL WIRE WRAP ROUTINES  --  MUPAC BOARD

comment 

All calculations are done from the DIP side.

(0,0) at LOWER left hand corner in left handed coordinate system.
X+ to right, Y+ is up

(0,0) is .1" to left of J1(G), 1.0" below

DIP socket pin 1 is upper left.

	MAP OF BOARD (DIP SIDE)
	-----------------------
	1A<1:36>		2A<1:36>
conns	1B  "			2B  "
	1C  "			2C  "

	D1 D2 ... D10	11 - 12 -13 -14		D14 ... D24
	E1  ...		     ...
	F1  ...		(59 pins per column)
	G1		universal pattern
	H1		     ...
	J1		     ...
	
			X<1:18>
back conn		Y<1:18>
			Z<1:18>




^^MUPATV__.	;TRANSFER VECTOR FOR QUAD HEIGHT 20 PIN DEC BOARDS


	-1			;FLAGS IF WIRE WRAP OR PC BOARD
	JRST CPOPJ		;THE INIT ROUTINE
	JRST MAPRC		;MAP ROW/COLS INTO GENERATED LOCS
	JRST MAPPAD		;MAP PADDLE/LETTER/SIDE INTO CONN LOCS
	JRST DISTPP		;DISTANCE CALC ROUTINE
	JRST FPWR		;FIND A POST WITH POWER
	JRST FGND		;FIND A POST WITH GND
	JRST MAPIT		;CONVERT POST INTO X,Y,BITS
	JRST PAKSIZ		;FIND DIMENSION OF DIP OUTLINE
	JRST GNDCLR		;?
	JRST WAGGND		;?
	JRST GNDOUT		;?
	JRST VCCOUT		;?

;Define a UML map, 20 rows x 6 columns, but leave out the
; universal pattern stuff because I can't figure out how
; to print it.

	=20			;NROWS		    (USED FOR UML ONLY)
	=6			;NCOLS		    (USED FOR UML ONLY)
	=6			;NCLPRG		    (USED FOR UML ONLY)
	0			;NRWPRP		    (USED FOR UML ONLY)
	=120			;DIPSLT_NROWS*NCOLS (USED FOR UML ONLY)
	SETPAD(=9)		;NPADS		    (USED FOR UML ONLY)
	-=36,,1			;PADLET		    (USED FOR UML ONLY)
	-1,,0			;PADPIN		    (USED FOR UML ONLY)

;Define some wire/wrap lengths ????
	=10			;FRACTN
	=200*2			;WRAPMG .200" INSULATION AROUND EACH POST
	=1500			;POSTMG .750" BARE WIRE AROUND EACH POST
	0			;NEXTR
CHECK MUPATV,WTVLEN


;Define locations on board, in 1 mil increments, from DIP side

RADIX =10
DIP00x__100		;Column 1, pin 1 is .1" from 0
DIP00y__6800		;row D, pin 1 is 6.8" from 0

DEFINE INCR(STEP)<	..TEM    ..TEM__..TEM+STEP    >
DEFINE DECR(STEP)<	..TEM    ..TEM__..TEM-STEP    >

;X location for pin 1 of socket in column #

DIPX:	..TEM__DIP00X
	0		;COL 0
	INCR(400)	;COL 1 to COL 2
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(500)	;COL 10-pin-1 TO 11
	INCR(200)	
	INCR(100)
	INCR(300)
	INCR(200)	;COL 14 TO 15-pin-1
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(400)
	INCR(0)		;COL 24

DIPY:	..TEM__DIP00Y
	0  0  0  0	;0, A,B,C
	DECR(1000)		;ROW D
	DECR(1000)
	DECR(1000)
	DECR(1000)
	DECR(1000)
	DECR(1000)		;ROW J

;Offsets of DIP pin within socket

PINX:	0	;G PIN
	0	;1
	0
	0
	0
	0
	0
	0
	0	;8
	300	;9
	300
	300
	300
	300
	300
	300
	300	;16
	300	;V PIN

PINY:	-800	;G PIN
	0	;1
	-100
	-200
	-300
	-400
	-500
	-600
	-700	;8
	-700	;9
	-600
	-500
	-400
	-300
	-200
	-100
	0	;16
	100	;V PIN

;Mapping for connectors, index by (CONnum*36)+connpin-1
; where connum 0:8 are 1A,1B,1C,2A,2B,2C,X,Y,Z

	define conrow(x,y)<
	 for i_0,3500,100
	   <	x+i,,y	   > >

CONTBL:	CONROW(100,7700)	;1A	
	CONROW(100,7600)	;1B
	CONROW(100,7500)	;1C
	CONROW(5300,7700)	;2A
	CONROW(5300,7600)	;2B
	CONROW(5300,7500)	;2C
	CONROW(3600,500)	;X
	CONROW(3600,400)	;Y
	CONROW(3600,300)	;Z
	   
RADIX 8


MAPIT:	JUMPL A,CONMAP			;MAP CONNECTOR LOCATION
	LDB T,[%DIPS,,A]		;DIP COLUMN
	LDB TT,[%DIPG,,A]		;DIP ROW
	SKIPN UNICOL(T)
	 JRST MAPITD		;IS A NORMAL 16 PIN SOCKET
;Pin is in universal pattern area
	MOVNS TT
	ADDI TT,=59
	IMULI TT,=100		;IN .1" INCREMENTS
	ADDI TT,=1000		;ROW 59 IS 1.0" UP
	HRLZ T,DIPX(T)		;XOLUMN X
	HRR T,TT		;X,,Y
	SETZB TT,TTT		;NO PWR,GND
	JRST CPOPJ1

;Pin is in some dip socket
MAPITD:	HRRZ T,DIPX(T)
	HRRZ TT,DIPY(TT)
	LDB TTT,[%%PINN,,A]	;WHICH PIN?
	CAIN TTT,VPIN
	 JRST [	PUSH P,[PWR,,=500]
		MOVEI TTT,=17	;LOOKS LIKE PIN 17
		JRST MAPIT1]
	CAIN TTT,GPIN
	 JRST [	PUSH P,[GND,,0]
		MOVEI TTT,0	;LOOKS LIKE PIN 0
		JRST MAPIT1]
	PUSH P,[0]		;NEITHER PWR/GND
MAPIT1:	ADD T,PINX(TTT)
	ADD TT,PINY(TTT)
	HRLZS T
	HRR T,TT		;X,,Y
	POP P,TT		;PWR/GND BITS
	SETZ TTT,
	JRST CPOPJ1

;Here for connector pins

CONMAP:	LDB TTT,[%CONN,,A]	;WHICH CONNECTOR GROUP?
;Compress the possible connector groups into an index
	TRZE TTT,40		;2A,2B,2C?
	 ADDI TTT,3
	CAIL TTT,L.X
	 SUBI TTT,L.X-7
	IMULI TTT,=36
	LDB TT,[%%PINN,,A]
	ADDI TTT,-1(TT)		;CONGRP*36 + CONPIN -1
	MOVE T,CONTBL(TTT)	;GET PIN X,,Y
;Now check for the dedicated pwr/ground pins on front connectors
	CAIE TT,1
	CAIN TT,=18
	 CAIA
	CAIN TT,=36		;GROUND ON 1,18,36
	 JRST [	MOVSI TT,GND	;FLAG AS GND PIN
		JRST CONMA1]
	CAIL TTT,2		;IN 1A,1B,1C?
	 JRST CONMA2		; NO
	CAIL TT,4		; PWR IS ON 4-8, 31-35
	CAILE TT,8
	 JRST [	CAIL TT,=31
		CAILE TT,=35
		 JRST CONMA2
		JRST .+1]
	SKIPA TT,[PWR,,=500]
CONMA2:	 SETZ TT,
CONMA1:	SETZ TTT,	
	JRST CPOPJ1

PAKSIZ:	LDB T,[%DIPS,,A]	;DIP COLUMN
	LDB TT,[%DIPG,,A]	;DIP ROW
	SKIPE UNICOL(T)		;UNIVERSAL AREA?
	 JRST PAKDIM		;YES, ASSUME IT'S OK ???
	ADD TT,PAKHGT(B)
	CAILE TT,L.J
	 POPJ P,		;BARF! FALLS OFF BOTTOM
	CAIG T,=11		;IN AREA TO LEFT OF UNIVERSAL?
	 JRST [	ADD T,PAKWID(B)
		CAILE T,=11	;BETTER NOT FALL INTO UNIVERSAL
		 POPJ P,
		JRST PAKDIM]
	ADD T,PAKWID(B)
	CAILE T,=24
	 POPJ P,
	JRST PAKDIM

MAPRC:	HLRZ TT,T		;UML ROW is DIP column on card
	HRRZS T			;UML COL is DIP row on card
	EXCH T,TT
	MOVNS T
	ADDI T,=24+1		;FIRST ROW IS 24
	CAIGE T,=15
	 SUBI T,4		;SKIP UNIVERSAL COLS
	SKIPG T
	 POPJ P,
	MOVNS TT
	ADDI TT,L.J+1
	CAIGE TT,L.D
	 POPJ P,
	MOVE TTT,T
	SETZ T,
	DPB TT,[%DIPG,,T]
	DPB TTT,[%DIPS,,T]
	JRST CPOPJ1

;Generate sequence of connector pins for UML printout
;T= connector "group" - 1A,1B,..,2A,...,X,...
;TT = padlet - 1:36

MAPPAD:	CAILE T,=9
	 JRST MAPLUZ
	CAILE TT,=36
	 JRST MAPLUZ
	CAILE T,6		;BACK CONN?
	 JRST [	ADDI T,L.X-7
		DPB T,[%CONN,,T]
		JRST MAPPA1]
	CAILE T,3
	 JRST [	SUBI T,3    TRO T,40    JRST .+1]
	DPB T,[%CONN,,T]

MAPPA1:	TLO T,MAPCON!MAPSOC
	DPB TT,[%%PINN,,T]
	SETZ TTT,
	DPB TTT,[%CONP,,T]
	POPJ P,

MAPLUZ:	SETZ T,
	POPJ P,

;Find a PWR/GND pin on board closest to this pin

STORAGE(IMPURE)
FPWRGND:	0	;EITHER VPIN OR GPIN
FPWRPTR:	0	;INDEX OF CUURENT CANDIDATE
STORAGE(PURE)

;A = MAPSOC+$$PINN,,LOC
;B = VOLTAGE

FPWR:	CAIE B,=500		;+5.00V??
	 JRST [	SETZ A,
		POPJ P,]
	SKIPA T,[MAPSOC+VPIN]
FGND:	 MOVEI T,MAPSOC+GPIN
	MOVEM T,FPWRGND		;WHAT TO LOOK FOR
	JUMPL A,FPWCON		;A CONNECTOR?
	LDB T,[%DIPS,,A]	;COLUMN OF PIN
	SKIPN UNICOL(T)		;IN UNIVERSAL AREA?
	 JRST [	MOVE T,FPWRGND	;NO, SIMPLE
		DPB T,[%%PINN,,A]	;MAKE INTO V,G PIN
		POPJ P,]	
;In universal area, look for V,G pin on eother side
	MOVEI T,FPWUNI-1	;LIST OF SLOTS AROUND UNIVERSAL
FPWR1:	MOVEM T,FPWRPTR
	PUSHJ P,FINDCLOSEST
	 POPJ P,		;RETURNS HERE WITH BEST
	AOS T,FPWRPTR
	SKIPGE A,(T)
	 POPJ P,		;END OF LIST
	HRL A,FPWRGND
	JRST CPOPJ1

FPWCON:	LDB TT,[%CONN,,A]	;FRONT OR BACK?
	TRZ TT,40
	MOVEI T,FPWFR-1		;Search on front dips slots
	CAIL TT,L.X
	 MOVEI T,FPWBAK-1	;Search on back dips slots
	JRST FPWR1
	
;Search list around universal area

FPWUNI:	DIPSLT(D,10)
	DIPSLT(E,10)
	DIPSLT(F,10)
	DIPSLT(G,10)
	DIPSLT(H,10)
	DIPSLT(J,10)
	DIPSLT(D,15)
	DIPSLT(E,15)
	DIPSLT(F,15)
	DIPSLT(G,15)
	DIPSLT(H,15)
	DIPSLT(J,15)
	-1

FPWFR:	DIPSLT(D,1)
	DIPSLT(D,2)
	DIPSLT(D,3)
	DIPSLT(D,4)
	DIPSLT(D,5)
	DIPSLT(D,6)
	DIPSLT(D,7)
	DIPSLT(D,8)
	DIPSLT(D,9)
	DIPSLT(D,10)	;DON'T LOOK IN UNIVERSAL
	DIPSLT(D,15)
	DIPSLT(D,16)
	DIPSLT(D,17)
	DIPSLT(D,18)
	DIPSLT(D,19)
	DIPSLT(D,20)
	DIPSLT(D,21)
	DIPSLT(D,22)
	DIPSLT(D,23)
	DIPSLT(D,24)
	-1

FPWBAK:	DIPSLT(J,1)
	DIPSLT(J,2)
	DIPSLT(J,3)
	DIPSLT(J,4)
	DIPSLT(J,5)
	DIPSLT(J,6)
	DIPSLT(J,7)
	DIPSLT(J,8)
	DIPSLT(J,9)
	DIPSLT(J,10)	;DON'T LOOK IN UNIVERSAL
	DIPSLT(J,15)
	DIPSLT(J,16)
	DIPSLT(J,17)
	DIPSLT(J,18)
	DIPSLT(J,19)
	DIPSLT(J,20)
	DIPSLT(J,21)
	DIPSLT(J,22)
	DIPSLT(J,23)
	DIPSLT(J,24)
	-1

FOR NAME IN (GNDCLR:,WAGGND:,GNDOUT:,VCCOUT:)
<NOTYET(NAME)
>
>;MWL
BEND MUPAC