/  8BAL LIBRARY GENERATOR

/  PROGRAM TO GENERATE 8BAL MACRO LIBRARIES
/  ON DSK:8BALIB.ML OR ANY SPECIFIED FILE

/  WRITTEN BY DAVID M. KRISTOL, JAN., 1972



ZZZ=0	/FOR FILL-INS

	FIELD 1

XR10=10
XR11=11
XR12=12
XR13=13
XR14=14

SCANP2=20
SCANP3=21
CDP=22
OUHP=23
LINCNT=24
LINBUF=25
GATHBF=26
SEPCOD=31
MPCHR="@
	*2000	/OUT OF WAY OF USR
	USR=200

XSTART,	CDF 0
STARP1=.
	TAD (7003	/NO LOAD OR USE USR AREAS,
			/ NO RESTART
STARC1=.
	DCA I (7746	/JSW
STRTT1=.
	CDF 10
	JMS I (7700	/PROGRAM START
	 10		/USRIN
	TAD ("1		/CD CALL 1
	JMS TYO
	JMS I (USR
	 5		/CALL CD
STREXT,	 1514		/.ML -- GET OLD MACRO LIBRARY
	TAD I (7617
	SNA		/OLD LIBRARY?
	JMP STAR1A	/NO.  CLEAR OUT DIRECTORY
	JMS I (USR	/YES.  FETCH HANDLER
	 1
STAR1,	 INHB+1		/TWO PAGE
	 JMP ERR2
	TAD I (7620
	DCA I STAR6	/SAVE START BLOCK
	JMP STAR2	/AND CONTINUE

STAR1A,	TAD (-400
	DCA STARC1
	TAD STAR6
	DCA STARP1
	DCA I STARP1	/CLEAR DIRECTORY
	ISZ STARP1
	ISZ STARC1
	JMP .-3
STAR2,	TAD ("2		/SECOND CD CALL
	JMS TYO
	JMS I (USR
	 5		/CALL CD
	 7002		/.8B
	TAD (7617
	DCA CDP		/POINTER TO CD INPUT
	TAD I (7600	/OUTPUT GIVEN?
	SNA
	JMP STAR10	/NO.  ENTER DSK:8BALIB.ML
	JMS I (USR	/YES.  FETCH HANDLER
	 1
STAR3,	 OUHB+1		/TWO PAGE
	 JMP ERR2
	TAD STAR3
	DCA OUHP	/SAVE OUTPUT HANDLER ENTRY
	TAD (7600
	DCA XR10
	TAD I XR10
	DCA XFNME	/MOVE CHOSEN NAME
	TAD I XR10
	DCA XFNME+1
	TAD I XR10
	DCA XFNME+2
	TAD I XR10
	SNA
	TAD STREXT	/.ML
	DCA XFNME+3
	TAD I (7600
	DCA XDEV	/SAVE DEVICE NUMBER
STAR4,	TAD XDEV
	JMS I (USR	/ENTER OUTPUT FILE
	 3
STAR5,	 XFNME
	 0
	 JMP ERR2
	TAD STAR5	/START BLOCK FOR OUTPUT
	IAC
	DCA WRITBL	/SAVE FOR WRITING
	TAD I STAR6	/START BLOCK OF OLD LIBRARY
	SNA		/WAS THERE ONE?
	JMP STAR11	/NO
	DCA STAR7	/YES.  SAVE BLOCK
	CIF 0
	JMS I STAR1	/CALL HANDLER
	 211		/2 PAGE, FIELD 1, FORWARD
STAR6,	 DIREC
STAR7,	 ZZZ
	 JMP ERR1
	TAD STAR7
	IAC
	DCA STAR9	/FOR READING
STAR8,	TAD (-4		/SET QUARTER
	DCA STRTT1
	CIF 0
	JMS I STAR1	/READ
	 200		/2 PAGE, FIELD 0
	 OUBUF
STAR9,	 ZZZ
	JMP ERR1
	ISZ STAR9	/NEXT BLOCK
	CLL
	TAD STRTT1	/- NEXT QUARTER TO BE READ
	TAD I STAR6	/QUARTER DESIRED IN CORE
	SNL CLA		/DESIRED QUARTER IN CORE?
	JMP STAR11	/YES
	JMS WRITBF
	TAD STRTT1
	JMP STAR8	/UPDATE QUARTER, READ NEXT BLOCK

STAR10,	JMS I (USR	/FETCH DSK:
	 1
	 DEVICE DSK
XDEV=.-1
	 OUHB+1		/TWO PAGE
	 JMP ERR2
	TAD .-2		/ADDRESS
	DCA OUHP
	JMP STAR4	/WILL AUTOMATICALLY CHECK 8BALIB.ML


/PB
/PB

	PAGE

XFNME,	FILENAME 8BALIB.ML

STAR11,	TAD I CDP	/FIRST INPUT
	ISZ CDP
	SNA		/BLANK LINE FOR INPUT?
	JMP ENDFIL	/YES.  CHECK OPTIONS
	JMS I (USR	/GET HANDLER
	 1
STAR12,	 INHB+1		/TWO PAGE
	 JMP ERR2
	TAD STAR12
	DCA INHNDP	/SAVE ADDRESS
	TAD I CDP
	ISZ CDP
	DCA INBLK	/STARTING BLOCK
	JMS CRLF
	JMS CRLF
	JMS CRLF
	TAD I (7666	/SYSTEM DATE
	JMS PRDATE
	JMS PRMES
	 HEAD		/HEADER
	JMP LOOP


WRITBF,	.-.		/WRITE OUTPUT BUFFER
	CIF 0
	JMS I OUHP
	 4200
	 OUBUF
WRITBL,	 ZZZ
	 JMP ERR1
	ISZ WRITBL
	JMP I WRITBF

/PB
/PB

	PAGE

LOOP,	TAD (-3^MCARG-3	/MAIN DEF LOCATE LOOP
	DCA LOOPC1
	TAD (MCALST-1
	DCA XR10
	DCA I XR10	/ZERO OUT ARGUMENT AREA
	ISZ LOOPC1
	JMP .-2
	TAD (MCALST+3-1	/POINT AT LABEL ENTRY
	DCA XR10
	TAD (PAT
	DCA LOOPP1
	JMS GETLIN
	JMS GATHER
	 NOP
	JMS TBLSUB	/SAVE LABEL (OR ZEROES, IF NONE)
LOOP1,	TAD I LOOPP1
	SMA		/INDIVIDUAL CHAR MATCH?
	JMP LOOP3	/NO
LOOP1A,	TAD I SCANP2	/YES
	SZA CLA		/MATCH?
	JMP LOOP	/NO
LOOP2,	ISZ SCANP2	/YES.  NEXT CHAR
LOOP2A,	ISZ LOOPP1	/AND NEXT PAT. CHAR
	JMP LOOP1

LOOP3,	SNA		/END OF PATTERN?
	JMP LOOP4	/YES.
	TAD .+3		/NO
	DCA .+1
LOOPC1,	 ZZZ
	JMP I .
	XLOOP1;XLOOP2;LOOP2;XLOOP4

XLOOP1,	CMA
	TAD SCANP2
	DCA SCANP2	/SO GATHER WILL WORK
	JMS GATHER	/GET FIELD (MACRO NAME)
	 JMP LOOP
	TAD GATHBF
	CIA
	DCA MCALST
	TAD GATHBF+1
	CIA
	DCA MCALST+1
	TAD GATHBF+2
	CIA
	DCA MCALST+2
	JMP LOOP2A	/CONTINUE

XLOOP2,	TAD (-MPCHR
	JMP LOOP1A	/CHECK SINGLE CHAR


XLOOP4,	JMS XLUPS1
	SKP
	JMP LOOP
	ISZ SCANP2
	JMS XLUPS1
	 JMP .-2
	JMP LOOP2A

LOOP4,	DCA LOOPT1	/NUMBER OF ARGUMENTS
	CMA CLL RTL	/-3
	TAD SEPCOD	/FOLLOWING MACRO NAME
	SZA		/:?
	JMP LOOP6	/NO
LOOP5,	JMS GATHER	/YES.  GET ARG.
	 JMP ERR3
	JMS TBLSUB	/PUT IN TABLE
	ISZ LOOPT1	/MARK ONE MORE ARG
	CMA		/-1
	TAD SEPCOD	/,?
	SPA SNA CLA	/ANYTHING BUT SP, CR?
	JMP LOOP6A	/NO
	TAD LOOPT1
	TAD (-MCARG+1
	SPA CLA		/TOO MANY?
	JMP LOOP5	/NO
	JMP ERR3

LOOP6,	IAC
	SMA CLA		/SP OR CR?
	JMP ERR3
LOOP6A,	TAD DIREC	/YES.  CR OR SP
	AND (3		/GET QUARTER ON BLOCK
	CLL RTL
	RTL
	RTL
	DCA LOOPT2	/OFFSET IN BLOCK
	TAD LOOPT2
	CLL RAR
	TAD LOOPT2	/140 CHAR PER QUARTER
	TAD (-600
	DCA WRTCC1	/CHAR COUNT
	TAD LOOPT2
	TAD (OUBUF
	DCA WRTCP1	/POINTER
	DCA WRTCP1+1
	TAD (-141	/INITIAL QUARTER COUNT
	DCA WRTCC2
	TAD DIREC
	DCA LOOPT2	/STARTING QUARTER
	JMP WRITE	/WRITE DEFINITION

LOOPT1, 0
LOOPT2, 0
LOOPP1, 0

/PB
/PB

	PAGE

WRITE,	JMS GETLIN	/NEXT LINE
	CMA
WRIT1,	DCA WRITI1	/INDICATOR
	JMS GATHER
	 JMP WRIT4	/NO FIELD
	TAD WRITI1
	SZA CLA
	CLA CMA CLL RTL	/-3:  ONE MORE SLOT
	TAD (MCALST-1+3
	DCA XR11
	TAD (-MCARG	/1 FOR LABEL
	TAD WRITI1	/0 OR -1
	DCA WRITC1
	DCA WRITC2	/ARG. NUMBER
WRIT2,	TAD I XR11
	SNA		/NULL ENTRY?
	JMP WRIT8	/YES
	TAD GATHBF	/NO.  COMPARE WITH FIELD
	SZA CLA
	JMP WRIT8
	TAD GATHBF+1
	TAD I XR11
	SZA CLA
	JMP WRIT9
	TAD I XR11
	TAD GATHBF+2
	SZA CLA
	JMP WRIT10
	TAD WRITC2	/FOUND.  GET ARG #
	ISZ WRITI1
	JMP WRIT3	/NOT FIRST FIELD
	SNA		/FIRST FIELD.  FIRST ARG?
	JMP WRIT5	/YES.  END OF MACRO
	SKP
WRIT3,	IAC
	JMS WRTCHR	/WRITE ARG. #
WRIT4,	TAD I SCANP2	/AND SEP
	JMS WRTCHR
	CMA
	TAD SEPCOD
	SZA CLA		/CR OR SP?
	JMP WRIT1	/NO
	JMP WRITE	/YES

WRIT5,	TAD I SCANP2	/GET SEP
	TAD (-MPCHR
	SZA CLA		/MPCHR?
	JMP WRIT10	/NO.  NOT END
	JMS WRTCHR	/YES.  WRITE 0 CHAR
	TAD LOOPT1
	JMS WRTCHR	/AND # OF ARGS
	TAD (LNBUF-1	/WILL POINT AT MACRO NAME
	DCA SCANP2
	JMS GATHER	/RECOLLECT NAME
	 JMP ERR3	/NOT REALLY POSSIBLE
	JMS FNDNAM
	 GATHBF		/FIND NAME IN DIREC
	 SKP		/NOT THERE YET
	JMP WRIT6	/ALREADY THERE
	TAD MCALST
	DCA I XR10
	TAD MCALST+1
	DCA I XR10
	TAD MCALST+2
	DCA I XR10	/PUT IN DIRECTORY
	TAD (XADD-XREPL	/FOR MESSAGE
WRIT6,	TAD (XREPL
	DCA WRIT7
	TAD LOOPT2	/START QUARTER
	DCA I XR10
	TAD I (7666	/DATE
	DCA I XR10
	JMS PRNAME
	 MCALST
	JMS PRMES
WRIT7,	 ZZZ
	TAD WRTCC2	/QUARTER COUNT
	CMA
	SNA CLA		/ABOUT TO GO TO 0?
	JMP .+3		/YES
	JMS WRTCHR	/NO
	JMP .-5
	JMS WRTCHR	/FORCING CHAR TO UPDATE QUARTER,
			/MAYBE WRITE BLOCK
	JMP LOOP	/CONTINUE

WRIT8,	ISZ XR11
WRIT9,	ISZ XR11
WRIT10,	ISZ WRITC2	/NEXT ARG
	ISZ WRITC1	/DONE ALL?
	JMP WRIT2	/NO
	TAD SCANP2
	CIA
	TAD SCANP3	/# OF CHARS IN FIELD
	DCA WRITC2
WRIT11,	TAD I SCANP3
	ISZ SCANP3
	JMS WRTCHR
	ISZ WRITC2
	JMP WRIT11
	JMP WRIT4

WRITI1, 0
WRITC1, 0
WRITC2, 0

/PB
/PB

	PAGE

RDCHR,	.-.		/READ INPUT CHARACTER
	ISZ RDCHC1	/DONE BUFFER?
	JMP RDCH2	/NO.  JUST FETCH
RDCH1,	CIF 0
	JMS I INHNDP	/GET BUFFER LOAD
	 2000		/WHOLE MESS, FIELD 0
INBUFP,	 INBUF		/THAT'S WHERE IT'S AT
INBLK,	 ZZZ		/BLOCK
	SMA CLA		/FATAL ERROR?
	SKP
	JMP ERR1	/YES
	TAD (10
	TAD INBLK
	DCA INBLK	/CHANGE BLOCK #
	TAD INBUFP
	DCA RDCHP1	/POINTER
	DCA RDCHP1+1	/BYTE
	TAD (-6000	/# OF CHARS
	DCA RDCHC1
RDCH2,	JMS GETCHR
	 RDCHP1
	AND (177
	TAD (-032	/END OF FILE?
	SNA
	JMP RDCH3	/YES
	TAD (-177+032
	SNA		/RUBOUT?
	JMP RDCHR+1	/YES.  IGNORE
	TAD (377	/177+200
	JMP I RDCHR

RDCH3,	TAD I CDP	/NEXT CD ENTRY
	ISZ CDP
	SNA		/END OF STRING?
	JMP RDCH4	/YES
RDCH3A,	DCA RDCHT1	/NO
	TAD I CDP
	ISZ CDP
	DCA INBLK	/NEW BLOCK
	TAD (INHB+1	/TWO PAGE
	DCA INHNDP
	TAD RDCHT1
	JMS I (USR
	 1
INHNDP,	 INHB+1		/TWO PAGE
	 JMP ERR2
	JMP RDCH1	/CARRY ON


RDCH4,	TAD I (7642	/ ALTMODE / CR BIT
	SPA CLA
	JMP ENDFIL	/ALL DONE
	JMS I (USR
	 5		/ANOTHER CD STRING
	 7002
	 0		/KEEP THOSE TENTATIVE FILES!
	TAD (7617
	DCA CDP
	TAD I CDP
	ISZ CDP
	SNA		/BLANK LINE?
	JMP ENDFIL	/YES.  CALL IT END OF FILE
	JMP RDCH3A	/NO

RDCHT1, 0
RDCHP1, 0;0
RDCHC1, -1	/TO START OFF WITH

WRTCHR,	.-.		/OUTPUT CHARACTER
	JMS PUTCHR
	 WRTCP1
	ISZ WRTCC2	/DONE QUARTER?
	JMP .+4		/NO
	TAD (-140	/YES
	DCA WRTCC2	/RESET COUNT
	ISZ DIREC	/INCREMENT DIRECTORY QUARTER
	ISZ WRTCC1	/DONE BUFFER?
	JMP I WRTCHR	/NO
	JMS WRITBF	/YES
	TAD (OUBUF
	DCA WRTCP1
	DCA WRTCP1+1
	TAD (-600
	DCA WRTCC1
	JMP I WRTCHR

WRTCC1, 0
WRTCC2, 0
WRTCP1, 0;0

XLUPS1,	.-.
	TAD I SCANP2
	JMS CCHECK
	 JMP .+3
	TAD SEPCOD
	SZA CLA
	ISZ XLUPS1
	JMP I XLUPS1

/PB
/PB

	PAGE

GETCHR,	.-.		/GET CHAR BY TWO POINTERS
	TAD I GETCHR
	ISZ GETCHR
	DCA GETCPB
	TAD I GETCPB
	ISZ GETCPB
	DCA GETCPP
	TAD I GETCPB
GETC1,	CDF 0		/ALWAYS FIELD 0
	SPA CLA
	JMP .+4
	TAD I GETCPP
	AND (377
	JMP GETC2

	TAD I GETCPP
	AND (7400
	CLL RTR
	RTR
	DCA GETCT1
	CMA
	TAD GETCPP
	DCA GETCPP
	TAD I GETCPP
	AND (7400
	TAD GETCT1
	CLL RTR
	RTR
GETC2,	CDF 10
	DCA GETCT1
	TAD I GETCPB
	CLL RAL
	SMA SNL
	STL RTR
	DCA I GETCPB
	TAD I GETCPB
	SPA CLA
	JMP GETC3
	CLA CMA
	TAD GETCPB
	DCA GETCPP
	ISZ I GETCPP
GETC3,	TAD GETCT1
	JMP I GETCHR

GETCT1, 0
GETCPP, 0
GETCPB, 0

PUTCHR,	.-.		/PUT CHARACTER INTO BUFFER BY
			/POINTER TO POINTERS
	AND (377
	DCA PUTCT1
	TAD I PUTCHR
	ISZ PUTCHR
	DCA PUTCPB
	TAD I PUTCPB
	ISZ PUTCPB
	DCA PUTCPP
	TAD I PUTCPB
PUTC1,	CDF 0		/ALWAYS FIELD 0
	SPA CLA
	JMP PUTC2
	TAD I PUTCPP
	AND (7400
	TAD PUTCT1
	DCA I PUTCPP
	JMP PUTC3

PUTC2,	TAD PUTCT1
	CLL RAR
	JMS PUTCS1
	CMA CML
	TAD PUTCPP
	DCA PUTCPP
	TAD PUTCT1
	JMS PUTCS1
PUTC3,	CDF 10
	TAD I PUTCPB
	CLL RAL
	SMA SNL
	STL RTR
	DCA I PUTCPB
	TAD I PUTCPB
	SPA CLA
	JMP I PUTCHR
	CMA
	TAD PUTCPB
	DCA PUTCPP
	ISZ I PUTCPP
	JMP I PUTCHR

PUTCPB, 0
PUTCPP, 0

PUTCS1,	.-.
	RTR
	RTR
	DCA PUTCT1
	TAD I PUTCPP
	AND (377
	DCA I PUTCPP
	TAD PUTCT1
	AND (7400
	TAD I PUTCPP
	DCA I PUTCPP
	JMP I PUTCS1

PUTCT1, 0

/PB
/PB

	PAGE

GETLIN,	.-.		/GET NEXT INPUT LINE
	TAD (LNBUF-1
	DCA XR14
	TAD XR14
	DCA LINBUF
	DCA LINCNT	/SAVE LINE INFO
	TAD LINBUF
	DCA SCANP2
	KSF
	JMP GETL1
	KRS
	TAD (-203
	SZA CLA		/^C?
	JMP GETL1	/NO
	CIF CDF 0
	JMP I (7605	/YES

GETL1,	JMS RDCHR
	TAD (-212
	SNA
	JMP GETL1	/IGNORE LF
	TAD (-214+212
	SNA
	JMP GETL1	/IGNORE FF
	TAD (-200+214
	SNA
	JMP GETL1	/IGNORE NUL
	TAD (200
	SKP
GETL2,	JMS RDCHR
	ISZ LINCNT
	TAD (-215
	SNA		/END OF LINE?
	JMP GETL3	/YES
	TAD (215	/NO
	DCA I XR14
	JMP GETL2

GETL3,	TAD (215
	DCA I XR14	/END OF LINE
	TAD LINCNT
	CIA
	DCA LINCNT
	JMP I GETLIN

CALTYI=JMS TYI

CCHECK,	.-.		/CHECK CHAR TYPE
	DCA CCHKT1
	TAD CCHKT1
	TAD (-"0
	SPA
	JMP CCHK2
	TAD ("0-"9
	SPA SNA
	JMP CCHK1
	TAD ("9-"A
	SPA
	JMP CCHK2
	TAD ("A-"Z
CCHK1,	SPA SNA CLA
	JMP I CCHECK

CCHK2,	CLA
	TAD (CCHKL1-1
	DCA XR12
CCHK3,	TAD I XR12
	SNA
	JMP CCHK4
	TAD CCHKT1
	SNA CLA
	JMP CCHK4
	ISZ XR12
	JMP CCHK3

CCHK4,	TAD I XR12
	DCA SEPCOD
	ISZ CCHECK
	JMP I CCHECK

CCHKT1, 0

TYI,	.-.
	KSF
	JMP .-1
	KRB
	TLS
	JMP I TYI

/PB
/PB

	PAGE

ENDFIL,	TAD I (7643	/ /D OPTION
	AND (400
	SNA CLA
	JMP ENDF3	/NOT SET
	JMS CRLF
	TAD (">
	JMS TYO
	TAD (CALTYI
	DCA GETL1
	TAD (CALTYI
	DCA GETL2
	JMS GETLIN
	JMS CRLF
ENDF1,	JMS GATHER	/GET MACRO NAME
	 JMP ENDF2	/NONE.  SHOULD BE END
	JMS FNDNAM
	 GATHBF
	JMP ENDF2	/NAME MISSING
	CMA CLL RTL
	TAD XR10
	DCA XR11	/BACK UP BY 3
	STL RTL
	TAD XR10
	DCA XR10	/FROM REGISTER
	TAD XR11
	IAC		/POINT TO FIRST WORD
	DCA .+2
	JMS PRNAME	/PRINT NAME
	 ZZZ
	TAD XR10
	TAD (-DIREC+1-400
	DCA ENDFC1	/# OF WORDS TO MOVE
	TAD I XR10
	DCA I XR11
	ISZ ENDFC1
	JMP .-3
	DCA I XR11	/0 END OF DIREC
	DCA I XR11
	DCA I XR11
	DCA I XR11
	DCA I XR11
	JMS PRMES
	 DEL
ENDF2,	CMA CLL RAL
	TAD SEPCOD
	SNA CLA		/,?
	JMP ENDF1	/YES
ENDF3,	IAC
	AND I (7643	/ /L OPTION?
	SNA CLA
	JMP ENDF5	/NO
	JMS CRLF
	JMS CRLF	/YES
	JMS PRMES
	 LIST
	TAD ENDFP
	DCA XR10
	TAD (-63	/51 ENTRIES
	DCA ENDFC1
ENDF4,	TAD I XR10
	SNA CLA
	JMP ENDF5	/DONE
	TAD XR10
	DCA .+2
	JMS PRNAME	/PRINT NAME
	 ZZZ
	TAD (3
	TAD XR10
	DCA XR10	/GET TO DATE
	TAD I XR10
	JMS PRDATE
	JMS CRLF
	ISZ ENDFC1
	JMP ENDF4

ENDF5,	JMS CRLF
	JMS WRITBF
	TAD ENDFC	/STEAL CONSTANT
	TAD I ENDFP	/GIVES LAST QUARTER USED
	CLL RAR
	CLL RAR		/DIVIDE BY 4
	DCA ENDFC1	/# OF BLOCKS IN FILE
	TAD STAR5
	DCA ENDFC
	CIF 0
	JMS I OUHP	/WRITE LAST BUFFER
	 4210
ENDFP,	 DIREC
ENDFC,	 2^4-1		/-1 TO REMOVE UNUSED QUARTER,
			/1 FOR DIREC, 1 FOR LAST BLOCK
/ABOVE IS DESTROYED AFTER IT IS USED
	 JMP ERR1
	TAD XDEV
	JMS I (USR	/RETRIEVE HANDLER
	 1
ENDF5A,	 OUHB
	 JMP ERR2
	TAD XDEV
	JMS I (USR
	 4
	 XFNME
ENDFC1,	 ZZZ
	 JMP ERR2
	CDF CIF 0
	JMP I (7605

/PB
/PB


	PAGE

PRCH,	.-.		/PRINT TRIMMED CHAR
	AND (77
	SZA
	TAD (240
	AND (77
	TAD (240
	JMS TYO
	JMP I PRCH

PRMES,	.-.
	TAD I PRMES	/POINTER
	DCA PRMSP1
	ISZ PRMES
PRMES1,	TAD I PRMSP1
	CLL RTR
	RTR
	RTR
	JMS PRMSS1
	TAD I PRMSP1
	JMS PRMSS1
	ISZ PRMSP1
	JMP PRMES1

PRMES2,	JMS CRLF
	JMP I PRMES

PRMSP1, 0

PRMSS1,	.-.
	AND (77
	SNA
	JMP PRMES2
	JMS PRCH
	JMP I PRMSS1

PRNAME,	.-.
	TAD I PRNAME
	ISZ PRNAME
	DCA PRNMP1
	CMA CLL RTL
	DCA PRNMC1
PRNM1,	TAD I PRNMP1
	CIA
	DCA PRNMT1
	TAD PRNMT1
	AND (7700
	SNA
	JMP PRNM3
	CLL RTR
	RTR
	RTR
	JMS PRCH
	TAD PRNMT1
PRNM2,	JMS PRCH
	ISZ PRNMP1
	ISZ PRNMC1
	JMP PRNM1
	JMS PRCH
	JMP I PRNAME

PRNM3,	TAD PRNMT1
	JMS PRCH
	JMP PRNM2

PRNMT1, 0
PRNMC1, 0
PRNMP1, 0


PRDATE, .-.		/PRINT DATE
	SNA		/IS THERE ONE?
	JMP I PRDATE	/NO.  RETURN WITHOUT PRINTING
	DCA PRDTT1	/SAVE
	TAD PRDTT1
	CLL RTL
	RTL
	RAL		/MONTH
	AND (17
	JMS PRDEC
	TAD ("/
	JMS TYO
	TAD PRDTT1
	CLL RTR
	RAR
	AND (37		/DAY
	JMS PRDEC
	TAD ("/
	JMS TYO
	TAD PRDTT1
	AND (7
	TAD (106	/70
	JMS PRDEC
	JMP I PRDATE

PRDEC,	.-.
	DCA PRDCT1
	DCA PRDCT2
	TAD PRDCT1
	TAD (-12
	SPA
	JMP .+3
	ISZ PRDCT2
	JMP .-4
	DCA PRDCT1
	TAD PRDCT2
	SNA
	JMP .+3
	TAD ("0
	JMS TYO
	TAD PRDCT1
	TAD (12+"0
	JMS TYO
	JMP I PRDEC

PRDCT1, 0
PRDCT2, 0
PRDTT1, 0

TYO,	.-.
	TLS
	TSF
	JMP .-1
	CLA
	JMP I TYO


/PB
/PB

	PAGE

FNDNAM,	.-.		/FIND NAME IN DIREC
	TAD (DIREC
	DCA XR10
	TAD (-63
	DCA FNDNC1	/# OF ENTRIES
	TAD I FNDNAM
	DCA FNDNT3
	TAD I FNDNT3	/PICK UP NAME
	ISZ FNDNT3
	DCA FNDNT1
	TAD I FNDNT3
	ISZ FNDNT3
	DCA FNDNT2
	TAD I FNDNT3
	DCA FNDNT3
	ISZ FNDNAM
FNDN1,	TAD I XR10
	SNA
	JMP FNDN5	/NOT THERE
	TAD FNDNT1
	SZA CLA
	JMP FNDN2
	TAD I XR10
	TAD FNDNT2
	SZA CLA
	JMP FNDN3
	TAD I XR10
	TAD FNDNT3
	SZA CLA
	JMP FNDN4
	ISZ FNDNAM
	JMP I FNDNAM

FNDN2,	ISZ XR10
FNDN3,	ISZ XR10
FNDN4,	ISZ XR10
	ISZ XR10
	ISZ FNDNC1
	JMP FNDN1
	JMP ERR3

FNDN5,	CMA
	TAD XR10
	DCA XR10
	JMP I FNDNAM

FNDNC1, 0
FNDNT1, 0
FNDNT2, 0
FNDNT3, 0

ERR3,	ISZ ERR
ERR2,	ISZ ERR
ERR1,	JMS PRMES
	 ERR
	CDF CIF 0
	JMP I (7605

XADD,	TEXT ' ADDED'
XREPL,	TEXT ' REPLACED'
DEL,	TEXT ' DELETED'
HEAD,	TEXT '  8BAL LIBRARY TRANSACTIONS'
LIST,	TEXT 'LIBRARY LISTING'
ERR,	TEXT '?1'

TBLSUB,	.-.		/ADD GATHBF TO TABLE
	TAD GATHBF
	CIA
	DCA I XR10
	TAD GATHBF+1
	CIA
	DCA I XR10
	TAD GATHBF+2
	CIA
	DCA I XR10
	JMP I TBLSUB

/PB
/PB

	PAGE

CRLF,	.-.
	TAD (215
	JMS TYO
	TAD (212
	JMS TYO
	JMP I CRLF

GATHER,	.-.		/COLLECT FIELD
	ISZ SCANP2
	TAD SCANP2
	DCA SCANP3
	TAD (GATHBF
	DCA GATHP1
	CMA CLL RAL
	DCA GATHBT
	DCA GATHBF
	DCA GATHBF+1
	DCA GATHBF+2
	TAD (-6
	DCA GATHC1
GATH1,	TAD I SCANP2
	JMS CCHECK
	 JMP GATH2
	TAD GATHBF
	SZA CLA
	ISZ GATHER
	JMP I GATHER

GATH2,	TAD GATHC1
	SNA CLA
	JMP GATH3
	TAD I SCANP2
	AND (77
	DCA GATHT1
	TAD I GATHP1
	CLL RTL
	RTL
	RTL
	TAD GATHT1
	DCA I GATHP1
	ISZ GATHBT
	JMP .+4
	ISZ GATHP1
	CMA CLL RAL
	DCA GATHBT
	ISZ GATHC1
GATHT1,	 ZZZ
GATH3,	ISZ SCANP2
	JMP GATH1

GATHBT, 0
GATHC1, 0
GATHP1, 0

CCHKL1,	-" ;0
	-211;0
	-215;1
	-",;2
	-":;3
	0;4	/DEFAULT

MCARG=17	/15 ARGUMENTS (PLUS LABEL)
MCALST,	ZBLOCK 3^MCARG+3

PAT,	4;2;-"D;-"E;-"F;4;2;1;0

/PB
/PB

	PAGE
NOPUNCH
LNBUF,	ZBLOCK 200	/LINE BUFFER
DIREC,	ZBLOCK 400

	FIELD 0

	*2000
OUHB,	ZBLOCK 400
INHB,	ZBLOCK 400
INBUF,	ZBLOCK 4000
OUBUF,	ZBLOCK 400

ENPUNCH

$