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

   1 /8      DUMP LPT HANDLER FOR OS/8
   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 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 \f/      EDIT HISTORY:
  85
  86 /       1976            S.R.    ORIGINALLY WRITTEN
  87 /       19-MAR-77       S.R.    FIXED BUG WITH BUFFER ENDING AT 7777
  88
  89         *0
  90
  91         -1
  92         DEVICE DUMP;DEVICE DUMP;1360;DUMP&177+4000;ZBLOCK 2
  93
  94         DMPVER="C&77
  95 \f       *200
  96
  97 LINK,   0               /POINTS TO 'LINC' ON NEXT PAGE
  98         TAD I DUMP      /GET FUNCTION CONTROL WORD
  99         DCA FNWD
 100         ISZ DUMP        /POINT TO BUFFER STARTING ADDRESS
 101         TAD I DUMP      /GET BUFFER STARTING ADDRESS
 102         DCA BUFFER
 103         ISZ DUMP        /POINT TO STARTING BLOCK #
 104         TAD I DUMP      /GET STARTING BLOCK NUMBER
 105         DCA BLOCK       /SAVE IT IN 'BLOCK'
 106         ISZ DUMP        /POINT TO  USER'S ERROR RETURN
 107         RDF
 108         TAD KCIDF       /FOR 'CIF CDF' TO USER'S FIELD
 109         DCA DMPRET      /NEED IT TO RETURN TO HIM LATER
 110         TAD FNWD        /LOOK AT FUNCTION WORD
 111         SMA             /BIT 0 IS READ/WRITE BIT
 112         JMP ERRET       /TAKE FATAL ERROR IF GUY TRIED TO
 113                         /READ FROM 'DUMP'
 114         AND L3700
 115         CLL RTR
 116         SNA
 117         JMP CLOSE       /0 PAGES MEANS PERFORM CLOSE
 118                         /OPERATION, GO AWAY
 119         CIA             /STORE AWAY NEGATIVE OF
 120                         /NUMBER OF LINES TO DUMP
 121         DCA KNT
 122         TAD FNWD        /LOOK SOME MORE AT ALL-IMPORTANT
 123                         /FUNCTION WORD
 124 L374,   AND L70         /ISOLATE FIELD OF BUFFER
 125         TAD KCDF        /FORM 'CDF' TO FLD OF BUFFER
 126         DCA .+1         /STORE IT IN NEXT LOCATION
 127 FNWD,
 128 BPTR,   HLT             /CHANGE DATA FIELD TO FLD OF BUFFER
 129 B,      TAD M40
 130         DCA RKNT
 131         JMS I LINK
 132         TAD LOW-200
 133         CIA CLL
 134         TAD BLOCK
 135         SZL CLA
 136         TAD KLLS
 137         JMS I LINK
 138         DCA LPUT+1-200
 139         TAD BLOCK
 140         JMS I LINK
 141         JMP BLK-200
 142         JMS I LINK
 143         JMP CRLF-200
 144 A,      JMS INIT
 145         TAD RKNT
 146         TAD L40         /MUST BE REAL 40
 147         JMS I LINK
 148         JMS PRINT-200
 149         TAD KSLASH
 150         JMS I LINK
 151         JMP SPACE-200
 152 C,      TAD I BPTR      /GET WORD FROM BUFFER
 153         JMS I LINK
 154         JMS PRINT-200   /PRINT IT IN OCTAL ON LIST DEVICE
 155         ISZ BPTR        /POINT TO NEXT WORD IN BUFFER
 156         NOP             /V3D
 157         ISZ CKNT        /DONE WITH THIS ROW?
 158         JMP C           /NO, GO PRINT NEXT WORD
 159         JMS I LINK
 160         JMP SPACE-200
 161         JMS INIT
 162 D,      TAD I BPTR
 163         RTR
 164         RTR
 165         RTR
 166         JMS I LINK
 167         JMP PUT6-200
 168         TAD I BPTR
 169         JMS I LINK
 170         JMP PUT6-200
 171         ISZ BPTR        /POINT TO NEXT WORD IN BUFFER
 172         NOP             /V3D
 173         ISZ CKNT        /DONE WITH THIS ROW?
 174         JMP D           /NO, GO ON TO NEXT WORD
 175         JMS I LINK
 176         JMP SPACE-200
 177         JMS INIT
 178 E,      TAD I BUFFER    /GET WORD 1 OF PAIR
 179         JMS I LINK
 180         JMP PUTSAV-200  /PUT OUT THE CHAR AND SAVE THE WORD
 181         ISZ BUFFER      /POINT TO WORD 2 OF PAIR
 182         TAD I BUFFER    /GET WORD 2 OF PAIR
 183         JMS I LINK
 184         JMP PUTSAV-200
 185         ISZ BUFFER      /POINT TO BEGIN OF NEXT PAIR
 186         JMS I LINK
 187         JMP THIRD-200   /PRINT THIRD CHAR FROM
 188                         /REMEMBRANCES OF LAST TWO
 189         ISZ CKNT
 190         ISZ CKNT        /DONE WITH THIS ROW?
 191         JMP E           /NO, GO ON TO NEXT PAIR
 192         JMS I LINK      /YES
 193         JMP CRLF-200    /PRINT CARRIAGE RETURN/LINE FEED
 194         ISZ KNT         /DONE WITH BUFFER YET?
 195         SKP             /NO
 196         JMP OKRET       /YES
 197         ISZ RKNT        /DONE WITH LAST ROW OF PAGE?
 198         JMP A           /NO, GO ON TO NEXT ROW IN SAME PAGE
 199         ISZ BLOCK       /BUMP BLOCK NUMBER BY 1
 200         JMP B           /GO DUMP THE NEXT PAGE
 201 \fCLOSE, STA             /-1 CHANGES CR TO FORM FEED
 202         JMS I LINK
 203         JMP CRLF-200
 204 OKRET,  ISZ DUMP        /POINT TO NORMAL RETURN
 205 M40,    SMA SZA CLA     /AC 0 SO ALWAYS SKIPS
 206 ERRET,  STL CLA RAR     /FATAL ERROR HAS AC NEGATIVE
 207 DMPRET, HLT             /PERFORM 'CIF CDF' TO USER'S FIELD
 208         JMP I DUMP      /RETURN
 209
 210 INIT,   0
 211         TAD M10
 212         DCA CKNT
 213         TAD BUFFER
 214         DCA BPTR
 215         JMP I INIT
 216
 217 KSLASH, 57-40
 218 KCIDF,  CIF CDF 0
 219 KCDF,   CDF 0
 220 M10,    -10
 221 L40,    40              /MUST BE REAL 40
 222 L3700,  3700
 223 BUFFER, 0
 224 RKNT,   0               /ROW COUNT
 225 CKNT,   0               /COLUMN COUNT
 226 BLOCK,  0               /CURRENT BLOCK NUMBER
 227 KLLS,   LLS
 228         IFZERO .-375&4000 <ERROR>
 229         *374
 230 L70,    70              /MUST BE AT REL LOC 174
 231 KNT,    0               /- NUMBER OF PAGES LEFT TO DUMP
 232         IFNZRO L70-374 <ERROR>
 233 DUMP,   DMPVER
 234         JMS LINK        /GET ADDRESS OF NEXT PAGE INTO LINK
 235         IFNZRO .-400 <ERROR>
 236         PAGE
 237 \f       LSF=6661        /SLIP ON LPT FLAG
 238         LLS=6666        /LOAD LPT BUFFER
 239
 240         IFDEF   DMPTTY  <
 241         LSF=TSF
 242         LLS=TLS
 243         >
 244
 245 LINC,   0
 246         DCA ARG
 247         RDF
 248         TAD HCDF
 249 TTY12,  DCA TEMP
 250 HCDF,   CDF 0
 251         TAD I LINC
 252         DCA DOIT
 253         ISZ LINC
 254 L77,    77
 255 TEMP,   0
 256         TAD ARG
 257 CNT,
 258 DOIT,   HLT
 259 POP,    JMP I LINC      /RETURN
 260 L177,   177
 261         IFNZRO  POP&177-15 <ERROR> /MUST BE AT 15 IN PG
 262         IFNZRO DOIT&177-14 <ERROR>
 263         IFNZRO TEMP&177-12 <ERROR>
 264
 265 THIRD,  TAD SAVE
 266         DCA ARG
 267         TAD ARG
 268 PUTSAV, AND L7600
 269         CLL RAL
 270         TAD SAVE
 271         RTL
 272         RTL
 273         AND L177
 274         DCA SAVE
 275         TAD ARG
 276         AND L177        /FORCE 7-BIT
 277         TAD M140        /DO RANGE CHECK
 278         CLL
 279         TAD (100        /FOR BETWEEN 40 AND 137
 280         SNL             /SKIP ON SUCCESS
 281 TTY40,
 282 M140,   SZA CLA         /NEVER SKIPS
 283 PUTSPC, TAD TTY40       /RESTORE CHAR OR BLANK
 284 PUTPOP, JMS LPUT
 285 TTY215, JMP POP
 286 \fLPUT,  0
 287         NOP             /THIS MAY BE AN 'LLS' OR 0
 288 L7600,  7600            /CLA
 289 KBD,    KSF
 290         JMP CHECKL
 291         TAD L7600
 292         KRS
 293         TAD (-7603
 294         SNA CLA
 295         JMP CTRLC
 296         KRB
 297         TLS
 298         AND L177
 299         TAD (-15
 300         SNA
 301         JMP CR
 302         TAD (15-70
 303         CLL
 304         TAD (10
 305         DCA TEMP
 306         SNL
 307         JMP NOT         /NOT A DIGIT
 308         TAD NUM
 309         CLL RAL
 310         CLL RAL
 311         CLL RAL
 312         TAD TEMP
 313         DCA NUM
 314         JMP CHECKL
 315 CTRLC,  CIF CDF 0
 316         JMP I L7600
 317 CR,     TAD NUM
 318         DCA LOW
 319         TAD (12-77
 320 NOT,    TAD L77
 321         TSF
 322         JMP .-1
 323 XTRA,   TLS
 324         CLA
 325         DCA NUM
 326 CHECKL, LSF
 327         JMP KBD
 328         JMP I LPUT      /YES, RETURN
 329 NUM,    0
 330 LOW,    0
 331 \fPUT6,  TAD TTY40
 332         AND L77
 333         JMP PUTSPC
 334
 335 PRINT,  0
 336         DCA ARG
 337         TAD TTY40
 338         JMS LPUT
 339         TAD (-4
 340         DCA CNT
 341 PRLUP,  TAD ARG
 342         AND L7600
 343         CLL RTL
 344         TAD L214        /14 SHIFTS TO 60
 345                         /AND L214 HAS AC0 = 0
 346         RTL
 347         JMS LPUT
 348         TAD ARG
 349         RTL
 350         RAL
 351         DCA ARG
 352         ISZ CNT         /BUG IF TRY TO USE AS L214
 353         JMP PRLUP
 354         JMP I PRINT
 355 L214,   214             /COULD BE 'AND CNT'
 356
 357 SAVE,   0               /MUST BE DEDICATED.  USED AS SHIFT
 358                         /REG AND MUST BE ALMOST 0 ON ENTRY
 359 \fARG,   0
 360
 361 SPACE,  TAD TTY40
 362         JMS LPUT
 363         JMP PUTSPC
 364
 365 BLK,    SNA CLA
 366         DCA LOW         /BLOCK 0 INITIALIZATION
 367         TAD L214        /FORM FEED
 368         JMS LPUT
 369         TAD ARG
 370         JMS PRINT
 371 /       TAD (-10
 372 /       DCA TEMP
 373 /       TAD TTY3
 374 /       JMS SPACE
 375 /LUP,   TAD TEMP
 376 /       TAD (10         /MUST BE REAL 10
 377 /       JMS PRINT
 378 /       ISZ TEMP
 379 /       JMP LUP
 380 CRLF,   TAD TTY215
 381         JMS LPUT
 382         TAD TTY12
 383         JMP PUTPOP
 384         PAGE
 385 \f