| 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 | $ |