Add README.md

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape1 / LIBSET.PA

/LIBSET - LIBRARY BUILDER PROGRAM
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
\f	FIELD 1
	HILOC=20
	INFPTR=21
	IFPTR=22
	TEMP=23
	NAMPTR=24
/VERSION=3
/PATCH="A

	*2600
START,	SKP
	JMP .+4
CALLCD,	JMS I (200
	5
RL,	2214
	0		/DON'T RESET OUTPUT FILES
	ISZ FIRST
	JMP NOTFST
	TAD I (7604
	SNA
	TAD RL
	DCA I (7604
	TAD I (7600
	SZA CLA		/IS THERE AN OUTPUT FILE?
	JMP OUTYES	/YES
	CLA IAC
	DCA I (7600	/NO - MAKE SYS:LIB8.RL THE OUTPUT FILE
	TAD (1411
	DCA I (7601
	TAD (0270
	DCA I (7602
	TAD I (7617
	SNA CLA		/HOW ABOUT INPUT FILES?
	TAD I (MPARAM+1
	AND (40		/IF NO INPUT FILES,
	SNA CLA		/AND /S OPTION IS ON,
	JMP OUTYES
	DCA PTRCOD	/USE PTR: FOR INPUT
	JMS I (200
	12
	4224
PTRCOD,	0
	0
	JMP I PERROR	/NO PTR - BAD
	TAD PTRCOD
	DCA I (7617
OUTYES,	JMS I (XOPEN
	JMS I (OCHAR
	JMS I (DMPREC	/PUT OUT NOTHIN IN FIRST RECORD
	TAD (7000
	DCA NAMPTR
	TAD (7376
	DCA INFPTR
NOTFST,	TAD (7617
	DCA IFPTR
FILELP,	TAD I IFPTR
	SNA CLA
	JMP NEXTCD
	TAD IFPTR
	JMS I (IOPEN
READLP,	CLA CMA
	TAD I (OUCCNT
	DCA FLEN
	DCA HILOC
	JMS I (IREAD	/READ AND COPY A RELOCATABLE PROGRAM
	SZA CLA		/TEST CHECKSUM
	JMP I PERROR
	TAD HILOC
	AND (7600
	TAD FLEN
	DCA I INFPTR
	JMS I (DMPREC
	ISZ INFPTR
	DCA I INFPTR
	CLA CLL CMA RTL
	TAD INFPTR
	DCA INFPTR
	TAD I (MPARAM+1
	AND (40
	SZA CLA
	JMP READLP	/IF /S SWITCH ON , CONTINUE READING TAPES UNTIL A ^Z
NXFIL,	ISZ IFPTR
	ISZ IFPTR
	JMP FILELP
NEXTCD,	TAD I (MPARAM-1
	SMA CLA
	JMP CALLCD
	DCA I NAMPTR
	ISZ NAMPTR
	ISZ NAMPTR
	ISZ NAMPTR
	DCA I NAMPTR
	TAD	NAMPTR
	CMA	IAC
	TAD	INFPTR
	SMA	CLA
	JMP I (FINISH
	JMP I	.+1
	TOOBIG

FIRST,	-1
FLEN,	0

JTABL,	DATAWD
	DATAWD
	ERROR
	SYMDEF
	ORIGIN
	DATAWD
	DATAWD
PERROR,	ERROR
	ENDTAP
	ERROR
	COMMON
	ERROR
	ERROR
	ERROR
	ERROR
	TRANVC

VERSON,	6301		/VERSION AND PATCH LEVEL
\f	*3000
IREAD,	0
	TAD (200
	DCA LOC
ILEADR,	JMS I (ICHAR
	DCA CKSM
	TAD CKSM
	AND (177
	SNA CLA
	JMP ILEADR
	TAD CKSM
	TAD (-232
	SNA CLA
	JMP I (NXFIL
	TAD (200
	JMS I (OCHAR
	TAD CKSM
	JMS I (OCHAR
	TAD CKSM
	SKP
NXTFRM,	JMS RCHAR
	CLL RTR
	RTR
	RAR
	DCA CHAR1
	TAD CHAR1
	RAL
	AND (17
	TAD JMPTAB
	DCA BTMP
	TAD I BTMP
	DCA BTMP
	JMP I BTMP
JMPTAB,	JTABL

RCHAR,	0
	JMS I (ICHAR
	DCA CHAR
	TAD CKSM
	TAD CHAR
	DCA CKSM
	TAD CHAR
	JMS I (OCHAR
	TAD CHAR
	JMP I RCHAR

DATAWD,	JMS RCHAR
	CLA CLL
	TAD LOC
	CMA
	TAD HILOC
	SZL CLA
	JMP .+3
	TAD LOC
	DCA HILOC
	ISZ LOC
	JMP NXTFRM

SYMDEF,	JMS RCHAR
	CLA CLL CMA RTL
	DCA CHAR1
GTNMLP,	JMS RCHAR
	AND (77
	CLL RTL
	RTL
	RTL
	DCA BTMP
	JMS RCHAR
	AND (77
	TAD BTMP
	DCA I NAMPTR
	ISZ NAMPTR
	ISZ CHAR1
	JMP GTNMLP
	TAD INFPTR
	AND (377
	DCA I NAMPTR
	ISZ NAMPTR
	TAD NAMPTR
	CIA
	TAD INFPTR
	SPA SNA CLA
	JMP I (TOOBIG
	JMP NXTFRM

ORIGIN,	JMS RCHAR
	CLA
	TAD CHAR1
	AND (7400
	TAD CHAR
	DCA LOC
	JMP NXTFRM

COMMON,	JMS RCHAR
	CLA
	JMP NXTFRM

TRANVC,	JMS RCHAR
	CLL RAL
	TAD CHAR
	CLL RAL
	CIA
	DCA BTMP
	JMS RCHAR
	CLA
	ISZ BTMP
	JMP .-3
	JMP NXTFRM

ENDTAP,	TAD CKSM
	CIA
	TAD CHAR
	DCA BTMP
	JMS RCHAR
	CLA
	TAD CHAR1
	AND (7400
	TAD CHAR
	TAD BTMP
	JMP I IREAD

LOC,	0
CHAR1,	0
CHAR,	0
BTMP,	0
CKSM,	0

\f	*3200
XOPEN,	0
	TAD (7577
	DCA 10
	TAD (FILENM-1
	DCA 11
	TAD (-5
	DCA 12
	TAD I 10
	DCA I 11
	ISZ 12
	JMP .-3
	JMS I (OOPEN
	TAD I (OUBLK
	DCA CTLWRI
	TAD I (OUHNDL
	DCA ODVH
	JMP I XOPEN

DMPREC,	0
	JMS I (OCHAR
	JMS I (OCHAR
	TAD I (OUDWCT
	TAD (200
	SZA CLA
	JMP .-4
	JMP I DMPREC

FINISH,	JMS I (OCLOSE
	CIF 0
	JMS I ODVH
	4210
	7000
CTLWRI,	0
	JMP OUTERR
	CDF CIF 0
	JMP I (7605
FILENM,	ZBLOCK 5
ODVH,	0

TOOBIG,	ISZ ERRNO
ERROR,	ISZ ERRNO
OUTERR,	ISZ ERRNO
INERR,	ISZ ERRNO
ERR,	TAD ERRNO
	TAD (ERR0
	DCA EPCH
	DCA ERRNO
	TAD I EPCH
	DCA ODVH
ERRLP,	TAD I ODVH
	RTR
	RTR
	RTR
	JMS EPCH
	TAD I ODVH
	JMS EPCH
	ISZ ODVH
	JMP ERRLP
ERXIT,	CDF CIF 0
	JMP I .+1
	7605

EPCH,	0
	AND (77
	SNA
	JMP ERXIT
	TAD (-40
	SPA
	TAD (100
	TAD (240
	6046
	6041
	JMP .-1
	CLA
	JMP I EPCH

ERRNO,	0
\f	*3400
		/ERROR MESSAGES
ERR0,	HELP
	INPER
	OUPER
	RELER
	BIGER

HELP,	TEXT	/HELP!/		/THIS ERROR CANNOT OCCUR
INPER,	TEXT	/INPUT ERROR/
OUPER,	TEXT	/ERROR WHILE WRITING OUTPUT FILE/
RELER,	TEXT	/BAD FORMAT OR CHECKSUM - TRY AGAIN./
BIGER,	TEXT	/LIBRARY DIRECTORY OVERFLOW - TOUGH/
\f	INBUF=0
	INCTL=2400
	OUBUF=6000
	OUCTL=4200
	INDEVH=6400
	OUDEVH=7000
	INRECS=12
	MPARAM=7643
	DCB=7760
	INFLD=INCTL&70		/GET FIELD OF INPUT BUFFER
	OUFLD=OUCTL&70		/DITTO OUTPUT BUFFER
	*2000
IN7400,	7400
IOPEN,	0
	DCA INXPTR
	CLA CMA
	DCA INCHCT		/SET INCHCT TO FORCE A READ
	ISZ INEOF		/SET END-OF-FILE FLAG TO FORCE A NEW FILE
	RDF
	TAD INCDIF
	DCA .+1
INPTR,	HLT			/RESTORE CALLING FIELDS
	JMP I IOPEN

ICHAR,	0
IN7600,	7600
	RDF
	TAD INCDIF
	DCA INRTRN		/SAVE CALLING FIELDS
INCHAR,	CDF INFLD
	ISZ INJMP		/BUMP THREE-WAY UNPACK SWITCH
	ISZ INCHCT
INJMPP,	JMP INJMP
	TAD INEOF
	SNA CLA			/DID LAST READ YIELD END-OF-FILE?
	JMP INGBUF		/NO - DO ANOTHER
GETNEW,	JMS INNEWF		/OPEN A NEW INPUT FILE
	JMP I (ERROR
INGBUF,	TAD INCTR
	CLL
	TAD (INRECS
	SNL
	DCA INCTR		/RESTORE INCTR IF IT HASN'T OVERFLOWED
	SZL			/IS THIS THE LAST READ?
	ISZ INEOF		/YES - SET END-OF-FILE FLAG
	CLL CML CMA RTR	/CONSTRUCT A CONTROL WORD FOR THE READ
	RTR			/FROM THE AMOUNT OF THE OVERFLOW
	RTR			/(IF ANY) AND THE STANDARD CONTROL WORD
	TAD (INCTL+1
	DCA INCTLW
INCDIF,	CDF CIF 0
	CDF 10
	JMS I INHNDL		/CALL THE DEVICE HANDLER
INCTLW,	0
INBUFP,	INBUF
INREC,	0
	JMP INERRX		/SOME KIND OF HANDLER ERROR
INBREC,	TAD INREC
	TAD (INRECS
	DCA INREC		/UPDATE THE RECORD NUMBER
	TAD INCTLW
	AND IN7600
	CLL RAL
	TAD INCTLW
	AND IN7600
	CMA
	DCA INCHCT		/COMPUTE THE NEW CHARACTER COUNT
	TAD INJMPP
	DCA INJMP		/RESET THE CHARACTER SWITCH
	TAD INBUFP
	DCA INPTR		/AND THE WORD POINTER
	JMP INCHAR		/GO BACK AND MAKE BELIEVE THIS NEVER HAPPENED
INERRX,	ISZ INEOF		/EITHER AN END-OF-FILE OR A BADDIE
	SMA CLA			/WHICH TYPE WAS IT?
	JMP INBREC		/END OF FILE - RESUME THY PROCESSING
	JMP I (INERR
INJMP,	HLT			/THIS IS THE THREE - WAY CHARACTER SWITCH
	JMP ICHAR1
	JMP ICHAR2
ICHAR3,	TAD INJMPP
	DCA INJMP
	TAD I INPTR
IN200,	AND IN7400
	CLL RTR
	RTR			/COMBINE THE HIGH-ORDER FOUR BITS OF
	TAD INCTLW
	RTR			/THE TWO WORD TO FORM THE THIRD CHARACTER
	RTR
	ISZ INPTR
	JMP INCOMN
ICHAR2,	TAD I INPTR
	AND IN7400
	DCA INCTLW		/SAVE THE HIGH-ORDER BITS FOR THE THIRD CHAR
	ISZ INPTR		/BUMP THE WORD POINTER
ICHAR1,	TAD I INPTR
INCOMN,	AND (377
INRTRN,	0			/RESTORE CALLING FIELDS
	JMP I ICHAR		/AND RETURN
INXPTR,	0
INEOF,	1			/THESE PARAMETERS ARE SET UP SO THAT
				/IOPEN IS UNNECESSARY.
INNEWF,	-1
	INCHCT=INNEWF
	CDF 10
	TAD (INDEVH+1
	DCA INHNDL		/INITIALIZE HANDLER ADDRESS
	TAD I INXPTR
	SNA			/ANY MORE?
	JMP I INNEWF		/NO - OUT OF INPUT
	JMS I IN200
	1			/ASSIGN, FETCH HANDLER
INHNDL,	0
	HLT			/HUH?
	TAD I INXPTR
	AND (7760		/GET LENGTH PART OF WORD
	SZA			/LENGTH OF 0 MEANS LENGTH >=256
	TAD (17		/ADD HIGH-ORDER BITS
	CLL CML RTR
	RTR
	DCA INCTR		/STORE LENGTH OF FILE
	ISZ INXPTR
	TAD I INXPTR
	DCA INREC		/STORE STARTING RECORD NUMBER OF FILE
	ISZ INXPTR
	DCA INEOF		/ZERO END-OF-FILE FLAG
	ISZ INNEWF
	JMP I INNEWF
	INCTR=IOPEN
\fPTP=20
	*2200
OOPEN,	0
OU7600,	7600
	RDF
	TAD OUCDIF
	DCA OORETN
	JMS OUASGN
OUENTR,	TAD I OU7600
	JMS I (200
	3			/ENTER OUTPUT FILE
OUBLK,	FILENM+1
OUELEN,	0			/REPLACED WITH LENGTH OF HOLE
	JMP OEFAIL		/FAILED - MAYBE WE ASKED TOO MUCH
	DCA OUCCNT
	JMS I (OUSETP
OORETN,	HLT			/RESTORE CALLING FIELDS
	JMP I OOPEN
OEFAIL,	TAD I OU7600
	AND (7760		/GET REQUESTED LENGTH
	SNA CLA			/WAS IT AN INDEFINITE REQUEST
	JMP I (OUTERR
	TAD I OU7600
	AND (17			/MAKE THE REQUESTED LENGTH ZERO
	DCA I OU7600
	JMP OUENTR		/TRY, TRY AGAIN
OUASGN,	0
	TAD (OUDEVH+1
	DCA OUHNDL
	CDF 10
	TAD I (FILENM
	AND (17			/STRIP OFF ANY LENGTH INFO
	SNA			/IS THERE AN OUTPUT DEVICE?
	JMP I (OUTERR
	JMS I (200
	1			/ASSIGN, FETCH HANDLER
OUHNDL,	0			/OUTPUT DEVICE HANDLER ENTRY
	HLT			/HUH?
	JMP I OUASGN
OUTDMP,	0
	DCA OUCTLW		/STORE THE CONTROL WORD
	TAD OUCCNT
	SNA
	ISZ OUCTLW
	TAD OUBLK
	DCA OUREC		/COMPUTE THE STARTING BLOCK NUMBER OF THIS TRANSFER
	TAD OUCTLW
	CLL RTL
	RTL
	RTL
	AND (17			/COMPUTE THE NUMBER OF RECORDS
	TAD OUCCNT		/UPDATE THE NUMBER OF BLOCKS IN THE FILE
	DCA OUCCNT
	TAD OUCCNT
	CLL CML
	TAD OUELEN
	SNL SZA CLA		/DOES THE LENGTH EXCEED THE GIVEN LENGTH?
	JMP I (OUTERR
OUCDIF,	CDF CIF 0
	CDF 10
	JMS I OUHNDL
OUCTLW,	0
	OUBUF
OUREC,	0
	JMP I (OUTERR
	JMP I OUTDMP
OCLOSE,	0
	RDF
	TAD OUCDIF
	DCA OCRET
	JMS I (OCHAR
	JMS I (OCHAR
FILLLP,	JMS I (OCHAR
	JMS I (OTYPE		/GET TYPE OF OUTPUT DEVICE
	SPA CLA
	TAD (100		/IF ITS A DIRECTORY DEVICE FORCE A RECORD
	TAD (77			/BOUNDARY - OTHERWISE A HALF-RECORD
	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 - THE ^Z IS ALREADY OUT
	TAD (4000+OUFLD		/PUT IN THE FIELD BITS AND THE WRITE BIT
	JMS OUTDMP
NODUMP,	JMS OUASGN	/REASSIGN OUTPUT HANDLER
	TAD I (FILENM
	JMS I (200
	4			/CLOSE THE OUTPUT FILE
OU7601,	FILENM+1
OUCCNT,	0
	JMP I (OUTERR
OCRET,	HLT			/RESTORE CALLING FIELDS
	JMP I OCLOSE
\f	*2400
OUSETP,	0			/ROUTINE TO INITIALIZE CHARACTER POINTERS
	TAD (OUCTL&3700		/GET SIZE OF BUFFER IN DOUBLEWORDS
	CIA			/NEGATE IT
	DCA OUDWCT
	TAD (OUBUF
	DCA OUPTR		/INITIALIZE WORD POINTER
	TAD OUJMPE
	DCA OUJMP		/INITIALIZE THREE-WAY CHARACTER SWITCH
	JMP I OUSETP

OCHAR,	0
	AND (377
	DCA OUTEMP
	RDF
	TAD (CDF CIF 0
	DCA OUCRET
OUCHAR,	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
OCHAR3,	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 SECOND WORD FROM LOW ORDER 4 BITS
	TAD OUJMPE
	DCA OUJMP		/RESET SWITCH
	ISZ OUPTR
	ISZ OUDWCT		/BUMP DOUBLEWORD 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,
OUCRET,	HLT			/RESTORE CALLING FIELDS
	JMP I OCHAR
OUTEMP,	0
OUPOLD,	0
OUPTR,	0
OUJMPE,	JMP OUJMP
OUDWCT,	0
OUTINH,	0

OTYPE,	0
	RDF
	TAD (CDF CIF 0
	DCA OTRTN
	CDF 10
	TAD I (7600
	AND (17
	TAD (DCB-1
	DCA OUTEMP
	TAD I OUTEMP
OTRTN,	HLT
	JMP I OTYPE
CTCTST,	0
	KRS
	TAD (-203
	SNA CLA			/IS THE TELETYPE BUFFER A ^C
	KSF			/WITH THE TELETYPE FLAG ON?
	JMP I CTCTST			/NO
	CDF CIF 0		/YES - GO TO MONITOR
	JMP I (7605		/THROUGH THE "DON'T SAVE CORE" RETURN
	$
\f