Repository navigation
Expand file tree
/
Copy pathpromh.9
More file actions
754 lines (666 loc) · 26.1 KB
/
Copy pathpromh.9
File metadata and controls
754 lines (666 loc) · 26.1 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
;;; CADR PROM Microcode. -*-Fundamental-*-
;;; There are many places in this code in which cycles are wasted.
;;; This is to make the code clearer, since it is far more important
;;; that code in a PROM be bug-free than that the boot sequence be
;;; 150 nanoseconds faster.
;;; Still to be done is the feature for loading microcode off the Chaos net.
(PROGN (PRINT '(TYPE T IF FOR PROM NIL FOR RAM))
(SETQ PROM (READ))
(SETQ PROMH '(
(LOCALITY M-MEM)
M-GARBAGE (0)
M-HUNOZ (0)
M-ZERO (0)
M-ONES (0)
M-A (0)
M-B (0)
M-C (0)
M-D (0)
M-TEMP-1 (0)
M-TEMP-2 (0)
M-MICR-OFFSET (0)
(LOCALITY A-MEM)
A-GARBAGE (0)
A-HUNOZ (0)
A-ZERO (0)
A-ONES (0)
A-A (0)
A-B (0)
A-C (0)
A-D (0)
A-TEMP-1 (0)
A-TEMP-2 (0)
A-MICR-OFFSET (0)
(LOC 40)
;;; Constants.
A-1 (0)
A-2 (0)
A-3 (0)
A-4 (0)
A-5 (0)
A-11 (0)
A-40 (0)
A-400 (0)
A-20000 (0)
A-3560 (0)
A-DISK-ERROR (0)
A-DISK-RECAL (0)
;;; Disk Characteristics (from label)
A-NCYLS (0) ;Total number of cylinders
A-NHEADS (0) ;Number of data heads (i.e. tracks per cylinder)
A-NBLKS (0) ;Number of blocks ("sectors") per track
A-HEADS-TIMES-BLOCKS (0) ;Number of blocks per cylinder
A-DISK-REGS (0) ;Virtual address of disk control registers
A-MICR-ORIGIN (0) ;Base disk address of microcode partition
A-MICR-ADDRESS (0) ;Address of next block of microcode partition
A-MICR-N-BLOCKS (0) ;Remaining blocks of microcode partition
A-TEM1 (0) ;Temporary used in division
(LOCALITY I-MEM)
(IF PROM (LOC 0))
(IF PROM BEG)
(IF PROM (JUMP GO))
(LOC 6)
I-MEM-LOC-6 ;Define this symbol in either case.
(IF PROM (JUMP-NOT-EQUAL-XCT-NEXT Q-R A-ZERO I-MEM-LOC-6)) ;This code also appears in the RAM
(IF PROM ((Q-R) ADD Q-R A-ONES))
(IF PROM I-MEM-LOC-10)
(IF PROM (JUMP HALT-CONS I-MEM-LOC-10)) ;Foo, should be in RAM by now
(IF PROM (ERROR-TABLE FAILED-TO-JUMP-INTO-RAM))
(IF (NOT PROM) (LOC 27000))
(IF (NOT PROM) BEG)
(IF (NOT PROM) (JUMP GO))
;;; Error halts:
;;; Put a NO-OP before each error halt so that they will be at even addresses
;;; and the 2 possible values in the PC lights will agree except for the low bit.
(NO-OP)
ERROR-BAD-BIT
(JUMP HALT-CONS ERROR-BAD-BIT)
(ERROR-TABLE ERROR-BAD-BIT)
(NO-OP)
ERROR-ADD-LOSES
(JUMP HALT-CONS ERROR-ADD-LOSES)
(ERROR-TABLE ERROR-ADD-LOSES)
(NO-OP)
ERROR-A-MEM
(JUMP HALT-CONS ERROR-A-MEM)
(ERROR-TABLE ERROR-A-MEM)
(NO-OP)
ERROR-M-MEM
(JUMP HALT-CONS ERROR-M-MEM)
(ERROR-TABLE ERROR-M-MEM)
(NO-OP)
ERROR-LEVEL-1-MAP
(JUMP HALT-CONS ERROR-LEVEL-1-MAP)
(ERROR-TABLE ERROR-LEVEL-1-MAP)
(NO-OP)
ERROR-PAGE-FAULT
(JUMP HALT-CONS ERROR-PAGE-FAULT)
(ERROR-TABLE ERROR-PAGE-FAULT)
(NO-OP)
ERROR-BAD-LABEL
(JUMP HALT-CONS ERROR-BAD-LABEL)
(ERROR-TABLE ERROR-BAD-LABEL)
(NO-OP)
ERROR-NO-MICR
(JUMP HALT-CONS ERROR-NO-MICR)
(ERROR-TABLE ERROR-NO-MICR)
(NO-OP)
ERROR-BAD-SECTION-TYPE
(JUMP HALT-CONS ERROR-BAD-SECTION-TYPE)
(ERROR-TABLE ERROR-BAD-SECTION-TYPE)
(NO-OP)
ERROR-BAD-ADDRESS
(JUMP HALT-CONS ERROR-BAD-ADDRESS)
(ERROR-TABLE ERROR-BAD-ADDRESS)
(NO-OP)
ERROR-END-OF-PARTITION
(JUMP HALT-CONS ERROR-END-OF-PARTITION)
(ERROR-TABLE ERROR-END-OF-PARTITION)
(NO-OP)
ERROR-DISK-ERROR
(JUMP HALT-CONS ERROR-DISK-ERROR)
(ERROR-TABLE ERROR-DISK-ERROR)
(NO-OP)
ERROR-DIVIDE-BY-ZERO
(JUMP HALT-CONS ERROR-DIVIDE-BY-ZERO)
(ERROR-TABLE ERROR-DIVIDE-BY-ZERO)
(NO-OP)
ERROR-PDL-BUFFER
(JUMP HALT-CONS ERROR-PDL-BUFFER)
(ERROR-TABLE ERROR-PDL-BUFFER)
;;; Program starts here. Create M-ZERO and M-ONES, and check the hardware a little.
GO ((M-ZERO Q-R) SETZ) ;Make all zeros. Result to Q-R, not to depend on M mem
(JUMP-IF-BIT-SET (BYTE-FIELD 1 0) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 1) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 2) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 3) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 4) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 5) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 6) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 7) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 10) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 11) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 12) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 13) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 14) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 15) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 16) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 17) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 20) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 21) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 22) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 23) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 24) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 25) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 26) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 27) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 30) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 31) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 32) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 33) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 34) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 35) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 36) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 37) Q-R ERROR-BAD-BIT)
((M-ONES Q-R) SETO) ;Make all ones, in Q-R not to trust M Mem
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 0) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 1) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 2) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 3) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 4) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 5) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 6) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 7) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 10) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 11) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 12) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 13) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 14) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 15) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 16) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 17) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 20) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 21) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 22) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 23) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 24) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 25) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 26) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 27) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 30) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 31) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 32) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 33) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 34) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 35) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 36) Q-R ERROR-BAD-BIT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 37) Q-R ERROR-BAD-BIT)
;;; ALU and Shifter don't drop or pick bits.
;;; Test M-mem, A-mem, and M=A logic
(JUMP-NOT-EQUAL Q-R A-ONES ERROR-A-MEM)
(JUMP-NOT-EQUAL M-ONES A-ONES ERROR-M-MEM)
((Q-R) SETZ)
(JUMP-NOT-EQUAL Q-R A-ZERO ERROR-A-MEM)
(JUMP-NOT-EQUAL M-ZERO A-ZERO ERROR-M-MEM)
;;; See if all carries in ALU really carry.
((Q-R) ADD M-ONES A-ZERO ALU-CARRY-IN-ONE)
(JUMP-NOT-EQUAL Q-R A-ZERO ERROR-ADD-LOSES)
;;; Another simple carry test
((Q-R) ADD M-ONES A-ONES)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 0) Q-R ERROR-ADD-LOSES)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 1) Q-R ERROR-ADD-LOSES)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 37) Q-R ERROR-ADD-LOSES)
;;; Prepare to test pdl buffer. Care required since no pass-around path.
((C-PDL-BUFFER-POINTER-PUSH) M-ZERO)
((C-PDL-BUFFER-POINTER-PUSH) M-ONES)
;;; This verifies that -1 + -1 is -2 and also tests the byte hardware a little
((MD) (BYTE-FIELD 37 1) Q-R A-ONES)
(JUMP-NOT-EQUAL MD A-ONES ERROR-ADD-LOSES)
;;; Foo, the byte hardware could be tested a little bit better than that!
(JUMP-NOT-EQUAL C-PDL-BUFFER-POINTER-POP A-ONES ERROR-PDL-BUFFER)
(JUMP-NOT-EQUAL C-PDL-BUFFER-POINTER-POP A-ZERO ERROR-PDL-BUFFER)
;;; Clear all memories to make sure they contain good parity
;;; But don't bash the M-ZERO and M-ONES constants.
((M-HUNOZ) DPB M-ONES (BYTE-FIELD 1 5) A-ZERO) ;40, size of M memory
((MD) DPB M-ONES (BYTE-FIELD 1 2) A-ZERO) ;4, lowest location to clear
CLEAR-M-MEMORY
((M-HUNOZ) ADD M-HUNOZ A-ONES) ;Note that M-HUNOZ is used, to get good par in it
((OA-REG-LOW) DPB M-HUNOZ (BYTE-FIELD 5 14.) A-ZERO) ;M destination
((M-GARBAGE) M-ZERO)
(JUMP-NOT-EQUAL MD A-HUNOZ CLEAR-M-MEMORY)
((M-HUNOZ) DPB M-ONES (BYTE-FIELD 1 5) A-ZERO) ;40, size of M memory
CLEAR-A-MEMORY
((OA-REG-LOW) DPB M-HUNOZ (BYTE-FIELD 10. 14.) A-ZERO) ;A destination
((A-GARBAGE) M-ZERO)
((M-HUNOZ) M+A+1 M-HUNOZ A-ZERO)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 10.) M-HUNOZ CLEAR-A-MEMORY)
;;; Construct useful constants.
MAKE-CONSTANTS
((A-1) DPB M-ONES (BYTE-FIELD 1 0) A-ZERO)
((A-2) DPB M-ONES (BYTE-FIELD 1 1) A-ZERO)
((A-3) DPB M-ONES (BYTE-FIELD 2 0) A-ZERO)
((A-4) DPB M-ONES (BYTE-FIELD 1 2) A-ZERO)
((A-5) DPB M-ONES (BYTE-FIELD 1 2) A-1)
((A-11) DPB M-ONES (BYTE-FIELD 1 3) A-1)
((A-40) DPB M-ONES (BYTE-FIELD 1 5) A-ZERO)
((A-400) DPB M-ONES (BYTE-FIELD 1 8) A-ZERO)
((A-20000) DPB M-ONES (BYTE-FIELD 1 13.) A-ZERO)
((A-3560) DPB M-ONES (BYTE-FIELD 3 4) A-ZERO)
((A-3560) DPB M-ONES (BYTE-FIELD 3 8) A-3560)
;;; A-DISK-RECAL / 10001005
((A-DISK-RECAL) DPB M-ONES (BYTE-FIELD 1 9) A-5)
((A-DISK-RECAL) DPB M-ONES (BYTE-FIELD 1 21.) A-DISK-RECAL)
;;; A-DISK-ERROR/ 47777360
((A-DISK-ERROR) DPB M-ONES (BYTE-FIELD 04. 04.) A-ZERO)
((A-DISK-ERROR) DPB M-ONES (BYTE-FIELD 12. 09.) A-DISK-ERROR)
((A-DISK-ERROR) DPB M-ONES (BYTE-FIELD 01. 23.) A-DISK-ERROR)
;;; Clear some more memories
((PDL-BUFFER-POINTER M-A) ;2000, size of pdl buffer
DPB M-ONES (BYTE-FIELD 1 10.) A-ZERO)
CLEAR-PDL-BUFFER
((C-PDL-BUFFER-POINTER-PUSH) M-ZERO)
((M-A) ADD M-A A-ONES)
(JUMP-NOT-EQUAL M-A A-ZERO CLEAR-PDL-BUFFER)
((M-A) A-40) ;Size of SPC stack
CLEAR-SPC-MEMORY
((MICRO-STACK-DATA-PUSH) SETZ)
((M-A) ADD M-A A-ONES)
(JUMP-NOT-EQUAL M-A A-ZERO CLEAR-SPC-MEMORY)
((MD) SETZ)
CLEAR-LEVEL-1-MAP
((VMA-WRITE-MAP M-B) DPB M-ONES (BYTE-FIELD 1 26.) A-ZERO) ;Clear level-1 map
((MD) ADD MD A-20000)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 24.) MD CLEAR-LEVEL-1-MAP)
((MD) SETZ)
CLEAR-LEVEL-2-MAP
((M-A) (BYTE-FIELD 5 13.) MD) ;What to write in level-1 map
((VMA-WRITE-MAP) DPB M-A (BYTE-FIELD 5 27.) A-B) ;Make level-1 map point at level-2
((VMA-WRITE-MAP) DPB M-ONES (BYTE-FIELD 1 25.) A-ZERO) ;Clear level-2 map
((MD) ADD MD A-400)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 24.) MD CLEAR-LEVEL-2-MAP)
((M-A MD) SETZ)
(IF (NOT PROM)
((M-B) DPB M-ONES (BYTE-FIELD 3 9) A-ZERO) ) ;27000 RAM version only
(IF (NOT PROM)
((M-B) DPB M-ONES (BYTE-FIELD 1 13.) A-B))
CLEAR-I-MEMORY
((OA-REG-LOW) DPB MD (BYTE-FIELD 14. 12.) A-ZERO)
(WRITE-I-MEM M-A A-A)
((MD) ADD MD A-1)
(IF PROM
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 14.) MD CLEAR-I-MEMORY) ;PROM, clear 16K
(JUMP-LESS-THAN MD A-B CLEAR-I-MEMORY) ) ;RAM, clear to limit
((M-A MD) DPB M-ONES (BYTE-FIELD 1 17.) A-ZERO) ;0 with good parity
CLEAR-D-MEMORY
((OA-REG-LOW) DPB MD (BYTE-FIELD 11. 12.) A-ZERO)
(DISPATCH WRITE-DISPATCH-RAM (BYTE-FIELD 0 0) (I-ARG (A-MEM-LOC A-A)))
((MD) ADD MD A-1)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 11.) MD CLEAR-D-MEMORY)
;;; The size of the disk is not known until the label is read in and parsed.
;;; In order to make the disk operations win, we have to initialize the
;;; size parameters to something reasonable; it doesn't matter what they
;;; are exactly since only blocks 0 and 1 will be dealt with.
FUDGE-INITIAL-DISK-PARAMETERS
((A-NBLKS) A-3)
((A-HEADS-TIMES-BLOCKS) A-3)
;;; Generate RESET on the I/O busses
((INTERRUPT-CONTROL) DPB M-ONES ;RESET THE BUS INTERFACE AND I/O DEVS
(BYTE-FIELD 1 28.) A-ZERO)
((M-A) A-400) ;RESET FOR ABOUT 80 MICROSECONDS
RST (JUMP-NOT-EQUAL-XCT-NEXT M-A A-ZERO RST)
((M-A) SUB M-A A-1)
((INTERRUPT-CONTROL) DPB M-ONES ;CLEAR RESET, SET HALFWORD-MODE,
(BYTE-FIELD 1 27.) A-ZERO) ;AND ENABLE INTERRUPTS
;;; Set up the map. First, write a 0 into the first location of the level
;;; one map. This is the only location we use. Read back to be safe.
SET-UP-THE-MAP
((MD) SETZ)
((VMA-WRITE-MAP) DPB M-ONES (BYTE-FIELD 1 26.) A-ZERO)
(NO-OP) ;Map gets written during this cycle
((M-A) MEMORY-MAP-DATA)
((M-B) (BYTE-FIELD 5 24.) M-A)
(JUMP-NOT-EQUAL M-B A-ZERO ERROR-LEVEL-1-MAP)
;;; Set up four pages:
;;; Page 0: Mapped to the first page of main memory.
;;; Page 1: Mapped to the disk control registers.
;;; Page 2: Mapped to the debug (spy) interface registers at 766000 .
;;; Page 3: Mapped to the second page of main memory. (system communication area)
;;; M-A holds the bits to write the level 1 map with r/w access, MD has zero initially.
SET-UP-FOUR-PAGES
((M-A VMA-WRITE-MAP) DPB M-ONES (BYTE-FIELD 4 22.) A-ZERO);Sets bit 24 which is ignored
((M-B) DPB M-ONES (BYTE-FIELD 11 0) A-A)
((MD) A-400)
((VMA-WRITE-MAP) DPB M-ONES (BYTE-FIELD 4 12) A-B) ;M-A + 36777
((A-DISK-REGS) DPB M-ONES (BYTE-FIELD 7 2) A-ZERO) ;Virt Addr 774
((MD) ADD MD A-400)
((M-B) DPB M-ONES (BYTE-FIELD 2 1) A-A) ;6
((VMA-WRITE-MAP) DPB M-ONES (BYTE-FIELD 12 4) A-B) ;M-A + 37766
((MD) ADD MD A-400)
((VMA-WRITE-MAP) DPB M-ONES (BYTE-FIELD 1 0) A-A) ;M-A + 1
(NO-OP)
((VMA) SETO) ;Make sure page 0 has good parity
PAGE-0-PARITY-FIX ;so the disk doesn't barf out when we save it
((VMA-START-READ) ADD VMA A-1)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
;Next instruction mustn't be ((VMA-START-WRITE) VMA).
((WRITE-MEMORY-DATA-START-WRITE) READ-MEMORY-DATA)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
(JUMP-LESS-THAN VMA A-400 PAGE-0-PARITY-FIX) ;This does one extra location, too bad.
;;; Now turn on parity checking
;;; Writing 4 in Unibus location 766012, which is at virtual address 1005,
;;; turns on ERROR-STOP-ENABLE. If we aren't really in a PROM, we write 44
;;; which also turns on (leaves on) PROM-DISABLE.
(IF PROM
((MD) A-4) ;PROM
((MD) DPB M-ONES (BYTE-FIELD 1 5) A-4) ) ;RAM
((VMA-START-WRITE) DPB M-ONES (BYTE-FIELD 1 9) A-5)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
;;; Initialize the disk.
(CALL DISK-RECALIBRATE)
;;; In order to not clobber core, save a page (page 0) of physical
;;; memory on disk. Block 1 is allocated to us for this purpose.
SAVE-A-PAGE
((M-A) DPB M-ONES (BYTE-FIELD 1 18.) A-ZERO) ;Delay for 0.1 second in case
SAPDLY (JUMP-NOT-EQUAL-XCT-NEXT M-A A-ZERO SAPDLY) ; something random is happening
((M-A) SUB M-A A-1)
((M-TEMP-1) A-1)
(CALL-XCT-NEXT DISK-WRITE)
((M-A) SETZ)
((M-TEMP-1) A-1) ;Now do a read-compare
(CALL-XCT-NEXT DISK-OP-LOW)
((M-TEMP-2) DPB M-ONES (BYTE-FIELD 1 3) A-ZERO) ;OP 10 = read-compare
((M-TEMP-1) AND READ-MEMORY-DATA A-DISK-ERROR)
(JUMP-NOT-EQUAL M-TEMP-1 A-ZERO SAVE-A-PAGE) ;Got an error on readback, retry
(JUMP-IF-BIT-SET (BYTE-FIELD 1 22.) READ-MEMORY-DATA SAVE-A-PAGE) ;R/C failed
;;; Read the label (block 0) into physical memory page 0, get disk
;;; parameters, and find out where the MICR partition is.
READ-LABEL
((M-TEMP-1) SETZ)
(CALL-XCT-NEXT DISK-READ)
((M-A) SETZ)
;; M-B/ LABL = 114 102 101 114 = 11420440514
((M-B) DPB M-ONES (BYTE-FIELD 2 02.) A-ZERO)
((M-B) DPB M-ONES (BYTE-FIELD 1 06.) A-B)
((M-B) DPB M-ONES (BYTE-FIELD 1 08.) A-B)
((M-B) DPB M-ONES (BYTE-FIELD 1 14.) A-B)
((M-B) DPB M-ONES (BYTE-FIELD 1 17.) A-B)
((M-B) DPB M-ONES (BYTE-FIELD 1 22.) A-B)
((M-B) DPB M-ONES (BYTE-FIELD 2 26.) A-B)
((M-B) DPB M-ONES (BYTE-FIELD 1 30.) A-B)
DECODE-LABEL
((VMA-START-READ M-C) A-ZERO) ;0
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT) ;First location of label must be ascii LABL
(JUMP-NOT-EQUAL READ-MEMORY-DATA A-B ERROR-BAD-LABEL)
((VMA-START-READ M-C) ADD M-C A-1) ;1
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT) ;Second location of label must be version 1.
(JUMP-NOT-EQUAL READ-MEMORY-DATA A-1 ERROR-BAD-LABEL)
((VMA-START-READ M-C) ADD M-C A-1) ;2
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
((A-NCYLS) READ-MEMORY-DATA)
((VMA-START-READ M-C) ADD M-C A-1) ;3
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
((A-NHEADS) READ-MEMORY-DATA)
((VMA-START-READ M-C) ADD M-C A-1) ;4
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
((A-NBLKS) READ-MEMORY-DATA)
((VMA-START-READ M-C) ADD M-C A-1) ;5
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
((A-HEADS-TIMES-BLOCKS) READ-MEMORY-DATA)
((VMA-START-READ M-C) ADD M-C A-1) ;6
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
((M-B) READ-MEMORY-DATA)
((VMA-START-READ M-C) ;200
DPB M-ONES (BYTE-FIELD 1 7) A-ZERO)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
((M-D) READ-MEMORY-DATA) ;M-D gets number of partitions
((VMA-START-READ M-C) ADD M-C A-1) ;201
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
((M-A) READ-MEMORY-DATA) ;M-A gets words per partition descriptor
((M-C) ADD M-C A-1) ;202 (start of partition table)
;; M-B/ Name of microload partition.
;; M-C/ Address of partition descriptor.
;; M-D/ Number of partitions
;; M-A/ Number of words per partition descriptor.
SEARCH-LABEL
(JUMP-EQUAL M-D A-ZERO ERROR-NO-MICR)
((VMA-START-READ) M-C)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
(JUMP-EQUAL READ-MEMORY-DATA A-B FOUND-PARTITION)
((M-C) ADD M-C A-A)
(JUMP-XCT-NEXT SEARCH-LABEL)
((M-D) SUB M-D A-1)
FOUND-PARTITION
((VMA-START-READ M-C) ADD M-C A-1)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
((A-MICR-ADDRESS) READ-MEMORY-DATA)
((A-MICR-ORIGIN) A-MICR-ADDRESS)
((VMA-START-READ) ADD M-C A-1)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
((A-MICR-N-BLOCKS) READ-MEMORY-DATA)
((M-MICR-OFFSET) A-400) ;So will read in a new page first off
;;; Process one section. Each section starts with three words:
;;; The section type, the initial address, and the number of locations.
;;; These are gotten into M-B, M-C, and M-D; then the section type is
;;; "dispatched" on.
;;; Section codes are:
;;; 1 = I-MEM, 2 = D-MEM, 3 = MAIN-MEM, 4 = A-M-MEM
PROCESS-SECTION
(CALL GET-NEXT-WORD)
(CALL-XCT-NEXT GET-NEXT-WORD)
((M-B) M-A)
(CALL-XCT-NEXT GET-NEXT-WORD)
((M-C) M-A)
((M-D) M-A)
(JUMP-EQUAL M-B A-1 PROCESS-I-MEM-SECTION)
(JUMP-EQUAL M-B A-2 PROCESS-D-MEM-SECTION)
(JUMP-EQUAL M-B A-3 PROCESS-MAIN-MEM-SECTION)
(JUMP-EQUAL M-B A-4 PROCESS-A-MEM-SECTION)
(JUMP ERROR-BAD-SECTION-TYPE)
PROCESS-I-MEM-SECTION
(JUMP-EQUAL M-D A-ZERO PROCESS-SECTION)
((M-A) (BYTE-FIELD 18. 14.) M-C)
(JUMP-NOT-EQUAL M-A A-ZERO ERROR-BAD-ADDRESS)
(CALL-XCT-NEXT GET-NEXT-WORD)
((M-D) SUB M-D A-1)
(CALL-XCT-NEXT GET-NEXT-WORD)
((M-B) M-A)
;;; Now the first word of the instruction is in A-B, second word is in M-A,
;;; and the address in I-MEM is in M-C.
((OA-REG-LOW) DPB M-C (BYTE-FIELD 14. 12.) A-ZERO)
(WRITE-I-MEM M-A A-B)
(JUMP-XCT-NEXT PROCESS-I-MEM-SECTION)
((M-C) ADD M-C A-1)
PROCESS-D-MEM-SECTION
(JUMP-EQUAL M-D A-ZERO PROCESS-SECTION)
((M-A) (BYTE-FIELD 21. 11.) M-C)
(JUMP-NOT-EQUAL M-A A-ZERO ERROR-BAD-ADDRESS)
(CALL-XCT-NEXT GET-NEXT-WORD)
((M-D) SUB M-D A-1)
;;; Now M-A has the contents and M-C has the address.
((OA-REG-LOW) DPB M-C (BYTE-FIELD 11. 12.) A-ZERO)
(DISPATCH WRITE-DISPATCH-RAM (BYTE-FIELD 0 0) (I-ARG (A-MEM-LOC A-A)))
(JUMP-XCT-NEXT PROCESS-D-MEM-SECTION)
((M-C) ADD M-C A-1)
PROCESS-MAIN-MEM-SECTION
(CALL GET-NEXT-WORD)
;;; M-C/ Number of blocks.
;;; M-D/ Address of first block, relative to beginning of partition.
;;; M-A/ Physical memory address of first word.
((M-B) ADD M-D A-MICR-ORIGIN)
MAIN-MEM-LOOP
(JUMP-EQUAL M-C A-ZERO PROCESS-SECTION)
(CALL-XCT-NEXT DISK-READ)
((M-TEMP-1) M-B)
((M-B) ADD M-B A-1)
((M-A) ADD M-A A-400)
(JUMP-XCT-NEXT MAIN-MEM-LOOP)
((M-C) SUB M-C A-1)
PROCESS-A-MEM-SECTION
((PDL-BUFFER-POINTER) SUB M-C A-1)
A-MEM-LOOP
(JUMP-EQUAL M-D A-ZERO DONE-LOADING)
((M-A) (BYTE-FIELD 22. 10.) M-C)
(JUMP-NOT-EQUAL M-A A-ZERO ERROR-BAD-ADDRESS)
(CALL-XCT-NEXT GET-NEXT-WORD)
((M-D) SUB M-D A-1)
(JUMP-XCT-NEXT A-MEM-LOOP)
((C-PDL-BUFFER-POINTER-PUSH) M-A)
DONE-LOADING
;;; Read back page 0 of physical memory, which we saved on block 1.
((M-TEMP-1) A-1)
(CALL-XCT-NEXT DISK-READ)
((M-A) SETZ)
((Q-R) A-400) ;Set up constant needed below.
((MD) DPB M-ONES (BYTE-FIELD 1 5) A-4) ;44
((VMA) DPB M-ONES (BYTE-FIELD 1 9) A-5) ;1005
;;; Copy the PDL buffer into A/M memory.
((PDL-BUFFER-INDEX) SETZ)
FILL-M-LOOP
((OA-REG-LOW) DPB PDL-BUFFER-INDEX (BYTE-FIELD 5 14.) A-ZERO)
((M-GARBAGE) C-PDL-BUFFER-INDEX)
((PDL-BUFFER-INDEX) M+1 PDL-BUFFER-INDEX)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 5) PDL-BUFFER-INDEX FILL-M-LOOP)
FILL-A-LOOP
((OA-REG-LOW) DPB PDL-BUFFER-INDEX (BYTE-FIELD 10. 14.) A-ZERO)
((A-GARBAGE) C-PDL-BUFFER-INDEX)
((PDL-BUFFER-INDEX) M+1 PDL-BUFFER-INDEX)
(JUMP-NOT-EQUAL PDL-BUFFER-INDEX A-ZERO FILL-A-LOOP)
;;; Turn off the PROM and enter the real world.
;;; Writing 44 in Unibus location 766012, which is at virtual address 1005,
;;; will turn on ERROR-STOP-ENABLE and PROM-DISABLE. The 2 programs (PROM and RAM)
;;; share a common loop at location 6 to wait for this Unibus cycle to happen.
;;; Note that Q-R, MD, and VMA are already set up.
JUMP-TO-6
(JUMP-XCT-NEXT I-MEM-LOC-6)
((VMA-START-WRITE) VMA) ;Well, we can't check for page fault here
GET-NEXT-WORD
;;; Get the next word of the MICR partition into M-A. A-MICR-ADDRESS
;;; contains the number of the next page to be read in from it.
;;; A-MICR-N-BLOCKS has the number of remaining pages in it.
;;; M-MICR-OFFSET has the physical address of the next word.
;;; Clobbers M-TEMP-1, M-TEMP-2, Q-R.
(JUMP-GREATER-OR-EQUAL M-MICR-OFFSET A-400 GET-NEXT-PAGE)
((VMA-START-READ) M-MICR-OFFSET)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
(POPJ-AFTER-NEXT (M-A) READ-MEMORY-DATA)
((M-MICR-OFFSET) ADD M-MICR-OFFSET A-1)
GET-NEXT-PAGE
((M-MICR-OFFSET) SETZ)
(JUMP-GREATER-OR-EQUAL M-ZERO A-MICR-N-BLOCKS ERROR-END-OF-PARTITION)
((A-MICR-N-BLOCKS) ADD M-ONES A-MICR-N-BLOCKS) ;Subtract 1
((M-TEMP-1) A-MICR-ADDRESS)
(CALL-XCT-NEXT DISK-READ)
((M-A) SETZ)
(JUMP-XCT-NEXT GET-NEXT-WORD)
((A-MICR-ADDRESS) M+A+1 M-ZERO A-MICR-ADDRESS)
;;; Disk commands.
;;; Initialize the disk drive. First, wait for it to be on-line.
;;; Then do a fault clear and a recalibrate. Then wait for the
;;; drive to become ready.
;;; Clobbers M-A, M-TEMP-1, M-TEMP-2.
DISK-RECALIBRATE
((VMA-START-READ) A-DISK-REGS) ;Wait for control ready
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 0) READ-MEMORY-DATA DISK-RECALIBRATE)
((WRITE-MEMORY-DATA) A-ZERO) ;Select unit 0
((VMA) A-DISK-REGS)
((VMA-START-WRITE) ADD VMA A-2) ;Disk Address reg
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
((VMA-START-READ) A-DISK-REGS)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
(JUMP-IF-BIT-SET (BYTE-FIELD 1 9.) READ-MEMORY-DATA DISK-RECALIBRATE) ;Off-line
(ERROR-TABLE AWAIT-DISK-ON-LINE) ;Hangs near here until drive is on-line
((M-A) SETZ)
((M-TEMP-1) SETZ)
((M-TEMP-2) A-5)
(CALL-XCT-NEXT DISK-OP)
((M-TEMP-2) DPB M-ONES (BYTE-FIELD 1 8) A-TEMP-2) ;405 Fault Clear
((M-TEMP-1) SETZ)
(CALL-XCT-NEXT DISK-OP)
((M-TEMP-2) A-DISK-RECAL)
AWAIT-DRIVE-READY
((VMA-START-READ) A-DISK-REGS)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
((M-TEMP-2) AND READ-MEMORY-DATA A-3560) ;Bits 4,5,6,8,9,10
(JUMP-NOT-EQUAL M-TEMP-2 A-ZERO AWAIT-DRIVE-READY)
(ERROR-TABLE AWAIT-DRIVE-READY) ;Hangs near here until drive is OK
(POPJ)
;;; Read one block.
;;; Takes disk block number in M-TEMP-1, phys. mem. address in M-A
;;; Does not clobber M-A.
;;; Clobbers M-TEMP-1, M-TEMP-2, Q-R.
DISK-READ
(JUMP-XCT-NEXT DISK-OP)
((M-TEMP-2) SETZ)
;;; Write one block.
;;; Takes disk block number in M-TEMP-1, phys. mem. address in M-A
;;; Does not clobber M-A.
;;; Clobbers M-TEMP-1, M-TEMP-2, Q-R.
DISK-WRITE
((M-TEMP-2) A-11)
; drops in.
DISK-OP
(CALL DISK-OP-LOW)
((M-TEMP-1) AND READ-MEMORY-DATA A-DISK-ERROR)
(JUMP-NOT-EQUAL M-TEMP-1 A-ZERO ERROR-DISK-ERROR)
(POPJ)
DISK-OP-LOW
;; Wait for the disk controller to be ready.
((VMA-START-READ) A-DISK-REGS)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 0) READ-MEMORY-DATA DISK-OP)
(ERROR-TABLE AWAIT-DISK-CONTROL-READY) ;Hangs near here if control hung or absent
;; Write a CCW word to the last loc of sys. comm. area.
((MD) SELECTIVE-DEPOSIT M-A (BYTE-FIELD 16. 8.) A-ZERO)
((VMA-START-WRITE) DPB M-ONES (BYTE-FIELD 10. 0) A-ZERO) ;Virt Addr 1777
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
;; Write the COMMAND register from M-TEMP-2.
((MD) M-TEMP-2)
((VMA-START-WRITE) A-DISK-REGS)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
;; Write the CLP register.
((MD) DPB M-ONES (BYTE-FIELD 9 0) A-ZERO) ;Phys Addr 777 = Virt Addr 1777
((VMA-START-WRITE) ADD VMA A-1)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
DISK-OP-CONTINUED
;; Convert block number in M-TEMP-1 to DISK ADDRESS word.
;; Write the DISK ADDRESS register.
(CALL-XCT-NEXT DIV)
((M-TEMP-2) A-HEADS-TIMES-BLOCKS)
((MD) DPB Q-R (BYTE-FIELD 12. 16.) A-ZERO)
(CALL-XCT-NEXT DIV)
((M-TEMP-2) A-NBLKS)
((M-TEMP-1) DPB Q-R (BYTE-FIELD 8 8) A-TEMP-1)
((MD) IOR MD A-TEMP-1)
((VMA-START-WRITE) ADD VMA A-1)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
;; Write the START register.
((VMA-START-WRITE) ADD VMA A-1)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
;; Wait for operation to complete.
DISK-WAIT
((VMA-START-READ) A-DISK-REGS)
(JUMP-IF-PAGE-FAULT ERROR-PAGE-FAULT)
(JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 0) READ-MEMORY-DATA DISK-WAIT)
(ERROR-TABLE AWAIT-DISK-DONE) ;Hangs near here while waiting for disk
(POPJ)
;;; Divide two numbers. This routine taken from UCADR 108.
;;; Dividend in M-TEMP-1, divisor in M-TEMP-2
;;; Quotient In Q-R, remainder in M-TEMP-1
;;; Clobbers A-TEM1.
DIV (JUMP-GREATER-OR-EQUAL-XCT-NEXT M-TEMP-1 A-ZERO DIV1)
((A-TEM1 Q-R) M-TEMP-1)
((Q-R) SUB M-ZERO A-TEM1)
DIV1 ((M-TEMP-1) DIVIDE-FIRST-STEP M-ZERO A-TEMP-2)
DIV1A (JUMP-IF-BIT-SET (BYTE-FIELD 1 0) Q-R ERROR-DIVIDE-BY-ZERO)
(REPEAT 31. ((M-TEMP-1) DIVIDE-STEP M-TEMP-1 A-TEMP-2))
((M-TEMP-1) DIVIDE-LAST-STEP M-TEMP-1 A-TEMP-2)
(JUMP-LESS-OR-EQUAL-XCT-NEXT M-ZERO A-TEM1 DIV2)
((M-TEMP-1) DIVIDE-REMAINDER-CORRECTION-STEP M-TEMP-1 A-TEMP-2)
((M-TEMP-1) SUB M-ZERO A-TEMP-1)
DIV2 ((A-TEM1) XOR M-TEMP-2 A-TEM1)
(POPJ-LESS-OR-EQUAL M-ZERO A-TEM1)
(POPJ-AFTER-NEXT
(A-TEM1) Q-R)
((Q-R) SUB M-ZERO A-TEM1)
)))