File: LIBRA.PA of Tape: Original/Originals/AL-4546D-SA
(Source file text)
/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-@@@@"
$