sw/os8/v3d/sources/system/dectapes/dectape3/CS.PA

   1 /4 OS/8 CASSETTE HANDLER
   2 /
   3 /
   4 /
   5 /
   6 /
   7 /
   8 /
   9 /
  10 /
  11 /COPYRIGHT  (C)  1974,1975 BY DIGITAL EQUIPMENT CORPORATION
  12 /
  13 /
  14 /
  15 /
  16 /
  17 /
  18 /
  19 /
  20 /
  21 /
  22 /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
  23 /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
  24 /CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
  25 /FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
  26 /
  27 /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
  28 /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
  29 /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
  30 /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
  31 /
  32 /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
  33 /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
  34 /DIGITAL.
  35 /
  36 /
  37 /
  38 /
  39 /
  40 /
  41 /
  42 /
  43 /
  44 /
  45
  46 /       DEC-S8-UCASA-A-LA
  47
  48 /       COPYRIGHT 1972
  49
  50 /       DIGITAL EQUIPMENT CORPORATION
  51
  52 /       MAYNARD MASSACHUSETTS   01754
  53
  54 /       MOUTH/DORP
  55
  56         IFNDEF CODE <CODE=0>
  57
  58         KCLR=CODE^10+6700       /CLEAR ALL
  59         KSDR=CODE^10+6701       /SKIP ON DATA FLAG
  60         KSEN=CODE^10+6702       /SKIP ON ERROR
  61         KSBF=CODE^10+6703       /SKIP ON READY FLAG
  62         KLSA=CODE^10+6704       /LOAD STATUS A
  63         KSAF=CODE^10+6705       /SKIP ON ANY FLAG OR ERROR
  64         KGOA=CODE^10+6706       /ASSERT CONTENTS OF STATUS A AND XFER
  65         KRSB=CODE^10+6707       /READ STATUS B
  66
  67         BSW=7002        /BYTE SWAP      [8/E,F ONLY]
  68
  69 /REWIND=10
  70 /BACKFIL=30
  71 /WRGAP=40
  72 /BACKBLOCK=50
  73 /SKPFIL=70
  74
  75 /SPECIAL CODES
  76
  77 /       0       WRITE EOF
  78 /       1       REWIND
  79 /       2       BACKBLOCK
  80 /       3       SKIPFILE/BACKFILE
  81
  82 /       4-7     UNUSED (TAKES LOW ORDER 2 BITS ONLY CURRENTLY)
  83
  84         VERSION="C&77
  85 \f       *0
  86
  87         -2              /THERE ARE TWO HANDLERS
  88
  89         2401
  90         7001+CODE
  91         0323
  92         0160+CODE+CODE  /CSA0
  93         270             /DEVICE CONTROL BLOCK (TYPE 27)
  94         4000+7          /ENTRY POINT FOR CSA0
  95         ZBLOCK 2
  96
  97         2401
  98         7001+CODE
  99         0323
 100         0161+CODE+CODE  /CSA1
 101         270
 102         4000+1          /ENTRY POINT FOR CSA1
 103         ZBLOCK 2
 104 \f       *200
 105
 106 K3700,  3700            /MUST BE FIRST LOCATION ON PAGE
 107 UNIT,
 108 CSA1,   VERSION         /ENTRY POINT FOR CSA1
 109         CLA             /PROTECT CODE AGAINST IGNORANT USERS
 110         TAD CSA1        /PICK UP ARGUMENTS
 111         DCA CSA0        /VIA CSA0
 112         STL IAC RAL     /TAD (3         [8/I,L,E,F]
 113         JMP .+3         /JOIN PROCESSING WITH UNIT 1
 114 CSA0,   VERSION         /ENTRY POINT FOR CSA0
 115         STL CLA RTL     /TAD (2
 116         BSW             /               [8/E,F]
 117         DCA UNIT        /SAVE UNIT (0 IS 200, 1 IS 300)
 118 CS,     JMS T           /INITIALIZATION; REPLACED BY RDF
 119         TAD KCIF        /FORM RETURN FIELD INSTRUCTION
 120         DCA RETCIF      /STORE IN RETURN CODE
 121         TAD I CSA0      /GET FUNCTION CONTROL WORD
 122         DCA FUN         /SAVE IT
 123         TAD FUN         /GET IT BACK AGAIN
 124         AND K70         /ISOLATE FIELD OF BUFFER
 125         TAD KCDF        /FORM CDF TO FIELD OF BUFFER
 126         DCA BUFCDF      /STORE IN APPROPRIATE SPOT
 127         ISZ CSA0        /POINT TO ARGUMENT 2
 128         TAD I CSA0      /GET BUFFER ADDRESS
 129         DCA BUFFER      /SAVE IT
 130         ISZ CSA0        /POINT TO ARGUMENT 3
 131         TAD I CSA0      /GET BLOCK NUMBER
 132         ISZ CSA0        /POINT TO ERROR RETURN
 133 KCIF,   CIF CDF 0       /SEEK TEMPORARY SAFETY IN CURRENT DATA FIELD
 134         SZA CLA
 135         JMP NOT1ST      /NOT BLOCK 0
 136         STL CLA RAR     /TAD (4000
 137         AND FUN         /ISOLATE READ/WRITE BIT
 138         TAD UNIT        /INSERT UNIT
 139         JMS I QCAS      /CALL CASSETTE ROUTINE
 140         REWIND-.        /TO PERFORM A REWIND/INITIALIZATION
 141 NOT1ST, TAD FUN
 142 K200,   AND K3700       /ISOLATE NUMBER OF BLOCKS TO XFER
 143         SNA
 144         JMP SPCASE      /0 BLOCKS MEANS SPECIAL THING (EOF)
 145 RECLP,  DCA BLKNT       /SET COUNT OF NUMBER OF BLOCKS
 146         STL CLA RAR     /TAD (4000
 147         AND FUN         /ISOLATE READ/WRITE BIT
 148         TAD UNIT        /INSERT UNIT
 149         JMS I QCAS      /CALL CASSETTE ROUTINE
 150         RW-.            /TO INITIATE READ OR WRITE
 151 RETRY,  SZA             /NON-ZERO AC MEANS ERROR
 152         JMP RETCIF      /TOUGH LUCK BOOBIE - ERROR
 153         TAD K7700       /GET READY TO XFER 100 DOUBLE WORDS
 154         DCA DBWDCT      /SET DOUBLE WORD COUNTER
 155         TAD BUFFER      /GET START OF BUFFER SEGMENT
 156         DCA BPTR        /SET 'BPTR'
 157 BUFCDF, HLT             /CHANGE TO DATA FIELD OF USER'S BUFFER
 158         TAD FUN
 159 K7700,  SMA CLA         /WHICH DIRECTION IS TRANSFER?
 160         JMP READ        /WANT TO READ
 161 \fWRITE, TAD I BPTR      /WANT TO WRITE, SO GET WORD FROM BUFFER
 162         JMS I QGPCH     /WRITE
 163         TAD I BPTR      /GET FIRST WORD AGAIN
 164         AND P7400       /ISOLATE FIRST HALF OF BYTE 3
 165         DCA T           /SAVE FOR FUTURE REFERENCE
 166         ISZ BPTR        /POINT TO NEXT LOCATION IN BUFFER
 167         TAD I BPTR      /GET SECOND WORD OF BUFFER PAIR
 168         JMS I QGPCH     /WRITE BYTE #2
 169         TAD I BPTR      /RETRIEVE WORD 2
 170         AND P7400       /ISOLATE 2ND HALF OF BYTE #3
 171         CLL RTR         /CREATE MYSTIC HIDDEN BYTE 3
 172         RTR
 173         TAD T           /GOOD THING I STILL HAVE THIS
 174         CLL RTR
 175         RTR
 176         JMS I QGPCH     /WRITE BYTE #3
 177         JMP COM
 178 \fREAD,  JMS I QGPCH     /READ BYTE #1 OF TRIPLE
 179         DCA I BPTR      /STORE IN WORD 1 OF BUFFER PAIR
 180         JMS I QGPCH     /READ BYTE #2 OF TRIPLE
 181         DCA T           /SAVE IT FOR POSTERITY
 182         JMS I QGPCH     /READ BYTE #3 OF TRIPLE
 183         RTL
 184         RTL             /MYSTIC ROTATES
 185         DCA T2
 186         TAD T2
 187         AND P7400       /AND MYSTIC CONSTANTS
 188         TAD I BPTR      /FIX UP BUFFER WORD 1 OF PAIR
 189         DCA I BPTR
 190         TAD T2
 191         RTL
 192         RTL             /MORE ROTATION
 193         AND P7400       /AND MORE
 194         TAD T
 195         ISZ BPTR        /POINT TO SECOND WORD OF BUFFER PAIR
 196         DCA I BPTR      /STORE SECOND WORD
 197 COM,    ISZ BPTR        /POINT TO BEGIN OF NEXT BUFFER PAIR
 198 P7400,  7400            /PROTECTION AGAINST CORE WRAP AROUND
 199         ISZ DBWDCT      /BUMP DOUBLE WORD COUNT
 200         JMP BUFCDF      /REITERATE
 201         JMS I QCAS      /CALL CASSETTE ROUTINE
 202         CRC-.           /TO CHECK CRC
 203         TAD BUFFER      /GET BUFFER SEGMENT ADDRESS
 204         TAD K200        /ADD 200 TO GET TO NEXT SEGMENT
 205         DCA BUFFER      /REPLACE
 206         TAD BLKNT       /GET BLOCK COUNT
 207         TAD K7700       /SUBTRAT 100
 208         SZA             /ARE WE DONE?
 209         JMP RECLP       /NO, REITERATE
 210         ISZ CSA0        /POINT TO NORMAL GOOD RETURN
 211 RETCIF, HLT             /RETURN TO USER'S DATA AND INSTRUCTION FIELDS
 212         JMP I CSA0      /RETURN
 213 \f/      INTIALIZATION ROUTINE - ONCE ONLY CODE
 214 /               OVERLAID BY TEMPORARIES
 215
 216 T,      0               /ENTRY POINT TO INITIALIZATION
 217 T2,     TAD KRDF        /REPLACE CALL BY RDF
 218 FUN,    DCA CS          /SO THAT WE'LL NEVER SEE YOU HERE AGAIN
 219 BUFFER, TAD T           /CORRECT ADDRESS OF GPCH
 220 DBWDCT, TAD KQX1        /BY ADDING IN CS+1
 221 QGPCH,  DCA .           /STORE IT HERE
 222 BLKNT,  STL CLA RTL     /CORRECT ADDRESS OF CAS IS 2 MORE
 223         TAD QGPCH
 224 QCAS,   DCA .           /THAN GPCH.  STORE IT HERE.
 225 BPTR,   JMP CS          /RETURN TO MAIN PROGRAM
 226 KRDF,   RDF
 227 KQX1,   GPCH-CS-1
 228
 229 SPCASE, TAD FUN
 230         AND L4003       /ISOLATE R/W BIT + SPECIAL CODE
 231         TAD UNIT
 232         JMS I QCAS
 233         SPCODE-.
 234         JMP RETCIF-1    /LEAVE GRACEFULLY
 235 K70,    70
 236 KCDF,   CDF 0
 237 L4003,  4003
 238         PAGE
 239 \fGPCH,  0               /READ OR WRITE A BYTE
 240         JMP AROUND      /GO TO REAL LOCATION OF THIS SUBROUTINE
 241 CAS,    0               /MUST BE AT GPCH+2; DO CASSETTE STUFF
 242         DCA TEMP        /SAVE ARGUMENT IN AC
 243         CDF 0
 244         TAD I CAS       /GET UNRELOCATED RELATIVE LOCAL ENTRY POINT
 245         TAD CAS         /RELOCATE IT
 246         ISZ CAS         /POINT TO NORMAL RETURN LOCATION
 247         DCA GPCH        /SAVE ENTRY POINT IN TEMPORARY
 248         JMP I GPCH      /GO TO CORRECT ENTRY POINT
 249
 250 RW,     TAD CAS
 251         DCA RTRY        /SAVE RETRY ADDRESS
 252         TAD TEMP        /GET ARGUMENT PASSED VIA AC
 253         DCA FNUNIT      /SAVE
 254         CLL STA RTL     /TAD (7775
 255         DCA ERKNT       /SET ERROR COUNT TO -3
 256 ERETRY, TAD FNUNIT
 257         SPA
 258         TAD (20         /READ CODE IS 0; WRITE IS 20
 259         KLSA            /LOAD STATUS A
 260         TAD FNUNIT      /***KLSA CLEARS BIT 0
 261         SMA CLA         /READS HAVE TO BE INITIATED
 262         JMS CWAIT       /READ
 263         JMP I RTRY      /RETURN
 264
 265 AROUND, DCA TEMP
 266         TAD FNUNIT
 267         SMA CLA
 268         JMP RDCHAR      /READ
 269         TAD TEMP        /WRITE
 270         JMS CWAIT
 271         JMP I GPCH      /RETURN
 272
 273 RDCHAR, JMS CWAIT
 274         TAD TEMP        /GET CHAR JUST READ
 275         JMP I GPCH      /RETURN WITH IT IN AC
 276 \fCRC,   TAD FNUNIT
 277         TAD (60
 278         KLSA            /INITIATE READ/WRITE CRC
 279         TAD FNUNIT      /***KLSA CLEARS BIT 0
 280         SMA CLA
 281         JMS CWAIT       /HAVE TO READ TWICE
 282         JMS CWAIT       /WRITE CRC WRITES BOTH
 283         KCLR            /WHY NOT?
 284         JMP I CAS       /RETURN
 285
 286 REWIND, TAD (10
 287         JMS UTIL
 288         TAD TEMP
 289         SMA CLA
 290         JMP I CAS       /MERELY REWIND IF READING
 291         JMP EOF
 292 SKIPF,  TAD (20
 293 BACKBL, TAD (10
 294 EOF,    TAD (10
 295 BACKF,  TAD (30
 296         JMS UTIL
 297         JMP I CAS       /RETURN
 298
 299 UTIL,   0
 300         TAD TEMP
 301         KLSA
 302 TRYAGN, KGOA
 303         JMS CTCTST
 304         KSBF            /WAIT FOR READY
 305         JMP .-2
 306         KRSB
 307         AND (10
 308         SZA CLA
 309         JMP TRYAGN      /KEEP TRYING IF ERROR CAUSED BY DRIVE EMPTY
 310         JMP I UTIL
 311
 312 TEMP,   0
 313 ERKNT,  0
 314 FNUNIT, 0
 315 RTRY,   0
 316
 317 SPCODE, TAD TEMP
 318         AND (3
 319         TAD (JMP TABLE
 320         DCA J
 321         TAD TEMP
 322         AND (4300
 323         DCA TEMP
 324 J,      HLT
 325 TABLE,  JMP EOF         /0 WRITE EOF
 326         JMP REWIND      /1 REWIND AND WRITE EOF IF BIT 0=1
 327         JMP BACKBL      /2 BACK BLOCK
 328         TAD TEMP        /3 SKIP/BACK FILE DEPENDING ON BIT 0
 329         SMA CLA
 330         JMP SKIPF       /FORWARD FILE
 331         JMP BACKF       /BACK FILE
 332 \fCWAIT, 0
 333         KGOA            /ASSERT CONTENTS OF STATUS A
 334         DCA TEMP        /SAVE ANYTHING READ
 335         JMS CTCTST
 336         KSAF
 337         JMP .-2         /WAIT FOR SOMETHING TO HAPPEN
 338         KSEN            /WAS IT AN ERROR?
 339         JMP I CWAIT     /NO, SO RETURN
 340 ERR,    DCA TEMP        /YES ... ERROR
 341         KRSB
 342         AND (30
 343         SNA
 344         JMP .+3
 345         AND (20
 346         JMP I RTRY      /END OF FILE IS SOFT ERROR
 347         ISZ ERKNT       /SHALL WE TRY AGAIN?
 348         JMP .+3         /YES
 349         STL CLA RAR     /TAD (4000
 350         JMP I RTRY      /RETURN WITH NON-ZERO AC
 351         TAD FNUNIT      /RETRY
 352         TAD (50         /BUT FIRST DO BACKSPACE BLOCK GAP
 353         JMS UTIL
 354         JMP ERETRY
 355
 356 CTCTST, 0               /TEST FOR CONTROL/C
 357 L7600,  7600
 358         TAD L7600
 359         KRS
 360         TAD (-7603
 361         SNA CLA
 362         KSF
 363         JMP I CTCTST
 364         CIF CDF 0
 365         JMP I L7600     /RETURN TO OS/8
 366         $
 367 \f