X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Fsystem%2Fdectapes%2Fdectape5%2FDTCOPY.PA;fp=sw%2Fos8%2Fv3d%2Fsources%2Fsystem%2Fdectapes%2Fdectape5%2FDTCOPY.PA;h=1ce92af5ea8ff9974f7b6707f82ed53af0da2c97;hb=7af5ad59491ddf2066641aef1e0025a337c0f247;hp=0000000000000000000000000000000000000000;hpb=919757fd611e482003ce51f366f6783cab73dea3;p=pdp8.git diff --git a/sw/os8/v3d/sources/system/dectapes/dectape5/DTCOPY.PA b/sw/os8/v3d/sources/system/dectapes/dectape5/DTCOPY.PA new file mode 100644 index 0000000..1ce92af --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape5/DTCOPY.PA @@ -0,0 +1,874 @@ +/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. +/ +/ +/ +/ +/ +/ + /DECTAPE COPY +/VERSION .B07 +/ +/ +/COPYRIGHT 1968 DIGITAL EQUIPMENT CORPORATION +/ MAYNARD, MASS. OCTOBER,1968 + + + +/ 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 + +*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 + 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 + +/ +/ 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 +/ + +/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 + +/ 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 + +/THIS SUBROUTINE READS NUMBERS, +/NOT EXCEEDING 4098, FROM A TELETYPE +/AND RETURNS THE OCTAL VALUE OF INPUT. +/THE FOLLOWING SPECIAL CHARACTERS +/ARE USD... MARKS END OF INPUT, CAUSES A +/IF THE 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 + SNA + JMP SMIXIT /EXIT ON FIRST + 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 + SZA + JMP SMIGOP /CONTINUE LOOP +SMIXIT, JMS I [SPEAK /SEND A + 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 + +/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 + + +/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 +/ MESSAGE +/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 + +/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 + + +/THIS SUBROUTINE READS OR WRITES +/ WORDS, IN CONTROL MODE, ON +/A BLOCK(S) ASSUMING THAT +/THE DECTAPE IS PROPERLY +/POSITIONED. IN LINE CODE: +/ JMS I [DECTAP +/ ADDRESS TO READ INTO (OR WRITE FROM) -1 +/ <3> IF READ, <5> IF WRITE +/<> +/<> +/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 + +/THIS SUBROUTINE CHECKS THE CONTENTS +/OF STATUS REGISTER B. +/ 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 + +/ 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 +/ +/ + +/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 + +/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 + +/PARITY ERROR WORD COUNT STACK +PSTACK, 0 + + +/ + +/END OF PROGRAM +$