sw/os8/v3d/sources/system/dectapes/dectape5/DTCOPY.PA

   1 /DECTAPE COPY, V10
   2
   3 /
   4 /
   5 /
   6 /
   7 /
   8 /
   9 //
  10 /
  11 /
  12 /
  13 /
  14 /COPYRIGHT (C) 1966, 1975
  15 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
  16 /
  17 /
  18 /
  19 /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
  20 /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
  21 /SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
  22 /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
  23 /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
  24 /AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
  25 /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
  26 /
  27 /
  28 /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
  29 /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
  30 /EQUIPMRNT COROPATION.
  31 /
  32 /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
  33 /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
  34 /
  35 /
  36 /
  37 /
  38 /
  39 /
  40 \f/DECTAPE COPY
  41 /VERSION .B07
  42 /
  43 /
  44 /COPYRIGHT 1968 DIGITAL EQUIPMENT CORPORATION
  45 /       MAYNARD, MASS.  OCTOBER,1968
  46
  47
  48 \f
  49 / THIS PROGRAM COPIES A DECTAPE FROM ONE
  50 / SPECIFIED UNIT TO ANOTHER. ALL DECTAPE
  51 / ROUTINES ARE INTERNALLY GENERATED SO THAT
  52 / IT MAY BE RUN WITHOUT THE MONITOR SYSTEM.
  53 /
  54 / STARTING ADDRESS IS 200
  55 /
  56         DTRA=6761
  57         DTCA=6762
  58         DTXA=6764
  59         DTSF=6771
  60         DTRB=6772
  61         DTLB=6774
  62
  63         WC=7754
  64         CA=7755
  65 / THESE AREAS ARE USED BY DATA BREAK
  66 BUFIOT=1547     /INPUT OUTPUT BUFFER
  67 BUFCHK=4563     /RE-READ BUFFER
  68 /
  69 *20
  70 / PAGE ZERO WORKING STORAGE
  71 BADTRY, -3      /COUNT OF READ ERRORS
  72 CURBLK, 0       /CURRENT BLOCK NUMBER
  73 TRASH1, 0       /WORKING STORAGE
  74 TRASH2, 0       /WORKING STORAGE
  75 TRASH3, 0       /WORKING STORAGE
  76 BLKCNT, 0       /NUMBEROF BLOCKS TO READ
  77                 /OR MINUS THAT NUMBER
  78 SORBLK, 0       /STORAGE FOR CURBLK
  79 WORDS,  0       /NUMBER OF WORDS PER BLOCK
  80 INUNIT, 0       /INPUT UNIT IN LH OCT CHAR
  81 OUTUNI, 0       /OUTPUT UNIT IN LH OCT CHAR
  82 RESTOR, 0       /NUMBER OF WORDS TO COPY
  83 RESAVE, 0       /NEGATIVE OF BLKCNT
  84 SMICAR, 0       /CHARACTER STORAGE
  85 SMISUM, 0       /RUNNING SUM
  86 SPELIN, 0       /POINTER
  87 SEAZIK, 0       /INPUT AREA
  88 SEAZOK, 0       /TEMP STORAGE
  89 DECTWC, 0       /FLAG TO DETERMINE IF VALIDATION WILL OCCUR
  90 DECTCA, 0       /CURRENT ADDRESS STORE
  91 FIRST,  0       /STARTING BLOCK NUMBER
  92 LAST,   0       /LAST BLOCK NUMBER
  93 LENGTH, 0       /NUMBER OF WORDS TO COPY
  94 PARITY, 0               /PARITY ERROR FLAG (COUNT)
  95 MSKIN,  0               /NEGATIVE OF INUNIT
  96 PARDEL, PSTACK          /POINTER TO PARITY TABLE
  97 /
  98 / PAGE ZERO SUBROUTINES
  99 DIREC,  0
 100         CLA
 101         DTRA            /FIND DIRECTION
 102         AND [400
 103         SZA CLA         /BRANCH BACK
 104         ISZ DIREC       /REVERSE DIRECTION EXIT
 105         JMP I DIREC     /FORWARD DIRECTION EXIT
 106 /
 107 /
 108 BACKUP, 0               /SUBROUTINE REWINDS TAPE
 109         CLA
 110         DTRA
 111         AND (670        /CLEAR DIRECTION AND MOVEMENT
 112         DTXA
 113         TAD (600        /GO IN REVERSE
 114         DTXA
 115         DTSF
 116         JMP .-1         /WAIT UNTILL DONE
 117         JMS I [ERROR    /BUSYWORK FOR ERRORS
 118         JMP I BACKUP    /EXIT ON ENDZONE ERROR
 119         JMP BACKUP+1
 120 \f
 121 *200
 122 BEGIN,  CLA CLL /INITIALIZE
 123         DTLB
 124         TLS     /TELETYPE OUTPUT
 125         JMS I [SPEAK
 126         MESS0
 127         JMS I [SPEAK
 128         MESS1   /INPUT UNIT NUMBER
 129         JMS GETNUM      /CHECK INPUT UNIT NUMBER
 130         DCA INUNIT
 131         TAD INUNIT
 132         CIA             /SET UP INPUT UNIT MASK
 133         DCA MSKIN
 134         JMS I [SPEAK
 135         MESS2   /OUTPUT UNIT NUMBER
 136         JMS GETNUM
 137         TAD MSKIN       /MAKE SURE UNITS ARE DIFFERENT
 138         SNA
 139         JMP BEGIN       /INPUT ERROR
 140         TAD INUNIT
 141         DCA OUTUNI
 142         JMS I [SPEAK    /GET FIRST BLOCK NUMBER
 143         MESSA
 144         JMS I [SMIGIT
 145         NOP
 146         DCA CURBLK
 147         TAD CURBLK
 148         CIA     /STORE BEGINNING MARKER
 149         DCA FIRST
 150         JMS I [SPEAK    /GET LAST BLOCK NUMBER
 151         MESSB
 152         JMS I [SMIGIT
 153         CLA CMA /KLUDGE IF NO INPUT
 154         DCA LAST
 155         TAD FIRST
 156         CLL
 157         SZA
 158         TAD LAST        /MAKE SURE VALID
 159         SZA SNL CLA
 160         JMP BEGIN
 161         DTLB
 162         TAD INUNIT              /INIT INPUT UNIT
 163         JMS I [FIXTAP
 164         DCA WORDS               /SET UP BLOCK LENGTH
 165         TAD OUTUNI              /INIT OUTPUT UNIT
 166         JMS I [FIXTAP
 167         CIA                     /MAKE SURE BLOCK LENGTH
 168         TAD WORDS               /SAME ON INPUT AND OUTPUT
 169         SZA CLA
 170         JMP BADLEN              /BLOCK LENGTH ERROR
 171         JMS I [SPEAK            /TYPE OUT BLOCK LENGTH
 172         MESS3
 173         TAD WORDS
 174         JMS I [TYPNUM
 175         JMS I [SPEAK            /SEND <RETURN><LINE FEED>
 176         MESS0+11
 177         TAD WORDS
 178         CIA     /COMPUTE NUMBER OF BLOCKS
 179         DCA LENGTH      /TO READ AND WRITE
 180         DCA BLKCNT      /CLEAR BLOCK COUNTER
 181         TAD [3014       /LOAD BUFFER SIZE
 182         TAD LENGTH
 183         SPA
 184         JMP BADLEN      /TOO MANY WORDS PER BLOCK
 185         ISZ BLKCNT      /TALLY
 186         TAD LENGTH
 187         SMA
 188         JMP .-3 /CONTINUE COUNTING
 189         TAD WORDS       /GET NUMBER OF
 190         TAD [-3014      /WORDS TO READ
 191         CIA     /AND TO WRITE
 192         DCA RESTOR      /PRESERVE IN RESTOR
 193         TAD RESTOR
 194         DCA LENGTH
 195         TAD BLKCNT      /SAVE NEGATIVE OF BLKCNT
 196         CIA
 197         DCA RESAVE
 198         JMS I [SPEAK
 199         MESSC
 200         JMS I [SMIGIT
 201         NOP
 202         DCA DECTWC      /SET UP VERIFY FLAG
 203 /
 204 / MAIN LOOP FOR COPY
 205 LETS,   TAD CURBLK      /CHECK FOR PARTIAL BLOCK TO COPY
 206         TAD BLKCNT
 207         CLL CMA IAC
 208         TAD LAST
 209         SZL
 210         JMP LETT        /COPY FULL LENGTH
 211         DCA LENGTH      /ADJUST WORDS TO COPY
 212         TAD RESTOR
 213         CIA
 214         TAD WORDS
 215         ISZ LENGTH
 216         JMP .-2 /COMPUTE PROPER LENGTH
 217         CIA
 218         TAD WORDS
 219         DCA LENGTH
 220         TAD [REVERS     /KLUDGE COPY EXIT
 221         DCA I [COPY
 222         JMP I [COPY+1   /PERFORM THIS COPY
 223 LETT,   JMS I [COPY     /COPY THIS BLOCKS
 224         TAD BLKCNT
 225         TAD BLKCNT      /ADVANCE CURRENT BLOCK
 226         TAD CURBLK
 227         DCA CURBLK
 228         JMS DIREC
 229         JMP LETU        /FORWARD EXCEEDED CHECK
 230 LETR,   TAD CURBLK      /REVERSE CHECK
 231         TAD FIRST
 232         CMA
 233         SZA CLA         /CHECK FOR MINUS 1
 234         JMP LETT        /CONTINUE COPY
 235         JMP I [DONE     /FINISHED JOB
 236 LETU,   TAD CURBLK
 237         CLL CMA IAC
 238         TAD LAST
 239         SZL CLA /CHECK FOR END OF TAPE
 240         JMP LETS
 241         JMP I [REVERV
 242
 243
 244
 245
 246 / THIS SUBROUTINE GETS INPUT
 247 / AND OUTPUT UNIT NUMBERS FROM
 248 / THE TELETYPE AND VALIDATES THEM.
 249 /
 250 GETNUM, 0
 251         JMS I [SMIGIT
 252         NOP
 253         AND [7
 254         CLL RTR         /MOVE TO LH THREE BITS
 255         RTR
 256         JMP I GETNUM
 257 /
 258 /
 259
 260 BADLEN, JMS I [SPEAK            /BLOCK LENGTH ERROR
 261         MESS3A
 262         JMP BEGIN
 263 /
 264 /
 265 /
 266 PAGE
 267 \f
 268 /
 269 / THIS TURN AROUND IS ENTERRED
 270 / WHEN THE LAST COPY MOVED INTO
 271 /       THE FINAL DATA AREA
 272 REVERV, TAD LAST
 273         DCA CURBLK      /START OF COPY BACK
 274         JMS REVALT      /CHANGE INUNIT AND OUTUNI
 275         TAD INUNIT
 276         DTCA DTXA
 277         JMS I [RESET    /REPOSITION TAPE
 278         TAD OUTUNI
 279         DTCA DTXA
 280         JMS I [RESET    /REPOSITION TAPE
 281 REBACK, TAD CURBLK
 282         CMA     /COMPUTE NEW COPY LENGTH
 283         TAD SORBLK
 284         TAD BLKCNT
 285         SNA
 286         JMP REVERS      /KLUDGE IF NOTHING TO DO
 287         DCA SORBLK      /MINUS # OF BLOCKS
 288         TAD SORBLK
 289         DCA BLKCNT      /SAVE THIS NUMBER
 290         TAD WORDS
 291         ISZ SORBLK
 292         JMP .-2
 293         DCA LENGTH      /LENGTH FOR COPY
 294         JMS I [COPY     /PERFORM IT
 295         TAD CURBLK
 296         TAD BLKCNT
 297         TAD RESAVE      /ADVANCE CURBLK
 298         DCA CURBLK
 299         TAD RESAVE
 300         DCA BLKCNT
 301         TAD RESTOR
 302         DCA LENGTH
 303         JMP I [LETR     /CONTINUE COPY
 304 /
 305 /
 306 / THIS TURN AROUND IS ENTERRED
 307 / WHEN THE LAST SEARCH FOR
 308 / CURRENT BLOCK CAUSED AN END
 309 / OF TAPE ERROR
 310 /
 311 REVERT, JMS DIREC
 312         SKP
 313         JMP I [DONE     /FINISHED IF DIRECTION REVERSE
 314         TAD SORBLK
 315         DCA CURBLK      /RESTORE CURBLK
 316         TAD OUTUNI      /RESET LOCATION OF
 317         DTCA DTXA       /OUTPUT DECTAPE AND
 318         JMS I [RESET    /FIND LAST BLOCK
 319         TAD [4000       /BY LOOKING FOR IMAGINARY
 320         JMS I [SEARCH   /BLOCK NUMBER (KLUDGING SEARCH)
 321         NOP
 322         JMP .-3 /TRY AGAIN ON ERRORS
 323         TAD SEAZIK      /MUST BE LAST BLOCK NUMBER
 324         DCA CURBLK
 325         JMS REVALT      /CHANGE INUNIT AND OUTUNI
 326         JMP REBACK
 327 /
 328 /
 329 / THIS TURN AROUND IS ENTERRED WHEN THE
 330 / END BLOCK FOR COPY WAS REACHED BY A
 331 / PARTIAL BUFFER COPY.
 332 /
 333 REVERS, CLA CMA /ADJUST CURBLK POINTER
 334         TAD SORBLK
 335         DCA CURBLK
 336         TAD RESAVE
 337         DCA BLKCNT      /MAKE BLKCNT NEGATIVE
 338         TAD RESTOR
 339         DCA LENGTH      /RESTORE COPY LENGTH
 340         JMS REVALT      /CHANGE INUNIT AND OUTUNI
 341         JMP I [LETR
 342 /
 343 REVALT, 0
 344         TAD OUTUNI
 345         TAD [400
 346         DCA OUTUNI      /REVERSE DIRECTION
 347         TAD INUNIT
 348         TAD [400
 349         DCA INUNIT      /REVERSE DIRECTION
 350         JMP I REVALT
 351 /
 352 \f
 353 /THIS SUBROUTINE PERFORMS THE OPERATION
 354 /OF COPYING N BLOCKS AND VALIDATING
 355 /THE OUTPUT.
 356 /WHEN END OF TAPE IS REACHED THE ROUTINE
 357 /BRANCHES TO "REVERS", OR TO REVERT
 358 /AS APPROPRIATE.
 359 /
 360 COPY,   0
 361         KSF     /CHECK FOR <^C>
 362         JMP .+5
 363         KRB
 364         TAD [-203
 365         SNA
 366         JMP I [7600
 367         CLA
 368         TAD INUNIT      /LOAD STAT REG A
 369         DTCA DTXA
 370         TAD [-3
 371         DCA BADTRY      /RESTORE ERROR COUNTER
 372         JMS I [DECTAP
 373 COPO,   BUFIOT  /INPUT AREA
 374         30      /READ CODE
 375         NOP     /NORMAL RETURN
 376         TAD PARITY              /CHECK PARITY FLAG
 377         SZA
 378         JMP I [ERRPAR           /FIX MESSAGE FOR PARITY ERRORS
 379 COPZ,   TAD OUTUNI      /(IGNORE END ZONE)
 380         DTCA DTXA       /OUTPUT UNIT & DIRECTION
 381 COPYB,  JMS I [DECTAP   /WRITE OUTPUT TAPE
 382         BUFIOT  /OUTPUT BUFFER
 383         50      /WRITE CODE
 384         JMP COPCPR      /NORMAL RETURN
 385         TAD [REVERS     /END ZONE RETURN
 386         DCA COPY        /FIX UP EXIT
 387 COPCPR, TAD CURBLK
 388         DCA SORBLK      /STORE CURRENT BLOCK NUMBER
 389         TAD DECTWC
 390         SZA CLA
 391         JMP I COPY      /NO VERIFICATION
 392         JMS I [RESET    /RETURN TO FRONT END
 393         JMS I [DECTAP   /READ DATA
 394 COPR,   BUFCHK  /INPUT AREA
 395         30      /READ CODE
 396         JMP .+2 /NORMAL RETURN BRANCH
 397         TAD I [WC       /END ZONE RETURN
 398         TAD LENGTH
 399         CIA
 400         DCA TRASH3      /COUNTER
 401         TAD COPO
 402         DCA 17  /FORWARDS POINTER
 403         TAD COPR        /REREAD BUFFER
 404         DCA 16  /SET UP POINTER
 405 COPCML, TAD I 16
 406         CIA
 407         TAD I 17
 408         SZA
 409         JMP COPERR      /MISMATCH ON READ
 410         ISZ TRASH3      /ANY MORE WORDS
 411         JMP COPCML      /LOOP
 412         JMP I COPY      /MADE IT! EXIT
 413 COPERR, ISZ BADTRY      /HOW MANY ATTEMPTS
 414         JMP COPERS      /TRY AGAIN
 415         JMS I [SPEAK
 416         MESS5   /RE-READ ERRORS
 417         JMS I [TUNIT    /TYPE UNIT NUMBER AND WAIT
 418         TAD [-3
 419         DCA BADTRY      /RESTORE ERROR COUNTER
 420 COPERS, CLA
 421         JMS I [RESET
 422         JMP COPYB       /WRITE OUT BLOCK AGAIN
 423 /
 424 PAGE
 425 \f
 426 / THIS SUBROUTINE MOVES THE DECTAPE
 427 / BACK IN PREPARATION FOR ANOTHER
 428 / READ OR WRITE.
 429 /
 430 RESET,  0
 431         CLA CLL /CLEAR AC AND LINK
 432         TAD [400        /CHANGE DIRECTION
 433         DTXA
 434         JMS DIREC       /FIND DIRECTION
 435         TAD [6  /FORWARD MAKE +3
 436         TAD [-3 /REVERSE MAKE -3
 437         TAD CURBLK
 438         SPA     /MAKE SURE VALUE IS PLUS
 439         JMP RESEV
 440         JMS I [SEARCH   /FIND THIS BLOCK
 441         SKP CLA /FOUND IT
 442         JMP RESET+4
 443 REEXT,  DTRA
 444         AND [200        /CLEAR STOP-GO FLAG
 445         TAD [400        /AND REVERSE DIRECTION
 446         DTXA
 447         JMP I RESET
 448 RESEV,  JMS BACKUP      /REWIND THIS TAPE
 449         JMP REEXT
 450 /
 451 /
 452 / THIS BRANCH IS TKEN WHEN
 453 / ALL COPYING IS COMPLETED
 454 DONE,   JMS I [SPEAK
 455         MESS4
 456         JMS I [SMIGIT
 457         JMP I [BEGIN
 458
 459         JMP I [BEGIN
 460 \f
 461 /THIS SUBROUTINE READS NUMBERS,
 462 /NOT EXCEEDING 4098, FROM A TELETYPE
 463 /AND RETURNS THE OCTAL VALUE OF INPUT.
 464 /THE FOLLOWING SPECIAL CHARACTERS
 465 /ARE USD...<RETURN> MARKS END OF INPUT, CAUSES A <CR><LF>
 466 /IF THE <RETURN> IS THE FIRST CHARACTER THEN
 467 /DIRECT RETURN IS TAKEN, ELSE RETURN IS TO ENTRY+2
 468 /       <^C> CAUSES A BRANCH TO 7600
 469 /
 470 SMIGIT, 0
 471         KCC             /INITIALIZE TTY INPUT
 472         DCA SMISUM              /CLEAR TEMP STORAGE
 473         JMS TTYIN               /GET CHAR
 474         AND     [177
 475         TAD     [200
 476         TAD [-215               /CHECK FOR <RETURN>
 477         SNA
 478         JMP SMIXIT              /EXIT ON FIRST <RETURN>
 479         ISZ SMIGIT              /ADVANCE EXIT POINTER
 480 SMIGOP, TAD [12                 /CHECK FOR ^C
 481         SNA
 482         JMP I [7600             /BRANCH TO MONITOR
 483         TAD [-65                /CHECK FOR DIGITS
 484         CLL
 485         TAD [10
 486         SNL
 487         JMP SMILOP              /INVALID CHARACTER
 488         DCA SMICAR              /TEMP STOR
 489         TAD SMISUM              /GET CHARACTER STRING
 490         CLL RAL
 491         CLL RAL
 492         CLL RAL                 /ROTATE TO LH POSITION
 493         TAD SMICAR              /APPEND CURRENT DIGIT
 494         DCA SMISUM
 495         TAD SMICAR
 496         TAD [260                /MAKE ASCII
 497         JMS TYPE        /ECHO CHARACTER
 498 SMILOP, JMS TTYIN               /GET NEXT CHARACTER
 499         TAD [-215               /CHECK FOR <RETURN>
 500         SZA
 501         JMP SMIGOP              /CONTINUE LOOP
 502 SMIXIT, JMS I [SPEAK            /SEND A <RETURN><LINE FEED>
 503         MESS0+11
 504         TAD SMISUM              /GET INPUT STRING
 505         JMP I SMIGIT            /EXIT
 506
 507
 508 /THIS SUBROUTINE READS A CHARACTER FROM THE TTY
 509 TTYIN,  0
 510         KSF                     /WAIT UNTIL READY
 511         JMP .-1
 512         KRB                     /READ TTY BUFFER
 513         JMP I TTYIN
 514 \f
 515 /THIS SUBROUTINE TYPES OUT A
 516 /DIGIT STRING FROM THE AC
 517 /AS FOUR OCTAL CHARACTERS
 518 TYPNUM, 0
 519         DCA SMICAR              /PRESERVE STRING VALUE
 520         TAD [-4
 521         DCA SMISUM      /INITIALIZE COUNTER
 522 TYPXL,  TAD SMICAR
 523         RTL
 524         RAL                     /GET NEXT PRINT DIGIT
 525         DCA SMICAR              /RETURN TO STRING
 526         TAD [3
 527         AND SMICAR
 528         RAL                     /ENTER CURRENT DIGIT
 529         TAD [260                /MAKE ASCII
 530         JMS TYPE                /TYPE DIGIT
 531         ISZ SMISUM              /COUNT DIGITS
 532         JMP TYPXL               /COUNTINUE LOOP
 533         JMP I TYPNUM            /EXIT
 534
 535 \f
 536 /THIS SUBROUTINE TYPES OUT A
 537 /MESSAGE IN "TEXT" FORMAT TWO
 538 /ASCII CHARACTERS PER WORD.
 539 /SPECIAL CHARACTERS ARE NOT
 540 /PERMITTED.     A CARRIGE RETURN
 541 /AND LINE FEED PRECEED THE
 542 /MESSAGE.
 543 /       JMS I [SPEAK <BRANCH TO SUBROUTINE>
 544 /       MESSAGE <POINTER TO MESSAGE BUFFER>
 545 /A ZERO WORD MARKS THE
 546 /END OF THE MESSAGE.
 547 /
 548 SPEAK,  0
 549         CLA CLL
 550         TAD [215
 551         JMS I [TYPE     /CARRIGE RETURN
 552         TAD I SPEAK     /GET ADDRESS OF OUTPUT
 553         DCA SPELIN
 554         ISZ SPEAK
 555         TAD [212
 556         JMS I [TYPE     /LINE FEED
 557 SPEELH, TAD I SPELIN    /GET NEXT WORD
 558         SNA     /CHECK FOR ZERO
 559         JMP I SPEAK     /EXIT IF ZERO
 560         AND [7700       /GET LH CHARACTER
 561         CLL RTR /MOVE TO
 562         RTR     /RIGHT HAND
 563         RTR     /SIX BITS
 564         JMS SPEOUT      /TRANSLATE AND OUTPUT
 565         TAD I SPELIN
 566         ISZ SPELIN      /ADVANCE POINTER
 567         AND [77 /GET RH CHARACTER
 568         JMS SPEOUT      /TRANSLATE AND OUTPUT
 569         JMP SPEELH
 570 SPEOUT, 0
 571         TAD [-40        /CHECK FORMAT
 572         SMA
 573         TAD [-100       /KLUDGE DIGITS FORMAT<200+XX>
 574         TAD [340        /ALPHA FORMAT <300+XX>
 575         JMS I [TYPE     /OUTPUT IT
 576         JMP I SPEOUT    /RETURN
 577
 578 /
 579 /THIS SUBROUTINE TYPES OUT
 580 /THE ASCII CHARACTER IN THE AC.
 581 /
 582 TYPE,   0
 583         TSF     /WAIT UNTIL READY
 584         JMP .-1
 585         TLS     /TYPE CHARACTER
 586         CLA
 587         JMP I TYPE
 588 /
 589 /THIS SUBROUTINE TYPES OUT THE
 590 /CURRENT UNIT NUMBER
 591 TUNIT,  0
 592         CLA
 593         DTRA
 594         AND [7000       /GET CURRENT UNIT NUMBER
 595         CLL RTL         /MOVE OVER
 596         RTL
 597         TAD [260        /MAKE ASCII CODE
 598         JMS I [TYPE     /TYPE IT
 599         JMS I [SMIGIT   /WAIT
 600         JMP I TUNIT     /EXIT
 601         JMP I TUNIT
 602 /
 603 /
 604 PAGE
 605 \f
 606 /THIS SUBROUTINE SEARCHES DECTAPE
 607 /IN A FORWARD OR REVERSE DIRECTION.
 608 /STATUS REGISTER A SHOULD CONTAIN
 609 /UNIT SELECT NUMBER (0-2), FORWARD
 610 /OR REVERSE, AND A5=1.
 611 /THE BLOCK NUMBER FOR WHICH THE PROGRAM IS
 612 /SEARCHING MUST BE IN THE AC.
 613 /ON ERROR RETURN THE COMAND
 614 /FOLLOWING THE "JMS" IS SKIPPED,
 615 /AN END OF TAPE ERROR WILL CAUSE
 616 /THREE MOVES INTO ENDZONE AND TWO COMMANDS FOLLOWING
 617 /THE "JMS" ARE SKIPPED
 618 SEARCH, 0
 619         CIA     /FORM TWO'S COMPLEMENT
 620         DCA SEAZOK      /STORE - BLOCK NUMBER
 621         DCA SEAZIK      /CLEAR INPUT WORD
 622         DTRA
 623         AND [274
 624         DTXA    /CLEAR OUT A REGISTER
 625         TAD [210        /START DEVICE
 626         DTXA
 627         JMS DIREC       /DETERMINE DIRECTION
 628         TAD [NOP-CIA    /FORWARD...FIX TO "NOP"
 629         TAD [CIA        /REVERSE...FIX TO "CIA"
 630         DCA SEATIX      /FIX UP COMMAND
 631         TAD [SEAZIK     /BLOCK NUMBER INPUT
 632         DCA I [CA       /PUT IN CURRENT ADDRESS
 633         CLA CMA /NUMBER OF BLOCKS=1
 634         JMS SEARUN      /FIND FIRST BLOCK MARK
 635         TAD [100                /SET CONTINUOUS MODE FLAG
 636         DTXA
 637         TAD SEAZIK      /BLOCK NUMBER HERE
 638         TAD SEAZOK      /MINUS BLOCK NUMBER THERE
 639 SEATIX, NOP     /IFSEARCHING IN REVERSE DIRECTION
 640 *.-1
 641         CIA     /IF SEARCHING IN FORWARD DIRECTION
 642         SPA     /SKIP IF DONE
 643         JMS SEARUN      /FIND "N" BLOCK MARKS
 644         DTRA
 645         AND [100                /CLEAR CONTINUOUS MODE FLAG
 646         DTXA
 647         JMP I SEARCH    /NORMAL EXIT
 648 SEARUN, 0
 649         DCA I [WC       /NUMBER OF BLOCKS TO READ
 650         DTXA
 651         DTSF    /CHECK FOR DONE
 652         JMP .-1
 653         DTRB    /READ STATUS REGISTER B
 654         SMA CLA
 655         JMP I SEARUN    /DT FLAG...NORMAL EXIT
 656         JMS I [ERROR    /HANDLE ALL ERRORS
 657         ISZ SEARCH      /END OF TAPE ERROR
 658         ISZ SEARCH      /ALL OTHER ERRORS
 659         JMP SEARUN-4    /EXIT
 660
 661 \f
 662 /THIS SUBROUTINE READS OR WRITES
 663 /<N> WORDS, IN CONTROL MODE, ON
 664 /A BLOCK(S) ASSUMING THAT
 665 /THE DECTAPE IS PROPERLY
 666 /POSITIONED. IN LINE CODE:
 667 /       JMS I [DECTAP
 668 /       <BUFFER> ADDRESS TO READ INTO (OR WRITE FROM) -1
 669 /       <3> IF READ, <5> IF WRITE
 670 /<<NORMAL RETURN>>
 671 /<<END OF TAPE ERROR>>
 672 /AN END OF TAPE ERROR WHILE SEARCHING
 673 /CAUSES A BRANCH TO "REVERT".
 674 /STATUS REGISTER A SHOULD CONTAIN:
 675 /AO-2 UNIT NUMBER
 676 /A3 FORWARD=0, REVERSE=1
 677 /A4 UNIMPORTANT, SHOULD BE ZERO
 678 /A5     1
 679 /A6-8,89 UNIMPORTANT
 680 /BLOCK NUMBER IN PAGE ZERO "CURBLK"
 681 /NUMBER OF WORDS TO READ OR
 682 /WRITE IS IN PAGE ZERO "LENGTH"
 683 /
 684 DECTAP, 0
 685         TAD I DECTAP    /GET INPUT BUFFER
 686         DCA DECTCA      /STORE
 687         ISZ DECTAP
 688 DECAGN, TAD CURBLK      /SEARCH FOR BLOCK
 689         JMS I [SEARCH
 690         JMP DECRUN      /FOUND IT
 691         JMP DECAGN
 692         JMP I [REVERT   /END ZONE ERROR
 693 DECRUN, TAD SEAZIK
 694         TAD SEAZOK      /CHECK TO SEE IF FOUND BLOCK
 695         SZA
 696         JMP DECEXT-3
 697         TAD LENGTH      /SET UP WORD COUNT
 698         CIA
 699         DCA I [WC
 700         TAD DECTCA      /AND INPUT OUTPUT BUFFER
 701         DCA I [CA
 702         TAD I DECTAP    /GET READ OR WRITE
 703 DECLOP, DTXA    /START GOING
 704         DTSF
 705         JMP .-1
 706         DTRB    /GET FLAGS
 707         SMA
 708         JMP DECEXI
 709         JMS I [ERROR
 710         JMP DECEXT-1    /ENDZONE ERROR
 711         JMS I [RESET    /RESTORE POINTERS
 712         JMP DECAGN
 713         ISZ DECTAP      /END OF TAPE EXIT
 714 DECEXT, ISZ DECTAP
 715         CLA
 716         JMP I DECTAP    /FINISHED
 717 DECEXI, CLA
 718         TAD I [WC       /HAVE WE FINISHED?
 719         SZA CLA
 720         JMP DECLOP      /NO-:CONTINUE READ-WRITE
 721         DTRA    /YES--CLEAR STATUS
 722         AND [274
 723         DTXA
 724         JMP DECEXT
 725 \f
 726 /THIS SUBROUTINE CHECKS THE CONTENTS
 727 /OF STATUS REGISTER B.
 728 /       <BRANCH> JMS I [ERROR
 729 /       <+1 END OF TAPE ERROR>
 730 /       <+2 ALL OTHER ERRORS>
 731 /IN ADDITION: 1--A SELECT ERROR WILL
 732 /CAUSE A TYPEOUT AND HALT. 2--A PARITY
 733 /ERROR ON OUTPUT TAPE CAUSES A
 734 /BRANCH TO "COPERS"; ON INPUT TAPE
 735 /"PARITY ERROR" IS TYPED OUT. 3--GO FLIP-FLOP
 736 /AND STATUS REGISTER A6-8 WILL BE CLEARED.
 737 /
 738 ERROR,  0
 739         CLA CLL
 740         DTRB                    /GET ERROR FLAGS
 741         AND [200                /PARITY ERROR FLAG
 742         SNA CLA
 743         JMP ERNOT               /HANDLE OTHER ERRORS
 744         DTXA                    /CLEAR FLAGS, CONTINUE READ MODE
 745         DTRA                    /GET UNIT NUMBER
 746         AND [7000
 747         TAD MSKIN               /CHECK FOR INPUT UNIT
 748         SZA
 749         JMP I [COPERR           /ERROR ON OUTPUT UNIT
 750         TAD I [WC               /PUT WORD COUNT IN PUSH
 751         CIA
 752         DCA I PARDEL            /DOWN STACK
 753         ISZ PARDEL              /ADVANCE POINTER
 754         ISZ PARITY              /SET FLAG
 755         JMP I [DECEXI           /RETURN TO READ
 756 ERNOT,  DTRA    /GET STATUS REGISTER A
 757         AND [274
 758         TAD [2  /DO NOT DISTURB ERROR FLAGS
 759         DTXA    /CLEAR A4 AND A6-8
 760         DTRB    /GET ERROR FLAGS
 761         RTL
 762         SMA     /SKIP IF END OF TAPE ERROR
 763         JMP ERROTH
 764         CLA
 765         TAD [-3         /LOAD -3
 766         DCA ERRSOR      /STORE IN COUNT
 767         TAD [200        /GO FLIP-FLOP
 768         DTXA    /SET
 769         DTSF
 770         JMP .-1
 771         ISZ ERRSOR      /HAVE WE DONE THREE TIMES
 772         JMP .-5
 773         JMP I ERROR     /EXIT
 774 ERRSOR, 0
 775 ERROTH, ISZ ERROR       /CHANGE ERROR BRANCH
 776         SZL
 777         CLA CLL         /MARK TRACK ERROR
 778         RTL
 779         SNL CLA
 780         JMP I ERROR             /TIMING ERROR BRANCH
 781         JMS I [SPEAK    /SELECT ERROR MESSAGE
 782         ERRSEL
 783 ERRUNT, JMS I [TUNIT
 784         JMP I ERROR
 785 /
 786 PAGE
 787 \f
 788 / VARIOUS MESSAGES
 789 MESS0,  TEXT %DECTAPE COPY V10A %
 790 MESSA,  TEXT %FIRST BLOCK TO COPY (OCTAL) %
 791 MESSB,  TEXT %FINAL BLOCK TO COPY (OCTAL) %
 792 ERRSEL, TEXT %SELECT ERROR ON UNIT #%
 793 PMESS, TEXT %PARITY ERROR ON BLOCK %
 794 MESSC,  TEXT %VERIFY OUTPUT? (0=YES, 1=NO): %
 795 MESS1,  TEXT %FROM UNIT %
 796 MESS2,  TEXT %TO UNIT %
 797 MESS3,  TEXT %PDP-8 WORDS PER BLOCK %
 798 MESS4,  TEXT %DONE%
 799 MESS5,  TEXT %WRITE ERRORS ON UNIT #%
 800 MESS3A, TEXT %BLOCK LENGTH ERROR%
 801 /
 802 /
 803 PAGE
 804 /
 805 /
 806 \f
 807 /THIS ROUTINE TYPES OUT PARITY ERROR MESSAGES
 808 /AND RESTORES POINTERS TO THE PUSH DOWN STACK.
 809 ERRPAR, CIA
 810         DCA PARITY              /SET UP STACK COUNTER
 811         CLA CMA
 812         TAD PARDEL              /MOVE POINTER BACK
 813         DCA PARDEL
 814         JMS I [SPEAK            /TYPE OUT MESSAGE
 815         PMESS
 816         TAD CURBLK
 817 EPLOOP, DCA EPJK
 818         TAD I PARDEL            /CHECK FOR CORRECT BLOCK NUMBER
 819         TAD WORDS               /ADVANCE BLOCK WORDS COUNT
 820         DCA I PARDEL
 821         TAD I PARDEL
 822         CIA             /REACHED ORIGINAL VALUE?
 823         TAD LENGTH
 824         SNA CLA
 825         JMP EPTYP               /TYPE BLOCK AT ERROR
 826         JMS DIREC
 827         CLL CMA RAL             /ADD ONE IF FORWARD
 828         CMA                     /SUBTRACT ONE IF NEGATIVE
 829         TAD EPJK                /NEXT BLOCK NUMBER
 830         JMP EPLOOP              /CONTINUE LOOP
 831 EPTYP,  TAD EPJK
 832         JMS I [TYPNUM           /TYPE BLOCK NUMBER
 833         ISZ PARITY              /ADVANCE COUNTER
 834         JMP ERRPAR+2            /CONTINUE LOOP
 835         JMP I EPPEXT            /RETURN TO COPY
 836 EPPEXT, COPZ                    /REENTRY TO COPY
 837 EPJK,   0                       /WORKING STORAGE
 838 \f
 839 /THIS SUBROUTINE READS A RANDOM
 840 /BLOCK ON DECTAPE TO DETERMINE THE BLOCK LENGTH
 841 FIXTAP, 0
 842         TAD [610                /FIX A REG. WORD
 843         DTCA DTXA               /LOAD A STAT. REG.
 844         CLA CMA
 845         DCA I [WC               /SEARCH FOR 1 BLOCK
 846         TAD [BUFIOT             /FIX CURRENT ADDRESS
 847         DCA I [CA               /TO READ INTO BUFFER
 848         DTSF                    /WAIT AROUND
 849         JMP .-1
 850         DTRB
 851         SPA CLA
 852         JMP FIXERR              /HANDLE ERROR CONDITIONS
 853         TAD [30                 /CHANGE TO READ MODE
 854         DTXA
 855         DTSF                    /WAIT TILL READ DONE
 856         JMP .-1
 857         TAD [200                /STOP TAPE
 858         DTXA
 859         TAD I [WC               /GET BLOCK LENGTH
 860         JMP I FIXTAP            /EXIT
 861 FIXERR, JMS I [ERROR
 862         TAD [400                /END OF TAPE...REVERSE DIRECTION
 863         TAD [210                /START TAPE MOVING
 864         DTXA                    /AND CLEAR FLAGS
 865         JMP FIXTAP+3            /TRY AGAIN
 866 \f
 867 /PARITY ERROR WORD COUNT STACK
 868 PSTACK, 0
 869
 870
 871 /
 872
 873 /END OF PROGRAM
 874 $