--- /dev/null
+/DECTAPE COPY, V10
+
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1966, 1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/DECTAPE COPY
+/VERSION .B07
+/
+/
+/COPYRIGHT 1968 DIGITAL EQUIPMENT CORPORATION
+/ MAYNARD, MASS. OCTOBER,1968
+
+
+\f
+/ THIS PROGRAM COPIES A DECTAPE FROM ONE
+/ SPECIFIED UNIT TO ANOTHER. ALL DECTAPE
+/ ROUTINES ARE INTERNALLY GENERATED SO THAT
+/ IT MAY BE RUN WITHOUT THE MONITOR SYSTEM.
+/
+/ STARTING ADDRESS IS 200
+/
+ DTRA=6761
+ DTCA=6762
+ DTXA=6764
+ DTSF=6771
+ DTRB=6772
+ DTLB=6774
+
+ WC=7754
+ CA=7755
+/ THESE AREAS ARE USED BY DATA BREAK
+BUFIOT=1547 /INPUT OUTPUT BUFFER
+BUFCHK=4563 /RE-READ BUFFER
+/
+*20
+/ PAGE ZERO WORKING STORAGE
+BADTRY, -3 /COUNT OF READ ERRORS
+CURBLK, 0 /CURRENT BLOCK NUMBER
+TRASH1, 0 /WORKING STORAGE
+TRASH2, 0 /WORKING STORAGE
+TRASH3, 0 /WORKING STORAGE
+BLKCNT, 0 /NUMBEROF BLOCKS TO READ
+ /OR MINUS THAT NUMBER
+SORBLK, 0 /STORAGE FOR CURBLK
+WORDS, 0 /NUMBER OF WORDS PER BLOCK
+INUNIT, 0 /INPUT UNIT IN LH OCT CHAR
+OUTUNI, 0 /OUTPUT UNIT IN LH OCT CHAR
+RESTOR, 0 /NUMBER OF WORDS TO COPY
+RESAVE, 0 /NEGATIVE OF BLKCNT
+SMICAR, 0 /CHARACTER STORAGE
+SMISUM, 0 /RUNNING SUM
+SPELIN, 0 /POINTER
+SEAZIK, 0 /INPUT AREA
+SEAZOK, 0 /TEMP STORAGE
+DECTWC, 0 /FLAG TO DETERMINE IF VALIDATION WILL OCCUR
+DECTCA, 0 /CURRENT ADDRESS STORE
+FIRST, 0 /STARTING BLOCK NUMBER
+LAST, 0 /LAST BLOCK NUMBER
+LENGTH, 0 /NUMBER OF WORDS TO COPY
+PARITY, 0 /PARITY ERROR FLAG (COUNT)
+MSKIN, 0 /NEGATIVE OF INUNIT
+PARDEL, PSTACK /POINTER TO PARITY TABLE
+/
+/ PAGE ZERO SUBROUTINES
+DIREC, 0
+ CLA
+ DTRA /FIND DIRECTION
+ AND [400
+ SZA CLA /BRANCH BACK
+ ISZ DIREC /REVERSE DIRECTION EXIT
+ JMP I DIREC /FORWARD DIRECTION EXIT
+/
+/
+BACKUP, 0 /SUBROUTINE REWINDS TAPE
+ CLA
+ DTRA
+ AND (670 /CLEAR DIRECTION AND MOVEMENT
+ DTXA
+ TAD (600 /GO IN REVERSE
+ DTXA
+ DTSF
+ JMP .-1 /WAIT UNTILL DONE
+ JMS I [ERROR /BUSYWORK FOR ERRORS
+ JMP I BACKUP /EXIT ON ENDZONE ERROR
+ JMP BACKUP+1
+\f
+*200
+BEGIN, CLA CLL /INITIALIZE
+ DTLB
+ TLS /TELETYPE OUTPUT
+ JMS I [SPEAK
+ MESS0
+ JMS I [SPEAK
+ MESS1 /INPUT UNIT NUMBER
+ JMS GETNUM /CHECK INPUT UNIT NUMBER
+ DCA INUNIT
+ TAD INUNIT
+ CIA /SET UP INPUT UNIT MASK
+ DCA MSKIN
+ JMS I [SPEAK
+ MESS2 /OUTPUT UNIT NUMBER
+ JMS GETNUM
+ TAD MSKIN /MAKE SURE UNITS ARE DIFFERENT
+ SNA
+ JMP BEGIN /INPUT ERROR
+ TAD INUNIT
+ DCA OUTUNI
+ JMS I [SPEAK /GET FIRST BLOCK NUMBER
+ MESSA
+ JMS I [SMIGIT
+ NOP
+ DCA CURBLK
+ TAD CURBLK
+ CIA /STORE BEGINNING MARKER
+ DCA FIRST
+ JMS I [SPEAK /GET LAST BLOCK NUMBER
+ MESSB
+ JMS I [SMIGIT
+ CLA CMA /KLUDGE IF NO INPUT
+ DCA LAST
+ TAD FIRST
+ CLL
+ SZA
+ TAD LAST /MAKE SURE VALID
+ SZA SNL CLA
+ JMP BEGIN
+ DTLB
+ TAD INUNIT /INIT INPUT UNIT
+ JMS I [FIXTAP
+ DCA WORDS /SET UP BLOCK LENGTH
+ TAD OUTUNI /INIT OUTPUT UNIT
+ JMS I [FIXTAP
+ CIA /MAKE SURE BLOCK LENGTH
+ TAD WORDS /SAME ON INPUT AND OUTPUT
+ SZA CLA
+ JMP BADLEN /BLOCK LENGTH ERROR
+ JMS I [SPEAK /TYPE OUT BLOCK LENGTH
+ MESS3
+ TAD WORDS
+ JMS I [TYPNUM
+ JMS I [SPEAK /SEND <RETURN><LINE FEED>
+ MESS0+11
+ TAD WORDS
+ CIA /COMPUTE NUMBER OF BLOCKS
+ DCA LENGTH /TO READ AND WRITE
+ DCA BLKCNT /CLEAR BLOCK COUNTER
+ TAD [3014 /LOAD BUFFER SIZE
+ TAD LENGTH
+ SPA
+ JMP BADLEN /TOO MANY WORDS PER BLOCK
+ ISZ BLKCNT /TALLY
+ TAD LENGTH
+ SMA
+ JMP .-3 /CONTINUE COUNTING
+ TAD WORDS /GET NUMBER OF
+ TAD [-3014 /WORDS TO READ
+ CIA /AND TO WRITE
+ DCA RESTOR /PRESERVE IN RESTOR
+ TAD RESTOR
+ DCA LENGTH
+ TAD BLKCNT /SAVE NEGATIVE OF BLKCNT
+ CIA
+ DCA RESAVE
+ JMS I [SPEAK
+ MESSC
+ JMS I [SMIGIT
+ NOP
+ DCA DECTWC /SET UP VERIFY FLAG
+/
+/ MAIN LOOP FOR COPY
+LETS, TAD CURBLK /CHECK FOR PARTIAL BLOCK TO COPY
+ TAD BLKCNT
+ CLL CMA IAC
+ TAD LAST
+ SZL
+ JMP LETT /COPY FULL LENGTH
+ DCA LENGTH /ADJUST WORDS TO COPY
+ TAD RESTOR
+ CIA
+ TAD WORDS
+ ISZ LENGTH
+ JMP .-2 /COMPUTE PROPER LENGTH
+ CIA
+ TAD WORDS
+ DCA LENGTH
+ TAD [REVERS /KLUDGE COPY EXIT
+ DCA I [COPY
+ JMP I [COPY+1 /PERFORM THIS COPY
+LETT, JMS I [COPY /COPY THIS BLOCKS
+ TAD BLKCNT
+ TAD BLKCNT /ADVANCE CURRENT BLOCK
+ TAD CURBLK
+ DCA CURBLK
+ JMS DIREC
+ JMP LETU /FORWARD EXCEEDED CHECK
+LETR, TAD CURBLK /REVERSE CHECK
+ TAD FIRST
+ CMA
+ SZA CLA /CHECK FOR MINUS 1
+ JMP LETT /CONTINUE COPY
+ JMP I [DONE /FINISHED JOB
+LETU, TAD CURBLK
+ CLL CMA IAC
+ TAD LAST
+ SZL CLA /CHECK FOR END OF TAPE
+ JMP LETS
+ JMP I [REVERV
+
+
+
+
+/ THIS SUBROUTINE GETS INPUT
+/ AND OUTPUT UNIT NUMBERS FROM
+/ THE TELETYPE AND VALIDATES THEM.
+/
+GETNUM, 0
+ JMS I [SMIGIT
+ NOP
+ AND [7
+ CLL RTR /MOVE TO LH THREE BITS
+ RTR
+ JMP I GETNUM
+/
+/
+
+BADLEN, JMS I [SPEAK /BLOCK LENGTH ERROR
+ MESS3A
+ JMP BEGIN
+/
+/
+/
+PAGE
+\f
+/
+/ THIS TURN AROUND IS ENTERRED
+/ WHEN THE LAST COPY MOVED INTO
+/ THE FINAL DATA AREA
+REVERV, TAD LAST
+ DCA CURBLK /START OF COPY BACK
+ JMS REVALT /CHANGE INUNIT AND OUTUNI
+ TAD INUNIT
+ DTCA DTXA
+ JMS I [RESET /REPOSITION TAPE
+ TAD OUTUNI
+ DTCA DTXA
+ JMS I [RESET /REPOSITION TAPE
+REBACK, TAD CURBLK
+ CMA /COMPUTE NEW COPY LENGTH
+ TAD SORBLK
+ TAD BLKCNT
+ SNA
+ JMP REVERS /KLUDGE IF NOTHING TO DO
+ DCA SORBLK /MINUS # OF BLOCKS
+ TAD SORBLK
+ DCA BLKCNT /SAVE THIS NUMBER
+ TAD WORDS
+ ISZ SORBLK
+ JMP .-2
+ DCA LENGTH /LENGTH FOR COPY
+ JMS I [COPY /PERFORM IT
+ TAD CURBLK
+ TAD BLKCNT
+ TAD RESAVE /ADVANCE CURBLK
+ DCA CURBLK
+ TAD RESAVE
+ DCA BLKCNT
+ TAD RESTOR
+ DCA LENGTH
+ JMP I [LETR /CONTINUE COPY
+/
+/
+/ THIS TURN AROUND IS ENTERRED
+/ WHEN THE LAST SEARCH FOR
+/ CURRENT BLOCK CAUSED AN END
+/ OF TAPE ERROR
+/
+REVERT, JMS DIREC
+ SKP
+ JMP I [DONE /FINISHED IF DIRECTION REVERSE
+ TAD SORBLK
+ DCA CURBLK /RESTORE CURBLK
+ TAD OUTUNI /RESET LOCATION OF
+ DTCA DTXA /OUTPUT DECTAPE AND
+ JMS I [RESET /FIND LAST BLOCK
+ TAD [4000 /BY LOOKING FOR IMAGINARY
+ JMS I [SEARCH /BLOCK NUMBER (KLUDGING SEARCH)
+ NOP
+ JMP .-3 /TRY AGAIN ON ERRORS
+ TAD SEAZIK /MUST BE LAST BLOCK NUMBER
+ DCA CURBLK
+ JMS REVALT /CHANGE INUNIT AND OUTUNI
+ JMP REBACK
+/
+/
+/ THIS TURN AROUND IS ENTERRED WHEN THE
+/ END BLOCK FOR COPY WAS REACHED BY A
+/ PARTIAL BUFFER COPY.
+/
+REVERS, CLA CMA /ADJUST CURBLK POINTER
+ TAD SORBLK
+ DCA CURBLK
+ TAD RESAVE
+ DCA BLKCNT /MAKE BLKCNT NEGATIVE
+ TAD RESTOR
+ DCA LENGTH /RESTORE COPY LENGTH
+ JMS REVALT /CHANGE INUNIT AND OUTUNI
+ JMP I [LETR
+/
+REVALT, 0
+ TAD OUTUNI
+ TAD [400
+ DCA OUTUNI /REVERSE DIRECTION
+ TAD INUNIT
+ TAD [400
+ DCA INUNIT /REVERSE DIRECTION
+ JMP I REVALT
+/
+\f
+/THIS SUBROUTINE PERFORMS THE OPERATION
+/OF COPYING N BLOCKS AND VALIDATING
+/THE OUTPUT.
+/WHEN END OF TAPE IS REACHED THE ROUTINE
+/BRANCHES TO "REVERS", OR TO REVERT
+/AS APPROPRIATE.
+/
+COPY, 0
+ KSF /CHECK FOR <^C>
+ JMP .+5
+ KRB
+ TAD [-203
+ SNA
+ JMP I [7600
+ CLA
+ TAD INUNIT /LOAD STAT REG A
+ DTCA DTXA
+ TAD [-3
+ DCA BADTRY /RESTORE ERROR COUNTER
+ JMS I [DECTAP
+COPO, BUFIOT /INPUT AREA
+ 30 /READ CODE
+ NOP /NORMAL RETURN
+ TAD PARITY /CHECK PARITY FLAG
+ SZA
+ JMP I [ERRPAR /FIX MESSAGE FOR PARITY ERRORS
+COPZ, TAD OUTUNI /(IGNORE END ZONE)
+ DTCA DTXA /OUTPUT UNIT & DIRECTION
+COPYB, JMS I [DECTAP /WRITE OUTPUT TAPE
+ BUFIOT /OUTPUT BUFFER
+ 50 /WRITE CODE
+ JMP COPCPR /NORMAL RETURN
+ TAD [REVERS /END ZONE RETURN
+ DCA COPY /FIX UP EXIT
+COPCPR, TAD CURBLK
+ DCA SORBLK /STORE CURRENT BLOCK NUMBER
+ TAD DECTWC
+ SZA CLA
+ JMP I COPY /NO VERIFICATION
+ JMS I [RESET /RETURN TO FRONT END
+ JMS I [DECTAP /READ DATA
+COPR, BUFCHK /INPUT AREA
+ 30 /READ CODE
+ JMP .+2 /NORMAL RETURN BRANCH
+ TAD I [WC /END ZONE RETURN
+ TAD LENGTH
+ CIA
+ DCA TRASH3 /COUNTER
+ TAD COPO
+ DCA 17 /FORWARDS POINTER
+ TAD COPR /REREAD BUFFER
+ DCA 16 /SET UP POINTER
+COPCML, TAD I 16
+ CIA
+ TAD I 17
+ SZA
+ JMP COPERR /MISMATCH ON READ
+ ISZ TRASH3 /ANY MORE WORDS
+ JMP COPCML /LOOP
+ JMP I COPY /MADE IT! EXIT
+COPERR, ISZ BADTRY /HOW MANY ATTEMPTS
+ JMP COPERS /TRY AGAIN
+ JMS I [SPEAK
+ MESS5 /RE-READ ERRORS
+ JMS I [TUNIT /TYPE UNIT NUMBER AND WAIT
+ TAD [-3
+ DCA BADTRY /RESTORE ERROR COUNTER
+COPERS, CLA
+ JMS I [RESET
+ JMP COPYB /WRITE OUT BLOCK AGAIN
+/
+PAGE
+\f
+/ THIS SUBROUTINE MOVES THE DECTAPE
+/ BACK IN PREPARATION FOR ANOTHER
+/ READ OR WRITE.
+/
+RESET, 0
+ CLA CLL /CLEAR AC AND LINK
+ TAD [400 /CHANGE DIRECTION
+ DTXA
+ JMS DIREC /FIND DIRECTION
+ TAD [6 /FORWARD MAKE +3
+ TAD [-3 /REVERSE MAKE -3
+ TAD CURBLK
+ SPA /MAKE SURE VALUE IS PLUS
+ JMP RESEV
+ JMS I [SEARCH /FIND THIS BLOCK
+ SKP CLA /FOUND IT
+ JMP RESET+4
+REEXT, DTRA
+ AND [200 /CLEAR STOP-GO FLAG
+ TAD [400 /AND REVERSE DIRECTION
+ DTXA
+ JMP I RESET
+RESEV, JMS BACKUP /REWIND THIS TAPE
+ JMP REEXT
+/
+/
+/ THIS BRANCH IS TKEN WHEN
+/ ALL COPYING IS COMPLETED
+DONE, JMS I [SPEAK
+ MESS4
+ JMS I [SMIGIT
+ JMP I [BEGIN
+
+ JMP I [BEGIN
+\f
+/THIS SUBROUTINE READS NUMBERS,
+/NOT EXCEEDING 4098, FROM A TELETYPE
+/AND RETURNS THE OCTAL VALUE OF INPUT.
+/THE FOLLOWING SPECIAL CHARACTERS
+/ARE USD...<RETURN> MARKS END OF INPUT, CAUSES A <CR><LF>
+/IF THE <RETURN> IS THE FIRST CHARACTER THEN
+/DIRECT RETURN IS TAKEN, ELSE RETURN IS TO ENTRY+2
+/ <^C> CAUSES A BRANCH TO 7600
+/
+SMIGIT, 0
+ KCC /INITIALIZE TTY INPUT
+ DCA SMISUM /CLEAR TEMP STORAGE
+ JMS TTYIN /GET CHAR
+ AND [177
+ TAD [200
+ TAD [-215 /CHECK FOR <RETURN>
+ SNA
+ JMP SMIXIT /EXIT ON FIRST <RETURN>
+ ISZ SMIGIT /ADVANCE EXIT POINTER
+SMIGOP, TAD [12 /CHECK FOR ^C
+ SNA
+ JMP I [7600 /BRANCH TO MONITOR
+ TAD [-65 /CHECK FOR DIGITS
+ CLL
+ TAD [10
+ SNL
+ JMP SMILOP /INVALID CHARACTER
+ DCA SMICAR /TEMP STOR
+ TAD SMISUM /GET CHARACTER STRING
+ CLL RAL
+ CLL RAL
+ CLL RAL /ROTATE TO LH POSITION
+ TAD SMICAR /APPEND CURRENT DIGIT
+ DCA SMISUM
+ TAD SMICAR
+ TAD [260 /MAKE ASCII
+ JMS TYPE /ECHO CHARACTER
+SMILOP, JMS TTYIN /GET NEXT CHARACTER
+ TAD [-215 /CHECK FOR <RETURN>
+ SZA
+ JMP SMIGOP /CONTINUE LOOP
+SMIXIT, JMS I [SPEAK /SEND A <RETURN><LINE FEED>
+ MESS0+11
+ TAD SMISUM /GET INPUT STRING
+ JMP I SMIGIT /EXIT
+
+
+/THIS SUBROUTINE READS A CHARACTER FROM THE TTY
+TTYIN, 0
+ KSF /WAIT UNTIL READY
+ JMP .-1
+ KRB /READ TTY BUFFER
+ JMP I TTYIN
+\f
+/THIS SUBROUTINE TYPES OUT A
+/DIGIT STRING FROM THE AC
+/AS FOUR OCTAL CHARACTERS
+TYPNUM, 0
+ DCA SMICAR /PRESERVE STRING VALUE
+ TAD [-4
+ DCA SMISUM /INITIALIZE COUNTER
+TYPXL, TAD SMICAR
+ RTL
+ RAL /GET NEXT PRINT DIGIT
+ DCA SMICAR /RETURN TO STRING
+ TAD [3
+ AND SMICAR
+ RAL /ENTER CURRENT DIGIT
+ TAD [260 /MAKE ASCII
+ JMS TYPE /TYPE DIGIT
+ ISZ SMISUM /COUNT DIGITS
+ JMP TYPXL /COUNTINUE LOOP
+ JMP I TYPNUM /EXIT
+
+\f
+/THIS SUBROUTINE TYPES OUT A
+/MESSAGE IN "TEXT" FORMAT TWO
+/ASCII CHARACTERS PER WORD.
+/SPECIAL CHARACTERS ARE NOT
+/PERMITTED. A CARRIGE RETURN
+/AND LINE FEED PRECEED THE
+/MESSAGE.
+/ JMS I [SPEAK <BRANCH TO SUBROUTINE>
+/ MESSAGE <POINTER TO MESSAGE BUFFER>
+/A ZERO WORD MARKS THE
+/END OF THE MESSAGE.
+/
+SPEAK, 0
+ CLA CLL
+ TAD [215
+ JMS I [TYPE /CARRIGE RETURN
+ TAD I SPEAK /GET ADDRESS OF OUTPUT
+ DCA SPELIN
+ ISZ SPEAK
+ TAD [212
+ JMS I [TYPE /LINE FEED
+SPEELH, TAD I SPELIN /GET NEXT WORD
+ SNA /CHECK FOR ZERO
+ JMP I SPEAK /EXIT IF ZERO
+ AND [7700 /GET LH CHARACTER
+ CLL RTR /MOVE TO
+ RTR /RIGHT HAND
+ RTR /SIX BITS
+ JMS SPEOUT /TRANSLATE AND OUTPUT
+ TAD I SPELIN
+ ISZ SPELIN /ADVANCE POINTER
+ AND [77 /GET RH CHARACTER
+ JMS SPEOUT /TRANSLATE AND OUTPUT
+ JMP SPEELH
+SPEOUT, 0
+ TAD [-40 /CHECK FORMAT
+ SMA
+ TAD [-100 /KLUDGE DIGITS FORMAT<200+XX>
+ TAD [340 /ALPHA FORMAT <300+XX>
+ JMS I [TYPE /OUTPUT IT
+ JMP I SPEOUT /RETURN
+
+/
+/THIS SUBROUTINE TYPES OUT
+/THE ASCII CHARACTER IN THE AC.
+/
+TYPE, 0
+ TSF /WAIT UNTIL READY
+ JMP .-1
+ TLS /TYPE CHARACTER
+ CLA
+ JMP I TYPE
+/
+/THIS SUBROUTINE TYPES OUT THE
+/CURRENT UNIT NUMBER
+TUNIT, 0
+ CLA
+ DTRA
+ AND [7000 /GET CURRENT UNIT NUMBER
+ CLL RTL /MOVE OVER
+ RTL
+ TAD [260 /MAKE ASCII CODE
+ JMS I [TYPE /TYPE IT
+ JMS I [SMIGIT /WAIT
+ JMP I TUNIT /EXIT
+ JMP I TUNIT
+/
+/
+PAGE
+\f
+/THIS SUBROUTINE SEARCHES DECTAPE
+/IN A FORWARD OR REVERSE DIRECTION.
+/STATUS REGISTER A SHOULD CONTAIN
+/UNIT SELECT NUMBER (0-2), FORWARD
+/OR REVERSE, AND A5=1.
+/THE BLOCK NUMBER FOR WHICH THE PROGRAM IS
+/SEARCHING MUST BE IN THE AC.
+/ON ERROR RETURN THE COMAND
+/FOLLOWING THE "JMS" IS SKIPPED,
+/AN END OF TAPE ERROR WILL CAUSE
+/THREE MOVES INTO ENDZONE AND TWO COMMANDS FOLLOWING
+/THE "JMS" ARE SKIPPED
+SEARCH, 0
+ CIA /FORM TWO'S COMPLEMENT
+ DCA SEAZOK /STORE - BLOCK NUMBER
+ DCA SEAZIK /CLEAR INPUT WORD
+ DTRA
+ AND [274
+ DTXA /CLEAR OUT A REGISTER
+ TAD [210 /START DEVICE
+ DTXA
+ JMS DIREC /DETERMINE DIRECTION
+ TAD [NOP-CIA /FORWARD...FIX TO "NOP"
+ TAD [CIA /REVERSE...FIX TO "CIA"
+ DCA SEATIX /FIX UP COMMAND
+ TAD [SEAZIK /BLOCK NUMBER INPUT
+ DCA I [CA /PUT IN CURRENT ADDRESS
+ CLA CMA /NUMBER OF BLOCKS=1
+ JMS SEARUN /FIND FIRST BLOCK MARK
+ TAD [100 /SET CONTINUOUS MODE FLAG
+ DTXA
+ TAD SEAZIK /BLOCK NUMBER HERE
+ TAD SEAZOK /MINUS BLOCK NUMBER THERE
+SEATIX, NOP /IFSEARCHING IN REVERSE DIRECTION
+*.-1
+ CIA /IF SEARCHING IN FORWARD DIRECTION
+ SPA /SKIP IF DONE
+ JMS SEARUN /FIND "N" BLOCK MARKS
+ DTRA
+ AND [100 /CLEAR CONTINUOUS MODE FLAG
+ DTXA
+ JMP I SEARCH /NORMAL EXIT
+SEARUN, 0
+ DCA I [WC /NUMBER OF BLOCKS TO READ
+ DTXA
+ DTSF /CHECK FOR DONE
+ JMP .-1
+ DTRB /READ STATUS REGISTER B
+ SMA CLA
+ JMP I SEARUN /DT FLAG...NORMAL EXIT
+ JMS I [ERROR /HANDLE ALL ERRORS
+ ISZ SEARCH /END OF TAPE ERROR
+ ISZ SEARCH /ALL OTHER ERRORS
+ JMP SEARUN-4 /EXIT
+
+\f
+/THIS SUBROUTINE READS OR WRITES
+/<N> WORDS, IN CONTROL MODE, ON
+/A BLOCK(S) ASSUMING THAT
+/THE DECTAPE IS PROPERLY
+/POSITIONED. IN LINE CODE:
+/ JMS I [DECTAP
+/ <BUFFER> ADDRESS TO READ INTO (OR WRITE FROM) -1
+/ <3> IF READ, <5> IF WRITE
+/<<NORMAL RETURN>>
+/<<END OF TAPE ERROR>>
+/AN END OF TAPE ERROR WHILE SEARCHING
+/CAUSES A BRANCH TO "REVERT".
+/STATUS REGISTER A SHOULD CONTAIN:
+/AO-2 UNIT NUMBER
+/A3 FORWARD=0, REVERSE=1
+/A4 UNIMPORTANT, SHOULD BE ZERO
+/A5 1
+/A6-8,89 UNIMPORTANT
+/BLOCK NUMBER IN PAGE ZERO "CURBLK"
+/NUMBER OF WORDS TO READ OR
+/WRITE IS IN PAGE ZERO "LENGTH"
+/
+DECTAP, 0
+ TAD I DECTAP /GET INPUT BUFFER
+ DCA DECTCA /STORE
+ ISZ DECTAP
+DECAGN, TAD CURBLK /SEARCH FOR BLOCK
+ JMS I [SEARCH
+ JMP DECRUN /FOUND IT
+ JMP DECAGN
+ JMP I [REVERT /END ZONE ERROR
+DECRUN, TAD SEAZIK
+ TAD SEAZOK /CHECK TO SEE IF FOUND BLOCK
+ SZA
+ JMP DECEXT-3
+ TAD LENGTH /SET UP WORD COUNT
+ CIA
+ DCA I [WC
+ TAD DECTCA /AND INPUT OUTPUT BUFFER
+ DCA I [CA
+ TAD I DECTAP /GET READ OR WRITE
+DECLOP, DTXA /START GOING
+ DTSF
+ JMP .-1
+ DTRB /GET FLAGS
+ SMA
+ JMP DECEXI
+ JMS I [ERROR
+ JMP DECEXT-1 /ENDZONE ERROR
+ JMS I [RESET /RESTORE POINTERS
+ JMP DECAGN
+ ISZ DECTAP /END OF TAPE EXIT
+DECEXT, ISZ DECTAP
+ CLA
+ JMP I DECTAP /FINISHED
+DECEXI, CLA
+ TAD I [WC /HAVE WE FINISHED?
+ SZA CLA
+ JMP DECLOP /NO-:CONTINUE READ-WRITE
+ DTRA /YES--CLEAR STATUS
+ AND [274
+ DTXA
+ JMP DECEXT
+\f
+/THIS SUBROUTINE CHECKS THE CONTENTS
+/OF STATUS REGISTER B.
+/ <BRANCH> JMS I [ERROR
+/ <+1 END OF TAPE ERROR>
+/ <+2 ALL OTHER ERRORS>
+/IN ADDITION: 1--A SELECT ERROR WILL
+/CAUSE A TYPEOUT AND HALT. 2--A PARITY
+/ERROR ON OUTPUT TAPE CAUSES A
+/BRANCH TO "COPERS"; ON INPUT TAPE
+/"PARITY ERROR" IS TYPED OUT. 3--GO FLIP-FLOP
+/AND STATUS REGISTER A6-8 WILL BE CLEARED.
+/
+ERROR, 0
+ CLA CLL
+ DTRB /GET ERROR FLAGS
+ AND [200 /PARITY ERROR FLAG
+ SNA CLA
+ JMP ERNOT /HANDLE OTHER ERRORS
+ DTXA /CLEAR FLAGS, CONTINUE READ MODE
+ DTRA /GET UNIT NUMBER
+ AND [7000
+ TAD MSKIN /CHECK FOR INPUT UNIT
+ SZA
+ JMP I [COPERR /ERROR ON OUTPUT UNIT
+ TAD I [WC /PUT WORD COUNT IN PUSH
+ CIA
+ DCA I PARDEL /DOWN STACK
+ ISZ PARDEL /ADVANCE POINTER
+ ISZ PARITY /SET FLAG
+ JMP I [DECEXI /RETURN TO READ
+ERNOT, DTRA /GET STATUS REGISTER A
+ AND [274
+ TAD [2 /DO NOT DISTURB ERROR FLAGS
+ DTXA /CLEAR A4 AND A6-8
+ DTRB /GET ERROR FLAGS
+ RTL
+ SMA /SKIP IF END OF TAPE ERROR
+ JMP ERROTH
+ CLA
+ TAD [-3 /LOAD -3
+ DCA ERRSOR /STORE IN COUNT
+ TAD [200 /GO FLIP-FLOP
+ DTXA /SET
+ DTSF
+ JMP .-1
+ ISZ ERRSOR /HAVE WE DONE THREE TIMES
+ JMP .-5
+ JMP I ERROR /EXIT
+ERRSOR, 0
+ERROTH, ISZ ERROR /CHANGE ERROR BRANCH
+ SZL
+ CLA CLL /MARK TRACK ERROR
+ RTL
+ SNL CLA
+ JMP I ERROR /TIMING ERROR BRANCH
+ JMS I [SPEAK /SELECT ERROR MESSAGE
+ ERRSEL
+ERRUNT, JMS I [TUNIT
+ JMP I ERROR
+/
+PAGE
+\f
+/ VARIOUS MESSAGES
+MESS0, TEXT %DECTAPE COPY V10A %
+MESSA, TEXT %FIRST BLOCK TO COPY (OCTAL) %
+MESSB, TEXT %FINAL BLOCK TO COPY (OCTAL) %
+ERRSEL, TEXT %SELECT ERROR ON UNIT #%
+PMESS, TEXT %PARITY ERROR ON BLOCK %
+MESSC, TEXT %VERIFY OUTPUT? (0=YES, 1=NO): %
+MESS1, TEXT %FROM UNIT %
+MESS2, TEXT %TO UNIT %
+MESS3, TEXT %PDP-8 WORDS PER BLOCK %
+MESS4, TEXT %DONE%
+MESS5, TEXT %WRITE ERRORS ON UNIT #%
+MESS3A, TEXT %BLOCK LENGTH ERROR%
+/
+/
+PAGE
+/
+/
+\f
+/THIS ROUTINE TYPES OUT PARITY ERROR MESSAGES
+/AND RESTORES POINTERS TO THE PUSH DOWN STACK.
+ERRPAR, CIA
+ DCA PARITY /SET UP STACK COUNTER
+ CLA CMA
+ TAD PARDEL /MOVE POINTER BACK
+ DCA PARDEL
+ JMS I [SPEAK /TYPE OUT MESSAGE
+ PMESS
+ TAD CURBLK
+EPLOOP, DCA EPJK
+ TAD I PARDEL /CHECK FOR CORRECT BLOCK NUMBER
+ TAD WORDS /ADVANCE BLOCK WORDS COUNT
+ DCA I PARDEL
+ TAD I PARDEL
+ CIA /REACHED ORIGINAL VALUE?
+ TAD LENGTH
+ SNA CLA
+ JMP EPTYP /TYPE BLOCK AT ERROR
+ JMS DIREC
+ CLL CMA RAL /ADD ONE IF FORWARD
+ CMA /SUBTRACT ONE IF NEGATIVE
+ TAD EPJK /NEXT BLOCK NUMBER
+ JMP EPLOOP /CONTINUE LOOP
+EPTYP, TAD EPJK
+ JMS I [TYPNUM /TYPE BLOCK NUMBER
+ ISZ PARITY /ADVANCE COUNTER
+ JMP ERRPAR+2 /CONTINUE LOOP
+ JMP I EPPEXT /RETURN TO COPY
+EPPEXT, COPZ /REENTRY TO COPY
+EPJK, 0 /WORKING STORAGE
+\f
+/THIS SUBROUTINE READS A RANDOM
+/BLOCK ON DECTAPE TO DETERMINE THE BLOCK LENGTH
+FIXTAP, 0
+ TAD [610 /FIX A REG. WORD
+ DTCA DTXA /LOAD A STAT. REG.
+ CLA CMA
+ DCA I [WC /SEARCH FOR 1 BLOCK
+ TAD [BUFIOT /FIX CURRENT ADDRESS
+ DCA I [CA /TO READ INTO BUFFER
+ DTSF /WAIT AROUND
+ JMP .-1
+ DTRB
+ SPA CLA
+ JMP FIXERR /HANDLE ERROR CONDITIONS
+ TAD [30 /CHANGE TO READ MODE
+ DTXA
+ DTSF /WAIT TILL READ DONE
+ JMP .-1
+ TAD [200 /STOP TAPE
+ DTXA
+ TAD I [WC /GET BLOCK LENGTH
+ JMP I FIXTAP /EXIT
+FIXERR, JMS I [ERROR
+ TAD [400 /END OF TAPE...REVERSE DIRECTION
+ TAD [210 /START TAPE MOVING
+ DTXA /AND CLEAR FLAGS
+ JMP FIXTAP+3 /TRY AGAIN
+\f
+/PARITY ERROR WORD COUNT STACK
+PSTACK, 0
+
+
+/
+
+/END OF PROGRAM
+$
projects / pdp8.git / blobdiff