software: Added more and more
[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape3 / TM8E.PA
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/TM8E.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/TM8E.PA
new file mode 100644 (file)
index 0000000..b42ccdd
--- /dev/null
@@ -0,0 +1,413 @@
+/16 TM8-E MAGTAPE HANDLER FOR OS/8
+
+
+
+
+
+
+
+
+
+
+/
+/
+/COPYRIGHT (C) 1973,1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT  TO CHANGE  WITHOUT NOTICE
+/AND  SHOULD  NOT  BE CONTRUED  AS A COMMITMENT  BY  DIGITAL  EQUIPMENT
+/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES  NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/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      LWCR=6701       /LOAD WORD COUNT REGISTER AND CLEAR AC
+       LCAR=6703       /LOAD CURRENT ADDRESS REGISTER AND CLEAR AC
+       LCMR=6705       /LOAD COMMAND REGISTER AND CLEAR AC
+       LFGR=6706       /LOAD FUNCTION REGISTER AND CLEAR AC
+       CLT=6712        /CLEAR TRANSPORT
+       RMSR=6714       /CLEAR AC AND READ MAIN STATUS REGISTER
+       RFSR=6716       /CLEAR AC AND READ STUFF
+       SKEF=6721       /SKIP IF ERROR FLAG IS SET
+       SKJD=6723       /SKIP IF THE JOB IS DONE (MTTF IS SET)
+       SKTR=6724       /SKIP IF TAPE UNIT READY (TUR TRUE)
+
+       MTAVERSION="F&77
+
+/SPECIAL CODES USED WHEN PAGE COUNT=0 (CODES IN BITS 9-11 OF FN WORD)
+
+/0     (CLOSE) WRITE 2 EOF'S
+/1     REWIND
+/2     SPACE FORWARD/REVERSE RECORDS
+/      IF BIT 0 OF THE FUNCTION WORD IS A 0,
+/              THIS CODE ADVANCES RECORDS.
+/              THE NEGATIVE OF THE NUMBER OF RECODRDS IS SPECIFIED IN ARG 3
+/      IF BIT 0 OF THE FUNCTION WORD IS A 1,
+/              THIS CODE BACKSPACES RECORDS.
+/              THE NEGATIVE OF THE NUMBER OF RECORDS IS SPECIFIED AS ARG 3.
+/      UNDER NO CIRCUMSTANCES DOES THIS COMMAND CONTINUE PAST A FILE MARK.
+/3     SPACE FORWARD/REVERSE FILES
+/      IF BIT 0 OF THE FUNCTION WORD IS A 0
+/              THEN THIS FUNCTION ADVANCE FILE MARKS
+/              THE NEGATIVE OF THE NUMBER OF FILE MARKS IS SPECIFIED BY ARG3
+/              THE TAPE IS LEFT POSITIONED AFTER THIS FILE MARK
+/              BUT UNDER NO CIRCUMSTANCES DOES THE TAPE ADVANCE PAST
+/              THE SECOND MARK OF TWO CONSECUTIVE FILE MARKS
+/      IF BIT 0 OF THE FUNCTION WORD IS A 1,
+/              THIS CODE BACKSPACES PAST FILE MARKS.
+/              THE NEGATIVE OF THE NUMBER OF FILE MARKS IS SPECIFIED BY ARG 3.
+/              THE TAPE IS LEFT POSITIONED BEFORE THE LAST FILE MARK,
+/              SO THE USER PROBABLY WANTS TO DO A FORWARD RECORD NEXT.
+/4     REWIND AND PUT OFF-LINE
+/5     WRITE EOF
+/6     PERFORM OPERATION WITH SPECIFIED BLOCKSIZE
+/      THE NEGATIVE OF THE DESIRED BLOCKSIZE IS SPECIFIED AS ARG 3.
+/7     CURRENTLY UNUSED
+
+/NOTE: SKIP TO EOD CAN BE PERFORMED BY SKIPPING 4096 FILES
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1.    MAJOR CODE OVERHAUL
+/2.    SKIP RECORDS RETURNS NON-FATAL ERROR IF IT DETECTS FILE MARK
+/3.    SKIP FORWARD FILES NEVER EVER PASSES EOD
+/4.    SKIP FORWARD FILES RETURNS ERROR IF IT STARTS IMMEDIATELY
+/      BEFORE A FILE MARK (UNLESS IT'S AT BOT)
+/      IT THEN REMAINS BEFORE THE FILE MARK
+/5.    FIXED TIMING PROBLEM FOR TS03
+/6.    CHANGED ORDER OF TEST FOR DATA DURING SKIP FORWARD FILES
+/7.    MADE UNUSED FUNCTION CODE 7 ACT SAME AS 0
+\f
+/BUILD DESCRIPTOR BLOCK
+
+       *0
+
+       -10             /8 ENTRY POINTS
+
+DEVICE TM8E;DEVICE MTA0;200;MTA0&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA1;200;MTA1&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA2;200;MTA2&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA3;200;MTA3&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA4;200;MTA4&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA5;200;MTA5&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA6;200;MTA6&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA7;200;MTA7&177+4000;ZBLOCK 2
+\f      *200
+
+PARITY,        402             /CHANGE TO 2 TO HAVE EVEN PARITY
+BLOCK0,        0               /SET TO 1 TO INHIBIT REWIND ON BLOCK 0
+MTATAD,        TAD MTA0        /USED TO MAKE HANDLER SERIALLY REUSABLE
+                       /CONTENTS MUST BE 13XX [V3C]
+MTISZ, ISZ MTANO       /DITTO
+STOP,  ISZ MTHX
+MTEXIT,        HLT             /CIF CDF TO USER'S FIELD
+       JMP I MTHX
+
+PNEXT, 0
+/V3C   CLA
+       TAD MTANO       /GET UNIT #
+       CIA
+       TAD MTATAD      /FIND WHICH ENTRY POINT
+       DCA MTFUN       /MAKE A 'TAD MTAN' AND EXECUTE IT
+MTFUN, HLT
+       DCA MTHX        /COLLECT ARGUMENTS VIA 'MTHX'
+       CLA STL RTR     /2000
+       TAD MTFUN       /MAKE A 'DCA MTAN' AND EXECUTE IT
+       DCA NBLOK
+       TAD MTISZ       /RESTORE DESTROYED ISZ
+NBLOK, HLT
+       TAD I MTHX      /GET FUNCTION WORD
+       DCA MTFUN       /SAVE IT IN 'MTFUN'
+       ISZ MTHX        /POINT TO BUFFER ADDRESS
+       STA             /GET ONE LESS THAN
+       TAD I MTHX      /BUFFER ADDRESS
+       DCA NBUFF       /AND STORE AWAY
+       ISZ MTHX        /POINT TO BLOCK NUMBER
+       TAD I MTHX      /GET BLOCK NUMBER
+       DCA NBLOK       /STORE AWAY
+       ISZ MTHX        /POINT TO ERROR RETURN
+       RDF             /GET CALLING FIELD
+       TAD MTCDIF      /CREATE CIF CDF TO USER'S FIELD
+       DCA MTEXIT      /STORE AWAY WHERE WILL BE USEFUL LATER
+MTCDIF,        CIF CDF 0       /GO TO FIELD 0
+       TAD MTANO       /GET UNIT NUMBER
+       CLL RTR
+       RTR
+       DCA MTANO       /PUT IN BITS 0-2 OF 'MTANO'
+       TAD MTFUN       /RETRIEVE FUNCTION WORD
+       AND L70         /ISOLATE FIELD OF BUFFER
+       TAD PARITY      /SET ODD PARITY BITS, AND DENSITY 8 (800 BPI, 7-CHANNEL)
+       TAD MTANO       /COMBINE WITH UNIT NUMBER
+       DCA MTAWD       /TO GET A USEFUL MTA COMMAND
+       TAD MTFUN       /ZERO BUFFER FOR PIP ON EOF
+       AND L70         /FIELD OF ORIGIN
+       TAD MTCDF
+       DCA USRCDF
+USRCDF,
+MTANO, 0
+       DCA MTANO       /RESET 'MTANO' FOR NEXT CALL
+       TAD MTFUN
+       RAL
+       AND P7600       /GET # OF WORDS IN BUFFER
+       SNA SZL         /ZERO BUFFER IF READING
+       JMP P7600
+       CIA
+       DCA MTH
+       TAD NBUFF
+       DCA ERROR
+MCLRLP,        ISZ ERROR
+L100,  100
+       DCA I ERROR
+       ISZ MTH
+       JMP MCLRLP
+P7600, 7600
+MTCDF, CDF 0
+       TAD BLOCK0
+       SNA             /OPERATE IN MULTIPLE-FILE MODE?
+       TAD NBLOK       /RETRIEVE BLOCK
+       SZA CLA         /IS IT BLOCK 0?
+       JMP BIGBLK      /NO
+       TAD MTATAD      /YES, REWIND [CAN BE 13XX]
+       JMS MTH         /CALL MAGTAPE ROUTINE
+MTAWD, 1000            /CA IMMATERIAL
+M7603, -7603           /WC IMMATERIAL
+L70,   70              /NO REWIND ERRORS (THESE CAN'T OCCUR)
+BIGBLK,        TAD MTFUN
+       JMS I PNEXT     /GO READ OR WRITE NEXT PAGE
+NBUFF, 0               /ONE LESS THAN ADDRESS OF BUFFER
+                       /MUST BE AT LOC AFTER CALL TO NEXT
+\f/     MTH
+
+/SET UP WC AND CA REGISTERS, LOAD FUNCTION AND GO
+
+/CALLING SEQUENCE:
+
+/      TAD (FNWORD
+/      JMS MTH
+/      BUFFER ADDRESS-1
+/      -WORD COUNT
+/      MASK FOR UNACCEPTABLE ERROR CONDITIONS
+/      <NORMAL RETURN>
+
+/      TAKES HANDLER ERROR RETURN ON ERRORS.
+/      IF ERROR, AC HAS ERROR CODE FROM MAIN STATUS REGISTER
+/      AC IS POSITIVE IF E.O.F. READ
+
+MTH,   0               /MUST BE AT 2ND LOC AFTER CALL TO NEXT
+       DCA ERROR       /SAVE FUNCTION TEMPORARILY
+       SKTR            /V3C
+       JMP .-1         /FIX TIMING BUG
+       CLT             /CLEAR THE WORLD
+       TAD MTAWD
+       LCMR            /LOAD COMMAND REGISTER
+       TAD I MTH       /GET CURRENT ADDRESS
+       LCAR            /LOAD IT
+       ISZ MTH         /POINT TO WORD COUNT
+       TAD I MTH       /GET WORD COUNT (TWO'S COMPLEMENT THEREOF)
+       LWCR            /LOAD IT
+       ISZ MTH         /POINT TO ERROR MASK
+       TAD ERROR       /GET FUNCTION BACK
+       LFGR            /GO BABY GO
+       JMS ERROR       /CHECK FOR ERROR
+       SKJD            /THROUGH?
+       JMP .-2         /NO
+       JMS ERROR       /YES, ANY ERRORS?
+E1,    ISZ MTH         /AMAZING WE MADE IT (NO ERRORS)
+       JMP I MTH       /NORMAL RETURN
+
+       IFNZRO MTH-NBUFF-1 <MTHERR,XXX>
+\fERROR,        0
+       TAD P7600       /YES
+       KRS             /IS IT CTRL/C?
+       TAD M7603       /ALLOW PARITY TELETYPES
+       SNA CLA
+       KSF
+       JMP SIFE
+       CLT             /ABORT I/O
+       JMP I P7600     /RETURN TO OS/8 KEYBOARD MONITOR
+SIFE,  SKEF            /SKIP ON ERROR
+       JMP I ERROR     /RETURN, NO ERRORS
+       RMSR            /WHAT'S CAUSING THE ERROR?
+       AND I MTH       /IS IT A GOOD ONE? (USE ERROR MASK)
+       SNA CLA         /IS ERROR ACCEPTABLE?
+       JMP E1          /YES
+       RMSR            /NOT ACCEPTABLE
+       AND L100        /IS IT AN E.O.F.?
+       SNA             /IF SO, LEAVE BIT 0 CLEAR
+       RMSR
+       JMP MTEXIT      /AND LEAVE WITH STATUS IN AC
+
+       IFZERO .-367&4000 <PERR,ZZXX>
+\f      *366
+MTHX,  MTAVERSION
+MTA7,  ISZ MTANO
+MTA6,  ISZ MTANO
+MTA5,  ISZ MTANO
+MTA4,  ISZ MTANO
+MTA3,  ISZ MTANO
+MTA2,  ISZ MTANO
+MTA1,  ISZ MTANO
+MTA0,  ISZ MTANO
+       JMS PNEXT       /GET ADDRESS OF FIRST LOCATION ON NEXT PAGE
+       PAGE
+
+       IFNZRO PARITY-200 <PARERR,ZZZ>
+\f      *400
+
+NEXT,  0
+       DCA RECNO       /READ OR WRITE AND HOW MANY
+       TAD NEXT
+       TAD KSTOP
+       DCA NSTOP       /ADDRESS OF RETURN ROUTINES
+       TAD NEXT
+       TAD KBLOK
+       DCA WC
+       TAD I WC
+       DCA WC
+       TAD I NEXT
+       DCA BUFFER      /GET BUFFER ADDRESS - 1
+       ISZ NEXT        /POINT TO MTH
+       TAD (3677       /V3C
+       DCA ERFLAG      /DEFAULT IS REPORT ALL ERRORS EXCEPT EOF
+       TAD RECNO
+       CLL RAL         /LINK SPECIFIES READ OR WRITE
+       AND L7600       /-(# OF BLOCKS)^200
+       SNA
+       JMP ZERO        /0 PAGE COUNT!
+       DCA RECNO
+       SZL             /READ OR WRITE?
+       STL CLA RTR     /WRITE.   +2000 TO CONVERT READ CODE TO WRITE CODE
+       TAD L2100       /READ (OR WRITE) & GO
+       DCA TEMP        /SAVE THIS COMMAND
+       TAD L7600
+       DCA WC          /OS/8 USES 128 WORD BLOCKS
+       STA             /V3C
+       DCA ERFLAG      /NOW DEFAULT IS REPORT ALL ERRORS
+RL1,   TAD TEMP
+       JMS GO
+       TAD BUFFER      /NEXT 200 WORDS
+       TAD L200
+       DCA BUFFER
+       TAD RECNO       /ANY MORE?
+       TAD L7600
+       SNA
+       JMP I NSTOP     /NO, FINISH
+       DCA RECNO       /YES, LOOP
+       JMP RL1         /REJOIN PROCESSING
+
+KSTOP, STOP-NBUFF      /USED TO RELOCATE 'STOP'
+
+KBLOK, NBLOK-NBUFF
+\fFLAG, 0
+
+COUNT,
+TEMP,  0
+
+EFL2,  TAD L5100
+       JMS GO          /ALL THIS CODE IS NEW FOR V3C
+EFL1,  TAD L5100
+       JMP GOO         /V3C
+
+GO,    0
+       JMS I NEXT      /CALL MTH
+BUFFER,        HLT
+WC,    0
+ERFLAG,        -1
+       JMP I GO
+
+L5100, 5100
+RECNO, 0
+NSTOP, 0
+L7,    7
+L2100, 2100
+\fZERO, TAD RECNO       /RETRIEVE FN WORD (MUST PRESERVE LINK)
+       AND L7          /ISOLATE SPECIAL CODE
+       TAD PJUMP
+       DCA .+1
+FN,    HLT             /BRANCH THROUGH JUMP TABLE
+
+TABLE, JMP EFL2        /0      CLOSE.  WRITE TWO EOF'S
+       JMP REW         /1      REWIND
+       JMP SPACE       /2      SPACE FORWARD/REVERSE RECORDS
+       JMP SEOF        /3      SPACE FORWARD/REVERSE FILES
+       JMP UNLOAD      /4      REWIND AND OFF-LINE
+       JMP EFL1        /5      WRITE EOF
+       JMP SPEC        /6      READ OR WRITE WITH SPECIAL BLOCKSIZE
+PJUMP, JMP TABLE       /7      UNUSED  SAME AS 0
+
+SEOF,  RAR             /LINK ON MEANS REVERSE
+       RTR
+       DCA FN
+       TAD WC
+       DCA COUNT
+       STA
+       DCA WC
+       RMSR
+       AND (3000       /CHECK BOT BIT
+       SZA CLA         /SIMULATE DATA IF AT BOT (OR REWINDING)
+FILE,  CLA IAC
+FILE2, DCA FLAG
+       TAD FN
+       TAD L6100       /V3C FORWARD [OR BACKSPACE] A RECORD
+       JMS GO
+       RMSR
+       AND P100
+       SNA CLA         /SKIP IF FILE MARK FOUND
+       JMP FILE
+       TAD FN
+       TAD FLAG
+       SZA CLA         /WAS THERE ANY DATA?
+       JMP CONT        /V3C YES, CONTINUE
+                       /EITHER SAW DATA OR WAS GOING IN REVERSE
+       STL             /NO, BACKSPACE ONE RECORD
+SPACE, CLA CMA         /V3C DON'T TOUCH LINK
+       DCA ERFLAG      /ALL ERRORS ARE FATAL
+       RAR             /LINK ON MEANS REVERSE (READ BIT)
+       STL RAR
+       STL RAR
+UNLOAD,        TAD P100        /ADD IN 'GO' BIT
+GOO,   JMS GO
+       JMP I NSTOP
+
+CONT,  ISZ COUNT       /V3C
+       JMP FILE2       /CONTINUE?
+       JMP I NSTOP     /CHECK FOR EOD BEFORE COUNT
+
+/FLAG .NE.  0 MEANS SAW DATA
+\fL6100,        6100
+P100,  100
+L7600, 7600
+
+SPEC,  CLA CMA         /V3C DON'T TOUCH LINK
+       DCA ERFLAG      /ALL ERRORS ARE NOW FATAL
+       SZL             /LINK STILL CONTAINS READ/WRITE BIT
+       STL CLA RTR
+       TAD L2100       /V3C
+       JMP GOO         /V3C
+
+REW,   DCA ERFLAG      /NO REWIND ERRORS
+       TAD (1000       /V3C
+       JMP UNLOAD      /V3C
+L200,  200
+       PAGE
+       $
+\f\v