File: LIBSET.PA of Tape: OS8/OS8-Latest/new-10
(Source file text)
/LIBSET - LIBRARY BUILDER PROGRAM / / / / / 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, 6460 /VERSION AND PATCH LEVEL *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 PAGE FIELD 1 *START $