File LIBSET.02

Directory of image this file is from
This file as a plain text file

	/LIBRARY BUILDER PROGRAM
	FIELD 1
	HILOC=20
	INFPTR=21
	IFPTR=22
	TEMP=23
	NAMPTR=24

	*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
	JMP I (FINISH

FIRST,	-1
FLEN,	0

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

*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
*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
*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/
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
PTP=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
*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 $



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search