;<DRAW>REP.FAI.42, 15-NOV-75 18:07:41, EDIT BY HELLIWELL
VERSION(REP,2)
;REPLACEMENT FOR BODIES
; USES A CORRESPONDENCE LIST
;	TPIN IN OLD TYPE	,,	link
;	PIN-ID			,,	TPIN IN NEW TYPE

;INITIALIZE CORLST FOR ALL PINS ON OLDTYP
REPLST:	SKIPE B,CORLST
	 PUSHJ P,PUTFS		;RECLAIM OLD LIST, IF ANY
	SETZM CORLST
	MOVEI G,CORLST		;POINT TO IT
	MOVE A,OLDTYP		;OLD BODY
	FETCH(A,A,TPIN)
	JUMPE A,CPOPJ
CORNXT:	GETFS(T)
	SETZM 1(T)
	HRRM T,(G)	;LINK NEW BLOCK
	MOVE G,T
	HRLZM A,(G)	;SAVE TYPE PIN POINTER
CORPIN:	FETCH(A,A,TPNX)
	JUMPN A,CORNXT
	POPJ P,

;REPSET - SET CORRESPONDENCES FOR REPLACEMENT
;A = TYPE TO REPLACE

REPSET:	MOVEM A,OLDTYP
MD,<	MOVEI T,[ASCIZ/TYPE NEW BODY NAME
/]
>;MD
	PUSHJ P,BODYGT
	 POPJ P,			;ALTMODE
	 POPJ P,			;NULL
	 JRST OOPS1		;NX
	MOVEM A,NEWTYP
REPST1:	PUSHJ P,REPLST		;INTIALIZE CORLST
MD,<	MOVE T,[ASCID/BR/]
	MOVEM T,SPMODT
	MOVEI T,SPM
	PUSHJ P,TCHNGM
	MOVEI T,UPREP
	MOVEM T,SPDISP
	PUSHJ P,PUSHM		;SET PIN IDS ON
	PUSH P,H
	PUSHJ P,REPAGN
	 CAIA
	  AOS -1(P)
	POP P,H
	PUSHJ P,POPM		;RESTORE STATE OF PIN IDS
	JRST RCHNGM		;RESTORE OLD MODE
>;MD
;REPAGN - ASK FOR REPLACEMENT MODE
REPAGN:	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/REPLACEMENT MODE (H FOR HELP)?/]
MD,<	SETZM KEEPIN		;CLEAR KEEP PINS FLAG
	SETZM COPPRP		;  " COPY PROPERTIES FLAG
>;MD
MAINTP:	PUSHJ P,GETCHR
	CAIL C,"A"+40
	CAILE C,"Z"+40
	CAIA
	SUBI C,40
	CAIE C,12
	TLNE M,DSKACT!MACACT
	CAIA
	OUTSTR[ASCIZ/
/]
	CAIE C,"H"
	CAIN C,"?"
	JRST [	TVOFF
		TLNN M,DSKACT!MACACT
MD,<		OUTSTR[ASCIZ/CHAR	MODE
E	EXACT MATCH BY DEFAULT PIN NAME
N	CLOSEST MATCH BY DEFAULT PIN NAME
L	EXACT GEOMETRIC OVERLAY
C	CLOSEST GEOMETRIC OVERLAY
<CR>	ASK ABOUT EACH PIN
<ALT>	ABORT
M	MAINTAIN PIN NAMES (PRECEEDS OTHER COMMANDS)
P	COPY BODY TEXT AND PROPERTIES
/]
>;MD
MPC,<		OUTSTR[ASCIZ/CHAR	MODE
N	MATCH BY PIN #
L	EXACT GEOMETRIC OVERLAY
C	CLOSEST GEOMETRIC OVERLAY
<CR>	ASK ABOUT EACH PIN
<ALT>	ABORT
/]
>;MPC
		TVON
		JRST MAINTP]
MD,<	CAIN C,"M"
	JRST [	SETOM KEEPIN
		TLNN M,DSKACT!MACACT
		OUTSTR[ASCIZ/MAINTAINING PIN NAMES./]
		JRST MAINTP]
	CAIN C,"P"
	JRST [	SETOM COPPRP
		TLNN M,DSKACT!MACACT
		OUTSTR[ASCIZ/COPYING PROPERTIES AND TEXT./]
		JRST MAINTP]
>;MD
	CAIN C,ALTMOD
	POPJ P,
MPC,<	CAIN C,"N"
	 JRST SAME
>;MPC
MD,<	CAIN C,"N"
	 JRST CNMAT
	CAIN C,"E"
	 JRST ENMAT
>;MD
	CAIN C,"L"
	 JRST REPLOC
	CAIN C,"C"
	 JRST REPCLS		;MORE FORGIVING THAN L
	CAIE C,12
	 JRST [	PUSHJ P,PERRET
		JRST REPAGN]
;Set correspondences manually
	MOVEI G,CORLST
	TLNN M,DSKACT!MACACT
MD,<	OUTSTR[ASCIZ/TYPE CORRESPONDENCE FOR PIN ID'S.
/]
>;MD
MPC,<	OUTSTR[ASCIZ/TYPE CORRESPONDENCE FOR PIN NAMES.
/]
>;MPC
	JRST GETIN

;GETPIN - ASK FOR CORRESPONDENCES
GETPIN:	TLNE M,DSKACT!MACACT
	JRST NOTALK
MD,<	OUTSTR[ASCIZ/OLD PIN ID /]	>
MPC,<	OUTSTR[ASCIZ/OLD PIN NAME /]	>
	HLRZ T,(G)		;PIN IN DEF
	FETCH(T,T,TPID)
MD,<	PUSHJ P,DECOUT		;PRINT PIN ID
>;MD
MPC,<	HRRZ A,T
	PUSH P,PUTCHR
	MOVE T,[OUTCHR TTT]
	MOVEM T,PUTCHR
	PUSHJ P,BPINPN		;PRINT AS BODY PIN#
	POP P,PUTCHR
>;MPC
	OUTSTR[ASCIZ/=/]
NOTALK:
MPC,<	MOVE C,[PUSHJ P,GETLCH]
	MOVEM C,GTCHRX
	PUSHJ P,RPNAM
	CAIA
>;MPC
MD,<	PUSHJ P,READN	>
	CAIE C,12
	JRST [	PUSHJ P,SCARF
		JRST REPST1
		JRST GETPIN]
	SETZ A,
	JUMPE T,NEWOK
	MOVEI A,CORLST
	JRST CHKNUM
;Check if the new PIN# already asked for
CHKNXT:	HLRZ TT,1(A)		;NEW PIN NUMBERS ASKED FOR ALREADY
	CAMN TT,T
	 JRST [	TLNN M,DSKACT!MACACT
		OUTSTR[ASCIZ/ALREADY USED!
/]
		JRST GETPIN]
CHKNUM:	HRRZ A,(A)
	JUMPN A,CHKNXT
	MOVE A,NEWTYP
	FETCH(A,A,TPIN)
	JRST NEWCH1
;Check if the PIN# asked for is in new TYPE
NEWNXT:	FETCH(TT,A,TPID)
	CAMN TT,T
	 JRST NEWOK
NEWCHK:	FETCH(A,A,TPNX)
NEWCH1:	JUMPN A,NEWNXT
	TLNN DSKACT!MACACT
	OUTSTR[ASCIZ/NO SUCH PIN IN NEW TYPE!
/]
	JRST GETPIN

NEWOK:	HRLM T,1(G)		;PIN# ASKED FOR
	HRRM A,1(G)		;THAT PIN IN NEW TYPE
GETIN:	MOVE H,G
	HRRZ G,(G)
	JUMPN G,GETPIN
;SAMEDN - FINISH UP CORLST WITH ALL OTHER PINS ON NEWTYP
;FALLS THRU
SAMEDN:	MOVE G,NEWTYP
	FETCH(G,G,TPIN)
	JRST REPNW9

REPNEW:	GETFS(T)
	HRRZM G,1(T)
	EXCH T,CORLST
	HRRZM T,@CORLST
REPNW1:	FETCH(G,G,TPNX)
REPNW9:	JUMPE G,CPOPJ1
	FETCH(T,G,TPID)		;A PIN ON NEW TYPE
	SKIPN A,CORLST		;CHECK IF ALREADY ON CORLST
	 JRST REPNEW
REPNW3:	HLRZ TT,1(A)
	CAMN TT,T
	 JRST REPNW1		;OK, IT'S THERE
REPNW2:	HRRZ A,(A)
	JUMPN A,REPNW3
	JRST REPNEW		;NOT THERE, CONS NEW ENTRY ONTO CORLST
;SAME - CORRESPOND TO SAME PIN# IN NEWTYP
MPC,<
;SETUP CORRESPENDENCES - SAME PIN# IN NEWTYP
SAME:	SKIPN G,CORLST		;RUN DOWN CORLST
	 JRST SAMEDN
SAME4:	HLRZ T,(G)		;OLD PIN (IN TYPE)
	FETCH(T,T,TPID)		;ITS PIN #
	MOVE A,NEWTYP
	FETCH(A,A,TPIN)
	JUMPE A,SAME3
SAME2:	FETCH(TT,A,TPID)
	CAME T,TT		;SAME PIN IN NEW TYPE?
	JRST SAME1
	HRRZM A,1(G)		;REMEMBER NEW PIN (IN TYPE)
	HRLM T,1(G)		;  " PIN #
SAME3:	HRRZ G,(G)
	JUMPE G,SAMEDN
	JRST SAME4

SAME1:	HRRZ A,(A)
	JUMPN A,SAME2
	JRST SAME3
>;MPC

;AUTO REPLACE 
MPC,<
REPCL1:	PUSHJ P,REPLST		;INITIALIZE CORLST
>;MPC
REPLOC:				;OFFSET CRAP GOES HERE
	PUSHJ P,REPCL4
	 JRST RPLERR
	JRST SAMEDN

RPLERR:	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/
SORRY, NO EXACT MATCH BY GEOMETRIC OVERLAY POSSIBLE.
/]
	JRST REPST1

;FIND CLOSEST PIN YET UNREPLACED
;A = PIN IN NEW TYPE
;RETURNS
;CURPIN = PIN FOUND CLOSEST
;CURDIS = DISTANCE  "
FCLONE:	SETZM CURPIN		;NO CLOSEST YET!
	HRLOI T,77777		;LARGE NUMBER
	MOVEM T,CURDIS		;CURRENT CLOSEST DISTANCE
REPL3:	SKIPE 1(G)		;HAVE WE FOUND THIS ONE YET?
	 JRST REPL2		;YES, SKIP IT
	HLRZ T,(G)		;POINTER TO OLD PIN TYPE BLOCK
	FETCH(T,T,TPXY)		;OLD PIN LOCATION
	ADJUST(SUB,T,<ADDR(A,TPXY)>)
	HLRE TT,T
	HRRES T
	IMUL T,T
	IMUL TT,TT
	ADD T,TT		;SQUARE OF DISTANCE
	CAML T,CURDIS		;SMALLER?
	 JRST REPL2		;NO
	MOVEM T,CURDIS		;UPDATE
	MOVEM G,CURPIN
REPL2:	HRRZ G,(G)		;ANOTHER MEMBER OF CORLST
	JUMPN G,REPL3
	POPJ P,
;GEOMETIC OVERLAY FOR DIFF NUMBER OF PINS
%MAX__20	;MAX SEPARATION BETWEEN PINS IN ORDER TO MATCH!

REPCLS:				;OFFSET STUFF GOES HERE ???
	PUSHJ P,REPCL4
	 JFCL			;THIS VERSION DOESN'T CARE
	JRST SAMEDN

REPCL4:	SKIPN CORLST
	 POPJ P,
	MOVE A,NEWTYP
	FETCH(A,A,TPIN)
	JUMPE A,CPOPJ
	HRLOI B,77777
	SETZ H,			;NONE FOUND YET
REPCL2:	FETCH(T,A,TPID)
	HRL A,T			;PIN#,,PIN
	TRZ TFLG
	MOVE G,CORLST
REPCL5:	CAMN A,1(G)		;IS IT MAPPED YET?
	 JRST REPCL3		;YES, TRY ANOTHER
	HRRZ G,(G)
	JUMPN G,REPCL5
	TRO TFLG		;FLAG UN-MAPPED NEW PIN SEEN
	MOVE G,CORLST		;NOT USED YET, CHECK DISTANCE
	PUSHJ P,FCLONE		;FIND ONE
	SKIPN CURPIN		;DID WE FIND ONE
	 POPJ P,		;NO, RAN OUT OF CORLST I GUESS
	CAMG B,CURDIS		;IS IT CLOSEST YET?
	 JRST REPCL3		;NO
	MOVE B,CURDIS
	MOVE H,CURPIN		;SAVE CLOSEST YET
	HRL H,A			;SAVE BOTH POINTERS
REPCL3:	HRRZ A,(A)
	JUMPN A,REPCL2		;LOOP THROUGH ALL
	JUMPE H,REPCL6
	CAILE B,%MAX*%MAX	;TO FAR APART?
	 POPJ P,
	HLRZ A,H		;GET POINTER TO NEW PIN
	FETCH(T,A,TPID)
	HRL A,T			;AND PIN ID
	MOVEM A,1(H)		;AND SAVE HERE
	JRST REPCL4		;LOOP UNTIL ALL ASSIGNED

REPCL6:	TRNE TFLG		;ALL NEW PINS MAPPED?
	 POPJ P,		;NO, LOSE RETURN
	MOVE H,CORLST
REPCL7:	SKIPN 1(H)		;THIS OLD PIN MAPPED?
	 POPJ P,		;NO, LOSE
	HRRZ H,(H)
	JUMPN H,REPCL7
	JRST CPOPJ1		;ALL OLD PINS MAPPED, WIN
;MAP BY DEFAULT PIN NAMES
MD,<
CNMAT:	PUSHJ P,DONMAT		;BEST MATCH BY DEFAULT PIN NAMES
	 JFCL
	JRST SAMEDN

;AUTO REPLACE 

REPCL1:	PUSHJ P,REPLST		;INITIALIZE CORLST
	SETOM KEEPIN		;MAKE SURE WE KEEP PINS
	SETOM COPPRP		;AND PROPERTIES

ENMAT:	PUSHJ P,DONMAT		;EXACT MATCH ONLY, BY DEFAULT PIN NAMES
	 JRST ENERR
	JRST SAMEDN

ENERR:	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/
SORRY, NO EXACT MATCH BY DEFAULT PIN NAME POSSIBLE.
/]
	JRST REPST1

;DONMAT - MATCH PINS BY DEFAULT PIN NAMES, TRIES ITS DAMNDEST
DONMAT:	SKIPN CORLST
	 POPJ P,
	TRZ TFLG!ATLP		;TFLG MEANS MATCH WASN'T EXACT
;Clear mark bits on all PINs of new TYPE
	MOVE A,NEWTYP
	FETCH(A,A,TPIN)
	JUMPE A,CPOPJ
DONMT0:	CLRBIT(DPTMP1!DPTMP2,TT,A,TPBIT)
	FETCH(A,A,TPNX)
	JUMPN A,DONMT0
	MOVE A,NEWTYP
	FETCH(A,A,TPIN)
DONMT1:	FETCH(T,A,TPBIT)	;FIND A PIN NOT ASSIGNED YET
	TRNE T,DPTMP1
	 JRST DONMT6
	ANDI T,BASSLH
	FETCH(TT,A,TPNAM)	;DEFAULT NAME
	HRL T,TT		;T = DEF NAME,,BASSLH
	FETCH(B,A,TPNX)
	JUMPE B,DONMT3
;Check for any other PINS with same default on the new type
DONMT2:	FETCH(TTT,B,TPBIT)
	ANDI TTT,BASSLH
	FETCH(TT,B,TPNAM)
	HRL TTT,TT
	CAMN TTT,T		;SAME DEFAULT, BUSSED, L/H ?
	 JRST [	TRO TFLG	;YES, MATCH ISN'T EXACT
		JRST DONMT3]
	FETCH(B,B,TPNX)
	JUMPN B,DONMT2
;Check for only one pin on old type with matching default
DONMT3:	MOVE G,CORLST
	SETZM CURPIN
DONMT4:	SKIPE 1(G)		;NOT MATCHED YET?
	 JRST DONMT5
	HLRZ TT,(G)
	FETCH(TTT,TT,TPNAM)
	PUSH P,TTT
	FETCH(TTT,TT,TPBIT)
	ANDI TTT,BASSLH
	HRL TTT,(P)
	SUB P,[1,,1]
	CAME TTT,T
	 JRST DONMT5
	SKIPE CURPIN
	 JRST [	TRO TFLG		;MORE THAN ONE POSSIBLE MATCH ON OLD BODY
		JRST DONMTB]
	MOVEM G,CURPIN
DONMT5:	HRRZ G,(G)
	JUMPN G,DONMT4
DONMTB:	SKIPN G,CURPIN
	 JRST [	TRO ATLP	;NEW PIN NOT MATCHED ON OLD BODY
		JRST DONMT6]
	FETCH(T,A,TPID)
	HRL A,T
	MOVEM A,1(G)		;UNIQUE MATCH, SET CORRESPONDENCE
	SETBIT(DPTMP1,TT,A,TPBIT)
DONMT6:	FETCH(A,A,TPNX)
	JUMPN A,DONMT1
;FALLS THRU
;TRY LOOSER MATCH
	TRNN ATLP		;ANY NOMATCH ON A NEW PIN ?
	 JRST REPCL6		; NO, CHECK IF ANY ERRORS IN MATCHING
;PASS2 - Try looser match, for those pins that weren't found above
	MOVE A,NEWTYP
	FETCH(A,A,TPIN)
DONMA1:	FETCH(T,A,TPBIT)
	TRNE T,DPTMP2!DPTMP1	;UNMATCHED?
	 JRST DONMA6
NODEC,<	FETCH(T,A,TPNAM) >	;LOOK FOR ANY PIN WITH SAME DEFAULT PIN NAME
DEC,<	ANDI T,BUSSED		;DEC, A LITTLE STRICTER, SINCE WE DID L/H LAST TIME
	FETCH(TT,A,TPNAM)
	HRL T,TT
>;DEC
	FETCH(B,A,TPNX)
	JUMPE B,DONMA3
DONMA2:
NODEC,<	FETCH(TTT,B,TPNAM) >	;,,TPNAM
DEC,<	ANDI TTT,BUSSED
	FETCH(TT,B,TPNAM)
	HRL TTT,TT		;TPNAM,,BUSSED
>;DEC
	CAMN TTT,T
	 JRST [	FETCH(TTT,B,TPBIT)	;SAME DEFAULT
		TRNE TTT,DPTMP1		; APPEARS UNMATCHED TWICE ON NEW TYPE?
		 JRST .+1
		TRO TFLG		;LOOSER MATCH IS AMBIGUOUS
		JRST DONMA3]
	FETCH(B,B,TPNX)
	JUMPN B,DONMA2
;Now see if there is a single pin in old TYPE that matches this looser eqv
DONMA3:	MOVE G,CORLST
	SETZM CURPIN
DONMA4:	SKIPE 1(G)		;NOT MATCHED YET?
	 JRST DONMA5
	HLRZ TT,(G)
NODEC,<	FETCH(TTT,TT,TPNAM) >	;,,TPNAM
DEC,<	FETCH(TTT,TT,TPBIT)
	ANDI TTT,BUSSED
	PUSH P,TTT
	FETCH(TTT,TT,TPNAM)
	HRLM TTT,(P)
	POP P,TTT		;TPNAM,,BUSSED
>;DEC
	CAME TTT,T
	 JRST DONMA5
	SKIPE CURPIN		;MATCHES TOO MANY IN OLD TYPE?
	 JRST [	TRO TFLG	;MATCH NOT EXACT, BUT DO OUR BEST
		JRST DONMA7]
	MOVEM G,CURPIN
DONMA5:	HRRZ G,(G)
	JUMPN G,DONMA4
DONMA7:	SKIPN G,CURPIN
	 JRST [	TRO TFLG	;NO MATCH FOR THIS PIN, ERROR
		JRST DONMA6]
	FETCH(T,A,TPID)
	HRL A,T
	MOVEM A,1(G)
	SETBIT(DPTMP2,TT,A,TPBIT)	;NOT NEEDED?
DONMA6:	FETCH(A,A,TPNX)
	JUMPN A,DONMA1
	JRST REPCL6

;THERE SHOULD PROBABLY BE N PASSES, IN ORDER OF INCREASING LOOSENESS
>;MD

REPONE:	PUSHJ P,GETCLS
	 POPJ P,
	PUSH P,A
	FETCH(A,A,BTYP)
	PUSHJ P,REPSET		;SET UP CORRESPONDENCE
	 JRST [	POP P,(P)
		JRST CLRREP]
	POP P,G
	PUSHJ P,REPIT
	TRO MCHG
	JRST CLRREP
IFN 0,<	PUSHJ P,CLRREP		;STRAIGHTEN AUTOMATICALLY?
MD,<	JRST STRAIGHTEN	>
MPC,<	POPJ P,		>
>;IFN 0

REPALL:
MD,<	MOVEI T,[ASCIZ/TYPE OLD BODY NAME
/]
>;MD
	PUSHJ P,BODYGT
	 POPJ P,			;ALTMODE
	 POPJ P,			;NULL
	 JRST OOPS1		;NX
	PUSHJ P,REPSET
	 JRST CLRREP

REPLOP:
	TRO MCHG
	SKIPN G,DBODPN
	 JRST CLRREP
REPLP2:	FETCH(B,G,BTYP)
	CAMN B,OLDTYP	;DOES THIS BODY HAVE THE RIGHT TYPE?
	 PUSHJ P,REPIT
REPLP1:	FETCH(G,G,BNXT)
	JUMPN G,REPLP2
	JRST CLRREP
IFN 0,<	PUSHJ P,CLRREP
MD,<	JRST STRAIGHTEN	>
MPC,<	POPJ P,		>
>;IFN 0

;REPSOME - SELECTIVE REPLACE BODY
REPSOME:
MD,<	MOVEI T,[ASCIZ/TYPE OLD BODY NAME
/]
>;MD
	PUSHJ P,BODYGT
	 POPJ P,			;ALTMODE
	 POPJ P,			;NULL
	 JRST OOPS1		;NX
	PUSHJ P,REPSET
	 JRST CLRREP		;LET HIM OUT
	MOVEI T,UPSTAR		;WHERE TO GO IN UPCLOS
	MOVEM T,SPDISP
	MOVE T,[ASCID/BR/]
	MOVEM T,SPMODT
	MOVEI T,SPM
	PUSHJ P,TCHNGM		;GET INTO SPECIAL POINTER MODE
	SKIPN G,DBODPN
	 JRST REPALT
	JRST REPSP1
REPSPC:	MOVE G,CURREP
	HRRZ G,(G)
	JUMPE G,REPALT
REPSP1:	MOVEM G,CURREP
	FETCH(A,G,BTYP)
	CAME A,OLDTYP
	 JRST REPSPC		;KEEP LOOKING
	MOVEI T,BIGPG
	MOVEM T,PGLASS
	PUSHJ P,DPYSET
	PUSHJ P,SETBRT
	FETCH(T,G,BXY)
	TLNE M,DSKACT!MACACT
	 JRST ISON		;NO, ALL BODIES ARE ON
	PUSHJ P,ONSCR		;IS IT ON SCREEN?
	 PUSHJ P,PICSET		;NO, GET IT ON
ISON:	MOVEM T,STARLOC
	TLNN M,DSKACT!MACACT
	OUTSTR[ASCIZ/
THIS ONE/]
	PUSHJ P,YORN
	 JRST REPALT
	 JRST REPSPC
	MOVE G,CURREP
	PUSHJ P,REPIT
	TRO MCHG
IFN 0,<MD,<	PUSHJ P,STRAIGHTEN	>>
	JRST REPSPC

REPALT:	PUSHJ P,RCHNGM		;RESTORE OLD MODE
CLRREP:	SKIPE B,CORLST
	PUSHJ P,PUTFS
	SETZM CORLST
	POPJ P,

;REPLACE BODY
; G = OLD BODY
; NEWTYP = NEW TYPE
; OLDTYP = TYPE OF OLD BODY

REPIT:	PUSH P,G
	MOVE T,NEWTYP
	STORE(T,G,BTYP)
MD,<	CAMN T,OLDTYP		;DON'T COPY PROPERTIES IF SAME BODY
	 JRST REPITP
	HRRZ T,(P)
	PUSHJ P,OFFBLO		;FIX CHAR OFFSET IF BIT ON
	FETCH(T,G,BBIT)
	TRNN T,FIXLOC		;LOCN FOLLOWING DEFAULT?
	 JRST NFXBLC
	FETCH(B,G,BLOC)		;YES, AND THERE IS LOCN?
	JUMPE B,NFXBLC		;JUST IN CASE
	MOVE A,G
	PUSHJ P,STLCOF		;SET LOCN OFFSET FROM NEW TYPE
NFXBLC:	FETCH(C,G,BTXT)		;BODY PROP LIST
	CLEAR(G,BTXT)		;ZERO POINTER TO IT
	SKIPN COPPRP		;COPY PROPERTIES?
	JRST [	PUSHJ P,TXTREL	;NO, RELEASE PROP LIST STG IN C
		JRST REPITP]
	JUMPE C,REPITP		;NOTHING TO DO IF NO LOCAL PROPS
;Now merge local PROP/TEXT with those from TYPE def
	MOVE A,G		;GET BODY POINTER
	PUSHJ P,COPLTP		;COPY TYPE'S TEXT/PROPERTIES INTO BODY'S INDIRECT LIST
	MOVE B,C		;OLD PROP LIST IN B
	PUSHJ P,MERGEP		;MERGE OLD PROPS ONTO NEW
	PUSHJ P,TXTREL		;RECLAIM OLD PROP LIST (C)
REPITP:
>;MD
MPC,<	SWITCH
	MOVEI G,RADDR(G,BLNK,BPLNK)	;MAKE FIRST PTR LOOK LIKE REST OF LIST
	HRRZ F,(P)		;BODY
	PUSHJ P,REPIT1		;DO BACK SIDE FIRST
	HRRZ G,(P)
	SWITCH
>;MPC
	MOVEI G,RADDR(G,BLNK,BPLNK)	;MAKE FIRST PTR LOOK LIKE REST OF LIST
	HRRZ F,(P)		;BODY
	PUSHJ P,REPIT1		;DO IT
	HRRZ A,(P)		;BODY POINTER
	PUSHJ P,BODFIX		;FIX ALL THE PINS ON IT!
	POP P,G			;RESTORE BODY POINTER
	POPJ P,

;REPIT1 - REPLACE PINS ON BODY BEING REPLACED
;G = RADDR(,BLNK,BPLNK)
;F = BODY POINTER

;REPIT2
;G = BPOINT
;H = PREVIOUS
;A = CORRESPONDENCE BLOCK
REPIT2:	HRRZ T,1(A)
	JUMPN T,REPDL5		;REPLACE?
	MOVE B,G
	FETCH(G,G,BPLNK)	;NO, TURN INTO POINT
	STORE(G,H,BPLNK)	;LINK THIS PIN OUT
	PUSHJ P,PINPNT		;CHANGE PIN TO PLAIN POINT
	JRST REPDL4

REPDL5:	STORE(T,G,BPLOC)	;NEW TYPE PIN POINTER
MD,<	SKIPN KEEPIN		;KEEPING PIN #'S?
	 CLEAR(G,BPPN)		;NO, FLUSH THEM
>;MD
	PUSH P,F
	FETCH(B,G,BBODY)	;BODY POINTER
	FETCH(F,B,BORI)		;GET ORIENTATION FROM OLD BODY
	FETCH(T,T,TPXY)		;X,Y FROM PIN TYPE BLOCK
	PUSHJ P,ORIENT		;ORIENT IT
	ADJUST(ADD,T,<ADDR(B,BXY)>)	;ADJUST TO BODY LOCATION
	MOVE A,SAVEG
MD,<	PUSH P,G
	PUSHJ P,PMOVRL		;MOVE TO NEW POS!
	POP P,G
>;MD
	POP P,F
REPIT1:	MOVE H,G		;SAVE POINTER TO PREVIOUS FOR LINK OUT
	FETCH(G,G,BPLNK)
REPDL4:	JUMPE G,REPMAK		;DONE WITH OLD PINS, NOW MAKE EXTRA PINS
	MOVEM G,SAVEG
MPC,<	FETCHL(TT,G,BPBIT)
	EQV TT,SID
	JUMPGE TT,REPIT1	;SAME SIDE?
>;MPC
	FETCH(T,G,BPLOC)
	MOVEI A,CORLST		;CORRESPONDENCE LIST
	JRST REPIT3

REPIT4:	HLRZ TT,(A)
	CAMN TT,T		;SAME PIN IN TYPE?
	 JRST REPIT2
REPIT3:	HRRZ A,(A)
	JUMPN A,REPIT4
	OUTSTR[ASCIZ/POINT NOT FOUND AT REPIT4!!
/]
	PUSHJ P,FUCKUP
	JRST REPIT1		;THIS SHOULDN'T HAVE HAPPENED
;REPMAK - MAKE EXTRA PINS IN NEW BODY

;H = END OF BPOINT LIST
;F = BODY
REPMAK:	MOVEI G,CORLST		;MAKE EXTRA PINS REQUIRED BY REPLACEMENT
	PUSH P,F		;BODY
	JRST REPMK1

REPMK2:	HLRZ A,(G)		;TPIN OF OLD PIN
	JUMPN A,REPMK1		;NOT A NEW PIN?
	HRRZ A,1(G)		;POINTER TO NEW TPIN BLOCK
	MOVE B,(P)		;BODY POINTER
	HRLI B,ISPIN		;PIN
	PUSHJ P,PUTPNT		;MAKE IT (D RETURNED = POINT CREATED)
MPC,<	FETCH(TT,A,TPID)	;PIN # FROM DEF
	MOVEI T,1		;INITIALLY USE NORMAL PAD FOR PIN
	CAIN TT,1		;PIN 1?
	 MOVEI T,3		;MAKE IT END UP PAD TYPE 3 (SQUARE)
	STORE(T,D,BPPN)
>;MPC
	STORE(D,H,BPLNK)	;LINK ONTO END OF OLD PIN LIST
	MOVE H,D		;MAKE THIS NEW ONE END OF LIST
REPMK1:	HRRZ G,(G)
	JUMPN G,REPMK2
	POP P,F
	POPJ P,