sw/os8/v3d/sources/system/dectapes/dectape3/RWTAPE.SB

   1 /DECTAPE I-O ROUTINES                         OS8 FORTRAN II LIBRARY
   2 /
   3 /
   4 /
   5 /
   6 /
   7 /
   8 /
   9 /
  10 /
  11 /COPYRIGHT  (C)  1974,1977 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 MANUAL.
  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 \f/      VERSION 2A
  46 /
  47 /       CALL 4, RTAPE(WTAPE)
  48 /       ARG UNIT
  49 /       ARG +-BLOCK (-MEANS START SEARCH FORWARD)
  50 /       ARG WORD COUNT
  51 /       ARG CORE ADDRESS
  52 /       VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
  53 /
  54         ENTRY   RTAPE
  55         ENTRY   WTAPE
  56         DUMMY WCT
  57         DUMMY CAD
  58         OPDEF TADI 1400
  59         OPDEF DCAI 3400
  60
  61         LAP             /ENABLE FIT INTO 1 PAGE
  62 /
  63 /DATA
  64 /
  65 DFUNC,  0
  66 DBLK,   0
  67 DWCT,   0
  68 DFIELD, 0
  69 WCT,    7754
  70 CAD,    7755
  71 DCORE,
  72 /
  73 /ARG PICKUP ROUTINE
  74 /
  75 GETARG, 0
  76         TAD I   RTAPE
  77         DCA     AA
  78         INC     RTAPE#
  79         TADI    RTAPE#
  80         DCA     WTAPE#
  81         INC     RTAPE#
  82 AA,     NOP             /SET DATA FIELD
  83         TADI    WTAPE#
  84         JMP I   GETARG
  85 /
  86 /ERROR
  87 /
  88 DTERR,  CALL    1,ERROR                 /CK FOR ERROR
  89         ARG     TAPERR
  90 /
  91 /DATA
  92 /
  93 /
  94 /START
  95 /
  96 WTAPE,  BLOCK   1
  97         2
  98         TAD     WTAPE           /MOVE ARG ADDR TO RTAPE
  99         DCA     RTAPE
 100         TAD     WTAPE#
 101         DCA     RTAPE#
 102         IAC                     /WRITE FUNCTION
 103         JMP     TARGS
 104 TAPERR, 2401                    /TA
 105         2005                    /PE
 106 RTAPE,  BLOCK   1
 107         2
 108 TARGS,  DCA     DFUNC           /READ=0, WRITE=1
 109         JMS     GETARG          /GET UNIT #
 110         CLL RTR                 /TO BITS 0-2
 111         RTR
 112         TAD     DFUNC           /COMBINE WITH R-W BIT
 113         DCA     DFUNC
 114         JMS     GETARG          /GET BLK #
 115         SMA
 116         JMP     RT2             /REV. SRCH.
 117         CIA                     /FORWARD SRCH.
 118         DCA     DBLK
 119         JMP     RT3
 120 RT2,    DCA     DBLK
 121         TAD     (400            /REV. SRCH. BIT
 122         TAD     DFUNC
 123         DCA     DFUNC
 124 RT3,    JMS     GETARG          /GET W.C.
 125         CIA
 126         DCA     DWCT
 127         JMS     GETARG          /GET CORE ADDR
 128         CLA CMA
 129         TAD     WTAPE#
 130         DCA     DCORE
 131         TAD     AA              /GET CORE FIELD
 132         DCA     DFIELD
 133 /
 134 /DEFINITIONS
 135 /
 136 OPDEF   DTCA    6762
 137 OPDEF   DTXA    6764
 138 OPDEF   DTLB    6774
 139 OPDEF   DTRB    6772
 140 SKPDF   DTSF    6771
 141 OPDEF   DTRA    6761
 142 /
 143 /START OF DECTAPE I-O
 144 /
 145         TAD     DFUNC           /UNIT & DIRECTION
 146         AND     (7400
 147         TAD     (10             /+ SRCH MODE
 148         DTCA DTXA               /SET STATUS & CLR FLGS
 149         DTLB                    /CLR FIELD BITS
 150         TAD     WCT             /USE 7754 AS ADDR TO
 151         6201            /SET FIELD 0
 152         DCAI    CAD             /STORE BLK FOUND
 153 DTSERR, RTL                     /REENTRY FOR SRCH ERROR
 154         RAL                     /ENDZONE FLAG TO LINK
 155         CLA CML                 /CHANGE DIRECTION
 156         TAD     (200            /DTA GO FLAG
 157 DTCONT, SNL                     /CK DIR.
 158 DTREV,  TAD     (400            /CHANGE DIR.
 159 DTSRCH, DTXA                    /GO INTO SEARCH
 160         DTSF DTRB               /READ CONDITION
 161         JMP     DTSRCH#
 162         SPA
 163         JMP     DTSERR          /ERROR
 164         DTRA                    /GET CUR. DIR.
 165         RTL                     /TO LINK
 166         RTL
 167         SZL CLA
 168         TAD     (3              /FOR REV GET BLK-3
 169         6201
 170         TADI    WCT             /# OF LAST BLK SEEN
 171         CMA                     /CIA MIGHT BLOW THE LINK
 172         TAD     DBLK
 173         CMA
 174         SZA CLA
 175         JMP     DTCONT          /CONT. SRCH
 176         SZL                     /FOUND, CK DIR.
 177         JMP     DTREV           /IF REV, SNEAK BACK UP
 178         TAD     DWCT            /SET WORD COUNT
 179         DCAI    WCT
 180         TAD     DCORE
 181         DCAI    CAD
 182 LABEL,  TAD     DFIELD          /LOAD FIELD BITS
 183         DTLB
 184         IAC                     /GET R-W FUNCTION
 185         AND     DFUNC
 186         CLL RTL
 187         RTL
 188         TAD     (130            /SET UP FUNCTION FOR
 189                                 /THE XOR TO GIVE SRCH
 190                                 /MODE CLEARED & SET CONTINUOUS MODE
 191                                 /READ=3, WRITE=5
 192         DTXA                    /BEGIN TRANSFER
 193 DTWAIT, DTSF                    /WAIT FOR W.C. OVERFLOW
 194         JMP     DTWAIT
 195         DTRA
 196         AND     (200            /STOP-GO BIT
 197         TAD     (2              /SAVE DTA & ERROR FLAGS
 198         DTXA                    /STOP TAPE
 199         DTRB                    /READ ERROR FLAGS
 200         SPA CLA                 /CK FOR ERROR
 201         JMP     DTERR           /YES
 202         RETRN   RTAPE
 203         END
 204 \f