mirror of
https://github.com/PDP-10/its.git
synced 2026-04-25 03:45:11 +00:00
SUDS - Stanford University Drawing System.
This commit is contained in:
Lars Brinkhoff
701
src/draw/rep.337
Normal file
701
src/draw/rep.337
Normal file
@@ -0,0 +1,701 @@
|
||||
;<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,
|
||||
Reference in New Issue
Block a user