projects / pdp8.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
A large commit.
[pdp8.git] / sw / os8 / v3d / sources / extensions / dectapes / dectape2 / basic.pa
CommitLineData
81e70d48
PH		 1/OS8 BASIC EDITOR, V5A
2/
3/
4/
5/
6/
7/
8/
9//
10/
11/
12/
13/
14/COPYRIGHT (C) 1972, 1973, 1974, 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/DEC-S8-LBASA-B-LA
41/
42/COPYRIGHT C 1972, 1973, 1974
43/
44/DIGITAL EQUIPMENT CORPORATION
45/MAYNARD,MASSACHUSETTS 01754
46/
47/AUGUST 19, 1972
48/
49/HANK MAURER, 1972
50/LEN ELEKMAN, 1972
51/SHAWN SPILMAN, 1973
52/
53/
54/ASSEMBLE AND LOAD AS FOLLOWS:
55/
56/ .R PAL8
57/ *BASIC,BASIC<BASIC.03
58/ .R ABSLDR
59/ *BASIC$
60/ .SA SYS BASIC;3211
61/
62/NOTE DIFFERENCES FROM VERSION 1 AS FOLLOWS:
63/
64/ .R SRCCOM
65/ *LPT:<BASIC.01,BASIC.03
66/ *
67/
68 VERSON= 5 /VERSION LOCATED IN CORE AT TAG "VERLOC"
69 /LEFT 6BIT HALF = VERSION NUMBER+21
70 /RIGHT 6BIT HALF = PATCH LEVEL+41 (A=01)
71
72/
73/FIXES FOR V4 J.K. 1975
74/
75/.LINE TOO LONG ERROR MESSAGE
76/.CLEAR CD OPTION TABLE AT START UP
77/.LIST FROM ACROSS FLD BOUNDRIES
78/.MEMORY OVERFLOW
79/.INPUT FROM TTY
80
81/JR 5-APR-77 ADDED EXTENDED DATE PRINTOUT
82/JR 13-APR-77 ADDED SCROLLING, SCOPE SUPPORT AND .BASIC COMMAND INTERFACE
83/JR 30-APR-77 FIX JSW FIELD BUG
84\f BCSIZE= 3700 / SIZE OF BCOMP.SV
85 BCBEGN= 7001 / START OF BCOMP
86 INFO= 7604 / INFORMATION AREA (FIELD 1)
87 JSW= 7746 /JOB STATUS WORD IN FIELD 0
88 OS8RES= 3400 / SWAP AREA FOR OS8
89 DSKBUF= 4200 / FILE BUFFER
90 HANDLR= 4600 / INPUT OUTPUT HANDLER ADDRESS
91 TXTAREA=5200 / START OF TEXT AREA
92 MDATE= 7666 /ADDR OF OS8 DATE IN FIELD 1
93 BIPCCL= 7777 /ADDR OF DATE EXTENSION IN FIELD 0
94 *3
95SWAPT1, 0
96SWAPT2, 0
97SWAPT3, 0
98SWAPT4, 0
99 0
100X10, INFO-1
101X11, NAMLST-1
102X12, 0
103X13, 0
104X14, 0
105X15, 0
106X16, 0
107X17, 0
108 *20
109RDTMP, 0 /USED BY INPUT ROUTINE
110RDPTR, 0
111SIZE, 0 /USED BY LINE EDITOR STUFF
112TEMP, 0
113TEMP2, 0
114TOWARD, 0
115PTR, 0
116NDIGS, 0
117NCHARS, 0
118COFLAG, 0 /=0 IF CTRL/O
119CHNFLAG,0 /=1 IF BACK FROM RUN, 0 IF OLD
120RUNFLAG,0 /=1 IF RUN, 0 IF SAVE
121OLDFLAG,0 /=1 IF INPUT COMING FROM FILE
122EOFADR, TXTAREA
123CORTMP, 0
124CORSIZ, 1
125LINENO, 0;0 /HOLDS MOST RECENT LINE NUM
126EOFLIN, 0;0 /LAST LINE NUMBER
127NAME, 0;0;0;0 /NAME BUFFER
128FNAME, FILENAME NONAME.BA /CURRENT FILE NAME
129DEVHAN, 0 /ADDRESS OF DEVICE HANDLER
130DEVNUM, 0 /CURRENT DEVICE NUMBER
131SWPNUM, 0 /SWAPPER FLAG (FOR ^C)
132O7700, 7700
133O200, 200
134O201, 201
135O7761, 7761
136O177, 177
137O232, 232
138O7201, 7201
139O7706, 7706
140O32, 32
141O7200, 7200
142O7600, 7600
143O17, 17
144O260, 260
145O237, 237
146O13, 13
147O215, 215
148O212, 212
149O37, 37
150O7741, 7741
151O7405, 7405
152O7701, 7701
153O7772, 7772
154O6171, 6171
155O6211, 6211
156O7770, 7770
157O6201, 6201
158O10, 10
159O7774, 7774
160O7766, 7766
161O7634, 7634
162O137, 137
163O7746, 7746
164O36, 36
165O77, 77
166O7745, 7745
167O12, 12
168O7771, 7771
169O7400, 7400
170O7760, 7760
171/
172O14, 14
173CSFLG, 0
174\f PAGE
175GETLIN, 0 /GET A LINE FROM TTY.
176 TAD I (HEIGHT /RESET SCREEN HEIGHT ON USER INPUT
177 DCA I (LINCNT
178 DCA NDIGS /CLEAR LINE NUMBER.
179 DCA CSFLG /ZERO OUT ^S FLAG WHENEVER WE GET INPUT
180 DCA NCHARS /CLEAR TEXT COUNT.
181IGNORE, CLA
182 JMS I [GETCH
183 DCA TEMP2 /SAVE CHAR
184 CLL CMA RTL /CHECK FOR CONTROL C
185 TAD TEMP2
186 SNA
187 JMP I (BYEBYE /ITS ^C EXIT TO OS8
188 TAD O7766 /CHECK FOR CARRIAGE RETURN
189 SNA
190 JMP CARRET /JUMP IF 015 - CARRET.
191 TAD O7770 /CHECK FOR ^U
192 SNA
193 JMP ALT /TREAT ^U AS ALTMODE
194 TAD O7772 /CHECK FOR ALTMODE
195 SNA
196 JMP ALT /JUMP IF 033 - ALTMODE.
197 TAD O7634 /CHECK FOR RUBOUT
198 SNA
199 JMP ARROW /TREAT LIKE BACK ARROW
200 IAC /CHECK FOR ALTMODE
201 SNA
202 JMP ALT /JUMP IF 176 - ALTMODE.
203 IAC
204 SZA
205 JMP .+4 /PRINT IF 175 - ALTMODE.
206ALT, JMS I [TYPE
207 MSGALT
208 JMP GETLIN+1
209 TAD O36 /CHECK FOR BACK ARROW
210 SNA
211 JMP ARROW /JUMP IF 137 - BACKARROW.
212 CLL
213 TAD O77
214 SNL
215 JMP IGNORE /JUMP IF NOT PRINTABLE.
216 IAC
217 DCA TEMP /SAVE IT(SP=01,^=77,NO 00).
218 TAD OLDFLAG /INPUT FROM FILE ?
219 SZA CLA
220 JMP .+3 /YES, DON'T ECHO
221 TAD TEMP2
222 JMS I [TTYOUT /PRINT ON TTY
223 TAD NCHARS
224 SZA CLA
225 JMP ISTEXT /NOT LINE NUMBER.
226 TAD TEMP
227 TAD O7745 /SEE IF ITS A DIGIT
228 JMS I [LNDIG /PUT DIGIT INTO LINE NUM
229 JMP IGNORE /GET NEXT CHAR
230ISTEXT, TAD NCHARS /PUT CHAR IN THE LINE.
231 TAD O7405
232 SPA CLA
233 JMP .+5
234 JMS I [CRLF
235 JMS I [TYPE /250 CHARS IS OK TO FIT 1 MORE.
236 MSGTOO
237 JMP GETLIN+1/IF AN EVEN NUMBER
238 TAD NCHARS /OF CHARS SO FAR
239 CLL RAR
240 TAD [LINE+2
241 DCA PTR
242 SZL
243 JMP RIGHTY
244 TAD TEMP /THEN STORE AS THE LEFT
245 CLL RTL /HALF OF THE WORD.
246 RTL
247 RTL
248 JMP .+4
249RIGHTY, TAD I PTR /ELSE AS THE RIGHT.
250 AND O7700
251 TAD TEMP
252 DCA I PTR
253 ISZ NCHARS
254 JMP IGNORE
255ARROW, TAD OLDFLAG /INPUT FROM FILE ?
256 SNA CLA
257 JMS I (PRTBSP /NO, GO PRINT BACKSPACE OR BACKARROW
258 CLA CMA
259 TAD NCHARS /IF THERE IS A TEXT CHAR TO ERASE
260 SPA
261 JMP .+3
262 DCA NCHARS /THEN ERASE IT.
263 JMP IGNORE
264 TAD NDIGS /OTHERWISE, IF THERE IS A LINENO
265 SMA /CHARACTER TO ERASE THEN ERASE
266 DCA NDIGS /THAT.
267 JMP IGNORE /OTHERWISE, NEVER MIND.
268CARRET, TAD OLDFLAG /INPUT FROM FILE ?
269 SNA CLA
270 JMS I [CRLF /NO, PRINT CR-LF
271 TAD NCHARS
272 SZA
273 JMP .+4 /NOT AN EMPTY LINE
274 TAD NDIGS /ANY CHARS AT ALL ?
275 SNA CLA
276 JMP IGNORE /NO, IGNORE EMPTY LINES
277 CLL RAR
278 TAD [LINE+2
279 DCA PTR
280 SZL
281 TAD I PTR /STORE 00 (CAR. RET.) LIKE ALL
282 AND O7700 /THE OTHER CHARACTERS.
283 DCA I PTR
284 JMS I [NORM /NORMALIZE LINE NUMBER
285 JMP I GETLIN
286/CRLF, 0 /PRINT CR-LF
287/ TAD O215
288/ JMS I [TTYOUT
289/ TAD O212
290/ JMS I [TTYOUT
291/ JMP I CRLF
292DUMMY, 0
293 CLA
294 ISZ DUMMY
295 JMP I DUMMY
296PATCH4, TAD [NAME+3
297 DCA TEMP2
298 CMA
299 DCA SIZE
300 JMP I (NAMLUP
301
302 PAGE
303\fLNDIG, 0 /GET DIGIT INTO LINE NUM
304 CLL
305 TAD O12
306 SZL
307 JMP .+4
308 CLA /NOT A DIGIT
309 ISZ LNDIG /RETURN +1
310 JMP I LNDIG
311 DCA TEMP /SAVE DIGIT
312 ISZ NDIGS
313 TAD NDIGS
314 TAD O7771
315 SMA
316 JMP I LNDIG /IGNORE MORE THAN 6 DIGITS.
317 TAD .+3
318 DCA .+1 /PUT IN THE NTH DIGIT IN THE
319 HLT /4 BIT BCD LINE NUMBER:
320 JMP .+7
321 JMP DIG1
322 JMP DIG2
323 JMP DIG3
324 JMP DIG4
325 JMP DIG5
326DIG6, TAD LINENO+1/WHERE N=6
327 AND O7760
328 JMP DIG56
329DIG5, TAD TEMP /WHERE N=5
330 CLL RTL
331 RTL
332 DCA TEMP
333 TAD LINENO+1
334 AND O7400
335DIG56, TAD TEMP
336 JMP DIG456
337DIG4, TAD TEMP /WHERE N=4
338 CLL RAR
339 RTR
340 RTR
341DIG456, DCA LINENO+1
342 JMP I LNDIG
343DIG3, TAD LINENO /WHERE N=3
344 AND O7760
345 JMP DIG23
346DIG2, TAD TEMP /WHERE N=2
347 CLL RTL
348 RTL
349 DCA TEMP
350 TAD LINENO
351 AND O7400
352DIG23, TAD TEMP
353 JMP DIG123
354DIG1, TAD TEMP /WHERE N=1
355 CLL RAR
356 RTR
357 RTR
358DIG123, DCA LINENO
359 JMP I LNDIG
360TYPE, 0 /TYPE A MESSAGE
361 DCA CRSWIT /SAVE CARRIAGE RETURN SWITCH
362 TAD I TYPE /GET ADDR OF MESSAGE
363 ISZ TYPE
364 DCA PASS
365TLOOP, JMS I [CTRLO /CHECK FOR CTRL/O
366 JMP TCRLF /YES, STOP PRINTING
367 TAD I PASS /GET HIGH CHAR
368 CLL RTR /SHIFT RIGHT
369 RTR
370 RTR
371 AND O77 /SIX BITS
372 SNA
373 JMP TCRLF /END OF MESSAGE
374 TAD O237 /CONVERT TO ASCII
375 JMS I [TTYOUT /PRINT CHAR
376 TAD I PASS /GET LOWER CHAR
377 ISZ PASS
378 AND O77
379 SNA
380 JMP TCRLF /END OF LINE
381 TAD O237 /CONVERT TO ASCII
382 JMS I [TTYOUT /PRINT
383 JMP TLOOP
384TCRLF, TAD CRSWIT /RETURN THE CARRIAGE ?
385 SNA CLA
386 JMS I [CRLF /YES
387 JMP I TYPE /DONE
388/TTYOUT, 0 /PRINT ONE CHAR
389/ TSF /WAIT
390/ JMP .-1
391/ TLS /PRINT
392/ CLA
393/ JMP I TTYOUT
394PASS, 0 /SKIP OVER LINE
395 ISZ TEMP
396 SKP
397 JMS FINCR
398 TAD I TEMP
399 AND O77
400 SZA CLA
401 JMP PASS+1
402 ISZ TEMP
403 JMP I PASS
404 JMS FINCR
405 JMP I PASS
406CRSWIT,
407FDECR, 0 /DECR. POINTER AND FIELD
408 TAD TEMP
409 SZA CLA
410 JMP .+5
411 RDF
412 TAD O6171
413 DCA .+1
414 HLT
415 CLA CMA
416 TAD TEMP
417 DCA TEMP
418 JMP I FDECR
419FINCR, 0 /INCR. CURRENT DATA FIELD
420 RDF
421 SZA
422 JMP HERE
423 TAD CORSIZ
424 DCA CORTMP
425HERE, TAD O6211
426 DCA .+1
427 HLT
428 ISZ CORTMP
429 JMP I FINCR
430 CDF 0
431 JMP I [COREOV /FILE TOO BIG
432\f PAGE
433CMDDONE,CDF
434 JMS I [CRLF /TYPE READY MESSAGE
435 JMS I [TYPE
436 MSGRDY
437MAINLUP,CDF
438 JMS I [GETLIN /GET AN EDITED LINE.
439 SNA CLA
440 JMP NOCOMD /NOT A COMMAND
441 TAD OLDFLAG /IN OLD MODE ?
442 SNA CLA
443 JMP I [COMMAND/NO, MUST BE A COMMAND
444 JMP MAINLUP /OTHERWISE IGNORE
445NOCOMD, TAD PTR /OR A LINE WITH A LINE
446 CMA /NUMBER ON IT.
447 TAD [LINE
448 DCA SIZE /SET UP SIZE OF LINE.
449 TAD I [LINE+2 /IS LINE EMPTY ??
450 SNA CLA
451 DCA SIZE /POSSIBLY ZERO.
452 TAD LINENO /IS IT > LAST LINE ?
453 CIA CLL
454 TAD EOFLIN
455 SZA CLA
456 JMP .+4 /HI PART NOT =, FORGET LOW
457 TAD LINENO+1
458 CIA CLL
459 TAD EOFLIN+1 /COMPARE LOW PARTS
460 SZL CLA
461 JMP NOTLAST /NOT > LAST
462 JMS I [GETEOF /GET EOF
463 TAD TEMP /MAKE IT LOOK LIKE
464 DCA PTR /A CALL TO FINDLN
465 TAD LINENO /SAVE NEW LAST LINE
466 DCA EOFLIN
467 TAD LINENO+1
468 DCA EOFLIN+1
469 SKP
470NOTLAST,JMS I [FINDLN /GENERAL CASE - SEARCH
471INSERT, TAD TEMP /THERE ARE (TEMP-PTR) WORDS IN
472 CLL CMA /THE OLD LINE WHICH ARE TO BE
473 TAD PTR /REPLACED BY (-SIZE) WORDS IN
474 CLA /NEW LINE.
475 RDF
476 SZL
477 TAD O7770
478 TAD O6201
479 DCA PTRFLD /GET FIELD OF START OF OLD LINE
480 TAD PTR
481 CLL CIA
482 TAD TEMP
483 TAD SIZE /WHICH WAY ?
484 SNA
485 JMP MOVE /SAME SIZE, MOVE IN NEW LINE
486 SPA
487 JMP I (EXPAND /MAKE MORE ROOM FOR NEW LINE
488 CIA
489 TAD TEMP /SHRINK THE FILE
490 DCA TOWARD /MOVE FILE DOWN TO HERE
491 RDF
492 TAD O6201
493 DCA TMPFLD /GET FIELD OF READ POINTER
494 TAD TOWARD
495 CLL CMA
496 TAD TEMP
497 SNL CLA
498 TAD O7770
499 TAD TMPFLD
500 DCA TWDFLD /GET FIELD OF WRITE POINTER
501TMPFLD, HLT
502 TAD I TEMP
503TWDFLD, HLT
504 DCA I TOWARD /MOVE DOWN
505 TAD I TOWARD
506 TAD O7701 /END OF FILE ???
507 SNA CLA
508 JMP LWREOF /YES, PUT NEW LINE IN AT END
509 ISZ TEMP /INCREMENT POINTERS
510 JMP .+4
511 TAD TMPFLD /AND FIELDS IF NECESSARY
512 TAD O10
513 DCA TMPFLD
514 ISZ TOWARD
515 JMP TMPFLD
516 TAD TWDFLD
517 TAD O10
518 DCA TWDFLD
519 JMP TMPFLD /KEEP SHRINKING
520LWREOF, TAD TOWARD /SET NEW EOF
521 JMS I [SETEOF
522MOVE, TAD SIZE
523 SNA CLA
524 JMP MAINLUP /IT WAS A DELETE
525 CDF 00
526 TAD LINENO /PUT IN LINE NUMBER
527 DCA I [LINE
528 TAD LINENO+1
529 DCA I [LINE+1
530MOVENTR,TAD [LINE
531 DCA TEMP
532MOVLUP, CDF /MOVE IN NEW LINE
533 TAD I TEMP
534 ISZ TEMP
535PTRFLD, HLT
536 DCA I PTR
537 ISZ PTR /INCREMENT POINTERS
538 JMP .+4
539 TAD PTRFLD /WHATCH OUT FOR FIELDS
540 TAD O10 /(W.C. OR E.M. ?)
541 DCA PTRFLD
542 ISZ SIZE
543 JMP MOVLUP
544 JMP MAINLUP
545SRCHBK, 0
546 DCA TEM
547 TAD I SRCHBK
548 ISZ SRCHBK
549 CIA
550 TAD TEM
551 CLL CMA
552 TAD I SRCHBK
553 SNL CLA
554 ISZ SRCHBK
555 ISZ SRCHBK
556 TAD TEM
557 JMP I SRCHBK
558TEM, 0
559
560 PAGE
561\fEXPAND, CIA /EXTRA ROOM NEEDED
562 DCA TOWARD
563 TAD I TEMP /SAVE THIS PLACE
564 DCA TEMP2
565 TAD O37 /NOW MARK THIS PLACE
566 DCA I TEMP
567 JMS I [GETEOF /GET EOF
568 RDF
569 TAD O6201
570 DCA TMP2FLD /GET FIELD OF END OF FILE
571 CLL
572 TAD TEMP /MOVE FILE UP
573 TAD TOWARD /TO
574 DCA TOWARD /HERE
575 SZL
576 JMS I [FINCR /MIGHT BE ACROSS A FIELD
577 RDF
578 TAD O6201
579 DCA TWD2FLD /SAVE NEW EOF FIELD
580 TAD TOWARD /SAVE NEW EOF
581 JMS I [SETEOF
582TMP2FLD,HLT
583 TAD I TEMP
584TWD2FLD,HLT
585 DCA I TOWARD /MOVE UP ONE WORD
586 TAD I TOWARD
587 TAD O7741 /IS THE MARK ?
588 SNA CLA
589 JMP LASTWD /YES, PUT IN LAST WORD
590 CLA CLL CMA
591 TAD TOWARD /BACK UP POINTERS
592 DCA TOWARD
593 SZL
594 JMP .+4
595 TAD TWD2FLD /AND FIELDS (MAYBE)
596 TAD O7770
597 DCA TWD2FLD
598 CLA CLL CMA
599 TAD TEMP
600 DCA TEMP
601 SZL
602 JMP TMP2FLD
603 TAD TMP2FLD
604 TAD O7770
605 DCA TMP2FLD
606 JMP TMP2FLD
607LASTWD, TAD TEMP2 /PUT IN SAVED WORD
608 DCA I TOWARD
609 JMP I [MOVE /GO MOVE IN NEW LINE
610COREOV, JMS I [TYPE /FILE TOO BIG
611 MSGBIG
612BYEBYE, CLA IAC
613 AND SWPNUM /IS OS8 RES IN PLACE ?
614 SZA CLA /YES IF EVEN NUMBER OF SWAPS
615BYE, JMS I [SWAP /PUT BACK OS8
616 TSF /WAIT FOR TTY SO OS8 DOESN'T
617 JMP .-1 /TRAMPLE ON MY LINE FEED
618 JMP I (7605 /EXIT TO OS8
619MSGBIG, 5646;5660;6372;160;6746;6347;5560;7000
620MSGALT, 0145;4655;4665;4645;0
621MSGWHAT,7051;4265;4000
622MSGTOO, 5552;5746;0165;6060;0155;6057;5000
623SCRATCH,TAD [TXTAREA/SCRATCH FILE
624 JMS I [SETEOF
625 DCA EOFLIN /ZERO LAST LINE NUM
626 DCA EOFLIN+1
627 JMP I [CMDDONE
628NORM, 0 /LINE NUMBER NORMALIZER
629 TAD NDIGS
630 SZA
631 JMP .+3 /IF THERE ARE NO DIGITS IN THE
632 CLA CMA /LINE NUMBER THEN
633 JMP I NORM /RETURN -1.
634 TAD O7772
635 SMA CLA
636 JMP I NORM /IF THE LINENO HAS BEEN FILLED
637 TAD O7774 /OUT TO 6 DIGITS(LEADING 0'S)
638 DCA TEMP /THEN RETURN.
639 TAD LINENO /OTHERWISE, SHIFT RIGHT 1 DIGIT
640 CLL RAR
641 DCA LINENO /AND CHECK AGAIN.
642 TAD LINENO+1
643 RAR
644 DCA LINENO+1
645 ISZ TEMP
646 JMP .-7
647 ISZ NDIGS
648 JMP NORM+1
649SETEOF, 0 /SET NEW EOF
650 DCA EOFADR /SAVE ADDR
651 RDF /GET FLD
652 TAD O6201
653 DCA EOFFLD /SAVE IT
654 TAD O77 /STORE EOF
655 DCA I EOFADR
656 JMP I SETEOF
657/
658GETEOF, 0
659 TAD EOFADR /RETRIEVE EOF INFO
660 DCA TEMP /FIRST ADDR
661EOFFLD, CDF
662 JMP I GETEOF
663
664 PAGE
665\fCOMMAND,TAD COMTBL /COMMAND LIST POINTER
666 DCA TEMP
667COMLUP, ISZ TEMP /GET 2 CHAR COMMAND
668 TAD I TEMP
669 ISZ TEMP
670 SNA
671 JMP WHAT /END OF LIST
672 TAD I [LINE+2 /IS THIS IT ?
673 SZA CLA
674 JMP COMLUP /NO, LOOK AGAIN
675 TAD I TEMP /GET COMMAND ADDR
676 DCA TEMP /AND GO TO IT
677 JMP I TEMP
678WHAT, JMS I [TYPE /TYPE WHAT?
679 MSGWHAT
680 JMP I [MAINLUP
681COMTBL, .
682 -5552
683 LIST
684 -6055
685 OLD
686 -6442
687 SAVE
688 -6366
689 RUN
690 -6444
691 SCRATCH
692 -4372
693 BYE
694 -5746
695 NEW
696 -5742
697 RENAME
698 0
699WSSAVE, 0145;6454;3343;4264;5244;1770;6400
700HEADING,0 /PRINT HEADING
701 JMS I [CRLF /LATER
702 TAD [FNAME /SET UP FOR CONVERSION
703 DCA TEMP /POINTER TO FILE NAME
704 TAD XTITLE /WHERE IT GOES
705 DCA PTR
706 JMS CONV /OUTPUT FIRST TWO CHARS
707 JMS CONV /NEXT TWO
708 JMS CONV /THIRD TWO
709 ISZ PTR /SKIP FOR EXT
710 JMS CONV /OUTPUT EXTENSION
711 JMS I [TYPE /TYPE HEADING
712XTITLE, TITLE
713 JMS I [CRLF /FOLLOWED BY A CRLF
714 JMP I HEADING
715CONV, 0 /CONVERT TO SIX BIT ASCII
716 TAD I TEMP /GET NEXT WORD
717 AND O77 /CHECK FOR 0
718 SNA /SUBSTITUTE BLANKS
719 TAD (40
720 TAD O7741 /SUBTRACT 37
721 AND O77 /SIX BITS
722 DCA I PTR
723 TAD I TEMP /DO UPPER CHAR
724 AND O7700
725 SNA
726 CLL CML RAR
727 TAD (-3700 /SAME WAY
728 TAD I PTR /COMBINE THEM
729 DCA I PTR
730 ISZ TEMP
731 ISZ PTR
732 JMP I CONV
733
734TITLE, 0;0;0;0101;0 /FOR THE PROG NAME
735 0101;0101 /SOME BLANKS
736VERLOC, VERSON^100+2142 /VERSION NUMBER
737 0101;0101 /MORE BLANKS
738DATE, 0;0;0 /DATE TEMPLATE
739DASH6, 1627 /"-6" FOR BUILDING DATE
740EODAT, 0 /END OF DATE TEMPLATE
741
742GETNC, 0 /GET A CHAR FOR A FILE NAME
743 TAD NCHARS /GET CHAR POINTER
744 ISZ NCHARS /BUMP IT
745 CLL RAR /DIVIDE BY 2
746 TAD [LINE+2 /ADD BASE
747 DCA TEMP /GIVES ADDR OF WORD
748 TAD I TEMP /GET 2 CHARS
749 SZL /ODD EVEN BIT IS IN LINK
750 JMP TESTCH /GO CHECK THE CHAR
751 RTR
752 RTR
753 RTR
754TESTCH, AND O77 /ONLY 6 BITS
755 SNA
756 JMP I GETNC /END OF NAME
757 TAD O37
758 ISZ GETNC
759 JMP I GETNC
760PATCH3, 0
761 JMS I [GETNC
762 JMP I PATCH3
763 AND O77
764 JMS I (SRCHBK
765 72
766 1
767 JMP EXB
768 ISZ PATCH3
769 JMS I (SRCHBK
770 60
771 12
772EXA, JMP I PATCH3
773 JMP I (PATCH2
774EXB, CLA IAC
775 JMP I PATCH3
776
777 PAGE
778\fLIST, TAD I [LINE+3 /LISTNH ?
779 TAD I [LINE+4
780 TAD [-4436 /PSEUDO TEST
781 SNA CLA
782 JMP LISTNH /NO HEADING
783 JMS I [HEADING/GIVE HEADING
784 TAD COFLAG /WAS CTRL/O TYPED ?
785 SNA CLA
786 JMP I [CMDDONE/YES, ABORT LISTING
787LISTNH, DCA NCHARS /SET POINTER
788 DCA NDIGS /AND DIGIT COUNTER
789 JMS I [GETNC /SKIP UNTIL BLANK
790 JMP NUMDUN /DONE
791 TAD (-40
792 SZA CLA
793 JMP .-4 /NO BLANK YET
794 JMS I [GETNC /GET A CHAR
795 JMP NUMDUN /END OF NUMBER
796 TAD O7706 /SUBTRACT 72
797 JMS I [LNDIG /GO SEE IF ITS A DIGIT
798 JMP .-4 /IT WAS, CONTINUE
799NUMDUN, TAD [TXTAREA
800 DCA PTR /SET UP POINTER
801 JMS I [NORM /NORMALIZE THE NUM
802 SPA CLA /ANY NUMBER ?
803 JMP .+3 /NO
804 JMS I [FINDLN /YES, LOCATE IT
805 TAD PTR
806 IAC
807 DCA TEMP
808 JMS I [FDECR
809 RDF /GET THE FIELD
810 TAD O6201
811 DCA PTR2FLD /SAVE IT
812 DCA TEMP
813LSTLUP, JMS I [CTRLO /CHECK FOR CTRL/O
814 JMP I [CMDDONE/YES, EXIT
815 JMS CTRLS /CHECK FOR XOFF
816 JMS GETFIL /GET CHARACTER TO LIST
817 JMP I [CMDDONE
818 JMS I [TTYOUT /PRINT IT
819 JMP LSTLUP /LOOP
820GETFIL, 0 /GET CHARACTER FROM FILE
821 TAD TEMP
822 ISZ TEMP
823 TAD .+3
824 DCA .+1
825 HLT
826 JMP I .+1 /SEQUENCE OF OPERATIONS
827 PTR2FLD /GET FIRST WORD
828 FRSTDIG /FIRST DIGIT OF LINE NUMBER
829 DIGIT /SECOND DIGIT
830 DIGIT /THIRD DIGIT
831 PTR2FLD /GET NEXT WORD OF LINE NUMBER
832 DIGIT /FOURTH DIGIT
833 DIGIT /FIFTH DIGIT
834 LASTDIG /SIXTH AND LAST DIGIT
835 PTR2FLD /GET WORD OF TEXT
836 LEFTTXT /LEFT CHARACTER
837 RITETXT /RIGHT CHARACTER
838 LINFTXT /LINE FEED CHARACTER
839PTR2FLD,HLT /CHECK FOR EOF
840 TAD I PTR
841 CDF
842 TAD O7701
843 SNA
844 JMP I GETFIL /YES, RETURN UNSKIPPED
845 TAD O77
846 DCA TEMP2 /NO, SAVE WORD
847 ISZ PTR /BUMP POINTER
848 JMP GETFIL+1
849 TAD PTR2FLD
850 TAD O10
851 DCA PTR2FLD
852 JMP GETFIL+1
853LASTDIG,CLA IAC /FORCE LAST DIGIT (EVEN IF 0)
854FRSTDIG,DCA NDIGS /ZERO DIGIT COUNT
855DIGIT, TAD TEMP2
856 RTL
857 RTL
858 DCA TEMP2 /SHIFT LEFT ONE DIGIT
859 TAD TEMP2
860 RAL
861 AND O17 /GET DIGIT
862 SZA
863 JMP NZDIGIT /ITS NOT ZERO
864 TAD NDIGS /IS IT A LEADING ZERO ?
865 SNA CLA
866 JMP GETFIL+1/YES, DON'T PRINT IT
867NZDIGIT,ISZ NDIGS /NON ZERO OR NON LEADING ZERO
868 TAD O260 /SO PRINT IT
869 JMP GFRET
870LEFTTXT,TAD TEMP2 /GET LEFT CHAR
871 RTR
872 RTR
873 RTR
874 JMP .+4
875RITETXT,TAD O10 /SETUP FOR LEFT CHAR NEXT
876 DCA TEMP
877 TAD TEMP2
878 AND O77 /SIXBITIZE AC
879 SNA
880 JMP ZEROTXT /0 IS END OF THE LINE
881 TAD O237 /MAKE IT ASCII
882GFRET, ISZ GETFIL
883 JMP I GETFIL
884ZEROTXT,TAD O13 /SETUP FOR LF NEXT
885 DCA TEMP
886 TAD O215 /RETURN CR
887 JMP GFRET
888LINFTXT,DCA TEMP /CLEAR SEQUENCER AND RETURN LF
889 TAD O212
890 JMP GFRET
891/
892CTRLS, 0
893 TAD CSFLG /XON?
894 SNA CLA
895 JMP I CTRLS /NO
896 JMP LSTLUP /YES
897/
898MSGRDY, 6346;4245;7200
899
900 PAGE
901\fGETFN, 0 /GET A FILE NAME (ALSO FETCH ITS HANDLER)
902 DCA SAVFLAG /=1 FOR SAVE, 0 FOR OLD OR NEW
903 TAD CHNFLAG /RETURNING FROM RUN ?
904 SZA CLA
905 JMP NOFUSR /YES, DON'T FETCH USR
906 JMS I [SWAP /GET OS8 RESIDENT
907 TAD SAVFLAG /IS IT OLD OR NEW ??
908 SNA CLA
909 IAC /YES, DON'T SWAP 10000-11777
910 DCA I (7746 /DO IF SAVE, SO ALTER JSW
911 CIF 10 /GET THE USR
912 JMS I O7700
913 10
914NOFUSR, DCA NCHARS /RESET CHAR POINTER
915BSKIP, JMS I [GETNC /GET A CHAR
916 JMP ASKNAM /ASK FOR FILE NAME
917 TAD M40 /BLANK ?
918 SZA CLA
919 JMP BSKIP /NO, LOOP
920NOSKIP, JMS GETNAM /GET A NAME
921 SNA CLA
922 JMP USEDSK /NO DEVICE SPECIFIED, USE DSK:
923 TAD NAME /PUT IN THE DEVICE NAME
924 DCA DEV /AS SPECIFIED
925 TAD NAME+1
926 DCA DEV+1
927 JMS GETNAM /FETCH THE FILE NAME
928 SZA CLA
929 JMP I (IOERR /BAD SYNTAX IN FILE DESCRIPTOR
930 JMP GETHAN /GO FETCH THE HANDLER
931USEDSK, TAD (0423 /SET DEVICE NAME TO DSK:
932 DCA DEV
933 TAD (1300
934 DCA DEV+1
935GETHAN, TAD [HANDLR+1
936 DCA DEV+2 /ALSO THE HANDLER ORIGIN
937 CIF 10
938 JMS I O200 /CALL THE USR
939 1 /FETCH HANDLER BY NAME
940DEV, 0;0;0
941 JMP I (IOERR /BAD DEVICE
942 TAD DEV+1 /SAVE THE DEVICE NUMBER
943 DCA DEVNUM
944 TAD DEV+2 /AND THE HANDLER ENTRY POINT
945 DCA DEVHAN
946MOVEFN, TAD SAVFLAG /WAS IT A SAVE ?
947M40, SMA SZA CLA
948 JMP I GETFN /YES, JUST RETURN
949 TAD NAME /NEW OR OLD, ANY NAME GIVEN ?
950 SNA
951 JMP I GETFN /NO, PROBABLY JUST A DEVICE
952 DCA FNAME /YES, SAVE IT
953 TAD NAME+1
954 DCA FNAME+1
955 TAD NAME+2
956 DCA FNAME+2
957 TAD NAME+3
958 DCA FNAME+3
959 JMP I GETFN
960ASKNAM, TAD SAVFLAG /WAS THIS A SAVE ?
961 SPA SNA CLA
962 JMP ASKNM /NO, GO ASK FOR A NAME
963 TAD FNAME /IT WAS A SAVE, ANY OLD NAME TO USE ?
964 SNA
965 JMP ASKNM /NO, GO ASK FOR ONE
966 DCA NAME /YES, MOVE INTO NAME
967 TAD FNAME+1
968 DCA NAME+1
969 TAD FNAME+2
970 DCA NAME+2
971 TAD FNAME+3
972 DCA NAME+3
973 JMP I GETFN
974ASKNM, CLA IAC /ASK FOR FILE NAME
975 JMS I [TYPE
976 ASKFN
977 TAD (DUMMY
978 DCA [LNDIG
979 JMS I [GETLIN
980 JMP I (PATCH1
981SAVFLAG,0
982GETNAM, 0 /GET A FILE OR DEVICE NAME
983 DCA NAME /ZERO THE NAME BUFFER
984 DCA NAME+1
985 DCA NAME+2
986 TAD O201 /USE DEFAULT EXT .BA
987 DCA NAME+3
988 TAD [NAME /SETUP POINTER
989 DCA TEMP2
990 TAD O7774 /SETUP SIZE (MAX 4 WORDS)
991 DCA SIZE
992NAMLUP, JMS I (PATCH3
993 JMP I GETNAM
994 CLL RTL
995 RTL
996 RTL
997 DCA I TEMP2 /SAVE IT
998 JMS I (PATCH3
999 JMP I GETNAM
1000 TAD I TEMP2 /COMBINE THE 2
1001 DCA I TEMP2
1002 ISZ TEMP2
1003 ISZ SIZE /ANY MORE ?
1004 JMP NAMLUP
1005 JMP I GETNAM
1006RENAME, CLL CML RAR /SAVE USR AREA
1007 JMS GETFN /GET FILE NAME
1008 CIF 10
1009 JMS I O200 /REMOVE USR
1010 11 /AND RESTORE 10000-11777
1011 JMS I [SWAP /SWAP OS8 RESIDENT
1012 JMP I [CMDDONE
1013NEW, TAD [TXTAREA /SCRATCH
1014 JMS I [SETEOF
1015 DCA EOFLIN /ZERO LAST LINE NUM
1016 DCA EOFLIN+1
1017 JMS GETFN /GET THE FILE NAME
1018 JMS I [SWAP /REMOVE OS8
1019 JMP I [CMDDONE
1020
1021 PAGE
1022\fPUTFIL, 0 /WRITE THE FILE
1023 TAD [TXTAREA
1024 DCA PTR /GET POINTER TO TEXT
1025 TAD O6201 /GET FIELD OF TEXT
1026 DCA I [PTR2FLD
1027 DCA TEMP /ZERO LINE SEQUENCER
1028 TAD [DSKBUF /GET ADDR OF DISK BUFFER
1029 DCA SWAPT1 /BUFFER POINTER
1030 TAD O7600
1031 DCA SWAPT2 /DOUBLE WORD COUNTER
1032 TAD JMPINS /SET 3 WAY SWITCH
1033 DCA PUTJMP
1034PFLOOP, JMS I [GETFIL /GET A CHAR FROM TEXT AREA
1035 JMP PFCTLZ /END OF FILE
1036 JMS PUTCH /OUTPUT IT
1037 JMP PFLOOP /DO NEXT CHAR
1038PFCTLZ, TAD O232 /PUT CTRL-Z
1039 JMS PUTCH
1040 TAD O7201 /BUFFER DUMP COUNT
1041 DCA PFTEMP
1042 JMS PUTCH /FILL WITH ZEROES
1043 ISZ PFTEMP
1044 JMP .-2
1045 JMP I PUTFIL /DONE
1046PFTEMP, 0
1047PUTCH, 0 /PUT A CHAR ONTO THE OS8 FILE
1048 DCA SWAPT4 /SAVE THE CHAR
1049PUTJMP, HLT /JUMP TO CORRECT PLACE
1050 JMP PH1 /FIRST CHAR
1051 JMP PH2 /SECOND CHAR
1052PH3, TAD JMPINS /RESTORE SWITCH
1053 DCA PUTJMP
1054 TAD SWAPT4 /GET THE CHAR
1055 AND O17 /LOW FOUR BITS
1056 CLL RAR
1057 RTR /INTO THE HIGH PART OF WORD TWO
1058 RTR
1059 TAD I SWAPT1 /COMBINE WITH CHAR 2
1060 DCA I SWAPT1
1061 TAD SWAPT4 /GET THE HIGH FOUR BITS
1062 RTL
1063 RTL /INTO THE HIGH PART OF WORD ONE
1064 AND O7400
1065 TAD I SWAPT3 /COMBINE WITH WORD ONE
1066 DCA I SWAPT3
1067 ISZ SWAPT1 /BUMP POINTER
1068 ISZ SWAPT2 /BUMP DOUBLE WORD COUNT
1069 JMP I PUTCH /RETURN
1070 JMS I [SWAP /SWAP IN OS8
1071 JMS I DEVHAN /WRITE THIS BUFFER
1072 4200
1073 DSKBUF
1074WRBLOK, 0
1075 JMP I (OUERR
1076 ISZ OUSIZE /ANY ROOM LEFT ?
1077 SKP
1078 JMP I (OUERR /NO, ERROR
1079 ISZ WRBLOK /BUMP BLOCK NUMBER
1080 ISZ I (OULEN /BUMP ACTUAL SIZE
1081 JMS I [SWAP /SWAP BACK
1082 TAD [DSKBUF /SET UP BUFFER POINTER
1083 DCA SWAPT1
1084 TAD O7600
1085 DCA SWAPT2 /SET UP COUNT
1086 JMP I PUTCH
1087PH2, TAD SWAPT1 /SAVE POINTER TO FIRST
1088 DCA SWAPT3
1089 ISZ SWAPT1 /BUMP POINTER
1090PH1, TAD SWAPT4 /GET CHAR
1091 DCA I SWAPT1 /INTO BUFFER
1092 ISZ PUTJMP /BUMP SWITCH
1093 JMP I PUTCH
1094JMPINS, JMP PUTJMP+1
1095OUSIZE, 0
1096SWAP, 0 /SWAP OS8 RESIDENT
1097 ISZ SWPNUM /FLIP BYEBYE SWITCH
1098 NOP
1099 JMS SWAP2 /WITH OS8RES THROUGH OS8RES+577
1100 OS8RES
1101 CDF
1102 JMS SWAP2
1103 OS8RES+200
1104 CDF 10
1105PATCH5, JMS SWAP2 /OVERLAID IF <12K
1106 OS8RES+400
1107 CDF 20
1108 JMP I SWAP
1109SWAP2, 0
1110 TAD O7600
1111 DCA SWAPT3
1112 TAD I SWAP2
1113 ISZ SWAP2
1114 DCA SWAPT4
1115 TAD I SWAP2
1116 ISZ SWAP2
1117 DCA SWPFLD
1118 JMP .+5
1119SWPLUP, CDF 00
1120 TAD SWAPT1
1121 DCA I SWAPT4
1122 ISZ SWAPT4
1123 TAD I SWAPT4
1124 DCA SWAPT2
1125SWPFLD, HLT
1126 TAD I SWAPT3
1127 DCA SWAPT1
1128 TAD SWAPT2
1129 DCA I SWAPT3
1130 ISZ SWAPT3
1131 JMP SWPLUP
1132 CDF 00
1133 TAD SWAPT1
1134 DCA I SWAPT4
1135 JMP I SWAP2
1136BADFIL, 4342;4501;4752;5546;0
1137ASKFN, 4752;5546;0157;4256;4616;1600
1138
1139 PAGE
1140\fRUN, TAD I [LINE+3 /RUNNH ?
1141 TAD I [LINE+4
1142 TAD (-3057
1143 SZA CLA
1144 JMS I [HEADING/GIVE A HEADING
1145 TAD [LINE+2 /SET UP FAKE LINE
1146 DCA TEMP
1147 TAD [WSSAVE
1148 DCA PTR
1149 TAD O7771
1150 DCA TEMP2
1151 TAD I PTR /MOVE FAKE LINE INTO "LINE"
1152 ISZ PTR
1153 DCA I TEMP
1154 ISZ TEMP
1155 ISZ TEMP2
1156 JMP .-5
1157 ISZ RUNFLAG /SET RUN FLAG
1158 JMP GFN
1159SAVE, DCA RUNFLAG /CLEAR THE RUN FLAG
1160 TAD DEVNUM /SAVE CURRENT DEVICE NUM
1161 DCA OLDDEV /INCASE WE CHANGE
1162GFN, CLA IAC /SET SAVFLAG
1163 JMS I [GETFN /GET THE DEV:NAME.EX
1164 TAD XNAME /SET UP ENTER
1165 DCA SAVBLK /POINTER TO FILE NAME
1166 TAD DEVNUM /GET DEVICE NUMBER
1167 CIF 10
1168 JMS I O200 /ENTER FILE
1169 3
1170SAVBLK, 0 /STARTING BLOCK GOES HERE
1171 0 /SIZE GOES HERE
1172 JMP I (IOERR
1173 TAD SAVBLK /PUT BLOCK NUMBER
1174 DCA I (WRBLOK /INTO WRITE
1175 TAD SAVBLK+1/PUT SIZE
1176 DCA I (OUSIZE /SOMEWHERE TOO
1177 DCA OULEN /ZERO BLOCK COUNT
1178 CIF 10
1179 JMS I O200 /DUMP USR
1180 11
1181 JMS I [SWAP /AND NOW OS8
1182 JMS I (PUTFIL /DO THE SAVE
1183 JMS I [SWAP /GET OS8
1184 TAD RUNFLAG /SET NO SWAP BIT IF RUN
1185 DCA I (7746
1186 CIF 10 /GET THE USR
1187 JMS I O7700
1188 10
1189 TAD DEVNUM /GET DEVICE NUMBER
1190 CIF 10
1191 JMS I O200 /CLOSE THE FILE
1192 4
1193XNAME, NAME
1194OULEN, 0 /SIZE
1195 JMP I (IOERR
1196 TAD RUNFLAG /WAS IT A RUN ?
1197 SZA CLA
1198 JMP I (DORUN /YES
1199 TAD OLDDEV /IS OLD DEVICE
1200 CIA /THE SAME AS
1201 TAD DEVNUM /THE NEW ONE ??
1202 SNA CLA
1203 JMP HNDLOK /YES, THE HANDLER IS OK
1204 TAD OLDDEV /RESTORE DEVICE NUMBER
1205 DCA DEVNUM
1206 TAD [HANDLR+1
1207 DCA DEVN /SET UP HANDLER LOAD ADDR
1208 TAD DEVNUM
1209 CIF 10
1210 JMS I O200
1211 1
1212DEVN, 0
1213 JMP I (IOERR
1214 TAD DEVN /RESET THE HANDLER ADDRESS
1215 DCA DEVHAN
1216HNDLOK, CIF 10 /GET RID OF THE USR
1217 JMS I O200
1218 11
1219 JMS I [SWAP /REMOVE OS8 AGAIN
1220 JMP I [CMDDONE
1221OLDDEV, 0
1222FINDLN, 0 /FIND A LINE
1223 TAD [TXTAREA
1224 DCA TEMP
1225SEARCH, TAD TEMP /COMPARE THE NUMBER OF
1226 DCA PTR /THIS LINE WITH THE SPOT
1227 TAD I TEMP /IN THE TEXT AREA.
1228 TAD O7701
1229 SNA
1230 JMP I FINDLN /NEW LINE GOES AT EOF
1231 TAD O77
1232 CLL CIA
1233 TAD LINENO
1234 SNA
1235 JMP SAME1ST
1236 SNL CLA
1237 JMP I FINDLN /INSERT NEW LINE
1238 ISZ TEMP
1239 SKP
1240 JMS I [FINCR
1241CONTIN, JMS I [PASS /IF ITS GREATER KEEP SEARCHING.
1242 JMP SEARCH
1243SAME1ST,ISZ TEMP /FIRST HALF OF LINE NUM SAME
1244 SKP
1245 JMS I [FINCR
1246 TAD I TEMP
1247 CLL CIA /CHECK SECOND HALF
1248 TAD LINENO+1
1249 SNA
1250 JMP SAME2ND /REPLACE OLD WITH NEW
1251 SZL CLA
1252 JMP CONTIN
1253 JMS I [FDECR
1254 TAD TEMP
1255 DCA PTR
1256 JMP I FINDLN /INSERT NEW LINE
1257SAME2ND,JMS I [PASS
1258 JMP I FINDLN
1259
1260 PAGE
1261\fDORUN, TAD (INFO+11/SET UP SOME OF INFO BLOCK
1262 DCA X10
1263 CDF 10
1264 TAD DEVHAN /SAVE DEVICE HANDLER ADDRESS (DSK:)
1265 DCA I X10
1266 CLL CML RTL /SAVE DEVICE NUMBER
1267 DCA I X10
1268 CDF
1269 TAD I (SAVBLK /SAVE STARTING BLOCK
1270 CDF 10
1271 DCA I X10
1272 TAD FNAME /SAVE FILE NAME
1273 DCA I X10
1274 TAD FNAME+1
1275 DCA I X10
1276 TAD FNAME+2
1277 DCA I X10
1278 TAD FNAME+3
1279 DCA I X10
1280 CDF
1281 JMS XMOVE /MOVE THIS PAGE INTO FIELD 1
1282 CDF
1283 DORUN
1284 CDF 10
1285 -200
1286 CDF CIF 10 /GO TO THE FIELD ONE COPY
1287RUNDO, JMS XMOVE /MOVE THE HANDLER INTO FIELD 1
1288 CDF
1289 HANDLR
1290 CDF 10
1291 -400
1292 TAD I (INFO+1 /GET START OF BCOMP.SV
1293 DCA BCBLOK
1294 CIF
1295 JMS I (7607 /READ IN THE COMPILER
1296 BCSIZE
1297 0
1298BCBLOK, 0
1299 JMP WHUPS
1300 JMS XMOVE /MOVE BACK THE HANDLER
1301 CDF 10
1302 HANDLR
1303 CDF
1304 -400
1305 CLA IAC /OPEN THE TEMP FILE
1306 JMS I (200
1307 3
1308TMPBLK, TMPFIL
1309 0
1310 JMP WHUPS
1311 JMS I (200 /RESET SYSTEM TABLES
1312 13 /AND REMOVE TENTATIVE FILES
1313 TAD TMPBLK /SAVE ITS START
1314 DCA I (INFO+10
1315 TAD TMPBLK+1
1316 DCA I (INFO+11 /AND ITS MAX LENGTH
1317 DCA I (7644 /KILL R SWITCH
1318 CIF CDF
1319 JMP I (BCBEGN /GO START THE COMPILER
1320WHUPS, TAD (123 /PRINT SY ERROR
1321 JMS TTYO
1322 TAD (131
1323 JMS TTYO
1324 TAD (15
1325 JMS TTYO
1326 TAD (12
1327 JMS TTYO
1328 TSF /WAIT FOR FLAG
1329 JMP .-1
1330 CDF CIF
1331 JMP I (7605 /RETURN TO OS8
1332TTYO, 0
1333 TSF
1334 JMP .-1
1335 TLS
1336 CLA
1337 JMP I TTYO
1338XMOVE, 0
1339 RDF /GET CALLING FIELD
1340 TAD (6203 /PLUS CIF CDF 0
1341 DCA MOVRTN /FOR RETURN
1342 JMS GMOVE /GET FROM FIELD
1343 DCA MFFLD
1344 JMS GMOVE /GET ADDRESS
1345 DCA MFPTR
1346 JMS GMOVE /GET TO FIELD
1347 DCA MTFLD
1348 JMS GMOVE /GET COUNT
1349 DCA MCNT
1350MFFLD, HLT
1351 TAD I MFPTR /MOVE IT
1352MTFLD, HLT
1353 DCA I MFPTR
1354 ISZ MFPTR
1355 ISZ MCNT
1356 JMP MFFLD
1357MOVRTN, HLT
1358 JMP I XMOVE
1359MFPTR, 0
1360MCNT,
1361GMOVE, 0
1362 TAD I XMOVE /GET ARG FOR MOVE
1363 ISZ XMOVE
1364 JMP I GMOVE
1365TMPFIL, FILENAME BASIC.TM
1366PATCH1, CLA
1367 TAD (400
1368 DCA [LNDIG
1369 DCA NCHARS
1370 JMP I (NOSKIP
1371
1372 PAGE
1373\fGETCH, 0 /GET A CHARACTER FROM THE TTY
1374 TAD OLDFLAG /INPUT FROM A FILE ?
1375 SZA CLA
1376 JMP FILEIN /YES
1377 KSF
1378 JMP .-1
1379 KRB
1380 AND O177
1381 JMP I GETCH
1382FILEIN, ISZ COUNT /ANYTHING IN BUFFER ?
1383 JMP NOREAD /YES, NO READ
1384 TAD O7200 /SET BUFFER COUNT
1385 DCA COUNT
1386 TAD [DSKBUF /SET BUFFER POINTER
1387 DCA RDPTR
1388 TAD RDJMP /RESET JUMP
1389 DCA NOREAD
1390 JMS I [SWAP /GET OS8
1391 TAD RDSIZE /ANY ROOM LEFT ?
1392 SNA
1393 JMP INERR /BAD END OF IFILE
1394 IAC
1395 DCA RDSIZE
1396 JMS I DEVHAN /READ NEXT BLOCK
1397 200
1398 DSKBUF
1399RDBLOK, 0
1400 JMP CHKSOF /CHECK FOR SOFT ERROR
1401SOFTOK, ISZ RDBLOK /BUMP BLOCK NUMBER
1402 JMS I [SWAP /AWAY WITH OS8
1403NOREAD, HLT /3W UNPACK JUMP
1404 JMP INCHR1
1405 JMP INCHR2
1406INCHR3, TAD RDJMP /RESET SWITCH
1407 DCA NOREAD
1408 TAD I RDPTR /GET LOW 4 BITS
1409 ISZ RDPTR /BUMP POINTER
1410 AND O7400 /MASK IT
1411 CLL RTR /SHIFT RIGHT 4
1412 RTR
1413 DCA TEMP /SAVE
1414 TAD I RDTMP /GET HIGH 4 BITS
1415 AND O7400
1416 TAD TEMP /COMBINE THEM
1417 CLL RTR /SHIFT RIGHT 4
1418 RTR
1419 JMP AND177 /GO FINISH
1420INCHR2, TAD RDPTR /SAVE ADDR OF FIRST WORD
1421 DCA RDTMP
1422 ISZ RDPTR /BUMP POINTER
1423INCHR1, TAD I RDPTR /GET NEXT CHAR
1424 ISZ NOREAD /BUMP SWITCH
1425AND177, AND O177 /MASK 7 BITS
1426 TAD O7746 /CHECK FOR ^Z
1427 SNA
1428 JMP ENDOLD /EOF
1429 TAD O32 /RESTORE CHAR
1430 JMP I GETCH
1431ENDOLD, DCA OLDFLAG /KILL OLD FLAG
1432 TAD CHNFLAG /WAS IT A RETURN FROM RUN ?
1433 SNA CLA
1434 JMP I [CMDDONE/NO, JUST AN OLD COMMAND
1435 DCA CHNFLAG /KILL FLAG
1436 TAD (INFO-3764
1437 DCA X10 /PICK UP NAME FROM INFO BLOCK
1438 TAD I X10 /(WHICH IS SWAPPED OUT)
1439 DCA FNAME
1440 TAD I X10
1441 DCA FNAME+1
1442 TAD I X10
1443 DCA FNAME+2
1444 TAD I X10
1445 DCA FNAME+3
1446 JMP I [CMDDONE/DONE WITH RETURN
1447OLDBAD, DCA FNAME+3 /TRY WITHOUT EXT
1448 ISZ TEMP /OR HAVE WE ALREADY ?
1449 JMP OLDTRY /NO, NOT YET
1450IOERR,
1451INERRX, CIF 10
1452 JMS I O200 /DISMISS USR
1453 11
1454OUERR,
1455INERR, DCA OLDFLAG /KILL OLD STATUS
1456 JMS I [SWAP /OUT WITH OS8
1457 JMS I [TYPE /PRINT MESSAGE
1458 BADFIL
1459 JMP I [MAINLUP
1460OLD, TAD [TXTAREA/SCRATCH FILE
1461 JMS I [SETEOF
1462 DCA EOFLIN /ZERO LAST LINE NUM
1463 DCA EOFLIN+1
1464 JMS I [GETFN /GET FILE NAME
1465 CLL CMA RAL /SET RETRY COUNT
1466 DCA TEMP
1467OLDTRY, TAD [FNAME /POINTER TO FILE NAME
1468 DCA SB /INTO LOOKUP CALL
1469 TAD DEVNUM /GET DEVICE NUMBER
1470 CIF 10
1471 JMS I O200 /LOOKUP FILE
1472 2
1473SB, 0 /START GOES HERE
1474RDSIZE, 0 /SIZE GOES HERE
1475 JMP OLDBAD /BAD FILE
1476 TAD SB /MOVE BLOCK
1477 SNA
1478 ISZ RDSIZE /SET COUNT TO 4095 IF NOT D.A.
1479 DCA RDBLOK
1480 CLA IAC /SET SWITCH
1481 DCA OLDFLAG /INPUT COMING FROM FILE
1482 CLA CMA /SET COUNT TO INITIALIZE READ
1483 DCA COUNT
1484 JMS I [SWAP /MOVE OS8
1485 JMP I [MAINLUP/DO OLD
1486RDJMP, JMP NOREAD+1
1487COUNT, 0
1488PATCH2, JMS I [SRCHBK
1489 01
1490 32
1491 JMP I (EXA
1492 TAD (-56
1493 SZA CLA
1494 JMP INERRX
1495 JMP I (PATCH4
1496/
1497CHKSOF, SMA CLA
1498 JMP SOFTOK /SOFT ERROR
1499 JMP INERR
1500
1501 PAGE
1502\fHEIGHT, -30 /SET TO SCREEN HEIGHT BY SET COMMAND
1503SDELAY, -200 /SET TO HOLD SCREEN DELAY BY SET COMMAND
1504 IFNZRO HEIGHT-3000 <__FIX SET COMMAND__>
1505LINCNT, 0 /THIS WORD IS ZERO TO FLAG THE NEW BASIC EDITOR TO "SET"
1506CURPOS, 0
1507
1508STIMER, 0
1509SCOPFG, 0 /SET NONZERO IF TERMINAL IS A SCOPE
1510
1511 /SKIP IF ^O NOT TYPED AND CLEAR 'COFLG'
1512 /RETURN TO CALL+1 IF ^O WAS TYPED AND SET 'COFLG'
1513 /SET OR CLEAR 'CLFLG' IF ^S OR ^Q TYPED OTHERWISE
1514
1515ZERO,
1516CTRLO, 0
1517 KSF
1518 JMP CTRLOX
1519 KRB
1520 AND A177
1521 TAD MCC
1522 SNA
1523 JMP I (BYEBYE
1524 TAD MCO
1525 SNA
1526 JMP CTRLOX+2
1527 TAD MCQ
1528 SNA
1529 JMP SETFLG+1
1530 TAD MCS
1531 SNA
1532 JMP SETFLG
1533CTRLOX, ISZ CTRLO
1534 CLA IAC
1535 DCA COFLAG
1536 JMP I CTRLO
1537
1538SETFLG, IAC
1539 DCA CSFLG
1540 JMP CTRLOX
1541
1542
1543CRLF, 0
1544 TAD O215
1545 JMS I [TTYOUT
1546 TAD O212
1547 JMS I [TTYOUT
1548 JMP I CRLF
1549
1550 /PRINT A CHAR ON TERMINAL
1551 /PAUSE IF LF WAS PRINTED AND DELAY REQUESTED
1552 /SCREENSIZE ALSO SET BY "SET TTY" COMMAND
1553
1554TTYOUT, 0
1555 TSF /FIRST WAIT
1556 JMP .-1
1557 TLS /NOW PRINT THE CHAR
1558 AND A177
1559 TAD (-15 /TEST IF LF WILL FOLLOW
1560 SZA CLA
1561 JMP I TTYOUT /RETURN IF NO
1562 ISZ LINCNT /TEST LINE COUNTER FOR SCREENFULL
1563 JMP I TTYOUT
1564 TAD HEIGHT
1565 DCA LINCNT /NOW RESET SCREEN COUNTER
1566 TAD SDELAY
1567 SNA /SKIP IF DELAY REQUESTED
1568 JMP I TTYOUT /OTHERWISE JUST RETURN AT ONCE
1569 DCA STIMER /SET HOLD SCREEN TIMER
1570DLOOP, KSF /FIRST TEST IF KEY STRUCK
1571 JMP NOKST /JMP IF NO
1572 KRS /ELSE READ CHAR
1573 AND A177 /MASK TO 7BIT
1574 TAD MCC
1575 SNA
1576 JMP I [BYEBYE /JMP IF ^C SEEN
1577 TAD MCO
1578 SZA
1579 TAD MCQ
1580 SZA
1581 TAD MCS
1582 SNA CLA
1583 JMP I TTYOUT /RETURN WITH CHAR STILL IN BUFFER IF ANY OF ABOVE SEEN
1584NOKST, ISZ ZERO
1585 JMP .-1 /LOOP 4096 TIMES (USUALLY)
1586 ISZ STIMER /TEST DELAY COUNTER
1587 JMP DLOOP /REITERATE IF NOT DONE
1588 JMP I TTYOUT /ELSE RETURN FOR MORE
1589
1590MCC, -3
1591MCO, -17+3
1592MCQ, -21+17
1593MCS, -23+21
1594A177, 177
1595
1596 /PRINT A BACKSPACE
1597 /IF TERMINAL IS A SCOPE, ECHO BS,SP,BS TO RUBOUT AND REPOSITION
1598 /CURSOR. OTHERWWISE ECHO BACKARROW
1599
1600PRTBSP, 0
1601 TAD SCOPFG /TEST SCOPE BIT
1602 SNA CLA
1603 JMP BKARRW /NOT - ECHO BACKARROW
1604 TAD NCHARS /SEE IF AT LEFT MARGIN
1605 TAD NDIGS
1606 SNA CLA
1607 JMP I PRTBSP /DO NOTHING IF YES
1608 TAD O10 /ELSE ECHO BS
1609 JMS I [TTYOUT
1610 TAD (40
1611 JMS I [TTYOUT /SP
1612 TAD O10
1613 SKP /BS
1614JUSTSP, TAD (40 /SPACE
1615 JMS I [TTYOUT
1616 JMP I PRTBSP /DONE
1617BKARRW, TAD ("_
1618 JMS I [TTYOUT
1619 JMP I PRTBSP
1620
1621 PAGE
1622\fLINE, /THE TELETYPE LINE BUFFER.
1623WSNAME, 0;0;0145;6454;3343;4264;5244;1770;6400
1624START, JMP RBASIC /IT WAS RAN
1625 CDF 10 /IF CHAINED TO CHECK IF CCL PASSED
1626 TAD I (7644 /Q SWITCH IN RESPONSE TO .BASIC COMMAND (OS78)
1627 CDF
1628 AND O200 /ISOLATE THE BIT
1629 SZA CLA
1630 JMP RBASIC /TREAT AS .R BASIC IF YES
1631 JMS I (CORE
1632 CLA IAC
1633 DCA I (JSW /NO SWAP
1634 CIF 10
1635 JMS I (7700 /FETCH USR
1636 10
1637 CIF 10
1638 JMS I (200 /RESET SYSTEM TABLES
1639 13
1640 TLS /SET TTY FLAG
1641 JMS GETDAT /SET UP TITLE
1642 ISZ CHNFLAG /TELL ABOUT RETURN FROM RUN
1643 JMP I (OLD /READ IN OLD WORK SPACE
1644RBASIC, CDF 10
1645 DCA I (7643
1646 DCA I (7644
1647 CDF 0
1648 TLS
1649 JMS I (CORE
1650 TAD O77
1651 DCA I [TXTAREA
1652 JMS GETDAT /SET UP TITLE
1653FINDSV, TAD I X11 /LOOK UP SOME SAVE FILES
1654 SNA
1655 JMP LUBUF /GO FIND BASIC.UF
1656 DCA XXXXSV /SAVE POINTER TO NAME
1657 CLA IAC
1658 CIF 10
1659 JMS I (200
1660 2
1661XXXXSV, 0
1662 0
1663 JMP NG
1664 IAC
1665 CDF 10
1666 TAD XXXXSV
1667 DCA I X10 /SAVE BLOCK PLUS 1
1668 CDF /IN INFO AREA
1669 JMP FINDSV
1670LUBUF, CLA IAC /FIND BASIC.UF
1671 CIF 10
1672 JMS I (200
1673 2
1674 BUFN
1675 0
1676 JMP .+3 /OK IF MISSING
1677 TAD .-3
1678 IAC /SAVE BLOCK +1
1679 CDF 10
1680 DCA I X10
1681 CDF
1682 CLA IAC /TYPE WITH NO CARRIAGE RETURN
1683 JMS I [TYPE /"OLD OR NEW -- "
1684 OLDNEW
1685 JMS I [SWAP
1686 JMP I (MAINLUP
1687NG, JMS I [TYPE /PART OF SYSTEM MISSING
1688 MISING
1689 JMP I (7605
1690
1691 /THE FOLLOWING ROUTINE ASSUMES THAT THE YEAR IS ALREADY
1692 /SET UP BY A CALL TO "CORE" - JR
1693
1694GETDAT, 0 /PUT OS8 DATE INTO THE TITLE
1695 CDF 10
1696 TAD I (MDATE /GET DATE WORD
1697 CDF
1698 DCA TEMP2 /SAVE IT
1699 TAD TEMP2
1700 SNA
1701 JMP I GETDAT /NO DATE
1702 AND O7400 /GET MONTH
1703 CLL RTL /SHIFT SOME
1704 RTL
1705 RTL
1706 TAD (MONTHS-3
1707 DCA X12
1708 TAD (DATE-1 /SET UP POINTER TO DATE
1709 DCA X13
1710 TAD TEMP2 /GET DAY
1711 RTR
1712 RAR
1713 AND O37
1714 JMP DAYGO /CONVER TO TEXT
1715DAYLP, TAD (100-12 /REDUCE AND TALLY QUOTIENT
1716 TAD TEMP
1717DAYGO, DCA TEMP
1718 TAD TEMP /SEE IF OVERFLOW
1719 AND O77
1720 TAD O7766
1721 SMA CLA
1722 JMP DAYLP /REDUCE MOD 10 IF NOT
1723 TAD TEMP
1724 TAD (2121 /UNPACK TO HANK'S ASCII
1725 DCA I X13 /INTO DATE
1726 TAD I X12 /GET MONTH CHARS
1727 DCA I X13
1728 TAD I X12
1729 DCA I X13
1730/ TAD TEMP2 /GET YEAR
1731/ AND (7
1732/ TAD (21
1733/ CLL RTL
1734/ RTL
1735/ RTL
1736/ ISZ X13 /THE WORD WITH -7 IS THERE
1737/ DCA I X13 /STORE LAST DIGIT OF YEAR
1738
1739 /ABOVE JOB DONE BY "CORE" DURING INIT TIME
1740
1741 JMP I GETDAT
1742
1743 PAGE
1744\fMONTHS, 1653;4257 /-JAN
1745 1647;4643 /-FEB
1746 1656;4263 /-MAR
1747 1642;6163 /-APR
1748 1656;4272 /-MAY
1749 1653;6657 /-JUN
1750 1653;6655 /-JUL
1751 1642;6650 /-AUG
1752 1664;4661 /-SEP
1753 1660;4465 /-OCT
1754 1657;6067 /-NOV
1755 1645;4644 /-DEC
1756NAMLST, BASICN
1757 BCOMPN
1758 BLOADN
1759 BRTSN
1760 BAFN
1761 BSFN
1762 BFFN
1763 0
1764BASICN, FILENAME BASIC.SV
1765BCOMPN, FILENAME BCOMP.SV
1766BLOADN, FILENAME BLOAD.SV
1767BRTSN, FILENAME BRTS.SV
1768BAFN, FILENAME BASIC.AF
1769BSFN, FILENAME BASIC.SF
1770BFFN, FILENAME BASIC.FF
1771BUFN, FILENAME BASIC.UF
1772MISING, 5257;4460;5661;5546;6546;0164;7264;6546;5600
1773OLDNEW, 5746;7001;6063;0160;5545;1616;0
1774
1775 PAGE
1776\f /THIS PAGE GETS WIPED OUT SOON
1777
1778 /ROUTINE TO GET CORESIZE, SETUP DATE IN HEADING
1779 /AND SET SCOPE / TTY FLAG FOR RUBOUT TREATMENT
1780
1781
1782CORE, 0 /CORE SIZE SUBROUTINE
1783 CDF 10 /GET INTO DATE FIELD
1784 TAD I (MDATE
1785 CDF /RESET FIELD
1786 AND (7 /LOOK AT LOW YEAR BITS
1787 DCA TEMP /HOLD
1788 TAD I (BIPCCL /NOW GET THE EXTENDED BITS
1789 AND (600 /FROM THE 600 BITS
1790 CLL RTR
1791 CLL RTR /SHIFT INTO PLACE
1792 TAD TEMP /ADD TO LOW BITS
1793 ISZ I (DASH6 /BUMP THE YEAR TENS DIGIT
1794 TAD (-12
1795 SMA /SKP IF .LT. 10 OFF OF 1970
1796 JMP .-3 /ELSE DECR AGAIN
1797 TAD (12+21 /CONVERT TO "HANKS ASCII"
1798 CLL RTL
1799 RTL
1800 RTL /SWAP TO LEFT HALF BYTE
1801 DCA I (EODAT /NOW STORE IN DATE TEMPLATE
1802 CDF 10
1803 TAD I (7726 /LOOK AT HLT/CLA HLT SCOPE KLUDGE
1804 CDF
1805 AND O200 /GET SCOPE BIT
1806 DCA I (SCOPFG /AND STORE IT
1807
1808 /STANDARD OS/8 CORESIZE ROUTINE
1809
1810 TAD I (7777
1811 AND COR70
1812 CLL RAR
1813 RTR
1814 SNA
1815 JMP COR0
1816 IAC
1817 DCA CORSIZ
1818 JMP COREX
1819COR0, CDF
1820 TAD CORSIZ
1821 RTL
1822 RAL
1823 AND COR70
1824 TAD COREX
1825 DCA .+1
1826COR1, CDF
1827 TAD I CORLOC
1828COR2, NOP
1829 DCA COR1
1830 TAD COR2
1831 DCA I CORLOC
1832COR70, 70
1833 TAD I CORLOC
1834CORX, 7400
1835 TAD CORX
1836 TAD CORV
1837 SZA CLA
1838 JMP COREX
1839 TAD COR1
1840 DCA I CORLOC
1841 ISZ CORSIZ
1842 JMP COR0
1843COREX, CDF
1844 TAD CORSIZ
1845 CIA
1846 DCA CORSIZ
1847 CLL CML CLA RTL /2
1848 TAD CORSIZ
1849 SZA CLA
1850 JMP I CORE
1851 TAD (SWAP&177+5600
1852 DCA I (PATCH5
1853 JMP I CORE
1854CORLOC, CORX
1855CORV, 1400
1856
1857 $$
My complete PDP-8 universe