software: Added more and more
[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape1 / LIBSET.PA
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/LIBSET.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/LIBSET.PA
new file mode 100644 (file)
index 0000000..866e8ad
--- /dev/null
@@ -0,0 +1,688 @@
+/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