Directory of image this file is from
This file as a plain text file
/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-@@@@" $