X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Flibra.pa;fp=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Flibra.pa;h=aad1f394fe05cda81c90f4432d1f83de9973eb17;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/os8/v3d/sources/fortran/all/libra.pa b/sw/os8/v3d/sources/fortran/all/libra.pa new file mode 100644 index 0000000..aad1f39 --- /dev/null +++ b/sw/os8/v3d/sources/fortran/all/libra.pa @@ -0,0 +1,1424 @@ +/LIBRA: F4 LIBRARIAN, V24A +/ +/ +/ +/ +/ +/ +/ +// +/ +/ +/ +/ +/COPYRIGHT (C) 1974, 1975 +/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. +/ +/ +/ +/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A +/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- +/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER +/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE +/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO +/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE +/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. +/ +/ +/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT +/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL +/EQUIPMRNT COROPATION. +/ +/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS +/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. +/ +/ +/ +/ +/ +/ + /LIBRA: FORTRAN IV LIBRARIAN +/ +/ +/ BORN OF JUD LEONARD, UNDER THE +/ SIGN FOR WHICH IT IS NAMED. +/ +/ +/ CHANGES FOR V23 +/ .PRINT VERSION NUMBER +/ .ACCEPT INPUT FROM CONSOLES WITHOUT PARITY +/ +/ +/ CHANGES FOR OS/8 V3D BY PAULA TIRAK +/ .CHANGED VERSION NUMBER TO 24A +/ .PUT IN NEW DATE ALGORITHM +/ .NO LONGER MISNAMES THE SECOND OUTPUT FILE +/ +/ +/ OS/8 CONSTANTS: +VERS=24 +PATCH="A +/ +FETCH=1 +LOOKUP=2 +ENTER=3 +CLOSE=4 +DECODE=5 +CHAIN=6 +ERROR=7 +USRIN=10 +USROUT=11 +/ +OUTF1=7600 /LIBRARY +OUTF2=7605 /CATALOG LISTING +OUTF3=7612 /UNUSED +INF=7617 +/ +EQHI=7642 +SWATOL=7643 +SWMTOX=7644 +SWYTO9=7645 +EQLO=7646 +DHRES=7647 /HANDLER RESIDENCY TABLE +SYSDAT=7666 /SYSTEM DATE +DCTLW=7760 /DEVICE CONTROL WORD TABLE +/ DEVICE CONTROL WORDS HAVE THE FORM: +/ BIT 0 FILE STRUCTURED +/ BIT 1 READ ONLY +/ BIT 2 WRITE ONLY +/ BITS 3-8 DEVICE TYPE +/ BITS 9-11 DIR BLOCK OF CURRENT TENTATIVE FILE +/ +/ INTERNAL DEFINITIONS: +F0=00 +F1=10 +CATBUF=2000 /IN FIELD 1 +CBUFS=1 /NUMBER OF BUFFERS FOR CATALOG +MODBUF=2400 /LIKEWISE +MBUFS=12 /BUFFERS FOR MODULE +ODEVH=7200 /OUTPUT DEVICE HANDLER (ROOM FOR 2-PAGE) +IDEVH=6600 /INPUT DEVICE HANDLER + / +/ PAGE 0 FOR LIBRA +/ + *1 +TMP1, 0 +TMP2, 0 /SOME TEMPS +TMP3, 0 +TMP4, 0 +TMP5, 0 +TMP6, 0 +TMP7, 0 +X0, 0 /AUTO-INDEX +X1, 0 +X2, 0 +X3, 0 +X4, 0 +X5, 0 +X6, 0 +X7, 0 +USR, 200 /CURRENT USR CALL ADDRESS + /LIBRA ASSUMES USR ALWAYS PRESENT +LIBDVH, ODEVH /ADDRESS OF LIBRARY DEVICE HANDLER +LIBU, 1 /UNIT CONTAINING LIBRARY; INITIALLY SYS: +CATLEN, 0 /LENGTH OF CATALOG +CATBLK, 0 /CURRENT CATALOG BLOCK IN CORE +LAVAIL, 0 /NEXT AVAILABLE LIBRARY BLOCK +LIBNAM, TEXT "FORLIBRL" + *.-1 +INFP, INF /CURRENT PLACE IN INPUT FILE LIST +MODU, 0 /UNIT CONTAINING CURRENT MODULE +MODDVH, IDEVH /INPUT DEVICE HANDLER ADDRESS +MODLEN, 0 /LENGTH OF THIS MODULE +MODBLK, 0 /FIRST BLOCK OF MODULE +INLSW, 0 /NON-ZERO IF IN LIBRARY INPUT +INFST, 0 /FIRST BLOCK OF INPUT FILE +INBLK, 0 /NEXT INPUT BLOCK NUMBER +THSBLK, 0 /READIN CONTROL +FULFLG, 0 /-1 IF CAT FULL + ENAM1, 0 +ENAM2, 0 /HOLDER FOR ESD NAMES +ENAM3, 0 + 0 /TEXT STOPPER FOR ENAME +ESDCTR, 0 +PCAT, CATBUF /POINTER TO CURRENT CATALOG BLOCK +INCLUD, -1 /SW FOR NAME INCLUDED IN CATALOG +CHANGD, 1 /0 IF CAT BLOCK MODIFIED +PMOD, MODBUF /POINTER TO CURRENT MODULE BLOCK +/ +TTFLAG, 0 /NON-ZERO WHEN TTY HAS INITIALIZED +PCHR, TTO /OUTPUT ROUTINE +TTPOS, 0 /TTY POSITION COUNTER +CATCNT, 0 +IOERR, 0 + 7421 /ERROR CODE TO MQ + JMP I .+1 + IOMES /LOG THE ERROR + / LIBRA MAIN CONTROL +/ + *177 /MAKES IT EASY TO CALL START +START, CDF F0 + JMS TTWAIT /ALLOW TTY TO COMPLETE + CIF F1 + JMS I USR + DECODE +TXTRL, 2214 /RL DEFAULT EXT + TAD (INF /RESET INPUT FILE POINTER + DCA INFP + TAD (TTO /AND IO DEVICE + DCA PCHR + DCA FULFLG + CDF F1 + TAD I (OUTF1 + SNA /NEW LIBRARY SPECIFIED? + JMP LASTLB /NO, USE LAST ONE + DCA LIBU /GET LIBRARY UNIT + TAD (OUTF1 + DCA X0 + TAD I X0 + DCA LIBNAM /MOVE + TAD I X0 /IN + DCA LIBNAM+1 /NEW + TAD I X0 /NAME + DCA LIBNAM+2 + TAD I X0 + SNA + TAD TXTRL /IF NO EXT, FORCE .RL + DCA LIBNAM+3 +LASTLB, TAD LIBU /REGET UNIT + AND (17 + TAD (DCTLW-1 /ADDRESS DEV CTL TABLE + DCA TMP1 + TAD I TMP1 + CDF F0 + SMA CLA /IS DEVICE FILE-STRUCTURED? + JMP NOTFS /NO, BOMB + TAD (ODEVH!1 + DCA OHADDR /ALLOW 2-PAGE HANDLER + TAD LIBU + AND (17 + CIF F1 + JMS I USR /GET THE HANDLER + FETCH +OHADDR, ODEVH!1 + JMS IOERR /YOU'RE KIDDING + TAD OHADDR /NOW THE REAL ADDRESS + DCA LIBDVH + JMP ZTEST + NOTFS, JMS TTOTXT + FLSTR-1 + JMS CRLF + JMP START +/ +IOMES, CLA + TAD (TTO + DCA PCHR /ENSURE IT COMES OUT ON TTY + JMS TTOTXT + IOMSG-1 + JMS CRLF + JMP START + PAGE + ZTEST, CDF F1 /FIND OR CREATE LIB. + TAD I (SWYTO9 /GET SWITCH WORD + AND (2000 /TEST FOR /Z + CDF F0 + SZA CLA + JMP NEWLIB /YES, ENTER NEW ONE +OLDLIB, JMS FNDLIB /LOOKUP THE LIBRARY + LOOKUP + JMP NEWLIB /COULDN'T FIND IT +/ + TAD LIBBLK /FIRST BLOCK OF LIBRARY + DCA ZCATB + TAD (CBUFS+MBUFS^200!F1 + DCA ZCATC /READ ALL YOU CAN + JMS ZCAT /DO THE READ + CDF F1 + TAD I (CATBUF /LOOK AT CONTROL WORD + CLL RAR + SZA CLA /IS IT A LIBRARY? + JMP NOTLIB /NO, ERROR + TAD I (CATBUF+3 + CDF F0 + DCA CATLEN /LENGTH IN BLOCKS + TAD LIBBLK + DCA LAVAIL /WILL BE UPDATED DURING SCAN + TAD LAVAIL + DCA CATBLK /CURRENT BLOCK IN BUFFER + TAD CATLEN + CIA + DCA TMP2 /COUNTER +CSLOOP, TAD (CBUFS+MBUFS + TAD TMP2 + SMA /WILL THE REST FIT IN BUFFER? + JMP CSLAST /YES + DCA TMP2 + TAD (-CBUFS-MBUFS^100 + DCA TMP1 /ENTRIES NOW IN CORE + JMS SCAT /SCAN CATALOG + TAD ZCATB /NEXT BLOCK WE'LL READ + DCA CATBLK + JMS ZCAT /READ SOME + JMP CSLOOP + CSLAST, CIA /NO OF BLOCKS WE DON'T NEED + TAD (CBUFS+MBUFS + JMS R6L /NO OF ENTRIES WE CAN LOOK AT + CIA + DCA TMP1 + JMS SCAT /LOOK FOR END +FULCAT, JMS TTOTXT /RAN OFF THE END + CATFUL-1 + JMS CRLF /** + JMP LCLOSE +/ +SCAT, 0 + TAD (CATBUF-1 + DCA X0 +SCLOOP, CDF F1 + TAD I X0 + CMA /TEST FOR END + SNA CLA + JMP GETINF /THAT'S IT + ISZ X0 + ISZ X0 /IGNORE REST OF NAME + TAD I X0 /GET LENGTH + TAD LAVAIL /ADD TO ST BLOCK OF FREE AREA + DCA LAVAIL + ISZ TMP1 + JMP SCLOOP + CDF F0 + JMP I SCAT /GO FOR NEXT BUFFER LOAD +/ +NOTLIB, JMS PRLBNM /PRINT LIBRARY NAME + JMS TTOTXT + UNLIB-1 + JMS CRLF + JMP START + PAGE + NEWLIB, JMS FNDLIB + ENTER + JMS IOERR + TAD LIBU + AND (7760 + CLL RTR + RTR + SNA /DID HE GIVE A LENGTH? + STL RTL /NO, USE 2 + DCA CATLEN + CDF F1 + TAD I (EQLO /HOW MANY EXTRA BLOCKS WANTED + CDF F0 + TAD CATLEN /PLUS CATALOG REQUIREMENT + CLL + TAD LIBLEN /MINUS AVAILABLE LENGTH + SZL CLA /CHECK FOR ENUF ROOM + JMP LSZERR /NO ROOM, GIVE MESSAGE +/ +/ WRITE EMPTY CATALOG +/ + TAD (CATBUF-1 + DCA X0 + TAD (-MBUFS-CBUFS^400 + DCA TMP1 + CDF F1 + DCA I X0 + ISZ TMP1 + JMP .-2 + TAD (CATBUF-1 /RESET FOR LATER USE + DCA X0 + CLA CMA + TAD CATLEN + SPA SNA /MORE THAN ONE? + JMP CATB0 /JUST ONE + CIA + ISZ ZCATB /START WITH SECOND CAT BLOCK +ZCLOOP, CLL + TAD (MBUFS+CBUFS + DCA TMP1 + SZL /FULL WRITE? + TAD TMP1 /NO + CIA + TAD (MBUFS+CBUFS + JMS R6R + TAD (4000!F1 + DCA ZCATC /SET CONTROL + JMS ZCAT + TAD TMP1 + SPA + JMP ZCLOOP /MORE TO GO +CATB0, CDF F1 + CLA IAC /1 IS LIBRARY CODE + DCA I X0 + TAD (VERS + DCA I X0 /MARK LIBRA VERSION # + TAD LIBLEN /JUST A GUESS + CIA + DCA I X0 + TAD CATLEN + DCA I X0 + CLA CMA /END OF CAT INDICATOR + DCA I X0 /MARKS FIRST AVAIL SLOT + CDF F0 + DCA CHANGD /FORCE A WRITE ON THIS ONE + TAD ZCATB + DCA LAVAIL + TAD LIBBLK /LIBRARY START BLOCK + DCA CATBLK /IS CURRENTLY IN BUFFER + JMP GETINF /BEGIN +/ +ZCAT, 0 + CDF F0 + JMS CCHK /LOOKOUT FOR CONTROL C + JMS I LIBDVH +ZCATC, F1 + CATBUF +ZCATB, 0 + JMS IOERR + TAD ZCATC + JMS R6L + AND (17 + TAD ZCATB + DCA ZCATB + ISZ CHANGD /SET UNMODIFIED SW + JMP I ZCAT + JMP .-2 +/ +FNDLIB, 0 + TAD I FNDLIB + DCA USRCOD + ISZ FNDLIB + TAD (LIBNAM + DCA LIBBLK + TAD LIBU + AND (17 + CIF F1 + JMS I USR +USRCOD, 0 +LIBBLK, LIBNAM +LIBLEN, 0 /NEG, REMEMBER + JMP I FNDLIB /COULD'T DO IT + TAD LIBBLK /FIRST BLOCK + DCA ZCATB /OF CATALOG + ISZ FNDLIB + JMP I FNDLIB +LSZERR, JMS TTOTXT + SMALL-1 + JMS CRLF + JMP START /GO FOR MORE + PAGE + / +/ SETUP POINTERS AND THINGS FOR NEXT INPUT MODULE +/ +GETINF, CLA CMA + DCA INCLUD /SET NO-NAME-INCLUDED SW + TAD INLSW /ARE WE GETTING INPUT FROM A LIBR? + SZA CLA + JMP INLIB /YES-GET NEXT MODULE THEREIN +NXTINF, CDF F1 + TAD I INFP /UNIT AND LEN OF NEXT IN FILE + SZA /IS THERE ONE? + JMP FTCHIN /YES + TAD I (SWATOL + AND (1000 /TEST FOR /C + CDF F0 + SNA CLA + JMP LCLOSE /NO MORE + JMS SAVRES /PRESERVE DEV HANDLER RESIDENCY + JMS TTWAIT /FINISH ANY TYPING + CIF F1 + JMS I USR /NEW LINE CONTINUES OLD + DECODE + 2214 /RL DEFAULT EXT + 0 /DO NOT DELETE TENTATIVE FILES + JMS RSTRES /RESTORE RESIDENCY TABLE + TAD (INF + DCA INFP /RESET INPUT FILE POINTER + JMP NXTINF /TRY AGAIN + FTCHIN, DCA MODU /UNIT CONTAINING INPUT MOD + ISZ INFP + TAD I INFP + DCA INFST /START OF INPUT FILE + ISZ INFP + TAD INFST + DCA MODBLK /IN THIS CASE, FILE=MODULE + TAD MODU + AND (7760 + CIA + CLL RTR + RTR + DCA MODLEN + TAD (IDEVH!1 + DCA INDVH /TENTATIVE HANDLER ADDR + CDF F0 + TAD MODU + AND (17 + CIF F1 + JMS I USR + FETCH +INDVH, IDEVH!1 /TENTATIVE INPUT HANDLER ADDR + JMS IOERR /DON'T GIVE ME THAT + TAD INDVH + DCA MODDVH /DEVICE HANDLER ADDRESS + DCA THSBLK /FORCE READIN TO READ +LUKMOD, TAD MODBLK /FIRST BLOCK OF MODULE + DCA INBLK /INITIALIZE READIN + JMS READIN /GET FIRST BLOCK + CDF F1 + CLA CMA /-1 + TAD I PMOD /LOOK AT IDENTIFIER + CDF F0 + SNA + JMP GOTLIB /ITS A LIBRARY + CLL RTR + SZA CLA /IS IT A MODULE + JMP BADINF /BAD INPUT + TAD LIBBLK /MAKE SURE + CIA + TAD LIBLEN /THAT MODULE + TAD LAVAIL /FITS IN LIBRARY + CLL + SNA /CHECK FOR TOO LONG HERE TOO** + JMP OVFLO /IT IS TOO LONG + TAD MODLEN + SNL CLA + JMP NXTEBK /GO GETTUM +OVFLO, JMS TTOTXT + TOOBIG-1 + JMS CRLF + JMP GETINF + BADINF, JMS TTOTXT + NOTMOD-1 + JMS CRLF + JMP GETINF +/ +GOTLIB, TAD MODLEN + SNA CLA + JMP LB2BIG /CAN'T DO A LOOKUP IF G. T. 255 + ISZ INLSW /SET IN-LIBRARY SWITCH + JMP INLIB +LB2BIG, JMS TTOTXT + L2BMSG-1 + JMS CRLF + JMP START + PAGE + / GET NEXT MODULE FROM LIBRARY +/ +INLIB, TAD INFST /START OF INPUT FILE + DCA INBLK /IS WHAT WE WANT + JMS READIN /BRING CATALOG INTO MODULE BUFFER + TAD (3 + TAD PMOD + DCA TMP1 + CDF F1 + TAD I TMP1 /GET CATALOG LEN + CIA + DCA TMP1 /HOLD COUNTER IN CASE OF FULL CATALOG + TAD INFST + DCA INBLK /WE WANT THE SAME ONE AGAIN + TAD INFST + DCA TMP3 /INIT ACCUMULATED MODULE START BLOCK + DCA MODLEN /INITAIL MOD LEN IS ZERO +INLSC1, JMS READIN /GET CATALOG BLOCK + TAD (-100 + DCA TMP2 /COUNT ENTRIES IN CAT BLOCK +INLSC2, CDF F1 + TAD I PMOD /LOOK FOR END-OF-CATALOG WORD + CMA + SNA CLA + JMP NDLSC /END OF SCAN + TAD (3 + TAD PMOD /POINT TO LENGTH + DCA TMP5 + TAD I TMP5 + SNA CLA /FIRST ENTRY FOR A MODULE? + JMP NOLEN /NO, DO NOT UPDATE + TAD MODLEN + TAD TMP3 /UPDATE MODULE STARTING BLOCK + DCA TMP3 + TAD I TMP5 /GET THIS LENGTH + DCA MODLEN /FOR THIS MODULE +NOLEN, TAD MODBLK /COMPARE LAST MODULE STARTING BLOCK + CMA CLL + TAD TMP3 /TO ACCUMULATED START BLOCK + SNL CLA /INTERESTING? + JMP NOTYET /NO + TAD I PMOD /YES; WAS NAME DELETED? + SZA CLA + JMP GLMOD /NO, WE'VE GOT A GOOD MODULE +NOTYET, TAD (4 + TAD PMOD /POINT TO NEXT NAME + DCA PMOD + ISZ TMP2 /END OF CAT BLOCK? + JMP INLSC2 /NO + ISZ TMP1 /YES; END OF CATALOG? + JMP INLSC1 /NO, GET NEW BLOCK +NDLSC, DCA INLSW /YES, NO LONGER IN A LIBRARY + JMP NXTINF /GET ANOTHER FILE + GLMOD, TAD TMP3 /GET STARTING BLOCK + DCA MODBLK /OF MODULE + JMP LUKMOD /AND GO GET THE MODULE +L2BMSG, TEXT "INPUT LIBRARY TOO BIG";0 + PAGE + / PROCESS LOOP FOR ONE MODULE +/ +NXTEBK, TAD (3 + TAD PMOD /ADDR OF FIRST ESD-1 + DCA X0 /RESET POINTER TO NAMES + TAD (-52 /PER BLOCK COUNT + DCA ESDCTR +ESDLUP, CDF F1 + TAD I X0 + DCA ENAM1 + TAD I X0 + DCA ENAM2 + TAD I X0 + DCA ENAM3 + TAD I X0 /TYPE CODE + CDF F0 + TAD (ESDTAB /DISPATCH FROM TBL + DCA TMP1 + JMP I TMP1 +ESDTAB, JMP ESDEND /0=END OF ESD TABLE + JMP DUPLUK /1=ENTRY=LOOK FOR + /DUPLICATE NAME + JMP ESDLND /2=EXTERN=IGNORE NAME + JMP ESDLND /3=FORT COMMON=IGNORE + JMP DUPLUK /4=PROG SECTION + HLT /5=MUL ENTRY=DOESN'T + /EXIST + HLT /6=MUL SECTION=DITTO + JMP DUPLUK /7=SECT8 + JMP ESDLND /10=COMMZ + JMP DUPLUK /11=FIELD1 + / +/ LOOK FOR DUPLICATION OF THIS ESD SYMBOL +/ +DUPLUK, TAD CATLEN + CIA + DCA TMP1 /COUNT LENGTH OF CAT + TAD CATBLK + CIA + TAD LIBBLK /ARE WE AT FIRST BLOCK? + SZA CLA + JMS CHGCHK /CHECK FOR BLOCK MODIFIED + TAD LIBBLK + DCA NXTCAT /SETUP FOR FIRST BLOCK OF CAT + TAD CATLEN + CIA + DCA CATCNT +GETCB, JMS GCATB /GET IT + TAD (CATBUF-1 + DCA X1 + TAD (-100 /COUNT ENTRIES/BLOCK + DCA TMP2 + CDF F1 +CBSRCH, TAD I X1 /LOOK AT NAME + CMA + SNA + JMP CHKI /END OF CATALOG-LOOK FOR /I + IAC /COMPLETE THE CIA + TAD ENAM1 /COMPARE + SZA CLA + JMP NOMTCH + TAD I X1 + CIA + TAD ENAM2 + SZA CLA + JMP NOMTCH + TAD I X1 /LAST CHANCE + CIA + TAD ENAM3 + SNA CLA + JMP GOTMAT /EQUAL! +NOMTCH, TAD X1 + AND (-4 + TAD (3 /BUMP TO NEXT + DCA X1 + ISZ TMP2 + JMP CBSRCH + JMS CHGCHK /CHECK FOR MODIFIED BLOCK + ISZ TMP1 /END OF CATALOG? + JMP GETCB /NO, GET NEXT + JMS TTOTXT + CATFUL-1 + JMS CRLF + CLA CMA + DCA FULFLG + JMP ESDEND /PUT THAT, IF POSSIBLE + GOTMAT, CDF F0 + JMS TTOTXT + ENAM1-1 /PRINT THE NAME + JMS TTOTXT + NDUP-1 /WHICH TO KEEP? + CDF F1 + TAD I (SWATOL + CDF F0 + AND (10 /TEST /I + SNA CLA + JMP CHKR /NO, LOOK FOR /R +GMASK, JMS TTOTXT + KEEP-1 + JMS WAITOP + JMP ESDLND /DEFAULT TO THE OLD ONE + TAD (-"O + SNA + JMP ESDLND /KEEP OLD + IAC /IS IT "N"? + SZA CLA + JMP GMASK /TRY AGAIN + JMP DELTO /DELETE THE OLD + PAGE + CHKR, JMS CRLF + CDF F1 + TAD I (SWMTOX + AND (100 /TEST /R + SNA CLA + JMP ESDLND /DEFAULT:KEEP THE OLD ONE +DELTO, CDF F1 + TAD X1 + AND (-4 + CIA + CMA /BACK UP POINTER + DCA X1 + DCA I X1 /CLEAR + DCA I X1 /OLD + DCA I X1 /NAME + ISZ X1 /SKIP OVER LENGTH + DCA CHANGD /BLOCK HAS BEEN MODIFIED + JMP NXTE /ENTER AT END OF LOOP +NDSCN, CDF F1 + TAD I X1 /LOOK AT NEXT + CMA + SNA CLA + JMP ENDCAT /NOW WE'RE THERE + TAD X1 + TAD (3 /BUMP TO NEXT NAME + DCA X1 +NXTE, ISZ TMP2 + JMP NDSCN + JMS CHGCHK /LOOK OUT FOR CHANGES + ISZ CATCNT /END OF CAT ? + SKP + JMP FULCAT /NO MORE PUSSY + JMS GCATB + TAD (CATBUF-1 + DCA X1 + TAD (-100 + DCA TMP2 + JMP NDSCN + CHKI, TAD I (SWATOL /LOOK AT /I SW + AND (10 + SNA CLA + JMP ENDCAT /NOT SET + JMS TTOTXT + ENAM1-1 /TYPE ESD NAME + JMS TTOTXT + NCLUD-1 /INCLUDE IT? +IANS, JMS WAITOP + JMP ENDCAT /DEFAULT TO INCLUDE + TAD (-"Y + SNA + JMP ENDCAT /YES, INCLUDE + TAD ("Y-"N + SZA CLA /IS IT "N"? + JMP IANS /NO, TRY AGAIN + JMP ESDLND +ENDCAT, TAD X1 /POINT TO EMPTY SLOT + AND (-4 + CIA + CMA + DCA X1 + JMP INSERT + PAGE + / THIS ESD GOES IN THE CATALOG +/ +INSERT, CDF F1 + TAD ENAM1 /MOVE + DCA I X1 /NAME + TAD ENAM2 /TO + DCA I X1 /LIBRARY + TAD ENAM3 /CATALOG + DCA I X1 + ISZ INCLUD /IS THIS THE FIRST? + SKP + TAD MODLEN /YES, GET THE LENGTH + DCA I X1 /AND STORE 4TH WORD + DCA CHANGD /SET CAT MODIFIED SW + CLA IAC + TAD X1 /CHECK FOR END OF BLOCK + AND (377 + SZA CLA + JMP MARKND /NO, MARK END OF CAT + JMS CHGCHK /WRITE THIS BLOCK + CDF F1 + TAD (-400 + DCA TMP1 /SET COUNT FOR BLOCK LEN + TAD (CATBUF-1 + DCA X1 /SET POINTER + CLA CMA + DCA I X1 + ISZ TMP1 + JMP .-2 /CLEAR THE BLOCK + DCA CHANGD + ISZ CATBLK + JMP ESDLND +MARKND, CLA CMA + DCA I X1 /MARK NEW END OF CAT +ESDLND, CDF F0 + CLA STL RTL /TWO TO SKIP VALUE + TAD X0 + DCA X0 + ISZ ESDCTR /DONE WITH BLOCK? + JMP ESDLUP /NO, GET NEXT + JMS READIN /GET NEXT BLOK + JMP NXTEBK /RESET POINTERS AND CONTINUE +ESDEND, ISZ INCLUD /CHECK FOR ANY NAMES OUT + JMP CPYMOD /YES, COPY MODULE INTO LIBRARY + JMS TTOTXT /SORRY, DIDN'T MAKE IT + NONEIN-1 + JMS CRLF + ISZ FULFLG + JMP GETINF /TRY NEXT + JMP LCLOSE + CPYMOD, TAD MODBLK /GET IN FILE STRT BLOCK + DCA INBLK + TAD MODLEN + CIA + DCA TMP1 + TAD LAVAIL /FIRST AVAILABLE BLOCK + DCA NXTOBK +CPYLUP, JMS READIN /READ BLOCK OF INPUT + TAD PMOD + DCA PNXTOB + JMS I LIBDVH /CALL OUTPUT HANDLER + 4200!F1 +PNXTOB, MODBUF +NXTOBK, 0 /NEXT OUTPUT BLOCK NUMBER + JMS IOERR + ISZ NXTOBK /BUMP BLOCK NUMBER + ISZ TMP1 /CHECK LENGH + JMP CPYLUP + TAD NXTOBK + DCA LAVAIL /UPDATE AVAILABLE POINTER + JMP GETINF /GO FOR NEXT + PAGE + CHGCHK, 0 + CDF F0 /PRECAUTION + TAD CHANGD /HAS BLOCK BEEN MODIFIED? + SZA CLA + JMP I CHGCHK /NO, NOTHING TO DO + TAD CATBLK + DCA ZCATB /WRITE THE BLOCK + TAD (4200!F1 + DCA ZCATC + JMS ZCAT + JMP I CHGCHK /OK +/ +/ +GCATB, 0 + CDF F0 + TAD NXTCAT + CIA + TAD CATBLK /IS IT IN CORE? + SNA CLA + JMP SOEZ /YES, ITS EZ + TAD NXTCAT + CIA + TAD LIBBLK + TAD CATLEN + SPA SNA CLA /CHECK FOR INTERNAL ERROR + JMP FULCAT /** + TAD NXTCAT + DCA ZCATB + TAD (200!F1 /SET FOR READ + DCA ZCATC + JMS ZCAT + TAD NXTCAT /NEXT BLOCK + DCA CATBLK /IS IN CORE +SOEZ, ISZ NXTCAT + JMP I GCATB +NXTCAT, 0 + PAGE + LCLOSE, JMS CHGCHK + TAD USRCOD + TAD (-ENTER /DID WE ENTER A NEW FILE? + SZA CLA + JMP CATLST /NO, GO LIST CATALOG + TAD LIBBLK /GET LEN + CIA + CDF F1 + TAD I (EQLO /GET USER EXTENSION REQUEST + CDF F0 + TAD LAVAIL /PLUS CURRENT END + DCA TMP1 + TAD TMP1 + CLL + TAD LIBLEN /CHECK FOR POSSIBLE + SNL CLA + JMP .+4 + TAD LIBLEN /CAN'T GIVE ALL HE WANTS + CIA + SKP + TAD TMP1 + DCA LCLEN /SET CLOSE LENGTH + TAD CATLEN + CMA + TAD LCLEN /COMPARE CAT LEN TO LIB LEN + SPA SNA CLA + JMP NOLIB /THERE'S NO POINT + TAD LIBBLK /GET FIRST BLOCK + DCA NXTCAT + JMS GCATB + CDF F1 + TAD LCLEN /ACTUAL LIBRARY LENGTH + DCA I (CATBUF+2 + CDF F0 + DCA CHANGD + JMS CHGCHK /WRITE IT + TAD LIBU + AND (17 + CIF F1 + JMS I USR + CLOSE + LIBNAM +LCLEN, 0 + JMS IOERR + JMP CATLST /GO LIST THE CATALOG +/ +NOLIB, JMS TTOTXT + WHYCLS-1 + JMS CRLF + JMP START + PAGE + / LIST THE CATALOG +/ +CATLST, JMS OOPEN /OPEN LISTING FILE + JMP START /NONE DESIRED + TAD (OCHAR /SETUP FOR DEVICE-INDEPENDENT + DCA PCHR /OUTPUT + TAD (214 /AT TOP OF PAGE + JMS I PCHR + JMS CRLF + JMS TTOTXT + LBV-1 + JMS TTOTXT + CATOF-1 + JMS PRLBNM /PRINT THE NAME + CDF F1 + TAD I (SYSDAT + CDF F0 + SNA + JMP NODATE /DON'T KNOW THE DATE + DCA TMP1 + JMS TTOTXT + ON-1 + CLA /THE FOLLOWING CODE GETS THE DAY + DCA TMP2 + TAD TMP1 /GET THE DATE + RTR /ROTATE THREE RIGHT AND MASK + RAR /TO GET THE DAY IN OCTAL + AND (37 + JMS MAK8BT /MAKE IT 8-BIT AND PRINT + DCA TMP2 + TAD TMP1 /GET THE DATE BACK + AND (7400 /MASK TO GET THE MONTH BITS + JMS R6R /MONTH*4 (IN OCTAL) + DCA TMP2 /PUT IN TEMP. VARIABLE TO SAVE IT + TAD TMP2 /GET IT BACK + RTR /MONTH + TAD TMP2 + TAD (MONTHS-6 + DCA .+2 /ADDRESS OF MONTH FROM TABLE + JMS TTOTXT /PUT IT IN THE TEXT LINE + 0 + TAD TMP1 /GET THE DATE---TO FIND THE YEAR + AND (7 /MASK TO GET THE YEAR OFFSET BITS + DCA TMP4 /SAVE THEM + DCA TMP2 + TAD I (7777 /GET THE DATE EXTENSION BITS + AND (600 + CLL RTR /ROTATE TO GET THEM INTO BIT + RTR /POSITIONS 7 AND 8 + TAD (106 /ADD 70(ORIGINAL BASE YEAR) + TAD TMP4 /ADD IN THE YEAR OFFSET BITS + JMS MAK8BT /MAKE 8-BIT AND PRINT +NODATE, JMS CRLF + JMP PRCAT /TITLE IS DONE, PRINT CAT +MAK8BT, 0 /ROUTINE TO CONVERT TO 8-BIT AND PRINT + CLL /FIRST CONVERT TO DECIMAL +CONVYR, TAD (-12 /KEEP SUBTRACTING 12 + SPA /HAVE THE YEAR + JMP GETDG1 + ISZ TMP2 /HOLDS THE FIRST DIGIT OF YEAR + JMP CONVYR +GETDG1, TAD (12 /GET THE SECOND DIGIT + DCA TMP3 /SAVE IT + TAD TMP2 /GET THE FIRST DIGIT + SNA /FIRST DIGIT IS A ZERO + JMP PRDIG2 /PRINT THE SECOND DIGIT + TAD (260 /MAKE FIRST DIGIT OF YEAR 8-BIT + JMS I PCHR /PRINT IT +PRDIG2, TAD TMP3 /GET THE SECOND DIGIT + TAD (260 /MAKE SECOND DIGIT OF YEAR 8-BIT + JMS I PCHR /PRINT IT + JMP I MAK8BT /RETURN + PAGE + / LIST ALL ENTRIES IN THE CATALOG +/ +PRCAT, TAD CATLEN + CIA + DCA TMP1 + TAD LIBBLK + DCA NXTCAT + CLA CMA + DCA TMP3 /SET LINE COUNTER +CATLUP, JMS GCATB + TAD (CATBUF-1 + DCA X0 + TAD (-100 + DCA TMP2 +CATLP2, CDF F1 + TAD I X0 /GET FIRST WORD OF NAME + SNA + JMP EMPTY /NOT AN ESD NAME + CMA + SNA + JMP NDCATL /END OF CATALOG + CMA /RESTORE FIRST WORD + JMS TTO2 /PRINT + JMP NDNAM /A SHORT NAME + CDF F1 + TAD I X0 + JMS TTO2 + JMP NDNAM + CDF F1 + TAD I X0 + JMS TTO2 + NOP +NDNAM, ISZ TMP3 /MORE ROOM ON THIS LINE? + JMP SAMLIN /SURE + JMS CRLF + TAD (-10 /SETUP FOR 8 PER LINE + DCA TMP3 + JMP EMPTY +SAMLIN, JMS TAB /SPACE OVER TO NEXT NAME +EMPTY, TAD X0 + AND (-4 + TAD (3 + DCA X0 /POINT TO NEXT + ISZ TMP2 + JMP CATLP2 /GO FOR NEXT + ISZ TMP1 /MORE BLOCKS? + JMP CATLUP /YES + JMS CRLF + JMS TTOTXT + CATFUL-1 +NDCATL, JMS CRLF + TAD (214 /EJECT PAGE + JMS I PCHR + JMS OCLOSE /CLOSE THE FILE + JMP START + PAGE + / USEFUL OUTPUT THINGS +/ +TTO, 0 + DCA TTOCHR + JMS TTWAIT + TAD (200 + KRS + TAD (-217 /CRTL/O CHECK + SNA CLA + KSF + SKP + JMP I TTO + TAD TTOCHR + TLS + DCA TTFLAG + JMP I TTO +TTOCHR, 0 +TTWAIT, 0 + TAD TTFLAG + SNA CLA + JMP I TTWAIT + JMS CCHK /BEWARE OF CTRL/C + TSF + JMP .-2 /WAIT TILL DONE + DCA TTFLAG /CLEAR BUSY FLAG + JMP I TTWAIT +CCHK, 0 + KSF + JMP I CCHK /NOTHING TO WORRY ABOUT + TAD (200 + KRS + TAD (-203 + SNA CLA /WAS IT CONTROL C? + JMP I (7600 /YES + JMP I CCHK +TTO2, 0 + DCA TMP7 + TAD TMP7 + JMS R6R + JMS TTO2A + TAD TMP7 + JMS TTO2A + ISZ TTO2 + JMP I TTO2 +TTO2A, 0 + AND (77 + SNA + JMP I TTO2 + TAD (-40 + SPA + TAD (100 + TAD (240 + JMS I PCHR + ISZ TTPOS /BUMP POSITION COUNT + JMP I TTO2A + R6R, 0 + CLL RTR + RTR + RTR + JMP I R6R +R6L, 0 + CLL RTL + RTL + RTL + JMP I R6L +TTOTXT, 0 + CDF F0 + TAD I TTOTXT + DCA X7 + ISZ TTOTXT /BUMP PAST POINTER + TAD I X7 + JMS TTO2 + JMP I TTOTXT + JMP .-3 +CRLF, 0 + DCA TTPOS /RESET POSITION + TAD (215 + JMS I PCHR + TAD (212 + JMS I PCHR + JMP I CRLF +TAB, 0 /PSEUDO-TAB GENERATOR + TAD (240 + JMS I PCHR + ISZ TTPOS + TAD TTPOS + AND (7 + SNA CLA /IS POSITION A MULTIPLE OF 8 + JMP I TAB + JMP TAB+1 /NO, TRY MORE + PAGE + WAITOP, 0 + TAD (277 /QUESTION + JMS TTO + DCA RETCHR +WREP, JMS TTI /WAIT FOR REPLY + TAD (-215 + SNA + JMP DFALT + TAD (215-240 /PRINTING? + SPA + JMP WREP /NO, TRY AGIAN + TAD (240 + DCA RETCHR + TAD RETCHR +ECHO, JMS TTO + JMS TTI + TAD (-215 + SNA + JMP GOTREP + TAD (215-377 /LOOKOUT FOR RUBOUT! + SNA + JMP RUBOUT + TAD (377 + JMP ECHO +RUBOUT, JMS CRLF + JMP WAITOP+1 +GOTREP, ISZ WAITOP /GOT A REAL ANSWER +DFALT, JMS CRLF + TAD RETCHR + JMP I WAITOP +RETCHR, 0 +/ +TTI, 0 + KSF /WAIT FOR A KEY + JMP .-1 + KRB + AND (177 /TAKE CARE OF PARITY + TAD (-3 /CTRL C? + SNA + JMP I (7600 /YES + TAD (203 /GET ORGINIAL CHAR BACK + JMP I TTI +PAGE + / +/ INPUT BUFFERRER AND STUFF +/ +READIN, 0 + CDF F0 + TAD INBLK + TAD THSBLK /-FIRST BLOCK FOLLOWING BUFFER CONTENTS + CLL + TAD (MBUFS + SNL /IS IT IN CORE? + JMP MUSTRD /NO, WE HAVE TO DO A READ + CLL RTR + RTR + RAR /TIMES 400 +SETP, TAD (MODBUF /PLUSS BUFFER ADDR + DCA PMOD /POINTS TO BLOCK + ISZ INBLK /READY FOR NEXT + JMP I READIN +MUSTRD, CLA /THIS ONE'S HARDER + TAD INBLK + DCA RDBLK + TAD INBLK + TAD (MBUFS + CIA + DCA THSBLK + JMS I MODDVH + MBUFS^200!F1 + MODBUF +RDBLK, 0 + JMS IOERR + JMP SETP /OK + / ROUTINES TO SAVE AND RESTORE +/ DEVICE HANDLER RESIDENCY TABLE +/ +SAVRES, 0 + TAD (DHRES-1 + DCA X0 + TAD (SVRES-1 + DCA X1 + JMS MOVRES + JMP I SAVRES +RSTRES, 0 + TAD (SVRES-1 + DCA X0 + TAD (DHRES-1 + DCA X1 + JMS MOVRES + JMP I RSTRES +MOVRES, 0 + TAD (-17 + DCA TMP1 + CDF F1 + TAD I X0 + DCA I X1 + ISZ TMP1 + JMP .-3 + CDF F0 + JMP I MOVRES +SVRES=7400 + / PRINT THE LIBRARY NAME +/ +PRLBNM, 0 + TAD LIBNAM + JMS TTO2 /FIRST 2 CHARS + JMP PREXT + TAD LIBNAM+1 + JMS TTO2 + JMP PREXT + TAD LIBNAM+2 + JMS TTO2 + NOP +PREXT, TAD (". + JMS I PCHR + TAD LIBNAM+3 + JMS TTO2 + JMP I PRLBNM + JMP I PRLBNM + PAGE + / OUTPUT HANDLERS STOLEN FROM PIP +OUFLD=F1 +OUCTL=MBUFS^200!4000!F1 +OUBUF=MODBUF +/ +/ INITIALIZE FOR OUTPUT +/ +OUSETP, 0 + TAD (OUCTL&3700 /BUFFER SIZE IN DBL WORDS + CIA /NEGATE IT (PAL10 BLOWS) + DCA OUDWCT + TAD (OUBUF + DCA OUPTR /INITIALIZE WORD POINTER + TAD OUJMPE + DCA OUJMP /INITIALIZE 3-WAY CHARACTER SWITCH + JMP I OUSETP +/ +/ STORE CHARACTERS IN OUTPUT BUFFER +/ IN PS8 FORMAT (YOU KNOW, 3 CHARS +/ IN 2 WORDS THE WRONG WAY) +/ +OCHAR, 0 + AND (377 + DCA OUTEMP + CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD + ISZ OUJMP /BUMP THE CHARACTER SWITCH +OUJMP, HLT /THREE WAY CHARACTER SWITCH + JMP OCHAR1 + JMP OCHAR2 + TAD OUTEMP + CLL RTL + RTL + AND (7400 + TAD I OUPOLD + DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH + /ORDER 4 BITS OF THIRD CHAR + TAD OUTEMP + CLL RTR + RTR + RAR + AND (7400 + TAD I OUPTR + DCA I OUPTR /UPDATE 2ND WORD FROM LO 4 BITS + TAD OUJMPE + DCA OUJMP /RESET SWITCH + ISZ OUPTR + ISZ OUDWCT /BUMP COUNTER EVERY 3 CHARS + JMP OUCOMN + TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE + JMS I (OUTDMP /DUMP THE BUFFER + JMS OUSETP /RE-INITIALIZE THE POINTERS + JMP OUCOMN +OCHAR2, TAD OUPTR + DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO + ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD +OCHAR1, TAD OUTEMP + DCA I OUPTR +OUCOMN, CDF F0 + JMP I OCHAR +OUTEMP, 0 +OUPOLD, 0 +OUPTR, 0 +OUJMPE, JMP OUJMP +OUDWCT, 0 +/ +/ MOVE OUTPUT FILE NAME TO FIELD 0 +/ +OFNAME, 0 + TAD (OUTF2 + DCA X0 /NAME OF CAT LIST FILE + CDF F1 + TAD I X0 + DCA OUFNAM /FIRST 2 CHARS + TAD I X0 + DCA OUFNAM+1 + TAD I X0 + DCA OUFNAM+2 + TAD I X0 + SNA + TAD TXTCA /DEFAULT CAT EXT + DCA OUFNAM+3 + CDF F0 /RESTORE FIELD + JMP I OFNAME +OUFNAM, ZBLOCK 4 +TXTCA, 301 + PAGE + OOPEN, 0 + CDF F1 + TAD I (OUTF2 /GET DEVICE CODE, LEN + DCA OUELEN /HOLD IT A MO + JMS I (OFNAME /GET FILE NAME INTO FIELD 0 + TAD OUELEN /CHECK FOR NULL FILE + SNA CLA + JMP I OOPEN /NOTHING TO OPEN + TAD OUNAME /RESET ENTER CALL + DCA OUBLK + TAD (IDEVH!1 + DCA OUHNDL + TAD OUELEN /THE UNIT + CIF F1 + JMS I USR + FETCH /ASSIGN, FETCH HANDLER +OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY + JMS IOERR /HUH? + TAD OUELEN /UNIT AGAIN + CIF F1 + JMS I USR + ENTER /ENTER OUTPUT FILE +OUBLK, OUFNAM /REPLACED WITH STARTING BLOCK +OUELEN, 0 /REPLACED WITH LENGTH OF HOLE + JMS IOERR /YOU BLEW IT!!! + DCA OUCCNT + JMS I (OUSETP + ISZ OOPEN + JMP I OOPEN + OUTDMP, 0 + DCA OUCTLW /STORE THE CONTROL WORD + TAD OUCCNT + SNA + ISZ OUCTLW + TAD OUBLK + DCA OUREC /COMPUTE STARTING BLOCK + TAD OUCTLW + JMS R6L + AND (17 /COMPUTE THE NUMBER OF RECORDS + TAD OUCCNT /UPDATE SIZE OF FILE + DCA OUCCNT + TAD OUCCNT + CLL CML + TAD OUELEN + SNL SZA CLA /EXCEED GIVEN LENGTH ? + JMS IOERR /YES - ERROR + CDF F0 + JMS I OUHNDL +OUCTLW, 0 + OUBUF +OUREC, 0 + JMS IOERR + JMP I OUTDMP + OCLOSE, 0 + TAD (232 /OUTPUT A CTRL/Z + JMS I PCHR +FILLLP, JMS I PCHR + TAD (77 + AND I (OUDWCT + SZA CLA /UP TO THE BOUNDARY YET? + JMP FILLLP /NO - FILL WITH ZEROS + TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT + TAD (OUCTL&3700 + SNA /A FULL WRITE LEFT? + JMP NODUMP /YES DON'T DO IT + TAD (4000!OUFLD /PUT IN FIELD AND WRITE BITS + JMS OUTDMP +NODUMP, CIF CDF F1 + TAD I (OUTF2 + CDF F0 + JMS I USR + CLOSE /CLOSE THE OUTPUT FILE +OUNAME, OUFNAM /POINTER TO OUTPUT FILE NAME +OUCCNT, 0 + JMS IOERR /ERROR WHILE CLOSING - BAD!! + JMP I OCLOSE /ALL DONE + PAGE + / MESSAGES +/ +LBV, TEXT "LIBRA V " +*.-1 +VMESG, VERS&70^7+VERS+6060 + PATCH&77^100+40 + 4000 +NONEIN, TEXT "MODULE NOT INCLUDED";0 +FLSTR, TEXT "LIBRARY MUST BE ON A FILE-STRUCTURED DEVICE";0 +SMALL, TEXT "INSUFFICIENT SPACE FOR LIBRARY";0 +NOTMOD, TEXT "INPUT NOT A MODULE";0 +TOOBIG, TEXT "INPUT TOO BIG FOR LIBRARY";0 +UNLIB, TEXT " IS NOT A LIBRARY";0 +NDUP, TEXT " IS DUPLICATE NAME";0 +KEEP, TEXT "; KEEP OLD OR NEW";0 +CATFUL, TEXT "CATALOG IS FULL";0 +NCLUD, TEXT ": INCLUDE";0 +WHYCLS, TEXT "LIBRARY TOO SMALL FOR USE; START OVER";0 +IOMSG, TEXT "I/O ERROR";0 +CATOF, TEXT "CATALOG OF ";0 +ON, TEXT " ON ";0 +CS197, TEXT ", 197";0 +MONTHS, TEXT "-JAN-@@@@@-FEB-@@@@@-MAR-@@@@" + TEXT "-APR-@@@@@-MAY-@@@@@-JUN-@@@@" + TEXT "-JUL-@@@@@-AUG-@@@@@-SEP-@@@@" + TEXT "-OCT-@@@@@-NOV-@@@@@-DEC-@@@@" + $ +