;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,PNTTYP TAB2: PUSHJ P,GETTYP REPEAT 4, PUSHJ P,PNTLOD TAB3: REPEAT 2, REPEAT 3, PUSHJ P,PNTUSE TAB4: REPEAT 3, REPEAT 2, PUSHJ P,PNTPS TAB5: REPEAT 4, PUSHJ P,PNTPS PUSHJ P,PNTSCT TAB6: REPEAT 5, ; 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 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 AUTO INCREMENT THROUGH PINS STARTING WITH . IF IS LEFT OUT, STARTS AT FIRST PIN. TYPE TO EXIT AUTO INCREMENTING. D DELETE PIN . PRINT LINE FOR PIN . PRINT LINE FOR PIN , 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 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,() 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