4bd98b2b9d871bdf49bbb807f8663d949285b78c
[pdp8.git] / sw / os8 / v3d / sources / extensions / dectapes / dectape2 / bload.pa
1 /OS8 BASIC LOADER, V5
2 /
3 /
4 /
5 /
6 /
7 /
8 //
9 /
10 /
11 /
12 /
13 /COPYRIGHT (C) 1972, 1973, 1974, 1975
14 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
15 /
16 /
17 /
18 /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
19 /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
20 /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
21 /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
22 /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
23 /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
24 /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
25 /
26 /
27 /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
28 /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
29 /EQUIPMRNT COROPATION.
30 /
31 /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
32 /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
33 /
34 /
35 /
36 /
37 /
38 /
39 \f/DEC-S8-LBASA-B-LA
40 /
41 /COPYRIGHT C 1972, 1973, 1974
42 /
43 /DIGITAL EQUIPMENT CORPORATION
44 /MAYNARD,MASSACHUSETTS 01754
45 /
46 /AUGUST 19, 1972
47 /
48 /HANK MAURER, 1972
49 /SHAWN SPILMAN, 1973
50 /
51 /
52 /
53 /
54 /ASSEMBLE AND LOAD AS FOLLOWS:
55 /
56 / .R PAL8
57 / *BLOAD,BLOAD<BLOAD.03
58 / .R ABSLDR
59 / *BLOAD$
60 / .SA SYS BLOAD;7605
61 /
62 /NOTE DIFFERENCES FROM VERSION 1 BY TRUNCATING
63 /THE SOURCE AFTER TAG "IMAGE" AND THEN:
64 /
65 / .R SRCCOM
66 / *LPT:<BLOAD.01,BLOAD.03
67 / *
68 /
69 /ALL CODE FOLLOWING TAG "IMAGE" IS NEW FOR VERSION 3
70 /
71 VERSON= 5 /VERSION WORD LOCATED AT TAG "VERLOC"
72 /LEFT HALF CONTAINS 60+VERSON
73 /RIGHT HALF CONTAINS PATCH LEVEL (A=01)
74
75 /
76 /CORRECTIONS MADE FOR V4 J.K 1975
77 / .MADE SWAP ROUTINE A REAL SWAP
78 / ./V FOR VERSION NUMBER
79 / ./C SO NON-BASIC SAVE FILES CAN CHAIN TO BASIC SAVE FILES
80 / .ADJUST JSW FOR /K
81 / .CORRECTED CCB FOR /K
82 / .CALCULATION OF DEFAULT CORE SIZE FOR PDP-8
83 / .TEST FOR BATCH RUNNIG
84 / .CHANGE ORDER OF CISTRT SO A CHAIN CAN BE
85 / CAN BE DONE FROM A .SV FILE WITH A
86 / FILE STATEMENT
87 /
88
89 /JR 30-APR-77 UPDATE VERSION AND FIX ERROR IN MAKECI WHEN BATCH NOT
90 / RUNNING
91 \f /OS8 BASIC COMPILER POST PROCESSOR
92
93 /AUTO INDEX REGISTERS
94
95 X10=10
96 X11=11
97 X13=13
98 STACK=15
99
100 /DUMMY SECTIONS FOR COMPILER/RUNTIME COMMUNICATIONS
101
102 NOPUNCH
103
104 /BRTS COMMUNICATIONS REGION
105
106 *20
107 STCDF, 0
108 NSTADR, 0
109 NASTAD, 0
110 SSTADR, 0
111 SASTAD, 0
112 CODCDF, 0
113 CODBGN, 0
114 DATTOP, 0
115 DATPTR, 0
116 SWPINF, 0
117
118 /BCOMP COMMON REGION
119
120 *40
121 VARCNT, 0
122 SVCNT, 0
123 ACNT, 0
124 SACNT, 0
125 LOCTRH, 0
126 LOCTRL, 0
127 BLOCK, 0
128 HIFLD, 0
129 BRTS, 0
130 DLSIZE, 0
131 ABORTX, 0
132
133 /PAGE 0 LOCATIONS USED BY LOADER
134
135 FREEHI, 0
136 FREELO, 0
137 TEMP, 0
138 TEMP2, 0
139 TEMP3, 0
140 WORD1, 0
141 WORD2, 0
142 WORD3, 0
143 NCHARS, 0
144 SUBHI, 0
145 SUBLO, 0
146 CODSZ1, 0
147 CODSZ2, 0
148 LOCHI, 0
149 LOCLO, 0
150 CODB, 0
151 CODF, 0
152 ICOUNT, 0
153 OCOUNT, 0
154 AC1, 0
155 AC2, 0
156 AC3, 0
157 SC, 0
158 LINEH, 0
159 LINEL, 0
160 XLABEL, 0
161 CLRFLD, 0
162 CLREND, 0
163 RESADR, 0
164
165 /MORE COMPILER DEFINITIONS
166
167 SVARST= 1036
168 ARAYST= 2132
169 SARYST= 2332
170 STEMPS= 2560
171 LITRL= STEMPS+2
172 SLITRL= LITRL+2
173 DATLST= SLITRL+2
174
175 /MISC DEFINES
176
177 STACKA= 7120 /MAIN STACK OF COMPILER
178 EDTBGN= 3212 /START OF EDITOR
179 EDTSIZ= 2100 /SIZE OF EDITOR
180 BRTBGN= 200 /START OF BRTS
181 BRTSIZ= 3400 /SIZE OF BRTS
182 DCB= 7760
183 JSW= 7746 /OS/8 JOB STATUS WORD
184 BIPCCL= 7777 /OS/8 SOFTWARE CORE SIZE AND BATCH FLAGS WORD
185 FSTOP1= 7 /ADDR OF BRTS EXIT ROUTINE
186
187 ENPUNCH /END OF DUMMY SECTIONS
188 \f /LOADER PROPER
189
190 *400
191 LOADER, JMS I (IMAGE /CORE IMAGE FILE PATCH
192 TAD (7577 /EXECUTION RESUMES HERE
193 DCA FREELO
194 CIA IAC
195 DCA SWPINF /SET SWAPPER FLAG TO INDICATE 17600 IS IN FIELD 1
196 DCA LINEH /CLEAR LINE NUMBER
197 DCA LINEL
198 TAD STACK /ANY UNCLOSED FOR'S ?
199 CIA
200 TAD (STACKA-1
201 SNA CLA
202 JMP .+3 /NO
203 JMS I (ERMSG /YES
204 2506
205 CLA CMA
206 TAD HIFLD /NO CDF'S IF ONLY 8K
207 SZA CLA
208 JMP NOPATCH /NO PATCHES
209 TAD (PATLST-1
210 DCA X10
211 PATLUP, TAD I X10
212 SNA
213 JMP I (STSTUF
214 DCA TEMP
215 TAD (SKP /ALWAYS TWO WORDS
216 DCA I TEMP
217 JMP PATLUP
218 NOPATCH,CDF 10
219 TAD I (DCB /CHECK FOR TD8E SYSTEM
220 AND (770 /ED FRIEDMAN GAVE ME THIS CODE
221 TAD (-210 /AND I'M TAKING IT ON FAITH
222 CDF
223 SNA CLA
224 TAD I (7612 /IS IT A ROM SYSTEM ?
225 TAD (-3
226 SZA CLA
227 GOTTD, JMP NOTD8E /NO TD/8E OR ROM TD/8E
228 /PREV INSTR NOP'D OUT TO FORCE TD8E (IMAGE)
229 TAD (7377 /TD8E SYS WASTES 400 WORDS
230 DCA FREELO
231 STL RAR /SET SWAP INFO (17600 OUT NOW)
232 NOTD8E, DCA SWPINF
233 JMS I (FREEF /GET CDF TO HIGHEST FIELD
234 DCA SWPF1 /INTO 2 PLACES
235 TAD SWPF1
236 DCA SWPF2
237 JMS SWAP /MOVE OS8 OUT
238 TAD (TAD L6221
239 DCA TDLIE+1
240 TAD (TAD L6221
241 DCA TDLIE+3
242 JMP I (STSTUF /DO SYMBOL TABLE STUFF
243 \fSWAP, 0 /SWAP OS8 RESIDENT
244 CLL CML RAR /4000
245 AND SWPINF /IS IT A TD8E SYS ?
246 SZA CLA
247 JMP TD8ESYS /YES
248 JMS SWPSUB /SWAP 17600 TO/FROM N7600
249 CDF 10
250 7600
251 JMP I SWAP
252 TD8ESYS,JMS SWPSUB /SWAP 17600 TO/FROM N7400
253 CDF 10
254 7400
255 JMS SWPSUB /SWAP 27600 TO/FROM N7600
256 L6221, CDF 20
257 L7600, 7600
258 TDLIE, CLL CML RTL /FIX UP 07600 STUFF TO MATCH
259 TAD SWPF1 /CIF CDF N0
260 DCA I (7642
261 TAD SWPF1
262 IAC /CIF N0
263 DCA I (7721
264 TAD I (7721
265 DCA I (7727
266 JMP I SWAP
267 SWPRET, CLA
268 CDF /RETURN IF 8K
269 JMP I SWAP
270 SWPFLAG,0
271
272 SWPSUB, 0 /SWAPPER
273 TAD I SWPSUB /GET FIELD
274 DCA SWP1 /TWICE
275 TAD SWP1
276 DCA SWP2 /ONCE FOR EACH DIRECTION
277 ISZ SWPSUB
278 TAD I SWPSUB /GET HI FIELD ADDR
279 DCA TEMP
280 ISZ SWPSUB
281 TAD L7600 /GET COUNT/POITER
282 DCA TEMP2
283 SWP1, HLT
284 TAD I TEMP2 /GET PART OF RESIDENT
285 DCA TEMP3
286 SWPF1, JMP SWPRET /RETURN IF 8K ONLY
287 TAD I TEMP
288 SWP2, HLT
289 DCA I TEMP2
290 TAD TEMP3
291 SWPF2, HLT
292 DCA I TEMP /INTO HI FIELD
293 ISZ TEMP /BUMP POINTER
294 NOP /JR PROTECT AGAINST WRAP AROUND
295 ISZ TEMP2 /AND PTR/CTR
296 JMP SWP1 /LOOP
297 CDF
298 JMP I SWPSUB
299
300 PAGE
301 \fNODATA, CDF
302 JMS I (FREEF /SAVE FIELD
303 CIA
304 DCA CLRFLD /FOR ARRAY CLEARING
305 TAD FREELO /SAVE THIS ADDR
306 CIA
307 DCA CLREND /FOR END OF ARRAY CLEAR
308 ISZ FREELO /MAKE IT NEXT FREE + 1
309 TAD (SVARST-1
310 DCA X10 /ALLOCATE STRING VARS
311 TAD (-436
312 DCA TEMP
313 ASVLUP, CDF 10
314 TAD I X10 /LOOK FOR DEFINED STRING VAR
315 DCA TEMP2 /SAVE SYMBOL NUMBER
316 TAD I X10 /GET SIZE
317 SPA
318 TAD (4010 /IF UNDEF USE 16 CHARS
319 DCA TEMP3
320 TAD TEMP2 /IS IT DEFINED ?
321 CDF
322 SMA CLA
323 JMS SVSTOR /YES, CREATE ENTRY
324 ISZ TEMP /BUMP COUNT
325 JMP ASVLUP /LOOP
326 CDF 10 /ALLOCATE STRING TEMPS
327 P6, TAD I (STEMPS+1
328 DCA STEMPF /INIT FIELD
329 TAD I (STEMPS /AND POINTER
330 SKP
331 STMLUP, TAD TEMP /LOOK AT NEXT ENTRY
332 SNA
333 JMP I (ALLOCA /DONE GO ALLOCATE ARRAYS
334 TAD (-1
335 DCA X10 /GET POINTER
336 STEMPF, CDF 10
337 TAD I X10 /GET ADDR OF NEXT ENTRY
338 DCA TEMP /SAVE IT
339 P7, TAD I X10 /AND ITS FIELD
340 DCA STEMPF
341 ISZ X10 /SKIP TEMP NUMBER
342 TAD I X10 /GET SYM NUMBER
343 DCA TEMP2
344 CDF
345 TAD (110 /GIVE IT MAX SIZE
346 DCA TEMP3
347 JMS SVSTOR /ALOOCATE IT
348 JMP STMLUP /LOOP
349 SVSTOR, 0 /MAKE ST ENTRY FOR STRING VAR
350 TAD TEMP2 /FIND ST ADDR
351 CLL RAL
352 TAD TEMP2
353 TAD SSTADR
354 DCA X11
355 TAD TEMP3 /NUMBER OF CHARS
356 TAD (3
357 CLL RAR
358 DCA SUBLO /NUMBER OF WORDS
359 DCA SUBHI
360 JMS SUB /FREEHI,LO=FREEHI,LO-SUBHI,LO
361 TAD FREELO /SAVE ADDR
362 DCA I X11
363 JMS I (FREEF /AND FIELD
364 DCA I X11
365 TAD TEMP3 /PUT IN MAX LENGTH
366 CIA /(NEGATIVE)
367 DCA I X11
368 JMP I SVSTOR
369 PSN, 0 /PRINT 3 DIGITS DECIMAL
370 DCA WORD2
371 CLL CMA RTL /-3
372 DCA XLABEL
373 PRNTSN, TAD WORD2 /GET NEXT DIGIT
374 CLL RTL /INTO THE LOW ORDER
375 RTL /THREE BITS AND THE LINK
376 DCA WORD2 /SAVE SHIFTED NUMBER
377 TAD WORD2 /NOW DO LAST SHIFT
378 RAL
379 AND (17 /ONLY FOUR BITS
380 SPACE, SZA
381 JMP NOZERO /NOT A ZERO
382 TAD I (TTY /ANY DIGITS YET ?
383 SNA CLA
384 JMP LEAD0 /NO, ITS A LEADING ZERO
385 NOZERO, TAD (60 /MAKE IT ASCII
386 JMS I (TTY /PRINT DIGIT
387 LEAD0, ISZ XLABEL /BUMP COUNT
388 JMP PRNTSN /MORE DIGIT(S)
389 JMP I PSN
390 SUB, 0 /DOUBLE SUBTRACT
391 TAD SUBLO /SUBTRACT LOWER
392 CLL CML CIA
393 TAD FREELO
394 DCA FREELO
395 RAL /GET BORROW
396 TAD SUBHI
397 CIA
398 TAD FREEHI /SUBTRACT UPPER
399 DCA FREEHI /SAVE NEW UPPER
400 TAD FREEHI /DID IT FIT ?
401 SMA SZA CLA
402 JMP I SUB /YUP
403 TOOBIG, DCA LINEH /CLEAR LINE NUMBER
404 DCA LINEL
405 JMS I (ERMSG /WRITE MESSAGE
406 2402 /TOO BIG
407 JMP I (ABORTL /ABORT RUN
408
409 TTX, 0 /PRINT CHAR ON TTY
410 TSF /WAIT FOR PREVIOUS CHAR
411 JMP .-1
412 TLS /PRINT THIS ONE
413 CLA
414 JMP I TTX
415
416 PAGE
417 \f/ CAUTION !!!
418 / THIS PAGE AND THE NEXT ONE ARE
419 / OVERLAYED BY THE INPUT BUFFER
420 / AS SOON AS THE ROUTINE "INWORD"
421 / IS CALLED. THIS FIRST HAPPENS
422 / AFTER THE TAG "RELCIT" .
423
424 STSTUF, TAD FREELO /SAVE START OF RESIDENT -1
425 CIA /NEGATED
426 DCA RESADR /USED TO COMPUTE AMOUNT OF MOVE
427 TAD VARCNT /GET NUMBER OF
428 TAD (401 /VARIABLES
429 CIA
430 DCA VARCNT
431 TAD SVCNT /STRING VARIABLES
432 TAD (401
433 CIA
434 DCA SVCNT
435 TAD ACNT /ARRAYS
436 TAD (41
437 CIA
438 DCA ACNT
439 TAD SACNT /AND STRING ARRAYS
440 TAD (41
441 CIA
442 DCA SACNT
443 JMS I (FREEF /SAVE HIGH FIELD
444 DCA STCDF
445 TAD VARCNT /SUBTRACT SPACE FOR
446 CLL RAL /SCALAR TABLE (3 WORDS A PIECE)
447 TAD VARCNT
448 TAD FREELO /DON'T BOTHER WITH A
449 DCA FREELO /DOUBLE PREC. SUBTRACTION
450 TAD FREELO /SAVE START OF SCALAR TABLE
451 IAC /FOR INTERPRETER
452 DCA NSTADR
453 TAD FREELO /CLEAR ALL VARIABLES
454 DCA X10 /IN THE
455 DCA I X10 /SCALAR TABLE
456 DCA I X10
457 DCA I X10
458 ISZ VARCNT
459 JMP .-4 /JUST TO BE NICE
460 CDF 10 /PREPARE TO MOVE
461 P1, TAD I (LITRL+1/THE NUMERIC LITERALS
462 DCA LFLD /INTO THE SCALAR TABLE
463 TAD I (LITRL
464 CDF
465 SKP
466 NLLOOP, TAD TEMP /ADDR OF NEXT LITERAL
467 SNA
468 JMP NONL /NO MORE NUMERIC LITERALS
469 TAD (-1
470 DCA X10
471 LFLD, CDF 10
472 TAD I X10 /GET ADDR OF NEXT LITERAL
473 DCA TEMP
474 P2, TAD I X10 /ALSO ITS FIELD
475 DCA LFLD
476 TAD I X10 /NOW ITS VALUE
477 DCA WORD1
478 TAD I X10
479 DCA WORD2
480 TAD I X10
481 DCA WORD3
482 TAD I X10 /NOW THE SYMBOL NUMBER
483 DCA TEMP2
484 TAD TEMP2 /TIMES THREE
485 CLL RAL
486 TAD TEMP2
487 TAD FREELO /PLUS START
488 DCA X11 /GIVES STORE ADDR
489 CDF
490 TAD WORD1 /NOW PUT LITERAL INTO TABLE
491 DCA I X11
492 TAD WORD2
493 DCA I X11
494 TAD WORD3
495 DCA I X11
496 JMP NLLOOP /DO NEXT LITERAL
497 NONL, TAD ACNT /ALLOCATE ARRAY TABLE
498 CLL RAL
499 CLL RAL /FOUR WORDS PER
500 TAD FREELO /SUBTRACT FROM LOWER END
501 DCA FREELO
502 TAD FREELO /SAVE THIS
503 DCA NASTAD /START OF ARRAY TABLE
504 TAD SVCNT /ALLOCATE
505 CLL RAL /STRING VAR TABLE
506 TAD SVCNT
507 TAD FREELO /3 WORDS EACH
508 DCA FREELO
509 TAD FREELO /AND SAVE IT FOR THE INT
510 DCA SSTADR
511 TAD SACNT /NOW SPACE FOR STRING
512 CLL RAL /ARRAY
513 CLL RAL
514 TAD FREELO /TABLE
515 DCA FREELO
516 TAD FREELO /SAVE FOR INT
517 DCA SASTAD
518 CDF 10 /PREPARE TO MOVE
519 P3, TAD I (SLITRL+1
520 DCA SLFLD /STRING LITERALS
521 TAD I (SLITRL
522 CDF
523 SKP
524 SLLOOP, TAD TEMP /IS NEXT LIT THERE ?
525 SNA
526 JMP I (NOSL /NO, END OF THE LINE
527 TAD (-1
528 DCA X10
529 JMS SFLD /SET THE FIELD
530 TAD I X10 /GET ADDR OF NEXT
531 DCA TEMP
532 P4, TAD I X10 /ALSO FIELD
533 DCA TEMP2
534 TAD I X10 /THEN CHAR COUNT
535 DCA NCHARS
536 JMP I (SLIT2 /DO REST OF STRING LIT
537 SFLD, 0
538 SLFLD, CDF 10
539 JMP I SFLD
540
541 PAGE
542 \fSLIT2, TAD NCHARS /COMPUTE WORD COUNT
543 TAD (3
544 CLL RAR
545 TAD X10 /TO GET ADDR OF SYMBOL NUMBER
546 DCA TEMP3
547 TAD I TEMP3
548 CLL RAL /SYM NUMBER TIMES 3
549 TAD I TEMP3
550 TAD SSTADR /PLUS BASE
551 DCA X11 /GIVES ST ADDR
552 TAD NCHARS /ALLOCATE SPACE FOR IT
553 IAC
554 CLL CML CMA RAR
555 DCA TEMP3 /(SAVE NUMBER OF WORDS)
556 TAD TEMP3
557 CLL
558 TAD FREELO
559 DCA FREELO /BELOW THE SYMBOL TABLES
560 SNL
561 JMP TMSLIT /TOO MUCH STRING LITERALS
562 TAD FREELO
563 TAD (-END-10
564 SZL CLA
565 JMP TMSLIT /DITTO
566 TAD FREELO /STICK THE ADDR
567 IAC
568 CDF
569 DCA I X11 /INTO THE ST ENTRY
570 JMS I (FREEF /ALSO THE FIELD
571 DCA I X11
572 TAD NCHARS /ALSO THE SIZE
573 CIA
574 DCA I X11
575 TAD FREELO /THIS IS WHERE IT GOES
576 DCA X11
577 TAD NCHARS /PUT IN THE LENGTH TOO
578 CIA /(NEGATIVE)
579 JMP .+4
580 MOVSL, JMS I (SFLD
581 TAD I X10
582 CDF
583 DCA I X11 /MOVE THE LITERAL TEXT
584 ISZ TEMP3
585 JMP MOVSL
586 P5, TAD TEMP2 /PUT THE FIELD OF THE NEXT
587 DCA I (SLFLD /ENTRY WHERE IT DOES THE MOST GOOD
588 JMP I (SLLOOP /DO THE NEXT LITERAL
589 NOSL, TAD FREELO /SAVE TOP OF DATA LIST
590 DCA DATTOP
591 TAD DATTOP /IF EMPTY MAKE TOP=BOTTOM
592 DCA DATPTR
593 TAD DLSIZE
594 SNA /IS ANY DATA ?
595 JMP I (NODATA /NO
596 CLL
597 TAD FREELO /GET START OF DATA
598 DCA FREELO
599 SNL
600 JMP TMDATA /TOO MUCH DATA
601 TAD FREELO
602 TAD (-END-10
603 SZL CLA
604 JMP TMDATA /DITTO
605 TAD FREELO /SAVE IT
606 DCA DATPTR
607 TAD FREELO /USE X13 TO FILL LIST
608 DCA X13
609 TAD (DATLST-1
610 DCA X10
611 CDF 10
612 DATLUP, TAD I X10 /ANY MORE DATA ELEMENTS ?
613 SNA
614 JMP I (NODATA
615 DCA TEMP /SAVE ADDR
616 P8, TAD I X10 /GET NEW FIELD
617 DCA DATAF1
618 P9, TAD DATAF1 /TWICE
619 DCA DATAF2
620 TAD TEMP /START WITH NEW ELEMENT
621 DCA X10
622 DATAF1, CDF 10
623 TAD I TEMP /GET COUNT
624 DCA TEMP
625 DATMOV, TAD I X10 /GET NEXT WORD
626 CDF
627 DCA I X13 /MOVE INTO DATA AREA
628 DATAF2, CDF 10
629 ISZ TEMP
630 JMP DATMOV
631 JMP DATLUP /DO NEXT ELEMENT
632 TMDATA, DCA LINEL /ZERO LINE NUMBER
633 DCA LINEH
634 JMS I (ERMSG /PRINT ERROR MESSAGE
635 2404
636 JMP I (ABORTL
637 TMSLIT, DCA LINEH /CLEAR THE LINE NUMBER
638 DCA LINEL
639 JMS I (ERMSG /PRINT MESSAGE
640 2423
641 JMP I (ABORTL
642
643 PATLST, P1;P2;P3;P4;P5;P6;P7;P8;P9;0
644
645 PAGE
646 \fALLOCA, TAD ACNT /ANY ARRAYS ?
647 SNA CLA
648 JMP ALLOCS /NO
649 TAD (ARAYST /ALLOCATE ARRAYS
650 DCA X10
651 TAD NASTAD
652 DCA X11
653 DOARAY, CDF 10
654 TAD I X10 /GET NEXT ARRAY
655 DCA TEMP
656 TAD I X10 /GET FIRST DIM
657 SNA
658 TAD (12 /USE 10 IF NONE
659 IAC /ALLOCATE 0TH ELEMENT
660 DCA TEMP2
661 TAD I X10 /GET SECOND DIM
662 SNA
663 TAD (12
664 IAC
665 DCA TEMP3
666 TAD TEMP3 /GET READY TO SUBTRACT
667 DCA SUBLO
668 DCA SUBHI
669 CDF
670 CLL CML RTR
671 AND TEMP /HOW MANY DIMS ?
672 SNA CLA
673 JMP ONLY1 /ONE
674 TAD TEMP2 /PRODUCT OF DIMS
675 JMS I (MUL12
676 JMP TIMES3 /MULT BY 3
677 ONLY1, DCA TEMP3 /ZERO SECOND DIMENSION
678 TAD TEMP2
679 DCA SUBLO
680 TIMES3, TAD (3 /MULT SIZE BY 3
681 JMS I (MUL12
682 JMS I (SUB /SUBTRACT FROM FREE
683 TAD FREELO
684 DCA I X11 /SAVE ADDR IN S.T.
685 JMS I (FREEF
686 DCA I X11
687 TAD TEMP2 /ALSO DIMS
688 DCA I X11
689 TAD TEMP3
690 DCA I X11
691 ISZ X10 /SKIP SYMBOL NUMBER
692 ISZ ACNT
693 JMP DOARAY
694 ALLOCS, TAD SACNT /ANY STRING ARRAYS
695 SNA CLA
696 JMP I (RELCIT /NO
697 TAD (SARYST+1
698 DCA X10 /ALLOCATE STRING ARRAYS
699 TAD SASTAD
700 DCA X11
701 DOSARY, CDF 10
702 TAD I X10
703 SNA
704 TAD (12 /USE 10 FOR DIM
705 IAC
706 DCA TEMP3
707 TAD I X10 /GET DIM
708 SNA
709 TAD (10 /USE 16 IF NO SIZE SPEC
710 DCA TEMP2
711 TAD TEMP3
712 DCA SUBLO /PREPARE FOR MULT
713 DCA SUBHI
714 CDF
715 TAD TEMP2 /GET NUM WORDS PER STRING
716 TAD (3
717 CLL RAR
718 JMS I (MUL12 /GET ARRAY SIZE
719 JMS I (SUB /DO SUBTRACTION
720 TAD FREELO /SAVE ADDR
721 DCA I X11
722 JMS I (FREEF
723 DCA I X11
724 TAD TEMP2 /AND STRING SIZE
725 CIA /(SIZES ARE NEG)
726 DCA I X11
727 TAD TEMP3 /AND NUMBER OF STRINGS
728 DCA I X11
729 ISZ X10 /SKIP NEXT NAME
730 ISZ X10 /AND NEXT SYM NUMBER
731 ISZ SACNT
732 JMP DOSARY
733 JMP I (RELCIT
734 INWORD, 0 /READ FROM CODE FILE
735 ISZ ICOUNT /ANYTHING IN BUFFER
736 JMP NOREAD /YASSUH!
737 JMS I (7607 /READ NEXT BLOCK
738 200
739 1000 /NOTE: THIS OVERLAYS USED CODE
740 INBLOK, 0
741 JMP I (IOERR
742 ISZ INBLOK /BUMP BLOCK COUNTER
743 TAD INBLOK-1/RESET BUFFER POINTER
744 DCA INPTR
745 TAD (-400 /AND COUNTER
746 DCA ICOUNT
747 NOREAD, TAD I INPTR /GET WORD
748 ISZ INPTR /BUMP POINTER
749 JMP I INWORD
750 INPTR, 0
751
752 CIPAT, 0 /PATCH TO MAKECI
753 TAD (1000
754 DCA I (JSW /CHANGE JSW
755 COPT, DCA I (CISTRT+1 /& TAKE CARE OF /C
756 JMP I CIPAT
757
758 PAGE
759 \fRELCIT, TAD LOCTRL /FIND START OF CODE
760 CLL IAC
761 DCA SUBLO /BY SUBTRACTING
762 RAL
763 TAD LOCTRH /AMOUNT FROM FREE
764 DCA SUBHI
765 JMS I (SUB
766 TAD FREELO /THIS IS THE START OF THE CODE
767 DCA CODBGN /MINUS ONE
768 TAD FREEHI /THIS IS THE FIELD NUMBER
769 DCA CODCDF
770 TAD LOCTRL /SET UP PROG SIZE COUNT
771 CLL CML CIA
772 DCA CODSZ1 /LOWER COUNT
773 RAL
774 TAD LOCTRH
775 CIA
776 DCA CODSZ2 /UPPER COUNT
777 TAD BLOCK /SET UP FOR READ AND WRITE
778 DCA I (OUBLOK
779 TAD BLOCK
780 DCA I (INBLOK
781 TAD (-401
782 DCA OCOUNT
783 CLA CMA
784 DCA ICOUNT
785 RELOOP, JMS I (INWORD /GET A WORD OF CODE
786 DCA TEMP
787 TAD (3000
788 TAD TEMP /CHECK FOR OPCODE 5000 (GOTO)
789 AND (7000
790 SZA CLA
791 JMP NORELC /NO JUMP
792 TAD TEMP /REMOVE FIELD BITS
793 AND (340
794 CLL RTR
795 TAD CDF0
796 DCA LBLFLD /FIELD OF LABEL ENTRY
797 TAD TEMP /ZERO FIELD BITS
798 AND (7437
799 DCA TEMP
800 JMS I (INWORD /GET REST OF ADDR
801 DCA TEMP2
802 JMS I (CHKLBL /CHECK FOR UNDEFINED LABEL
803 LBLFLD, HLT
804 TAD I TEMP2
805 AND (7 /GET ADDR TO BE RELOCATED
806 DCA LOCHI
807 ISZ TEMP2
808 TAD I TEMP2
809 CLL
810 TAD CODBGN /ADD BASE ADDR
811 CDF0, CDF
812 DCA LOCLO /SAVE LOW PART OF JUMP
813 RAL
814 TAD CODCDF /GET HIGH PART
815 TAD LOCHI
816 CLL RTL /PUT IT INTO CORRECT PLACE
817 RTL
818 RAL
819 TAD TEMP /PLUS INSTRUCTION
820 JMS I (OUTWRD
821 ISZ CODSZ1 /BUMP COUNTER
822 SKP
823 ISZ CODSZ2 /CAN'T BE LAST WORD
824 TAD LOCLO /OUTPUT LOW ORDER ADDR
825 SKP
826 NORELC, TAD TEMP /JUST OUTPUT IT
827 RELOUT, JMS I (OUTWRD
828 ISZ CODSZ1 /DOUBLE WORD ISZ BUMP
829 JMP RELOOP
830 ISZ CODSZ2
831 JMP RELOOP
832 JMP I (LOADIT /DONE RELOCATING, GO LOAD
833
834 /PRINT ERROR MESSAGE
835
836 ERMSG, 0 /PRINT ERROR MESSAGE
837 CDF
838 TAD I ERMSG /GET CODE
839 CLL RTR /PRINT FIRST CHAR
840 RTR
841 RTR
842 JMS TTY
843 TAD I ERMSG /PRINT SECOND CHAR
844 JMS TTY
845 ISZ ERMSG /FIX RETURN ADDR
846 TAD (240 /PRINT SPACE
847 JMS TTY
848 DCA TTY /USE TTY AS A SWITCH
849 TAD LINEH /PRINT HIGH ORDER
850 JMS I (PSN
851 TAD LINEL /THEN LOW ORDER
852 JMS I (PSN /(LINE NUMBER NATCH !)
853 TAD (215 /PRINT CARRIAGE RETURN
854 JMS I (TTX
855 TAD (212 /PRINT LINE FEED
856 JMS I (TTX
857 JMP I ERMSG /RETURN
858
859 TTY, 0 /CONVERT TO ASCII AND PRINT
860 TAD (240
861 AND (77
862 TAD (240
863 JMS I (TTX /PRINT CHAR
864 JMP I TTY /RETURN
865
866 PAGE
867 \fLOADIT, JMS I (OUDUMP /DUMP LAST BLOCK
868 TAD LOCTRL /SET UP COUNTER
869 CIA CLL CML
870 DCA CODSZ1
871 RAL
872 TAD LOCTRH
873 CIA
874 DCA CODSZ2
875 TAD CODBGN
876 DCA TEMP /CODE BEGIN -1
877 TAD BLOCK /SET UP BLOCK NUMBER
878 DCA I (INBLOK
879 CLA CMA
880 DCA ICOUNT
881 TAD CODCDF /SET UP CODE CDF
882 CLL RTL
883 RAL
884 TAD (6201
885 DCA CODCDF
886 TAD CODCDF
887 DCA CF
888 LODLUP, ISZ TEMP /BUMP POINTER
889 JMP NOFJMP /FIELD IS OK
890 TAD CF /BUMP THE FIELD
891 TAD (10
892 DCA CF
893 NOFJMP, JMS I (INWORD /GET NEXT WORD
894 CF, HLT
895 DCA I TEMP /SAVE THE WORD
896 CDFZER, CDF
897 ISZ CODSZ1 /MORE CODE ?
898 JMP LODLUP /YES
899 ISZ CODSZ2
900 JMP LODLUP /YES
901 TAD CF /GET THE FIELD
902 DCA CLEARF /AND SAVE IT
903 CLRLUP, TAD CLREND /IS THIS THE END OF CLEAR ?
904 TAD TEMP
905 SZA CLA
906 JMP MORCLR /NO, KEEP GOING
907 TAD CLRFLD /DO FIELDS MATCH ?
908 TAD CLEARF
909 SNA CLA
910 JMP DONCLR /YES, ARRAYS ARE CLEARED
911 MORCLR, ISZ TEMP /BUMP POINTER
912 JMP CLEARF /DON'T BUMP FIELD
913 TAD CLEARF /DO BUMP FIELD
914 TAD (10
915 DCA CLEARF
916 CLEARF, HLT
917 DCA I TEMP /CLEAR THE WORD
918 JMP CLRLUP /DO MORE
919 DONCLR, TAD CLEARF /COPY THE FIELD
920 DCA STFLDM
921 TAD TEMP /GET THE COUNT
922 TAD RESADR /OF HOW MUCH SYMBOL TABLE
923 DCA TEMP2 /TO MOVE
924 TAD TEMP /PUT IT INTO AUTO XR'S
925 DCA X13
926 TAD X13
927 DCA X11
928 MOVSTL, CDF
929 TAD I X11 /GET NEXT WORD OF ST
930 STFLDM, HLT
931 DCA I X13 /STORE IT
932 ISZ TEMP2
933 JMP MOVSTL
934 JMS MOVFIN /MOVE FINI PAGE INTO 7000-7177
935 JMP I (7000 /GO READ BRTS.SV
936 \fCHKLBL, 0 /CHECK LABEL FOR UNDEF
937 TAD I CHKLBL /GET FIELD
938 DCA .+1
939 HLT
940 TAD I TEMP2 /GET FIRST WORD OF LABEL
941 SPA CLA
942 JMP I CHKLBL /SIGN BIT IS DEFINED
943 CLL CMA RAL /GET ADDR OF LINE NUM
944 TAD TEMP2
945 DCA XLABEL
946 TAD I XLABEL /GET HIGH ORDER LINE
947 DCA LINEH
948 ISZ XLABEL
949 TAD I XLABEL /GET LOW ORDER
950 DCA LINEL
951 CDF
952 JMS I (ERMSG /PRINT MESSAGE
953 2523
954 JMP I CHKLBL /RETURN
955
956 FREEF, 0 /MAKE A CDF FROM FREEHI
957 TAD FREEHI
958 CLL RTL
959 RAL
960 TAD CDFZER
961 JMP I FREEF
962
963 ABORTL, JMS MOVFIN /PUT FINI PAGE INTO 7000-7177
964 /AND ABORT THE RUN
965 JMP I (ABORT-FINI+7000
966
967 MOVFIN, 0 /FINI PAGE MOVER
968 CDF
969 TAD (FINI-1 /MOVE INT READING CODE
970 DCA X10
971 TAD (6777 /INTO 7000
972 DCA X11
973 TAD (-200
974 DCA TEMP /PUT CORRECT COUNT HERE
975 TAD I X10
976 DCA I X11 /MOVE CODE
977 ISZ TEMP
978 JMP .-3
979 JMP I MOVFIN
980
981 PAGE
982 \fFINI, TAD I XERMSG /ANY ERRORS ?
983 SZA CLA
984 JMP ABORT /YES, DON'T RUN IT
985 TAD XINT /MOVE INT STUFF
986 DCA FTEMP
987 TAD M12 /10 KEY LOCATIONS
988 DCA FCNT
989 TAD XSAVE /INTO A SAFE PLACE
990 DCA FTEMP2
991 TAD I FTEMP
992 ISZ FTEMP
993 DCA I FTEMP2
994 ISZ FTEMP2
995 ISZ FCNT
996 JMP .-5 /MOVE LOOP
997 TAD BRTS /READ IN BRTS
998 DCA BRTSB
999 JMS I X7607
1000 BRTSIZ
1001 0
1002 BRTSB, 0
1003 JMP IOERR
1004 TAD XSAVE
1005 DCA FTEMP
1006 TAD XINT /MOVE STUFF BACK
1007 DCA FTEMP2
1008 TAD I FTEMP
1009 ISZ FTEMP
1010 DCA I FTEMP2
1011 ISZ FTEMP2
1012 ISZ M12
1013 JMP .-5
1014 TAD (JMP I FSTOP1 /PATCH ^C LOCATIONS
1015 DCA I (7600
1016 TAD (JMP I FSTOP1
1017 DCA I (7605
1018 JMP I (BRTBGN /GO START BRTS
1019
1020 M12, -12
1021 XINT, 20
1022 XERMSG, ERMSG
1023 X7607, 7607
1024 XSAVE, 7001+XSAVE-FINI
1025
1026 MUL12, 0 /MULTIPLY 12BITS AND 24 BITS
1027 DCA AC3 /SAVE 12 BIT THING
1028 DCA AC2 /CLEAR REST OF AC
1029 DCA AC1
1030 TAD (-15 /ONLY TEST 12 BITS
1031 DCA SC
1032 JMP MULBGN
1033 MULLUP, SNL /WAS BIT ON ?
1034 JMP NOADD /NO, DON'T ADD
1035 TAD SUBLO /ADD TO HIGH ORDER 2/3'S OF AC
1036 TAD AC2
1037 DCA AC2
1038 CML RAL
1039 TAD SUBHI
1040 NOADD, TAD AC1 /SHIFT AC RIGHT
1041 CLL RAR
1042 DCA AC1
1043 TAD AC2
1044 RAR
1045 DCA AC2
1046 MULBGN, TAD AC3
1047 FTEMP, RAR
1048 FTEMP2, DCA AC3
1049 FCNT, ISZ SC /BUMP SHIFT COUNTER
1050 JMP MULLUP
1051 TAD AC2 /ANSWER IS LOWER 2/3'S OF AC
1052 DCA SUBHI
1053 TAD AC3
1054 DCA SUBLO
1055 JMP I MUL12
1056
1057 IOERR, DCA LINEL /ZERO LINE NUMBER
1058 JMS I XERMSG /PRINT MESSAGE
1059 1117
1060 ABORT, JMS I (SWAP /SWAP OS8 BACK
1061 JMS I (200 /CHECK OUT W/ CI BUILDER
1062 TAD (4207 /RESTORE ^C LOCATIONS
1063 DCA I (7600
1064 TAD (6213
1065 DCA I (7605
1066 TAD ABORTX /CALLED VIA CHAIN ?(FROM EDIT)
1067 SNA
1068 JMP I (7600 /NO, RETURN TO OS8
1069 DCA EDTBLK /YES, SAVE EDITOR START
1070 JMS I X7607 /READ IN EDITOR
1071 EDTSIZ /THIS MUCH
1072 0
1073 OWTEMP,
1074 EDTBLK, 0
1075 JMP I (7605 /ERROR
1076 JMP I (EDTBGN /GO START EDITOR
1077
1078 OUTWRD, 0 /OUTPUT WORD TO TEMP FILE
1079 ISZ OCOUNT /ANY ROOM ?
1080 JMP NOWRIT /YES
1081 DCA OWTEMP /SAVE WORD
1082 JMS OUDUMP /WRITE BLOCK
1083 ISZ OUBLOK /BUMP BLOCK NUMBER
1084 TAD OUBLOK-1/RESET BUFFET POINTER
1085 DCA OUPTR
1086 TAD (-400
1087 DCA OCOUNT /AND COUNT
1088 TAD OWTEMP /RESTORE AC
1089 NOWRIT, CDF 10
1090 DCA I OUPTR /INTO BUFFER
1091 CDF
1092 ISZ OUPTR
1093 JMP I OUTWRD
1094 OUPTR, 0
1095 OUDUMP, 0 /WRITE BLOCK
1096 JMS I X7607 /WRITE BLOCK
1097 4210
1098 0
1099 OUBLOK, 0
1100 JMP IOERR
1101 JMP I OUDUMP
1102
1103 END=FINI+200
1104
1105 PAGE
1106 \f BLDCI=200 /PAGE INTO WHICH MAKECI GETS MOVED
1107 LOADBL=357 /LOC WHERE BCOMP LEAVES BLOAD BLOCK #
1108
1109 IMAGE, 0
1110 TAD I (LOADBL /COME HERE TO CREATE CORE IMAGE
1111 TAD (6 /ALREADY HAVE THIS MUCH
1112 DCA I (LDRBLK /INIT BLOAD OVRLY READER
1113 CDF 10
1114 TAD I (7644 /TEST FOR /V
1115 CDF
1116 AND (4
1117 SZA CLA
1118 JMS I (VERNUM
1119 CDF 10
1120 TAD I (7643 /GET OPTION BITS
1121 CDF
1122 DCA TEMP
1123 TAD TEMP
1124 RTR
1125 SNL CLA /HAVE K OPTION?
1126 JMP LSTART /NO: START LOADER
1127 TAD TEMP
1128 RTL
1129 SZL CLA /HAVE B OPTION?
1130 DCA I (FLGRTS /YES: FLAG IT
1131 TAD TEMP /TEST FOR /C
1132 RTL
1133 SPA CLA
1134 JMP .+3
1135 TAD (NOP
1136 DCA I (COPT
1137 CDF 10
1138 TAD I (7646 /GET =N
1139 CDF
1140 AND (7 /WIPE ALT MODE
1141 SNA
1142 CLL CML RTL /DEFAULT=12K FOR NOW
1143 DCA TEMP
1144 CLL CMA
1145 TAD TEMP /MUST BE >1 HERE
1146 SNA CLA
1147 ISZ TEMP
1148 TAD TEMP
1149 CLL CMA
1150 TAD HIFLD
1151 SNL CLA /WHICH HAS MORE CORE?
1152 JMP .+3 /TARGET MACHINE: TOUGH
1153 TAD TEMP /HOST MACHINE
1154 DCA HIFLD /FAKE OUT LOADER
1155 TAD HIFLD
1156 CIA
1157 DCA I (FLDCNT /INIT CI BUILDER
1158 TAD I (FLDCNT
1159 DCA I (MYCORE /AND CI STARTER
1160 CDF 10
1161 DCA I (7646 /CLEAR =N BITS
1162 DCA I (7643 /AND EARLY OPTIONS
1163 TAD I (7644 /GET OPTION BITS
1164 CDF
1165 RTL
1166 SZL CLA /HAVE N SWITCH?
1167 JMP NOTDSY /NEVER SEES TD8E SYSTEM
1168 TAD HIFLD
1169 CLL RAR
1170 SNA CLA /HAVE OVER 8K CORE?
1171 JMP NOTDSY
1172 TAD (NOP
1173 DCA I (GOTTD /YES: FORCE SYS=TD8E
1174 CDF 10 /THE QUESTION IS,
1175 TAD I (DCB /WAS IT A LITTLE WHITE ONE
1176 AND (770 /OR NOT?
1177 TAD (-210
1178 CDF
1179 SNA CLA
1180 TAD I (7612
1181 TAD (-3
1182 SNA CLA
1183 JMP .+3 /IT WAS TRUTH!
1184 TAD (SWAP-LOADER+5600
1185 DCA I (TDLIE /LIES: MUST LIE TO SWAPPER ALSO
1186 CLA IAC
1187 NOTDSY, DCA I (TDFLAG /NOT 0 MEANS HAVE TD8E
1188 CMA
1189 DCA I (ERMSG /FORCE LOAD ABORT
1190 LSTART, TAD (BLDCI-1 /MOVE CI BUILDER
1191 DCA X10 /INTO LOW CORE
1192 TAD (MAKECI-1
1193 DCA X11
1194 TAD I X11
1195 DCA I X10
1196 ISZ ICTR
1197 JMP .-3
1198 TAD HIFLD /START OF BLOAD V1
1199 DCA FREEHI
1200 JMP I IMAGE /RETURN TO LOADER
1201
1202 ICTR, -200
1203 CCLIST, 0 /1ST 4 WORDS OF CCB
1204 6203
1205 CISTRT
1206 1000 /JOB STATUS WORD
1207
1208 PAGE
1209 \f CCB=1000 /LOC TO START BUILDING CCB
1210
1211 MAKECI, 0 /THIS PAGE GETS MOVED!
1212 TSF
1213 JMP .-1 /SEE TAG "ABORT" IN BLOAD V1
1214 ISZ I (ERMSG /WHY ARE WE HERE?
1215 JMP BOSFIX /GENUINE ABORTION
1216 TAD (CCB-1
1217 DCA X10
1218 TAD (CCLIST-1
1219 DCA X11
1220 TAD I X11 /1ST FOUR WORDS OF CCB
1221 DCA I X10
1222 ISZ MKCCNT
1223 JMP .-3
1224 CCSEGS, TAD FLDCNT
1225 CLL CIA RAL
1226 RTL /THIS FIELD
1227 DCA TEMP
1228 TAD (70
1229 AND CODCDF /LOWEST FIELD USED
1230 CLL CIA
1231 TAD TEMP
1232 SNL /THIS FIELD USED?
1233 JMP NOCODE /NO: BYPASS IT
1234 SZA CLA /IS IT FULL?
1235 JMP ALLCODE /YES
1236 TAD CODBGN /PROBABLY NOT
1237 AND (7400
1238 DCA TEMP2
1239 TAD TEMP2
1240 CIA
1241 CLL RAR
1242 TAD TEMP
1243 DCA TEMP
1244 TAD TEMP2
1245 ALLCODE,DCA I X10
1246 TAD FLDCNT
1247 IAC
1248 TAD TDFLAG
1249 SMA CLA /NEED TOP PAGE?
1250 TAD (3700 /NO: 37 PAGES
1251 TAD TEMP /YES: 40 PAGES
1252 AND K3777
1253 DCA I X10
1254 ISZ I (CCB
1255 NOCODE, CLA CLL
1256 ISZ FLDCNT /NEXT FIELD ZERO?
1257 JMP CCSEGS /NO: LOOP
1258 TAD FLGRTS
1259 SZA CLA /NEED BRTS?
1260 TAD (CISTRT
1261 DCA I X10
1262 TAD FLGRTS
1263 SZA CLA
1264 TAD (200-3700
1265 TAD (3700
1266 DCA I X10
1267 TAD I (CCB
1268 CMA
1269 DCA I (CCB /NEGATE SEG COUNT
1270 JMS I (7607 /READ CI STARTER
1271 KP200, 200 /FROM END OF BLOAD.SV
1272 CISTRT /INTO HI CORE
1273 LDRBLK, 0 /INIT BY "IMAGE"
1274 BOSPT1, 7600 /CAN'T GET THIS ERROR
1275 JMS I JCIP
1276 TAD TDFLAG /PASS TD8E FLAG
1277 DCA I (FLAGTD
1278 TAD FLGRTS
1279 DCA I (RTSFLG /AND BRTS FLAG
1280 TAD MYCORE
1281 DCA I (NOCORE /AND CORE LIMIT
1282 TAD (17 /SAVE 10 KEY LOCATIONS
1283 DCA X10
1284 TAD (KEYLOC-1
1285 DCA X11
1286 TAD I X10
1287 DCA I X11
1288 ISZ MCICNT
1289 JMP .-3
1290 JMS I (7607 /CALL SYS HANDLER
1291 4200 /TO WRITE CCB
1292 CCB-200 /(AND PRECEDING PG)
1293 37 /INTO SCRATCH BLOCK
1294 K3777, 3777 /CAN'T GET THIS ERROR
1295 JMP I (EXEUIT
1296
1297 MKCCNT, -4
1298 MCICNT, -12
1299 FLDCNT, -7
1300 TDFLAG, 1 /0 MEANS TD8E IS DEATH AT RT
1301 FLGRTS, -1 /0 MEANS INCL BRTS IN CI
1302
1303 BOSFIX, TAD I (BIPCCL
1304 RAL
1305 SMA CLA
1306 JMP I MAKECI /BATCH NOT RUNNING
1307 TAD I (7777
1308 AND (70
1309 TAD CDFZRO
1310 DCA BOSCDF /CDF TO BATCH FIELD
1311 BOSLUP, CDF 10
1312 TAD I BOSPT1 /GET BATCH WRDS
1313 BOSCDF, CDF 10
1314 DCA I BOSPT2 /BACK INTO POSITION
1315 CDFZRO, CDF
1316 ISZ BOSPT1
1317 ISZ BOSPT2
1318 JMP BOSLUP
1319 JMP I MAKECI
1320
1321 BOSPT2, 7774
1322 MYCORE, 0
1323 JCIP, CIPAT
1324
1325 PAGE
1326 \fVERNUM, 0
1327 TAD (VTEXT
1328 DCA TEMP
1329 MOREV, TAD I TEMP
1330 SNA
1331 JMP VOUT
1332 CLL RTR
1333 RTR
1334 RTR
1335 JMS I (TTY
1336 TAD I TEMP
1337 JMS I (TTY
1338 ISZ TEMP
1339 JMP MOREV
1340 VOUT, TAD (215
1341 JMS I (TTX
1342 TAD (212
1343 JMS I (TTX
1344 JMP I VERNUM
1345
1346 VTEXT, TEXT /BLOAD V/
1347 *.-1
1348 VERLOC, 100^VERSON+6001
1349 0
1350
1351 PAGE
1352 \f *7000
1353 BSTART=200 /START ADDR FOR BRTS
1354 CISTRT, SKP /RUNNED
1355 JMP CHAIN /CHAINED
1356 TAD (7603
1357 DCA X10
1358 TAD (NAMLST-1
1359 DCA X11
1360 CDF 10
1361 DCA I X10 /ZERO EDITOR
1362 DCA I X10 /COMPILER
1363 DCA I X10 /AND LOADER BLOCK #S
1364 CDF
1365 CIF 10
1366 JMS I (7700
1367 10 /USRIN
1368 FINDSV, TAD I X11 /LOOKUP SOME SAVE FILES
1369 SNA
1370 JMP LUBUF /GO LOOK FOR BASIC.UF
1371 DCA XXXXSV /SAVE POINTER TO NAME
1372 CLA IAC /THEY'RE ON SYS
1373 CIF 10
1374 JMS I (200
1375 2
1376 XXXXSV, 0
1377 0
1378 JMS I (ERRORX /ERROR
1379 TAD XXXXSV /GET STARTING BLOCK
1380 IAC /PLUS 1
1381 CDF 10
1382 DCA I X10 /INTO INFO AREA
1383 CDF
1384 JMP FINDSV /LOOP
1385 LUBUF, CLA IAC
1386 CIF 10
1387 JMS I (200 /LOOKUP BASIC.UF
1388 2
1389 BUFN /(USER DEFINED FUNCTIONS)
1390 0
1391 JMP .+3 /OK IF NOT THERE
1392 TAD .-3 /GET STARTING BLOCK +1
1393 IAC
1394 CDF 10
1395 DCA I X10 /INTO INFO BLOCK
1396 CDF 0
1397 CIF 10
1398 JMS I (200
1399 11 /USR OUT
1400 CHAIN, CDF 10
1401 TAD I (7607 /GET BRTS STARTING BLK
1402 CDF
1403 DCA I (BRTSST /INTO RTS READER
1404 JMP I (BINIT
1405
1406 NAMLST, BRTSN
1407 BAFN
1408 BSFN
1409 BFFN
1410 0
1411 BRTSN, FILENAME BRTS.SV
1412 BAFN, FILENAME BASIC.AF
1413 BSFN, FILENAME BASIC.SF
1414 BFFN, FILENAME BASIC.FF
1415 BUFN, FILENAME BASIC.UF
1416 \fCORE, 0
1417 TAD I (BIPCCL
1418 AND COR70
1419 CLL RAR
1420 RTR
1421 SZA /IS THERE A SYSTEM VALUE?
1422 JMP I CORE /YES: USE IT
1423 COR0, CDF
1424 TAD CORSIZ
1425 RTL
1426 RAL
1427 AND COR70
1428 TAD COREX
1429 DCA .+1
1430 COR1, CDF
1431 TAD I CORLOC
1432 COR2, NOP
1433 DCA COR1
1434 TAD COR2
1435 DCA I CORLOC
1436 COR70, 70
1437 TAD I CORLOC
1438 CORX, 7400
1439 TAD CORX
1440 TAD CORV
1441 SZA CLA
1442 JMP COREX
1443 TAD COR1
1444 DCA I CORLOC
1445 ISZ CORSIZ
1446 JMP COR0
1447 COREX, CDF
1448 CLA CMA /HI FIELD IS #FIELDS-1
1449 TAD CORSIZ
1450 JMP I CORE
1451 CORLOC, CORX
1452 CORV, 1400
1453 CORSIZ, 1
1454
1455 PAGE
1456 \fGETRTS, 0 /READ BRTS INTO 0-6777
1457 TAD BRTS
1458 DCA BRTSBB
1459 JMS I (7607
1460 BRTSIZ
1461 0
1462 BRTSBB, 0
1463 NOCORE, -1 /CAN'T GET THIS ERROR
1464 JMP I GETRTS
1465 BINIT, ISZ RTSFLG /NEED BRTS?
1466 JMP BRTSIN /GOT IT: START IT
1467 JMS I (7607
1468 BRTSIZ
1469 0
1470 BRTSST, 0
1471 SR2, 20 /CAN'T GET THIS ERROR
1472 BRTSIN, CDF 10 /WHAT ARE WE RUNNING ON?
1473 ISZ EKOUNT
1474 TAD I (DCB /CHECK FOR TD8E SYSTEM
1475 AND (770 /ED FRIEDMAN GAVE ME THIS CODE
1476 TAD (-210 /AND I'M TAKING IT ON FAITH
1477 CDF
1478 SNA CLA
1479 TAD I (7642 /IS IT A ROM SYSTEM ?
1480 TAD (-6223
1481 SZA CLA
1482 JMP PSADJ /NO TD/8E OR ELSE ROM TD/8E
1483 TAD FLAGTD
1484 SNA CLA /IMAGE OK ON TD8E?
1485 JMS ERRORX /NO: DONT RUN IT
1486 TAD KEYLOC
1487 DCA CDFTOP
1488 SWPLOOP,CDF 20
1489 TAD I TDCTR
1490 DCA GETRTS
1491 CDFTOP, CDF 70
1492 TAD I TDCTR
1493 DCA ERRORX
1494 TAD GETRTS
1495 DCA I TDCTR
1496 CDF 20
1497 TAD ERRORX
1498 DCA I TDCTR
1499 ISZ TDCTR
1500 JMP SWPLOOP
1501 CDF
1502 CLL CML RTL
1503 TAD CDFTOP /PATCH MONITOR FIELD STUFF
1504 DCA I (7642 /CDF CIF HI CORE
1505 IAC
1506 TAD CDFTOP
1507 DCA I (7721 /CIF HI CORE
1508 TAD I (7721
1509 DCA I (7727
1510 CCHEK, ISZ EKOUNT
1511 JMS I (CORE /HOW MUCH CORE DO WE HAVE?
1512 TAD NOCORE /HOW MUCH DO WE NEED?
1513 SPA CLA
1514 JMS ERRORX /INSUFFICIENT CORE
1515 TAD I SR1 /RESTORE KEY LOCATIONS
1516 DCA I SR2
1517 ISZ SR1
1518 ISZ SR2
1519 ISZ SR3
1520 JMP .-5
1521 TAD (JMP I FSTOP1 /PATCH CTRL/C LOCS
1522 DCA I (7600
1523 TAD (JMP I FSTOP1
1524 DCA I (7605
1525 TAD SWPINF /TELL BRTS OS/8 PG 17600 OUT NOW
1526 RAR
1527 STL RAL
1528 DCA SWPINF
1529 JMP I (BSTART /START BRTS
1530
1531 ERRORX, 0
1532 CIF 10
1533 JMS I (7700
1534 7
1535 EKOUNT, 1
1536 JMP I (7605
1537
1538 EXEUIT, TAD RTSFLG
1539 SNA CLA /NEED BRTS?
1540 JMS GETRTS /YES: READ IT
1541 TAD (4207 /RESTORE ^C HOOKS
1542 DCA I (7600
1543 TAD (6213
1544 DCA I (7605
1545 JMP I (7600 /BACK TO OS8
1546 KEYLOC, ZBLOCK 12
1547 SR1, KEYLOC
1548 SR3, -12
1549 RTSFLG, -1 /0 MEANS BRTS IS IN CORE
1550 FLAGTD, 1 /1 IF TD8E IS OK AT RUNTIME
1551 PSADJ, TAD (4001
1552 AND KEYLOC+11
1553 TAD (2000
1554 DCA KEYLOC+11
1555 JMP CCHEK
1556 TDCTR, 7600
1557
1558 PAGE
1559 $$$$$
1560 \f