Commit | Line | Data |
---|---|---|
7af5ad59 PH |
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 | $ |