github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-17 00:33:22 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/wl/wldip.329
Lars Brinkhoff 33074b453f SUDS - Stanford University Drawing System.
2018-05-05 19:19:09 +02:00

2638 lines
49 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;<WIRELIST>WLDIP.FAI.146, 20-NOV-75 10:14:55, EDIT BY HELLIWELL
SUBTTL 'DIP' CHANGE DIP FILENAME, PRINT DIP FILENAME
CNAME: MOVSI T,'DIP'
MOVEM T,DEFEXT
PUSHJ P,CFILE
POPJ P, ;NO CHANGE
MOVE T,FILNAM
MOVEM T,DIPNAM
MOVE T,FILEXT
MOVEM T,DIPNAM+1
SKIPN T,FILPPN
DSKPPN T,
MOVEM T,DIPPPN
JRST CPOPJ1
NDNAME: PUSHJ P,CNAME
JFCL
PUSHJ P,DNPNT
CRLF
POPJ P,
DNPNT: MOVE T,[OUTCHR TTT]
MOVEM T,PUTCHR
DNPNT1:
NOITS,<
PUTSIX DIPNAM
PUTBYT "."
HLLZ TTT,DIPNAM+1
PUTSIX TTT
IFE LIBPPN,<
SKIPN DIPPPN
POPJ P,
>;IFE LIBPPN
PUTBYT "["
NOCMU,<
HLLZ TT,DIPPPN
PUSHJ P,LSIXOUT
PUTBYT ","
HRLZ TT,DIPPPN
PUSHJ P,LSIXOUT
>;NOCMU
CMU,<
MOVE T,[DIPPPN,,PPNBUF]
DECCMU T,
JRST [ PUTSIX DIPPPN
JRST .+2 ]
PUTSTR PPNBUF
>;CMU
PUTBYT "]"
>;NOITS
ITS,<
SKIPN T,DIPNAM+3
DSKPPN T,
PUTSIX T
PUTBYT ";"
PUTSIX DIPNAM
PUTBYT 40
HLLZ T,DIPNAM+1
PUTSIX T
>;ITS
POPJ P,
; READ DIP FILE
DIPIN: SKIPE RESIDENT
JRST [NOMODR: OUTSTR[ASCIZ/SORRY, CAN'T MODIFY RESIDENT DIPS /]
JRST ERRET] ;FLUSH REST OF LINE
PUSHJ P,CNAME ;CHECK FOR NAME CHANGE
JFCL
SKIPE DIPLST ;GO AHEAD AND READ IF NONE AT ALL
JRST [ PUSHJ P,IERR
ASK[ASCIZ/SOME DIPS ALREADY IN, TYPE Y TO ADD MORE./]
POPJ P,
POPJ P,
JRST .+1]
PUSHJ P,DIPINS
OUTSTR[ASCIZ/ COULDN'T GET IT IN!
/]
POPJ P,
;READ DIP FILE
DIPCHK: SKIPE DIPLST ;ALREADY IN?
JRST CPOPJ1 ;NO
DIPINS: PUSHJ P,IN10 ;SET FOR IFULL WORD INPUT
POPJ P,
DIPINT: MOVE T,DIPPPN
MOVEM T,DIPNAM+3
DIPIN2: SETZM DIPNAM+2
HLLZS DIPNAM+1
MOVE T,DIPNAM+3
LOOKUP DAT,DIPNAM ;FIND FILE!
JRST [
IFN LIBPPN,< JUMPE T,DIPIN3 >
MOVEM T,DIPNAM+3
PUSHJ P,DNPNT
OUTSTR[ASCIZ/, LOOKUP FAILED.
TRY ANOTHER DIP FILENAME?/]
PUSHJ P,CNAME
JRST [ RELEASE DAT,
POPJ P,]
SKIPA T,DIPPPN
DIPIN3: MOVE T,[LIBPPN]
MOVEM T,DIPNAM+3
JRST DIPIN2]
MOVEM T,DIPNAM+3
PUSHJ P,DNPNT
MOVE T,[PUSHJ P,BYTIN]
MOVEM T,GETCHR
SETZM FACTR1 ;NO DIPS READ YET
MOVE T,.JBREL
LSH T,-12
MOVEM T,FACTR2
SETZM DVER ;ASSUME VERSION 0
PUSHJ P,BYTIN ;READ VERSION #
JRST DIPER1
JUMPGE TTT,DVER0
CAMGE TTT,[-DIPVER]
JRST [ OUTSTR[ASCIZ/I DON'T RECOGNIZE THIS VERSION #.
/]
JRST DIPER0]
MOVMS TTT
MOVEM TTT,DVER ;VERSION NUMBER IS -
CAIGE TTT,5 ;**DVER
OUTSTR [ASCIZ /
Old DIPVER, I'm setting package types from defaults,
maybe you should write this back out!
/]
;READ IN DIPS FROM DIPS.DIP
GTPINN: PUSHJ P,BYTIN ;READ NUMBER OF PINS ON THIS DIP!
JRST DIPER1
DVER0: JUMPE TTT,[ RELEASE DAT,
PUTBYT " "
MOVE T,FACTR1
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ DIPS READ/]
MOVE T,.JBREL
LSH T,-12
SUB T,FACTR2
JUMPE T,NXCOR
OUTSTR[ASCIZ/, /]
PUSHJ P,DECOUT
OUTSTR[ASCIZ/K CORE USED/]
NXCOR: OUTSTR[ASCIZ/.
/]
JRST CPOPJ1] ;DONE
GETFS (H,DHEAD)
BCLEAR(TT,H,DHEAD) ;CLEAN IT UP
STORE(TTT,H,DPNN) ;#PINS AS READ FROM FILE
PUSHJ P,RSTR
JRST [ OUTSTR[ASCIZ/ILLEGAL NULL DIPNAME!
/]
FSTRET(H,DHEAD)
POPJ P,]
STORE(T,H,DNAM) ;STO DIPNAME
MOVE T,DVER
CAIL T,5 ;**DVER
JRST GOTPAK
MOVSI A,-NPACK ;DEFAULT PACKAGE FROM # PINS
FETCH(TT,H,DPNN)
CAMN TT,PACKPN(A)
JRST GOTPK1
AOBJN A,.-2
JRST NOPAK
GOTPAK: PUSHJ P,RSTR
JRST NOPAK
MOVE B,T
PUSHJ P,MATPAK ;TRY TO FIND PACKAGE NAME
JRST [ PUSH P,T
FETCH(A,H,DNAM)
PUSHJ P,STROUT
OUTSTR [ASCIZ / has illegal package type - /]
POP P,A
PUSHJ P,STROUT
CRLF
SETZ A,
JRST .+1]
PUSHJ P,PUTFS ;RETURN NAME
GOTPK1: STORE(A,H,DPAK)
NOPAK: SKIPN T,DVER ;**DVER IS THERE A PART NUMBER STRING?
JRST NODPRT ;NO
CAILE T,1 ;OLDER VERSION HAS ONLY PART NUMBER
JRST NEWPRP ;ELSE NEW PROPERTY STUFF
PUSHJ P,RSTR ;READ PART NUMBER
JRST NODPRT ;IF NONE, ITS EASY
MOVE A,T ;SAVE PART NUMBER STRING
GETFS(B,PNBK) ;GET PROPERTY NAME BLOCK
BCLEAR(T,B,PNBK) ;CLEAR IT
STORE(B,H,PRPN) ;PUT IT INTO PROPERTY NAME LIST
MOVEI TT,[ASCIZ/PART NUMBER/]
PUSHJ P,ASCCOP ;MAKE INTERNAL STRING OF "PART NUMBER"
STORE(T,B,PRNS) ;STORE PROPERTY NAME
GETFS(C,PVBK) ;GET PROPERTY VALUE BLOCK
BCLEAR(T,C,PVBK) ;CLEAR IT
MOVEI T,DEFPRP!PARTNM ;MAKE IT A DEFAULT PROPERTY AND PART NUMBER
STORE(T,C,PRBT) ;STORE IN BITS
STORE(C,H,PRPV) ;PUT INTO PROPERTY VALUE LIST
STORE(A,C,PRVS) ;STORE PROPERTY VALUE STRING
STORE(B,C,PRNB) ;STORE POINTER TO PROPERTY NAME BLOCK
MOVE G,C
PUSHJ P,THRDPN ;THREAD NEW PART NUMBER
JRST NODPRT ;ALL DONE
;NEWPRP - New property list stuff
COMMENT 
A DIP's properties are arranged in a hierarchy of increasing
specification, which is terminated in a unique part number. (?)
At each level, a further specific property may be specified which
may assume a set of values. Sub-properties may appear under each
property value, until the part is completely specified. The depth
of the tree, and the sub-property's name at the next level are fixed
by the DIP's property name list. For example:
TTLDLY Delay Drive Part-number
10 ns 4 TTLDLY-10-4
10 TTLDLY-10-10
20 ns 10 TTLDLY-20-10
...

NEWPRP: MOVEI G,RADDR(H,PRPN,PRNN)
PRPNM1: PUSHJ P,RSTR
JRST PRPNMD ;0, DONE
GETFS(A,PNBK) ;GET PROPERTY NAME BLOCK
BCLEAR(TT,A,PNBK) ;CLEAR IT
STORE(A,G,PRNN) ;PUT IT AT END OF LIST
MOVE G,A ;MAKE IT END OF LIST
STORE(T,G,PRNS) ;STORE PROPERTY NAME IN BLOCK
JRST PRPNM1
PRPNMD: PUSHJ P,RSTR
JRST NODPRT ;NO VALUES
GETFS(F,PVBK)
BCLEAR(TT,F,PVBK)
STORE(T,F,PRVS) ;STORE PROPERTY VALUE STRING
MOVE TTT,DVER ;**DVER
CAIG TTT,2 ;MIT HAS VERSION WHICH DOESN'T READ/WRITE BITS
JRST [ MOVEI TTT,PARTNM!DEFPRP
JRST DV2A]
PUSHJ P,BYTIN
SETZ TTT, ;CATCH ERROR LATER
DV2A: STORE(TTT,F,PRBT) ;STORE BITS
STORE(F,H,PRPV) ;START PROPERTY VALUE LIST
FETCH(T,H,PRPN) ;GET START OF PROPERTY NAME LIST
STORE(T,F,PRNB) ;AND STORE IT
MOVE G,F
TRNE TTT,PARTNM ;IF PART NUMBER
PUSHJ P,THRDPN ;THEN ADD TO PARTLIST (SORTED)
PRPVL1: PUSHJ P,RSTR ;PUSH FOR NEXT DEEPER VALUE?
JRST PRPVL2 ;NO, READ MORE AT SAME LEVEL
; Push for sub-property value,
; which is named by next entry on PRNN property name list
GETFS(A,PVBK)
BCLEAR(TT,A,PVBK)
STORE(T,A,PRVS)
MOVE TTT,DVER ;**DVER
CAIG TTT,2 ;MIT HAS VERSION WHICH DOESN'T READ/WRITE BITS
JRST [ MOVEI TTT,PARTNM!DEFPRP
JRST DV2B]
PUSHJ P,BYTIN
SETZ TTT, ;CATCH ERROR LATER
DV2B: STORE(TTT,A,PRBT)
STORE(F,A,PRPP)
STORE(A,F,PRNP) ;MAKE US NEXT LEVEL DOWN
FETCH(T,F,PRNB)
SKIPE T
FETCH(T,T,PRNN) ;CDR PROPERTY NAME LIST
STORE(T,A,PRNB)
MOVE F,A ;MAKE US THE CURRENT LEVEL
MOVE G,F
TRNE TTT,PARTNM ;MAY HAVE REACHED THE PART NUMBER
PUSHJ P,THRDPN ; MAKE NEW ENTRY IN PARTLIST
JRST PRPVL1
;Continue reading alternate values for same property
;
PRPVL2: PUSHJ P,RSTR ;AT SAME LEVEL, READ NEXT VALUE
JRST PRPVL3 ;NONE, POP UP
GETFS(A,PVBK)
BCLEAR(TT,A,PVBK)
STORE(T,A,PRVS) ;STORE VALUE STRING
PUSHJ P,BYTIN
SETZ TTT, ;CATCH ERROR LATER
STORE(TTT,A,PRBT)
STORE(A,F,PRNV)
FETCH(T,F,PRPP) ;SIBLINGS SHARE SAME PARENT
STORE(T,A,PRPP)
FETCH(T,F,PRNB) ; AND SAME PROPERTY NAME
STORE(T,A,PRNB)
MOVE F,A
JRST PRPVL1
PRPVL3: FETCH(F,F,PRPP) ;BACK UP TO PREVIOUS LEVEL
JUMPN F,PRPVL2 ;LOOP BACK IF NOT TOP
;Have read DIPNAME and properties, now read DIP pins
NODPRT: MOVEI G,RADDR(H,DPIN,DPNXT)
FETCH(F,H,DPNN) ;NUMBER OF PINS
SETZM TMPCN1 ;CLEAR GENERATED PIN NAMES
AOJA F,NCLRSP ;GO DO END TEST
GTPINS: MOVE TT,DVER
CAIGE TT,4 ;**DVER NEW FORMAT?
JRST [ AOS TTT,TMPCN1 ;NO, MUST GENERATE
JRST GTPIN1] ;LOOK LIKE WE JUST READ IT
PUSHJ P,BYTIN
JRST DIPER2 ;ILL EOF
GTPIN1: MOVEM TTT,TMPCN2 ;SAVE HERE
PUSHJ P,BYTIN ;READ BITS,,PS#
JRST DIPER2
MOVE TT,TTT ;SAVE HERE
PUSHJ P,BYTIN ;READ HI,,LOW LOADING
JRST DIPER2
GETFS (T,DPHEAD)
BCLEAR(A,T,DPHEAD)
STORE(T,G,DPNXT)
MOVE G,T ;G NOW POINTS TO PIN HEADER
HRRZ T,TMPCN2 ;GET PIN NAME
STORE(T,G,DPNM) ;STORE IT
STORE(TT,G,PSWP)
HLRZ TT,TT
STORE(TT,G,DPBIT)
STORE(TTT,G,LLOW)
HLRZ TTT,TTT
STORE(TTT,G,LHI)
PUSHJ P,BYTIN ;READ USE
JRST DIPER2
STORE(TTT,G,DUSE)
PUSHJ P,BYTIN ;READ SECT BITS,,SECT PIN #
JRST DIPER2
STORE(TTT,G,SCTP) ;SECT PIN #
HLRZ TTT,TTT
STORE(TTT,G,SCTB) ;SECT BITS
FETCH(B,G,DPBIT)
TRNE B,INLD!OUTLD!TERM
JRST NCLRSP
CLEAR(G,SCTB)
CLEAR(G,SCTP)
CLEAR(G,PSWP)
NCLRSP: SOJG F,GTPINS
FETCH(T,H,DNAM)
MOVEM T,DSTRNG
DIPCHECK
PUSHJ P,DALPHA
JRST ISNEWD
FETCH(A,H,DNAM)
PUSHJ P,STROUT
OUTSTR[ASCIZ/ ALREADY EXISTS, WILL SKIP IT!
/]
PUSHJ P,RELH2 ;RELEASE DEFINITION
JRST GTPINN ;AND LOOP BACK
ISNEWD: STORE(H,F,NXTD)
STORE(G,H,NXTD)
AOS FACTR1 ;COUNT A DIP READ
JRST GTPINN
;DIPER - Error reading DIP, release storage and ignore
DIPER2: PUSHJ P,RELH2
DIPER1: OUTSTR[ASCIZ/UNEXPECTED EOF ON DIP FILE!
/]
DIPER0: RELEASE DAT,
POPJ P,
RELH2: FETCH(B,H,DNAM)
SKIPE B
PUSHJ P,PUTFS
FETCH(G,H,DPIN)
JUMPE G,RELH22
RELH21: MOVE B,G
FETCH(G,G,DPNXT)
FSTRET(B,DPHEAD)
JUMPN G,RELH21
RELH22: FETCH(A,H,PRPN)
JUMPE A,RELH24
RELH23: FETCH(B,A,PRNS)
SKIPE B
PUSHJ P,PUTFS
MOVE B,A
FETCH(A,A,PRNN)
FSTRET(B,PNBK)
JUMPN A,RELH23
RELH24: FETCH(A,H,PRPV)
SKIPE A
PUSHJ P,RELPRP
FSTRET(H,DHEAD)
POPJ P,
RELPRP: MOVE B,A
FETCH(A,A,PRNP)
JUMPN A,RELPRP ;GET TO BOTTOM
FETCH(A,B,PRNV) ;FOLLOW THIS LEVEL
SKIPN A
JRST [ FETCH(A,B,PRPP) ;END THIS LEVEL, GO UP 1 LEVEL
JUMPE A,.+1
CLEAR(A,PRNP)
JRST .+1]
MOVE T,B
PUSHJ P,UNTHRD
FSTRET(B,PVBK)
JUMPN A,RELPRP
POPJ P,
; WRITE DIP FILE
DIPWRT: PUSHJ P,CNAME ;CHECK FOR NAME CHANGE
JFCL
SKIPN DIPLST
JRST [ OUTSTR[ASCIZ/NO DIPS IN DIPLST!
/]
POPJ P,]
INIT LST,10
'DSK ' ;ALWAYS USE DISK!
XWD LSTHD,0
JRST [ OUTSTR[ASCIZ/INIT FAILED ON DISK!
/]
JRST ERRET]
MOVEI T,LSTBUF
EXCH T,.JBFF
OUTBUF LST,2
MOVEM T,.JBFF
MOVE T,DIPPPN
MOVEM T,DIPNAM+3
SETZM DIPNAM+2
HLLZS DIPNAM+1
PUSHJ P,DNPNT
ENTER LST,DIPNAM ;FIND FILE!
JRST [ OUTSTR[ASCIZ/ENTER FAILED CODE = /]
HRRZ T,DIPNAM+1
PUSHJ P,DECOUT
OUTSTR[ASCIZ/
/]
RELEASE LST,
POPJ P,]
MOVNI TTT,DIPVER
PUSHJ P,WORDOUT ;WRITE VERSION #
MOVE H,DIPLST
DIPCHECK
SETZM FACTR1
DIPWR1: AOS FACTR1
FETCH(G,H,DPNN) ;# OF PINS
MOVE TTT,G
PUSHJ P,WORDOUT
FETCH(T,H,DNAM)
PUSHJ P,WSTR ;WRITE DIP NAME
FETCH(T,H,DPAK)
JUMPE T,[PUSHJ P,WRTZERO
JRST DIPWR4]
HRRZ T,PACKNM(T)
PUSHJ P,WASCIZ ;WRITE PACKAGE NAME
DIPWR4: FETCH(F,H,PRPN)
JUMPE F,DPWPN1
DIPWPN: FETCH(T,F,PRNS)
PUSHJ P,WSTR
FETCH(F,F,PRNN)
JUMPN F,DIPWPN
DPWPN1: PUSHJ P,WRTZERO
FETCH(F,H,PRPV)
JUMPE F,[PUSHJ P,WRTZERO
JRST DPWPV1]
DIPWPV: FETCH(T,F,PRVS)
PUSHJ P,WSTR ;PROPERTY VALUE
FETCH(TTT,F,PRBT)
TRZ TTT,PNUSED!PRTMP1 ;CLEAR MARK BITS
PUSHJ P,WORDOUT ;PROPERTY VALUE BITS
FETCH(T,F,PRNP)
JUMPN T,DPWPV2
PUSHJ P,WRTZERO
DPWPV3: FETCH(T,F,PRNV)
JUMPN T,DPWPV2
PUSHJ P,WRTZERO
FETCH(F,F,PRPP)
JUMPN F,DPWPV3
JRST DPWPV1
DPWPV2: MOVE F,T
JUMPN F,DIPWPV
DPWPV1: MOVEI F,RADDR(H,DPIN,DPNXT)
JUMPE G,DIPWR3 ;JUMP IF NO PINS
DIPWR2: FETCH(F,F,DPNXT)
FETCH(TTT,F,DPNM) ;PIN NAME
PUSHJ P,WORDOUT ;WRITE 0,,PIN NAME
FETCH(TTT,F,PSWP)
FETCH(TT,F,DPBIT)
HRL TTT,TT
PUSHJ P,WORDOUT ;BITS,,PS #
FETCH(TTT,F,LLOW)
FETCH(TT,F,LHI)
HRL TTT,TT
PUSHJ P,WORDOUT ;LOADING
FETCH(TTT,F,DUSE)
PUSHJ P,WORDOUT ;USE
FETCH(TTT,F,SCTP)
FETCH(TT,F,SCTB)
HRL TTT,TT
PUSHJ P,WORDOUT ;SECT BITS,,SECT PIN #
SOJG G,DIPWR2
DIPWR3: FETCH(H,H,NXTD)
JUMPN H,DIPWR1
PUSHJ P,WRTZERO
RELEASE LST,
PUTBYT " "
MOVE T,FACTR1
PUSHJ P,DECOUT
OUTSTR[ASCIZ/ DIPS WRITTEN.
/]
POPJ P,
; SORT DIP NAMES
DIPCHECK
;Sort the dip name in DSTRNG into DIPLST
;returns:
;+1 new name (insert after F)
;+2 found
DALPHA: MOVEI G,DIPLST-ADDR(0,NXTD)
;loop scans by 10.
DALPH2: MOVE F,G
DALPH4: FETCH(G,G,NXTD)
JUMPE G,DALPH5 ;MIGHT HAVE GONE BY, RECHECK LAST SEGMENT
FETCH(TT,G,DNAM)
MOVE T,DSTRNG
PUSHJ P,DSORT
JRST DALPH5 ;.LT. CURRENT, GO OVER LAST SEGMENT
CAIA ;.GT. CURRENT, SKIP 10
JRST CPOPJ1 ;.EQ. CURRENT, WIN
MOVE F,G
MOVEI T,=10 ;SKIP PAST 10 ENTRIES
DALPH1: FETCH(G,G,NXTD)
JUMPE G,DALPH5
SOJG T,DALPH1
JRST DALPH4
;loop scans by 1
DALPH5: SKIPA G,F ;BACK TO LAST SEGMENT
DALPH3: MOVE F,G
FETCH(G,G,NXTD)
JUMPE G,CPOPJ ;NEW, BELONGS AT END OF LIST
FETCH(TT,G,DNAM)
MOVE T,DSTRNG
PUSHJ P,DSORT
POPJ P, ;LESS THAN CURRENT, IS NEW
JRST DALPH3
JRST CPOPJ1
;SPECIAL SORT ROUTINE FOR DIPNAMES
; COMPARE STRING IN T VS. TT
; PUSHJ P,DSORT
; T is alpha less than TT
; T is alpha greater than TT
; T is alpha equal to TT
^DSORT: PUSH P,A
PUSH P,B
PUSH P,C
ADD T,[POINT 7,1]
ADD TT,[POINT 7,1]
CAIA
DSORT1: JUMPE TTT,DSRTD2 ;EQUAL IF END OF STRING
PUSHJ P,GET ;GET CHAR IN TTT FROM T
PUSHJ P,GETT ;GET CHAR IN A FROM TT
CAIL TTT,"0"
CAILE TTT,"9"
JRST DSORT2 ;NON DIGIT, COMPARE
CAIL A,"0"
CAILE A,"9"
JRST DSORT2 ;NON DIGIT, COMPARE
SETZB B,C ;BOTH DIGITS, INIT NUMBERS
DSORT3: IMULI B,=10
ADDI B,-60(TTT)
PUSHJ P,GET
CAIL TTT,"0"
CAILE TTT,"9"
JRST DSORT4
JRST DSORT3
DSORT4: IMULI C,=10
ADDI C,-60(A)
PUSHJ P,GETT
CAIL A,"0"
CAILE A,"9"
JRST DSORT5
JRST DSORT4
DSORT5: CAMN B,C ;SAME NUMBERS?
JRST DSORT2 ;YES, CHECK LETTERS
CAMLE B,C
JRST DSRTD1
JRST DSRTD0
DSRTD2: AOS -3(P)
JRST DSRTD1
DSORT2: CAMN TTT,A
JRST DSORT1 ;STILL EQUAL
CAML TTT,A
DSRTD1: AOS -3(P) ;TT LESS THAN T SKIP
DSRTD0: POP P,C ;T LESS THAN TT DIRECT
POP P,B
POP P,A
POPJ P,
; GET, GETT
GET: TLNN T,760000
JRST [ HRR T,-1(T)
TRNE T,-1
JRST .+1
SETZ TTT,
POPJ P,]
ILDB TTT,T
POPJ P,
GETT: TLNN TT,760000
JRST [ HRR TT,-1(TT)
TRNE TT,-1
JRST .+1
SETZ A,
POPJ P,]
ILDB A,TT
POPJ P,
; RENAME, PRINT, MODIFY
;MODIFY A DIP DEFINITION
;CHECK FOR RIDICULOUSLY LONG DIP NAMES
TEST7: HRRZ T,(B)
JUMPE T,CPOPJ1
MOVE T,1(T)
TDNN T,[BYTE(7)0,0,177]
JRST CPOPJ1
PUSHJ P,IERR
ASK[ASCIZ/MORE THAN 7 CHARS IN DIPNAME, ARE YOU SURE?/]
POPJ P,
POPJ P,
JRST CPOPJ1
DIPSET: MOVE B,[PUSHJ P,TTYIN]
MOVEM B,GETCHR
PUSHJ P,TREADU
POPJ P,
JRST [NONULL:OUTSTR[ASCIZ/SORRY - YOU MUST TYPE A DIP NAME.
/]
POPJ P,]
MOVEM B,DSTRNG
DIPCHECK
PUSHJ P,DALPHA
JRST [
NODIPY: MOVE B,DSTRNG
OUTSTR[ASCIZ/NO SUCH DIP!
/]
JRST PUTFS]
MOVE H,G
MOVE B,DSTRNG
AOS (P)
JRST PUTFS
; DIPREN - Dip rename
DIPREN: SKIPE RESIDENT
JRST NOMODR
PUSHJ P,DIPSET ;FIND THE DIP
POPJ P,
OUTSTR[ASCIZ/NEW NAME?/]
HRLM F,(P) ;SAVE PREVIOUS POINTER
PUSHJ P,TREADU
POPJ P,
POPJ P,
PUSHJ P,TEST7
JRST PUTFS
MOVEM B,DSTRNG
DIPCHECK
PUSHJ P,DALPHA
JRST RENOK
OUTSTR[ASCIZ/SORRY, NAME ALREADY IN USE!
/]
MOVE B,DSTRNG
JRST PUTFS
RENOK: HLRZ G,(P) ;GET POINTER TO OLD PREVIOUS
FETCH(H,G,NXTD) ;POINTER TO CURRETN DIP DEF
FETCH(TT,F,NXTD) ;GET NEW NEXT FROM NEW PREVIOUS
CAIE TT,(H) ;ARE WE ALREADY IN RIGHT PLACE?
CAIN F,(H) ;CHECK BOTH
JRST RENSAM ;YES
FETCH(T,H,NXTD) ;OLD NEXT
STORE(T,G,NXTD) ;LINK US OUT
STORE(TT,H,NXTD) ;STORE NEXT
STORE(H,F,NXTD) ;STORE US
RENSAM: FETCH(B,H,DNAM) ;OLD NAME
MOVE T,DSTRNG
STORE(T,H,DNAM) ;NEW NAME
JRST PUTFS
DIPPRN: PUSHJ P,DIPSET
POPJ P,
MOVE T,[OUTCHR TTT]
MOVEM T,PUTCHR
JRST ONEDIP
; MODIFY - Modify DIP definition
MODIFY: SKIPE RESIDENT
JRST NOMODR
SETZ W, ;ASSUME MODIFY ALL
SETZM PININC ;NO AUTO INC TO START WITH
PUSHJ P,TREADU ;READ STRING
POPJ P,
JRST NONULL
MOVEM B,DSTRNG ;SAVE HERE
MOVE T,[PUSHJ P,TTYIN]
MOVEM T,GETCHR
MOVE T,[OUTCHR TTT]
MOVEM T,PUTCHR
DIPCHECK
PUSHJ P,DALPHA
JRST MAKDIP
MOVE B,DSTRNG
PUSHJ P,PUTFS ;GIVE BACK STRING
MOVE H,G ;PUT POINTER TO DIP INTO H
GOTDIP:
TTYBT,< SETO T,
GETLIN T
TLO T,100
SETLIN T
MOVEI T,[000620,,ITS,<40>0 ;TAB,CR,LF,ALTMODE FOR ITS
0
0
NOITS,<1>,,0 ];ALTMODE FOR STANFORD
SETACT T ;SET AS SPECIAL ACTIVATION TABLE
PTJOBX [03] ;ECHOING OFF
>;TTYBT
NOTTYBT,<
INIT TTYCHN,700
'TTY '
0
JRST [ OUTSTR[ASCIZ/INIT FAILED ON TTY.
/]
EXIT 1,
JRST .-3]
SETOM SAVLIN
PUSHJ P,LINCLR
>;NOTTYBT
PUSHJ P,FSTLIN
MOVEI F,1 ;SET F TO 1 FOR TYPE 0
FETCH(G,H,DPIN) ;GET POINTER TO FIRST PIN
MODLOP: OUTCHR [11] ;INDENT
HLR W,W ;RESET MODE
XCT TAB1(W)
CAIA
JRST MODEND ;SKIPS IF DONE
OUTCHR [11]
XCT TAB2(W)
FETCH(T,G,DPBIT)
TRNE T,NULLD!GND
JRST MDCRLF
OUTCHR [11]
XCT TAB3(W)
OUTCHR [11]
XCT TAB4(W)
FETCH(T,G,DPBIT)
TRNE T,PWR
JRST MDCRLF
OUTCHR [11]
XCT TAB5(W)
OUTCHR [11]
XCT TAB6(W)
MDCRLF: OUTSTR[ASCIZ/
/]
JRST MODLOP
MODEND: OUTSTR [ASCIZ /
/]
PUSHJ P,DUPCHK ;CHECK FOR SECTION PIN DUPLICATION
JRST [ OUTSTR[ASCIZ/SECTION PIN # USED MORE THAN ONCE.
YOU MUST FIX IT BEFORE YOU CAN EXIT.
/]
JRST MODLOP]
TTYBT,< SETO T,
GETLIN T
TLZ T,100
SETLIN T
PTJOBX [04] ;ECHOING ON
>;TTYBT
NOTTYBT,<
SETSTS TTYCHN,0
RELEASE TTYCHN,
SETZM SAVLIN
>;NOTTYBT
PUSHJ P,SECCHK ;SECTIONS ALLOCATED SEQUENTIALLY?
PUSHJ P,SECFIX ;NO, MAYBE FIX
PUSHJ P,SCPCHK ;SECTION PIN #'S ALLOCATED SEQUENTIALLY?
PUSHJ P,SCPFIX ;NO, RE-ALLOCATE MAYBE
PUSHJ P,ANYSEC ;ANY SECTIONS ASSIGNED?
PUSHJ P,SECONE ;NO, ASSIGN ONE MAYBE
POPJ P,
NODPIN: OUTSTR [ASCIZ /NO SUCH PIN!
/]
MODERN: POP P,(P)
JRST MODER1
MODERP: POP P,(P)
MODERR: OUTSTR[ASCIZ/INPUT ERROR!
/]
MODER1: CLRBFI ;AVOID ANY EMBARASSMENT
NOTTYBT,< PUSHJ P,LINCLR >
SETZM PININC ;FLUSH AUTO-INC
JRST MODLOP
PUSHJ P,GETPIN
TAB1:
REPEAT 5,<PUSHJ P,GETPIN>
PUSHJ P,PNTTYP
TAB2:
PUSHJ P,GETTYP
REPEAT 4,<PUSHJ P,PNTTYP>
PUSHJ P,PNTLOD
TAB3:
REPEAT 2,<PUSHJ P,GETLOD>
REPEAT 3,<PUSHJ P,PNTLOD>
PUSHJ P,PNTUSE
TAB4:
REPEAT 3,<PUSHJ P,GETUSE>
REPEAT 2,<PUSHJ P,PNTUSE>
PUSHJ P,PNTPS
TAB5:
REPEAT 4,<PUSHJ P,GETPS>
PUSHJ P,PNTPS
PUSHJ P,PNTSCT
TAB6:
REPEAT 5,<PUSHJ P,GETSCT>
; MODIFY AND DIPIN CHECK ROUTINES
DUPCHK: FETCH(G,H,DPIN)
JUMPE G,CPOPJ1
DUPCK1: FETCH(F,G,DPNXT)
JUMPE F,CPOPJ1 ;ALL DONE?
FETCH(T,G,SCTP)
FETCH(TT,G,SCTB)
DUPCK2: FETCH(TTT,F,SCTP)
CAME TTT,T ;SAME SECTION PIN #?
JRST DUPCK3 ;NO
FETCH(TTT,F,SCTB) ;YES, GET SECTION BITS
TRNE TTT,(TT) ;ANY COMMON SECTIONS?
POPJ P, ;YES, DUPLICATE SECTION PIN.
DUPCK3: FETCH(F,F,DPNXT)
JUMPN F,DUPCK2
FETCH(G,G,DPNXT)
JRST DUPCK1
ANYSEC: TRZ FLAG ;NO IN OR OUT SEEN YET
MOVEI G,RADDR(H,DPIN,DPNXT)
JRST ANYSC2
ANYSC1: FETCH(T,G,DPBIT)
TRNN T,INLD!OUTLD!TERM
JRST ANYSC2
TRO FLAG
FETCH(TT,G,SCTB)
JUMPN TT,CPOPJ1 ;HAS SOME SECTION BITS
ANYSC2: FETCH(G,G,DPNXT)
JUMPN G,ANYSC1
TRNN FLAG
AOS (P)
POPJ P,
SECONE: ASK[ASCIZ/NO SECTIONS ASSIGNED, SHALL I ASSIGN SECTION 0?/]
POPJ P,
POPJ P,
MOVEI T,1
MOVEI TT,400000 ;SECTION 0
MOVEI G,RADDR(H,DPIN,DPNXT)
JRST SECON2
SECON1: FETCH(TTT,G,DPBIT)
TRNN TTT,INLD!OUTLD!TERM
JRST SECON2
STORE(T,G,SCTP)
STORE(TT,G,SCTB)
ADDI T,1 ;INCREMENT ONLY WHEN USED
SECON2: FETCH(G,G,DPNXT)
JUMPN G,SECON1
POPJ P,
SECCHK: MOVSI A,-1
MOVEI G,RADDR(H,DPIN,DPNXT)
JRST SECCK2
SECCK1: FETCH(T,G,SCTB)
JUMPE T,SECCK2
TRO A,(T)
SECCK2: FETCH(G,G,DPNXT)
JUMPN G,SECCK1
IORI A,-1(A)
AOJE A,CPOPJ1
POPJ P,
;CALL AFTER SECCHK (LEAVES BITS IN A)
SECFIX:ASK[ASCIZ/SECTION NUMBERS NOT ALLOCATED SEQUENTIALLY FROM 0,
SHALL I RE-ALLOCATE THEM FOR YOU?/]
POPJ P,
POPJ P,
HRLOI A,-1(A)
SETCA A, ;MAKE WORD OF HOLES
SECFX1: JFFO A,.+1
TDZ A,SCTTAB(B) ;CLEAR A HOLE
LSH A,1 ;ACCOUNT FOR SHIFT WE ARE DOING
MOVE B,SCTTAB(B)
SUBI B,1 ;MAKE A MASK
HLRZ B,B
MOVEI G,RADDR(H,DPIN,DPNXT)
JRST SECFX3
SECFX2: FETCH(TT,G,SCTB)
MOVE TTT,TT
ANDCM TT,B
AND TTT,B
LSH TTT,1
IOR TT,TTT
STORE(TT,G,SCTB)
SECFX3: FETCH(G,G,DPNXT)
JUMPN G,SECFX2
JUMPN A,SECFX1
POPJ P,
;CHECK THAT SECTION PIN #'S ARE ALLOCATED SEQUENTIALLY
SCPCHK: PUSHJ P,SCBGET ;GET MAX SECTION #
JUMPL A,CPOPJ1
SCPCK0: PUSHJ P,SCPGET ;GET MAX SCTP
SCPCK1: PUSHJ P,SCPCKF ;FIND THIS ONE
POPJ P, ;NONE, RETURN
SOJG T,SCPCK1 ;CHECK THEM ALL
SOJGE A,SCPCK0 ;AND ALL SECTIONS
JRST CPOPJ1
;HERE TO RE-ALLOCATE SECTION PIN #'S
SCPFIX: ASK[ASCIZ/SECTION PIN #'S NOT ASSIGNED SEQUENTIALLY FROM 1
SHALL I RE-ALLOCATE THEM FOR YOU?/]
POPJ P,
POPJ P,
PUSHJ P,SCBGET
SCPFX0: PUSHJ P,SCPGET ;GET MAX
SCPFX1: PUSHJ P,SCPCKF ;FIND THIS VALUE
PUSHJ P,SCPALC ;RE-ALLOCATE IF HOLE HERE!
SOJG T,SCPFX1
SOJGE A,SCPFX0
POPJ P,
SCPCKF: movn tt,a
movei ttt,400000
lsh ttt,(tt) ;make bit for section we are checking
MOVEI G,RADDR(H,DPIN,DPNXT)
JRST SCPF2
SCPF1: fetch(tt,g,sctb) ;get this pins section bits
trnn ttt,(tt)
JRST SCPF2
FETCH(TT,G,SCTP)
CAMN TT,T ;FOUND ONE?
JRST CPOPJ1 ;YES, ONE SKIP
SCPF2: FETCH(G,G,DPNXT)
JUMPN G,SCPF1
POPJ P,
SCPALC: MOVEI G,RADDR(H,DPIN,DPNXT)
JRST SCPA2
SCPA1: FETCH(TT,G,SCTB)
JFFO TT,.+1
CAIE TTT,=18(A)
JRST SCPA2
FETCH(TT,G,SCTP)
CAML TT,T ;NEED RE-ALLOCATING?
SUBI TT,1 ;YES, REDUCE IT
STORE(TT,G,SCTP)
SCPA2: FETCH(G,G,DPNXT)
JUMPN G,SCPA1
POPJ P,
SCBGET: SETO A, ;INIT TO -1
MOVEI G,RADDR(H,DPIN,DPNXT)
JRST SCBG2
SCBG1: FETCH(TT,G,SCTB)
HRLZ TT,TT
JFFO TT,.+2
JRST SCBG2
CAMLE TTT,A
MOVE A,TTT
SCBG2: FETCH(G,G,DPNXT)
JUMPN G,SCBG1
POPJ P,
SCPGET: SETZ T, ;COLLECT MAX SECTION PIN # HERE
MOVEI G,RADDR(H,DPIN,DPNXT)
JRST SCPG2
SCPG1: FETCH(TT,G,SCTB)
JFFO TT,.+1
CAIE TTT,=18(A)
JRST SCPG2
FETCH(TT,G,SCTP) ;GET SECTION PIN #
CAMLE TT,T
MOVE T,TT
SCPG2: FETCH(G,G,DPNXT)
JUMPN G,SCPG1
POPJ P,
; MODIFY SUBRS
MODTAB: "T" ;START WITH TYPE
"L" ;START WITH LOADING
"U" ;START WITH USE
"P" ;START WITH INPUT SHARING
"S" ;START WITH SECTION SCHTICK
MODLEN__.-MODTAB
TTTICK: XCT GETCHR
JFCL
TTTCHK: CAIN TTT,11
JRST CPOPJ1
CAIN TTT,ALTMOD
JRST [ SETZM PININC
JRST .+2] ;SAME AS CR, EXCEPT FLUSHES PININC
CAIN TTT,12
TROA W,-1 ;INDICATE PRINT ONLY
POPJ P,
JRST CPOPJ1
GETPIN: SKIPN G,PININC
JRST GETPN1
MOVEI TTT,11 ;IF STILL INCREMENTING, MAKE IT LOOK LIKE <N><TAB>
MOVE G,PININC ;GET LAST PIN
FETCH(G,G,DPNXT) ;GET NEXT
MOVEM G,PININC ;MAKE IT LAST
JUMPN G,GOTPNM ;GO PROCESS UNLESS END
GETPN1: XCT GETCHR
JFCL
CAIL TTT,"A"+40
CAILE TTT,"Z"+40
CAIA
SUBI TTT,40 ;ACCEPT LOWER CASE
CAIN TTT,12
JRST CPOPJ1 ;SKIP TO INDICATE DONE
CAIN TTT,"D"
JRST DELPIN
CAIE TTT,"H"
CAIN TTT,"?"
JRST MODHLP
CAIE TTT,"A"
JRST GETPN2
PUSHJ P,RPNAMA
JRST MODERP
CAIE TTT,12
JRST MODERP
MOVEI TTT,11
JUMPN A,GETPN3
FETCH(G,H,DPIN) ;BLANK, START WITH FIRST
JUMPE G,[OUTSTR [ASCIZ /NO PINS!
/]
JRST MODERN]
JRST GETPN4
GETPN3: PUSHJ P,FNPNAM ;FIND PIN
JRST NODPIN
GETPN4: MOVEM G,PININC
JRST GOTPNM
GETPN2: MOVSI T,-MODLEN
GETPNM: CAME TTT,MODTAB(T)
AOBJN T,GETPNM
JUMPGE T,GETPN5
PUTBYT @TTT
XCT GETCHR
JFCL
CAIE TTT,12
JRST MODERP
HRR W,T
HRL W,T
OUTSTR[ASCIZ/
/]
JRST GETPIN
GETPN5: PUSHJ P,TRPNAM ;READ PIN NAME
JRST MODERP
PUSHJ P,TTTCHK
JRST MODERP
PUSHJ P,FNPNAM ;FIND PIN
JRST MAKPIN ;NOT FOUND, MAKE IT
GOTPNM: FETCH(F,G,DPNM) ;GET PIN NAME IN F
CAIN TTT,12 ;PRINTING LINE ONLY?
JRST PNTPIN ;JUST ECHO PIN#
PUSHJ P,ONELN
OUTCHR [11]
JRST PNTPIN ;NOW ECHO PIN#
;DELETE PIN
DELPIN: PUSHJ P,RPNAM ;READ NAME OF PIN TO DELETE
JRST MODERP
CAIE TTT,12
JRST MODERP
PUSHJ P,FNPNAM ;FIND PIN
JRST NODPIN ;ERROR IF NONE
PUTBYT "D" ;NOW ECHO COMMAND
PUSHJ P,PNTPIN
OUTSTR [ASCIZ /
/]
FETCH(T,G,DPNXT) ;GET HIS NEXT POINTER
STORE(T,F,DPNXT) ;LINK HIM OUT
FSTRET(G,DPHEAD)
FETCH(T,H,DPNN)
SUBI T,1 ;DECREASE PIN IN DIP
STORE(T,H,DPNN)
JRST GETPIN ;AND GET PIN AGAIN
MAKPIN: CAIE TTT,11 ;ONLY TAB CAN CREATE PIN
JRST MODERP
GETFS(T,DPHEAD) ;GET BLOCK FOR NEW PIN
BCLEAR(TT,T,DPHEAD)
STORE(G,T,DPNXT) ;LINK INTO PIN LIST
STORE(T,F,DPNXT)
MOVE G,T
MOVEI TTT,NULLD ;INITIALIZE TO NULL PIN
STORE(TTT,G,DPBIT)
STORE(A,G,DPNM)
FETCH(T,H,DPNN)
ADDI T,1
STORE(T,H,DPNN) ;UPDATE NUMBER OF PINS
JRST GOTPNM
FNPNAM: MOVEI G,RADDR(H,DPIN,DPNXT)
JRST FNPNM2
FNPNM1: FETCH(T,G,DPNM)
CAMN T,A
JRST CPOPJ1
CAML T,A
POPJ P,
FNPNM2: MOVE F,G
FETCH(G,G,DPNXT)
JUMPN G,FNPNM1
POPJ P,
GETTYP: PUSHJ P,TTTICK
CAIA
JRST PNTTYP
MOVE T,DEFECL ;ASSUME DEFAULT
CAIN TTT,"E" ;ECL?
JRST [ MOVEI T,ECL
JRST ISECL]
CAIE TTT,"T"
JRST ISNTET
MOVEI T,TTL
ISECL: XCT GETCHR ;GET NEXT CHAR
JFCL
ISNTET: MOVEM T,ECLBIT ;SAVE HERE FOR ORING
PUSHJ P,GETWRT
JFCL
PUSHJ P,TTTCHK
JRST MODERP
JUMPE A,PNTTYP
MOVSI T,-TYPLEN
CAMN A,TYPTAB(T)
JRST GETTY1
AOBJN T,.-2
JRST MODERP
GETTY1: MOVE T,TYPBIT(T)
TRNN T,GND!NULLD
IOR T,ECLBIT ;TURN ON ECL OR TTL OR NOTHING
STORE(T,G,DPBIT)
TRNE T,GND!NULLD
CLEAR(G,DUSE)
TRNE T,OPENC!GND!NULLD
CLEAR(G,LHI) ;CLEAR HI LOADING
TRNE T,PULL!GND!NULLD
CLEAR(G,LLOW)
TRNN T,INLD!OUTLD!TERM ;ONLY THESE SHOULD HAVE SECTION STUFF
CLEAR(G,SCTB)
TRNN T,INLD!OUTLD!TERM
CLEAR(G,SCTP)
TRNN T,INLD!OUTLD!TERM
CLEAR(G,PSWP)
FETCH(TT,G,DUSE)
TLC TT,'CLK'
TLNE TT,-1
JRST PNTTYP
TRO T,CLK
STORE(T,G,DPBIT)
JRST PNTTYP
TYPTAB: 'I '
'IS '
'IP '
'ISP '
'IF '
'IFS '
'IFP '
'IFSP '
'O '
'OT '
'OC '
'OP '
'OF '
'OTF '
'OCF '
'OPF '
'PWR '
'P '
'V '
'GND '
'G '
'Z '
'N '
'NC '
TYPLEN__.-TYPTAB
TYPBIT: INLD!DRVREQ
INLD!SHARE!DRVREQ
INLD
INLD!SHARE
INLD!FFIN!DRVREQ
INLD!FFIN!SHARE!DRVREQ
INLD!FFIN
INLD!FFIN!SHARE
OUTLD
OUTLD!TRI
OUTLD!OPENC
OUTLD!PULL
OUTLD!FFOUT
OUTLD!FFOUT!TRI
OUTLD!FFOUT!OPENC
OUTLD!FFOUT!PULL
PWR
PWR
PWR
GND
GND
TERM
NULLD
NULLD
GETLOD: FETCH(T,G,DPBIT)
TRNE T,PULL ;PULLUPS HAVE NO LOW LOAD
JRST [ PUTBYT 11
JRST GETLD3]
PUSHJ P,TTTICK
CAIA
JRST GETLD1
PUSHJ P,SLDECIN
JFCL
MOVM T,A
CAIG T,377777
PUSHJ P,TTTCHK
JRST MODERP
STORE(A,G,LLOW)
GETLD1: FETCH(T,G,LLOW)
PUSH P,TTT
PUSHJ P,LDOUT
FETCH(T,G,DPBIT)
TRNE T,PWR
PUTBYT "V"
PUTBYT 11
POP P,TTT
CAIE TTT,11
JRST GETLD2
TRNE T,OPENC ;OPEN COLLECTOR?
POPJ P,
GETLD3: PUSHJ P,TTTICK
CAIA
JRST GETLD2
PUSHJ P,SLDECIN
JFCL
MOVM T,A
CAIG T,377777
PUSHJ P,TTTCHK
JRST MODERP
STORE(A,G,LHI)
GETLD2: FETCH(T,G,DPBIT)
TRNE T,OPENC
POPJ P,
FETCH(T,G,LHI)
PUSHJ P,LDOUT
FETCH(T,G,DPBIT)
TRNE T,PWR
PUTSTR[ASCIZ/MA/]
POPJ P,
GETUSE: PUSHJ P,TTTICK
CAIA
JRST PNTUSE
PUSHJ P,GETWRT
JFCL
PUSHJ P,TTTCHK
JRST MODERP
STORE(A,G,DUSE)
FETCH(T,G,DPBIT)
TLC A,'CLK'
TLNE A,-1
TRZA T,CLK ;CANt BE CLK
TRO T,CLK ;IS CLK
STORE(T,G,DPBIT)
JRST PNTUSE
GETPS: PUSHJ P,TTTICK
CAIA
JRST PNTPS
PUSHJ P,TDECIN
JFCL
PUSHJ P,TTTCHK
JRST MODERP
STORE(A,G,PSWP)
JRST PNTPS
GETSCT: PUSHJ P,TTTICK
CAIA
JRST PNTSCT
PUSHJ P,TDECIN
JFCL
CAIE TTT,"/" ;THIS MUST BE SECT PIN #
JRST GETSC2
JUMPE A,MODERP
CAILE A,777777 ;THIS IS A REASONABLE UPPER BOUND
JRST MODERP
HRRZM A,SECTMP ;TMP CELL FOR SECT STUFF
GETSC1: PUSHJ P,DECIN
JFCL
CAILE A,=17 ;MAX # ALLOWED
JRST MODERP
MOVN A,A
MOVSI T,400000
LSH T,(A)
TDNE T,SECTMP ;ALREADY USED?
JRST MODERP
IORM T,SECTMP
CAIN TTT,","
JRST GETSC1
GETSC3: PUSHJ P,TTTCHK
JRST MODERP
MOVE T,SECTMP
STORE(T,G,SCTP)
HLRZ T,SECTMP
STORE(T,G,SCTB)
JRST PNTSCT
GETSC2: JUMPN A,MODERP
SETZM SECTMP
JRST GETSC3
MODHLP: XCT GETCHR
JFCL
CAIE TTT,12
JRST MODERP
OUTSTR [ASCIZ \HELP:
? TYPE THIS LIST
H TYPE THIS LIST
A<N> AUTO INCREMENT THROUGH PINS STARTING WITH <N>.
IF <N> IS LEFT OUT, STARTS AT FIRST PIN.
TYPE <ALT> TO EXIT AUTO INCREMENTING.
D<N> DELETE PIN <N>.
<N><CR> PRINT LINE FOR PIN <N>.
<N><TAB> PRINT LINE FOR PIN <N>, THEN START ACCEPTING NEW INFO
FOR THIS PIN STARTING AS CURRENTLY SELECTED COLUMN.
T START AT TYPE COLUMN
L START AT LOADING COLUMN
U START AT USE COLUMN
P START AT INPUT/OUTPUT SHARE NUMBER COLUMN
S START AT SECTION COLUMN
<CRLF> EXIT MODIFY MODE
\]
JRST GETPIN
; PRINT SUBRS
FSTLIN: FETCH(A,H,DNAM)
PUSHJ P,STROUT
PUTBYT 11
FETCH(T,H,DPNN)
PUSHJ P,DECOUT
PUTSTR[ASCIZ/ PINS DEFINED, /]
FETCH(T,H,DPAK)
PUTSTR @PACKNM(T)
PUTSTR [ASCIZ / Package
PIN # TYPE LOW HI USE PS SECTION(S)
/]
POPJ P,
PNTPIN: FETCH(T,G,DPNM)
JRST PUTDEC
PNTTYP: FETCH(A,G,DPBIT)
PNTYPE: TRNE A,ECL
PUTBYT "E"
TRNE A,TTL
PUTBYT "T"
TRNE A,OUTLD
PUTBYT "O"
TRNE A,FFOUT
PUTBYT "F"
TRNE A,TRI
PUTBYT "T"
TRNE A,OPENC
PUTBYT "C"
TRNE A,PULL
PUTBYT "P"
TRNE A,INLD
PUTBYT "I"
TRNE A,FFIN
PUTBYT "F"
TRNE A,SHARE
PUTBYT "S"
TRNN A,DRVREQ
TRNN A,INLD
CAIA
PUTBYT "P"
TRNE A,TERM
PUTBYT "Z"
TRNE A,GND
PUTBYT GNDCHR
TRNE A,PWR
PUTBYT PWRCHR
TRNE A,NULLD
PUTBYT "N"
POPJ P,
PNTLOD: FETCH(T,G,LLOW)
FETCH(TT,G,DPBIT)
TRNN TT,PULL
PUSHJ P,LDOUT
FETCH(T,G,DPBIT)
TRNE T,PWR
PUTBYT "V"
PUTBYT 11
TRNE T,OPENC
POPJ P,
FETCH(T,G,LHI)
PUSHJ P,LDOUT
FETCH(T,G,DPBIT)
TRNE T,PWR
PUTSTR[ASCIZ/MA/]
POPJ P,
PNTUSE: FETCH(A,G,DUSE)
PUTSIX A
POPJ P,
PNTPS: FETCH(T,G,PSWP)
JUMPN T,DECOUT
POPJ P,
PNTSCT: FETCH(T,G,SCTB)
JUMPE T,CPOPJ ;ANY SECTION STUFF AT ALL?
FETCH(T,G,SCTP)
PUSHJ P,DECOUT
PUTBYT "/"
FETCH(A,G,SCTB)
MOVS A,A
CAIA
PNTSC1: PUTBYT ","
MOVE T,A
JFFO T,.+1
TDZ A,SCTTAB(TT) ;CLEAR BIT
MOVE T,TT
PUSHJ P,DECOUT ;PRINT #
JUMPN A,PNTSC1
POPJ P,
ONELIN: PUTBYT 11
ONELN: PUSHJ P,PNTPIN
PUTBYT 11
PUSHJ P,PNTTYP
FETCH(T,G,DPBIT)
TRNE T,GND!NULLD
JRST ONELN1
PUTBYT 11
PUSHJ P,PNTLOD
PUTBYT 11
PUSHJ P,PNTUSE
FETCH(T,G,DPBIT)
TRNE T,PWR
JRST ONELN1
PUTBYT 11
PUSHJ P,PNTPS
PUTBYT 11
PUSHJ P,PNTSCT
ONELN1: PUTSTR[ASCIZ/
/]
POPJ P,
ONEDIP: PUSHJ P,FSTLIN
MOVEI G,RADDR(H,DPIN,DPNXT)
JRST ONEDP2
ONEDP1: PUSHJ P,ONELIN
ONEDP2: FETCH(G,G,DPNXT)
JUMPN G,ONEDP1
CRLF
POPJ P,
SCTTAB:
FOR I_0,=17
< <400000,,0>-I
>
; COPY DIP DEF
;MAKE NEW DIP FROM OLD
DIPCOP: SKIPE RESIDENT
JRST NOMODR
PUSHJ P,DIPSET
POPJ P,
MOVE W,H
OUTSTR[ASCIZ/NEW DIP NAME?/]
PUSHJ P,TREADU
POPJ P,
JRST ERRET
PUSHJ P,TEST7
JRST PUTFS
MOVEM B,DSTRNG
DIPCHECK
PUSHJ P,DALPHA
TDZA H,H ;NOTHING TO GIVE BACK LATER
JRST [ MOVE B,DSTRNG
ASK[ASCIZ/ALREADY EXISTS, REPLACE?/]
JRST PUTFS
JRST PUTFS
FETCH(H,F,NXTD)
FETCH(G,H,NXTD)
JRST GTFACT]
GTFACT: OUTSTR[ASCIZ/LOADING CONVERSION FACTOR?/]
MOVEI T,1
MOVEM T,FACTR1 ;INITIALIZE FACTORS
MOVEM T,FACTR2
MOVE T,[PUSHJ P,TTYIN]
MOVEM T,GETCHR
PUSHJ P,DECIN ;READ FIRST FACTOR
JFCL
CAIN TTT,12
JUMPE A,USEONE ;CRLF IS 1/1
MOVEM A,FACTR1
CAIE TTT,"/"
JRST USEONE
PUSHJ P,DECIN
JFCL
JUMPE A,FACTER
MOVEM A,FACTR2
USEONE: CAIE TTT,12
JRST FACTER
GETFS(T,DHEAD)
BCLEAR(TT,T,DHEAD)
MOVE TT,DSTRNG
STORE(TT,T,DNAM)
STORE(T,F,NXTD)
STORE(G,T,NXTD)
FETCH(TTT,W,DPNN)
STORE(TTT,T,DPNN)
FETCH(TTT,W,DPAK)
STORE(TTT,T,DPAK)
MOVEI T,RADDR(T,DPIN,DPNXT)
MOVEI W,RADDR(W,DPIN,DPNXT)
JRST COPLP1
COPLOP: GETFS (TT,DPHEAD)
STORE(TT,T,DPNXT)
MOVE T,TT
FETCH(TTT,W,DPNM)
STORE(TTT,T,DPNM)
FETCH(TTT,W,DUSE)
STORE(TTT,T,DUSE)
FETCH(TTT,W,PSWP)
STORE(TTT,T,PSWP)
FETCH(TTT,W,SCTB)
STORE(TTT,T,SCTB)
FETCH(TTT,W,SCTP)
STORE(TTT,T,SCTP)
FETCH(TTT,W,DPBIT)
STORE(TTT,T,DPBIT)
FETCH(A,W,LHI)
TRNN TTT,PWR
PUSHJ P,FACTOR ;SCALE HI
STORE(A,T,LHI)
FETCH(A,W,LLOW)
TRNN TTT,PWR
PUSHJ P,FACTOR ;SCALE LOW
STORE(A,T,LLOW)
COPLP1: FETCH(W,W,DPNXT)
JUMPN W,COPLOP
CLEAR(T,DPNXT) ;CLEAR LAST LINK
JUMPN H,RELH2 ;ANYTHING TO GIVE BACK?
POPJ P,
FACTOR: IMUL A,FACTR1
IDIV A,FACTR2
ASH B,1
CAML B,FACTR2
ADDI A,1 ;ROUND UP
POPJ P,
FACTER: OUTSTR[ASCIZ/INPUT ERROR!
/]
CLRBFI
JRST GTFACT
DIPDEL: SKIPE RESIDENT
JRST NOMODR
PUSHJ P,DIPSET
POPJ P,
RELDIP: FETCH(H,F,NXTD)
FETCH(G,H,NXTD) ;GET HIS NEXT POINTER
STORE(G,F,NXTD) ;LINK HIM OUT
JRST RELH2 ;AND GIVE HIM BACK
MAKDIP: PUSHJ P,TEST7
JRST TOLONG
ASK [ASCIZ /DIP DOES NOT EXIST, CREATE? /]
JRST TOLONG
JRST TOLONG
GETFS (H,DHEAD)
BCLEAR(TT,H,DHEAD)
MOVE TT,DSTRNG
STORE(TT,H,DNAM)
STORE(H,F,NXTD)
STORE(G,H,NXTD)
PUSHJ P,GETPAK
JRST TOLONG
JRST GOTDIP
STORE(A,H,DPAK)
JRST GOTDIP
TOLONG: MOVE B,DSTRNG
JRST PUTFS
;GETPAK - READ PACKAGE NAME
;RETURNS
; - FAILS
; - LET HIM OUT
; -WIN
;A = PACKAGE CODE
GETPAK: OUTSTR [ASCIZ /PACKAGE TYPE (# OF PINS)? /]
PUSHJ P,TREADU
POPJ P,
JRST CPOPJ1
MOVE T,B
PUSHJ P,MATPAK ;DO WE KNOW ABOUT THIS PACKAGE ?
JRST [ PUSHJ P,PUTFS
OUTSTR [ASCIZ /Unknown package name
/]
PUSHJ P,IERR
POPJ P,]
PUSHJ P,PUTFS
JRST CPOPJ2
SETPAK: SKIPE RESIDENT
JRST NOMODR
PUSHJ P,DIPSET
POPJ P,
PUSHJ P,GETPAK
POPJ P,
POPJ P,
STORE(A,H,DPAK)
POPJ P,
SUBTTL DIP PROPERTY ROUTINES
;VALFIX - FIX VALUE STRING TO BE CONONICAL FORM
; OHM, M - MEG, m - MILLI,  - UMICRO
VALFIX: PUSH P,A
PUSH P,B
PUSH P,T
HRRZ A,T
ADD A,[POINT 7,1]
MOVE B,[POINT 7,STRTAB]
VALFX1: PUSHJ P,VALGET
JRST VALFX2
CAIN TTT,""
JRST VALOHM
CAIN TTT,"M"
JRST VALMEG
CAIN TTT,"M"+40
JRST VALMIL
CAIN TTT,""
MOVEI TTT,"U"
VALFX3: PUSHJ P,VPUTIT
JRST VALFX1
VALOHM: MOVEI T,[ASCIZ/OHMS/]
VALSTR: MOVEI TTT,40
LDB TT,B
CAIE TT,40
PUSHJ P,VPUTIT
HRLI T,(<POINT 7,0>)
VALST1: ILDB TTT,T
JUMPE TTT,VALFX1
PUSHJ P,VPUTIT
JRST VALST1
VALMEG: PUSHJ P,VALCHK
JRST VALFX3
MOVEI T,[ASCIZ/MEG/]
JRST VALSTR
VALMIL: PUSHJ P,VALCHK
JRST VALFX3
MOVEI T,[ASCIZ/MILLI/]
JRST VALSTR
VALCHK: LDB TT,B
CAIL TT,"A"
CAILE TT,"Z"
SKIPN TT ;NOT PRECEEDED BY LETTER, NULL?
POPJ P, ;LETTER OR BEGINNING OF STRING
PUSH P,A
PUSH P,TTT
PUSHJ P,VALGET
SETZ TTT,
CAIL TTT,"A"
CAILE TTT,"Z"
JRST [ MOVE TT,TTT
POP P,TTT
POP P,A
CAIL TT,"0" ;IF FOLLOWED BY
CAILE TT,"9" ;A DIGIT, THEN NO
AOS (P)
POPJ P,]
PUSHJ P,VALGET
SETZ TTT,
MOVE TT,TTT
POP P,TTT
POP P,A
CAIL TT,"A"
CAILE TT,"Z"
AOS (P)
POPJ P,
VALGET: TLNN A,760000
JRST [ TRNE A,-1
HRR A,-1(A)
TRNN A,-1
POPJ P,
JRST .+1]
ILDB TTT,A
JUMPE TTT,VALGET
CAIN TTT,""
MOVEI TTT,40
CAIL TTT,"A"+40
CAILE TTT,"Z"+40
JRST CPOPJ1
SUBI TTT,40
JRST CPOPJ1
VALFX2: SETZ TTT,
PUSHJ P,VPUTIT
TLNE B,760000
JRST VALFX2
POP P,B ;GET BACK ORIGINAL STRING
PUSHJ P,PUTFS
POP P,B
POP P,A
MOVEI TT,STRTAB
JRST ASCCOP
VPUTIT: CAMN B,[POINT 7,STRTAB+MXSTLN-1,34]
JRST [ OUTSTR[ASCIZ/EXPANDED STRING TOO LONG, TRUNCATED!
/]
POPJ P,]
CAIL TTT,"a"
CAILE TTT,"z"
CAIA
SUBI TTT,40 ;CONVERT LOWER CASE TO UPPER CASE
IDPB TTT,B
POPJ P,
VALMAT: ADD T,[POINT 7,1]
ADD TT,[POINT 7,1]
PUSH P,A
VALMT1: PUSHJ P,VGETT
JRST [ PUSHJ P,VGETTT
JRST VALMTW
JRST VALMTE]
PUSHJ P,VGETTT
JRST VALMTE
CAMN TTT,A
JRST VALMT1
VALMTE: POP P,A
POPJ P,
VALMTW: POP P,A
JRST CPOPJ1
VGETT: TLNN T,760000
JRST [ HRR T,-1(T)
TRNN T,-1
POPJ P,
JRST .+1]
ILDB TTT,T
JUMPE TTT,VGETT
CAIN TTT,40
JRST VGETT
JRST CPOPJ1
VGETTT: TLNN TT,760000
JRST [ HRR TT,-1(TT)
TRNN TT,-1
POPJ P,
JRST .+1]
ILDB A,TT
JUMPE A,VGETTT
CAIN A,40
JRST VGETTT
JRST CPOPJ1
;Setup PARTLIST, entries must be sorted
; also clears PNUSED bits
THREAD: SKIPN H,DIPLST
POPJ P,
THRD1: FETCH(G,H,PRPV)
JUMPE G,THRD2
THRD3: FETCH(T,G,PRBT)
TRZ T,PNUSED ;CLEAR THIS BIT EVERYWHERE
STORE(T,G,PRBT)
TRNE T,PARTNM
PUSHJ P,THRDPN ;SORT IN PART NUMBER
FETCH(T,G,PRNP)
JUMPN T,[MOVE G,T
JRST THRD3]
THRD4: FETCH(T,G,PRNV)
JUMPN T,[MOVE G,T
JRST THRD3]
FETCH(G,G,PRPP)
JUMPN G,THRD4
THRD2: FETCH(H,H,NXTD)
JUMPN H,THRD1
POPJ P,
;THRDPN - Enter part number property in G onto PARTLIST, in alphasorted order.
THRDPN: PUSH P,F
PUSH P,E
MOVEI F,PARTLIST-ADDR(0,NXPL)
JRST THRDP1
THRDP2: FETCH(TT,F,PLPT) ;GET PART NUMBER BLOCK POINTER
FETCH(TT,TT,PRVS) ;GET VALUE STRING AT LIST
FETCH(T,G,PRVS) ;GET OUT VALUE STRING (G)
PUSHJ P,DSORT ;COMPARE
JRST THRDP3 ; New Property value is less, insert here
JRST THRDP1 ; still larger, scan further
FETCH(T,F,PLBT) ; exactly equal
TRO T,PL2ND ;MARK OLD AS SECOND OCCURANCE OF PART NUMBER
STORE(T,F,PLBT)
THRDP3: GETFS(T,PLBK) ;INSERT NEW ENTRY ON PARTS LIST
BCLEAR(TT,T,PLBK)
STORE(F,T,NXPL)
STORE(T,E,NXPL) ; (E)  (T.NEW)  (F)
STORE(G,T,PLPT)
POP P,E
POP P,F
POPJ P,
THRDP1: MOVE E,F ;SCAN PARTLIST THREAD BLOCKS
FETCH(F,F,NXPL)
JUMPN F,THRDP2
JRST THRDP3 ;END OF PARTLIST, PUT ONTO END
;UNTHRD - Remove part number in T from PARTLIST
UNTHRD: FETCH(TT,T,PRBT)
TRNN TT,PARTNM
POPJ P,
PUSH P,T
MOVEI TT,PARTLIST-ADDR(0,NXPL)
JRST UTHRD1
UTHRD2: FETCH(TTT,TT,PLPT)
CAMN TTT,(P)
JRST UTHRD3
UTHRD1: MOVE T,TT
FETCH(TT,TT,NXPL)
JUMPN TT,UTHRD2
POP P,T
OUTSTR[ASCIZ/PROGRAM ERROR - PART NUMBER BLOCK NOT FOUND AT UNTHRD.
/]
POPJ P,
UTHRD3: FETCH(TTT,TT,NXPL)
STORE(TTT,T,NXPL)
FETCH(TTT,TT,PLBT)
;NOTE!!! HERE WE LOSE ANY FREE STORAGE POINTED TO BY MDCN
FSTRET(TT,PLBK)
TRNE TTT,PL2ND ;ARE WE A SECOND?
JRST UTHRD4 ;YES, DON'T CHANGE NEXT
FETCH(TT,T,NXPL) ;next block can't be second, unless we were also.
FETCH(TTT,TT,PLBT)
TRZ TTT,PL2ND ;THIS IS NO LONGER A SECOND
STORE(TTT,TT,PLBT)
UTHRD4: POP P,T
POPJ P,
; ENTER DIP PROPERTY MODE
DIPPRP: SKIPE RESIDENT
JRST NOMODR
PUSHJ P,DIPSET
POPJ P,
MOVEM H,CURDIP
MOVEI T,[PUSHJ P,PRPLOP]
MOVEM T,DISPWD
MOVEI T,[ASCIZ/**/]
MOVEM T,PROMPT
OUTSTR[ASCIZ/DIP PROPERTY SUB-MODE!
/]
POPJ P,
PRPLOP: MOVE H,CURDIP ;SET THIS UP FOR ROUTINES
CAIN A,12
JRST [ OUTCHR[15]
POPJ P,]
CAIN A,"E"
JRST DIPMOD ;RETURN TO DIP MODE
CAIN A,"I"
JRST PRPADD
CAIN A,"R"
JRST PRPDEL
CAIN A,"A"
JRST PRPNEW
CAIN A,"D"
JRST PRPFLU
CAIN A,"C"
JRST PRPCHG
CAIN A,"P"
JRST PRPPNT
JRST CPOPJ1 ;ERROR RETURN
;Print out properties
PRPPNT: PUSHJ P,TREAD
POPJ P, ;QUIT ON ALTMODE
CAIA
JRST [ PUSHJ P,PUTFS
JRST ERRET] ;NO ARGUMENT
SETZM LCOUNT ;INITIALIZE LINE COUNT
MOVE T,[PUSHJ P,TTYOUT]
MOVEM T,PUTCHR
PRPPN0: FETCH(G,H,PRPN)
JUMPE G,[PUTSTR[ASCIZ/NO PROPERTIES.
/]
POPJ P,]
SETZM DEPTH
PRPPN1: FETCH(A,G,PRNS)
PUSHJ P,STROUT
FETCH(G,G,PRNN)
JUMPE G,PRPPN2
AOS A,DEPTH
IMULI A,=16
CAMG A,LCOUNT
CRLF
PUSHJ P,FILL
JRST PRPPN1
PRPPN2: CRLF
CRLF ;MAKE A BLANK LINE
FETCH(G,H,PRPV)
JUMPE G,[PUTSTR[ASCIZ/NO VALUES.
/]
POPJ P,]
SETZM DEPTH
PRPPN3: MOVEI A,40
FETCH(T,G,PRBT)
TRNE T,DEFPRP
MOVEI A,"*"
PUTBYT (A)
TRNE T,NULVAL
PUTBYT "!"
FETCH(A,G,PRVS)
PUSHJ P,STROUT
FETCH(T,G,PRNP)
JUMPN T,[AOS DEPTH
JRST PRPPN4]
PRPPN5: FETCH(T,G,PRNV)
JUMPN T,PRPPN4
FETCH(G,G,PRPP)
JUMPE G,[CRLF
POPJ P,]
SOS DEPTH
JRST PRPPN5
PRPPN4: MOVE G,T
MOVE A,DEPTH
IMULI A,=16
CAMG A,LCOUNT
CRLF
JUMPE A,PRPPN3
PUSHJ P,FILL
JRST PRPPN3
;Change properties
PRPCHG: OUTSTR[ASCIZ/NOT IMPLEMENTED YET.
/]
POPJ P,
;Add new property
PRPNEW: MOVE TT,[PUSHJ P,TTYOUT]
MOVEM TT,PUTCHR
MOVE TT,[PUSHJ P,TTYIN]
MOVEM TT,GETCHR
SETZM PRPLST
MOVEI F,PRPLST-ADDR(0,PRNP)
TRZ FLAG
FETCH(G,H,PRPN)
JUMPN G,PRPNW1
GETFS(G,PNBK) ;NOW MAKE NAME BLOCK FOR "PART NUMBER"
BCLEAR(T,G,PNBK)
MOVEI TT,[ASCIZ/PART NUMBER/]
PUSHJ P,ASCCOP
STORE(T,G,PRNS)
STORE(G,H,PRPN) ;LINK IN
PRPNW0: PUSHJ P,RPRVAL
JRST PRPADE ;QUIT
CAIA ;NULL LINE
JRST PRPNW4 ;NOT NULL LINE
CAIE TTT,12
JRST PRPNW0
TRO FLAG ;NO ARG, PROMPT FOR VALUES
PRPNW1: TRNN FLAG
JRST PRPNW2
FETCH(A,G,PRNS)
PUSHJ P,STROUT
OUTSTR[ASCIZ/: /]
PRPNW2: PUSHJ P,RPRVAL
JRST PRPNWA ;QUIT
JRST [ CAIE TTT,12 ;NULL
JRST PRPNW2
TRON FLAG
JRST PRPNW1
JRST PRPNWA] ;LET HIM OUT LIKE ALTMODE
PRPNW4: CAIN TTT,12
TRO FLAG
CAIN TTT,11
TRZ FLAG
GETFS(A,PVBK)
BCLEAR(T,A,PVBK)
STORE(G,A,PRNB)
STORE(A,F,PRNP)
STORE(B,A,PRVS)
STORE(TT,A,PRBT) ;STORE BITS FROM RPRVAL
STORE(F,A,PRPP)
MOVE F,A
FETCH(G,G,PRNN)
JUMPN G,PRPNW1
TRNN FLAG ;DID WE END WITH LF?
JRST PRPNWB ;NO, TOO MANY VALUES
PRPNW5: FETCH(T,F,PRBT)
TRO T,DEFPRP!PARTNM
STORE(T,F,PRBT) ;MAKE SURE LAST BLOCK IS PART NUMBER AND DEFAULT
MOVE G,F
PUSHJ P,THRDPN ;THREAD NEW PART NUMBER
MOVEI G,RADDR(H,PRPV,PRNV)
SETZ D, ;CLEAR SAVED PRPP
MOVE E,PRPLST
JRST PRPNW7
PRPNW8: FETCH(T,G,PRBT)
TRNE T,PARTNM ;IF THIS IS PART NUMBER,
JRST PRPNP2 ;THEN WE ARE CHANGING PART NUMBER, NOT ADDING NEW ONE
FETCH(T,E,PRVS)
FETCH(TT,G,PRVS)
PUSHJ P,DSORT
JRST PRPNP1
JRST PRPNW7
MOVE A,E
FETCH(E,E,PRNP)
FSTRET(A,PVBK)
JUMPE E,[OUTSTR[ASCIZ/RAN OUT OF NEW VALUES BEFORE GETTING TO PART NUMBER!
/]
JRST ERRET]
MOVE D,G ;SAVE FOR PRPP
MOVEI G,RADDR(G,PRNP,PRNV)
PRPNW7: MOVE F,G
FETCH(G,G,PRNV)
JUMPN G,PRPNW8
PRPNP1: STORE(G,E,PRNV)
STORE(D,E,PRPP)
STORE(E,F,PRNV)
POPJ P,
PRPNP2: FETCH(B,G,PRVS)
PUSHJ P,PUTFS
FETCH(B,E,PRVS)
STORE(B,G,PRVS)
FETCH(B,E,PRBT)
STORE(B,G,PRBT)
FSTRET(E) ;THERE THEORETICALLY SHOULDN'T BE ANY BELOW HERE
POPJ P,
PRPNWB: OUTSTR[ASCIZ/MORE VALUES THAN PROPERTIES.
/]
PUSHJ P,IERR
PRPNWA: SKIPN G,PRPLST
JRST PRPADE
PRPNWC: MOVE A,G
FETCH(G,G,PRNP)
FSTRET(A,PVBK)
JUMPN G,PRPNWC
JRST PRPADE
;Read property value
RPRVAL: SETZ TT,
RPRVL1: XCT GETCHR
POPJ P, ;EOF
CAIN TTT,"*" ;STAR MEANS
JRST [ TRO TT,DEFPRP ;DEFAULT
JRST RPRVL1]
CAIN TTT,"!" ;EXCLAIM MEANS
JRST [ TRO TT,NULVAL ;NULL VALUE
JRST RPRVL1]
HRLM TT,(P)
CAIN TTT,40 ;SPACE IS KLUDGE TO ALLOW "*" OR "!"
JRST [ XCT GETCHR
POPJ P,
JRST .+1]
PUSHJ P,TISTRU
POPJ P,
POPJ P,
JRST CPOPJ1
HLRZ TT,(P)
JRST CPOPJ2
;Flush properties
PRPFLU: PUSHJ P,TREADU
POPJ P,
JRST [ OUTSTR[ASCIZ/PART NUMBER?/]
PUSHJ P,TREADU
POPJ P,
POPJ P,
JRST .+1]
MOVEM B,STRING
FETCH(G,H,PRPV)
JUMPE G,PRPFLA
SETZ F, ;NO PARTIAL MATCH YET
TRZ FLAG ;NOT AMBIGUOUS YET
PRPFL1: FETCH(T,G,PRBT)
TRNN T,PARTNM
JRST PRPFL2
HRRZ T,STRING
FETCH(TT,G,PRVS)
PUSHJ P,TXTPAR
JRST PRPFL3
JRST PRPFL3
JRST PRPFL4
MOVE F,G
JRST PRPFL6
PRPFL4: SKIPE F
TRO FLAG ;AMBIGUOUS
MOVE F,G
JRST PRPFL3
PRPFL2: FETCH(T,G,PRNP)
JUMPN T,[MOVE G,T
JRST PRPFL1]
PRPFL5: FETCH(T,G,PRNV)
JUMPN T,[MOVE G,T
JRST PRPFL1]
PRPFL3: FETCH(G,G,PRPP)
JUMPN G,PRPFL5
TRNE FLAG
JRST PRPFLB
JUMPN F,PRPFL6
PRPFLA: OUTSTR[ASCIZ/NO SUCH PART NUMBER.
/]
JRST PRPADA
PRPFLB: OUTSTR[ASCIZ/AMBIGUOUS PART NUMBER.
/]
JRST PRPADA
PRPFL6: FETCH(A,F,PRPP)
JUMPE A,[FETCH(B,H,PRPV)
JRST PRPFL7]
FETCH(B,A,PRNP)
PRPFL7: CAME B,F
JRST PRPFL8
FETCH(C,F,PRNV)
JUMPN C,PRPFL9
JUMPE A,PRPFL9
MOVE F,A
JRST PRPFL6
PRPFL8: FETCH(C,B,PRNV)
PRPFM3: CAMN C,F
JRST PRPFM2
MOVE B,C
FETCH(C,C,PRNV)
JUMPN C,PRPFL8
OUTSTR[ASCIZ/VALUE BLOCK NOT FOUND AT PRPFL8!
/]
JRST PRPADA
PRPFM2: FETCH(C,F,PRNV)
STORE(C,B,PRNV)
PRPFM1: CLEAR(F,PRPP)
CLEAR(F,PRNV)
MOVE A,F
PUSHJ P,RELPRP
JRST PRPADA
PRPFL9: JUMPE A,[STORE(C,H,PRPV)
JRST PRPFM1]
STORE(C,A,PRNP)
JRST PRPFM1
;Set new property name
PRPSET: PUSHJ P,TREADU
POPJ P, ;ALTMODE
JRST [ OUTSTR[ASCIZ/PROPERTY NAME?/]
PUSHJ P,TREADU
POPJ P,
POPJ P,
JRST .+1]
MOVEM B,STRING ;SAVE NEW PROPERTY NAME
JRST CPOPJ1
;FIND PROPERTY
;RADDR(H,PRPN,PRNN) IN F
;PRNN OF F IN G
;STRING IN T
;RETURNS: +1 NO SUCH PROPERTY
; +2 AMBIGUOUS
; +3 FOUND BY PARTIAL MATCH
; +4 FOUND BY EXACT MATCH
PRPFND: PUSH P,T
SETZ A,
TLZ TFLG
PRPFN1: MOVE T,(P)
FETCH(TT,G,PRNS)
PUSHJ P,TXTPAR
JRST PRPFN2
JRST PRPFN2
JRST PRPFN3
POP P,T
JRST CPOPJ3 ;EXACT MATCH RETURN
PRPFN3: SKIPE A ;ANY OTHER PARTIALS?
TLO TFLG ;YES, FLAG IT
MOVE A,G
HRL A,F
PRPFN2: MOVE F,G
FETCH(G,G,PRNN)
JUMPN G,PRPFN1
POP P,T
TLNE TFLG
JRST CPOPJ1
JUMPE A,CPOPJ
HRRZ G,A
HLRZ F,A
JRST CPOPJ2
PRPADD: PUSHJ P,PRPSET
POPJ P,
HRRZ T,STRING
MOVEI F,RADDR(H,PRPN,PRNN)
FETCH(G,F,PRNN)
JUMPE G,PRPADX
PUSHJ P,PRPFND
JRST PRPAD0
JRST PRPAD0
JRST [ ASK[ASCIZ/PROPERTY IS PARTIAL MATCH TO EXISTING PROPERTY,
ARE YOU SURE YOU WANT TO CREATE IT?/]
JRST PRPADA
JRST PRPADA
JRST PRPAD0]
PRPADY: OUTSTR[ASCIZ/SORRY - PROPERTY ALREADY EXISTS.
/]
JRST PRPADA
PRPADX: MOVEI TT,[ASCIZ/PART NUMBER/]
PUSHJ P,ASCPAR
JRST PRPAD0
JRST PRPAD0
JRST PRPADY
PRPAD0: OUTSTR[ASCIZ/NAME OF OLD PROPERTY TO
INSERT NEW PROPERTY BEFORE?
/]
PUSHJ P,TREADU
JRST PRPADA
JRST PRPADA
HRLM B,STRING
MOVEI F,RADDR(H,PRPN,PRNN)
FETCH(G,F,PRNN)
JUMPN G,PRPAD1 ;IF WE HAVE LIST, JUST SEARCH IT
HLRZ T,STRING
MOVEI TT,[ASCIZ/PART NUMBER/]
PUSHJ P,ASCPAR ;IF NO LIST YET, MUST BE "PART NUMBER"
JRST PRPADB ;NOT EXACT OR PARTIAL MATCH, ERROR
JFCL ;PARTIAL MATCH
HLRZ B,STRING ;GIVE THIS BACK, IT MAY ONLY BE A PARTIAL MATCH
PUSHJ P,PUTFS
GETFS(G,PNBK) ;NOW MAKE NAME BLOCK FOR "PART NUMBER"
BCLEAR(T,G,PNBK)
MOVEI TT,[ASCIZ/PART NUMBER/]
PUSHJ P,ASCCOP
STORE(T,G,PRNS)
STORE(G,F,PRNN) ;LINK IN
JRST PRPAD3
PRPAD1: HLRZ T,STRING
PUSHJ P,PRPFND
JRST PRPADB ;NOT FOUND
JRST PRPADC ;AMBIGUOUS
HLRZ B,STRING ;EXACT MATCH
PUSHJ P,PUTFS
PRPAD3: FETCH(E,H,PRPV) ;GET PROPERTY VALUE POINTER
JUMPE E,PRPAD7 ;ALL DONE IF NO VALUES YET.
OUTSTR[ASCIZ/VALUE OF THIS PROPERTY FOR EXISTING PARTS?
/]
PUSHJ P,RPRVAL
JRST PRPADA ;QUIT
JRST PRPADA ;NULL (SOMEDAY WE WILL PROMPT FOR THIS)
HRLM B,STRING
MOVEM TT,TMPCN1 ;SAVE BITS HERE
PRPAD7: GETFS(A,PNBK)
BCLEAR(T,A,PNBK)
HRRZ T,STRING
STORE(T,A,PRNS)
STORE(G,A,PRNN)
STORE(A,F,PRNN) ;NOW WE HAVE THE NEW PROPERTY NAME
JUMPE E,CPOPJ ;DON'T HAVE TO INSERT NEW IF NO VALUES YET
HLRZS STRING
MOVE F,A ;SAVE OUR PROPERTY HERE
PRPAD4: FETCH(T,E,PRNB)
CAME T,G ;IS THIS WHERE TO INSERT IT?
JRST PRPAD5
FETCH(D,E,PRPP) ;GET PREVIOUS POINTER
GETFS(A,PVBK)
BCLEAR(T,A,PVBK)
MOVE TT,STRING
PUSHJ P,LSTCOP ;COPY VALUE
STORE(T,A,PRVS) ;STORE INTO BLOCK
FETCH(T,A,PRBT)
TDO T,TMPCN1 ;ADD BITS FROM RPRVAL
STORE(T,A,PRBT)
STORE(F,A,PRNB) ;STORE POINTER TO PROPERTY NAME BLOCK
STORE(D,A,PRPP) ;STORE PREVIOUS POINTER
MOVE B,E ;NOW SPREAD NEW BLOCK THROUGH LOWER LEVEL
PRPAD8: STORE(A,B,PRPP)
FETCH(B,B,PRNV)
JUMPN B,PRPAD8
STORE(E,A,PRNP)
SKIPE D
STORE(A,D,PRNP) ;IF NOT TOP, STORE US IN PREVIOUS
SKIPN D
STORE(A,H,PRPV) ;IF TOP, STORE IN DIP DEF
SKIPN E,D
POPJ P,
JRST PRPAD6
PRPAD5: FETCH(T,E,PRNP)
JUMPN T,[MOVE E,T
JRST PRPAD4]
PRPAD6: FETCH(T,E,PRNV)
JUMPN T,[MOVE E,T
JRST PRPAD5]
FETCH(E,E,PRPP)
JUMPN E,PRPAD6
POPJ P,
PRPADC: OUTSTR[ASCIZ/AMBIGUOUS PROPERTY.
/]
CAIA
PRPADB: OUTSTR[ASCIZ/NO SUCH PROPERTY.
/]
HLRZ B,STRING
PUSHJ P,PUTFS
PRPADA: HRRZ B,STRING
PUSHJ P,PUTFS
PRPADE: FETCH(T,H,PRPV)
JUMPN T,CPOPJ ;LEAVE IF ANY VALUES
FETCH(A,H,PRPN)
FETCH(T,A,PRNN)
JUMPN T,CPOPJ ;IF MORE THAN ONE PROPERTY NAME, LEAVE LIST
FSTRET(A,PNBK) ;ELSE RETURN BLOCK (WHICH MUST BE "PART NUMBER" BLOCK)
CLEAR(H,PRPN) ;AND POINTER TO IT
POPJ P,
;Delete property
PRPDEL: PUSHJ P,PRPSET
POPJ P,
MOVEI F,RADDR(H,PRPN,PRNN)
FETCH(G,F,PRNN)
JUMPE G,PRPDLA
HRRZ T,STRING
PUSHJ P,PRPFND
JRST PRPDLA
JRST PRPDLB
JFCL ;PARTIAL MATCH
MOVE B,STRING ;EXACT MATCH
PUSHJ P,PUTFS
FETCH(T,G,PRNN)
JUMPE T,[FETCH(T,H,PRPN) ;GET FIRST PROPERTY NAME
CAMN T,G
JRST .+1 ;ALLOW DELETION OF "PART NUMBER" IF IT IS ONLY ONE.
OUTSTR[ASCIZ/SORRY - CAN'T DELETE "PART NUMBER" UNLESS ONLY PROPERTY.
/]
POPJ P,]
FETCH(E,H,PRPV) ;GET VALUE LIST
JUMPE E,PRPDLX ;DONE IF NONE
TRZ FLAG
MOVE T,[PUSHJ P,TTYOUT]
MOVEM T,PUTCHR
PUSHJ P,PRPCLR ;CLEAR TEMP MARK BITS
PRPDL2: FETCH(T,E,PRNB)
CAME T,G ;IS THIS A VALUE TO DELETE
JRST PRPDL9 ;NO
FETCH(B,E,PRBT)
FETCH(T,E,PRNV)
JUMPE T,[TRO B,PRTMP1
STORE(B,E,PRBT)
JRST PRPDL4]
TRON FLAG
OUTSTR[ASCIZ/TYPE Y FOR BRANCH OF TREE YOU WANT PRESERVED.
/]
PRPDL8: SKIPA D,E
PRPDL5: PUTBYT 11
FETCH(A,D,PRVS)
PUSHJ P,STROUT
FETCH(D,D,PRPP)
JUMPN D,PRPDL5
ASK[ASCIZ/?/]
POPJ P, ;LET HIM OUT
JRST PRPDL6
TRO B,PRTMP1 ;YES = SAVE THIS BRANCH
STORE(B,E,PRBT)
PRPDL4: FETCH(E,E,PRPP) ;NOW BACK OUT
JUMPE E,PRPDL7
PRPDL3: FETCH(T,E,PRNV)
JUMPE T,PRPDL4
MOVE E,T
PRPDL9: FETCH(T,E,PRNP)
JUMPE T,PRPDL3
MOVE E,T
JRST PRPDL2
PRPDL6: FETCH(T,E,PRNV)
JUMPE T,[OUTSTR[ASCIZ/SORRY - YOU DIDN'T CHOSE ONE, TRY AGAIN.
/]
FETCH(E,E,PRPP)
JUMPE E,[FETCH(E,H,PRPV)
JRST PRPDL8]
FETCH(E,E,PRNP)
JRST PRPDL8]
MOVE E,T
JRST PRPDL8
PRPDL7: FETCH(E,H,PRPV)
PRPDM1: FETCH(T,E,PRNB)
CAME T,G
JRST PRPDM2
MOVE D,E
FETCH(E,D,PRPP)
PRPDM5: FETCH(T,D,PRBT)
TRNN T,PRTMP1
JRST PRPDM3
FETCH(A,D,PRNP)
JUMPE A,PRPDN1
PRPDN2: STORE(E,A,PRPP) ;FIXUP BACK POINTERS FOR LOWER LEVEL
FETCH(A,A,PRNV)
JUMPN A,PRPDN2
FETCH(A,D,PRNP)
PRPDN1: JUMPE E,[STORE(A,H,PRPV)
JRST PRPDM4]
STORE(A,E,PRNP)
PRPDM4: MOVE C,D
FETCH(D,D,PRNV)
MOVE T,C
PUSHJ P,UNTHRD
FSTRET(C,PVBK)
JRST PRPDM6
PRPDM3: MOVE A,D
FETCH(D,D,PRNV)
CLEAR(A,PRPP)
CLEAR(A,PRNV)
PUSHJ P,RELPRP
PRPDM6: JUMPN D,PRPDM5
CAIA
PRPDM8: FETCH(E,E,PRPP)
JUMPE E,PRPDLX
PRPDM7: FETCH(T,E,PRNV)
JUMPE T,PRPDM8
MOVE E,T
PRPDM2: FETCH(T,E,PRNP)
JUMPE T,PRPDM7
MOVE E,T
JRST PRPDM1
PRPDLX: FETCH(T,G,PRNN)
STORE(T,F,PRNN)
FSTRET(G,PNBK)
POPJ P,
PRPDLB: OUTSTR[ASCIZ/AMBIGUOUS PROPERTY.
/]
CAIA
PRPDLA: OUTSTR[ASCIZ/NO SUCH PROPERTY.
/]
MOVE B,STRING
JRST PUTFS
PRPCLR: FETCH(A,H,PRPV)
JUMPE A,CPOPJ
PRPCL1: FETCH(T,A,PRBT)
TRZ T,PRTMP1
STORE(T,A,PRBT)
FETCH(T,A,PRNP)
JUMPN T,[MOVE A,T
JRST PRPCL1]
PRPCL2: FETCH(T,A,PRNV)
JUMPN T,[MOVE A,T
JRST PRPCL1]
FETCH(A,A,PRPP)
JUMPN A,PRPCL2
POPJ P,
SUBTTL 'LSD' LIST DIP DEFS
;LIST ALL DIP DEFINITIONS INTO FILE
DIPPRA: PUSHJ P,DIPCHK
JRST ERRET
PUSHJ P,TREADu
POPJ P,
JRST DIPPRB
MOVE A,1(B)
PUSHJ P,PUTFS
CAMN A,[ASCIZ/PARTS/]
JRST DIPPTA
JRST ERRET
DIPPRB: MOVSI T,'LSD'
MOVEI TT,0
MOVSI TTT,'DSK'
PUSHJ P,OUTSET
POPJ P,
MOVE H,DIPLST
PNTAL2: SKIPN T,LCOUNT
JRST PNTAL3
CAILE T,=64
JRST [ CRLF ;LEAVE LOTS OF SPACE
CRLF
JRST PNTAL3]
PUTBYT 11
PNTAL3: FETCH(A,H,DNAM)
PUSHJ P,STROUT
FETCH(H,H,NXTD)
JUMPN H,PNTAL2
MOVE H,DIPLST
DIPCHECK
PNTALL: PUSHJ P,DIPHDR ;PRINT TOP LINE
PUSHJ P,FSTLIN ;FIRST LINE OF DIP DEF
MOVEI G,RADDR(H,DPIN,DPNXT)
JRST PNTAL4
PNTAL1: CRLF ;EXTRA CRLF
PUSHJ P,ONELIN
PNTAL4: FETCH(G,G,DPNXT)
JUMPN G,PNTAL1
CRLF
CRLF
PUSHJ P,PRPPN0
FETCH(H,H,NXTD)
JUMPN H,PNTALL
RELEASE LST,
POPJ P,
DIPHDR: PUTSTR[BYTE(7)15,14]
PUTSTR[ASCIZ/DIP DEFINITIONS FROM /]
PUSHJ P,DNPNT1
MOVEI A,=64
PUSHJ P,FILL ;FILL TO END OF 8TH COLUMN
FETCH(A,H,DNAM)
PUSHJ P,STROUT ;PRINT DIP NAME
CRLF
CRLF
CRLF
POPJ P,
SUBTTL 'PTL' LIST DIP DEFS
;LIST ALL DIP DEFINITIONS INTO FILE
DIPPTA: MOVSI T,'PTL'
MOVEI TT,0
MOVSI TTT,'DSK'
PUSHJ P,OUTSET
POPJ P,
TLO SIMTAB ;SO IT CAN BE SORTED
MOVE H,DIPLST
DIPPT1: FETCH(T,H,PRPV) ;PART TREE
JUMPE T,DIPPT2
DIPPT3: MOVE G,T
FETCH(T,G,PRNP)
JUMPN T,DIPPT3
FETCH(T,G,PRBT)
TRNN T,PARTNM
JRST DIPPT4
FETCH(A,G,PRVS)
PUSHJ P,STROUT
MOVEI A,=16
PUSHJ P,FILL
FETCH(A,H,DNAM)
PUSHJ P,STROUT
FETCH(F,G,PRPP)
JUMPE F,DIPPT6
MOVEI A,=32
PUSHJ P,FILL
CAIA
DIPPT7: PUTSTR[ASCIZ/, /]
FETCH(A,F,PRNB)
FETCH(A,A,PRNS)
PUSHJ P,STROUT
PUTBYT ":"
FETCH(T,F,PRBT)
TRNE T,DEFPRP
PUTBYT "*"
TRNE T,NULVAL
PUTBYT "!"
FETCH(A,F,PRVS)
PUSHJ P,STROUT
FETCH(F,F,PRPP)
JUMPN F,DIPPT7
DIPPT6: CRLF
DIPPT4: FETCH(T,G,PRNV)
JUMPN T,DIPPT3
FETCH(T,G,PRPP)
JUMPN T,[MOVE G,T
JRST DIPPT4]
DIPPT5: FETCH(H,H,NXTD)
JUMPN H,DIPPT1
RELEASE LST,
POPJ P,
DIPPT2: PUTSTR[ASCIZ/ /]
FETCH(A,H,DNAM)
PUSHJ P,STROUT
CRLF
JRST DIPPT5
Reference in New Issue View Git Blame Copy Permalink