PiDP-8/I Software

Check-in Differences
Log In
Invert Patch Path Unified Diff

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Difference From 8a49cdd555d0ee2b To 29dfc620d53074b3

2018-02-19
18:07
Another attempt at cleanup. check-in: 448527acfc user: poetnerd tags: os8-v3f-extensions
18:04
Corrections to README.md: Fixed formatting of included file. Added license. check-in: 8a49cdd555 user: poetnerd tags: os8-v3f-extensions
17:56
Amendments to os8-v3f sources to get them to build properly, and to clean up newlines as documented in README.md. TODO: Find out why mkos8 complains of bad device on the SQUISH. check-in: ab0e49c8c5 user: poetnerd tags: os8-v3f-extensions
2018-02-18
19:14
Moved a single-use string member variable in class simh inline. It needn't be externally-visible. check-in: df07d34aed user: tangent tags: os8-cp
18:46
Merged in trunk improvements check-in: 29dfc620d5 user: tangent tags: os8-cp
17:37
Added more clarification of when ASCII transforms are lossless. (If newlines are well formed.) check-in: 1b6da290c4 user: poetnerd tags: os8-cp
03:10
Typo, grammar, and clarity tweaks to previous check-in: 7689d22a2c user: tangent tags: trunk

Changes to bin/os8-cp.
︙︙
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

#### GLOBALS AND CONSTANTS #############################################

progmsg = True
DEBUG = False
VERBOSE = False
QUIET = False

# Default RK05 system image to attach if no sys specified.
_default_sys_image = "os8v3d-patched.rk05"
_default_sys_path = dirs.os8mo + _default_sys_image
_default_att_spec = ["rk", "0", _default_sys_path]

# Regex for parsing an argument string into a sys device
_dev_arg_regex_str = "-(rk|td|dt|rx)(\d?)(s)?"
_dev_arg_re = re.compile(_dev_arg_regex_str)

# Regex for parsing an action file att string into a sys device.  Note
# reuse of regex string from above.
_dev_actfile_regex_str = _dev_arg_regex_str[1:]   # strip -








<
<
<
<
<








54
55
56
57
58
59
60





61
62
63
64
65
66
67

#### GLOBALS AND CONSTANTS #############################################

progmsg = True
DEBUG = False
VERBOSE = False
QUIET = False






# Regex for parsing an argument string into a sys device
_dev_arg_regex_str = "-(rk|td|dt|rx)(\d?)(s)?"
_dev_arg_re = re.compile(_dev_arg_regex_str)

# Regex for parsing an action file att string into a sys device.  Note
# reuse of regex string from above.
_dev_actfile_regex_str = _dev_arg_regex_str[1:]   # strip -
︙︙
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

    the command since we do not intend to try and replace your perfectly
    good POSIX cp implementation, so it errors out.

    If you give only one file name argument, the program always errors
    out: it requires at least one source and one destination.

    The -a, -b, -i, -y, and -z flags correspond to the OS/8 PIP options:

        /A    ASCII format.  OS/8 and POSIX newlines are translated.
              Such transfers are lossless if line endings are  well-formed.
        /B    Binary OS/8 ABSLDR format with leader/trailer and other
              specific formatting that is detected and enforced by PIP.
        /I    Image mode.  Files are copied byte for byte verbatim.
        /Z    ZERO directory of destination OS/8 device.
        /Y    Yank system area from source to destination.

    If no format flag is set, the default transfer format is /I.

    (This priogram currently uses PIP as its primary handler for the
    OS/8 side of the work.)  They must be followed by at least one source
    file name, and they affect all subsequent source file names until
    another such option is found.  For example:

        $ os8-cp -a foo bar -b qux sys:









<







<
<
<








361
362
363
364
365
366
367

368
369
370
371
372
373
374



375
376
377
378
379
380
381

    the command since we do not intend to try and replace your perfectly
    good POSIX cp implementation, so it errors out.

    If you give only one file name argument, the program always errors
    out: it requires at least one source and one destination.

    The -a, -b, -i, -y, and -z flags correspond to the OS/8 PIP options:

        /A    ASCII format.  OS/8 and POSIX newlines are translated.
              Such transfers are lossless if line endings are  well-formed.
        /B    Binary OS/8 ABSLDR format with leader/trailer and other
              specific formatting that is detected and enforced by PIP.
        /I    Image mode.  Files are copied byte for byte verbatim.
        /Z    ZERO directory of destination OS/8 device.
        /Y    Yank system area from source to destination.



    (This priogram currently uses PIP as its primary handler for the
    OS/8 side of the work.)  They must be followed by at least one source
    file name, and they affect all subsequent source file names until
    another such option is found.  For example:

        $ os8-cp -a foo bar -b qux sys:
︙︙
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475

  action_plan["mount"] = []
  action_plan["copy"] = []

  idx = 1
  numargs = len(sys.argv)

  filespec_seen = 0
  mode_opt = "i"                              # start of with default of binary.
  first_mode = mode_opt
  source = ""
  destination = ""
  # Keep file_list and mode_list in sync.
  file_and_mode_list = []
  
  while idx < numargs:








|








452
453
454
455
456
457
458
459
460
461
462
463
464
465
466

  action_plan["mount"] = []
  action_plan["copy"] = []

  idx = 1
  numargs = len(sys.argv)

  filespec_seen = 0
  mode_opt = "b"                              # start of with default of binary.
  first_mode = mode_opt
  source = ""
  destination = ""
  # Keep file_list and mode_list in sync.
  file_and_mode_list = []
  
  while idx < numargs:
︙︙
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628

    print "Could not start simulator: " + e.message + '!'
    exit (1)
  # s.set_logfile (os.fdopen (sys.stdout.fileno (), 'w', 0))
  s.set_logfile (open ("logfile.txt", 'w'))

  # Perform sys attach
  att_spec = action_plan["sys"]
  if att_spec == None: att_spec = _default_att_spec
  simh_boot_dev = att_spec[0] + att_spec[1]     # Compose simh dev from name and unit.
  imagename = att_spec[2]
  if not os.path.exists (imagename):
    abort_prog ("Requested boot image file: " + imagename + " not found.")
  if VERBOSE or DEBUG:
    print "Attaching " + simh_boot_dev + " to " + imagename
  s.send_cmd ("att " + simh_boot_dev + " " + imagename)








<








605
606
607
608
609
610
611

612
613
614
615
616
617
618

    print "Could not start simulator: " + e.message + '!'
    exit (1)
  # s.set_logfile (os.fdopen (sys.stdout.fileno (), 'w', 0))
  s.set_logfile (open ("logfile.txt", 'w'))

  # Perform sys attach
  att_spec = action_plan["sys"]

  simh_boot_dev = att_spec[0] + att_spec[1]     # Compose simh dev from name and unit.
  imagename = att_spec[2]
  if not os.path.exists (imagename):
    abort_prog ("Requested boot image file: " + imagename + " not found.")
  if VERBOSE or DEBUG:
    print "Attaching " + simh_boot_dev + " to " + imagename
  s.send_cmd ("att " + simh_boot_dev + " " + imagename)
︙︙
Changes to lib/simh.py.
︙︙
159
160
161
162
163
164
165

166
167
168
169
170
171
172
173

  # move on.  This tolerant mode is appropriate for programs that need
  # the simulator alone, not actually the PiDP-8/I front panel display.
  
  def __init__ (self, basedir, ignore_gpio_lock = False):
    # Start the simulator instance
    self._child = pexpect.spawn(basedir + '/bin/pidp8i-sim')
    self._valid_pip_options = ["/A", "/B", "/I"]

    self._os8_file_re = re.compile("(\S+):(\S+)?")
    self._os8_error_match_strings = []
    self._os8_fatal_check = []

    # Parse our OS/8 Errors table into actionable chunks
    for error_spec in self._os8_errors:
      self._os8_error_match_strings.append(error_spec[0])
      self._os8_fatal_check.append(error_spec[1])








>
|








159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174

  # move on.  This tolerant mode is appropriate for programs that need
  # the simulator alone, not actually the PiDP-8/I front panel display.
  
  def __init__ (self, basedir, ignore_gpio_lock = False):
    # Start the simulator instance
    self._child = pexpect.spawn(basedir + '/bin/pidp8i-sim')
    self._valid_pip_options = ["/A", "/B", "/I"]
    self._os8_file_regex_str = "(\S+):(\S+)?"
    self._os8_file_re = re.compile(self._os8_file_regex_str)
    self._os8_error_match_strings = []
    self._os8_fatal_check = []

    # Parse our OS/8 Errors table into actionable chunks
    for error_spec in self._os8_errors:
      self._os8_error_match_strings.append(error_spec[0])
      self._os8_fatal_check.append(error_spec[1])
︙︙
Changes to libexec/mkos8.
︙︙
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

# script's progress.
progmsg = True

# Name of the RK05 disk image files we create
_bin_rk05 = "os8v3d-bin.rk05"
_src_rk05 = "os8v3d-src.rk05"
_patched_rk05 = "os8v3d-patched.rk05"
_v3f_build_rk05 = "os8-v3f-build.rk05"

# Parser regexps used in patcher
_com_os8_parse_str = "^\.([a-zA-Z]+)\s?(.*)$"
_com_os8_parse = re.compile(_com_os8_parse_str)
_com_split_str = "^([a-zA-Z]+)\s?(.*)$"
_com_split_parse = re.compile(_com_split_str)
_odt_parse_str = "^([0-7]+)\s?/\s?(\S+)\s+([0-7;]+)"
_odt_parse = re.compile(_odt_parse_str)

#### mkos8_abort  ######################################################
# Fatal error. Abort mkos8
# Assumes we are in SIMH context. Quit SIMH

def mkos8_abort (s):
  print "Fatal Error.  Cannot proceed."
  s.quit ()
  exit (-1)

#### mkos8_abort_os8  ##################################################
# Fatal error. Abort mkos8
# Assumes we are in os8 context.  Exit to SIMH, then quit SIMH.

def mkos8_abort_os8 (s):
  print "Fatal Error.  Cannot proceed."
  s.back_to_cmd("\\.")        
  s.quit ()
  exit (-1)


#### check_exists ######################################################
# Check existence of all files needed

def check_exists (s, image_copyins):








<











<




<
<
<
<
<
<
<
<
<
<








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

# script's progress.
progmsg = True

# Name of the RK05 disk image files we create
_bin_rk05 = "os8v3d-bin.rk05"
_src_rk05 = "os8v3d-src.rk05"
_patched_rk05 = "os8v3d-patched.rk05"


# Parser regexps used in patcher
_com_os8_parse_str = "^\.([a-zA-Z]+)\s?(.*)$"
_com_os8_parse = re.compile(_com_os8_parse_str)
_com_split_str = "^([a-zA-Z]+)\s?(.*)$"
_com_split_parse = re.compile(_com_split_str)
_odt_parse_str = "^([0-7]+)\s?/\s?(\S+)\s+([0-7;]+)"
_odt_parse = re.compile(_odt_parse_str)

#### mkos8_abort  ######################################################
# Fatal error. Abort mkos8


def mkos8_abort (s):
  print "Fatal Error.  Cannot proceed."
  s.quit ()










  exit (-1)


#### check_exists ######################################################
# Check existence of all files needed

def check_exists (s, image_copyins):
︙︙
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909

  # Finish up
  if progmsg: print "Cleaning up..."
  s.os8_squish ("SYS")
  s.os8_squish ("DSK")
  s.back_to_cmd("\\.")
  s.send_cmd ("detach rk0")

#### make_system_tape ##################################################
# Make and install new OS/8 System Head.
# ISSUE: Doing this will probably break the LC/UC batch scripts.

#### call_pal8 #########################################################
# Generic call out to PAL8 with error recovery.
# We rely on the caller to have good specifications for source,
# binary and optional listing files.

def call_pal8 (s, source, binary):
  pal8_replies = ["ERRORS DETECTED: ", "BE\s+\S+", "CF\s+\S+", "DE\s+\S+", "DF", "IC\s+\S+", "ID\s+\S+",
                  "IE\s+\S+", "II\s+\S+", "IP\s+\S+", "IZ\s+\S+", "LD\s+\S+", "LG\s+\S+", "PE\s+\S+",
                  "PH\s+\S+", "RD\s+\S+", "SE\s+\S+", "UO\s+\S+", "US\s+\S+", "ZE\s+\S+", "\S+ NOT FOUND"]

  # Build OS/8 System head by using PAL-8 to assemble OS8.PA and CD.PA
  if progmsg: print "Assembling " + source
  com_line = binary + "<" + source
  s.os8_send_cmd ("\\.", "R PAL8")
  s.os8_send_cmd ("\\*", com_line)
  err_count = 0
  reply = s._child.expect (pal8_replies)
  executed_line = s._child.before.strip()
  reply_str = s._child.after.strip()
  if reply == 0:
    s._child.expect("\d+")
    err_count = int(s._child.after.strip())
    reply_str += " " + s._child.after.strip()
  if reply > 0 or err_count > 0:
    print "PAL8 Error: "
    print "\t*" + executed_line
    print "\t" + reply_str
    s.os8_send_ctrl ('c')      # exit PAL8 Just in case.
    # We could do something better than just dying, I expect.
    mkos8_abort_os8(s)
  # s.os8_send_ctrl ('[')      # exit PAL8
  

#### make_v3f ##########################################################
# Create an RK05 image containing the OS/8 v3f sources on partition A.
# Build binaries for them into partition B.

def make_v3f (s, args):
  sys_path = dirs.os8mo + _patched_rk05
  build_path = dirs.os8mo + _v3f_build_rk05

  if not os.path.isfile(sys_path):
    print "System pack: " + sys_path + " not found."
    mkos8_abort(s)
  if not os.path.isfile(build_path):
    print "OS/8 V3F build image: " + build_path + " not found."
    mkos8_abort(s)

  s.send_cmd ("attach rk0 " + sys_path)
  s.send_cmd ("attach rk1 " + build_path)
  s.send_cmd ("boot rk0")         # We're running OS/8. Let's build!

  # Build BUILD
  if progmsg: print "Building BUILD."
  call_pal8(s, "RKA1:BUILD.PA","RKB1:BUILD.BN")
  if progmsg: print "Loading and savinging BUILD.SV to RKB1:"
  s.os8_send_cmd ("\\.", "R ABSLDR")
  s.os8_send_cmd ("\*", "RKB1:BUILD.BN")
  s.os8_send_ctrl ('[')
  s.os8_send_cmd ("\\.", "SAVE RKB1:BUILD.SV")

  call_pal8(s, "RKA1:OS8.PA", "RKB1:OS8.BN")
  call_pal8(s, "RKA1:CD.PA", "RKB1:CD.BN")

  # Build RESORC and CCL
  if progmsg: print "Preparing to build CCL and RESORC with BATCH scripts."

  s.os8_send_cmd ("\\.", "ASSIGN RKA1 IN")
  s.os8_send_cmd ("\\.", "ASSIGN RKB1 OUT")

  # BATCH scripts must be on the SYSTEM device.  DSK: will work.
  s.os8_send_cmd ("\\.", "COPY DSK:<RKA1:RESORC.BI")
  s.os8_send_cmd ("\\.", "COPY DSK:<RKA1:CCL.BI")
  
  # The CCL.BI script chains to RESORC.BI
  s.os8_send_cmd("\\.", "SUBMIT CCL.BI")
  # What kind of error trapping can we do here?

  # Delete the batch scripts we copied in.
  s.os8_send_cmd ("\\.", "DEL DSK:<RKA1:RESORC.BI")
  s.os8_send_cmd ("\\.", "DEL DSK:<RKA1:CCL.BI")
  if progmsg: print "RESORC.SV and CCL.SV should be in RKB1:"
  
  # Finish up
  if progmsg: print "Cleaning up..."
  if progmsg: print "Squish RKB1:"
  s.os8_squish ("RKB1:")
  s.back_to_cmd("\\.")
  s.send_cmd ("detach rk0")
  s.send_cmd ("detach rk1")

#### main ##############################################################
# Program entry point.  Parses the command line and drives the above.

def main ():
  # Parse the command line
  allowed_acts = ["all", "bin", "src", "patch", "head", "v3f"]
  do_all_acts = ["bin", "src"]    # Just do bin and src if act is "all".
  
  ap = argparser.ArgParser (allowed_acts)
  global progmsg
  progmsg = not ap.args.verbose

  # Initialize our acts dict.








<
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<





|








783
784
785
786
787
788
789



790



























































































791
792
793
794
795
796
797
798
799
800
801
802
803

  # Finish up
  if progmsg: print "Cleaning up..."
  s.os8_squish ("SYS")
  s.os8_squish ("DSK")
  s.back_to_cmd("\\.")
  s.send_cmd ("detach rk0")
































































































#### main ##############################################################
# Program entry point.  Parses the command line and drives the above.

def main ():
  # Parse the command line
  allowed_acts = ["all", "bin", "src", "patch"]
  do_all_acts = ["bin", "src"]    # Just do bin and src if act is "all".
  
  ap = argparser.ArgParser (allowed_acts)
  global progmsg
  progmsg = not ap.args.verbose

  # Initialize our acts dict.
︙︙
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945

  s = simh (dirs.build, True)
  s.set_logfile (open (dirs.log + 'mkos8-' + first_act + '.log', 'w') \
      if progmsg else os.fdopen (sys.stdout.fileno (), 'w', 0))

  if acts["bin"]: make_bin (s, ap.args)
  if acts["src"]: make_src (s, ap.args)
  if acts["patch"]: make_patch (s, ap.args)
  if acts["v3f"]: make_v3f (s, ap.args)
  
  s.quit ()
  if progmsg: print "Done!"


if __name__ == "__main__":
    main()








<








825
826
827
828
829
830
831

832
833
834
835
836
837
838

  s = simh (dirs.build, True)
  s.set_logfile (open (dirs.log + 'mkos8-' + first_act + '.log', 'w') \
      if progmsg else os.fdopen (sys.stdout.fileno (), 'w', 0))

  if acts["bin"]: make_bin (s, ap.args)
  if acts["src"]: make_src (s, ap.args)
  if acts["patch"]: make_patch (s, ap.args)

  
  s.quit ()
  if progmsg: print "Done!"


if __name__ == "__main__":
    main()
Deleted src/os8-v3f/BLOAD.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555

/1 OS8 BASIC LOADER, V5B
/
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1972, 1973, 1974, 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
/SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
/AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/
/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMRNT COROPATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
/
/
/
/
/
/DEC-S8-LBASA-B-LA
/
/COPYRIGHT  C  1972, 1973, 1974
/
/DIGITAL EQUIPMENT CORPORATION
/MAYNARD,MASSACHUSETTS 01754
/
/AUGUST 19, 1972
/
/HANK MAURER, 1972
/SHAWN SPILMAN, 1973
/
/
/
/
/ASSEMBLE AND LOAD AS FOLLOWS:
/
/	.R PAL8
/	*BLOAD,BLOAD<BLOAD.03
/	.R ABSLDR
/	*BLOAD$
/	.SA SYS BLOAD;7605
/
/NOTE DIFFERENCES FROM VERSION 1 BY TRUNCATING
/THE SOURCE AFTER TAG "IMAGE" AND THEN:
/
/	.R SRCCOM
/	*LPT:<BLOAD.01,BLOAD.03
/	*
/
/ALL CODE FOLLOWING TAG "IMAGE" IS NEW FOR VERSION 3
/
	VERSON=	5	/VERSION WORD LOCATED AT TAG "VERLOC"
			/LEFT HALF CONTAINS 60+VERSON
			/RIGHT HALF CONTAINS PATCH LEVEL (A=01)

/
/CORRECTIONS MADE FOR V4		J.K 1975
/ .MADE SWAP ROUTINE A REAL SWAP
/ ./V FOR VERSION NUMBER
/ ./C SO NON-BASIC SAVE FILES CAN CHAIN TO BASIC SAVE FILES
/ .ADJUST JSW FOR /K
/ .CORRECTED CCB FOR /K
/ .CALCULATION OF DEFAULT CORE SIZE FOR PDP-8
/ .TEST FOR BATCH RUNNIG
/ .CHANGE ORDER OF CISTRT SO A CHAIN CAN BE
/	CAN BE DONE FROM A .SV FILE WITH A 
/	FILE STATEMENT
/

/JR	30-APR-77	UPDATE VERSION AND FIX ERROR IN MAKECI WHEN BATCH NOT 
/			RUNNING
/JR	9-MAY-78	ADD CODE TO HANDLE 2 PAGE SYSTEM HANDLERS (RL01)
	/OS8 BASIC COMPILER POST PROCESSOR

	/AUTO INDEX REGISTERS

	X10=10
	X11=11
	X13=13
	STACK=15

	/DUMMY SECTIONS FOR COMPILER/RUNTIME COMMUNICATIONS

	NOPUNCH

	/BRTS COMMUNICATIONS REGION

	*20
STCDF,	0
NSTADR,	0
NASTAD,	0
SSTADR,	0
SASTAD,	0
CODCDF,	0
CODBGN,	0
DATTOP,	0
DATPTR,	0
SWPINF,	0

	/BCOMP COMMON REGION

	*40
VARCNT,	0
SVCNT,	0
ACNT,	0
SACNT,	0
LOCTRH,	0
LOCTRL,	0
BLOCK,	0
HIFLD,	0
BRTS,	0
DLSIZE,	0
ABORTX,	0

	/PAGE 0 LOCATIONS USED BY LOADER

FREEHI,	0
FREELO,	0
TEMP,	0
TEMP2,	0
TEMP3,	0
WORD1,	0
WORD2,	0
WORD3,	0
NCHARS,	0
SUBHI,	0
SUBLO,	0
CODSZ1,	0
CODSZ2,	0
LOCHI,	0
LOCLO,	0
CODB,	0
CODF,	0
ICOUNT,	0
OCOUNT,	0
AC1,	0
AC2,	0
AC3,	0
SC,	0
LINEH,	0
LINEL,	0
XLABEL,	0
CLRFLD,	0
CLREND,	0
RESADR,	0

	/MORE COMPILER DEFINITIONS

	SVARST=	1036
	ARAYST=	2132
	SARYST=	2332
	STEMPS=	2560
	LITRL=	STEMPS+2
	SLITRL=	LITRL+2
	DATLST=	SLITRL+2

	/MISC DEFINES

	STACKA=	7120	/MAIN STACK OF COMPILER
	EDTBGN=	3212	/START OF EDITOR
	EDTSIZ=	2100	/SIZE OF EDITOR
	BRTBGN=	200	/START OF BRTS
	BRTSIZ=	3400	/SIZE OF BRTS
	DCB=	7760
	JSW=	7746	/OS/8 JOB STATUS WORD
	BIPCCL=	7777	/OS/8 SOFTWARE CORE SIZE AND BATCH FLAGS WORD
	FSTOP1=	7	/ADDR OF BRTS EXIT ROUTINE

	ENPUNCH		/END OF DUMMY SECTIONS
	AC7775=	CLL STA RTL
	AC7776=	CLL STA RAL

	/LOADER PROPER

	*400
LOADER,	JMS I	(IMAGE	/CORE IMAGE FILE PATCH
	TAD	(7577	/EXECUTION RESUMES HERE
	DCA	FREELO
	CIA IAC
	DCA	SWPINF	/SET SWAPPER FLAG TO INDICATE 17600 IS IN FIELD 1
	DCA	LINEH	/CLEAR LINE NUMBER
	DCA	LINEL
	TAD	STACK	/ANY UNCLOSED FOR'S ?
	CIA
	TAD	(STACKA-1
	SNA CLA
	JMP	.+3	/NO
	JMS I	(ERMSG	/YES
	2506
	CLA CMA
	TAD	HIFLD	/NO CDF'S IF ONLY 8K
	SZA CLA
	JMP	NOPATCH	/NO PATCHES
	TAD	(PATLST-1
	DCA	X10
PATLUP,	TAD I	X10
	SNA
	JMP I	(STSTUF
	DCA	TEMP
	TAD	(SKP	/ALWAYS TWO WORDS
	DCA I	TEMP
	JMP	PATLUP
NOPATCH,AC7775		/TEST MAGIC LOCATION FOR A 3
	TAD I	(7612
	SZA CLA		/SKP IF 2 PAGE SYSTEM HANDLER
GOTTD,	JMP	NOTD8E	/NO TD/8E OR ROM TD/8E
			/PREV INSTR NOP'D OUT TO FORCE TD8E (IMAGE)
	TAD	(7377	/TD8E SYS WASTES 400 WORDS
	DCA	FREELO
	STL RAR		/SET SWAP INFO (17600 OUT NOW)
NOTD8E,	DCA	SWPINF
	JMS I	(FREEF	/GET CDF TO HIGHEST FIELD
	DCA	SWPF1	/INTO 2 PLACES
	TAD	SWPF1
	DCA	SWPF2
	TAD	SWPF2	/PASS NEW HANDLER FIELD BITS TO SWAPPER (2 PAGE HNDLR)
	JMS	SWAP	/MOVE OS8 OUT
	JMP I	(STSTUF	/DO SYMBOL TABLE STUFF
SWAP,	0		/SWAP OS8 RESIDENT
	AND	(70	/ISOLATE NEW FIELD BITS IN AC
	DCA	AC2	/SAVE THEM
	CLL CML RAR	/4000
	AND	SWPINF	/IS IT A TD8E SYS ?
	SZA CLA
	JMP	TD8ESYS	/YES
	JMS	SWPSUB	/SWAP 17600 TO/FROM N7600
	CDF	10
	7600
	JMP I	SWAP
TD8ESYS,JMS	SWPSUB	/SWAP 17600 TO/FROM N7400
	CDF	10
	7400
	JMS	SWPSUB	/SWAP 27600 TO/FROM N7600
L6221,	CDF	20
L7600,	7600
TDLIE,	AC7775		/TEST FOR GENUINE 2 PAGE HANDLER
	TAD I	(7612
	SZA CLA
	JMP I	SWAP	/RETURN IF NO
	TAD	(7635	/SET POINTER INTO HANDLER
	DCA	AC1
PATLP,	TAD I	AC1	/RANGE CHECK WORD FOR CDF 20-70
	TAD	(-6300
	CLL
	TAD	(70
	SNL CLA		/SKP IF CDF N0
	JMP	NOPAT	/ELSE SKP ADJUSTMENT
	TAD I	AC1	/GET INSTRUCTION
	AND	(7707	/CLEAR FIELD BITS
	TAD	AC2	/INSERT NEW ONES
	DCA I	AC1	/STORE BACK
NOPAT,	ISZ	AC1	/BUMP PTR
	JMP	PATLP	/LOOP
	JMP I	SWAP

SWPSUB,	0		/SWAPPER
	TAD I	SWPSUB	/GET FIELD
	DCA	SWP1	/TWICE
	TAD	SWP1
	DCA	SWP2	/ONCE FOR EACH DIRECTION
	ISZ	SWPSUB
	TAD I	SWPSUB	/GET HI FIELD ADDR
	DCA	TEMP
	ISZ	SWPSUB
	TAD	L7600	/GET COUNT/POITER
	DCA	TEMP2
SWP1,	HLT
	TAD I	TEMP2	/GET PART OF RESIDENT
	DCA	TEMP3
SWPF1,	JMP	SWPRET	/RETURN IF 8K ONLY
	TAD I	TEMP
SWP2,	HLT
	DCA I	TEMP2
	TAD	TEMP3
SWPF2,	HLT
	DCA I	TEMP	/INTO HI FIELD
	ISZ	TEMP	/BUMP POINTER
	NOP		/JR PROTECT AGAINST WRAP AROUND
	ISZ	TEMP2	/AND PTR/CTR
	JMP	SWP1	/LOOP
SWPRET,	CDF
	JMP I	SWPSUB

	PAGE
	MAXSIZ=	120	/DEFINE MAXIMUM SIZE STRING

NODATA,	CDF
	JMS I	(FREEF	/SAVE FIELD
	CIA
	DCA	CLRFLD	/FOR ARRAY CLEARING
	TAD	FREELO	/SAVE THIS ADDR
	CIA
	DCA	CLREND	/FOR END OF ARRAY CLEAR
	ISZ	FREELO	/MAKE IT NEXT FREE + 1
	TAD	(SVARST-1
	DCA	X10	/ALLOCATE STRING VARS
	TAD	(-436
	DCA	TEMP
ASVLUP,	CDF	10
	TAD I	X10	/LOOK FOR DEFINED STRING VAR
	DCA	TEMP2	/SAVE SYMBOL NUMBER
	TAD I	X10	/GET SIZE
	SPA
	TAD	(4010	/IF UNDEF USE 16 CHARS
	DCA	TEMP3
	TAD	TEMP2	/IS IT DEFINED ?
	CDF
	SMA CLA
	JMS	SVSTOR	/YES, CREATE ENTRY
	ISZ	TEMP	/BUMP COUNT
	JMP	ASVLUP	/LOOP
	CDF	10	/ALLOCATE STRING TEMPS
P6,	TAD I	(STEMPS+1
	DCA	STEMPF	/INIT FIELD
	TAD I	(STEMPS	/AND POINTER
	SKP
STMLUP,	TAD	TEMP	/LOOK AT NEXT ENTRY
	SNA
	JMP I	(ALLOCA	/DONE GO ALLOCATE ARRAYS
	TAD	(-1
	DCA	X10	/GET POINTER
STEMPF,	CDF	10
	TAD I	X10	/GET ADDR OF NEXT ENTRY
	DCA	TEMP	/SAVE IT
P7,	TAD I	X10	/AND ITS FIELD
	DCA	STEMPF
	ISZ	X10	/SKIP TEMP NUMBER
	TAD I	X10	/GET SYM NUMBER
	DCA	TEMP2
	CDF
	TAD	(MAXSIZ	/GIVE IT MAX SIZE
	DCA	TEMP3
	JMS	SVSTOR	/ALOOCATE IT
	JMP	STMLUP	/LOOP
SVSTOR,	0		/MAKE ST ENTRY FOR STRING VAR
	TAD	TEMP2	/FIND ST ADDR
	CLL RAL
	TAD	TEMP2
	TAD	SSTADR
	DCA	X11
	TAD	TEMP3	/NUMBER OF CHARS
	TAD	(3
	CLL RAR
	DCA	SUBLO	/NUMBER OF WORDS
	DCA	SUBHI
	JMS	SUB	/FREEHI,LO=FREEHI,LO-SUBHI,LO
	TAD	FREELO	/SAVE ADDR
	DCA I	X11
	JMS I	(FREEF	/AND FIELD
	DCA I	X11
	TAD	TEMP3	/PUT IN MAX LENGTH
	CIA		/(NEGATIVE)
	DCA I	X11
	JMP I	SVSTOR
PSN,	0		/PRINT 3 DIGITS DECIMAL
	DCA	WORD2
	CLL CMA RTL	/-3
	DCA	XLABEL
PRNTSN,	TAD	WORD2	/GET NEXT DIGIT
	CLL RTL		/INTO THE LOW ORDER
	RTL		/THREE BITS AND THE LINK
	DCA	WORD2	/SAVE SHIFTED NUMBER
	TAD	WORD2	/NOW DO LAST SHIFT
	RAL
	AND	(17	/ONLY FOUR BITS
SPACE,	SZA
	JMP	NOZERO	/NOT A ZERO
	TAD I	(TTY	/ANY DIGITS YET ?
	SNA CLA
	JMP	LEAD0	/NO, ITS A LEADING ZERO
NOZERO,	TAD	(60	/MAKE IT ASCII
	JMS I	(TTY	/PRINT DIGIT
LEAD0,	ISZ	XLABEL	/BUMP COUNT
	JMP	PRNTSN	/MORE DIGIT(S)
	JMP I	PSN
SUB,	0		/DOUBLE SUBTRACT
	TAD	SUBLO	/SUBTRACT LOWER
	CLL CML CIA
	TAD	FREELO
	DCA	FREELO
	RAL		/GET BORROW
	TAD	SUBHI
	CIA
	TAD	FREEHI	/SUBTRACT UPPER
	DCA	FREEHI	/SAVE NEW UPPER
	TAD	FREEHI	/DID IT FIT ?
	SMA SZA CLA
	JMP I	SUB	/YUP
TOOBIG,	DCA	LINEH	/CLEAR LINE NUMBER
	DCA	LINEL
	JMS I	(ERMSG	/WRITE MESSAGE
	2402		/TOO BIG
	JMP I	(ABORTL	/ABORT RUN

TTX,	0		/PRINT CHAR ON TTY
	TSF		/WAIT FOR PREVIOUS CHAR
	JMP	.-1
	TLS		/PRINT THIS ONE
	CLA
	JMP I	TTX

	PAGE
/    CAUTION !!!
/    THIS PAGE AND THE NEXT ONE ARE
/    OVERLAYED BY THE INPUT BUFFER
/    AS SOON AS THE ROUTINE "INWORD"
/    IS CALLED. THIS FIRST HAPPENS
/    AFTER THE TAG "RELCIT" .

STSTUF,	TAD	FREELO	/SAVE START OF RESIDENT -1
	CIA		/NEGATED
	DCA	RESADR	/USED TO COMPUTE AMOUNT OF MOVE
	TAD	VARCNT	/GET NUMBER OF
	TAD	(401	/VARIABLES
	CIA
	DCA	VARCNT
	TAD	SVCNT	/STRING VARIABLES
	TAD	(401
	CIA
	DCA	SVCNT
	TAD	ACNT	/ARRAYS
	TAD	(41
	CIA
	DCA	ACNT
	TAD	SACNT	/AND STRING ARRAYS
	TAD	(41
	CIA
	DCA	SACNT
	JMS I	(FREEF	/SAVE HIGH FIELD
	DCA	STCDF
	TAD	VARCNT	/SUBTRACT SPACE FOR
	CLL RAL		/SCALAR TABLE (3 WORDS A PIECE)
	TAD	VARCNT
	TAD	FREELO	/DON'T BOTHER WITH A
	DCA	FREELO	/DOUBLE PREC. SUBTRACTION
	TAD	FREELO	/SAVE START OF SCALAR TABLE
	IAC		/FOR INTERPRETER
	DCA	NSTADR
	TAD	FREELO	/CLEAR ALL VARIABLES
	DCA	X10	/IN THE
	DCA I	X10	/SCALAR TABLE
	DCA I	X10
	DCA I	X10
	ISZ	VARCNT
	JMP	.-4	/JUST TO BE NICE
	CDF	10	/PREPARE TO MOVE
P1,	TAD I	(LITRL+1/THE NUMERIC LITERALS
	DCA	LFLD	/INTO THE SCALAR TABLE
	TAD I	(LITRL
	CDF
	SKP
NLLOOP,	TAD	TEMP	/ADDR OF NEXT LITERAL
	SNA
	JMP	NONL	/NO MORE NUMERIC LITERALS
	TAD	(-1
	DCA	X10
LFLD,	CDF	10
	TAD I	X10	/GET ADDR OF NEXT LITERAL
	DCA	TEMP
P2,	TAD I	X10	/ALSO ITS FIELD
	DCA	LFLD
	TAD I	X10	/NOW ITS VALUE
	DCA	WORD1
	TAD I	X10
	DCA	WORD2
	TAD I	X10
	DCA	WORD3
	TAD I	X10	/NOW THE SYMBOL NUMBER
	DCA	TEMP2
	TAD	TEMP2	/TIMES THREE
	CLL RAL
	TAD	TEMP2
	TAD	FREELO	/PLUS START
	DCA	X11	/GIVES STORE ADDR
	CDF
	TAD	WORD1	/NOW PUT LITERAL INTO TABLE
	DCA I	X11
	TAD	WORD2
	DCA I	X11
	TAD	WORD3
	DCA I	X11
	JMP	NLLOOP	/DO NEXT LITERAL
NONL,	TAD	ACNT	/ALLOCATE ARRAY TABLE
	CLL RAL
	CLL RAL		/FOUR WORDS PER
	TAD	FREELO	/SUBTRACT FROM LOWER END
	DCA	FREELO
	TAD	FREELO	/SAVE THIS
	DCA	NASTAD	/START OF ARRAY TABLE
	TAD	SVCNT	/ALLOCATE
	CLL RAL		/STRING VAR TABLE
	TAD	SVCNT
	TAD	FREELO	/3 WORDS EACH
	DCA	FREELO
	TAD	FREELO	/AND SAVE IT FOR THE INT
	DCA	SSTADR
	TAD	SACNT	/NOW SPACE FOR STRING
	CLL RAL		/ARRAY
	CLL RAL
	TAD	FREELO	/TABLE
	DCA	FREELO
	TAD	FREELO	/SAVE FOR INT
	DCA	SASTAD
	CDF	10	/PREPARE TO MOVE
P3,	TAD I	(SLITRL+1
	DCA	SLFLD	/STRING LITERALS
	TAD I	(SLITRL
	CDF
	SKP
SLLOOP,	TAD	TEMP	/IS NEXT LIT THERE ?
	SNA
	JMP I	(NOSL	/NO, END OF THE LINE
	TAD	(-1
	DCA	X10
	JMS	SFLD	/SET THE FIELD
	TAD I	X10	/GET ADDR OF NEXT
	DCA	TEMP
P4,	TAD I	X10	/ALSO FIELD
	DCA	TEMP2
	TAD I	X10	/THEN CHAR COUNT
	DCA	NCHARS
	JMP I	(SLIT2	/DO REST OF STRING LIT
SFLD,	0
SLFLD,	CDF	10
	JMP I	SFLD

	PAGE
SLIT2,	TAD	NCHARS	/COMPUTE WORD COUNT
	TAD	(3
	CLL RAR
	TAD	X10	/TO GET ADDR OF SYMBOL NUMBER
	DCA	TEMP3
	TAD I	TEMP3
	CLL RAL		/SYM NUMBER TIMES 3
	TAD I	TEMP3
	TAD	SSTADR	/PLUS BASE
	DCA	X11	/GIVES ST ADDR
	TAD	NCHARS	/ALLOCATE SPACE FOR IT
	IAC
	CLL CML CMA RAR
	DCA	TEMP3	/(SAVE NUMBER OF WORDS)
	TAD	TEMP3
	CLL
	TAD	FREELO
	DCA	FREELO	/BELOW THE SYMBOL TABLES
	SNL
	JMP	TMSLIT	/TOO MUCH STRING LITERALS
	TAD	FREELO
	TAD	(-END-10
	SZL CLA
	JMP	TMSLIT	/DITTO
	TAD	FREELO	/STICK THE ADDR
	IAC
	CDF
	DCA I	X11	/INTO THE ST ENTRY
	JMS I	(FREEF	/ALSO THE FIELD
	DCA I	X11
	TAD	NCHARS	/ALSO THE SIZE
	CIA
	DCA I	X11
	TAD	FREELO	/THIS IS WHERE IT GOES
	DCA	X11
	TAD	NCHARS	/PUT IN THE LENGTH TOO
	CIA		/(NEGATIVE)
	JMP	.+4
MOVSL,	JMS I	(SFLD
	TAD I	X10
	CDF
	DCA I	X11	/MOVE THE LITERAL TEXT
	ISZ	TEMP3
	JMP	MOVSL
P5,	TAD	TEMP2	/PUT THE FIELD OF THE NEXT
	DCA I	(SLFLD	/ENTRY WHERE IT DOES THE MOST GOOD
	JMP I	(SLLOOP	/DO THE NEXT LITERAL
NOSL,	TAD	FREELO	/SAVE TOP OF DATA LIST
	DCA	DATTOP
	TAD	DATTOP	/IF EMPTY MAKE TOP=BOTTOM
	DCA	DATPTR
	TAD	DLSIZE
	SNA		/IS ANY DATA ?
	JMP I	(NODATA	/NO
	CLL
	TAD	FREELO	/GET START OF DATA
	DCA	FREELO
	SNL
	JMP	TMDATA	/TOO MUCH DATA
	TAD	FREELO
	TAD	(-END-10
	SZL CLA
	JMP	TMDATA	/DITTO
	TAD	FREELO	/SAVE IT
	DCA	DATPTR
	TAD	FREELO	/USE X13 TO FILL LIST
	DCA	X13
	TAD	(DATLST-1
	DCA	X10
	CDF	10
DATLUP,	TAD I	X10	/ANY MORE DATA ELEMENTS ?
	SNA
	JMP I	(NODATA
	DCA	TEMP	/SAVE ADDR
P8,	TAD I	X10	/GET NEW FIELD
	DCA	DATAF1
P9,	TAD	DATAF1	/TWICE
	DCA	DATAF2
	TAD	TEMP	/START WITH NEW ELEMENT
	DCA	X10
DATAF1,	CDF	10
	TAD I	TEMP	/GET COUNT
	DCA	TEMP
DATMOV,	TAD I	X10	/GET NEXT WORD
	CDF
	DCA I	X13	/MOVE INTO DATA AREA
DATAF2,	CDF	10
	ISZ	TEMP
	JMP	DATMOV
	JMP	DATLUP	/DO NEXT ELEMENT
TMDATA,	DCA	LINEL	/ZERO LINE NUMBER
	DCA	LINEH
	JMS I	(ERMSG	/PRINT ERROR MESSAGE
	2404
	JMP I	(ABORTL
TMSLIT,	DCA	LINEH	/CLEAR THE LINE NUMBER
	DCA	LINEL
	JMS I	(ERMSG	/PRINT MESSAGE
	2423
	JMP I	(ABORTL

PATLST,	P1;P2;P3;P4;P5;P6;P7;P8;P9;0

	PAGE
ALLOCA,	TAD	ACNT	/ANY ARRAYS ?
	SNA CLA
	JMP	ALLOCS	/NO
	TAD	(ARAYST	/ALLOCATE ARRAYS
	DCA	X10
	TAD	NASTAD
	DCA	X11
DOARAY,	CDF	10
	TAD I	X10	/GET NEXT ARRAY
	DCA	TEMP
	TAD I	X10	/GET FIRST DIM
	SNA
	TAD	(12	/USE 10 IF NONE
	IAC		/ALLOCATE 0TH ELEMENT
	DCA	TEMP2
	TAD I	X10	/GET SECOND DIM
	SNA
	TAD	(12
	IAC
	DCA	TEMP3
	TAD	TEMP3	/GET READY TO SUBTRACT
	DCA	SUBLO
	DCA	SUBHI
	CDF
	CLL CML RTR
	AND	TEMP	/HOW MANY DIMS ?
	SNA CLA
	JMP	ONLY1	/ONE
	TAD	TEMP2	/PRODUCT OF DIMS
	JMS I	(MUL12
	JMP	TIMES3	/MULT BY 3
ONLY1,	DCA	TEMP3	/ZERO SECOND DIMENSION
	TAD	TEMP2
	DCA	SUBLO
TIMES3,	TAD	(3	/MULT SIZE BY 3
	JMS I	(MUL12
	JMS I	(SUB	/SUBTRACT FROM FREE
	TAD	FREELO
	DCA I	X11	/SAVE ADDR IN S.T.
	JMS I	(FREEF
	DCA I	X11
	TAD	TEMP2	/ALSO DIMS
	DCA I	X11
	TAD	TEMP3
	DCA I	X11
	ISZ	X10	/SKIP SYMBOL NUMBER
	ISZ	ACNT
	JMP	DOARAY
ALLOCS,	TAD	SACNT	/ANY STRING ARRAYS
	SNA CLA
	JMP I	(RELCIT	/NO
	TAD	(SARYST+1
	DCA	X10	/ALLOCATE STRING ARRAYS
	TAD	SASTAD
	DCA	X11
DOSARY,	CDF	10
	TAD I	X10
	SNA
	TAD	(12	/USE 10 FOR DIM
	IAC
	DCA	TEMP3
	TAD I	X10	/GET DIM
	SNA
	TAD	(10	/USE 16 IF NO SIZE SPEC
	DCA	TEMP2
	TAD	TEMP3
	DCA	SUBLO	/PREPARE FOR MULT
	DCA	SUBHI
	CDF
	TAD	TEMP2	/GET NUM WORDS PER STRING
	TAD	(3
	CLL RAR
	JMS I	(MUL12	/GET ARRAY SIZE
	JMS I	(SUB	/DO SUBTRACTION
	TAD	FREELO	/SAVE ADDR
	DCA I	X11
	JMS I	(FREEF
	DCA I	X11
	TAD	TEMP2	/AND STRING SIZE
	CIA		/(SIZES ARE NEG)
	DCA I	X11
	TAD	TEMP3	/AND NUMBER OF STRINGS
	DCA I	X11
	ISZ	X10	/SKIP NEXT NAME
	ISZ	X10	/AND NEXT SYM NUMBER
	ISZ	SACNT
	JMP	DOSARY
	JMP I	(RELCIT
INWORD,	0		/READ FROM CODE FILE
	ISZ	ICOUNT	/ANYTHING IN BUFFER
	JMP	NOREAD	/YASSUH!
	JMS I	(7607	/READ NEXT BLOCK
	200
	1000		/NOTE: THIS OVERLAYS USED CODE
INBLOK,	0
	JMP I	(IOERR
	ISZ	INBLOK	/BUMP BLOCK COUNTER
	TAD	INBLOK-1/RESET BUFFER POINTER
	DCA	INPTR
	TAD	(-400	/AND COUNTER
	DCA	ICOUNT
NOREAD,	TAD I	INPTR	/GET WORD
	ISZ	INPTR	/BUMP POINTER
	JMP I	INWORD
INPTR,	0

CIPAT,	0	/PATCH TO MAKECI
	TAD	(1000
	DCA I	(JSW	/CHANGE JSW
COPT,	DCA I	(CISTRT+1	/& TAKE CARE OF /C
	JMP I CIPAT

	PAGE
RELCIT,	TAD	LOCTRL	/FIND START OF CODE
	CLL IAC
	DCA	SUBLO	/BY SUBTRACTING
	RAL
	TAD	LOCTRH	/AMOUNT FROM FREE
	DCA	SUBHI
	JMS I	(SUB
	TAD	FREELO	/THIS IS THE START OF THE CODE
	DCA	CODBGN	/MINUS ONE
	TAD	FREEHI	/THIS IS THE FIELD NUMBER
	DCA	CODCDF
	TAD	LOCTRL	/SET UP PROG SIZE COUNT
	CLL CML CIA
	DCA	CODSZ1	/LOWER COUNT
	RAL
	TAD	LOCTRH
	CIA
	DCA	CODSZ2	/UPPER COUNT
	TAD	BLOCK	/SET UP FOR READ AND WRITE
	DCA I	(OUBLOK
	TAD	BLOCK
	DCA I	(INBLOK
	TAD	(-401
	DCA	OCOUNT
	CLA CMA
	DCA	ICOUNT
RELOOP,	JMS I	(INWORD	/GET A WORD OF CODE
	DCA	TEMP
	TAD	(3000
	TAD	TEMP	/CHECK FOR OPCODE 5000 (GOTO)
	AND	(7000
	SZA CLA
	JMP	NORELC	/NO JUMP
	TAD	TEMP	/REMOVE FIELD BITS
	AND	(340
	CLL RTR
	TAD	CDF0
	DCA	LBLFLD	/FIELD OF LABEL ENTRY
	TAD	TEMP	/ZERO FIELD BITS
	AND	(7437
	DCA	TEMP
	JMS I	(INWORD	/GET REST OF ADDR
	DCA	TEMP2
	JMS I	(CHKLBL	/CHECK FOR UNDEFINED LABEL
LBLFLD,	HLT
	TAD I	TEMP2
	AND	(7	/GET ADDR TO BE RELOCATED
	DCA	LOCHI
	ISZ	TEMP2
	TAD I	TEMP2
	CLL
	TAD	CODBGN	/ADD BASE ADDR
CDF0,	CDF
	DCA	LOCLO	/SAVE LOW PART OF JUMP
	RAL
	TAD	CODCDF	/GET HIGH PART
	TAD	LOCHI
	CLL RTL		/PUT IT INTO CORRECT PLACE
	RTL
	RAL
	TAD	TEMP	/PLUS INSTRUCTION
	JMS I	(OUTWRD
	ISZ	CODSZ1	/BUMP COUNTER
	SKP
	ISZ	CODSZ2	/CAN'T BE LAST WORD
	TAD	LOCLO	/OUTPUT LOW ORDER ADDR
	SKP
NORELC,	TAD	TEMP	/JUST OUTPUT IT
RELOUT,	JMS I	(OUTWRD
	ISZ	CODSZ1	/DOUBLE WORD ISZ BUMP
	JMP	RELOOP
	ISZ	CODSZ2
	JMP	RELOOP
	JMP I	(LOADIT	/DONE RELOCATING, GO LOAD

	/PRINT ERROR MESSAGE

ERMSG,	0		/PRINT ERROR MESSAGE
	CDF
	TAD I	ERMSG	/GET CODE
	CLL RTR		/PRINT FIRST CHAR
	RTR
	RTR
	JMS	TTY
	TAD I	ERMSG	/PRINT SECOND CHAR
	JMS	TTY
	ISZ	ERMSG	/FIX RETURN ADDR
	TAD	(240	/PRINT SPACE
	JMS	TTY
	DCA	TTY	/USE TTY AS A SWITCH
	TAD	LINEH	/PRINT HIGH ORDER
	JMS I	(PSN
	TAD	LINEL	/THEN LOW ORDER
	JMS I	(PSN	/(LINE NUMBER NATCH !)
	TAD	(215	/PRINT CARRIAGE RETURN
	JMS I	(TTX
	TAD	(212	/PRINT LINE FEED
	JMS I	(TTX
	JMP I	ERMSG	/RETURN

TTY,	0		/CONVERT TO ASCII AND PRINT
	TAD	(240
	AND	(77
	TAD	(240
	JMS I	(TTX	/PRINT CHAR
	JMP I	TTY	/RETURN

	PAGE
LOADIT,	JMS I	(OUDUMP	/DUMP LAST BLOCK
	TAD	LOCTRL	/SET UP COUNTER
	CIA CLL CML
	DCA	CODSZ1
	RAL
	TAD	LOCTRH
	CIA
	DCA	CODSZ2
	TAD	CODBGN
	DCA	TEMP	/CODE BEGIN -1
	TAD	BLOCK	/SET UP BLOCK NUMBER
	DCA I	(INBLOK
	CLA CMA
	DCA	ICOUNT
	TAD	CODCDF	/SET UP CODE CDF
	CLL RTL
	RAL
	TAD	(6201
	DCA	CODCDF
	TAD	CODCDF
	DCA	CF
LODLUP,	ISZ	TEMP	/BUMP POINTER
	JMP	NOFJMP	/FIELD IS OK
	TAD	CF	/BUMP THE FIELD
	TAD	(10
	DCA	CF
NOFJMP,	JMS I	(INWORD	/GET NEXT WORD
CF,	HLT
	DCA I	TEMP	/SAVE THE WORD
CDFZER,	CDF
	ISZ	CODSZ1	/MORE CODE ?
	JMP	LODLUP	/YES
	ISZ	CODSZ2
	JMP	LODLUP	/YES
	TAD	CF	/GET THE FIELD
	DCA	CLEARF	/AND SAVE IT
CLRLUP,	TAD	CLREND	/IS THIS THE END OF CLEAR ?
	TAD	TEMP
	SZA CLA
	JMP	MORCLR	/NO, KEEP GOING
	TAD	CLRFLD	/DO FIELDS MATCH ?
	TAD	CLEARF
	SNA CLA
	JMP	DONCLR	/YES, ARRAYS ARE CLEARED
MORCLR,	ISZ	TEMP	/BUMP POINTER
	JMP	CLEARF	/DON'T BUMP FIELD
	TAD	CLEARF	/DO BUMP FIELD
	TAD	(10
	DCA	CLEARF
CLEARF,	HLT
	DCA I	TEMP	/CLEAR THE WORD
	JMP	CLRLUP	/DO MORE
DONCLR,	TAD	CLEARF	/COPY THE FIELD
	DCA	STFLDM
	TAD	TEMP	/GET THE COUNT
	TAD	RESADR	/OF HOW MUCH SYMBOL TABLE
	DCA	TEMP2	/TO MOVE
	TAD	TEMP	/PUT IT INTO AUTO XR'S
	DCA	X13
	TAD	X13
	DCA	X11
MOVSTL,	CDF
	TAD I	X11	/GET NEXT WORD OF ST
STFLDM,	HLT
	DCA I	X13	/STORE IT
	ISZ	TEMP2
	JMP	MOVSTL
	JMS	MOVFIN	/MOVE FINI PAGE INTO 7000-7177
	JMP I	(7000	/GO READ BRTS.SV
CHKLBL,	0		/CHECK LABEL FOR UNDEF
	TAD I	CHKLBL	/GET FIELD
	DCA	.+1
	HLT
	TAD I	TEMP2	/GET FIRST WORD OF LABEL
	SPA CLA
	JMP I	CHKLBL	/SIGN BIT IS DEFINED
	CLL CMA RAL	/GET ADDR OF LINE NUM
	TAD	TEMP2
	DCA	XLABEL
	TAD I	XLABEL	/GET HIGH ORDER LINE
	DCA	LINEH
	ISZ	XLABEL
	TAD I	XLABEL	/GET LOW ORDER
	DCA	LINEL
	CDF
	JMS I	(ERMSG	/PRINT MESSAGE
	2523
	JMP I	CHKLBL	/RETURN

FREEF,	0		/MAKE A CDF FROM FREEHI
	TAD	FREEHI
	CLL RTL
	RAL
	TAD	CDFZER
	JMP I	FREEF

ABORTL,	JMS	MOVFIN	/PUT FINI PAGE INTO 7000-7177
			/AND ABORT THE RUN
	JMP I	(ABORT-FINI+7000

MOVFIN,	0		/FINI PAGE MOVER
	CDF
	TAD	(FINI-1	/MOVE INT READING CODE
	DCA	X10
	TAD	(6777	/INTO 7000
	DCA	X11
	TAD	(-200
	DCA	TEMP	/PUT CORRECT COUNT HERE
	TAD I	X10
	DCA I	X11	/MOVE CODE
	ISZ	TEMP
	JMP	.-3
	JMP I	MOVFIN

	PAGE
FINI,	TAD I	XERMSG	/ANY ERRORS ?
	SZA CLA
	JMP	ABORT	/YES, DON'T RUN IT
	TAD	XINT	/MOVE INT STUFF
	DCA	FTEMP
	TAD	M12	/10 KEY LOCATIONS
	DCA	FCNT
	TAD	XSAVE	/INTO A SAFE PLACE
	DCA	FTEMP2
	TAD I	FTEMP
	ISZ	FTEMP
	DCA I	FTEMP2
	ISZ	FTEMP2
	ISZ	FCNT
	JMP	.-5	/MOVE LOOP
	TAD	BRTS	/READ IN BRTS
	DCA	BRTSB
	JMS I	X7607
	BRTSIZ
	0
BRTSB,	0
	JMP	IOERR
	TAD	XSAVE
	DCA	FTEMP
	TAD	XINT	/MOVE STUFF BACK
	DCA	FTEMP2
	TAD I	FTEMP
	ISZ	FTEMP
	DCA I	FTEMP2
	ISZ	FTEMP2
	ISZ	M12
	JMP	.-5
	TAD	(JMP I FSTOP1	/PATCH ^C LOCATIONS
	DCA I	(7600
	TAD	(JMP I FSTOP1
	DCA I	(7605
	JMP I	(BRTBGN	/GO START BRTS

M12,	-12
XINT,	20
XERMSG,	ERMSG
X7607,	7607
XSAVE,	7001+XSAVE-FINI

MUL12,	0		/MULTIPLY 12BITS AND 24 BITS
	DCA	AC3	/SAVE 12 BIT THING
	DCA	AC2	/CLEAR REST OF AC
	DCA	AC1
	TAD	(-15	/ONLY TEST 12 BITS
	DCA	SC
	JMP	MULBGN
MULLUP,	SNL		/WAS BIT ON ?
	JMP	NOADD	/NO, DON'T ADD
	TAD	SUBLO	/ADD TO HIGH ORDER 2/3'S OF AC
	TAD	AC2
	DCA	AC2
	CML RAL
	TAD	SUBHI
NOADD,	TAD	AC1	/SHIFT AC RIGHT
	CLL RAR
	DCA	AC1
	TAD	AC2
	RAR
	DCA	AC2
MULBGN,	TAD	AC3
FTEMP,	RAR
FTEMP2,	DCA	AC3
FCNT,	ISZ	SC	/BUMP SHIFT COUNTER
	JMP	MULLUP
	TAD	AC2	/ANSWER IS LOWER 2/3'S OF AC
	DCA	SUBHI
	TAD	AC3
	DCA	SUBLO
	JMP I	MUL12

IOERR,	DCA	LINEL	/ZERO LINE NUMBER
	JMS I	XERMSG	/PRINT MESSAGE
	1117
ABORT,	TAD	(20	/PASS NORMAL FIELD BITS TO RESTORE ANY 2 PAGE SYS:
	JMS I	(SWAP	/SWAP OS8 BACK
	JMS I (200	/CHECK OUT W/ CI BUILDER
	TAD	(4207	/RESTORE ^C LOCATIONS
	DCA I	(7600
	TAD	(6213
	DCA I	(7605
	TAD	ABORTX	/CALLED VIA CHAIN ?(FROM EDIT)
	SNA
	JMP I	(7600	/NO, RETURN TO OS8
	DCA	EDTBLK	/YES, SAVE EDITOR START
	JMS I	X7607	/READ IN EDITOR
	EDTSIZ		/THIS MUCH
	0
OWTEMP,
EDTBLK,	0
	JMP I	(7605	/ERROR
	JMP I	(EDTBGN	/GO START EDITOR

OUTWRD,	0		/OUTPUT WORD TO TEMP FILE
	ISZ	OCOUNT	/ANY ROOM ?
	JMP	NOWRIT	/YES
	DCA	OWTEMP	/SAVE WORD
	JMS	OUDUMP	/WRITE BLOCK
	ISZ	OUBLOK	/BUMP BLOCK NUMBER
	TAD	OUBLOK-1/RESET BUFFET POINTER
	DCA	OUPTR
	TAD	(-400
	DCA	OCOUNT	/AND COUNT
	TAD	OWTEMP	/RESTORE AC
NOWRIT,	CDF	10
	DCA I	OUPTR	/INTO BUFFER
	CDF
	ISZ	OUPTR
	JMP I	OUTWRD
OUPTR,	0
OUDUMP,	0		/WRITE BLOCK
	JMS I	X7607	/WRITE BLOCK
	4210
	0
OUBLOK,	0
	JMP	IOERR
	JMP I	OUDUMP

	END=FINI+200

	PAGE
	BLDCI=200	/PAGE INTO WHICH MAKECI GETS MOVED
	LOADBL=357	/LOC WHERE BCOMP LEAVES BLOAD BLOCK #

IMAGE,	0
	TAD I	(LOADBL	/COME HERE TO CREATE CORE IMAGE
	TAD	(6		/ALREADY HAVE THIS MUCH
	DCA I	(LDRBLK	/INIT BLOAD OVRLY READER
	CDF 10
	TAD I	(7644	/TEST FOR /V
	CDF
	AND	(4
	SZA CLA
	JMS I	(VERNUM
	CDF 10
	TAD I	(7643	/GET OPTION BITS
	CDF
	DCA	TEMP
	TAD	TEMP
	RTR
	SNL CLA		/HAVE K OPTION?
	JMP	LSTART	/NO: START LOADER
	TAD	TEMP
	RTL
	SZL CLA		/HAVE B OPTION?
	DCA I	(FLGRTS	/YES: FLAG IT
	TAD	TEMP	/TEST FOR /C
	RTL
	SPA CLA
	JMP	.+3
	TAD	(NOP
	DCA I	(COPT
	CDF 10
	TAD I	(7646	/GET =N
	CDF
	AND (7		/WIPE ALT MODE
	SNA
	CLL CML RTL	/DEFAULT=12K FOR NOW
	DCA	TEMP
	CLL CMA
	TAD	TEMP	/MUST BE >1 HERE
	SNA CLA
	ISZ	TEMP
	TAD	TEMP
	CLL CMA
	TAD	HIFLD
	SNL CLA		/WHICH HAS MORE CORE?
	JMP	.+3		/TARGET MACHINE: TOUGH
	TAD	TEMP	/HOST MACHINE
	DCA	HIFLD	/FAKE OUT LOADER
	TAD	HIFLD
	CIA
	DCA I	(FLDCNT	/INIT CI BUILDER
	TAD I	(FLDCNT
	DCA I	(MYCORE	/AND CI STARTER
	CDF 10
	DCA I	(7646	/CLEAR =N BITS
	DCA I	(7643	/AND EARLY OPTIONS
	TAD I	(7644	/GET OPTION BITS
	CDF
	RTL
	SZL CLA		/HAVE N SWITCH?
	JMP	NOTDSY	/NEVER SEES TD8E SYSTEM
	TAD	HIFLD
	CLL RAR
	SNA CLA		/HAVE OVER 8K CORE?
	JMP	NOTDSY
	TAD	(NOP
	DCA I	(GOTTD	/YES: FORCE SYS=TD8E
	CLA IAC
NOTDSY,	DCA I	(TDFLAG	/NOT 0 MEANS HAVE TD8E
	CMA
	DCA I	(ERMSG	/FORCE LOAD ABORT
LSTART,	TAD	(BLDCI-1	/MOVE CI BUILDER
	DCA	X10		/INTO LOW CORE
	TAD	(MAKECI-1
	DCA	X11
	TAD I	X11
	DCA I	X10
	ISZ	ICTR
	JMP	.-3
	TAD	HIFLD	/START OF BLOAD V1
	DCA	FREEHI
	JMP I	IMAGE	/RETURN TO LOADER

ICTR,	-200
CCLIST,	0		/1ST 4 WORDS OF CCB
	6203
	CISTRT
	1000		/JOB STATUS WORD

	PAGE
	CCB=1000	/LOC TO START BUILDING CCB

MAKECI,	0		/THIS PAGE GETS MOVED!
	TSF
	JMP	.-1		/SEE TAG "ABORT" IN BLOAD V1
	ISZ I	(ERMSG	/WHY ARE WE HERE?
	JMP	BOSFIX	/GENUINE ABORTION
	TAD	(CCB-1
	DCA	X10
	TAD	(CCLIST-1
	DCA	X11
	TAD I	X11	/1ST FOUR WORDS OF CCB
	DCA I	X10
	ISZ	MKCCNT
	JMP	.-3
CCSEGS,	TAD	FLDCNT
	CLL CIA RAL
	RTL		/THIS FIELD
	DCA	TEMP
	TAD	(70
	AND	CODCDF	/LOWEST FIELD USED
	CLL CIA
	TAD	TEMP
	SNL		/THIS FIELD USED?
	JMP	NOCODE	/NO: BYPASS IT
	SZA CLA		/IS IT FULL?
	JMP	ALLCODE	/YES
	TAD	CODBGN	/PROBABLY NOT
	AND	(7400
	DCA	TEMP2
	TAD	TEMP2
	CIA
	CLL RAR
	TAD	TEMP
	DCA	TEMP
	TAD	TEMP2
ALLCODE,DCA I	X10
	TAD	FLDCNT
	IAC
	TAD	TDFLAG
	SMA CLA		/NEED TOP PAGE?
	TAD	(3700	/NO: 37 PAGES
	TAD	TEMP	/YES: 40 PAGES
	AND	K3777
	DCA I	X10
	ISZ I	(CCB
NOCODE,	CLA CLL
	ISZ	FLDCNT	/NEXT FIELD ZERO?
	JMP	CCSEGS	/NO: LOOP
	TAD	FLGRTS
	SZA CLA		/NEED BRTS?
	TAD	(CISTRT
	DCA I	X10
	TAD	FLGRTS
	SZA CLA
	TAD	(300-3700
	TAD	(3700
	DCA I	X10
	TAD I	(CCB
	CMA
	DCA I	(CCB		/NEGATE SEG COUNT
	JMS I	(7607	/READ CI STARTER
	300		/FROM END OF BLOAD.SV
	CISTRT		/INTO HI CORE
LDRBLK,	0		/INIT BY "IMAGE"
BOSPT1,	7600		/CAN'T GET THIS ERROR
	JMS I	JCIP
	TAD	TDFLAG	/PASS TD8E FLAG
	DCA I	(FLAGTD
	TAD	FLGRTS
	DCA I	(RTSFLG	/AND BRTS FLAG
	TAD	MYCORE
	DCA I	(NOCORE	/AND CORE LIMIT
	TAD	(17		/SAVE 10 KEY LOCATIONS
	DCA	X10
	TAD	(KEYLOC-1
	DCA	X11
	TAD I	X10
	DCA I	X11
	ISZ	MCICNT
	JMP	.-3
	JMS I	(7607	/CALL SYS HANDLER
	4200		/TO WRITE CCB
	CCB-200		/(AND PRECEDING PG)
	37		/INTO SCRATCH BLOCK
K3777,	3777		/CAN'T GET THIS ERROR
	JMP I	(EXEUIT

MKCCNT,	-4
MCICNT,	-12
FLDCNT,	-7
TDFLAG,	1		/0 MEANS TD8E IS DEATH AT RT
FLGRTS,	-1		/0 MEANS INCL BRTS IN CI

BOSFIX,	TAD I 	(BIPCCL
	RAL
	SMA CLA
	JMP I	MAKECI	/BATCH NOT RUNNING
	TAD I	(7777
	AND	(70
	TAD	CDFZRO
	DCA	BOSCDF	/CDF TO BATCH FIELD
BOSLUP,	CDF 10
	TAD I	BOSPT1	/GET BATCH WRDS
BOSCDF,	CDF 10
	DCA I	BOSPT2	/BACK INTO POSITION
CDFZRO,	CDF
	ISZ	BOSPT1
	ISZ	BOSPT2
	JMP	BOSLUP
	JMP I	MAKECI

BOSPT2,	7774
MYCORE,	0
JCIP,	CIPAT

	PAGE
VERNUM,	0
	TAD	(VTEXT
	DCA	TEMP
MOREV,	TAD I	TEMP
	SNA
	JMP	VOUT
	CLL RTR
	RTR
	RTR
	JMS I 	(TTY
	TAD I TEMP
	JMS I 	(TTY
	ISZ	TEMP
	JMP	MOREV
VOUT,	TAD	(215
	JMS I	(TTX
	TAD	(212
	JMS I	(TTX
	JMP I	VERNUM

VTEXT,	TEXT	/BLOAD  V/
	*.-1
VERLOC,	100^VERSON+6001
	0

	PAGE
	*7000
	BSTART=200	/START ADDR FOR BRTS
CISTRT,	SKP		/RUNNED
	JMP CHAIN	/CHAINED
	TAD (7603
	DCA X10
	TAD (NAMLST-1
	DCA X11
	CDF	10
	DCA I	X10	/ZERO EDITOR
	DCA I	X10	/COMPILER
	DCA I	X10	/AND LOADER BLOCK #S
	CDF
	CIF 10
	JMS I (7700
	10		/USRIN
FINDSV,	TAD I	X11	/LOOKUP SOME SAVE FILES
	SNA
	JMP	LUBUF	/GO LOOK FOR BASIC.UF
	DCA	XXXXSV	/SAVE POINTER TO NAME
	CLA IAC		/THEY'RE ON SYS
	CIF	10
	JMS I	(200
	2
XXXXSV,	0
	0
	JMS I	(ERRORX	/ERROR
	TAD	XXXXSV	/GET STARTING BLOCK
	IAC		/PLUS 1
	CDF	10
	DCA I	X10	/INTO INFO AREA
	CDF
	JMP	FINDSV	/LOOP
LUBUF,	CLA IAC
	CIF	10
	JMS I	(200	/LOOKUP BASIC.UF
	2
	BUFN		/(USER DEFINED FUNCTIONS)
	0
	JMP	.+3	/OK IF NOT THERE
	TAD	.-3	/GET STARTING BLOCK +1
	IAC
	CDF	10
	DCA I	X10	/INTO INFO BLOCK
	CDF 0
	CIF 10
	JMS I	(200
	11		/USR OUT
CHAIN,	CDF 10
	TAD I (7607	/GET BRTS STARTING BLK
	CDF
	DCA I	(BRTSST	/INTO RTS READER
	JMP I	(BINIT

NAMLST,	BRTSN
	BAFN
	BSFN
	BFFN
	0
BRTSN,	FILENAME BRTS.SV
BAFN,	FILENAME BASIC.AF
BSFN,	FILENAME BASIC.SF
BFFN,	FILENAME BASIC.FF
BUFN,	FILENAME BASIC.UF
CORE,	0
	TAD I	(BIPCCL
	AND COR70
	CLL RAR
	RTR
	SZA		/IS THERE A SYSTEM VALUE?
	JMP I CORE	/YES: USE IT
COR0,	CDF
	TAD	CORSIZ
	RTL
	RAL
	AND	COR70
	TAD	COREX
	DCA	.+1
COR1,	CDF
	TAD I	CORLOC
COR2,	NOP
	DCA	COR1
	TAD	COR2
	DCA I	CORLOC
COR70,	70
	TAD I	CORLOC
CORX,	7400
	TAD	CORX
	TAD	CORV
	SZA CLA
	JMP	COREX
	TAD	COR1
	DCA I	CORLOC
	ISZ	CORSIZ
	JMP	COR0
COREX,	CDF
	CLA CMA		/HI FIELD IS #FIELDS-1
	TAD	CORSIZ
	JMP I CORE
CORLOC,	CORX
CORV,	1400
CORSIZ,	1

	PAGE
GETRTS,	0		/READ BRTS INTO 0-6777
	TAD BRTS
	DCA BRTSBB
	JMS I (7607
	BRTSIZ
	0
BRTSBB,	0
NOCORE,	-1		/CAN'T GET THIS ERROR
	JMP I GETRTS
BINIT,	ISZ RTSFLG	/NEED BRTS?
	JMP BRTSIN	/GOT IT: START IT
	JMS I	(7607
	BRTSIZ
	0
BRTSST,	0
SR2,	20		/CAN'T GET THIS ERROR
BRTSIN,	AC7775		/TEST IF GENUINE 2 PAGE SYSTEM HANDLER
	TAD I	(7612
	SZA CLA		/SKP IF YES
	JMP	PSADJ	/ELSE SKIP CDF ADJUSTMENT
	TAD FLAGTD
	SNA CLA		/IMAGE OK ON TD8E?
	JMS ERRORX	/NO: DONT RUN IT
	TAD	KEYLOC	/GET NEW FIELD BITS
	AND	(70
	DCA	CDFTOP
PTCHLP,	TAD I	PTCHPT	/RANGE CHECK A WORD
	TAD	(-6300
	CLL
	TAD	(70
	SNL CLA		/SKP IF CDF N0
	JMP	NOPTCH
	TAD I	PTCHPT	/ISOLATE CDF INSTR
	AND	(7707
	TAD	CDFTOP
	DCA I	PTCHPT	/STORE IT BACK
NOPTCH,	ISZ	PTCHPT
	JMP	PTCHLP
	TAD KEYLOC
	DCA CDFTOP
SWPLOOP,CDF 20
	TAD I TDCTR
	DCA GETRTS
CDFTOP,	CDF	70
	TAD I TDCTR
	DCA ERRORX
	TAD GETRTS
	DCA I TDCTR
	CDF 20
	TAD ERRORX
	DCA I TDCTR
	ISZ TDCTR
	JMP SWPLOOP
	CDF
CCHEK,	ISZ EKOUNT
	JMS I	(CORE	/HOW MUCH CORE DO WE HAVE?
	TAD NOCORE	/HOW MUCH DO WE NEED?
	SPA CLA
	JMS ERRORX	/INSUFFICIENT CORE
	TAD I SR1	/RESTORE KEY LOCATIONS
	DCA I SR2
	ISZ SR1
	ISZ SR2
	ISZ SR3
	JMP .-5
	TAD (JMP I FSTOP1	/PATCH CTRL/C LOCS
	DCA I (7600
	TAD (JMP I FSTOP1
	DCA I (7605
	TAD	SWPINF	/TELL BRTS OS/8 PG 17600 OUT NOW
	RAR
	STL RAL
	DCA	SWPINF
	JMP I	(BSTART	/START BRTS
PTCHPT,	7635

ERRORX,	0
	CIF 10
	JMS I (7700
	7
EKOUNT,	1
	JMP I	(7605

EXEUIT,	TAD RTSFLG
	SNA CLA		/NEED BRTS?
	JMS GETRTS	/YES: READ IT
	TAD (4207	/RESTORE ^C HOOKS
	DCA I (7600
	TAD (6213
	DCA I (7605
	JMP I (7600	/BACK TO OS8
KEYLOC,	ZBLOCK 12
SR1,	KEYLOC
SR3,	-12
RTSFLG,	-1		/0 MEANS BRTS IS IN CORE
FLAGTD,	1		/1 IF TD8E IS OK AT RUNTIME
PSADJ,	TAD (4001
	AND KEYLOC+11
	TAD (2000
	DCA KEYLOC+11
	JMP CCHEK
TDCTR,	7600

	PAGE
	$$$$$


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/BOOT.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847

/BOOT.PA		17
/OS/8 V3D WITH RL01,RX02 AND VXA0 DEVICES
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
	/SR

/FIXES MADE FOR MAINTENANCE RELEASE:

/1.	ADDED RX01 (FLOPPY BOOTSTRAP)
/2.	LEFT PATCH SPACE IN NAME TABLE

/	26-DEC-77

/1.	ADDED RL BOOTSTRAP (S.R.)


	*1
	HLT
	JMP I (7600
	*100

INNER,	0
OUTR,	-20
CODE,	0
LENGTH,	0
	*200

START,	CLA		/ALLOW BEING CHAINED TO
	TAD I (7600
	SPA CLA
	JMP OS8IN
	ISZ INNER
	JMP .-1
	ISZ OUTR
	JMP .-3
	JMS I (TESTRK
COSIN,	TAD I (7776
COMN,	CIA
	DCA CODE
	TAD (TABLE
	DCA PTR
LOOP,	TAD I PTR
	SNA
	JMP I (OS8
	TAD CODE
	SZA CLA
	JMP NXT
	IOF
	ISZ PTR
	TAD I PTR
	DCA OLDLOC
	ISZ PTR
	TAD I PTR
	DCA NEWLOC
	ISZ PTR
	TAD I PTR
	CIA
	DCA LENGTH
XXLUP,	TAD I OLDLOC
	DCA I NEWLOC
	ISZ OLDLOC
	ISZ NEWLOC
	ISZ LENGTH
	JMP XXLUP
	ISZ PTR
	TAD I PTR
	DCA TEMP
	TAD HLTSWT
	SNA CLA
	HLT
	CLL
	JMP I TEMP
HLTSWT,	1

NXT,	TAD PTR
	TAD (5
	DCA PTR
	JMP LOOP

OLDLOC,	0
NEWLOC,	0
PTR,	0
SCAN,	0
OS8IN,	TAD I (7600
	TAD (-4207
	SZA CLA
	JMP I (RETRY
	TAD I (1000
	TAD (777
	SNA CLA
	TAD (600
	TAD (1000-1
	DCA SCAN
SKAN,	ISZ SCAN
	TAD I SCAN
	SNA
	JMP I (RETRY
	AND (177
	TAD (-"/!7600
	SZA CLA
	JMP SKAN
	ISZ SCAN
	TAD I SCAN
	AND (77
	CLL RTL
	RTL
	RTL
	DCA TEMP
	ISZ SCAN
	TAD I SCAN
	AND (77
	TAD TEMP
	DCA TEMP
	ISZ SCAN
	TAD I SCAN
	AND (177
	TAD (-".!7600
	DCA HLTSWT
	TAD TEMP
	JMP COMN

TEMP,	0
	PAGE
TABLE,	2403	/TC
	DECTAP
	7554
	25
	7554

	2213	/RK
RKADR,	RK8
	21
	11
	21

	2404	/TD
	TD8E
	7277
	34
	7277

	1424	/LT
	LINCTP
	4400
	7
	4400

	2206	/RF
	RF08
	7746
	7
	7746

	2024	/PT
	BINLDR
	7626
	152
	7700

	3205	/ZE
	ZERO
	4
	6
	4

	2431	/TY
	TYPSET
	7730
	42
	7730

	0414	/DL
	DIAL
	4012
	6
	4012

	0301	/CA
	CAS
	4000
	40
	4000

	0415	/DM
	DSKMON
	171
	16
	174

	2605	/VE
	VERS
	VERS
	1
	VERS

	0424	/DT
	TAPE
	TAPE
	1
	TAPE

	0413	/DK
	DISK
	DISK
	1
	DISK

	2205	/RE
	RK8E
	21
	11
	21

	2523	/US
	1
	1
	1
	RETRY

	2230	/RX
	RX01
	RX8E
	42
	RXSTRT

	2214	/RL
	RL01
	1
	35
	1

	2630	/VX
	VXA0
	0
	7
	0
	ZBLOCK 3^5	/PATCH SPACE

	0

/FORMAT:

/SIXBIT OF 2-CHARACTER NAME
/ADDRESS OF BOOTSTRAP CODE IN BOOT
/ADDRESS WHERE BOOTSTRAP CODE IS TO BE MOVED TO
/LENGTH OF BOOTSTRAP IN WORDS
/STARTING ADDRESS OF BOOTSTRAP
DECTAP,	7600
	6774
	1374
	6766
	6771
	5360
	7240
	1354
	3773
	1354
	3772
	1375
	6766
	5376
	7754
	7755
	0600
	0220
	6771
	5376
RK8,	6732
	6751
	6745
	5023
	6742
	6753
	6755
	6733
	5031

RK8E,	7000
	7000
	7000
	7000
	7201
	6742
	6742
	6743
	5031
TD8E,	6007
	1312
	4312
	4312
	6773
	5303
	6777
	3726
	2326
	5303
	5732
	2000
	1300
	6774
	6771
	5315
	6776
	0331
	1327
	7640
	5315
	2321
	5712
	7354
	7756
	7747
	0077
	7400
LINCTP,	6141
	1020
	0020
	0004
	0700
	0000
	6020
RF08,	6643
	6615
	7600
	6603
	6622
	5352
	5752
/	1000 IS OS/8 LINE BUUFFER
/	1600 IS PS/8 LINE BUFFERE

	*2000

BINLDR,	0000
	3212
	4260
	1300
	7750
	5237
	2212
	7040
	5227
	1212
	7640
	5230
	1214
	0274
	1341
	7510
	2226
	7750
	5626
	1214
	0256
	1257
	3213
	5230
	0070
	6201
	0000
	0000
	6031
	5262
	6036
	3214
	1214
	5660
	6011
	5270
	6016
	5265
	0300
	4343
	7041
	1215
	7402
	6032
	6014
	6214
	1257
	3213
	7604
	7700
	1353
	1352
	3261
	4226
	5313
	3215
	1213
	3336
	1214
	3376
	4260
	3355
	4226
	5275
	4343
	7420
	5336
	3216
	1376
	1355
	1215
	5315
	0000
	3616
	2216
	7600
	5332
	0000
	1376
	7106
	7006
	7006
	1355
	5743
	5262
	0006
	0000
	0000
	6014
	6011
	5357
	6016
	7106
	7006
	7510
	5374
	7006
	6011
	5367
	6016
	7420
	3776
	3376
	5357
	0000
	5301
ZERO,	1005
	3410
	5004
	5404
	0011
	2010
DIAL,	6141
	1020
	0020
	0004
	0701
	7300
/	7300
/	6002
/	6042
/	6022
/	6012
/	6032
/	6601
/	6764
/	1221
/	3010
/	1622
/	2222
/	7450
/	5620
/	3410
/	5212
/	7730
/	7727
/	0223
TYPSET,	6774
	1347
	4341
	7240
	1353
	3355
	1352
	4341
	5753
	7777
	6766
	3354
	6771
	5344
	5741
	4600
	7777
	7777
	4220
	7400
	7777
	7777
	7777
	6014
	6011
	5360
	7106
	6012
	7420
	5357
	5756
	4356
	3373
	4356
VXA0,	7200
1206
	6200
	6207
	5605
	0000
	7000
PTCLEV,	"A
L3,	"5
LV,	"V
VERS,	TAD LV
	JMS I (PUT
	TAD L3
	JMS I (PUT
	TAD PTCLEV
	JMS I (PUT
	JMP I PRETRY
PRETRY,	RETRY
DSKMON,	7577
	7750
	7751
	1171
	3572
	1172
	3573
	6643
	6615
	6603
	6602
	5203
	5606
	7600
CAS,	1237
	1206
	6704
	6706
	6703
	5204
	7264
	6702
	7610
	3211
	3636
	1205
	6704
	6706
	6701
	5216
	7002
	7430
	1636
	7022
	3636
	7420
	2236
	2235
	5215
	7346
	7002
	3235
	5201
	7737
	3557
	7730
	LCD=6751
	SDN=6755
	SER=6754
	STR=6753
	XDR=6752

RX01,	RELOC 20
RX8E,
/  DEVICE IOT SYMBOLIC EQUATES
/
LCD=6751		/LOAD COMMAND
XDR=6752		/TRANSFER DATA
STR=6753		/SKIP IF READY TO TRANSFER
SER=6754		/SKIP ON ERROR
SDN=6755		/SKIP ON DONE
/
/
/
/
READ,	TAD	UNIT	/TRY NEXT COMBINATION OF DENSITY AND UNIT
	TAD	CON360	/ADDING IN 360
	AND	CON420	/KEEPING ONLY 420 BITS
	DCA	UNIT	/CYCLES 400,420,0,20,400,,,,,,,,
	CLL CLA CML IAC RTL /COMMAND TO READ DISK - MUST BE ON OMNIBUS!
	TAD	UNIT	/UNIT AND DENSITY
	LCD		/COMMAND TO CONTROLLER
	CLL CLA IAC	/TO SET SECTOR AND TRACK TO 1
	JMS	LOAD	/SECTOR TO CONTROLLER, LEAVES AC ALONE
	JMS	LOAD	/AND TRACK
LITRAL,	7004		/LEAVING A 2 IN AC; SERVES AS LITERAL
/
/  FOLLOWING IS PART OF WAIT LOOP, SAME SECONDARY BOOTS, OLD PRIMARY BOOT
/
RXSTRT,
XSTRT,	SDN		/HAS DONE COME UP; CODE STARTS HERE!
	JMP	LOAD+1	/NO, GO CHECK FOR READY TO TRANSFER
/
/  NOW, DONE OR ERROR
/
	SER		/SKIP ON AN ERROR, TRY ANOTHER DENSITY ETC.
	SNA		/NASTY, AC=2 FOR ABOUT TO DO SILO, 0 ON START-UP
	JMP	READ	/START-UP, GO SET UP UNIT, THEN READ TO SILO
	TAD	UNIT	/AC ALREADY 2, PUT IN UNIT, DENSITY
	LCD		/TO EMPTY THE SILO
	TAD	UNIT	/SET UP LOC 60 FOR OLD SECONDARY BOOT
	AND	CON360	/KEEPING UNLY DENSITY BIT
	TAD	LITRAL	/ADDING IN 7004, BECAUSE THAT'S WHAT SYS WANTS
	DCA	RX1SAV	/OLD SECONDARY BOOT MOVES IT TO HANDLER
CON360,	360		/LITERAL; EXECUTES IN LINE AS A NO-OP
/			/FALLS THRU TO NEXT PAGE OF LISTING
/
/
/  FOLLOWING CODE SAME AS OLD PRIMARY BOOT
/
	JMS	LOAD	/GRAB NEXT ITEM FROM SILO
	DCA	2	/TRADITION; SECONDARY BOOT STARTS LOADING AT 2 !
	ISZ	50	/INCREMENT LOAD ADDRESS
	JMP	47	/GO BACK FOR ANOTHER
/
/  SECONDARY BOOT LOADS OVER PRIMARY BOOT UNIT LOCATION 47 IS LOADED,
/  THEN CONTROL PASSES TO SECONDARY BOOT
/
LOAD,	0		/SUBROUTINE TO GIVE AND TAKE DATA FROM CONTROLLER
	STR		/IS HE READY TO TALK TO US?
	JMP XSTRT	/NO, IS HE PERHAPS DONE WITH SILO, OR IN ERROR?
	XDR		/YES, DATA IN OR OUT;IF DATA TO CONTROLLER, AC UNCHANGED
	JMP I	LOAD	/NO MAGIC, JUST EXIT FROM SUBROUTINE
/
/  60 GOES TO OLD SECONDARY BOOT
/  61 HAS DENSITY AND UNIT THAT BOOTED SUCCESSFULLY
/
/
CON420,			/USE IT TO HOLD 420 LITERAL TO START OUT
RX1SAV,	420		/UNIT^20+7004 TO GO TO SYS HANDLER
UNIT,	20		/<DENSITY^400>+<UNIT^20> THAT BOOTED OK
/

	RELOC
	PAGE
L2213,	2213
	DIML=6615
DISK,	CLA IAC
	DIML
	SNA CLA
	JMP GOTRF
	TAD (70
	6732
	SNA CLA
	JMP GOTRK8
	CLA IAC
	6744
	SZA CLA
	JMP I PRETR
	STA		/RE
GOTRF,	TAD L2206	/RF
	JMP I PCOMN
L2206,	2206
GOTRK8,	TAD L2213	/RK
	JMP I PCOMN
PRETR,	RETRY
TAPE,	6141		/LINC
	17		/COMPL AC
	2		/PDP
	IAC
	SNA CLA
	JMP GOTLTA
	TAD (70
	6774
	CLA
	6772
	NOP
	TAD M70
	SNA CLA
	JMP GOTTC
	STL CLA RAR
	6774
	CLA
	6776
	SMA CLA
	JMP I PRETR
GOTTD,	CLA IAC
GOTTC,	TAD L2403	/TC
	JMP I PCOMN
GOTLTA,	TAD L1424	/LT
	JMP I PCOMN
L1424,	1424
L2403,	2403
PCOMN,	COMN
M70,	-70
/	0000
CRLF,	0
	TAD L215
	JMS PUT
	TAD L212
	JMS PUT
	JMP I CRLF

L215,	215
L212,	212

PUT,	0
	TLS
	TSF
	JMP .-1
	CLA
	JMP I PUT

GET,	0
	KSF
	JMP .-1
	KRB
	AND (177
	TLS
	TSF
	JMP .-1
	TAD (-003
	SNA
	JMP I (7605
	TAD (003-177
	SNA
	JMP I (RETRY
	TAD (177-015
	SNA
	ISZ GET
	TAD (015
	AND (77
	JMP I GET

TESTRK,	0
	TAD (70
	6732
	SNA CLA
	JMP I TESTRK
RK05,	TAD (RK8E
	DCA I (RKADR
	JMP I TESTRK
	PAGE
OS8,	TAD ("N
	JMS I (PUT
	TAD ("O
	JMS I (PUT
	CLA IAC
	DCA I (HLTSWT
RETRY,	JMS I (CRLF
	TAD ("/
	JMS I (PUT
	JMS I (GET
	SKP
	JMP RETRY
	CLL RTL
	RTL
	RTL
	DCA I (TEMP
	JMS I (GET
	SKP
	JMP RETRY
	TAD I (TEMP
	DCA I (TEMP
	JMS I (GET
	JMP .-1
	CLA
	JMS I (CRLF
	TAD I (TEMP
	JMP I (COMN
RL01,	6600
	7201
	4027
	1004
	4027
	6615
	7002
	7012
	6615
	0025
	7004
	6603
	7325
	4027
	7332
	6605
	1026
	6607
	7327
	4027
	0377
	7600
	0000
	6604
	6601
	5031
	6617
	5427
	5001
	PAGE
	FIELD 0
	*200
	$


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/BPAT.PA. 
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

/1	RL01 PATCH FOR BRTS

	*1345
HFIX,	0
	CLL STA RTL	/AC7775
	TAD I	H7612
	SZA CLA		/SKP IF 2 PAGE HANDLER
	JMP I	HFIX	/ELSE EXIT NOW
FIXLUP,	TAD I	FIXPTR	/GET A WORD FROM HANDLER
	TAD	M6300
	CLL		/RANGE CHECK FOR CIF/CDF N0
	TAD	H70
	SNL CLA		/SKP IF CDF OR CIF
	JMP	NOFIX	/ELSE DON'T FIX IT
	TAD I	FIXPTR	/GET INSTRUCTION
	AND	H7707	/ZERO FIELD BITS
	TAD	H20	/PUT BACK FIELD 2
	DCA I	FIXPTR	/STORE INSTRUCTION BACK
NOFIX,	ISZ	FIXPTR
	JMP	FIXLUP
	JMP I	HFIX	/--RETURN--
FIXPTR,	7635
H20,	20
H70,	70
H7612,	7612
H7707,	7707
M6300,	-6300

	FIELD	1
	*4526
PSWP2P,	0
	*4543
	JMS I	PHFIX
	JMP I	PSWP2P
PHFIX,	HFIX

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/BUILD.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751

/33 OS/8 V3D BUILD
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1971,1972,1973,1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/ABSTRACT--
/BUILD IS THE SYSTEM CONFIGURATOR FOR THE OS/8 PROGRAMMING
/SYSTEM. WITH BUILD, THE DEVICES WITHIN A PARTICULAR
/SYSTEM CAN BE RAPIDLY AND EASILY CHANGED. BUILD ALSO
/PROVIDES THE FACILITY FOR CREATING AN INITIAL OS/8 SYSTEM
/FROM BINARY PAPER TAPES OR CASSETTES.

/V3 CHANGES

/0.	MADE BUILD SUPPORTABLE
/1.	ADDED VE COMMAND (CURRENT VERSION # IS 3X WHERE X IS PATCH LEVEL)
/2.	FIXED PROBLEM WITH Z'S AND 9'S IN FILENAMES
/3.	CHANGED LENGTH OF DF32
/4.	FIXED PROBLEM WITH RK8 BOOTSTRAP RECORD.
/5.	ON LOAD, NULL EXTENSION FIRST SEARCHES FOR .BN
/6.	CR TO $ DOESN'T GIVE ERROR
/7.	FIXED BUG WITH BUILDING ROM SYS
/8.	RUBOUTS TO BOL GIVE $
/9.	^U RETYPES $
/10.	ASSUME DSK: IF NO DEV GIVEN WITH LOAD
/11.	NO DOT IS PRINTED IF NO EXTENSION
/12.	^O STUFF NEW
/13.	ALLOW PARITY ^C
/14.	ADDED EXAMINE COMMAND
/15.	FIXED BUG RE ACCESSING USR TABLE VIA POINTER
/16.	CLEANED UP MOVE ROUTINE
/17.	CLEANED UP NUMBER TOO BIG CHECKER
/18.	OVERFLOW ERROR MESSAGE CHANGED TO 'BAD ORIGIN'
/19.	DON'T ALLOW NAMES OVER 6 CHARS TO SPILL INTO EXTENSION;
/	DON'T ALLOW MULTIPLE EXTENSIONS
/20.	INCREASED NUMBER OF ALLOWABLE ENTRY PTS/HANDLER TO 16 (DEC)
/21.	CLEANED UP SYMBOL PRINT ROUTINE
/22.	GOT NAMES IN TABLE TO LINE UP.
/23.	INSERT GRPNAME <CR> INSERTS FIRST HANDLER
/24.	INSERT GRP,DEV1,DEV2,DEV3,...
/25.	INSERT GRP,DEV1-5,...
/26.	SAME FOR DELETE AND REPLACE
/27.	COUNT DEVICES AND SLOTS ONLY ON BOOT
/28.	FIXED BUG RE SYS RF08=4023
/29.	GENERAL SUPPORT OF 2-PAGE SYS HANDLERS
/30.	ADDED QL COMMAND
/31.	SETS SA=00200, JSW=0
/32.	UNLOAD UNLOADS AND DELETES
/33.	ADDED DSK COMMAND
/34.	BUILD COMMAND
/35.	PRINT TELLS YOU ABOUT DSK
/36.	TOOK OUT LOC DEPENDENT CHECK FOR SYSTEM HANDLERS
/37.	INSERT ALLOWS SETTING # OF PLATTERS
/38.	HANDLER HEADER LOADS DIRECTLY INTO DESCRIPTOR TABLE
/39.	USES EXTRA CORE IF AVAILABLE (ALSO CHECKS SOFTWARE CORE SIZE)
/40.	STOPS ECHOING ON INPUT LINE OVERFLOW
/41.	*'S SYSTEM DEVICE
/42.	REMEMBERS SYS ACROSS A BOOT
/43.	'Y' INSTEAD OF 'YE'
/44.	BO CHECKS DCB IN CORE TO SEE IF NEED REWRITE MONITOR
/45.	ALLOW UNLOADING ENTRY POINT NAMES
/46.	CTL COMMAND
/47.	EACH COMMAND HAS ITS OWN MAXIMUM INPUT LINE SIZE
/48.	ADDED CORE COMMAND
/49.	FIXED ^U TO WRITE ZERO DIRECT MSG BUG
/50.	HIT CONTINUE AFTER 'SYS ERR' TO RETRY
/51.	PRESERVED DATE ACROSS BOOT
/52.	MULTIPLE LOADS AND UNLOADS
/53.	LOAD FROM SCRATCH USES INTERNAL ACTIVE HANDLERS
/54.	CASSETTE SUPPORT
/55.	SETS CORE CONTROL BLOCK

/CHANGES SINCE FIELD RELEASE

/A	'NO ROOM' DOESN'T PRINT 'BAD LOAD'
/B	NO. OF ENTRY POINTS NOW CORRECTLY CHECKED FOR
/C	FIXED BUG RE BUILDING TD8E FROM TD8E
/D	BOOT CMD DISABLES BUILD CMD
/E	JSW SET TO 1 BEFORE CHAINING TO ABSLDR
/F	P CMD BUG FIXED
/G	ALTER BUG FIXED
/H	LENGTH OF INPUT LINE SYMBOLIC
/I	SOFCOR STUFF OPTIMIZED
/J	QL DOESN'T PRINT SPACE BETWEEN SYS'S GRP:NAME
/K	FIXED BUG IN 32K
/L	PAPER TAPE PUTS HLT IN 7600

/THINGS TO DO:

/?	DIES IF DATA OCCURS BEFORE *0
/?	BOOT.ZE, .NZ  CMD?
/?	GET 2-PAGE BIT OF CURRENT SYSTEM

/CHANGES FOR MAINTENANCE RELEASE V3C:

/	7-AUG-75

/1.	CHANGED VERSION NUMBER TO V5
/2.	INCORPORATED PATCH SEQ #1 (DSN APRIL 1975)
/	ZERO LOCATION SOFSET WHILE BUILDING
/3.	INCORPORATED PATCH SEQ #2 (DSN NOV. 1974)
/	DISMISS USR AFTER ?NAME ERROR
/4.	INCORPORATED PATCH SEQ #3 (DSN  MARCH 1975)
/	DECREASE SYSTEM SIZE BY 5 (FOR ABSLDR) WHEN BUILDING FROM PAPER TAPE
/5.	INCORPORATED PATCH SEQ #4 (DSN APRIL 1975)
/	ADDED 'SIZE' COMMAND TO BUILD
/6.	FIXED BUG WHICH CAUSES SYSXY.RS NOT FOUND TO BE PRINTED
/	ON BOOTXY.RS COMMAND

/CHANGES FOR V3D:

/	1-MAY-77

/1.	FIXED PROBLEM WITH CASSETTE BUILD (JSW WAS SET WRONG)
/2.	ALLOWED SAVING OF HIGH-ORDER DATE BITS
/BUILD PAGE 0
	*1
	HLT		/SAFETY HALT AND PATCH SPACE
SAV1,	0
SAV2,	0		/SAVES GROUP NAME
			/POINTER TO BATCH ROUTINE (GROSS BUT NEEDED THE ROOM)
BATT,	BATTST		/AGAIN GROSS BUT WHAT CAN I SAY?
	*10		/AUTO INDEX REGISTERS
XR1,	0		/GENERAL PURPOSE REGISTERS
XR2,	0
XR3,	0
XR4,	0		/USED TO BUILD IMAGE TABLES
XR5,	0
LXR,	0
GNMXR,	0
L600,	600

	*20
COUNT,	0		/GENERAL COUNTER LOCATION
CHAR,	0		/CHARACTER BUFFER
TEMP,	0		/TEMPORARIES
TMP1,	0


	BUFFER=5400
	BINARY=6000
	DEVBUF=0400	/FIRST HANDLER AT 10400
			/FOR REASONS TOO LONG TO GO INTO HERE,
			/BUT WHICH HAVE TO DO WITH CURIOUS
			/PROPERTIES OF THE NUMBER 0,
			/HANDLERS CAN'T START AT 0.
			/THEY COULD HAVE STARTED AT 200.
	SOFSET=7747	/SYSTEM OFFSET. (CURRENTLY =0)
	PG7600=BUFFER	/RECORD 0 (IMAGES OF BOTH 7600'S)

	LDRCTL=4113	/CHECK OS/8 ASSEMBLY
NAME1,	0		/NAME1-4 HOLDS FILE AND DEVICE NAMES
NAME2,	0
NAME3,	0
NAME4,	0
TABLMT,	DSCTAB		/HIGH CORE END OF DESCRIPTORS
			/FIRST FREE LOCATION
SIZE,	0
HNDPTR,	DEVBUF		/POINTS TO FIRST FREE LOCATION IN HANDLER TABLE

	BLDSAV=76	/**** WILL DESTROY PREVIOUS FILES
			/START OF 40 BLOCK TO SAVE BUILD IN
	HDRSIZ=10	/NUMBER OF ITEMS IN A DESCRIPTOR
DSCPTR,	DSCTAB		/ALWAYS POINTS TO BEGIN OF CURRENT DESCRIPTOR
SLOT,	0
DSKG1,	0		/NAME OF 'DSK'
DSKG2,	0
DSKP1,	0
DSKP2,	0
NEWPAG,	0
OLDPAG,	0
NEWCOR,	0		/NEW CORE MAX
SAVDAT,	0		/REMEMBERS DATE ACROSS A BOOT
	DATEWD=7666
FLAG2,	1		/0 IF PREVIOUS SYSTEM HAD A 2-PAGE HANDLER
/SAMSYS,	1		/0 IF DIDN'T SPECIFY NEW SYS
	BLOK66=0
SYSDCB,	0
	SA=7744
	JSW=7746
/BOOTDV,	0		/HANDLER ADDRESS OF DEVICE WE'RE BOOTSTRAPPING TO
SAVHID,	0		/HIGH-ORDER DATE (BITS 3-4)
/BEGLIN:	72 CHAR LINE BUFFER

/NEW BUILD CORE ALLOCATION:

/0000-5177	BUILD (ABSLD MUST BE ABOVE 4177)
/5400-5777	DEVICE HANDLER FOR LOAD
/5200-5377	PAPER TAPE/INIT/LINE BUFFER
/6000-6377	INPUT BUFFER FOR LOAD (TEMP LOC OF USR)
/6400-7577	DESCRIPTOR TABLE (DSCTAB)

/BINARY MUST FOLLOW BUFFER
/FIELD 1: HANDLERS (0400-7577)
/10000-10377	BLOK66	BUFFER
	*200

	SKP CLA	/ENTRY FROM 'R BUILD'
	HLT		/CHAIN ENTRY ADDRESS
	TAD I [7600	/SEE IF SYSTEM ALREADY EXISTS
	CIA
	TAD [4207
	SZA CLA	/IF NOT, BUILD SYSTEM FROM PAPER TAPE
	CLA IAC	/NOTE FACT THAT OS/8 AINT AROUND
	DCA I [RETSW
	JMS I (CORE
	DCA I (AMTCOR	/FIGURE OUT HOW MUCH CORE WE HAVE
	JMS I (GOOD	/DO SOME INITIALIZATION; IT'LL DO YA GOOD
	TAD (BATLS-1	/SET POINTER FOR BATCH OVERLAY
	JMS I (BATTST	/GO CHECK FOR CALL FROM BATCH
CONFIG,	CDF 0
	DCA I (ECHOFLG	/ALLOW TYPING
	JMS I [CRLF
DOLR,	TAD ["$	/OUTPUT A $ BECAUSE I'M JEWISH
	JMS I [TTYOUT
	DCA I [SWAPER	/USE CURRENT HANDLER, NO SWAP ON ^C.
	TAD [-LNLNGT
	JMS I [GTEXT	/READ TTY LINE
	JMP DOLR
	JMS I [GNAME	/INTERPRET THE COMMAND
	TAD NAME1
	SNA
	JMP CONFIG
	DCA CHAR	/ENABLE TEST TO WORK
	JMS I [TEST	/LOOK FOR THE COMMAND IN LIST
	-1417;LOAD	/LOAD DEVICE HANDLER BINARY
	-2205;REPLACE	/REPLACE IN SYSTEM
	-1601;NAME	/ALTER PERMANENT NAME
	-0114;ALTER	/CHANGE DEVICE HANDLER LOCATION
	-2022;PRINT	/SYSTEM STATUS
	-2331;SYSTEM	/SPECIFY SYSTEM DEVICE
	-0217;BOOT	/BOOTSTRAP THE NEW SYSTEM
	-2516;UNLOAD	/DELETE INACTIVE HANDLER
	-0405;DELETE	/DELETE ACTIVE HANDLER
	-1116;INSERT	/INSERT HANDLER IN SYSTEM
	-2605;VERS	/TYPE VERSION #
	-0530;EXAMINE	/EXAMINE LOCATION
	-2114;QLIST	/QUICK LIST
	-0423;DSK	/DSK
	-0317;KORE	/CORE
	-0403;DCBCM	/DCB
	-0324;CTLCM	/CTL
	-2311;SIZCM	/SIZE
	-0516;END	/END COMMAND FOR BATCH
BD,	-0225;BUILD	/BUILD
	0		/MUST TERMINATE LIST WITH 0
	JMP I [WHAT	/DIDN'T FIND COMMAND

/NEW HEADER BLOCK:

/	DEVICE GROUPNAME
/	DEVICE PERMANENT NAME
/	DCB	(R/W,TYPE,MAX # OF PLATTERS)
/	1/2 PAGE, SYSTEM BIT, CORES BIT, REL ENTRY PT
/	MUST BE 0
/	SIZE OF 1 PLATTER
CORSIZ,
GETCHA,	0
	TAD DSCPTR
	TAD I GETCHA
	ISZ GETCHA
	DCA GETEM
	TAD I GETEM
	JMP I GETCHA

/GOTCHA SUBROUTINE MOVED FOR ROOM

	PUT=JMS I [GOTCHA
	GET=JMS I [GETCHA


BATTST,	0		/SUBROUTINE TO SEE IF CALLED FROM BATCH
	DCA XR1	/POINTER TO OVERLAY CODE IN FIELD 2
	TAD I [7777	/GET THE BATCH SWITCH (JMP BATBK IF IN BATCH)
	RAL		/BIT 1
	SMA CLA	/IF NO BATCH MAY NOT HAVE FIELD 2
	JMP I BATTST	/NOT CALLED FROM BATCH
BATBK,	CIF 20		/NOW TO FIELD 2
	JMS I (BATSET	/GO DO SOME OVERLAYS
	JMP I BATTST	/RETURN TO CALLER
GETEM,			/POINTS INTO DSCTAB
RELCOR,	0
	CLA IAC
	DCA CORSIZ	/MAKE RE-USABLE
	TAD [7400
	DCA CORX	/MAKE ROUTINE REUSABLE ON 32K MACHINE
COR0,	CDF 0
	TAD CORSIZ
	RTL
	RAL
	AND COR70
	TAD COREX
	DCA .+1
COR1,	CDF /N
	TAD I CORLOC
COR2,	NOP
	DCA COR1
	TAD COR2
	DCA I CORLOC
COR70,	70
	TAD I CORLOC
CORX,	7400
	TAD CORX
	TAD CORV
	SZA CLA
	JMP COREX
	TAD COR1
	DCA I CORLOC
	ISZ CORSIZ
	JMP COR0
COREX,	CDF 0
	STA
	TAD CORSIZ
	JMP I RELCOR	/LEAVE WITH HIGHEST EXISTENT BANK

CORLOC,	CORX
CORV,	1400
	PAGE
/GET	GETS DESCRIPTOR ITEM FROM CURRENT DESCRIPTOR
/OP

/PUT	PUTS DESCRIPTOR ITEM IN AC BACK IN SPECIFIED ITEM
/OP	IN CURRENT DESCRIPTOR

/ITEMS:

/ACTIVE	BIT 0=1 MEANS ENTRY POINT HAS BEEN INSERTED (IS ACTIVE)
/PERM1	PERMANENT NAME (FIRST 2 CHARS)
/PERM2	2ND 2 CHARS
/TWOPAG	BIT 0=1 MEANS 2-PAGE HANDLER, BIT 4 IGNORED, BITS 5-11 RELATIVE ENTRY POINT
/PAGRES	BITS 7-11 GIVE PAGE OF START OF HANDLER WHEN ROTATED 6 RT
/GRPNM1	GROUP NAME (DEVICE NAME) FIRST 2 CHARS
/GRPNM2	2ND 2 CHARS
/DEVSIZ	GIVES SIZE OF 1 PLATTER
/PLATNUM # OF PLATTERS IN BITS 2-4
/DSKBIT	BIT 1 IS FLAG FOR 'DSK' (USED TEMPORARILY BY BUILD)
/MAXPLT	MAXIMUM NUMBER OF PLATTERS ALLOWED (IN BITS 9-11)
/DCB	D.C.B. BIT 0: FILESTRUCTURED, BITS 3-8 DEVICE TYPE
/	BITS 9-11 MAX NO. OF PLATTERS
/CORES	BIT 2 MEANS ENTRY PT IS CORESIDENT WITH SYS HANDLER
/SYSBIT	BIT 1 IS A 1 IF THE DEVICE HAS NAME 'SYS' AND IS A SYS DEVICE

/IF FIRST ENTRY OF A DESCRIPTOR IS GE 7600, THEN THIS
/ENTRY IS A BOOTSTRAP ENTRY.
/IT STARTS WITH THE NEGATIVE OF THE NUMBER OF WORDS IN THE
/BOOTSTRAP (FOR THE PRECEDING DEVICE), FOLLOWED BY THAT MANY WORDS
	GRPNM1=0
	GRPNM2=1
	PRMNM1=2
	PRMNM2=3
	DCB=4
	MAXPLT=4
	DVTYPE=4
	TWOPAG=5	/BIT 0
	SYSBIT=5	/BIT 1
	ACTIVE=6
	ENTPT=5
	PAGRES=6
	PLATNUM=6
	DEVSIZ=7
	DSKBIT=6	/BIT 1
	CORES=5		/BIT 2
/READ A LINE OF TEXT    RETURN 1 IS ^U RETURN
GTEXT,	0		/ROUTINE TO COLLECT TTY INPUT
	TAD (-BEGLIN	/AC IS NON-ZERO
	DCA ENDLIN
	DCA I (RUBFLG	/INITIALIZE RUBOUT TO \
	TAD (BEGLIN-1
RDTX,	DCA LXR		/BUFFER ADD. TO INDEX
RDTXT,	JMS I [TTYIN	/READ BLOODY TELETYPE
	TAD CHAR
	DCA NAME1	/SETUP FOR TEST AGAIN
	JMS I [TEST
	-377;RBOUT	/RUBOUT
LFMOD,	-212;LFEED	/LINE FEED..ECHO CURRENT COMMAND
	-215;CARRET	/LINE TERMINATOR
	-233;ALTMOD	/ALT MODE IN SEVERAL FLAVORS
	-375;ALTMOD
	-376;ALTMOD
	-200;RDTXT	/IGNORE BLANKS
	-217;RDTXT	/AS WELL AS ^O
	-203;CTRLC	/BACK TO CURRENT SYSTEM
	-225;CTRLU	/CTRLU
	0		/IF NOT ONE OF THESE, PUT IN BUFFER
	TAD LXR
	TAD ENDLIN
	SNA CLA
	JMP RDTXT	/LINE OVERFLOW, STOP ECHOING
	JMS I [PRNT	/PRINT THE CHARACTER
	TAD CHAR
	DCA I LXR	/AND PUT IN LINE BUFFER
	JMP RDTXT	/NO PROBLEMS YET
RBOUT,	TAD LXR		/IS THERE TEXT TO RUB OUT?
	TAD [1-BEGLIN
	SNA CLA
	JMP RBCR	/NO..SO DON'T DO ANYTHING
	TAD ["\		/YES..ECHO BACKSLASH?
	ISZ I (RUBFLG	/IF = -1, NO
	JMS I [TTYOUT
	CLA CMA		/IGNORE CONSECUTIVE RUBOUTS
	DCA I (RUBFLG
	TAD LXR
	DCA TMP1
	TAD I TMP1
	JMS I [TTYOUT	/ECHO LAST CHAR
XRBACK,	CLA CMA
	TAD LXR		/MOVE INDEX BACK ONE
	JMP RDTX
CARRET,	JMS I [CRLF	/GENERATE 215,212
CAR1,	DCA I LXR
	DCA I LXR	/GUARD AGAINS CMD <CR>
	TAD [BEGLIN-1
	DCA GNMXR	/SETUP FOR GNAME ROUTINE
	ISZ GTEXT	/TAKE NORMAL RETURN
	JMP I GTEXT

LFEED,	DCA I LXR	/A 0 TO MARK END
	TAD [BEGLIN-1
	DCA LXR
	JMS I [CRLF
	TAD ["$
	JMS I [TTYOUT
ECHO,	TAD I LXR
	SNA		/DONE ECHOING?
	JMP XRBACK	/YES..REPOSITION LXR
	JMS I [TTYOUT
	JMP ECHO

ALTMOD,	TAD ["$		/ALT MODE ECHOES AS $
	JMS I [TTYOUT
	JMP CAR1

CTRLU,	TAD ["^
	JMS I [TTYOUT	/GENERATE ^U
	TAD NAME1
	TAD [100
	JMS I [TTYOUT
RBCR,	JMS I [CRLF
	JMP I GTEXT	/TAKE ERROR RETURN
	GETCHR=JMS I [GETC
	BAKCHR=JMS I [BAKC

ENDLIN,
GETNUM,	0		/PICKS UP NUMBER FROM LINE BUFF
			/DELIM CHAR PUT IN 'CHAR'
			/PRINTS ERROR MESSAGE IF  GT 4095
			/IF NO NUMBER, TAKES RETURN 1
			/IF NUMBER, TAKES RET 2 WITH # IN 'SIZE'
	DCA SIZE
	DCA GOTSW	/HAVEN'T FOUND ANY DIGITS YET
	JMP NCHAR
ROT,	DCA TMP1
	ISZ GOTSW	/FOUND A DIGIT
	TAD SIZE
	AND [7000
	SZA CLA
	JMP I [BADARG	/NUMBER .GT. 4095
	TAD SIZE
	CLL RTL
	RAL		/BUILD UP THE DIGIT
	TAD TMP1
	DCA SIZE
NCHAR,	GETCHR
	SNA		/0 ENDS THE LINE
	JMP NUMOUT
	TAD [-240	/IGNORE SPACES
	SNA
	JMP NCHAR
	TAD (-30	/TEST LIMITS
	CLL
	TAD [10		/MUST BE BETWEEN 0 AND 7
	SZL
	JMP ROT
	TAD (260	/RESTORE CHAR
NUMOUT,	DCA CHAR	/SAVE AWAY THIS DELIMETER
	TAD GOTSW	/DID WE GET ANY DIGITS?
	SZA CLA		/?
	ISZ GETNUM	/YES
	JMP I GETNUM	/NO, RETURN
GETC,	0		/GET THE NEXT CHARACTER, ADVANCE SCAN PAST IT
	TAD I GNMXR
	JMP I GETC

GOTSW,			/1 MEANS GOT A DIGIT
BAKC,	0		/BACK UP SCAN TO THE CHARACTER JUST LOOKED AT
	STA
	TAD GNMXR
	DCA GNMXR
	JMP I BAKC
	PAGE
	INIT=JMS I [INI
	ADVDSC=JMS I [DSCADV
	ADVBOT=JMS I [BOTADV

/	JMS PRMNAM	/SEARCH TABLE FOR A PERMANENT NAME
			/GIVEN IN NAME1-NAME2
			/POINT TO DESCRIPTOR FOR THIS NAME
/	JMS ACTNAM	/SAME BUT PERMANENT NAME MUST BE ACTIVE
/	JMS BIGNAM	/SEARCHES FOR PERM & GRP NAME (GRP NAME IN SAV1,SAV2)
/	JMS GRPNAM	/SAME BUT SEARCH FOR GROUP NAME

CHKNAM,	0
	INIT
CHKLUP,	ADVDSC		/ADVANCE TO NEXT DESCRIPTOR
	ADVBOT		/ADVANCE OVER ANY BOOTSTRAP
	JMP NFOUND	/NO MORE- ERROR
	GET
NM1,	GRPNM1		/GET GROUP OR PERMANENT NAME
	CIA
	TAD NAME1
	SZA CLA		/DO FIRST WORDS MATCH?
	JMP CHKLUP	/NO, TRY AGAIN
	GET
NM2,	GRPNM2		/GET 2ND WORD
	CIA
	TAD NAME2
	SZA CLA		/2ND WORD MATCH?
	JMP CHKLUP	/NO
	TAD BIGFLG
	SNA CLA		/WANT BOTH GROUP AND PERM NAME?
	JMP NOBIG	/NO
	GET		/YES
	GRPNM1
	CIA
	TAD SAV1
	SZA CLA
	JMP CHKLUP
	GET
	GRPNM2
	CIA
	TAD SAV2
	SZA CLA
	JMP CHKLUP
NOBIG,	TAD ACTSW	/FOUND MATCH
	SNA CLA		/MUST HANDLER BE ACTIVE?
	JMP I CHKNAM	/NO, RETURN
	GET		/YES
	ACTIVE
	SMA CLA		/IS IT ACTIVE?
	JMP CHKLUP	/NO, TRY AGAIN
	JMP I CHKNAM	/YES, RETURN
GRPNAM,	0
	TAD (GRPNM1	/WANT TO SEARCH FOR GROUP NAME
	DCA NM1
	TAD (GRPNM2
	DCA NM2
	DCA ACTSW	/NEED NOT BE ACTIVE
	DCA BIGFLG
	JMS CHKNAM	/GO SEARCH
	JMP I GRPNAM

ACTSW,	0		/1 MEANS HANDLER MUST BE ACTIVE

PRMNAM,	0
	DCA ACTSW	/AC MAY BE NON ZERO (TO MEAN ACTIVE ONLY)
	TAD (PRMNM1	/WANT TO SEARCH FOR PERMANENT NAME
	DCA NM1
	TAD (PRMNM2
	DCA NM2
	DCA BIGFLG
	JMS CHKNAM	/GO SEARCH
	JMP I PRMNAM

BADLOD,	JMS I [CRLF
	JMS I [PRWD
	TEXT	/?BAD LOAD/
	DCA I TABLMT	/RESTORE SENTINEL 0
	JMP I [CONFIG

BIGNAM,	0
	DCA ACTSW
	TAD (PRMNM1
	DCA NM1
	TAD (PRMNM2
	DCA NM2
	CLA IAC
	DCA BIGFLG
	JMS CHKNAM
	JMP I BIGNAM

/SOMETIMES CHKNAM CAME FROM DSKASK INSTEAD OF GETSYS ****

BIGFLG,	0		/SET TO 1 TO CHECK GROUP & PERMANENT NAME
NFOUND,	JMS I [PRNAME
	JMS I [PRWD
	TEXT / NOT FOUND/
	JMP I [CONFIG

NOROOM,	JMS I [PRWD
	TEXT /?NO ROOM/
	DCA I TABLMT	/RESTORE SENTINEL 0
	JMP I [CONFIG

VERS,	JMS I [PRWD
	TEXT	/BUILD V6A/
	JMP I [CONFIG

/BUILD CORE CONTROL BLOCK
/	***** CAUTION IF BUILD GROWS FROM FIELD 2

BLDCCB,	-3		/3 SEGMENTS
	6203		/FIELD 0
	0200		/200 IS S.A.
	0000		/JSW
	0000
	1020		/20000-21777
	0000		/10000-17577
	3710
	0000		/00000-07577
	3700
/GOES INTO WORDS 200-377 OF BLOCK 37
	PAGE
/LOAD A 1- OR 2-PAGE HANDLER INTO BUFFER
/USE IT TO ABSLD

SETUP,	0
	TAD [NAME1
	DCA FILPTR	/POINT TO FILENAME AREA
	TAD (BUFFER+1	/LOAD 2 PAGE HANDLER INTO 'BUFFER'
	DCA DRIVER	/SET UP ASSIGN DEVICE HANDLER
	JMS I [GNAME	/GET DEVICE NAME
	TAD NAME1
	SNA CLA
	JMP I SETUP	/NO ARG
	ISZ SETUP
	TAD I (RETSW
	SZA CLA
	JMP I (BLDLOD	/WHEN LOADING STANDALONE, USE INTERNAL HANDLERS
	TAD CHAR
	TAD [-":
	SZA CLA
	JMP I (SETDSK	/USE 'DSK ' IF NO DEVICE GIVEN
	TAD NAME1
	DCA DVNM1
	TAD NAME2
	DCA DVNM1+1	/LOOKUP DEVICE NAME
GETU,	JMS I (GETUSR
	CIF 10
	JMS I [200	/FETCH HANDLER
	1
SUBLUP,
DVNM1,	0
LODTMP,
DVNUM,	0		/NAME GOES IN HERE
DRIVER,	0
	JMP I (KICKM	/NO DEVICE. RELEASE MONITOR
	TAD CHAR
	SZA CLA
	JMS I [GNAME	/PICK UP FILE NAME
	TAD DVNM1+1	/DEVICE NUMBER
	JMS I (DTYPE	/SEE IF FILE STRUCTURED
	TAD NAME1	/IF FILE STRUCTURED WITH NO NAME
	SNA CLA		/IT IS AN ERROR
	JMP I (NMER	/V3C
	TAD NAME4	/SAVE ORIGINAL EXTENSION
	DCA TEMP
	TAD NAME4
	SNA		/IF NULL
	TAD (0216	/TRY .BN FIRST
TRYAGN,	DCA NAME4
	TAD DVNUM	/GET DEVICE NUMBER
	CIF 10
	JMS I [200	/DO LOOKUP OF FILENAME
	2
FILPTR,	NAME1
	0
	JMP LDEXT	/DIDN'T FIND FILE. DO SOMETHING
	CIF 10
	JMS I [200	/KICK OUT MONITOR
	11
	TAD DRIVER
LOADIN,	DCA I [DVICE	/ENTRY POINT OF HANDLER
	JMS I (IOPEN	/IF HERE, IT WILL FIT
	JMP I SETUP
LOAD,	JMS SETUP	/SET UP FOR INPUT
	JMP I [NODEV	/NO LOAD DEVICE
	STA CLL RAL	/-2 DO A HANDLER LOAD
	CIF CDF 20	/OFF TO FIELD 2
	JMS I (LDABS
	JMP I [BADLOD	/BAD
	TAD I TABLMT	/SEE IF HEADER INFORMATION IS OK
	SMA
	JMP I [BADLOD
	TAD (20		/ALLOW 16 HANDLERS/BINARY
	SPA CLA
	JMP I [BADINP	/TOO MANY
	TAD I TABLMT
	DCA LODTMP	/# OF LOOPS TO EXECUTE
	TAD TABLMT
	TAD [PAGRES+1	/POINT TO FIRST 'PAGRES' WORD
	DCA HDPTR	/GO THERE FOR DESCRIPTORS
	TAD HNDPTR
	JMS I [ROTL
	DCA TEMP	/PAGE OF RESIDENCE
PGLUP,	TAD TEMP
	DCA I HDPTR	/INSERT PAGE OF RESIDENCE
	TAD HDPTR
	TAD [HDRSIZ
	DCA HDPTR
	ISZ LODTMP
	JMP PGLUP
	TAD [2-HDRSIZ
	TAD HDPTR
	DCA HDPTR	/POINT TO AFTER DESCRIPTORS
	TAD HDPTR
	CIA
	TAD I (NEWLIM
	SNA CLA		/AT END?
	JMP I (OK		/YES
	TAD I HDPTR	/NO, MAYBE A BOOTSTRAP RECORD
	CLL
	TAD [200
	SNL CLA
	JMP I [BADLOD	/NO
	TAD I HDPTR	/MAYBE
	CIA
	IAC		/OVER COUNT
	TAD HDPTR
	CIA
	TAD I (NEWLIM
	SZA CLA
	JMP I [BADLOD	/NO
	JMP I (OK
HDPTR,	0		/POINTS INTO NEW HEADER

/DESCRIPTOR TABLE DESCRIPTION:

/'TABLMT' ALWAYS POINTS TO FIRST FREE LOCATION
/'DSCPTR' ALWAYS POINTS TO BEGIN OF CURRENT HEADER BLOCK
/ITEMS ARE OF 3 FORMS:
/(A) GROUP COUNT: IN RANGE -1 TO -20  (IGNORED AND HAS NO MEANING)
/	IT IS THERE FOR COMPATIBILITY WITH OLD BUILD
/(B) HEADER BLOCK STARTS WITH NUMBER IN RANGE 0-7577
/	CONSISTS OF 'HDRSIZ' CONSECUTIVE WORDS
/	DESCRIBED ELSEWHERE
/(C) BOOTSTRAP BLOCK: STARTS WITH NUMBER IN RANGE 7600-7757
/	THIS IS THE NEGATIVE OF THE NUMBER OF WORDS TO FOLLOW
/NON-SYSTEM HEADER INFO:

/	- NUMBER OF ENTRY POINTS

/FOR EACH ENTRY POINT:

/0,1	GROUP NAME
/2,3	ENTRY POINT NAME	(PERMANENT NAME)
/4	R/W FILE-STR, DEVICE TYPE, MAX # OF PLATTERS
/5	1/2 PAGE, REL ENTRY PT, SYSBIT, CORES
/6*	PAGE OF HANDLER, ACTIVE BIT, # OF PLATS, DSKBIT
/7	SIZE OF DEVICE

/* SUPPLIED BY BUILD

LDEXT,	TAD TEMP	/DIDN'T FIND FILE
	SZA CLA
	JMP I (KICKM	/NO RESORT
	ISZ TEMP
	JMP TRYAGN	/TRY NULL EXTENSION

	PAGE
REPLACE,JMS I (DEL	/DELETE PERMANENT NAME SPECIFIED NEXT
	TAD CHAR
	TAD MEQ
	SZA CLA		/AFTER ALL DELETIONS, MUST FIND A "="
	JMP I [SYNTAX	/IF NOT, WARN THE GUY
	JMS INS		/IF FOUND IT, NOW PERFORM INSERTIONS
	JMP I [CONFIG	/THE GUY HAS BEEN HUMORED

INSERT,	JMS INS
TSTEOL,	TAD CHAR	/THERE SHOULDN'T BE ANYTHING AFTER EOC
	SNA CLA
	JMP I [CONFIG	/THERE WASN'T
	JMP I [SYNTAX	/WARN BLOKE ABOUT EXTRA STUFF

DELETE,	JMS I (DEL	/DELETE PERMANENT NAMES SPECIFIED
	JMP TSTEOL

SYSTEM,	JMS INS		/SYS IS SAME AS INSERT
	GET
	SYSBIT
	RTL
	SPA SZL CLA	/BUT SYSBIT OR CORES SHOULD BE ON
	JMP TSTEOL	/JUST TO HUMOR IT'S NAME
TWOSYS,	JMS I [PRWD	/AND FOR COMPATIBILITY REASONS
	TEXT	/?SYS/
	JMP I [CONFIG
INS,	0
	TAD (STL RAR
	DCA I (ACTION	/SET 'ACTION' FOR INSERTIONS
	JMS I [TSTNAM	/LOOK FOR A NAME
	JMS I [GRPNAM	/GET GROUP NAME
	JMS SAVNAM
	JMS I [TEST
MEQ,	-"=;ACT
	-",;INSNAM
	-":;INSNAM
	4000;ACT
	0
INSNAM,	JMS I [TSTNAM	/GRAB A NAME
INSGN,	JMS I [BIGNAM	/GET PERMANENT NAME WITH SPECIFIED GROUP NAME
	GET
	GRPNM1
	CIA
	TAD SAV1
	SZA CLA
	JMP I [NFOUND	/MAKE SURE PERMANENT NAME FOUND
	GET		/HAS GROUP NAME PREVIOUSLY SPECIFIED
	GRPNM2
	CIA
	TAD SAV2
	SZA CLA
	JMP I [NFOUND
ACT,	JMS I (SETACT	/SET ACTIVE BIT
COM,	JMS I [TEST
	-"-;HYPH
	-",;INSNAM
	-"=;INPLAT
	0
	JMP I INS
INPLAT,	JMS I [GETNUM	/AN "="
	JMP I [SYNTAX
	TAD SIZE
	SNA CLA
	JMP I [BADARG	/=0 ILLEGAL
	GET
	MAXPLT
	AND [7		/GET MAXIMUM # OF PLATTERS ALLOWED
	SNA
	IAC		/0 MEANT 1
	CMA CLL
	TAD SIZE	/COMPARE WITH USER'S REQUEST
	SZL CLA		/IS HIS REQUEST OKAY?
	JMP BADPLT	/REQUEST-SHMEST.  TOO MANY PLATTERS
	TAD SIZE
	JMS I [ROTR
	DCA SIZE
	GET
	PLATNUM
	AND (6177
	TAD SIZE	/STORE AWAY HIS STATED NUMBER OF PLATTERS
	PUT		/FOR FUTURE USE BY 'BOOT'
	PLATNUM
	JMP COM		/REJOIN PROCESSING

BADPLT,	JMS I [PRWD
	TEXT	/?PLAT/
	JMP I [CONFIG
SAVNAM,	0
	TAD NAME1
	DCA SAV1	/SAVE GROUP NAME
	TAD NAME2
	DCA SAV2
	JMP I SAVNAM

HYPH,	TAD NAME2
	AND [77
	CIA
	DCA DETEM
	GETCHR
	AND [77
	TAD DETEM	/GET CHAR AFTER HYPEN
	SNA CLA		/REACHED IT YET?
	JMP IGET	/YES, WELL TRY FOR MORE STUFF
	BAKCHR		/NO, PUT IT BACK FOR FUTURE USE
	ISZ NAME2	/FORM NEXT SEQUENTIAL NAME
	JMP INSGN	/GO INSERT IT
/DO WE REALLY HAVE TO START SEARCH AT CURRENT DESCR?

DETEM,	0

IGET,	GETCHR
	DCA CHAR
	JMP COM

NODEV,	JMS I [PRWD
	TEXT	/?DEVICE/
	JMP I [CONFIG
	PAGE
INTEM,
SETACT,	0
	GET
	ACTIVE		/GET ACTIVATION BIT
	RAL
ACTION,	STL RAR		/ACTIVATE IT (SET TO 'CLL RAR' TO DEACT)
	PUT
	ACTIVE		/RESTORE
	JMP I SETACT

DEL,	0
	TAD (CLL RAR
	DCA ACTION
DELNAM,	JMS I [TSTNAM	/PARSE OFF A NAME
DELGN,	JMS I [ACTNAM	/FIND IT AS AN ACTIVE PERMANENT NAME
	JMS SETACT	/DEACTIVATE IT
	GET
	PLATNUM
	AND [6177	/SET # OF PLATTERS TO 0
	PUT
	PLATNUM
DCOM,	JMS I [TEST
	-"-;DHYPH
	-",;DELNAM
	0
	JMP I DEL

DHYPH,	TAD NAME2
	AND [77
	CIA
	DCA INTEM
	GETCHR
	AND [77
	TAD INTEM
	SNA CLA		/REACHED FINAL NAME?
	JMP DGET	/YES
	BAKCHR		/NO, PUT FINAL LETTER BACK
	ISZ NAME2	/YES, BUMP TO NEXT NAME
L0423,	423
	JMP DELGN	/DELETE NEXT ONE IN SUCCESSION
DGET,	GETCHR
	DCA CHAR
	JMP DCOM

TTYIN,	0		/TTY INPUT ROUTINE
	KSF
	JMP .-1
	KRB
	SNA		/LOW LEVEL BLANK IGNORE
	JMP TTYIN+1
	AND [177	/HANDLE PARITY
	TAD [200
	DCA CHAR
	JMP I TTYIN
/DSK=ACTIVE PERMANENT NAME
/DSK=GROUPNAME:PERMANENT NAME
/DSK=<CR>	MEANS NO DSK SPECIFIED, USE 'SYS'

/JUST REMEMBERS NAME (NOTHING ELSE)

DSK,	JMS I [GNAME	/GET A NAME
	TAD NAME1
	SNA CLA
	JMP NODSK
	TAD CHAR
	SNA
	JMP NOCOL
	TAD [-":
	SZA CLA		/IS IT FOLLOWED BY A ":"?
	JMP I [SYNTAX	/NO, ASSUME HE'S GIVING AN ACTIVE PERMANENT NAME
			/THIS IS FOR COMPATIBILITY WITH OLD BUILD
/	JMS I [GRPNAM	/YES, ITS A GROUP NAME
	TAD NAME1	/SAVE IT
	DCA DSKG1
	TAD NAME2
	DCA DSKG2
	JMS I [TSTNAM	/GET PERMANENT NAME
PN,	TAD NAME1
	DCA DSKP1	/DON'T WORRY NOW IF IT'S AROUND
	TAD NAME2
	DCA DSKP2
	TAD CHAR
	SZA CLA
	JMP I [SYNTAX
	JMP I [CONFIG

NODSK,	DCA DSKG1	/FIRST WORD 0 MEANS NONE SPECIFIED
	JMP I [CONFIG

NOCOL,	JMS I [ACTNAM	/IT MUST BE AN ACTIVE HANDLER
	GET
	GRPNM1
	DCA DSKG1
	GET
	GRPNM2
	DCA DSKG2
	JMP PN
SETDSK,	TAD L0423	/DS
	DCA I (DVNM1
	TAD (1300	/K
	DCA I (DVNM1+1
	JMP I (GETU

KICKM,	CIF 10		/RELEASE MONITOR AND RELOAD
	JMS I [200	/OUR DEVICES
	11
	JMP I [NFOUND

GETUSR,	0
	CIF 10
	JMS I [7700	/LOCK IN MONITOR
	10
	CIF 10		/RESET RESIDENT HANDLER TABLE
	JMS I [200
	13
	JMP I GETUSR
/	CODE FOR USING INTERNAL HANDLERS ON STANDALONE LOAD:

BLDLOD,	DCA I (FILPTR	/LOAD DEV
	JMS I [ACTNAM	/MUST BE ACTIVE
	JMS I [GETPG
	DCA HNDLOK	/LOCATION OF HANDLER
	TAD [-400
	JMS I [MOVE
	CDF 10
HNDLOK,	HLT
	CDF 0
PBUFFER,BUFFER
	GET
	DCB
	DCA BLDCB
	GET
	ENTPT
	AND [177
	TAD PBUFFER	/GET ENTRY POINT OF HANDLER
	JMP I (LOADIN

BLDCB,	0		/CONTAINS DCB OF CURRENT LOAD HANDLER
	PAGE
GETPG,	0
	GET
	PAGRES
	JMS I [ROTR
	AND [7600
	JMP I GETPG

/FORMAT:	NAME OLDNAME=NEWNAME

NAME,	JMS TSTNAM	/SEE IF ARGUMENT SUPPLIED
			/SEARCH PERMANENT TABLES
	JMS I [ACTNAM	/GET ACTIVE PERMANENT NAME DESCRIPTOR
	TAD CHAR
	TAD MEQL	/CHECK FOR =
	SZA CLA
	JMP I [BADARG
	JMS TSTNAM	/GET NEW DEVICE NAME
	TAD NAME1	/REPLACE THE NAME
	PUT
	PRMNM1
	TAD NAME2
	PUT
	PRMNM2
	JMP I [CONFIG
EXAMINE,CLA IAC
ALTER,	DCA XSWTCH
	JMS I [TSTNAM	/ALTER ALLOWS MODS TO A PARTICULAR
	JMS I [GRPNAM	/HANDLER'S ACTUAL CODE.
			/LOOK AT DEVICE TYPE ENTRY
	JMS GETPG	/GET PAGE OF RESIDENCE
	DCA PAGAD	/SAVE IT.
	JMS I [GETNUM	/GET RELATIVE LOC TO ALTER
	JMP I [SYNTAX	/NO NUMBER
	GET
P2PAG,	TWOPAG		/IS THIS A 2-PAGE HANDLER?
	SPA CLA
	TAD [7600
	TAD [7600	/ALLOW 200 OR 400 MAXIMUM
	CLL
	TAD SIZE	/IS THE # TO ALTER TOO LARGE?
	SZL CLA
	JMP I [BADARG	/I GUESS IT IS
	TAD SIZE
	TAD PAGAD	/GET ABSOLUTE LOCATION
	DCA PAGAD
	TAD XSWTCH
	SZA CLA		/EXAMINE OR ALTER?
	JMP EXAM	/EXAMINE
	TAD CHAR	/ALTER
	SZA CLA		/CR?
	JMP GETVAL	/NO
	JMS EXAMSB	/YES, GIVE GUY  OLD VALUE FIRST
ODTL,	TAD ["/		/ODT LIKE
	JMS I [TTYOUT
	TAD [-100
	JMS I [GTEXT
	JMP ODTL
GETVAL,	JMS I [GETNUM	/GET NEW CONTENTS
	JMP I (TSTEOL	/NO NUMBER
	TAD SIZE
	CDF 10
	DCA I PAGAD	/REPLACE THAT LOC.
	JMP I [CONFIG	/AND GET OUT
PAGAD,	0

/ALTER GROUPNAME,LOC=NEWVALUE
/ALTER GROUPNAME,LOC
/EXAMINE GROUPNAME,LOC
/SIZE ACTNAM
/SIZE ACTNAM=VALUE
/DCB ACTNAM
/DCB ACTNAM=VALUE
/CTL ACTNAM
/CTL ACTNAM=VALUE

SIZCM,	TAD (3		/SIZE COMMAND V3C
DCBCM,	TAD [-1		/EXAMINE DCB WORD
CTLCM,	TAD P2PAG	/EXAMINE CONTROL WORD
	DCA PUTAT
	TAD PUTAT
	DCA LOOKAT
	JMS I [TSTNAM	/GET A NAME
	JMS I [ACTNAM	/IT MUST BE ACTIVE
	JMS I [TEST
MEQL,	-"=;INPDCB
	4000;EXAMDCB
	0
	JMP I [SYNTAX
INPDCB,	JMS I [GETNUM
	JMP I [CONFIG	/IGNORE = NOTHING
	TAD SIZE
	PUT
XSWTCH,			/0 MEANS ALTER, 1 MEANS EXAMINE
PUTAT,	DCB
	JMP I [CONFIG	/THE USER LIVES DANGEROUSLY

EXAMDCB,GET
LOOKAT,	DCB
	JMS PUTNUM
	TAD ["/
	JMS I [TTYOUT
	TAD [-100
	JMS I [GTEXT
	JMP EXAMDCB
	JMP INPDCB	/NOW PARSE OFF THE REPLY
EXAM,	JMS EXAMSB
	JMP I [CONFIG

EXAMSB,	0
	CDF 10
	TAD I PAGAD	/GET CURRENT CONTENTS
	CDF 0
	JMS PUTNUM	/PRINT IT
	JMP I EXAMSB

PUTNUM,	0		/PRINT AN OCTAL NUMBER
	DCA PTM
	TAD [-4		/4 DIGITS
	DCA PKNT
PLOOP,	TAD PTM
	RTL
	RTL
	AND [7
	TAD (60
	JMS I [TTYOUT
	TAD PTM
	RTL
	RAL
	DCA PTM
	ISZ PKNT
	JMP PLOOP
	JMP I PUTNUM
PTM,	0

PKNT,
TSTNAM,	0
	JMS I [GNAME	/COLLECT NAME
	TAD NAME1	/IF NO NAME FOUND, GIVE ERROR
	SZA CLA
	JMP I TSTNAM
NAMERR,	JMS I [PRWD
	TEXT	/?NAME/
	JMP I [CONFIG
	PAGE
/PRINT FUNCTION TYPES OUT THE STATUS OF BUILD ON COMMAND
/AN * BESIDE A DEVICE INDICATES THAT IT IS CURRENTLY MARKED
/FOR INSERTION IN THE SYSTEM BEING BUILT.

TTY240,
PRINT,	STA
	DCA OLDPAG	/SET ILLEGAL OLD PAGE
	INIT
	ISZ I (LINEUP	/MAKE THINGS LINE UP
PRLUP,	ADVDSC		/ADVANCE TO NEXT DESCRIPTOR
	ADVBOT		/ADVANCE PAST A BOOTSTRAP (IF ANY)
	JMP DONE	/ALL DONE
	JMS I [GETPG	/GET PAGE OF NEW HANDLER
	DCA NEWPAG
	TAD NEWPAG
	CIA
	TAD OLDPAG	/COMPARE WITH LAST HANDLER'S PAGE
	SNA CLA		/SAME?
	JMP PRTPER	/YES
	JMS I [CRLF	/NO, GO TO NEXT LINE
	TAD NEWPAG
	DCA OLDPAG
	JMS PGNAME
	TAD TTY240
	JMS I [TTYOUT
PRTPER,	GET		/GET ACTIVE BIT
	ACTIVE
	SPA CLA		/IS IT ACTIVE?
	TAD ("*-STA	/YES, PRINT *
	TAD TTY240	/NO, PRINT SPACE
	JMS I [TTYOUT
	JMS PNAME	/PRINT PERMANENT NAME
	JMP PRLUP

PGNAME,	0
	GET
	GRPNM1
	JMS I (PRINTE	/PRINT GROUP NAME
	GET
	GRPNM2
	JMS I (PRINTE
	TAD (":
	JMS I [TTYOUT
	JMP I PGNAME
DONE,	DCA I (LINEUP	/NO MORE LINE-UP
	TAD DSKG1
	SNA CLA
	JMP TELCOR
	JMS I [CRLF	/TELL GUY ABOUT 'DSK'
	JMS I [CRLF
	JMS I [PRWD
	TEXT	/DSK=/
	TAD DSKG1
	JMS I (PRINTE
	TAD DSKG2
	JMS I (PRINTE
	TAD (":
	JMS I [TTYOUT
	TAD DSKP1
	JMS I (PRINTE
	TAD DSKP2
	JMS I (PRINTE
TELCOR,	TAD NEWCOR
	SNA
	JMP I [CONFIG	/NO SPECIFIED CORE LIMIT
	JMS I [ROTL
	TAD (6000
	DCA CORMSG+3
	JMS I [CRLF
	JMS I [PRWD
CORMSG,	TEXT	/CORE= /
	JMP I [CONFIG
/QUICK PRINT

QLIST,	INIT
QLUP,	ADVDSC		/ADVANCE TO NEXT DESCRIPTOR
	ADVBOT		/ADVANCE OVER ANY BOOTSTRAP IF NECESSARY
	JMP DONE	/GO AWAY WHEN NO MORE
	GET
	ACTIVE		/GET ACTIVE BIT
	SMA CLA		/IS IT ACTIVE?
	JMP QLUP	/NO, IGNORE IT
	GET		/YES
	SYSBIT
	RAL
	SPA CLA		/IS IT 'SYS'?
	JMS PGNAME	/YES, PRINT GROUP NAME TOO
	JMS PNAME	/NO, PRINT PERMANENT NAME ONLY
	JMP QLUP

DT,
PNAME,	0
	GET
	PRMNM1
	JMS I (PRINTE
	GET
	PRMNM2
	JMS I (PRINTE
	TAD TTY240
	JMS I [TTYOUT
	JMP I PNAME
	DCBTBL=7760

WHAT,	JMS I [PRNAME
	JMS I [PRWD
	TEXT /?/	/FOR WHEN A COMMAND ERROR OCCURS
	JMP I [CONFIG


DTYPE,	0		/RETURNS TYPE OF OUTPUT
	TAD (DCBTBL-1
	DCA DT		/ENTRY AC HAD DEVICE #
	CDF 10
	TAD I DT	/IF FILE DEVICE, LINK=0
	CDF 0
	CMA RAL		/ALSO, IF FILE AC=0 ON EXIT
	CLA RAL
	JMP I DTYPE
WRITCC,	0
	TAD [-6		/PUT IN DATA BREAK FILLERS
	JMS I [MOVE
	CDF 0
	K7750
	CDF 0
	PG7600+200+150
	TAD (4200
	JMS I [SYS	/WRITE NEW CCB
	BLDCCB-200
	37
	JMP I WRITCC
	PAGE
TOOMANY,JMS I [PRWD
	TEXT	/?HANDLERS/
	JMP I [CONFIG

GOTCHA,	0
	DCA I (GOTEM
	TAD I GOTCHA
	TAD DSCPTR
	ISZ GOTCHA
	DCA GETEMP
	TAD I (GOTEM
	DCA I GETEMP
	JMP I GOTCHA

GETEMP,	0		/TEMP FOR GOTCHA
TEST,	0		/TEST CHAR AGAINST ARGUMENTS
	TAD I TEST	/PICK UP ARGUMENT FROM LIST
	SNA		/0 TERMINATES
	JMP I TEST
	TAD CHAR	/SEE IF THEY COMPARE =
	AND (3777	/COMPARE ONLY LOW ORDER, THUS ALLOWING '4000' TO MEAN '0'
	SNA CLA
	JMP TSTOVR	/THEY DO..DISPATCH TO TABLE
	ISZ TEST
	ISZ TEST
	JMP TEST+1	/THEY DON'T. KEEP GOING
TSTOVR,	ISZ TEST
	TAD I TEST
	DCA TEMP
	JMP I TEMP

K7750,	7750		/DATA BREAK FILLERS
	7751
	7752
	7753
	7754
	7755

SYS,	0		/SAVES A FEW WORDS IN SYSTEM CALLS
	DCA SYCTL	/SAVE FUNCTION WORD
	TAD I SYS
	DCA SYBUF	/BUFFER BEING USED
	ISZ SYS
	TAD I SYS
	DCA SYREC	/RECORD #
	ISZ SYS		/THERE IS NO ERROR RETURN
/IF SWAPER SET AND BOOTDV SET, USE SPECIAL BOOT HANDLER HERE
GO,	JMS I SYSENT
SYCTL,	0
SYBUF,	0
SYREC,	0
	SKP CLA
	JMP I SYS
	JMS I [PRWD
	TEXT	/SYS ERR/
	HLT		/IF USER IS DARING, HIT CONTINUE TO RETRY
	JMP GO

SYSENT,	7607
/*****************
/
/	SYS HANDLER IS 2-PAGES LONG IF LOCATION 7612 IS A 3
/
/******************

CLRTBL,	0
	TAD [BEGLIN
	DCA XR1
	TAD [-200	/ZERO OUT 5200-5377
	DCA TMP1
	DCA I XR1
	ISZ TMP1
	JMP .-2
	JMP I CLRTBL

/FOR HANDLER ONLY
ORGLIM,	0		/THIS ROUTINE MAKES CERTAIN THAT
	DCA CLRTBL	/THE ORIGIN FOR LDABS IS WITHIN
	TAD CLRTBL	/THE BOUNDS SPECIFIED BY SIZE
	TAD [7600	/AND THE CONTENTS OF HNDPTR
	SPA
	JMP BADORG	/ORIGIN BELOW 200
	CIA
	TAD [400	/IS ORIGIN WITHIN UPPER BOUND?
	SPA CLA
	JMP BADORG
	TAD CLRTBL
	TAD [7600	/NOW GIVE BACK RELATIVE BUFFER
	TAD HNDPTR	/ADDRESS IN FIELD 1
	DCA CLRTBL
	TAD CLRTBL
	AND [7600
	TAD [200
	SNA CLA
	JMP I (NOROOM	/CAN'T 'ORIGIN' INTO PAGE 7600
	TAD CLRTBL
	CIF CDF 20	/CALLED FROM FIELD 2
	JMP I ORGLIM

BADORG,	JMS I [PRWD
	TEXT /?ORIGIN/
	JMP I (OVROUT

/SOMEWHERE TEST IF HE GAVE US A 2-PAGE BUT REQ A 1-PAGE
/	PG7600_0
/	BLOK66_66
/	IF OLD SYS WAS 1 PAGE, BLOK66/L_PG7600/L

RECZRO,	0		/READS FIELD 1 CODE, EVEN FOR 12K TD8E
	TAD [200
	JMS I [SYS	/READ RECORD 0
	PG7600
	0		/THAT NORMALLY CONTAINS FIELD 1
	TAD (210
	JMS I [SYS	/READ RECORD 66
	BLOK66
	66
	TAD FLAG2	/DID PREVIOUS SYSTEM HAVE A 2-PAGE HANDLER?
	SZA CLA
	TAD [-200	/NO
	JMS I [MOVE	/YES
	CDF 0
	PG7600
	CDF 10
	BLOK66
	JMP I RECZRO

NOTNUF,	JMS I [PRWD
	TEXT	/?CORE/
	JMP I [CONFIG
	PAGE
UNLOAD,	JMS I [TSTNAM	/PULL OFF A NAME
	JMS I [GRPNAM	/IT HAD BETTER BE A GROUP NAME
	JMS I [TEST
	-":;UNLPRM
	4000;UNLGRP
	0
	JMP I [SYNTAX

UNLPRM,	JMS I (SAVNAM	/UNLOAD PARTICULAR HANDLER
UNLNAM,	JMS I [TSTNAM
	JMS I [BIGNAM
	TAD DSCPTR	/DELETE A SINGLE DESCRIPTOR
	DCA SAVPTR	/DON(T DELETE HANDLER
	TAD DSCPTR	/OR BOOTSTRAP
	TAD [HDRSIZ	/NO RELOCATION NECESSARY
	DCA LSTPTR
	TAD TABLMT
	JMP NOMOR
UNLGRP,	JMS I [GETPG	/GET PAGE OF RESIDENCE
	DCA TOMOV	/START OF HANDLER
	GET
	TWOPAG		/IS IT A 1- OR 2- PAGE HANDLER?
	SPA CLA
	TAD [200	/2 PAGE
	TAD [200	/1 PAGE
	DCA UNSIZE
	TAD TOMOV	/DELETE HANDLER AND MOVE ALL FOLLOWING DOWN
	TAD UNSIZE
	DCA FROMOV	/GET FIRST LOCATION AFTER HANDLER
	TAD HNDPTR	/GET NEXT FREE LOCATION FOR HANDLER
	CIA
	TAD FROMOV	/GET NUMBER OF LOCS TO MOVE
	JMS I [MOVE
	CDF 10
FROMOV,	0
	CDF 10
TOMOV,	0		/UPDATE POINTERS; SEARCH DESCRIPTORS
	TAD UNSIZE	/FOR REFS TO MOVED HANDLERS AND DECREASE
	CIA		/THOSE REFS BY -UNSIZE
	TAD HNDPTR
	DCA HNDPTR	/FREES SOME BUFFER SPACE
	TAD TABLMT
	DCA OLDTOP	/REMEMBER ORIGINAL TOP OF STACK
	STA		/BACK UP OVER GROUP COUNT
	TAD DSCPTR
	DCA SAVPTR	/REMEMBER THIS LOCATION
	TAD UNSIZE
	JMS I [ROTL
	CIA
	DCA UNSIZE
	TAD DSCPTR
	TAD [HDRSIZ
	DCA LSTPTR	/'LSTPTR' POINTS TO FIRST DESCRIPTOR BEING MOVED
/COMPRESS THE DESCRIPTORS ABOVE THIS ONE

ADV,	ADVDSC		/ADVANCE TO NEXT DESCRIPTOR
	JMP BADV	/ENCOUNTERED A BOOTSTRAP RECORD
	JMP NOMORE	/NO MORE, THROUGH
GT,	JMS I [GETPG	/GET PAGE OF THIS DESCRIPTOR
	CLL CIA
	TAD TOMOV	/COMPARE WITH PAGE OF DELETED HANDLER
	SNA CLA
	JMP SAMPAG	/THEY'RE THE SAME
	SZL		/THEY'RE NOT THE SAME.  WHICH IS HIGHER?
	JMP ADV		/IT WAS BELOW HANDLER.  NO SWEAT.
	GET		/IT WAS ABOVE HANDLER, HAVE TO ACCOUNT FOR THIS
	PAGRES		/POINT TO NEW HANDLER LOCATION
	TAD UNSIZE
	PUT
	PAGRES
	JMP ADV		/CONTINUE
SAMPAG,	TAD [HDRSIZ
	TAD DSCPTR
	DCA LSTPTR	/NOTE LOCATION OF NEXT DESCRIPTOR
	JMP ADV
/ADVANCE PAST BOOTSTRAP OR DELETE IT AS NECESSARY
BADV,	TAD DSCPTR
	CIA
	TAD LSTPTR
	SZA CLA		/IS THIS BOOT PART OF GROUP BEING UNLOADED?
	JMP BDV		/NO
	TAD I DSCPTR	/YES
	CIA
	IAC
	TAD DSCPTR
	DCA LSTPTR	/SET 'LSTPTR' TO BEGIN OF NEXT DESCRIPTOR
BDV,	ADVBOT		/ADVANCE OVER BOOTSTRAP
	JMP NOMORE	/DONE
	JMP GT		/GO ON TO NEXT DESCRIPTOR
/ALL DESCRIPTORS FOR THE SAME HANDLER ARE CONSECUTIVE
/MOVE DOWN DESCRIPTORS

NOMORE,	TAD OLDTOP
NOMOR,	CIA
	TAD LSTPTR	/MINUS # OF WORDS TO MOVE
	JMS I [MOVE
	CDF 0
LSTPTR,	0		/FIRST DESCRIPTOR NOT CONSIDERED
	CDF 0
SAVPTR,	0		/POINTS TO INITIAL DESCRIPTOR BEING DELETED
	TAD LSTPTR
	CIA
	TAD SAVPTR	/GET NUMBER OF WORDS DELETED
	TAD TABLMT
	DCA TABLMT	/UPDATE TABLMT
	DCA I TABLMT	/MUST HAVE 0 AT TABLE END SO DON'T THINK IT'S A BOOTSTRAP
	JMS I [COMMA
	JMP UNLNAM

OLDTOP,			/ORIGINAL TOP OF DESCRIPTORS
INI,	0
	TAD (DSCTAB-HDRSIZ
	DCA DSCPTR
	JMP I INI

	INIT=JMS I [INI

/RETURN TO CONFIG IF EOL, OR BACK IN-LINE IF COMMA

UNSIZE,
COMMA,	0
	TAD CHAR
	SNA
	JMP I [CONFIG
	TAD (-",
	SNA CLA
	JMP I COMMA
	JMP I [SYNTAX
BOOTQ,	SZA CLA		/MAY BE OVERLAID
	JMP SAMEE
	DCA I (DRECT	/DON'T TOUCH DIRECTORY IF DIDN'T COPY SYS
SAMF,	JMS I [SYSWP
	JMP I (BOOT4
SAMEE,	JMS I (SYSCPY	/OR IF OLD DEV=NEW DEV
	JMP SAMF
	PAGE
LOCSYS,	0
	TAD (2331	/"SY"
	DCA NAME1
	TAD (2300	/"S "
	DCA NAME2
	DCA NAME3	/V3C
	DCA NAME4
	JMS I [ACTNAM	/LOOK UP 'SYS'
	JMP I LOCSYS

NOSLOT,	JMS I [PRWD
	TEXT	/?SLOTS/
	JMP I [CONFIG

GOOD,	0
	TAD [4207	/RESTORE 7600 TO NORMAL
	DCA I [7600
	TAD [5000
	DCA I [7601
	TAD (CDF CIF
	DCA I [SA	/SET SA=00200
	TAD [200
	DCA I (SA+1
	DCA I (JSW	/SET JOB STATUS WORD=0
	STA
	DCA I (DRECT
	CLL STA RTL	/-3
	TAD I [7612	/FUDGE FOR 12K TD8E
	DCA FLAG2	/SET FLAG2=0 IF PREV SYSTEM WAS 2 PAGE
	JMP I GOOD
PACK,	ISZ PROTECT	/OK TO PACK IT?
	JMP PACKOK	/YES
	STA
	DCA PROTECT	/INHIBIT OTHER PACKS ALSO
	JMP GNAME2
PACKOK,	ISZ SWIT	/PACK LEFT OR RIGHT
	JMP RIGHT
	TAD CHAR
	AND [77
	JMS I [ROTL	/ROTATE 6 LEFT
	DCA I TEMP	/STORE THE CHARACTER
	JMP GNAME2
RIGHT,	CLA CMA		/RESET FLIP FLOP
	DCA SWIT
	TAD CHAR
	AND [77
	TAD I TEMP
	DCA I TEMP
	ISZ TEMP	/POINT TO NEXT WORD
	JMP GNAME2
PROTECT,0		/-1 MEANS DON'T ACCEPT CHAR, IGNORE IT
SWIT,	0


ACTNAM,	0		/THEY MUST BE ACTIVE
	CLA IAC
	JMS I (PRMNAM
	JMP I ACTNAM
DOT,	CLA CMA
	DCA SWIT
	TAD (-3		/NOW ALLOW ONLY A 2-CHAR EXTENSION
	DCA PROTECT
	TAD (NAME4
	DCA TEMP
	ISZ DOTCNT	/HAD WE SEEN A DOT BEFORE?
	JMP SYNTAX	/YES
	JMP GNAME2	/NO

DOTCNT,	-1		/-1 MEANS HAVEN'T SEEN A DOT

EOL,	DCA CHAR
	JMP I GNAME

GNAME,	0		/COLLECT A WORD IN NAME1-NAME4
			/LEAVE DELIMITING CHAR IN 'CHAR'
	CDF 0
	TAD [-7		/MAX 6 CHARACTERS
	DCA PROTECT
	DCA NAME1	/FIRST CLEAR OUT COLLECTION AREA
	DCA NAME2
	DCA NAME3
	DCA NAME4
	CLA CMA
	DCA SWIT	/L-R PACKING SWITCH
	STA
	DCA DOTCNT	/ALLOW ONLY ONE DOT PER NAME
	TAD (NAME1
	DCA TEMP
GNAME2,	GETCHR
	SNA		/A 0 ENDS THE SEARCH
	JMP EOL
	DCA CHAR
	TAD CHAR
	TAD (-"A	/GET ONLY A-Z OR 0-9
	CLL
	TAD ("A-"Z-1
	SNL CLA		/IS IT A-Z?
	JMP PACK	/YES..PACK IT AWAY
	TAD CHAR
	TAD (-"0
	CLL
	TAD ("0-"9-1
	SNL CLA
	JMP PACK	/FOUND 0-9
	JMS I [TEST	/TEST FOR DELIMITING CHARS
	-".;DOT		/ADVANCE POINTERS
	0
	JMP I GNAME
SYNTAX,	JMS I [PRWD
	TEXT /?SYNTAX/
	JMP I [CONFIG

DSKBAD,	JMS I [PRWD
	TEXT	/?DSK/
	JMP I [CONFIG
	SRES=BEGLIN+60	/RESIDENCY TABLE
	SDCB=BEGLIN+100	/DCB
	SHND=BEGLIN+120	/SLOT ASSSIGNED?
	SNAME=BEGLIN+140/NAME
	SBUFF=BEGLIN+160/ADDRESS OF HANDLER


/	SYSTEM TABLES:

/THOSE IN USR:

/PDNT	PERMANENT DEVICE NAME TABLE	(SNAME)
/	POINTED TO BY LOCATION 10036 IN USR
/	CONTAIN HASH CODE OF DEVICE NAME
/	ADD TWO WORDS OF NAME TOGETHER AND TURN ON BIT 0
/	IF SECOND WORD WAS NON-ZERO
/	AN ENTRY OF 0 MEANS THERE IS NO DEVICE FOR THAT ENTRY

/DHIT	DEVICE HANDLER INFORMATION TABLE	(SHND)
/	POINTED TO BY LOCATION 10037 IN USR
/	BIT 0		=1 IF THIS IS A TWO-PAGE HANDLER
/	BITS 1-4	RELATIVE BLOCK LOCATION OF HANDLER ON SYSTEM DEVICE
/			(BLOCK SLOT).  ADD 15 TO GET ACTUAL BLOCK #.
/	BITS 5-11	RELATIVE ENTRY POINT OF HANDLER


/DHRT	DEVICE HANDLER RESIDENCY TABLE	(SRES)
/	IN LOCATIONS 17647-17665
/	ACTUAL ENTRY POINT OF HANDLER
/	WE ONLY CARE ABOUT IT IF THE HANDLER IS RESIDENT.
/	OTHERWISE IT'S ZERO.
/	THE SYSTEM HANDLER AND ALL HANDLERS CORESIDENT WITH
/	IT ARE ALWAYS RESIDENT IN CORE AND HAVE THIS ENTRY NON-0.


/DCWT	DEVICE CONTROL WORD TABLE	(SDCB)
/	RESIDES IN LOCATIONS 17760-17776
/	BIT 0		1 IF DEVICE IS FILE STRUCTURED
/	BIT 1		1 IF THE DEVICE IS READ ONLY
/	BIT 2		1 IF THE DEVICE IS WRITE-ONLY
/	BITS 3-8	PHYSICAL DEVICE TYPE
/	BITS 9-11	DIRECTORY BLOCK # (WE SET TO 0)
/PRE-ASSIGNED DEVICE TYPES

/0	TELETYPE
/1	HIGH SPEED PAPER TAPE READER
/2	HIGH SPEED PAPER TAPE PUNCH
/3	CARD READER
/4	LINE PRINTER (ANY TYPE)
/5	RK8 DISK
/6	RF08 (1 PLATTER)
/7	RF08 (2 PLATTERS)
/10	RF08 (3 PLATTERS)
/11	RF08 (4 PLATTERS)
/12	DF32 (1 PLATTER)
/13	DF32 (2 PLATTERS)
/14	DF32 (3 PLATTERS)
/15	DF32 (4 PLATTERS)
/16	TC08 DECTAPE
/17	LINCTAPE
/20	TM8E MAGTAPE
/21	TD8E DECTAPE (12K OR ROM)
/22	BAT:
/23	RK8E DISK
/27	TU60 CASSETTES
/30	VR12 (PDP-12 SCOPE)
	PAGE
BOOT2A,	TAD (15
	DCA SLOT	/START ASSIGNING AT BLOCK SLOT 16 (16-25)
	TAD (-17	/ALLOW 16 ACTIVE HANDLERS NOT COUNTING DSK
	DCA COUNT
	JMS I (CLRTBL	/CLEAR OUT IN-CORE TABLES
	TAD (SHND+1	/ASSIGN SLOTS, COUNT ACTIVE HANDLERS
	DCA XR1		/XR1 POINTS TO SLOT TABLE (DHIT)
	TAD (SDCB+1
	DCA XR2		/XR2 POINTS TO DCB TABLE
	TAD (SNAME+1
	DCA XR3		/XR3 POINTS TO PERMANENT DEVICE NAME TABLE
	TAD (SBUFF+1
	DCA XR4		/XR4 POINTS TO HANDLER BUFFER ADDRESSES
	TAD (SRES+1
	DCA XR5		/XR5 POINTS TO RESIDENCY TABLE
	CLA IAC		/??
	DCA OLDPAG	/SET 'OLDPAG' TO A RIDICULOUS VALUE
	INIT
SLTLUP,	ADVDSC		/GO TO NEXT DESCRIPTOR
	ADVBOT		/ADVANCING OVER ANY BOOTSTRAPS
	JMP BOOT2X	/ALL DONE CREATING INTERNAL COPIES OF TABLES
	GET
	ACTIVE
	SMA CLA		/IS IT ACTIVE?
	JMP INACT	/NO
	ISZ COUNT	/YES, UPDATE COUNT
	JMP ACTIV
	JMP I (TOOMANY	/TOO MANY ACTIVE HANDLERS

BOOT2X,/	TAD I (SNAME	/SEE IF SYS WAS SPECIFIED
/	DCA SAMSYS	/0 IF DIDN'T SPECIFY NEW SYS
/	TAD SAMSYS
/	SZA CLA
/	JMP CHKDSK
/	CDF 10
/	TAD I (7760	/DIDN'T SPECIFY SYS SO USE CURRENT SYS
/	CDF 0
/	DCA I (SDCB
/	TAD (7607
/	DCA I (SRES
/CHKDSK,	TAD DSKG1	/WAS DSK SPECIFIED?
/	SZA CLA
/	JMP I (BOOT3	/YES, ALREADY SET UP
/	TAD I (SDCB
/	DCA I (SDCB+1
/	TAD (7607
/	DCA I (SRES+1
/	DCA I (SBUFF+1
	JMP I (BOOT3
CHKRES,	0
	JMS I [GETPG	/GET PAGE OF RESIDENCE
	DCA NEWPAG
	TAD NEWPAG
	TAD OLDPAG
	SNA CLA		/SAME OR PREVIOUS PAGE?
	JMP I CHKRES	/YES, SAME PAGE
	ISZ CHKRES
	GET		/NO, A NEW PAGE, NEEDS NEW SLOT, ETC.
	CORES
	RTL		/GET CORES BIT
	SPA CLA		/IS THIS ALLOWED TO START A NEW GROUP?
	JMP I (TWOSYS	/NO, IT MAY ONLY BE CORESIDENT WITH SOMETHING EARLIER
	TAD NEWPAG	/YES
	CIA
	DCA OLDPAG	/GOT NEW 'OLDPAG'
	JMP I CHKRES
ACTIV,	JMS CHKRES
	JMP SAMPG
	GET
	SYSBIT
	RAL
	SPA CLA		/IS IT A 'SYS' HANDLER?
	JMP I (SETSY	/YES
	JMS I (GETSLOT	/NO
	JMS I (SETSLT	/SET BLOCK SLOT
	DCA I XR1
	TAD NEWPAG
HNDLOC,	DCA I XR4	/STORE AWAY ADDRESS OF HANDLER (OR 0 IF PREVIOUSLY USED)
	JMS I (GETDCB
	DCA I XR2	/SET DCB
	GET		/HASH CODE NAME
	PRMNM2
	DCA TEMP	/SAVE 2ND WORD
	GET
	PRMNM1
	TAD TEMP	/ADD 2 WORDS
	DCA TMP1	/SAVE SUM
	TAD TEMP
	SNA CLA		/WAS 2ND WORD 0?
	JMP NO4C	/YES
	TAD TMP1	/NO, FORCE BIT 0 ON
	RAL
	STL RAR
	DCA TMP1
NO4C,	TAD TMP1	/TAKE CODED NAME
	DCA I XR3	/SET PERMANENT NAME TABLE
	GET
	CORES
	RTL		/GET CORESIDENT BIT
	SMA CLA		/IS IT RESIDENT?
	JMP NORE	/NO
	GET		/YES
	ENTPT		/GET RELATIVE ENTRY POINT
	AND [177
	TAD [7600	/CORESIDENT ENTRY POINTS TO SYS MUST BE ON PAGE 7600
NORE,	DCA I XR5	/SET RESIDENCY TABLE
INACT,	GET		/BUT MAYBE IT'S 'DSK'
	DSKBIT
	RTL
	SNL CLA		/IS IT DSK?
	JMP SLTLUP	/NO, IT'S TO BE IGNORED
	JMS I (SLOTDSK	/YES ASSIGN 'DSK''S LOCATION SLOT
	GET		/GET RID OF DSK BIT
	DSKBIT
	RTL
	CLL RTR
	PUT
	DSKBIT
	JMP SLTLUP	/REITERATE
SAMPG,	TAD SLOT	/ALREADY HAVE SLOT
	JMS I (SETSLT
	DCA I XR1
	JMP HNDLOC

GOTEM,
CORE,	0
	TAD I [7777
	AND [70
	CLL RTR
	RAR
	SNA
	JMS I (RELCOR
	JMP I CORE
	PAGE
/	STEPS IN BOOTSTRAPPING:

/1.	ASSIGN DSK, IF SPECIFIED, MAKE SURE NFS		[BOOT2]
/2.	ASSIGN SLOTS					[BOOT2A]
/3.	GIVE ERROR IF TOO MANY ACTIVE OR TOO MANY SLOTS	[BOOT2A]
/4.	BUILD INTERNAL COPIES OF DCB, SLOT, NAME, RES	[BOOT2A]
/5.	ALSO BUILD HANDLER ADDRESS TABLE, CONTAINS	[BOOT2A]
/	HANDLER ADDRESS IF NOT PREVIOUSLY WRITTEN OUT
/6.	COMPARE DCB'S OF NEW AND OLD SYSTEM, IF DIFF,	[BOOT3]
/	COPY SYSTEM OVER.  LEAVE NEW SYSTEM HANDLER
/	IN CORE
/7.	ASK GUY ABOUT NEW DIRECTORY			[BOOT4]
/8.	READ IN USR, UPDATE ITS TABLES, WRITE OUT USR	[BOOTC]
/	NAME TABLE, DHIT (SLOT, 2-PAGE,ENTPT)
/9.	READ IN CURRENT PAGE 7600 IMAGES		[BOOT5]
/	SET UP AS FOLLOWS:
/	PG7600/L:	BOOT
/	PG7600/H:	07600 IMAGE
/	BLOK66/L:	17600 IMAGE
/	BLOK66/U:	27600 IMAGE
/	THIS IS ACCOMPLISHED VIA:
/	PG7600_0
/	BLOK66_66
/	IF OLD SYS WAS 1 PAGE, BLOK66/L_PG7600/L
/10.	MOVE DCB AND RESIDENCY TABLES INTO 17600 IMAGE	[BOOT6]
/11.	MOVE BOOTSTRAP INTO PAGE 7600 IMAGES (2 PLACES)	[BOOT7]
/12.	WRITE OUT HANDLERS				[BOOT8]
/13.	ZERO DIRECTORY IF REQUESTED			[BOOTD]
/14.	PUT SYS, DATA BREAK, CORE LIM IN 07600 IMAGE	[BOOTE]
/15.	WRITE 7600 IMAGES BACK OUT ONTO TAPE		[BOOTF]
/	IF NEW SYS IS 1-PAGE, PG7600/L_BLOK66/L
/	0_PG7600
/	66_BLOK66
/16.	READ BACK PAGE 7600 IMAGES.  MOVE IN FIELD 1 STUFF
/	EXCEPT FOR CD AREA, RESTORE TODAY'S DATE,
/	BRANCH TO 7600
GETSLOT,0
	ISZ SLOT	/USE NEXT SLOT
	TAD SLOT
	TAD (-26
	SNA CLA
	JMP I (NOSLOT
	TAD SLOT
	JMP I GETSLOT

BOOT,	ISZ I (RETSW	/***?
	CLA IAC
	DCA I (BD	/DISABLE 'BUILD' CMD
/SEE IF ARGUMENT WAS GIVEN; TREAT IT AS BOOT DEVICE,
/SAVE HANDLER ADDRESS (MUST BE AN ACTIVE HANDLER)
	JMS I (LOCSYS	/IN CASE DSK=SYS
/	JMS I [GETNUM
/	NOP
/	TAD SIZE
/	DCA BOOTDV	/CHECK THAT # IS GT 7600
BOOT2,	TAD DSKG1	/FIND OUT ABOUT 'DSK'
	SNA
	JMP GOTD	/DSK=SYS
	DCA SAV1
	TAD DSKG2
	DCA SAV2
	TAD DSKP1
	DCA NAME1
	TAD DSKP2
	DCA NAME2
	JMS I [BIGNAM	/FIND IT IN TABLES
GOTD,	GET
	DCB
	SMA CLA		/IS IT FILE-STRUCTURED?
	JMP I (DSKBAD	/NO
	GET		/YES
	DSKBIT
	RTL
	STL RTR		/TURN ON BIT 1
	PUT
	DSKBIT
	JMP I (BOOT2A
GETDCB,	0
	GET
	PLATNUM
	JMS I [ROTL
	AND [7		/GET # OF PLATTERS
	SNA
	IAC		/0 MEANS 1
	TAD [-1		/SUBTRACT 1
	CLL RTL
	RAL		/TIMES 10
	DCA TMP1
	GET
	DCB
	AND [7770	/MASK OFF USEFUL INFO
	TAD TMP1
	JMP I GETDCB
SLOTDSK,0
	JMS I (CHKRES
	JMP SMPG
	TAD NEWPAG
	DCA I (SBUFF+1
	JMS GETSLOT
	JMS SETSLT
B,	DCA I (SHND+1
	JMS GETDCB
	DCA I (SDCB+1
	TAD (5723	/'DSK' HASHED
	DCA I (SNAME+1
	GET
	SYSBIT
	RTL		/SYSBIT TO L, CORES BIT TO AC0
	SNL SMA CLA	/IS IT EITHER SYS OR CORESIDENT WITH SYS?
	JMP NORE2	/NO, SO IT'S NOT CORE-RESIDENT
	GET		/YES, RESIDENT AT ALL TIMES IN 07600
	ENTPT
	AND [177
	TAD [7600
NORE2,	DCA I (SRES+1
	JMP I SLOTDSK

SETSY,	TAD NEWPAG
	DCA I (SBUFF
/	JMS SETSLT	/NO BLOCK SLOT
	DCA I (SHND
	JMS GETDCB
	DCA I (SDCB	/SET DCB
	TAD I (SNAME
	SZA CLA
	JMP I (TWOSYS
	TAD (4631	/HASH CODING FOR 'SYS'
	DCA I (SNAME
/CHECK THAT NAME IS 'SYS'
	TAD [7607
	DCA I (SRES
/CHECK REL ENTRY PT IS 7
	JMP I (INACT

SMPG,	TAD SLOT
	JMS SETSLT
	JMP B
SETSLT,	0
	SNA
	JMP .+3
	TAD [-15
	JMS I [ROTR
	DCA TMP1
	GET		/
	CORES		/
	RTL		/
	SPA SZL CLA	/
	JMP I SETSLT	/SYS &CORES HANDLERS GET 0 ENTRY (UNFORTUNATELY)
	GET
	ENTPT
	AND (4177
	TAD TMP1
	JMP I SETSLT


	PAGE
	USRBLK=13	/BLOCK OF USR ON SYSTEM DEVICE
	USRNPT=36	/POINTS TO USR PTR TO PERMANENT DEVICE NAME TABLE
	USRHPT=37	/POINTS TO USR PTR TO DEVICE HANDLER INFORMATION TABLE

BOOTC,	TAD [200	/READ FIRST BLOCK OF USR
	JMS I [SYS
	BUFFER		/INTO BUFFER
	USRBLK
	TAD I [BUFFER+USRNPT	/GET POINTER TO NAME TABLE
	TAD [BUFFER-400	/ADD IN OFFSET FOR RELOCATION
	DCA T1AD	/ASSUME BOTH TABLES OCCUR IN THE SECOND
	TAD I [BUFFER+USRHPT	/BLOCK OF THE USR
	TAD [BUFFER-400
	DCA T2AD	/GET POINTER TO DHIT
	TAD [400	/READ BLOCKS 2 AND 3 OF USR
	JMS I [SYS	/INTO BUFFER,BINARY
	BUFFER
	USRBLK+1
	TAD [-17
	JMS I [MOVE	/MOVE IN PERMANENT DEVICE NAME TABLE
	CDF 0
	SNAME
	CDF 0
T1AD,	HLT
/	TAD SAMSYS	/WAS SYS SPECIFIED?
/	SZA CLA
/	JMP CHKD2	/YES
/	TAD I T2AD	/NO, USE CURRENT SYS INFO
/	DCA I (SHND
/CHKD2,	TAD DSKG1
/	SZA CLA		/WAS DSK SPECIFIED?
/	JMP MVSHND	/YES
/	TAD I T2AD	/MAKE SAME AS SYS
/	DCA I (SHND+1
MVSHND,	TAD [-17	/NOW PUT IN SLOT WORDS (DHIT)
	JMS I [MOVE
	CDF 0
	SHND
	CDF 0
TMP2,
T2AD,	HLT
	TAD [4400	/RE-WRITE USR
	JMS I [SYS
L5400,	BUFFER
	USRBLK+1
	JMP I [BOOT5
	IFNZRO BUFFER-5400 <ERRRR,XX>
BOOTD,	TAD DRECT	/WANT NEW DIRECTORY?
SNACLA,	SNA CLA
	JMP BOOTE
	TAD L5400	/YEP. WRITE ONE
	JMS I [SYS
	DPROPR
	1
BOOTE,	TAD NEWCOR
	CLL RAL
	RTL
	TAD SAVHID	/V3D SET NEW H.O. DATE WORD
	DCA I [7777	/SET UP NEW CORE LIMIT
	TAD SYSLOC	/MOVE IN FRESH COPY OF SYS HANDLER
	TAD [7
	DCA SYSL2
	TAD [7607-7743-1
	JMS I [MOVE
	CDF 10
SYSL2,	HLT
	CDF 0
	7607
	TAD [-200	/PUT SYS HANDLER INTO REC 0 BUFF. ???
	JMS I [MOVE
	CDF 0
	7600
	CDF 0
	PG7600+200	/RESIDENT F0 CODE
	JMS I (WRITCC	/WRITE CCB AND DATA BREAK FILLERS
	TAD [200
	TAD SYSLOC	/MOVE IN COPY OF 27600 AGAIN
	DCA SYSL3
	TAD [-200
	JMS I [MOVE
	CDF 10
SYSL3,	HLT
	CDF 10
	BLOK66+200
	JMP I (BOOTF

DRECT,	-1		/1 MEANS WRITE A ZERO DIRECTORY
			/0 MEANS DON'T TOUCH DIRECTORY
			/-1 MEANS ASK GUY FOR OPTION
/SEE IF NEW SYSTEM HAS SAME DCB AS CURRENT SYSTEM
/THIS MAY WELL CAUSE EXTRA I/O WHEN GOING FROM RF08=K TO RF08=M

BOOT3,	CDF 10
	TAD I (DATEWD
	DCA SAVDAT	/SAVE TODAY'S DATE FOR FUTURE REFERENCE
	TAD I (DCBTBL	/GET DCB OF CURRENT SYSTEM
	CDF 0
	AND [7770
	DCA TMP2
	JMS I (PATCH	/V3D
	TAD SAVLOC	/DON'T COPY IF DID 'BUILD'
	SNA CLA		/WAS THE 'BU' COMMAND USED?
	TAD [-10	/NO, USE 'SZA CLA'
	TAD SNACLA	/YES, USE 'SNA CLA'
	DCA I (BOOTQ
	JMS SETUPSYS
	TAD SYSDCB
	CIA
	TAD TMP2
	JMP I (BOOTQ

/NOTE: THIS PROCEDURE DOESN'T COPY BOOTSTRAP IF NEW DEV=OLD DEV.
/	THEREFORE YOU CAN'T CHANGE BOOTSTRAPS
/	CHECK ON AFFECT FOR TD8E/ROM INTERACTION
SETUPSYS,0
	DCA SAVLOC
	TAD SAVLOC
	DCA I (SAVLC
	JMS I (LOCSYS
	JMS I [GETPG	/GET PAGE OF SYS HANDLER
	DCA SYSLOC	/PAGE OF START OF NEW SYSTEM HANDLER
	JMS I (GETDCB
	DCA SYSDCB
	JMS I (GETLEN
	GET
	TWOPAG
	DCA I (SYSSIZ
	TAD I (SYSSIZ
	SMA CLA		/IS IT 1- OR 2-PAGES?
	JMP ONEPG	/GUESS WHAT THIS MEANS [HINT LOOK AT LABEL]
	STA
	TAD I (AMTCOR
	SNA CLA
	JMP I (NOTNUF	/WE CAN'T RUN IN 8 K
ONEPG,	TAD [-400
	JMS I [MOVE
	CDF 10
SYSLOC,	HLT		/MOVE SYSTEM HANDLER
	CDF 10
SAVLOC,	0		/TO 10000-10377
	JMP I SETUPSYS
	PAGE
FIRST,	0		/SUBROUTINE FOR LDABS IN FIELD 2
	TAD KLUD
	DCA NEWLIM
	CIF CDF 20
	JMP I FIRST

/0:	LOADING OS/8
/-2:	LOADING HEADER OF HANDLER
/-1:	LOADING HANDLER

HND,	CDF 20		/DATA FIELD 2
	TAD I (ORIGIN
	DCA KLUD
	TAD TABLMT
	CIF CDF 20		/BACK TO FIELD 2
	JMP I (ORI

KLUD,	0
NEWLIM,	0		/NEW END OF DESCRIPTORS


OK,	STA		/NOW USE ORIGIN TO TELL US HOW BIG A
	CDF 20
	TAD I (ORIGIN	/HANDLER WAS LOADED
	CDF 00		/BACK TO OUR FIELD
	AND [7600
	TAD [200	/REMEMBER THAT ORIGIN IS ONE GREATER
	DCA HNDPTR	/THAN ACTUAL LAST LOCATION.
			/BETTER TO USE 2-PAGE BIT
	TAD NEWLIM
	DCA TABLMT	/SET NEW TABLE TOP
	DCA I TABLMT	/NEED 0 AT END
	JMS I [COMMA
	JMP I (LOAD



NMER,	CIF 10		/V3C
	JMS I [200	/DISMISS USR FROM CORE
	11
	JMP I (NAMERR

IOPEN,	0		/PREPARE TO READ INPUT
	CLA CMA
	DCA I (CHCNT
	TAD I (JMPX	/RESTORE SWITCH
	DCA I (JMPGET
	TAD I (FILPTR	/RESULTS OF LOOKUP
	DCA I (RECNO
	DCA I (REOF
	TAD (CDF 0
	CDF 20		/OFF TO FIELD 2
	DCA I (XFIELD	/SETUP LDABS FOR FIELD 0
	CDF 00		/BACK TO FIELD 0
	JMP I IOPEN
	PAGE

/BLOCK 0 OF DEVICE CONTAINS INITIAL IMAGE
/OF 17600 FOLLOWED BY 07600

/17600-17646	CD AREA	INITIALLY CONTAINS BOOTSTRAP
/17647-17665	RESIDENCY TABLE
/17666		DATE
/17667-17677	PART OF OS/8 KBM
/17700-17740	PART OF OS/8 USR
/17741-17757	USER DEVICE NAME TABLE/ODT
/17760-17776	CONTROL WORD TABLE (DCB)
/17777		UNUSED

/07600-07606	PART OF OS/8 CODE
/07607-07743	SYSTEM HANDLER
/07744-07745	STARTING ADDRESS
/07746		JOB STATUS WORD (JSW)
/07747		MUST BE 0 (SOFSET)
/07750-07755	DATA BREAK LOCATIONS RESERVED FOR HARDWARE
/07756-07775	KBM AND ODT
/07776		MUST BE 0 (SBLOCK)
/07777		SOFTWARE CORE SIZE, BATCH FLAGS

/IF SYSTEM HANDLER IS TWO PAGES LONG, THEN WE HAVE INSTEAD:

/BLOCK 66 (LOWER) CONTAINS 17600 IMAGE
/BLOCK 66 (UPPER) CONTAINS 27600 IMAGE (MUST END WITH 4 ZERO'S)
/BLOCK 0  (LOWER) CONTAINS BOOTSTRAP
/BLOCK 0  (UPPER) CONTAINS 07600 IMAGE
	*4000
DSCADV,	0		/ADVANCE TO NEXT DESCRIPTOR
			/RETURN 2 MEANS NO MORE
			/RETURN 1 MEANS NOW AT BOOTSTRAP BLOCK
			/RETURN 3 OTHERWISE
	TAD DSCPTR
	TAD [HDRSIZ
	DCA DSCPTR
	JMS I (SKPCRD	/SKIP A POSSIBLE GROUP COUNT
	TAD I DSCPTR
	CLL
	TAD [200
	SZL CLA
	JMP I DSCADV	/TAKE RETURN1 UPON REACHING BOOTSTRAP RECORD
	ISZ DSCADV
	TAD I DSCPTR
	SZA CLA
	ISZ DSCADV	/TAKE RETURN 2 IF ADVANCED TO END
	JMP I DSCADV

/RETURN 1 MEANS NO MORE DESCRIPTORS
BOTADV,	0
	TAD I DSCPTR
	CIA
	IAC		/COUNT IS ONE MORE
	TAD DSCPTR
	DCA DSCPTR	/POINT TO BEGIN OF NEXT DESCRIPTOR
	JMS I (SKPCRD
	TAD I DSCPTR
	CLL
	TAD [200
	SZL CLA
	JMP BOTADV+1	/WIERD CASE OF CONSECUTIVE BOOTSTRAPS
	TAD I DSCPTR
	SZA CLA
	ISZ BOTADV	/TAKE RETURN1 IF ADVANCED TO END
	JMP I BOTADV

/WIERD CASES CAN OCCUR IF GUY DELETES ALL ENTRY POINTS IN A GROUP SEPARATELY

/DESCRIPTOR ENTRIES:

/FIRST WORD:
/	0		MEANS END OF TABLE
/	-1 TO -20	MEANS GROUP COUNT (NOT NECESSARILY ACCURATE)
/	-21 TO -400 APPROX MEANS BOOTSTRAP RECORD COUNT
/	OTHER		MEANS DESCRIPTOR
SYSCPY,	0		/COPY OS/8 SYSTEM
	STA
	TAD I (AMTCOR
	SZA CLA
	TAD [10		/GT 8K
	DCA CORBIT
	TAD CORBIT
	SZA CLA
	JMP COP2
	JMS I [SYSWP	/SWAP IN NEW SYS HANDLER
	TAD (7410
	JMS I [SYS	/SAVE PART OF BUILD TO MAKE A BIG BUFFER
	400		/SAVE 400-
	27		/SAVE IN BLOCK 27
	JMS I [SYSWP	/GET BACK ORIGINAL HANDLER
COP2,	TAD [4210
	JMS COPY	/COPY BLOCK 0
	0
	TAD (5610
	JMS COPY	/COPY 7-15
	7
	TAD [4210
	JMS COPY	/COPY 26
	26
	TAD (7410
	JMS COPY	/COPY 51-66
	51
	TAD [4210
	JMS COPY	/COPY 67
	67
	TAD CORBIT
	SZA CLA
	JMP COP3
	JMS I [SYSWP	/GET BACK NEW HANDLER FOR A MOMENT
	TAD (3410	/RESTORE CORE WE SAVED
	JMS I [SYS
	400
	27
	JMS I [SYSWP	/RESTORE ORIGINAL SYS HANDLER
COP3,	JMP I SYSCPY
COPY,	0
	TAD CORBIT
	DCA TMP1
	TAD I COPY
	DCA COPREC	/ARG 1 CONTAINS FIRST BLOCK TO COPY
	TAD COPREC
	DCA CPREC2	/MAKE TWO COPIES
	STL RAR		/CONVERT 'WRITE' TO READ
	TAD TMP1
	JMS I [SYS	/READ FROM ORIGINAL DEVICE
	400
COPREC,	HLT
	JMS I [SYSWP
	TAD TMP1
	JMS I [SYS	/WRITE ON NEW DEVICE
	400
CPREC2,	HLT
	JMS I [SYSWP	/LEAVE WITH ORIGINAL SYSTEM HANDLER STILL IN SYSTEM
	JMP I COPY	/FALL THROUGH RECORD NUMBER
CORBIT,
GETLEN,	0
	GET		/GET LENGTH OF DEVICE
	PLATNUM
	JMS I [ROTL	/GET NUMBER OF PLATTERS
	AND [7
	SNA
	IAC		/0 MEANS 1
	CIA
	DCA COUNT
	GET
	DEVSIZ
	DCA TMP1
SIZLUP,	TAD TMP1
	SNA
	STA		/4096 BECOMES 4095
	ISZ COUNT
	JMP SIZLUP
	CIA
	TAD [70		/LEAVE ROOM FOR OS/8
	DCA DLENGTH
	JMP I GETLEN

DPROPR,	-1		/INITIAL EMPTY DIRECTORY
	MFREE
	0
	0
	-1
	0		/1 EMPTY FILE
DLENGT,	0


BADARG,	JMS I [PRWD
	TEXT	/?ARG/
	JMP I [CONFIG
	PAGE
/WANT TO COPY

/SYS	0
/KBM	7-12
/USR	13-15
/ENTER	26
/CD	51-53
/SAVE,DATE 54-55
/ERR	56
/CHAIN	57
/ODT	60-63
/CCL	64,65,67
/SYS	66

/EXTRA (DON'T WANT TO COPY):

/HANDLERS	16-25
/SCRATCH	27-50

/NEW ALGORITHM:

/SET FIELD 2 IF 12K OR MORE AND SKIP *'ED ITEMS

/1.	MOVE NEW SYS HANDLER TO 0,200
/2.*	SAVE 34 PAGES STARTING AT 10400 IN BLOCK 27 OF NEW DEVICE
/3.	COPY BLOCKS 7-15
/4.	COPY BLOCK 26
/5.	COPY BLOCKS 51-66
/6.	COPY BLOCK 67
/7.*	RESTORE 34 PAGES
/THE FOLLOWING ROUTINES AND VARIABLES MUST BE ABOVE THE LOCATIONS
/IN WHICH OS/8 AND CD LOAD INTO, BECAUSE THEY ARE CALLED BY LDABS.
/FURTHERMORE, NONE OF THESE ROUTINES MAY USE PAGE 0 LITERALS
/OR MAY USE ANY PAGE 0 TEMPORARIES, EXCEPT THAT SOME MAY USE
/PAGE ZERO TEMPORARIES IF THE STORE INTO THEM FIRST
/(EXCEPT THOSE COMMENTED OTHERWISE, WHICH MUST PRESERVE
/THE NEW PAGE 0 AT ALL COSTS, UNTIL IT IS WRITTEN OUT

/LDABS
/ICHAR
/BADINP
/OVER
/ASSEMB
/CTCTST
/PRWD
/CTRLC
/OVROUT
/ROTL
/PRINTE
/TTYOUT
/ROTR
/PWORD
/ECHOFL
/LINEUP
/CRLF
/PRNT
/RUBFLG
/MOVE
/SYSWP
/AMTCOR
	SYDCB=7760	/LOCATION OF SYS,DSK DCB WORDS

BOOT5,	JMS I (RECZRO
BOOT6,	TAD [-17
	JMS I [MOVE	/PUT RESIDENT FIELD 1 TABLES INTO
	CDF 0
	SDCB		/FIXED SPOTS
	CDF 10
	BLOK66+160
	TAD [-17
	JMS I [MOVE
	CDF 0
	SRES
	CDF 10
	BLOK66+47	/COULD SET USER DEVICE NAMES HERE IF DESIRED
BOOT7,	JMS I (LOCSYS
/	TAD SAMSYS
/	SZA CLA		/SAME SYSTEM?
/	JMP BOOT8	/YES
BLOOK,	ADVDSC		/SEARCH FOR BOOTSTRAP
	JMP FNDBOT	/FOUND BOOTSTRAP RECORD AMONGST DESCRIPTORS
	HLT		/IT WASN'T THERE!
	JMP BLOOK	/KEEP LOOKING

FNDBOT,	TAD DSCPTR
	IAC		/POINT TO BOOTSTRAP
	DCA FROMBO
	TAD I DSCPTR	/LENGTH OF BOOTSTRAP
/CHECK THAT'S IT'S LE 47 LOCS IF 1-PAGE SYSTEM
	JMS I [MOVE
	CDF 0
FROMBO,	HLT
	CDF 0
	PG7600
	TAD [-47	/MOVE FIRST 47 LOCS INTO CD AREA IN 17600 IMAGE
	JMS I [MOVE
	CDF 0
	PG7600
	CDF 10
	BLOK66
BOOT8,	TAD (-16
	DCA COUNT
	TAD (SBUFF
	DCA XR1
	TAD (SHND
	DCA XR2
DVLOOP,	TAD I XR1
	SNA
	JMP NOHN
	DCA DVBUF	/LOCATION OF HANDLER
	TAD I XR2
	JMS I [ROTL
	AND [17
	SNA
	JMP CN		/NO BLOCK SLOT
	TAD L15		/CONVERT TO ACTUAL BLOCK #
	DCA DVREC
	TAD [4210
	JMS I [SYS
DVBUF,	HLT
DVREC,	HLT
CN,	ISZ COUNT
	JMP DVLOOP
	JMP I (BOOTD
NOHN,	ISZ XR2
	JMP CN

SYSSIZ,	0		/MINUS MEANS 2-PAGE SYS HANDLER
CTRLC,	KCC		/CLEAR ^C FLAG
	TAD I (SWAPER	/DO WE HAVE TO SWITCH?
	SZA CLA
	JMS I (SYSWP	/YES. INSERT OLD HANDLER
	JMP END	/GO CHECK BATCH BEFORE RETURNING

KORE,	JMS I [GETNUM
L15,	15		/NOTHING MEANS 0
	TAD SIZE
	AND [7770
	SZA CLA
	JMP I [BADARG	/MUST BE BETWEEN 0 AND 7
	JMS I (RELCOR	/FIND REAL AMOUNT OF CORE
	CMA
	TAD SIZE
	SMA CLA
	JMP I (NOTNUF	/MUST BE .LE. REAL AMT OF CORE
	TAD CHAR
	SZA CLA
	JMP I [SYNTAX
	TAD SIZE
	DCA NEWCOR
	JMP I [CONFIG
/	IF NEW SYS IS 1-PAGE,   PG7600/L_BLOK66/L
/	0_PG7600
/	66_BLOK66

BOOTF,	TAD SYSSIZ
	SMA CLA		/IS NEW SYS TWO PAGES?
	TAD [-200	/NO
	JMS I [MOVE	/YES, NULL MOVE
	CDF 10
	BLOK66
	CDF 0
	PG7600
	TAD [4200
	JMS I [SYS
	PG7600
	0
	TAD [4210
	JMS I [SYS
	BLOK66
	66
BOOTG,	NOP
/	JMS I (RECZRO	/SIMULATE BOOTSTRAP
	TAD [-131	/MOVE UP FIELD 1 CODE
	JMS I [MOVE
	CDF 10
	BLOK66+47
	CDF 10
	7600+47
	TAD SAVDAT
	CDF 10
	DCA I (DATEWD
	CDF 0
	JMS I [PRWD
	TEXT /SYS BUILT/



/MUST DO SOME CLEAN UP IF BATCH IS RUNNING
/ALL OVERLAYED CODE MUST BE RESET IN CASE USER WANTS
/TO REUSE THIS COPY OF BUILD.

END,	JMS I BATT	/JUMP TO BATCH TEST ROUTINE FOR CLEAN UP
	JMP I [7600	/OTHERWISE GO HOME WITH NEW SYSTEM
			/THIS IS FROM BATCH
	PAGE


/MOVE MOVES CORE AROUND	(CALLABLE FROM ANY FIELD)

/	TAD (-# OF LOCS TO MOVE
/	JMS MOVE
/	CDF FROM FIELD
/	FROM BUFFER LOCATION START
/	CDF 'TO' FILED
/	TO BUFFER

/MUSTN'T DESTROY OS/8 LOCS, NO PAGE 0 TEMPS!

MOVE,	0
	DCA MVCT
	RDF
	TAD (CIF CDF
	DCA MOVRET
	TAD I MOVE	/GET CDF FROM-FLD
	DCA MVCDF2
	ISZ MOVE	/POINT TO FROM-BUF
	TAD I MOVE	/GET LOC TO MOVE
	DCA MVTM1
	ISZ MOVE	/POINT TO TO-CDF
	TAD I MOVE
	DCA MVDF	/GET CDF TO FIELD OF DESTINATION
	ISZ MOVE	/POINT TO TARGET AREA
	TAD I MOVE
	DCA MVTM2
	ISZ MOVE	/POINT TO RETURN
	TAD MVCT
	SNA CLA
	JMP MOVRET	/NOTHING TO MOVE
MVCDF2,	CDF 0		/GETS ALTERED TO PICK UP F1
	TAD I MVTM1
MVDF,	HLT
	DCA I MVTM2
	ISZ MVTM1	/BUMP POINTERS TO AREAS
	ISZ MVTM2
MV20,	20
	ISZ MVCT
	JMP MVCDF2
MOVRET,	HLT		/RETURN TO CALLING FIELD
	JMP I MOVE

CTCTST,	0
	TAD MV7600	/ALLOW FOR PARITY
	KRS
	TAD (-7603
	SNA CLA
	KSF
	JMP I CTCTST
	JMP I (CTRLC
MVCT,	0


ASSEMB,	0		/ASSEMBLE TWO 6 BIT WORDS
	CDF 20
	TAD I LWD1
	JMS I PROTL
	TAD I LWD2
	CDF 00
	JMP I ASSEMB

LWD1,	WD1
LWD2,	WD2
PROTL,	ROTL

BOOT4,	TAD I (DRECT
	SMA CLA
	JMP I (BOOTC	/HE'S SPECIFIED ABOUT DIRECTORY ZERO
	JMS I [PRWD	/YES, NO NEED TO COPY SYSTEM
	TEXT	/WRITE ZERO DIRECT?/
	TAD [-10	/DON'T WANT TO DESTROY PRECIOUS TABLES
	JMS I [GTEXT	/GET REPLY
	JMP BOOT4
	JMS I [GNAME
	TAD NAME1
	AND [7700
	TAD (-3100
	SNA CLA
	CLA IAC		/Y
	DCA I (DRECT	/NO; COULD HAVE SAVED LOCATION BUT I FEEL SAFER THIS WAY
	JMP I (BOOTC

MVTM1,
ROTL,	0
	CLL RTL
	RTL
	RTL
	JMP I ROTL

MVTM2,
ROTR,	0
	CLL RTR
	RTR
	RTR
	JMP I ROTR
TTYOUT,	0		/YOU GUESSED IT
	DCA TM
	TAD ECHOFL
	SZA CLA		/ARE WE ECHOING?
	JMP I TTYOUT	/NO
	TAD TM		/YES
	TLS
	TSF
	JMP .-1
MV7600,	7600		/CLA
	JMS I (CTCTST	/TEST FOR ^C.
	JMP I TTYOUT

TM,
SKPCRD,	0
	TAD I DSCPTR
	CLL
	TAD MV20		/A GROUP COUNT MUST BE IN THE RANGE -1 TO -20
	SNL CLA
	JMP I SKPCRD
	ISZ DSCPTR	/IT'S A DARN GROUP COUNT, GO PAST IT
	JMP SKPCRD+1	/WIERD CASE OF CONSECUTIVE GROUP COUNTS

ECHOFL,	0		/1 MEANS NOT ECHOING, SAW ^O
PATCH,	0
	TAD I [7777	/V3D
	AND L600
	DCA SAVHID	/SAVE HIGH ORDER DATE BITS
	JMP I PATCH
	PAGE
PRNAME,	0		/ROUTINE TO PRINT NAME1-NAME4
	TAD (NAME1
	DCA TEMP
	CLL STA RTL	/-3
	DCA COUNT
PRNM2,	TAD I TEMP
	JMS PRINTE	/TYPE OUT CHARS
	ISZ TEMP
	ISZ COUNT	/EXHAUSTED ALL?
	JMP PRNM2
	TAD I TEMP
	SNA CLA
	JMP I PRNAME	/NO . IF NO EXTENSION
	TAD (".		/PRINT '.'
	JMS I (TTYOUT
	TAD I TEMP
	JMS PRINTE
	JMP I PRNAME

PRINTE,	0
	DCA CHTMP2
	TAD CHTMP2	/EXTRACT LEFT HAND SIDE
	JMS I (ROTR
	JMS PWORD
	TAD CHTMP2
	JMS PWORD
	JMP I PRINTE
PWORD,	0
	AND (77
	SNA		/IF NULL, GET OUT
	JMP NULL
	DCA PRTM
	TAD (200
	KRS
	TAD (-217	/^O
	SNA CLA		/STOP ECHOING?
	KSF		/MAYBE
	SKP		/NO
	JMP CTO		/YES
	TAD PRTM
	TAD (240
	AND (77
PRSPAC,	TAD (240
	JMS I (TTYOUT
	JMP I PWORD
NULL,	TAD LINEUP
	SNA CLA		/PRINT SPACE?
	JMP I PRINTE	/NO
	JMP PRSPAC	/YES

PRWD,	0
	CLA
PRWD2,	TAD I PRWD
	JMS PRINTE
	TAD I PRWD
	ISZ PRWD
	AND (77
	SZA CLA
	JMP PRWD2
	JMP I PRWD	/LEAVE IF LAST WORD ENDED WITH 00

CHTMP2,	0

CTO,	KCC
	TAD ("^
	JMS I (TTYOUT
	TAD ("O
	JMS I (TTYOUT
	JMS CRLF
	CLA IAC
	DCA I (ECHOFL
	JMP I PWORD

LINEUP,	0		/NON-ZERO MEANS PRINT NULLS AS SPACES
OVER,	JMS I (ASSEMB	/EXTENSION OF LDABS.
	CIA
	CDF 20		/OFF TO FIELD 2
	TAD I LCKSUM	/CHECKSUM OK?
	CDF 00		/BACK TO OUR FIELD
	SZA CLA
	JMP BADINP	/SOORY ABOUT THAT
	CLA IAC
	JMP OVROUT	/SKIP ERROR EXIT
BADINP,	JMS PRWD
	TEXT /?BAD INPUT/
	JMS CRLF
OVROUT,	CDF 20
	TAD I (LDABS
	CDF 00
	DCA OTEMP
	JMP I OTEMP
OTEMP,	0


LCKSUM,	CKSUM
PRTM,	0
CRLF,	0
	TAD (215
	DCA NAME1
	JMS PRNT
	TAD (212
	JMS I (TTYOUT
	JMP I CRLF

PRNT,	0		/CHARACTER PRINT ROUTINE
	TAD ("\		/IF NOT RUBOUT, AND IF RUBOUT WAS
	ISZ RUBFLG	/LAST, ECHO \.
	SKP CLA
	JMS I (TTYOUT
	TAD NAME1
	JMS I (TTYOUT
	JMP I PRNT
RUBFLG,	0		/RUBOUT FLAG
	PAGE
/ASSUMES NEW PROPOSED SYSTEM HANDLER IS IN 10000-10377

/CAN'T DESTROY OS/8, IE. CAN'T USE PG 0 TEMPS

SYSWP,	0		/ROUTINE TO MOVE SYS HANDLER AROUND
	ISZ SWAPER	/DIDDLE SWAP INDICATOR
	CLA CMA		/-1 MEANS NEW HANDLER IS IN
	DCA SWAPER
	STA
	TAD AMTCOR
	SNA CLA		/DO WE HAVE 8K?
	JMP SWAPLW	/YES, DON'T SWAP WITH FIELD 2
	TAD L7600	/NO, CAN'T HURT TO SWAP FIELD 2
	DCA OUT
	TAD SAVLC
	TAD P200
	DCA IN
	TAD (4-200
	DCA STEMP	/SWAP ENTIRE PAGE (EXCEPT LAST 4 LOCATIONS)
SWAP3,	CDF 10		/SWAP 27600 & 2ND PAGE OF HANDLER
	TAD I IN
	DCA SYSQ
	CDF 20
	TAD I OUT
	CDF 10
	DCA I IN
	TAD SYSQ
	CDF 20
	DCA I OUT
	ISZ IN
L7400,	7400		/NOP
	ISZ OUT
L7600,	7600
	ISZ STEMP
	JMP SWAP3
SWAPLW,	CDF 0
	TAD (7607
	DCA OUT		/7607 ALWAYS TARGET DESTINATION
	TAD SAVLC
	TAD (7
	DCA IN
	TAD (7607-7743-1/ONLY 7607-7743 GETS MOVED
	DCA STEMP
SWAP2,	CDF 10
	TAD I IN
	DCA SYSQ	/TEMP STORE
	CDF 0
	TAD I OUT
	CDF 10
	DCA I IN
	TAD SYSQ
	CDF 0
	DCA I OUT
	ISZ IN
	ISZ OUT
	ISZ STEMP
	JMP SWAP2
	DCA I (SOFSET	/V3C
	JMP I SYSWP

AMTCOR,	1		/HIGHEST CORE BANK
SAVLC,	0		/MUST BE ABOVE 3577
CHTMP,
IN,	0		/POINTS TO HANDLER AREA AT ONE NAMED SYS
OUT,	0		/POINTS TO 7607 HANDLER
SWAPER,	0		/-1 MEANS NEW HANDLER IN

/MUST BE ABOVE OS/8,  NO PAGE 0 LITERALS

STEMP,
ICHAR,	0
	JMS I (CTCTST
	ISZ JMPGET	/POINT TO CORRECT CHAR
	ISZ CHCNT	/NEED WE READ?
JMPX,	JMP JMPGET	/NOT YET
	TAD REOF	/YES. DID LAST YIELD EOF?
	SZA CLA
	JMP I (BADINP	/SOMETHING IS WRONG.
RDIN,	JMS I DVICE
P200,	0200		/READ INTO FIELD 0
BINBUF,	BINARY
RECNO,	0
	JMP RERROR	/READ ERROR
RECNO2,	ISZ RECNO	/POINT TO NEXT RECORD
	TAD (-601
	DCA CHCNT	/NEW CHARACTER COUNT
	TAD BINBUF
	DCA CHPTR
	TAD JMPX
	DCA JMPGET	/RESET JUMP SWITCH
	JMP ICHAR+1
SYSQ,
JMPGET,	JMP .		/IF WE GET CAUGHT HERE, WE KNOW IT
	JMP CHAR1	/ASSEMBLE FIRST CHAR
	JMP CHAR2	/SECOND CHAR
	TAD JMPX	/THIRD CHAR HERE
	DCA JMPGET	/RESET SWITCH
	TAD I CHPTR
	AND L7400
	CLL RTR
	RTR
	TAD CHTMP	/ADD IN THE LAST TEMP STORE
	RTR
	RTR
	ISZ CHPTR	/TO NEXT CHAR
	JMP GCHCOM
CHAR2,	TAD I CHPTR
	AND L7400
	DCA CHTMP	/SAVE FOR THIRD CHAR
	ISZ CHPTR
CHAR1,	TAD I CHPTR
GCHCOM,	AND (377
	ISZ ICHAR	/PASS UP ERROR RET
	JMP TO20		/RETURN
RERROR,	SPA CLA		/FATAL, OR EOF?
	JMP IOERR	/FATAL
	ISZ REOF	/END OF FILE
	JMP RECNO2	/BACK TO MAINSTREAM
IOERR,	JMS I (PRWD
	TEXT	\?I/O\
TO20,	CIF CDF 20		/BACK TO FIELD 2
	JMP I ICHAR


REOF,	0
CHCNT,	0
CHPTR,	0
DVICE,	0
RETSW,	0		/0 MEANS RAN FROM 0S/8, 1 MEANS RNA STANDALONE
	PAGE
	LNLNGT=103
BEGLIN,	ZBLOCK LNLNGT

	SBLOCK=7776	/??
/CTCFAK,	.+1		/^C MUST NOT RETURN TO ANY SYSTEM.
/	JMP I CTCFAK	/CTCFAK MARKS OUR PLACE DURING
/			/SYSGEN, AND ^C WILL RETURN TO THAT PLACE.
/*** THIS STUFF GOES AWAY ON A BOOT

BUILD,	CDF 10
	TAD I [7200	/HAS SPECIAL CODE BEEN OVERLAID BY HANDLERS?
	CDF 0
	TAD [-1234
	SZA CLA
	JMP I (NOROOM	/YES, TOO BAD
/	TAD (5601
/	DCA I [7600
/	TAD (CTCFAK+1
/	DCA I (7601
	TAD [6600	/SAVE OLD SYSTEM HANDLER IN 16600
	JMS I (SETUPSYS
/	JMS CTCFAK
RDOS8,	JMS I [PRWD
	TEXT	\LOAD OS/8: \
	JMS RD
	JMP RDOS8
	CIF CDF 10
	JMS I (WROS8
	JMS I (SYSWP
/	JMS CTCFAK
RDCD,	JMS I [CRLF
	JMS I [PRWD
	TEXT	/LOAD CD: /
	DCA DVER
	JMS RD
	JMP RDCD
	CIF CDF 10
	JMS I (WRCD
	TAD I (RETSW
	SNA CLA		/NOT IF FROM SCRATCH
	JMS I (SYSWP	/GET OLD HANDLER IF ANY BACK IN
	JMP I [CONFIG
RD,	0
	TAD [-40
	JMS I [GTEXT
	JMP I RD
	JMS I (SETUP
DVER,	JMP I (NODEV
	JMS I (SYSWP	/PUT IN NEW HANDLER
	CIF CDF 10
	JMS I (SAVE
	JMS I (SYSWP
	CIF CDF 20	/OFF TO PAGE 2
	JMS I [LDABS	/PAST HERE PAGE 0 IS GONE
	JMP I RD
	JMS I (SYSWP
	ISZ RD
	JMP I RD
	PAGE
	*6400

DSCTAB,	ZBLOCK 1200
/RELIC:

	*7600
	0		/ONLY LOADED FROM PAPER TAPE.

	*7777
	0		/SET SOFTWARE CORE SIZE TO 'UNKNOWN'
	FIELD 1
	*0
	0		/FORCE ABSLDR TO LOAD THIS PAGE
	*400
/	ZBLOCK 5400
	0
	*6600

	RELOC BINARY

BINPUN,	CDF 10
	CLA
	TAD (-400
	CIF 0
	JMS I (MOVE
	CDF 10
	6600
	CDF 0
	BINARY		/MOVE ONESELF DOWN
	CIF CDF 0
	JMP I (LDR	/EXECUTE IN FIELD 0
LDR,	JMS LEDER	/PUNCH 72 FRAMES OF 200
	DCA CHECK	/0 CHECKSUM
	TAD (102
	JMS CKSUMM
	JMS PNCH
STARTB,	JMS I (CRLF
	TAD ("*
	JMS I (TTYOUT
	TAD (-100
	JMS I (GTEXT
	JMP STARTB
	JMS I (GETNUM
	JMP I (OVERB
	TAD SIZE
	AND (7770
	SZA CLA
	JMP STARTB
	TAD SIZE
	CLL RTL
	RAL
	DCA FLD
	JMS I (GETNUM	/GET LOWER LIMIT
	JMP STARTB
	TAD SIZE
	DCA LIM1
	JMS I (GETNUM	/GET UPPER LIMIT
	JMP STARTB
	TAD SIZE
	DCA LIM2
	TAD LIM2
	CMA
	TAD LIM1
	DCA COUNT2
	TAD FLD
	TAD (300
	JMS PNCH
	TAD FLD
	TAD (CDF 0
	DCA BUFLD
	TAD LIM1
	JMS I (ROTR
	AND (77
	TAD (100
	JMS CKSUMM
	TAD LIM1
	AND (77
	JMS CKSUMM
BUFLD,	HLT
	TAD I LIM1
	JMS I (ROTR
	AND (77
	JMS CKSUMM
	TAD I LIM1
	AND (77
	JMS CKSUMM
	ISZ LIM1
	ISZ COUNT2
	JMP BUFLD
	CIF CDF 0
	JMP STARTB
LEDER,	0		/PUNCH LEADER/TRAILER
	TAD (-200
	DCA COUNT2
	TAD (200
	JMS PNCH
	ISZ COUNT2
	JMP .-3
	JMP I LEDER

PNCH,	0
	PLS
	PSF
	JMP .-1
	CLA
	JMP I PNCH

FLD,	0
LIM1,	0
LIM2,	0
COUNT2,	0
CHECK,	0

CKSUMM,	0
	DCA CK1
	TAD CK1
	TAD CHECK
	DCA CHECK
	TAD CK1
	JMS PNCH
	JMP I CKSUMM

CK1,	0
	PAGE
OVERB,	TAD Q300
	JMS I QPNCH	/FIELD 0
	TAD Q176
	JMS I QCKSUM
	JMS I QCKSUM	/*7600
	TAD Q74
	JMS I QCKSUM
	STL CLA RTL
	JMS I QCKSUM	/HALT
	TAD Q177
	TAD Q77
	JMS I QCKSUM	/*7777
	JMS I QCKSUM
	JMS I QCKSUM	/*0000
	TAD Q102
	JMS I QCKSUM
	JMS I QCKSUM
	TAD I QCHECK
	JMS I QROTR
	AND Q77
	JMS I QPNCH
	TAD I QCHECK
	AND Q77
	JMS I QPNCH
	JMS I QLEDER
	HLT
	JMP .-1	/ALL DONE
Q300,	300
QPNCH,	PNCH
Q176,	176
QCKSUM,	CKSUMM
Q74,	74
Q177,	177
Q77,	77
Q102,	102
QCHECK,	CHECK
QROTR,	ROTR
QLEDER,	LEDER
	PAGE

	RELOC
	DIRLOC=1400	/FROM OS/8 ASSEMBLY

	READ=JMS I (7607
	WRITE=READ
	MFREE=70
	ERR=JMS I (WRERR

	*7200


	1234		/MAGIC NUMBER WHICH IF NOT HERE, MEANS HANDLERS OVERLAID

WROS8,	0
	CIF 0
	TAD Z7600
	JMS I (MOVE	/SAVE CURRENT 7600
	CDF 0
	7600
	CDF 0
	7000		/IN 07000
	TAD (-7		/MOVE 6600 TO 7600
	CIF 0
	JMS I (MOVE
	CDF 0
	6600
	CDF 0
	7600
	TAD (-34	/FINISH MOVING FIELD 0
	CIF 0
	JMS I (MOVE
	CDF 0
	6744
	CDF 0
	7744
	CDF 0
	TAD (6		/V3D DEV EXT LENGTH OF ABSLDR
	TAD I (DLENGTH	/FILL IN INITIAL LENGTH
	CDF 10
	DCA I (DIRLOC+14	/OS8 HAS INITIAL DIRECTORY
	CIF 0;WRITE;4200;7400;0;ERR	/INITIAL REC.0
	CIF 0;WRITE;4200;7400;66;ERR	/ALSO WRITE RECORD 66
	CIF 0;WRITE;4210;DIRLOC;1;ERR	/INITIAL DIRECTORY
	CIF 0;WRITE;5000;0;7;ERR	/KBM
	CIF 0;WRITE;4610;0;13;ERR	/USR
	CIF CDF 20	/OFF IN FIELD 2
	JMP I (BAK
WHER,	CDF 0	/RETURN FROM RELOCATED ROUTINES.
	TAD I (RETSW
	CDF 10
	SNA CLA		/SCRATCH BUILD?
	JMP I (RES76	/NO
	TAD Z7600	/YES	/MOVE 17600 UP THERE
	CIF 0
	JMS I (MOVE
	CDF 0
	7400
	CDF 10
Z7600,	7600
	JMS I (RESTORE
	CIF CDF 0
	JMP I WROS8

/RELATIONSHIP BEWTWEEN OS/8 CORE IMAGE AND BLOCKS ON SYSTEM DEVICE:

/ITEM		CORE LOC	BLOCKS

/KBM		0000-1777	7-12
/OVERLAYS	2000-3577	54-57
/INIT DIR	DIRLOC-		1
/ABSLDR CCB	LDRCTL-		70
/INIT BLOCK 0	7400-7777	0
/USR		10000-11377	13-15
/ABSLDR			12000-14377	71-75
/ENTER		13400-13577	26
/EXT MEM SAVE & ODT				64
/SYS	06600-06606	PART OF 07600
/SYS	06744-06777	"
WRCD,	0
	CIF 0;WRITE;4600;0;51;ERR	/CD
	CIF 0;WRITE;5011;0;60;ERR	/ODT

/THE NEXT ROUTINE IS TO FINISH LOADING BLOCK 64 OF THE
/SYSTEM DEVICE THAT HAD BEEN RESERVED.  THE FIRST PART
/WAS WRITTEN WITH OS8 AND NOW THE OTHER PART MUST BE
/WRITTEN ON THAT SAME BLOCK FROM CD.

	CIF 0;READ;210;0;64;ERR		/GET PART OF ODT WRITTEN
	/MOVE LOCATIONS 11600-11663 TO 10000-10063
	CIF 0
	TAD (-64
	JMS I (MOVE
	CDF 10
	1600
	CDF 10
	0000
	CIF 0;WRITE;4210;0;64;ERR

/END OF ROUTINE TO LOAD BLOCK 64

	JMS I (RESTORE
	JMS I (CASIT
	CIF CDF 0
	JMP I WRCD
	PAGE
	READ=JMS I (7607
	ERR=JMS WRERR

/SPECIAL CODE TO CHAIN TO ABSLDR, TO READ IN MCPIP

	JMS I (7700
	10		/LOCK USR IN CORE
	TAD R7600	/ZERO CD AREA
	DCA CDPTR
	TAD (-47
	DCA CDKNT
	DCA I CDPTR
	ISZ CDPTR
	ISZ CDKNT
	JMP .-3
	STL CLA RAR	/ALTMODE
	DCA I (7642
	JMS I (200
	12		/INQUIRE
	4503	/ENCODE CSA0
CDN,	0
	0
	HLT
	TAD CDN		/TAKE DEVICE NUMBER
	DCA I (7617	/STORE DEVICE NUMBER OF CASSETTE
	ISZ I (7620	/V3C FORCE BLOCK 1
	CLA IAC
	CDF 0		/V3D
	DCA I (7746	/SET JSW SO CHAIN DOESN'T DO USROUT
	CDF 10
	JMS I (200	/CHAIN TO ABSLDR
	6
	70
RESTORE,0
	CIF 0;READ;3701;0;BLDSAV;ERR
	CIF 0;READ;3510;0;BLDSAV+20;ERR	/RESTORE BUILD
	JMP I RESTORE
	WRITE=JMS I (7607
	ERR=JMS WRERR

SAVE,	0
	CDF 0
	DCA I (SOFSET
	DCA I (SBLOCK
	DCA I (DRECT	/HAVE TO KEEP DIRECTORY LATER
	CDF 10
	CIF 0;WRITE;7701;0;BLDSAV;ERR
	CIF 0;WRITE;7510;0;BLDSAV+20;ERR
	JMS CASIT
	CIF CDF 0
	JMP I SAVE

RES76,	TAD I (Z7600
	CIF 0
	JMS I (MOVE
	CDF 0
	7000		/RESTORE OLD PAGE 7600
	CDF 0
	7600
	JMP I (Z7600
WRERR,	0		/WRITE ERROR
	HLT CLA		/HIT CONTINUE TO RETRY
	TAD WRERR
	TAD (-6
	DCA WRERR	/POINT BACK TO CIF OF CALL
	JMP I WRERR	/RETRY

/RELATIONSHIP BETWEEN CD CORE IMAGE AND BLOCKS ON SYSTEM DEVICE:

/ITEM		CORE LOC	BLOCKS
/CD		00000-01377	51-63
/ODT		10000-11777	60-63

CSA,	0		/CASSETTE HANDLER ENTRY PT
CDPTR,	0

CDKNT,
CASIT,	0
	CDF 0
	TAD I (RECNO
	SNA
	CLA IAC		/IF BLOCK 0, CHANGE TO 1
	DCA I (RECNO
	TAD I PRETSW
	SNA CLA		/BUILDING FROM SCRATCH?
	JMP I CASIT	/NO
	TAD I (BLDCB	/YES, GET DCB OF LOAD HANDLER
	AND L770
	TAD M270	/CASSETTE DEVICE CODE=27
	SZA CLA
	JMP I CASIT	/NOT A CASSETTE
	TAD I (DVICE
	DCA CSA		/GET HANDLER ENTRY POINT
	CDF 10
	CIF 0
	JMS I CSA
	3		/SKIP TO NEXT FILE
L770,	770
M270,	-270
R7600,	7600		/IGNORE ERRORS
	CIF 0
	JMS I CSA
	100		/DUMMY READ A PAGE
	BINARY		/TO SKIP HEADER
PRETSW,	RETSW
	SKP CLA		/WANT AN ERROR
	HLT		/A GOOD READ IS BAD!
	JMP I CASIT


/INITIALIZATION CODE FOR BATCH OPERATION



	FIELD 2

*10
BATXR1,	0		/INDEX REG. 1 FOR BATCH
BATXR2,	0		/INDEX REG. 2 FOR BATCH


*200

BATSET,	0
	TAD I (XR1	/GET THE OVERLAY POINTER
	SZA		/IF ZERO USE OLD VALUE
			/THIS SAVES ME SOME FIELD 0 SPACE
	DCA BATXR1	/SAVE THE POINTER
	TAD I [7777	/NOW GET THE BATCH FIELD
	CDF 20		/TO FIELD 2
	AND (0070	/NOW GET THE FIELD BITS
	TAD (CIF	/MAKE A CIF FOR OVERLAY
	DCA CBATI	/SAVE IN INPUT ROUTINE
	TAD CBATI	/ALSO OUTPUT
	DCA CBATO	/OVERLAY

BATMOV,	TAD I BATXR1	/GET NEXT STORAGE ADDRESS
	SNA		/IF ZERO ALL DONE (SECOND TIME THRU)
	JMP BATDON	/RETURN TO CALLER
	DCA BATXR2	/OTHERWISE SAVE POINTER TO TARGET CODE
BATLUP,	TAD I BATXR1	/GET A PATCH WORD
	SNA		/ZERO MEANS END OF THIS PATCH
	JMP BATMOV	/GO GET ANOTHER POINTER OR MAYBE ALL DONE
	CDF 0		/BACK TO FIELD ZERO
	DCA I BATXR2	/NOW CODE IS BATCHABLE
	CDF 20		/BACK TO FIELD 2
	JMP BATLUP	/DO IT ALL AGAIN

BATDON,	CIF CDF 0	/RETURN TO CALLER
	JMP I BATSET	/BYE


BATLS,	TTYIN		/POINTER TO MOVE DATA
	CBATI=.	/SET CIF BATCH
	RELOC TTYIN+1	/RELOCATABLE CODE
	CIF
	JMS I BATINI	/JUMP TO GET INPUT FROM BATCH
	HLT		/BAD ERROR
	SKP		/SKIP OVER POINTER
BATINI,	5400		/POINTER TO BATCH INPUT ROUTINE
	0		/TERMINATOR

	TTYOUT+5	/NOW FOR OUTPUT
	RELOC
	CBATO=.	/SET FOR CIF BATCH
	RELOC TTYOUT+6	/POINTER TO MOVE DATA
	CIF		/CIF BATCH
	JMS I .+1	/GO SEND DATA TO BATCH
	7400		/POINTER TO BATCH OUTPUT PROCESSOR
	0		/TERMINATOR


	LFMOD		/POINTER TO LINE FEED MOD
	RELOC LFMOD+1	/RLOCATE THE CODE
	RDTXT		/IGNORE LINE FEEDS
	0		/TERMINATOR

	BATTST+1	/POINTER TO MODIFY BATCH TEST
	RELOC BATTST+2	/RELOCATE THE CODE
	JMP BATBK	/JUMP AROUND THE BATCH SWITCH TEST
			/WITH A NEW SYSTEM THE TEST IS ILLOGICAL
			/WHICH IS THE CASE IF A BOOT IS REQUESTED
	0		/TERMINATOR
	RELOC

	0		/FINAL OVERLAY TERMINATOR



/NOW COMES THE RESET CODE TO PUT THINGS BACK
/ THE WAY THEY WERE TO BEGIN WITH.

	TTYIN		/POINTER TO MOVE DATA
	RELOC TTYIN+1	/RELOCATABLE CODE
	KSF		/SKIP ON FLAG
	JMP .-1
	KRB		/READ A CHAR
	SNA		/LOW LEVEL BLANK IGNORE
	JMP TTYIN+1	/GO GET ANOTHER
	0		/OVERLAY TERMINATOR

	TTYOUT+5	/NOW FOR OUTPUT
	RELOC TTYOUT+6	/RELOCATE AGAIN
	TLS		/PRINT THE CHAR
	TSF		/DONE?
	JMP .-1	/NO.
	0		/OVERLAY TERMINATOR

	LFMOD		/POINTER TO LINE FEED MOD
	RELOC LFMOD+1	/RELOCATE ONE MORE TIME
	LFEED		/LINE FEED..ECHO CURRENT COMMAND
	0		/TERMINATOR

	BATTST+1	/POINTER TO BATCH TEST
	RELOC BATTST+2	/RELOCATE THE CODE
	TAD I [7777	/RESET THE CODE TO ORIGINAL STATE
	0		/OVERLAY TERMINATOR

	RELOC
	0		/FINAL OVERLAY TERMINATOR
	PAGE


/LDABS DOES A REAL LIVE ABSLOAD IF AC=0
/IF AC=-2 THEN IT IS LOADING A HANDLER, THIS IS DONE AS FOLLOWS:
/SEARCH FOR *0
/THEN LOAD CONSEC WORDS INTO DESCRIPTOR TABLE
/AT NEXT ORIGIN, LOAD WORDS INTO HANDLER AREA (ALLOW ORIGINS)

/CAN'T USE PAGE 0 LITERALS IN CASE LOADING OS/8

LDABS,	0
	DCA LODTST	/-2 IF HANDLER, 0 IF OS8
LDABS2,	TAD JMPNXT
	DCA TSTO0
	DCA CKSUM	/CLEAR CHECKSUM
	JMS I (ICHA	/GET A BUFFER CHAR
	JMP LDAB	/NO INPUT FOUND
	SNA
	JMP .-3		/IGNORE BLANKS
	TAD (-200
	SZA CLA		/IS IT LEADER?
	JMP BADIN	/WASN'T 200..PROBABLY NOT BINARY
LEADER,	JMS I (ICHA
	JMP LDAB	/STRANGE....ALL LEADER!!!
	SNA
	JMP LDABS2	/START OVER.BLANKS AFTER LEADER
	TAD (-200	/IS IT STILL LEADER?
	SNA
	JMP LEADER	/YES
NEWWD,	SMA		/IS IT < 200?
	JMP FIELDW	/NO.TEST FOR FIELD SEETING
	TAD (200	/RESTORE CHARACTER
	DCA WD1
	JMS I (ICHA
	JMP BADIN	/EOF BETWEEN WORDS. HOW NICE!
	DCA WD2
	JMS I (ICHA
	JMP BADIN
	TAD (-200	/200 FINISHES US UP
	SNA
	JMP OVE
	DCA WD
	JMS I (ASSEM	/ASSEMBLE LAST WORD READ
	SZL		/IS IT AN ORIGIN?
	JMP ORGTST	/YES
XFIELD,	HLT		/GETS CDF N
	DCA I ORIGIN	/STORE THIS WORD
CDF20,	CDF 20
	ISZ ORIGIN	/SHOULD NEVER SKIP, BUT...
LD7,	7
	TAD ORIGIN
	TAD (200	/GIVE ERROR IF ORIGIN ADVANCES TO 7600
	SZA CLA
	JMP .+3		/SKIP AROUND ERROR
	CIF CDF 0	/ERROR IN FIELD 0
	JMP I (NOROOM
NEXT,	TAD WD1
	TAD WD2		/MAKE UP CHECKSUM
	TAD CKSUM
	DCA CKSUM
	TAD WD
	JMP NEWWD

ORGTST,	DCA ORGX	/TEST FOR ORIGIN
	TAD LODTST	/GET POINTER TO PROPER ORIGIN
	SNA CLA
	JMP .+3
	CIF CDF 0	/JUMP TO HANDLER TEST
	JMP I (HND
	TAD ORGX	/OS/8 - USE REAL ORIGIN
ORI,	DCA ORIGIN	/BUFFER AREA
	TAD LODTST	/HANDLER LOAD?
	SNA CLA
	JMP NEXT	/NOPE
	TAD ORGX	/DON'T START LOAD UNTIL *0 IS FOUND
	SZA CLA
TSTO0,	JMP NEXT
	DCA .-1		/FOUND *0..DO THE LOAD
	ISZ LODTST	/YES. BUMP LODTST TO LOAD HANDLER NEXT
	JMP NEXT
	TAD XFIELD
	TAD (-CDF 0
	SZA CLA
	JMP .+3		/JUMP AROUND IF NOT FIRST TIME
	CIF CDF 0	/SUBROUTINE IN FIELD 0
	JMS I [FIRST	/FIRST TIME THROUGH


/DO THIS BETTER; ALSO MAKE SURE HANDLER DOESN(T HAVE A FILED PSEUDO
	TAD (CDF 10
	DCA XFIELD	/AT THIS POINT, WE START
	CLA CMA		/LOADING THE HANDLER INTO THE
	DCA LODTST	/AREA SPECIFIED BY HNDORG+1
/CHECK 'ORIGIN' TO SEE IF HEADER WAS RIGHT SIZE
/ALSO ELSEWHERE, CAN CHECK ORIGIN WHEN BUMPING TO SEE
/IF WE HIT ANY MAGIC LOCATIONS
	TAD ORGX	/SEE IF LEGAL RE ORIGIN
	CIF CDF 0	/OFF ON FIELD 0
	JMS I (ORGLIM
	DCA ORIGIN	/ACTUAL FIELD 1 ORIGIN
/	TAD SNACLA	/LOADING FIELD 1..TEST ORIGINS
/	DCA JMPRE
JMPNXT,	JMP NEXT
FIELDW,	TAD (-100	/LESS THAN 300 FAILS
	SPA
	JMP BADIN
	DCA WD1
	TAD WD1
	AND LD7
	SZA CLA
	JMP BADIN	/DISECT WORD TO CATCH GARBAGE
	TAD LODTST	/IF LOADING HANDLER, IGNORE FIELD
	SZA CLA
	JMP FIELD2
	TAD WD1
	AND (70		/EXTRACT FIELD SETTING
	TAD [CDF 0
	DCA XFIELD
FIELD2,	JMS I (ICHA
	JMP BADIN
	TAD (7600
	SZA
	JMP NEWWD
OVE,	CIF CDF 0	/ROUTINE IN FIELD 0
	JMP I [OVER
LDAB,	CIF CDF 0	/BACK TO FIELD 0
	JMP I LDABS	/RETURN FROM SUBROUTINE

BADIN,	CIF CDF 0	/BACK TO FIELD 0
	JMP I [BADINP	/BAD INPUT


ORGX,	0
ORIGIN,	0
WD1,	0
WD2,	0
WD,	0
CKSUM,	0
LODTST,	0
	PAGE
ICHA,	0		/ICHAR CALL ROUTINE FOR FIELD 0
	CIF CDF 0	/OFF TO FIELD 0
	JMS I (ICHAR	/JUMP TO ICHAR
	JMP I ICHA	/ERROR RETURN
	ISZ ICHA	/GOOD RETURN
	JMP I ICHA	/RETURN TO CALLER



ASSEM,	0		/ASSEMBLE A WORD
			/THIS CODE APPEARS IN FIELD 0 ALSO
	TAD I (WD1	/GET WORD 1
	CLL RTL		/NOW DO THE ROTATE
	RTL;RTL
	TAD I (WD2	/NOW FOR THE SECOND PART
	JMP I ASSEM	/BACK TO CALLER
	PAGE
	WRITEX=JMS I (7607	/OFF TO WRITE TO DEV.
	ERROR=JMS ERRX		/ERROR SUBROUTINE
BAK,
	CIF 0;WRITEX;4111;3400;26;ERROR	/ENTER OVERLAY
	CIF 0;WRITEX;4701;2000;54;ERROR	/SAVE, DATE, MON ERROR, CHAIN OVERLAYS
	TAD Q200
	CDF 0
	TAD I QLD
	DCA I QLD
	CDF 20
	CIF 0;WRITEX;4101;LDRCTL;70;ERROR /ABSLDR CORE CONTROL BLOCK
	TAD (-114
	CIF 0
	JMS I (MOVE
	CDF 0
	4264
	CDF 0
	3464
	CIF 0;WRITEX;4200;3400;64;ERROR
	CIF 0;WRITEX;5210;2000;71;ERROR	/ABSLDR
	CIF CDF 10	/BACK TO FIELD 1
	JMP I (WHER
QLD,	LDRCTL+5
Q200,	200


ERRX,	0		/WRITE ERROR
	HLT CLA		/HIT CONTINUE TO RETRY
	TAD ERRX
	TAD (-6		/BACK TO TRY AGAIN
	DCA ERRX	/AGAIN
	JMP I ERRX	/RETRY



	FIELD 0
	*200
	$


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCL.BI. 
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

$JOB ASSEMBLE AND LINK CCL.MA
.MAC OUT:CCLPS<IN:CCLPS.MA
.MAC OUT:CCLTBL<IN:CCLTBL.MA
.MAC OUT:CCLCDX<IN:CCLCDX.MA
.MAC OUT:CCLSIZ<IN:CCLSIZ.MA
.MAC OUT:CCLCOR<IN:CCLCOR.MA
.MAC OUT:CCLCD<IN:CCLCD.MA
.MAC OUT:CCLTAB<IN:CCLTAB.MA
.MAC OUT:CCLDRV<IN:CCLDRV.MA
.MAC OUT:CCLAT<IN:CCLAT.MA
.MAC OUT:CCLSEM<IN:CCLSEM.MA
.MAC OUT:CCLDAT<IN:CCLDAT.MA
.MAC OUT:CCLSB2<IN:CCLSB2.MA
.MAC OUT:CCLREM<IN:CCLREM.MA
.MAC OUT:CCLMSG<IN:CCLMSG.MA
.MAC OUT:CCLRUN<IN:CCLRUN.MA
.MAC OUT:CCLSUB<IN:CCLSUB.MA
.MAC OUT:CCL<IN:CCL.MA
.LINK OUT:CCL<OUT:CCL,OUT:CCLTBL,OUT:CCLAT,OUT:CCLMSG$
*OUT:CCLTAB,OUT:CCLDRV,OUT:CCLPS,OUT:CCLSIZ/F
/*OUT:CCLSEM
*=0/N/9
*=1000/N
*=1400/N
*=2000/N
*=2400/N
*=3000/N
*=3400/N
*=4000/N
*=4400/N/O
*OUT:CCLDAT,OUT:CCLCOR/C
*OUT:CCLSUB/C
*OUT:CCLSB2/C
*OUT:CCLCDX
*/O
*OUT:CCLCD/C
*OUT:CCLRUN,OUT:CCLREM
*$
.DEL OUT:CCL???.RB
.COPY OUT:CCL.SV<DSK:CCL.SV
.DEL CCL.SV
/CHAIN TO RESORC COMPILE AND LINK
.SUB RESORC.BI
$END


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCL.MA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785

/5	MACREL VERSION OF CCL FOR OS/8 V3D
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975,1976,1977,1978 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
	MIFILE=7617
	.GLOBAL OUTLIM,OUTSW,COLSET,FNAME1
	.GLOBAL LPTDEV,TTYDEV,DMPDEV,NULDEV,PTPDEV,TVDEV
	.GLOBAL EXSUB,BLK,IOERR
	.GLOBAL LOOK
	.GLOBAL SETLPT,SETPTP,SETTTY,YFORT,YF4,YLOAD,YLOADER
	.GLOBAL DEFILE
	.GLOBAL YAT,ZOW,BATCH,FLAG,RDMON,REGO,REMD,CHAIN
	.GLOBAL DECODE,SCAN,LBEGIN
	.GLOBAL DEFALT,MOVE,TWAIT,NAMPTR
	BEGLN==1000
	XFERV==70	/LOCATION INSIDE USR WHICH IS FREE
	.EXTERNAL SWAPER
/	.EXTERNAL SEMI
	.EXTERNAL MONFIX
	.EXTERNAL TABLES
	.EXTERNAL AT,CCLBLC,PTBL,SAVL,LEAVE,VERTN,NOCCL
	.EXTERNAL SETDEV,RECALL
	.EXTERNAL CD,CCER1,REMEM,ARLOC
	.EXTERNAL PRMESG,PRINT,CCSUB
	.GLOBAL YCCL

	XR2=15
	XR=16
	AMFLAG=17
	T=20
	DELIM=32
	DEFALT=33	/POINTS TO DEFAULT EXTENSION LIST
	PTR=36
	BATSPL=7200	/JMS HERE TO PERFORM SPOOLING WITH DEFAULT EXT IN AC
	SOFSET=7747

/CCL STARTING ADDRESS:	12000
/STARTING ADDRESS:	12001
/CHAIN STARTING ADDRESS:12002

/	JOB STATUS WORD = 2003

/**************************************************
/
/		SAVING CCL
/
/		.LOAD CCL
/		.SAVE SYS CCL;12001=2103
/		.R CCL
/
/**************************************************

	OV=1375
	MSOVL2=55
	CCLTAB="H	/MUST BE UPDATED IF TABLES CHANGE
	CCLNUM="3
	CCLVER="A	/CCL VERSION #

/*** NOTE: VERSION E OF CCL WAS FOR IN-HOUSE USE ONLY.
/USE OF SEMICOLONS WITH CCL VERSION I OR LATER
/REQUIRES BATCH VERSION 7 OR LATER.
/USE OF BASIC COMMAND REQUIRES V3D BASIC OR LATER

/MEMORY ALLOCATION:

/0 0000-0777	KBM
/0 1000-1777	COMMAND LINE [EACH @ FILE RESTRICTED TO 1 BLOCK]
/0 2000-2777	LINE BUFFER EXTENSION
/0 3000-3177	PRE-EXTENSION @ BUFFER
/0 3200-3577	@ BUFFER
/0 4000-4377	REM-LINES
/0 4400-4777	INPUT HANDLER FOR CD
/		ALSO, SEMICOLON BUFFER
/0 5000-5777	LONGWORD TABLE
/0 6000-7277	MORE TABLES
/0 7300-7577	SWITCH POINTER TABLE
/	CHANGES SINCE FIELD RELEASE VERSION:

/1.	RECURSIVE 'U' BUG FIXED
/2.	INTERNAL STRUCTURE OF CCL KEYWORD TABLE CHANGED
/3.	BUG RE REWRITING BLOCK CONTAINING PTR TO CORRECT FORTRAN FIXED
/4.	.SV PARTS OF FILENAMES REMOVED FROM TABLE TO SAVE SPACE
/5.	COMPARE PASSES ALTMODE
/6.	TTY BECAME DEFAULT FOR COMPAR, DIRECT, AND MAP
/7.	BUG RE PASSING DEFAULT * FIXED
/8.	.LS FORM OF .CREF COMMAND REMOVED
/9.	BUG CONCERNING PROCESSOR SWITCHES FIXED
/10.	CCL SWITCH ALLOWED AFTER =N OPTION
/11.	BUG RE 'BAD SWITCH OPTION' MESSAGE FIXED
/12.	EXTRA SPACES NOW ALLOWED BEFORE CCL ARGUMENT
/13.	'DOES NOT EXIST' MESSAGE NOW SPELLED CORRECTLY
/14.	'BAD CCL SWITCH' MESSAGE ADDED
/15.	CCL EDIT # CHANGED TO CCL VERSION #
/16.	.EX CHAINS TO BCOMP NOT BASIC FOR .BA FILES
/17.	MUNG PTR: NOW WORKS
/18.	FIXED BUG RE MUNG <CR>
/19.	FIXED BUG RE CD FOR FILE > 2047 BLKS
/20.	FIXED BUG RE MAKE PTR:

/VERSION B FIXES:

/21.	ALLOWED 'EDIT' TO COPY FILE EXTENSION
/22.	FIXED BUG RE .CCL ON WRITE-LOCKED DEVICE
/23.	FIXED DATE PROBLEM
/24.	ALLOWED FF AND VT IN AN INDIRECT FILE TO BE IGNORED

/VERSION C FIXES:

/25.	FIXED BUG RE SPACES AND SLASHES IN MUNG TEXT ARGUMENT
/26.	ALLOWED EDIT COMMAND TO USE SAME OUT DEVICE
/	 AS IN DEVICE (IF NONE SPECIFIED)
/27.	ADDED MORE SYNTAX CHECKING TO ZERO COMMAND

/VERSION D CHANGES:

/28.	ALLOWED EDIT A<B COMMAND TO REMEMBER ONLY UP TO '<' .

/VERSION E CHANGES: (IN-HOUSE ONLY VERSION)

/29.	WARNING MSG IF SQUISH SYS: UNDER BATCH
/30.	ADDED SOME NOTES ON HOW TO ALLOW = AS WELL AS <
/31.	ADDED HOOKS FOR ; TO BE READY FOR V4
/32.	FIX BUG RE CMD STARTING WITH SPACES

/CHANGES FOR MAINTENANCE RELEASE (OS/8 V3C):

/33.	FIXED BUG ABOUT @ NOT FOLLOWED BY FILESPEC
/34.	INCORPORATED ALL PREVIOUS EDITS
/35.	ALLOWED ' TO TERMINATE AN INDIRECT REQUEST (AND BE IGNORED)
/36.	FIXED BUG ABOUT EDIT DEV1:_DEV2:FOO LOSING DEV1:
/37.	CORRECTED SPELLING OF SUPERSEDING
/38.	ADDED .LD EXTENSION TO EXECUTE TABLES [USES FRTS]

/VERSION G CHANGES:

/39.	FIXED BUG WITH HELP COMMAND
/40.	FIXED BUG CONCERNING EDIT DEV:_FILE

/VERSION H CHANGES:

/41.	ADDED MAC AND LINK COMMANDS
/42.	ADDED MACREL AND LINKER INTO COMPILE/LOAD/EXECUTE COMMANDS
/43.	ALLOWED UX COMMANDS TO CONTAIN KBM COMMANDS
/44.	ALLOWED PASSING A KBM COMMAND TO CCL ON CHAINING
/45.	ALLOWED @ AT BEGINNING OF LINE
/46.	MOVED MOST OF 'DETCOR' TO FIELD 0
/47.	WAIT ROUTINE  NOW GIVES UP IF TTY FLAG ISN'T UP WITHIN 0.1 SEC
/48.	ALLOWED EXEC .BI TO USE BATCH
/49.	TENTATIVELY ADDED SEMICOLON STUFF
/50.	PUT BACK WARNING MESSAGE IF TRY TO SQUISH UNDER BATCH
/VERSION I CHANGES:

/51.	FIRMED UP SEMICOLON STUFF

/VERSION J CHANGES:

/52.	DEFAULT DEVICE FOR COMPIL, PAL, ETC. IS NOW LOGICAL DSK: NOT SYS:
/53.	-L, -S, AND -P SWITCHES NOW SET OUTPUT NAME TO CURRENT INPUT NAME

/VERSION K CHANGES:

/54.	DATE NOW HANDLES DATE/78 ALGORITHM
/55.	TOOK OUT 'TCF' WHICH WAS CAUSING BATCH TO HANG

/VERSION 1A CHANGES:

/56.	FIXED BUG RE NULL INDIRECT CMD FILE
/57.	FIXED BUG TO NOW ALLOW DATE WITH ARGS IN INIT.CM
/58.	PRINT "OS78" FOR VERSION NAME IF APPLICABLE
/59.	ADDED -N AND -D AND REWROTE LOGIC A BIT
/60.	HELP COMMAND NOW USES HELP.SV
/61.	SET COMMAND NOW USES SET.SV
/62.	'CORE' BECOMES 'MEMORY' IN 3 MSGS AND 1 CMD
/63.	ADDED BASIC COMMAND (CHAINS TO BASIC.SV WITH Q SWITCH)
/64.	ALLOWED FOR TERMINATE COMMAND (OS78 REPLACES BACKSPACE)
/65.	ADDED DUPLICATE COMMAND (USES RXCOPY)

/V1B CHANGES:

/66.	MODIFIED FORMAT OF MAIN TABLE
/67.	GIVE ERROR MESSAGE IF NO FILENAME IS GIVEN WITH INDIRECT
/	FILE (EVEN IF NON-FS)
/68.	PRINT KBM VERSION #
/69.	ADDED TERMINATE COMMAND

/V1F CHANGE:

/70.	DUPL CALLS RXCOPY IN SPECIAL MODE

/V1G CHANGES:

/71.	SOURCE CODE IS NOW MACREL
/72	LINKER OVERLAYS ADDED
/73.	= ALLOWED IN ADDITION TO _ AND < (IF NOT FOLLOWED BY A DIGIT)
/74.	/C:NNNN ALLOWED FOR NUMERIC ARGUMENT IN ADDITION TO =
/75.	HOOKS FOR MULTIPLE CHARACTER SWITCHES ADDED
/76.	SWITCHES MAY NO LONGER BE EMBEDDED IN A FILENAME
/77.	KNOWN BUG IF SAY MAKE #
/78	A+B IS IDENTICAL TO A-NB,B
/79.	KNOWN BUG THAT /A-L USES A
/80.	TEMPORARILY REMOVED SEMICOLON STUFF
/	FORMAT OF CCL TABLE

/ENTRY	PURPOSE

/	TABLE WIDTH=7 (BUT VARIES)

/0	FLAG WORD

	/BIT	MEANING IF ON

	/0	PERFORM CD (IF 0, OMIT ENTRIES 1-6)
	/1	DON'T PERMIT SPOOLING
	/2	ALLOW .LS, .NB, .MP SWITCHES
	/3	ADD _ TO END OF COMMAND STRING
	/4	SET OUTPUT EXTENSION = INPUT EXTENSION (IF BIT 2 ON)
	/6-8	SPECIFIES AUTOMATIC INPUT REMEMBERING (REM LINE MINUS 1)
	/	0 MEANS NONE.  7 RESERVED FOR SPECIAL USE.
	/10	CAUSE -L, ETC. TO GO TO 2ND OUTPUT FILE & COPIES NAME
	/11	WANT DEFAULT ALTMODE (COMPL IF AMFLAG=1)

/1	PTR TO DEFAULT EXTENSION LIST FOR INPUT FILES.
/	IF PTS TO 0, NONE.   IF PTS TO 5200, USE SPECIAL MODE.

/2-4	DEFAULT SWITCHES TO BE OR'ED INTO THOSE
/	EXPLICITLY GIVEN.

/5	ADDRESS OF SUBROUTINE TO BE CALLED
/	AFTER C.D. HAS BEEN DONE.  0 IF NONE.

/6	PTR TO FILENAME OF PROGRAM
/	TO BE CHAINED TO.  0 IF NONE.

/	FIELD 0

/1000-1777	LINE BUFFER
/2000-2777	LINE BUFFER EXTENSION
/4000-4377	REM-LINES
/4400-4777	HANDLER
/5000-5577	BUFFER
/6000-7577	MORE CCL (7 PAGES)

	REST=5000
	.ASECT CCL
	*2000
	.JSW 2103
	.VERSION CCLNUM&77^100+<CCLVER&77>

	FIELD 1

	FAKBM=404	/PLACE TO FAKE OUT KBM

START,	JMP .+3		/START FROM MONITOR
	JMP MONF	/START FROM .RUN COMMAND
	JMP MONCHN	/START WHEN CHAINED TO
	CLA
	CDF 0		/READ IN REST OF CCL
	TAD I (CCLBLC	/GET BLOCK OF START
	DCA I (SOFSET	/ALLOW LINKER OVERLAY DRIVER TO WORK
	TAD (7607
	DCA I (7756
	TAD I (SOFSET
	CDF 10
	TAD CCLREM
	DCA CCLREM	/GET BLOCK OF REST
	CIF 0
	JMS I (7607
	1300		/READ 11 MORE PAGES
	REST
WFL,
CCLREM,	1+5+1		/SKIP CCB AND *400 STUFF
	JMP I (ERR2
	JMS FIXX
	JMS TWAIT
	CDF 0
	TAD I LVNO
	CDF 10
	TAD (-CCLTAB	/DO VERSION #'S AGREE?
	SZA CLA
	JMP I (BADVNO
	JMS I (AT
	TAD (BEGLN-1
	DCA XR
L$:	CDF 0
	TAD I XR
	CDF 10
	SNA
	JMP 2$
	TAD (-";
	SZA CLA
	JMP L$
/	JMS I (SEMI
	NOP
2$:	STA
	DCA I (REMD	/ALLOW RECURSIVE U'S
	CDF 0
	TAD I KENTRY	/GET ENTRY #
	CIF CDF 10
	TAD (PTBL	/GET ADDRESS OF PTR TO START OF ENTRY
	DCA PTR
	CDF TABLES
	TAD I PTR	/GET PTR TO START OF ENTRY
	CDF 10
	DCA PTR
	TAD PTR
BASPTR,	DCA BASPTR
	JMP I (GO

FIXX,	0
	DCA I (XFERV	/SET UP STUFF FOR OVERLAY DRIVER
	TAD (SWAPER
	DCA I (XFERV+1
	JMP I FIXX

MONF,	JMS FIXX
	JMP I (MONFIX
MONCHN,
	CIF 0
	JMS I (7607	/READ IN KBM
	1000		/4 BLOCKS
	0		/0-1777
	7		/BLOCK 7 ON SYS:
	HLT		/NO WAY TO RECOVER (EVEN 7605 DOES THIS)
	TAD (-44
	JMS I (MOVE	/ASSUME COMMAND LINE IS IN
	CDF 10		/17600-17643
	7600
	CDF 0
	1000		/MOVE TO OS/8 LINE BUFFER
	CIF CDF 0
YAT,	JMP I KFAKBM	/@ DESTROYS THIS CODE (MUST BE ONE BEFORE 'REGO')
	TAD I (SAVL	/'YAT' IS JMS'ED TO
	SNA CLA		/BY INITIAL @ COMMAND
	JMP I (LEAVE	/DO NOTHING IF NO @ GOT EXPANDED (NULL LINE)
REGO,	CIF 0
	JMS I (7607
	200		/READ ONE BLOCK
	400		/400-777
	10		/RESTORE PART OF KBM WHICH WAS DESTROYED BY OVERLAY
	HLT
	JMP I (FAKE

/REGO,	TAD KCIDF
/	CDF 0
/	DCA I (RETCIF	/ALLOW 'FINDIT' TO RETURN TO FIELD 1
/	CIF CDF 0
/	STA
/	DCA I (HALF
/	DCA I (ENTRY
/	TAD (KEYWRD
/	DCA I (KPTR
/	JMS I (FINDIT	/LOOK UP KEYWORD
/	SMA CLA
/	JMP PREGO	/FOUND IT
/CMDERR,	JMS I (PRMESG	/NOT A LEGAL KEYWORD
/	ERRCMD

	.START START+1,1
TWAIT,	0
	DCA WFL
	JMS I (BATCH
	JMP TW		/BATCH NOT RUNNING
	CLA		/WE'RE RUNNING UNDER BATCH
	JMP I TWAIT
TW,	TSF
	SKP		/WAIT FOR THINGS TO QUIET DOWN
	JMP I TWAIT
LVNO,	AND I 0		/WASTE SOME TIME
KFAKBM,	AND I 4
KENTRY,	600
	ISZ WFL
	JMP TW
	JMP I TWAIT	/CAN'T WAIT TOO LONG
FILDMY,	FILENAME DUMMY.SV
	0		/EXTRA EXTENSION WORD
	PAGE
BADVNO,	JMS I (PRINT
	BADVMS
	JMS I (VERTN
	JMP I (LEAVE	/GO AWAY
/THIS ROUTINE DETERMINES IF THE CHARACTER IN THE AC IS A LETTER OR DIGIT
/IF LETTER, RETURNS TO RET+1 WITH LETTER-"A IN AC AND LINK=0
/IF DIGIT, RETURNS TO RET+1 WITH DIGIT-"0 IN AC AND LINK=1
/IF NEITHER, RETURNS TO RET WITH CHAR-"A IN AC.
DECODE,	0
	TAD (-"9-1	/MIGHT BE CALLED WITH ANY DF
	CLL
	TAD ("9+1-"0
	SZL
	JMP YES$
	TAD ("0-"Z-1
	CLL CML
	TAD ("Z-"A+1
	SNL
YES$:	ISZ DECODE
	JMP I DECODE
LBEGIN,	0		/PTS TO 1 CHAR BEFORE COMMAND KEYWORD ARGUMENT

SCAN,	0
	TAD (BEGLN
	DCA T
	CDF 0
	JMS BLSCAN	/IGNORE INITIAL SPACES
	JMP 2$
1$:	CLA
	ISZ T
	TAD I T
2$:	SNA
	JMP 3$
	JMS I (DECODE
	SKP CLA
	JMP 1$
	JMS BLSCAN
3$:	DCA DELIM
	STA
	TAD T
	CDF 10
	DCA I (LBEGIN
	JMP I SCAN

BLSCAN,	0
	TAD I T
	TAD (-240
	SZA
	JMP 1$
	ISZ T
	JMP BLSCAN+1
1$:	TAD (240
	JMP I BLSCAN	/LEAVE CHAR IN AC
SETLPT,	0		/COULD BE ONCE ONLY
	TAD (LPTDEV
	JMS I (SETDEV
	JMP I SETLPT

SETTTY,	0
	TAD (TTYDEV
	JMS I (SETDEV
	JMP I SETTTY

SETPTP,	0
	TAD (PTPDEV
	JMS I (SETDEV
	JMP I SETPTP

FAKE,	CIF CDF 0
	TAD (MSOVL2
	DCA I (OV	/RESTORE LOC SO DATE CMD W ARGS WILL WORK
	JMP I (FAKBM
SYSER,	TEXT	\#I/O ERROR ON SYS:\
GO,	JMS I (SCAN	/ADVANCE SCAN UNTIL AFTER SPACES
GO2,	CDF TABLES
	TAD I PTR	/GET FLAG
	CDF 10
	DCA FLAG	/SAVE IT
	TAD DELIM
	SNA CLA		/IS TYPED LINE EMPTY AFTER KEYWORD?
	TAD FLAG	/AND IS SPECIAL REMEMBERING BITS ON?
	CLL RTR
	RAR		/AND HAS GOD WILLED US TO REMEMBER?
	AND (7		/AND ARE THE ZODIAK SIGNS FAVORABLE?
	SNA
	JMP I (NORM	/NO
	TAD REMD	/YES, GET REM-LINE (SUBTRACT 1)
	DCA REMD
	CDF 0
	TAD I (BEGLN
	CDF 10
	DCA I (NMPTR
	JMS I (RECALL	/RECALL LINE
REMD,	-1		/-1 MEANS DIDN'T RETRIEVE A REMEMBER LINE
	DCA DEPN	/SAVE DEPENDENT INFO
	TAD I (NMPTR
	SZA CLA		/EG COMMAND?
	JMP I (NORM	/NO
	ISZ DELIM	/YES
	TAD DEPN
	DCA PTR		/RESET PTR FROM CMD DEPENDENT WORD
	JMP GO2

DEPN,	0		/REM LINE DEPENDENT INFORMATION
	PAGE
	COLWRD		/NEEDED FOR SET TTY COL
NORM,	TAD FLAG
L7700,	SMA CLA
	JMP CHAINN	/SKIP ENTRIES IF NO CD
	ISZ PTR		/POINT TO DEFAULT INPUT EXTENSION
	CDF TABLES
	TAD I PTR	/GET DEFAULT INPUT EXTENSION PTR
	CDF 10
	DCA DEFALT	/SAVE IT
	TAD (7641
	DCA XR
	TAD FLAG
	CDF 0
	TAD I PAMFLAG	/COMBINE ALTMODE BITS
	CDF 10
	RAR		/IN POSITION 11
	CLA RAR		/PUT NEW ALTMODE BIT ALONE IN BIT 0
	DCA I XR	/STORE AWAY IN C.D. OPTION TABLE
	DCA I XR	/V3D ZERO OPTION WORDS
	DCA I XR
	DCA I XR
	DCA I XR	/ZERO L.O. =
L$:	ISZ PTR
	CDF TABLES
	TAD I PTR
	SNA
	JMP 2$
	DCA NTEMP
	ISZ PTR
	TAD I PTR	/GET VALUE
	CDF 10
	TAD I NTEMP
	DCA I NTEMP	/STORE IN SPECIFIED LOCATION
	JMP L$
2$:	CDF 10
	TAD FLAG
	AND (400
	SZA CLA
	JMS I (INSARR	/INSERT BACK ARROW IF FLAG BIT SET
	JMS I (CD	/PERFORM COMMAND DECODE IF FLAG BIT
			/0 SET
	TAD FLAG
	RAL
	SMA CLA		/IS SPOOLING PROHIBITED?
	JMS I (SPOOLIT	/NO
CHAINN,	ISZ PTR		/POINT TO AFTER CD SUBR
	CDF TABLES
	TAD I PTR	/GET SUBR ADDRESS
	CDF 10
	JMS I (JMSUB
	TAD I (DEFILE
	SZA		/IS THERE A FILENAME SET TO CHAIN TO?
	JMP ZOW		/YES
	ISZ PTR		/NO, POINT TO FILENAME
	CDF TABLES
	TAD I PTR
	CDF 10
	SNA
	JMP I (LEAVE	/NO FILE TO CHAIN TO
ZOW,	DCA NMPTR
	JMS LOOK	/LOOKUP FILE
NMPTR,	0
	JMP I (CCER1	/NOT FOUND
CHAIN,	JMS I (200	/CHAIN TO IT
	6		/CHAIN

BLK,	0
/	-----
PAMFLAG,AMFLAG
/LOOK, LOOKS UP FILE ON DEVICE .  POINTER IS IN ARG1
/	ARG2 IS ERROR RETURN IF NOT FOUND
/DEVICE NUMBER IS IN AC.  IF 0, USE SYS:

LOOK,	0
	SNA
	IAC
	DCA DEV
	TAD I LOOK	/GET PTR TO FILE NAME IN FIELD 0
	DCA HISFIL
	TAD HISFIL
	AND L7700
	SNA CLA
	JMP FLD1	/PTR LT 100 MEANS IN FIELD 1
	TAD (-3
	JMS I (MOVE	/MOVE IT UP
	CDF 0
BWORD,
HISFIL,	0
	CDF 10
PFILDMY,FILDMY
	TAD PFILDMY
SETN,	DCA NAMPTR	/STORE AWAY PTR TO FILENAME
	ISZ LOOK	/POINT TO ERROR RETURN
	TAD DEV		/GET DEVICE NUMBER
	JMS I (200
	2		/LOOKUP
NTEMP,
NAMPTR,	0
	0
	JMP I LOOK	/TAKE ERROR RETURN IF NOT FOUND
	TAD NAMPTR	/STORE STARTING BLOCK # IN 'BLK'
	DCA BLK
	ISZ LOOK	/POINT TO NORMAL RETURN
	JMP I LOOK	/RETURN
FLAG,	0
DEV,	0

FLD1,	TAD HISFIL
	JMP SETN

/SKIP IF BATCH IS RUNNING AND PUT CIF BATCH FIELD IN AC

BATCH,	0
	CDF 0
	TAD I (7777
	CDF 10
	DCA BWORD
	TAD BWORD
	RTL
	SNL CLA		/IS BATCH RUNNING?
	JMP I BATCH	/NO
	TAD BWORD	/YES
	AND (70		/ISOLATE FIELD OF BATCH
	TAD (CIF	/FORM CIF TO THE HIGHEST FIELD
	ISZ BATCH	/AND TAKE SKIP RETURN WITH IT IN AC
	JMP I BATCH
	PAGE
DEFILE,	0		/PTR TO FILENAME TO CHAIN TO

TEMP,
RDMON,	0
	CDF 10
	CIF 0
	CLA
	JMS I (7607
	0400		/READ 2 RECORD
	2000		/LOCATION 2000 FIELD 0
	7		/BLOCK 7,10
	JMP IOERR
	JMP I RDMON

ERR2,	CIF CDF 0
	JMP I (NOCCL
EXSUB,	0
	TAD BASPTR	/PUSH PTR BACK TO BEGIN OF ENTRIES
	JMS I (REMEM	/REMEMBER THIS IN DEPENDENT WORD
	2
	JMP I EXSUB

JMSUB,	0
	SNA
	JMP I JMSUB
	DCA TEMP
	JMS I (CCSUB	/LOAD OVERLAY
	JMS I TEMP
	JMP I JMSUB

SPOOLIT,0
	JMS I (BATCH	/IS BATCH RUNNING?
	JMP I SPOOLIT	/NO
	DCA CB		/YES
	CDF 0
	TAD I DEFALT
	TAD (-5200
	SNA CLA
	TAD I DEFALT	/LEAVE 5200 IN AC IF SPECIAL MODE
	CDF 10
CB,	HLT		/CIF TO FIELD OF BATCH
	JMS I (BATSPL	/ALLOW BATCH TO SPOOL STUFF
	JMP I SPOOLIT
INSARR,	0
	TAD (BEGLN
	DCA XR
	CDF 0
	TAD I XR
	SZA CLA
	JMP .-2
	STA
	TAD XR
	DCA XR
	TAD ("<
	DCA I XR
	DCA I XR
	CDF 10
	STA
	TAD XR
	DCA I (ARLOC	/REMEMBER WHERE WE INSERTED A "_"
	JMP I INSARR
/	TAD (-# OF LOCS TO MOVE
/	JMS MOVE
/	FROM CDF
/	FROM LOC
/	TO CDF
/	TO LOC

MOVE,	0
	DCA T
	TAD I MOVE	/GET FROM CDF
	DCA FRCDF
	ISZ MOVE
	STA
	TAD I MOVE	/GET FROM LOC-1
	DCA XR
	ISZ MOVE
	TAD I MOVE	/GET TO CDF
	DCA TOCDF
	ISZ MOVE
	STA
	TAD I MOVE	/GET TO LOC-1
	DCA XR2
	ISZ MOVE	/POINT TO RETURN
	TAD T
	SNA CLA
	JMP I MOVE	/V1A IGNORE 0 MOVE
FRCDF,	HLT
	TAD I XR
TOCDF,	HLT
	DCA I XR2
	ISZ T
	JMP FRCDF
	CDF 10
	JMP I MOVE
OUTSW,	-1		/-1 MEANS ON OUTPUT SIDE, 0 ON INPUT SIDE

OUTLIM,	1-MIFILE
IOERR,	JMS I (PRMESG
	SYSER
BADVMS,	TEXT	/#CCL 3X OVERLAY AND CCL INCOMPATIBLE/
	AAAA=.
	*BADVMS+3
	CCLTAB&77^100+40
	*AAAA
COLWRD,	1

COLSET,	0
/	JMS I (CCSUB
	JMS I (SETTTY
	TAD I (7646
	SNA
	TAD COLWRD
	DCA I (7646
	JMP I COLSET
	PAGE
	.ASECT CCLMOR
	FIELD 0
	*6740
YCCL,	FILENAME CCL.SV
	*.-1
YFORT,	FILENAME FORT.SV
	*.-1
YF4,	FILENAME F4.SV
	*.-1
YLOADER,FILENAME LOADER.SV
	*.-1
YLOAD,	FILENAME LOAD.SV
	*.-1
LPTDEV,	DEVICE LPT
TVDEV,	DEVICE TV
TTYDEV,	DEVICE TTY
PTPDEV,	DEVICE PTP
DMPDEV,	DEVICE DUMP
NULDEV,	DEVICE NULL
FNAME1,	ZBLOCK 5


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLAT.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/2	CCL INDIRECT COMMAND FILE PROCESSOR

	.GLOBAL AT,FUDG,DONB

	.EXTERNAL BEGLN,GETSPC,ASSIGN,SETEXT,EXTCM
	.GLOBAL SAVL
	.EXTERNAL DEFALT,LOOKUP,ASADR,LNAME
	.EXTERNAL PRMESG,MOVE
	.EXTERNAL OUTSW,OUTLIM

	XR=16
	CLXR=35
	T=20
	LXR=34
	BFR=3000

	.RSECT AT1
	FIELD 1

AT,	0
ATMORE,	TAD (BEGLN-1
	DCA LXR
ATLOOP,	JMS I (GLXR
	SNA
	JMP I AT
	TAD (-300
	SZA CLA
	JMP ATLOOP
	TAD LXR
	DCA I (SAVL
	JMS FUDG
	JMS I (GETSPC
	JMS I (ASSIGN
	DCA I (SETEXT
	TAD (EXTCM
	DCA I (DEFALT
	JMS I (LOOKUP
	SZA CLA		/V3C
	TAD I (ASADR
	SNA
	JMP I (ATERR	/IF NO FILESPEC AFTER @, ERROR
	DCA T
	TAD I (LNAME	/GET BLOCK NUMBER
	DCA BLN
	CIF 0
	JMS I T
	200		/READ 2 PAGES
NWB,	BFR+200		/INTO BUFFER
COUNT,
BLN,	0		/FROM THIS BLOCK
	JMP I (ATERR	/ I/O ERROR
	TAD (-200
	DCA COUNT
	TAD (BFR-1
	DCA XR
	TAD NWB
	DCA T
	CDF 0
L$:	TAD I T
	JMS I (P
	CLL RTR
	RTR
	DCA TEMP$
	ISZ T
	TAD I T
	JMS I (P
	CLL RTL
	RTL
	RAL
	TAD TEMP$
	JMS I (P
	CLA
	ISZ T
	ISZ COUNT
	JMP L$
	JMP I (ATOVER

TEMP$:	0

/ATFIN,	TAD LXR
/	TAD (-BEGLN
/	SZA CLA
/	JMP I AT	/LEAVE
/	JMP I (LEAVE	/LEAVE BECAUSE LINE NOW EMPTY
FUDG,	0
	DCA I (OUTSW	/LOAD HANDLER
	TAD I (OUTLIM
	CIA
	DCA CLXR
	JMP I FUDG

GLXR,	0
	CDF 0
	ISZ LXR
	TAD I LXR
	CDF 10
	JMP I GLXR

DONB,	0		/USED AS A FLAG
	JMP I DONB
	PAGE
P,	0
	AND (177
	SNA
	JMP CTZ		/END AT 0 OR ^Z
	TAD (-32
	SNA
	JMP CTZ
	TAD (32-16	/IGNORE CR,LF,FF,VT
	CLL
	TAD (16-12
	SZL
	JMP 1$
	TAD (212	/FORCE 8-BIT
	DCA I XR
1$:	CLA
	TAD I T
	AND (7400
	JMP I P
CTZ,	CDF 10
	TAD LXR
	DCA ATEND
	STA
	TAD LXR
	DCA LXR		/INCASE @ GOES TO EOL
	JMS I (GLXR	/SEARCH FOR EOL
	SZA CLA
	JMP .-2
	TAD LXR
	CMA
	TAD ATEND
	DCA ENDLEN
	TAD XR
	CMA
	TAD (BFR	/GET LENGTH OF INSERTED STUFF
	DCA NEWLEN
	CDF 0
	TAD I ATEND	/GET NEXT CHAR AFTER FILESPEC
	CDF 10		/V3C
	TAD (-"'
	SZA CLA		/IS IT AN APOSTROPHE?
	JMP .+3		/NO
	ISZ ENDLEN	/YES
	ISZ ATEND	/MAKE IT GO AWAY
	TAD ENDLEN
	JMS I (MOVE	/MOVE REST OF LINE UP
	CDF 0
ATEND,	0		/FIRST CHAR POSITION AFTER @ SPEC
	CDF 0
	BEGLN+1000
	TAD NEWLEN	/IF 0, 'MOVE' WILL IGNORE IT
	JMS I (MOVE	/MOVE IN NEW STUFF
	CDF 0
	BFR
	CDF 0
SAVL,	0		/POINTS TO @
	TAD NEWLEN
	CIA
	TAD SAVL
	DCA NEWEND
	CLL
	TAD NEWEND
	TAD MB
	SZL CLA
	JMP ATOVER
	TAD ENDLEN
	JMS I (MOVE	/MOVE BACK END
	CDF 0
	BEGLN+1000
	CDF 0
NEWEND,	0		/FIRST POSITION AFTER NEW STUFF
	JMP I (ATMORE	/LOOK FOR MORE

MB,	-BEGLN-1000
ATOVER,	JMS I (PRMESG
	OVFLOW
ENDLEN,	0		/- NO. OF CHARS AT END INCLUDING 0
NEWLEN,	0		/- NO. OF CHARS BEING INSERTED

ATERR,	CDF 10
	CLA
	JMS I (PRMESG
	ATIO
ATIO,	TEXT	/#BAD FILENAME OR ERROR READING INDIRECT FILE/
OVFLOW,	TEXT	/#COMMAND LINE OVERFLOW/
	PAGE

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLCD.MA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/4	CCL'S COMMAND DECODER
	.EXTERNAL TABLES,FNAME1
	.EXTERNAL SWTCHS
	.ENTRY GETSPC
/THE FOLLOWING DON'T HAVE TO BE ENTRY'S BECAUSE THEY ARE LINKED TO
/FROM THE EXTENSION MODULE (CCLCDX) THAT KNOWS CCLCD IS IN MEMORY
	.GLOBAL LV
	.EXTERNAL EQLPRM,POUND,DNUMB
	MULTI=1		/SET TO 0 TO GET RID OF MULTIPLE CHARACTER SWITCHES
	PTR=36
	.GLOBAL BADEV,CDER2,DVICE	/******
	.GLOBAL ASADR,LNAME		/*****
	.ENTRY CCER1
	.RSECT CCLCD
	.GLOBAL UNKN
	.EXTERNAL FLAG,MOVE,PRMESG
	.EXTERNAL PRNAME,PRWD
	.EXTERNAL LBEGIN,DECODE
	.EXTERNAL ARLOC
	.EXTERNAL DEFILE
	.ENTRY CD,ASSIGN,LOOKUP,ZEROCD,GLXR
	.EXTERNAL OUTSW,OUTLIM
	.ENTRY GCH,SETDEV,SETEXT
	.ENTRY NMOVE
	.EXTERNAL DONB
	.EXTERNAL NAMPTR
	FIELD 1
	MOFILE=7600
	MIFILE=7617
	MPARAM=7643

	XR2=15
	XR=16
	T=20
	TT=21
	DEF=22
	NAME1=23
	NAME2=24
	NAME3=25
	NAME4=26
	NAME5=27
	NMBASE=37
	DEV1=30
	DEV2=31
	DELIM=32
	DEFALT=33	/POINTS TO DEFAULT EXTENSION LIST
	LXR=34
	CLXR=35
	BEGLN=1000
	HNDLR=4400
CD,	0
	JMS I (CDINIT
BEGGRP,	TAD I (OUTSW
	SNA CLA
	TAD I (BEGDIF	/DIFF BETWEEN INPUT & OUTPUT AREAS
	TAD (MOFILE-1
	DCA CLXR
	JMS I (GETSPC	/FAKE-OUT TO GETSPC CAN CAUSE EFFECTIVE BRANCH HERE
	JMS I (ASSIGN
	TAD I (OUTSW
	SNA CLA
	TAD I (LIMDIF	/DIFF BETWEEN END OF OUTPUT & INPUT AREAS
	TAD I (OUTLIM	/END OF OUTPUT AREA
	TAD CLXR
	SMA CLA
	JMP I (CDER1
	TAD I (OUTSW
	SNA CLA
LKUPSW,	JMP IN$		/ZEROED IF IN "SPECIAL DECODE" MODE
	TAD I (DVICE
	JMS PCLXR
	TAD NAME1
	JMS PCLXR
	TAD NAME2
	JMS PCLXR
	TAD NAME3
	JMS PCLXR
	TAD NAME4
	JMP 2$
IN$:	JMS I (LOOKUP
	JMS PCLXR	/STORE LENGTH AND DEV NUMBER
	TAD I (LNAME	/GET BLOCK
2$:	JMS PCLXR
	JMS I (CCLSWT
	TAD I (OUTSW
	SNA CLA
	TAD I (FLAG
	CLL RTL
	SPA CLA		/FEATURE ENABLED?
	TAD LKUPSW
	SNA CLA
	JMP DLOOK	/IN SPECIAL MODE OR ON OUTPUT SIDE
	TAD DELIM
	TAD (-"+
	SNA CLA
	JMP NBS
	TAD DONB
	SZA CLA
	JMP NBS
	TAD (7600	/V1A NOW TAKES ARG IN AC
	JMS I (NMOVE	/MOVE NAME TO OUTPUT FILE NAMES
	JMP DLOOK
NBS,	JMS I (ZERR
DLOOK,	STA
	DCA I (DVFLAG
	TAD DELIM
	SNA
	JMP I CD
	TAD (-"[
	SNA
	JMP I (OLENGT
	TAD ("[-"+
	SZA
	TAD ("+-",
	SNA
	JMP I (FILLP	/**** JUMPING INTO ROUTINE (IS THIS A BUG?)
	TAD (",-"<
	SZA
	TAD ("<-"_
	SNA
	JMP 5$		/BACK-ARROW (UNDERSCORE) MEANS SAME AS "<"
	TAD ("_-"=
	SZA CLA		/SKIP ON AN EQUAL SIGN (=)
	JMP I (CDER2	/BAD CHAR
	JMS I (GLXR
	JMS I (DECODE
	CLL
	STA		/LINK=0 MEANS LETTER
	TAD LXR		/NOW LINK=1 MEANS LETTER
	DCA LXR
	SZL
	JMP 5$		/= MEANS "<"
	JMS I (EQLPRM	/= MEANS = (NUMERIC PARAMETER)
DL2:	JMS I (CCLSWT
	JMP DLOOK
5$:	ISZ I (OUTSW	/FOUND BACK-ARROW (<)
	JMP I (CDER2	/TWO BACK-ARROWS
	TAD LXR		/GET PTR TO ARROW
	DCA I (ARLOC	/SAVE IT ('EDIT' MIGHT NEED IT)
	JMP BEGGRP

PCLXR,	0
	ISZ CLXR
	DCA I CLXR
	JMP I PCLXR
	PAGE
ZERR,	0
	DCA I (DONB	/ZERO 1ST OUTPUT FILE
	TAD (7577
	DCA XR2
	DCA I XR2
	DCA I XR2
	DCA I XR2
	DCA I XR2
	DCA I XR2
	JMP I ZERR
ASSIGN,	0
	TAD CLXR
	AND I (DVFLAG
	TAD I (OUTLIM
	SMA SZA CLA	/CHECK FOR OUTPUT OR FIRST INPUT
	JMP ASNORM	/IF DEVICE WAS SPECIFIC,
			/OR IF WE ARE ON THE INPUT SIDE,
			/PROCEED NORMALLY
	TAD NAME1
	SNA CLA
	JMP ASGNST
	TAD DFLTNM+1
	DCA DEV2
	TAD DFLTNM
	DCA DEV1
ASNORM,	TAD DEV1
	DCA AS+1
	TAD DEV2
	DCA AS+2
	TAD I (OUTSW
	SNA CLA		/DON'T LOAD HANDLER
			/IF WE ARE ON OUTPUT SIDE OF "_"
	TAD NAME1
SPKLG1,	SNA CLA		/OR THERE IS NO FILE NAME TO LOOK UP
	TAD GETHND	/GETHND=11 NORMALLY,
			/0 IF IN "SPECIAL DECODE" MODE
	IAC
	DCA AS
	TAD (HNDLR+1	/ALLOW TWO PAGE HANDLERS
	DCA ASADR
	CIF 10
	JMS I (200
AS,	0
	0
	0
ASADR,	HNDLR+1
	JMP I (CDER0
	TAD AS+2
ASGNST,	DCA I (DVICE
	JMP I ASSIGN
DFLTNM,	DEVICE DSK
GETHND,	11		/1+11=12 (1=FETCH, 12=INQUIRE)
GETL,	0
	JMS I (GCH
	DCA DELIM
	TAD DELIM
	JMS I (DECODE
	JMP I GETL	/NON-ALPHANUM IN CCL SWITCH
	CLA
	TAD DELIM
	AND (77
	ISZ GETL
	JMP I GETL
CCLSWT,	0
	TAD DELIM
	TAD (-"/
	SNA
	JMP I (SLASH
	TAD ("/-"-
	SZA CLA
	JMP I CCLSWT
	TAD I (OUTSW
	SZA CLA
	JMP I (CDER4	/CCL EXT ON OUTPUT FILE
	TAD (SWTCHS
	DCA DEF
	JMS GETL
	JMP I (CDER44	/NON-ALPHANUMERIC CCL SWITCH
	JMS I (ROTL
	DCA TN$
	JMS GETL
	JMP 1$		/ONE CHAR CCL SWITCH
	TAD TN$
	DCA TN$
	JMS GETL
1$:	SKP CLA		/2 CHAR CCL SWITCH
	JMP I (CDER44	/3 CHAR CCL-SWITCH
	TAD TN$
	JMS I (EXTLUK
	CLA
	ISZ DEF
	CDF 0
	TAD I DEF
	DCA G$		/GET PTR TO ARGUMENT PAIR
	TAD I G$	/GET SUBROUTINE
	DCA H$
	ISZ G$
	TAD I G$	/GET ARGUMENT
	CDF 10
	JMS I H$	/CALL SUBR, ARG IN AC
	JMP CCLSWT+1
G$:	0
H$:	0
TN$:	0
	PAGE
/GETS A NAME FROM FIELD ZERO BUFFER VIA LXR
/RETURNS WITH DELIMETER IN AC
/GIVES ERROR MESSAGE IF NAME IS BAD

GNAME,	0
	DCA NAME1
	DCA NAME2
	DCA NAME3
	DCA NAME4
	DCA NAME5
	TAD (NAME1
	DCA NMBASE
	CLA CMA
	DCA PERDSW
	DCA NAMECT
	JMS I (GCH
	TAD (-"#
	SNA
	JMS I (NUMC	/BUG IF MAKE COMMAND USES A # (OVERLAYS LOOP)
	TAD ("#
	SKP
GTNMLP,	JMS I (GCH
P2,	DCA DELIM
	TAD DELIM
	TAD (-"%
	SNA
	JMP PER
	TAD ("%-"?
	SZA
	TAD ("?-"*
	SNA
STARSW,	JMP I (CDER6	/"JMP STARNM"
			/IF "SPECIAL DECODE" MODE
	TAD ("*-".
	SNA CLA
	JMP PERIOD
	TAD DELIM
	JMS I (DECODE
	JMP LV
STARNM,	CLA		/THIS CODE HANDLES *'S AND ?'S CORRECTLY
	TAD DELIM
	AND (77
	DCA DELIM
	TAD NAMECT
	TAD (-6
	SMA CLA
	JMP GTNMLP
	TAD NAMECT
	CLL RAR
	TAD NMBASE
	DCA TT
	TAD DELIM
	SNL
	JMS I (ROTL
	TAD I TT
	DCA I TT
	ISZ NAMECT
	JMP GTNMLP
PERIOD,	TAD NAME1
	SZA CLA
	ISZ PERDSW
	JMP I (CDER7	/NULL NAME OR DOUBLE EXTENSION
	ISZ NMBASE
	ISZ NMBASE
	STL CLA RTL	/2 (ALLOW 4 CHARACTER EXTENSION)
	DCA NAMECT
	JMP GTNMLP
LV,	CLA
	TAD DELIM
	JMP I GNAME

PER,	TAD ("?
	JMP P2
PERDSW,	0
NAMECT,	0
	SOFSET=7747

CDER6,	CDF 0
	TAD I (7777
	CDF 10
	RAL
	SPA CLA
	JMP CD6E	/ERROR IF BATCH IS RUNNING
	TAD I (FLAG
	RTL
	SMA CLA
	JMP CD6E	/ONLY IF -LS WORKS
	TAD (-12
	JMS I (MOVE
	CDF 10
	MUNGC
	CDF 10
	7600
	TAD (-34
	JMS I (MOVE
	CDF 0
	1000
	CDF 10
	7612
	DCA I (7646	/SAFETY
	CDF 0
	TAD I (SOFSET
	CDF 10
	DCA BLK
	JMS I (200
	6		/CHAIN TO CCL.SV
BLK,	0


CD6E,	JMS I (PRMESG
	BADSTR

	PAGE
LOOKUP,	0
	DCA LNAME
	TAD NAME1
	SNA CLA
	JMP LKUPST
	TAD I (PERDSW
	TAD NAME4
	SNA CLA
	CLA IAC		/FORCE NAMERM NON-0 IF . AND NO EXT
	TAD NAME4
	DCA NAMERM	/REMEMBER TYPED EXTENSION
	TAD DEFALT
	DCA DEF
	TAD I (SETEXT
	SNA		/HAS AN EXTENSION BEEN SET?
	TAD NAMERM	/NO
	SNA		/DOES FILE HAVE EXTENSION?
	JMP EXT2	/NO EXTENSION TYPED OR SET, DO SUCCESSIVE LOOK-UPS
	JMS EXTLUK	/LOOK FOR EXTENSION
	SNA CLA		/DID WE FIND IT?
	JMP EXT3	/NO, FORCE NULL EXTENSION TO MATCH
EXT2,	CDF 0
	TAD I DEF
	IAC
	SNA CLA
	JMP NEXTEXT	/IGNORE -1'S
	TAD NAMERM
	SZA CLA
	JMP EXT3
	TAD I DEF
	DCA NAME4	/SET NEW EXTENSION
EXT3,	CDF 10
	TAD (NAME1
	DCA LNAME
	TAD I (AS+2
	JMS I (200
	2
LNAME,	0		/NAME1
LENGTH,	0
	JMP LFAILD
	TAD NAME4
	DCA I (SETEXT
	ISZ DEF		/POINT TO ASSOCIATED CUSP NAME
	CDF 0
	TAD I DEF
	CDF 10
	DCA I (DEFILE	/SAVE IT AWAY
	TAD LENGTH
	CLL
	TAD (400
	SNL
CLACON,	7600		/CLA
	CLL RTL
	RTL
	AND (7760
LKUPST,	TAD DVICE
	JMP I LOOKUP
LFAILD,	TAD NAMERM
	CDF 0
	SNA CLA		/WAS THERE AN EXPLICIT EXTENSION?
	TAD I DEF	/NO - WAS THERE A DEFAULT EXTENSION?
	SNA CLA
	JMP XYZ
NEXTEXT,CDF 10
	ISZ DEF		/NO EXPLICIT EXT AND YES DEFAULT EXT
	ISZ DEF		/POINT TO NEXT POSSIBLE DEFAULT EXTENSION
	JMP EXT2	/AND TRY FOR IT

NAMERM,	0
DVICE,	0

EXTLUK,	0
	CIA
	DCA T
1$:	CDF 0
	TAD I DEF
	CDF 10
	SNA		/AT NULL?
	JMP I EXTLUK	/YES
	TAD T		/NO
	SNA CLA		/MATCH?
	JMP 2$		/YES
	ISZ DEF		/NO
	ISZ DEF		/POINT TO NEXT ENTRY
	JMP 1$		/TRY AGAIN
2$:	TAD T		/RETURN WITH IT IN AC
	CIA
	JMP I EXTLUK
XYZ,	CDF 10
	JMP I (CDER3	/NO DEFALT EXTENSION OR YES EXPLICIT EXTENSION
BADSYN,	TEXT	/#ILLEGAL SYNTAX/
TOOMAN,	TEXT	/#TOO MANY FILES/
/AMBIGY,	TEXT	/#AMBIGUOUS SWITCH/
CDER1,	JMS I (PRMESG
	TOOMAN
NFOU,	TAD NAME1
	AND (77
	SNA CLA
	JMP I (ONE		/ONE-CHARACTER SWITCH
	JMS I (PRNAME
	JMS I (PRMESG
	SWNF
	PAGE
/TAKES A LETTER OR A DIGIT IN AC
/AND TURNS ON APPROPRIATE BIT IN OPTION TABLE

SLSHCH,	0
	DCA DELIM
	TAD (MPARAM-1
	DCA T
	TAD DELIM
	JMS I (DECODE
	JMP CDER8
	SZL
	TAD (32
	CMA STL		/THE FOLLOWING TURNS
			/ON THE CORRECT OPTION BIT
	DCA TT
L$:	SZL
	ISZ T
	RAR
	SNL
	ISZ TT
	JMP L$
	DCA TT
	TAD TT
	CMA
	AND I T
	TAD TT
	DCA I T
	JMP I SLSHCH

CDER8,	CLA
	JMS I (PRMESG
	BADOPT
ZEROCD,	0
	TAD (-42	/AC MAY BE NON-0
	DCA T
	TAD (MOFILE-1
	DCA XR
	DCA I XR	/ZERO THE COMMAND DECODER OUTPUT AREA
	ISZ T
	JMP .-2
	JMP I ZEROCD

GCH,	0
	JMS GLXR
	TAD (-240
	SNA
	JMP GCH+1	/IGNORE SPACES
	TAD (240-"(
	SNA
	JMP OPENP$
	TAD ("(
	JMP I GCH
	JMP GCH+1
OPENP$:	JMS GLXR
	TAD (-")
	SNA
	JMP GCH+1
	TAD (")
	JMS SLSHCH
	JMP OPENP$

GLXR,	0
	CDF 0
	ISZ LXR
	TAD I LXR
	CDF 10
	JMP I GLXR

	IFZERO MULTI <
SLASH,	JMS GLXR
	JMS SLSHCH
	JMS GLXR
	DCA DELIM
	JMP I (CCLSWT+1
	>

	IFNZRO MULTI <
SLASH,	CDF TABLES	/POINT TO SWITCH TABLE POINTER
	TAD I PTR	/GET PTR TO SWITCH TABLE
	CDF 10
	JMS I (TRANSL
	JMP I (CCLSWT+1
	>
OLENGT,	TAD I (OUTSW
	AND NAME1	/[N] IS ONLY LEGAL
			/ON THE OUTPUT SIDE OF THE "_"
	SNA CLA		/AND ONLY AFTER A FILE NAME
	JMP I (CDER2
	TAD (-4
	TAD CLXR
	DCA NMBASE
	JMS I (DNUMB
	CLL RTL
	RTL
	AND (7760
	TAD I NMBASE
	DCA I NMBASE
	CDF 0
	TAD DELIM
	TAD (-"]	/IS THERE A CLOSING BRACKET?
	SNA		/IF NOT,
			/"DLOOK" ROUTINE WILL DETECT IT
	JMS GCH
	DCA DELIM
	JMP I (DL2
SETDSK,	0
	TAD DSKDEV
	SZA
	JMP I SETDSK
	JMS I (200
	12		/INQUIRE
	5723		/PACKED ENCODING FOR 'DSK:'
DSKDEV,	0		/SET TO DEVICE NUMBER
	0
	HLT		/NO 'DSK' !
	TAD DSKDEV
	JMP I SETDSK
	.ENABLE ASCII
	.DISABLE FILL
MUNGC,	TEXT	/MUNG WILD,/
	.ENABLE SIXBIT
	.ENABLE FILL
	PAGE
CCER1,	TAD I (NAMPTR
	DCA X$
	TAD (-5
	JMS I (MOVE
	CDF 10
X$:	0
	CDF 10
	NAME1
CDER3,	TAD (4300
	JMS I (PRWD	/#
	JMS I (PRNAME
	JMS I (PRMESG
	NF

CCER2,	TAD I (DVNM1
	DCA DEV1
	TAD I (DVNM2
	DCA DEV2
CDER0,	TAD DEV1
	SNA CLA
	JMP I (CDER2	/B DOES NOT EXIST
	TAD (4300	/#
	JMS I (PRWD
	TAD DEV1
	JMS I (PRWD
	TAD DEV2
	JMS I (PRWD
	JMS I (PRMESG
	DNE
NF,	TEXT	/ NOT FOUND/
DNE,	TEXT	/ DOES NOT EXIST/
BADSW,	TEXT	/#SWITCH NOT ALLOWED HERE/
BADSW2,	TEXT	/#BAD CCL SWITCH/
CONTRA,	TEXT	/#CONTRADICTORY SWITCHES/
BKA,	0
	TAD I (LBEGIN
	DCA CLXR
1$:	CDF 0
	ISZ CLXR
	TAD I CLXR
	CDF 10
	SNA
	JMP NOBKR$
	TAD (-"<
	SNA
	JMP I BKA
	TAD ("<-"_
	SNA
	JMP I BKA
	TAD ("_-"=
	SZA CLA
	JMP 1$
	ISZ CLXR	/= MEANS _ IF NOT FOLLOWED BY A DIGIT
	CDF 0
	TAD I CLXR
	CDF 10
	JMS I (DECODE
	SKP CLA		/NOT A DIGIT
	SNL CLA		/MAYBE A DIGIT
	JMP I BKA	/= FOLLOWED BY A NON-DIGIT MEANS _
	JMP 1$		/IT'S AN =NNNN

NOBKR$:	ISZ BKA
	JMP I BKA
BADEV,	TEXT	/#BAD DEVICE/
	PAGE
CDINIT,	0
	ISZ PTR		/POINT TO SWITCH TABLE
	JMS I (200
	13		/RESET ALL HANDLERS
	CDF 0
	TAD I DEFALT
	CDF 10
	TAD (-5200
	SZA CLA		/IS THIS A REQUEST FOR A
			/"SPECIAL DECODE"?
	JMP CDCONT	/NO
	TAD ALTLIM
	DCA I (OUTLIM	/YES, SET UP THE PROPER LOCATIONS
	TAD ALTDF1
	DCA LIMDIF	/TO GET 1 OUTPUT AND 5 INPUT FILES
	TAD ALTDF2
	DCA BEGDIF	/ALL OF WHICH ARE
			/5-WORD <DEVICE,NAME> ENTRIES
	DCA I PLKUPS
	TAD STARJM
	DCA I PSTARS	/AND ALLOW *
			/AS A FILE OR EXTENSION NAME
	TAD L7600	/STOPS FETCHES IN SPECIAL MODE
	DCA I PSPKG1	/NO HANDLER FETCHES NECESSARY EITHER
			/SINCE NO LOOKUPS
CDCONT,	JMS I (BKA	/SCAN AHEAD FOR <
	STA		/SKIP RETURN IF NOT FOUND
	DCA I (OUTSW
	JMS I (ZEROCD
	TAD I (LBEGIN
	DCA LXR
	JMP I CDINIT
/CONSTANTS NECESSARY TO SUPPORT "SPECIAL DECODE" MODE
ALTLIM,	1-MOFILE-5
ALTDF1,	MOFILE+5-MPARAM+5
ALTDF2,	5
PLKUPS,	LKUPSW
PSTARS,	STARSW
PSPKG1,	SPKLG1

BEGDIF,	MIFILE-MOFILE
LIMDIF,	MIFILE-MPARAM+2
/STARJM,	RELOC STARNM	/DUMP LITERALS AT LAST POSSIBLE MOMENT
/	JMP STARNM
/	RELOC
STARJM,	5200+<STARNM&177>
SETDEV,	0		/V1A ARG NOW IN AC
	DCA 1$
	CLL STA RAL	/-2
	JMS I (MOVE
	CDF 0
1$:	0		/PTS TO DEVICE NAME
	CDF 10
	DVNM1
	JMS I (SETOUT
	JMP I SETDEV

UNKN,	0
	TAD SETEXT
	SZA
	TAD T		/NEG OF SWITCH REQUEST
	SZA CLA
	JMP CCERA	/CAN'T HAVE 2ND DEFAULT EXTENSION
	TAD T
	CIA
	DCA SETEXT	/SET DEFAULT EXTENSION
	TAD DEFALT	/SEE IF IT'S IN COMMAND'S SEARCH LIST
	DCA DEF
	TAD SETEXT
	JMS I (EXTLUK
	SNA CLA		/DID WE FIND IT?
	JMP CDER4	/NO
	ISZ DEF		/YES
/	TAD I (JMSUB	/ALLOW RECURSIVE CALL
/	DCA HOLD
	CDF 0
	TAD I DEF
	CDF 10
	JMS I (JMSUB	/CALL ITS SUBR
/	TAD HOLD
/V1A RECURSIVE CALL NO LONGER THREATENS
/	DCA I (JMSUB
	JMP I UNKN

SETEXT,	0		/EXT WHICH HAS BEEN SET BY A CCL SWITCH
CCERA,	JMS I (PRMESG
	CONTRA
CDER2,	JMS PRMESG
	BADSYN

L7600,
CCERB,
CDER4,	7600		/CLA
	JMS I (PRMESG
	BADSW
CDER44,	CLA
	JMS I (PRMESG
	BADSW2
CDER7,	JMS I (PRMESG
	BADX
BADSTR,	TEXT	/#ILLEGAL * OR ?/
SWNF,	TEXT	/ OPTION UNKNOWN/
BADOPT,	TEXT	/#BAD SWITCH OPTION/
	PAGE
BADX,	TEXT	/#BAD EXTENSION/

/THIS GETS A DEV:NAME.EXT SPECIFICATION (USING LXR)
/PUTTING RESULT IN DEV1,DEV2, NAME1-4.
/IT GIVES A FATAL ERROR MESSAGE IF BAD.
GETSPC,	0
	STA
	DCA DVFLAG
	DCA DEV1
FILLP1,	DCA DEV2
FILLP,	JMS I (GNAME
	TAD (-":	/AC CONTAINED DELIM
	SNA CLA
	JMP 3$		/IT'S A DEVICE NAME
	DCA NUMC
	TAD (-4
	JMS I (MOVE
	CDF 10
	NAME1
	CDF 0
	FNAME1		/SAVE AWAY FILE NAME
	JMP I GETSPC
3$:	CLA IAC		/PARSE FILENAME AFTER DEV:
	TAD I (PERDSW
	TAD NUMC
	SZA CLA
	JMP CDERA	/. OR # IN DEVICE NAME
	TAD NAME1
	DCA DEV1
	ISZ DVFLAG
	JMP CDERA	/CATCHES A:B:
	TAD NAME2
	JMP FILLP1

DVFLAG,	0
CDERA,	JMS I (PRMESG
	BADEV

NUMC,	0		/USED AS FLAG INDICATING SAW #
	JMS I (POUND
	JMP I NUMC
NMOVE,	0
	DCA 2$		/V1A ARG IN AC
	TAD I (FLAG
	RTL
	SMA CLA		/FEATURE ENABLED?
	JMP I (CCERB	/NO
	TAD I (OUTSW
	SZA CLA
	JMP I (CCERB	/ON OUTPUT SIDE
	TAD I (MOFILE	/V3C
	SNA CLA		/DON'T CHANGE OUT DEV IF SPECIFIED
	TAD I (FLAG	/LOOK AT 'COPY EXT' BIT
	AND (200
	SNA CLA
	JMP 1$		/IT WASN'T SET
	TAD I (MIFILE	/GET FIRST INPUT DEVICE
	AND (17		/ISOLATE DEVICE BITS
	DCA I (MOFILE	/FORCE THIS TO BE FIRST OUTPUT DEVICE
1$:	TAD I 2$
	SNA
	JMS I (SETDSK	/CHANGE TO 'IAC' TO ALWAYS USE SYS:
	DCA I 2$	/SET DEVICE TO SYS IF NONE
	ISZ 2$
	TAD I 2$	/WAS THERE A SPECIFICATION THERE?
	SZA CLA
	JMP I NMOVE	/YES, DO NOTHING
	TAD I (FLAG
	AND (200	/GET 'COPY EXTENSION' BIT
	SMA SZA CLA	/'SMA' IS UNNECESSARY
	STA		/COPY 4 WORDS IF BIT 4 WAS ON
	TAD (-3		/OTHERWISE ONLY COPY 3 WORDS
	JMS I (MOVE
	CDF 0
	FNAME1
	CDF 10
2$:	0
	JMP I NMOVE
ROTL,	0
	CLL RTL
	RTL
	RTL
	JMP I ROTL

JMSUB,	0
	SNA
	JMP I JMSUB
	DCA T$
	JMS I T$
	JMP I JMSUB
T$:	0
AMBIG,	TAD NAME1
	AND (77
	SNA CLA
	JMP I (ONE
	JMS I (PRNAME
	JMS I (PRMESG
	AMBIGY
AMBIGY,	TEXT	/ OPTION AMBIGUOUS/
	PAGE
SETOUT,	0
	TAD I (FLAG
	RTR
	SZL CLA
	TAD (5
	TAD (7600
	DCA OLOC
	TAD I OLOC
	SZA CLA
	JMP I SETOUT	/HE'S SPECIFIED SOMETHING
	JMS I (200
	12		/INQUIRE
DVNM1,	0
DVNM2,	0
	0
	JMP I (CCER2	/NO SUCH DEVICE
	TAD DVNM2
	DCA I OLOC
	TAD OLOC
	AND (5
	SNA CLA		/USING 2ND OUT DEV?
	JMP I SETOUT	/NO
	ISZ OLOC	/YES
	TAD (-4
	JMS I (MOVE
	CDF 0
	FNAME1
	CDF 10
OLOC,	7600		/INITIALLY 7600 OR 7605
	JMP I SETOUT
/	TAD (PTR TO SWITCH TABLE ENTRY (IN FIELD 0)
/	JMS TRANSL
/	IT PARSES SWITCH, SETS BIT
/	PARSES :VALUE, SETS = OPTION
/	LEAVES DELIMETER IN DELIM

TRANSL,	0
	DCA SPTR	/POINT INTO A SWITCH TABLE
	JMS I (GNAME	/GET A NAME
	DCA DEL
/	TAD NAME4
/	SZA CLA
/	HLT		/EXTENSION ON A SWITCH
	JMS SRCH
	JMP I (NFOU	/SWITCH NOT FOUND
	STA
	TAD SRPTR
	DCA SSPTR	/SAVE PTR INTO LONG NAME
	JMS SRCH	/SEARCH SOME MORE
	SKP		/SHOULDN'T FIND ANYTHING
	JMP I (AMBIG	/AMBIGUOUS SWITCH
	CDF 0
L$:	TAD I SSPTR	/SCAN PAST END OF LONG NAME
	ISZ SSPTR
	AND (77
X240:	SZA CLA
	JMP L$
	TAD I SSPTR
	CDF 10
SL,	AND (377	/ISOLATE CORRESPONDING ONE-CHARACTER SWITCH
	SZA
	JMS I (SLSHCH	/SET APPROPRIATE BIT
	TAD DEL
	DCA DELIM
	TAD DELIM
	TAD (-":
	SNA CLA
	JMS I (EQLPRM
	JMP I TRANSL

ONE,	TAD NAME1
	CLL RTR
	RTR
	RTR
	TAD X240
	AND (77
	TAD X240
	JMP SL

SPTR,	0
SSPTR,	0
DEL,	0
/RETURN 1 IF NAME NOT FOUND
/RETURN 2 IF NAME FOUND

SRCH,	0
1$:	TAD (NAME1
	DCA NPTR
	CLL STA RTL	/-3
	DCA NCNT
	CDF 0
	TAD I SPTR
	CDF 10
	ISZ SPTR
	SNA
	JMP I SRCH	/NOT FOUND
	DCA SRPTR
2$:	TAD I NPTR
	SNA
	JMP 3$
	AND (77
	SZA CLA
	TAD (77		/MUST MATCH BOTH BYTES
	TAD (7700	/NEED ONLY MATCH LEFT BYTE
	CDF 0
	AND I SRPTR
	CDF 10
	CIA
	TAD I NPTR
	SZA CLA
	JMP 1$		/THIS SWITCH AIN'T IT
	ISZ SRPTR
	ISZ NPTR
	ISZ NCNT
	JMP 2$
3$:	ISZ SRCH
	JMP I SRCH

SRPTR,	0		/POINTS INTO LONG NAME TABLE
NCNT,	0
NPTR,	0		/POINTS INTO NAME1-3
	PAGE


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLCDX.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/1	CCL CD EXTENSION
	.ENTRY POUND,NUMBER,EQLPRM,DNUMB
	.EXTERNAL GCH
	.EXTERNAL LV
	MPARAM=7643
	T=20
	DELIM=32
	NAME1=23
	NAME2=24
	NAME3=25
	NAME4=26
	LXR=34
	.EXTERNAL PRMESG
	.RSECT CCLCDX
	FIELD 1

BADNUM,	TEXT	/#BAD NUMBER/

EQLPRM,	0
	DCA NUMFUJ
	JMS NUMBER
	DCA I (MPARAM+3
	CLA CLL CML RAR
	AND I (MPARAM-1	/PRESERVE  ALTMODE
	TAD HIORD
	DCA I (MPARAM-1
	JMP I EQLPRM
NUMBER,	0
	SZA CLA
	TAD (<TAD NUM>-SKP
	TAD (SKP
	DCA NUMADD	/SET NUMADD TO EITHER "SKP" OR "TAD NUM"
	DCA HIORD
NUMLP,	DCA NUM
	JMS I (GCH
	ISZ NUMKNT
	SKP
	JMP EONUM2
	CMA
	TAD NUMFUJ
	TAD ("8		/TEST INPUT CHARACTER FOR RANGE
	CLL CMA		/0-7 IF NUMFUJ=0
	TAD (10		/0-9 IF NUMFUJ=2
	TAD NUMFUJ
	SNL
	JMP EONUM
	DCA T
	CLA CLL CMA RTL
	DCA DELIM
	TAD NUM
ROTLP,	CLL RAL
	DCA NUMX
	TAD HIORD
	RAL
NUMSKP,	SPA		/MODIFIED BY #
	JMP CDER5
	DCA HIORD
	TAD NUMX
	ISZ DELIM
	JMP ROTLP
NUMADD,	TAD NUM		/SKP IF OCTAL
	TAD NUM
	TAD T
	JMP NUMLP
EONUM,	TAD ("0
EONUM2,	DCA DELIM
	TAD NUMKNT
	SPA CLA
	JMP CDER5	/FEWER THAN CORRECT NUMBER OF DIGITS
	TAD NUM
	JMP I NUMBER

NUM,	0
NUMFUJ,	0
NUMKNT,	0		/SET TO -N-1 TO FORCE N DIGITS
HIORD,	0
NUMX,	0
DNUMB,	0
	CLA CLL CML RTL
	DCA NUMFUJ	/SET "NUMBER" TO ACCEPT
			/DIGITS 8 AND 9
	STA		/ALLOW DECIMAL
	JMS NUMBER
	JMP I DNUMB
CDER5,	JMS I (PRMESG
	BADNUM
POUND,	0		/USED AS FLAG INDICATING SAW #
	TAD (SKP
	DCA NUMSKP
	TAD (-11
	DCA NUMKNT
	JMS NUMBER
	DCA NAME2
	TAD HIORD
	DCA NAME1
	STA
	TAD LXR
	DCA LXR
	TAD (-11
	DCA NUMKNT
	JMS NUMBER
	DCA NAME4
	TAD HIORD
	DCA NAME3
	TAD (SPA
	DCA NUMSKP
	JMP I (LV
	PAGE

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLCOR.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/1	CCL CORE (MEMORY) ROUTINES

	.ENTRY DETCOR,OTOD
	.EXTERNAL CORE,CORSIZ
	.EXTERNAL PRINT,LBEGIN,PRWD,CMDERR
	BATCCL=7777

	.RSECT CORF1
	FIELD 1
HISIZ,	0		/HIGHEST MEMORY BANK
NEWCOR,	0		/PROPOSED NEW MEMORY BANK

DETCOR,	0
	CIF 0
	JMS I (CORE
	SNA
	JMS K8
	TAD (-30
	SMA
	JMS I (K32
	TAD (40
	JMS I (OTOD
	DCA CORMES+1
	TAD I (LBEGIN
	DCA XRL
	CDF 0
	STA
	TAD I (CORSIZ
	DCA HISIZ
	ISZ XRL
	TAD I XRL	/GET NEXT CHAR
	SNA
	JMP COREQ	/NOT SETTING CORE SIZE
	TAD (-260
	DCA NEWCOR
	TAD NEWCOR
	AND (7770
	SZA CLA
	JMP DETER	/TRIED TO SET CORE SIZE GT 7
	ISZ XRL		/SHOULD ONLY BE ONE FIELD NUMBER
	TAD I XRL	/IF MORE, THEN ERROR RETURN
	SZA CLA
	JMP DETER
	TAD NEWCOR
	CIA
	TAD HISIZ
	SPA CLA
	JMP BADCOR	/TRIED TO SET SOFTWARE CORE SIZE GT REAL CORE SIZE
	TAD I (BATCCL
	RTL		/BATCH BIT TO LINK
	SZL CLA
	JMP WRSCOR	/CAN'T CHANGE CORE SIZE UNDER BATCH
	TAD NEWCOR
	CLL RTL
	RAL
	DCA NEWCOR
	TAD I (BATCCL
	AND (7707
	TAD NEWCOR
	DCA I (BATCCL
COREQ,	CDF 0
	TAD I (BATCCL
	AND (70
	SNA
	JMP ABSCOR
	TAD (10
	CLL RAR
	JMS I (OTOD
	CDF 10
	DCA SCRMES
	TAD SCRMES
	CIA
	TAD CORMES+1
	SNA CLA
	JMP ABSCOR	/DON'T PRINT SOFT IF = REAL
	JMP I (SCRM

DETER,	CDF 10
	JMP I (CMDERR
	JMP I DETCOR

XRL,	0

BADCOR,	CDF 10
	JMS I (PRINT
	NOCORE
	JMP COREQ

ABSCOR,	CDF 10
	JMS I (PRINT
	CORMES
	JMP I DETCOR

WRSCOR,	CDF 10
	JMS I (PRINT
	BATCOR
	JMP COREQ


K8,	0
	TAD (1716
	JMS I (PRWD
	TAD (1431
	JMS I (PRWD
	CIF CDF 0
	JMP I K8
SCRMES,	TEXT	\00K OF\
	*.-1
CORMES,	TEXT	/  00K MEMORY/

K32,	0
	DCA TMP
	TAD (4100
	DCA I (CORMES+6
	TAD TMP
	JMP I K32
TMP,	0
	PAGE
OTOD,	0
	DCA 2$
	DCA 1$
	TAD 2$
	TAD (-12
	ISZ 1$
	SMA
	JMP .-3
	TAD (72
	DCA 3$
	TAD 1$		/IS THE 'TENS' DIGIT > 9?
	TAD (-13
	SPA CLA		/IF IT IS 9 OR LESS
	JMP .+4		/JMP OVER ADJUSTMENT
	TAD (4061		/OTHERWISE SET 'HUNDREDS' INDICATOR BIT
	DCA I (CORMES
	TAD (-12		/ADJUST 'TENS' BIT
	TAD (-1

	TAD 1$
	SNA
	TAD (40-60
	TAD (60
	CLL RTL
	RTL
	RTL
	TAD 3$
	JMP I OTOD

1$:	0
2$:	0
3$:	0
SCRM,	CDF 10
	JMS I (PRINT
	SCRMES
	JMP I (DETER+2
NOCORE,	TEXT	/# NOT ENOUGH MEMORY/
BATCOR,	TEXT	/#CANNOT CHANGE MEMORY LIMIT WHILE RUNNING BATCH/
	PAGE


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLDAT.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/3	CCL DATE COMMAND

	.ENTRY DATE
	.EXTERNAL PRINT,OTOD,PRWD,PRMESG
	.EXTERNAL CRLF,LOOK,CHAIN
	.EXTERNAL YDATE

	DATWD=7666
	BATCCL=7777

	.RSECT CCLDAT
	FIELD 1

DATE,	0
	TAD I (DATWD
	SNA
	JMP NODATE
	DCA DATEM
	TAD DATEM
	CLL RTL
	RTL
	RAL
	AND (17
	DCA TM1
	TAD TM1
	TAD (MONLST-1
	DCA TM2
	TAD I TM2
	DCA 4$
	TAD DATEM
	AND (7
	DCA T$
	CDF 0
	TAD I (BATCCL
	CDF 10
	CLL RTR
	RTR
	AND (30
	TAD T$
	DCA TM2
	TAD TM2
	TAD (70.
	JMS I (OTOD
	DCA YEAR
	TAD DATEM
	CLL RTR
	RAR
	AND (37
	DCA DATEM
	TAD DATEM
	JMS I (OTOD
	DCA DAY
	STL CLA RTL	/2
	TAD TM2
	CLL RTR
	SNL SMA
	JMP 1$
	ISZ I (JAN
	ISZ I (FEB
1$:	AND (37
	TAD TM2
	TAD (3
	TAD DATEM
	DCA DATEM
	TAD TM1
	TAD (JAN-1
	DCA TM1
	TAD I TM1
	TAD DATEM
2$:	CLL
	TAD (-7
	SZL
	JMP 2$
	TAD (7
	TAD (WEEKLST
	DCA TM2
	TAD I TM2
	DCA 3$
	STA		/DON'T CRLF AND PRINT IN LOWER CASE
	JMS I (PRINT
3$:	0
	STA
	JMS I (PRINT
	DAYDAY
	CLA IAC
	JMS I (PRINT
4$:	0
	STL CLA RAR
	JMS I (PRWD	/SPACE
	TAD DAY
	JMS I (PRWD
	CLA IAC
	JMS I (PRINT
	COM19
	TAD YEAR
	JMS I (PRWD
	JMS I (CRLF
	JMS I (LOOK	/LOOKUP SYS:DATE.SV
	YDATE
	JMP I DATE	/DO NOTHING IF IT'S NOT THERE
	JMP I (CHAIN	/CHAIN TO IT, IF IT'S THERE
T$:	0
NODATE,	JMS I (PRMESG
	NONE
TM1,	0
TM2,	0
DATEM,	0
DAY,	0
YEAR,	0

NONE,	TEXT	/NONE/
	PAGE
MONLST,	MON1
	MON2
	MON3
	MON4
	MON5
	MON6
	MON7
	MON8
	MON9
	MON10
	MON11
	MON12
MON1,	TEXT	/JANUARY/
MON2,	TEXT	/FEBRUARY/
MON3,	TEXT	/MARCH/
MON4,	TEXT	/APRIL/
MON5,	TEXT	/MAY/
MON6,	TEXT	/JUNE/
MON7,	TEXT	/JULY/
MON8,	TEXT	/AUGUST/
MON9,	TEXT	/SEPTEMBER/
MON10,	TEXT	/OCTOBER/
MON11,	TEXT	/NOVEMBER/
MON12,	TEXT	/DECEMBER/
COM19,	TEXT	/, 19/

WEEKLST,DAY1
	DAY2
	DAY3
	DAY4
	DAY5
	DAY6
	DAY7

	.ENABLE ASCII
DAY1,	TEXT	/Satur/
DAY2,	TEXT	/Sun/
DAY3,	TEXT	/Mon/
DAY4,	TEXT	/Tues/
DAY5,	TEXT	/Wednes/
DAY6,	TEXT	/Thurs/
DAY7,	TEXT	/Fri/
DAYDAY,	TEXT	/day /
	.ENABLE SIXBIT

JAN,	0
FEB,	3
	4;0;2;5;0;3;6;1;4;6


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLDRV.MA. 
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

/OVRDRV - OVERLAY DRIVER FOR CCL
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977,1978 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/

/OVERLAY DRIVER
/FOR LINKER PROGRAM MODULES
/VERSION=V3A


/THIS SECT IS TWO LOCATIONS AND CONTAINS THE TRANSFER VECTOR TO SWAPER
/AND A FLAG THAT INDICATES WHETHER A JMP (1) OR JMS (0) WAS PERFORMED
/TO THE TRANSFER VECTOR

/	.SECT	XFERV,Z
/	0			/FLAG, 1=JMP, 0=JMS
/	SWAPER			/TRANSFER VECTOR TO SWAP ROUTINE

/THIS IS THE MAIN DRIVER SECTION

	.SECT	SWAPER,R
	.GLOBAL	SWPTAB,TRANVC

	.ZTERNAL XFERV
	FIELD	1

SWAP,	6102			/VERSION NUMBER
	DCA	AC		/SAVE CALLING AC
	RAL
	DCA	LINK		/AND LINK
	RDF			/GET CALLING DF
	TAD	(CDF		/FORM CDF
SWAP0,	JMP	ONCE		/DO ONCE ONLY CODE - REPLACED BY DCA EXIT
	CDF	.		/CHANGE TO THIS DATA FIELD
	TAD I	SWAP		/GET OVERLAY,LEVEL,FIELD
	DCA	BINDAT		/SAVE
	ISZ	SWAP		/BUMP POINTER
	TAD I	SWAP		/GET SUBROUTINE ADDRESS
	DCA	XITLOC		/SAVE
	TAD	BINDAT		/FORM CDF TO CALLED SUBROUTINE
	AND	(7
	RAL CLL
	RTL
	TAD	(CDF
	DCA	SWAP1A		/SAVE
	TAD	SWAP1A		/FORM CIF TO CALLED SUBROUTINE
	IAC
	DCA	EXIT+1		/SAVE FOR EXIT
/LOAD OVERLAY OF CALLED SUBROUTINE

LOAD,	TAD	BINDAT
	AND	(1600		/EXTRACT LEVEL OF CALLED SUBROUTINE
	RTR CLL			/5 RIGHT
	RTR
	RAR
	DCA	PNTR		/SAVE
	TAD	PNTR
	TAD	(SWPTAB		/COMPUTE ENTRY INTO SWAP TABLE
	DCA	FLD		/POINTS TO FIELD OF OVERLAY
	TAD	PNTR		/COMPUTE ENTRY INTO CURRENT OVERLAY TABLE
	RTR CLL
	TAD	(CURTAB
	DCA	PNTR
	TAD	BINDAT		/EXTRACT DESIRED OVERLAY NUMBER
	AND	(170
	RTR CLL			/RIGHT 3
	RAR
	CIA			/NEGATE
	DCA	TEMP
	TAD	TEMP
	TAD I	PNTR		/COMPARE WITH CURRENT OVERLAY NUMBER FOR LEVEL
	SNA CLA			/SAME?
	JMP	SWAP1		/YES, NO READING NEEDED
LOAD1,	TAD	TEMP		/NO, SET TO NEW
	CIA
	DCA I	PNTR		/OVERLAY NUMBER
	TAD	FLD		/SET UP POINTERS TO
	IAC
	DCA	ADDRES		/ADDRESS
	TAD	ADDRES
	IAC
	DCA	RELBLK		/RELATIVE BLOCK NUMBER
	TAD	RELBLK
	IAC
	DCA	LENGTH		/LENGTH OF OVERLAY
	TAD	TEMP		/TEST OVERLAY NUMBER
	SNA CLA			/0?
	JMP	LOAD2		/YES, NO MULTIPLICATION NEEDED
	TAD I	LENGTH		/BLOCK NUMBER = (LENGTH OF OVERLAY)
	JMP I	.+1		/TIMES (THE NUMBER OF THE OVERLAY)
	PATCH
LOAD2,	TAD I	RELBLK		/PLUS (RELATIVE BLOCK OF LEVEL)
	TAD	STRBLK		/PLUS (STARTING BLOCK OF PROGRAM)
	DCA	REDBLK		/SAVE IN CALL LOCATION
	TAD I	ADDRES		/GET ADDRESS TO LOAD
	DCA	REDADD		/SAVE IN CALL LOCATION
	TAD I	FLD		/GET FIELD
	AND	(7		/MASK
	RTR CLL
	RAR			/POSITION
	TAD I	LENGTH		/GET LENGTH
	RTL
	RTL
	RTL
	DCA	REDCNT		/FORM CONTROL WORD
	CIF	0
	JMS I	(7607		/CALL SYSTEM HANDLER TO READ IN OVERLAY
REDCNT,	7756			/FUNCTION CONTROL WORD (POINTS TO MREAD-1 FOR "ONCE"
REDADD,	-7607			/BUFFER ADDRESS (CONTAINS SYS: ENTRY POINT FOR "ONCE"
REDBLK,	0			/STARTING BLOCK NUMBER
	HLT			/ERROR RETURN ADDRESS

SWAP1,	TAD	XFERV		/GET JMP-JMS FLAG
	SZA CLA			/SET?
	JMP	SWAP2		/YES, EXECUTE A JMP
	CLA CLL CMA RTL		/-3
	TAD	SWAP		/BACK UP TO CALLER'S PC
	DCA	SWAP
	TAD I	SWAP
SWAP1A,	0			/CDF TO CALLED SUBROUTINE
	DCA I	XITLOC		/SAVE IN CALLED SUBROUTINE
	ISZ	XITLOC		/BUMP TRANSFER ADDRESS
	CDF	.
	TAD	(ISZ XFERV
	DCA I	SWAP		/SET BACK UP ENTRY IN XFER VECTOR TABLE
SWAP2,	DCA	XFERV		/CLEAR FLAG
	TAD	LINK		/RESTORE LINK AND AC
	RAR CLL
	TAD	AC
EXIT,	0			/SET DF TO CALLING FIELD
	0			/SET IF TO CALLED FIELD
	JMP I	XITLOC		/GO TO CALLED SUBROUTINE

/VARIABLE LOCATIONS
/SOME OF THE FOLLOWING LOCATIONS CONTAIN
/ONCE ONLY CODE TO SET UP STARTING BLOCK
/AND CHECK THAT FILE CAME FROM SYS:
CURTAB=.			/CURRENT OVERLAY IN LEVEL TABLE (8 ENTRIES)
STRBLK=.			/ENTRY 0 IS USED TO HOLD STARTING BLOCK OF FILE
ONCE,	DCA	EXIT		/SAVE CALLING FIELD
				/ALSO ENTRY 0
	TAD	.-1		/SET UP SO WON'T BE EXECUTED AGAIN
				/ALSO ENTRY 1
	DCA	SWAP0
				/ALSO ENTRY 2
	CDF	0
				/ALSO ENTRY 3
	TAD I	FLD		/GET STARTING BLOCK FROM "SOFSET"
				/ALSO ENTRY 4
	SNA
				/ALSO ENTRY 5
	HLT			/ERROR, K.M. PATCHES NOT IN
				/ALSO ENTRY 6
	DCA	STRBLK		/SAVE
				/ALSO ENTRY 7
	TAD I	REDCNT		/CHECK FILE CAME FROM SYS:
	TAD	REDADD

BINDAT,				/CONTAINS OVERLAY,LEVEL,FIELD OF DESIRED SUBROUTINE
	SNA CLA			/FROM SYS: ?
XITLOC,				/CONTAINS LOCATION TO GO TO IN DESIRED SUBROUTINE
	JMP	SWAP0+1		/YES, OK
PNTR,				/POINTS INTO CURTAB
	HLT			/NO, ERROR
TEMP,				/TEMP STORAGE
	JMP	.-1		/DON'T ALLOW CONTINUE
FLD,				/POINTS TO FIELD WORD IN SWPTAB
	7747			/POINTER TO "SOFSET"

ADDRES=REDADD			/POINTS TO ADDRESS WORD IN SWPTAB
RELBLK=REDBLK			/POINTS TO RELATIVE BLOCK WORD IN SWPTAB
LENGTH=REDCNT			/POINTS TO LENGTH WORD IN SWPTAB

AC,	0			/SAVED AC
LINK,	0			/SAVED LINK

	PAGE

/PATCH TO FIX BLOCK POSITION CALCULATION
PATCH,	IAC		/CONVERT PAGES TO BLOCKS
	CLL RAR
	DCA	PTEMP
	TAD	PTEMP	/MULTIPLY BLOCK LENGTH
	ISZ I	PPNT	/BY OVERLAY NUMBER
	JMP	.-2
	JMP I	.+1
	LOAD2
PPNT,	TEMP
PTEMP,	0



/THIS AREA CONTAINS OVERLAY DATA FOR MAIN AND THE 7 LEVELS
/THE FORMAT OF EACH ENTRY IS:
/WORD1:	FIELD OF LEVEL
/WORD2:	ADDRESS OF LEVEL
/WORD3:	RELATIVE BLOCK OF 1ST OVERLAY IN LEVEL
/WORD4:	LENGTH OF THE LEVEL (ANY AND ALL OVERLAYS-EACH)
/	(ALL OVERLAYS IN A LEVEL ARE THE SAME LENGTH)

SWPTAB,

	*.+40

/THIS AREA CONTAINS THE TRANSFER VECTORS FOR EACH ENTRY POINT
/IN ALL THE OVERLAYS IN ALL THE LEVELS
/ITS SIZE SHOULD BE MODIFIED BY THE USER
/TO FIT THE MAXIMUM NUMBER OF TRANSFER VECTORS NEEDED
/EACH TRANSFER VECTOR OCCUPIES 4 LOCATIONS
/THE TABLE IS INITIALLY SET UP FOR 24(DEC) (30(OCT)) VECTORS
/THE MAXIMUM SIZE THIS TABLE CAN BE IS 3774 (OCT) LOCATIONS FOR
/511 (DEC) (777 (OCT)) VECTORS
/THE FORMAT OF EACH VECTOR ENTRY IS:
/WORD1:	ISZ	XFERV
/WORD2:	JMS I	XFERV+1
/WORD3:	LEVEL/OVERLAY/FIELD
/WORD4:	ADDRESS

TRANVC,

	SIZE=53.	/MODIFY THIS LINE TO CHANGE THE SIZE OF THE TABLE
			/SET FOR 24(DEC)

	*SIZE^4+.




<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLMSG.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/2	CCL MESSAGE PRINTER
	.EXTERNAL TWAIT,BATCH

	T=20
	BATOUT=7400	/JMS HERE TO PRINT ON BATCH LOG
	BATERR=7000	/JMP HERE TO ABORT BATCH
	NAME1=23
	NAME2=24
	NAME3=25
	NAME4=26
	NAME5=27

	.GLOBAL PRMESG,PRWD,PRNAME,PRINT,CRLF
	.GLOBAL LEAVE
	.RSECT CCLMSG

	FIELD 1

PRMESG,	0
	CLA
	TAD I PRMESG
	DCA TE2
	JMS PRINT
TE2,	HLT
LEAVE,	JMS I (TWAIT
/V3D	TCF
	CIF CDF 0
	TAD FATALFLG
	SNA CLA
	JMP I (7605
FATALFLG,0		/CIF CDF BATCH FIELD IF WANT TO ABORT
	JMP I (BATERR

PRWD,	0
	DCA T
	TAD T
TTY212,	RTR
	RTR
	RTR
	JMS PCHAR
	TAD T
	JMS PCHAR
	JMP I PRWD

PCHAR,	0
	AND (77
TNOP,	SNA
	JMP I PCHAR	/IGNORE NULLS
	TAD (240
	AND (77
	TAD (240	/CAN'T USE 'TTY240'
	JMS TYPE
	JMP I PCHAR
TE,
PRNAME,	0
	TAD NAME1
	JMS PRWD
	TAD NAME2
	JMS PRWD
	TAD NAME3
	JMS PRWD
	TAD NAME4
	SNA CLA
	JMP I PRNAME
	TAD (256
	JMS PCHAR
	TAD NAME4
	JMS PRWD
/	TAD NAME5
/	SZA
/	JMS PRWD
	JMP I PRNAME
TYPE,	0
/	SNA
/	JMP I TYPE	/CAN REMOVE IF NEED ROOM
	DCA TE2
	JMS I (BATCH
	JMP TTYOUT
	DCA CIFB
CIFB,	HLT		/REPLACED BY CIF BATCH FIELD
	TAD TE2
	JMS I (BATOUT
	TAD TE2
	TAD (-"#
	SZA CLA
	JMP I TYPE
	TAD CIFB
	IAC		/CONVERT CIF TO CIF CDF
	DCA FATALFLG
	JMP I TYPE

TTYOUT,	TAD TE2
	TAD (-"#	/DON'T TYPE #'S
	SNA CLA
	JMP I TYPE
	TAD T7600
	KRS
	TAD (-7603
	SNA
	JMP LEAVE
	TAD (203-217
	SNA CLA
	JMP I TYPE
	TAD TE2
TJUMP,	JMP .+3
	TSF
	JMP .-1
	TLS
T7600,	7600
	TAD TNOP
	DCA TJUMP
	JMP I TYPE
PRINT,	0
	DCA CRLF	/AC NON-0 MEANS DON'T CRLF
	TAD I PRINT
	ISZ PRINT
	DCA TE
	TAD CRLF
	SPA CLA
	TAD (TYPE-PRWD
	TAD (PRWD
	DCA PROUT
1$:	TAD I TE
	JMS I PROUT
	TAD I TE
	ISZ TE
	AND (77
	SZA CLA
	JMP 1$
	CLA IAC
	AND CRLF
	SNA CLA
	JMS CRLF
	JMP I PRINT

PROUT,	PRWD
CRLF,	0
	TAD (215
	JMS TYPE
	TAD TTY212
	JMS TYPE
	JMP I CRLF
	PAGE


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLPS.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/1
	.ASECT MORTBL
	FIELD 0
	*7130
	.EXTERNAL NMOVE,DONB,UNKN
	.EXTERNAL SETDEV,LPTDEV,TTYDEV,TVDEV,PTPDEV,DMPDEV,NULDEV
	.GLOBAL SWTCHS
SWTCHS,	1423;	P1	/LS
	1602;	P2	/NB
	1520;	P3	/MP
	1400;	P4	/L
	2400;	P5	/T
	2300;	P6	/S
	2000;	P7	/P
	0400;	P8	/D
	1600;	P9	/N
	0000;	P10	/UNKNOWN
P1,	NMOVE
	7605
P2,	DONB
	0
P3,	NMOVE
	7612
P4,	SETDEV
	LPTDEV
P5,	SETDEV
	TTYDEV
P6,	SETDEV
	TVDEV
P7,	SETDEV
	PTPDEV
P8,	SETDEV
	DMPDEV
P9,	SETDEV
	NULDEV
P10,	UNKN
	0

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLREM.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/1	CCL RECOLLECTION ROUTINES

	.EXTERNAL REMD,SCAN,LBEGIN,BEGLN,PRMESG,PRINT

	DATWD=7666
	CLXR=35
	XR=16

	.ENTRY REMEM,FOREVER,RECALL
	.RSECT CCLREM
	FIELD 1

/CCL REMEMBERS UP TO 8 COMMAND LINES (EACH UP TO 55 DECIMAL
/SIXBIT CHARACTERS LONG) IN BLOCK 65 ON THE SYSTEM DEVICE.
/THIS BLOCK WHEN READ INTO 04000-04377 HAS THE FOLLOWING FORMAT:

/4000-4037	REM-LINE 0
/4040-4177	REM-LINE 1
/4100-4137	REM-LINE 2
/4140-4177	REM-LINE 3
/4200-4237	REM-LINE 4
/4240-4277	REM-LINE 5
/4300-4337	REM-LINE 6
/4340-4377	REM-LINE 7

/EACH REM-LINE HAS THE FOLLOWING FORMAT:

/WORD 0:	IN-USE FLAG, MUST BE '1234' TO INDICATE LINE WAS REMEMBERED HERE
/WORD 1:	DATE LINE WAS REMEMBERED
/WORD 2:	COMMAND DEPENDENT INFORMATION
/WORD 3:	RESERVED FOR FUTURE EXPANSION
/WORDS 4-37	COMMAND LINE NOT INCLUDING KEYWORD OR FOLLOWING SPACES
/		PACKED IN 6-BIT AND TERMINATED BY A 6-BIT 0.

/ROUTINES:

/	TAD (DEP
/	JMS REMEM
/	N

/REMEMBERS CURRENT LINE IN REM-LINE N.  AC IS LINE DEPENDENT INFORMATION.
/IF LINE IS TOO BIG, THIS PRINTS A WARNING MESSAGE AND RETURNS AS IF OK.

/	JMS RECALL
/	N

/RECALLS REM-LINE N INTO BUFFER
/IF NOTHING THERE, PRINTS A BAD SYNTAX MESSAGE AND RETURNS TO OS/8.
/UPON RETURN, LINE-DEPENDENT INFO IS IN AC.
/IF DATES DON'T MATCH, IT'S NOT THERE UNLESS DATE = -1

/0	USED BY TECO, MAKE COMMANDS
/1	USED BY EDIT, CREATE COMMANDS
/2	USED BY COMPILE, EXECUTE COMMANDS & PAL.
/	DEPENDENT WORD IS PTR TO FIRST ENTRY IN MAIN TABLE

/3	USED BY 'UA' COMMAND
/4	USED BY UB
/5	USED BY UC

/	JMS FOREVER

/CAUSES NEXT CALL TO REMEM TO INSERT -1 AS DATE
	REMSPACE=4000
	REMBLOCK=65

REMEM,	0
	DCA DEP
	TAD I (REMD
	SMA CLA
	JMP I REMEM	/DON'T REMEMBER IF JUST RECALLED
	JMS I (RDREM
	JMP I (MEMBIG
	TAD I REMEM
	ISZ REMEM
	CLL RTL
	RTL
	RAL		/MULTIPLY BY 40
	TAD (REMSPACE
	DCA LPTR
	TAD (1234
	CDF 0
	DCA I LPTR
	CDF 10
	ISZ LPTR
FORVR,	TAD I (DATWD	/REPLACED BY CMA IF WANT NO DATE
	JMS LPUT	/STORE DATE
	TAD DEP
	JMS LPUT	/STORE DEPENDENT INFO
	JMS LPUT	/RESERVED
	JMS I (SCAN	/GO PAST KEYWORD AND BLANKS
	TAD I (LBEGIN
	DCA XR
L$:	JMS I (GETF
	JMP 3$
	JMS I (ROTL
	DCA TML
	JMS I (GETF
	JMP 2$
	TAD TML
	JMS LPUT
	JMP L$
2$:	TAD TML
3$:	JMS LPUT
	JMS I (WRREM
	JMP I (MEMBIG
REMGO,	JMP I REMEM
DEP,	0
LPTR,	0		/PTS TO REM-LINE
TML,	0		/TEMP

/PUT INTO REM-LINE

LPUT,	0
	DCA TML
	TAD LPTR
	AND (37
	SNA CLA
	JMP I (MEMBIG
	TAD TML
	CDF 0
	DCA I LPTR
	CDF 10
	ISZ LPTR
	JMP I LPUT

FOREVER,0
	TAD LCMA
	DCA FORVR
	JMP I FOREVER	/NON-ZERO MEANS SET DATE TO -1
RECALL,	0
	JMS I (RDREM
	JMP I (REMERR
	TAD I RECALL
	ISZ RECALL
	JMS I (ROTL
	RAR
	TAD (REMSPACE
	DCA LPTR
	JMS LGET
	TAD (-1234
	SZA CLA
	JMP I (REMER2
	JMS LGET
	SNA
	JMP I (REMER2
LCMA,	CMA
	SNA
	JMP 1$
	IAC
	TAD I (DATWD	/SAME DAY?
	SZA CLA
	JMP I (REMER2
1$:	JMS LGET
	DCA DEP
	JMS LGET	/IGNORE RESERVED WORD
	CLA
	TAD (BEGLN-1
	DCA XR
	TAD (BEGLN-1
	DCA I (LBEGIN
L$:	JMS LGET
	DCA TML
	TAD TML
	JMS I (ROTL
	RAL
	JMS I (PUTF
	JMP LV$
	TAD TML
	JMS I (PUTF
	JMP LV$
	JMP L$

LV$:	TAD DEP
	JMP I RECALL
LGET,	0
	CDF 0
	TAD I LPTR
	CDF 10
	ISZ LPTR
	JMP I LGET
	PAGE
PUTF,	0
	AND (77
	SNA
	JMP PUTZ
	ISZ PUTF
	TAD (240
	AND (77
	TAD (240
PUTZ,	CDF 0
	DCA I XR
	CDF 10
	JMP I PUTF

REMERR,	JMS I (PRMESG
	REMBAD
REMER2,	JMS I (PRMESG
	BADREM
MEMBIG,	CLA
	JMS I (PRINT
	MEMWARN
	JMP I (REMGO

RDREM,	0
	CIF 0
	JMS I (7607
	200		/READ 2 PAGES INTO FIELD 0
	4000		/LOCATION 4000
	REMBLOCK
	SKP CLA
	ISZ RDREM
	JMP I RDREM

WRREM,	0
	CIF 0
	JMS I (7607
	4200		/WRITE 2 PAGES FROM FIELD 0
	4000		/LOCATION 4000
	REMBLOCK
	SKP CLA
	ISZ WRREM
	JMP I WRREM
/GET FROM INPUT LINE VIA XR

GETF,	0
	CDF 0
	TAD I XR
	CDF 10
	SZA
	ISZ GETF
	AND (77
	JMP I GETF
ROTL,	0
	CLL RTL
	RTL
	RTL
	JMP I ROTL

MEMWARN,TEXT	/%CAN'T REMEMBER/
REMBAD,	TEXT	\#I/O ERROR TRYING TO RECALL\
BADREM,	TEXT	/#BAD RECOLLECTION/
	PAGE


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLRUN.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/1	CCL RUN COMMAND

	.RSECT CCLRUN
	FIELD 1

	.ENTRY MONFIX,MONRES
	.EXTERNAL RDMON,PRMESG
	.EXTERNAL F1,F2,LO1,LO2
	.EXTERNAL YLOAD,YLOADER,YF4,YFORT
	.EXTERNAL LOOK
	.EXTERNAL BLK,IOERR
	PRQMRK==1357
	CCLBLK=67
	DEASADR=427
	CCLSW=435
	GETCCL=1362
	.EXTERNAL YCCL
	OS78BIT=7771

MONFIX,	JMS I (RDMON
	CDF 0
	TAD I ZERO
	TAD (-7607
	SNA CLA
	JMP I (CCER3	/ALWAYS WRITE OUT CCL BLOCK
	CDF 10
	CIF 0
	JMS I L7607
	4200		/WRITE 1 RECORD FROM FIELD 0
	400		/LOCATIONS 400-777
	CCLBLK		/INTO THE SYSTEM'S CCL BLOCK
	JMP I (IOERR
	CDF 0
	TAD I (2000+CCLSW
	TAD XXX
	SNA
	JMP OK$
	TAD XXX2
	SZA CLA
	JMP I (CCER3
/	CIF CDF 0
/	JMP I L7605
OK$:	TAD (GETCCL
	DCA I (2000+CCLSW
	STA
	DCA I (2000+DEASADR	/DELETE DEASSIGN
	JMS WRMON
	IFZERO 1 <
	JMS I (LOOK
	YFORT		/LOOK FOR FORT.SV
	TAD XXX3	/NOT FOUND, USE F4
	TAD (YFORT	/FOUND USE IT
	DCA I (F1
	TAD I (F1
	DCA I (F2
	TAD I (F1
	TAD MYFORT
	SZA CLA
	TAD XXX4
	TAD (YLOADER
	DCA I (LO1
	TAD I (LO1
	DCA I (LO2
	JMS I (LOOK
	YCCL
	JMP I (IOERR	/CCL.SV NOT FOUND
	TAD I (BLK
	TAD (4		/*3400 IS 4TH BLOCK OF CCL NOT COUNTING CCB
	DCA B$
	CDF 10
	CIF 0
	JMS I (7607
	4210		/WRITE 1 RECORD FROM FIELD 1
	3400		/LOCS 3400-3777
B$:	0
	JMP I (IOERR
	>
	CIF CDF 0
	JMP I (7605

XXX,	-PRQMRK
XXX2,	PRQMRK-GETCCL
	IFZERO 1 <
MYFORT,	-YFORT
XXX3,	YF4-YFORT
XXX4,	YLOAD-YLOADER
	>
WRMON,	0
	CDF 10
	CIF 0
	JMS I L7607
	4200
	2400
	10
	JMP I (IOERR
	JMP I WRMON

ZERO,	0
L7607,	7607
MONRES,	0
	CDF 0
	TAD I (OS78BIT
	CDF 10
	AND (200
	SZA CLA
	JMP ERR
	JMS I (RDMON
	CDF 0
	TAD (PRQMRK
	DCA I (2000+CCLSW
	TAD (-405
	DCA I (2000+DEASADR
	JMS WRMON
	JMP I MONRES

ERR,	JMS I (PRMESG
	.+1
	TEXT	"#CCL IS THE CONCISE COMMAND LANGUAGE FOR OS/78"
CCER3,	CDF 10
	JMS I (PRMESG
	BADMON
BADMON,	TEXT	/#BAD MONITOR/
	PAGE


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLSB2.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/2	CCL SUBROUTINES PART 2
	.ENTRY TRMSUB,REQSUB,CANSUB
	OS78BIT=7771
	.EXTERNAL PRMESG,LOOK,CHAIN,YTERMIN,PRINT,LEAVE

	.RSECT CCLSB2
	FIELD 1
	.SBTTL TERMINATE COMMAND

TRMSUB,	0
	CDF 0
	TAD I (OS78BIT
	CDF 10
	AND (200
	SNA CLA
	JMP I TRMSUB	/BACKSPACE, NOT TERMINATE
	JMS I (LOOK	/LOOKUP TERMIN.SV
	YTERMIN
	SKP CLA
	JMP I (CHAIN
	6073
	6002
	CLA STL RAR	/JUST IN CASE WE'RE NOT ON A VT-78
	JMS I (PRINT
	BADEV
	JMP I (LEAVE
CANSUB,	0
	TAD I (7726
	AND (4
	SNA CLA
	JMP FOO4
	TAD I (7726
	AND (7773
	DCA I (7726	/TURN OFF SYMBIONT BIT
	CDF 0
	TAD I (7777
	RTL
	SZL CLA
	JMP 3$
	TAD I (7777
	AND (7707
	DCA I (7777
3$:	CDF 10
	STL CLA RAR
	JMS I (PRINT
	OFFMSG
	STL CLA RAR
	JMS I (PRINT
	ME2MSG
	CIF CDF 30
	JMP I (3	/GO TO MAGIC SPOT IN SYMBIONT LAND

FOO3,	STL CLA RAR
	JMS I (PRINT
	ALRACT
	JMP I (LEAVE
FOO4,	STL CLA RAR
	JMS I (PRINT
	NOTACT
	JMP I (LEAVE
	PAGE
	.SBTTL REQUEST COMMAND

REQSUB,	0
	TAD I (7617
	AND (17
	TAD (7647-1
	DCA T
	TAD I T
	TAD (-7607
	SZA CLA
	JMP FOO		/*** FILE NOT ON SYS:
	TAD I (7620
	DCA BLK
	CDF 0
	TAD I (7777
	AND (70
	TAD (-20
	SNA CLA
	JMP 1$
	RTL
	SZL CLA
	JMP FOO2
	TAD I (7777
	AND (7707
	TAD (20
	DCA I (7777
1$:	CDF 10
	TAD I (7726
	AND (4
	SZA CLA
	JMP FOO3
	TAD I (7726
	AND (7773
	TAD (4
	DCA I (7726
	STL CLA RAR
	JMS I (PRINT
	ONMSG
	STL CLA RAR
	JMS I (PRINT
	MEMMSG
	JMS I (200	/CHAIN TO IT
	6
BLK,	0

T,	0
FOO,	STL CLA RAR
	JMS I (PRINT
	SYSMSG
	JMP I (LEAVE

FOO2,	CDF 10
	STL CLA RAR
	JMS I (PRINT
	BATMSG
	JMP I (LEAVE
	PAGE
	.ENABLE ASCII
SYSMSG,	TEXT	"#Symbiont must be on SYS:"
BATMSG,	TEXT	"#Cannot start symbiont from BATCH"
ONMSG,	TEXT	"[Starting symbiont]"
BADEV,	TEXT	"#Illegal OS/8 command"
OFFMSG,	TEXT	"[Shutting down symbiont]"
NOTACT,	TEXT	"%No symbiont is active"
ALRACT,	TEXT	"#Request denied - symbiont already running"
MEMMSG,	TEXT	"[12K Memory]"
ME2MSG,	TEXT	"[16K Memory]
	.ENABLE SIXBIT

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLSEM.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/1	CCL SEMICOLON CODE

	.ENTRY SEMI

	.EXTERNAL PRMESG,YBATCH,ZOW,BEGLN
	MOFILE=7600
	XR=16

	.RSECT SEM1
	FIELD 1

ENGOA,	TAD (-5
	JMS I (ZEROCD
	TAD I (BLKNO
	DCA I (7620
	CLA IAC
	DCA I (7617	/'CCBTCH' IS ON SYS:
	TAD (20		/   /T OPTION
	DCA I (7644
	TAD (20		/  ALSO /H (HUSH) OPTION
	DCA I (7643
	TAD (YBATCH
	JMP I (ZOW	/CHAIN TO BATCH

ZEROCD,	0
	TAD (-42	/AC MAY BE NON-0
	DCA T$
	TAD (MOFILE-1
	DCA XR
	DCA I XR	/ZERO THE COMMAND DECODER OUTPUT AREA
	ISZ T$
	JMP .-2
	JMP I ZEROCD
T$:	0
SEMSG1,	TEXT	/? ENTER ERROR/
SEMSG2,	TEXT	\?I/O ERROR\
SEMSG3,	TEXT	/?DEVICE FULL/
SEMSG4,	TEXT	/?CLOSE ERROR/
	PAGE
	BATBUF=4400	/LOCATION OF ONE BLOCK BATCH TEMP BUFFER
	USR=200
	GLINE=1200	/LOCATION FROM KBM
	CTRLCK=1241	/LOC FROM KBM, PTS TO PLACE TO BRANCH ON ^C
BATPTR,	BATBUF-1
LCHAR,	0

SEMGO,	CIF CDF 10
	JMP I SEMI

SEMI,	0
	CLA IAC		/SYS
	JMS I (USR
	3		/ENTER
BLKNO,	TEMNAM
BLKLEN,	0		/NEG OF LENGTH
	JMP SEMER1	/ENTER ERROR
	TAD BLKNO
	DCA BATBLK
	TAD (BEGLN-1
	DCA XR
	TAD (7600
	DCA I (CTRLCK	/FORCE ^C TO GLINE TO GO TO 7600
	JMS BATLST
	BATHED
S2,	CDF 0
	TAD I XR
	CDF 10
	SNA
	JMP LINEND
	DCA LCHAR	/SAVE CHAR
	TAD LCHAR
	TAD (-";
	SNA CLA
	JMP GOTSEM
	TAD LCHAR
S3,	JMS BATPUT
	JMP S2
LINEND,	TAD LCHAR
	TAD (-";	/LOOK AT LAST CHAR
	SZA CLA		/WAS IT SEMICOLON?
	JMP BATEND	/NO, END OF TEMP BATCH STREAM
	CIF CDF 0
	JMS I (GLIN	/YES, READ NEW LINE FROM KEYBOARD
/**** WHAT IF WE'RE RUNNING UNDER BATCH ****
	TAD (BEGLN-1
	DCA XR
	JMP S2

GOTSEM,	JMS KRLF
	TAD (".
	JMP S3

KRLF,	0
	TAD (215
	JMS BATPUT
	TAD (212
	JMS BATPUT
	JMP I KRLF

BATPUT,	0
	ISZ BATPTR
	CDF BATBUF
	DCA I BATPTR
	CDF 10
	TAD BATPTR
	TAD (-BATBUF-377
	SNA CLA
	JMS BATWRIT	/WRITE OUT BUFFER IF FULL
	JMP I BATPUT
BATWRIT,0
	CIF 0
	JMS I (7607
	4200		/WRITE 1 BLOCK
	BATBUF
BATBLK,	0
	JMP SEMER2	/  I/O ERROR
	ISZ BATBLK	/POINT TO NEXT BLOCK
	ISZ BATLEN	/BUMP LENGTH
	ISZ BLKLEN
	SKP
	JMP SEMER3	/DEVICE FULL
	TAD (BATBUF-1
	DCA BATPTR
	JMP I BATWRIT

BATEND,	JMS KRLF
	JMS BATLST
	BATAIL
	JMS BATWRIT
	CLA IAC		/SYS
	JMS I (USR
	4		/CLOSE
	TEMNAM
BATLEN,	0		/LENGTH OF TEMPORARY FILE
	JMP SEMER4	/CLOSE ERROR
	JMP I (ENGOA
BATLST,	0
	TAD I BATLST
	DCA T$
	ISZ BATLST
L$:	TAD I T$
	SNA
	JMP I BATLST
	JMS BATPUT
	ISZ T$
	JMP L$

T$:	0

SEMER1,	JMS I (PRMESG
	SEMSG1
SEMER2,	JMS I (PRMESG
	SEMSG2
SEMER3,	JMS I (PRMESG
	SEMSG3
SEMER4,	JMS I (PRMESG
	SEMSG4
	PAGE
	.FSECT GLYN
	FIELD 0

GLIN,	0
	JMS I PGLINE
	CIF CDF 10
	JMP I GLIN
PGLINE,	GLINE
	.ASECT SEMSGS
	.ENABLE ASCII
	FIELD 0
	*7400
BATHED,	TEXT	"$JOB"<215><212>"."
BATAIL,	TEXT ".R FOTP"<215><212>"*SYS:CCBTCH.TM/D$"<215><212>"$END"<215><212><32>
TEMNAM,	FILENAME CCBTCH.TM

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLSIZ.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/1
	.GLOBAL CORE,CORSIZ
	.ASECT CORF0
	LXM=6200
	FIELD 0
	*7200
CORLOC,	CORX
CORV,	1400
CORSIZ,	1

CORE,	0
	TAD T7000	/SETS KT8A IF PRESENT
	LXM		/LXM INSTRUCTION
	CLA		/LXM ACTS AS NOP IF NO KT8A
CORE2,	CDF 0
	TAD CORSIZ	/ADJUST FIELDS FOR CDF
	CLL RTR
	RTR
	BSW
	SZL
	TAD T4
	AND COR174
	TAD COREX
	DCA .+1
COR1,	CDF
	TAD I CORLOC
COR2,	NOP
	DCA COR1
	TAD COR2
	DCA I CORLOC
COR174,	174
	TAD I CORLOC
CORX,	7400
	TAD CORX
	TAD CORV
	SZA CLA
	JMP COREX
	TAD COR1
	DCA I CORLOC
	ISZ CORSIZ
	JMP CORE2
COREX,	CDF 0
	LXM		/NEUTRALIZES KT8A
	TAD CORSIZ
	CLL RTL
	TAD M10
	CIF CDF 10
	JMP I CORE	/RETURN
M10,	-10
T4,	4
T7000,	7000


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLSUB.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/3	CCL SIMPLE COMMAND SUBROUTINES

	.EXTERNAL REMD,REGO,FLAG,FOREVER,REMEM,PRMESG
	.EXTERNAL RDMON,BATCH
	.GLOBAL USRSUB,BASUB,DEASSIGN
	.EXTERNAL ASSIGN,FUDG,DVICE,LOOK,PRINT
	.ENTRY VERTN	/CALLED INDEPENDENTLY BY CCL
	.GLOBAL CRSUB,EDSUB,ZERSUB
	.GLOBAL TECSUB,MAKSUB,MNGSUB
	.GLOBAL SQSUB,KILRT,RENRT,MOVRT
	.EXTERNAL CDER2,GETSPC,GCH,ZEROCD,LBEGIN
	.ENTRY CMDERR
	.ENTRY CCSUB
	.GLOBAL ARLOC	/****
	MOFILE=7600
	MPARAM=7643

	XR2=15
	XR=16
	NAME1=23
	NAME2=24
	NAME3=25
	NAME4=26
	DELIM=32
	LXR=34
	OS78BIT=7771
	CCLNUM="3
	CCLVER="A
	.SBTTL UA,UB,UC COMMANDS
	.RSECT CCLSUB
	FIELD 1

/TEST END OF TABLE

USRSUB,	0
	TAD I (REMD
	SMA CLA
	JMP I (REGO	/REMEMBERED A NEW LINE
	TAD I (FLAG	/WANT TO
	AND (70
	CLL RTR
	RAR
	TAD (-1		/IN THIS REM-LINE
	DCA U$
	JMS I (FOREVER	/NO DATE
	JMS I (REMEM
U$:	0
	JMP I USRSUB
	.SBTTL BASIC COMMAND

BASUB,	0
	TAD (200	/SET /Q SWITCH
	DCA I (MPARAM+1
	JMP I BASUB
	.SBTTL VERSION COMMAND

VERTN,	0
	JMS I (RDMON	/READ MONITOR
	CDF 0
	TAD I (2031	/GET PATCH LEVEL
	SNA
	TAD ("!
	AND (77
	DCA TEM$
	TAD I (2000	/GET VERSION #
	CDF 10
	SPA
KK7600:	7600		/"0" MEANS OLD
	TAD (60
	CLL RTL
	RTL
	RTL
	TAD TEM$
	DCA I (VLOC
	CDF 0
	TAD I (OS78BIT
	AND (200	/	78
	SZA CLA		/	OR
	TAD (1000	/	/8
	TAD (5770
	CDF 10
	DCA I (LOC78
	JMS I (PRMESG
	VMES
TEM$:	0
	.SBTTL DEASSIGN COMMAND

/ALLOW DEASSIGN FOO ?

DEASSIGN,0
	TAD (7740
	DCA XR
	TAD (-17
	DCA T$
	DCA I XR
	ISZ T$
	JMP .-2
	CDF 0
	TAD I (7746
	AND (6777
	TAD (1000
	DCA I (7746
	CDF 10
	JMP I DEASSIGN

T$:	0
CHKSUP,	0
	JMS I (FUDG
	JMS I (ASSIGN
	TAD NAME1
	SNA CLA
	JMP I CHKSUP	/CAN'T SUP IF NO FILENAME
	TAD I (DVICE
	JMS I (LOOK	/LOOK UP FILE
	NAME1
	JMP I CHKSUP	/NOT FOUND (GOOD)
	JMS I (PRINT
	SUP
	JMP I CHKSUP
	.SBTTL ZERO COMMAND
ZERSUB,	0
	TAD I (7601
	SNA CLA		/WAS FILENAME SPECIFIED ON ZERO CMD?
	TAD I KK7600	/OR WAS NO OUT DEVICE SPECIFIED?
	SNA CLA
	JMP I (CDER2	/YES... ERROR
	JMP I ZERSUB	/NO, OKAY.

CMDERR,	JMS I (PRMESG	/NOT A LEGAL KEYWORD
	ERRCMD

RENMES,	TEXT	/FILES RENAMED:/
	PAGE
	.SBTTL PUT MACRO
	.NOLIST ME

	.MACRO PUT TXT
	JMS TECPUT

	.IF IDN TXT[1],$<
	.ENABLE ASCII
	;TEXT	<ALTMODE>"TXT[2:0]"
	.ENABLE SIXBIT
	>

	.IF DIF TXT[1],$<
	.ENABLE ASCII
	;TEXT	/TXT/
	.ENABLE SIXBIT
	>

	.ENDM
	.SBTTL MAKE COMMAND

	ALTMODE=233

SETPA,	0
	JMS I (SETX
	"P;"A		/KEEP HERE TO MAKE EASY TO PATCH
	JMP I SETPA

MAKSUB,	0
	TAD DELIM
	SNA CLA
	JMP I (CMDERR	/DON'T ALLOW MAKE <CR>
	JMS SETLXR
	JMS I (GETSPC
	JMS I (LOVE
	PUT "EW"
	JMS TECMOV
	JMS SETPA
	PUT "$"
	JMS I (CHKSUP
	JMS I (REMEM
	0
	JMP I MAKSUB

SETLXR,	0
	TAD I (LBEGIN
	DCA LXR
	TAD (MOFILE-1
	DCA I (TYR
	TAD (-5		/ZERO OPTION TABLE TOO
	JMS I (ZEROCD
	TAD LXR
	DCA SAVLXR
	JMP I SETLXR

/PUT FOLLOWING CHARS INTO TECO BUFFER VIA TXR

TECPUT,	0
/	TAD NAME1
/	SNA CLA
/	JMP I (CDER2
	TAD I TECPUT
	ISZ TECPUT
	SNA
	JMP I TECPUT
	JMS I (TPUT
	JMP TECPUT+1
/MOVE CHARS FROM FIELD 0 LINE BUFFER
/FROM SAVLXR+1 TO LXR-1 INCLUSIVE
/INTO TECO LINE BUFFER AT 17600

TECMOV,	0
	TAD SAVLXR
	DCA XR2
	TAD SAVLXR
	CMA
	TAD LXR
	SNA CLA
	JMP I (CDER2	/NO FILE SPEC
L$:	CDF 0
	TAD I XR2
	CDF 10
	JMS I (TPUT
	TAD XR2
	CMA
	TAD LXR
	SNA CLA
	JMP I TECMOV
	JMP L$
	.SBTTL TECO COMMAND

TECSUB,	0
	JMS SETLXR
	JMS I (GETSPC
	TAD DELIM
	SNA
	JMP TECNORM
	TAD (-"<	/ALLOW "_" AS WELL AS "<"
	SZA
	TAD ("<-"=
	SZA
	TAD ("=-"_
	SZA CLA
	JMP I (CDER2
1$:	CDF 0
	DCA I LXR	/CHANGE < TO 0
	CDF 10
	PUT "EW"
	JMS TECMOV
	JMS SETPA
	TAD LXR
	DCA SAVLXR
	JMS I (CHKSUP
	JMS I (GETSPC
	PUT "$ER"
	JMS TECMOV
	JMS SETPA
	PUT "$Y"
	JMP TECLV
TECNORM,PUT "EB"
	JMS TECMOV
	JMS SETPA
	PUT "$Y"
TECLV,	JMS I (REMEM
	0
	JMP I TECSUB
SAVLXR,	0
	PAGE
	.SBTTL MUNG COMMAND

TPUT,	0
	AND (177	/TECO LIKES 7-BIT
	ISZ TYR
	DCA I TYR
	TAD TYR
	TAD (-7646	/CHECK FOR OVERFLOW OF CD AREA
	SZA CLA
	JMP I TPUT
	JMS I (PRMESG
	TOOLNG

MNGSUB,	0
	JMS I (SETLXR
	JMS I (GETSPC
	PUT "ER"
	JMS I (TECMOV
	JMS SETX
	"T;"E
	PUT "$YHXYHKI"
	TAD DELIM
	SNA
	JMP F$
	TAD (-",
	SZA CLA
	JMP I (CDER2
L$:	STL CLA RAR	/PREVENT 'GCH' FROM HANDLING SPACE AND /
	JMS I (GCH
	AND (177	/GET RID OF HIGH ORDER BIT
	SNA
	JMP F$
	JMS TPUT
	JMP L$
F$:	PUT "$MY"	/MACRO GETS CALLED WITH POINTER PAST CHARS
	JMP I MNGSUB
TYR,	0
/SET DEFAULT EXTENSION

SETX,	0
	TAD I SETX
	DCA 1$
	ISZ SETX
	TAD I SETX
	DCA 2$		/FALL THRU 2ND EXT
	TAD NAME4
	SNA CLA
	TAD NAME1
	SNA CLA
	JMP I SETX
	TAD I TYR	/GET LAST CHAR (NO EXT)
	TAD (-56	/WAS IT A DOT?
	SNA CLA
	JMP I SETX	/YES
	JMS I (TECPUT	/NO, USE DEFAULT EXTENSION
	".
1$:	0
2$:	0
	0
	TAD 1$
	AND (77
	CLL RTL
	RTL
	RTL
	DCA 1$
	TAD 2$
	AND (77
	TAD 1$
	DCA NAME4
	JMP I SETX
LOVE,	0
	TAD NAME1
	TAD (-'LO
	SZA CLA
	JMP I LOVE
	TAD NAME2
	TAD (-'VE
	SZA CLA
	JMP I LOVE
	TAD NAME3
	TAD NAME4
	SZA CLA
	JMP I LOVE
	JMS I (PRINT
	LOVMES
	JMP I LOVE

TOOLNG,	TEXT	/#COMMAND TOO LONG/
CCSUB,	0		/USED TO FORCE THIS OVERLAY IN
	JMP I CCSUB
	PAGE
	.SBTTL CREATE COMMAND

CRSUB,	0
	TAD I (7617
	SNA CLA		/BETTER BE NO INPUT
	TAD I K7600	/ANYTHING THERE?
	SNA CLA
	JMP I (CDER2	/NO OUTPUT OR YES INPUT
	JMS EDSUB	/REMOVE BACK-ARROW AND REMEMBER CREATE LINE
	JMP I CRSUB
	.SBTTL EDIT COMMAND

EDSUB,	0
	CDF 0
	DCA I ARLOC	/REPLACE ARROW BY NULL
	CDF 10
	JMS I (REMEM	/REMEMBER NEW COMMAND LINE
	1
	JMP I EDSUB

ARLOC,	.		/LOCATION OF BACK-ARROW IN COMMAND LINE
			/'.' IS HARMLESS POINTER IN CASE NO ARROW
	.SBTTL SQUISH COMMAND

SQSUB,	0
	TAD I K7600
	SZA CLA
	JMP I SQSUB
	TAD I (7617
	DCA I K7600
	JMS I (BATCH	/IS BATCH RUNNING?
	JMP I SQSUB	/NO
K7600,	7600		/YES (CLEAR AC)
	TAD I K7600
	TAD (7647-1	/POINT INTO DEVICE HANDLER RESIDENCY TABLE
	DCA T$
	TAD I T$	/GET HANDLER STARTING ADDRESS
	TAD (-7607
	SZA CLA		/IS SQUISHED DEVICE SYS:?
	JMP I SQSUB	/NO
	JMS I (PRINT
	SQWARN		/YES, WARN USER
	JMP I SQSUB
T$:	0
	.SBTTL COPY, MOVE, AND DELETE COMMANDS

KILRT,	0
	STL CLA RAR	/4000 MEANS NOT PACKED
	JMS I (PRINT
	KILMES
	JMP I KILRT

RENRT,	0
	JMS I (PRINT
	RENMES
	JMP I RENRT

MOVRT,	0
	JMS I (PRINT
	MOVMES
	JMP I MOVRT
VMES,	TEXT	\OS/8 - KBM V3A - CCL V1A\
	LOC78=VMES+1
	VLOC=VMES+6
	*.-2
	CCLNUM&77^100+<CCLVER&77>
	*.+2
LOVMES,	TEXT	/NOT WAR?/
SUP,	TEXT	/%SUPERSEDING/
ERRCMD,	TEXT	/#ERROR IN COMMAND/
SQWARN,	TEXT	/%BATCH SQUISHING SYS:!/
MOVMES,	TEXT	/FILES COPIED:/
	.ENABLE ASCII
KILMES,	TEXT	/Files deleted:/
	.ENABLE SIXBIT
	PAGE

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLTAB.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/1	CCL OVERLAY TABLE

	.EXTERNAL BEGLN,PRQMRK
	.GLOBAL CCLBLC,NOCCL
	CCLTAB="H

/CCL.SV (THE IMPORTANT PART) MUST BE A SINGLE CORE-LOAD
/CONTIGUOUS LOAD, BECAUSE OF THE WAY THE MONITOR LOADS IT.
/FORTUNATELY, FIELD 0 STUFF OCCURS AFTER FIELD 1 STUFF IN THE
/OS/8 CORE-IMAGE FORMAT.
/FOR VERSION OF THE MONITOR BEFORE LEVEL A,
/THE TOTAL LENGTH OF CCL.SV MUST BE LESS THAN14 BLOCKS
/OR IT READS OVER 7600.
/BUT NOW CCL COMES IN AND READS THE REMAINDER OF ITSELF
/INTO FIELD 0.  400-777 IS IGNORED BY SKIPPING A BLOCK,
/THEN THER REST OF CCL (7 PAGES) IS READ IN.

	.ASECT TABLE0
	FIELD 0

	*400

/IT LOADS OVER THE SAVE, DATE OVERLAY
/AND STARTS AT LOCATION 600

/KEYWORD TABLE IN 400-

/CONSISTS OF COMMANDS 2 CHARS PER LOCATION
/IN 5-BIT ASCII (ONLY LETTERS ARE LEGAL)
/SEPARATED FROM EACH OTHER BY 6-BIT 00'S.
/EACH ENTRY STARTS ON A WORD BOUNDARY, BUT IF YOU
/NEED THE ROOM, THEY NEED NOT WITH A SIMPLE FIX
/BIT 40 ON MEANS THAT THE CHARACTER ISN'T REQUIRED
/BUT IF THE USER DOES TYPE A LETTER, IT MUST MATCH.
VNO,	CCLTAB
KEYWRD,
0530	/EX ECUT
4543
6564
0002	/BA CKSP OR TER MIN
0143
5363
6000
0201	/BAS IC
2351
4300
0425	/DU PLICATE
6054
5143
4164
4500
0217	/BO OT
5764
0003	/CCL
0314
0003	/COMPA R
1715
2001
6200
0317	/COM PIL
1560
5154
0003	/COP Y
1720
7100
1505	/MEM ORY
1557
6271
0003	/CREA TE
2205
0164
4500
0322	/CREF
0506
0004	/DA TE
0164
4500
0405	/DEL ETE
1445
6445
0004	/DE A
0541
0004	/DIR ECT
1122
4543
6400
0504	/ED IT
5164
/0005	/EO F
/1746
0010	/HE LP
0554
6000
1411	/LIN K
1653
0015	/MAC R
0103
6200
1411	/LI ST
6364
0014	/LO AD
1741
4400
1501	/MAK E
1345
0015	/MAP
0120
0015	/MUNG
2516
0700
2001	/PAL
1400
2022	/PRI NT
1156
6400
2025	/PU NCH
5643
5000
2205	/REN AME
1641
5545
0022	/RES
0523
/0022	/REW IND
/0527
/5156
/4400
0003	/CA NCEL
0156
4345
5400
2305	/SET
2400
2313	/SK IP
5160
0023	/SQ UISH
2165
5163
5000
2325	/SU BMIT
4255
5164
0024	/TE CO
0543
5700
2431	/TY PE
6045
/0025	/UN LOAD
/1654
/5741
/4400
0022	/REQ U
0521
6500
2165	/Q UEUE
4565
4500
2501	/UA
0025	/UB
0200
2503	/UC
0026	/VE R
0562
0032	/ZERO
0522
1700
4000	/@
	ZBLOCK 600-.
	IFDEF XYZMCR <

THIS IS THE TECO MACRO WHICH WAS USED TO CREATE THE ABOVE TABLE:


HKGYJ2SR0,.KHXAHKMA
TYPE COMMANDS, SPACE SEPARATES MANDATORY PART FROM
OPTIONAL PART, CR TERMINATES COMMANDS, ^Z TERMINATES ALL.
**  NO EDITING **
HKHXYHXN0UO0UB0UN
!CHLP!^TULQL-32"EOBLANK'QL-13"EOCR'QL-26"EOEND'
!CHLP0!QL&63+QBUT QT/8UXQX+48IQT-(8*QX)+48I
QL"NZJ.UZGNQLIQZJXNK%N'
%O&1"NOCHLP' QN-3"LZUH'I
OCHLP
!BLANK! 32UBZJ.UZGNQLIQZJXNK%NOCHLP
!CR! 
QHJ	/GNZJXN0UN0UB0ULOCHLP0
!END!I00



	>
	*600

	JSBITS=7746
	SYSTEM=22
	PRMES=330
	ERRET=33	/THESE ARE LOCATIONS FROM OS/8 MONITOR

/RUNS IN FIELD 0 ONLY.

ENTRY,	0		/INITIALLY 0 MEANS 'EX' COMMAND
LINPTR,	JMP ENTREE	/OS/8 JUMPS HERE (ACTUALLY TO 600)
TEMM,
TEKLDG,	ISZ CCLNHR	/TECO 'EG' JUMPS HERE
	DCA I (BEGLN	/ZERO COMMAND LINE
	JMP TEGO	/FIRST WE DISABLE CALLS TO MONITOR
ENTREE,	TAD (7605
	DCA ERRET
	TAD SYSTEM
	DCA MYSYS
	JMS FINDIT	
	SPA CLA		/WAS IT A LEGAL COMMAND?
	JMP I (PRQMRK	/NO
TEGO,	TAD (6003	/YES
	DCA I (JSBITS
	CIF 10
	JMS I MYSYS	/CALL USR AND LOCK IN CORE
	10
	CLA IAC
	CIF 10
	JMS I (200
	2
CCLBLC,	CCLSV
CCLEN,	0
CCLNHR,	JMP NOCCL	/ISZ'ED IF KBM NOT IN MEMORY
	CLA IAC
	TAD CCLBLC
	DCA CCLRDB
	JMS I (7607
CCLCCW,	2711		/READ 27 PAGES OF CCL.SV
CCLSTR,	2000
MYSYS,
CCLRDB,	7700		/INITIALLY POINTS TO USR
	JMP NOCCL
	CIF CDF 10
	JMP I CCLSTR
CCLSV,	FILENAME CCL.SV

NOCCL,	CLA SKP
	JMP I (7605	/GO BACK TO MON IF CCL NOT FOUND ON TECO EG COMMAND
	JMS I (PRMES	/PRINT ERROR MESSAGE OTHERWISE
	TEXT	/NO CCL!/
	0
/FINDS IF INPUT LINE STARTS WITH A COMMAND
/LEAVES ENTRY # IN AC, -1 IF NOT FOUND
/ENTRIES START AT ENTRY 0.
/CALLABLE FROM ANY FIELD

FINDIT,	0
MORE,	TAD (BEGLN-1
	DCA LINPTR
	ISZ LINPTR
	TAD I LINPTR
	TAD (-240
	SNA CLA
	JMP .-4
	JMS GETKAR
	JMP ENDOFT	/NO MATCH
	JMP INTO
FNLUP,	TAD I LINPTR
	TAD (-301
	STL
	TAD (-32
	SNL CLA
	JMP NOLET	/NOT A LETTER
	JMS GETKAR
	JMP MATCH
INTO,	CIA
	TAD I LINPTR
	AND (37		/5-BIT ASCII
	ISZ LINPTR
	SNA CLA		/DO THEY MATCH?
	JMP FNLUP	/YES
NOMT,	JMS GETKAR
	SKP
	JMP .-2		/SCAN TO NEXT ENTRY
	ISZ ENTRY
	JMP MORE

NOLET,	JMS GETKAR
	JMP MATCH
	CLA
	ISZ SIGNIF
	JMP NOMT
MATCH,	TAD ENTRY
	SKP
ENDOFT,	STA
RETCIF,	CDF 0		/RETURN TO CALLING FIELD (MAY BE OVERLAID)
	JMP I FINDIT
KPTR,	KEYWRD
HALF,	-1		/0 MEANS LEFT HALF
SIGNIF,	0		/1 MEANS 40 BIT ON WHICH MEANS CHAR IS SIGNIF ONLY IF PRESENT

/GETKAR GETS NEXT 5-BIT CHAR, LEAVES IT IN AC
/SETS SIGNIF TO -1 IF 40 BIT WAS PRESENT
/TAKES RETURN 1 IF CHAR IS 0
/TAKES RETURN 2 OTHERWISE

GETKAR,	0
	ISZ HALF
	JMP RTHALF
	TAD I KPTR
	RTR
	RTR
	RTR
	JMP INSIDE
RTHALF,	STA
	DCA HALF
	TAD I KPTR
	ISZ KPTR
INSIDE,	AND (77
	DCA TEMM
	TAD TEMM
	AND X40
X40,	SZA CLA
	STA
	DCA SIGNIF
	TAD TEMM
	SZA
	ISZ GETKAR
	AND (37
	JMP I GETKAR
	PAGE


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CCLTBL.MA. 
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

/
/
/
/COPYRIGHT  (C)  1979 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/


/VERSION=V3A (D.H.)
/10	CCL INTERNAL TABLES FOR OS/78

	.NOLIST ME
	.GLOBAL EXTCM
	.GLOBAL YBATCH,YDATE,YTERMIN
	.GLOBAL F1,F2,LO1,LO2
	.EXTERNAL SETLPT,SETTTY,SETPTP,COLSET
	.EXTERNAL TECSUB,MAKSUB,MNGSUB
	.EXTERNAL YF4,YLOAD
	.EXTERNAL USRSUB,REQSUB,CANSUB
	.EXTERNAL MOVRT,KILRT,RENRT
	.EXTERNAL EXSUB
	.EXTERNAL TRMSUB,BASUB,MONRES,DETCOR,DATE,DEASSIGN,SQSUB,VERTN,ZERSUB
	.EXTERNAL YAT
	.EXTERNAL CRSUB,EDSUB
	.DSECT PTBL
	FIELD 0
	.ASECT SWS
	*7300
	.ASECT LONGS
	*5000

	.MACRO .BOX COM,SPACES,STARS
	LEN=.NCHARS COM
	.PUSH .LISTWD
	L1=LEN+4
	L2=LEN+2
	;.LIST ME

/	STARS[1:L1]
/	*SPACES[1:L2]*
/	* COM *
/	*SPACES[1:L2]*
/	STARS[1:L1]
	.POP .LISTWD
	EJECT CCL COMMANDS
	.ENDM .BOX

	.MACRO .EXT
	.ENDM
	.MACRO .CMD COMAND,ABBREV,CODE,EXTEN,SWITCH,SUBR,PROGRM,LABEL
	.BOX	COMAND,"                ","****************"
	.SBTTL COMAND
	..=.
	.DSECT PTBL
	;..
	.SECT *
X'ABBREV,	CODE
	IFNZRO CODE&4000 <
	;EXTEN
	.IF NBL SWITCH[1]<
	XX="SWITCH[1]&77;YY=<XX-1>%12.;7643+YY;ZZ=XX-<YY^12.>
	QQ=1
	.REPT 12.-ZZ&17
	QQ=QQ^2
	.ENDR
	;QQ>
	.IF NBL SWITCH[2]<
	XX="SWITCH[2]&77;YY=<XX-1>%12.;7643+YY;ZZ=XX-<YY^12.>
	QQ=1
	.REPT 12.-ZZ&17
	QQ=QQ^2
	.ENDR
	;QQ>
	;0
	.ASECT SWS
	..=.
	.SECT *
	.IF BL LABEL <;.. >		/REMOVE IF DON'T WANT MULTIPLE CHARACTER SWITCHES
	.IF NB LABEL <;LABEL>
	;SUBR
	.IF NB PROGRM<
	;Y'PROGRM>
	.IF BL PROGRM<
	;0>
	>
	IFZERO CODE&4000 <
	;EXTEN
	.IF NB SWITCH<
	;Y'SWITCH>
	.IF BL SWITCH<
	;0>
	>
	.ENDM
	.MACRO .QUAL LONG,SHORT,NAME
	.ASECT LONGS
	..=.
	;TEXT	"LONG[1:6]";"SHORT
	.SECT *
	.ASECT SWS
	.IF NB NAME <NAME=.>
	;..
	.SECT *
	.ENDM
	.MACRO .ENDQ
	.ASECT SWS
	;0
	.SECT *
	EJECT CCL COMMANDS
	.ENDM
	.ASECT TABLES
	FIELD 0
	*6200
	.CMD	EXECUTE,EX,5033,	EXTEXE,	G,	EXSUB,	PAL8	/MUST BE FIRST FOR TECO EG
	.ENDQ
	.CMD	BACKSPACE,BA,0,				TRMSUB,	CAMP
	.ENDQ
	.CMD	BASIC,BAS,0,				BASUB,	BASIC
	.ENDQ
	.CMD	DUPLIC,DU,4001,	STAR,	,		0,	RXCOP
	.QUAL	NOCOPY,M
	.QUAL	NOMATCH,N
	.QUAL	PAUSE,P
	.QUAL	READONLY,R
	.QUAL	VERSION,V
	.ENDQ
	.CMD	BOOT,BO,0,				0,	BOOT
	.ENDQ
	.CMD	CCL,CCL,0,				MONRES,	
	.ENDQ
	.CMD	COMPARE,COMPA,4001,	EXTNUL,	,		SETTTY,	SRCCOM
	.QUAL	NOCOMMENTS,C
	.QUAL	NOSPACES,S
	.QUAL	TABS,T
	.QUAL	BLANKS,B
	.QUAL	NOPRINTCOMMENTS,X
	.ENDQ
	.CMD	COM,COM,5033,	EXTCOM,	,		EXSUB,	PAL8
	.QUAL	NOISN,N
	.QUAL	OPTIMIZE,Q
	.QUAL	GO,G
	.ENDQ
	.CMD	COPY,COP,4001,	STAR,	L,	MOVRT,	FOTP
	.QUAL	NOCOPY,D
	.QUAL	NOPREDELETE,N
	.QUAL	RENAME,R
	.QUAL	FAILSAFE,F
	.QUAL	CURRENT,C,LSTOPT
	.QUAL	LOG,L
	.QUAL	OTHER,O
	.QUAL	QUERY,Q
	.QUAL	INQUIRE,Q
	.QUAL	INSPECT,Q
	.QUAL	TODAY,T
	.QUAL	UGLY,U
	.QUAL	INDEPENDENTLY,U
	.QUAL	INVERT,V
	.QUAL	EXCEPT,V
	.QUAL	VERSION,W
	.QUAL	V,V
	.ENDQ
	.CMD	MEMORY,MEM,0,				DETCOR,	
	.ENDQ
	.CMD	CREATE,CREA,4400,	EXTNUL,	,		CRSUB,	EDIT
	.QUAL	SPACES,B
	.ENDQ
	.CMD	CREF,CREF,4002,	EXTCF,	C,	0,	PAL8
	.QUAL	NOLIST,P
	.QUAL	NOSYMTAB,U
	.QUAL	RALF,R
	.QUAL	SABR,S
	.QUAL	NOLITERALS,X
	.QUAL	KEEP,E
	.QUAL	MAMMOTH,M
	.QUAL	MOBY,M
	.ENDQ
	.CMD	DATE,DA,0,				DATE,	
	.ENDQ
	.CMD	DELETE,DEL,4001,	STAR,	LD,	KILRT,	FOTP,LSTOPT
	.CMD	DEASSIGN,DE,0,				DEASSIG,
	.ENDQ
	.CMD	DIRECT,DIR,4001,	STAR,	,COLSET,	DIRECT
	.QUAL	BLOCKS,B
	.QUAL	CURRENT,C
	.QUAL	EXTENDED,E
	.QUAL	FAST,F
	.QUAL	BRIEF,F
	.QUAL	ADDITIONAL,I
	.QUAL	EMPTIES,M
	.QUAL	FREE,M
/	.QUAL	INDEPENDENTLY,U
	.QUAL	OTHER,O
	.QUAL	REMAINDER,R
	.QUAL	UGLY,U
	.QUAL	INVERT,V
	.QUAL	EXCEPT,V
	.QUAL	VERSION,W
	.QUAL	V,V
	.QUAL	COLUMNS,Z	/DUMMY
	.ENDQ
	.CMD	EDIT,ED,5220,	EXTNUL,	,		EDSUB,	EDIT
	.QUAL	SPACES,B
	.QUAL	PREDELETE,D
	.QUAL	DELETE,D
	.ENDQ
/	.CMD	EOF,EO,0,				0,	CAMP
/	.ENDQ
	.CMD	HELP,HE,4001,	STAR,	T,	SETTTY,	HELP
	.ENDQ
	.CMD	LINK,LIN,5033,	EXTLI,	,		EXSUB,	LINK
	.QUAL	GO,G
	.QUAL	HALTS,H
	.QUAL	JUMPS,J
	.QUAL	JMPS,J
	.QUAL	CORE,K
	.QUAL	MEMORY,K
	.QUAL	VERSION,V
	.QUAL	START,S
	.QUAL	JSW,W
	.QUAL	M,M
	.ENDQ
	.CMD	MAC,MAC,5033,	EXTMA,	,		EXSUB,	MACREL
	.QUAL	BLOCK,B
	.QUAL	HEADING,B
	.QUAL	HDR,B
	.QUAL	CREF,C
	.QUAL	KREF,C
	.QUAL	GO,G
	.QUAL	NOCONDITIONALS,J
	.QUAL	LINK,L
	.QUAL	PERM,M
	.QUAL	NOLIST,N
	.QUAL	OMIT,O
	.QUAL	NOMACROS,O
	.QUAL	RESET,P
	.QUAL	EAE,Q
	.QUAL	REMOVE,R
	.QUAL	REDUNDANT,R
	.QUAL	DESTROY,Z
	.QUAL	NOBATCH,Z
	.QUAL	EXTENDED,X
	.QUAL	K,K
	.QUAL	P,P
	.ENDQ
	.CMD	LIST,LI,4001,	STAR,	U,	SETLPT,	FOTP,LSTOPT
	.CMD	LOAD,LO,5031,	EXTLO,	,		EXSUB,	ABSLDR
	.QUAL	IMAGE,I
	.QUAL	MULTIPLE,S
	.QUAL	SLURP,S
	.QUAL	GO,G
/	/8	/9	/START:N	/FIELD:F	/P
	.ENDQ
	.CMD	MAKE,MAK,0,				MAKSUB,	TECO
	.ENDQ
	.CMD	MAP,MAP,4001,	EXTBN,	,		SETTTY,	BITMAP
	.QUAL	MULTIPLE,S
	.QUAL	SLURP,S
	.QUAL	INVERT,T
/	FIELD:N
	.ENDQ
	.CMD	MUNG,MUNG,0,				MNGSUB,	TECO
	.ENDQ
	.CMD	PAL,PAL,5033,	EXTPA,	,		EXSUB,	PAL8
	.QUAL	SHIFT,B
	.QUAL	CREF,C
	.QUAL	DDT,D
	.QUAL	NOLINKS,E
	.QUAL	NOFILL,F
	.QUAL	GO,G
	.QUAL	NONPAGINATED,H
	.QUAL	NOCONDITIONALS,J
	.QUAL	LOAD,L
	.QUAL	NOLIST,N
	.QUAL	NOORIG,O
	.QUAL	NOSYMTAB,S
	.QUAL	NOREMEMBERLITERALS,W
	.QUAL	WIDE,7
	.QUAL	W,W
	.ENDQ
/	/K	/T
	.CMD	PRINT,PRI,4000,	STAR,	,		SETLPT,	LPTSPL
	.ENDQ
	.CMD	PUNCH,PU,4001,	EXTNUL,	,		SETPTP,	PIP
/	.QUAL	ASCII,A
/	.QUAL	BINARY,B
/	.QUAL	ELIMINATE,C
/	.QUAL	PREDELETE,D
/	.QUAL	DELETE,D
/	.QUAL	IGNORE,G
/	.QUAL	IMAGE,I
/	.QUAL	TABS,T
/	.QUAL	VERSION,V
/	.QUAL	V,V
	.ENDQ
	.CMD	RENAME,REN,4001,	STAR,	LR,RENRT,FOTP,LSTOPT
	.CMD	RESOURCES,RES,4001,	EXTSY,	,		SETTTY,	RESORC
	.QUAL	DETAILED,E
	.QUAL	EXTENDED,E
	.QUAL	BRIEF,F
	.QUAL	FAST,F
	.ENDQ
/	.CMD	REWIND,REW,0,				0,	CAMP
/	.ENDQ
	.CMD	CANCEL,CA,0,CANSUB,
	.ENDQ
	.CMD	SET,SET,0,				0,	SET
	.ENDQ
	.CMD	SKIP,SK,0,				0,	CAMP
	.ENDQ
	.CMD	SQUISH,SQ,4001,	EXTNUL,	S,	SQSUB,	PIP
	.QUAL	OK,O
	.QUAL	NOCONFIRM,O
	.ENDQ
	.CMD	SUBMIT,SU,4000,	EXTBI,	,		0,	BATCH
	.QUAL	CARDS,C
	.QUAL	NONFATAL,E
	.QUAL	PAPERTAPE,P
	.QUAL	QUIET,Q
	.QUAL	HUSH,H
	.QUAL	TERMINAL,T
	.QUAL	TTY,T
	.QUAL	UNATTENDED,U
	.QUAL	VERSION,V
	.QUAL	026,6
	.ENDQ
	.CMD	TECO,TE,10,				TECSUB,	TECO
	.ENDQ
	.CMD	TYPE,TY,4001,	STAR,	U,	SETTTY,	FOTP,LSTOPT
/	.CMD	UNLOAD,UN,0,				0,	CAMP
/	.ENDQ
	.CMD	REQUEST,REQ,4000,EXTSV,,REQSUB,
	.ENDQ
	.CMD	QUEUE,Q,4000,STAR,,0,QUEUE
	.QUAL	LIST,L
	.QUAL	KILL,K
	.QUAL	STOP,S
	.QUAL	GO,G
	.QUAL	START,G
	.QUAL	NOH,H
	.QUAL	DELETE,D
	.QUAL	COPIES,C
	.ENDQ
	.CMD	UA,UA,40,				USRSUB,	
	.ENDQ
	.CMD	UB,UB,50,				USRSUB,	
	.ENDQ
	.CMD	UC,UC,60,				USRSUB,	
	.ENDQ
	.CMD	VERSION,VE,0,				VERTN,	
	.ENDQ
	.CMD	ZERO,ZERO,4401,	EXTNUL,	Z,	ZERSUB,	PIP
	.ENDQ
/	.CMD	@,@,0,				YAT,	
/	.ENDQ
	..=.
	0;YAT;0
	.DSECT PTBL
	..
	0;0
/PTBL,	XEXE
/	XBAC
/	XBAS
/	XDUPL
/	XBOO
/	XCCL
/	XCOMPA
/	XCOMPI
/	XCOP
/	XCOR
/	XCREA
/	XCREF
/	XDAT
/	XDEL
/	XDEA
/	XDIR
/	XEDI
/	XEOF
/	XHEL
/	XLINK
/	XMAC
/	XLIS
/	XLOA
/	XMAK
/	XMAP
/	XMUN
/	XPAL
/	XPRI
/	XPUN
/	XREN
/	XRES
/	XREW
/	XSET
/	XSKI
/	XSQU
/	XSUB
/	XTEC
/	XTYP
/	XUNL
/	XUA
/	XUB
/	XUC
/	XVER
/	XZER
/	XAT
	.EXT	ALG=AL
	.EXT	BAK=BK
	.EXT	BAS=BA
	.EXT	BIN=BN
	.EXT	BUG=BG
	.EXT	CMD=CM
	.EXT	COM=CM
	.EXT	CRF=CF
	.EXT	CTL=CM
	.EXT	DAT=DA
	.EXT	DIR=DI
	.EXT	DOC=DC
	.EXT	HLP=HL
	.EXT	INI=IN
	.EXT	LOG=LG
	.EXT	LPT=LP
	.EXT	LST=LS
	.EXT	MAC=MA
	.EXT	MAN=MN
	.EXT	MAP=MP
	.EXT	MEM=ME
	.EXT	OLD=OL
	.EXT	PAL=PA
	.EXT	REL=RL
	.EXT	RIM=RM
	.EXT	RNO=RO
	.EXT	SAV=SV
	.EXT	EXE=SV
	.EXT	SNO=SN
	.EXT	SRC=SR
	.EXT	SYS=SY
	.EXT	TEC=TE
	.EXT	TEM=TM
	.EXT	TMP=TM
	.EXT	TXT=TX
	.EXT	BAT=BI
	.EXT	FOR=FT
	.EXT	RLF=RA
	.EXT	OBJ=RB
	.EXT	SBR=SB
	.EXT	FTN=FT
	.ASECT EXTNS
	FIELD 0
	*6600
STAR,	5200;	0
	0;	0


EXTSY,	'SY;	0
	0;	0
EXTBI,	'BI;	0
	0;	0
EXTCF,	'PA;	YPAL8
	0;	YPAL8
EXTMA,	'MA;	YMACREL
	0;	YMACREL
EXTPA,	'PA;	YPAL8
	0;	YPAL8
EXTBN,	'BN;	0
	0;	YABSLDR
EXTNUL,	0;	0
EXTLO,	'BN;	YABSLDR
	'RL;	LO1,YLOAD	/****
EXTLI,	'RB;	YLINK
	0;	0
EXTCM,	'CM;	0
	0;	0
EXTSV,	'SM;	0
	'SV;	0
	0;	0
EXTEXE,	'PA;	YPAL8
	'FT;	F1,YF4	/****
	'BA;	YBCOMP
	'MA;	YMACREL
	'BN;	YABSLDR
	'RL;	LO2,YLOAD	/****
	'RA;	YRALF
	'SB;	YSABR
	'RB;	YLINK
	'LD;	YFRTS
	'BI;	YBATCH
	0;	0
	ZBLOCK 4
EXTCOM,	'PA;	YPAL8
	'FT;	F2,YF4	/****
	'MA;	YMACREL
	'BA;	YBCOMP
	'RA;	YRALF
	'SB;	YSABR
	0;	0
	ZBLOCK 4
	.ASECT FNAMES
	FIELD 0
	*7000
YEDIT,	FILENAME EDIT.SV
	*.-1
YBOOT,	FILENAME BOOT.SV
	*.-1
YBITMAP,FILENAME BITMAP.SV
	*.-1
YSRCCOM,FILENAME SRCCOM.SV
	*.-1
YBCOMP,	FILENAME BCOMP.SV
	*.-1
YPAL8,	FILENAME PAL8.SV
	*.-1
YFOTP,	FILENAME FOTP.SV
	*.-1
YDIRECT,FILENAME DIRECT.SV
	*.-1
YPIP,	FILENAME PIP.SV
	*.-1
YABSLDR,FILENAME ABSLDR.SV
	*.-1
YTECO,	FILENAME TECO.SV
	*.-1
YLPTSPL,FILENAME LPTSPL.SV
	*.-1
YCAMP,	FILENAME CAMP.SV
	*.-1
YSET,	FILENAME SET.SV
	*.-1
YBASIC,	FILENAME BASIC.SV
	*.-1
YRXCOP,	FILENAME RXCOPY.SV
	*.-1
YRESORC,FILENAME RESORC.SV
	*.-1
YBATCH,	FILENAME BATCH.SV
	*.-1
YRALF,	FILENAME RALF.SV
	*.-1
YSABR,	FILENAME SABR.SV
	*.-1
YFRTS,	FILENAME FRTS.SV
	*.-1
YHELP,	FILENAME HELP.SV
	*.-1
YMACREL,FILENAME MACREL.SV
	*.-1
YLINK,	FILENAME LINK.SV
	*.-1
YDATE,	FILENAME DATE.SV
	*.-1
YTERMIN,FILENAME TERMIN.SV
	*.-1
YQUEUE,	FILENAME QUEUE.SV
	*.-1
YCANCEL,FILENAME CANCEL.SV
	*.-1


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/CD.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688

	XLIST
/8    COMMAND DECODER FOR OS/8 MONITOR
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974, 1975, 1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/APRIL 1977		RL/EF/HJ/SR

/ABSTRACT--
/COMMAND DECODER (CD) ACCEPTS TTY INPUT AND INTERPRETS
/THAT INPUT AS A LIST OF OPTIONS AND FILE SPECIFICATIONS
/FOR OS/8 CUSPS. TABLES ARE SETUP INDICATING THE SPECIFIED
/FILES AND OPTIONS.
/THIS VERSION OF CD IS CAPABLE OF RUNNING OS/8 BATCH.
/MODIFICATIONS TO INITIALIZATION CODE HAVE BEEN MADE TO
/ALLOW THIS.


	DCB=7760
	SHNDLR=7607
	USERFG=40	/LOCATION IN MAIN OS/8 ASSEMBLY - VOLATILE
	T1=41	/DITTO
	MCDREC=51	/ALSO PRETTY VOLATILE
	MOFILE=7600
	MIFILE=7617
	MPARAM=7643
	FIELD 0	/JUSTINCASE

	CDVERSION=6501	/5A
	ODTVERSION=6601	/6A
/V3 CHANGES TO CD:

/1. FIXED LOTS OF BUGS
/	A:B:C IS ILLEGAL
/	15-BIT = OPTION DOESN'T DESTROY ALTMODE BIT
/2.	ADDED ? SUPPORT IN SPECIAL MODE
/3.	ALLOWED SPECIAL MODE UNDER BATCH
/4.	REMOVED DCC CODE
/5.	^U, RO TO BOL, AND LF ALL REPRINT *
/6.	VERSION # AT LOC ZERO
/7.	DON'T LOAD HANDLERS FOR OUTPUT DEVICE
/8.	CHANGED _ TO < STANDARD

/V3 CHANGES TO ODT

/1.	REMOVED DCC CODE
/2.	FIXED CORE SIZE ROUTINE
/3.	ALLOWED SOFTWARE CORE SIZE
/4.	MODIFIED 'GO' COMMAND SO THAT IT DOESN'T RESTORE TRAP
/	LOCATION TO UNMODIFIED VALUE
/5.	FIXED BUG RE: JMS'S OUT OF FIELD WITH MAGIC LOCATION SET
/6.	TURN OFF INTERRUPTS ON BREAKPOINT

/CHANGES AFTER FIELD TEST RELEASE:

/1.	FIXED BUG RE FILE LENGTHS GT 2047 BLOCKS

/MAINTENANCE RELEASE:

/	NO CHANGES

/V3D CHANGES:

/CHANGED FORMAT OF VERSION NUMBERS
	*200
CD,	JMP I NUMBER	/EXECUTED IN SYSGEN
NUM,	JMP I T
ANALYZ,	TAD [BEGLN-1
	DCA XR
	TAD I XR
	SNA
	JMP NOBKAR
	TAD [-"<
	SZA CLA
	JMP .-5
	CLA CMA
NOBKAR,	DCA OUTSW
	TAD [BEGLN-1
	DCA LXR
BEGGRP,	TAD OUTSW
	SNA CLA
	TAD BEGDIF		/DIFF BETWEEN INPUT & OUTPUT AREAS
	TAD [MOFILE-1
	DCA CLXR
	STA
	DCA DVFLAG
	DCA DEV1
FILLP1,	DCA DEV2
FILLP,	JMS I [GNAME
	TAD ["A-":	/AC CONTAINED DELIM - "A
	SNA CLA
	JMP DEVNAM
	JMS I [ASSIGN
	TAD OUTSW
	SNA CLA
	TAD LIMDIF		/DIFF BETWWEN END OF OUTPUT & INPUT AREAS
	TAD OUTLIM		/END OF OUTPUT AREA
	TAD CLXR
	SMA CLA
	JMP CDER1
	TAD OUTSW
	SNA CLA
LKUPSW,	JMP INFILE		/ZEROED IF IN "SPECIAL DECODE" MODE
	CDF 10
	TAD DVICE
	DCA I CLXR
	TAD NAME1
	DCA I CLXR
	TAD NAME2
	DCA I CLXR
	TAD NAME3
	DCA I CLXR
	TAD NAME4
CDSKP,	SKP
INFILE,	JMS I [LOOKUP
	DCA I CLXR
DLOOK,	CDF 0
	STA
	DCA DVFLAG
	TAD DELIM
	SNA
	JMP CDOVER
	TAD [-"[
	SNA
	JMP I [OLENGT
	TAD ["[-",
	SNA
	JMP FILLP
	TAD [",-"<
	SNA
	JMP BKAROW
	TAD ["<-"=
	SZA CLA
	JMP I [CDER2
EQUAL,	DCA NUMFUJ
	JMS NUMBER
	DCA I [MPARAM+3
	CLA CLL CML RAR
	AND I [MPARAM-1	/PRESERVE  ALTMODE
	TAD HIORD
	DCA I [MPARAM-1
	JMP DLOOK
BKAROW,	ISZ OUTSW
	JMP I [CDER2
	JMP BEGGRP
DEVNAM,	TAD NAME1
	DCA DEV1
	ISZ DVFLAG
	JMP I [CDER2	/CATCHES A:B:
	TAD NAME2
	JMP FILLP1
CDOVER,	TSF
	JMP .-1	/LET PRINTER QUIET DOWN
	TCF	/AND CLEAR FLAG
	CDF CIF 10
	TAD TMONIT
	DCA I [200	/RESTORE "MONITO"
	TAD TUSRFG
	DCA I [USERFG	/RESTORE "USER FLAG"
	TAD TFPUTX	/LOAD "USER CALLING FIELD" INTO AC
	JMP I CD	/RETURN - MONITOR RESTORES CORE IF NECESSARY
NUMBER,	4000	/USED BY SYSGEN
	TAD CDSKP
	DCA NUMADD	/SET NUMADD TO EITHER "SKP" OR "TAD NUM"
	DCA HIORD
NUMLP,	DCA NUM
	JMS NUMTST	/INTO PAGE 0 FOR RANGE TEST
	SNL
	JMP EONUM
	DCA T
	CLA CLL CMA RTL
	DCA DELIM
	TAD NUM
ROTLP,	CLL RAL
	DCA NUMX
	TAD HIORD
	RAL
	SPA
	JMP I [CDER2
	DCA HIORD
	TAD NUMX
	ISZ DELIM
	JMP ROTLP
NUMADD,	TAD NUM		/SKP IF OCTAL
	TAD NUM
	TAD T
	JMP NUMLP
EONUM,	TAD ["0
	DCA DELIM
	TAD NUM
	CDF 10
	JMP I NUMBER
CDER1,	JMS I [PRMESG
	TEXT	/TOO MANY FILES/
	IFZERO .&400 <*400>
ASSIGN,	0
	TAD CLXR
	AND DVFLAG
	TAD OUTLIM
	SMA SZA CLA	/CHECK FOR OUTPUT OR FIRST INPUT
	JMP ASNORM	/IF DEVICE WAS SPECIFIC, OR IF WE ARE ON THE INPUT SIDE,
			/PROCEED NORMALLY
	TAD NAME1
	SNA CLA
	JMP ASGNST
	TAD DFLTNM+1
	DCA DEV2
	TAD DFLTNM
	DCA DEV1
ASNORM,	TAD DEV1
	DCA AS+1
	TAD DEV2
	DCA AS+2
	TAD OUTSW
	SNA CLA		/DON'T LOAD HANDLER IF WE ARE ON OUTPUT SIDE OF "_"
	TAD NAME1
SPKLG1,	SNA CLA		/OR IF THERE IS NO FILE NAME TO LOOK UP
	TAD GETHND	/GETHND=11 NORMALLY, 0 IF IN "SPECIAL DECODE" MODE
	IAC
	DCA AS
	TAD [1401	/ALLOW TWO PAGE HANDLERS
	DCA ASADR
	CIF 10
	JMS I [200
AS,	0
	0
	0
ASADR,	1401
	JMP I [CDER0
	TAD AS+2
ASGNST,	DCA DVICE
	JMP I ASSIGN
GNAME,	0
	DCA NAME1
	DCA NAME2
	DCA NAME3
	DCA NAME4
	TAD [NAME1
	DCA NMBASE
	CLA CMA
	DCA PERDSW
	DCA NAMECT
GTNMLP,	JMS I [GCH
	DCA DELIM
	TAD DELIM
	TAD [-"?
	SZA
	TAD ["?-"*
	SNA
STARSW,	JMP I [CDER2	/"JMP STARNM" IF "SPECIAL DECODE" MODE
	TAD ["*-".
	SNA CLA
	JMP PERIOD
	JMS I [DECODE
	JMP I GNAME
STARNM,	CLA		/THIS CODE HANDLES *'S AND ?'S CORRECTLY
	TAD DELIM
	AND [77
	DCA DELIM
	TAD NAMECT
	TAD [-6
	SMA CLA
	JMP GTNMLP
	TAD NAMECT
	CLL RAR
	TAD NMBASE
	DCA TT
	TAD DELIM
	SZL
	JMP .+4
	RTL
	RTL
	RTL
	TAD I TT
	DCA I TT
	ISZ NAMECT
	JMP GTNMLP
PERIOD,	TAD NAME1
	SZA CLA
	ISZ PERDSW
	JMP I [CDER2
	ISZ NMBASE
	TAD [4
	JMP GTNMLP-1
LOOKUP,	0
	DCA LNAME
	TAD NAME1
	SNA CLA
	JMP LKUPST
	JMP EXT1
LKUPLP,	DCA LNAME
	TAD AS+2
	CIF 10
	JMS I [200
	2
LNAME,	0	/NAME1
LENGTH,	0
	JMP LFAILD
	TAD LENGTH
	CLL
	TAD [400
	SNL
	CLA
	CLL RTL
	RTL
	AND [7760
LKUPST,	CDF 10
	TAD DVICE
	DCA I CLXR
	TAD LNAME
	JMP I LOOKUP
LFAILD,	TAD NAMECT
	SNA CLA		/WAS THERE AN EXPLICIT EXTENSION?
	TAD DEFALT	/NO - WAS THERE A DEFAULT EXTENSION?
	SNA CLA
	JMP I [CDER3	/YES OR NO - FILE NOT FOUND
	ISZ NAMECT	/NO AND YES - SET FLAG TO FAIL NEXT TIME
	JMP EXT2	/ZERO OUT THE EXTENSION AND TRY AGAIN
CDER3,	JMS I [PRNAME
	JMS I [PRMESG
	TEXT	/ NOT FOUND/
	IFZERO .+200&1000 <*600>
	0		/V3 [FREE LOC]
SLSHCH,	0
/V3	SNA
/V3	JMP I [CDER2
	DCA DELIM
	TAD [MPARAM-1
	DCA T
	JMS I [DECODE
	JMP I [CDER2
	SZL
	TAD [32
	CMA STL	/THE FOLLOWING TURNS ON THE CORRECT OPTION BIT
	DCA TT
SLSHLP,	SZL
	ISZ T
	RAR
	SNL
	ISZ TT
	JMP SLSHLP
	DCA TT
	CDF 10
	TAD TT
	CMA
	AND I T
	TAD TT
	DCA I T
	CDF 0
	JMP I SLSHCH
DECODE,	0
	TAD DELIM
	TAD [-"9-1
	CLL
	TAD ["9+1-"0
	SZL
	JMP DCDYES
	TAD ["0-"Z-1
	CLL CML
	TAD ["Z-"A+1
	SNL
DCDYES,	ISZ DECODE
	JMP I DECODE
CDER0,	TAD DEV1
	JMS I [PRWD
	TAD DEV2
	JMS I [PRWD
	JMS I [PRMESG
	TEXT	/ DOES NOT EXIST/

RESTRT,	JMS I [CRLF
	CDF 10
	TAD [MOFILE-1
	DCA XR
	TAD [-47
	DCA T
	DCA I XR	/ZERO OUT THE COMMAND DECODER OUTPUT AREA
	ISZ T
	JMP .-2
	CDF 0
	JMP I [GLINE
GCH,	0
	TAD I LXR
	TAD [-240
	SNA
	JMP GCH+1
	TAD [240-"/
	SNA
	JMP SLASH
	TAD ["/-"(
	SNA
	JMP OPENP
	TAD ["(
	JMP I GCH
SLASH,	TAD I LXR
	JMS I [SLSHCH
	JMP GCH+1
OPENP,	TAD I LXR
	TAD [-")
	SNA
	JMP GCH+1
	TAD [")
	JMS I [SLSHCH
	JMP OPENP
OLENGT,	TAD OUTSW
	AND NAME1	/[N] IS ONLY LEGAL ON THE OUTPUT SIDE OF THE "_"
	SNA CLA		/AND ONLY AFTER A FILE NAME
	JMP I [CDER2
	TAD [-4
	TAD CLXR
	DCA NMBASE
	CLA CLL CML RTL
	DCA NUMFUJ	/SET "NUMBER" TO ACCEPT DIGITS 8 AND 9
	TAD OLFUDJ	/LOAD FUDGE SO THAT "NUMBER" WILL BE DECIMAL
	JMS I [NUMBER
	CLL RTL
	RTL
	AND [7760
	TAD I NMBASE
	DCA I NMBASE
	CDF 0
	TAD DELIM
	TAD [-"]	/IS THERE A CLOSING BRACKET?
	SNA		/IF NOT, "DLOOK" ROUTINE WILL DETECT IT
	JMS I [GCH
	DCA DELIM
	JMP I [DLOOK
OLFUDJ,	NUM&177+1570

CDER2,	CLA
	JMS I [PRMESG
	TEXT	/ILLEGAL SYNTAX/
	IFZERO .&1000 <*1000>
	/TELETYPE INPUT ROUTINE FOR COMMAND DECODER
GLINE,	TAD (252	/SETS 1177=252 FOR * IN MESSAGE
	JMS I PRINT
	DCA RBFLAG
	TAD [BEGLN-1
	DCA LXR
CHLOOP,	6031		/KSF
	JMP CHLOOP
	TAD [200
	6034		/KRS
	DCA NAME1
	6032		/KCC
	TAD [SPADR-1
	DCA XR
DSPCHL,	TAD I XR
	SZA
	TAD NAME1
	SNA CLA
	JMP I XR
	JMP DSPCHL
SPADR,	-225;JMP CTRLU
	-215;JMP CARRET
	-377;JMP RUBOUT
	-375;JMP ALTMOD	/V3D MODIFIED BY SET
	-376;JMP ALTMOD	/V3D MODIFIED BY SET
	-233;JMP ALTMOD
	-200;JMP CHLOOP
	-217;JMP CHLOOP	/^O
	 -"_;JMP LESSTN
	-212;JMP LFEED
	-203;JMP CTRLC	/MUST BE LAST - SEE CLRLIN CODE
	0
	JMS PRNT
CINSRT,	TAD NAME1
	DCA I LXR
	TAD LXR
	TAD [-EOBUFR+2
	SPA CLA
	JMP CHLOOP
	JMS CRLF
	JMP I [CDER2
CARRET,	JMS CRLF
CLFINI,	DCA I LXR
	JMP I [ANALYZ
LESSTN,	JMS PRNT
	TAD ["<
	JMP CINSRT+1
CTRLC,
CTRLU,	TAD [336
	JMS I PRINT
	TAD NAME1
	TAD [100
CLRLIN,	JMS I PRINT
	JMS CRLF
	TAD I XR
	SZA CLA
	JMP GLINE
	CDF 10
	CLA CMA
	DCA I [7700
	TSF
	JMP .-1
	JMP I [7605	/7605=CDF CIF 10
CRLF,	0
	TAD [215
	DCA NAME1
	JMS PRNT
	TAD [212
	JMS I PRINT
	JMP I CRLF
ALTMOD,	TAD [244
	DCA NAME1
	CLA CLL CML RAR
	CDF 10
	DCA I [MPARAM-1
	CDF 0
	JMS PRNT
	JMP CLFINI
/*** LOCATIONS ON THIS PAGE ARE MODIFIED BY SET
/SEE SET FOR DETAILS.  DO NOT CHANGE.

RUBOUT,	TAD LXR
	TAD [1-BEGLN
	SNA CLA
	JMP RBSPCL
	TAD [334
	ISZ RBFLAG
	JMS I PRINT
	CLA CMA
	DCA RBFLAG
	TAD LXR
	DCA T
	TAD I T
	JMS I PRINT
LBCKUP,	CLA CMA
	TAD LXR
	JMP CHLOOP-1
RBSPCL,	ISZ RBFLAG
	JMP CLRLIN+1
	TAD [334
	JMP CLRLIN
PRNT,	0
	ISZ RBFLAG
	JMP .+3
	TAD [334
	JMS I PRINT
	DCA RBFLAG
	TAD NAME1
	JMS I PRINT
	JMP I PRNT
LFEED,	JMS CRLF
	DCA I LXR
	TAD [BEGLN-2
	DCA XR
	TAD I XR
	SNA
	JMP LBCKUP
	JMS I PRINT
	JMP .-4

	IFNZRO RUBOUT-1131 <_ERROR_>
	*1200		/INITIALIZATION - STORED OVER BY LINE BUFFER
	BEGLN=.		/LINE BUFFER
CDINIT,	DCA TFPUTX
	CDF 10
	CLA IAC
	TAD I [200
	DCA TMONIT	/SAVE AWAY MONITOR CALL ADDRESS SINCE WE CALL
	TAD I [USERFG	/THE MONITOR RECURSIVELY, LIKEWISE SAVE
	DCA TUSRFG	/THE "USER FLAG" AND THE FIELD WE WERE CALLED FROM
	TAD I [T1	/FETCH THE USERS ARGUMENT
	DCA DEFALT	/STORE IN THE DEFAULT EXTENSION WORD
	DCA I [7	/ZERO "DIRECTORY SEGMENT IN CORE" KEY
	CDF 0
	CIF 10
	JMS I [200
	13		/RESET ALL HANDLERS
	0		/BUT NOT OUTPUT FILES
	TAD DEFALT
	TAD M5200
	SZA CLA		/IS THIS A REQUEST FOR A "SPECIAL DECODE"?
	JMP CDCONT	/NO
	TAD ALTLIM
	DCA OUTLIM	/YES - SET UP ALL THE PROPER LOCATIONS
	TAD ALTDF1
	DCA LIMDIF	/TO YIELD 1 OUTPUT FILE AND 5 INPUT FILES
	TAD ALTDF2
	DCA BEGDIF	/ALL OF WHICH ARE 5-WORD <DEVICE,NAME> ENTRIES
	DCA I PLKUPS
	TAD STARJM
	DCA I PSTARS	/AND ALLOW * AS A FILE OR EXTENSION NAME
	DCA DEFALT	/NO DEFAULT EXTENSION IN "SPECIAL" MODE
	TAD CCLA	/STOPS FETCHES IN SPECIAL MODE
	DCA I PSPKG1	/NO HANDLER FETCHES NECESSARY EITHER SINCE NO LOOKUPS
CDCONT,	TAD I PRWD	/SEE IF BATCH FLAG IS UP
	RAL
	SPA CLA		/IF YES, GO TO PAGE0 CODE
	JMP TT		/TT ETC. IS ONCE-ONLY CODE
	JMP I CDRST
CDRST,	RESTRT+1
		/CONSTANTS NECESSARY TO SUPPORT "SPECIAL DECODE" MODE
M5200,	-5200
ALTLIM,	1-MOFILE-5
ALTDF1,	MOFILE+5-MPARAM+5
ALTDF2,	5
PLKUPS,	LKUPSW
STARJM,	STARNM&177+5200		/"JMP STARNM"
PSTARS,	STARSW
CCLA,	CLA
PSPKG1,	SPKLG1
	*1314
	EOBUFR=.
PRMESG,	0
	TAD I PRMESG
	JMS PRWD
	TAD I PRMESG
	ISZ PRMESG
	AND [77
	SZA CLA
	JMP PRMESG+1
	JMP I [RESTRT
PRWD,	7777
	DCA T
	TAD T
	RTR
	RTR
	RTR
	JMS PCHAR
	TAD T
	JMS PCHAR
	JMP I PRWD
PCHAR,	0
	AND [77
	SNA
	JMP I PCHAR	/IGNORE NULLS
	TAD [240
	AND [77
	TAD [240
	JMS TYPE
	JMP I PCHAR
PRNAME,	0
	TAD NAME1
/	SNA		/WOULD LIKE TO FIND ROOM FOR THESE 2 LOCS
/	JMP I [CDER2
	JMS PRWD
	TAD NAME2
	JMS PRWD
	TAD NAME3
	JMS PRWD
	TAD NAME4
	SNA CLA
	JMP I PRNAME
	TAD [256
	JMS PCHAR
	TAD NAME4
	JMS PRWD
	JMP I PRNAME
TYPE,	0
	JMP .+3
	TSF
	JMP .-1
	TLS
	CLA
	TAD [7000
	DCA TYPE+1
TYPRET,	JMP I TYPE
	IFNZRO TYPRET-1377 <BATCHX,ZQWE>
	*4001	/PROG TO WRITE CD AND ODT ONTO NEW SYSTEM DEVICE
		/4000=JMS SYSSWP TO SWAP PGS 6600 AND 7600
	TAD I (7777	/SET TO PROPER RECORD FOR FIELD 1 STUFF
	DCA F1STUF
	JMS I SYSHND
	4600
	0
	MCDREC
	JMP CERR
	JMS I SYSHND
	5011
	0
	ODTREC
	JMP CERR
	JMS I SYSHND
	0110		/READ IN UPPER PG 7600
	7600
F1STUF,	0
	JMP CERR
	JMP I .+1
	7605		/START HER UP
CERR,	TAD .+3
	DCA 4001
	JMP 4000	/RESWAP AND HALT
	HLT
SYSHND,	7607
	PAGE
	*0
	CDVERSION
	HLT		/POWER FAIL RESTART PROTECTION
NUMTST,	7777
	JMS I [GCH
	CMA
	TAD NUMFUJ
	TAD ["8		/TEST INPUT CHARACTER FOR RANGE
	CLL CMA		/0-7 IF NUMFUJ=0
	TAD [10		/0-9 IF NUMFUJ=2
	TAD NUMFUJ
	JMP I NUMTST
	*15
LXR,	0
XR,	0
CLXR,	0
T,	CDINIT
TT,	CDF 0		/***GETS SET TO CDF BATCH
HIORD,	TAD I DVICE	/CHECK TO SEE IF BOS IS REALLY THERE
NUMX,	TAD OUTSW	/IF NOT, SIGNAL ERROR
RBFLAG,	SNA CLA
NAME1,	JMP NAMECT	/IT'S O.K.....PROBABLY!
NAME2,	CDF 0		/BAD. SIGNAL ERROR TO MONITOR
NAME3,	ISZ I NUMTST
NAME4,	JMP I [7605	/AND RESTART BATCH MONITOR
NAMECT,	CIF CDF 0	/*****GETS ALTERED******
NMBASE,	JMP I .+1	/START UP IN CD AREA OF BATCH
DEV1,	RESTRT+1	/***GETS ADDRESS OF CD AREA
DEV2,	0
PERDSW,	0
NUMFUJ,	0
DVFLAG,	0
DELIM,	0
OUTSW,	0
DEFALT,	0
DVICE,	0
DFLTNM,	0423;1300	/DSK
BEGDIF,	MIFILE-MOFILE
LIMDIF,	MIFILE-MPARAM+2
OUTLIM,	1-MIFILE
GETHND,	11
TMONIT,	0
TUSRFG,	0
TFPUTX,	0
EXT1,	TAD NAME4
	DCA NAMECT	/REMEMBER TYPED EXTENSION
	TAD NAMECT
	SNA
	TAD DEFALT	/SUBSTITUTE DEFAULT IF ZERO
EXT2,	DCA NAME4
	TAD [NAME1
	JMP I .+1
	LKUPLP
PRINT,	TYPE
	FIELD 1
	XLIST
	EJECT INVISIBLE ODT
	/INVISIBLE ODT FOR OS/8 MONITOR
	/LOADS INTO FIELD 1 NOW, BUT LOADS & EXECUTES IN FIELD 0
	/DEFINITIONS OF MONITOR SYMBOLS - VOLATILE!
	ODTREC=60
	UDNAME=7741
	MREAD=7757
	MGET=7667
	KMREC=7
	MTEMP=27
	MARG1=7740
	JSBITS=7746
	LXM=6200		/EXTENDED MEMORY REGISTER LOAD
	RXM=6230		/EXTENDED MEMORY REGISTER READ
	RACA=6175		/EXTENDED MEMORY BIT MANIPULATION
	RACB=6176		/"                              "
	RACC=6177		/"				"
	*200
READ,	JMS I [OCRLF
READ5,	DCA WORD
	DCA WORD+1
	TAD [-7		/ SET CHARACTER LIMIT
	DCA TOTE
REA,	KSF		/CHARACTER INPUT
	JMP .-1
	JMS I [CTCTST	/CONTROL 'C' TEST
	JMP CTRC	
	TAD (203
	DCA TEMP	/STORE CHARACTERS
	KCC
	TAD TEMP
	JMS I [TYPN	/ECHO INPUT CHARACTERS
	TAD TABL1A	/SET UP COMMAND TABLE SEARCH
	DCA 10
CHFLP,	TAD I 10	/CHARACTER I.D.
	SPA
	JMP SEX		/NO COMMAND -NUMERIC INPUT
	CIA
	TAD TEMP
	SZA CLA
	JMP CHFLP	/NOT THIS ONE-TRY NEXT ONE
	TAD 10		/THIS IS THE COMMAND
	TAD TABL2A	/SET UP JUMP TO COMMAND SUBROUTINE
	DCA TEMP
	TAD I TEMP
	DCA TEMP
	TAD WORD
	JMS I [XLODE	/BANK AND FIELD ADJUSTMENT
	DCA WORD
	JMP FLDTST	/SEE IF FIELD SETTING IS LEGAL
CTRC,	JMS I [DUMP	/CONTROL 'C'
	LXM		/DISABLE KT8A
	JMP I [7605
TABL1=.		/COMMAND TABLE
	240		/SPACE
	212		/LINE FEED
	215		/CR
	257		/SLASH
	302		/B
	307		/G
	273		/;
	303		/C
	327		/W
	336		/^
	315		/M
	301		/A
	314		/L
	304		/D
	337		/<-ARROW
	306		/F
	377		/RUBOUT
	253		/+
	255		/-
	-270		/USED - SEE "SEX"
EXAM,	JMS TOTTST	/SLASH SUBROUTINE-LOCATION EXAMINATION
	JMP EX2
	TAD WORD	/FIELD
	DCA CAD
	TAD WORD+1	/ADDRESS
	DCA CAD+1
EX2,	JMS LOAD	/GET LOCATION CONTENTS
	CAD
	JMS I [PNUM	/ECHO CONTENTS 
	DCA SHUT
	JMP READ5
SEX,	TAD TEMP	/ADDRESS & FIELD ADJUSTMENT
	CLL
	TAD [10		/TEST FOR NUMBER
	SNL
	JMP NO
	DCA TEMP
	CLA CLL CMA RTL
	DCA CRL
SROT,	TAD WORD+1	/FIELD & ADDRESS PROCESSING
	CLL RAL
	DCA WORD+1
	TAD WORD
	RAL
	DCA WORD	/FIELD AND BANK STORAGE
	ISZ CRL
	JMP SROT
	TAD WORD+1
	TAD TEMP
	DCA WORD+1	/ADDRESS STORAGE
	ISZ TOTE	/TEST FOR TOO MANY CHARACTERS
	JMP REA
NO,	CLA		/UNACCEPTABLE INPUT ECHOS ?
	TAD [277
	JMS I [TYPN
	JMP READ
CRL,	0		
	JMS TOTTST
	JMP I CRL
	TAD WORD+1
	ISZ SHUT
	JMS I [STORE
	CAD
	CLA
	JMP I CRL
CRL1,	JMS CRL		/CARRAIGE RETURN
	JMP READ
CRL2,	TAD [215	/LINE FEED
	JMS I [TYPN
	JMS CRL
	JMS I [TYPN
	ISZ CAD+1
TABL1A,	TABL1-1
UPAR3,	JMS I [TYPD
	CAD
	TAD [257
	JMS I [TYPN
	JMP EX2
OPIN,	JMS CRL		/BKARROW/UNDERLINE
	JMS LOAD
	CAD
	DCA CAD+1
	TAD INDFLD
	JMS I [XLODE
	DCA CAD
UPAR2,	JMS I [OCRLF
	JMP UPAR3
SEMI,	JMS CRL		/SEMI COLON
	ISZ CAD+1
TABL2A,	TABL2-TABL1
	JMP READ5
	*400
/NOTE THAT LOCATIONS BURP,BURP+1 GET ALTERED AFTER BRKTST
/IS EXECUTED. THEY BECOME: CDF 10; TAD I [MARG1
BURP,	JMP I .+1	/RETURN FROM BREAKPOINT -GO REDETERMINE CORE SIZE
	BRKTST		/TO MAKE ILLEGAL FIELD GIVE ?
	DCA SAC
	/IOF	/COMMENTED OUT FOR HIGH GROUND SUPPORT
	TAD I [MTRAD		/RESTABLISH ADDRESS,FIELD,ETC.
	DCA TRAD
	TAD I [MTRAD1		/THESE ARE ALL 
	DCA TRAD+1
	TAD I [MKEEP		/BREAKPOINT PARAMETERS
	DCA KEEP
	TAD I [MPUNN		/
	DCA PUNN
	CLA IAC
	AND I (7700
	DCA LINK
	TAD I (7700
	CDF 0
	JMS I [T174	/BANK AND FIELD MANIPULATION
	TAD DATFLD
	DCA INDFLD
	TAD [KMREC
	CDF 10
	DCA I (MGET+4
	CLA CLL CMA RAL
	AND I [MGET+2
	DCA I [MGET+2	/REMOVE LOW-ORDER BIT FROM CONTROL WORD
	CDF 0
	TAD KEEP
	JMS I [STORE
	TRAD
	TAD TRAD+1
	IAC
	DCA GAME+1		/ESTABLISH CONTINUE PARAMETERS
	TAD TRAD
	DCA GAME
	TAD KEEP
	DCA INST
	JMS IOTTST
	SKP
	JMP JMPLIP
	TAD TRAD
	DCA CAD			/ESTABLISH EXAM PARAMETERS
	TAD TRAD+1
	DCA CAD+1
	JMS I [EFFADR
	TAD CAD
	DCA FROG
	TAD CAD+1
	DCA FROG+1
JMPLIP,	JMS I [CTCTST
	JMP I [7605
	CLA
	JMP I (LIP
CTCTST,	0		/CONTROL 'C' TEST
	TAD [200
	KSF
	STA
	KRS
	TAD (-203
	SZA
	ISZ CTCTST
	JMP I CTCTST

OCRLF,	0		/CARRAIGE RETURN-LINE FEED
	TAD [215
	JMS I [TYPN
	TAD [212
	JMS I [TYPN
	CLA CMA
	DCA SHUT
	JMP I OCRLF
TRAP,	JMS TOTTST	/ESTABLISHES BREAKPOINT
	TAD [SHNDLR
	TAD WORD+1
	DCA TRAD+1	/ADDRESS
	TAD WORD
	DCA TRAD	/FIELD
	TAD [7000
	DCA I [SHNDLR
	TAD [4
	DCA WORD+1
	TAD [UDNAME-MPUNN-1
	DCA TEMP
	TAD [BRKCOD-1	/MOVE UP RETURN CODE
	DCA 10
	TAD [UDNAME-1
	DCA 11
	TAD I 10
	CDF 10
	DCA I 11
	CDF 0
	ISZ TEMP
	JMP .-5
	TAD I [JSBITS
	RTR
	SZL CLA
	TAD [5
	CDF 10
	TAD I [J7600
	DCA I [J7600	/CHANGE JMP 7600 TO JMP 7605 IF ODT AREA NOT USED
	CDF 0
	TAD I [JSBITS
	DCA JSTEMP		/SAVE JSBITS BEFORE SETTING BRKPT
	TAD [CIF 10
	JMS I [STORE
	WORD
	ISZ WORD+1
	TAD [JMP I 6	/STORE RETURN JMP
	JMS I [STORE
	WORD
	ISZ WORD+1
	TAD DNAME
	JMS I [STORE
	WORD
	TAD JSTEMP
	DCA I [JSBITS		/RESTORE JSBITS
	JMP I [READ
SUBT,	CML
ADD,	TAD WORD+1	/MODIFY CURRENT LOCATION POINTER
	SNA
	IAC		/1 IS DEFAULT VALUE
	SZL		/+ OR -?
	CIA		/-
	TAD CAD+1
	DCA CAD+1
	JMP I [UPAR2	/AND DISPLAY LOC AND CONTENTS
	*600		/MONITOR ENTERS ODT HERE
LIP,	HLT		/ERROR. AT INIT, THE CODE AT 600
	JMP I .+1	/IS CHANGED TO: ISZ PUNN;
TTYTST,	INIT		/JMP XCONT; TSF
	JMP TTYOFF
LIPTYP,	JMS I [TYPD
	TRAD
	TAD P250
	JMS I [TYPN
	TAD LINK
	TAD [260
	JMS I [TYPN
	TAD [273
	JMS I [TYPN
	TAD SAC
	JMS I [PNUM
	JMP I [READ
JUMP,	JMS TOTTST	/TEST FOR 'G' WITH NO ADDRESS
	JMP I PNO
	TAD WORD
	DCA GAME
	TAD WORD+1
	DCA GAME+1
	TAD WORD
	JMS I [T174	/FIELD ADJUSTMENT -STORED IN DATFLD
	TAD [7000
	DCA INST
	DCA SAC
	DCA LINK
	JMP CONTX
CONTIN,	

	TAD WORD+1	/ 'C'-CONTINUE COMMAND
	CIA
	SNA
CONTX,	CMA
	DCA PUNN
	DCA I [7607	/IN CASE THERE WAS NO BREAKPOINT
	JMS LOAD	/V3
	TRAD		/V3
	DCA KEEP	/V3
	JMS I [OCRLF
XCONT,	TAD [JMP 4
	JMS I [STORE
	TRAD
	CDF 10
	TAD TRAD
	DCA I [MTRAD
	TAD TRAD+1
	DCA I [MTRAD1
	TAD KEEP
	DCA I [MKEEP
	TAD PUNN
	DCA I [MPUNN
	CDF 0
	TAD EXTEMP
	LXM
	JMS I [SIM	/SIMULATE THE BRKPOINTED INST HERE
	TAD LINK	/SAVE LINK
	DCA I [MLINK	/ESTABLISH RETURN CODE---MXXXX'S
	TAD SAC		/SAVE AC
	DCA I [MAC
	TAD GAME	/ESTABLISH START CDF
	TAD [CIF 0
	DCA I [MSTCDF
	TAD DATFLD	/ESTABLISH 'B' CDF
	JMS I [XLODE
	TAD [CDF 0
	DCA I [MCDF
	TAD GAME+1	/ESTABLISH START ADDRESS
	DCA I [MSTADR
	JMS I [DUMP
	TAD I [JSBITS
	RTR
	SZL CLA
	JMP I [MSWITC
	JMP I [MREAD	/EXECUTION TIME
UPAR1,	JMS I [CRL	/UP-ARROW COMMAND- CLOSE LOCATION
	JMS I [EFFADR
	JMP I [UPAR2	/PRINT REFERENCED LOCATION CONTENTS
EFFADR,	0		/USE CONTENTS AS MRI
	JMS LOAD
	CAD
	AND [177	/ISOLATE LOCATION REFERENCED
	DCA TEMP
	JMS LOAD
	CAD
	AND [200	/IS IT 'THIS PAGE'?
P250,	SNA CLA
	JMP .+3
	TAD CAD+1
	AND [7600
	TAD TEMP
	DCA TEMP
	JMS LOAD
	CAD
	AND T400	/IS IT INDIRECT-TEST '400' BIT
	SNA CLA
	JMP NOIND
	TAD TEMP
	DCA CAD+1
	JMS LOAD
	CAD
	DCA TEMP
	TAD CAD+1
	AND P7770	/IS IT AUTO-INDEXED?
	TAD P7770
	SZA CLA
	JMP NOAUTO
	ISZ TEMP
P7770,	7770		/COVERS ISZ....
	TAD TEMP
	JMS I [STORE
	CAD
NOAUTO,	TAD INDFLD	/NO INDEXING
	JMS I [XLODE
	DCA CAD
NOIND,	TAD TEMP	/NOT INDIRECT
	DCA CAD+1
	JMP I EFFADR
TTYOFF,			/WASTE SOME TIME
	JMS IOTTST
T400,	AND I 0
	ISZ NOUGHT
	JMP TTYTST
	JMP LIPTYP	/IF THE TTY FLAG ISN'T UP NOW, IT'LL NEVER GO UP
TABL2=.		/COMMAND TABLE SUBROUTINE INFO
	REA		/IGNORE BLANKS
	CRL2
	CRL1
	EXAM
	TRAP
	JUMP
	SEMI
	CONTIN
	WSER
	UPAR1
	MASKX
	ACX
	LINKX
	DATF
	OPIN
	INDF
	RBOUT
	ADD
	SUBT
IFZERO 1000&. <*1000>
PNUM,	0		/PRINTS CONTENTS OF ADDRESS LOCATION
	DCA PUNN	/OR ADDRESS...ITSELF
	TAD [-4
	DCA TEMP
PN2,	TAD PUNN
	RTL
	RAL
	DCA PUNN
	TAD PUNN
	RAL
	AND [7
	TAD [260
	JMS I [TYPN
	ISZ TEMP
	JMP PN2
	TAD [240
	JMS I [TYPN
	JMP I PNUM
TYPD,	0		/PRINTS BANK AND FIELD OF ACCESSED LOC.
	TAD I TYPD
	DCA TEMP
	TAD I TEMP
	JMS I TYPDXX
	JMS I [TYPN	/TYPE BANK
	TAD NWD		 
	JMS I [TYPN	/TYPE FIELD
	TAD I TEMP
	JMS I [PNUM	/PRINT ADDRESS
	ISZ TYPD
	JMP I TYPD
TYPDXX,	TYPDX
TYPN,	0		/PRINTS CHARACTERS PREPARED BY TYPD;PNUM,ETC.
	TLS
	TSF
	JMP .-1
	CLA
	JMS I [CTCTST
	JMP I [CTRC
	TAD [-14	/^O?
	SZA CLA
	JMP I TYPN	/NO
	KCC		/YES
	JMP I [READ
WSER,	JMS I [OCRLF	/ 'W'---WORD SEARCH
	TAD LIMLO
	DCA CKT+1	/ESTABLISH LOWER LIMIT
	TAD INDFLD
	JMS I [XLODE	/ADJUST WORD SEARCH BANK AND FIELD
	DCA CKT
WSER1,	JMS LOAD
	CKT
	AND MASK	/SEARCH MASK
	CIA
	TAD WORD+1
	SZA CLA
	JMP WSER2
	JMS I [TYPD	/WORD FOUND GO TYPE IT
	CKT
	TAD [257
	JMS I [TYPN
	JMS LOAD
	CKT
	JMS I [PNUM
	JMS I [OCRLF
WSER2,	TAD CKT+1	/TEST NEXT LOCATION
	CIA
	TAD LIMHI	/IF IT ISN'T ABOVE THE LIMIT
	SNA CLA
	JMP I [READ	/OVER LIMIT GO GET NEXT COMMAND
	ISZ CKT+1
	JMP WSER1	/SEARCH NEXT LOCATION

ACX,	TAD [SAC-LINK	/ 'A' COMMAND
LINKX,	TAD [LINK-MASK	/ 'L' COMMAND
MASKX,	TAD [MASK-INDFLD	/ 'M' COMMAND
INDF,	TAD [INDFLD-DATFLD		/'F' COMMAND
DATF,	TAD [DATFLD	/ 'D' COMMAND
	DCA WORD+1
	CLA CMA
	DCA WORD
	DCA TOTE
	TAD [257
	JMS I [TYPN
	JMP I [EXAM
BRKCOD=.		/RETURN CODE --- FROM 'G','C' COMMANDS
	NOPUNC
	*UDNAME		/STORED IN UPPER FIELD ZERO
	ENPUNC

	DCA MARG1
	RAL
	RDF
	DCA 7700
	TAD PODT
	DCA MGET+4
	ISZ MGET+2	/DON'T REVERSE TAPE MOTION TO PICK UP ODT
	CDF CIF 0
J7600,	JMP 7600
PODT,	ODTREC
P7603,	7603
MTRAD,	0
MTRAD1,	0
MKEEP,	0
MPUNN,	0

	NOPUNC
	*BRKCOD+MPUNN-UDNAME+1
	ENPUNC

DUMP,	0		/SUBROUTINE TO STORE ADJUSTED CODE
	TAD STOFLG	/LT
	SNA CLA
	JMP I DUMP
	JMS I [SHNDLR
	4200
	1400
GREC,	0		/SET BY GETADR
	HLT
	DCA STOFLG
	JMP I DUMP

RBOUT,	TAD [277	/RUBOUT COMMAND
	JMS I [TYPN
	TAD [240
	JMS I [TYPN
	JMP I REDE5
	IFNZRO .-1200&4000 <*1200>
SIM,	0		/SIMULATES BREAKPOINTED INST
	JMS IOTTST
	JMS LOAD
	FROG
	DCA TEMP
	JMS I [DUMP
	DCA I [GREC
	JMS I [SHNDLR	/DUE TO 128K CODE -SIM IS LOADED INTO 1600
	0100
SIMXT,	1600
	64
	HLT
	JMS I SIMXT
	JMS I [STORE
	FROG
	JMP I SIM
XLODE,	0		/TRANSFORMS 'ABCDE' TO 'ACDEB0' FOR CDF
	DCA NWD
	TAD TEMP	/TEST FOR GO COMMAND
	CIA		/A 'GO' ABOVE 32K REQUIRES SETTING EXTEMP
	TAD TJUMP	/FOR LXM ENABLE
	SNA CLA
	TAD (30
	AND NWD
	SNA CLA 
	JMP LT32K
	TAD [7000
	DCA EXTEMP
LT32K,	TAD NWD		/TRANFORMATION IS HERE
	AND (17
	TAD (7770
	SPA
	TAD (17
	TAD [7771
	TAD NWD
	CLL RTL
	JMP I XLODE

T174,	0		/TRANSFORMS 174 TO 37
	CLL RTR
	RAR
	AND (17
	TAD [10
	AND [7767	/... 0027 ARE THE RELEVANT BITS IN 7767
	SZL
	TAD [10
	DCA DATFLD
	JMP I T174
TYPDX,	0		/PROCESSES BANK & FIELD FOR PRINTING
	SPA		/ADJUSTMENT FOR LINE FEED AFTER
	CLA		/REFERENCE TO M,D,F,ETC. COMMANDS
	CLL RTR
	RAR
	DCA T174
	TAD T174
	AND [7
	TAD [260
	DCA NWD
	TAD T174
	AND [10
	SZL
	TAD [4
	CLL RTR
	TAD [260
	ISZ TEMP
	JMP I TYPDX


STORE,	0		/SUBROUTINE TO ADJUST CODE
	DCA LOAD
	TAD I STORE
	JMS I [GETADR
	ISZ STOFLG	/INDICATE THAT WE'RE CHANGING THIS RECORD
	TAD LOAD
	DCA I ADR
	CDF 0
	ISZ STORE
	JMP I STORE
GETADR,	0		/GETS ADDRESS....
	DCA ADR
	TAD I ADR
	DCA FADR
	ISZ ADR
	TAD I ADR
	DCA ADR
	TAD FADR
	SNA		/ONLY NEED TO FOOL WITH ADDRESS IF IT'S IN FIELD 0
	JMP CKADR
	SPA
	CLA
	TAD [CDF 0
	DCA .+1
FADR,	0
	ISZ GETADR
	JMP I GETADR
CKADR,	TAD ADR		/MANIPULATES FIELD 0 OF ODT'D PROGRAM
	RAL		/ACCESSES IT IN LOCS 1400-1777
	SZL SPA CLA	/
	JMP FADR+1
	CLA CLL CMA RTL
	AND I [JSBITS
	DCA I [JSBITS	/MODIFY THE JSW TO INDICATE ODT AREA VIOLATION
	TAD ADR
	CLL RTL
	RTL
	RAL
	AND [7		/CALCULATE BLOCK OF STORAGE
	TAD [MTEMP+4
	DCA GIREC
	TAD I [GREC	/MAYBE IT'S ALREADY IN CORE
	CIA
	TAD GIREC
	SNA CLA
	JMP NOREAD	/IT IS!!
	JMS I [DUMP	/MAYBE... ...IT ISN'T
	JMS I [SHNDLR	/LOADS RELEVANT PROGRAM CODE
	0200
G1400,	1400
GIREC,	0
	HLT
	TAD GIREC
	DCA I [GREC
NOREAD,	TAD ADR		/ADJUST THE ADDRESS FOR PROPER ACCESS
	AND (377
	TAD G1400
	DCA ADR
	JMP I GETADR


	*1400
	/INITIALIZATION CODE TO SET UP THE "MREAD" AREA IN FIELD 0
	/WITH THE ODT CODE TO START UP A PROGRAM

INIT,	TAD I 10
	DCA I 11
	ISZ TEMP
	JMP .-3
	JMS CORE	/DETERMINE CORE FIELD SIZE
	TSF
	JMP .-1
	JMP I [READ

BRKTST,	JMS CORE	/GET CORE SIZE NOW THAT WE WERE
	TAD KLIP
	DCA I PLIP	/SETUP LOCATIONS AT 600
	TAD KLIP+1
	DCA I PLIP+1
	TAD KLIP+2
	DCA I PLIP+2
	TAD KCDF10	/JUST BREAKPOINTED IN. THEN RESTORE
	DCA I BURPO	/LOCS AT BURP SO WE NEVER COME BACK
	TAD KCDF10+1	/HERE AGAIN UNTIL WE'RE SWAPPED
	DCA I BURP2
	JMP I BURPO
KCDF10,	CDF 10
	TAD I [MARG1	/SIMULATE LOCS AT BURP
BURPO,	BURP
BURP2,	BURP+1
RSTCOD=.		/RESTORES ODT AFTER 'C','G' COMMANDS
	NOPUNC
	*MREAD-1
	ENPUNC

	SHNDLR
	JMS I .-1
	1000
	0
	MTEMP+4
	HLT
MSWITC,	TAD MLINK
	CLL RAR
	TAD MAC
MCDF,	CDF 0		/CDF OF PREVIOUS BRKPOINTED INST
	JMP MSTCDF
MAC,	0		/SAVED AC
MLINK,	0		/LIKEWISE LINK
MSTCDF,	CIF 0		/START CDF
	JMP I .+1
MSTADR,	0		/START ADDRESS

	NOPUNC
	*RSTCOD+MSTADR-MREAD+2
	ENPUNC
CORE,	0		/DETERMINES AVAILABLE CORE
	RXM		/READ AND STORE EXT MEM INFO
	DCA EXTEMP
	TAD [7000
	LXM		/SETS LXM FOR ODT PURPOSES
	CLA
	CDF 0
	TAD I M1	/FIELD INFO STORED IN 7777(IF AVAILABLE)
	AND COR70
	CLL RTR
	RAR
	SZA		/HAS CORE SIZE BEEN SET?
	JMP USERCR	/VERILY
COR0,	CDF 0
	TAD CORSIZ	/GET FIELD TO TEST
	JMS I [XLODE	/EXTENDED MEMORY BANK&FIELD ADJUSTMENT
	TAD COREX
	DCA .+1		/SET UP CDF TO FIELD
COR1,	CDF	
	TAD I CORLOC	/SAVE CURRENT CONTENTS
COR2,	NOP
	DCA COR1
	TAD COR2
	DCA I CORLOC
COR70,	70		/ACTS AS NOP
	TAD I CORLOC	/TRY TO READ BACK 7000
CORX,	7400
	TAD CORX
	TAD CORV
	SZA CLA
	JMP COREX	/NON-EXISTENT FIELD EXIT
	TAD COR1	/RESTORES CONTENTS DESTROYED
	DCA I CORLOC
	ISZ CORSIZ	/TRY NEXT HIGHER FIELD
	JMP COR0

COREX,	CDF 0		/STORE AWAY LAST REAL FIELD IN 'ZERO'
	TAD CORSIZ
	TAD M1
USERCR,	CIA
	DCA ZERO
	JMP I CORE
CORLOC,	CORX
CORV,	1400
M1,	-1
CORSIZ,	1
KLIP,	ISZ PUNN
	XCONT&177+5200
	TSF
PLIP,	LIP
	LIP+1
	LIP+2

	*1600
SIMX,	0		/SIMULATES BREAKPOINTED INST
	TAD TEMP
	DCA 0
	JMS IOTTST	/IS IT AN IOT?
	TAD T777
	CMA
	AND INST
	RAL
	CML
	SNL SMA		/IS IT A JMS OR A JMP?
	JMP JMSJMP
	CML RAR
	DCA SOPR	/STORE INST IN SOPR
	TAD DATFLD	/PREPARE CDF
	JMS I [XLODE
	TAD [CDF 0
	DCA .+1
	HLT
	TAD LINK	/AND LINK
	CLL RAR
	TAD SAC		/AND AC
SOPR,	HLT		/EXECUTE INSTRUCTION
	SKP
	ISZ GAME+1
	DCA SAC		/RESAVE AC,LINK,DATFLD
	RAL
	DCA LINK
	RDF
	JMS I [T174
	CDF CIF 0
EOSIM,	TAD 0		/PREPARE TO RETURN
	CIA		/HAS LOC 0 BEEN CHANGED?BY A TAD...DCA...ISZ...
	TAD TEMP
EOTST,	SNA CLA		/IF SO,THEN...
	JMP .+3
	TAD 0		/...DO A STORE(ON RETURN TO SIM)
	JMP I SIMX
	ISZ SIMX
	JMP I SIMX
JMSJMP,	RTL		/PROCESS JMP,JMS
	SZL CLA
	JMP JMPX
	TAD TRAD
	DCA FROG
	TAD GAME+1
	DCA 0
	CLA IAC CLL
JMPX,	TAD FROG+1
	DCA GAME+1
	CML RAL		/PUT -LINK IN AC (0 IF JMP, 1 IF JMS)
	JMP EOTST
T777,	777

	*0
ZERO,	ODTVERSION
	/HLT		/IN CASE BKPT WITH INTER ON
	CIF 30		/SYMBIONT CODE
	JMP .-1
PUNN,	0
	*4		/PAGE 0 LITERALS AND CELLS
	CIF 10		/PROTOTYPE BREAKPOINT
	JMP I 6		/USED BY PROGRAMS WITH JSBITS(10)=1
DNAME,	UDNAME		/WHEN ODT IS RELOADED ON A BREAKPOINT

	*7
EXTEMP,	0
	RSTCOD-1
	MREAD-2
	*12
TOTE,	0
KEEP,	0
INST,	0
SHUT,	-1
TRAD,	0;SHNDLR
WORD,	0;0
LINK,	0
SAC,	0
CAD,	0;0
CKT,	0;0
GAME,	0;0
FROG,	0;0
TEMP,	MREAD-MSTADR-2
JSTEMP,	0
DATFLD,	0
INDFLD,	0
MASK,	7777
LIMLO,	0
LIMHI,	7577
ADR,	0
FLDTST,	TAD ZERO		/LOC. 0 HAS LAST REAL CORE FIELD
	TAD NWD		/IF USER TRIES TO ADDRESS NON-
	SMA SZA CLA		/EXISTENT CORE, A ? RETURNS
	JMP I PNO
	JMP I TEMP	/HE'S OK.
PNO,	NO
TOTTST,	0		/TEST FOR COMMAND WITHOUT ADDRESS
	TAD TOTE
	TAD [7
	SZA CLA
	ISZ TOTTST
	JMP I TOTTST
STOFLG,	0
NWD,	0
TJUMP,	JUMP
NOUGHT,	0
LOAD,	0		/SUBROUTINE TO LOAD PROGRAM CODE
	TAD I LOAD
	JMS I [GETADR
REDE5,	READ5
	TAD I ADR	/RETURNS ADDRESS CONTENTS IN AC
	CDF 0
	ISZ LOAD
	JMP I LOAD
IOTTST,	0		/TEST FOR ISOLATING I/O
	CLA CLL CML RTR
	TAD INST
	SZL CLA
	ISZ IOTTST
	JMP I IOTTST
	$


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/FPAT.PA. 
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

/FRTS PATCH
/TO FIX LIMITATION INVOLVING 2-PAGE SYSTEM HANDLERS

/16-JAN-78 SR/DS

	TEM=7507
	L7=7541

	FIELD 1

	*2675

	342		/ = "AND (7770)"

	*2742

	7770

	*7526

TDSET,	0		/SUBROUTINE TO RELOCATE ALL CIF/CDF'S
			/TO FIELDS 1-7 IN SYSTEM HANDLER 1ST
			/PAGE 07635 AND ABOVE.
	DCA TEM
	TAD L7635
	DCA P1
	JMP LOOP
L7635,	7635
L1570,	1570
L7710,	7710

	*7546

LOOP,	TAD I P1
	TAD L1570
	CLL
	TAD L7710
	SZL CLA
	JMP NOFIX	/NOT A CIF/CDF TO FIELD>0
	TAD I P1	/OK: RELOCATE FIELD
	AND L7
	TAD TEM		/EITHER UP INITIALLY, OR BACK
			/DOWN FINALLY
	DCA I P1
NOFIX,	ISZ P1		/ON TO NEXT LOCATION
	JMP LOOP
	JMP I TDSET	/DONE
P1,	0		/POINTER TO SYS HANDLER

	*7576

	6220
$

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/FUTIL.LS. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967
5968
5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
6009
6010
6011
6012
6013
6014
6015
6016
6017
6018
6019
6020
6021
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
6061
6062
6063
6064
6065
6066
6067
6068
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
6119
6120
6121
6122
6123
6124
6125
6126
6127
6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
6138
6139
6140
6141
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174
6175
6176
6177
6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
6191
6192
6193
6194
6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205
6206
6207
6208
6209
6210
6211
6212
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262
6263
6264
6265
6266
6267
6268
6269
6270
6271
6272
6273
6274
6275
6276
6277
6278
6279
6280
6281
6282
6283
6284
6285
6286
6287
6288
6289
6290
6291
6292
6293
6294
6295
6296
6297
6298
6299
6300
6301
6302
6303
6304
6305
6306
6307
6308
6309
6310
6311
6312
6313
6314
6315
6316
6317
6318
6319
6320
6321
6322
6323
6324
6325
6326
6327
6328
6329
6330
6331
6332
6333
6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
6353
6354
6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
6383
6384
6385
6386
6387
6388
6389
6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
6504
6505
6506
6507
6508
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521
6522
6523
6524
6525
6526
6527
6528
6529
6530
6531
6532
6533
6534
6535
6536
6537
6538
6539
6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570
6571
6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627
6628
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660
6661
6662
6663
6664
6665
6666
6667
6668
6669
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683
6684
6685
6686
6687
6688
6689
6690
6691
6692
6693
6694
6695
6696
6697
6698
6699
6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762
6763
6764
6765
6766
6767
6768
6769
6770
6771
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784
6785
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
6796
6797
6798
6799
6800
6801
6802
6803
6804
6805
6806
6807
6808
6809
6810
6811
6812
6813
6814
6815
6816
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853
6854
6855
6856
6857
6858
6859
6860
6861
6862
6863
6864
6865
6866
6867
6868
6869
6870
6871
6872
6873
6874
6875
6876
6877
6878
6879
6880
6881
6882
6883
6884
6885
6886
6887
6888
6889
6890
6891
6892
6893
6894
6895
6896
6897
6898
6899
6900
6901
6902
6903
6904
6905
6906
6907
6908
6909
6910
6911
6912
6913
6914
6915
6916
6917
6918
6919
6920
6921
6922
6923
6924
6925
6926
6927
6928
6929
6930
6931
6932
6933
6934
6935
6936
6937
6938
6939
6940
6941
6942
6943
6944
6945
6946
6947
6948
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
6982
6983
6984
6985
6986
6987
6988
6989
6990
6991
6992
6993
6994
6995
6996
6997
6998
6999
7000
7001
7002
7003
7004
7005
7006
7007
7008
7009
7010
7011
7012
7013
7014
7015
7016
7017
7018
7019
7020
7021
7022
7023
7024
7025
7026
7027
7028
7029
7030
7031
7032
7033
7034
7035
7036
7037
7038
7039
7040
7041
7042
7043
7044
7045
7046
7047
7048
7049
7050
7051
7052
7053
7054
7055
7056
7057
7058
7059
7060
7061
7062
7063
7064
7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076
7077
7078
7079
7080
7081
7082
7083
7084
7085
7086
7087
7088
7089
7090
7091
7092
7093
7094
7095
7096
7097
7098
7099
7100
7101
7102
7103
7104
7105
7106
7107
7108
7109
7110
7111
7112
7113
7114
7115
7116
7117
7118
7119
7120
7121
7122
7123
7124
7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
7149
7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167
7168
7169
7170
7171
7172
7173
7174
7175
7176
7177
7178
7179
7180
7181
7182
7183
7184
7185
7186
7187
7188
7189
7190
7191
7192
7193
7194
7195
7196
7197
7198
7199
7200
7201
7202
7203
7204
7205
7206
7207
7208
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
7220
7221
7222
7223
7224
7225
7226
7227
7228
7229
7230
7231
7232
7233
7234
7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248
7249
7250
7251
7252
7253
7254
7255
7256
7257
7258
7259
7260
7261
7262
7263
7264
7265
7266
7267
7268
7269
7270
7271
7272
7273
7274
7275
7276
7277
7278
7279
7280
7281
7282
7283
7284
7285
7286
7287
7288
7289
7290
7291
7292
7293
7294
7295
7296
7297
7298
7299
7300
7301
7302
7303
7304
7305
7306
7307
7308
7309
7310
7311
7312
7313
7314
7315
7316
7317
7318
7319
7320
7321
7322
7323
7324
7325
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341
7342
7343
7344
7345
7346
7347
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375
7376
7377
7378
7379
7380
7381
7382
7383
7384
7385
7386
7387
7388
7389
7390
7391
7392
7393
7394
7395
7396
7397
7398
7399
7400
7401
7402
7403
7404
7405
7406
7407
7408
7409
7410
7411
7412
7413
7414
7415
7416
7417
7418
7419
7420
7421
7422
7423
7424
7425
7426
7427
7428
7429
7430
7431
7432
7433
7434
7435
7436
7437
7438
7439
7440
7441
7442
7443
7444
7445
7446
7447
7448
7449
7450
7451
7452
7453
7454
7455
7456
7457
7458
7459
7460
7461
7462
7463
7464
7465
7466
7467
7468
7469
7470
7471
7472
7473
7474
7475
7476
7477
7478
7479
7480
7481
7482
7483
7484
7485
7486
7487
7488
7489
7490
7491
7492
7493
7494
7495
7496
7497
7498
7499
7500
7501
7502
7503
7504
7505
7506
7507
7508
7509
7510
7511
7512
7513
7514
7515
7516
7517
7518
7519
7520
7521
7522
7523
7524
7525
7526
7527
7528
7529
7530
7531
7532
7533
7534
7535
7536
7537
7538
7539
7540
7541
7542
7543
7544
7545
7546
7547
7548
7549
7550
7551
7552
7553
7554
7555
7556
7557
7558
7559
7560
7561
7562
7563
7564
7565
7566
7567
7568
7569
7570
7571
7572
7573
7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
7585
7586
7587
7588
7589
7590
7591
7592
7593
7594
7595
7596
7597
7598
7599
7600
7601
7602
7603
7604
7605
7606
7607
7608
7609
7610
7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
7627
7628
7629
7630
7631
7632
7633
7634
7635
7636
7637
7638
7639
7640
7641
7642
7643
7644
7645
7646
7647
7648
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
7661
7662
7663
7664
7665
7666
7667
7668
7669
7670
7671
7672
7673
7674
7675
7676
7677
7678
7679
7680
7681
7682
7683
7684
7685
7686
7687
7688
7689
7690
7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
7704
7705
7706
7707
7708
7709
7710
7711
7712
7713
7714
7715
7716
7717
7718
7719
7720
7721
7722
7723
7724
7725
7726
7727
7728
7729
7730
7731
7732
7733
7734
7735
7736
7737
7738
7739
7740
7741
7742
7743
7744
7745
7746
7747
7748
7749
7750
7751
7752
7753
7754
7755
7756
7757
7758
7759
7760
7761
7762
7763
7764
7765
7766
7767
7768
7769
7770
7771
7772
7773
7774
7775
7776
7777
7778
7779
7780
7781
7782
7783
7784
7785
7786
7787
7788
7789
7790
7791
7792
7793
7794
7795
7796
7797
7798
7799
7800
7801
7802
7803
7804
7805
7806
7807
7808
7809
7810
7811
7812
7813
7814
7815
7816
7817
7818
7819
7820
7821
7822
7823
7824
7825
7826
7827
7828
7829
7830
7831
7832
7833
7834
7835
7836
7837
7838
7839
7840
7841
7842
7843
7844
7845
7846
7847
7848
7849
7850
7851
7852
7853
7854
7855
7856
7857
7858
7859
7860
7861
7862
7863
7864
7865
7866
7867
7868
7869
7870
7871
7872
7873
7874
7875
7876
7877
7878
7879
7880
7881
7882
7883
7884
7885
7886
7887
7888
7889
7890
7891
7892
7893
7894
7895
7896
7897
7898
7899
7900
7901
7902
7903
7904
7905
7906
7907
7908
7909
7910
7911
7912
7913
7914
7915
7916
7917
7918
7919
7920
7921
7922
7923
7924
7925
7926

/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 1

             /FUTIL - FILE UTILITY - V08A

             DECIMAL
       0010  VERSION=08
             OCTAL
       0001  PATCH="A&77

             /       OS/8 FILE UTILITY PROGRAM.  ALLOWS EXAMINATION AND
             /  MODIFICATION OF OS/8 MASS STORAGE DEVICES FROM THE CON-
             /  SOLE.  DUMPING OF BLOCKS, LISTING OF WORDS AND MODIFICA-
             /  TION OF WORDS CAN BE DONE IN 7 FORMATS: OCTAL; SIGNED AND
             /  UNSIGNED DECIMAL; UNPACKED, 6-BIT PACKED, XS240 PACKED AND
             /  OS/8 PACKED ASCII.  LISTING AND DUMPING CAN ALSO BE DONE
             /  IN 5 MORE FORMATS: BCD, BYTE (OCTAL CHARACTER), 2 PSEUDO-
             /  SYMBOLIC FORMATS [PDP-8 & FPP-12/8A], AND A COMBINATION
             /  FORMAT FOR DIRECTORY DUMPING. PROGRAM USES BOTH COMMAND
             /  WORDS AND COMMAND CHARACTERS (LIKE ODT) FOR DIRECTION.

             /BY:    JIM CRAPUCHETTES
             /       MENLO COMPUTER ASSOCIATES, INC.
             /       (FORMERLY: FRELAN ASSOCIATES)
             /       P.O. BOX 298
             /       MENLO PARK, CALIF. 94025
             /
             /
             /VERSIONS 1 THRU 4 - "XTAPE" FOR THE XSYSTEM,
             /  LAST REVISION--APRIL 1970.
             /
             /VERSION 5 - OS/8 OPERATION, JULY 1972 THRU JUNE 1976
             /  "(...)", "C & 'CC AS NUMBERS, IOT DECODING, LIST
             /  & DUMP FORMATS, OUTPUT TO LPT:, FILE DATE & LOC
             /  IN DIRECTORY, "WORD MEMREF...", BCD OUTPUT,
             /  ADDITIONAL ODT OUTPUTS, "BYTE" OUTPUT.
             /VERSION 6 - EXPANSION OF OS/8 OPERATION, JUNE 1976:
             /  "FILLER" FOR "MODIFY", SEARCH LIMITS CHANGE, "WRITE"
             /  WITH AN ARGUMENT, FPP INSTRUCTION DECODING, CHAINING
             /  SUPPORT (FOR CCL CALLS), LOAD MODULE HANDLING AND
             /  "SHOW HEADER", MULTIPLE DEFAULT EXTENSIONS, ^R FOR
             /  RETYPE, SET REPLACES OPTION, NEW OUTPUT ROUTINE FOR
             /  "DIRECTORY" FORMAT, LINK OVERLAY HANDLING, ODT CHANGES,
             /  EXIT, SCAN, WRITE LOCKED OPERATION, SPEED UP SEARCHES,
             /  XS240 FORMATS
             /VERSION 6.17 - APR 1, 1977; BATCH OPERATION, COMMENT
             /VERSION 6.20 - MAY 16, 1977; NEW DATE, FULL FILE OUTPUT
             /   (SET/SHOW DDEV, OPEN ..., CLOSE), OPT ":" ON DEVICES.
             /VERSION 6.21 - JUN 4, 1977; NEW INPUT ROUTINE, TEMP STORAGE
             /VERSION 6.22 - JUL 13, 1977; CRTL-Q & -S, SCOPE MODE,
             /  IF/END COMMANDS, ALPHA DATE.
             /
             /PREVIOUS VERSIONS HAVE BEEN AVAILABLE THROUGH DECUS,
             /  DEC SUPPORT BEGINS WITH VERSION 7 - 20-JUL-77.
             /               VERSION 7 PATCHES:
             /               1.CTRL/U CRASH & OVERLAY MAPPING IN SAVE MODE(7A TO 7B)
             /               2.FIXED SHOW CCB PROBLEM(7B TO 7C)
             /               3.ODT MAPPING ON LD. MODULES(7C TO 7D)
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 1-1

             /               4.ADDED SHOW CCB SUPPORT FOR KT8A SAVE IMAGES(7D TO 7E)
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 2

             /       SOME ROUTINES AND IDEAS USED IN THIS PROGRAM WERE
             /  DERIVED FROM EDIT-8 AND FOCAL, BY RICK MERRILL, DEC.
             /       THE ODT COMMAND SET IS NEARLY IDENTICAL TO THE OS/8
             /  ODT COMMAND SET EXCEPT THAT 15 BIT ADDRESSES ARE USED
             /  EVERYWHERE AND THERE ARE NO COMMANDS FOR PROGRAM EXECU-
             /  TION.
             /       THE DOUBLE PRECISION ARITHMETIC ROUTINES ARE A MUCH
             /  MODIFIED VERSION OF DECUS 8-115A.


             /  ASSEMBLY INFORMATION:
             /
             /  .R PAL8      [VERSION 9]
             /  *FUTIL<FUTIL/L/K/P=6400$
             /  .SA ... FUTIL
             /
             /       THE LISTING FILE REQUIRES ABOUT 725 BLOCKS, THE BIN-
             /  ARY FILE ABOUT 35 BLOCKS AND THE CREF LISTING FILE ABOUT
             /  960 BLOCKS.  CREFING REQUIRES EITHER "/M" OR "/X" FOR
             /  CREF V3.


             /MEMORY ALLOCATION:
             /
             /00000-06310    PROGRAM PROPER
             /06310-06577    ARGUMENT STRING BUFFER
             /06400-06777    --- ONCE ONLY CODE FOR CHAIN ---
             /06600-07177    DDEV HANDLER AREA, 2 PAGES
             /07200-07577    DEVICE HANDLER AREA, 2 PAGES
             /
             /10000-11777    USR AREA & ERROR MESSAGES (SWAPPED)
             /12000-12377    CCB/HEADER CODE, OPEN, CLOSE & OUTPUT
             /12600-15700    TEXT STRINGS, LISTS
             /15700-16377    STRING MASK, COMMAND BUFFERS, PDL
             /16400-16577    CCB BUFFER, 1 PAGE
             /16600-17177    DDEV BUFFER, 2 PAGES
             /17200-17577    I/O BUFFER, 2 PAGES
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 3

             /PAGE 0: POINTERS, CONSTANTS, VARIABLES, SWITCHES, ADDRESSES


       0000  *0

00000  0000  OVLFLG, 0       /OVERLAY FLAG FOR SAVE FILES

00001  0000  DPSGN,  0
00002  0000  LASTOP, 0
00003  0000  THISOP, 0

00004  0000  ZBLOCK 3        /USED BY ODT

             /VARIABLES & SWITCHES
00007  0000  PDLPT,  0       /P.D.L. POINTER
00010  4030  DPNT,   RUBO-1  /USED UNIVERSALLY (SCOPE INITIALIZATION)
00011  6627  SPNT,   SCOPLS-1 /USED BY 'XSTRIN', 'XSMASK', 'READ', 'TERMT'
00012  6656  SCANX1, BATLS-1 /USED BY 'SORTJ' (BATCH INITIALIZATION)
00013  0000  SCANX2, 0       /USED BY 'XSTRIN'
00014  0000  GETPNT, 0       /USED BY 'GET' & 'BKLOC'
00015  0000  COMIR,  0       /USED FOR USER LINE INPUT
00016  5712  COMOUT, COMB-1  /USED FOR USER LINE SCAN
00017  0000  TYPSW,  0       /ODT COMMAND OCT-SYM SWITCH (0=OCT)
00020  0000  ERMODE, 0       /ERROR MESSAGE MODE SWITCH (0=LONG)

00021  0000  TEMP,   0
00022  0000  TEMP1,  0
00023  0000  TEMP2,  0
00024  0000  TEMP3,  0
00025  0000  ACC1,   0       /24 BIT ACCUMULATORS
00026  0000  ACC2,   0
00027  0000  ACCX1,  0
00030  0000  ACCX2,  0

       0025  NAM1=   ACC1    /DEFINITIONS FOR NAME BUFFER:
       0026  NAM2=   ACC1+1  /  THESE LOCATIONS ARE USED FOR A
       0027  NAM3=   ACC1+2  /  6 CHARACTER FILE (OR DEVICE)
       0030  NAM4=   ACC1+3  /  NAME & A 2 CHAR EXTENSION.

00031  0000  OPER1,  0
00032  0000  OPER2,  0

00033  0000  TEMPV1, 0       /24 BIT TEMPORARY STORAGE FOR
00034  0000  TEMPV2, 0       / "SET TEMP ..." & "EVAL T"

00035  0000  CHAR,   0
00036  0000  CNT,    0
00037  0000  CNTR,   0
00040  0000  CNTRA,  0
00041  0000  NCNT,   0       /LINE POSITION COUNTER
00042  0000  FCNT,   0       /FORMAT NUMBER (INIT TO PACKED ASCII)
00043  3621  OUTPNT, PACOUT  /POINTER TO DEFAULT OUTPUT ROUTINE
00044  0000  MODSW,  0       /MODES: NORMAL=0,MAPPED=+,OFFSET=-.
00045  0000  CHARSW, 0       /CHARACTER PACK & UNPACK SWITCH
00046  0000  CRSWT,  0       /= -1 IF GWORD TERMINATOR WAS A SPACE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 3-1

00047  0000  SHUT,   0       /= -1 IF SOMETHING OPEN
00050  0000  MODIF,  0       /= -1 IF SOMETHING WAS MODIFIED
00051  0000  ABSSW,  0       /ABSOLUTE OR RELATIVE LOCATION FOR SEARCHES
00052  0000  DSWIT,  0       /DUMP SWITCH: "DUMP","LIST" & "SHOW ERR" -> 1
00053  0000  DMODE,  0       /DUMP MODE: NONE=0,PART=1,ALL=4000

00054  0000  CBLK,   0       /= CURRENT BLOCK
00055  0000          0       /DUMMY FOR "SHOW ABS"
00056  0000  CAD,    0       /= CURRENT ADDRESS (0 -> 377)+IOBUF
00057  0000  BLK,    0       /= "BLOCK"
00060  0000  LOCH,   0
00061  0000  LOCL,   0       /= "LOCATION" (DISPLACEMENT)
00062  0000  UBLK,   0       /UPPER LIMIT FOR SEARCHES
00063  0001  ULOCH,  1
00064  7577  ULOCL,  7577
00065  0000  LBLK,   0       /LOWER LIMIT FOR SEARCHES
00066  0000  LLOCH,  0
00067  0200  LLOCL,  200
00070  0000  SBLK,   0       /"LOCATION" FOR "ODT" ROUTINES
00071  0000  SLOCH,  0
00072  0000  SLOCL,  0

00073  0000  OFFSET, 0       /OFFSET
00074  0000  FILLER, 0       /FILLER CONSTANT FOR "MODIFY"
00075  7777  MASK,   -1      /MASK FOR WORD SEARCH
00076  7777  SMASKL, -1      /= -(LENGTH OF SMASK)
00077  0000  RBLK1,  0       /START BLOCK OF FILE
00100  7607  DEVAD,  7607    /DEVICE ENTRY ADDR (INIT TO "SYS")
00101  0001  DEVNO,  1       /DEVICE NUMBER (INIT TO "SYS")
00102  7700  USRAD,  7700    /USR ADDRESS, INITIALIZED TO OUT
                             /7700=MSGS IN; 0=NONE IN; 200=USR IN

             /CONSTANTS
00103  7400  M400,   -400
00104  7540  M240,   -240
00105  7563  M215,   -215
00106  7600  M200,   -200
00107  7700  M100,   -100
00110  7760  M20,    -20
00111  7770  M10,    -10
00112  7777  M1,     -1
00113  0007  N7,     7
00114  0015  N15,    15
00115  0020  N20,    20
00116  0077  N77,    77
00117  0177  N177,   177
00120  0200  N200,   200
00121  0377  N377,   377
00122  7000  N7000,  7000
       0103  N7400=  M400

             /ADDRESSES
       4523  READLN= JMS I .         /GET NEXT INPUT LINE, WITH
00123  4000          READ            / SPECIAL TERMINATORS
00124  3605  TYPSTI, TYPSTR
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 3-2

00125  3600  TYPSI,  TYPES
00126  5054  TYPECI, TYPEC
00127  1761  TWOCI,  TWOCS
00130  5044  CRLFI,  CRLF
       4531  DIGIT=  JMS I .         /OUTPUT AN ASCII DIGIT
00131  4161          DODIG
       4532  SPACE1= JMS I .         /OUTPUT 1 SPACE OR ...
00132  2561          DO1SP
       4533  SPACE2= JMS I .         /OUTPUT 2 SPACES
00133  2565          DO2SP
00134  5125  CTRLI,  CTRL
00135  3621  TWOT,   PACOUT
00136  5061  TYPEI,  TYPE
00137  3436  DECI,   DPRT
00140  3400  OCTI,   OPRT
00141  3445  DEC2I,  DEC2
00142  5000  PDATEI, PDATE
00143  3762  RTL6I,  RTL6
00144  3767  RTR6I,  RTR6
00145  5261  SOCTI,  OCTSET
00146  3105  BKLOCI, BKLOC
00147  5400  EVALI,  EVAL

       4550  PUSH=   JMS I .         /PUSH AC ON P.D.L.
00150  5600          PUSHX
       4551  POP=    JMS I .         /POP P.D.L. INTO AC
00151  5606          POPX
       4552  CALUSR= JMS I .         /DO USR FUNCTION
00152  0520          USEUSR
       4553  TADIDP= JMS I .         /"TAD I DPNT" IN FIELD 1
00153  2156          TIDPNT
       4554  TADICAD=  JMS I .       /"TAD I CAD" IN FIELD 1
00154  6170          TICAD
       4555  DCAICAD=  JMS I .       /"DCA I CAD" IN FIELD 1
00155  6163          DICAD

00156  3122  GWORDI, GWORD
00157  5272  GARGI,  GARGS
00160  5713  ARGI,   ARG
00161  3000  GETI,   GET
00162  3073  ODGETI, ODGET
00163  5362  GETNI,  GETN
00164  3502  SSKIPI, SSKIP
00165  2752  LIMITI, LIMITS
00166  3557  INCI,   INC
00167  3643  SORTI,  SORTJ
00170  4141  ENDCI,  ENDC
00171  0203  RECRLF, MAIN1-1
00172  0204  RESTAR, MAIN1

       4573  ERROR=  JMS I .
00173  0454          XERROR

00174  5712  COMST,  COMB-1
00175  6305  TEMPST, TEMPL-1
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 3-3

00176  5610  MASKBS, SMASKB-1


       0200  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 4

             /PROGRAM MAIN LOOP AND DRIVER.  COLLECTS CHARACTERS
             /INTO COMMAND BUFFER UNTIL END IS REACHED.

00200  3102          DCA USRAD       /CLEAR ON RESTART (NOTHING IN)!
00201  6046          TLS             /RAISE TELETYPE FLAG
00202  3047          DCA SHUT        /NOTHING IS OPEN
00203  4530          JMS I CRLFI     /OUTPUT CR-LF.
00204  4545  MAIN1,  JMS I SOCTI     /SET INPUT TO OCTAL; EXEC 'COMMENT'
00205  3052          DCA DSWIT       /RESET DUMP OUTPUT SWITCH
00206  1174          TAD COMST       /INIT COMMAND BUFFER.
00207  3015          DCA COMIR
00210  1377          TAD (PDLB+1     /INIT PUSH-DOWN-LIST
00211  3007          DCA PDLPT
00212  4523  MAIN2,  READLN          /GET A LINE FROM INPUT.
00213  4472            CCHARL-1      /CR LF ; ! / ALT-
00214  0050            COPSL-CCHARL  / MODES ETC...
00215  5204          JMP MAIN1       /BUFFER WAS EMPTIED.


             /ROUTINE TO HANDLE CARRIAGE RETURN.
00216  4570  CRCR,   JMS I ENDCI     /PUT A CR IN BUFFER
00217  5235            JMP CRCRC     /ONLY A CR IN BUFFER
00220  4556          JMS I GWORDI    /GET COMMAND WORD
00221  5234            JMP CRCRN     /BUFFER BEGINS WITH A #
00222  2046          ISZ CRSWT       /WORD ENDED BY A CR?
00223  5230          JMP CRCR1       /YES, ONLY A FEW ARE OK
00224  4567          JMS I SORTI     /NO, LOOK UP COMMAND
00225  4602            CWORDL-1
00226  0031            WOPSL-CWORDL
00227  4573  ERCB,   ERROR           /NOT A LEGAL COMMAND
             /
00230  4567  CRCR1,  JMS I SORTI     /"WRITE","REWIND","EXIT" & "COMMENT"
00231  4663            CWORL2-1
00232  0010            WOPSLL-CWORL2
00233  4573  ERCA,   ERROR           /SOMETHING NOT LEGAL
             /
00234  4361  CRCRN,  JMS CLOSE       /CLOSE THE OPEN LOCATION IF OPEN
00235  3047  CRCRC,  DCA SHUT        / MARK LOCATION CLOSED
00236  5204          JMP MAIN1

             /ROUTINE TO HANDLE SLASH
00237  4570  SLASH,  JMS I ENDCI     /END BUFFER WITH A CR
00240  5244            JMP SLA1      /OPEN LAST, CR ONLY
00241  4776'         JMS WCHEK       /DOES LINE START W. A WORD?
00242  4565          JMS I LIMITI    /NO, GET ARG--
00243  0070            SBLK          / & SLOCH & SLOCL
00244  4532  SLA1,   SPACE1          /OUTPUT SPACE
00245  4775' SLO1,   JMS ODTOUT      /GET THE WORD & OUTPUT
00246  4532  SLO2,   SPACE1          /FOLLOWED BY 2 SPACES
00247  4532          SPACE1          /(FOR ";"--OUTPUT ONLY 1 SPACE AND
00250  4562          JMS I ODGETI    / THEN FORCE ACTION & IGNORE VALUE)
00251  7240          STA
00252  5235          JMP CRCRC       /GO MARK LOCATION OPEN

             /ROUTINE TO HANDLE ALT MODE & ESCAPE KEYS
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 4-1

00253  1043  ALTMOD, TAD OUTPNT      /USE OUTPUT ROUTINE 'SET' BY
00254  5261          JMP ALTM1       / 'FORMAT' OPTION.

             /ROUTINE TO CLOSE A LOCATION, OUTPUT ITS (NEW) CONTENTS IN A
             /  SPECIFIED FORMAT AND THEN RE-OPEN.  THE ROUTINE HANDLES:
             /  # (BCD), $ (OS/8 ASCII), % (BYTE OCTAL), & (XS240 ASCII),
             /  : (SIGNED DECIMAL), < (OCTAL), = (UNSIGNED DECIMAL),
             /  > (PDP SYMBOLIC), @ (DATE), [ (ASCII), \ (FPP SYMBOLIC),
             /  ] (PACKED ASCII) AND ? (DIRECTORY).
             /
00255  1012  OMODES, TAD SCANX1      /'SORTJ' POINTER TO CHAR LIST
00256  1374          TAD (OTABLE-1-CCHARL
00257  3010          DCA DPNT        /POINT INTO ADDR TABLE,
00260  4553          TADIDP          / GET OUTPUT ROUTINE ADDR,
00261  3270  ALTM1,  DCA OMODPT      / & SET POINTER TO ROUTINE.
00262  4353          JMS ECLOSE      /CLOSE THIS LOCATION
00263  4532          SPACE1          /OUTPUT SPACE
00264  3045          DCA CHARSW      /RESET UNPACK SWITCH
00265  4562          JMS I ODGETI    /GET WORD
00266  4670          JMS I OMODPT    /OUTPUT IN DESIRED FORMAT
00267  5246          JMP SLO2        /AND GO REOPEN.
00270  0000  OMODPT, 0

             /ROUTINE TO HANDLE BACKARROW.
00271  4353  BACKAR, JMS ECLOSE      /CLOSE THIS LOCATION
00272  4554          TADICAD         /GET THE CONTENTS,
00273  5306          JMP UPARR1      /AND USE THEM AS THE ADDR

             /ROUTINE TO HANDLE UPARROW.
00274  4353  UPARR,  JMS ECLOSE      /CLOSE THIS LOCATION
00275  4554          TADICAD         /IS THIS A 'PAGE 0' REF.?
00276  0120          AND N200
00277  7640          SZA CLA
00300  1072          TAD SLOCL       /YES, USE PAGE BITS
00301  0106          AND M200        / MASK PAGE OR 0 TO PAGE #
00302  3072          DCA SLOCL       / & SAVE IT
00303  4554          TADICAD         /GET THE CONTENTS,
00304  0117          AND N177        /AND USE THE ADDRESS BITS.
00305  1072          TAD SLOCL       / ALONG WITH PAGE BITS
00306  3072  UPARR1, DCA SLOCL       /THIS IS 12 BIT ADDR
00307  5336          JMP EXCL2       /NOW GO FINISH
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 5

             /ROUTINE TO HANDLE SEMICOLON, LINE FEED & EXCLAMATION.

00310  3536  SEMIC,  DCA I TYPEI     /SET NO-OUTPUT SWITCH-V7B
00311  7240  LFLF,   STA             /LINE-FEED - CLOSE,INCREMENT,OUTPUT
00312  3270  EXCL,   DCA OMODPT      /EXCLAMATION - CLOSE,DECREMENT,OUTPUT
00313  4353          JMS ECLOSE      /CLOSE THIS LOCATION
00314  7001          IAC
00315  3025          DCA ACC1        /SET UP D.P. INCREMENT
00316  3026          DCA ACC2
00317  3001  EXCL1,  DCA DPSGN       /(FOR SAFETY)
00320  2270          ISZ OMODPT      /INCREMENT OR DECREMENT?
00321  4773'         JMS DPNEG       / DECREMENT, NEGATE VALUE
00322  7100          CLL
00323  1025          TAD ACC1
00324  1072          TAD SLOCL       /UPDATE LOCATION TO 15 BITS
00325  3072          DCA SLOCL
00326  7004          RAL
00327  1026          TAD ACC2
00330  1071          TAD SLOCH
00331  0113          AND N7          / (BUT ONLY 15 BITS)
00332  3071          DCA SLOCH
00333  1536          TAD I TYPEI     / ANY OUTPUT?-V7B
00334  7650          SNA CLA
00335  5247          JMP SLO2+1      /  NO, WAS ";" DO ONE SPACE
00336  4530  EXCL2,  JMS I CRLFI     /GIVE CR/LF FOR NEXT LINE
00337  4546          JMS I BKLOCI    /OUTPUT ADDRESS
00340  0067            SBLK-1
00341  4527          JMS I TWOCI     /OUTPUT "\ "
00342  3440            3440
00343  5245          JMP SLO1        /NOW GO OPEN NEXT LOCATION

             /ROUTINE TO HANDLE PLUS & MINUS.
00344  7240  PLUS,   STA             /"+", SET SWITCH
00345  3270  MINUS,  DCA OMODPT      /"-", CLEAR SWITCH
00346  4570          JMS I ENDCI     /END BUFFER, TEST
00347  5336            JMP EXCL2     /NO ARG, DO SAME AGAIN
00350  4776'         JMS WCHEK       /LINE START WITH A COMMAND?
00351  4560          JMS I ARGI      /NO, GET AN ARG
00352  5317          JMP EXCL1       /UPDATE LOC & GO OPEN


00353  0000  ECLOSE, 0       /SUB. TO CLOSE THE LOCATION IF ARG.
00354  4570          JMS I ENDCI     /END BUFFER WITH A CR.
00355  5753            JMP I ECLOSE  /ONLY A CR IN BUFFER, DONE
00356  4776'         JMS WCHEK       /DOES LINE START W. A WORD?
00357  4361          JMS CLOSE       /ARG IN BUFFER, USE IT
00360  5753          JMP I ECLOSE    /DONE

00361  0000  CLOSE,  0       /SUBROUTINE TO CLOSE A LOCATION
00362  4560          JMS I ARGI      /GET ONE ARG
00363  2047          ISZ SHUT        /ANYTHING OPEN?
00364  5761          JMP I CLOSE     /NO, RETURN
00365  4562          JMS I ODGETI    /YES, SET UP THINGS RIGHT
00366  7240          STA
00367  3050          DCA MODIF       /SET MODIFY FLAG
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 5-1

00370  1025          TAD ACC1        /USE "LOC" AS DATA
00371  4555          DCAICAD         /STORE IT
00372  5761          JMP I CLOSE


00373  6141
00374  0032
00375  4200
00376  6200
00377  6130
       0400  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 6

             /ROUTINE TO 'EVALUATE' A SIGNED DOUBLE PRECISION ARITHMETIC
             /  EXPRESSION & OUTPUT THE RESULTS IN OCTAL & D.P. SIGNED
             /  DECIMAL.
00400  4547  XVAL,   JMS I EVALI     /GO EVALUATE
00401  7410          SKP             /TERMINATED BY A CR
00402  4573  ERCC,   ERROR           / SORRY!--TOO MANY ")"S
00403  4527          JMS I TWOCI     /"= "
00404  7540            7540
00405  1026          TAD ACC2
00406  4540          JMS I OCTI      /OUTPUT HIGH ORDER IN OCTAL
00407  1025          TAD ACC1
00410  4540          JMS I OCTI      /OUTPUT LOW ORDER IN OCTAL
00411  1027          TAD ACCX1       /SAVE REMAINDER FOR LATER
00412  3015          DCA COMIR
00413  1030          TAD ACCX2
00414  3016          DCA COMOUT
00415  1377          TAD (-7
00416  3254          DCA XERROR      /MUST DEVELOP 7 DIGITS
00417  4527          JMS I TWOCI     /OUTPUT " ("
00420  4050            4050
00421  1026          TAD ACC2        /IS DPAC NEG?
00422  7700          SMA CLA
00423  5226          JMP DLOOP1-1    /NO, OUTPUT " "
00424  4776'         JMS DPNEG       /YES, MAKE IT POSITIVE
00425  1114          TAD N15         / AND OUTPUT "-".
00426  4532          SPACE1
00427  1375  DLOOP1, TAD (12         /RESET DIVISOR TO 10(10)
00430  3031          DCA OPER1
00431  3032          DCA OPER2
00432  4774'         JMS DDIV        /GO DIVIDE DPAC BY 10(10)
00433  1027          TAD ACCX1       / GET REMAINDER
00434  4550          PUSH            /PUT IT ON PUSH-DOWN-LIST
00435  2254          ISZ XERROR      /DONE YET?
00436  5227          JMP DLOOP1
00437  1016          TAD COMOUT      /YES, RESTORE REMAINDER
00440  3030          DCA ACCX2
00441  1015          TAD COMIR
00442  3027          DCA ACCX1
00443  1377          TAD (-7
00444  3254          DCA XERROR      /NOW SET UP TO OUTPUT 7 DIGITS
00445  4551  DLOOP2, POP             / IN REVERSE ORDER!
00446  4531          DIGIT           /MAKE REMAIN A DIGIT
00447  2254          ISZ XERROR      /DONE?
00450  5245          JMP DLOOP2
00451  4526          JMS I TYPECI    /YES, OUTPUT ")"
00452  0251            ")
00453  5571          JMP I RECRLF    / AND CR/LF


             /ERROR ROUTINE
00454  0000  XERROR, 0
00455  7200          CLA             /CLEAR POSSIBLE JUNK FROM AC
00456  3052          DCA DSWIT       /RESET IN CASE DUMP MODE
00457  6201          CDF 0
00460  4526          JMS I TYPECI    /OUTPUT "?"
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 6-1

00461  0277            "?
00462  1373          TAD (ERLIST-1   /INIT LIST POINTER
00463  3010          DCA DPNT
00464  3021          DCA TEMP        /SET CODE TO 0
00465  2021  XERR1,  ISZ TEMP        /BUMP ERROR CODE
00466  4553          TADIDP          /GET AN ADDRESS
00467  7450          SNA
00470  5275          JMP XERR2       /(FOR DEBUGGING)
00471  7040          CMA             /= -(ADDR+1)
00472  1254          TAD XERROR      /DOES IT MATCH THE CALL?
00473  7640          SZA CLA
00474  5265          JMP XERR1       /NO
00475  1021  XERR2,  TAD TEMP        /YES, OUTPUT ERROR CODE
00476  4541          JMS I DEC2I     /  AS 2 DECIMAL DIGITS
00477  4525          JMS I TYPSI     /NOW OUTPUT " AT "
00500  4310            MS17
00501  1372          TAD (-COMB+1    /CALCULATE POSITION IN
00502  1016          TAD COMOUT      / COMMAND BUFFER,
00503  4541          JMS I DEC2I     / & OUTPUT AS 2 DIGITS.
00504  1020          TAD ERMODE      /LONG/SHORT MESSAGES? [NOTE: THIS ->
00505  7640  XERR3,  SZA CLA         / "7600" (A CLA) IF 'USROUT' ERROR!]
00506  5315          JMP XERR4       /SHORT, GO DO CR/LF
00507  4344          JMS USROUT      /LONG, BE SURE MESSAGES ARE IN
00510  4533          SPACE2          /OUTPUT 2 SPACES
00511  1021          TAD TEMP        /CODE = ADDRESS-1 OF ADDRESS
00512  3010          DCA DPNT        / OF MESSAGE
00513  4553          TADIDP          /GET MESSAGE ADDR
00514  4524          JMS I TYPSTI    / OUTPUT MESSAGE
00515  4530  XERR4,  JMS I CRLFI     /OUTPUT A CR,LF PAIR
00516  5717          JMP I .+1       /***    CIF BAT         /BATCH OPER.
00517  0204            MAIN1         /***    JMP I N7000     /'BATABT'!


00520  0000  USEUSR, 0       /USR CALLER SUBROUTINE (FROM EITHER FIELD!)
00521  3344          DCA USRSAV      /SAVE CONTENTS OF AC
00522  6214          RDF
00523  1325          TAD UCDF0       /SET UP RETURN FIELD (FOR 2ND USR CALL)
00524  3341          DCA USRCDF
00525  6201  UCDF0,  CDF 0           /SET TO HERE FOR 1ST CALL
00526  1102          TAD USRAD       /IS USR IN OR OUT?
00527  7740          SMA SZA CLA
00530  5336          JMP USRIN       /IN, GO TO IT
00531  6212          CIF 10
00532  4507          JMS I M100      /OUT, DO "USRIN" FUNCTION
00533  0010            10
00534  1120          TAD N200
00535  3102          DCA USRAD       / & SO INDICATE
00536  6213  USRIN,  CDF CIF 10
00537  1320          TAD USEUSR      /MOVE RETURN ADDRESS TO THE
00540  3520          DCA I N200      / USR ENTRY POINT
00541  6201  USRCDF, CDF             /SET UP D.F. FOR RETURN
00542  1344          TAD USRSAV      /RESTORE AC CONTENTS
00543  5771          JMP I (201      / & FAKE A CALL TO IT
             USRSAV,

/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 6-2

00544  0000  USROUT, 0       /SUBROUTINE TO REMOVE USR BY RECALLING
00545  1102  ERC15,  TAD USRAD       / ERROR MESSAGES FROM SCRATCH
00546  7710          SPA CLA         / BLOCKS ON SYS.
00547  5744          JMP I USROUT    /JUST EXIT IF PRESENT...
00550  1107          TAD M100
00551  3102          DCA USRAD       /SET USR TO "OUT"
00552  4770          JMS I (7607     /READ IN THE MESSAGES
00553  0610            610           / 6 PAGES TO FIELD 1
00554  0000            0             / STARTING AT LOC 10000
00555  0027            27            / FROM SCRATCH BLKS
00556  7610            SKP CLA       /!!! ERROR !!!
00557  5744          JMP I USROUT    /OK, JUST EXIT
00560  1106          TAD M200
00561  3305          DCA XERR3       /NO MORE MESSAGES ON ERROR!
00562  1364          TAD ERC16
00563  3345          DCA ERC15       /AND NO MORE "SHOW ERROR"!
00564  4573  ERC16,  ERROR           /TELL THE HORRIBLE STORY!


00570  7607
00571  0201
00572  2066
00573  5530
00574  6040
00575  0012
00576  6141
00577  7771
       0600  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 7

             /ROUTINE TO EXECUTE THE BLOCK 'SCAN' COMMAND
00600  4557  XSCAN,  JMS I GARGI     /GET ARGS CONVERTED
00601  1377          TAD (SCANER     / & SET UP FOR SCANNING
00602  5210          JMP XDUM0

             /ROUTINE TO EXECUTE THE BLOCK 'DUMP' COMMAND
00603  1044  XDUMP,  TAD MODSW       /MAPPED MODE?
00604  7740          SMA SZA CLA
00605  4573  ERC14,  ERROR           /YES, DUMP IS MEANINGLESS!
00606  4247          JMS XDLCOM      /DO COMMON STUFF
00607  1376          TAD (LLIST      / & SET UP FOR DUMPING
00610  3327  XDUM0,  DCA XGFORM      /SET OUTPUT ROUTINE--DUMP/SCAN
00611  2010  XDUM1,  ISZ DPNT        /SKIP FIRST WORD
00612  2010          ISZ DPNT        /SKIP A WORD
00613  1410          TAD I DPNT      /GET NEXT START BLOCK.
00614  4775'         JMS BLKTST
00615  1410          TAD I DPNT      /GET NEXT -(# BLOCKS)
00616  3022          DCA TEMP1
00617  4534  XDUM2,  JMS I CTRLI     /TEST HERE FOR 'SCAN' TERMINATE
00620  3061          DCA LOCL        /SET LOC TO 0
00621  3060          DCA LOCH
00622  1103          TAD M400        /SET TO -400(8) [1 BLOCK]
00623  4727          JMS I XGFORM    /DUMP OR SCAN A BLOCK
00624  2057          ISZ BLK         /INCREMENT BLOCK NUMBER
00625  2022          ISZ TEMP1       /DONE?
00626  5217          JMP XDUM2       /NO, DO NEXT BLOCK
00627  2021          ISZ TEMP        /YES, ARE ALL ARGS DONE?
00630  5211          JMP XDUM1       /NO, DO NEXT
00631  5245          JMP XLIS2       /YES, DONE--RESET SWITCH

             /ROUTINE TO EXECUTE THE LOCATION 'LIST' COMMAND
00632  4247  XLIST0, JMS XDLCOM      /DO COMMON STUFF
00633  1410  XLIS1,  TAD I DPNT      /GET BLOCK #
00634  4775'         JMS BLKTST      /TEST & SET BLK
00635  1410          TAD I DPNT      /GET & SET LOCATION
00636  3060          DCA LOCH
00637  1410          TAD I DPNT
00640  3061          DCA LOCL
00641  1410          TAD I DPNT      /GET -(# WORDS)
00642  4261          JMS LLIST       /NOW GO DO IT
00643  2021          ISZ TEMP        /ARE ALL ARGS USED?
00644  5233          JMP XLIS1       /NO, CONTINUE
00645  3052  XLIS2,  DCA DSWIT       /RESET DUMP SWITCH
00646  5571          JMP I RECRLF    / DO CR/LF & CONTINUE

             /COMMON SUBROUTINE FOR 'XDUMP'&'XLIST0'
00647  0000  XDLCOM, 0
00650  1043          TAD OUTPNT      /INITIALIZE DEFAULTS
00651  3325          DCA LISTPT
00652  1365          TAD OUTSW
00653  3326          DCA LOUTSW
00654  4327          JMS XGFORM      /GET FORMAT, IF ANY
00655  7000          NOP             /RETURN FOR NO FORMAT
00656  4557          JMS I GARGI     /GET ARGS
00657  2052          ISZ DSWIT       /SET DUMP SWITCH
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 7-1

00660  5647          JMP I XDLCOM

             /SUBROUTINE TO OUTPUT -[C(AC)] WORDS FROM THE DEVICE
             /BEGINNING AT BLK.LOC IN THE SPECIFIED FORMAT
00661  0000  LLIST,  0
00662  3040          DCA CNTRA       /SET UP -# WORDS TO LIST
00663  3045          DCA CHARSW      /RESET UNPACK SWITCH
00664  4530  LLIS1,  JMS I CRLFI
00665  1061          TAD LOCL
00666  0113          AND N7          /SET UP # ON THIS LINE
00667  3037          DCA CNTR
00670  1326          TAD LOUTSW      /IF CHARACTER OUTPUT,
00671  7650          SNA CLA
00672  1111          TAD M10         / DOUBLE # WORDS/LINE
00673  1037          TAD CNTR
00674  1111          TAD M10
00675  3037          DCA CNTR
00676  4546          JMS I BKLOCI    /OUTPUT LOCATION
00677  0056            BLK-1
00700  4525          JMS I TYPSI     /OUTPUT ":   "
00701  4264            MS13
00702  4561  LLIS2,  JMS I GETI      /GET A WORD
00703  5312            JMP LLIS3     /FILE MODE, NO SUCH ADDR..
00704  4725          JMS I LISTPT    /OUTPUT IT
00705  1326          TAD LOUTSW      /TEST MODE SWITCH
00706  7510          SPA
00707  5322          JMP LLIS5       /"SYMBOLIC", CR/LF NOW
00710  7640          SZA CLA         /CHARACTERS, NO SPACES
00711  4533          SPACE2          /NUMBERS, TWO SPACES
00712  4566  LLIS3,  JMS I INCI      /INCREMENT LOC
00713  2040          ISZ CNTRA       /ALL WORDS DONE?
00714  5317          JMP LLIS4       /NO
00715  4530          JMS I CRLFI
00716  5661          JMP I LLIST     /YES, RETURN
             /
00717  2037  LLIS4,  ISZ CNTR        /ALL DONE WITH THIS LINE?
00720  5302          JMP LLIS2       /NOT YET
00721  5264          JMP LLIS1       /YES, OUTPUT CR/LF & CONTINUE
             /
00722  7240  LLIS5,  STA
00723  3037          DCA CNTR        /FORCE A CR/LF
00724  5312          JMP LLIS3
00725  0000  LISTPT, 0
00726  0000  LOUTSW, 0


             /SUBROUTINE TO GET A FORMAT FOR 'XFORM' & 'XDLCOM'
00727  0000  XGFORM, 0
00730  4556          JMS I GWORDI    /GET A WORD
00731  5727            JMP I XGFORM  /NOT FOLLOWED BY A WORD
00732  4567          JMS I SORTI     /LOOK UP WORD
00733  4702            FORML-1
00734  0031            FOPSL-FORML
00735  4573  ERCD,   ERROR           /WORD NOT RECOGNIZED
             /
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 7-2

00736  7130  XFSYM,  STL RAR         /"SYMBOLIC"; SWITCH NEG
00737  7001  XFNUM,  IAC             /NUMERIC; SWITCH POS
00740  3326  XFCHR,  DCA LOUTSW      /CHARACTER; SWITCH 0
00741  1012          TAD SCANX1      /'SORTJ' POINTER TO CHAR
00742  1374          TAD (-FORML     /CALCULATE FORMAT #
00743  7110          CLL RAR         /(DIVIDE BY 2)
00744  3022          DCA TEMP1       / & SAVE IT.
00745  1022          TAD TEMP1
00746  1373          TAD (FTABLE-1
00747  3010          DCA DPNT
00750  4553          TADIDP
00751  3325          DCA LISTPT      /SET UP OUTPUT POINTER
00752  2327          ISZ XGFORM      /BUMP RETURN ADDRESS
00753  5727          JMP I XGFORM

             /ROUTINE TO 'SET' THE 'FORMAT' OPTION
00754  4327  XFORM,  JMS XGFORM      /GET FORMAT WORD
00755  4573  ERCE,   ERROR           /NUMBER?!  SORRY ABOUT THAT!
00756  1326          TAD LOUTSW      /OK, SET UP DEFAULTS:
00757  3365          DCA OUTSW       /  SWITCH,
00760  1325          TAD LISTPT
00761  3043          DCA OUTPNT      /  ROUTINE POINTER,
00762  1022          TAD TEMP1
00763  3042          DCA FCNT        /  & FORMAT #
00764  5772'         JMP XSETN
00765  0000  OUTSW,  0       /MODE:0=NOTHING,+=SPACES,-=CR/LF


00772  1600
00773  4763
00774  3075
00775  6154
00776  0661
00777  5744
       1000  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 8

             /ROUTINE TO EXECUTE THE 'OPEN' COMMAND.
01000  7240  XOPEN,  STA             /"." LEGAL IN FILE NAME
01001  4777'         JMS GNAME       /GET FILE NAME FOR OUTPUT
01002  6212          CIF 10
01003  5776'         JMP XOPEN1      /NOW GO TO FIELD 1 TO HANDLE


             /ROUTINE TO EXECUTE THE 'CLOSE' COMMAND.
01004  6213  XCLOSE, CDF CIF 10
01005  5775'         JMP XCLOS1      /ALL CODE IS IN FIELD 1


             /ROUTINE TO EXECUTE THE 'FILE' COMMAND.
01006  1022  XFIERR, TAD TEMP1       /MADE ALL POSSIBLE ATTEMPTS
01007  7700          SMA CLA         / AT EXTENSION RETRIES?
01010  5216          JMP XFIOUT      / YES, ALL TRIES DONE!
01011  2001          ISZ DPSGN       /THIS WILL SKIP ON 1ST FAIL
01012  2022          ISZ TEMP1       /THIS WILL SKIP ON 2ND FAIL
01013  1374          TAD (1404       / 2ND TRY--USE "LD" EXTEN
01014  3030          DCA NAM4        / 3RD TRY--USE NULL EXTEN
01015  5230          JMP XFICHN+2    /  3RD TRY IS FINAL FAILURE
             /
01016  4773' XFIOUT, JMS PNAME       /OUTPUT FILE NAME &
01017  4525          JMS I TYPSI     /"LOOKUP FAILED"
01020  4277            MS15
             /
01021  4530  XFILEN, JMS I CRLFI     /OUTPUT CR/LF
01022  2046          ISZ CRSWT       /WAS LAST ENDED BY A CR?
01023  5572          JMP I RESTAR    /YES, DONE
01024  7240  XFILE,  STA             /"." LEGAL IN FILE NAME
01025  4777'         JMS GNAME       /GET NEXT FILE NAME
01026  7240  XFICHN, STA
01027  3001          DCA DPSGN       /SET TRY AGAIN SWITCH
01030  1372          TAD (NAM1       /INIT POINTER TO NAME
01031  3235          DCA FSTBLK
01032  1101          TAD DEVNO       /GET DEVICE #
01033  4552          CALUSR
01034  0002            2             /LOOKUP
01035  0000  FSTBLK,   0     /NAME PNTR, BECOMES ST BLK
01036  0000  FBKLEN,   0     / BECOMES -(FILE LENGTH)
01037  5206          JMP XFIERR      /LOOKUP FAILED
01040  1235          TAD FSTBLK
01041  3077          DCA RBLK1       /SET UP PAGE 0 ST BLK
01042  6211          CDF 10
01043  3771          DCA I (CCBB     / & RESET CCBB
01044  1774          TAD I (1404     /GET # ADD'L INFO WORDS
01045  3354          DCA GDEV2       / (NEGATIVE) & SAVE IT
01046  1354          TAD GDEV2
01047  1770          TAD I (17       /POINT TO FIRST OF THEM
01050  3355          DCA GDEV3       / (THE DATE, IF PRESENT)
01051  1513          TAD I N7        /GET THE NUMBER OF THE
01052  0113          AND N7          / DIRECTORY SEGMENT IN
01053  3037          DCA CNTR        / CORE & SAVE IT.
01054  1354          TAD GDEV2       /WAS # OF ADD'L WRDS = 0?
01055  7640          SZA CLA
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 8-1

01056  1755          TAD I GDEV3     / NO, GET THE DATE WORD
01057  6201          CDF 0
01060  3353          DCA GDEV1       /STORE DATE OR 0 (NO DATE)
01061  4773'         JMS PNAME       /OUTPUT FILE NAME
01062  1235          TAD FSTBLK
01063  4540          JMS I OCTI      /OUTPUT ST. BLK. IN OCTAL
01064  4526          JMS I TYPECI
01065  0255            "-
01066  1236          TAD FBKLEN      /CALCULATE LAST BLK #
01067  7040          CMA
01070  1235          TAD FSTBLK
01071  4540          JMS I OCTI      / & OUTPUT IN OCTAL
01072  4533          SPACE2          /OUTPUT 2 SPACES
01073  1236          TAD FBKLEN
01074  7041          CIA
01075  4540          JMS I OCTI      /OUTPUT LENGTH IN OCTAL
01076  4527          JMS I TWOCI     /" ("
01077  4050            4050
01100  1236          TAD FBKLEN
01101  7041          CIA
01102  4537          JMS I DECI      / & AGAIN IN DECIMAL
01103  4525          JMS I TYPSI     /")  "
01104  4403            MS33
01105  1037          TAD CNTR        /GET SEGMENT #
01106  4543          JMS I RTL6I     / & PUT IN BITS 3-5
01107  4527          JMS I TWOCI     / TO OUTPUT IT & "."
01110  6056            6056
01111  1355          TAD GDEV3       /GET ADDR OF 1ST ADD'L WRD
01112  1367          TAD (-1400-4    / FOR OFFSET OF NAME START
01113  4766'         JMS OCT3        /OUTPUT LOCATION IN SEG
01114  4533          SPACE2          / & TWO SPACES
01115  1353          TAD GDEV1       /GET DATE WORD
01116  7440          SZA             /IS IT = 0?
01117  4542          JMS I PDATEI    /NO, OUTPUT DATE
01120  5221          JMP XFILEN      /NOW OUTPUT CR/LF & CONTINUE


             /ROUTINE TO 'SET' THE 'DEVICE' OPTION
01121  4340  XDEV,   JMS GDEVICE     /GET & FETCH DEVICE HANDLER
01122  7201            DEVHAN+1      / (2 PAGE HANDLER IS OK)
01123  3100          DCA DEVAD       /SET UP HANDLER ADDRESS
01124  1354          TAD GDEV2       /SAVE DEVICE #
01125  3101          DCA DEVNO
01126  3077          DCA RBLK1       / & NO FILE KNOWN
01127  3047          DCA SHUT        / & NOTHING OPENED
01130  3050          DCA MODIF       / & NOTHING MODIFIED
01131  1025          TAD NAM1
01132  6212          CIF 10
01133  5765'         JMP XDEVM       /GO FINISH SETUP IN FIELD 1


             /ROUTINE TO 'SET' THE 'DDEV' OPTION
01134  4340  XDDEV,  JMS GDEVICE     /GET & FETCH DEVICE HANDLER
01135  6601            DMPHAN+1      / (2 PAGE HANDLER IS OK)
01136  6212          CIF 10
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 8-2

01137  5764'         JMP XDDEV1      /GO TO FIELD 1 TO FINISH SETUP

01140  0000  GDEVICE,0       /SUBROUTINE TO GET DEVICE NAME & FETCH HANDLER
01141  4777'         JMS GNAME       /GET DEV NAME ("." ILLEGAL)
01142  1025          TAD NAM1        /MOVE NAME TO CALL
01143  3353          DCA GDEV1
01144  1026          TAD NAM2
01145  3354          DCA GDEV2
01146  1740          TAD I GDEVICE   /GET HANDLER SPACE ADDRESS
01147  2340          ISZ GDEVICE
01150  3355          DCA GDEV3
01151  4552          CALUSR
01152  0001            1             /FETCH HANDLER
01153  0000  GDEV1,    0
01154  0000  GDEV2,    0
01155  0000  GDEV3,    0
01156  4573  ERCY,   ERROR           /NO SUCH HANDLER
01157  1355          TAD GDEV3       /RETURN HANDLER ADDRESS
01160  5740          JMP I GDEVICE


01164  2200
01165  2467
01166  3407
01167  6374
01170  0017
01171  6400
01172  0025
01173  2731
01174  1404
01175  2272
01176  2222
01177  3676
       1200  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 9

             /ROUTINE TO EXECUTE THE 'SHOW' COMMAND
01200  4525  XSHBLK, JMS I TYPSI     /"BLOCK = "
01201  4376            MS32
01202  1077          TAD RBLK1       /OUTPUT BLOCK IN OCTAL
01203  4540  XSTYPE, JMS I OCTI
01204  4530  XSHCR,  JMS I CRLFI     /GIVE A CR & LF
01205  3052          DCA DSWIT       /BE SURE SWITCH IS RESET
01206  2046          ISZ CRSWT       /LAST WORD ENDED BY CR?
01207  5572          JMP I RESTAR    /YES, DONE
01210  4556  XSHOW,  JMS I GWORDI    /GET A WORD
01211  5215            JMP ERCG      /NUMBERS NOT RECOGNIZED
01212  4567          JMS I SORTI     /LOOK IT UP
01213  5073            SHOWL-1
01214  0037            SHOWOP-SHOWL
01215  4573  ERCG,   ERROR           /NOT FOLLOWED BY LEGAL WORD

01216  4525  XSHVER, JMS I TYPSI     /"VERSION = <VERSION><PATCH>"
01217  2512            MSVER
01220  5204          JMP XSHCR

01221  4525  XSHMSK, JMS I TYPSI     /"MASK = "
01222  4204            MS02
01223  1075          TAD MASK
01224  5203          JMP XSTYPE

01225  4525  XSHOFF, JMS I TYPSI     /"OFFSET = "
01226  4242            MS09
01227  1073          TAD OFFSET
01230  7041          CIA
01231  5203          JMP XSTYPE

01232  4525  XSHFIL, JMS I TYPSI     /"FILLER = "
01233  4415            MS37
01234  1074          TAD FILLER
01235  5203          JMP XSTYPE

01236  4525  XSHODL, JMS I TYPSI     /"ODT  LOC = "
01237  4256            MS12
01240  4546          JMS I BKLOCI    /OUTPUT IT
01241  0067            SBLK-1
01242  5257          JMP XSHBKS

01243  4525  XSHREL, JMS I TYPSI     /"REL. LOC = "
01244  4324            MS20
01245  4546          JMS I BKLOCI    / & OUTPUT IT
01246  0056            BLK-1
01247  5257          JMP XSHBKS

01250  4525  XSHABS, JMS I TYPSI     /"ABS. LOC = "
01251  4210            MS03
01252  1056          TAD CAD         /OUTPUT LOCATION IN BLOCK
01253  1377          TAD (-IOBUF
01254  3056          DCA CAD
01255  4546          JMS I BKLOCI
01256  0053            CBLK-1
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 9-1

01257  1050  XSHBKS, TAD MODIF       /HAS BLOCK BEEN MODIFIED?
01260  7700          SMA CLA
01261  5204          JMP XSHCR       / NO, SAY NOTHING!
01262  4525          JMS I TYPSI     /  YES, SAY " MOD"
01263  2142            MSMOD
01264  5204          JMP XSHCR

01265  4525  XSHUPP, JMS I TYPSI     /"UPPER = "
01266  4216            MS04
01267  4546          JMS I BKLOCI    /OUTPUT IN BLOCK.LOC FORM
01270  0061            UBLK-1
01271  5204          JMP XSHCR

01272  4525  XSHLOW, JMS I TYPSI     /"LOWER = "
01273  4223            MS05
01274  4546          JMS I BKLOCI
01275  0064            LBLK-1
01276  5204          JMP XSHCR

01277  4525  XSHFMT, JMS I TYPSI     /"FORMAT = "
01300  4230            MS06
01301  1042          TAD FCNT
01302  1376          TAD (FMTLS-1    /SET UP FOR CORRECT TITLE
01303  3010  XSHFM,  DCA DPNT
01304  4553          TADIDP          /GET MESSAGE ADDRESS
01305  4524          JMS I TYPSTI    /OUTPUT DESCRIPTOR
01306  5204          JMP XSHCR

01307  4525  XSHMOD, JMS I TYPSI     /"MODE = "
01310  4247            MS10
01311  1044          TAD MODSW       /GET CORRECT MESSAGE
01312  1375          TAD (MODELS-1   /(OFFSET INTO TABLE)
01313  5303          JMP XSHFM       /GET ADDRESS & OUTPUT

01314  4525  XSHOUT, JMS I TYPSI     /"OUTPUT = "
01315  4367            MS30
01316  1017          TAD TYPSW       /SET UP MESSAGE ADDRESS
01317  1374          TAD (OUTLS-1    /(OFFSET INTO TABLE)
01320  5303          JMP XSHFM

01321  4525  XSHSMS, JMS I TYPSI     /"SMASK = "
01322  4203            MS07
01323  1076          TAD SMASKL
01324  3021          DCA TEMP        /-# TO OUTPUT
01325  1176          TAD MASKBS
01326  3010          DCA DPNT        /SET UP TO OUTPUT
01327  1111          TAD M10         /SET LINE LENGTH
01330  3022          DCA TEMP1
01331  5342          JMP XSHSM2
01332  4527  XSHSM1, JMS I TWOCI     /OUTPUT ", "
01333  5440            5440
01334  2022          ISZ TEMP1       /ENOUGH ON THIS LINE?
01335  5342          JMP XSHSM2      /NO, OK
01336  4530          JMS I CRLFI     /YES, OUTPUT CR-LF
01337  4533          SPACE2          / & 2 SPACES
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 9-2

01340  7240          STA             /MAKE LINE 1 LONGER
01341  5327          JMP XSHSM1-3    /AND RESET LENGTH
             /
01342  4553  XSHSM2, TADIDP          /GET NEXT VALUE
01343  4540          JMS I OCTI      / & OUTPUT IT
01344  2021          ISZ TEMP        /ENOUGH?
01345  5332          JMP XSHSM1
01346  5204          JMP XSHCR       /OK, GET NEXT WORD

01347  4525  XSHDEV, JMS I TYPSI     /"DEVICE = XXXX"
01350  2457            MSDEV
01351  4527          JMS I TWOCI     /NOW OUTPUT " ("
01352  4050            4050
01353  1101          TAD DEVNO       /GET THE DEVICE #
01354  4541          JMS I DEC2I     / & OUTPUT AS 2 DIGITS
01355  4526          JMS I TYPECI    /FINALLY OUTPUT ")"
01356  0251            ")
01357  5204          JMP XSHCR

01360  4525  XSHDDEV,JMS I TYPSI     /"DDEV = XXXX"
01361  2450            MSDDEV
01362  5204          JMP XSHCR


01363  0000  FPRNT,  0       /PRINT FIELD DIGIT FROM BITS 6-8
01364  4773          JMS I (FPRNTX   /FIRST PRINT BANK BITS
01365  7012          RTR             /MOVE TO BITS 9-11
01366  7010          RAR
01367  0113          AND N7          /MASK TO 1 DIGIT
01370  4531          DIGIT           / & OUTPUT IN ASCII
01371  5763          JMP I FPRNT


01373  7011
01374  5274
01375  5270
01376  4777
01377  0600
       1400  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 10

             /CONTINUATION OF 'SHOW' COMMAND

             /SHOW 'CCB' HANDLER
01400  6213  XSHCCB, CDF CIF 10
01401  4777'         JMS GCCB        /SET UP CCB FOR FILE
01402  3001          DCA DPSGN       / & SET UP SEGMENTS
01403  4525          JMS I TYPSI     /"CCB:"
01404  4253            MS11
01405  4353          JMS CCHDST      /DO SETUP, OUTPUT START
01406  4525          JMS I TYPSI     /", JSW = "
01407  4317            MS19
01410  4776'         JMS NXTOCT      /OUTPUT J.S.W. IN OCTAL
01411  4530          JMS I CRLFI
01412  4525          JMS I TYPSI     /"  CORE SEGS:   "
01413  4267            MS14
01414  1375  XSHCC1, TAD (-4
01415  3037          DCA CNTR        /-#/LINE
01416  4553  XSHCC2, TADIDP          /GET ORIGIN WORD
01417  3022          DCA TEMP1
01420  4553          TADIDP          / & COUNT WORD
01421  3023          DCA TEMP2
             /       TAD TEMP2       /GO OUTPUT START FIELD
             /       JMS FPRNT
01422  4774          JMS I (ADFLD    /ADJUST BANK AND FIELD FOR 128K
01423  1022          TAD TEMP1       / & START ADDR
01424  4540          JMS I OCTI
01425  4526          JMS I TYPECI    / & A "-"
01426  0255            "-
             /       TAD TEMP2       /OUTPUT FIELD AGAIN
             /       JMS FPRNT
01427  4774          JMS I (ADFLD    /ADJUST BANK AND FIELD (128K)
01430  1023          TAD TEMP2       / PAGE COUNT -> PAGES
01431  7104          CLL RAL
01432  0106          AND M200        /MASK OFF FIELD DATA
01433  1022          TAD TEMP1       /ADD ORIGIN ADDR
01434  1112          TAD M1          / & SUBTRACT 1 FOR END
01435  4540          JMS I OCTI      /OUTPUT END ADDR IN OCTAL
01436  2001          ISZ DPSGN       /DONE?
01437  5245          JMP XSHCC4      /NO
01440  1000          TAD OVLFLG      /YES, OVERLAYS? (LINK OUTPUT)
01441  7450          SNA
01442  5773'         JMP XSHCR       / NO, DONE
01443  3010          DCA DPNT        / YES, RESET POINTER
01444  5277          JMP XSHHD1      /  & CONTINUE
             /
01445  4527  XSHCC4, JMS I TWOCI     /OUTPUT SEPARATOR
01446  5440            5440
01447  2037          ISZ CNTR        /DONE ON THIS LINE?
01450  5216          JMP XSHCC2      /NO
01451  4530          JMS I CRLFI     /YES
01452  4533          SPACE2          /ADD 2 SPACES
01453  7240          STA             /AND 1 MORE ITEM PER LINE
01454  5214          JMP XSHCC1

             /SHOW 'HEADER' HANDLER
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 10-1

01455  6213  XSHHDR, CDF CIF 10
01456  4772'         JMS GHDR        /SET UP HEADER FOR MODULE
01457  4525          JMS I TYPSI     /"HEADER:"
01460  4422            MS38
01461  4353          JMS CCHDST      /DO SETUP, OUTPUT START
01462  4525          JMS I TYPSI     /", NEXT WORD = "
01463  4426            MS39
01464  4553          TADIDP          /GET FIELD DIGIT
01465  4531          DIGIT           / & OUTPUT
01466  4776'         JMS NXTOCT      /FOLLOWED BY ADDRESS
01467  4525          JMS I TYPSI     /", LOAD VER = "
01470  4436            MS40
01471  4776'         JMS NXTOCT      / & OUTPUT VERSION
01472  4553          TADIDP          /GET E.P. FLAG
01473  7650          SNA CLA
01474  5277          JMP XSHHD1      / NO E.P.
01475  4525          JMS I TYPSI     /", EP REQ'D"
01476  4443            MS41
01477  4530  XSHHD1, JMS I CRLFI     /TO THE NEXT LINE
01500  4525          JMS I TYPSI     /"  OVLYS START...
01501  4452            MS42
01502  4553  XSHHD2, TADIDP          /GET NUMBER OF OVERLAYS
01503  7450          SNA             / FOR THIS LEVEL
01504  5773'         JMP XSHCR       / 0 = END, DONE
01505  3022          DCA TEMP1       /SAVE IT
01506  4530          JMS I CRLFI     /OUTPUT A CR/LF
01507  4533          SPACE2          / AND 4 SPACES
01510  4533          SPACE2
01511  1022          TAD TEMP1
01512  4541          JMS I DEC2I     /# OVLYS IN DECIMAL
01513  4533          SPACE2
01514  4553          TADIDP          /GET MEMORY START WORD
01515  3023          DCA TEMP2
01516  1023          TAD TEMP2
01517  4771'         JMS FPRNT       /OUTPUT START FIELD
01520  1023          TAD TEMP2
01521  0103          AND M400        / & DOUBLE-PAGE
01522  4540          JMS I OCTI
01523  4533          SPACE2
01524  4776'         JMS NXTOCT      /OUTPUT RELATIVE BLOCK
01525  4533          SPACE2
01526  4776'         JMS NXTOCT      /OUTPUT OVERLAY LENGTH
01527  5302          JMP XSHHD2      /AND DO ANOTHER ROUND!

             /SHOW 'ERRORS' HANDLER
01530  4770' XSHERR, JMS USROUT      /BE SURE MESSAGES ARE IN
01531  2052          ISZ DSWIT       /SET DUMP SWITCH
01532  4525          JMS I TYPSI     /"ERRORS:  FUTIL VERSION ..."
01533  2500            MSERR
01534  4530          JMS I CRLFI
01535  7201          CLA IAC
01536  3010          DCA DPNT        /SET POINTER & CODE
01537  4530  XSHER1, JMS I CRLFI     /DO ANOTHER CR/LF
01540  1010          TAD DPNT        /TEST FOR LAST REAL MESSAGE
01541  1367          TAD (-EMSEND    /(NOT DEBUG MESSAGE!)
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 10-2

01542  7650          SNA CLA
01543  5773'         JMP XSHCR
01544  1010          TAD DPNT        /OUTPUT ERROR CODE
01545  4541          JMS I DEC2I     / AS 2 DIGITS
01546  4525          JMS I TYPSI     /THEN " =  "
01547  4200            MS01
01550  4553          TADIDP          /GET ADDR OF MESSAGE AND
01551  4524          JMS I TYPSTI    / OUTPUT IT
01552  5337          JMP XSHER1


01553  0000  CCHDST, 0
01554  4530          JMS I CRLFI
01555  4525          JMS I TYPSI     /"  SA = "
01556  4313            MS18
01557  1366          TAD (CCBB
01560  3010          DCA DPNT        /SET UP POINTER TO DATA
01561  4553          TADIDP          /GET 2ND WORD FROM CCB/HDR
01562  4771'         JMS FPRNT       /IT HAS START FIELD SO OUTPUT
01563  4776'         JMS NXTOCT      / FOLLOWED BY START ADDR
01564  5753          JMP I CCHDST


01566  6400
01567  7720
01570  0544
01571  1363
01572  2050
01573  1204
01574  7000
01575  7774
01576  1766
01577  2000
       1600  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 11

             /ROUTINE TO EXECUTE THE 'SET' COMMAND
01600  2046  XSETN,  ISZ CRSWT       /WAS LAST INFO ENDED BY CR?
01601  5572          JMP I RESTAR    /YES, DONE
01602  4556  XSET,   JMS I GWORDI    /GET OPTION WORD
01603  5211            JMP XSET1     /NO NUMBERS PLEASE!
01604  2046          ISZ CRSWT       /WAS WORD ENDED BY A CR?
01605  4573  ERCK,   ERROR           /YES, ILLEGAL HERE
01606  4567          JMS I SORTI     /LOOK UP WORD
01607  5110            SETLST-1
01610  0060            SETJMP-SETLST
01611  4573  XSET1,  ERROR           /WHAT???


             /ROUTINE TO 'SET' THE 'DMODE' (DUMP MODE)
01612  4556  XDMODE, JMS I GWORDI    /GET A WORD
01613  5217            JMP ERC11     /NO NUMBERS HERE!
01614  4567          JMS I SORTI     /LOOK IT UP
01615  5260            XDMLST-1
01616  0004            XDMOPS-XDMLST
01617  4573  ERC11,  ERROR           /NO LIKEE!!
             /
01620  7350          CLL STA RAR     /4000: 'ALL' (ECHO TO TTY & FILE)
01621  7001  XDMODS, IAC             /   1: 'PART' (ONLY DUMP,LIST,ETC)
01622  3053          DCA DMODE       /   0: 'NONE' (TTY ONLY)
01623  5200          JMP XSETN


             /ROUTINE TO 'SET' THE 'OUTPUT' OPTION
01624  4556  XOUTS,  JMS I GWORDI    /GET OPTION WORD
01625  5231            JMP ERCL      / # IN THE BUFFER
01626  4567          JMS I SORTI     /LOOK IT UP
01627  5222            XOLST-1
01630  0007            XOOPS-XOLST
01631  4573  ERCL,   ERROR           /NOT FOLLOWED BY LEGAL WORD
             /
01632  7344          CLL STA RAL     /-1: 'FPP' (SYMBOLIC)
01633  7001  XOUTS1, IAC             /+1: 'PDP' (SYMBOLIC)
01634  3017          DCA TYPSW       / 0: 'OCTAL'
01635  5200          JMP XSETN


             /ROUTINE TO 'SET' THE 'MASK' OPTION
01636  4560  XMASK,  JMS I ARGI      /GET ONE ARG
01637  1025          TAD ACC1        /GET 'LOC'
01640  3075          DCA MASK        / & SET MASK
01641  5200          JMP XSETN


             /ROUTINE TO 'SET' THE 'OFFSET' OPTION
01642  4560  XOFFS,  JMS I ARGI      /GET ONE ARG
01643  1025          TAD ACC1        /GET #
01644  7041          CIA
01645  3073          DCA OFFSET      /SET IT
01646  5200          JMP XSETN

/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 11-1


             /ROUTINE TO 'SET' THE 'ERROR' (MODE) OPTION
01647  4556  XEMODE, JMS I GWORDI    /GET WORD
01650  5254            JMP ERCZ      /NO NUMBERS ALLOWED!!!
01651  4567          JMS I SORTI     /LOOK IT UP
01652  5211            XELST-1
01653  0005            XEOPS-XELST
01654  4573  ERCZ,   ERROR           /ILLEGAL SOMETHING
             /
01655  7001  XEMOD1, IAC             /'SHORT'
01656  3020          DCA ERMODE      /'LONG'
01657  5200          JMP XSETN


             /ROUTINE TO 'SET' THE 'UPPER' LIMITS OPTION
01660  4565  XUPP,   JMS I LIMITI    /UPPER, GET ARGS
01661  0062            UBLK
01662  5200          JMP XSETN

             /ROUTINE TO 'SET' THE 'LOWER' LIMITS OPTION
01663  4565  XLOW,   JMS I LIMITI    /LOWER, GET ARGS
01664  0065            LBLK
01665  5200          JMP XSETN

             /ROUTINE TO 'SET' THE 'MODE' OPTION
01666  4556  XMODE,  JMS I GWORDI    /GET OPTION WORD
01667  5273            JMP ERCJ      /NUMBER IN BUFFER, BAIL OUT
01670  4567          JMS I SORTI     /LOOK IT UP
01671  5237            MODLST-1
01672  0011            MODOPS-MODLST
01673  4573  ERCJ,   ERROR           /NOT RECOGNIZED
             /
01674  7346          CLL STA RTL     /-1: OFFSET
01675  7001  XMODS,  IAC             /+2: LOAD (MODULE)
01676  7001          IAC             /+1: SAVE (FILE)
01677  3044          DCA MODSW       / 0: NORMAL
01700  5200          JMP XSETN

             /ROUTINE TO 'SET' THE 'FILLER' OPTION
01701  4560  XFILL,  JMS I ARGI      /GET ONE ARG
01702  1025          TAD ACC1
01703  3074          DCA FILLER      / & SET AS FILLER
01704  5200          JMP XSETN

             /ROUTINE TO 'SET' THE 'TEMP' STORAGE
01705  4560  XTEMP,  JMS I ARGI      /GET THE 24 BIT ARG (EXPRESSION!)
01706  1025          TAD ACC1        /NOW SAVE THE 24 BITS FOR LATER
01707  3033          DCA TEMPV1
01710  1026          TAD ACC2        /GET IT BACK WITH "EVAL T"
01711  3034          DCA TEMPV2      / (OR IN AN EXPRESSION)
01712  5200          JMP XSETN


             /ROUTINE TO EXECUTE THE 'IF' COMMAND
01713  4547  XIF,    JMS I EVALI     /EVALUATE THE EXPRESSION
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 11-2

01714  7410            SKP           / TERMIN = CR, OK
01715  5777'         JMP ERCC        / TOO MANY PARENS
01716  1025          TAD ACC1        /TEST THE 24-BIT VALUE FOR ZERO
01717  7450          SNA
01720  1026          TAD ACC2
01721  7650          SNA CLA
01722  5572          JMP I RESTAR    /OK, JUST CONTINUE
01723  1174  XIFSKP, TAD COMST       /NOT ZERO, BEGIN SKIPPING FOR
01724  3015          DCA COMIR       / LINE STARTING WITH "END"
01725  4523          READLN          /GET A LINE FROM THE INPUT
01726  4522            TYPEM-1       / WITH THESE TERMINATORS
01727  0342            IFSKPO-TYPEM
01730  5323          JMP XIFSKP      /BUFFER EMPTIED
             /
01731  4570  XIFCR,  JMS I ENDCI     /CR FOUND, TIDY THINGS UP
01732  5323            JMP XIFSKP    / CR ONLY
01733  4556          JMS I GWORDI    /GET 1ST WORD ON LINE
01734  5323            JMP XIFSKP    / NO WORD
01735  1376          TAD (-0516      /IS THE WORD "EN..."?
01736  7640          SZA CLA
01737  5323          JMP XIFSKP      / NO, KEEP LOOKING!
01740  5572          JMP I RESTAR    /YES! BEGIN EXECUTION AGAIN!


             /ROUTINE TO OUTPUT LOCATION THAT SATISFIED ONE
             /OF THE SEARCH COMMANDS.  IF ABSSW=0, OUTPUT
             /AS RELATIVE LOCATION.
01741  0000  ABKLOC, 0
01742  1051          TAD ABSSW       /IS IT 0?
01743  7640          SZA CLA
01744  5353          JMP ABK2        /NO, OUTPUT AS ABSOLUTE
01745  4546          JMS I BKLOCI    /OUTPUT LOCATION
01746  0056            BLK-1
01747  4527  ABK1,   JMS I TWOCI     /OUTPUT ": "
01750  7240            7240
01751  4535          JMS I TWOT
01752  5741          JMP I ABKLOC
             /
01753  1061  ABK2,   TAD LOCL        /MAKE ABSOLUTE
01754  0121          AND N377
01755  3056          DCA CAD
01756  4546          JMS I BKLOCI    /NOW OUTPUT IT
01757  0053            CBLK-1
01760  5347          JMP ABK1

01761  0000  TWOCS,  0       /OUTPUT 2-CHARACTER ARG
01762  1761          TAD I TWOCS     /GET ARG
01763  2361          ISZ TWOCS       /SKIP IT
01764  4535          JMS I TWOT      /OUTPUT IT
01765  5761          JMP I TWOCS

01766  0000  NXTOCT, 0
01767  4553          TADIDP          /GET NEXT WORD FROM BLOCK
01770  4540          JMS I OCTI      / & OUTPUT IN OCTAL
01771  5766          JMP I NXTOCT
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 11-3



01776  7262
01777  0402
       2000  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 12

             /ROUTINE TO EXECUTE THE 'WORD' SEARCH COMMAND
02000  4247  XWORD,  JMS SSET        /INITIALIZE SEARCH
02001  1236          TAD CNOP        /SET UP FOR NORMAL,
02002  3237          DCA CNOP+1
02003  1111          TAD M10         / EQUAL SEARCH
02004  1377  XWOR2,  TAD (SNA CLA    /"UNEQUAL" WORD SEARCH
02005  3233          DCA XWORC
02006  4556  XWOR1,  JMS I GWORDI    /GET POSSIBLE WORD
02007  5221            JMP XWOR3     /NUMBERS IN BUFFER
02010  2046          ISZ CRSWT       /WAS IT ENDED BY A CR?
02011  4573  ERCI,   ERROR           /YES, VELLY SOLLY!
02012  4567          JMS I SORTI     /LOOK UP COMMAND: UN, ME,
02013  5276            XWORCL-1      / AB, FR, TO
02014  0014            XWOROP-XWORCL
02015  4573  ERCH,   ERROR           /COMMAND NOT RECOGNIZED
             /
02016  1230  XWOR7,  TAD XWOR4+1     /"MEMREF", ONLY MEMORY-
02017  3237          DCA CNOP+1      / REFERENCE OP-CODES CAN
02020  5206          JMP XWOR1       / EVER BE OUTPUT.
             /
02021  4560  XWOR3,  JMS I ARGI      /GET AN ARG
02022  1025          TAD ACC1        /GET THE VALUE
02023  0075          AND MASK
02024  7041          CIA
02025  3036          DCA CNT         /LOOK FOR THIS WORD
02026  4307          JMS LSETUP      /SET UP COUNT OF WORDS TO DO
02027  4561  XWOR4,  JMS I GETI      /GET A WORD
02030  5245            JMP XWOR5     /FILE MODE, NO SUCH ADDRESS
02031  0075          AND MASK
02032  1036          TAD CNT
02033  7402  XWORC,  HLT             /WILL BE "SZA CLA" OR "SNA CLA"
02034  5245          JMP XWOR5       /DID NOT MATCH
02035  4776'         JMS OPRTST      /TEST FOR OP-CODES 6 & 7
02036  7000  CNOP,   NOP             / 7--OPR
02037  7000          NOP             / 6--IOT;"NOP" OR "JMP XWOR5"
02040  4775'         JMS ABKLOC      /DID MATCH, OUTPUT LOC
02041  4561          JMS I GETI      /GET THAT WORD
02042  5774'           JMP ERCP      / OH I HOPE NOT!!!
02043  4540          JMS I OCTI      /AND OUTPUT IT IN OCTAL
02044  4530          JMS I CRLFI
02045  4347  XWOR5,  JMS LCHEK       /DONE YET?
02046  5227          JMP XWOR4       /NO

             /SUBROUTINE TO INITIALIZE THE SEARCH COMMANDS
02047  0000  SSET,   0
02050  3051          DCA ABSSW       /RESET ABSOLUTE SWITCH
02051  1065          TAD LBLK        /SET UP START BLK & LOC
02052  3057          DCA BLK
02053  1066          TAD LLOCH
02054  3060          DCA LOCH
02055  1067          TAD LLOCL
02056  3061          DCA LOCL
02057  1062          TAD UBLK        /SET UP END BLK & LOC
02060  3304          DCA EBLK
02061  1063          TAD ULOCH
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 12-1

02062  3305          DCA ELOCH
02063  1064          TAD ULOCL
02064  3306          DCA ELOCL
02065  5647          JMP I SSET

             /COMMON OPTIONS FOR 'WORD' AND 'STRING' SEARCHES

02066  7240  XWSABS, STA
02067  3051          DCA ABSSW       /'ABSOLUTE'--SET SWITCH
02070  5300          JMP XWSRET
             /
02071  4565  XWSFRM, JMS I LIMITI    /'FROM'--GET LOWER LIMITS
02072  0057            BLK
02073  5300          JMP XWSRET
             /
02074  1062  XWSTO,  TAD UBLK        /'TO'--SET UP IF NEEDED
02075  3304          DCA EBLK
02076  4565          JMS I LIMITI    / & GET UPPER LIMITS
02077  2104            EBLK
02100  7344  XWSRET, STA CLL RAL     /= -2, CALCULATE RETURN ADDRESS AS
02101  1556          TAD I GWORDI    / LAST CALL TO "GWORD" TO ALLOW
02102  3347          DCA LCHEK       / THESE TO BE COMMON TO BOTH
02103  5747          JMP I LCHEK     / 'WORD' AND 'STRING' SEARCHES.
02104  0000  EBLK,   0
02105  0000  ELOCH,  0
02106  0000  ELOCL,  0


02107  0000  LSETUP, 0       /SET SEARCH WORD-COUNTERS **** SEE NOTE ****
02110  3025          DCA ACC1        /INITIALIZE THESE TO 0
02111  3026          DCA ACC2
02112  1044          TAD MODSW       /IN A MAPPED MODE?
02113  7740          SMA SZA CLA
02114  5327          JMP LSETL       / YES, IGNORE BLOCK PARTS
02115  1057          TAD BLK         / NO, SET UP FOR 24 BIT
02116  3025          DCA ACC1
02117  1304          TAD EBLK        /  BLK-EBLK
02120  3031          DCA OPER1
02121  3032          DCA OPER2
02122  4773'         JMS DSUB        /DO THE SUBTRACTION
02123  1372          TAD (400        /NOW SET UP MULTIPLY BY 400
02124  3031          DCA OPER1
02125  3032          DCA OPER2
02126  4771'         JMS DMUL        /GIVES: (BLK-EBLK)*400
02127  7101  LSETL,  CLL IAC
02130  1306          TAD ELOCL
02131  3031          DCA OPER1       /NOW SET UP ELOC+1
02132  7004          RAL
02133  1305          TAD ELOCH
02134  3032          DCA OPER2
02135  4773'         JMS DSUB        /AND SUBTRACT IT
02136  1061          TAD LOCL        /NOW ADD LOC TO GIVE:
02137  3031          DCA OPER1       / (BLK-EBLK)*400+(LOC-ELOC-1)
02140  1060          TAD LOCH        / WHICH IS 24-BIT COUNT OF
02141  3032          DCA OPER2       / WORDS TO SEARCH.
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 12-2

02142  4770'         JMS DADD
02143  1026          TAD ACC2        /IF NOT NEGATIVE, ALREADY TOO
02144  7700          SMA CLA
02145  5571          JMP I RECRLF    / FAR, SO JUST QUIT NOW!
02146  5707          JMP I LSETUP

             /**** NOTE: COUNT LEFT SET UP IN ACC1 & ACC2 ****

02147  0000  LCHEK,  0       /CHECK IF SEARCH RANGE EXHAUSTED
02150  4566          JMS I INCI      /INCREMENT LOC
02151  2025          ISZ ACC1        /COUNT WORDS TO DO
02152  5747          JMP I LCHEK
02153  2026          ISZ ACC2        / (24-BIT)
02154  5747          JMP I LCHEK
02155  5571          JMP I RECRLF    /DO CR/LF & STOP!


02156  0000  TIDPNT, 0       /"TAD I DPNT" IN FIELD 1
02157  6211          CDF 10
02160  1410          TAD I DPNT
02161  6201          CDF 0
02162  5756          JMP I TIDPNT


02163  0000  ASCII,  0       /ASCII OUTPUT FORMAT FROM DEVICE
02164  0117          AND N177        /MAKE CHARS INTO "STANDARD"
02165  1120          TAD N200        / FORM: 7 BITS + PARITY ON
02166  4536          JMS I TYPEI     / TO CAUSE CORRECT PRINTING
02167  5763          JMP I ASCII


02170  5650
02171  6000
02172  0400
02173  5662
02174  2473
02175  1741
02176  4547
02177  7650
       2200  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 13

             /ROUTINE TO 'REWIND' THE DEVICE
02200  6211  XREWIN, CDF 10
02201  1102          TAD USRAD       /RESET DIRECTORY SEGMENT KEY
02202  7700          SMA CLA
02203  3513          DCA I N7        / IN USR IF IT IS IN MEMORY.
02204  6201          CDF 0
02205  4500          JMS I DEVAD     /CALL HANDLER
02206  0110            0110          /READ, 1 PAGE, FIELD 1
02207  6127            PDLB          /DUMMY BUFFER (ZAP P.D.L.)
02210  0001            1             /BLK 1
02211  5213            JMP RERROR    /READ ERROR!
02212  5572          JMP I RESTAR

             /READ ERROR--TEST TYPE & OUTPUT MESSAGE

02213  7710  RERROR, SPA CLA         /BIT 0 = 1 IF FATAL
02214  4573  ERC00,  ERROR           /FATAL
02215  4573  ERC01,  ERROR           /NON-FATAL


             /ROUTINE TO EXECUTE THE 'STRING' SEARCH COMMAND
02216  4777' XSTRIN, JMS SSET        /INITIALIZE
02217  1376          TAD (STJMP-STCDF /RESET MASKING SWITCH
02220  1200  XSTR0,  TAD XREWIN      / OR SET MASKING SWITCH
02221  3360          DCA SMSKSW
02222  4556          JMS I GWORDI    /GET POSSIBLE WORD
02223  5232            JMP XSTR1     /NUMBERS ONLY
02224  2046          ISZ CRSWT       /FOLLOWED BY A CR?
02225  5775'         JMP ERCI        / YES, KICK OUT*****
02226  4567          JMS I SORTI     /LOOK UP OPTION: MA,
02227  5300            STRLST-1      / AB, FR, TO
02230  0025            STROPS-STRLST
02231  5774'         JMP ERCH        /NO LIKEE!
             /
02232  4557  XSTR1,  JMS I GARGI     /GET ARGS - THEN REPACK INTO BUFFER
02233  1021          TAD TEMP        / MASKING THEM IF SPECIFIED
02234  3037          DCA CNTR        /SET UP LENGTH
02235  1175          TAD TEMPST
02236  3013          DCA SCANX2      /STORING DONE IN NEG. FORM
02237  5242          JMP XSTR2+2     /GO SET UP MASK
             /
02240  2024  XSTR2,  ISZ TEMP3       /MASK END?
02241  5246          JMP XSTR3
02242  1176          TAD MASKBS      /YES, RESET MASK
02243  3011          DCA SPNT
02244  1076          TAD SMASKL      /SET UP LENGTH
02245  3024          DCA TEMP3
02246  2010  XSTR3,  ISZ DPNT        /SKIP 2 EXTRA WORDS
02247  2010          ISZ DPNT
02250  1410          TAD I DPNT      /GET A WORD
02251  4357          JMS STRMSK      /TEST & MASK
02252  7041          CIA             /NEGATE
02253  3413          DCA I SCANX2    /STORE
02254  2010          ISZ DPNT        /BUMP POINTER
02255  2037          ISZ CNTR        /DONE?
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 13-1

02256  5240          JMP XSTR2
02257  4773'         JMS LSETUP      /YES, SET UP COUNT OF WORDS
02260  1175  XSTR4,  TAD TEMPST      /SET UP FOR SEARCH:
02261  3010          DCA DPNT        /  STRING,
02262  1021          TAD TEMP
02263  3037          DCA CNTR        /  & STRING LENGTH.
02264  1061          TAD LOCL
02265  3366          DCA XLOCL       /SAVE CURRENT LOCATION
02266  1060          TAD LOCH
02267  3365          DCA XLOCH
02270  1057          TAD BLK
02271  3364          DCA XBLK
02272  1025          TAD ACC1        / & COUNT FOR RESET
02273  3031          DCA OPER1
02274  1026          TAD ACC2
02275  3032          DCA OPER2
02276  5302          JMP XSTR6       /NOW SET UP MASK
             /
02277  4772' XSTR5,  JMS LCHEK       /DONE?
02300  2024          ISZ TEMP3       /NO, AT MASK END?
02301  5306          JMP XSTR7
02302  1176  XSTR6,  TAD MASKBS      / YES, RESET MASK
02303  3011          DCA SPNT
02304  1076          TAD SMASKL
02305  3024          DCA TEMP3
02306  4561  XSTR7,  JMS I GETI      /GET NEXT WORD
02307  5333            JMP XSTR10    /MAPPED MODE, NO SUCH ADDRESS
02310  4357          JMS STRMSK      /TEST & MASK
02311  1410          TAD I DPNT      /COMPARE?
02312  7640          SZA CLA
02313  5333          JMP XSTR10      /NO, GO RESET & CONTINUE
02314  2037          ISZ CNTR        /MATCHED ENOUGH?
02315  5277          JMP XSTR5       /NOT YET
02316  4343          JMS XRSET       /YES, RESET LOCATION & COUNT
02317  1021          TAD TEMP        /AND LENGTH
02320  3037          DCA CNTR
02321  1111  XSTR8,  TAD M10
02322  3027          DCA ACCX1       /  -(#/LINE)
02323  4771'         JMS ABKLOC      /OUTPUT THIS LOCATION
02324  4561  XSTR9,  JMS I GETI      /GET A WORD
02325  5770'           JMP ERCP      /BAD,BAD,BAD!!!
02326  4540          JMS I OCTI      /AND OUTPUT IN OCTAL
02327  4566          JMS I INCI      /INCREMENT LOC
02330  2037          ISZ CNTR        /DONE?
02331  5336          JMP XSTR11      /NO, CONTINUE
02332  4530          JMS I CRLFI     /YES, OUTPUT CR/LF
02333  4343  XSTR10, JMS XRSET       /RESET LOCATION & COUNT
02334  4772'         JMS LCHEK       /DONE?
02335  5260          JMP XSTR4       /NO, LOC INC'D, TRY NEXT
             /
02336  4533  XSTR11, SPACE2          /OUTPUT "  "
02337  2027          ISZ ACCX1       /DONE ON THIS LINE?
02340  5324          JMP XSTR9       /NO, NOT YET
02341  4530          JMS I CRLFI     /YES
02342  5321          JMP XSTR8
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 13-2


02343  0000  XRSET,  0       /RESET BLK & LOC FROM XBLK & XLOC
02344  1366          TAD XLOCL       /LOC
02345  3061          DCA LOCL
02346  1365          TAD XLOCH
02347  3060          DCA LOCH
02350  1364          TAD XBLK        /BLK
02351  3057          DCA BLK
02352  1031          TAD OPER1       /WORDS LEFT TO SEARCH
02353  3025          DCA ACC1
02354  1032          TAD OPER2
02355  3026          DCA ACC2
02356  5743          JMP I XRSET

02357  0000  STRMSK, 0       /STRING MASKING  *** NEXT WORD MODIFIED ***
02360  6211  SMSKSW, CDF 10          /"CDF 10" OR "JMP I STRMSK"
02361  0411          AND I SPNT      /OK, MASK IN FIELD 1
02362  6201          CDF 0
02363  5757          JMP I STRMSK
       5757  STJMP=  JMP I STRMSK
       6211  STCDF=  CDF 10

02364  0000  XBLK,   0
02365  0000  XLOCH,  0
02366  0000  XLOCL,  0


02370  2473
02371  1741
02372  2147
02373  2107
02374  2015
02375  2011
02376  7546
02377  2047
       2400  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 14

             /ROUTINE TO EXECUTE THE BLOCK 'WRITE' COMMAND
02400  4560  XWRARG, JMS I ARGI      /GET ONE ARG
02401  1025          TAD ACC1        /USE IT AS THE BLOCK
02402  7410          SKP
02403  1777' XWRITE, TAD WBLK        /SET BLOCK
02404  3210          DCA XWBLK
02405  4500          JMS I DEVAD     /CALL HANDLER
02406  4210            4210          /WRITE, 2 PAGES, FIELD 1
02407  7200            IOBUF
02410  0000  XWBLK,    0             /[** COUNTER FOR MODIFY **]
02411  5214            JMP WERROR    /WRITE ERROR
02412  3050          DCA MODIF       /CLEAR SOMETHING-CHANGED FLAG
02413  5572          JMP I RESTAR

             /WRITE ERROR--TEST TYPE & OUTPUT MESSAGE

02414  7710  WERROR, SPA CLA         /BIT 0 = 1 IF FATAL
02415  4573  ERC02,  ERROR           /FATAL
02416  4573  ERC03,  ERROR           /NON-FATAL


             /ROUTINE TO EXECUTE THE 'MODIFY' COMMAND
02417  4556  XMODIF, JMS I GWORDI    /GET FORMAT WORD IF ONE
02420  5231            JMP XMODEF    /NONE, GET DEFAULT
02421  3277          DCA MODTMP      /SAVE FOR LATER
02422  2046          ISZ CRSWT       /TERMINATED BY A CR?
02423  5230          JMP ERCO        / YES, SAVE USER FROM HIMSELF!
02424  1277          TAD MODTMP      /TEST FORMAT FOR RECOGNITION
02425  4567          JMS I SORTI
02426  5013            MODIFL-1
02427  0021            MODADS-MODIFL
02430  4573  ERCO,   ERROR           / I THEENK YOU USE BAD WORD!
             /
             /NO FORMAT DESCRIPTOR GIVEN, USE DEFAULT
02431  1042  XMODEF, TAD FCNT        /USE CURRENT FORMAT,
02432  1376          TAD (MODDLS-1   / WITH A LITTLE DIFFERENCE
02433  3010          DCA DPNT
02434  4553          TADIDP          /GET THE ONE TO USE
02435  3277          DCA MODTMP      / AND SAVE IT
             /
02436  4557  XMOD0,  JMS I GARGI     /OK, NOW GET ARGS
02437  1021          TAD TEMP        /MOVE COUNT TO A SAFE PLACE
02440  3210          DCA XWBLK
02441  1410  XMOD1,  TAD I DPNT      /GET BLOCK #
02442  4775'         JMS BLKTST      /TEST & SET BLK
02443  1410          TAD I DPNT      /GET LOC
02444  3060          DCA LOCH
02445  1410          TAD I DPNT
02446  3061          DCA LOCL
02447  1410          TAD I DPNT      /GET -(# LOCS)
02450  3037          DCA CNTR
02451  1174  XMOD2,  TAD COMST       /INIT COMM. BUFF. FOR MODS
02452  3015          DCA COMIR
02453  3045          DCA CHARSW      /RESET HALF SWITCH
02454  4545          JMS I SOCTI     /INITIALIZE INPUT TO OCTAL
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 14-1

02455  4546          JMS I BKLOCI    /OUTPUT START LOC
02456  0056            BLK-1
02457  4527          JMS I TWOCI     /AND ": "
02460  7240            7240
02461  4523          READLN          /GET A LINE (TEST: RUBOUT, ^U & ^R)
02462  4522            TYPEM-1       /IGNORE LF'S
02463  0340            MCHARO-TYPEM
02464  5251          JMP XMOD2       /BUFFER EMPTIED!


             /CR TYPED, END
02465  4570  XMODCR, JMS I ENDCI     /END BUFFER WITH A CR.
02466  5251            JMP XMOD2     /ONLY A CR IN BUFFER-RETRY!
02467  1277          TAD MODTMP      /NOW LOOK UP FORMAT
02470  4567          JMS I SORTI
02471  5013            MODIFL-1
02472  0011            MODIFO-MODIFL
02473  4573  ERCP,   ERROR           /ILLEGAL (EXTRA BAD IF HERE)

02474  2210  XMODDN, ISZ XWBLK       /RETURN HERE, ALL ARGS DONE?
02475  5241          JMP XMOD1       /NO
02476  5572          JMP I RESTAR    /YES
02477  0000  MODTMP, 0

02500  0000  XGET,   0       /SUB. TO SET CURRENT LOC & FLAG
02501  4561          JMS I GETI      /SET LOCATION
02502  4573  ERC07,    ERROR         /MAPPED MODE, NO SUCH ADDRESS
02503  7240          STA
02504  3050          DCA MODIF       /SET FLAG
02505  5700          JMP I XGET

             /NUMERIC FORMATS HERE
02506  4567  XNUM0,  JMS I SORTI     /TEST TERMINATOR
02507  5443            GETLST-1-1    /SPACE, COMMA, CR
02510  7423            NUMOPS-GETLST+1
02511  5774'         JMP ERCQ        /ILLEGAL TERMIN
             /
02512  4563  XNUM1,  JMS I GETNI     /COMMA, SKIP IT
02513  4564          JMS I SSKIPI    / SPACE, IGNORE IT
02514  4773' XNUM2,  JMS EXPRIN      /GET NEXT ARG--EXPRESSION
02515  4300          JMS XGET        /SET UP LOCATION
02516  1025          TAD ACC1
02517  4555          DCAICAD         / & STORE VALUE
02520  4566          JMS I INCI      /INCREMENT LOCATION
02521  2037          ISZ CNTR        /ALL MODS DONE?
02522  5306          JMP XNUM0       /NO, TEST TERMIN
02523  5274          JMP XMODDN      /YES, TEST NEXT SET
             /
02524  1037  XNUM3,  TAD CNTR        /DONE?
02525  7650          SNA CLA
02526  5274          JMP XMODDN      /YES
02527  4300          JMS XGET        /NO, SET UP LOC
02530  1074          TAD FILLER
02531  4555          DCAICAD         /AND FILL WITH 'FILLER'
02532  4566          JMS I INCI      /INCREMENT LOC
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 14-2

02533  2037          ISZ CNTR        /DONE?
02534  5324          JMP XNUM3       /NO
02535  5274          JMP XMODDN      /YES

             /ASCII FORMAT HERE
02536  4346          JMS CGET        /GET A CHAR & CHECK FOR CR
02537  4300  XASC1,  JMS XGET        /SET UP LOC & SET FLAG
02540  1035          TAD CHAR
02541  4555          DCAICAD         /STORE THIS CHAR
02542  4566          JMS I INCI      /INCREMENT LOC
02543  2037          ISZ CNTR        /MODS DONE?
02544  5336          JMP XASC1-1     /NO
02545  5274          JMP XMODDN      /YES

02546  0000  CGET,   0       /GET NEXT CHAR.  IF CR, MODS DONE
02547  4352          JMS CGTEST      /GET & TEST NEXT
02550  5324            JMP XNUM3     /CR, FILL REST WITH 'FILLER'
02551  5746          JMP I CGET

02552  0000  CGTEST, 0       /SUB. TO GET A CHAR & CHECK FOR CR
02553  4563          JMS I GETNI     /GET NEXT CHARACTER
02554  1035          TAD CHAR        /IS IT A CR?
02555  1105          TAD M215
02556  7640          SZA CLA
02557  2352          ISZ CGTEST      /RETURN TO CALL+2 IF NOT
02560  5752          JMP I CGTEST


02561  0000  DO1SP,  0       /OUTPUT " " + AC
02562  4526          JMS I TYPECI
02563  0240            " 
02564  5761          JMP I DO1SP     /ANOTHER TUFFIE

02565  0000  DO2SP,  0       /OUTPUT "  " + AC (PACKED ASCII)
02566  4527          JMS I TWOCI
02567  4040            4040
02570  5765          JMP I DO2SP     /FAST & SWEET!


02573  5727
02574  5722
02575  6154
02576  5045
02577  3042
       2600  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 15

             /ROUTINE TO EXECUTE THE 'SMASK' (STRING MASK) COMMAND
02600  4557  XSMASK, JMS I GARGI     /GET ARGS
02601  1021          TAD TEMP
02602  3076          DCA SMASKL      /SAVE -(MASK LENGTH)
02603  1176          TAD MASKBS      /SET UP TO STORE WORDS
02604  3011          DCA SPNT
02605  2010  XSMAS1, ISZ DPNT        /SKIP 2 WORDS
02606  2010          ISZ DPNT
02607  1410          TAD I DPNT      /GET & STORE ONE
02610  6211          CDF 10
02611  3411          DCA I SPNT
02612  6201          CDF 0
02613  2010          ISZ DPNT        /SKIP 1 MORE
02614  2021          ISZ TEMP        /DONE ?
02615  5205          JMP XSMAS1      /NO
02616  5572          JMP I RESTAR


             /XS240 PACKED ASCII FORMAT HERE
02617  1104  XXS20,  TAD M240        /SET OFFSET
             /PACKED ASCII FORMAT HERE
02620  3331  XPAC0,  DCA PNAME       /CLEAR OFFSET
02621  1104  XPAC1,  TAD M240        /IS CHAR < 240?
02622  1035          TAD CHAR
02623  7700          SMA CLA
02624  5227          JMP XPAC2       /NO, JUST PACK CHAR
02625  7040          CMA
02626  4304          JMS PACK        /YES, PACK A FLAG (77) FIRST
02627  1035  XPAC2,  TAD CHAR        /NOW GO PACK CHAR
02630  1331          TAD PNAME       /(WITH DESIRED OFFSET)
02631  4304          JMS PACK
02632  4777'         JMS  CGET       /NOW GET & TEST NEXT
02633  5221          JMP XPAC1       / OK, CONTINUE

             /OS/8 ASCII HERE
02634  1061  XOPS1,  TAD LOCL        /TEST START & COUNT FOR EVEN
02635  7010          RAR             /(LOW BIT TO LINK &
02636  7200          CLA             / CLEAR AC)
02637  1037          TAD CNTR
02640  7010          RAR             /(LOW TO LINK, LINK TO AC0)
02641  7730          SZL SPA CLA     /BOTH L=0 & AC0=0 FOR OK
02642  4573  ERC04,  ERROR           /START OR COUNT NOT EVEN
02643  1045  XOPS2,  TAD CHARSW      /GET SWITCH
02644  2045          ISZ CHARSW      / & BUMP IT
02645  7110          CLL RAR         /ROTATE AC 11 INTO LINK
02646  7670          SZL SNA CLA     /CHARACTER 3?
02647  5275          JMP XOPS5       /NO, CHAR 1 OR CHAR 2
02650  7240          STA
02651  1056          TAD CAD         /YES, BACK UP POINTER
02652  3056          DCA CAD
02653  7344          STA CLL RAL     / & SET LOOP COUNT TO -2
02654  3045          DCA CHARSW
02655  1035  XOPS3,  TAD CHAR        /GET REST OF CHAR
02656  7106          CLL RTL         /4 BITS LEFT
02657  7006          RTL
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 15-1

02660  3035          DCA CHAR        /SAVE IT
02661  1035          TAD CHAR        /NOW MERGE 4 BITS WITH
02662  0103          AND N7400       / A PREVIOUS CHAR
02663  4554          TADICAD
02664  4555          DCAICAD         /4 BITS OF 3RD + 1ST OR 2ND
02665  2056          ISZ CAD         /BUMP POINTER
02666  2045          ISZ CHARSW      /DONE?
02667  5255          JMP XOPS3
02670  1037          TAD CNTR        /YES, DONE ALL MODS?
02671  7650          SNA CLA
02672  5776'         JMP XMODDN      /YES, TEST FOR DONE
02673  4777' XOPS4,  JMS  CGET       /GET & TEST NEXT CHAR
02674  5243          JMP XOPS2       /OK, DO NEXT
             /
02675  4775' XOPS5,  JMS  XGET       /SET UP CURRENT LOC
02676  1035          TAD CHAR
02677  4555          DCAICAD         /AND STORE CHARACTER
02700  4566          JMS I INCI      /INCREMENT LOC
02701  2037          ISZ CNTR        /BUMP COUNTER FOR LATER
02702  5273          JMP XOPS4       / SO IGNORE SKIP NOW
02703  5273          JMP XOPS4

02704  0000  PACK,   0       /SUB. TO PACK CHARACTERS
02705  0116          AND N77         /USE ONLY 6 BITS
02706  2045          ISZ CHARSW      /CHECK HALF
02707  5316          JMP PACK1
02710  4554          TADICAD         /RIGHT HALF, ADD TO LEFT
02711  4555          DCAICAD 
02712  1037          TAD CNTR        /ALL MODS DONE?
02713  7640          SZA CLA
02714  5704          JMP I PACK      /NO
02715  5776'         JMP XMODDN      /YES
             /
02716  4543  PACK1,  JMS I RTL6I     /LEFT HALF, ROTATE INTO IT
02717  3045          DCA CHARSW      /SAVE IT
02720  4775'         JMS  XGET       /SET UP CURRENT LOC
02721  1045          TAD CHARSW
02722  4555          DCAICAD         /STORE WORD
02723  4566          JMS I INCI      /INCREMENT LOC
02724  2037          ISZ CNTR        /BUMP COUNTER FOR LATER
02725  7000          NOP             / SO DON'T SKIP NOW
02726  7240          STA
02727  3045          DCA CHARSW      /RESET SWITCH
02730  5704          JMP I PACK


02731  0000  PNAME,  0       /PRINT A FILE NAME, PADDED W. SPACES
02732  1025          TAD NAM1
02733  4535          JMS I TWOT      / OUTPUT UP TO
02734  1026          TAD NAM2
02735  4535          JMS I TWOT      / 6 CHARACTERS
02736  1027          TAD NAM3
02737  4535          JMS I TWOT      / OF FILE NAME,
02740  4526          JMS I TYPECI    / A "."
02741  0256            ".
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 15-2

02742  1030          TAD NAM4        / & UP TO 2 CHARS
02743  4535          JMS I TWOT      / OF EXTENSION.
02744  4532  PNAME1, SPACE1          /OUTPUT A " "
02745  1041          TAD NCNT        /11(10) CHARS ON LINE YET?
02746  1374          TAD (-13
02747  7710          SPA CLA
02750  5344          JMP PNAME1      /NO, OUTPUT ANOTHER SPACE
02751  5731          JMP I PNAME


             /SUBROUTINE TO GET A NUMERIC ARGUMENT FROM THE
             /  COMMAND BUFFER AND RETURN IT TO THE 3 WORDS
             /  POINTED TO BY CALL+1.  THE FIRST WORD (BLOCK
             /  NUMBER) IS NOT CHANGED IF NO BLOCK PART WAS
             /  GIVEN IN THE COMMAND.

02752  0000  LIMITS, 0
02753  1752          TAD I LIMITS    /GET ADDRESS OF 3 WORDS
02754  2352          ISZ LIMITS
02755  3331          DCA PNAME       / & SAVE IT
02756  4560          JMS I ARGI      /GET COMMAND DATA
02757  1022          TAD TEMP1       /GET BLOCK NUMBER PART
02760  2022          ISZ TEMP1       /WAS A BLOCK PART SPEC'D?
02761  3731          DCA I PNAME     / YES, STORE IT
02762  7200          CLA             /(CLEAR IN CASE NOT!)
02763  2331          ISZ PNAME       /BUMP POINTER
02764  1026          TAD ACC2
02765  0113          AND N7
02766  3731          DCA I PNAME     /STORE HIGH 3 BITS
02767  2331          ISZ PNAME
02770  1025          TAD ACC1
02771  3731          DCA I PNAME     / & LOW 12 BITS OF ADDR.
02772  5752          JMP I LIMITS


02774  7765
02775  2500
02776  2474
02777  2546
       3000  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 16

             /SUBROUTINE TO 'GET' A WORD FROM THE DEVICE.
             /
             /  THE ACTUAL WORD ON THE DEVICE THAT IS ACCESSED
             /  IS DEPENDENT ON THE MODE SWITCH, AS FOLLOWS:
             /
             /  MODE         ACTION
             /
             /  0 = NORMAL   THE HIGH 7 BITS OF THE 15 BIT ADDRESS
             /               ARE ADDED TO THE SPECIFIED BLOCK #
             /               TO GET THE ACTUAL BLOCK & THE LOW 8
             /               BITS OF THE 15 BIT ADDR ARE USED TO
             /               SPECIFY THE WORD WITHIN THE BLOCK.
             /
             / -1 = OFFSET   THE 12 BIT "OFFSET" (WHICH IS NEGATED)
             /               IS ADDED TO THE LOW 12 BITS OF THE
             /               ADDRESS, AND THEN THE NEW ADDRESS IS
             /               HANDLED AS ABOVE.
             /               THIS MODE IS USED PRIMARILY WHEN
             /               WORKING WITH THE OPERATING SYSTEM
             /               WITH OVERLAYS WHOSE REAL START BLOCK
             /               AND LOCATION WITHIN A FIELD ARE KNOWN.
             /               BY SETTING THE "OFFSET" TO THE START
             /               ADDRESS OF THE OVERLAY, ITS REAL
             /               ADDRESSES CAN BE USED AND THE PROPER
             /               LOCATIONS WILL BE ACCESSED.
             /
             / +1 = SAVE     THIS MODE IS USED WITH CORE IMAGE
             /               "SAVE" FILES ONLY.  THE FILE'S CCB
             /               (CORE CONTROL BLOCK) IS USED TO
             /               DETERMINE THE REAL LOCATION ON THE
             /               DEVICE OF THE SPECIFIED 15 BIT ADDR-
             /               ESS.  THE START BLOCK OF THE FILE
             /               IS USED, AND ANY SPECIFIED "BLOCK"
             /               PART IS USED TO SPECIFY THE OVERLAY
             /               WANTED AT THAT ADDRESS.  FOR FILES
             /               WITHOUT OVERLAYS (GENERATED BY THE
             /               MONITOR "SAVE" COMMAND), THIS PART
             /               MUST BE ZERO (0) OR NO MATCH WILL
             /               OCCUR.  FOR FILES WITH OVERLAYS
             /               (GENERATED BY THE PROGRAM "LINK"),
             /               A LEGAL OVERLAY AT THE SPECIFIED
             /               ADDRESS MUST BE SPECIFIED FOR A
             /               MATCH TO OCCUR.  THIS MODE CAN ONLY
             /               BE USED AFTER A "FILE" COMMAND.
             /
             / +2 = LOAD     THIS MODE IS USED WITH OS/8 FORTRAN
             /               IV LOAD MODULES.  THE FILE'S HEADER
             /               BLOCK IS USED TO DETERMINE THE REAL
             /               LOCATION ON THE DEVICE OF THE SPECI-
             /               FIED 15 BIT ADDRESS AND THE "BLOCK"
             /               PART IS USED TO SPECIFY THE OVERLAY
             /               WANTED AT THAT ADDRESS.  THIS MODE CAN
             /               ONLY BE USED AFTER A "FILE" COMMAND.


/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 16-1

             /CALLING SEQUENCE:
             /
             /       JMS I GETI
             /         RETURN1       /MODE=MAPPED, NO SUCH ADDRESS
             /       NORMAL RETURN   /'CAD' SET, DATA IN AC
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 17

             /SUBROUTINE 'GET'--PART OF THIS PAGE & ALL OF NEXT

03000  0000  GET,    0
03001  4534          JMS I CTRLI     /GO TEST FOR CONTROL-CHARS
03002  1044          TAD MODSW       /OK, TEST MODE
03003  7450          SNA
03004  5210          JMP GET0        /NORMAL MODE, NO CHANGES
03005  7700          SMA CLA
03006  5777'         JMP GET4        /SAVE MODE, DO MAPPING
03007  1073          TAD OFFSET      /OFFSET MODE, ADD IT
03010  4263  GET0,   JMS DBLPGS      /NOW ADD 'DOUBLE PAGES'
03011  1057          TAD BLK         / OF LOC TO BLK TO SET
03012  3054          DCA CBLK        /'CURRENT BLOCK'
03013  4227  GET1,   JMS GETIO       /OUTPUT CURREN (IF NEEDED), GET NEXT
03014  5776'           JMP RERROR    /  READ ERROR, GO TELL ABOUT IT
03015  1044          TAD MODSW       /TEST AGAIN FOR OFFSET
03016  7710          SPA CLA
03017  1073          TAD OFFSET      /YES, ADD IT AGAIN
03020  1061          TAD LOCL        /USE 8 ADDRESS BITS FROM LOC
03021  0121          AND N377
03022  1241          TAD BUFST       /INTO BUFFER, TO SET
03023  3056          DCA CAD         /'CURRENT ADDRESS'
03024  4554          TADICAD         /NOW GET THE WORD
03025  2200          ISZ GET         /RETURN TO CALL+2 WITH IT
03026  5600  GETX,   JMP I GET       /[EXIT TO CALL+1 FOR MAP FAIL]

03027  0000  GETIO,  0       /DO I/O FOR 'GET' & 'SCANER'
03030  1054          TAD CBLK        /IS THIS SAME BLOCK AS IS IN
03031  7041          CIA             /CORE CURRENTLY?
03032  1257          TAD RBLK
03033  7650          SNA CLA
03034  5261          JMP GETIO2      /YES, USE IT.
03035  2050          ISZ MODIF       /NO, ANY CHANGES IN THIS BLK?
03036  5244          JMP GETIO1      /NO, DEVICE OK AS IS
03037  4500          JMS I DEVAD     /CALL DEVICE HANDLER
03040  4210            4210          /WRITE, 2 PAGES, FIELD 1
03041  7200  BUFST,    IOBUF
03042  0000  WBLK,     0
03043  5775'           JMP WERROR    /WRITE ERROR
03044  1054  GETIO1, TAD CBLK        /NOW UPDATE OUTPUT BLOCK
03045  3242          DCA WBLK
03046  1054          TAD CBLK        / AND INPUT BLOCK #
03047  3257          DCA RBLK
03050  3050          DCA MODIF       / AND RESET SWITCH
03051  1054          TAD CBLK        /SHOW BLOCK NUMBER IN LIGHTS
03052  7421          MQL             / (IF THERE ARE ANY!)
03053  7200          CLA
03054  4500          JMS I DEVAD     /CALL DEVICE HANDLER
03055  0210            0210          /READ, 2 PAGES, FIELD 1
03056  7200            IOBUF
03057  7777  RBLK,     -1    /(NOTHING IN CORE-ILLEGAL BLK #)
03060  5627            JMP I GETIO   /READ ERROR
03061  2227  GETIO2, ISZ GETIO       /OK, DO NORMAL RETURN
03062  5627          JMP I GETIO

/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 17-1


03063  0000  DBLPGS, 0       /CONVERT LOCATION TO DOUBLE-PAGES
03064  1061          TAD LOCL
03065  0103          AND M400        /HIGH 4 BITS HERE
03066  7104          CLL RAL         /BECOME LOW 4 BITS
03067  1060          TAD LOCH        /FOR A 7 BIT VALUE
03070  7006          RTL
03071  7006          RTL
03072  5663          JMP I DBLPGS


             /GET WORD ROUTINE FOR "ODT" COMMANDS

03073  0000  ODGET,  0
03074  1070          TAD SBLK        /SET UP BLOCK
03075  3057          DCA BLK
03076  1071          TAD SLOCH
03077  3060          DCA LOCH
03100  1072          TAD SLOCL
03101  3061          DCA LOCL        /SET UP LOCATION
03102  4561          JMS I GETI      /NOW GET WORD
03103  4573  ERC05,    ERROR         /MAPPED MODE, NO SUCH ADDRESS
03104  5673          JMP I ODGET     / & RETURN WITH IT


             /OUTPUT 12 BIT BLOCK # & 15 BIT ADDRESS IN OCTAL

03105  0000  BKLOC,  0
03106  1705          TAD I BKLOC     /GET ARGUMENT (ADDR-1)
03107  2305          ISZ BKLOC
03110  3014          DCA GETPNT      / & SET UP A-XR
03111  1414          TAD I GETPNT    /GET BLOCK PART
03112  4540          JMS I OCTI      / & OUTPUT IT
03113  1414          TAD I GETPNT    /GET FIELD
03114  0113          AND N7
03115  4527          JMS I TWOCI     / & OUTPUT "." & IT
03116  5660            5660          / (".0")
03117  1414          TAD I GETPNT    /GET ADDRESS
03120  4540          JMS I OCTI      / & OUTPUT IT
03121  5705          JMP I BKLOC


             /SUBROUTINE TO GET A COMMAND WORD OR CHARACTER
             /FROM THE COMMAND BUFFER.  IF THE BUFFER CONTAINS
             /ONLY NUMERIC ITEMS, RETURN TO CALL+1. TERMINATOR
             /IS SPACE OR CR
03122  0000  GWORD,  0
03123  4564          JMS I SSKIPI    /GET NEXT NON-SPACE
03124  1035          TAD CHAR
03125  0116          AND N77         /USE THIS CHAR AS LEFT
03126  4543          JMS I RTL6I     / 6 BITS.
03127  3045          DCA CHARSW      /SAVE IT
03130  4567          JMS I SORTI     /CHECK FOR ^K, ^D, (, ", ',
03131  5350            GWLST1-1      / DIGITS, SPACE & CR
03132  0022            GWOPS1-GWLST1
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 17-2

03133  4563          JMS I GETNI     /NONE, IS NEXT A SPACE
03134  4567          JMS I SORTI     / OR A C.R.?
03135  5367            GWLST2-1
03136  0022            GWOPS2-GWLST2
03137  1035          TAD CHAR        /NONE, USE AS LOWER 6 BITS
03140  0116          AND N77
03141  1045          TAD CHARSW
03142  3045          DCA CHARSW      /SAVE IT
03143  4563  GWD1,   JMS I GETNI     /LOOK FOR SPACE OR C.R.
03144  4567          JMS I SORTI
03145  5367            GWLST2-1
03146  0022            GWOPS2-GWLST2
03147  5343          JMP GWD1        /NEITHER, KEEP LOOKING
             /
03150  7240  GWD2,   STA             /SPACE FOUND, SET SWITCH
03151  3046  GWD3,   DCA CRSWT       /CR FOUND, RESET SWITCH
03152  1045          TAD CHARSW      /RETURN WITH WORD
03153  2322          ISZ GWORD       / TO CALL+2
03154  5722  GWD4,   JMP I GWORD
             /EXIT TO CALL+1 IF ANY NUMERIC ITEM FOUND--
             /  ^K, ^D, (, ", ', DIGITS


             /"DIRECTORY" FORMAT OUTPUT ROUTINE
03155  0000  DIRDMP, 0
03156  4540          JMS I OCTI      /OUTPUT IN OCTAL FIRST
03157  4533          SPACE2
03160  4554          TADICAD
03161  4363          JMS DIROUT      / THEN 3 OTHERS
03162  5755          JMP I DIRDMP

             /"?" ODT OUTPUT ROUTINE
03163  0000  DIROUT, 0
03164  7041          CIA             /ASSUME WAS NEGATIVE
03165  4537          JMS I DECI      / & OUTPUT IN DECIMAL
03166  4533          SPACE2
03167  4554          TADICAD
03170  4542          JMS I PDATEI    /OUTPUT AGAIN AS DATE
03171  4533          SPACE2
03172  4554          TADICAD
03173  4535          JMS I TWOT      /OUTPUT LAST TIME AS PACKED ASCII
03174  5763          JMP I DIROUT


03175  2414
03176  2213
03177  3200
       3200  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 18

             /CONTINUATION OF 'GET' -- MAPPING FOR "SAVE" AND "LOAD"
             /  MODES DONE HERE.

03200  4777' GET4,   JMS DBLPGS      /GET # DOUBLE-PAGES
03201  3056          DCA CAD         / & SAVE IT
03202  7240          STA
03203  1044          TAD MODSW       /TEST FOR SAVE OR LOAD MODE
03204  7640          SZA CLA
03205  5300          JMP GETL1       / LOAD MODE
03206  6213          CDF CIF 10
03207  4776'         JMS GCCB        /SAVE MODE, GET CCB
03210  3361          DCA SEGCNT      / & SET UP # SEGMENTS
03211  1077          TAD RBLK1       /SET UP ACTUAL FIRST BLOCK
03212  7001          IAC
03213  3054          DCA CBLK        / FOR MAPPING.
03214  6211  GETS1,  CDF 10
03215  1414          TAD I GETPNT    /GET AN ORIGIN WORD
03216  3357          DCA GETORG
03217  1414          TAD I GETPNT    / & A CONTROL WORD.
03220  6201          CDF 0
03221  3360          DCA GETCW
03222  1360          TAD GETCW       /TEST FOR FIELD MATCH
03223  7112          CLL RTR
03224  7010          RAR
03225  0113          AND N7          /(MASK OFF COUNT)
03226  7041          CIA
03227  1060          TAD LOCH        /SAME?
03230  7640          SZA CLA
03231  5261          JMP GETS2       /NO, TRY NEXT SEGMENT
03232  1061          TAD LOCL        /YES, NOW TEST ADDRESSES
03233  0106          AND M200        /(MASK TO PAGE)
03234  7161          STL CIA
03235  1357          TAD GETORG      /[ORIG PAGE]-[ADDR PAGE]
03236  7460          SZA SNL         /ABOVE THE ORIGIN?
03237  5261          JMP GETS2       /NO, TRY NEXT
03240  7010          RAR             /OK, DIVIDE BY 2 (WITH SIGN)
03241  3357          DCA GETORG      / & SAVE IT.
03242  1360          TAD GETCW       /BEYOND TOP OF SEGMENT?
03243  0107          AND M100        /(MASK OFF FIELD AND MAKE)
03244  7450          SNA
03245  7130          STL RAR         / 0 => 40, THEN SUBTRACT
03246  1107          TAD M100        / ONE PAGE)
03247  1357          TAD GETORG
03250  7710          SPA CLA
03251  5261          JMP GETS2       /NO, TRY NEXT
03252  1357          TAD GETORG      /YES, UPDATE CBLK TO RIGHT
03253  7041          CIA
03254  4362          JMS UPCBLK      / ACTUAL BLOCK
03255  1057          TAD BLK         /MUST BE IN "LVL 0" OR
03256  7640          SZA CLA
03257  5775'         JMP GETX        / RETURN AS BAD
03260  5774'         JMP GET1        /NOW GO GET THE DATA
             /
03261  7200  GETS2,  CLA
03262  1360          TAD GETCW       /UPDATE CBLK
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 18-1

03263  0107          AND M100
03264  7450          SNA
03265  7130          STL RAR         /(MAKING 0 => 40)
03266  1373          TAD (100        /(ROUND UP PAGE COUNT)
03267  4362          JMS UPCBLK
03270  2361          ISZ SEGCNT      /ALL SEGMENTS DONE?
03271  5214          JMP GETS1       /NO, TRY NEXT
03272  1000          TAD OVLFLG      /YES, OVERLAYS? (LINK OUTPUT)
03273  7450          SNA
03274  5775'         JMP GETX        / NO, RETURN TO CALL+1
03275  1372          TAD (4          / YES, RESET POINTER
03276  3014          DCA GETPNT      / TO SKIP OVER LVL 0
03277  5302          JMP GETL2       / & CONTINUE
             /
03300  6213  GETL1,  CDF CIF 10
03301  4771'         JMS GHDR        /GET & TEST HEADER
03302  6211  GETL2,  CDF 10
03303  1414          TAD I GETPNT    /GET NUMBER OF OVERLAYS
03304  3361          DCA SEGCNT
03305  1414          TAD I GETPNT    /GET PAGE & FIELD
03306  3360          DCA GETCW
03307  1414          TAD I GETPNT    /GET REL BLK NUMBER
03310  1077          TAD RBLK1       / + START BLOCK
03311  3054          DCA CBLK        / = ABS START BLK, THIS LEVEL
03312  1414          TAD I GETPNT    /GET LENGTH, THESE OVERLAYS
03313  6201          CDF 0
03314  3357          DCA GETORG
03315  1360          TAD GETCW       /GET DBL-PAGE & FIELD
03316  7450          SNA
03317  5775'         JMP GETX        / 0 = THE END!!!
03320  0103          AND M400        /CONVERT TO DBL-PAGE #
03321  7106          CLL RTL
03322  7006          RTL
03323  1360          TAD GETCW       / IN BITS 5-11
03324  7004          RAL
03325  0117          AND N177
03326  7041          CIA             /-(DBL-PG # OF OVLY START)
03327  1056          TAD CAD         /+(DBL-PG # OF DESIRED)
03330  7510          SPA
03331  5345          JMP GETL3       / GONE TOO FAR, MISSED IT!
03332  3360          DCA GETCW       /= RELATIVE BLOCK NUMBER
03333  1360          TAD GETCW       /IS THIS WITHIN THIS OVLY?
03334  7041          CIA
03335  1357          TAD GETORG
03336  7750          SPA SNA CLA
03337  5302          JMP GETL2       / NO, TRY NEXT OVERLAY
03340  1057          TAD BLK         /OK, SET UP -(#LVL +1)
03341  7040          CMA
03342  3362          DCA UPCBLK      /V7B
03343  1362          TAD UPCBLK      /V7B-ADDR IS OK, IS THERE A
03344  1361          TAD SEGCNT      / LEVEL WANTED?
03345  7710  GETL3,  SPA CLA
03346  5775'         JMP GETX        /ILLEGAL LEVEL; TOO FAR--EXIT
03347  1360          TAD GETCW       /ALL OK!  ADD RELATIVE BLK
03350  7410          SKP
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 18-2

03351  1357  GETL4,  TAD GETORG      / TO (LVLS-1)*LENGTH-V7B
03352  1054          TAD CBLK
03353  3054          DCA CBLK        / TO OVERLAY START BLOCK
03354  2362          ISZ UPCBLK      /[MULTIPLY BY ADDING]-V7B
03355  5351          JMP GETL4
03356  5774'         JMP GET1
03357  0000  GETORG, 0
03360  0000  GETCW,  0
03361  0000  SEGCNT, 0

03362  0000  UPCBLK, 0
03363  4544          JMS I RTR6I     /MOVE COUNT TO BITS 6-11
03364  7110          CLL RAR         /DIVIDE FOR DOUBLE PAGES
03365  1054          TAD CBLK        /UPDATE
03366  3054          DCA CBLK
03367  5762          JMP I UPCBLK



03371  2050
03372  0004
03373  0100
03374  3013
03375  3026
03376  2000
03377  3063
       3400  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 19

             /NUMERIC OUTPUT SUBROUTINES, NO ZERO SUPPRESSION:

03400  0000  OPRT,   0       /4-DIGIT OCTAL
03401  4253          JMS NUMOUT
03402  7000          -1000
03403  7700          -100
03404  7770          -10
03405  0000          0
03406  5600          JMP I OPRT

03407  0000  OCT3,   0       /3-DIGIT OCTAL
03410  4253          JMS NUMOUT
03411  7700          -100
03412  7770          -10
03413  0000          0
03414  5607          JMP I OCT3

03415  0000  BPRT,   0       /3-DIGIT BCD
03416  4253          JMS NUMOUT
03417  7400          -400
03420  7760          -20
03421  0000          0
03422  5615          JMP I BPRT


03423  0000  SGNDP,  0       /4-DIGIT DECIMAL, SIGNED
03424  3300          DCA NUMB
03425  1300          TAD NUMB
03426  7710          SPA CLA
03427  1114          TAD N15
03430  4532          SPACE1          /OUTPUT "-" OR " "
03431  1300          TAD NUMB        /NOW OUTPUT IN DECIMAL
03432  7510          SPA
03433  7041          CIA
03434  4236          JMS DPRT
03435  5623          JMP I SGNDP

             DECIMAL

03436  0000  DPRT,   0       /4-DIGIT DECIMAL, UNSIGNED
03437  4253          JMS NUMOUT
03440  6030          -1000
03441  7634          -100
03442  7766          -10
03443  0000          0
03444  5636          JMP I DPRT

03445  0000  DEC2,   0       /2-DIGIT DECIMAL, UNSIGNED
03446  0117          AND N177        /MASK IT FIRST
03447  4253          JMS NUMOUT
03450  7766          -10
03451  0000          0
03452  5645          JMP I DEC2

             OCTAL
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 19-1


03453  0000  NUMOUT, 0       /THE REAL OUTPUT SUBROUTINE
03454  3300          DCA NUMB        /SAVE THE NUMBER
03455  3301  NUMO1,  DCA NUMDGT      /RESET "DIGIT" TO 0
03456  7300          CLA CLL
03457  1300          TAD NUMB        /GET CURRENT VALUE
03460  1653          TAD I NUMOUT    /SUBTRACT DIGIT BASE
03461  7420          SNL             /DID IT OVERFLOW?
03462  5266          JMP NUMO2       /NO, TOO FAR!
03463  2301          ISZ NUMDGT      /YES, BUMP DIGIT
03464  3300          DCA NUMB        / & UPDATE VALUE
03465  5256          JMP NUMO1+1
             /
03466  7300  NUMO2,  CLA CLL
03467  1301          TAD NUMDGT      /OUTPUT THE "DIGIT"
03470  4531          DIGIT
03471  2253          ISZ NUMOUT      /BUMP TO NEXT ARG
03472  1653          TAD I NUMOUT    /DONE ENOUGH?
03473  7640          SZA CLA
03474  5255          JMP NUMO1
03475  1300          TAD NUMB        /YES, SO OUTPUT THE LAST
03476  4531          DIGIT           / ONE.
03477  5653          JMP I NUMOUT    /AND RETURN
03500  0000  NUMB,   0
03501  0000  NUMDGT, 0

03502  0000  SSKIP,  0       /SKIP SPACES IN COMMAND BUFFER.
03503  1035          TAD CHAR
03504  1104          TAD M240        /IS THIS A SPACE?
03505  7640          SZA CLA
03506  5702          JMP I SSKIP     /NO, DONE
03507  4563          JMS I GETNI     /YES, GET NEXT CHAR
03510  5303          JMP SSKIP+1     / & GO TRY IT


             /OS/8 ASCII OUTPUT SUBROUTINE.  OUTPUTS 1 CHAR
             /  FOR EVEN WORD & 2 CHARS FOR ODD WORD.

03511  0000  OSTYPE, 0
03512  4327          JMS OSSET       /DO SETUP FOR UNPACKING
03513  4777          JMS I (ASCII    /OUTPUT CHARS TO "STANDARD"
03514  2045          ISZ CHARSW      /UNPACK 2ND CHARACTER?
03515  5340          JMP OSUNPK      / YES, & RETURN TO OSSET CALL!
03516  5711          JMP I OSTYPE    /DONE, RETURN TO CALLER


             /OS/8 "BYTE" OUTPUT SUBROUTINE.  OUTPUT ONE
             /  8-BIT OCTAL NUMBER FOR EVEN WORD AND TWO 8-
             /  BIT OCTAL NUMBERS FOR ODD WORD.  USED FOR
             /  DUMPING OS/8 ".BN" FILES OR ASCII IN OCTAL.

03517  0000  BYTEO,  0
03520  4327          JMS OSSET       /DO SETUP FOR UNPACKING
03521  4207          JMS OCT3        /3 DIGIT OCTAL OUTPUT
03522  2045          ISZ CHARSW      /UNPACK 2ND "CHAR"?
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 19-2

03523  7410          SKP
03524  5717          JMP I BYTEO     / DONE, RETURN
03525  4533          SPACE2          /YES, BUT OUTPUT 2 SPACES
03526  5340          JMP OSUNPK      / BEFORE DOING UNPACKING


             /OS/8 FORMAT UNPACKING ROUTINES FOR 'OSTYPE' AND
             /  'BYTEO'.  THE SUBROUTINE SETS UP THE COUNTER
             /  FOR NUMBER OF OUTPUTS TO DO, SAVING & RESTORING
             /  THE AC.  THE ROUTINE WILL BE CALLED ONLY IF 2
             /  OUTPUTS BEING DONE AND DOES THE UNPACK OF THE
             /  2ND "CHARACTER", RETURNING TO THE CALLER OF THE
             /  SUBROUTINE!

03527  0000  OSSET,  0       /ENTER HERE TO INITIALIZE
03530  3357          DCA INC         /SAVE AC
03531  7001          IAC
03532  0061          AND LOCL        /AC = 0 OR 1
03533  7040          CMA             /AC = -1 OR -2 (-# TO DO)
03534  3045          DCA CHARSW      /SET UP UNPACK COUNT
03535  1357  OSRETN, TAD INC         /GET VALUE TO AC
03536  0121          AND N377        /MASK TO 8 BITS
03537  5727          JMP I OSSET
             /
03540  7240  OSUNPK, STA     /JUMP HERE IF 2ND CHAR TO GET
03541  1056          TAD CAD
03542  3223          DCA SGNDP       /POINT TO HIGH WORD
03543  6211          CDF 10
03544  1456          TAD I CAD       /GET LOW BITS OF "CHAR"
03545  0103          AND N7400       / MASK TO 4 BITS AND
03546  4544          JMS I RTR6I     / MOVE TO BITS 8-11
03547  7012          RTR
03550  3357          DCA INC         /SAVING IT HERE FOR LATER!
03551  1623          TAD I SGNDP     /NOW GET HIGH BITS OF "CHAR"
03552  0103          AND N7400       / MASK TO 4 BITS AND
03553  6201          CDF 0
03554  7112          CLL RTR         / MOVE TO BITS 4-7
03555  7012          RTR
03556  5335          JMP OSRETN      /GET OTHER BITS & RETURN!


             /SUBROUTINE TO INCREMENT THE "CURRENT LOCATION"

03557  0000  INC,    0
03560  2061          ISZ LOCL        /INCREMENT LOW 12 ADDR BITS
03561  5757          JMP I INC       /OK AS IS
03562  7100          CLL
03563  1060          TAD LOCH        /LOW OVERFLOW, INCR. HIGH
03564  1376          TAD (7771       / 3 ADDRESS BITS (& TEST)
03565  0113          AND N7
03566  3060          DCA LOCH
03567  7430          SZL             /DID HIGH OVERFLOW ALSO?
03570  1120          TAD N200        / YES, THEN BUMP BLK ALSO
03571  1057          TAD BLK
03572  3057          DCA BLK
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 19-3

03573  5757          JMP I INC


03576  7771
03577  2163
       3600  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 20

             /OUTPUT PACKED STRING, ADDRESS IN CALL+1,
             / TERMINATOR IS XX00.
03600  0000  TYPES,  0
03601  1600          TAD I TYPES
03602  2200          ISZ TYPES
03603  4205          JMS TYPSTR
03604  5600          JMP I TYPES

             /OUTPUT PACKED STRING, ADDRESS IN AC, TERMIN IS XX00
03605  0000  TYPSTR, 0
03606  3341          DCA GETNT
03607  6211  TTAGN,  CDF 10
03610  1741          TAD I GETNT
03611  6201          CDF 0
03612  2341          ISZ GETNT
03613  4221          JMS PACOUT
03614  1276          TAD GNAME
03615  0116          AND N77
03616  7650          SNA CLA
03617  5605          JMP I TYPSTR
03620  5207          JMP TTAGN

             /PACKED ASCII OUTPUT ROUTINE
03621  0000  PACOUT, 0
03622  3276          DCA GNAME
03623  1276          TAD GNAME       /USE LEFT 6 BITS
03624  4544          JMS I RTR6I
03625  4231          JMS ONECHR
03626  1276          TAD GNAME       /USE RIGHT 6 BITS
03627  4231          JMS ONECHR
03630  5621          JMP I PACOUT

             /OUTPUT TRIMMED OR UNTRIMMED ASCII IN THE AC
03631  0000  ONECHR, 0       /NO CODE FOR CR/LF
03632  0116          AND N77
03633  7450          SNA
03634  5631          JMP I ONECHR    /IGNORE "@"
03635  1377          TAD (-40
03636  7500          SMA
03637  1107          TAD M100
03640  4526          JMS I TYPECI
03641  0340            340
03642  5631          JMP I ONECHR


             /SUBROUTINE TO MATCH CHAR AGAINST LIST1 AND JUMP
             /THROUGH LIST2 WHEN MATCH FOUND.  BOTH LISTS IN
             /FIELD 1.

03643  0000  SORTJ,  0
03644  7450          SNA
03645  1035          TAD CHAR        /USE CHAR IF AC = 0
03646  3275          DCA SORTEM      /ITEM TO LOOK UP
03647  1643          TAD I SORTJ
03650  2243          ISZ SORTJ       /GET LIST1 ADDRESS
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 20-1

03651  3012          DCA SCANX1
03652  6211  SORT1,  CDF 10
03653  1412          TAD I SCANX1    /COMPARE WITH SORTEM
03654  6201          CDF 0
03655  7450          SNA             /0 ?
03656  5273          JMP SORT2       /END OF LIST
03657  7161          CIA STL
03660  1275          TAD SORTEM
03661  7640          SZA CLA         /DOES IT MATCH?
03662  5252          JMP SORT1       /NO, TRY NEXT
03663  1012          TAD SCANX1      /YES, GET ADDRESS...
03664  1643          TAD I SORTJ
03665  3243          DCA SORTJ       /...OF JUMP ADDRESS
03666  6211          CDF 10
03667  1643          TAD I SORTJ
03670  3243          DCA SORTJ
03671  6201          CDF 0
03672  5643          JMP I SORTJ     /GO TO ROUTINE
03673  2243  SORT2,  ISZ SORTJ       /MATCH NOT FOUND,
03674  5643          JMP I SORTJ     /EXIT TO CALL+3
03675  0000  SORTEM, 0


             /SUBROUTINE TO GET A NAME FOR 'XOPEN', 'XFILE', 'XDEV' & 'XDDEV'

03676  0000  GNAME,  0       /GET A FILE OR DEVICE NAME
03677  3022          DCA TEMP1       /SET UP "." SWITCH AND
03700  1022          TAD TEMP1       / FILE/DEVICE SWITCH
03701  3023          DCA TEMP2
03702  3025          DCA NAM1
03703  3026          DCA NAM2        /CLEAR NAME AREA
03704  3027          DCA NAM3
03705  1376          TAD (2326       / & INIT EXTENSION TO "SV"
03706  3030          DCA NAM4
03707  1375          TAD (NAM1       / & INIT POINTER FOR NAME
03710  3021          DCA TEMP
03711  4564          JMS I SSKIPI    /SKIP LEADING SPACES
03712  7240          STA
03713  1016          TAD COMOUT      /BACK UP THE POINTER
03714  3016          DCA COMOUT
03715  4351          JMS GPAIR       /1ST & 2ND CHAR
03716  4351          JMS GPAIR       /3RD & 4TH
03717  4351  GETSCN, JMS GPAIR       /5TH & 6TH OR 1ST & 2ND EXT.
03720  4341          JMS GETNT       /SCAN FOR TERMINATOR
03721  7200          CLA
03722  5320          JMP .-2
             /
03723  1023  GETCOL, TAD TEMP2       /":" SEEN, DEVICE OR FILE NAME?
03724  7640          SZA CLA
03725  5346          JMP GETNTC      / FILE, JUST USE THE ":"
03726  2023          ISZ TEMP2       / DEVICE, FLAG ":" SEEN
03727  5320          JMP GETSCN+1    /  AND SCAN TO TERMIN.
             /
03730  2022  GETPER, ISZ TEMP1       /"." FOUND, FIRST ONE?
03731  4573  ERCM,   ERROR           /NO, THE END...
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 20-2

03732  3030          DCA NAM4        /YES, RESET EXT,
03733  1374          TAD (NAM4       / SET POINTER
03734  3021          DCA TEMP
03735  5317          JMP GETSCN      / & GO GET IT
             /
03736  7240  GETEND, STA             /TERM = SPACE, SET SWITCH
03737  3046          DCA CRSWT       /TERM = CR, RESET SWITCH
03740  5676          JMP I GNAME     /..DONE....

03741  0000  GETNT,  0       /GET & TEST A CHAR
03742  4563          JMS I GETNI     /GET NEXT CHAR
03743  4567          JMS I SORTI     /TEST IT
03744  5444            GETLST-1
03745  0005            GETOPS-GETLST
03746  1035  GETNTC, TAD CHAR        /OK, USE CHAR
03747  0116          AND N77         /MASK TO 6 BITS
03750  5741          JMP I GETNT     / & EXIT WITH IT

03751  0000  GPAIR,  0       /GET RIGHT/LEFT-HALF-CHARS
03752  4341          JMS GETNT
03753  4543          JMS I RTL6I     /TO LEFT HALF
03754  3421          DCA I TEMP      / & STORE IT
03755  4341          JMS GETNT
03756  1421          TAD I TEMP      /MERGE WITH LAST LEFT
03757  3421          DCA I TEMP
03760  2021          ISZ TEMP        /BUMP POINTER
03761  5751          JMP I GPAIR

03762  0000  RTL6,   0       /ROTATE AC 6 LEFT
03763  7106          CLL RTL
03764  7006          RTL
03765  7006          RTL
03766  5762          JMP I RTL6

03767  0000  RTR6,   0       /ROTATE AC 6 RIGHT
03770  7112          CLL RTR
03771  7012          RTR
03772  7012          RTR
03773  5767          JMP I RTR6


03774  0030
03775  0025
03776  2326
03777  7740
       4000  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 21

             /SUBROUTINE TO READ A "LINE" FROM THE USER.  IT CHECKS FOR
             /  RUBOUT, ^U AND ^R FIRST, THEN CHECKS FOR ONE OF A LIST OF
             /  TERMINATORS PASSED BY THE CALLER.  AS WITH OS/8, RUBOUT
             /  DELETES CHARACTES AND ^U DELETES THE CURRENT LINE.  ^R
             /  (FOR RETYPE) ECHOES THE CURRENT COMMAND BUFFER IN THE SAME
             /  MANNER AS LINE-FEED DOES FOR OS/8.  IF THE CHARACTER IS A
             /  TERMINATOR, CONTROL PASSES DIRECTLY TO THE CORRESPONDING
             /  CALLER ROUTINE (OUT OF THIS ROUTINE).  INPUT CHARACTERS
             /  ARE ALSO TRANSLATED FROM LOWER CASE TO UPPER CASE.  EXIT
             /  IN THE NORMAL MANNER OCCURS ONLY ON BUFFER EMPTY FROM
             /  RUBOUT OR ^U.

04000  0000  READ,   0       /READ AND ECHO INPUT CHARACTER
04001  1600          TAD I READ      /GET TWO LIST ADDRESS PARAMETERS
04002  2200          ISZ READ
04003  3220          DCA RETERM      / FROM CALLER AND SET UP IN
04004  1600          TAD I READ      / SORT ROUTINE CALL
04005  2200          ISZ READ
04006  3221          DCA RETERM+1
04007  4312  RENEXT, JMS RKEY        /GET A CHAR
04010  5231            JMP RUBO      /RUBOUT, GO BEGIN DELETIONS
04011  3035  REKEY,  DCA CHAR
04012  4567          JMS I SORTI     /CHECK FOR CTRL-R & CTRL-U
04013  5523            REACTL-1
04014  0003            REACTS-REACTL
04015  1035          TAD CHAR
04016  4536          JMS I TYPEI
04017  4567          JMS I SORTI     /CHECK FOR CALLER TERMINATORS
04020  0000  RETERM,   0             / PARAMETERS HERE
04021  0000            0
04022  1035          TAD CHAR        /NONE, JUST STORE IN BUFFER
04023  7410          SKP
04024  1377  RESPC,  TAD ("          /FOR CAMMAND INPUT, TAB -> SPACE!
04025  6211          CDF 10
04026  3415          DCA I COMIR     /COMMAND (LINE) INPUT BUFFER
04027  6201          CDF 0
04030  5207          JMP RENEXT
             /
             /+++    FOR SCOPE OPERATION, RUBOUTS CAUSE OUTPUT OF THE
             /+++    SEQUENCE BACKSPACE, SPACE, BACKSPACE TO CLEAR THE
             /+++    PREVIOUS CHARACTER FROM THE SCREEN.  IF "SCOPE
             /+++    MODE" IS SET, RUBO IS OVERLAID ON STARTUP.

             /***    FOR BATCH OPERATION, RUBOUTS ARE IGNORED BY 'RKEY'
             /***    AND 'RUBO' IS OVERLAID WITH CODE TO IGNORE A LINE-
             /***    FEED THAT FOLLOWS A CARRIAGE-RETURN.
             /
04031  4303  RUBO,   JMS BTEST       /RUBOUT TYPED,TEST FOR EMPTY
04032  5261          JMP RUBOF       / INPUT BUFFER EMPTY!
04033  4526          JMS I TYPECI    /OK, OUTPUT 1ST "\"
04034  0334            "\
04035  4303  RUBO1,  JMS BTEST       /NOW EMPTY?
04036  5257          JMP RUBOE       / YES, LINE END
04037  1015          TAD COMIR       /ECHO LAST CHAR IN BUFFER
04040  3341          DCA ENDC
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 21-1

04041  6211          CDF 10
04042  1741          TAD I ENDC
04043  6201          CDF 0
04044  4536          JMS I TYPEI
04045  7240          STA
04046  1015          TAD COMIR       /NOW BACK UP POINTER
04047  3015          DCA COMIR
04050  4312          JMS RKEY        /GET A CHAR
04051  5235            JMP RUBO1     /ANOTHER RUBOUT, GO HANDLE
04052  3303          DCA BTEST       /SAVE THE CHAR
04053  4526          JMS I TYPECI    / DO CLOSING "\"
04054  0334            "\
04055  1303          TAD BTEST
04056  5211          JMP REKEY       /& GO USE NEW CHAR
             /
04057  4526  RUBOE,  JMS I TYPECI    /BUFFER WAS EMPTIED,
04060  0334            "\            /OUTPUT CLOSING "\"
04061  4530  RUBOF,  JMS I CRLFI     / & A CR/LF
04062  5600          JMP I READ
             /
04063  4526  RECHO,  JMS I TYPECI    /ECHO "^R" & THEN
04064  0222            "R-100
04065  4530          JMS I CRLFI     /ECHO CURRENT LINE
04066  1174          TAD COMST       /INIT AUTO-XR
04067  3016          DCA COMOUT
04070  1016  RECHO1, TAD COMOUT      /DONE?
04071  7041          CIA
04072  1015          TAD COMIR
04073  7650          SNA CLA
04074  5207          JMP RENEXT      /YES, MORE INPUT
04075  4563          JMS I GETNI     /NO, GET NEXT CHAR
04076  4536          JMS I TYPEI     / & OUTPUT IT
04077  5270          JMP RECHO1      / & CONTINUE
             /
04100  4526  RERASE, JMS I TYPECI    /OUTPUT "^U"
04101  0225            "U-100
04102  5261          JMP RUBOF       /GO OUTPUT CR/LF & EXIT

04103  0000  BTEST,  0       /TEST FOR COMM. BUFFER EMPTY
04104  1015          TAD COMIR
04105  7041          CIA
04106  1174          TAD COMST
04107  7640          SZA CLA         /EMPTY?
04110  2303          ISZ BTEST       /NO, STILL OK, TO CALL+2
04111  5703          JMP I BTEST     / OTHERWISE TO CALL+1
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 22

04112  0000  RKEY,   0       /GET A NON-NULL CHAR, TEST & TRANSLATE
04113  6031          KSF             /***    JMS I CTRLI     /CHECK KEYBOARD
04114  5313          JMP .-1         /***    CIF BAT         /BATCH OPER.
04115  4534          JMS I CTRLI     /***    JMS I BATINI
04116  6031          KSF             /***    ERROR           /EOF!!
04117  5313          JMP RKEY+1      /***    NOP     /MUST USE SPECIAL CARE
04120  6036          KRB             /***    NOP     / TO HANDLE CTRL-Q!
04121  0117          AND N177        /MASK OFF PARITY
04122  7450          SNA
04123  5313          JMP RKEY+1      /NULL CHAR
04124  1376          TAD (-177       /IS IT A RUBOUT?
04125  7450          SNA
04126  5712  RKEY0,  JMP I RKEY      /YES, EXIT TO CALL+1    /*** BATCH
04127  2312          ISZ RKEY        /NO, EXIT TO CALL+2     /*** OPER.
04130  1375          TAD (2          /TEST FOR ALT-MODES
04131  7500          SMA
04132  5337          JMP RKEY1       / 375 OR 376
04133  1374          TAD (35         /IS IT LOWER CASE?
04134  7500          SMA
04135  1373          TAD (-40        /YES, MAKE UPPER CASE
04136  1372          TAD (-35
04137  1371  RKEY1,  TAD (375        /RESTORE CHAR & ADD PARITY
04140  5712          JMP I RKEY      / & EXIT WITH IT


             /SUBROUTINE TO TERMINATE COMMAND BUFFER WITH A C.R.
             /RETURN TO CALL+1 IF ONLY A CR (EXCLUDING LEADING
             /SPACES) IN BUFFER, TO CALL+2 IF ANYTHING ELSE.
04141  0000  ENDC,   0
04142  1370          TAD (215        /PUT A CR IN BUFFER
04143  6211          CDF 10
04144  3415          DCA I COMIR
04145  6201          CDF 0
04146  1174          TAD COMST       /INIT'L BUFFER UNLOAD
04147  3016          DCA COMOUT
04150  1035          TAD CHAR        /SAVE CHAR FOR POSSIBLE
04151  3021          DCA TEMP        / USE BY 'WCHEK'
04152  4563          JMS I GETNI     /GET FIRST CHARACTER
04153  4564          JMS I SSKIPI    /SKIP LEADING SPACES
04154  1035          TAD CHAR        /GET 1ST NON-SPACE
04155  1105          TAD M215        /IS IT A CR?
04156  7640          SZA CLA         /YES, NOTHING IN BUFFER
04157  2341          ISZ ENDC        /OTHERWISE RETURN TO CALL+2
04160  5741          JMP I ENDC


04161  0000  DODIG,  0       /OUTPUT AC AS AN ASCII DIGIT
04162  4526          JMS I TYPECI
04163  0260            "0
04164  5761          JMP I DODIG


04170  0215
04171  0375
04172  7743
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 22-1

04173  7740
04174  0035
04175  0002
04176  7601
04177  0240
       4200  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 23

             /'FPP'/OCTAL/'PDP' OUTPUT ROUTINE FOR ODT
04200  0000  ODTOUT, 0
04201  1017          TAD TYPSW       /-1, 0, +1
04202  1377          TAD (TAD ODTOL  /GENERATE ADDRESS OF DESIRED
04203  3204          DCA ODTOPT      / OUTPUT ROUTINE
04204  7402  ODTOPT, HLT             /[USED TWICE!]
04205  3204          DCA ODTOPT
04206  4562          JMS I ODGETI    /GET SPECIFIED WORD
04207  4604          JMS I ODTOPT    / & OUTPUT IT
04210  5600          JMP I ODTOUT

04211  4400          FPPDMP          /-1 = OCTAL + FPP
04212  3400  ODTOL,  OPRT            / 0 = OCTAL
04213  4214          PDPDMP          /+1 = OCTAL + PDP


             /OCTAL & 'PDP' (SYMBOLIC) DUMP ROUTINE
04214  0000  PDPDMP, 0
04215  4540          JMS I OCTI      /FIRST OUTPUT IN OCTAL
04216  4533          SPACE2          /FOLLOWED BY 2 SPACES,
04217  4221          JMS PDPOUT      / & THEN AS 'PDP'
04220  5614          JMP I PDPDMP


             /'PDP' (SYMBOLIC) INSTRUCTION DECODING
04221  0000  PDPOUT, 0
04222  7200          CLA
04223  4776'         JMS OPRTST      /TEST FOR OPR & IOT
04224  5262          JMP OPRS        /  OPR
04225  4775'         JMS IOPRNT      /  IOT
04226  4774' SYMS,   JMS GETOP       /GET OP-CODE TO BITS 9-11
04227  7004          RAL             / * 2
04230  4773'         JMS SYMTYP      /OUTPUT 3 CHAR SYMBOL & SPACE
04231  2600            INSLST        /(TABLE FOR INDEXING)
04232  7776            -2            /(- # WORDS)
04233  4776'         JMS OPRTST      /TEST FOR OPR & IOT
04234  5256          JMP SYMEND      /  OPR, DONE
04235  5257          JMP IOTS        /  IOT
04236  4554          TADICAD         /MEMORY REF., INDIRECT?
04237  0372          AND (400
04240  7650          SNA CLA
04241  5244          JMP REFS1       /NO
04242  4527          JMS I TWOCI     /YES, OUTPUT "I "
04243  1140            1140
04244  4554  REFS1,  TADICAD         /SET UP ADDR BITS
04245  0117          AND N177
04246  3771'         DCA BITVAL      /SAVE THEM
04247  4554          TADICAD         /IS THIS A 'PAGE 0 REF'?
04250  0120          AND N200
04251  7640          SZA CLA
04252  1061          TAD LOCL        /NO, USE PAGE BITS
04253  0106          AND M200
04254  1771'         TAD BITVAL      /OK, NOW ADD ADDR BITS
04255  4540  REFS2,  JMS I OCTI      /OUTPUT IN OCTAL
04256  5621  SYMEND, JMP I PDPOUT    /DONE, RETURN
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 23-1


             /
04257  4554  IOTS,   TADICAD         /USE ONLY LAST 9 BITS
04260  0370          AND (777
04261  5255          JMP REFS2       /AND OUTPUT IN OCTAL
             /
04262  4554  OPRS,   TADICAD         /IS THIS A NOP?
04263  0370          AND (777
04264  7450          SNA
04265  5226          JMP SYMS        /YES, OUTPUT "NOP "
04266  0120          AND N200        /IS THERE A CLA IN IT?
04267  7650          SNA CLA
04270  5275          JMP OPRS1       /NO, CONTINUE
04271  4773'         JMS SYMTYP      /YES, OUTPUT "CLA "
04272  2726            CLANAM
04273  7776            -2
04274  7001          IAC
04275  3036  OPRS1,  DCA CNT         /SET ANYTHING OUTPUT SWITCH
04276  4554          TADICAD         /SET UP WORD FOR DECODE
04277  4543          JMS I RTL6I
04300  7010          RAR
04301  3771'         DCA BITVAL      /SAVE IT
04302  4554          TADICAD         /CHECK FOR OPR1, OPR2 OR EAE
04303  7110          CLL RAR
04304  0120          AND N200
04305  7450          SNA
04306  5333          JMP OPR1A       /OPR1 MICRO-INSTRUCTION
04307  7620          SNL CLA
04310  5767'         JMP OPR2A       /OPR2 MICRO-INSTRUCTION
             /
             /DO THE DOCODING FOR THE EAE MICRO-INSTRUCTIONS
04311  1366  EAE,    TAD (EAELST-2   /SET UP EAE LIST POINTER
04312  3765'         DCA BITPNT
04313  4764'         JMS BITS        /SHIFT & CHECK BIT 5
04314  4763'         JMS OPRTYP      /IF = 1, "MQA "
04315  1771'         TAD BITVAL      /CHECK BIT 6
04316  7104          CLL RAL         /("SCA" IN "A" MODE OF 8/E
04317  3771'         DCA BITVAL      / 'MODE BIT' IN "B" MODE)
04320  7430          SZL
04321  1115          TAD N20         /IF ON, USE OTHER WORDS
04322  3332          DCA EAETMP
04323  4764'         JMS BITS        /CHECK BIT 7
04324  4763'         JMS OPRTYP      / "MQL "
04325  4554          TADICAD 
04326  0362          AND (16
04327  1332          TAD EAETMP      /(ADD SWITCH WORD)
04330  4761'         JMS SYMLIM      /CHECK FOR & OUTPUT LAST INST.
04331  7742            -36           /UPPER LIMIT
04332  0000  EAETMP, 0
             /
             /DO THE DECODING FOR THE OPR1 MICRO-INSTRUCTIONS
04333  1360  OPR1A,  TAD (OP1LST-2   /SET OPR1 LIST
04334  3765'         DCA BITPNT
04335  4764'         JMS BITS        /SHIFT & CHECK BIT 5
04336  4763'         JMS OPRTYP      /IF = 1, OUTPUT "CLL "
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 23-2

04337  4764'         JMS BITS        /CHECK BIT 6
04340  4763'         JMS OPRTYP      / "CMA "
04341  4764'         JMS BITS        /CHECK BIT 7
04342  4763'         JMS OPRTYP      / "CML "
04343  2765'         ISZ BITPNT      /BUMP POINTER
04344  2765'         ISZ BITPNT
04345  4554          TADICAD         /LOOK FOR IAC
04346  7010          RAR
04347  7630          SZL CLA
04350  4763'         JMS OPRTYP      /OUTPUT "IAC "
04351  4554          TADICAD         /SET UP TO CHECK FOR ROTATES
04352  0362          AND (16
04353  4761'         JMS SYMLIM      /CHECK & OUTPUT
04354  7766            -12           /UPPER LIMIT


04360  2616
04361  4433
04362  0016
04363  4467
04364  4456
04365  4471
04366  2662
04367  4405
04370  0777
04371  4522
04372  0400
04373  4475
04374  6243
04375  4523
04376  4547
04377  1212
       4400  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 24

             /OCTAL & 'FPP' (SYMBOLIC) DUMP ROUTINE
04400  0000  FPPDMP, 0
04401  4540          JMS I OCTI      /FIRST OUTPUT IN OCTAL
04402  4533          SPACE2          / THEN 2 SPACES
04403  4777'         JMS FPPOUT      / & THEN AS FPP
04404  5600          JMP I FPPDMP

             /THE FOLLOWING ROUTINES ARE USED BY 'PDPOUT'

             /DO THE DECODING FOR THE OPR2 MICROINSTRUCTIONS
04405  1376  OPR2A,  TAD (OP2LST-2   /SET UP LIST POINTER
04406  3271          DCA BITPNT
04407  4256          JMS BITS        /SHIFT & CHECK BIT 5
04410  4315          JMS OPR2T       /IF 1, OUTPUT "SMA " OR "SPA "
04411  4256          JMS BITS        /CHECK BIT 6
04412  4315          JMS OPR2T       / "SZA " OR "SNA "
04413  4256          JMS BITS        /CHECK BIT 7
04414  4315          JMS OPR2T       / "SNL " OR "SZL "
04415  4256          JMS BITS        /CHECK BIT 8
04416  7410          SKP
04417  5224          JMP OPR2B       /IT WAS 0
04420  4554          TADICAD         /MUST CHECK FOR "SKP "
04421  0375          AND (160
04422  7650          SNA CLA         /ARE ALL SKIP SENSES = 0?
04423  4267          JMS OPRTYP      /YES, SO OUTPUT "SKP "
04424  1374  OPR2B,  TAD (OP2LST+14  /SET UP CHECK FOR OSR & HLT
04425  3271          DCA BITPNT
04426  4256          JMS BITS        /CHECK BIT 9
04427  4267          JMS OPRTYP      / "OSR "
04430  4256          JMS BITS        /CHECK BIT 10
04431  4267          JMS OPRTYP      / "HLT "
04432  5246          JMP OPEND       /CHECK FOR ANY DONE

04433  0000  SYMLIM, 0       /CHECK LAST SYMBOL AGAINST LIMIT
04434  3035          DCA CHAR        /SAVE AC
04435  1035          TAD CHAR
04436  7550          SPA SNA         /IS IT > 0?
04437  5246          JMP OPEND       /NO, TEST IF ANY OUTPUT DONE
04440  1633          TAD I SYMLIM    /IT IS > UPPER LIMIT?
04441  7740          SMA SZA CLA
04442  5246          JMP OPEND       /NO, GO CHECK AGAIN
04443  1035          TAD CHAR        /CALCULATE ADDRESS
04444  4267          JMS OPRTYP      / & OUTPUT LAST
04445  5773'         JMP SYMEND      /...DONE
             /
04446  7200  OPEND,  CLA
04447  1036          TAD CNT         /ANYTHING OUTPUT?
04450  7640          SZA CLA
04451  5773'         JMP SYMEND      /YES, DONE WITH OUTPUT
04452  4275          JMS SYMTYP      /NO, OUTPUT "OPR "
04453  2730            OPRMES
04454  7776            -2
04455  5772'         JMP IOTS        /NOW GO OUTPUT LAST 9 BITS

04456  0000  BITS,   0       /DECODE A WORD ONE BIT AT A TIME
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 24-1

04457  1322          TAD BITVAL      /SHIFT A BIT INTO LINK
04460  7104          CLL RAL
04461  3322          DCA BITVAL      /SAVE FOR LATER
04462  2271          ISZ BITPNT      /BUMP SYMBOL POINTER
04463  2271          ISZ BITPNT
04464  7420          SNL
04465  2256          ISZ BITS        /TO CALL+2 IF L = 0
04466  5656          JMP I BITS

04467  0000  OPRTYP, 0       /OUTPUT AN OPR SYMBOL
04470  4275          JMS SYMTYP      /OUTPUT THE SYMBOL
04471  0000  BITPNT,   0             /ADDRESS
04472  7776            -2
04473  2036          ISZ CNT         /SET SWITCH
04474  5667          JMP I OPRTYP

04475  0000  SYMTYP, 0       /OUTPUT A SYMBOL
04476  1675          TAD I SYMTYP    /ADD TABLE ADDR TO ANY INDEX
04477  2275          ISZ SYMTYP
04500  3314          DCA SYMPNT      /SAVE POINTER
04501  1675          TAD I SYMTYP    /GET COUNT OF WORDS
04502  2275          ISZ SYMTYP
04503  3256          DCA BITS        / & SAVE IT
04504  6211  SYMNXT, CDF 10          /"SYMBOL"S IN FIELD 1
04505  1714          TAD I SYMPNT
04506  6201          CDF 0
04507  4535          JMS I TWOT      /OUTPUT A PAIR OF LETTERS
04510  2314          ISZ SYMPNT
04511  2256          ISZ BITS        /DONE?
04512  5304          JMP SYMNXT
04513  5675          JMP I SYMTYP
04514  0000  SYMPNT, 0

04515  0000  OPR2T,  0       /OUTPUT AN OPR2 SYMBOL
04516  4554          TADICAD 
04517  0371          AND (10         /IF BIT IS ON, REVERSE THE
04520  4267          JMS OPRTYP      /SENSE OF THE SKIP
04521  5715          JMP I OPR2T

04522  0000  BITVAL, 0


04523  0000  IOPRNT, 0       /OUTPUT I/O NAMES
04524  1370          TAD (IOTTAB     /SET UP POINTER
04525  3344  IOPRN1, DCA IOPNT       /SET (OR UPDATE) POINTER
04526  6211          CDF 10
04527  1744          TAD I IOPNT     /GET NEXT IOT
04530  6201          CDF 0
04531  7450          SNA             /AT END OF TABLE?
04532  5723          JMP I IOPRNT    /YES, CODE NOT FOUND
04533  7041          CIA
04534  4554          TADICAD         /NO,  DO THEY MATCH?
04535  7650          SNA CLA
04536  5342          JMP IOPRN2      /YES, OUTPUT NAME
04537  1367          TAD (4          /NO, UPDATE POINTER
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 24-2

04540  1344          TAD IOPNT
04541  5325          JMP IOPRN1      / & TRY AGAIN
             /
04542  7001  IOPRN2, IAC             /WORD FOLLOWS CODE
04543  4275          JMS SYMTYP      /OUTPUT THE MNEMONIC
04544  0000  IOPNT,    0
04545  7775            -3
04546  5773'         JMP SYMEND      / & RETURN


04547  0000  OPRTST, 0       /TEST "INSTRUCTION" FOR OPR & IOT
04550  4554          TADICAD         /GET WORD
04551  0122          AND N7000       /MASK OFF OP CODE
04552  1366          TAD (1000       /IS IT AN OPR?
04553  7450          SNA
04554  5747          JMP I OPRTST    /YES, EXIT TO CALL+1
04555  2347          ISZ OPRTST
04556  1366          TAD (1000       /IS IT AN IOT?
04557  7640          SZA CLA
04560  2347          ISZ OPRTST      /NO, EXIT TO CALL+3
04561  5747          JMP I OPRTST    / YES, TO CALL+2


04566  1000
04567  0004
04570  2732
04571  0010
04572  4257
04573  4256
04574  2656
04575  0160
04576  2640
04577  4600
       4600  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 25

             /'FPP' (SYMBOLIC) INSTRUCTION DECODING
04600  0000  FPPOUT, 0
04601  7200          CLA             /HARD TO TELL WHAT MIGHT COME!
04602  4554          TADICAD         /GET THE WORD
04603  0377          AND (600        /MASK OFF MODE BITS
04604  7450          SNA
04605  5254          JMP SPECIAL     / NON-ARITHMETIC
04606  1103          TAD M400        /GIVES: -=BASE, 0=LONG, +=INDIR.
04607  3023          DCA TEMP2
04610  4776'         JMS GETOP       /GET OP-CODE TO BITS 9-11
04611  4775' FPLEA,  JMS MULT3       /MULTIPLY BY 3 (WORDS/OP OUT)
04612  4774'         JMS SYMTYP      /OUTPUT 6 CHAR OPR SYMBOL
04613  3757            FPPINS        /(INCLUDING "LEA")
04614  7775            -3
04615  1023          TAD TEMP2       /NOW HANDLE MODE
04616  7450          SNA
04617  5240          JMP LONG        / LONG INDEXED
04620  7700          SMA CLA
04621  5231          JMP INDIR       / INDIRECT INDEXED
04622  4525  BASE,   JMS I TYPSI     / BASE - OUTPUT "  B+"
04623  3743            MSBASE
04624  4554          TADICAD         /GET WORD AGAIN
04625  0117          AND N177        / MASK OFF OFFSET
04626  4775'         JMS MULT3       / MULTIPLY IT BY 3
04627  4773'         JMS OCT3        / & OUTPUT IN OCTAL
04630  5600          JMP I FPPOUT
             /
04631  4525  INDIR,  JMS I TYPSI     /OUTPUT "% B+"
04632  3746            MSINDI
04633  4554          TADICAD         /GET WORD AGAIN
04634  0113          AND N7          / MASK OFF OFFSET
04635  4775'         JMS MULT3       / MULTIPLY IT BY 3
04636  4773'         JMS OCT3        / & OUTPUT IT IN OCTAL
04637  5243          JMP XRPLUS      /FINALLY DO XR OUTPUT
             /
04640  4527  LONG,   JMS I TWOCI     /OUTPUT "# "
04641  4340            4340
04642  4772'         JMS FLDOUT      /AND FIELD AND "*"
04643  4771' XRPLUS, JMS GET678      /GET XR FIELD
04644  4527          JMS I TWOCI     / & OUTPUT ",X" WHERE
04645  5460            5460          / "X" IS A DIGIT
04646  4554          TADICAD         /GET WORD THE LAST TIME
04647  0370          AND (100        / AND CHECK "+" BIT
04650  7640          SZA CLA
04651  4526          JMS I TYPECI    /OUTPUT "+" OR SKIP
04652  0253            "+            /[A NOP]
04653  5600          JMP I FPPOUT
             /
04654  4776' SPECIAL,JMS GETOP       /GET OP-CODE
04655  4567          JMS I SORTI     / & BRANCH ON IT
04656  4121            FPPMO0-1
04657  0010            FPPMOJ-FPPMO0
04660  4554  SPCOP0, TADICAD         /FALLS THRU ON 0, GET
04661  0367          AND (170        / SUB-OP-CODE
04662  4567          JMS I SORTI     / & BRANCH ON IT
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 25-1

04663  4140            FPPOP0-1
04664  0020            FPPOPJ-FPPOP0
04665  4554  SPOP00, TADICAD         /FALLS THRU ON 0, USE AS
04666  0113          AND N7          / INDEX INTO LAST LIST
04667  7001          IAC
04670  4775' SPOP04, JMS MULT3       /THREE WORDS/SYMBOL
04671  4774'         JMS SYMTYP      /OUTPUT ONE OF SEVERAL
04672  4015            FPOP00        / SYMBOLS IN THIS LIST
04673  7775            -3
04674  5600          JMP I FPPOUT
             /
04675  7340  SPOP05, CLL STA         /= -1
04676  5270          JMP SPOP04      /OUTPUT "STARTE"
             /
04677  7344  SPNUSE, CLL STA RAL     /= -2
04700  5270          JMP SPOP04      /OUTPUT "UNUSED"
             /
04701  4771' SPO123, JMS GET678      /"ALN X", "ATX X", "XTA X"
04702  7104          CLL RAL         /(2 WORDS PER)
04703  4774'         JMS SYMTYP      /OUTPUT SYMBOL
04704  4046            FPXR1S-2
04705  7776            -2
04706  5313          JMP XROUT       / & XR VALUE
             /
04707  1366  SPOP10, TAD (4          /"LDX *,X"
04710  4774' SPOP11, JMS SYMTYP      /"ADDX *,X"
04711  4057            FPXR2S
04712  7774            -4
04713  4554  XROUT,  TADICAD         /GET XR FIELD
04714  0113          AND N7
04715  4531          DIGIT           / & OUTPUT AS DIGIT
04716  5600          JMP I FPPOUT
             /
04717  4554  SPCOP1, TADICAD         /GROUP 0 OR 1?
04720  0370          AND (100
04721  7650          SNA CLA
04722  5337          JMP SPOP1J      / 1 = CONDITIONAL JUMPS
04723  4771'         JMS GET678      / 0 = SETS, ETC.
04724  1365          TAD (-4         /SUB-OP-CODES 0 THRU 3?
04725  7700          SMA CLA
04726  5277          JMP SPNUSE      / NO, 4 THRU 7 = UN-USED
04727  4771'         JMS GET678      /0 THRU 3: SETX,SETB,JSA,JSR
04730  7001          IAC             / +1+1 => 2 THRU 5
04731  7001  SPCOP3, IAC             / 1: TRAP3
04732  4775' SPCOP4, JMS MULT3       / 0: TRAP4
04733  4774'         JMS SYMTYP      /GO DO ONE OF THESE
04734  4067            FOP134
04735  7775            -3
04736  5342          JMP DOFLD       /FINISH WITH FIELD
             /
04737  4764' SPOP1J, JMS CONDIT      /CONDITIONAL JUMPS
04740  1200            1200          / "J--"
04741  4533          SPACE2
04742  4772' DOFLD,  JMS FLDOUT      /OUTPUT FIELD & "*"
04743  5600          JMP I FPPOUT
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 25-2

             /
04744  4525  SPCOP2, JMS I TYPSI     /OUTPUT "JNX "
04745  3751            MSJNX
04746  5242          JMP XRPLUS-1    / & HANDLE ADDRESS
             /
             /  SPCOP3 & SPCOP4
             /
04747  4554  SPCOP5, TADICAD         /GET WORD AGAIN
04750  0370          AND (100
04751  7640          SZA CLA
04752  5277          JMP SPNUSE      /BIT 5 ON IS UNUSED OP
04753  4764'         JMS CONDIT      /LOAD TRUTH
04754  1424            1424          / "LT--"
04755  5600          JMP I FPPOUT
             /
04756  7001  SPCOP7, IAC             / "LEA" INDIRECT, SET SWITCH
04757  3023  SPCOP6, DCA TEMP2       / "LEA" LONG, SET SWITCH
04760  7340          CLL STA
04761  5211          JMP FPLEA       / & GO DO OUTPUT


04764  6265
04765  7774
04766  0004
04767  0170
04770  0100
04771  6251
04772  6277
04773  3407
04774  4475
04775  6257
04776  6243
04777  0600
       5000  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 26

05000  0000  PDATE,  0       /ROUTINE TO OUTPUT AN EXTENDED DATE WORD
05001  3244          DCA CRLF        /SAVE IT
05002  1244          TAD CRLF        /GET WORD & MASK
05003  0121          AND N377
05004  7112          CLL RTR         /DAY (4-8) TO 7-11
05005  7010          RAR
05006  4541          JMS I DEC2I     / OUTPUT AS 2 DIGITS (MASKED)
05007  4526          JMS I TYPECI    / AND A SEPARATOR
05010  0255            "-
05011  1244          TAD CRLF        /GET WORD A SECOND TIME
05012  4544          JMS I RTR6I     /MONTH (0-3) TO 7-10
05013  7010          RAR             / FOR MONTH*2
05014  0377          AND (36         / MASK IT AND USE AS AN INDEX
05015  4525          JMS I TYPSI     / TO OUTPUT MONTH IN ALPHA
05016  2521            MONTHS        / FORM (WITH SAFETY...)
05017  4526          JMS I TYPECI    /FOLLOWED BY "-"
05020  0255            "-
05021  1244          TAD CRLF        /GET LAST TIME
05022  0113          AND N7          / MASK OFF YEAR
05023  1231          TAD YRTEST      /  TEST IF .GT. THIS YEAR
05024  7540          SMA SZA
05025  1376          TAD (-10        /   YES, SUBTRACT 8
05026  1232          TAD YRBASE      / ADD TO BASE YEAR
05027  4541          JMS I DEC2I     / & OUTPUT IT
05030  5600          JMP I PDATE
05031  0000  YRTEST, 0       /-(THIS YEAR) FOR TESTING
05032  0000  YRBASE, 0       /BASE YEAR FOR DATE + THIS YEAR


05033  0000  TYPEA,  0       /OUTPUT ASCII CHARACTER IN THE AC
05034  1633          TAD I TYPEA     /GET ARG, IF ANY
05035  2233          ISZ TYPEA
05036  3543          DCA I RTL6I     /SAVE THE CHAR HERE FOR FIELD 1
05037  4534          JMS I CTRLI
05040  6212          CIF 10
05041  5775'         JMP TYPE1       /GO TO FIELD 1 TO DO THE OUTPUT
             /
05042  2041  TYPEX,  ISZ NCNT        /BUMP LINE POSITION
05043  5633          JMP I TYPEA     / & EXIT

05044  0000  CRLF,   0       /OUTPUT CARRIAGE RETURN, LINE FEED
05045  7200          CLA
05046  4233          JMS TYPEA
05047  0215            215
05050  4233          JMS TYPEA
05051  0212            212
05052  3041          DCA NCNT        /RESET LINE POSITION
05053  5644          JMP I CRLF


05054  0000  TYPEC,  0       /OUTPUT A SINGLE CHAR ARG
05055  1654          TAD I TYPEC     /GET IT
05056  2254          ISZ TYPEC
05057  4261          JMS TYPE        /OUTPUT IT
05060  5654          JMP I TYPEC
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 26-1



05061  0000  TYPE,   0       /CHARACTER OUTPUT ROUTINE
05062  0121          AND N377        /BE SURE ONLY 8 BITS
05063  7450          SNA
05064  1035          TAD CHAR        /USE CHAR IF AC = 0
05065  3277          DCA TCHAR       /CHAR TO OUTPUT
05066  1277          TAD TCHAR
05067  4567          JMS I SORTI     /CHECK FOR SPECIALS
05070  4516            TYPEL-1
05071  0056            TYPEOP-TYPEL
05072  1277          TAD TCHAR       /IS TCHAR < 240?
05073  1104          TAD M240
05074  7710          SPA CLA
05075  5320          JMP TYPCTL      /NO, OUTPUT AS CTRL-CHAR
05076  4233  TYPC,   JMS TYPEA       /NOW OUTPUT CHAR
05077  0000  TCHAR,    0
05100  5661          JMP I TYPE
             /
05101  4233  TYPALT, JMS TYPEA       /OUTPUT "$" FOR ALT-MODES
05102  0244            "$
05103  5661          JMP I TYPE
             /
05104  4244  TYPCR,  JMS CRLF        /C.R. TO OUTPUT
05105  5661          JMP I TYPE
             /
05106  4233  TYPTAB, JMS TYPEA       /SPACE OVER FOR TAB
05107  0240            " 
05110  1041          TAD NCNT        /TAB TO OUTPUT
05111  1111          TAD M10
05112  7450          SNA
05113  5661          JMP I TYPE
05114  7500          SMA
05115  5311          JMP TYPTAB+3    /REDUCE BY TAB SIZE
05116  7200          CLA
05117  5306          JMP TYPTAB
             /
05120  4233  TYPCTL, JMS TYPEA       /CONTROL-CHAR, OUTPUT AS
05121  0336            "^
05122  1324          TAD C100        / "^","CHAR+100"
05123  5276          JMP TYPC
05124  0100  C100,   100


05125  0000  CTRL,   0       /CHECK FOR CTRL-C, CTRL-S, CTRL-Q & CTRL-P
05126  3367          DCA CTRLQS      /CLEAR HANG FLAG
05127  6031  CTRL0,  KSF             /HAS A KEY BEEN HIT?
05130  5363          JMP CTRLX       /NO, TEST IF HANGING
05131  6034          KRS
05132  0117          AND N177        /YES, MASK OFF PARITY BIT
05133  1374          TAD (-"C+300    /IS IT A CTRL-C (ABORT PROGRAM)?
05134  7450          SNA
05135  5360  BCTRLC, JMP CTRLC       /***    JMP I CTRLCI    /== ABORT ==
05136  1110          TAD M20         /IS IT A CTRL-S (STOP OUTPUT)?
05137  7440          SZA
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 26-2

05140  5343          JMP CTRL1
05141  2367          ISZ CTRLQS      / YES, SET HANG FLAG
05142  6032          KCC             /  & CLEAR HARDWARE FLAG
05143  1373  CTRL1,  TAD (2          /IS IT A CTRL-Q (START OUTPUT)?
05144  7440          SZA
05145  5350          JMP CTRL2
05146  6032          KCC             / YES, CLEAR THE HARDWARE
05147  5725          JMP I CTRL      /  & JUST EXIT
             /
05150  7001  CTRL2,  IAC             /IS IT A CTRL-P (STOP PROGRAM)?
05151  7640          SZA CLA
05152  5363          JMP CTRLX       /NO, TEST IF HANGING
05153  6032          KCC
05154  3052          DCA DSWIT       /YES, RESET DUMP SWITCH
05155  4526          JMS I TYPECI    /OUTPUT "^P"
05156  0220            "P-100
05157  5571          JMP I RECRLF    / THEN CR/LF & RESTART
             /
             /ROUTINE TO EXECUTE THE 'EXIT' COMMAND
             /
             XEXIT,
05160  3052  CTRLC,  DCA DSWIT       /RESET DUMP SWITCH
05161  5506          JMP I M200      / & GO TO SYSTEM
05162  0516  CTRLCI, XERR4+1         /*** CTRL-C ABORTS JOB STREAM! ***
             /
05163  1367  CTRLX,  TAD CTRLQS      /HANGING BECAUSE OF CTRL-S?
05164  7640          SZA CLA
05165  5327          JMP CTRL0       / YES, BACK FOR ANOTHER ROUND
05166  5725          JMP I CTRL      / NO, OUT WE GO!

05167  0000  CTRLQS, 0       /CTRL-S, CTRL-Q FLAG


05173  0002
05174  7775
05175  2400
05176  7770
05177  0036
       5200  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 27

             /INPUT AN UNSIGNED 24 BIT NUMBER
05200  0000  ACCEPT, 0
05201  3025          DCA ACC1        /CLEAR LO
05202  3026          DCA ACC2        / & HI WORDS
05203  3777'         DCA DADD        / & LEGAL INPUT SWITCH
05204  4564          JMS I SSKIPI    /GET FIRST NON-SPACE
05205  7410          SKP
05206  4563  ACCPT1, JMS I GETNI     /DON'T IGNORE SPACES
05207  4567          JMS I SORTI     /CHECK FOR ^D, ^K, (, ", ',
05210  5350            GWLST1-1      / DIGITS, SPACE
05211  0043            ACOPS-GWLST1
05212  5236          JMP ACCPT3      /NONE OF THE ABOVE
             /
05213  1035  ACCNUM, TAD CHAR
05214  1376          TAD (-"0        /MAKE A DIGIT
05215  3261          DCA OCTSET
05216  1261          TAD OCTSET      /IS DIGIT LEGAL?
05217  7041          CIA
05220  1242          TAD ACBASE
05221  7750          SPA SNA CLA
05222  4573  ERC09,  ERROR           / NO, ILLEGAL DIGIT!
05223  1242  ACCMUL, TAD ACBASE      /SET UP MULTIPLY OF PREVIOUS
05224  3031          DCA OPER1       / BY BASE
05225  3032          DCA OPER2
05226  4775'         JMS DMUL        / DO MULTIPLY
05227  1261          TAD OCTSET      /SET UP ADD OF NEXT "DIGIT"
05230  3031          DCA OPER1
05231  3032          DCA OPER2
05232  4777'         JMS DADD        /OK, DO THE ADD (& SET SWITCH)
05233  5206          JMP ACCPT1
             /
05234  7240          STA             /  SPACE HERE
05235  3046          DCA CRSWT       /SET SWITCH: CR HERE
05236  1777' ACCPT3, TAD DADD        /TERMINATING CHAR RECEIVED
05237  7650          SNA CLA         /CHECK FOR LEGAL INPUT
05240  4573  ERCR,   ERROR           /YOU CAN'T OUT-SMART ME!
05241  5600          JMP I ACCEPT
05242  0010  ACBASE, 10
             /
             /
05243  4265  DQUOTE, JMS QUOTEC      / " - GET SINGLE CHAR
05244  3261          DCA OCTSET      / SAVE VALUE
05245  5223          JMP ACCMUL      / & USE IT AS A "DIGIT"
             /
05246  4265  SQUOTE, JMS QUOTEC      / ' - PACKED ASCII, GET 1ST
05247  0116          AND N77         /MASK TO 6 BITS
05250  4543          JMS I RTL6I     /MOVE TO LEFT HALF
05251  3261          DCA OCTSET      / & SAVE IT
05252  4265          JMS QUOTEC      /GET 2ND CHAR
05253  0116          AND N77         /MASK
05254  1261          TAD OCTSET      /MERGE
05255  5244          JMP DQUOTE+1    / & USE THIS AS A "DIGIT"
             /
05256  1374  CTRLD,  TAD (2          / ^D - SET RADIX TO DECIMAL
05257  4261  CTRLK,  JMS OCTSET      / ^K - SET RADIX TO OCTAL
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 27-1

05260  5206          JMP ACCPT1


             /SUB. TO SET UP FOR OCTAL/DECIMAL INPUT.  CALLED FROM
             /  COMMAND INPUT & MODIFY & IF AN "^K"/"^D" IN INPUT.
05261  0000  OCTSET, 0       /SET UP FOR OCTAL/DECIMAL INPUT
05262  1373          TAD (10         /ENTER WITH AC= 2 FOR DECIMAL
05263  3242          DCA ACBASE
05264  5661          JMP I OCTSET

05265  0000  QUOTEC, 0       /GET A QUOTED CHARACTER
05266  4772'         JMS CGTEST      /GET & TEST FOR A CR
05267  4573  ERC13,    ERROR         / ILLEGAL USE OF " OR '
05270  1035          TAD CHAR        /OK, RETURN WITH IT
05271  5665          JMP I QUOTEC


             /SUBROUTINE TO DEVELOP ARGUMENTS FROM THE COMMAND
             /BUFFER, AND RETURN WITH -(#) OF ARGS IN 'TEMP'.
05272  0000  GARGS,  0
05273  1175          TAD TEMPST      /GET BUFFER ADDRESS
05274  3010          DCA DPNT
05275  3021          DCA TEMP        /ZERO THE NUMBER OF ARGS
05276  7240  GAR1,   STA
05277  3022          DCA TEMP1       /SET BLK TO -1
05300  7240          STA
05301  3036          DCA CNT         /RESET SWITCH
05302  4771' GAR2,   JMS EXPRIN      /GET NEXT ARG
05303  4564          JMS I SSKIPI    /IGNORE TRAILING SPACES
05304  4567          JMS I SORTI     /BRANCH ON TERMINATOR
05305  5442            GARLST-1
05306  7772            GAROPS-GARLST
05307  4573  ERCS,   ERROR           /ILLEGAL TERMIN., FLAME OUT
             /
05310  4326  GAR3,   JMS GPUT        /CR FOUND, END
05311  1175          TAD TEMPST      /SET UP POINTER FOR
05312  3010          DCA DPNT        / GETTING RESULTS
05313  5672          JMP I GARGS
             /
05314  4563  GAR4,   JMS I GETNI     /SKIP OVER "."
05315  1025          TAD ACC1        /.= TERMIN (BLOCK PART)
05316  5277          JMP GAR1+1      /SET BLOCK & GET NEXT
             /
05317  1025  GAR5,   TAD ACC1        /-= TERMIN (LOC PART)
05320  3023          DCA TEMP2
05321  4563          JMS I GETNI     /SKIP OVER "-"
05322  5301          JMP GAR2-1      /GO SET SWITCH
             /
05323  4326  GAR6,   JMS GPUT        /,= TERMIN
05324  4563          JMS I GETNI     /SKIP OVER ","
05325  5276          JMP GAR1


             /SUBROUTINE TO PUT THE DEVELOPED ARGS IN THE ARG
             /BUFFER.  ALL ARGUMENTS ARE STORED IN 4 WORDS IN
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 27-2

             /THE BUFFER, AS SPECIFIED BY:
             /   BLOCK.LOC1-LOC2  (TERMINATED BY , OR C.R.)
             /AS:
             /I-------I-------I-------I-------I-----
             /I WORD1 I WORD2 I WORD3 I WORD4 I ETC.
             /I-------I-------I-------I-------I-----
             /WHERE:
             /  WORD1=       BLOCK (OR -1 IF NONE SPECIFIED)
             /  WORD2=       LOC (HIGH) [ONLY 3 BITS, LOC2 IF SPEC'D]
             /  WORD3=       LOC1 (LOW)
             /  WORD4=       LOC2-LOC1-1 (LOC2=LOC1 IF NOT
             /               SPECIFIED) [ONLY 12 LOW BITS USED]
05326  0000  GPUT,   0
05327  1022          TAD TEMP1
05330  3410          DCA I DPNT      /SET BLOCK
05331  2036          ISZ CNT         /WAS A LOC2 SPECIFIED?
05332  5335          JMP GPUT1       /YES, OK
05333  1025          TAD ACC1
05334  3023          DCA TEMP2       /NO, MAKE ARGS SAME
05335  1026  GPUT1,  TAD ACC2        /STORE HIGH ADDR
05336  0113          AND N7          /MASKED TO 3 BITS
05337  3410          DCA I DPNT
05340  1023          TAD TEMP2       /USE 1ST ARG
05341  3410          DCA I DPNT
05342  1025          TAD ACC1
05343  7040          CMA
05344  1023          TAD TEMP2
05345  3410          DCA I DPNT      /DIFF= (TEMP2-ACC1-1)
05346  7240          STA
05347  1021          TAD TEMP        /ANOTHER ENTRY
05350  3021          DCA TEMP
05351  5726          JMP I GPUT


05352  0000  XS240O, 0       /XS240 FORMAT PACKED ASCII
05353  4544          JMS I RTR6I     /HIGH 6 BITS
05354  0116          AND N77
05355  4532          SPACE1          / PLUS A SPACE
05356  4554          TADICAD         /THEN LOW 6 BITS,
05357  0116          AND N77
05360  4532          SPACE1          / PLUS A SPACE
05361  5752          JMP I XS240O


05362  0000  GETN,   0       /GET NEXT CHAR FROM COMM. BUFF.
05363  6211          CDF 10
05364  1416          TAD I COMOUT
05365  6201          CDF 0
05366  3035          DCA CHAR
05367  5762          JMP I GETN


05371  5727
05372  2552
05373  0010
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 27-3

05374  0002
05375  6000
05376  7520
05377  5650
       5400  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 28

             /ROUTINE TO EVALUATE THE PARENTHESIZED EXPRESSION
             /OF DOUBLE PRECISION INTEGERS IN THE COMMAND BUFFER.
             /IT CALLS ITSELF RECURSIVELY TO EVALUATE EXPRESSIONS
             /IN "(...)", PLACING INFORMATION ON A PUSH-DOWN-LIST
             /OR DOING ARITHMETIC ACCORDING TO OPERATOR PRECIDENCE.
             /
             /OPERATIONS (IN ORDER OF PRECIDENCE):
             /  OR AND ADD SUB DIV MPY
             /  !   &   +   -   /   *

             /ALL ARITHMETIC IS DONE IN DOUBLE-PRECISION SIGNED
             /INTEGER.  OVERFLOW ON MULTIPLY, ADD OR SUBTRACT IS
             /IGNORED BUT DIVIDE BY 0 WILL CAUSE AN ERROR.


05400  0000  EVAL,   0
05401  3032          DCA OPER2       /0 => D.P. TEMP (NEW NUMBER
05402  3031          DCA OPER1       / OR LAST RESULT).
05403  3002          DCA LASTOP      /0 => LASTOP
05404  4765          JMS I TERMTI    /GET NEXT & TEST FOR TERM.
05405  5207          JMP EVAL1       /TERM, CHECK IT
05406  5272          JMP ENUM        / IT MUST BE A NUMBER

05407  4567  EVAL1,  JMS I SORTI     /CHECK LEGAL TERMS
05410  5476            EVLST1-1      /"+","-" & "("
05411  7775            EVOPS1-EVLST1
05412  4573  ERCT,   ERROR           /SORRY ABOUT THAT

05413  4764  EVAL2,  JMS I LPARI     /IS CHAR "("?
05414  4573  ERCU,   ERROR           /YES,ILLEGAL (NO OP FIRST)
05415  1040  EVMIN,  TAD CNTRA       /SEQN # OF TERMINATOR
05416  3003          DCA THISOP      /SET UP THISOP
05417  1040          TAD CNTRA       /IS IT ")" OR "CR"?
05420  1111          TAD M10
05421  7700          SMA CLA
05422  3003          DCA THISOP      /YES, 0 => THISOP
05423  1003  EVAL3,  TAD THISOP      /CHECK PRIORITIES
05424  7041          CIA
05425  1002          TAD LASTOP      /IS LASTOP < THISOP?
05426  7710          SPA CLA
05427  5256          JMP EVPAR       /YES, CONTINUE SCAN
05430  1003          TAD THISOP      / IS THISOP+LASTOP=0?
05431  1002          TAD LASTOP
05432  7650          SNA CLA
05433  5357          JMP EVALX       /YES, DONE
05434  1002          TAD LASTOP      /NO, DO THIS OP NOW
05435  1366          TAD EVTAB
05436  3246          DCA EVOP        /SET UP OPERATION
05437  1002          TAD LASTOP      /IS THIS =0?
05440  7650          SNA CLA
05441  5246          JMP EVOP        /YES, DO OP
05442  4551          POP             /NO, POP LAST OFF LIST
05443  3026          DCA ACC2        / INTO D.P.AC.
05444  4551          POP
05445  3025          DCA ACC1
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 28-1

05446  7402  EVOP,   HLT             /JMS TO OPERATION ROUTINE
05447  1026          TAD ACC2
05450  3032          DCA OPER2       /DUPLICATE D.P.AC. INTO
05451  1025          TAD ACC1
05452  3031          DCA OPER1       / D.P. TEMP
05453  4551          POP
05454  3002          DCA LASTOP      /POP UP ANOTHER OLD OPERATOR
05455  5223          JMP EVAL3       /AND GO DO IT

05456  4764  EVPAR,  JMS I LPARI     /IS CHAR A "("?
05457  5337          JMP EVLPAR      /YES, GO DO A SUB-EXPRESSION
05460  1002          TAD LASTOP      /NO, PUSH DOWN OLD OP
05461  4550          PUSH
05462  1031          TAD OPER1       / & D.P. TEMP (LAST
05463  4550          PUSH
05464  1032          TAD OPER2       / RESULT OR NEW NUMBER).
05465  4550          PUSH
05466  1003          TAD THISOP      /UPDATE LASTOP
05467  3002          DCA LASTOP
05470  4765  EVNEXT, JMS I TERMTI    /GET NEXT & TEST FOR TERM.
05471  5337          JMP EVLPAR      /TERM, MUST BE A "("
05472  4567  ENUM,   JMS I SORTI     /CHECK FOR "C","B", ETC...
05473  5502            EVLST2-1
05474  0011            EVOPS2-EVLST2
05475  4777'         JMS ACCEPT      /GET A # OR BOMB OUT!
05476  7240          STA
05477  1016          TAD COMOUT      /BACK UP POINTER
05500  3016          DCA COMOUT
05501  1025  ENUMX,  TAD ACC1
05502  3031          DCA OPER1       /LO ORDER PART
05503  1026          TAD ACC2
05504  3032          DCA OPER2       /HI ORDER PART
05505  5354          JMP EVOPN       /GO CHECK TERMINATOR
             /
05506  6211  EVDATE, CDF 10          /"D" -- USE DATE WORD
05507  1776          TAD I (7666     /GET DATE WORD
05510  6201          CDF 0
05511  5334          JMP EVBLK+1
05512  1027  EVREM,  TAD ACCX1       /"R" -- USE REMAINDER
05513  3025          DCA ACC1
05514  1030          TAD ACCX2       / AS NEXT "INPUT".
05515  5335          JMP EVBLK+2
05516  1033  EVTEMP, TAD TEMPV1      /"T" -- USE 'TEMP' STORAGE
05517  3025          DCA ACC1
05520  1034          TAD TEMPV2
05521  5335          JMP EVBLK+2
05522  7614  EVSR,   LAS SKP         /"S" -- USE SWITCHES
05523  4554          TADICAD         /"C" -- USE CONTENTS
05524  5334          JMP EVBLK+1
05525  1074  EVFIL,  TAD FILLER      /"F" -- USE FILLER
05526  5334          JMP EVBLK+1
05527  1061  EVLOC,  TAD LOCL        /"L" -- USE LOCATION
05530  3025          DCA ACC1
05531  1060          TAD LOCH
05532  5335          JMP EVBLK+2
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 28-2

05533  1057  EVBLK,  TAD BLK         /"B" -- USE BLOCK
05534  3025          DCA ACC1        /INTO LO ORDER PART
05535  3026          DCA ACC2        /0 HIGH ORDER PART
05536  5301          JMP ENUMX       /CHECK NEXT CHARACTER

05537  4764  EVLPAR, JMS I LPARI     /IS CHAR "("?
05540  7410          SKP
05541  4573  ERCV,   ERROR           /NO, DIE! (ILLEGAL OPERATOR)
05542  1002  EVPAR2, TAD LASTOP      /PUSH DOWN LASTOP
05543  4550          PUSH
05544  1200          TAD EVAL        /PREPARE TO RE-CALL
05545  4550          PUSH
05546  4200          JMS EVAL        /RECURSIVE CALL
05547  4573  ERCW,   ERROR           /TERM = CR, NOT ENOUGH PARENS
05550  4551          POP
05551  3200          DCA EVAL        /RESTORE RETURN ADDR
05552  4551          POP
05553  3002          DCA LASTOP      /RESTORE LASTOP
05554  4765  EVOPN,  JMS I TERMTI    /GET NEXT & TEST FOR TERM.
05555  5213          JMP EVAL2       /OK
05556  5341          JMP EVPAR2-1    /GARBAGE, GIVE SAME ERROR

05557  1040  EVALX,  TAD CNTRA       /WAS CHAR CR OR ")"?
05560  1111          TAD M10
05561  7650          SNA CLA
05562  2200          ISZ EVAL        / ")", RETURN TO CALL+2
05563  5600          JMP I EVAL      / CR, RETURN TO CALL+1

05564  5616  LPARI,  LPAR
05565  5624  TERMTI, TERMT

05566  4766  EVTAB,  JMS I .    /JMS THRU TABLE TO OPERATIONS

05567  5677          DIOR    /INCLUSIVE OR
05570  5667          DAND    /AND
05571  5650          DADD    /ADD
05572  5662          DSUB    /SUBTRACT
05573  6040          DDIV    /DIVIDE
05574  6000          DMUL    /MULTIPLY


05576  7666
05577  5200
       5600  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 29

05600  0000  PUSHX,  0       /PUSH AC ONTO LIST
05601  6211          CDF 10
05602  3407          DCA I PDLPT
05603  6201          CDF 0
05604  2007          ISZ PDLPT       /BUMP POINTER
05605  5600          JMP I PUSHX

05606  0000  POPX,   0       /POP LIST INTO AC
05607  7360          STA STL         /SET LINK SO IT WILL BE 0
05610  1007          TAD PDLPT       /BACK UP POINTER
05611  3007          DCA PDLPT
05612  6211          CDF 10
05613  1407          TAD I PDLPT
05614  6201          CDF 0
05615  5606          JMP I POPX


05616  0000  LPAR,   0       /CHECK IF CHAR = "("
05617  1035          TAD CHAR
05620  1377          TAD (-"(
05621  7640          SZA CLA
05622  2216          ISZ LPAR        /IF IT IS NOT, TO CALL+2
05623  5616          JMP I LPAR      /  ELSE TO CALL+1

             /COMPARE CHAR AGAINST LIST OF TERMINATORS.  IF IT
             /IS ONE, RETURN TO CALL+1, ELSE TO CALL+2.
05624  0000  TERMT,  0
05625  7300          CLA CLL
05626  4563          JMS I GETNI     /GET NEXT CHARACTER
05627  4564          JMS I SSKIPI    /IGNORE SPACES
05630  1376          TAD (TERMS-1    /SET UP POINTER
05631  3011          DCA SPNT
05632  3040          DCA CNTRA       /SET CNTRA TO 0
05633  6211  TERMT1, CDF 10
05634  1411          TAD I SPNT      /GET AN ITEM
05635  6201          CDF 0
05636  2040          ISZ CNTRA       /ADD 1 TO ITEM #
05637  7450          SNA
05640  5246          JMP TERMTE      /WAS 0, END
05641  7041          CIA
05642  1035          TAD CHAR        /SAME AS THIS?
05643  7650          SNA CLA
05644  5624          JMP I TERMT     /YES, TO CALL+1
05645  5233          JMP TERMT1
05646  2224  TERMTE, ISZ TERMT       /DIDN'T FIND IT, TO
05647  5624          JMP I TERMT     / CALL+2

             /DOUBLE-PRECISION ROUTINES

05650  0000  DADD,   0       /D.P. ADD
05651  7100          CLL
05652  1031          TAD OPER1
05653  1025          TAD ACC1        /ADD LOW ORDER PARTS
05654  3025          DCA ACC1
05655  7004          RAL             /GET CARRY TO AC11
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 29-1

05656  1032          TAD OPER2       /ADD HIGH ORDER PARTS
05657  1026          TAD ACC2
05660  3026          DCA ACC2        /STORE HIGH ORDER PART
05661  5650          JMP I DADD

05662  0000  DSUB,   0       /D.P. SUBTRACT
05663  3001          DCA DPSGN       /ZERO IT FOR SAFETY
05664  4775'         JMS MULNEG      /NEGATE OPERAND
05665  4250          JMS DADD        / & ADD
05666  5662          JMP I DSUB

05667  0000  DAND,   0       /D.P. LOGICAL AND
05670  1026          TAD ACC2        /AND HIGH ORDER PARTS
05671  0032          AND OPER2
05672  3026          DCA ACC2
05673  1025          TAD ACC1        /AND LOW ORDER PARTS
05674  0031          AND OPER1
05675  3025          DCA ACC1
05676  5667          JMP I DAND      /RETURN

05677  0000  DIOR,   0       /D.P. LOGICAL INCLUSIVE OR
05700  1026          TAD ACC2        /IOR HIGH ORDER PARTS
05701  7040          CMA
05702  0032          AND OPER2
05703  1026          TAD ACC2
05704  3026          DCA ACC2
05705  1025          TAD ACC1        /IOR LOW ORDER PARTS
05706  7040          CMA
05707  0031          AND OPER1
05710  1025          TAD ACC1
05711  3025          DCA ACC1
05712  5677          JMP I DIOR


             /SUBROUTINE TO GET SINGLE ARGS FROM THE COMMAND
             /BUFFER.  MUST BE IN 'BLOK.LOC' FORM.  ONLY ".",
             /SPACE AND CR ARE ALLOWED OTHER THAN DIGITS.
05713  0000  ARG,    0
05714  7240          STA
05715  3022  ARG1,   DCA TEMP1       /SET 'BLOK' [INIT TO -1]
05716  4327          JMS EXPRIN      /  GET AN ARG
05717  4567          JMS I SORTI     /LOOK UP TERMINATOR
05720  5445            ARGLST-1
05721  0010            ARGOPS-ARGLST
05722  4573  ERCQ,   ERROR           /ILLEGAL TERMINATOR
             /
05723  4563  ARG2,   JMS I GETNI     /SKIP OVER "."
05724  1025          TAD ACC1        /TERM = ".", SET 'BLOK'
05725  5315          JMP ARG1
             /
05726  5713  ARG3,   JMP I ARG       /TERM = " " OR CR


             /GET NEXT ARG FROM COMM. BUFF.  IF NEXT CHAR IS
             /  A "(", USE 'EVAL' TO GET IT, OTHERWISE USE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 29-2

             /  'ACCEPT'.
05727  0000  EXPRIN, 0
05730  4564          JMS I SSKIPI    /IGNORE SPACES
05731  4216          JMS LPAR        /IS CHAR A "("?
05732  5335          JMP EXPRI1
05733  4774'         JMS ACCEPT      /NO, MUST BE A NUMBER
05734  5727          JMP I EXPRIN
             /
05735  4547  EXPRI1, JMS I EVALI     /YES, GO EVALUATE EXPRESSION
05736  4573  ERC08,  ERROR           /CR = ILLEGAL TERMINATOR
05737  4773'         JMS CGTEST      /OK, SKIP OVER ")" & TEST FOR CR
05740  7410            SKP
05741  7240          STA             /NO, SET SWITCH
05742  3046          DCA CRSWT       /YES, RESET IT
05743  5727          JMP I EXPRIN    / & LEAVE...


05744  0000  SCANER, 0       /EXECUTION SUBROUTINE FOR 'SCAN' COMMAND
05745  7200          CLA
05746  1057          TAD BLK         /SET UP DESIRED BLOCK
05747  3054          DCA CBLK
05750  4772'         JMS GETIO       /DO NECESSARY I/O
05751  7610            SKP CLA       /  READ ERROR!
05752  5744          JMP I SCANER    /THIS BLOCK IS OK!
05753  1057          TAD BLK
05754  4540          JMS I OCTI      /OUTPUT BLOCK NUMBER
05755  4525          JMS I TYPSI     / & TELL IT'S BAD
05756  2145            MSBAD
05757  4530          JMS I CRLFI     / TO ANOTHER LINE
05760  5744          JMP I SCANER


05772  3027
05773  2552
05774  5200
05775  6126
05776  5336
05777  7530
       6000  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 30

             /SIGNED MULTIPLY AND DIVIDE ROUTINES

06000  0000  DMUL,   0
06001  4312          JMS MDCOM       /MAKE DPAC POS, INITIALIZE
06002  7710          SPA CLA         /MAKE SURE MULTIPLIER IS POSITIVE
06003  4326          JMS MULNEG      / IT WAS NEG, MAKE POS & SET SIGN
06004  1026  DMUL1,  TAD ACC2        /SHIFT RIGHT & OUT
06005  7010          RAR
06006  3026          DCA ACC2        /THRU HI OF LO
06007  1025          TAD ACC1
06010  7010          RAR
06011  3025          DCA ACC1        /THRU LO OF LO INTO LINK
06012  2341          ISZ DPNEG       /DONE YET?
06013  5221          JMP DMUL2       /NO, CONTINUE
06014  1001  DMUL4,  TAD DPSGN       /YES, CHECK SIGN OF RESULT
06015  7010          RAR
06016  7630          SZL CLA         /SKIP IF SIGN OK
06017  4341          JMS DPNEG       /NOT OK, NEGATE
06020  5600          JMP I DMUL
             /
06021  7420  DMUL2,  SNL             /ADD IN THIS TIME?
06022  5231          JMP DMUL3       /NO, BIT OUT WAS 0
06023  7300          CLA CLL         /YES, BIT WAS 1
06024  1031          TAD OPER1       /START WITH LOW
06025  1027          TAD ACCX1
06026  3027          DCA ACCX1
06027  7204          CLA RAL         /GET CARRY
06030  1032          TAD OPER2       /ADD HIGH PARTS
06031  1030  DMUL3,  TAD ACCX2       /AND BEGIN SHIFTING OUT
06032  7010          RAR
06033  3030          DCA ACCX2
06034  1027          TAD ACCX1
06035  7010          RAR
06036  3027          DCA ACCX1
06037  5204          JMP DMUL1

06040  0000  DDIV,   0
06041  1240          TAD DDIV        /MOVE RETURN ADDRESS
06042  3200          DCA DMUL
06043  4312          JMS MDCOM       /MAKE DPAC POS, INITIALIZE
06044  7700          SMA CLA         /IS DIVISOR NEGATIVE?
06045  4326          JMS MULNEG      / NO, NEGATE IT & SET SIGN
06046  7430          SZL             /  IS IT 0? (CARRY OUT ON NEGATE)
06047  4573  ERCX,   ERROR           /   YES, YOU LOST
06050  2001          ISZ DPSGN       /CORRECT FOR SIGN DIF IN * & /
06051  1027  DDIV1,  TAD ACCX1       /SUBTRACT LO OF LO
06052  1031          TAD OPER1
06053  3027          DCA ACCX1
06054  7204          CLA RAL         /CARRY TO AC
06055  1030          TAD ACCX2       /SUBTRACT HI OF LO
06056  1032          TAD OPER2
06057  7510          SPA             /TOO FAR?
06060  5264          JMP DDIV2       /YES
06061  7120          CLL CML         /NO, SET LINK
06062  3030          DCA ACCX2
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 30-1

06063  5272          JMP DDIV3
06064  7200  DDIV2,  CLA
06065  1031          TAD OPER1       /RESET LO ORDER PART
06066  7041          CIA
06067  1027          TAD ACCX1
06070  3027          DCA ACCX1
06071  7100          CLL             /RESET LINK
06072  1025  DDIV3,  TAD ACC1        /BEGIN SHIFTING
06073  7004          RAL
06074  3025          DCA ACC1
06075  1026          TAD ACC2
06076  7004          RAL
06077  3026          DCA ACC2
06100  2341          ISZ DPNEG       /DONE YET?
06101  7410          SKP
06102  5214          JMP DMUL4       /YES, CHECK SIGN & RETURN
06103  1027          TAD ACCX1       /NO, KEEP SHIFTING
06104  7004          RAL
06105  3027          DCA ACCX1
06106  1030          TAD ACCX2
06107  7004          RAL
06110  3030          DCA ACCX2
06111  5251          JMP DDIV1

06112  0000  MDCOM,  0     /COMMON ROUTINE FOR MULTIPLY & DIVIDE
06113  3001          DCA DPSGN       /RESET SIGN
06114  1026          TAD ACC2        /IS DPAC POS?
06115  7710          SPA CLA
06116  4341          JMS DPNEG       /NO, NEGATE
06117  3030          DCA ACCX2       / 0 => DPACX
06120  3027          DCA ACCX1
06121  1377          TAD (-31        /INITIALIZE COUNTER
06122  3341          DCA DPNEG
06123  7100          CLL
06124  1032          TAD OPER2       /RETURN W. HIGH OPERAND
06125  5712          JMP I MDCOM

06126  0000  MULNEG, 0       /NEGATE THE MULTIPLIER/DIVISOR
06127  1031          TAD OPER1       /DO LO-ORDER PART
06130  7141          CLL CIA
06131  3031          DCA OPER1
06132  1032          TAD OPER2       /DO HI-ORDER PART
06133  7040          CMA
06134  7430          SZL             /CARRY?
06135  7101          CLL IAC         /YES, ADD IT IN
06136  3032          DCA OPER2
06137  2001          ISZ DPSGN       /SIGN CHANGE MADE
06140  5726          JMP I MULNEG

06141  0000  DPNEG,  0       /NEGATE THE D.P.AC.
06142  1025          TAD ACC1        /DO LO-ORDER PART
06143  7141          CLL CIA
06144  3025          DCA ACC1
06145  1026          TAD ACC2        /DO HI-ORDER PART
06146  7040          CMA
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 30-2

06147  7430          SZL             /CARRY?
06150  7101          CLL IAC         /YES, ADD IT IN
06151  3026          DCA ACC2
06152  2001          ISZ DPSGN       /SIGN CHANGE MADE
06153  5741          JMP I DPNEG


06154  0000  BLKTST, 0       /TEST & SET BLK
06155  3341          DCA DPNEG       /SAVE DATA
06156  1341          TAD DPNEG       /GET IT BACK AGAIN
06157  2341          ISZ DPNEG       /LEGAL BLOCK NUMBER?
06160  3057          DCA BLK         / YES IF NOT 7777 (-1)
06161  7200          CLA             / IF NOT, CLEAR JUNK
06162  5754          JMP I BLKTST


06163  0000  DICAD,  0       /"DCA I CAD" IN FIELD 1
06164  6211          CDF 10
06165  3456          DCA I CAD
06166  6201          CDF 0
06167  5763          JMP I DICAD

06170  0000  TICAD,  0       /"TAD I CAD" IN FIELD 1
06171  6211          CDF 10
06172  1456          TAD I CAD
06173  6201          CDF 0
06174  5770          JMP I TICAD


06177  7747
       6200  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 31

             /CHECK IF THE COMMAND BUFFER STARTS WITH A WORD.  IF
             /IT DOES, RETURN TO 'MAIN3' WITH THE SPECIAL CHAR-
             /ACTER AND JUST USE IT AS PART OF THE COMMAND STRING.
             /IF IT DOES NOT, TEST FOR EXPRESSIONS [IN "(...)",
             /TO ALLOW CHARACTERS IN THE EXPRESSIONS TO NOT BE
             /TAKEN AS COMMAND CHARACTERS] AND SINGLE & DOUBLE
             /QUOTES [THE FOLLOWING CHARACTER OR CHARACTERS ARE
             /LITERALS, NOT COMMANDS].  IF THE PARENS MATCH AND
             /THE QUOTES ARE FOLLOWED BY THE CORRECT NUMBER OF
             /CHARACTERS, THEN THE LAST CHARACTER WAS AN "ODT"
             /COMMAND TO BE EXECUTED SO RETURN TO CALL+1.  OTHER-
             /WISE RETURN TO 'MAIN3' AS ABOVE.

06200  0000  WCHEK,  0
06201  4556          JMS I GWORDI    /COM BUF BEGIN WITH A WORD?
06202  5211            JMP WCHEK2    /NO, TEST FOR PARENS, ETC.
06203  7240  WCHEK1, STA
06204  1015          TAD COMIR       /YES, BACK UP COMIR
06205  3015          DCA COMIR
06206  1021          TAD TEMP        /AND USE THE SPECIAL CHAR AS
06207  5610          JMP I .+1       / PART OF THE COMMAND STRING
06210  4025            RESPC+1
             /
06211  7240  WCHEK2, STA
06212  1016          TAD COMOUT      /SET UP ANOTHER A-XR
06213  3010          DCA DPNT
06214  3036          DCA CNT         /RESET (OR SET) PAREN COUNT
06215  4553  WCHEK3, TADIDP          /GET A CHAR FROM COMM. BUFF.
06216  4567          JMS I SORTI     / & GO TEST IT
06217  5460            WCKLST-1
06220  0006            WCKOPS-WCKLST
06221  5215          JMP WCHEK3      /NONE, CONTINUE SCAN
             /
06222  1036  WCHEK4, TAD CNT         /CR, DO PARENS MATCH?
06223  7640          SZA CLA
06224  5203          JMP WCHEK1      /NO, CONTINUE COMMAND INPUT
06225  5600          JMP I WCHEK     /YES, INPUT IS DONE
             /
06226  7344  WCHEK5, STA CLL RAL     /SET TO -2
06227  7001          IAC             /AC = +1 OR -1
06230  1036          TAD CNT         / UPDATE PAREN COUNT
06231  5214          JMP WCHEK3-1    / & CONTINUE SCAN
             /
06232  4235  WCHEK6, JMS WCHONE      / ' -- 2 CHARACTERS
06233  4235          JMS WCHONE      / " -- 1 CHARACTER
06234  5215          JMP WCHEK3      /OK, CONTINUE SCAN

06235  0000  WCHONE, 0
06236  4553          TADIDP          /GET NEXT CHAR
06237  1105          TAD M215        /IS IT A CR?
06240  7650          SNA CLA
06241  5203          JMP WCHEK1      /YES, DON'T EXECUTE SPECIAL
06242  5635          JMP I WCHONE    /NO, OK
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 32

             /FPP INSTRUCTION DECODING SUPPORT SUBROUTINES

06243  0000  GETOP,  0       /GET OP-CODE (BITS 0-3) TO BITS 9-11
06244  4554          TADICAD
06245  0122          AND N7000
06246  7106          CLL RTL
06247  7006          RTL
06250  5643          JMP I GETOP

06251  0000  GET678, 0       /GET BITS 678 TO BITS 9-11
06252  4554          TADICAD
06253  7112          CLL RTR
06254  7010          RAR
06255  0113          AND N7
06256  5651          JMP I GET678

06257  0000  MULT3,  0       /MULTIPLY AC BY THREE
06260  3243          DCA GETOP
06261  1243          TAD GETOP
06262  7104          CLL RAL
06263  1243          TAD GETOP       /WORKS FOR POS OR NEG!
06264  5657          JMP I MULT3

06265  0000  CONDIT, 0       /OUTPUT CONDITIONAL FPP INSTRUCTION
06266  1665          TAD I CONDIT    /GET LEADING 1 OR 2 CHARS
06267  2265          ISZ CONDIT
06270  4535          JMS I TWOT      / & OUTPUT THEM
06271  4251          JMS GET678      /GET CONDITION CODE
06272  4676          JMS I SYMTYI    / AS INDEX TO TABLE
06273  4111            FPCOND
06274  7777            -1
06275  5665          JMP I CONDIT
06276  4475  SYMTYI, SYMTYP

06277  0000  FLDOUT, 0       /OUTPUT FIELD DIGIT & "*"
06300  4554          TADICAD
06301  0113          AND N7          /GET FIELD
06302  4543          JMS I RTL6I     / TO BITS 3-5
06303  4527          JMS I TWOCI     / & OUTPUT "F*"
06304  6052            6052          / WHERE "F" IS DIGIT
06305  5677          JMP I FLDOUT



                     DECIMAL         /SET RADIX TO DECIMAL

       6306  TEMPL=  .               /ARGUMENT BUFFER
                             /L(TEMPL)=180(10)
       6572  F0END=  TEMPL+180
06306  0006          DMPHAN-F0END    /(SHOW SPACE LEFT)

                     OCTAL

       6400  PAGE    /****** MUST BE NO LITERALS! ******

/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 32-1

       6600  DMPHAN= 06600   /DUMP HANDLER AREA, 2 FIELD 0 PAGES

       7200  DEVHAN= 07200   /DEVICE HANDLER AREA, 2 FIELD 0 PGS


             IFNZRO  DMPHAN-F0END&4000  <BADERR,__CAN'T RUN>

             /IF THE ABOVE ASSEMBLES, THE BUFFERS ARE OVER-
             /  RUNNING THE DUMP DEVICE HANDLER.


       6306  *TEMPL  /ADD INITIALIZATION CODE WHICH IS OVERLAID

06306  0000  INIMSG, 0       /INITIALIZE ERROR MESSAGES ON SCRATCH BLKS
06307  6211          CDF 10
06310  1777          TAD I (7726     /BUT FIRST CHECK FOR "SCOPE MODE"
06311  6201          CDF 0
06312  0120          AND N200        / (BIT 4 OF 17726)
06313  7650          SNA CLA
06314  5322          JMP INIDAT      /  NOT SET, GO SET UP DATE
06315  1411  INISCO, TAD I SPNT      /SET, CHANGE RUBOUT HANDLER TO
06316  7450          SNA
06317  5322          JMP INIDAT      / ERASE CHARACTERS FROM SCREEN
06320  3410          DCA I DPNT      / AND FROM BUFFER (MUCH EASIER
06321  5315          JMP INISCO      / THAN ON HARD COPY!)
             /
06322  6211  INIDAT, CDF 10          /NOW INIT EXTENDED DATE
06323  1776          TAD I (7666     /GET SYSTEM DATE WORD
06324  6201          CDF 0
06325  0113          AND N7          /PICK OFF THIS YEAR PART
06326  7041          CIA
06327  3775'         DCA YRTEST      / AND SET TEST YEAR (NEG)
06330  1512          TAD I M1        /NOW GET EXTENDED YEAR BITS
06331  0374          AND (600        / FROM "B.I.P." WORD AND
06332  7112          CLL RTR         /  MOVE TO BITS 7,8 (*8)
06333  7012          RTR
06334  1373          TAD (106        /ADD TO A STARTING BASE OF 70[10]
06335  7041          CIA
06336  1775'         TAD YRTEST      /AND ADD THIS YEAR ALSO
06337  7041          CIA
06340  3772'         DCA YRBASE      /= 70 + EXTEND*8 + THIS YEAR
06341  1771          TAD I (7746     /GET JSW
06342  0370          AND (6777       /CLEAR BIT 2 (CAN RESTART!)
06343  7110          CLL RAR
06344  7124          STL RAL         /SET BIT 11 (DON'T SAVE FIELD 1)
06345  3771          DCA I (7746     /& PUT IT BACK
06346  4767          JMS I (7607     /WRITE ERROR MESSAGES
06347  4610            4610          / 6 PAGES, FIELD 1
06350  0000            0             / FROM LOC 10000
06351  0027            27            / NORMAL SAVE AREA!
06352  7610            SKP CLA
06353  5706          JMP I INIMSG    /OK, JUST EXIT
06354  1106          TAD M200
06355  3766'         DCA XERR3       /FAILED, ASSUME WRITE LOCKED
06356  1365          TAD (ERROR      / SO NO ERROR MESSAGES ON
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 32-2

06357  3764'         DCA ERC15       / ERROR OR "SHOW ERRORS"
06360  5706          JMP I INIMSG


06364  0545
06365  4573
06366  0505
06367  7607
06370  6777
06371  7746
06372  5032
06373  0106
06374  0600
06375  5031
06376  7666
06377  7726
       6400  PAGE    /LITERALS HERE ARE OK!
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 33

             /INITIALIZATION CODE--RESIDES IN BUFFER AREA AND IS WIPED
             /  OUT DURING EXECUTION.  HANDLES CHAINED AND NORMAL STARTS.

06400  7610  START,  CLA SKP         /NORMAL
06401  7240          STA             /CHAINED (FROM CCL!)
06402  3021          DCA TEMP
06403  6211          CDF 10
06404  3777          DCA I (CCBB     /ZAP CCB SWITCH
06405  6201          CDF 0
06406  1120          TAD N200
06407  3776          DCA I (7745     /RESET START ADDRESS
06410  4775'         JMS INIMSG      /INIT SCOPE, DATE & ERROR MESSAGES
06411  4774'         JMS BATSET      /TEST & SET UP FOR BATCH
06412  2021          ISZ TEMP        /CHAINED?
06413  5773          JMP I (201      / NO, START IT UP!
06414  6211          CDF 10
06415  1506          TAD I M200      /YES, 1ST OUTPUT DEVICE?
06416  6201          CDF 0
06417  0372          AND (17         /(IGNORE LENGTH SPEC)
06420  7450          SNA
06421  5271          JMP STSWIT      / NO, LEAVE AS SYS
06422  3101          DCA DEVNO       /YES, SET DEVICE NUMBER
06423  1101          TAD DEVNO
06424  4552          CALUSR          /NOW DO HANDLER FETCH BY
06425  0001            1             / NUMBER (PAINTING?)
06426  7201  STDEV,    DEVHAN+1      /--2 PAGES--
06427  5351            JMP STERR     /ARGGGG! FAILED!!!
06430  1226          TAD STDEV
06431  3100          DCA DEVAD       /SET UP HANDLER ENTRY
06432  1106          TAD M200
06433  3010          DCA DPNT        /SET UP FIELD 1 POINTER
06434  4553          TADIDP          /GET NAME OF FILE
06435  3025          DCA NAM1
06436  4553          TADIDP
06437  3026          DCA NAM2
06440  4553          TADIDP
06441  3027          DCA NAM3
06442  4553          TADIDP          /GET EXTENSION
06443  3030          DCA NAM4
06444  1025          TAD NAM1        /WAS THERE REALLY A NAME?
06445  7640          SZA CLA
06446  7240          STA             / YES, SET NAME SWITCH
06447  3021          DCA TEMP        / NO, RESET
06450  6211          CDF 10
06451  3771          DCA I (XDNAM    /CLEAR DEVICE NAME WORDS
06452  3770          DCA I (XDNAM+1
06453  1410          TAD I DPNT      /GET NEXT WORD & TEST FOR ZERO
06454  7640          SZA CLA
06455  5271          JMP STSWIT      / SOMETHING NOT RIGHT!
06456  1410          TAD I DPNT      /OK, ASSUME CCL CHAIN & SET
06457  3771          DCA I (XDNAM    / UP DEVICE NAME
06460  1410          TAD I DPNT
06461  3770          DCA I (XDNAM+1
06462  1771          TAD I (XDNAM    /EMPTY?
06463  7640          SZA CLA
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 33-1

06464  5271          JMP STSWIT
06465  1367          TAD (0423       /YES, MUST BE DEFAULT NAME--
06466  3771          DCA I (XDNAM    / "DSK"
06467  1366          TAD (1300
06470  3770          DCA I (XDNAM+1
06471  6211  STSWIT, CDF 10
06472  1765          TAD I (7643     /TEST SWITCHES
06473  0120          AND N200        / "/E"?
06474  3020          DCA ERMODE      / 0= LONG, NON-0= SHORT
06475  7001          IAC
06476  0765          AND I (7643     / "/L"? [LOAD]
06477  7650          SNA CLA
06500  5307          JMP STSWO       /NO, CHECK NEXT
06501  1030          TAD NAM4        /YES, SET DEFAULT EXTENSION
06502  7450          SNA
06503  1364          TAD (1404       / TO ".LD"
06504  3030          DCA NAM4
06505  7001          IAC
06506  5330          JMP STSWEX-2    / & GO SET MODE
             /
06507  1763  STSWO,  TAD I (7644
06510  0362          AND (1000       / "/O"? [OFFSET]
06511  7650          SNA CLA
06512  5320          JMP STSWS       /NO, GO CHECK LAST
06513  1761          TAD I (7646     /YES, GET LOW 12 BITS OF
06514  7041          CIA             / "=NNNN" AS OFFSET AND
06515  3073          DCA OFFSET      / IT UP
06516  7240          STA
06517  5331          JMP STSWEX-1    / & GO SET MODE
             /
06520  1763  STSWS,  TAD I (7644     / "/S"? [SAVE]
06521  0360          AND (40
06522  7650          SNA CLA
06523  5332          JMP STSWEX      /NO, WAS NOT ANY THAT COUNT
06524  1030          TAD NAM4        /YES, SET DEFAULT EXTENSION
06525  7450          SNA
06526  1357          TAD (2326       / TO ".SV"
06527  3030          DCA NAM4
06530  7001          IAC             / & SET MODE
06531  3044          DCA MODSW       /-1=OFF,0=NOR,+1=SV,+2=LD
06532  6201  STSWEX, CDF 0
06533  2021          ISZ TEMP        /FILE NAME SPECIFIED?
06534  5773          JMP I (201      / NO, JUST START
06535  3046          DCA CRSWT       /YES, SET SWITCH TO CR,
06536  6046  STTLS,  TLS             / START TTY     ***     BATCH OPER.
06537  4530          JMS I CRLFI     / & DO CR/LF
06540  1030          TAD NAM4        /ANY EXTENSION SPECIFIED?
06541  7650          SNA CLA
06542  7240          STA             / NO--ALLOW 3 TRIES: SV, LD, NULL
06543  3022          DCA TEMP1       /  ELSE ALLOW ONLY 1 TRY
06544  1030          TAD NAM4        /IF NO EXTENSION SET YET,
06545  7450          SNA
06546  1357          TAD (2326       / SET TO START DEFAULTS WITH SV
06547  3030          DCA NAM4
06550  5756'         JMP XFICHN      /NOW GO DO FILE LOOKUP
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 33-2

             /
06551  6046  STERR,  TLS             /START UP OUTPUT  ***   BATCH OPER.
06552  5755'         JMP ERCY        / & GIVE ERROR!


06555  1156
06556  1026
06557  2326
06560  0040
06561  7646
06562  1000
06563  7644
06564  1404
06565  7643
06566  1300
06567  0423
06570  2465
06571  2464
06572  0017
06573  0201
06574  6600
06575  6306
06576  7745
06577  6400
       6600  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 34

             /INITIALIZATION CODE FOR BATCH OPERATION

06600  0000  BATSET, 0
06601  1512          TAD I M1        /TEST BIT 1 OF 07777 FOR "BIP"
06602  7004          RAL             / (BATCH-IN-PROGRESS)
06603  7700          SMA CLA
06604  5600          JMP I BATSET    / NO, INTERACTIVE MODE
06605  1512          TAD I M1        / YES, GET FIELD BITS OF BATCH
06606  0377          AND (70         /  TO GENERATE A "CIF BAT"
06607  1376          TAD (CIF        /   AND SET UP 3 CALLS:
06610  3307          DCA CBATI       /       INPUT,
06611  1307          TAD CBATI
06612  3346          DCA CBATO       /       OUTPUT AND
06613  1307          TAD CBATI
06614  3336          DCA CBATE       /       ERROR.
06615  1412  BATMOV, TAD I SCANX1    /GET NEXT STORAGE ADDRESS
06616  7450          SNA
06617  5600          JMP I BATSET    / 0 = ALL DONE!
06620  3010          DCA DPNT        /SET UP POINTER
06621  1412  BATLUP, TAD I SCANX1    /GET A PATCH WORD
06622  7450          SNA
06623  5215          JMP BATMOV      / 0 = GROUP END
06624  6201  BATPAT, CDF 0           /CHANGED FOR "TYPEB"!!
06625  3410          DCA I DPNT      /PATCH THE WORD
06626  6201          CDF 0
06627  5221          JMP BATLUP      /DO IT AGAIN!


             /"SCOPE MODE" PATCHES FOR RUBOUT HANDLER.  INITIAL-
             /  IZATION CODE FIRST CHECKS FOR SCOPE AND THEN FOR
             /  BATCH.  THUS, IF BOTH ARE SET, FIRST THINGS WILL BE
             /  SET UP FOR SCOPE AND THEN THEY WILL BE RESET FOR
             /  BATCH.  THIS SEQUENCE IS REQUIRED!

06776  6202
06777  0070
       4031  SCOPLS, RELOC   RUBO
04031* 4303          JMS BTEST       /BUFFER NOW EMPTY?
04032* 5207          JMP RENEXT      / YES, JUST IGNORE RUBOUT
04033* 7240          STA
04034* 1015          TAD COMIR       /NO, BACK UP POINTER
04035* 3015          DCA COMIR
04036* 1015          TAD COMIR       /SET UP POINTER FOR TESTING, ALSO
04037* 3016          DCA COMOUT
04040* 4247          JMS RUBO2       /OUTPUT BACKSPACE, SPACE, BACKSPACE
04041* 4563          JMS I GETNI     /GET RUBBED OUT CHAR AND TEST
04042* 1035          TAD CHAR
04043* 1104          TAD M240        / FOR A CONTROL CHAR
04044* 7710          SPA CLA
04045* 4247          JMS RUBO2       /YES, ERASE "^" ALSO!
04046* 5207          JMP RENEXT      /TRY FOR ANOTHER CHAR

04047* 7402  RUBO2,  HLT     /MUST BE NON-ZERO!!!
04050* 4656          JMS I TYPEAI    /OUTPUT A BACKSPACE,
04051* 0210            "H-100        /(CTRL-H)
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 34-1

04052* 4532          SPACE1          / SPACE,
04053* 4656          JMS I TYPEAI    / BACKSPACE SEQUENCE TO
04054* 0210            "H-100        / CLEAR OFF SCREEN CHAR
04055* 5647          JMP I RUBO2
04056* 5033  TYPEAI, TYPEA
04057* 0000          0

       6657          RELOC


             BATLS,  /PATCHES--ADDRESS-1, CODE, 0 WITH EXTRA 0 FOR END.

06657  4030          RUBO-1          /==== INPUT PATCHES ====
       4031          RELOC   RUBO
04031* 3035          DCA CHAR        /SAVE NEW CHAR INPUT
04032* 1035          TAD CHAR        /IS THIS A FORM-FEED?
04033* 1252          TAD RM214
04034* 7450          SNA
04035* 5313          JMP RKEY+1      / YES, JUST IGNORE IT!
04036* 1253          TAD R2          /NO, THEN IS IT A LINE-FEED?
04037* 7650          SNA CLA
04040* 1254          TAD RLAST       / YES, WAS LAST A CARRIAGE-RETURN?
04041* 1105          TAD M215
04042* 7640          SZA CLA
04043* 1035          TAD CHAR        /NO TO ONE OR OTHER, USE CHAR.
04044* 3254          DCA RLAST       / YES TO BOTH, SET TO 0!
04045* 1254          TAD RLAST       /OK, WAS IT A CR-LF PAIR?
04046* 7650          SNA CLA
04047* 5313          JMP RKEY+1      /  YES, JUST IGNORE LF!
04050* 5212          JMP REKEY+1     /  NO, GO USE THIS CHAR

04051* 5400  BATINI, 5400            /IN THE BATCH FIELD
04052* 7564  RM214,  -214
04053* 0002  R2,     2
04054* 0215  RLAST,  215             /!!! CR OF ".R FUTIL" HAS AN LF !!
04055* 0000          0

04056* 4112          RKEY+1-1
       6706          RELOC           /TO PUT 'CBATI' ON THIS PAGE
       6707  CBATI=  .+1             /REALLY ON "CIF BAT"
       4113          RELOC   RKEY+1
04113* 4534          JMS I CTRLI     /CHECK FOR CONTROL KEYS
04114* 6202          CIF             /***    CIF BAT
04115* 4651          JMS I BATINI    /GET A BATCH CHARACTER
04116* 4573  ERC17,  ERROR           /!!! EOF ON INPUT !!!
04117* 7000          NOP             /FILLER FOR INTERACTIVE CTRL-Q
04120* 7000          NOP
04121* 0000          0

04122* 4125          RKEY0-1
       4126          RELOC   RKEY0
04126* 5313          JMP RKEY+1      /IGNORE RUBOUT UNDER BATCH
04127* 7000          NOP             / & RETURN TO CALL+1!
04130* 0000          0

/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 34-2

04131* 5134          BCTRLC-1
       5135          RELOC   BCTRLC
05135* 5762          JMP I CTRLCI    /CTRL-C, ABORT JOB STREAM!
05136* 0000          0

       6724          RELOC           /==== OUTPUT PATCHES ====
06724  0200          201-1
06725  7000          NOP
06726  0000          0

06727  6535          STTLS-1
06730  7000          NOP             /ZAP 3 "TLS"S USED FOR STARTUP
06731  0000          0

06732  6550          STERR-1
06733  7000          NOP
06734  0000          0

       6735          RELOC           /==== ERROR PATCH ====

06735  0514          XERR4-1
       6736  CBATE=  .               /REALLY ON "CIF BAT"
       0515          RELOC   XERR4
00515* 6202          CIF             /***    CIF BAT
00516* 5522          JMP I N7000     /ABORT TO BATCH FIELD!
00517* 0000          0

       6741          RELOC

06741  6623          BATPAT-1
06742  6211          CDF 10          /*** NEXT CODE IN FIELD 1 ***
06743  0000          0

06744  2404          TYPEB-1
       6745          RELOC
       6746  CBATO=  .+1             /REALLY ON "CIF BAT"
                     IFDEF   TYPEB   </NO PASS1 ERROR!
       2405          RELOC   TYPEB   /*** REALLY IN FIELD 1 ***
                     >
02405* 6211          CDF 10          /***    SET UP RETURN D.F.
02406* 6202          CIF             /***    CIF BAT
02407* 4610          JMS I .+1       /OUTPUT A CHARACTER TO LOG
02410* 7400            7400          /BATOUT, IN THE BATCH FIELD
02411* 6201          CDF 0           /***    RESET D.F.
02412* 0000          0

       6753          RELOC

06753  0000          0
       7000          PAGE



/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 35


       7000          *7000
                     /NEW CODE TO HANDLE 128K SUPPORT
07000  0000  ADFLD,  0       /ADJUSTS BANK AND FIELD FOR CCB PRINTING
07001  1023          TAD TEMP2
07002  0377          AND (76
07003  7112          CLL RTR
07004  7430          SZL
07005  1376          TAD (20
07006  7106          CLL RTL
07007  4775          JMS I (FPRNT
07010  5600          JMP I ADFLD
07011  0000  FPRNTX, 0               /ROUTINE TO PRINT BANK BITS
07012  0374          AND (174        /ISOLATE BANK AND FIELD BITS
07013  3226          DCA FLD
07014  1226          TAD FLD
07015  0373          AND (104        /ISOLATE BANK BITS
07016  7112          CLL RTR         /SSWITCH THEM AROUND
07017  7010          RAR
07020  7430          SZL
07021  1372          TAD (4
07022  7112          CLL RTR
07023  4531          DIGIT           /PRINT BANK BITS
07024  1226          TAD FLD
07025  5611          JMP I FPRNTX
07026  0000  FLD,    0

07172  0004
07173  0104
07174  0174
07175  1363
07176  0020
07177  0076
       0001  FIELD   1       /THE END OF FIELD 0!
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36

       0000  *10000          /PUT A POINTER HERE!

10000  3542          NXTIOT  /ADDR OF NEXT FREE SPACE IN TABLE


             /ERROR MESSAGES AND ADDRESS LIST.  THESE ITEMS RESIDE
             /  UNDER THE USR, REQUIRING THAT THE USR SWAP THEM
             /  WHEN IT IS USED AND THAT THE PROGRAM KICK OUT THE
             /  USR WHEN AN ERROR OCCURS IN LONG ERROR MESSAGE MODE
             /  OR WHEN A "SHOW ERRORS" COMMAND IS GIVEN.  IT IS
             /  TO THE ADVANTAGE OF DECTAPE (AND PROBABLY ALSO
             /  FLOPPY DISK) SYSTEMS TO USE SHORT ERROR MESSAGE
             /  MODE TO REDUCE USR SWAPPING IF DOING MANY "FILE"
             /  OR "SET DEVICE ...DDEV..." COMMANDS.

       0002  *10002  /MESSAGE ADDRESS AT ERROR CODE NUMBER +1 (AUTO-XR)

             /LIST OF ADDRESSES OF ERROR MESSAGES

10002  0062          ERMSA
10003  0100          ERMSB
10004  0116          ERMSC
10005  1104          ERMS14
10006  0125          ERMSD
10007  0137          ERMSE
10010  0227          ERMSG
10011  0242          ERMSH
10012  0256          ERMSI
10013  0276          ERMSK
10014  0267          ERMSJ
10015  0322          ERMSXO
10016  0341          ERMSL
10017  0651          ERMSZ
10020  0404          ERMSO
10021  1051          ERMS11
10022  0717          ERMS04
10023  0417          ERMSP
10024  0435          ERMSQ
10025  0456          ERMSR
10026  1030          ERMS09
10027  1003          ERMS08
10030  1071          ERMS13
10031  0501          ERMSS
10032  0523          ERMST
10033  0543          ERMSU
10034  0564          ERMSV
10035  0604          ERMSW
10036  0622          ERMSX
10037  0636          ERMSY
10040  0361          ERMSM
10041  0673          ERMS00
10042  0671          ERMS01
10043  0706          ERMS02
10044  0704          ERMS03
10045  1037          ERMS10
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-1

10046  0150          ERMSF
10047  0171          ERMSGC
10050  0207          ERMSHD
10051  0742          ERMS05
10052  0764          ERMS07
10053  1163          ERMS18
10054  1172          ERMS19
10055  1201          ERMS20
10056  1124          ERMS15
10057  1135          ERMS16
10060  1151  EMSEND, ERMS17
10061  1212          ERMS99


             /ERROR MESSAGES:

10062  1114  ERMSA,  TEXT &ILLEGAL SINGLE-WORD COMMAND&
10063  1405
10064  0701
10065  1440
10066  2311
10067  1607
10070  1405
10071  5527
10072  1722
10073  0440
10074  0317
10075  1515
10076  0116
10077  0400

10100  1114  ERMSB,  TEXT &ILLEGAL MULTI-WORD COMMAND&
10101  1405
10102  0701
10103  1440
10104  1525
10105  1424
10106  1155
10107  2717
10110  2204
10111  4003
10112  1715
10113  1501
10114  1604
10115  0000

10116  2417  ERMSC,  TEXT &TOO MANY ")"S&
10117  1740
10120  1501
10121  1631
10122  4042
10123  5142
10124  2300

10125  1114  ERMSD,  TEXT &ILLEGAL FORMAT WORD&
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-2

10126  1405
10127  0701
10130  1440
10131  0617
10132  2215
10133  0124
10134  4027
10135  1722
10136  0400

10137  0201  ERMSE,  TEXT &BAD FORMAT SYNTAX&
10140  0440
10141  0617
10142  2215
10143  0124
10144  4023
10145  3116
10146  2401
10147  3000

10150  1617  ERMSF,  TEXT &NO FILE FOR C.C.B./HEADER REQUEST&
10151  4006
10152  1114
10153  0540
10154  0617
10155  2240
10156  0356
10157  0356
10160  0256
10161  5710
10162  0501
10163  0405
10164  2240
10165  2205
10166  2125
10167  0523
10170  2400

10171  0201  ERMSGC, TEXT &BAD C.C.B (NOT A SAVE FILE)&
10172  0440
10173  0356
10174  0356
10175  0240
10176  5016
10177  1724
10200  4001
10201  4023
10202  0126
10203  0540
10204  0611
10205  1405
10206  5100

10207  0201  ERMSHD, TEXT &BAD HEADER (NOT A LOAD MODULE)&
10210  0440
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-3

10211  1005
10212  0104
10213  0522
10214  4050
10215  1617
10216  2440
10217  0140
10220  1417
10221  0104
10222  4015
10223  1704
10224  2514
10225  0551
10226  0000

10227  1114  ERMSG,  TEXT &ILLEGAL ITEM TO SHOW&
10230  1405
10231  0701
10232  1440
10233  1124
10234  0515
10235  4024
10236  1740
10237  2310
10240  1727
10241  0000

10242  1114  ERMSH,  TEXT &ILLEGAL SEARCH MODIFIER&
10243  1405
10244  0701
10245  1440
10246  2305
10247  0122
10250  0310
10251  4015
10252  1704
10253  1106
10254  1105
10255  2200

10256  0201  ERMSI,  TEXT &BAD SEARCH SYNTAX&
10257  0440
10260  2305
10261  0122
10262  0310
10263  4023
10264  3116
10265  2401
10266  3000

10267  1114  ERMSJ,  TEXT &ILLEGAL MODE&
10270  1405
10271  0701
10272  1440
10273  1517
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-4

10274  0405
10275  0000

10276  2305  ERMSK,  TEXT &SET OPTION FOLLOWED BY A CR, BAD SYNTAX&
10277  2440
10300  1720
10301  2411
10302  1716
10303  4006
10304  1714
10305  1417
10306  2705
10307  0440
10310  0231
10311  4001
10312  4003
10313  2254
10314  4002
10315  0104
10316  4023
10317  3116
10320  2401
10321  3000

10322  1625  ERMSXO, TEXT &NUMBER OR ILLEGAL SET OPTION&
10323  1502
10324  0522
10325  4017
10326  2240
10327  1114
10330  1405
10331  0701
10332  1440
10333  2305
10334  2440
10335  1720
10336  2411
10337  1716
10340  0000

10341  1625  ERMSL,  TEXT &NUMBER OR ILLEGAL OUTPUT OPTION&
10342  1502
10343  0522
10344  4017
10345  2240
10346  1114
10347  1405
10350  0701
10351  1440
10352  1725
10353  2420
10354  2524
10355  4017
10356  2024
10357  1117
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-5

10360  1600

10361  1114  ERMSM,  TEXT &ILLEGAL "." IN NAME (FILE OR DEVICE)&
10362  1405
10363  0701
10364  1440
10365  4256
10366  4240
10367  1116
10370  4016
10371  0115
10372  0540
10373  5006
10374  1114
10375  0540
10376  1722
10377  4004
10400  0526
10401  1103
10402  0551
10403  0000

10404  1114  ERMSO,  TEXT &ILLEGAL MODIFY FORMAT&
10405  1405
10406  0701
10407  1440
10410  1517
10411  0411
10412  0631
10413  4006
10414  1722
10415  1501
10416  2400

10417  2022  ERMSP,  TEXT &PROGRAM OR HARDWARE PROBLEM&
10420  1707
10421  2201
10422  1540
10423  1722
10424  4010
10425  0122
10426  0427
10427  0122
10430  0540
10431  2022
10432  1702
10433  1405
10434  1500

10435  0201  ERMSQ,  TEXT &BAD TERMINATOR IN SINGLE ARGUMENT&
10436  0440
10437  2405
10440  2215
10441  1116
10442  0124
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-6

10443  1722
10444  4011
10445  1640
10446  2311
10447  1607
10450  1405
10451  4001
10452  2207
10453  2515
10454  0516
10455  2400

10456  2405  ERMSR,  TEXT &TERMINATOR BEFORE LEGAL NUMBER INPUT&
10457  2215
10460  1116
10461  0124
10462  1722
10463  4002
10464  0506
10465  1722
10466  0540
10467  1405
10470  0701
10471  1440
10472  1625
10473  1502
10474  0522
10475  4011
10476  1620
10477  2524
10500  0000

10501  0201  ERMSS,  TEXT &BAD TERMINATOR IN MULTIPLE ARGUMENT&
10502  0440
10503  2405
10504  2215
10505  1116
10506  0124
10507  1722
10510  4011
10511  1640
10512  1525
10513  1424
10514  1120
10515  1405
10516  4001
10517  2207
10520  2515
10521  0516
10522  2400

10523  1114  ERMST,  TEXT &ILLEGAL CHARACTER IN EXPRESSION&
10524  1405
10525  0701
10526  1440
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-7

10527  0310
10530  0122
10531  0103
10532  2405
10533  2240
10534  1116
10535  4005
10536  3020
10537  2205
10540  2323
10541  1117
10542  1600

10543  1114  ERMSU,  TEXT &ILLEGAL USE OF "(" IN EXPRESSION&
10544  1405
10545  0701
10546  1440
10547  2523
10550  0540
10551  1706
10552  4042
10553  5042
10554  4011
10555  1640
10556  0530
10557  2022
10560  0523
10561  2311
10562  1716
10563  0000

10564  1114  ERMSV,  TEXT &ILLEGAL OPERATOR IN EXPRESSION&
10565  1405
10566  0701
10567  1440
10570  1720
10571  0522
10572  0124
10573  1722
10574  4011
10575  1640
10576  0530
10577  2022
10600  0523
10601  2311
10602  1716
10603  0000

10604  2417  ERMSW,  TEXT &TOO FEW ")"S IN EXPRESSION&
10605  1740
10606  0605
10607  2740
10610  4251
10611  4223
10612  4011
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-8

10613  1640
10614  0530
10615  2022
10616  0523
10617  2311
10620  1716
10621  0000

10622  0411  ERMSX,  TEXT &DIVISION BY 0 ATTEMPTED&
10623  2611
10624  2311
10625  1716
10626  4002
10627  3140
10630  6040
10631  0124
10632  2405
10633  1520
10634  2405
10635  0400

10636  2516  ERMSY,  TEXT &UNKNOWN HANDLER NAME&
10637  1316
10640  1727
10641  1640
10642  1001
10643  1604
10644  1405
10645  2240
10646  1601
10647  1505
10650  0000

10651  1625  ERMSZ,  TEXT &NUMBER OR ILLEGAL ERROR OPTION&
10652  1502
10653  0522
10654  4017
10655  2240
10656  1114
10657  1405
10660  0701
10661  1440
10662  0522
10663  2217
10664  2240
10665  1720
10666  2411
10667  1716
10670  0000

10671  1617  ERMS01, TEXT &NON-&
10672  1655
10673  0000
       0673          *.-1

/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-9

10673  0601  ERMS00, TEXT &FATAL READ ERROR&
10674  2401
10675  1440
10676  2205
10677  0104
10700  4005
10701  2222
10702  1722
10703  0000

10704  1617  ERMS03, TEXT &NON-&
10705  1655
10706  0000
       0706          *.-1

10706  0601  ERMS02, TEXT &FATAL WRITE ERROR&
10707  2401
10710  1440
10711  2722
10712  1124
10713  0540
10714  0522
10715  2217
10716  2200

10717  1704  ERMS04, TEXT &ODD START LOC OR COUNT IN OS/8 MODIFY&
10720  0440
10721  2324
10722  0122
10723  2440
10724  1417
10725  0340
10726  1722
10727  4003
10730  1725
10731  1624
10732  4011
10733  1640
10734  1723
10735  5770
10736  4015
10737  1704
10740  1106
10741  3100

10742  0201  ERMS05, TEXT &BAD ADDRESS/OVERLAY (ODT COMMANDS)&
10743  0440
10744  0104
10745  0422
10746  0523
10747  2357
10750  1726
10751  0522
10752  1401
10753  3140
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-10

10754  5017
10755  0424
10756  4003
10757  1715
10760  1501
10761  1604
10762  2351
10763  0000

             /ERMS06,

10764  0201  ERMS07, TEXT &BAD ADDRESS/OVERLAY (MODIFY)&
10765  0440
10766  0104
10767  0422
10770  0523
10771  2357
10772  1726
10773  0522
10774  1401
10775  3140
10776  5015
10777  1704
11000  1106
11001  3151
11002  0000

11003  0122  ERMS08, TEXT &ARGUMENT EXPRESSION NOT TERMINATED BY ")"&
11004  0725
11005  1505
11006  1624
11007  4005
11010  3020
11011  2205
11012  2323
11013  1117
11014  1640
11015  1617
11016  2440
11017  2405
11020  2215
11021  1116
11022  0124
11023  0504
11024  4002
11025  3140
11026  4251
11027  4200

11030  1114  ERMS09, TEXT &ILLEGAL DIGIT&
11031  1405
11032  0701
11033  1440
11034  0411
11035  0711
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-11

11036  2400

11037  0425  ERMS10, TEXT &DUMP HANDLER ERROR&
11040  1520
11041  4010
11042  0116
11043  0414
11044  0522
11045  4005
11046  2222
11047  1722
11050  0000

11051  1625  ERMS11, TEXT &NUMBER OR ILLEGAL DMODE OPTION&
11052  1502
11053  0522
11054  4017
11055  2240
11056  1114
11057  1405
11060  0701
11061  1440
11062  0415
11063  1704
11064  0540
11065  1720
11066  2411
11067  1716
11070  0000

             /ERMS12,

11071  1114  ERMS13, TEXT &ILLEGAL USE OF ' OR "&
11072  1405
11073  0701
11074  1440
11075  2523
11076  0540
11077  1706
11100  4047
11101  4017
11102  2240
11103  4200

11104  1501  ERMS14, TEXT &MAPPED MODE--USE LIST, NOT DUMP&
11105  2020
11106  0504
11107  4015
11110  1704
11111  0555
11112  5525
11113  2305
11114  4014
11115  1123
11116  2454
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-12

11117  4016
11120  1724
11121  4004
11122  2515
11123  2000

11124  1617  ERMS15, TEXT &NO ERROR MESSAGES&
11125  4005
11126  2222
11127  1722
11130  4015
11131  0523
11132  2301
11133  0705
11134  2300

11135  1116  ERMS16, TEXT &INPUT ERROR ON MESSAGES&
11136  2025
11137  2440
11140  0522
11141  2217
11142  2240
11143  1716
11144  4015
11145  0523
11146  2301
11147  0705
11150  2300

11151  0517  ERMS17, TEXT &EOF ON BATCH INPUT&
11152  0640
11153  1716
11154  4002
11155  0124
11156  0310
11157  4011
11160  1620
11161  2524
11162  0000

11163  0516  ERMS18, TEXT &ENTER FAILED&
11164  2405
11165  2240
11166  0601
11167  1114
11170  0504
11171  0000

11172  0314  ERMS19, TEXT &CLOSE FAILED&
11173  1723
11174  0540
11175  0601
11176  1114
11177  0504
11200  0000
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 36-13


11201  0425  ERMS20, TEXT &DUMP FILE OVERRUN&
11202  1520
11203  4006
11204  1114
11205  0540
11206  1726
11207  0522
11210  2225
11211  1600

11212  0405  ERMS99, TEXT &DEBUG&
11213  0225
11214  0700
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 37

       2000  *12000  /BEGIN ABOVE THE USR AREA

             /GCCB & GHDR--ROUTINES TO READ IN THE FIRST BLOCK OF THE
             /  LAST FILE SPECIFIED BY THE LAST "FILE" COMMAND, ASSUM-
             /  ING THAT IT WAS A SAVE FILE OR LOAD MODULE, AND DO THE
             /  FEW CHECKS THAT ARE AVAILABLE TO TEST FOR A CCB (CORE-
             /  CONTROL-BLOCK) OR HEADER BLOCK BEFORE LETTING THE DATA
             /  BE USED FOR THE APPROPRIATE PURPOSE.

12000  0000  GCCB,   0       /GET CORE-CONTROL-BLOCK
12001  4306          JMS CCBHDR      /DO COMMON TEST & READ-IN
12002  7104          CLL RAL         /ADJUSTS FOR 128K INDICATOR BIT
12003  7130          STL RAR
12004  7700          SMA CLA         /1ST WORD (-# SEGS) NEG?
12005  5222          JMP GCCERR      / NO, CAN'T BE CCB
12006  1777          TAD I (CCBB+3   /GET JOB STATUS WORD
12007  0376          AND (200        /OVERLAY BIT SET (LINK)?
12010  7640          SZA CLA         / 0 = NO
12011  1375          TAD (CCBB+140-1 / 1 = YES, START ADDR-1
12012  6201          CDF 0
12013  3774          DCA I (OVLFLG   /NO = 0; YES = ADDR-1
12014  6211          CDF 10
12015  1773          TAD I (CCBB+1   /2ND WORD A "CDF CIF X0"?
12016  0372          AND (7603
12017  7041  CIA
12020  1246          TAD GCCCDF
12021  7640          SZA CLA
12022  4771' GCCERR, JMS ERROR1      /LOOKS BAD, JUST EXIT NOW!
12023  2341          ISZ GETSWX      /LOOKS OK, 1ST TIME SINCE READ?
12024  5242          JMP GCCB2       /NO, DON'T CHANGE THINGS AGAIN
12025  1370          TAD (CCBB+140+3 /YES, POINT TO LENGTH WORDS
12026  3250  GCCB1,  DCA GHDR        / TO CHANGE PAGES TO BLOCKS
12027  1250          TAD GHDR        /GET A WORD - PAGES-V7C
12030  1367          TAD (-6603      /V7C
12031  7650          SNA CLA         /V7C
12032  5242          JMP GCCB2       / 0 = DONE
12033  1650          TAD I GHDR      /V7C
12034  7001          IAC             /ROUND DOWN IN 2 STEPS FOR PDP-8
12035  7110          CLL RAR
12036  3650          DCA I GHDR      /STORE A WORD - BLOCKS
12037  1250          TAD GHDR        /UPDATE POINTER TO NEXT
12040  1366          TAD (4
12041  5226          JMP GCCB1
             /
12042  3341  GCCB2,  DCA GETSWX      /BE SURE SWITCH STAYS CLEAR
12043  1727          TAD I SEGNI     /GET -# SEGMENTS
12044  7104          CLL RAL
12045  7130          STL RAR         /ADJUSTS FOR 128K INDICATOR BIT
12046  6203  GCCCDF, CDF CIF 0
12047  5600          JMP I GCCB      /OK, RETURN VALUE

12050  0000  GHDR,   0       /GET HEADER BLOCK (FORTRAN IV)
12051  1365          TAD (3          /TO SET UP CCBB+6
12052  4306          JMS CCBHDR      /DO COMMON TEST & READ-IN
12053  1364          TAD (-2         /1ST WORD MUST BE EXACTLY 2
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 37-1

12054  7640          SZA CLA
12055  5301          JMP HDRERR      / NO, CAN'T BE A HEADER
12056  2341          ISZ GETSWX      /1ST TIME THRU SINCE READ?
12057  5302          JMP GHDR1       / NO, DON'T CHANGE ANYTHING
12060  3763          DCA I (CCBB+47  /YES, BE SURE THESE WORDS
12061  3762          DCA I (CCBB+50  / ARE 0 FOR USERS
12062  1773          TAD I (CCBB+1   /GET START FIELD WORD
12063  7450          SNA
12064  5301          JMP HDRERR      / SHOULD BE 1 THRU 7
12065  7106          CLL RTL         /LOOKS OK, MOVE FIELD TO BITS
12066  7004          RAL             / 6-8 TO HELP "SHOW HEAD"
12067  3773          DCA I (CCBB+1
12070  1773          TAD I (CCBB+1   /ARE THESE ONLY BITS SET?
12071  0361          AND (7707
12072  7640          SZA CLA
12073  5301          JMP HDRERR      / NO, SOMETHING MUST BE BAD
12074  1777          TAD I (CCBB+3   /OK, TEST FIELD OF NEXT FREE
12075  7450          SNA
12076  5301          JMP HDRERR      / SHOULD BE 1 THRU 7
12077  0360          AND (7770
12100  7640          SZA CLA
12101  4771' HDRERR, JMS ERROR1
12102  3341  GHDR1,  DCA GETSWX      /MAKE SURE THIS IS 0
12103  7000          NOP             /AC NON-ZERO FOR OK-V7C
12104  6203          CDF CIF 0
12105  5650          JMP I GHDR      /OK, BACK TO USER

12106  0000  CCBHDR, 0
12107  1377          TAD (CCBB+3     /CCBB+6 FOR GHDR
12110  6201          CDF 0
12111  3757          DCA I (GETPNT   /SET UP POINTER FOR 'GET'
12112  1756          TAD I (DEVAD    /GET ADDR OF DEVICE
12113  3340          DCA DEVADX      / HANDLER & SAVE HERE
12114  1755          TAD I (RBLK1    /GET START BLOCK NUMBER
12115  7450          SNA
12116  4771' ERCF,   JMS ERROR1      / NO FILE!!! GIVE ERROR
12117  6211          CDF 10
12120  3330          DCA GCCBLK      /OK, SET UP 1ST BLOCK
12121  1727          TAD I SEGNI     /IS SOMETHING IN MEMORY?
12122  7440          SZA
12123  5706          JMP I CCBHDR    / YES, RETURN 1ST WORD
12124  6202          CIF 0
12125  4740          JMS I DEVADX    /NO, READ 1ST BLOCK OF FILE
12126  0110            0110          /READ; 1 PAGE; FIELD 1
12127  6400  SEGNI,    CCBB          /BUFFER IS HERE
12130  0000  GCCBLK,   0             /BLOCK NUMBER
12131  5336            JMP RDERX     /...BAD NEWS...
12132  7240          STA
12133  3341          DCA GETSWX      /OK, SET "JUST READ" SWITCH
12134  1727          TAD I SEGNI     /AND GET 1ST WORD
12135  5706          JMP I CCBHDR
             /
12136  6203  RDERX,  CDF CIF 0       /RETURN TO FIELD 0
12137  5754          JMP I (RERROR   / FOR READ ERROR

/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 37-2

12140  0000  DEVADX, 0
12141  0000  GETSWX, 0


12142  4040  MSMOD,  TEXT "  MOD"
12143  1517
12144  0400

12145  4002  MSBAD,  TEXT " BAD BLOCK"
12146  0104
12147  4002
12150  1417
12151  0313
12152  0000


12154  2213
12155  0077
12156  0100
12157  0014
12160  7770
12161  7707
12162  6450
12163  6447
12164  7776
12165  0003
12166  0004
12167  1175
12170  6543
12171  2433
12172  7603
12173  6401
12174  0000
12175  6537
12176  0200
12177  6403
       2200  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 38

             /CONTINUATION OF OUTPUT COMMANDS AND ROUTINES FROM FIELD 0

             /CONTINUATION OF 'SET' 'DDEV' HANDLER

12200  3263  XDDEV1, DCA DDEVAD      /SET UP HANDLER ADDRESS
12201  1777          TAD I (GDEV2
12202  3264          DCA DDEVNO      / AND DEVICE NUMBER
12203  6211          CDF 10
12204  1264          TAD DDEVNO      /LOOK AT DCW FOR SPECIFIED
12205  1376          TAD (7760-1     / DEVICE TO SEE IF FILE
12206  3265          DCA DDCWPT      / STRUCTURED.
12207  1665          TAD I DDCWPT    /BIT 0 = 1 FOR FILES
12210  7700          SMA CLA
12211  1375          TAD (212        / NO, LINE-AT-A-TIME
12212  3774'         DCA DDEVS       / YES, BLOCK-AT-A-TIME
12213  1340          TAD DMPADR      /OK, INITIALIZE OUTPUT POINTER
12214  3353          DCA DMPPTR
12215  3253          DCA XOSIZ       / AND ZERO BLOCK COUNTER
12216  3266          DCA DNAM        / AND CLEAR ANY FILE NAME
12217  7001          IAC
12220  3341          DCA DMPBLK      / AND SET BLOCK NUMBER TO 1
12221  5773'         JMP XDDEV2      /LAST, GO SET UP NAME FOR OUTPUT


             /CONTINUATION OF EXECUTION OF 'OPEN' COMMAND

12222  1372  XOPEN1, TAD (NAM1-1     /SET UP POINTER TO FIELD 0 FILE
12223  3010          DCA DPNT        / NAME (NOTE: XR IN FIELD 1!!!)
12224  1410          TAD I DPNT      /MOVE THE FILE NAME UP HERE
12225  3266          DCA DNAM
12226  1410          TAD I DPNT
12227  3267          DCA DNAM+1
12230  1410          TAD I DPNT
12231  3270          DCA DNAM+2
12232  1410          TAD I DPNT      /GET THE EXTENSION PART
12233  2771          ISZ I (TEMP1    / WAS ANYTHING REALLY SPECIFIED?
12234  5237          JMP XOPEN2
12235  7200          CLA
12236  1370          TAD (0425       /  NO, DEFAULT TO ".DU"
12237  3271  XOPEN2, DCA DNAM+3
12240  1310          TAD XCLNAM      /SET UP POINTER TO NAME FOR USR
12241  3252          DCA XOBLK
12242  6211          CDF 10          /SET UP RETURN FIELD
12243  1665          TAD I DDCWPT    /CLEAR ANY OPEN FILE ON
12244  0367          AND (7770       / THIS DEVICE SO "OPEN"
12245  3665          DCA I DDCWPT    / CAN BE DONE WHENEVER!
12246  6202          CIF 0           /SET UP SUBROUTINE FIELD
12247  1264          TAD DDEVNO      /GET DUMP DEVICE NUMBER
12250  4766'         JMS USEUSR      / AND GO GET USR & CALL IT.
12251  0003            3             /ENTER
12252  0000  XOBLK,    0     /NAME POINTER, BECOMES START BLK
12253  0000  XOSIZ,    0     / BECOMES -# BLOCKS CAN USE
12254  4765' ERC18,    JMS ERROR1    /THE ENTER FAILED!
12255  1252          TAD XOBLK       /OK! SET UP FILE START BLOCK
12256  3341          DCA DMPBLK
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 38-1

12257  1340          TAD DMPADR      /INITIALIZE POINTER
12260  3353          DCA DMPPTR
12261  6203  XOCEX,  CDF CIF 0
12262  5764'         JMP MAIN1       /TRY NEXT COMMAND

12263  7607  DDEVAD, 7607    /INIT ADDRESS TO "SYS:" (SEE ABOVE)
12264  0001  DDEVNO, 1       /INIT THIS TO "SYS:" ALSO.
12265  7760  DDCWPT, 7760    / THIS ALSO

12266  0000  DNAM,   0       /DUMP FILE NAME, INIT TO NULL
12267  0000          0
12270  0000          0
12271  0000          0       /(EXTENSION HERE)


             /CONTINUATION OF EXECUTION OF 'CLOSE' COMMAND

12272  1266  XCLOS1, TAD DNAM        /IS ANY FILE OPEN?
12273  7650          SNA CLA
12274  5261          JMP XOCEX       / NO, IGNORE COMMAND
12275  1277          TAD XCTLZ       / YES, OUTPUT A CTRL-Z
12276  4315          JMS DMPOUT      /  AND FILL TO END
12277  0232  XCTLZ,    "Z-100
12300  1252          TAD XOBLK       /OK, CALCULATE FILE SIZE
12301  7041          CIA
12302  1341          TAD DMPBLK      /= NEXT - START
12303  3311          DCA XCLSIZ      /= FILE SIZE IN BLOCKS
12304  1264          TAD DDEVNO      /GET DUMP DEVICE NUMBER
12305  6202          CIF 0
12306  4766'         JMS USEUSR      /GET USR AND CALL IT
12307  0004            4             /CLOSE
12310  2266  XCLNAM,   DNAM          /POINTER TO FILE NAME
12311  0000  XCLSIZ,   0             /SIZE OF NEW FILE
12312  4765' ERC19,    JMS ERROR1    /OH NO! CLOSE FAILED!
12313  3266          DCA DNAM        /OK, ZAP KNOWLEDGE OF FILE
12314  5261          JMP XOCEX


12315  0000  DMPOUT, 0       /DUMP FILE CHARACTER OUTPUT ROUTINE
12316  3352          DCA DMPCHR      /SAVE THE CHARACTER
12317  1352          TAD DMPCHR      /PUT IT INTO FILE BUFFER
12320  6211          CDF 10          /(MUST BE SURE!)
12321  3753  DMPNUL, DCA I DMPPTR    /INSERT AN 8 BIT CHAR
12322  2353          ISZ DMPPTR
12323  1353          TAD DMPPTR      /NOW AT END OF BUFFER?
12324  1363          TAD (-DMPBUF-400
12325  7650          SNA CLA
12326  5335          JMP DMPIT       / YES, DUMP BUFFER NOW
12327  1352          TAD DMPCHR      /NO, FILL FOLLOWING THIS CHAR?
12330  7041          CIA
12331  1715          TAD I DMPOUT    /(THE TEST CHAR @ CALL+1)
12332  7650          SNA CLA
12333  5321          JMP DMPNUL      / YES, FILL WITH NULLS!
12334  5715          JMP I DMPOUT    /  NO, EXECUTE FILL CHAR
             /
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 38-2

12335  6202  DMPIT,  CIF 0
12336  4663          JMS I DDEVAD    /CALL DUMP FILE HANDLER
12337  4210            4210          /WRITE, 2 PAGES, FIELD 1
12340  6600  DMPADR,   DMPBUF
12341  0001  DMPBLK,   1             /BLOCK NUMBER
12342  4765' ERC10,    JMS ERROR1    /ERROR ON OUTPUT FILE!
12343  1340          TAD DMPADR      /NOW RESET OUTPUT POINTER
12344  3353          DCA DMPPTR
12345  2341          ISZ DMPBLK      /INCREMENT BLOCK NUMBER
12346  2253          ISZ XOSIZ       /ANY MORE SPACE LEFT?
12347  5715          JMP I DMPOUT    / YES, EXIT NOW
12350  3266          DCA DNAM        /  NO! ZAP DUMP FILE
12351  4765' ERC20,  JMS ERROR1      /   AND DIE!
12352  0000  DMPCHR, 0
12353  0000  DMPPTR, 0       /CHARACTER OUTPUT POINTER


12363  0600
12364  0204
12365  2433
12366  0520
12367  7770
12370  0425
12371  0022
12372  0024
12373  2441
12374  2430
12375  0212
12376  7757
12377  1154
       2400  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 39

             /CONTINUATION OF ROUTINE TO OUTPUT A CHAR TO A DEVICE

12400  1777  TYPE1,  TAD I (DMODE    /TTY= NONE, PART&-DSWIT, ALL
12401  0776          AND I (DSWIT    / SO TEST FOR PART&DSWIT
12402  7640          SZA CLA
12403  5212          JMP TYPE2       /NO OUTPUT TO TTY
12404  1775          TAD I (RTL6     /GET CHARACTER TO OUTPUT
12405  7000  TYPEB,  NOP             /***    CDF 10          /*** BATCH
12406  6041          TSF             /***    CIF BAT         /*** CHANGES
12407  5206          JMP .-1         /***    JMS I .+1       /*** LOG
12410  6046          TLS             /***      7400          /*** OUTPUT
12411  7200          CLA             /***    CDF 0
12412  7330  TYPE2,  STL CLA RAR     /=4000 (SET AC BIT 0 FOR TEST)
12413  1776          TAD I (DSWIT    /=4000 OR 4001 (DSWIT=1)
12414  0777          AND I (DMODE    /FILE= PART&DSWIT OR ALL
12415  7650          SNA CLA
12416  5231          JMP TYPE3       / OUTPUT TO TTY ONLY
12417  1230          TAD DDEVS       /FILE STRUCTURED OUTPUT?
12420  6211          CDF 10
12421  7450          SNA
12422  1774          TAD I (DNAM     / YES, FILE OPEN?
12423  6201          CDF 0
12424  7650          SNA CLA
12425  5231          JMP TYPE3       /  NO TO EITHER
12426  1775          TAD I (RTL6     /OK, GET CHARACTER TO OUTPUT
12427  4773'         JMS DMPOUT      /OUTPUT IT & TEST FOR END
12430  0000  DDEVS,    0             /TEST: 0=FILE, 212= NON-FILE
12431  6203  TYPE3,  CDF CIF 0
12432  5772'         JMP TYPEX       /BACK AND OUT


12433  0000  ERROR1, 0       /FIELD 1 ERROR ROUTINE HEAD
12434  7200          CLA             /CLEAR POSSIBLE JUNK IN AC
12435  1233          TAD ERROR1      /MOVE RETURN ADDR TO FIELD 0
12436  6203          CDF CIF 0
12437  3771          DCA I (XERROR
12440  5770          JMP I (XERROR+1


12441  6201  XDDEV2, CDF 0           /NAME IS OVER THERE
12442  1767          TAD I (NAM1     /MOVE DEVICE NAME INTO STRING
12443  3254          DCA XDDNAM      / IN THIS FIELD FOR "SHOW DDEV"
12444  1766          TAD I (NAM2
12445  3255          DCA XDDNAM+1
12446  6203          CDF CIF 0
12447  5765'         JMP XSETN       /BACK TO 'SET'

12450  0004  MSDDEV, TEXT "@DDEV = SYS@"
12451  0405
12452  2640
12453  7540
12454  2331
12455  2300
12456  0000
       2454  XDDNAM= .-3
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 39-1


12457  0004  MSDEV,  TEXT "@DEVICE = SYS@"
12460  0526
12461  1103
12462  0540
12463  7540
12464  2331
12465  2300
12466  0000

       2464  XDNAM=  .-3     /ADDR OF 1ST WORD OF DEVICE NAME

             /CONTINUATION OF CODE FROM FIELD 0

12467  3264  XDEVM,  DCA XDNAM       /SET 4 DEVICE NAME CHARS IN
12470  1766          TAD I (NAM2     / OUTPUT MESSAGE
12471  3265          DCA XDNAM+1
12472  6211          CDF 10
12473  3764          DCA I (CCBB     /NO C.C.B. OR HEADER PRESENT
12474  6203          CDF CIF 0
12475  7240          STA
12476  3763          DCA I (RBLK     /RESET BLOCK NUMBER
12477  5765'         JMP XSETN       /GO DO NEXT OPTION


12500  4005  MSERR,  TEXT " ERROR CODES: FUTIL "
12501  2222
12502  1722
12503  4003
12504  1704
12505  0523
12506  7240
12507  0625
12510  2411
12511  1440
12512  0000
       2512          *.-1

             /VERSION NUMBER MESSAGE--THE FOLLOWING CODE INSERTS THE
             /  VERSION NUMBER AND PATCH LEVEL SET NEAR THE START OF
             /  THE SOURCE INTO THE VERSION MESSAGE.

12512  2605  MSVER,  TEXT "VERSION = ???"    /VERS = 2 DIGITS, PATCH = 1
12513  2223
12514  1117
12515  1640
12516  7540
12517  7777
12520  7700
       2517          *.-2
       0000  VERTEN= VERSION%12              /TENS DIGIT
       0010  VERONE= -VERTEN^12+VERSION      /ONES DIGIT
12517  6070          VERTEN^100+VERONE+6060  /INSERT TWO DIGITS
12520  0100          PATCH^100               /INSERT PATCH + NULL TERM

/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 39-2

             /ALPHA MONTH NAMES PLUS DUMMIES FOR PDATE SUBROUTINE

12521  4060  MONTHS, TEXT " 00@JAN@FEB@MAR@APR@MAY@JUN@JUL"
12522  6000
12523  1201
12524  1600
12525  0605
12526  0200
12527  1501
12530  2200
12531  0120
12532  2200
12533  1501
12534  3100
12535  1225
12536  1600
12537  1225
12540  1400
12541  0125          TEXT "AUG@SEP@OCT@NOV@DEC@ 13@ 14@ 15"
12542  0700
12543  2305
12544  2000
12545  1703
12546  2400
12547  1617
12550  2600
12551  0405
12552  0300
12553  4061
12554  6300
12555  4061
12556  6400
12557  4061
12560  6500


12563  3057
12564  6400
12565  1600
12566  0026
12567  0025
12570  0455
12571  0454
12572  5042
12573  2315
12574  2266
12575  3762
12576  0052
12577  0053
       2600  PAGE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 40

             /SYMBOLICS FOR PDP-8 INSTRUCTIONS:
12600  0116  INSLST, TEXT  "AND TAD ISZ DCA JMS JMP IOT NOP "
12601  0440
12602  2401
12603  0440
12604  1123
12605  3240
12606  0403
12607  0140
12610  1215
12611  2340
12612  1215
12613  2040
12614  1117
12615  2440
12616  1617
12617  2040
12620  0000
       2620          *.-1

             / GROUP 1 MICRO-INSTS.:
12620  0314  OP1LST, TEXT  "CLL CMA CML IAC BSW RAL RTL RAR RTR "
12621  1440
12622  0315
12623  0140
12624  0315
12625  1440
12626  1101
12627  0340
12630  0223
12631  2740
12632  2201
12633  1440
12634  2224
12635  1440
12636  2201
12637  2240
12640  2224
12641  2240
12642  0000
       2642          *.-1


             / GROUP 2 MICRO-INST'S:
12642  2315  OP2LST, TEXT  "SMA SZA SNL SKP SPA SNA SZL OSR HLT "
12643  0140
12644  2332
12645  0140
12646  2316
12647  1440
12650  2313
12651  2040
12652  2320
12653  0140
12654  2316
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 40-1

12655  0140
12656  2332
12657  1440
12660  1723
12661  2240
12662  1014
12663  2440
12664  0000
       2664          *.-1

             / EAE MICRO-INST'S:
12664  1521  EAELST, TEXT  "MQA MQL SCL MUY DVI NMI SHL ASR LSR SCA "
12665  0140
12666  1521
12667  1440
12670  2303
12671  1440
12672  1525
12673  3140
12674  0426
12675  1140
12676  1615
12677  1140
12700  2310
12701  1440
12702  0123
12703  2240
12704  1423
12705  2240
12706  2303
12707  0140
12710  0000
       2710          *.-1
12710  0401          TEXT  "DAD DST SWBADPSZDPICDCM SAM "
12711  0440
12712  0423
12713  2440
12714  2327
12715  0201
12716  0420
12717  2332
12720  0420
12721  1103
12722  0403
12723  1540
12724  2301
12725  1540
12726  0000
       2726          *.-1

12726  0314  CLANAM, 0314  /"CLA "
12727  0140          0140

12730  1720  OPRMES, 1720  /"OPR "
12731  2240          2240
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 41

             / IOT INSTRUCTIONS:

12732  6000  IOTTAB, 6000
12733  2313          TEXT "SKON"
12734  1716
12735  0000
12736  6001          6001
12737  1117          TEXT "ION@"
12740  1600
12741  0000
12742  6002          6002
12743  1117          TEXT "IOF@"
12744  0600
12745  0000
12746  6003          6003
12747  2322          TEXT "SRQ@"
12750  2100
12751  0000
12752  6004          6004
12753  0724          TEXT "GTF@"
12754  0600
12755  0000
12756  6005          6005
12757  2224          TEXT "RTF@"
12760  0600
12761  0000
12762  6006          6006
12763  2307          TEXT "SGT@"
12764  2400
12765  0000
12766  6007          6007
12767  0301          TEXT "CAF@"
12770  0600
12771  0000
12772  6010          6010
12773  2220          TEXT "RPE@"
12774  0500
12775  0000
12776  6011          6011
12777  2223          TEXT "RSF@"
13000  0600
13001  0000
13002  6012          6012
13003  2222          TEXT "RRB@"
13004  0200
13005  0000
13006  6014          6014
13007  2203          TEXT "RCF@"
13010  0600
13011  0000
13012  6016          6016
13013  2203          TEXT "RCC@"
13014  0300
13015  0000
13016  6020          6020
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 41-1

13017  2003          TEXT "PCE@"
13020  0500
13021  0000
13022  6021          6021
13023  2023          TEXT "PSF@"
13024  0600
13025  0000
13026  6022          6022
13027  2003          TEXT "PCF@"
13030  0600
13031  0000
13032  6024          6024
13033  2020          TEXT "PPC@"
13034  0300
13035  0000
13036  6026          6026
13037  2014          TEXT "PLS@"
13040  2300
13041  0000
13042  6030          6030
13043  1303          TEXT "KCF@"
13044  0600
13045  0000
13046  6031          6031
13047  1323          TEXT "KSF@"
13050  0600
13051  0000
13052  6032          6032
13053  1303          TEXT "KCC@"
13054  0300
13055  0000
13056  6034          6034
13057  1322          TEXT "KRS@"
13060  2300
13061  0000
13062  6035          6035
13063  1311          TEXT "KIE@"
13064  0500
13065  0000
13066  6036          6036
13067  1322          TEXT "KRB@"
13070  0200
13071  0000
13072  6040          6040
13073  2406          TEXT "TFL@"
13074  1400
13075  0000
13076  6041          6041
13077  2423          TEXT "TSF@"
13100  0600
13101  0000
13102  6042          6042
13103  2403          TEXT "TCF@"
13104  0600
13105  0000
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 41-2

13106  6044          6044
13107  2420          TEXT "TPC@"
13110  0300
13111  0000
13112  6045          6045
13113  2423          TEXT "TSK@"
13114  1300
13115  0000
13116  6046          6046
13117  2414          TEXT "TLS@"
13120  2300
13121  0000
13122  6100          6100
13123  0420          TEXT "DPI@"
13124  1100
13125  0000
13126  6101          6101
13127  2315          TEXT "SMP@"
13130  2000
13131  0000
13132  6102          6102
13133  2320          TEXT "SPL@"
13134  1400
13135  0000
13136  6103          6103
13137  0520          TEXT "EPI@"
13140  1100
13141  0000
13142  6104          6104
13143  0315          TEXT "CMP@"
13144  2000
13145  0000
13146  6105          6105
13147  2354          TEXT "S,CMP"
13150  0315
13151  2000
13152  6106          6106
13153  0305          TEXT "CEP@"
13154  2000
13155  0000
13156  6107          6107
13157  2320          TEXT "SPO@"
13160  1700
13161  0000
13162  6110          6110
13163  2203          TEXT "RCTV"
13164  2426
13165  0000
13166  6111          6111
13167  2203          TEXT "RCRL"
13170  2214
13171  0000
13172  6112          6112
13173  2203          TEXT "RCRH"
13174  2210
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 41-3

13175  0000
13176  6113          6113
13177  2203          TEXT "RCCV"
13200  0326
13201  0000
13202  6114          6114
13203  2203          TEXT "RCGB"
13204  0702
13205  0000
13206  6115          6115
13207  2203          TEXT "RCLC"
13210  1403
13211  0000
13212  6116          6116
13213  2203          TEXT "RCCB"
13214  0302
13215  0000
13216  6130          6130
13217  0314          TEXT "CLZE"
13220  3205
13221  0000
13222  6131          6131
13223  0314          TEXT "CLSK"
13224  2313
13225  0000
13226  6132          6132
13227  0314          TEXT "CLOE"
13230  1705
13231  0000
13232  6133          6133
13233  0314          TEXT "CLAB"
13234  0102
13235  0000
13236  6134          6134
13237  0314          TEXT "CLEN"
13240  0516
13241  0000
13242  6135          6135
13243  0314          TEXT "CLSA"
13244  2301
13245  0000
13246  6136          6136
13247  0314          TEXT "CLBA"
13250  0201
13251  0000
13252  6137          6137
13253  0314          TEXT "CLCA"
13254  0301
13255  0000
13256  6201          6201
13257  0304          TEXT "CDF 00"
13260  0640
13261  6060
13262  0000
       3262          *.-1
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 41-4

13262  6211          6211
13263  0304          TEXT "CDF 10"
13264  0640
13265  6160
13266  0000
       3266          *.-1
13266  6221          6221
13267  0304          TEXT "CDF 20"
13270  0640
13271  6260
13272  0000
       3272          *.-1
13272  6231          6231
13273  0304          TEXT "CDF 30"
13274  0640
13275  6360
13276  0000
       3276          *.-1
13276  6241          6241
13277  0304          TEXT "CDF 40"
13300  0640
13301  6460
13302  0000
       3302          *.-1
13302  6251          6251
13303  0304          TEXT "CDF 50"
13304  0640
13305  6560
13306  0000
       3306          *.-1
13306  6261          6261
13307  0304          TEXT "CDF 60"
13310  0640
13311  6660
13312  0000
       3312          *.-1
13312  6271          6271
13313  0304          TEXT "CDF 70"
13314  0640
13315  6760
13316  0000
       3316          *.-1
13316  6202          6202
13317  0311          TEXT "CIF 00"
13320  0640
13321  6060
13322  0000
       3322          *.-1
13322  6212          6212
13323  0311          TEXT "CIF 10"
13324  0640
13325  6160
13326  0000
       3326          *.-1
13326  6222          6222
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 41-5

13327  0311          TEXT "CIF 20"
13330  0640
13331  6260
13332  0000
       3332          *.-1
13332  6232          6232
13333  0311          TEXT "CIF 30"
13334  0640
13335  6360
13336  0000
       3336          *.-1
13336  6242          6242
13337  0311          TEXT "CIF 40"
13340  0640
13341  6460
13342  0000
       3342          *.-1
13342  6252          6252
13343  0311          TEXT "CIF 50"
13344  0640
13345  6560
13346  0000
       3346          *.-1
13346  6262          6262
13347  0311          TEXT "CIF 60"
13350  0640
13351  6660
13352  0000
       3352          *.-1
13352  6272          6272
13353  0311          TEXT "CIF 70"
13354  0640
13355  6760
13356  0000
       3356          *.-1
13356  6203          6203
13357  0304          TEXT "CDIF00"
13360  1106
13361  6060
13362  0000
       3362          *.-1
13362  6213          6213
13363  0304          TEXT "CDIF10"
13364  1106
13365  6160
13366  0000
       3366          *.-1
13366  6223          6223
13367  0304          TEXT "CDIF20"
13370  1106
13371  6260
13372  0000
       3372          *.-1
13372  6233          6233
13373  0304          TEXT "CDIF30"
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 41-6

13374  1106
13375  6360
13376  0000
       3376          *.-1
13376  6243          6243
13377  0304          TEXT "CDIF40"
13400  1106
13401  6460
13402  0000
       3402          *.-1
13402  6253          6253
13403  0304          TEXT "CDIF50"
13404  1106
13405  6560
13406  0000
       3406          *.-1
13406  6263          6263
13407  0304          TEXT "CDIF60"
13410  1106
13411  6660
13412  0000
       3412          *.-1
13412  6273          6273
13413  0304          TEXT "CDIF70"
13414  1106
13415  6760
13416  0000
       3416          *.-1
13416  6204          6204
13417  0311          TEXT "CINT"
13420  1624
13421  0000
13422  6214          6214
13423  2204          TEXT "RDF@"
13424  0600
13425  0000
13426  6224          6224
13427  2211          TEXT "RIF@"
13430  0600
13431  0000
13432  6234          6234
13433  2211          TEXT "RIB@"
13434  0200
13435  0000
13436  6244          6244
13437  2215          TEXT "RMF@"
13440  0600
13441  0000
13442  6254          6254
13443  2311          TEXT "SINT"
13444  1624
13445  0000
13446  6264          6264
13447  0325          TEXT "CUF@"
13450  0600
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 41-7

13451  0000
13452  6274          6274
13453  2325          TEXT "SUF@"
13454  0600
13455  0000
13456  6550          6550
13457  0606          TEXT "FFST"
13460  2324
13461  0000
13462  6551          6551
13463  0620          TEXT "FPINT"
13464  1116
13465  2400
13466  6552          6552
13467  0620          TEXT "FPICL"
13470  1103
13471  1400
13472  6553          6553
13473  0620          TEXT "FPCOM"
13474  0317
13475  1500
13476  6554          6554
13477  0620          TEXT "FPHLT"
13500  1014
13501  2400
13502  6555          6555
13503  0620          TEXT "FPST"
13504  2324
13505  0000
13506  6556          6556
13507  0620          TEXT "FPRST"
13510  2223
13511  2400
13512  6557          6557
13513  0620          TEXT "FPIST"
13514  1123
13515  2400
13516  6561          6561
13517  0615          TEXT "FMODE"
13520  1704
13521  0500
13522  6563          6563
13523  0615          TEXT "FMRB"
13524  2202
13525  0000
13526  6564          6564
13527  0615          TEXT "FMRP"
13530  2220
13531  0000
13532  6565          6565
13533  0615          TEXT "FMDO"
13534  0417
13535  0000
13536  6567          6567
13537  0620          TEXT "FPEP"
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 41-8

13540  0520
13541  0000


13542  0000  NXTIOT, ZBLOCK 200      /LEAVE ROOM FOR EXPANSION

13742  0000          0               /TABLE TERMINATOR


             /CODES MAY BE ADDED TO THE TABLE IN THE SPACE LEFT BY THE
             /  "ZBLOCK 200".  SINCE EACH ENTRY REQUIRES 4 WORDS (THE
             /  ACTUAL CODE IN THE FIRST WORD AND UP TO 6 PACKED ASCII
             /  CHARACTERS IN THE NEXT THREE WORDS, PADDED WITH TRAIL-
             /  ING 0'S), THERE IS ROOM FOR 40 OCTAL (32 DECIMAL) IOTS
             /  AND THEIR NAMES.  THESE CAN BE PATCHED IN DIRECTLY
             /  USING THE PROGRAM ITSELF.  **** NOTE THAT THE CONTENTS
             /  OF LOCATION 10000 POINT TO THE FIRST FREE ENTRY. ****
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 42

             /SYMBOLICS FOR FPP-12/8A INSTRUCTIONS

13743  4040  MSBASE, TEXT "  B+"
13744  0253
13745  0000

13746  4540  MSINDI, TEXT "% B+"
13747  0253
13750  0000

13751  1216  MSJNX,  TEXT "JNX  "
13752  3040
13753  4000

             /THE FOLLOWING STRINGS ARE PADDED WITH "@"S IN PROPER
             /  PLACES TO FORCE WORD ALIGNMENT AS NEEDED.

13754  1405          TEXT "LEA@"     /+1 WORD 0000
13755  0100
13756  0000
13757  0614  FPPINS, TEXT "FLDA@@FADD@@FSUB@@FDIV"
13760  0401
13761  0000
13762  0601
13763  0404
13764  0000
13765  0623
13766  2502
13767  0000
13770  0604
13771  1126
13772  0000
13773  0615          TEXT "FMUL@@FADDM@FSTA@@FMULM"
13774  2514
13775  0000
13776  0601
13777  0404
14000  1500
14001  0623
14002  2401
14003  0000
14004  0615
14005  2514
14006  1500

14007  2516          TEXT "UNUSEDSTARTE"
14010  2523
14011  0504
14012  2324
14013  0122
14014  2405
14015  0000
       4015          *.-1
14015  0616  FPOP00, TEXT "FNOP@@FEXIT@FPAUSEFCLA@@FNEG"
14016  1720
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 42-1

14017  0000
14020  0605
14021  3011
14022  2400
14023  0620
14024  0125
14025  2305
14026  0603
14027  1401
14030  0000
14031  0616
14032  0507
14033  0000
14034  0616          TEXT "FNORM@STARTFSTARTDJAC@@"
14035  1722
14036  1500
14037  2324
14040  0122
14041  2406
14042  2324
14043  0122
14044  2404
14045  1201
14046  0300
14047  0000

14050  0114  FPXR1S, TEXT "ALN ATX XTA "
14051  1640
14052  0124
14053  3040
14054  3024
14055  0140
14056  0000

14057  0104  FPXR2S, TEXT "ADDX *,@LDX *,@"
14060  0430
14061  4052
14062  5400
14063  1404
14064  3040
14065  5254
14066  0000

14067  2422  FOP134, TEXT "TRAP4 TRAP3 SETX  SETB  JSA  @JSR  "
14070  0120
14071  6440
14072  2422
14073  0120
14074  6340
14075  2305
14076  2430
14077  4040
14100  2305
14101  2402
14102  4040
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 42-2

14103  1223
14104  0140
14105  4000
14106  1223
14107  2240
14110  4000

14111  0521  FPCOND, TEXT "EQGELEA@NELTGTAL"
14112  0705
14113  1405
14114  0100
14115  1605
14116  1424
14117  0724
14120  0114
14121  0000


             /CONTROL TABLES FOR FPP INSTRUCTION DECODING

14122  0007  FPPMO0, 7       /MAJOR SUB-OP-CODE OF SPECIALS
14123  0006          6
14124  0005          5
14125  0004          4
14126  0003          3
14127  0002          2
14130  0001          1
14131  0000          0       /END & FALL-OUT POINT

14132  4756  FPPMOJ, SPCOP7
14133  4757          SPCOP6
14134  4747          SPCOP5
14135  4732          SPCOP4
14136  4731          SPCOP3
14137  4744          SPCOP2
14140  4717          SPCOP1

14141  0170  FPPOP0, 170     /MINOR SUB-OP-CODE OF SUB-OP-CODE
14142  0160          160     / 0 SPECIALS
14143  0150          150
14144  0140          140
14145  0130          130
14146  0120          120
14147  0110          110
14150  0100          100
14151  0070          70
14152  0060          60
14153  0050          50
14154  0040          40
14155  0030          30
14156  0020          20
14157  0010          10
14160  0000          00

14161  4677  FPPOPJ, SPNUSE  /ALL UNUSED POSSIBILITIES
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 42-3

14162  4677          SPNUSE
14163  4677          SPNUSE
14164  4677          SPNUSE
14165  4677          SPNUSE
14166  4677          SPNUSE
14167  4710          SPOP11
14170  4707          SPOP10
14171  4677          SPNUSE
14172  4677          SPNUSE
14173  4675          SPOP05
14174  4670          SPOP04
14175  4701          SPO123
14176  4701          SPO123
14177  4701          SPO123
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 43

             /MESSAGES:

14200  4075  MS01,   TEXT " =  "
14201  4040
14202  0000

14203  0023  MS07,   0023  /"SMASK = "
14204  1501  MS02,   TEXT    "MASK = "
14205  2313
14206  4075
14207  4000

14210  0102  MS03,   TEXT "ABS. LOC = "
14211  2356
14212  4014
14213  1703
14214  4075
14215  4000

14216  2520  MS04,   TEXT "UPPER = "
14217  2005
14220  2240
14221  7540
14222  0000

14223  1417  MS05,   TEXT "LOWER = "
14224  2705
14225  2240
14226  7540
14227  0000

14230  0617  MS06,   TEXT "FORMAT = "
14231  2215
14232  0124
14233  4075
14234  4000

14235  0411  MS08,   TEXT "DIRECTORY"
14236  2205
14237  0324
14240  1722
14241  3100

14242  1706  MS09,   TEXT "OFFSET = "
14243  0623
14244  0524
14245  4075
14246  4000

14247  1517  MS10,   TEXT "MODE = "
14250  0405
14251  4075
14252  4000

14253  0303  MS11,   TEXT "CCB:"
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 43-1

14254  0272
14255  0000

14256  1704  MS12,   TEXT "ODT  LOC = "
14257  2440
14260  4014
14261  1703
14262  4075
14263  4000

14264  7240  MS13,   TEXT ":   "
14265  4040
14266  0000

14267  4040  MS14,   TEXT "  CORE SEGS:   "
14270  0317
14271  2205
14272  4023
14273  0507
14274  2372
14275  4040
14276  4000

14277  1417  MS15,   TEXT "LOOKUP FAILED"
14300  1713
14301  2520
14302  4006
14303  0111
14304  1405
14305  0400

14306  0620  MS16,   TEXT "FPP"
14307  2000

14310  4001  MS17,   TEXT " AT "
14311  2440
14312  0000

14313  4040  MS18,   TEXT "  SA = "
14314  2301
14315  4075
14316  4000

14317  5440  MS19,   TEXT ",  JSW = "
14320  4012
14321  2327
14322  4075
14323  4000

14324  2205  MS20,   TEXT "REL. LOC = "
14325  1456
14326  4014
14327  1703
14330  4075
14331  4000
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 43-2


14332  2001  MS21,   TEXT "PACKED"
14333  0313
14334  0504
14335  0000

14336  0123  MS22,   TEXT "ASCII"
14337  0311
14340  1100

14341  1723  MS23,   TEXT "OS/8"
14342  5770
14343  0000

14344  2516  MS24,   2516  /"UNSIGNED"

14345  2311  MS25,   TEXT "SIGNED"
14346  0716
14347  0504
14350  0000

14351  1703  MS26,   TEXT "OCTAL"
14352  2401
14353  1400

14354  1706  MS27,   TEXT "OFFSET"
14355  0623
14356  0524
14357  0000

14360  2301  MS28,   TEXT "SAVE"
14361  2605
14362  0000

14363  1617  MS29,   TEXT "NORMAL"
14364  2215
14365  0114
14366  0000

14367  1725  MS30,   TEXT "OUTPUT = "
14370  2420
14371  2524
14372  4075
14373  4000

14374  2004  MS31,   TEXT "PDP"
14375  2000

14376  0214  MS32,   TEXT "BLOCK = "
14377  1703
14400  1340
14401  7540
14402  0000

14403  5140  MS33,   TEXT ")  "
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 43-3

14404  4000

14405  1417  MS34,   TEXT "LOAD"
14406  0104
14407  0000

14410  0203  MS35,   TEXT "BCD"
14411  0400

14412  0231  MS36,   TEXT "BYTE"
14413  2405
14414  0000

14415  0611  MS37,   TEXT "FILLER = "
14416  1414
14417  0522
14420  4075
14421  4000

14422  1005  MS38,   TEXT "HEADER:"
14423  0104
14424  0522
14425  7200

14426  5440  MS39,   TEXT ", NEXT WORD = "
14427  1605
14430  3024
14431  4027
14432  1722
14433  0440
14434  7540
14435  0000

14436  5440  MS40,   TEXT ", LOAD V "
14437  1417
14440  0104
14441  4026
14442  4000

14443  5440  MS41,   TEXT ", E.P. REQ'D"
14444  0556
14445  2056
14446  4022
14447  0521
14450  4704
14451  0000

14452  4040  MS42,   TEXT "  OVLYS START BLOCK LENGTH"
14453  1726
14454  1431
14455  2340
14456  2324
14457  0122
14460  2440
14461  0214
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 43-4

14462  1703
14463  1340
14464  1405
14465  1607
14466  2410
14467  0000

14470  3023  MS43,   TEXT "XS240"
14471  6264
14472  6000
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 44

             /MAIN LOOP CHARACTER LIST
14473  0243  CCHARL, "#
14474  0244          "$
14475  0245          "%
14476  0246          "&
14477  0272          ":
14500  0274          "<
14501  0275          "=
14502  0276          ">
14503  0277          "?
14504  0300          "@
14505  0333          "[
14506  0334          "\
14507  0335          "]
14510  0257          "/
14511  0241          "!
14512  0253          "+
14513  0255          "-
14514  0273          ";
14515  0336          "^
14516  0337          "_
             /'TYPE' COMMAND LIST
14517  0211  TYPEL,  211     /TAB
14520  0233          233     /ALT MODES
14521  0375          375
14522  0376          376
             /'XMODIF' CHECK LIST
14523  0215  TYPEM,  215     /CR
14524  0212          212     /LF
14525  0000          0

             /ADDRESSES FOR 'OMODES'
14526  3415  OTABLE, BPRT    /#
14527  3511          OSTYPE  /$
14530  3517          BYTEO   /%
14531  5352          XS240O  /&
14532  3423          SGNDP   /:
14533  3400          OPRT    /<
14534  3436          DPRT    /=
14535  4221          PDPOUT  />
14536  3163          DIROUT  /?
14537  5000          PDATE   /@
14540  2163          ASCII   /[
14541  4600          FPPOUT  /\
14542  3621          PACOUT  /]

             /MAIN LOOP JUMP LIST - RESPOND TO SPECIAL CHAR
14543  0255  COPSL,  OMODES
14544  0255          OMODES
14545  0255          OMODES
14546  0255          OMODES
14547  0255          OMODES
14550  0255          OMODES
14551  0255          OMODES  /SEE ABOVE LIST
14552  0255          OMODES
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 44-1

14553  0255          OMODES
14554  0255          OMODES
14555  0255          OMODES
14556  0255          OMODES
14557  0255          OMODES
14560  0237          SLASH
14561  0312          EXCL
14562  0344          PLUS
14563  0345          MINUS
14564  0310          SEMIC
14565  0274          UPARR
14566  0271          BACKAR
14567  4024          RESPC
14570  0253          ALTMOD
14571  0253          ALTMOD
14572  0253          ALTMOD
14573  0216          CRCR
14574  0311          LFLF

             /'TYPE' JUMP LIST
14575  5106  TYPEOP, TYPTAB
14576  5101          TYPALT
14577  5101          TYPALT
14600  5101          TYPALT
14601  5104          TYPCR
14602  5105          TYPCR+1

             /COMMAND WORD LIST FOR COMMANDS NOT FOLLOWED BY CR
14603  0526  CWORDL, TEXT "EVE@DUD@LIL@FIF@OPSCSTSMWOW@MOM@SHSES@WRIFEXCOC@"
14604  0500
14605  0425
14606  0400
14607  1411
14610  1400
14611  0611
14612  0600
14613  1720
14614  2303
14615  2324
14616  2315
14617  2717
14620  2700
14621  1517
14622  1500
14623  2310
14624  2305
14625  2300
14626  2722
14627  1106
14630  0530
14631  0317
14632  0300
14633  0000

             /MAIN LOOP JUMP LIST - EXECUTE A COMMAND
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 44-2

14634  0400  WOPSL,  XVAL
14635  0400          XVAL
14636  0603          XDUMP
14637  0603          XDUMP
14640  0632          XLIST0
14641  0632          XLIST0
14642  1024          XFILE
14643  1024          XFILE
14644  1000          XOPEN
14645  0600          XSCAN
14646  2216          XSTRIN
14647  2600          XSMASK
14650  2000          XWORD
14651  2000          XWORD
14652  2417          XMODIF
14653  2417          XMODIF
14654  1210          XSHOW
14655  1602          XSET
14656  1602          XSET
14657  2400          XWRARG
14660  1713          XIF
14661  5160          XEXIT
14662  0204          MAIN1   /COMMENT
14663  0204          MAIN1

             /LISTS FOR COMMANDS FOLLOWED BY A CR.
14664  2205  CWORL2, TEXT "REWRENEXCLCOC@"
14665  2722
14666  0516
14667  0530
14670  0314
14671  0317
14672  0300
14673  0000

14674  2200  WOPSLL, XREWIN  /REWIND
14675  2403          XWRITE  /WRITE
14676  0204          MAIN1   /END
14677  5160          XEXIT   /EXIT
14700  1004          XCLOSE  /CLOSE
14701  0204          MAIN1   /COMMENT
14702  0204          MAIN1
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 45

             /'XFORM' LISTS  ----ORDER IS CRITICAL----
14703  2001  FORML,  TEXT "PAP@ASA@OSOSXSX@UNU@SIS@OCO@BCB@BYBYPDPDFPF@DID@"
14704  2000
14705  0123
14706  0100
14707  1723
14710  1723
14711  3023
14712  3000
14713  2516
14714  2500
14715  2311
14716  2300
14717  1703
14720  1700
14721  0203
14722  0200
14723  0231
14724  0231
14725  2004
14726  2004
14727  0620
14730  0600
14731  0411
14732  0400
14733  0000

14734  0740  FOPSL,  XFCHR   /PACKED (ASCII)
14735  0740          XFCHR
14736  0740          XFCHR   /ASCII
14737  0740          XFCHR
14740  0740          XFCHR   /OS/8 (ASCII, PACKED)
14741  0740          XFCHR
14742  0740          XFCHR   /XS240 (ASCII, PACKED)
14743  0740          XFCHR
14744  0737          XFNUM   /UNSIGNED (DECIMAL)
14745  0737          XFNUM
14746  0737          XFNUM   /SIGNED (DECIMAL)
14747  0737          XFNUM
14750  0737          XFNUM   /OCTAL
14751  0737          XFNUM
14752  0737          XFNUM   /BCD
14753  0737          XFNUM
14754  0737          XFNUM   /BYTE (OCTAL)
14755  0737          XFNUM
14756  0736          XFSYM   /PDP (SYMBOLIC)
14757  0736          XFSYM
14760  0736          XFSYM   /FPP (SYMBOLIC)
14761  0736          XFSYM
14762  0736          XFSYM   /DIRECTORY
14763  0736          XFSYM

             /  ROUTINE ADDRESS LIST

14764  3621  FTABLE, PACOUT
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 45-1

14765  2163          ASCII
14766  3511          OSTYPE
14767  5352          XS240O
14770  3436          DPRT
14771  3423          SGNDP
14772  3400          OPRT
14773  3415          BPRT
14774  3517          BYTEO
14775  4214          PDPDMP
14776  4400          FPPDMP
14777  3155          DIRDMP

             /'XSHFMT' DESCRIPTOR ADDRESS LIST
15000  4332  FMTLS,  MS21    /PACKED ASCII
15001  4336          MS22    /ASCII
15002  4341          MS23    /OS/8 ASCII
15003  4470          MS43    /XS240 ASCII
15004  4344          MS24    /UNSIGNED DECIMAL
15005  4345          MS25    /SIGNED DECIMAL
15006  4351          MS26    /OCTAL
15007  4410          MS35    /BCD
15010  4412          MS36    /BYTE
15011  4374          MS31    /PDP SYMBOLIC
15012  4306          MS16    /FPP SYMBOLIC
15013  4235          MS08    /DIRECTORY


             /'XMODIF' COMMAND LIST
15014  2001  MODIFL, TEXT "PAP@ASA@OSXSNUN@"
15015  2000
15016  0123
15017  0100
15020  1723
15021  3023
15022  1625
15023  1600
15024  0000

             /'XMODIF' JUMP LIST
15025  2620  MODIFO, XPAC0   /PACKED
15026  2620          XPAC0
15027  2537          XASC1   /ASCII
15030  2537          XASC1
15031  2634          XOPS1   /OS/8
15032  2617          XXS20   /XS240
15033  2514          XNUM2   /NUMERIC
15034  2514          XNUM2

15035  2436  MODADS, XMOD0   /MODIFL TEST LIST
15036  2436          XMOD0
15037  2436          XMOD0
15040  2436          XMOD0
15041  2436          XMOD0
15042  2436          XMOD0
15043  2436          XMOD0
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 45-2

15044  2436          XMOD0
15045  2436          XMOD0

15046  2001  MODDLS, TEXT "PAASOSXSNUNUNUNUNUNUNUNU" /DEFAULT LIST
15047  0123
15050  1723
15051  3023
15052  1625
15053  1625
15054  1625
15055  1625
15056  1625
15057  1625
15060  1625
15061  1625
15062  0000

             /'XMODIF' CHARACTER JUMP LIST
15063  2465  MCHARO, XMODCR  /CR, END
15064  4007          RENEXT  /LF, IGNORE

             /'XIF' CHARACTER JUMP LIST
15065  1731  IFSKPO, XIFCR   /CR, END OF LINE
15066  4007          RENEXT  /LF, IGNORE

             /XNUM JUMP LIST
15067  2512  NUMOPS, XNUM1   /,
15070  5722          ERCQ    /:
15071  5722          ERCQ    /.
15072  2513          XNUM1+1 /SPACE
15073  2524          XNUM3   /CR
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 46

             /'XSHOW' COMMAND LIST
15074  0214  SHOWL,  TEXT "BLB@ODCCC@HEH@ABA@RER@SMVE"
15075  0200
15076  1704
15077  0303
15100  0300
15101  1005
15102  1000
15103  0102
15104  0100
15105  2205
15106  2200
15107  2315
15110  2605
15111  0000
       5111          *.-1
             /'XSET' COMMAND LIST
15111  0404  SETLST, TEXT "DDFOF@OUO@ERE@OFUPLOTEDEDMMOFIMAM@
15112  0617
15113  0600
15114  1725
15115  1700
15116  0522
15117  0500
15120  1706
15121  2520
15122  1417
15123  2405
15124  0405
15125  0415
15126  1517
15127  0611
15130  1501
15131  1500
15132  0000

             /'XSHOW' JUMP LIST
15133  1200  SHOWOP, XSHBLK  /BLOCK
15134  1200          XSHBLK
15135  1236          XSHODL  /ODT LOC
15136  1400          XSHCCB  /CCB (CORE CONTROL BLOCK)
15137  1400          XSHCCB
15140  1455          XSHHDR  /HEADER (F4 LOAD MODULE)
15141  1455          XSHHDR
15142  1250          XSHABS  /ABS. LOC
15143  1250          XSHABS
15144  1243          XSHREL  /REL. LOC
15145  1243          XSHREL
15146  1321          XSHSMS  /SMASK
15147  1216          XSHVER  /VERSION
15150  1360          XSHDDEV /DDEV
15151  1277          XSHFMT  /FORMAT
15152  1277          XSHFMT
15153  1314          XSHOUT  /OUTPUT
15154  1314          XSHOUT
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 46-1

15155  1530          XSHERR  /ERRORS
15156  1530          XSHERR
15157  1225          XSHOFF  /OFFSET
15160  1265          XSHUPP  /UPPER
15161  1272          XSHLOW  /LOWER
15162  1215          ERCG    /TEMP--NOT ALLOWED FOR SHOW
15163  1347          XSHDEV  /DEVICE
15164  1215          ERCG    /DMODE--NOT ALLOWED FOR SHOW
15165  1307          XSHMOD  /MODE
15166  1232          XSHFIL  /FILLER
15167  1221          XSHMSK  /MASK
15170  1221          XSHMSK

             /'XSET' JUMP LIST
15171  1134  SETJMP, XDDEV   /DDEV (DUMP DEVICE)
15172  0754          XFORM   /FORMAT
15173  0754          XFORM
15174  1624          XOUTS   /OUTPUT
15175  1624          XOUTS
15176  1647          XEMODE  /ERROR (MODE)
15177  1647          XEMODE
15200  1642          XOFFS   /OFFSET
15201  1660          XUPP    /UPPER
15202  1663          XLOW    /LOWER
15203  1705          XTEMP   /TEMP
15204  1121          XDEV    /DEVICE
15205  1612          XDMODE  /DMODE (DUMP MODE)
15206  1666          XMODE   /MODE
15207  1701          XFILL   /FILLER
15210  1636          XMASK   /MASK
15211  1636          XMASK

             /'XEMODE' COMMAND LIST
15212  2310  XELST,  TEXT "SHS@LOL@"
15213  2300
15214  1417
15215  1400
15216  0000

             /'XEMODE' BRANCH LIST
15217  1655  XEOPS,  XEMOD1          /SHORT
15220  1655          XEMOD1
15221  1656          XEMOD1+1        /LONG
15222  1656          XEMOD1+1

             /'XOUTS' LISTS
15223  0620  XOLST,  TEXT "FPF@PDP@OCO@"
15224  0600
15225  2004
15226  2000
15227  1703
15230  1700
15231  0000

15232  1632  XOOPS,  XOUTS1-1        /FPP SYMBOLIC
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 46-2

15233  1632          XOUTS1-1
15234  1633          XOUTS1          /PDP SYMBOLIC
15235  1633          XOUTS1
15236  1634          XOUTS1+1        /OCTAL
15237  1634          XOUTS1+1

             /'XMODE' COMMAND LIST
15240  1706  MODLST, TEXT "OFO@SAS@LOL@NON@"
15241  1700
15242  2301
15243  2300
15244  1417
15245  1400
15246  1617
15247  1600
15250  0000

             /'XMODE' JUMP LIST
15251  1674  MODOPS, XMODS-1 /OFFSET
15252  1674          XMODS-1
15253  1676          XMODS+1 /SAVE FILE
15254  1676          XMODS+1
15255  1675          XMODS   /LOAD MODULE
15256  1675          XMODS
15257  1677          XMODS+2 /NORMAL
15260  1677          XMODS+2

             /'XDMODE' LISTS
15261  0114  XDMLST, TEXT "ALPANO"
15262  2001
15263  1617
15264  0000

15265  1620  XDMOPS, XDMODS-1        /ALL
15266  1621          XDMODS          /PART
15267  1622          XDMODS+1        /NONE


             /LIST OF DESCRIPTOR ADDRESSES FOR "SHOW MODE"

15270  4354          MS27    /-1 = "OFFSET"
15271  4363  MODELS, MS29    / 0 = "NORMAL"
15272  4360          MS28    /+1 = "SAVE"
15273  4405          MS34    /+2 = "LOAD"


             /LIST OF DESCRIPTOR ADDRESSES FOR "SHOW OUTPUT"

15274  4306          MS16    /-1 = "FPP (SYMBOLIC)"
15275  4351  OUTLS,  MS26    / 0 = "OCTAL"
15276  4374          MS31    /+1 = "PDP (SYMBOLIC)"


             /'XWORD' COMMAND LIST
15277  2516  XWORCL, TEXT "UNU@"
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 46-3

15300  2500
15301  0000
       5301          *.-1
             /'XSTRIN' COMMAND LIST
15301  0622  STRLST, TEXT "FRF@TOT@ABA@MAM@ME"
15302  0600
15303  2417
15304  2400
15305  0102
15306  0100
15307  1501
15310  1500
15311  1505
15312  0000


             /'XWORD' JUMP LIST
15313  2004  XWOROP, XWOR2   /UNEQUAL
15314  2004          XWOR2
15315  2071          XWSFRM  /FROM
15316  2071          XWSFRM
15317  2074          XWSTO   /TO
15320  2074          XWSTO
15321  2066          XWSABS  /ABSOLUTE
15322  2066          XWSABS
15323  2015          ERCH    /MASKED--NO!
15324  2016          XWOR7   /MEMREF
15325  2016          XWOR7

             /'XSTRIN' JUMP LIST
15326  2071  STROPS, XWSFRM  /FROM
15327  2071          XWSFRM
15330  2074          XWSTO   /TO
15331  2074          XWSTO
15332  2066          XWSABS  /ABSOLUTE
15333  2066          XWSABS
15334  2220          XSTR0   /MASKED
15335  2220          XSTR0
15336  2015          ERCH    /MEMREF--NO!
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 47

             /LIST OF TERMINATORS, IN ORDER, FOR 'EVAL'
15337  0241  TERMS,  "!  /1
15340  0246          "&  /2
15341  0253          "+  /3
15342  0255          "-  /4
15343  0257          "/  /5
15344  0252          "*  /6
15345  0250          "(  /7
15346  0251          ")  /10
15347  0215          215     /CR: 11
15350  0000          0

             /'GWORD' & 'ACCEPT' COMMAND LISTS
15351  0271  GWLST1, "9
15352  0270          "8
15353  0267          "7
15354  0266          "6
15355  0265          "5
15356  0264          "4
15357  0263          "3
15360  0262          "2
15361  0261          "1
15362  0260          "0
15363  0204          204     /^D
15364  0213          213     /^K
15365  0242          ""
15366  0247          "'
15367  0250          "(
15370  0240  GWLST2, 240     /SPACE
15371  0215          215     /CR
15372  0000          0

             /'GWORD' JUMP LISTS
15373  3154  GWOPS1, GWD4    / 9 - A NUMBER
15374  3154          GWD4    / 8 - A NUMBER
15375  3154          GWD4    / 7 - A NUMBER
15376  3154          GWD4    / 6 - A NUMBER
15377  3154          GWD4    / 5 - A NUMBER
15400  3154          GWD4    / 4 - A NUMBER
15401  3154          GWD4    / 3 - A NUMBER
15402  3154          GWD4    / 2 - A NUMBER
15403  3154          GWD4    / 1 - A NUMBER
15404  3154          GWD4    / 0 - A NUMBER
15405  3154          GWD4    /^D - A NUMBER
15406  3154          GWD4    /^K - A NUMBER
15407  3154          GWD4    / " - A NUMBER
15410  3154          GWD4    / ' - A NUMBER
15411  3154          GWD4    / ( - A NUMBER
15412  3150  GWOPS2, GWD2    /SPACE - TERMINATOR
15413  3151          GWD3    /  CR  -     "

             /'ACCEPT' JUMP LIST
15414  5213  ACOPS,  ACCNUM  / 9 - A DIGIT
15415  5213          ACCNUM  / 8 - A DIGIT
15416  5213          ACCNUM  / 7 - A DIGIT
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 47-1

15417  5213          ACCNUM  / 6 - A DIGIT
15420  5213          ACCNUM  / 5 - A DIGIT
15421  5213          ACCNUM  / 4 - A DIGIT
15422  5213          ACCNUM  / 3 - A DIGIT
15423  5213          ACCNUM  / 2 - A DIGIT
15424  5213          ACCNUM  / 1 - A DIGIT
15425  5213          ACCNUM  / 0 - A DIGIT
15426  5256          CTRLD   / ^D SWITCH
15427  5257          CTRLK   / ^K SWITCH
15430  5243          DQUOTE  / " - SINGLE ASCII
15431  5246          SQUOTE  / ' - PACKED ASCII
15432  5240          ERCR    / ( - ILLEGAL HERE
15433  5234          ACCPT3-2        /SPACE - END
15434  5235          ACCPT3-1        /CR - END

             /'GARGS' JUMP LIST - TERMINATORS
15435  5317  GAROPS, GAR5    /-
15436  5323          GAR6    /,
15437  5307          ERCS    /:, SHOULDN'T SEE, WILL DO ERROR
15440  5314          GAR4    /.
15441  5307          ERCS    /SPACE, SHOULDN'T SEE, WILL DO 'ERROR'
15442  5310          GAR3    /CR

             /'GARGS' & 'ARG' COMMAND LISTS
15443  0255  GARLST, "-
15444  0254          ",
15445  0272  GETLST, ":
15446  0256  ARGLST, ".
15447  0240          240     /SPACE
15450  0215          215     /CR
15451  0000          0

             /'GETNT' LISTS
15452  3723  GETOPS, GETCOL
15453  3730          GETPER
15454  3736          GETEND
15455  3737          GETEND+1

             /'ARG' JUMP LIST
15456  5723  ARGOPS, ARG2
15457  5726          ARG3
15460  5726          ARG3

             /'WCHEK' LISTS
15461  0250  WCKLST, "(
15462  0251          ")
15463  0242          ""
15464  0247          "'
15465  0215          215
15466  0000          0

15467  6227  WCKOPS, WCHEK5+1
15470  6226          WCHEK5
15471  6233          WCHEK6+1
15472  6232          WCHEK6
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 47-2

15473  6222          WCHEK4

             /'EVAL' JUMP LIST 1
15474  5470  EVOPS1, EVNEXT  /+
15475  5415          EVMIN   /-
15476  5537          EVLPAR  /(

             /'EVAL' COMMAND LISTS
15477  0253  EVLST1, "+
15500  0255          "-
15501  0250          "(
15502  0000          0

15503  0314  EVLST2, "L
15504  0302          "B
15505  0323          "S
15506  0303          "C
15507  0306          "F
15510  0322          "R
15511  0324          "T
15512  0304          "D
15513  0000          0

             /'EVAL' JUMP LIST 2
15514  5527  EVOPS2, EVLOC   /L (LOC)
15515  5533          EVBLK   /B (BLK)
15516  5522          EVSR    /S (S.R.)
15517  5523          EVSR+1  /C (CONTENTS)
15520  5525          EVFIL   /F (FILLER)
15521  5512          EVREM   /R (REMAINDER)
15522  5516          EVTEMP  /T (TEMP)
15523  5506          EVDATE  /D (DATE)

             /ACTION CHARS FOR "READLN" SUBROUTINE
15524  0222  REACTL, "R-100  /CTRL-R = RE-ECHO
15525  0225          "U-100  /CTRL-U = ERASE LINE
15526  0000          0

15527  4063  REACTS, RECHO
15530  4100          RERASE
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 48

             /ERROR ROUTINE ADDRESS LIST:

15531  0233  ERLIST, ERCA
15532  0227          ERCB
15533  0402          ERCC
15534  0605          ERC14
15535  0735          ERCD
15536  0755          ERCE
15537  1215          ERCG
15540  2015          ERCH
15541  2011          ERCI
15542  1605          ERCK
15543  1673          ERCJ
15544  1611          XSET1
15545  1631          ERCL
15546  1654          ERCZ
15547  2430          ERCO
15550  1617          ERC11
15551  2642          ERC04
15552  2473          ERCP
15553  5722          ERCQ
15554  5240          ERCR
15555  5222          ERC09
15556  5736          ERC08
15557  5267          ERC13
15560  5307          ERCS
15561  5412          ERCT
15562  5414          ERCU
15563  5541          ERCV
15564  5547          ERCW
15565  6047          ERCX
15566  1156          ERCY
15567  3731          ERCM
15570  2214          ERC00
15571  2215          ERC01
15572  2415          ERC02
15573  2416          ERC03
15574  2342          ERC10
15575  2116          ERCF
15576  2022          GCCERR
15577  2101          HDRERR
15600  3103          ERC05
15601  2502          ERC07
15602  2254          ERC18
15603  2312          ERC19
15604  2351          ERC20
15605  0545          ERC15
15606  0564          ERC16
15607  4116          ERC17
15610  0000          0


                     DECIMAL

15611  7777  SMASKB, -1              /STRING SEARCH MASK BUFFER
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 48-1

                             /L(SMASKB)=66(10)
       5713  COMB=   SMASKB+66       /COMMAND INPUT BUFFER
                             /L(COMB)= 140(10)
       6127  PDLB=   COMB+140        /PUSH-DOWN-LIST BUFFER
                             /**** ALSO REWIND BUFFER! ****
15612  0251          CCBB-PDLB       /SHOW PDL SPACE

                     OCTAL


       6400  CCBB=   16400   /CORE-CONTROL-BLOCK BUFFER AND HEADER
                             / BUFFER FOR LOAD MODULES, 1 PAGE FIELD 1

       6600  DMPBUF= 16600   /DUMP OUTPUT BUFFER, 2 PAGES FIELD 1

       7200  IOBUF=  17200   /DEVICE I/O DUFFER, 2 PAGES FIELD 1


             $$$$
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 49

ABKLOC 1741      CCHDST 1553      DEVHAN 7200      ERCH   2015
ABK1   1747      CGET   2546      DEVNO  0101      ERCI   2011
ABK2   1753      CGTEST 2552      DICAD  6163      ERCJ   1673
ABSSW  0051      CHAR   0035      DIGIT  4531      ERCK   1605
ACBASE 5242      CHARSW 0045      DIOR   5677      ERCL   1631
ACCEPT 5200      CLANAM 2726      DIRDMP 3155      ERCM   3731
ACCMUL 5223      CLOSE  0361      DIROUT 3163      ERCO   2430
ACCNUM 5213      CNOP   2036      DLOOP1 0427      ERCP   2473
ACCPT1 5206      CNT    0036      DLOOP2 0445      ERCQ   5722
ACCPT3 5236      CNTR   0037      DMODE  0053      ERCR   5240
ACCX1  0027      CNTRA  0040      DMPADR 2340      ERCS   5307
ACCX2  0030      COMB   5713      DMPBLK 2341      ERCT   5412
ACC1   0025      COMIR  0015      DMPBUF 6600      ERCU   5414
ACC2   0026      COMOUT 0016      DMPCHR 2352      ERCV   5541
ACOPS  5414      COMST  0174      DMPHAN 6600      ERCW   5547
ADFLD  7000      CONDIT 6265      DMPIT  2335      ERCX   6047
ALTMOD 0253      COPSL  4543      DMPNUL 2321      ERCY   1156
ALTM1  0261      CRCR   0216      DMPOUT 2315      ERCZ   1654
ARG    5713      CRCRC  0235      DMPPTR 2353      ERC00  2214
ARGI   0160      CRCRN  0234      DMUL   6000      ERC01  2215
ARGLST 5446      CRCR1  0230      DMUL1  6004      ERC02  2415
ARGOPS 5456      CRLF   5044      DMUL2  6021      ERC03  2416
ARG1   5715      CRLFI  0130      DMUL3  6031      ERC04  2642
ARG2   5723      CRSWT  0046      DMUL4  6014      ERC05  3103
ARG3   5726      CTRL   5125      DNAM   2266      ERC07  2502
ASCII  2163      CTRLC  5160      DODIG  4161      ERC08  5736
BACKAR 0271      CTRLCI 5162      DOFLD  4742      ERC09  5222
BASE   4622      CTRLD  5256      DO1SP  2561      ERC10  2342
BATINI 4051      CTRLI  0134      DO2SP  2565      ERC11  1617
BATLS  6657      CTRLK  5257      DPNEG  6141      ERC13  5267
BATLUP 6621      CTRLQS 5167      DPNT   0010      ERC14  0605
BATMOV 6615      CTRLX  5163      DPRT   3436      ERC15  0545
BATPAT 6624      CTRL0  5127      DPSGN  0001      ERC16  0564
BATSET 6600      CTRL1  5143      DQUOTE 5243      ERC17  4116
BCTRLC 5135      CTRL2  5150      DSUB   5662      ERC18  2254
BITPNT 4471      CWORDL 4603      DSWIT  0052      ERC19  2312
BITS   4456      CWORL2 4664      EAE    4311      ERC20  2351
BITVAL 4522      C100   5124      EAELST 2664      ERLIST 5531
BKLOC  3105      DADD   5650      EAETMP 4332      ERMODE 0020
BKLOCI 0146      DAND   5667      EBLK   2104      ERMSA  0062
BLK    0057      DBLPGS 3063      ECLOSE 0353      ERMSB  0100
BLKTST 6154      DCAICA 4555      ELOCH  2105      ERMSC  0116
BPRT   3415      DDCWPT 2265      ELOCL  2106      ERMSD  0125
BTEST  4103      DDEVAD 2263      EMSEND 0060      ERMSE  0137
BUFST  3041      DDEVNO 2264      ENDC   4141      ERMSF  0150
BYTEO  3517      DDEVS  2430      ENDCI  0170      ERMSG  0227
CAD    0056      DDIV   6040      ENUM   5472      ERMSGC 0171
CALUSR 4552      DDIV1  6051      ENUMX  5501      ERMSH  0242
CBATE  6736      DDIV2  6064      ERCA   0233      ERMSHD 0207
CBATI  6707      DDIV3  6072      ERCB   0227      ERMSI  0256
CBATO  6746      DECI   0137      ERCC   0402      ERMSJ  0267
CBLK   0054      DEC2   3445      ERCD   0735      ERMSK  0276
CCBB   6400      DEC2I  0141      ERCE   0755      ERMSL  0341
CCBHDR 2106      DEVAD  0100      ERCF   2116      ERMSM  0361
CCHARL 4473      DEVADX 2140      ERCG   1215      ERMSO  0404
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 49-1

ERMSP  0417      EVREM  5512      GET    3000      INSLST 2600
ERMSQ  0435      EVSR   5522      GETCOL 3723      IOBUF  7200
ERMSR  0456      EVTAB  5566      GETCW  3360      IOPNT  4544
ERMSS  0501      EVTEMP 5516      GETEND 3736      IOPRNT 4523
ERMST  0523      EXCL   0312      GETI   0161      IOPRN1 4525
ERMSU  0543      EXCL1  0317      GETIO  3027      IOPRN2 4542
ERMSV  0564      EXCL2  0336      GETIO1 3044      IOTS   4257
ERMSW  0604      EXPRIN 5727      GETIO2 3061      IOTTAB 2732
ERMSX  0622      EXPRI1 5735      GETLST 5445      LASTOP 0002
ERMSXO 0322      FBKLEN 1036      GETL1  3300      LBLK   0065
ERMSY  0636      FCNT   0042      GETL2  3302      LCHEK  2147
ERMSZ  0651      FILLER 0074      GETL3  3345      LFLF   0311
ERMS00 0673      FLD    7026      GETL4  3351      LIMITI 0165
ERMS01 0671      FLDOUT 6277      GETN   5362      LIMITS 2752
ERMS02 0706      FMTLS  5000      GETNI  0163      LISTPT 0725
ERMS03 0704      FOPSL  4734      GETNT  3741      LLIST  0661
ERMS04 0717      FOP134 4067      GETNTC 3746      LLIS1  0664
ERMS05 0742      FORML  4703      GETOP  6243      LLIS2  0702
ERMS07 0764      FPCOND 4111      GETOPS 5452      LLIS3  0712
ERMS08 1003      FPLEA  4611      GETORG 3357      LLIS4  0717
ERMS09 1030      FPOP00 4015      GETPER 3730      LLIS5  0722
ERMS10 1037      FPPDMP 4400      GETPNT 0014      LLOCH  0066
ERMS11 1051      FPPINS 3757      GETSCN 3717      LLOCL  0067
ERMS13 1071      FPPMOJ 4132      GETSWX 2141      LOCH   0060
ERMS14 1104      FPPMO0 4122      GETS1  3214      LOCL   0061
ERMS15 1124      FPPOPJ 4161      GETS2  3261      LONG   4640
ERMS16 1135      FPPOP0 4141      GETX   3026      LOUTSW 0726
ERMS17 1151      FPPOUT 4600      GET0   3010      LPAR   5616
ERMS18 1163      FPRNT  1363      GET1   3013      LPARI  5564
ERMS19 1172      FPRNTX 7011      GET4   3200      LSETL  2127
ERMS20 1201      FPXR1S 4050      GET678 6251      LSETUP 2107
ERMS99 1212      FPXR2S 4057      GHDR   2050      MAIN1  0204
ERROR  4573      FSTBLK 1035      GHDR1  2102      MAIN2  0212
ERROR1 2433      FTABLE 4764      GNAME  3676      MASK   0075
EVAL   5400      F0END  6572      GPAIR  3751      MASKBS 0176
EVALI  0147      GARGI  0157      GPUT   5326      MCHARO 5063
EVALX  5557      GARGS  5272      GPUT1  5335      MDCOM  6112
EVAL1  5407      GARLST 5443      GWD1   3143      MINUS  0345
EVAL2  5413      GAROPS 5435      GWD2   3150      MODADS 5035
EVAL3  5423      GAR1   5276      GWD3   3151      MODDLS 5046
EVBLK  5533      GAR2   5302      GWD4   3154      MODELS 5271
EVDATE 5506      GAR3   5310      GWLST1 5351      MODIF  0050
EVFIL  5525      GAR4   5314      GWLST2 5370      MODIFL 5014
EVLOC  5527      GAR5   5317      GWOPS1 5373      MODIFO 5025
EVLPAR 5537      GAR6   5323      GWOPS2 5412      MODLST 5240
EVLST1 5477      GCCB   2000      GWORD  3122      MODOPS 5251
EVLST2 5503      GCCBLK 2130      GWORDI 0156      MODSW  0044
EVMIN  5415      GCCB1  2026      HDRERR 2101      MODTMP 2477
EVNEXT 5470      GCCB2  2042      IFSKPO 5065      MONTHS 2521
EVOP   5446      GCCCDF 2046      INC    3557      MSBAD  2145
EVOPN  5554      GCCERR 2022      INCI   0166      MSBASE 3743
EVOPS1 5474      GDEVIC 1140      INDIR  4631      MSDDEV 2450
EVOPS2 5514      GDEV1  1153      INIDAT 6322      MSDEV  2457
EVPAR  5456      GDEV2  1154      INIMSG 6306      MSERR  2500
EVPAR2 5542      GDEV3  1155      INISCO 6315      MSINDI 3746
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 49-2

MSJNX  3751      M400   0103      OUTLS  5275      R2     4053
MSMOD  2142      NAM1   0025      OUTPNT 0043      SBLK   0070
MSVER  2512      NAM2   0026      OUTSW  0765      SCANER 5744
MS01   4200      NAM3   0027      OVLFLG 0000      SCANX1 0012
MS02   4204      NAM4   0030      PACK   2704      SCANX2 0013
MS03   4210      NCNT   0041      PACK1  2716      SCOPLS 6630
MS04   4216      NUMB   3500      PACOUT 3621      SEGCNT 3361
MS05   4223      NUMDGT 3501      PATCH  0001      SEGNI  2127
MS06   4230      NUMOPS 5067      PDATE  5000      SEMIC  0310
MS07   4203      NUMOUT 3453      PDATEI 0142      SETJMP 5171
MS08   4235      NUMO1  3455      PDLB   6127      SETLST 5111
MS09   4242      NUMO2  3466      PDLPT  0007      SGNDP  3423
MS10   4247      NXTIOT 3542      PDPDMP 4214      SHOWL  5074
MS11   4253      NXTOCT 1766      PDPOUT 4221      SHOWOP 5133
MS12   4256      N15    0114      PLUS   0344      SHUT   0047
MS13   4264      N177   0117      PNAME  2731      SLASH  0237
MS14   4267      N20    0115      PNAME1 2744      SLA1   0244
MS15   4277      N200   0120      POP    4551      SLOCH  0071
MS16   4306      N377   0121      POPX   5606      SLOCL  0072
MS17   4310      N7     0113      PUSH   4550      SLO1   0245
MS18   4313      N7000  0122      PUSHX  5600      SLO2   0246
MS19   4317      N7400  0103      QUOTEC 5265      SMASKB 5611
MS20   4324      N77    0116      RBLK   3057      SMASKL 0076
MS21   4332      OCTI   0140      RBLK1  0077      SMSKSW 2360
MS22   4336      OCTSET 5261      RDERX  2136      SOCTI  0145
MS23   4341      OCT3   3407      REACTL 5524      SORTEM 3675
MS24   4344      ODGET  3073      REACTS 5527      SORTI  0167
MS25   4345      ODGETI 0162      READ   4000      SORTJ  3643
MS26   4351      ODTOL  4212      READLN 4523      SORT1  3652
MS27   4354      ODTOPT 4204      RECHO  4063      SORT2  3673
MS28   4360      ODTOUT 4200      RECHO1 4070      SPACE1 4532
MS29   4363      OFFSET 0073      RECRLF 0171      SPACE2 4533
MS30   4367      OMODES 0255      REFS1  4244      SPCOP0 4660
MS31   4374      OMODPT 0270      REFS2  4255      SPCOP1 4717
MS32   4376      ONECHR 3631      REKEY  4011      SPCOP2 4744
MS33   4403      OPEND  4446      RENEXT 4007      SPCOP3 4731
MS34   4405      OPER1  0031      RERASE 4100      SPCOP4 4732
MS35   4410      OPER2  0032      RERROR 2213      SPCOP5 4747
MS36   4412      OPRMES 2730      RESPC  4024      SPCOP6 4757
MS37   4415      OPRS   4262      RESTAR 0172      SPCOP7 4756
MS38   4422      OPRS1  4275      RETERM 4020      SPECIA 4654
MS39   4426      OPRT   3400      RKEY   4112      SPNT   0011
MS40   4436      OPRTST 4547      RKEY0  4126      SPNUSE 4677
MS41   4443      OPRTYP 4467      RKEY1  4137      SPOP00 4665
MS42   4452      OPR1A  4333      RLAST  4054      SPOP04 4670
MS43   4470      OPR2A  4405      RM214  4052      SPOP05 4675
MULNEG 6126      OPR2B  4424      RTL6   3762      SPOP1J 4737
MULT3  6257      OPR2T  4515      RTL6I  0143      SPOP10 4707
M1     0112      OP1LST 2620      RTR6   3767      SPOP11 4710
M10    0111      OP2LST 2642      RTR6I  0144      SPO123 4701
M100   0107      OSRETN 3535      RUBO   4031      SQUOTE 5246
M20    0110      OSSET  3527      RUBOE  4057      SSET   2047
M200   0106      OSTYPE 3511      RUBOF  4061      SSKIP  3502
M215   0105      OSUNPK 3540      RUBO1  4035      SSKIPI 0164
M240   0104      OTABLE 4526      RUBO2  4047      START  6400
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 49-3

STCDF  6211      TYPEOP 4575      XDMLST 5261      XOCEX  2261
STDEV  6426      TYPES  3600      XDMODE 1612      XOFFS  1642
STERR  6551      TYPEX  5042      XDMODS 1621      XOLST  5223
STJMP  5757      TYPE1  2400      XDMOPS 5265      XOOPS  5232
STRLST 5301      TYPE2  2412      XDNAM  2464      XOPEN  1000
STRMSK 2357      TYPE3  2431      XDUMP  0603      XOPEN1 2222
STROPS 5326      TYPSI  0125      XDUM0  0610      XOPEN2 2237
STSWEX 6532      TYPSTI 0124      XDUM1  0611      XOPS1  2634
STSWIT 6471      TYPSTR 3605      XDUM2  0617      XOPS2  2643
STSWO  6507      TYPSW  0017      XELST  5212      XOPS3  2655
STSWS  6520      TYPTAB 5106      XEMODE 1647      XOPS4  2673
STTLS  6536      UBLK   0062      XEMOD1 1655      XOPS5  2675
SYMEND 4256      UCDF0  0525      XEOPS  5217      XOSIZ  2253
SYMLIM 4433      ULOCH  0063      XERROR 0454      XOUTS  1624
SYMNXT 4504      ULOCL  0064      XERR1  0465      XOUTS1 1633
SYMPNT 4514      UPARR  0274      XERR2  0475      XPAC0  2620
SYMS   4226      UPARR1 0306      XERR3  0505      XPAC1  2621
SYMTYI 6276      UPCBLK 3362      XERR4  0515      XPAC2  2627
SYMTYP 4475      USEUSR 0520      XEXIT  5160      XREWIN 2200
TADICA 4554      USRAD  0102      XFCHR  0740      XROUT  4713
TADIDP 4553      USRCDF 0541      XFICHN 1026      XRPLUS 4643
TCHAR  5077      USRIN  0536      XFIERR 1006      XRSET  2343
TEMP   0021      USROUT 0544      XFILE  1024      XSCAN  0600
TEMPL  6306      USRSAV 0544      XFILEN 1021      XSET   1602
TEMPST 0175      VERONE 0010      XFILL  1701      XSETN  1600
TEMPV1 0033      VERSIO 0010      XFIOUT 1016      XSET1  1611
TEMPV2 0034      VERTEN 0000      XFNUM  0737      XSHABS 1250
TEMP1  0022      WBLK   3042      XFORM  0754      XSHBKS 1257
TEMP2  0023      WCHEK  6200      XFSYM  0736      XSHBLK 1200
TEMP3  0024      WCHEK1 6203      XGET   2500      XSHCCB 1400
TERMS  5337      WCHEK2 6211      XGFORM 0727      XSHCC1 1414
TERMT  5624      WCHEK3 6215      XIF    1713      XSHCC2 1416
TERMTE 5646      WCHEK4 6222      XIFCR  1731      XSHCC4 1445
TERMTI 5565      WCHEK5 6226      XIFSKP 1723      XSHCR  1204
TERMT1 5633      WCHEK6 6232      XLIST0 0632      XSHDDE 1360
THISOP 0003      WCHONE 6235      XLIS1  0633      XSHDEV 1347
TICAD  6170      WCKLST 5461      XLIS2  0645      XSHERR 1530
TIDPNT 2156      WCKOPS 5467      XLOCH  2365      XSHER1 1537
TTAGN  3607      WERROR 2414      XLOCL  2366      XSHFIL 1232
TWOCI  0127      WOPSL  4634      XLOW   1663      XSHFM  1303
TWOCS  1761      WOPSLL 4674      XMASK  1636      XSHFMT 1277
TWOT   0135      XASC1  2537      XMODCR 2465      XSHHDR 1455
TYPALT 5101      XBLK   2364      XMODDN 2474      XSHHD1 1477
TYPC   5076      XCLNAM 2310      XMODE  1666      XSHHD2 1502
TYPCR  5104      XCLOSE 1004      XMODEF 2431      XSHLOW 1272
TYPCTL 5120      XCLOS1 2272      XMODIF 2417      XSHMOD 1307
TYPE   5061      XCLSIZ 2311      XMODS  1675      XSHMSK 1221
TYPEA  5033      XCTLZ  2277      XMOD0  2436      XSHODL 1236
TYPEAI 4056      XDDEV  1134      XMOD1  2441      XSHOFF 1225
TYPEB  2405      XDDEV1 2200      XMOD2  2451      XSHOUT 1314
TYPEC  5054      XDDEV2 2441      XNUM0  2506      XSHOW  1210
TYPECI 0126      XDDNAM 2454      XNUM1  2512      XSHREL 1243
TYPEI  0136      XDEV   1121      XNUM2  2514      XSHSMS 1321
TYPEL  4517      XDEVM  2467      XNUM3  2524      XSHSM1 1332
TYPEM  4523      XDLCOM 0647      XOBLK  2252      XSHSM2 1342
/FUTIL - FILE UTILITY - V08A              PAL8-V10D NO DATE   PAGE 49-4

XSHUPP 1265      
XSHVER 1216      
XSMASK 2600      
XSMAS1 2605      
XSTRIN 2216      
XSTR0  2220      
XSTR1  2232      
XSTR10 2333      
XSTR11 2336      
XSTR2  2240      
XSTR3  2246      
XSTR4  2260      
XSTR5  2277      
XSTR6  2302      
XSTR7  2306      
XSTR8  2321      
XSTR9  2324      
XSTYPE 1203      
XS240O 5352      
XTEMP  1705      
XUPP   1660      
XVAL   0400      
XWBLK  2410      
XWORC  2033      
XWORCL 5277      
XWORD  2000      
XWOROP 5313      
XWOR1  2006      
XWOR2  2004      
XWOR3  2021      
XWOR4  2027      
XWOR5  2045      
XWOR7  2016      
XWRARG 2400      
XWRITE 2403      
XWSABS 2066      
XWSFRM 2071      
XWSRET 2100      
XWSTO  2074      
XXS20  2617      
YRBASE 5032      
YRTEST 5031      


ERRORS DETECTED: 0
LINKS GENERATED: 165



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/FUTIL.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789

/FUTIL - FILE UTILITY - V08A

DECIMAL
VERSION=08
OCTAL
PATCH="A&77

/	OS/8 FILE UTILITY PROGRAM.  ALLOWS EXAMINATION AND
/  MODIFICATION OF OS/8 MASS STORAGE DEVICES FROM THE CON-
/  SOLE.  DUMPING OF BLOCKS, LISTING OF WORDS AND MODIFICA-
/  TION OF WORDS CAN BE DONE IN 7 FORMATS: OCTAL; SIGNED AND
/  UNSIGNED DECIMAL; UNPACKED, 6-BIT PACKED, XS240 PACKED AND
/  OS/8 PACKED ASCII.  LISTING AND DUMPING CAN ALSO BE DONE
/  IN 5 MORE FORMATS: BCD, BYTE (OCTAL CHARACTER), 2 PSEUDO-
/  SYMBOLIC FORMATS [PDP-8 & FPP-12/8A], AND A COMBINATION
/  FORMAT FOR DIRECTORY DUMPING. PROGRAM USES BOTH COMMAND
/  WORDS AND COMMAND CHARACTERS (LIKE ODT) FOR DIRECTION.

/BY:	JIM CRAPUCHETTES
/	MENLO COMPUTER ASSOCIATES, INC.
/	(FORMERLY: FRELAN ASSOCIATES)
/	P.O. BOX 298
/	MENLO PARK, CALIF. 94025
/
/
/VERSIONS 1 THRU 4 - "XTAPE" FOR THE XSYSTEM,
/  LAST REVISION--APRIL 1970.
/
/VERSION 5 - OS/8 OPERATION, JULY 1972 THRU JUNE 1976
/  "(...)", "C & 'CC AS NUMBERS, IOT DECODING, LIST
/  & DUMP FORMATS, OUTPUT TO LPT:, FILE DATE & LOC
/  IN DIRECTORY, "WORD MEMREF...", BCD OUTPUT,
/  ADDITIONAL ODT OUTPUTS, "BYTE" OUTPUT.
/VERSION 6 - EXPANSION OF OS/8 OPERATION, JUNE 1976:
/  "FILLER" FOR "MODIFY", SEARCH LIMITS CHANGE, "WRITE"
/  WITH AN ARGUMENT, FPP INSTRUCTION DECODING, CHAINING
/  SUPPORT (FOR CCL CALLS), LOAD MODULE HANDLING AND
/  "SHOW HEADER", MULTIPLE DEFAULT EXTENSIONS, ^R FOR
/  RETYPE, SET REPLACES OPTION, NEW OUTPUT ROUTINE FOR
/  "DIRECTORY" FORMAT, LINK OVERLAY HANDLING, ODT CHANGES,
/  EXIT, SCAN, WRITE LOCKED OPERATION, SPEED UP SEARCHES,
/  XS240 FORMATS
/VERSION 6.17 - APR 1, 1977; BATCH OPERATION, COMMENT
/VERSION 6.20 - MAY 16, 1977; NEW DATE, FULL FILE OUTPUT
/   (SET/SHOW DDEV, OPEN ..., CLOSE), OPT ":" ON DEVICES.
/VERSION 6.21 - JUN 4, 1977; NEW INPUT ROUTINE, TEMP STORAGE
/VERSION 6.22 - JUL 13, 1977; CRTL-Q & -S, SCOPE MODE,
/  IF/END COMMANDS, ALPHA DATE.
/
/PREVIOUS VERSIONS HAVE BEEN AVAILABLE THROUGH DECUS,
/  DEC SUPPORT BEGINS WITH VERSION 7 - 20-JUL-77.
/		VERSION 7 PATCHES:
/		1.CTRL/U CRASH & OVERLAY MAPPING IN SAVE MODE(7A TO 7B)
/		2.FIXED SHOW CCB PROBLEM(7B TO 7C)
/		3.ODT MAPPING ON LD. MODULES(7C TO 7D)
/		4.ADDED SHOW CCB SUPPORT FOR KT8A SAVE IMAGES(7D TO 7E)
/	SOME ROUTINES AND IDEAS USED IN THIS PROGRAM WERE
/  DERIVED FROM EDIT-8 AND FOCAL, BY RICK MERRILL, DEC.
/	THE ODT COMMAND SET IS NEARLY IDENTICAL TO THE OS/8
/  ODT COMMAND SET EXCEPT THAT 15 BIT ADDRESSES ARE USED
/  EVERYWHERE AND THERE ARE NO COMMANDS FOR PROGRAM EXECU-
/  TION.
/	THE DOUBLE PRECISION ARITHMETIC ROUTINES ARE A MUCH
/  MODIFIED VERSION OF DECUS 8-115A.


/  ASSEMBLY INFORMATION:
/
/  .R PAL8	[VERSION 9]
/  *FUTIL<FUTIL/L/K/P=6400$
/  .SA ... FUTIL
/
/	THE LISTING FILE REQUIRES ABOUT 725 BLOCKS, THE BIN-
/  ARY FILE ABOUT 35 BLOCKS AND THE CREF LISTING FILE ABOUT
/  960 BLOCKS.  CREFING REQUIRES EITHER "/M" OR "/X" FOR
/  CREF V3.


/MEMORY ALLOCATION:
/
/00000-06310	PROGRAM PROPER
/06310-06577	ARGUMENT STRING BUFFER
/06400-06777	--- ONCE ONLY CODE FOR CHAIN ---
/06600-07177	DDEV HANDLER AREA, 2 PAGES
/07200-07577	DEVICE HANDLER AREA, 2 PAGES
/
/10000-11777	USR AREA & ERROR MESSAGES (SWAPPED)
/12000-12377	CCB/HEADER CODE, OPEN, CLOSE & OUTPUT
/12600-15700	TEXT STRINGS, LISTS
/15700-16377	STRING MASK, COMMAND BUFFERS, PDL
/16400-16577	CCB BUFFER, 1 PAGE
/16600-17177	DDEV BUFFER, 2 PAGES
/17200-17577	I/O BUFFER, 2 PAGES
/PAGE 0: POINTERS, CONSTANTS, VARIABLES, SWITCHES, ADDRESSES


*0

OVLFLG,	0	/OVERLAY FLAG FOR SAVE FILES

DPSGN,	0
LASTOP,	0
THISOP,	0

ZBLOCK 3	/USED BY ODT

/VARIABLES & SWITCHES
PDLPT,	0	/P.D.L. POINTER
DPNT,	RUBO-1	/USED UNIVERSALLY (SCOPE INITIALIZATION)
SPNT,	SCOPLS-1 /USED BY 'XSTRIN', 'XSMASK', 'READ', 'TERMT'
SCANX1,	BATLS-1	/USED BY 'SORTJ' (BATCH INITIALIZATION)
SCANX2,	0	/USED BY 'XSTRIN'
GETPNT,	0	/USED BY 'GET' & 'BKLOC'
COMIR,	0	/USED FOR USER LINE INPUT
COMOUT,	COMB-1	/USED FOR USER LINE SCAN
TYPSW,	0	/ODT COMMAND OCT-SYM SWITCH (0=OCT)
ERMODE,	0	/ERROR MESSAGE MODE SWITCH (0=LONG)

TEMP,	0
TEMP1,	0
TEMP2,	0
TEMP3,	0
ACC1,	0	/24 BIT ACCUMULATORS
ACC2,	0
ACCX1,	0
ACCX2,	0

NAM1=	ACC1	/DEFINITIONS FOR NAME BUFFER:
NAM2=	ACC1+1	/  THESE LOCATIONS ARE USED FOR A
NAM3=	ACC1+2	/  6 CHARACTER FILE (OR DEVICE)
NAM4=	ACC1+3	/  NAME & A 2 CHAR EXTENSION.

OPER1,	0
OPER2,	0

TEMPV1,	0	/24 BIT TEMPORARY STORAGE FOR
TEMPV2,	0	/ "SET TEMP ..." & "EVAL T"

CHAR,	0
CNT,	0
CNTR,	0
CNTRA,	0
NCNT,	0	/LINE POSITION COUNTER
FCNT,	0	/FORMAT NUMBER (INIT TO PACKED ASCII)
OUTPNT,	PACOUT	/POINTER TO DEFAULT OUTPUT ROUTINE
MODSW,	0	/MODES: NORMAL=0,MAPPED=+,OFFSET=-.
CHARSW,	0	/CHARACTER PACK & UNPACK SWITCH
CRSWT,	0	/= -1 IF GWORD TERMINATOR WAS A SPACE
SHUT,	0	/= -1 IF SOMETHING OPEN
MODIF,	0	/= -1 IF SOMETHING WAS MODIFIED
ABSSW,	0	/ABSOLUTE OR RELATIVE LOCATION FOR SEARCHES
DSWIT,	0	/DUMP SWITCH: "DUMP","LIST" & "SHOW ERR" -> 1
DMODE,	0	/DUMP MODE: NONE=0,PART=1,ALL=4000

CBLK,	0	/= CURRENT BLOCK
	0	/DUMMY FOR "SHOW ABS"
CAD,	0	/= CURRENT ADDRESS (0 -> 377)+IOBUF
BLK,	0	/= "BLOCK"
LOCH,	0
LOCL,	0	/= "LOCATION" (DISPLACEMENT)
UBLK,	0	/UPPER LIMIT FOR SEARCHES
ULOCH,	1
ULOCL,	7577
LBLK,	0	/LOWER LIMIT FOR SEARCHES
LLOCH,	0
LLOCL,	200
SBLK,	0	/"LOCATION" FOR "ODT" ROUTINES
SLOCH,	0
SLOCL,	0

OFFSET,	0	/OFFSET
FILLER,	0	/FILLER CONSTANT FOR "MODIFY"
MASK,	-1	/MASK FOR WORD SEARCH
SMASKL,	-1	/= -(LENGTH OF SMASK)
RBLK1,	0	/START BLOCK OF FILE
DEVAD,	7607	/DEVICE ENTRY ADDR (INIT TO "SYS")
DEVNO,	1	/DEVICE NUMBER (INIT TO "SYS")
USRAD,	7700	/USR ADDRESS, INITIALIZED TO OUT
		/7700=MSGS IN; 0=NONE IN; 200=USR IN

/CONSTANTS
M400,	-400
M240,	-240
M215,	-215
M200,	-200
M100,	-100
M20,	-20
M10,	-10
M1,	-1
N7,	7
N15,	15
N20,	20
N77,	77
N177,	177
N200,	200
N377,	377
N7000,	7000
N7400=	M400

/ADDRESSES
READLN=	JMS I .		/GET NEXT INPUT LINE, WITH
	READ		/ SPECIAL TERMINATORS
TYPSTI,	TYPSTR
TYPSI,	TYPES
TYPECI,	TYPEC
TWOCI,	TWOCS
CRLFI,	CRLF
DIGIT=	JMS I .		/OUTPUT AN ASCII DIGIT
	DODIG
SPACE1=	JMS I .		/OUTPUT 1 SPACE OR ...
	DO1SP
SPACE2=	JMS I .		/OUTPUT 2 SPACES
	DO2SP
CTRLI,	CTRL
TWOT,	PACOUT
TYPEI,	TYPE
DECI,	DPRT
OCTI,	OPRT
DEC2I,	DEC2
PDATEI,	PDATE
RTL6I,	RTL6
RTR6I,	RTR6
SOCTI,	OCTSET
BKLOCI,	BKLOC
EVALI,	EVAL

PUSH=	JMS I .		/PUSH AC ON P.D.L.
	PUSHX
POP=	JMS I .		/POP P.D.L. INTO AC
	POPX
CALUSR=	JMS I .		/DO USR FUNCTION
	USEUSR
TADIDP=	JMS I .		/"TAD I DPNT" IN FIELD 1
	TIDPNT
TADICAD=  JMS I .	/"TAD I CAD" IN FIELD 1
	TICAD
DCAICAD=  JMS I .	/"DCA I CAD" IN FIELD 1
	DICAD

GWORDI,	GWORD
GARGI,	GARGS
ARGI,	ARG
GETI,	GET
ODGETI,	ODGET
GETNI,	GETN
SSKIPI,	SSKIP
LIMITI,	LIMITS
INCI,	INC
SORTI,	SORTJ
ENDCI,	ENDC
RECRLF,	MAIN1-1
RESTAR,	MAIN1

ERROR=	JMS I .
	XERROR

COMST,	COMB-1
TEMPST,	TEMPL-1
MASKBS,	SMASKB-1


PAGE
/PROGRAM MAIN LOOP AND DRIVER.  COLLECTS CHARACTERS
/INTO COMMAND BUFFER UNTIL END IS REACHED.

	DCA USRAD	/CLEAR ON RESTART (NOTHING IN)!
	TLS		/RAISE TELETYPE FLAG
	DCA SHUT	/NOTHING IS OPEN
	JMS I CRLFI	/OUTPUT CR-LF.
MAIN1,	JMS I SOCTI	/SET INPUT TO OCTAL; EXEC 'COMMENT'
	DCA DSWIT	/RESET DUMP OUTPUT SWITCH
	TAD COMST	/INIT COMMAND BUFFER.
	DCA COMIR
	TAD (PDLB+1	/INIT PUSH-DOWN-LIST
	DCA PDLPT
MAIN2,	READLN		/GET A LINE FROM INPUT.
	  CCHARL-1	/CR LF ; ! / ALT-
	  COPSL-CCHARL	/ MODES ETC...
	JMP MAIN1	/BUFFER WAS EMPTIED.


/ROUTINE TO HANDLE CARRIAGE RETURN.
CRCR,	JMS I ENDCI	/PUT A CR IN BUFFER
	  JMP CRCRC	/ONLY A CR IN BUFFER
	JMS I GWORDI	/GET COMMAND WORD
	  JMP CRCRN	/BUFFER BEGINS WITH A #
	ISZ CRSWT	/WORD ENDED BY A CR?
	JMP CRCR1	/YES, ONLY A FEW ARE OK
	JMS I SORTI	/NO, LOOK UP COMMAND
	  CWORDL-1
	  WOPSL-CWORDL
ERCB,	ERROR		/NOT A LEGAL COMMAND
/
CRCR1,	JMS I SORTI	/"WRITE","REWIND","EXIT" & "COMMENT"
	  CWORL2-1
	  WOPSLL-CWORL2
ERCA,	ERROR		/SOMETHING NOT LEGAL
/
CRCRN,	JMS CLOSE	/CLOSE THE OPEN LOCATION IF OPEN
CRCRC,	DCA SHUT	/ MARK LOCATION CLOSED
	JMP MAIN1

/ROUTINE TO HANDLE SLASH
SLASH,	JMS I ENDCI	/END BUFFER WITH A CR
	  JMP SLA1	/OPEN LAST, CR ONLY
	JMS WCHEK	/DOES LINE START W. A WORD?
	JMS I LIMITI	/NO, GET ARG--
	  SBLK		/ & SLOCH & SLOCL
SLA1,	SPACE1		/OUTPUT SPACE
SLO1,	JMS ODTOUT	/GET THE WORD & OUTPUT
SLO2,	SPACE1		/FOLLOWED BY 2 SPACES
	SPACE1		/(FOR ";"--OUTPUT ONLY 1 SPACE AND
	JMS I ODGETI	/ THEN FORCE ACTION & IGNORE VALUE)
	STA
	JMP CRCRC	/GO MARK LOCATION OPEN

/ROUTINE TO HANDLE ALT MODE & ESCAPE KEYS
ALTMOD,	TAD OUTPNT	/USE OUTPUT ROUTINE 'SET' BY
	JMP ALTM1	/ 'FORMAT' OPTION.

/ROUTINE TO CLOSE A LOCATION, OUTPUT ITS (NEW) CONTENTS IN A
/  SPECIFIED FORMAT AND THEN RE-OPEN.  THE ROUTINE HANDLES:
/  # (BCD), $ (OS/8 ASCII), % (BYTE OCTAL), & (XS240 ASCII),
/  : (SIGNED DECIMAL), < (OCTAL), = (UNSIGNED DECIMAL),
/  > (PDP SYMBOLIC), @ (DATE), [ (ASCII), \ (FPP SYMBOLIC),
/  ] (PACKED ASCII) AND ? (DIRECTORY).
/
OMODES,	TAD SCANX1	/'SORTJ' POINTER TO CHAR LIST
	TAD (OTABLE-1-CCHARL
	DCA DPNT	/POINT INTO ADDR TABLE,
	TADIDP		/ GET OUTPUT ROUTINE ADDR,
ALTM1,	DCA OMODPT	/ & SET POINTER TO ROUTINE.
	JMS ECLOSE	/CLOSE THIS LOCATION
	SPACE1		/OUTPUT SPACE
	DCA CHARSW	/RESET UNPACK SWITCH
	JMS I ODGETI	/GET WORD
	JMS I OMODPT	/OUTPUT IN DESIRED FORMAT
	JMP SLO2	/AND GO REOPEN.
OMODPT,	0

/ROUTINE TO HANDLE BACKARROW.
BACKAR,	JMS ECLOSE	/CLOSE THIS LOCATION
	TADICAD		/GET THE CONTENTS,
	JMP UPARR1	/AND USE THEM AS THE ADDR

/ROUTINE TO HANDLE UPARROW.
UPARR,	JMS ECLOSE	/CLOSE THIS LOCATION
	TADICAD		/IS THIS A 'PAGE 0' REF.?
	AND N200
	SZA CLA
	TAD SLOCL	/YES, USE PAGE BITS
	AND M200	/ MASK PAGE OR 0 TO PAGE #
	DCA SLOCL	/ & SAVE IT
	TADICAD		/GET THE CONTENTS,
	AND N177	/AND USE THE ADDRESS BITS.
	TAD SLOCL	/ ALONG WITH PAGE BITS
UPARR1,	DCA SLOCL	/THIS IS 12 BIT ADDR
	JMP EXCL2	/NOW GO FINISH
/ROUTINE TO HANDLE SEMICOLON, LINE FEED & EXCLAMATION.

SEMIC,	DCA I TYPEI	/SET NO-OUTPUT SWITCH-V7B
LFLF,	STA		/LINE-FEED - CLOSE,INCREMENT,OUTPUT
EXCL,	DCA OMODPT	/EXCLAMATION - CLOSE,DECREMENT,OUTPUT
	JMS ECLOSE	/CLOSE THIS LOCATION
	IAC
	DCA ACC1	/SET UP D.P. INCREMENT
	DCA ACC2
EXCL1,	DCA DPSGN	/(FOR SAFETY)
	ISZ OMODPT	/INCREMENT OR DECREMENT?
	JMS DPNEG	/ DECREMENT, NEGATE VALUE
	CLL
	TAD ACC1
	TAD SLOCL	/UPDATE LOCATION TO 15 BITS
	DCA SLOCL
	RAL
	TAD ACC2
	TAD SLOCH
	AND N7		/ (BUT ONLY 15 BITS)
	DCA SLOCH
	TAD I TYPEI	/ ANY OUTPUT?-V7B
	SNA CLA
	JMP SLO2+1	/  NO, WAS ";" DO ONE SPACE
EXCL2,	JMS I CRLFI	/GIVE CR/LF FOR NEXT LINE
	JMS I BKLOCI	/OUTPUT ADDRESS
	  SBLK-1
	JMS I TWOCI	/OUTPUT "\ "
	  3440
	JMP SLO1	/NOW GO OPEN NEXT LOCATION

/ROUTINE TO HANDLE PLUS & MINUS.
PLUS,	STA		/"+", SET SWITCH
MINUS,	DCA OMODPT	/"-", CLEAR SWITCH
	JMS I ENDCI	/END BUFFER, TEST
	  JMP EXCL2	/NO ARG, DO SAME AGAIN
	JMS WCHEK	/LINE START WITH A COMMAND?
	JMS I ARGI	/NO, GET AN ARG
	JMP EXCL1	/UPDATE LOC & GO OPEN


ECLOSE,	0	/SUB. TO CLOSE THE LOCATION IF ARG.
	JMS I ENDCI	/END BUFFER WITH A CR.
	  JMP I ECLOSE	/ONLY A CR IN BUFFER, DONE
	JMS WCHEK	/DOES LINE START W. A WORD?
	JMS CLOSE	/ARG IN BUFFER, USE IT
	JMP I ECLOSE	/DONE

CLOSE,	0	/SUBROUTINE TO CLOSE A LOCATION
	JMS I ARGI	/GET ONE ARG
	ISZ SHUT	/ANYTHING OPEN?
	JMP I CLOSE	/NO, RETURN
	JMS I ODGETI	/YES, SET UP THINGS RIGHT
	STA
	DCA MODIF	/SET MODIFY FLAG
	TAD ACC1	/USE "LOC" AS DATA
	DCAICAD		/STORE IT
	JMP I CLOSE


PAGE
/ROUTINE TO 'EVALUATE' A SIGNED DOUBLE PRECISION ARITHMETIC
/  EXPRESSION & OUTPUT THE RESULTS IN OCTAL & D.P. SIGNED
/  DECIMAL.
XVAL,	JMS I EVALI	/GO EVALUATE
	SKP		/TERMINATED BY A CR
ERCC,	ERROR		/ SORRY!--TOO MANY ")"S
	JMS I TWOCI	/"= "
	  7540
	TAD ACC2
	JMS I OCTI	/OUTPUT HIGH ORDER IN OCTAL
	TAD ACC1
	JMS I OCTI	/OUTPUT LOW ORDER IN OCTAL
	TAD ACCX1	/SAVE REMAINDER FOR LATER
	DCA COMIR
	TAD ACCX2
	DCA COMOUT
	TAD (-7
	DCA XERROR	/MUST DEVELOP 7 DIGITS
	JMS I TWOCI	/OUTPUT " ("
	  4050
	TAD ACC2	/IS DPAC NEG?
	SMA CLA
	JMP DLOOP1-1	/NO, OUTPUT " "
	JMS DPNEG	/YES, MAKE IT POSITIVE
	TAD N15		/ AND OUTPUT "-".
	SPACE1
DLOOP1,	TAD (12		/RESET DIVISOR TO 10(10)
	DCA OPER1
	DCA OPER2
	JMS DDIV	/GO DIVIDE DPAC BY 10(10)
	TAD ACCX1	/ GET REMAINDER
	PUSH		/PUT IT ON PUSH-DOWN-LIST
	ISZ XERROR	/DONE YET?
	JMP DLOOP1
	TAD COMOUT	/YES, RESTORE REMAINDER
	DCA ACCX2
	TAD COMIR
	DCA ACCX1
	TAD (-7
	DCA XERROR	/NOW SET UP TO OUTPUT 7 DIGITS
DLOOP2,	POP		/ IN REVERSE ORDER!
	DIGIT		/MAKE REMAIN A DIGIT
	ISZ XERROR	/DONE?
	JMP DLOOP2
	JMS I TYPECI	/YES, OUTPUT ")"
	  ")
	JMP I RECRLF	/ AND CR/LF


/ERROR ROUTINE
XERROR,	0
	CLA		/CLEAR POSSIBLE JUNK FROM AC
	DCA DSWIT	/RESET IN CASE DUMP MODE
	CDF 0
	JMS I TYPECI	/OUTPUT "?"
	  "?
	TAD (ERLIST-1	/INIT LIST POINTER
	DCA DPNT
	DCA TEMP	/SET CODE TO 0
XERR1,	ISZ TEMP	/BUMP ERROR CODE
	TADIDP		/GET AN ADDRESS
	SNA
	JMP XERR2	/(FOR DEBUGGING)
	CMA		/= -(ADDR+1)
	TAD XERROR	/DOES IT MATCH THE CALL?
	SZA CLA
	JMP XERR1	/NO
XERR2,	TAD TEMP	/YES, OUTPUT ERROR CODE
	JMS I DEC2I	/  AS 2 DECIMAL DIGITS
	JMS I TYPSI	/NOW OUTPUT " AT "
	  MS17
	TAD (-COMB+1	/CALCULATE POSITION IN
	TAD COMOUT	/ COMMAND BUFFER,
	JMS I DEC2I	/ & OUTPUT AS 2 DIGITS.
	TAD ERMODE	/LONG/SHORT MESSAGES? [NOTE: THIS ->
XERR3,	SZA CLA		/ "7600" (A CLA) IF 'USROUT' ERROR!]
	JMP XERR4	/SHORT, GO DO CR/LF
	JMS USROUT	/LONG, BE SURE MESSAGES ARE IN
	SPACE2		/OUTPUT 2 SPACES
	TAD TEMP	/CODE = ADDRESS-1 OF ADDRESS
	DCA DPNT	/ OF MESSAGE
	TADIDP		/GET MESSAGE ADDR
	JMS I TYPSTI	/ OUTPUT MESSAGE
XERR4,	JMS I CRLFI	/OUTPUT A CR,LF PAIR
	JMP I .+1	/***	CIF BAT		/BATCH OPER.
	  MAIN1		/***	JMP I N7000	/'BATABT'!


USEUSR,	0	/USR CALLER SUBROUTINE (FROM EITHER FIELD!)
	DCA USRSAV	/SAVE CONTENTS OF AC
	RDF
	TAD UCDF0	/SET UP RETURN FIELD (FOR 2ND USR CALL)
	DCA USRCDF
UCDF0,	CDF 0		/SET TO HERE FOR 1ST CALL
	TAD USRAD	/IS USR IN OR OUT?
	SMA SZA CLA
	JMP USRIN	/IN, GO TO IT
	CIF 10
	JMS I M100	/OUT, DO "USRIN" FUNCTION
	  10
	TAD N200
	DCA USRAD	/ & SO INDICATE
USRIN,	CDF CIF 10
	TAD USEUSR	/MOVE RETURN ADDRESS TO THE
	DCA I N200	/ USR ENTRY POINT
USRCDF,	CDF		/SET UP D.F. FOR RETURN
	TAD USRSAV	/RESTORE AC CONTENTS
	JMP I (201	/ & FAKE A CALL TO IT
USRSAV,

USROUT,	0	/SUBROUTINE TO REMOVE USR BY RECALLING
ERC15,	TAD USRAD	/ ERROR MESSAGES FROM SCRATCH
	SPA CLA		/ BLOCKS ON SYS.
	JMP I USROUT	/JUST EXIT IF PRESENT...
	TAD M100
	DCA USRAD	/SET USR TO "OUT"
	JMS I (7607	/READ IN THE MESSAGES
	  610		/ 6 PAGES TO FIELD 1
	  0		/ STARTING AT LOC 10000
	  27		/ FROM SCRATCH BLKS
	  SKP CLA	/!!! ERROR !!!
	JMP I USROUT	/OK, JUST EXIT
	TAD M200
	DCA XERR3	/NO MORE MESSAGES ON ERROR!
	TAD ERC16
	DCA ERC15	/AND NO MORE "SHOW ERROR"!
ERC16,	ERROR		/TELL THE HORRIBLE STORY!


PAGE
/ROUTINE TO EXECUTE THE BLOCK 'SCAN' COMMAND
XSCAN,	JMS I GARGI	/GET ARGS CONVERTED
	TAD (SCANER	/ & SET UP FOR SCANNING
	JMP XDUM0

/ROUTINE TO EXECUTE THE BLOCK 'DUMP' COMMAND
XDUMP,	TAD MODSW	/MAPPED MODE?
	SMA SZA CLA
ERC14,	ERROR		/YES, DUMP IS MEANINGLESS!
	JMS XDLCOM	/DO COMMON STUFF
	TAD (LLIST	/ & SET UP FOR DUMPING
XDUM0,	DCA XGFORM	/SET OUTPUT ROUTINE--DUMP/SCAN
XDUM1,	ISZ DPNT	/SKIP FIRST WORD
	ISZ DPNT	/SKIP A WORD
	TAD I DPNT	/GET NEXT START BLOCK.
	JMS BLKTST
	TAD I DPNT	/GET NEXT -(# BLOCKS)
	DCA TEMP1
XDUM2,	JMS I CTRLI	/TEST HERE FOR 'SCAN' TERMINATE
	DCA LOCL	/SET LOC TO 0
	DCA LOCH
	TAD M400	/SET TO -400(8) [1 BLOCK]
	JMS I XGFORM	/DUMP OR SCAN A BLOCK
	ISZ BLK		/INCREMENT BLOCK NUMBER
	ISZ TEMP1	/DONE?
	JMP XDUM2	/NO, DO NEXT BLOCK
	ISZ TEMP	/YES, ARE ALL ARGS DONE?
	JMP XDUM1	/NO, DO NEXT
	JMP XLIS2	/YES, DONE--RESET SWITCH

/ROUTINE TO EXECUTE THE LOCATION 'LIST' COMMAND
XLIST0,	JMS XDLCOM	/DO COMMON STUFF
XLIS1,	TAD I DPNT	/GET BLOCK #
	JMS BLKTST	/TEST & SET BLK
	TAD I DPNT	/GET & SET LOCATION
	DCA LOCH
	TAD I DPNT
	DCA LOCL
	TAD I DPNT	/GET -(# WORDS)
	JMS LLIST	/NOW GO DO IT
	ISZ TEMP	/ARE ALL ARGS USED?
	JMP XLIS1	/NO, CONTINUE
XLIS2,	DCA DSWIT	/RESET DUMP SWITCH
	JMP I RECRLF	/ DO CR/LF & CONTINUE

/COMMON SUBROUTINE FOR 'XDUMP'&'XLIST0'
XDLCOM,	0
	TAD OUTPNT	/INITIALIZE DEFAULTS
	DCA LISTPT
	TAD OUTSW
	DCA LOUTSW
	JMS XGFORM	/GET FORMAT, IF ANY
	NOP		/RETURN FOR NO FORMAT
	JMS I GARGI	/GET ARGS
	ISZ DSWIT	/SET DUMP SWITCH
	JMP I XDLCOM

/SUBROUTINE TO OUTPUT -[C(AC)] WORDS FROM THE DEVICE
/BEGINNING AT BLK.LOC IN THE SPECIFIED FORMAT
LLIST,	0
	DCA CNTRA	/SET UP -# WORDS TO LIST
	DCA CHARSW	/RESET UNPACK SWITCH
LLIS1,	JMS I CRLFI
	TAD LOCL
	AND N7		/SET UP # ON THIS LINE
	DCA CNTR
	TAD LOUTSW	/IF CHARACTER OUTPUT,
	SNA CLA
	TAD M10		/ DOUBLE # WORDS/LINE
	TAD CNTR
	TAD M10
	DCA CNTR
	JMS I BKLOCI	/OUTPUT LOCATION
	  BLK-1
	JMS I TYPSI	/OUTPUT ":   "
	  MS13
LLIS2,	JMS I GETI	/GET A WORD
	  JMP LLIS3	/FILE MODE, NO SUCH ADDR..
	JMS I LISTPT	/OUTPUT IT
	TAD LOUTSW	/TEST MODE SWITCH
	SPA
	JMP LLIS5	/"SYMBOLIC", CR/LF NOW
	SZA CLA		/CHARACTERS, NO SPACES
	SPACE2		/NUMBERS, TWO SPACES
LLIS3,	JMS I INCI	/INCREMENT LOC
	ISZ CNTRA	/ALL WORDS DONE?
	JMP LLIS4	/NO
	JMS I CRLFI
	JMP I LLIST	/YES, RETURN
/
LLIS4,	ISZ CNTR	/ALL DONE WITH THIS LINE?
	JMP LLIS2	/NOT YET
	JMP LLIS1	/YES, OUTPUT CR/LF & CONTINUE
/
LLIS5,	STA
	DCA CNTR	/FORCE A CR/LF
	JMP LLIS3
LISTPT,	0
LOUTSW,	0


/SUBROUTINE TO GET A FORMAT FOR 'XFORM' & 'XDLCOM'
XGFORM,	0
	JMS I GWORDI	/GET A WORD
	  JMP I XGFORM	/NOT FOLLOWED BY A WORD
	JMS I SORTI	/LOOK UP WORD
	  FORML-1
	  FOPSL-FORML
ERCD,	ERROR		/WORD NOT RECOGNIZED
/
XFSYM,	STL RAR		/"SYMBOLIC"; SWITCH NEG
XFNUM,	IAC		/NUMERIC; SWITCH POS
XFCHR,	DCA LOUTSW	/CHARACTER; SWITCH 0
	TAD SCANX1	/'SORTJ' POINTER TO CHAR
	TAD (-FORML	/CALCULATE FORMAT #
	CLL RAR		/(DIVIDE BY 2)
	DCA TEMP1	/ & SAVE IT.
	TAD TEMP1
	TAD (FTABLE-1
	DCA DPNT
	TADIDP
	DCA LISTPT	/SET UP OUTPUT POINTER
	ISZ XGFORM	/BUMP RETURN ADDRESS
	JMP I XGFORM

/ROUTINE TO 'SET' THE 'FORMAT' OPTION
XFORM,	JMS XGFORM	/GET FORMAT WORD
ERCE,	ERROR		/NUMBER?!  SORRY ABOUT THAT!
	TAD LOUTSW	/OK, SET UP DEFAULTS:
	DCA OUTSW	/  SWITCH,
	TAD LISTPT
	DCA OUTPNT	/  ROUTINE POINTER,
	TAD TEMP1
	DCA FCNT	/  & FORMAT #
	JMP XSETN
OUTSW,	0	/MODE:0=NOTHING,+=SPACES,-=CR/LF


PAGE
/ROUTINE TO EXECUTE THE 'OPEN' COMMAND.
XOPEN,	STA		/"." LEGAL IN FILE NAME
	JMS GNAME	/GET FILE NAME FOR OUTPUT
	CIF 10
	JMP XOPEN1	/NOW GO TO FIELD 1 TO HANDLE


/ROUTINE TO EXECUTE THE 'CLOSE' COMMAND.
XCLOSE,	CDF CIF 10
	JMP XCLOS1	/ALL CODE IS IN FIELD 1


/ROUTINE TO EXECUTE THE 'FILE' COMMAND.
XFIERR,	TAD TEMP1	/MADE ALL POSSIBLE ATTEMPTS
	SMA CLA		/ AT EXTENSION RETRIES?
	JMP XFIOUT	/ YES, ALL TRIES DONE!
	ISZ DPSGN	/THIS WILL SKIP ON 1ST FAIL
	ISZ TEMP1	/THIS WILL SKIP ON 2ND FAIL
	TAD (1404	/ 2ND TRY--USE "LD" EXTEN
	DCA NAM4	/ 3RD TRY--USE NULL EXTEN
	JMP XFICHN+2	/  3RD TRY IS FINAL FAILURE
/
XFIOUT,	JMS PNAME	/OUTPUT FILE NAME &
	JMS I TYPSI	/"LOOKUP FAILED"
	  MS15
/
XFILEN,	JMS I CRLFI	/OUTPUT CR/LF
	ISZ CRSWT	/WAS LAST ENDED BY A CR?
	JMP I RESTAR	/YES, DONE
XFILE,	STA		/"." LEGAL IN FILE NAME
	JMS GNAME	/GET NEXT FILE NAME
XFICHN,	STA
	DCA DPSGN	/SET TRY AGAIN SWITCH
	TAD (NAM1	/INIT POINTER TO NAME
	DCA FSTBLK
	TAD DEVNO	/GET DEVICE #
	CALUSR
	  2		/LOOKUP
FSTBLK,	  0	/NAME PNTR, BECOMES ST BLK
FBKLEN,	  0	/ BECOMES -(FILE LENGTH)
	JMP XFIERR	/LOOKUP FAILED
	TAD FSTBLK
	DCA RBLK1	/SET UP PAGE 0 ST BLK
	CDF 10
	DCA I (CCBB	/ & RESET CCBB
	TAD I (1404	/GET # ADD'L INFO WORDS
	DCA GDEV2	/ (NEGATIVE) & SAVE IT
	TAD GDEV2
	TAD I (17	/POINT TO FIRST OF THEM
	DCA GDEV3	/ (THE DATE, IF PRESENT)
	TAD I N7	/GET THE NUMBER OF THE
	AND N7		/ DIRECTORY SEGMENT IN
	DCA CNTR	/ CORE & SAVE IT.
	TAD GDEV2	/WAS # OF ADD'L WRDS = 0?
	SZA CLA
	TAD I GDEV3	/ NO, GET THE DATE WORD
	CDF 0
	DCA GDEV1	/STORE DATE OR 0 (NO DATE)
	JMS PNAME	/OUTPUT FILE NAME
	TAD FSTBLK
	JMS I OCTI	/OUTPUT ST. BLK. IN OCTAL
	JMS I TYPECI
	  "-
	TAD FBKLEN	/CALCULATE LAST BLK #
	CMA
	TAD FSTBLK
	JMS I OCTI	/ & OUTPUT IN OCTAL
	SPACE2		/OUTPUT 2 SPACES
	TAD FBKLEN
	CIA
	JMS I OCTI	/OUTPUT LENGTH IN OCTAL
	JMS I TWOCI	/" ("
	  4050
	TAD FBKLEN
	CIA
	JMS I DECI	/ & AGAIN IN DECIMAL
	JMS I TYPSI	/")  "
	  MS33
	TAD CNTR	/GET SEGMENT #
	JMS I RTL6I	/ & PUT IN BITS 3-5
	JMS I TWOCI	/ TO OUTPUT IT & "."
	  6056
	TAD GDEV3	/GET ADDR OF 1ST ADD'L WRD
	TAD (-1400-4	/ FOR OFFSET OF NAME START
	JMS OCT3	/OUTPUT LOCATION IN SEG
	SPACE2		/ & TWO SPACES
	TAD GDEV1	/GET DATE WORD
	SZA		/IS IT = 0?
	JMS I PDATEI	/NO, OUTPUT DATE
	JMP XFILEN	/NOW OUTPUT CR/LF & CONTINUE


/ROUTINE TO 'SET' THE 'DEVICE' OPTION
XDEV,	JMS GDEVICE	/GET & FETCH DEVICE HANDLER
	  DEVHAN+1	/ (2 PAGE HANDLER IS OK)
	DCA DEVAD	/SET UP HANDLER ADDRESS
	TAD GDEV2	/SAVE DEVICE #
	DCA DEVNO
	DCA RBLK1	/ & NO FILE KNOWN
	DCA SHUT	/ & NOTHING OPENED
	DCA MODIF	/ & NOTHING MODIFIED
	TAD NAM1
	CIF 10
	JMP XDEVM	/GO FINISH SETUP IN FIELD 1


/ROUTINE TO 'SET' THE 'DDEV' OPTION
XDDEV,	JMS GDEVICE	/GET & FETCH DEVICE HANDLER
	  DMPHAN+1	/ (2 PAGE HANDLER IS OK)
	CIF 10
	JMP XDDEV1	/GO TO FIELD 1 TO FINISH SETUP

GDEVICE,0	/SUBROUTINE TO GET DEVICE NAME & FETCH HANDLER
	JMS GNAME	/GET DEV NAME ("." ILLEGAL)
	TAD NAM1	/MOVE NAME TO CALL
	DCA GDEV1
	TAD NAM2
	DCA GDEV2
	TAD I GDEVICE	/GET HANDLER SPACE ADDRESS
	ISZ GDEVICE
	DCA GDEV3
	CALUSR
	  1		/FETCH HANDLER
GDEV1,	  0
GDEV2,	  0
GDEV3,	  0
ERCY,	ERROR		/NO SUCH HANDLER
	TAD GDEV3	/RETURN HANDLER ADDRESS
	JMP I GDEVICE


PAGE
/ROUTINE TO EXECUTE THE 'SHOW' COMMAND
XSHBLK,	JMS I TYPSI	/"BLOCK = "
	  MS32
	TAD RBLK1	/OUTPUT BLOCK IN OCTAL
XSTYPE,	JMS I OCTI
XSHCR,	JMS I CRLFI	/GIVE A CR & LF
	DCA DSWIT	/BE SURE SWITCH IS RESET
	ISZ CRSWT	/LAST WORD ENDED BY CR?
	JMP I RESTAR	/YES, DONE
XSHOW,	JMS I GWORDI	/GET A WORD
	  JMP ERCG	/NUMBERS NOT RECOGNIZED
	JMS I SORTI	/LOOK IT UP
	  SHOWL-1
	  SHOWOP-SHOWL
ERCG,	ERROR		/NOT FOLLOWED BY LEGAL WORD

XSHVER,	JMS I TYPSI	/"VERSION = <VERSION><PATCH>"
	  MSVER
	JMP XSHCR

XSHMSK,	JMS I TYPSI	/"MASK = "
	  MS02
	TAD MASK
	JMP XSTYPE

XSHOFF,	JMS I TYPSI	/"OFFSET = "
	  MS09
	TAD OFFSET
	CIA
	JMP XSTYPE

XSHFIL,	JMS I TYPSI	/"FILLER = "
	  MS37
	TAD FILLER
	JMP XSTYPE

XSHODL,	JMS I TYPSI	/"ODT  LOC = "
	  MS12
	JMS I BKLOCI	/OUTPUT IT
	  SBLK-1
	JMP XSHBKS

XSHREL,	JMS I TYPSI	/"REL. LOC = "
	  MS20
	JMS I BKLOCI	/ & OUTPUT IT
	  BLK-1
	JMP XSHBKS

XSHABS,	JMS I TYPSI	/"ABS. LOC = "
	  MS03
	TAD CAD		/OUTPUT LOCATION IN BLOCK
	TAD (-IOBUF
	DCA CAD
	JMS I BKLOCI
	  CBLK-1
XSHBKS,	TAD MODIF	/HAS BLOCK BEEN MODIFIED?
	SMA CLA
	JMP XSHCR	/ NO, SAY NOTHING!
	JMS I TYPSI	/  YES, SAY " MOD"
	  MSMOD
	JMP XSHCR

XSHUPP,	JMS I TYPSI	/"UPPER = "
	  MS04
	JMS I BKLOCI	/OUTPUT IN BLOCK.LOC FORM
	  UBLK-1
	JMP XSHCR

XSHLOW,	JMS I TYPSI	/"LOWER = "
	  MS05
	JMS I BKLOCI
	  LBLK-1
	JMP XSHCR

XSHFMT,	JMS I TYPSI	/"FORMAT = "
	  MS06
	TAD FCNT
	TAD (FMTLS-1	/SET UP FOR CORRECT TITLE
XSHFM,	DCA DPNT
	TADIDP		/GET MESSAGE ADDRESS
	JMS I TYPSTI	/OUTPUT DESCRIPTOR
	JMP XSHCR

XSHMOD,	JMS I TYPSI	/"MODE = "
	  MS10
	TAD MODSW	/GET CORRECT MESSAGE
	TAD (MODELS-1	/(OFFSET INTO TABLE)
	JMP XSHFM	/GET ADDRESS & OUTPUT

XSHOUT,	JMS I TYPSI	/"OUTPUT = "
	  MS30
	TAD TYPSW	/SET UP MESSAGE ADDRESS
	TAD (OUTLS-1	/(OFFSET INTO TABLE)
	JMP XSHFM

XSHSMS,	JMS I TYPSI	/"SMASK = "
	  MS07
	TAD SMASKL
	DCA TEMP	/-# TO OUTPUT
	TAD MASKBS
	DCA DPNT	/SET UP TO OUTPUT
	TAD M10		/SET LINE LENGTH
	DCA TEMP1
	JMP XSHSM2
XSHSM1,	JMS I TWOCI	/OUTPUT ", "
	  5440
	ISZ TEMP1	/ENOUGH ON THIS LINE?
	JMP XSHSM2	/NO, OK
	JMS I CRLFI	/YES, OUTPUT CR-LF
	SPACE2		/ & 2 SPACES
	STA		/MAKE LINE 1 LONGER
	JMP XSHSM1-3	/AND RESET LENGTH
/
XSHSM2,	TADIDP		/GET NEXT VALUE
	JMS I OCTI	/ & OUTPUT IT
	ISZ TEMP	/ENOUGH?
	JMP XSHSM1
	JMP XSHCR	/OK, GET NEXT WORD

XSHDEV,	JMS I TYPSI	/"DEVICE = XXXX"
	  MSDEV
	JMS I TWOCI	/NOW OUTPUT " ("
	  4050
	TAD DEVNO	/GET THE DEVICE #
	JMS I DEC2I	/ & OUTPUT AS 2 DIGITS
	JMS I TYPECI	/FINALLY OUTPUT ")"
	  ")
	JMP XSHCR

XSHDDEV,JMS I TYPSI	/"DDEV = XXXX"
	  MSDDEV
	JMP XSHCR


FPRNT,	0	/PRINT FIELD DIGIT FROM BITS 6-8
	JMS I (FPRNTX	/FIRST PRINT BANK BITS
	RTR		/MOVE TO BITS 9-11
	RAR
	AND N7		/MASK TO 1 DIGIT
	DIGIT		/ & OUTPUT IN ASCII
	JMP I FPRNT


PAGE
/CONTINUATION OF 'SHOW' COMMAND

/SHOW 'CCB' HANDLER
XSHCCB,	CDF CIF 10
	JMS GCCB	/SET UP CCB FOR FILE
	DCA DPSGN	/ & SET UP SEGMENTS
	JMS I TYPSI	/"CCB:"
	  MS11
	JMS CCHDST	/DO SETUP, OUTPUT START
	JMS I TYPSI	/", JSW = "
	  MS19
	JMS NXTOCT	/OUTPUT J.S.W. IN OCTAL
	JMS I CRLFI
	JMS I TYPSI	/"  CORE SEGS:   "
	  MS14
XSHCC1,	TAD (-4
	DCA CNTR	/-#/LINE
XSHCC2,	TADIDP		/GET ORIGIN WORD
	DCA TEMP1
	TADIDP		/ & COUNT WORD
	DCA TEMP2
/	TAD TEMP2	/GO OUTPUT START FIELD
/	JMS FPRNT
	JMS I (ADFLD	/ADJUST BANK AND FIELD FOR 128K
	TAD TEMP1	/ & START ADDR
	JMS I OCTI
	JMS I TYPECI	/ & A "-"
	  "-
/	TAD TEMP2	/OUTPUT FIELD AGAIN
/	JMS FPRNT
	JMS I (ADFLD	/ADJUST BANK AND FIELD (128K)
	TAD TEMP2	/ PAGE COUNT -> PAGES
	CLL RAL
	AND M200	/MASK OFF FIELD DATA
	TAD TEMP1	/ADD ORIGIN ADDR
	TAD M1		/ & SUBTRACT 1 FOR END
	JMS I OCTI	/OUTPUT END ADDR IN OCTAL
	ISZ DPSGN	/DONE?
	JMP XSHCC4	/NO
	TAD OVLFLG	/YES, OVERLAYS? (LINK OUTPUT)
	SNA
	JMP XSHCR	/ NO, DONE
	DCA DPNT	/ YES, RESET POINTER
	JMP XSHHD1	/  & CONTINUE
/
XSHCC4,	JMS I TWOCI	/OUTPUT SEPARATOR
	  5440
	ISZ CNTR	/DONE ON THIS LINE?
	JMP XSHCC2	/NO
	JMS I CRLFI	/YES
	SPACE2		/ADD 2 SPACES
	STA		/AND 1 MORE ITEM PER LINE
	JMP XSHCC1

/SHOW 'HEADER' HANDLER
XSHHDR,	CDF CIF 10
	JMS GHDR	/SET UP HEADER FOR MODULE
	JMS I TYPSI	/"HEADER:"
	  MS38
	JMS CCHDST	/DO SETUP, OUTPUT START
	JMS I TYPSI	/", NEXT WORD = "
	  MS39
	TADIDP		/GET FIELD DIGIT
	DIGIT		/ & OUTPUT
	JMS NXTOCT	/FOLLOWED BY ADDRESS
	JMS I TYPSI	/", LOAD VER = "
	  MS40
	JMS NXTOCT	/ & OUTPUT VERSION
	TADIDP		/GET E.P. FLAG
	SNA CLA
	JMP XSHHD1	/ NO E.P.
	JMS I TYPSI	/", EP REQ'D"
	  MS41
XSHHD1,	JMS I CRLFI	/TO THE NEXT LINE
	JMS I TYPSI	/"  OVLYS START...
	  MS42
XSHHD2,	TADIDP		/GET NUMBER OF OVERLAYS
	SNA		/ FOR THIS LEVEL
	JMP XSHCR	/ 0 = END, DONE
	DCA TEMP1	/SAVE IT
	JMS I CRLFI	/OUTPUT A CR/LF
	SPACE2		/ AND 4 SPACES
	SPACE2
	TAD TEMP1
	JMS I DEC2I	/# OVLYS IN DECIMAL
	SPACE2
	TADIDP		/GET MEMORY START WORD
	DCA TEMP2
	TAD TEMP2
	JMS FPRNT	/OUTPUT START FIELD
	TAD TEMP2
	AND M400	/ & DOUBLE-PAGE
	JMS I OCTI
	SPACE2
	JMS NXTOCT	/OUTPUT RELATIVE BLOCK
	SPACE2
	JMS NXTOCT	/OUTPUT OVERLAY LENGTH
	JMP XSHHD2	/AND DO ANOTHER ROUND!

/SHOW 'ERRORS' HANDLER
XSHERR,	JMS USROUT	/BE SURE MESSAGES ARE IN
	ISZ DSWIT	/SET DUMP SWITCH
	JMS I TYPSI	/"ERRORS:  FUTIL VERSION ..."
	  MSERR
	JMS I CRLFI
	CLA IAC
	DCA DPNT	/SET POINTER & CODE
XSHER1,	JMS I CRLFI	/DO ANOTHER CR/LF
	TAD DPNT	/TEST FOR LAST REAL MESSAGE
	TAD (-EMSEND	/(NOT DEBUG MESSAGE!)
	SNA CLA
	JMP XSHCR
	TAD DPNT	/OUTPUT ERROR CODE
	JMS I DEC2I	/ AS 2 DIGITS
	JMS I TYPSI	/THEN " =  "
	  MS01
	TADIDP		/GET ADDR OF MESSAGE AND
	JMS I TYPSTI	/ OUTPUT IT
	JMP XSHER1


CCHDST,	0
	JMS I CRLFI
	JMS I TYPSI	/"  SA = "
	  MS18
	TAD (CCBB
	DCA DPNT	/SET UP POINTER TO DATA
	TADIDP		/GET 2ND WORD FROM CCB/HDR
	JMS FPRNT	/IT HAS START FIELD SO OUTPUT
	JMS NXTOCT	/ FOLLOWED BY START ADDR
	JMP I CCHDST


PAGE
/ROUTINE TO EXECUTE THE 'SET' COMMAND
XSETN,	ISZ CRSWT	/WAS LAST INFO ENDED BY CR?
	JMP I RESTAR	/YES, DONE
XSET,	JMS I GWORDI	/GET OPTION WORD
	  JMP XSET1	/NO NUMBERS PLEASE!
	ISZ CRSWT	/WAS WORD ENDED BY A CR?
ERCK,	ERROR		/YES, ILLEGAL HERE
	JMS I SORTI	/LOOK UP WORD
	  SETLST-1
	  SETJMP-SETLST
XSET1,	ERROR		/WHAT???


/ROUTINE TO 'SET' THE 'DMODE' (DUMP MODE)
XDMODE,	JMS I GWORDI	/GET A WORD
	  JMP ERC11	/NO NUMBERS HERE!
	JMS I SORTI	/LOOK IT UP
	  XDMLST-1
	  XDMOPS-XDMLST
ERC11,	ERROR		/NO LIKEE!!
/
	CLL STA RAR	/4000: 'ALL' (ECHO TO TTY & FILE)
XDMODS,	IAC		/   1: 'PART' (ONLY DUMP,LIST,ETC)
	DCA DMODE	/   0: 'NONE' (TTY ONLY)
	JMP XSETN


/ROUTINE TO 'SET' THE 'OUTPUT' OPTION
XOUTS,	JMS I GWORDI	/GET OPTION WORD
	  JMP ERCL	/ # IN THE BUFFER
	JMS I SORTI	/LOOK IT UP
	  XOLST-1
	  XOOPS-XOLST
ERCL,	ERROR		/NOT FOLLOWED BY LEGAL WORD
/
	CLL STA RAL	/-1: 'FPP' (SYMBOLIC)
XOUTS1,	IAC		/+1: 'PDP' (SYMBOLIC)
	DCA TYPSW	/ 0: 'OCTAL'
	JMP XSETN


/ROUTINE TO 'SET' THE 'MASK' OPTION
XMASK,	JMS I ARGI	/GET ONE ARG
	TAD ACC1	/GET 'LOC'
	DCA MASK	/ & SET MASK
	JMP XSETN


/ROUTINE TO 'SET' THE 'OFFSET' OPTION
XOFFS,	JMS I ARGI	/GET ONE ARG
	TAD ACC1	/GET #
	CIA
	DCA OFFSET	/SET IT
	JMP XSETN


/ROUTINE TO 'SET' THE 'ERROR' (MODE) OPTION
XEMODE,	JMS I GWORDI	/GET WORD
	  JMP ERCZ	/NO NUMBERS ALLOWED!!!
	JMS I SORTI	/LOOK IT UP
	  XELST-1
	  XEOPS-XELST
ERCZ,	ERROR		/ILLEGAL SOMETHING
/
XEMOD1,	IAC		/'SHORT'
	DCA ERMODE	/'LONG'
	JMP XSETN


/ROUTINE TO 'SET' THE 'UPPER' LIMITS OPTION
XUPP,	JMS I LIMITI	/UPPER, GET ARGS
	  UBLK
	JMP XSETN

/ROUTINE TO 'SET' THE 'LOWER' LIMITS OPTION
XLOW,	JMS I LIMITI	/LOWER, GET ARGS
	  LBLK
	JMP XSETN

/ROUTINE TO 'SET' THE 'MODE' OPTION
XMODE,	JMS I GWORDI	/GET OPTION WORD
	  JMP ERCJ	/NUMBER IN BUFFER, BAIL OUT
	JMS I SORTI	/LOOK IT UP
	  MODLST-1
	  MODOPS-MODLST
ERCJ,	ERROR		/NOT RECOGNIZED
/
	CLL STA RTL	/-1: OFFSET
XMODS,	IAC		/+2: LOAD (MODULE)
	IAC		/+1: SAVE (FILE)
	DCA MODSW	/ 0: NORMAL
	JMP XSETN

/ROUTINE TO 'SET' THE 'FILLER' OPTION
XFILL,	JMS I ARGI	/GET ONE ARG
	TAD ACC1
	DCA FILLER	/ & SET AS FILLER
	JMP XSETN

/ROUTINE TO 'SET' THE 'TEMP' STORAGE
XTEMP,	JMS I ARGI	/GET THE 24 BIT ARG (EXPRESSION!)
	TAD ACC1	/NOW SAVE THE 24 BITS FOR LATER
	DCA TEMPV1
	TAD ACC2	/GET IT BACK WITH "EVAL T"
	DCA TEMPV2	/ (OR IN AN EXPRESSION)
	JMP XSETN


/ROUTINE TO EXECUTE THE 'IF' COMMAND
XIF,	JMS I EVALI	/EVALUATE THE EXPRESSION
	  SKP		/ TERMIN = CR, OK
	JMP ERCC	/ TOO MANY PARENS
	TAD ACC1	/TEST THE 24-BIT VALUE FOR ZERO
	SNA
	TAD ACC2
	SNA CLA
	JMP I RESTAR	/OK, JUST CONTINUE
XIFSKP,	TAD COMST	/NOT ZERO, BEGIN SKIPPING FOR
	DCA COMIR	/ LINE STARTING WITH "END"
	READLN		/GET A LINE FROM THE INPUT
	  TYPEM-1	/ WITH THESE TERMINATORS
	  IFSKPO-TYPEM
	JMP XIFSKP	/BUFFER EMPTIED
/
XIFCR,	JMS I ENDCI	/CR FOUND, TIDY THINGS UP
	  JMP XIFSKP	/ CR ONLY
	JMS I GWORDI	/GET 1ST WORD ON LINE
	  JMP XIFSKP	/ NO WORD
	TAD (-0516	/IS THE WORD "EN..."?
	SZA CLA
	JMP XIFSKP	/ NO, KEEP LOOKING!
	JMP I RESTAR	/YES! BEGIN EXECUTION AGAIN!


/ROUTINE TO OUTPUT LOCATION THAT SATISFIED ONE
/OF THE SEARCH COMMANDS.  IF ABSSW=0, OUTPUT
/AS RELATIVE LOCATION.
ABKLOC,	0
	TAD ABSSW	/IS IT 0?
	SZA CLA
	JMP ABK2	/NO, OUTPUT AS ABSOLUTE
	JMS I BKLOCI	/OUTPUT LOCATION
	  BLK-1
ABK1,	JMS I TWOCI	/OUTPUT ": "
	  7240
	JMS I TWOT
	JMP I ABKLOC
/
ABK2,	TAD LOCL	/MAKE ABSOLUTE
	AND N377
	DCA CAD
	JMS I BKLOCI	/NOW OUTPUT IT
	  CBLK-1
	JMP ABK1

TWOCS,	0	/OUTPUT 2-CHARACTER ARG
	TAD I TWOCS	/GET ARG
	ISZ TWOCS	/SKIP IT
	JMS I TWOT	/OUTPUT IT
	JMP I TWOCS

NXTOCT,	0
	TADIDP		/GET NEXT WORD FROM BLOCK
	JMS I OCTI	/ & OUTPUT IN OCTAL
	JMP I NXTOCT


PAGE
/ROUTINE TO EXECUTE THE 'WORD' SEARCH COMMAND
XWORD,	JMS SSET	/INITIALIZE SEARCH
	TAD CNOP	/SET UP FOR NORMAL,
	DCA CNOP+1
	TAD M10		/ EQUAL SEARCH
XWOR2,	TAD (SNA CLA	/"UNEQUAL" WORD SEARCH
	DCA XWORC
XWOR1,	JMS I GWORDI	/GET POSSIBLE WORD
	  JMP XWOR3	/NUMBERS IN BUFFER
	ISZ CRSWT	/WAS IT ENDED BY A CR?
ERCI,	ERROR		/YES, VELLY SOLLY!
	JMS I SORTI	/LOOK UP COMMAND: UN, ME,
	  XWORCL-1	/ AB, FR, TO
	  XWOROP-XWORCL
ERCH,	ERROR		/COMMAND NOT RECOGNIZED
/
XWOR7,	TAD XWOR4+1	/"MEMREF", ONLY MEMORY-
	DCA CNOP+1	/ REFERENCE OP-CODES CAN
	JMP XWOR1	/ EVER BE OUTPUT.
/
XWOR3,	JMS I ARGI	/GET AN ARG
	TAD ACC1	/GET THE VALUE
	AND MASK
	CIA
	DCA CNT		/LOOK FOR THIS WORD
	JMS LSETUP	/SET UP COUNT OF WORDS TO DO
XWOR4,	JMS I GETI	/GET A WORD
	  JMP XWOR5	/FILE MODE, NO SUCH ADDRESS
	AND MASK
	TAD CNT
XWORC,	HLT		/WILL BE "SZA CLA" OR "SNA CLA"
	JMP XWOR5	/DID NOT MATCH
	JMS OPRTST	/TEST FOR OP-CODES 6 & 7
CNOP,	NOP		/ 7--OPR
	NOP		/ 6--IOT;"NOP" OR "JMP XWOR5"
	JMS ABKLOC	/DID MATCH, OUTPUT LOC
	JMS I GETI	/GET THAT WORD
	  JMP ERCP	/ OH I HOPE NOT!!!
	JMS I OCTI	/AND OUTPUT IT IN OCTAL
	JMS I CRLFI
XWOR5,	JMS LCHEK	/DONE YET?
	JMP XWOR4	/NO

/SUBROUTINE TO INITIALIZE THE SEARCH COMMANDS
SSET,	0
	DCA ABSSW	/RESET ABSOLUTE SWITCH
	TAD LBLK	/SET UP START BLK & LOC
	DCA BLK
	TAD LLOCH
	DCA LOCH
	TAD LLOCL
	DCA LOCL
	TAD UBLK	/SET UP END BLK & LOC
	DCA EBLK
	TAD ULOCH
	DCA ELOCH
	TAD ULOCL
	DCA ELOCL
	JMP I SSET

/COMMON OPTIONS FOR 'WORD' AND 'STRING' SEARCHES

XWSABS,	STA
	DCA ABSSW	/'ABSOLUTE'--SET SWITCH
	JMP XWSRET
/
XWSFRM,	JMS I LIMITI	/'FROM'--GET LOWER LIMITS
	  BLK
	JMP XWSRET
/
XWSTO,	TAD UBLK	/'TO'--SET UP IF NEEDED
	DCA EBLK
	JMS I LIMITI	/ & GET UPPER LIMITS
	  EBLK
XWSRET,	STA CLL RAL	/= -2, CALCULATE RETURN ADDRESS AS
	TAD I GWORDI	/ LAST CALL TO "GWORD" TO ALLOW
	DCA LCHEK	/ THESE TO BE COMMON TO BOTH
	JMP I LCHEK	/ 'WORD' AND 'STRING' SEARCHES.
EBLK,	0
ELOCH,	0
ELOCL,	0


LSETUP,	0	/SET SEARCH WORD-COUNTERS **** SEE NOTE ****
	DCA ACC1	/INITIALIZE THESE TO 0
	DCA ACC2
	TAD MODSW	/IN A MAPPED MODE?
	SMA SZA CLA
	JMP LSETL	/ YES, IGNORE BLOCK PARTS
	TAD BLK		/ NO, SET UP FOR 24 BIT
	DCA ACC1
	TAD EBLK	/  BLK-EBLK
	DCA OPER1
	DCA OPER2
	JMS DSUB	/DO THE SUBTRACTION
	TAD (400	/NOW SET UP MULTIPLY BY 400
	DCA OPER1
	DCA OPER2
	JMS DMUL	/GIVES: (BLK-EBLK)*400
LSETL,	CLL IAC
	TAD ELOCL
	DCA OPER1	/NOW SET UP ELOC+1
	RAL
	TAD ELOCH
	DCA OPER2
	JMS DSUB	/AND SUBTRACT IT
	TAD LOCL	/NOW ADD LOC TO GIVE:
	DCA OPER1	/ (BLK-EBLK)*400+(LOC-ELOC-1)
	TAD LOCH	/ WHICH IS 24-BIT COUNT OF
	DCA OPER2	/ WORDS TO SEARCH.
	JMS DADD
	TAD ACC2	/IF NOT NEGATIVE, ALREADY TOO
	SMA CLA
	JMP I RECRLF	/ FAR, SO JUST QUIT NOW!
	JMP I LSETUP

/**** NOTE: COUNT LEFT SET UP IN ACC1 & ACC2 ****

LCHEK,	0	/CHECK IF SEARCH RANGE EXHAUSTED
	JMS I INCI	/INCREMENT LOC
	ISZ ACC1	/COUNT WORDS TO DO
	JMP I LCHEK
	ISZ ACC2	/ (24-BIT)
	JMP I LCHEK
	JMP I RECRLF	/DO CR/LF & STOP!


TIDPNT,	0	/"TAD I DPNT" IN FIELD 1
	CDF 10
	TAD I DPNT
	CDF 0
	JMP I TIDPNT


ASCII,	0	/ASCII OUTPUT FORMAT FROM DEVICE
	AND N177	/MAKE CHARS INTO "STANDARD"
	TAD N200	/ FORM: 7 BITS + PARITY ON
	JMS I TYPEI	/ TO CAUSE CORRECT PRINTING
	JMP I ASCII


PAGE
/ROUTINE TO 'REWIND' THE DEVICE
XREWIN,	CDF 10
	TAD USRAD	/RESET DIRECTORY SEGMENT KEY
	SMA CLA
	DCA I N7	/ IN USR IF IT IS IN MEMORY.
	CDF 0
	JMS I DEVAD	/CALL HANDLER
	  0110		/READ, 1 PAGE, FIELD 1
	  PDLB		/DUMMY BUFFER (ZAP P.D.L.)
	  1		/BLK 1
	  JMP RERROR	/READ ERROR!
	JMP I RESTAR

/READ ERROR--TEST TYPE & OUTPUT MESSAGE

RERROR,	SPA CLA		/BIT 0 = 1 IF FATAL
ERC00,	ERROR		/FATAL
ERC01,	ERROR		/NON-FATAL


/ROUTINE TO EXECUTE THE 'STRING' SEARCH COMMAND
XSTRIN,	JMS SSET	/INITIALIZE
	TAD (STJMP-STCDF /RESET MASKING SWITCH
XSTR0,	TAD XREWIN	/ OR SET MASKING SWITCH
	DCA SMSKSW
	JMS I GWORDI	/GET POSSIBLE WORD
	  JMP XSTR1	/NUMBERS ONLY
	ISZ CRSWT	/FOLLOWED BY A CR?
	JMP ERCI	/ YES, KICK OUT*****
	JMS I SORTI	/LOOK UP OPTION: MA,
	  STRLST-1	/ AB, FR, TO
	  STROPS-STRLST
	JMP ERCH	/NO LIKEE!
/
XSTR1,	JMS I GARGI	/GET ARGS - THEN REPACK INTO BUFFER
	TAD TEMP	/ MASKING THEM IF SPECIFIED
	DCA CNTR	/SET UP LENGTH
	TAD TEMPST
	DCA SCANX2	/STORING DONE IN NEG. FORM
	JMP XSTR2+2	/GO SET UP MASK
/
XSTR2,	ISZ TEMP3	/MASK END?
	JMP XSTR3
	TAD MASKBS	/YES, RESET MASK
	DCA SPNT
	TAD SMASKL	/SET UP LENGTH
	DCA TEMP3
XSTR3,	ISZ DPNT	/SKIP 2 EXTRA WORDS
	ISZ DPNT
	TAD I DPNT	/GET A WORD
	JMS STRMSK	/TEST & MASK
	CIA		/NEGATE
	DCA I SCANX2	/STORE
	ISZ DPNT	/BUMP POINTER
	ISZ CNTR	/DONE?
	JMP XSTR2
	JMS LSETUP	/YES, SET UP COUNT OF WORDS
XSTR4,	TAD TEMPST	/SET UP FOR SEARCH:
	DCA DPNT	/  STRING,
	TAD TEMP
	DCA CNTR	/  & STRING LENGTH.
	TAD LOCL
	DCA XLOCL	/SAVE CURRENT LOCATION
	TAD LOCH
	DCA XLOCH
	TAD BLK
	DCA XBLK
	TAD ACC1	/ & COUNT FOR RESET
	DCA OPER1
	TAD ACC2
	DCA OPER2
	JMP XSTR6	/NOW SET UP MASK
/
XSTR5,	JMS LCHEK	/DONE?
	ISZ TEMP3	/NO, AT MASK END?
	JMP XSTR7
XSTR6,	TAD MASKBS	/ YES, RESET MASK
	DCA SPNT
	TAD SMASKL
	DCA TEMP3
XSTR7,	JMS I GETI	/GET NEXT WORD
	  JMP XSTR10	/MAPPED MODE, NO SUCH ADDRESS
	JMS STRMSK	/TEST & MASK
	TAD I DPNT	/COMPARE?
	SZA CLA
	JMP XSTR10	/NO, GO RESET & CONTINUE
	ISZ CNTR	/MATCHED ENOUGH?
	JMP XSTR5	/NOT YET
	JMS XRSET	/YES, RESET LOCATION & COUNT
	TAD TEMP	/AND LENGTH
	DCA CNTR
XSTR8,	TAD M10
	DCA ACCX1	/  -(#/LINE)
	JMS ABKLOC	/OUTPUT THIS LOCATION
XSTR9,	JMS I GETI	/GET A WORD
	  JMP ERCP	/BAD,BAD,BAD!!!
	JMS I OCTI	/AND OUTPUT IN OCTAL
	JMS I INCI	/INCREMENT LOC
	ISZ CNTR	/DONE?
	JMP XSTR11	/NO, CONTINUE
	JMS I CRLFI	/YES, OUTPUT CR/LF
XSTR10,	JMS XRSET	/RESET LOCATION & COUNT
	JMS LCHEK	/DONE?
	JMP XSTR4	/NO, LOC INC'D, TRY NEXT
/
XSTR11,	SPACE2		/OUTPUT "  "
	ISZ ACCX1	/DONE ON THIS LINE?
	JMP XSTR9	/NO, NOT YET
	JMS I CRLFI	/YES
	JMP XSTR8

XRSET,	0	/RESET BLK & LOC FROM XBLK & XLOC
	TAD XLOCL	/LOC
	DCA LOCL
	TAD XLOCH
	DCA LOCH
	TAD XBLK	/BLK
	DCA BLK
	TAD OPER1	/WORDS LEFT TO SEARCH
	DCA ACC1
	TAD OPER2
	DCA ACC2
	JMP I XRSET

STRMSK,	0	/STRING MASKING  *** NEXT WORD MODIFIED ***
SMSKSW,	CDF 10		/"CDF 10" OR "JMP I STRMSK"
	AND I SPNT	/OK, MASK IN FIELD 1
	CDF 0
	JMP I STRMSK
STJMP=	JMP I STRMSK
STCDF=	CDF 10

XBLK,	0
XLOCH,	0
XLOCL,	0


PAGE
/ROUTINE TO EXECUTE THE BLOCK 'WRITE' COMMAND
XWRARG,	JMS I ARGI	/GET ONE ARG
	TAD ACC1	/USE IT AS THE BLOCK
	SKP
XWRITE,	TAD WBLK	/SET BLOCK
	DCA XWBLK
	JMS I DEVAD	/CALL HANDLER
	  4210		/WRITE, 2 PAGES, FIELD 1
	  IOBUF
XWBLK,	  0		/[** COUNTER FOR MODIFY **]
	  JMP WERROR	/WRITE ERROR
	DCA MODIF	/CLEAR SOMETHING-CHANGED FLAG
	JMP I RESTAR

/WRITE ERROR--TEST TYPE & OUTPUT MESSAGE

WERROR,	SPA CLA		/BIT 0 = 1 IF FATAL
ERC02,	ERROR		/FATAL
ERC03,	ERROR		/NON-FATAL


/ROUTINE TO EXECUTE THE 'MODIFY' COMMAND
XMODIF,	JMS I GWORDI	/GET FORMAT WORD IF ONE
	  JMP XMODEF	/NONE, GET DEFAULT
	DCA MODTMP	/SAVE FOR LATER
	ISZ CRSWT	/TERMINATED BY A CR?
	JMP ERCO	/ YES, SAVE USER FROM HIMSELF!
	TAD MODTMP	/TEST FORMAT FOR RECOGNITION
	JMS I SORTI
	  MODIFL-1
	  MODADS-MODIFL
ERCO,	ERROR		/ I THEENK YOU USE BAD WORD!
/
/NO FORMAT DESCRIPTOR GIVEN, USE DEFAULT
XMODEF,	TAD FCNT	/USE CURRENT FORMAT,
	TAD (MODDLS-1	/ WITH A LITTLE DIFFERENCE
	DCA DPNT
	TADIDP		/GET THE ONE TO USE
	DCA MODTMP	/ AND SAVE IT
/
XMOD0,	JMS I GARGI	/OK, NOW GET ARGS
	TAD TEMP	/MOVE COUNT TO A SAFE PLACE
	DCA XWBLK
XMOD1,	TAD I DPNT	/GET BLOCK #
	JMS BLKTST	/TEST & SET BLK
	TAD I DPNT	/GET LOC
	DCA LOCH
	TAD I DPNT
	DCA LOCL
	TAD I DPNT	/GET -(# LOCS)
	DCA CNTR
XMOD2,	TAD COMST	/INIT COMM. BUFF. FOR MODS
	DCA COMIR
	DCA CHARSW	/RESET HALF SWITCH
	JMS I SOCTI	/INITIALIZE INPUT TO OCTAL
	JMS I BKLOCI	/OUTPUT START LOC
	  BLK-1
	JMS I TWOCI	/AND ": "
	  7240
	READLN		/GET A LINE (TEST: RUBOUT, ^U & ^R)
	  TYPEM-1	/IGNORE LF'S
	  MCHARO-TYPEM
	JMP XMOD2	/BUFFER EMPTIED!


/CR TYPED, END
XMODCR,	JMS I ENDCI	/END BUFFER WITH A CR.
	  JMP XMOD2	/ONLY A CR IN BUFFER-RETRY!
	TAD MODTMP	/NOW LOOK UP FORMAT
	JMS I SORTI
	  MODIFL-1
	  MODIFO-MODIFL
ERCP,	ERROR		/ILLEGAL (EXTRA BAD IF HERE)

XMODDN,	ISZ XWBLK	/RETURN HERE, ALL ARGS DONE?
	JMP XMOD1	/NO
	JMP I RESTAR	/YES
MODTMP,	0

XGET,	0	/SUB. TO SET CURRENT LOC & FLAG
	JMS I GETI	/SET LOCATION
ERC07,	  ERROR		/MAPPED MODE, NO SUCH ADDRESS
	STA
	DCA MODIF	/SET FLAG
	JMP I XGET

/NUMERIC FORMATS HERE
XNUM0,	JMS I SORTI	/TEST TERMINATOR
	  GETLST-1-1	/SPACE, COMMA, CR
	  NUMOPS-GETLST+1
	JMP ERCQ	/ILLEGAL TERMIN
/
XNUM1,	JMS I GETNI	/COMMA, SKIP IT
	JMS I SSKIPI	/ SPACE, IGNORE IT
XNUM2,	JMS EXPRIN	/GET NEXT ARG--EXPRESSION
	JMS XGET	/SET UP LOCATION
	TAD ACC1
	DCAICAD		/ & STORE VALUE
	JMS I INCI	/INCREMENT LOCATION
	ISZ CNTR	/ALL MODS DONE?
	JMP XNUM0	/NO, TEST TERMIN
	JMP XMODDN	/YES, TEST NEXT SET
/
XNUM3,	TAD CNTR	/DONE?
	SNA CLA
	JMP XMODDN	/YES
	JMS XGET	/NO, SET UP LOC
	TAD FILLER
	DCAICAD		/AND FILL WITH 'FILLER'
	JMS I INCI	/INCREMENT LOC
	ISZ CNTR	/DONE?
	JMP XNUM3	/NO
	JMP XMODDN	/YES

/ASCII FORMAT HERE
	JMS CGET	/GET A CHAR & CHECK FOR CR
XASC1,	JMS XGET	/SET UP LOC & SET FLAG
	TAD CHAR
	DCAICAD		/STORE THIS CHAR
	JMS I INCI	/INCREMENT LOC
	ISZ CNTR	/MODS DONE?
	JMP XASC1-1	/NO
	JMP XMODDN	/YES

CGET,	0	/GET NEXT CHAR.  IF CR, MODS DONE
	JMS CGTEST	/GET & TEST NEXT
	  JMP XNUM3	/CR, FILL REST WITH 'FILLER'
	JMP I CGET

CGTEST,	0	/SUB. TO GET A CHAR & CHECK FOR CR
	JMS I GETNI	/GET NEXT CHARACTER
	TAD CHAR	/IS IT A CR?
	TAD M215
	SZA CLA
	ISZ CGTEST	/RETURN TO CALL+2 IF NOT
	JMP I CGTEST


DO1SP,	0	/OUTPUT " " + AC
	JMS I TYPECI
	  " 
	JMP I DO1SP	/ANOTHER TUFFIE

DO2SP,	0	/OUTPUT "  " + AC (PACKED ASCII)
	JMS I TWOCI
	  4040
	JMP I DO2SP	/FAST & SWEET!


PAGE
/ROUTINE TO EXECUTE THE 'SMASK' (STRING MASK) COMMAND
XSMASK,	JMS I GARGI	/GET ARGS
	TAD TEMP
	DCA SMASKL	/SAVE -(MASK LENGTH)
	TAD MASKBS	/SET UP TO STORE WORDS
	DCA SPNT
XSMAS1,	ISZ DPNT	/SKIP 2 WORDS
	ISZ DPNT
	TAD I DPNT	/GET & STORE ONE
	CDF 10
	DCA I SPNT
	CDF 0
	ISZ DPNT	/SKIP 1 MORE
	ISZ TEMP	/DONE ?
	JMP XSMAS1	/NO
	JMP I RESTAR


/XS240 PACKED ASCII FORMAT HERE
XXS20,	TAD M240	/SET OFFSET
/PACKED ASCII FORMAT HERE
XPAC0,	DCA PNAME	/CLEAR OFFSET
XPAC1,	TAD M240	/IS CHAR < 240?
	TAD CHAR
	SMA CLA
	JMP XPAC2	/NO, JUST PACK CHAR
	CMA
	JMS PACK	/YES, PACK A FLAG (77) FIRST
XPAC2,	TAD CHAR	/NOW GO PACK CHAR
	TAD PNAME	/(WITH DESIRED OFFSET)
	JMS PACK
	JMS  CGET	/NOW GET & TEST NEXT
	JMP XPAC1	/ OK, CONTINUE

/OS/8 ASCII HERE
XOPS1,	TAD LOCL	/TEST START & COUNT FOR EVEN
	RAR		/(LOW BIT TO LINK &
	CLA		/ CLEAR AC)
	TAD CNTR
	RAR		/(LOW TO LINK, LINK TO AC0)
	SZL SPA CLA	/BOTH L=0 & AC0=0 FOR OK
ERC04,	ERROR		/START OR COUNT NOT EVEN
XOPS2,	TAD CHARSW	/GET SWITCH
	ISZ CHARSW	/ & BUMP IT
	CLL RAR		/ROTATE AC 11 INTO LINK
	SZL SNA CLA	/CHARACTER 3?
	JMP XOPS5	/NO, CHAR 1 OR CHAR 2
	STA
	TAD CAD		/YES, BACK UP POINTER
	DCA CAD
	STA CLL RAL	/ & SET LOOP COUNT TO -2
	DCA CHARSW
XOPS3,	TAD CHAR	/GET REST OF CHAR
	CLL RTL		/4 BITS LEFT
	RTL
	DCA CHAR	/SAVE IT
	TAD CHAR	/NOW MERGE 4 BITS WITH
	AND N7400	/ A PREVIOUS CHAR
	TADICAD
	DCAICAD		/4 BITS OF 3RD + 1ST OR 2ND
	ISZ CAD		/BUMP POINTER
	ISZ CHARSW	/DONE?
	JMP XOPS3
	TAD CNTR	/YES, DONE ALL MODS?
	SNA CLA
	JMP XMODDN	/YES, TEST FOR DONE
XOPS4,	JMS  CGET	/GET & TEST NEXT CHAR
	JMP XOPS2	/OK, DO NEXT
/
XOPS5,	JMS  XGET	/SET UP CURRENT LOC
	TAD CHAR
	DCAICAD		/AND STORE CHARACTER
	JMS I INCI	/INCREMENT LOC
	ISZ CNTR	/BUMP COUNTER FOR LATER
	JMP XOPS4	/ SO IGNORE SKIP NOW
	JMP XOPS4

PACK,	0	/SUB. TO PACK CHARACTERS
	AND N77		/USE ONLY 6 BITS
	ISZ CHARSW	/CHECK HALF
	JMP PACK1
	TADICAD		/RIGHT HALF, ADD TO LEFT
	DCAICAD	
	TAD CNTR	/ALL MODS DONE?
	SZA CLA
	JMP I PACK	/NO
	JMP XMODDN	/YES
/
PACK1,	JMS I RTL6I	/LEFT HALF, ROTATE INTO IT
	DCA CHARSW	/SAVE IT
	JMS  XGET	/SET UP CURRENT LOC
	TAD CHARSW
	DCAICAD		/STORE WORD
	JMS I INCI	/INCREMENT LOC
	ISZ CNTR	/BUMP COUNTER FOR LATER
	NOP		/ SO DON'T SKIP NOW
	STA
	DCA CHARSW	/RESET SWITCH
	JMP I PACK


PNAME,	0	/PRINT A FILE NAME, PADDED W. SPACES
	TAD NAM1
	JMS I TWOT	/ OUTPUT UP TO
	TAD NAM2
	JMS I TWOT	/ 6 CHARACTERS
	TAD NAM3
	JMS I TWOT	/ OF FILE NAME,
	JMS I TYPECI	/ A "."
	  ".
	TAD NAM4	/ & UP TO 2 CHARS
	JMS I TWOT	/ OF EXTENSION.
PNAME1,	SPACE1		/OUTPUT A " "
	TAD NCNT	/11(10) CHARS ON LINE YET?
	TAD (-13
	SPA CLA
	JMP PNAME1	/NO, OUTPUT ANOTHER SPACE
	JMP I PNAME


/SUBROUTINE TO GET A NUMERIC ARGUMENT FROM THE
/  COMMAND BUFFER AND RETURN IT TO THE 3 WORDS
/  POINTED TO BY CALL+1.  THE FIRST WORD (BLOCK
/  NUMBER) IS NOT CHANGED IF NO BLOCK PART WAS
/  GIVEN IN THE COMMAND.

LIMITS,	0
	TAD I LIMITS	/GET ADDRESS OF 3 WORDS
	ISZ LIMITS
	DCA PNAME	/ & SAVE IT
	JMS I ARGI	/GET COMMAND DATA
	TAD TEMP1	/GET BLOCK NUMBER PART
	ISZ TEMP1	/WAS A BLOCK PART SPEC'D?
	DCA I PNAME	/ YES, STORE IT
	CLA		/(CLEAR IN CASE NOT!)
	ISZ PNAME	/BUMP POINTER
	TAD ACC2
	AND N7
	DCA I PNAME	/STORE HIGH 3 BITS
	ISZ PNAME
	TAD ACC1
	DCA I PNAME	/ & LOW 12 BITS OF ADDR.
	JMP I LIMITS


PAGE
/SUBROUTINE TO 'GET' A WORD FROM THE DEVICE.
/
/  THE ACTUAL WORD ON THE DEVICE THAT IS ACCESSED
/  IS DEPENDENT ON THE MODE SWITCH, AS FOLLOWS:
/
/  MODE		ACTION
/
/  0 = NORMAL	THE HIGH 7 BITS OF THE 15 BIT ADDRESS
/		ARE ADDED TO THE SPECIFIED BLOCK #
/		TO GET THE ACTUAL BLOCK & THE LOW 8
/		BITS OF THE 15 BIT ADDR ARE USED TO
/		SPECIFY THE WORD WITHIN THE BLOCK.
/
/ -1 = OFFSET	THE 12 BIT "OFFSET" (WHICH IS NEGATED)
/		IS ADDED TO THE LOW 12 BITS OF THE
/		ADDRESS, AND THEN THE NEW ADDRESS IS
/		HANDLED AS ABOVE.
/		THIS MODE IS USED PRIMARILY WHEN
/		WORKING WITH THE OPERATING SYSTEM
/		WITH OVERLAYS WHOSE REAL START BLOCK
/		AND LOCATION WITHIN A FIELD ARE KNOWN.
/		BY SETTING THE "OFFSET" TO THE START
/		ADDRESS OF THE OVERLAY, ITS REAL
/		ADDRESSES CAN BE USED AND THE PROPER
/		LOCATIONS WILL BE ACCESSED.
/
/ +1 = SAVE	THIS MODE IS USED WITH CORE IMAGE
/		"SAVE" FILES ONLY.  THE FILE'S CCB
/		(CORE CONTROL BLOCK) IS USED TO
/		DETERMINE THE REAL LOCATION ON THE
/		DEVICE OF THE SPECIFIED 15 BIT ADDR-
/		ESS.  THE START BLOCK OF THE FILE
/		IS USED, AND ANY SPECIFIED "BLOCK"
/		PART IS USED TO SPECIFY THE OVERLAY
/		WANTED AT THAT ADDRESS.  FOR FILES
/		WITHOUT OVERLAYS (GENERATED BY THE
/		MONITOR "SAVE" COMMAND), THIS PART
/		MUST BE ZERO (0) OR NO MATCH WILL
/		OCCUR.  FOR FILES WITH OVERLAYS
/		(GENERATED BY THE PROGRAM "LINK"),
/		A LEGAL OVERLAY AT THE SPECIFIED
/		ADDRESS MUST BE SPECIFIED FOR A
/		MATCH TO OCCUR.  THIS MODE CAN ONLY
/		BE USED AFTER A "FILE" COMMAND.
/
/ +2 = LOAD	THIS MODE IS USED WITH OS/8 FORTRAN
/		IV LOAD MODULES.  THE FILE'S HEADER
/		BLOCK IS USED TO DETERMINE THE REAL
/		LOCATION ON THE DEVICE OF THE SPECI-
/		FIED 15 BIT ADDRESS AND THE "BLOCK"
/		PART IS USED TO SPECIFY THE OVERLAY
/		WANTED AT THAT ADDRESS.  THIS MODE CAN
/		ONLY BE USED AFTER A "FILE" COMMAND.


/CALLING SEQUENCE:
/
/	JMS I GETI
/	  RETURN1	/MODE=MAPPED, NO SUCH ADDRESS
/	NORMAL RETURN	/'CAD' SET, DATA IN AC
/SUBROUTINE 'GET'--PART OF THIS PAGE & ALL OF NEXT

GET,	0
	JMS I CTRLI	/GO TEST FOR CONTROL-CHARS
	TAD MODSW	/OK, TEST MODE
	SNA
	JMP GET0	/NORMAL MODE, NO CHANGES
	SMA CLA
	JMP GET4	/SAVE MODE, DO MAPPING
	TAD OFFSET	/OFFSET MODE, ADD IT
GET0,	JMS DBLPGS	/NOW ADD 'DOUBLE PAGES'
	TAD BLK		/ OF LOC TO BLK TO SET
	DCA CBLK	/'CURRENT BLOCK'
GET1,	JMS GETIO	/OUTPUT CURREN (IF NEEDED), GET NEXT
	  JMP RERROR	/  READ ERROR, GO TELL ABOUT IT
	TAD MODSW	/TEST AGAIN FOR OFFSET
	SPA CLA
	TAD OFFSET	/YES, ADD IT AGAIN
	TAD LOCL	/USE 8 ADDRESS BITS FROM LOC
	AND N377
	TAD BUFST	/INTO BUFFER, TO SET
	DCA CAD		/'CURRENT ADDRESS'
	TADICAD		/NOW GET THE WORD
	ISZ GET		/RETURN TO CALL+2 WITH IT
GETX,	JMP I GET	/[EXIT TO CALL+1 FOR MAP FAIL]

GETIO,	0	/DO I/O FOR 'GET' & 'SCANER'
	TAD CBLK	/IS THIS SAME BLOCK AS IS IN
	CIA		/CORE CURRENTLY?
	TAD RBLK
	SNA CLA
	JMP GETIO2	/YES, USE IT.
	ISZ MODIF	/NO, ANY CHANGES IN THIS BLK?
	JMP GETIO1	/NO, DEVICE OK AS IS
	JMS I DEVAD	/CALL DEVICE HANDLER
	  4210		/WRITE, 2 PAGES, FIELD 1
BUFST,	  IOBUF
WBLK,	  0
	  JMP WERROR	/WRITE ERROR
GETIO1,	TAD CBLK	/NOW UPDATE OUTPUT BLOCK
	DCA WBLK
	TAD CBLK	/ AND INPUT BLOCK #
	DCA RBLK
	DCA MODIF	/ AND RESET SWITCH
	TAD CBLK	/SHOW BLOCK NUMBER IN LIGHTS
	MQL		/ (IF THERE ARE ANY!)
	CLA
	JMS I DEVAD	/CALL DEVICE HANDLER
	  0210		/READ, 2 PAGES, FIELD 1
	  IOBUF
RBLK,	  -1	/(NOTHING IN CORE-ILLEGAL BLK #)
	  JMP I GETIO	/READ ERROR
GETIO2,	ISZ GETIO	/OK, DO NORMAL RETURN
	JMP I GETIO


DBLPGS,	0	/CONVERT LOCATION TO DOUBLE-PAGES
	TAD LOCL
	AND M400	/HIGH 4 BITS HERE
	CLL RAL		/BECOME LOW 4 BITS
	TAD LOCH	/FOR A 7 BIT VALUE
	RTL
	RTL
	JMP I DBLPGS


/GET WORD ROUTINE FOR "ODT" COMMANDS

ODGET,	0
	TAD SBLK	/SET UP BLOCK
	DCA BLK
	TAD SLOCH
	DCA LOCH
	TAD SLOCL
	DCA LOCL	/SET UP LOCATION
	JMS I GETI	/NOW GET WORD
ERC05,	  ERROR		/MAPPED MODE, NO SUCH ADDRESS
	JMP I ODGET	/ & RETURN WITH IT


/OUTPUT 12 BIT BLOCK # & 15 BIT ADDRESS IN OCTAL

BKLOC,	0
	TAD I BKLOC	/GET ARGUMENT (ADDR-1)
	ISZ BKLOC
	DCA GETPNT	/ & SET UP A-XR
	TAD I GETPNT	/GET BLOCK PART
	JMS I OCTI	/ & OUTPUT IT
	TAD I GETPNT	/GET FIELD
	AND N7
	JMS I TWOCI	/ & OUTPUT "." & IT
	  5660		/ (".0")
	TAD I GETPNT	/GET ADDRESS
	JMS I OCTI	/ & OUTPUT IT
	JMP I BKLOC


/SUBROUTINE TO GET A COMMAND WORD OR CHARACTER
/FROM THE COMMAND BUFFER.  IF THE BUFFER CONTAINS
/ONLY NUMERIC ITEMS, RETURN TO CALL+1. TERMINATOR
/IS SPACE OR CR
GWORD,	0
	JMS I SSKIPI	/GET NEXT NON-SPACE
	TAD CHAR
	AND N77		/USE THIS CHAR AS LEFT
	JMS I RTL6I	/ 6 BITS.
	DCA CHARSW	/SAVE IT
	JMS I SORTI	/CHECK FOR ^K, ^D, (, ", ',
	  GWLST1-1	/ DIGITS, SPACE & CR
	  GWOPS1-GWLST1
	JMS I GETNI	/NONE, IS NEXT A SPACE
	JMS I SORTI	/ OR A C.R.?
	  GWLST2-1
	  GWOPS2-GWLST2
	TAD CHAR	/NONE, USE AS LOWER 6 BITS
	AND N77
	TAD CHARSW
	DCA CHARSW	/SAVE IT
GWD1,	JMS I GETNI	/LOOK FOR SPACE OR C.R.
	JMS I SORTI
	  GWLST2-1
	  GWOPS2-GWLST2
	JMP GWD1	/NEITHER, KEEP LOOKING
/
GWD2,	STA		/SPACE FOUND, SET SWITCH
GWD3,	DCA CRSWT	/CR FOUND, RESET SWITCH
	TAD CHARSW	/RETURN WITH WORD
	ISZ GWORD	/ TO CALL+2
GWD4,	JMP I GWORD
/EXIT TO CALL+1 IF ANY NUMERIC ITEM FOUND--
/  ^K, ^D, (, ", ', DIGITS


/"DIRECTORY" FORMAT OUTPUT ROUTINE
DIRDMP,	0
	JMS I OCTI	/OUTPUT IN OCTAL FIRST
	SPACE2
	TADICAD
	JMS DIROUT	/ THEN 3 OTHERS
	JMP I DIRDMP

/"?" ODT OUTPUT ROUTINE
DIROUT,	0
	CIA		/ASSUME WAS NEGATIVE
	JMS I DECI	/ & OUTPUT IN DECIMAL
	SPACE2
	TADICAD
	JMS I PDATEI	/OUTPUT AGAIN AS DATE
	SPACE2
	TADICAD
	JMS I TWOT	/OUTPUT LAST TIME AS PACKED ASCII
	JMP I DIROUT


PAGE
/CONTINUATION OF 'GET' -- MAPPING FOR "SAVE" AND "LOAD"
/  MODES DONE HERE.

GET4,	JMS DBLPGS	/GET # DOUBLE-PAGES
	DCA CAD		/ & SAVE IT
	STA
	TAD MODSW	/TEST FOR SAVE OR LOAD MODE
	SZA CLA
	JMP GETL1	/ LOAD MODE
	CDF CIF 10
	JMS GCCB	/SAVE MODE, GET CCB
	DCA SEGCNT	/ & SET UP # SEGMENTS
	TAD RBLK1	/SET UP ACTUAL FIRST BLOCK
	IAC
	DCA CBLK	/ FOR MAPPING.
GETS1,	CDF 10
	TAD I GETPNT	/GET AN ORIGIN WORD
	DCA GETORG
	TAD I GETPNT	/ & A CONTROL WORD.
	CDF 0
	DCA GETCW
	TAD GETCW	/TEST FOR FIELD MATCH
	CLL RTR
	RAR
	AND N7		/(MASK OFF COUNT)
	CIA
	TAD LOCH	/SAME?
	SZA CLA
	JMP GETS2	/NO, TRY NEXT SEGMENT
	TAD LOCL	/YES, NOW TEST ADDRESSES
	AND M200	/(MASK TO PAGE)
	STL CIA
	TAD GETORG	/[ORIG PAGE]-[ADDR PAGE]
	SZA SNL		/ABOVE THE ORIGIN?
	JMP GETS2	/NO, TRY NEXT
	RAR		/OK, DIVIDE BY 2 (WITH SIGN)
	DCA GETORG	/ & SAVE IT.
	TAD GETCW	/BEYOND TOP OF SEGMENT?
	AND M100	/(MASK OFF FIELD AND MAKE)
	SNA
	STL RAR		/ 0 => 40, THEN SUBTRACT
	TAD M100	/ ONE PAGE)
	TAD GETORG
	SPA CLA
	JMP GETS2	/NO, TRY NEXT
	TAD GETORG	/YES, UPDATE CBLK TO RIGHT
	CIA
	JMS UPCBLK	/ ACTUAL BLOCK
	TAD BLK		/MUST BE IN "LVL 0" OR
	SZA CLA
	JMP GETX	/ RETURN AS BAD
	JMP GET1	/NOW GO GET THE DATA
/
GETS2,	CLA
	TAD GETCW	/UPDATE CBLK
	AND M100
	SNA
	STL RAR		/(MAKING 0 => 40)
	TAD (100	/(ROUND UP PAGE COUNT)
	JMS UPCBLK
	ISZ SEGCNT	/ALL SEGMENTS DONE?
	JMP GETS1	/NO, TRY NEXT
	TAD OVLFLG	/YES, OVERLAYS? (LINK OUTPUT)
	SNA
	JMP GETX	/ NO, RETURN TO CALL+1
	TAD (4		/ YES, RESET POINTER
	DCA GETPNT	/ TO SKIP OVER LVL 0
	JMP GETL2	/ & CONTINUE
/
GETL1,	CDF CIF 10
	JMS GHDR	/GET & TEST HEADER
GETL2,	CDF 10
	TAD I GETPNT	/GET NUMBER OF OVERLAYS
	DCA SEGCNT
	TAD I GETPNT	/GET PAGE & FIELD
	DCA GETCW
	TAD I GETPNT	/GET REL BLK NUMBER
	TAD RBLK1	/ + START BLOCK
	DCA CBLK	/ = ABS START BLK, THIS LEVEL
	TAD I GETPNT	/GET LENGTH, THESE OVERLAYS
	CDF 0
	DCA GETORG
	TAD GETCW	/GET DBL-PAGE & FIELD
	SNA
	JMP GETX	/ 0 = THE END!!!
	AND M400	/CONVERT TO DBL-PAGE #
	CLL RTL
	RTL
	TAD GETCW	/ IN BITS 5-11
	RAL
	AND N177
	CIA		/-(DBL-PG # OF OVLY START)
	TAD CAD		/+(DBL-PG # OF DESIRED)
	SPA
	JMP GETL3	/ GONE TOO FAR, MISSED IT!
	DCA GETCW	/= RELATIVE BLOCK NUMBER
	TAD GETCW	/IS THIS WITHIN THIS OVLY?
	CIA
	TAD GETORG
	SPA SNA CLA
	JMP GETL2	/ NO, TRY NEXT OVERLAY
	TAD BLK		/OK, SET UP -(#LVL +1)
	CMA
	DCA UPCBLK	/V7B
	TAD UPCBLK	/V7B-ADDR IS OK, IS THERE A
	TAD SEGCNT	/ LEVEL WANTED?
GETL3,	SPA CLA
	JMP GETX	/ILLEGAL LEVEL; TOO FAR--EXIT
	TAD GETCW	/ALL OK!  ADD RELATIVE BLK
	SKP
GETL4,	TAD GETORG	/ TO (LVLS-1)*LENGTH-V7B
	TAD CBLK
	DCA CBLK	/ TO OVERLAY START BLOCK
	ISZ UPCBLK	/[MULTIPLY BY ADDING]-V7B
	JMP GETL4
	JMP GET1
GETORG,	0
GETCW,	0
SEGCNT,	0

UPCBLK,	0
	JMS I RTR6I	/MOVE COUNT TO BITS 6-11
	CLL RAR		/DIVIDE FOR DOUBLE PAGES
	TAD CBLK	/UPDATE
	DCA CBLK
	JMP I UPCBLK



PAGE
/NUMERIC OUTPUT SUBROUTINES, NO ZERO SUPPRESSION:

OPRT,	0	/4-DIGIT OCTAL
	JMS NUMOUT
	-1000
	-100
	-10
	0
	JMP I OPRT

OCT3,	0	/3-DIGIT OCTAL
	JMS NUMOUT
	-100
	-10
	0
	JMP I OCT3

BPRT,	0	/3-DIGIT BCD
	JMS NUMOUT
	-400
	-20
	0
	JMP I BPRT


SGNDP,	0	/4-DIGIT DECIMAL, SIGNED
	DCA NUMB
	TAD NUMB
	SPA CLA
	TAD N15
	SPACE1		/OUTPUT "-" OR " "
	TAD NUMB	/NOW OUTPUT IN DECIMAL
	SPA
	CIA
	JMS DPRT
	JMP I SGNDP

DECIMAL

DPRT,	0	/4-DIGIT DECIMAL, UNSIGNED
	JMS NUMOUT
	-1000
	-100
	-10
	0
	JMP I DPRT

DEC2,	0	/2-DIGIT DECIMAL, UNSIGNED
	AND N177	/MASK IT FIRST
	JMS NUMOUT
	-10
	0
	JMP I DEC2

OCTAL

NUMOUT,	0	/THE REAL OUTPUT SUBROUTINE
	DCA NUMB	/SAVE THE NUMBER
NUMO1,	DCA NUMDGT	/RESET "DIGIT" TO 0
	CLA CLL
	TAD NUMB	/GET CURRENT VALUE
	TAD I NUMOUT	/SUBTRACT DIGIT BASE
	SNL		/DID IT OVERFLOW?
	JMP NUMO2	/NO, TOO FAR!
	ISZ NUMDGT	/YES, BUMP DIGIT
	DCA NUMB	/ & UPDATE VALUE
	JMP NUMO1+1
/
NUMO2,	CLA CLL
	TAD NUMDGT	/OUTPUT THE "DIGIT"
	DIGIT
	ISZ NUMOUT	/BUMP TO NEXT ARG
	TAD I NUMOUT	/DONE ENOUGH?
	SZA CLA
	JMP NUMO1
	TAD NUMB	/YES, SO OUTPUT THE LAST
	DIGIT		/ ONE.
	JMP I NUMOUT	/AND RETURN
NUMB,	0
NUMDGT,	0

SSKIP,	0	/SKIP SPACES IN COMMAND BUFFER.
	TAD CHAR
	TAD M240	/IS THIS A SPACE?
	SZA CLA
	JMP I SSKIP	/NO, DONE
	JMS I GETNI	/YES, GET NEXT CHAR
	JMP SSKIP+1	/ & GO TRY IT


/OS/8 ASCII OUTPUT SUBROUTINE.  OUTPUTS 1 CHAR
/  FOR EVEN WORD & 2 CHARS FOR ODD WORD.

OSTYPE,	0
	JMS OSSET	/DO SETUP FOR UNPACKING
	JMS I (ASCII	/OUTPUT CHARS TO "STANDARD"
	ISZ CHARSW	/UNPACK 2ND CHARACTER?
	JMP OSUNPK	/ YES, & RETURN TO OSSET CALL!
	JMP I OSTYPE	/DONE, RETURN TO CALLER


/OS/8 "BYTE" OUTPUT SUBROUTINE.  OUTPUT ONE
/  8-BIT OCTAL NUMBER FOR EVEN WORD AND TWO 8-
/  BIT OCTAL NUMBERS FOR ODD WORD.  USED FOR
/  DUMPING OS/8 ".BN" FILES OR ASCII IN OCTAL.

BYTEO,	0
	JMS OSSET	/DO SETUP FOR UNPACKING
	JMS OCT3	/3 DIGIT OCTAL OUTPUT
	ISZ CHARSW	/UNPACK 2ND "CHAR"?
	SKP
	JMP I BYTEO	/ DONE, RETURN
	SPACE2		/YES, BUT OUTPUT 2 SPACES
	JMP OSUNPK	/ BEFORE DOING UNPACKING


/OS/8 FORMAT UNPACKING ROUTINES FOR 'OSTYPE' AND
/  'BYTEO'.  THE SUBROUTINE SETS UP THE COUNTER
/  FOR NUMBER OF OUTPUTS TO DO, SAVING & RESTORING
/  THE AC.  THE ROUTINE WILL BE CALLED ONLY IF 2
/  OUTPUTS BEING DONE AND DOES THE UNPACK OF THE
/  2ND "CHARACTER", RETURNING TO THE CALLER OF THE
/  SUBROUTINE!

OSSET,	0	/ENTER HERE TO INITIALIZE
	DCA INC		/SAVE AC
	IAC
	AND LOCL	/AC = 0 OR 1
	CMA		/AC = -1 OR -2 (-# TO DO)
	DCA CHARSW	/SET UP UNPACK COUNT
OSRETN,	TAD INC		/GET VALUE TO AC
	AND N377	/MASK TO 8 BITS
	JMP I OSSET
/
OSUNPK,	STA	/JUMP HERE IF 2ND CHAR TO GET
	TAD CAD
	DCA SGNDP	/POINT TO HIGH WORD
	CDF 10
	TAD I CAD	/GET LOW BITS OF "CHAR"
	AND N7400	/ MASK TO 4 BITS AND
	JMS I RTR6I	/ MOVE TO BITS 8-11
	RTR
	DCA INC		/SAVING IT HERE FOR LATER!
	TAD I SGNDP	/NOW GET HIGH BITS OF "CHAR"
	AND N7400	/ MASK TO 4 BITS AND
	CDF 0
	CLL RTR		/ MOVE TO BITS 4-7
	RTR
	JMP OSRETN	/GET OTHER BITS & RETURN!


/SUBROUTINE TO INCREMENT THE "CURRENT LOCATION"

INC,	0
	ISZ LOCL	/INCREMENT LOW 12 ADDR BITS
	JMP I INC	/OK AS IS
	CLL
	TAD LOCH	/LOW OVERFLOW, INCR. HIGH
	TAD (7771	/ 3 ADDRESS BITS (& TEST)
	AND N7
	DCA LOCH
	SZL		/DID HIGH OVERFLOW ALSO?
	TAD N200	/ YES, THEN BUMP BLK ALSO
	TAD BLK
	DCA BLK
	JMP I INC


PAGE
/OUTPUT PACKED STRING, ADDRESS IN CALL+1,
/ TERMINATOR IS XX00.
TYPES,	0
	TAD I TYPES
	ISZ TYPES
	JMS TYPSTR
	JMP I TYPES

/OUTPUT PACKED STRING, ADDRESS IN AC, TERMIN IS XX00
TYPSTR,	0
	DCA GETNT
TTAGN,	CDF 10
	TAD I GETNT
	CDF 0
	ISZ GETNT
	JMS PACOUT
	TAD GNAME
	AND N77
	SNA CLA
	JMP I TYPSTR
	JMP TTAGN

/PACKED ASCII OUTPUT ROUTINE
PACOUT,	0
	DCA GNAME
	TAD GNAME	/USE LEFT 6 BITS
	JMS I RTR6I
	JMS ONECHR
	TAD GNAME	/USE RIGHT 6 BITS
	JMS ONECHR
	JMP I PACOUT

/OUTPUT TRIMMED OR UNTRIMMED ASCII IN THE AC
ONECHR,	0	/NO CODE FOR CR/LF
	AND N77
	SNA
	JMP I ONECHR	/IGNORE "@"
	TAD (-40
	SMA
	TAD M100
	JMS I TYPECI
	  340
	JMP I ONECHR


/SUBROUTINE TO MATCH CHAR AGAINST LIST1 AND JUMP
/THROUGH LIST2 WHEN MATCH FOUND.  BOTH LISTS IN
/FIELD 1.

SORTJ,	0
	SNA
	TAD CHAR	/USE CHAR IF AC = 0
	DCA SORTEM	/ITEM TO LOOK UP
	TAD I SORTJ
	ISZ SORTJ	/GET LIST1 ADDRESS
	DCA SCANX1
SORT1,	CDF 10
	TAD I SCANX1	/COMPARE WITH SORTEM
	CDF 0
	SNA		/0 ?
	JMP SORT2	/END OF LIST
	CIA STL
	TAD SORTEM
	SZA CLA		/DOES IT MATCH?
	JMP SORT1	/NO, TRY NEXT
	TAD SCANX1	/YES, GET ADDRESS...
	TAD I SORTJ
	DCA SORTJ	/...OF JUMP ADDRESS
	CDF 10
	TAD I SORTJ
	DCA SORTJ
	CDF 0
	JMP I SORTJ	/GO TO ROUTINE
SORT2,	ISZ SORTJ	/MATCH NOT FOUND,
	JMP I SORTJ	/EXIT TO CALL+3
SORTEM,	0


/SUBROUTINE TO GET A NAME FOR 'XOPEN', 'XFILE', 'XDEV' & 'XDDEV'

GNAME,	0	/GET A FILE OR DEVICE NAME
	DCA TEMP1	/SET UP "." SWITCH AND
	TAD TEMP1	/ FILE/DEVICE SWITCH
	DCA TEMP2
	DCA NAM1
	DCA NAM2	/CLEAR NAME AREA
	DCA NAM3
	TAD (2326	/ & INIT EXTENSION TO "SV"
	DCA NAM4
	TAD (NAM1	/ & INIT POINTER FOR NAME
	DCA TEMP
	JMS I SSKIPI	/SKIP LEADING SPACES
	STA
	TAD COMOUT	/BACK UP THE POINTER
	DCA COMOUT
	JMS GPAIR	/1ST & 2ND CHAR
	JMS GPAIR	/3RD & 4TH
GETSCN,	JMS GPAIR	/5TH & 6TH OR 1ST & 2ND EXT.
	JMS GETNT	/SCAN FOR TERMINATOR
	CLA
	JMP .-2
/
GETCOL,	TAD TEMP2	/":" SEEN, DEVICE OR FILE NAME?
	SZA CLA
	JMP GETNTC	/ FILE, JUST USE THE ":"
	ISZ TEMP2	/ DEVICE, FLAG ":" SEEN
	JMP GETSCN+1	/  AND SCAN TO TERMIN.
/
GETPER,	ISZ TEMP1	/"." FOUND, FIRST ONE?
ERCM,	ERROR		/NO, THE END...
	DCA NAM4	/YES, RESET EXT,
	TAD (NAM4	/ SET POINTER
	DCA TEMP
	JMP GETSCN	/ & GO GET IT
/
GETEND,	STA		/TERM = SPACE, SET SWITCH
	DCA CRSWT	/TERM = CR, RESET SWITCH
	JMP I GNAME	/..DONE....

GETNT,	0	/GET & TEST A CHAR
	JMS I GETNI	/GET NEXT CHAR
	JMS I SORTI	/TEST IT
	  GETLST-1
	  GETOPS-GETLST
GETNTC,	TAD CHAR	/OK, USE CHAR
	AND N77		/MASK TO 6 BITS
	JMP I GETNT	/ & EXIT WITH IT

GPAIR,	0	/GET RIGHT/LEFT-HALF-CHARS
	JMS GETNT
	JMS I RTL6I	/TO LEFT HALF
	DCA I TEMP	/ & STORE IT
	JMS GETNT
	TAD I TEMP	/MERGE WITH LAST LEFT
	DCA I TEMP
	ISZ TEMP	/BUMP POINTER
	JMP I GPAIR

RTL6,	0	/ROTATE AC 6 LEFT
	CLL RTL
	RTL
	RTL
	JMP I RTL6

RTR6,	0	/ROTATE AC 6 RIGHT
	CLL RTR
	RTR
	RTR
	JMP I RTR6


PAGE
/SUBROUTINE TO READ A "LINE" FROM THE USER.  IT CHECKS FOR
/  RUBOUT, ^U AND ^R FIRST, THEN CHECKS FOR ONE OF A LIST OF
/  TERMINATORS PASSED BY THE CALLER.  AS WITH OS/8, RUBOUT
/  DELETES CHARACTES AND ^U DELETES THE CURRENT LINE.  ^R
/  (FOR RETYPE) ECHOES THE CURRENT COMMAND BUFFER IN THE SAME
/  MANNER AS LINE-FEED DOES FOR OS/8.  IF THE CHARACTER IS A
/  TERMINATOR, CONTROL PASSES DIRECTLY TO THE CORRESPONDING
/  CALLER ROUTINE (OUT OF THIS ROUTINE).  INPUT CHARACTERS
/  ARE ALSO TRANSLATED FROM LOWER CASE TO UPPER CASE.  EXIT
/  IN THE NORMAL MANNER OCCURS ONLY ON BUFFER EMPTY FROM
/  RUBOUT OR ^U.

READ,	0	/READ AND ECHO INPUT CHARACTER
	TAD I READ	/GET TWO LIST ADDRESS PARAMETERS
	ISZ READ
	DCA RETERM	/ FROM CALLER AND SET UP IN
	TAD I READ	/ SORT ROUTINE CALL
	ISZ READ
	DCA RETERM+1
RENEXT,	JMS RKEY	/GET A CHAR
	  JMP RUBO	/RUBOUT, GO BEGIN DELETIONS
REKEY,	DCA CHAR
	JMS I SORTI	/CHECK FOR CTRL-R & CTRL-U
	  REACTL-1
	  REACTS-REACTL
	TAD CHAR
	JMS I TYPEI
	JMS I SORTI	/CHECK FOR CALLER TERMINATORS
RETERM,	  0		/ PARAMETERS HERE
	  0
	TAD CHAR	/NONE, JUST STORE IN BUFFER
	SKP
RESPC,	TAD (" 		/FOR CAMMAND INPUT, TAB -> SPACE!
	CDF 10
	DCA I COMIR	/COMMAND (LINE) INPUT BUFFER
	CDF 0
	JMP RENEXT
/
/+++	FOR SCOPE OPERATION, RUBOUTS CAUSE OUTPUT OF THE
/+++	SEQUENCE BACKSPACE, SPACE, BACKSPACE TO CLEAR THE
/+++	PREVIOUS CHARACTER FROM THE SCREEN.  IF "SCOPE
/+++	MODE" IS SET, RUBO IS OVERLAID ON STARTUP.

/***	FOR BATCH OPERATION, RUBOUTS ARE IGNORED BY 'RKEY'
/***	AND 'RUBO' IS OVERLAID WITH CODE TO IGNORE A LINE-
/***	FEED THAT FOLLOWS A CARRIAGE-RETURN.
/
RUBO,	JMS BTEST	/RUBOUT TYPED,TEST FOR EMPTY
	JMP RUBOF	/ INPUT BUFFER EMPTY!
	JMS I TYPECI	/OK, OUTPUT 1ST "\"
	  "\
RUBO1,	JMS BTEST	/NOW EMPTY?
	JMP RUBOE	/ YES, LINE END
	TAD COMIR	/ECHO LAST CHAR IN BUFFER
	DCA ENDC
	CDF 10
	TAD I ENDC
	CDF 0
	JMS I TYPEI
	STA
	TAD COMIR	/NOW BACK UP POINTER
	DCA COMIR
	JMS RKEY	/GET A CHAR
	  JMP RUBO1	/ANOTHER RUBOUT, GO HANDLE
	DCA BTEST	/SAVE THE CHAR
	JMS I TYPECI	/ DO CLOSING "\"
	  "\
	TAD BTEST
	JMP REKEY	/& GO USE NEW CHAR
/
RUBOE,	JMS I TYPECI	/BUFFER WAS EMPTIED,
	  "\		/OUTPUT CLOSING "\"
RUBOF,	JMS I CRLFI	/ & A CR/LF
	JMP I READ
/
RECHO,	JMS I TYPECI	/ECHO "^R" & THEN
	  "R-100
	JMS I CRLFI	/ECHO CURRENT LINE
	TAD COMST	/INIT AUTO-XR
	DCA COMOUT
RECHO1,	TAD COMOUT	/DONE?
	CIA
	TAD COMIR
	SNA CLA
	JMP RENEXT	/YES, MORE INPUT
	JMS I GETNI	/NO, GET NEXT CHAR
	JMS I TYPEI	/ & OUTPUT IT
	JMP RECHO1	/ & CONTINUE
/
RERASE,	JMS I TYPECI	/OUTPUT "^U"
	  "U-100
	JMP RUBOF	/GO OUTPUT CR/LF & EXIT

BTEST,	0	/TEST FOR COMM. BUFFER EMPTY
	TAD COMIR
	CIA
	TAD COMST
	SZA CLA		/EMPTY?
	ISZ BTEST	/NO, STILL OK, TO CALL+2
	JMP I BTEST	/ OTHERWISE TO CALL+1
RKEY,	0	/GET A NON-NULL CHAR, TEST & TRANSLATE
	KSF		/***	JMS I CTRLI	/CHECK KEYBOARD
	JMP .-1		/***	CIF BAT		/BATCH OPER.
	JMS I CTRLI	/***	JMS I BATINI
	KSF		/***	ERROR		/EOF!!
	JMP RKEY+1	/***	NOP	/MUST USE SPECIAL CARE
	KRB		/***	NOP	/ TO HANDLE CTRL-Q!
	AND N177	/MASK OFF PARITY
	SNA
	JMP RKEY+1	/NULL CHAR
	TAD (-177	/IS IT A RUBOUT?
	SNA
RKEY0,	JMP I RKEY	/YES, EXIT TO CALL+1	/*** BATCH
	ISZ RKEY	/NO, EXIT TO CALL+2	/*** OPER.
	TAD (2		/TEST FOR ALT-MODES
	SMA
	JMP RKEY1	/ 375 OR 376
	TAD (35		/IS IT LOWER CASE?
	SMA
	TAD (-40	/YES, MAKE UPPER CASE
	TAD (-35
RKEY1,	TAD (375	/RESTORE CHAR & ADD PARITY
	JMP I RKEY	/ & EXIT WITH IT


/SUBROUTINE TO TERMINATE COMMAND BUFFER WITH A C.R.
/RETURN TO CALL+1 IF ONLY A CR (EXCLUDING LEADING
/SPACES) IN BUFFER, TO CALL+2 IF ANYTHING ELSE.
ENDC,	0
	TAD (215	/PUT A CR IN BUFFER
	CDF 10
	DCA I COMIR
	CDF 0
	TAD COMST	/INIT'L BUFFER UNLOAD
	DCA COMOUT
	TAD CHAR	/SAVE CHAR FOR POSSIBLE
	DCA TEMP	/ USE BY 'WCHEK'
	JMS I GETNI	/GET FIRST CHARACTER
	JMS I SSKIPI	/SKIP LEADING SPACES
	TAD CHAR	/GET 1ST NON-SPACE
	TAD M215	/IS IT A CR?
	SZA CLA		/YES, NOTHING IN BUFFER
	ISZ ENDC	/OTHERWISE RETURN TO CALL+2
	JMP I ENDC


DODIG,	0	/OUTPUT AC AS AN ASCII DIGIT
	JMS I TYPECI
	  "0
	JMP I DODIG


PAGE
/'FPP'/OCTAL/'PDP' OUTPUT ROUTINE FOR ODT
ODTOUT,	0
	TAD TYPSW	/-1, 0, +1
	TAD (TAD ODTOL	/GENERATE ADDRESS OF DESIRED
	DCA ODTOPT	/ OUTPUT ROUTINE
ODTOPT,	HLT		/[USED TWICE!]
	DCA ODTOPT
	JMS I ODGETI	/GET SPECIFIED WORD
	JMS I ODTOPT	/ & OUTPUT IT
	JMP I ODTOUT

	FPPDMP		/-1 = OCTAL + FPP
ODTOL,	OPRT		/ 0 = OCTAL
	PDPDMP		/+1 = OCTAL + PDP


/OCTAL & 'PDP' (SYMBOLIC) DUMP ROUTINE
PDPDMP,	0
	JMS I OCTI	/FIRST OUTPUT IN OCTAL
	SPACE2		/FOLLOWED BY 2 SPACES,
	JMS PDPOUT	/ & THEN AS 'PDP'
	JMP I PDPDMP


/'PDP' (SYMBOLIC) INSTRUCTION DECODING
PDPOUT,	0
	CLA
	JMS OPRTST	/TEST FOR OPR & IOT
	JMP OPRS	/  OPR
	JMS IOPRNT	/  IOT
SYMS,	JMS GETOP	/GET OP-CODE TO BITS 9-11
	RAL		/ * 2
	JMS SYMTYP	/OUTPUT 3 CHAR SYMBOL & SPACE
	  INSLST	/(TABLE FOR INDEXING)
	  -2		/(- # WORDS)
	JMS OPRTST	/TEST FOR OPR & IOT
	JMP SYMEND	/  OPR, DONE
	JMP IOTS	/  IOT
	TADICAD		/MEMORY REF., INDIRECT?
	AND (400
	SNA CLA
	JMP REFS1	/NO
	JMS I TWOCI	/YES, OUTPUT "I "
	  1140
REFS1,	TADICAD		/SET UP ADDR BITS
	AND N177
	DCA BITVAL	/SAVE THEM
	TADICAD		/IS THIS A 'PAGE 0 REF'?
	AND N200
	SZA CLA
	TAD LOCL	/NO, USE PAGE BITS
	AND M200
	TAD BITVAL	/OK, NOW ADD ADDR BITS
REFS2,	JMS I OCTI	/OUTPUT IN OCTAL
SYMEND,	JMP I PDPOUT	/DONE, RETURN

/
IOTS,	TADICAD		/USE ONLY LAST 9 BITS
	AND (777
	JMP REFS2	/AND OUTPUT IN OCTAL
/
OPRS,	TADICAD		/IS THIS A NOP?
	AND (777
	SNA
	JMP SYMS	/YES, OUTPUT "NOP "
	AND N200	/IS THERE A CLA IN IT?
	SNA CLA
	JMP OPRS1	/NO, CONTINUE
	JMS SYMTYP	/YES, OUTPUT "CLA "
	  CLANAM
	  -2
	IAC
OPRS1,	DCA CNT		/SET ANYTHING OUTPUT SWITCH
	TADICAD		/SET UP WORD FOR DECODE
	JMS I RTL6I
	RAR
	DCA BITVAL	/SAVE IT
	TADICAD		/CHECK FOR OPR1, OPR2 OR EAE
	CLL RAR
	AND N200
	SNA
	JMP OPR1A	/OPR1 MICRO-INSTRUCTION
	SNL CLA
	JMP OPR2A	/OPR2 MICRO-INSTRUCTION
/
/DO THE DOCODING FOR THE EAE MICRO-INSTRUCTIONS
EAE,	TAD (EAELST-2	/SET UP EAE LIST POINTER
	DCA BITPNT
	JMS BITS	/SHIFT & CHECK BIT 5
	JMS OPRTYP	/IF = 1, "MQA "
	TAD BITVAL	/CHECK BIT 6
	CLL RAL		/("SCA" IN "A" MODE OF 8/E
	DCA BITVAL	/ 'MODE BIT' IN "B" MODE)
	SZL
	TAD N20		/IF ON, USE OTHER WORDS
	DCA EAETMP
	JMS BITS	/CHECK BIT 7
	JMS OPRTYP	/ "MQL "
	TADICAD	
	AND (16
	TAD EAETMP	/(ADD SWITCH WORD)
	JMS SYMLIM	/CHECK FOR & OUTPUT LAST INST.
	  -36		/UPPER LIMIT
EAETMP,	0
/
/DO THE DECODING FOR THE OPR1 MICRO-INSTRUCTIONS
OPR1A,	TAD (OP1LST-2	/SET OPR1 LIST
	DCA BITPNT
	JMS BITS	/SHIFT & CHECK BIT 5
	JMS OPRTYP	/IF = 1, OUTPUT "CLL "
	JMS BITS	/CHECK BIT 6
	JMS OPRTYP	/ "CMA "
	JMS BITS	/CHECK BIT 7
	JMS OPRTYP	/ "CML "
	ISZ BITPNT	/BUMP POINTER
	ISZ BITPNT
	TADICAD		/LOOK FOR IAC
	RAR
	SZL CLA
	JMS OPRTYP	/OUTPUT "IAC "
	TADICAD		/SET UP TO CHECK FOR ROTATES
	AND (16
	JMS SYMLIM	/CHECK & OUTPUT
	  -12		/UPPER LIMIT


PAGE
/OCTAL & 'FPP' (SYMBOLIC) DUMP ROUTINE
FPPDMP,	0
	JMS I OCTI	/FIRST OUTPUT IN OCTAL
	SPACE2		/ THEN 2 SPACES
	JMS FPPOUT	/ & THEN AS FPP
	JMP I FPPDMP

/THE FOLLOWING ROUTINES ARE USED BY 'PDPOUT'

/DO THE DECODING FOR THE OPR2 MICROINSTRUCTIONS
OPR2A,	TAD (OP2LST-2	/SET UP LIST POINTER
	DCA BITPNT
	JMS BITS	/SHIFT & CHECK BIT 5
	JMS OPR2T	/IF 1, OUTPUT "SMA " OR "SPA "
	JMS BITS	/CHECK BIT 6
	JMS OPR2T	/ "SZA " OR "SNA "
	JMS BITS	/CHECK BIT 7
	JMS OPR2T	/ "SNL " OR "SZL "
	JMS BITS	/CHECK BIT 8
	SKP
	JMP OPR2B	/IT WAS 0
	TADICAD		/MUST CHECK FOR "SKP "
	AND (160
	SNA CLA		/ARE ALL SKIP SENSES = 0?
	JMS OPRTYP	/YES, SO OUTPUT "SKP "
OPR2B,	TAD (OP2LST+14	/SET UP CHECK FOR OSR & HLT
	DCA BITPNT
	JMS BITS	/CHECK BIT 9
	JMS OPRTYP	/ "OSR "
	JMS BITS	/CHECK BIT 10
	JMS OPRTYP	/ "HLT "
	JMP OPEND	/CHECK FOR ANY DONE

SYMLIM,	0	/CHECK LAST SYMBOL AGAINST LIMIT
	DCA CHAR	/SAVE AC
	TAD CHAR
	SPA SNA		/IS IT > 0?
	JMP OPEND	/NO, TEST IF ANY OUTPUT DONE
	TAD I SYMLIM	/IT IS > UPPER LIMIT?
	SMA SZA CLA
	JMP OPEND	/NO, GO CHECK AGAIN
	TAD CHAR	/CALCULATE ADDRESS
	JMS OPRTYP	/ & OUTPUT LAST
	JMP SYMEND	/...DONE
/
OPEND,	CLA
	TAD CNT		/ANYTHING OUTPUT?
	SZA CLA
	JMP SYMEND	/YES, DONE WITH OUTPUT
	JMS SYMTYP	/NO, OUTPUT "OPR "
	  OPRMES
	  -2
	JMP IOTS	/NOW GO OUTPUT LAST 9 BITS

BITS,	0	/DECODE A WORD ONE BIT AT A TIME
	TAD BITVAL	/SHIFT A BIT INTO LINK
	CLL RAL
	DCA BITVAL	/SAVE FOR LATER
	ISZ BITPNT	/BUMP SYMBOL POINTER
	ISZ BITPNT
	SNL
	ISZ BITS	/TO CALL+2 IF L = 0
	JMP I BITS

OPRTYP,	0	/OUTPUT AN OPR SYMBOL
	JMS SYMTYP	/OUTPUT THE SYMBOL
BITPNT,	  0		/ADDRESS
	  -2
	ISZ CNT		/SET SWITCH
	JMP I OPRTYP

SYMTYP,	0	/OUTPUT A SYMBOL
	TAD I SYMTYP	/ADD TABLE ADDR TO ANY INDEX
	ISZ SYMTYP
	DCA SYMPNT	/SAVE POINTER
	TAD I SYMTYP	/GET COUNT OF WORDS
	ISZ SYMTYP
	DCA BITS	/ & SAVE IT
SYMNXT,	CDF 10		/"SYMBOL"S IN FIELD 1
	TAD I SYMPNT
	CDF 0
	JMS I TWOT	/OUTPUT A PAIR OF LETTERS
	ISZ SYMPNT
	ISZ BITS	/DONE?
	JMP SYMNXT
	JMP I SYMTYP
SYMPNT,	0

OPR2T,	0	/OUTPUT AN OPR2 SYMBOL
	TADICAD	
	AND (10		/IF BIT IS ON, REVERSE THE
	JMS OPRTYP	/SENSE OF THE SKIP
	JMP I OPR2T

BITVAL,	0


IOPRNT,	0	/OUTPUT I/O NAMES
	TAD (IOTTAB	/SET UP POINTER
IOPRN1,	DCA IOPNT	/SET (OR UPDATE) POINTER
	CDF 10
	TAD I IOPNT	/GET NEXT IOT
	CDF 0
	SNA		/AT END OF TABLE?
	JMP I IOPRNT	/YES, CODE NOT FOUND
	CIA
	TADICAD		/NO,  DO THEY MATCH?
	SNA CLA
	JMP IOPRN2	/YES, OUTPUT NAME
	TAD (4		/NO, UPDATE POINTER
	TAD IOPNT
	JMP IOPRN1	/ & TRY AGAIN
/
IOPRN2,	IAC		/WORD FOLLOWS CODE
	JMS SYMTYP	/OUTPUT THE MNEMONIC
IOPNT,	  0
	  -3
	JMP SYMEND	/ & RETURN


OPRTST,	0	/TEST "INSTRUCTION" FOR OPR & IOT
	TADICAD		/GET WORD
	AND N7000	/MASK OFF OP CODE
	TAD (1000	/IS IT AN OPR?
	SNA
	JMP I OPRTST	/YES, EXIT TO CALL+1
	ISZ OPRTST
	TAD (1000	/IS IT AN IOT?
	SZA CLA
	ISZ OPRTST	/NO, EXIT TO CALL+3
	JMP I OPRTST	/ YES, TO CALL+2


PAGE
/'FPP' (SYMBOLIC) INSTRUCTION DECODING
FPPOUT,	0
	CLA		/HARD TO TELL WHAT MIGHT COME!
	TADICAD		/GET THE WORD
	AND (600	/MASK OFF MODE BITS
	SNA
	JMP SPECIAL	/ NON-ARITHMETIC
	TAD M400	/GIVES: -=BASE, 0=LONG, +=INDIR.
	DCA TEMP2
	JMS GETOP	/GET OP-CODE TO BITS 9-11
FPLEA,	JMS MULT3	/MULTIPLY BY 3 (WORDS/OP OUT)
	JMS SYMTYP	/OUTPUT 6 CHAR OPR SYMBOL
	  FPPINS	/(INCLUDING "LEA")
	  -3
	TAD TEMP2	/NOW HANDLE MODE
	SNA
	JMP LONG	/ LONG INDEXED
	SMA CLA
	JMP INDIR	/ INDIRECT INDEXED
BASE,	JMS I TYPSI	/ BASE - OUTPUT "  B+"
	  MSBASE
	TADICAD		/GET WORD AGAIN
	AND N177	/ MASK OFF OFFSET
	JMS MULT3	/ MULTIPLY IT BY 3
	JMS OCT3	/ & OUTPUT IN OCTAL
	JMP I FPPOUT
/
INDIR,	JMS I TYPSI	/OUTPUT "% B+"
	  MSINDI
	TADICAD		/GET WORD AGAIN
	AND N7		/ MASK OFF OFFSET
	JMS MULT3	/ MULTIPLY IT BY 3
	JMS OCT3	/ & OUTPUT IT IN OCTAL
	JMP XRPLUS	/FINALLY DO XR OUTPUT
/
LONG,	JMS I TWOCI	/OUTPUT "# "
	  4340
	JMS FLDOUT	/AND FIELD AND "*"
XRPLUS,	JMS GET678	/GET XR FIELD
	JMS I TWOCI	/ & OUTPUT ",X" WHERE
	  5460		/ "X" IS A DIGIT
	TADICAD		/GET WORD THE LAST TIME
	AND (100	/ AND CHECK "+" BIT
	SZA CLA
	JMS I TYPECI	/OUTPUT "+" OR SKIP
	  "+		/[A NOP]
	JMP I FPPOUT
/
SPECIAL,JMS GETOP	/GET OP-CODE
	JMS I SORTI	/ & BRANCH ON IT
	  FPPMO0-1
	  FPPMOJ-FPPMO0
SPCOP0,	TADICAD		/FALLS THRU ON 0, GET
	AND (170	/ SUB-OP-CODE
	JMS I SORTI	/ & BRANCH ON IT
	  FPPOP0-1
	  FPPOPJ-FPPOP0
SPOP00,	TADICAD		/FALLS THRU ON 0, USE AS
	AND N7		/ INDEX INTO LAST LIST
	IAC
SPOP04,	JMS MULT3	/THREE WORDS/SYMBOL
	JMS SYMTYP	/OUTPUT ONE OF SEVERAL
	  FPOP00	/ SYMBOLS IN THIS LIST
	  -3
	JMP I FPPOUT
/
SPOP05,	CLL STA		/= -1
	JMP SPOP04	/OUTPUT "STARTE"
/
SPNUSE,	CLL STA RAL	/= -2
	JMP SPOP04	/OUTPUT "UNUSED"
/
SPO123,	JMS GET678	/"ALN X", "ATX X", "XTA X"
	CLL RAL		/(2 WORDS PER)
	JMS SYMTYP	/OUTPUT SYMBOL
	  FPXR1S-2
	  -2
	JMP XROUT	/ & XR VALUE
/
SPOP10,	TAD (4		/"LDX *,X"
SPOP11,	JMS SYMTYP	/"ADDX *,X"
	  FPXR2S
	  -4
XROUT,	TADICAD		/GET XR FIELD
	AND N7
	DIGIT		/ & OUTPUT AS DIGIT
	JMP I FPPOUT
/
SPCOP1,	TADICAD		/GROUP 0 OR 1?
	AND (100
	SNA CLA
	JMP SPOP1J	/ 1 = CONDITIONAL JUMPS
	JMS GET678	/ 0 = SETS, ETC.
	TAD (-4		/SUB-OP-CODES 0 THRU 3?
	SMA CLA
	JMP SPNUSE	/ NO, 4 THRU 7 = UN-USED
	JMS GET678	/0 THRU 3: SETX,SETB,JSA,JSR
	IAC		/ +1+1 => 2 THRU 5
SPCOP3,	IAC		/ 1: TRAP3
SPCOP4,	JMS MULT3	/ 0: TRAP4
	JMS SYMTYP	/GO DO ONE OF THESE
	  FOP134
	  -3
	JMP DOFLD	/FINISH WITH FIELD
/
SPOP1J,	JMS CONDIT	/CONDITIONAL JUMPS
	  1200		/ "J--"
	SPACE2
DOFLD,	JMS FLDOUT	/OUTPUT FIELD & "*"
	JMP I FPPOUT
/
SPCOP2,	JMS I TYPSI	/OUTPUT "JNX "
	  MSJNX
	JMP XRPLUS-1	/ & HANDLE ADDRESS
/
/  SPCOP3 & SPCOP4
/
SPCOP5,	TADICAD		/GET WORD AGAIN
	AND (100
	SZA CLA
	JMP SPNUSE	/BIT 5 ON IS UNUSED OP
	JMS CONDIT	/LOAD TRUTH
	  1424		/ "LT--"
	JMP I FPPOUT
/
SPCOP7,	IAC		/ "LEA" INDIRECT, SET SWITCH
SPCOP6,	DCA TEMP2	/ "LEA" LONG, SET SWITCH
	CLL STA
	JMP FPLEA	/ & GO DO OUTPUT


PAGE
PDATE,	0	/ROUTINE TO OUTPUT AN EXTENDED DATE WORD
	DCA CRLF	/SAVE IT
	TAD CRLF	/GET WORD & MASK
	AND N377
	CLL RTR		/DAY (4-8) TO 7-11
	RAR
	JMS I DEC2I	/ OUTPUT AS 2 DIGITS (MASKED)
	JMS I TYPECI	/ AND A SEPARATOR
	  "-
	TAD CRLF	/GET WORD A SECOND TIME
	JMS I RTR6I	/MONTH (0-3) TO 7-10
	RAR		/ FOR MONTH*2
	AND (36		/ MASK IT AND USE AS AN INDEX
	JMS I TYPSI	/ TO OUTPUT MONTH IN ALPHA
	  MONTHS	/ FORM (WITH SAFETY...)
	JMS I TYPECI	/FOLLOWED BY "-"
	  "-
	TAD CRLF	/GET LAST TIME
	AND N7		/ MASK OFF YEAR
	TAD YRTEST	/  TEST IF .GT. THIS YEAR
	SMA SZA
	TAD (-10	/   YES, SUBTRACT 8
	TAD YRBASE	/ ADD TO BASE YEAR
	JMS I DEC2I	/ & OUTPUT IT
	JMP I PDATE
YRTEST,	0	/-(THIS YEAR) FOR TESTING
YRBASE,	0	/BASE YEAR FOR DATE + THIS YEAR


TYPEA,	0	/OUTPUT ASCII CHARACTER IN THE AC
	TAD I TYPEA	/GET ARG, IF ANY
	ISZ TYPEA
	DCA I RTL6I	/SAVE THE CHAR HERE FOR FIELD 1
	JMS I CTRLI
	CIF 10
	JMP TYPE1	/GO TO FIELD 1 TO DO THE OUTPUT
/
TYPEX,	ISZ NCNT	/BUMP LINE POSITION
	JMP I TYPEA	/ & EXIT

CRLF,	0	/OUTPUT CARRIAGE RETURN, LINE FEED
	CLA
	JMS TYPEA
	  215
	JMS TYPEA
	  212
	DCA NCNT	/RESET LINE POSITION
	JMP I CRLF


TYPEC,	0	/OUTPUT A SINGLE CHAR ARG
	TAD I TYPEC	/GET IT
	ISZ TYPEC
	JMS TYPE	/OUTPUT IT
	JMP I TYPEC


TYPE,	0	/CHARACTER OUTPUT ROUTINE
	AND N377	/BE SURE ONLY 8 BITS
	SNA
	TAD CHAR	/USE CHAR IF AC = 0
	DCA TCHAR	/CHAR TO OUTPUT
	TAD TCHAR
	JMS I SORTI	/CHECK FOR SPECIALS
	  TYPEL-1
	  TYPEOP-TYPEL
	TAD TCHAR	/IS TCHAR < 240?
	TAD M240
	SPA CLA
	JMP TYPCTL	/NO, OUTPUT AS CTRL-CHAR
TYPC,	JMS TYPEA	/NOW OUTPUT CHAR
TCHAR,	  0
	JMP I TYPE
/
TYPALT,	JMS TYPEA	/OUTPUT "$" FOR ALT-MODES
	  "$
	JMP I TYPE
/
TYPCR,	JMS CRLF	/C.R. TO OUTPUT
	JMP I TYPE
/
TYPTAB,	JMS TYPEA	/SPACE OVER FOR TAB
	  " 
	TAD NCNT	/TAB TO OUTPUT
	TAD M10
	SNA
	JMP I TYPE
	SMA
	JMP TYPTAB+3	/REDUCE BY TAB SIZE
	CLA
	JMP TYPTAB
/
TYPCTL,	JMS TYPEA	/CONTROL-CHAR, OUTPUT AS
	  "^
	TAD C100	/ "^","CHAR+100"
	JMP TYPC
C100,	100


CTRL,	0	/CHECK FOR CTRL-C, CTRL-S, CTRL-Q & CTRL-P
	DCA CTRLQS	/CLEAR HANG FLAG
CTRL0,	KSF		/HAS A KEY BEEN HIT?
	JMP CTRLX	/NO, TEST IF HANGING
	KRS
	AND N177	/YES, MASK OFF PARITY BIT
	TAD (-"C+300	/IS IT A CTRL-C (ABORT PROGRAM)?
	SNA
BCTRLC,	JMP CTRLC	/***	JMP I CTRLCI	/== ABORT ==
	TAD M20		/IS IT A CTRL-S (STOP OUTPUT)?
	SZA
	JMP CTRL1
	ISZ CTRLQS	/ YES, SET HANG FLAG
	KCC		/  & CLEAR HARDWARE FLAG
CTRL1,	TAD (2		/IS IT A CTRL-Q (START OUTPUT)?
	SZA
	JMP CTRL2
	KCC		/ YES, CLEAR THE HARDWARE
	JMP I CTRL	/  & JUST EXIT
/
CTRL2,	IAC		/IS IT A CTRL-P (STOP PROGRAM)?
	SZA CLA
	JMP CTRLX	/NO, TEST IF HANGING
	KCC
	DCA DSWIT	/YES, RESET DUMP SWITCH
	JMS I TYPECI	/OUTPUT "^P"
	  "P-100
	JMP I RECRLF	/ THEN CR/LF & RESTART
/
/ROUTINE TO EXECUTE THE 'EXIT' COMMAND
/
XEXIT,
CTRLC,	DCA DSWIT	/RESET DUMP SWITCH
	JMP I M200	/ & GO TO SYSTEM
CTRLCI,	XERR4+1		/*** CTRL-C ABORTS JOB STREAM! ***
/
CTRLX,	TAD CTRLQS	/HANGING BECAUSE OF CTRL-S?
	SZA CLA
	JMP CTRL0	/ YES, BACK FOR ANOTHER ROUND
	JMP I CTRL	/ NO, OUT WE GO!

CTRLQS,	0	/CTRL-S, CTRL-Q FLAG


PAGE
/INPUT AN UNSIGNED 24 BIT NUMBER
ACCEPT,	0
	DCA ACC1	/CLEAR LO
	DCA ACC2	/ & HI WORDS
	DCA DADD	/ & LEGAL INPUT SWITCH
	JMS I SSKIPI	/GET FIRST NON-SPACE
	SKP
ACCPT1,	JMS I GETNI	/DON'T IGNORE SPACES
	JMS I SORTI	/CHECK FOR ^D, ^K, (, ", ',
	  GWLST1-1	/ DIGITS, SPACE
	  ACOPS-GWLST1
	JMP ACCPT3	/NONE OF THE ABOVE
/
ACCNUM,	TAD CHAR
	TAD (-"0	/MAKE A DIGIT
	DCA OCTSET
	TAD OCTSET	/IS DIGIT LEGAL?
	CIA
	TAD ACBASE
	SPA SNA CLA
ERC09,	ERROR		/ NO, ILLEGAL DIGIT!
ACCMUL,	TAD ACBASE	/SET UP MULTIPLY OF PREVIOUS
	DCA OPER1	/ BY BASE
	DCA OPER2
	JMS DMUL	/ DO MULTIPLY
	TAD OCTSET	/SET UP ADD OF NEXT "DIGIT"
	DCA OPER1
	DCA OPER2
	JMS DADD	/OK, DO THE ADD (& SET SWITCH)
	JMP ACCPT1
/
	STA		/  SPACE HERE
	DCA CRSWT	/SET SWITCH: CR HERE
ACCPT3,	TAD DADD	/TERMINATING CHAR RECEIVED
	SNA CLA		/CHECK FOR LEGAL INPUT
ERCR,	ERROR		/YOU CAN'T OUT-SMART ME!
	JMP I ACCEPT
ACBASE,	10
/
/
DQUOTE,	JMS QUOTEC	/ " - GET SINGLE CHAR
	DCA OCTSET	/ SAVE VALUE
	JMP ACCMUL	/ & USE IT AS A "DIGIT"
/
SQUOTE,	JMS QUOTEC	/ ' - PACKED ASCII, GET 1ST
	AND N77		/MASK TO 6 BITS
	JMS I RTL6I	/MOVE TO LEFT HALF
	DCA OCTSET	/ & SAVE IT
	JMS QUOTEC	/GET 2ND CHAR
	AND N77		/MASK
	TAD OCTSET	/MERGE
	JMP DQUOTE+1	/ & USE THIS AS A "DIGIT"
/
CTRLD,	TAD (2		/ ^D - SET RADIX TO DECIMAL
CTRLK,	JMS OCTSET	/ ^K - SET RADIX TO OCTAL
	JMP ACCPT1


/SUB. TO SET UP FOR OCTAL/DECIMAL INPUT.  CALLED FROM
/  COMMAND INPUT & MODIFY & IF AN "^K"/"^D" IN INPUT.
OCTSET,	0	/SET UP FOR OCTAL/DECIMAL INPUT
	TAD (10		/ENTER WITH AC= 2 FOR DECIMAL
	DCA ACBASE
	JMP I OCTSET

QUOTEC,	0	/GET A QUOTED CHARACTER
	JMS CGTEST	/GET & TEST FOR A CR
ERC13,	  ERROR		/ ILLEGAL USE OF " OR '
	TAD CHAR	/OK, RETURN WITH IT
	JMP I QUOTEC


/SUBROUTINE TO DEVELOP ARGUMENTS FROM THE COMMAND
/BUFFER, AND RETURN WITH -(#) OF ARGS IN 'TEMP'.
GARGS,	0
	TAD TEMPST	/GET BUFFER ADDRESS
	DCA DPNT
	DCA TEMP	/ZERO THE NUMBER OF ARGS
GAR1,	STA
	DCA TEMP1	/SET BLK TO -1
	STA
	DCA CNT		/RESET SWITCH
GAR2,	JMS EXPRIN	/GET NEXT ARG
	JMS I SSKIPI	/IGNORE TRAILING SPACES
	JMS I SORTI	/BRANCH ON TERMINATOR
	  GARLST-1
	  GAROPS-GARLST
ERCS,	ERROR		/ILLEGAL TERMIN., FLAME OUT
/
GAR3,	JMS GPUT	/CR FOUND, END
	TAD TEMPST	/SET UP POINTER FOR
	DCA DPNT	/ GETTING RESULTS
	JMP I GARGS
/
GAR4,	JMS I GETNI	/SKIP OVER "."
	TAD ACC1	/.= TERMIN (BLOCK PART)
	JMP GAR1+1	/SET BLOCK & GET NEXT
/
GAR5,	TAD ACC1	/-= TERMIN (LOC PART)
	DCA TEMP2
	JMS I GETNI	/SKIP OVER "-"
	JMP GAR2-1	/GO SET SWITCH
/
GAR6,	JMS GPUT	/,= TERMIN
	JMS I GETNI	/SKIP OVER ","
	JMP GAR1


/SUBROUTINE TO PUT THE DEVELOPED ARGS IN THE ARG
/BUFFER.  ALL ARGUMENTS ARE STORED IN 4 WORDS IN
/THE BUFFER, AS SPECIFIED BY:
/   BLOCK.LOC1-LOC2  (TERMINATED BY , OR C.R.)
/AS:
/I-------I-------I-------I-------I-----
/I WORD1 I WORD2 I WORD3 I WORD4 I ETC.
/I-------I-------I-------I-------I-----
/WHERE:
/  WORD1=	BLOCK (OR -1 IF NONE SPECIFIED)
/  WORD2=	LOC (HIGH) [ONLY 3 BITS, LOC2 IF SPEC'D]
/  WORD3=	LOC1 (LOW)
/  WORD4=	LOC2-LOC1-1 (LOC2=LOC1 IF NOT
/		SPECIFIED) [ONLY 12 LOW BITS USED]
GPUT,	0
	TAD TEMP1
	DCA I DPNT	/SET BLOCK
	ISZ CNT		/WAS A LOC2 SPECIFIED?
	JMP GPUT1	/YES, OK
	TAD ACC1
	DCA TEMP2	/NO, MAKE ARGS SAME
GPUT1,	TAD ACC2	/STORE HIGH ADDR
	AND N7		/MASKED TO 3 BITS
	DCA I DPNT
	TAD TEMP2	/USE 1ST ARG
	DCA I DPNT
	TAD ACC1
	CMA
	TAD TEMP2
	DCA I DPNT	/DIFF= (TEMP2-ACC1-1)
	STA
	TAD TEMP	/ANOTHER ENTRY
	DCA TEMP
	JMP I GPUT


XS240O,	0	/XS240 FORMAT PACKED ASCII
	JMS I RTR6I	/HIGH 6 BITS
	AND N77
	SPACE1		/ PLUS A SPACE
	TADICAD		/THEN LOW 6 BITS,
	AND N77
	SPACE1		/ PLUS A SPACE
	JMP I XS240O


GETN,	0	/GET NEXT CHAR FROM COMM. BUFF.
	CDF 10
	TAD I COMOUT
	CDF 0
	DCA CHAR
	JMP I GETN


PAGE
/ROUTINE TO EVALUATE THE PARENTHESIZED EXPRESSION
/OF DOUBLE PRECISION INTEGERS IN THE COMMAND BUFFER.
/IT CALLS ITSELF RECURSIVELY TO EVALUATE EXPRESSIONS
/IN "(...)", PLACING INFORMATION ON A PUSH-DOWN-LIST
/OR DOING ARITHMETIC ACCORDING TO OPERATOR PRECIDENCE.
/
/OPERATIONS (IN ORDER OF PRECIDENCE):
/  OR AND ADD SUB DIV MPY
/  !   &   +   -   /   *

/ALL ARITHMETIC IS DONE IN DOUBLE-PRECISION SIGNED
/INTEGER.  OVERFLOW ON MULTIPLY, ADD OR SUBTRACT IS
/IGNORED BUT DIVIDE BY 0 WILL CAUSE AN ERROR.


EVAL,	0
	DCA OPER2	/0 => D.P. TEMP (NEW NUMBER
	DCA OPER1	/ OR LAST RESULT).
	DCA LASTOP	/0 => LASTOP
	JMS I TERMTI	/GET NEXT & TEST FOR TERM.
	JMP EVAL1	/TERM, CHECK IT
	JMP ENUM	/ IT MUST BE A NUMBER

EVAL1,	JMS I SORTI	/CHECK LEGAL TERMS
	  EVLST1-1	/"+","-" & "("
	  EVOPS1-EVLST1
ERCT,	ERROR		/SORRY ABOUT THAT

EVAL2,	JMS I LPARI	/IS CHAR "("?
ERCU,	ERROR		/YES,ILLEGAL (NO OP FIRST)
EVMIN,	TAD CNTRA	/SEQN # OF TERMINATOR
	DCA THISOP	/SET UP THISOP
	TAD CNTRA	/IS IT ")" OR "CR"?
	TAD M10
	SMA CLA
	DCA THISOP	/YES, 0 => THISOP
EVAL3,	TAD THISOP	/CHECK PRIORITIES
	CIA
	TAD LASTOP	/IS LASTOP < THISOP?
	SPA CLA
	JMP EVPAR	/YES, CONTINUE SCAN
	TAD THISOP	/ IS THISOP+LASTOP=0?
	TAD LASTOP
	SNA CLA
	JMP EVALX	/YES, DONE
	TAD LASTOP	/NO, DO THIS OP NOW
	TAD EVTAB
	DCA EVOP	/SET UP OPERATION
	TAD LASTOP	/IS THIS =0?
	SNA CLA
	JMP EVOP	/YES, DO OP
	POP		/NO, POP LAST OFF LIST
	DCA ACC2	/ INTO D.P.AC.
	POP
	DCA ACC1
EVOP,	HLT		/JMS TO OPERATION ROUTINE
	TAD ACC2
	DCA OPER2	/DUPLICATE D.P.AC. INTO
	TAD ACC1
	DCA OPER1	/ D.P. TEMP
	POP
	DCA LASTOP	/POP UP ANOTHER OLD OPERATOR
	JMP EVAL3	/AND GO DO IT

EVPAR,	JMS I LPARI	/IS CHAR A "("?
	JMP EVLPAR	/YES, GO DO A SUB-EXPRESSION
	TAD LASTOP	/NO, PUSH DOWN OLD OP
	PUSH
	TAD OPER1	/ & D.P. TEMP (LAST
	PUSH
	TAD OPER2	/ RESULT OR NEW NUMBER).
	PUSH
	TAD THISOP	/UPDATE LASTOP
	DCA LASTOP
EVNEXT,	JMS I TERMTI	/GET NEXT & TEST FOR TERM.
	JMP EVLPAR	/TERM, MUST BE A "("
ENUM,	JMS I SORTI	/CHECK FOR "C","B", ETC...
	  EVLST2-1
	  EVOPS2-EVLST2
	JMS ACCEPT	/GET A # OR BOMB OUT!
	STA
	TAD COMOUT	/BACK UP POINTER
	DCA COMOUT
ENUMX,	TAD ACC1
	DCA OPER1	/LO ORDER PART
	TAD ACC2
	DCA OPER2	/HI ORDER PART
	JMP EVOPN	/GO CHECK TERMINATOR
/
EVDATE,	CDF 10		/"D" -- USE DATE WORD
	TAD I (7666	/GET DATE WORD
	CDF 0
	JMP EVBLK+1
EVREM,	TAD ACCX1	/"R" -- USE REMAINDER
	DCA ACC1
	TAD ACCX2	/ AS NEXT "INPUT".
	JMP EVBLK+2
EVTEMP,	TAD TEMPV1	/"T" -- USE 'TEMP' STORAGE
	DCA ACC1
	TAD TEMPV2
	JMP EVBLK+2
EVSR,	LAS SKP		/"S" -- USE SWITCHES
	TADICAD		/"C" -- USE CONTENTS
	JMP EVBLK+1
EVFIL,	TAD FILLER	/"F" -- USE FILLER
	JMP EVBLK+1
EVLOC,	TAD LOCL	/"L" -- USE LOCATION
	DCA ACC1
	TAD LOCH
	JMP EVBLK+2
EVBLK,	TAD BLK		/"B" -- USE BLOCK
	DCA ACC1	/INTO LO ORDER PART
	DCA ACC2	/0 HIGH ORDER PART
	JMP ENUMX	/CHECK NEXT CHARACTER

EVLPAR,	JMS I LPARI	/IS CHAR "("?
	SKP
ERCV,	ERROR		/NO, DIE! (ILLEGAL OPERATOR)
EVPAR2,	TAD LASTOP	/PUSH DOWN LASTOP
	PUSH
	TAD EVAL	/PREPARE TO RE-CALL
	PUSH
	JMS EVAL	/RECURSIVE CALL
ERCW,	ERROR		/TERM = CR, NOT ENOUGH PARENS
	POP
	DCA EVAL	/RESTORE RETURN ADDR
	POP
	DCA LASTOP	/RESTORE LASTOP
EVOPN,	JMS I TERMTI	/GET NEXT & TEST FOR TERM.
	JMP EVAL2	/OK
	JMP EVPAR2-1	/GARBAGE, GIVE SAME ERROR

EVALX,	TAD CNTRA	/WAS CHAR CR OR ")"?
	TAD M10
	SNA CLA
	ISZ EVAL	/ ")", RETURN TO CALL+2
	JMP I EVAL	/ CR, RETURN TO CALL+1

LPARI,	LPAR
TERMTI,	TERMT

EVTAB,	JMS I .	   /JMS THRU TABLE TO OPERATIONS

	DIOR	/INCLUSIVE OR
	DAND	/AND
	DADD	/ADD
	DSUB	/SUBTRACT
	DDIV	/DIVIDE
	DMUL	/MULTIPLY


PAGE
PUSHX,	0	/PUSH AC ONTO LIST
	CDF 10
	DCA I PDLPT
	CDF 0
	ISZ PDLPT	/BUMP POINTER
	JMP I PUSHX

POPX,	0	/POP LIST INTO AC
	STA STL		/SET LINK SO IT WILL BE 0
	TAD PDLPT	/BACK UP POINTER
	DCA PDLPT
	CDF 10
	TAD I PDLPT
	CDF 0
	JMP I POPX


LPAR,	0	/CHECK IF CHAR = "("
	TAD CHAR
	TAD (-"(
	SZA CLA
	ISZ LPAR	/IF IT IS NOT, TO CALL+2
	JMP I LPAR	/  ELSE TO CALL+1

/COMPARE CHAR AGAINST LIST OF TERMINATORS.  IF IT
/IS ONE, RETURN TO CALL+1, ELSE TO CALL+2.
TERMT,	0
	CLA CLL
	JMS I GETNI	/GET NEXT CHARACTER
	JMS I SSKIPI	/IGNORE SPACES
	TAD (TERMS-1	/SET UP POINTER
	DCA SPNT
	DCA CNTRA	/SET CNTRA TO 0
TERMT1,	CDF 10
	TAD I SPNT	/GET AN ITEM
	CDF 0
	ISZ CNTRA	/ADD 1 TO ITEM #
	SNA
	JMP TERMTE	/WAS 0, END
	CIA
	TAD CHAR	/SAME AS THIS?
	SNA CLA
	JMP I TERMT	/YES, TO CALL+1
	JMP TERMT1
TERMTE,	ISZ TERMT	/DIDN'T FIND IT, TO
	JMP I TERMT	/ CALL+2

/DOUBLE-PRECISION ROUTINES

DADD,	0	/D.P. ADD
	CLL
	TAD OPER1
	TAD ACC1	/ADD LOW ORDER PARTS
	DCA ACC1
	RAL		/GET CARRY TO AC11
	TAD OPER2	/ADD HIGH ORDER PARTS
	TAD ACC2
	DCA ACC2	/STORE HIGH ORDER PART
	JMP I DADD

DSUB,	0	/D.P. SUBTRACT
	DCA DPSGN	/ZERO IT FOR SAFETY
	JMS MULNEG	/NEGATE OPERAND
	JMS DADD	/ & ADD
	JMP I DSUB

DAND,	0	/D.P. LOGICAL AND
	TAD ACC2	/AND HIGH ORDER PARTS
	AND OPER2
	DCA ACC2
	TAD ACC1	/AND LOW ORDER PARTS
	AND OPER1
	DCA ACC1
	JMP I DAND	/RETURN

DIOR,	0	/D.P. LOGICAL INCLUSIVE OR
	TAD ACC2	/IOR HIGH ORDER PARTS
	CMA
	AND OPER2
	TAD ACC2
	DCA ACC2
	TAD ACC1	/IOR LOW ORDER PARTS
	CMA
	AND OPER1
	TAD ACC1
	DCA ACC1
	JMP I DIOR


/SUBROUTINE TO GET SINGLE ARGS FROM THE COMMAND
/BUFFER.  MUST BE IN 'BLOK.LOC' FORM.  ONLY ".",
/SPACE AND CR ARE ALLOWED OTHER THAN DIGITS.
ARG,	0
	STA
ARG1,	DCA TEMP1	/SET 'BLOK' [INIT TO -1]
	JMS EXPRIN	/  GET AN ARG
	JMS I SORTI	/LOOK UP TERMINATOR
	  ARGLST-1
	  ARGOPS-ARGLST
ERCQ,	ERROR		/ILLEGAL TERMINATOR
/
ARG2,	JMS I GETNI	/SKIP OVER "."
	TAD ACC1	/TERM = ".", SET 'BLOK'
	JMP ARG1
/
ARG3,	JMP I ARG	/TERM = " " OR CR


/GET NEXT ARG FROM COMM. BUFF.  IF NEXT CHAR IS
/  A "(", USE 'EVAL' TO GET IT, OTHERWISE USE
/  'ACCEPT'.
EXPRIN,	0
	JMS I SSKIPI	/IGNORE SPACES
	JMS LPAR	/IS CHAR A "("?
	JMP EXPRI1
	JMS ACCEPT	/NO, MUST BE A NUMBER
	JMP I EXPRIN
/
EXPRI1,	JMS I EVALI	/YES, GO EVALUATE EXPRESSION
ERC08,	ERROR		/CR = ILLEGAL TERMINATOR
	JMS CGTEST	/OK, SKIP OVER ")" & TEST FOR CR
	  SKP
	STA		/NO, SET SWITCH
	DCA CRSWT	/YES, RESET IT
	JMP I EXPRIN	/ & LEAVE...


SCANER,	0	/EXECUTION SUBROUTINE FOR 'SCAN' COMMAND
	CLA
	TAD BLK		/SET UP DESIRED BLOCK
	DCA CBLK
	JMS GETIO	/DO NECESSARY I/O
	  SKP CLA	/  READ ERROR!
	JMP I SCANER	/THIS BLOCK IS OK!
	TAD BLK
	JMS I OCTI	/OUTPUT BLOCK NUMBER
	JMS I TYPSI	/ & TELL IT'S BAD
	  MSBAD
	JMS I CRLFI	/ TO ANOTHER LINE
	JMP I SCANER


PAGE
/SIGNED MULTIPLY AND DIVIDE ROUTINES

DMUL,	0
	JMS MDCOM	/MAKE DPAC POS, INITIALIZE
	SPA CLA		/MAKE SURE MULTIPLIER IS POSITIVE
	JMS MULNEG	/ IT WAS NEG, MAKE POS & SET SIGN
DMUL1,	TAD ACC2	/SHIFT RIGHT & OUT
	RAR
	DCA ACC2	/THRU HI OF LO
	TAD ACC1
	RAR
	DCA ACC1	/THRU LO OF LO INTO LINK
	ISZ DPNEG	/DONE YET?
	JMP DMUL2	/NO, CONTINUE
DMUL4,	TAD DPSGN	/YES, CHECK SIGN OF RESULT
	RAR
	SZL CLA		/SKIP IF SIGN OK
	JMS DPNEG	/NOT OK, NEGATE
	JMP I DMUL
/
DMUL2,	SNL		/ADD IN THIS TIME?
	JMP DMUL3	/NO, BIT OUT WAS 0
	CLA CLL		/YES, BIT WAS 1
	TAD OPER1	/START WITH LOW
	TAD ACCX1
	DCA ACCX1
	CLA RAL		/GET CARRY
	TAD OPER2	/ADD HIGH PARTS
DMUL3,	TAD ACCX2	/AND BEGIN SHIFTING OUT
	RAR
	DCA ACCX2
	TAD ACCX1
	RAR
	DCA ACCX1
	JMP DMUL1

DDIV,	0
	TAD DDIV	/MOVE RETURN ADDRESS
	DCA DMUL
	JMS MDCOM	/MAKE DPAC POS, INITIALIZE
	SMA CLA		/IS DIVISOR NEGATIVE?
	JMS MULNEG	/ NO, NEGATE IT & SET SIGN
	SZL		/  IS IT 0? (CARRY OUT ON NEGATE)
ERCX,	ERROR		/   YES, YOU LOST
	ISZ DPSGN	/CORRECT FOR SIGN DIF IN * & /
DDIV1,	TAD ACCX1	/SUBTRACT LO OF LO
	TAD OPER1
	DCA ACCX1
	CLA RAL		/CARRY TO AC
	TAD ACCX2	/SUBTRACT HI OF LO
	TAD OPER2
	SPA		/TOO FAR?
	JMP DDIV2	/YES
	CLL CML		/NO, SET LINK
	DCA ACCX2
	JMP DDIV3
DDIV2,	CLA
	TAD OPER1	/RESET LO ORDER PART
	CIA
	TAD ACCX1
	DCA ACCX1
	CLL		/RESET LINK
DDIV3,	TAD ACC1	/BEGIN SHIFTING
	RAL
	DCA ACC1
	TAD ACC2
	RAL
	DCA ACC2
	ISZ DPNEG	/DONE YET?
	SKP
	JMP DMUL4	/YES, CHECK SIGN & RETURN
	TAD ACCX1	/NO, KEEP SHIFTING
	RAL
	DCA ACCX1
	TAD ACCX2
	RAL
	DCA ACCX2
	JMP DDIV1

MDCOM,	0     /COMMON ROUTINE FOR MULTIPLY & DIVIDE
	DCA DPSGN	/RESET SIGN
	TAD ACC2	/IS DPAC POS?
	SPA CLA
	JMS DPNEG	/NO, NEGATE
	DCA ACCX2	/ 0 => DPACX
	DCA ACCX1
	TAD (-31	/INITIALIZE COUNTER
	DCA DPNEG
	CLL
	TAD OPER2	/RETURN W. HIGH OPERAND
	JMP I MDCOM

MULNEG,	0	/NEGATE THE MULTIPLIER/DIVISOR
	TAD OPER1	/DO LO-ORDER PART
	CLL CIA
	DCA OPER1
	TAD OPER2	/DO HI-ORDER PART
	CMA
	SZL		/CARRY?
	CLL IAC		/YES, ADD IT IN
	DCA OPER2
	ISZ DPSGN	/SIGN CHANGE MADE
	JMP I MULNEG

DPNEG,	0	/NEGATE THE D.P.AC.
	TAD ACC1	/DO LO-ORDER PART
	CLL CIA
	DCA ACC1
	TAD ACC2	/DO HI-ORDER PART
	CMA
	SZL		/CARRY?
	CLL IAC		/YES, ADD IT IN
	DCA ACC2
	ISZ DPSGN	/SIGN CHANGE MADE
	JMP I DPNEG


BLKTST,	0	/TEST & SET BLK
	DCA DPNEG	/SAVE DATA
	TAD DPNEG	/GET IT BACK AGAIN
	ISZ DPNEG	/LEGAL BLOCK NUMBER?
	DCA BLK		/ YES IF NOT 7777 (-1)
	CLA		/ IF NOT, CLEAR JUNK
	JMP I BLKTST


DICAD,	0	/"DCA I CAD" IN FIELD 1
	CDF 10
	DCA I CAD
	CDF 0
	JMP I DICAD

TICAD,	0	/"TAD I CAD" IN FIELD 1
	CDF 10
	TAD I CAD
	CDF 0
	JMP I TICAD


PAGE
/CHECK IF THE COMMAND BUFFER STARTS WITH A WORD.  IF
/IT DOES, RETURN TO 'MAIN3' WITH THE SPECIAL CHAR-
/ACTER AND JUST USE IT AS PART OF THE COMMAND STRING.
/IF IT DOES NOT, TEST FOR EXPRESSIONS [IN "(...)",
/TO ALLOW CHARACTERS IN THE EXPRESSIONS TO NOT BE
/TAKEN AS COMMAND CHARACTERS] AND SINGLE & DOUBLE
/QUOTES [THE FOLLOWING CHARACTER OR CHARACTERS ARE
/LITERALS, NOT COMMANDS].  IF THE PARENS MATCH AND
/THE QUOTES ARE FOLLOWED BY THE CORRECT NUMBER OF
/CHARACTERS, THEN THE LAST CHARACTER WAS AN "ODT"
/COMMAND TO BE EXECUTED SO RETURN TO CALL+1.  OTHER-
/WISE RETURN TO 'MAIN3' AS ABOVE.

WCHEK,	0
	JMS I GWORDI	/COM BUF BEGIN WITH A WORD?
	  JMP WCHEK2	/NO, TEST FOR PARENS, ETC.
WCHEK1,	STA
	TAD COMIR	/YES, BACK UP COMIR
	DCA COMIR
	TAD TEMP	/AND USE THE SPECIAL CHAR AS
	JMP I .+1	/ PART OF THE COMMAND STRING
	  RESPC+1
/
WCHEK2,	STA
	TAD COMOUT	/SET UP ANOTHER A-XR
	DCA DPNT
	DCA CNT		/RESET (OR SET) PAREN COUNT
WCHEK3,	TADIDP		/GET A CHAR FROM COMM. BUFF.
	JMS I SORTI	/ & GO TEST IT
	  WCKLST-1
	  WCKOPS-WCKLST
	JMP WCHEK3	/NONE, CONTINUE SCAN
/
WCHEK4,	TAD CNT		/CR, DO PARENS MATCH?
	SZA CLA
	JMP WCHEK1	/NO, CONTINUE COMMAND INPUT
	JMP I WCHEK	/YES, INPUT IS DONE
/
WCHEK5,	STA CLL RAL	/SET TO -2
	IAC		/AC = +1 OR -1
	TAD CNT		/ UPDATE PAREN COUNT
	JMP WCHEK3-1	/ & CONTINUE SCAN
/
WCHEK6,	JMS WCHONE	/ ' -- 2 CHARACTERS
	JMS WCHONE	/ " -- 1 CHARACTER
	JMP WCHEK3	/OK, CONTINUE SCAN

WCHONE,	0
	TADIDP		/GET NEXT CHAR
	TAD M215	/IS IT A CR?
	SNA CLA
	JMP WCHEK1	/YES, DON'T EXECUTE SPECIAL
	JMP I WCHONE	/NO, OK
/FPP INSTRUCTION DECODING SUPPORT SUBROUTINES

GETOP,	0	/GET OP-CODE (BITS 0-3) TO BITS 9-11
	TADICAD
	AND N7000
	CLL RTL
	RTL
	JMP I GETOP

GET678,	0	/GET BITS 678 TO BITS 9-11
	TADICAD
	CLL RTR
	RAR
	AND N7
	JMP I GET678

MULT3,	0	/MULTIPLY AC BY THREE
	DCA GETOP
	TAD GETOP
	CLL RAL
	TAD GETOP	/WORKS FOR POS OR NEG!
	JMP I MULT3

CONDIT,	0	/OUTPUT CONDITIONAL FPP INSTRUCTION
	TAD I CONDIT	/GET LEADING 1 OR 2 CHARS
	ISZ CONDIT
	JMS I TWOT	/ & OUTPUT THEM
	JMS GET678	/GET CONDITION CODE
	JMS I SYMTYI	/ AS INDEX TO TABLE
	  FPCOND
	  -1
	JMP I CONDIT
SYMTYI,	SYMTYP

FLDOUT,	0	/OUTPUT FIELD DIGIT & "*"
	TADICAD
	AND N7		/GET FIELD
	JMS I RTL6I	/ TO BITS 3-5
	JMS I TWOCI	/ & OUTPUT "F*"
	  6052		/ WHERE "F" IS DIGIT
	JMP I FLDOUT



	DECIMAL		/SET RADIX TO DECIMAL

TEMPL=	.		/ARGUMENT BUFFER
		/L(TEMPL)=180(10)
F0END=	TEMPL+180
	DMPHAN-F0END	/(SHOW SPACE LEFT)

	OCTAL

PAGE	/****** MUST BE NO LITERALS! ******

DMPHAN=	06600	/DUMP HANDLER AREA, 2 FIELD 0 PAGES

DEVHAN=	07200	/DEVICE HANDLER AREA, 2 FIELD 0 PGS


IFNZRO	DMPHAN-F0END&4000  <BADERR,__CAN'T RUN>

/IF THE ABOVE ASSEMBLES, THE BUFFERS ARE OVER-
/  RUNNING THE DUMP DEVICE HANDLER.


*TEMPL	/ADD INITIALIZATION CODE WHICH IS OVERLAID

INIMSG,	0	/INITIALIZE ERROR MESSAGES ON SCRATCH BLKS
	CDF 10
	TAD I (7726	/BUT FIRST CHECK FOR "SCOPE MODE"
	CDF 0
	AND N200	/ (BIT 4 OF 17726)
	SNA CLA
	JMP INIDAT	/  NOT SET, GO SET UP DATE
INISCO,	TAD I SPNT	/SET, CHANGE RUBOUT HANDLER TO
	SNA
	JMP INIDAT	/ ERASE CHARACTERS FROM SCREEN
	DCA I DPNT	/ AND FROM BUFFER (MUCH EASIER
	JMP INISCO	/ THAN ON HARD COPY!)
/
INIDAT,	CDF 10		/NOW INIT EXTENDED DATE
	TAD I (7666	/GET SYSTEM DATE WORD
	CDF 0
	AND N7		/PICK OFF THIS YEAR PART
	CIA
	DCA YRTEST	/ AND SET TEST YEAR (NEG)
	TAD I M1	/NOW GET EXTENDED YEAR BITS
	AND (600	/ FROM "B.I.P." WORD AND
	CLL RTR		/  MOVE TO BITS 7,8 (*8)
	RTR
	TAD (106	/ADD TO A STARTING BASE OF 70[10]
	CIA
	TAD YRTEST	/AND ADD THIS YEAR ALSO
	CIA
	DCA YRBASE	/= 70 + EXTEND*8 + THIS YEAR
	TAD I (7746	/GET JSW
	AND (6777	/CLEAR BIT 2 (CAN RESTART!)
	CLL RAR
	STL RAL		/SET BIT 11 (DON'T SAVE FIELD 1)
	DCA I (7746	/& PUT IT BACK
	JMS I (7607	/WRITE ERROR MESSAGES
	  4610		/ 6 PAGES, FIELD 1
	  0		/ FROM LOC 10000
	  27		/ NORMAL SAVE AREA!
	  SKP CLA
	JMP I INIMSG	/OK, JUST EXIT
	TAD M200
	DCA XERR3	/FAILED, ASSUME WRITE LOCKED
	TAD (ERROR	/ SO NO ERROR MESSAGES ON
	DCA ERC15	/ ERROR OR "SHOW ERRORS"
	JMP I INIMSG


PAGE	/LITERALS HERE ARE OK!
/INITIALIZATION CODE--RESIDES IN BUFFER AREA AND IS WIPED
/  OUT DURING EXECUTION.  HANDLES CHAINED AND NORMAL STARTS.

START,	CLA SKP		/NORMAL
	STA		/CHAINED (FROM CCL!)
	DCA TEMP
	CDF 10
	DCA I (CCBB	/ZAP CCB SWITCH
	CDF 0
	TAD N200
	DCA I (7745	/RESET START ADDRESS
	JMS INIMSG	/INIT SCOPE, DATE & ERROR MESSAGES
	JMS BATSET	/TEST & SET UP FOR BATCH
	ISZ TEMP	/CHAINED?
	JMP I (201	/ NO, START IT UP!
	CDF 10
	TAD I M200	/YES, 1ST OUTPUT DEVICE?
	CDF 0
	AND (17		/(IGNORE LENGTH SPEC)
	SNA
	JMP STSWIT	/ NO, LEAVE AS SYS
	DCA DEVNO	/YES, SET DEVICE NUMBER
	TAD DEVNO
	CALUSR		/NOW DO HANDLER FETCH BY
	  1		/ NUMBER (PAINTING?)
STDEV,	  DEVHAN+1	/--2 PAGES--
	  JMP STERR	/ARGGGG! FAILED!!!
	TAD STDEV
	DCA DEVAD	/SET UP HANDLER ENTRY
	TAD M200
	DCA DPNT	/SET UP FIELD 1 POINTER
	TADIDP		/GET NAME OF FILE
	DCA NAM1
	TADIDP
	DCA NAM2
	TADIDP
	DCA NAM3
	TADIDP		/GET EXTENSION
	DCA NAM4
	TAD NAM1	/WAS THERE REALLY A NAME?
	SZA CLA
	STA		/ YES, SET NAME SWITCH
	DCA TEMP	/ NO, RESET
	CDF 10
	DCA I (XDNAM	/CLEAR DEVICE NAME WORDS
	DCA I (XDNAM+1
	TAD I DPNT	/GET NEXT WORD & TEST FOR ZERO
	SZA CLA
	JMP STSWIT	/ SOMETHING NOT RIGHT!
	TAD I DPNT	/OK, ASSUME CCL CHAIN & SET
	DCA I (XDNAM	/ UP DEVICE NAME
	TAD I DPNT
	DCA I (XDNAM+1
	TAD I (XDNAM	/EMPTY?
	SZA CLA
	JMP STSWIT
	TAD (0423	/YES, MUST BE DEFAULT NAME--
	DCA I (XDNAM	/ "DSK"
	TAD (1300
	DCA I (XDNAM+1
STSWIT,	CDF 10
	TAD I (7643	/TEST SWITCHES
	AND N200	/ "/E"?
	DCA ERMODE	/ 0= LONG, NON-0= SHORT
	IAC
	AND I (7643	/ "/L"? [LOAD]
	SNA CLA
	JMP STSWO	/NO, CHECK NEXT
	TAD NAM4	/YES, SET DEFAULT EXTENSION
	SNA
	TAD (1404	/ TO ".LD"
	DCA NAM4
	IAC
	JMP STSWEX-2	/ & GO SET MODE
/
STSWO,	TAD I (7644
	AND (1000	/ "/O"? [OFFSET]
	SNA CLA
	JMP STSWS	/NO, GO CHECK LAST
	TAD I (7646	/YES, GET LOW 12 BITS OF
	CIA		/ "=NNNN" AS OFFSET AND
	DCA OFFSET	/ IT UP
	STA
	JMP STSWEX-1	/ & GO SET MODE
/
STSWS,	TAD I (7644	/ "/S"? [SAVE]
	AND (40
	SNA CLA
	JMP STSWEX	/NO, WAS NOT ANY THAT COUNT
	TAD NAM4	/YES, SET DEFAULT EXTENSION
	SNA
	TAD (2326	/ TO ".SV"
	DCA NAM4
	IAC		/ & SET MODE
	DCA MODSW	/-1=OFF,0=NOR,+1=SV,+2=LD
STSWEX,	CDF 0
	ISZ TEMP	/FILE NAME SPECIFIED?
	JMP I (201	/ NO, JUST START
	DCA CRSWT	/YES, SET SWITCH TO CR,
STTLS,	TLS		/ START TTY	***	BATCH OPER.
	JMS I CRLFI	/ & DO CR/LF
	TAD NAM4	/ANY EXTENSION SPECIFIED?
	SNA CLA
	STA		/ NO--ALLOW 3 TRIES: SV, LD, NULL
	DCA TEMP1	/  ELSE ALLOW ONLY 1 TRY
	TAD NAM4	/IF NO EXTENSION SET YET,
	SNA
	TAD (2326	/ SET TO START DEFAULTS WITH SV
	DCA NAM4
	JMP XFICHN	/NOW GO DO FILE LOOKUP
/
STERR,	TLS		/START UP OUTPUT  ***	BATCH OPER.
	JMP ERCY	/ & GIVE ERROR!


PAGE
/INITIALIZATION CODE FOR BATCH OPERATION

BATSET,	0
	TAD I M1	/TEST BIT 1 OF 07777 FOR "BIP"
	RAL		/ (BATCH-IN-PROGRESS)
	SMA CLA
	JMP I BATSET	/ NO, INTERACTIVE MODE
	TAD I M1	/ YES, GET FIELD BITS OF BATCH
	AND (70		/  TO GENERATE A "CIF BAT"
	TAD (CIF	/   AND SET UP 3 CALLS:
	DCA CBATI	/	INPUT,
	TAD CBATI
	DCA CBATO	/	OUTPUT AND
	TAD CBATI
	DCA CBATE	/	ERROR.
BATMOV,	TAD I SCANX1	/GET NEXT STORAGE ADDRESS
	SNA
	JMP I BATSET	/ 0 = ALL DONE!
	DCA DPNT	/SET UP POINTER
BATLUP,	TAD I SCANX1	/GET A PATCH WORD
	SNA
	JMP BATMOV	/ 0 = GROUP END
BATPAT,	CDF 0		/CHANGED FOR "TYPEB"!!
	DCA I DPNT	/PATCH THE WORD
	CDF 0
	JMP BATLUP	/DO IT AGAIN!


/"SCOPE MODE" PATCHES FOR RUBOUT HANDLER.  INITIAL-
/  IZATION CODE FIRST CHECKS FOR SCOPE AND THEN FOR
/  BATCH.  THUS, IF BOTH ARE SET, FIRST THINGS WILL BE
/  SET UP FOR SCOPE AND THEN THEY WILL BE RESET FOR
/  BATCH.  THIS SEQUENCE IS REQUIRED!

SCOPLS,	RELOC	RUBO
	JMS BTEST	/BUFFER NOW EMPTY?
	JMP RENEXT	/ YES, JUST IGNORE RUBOUT
	STA
	TAD COMIR	/NO, BACK UP POINTER
	DCA COMIR
	TAD COMIR	/SET UP POINTER FOR TESTING, ALSO
	DCA COMOUT
	JMS RUBO2	/OUTPUT BACKSPACE, SPACE, BACKSPACE
	JMS I GETNI	/GET RUBBED OUT CHAR AND TEST
	TAD CHAR
	TAD M240	/ FOR A CONTROL CHAR
	SPA CLA
	JMS RUBO2	/YES, ERASE "^" ALSO!
	JMP RENEXT	/TRY FOR ANOTHER CHAR

RUBO2,	HLT	/MUST BE NON-ZERO!!!
	JMS I TYPEAI	/OUTPUT A BACKSPACE,
	  "H-100	/(CTRL-H)
	SPACE1		/ SPACE,
	JMS I TYPEAI	/ BACKSPACE SEQUENCE TO
	  "H-100	/ CLEAR OFF SCREEN CHAR
	JMP I RUBO2
TYPEAI,	TYPEA
	0

	RELOC


BATLS,	/PATCHES--ADDRESS-1, CODE, 0 WITH EXTRA 0 FOR END.

	RUBO-1		/==== INPUT PATCHES ====
	RELOC	RUBO
	DCA CHAR	/SAVE NEW CHAR INPUT
	TAD CHAR	/IS THIS A FORM-FEED?
	TAD RM214
	SNA
	JMP RKEY+1	/ YES, JUST IGNORE IT!
	TAD R2		/NO, THEN IS IT A LINE-FEED?
	SNA CLA
	TAD RLAST	/ YES, WAS LAST A CARRIAGE-RETURN?
	TAD M215
	SZA CLA
	TAD CHAR	/NO TO ONE OR OTHER, USE CHAR.
	DCA RLAST	/ YES TO BOTH, SET TO 0!
	TAD RLAST	/OK, WAS IT A CR-LF PAIR?
	SNA CLA
	JMP RKEY+1	/  YES, JUST IGNORE LF!
	JMP REKEY+1	/  NO, GO USE THIS CHAR

BATINI,	5400		/IN THE BATCH FIELD
RM214,	-214
R2,	2
RLAST,	215		/!!! CR OF ".R FUTIL" HAS AN LF !!
	0

	RKEY+1-1
	RELOC		/TO PUT 'CBATI' ON THIS PAGE
CBATI=	.+1		/REALLY ON "CIF BAT"
	RELOC	RKEY+1
	JMS I CTRLI	/CHECK FOR CONTROL KEYS
	CIF		/***	CIF BAT
	JMS I BATINI	/GET A BATCH CHARACTER
ERC17,	ERROR		/!!! EOF ON INPUT !!!
	NOP		/FILLER FOR INTERACTIVE CTRL-Q
	NOP
	0

	RKEY0-1
	RELOC	RKEY0
	JMP RKEY+1	/IGNORE RUBOUT UNDER BATCH
	NOP		/ & RETURN TO CALL+1!
	0

	BCTRLC-1
	RELOC	BCTRLC
	JMP I CTRLCI	/CTRL-C, ABORT JOB STREAM!
	0

	RELOC		/==== OUTPUT PATCHES ====
	201-1
	NOP
	0

	STTLS-1
	NOP		/ZAP 3 "TLS"S USED FOR STARTUP
	0

	STERR-1
	NOP
	0

	RELOC		/==== ERROR PATCH ====

	XERR4-1
CBATE=	.		/REALLY ON "CIF BAT"
	RELOC	XERR4
	CIF		/***	CIF BAT
	JMP I N7000	/ABORT TO BATCH FIELD!
	0

	RELOC

	BATPAT-1
	CDF 10		/*** NEXT CODE IN FIELD 1 ***
	0

	TYPEB-1
	RELOC
CBATO=	.+1		/REALLY ON "CIF BAT"
	IFDEF	TYPEB	</NO PASS1 ERROR!
	RELOC	TYPEB	/*** REALLY IN FIELD 1 ***
	>
	CDF 10		/***	SET UP RETURN D.F.
	CIF		/***	CIF BAT
	JMS I .+1	/OUTPUT A CHARACTER TO LOG
	  7400		/BATOUT, IN THE BATCH FIELD
	CDF 0		/***	RESET D.F.
	0

	RELOC

	0
	PAGE




	*7000
	/NEW CODE TO HANDLE 128K SUPPORT
ADFLD,	0	/ADJUSTS BANK AND FIELD FOR CCB PRINTING
	TAD TEMP2
	AND (76
	CLL RTR
	SZL
	TAD (20
	CLL RTL
	JMS I (FPRNT
	JMP I ADFLD
FPRNTX,	0		/ROUTINE TO PRINT BANK BITS
	AND (174	/ISOLATE BANK AND FIELD BITS
	DCA FLD
	TAD FLD
	AND (104	/ISOLATE BANK BITS
	CLL RTR		/SSWITCH THEM AROUND
	RAR
	SZL
	TAD (4
	CLL RTR
	DIGIT		/PRINT BANK BITS
	TAD FLD
	JMP I FPRNTX
FLD,	0

FIELD	1	/THE END OF FIELD 0!
*10000		/PUT A POINTER HERE!

	NXTIOT	/ADDR OF NEXT FREE SPACE IN TABLE


/ERROR MESSAGES AND ADDRESS LIST.  THESE ITEMS RESIDE
/  UNDER THE USR, REQUIRING THAT THE USR SWAP THEM
/  WHEN IT IS USED AND THAT THE PROGRAM KICK OUT THE
/  USR WHEN AN ERROR OCCURS IN LONG ERROR MESSAGE MODE
/  OR WHEN A "SHOW ERRORS" COMMAND IS GIVEN.  IT IS
/  TO THE ADVANTAGE OF DECTAPE (AND PROBABLY ALSO
/  FLOPPY DISK) SYSTEMS TO USE SHORT ERROR MESSAGE
/  MODE TO REDUCE USR SWAPPING IF DOING MANY "FILE"
/  OR "SET DEVICE ...DDEV..." COMMANDS.

*10002	/MESSAGE ADDRESS AT ERROR CODE NUMBER +1 (AUTO-XR)

/LIST OF ADDRESSES OF ERROR MESSAGES

	ERMSA
	ERMSB
	ERMSC
	ERMS14
	ERMSD
	ERMSE
	ERMSG
	ERMSH
	ERMSI
	ERMSK
	ERMSJ
	ERMSXO
	ERMSL
	ERMSZ
	ERMSO
	ERMS11
	ERMS04
	ERMSP
	ERMSQ
	ERMSR
	ERMS09
	ERMS08
	ERMS13
	ERMSS
	ERMST
	ERMSU
	ERMSV
	ERMSW
	ERMSX
	ERMSY
	ERMSM
	ERMS00
	ERMS01
	ERMS02
	ERMS03
	ERMS10
	ERMSF
	ERMSGC
	ERMSHD
	ERMS05
	ERMS07
	ERMS18
	ERMS19
	ERMS20
	ERMS15
	ERMS16
EMSEND,	ERMS17
	ERMS99


/ERROR MESSAGES:

ERMSA,	TEXT &ILLEGAL SINGLE-WORD COMMAND&

ERMSB,	TEXT &ILLEGAL MULTI-WORD COMMAND&

ERMSC,	TEXT &TOO MANY ")"S&

ERMSD,	TEXT &ILLEGAL FORMAT WORD&

ERMSE,	TEXT &BAD FORMAT SYNTAX&

ERMSF,	TEXT &NO FILE FOR C.C.B./HEADER REQUEST&

ERMSGC,	TEXT &BAD C.C.B (NOT A SAVE FILE)&

ERMSHD,	TEXT &BAD HEADER (NOT A LOAD MODULE)&

ERMSG,	TEXT &ILLEGAL ITEM TO SHOW&

ERMSH,	TEXT &ILLEGAL SEARCH MODIFIER&

ERMSI,	TEXT &BAD SEARCH SYNTAX&

ERMSJ,	TEXT &ILLEGAL MODE&

ERMSK,	TEXT &SET OPTION FOLLOWED BY A CR, BAD SYNTAX&

ERMSXO,	TEXT &NUMBER OR ILLEGAL SET OPTION&

ERMSL,	TEXT &NUMBER OR ILLEGAL OUTPUT OPTION&

ERMSM,	TEXT &ILLEGAL "." IN NAME (FILE OR DEVICE)&

ERMSO,	TEXT &ILLEGAL MODIFY FORMAT&

ERMSP,	TEXT &PROGRAM OR HARDWARE PROBLEM&

ERMSQ,	TEXT &BAD TERMINATOR IN SINGLE ARGUMENT&

ERMSR,	TEXT &TERMINATOR BEFORE LEGAL NUMBER INPUT&

ERMSS,	TEXT &BAD TERMINATOR IN MULTIPLE ARGUMENT&

ERMST,	TEXT &ILLEGAL CHARACTER IN EXPRESSION&

ERMSU,	TEXT &ILLEGAL USE OF "(" IN EXPRESSION&

ERMSV,	TEXT &ILLEGAL OPERATOR IN EXPRESSION&

ERMSW,	TEXT &TOO FEW ")"S IN EXPRESSION&

ERMSX,	TEXT &DIVISION BY 0 ATTEMPTED&

ERMSY,	TEXT &UNKNOWN HANDLER NAME&

ERMSZ,	TEXT &NUMBER OR ILLEGAL ERROR OPTION&

ERMS01,	TEXT &NON-&
	*.-1

ERMS00,	TEXT &FATAL READ ERROR&

ERMS03,	TEXT &NON-&
	*.-1

ERMS02,	TEXT &FATAL WRITE ERROR&

ERMS04,	TEXT &ODD START LOC OR COUNT IN OS/8 MODIFY&

ERMS05,	TEXT &BAD ADDRESS/OVERLAY (ODT COMMANDS)&

/ERMS06,

ERMS07,	TEXT &BAD ADDRESS/OVERLAY (MODIFY)&

ERMS08,	TEXT &ARGUMENT EXPRESSION NOT TERMINATED BY ")"&

ERMS09,	TEXT &ILLEGAL DIGIT&

ERMS10,	TEXT &DUMP HANDLER ERROR&

ERMS11,	TEXT &NUMBER OR ILLEGAL DMODE OPTION&

/ERMS12,

ERMS13,	TEXT &ILLEGAL USE OF ' OR "&

ERMS14,	TEXT &MAPPED MODE--USE LIST, NOT DUMP&

ERMS15,	TEXT &NO ERROR MESSAGES&

ERMS16,	TEXT &INPUT ERROR ON MESSAGES&

ERMS17,	TEXT &EOF ON BATCH INPUT&

ERMS18,	TEXT &ENTER FAILED&

ERMS19,	TEXT &CLOSE FAILED&

ERMS20,	TEXT &DUMP FILE OVERRUN&

ERMS99,	TEXT &DEBUG&
*12000	/BEGIN ABOVE THE USR AREA

/GCCB & GHDR--ROUTINES TO READ IN THE FIRST BLOCK OF THE
/  LAST FILE SPECIFIED BY THE LAST "FILE" COMMAND, ASSUM-
/  ING THAT IT WAS A SAVE FILE OR LOAD MODULE, AND DO THE
/  FEW CHECKS THAT ARE AVAILABLE TO TEST FOR A CCB (CORE-
/  CONTROL-BLOCK) OR HEADER BLOCK BEFORE LETTING THE DATA
/  BE USED FOR THE APPROPRIATE PURPOSE.

GCCB,	0	/GET CORE-CONTROL-BLOCK
	JMS CCBHDR	/DO COMMON TEST & READ-IN
	CLL RAL		/ADJUSTS FOR 128K INDICATOR BIT
	STL RAR
	SMA CLA		/1ST WORD (-# SEGS) NEG?
	JMP GCCERR	/ NO, CAN'T BE CCB
	TAD I (CCBB+3	/GET JOB STATUS WORD
	AND (200	/OVERLAY BIT SET (LINK)?
	SZA CLA		/ 0 = NO
	TAD (CCBB+140-1	/ 1 = YES, START ADDR-1
	CDF 0
	DCA I (OVLFLG	/NO = 0; YES = ADDR-1
	CDF 10
	TAD I (CCBB+1	/2ND WORD A "CDF CIF X0"?
	AND (7603
CIA
	TAD GCCCDF
	SZA CLA
GCCERR,	JMS ERROR1	/LOOKS BAD, JUST EXIT NOW!
	ISZ GETSWX	/LOOKS OK, 1ST TIME SINCE READ?
	JMP GCCB2	/NO, DON'T CHANGE THINGS AGAIN
	TAD (CCBB+140+3	/YES, POINT TO LENGTH WORDS
GCCB1,	DCA GHDR	/ TO CHANGE PAGES TO BLOCKS
	TAD GHDR	/GET A WORD - PAGES-V7C
	TAD (-6603	/V7C
	SNA CLA		/V7C
	JMP GCCB2	/ 0 = DONE
	TAD I GHDR	/V7C
	IAC		/ROUND DOWN IN 2 STEPS FOR PDP-8
	CLL RAR
	DCA I GHDR	/STORE A WORD - BLOCKS
	TAD GHDR	/UPDATE POINTER TO NEXT
	TAD (4
	JMP GCCB1
/
GCCB2,	DCA GETSWX	/BE SURE SWITCH STAYS CLEAR
	TAD I SEGNI	/GET -# SEGMENTS
	CLL RAL
	STL RAR		/ADJUSTS FOR 128K INDICATOR BIT
GCCCDF,	CDF CIF 0
	JMP I GCCB	/OK, RETURN VALUE

GHDR,	0	/GET HEADER BLOCK (FORTRAN IV)
	TAD (3		/TO SET UP CCBB+6
	JMS CCBHDR	/DO COMMON TEST & READ-IN
	TAD (-2		/1ST WORD MUST BE EXACTLY 2
	SZA CLA
	JMP HDRERR	/ NO, CAN'T BE A HEADER
	ISZ GETSWX	/1ST TIME THRU SINCE READ?
	JMP GHDR1	/ NO, DON'T CHANGE ANYTHING
	DCA I (CCBB+47	/YES, BE SURE THESE WORDS
	DCA I (CCBB+50	/ ARE 0 FOR USERS
	TAD I (CCBB+1	/GET START FIELD WORD
	SNA
	JMP HDRERR	/ SHOULD BE 1 THRU 7
	CLL RTL		/LOOKS OK, MOVE FIELD TO BITS
	RAL		/ 6-8 TO HELP "SHOW HEAD"
	DCA I (CCBB+1
	TAD I (CCBB+1	/ARE THESE ONLY BITS SET?
	AND (7707
	SZA CLA
	JMP HDRERR	/ NO, SOMETHING MUST BE BAD
	TAD I (CCBB+3	/OK, TEST FIELD OF NEXT FREE
	SNA
	JMP HDRERR	/ SHOULD BE 1 THRU 7
	AND (7770
	SZA CLA
HDRERR,	JMS ERROR1
GHDR1,	DCA GETSWX	/MAKE SURE THIS IS 0
	NOP		/AC NON-ZERO FOR OK-V7C
	CDF CIF 0
	JMP I GHDR	/OK, BACK TO USER

CCBHDR,	0
	TAD (CCBB+3	/CCBB+6 FOR GHDR
	CDF 0
	DCA I (GETPNT	/SET UP POINTER FOR 'GET'
	TAD I (DEVAD	/GET ADDR OF DEVICE
	DCA DEVADX	/ HANDLER & SAVE HERE
	TAD I (RBLK1	/GET START BLOCK NUMBER
	SNA
ERCF,	JMS ERROR1	/ NO FILE!!! GIVE ERROR
	CDF 10
	DCA GCCBLK	/OK, SET UP 1ST BLOCK
	TAD I SEGNI	/IS SOMETHING IN MEMORY?
	SZA
	JMP I CCBHDR	/ YES, RETURN 1ST WORD
	CIF 0
	JMS I DEVADX	/NO, READ 1ST BLOCK OF FILE
	  0110		/READ; 1 PAGE; FIELD 1
SEGNI,	  CCBB		/BUFFER IS HERE
GCCBLK,	  0		/BLOCK NUMBER
	  JMP RDERX	/...BAD NEWS...
	STA
	DCA GETSWX	/OK, SET "JUST READ" SWITCH
	TAD I SEGNI	/AND GET 1ST WORD
	JMP I CCBHDR
/
RDERX,	CDF CIF 0	/RETURN TO FIELD 0
	JMP I (RERROR	/ FOR READ ERROR

DEVADX,	0
GETSWX,	0


MSMOD,	TEXT "  MOD"

MSBAD,	TEXT " BAD BLOCK"


PAGE
/CONTINUATION OF OUTPUT COMMANDS AND ROUTINES FROM FIELD 0

/CONTINUATION OF 'SET' 'DDEV' HANDLER

XDDEV1,	DCA DDEVAD	/SET UP HANDLER ADDRESS
	TAD I (GDEV2
	DCA DDEVNO	/ AND DEVICE NUMBER
	CDF 10
	TAD DDEVNO	/LOOK AT DCW FOR SPECIFIED
	TAD (7760-1	/ DEVICE TO SEE IF FILE
	DCA DDCWPT	/ STRUCTURED.
	TAD I DDCWPT	/BIT 0 = 1 FOR FILES
	SMA CLA
	TAD (212	/ NO, LINE-AT-A-TIME
	DCA DDEVS	/ YES, BLOCK-AT-A-TIME
	TAD DMPADR	/OK, INITIALIZE OUTPUT POINTER
	DCA DMPPTR
	DCA XOSIZ	/ AND ZERO BLOCK COUNTER
	DCA DNAM	/ AND CLEAR ANY FILE NAME
	IAC
	DCA DMPBLK	/ AND SET BLOCK NUMBER TO 1
	JMP XDDEV2	/LAST, GO SET UP NAME FOR OUTPUT


/CONTINUATION OF EXECUTION OF 'OPEN' COMMAND

XOPEN1,	TAD (NAM1-1	/SET UP POINTER TO FIELD 0 FILE
	DCA DPNT	/ NAME (NOTE: XR IN FIELD 1!!!)
	TAD I DPNT	/MOVE THE FILE NAME UP HERE
	DCA DNAM
	TAD I DPNT
	DCA DNAM+1
	TAD I DPNT
	DCA DNAM+2
	TAD I DPNT	/GET THE EXTENSION PART
	ISZ I (TEMP1	/ WAS ANYTHING REALLY SPECIFIED?
	JMP XOPEN2
	CLA
	TAD (0425	/  NO, DEFAULT TO ".DU"
XOPEN2,	DCA DNAM+3
	TAD XCLNAM	/SET UP POINTER TO NAME FOR USR
	DCA XOBLK
	CDF 10		/SET UP RETURN FIELD
	TAD I DDCWPT	/CLEAR ANY OPEN FILE ON
	AND (7770	/ THIS DEVICE SO "OPEN"
	DCA I DDCWPT	/ CAN BE DONE WHENEVER!
	CIF 0		/SET UP SUBROUTINE FIELD
	TAD DDEVNO	/GET DUMP DEVICE NUMBER
	JMS USEUSR	/ AND GO GET USR & CALL IT.
	  3		/ENTER
XOBLK,	  0	/NAME POINTER, BECOMES START BLK
XOSIZ,	  0	/ BECOMES -# BLOCKS CAN USE
ERC18,	  JMS ERROR1	/THE ENTER FAILED!
	TAD XOBLK	/OK! SET UP FILE START BLOCK
	DCA DMPBLK
	TAD DMPADR	/INITIALIZE POINTER
	DCA DMPPTR
XOCEX,	CDF CIF 0
	JMP MAIN1	/TRY NEXT COMMAND

DDEVAD,	7607	/INIT ADDRESS TO "SYS:" (SEE ABOVE)
DDEVNO,	1	/INIT THIS TO "SYS:" ALSO.
DDCWPT,	7760	/ THIS ALSO

DNAM,	0	/DUMP FILE NAME, INIT TO NULL
	0
	0
	0	/(EXTENSION HERE)


/CONTINUATION OF EXECUTION OF 'CLOSE' COMMAND

XCLOS1,	TAD DNAM	/IS ANY FILE OPEN?
	SNA CLA
	JMP XOCEX	/ NO, IGNORE COMMAND
	TAD XCTLZ	/ YES, OUTPUT A CTRL-Z
	JMS DMPOUT	/  AND FILL TO END
XCTLZ,	  "Z-100
	TAD XOBLK	/OK, CALCULATE FILE SIZE
	CIA
	TAD DMPBLK	/= NEXT - START
	DCA XCLSIZ	/= FILE SIZE IN BLOCKS
	TAD DDEVNO	/GET DUMP DEVICE NUMBER
	CIF 0
	JMS USEUSR	/GET USR AND CALL IT
	  4		/CLOSE
XCLNAM,	  DNAM		/POINTER TO FILE NAME
XCLSIZ,	  0		/SIZE OF NEW FILE
ERC19,	  JMS ERROR1	/OH NO! CLOSE FAILED!
	DCA DNAM	/OK, ZAP KNOWLEDGE OF FILE
	JMP XOCEX


DMPOUT,	0	/DUMP FILE CHARACTER OUTPUT ROUTINE
	DCA DMPCHR	/SAVE THE CHARACTER
	TAD DMPCHR	/PUT IT INTO FILE BUFFER
	CDF 10		/(MUST BE SURE!)
DMPNUL,	DCA I DMPPTR	/INSERT AN 8 BIT CHAR
	ISZ DMPPTR
	TAD DMPPTR	/NOW AT END OF BUFFER?
	TAD (-DMPBUF-400
	SNA CLA
	JMP DMPIT	/ YES, DUMP BUFFER NOW
	TAD DMPCHR	/NO, FILL FOLLOWING THIS CHAR?
	CIA
	TAD I DMPOUT	/(THE TEST CHAR @ CALL+1)
	SNA CLA
	JMP DMPNUL	/ YES, FILL WITH NULLS!
	JMP I DMPOUT	/  NO, EXECUTE FILL CHAR
/
DMPIT,	CIF 0
	JMS I DDEVAD	/CALL DUMP FILE HANDLER
	  4210		/WRITE, 2 PAGES, FIELD 1
DMPADR,	  DMPBUF
DMPBLK,	  1		/BLOCK NUMBER
ERC10,	  JMS ERROR1	/ERROR ON OUTPUT FILE!
	TAD DMPADR	/NOW RESET OUTPUT POINTER
	DCA DMPPTR
	ISZ DMPBLK	/INCREMENT BLOCK NUMBER
	ISZ XOSIZ	/ANY MORE SPACE LEFT?
	JMP I DMPOUT	/ YES, EXIT NOW
	DCA DNAM	/  NO! ZAP DUMP FILE
ERC20,	JMS ERROR1	/   AND DIE!
DMPCHR,	0
DMPPTR,	0	/CHARACTER OUTPUT POINTER


PAGE
/CONTINUATION OF ROUTINE TO OUTPUT A CHAR TO A DEVICE

TYPE1,	TAD I (DMODE	/TTY= NONE, PART&-DSWIT, ALL
	AND I (DSWIT	/ SO TEST FOR PART&DSWIT
	SZA CLA
	JMP TYPE2	/NO OUTPUT TO TTY
	TAD I (RTL6	/GET CHARACTER TO OUTPUT
TYPEB,	NOP		/***	CDF 10		/*** BATCH
	TSF		/***	CIF BAT		/*** CHANGES
	JMP .-1		/***	JMS I .+1	/*** LOG
	TLS		/***	  7400		/*** OUTPUT
	CLA		/***	CDF 0
TYPE2,	STL CLA RAR	/=4000 (SET AC BIT 0 FOR TEST)
	TAD I (DSWIT	/=4000 OR 4001 (DSWIT=1)
	AND I (DMODE	/FILE= PART&DSWIT OR ALL
	SNA CLA
	JMP TYPE3	/ OUTPUT TO TTY ONLY
	TAD DDEVS	/FILE STRUCTURED OUTPUT?
	CDF 10
	SNA
	TAD I (DNAM	/ YES, FILE OPEN?
	CDF 0
	SNA CLA
	JMP TYPE3	/  NO TO EITHER
	TAD I (RTL6	/OK, GET CHARACTER TO OUTPUT
	JMS DMPOUT	/OUTPUT IT & TEST FOR END
DDEVS,	  0		/TEST: 0=FILE, 212= NON-FILE
TYPE3,	CDF CIF 0
	JMP TYPEX	/BACK AND OUT


ERROR1,	0	/FIELD 1 ERROR ROUTINE HEAD
	CLA		/CLEAR POSSIBLE JUNK IN AC
	TAD ERROR1	/MOVE RETURN ADDR TO FIELD 0
	CDF CIF 0
	DCA I (XERROR
	JMP I (XERROR+1


XDDEV2,	CDF 0		/NAME IS OVER THERE
	TAD I (NAM1	/MOVE DEVICE NAME INTO STRING
	DCA XDDNAM	/ IN THIS FIELD FOR "SHOW DDEV"
	TAD I (NAM2
	DCA XDDNAM+1
	CDF CIF 0
	JMP XSETN	/BACK TO 'SET'

MSDDEV,	TEXT "@DDEV = SYS@"
XDDNAM=	.-3

MSDEV,	TEXT "@DEVICE = SYS@"

XDNAM=	.-3	/ADDR OF 1ST WORD OF DEVICE NAME

/CONTINUATION OF CODE FROM FIELD 0

XDEVM,	DCA XDNAM	/SET 4 DEVICE NAME CHARS IN
	TAD I (NAM2	/ OUTPUT MESSAGE
	DCA XDNAM+1
	CDF 10
	DCA I (CCBB	/NO C.C.B. OR HEADER PRESENT
	CDF CIF 0
	STA
	DCA I (RBLK	/RESET BLOCK NUMBER
	JMP XSETN	/GO DO NEXT OPTION


MSERR,	TEXT " ERROR CODES: FUTIL "
	*.-1

/VERSION NUMBER MESSAGE--THE FOLLOWING CODE INSERTS THE
/  VERSION NUMBER AND PATCH LEVEL SET NEAR THE START OF
/  THE SOURCE INTO THE VERSION MESSAGE.

MSVER,	TEXT "VERSION = ???"	/VERS = 2 DIGITS, PATCH = 1
	*.-2
VERTEN=	VERSION%12		/TENS DIGIT
VERONE=	-VERTEN^12+VERSION	/ONES DIGIT
	VERTEN^100+VERONE+6060	/INSERT TWO DIGITS
	PATCH^100		/INSERT PATCH + NULL TERM

/ALPHA MONTH NAMES PLUS DUMMIES FOR PDATE SUBROUTINE

MONTHS,	TEXT " 00@JAN@FEB@MAR@APR@MAY@JUN@JUL"
	TEXT "AUG@SEP@OCT@NOV@DEC@ 13@ 14@ 15"


PAGE
/SYMBOLICS FOR PDP-8 INSTRUCTIONS:
INSLST,	TEXT  "AND TAD ISZ DCA JMS JMP IOT NOP "
	*.-1

/ GROUP 1 MICRO-INSTS.:
OP1LST,	TEXT  "CLL CMA CML IAC BSW RAL RTL RAR RTR "
	*.-1


/ GROUP 2 MICRO-INST'S:
OP2LST,	TEXT  "SMA SZA SNL SKP SPA SNA SZL OSR HLT "
	*.-1

/ EAE MICRO-INST'S:
EAELST,	TEXT  "MQA MQL SCL MUY DVI NMI SHL ASR LSR SCA "
	*.-1
	TEXT  "DAD DST SWBADPSZDPICDCM SAM "
	*.-1

CLANAM,	0314  /"CLA "
	0140

OPRMES,	1720  /"OPR "
	2240
/ IOT INSTRUCTIONS:

IOTTAB,	6000
	TEXT "SKON"
	6001
	TEXT "ION@"
	6002
	TEXT "IOF@"
	6003
	TEXT "SRQ@"
	6004
	TEXT "GTF@"
	6005
	TEXT "RTF@"
	6006
	TEXT "SGT@"
	6007
	TEXT "CAF@"
	6010
	TEXT "RPE@"
	6011
	TEXT "RSF@"
	6012
	TEXT "RRB@"
	6014
	TEXT "RCF@"
	6016
	TEXT "RCC@"
	6020
	TEXT "PCE@"
	6021
	TEXT "PSF@"
	6022
	TEXT "PCF@"
	6024
	TEXT "PPC@"
	6026
	TEXT "PLS@"
	6030
	TEXT "KCF@"
	6031
	TEXT "KSF@"
	6032
	TEXT "KCC@"
	6034
	TEXT "KRS@"
	6035
	TEXT "KIE@"
	6036
	TEXT "KRB@"
	6040
	TEXT "TFL@"
	6041
	TEXT "TSF@"
	6042
	TEXT "TCF@"
	6044
	TEXT "TPC@"
	6045
	TEXT "TSK@"
	6046
	TEXT "TLS@"
	6100
	TEXT "DPI@"
	6101
	TEXT "SMP@"
	6102
	TEXT "SPL@"
	6103
	TEXT "EPI@"
	6104
	TEXT "CMP@"
	6105
	TEXT "S,CMP"
	6106
	TEXT "CEP@"
	6107
	TEXT "SPO@"
	6110
	TEXT "RCTV"
	6111
	TEXT "RCRL"
	6112
	TEXT "RCRH"
	6113
	TEXT "RCCV"
	6114
	TEXT "RCGB"
	6115
	TEXT "RCLC"
	6116
	TEXT "RCCB"
	6130
	TEXT "CLZE"
	6131
	TEXT "CLSK"
	6132
	TEXT "CLOE"
	6133
	TEXT "CLAB"
	6134
	TEXT "CLEN"
	6135
	TEXT "CLSA"
	6136
	TEXT "CLBA"
	6137
	TEXT "CLCA"
	6201
	TEXT "CDF 00"
	*.-1
	6211
	TEXT "CDF 10"
	*.-1
	6221
	TEXT "CDF 20"
	*.-1
	6231
	TEXT "CDF 30"
	*.-1
	6241
	TEXT "CDF 40"
	*.-1
	6251
	TEXT "CDF 50"
	*.-1
	6261
	TEXT "CDF 60"
	*.-1
	6271
	TEXT "CDF 70"
	*.-1
	6202
	TEXT "CIF 00"
	*.-1
	6212
	TEXT "CIF 10"
	*.-1
	6222
	TEXT "CIF 20"
	*.-1
	6232
	TEXT "CIF 30"
	*.-1
	6242
	TEXT "CIF 40"
	*.-1
	6252
	TEXT "CIF 50"
	*.-1
	6262
	TEXT "CIF 60"
	*.-1
	6272
	TEXT "CIF 70"
	*.-1
	6203
	TEXT "CDIF00"
	*.-1
	6213
	TEXT "CDIF10"
	*.-1
	6223
	TEXT "CDIF20"
	*.-1
	6233
	TEXT "CDIF30"
	*.-1
	6243
	TEXT "CDIF40"
	*.-1
	6253
	TEXT "CDIF50"
	*.-1
	6263
	TEXT "CDIF60"
	*.-1
	6273
	TEXT "CDIF70"
	*.-1
	6204
	TEXT "CINT"
	6214
	TEXT "RDF@"
	6224
	TEXT "RIF@"
	6234
	TEXT "RIB@"
	6244
	TEXT "RMF@"
	6254
	TEXT "SINT"
	6264
	TEXT "CUF@"
	6274
	TEXT "SUF@"
	6550
	TEXT "FFST"
	6551
	TEXT "FPINT"
	6552
	TEXT "FPICL"
	6553
	TEXT "FPCOM"
	6554
	TEXT "FPHLT"
	6555
	TEXT "FPST"
	6556
	TEXT "FPRST"
	6557
	TEXT "FPIST"
	6561
	TEXT "FMODE"
	6563
	TEXT "FMRB"
	6564
	TEXT "FMRP"
	6565
	TEXT "FMDO"
	6567
	TEXT "FPEP"


NXTIOT,	ZBLOCK 200	/LEAVE ROOM FOR EXPANSION

	0		/TABLE TERMINATOR


/CODES MAY BE ADDED TO THE TABLE IN THE SPACE LEFT BY THE
/  "ZBLOCK 200".  SINCE EACH ENTRY REQUIRES 4 WORDS (THE
/  ACTUAL CODE IN THE FIRST WORD AND UP TO 6 PACKED ASCII
/  CHARACTERS IN THE NEXT THREE WORDS, PADDED WITH TRAIL-
/  ING 0'S), THERE IS ROOM FOR 40 OCTAL (32 DECIMAL) IOTS
/  AND THEIR NAMES.  THESE CAN BE PATCHED IN DIRECTLY
/  USING THE PROGRAM ITSELF.  **** NOTE THAT THE CONTENTS
/  OF LOCATION 10000 POINT TO THE FIRST FREE ENTRY. ****
/SYMBOLICS FOR FPP-12/8A INSTRUCTIONS

MSBASE,	TEXT "  B+"

MSINDI,	TEXT "% B+"

MSJNX,	TEXT "JNX  "

/THE FOLLOWING STRINGS ARE PADDED WITH "@"S IN PROPER
/  PLACES TO FORCE WORD ALIGNMENT AS NEEDED.

	TEXT "LEA@"	/+1 WORD 0000
FPPINS,	TEXT "FLDA@@FADD@@FSUB@@FDIV"
	TEXT "FMUL@@FADDM@FSTA@@FMULM"

	TEXT "UNUSEDSTARTE"
	*.-1
FPOP00,	TEXT "FNOP@@FEXIT@FPAUSEFCLA@@FNEG"
	TEXT "FNORM@STARTFSTARTDJAC@@"

FPXR1S,	TEXT "ALN ATX XTA "

FPXR2S,	TEXT "ADDX *,@LDX *,@"

FOP134,	TEXT "TRAP4 TRAP3 SETX  SETB  JSA  @JSR  "

FPCOND,	TEXT "EQGELEA@NELTGTAL"


/CONTROL TABLES FOR FPP INSTRUCTION DECODING

FPPMO0,	7	/MAJOR SUB-OP-CODE OF SPECIALS
	6
	5
	4
	3
	2
	1
	0	/END & FALL-OUT POINT

FPPMOJ,	SPCOP7
	SPCOP6
	SPCOP5
	SPCOP4
	SPCOP3
	SPCOP2
	SPCOP1

FPPOP0,	170	/MINOR SUB-OP-CODE OF SUB-OP-CODE
	160	/ 0 SPECIALS
	150
	140
	130
	120
	110
	100
	70
	60
	50
	40
	30
	20
	10
	00

FPPOPJ,	SPNUSE	/ALL UNUSED POSSIBILITIES
	SPNUSE
	SPNUSE
	SPNUSE
	SPNUSE
	SPNUSE
	SPOP11
	SPOP10
	SPNUSE
	SPNUSE
	SPOP05
	SPOP04
	SPO123
	SPO123
	SPO123
/MESSAGES:

MS01,	TEXT " =  "

MS07,	0023  /"SMASK = "
MS02,	TEXT    "MASK = "

MS03,	TEXT "ABS. LOC = "

MS04,	TEXT "UPPER = "

MS05,	TEXT "LOWER = "

MS06,	TEXT "FORMAT = "

MS08,	TEXT "DIRECTORY"

MS09,	TEXT "OFFSET = "

MS10,	TEXT "MODE = "

MS11,	TEXT "CCB:"

MS12,	TEXT "ODT  LOC = "

MS13,	TEXT ":   "

MS14,	TEXT "  CORE SEGS:   "

MS15,	TEXT "LOOKUP FAILED"

MS16,	TEXT "FPP"

MS17,	TEXT " AT "

MS18,	TEXT "  SA = "

MS19,	TEXT ",  JSW = "

MS20,	TEXT "REL. LOC = "

MS21,	TEXT "PACKED"

MS22,	TEXT "ASCII"

MS23,	TEXT "OS/8"

MS24,	2516  /"UNSIGNED"

MS25,	TEXT "SIGNED"

MS26,	TEXT "OCTAL"

MS27,	TEXT "OFFSET"

MS28,	TEXT "SAVE"

MS29,	TEXT "NORMAL"

MS30,	TEXT "OUTPUT = "

MS31,	TEXT "PDP"

MS32,	TEXT "BLOCK = "

MS33,	TEXT ")  "

MS34,	TEXT "LOAD"

MS35,	TEXT "BCD"

MS36,	TEXT "BYTE"

MS37,	TEXT "FILLER = "

MS38,	TEXT "HEADER:"

MS39,	TEXT ", NEXT WORD = "

MS40,	TEXT ", LOAD V "

MS41,	TEXT ", E.P. REQ'D"

MS42,	TEXT "  OVLYS START BLOCK LENGTH"

MS43,	TEXT "XS240"
/MAIN LOOP CHARACTER LIST
CCHARL,	"#
	"$
	"%
	"&
	":
	"<
	"=
	">
	"?
	"@
	"[
	"\
	"]
	"/
	"!
	"+
	"-
	";
	"^
	"_
/'TYPE' COMMAND LIST
TYPEL,	211	/TAB
	233	/ALT MODES
	375
	376
/'XMODIF' CHECK LIST
TYPEM,	215	/CR
	212	/LF
	0

/ADDRESSES FOR 'OMODES'
OTABLE,	BPRT	/#
	OSTYPE	/$
	BYTEO	/%
	XS240O	/&
	SGNDP	/:
	OPRT	/<
	DPRT	/=
	PDPOUT	/>
	DIROUT	/?
	PDATE	/@
	ASCII	/[
	FPPOUT	/\
	PACOUT	/]

/MAIN LOOP JUMP LIST - RESPOND TO SPECIAL CHAR
COPSL,	OMODES
	OMODES
	OMODES
	OMODES
	OMODES
	OMODES
	OMODES	/SEE ABOVE LIST
	OMODES
	OMODES
	OMODES
	OMODES
	OMODES
	OMODES
	SLASH
	EXCL
	PLUS
	MINUS
	SEMIC
	UPARR
	BACKAR
	RESPC
	ALTMOD
	ALTMOD
	ALTMOD
	CRCR
	LFLF

/'TYPE' JUMP LIST
TYPEOP,	TYPTAB
	TYPALT
	TYPALT
	TYPALT
	TYPCR
	TYPCR+1

/COMMAND WORD LIST FOR COMMANDS NOT FOLLOWED BY CR
CWORDL,	TEXT "EVE@DUD@LIL@FIF@OPSCSTSMWOW@MOM@SHSES@WRIFEXCOC@"

/MAIN LOOP JUMP LIST - EXECUTE A COMMAND
WOPSL,	XVAL
	XVAL
	XDUMP
	XDUMP
	XLIST0
	XLIST0
	XFILE
	XFILE
	XOPEN
	XSCAN
	XSTRIN
	XSMASK
	XWORD
	XWORD
	XMODIF
	XMODIF
	XSHOW
	XSET
	XSET
	XWRARG
	XIF
	XEXIT
	MAIN1	/COMMENT
	MAIN1

/LISTS FOR COMMANDS FOLLOWED BY A CR.
CWORL2,	TEXT "REWRENEXCLCOC@"

WOPSLL,	XREWIN	/REWIND
	XWRITE	/WRITE
	MAIN1	/END
	XEXIT	/EXIT
	XCLOSE	/CLOSE
	MAIN1	/COMMENT
	MAIN1
/'XFORM' LISTS  ----ORDER IS CRITICAL----
FORML,	TEXT "PAP@ASA@OSOSXSX@UNU@SIS@OCO@BCB@BYBYPDPDFPF@DID@"

FOPSL,	XFCHR	/PACKED (ASCII)
	XFCHR
	XFCHR	/ASCII
	XFCHR
	XFCHR	/OS/8 (ASCII, PACKED)
	XFCHR
	XFCHR	/XS240 (ASCII, PACKED)
	XFCHR
	XFNUM	/UNSIGNED (DECIMAL)
	XFNUM
	XFNUM	/SIGNED (DECIMAL)
	XFNUM
	XFNUM	/OCTAL
	XFNUM
	XFNUM	/BCD
	XFNUM
	XFNUM	/BYTE (OCTAL)
	XFNUM
	XFSYM	/PDP (SYMBOLIC)
	XFSYM
	XFSYM	/FPP (SYMBOLIC)
	XFSYM
	XFSYM	/DIRECTORY
	XFSYM

/  ROUTINE ADDRESS LIST

FTABLE,	PACOUT
	ASCII
	OSTYPE
	XS240O
	DPRT
	SGNDP
	OPRT
	BPRT
	BYTEO
	PDPDMP
	FPPDMP
	DIRDMP

/'XSHFMT' DESCRIPTOR ADDRESS LIST
FMTLS,	MS21	/PACKED ASCII
	MS22	/ASCII
	MS23	/OS/8 ASCII
	MS43	/XS240 ASCII
	MS24	/UNSIGNED DECIMAL
	MS25	/SIGNED DECIMAL
	MS26	/OCTAL
	MS35	/BCD
	MS36	/BYTE
	MS31	/PDP SYMBOLIC
	MS16	/FPP SYMBOLIC
	MS08	/DIRECTORY


/'XMODIF' COMMAND LIST
MODIFL,	TEXT "PAP@ASA@OSXSNUN@"

/'XMODIF' JUMP LIST
MODIFO,	XPAC0	/PACKED
	XPAC0
	XASC1	/ASCII
	XASC1
	XOPS1	/OS/8
	XXS20	/XS240
	XNUM2	/NUMERIC
	XNUM2

MODADS,	XMOD0	/MODIFL TEST LIST
	XMOD0
	XMOD0
	XMOD0
	XMOD0
	XMOD0
	XMOD0
	XMOD0
	XMOD0

MODDLS,	TEXT "PAASOSXSNUNUNUNUNUNUNUNU" /DEFAULT LIST

/'XMODIF' CHARACTER JUMP LIST
MCHARO,	XMODCR	/CR, END
	RENEXT	/LF, IGNORE

/'XIF' CHARACTER JUMP LIST
IFSKPO,	XIFCR	/CR, END OF LINE
	RENEXT	/LF, IGNORE

/XNUM JUMP LIST
NUMOPS,	XNUM1	/,
	ERCQ	/:
	ERCQ	/.
	XNUM1+1	/SPACE
	XNUM3	/CR
/'XSHOW' COMMAND LIST
SHOWL,	TEXT "BLB@ODCCC@HEH@ABA@RER@SMVE"
	*.-1
/'XSET' COMMAND LIST
SETLST,	TEXT "DDFOF@OUO@ERE@OFUPLOTEDEDMMOFIMAM@

/'XSHOW' JUMP LIST
SHOWOP,	XSHBLK	/BLOCK
	XSHBLK
	XSHODL	/ODT LOC
	XSHCCB	/CCB (CORE CONTROL BLOCK)
	XSHCCB
	XSHHDR	/HEADER (F4 LOAD MODULE)
	XSHHDR
	XSHABS	/ABS. LOC
	XSHABS
	XSHREL	/REL. LOC
	XSHREL
	XSHSMS	/SMASK
	XSHVER	/VERSION
	XSHDDEV	/DDEV
	XSHFMT	/FORMAT
	XSHFMT
	XSHOUT	/OUTPUT
	XSHOUT
	XSHERR	/ERRORS
	XSHERR
	XSHOFF	/OFFSET
	XSHUPP	/UPPER
	XSHLOW	/LOWER
	ERCG	/TEMP--NOT ALLOWED FOR SHOW
	XSHDEV	/DEVICE
	ERCG	/DMODE--NOT ALLOWED FOR SHOW
	XSHMOD	/MODE
	XSHFIL	/FILLER
	XSHMSK	/MASK
	XSHMSK

/'XSET' JUMP LIST
SETJMP,	XDDEV	/DDEV (DUMP DEVICE)
	XFORM	/FORMAT
	XFORM
	XOUTS	/OUTPUT
	XOUTS
	XEMODE	/ERROR (MODE)
	XEMODE
	XOFFS	/OFFSET
	XUPP	/UPPER
	XLOW	/LOWER
	XTEMP	/TEMP
	XDEV	/DEVICE
	XDMODE	/DMODE (DUMP MODE)
	XMODE	/MODE
	XFILL	/FILLER
	XMASK	/MASK
	XMASK

/'XEMODE' COMMAND LIST
XELST,	TEXT "SHS@LOL@"

/'XEMODE' BRANCH LIST
XEOPS,	XEMOD1		/SHORT
	XEMOD1
	XEMOD1+1	/LONG
	XEMOD1+1

/'XOUTS' LISTS
XOLST,	TEXT "FPF@PDP@OCO@"

XOOPS,	XOUTS1-1	/FPP SYMBOLIC
	XOUTS1-1
	XOUTS1		/PDP SYMBOLIC
	XOUTS1
	XOUTS1+1	/OCTAL
	XOUTS1+1

/'XMODE' COMMAND LIST
MODLST,	TEXT "OFO@SAS@LOL@NON@"

/'XMODE' JUMP LIST
MODOPS,	XMODS-1	/OFFSET
	XMODS-1
	XMODS+1	/SAVE FILE
	XMODS+1
	XMODS	/LOAD MODULE
	XMODS
	XMODS+2	/NORMAL
	XMODS+2

/'XDMODE' LISTS
XDMLST,	TEXT "ALPANO"

XDMOPS,	XDMODS-1	/ALL
	XDMODS		/PART
	XDMODS+1	/NONE


/LIST OF DESCRIPTOR ADDRESSES FOR "SHOW MODE"

	MS27	/-1 = "OFFSET"
MODELS,	MS29	/ 0 = "NORMAL"
	MS28	/+1 = "SAVE"
	MS34	/+2 = "LOAD"


/LIST OF DESCRIPTOR ADDRESSES FOR "SHOW OUTPUT"

	MS16	/-1 = "FPP (SYMBOLIC)"
OUTLS,	MS26	/ 0 = "OCTAL"
	MS31	/+1 = "PDP (SYMBOLIC)"


/'XWORD' COMMAND LIST
XWORCL,	TEXT "UNU@"
	*.-1
/'XSTRIN' COMMAND LIST
STRLST,	TEXT "FRF@TOT@ABA@MAM@ME"


/'XWORD' JUMP LIST
XWOROP,	XWOR2	/UNEQUAL
	XWOR2
	XWSFRM	/FROM
	XWSFRM
	XWSTO	/TO
	XWSTO
	XWSABS	/ABSOLUTE
	XWSABS
	ERCH	/MASKED--NO!
	XWOR7	/MEMREF
	XWOR7

/'XSTRIN' JUMP LIST
STROPS,	XWSFRM	/FROM
	XWSFRM
	XWSTO	/TO
	XWSTO
	XWSABS	/ABSOLUTE
	XWSABS
	XSTR0	/MASKED
	XSTR0
	ERCH	/MEMREF--NO!
/LIST OF TERMINATORS, IN ORDER, FOR 'EVAL'
TERMS,	"!  /1
	"&  /2
	"+  /3
	"-  /4
	"/  /5
	"*  /6
	"(  /7
	")  /10
	215	/CR: 11
	0

/'GWORD' & 'ACCEPT' COMMAND LISTS
GWLST1,	"9
	"8
	"7
	"6
	"5
	"4
	"3
	"2
	"1
	"0
	204	/^D
	213	/^K
	""
	"'
	"(
GWLST2,	240	/SPACE
	215	/CR
	0

/'GWORD' JUMP LISTS
GWOPS1,	GWD4	/ 9 - A NUMBER
	GWD4	/ 8 - A NUMBER
	GWD4	/ 7 - A NUMBER
	GWD4	/ 6 - A NUMBER
	GWD4	/ 5 - A NUMBER
	GWD4	/ 4 - A NUMBER
	GWD4	/ 3 - A NUMBER
	GWD4	/ 2 - A NUMBER
	GWD4	/ 1 - A NUMBER
	GWD4	/ 0 - A NUMBER
	GWD4	/^D - A NUMBER
	GWD4	/^K - A NUMBER
	GWD4	/ " - A NUMBER
	GWD4	/ ' - A NUMBER
	GWD4	/ ( - A NUMBER
GWOPS2,	GWD2	/SPACE - TERMINATOR
	GWD3	/  CR  -     "

/'ACCEPT' JUMP LIST
ACOPS,	ACCNUM	/ 9 - A DIGIT
	ACCNUM	/ 8 - A DIGIT
	ACCNUM	/ 7 - A DIGIT
	ACCNUM	/ 6 - A DIGIT
	ACCNUM	/ 5 - A DIGIT
	ACCNUM	/ 4 - A DIGIT
	ACCNUM	/ 3 - A DIGIT
	ACCNUM	/ 2 - A DIGIT
	ACCNUM	/ 1 - A DIGIT
	ACCNUM	/ 0 - A DIGIT
	CTRLD	/ ^D SWITCH
	CTRLK	/ ^K SWITCH
	DQUOTE	/ " - SINGLE ASCII
	SQUOTE	/ ' - PACKED ASCII
	ERCR	/ ( - ILLEGAL HERE
	ACCPT3-2	/SPACE - END
	ACCPT3-1	/CR - END

/'GARGS' JUMP LIST - TERMINATORS
GAROPS,	GAR5	/-
	GAR6	/,
	ERCS	/:, SHOULDN'T SEE, WILL DO ERROR
	GAR4	/.
	ERCS	/SPACE, SHOULDN'T SEE, WILL DO 'ERROR'
	GAR3	/CR

/'GARGS' & 'ARG' COMMAND LISTS
GARLST,	"-
	",
GETLST,	":
ARGLST,	".
	240	/SPACE
	215	/CR
	0

/'GETNT' LISTS
GETOPS,	GETCOL
	GETPER
	GETEND
	GETEND+1

/'ARG' JUMP LIST
ARGOPS,	ARG2
	ARG3
	ARG3

/'WCHEK' LISTS
WCKLST,	"(
	")
	""
	"'
	215
	0

WCKOPS,	WCHEK5+1
	WCHEK5
	WCHEK6+1
	WCHEK6
	WCHEK4

/'EVAL' JUMP LIST 1
EVOPS1,	EVNEXT	/+
	EVMIN	/-
	EVLPAR	/(

/'EVAL' COMMAND LISTS
EVLST1,	"+
	"-
	"(
	0

EVLST2,	"L
	"B
	"S
	"C
	"F
	"R
	"T
	"D
	0

/'EVAL' JUMP LIST 2
EVOPS2,	EVLOC	/L (LOC)
	EVBLK	/B (BLK)
	EVSR	/S (S.R.)
	EVSR+1	/C (CONTENTS)
	EVFIL	/F (FILLER)
	EVREM	/R (REMAINDER)
	EVTEMP	/T (TEMP)
	EVDATE	/D (DATE)

/ACTION CHARS FOR "READLN" SUBROUTINE
REACTL,	"R-100	/CTRL-R = RE-ECHO
	"U-100	/CTRL-U = ERASE LINE
	0

REACTS,	RECHO
	RERASE
/ERROR ROUTINE ADDRESS LIST:

ERLIST,	ERCA
	ERCB
	ERCC
	ERC14
	ERCD
	ERCE
	ERCG
	ERCH
	ERCI
	ERCK
	ERCJ
	XSET1
	ERCL
	ERCZ
	ERCO
	ERC11
	ERC04
	ERCP
	ERCQ
	ERCR
	ERC09
	ERC08
	ERC13
	ERCS
	ERCT
	ERCU
	ERCV
	ERCW
	ERCX
	ERCY
	ERCM
	ERC00
	ERC01
	ERC02
	ERC03
	ERC10
	ERCF
	GCCERR
	HDRERR
	ERC05
	ERC07
	ERC18
	ERC19
	ERC20
	ERC15
	ERC16
	ERC17
	0


	DECIMAL

SMASKB,	-1		/STRING SEARCH MASK BUFFER
		/L(SMASKB)=66(10)
COMB=	SMASKB+66	/COMMAND INPUT BUFFER
		/L(COMB)= 140(10)
PDLB=	COMB+140	/PUSH-DOWN-LIST BUFFER
		/**** ALSO REWIND BUFFER! ****
	CCBB-PDLB	/SHOW PDL SPACE

	OCTAL


CCBB=	16400	/CORE-CONTROL-BLOCK BUFFER AND HEADER
		/ BUFFER FOR LOAD MODULES, 1 PAGE FIELD 1

DMPBUF=	16600	/DUMP OUTPUT BUFFER, 2 PAGES FIELD 1

IOBUF=	17200	/DEVICE I/O DUFFER, 2 PAGES FIELD 1


$$$$


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/KL8E.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805

/19 SUPER TTY HANDLER FOR OS/8
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975,1977,1978 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/

/S.W.,S.R.,H.J.,R.L.,S.R.

	*0

	-1
	IFNDEF SLU <SLU=0>
	IFZERO SLU <DEVICE KL8E;DEVICE TTY;0;TTY&177+4000;ZBLOCK 2>
	IFZERO SLU-2 <DEVICE SLU2;DEVICE SLU2;0;TTY&177+4000;ZBLOCK 2>
	IFZERO SLU-3 <DEVICE SLU3;DEVICE SLU3;0;TTY&177+4000;ZBLOCK 2>

/TWO-PAGE TELETYPE HANDLER FOR OS/8 V3.
/ON INPUT, RECOGNIZES ^Z, ^C, ^U, RUBOUT
/^Z	MEANS END OF INPUT, INSERT ^Z IN BUFFER,
/	PAD WITH ZEROES, AND ECHO "^Z"
/^C	MEANS ABORT JOB, RETURN TO OS/8 VIA LOC 7600 TO SAVE CORE AND PRINT "^C"
/^U	MEANS DELETE THE LAST LINE, ALLOW OPERATOR TO RETYPE
/	(LINE STARTS AT BEGIN OF BUFFER AND IS TERMINATED BY A CR)
/	A CR GETS ENTERED INTO BUFFER, CAUSES A LF TO ALSO ECHO
/	AND GET ENTERED INTO BUFFER, BUFFER IS THEN PADDED WITH NULLS.
/	CONVERTS LC TO UC

/ON OUTPUT RECOGNIZES ^C, ^O, ^S, ^Q FROM KEYBOARD
/^C	CAUSES JOB TO ABORT, RETURN TO OS/8 VIA LOCATION 7600
/	TO SAVE CORE AND PRINT "^C"
/^O	CAUSES ECHOING BY THE HANDLER TO CEASE
/	TYPING ANY OTHER CHARACTER RESUMES ECHOING.
/^S	CAUSES THE HANDLER TO STOP SENDING TO TERMINAL
/^Q	RESUMES HANDLER SENDING
/	^S AND ^Q ARE IGNORED  IN OTHER CASES

/WHENEVER PRINTING CHARACTERS (EITHER ON OUTPUT OR WHEN ECHOING),
/	IGNORES NULLS
/	FLAGS LC WITH AN APOSTROPHE
/	HANDLES TABS CORRECTLY (SEVERAL WAYS)
/	PRINTS ESCAPE AS $
/	DELAYS 16 MS AFTER LINEFEEDS
/	PRINTS CONTROL CHARACTERS AS "^K"

/DOES AUTOMATIC CR/LF AT END OF LINE WIDTH.

/MAINTENANCE RELEASE CHANGES:

/1.	ADDED KCC FOR NON-CONSOLE TELETYPES

/V3D CHANGES: (VERSION E)

/1.	ADDED DELAY OPTION FOR VT78
/2.	ADDED SCOPE RUBOUTS
/3.	CHANGED VT78 DEFAULTS
/4.	REARRANGED CODE FOR SET TTY ESC AND ARROW

/CHANGES FOR OS/78 V2

/1.	CHANGED KSF TO KKSF, ETC.
/	(DID NOT BUMP VERSION LETTER)
/2.	MADE CONDITIONALS FOR SLU2
	IFNDEF INDVC <INDVC=03>
	IFNDEF OUTDVC <OUTDVC=INDVC+1>

	KKSF=10^INDVC+6001
	KKCC=10^INDVC+6002
	KKRS=10^INDVC+6004
	KKRB=KKCC KKRS
	TTSF=10^OUTDVC+6001
	TTCF=10^OUTDVC+6002
	TTPC=10^OUTDVC+6004
	TTLS=TTCF TTPC

	TTYVERSION="E&77
/BUILD YOUR OWN TELETYPE HANDLER:

/THIS SOURCE HAS MUMBLE LOCATIONS LEFT.

/THE FOLLOWING CONDITIONALS ALLOW YOU TO INCLUDE OPTIONAL FEATURES.
/YOU MAY INCLUDE AS MANY OR AS FEW AS YOU DESIRE PROVIDED THERE
/IS ROOM LEFT.

/CONDITIONAL	LOCATIONS	LOCATIONS	INCLUDED
/VARIABLE	PAGE 1		PAGE 2		FEATURES

/ DELAY		 0		 7		DELAY AFTER GIVEN CHAR
/ CTRL	 	 0 		 3		PRINT CONTROL CHARS AS ^K
/ RUB		 0		 0		PRINT CHAR RUBBED OUT ON RUBOUTS
/ SIMTAB	 0		10		SIMULATE TABS AS SPACES
/ SLOTAB	 0		 6		PUT OUT 2 RUBOUTS AFTER A TAB
/ ESC		 0		10		PRINT ESCAPE AS $
/ FLAGLC	 0		12		FLAG LOWER CASE CHARS ON OUTPUT
/ CNVLC		 0		 7		CONVERT LOWER CASE ON INPUT TO UPPER CASE
/ ALTMOD	 0		11		CONVERT ALTMODES (175,176) TO ESCAPE (33)
/ PAUS		 0		20		PAUSE BETWEEN PAGES
/ FREE LOCS:	 2		33

	VT78=1		/SET TO 0 TO ALLOW OTHER PARAMETERS
			/SET TO 1 TO FORCE OTHER PARAMETERS TO VT78 COMPATIBLE

	DELAY=0		/SET NON-ZERO TO ALLOW DELAY AFTER ANY CHAR (12=CR)
			/TYPICALLY AFTER LF FOR HIGH SPEED VT05
			/SET VALUE OF DELAY = 7-BIT CHAR TO DELAY AFTER

	CTRL=1		/SET TO 1 TO ECHO CONTROL CHARS AS ^K
			/SET TO 0 TO ACCEPT CONTROL CHARACTERS AND PUT
			/IN BUFFER, BUT NOT ECHO THEM (EXCEPT THE USUAL)
	RUB=1		/SET TO 0 TO ECHO EACH RUBOUT BY TYPING A BACK SLASH
			/SET TO 1 TO ECHO CHARS RUBBED OUT UPON RUB-OUT
			/SET TO 4000 TO PERFORM SCOPE TYPE RUBOUTS
	SIMTAB=1	/SET TO 1 TO SIMULATE TABS AS THE CORRECT NUMBER OF SPACES
			/SET TO 0 TO TYPE TABS AS TABS
	SLOTAB=0	/SET TO 1 TO TYPE 2 RUBOUTS AFTER A TAB
			/ONLY IS APPLICABLE IF SIMTAB=0
	ALTMOD=0	/SET TO 1 TO CONVERT 175,176 TO 33
			/(UPPER CASE TERMINALS ONLY)
	ESC=1		/SET TO 1 TO ECHO ESCAPE AS $
			/SET TO 0 TO ECHO ESCAPE AS A CONTROL CHAR (^[)
	FLAGLC=1	/SET TO 1 TO FLAG LOWER CASE CHARS ON OUTPUT
			/THIS IS FOR PEOPLE NOT PRIVELIDGED ENOUGH TO
			/OWN A LOWER CASE TERMINAL
			/SET TO 0 TO PRINT LOWER CASE CHARS AS IS
	CNVLC=0		/SET TO 1 TO CONVERT LOWER CASE CHARS ON INPUT TO UPPER CASE
			/SET TO 0 TO ACCEPT INPUTTED LOWER CASE CHARS AS IS
			/THIS IS FOR PEOPLE WHO ARE HANDICAPPED BY A LOWER CASE
			/TERMINAL AND ONLY WANT UPPER CASE
	PAUS=200	/NON-0 PAUSES BETWEEN SCOPE PAGES
	HEIGHT=30	/NUMBER OF LINES PER SCREEN

/SOME OF THE ABOVE OPTIONS SHOULD ACTUALLY BE IMPLEMENTED
/IN SUCH A MANNER THAT THE USER CAN CHANGE THEM VIA AN ALTER
/RATHER THAN HAVE TO REASSEMBLE.

	IFNZRO VT78 <
	DELAY=0
	CTRL=1
	RUB=4000
	SIMTAB=0
	SLOTAB=0
	ALTMOD=0
	ESC=1
	FLAGLC=0
	CNVLC=0
	IFNZRO INDVC-3 <CTRL=0>
	>
/CROSS PAGE LINKAGE:

/THIS CODE MUST BE ABLE TO LOAD INTO ANY TWO PAGES OF CORE
/THE ENTRY POINT IS AT THE NEXT LOCATION TO THE END OF THE FIRST PAGE
/AT THE END OF THE FIRST PAGE WE JMS TO PLINK,
/THIS LEAVES THE ADDRESS OF THE FIRST LOCATION OF THE NEXT PAGE
/IN LOCATION 'PLINK' .  THIS JUST HAPPENS TO BE THE ADDRESS
/OF BOTH TTYPCH AND TTYGCH.

/TTYPCH AND TTYGCH SHARE THE SAME ENTRY POINT.
/IF IT IS CALLED WITH A 0 AC, IT IS A CALL TO TTYGCH,
/IF IT IS CALLED WITH A NON-ZERO AC, IT IS A CALL TO TTYPCH.

/RETURN 1 MEANS GOT RUBOUT
/TTYGCH TAKES RETURN 2 IF IT GOT A ^Z.
/OTHERWISE IT TAKES RETURN 3 WITH CHARACTER GOTTEN IN AC.

/TTYPCH TAKES RETURN 1 IF IT WANTS THE HANDLER TO GO AWAY,
/I.E IF IT SAW A ^Z.
/AC IS NORMALLY NON-ZERO UPON RETURN
/AC IS POSITIVE MEANS DO A CRLF

/WHEN ECHOING WE WANT TO CALL TTYPRT
/BUT OTHERWISE WE WANT TO CALL TTYPCH (WHICH DOES ADDITIONAL
/STUFF LIKE CHECK ^O, ^Q, ETC.
/WE TELL BY WHETHER OR NOT TTYGCH HAD BEEN PREVIOUSLY CALLED.
	*200

PLINK,	0		/GETS ADDRESS OF TTYPCH AND TTYGCH (START OF NEXT PAGE)
	STL CLA RAR	/4000
	TAD I TTY	/RETRIEVE FUNCTION WORD, BUT PUT R/W BIT IN LINK
	AND L3700	/EXTRACT NUMBER OF DOUBLE-WORDS TO TRANSFER
	CMA		/GET COUNT+1
	DCA BUFSIZ	/STORE AWAY
	RDF		/FIND OUT THE USER'S DATA FIELD
	TAD CIFCDF	/FORM OUR EXIT CIF CDF
	DCA TTYXIT	/STORE AWAY FOR EXIT ROUTINE
	TAD TTY70	/GET FUNCTION WORD
L776,	AND I TTY	/ISOLATE FIELD OF BUFFER
	TAD TTYCDF	/FORM CDF TO FIELD OF BUFFER
	DCA TTCDBF	/STORE WHERE IT WILL BE USEFUL
			/AT SAME TIME, INITIALIZE TTYEOF
	ISZ TTY		/POINT TO BUFFER ADDRESS
	TAD I TTY	/AND GET IT
	DCA BUFSTRT	/AND SAVE IT
	ISZ TTY		/POINT TO BLOCK #
TTY376,	ISZ TTY		/POINT TO ERROR RETURN
SHIFT,			/OUTPUT SHIFT REGISTER
TTYEOF,			/0 IF SAW CR OR ^Z AND WISH TO PAD BUFFER WITH 0'S
TTCDBF,	HLT		/CDF BUFFER FIELD
	JMP TTYKLG
TTYLP,	SNL CLA		/LINK=1 MEANS OUTPUT
	JMP TTYGET	/INPUT IS FROM TTY:
/LINK MUST BE SET FIRST TIME THROUGH HERE.
/IT ACTS AS A GUARD BIT IN THE SHIFT REGISTER
ROTL,	RTL
	RTL
	SPA		/DO WE HAVE 8 BITS SHIFTED IN?
	JMP TELP
	DCA SHIFT	/SAVE SHIFT REGISTER
	TAD I BUFSTRT
	SZA
	JMS PUNCH	/PRINT A CHARACTER
	TAD I BUFSTRT
	ISZ BUFSTRT	/BUMP INPUT POINTER
TT7400,	7400		/PROTECT ISZ
	AND TT7400
	CLL RAL
	TAD SHIFT	/SHIFT HIGH ORDER 4 BITS INTO
	JMP ROTL	/SHIFT REGISTER
TELP,	JMS PUNCH	/PRINT 3RD CHARACTER OF DOUBLE-WORD
	STL		/***KLUDGE
TTYKLG,	ISZ BUFSIZ	/DONE?
	JMP TTYLP	/NOT YET
TTYX,	TAD TTYEOF	/IF INPUT AND WE WERE PADDING WITH 0'S
	SZA CLA		/TAKE SOFT ERROR EXIT
TTYRTN,	ISZ TTY		/POINT TO NORMAL RETURN
			/CAN'T GET ERROR OR END-OF-FILE ON OUTPUT
TTYXIT,	HLT		/RETURN TO USER'S FIELD
	JMP I TTY	/RETURN TO USER
TTYCA,	0
TTYWC,	0
BUFSIZ,	0
BUFSTRT,0
TTY70,	70

PUNCH,	0		/NEVER CALL TTYPCH WITH ZERO AC
	JMS I PLINK	/CALL TTYPCH
	JMP TTYRTN	/GO AWAY, WE SAW A ^Z
L7700,	SMA CLA		/DID WE REACH END OF TTY LINE?
	JMS CRLF	/YES, PERFORM CR/LF
	JMP I PUNCH	/RETURN

TMP,
CRLF,	0
	TAD L215
	JMS I PLINK	/CALL TTYPCH TO PRINT CR
L215,	215		/CAN'T RETURN HERE
	CLA		/****
	TAD L212
	JMS I PLINK	/CALL TTYPCH TO PRINT LF
L212,	212		/CAN'T RETURN HERE
	CLA		/****
	JMP I CRLF	/RETURN
CTRLU,	JMS CRLF	/PERFORM A CR/LF
TTYGET,	TAD BUFSTRT
	DCA TTYCA	/POINT TO START OF BUFFER
	TAD BUFSIZ
	CLL RAL		/CONVERT DOUBLE-WORDS TO WORDS
DCAWC,	DCA TTYWC	/SET SIZE OF BUFFER
TSTEND,	TAD TTYEOF
	SNA CLA
	JMP ZERO
	JMS I PLINK	/CALL TTYGCH TO GET A CHARACTER
	JMP RUBOUT	/RETURN 1 MEANS SAW RUBOUT
ZERO,	DCA I TTYCA	/RETURN 2 MEANS GOT CHARACTER
			/STORE AWAY TEMPORARILY
			/USING USER'S BUFFER AS A TEMP LOCATION
	TAD I TTYCA	/GET BACK CHARACTER
	IFNZRO .-320 <_ERROR>
	SZA
	JMS PUNCH	/ECHO IT
	TAD I TTYCA	/GET IT AGAIN
	TAD M32		/-^Z
	SNA
	JMP CTRLZ
	TAD L5		/^Z-^U
	SNA 		/IS IT ^U?
	JMP CTRLU	/YES
	TAD L7
GRUDGE,	DCA TMP
	ISZ TTYCA	/NO
L7,	7
	ISZ TTYWC	/IS BUFFER FULL?
TT10,	SKP
	JMP TTYX
	ISZ TMP		/WAS LAST CHAR A CR?
	JMP TSTEND	/NO
	DCA TTYEOF	/YES, SET "PAD WITH 0'S" FLAG
	ISZ TTY		/POINT TO NORMAL RETURN
			/CR IS NOT AN ERROR OR END-OF-FILE
	TAD L212	/IF LAST CHAR INPUT WAS CR, NOW PRETEND LF WAS INPUT
	JMP ZERO	/REJOIN PROCESSING

CTRLZ,	DCA TTYEOF
	JMS CRLF
	JMP GRUDGE

M32,	-32
L5,	5
L3700,	3700
CIFCDF,	CIF CDF 0
TTYCDF,	CDF 0

/TTYEOF IS ZERO MEANS PAD BUFFER WITH ZEROES
/DON'T DO YET:
/RUBOUT,	AND TTYWC	/177 IN AC
/	SNA CLA
/	JMP CTRLU

RUBOUT,	KKCC		/TTYGCH DOESN'T CLEAR RO FROM BUFFER
	TAD TTYCA
	CIA
	TAD BUFSTRT
	SNA CLA		/ARE WE AT BEGIN OF BUFFER?
	JMP CTRLU	/YES
	STA
	TAD TTYCA
	DCA TTYCA
	IFZERO RUB <
LSLASH,	"\
	TAD LSLASH		/PRINT A BACK SLASH FOR EACH RUBBED OUT CHAR
	>
	IFNZRO RUB&4000+RUB <TAD I TTYCA>	/PRINT CHAR JUST DELETED
	IFNZRO RUB&4000 <TAD TT10>	/BACKSPACE-SPACE-BACKSPACE
	JMS PUNCH
	STA
	TAD TTYWC
	JMP DCAWC	/BUMP BACK WC AND GET ANOTHER CHAR

	ZBLOCK 376-.
TTY,	TTYVERSION	/ENTRY POINT TO HANDLER
	JMS PLINK	/SET UP CROSS PAGE LINKAGE
	IFNZRO TTY-376 <ENTERR,QQQQ>
	PAGE
/INTERLUDE:

/USA STANDARD CODE FOR INFORMATION INTERCHANGE:

/	000	001	010	011	100	101	110	111
/
/ 0000	NUL	DLE	SP	0	@	P	'	'P
/
/ 0001	SOH	DC1	!	1	A	Q	'A	'Q
/
/ 0010	STX	DC2	"	2	B	R	'B	'R
/
/ 0011	ETX	DC3	#	3	C	S	'C	'S
/
/ 0100	EOT	DC4	$	4	D	T	'D	'T
/
/ 0101	ENQ	NAK	%	5	E	U	'E	'U
/
/ 0110	ACK	SYN	&	6	F	V	'F	'V
/
/ 0111	BEL	ETB	'	7	G	W	'G	'W
/
/ 1000	BS	CAN	(	8	H	X	'H	'X
/
/ 1001	HT	EM	)	9	I	Y	'I	'Y
/
/ 1010	LF	SUB	*	:	J	Z	'J	'Z
/
/ 1011	VT	ESC	+	;	K	[	'K	'[
/
/ 1100	FF	FS	,	<	L	\	'L	'\
/
/ 1101	CR	GS	-	=	M	]	'M	']
/
/ 1110	SO	RS	.	>	N	^	'N	'^
/
/ 1111	SI	US	/	?	O	_	'O	'_
/
/TTYGCH:	GETS A CHAR FROM KBD
/	IF GOT ^Z, IT SETS TTYEOF FLAG
/	LEAVES IT IN AC IN 7-BIT

/TTYPRT:	PRINTS CHAR IN AC ON TTY
/	IGNORES NULLS
/	PRINTS ^X ON CONTROL CHARS (EXCEPT CR, LF, FF, VT, TAB)
/	PRINTS 'X ON LOWER CASE

/HANDLES TABS CORRECTLY
/	AND AUTOMATICALLY PRINTS CR/LF AT EOL
/	PRINTS ESCAPE AS $

/TTYTLS:	USED TO ACTUALLY PRINT CHAR
/		IT HANDLES TABS AUTOMATICALLY
/		AND CR/LF'S AT END OF LINE

/TTYPCH:	IT USES TTYPRT TO PRINT CHAR BUT ALSO RESPONDS TO
/		^C, ^O, ^S, ^Q.
/		IF ^Z IS BEING PRINTED, IT THEN STOPS FURTHER PRINTING
/MUST BE AT TOP OF PAGE
TTYPCH,			/ENTRY POINT TO TTY PUNCH ROUTINE
			/OR TTY PRINT ROUTINE
TTYGCH,	0		/ENTRY POINT TO TTY GET CHAR ROUTINE
	SNA
	JMS TGCH	/ZERO AC-MEANT CALL TO TTYGCH
PCH,	AND (177	/FORCE TO 7-BIT
	DCA TCHAR
	TAD TGCH
M140,	SZA CLA		/ARE WE ECHOING?
	JMP ECHO	/YES, IGNORE ^S AND STUFF
K5,	5		/MUST BE AT REL 10
	TAD TCHAR
	TAD (-32
	IFZERO PAUS <
	SNA CLA
	JMP I TTYPCH
	>
	IFNZRO PAUS <
	SNA
	JMP I TTYPCH
	TAD L15		/32-15
	SNA CLA		/LOOK FOR CR
	ISZ LINCNT	/AT END OF PAGE?
	JMP NOPAUS	/NOT AT CR, OR AT CR BUT NOT AT END OF PAGE
L15,	15		/MUST BE HERE FOR SET
	TAD PAUSN
	DCA TTYTLS	/SET COUNT FOR OUTER LOOP
	ISZ LINCNT
	JMP .-1
	ISZ TTYTLS
	JMP .-3
	TAD LINSYZ
	DCA LINCNT
	>
NOPAUS,	JMS TTYTST
	TAD (203-217	/NO
	SNA		/^O?
	DCA TCHAR	/YES, SET TO NULL SO IT WILL BE IGNORED
	TAD (217-223	/NO
	SZA CLA		/^S?
	JMP ECHO	/NO, IGNORE CHAR
TTCTLQ,	JMS TTYTST
	TAD (203-221	/NO, NOTHING ELSE MATTERS UNTIL ^Q
	SZA CLA		/^Q?
	JMP TTCTLQ	/NO, SUSPEND OUTPUTTING
TTY32,	KKCC		/YES, REMOVE ^Q FROM BUFFER
/HAD NO ROOM FOR:
/	TAD LINSYZ
/	DCA LINCNT
ECHO,	DCA TGCH
	ISZ TTYPCH
	IFNZRO ESC <
	TAD TCHAR
	TAD (-33
	SZA CLA
	JMP .+3
	TAD L44
	DCA TCHAR
L44,	44
	>
	TAD TCHAR
	SNA
	JMP TTYCTO	/IGNORE NULLS
	IFNZRO RUB&4000 <
	TAD (-10
	SNA
	JMP RUBO
	TAD (10-16
	>
	IFZERO RUB&4000 <
	TAD (-16
	>
TTY100,	CLL
TTY10,	TAD K5
TTY240,	SZA		/TAB?
	JMP NOTAB
	IFNZRO SIMTAB <
TTYTAB,	TAD TTY240
	JMS TTYTLS
TTY7,	7		/HERE FOR NO SPECIAL REASON
	TAD TABCTR
	AND TTY7
	SZA CLA
	JMP TTYTAB
	JMP TTYCTO
	>
	IFNZRO SLOTAB <
	TAD TCHAR
	JMS TTYTLS
	TAD (177
	JMS TTYTLS
	TAD (177
	JMP PRIN+1
	>
	IFZERO SIMTAB+SLOTAB <JMP PRIN>

/BUG: IF HARDWARE TABS, DON'T COUNT COLUMNS CORRECTLY

	IFNZRO RUB&4000 <
RUBO,	TAD TTY10	/OUTPUT BACKSPACE-RUBOUT-BACKSPACE
	JMS TTYTLS
	TAD TTY240
	JMS TTYTLS
	TAD (-4
	TAD TABCTR
	JMP PREPRN
	>
NOTAB,	SZL CLA
	JMP SPCHR	/DON'T UPARROW CHARS LF,CR,TAB,VT,FF
	IFNZRO FLAGLC <
	TAD TCHAR
	AND TTY140
	TAD M140
	SZA CLA		/IS IT LC?
	JMP NOLC	/NO
TTYQUO,	"'
	TAD TTYQUO	/YES
	JMS TTYTLS	/PRINT QUOTE
	TAD M40
	JMP PRIN	/PRINT UPPER CASE OF CHAR
	>
NOLC,	TAD TCHAR	/NO, GET BACK CHAR
	AND TTY140	/HIGH ORDER BITS IRRELEVANT
	IFNZRO CTRL <
M40,	SMA SZA CLA	/CAN'T BE NEGATIVE
	JMP PRIN	/NOT A CONTROL CHARACTER
	TAD TTYUPA	/ECHO 201-237 AS ^X (EXCEPT 211-215)
	JMS TTYTLS
	TAD TTY100	/ADD X100 TO ^K TO GET K
	>
	IFZERO CTRL <
	SNA CLA		/IS CHAR A CONTROL CHAR?
	JMP TTYCTO	/YES, DON'T ECHO CONTROL CHARACTERS EXCEPT FOR 211-215
	>
PRIN,	TAD TCHAR
	JMS TTYTLS
TTYCTO,	TAD TABCTR	/RETURN TABCNT IN AC
	JMP I TTYPCH

	IFZERO CTRL <
M40,	-40
	>

TTY140,
SPCHR,	STA CLL
	TAD LINSIZ
PREPRN,	DCA TABCTR	/THESE CHARS RESET COLUMN COUNTER
	JMP PRIN
TGCH,	0		/NON-ZERO MEANS TTYGCH WAS CALLED
	KKSF
	JMP .-1		/WAIT FOR CHAR TO BE TYPED
	JMS TTYTST
/WILD: (DON'T PUT IN)	SZA CLA /FALL THRU AND RETURN R.O.
/	ISZ TTYGCH
	TAD (203-377
	SNA CLA		/TAKE RETURN 1 ON RUB OUT
	JMP I TTYGCH	/"CLUMSY" - R.L. (9/18/73)
	ISZ TTYGCH
	KKRB		/GET CHARACTER
TTYAND,	AND (177	/MUST RETURN CHAR IN 7-BIT
	IFNZRO CNVLC <
	DCA TCHAR
	TAD TCHAR
	AND TTY140
	TAD M140
	SNA CLA		/IS IT LC?
	TAD M40		/YES
	TAD TCHAR	/NO
	>
	IFNZRO ALTMOD <
	TAD (-175	/IS IT 175 OR 176?
	SMA
	JMP CONV	/YES, CONVERT ALTMODE TO ESCAPE
	TAD (175	/NO, RESTORE CHAR
	>
	JMP I TTYGCH	/TAKE RETURN 3

/SHOULDN'T TABCTR BE INITIALIZED TO C(LINSIZ) UPON ENTRY?

TABCTR,	-110

TTYTLS,	0
	TTLS
	IFNZRO DELAY <
	TAD (-DELAY
	SZA CLA
	STA
	>
TTYTSF,	TTSF
	JMP .-1
	IFNZRO DELAY <
	IAC
	SZA		/19.66 MS IS G.T. 1/60 SEC
	JMP TTYTSF
	>
	ISZ TABCTR
TTYUPA,	"^
TT7600,	7600
	JMP I TTYTLS
LINSIZ,	-110

	IFNZRO PAUS <
LINSYZ,	-HEIGHT
LINCNT,	-HEIGHT
PAUSN,	-PAUS
	>

	IFNZRO ALTMOD <
		IFNZRO KKCC-6032 <
CONV,		CLA
		TAD (33
		JMP I TTYGCH
		>
	IFZERO KKCC-6032 <
CONV,		CLA IAC
		TAD TTY32	/DEVICE DEPENDENT
		JMP TTYAND
		>
	>
TCHAR,	0

/TTYTST:	READS KEYBOARD STATICALLY AND RESPONDS TO ^C
/		OTHERWISE RETURNS CHAR (8-BIT) MINUS 203 IN AC.
/		IF FLAG IS NOT UP, IT RETURNS A 1.

TTYTST,	0
	TAD TT7600	/OR CHAR IN
	KKRS
	TAD (-7603	/-7603=175
	KKSF
	CLA IAC		/STUFF IN BUFFER IS UNRELIABLE IF FLAG ISN'T UP
	SZA
	JMP I TTYTST
	IFNZRO INDVC-3 <KKCC>
	CIF CDF 0	/BRANCH TO OS/8 MONITOR AT 07600
	JMP I TT7600	/IT WILL PRINT "^C" FOR CHAR IN BUFFER
	PAGE
/	DYNAMICALLY MODIFYING THE KL8E HANDLER

/	*** I M P O R T A N T ***

/	THIS HANDLER CAN BE DYNAMICALLY CHANGED VIA SET COMMANDS.
/	CONSEQUENTLY, IT IS EXTREMELY IMPORTANT THAT PEOPLE
/	WHO MODIFY THIS SOURCE DO NOT AFFECT THE ALGORITHMS
/	NECESSARY TO PERFORM SUCH MODIFICATIONS.

/	THIS ALGORITHM IS EXPLAINED BELOW.

/	SET TTY WIDTH=N

/	SEARCH LOCATIONS 200-377 FOR A 7600.  CALL ITS ADDRESS X.
/	LET Y BE THE INSTRUCTION AT LOCATION X+1.
/	FORM THE (RELATIVE) ADDRESS T=Y&177+200-1.
/	THEN LOCATIONS T AND X+2 CONTAIN MINUS THE TTY WIDTH.
/	THE WIDTH MUST BE A MULTIPLE OF 10 AND MUST NOT BE 200.
/	(BECAUSE -200 IS THE MAGIC 7600)

/	SET TTY CODE XX

/	SEARCH ENTIRE HANDLER FOR INSTRUCTIONS OF THE FORM 6XXY
/	WHERE XX IS NOT 20 OR 21,
/	AND FURTHERMORE DON'T INCLUDE A 6031 IF 2 LOCATIONS
/	FOLLOWING IS A 7650
/	AND DON'T INCLUDE A 6034 IF 4 LOCATIONS FOLLOWING IS A 7650.


/	SET TTY [NO] ECHO

/	THE WORD INVOLVED IS AT (RELATIVE) LOCATION 120.
/	SET TO 7440 TO ECHO.
/	SET TO 7610 TO SUPPRESS ECHOING.


/	SET TTY LC

/	SEARCH LOCATIONS 200-377 FOR A 377.  CALL ITS ADDRESS X.
/	LOOK AT LOCATION X+5.
/	IF THIS LOCATION IS NOT A 7650, THEN LC TO UC CONVERSION
/	WAS NOT ENABLED AT ASSEMBLY TIME.
/	IF THE FEATURE IS ENABLED, CHANGE LOCATION X+5 TO A 7610
/	TO PREVENT THE CONVERSION.  TO ALLOW CONVERSION, SET
/	LOCATION X+5 BACK TO 7650.

/	SET TTY PAGE

/	SEARCH LOCATIONS 215-300 FOR A 7450. CALL ITS ADDRESS X.
/	SET X+3 TO 7640 TO ENABLE ^S, ^Q.
/	SET X+3 TO 7200 TO DISABLE ^S, ^Q.
/	SET TTY TAB

/	SEARCH LOCATIONS 200-300 FOR A 7.
/	IF NOT FOUND, SIMULATED TABS WAS NOT ENABLED AT ASSEMBLY TIME.
/	IF FOUND, CALL ITS ADDRESS X.
/	TO PATCH OUT SIMULATED TABS:
/		MOVE C(X-12) TO LOCATION X-2
/		CHANGE LOCATION X+3 TO A 7610
/	TO RESTORE SIMULATED TABS:
/		SET LOCATION X-2 TO X-4&77+1200
/		CHANGE LOCATION X+3 TO A 7640

/	SET TTY FILL

/	THE LITERAL 177 MUST REMAIN AT THE END OF PAGE 2
/	SEARCH LOCATIONS 200-300 FOR A 1377.
/	IF NOT FOUND, THEN FILL CHARACTERS WERE NOT ENABLED AT ASSEMBLY
/	TIME.  IF FOUND, CALL ITS ADDRESS X.
/	TO PATCH OUT FILL CHARACTERS, MOVE C(X+3) TO LOCATION X-1.
/	TO RESTORE FILL CHARACTERS, MOVE C(X+1) TO LOCATION X-1.

/	SET TTY FLAGLC

/	SEARCH LOCATIONS 200-377 FOR A 247.
/	IF NOT FOUND, LOWER CASE FLAGGING WAS NOT ENABLED AT ASSEMBLY TIME.
/	IF FOUND, CALL ITS ADDRESS X.
/	TO DISABLE FLAGGING, SET LOCATION X-2 TO A 7200.
/	TO RE-ENABLE FLAGGING, SET LOCATION X-2 TO A 7640.

/	SET TTY PAUSE [N]

/	SEARCH LOCATIONS 200-300 FOR A 15.
/	IF NOT FOUND, PAUSING WAS NOT ENABLED AT ASSEMBLY TIME.
/	IF FOUND, CALL ITS ADDRESS X.
/	TO DISABLE PAUSING AFTER A FULL SCREEN,
/	SET LOCATION X-3 TO A 7610.
/	TO RE-ENABLE PAUSING, SET LOCATION X-3 TO A 7650.
/	TO SET PAUSE DURATION, SEARCH LOCATIONS 300-377 FOR A 7600,
/	CALLING ITS ADDRESS X.  THEN (MINUS THE) PAUSE DURATION IS AT
/	LOCATION X+5.

/	SET TTY HEIGHT

/	THIS IS ONLY APPLICABLE IF SET TTY PAUSE HAS BEEN ASSEMBLED IN
/	(A 15 CAN BE FOUND ON SECOND PAGE).
/	NEGATIVE OF HEIGHT MUST BE SET IN BOTH LOCATIONS X+3 AND X+4
/	WHERE X IS THE ADDRESS OF A 7600 AS IN ABOVE.
/	SET TTY ESCAPE

/	SEARCH LOCATIONS 200-377 FOR A 44.
/	IF NOT FOUND, THEN $ WAS NOT ASSEMBLED INTO TTY HANDLER.
/	IF FOUND, CALL ITS ADDRESS X.
/	TO DISABLE PRINTING ESCAPE AS $, SET LOCATION X-4 TO A 'CLA'.
/	TO CAUSE ESCAPE TO PRINT AS AN ESCAPE, SET LOCATION X-4 TO SZA CLA.

/	SET TTY ARROW

/	SEARCH LOCATIONS 200-377 FOR 7740.

/	IF NOT FOUND, USING OLD HANDLER.
/	CALL ITS ADDRESS X.
/	IF LOCATION X+1 IS MORE THAN 7000,
/	THEN UPARROW MODE WAS NOT ASSEMBLED INTO KL8E.
/	OTHERWISE, TO ALLOW ARROWS, SET LOCATION X+3 TO THE
/	CONTENTS OF LOCATION X+6.
/	TO CAUSE CONTROL CHARACTERS TO ECHO AS IS, SET
/	LOCATION X+3 TO 'SKP CLA'.
/	NOTE THAT THIS IS A DIFFERENT OPTION THAN ASSEMBLING CTRL=0.
	IFDEF TEST <
	*600

/TEST ROUTINE FOR KL8E HANDLER

GO,	JMS I (TTY	/CALL HANDLER
	0600		/READ SIX PAGES
	1000		/BUFFER AT 01000
	0001		/BLOCK 1
	HLT		/ERROR RETURN
	JMS I (TTY	/CALL HANDLER AGAIN
	4600		/OUTPUT SIX PAGES
	1000
	0001
	HLT
	CLA
	JMP GO
	>
	$


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/OS78.BI. 
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

$JOB UPDATE OS/78 V2 TO RX02 FLOPPIES
.R PIP
*FUTIL.SV,RESORC.SV,BUILD.SV</D
*BPAT.BN,FPAT.BN,BOOT.SV</D
*RLFRMT.SV,VXNS.BN,VXSY.BN</D
*RXNS.BN,RXSY1.BN,RXSY2.BN</D
*RLSY.BN,RL0.BN,RL1.BN</D
*RL2.BN,RL3.BN,RLC.BN</D
*RX78C.BN,KL8E.PA</D
*CCL.MA,CCLPS.MA,CCLTBL.MA</D
*CCLCDX.MA,CCLCD.MA,CCLCOR.MA</D
*CCLSIZ.MA,CCLTAB.MA,CCLDRV.MA</D
*CCLAT.MA,CCLSB2.MA,CCLDAT.MA</D
*CCLSEM.MA,CCLREM.MA,CCLMSG.MA</D
*CCLRUN.MA,CCLSUB.MA</D
/
.RUN RXA1:FOTP
*SYS:<RXA1:BITMAP.SV,HELP.HL,HELP.SV,RESEQ.BA,SPOOLR.SM
*SYS:<RXA1:QUEUE.SV,SRCCOM.SV,CREF.SV,BASIC.OV,BASIC.WS
*SYS:<RXA1:BRTS.SV,BASIC.SV,DIRECT.SV,FOTP.SV,EDIT.SV
*SYS:<RXA1:BLOAD.SV,DEMO.BI,DEMOG.BA,DEMON3.TX,DEMONP.SV
*SYS:<RXA1:DEMOCH.SV,DEMO1.SV,DEMON1.TX,DEMOIN.BA,DEMOM4.TX
*SYS:<RXA1:DEMOM2.TX,DEMO1.V2,DEMOCH.PA,DEMOM6.TX,DEMO1.PA
*SYS:<RXA1:DEMONP.PA,DEMOM7.TX,DEMOM5.TX,DEMOMX.TX,BCOMP.SV
*SYS:<RXA1:DEMOM3.TX,DEMOM1.TX
$MSG ENTER CR AFTER PUTTING IN DISK #2
.R FOTP
*SYS:<RXA1:F4.SV,PASS3.SV,FRTS.SV,PASS20.SV,LOAD.SV
*SYS:<RXA1:PASS2.SV,RALF.SV,FORLIB.RL
.SET SYS OS78
.SET TTY WIDTH 80
.SET TTY COL 2
.SET SYS INIT HELP
.SET TTY SCOPE
.SET TTY PAUSE 3
$MSG INSERT A BLANK FLOPPY IN RXA1 AND ENTER A CR
.DUPLIC RXA1:<RXA0:
$MSG YOU MAY DELETE FILE OS78.BI AFTER DOING A CR
$END


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/OS8.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143

/12 OS8 MONITOR SYSTEM		OS8 VERS. 3F
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1970,1971,1972,1973,1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/13-APRIL-1977		RL/EF/HJ/SR


	/THIS VERSION OF OS/8 IS THE BATCH OPERATING SYSTEM
	/AS WELL AS THE STANDARD KEYBOARD SYSTEM. THIS SYSTEM
	/IS EXTERNALLY COMPATIBLE WITH ALL PREVIOUS OS/8-PS/8
	/USER PROGRAMS. HOWEVER, INTERNALLY THE SYSTEMS ARE
	/QUITE DIFFERENT. THE MARCH 1972 OS/8 WILL NOT RUN BATCH.
	/THIS VERSION IS COMPATIBLE WITH CCL.

/	SYMBOLIC REFERENCES TO VARIOUS OVERLAYS:

	MEOVLY=26		/DIRECTORY OVERFLOW OVERLAY FOR "ENTER"
	MCDREC=51		/COMMAND DECODER
	MSOVLY=54		/"SAVE W. ARGS" OVERLAY
	MSOVL2=55		/SECOND PART OF SAVE W. ARGS
	MERRTN=56		/MONITOR ERROR ROUTINE
	MRUNRC=57		/"CHAIN" OVERLAY
	ODTREC=60		/SYSTEM ODT
	MFREE=70		/BEGINNING OF FILE STORAGE
	CCB=7400
	CSOVLY=400
	RSOVL1=1400
	RSOVL2=2000

	EXOVLY=64	/EXTENDED MEMORY OVERLAY
	LXM=6200	/EXTENDED MEMORY LOAD INSTRUCTION
	VERSNO=3
	PATCHLEV="S

/V3 CHANGES:

/1.	CCL SUPPORT
/2.	FIXED KILLER CLOSE BUG
/3.	ADDED VERSION NUMBER
/4.	^U, RO TO BOL, AND LF ALL PRINT '.' AGAIN
/5.	CALL TO USR WITH CODE OF 0 GIVES ERROR
/6.	MONITOR ERROR MESSAGES NOW GIVE EXPLANATION
/7.	ENTER NOW MOVES 7 FILES TO MAKE ROOM INSTEAD OF HALF SEGMENT
/8.	DIRECTORY VERIFICATION HAS IMPROVED

/V3 FIXES TO ABSLDR:

/1.	ALLOWED PARITY ^C
/2.	PUT IN SELF-STARTING STUFF
/3.	FIXED CCB BUG FOR 17600

/FIXES TO FIELD RELEASE

/1.	ABSLDR CHECKS PAGE 0 LITERALS
/2.	FIXED BUG RE MONITOR ERROR MESSAGES
/3.	ADDITIONAL INFO FIX
/4.	BATCH FIX

/FIXES FOR MAINTENANCE RELEASE:

/1.	CHANGED VERSION NUMBER OF MONITOR TO V3M
/2.	INCORPORATED PATCH RE LOC 13121 AFTER MONITOR ERROR
/	[SEQ #1, DSN APRIL 1975]
/3.	ALLOW CHAIN TO WORK ON FULL FIELD SAVES
/	[SEQ #2, DSN  JUNE 1975]
/4.	ALLOW ABSLDR/I TO WORK ON FULL FIELD CORE IMAGES
/	[SEQ #1, DSN OCTOBER 1975]
/5.	ADDED INTERNAL VERSION NUMBER TO ABSLDR AT LOCATION 2200
/	MAINT. RELEASE VERSION # IS V4
/6.	SET INITIAL ABSLDR DATE TO 1-NOVEMBER-1975

/V3D AND OS/78 CHANGES:

/1.	ACCEPT DEC STANDARD DATE FORMAT FOR INPUT (DD-MMM-YY)
/2.	CHANGED VERSION NUMBER TO V3Q
/3.	ADDED DATE/78 CHANGES
/4.	FIXED BUG ABOUT WAITING FOR TTY FLAG & BATCH
/5.	ADDED STUFF FOR LINKER [USES SOFSET]
/6.	CHANGED ABSLDR DATE TO 1-JUNE-77
/7.	DISALLOW RUN OF PROGRAM WITH BIT 4 OF JSW ON [OS/78 ONLY]
/8.	ASSIGNED RESIDENT BITS FOR SCOPE AND OS/78
/9.	ALLOW @ IN KBM COMMAND
/10.	COULD RUN INIT.CM ON SYSTEM START-UP
/11.	CHANGED BAD CORE IMAGE MSG TO CORE IMAGE ERR
/12.	CHANGED ABSLDR/I SO THAT IT SETS UP JSW AND SA
/V3F CHANGES:

/1.	ADDED MONITOR SUPPORT FOR KT8A
/		A. R,RUN, GET COMMANDS NOW LOAD 128K
/		B. SAVE COMMAND CAN SAVE UP TO 128K
/2.	ADDED HIGROUND SUPPORT
/3.	ABSLDR ALSO UPDATED TO SUPPORT 128K
	/KEYBOARD MONITOR FOR OS/8 SYSTEM - UNCOMMENTED AT PRESENT

	FIELD 0
	MTHREE=CLA CLL CMA RTL
	*200
PRINT,	JMP I HNDL	/MUST BE AT 200 FOR BATCH
	JMP .+3		/****GETS CIF CDF N FOR BATCH*****
	TSF		/****GETS JMP I .+1******
	JMP .-1		/*GETS BOSPRT*****
	TLS
	CLA
	TAD [7000
	DCA PRINT+1
	JMP I PRINT
GETNAM,	0		/ROUTINE TO ACESS TTY INPUT
	DCA NM1		/FIRST OFF,INITIALIZE 
	DCA NM2		/SET UP SYMBOLS FOR STORING NAME
	DCA NM3
	DCA NM4
	TAD TNM1
	DCA PN
	CLA CMA
	DCA PRDSW
GTNMX,	DCA NMCT
	TAD I LXR	/LOCATE FIRST CHARACTER
	TAD M240	/IS IT A SPACE?
	SNA		/IF SO TEST NEXT CHARACTER
	JMP .-3
	TAD [240	/WE'VE GOT FIRST CHARACTER
	SKP
GTNMLP,	TAD I LXR	/GET ANOTHER CHARACTER
	DCA TMP
	TAD TMP
	TAD M256	/IS IT A PERIOD?
	SNA
	JMP PERIOD	/IF SO, PROCESS IT
	TAD [-2
	CLL
	TAD M12
	SNL CLA		/IS IT GT  ASCII CHARACTER (#9)? 
	JMP NINSRT	/IF NO, INSERT IN NAME
	TAD M301
	TAD TMP
	CLL CML
	TAD [-32
	SNL CLA		/IS IT GT ASCII(Z),IF SO
	JMP EONAME	/END OF NAME
NINSRT,	TAD NMCT	/CHECK FOR MAXIMUM CHARS
	TAD [-6
	SMA CLA
	JMP GTNMLP	/IF MAXIMUM SAVE NO MORE
	TAD NMCT	/SET UP POINTER TO STORE CHARACTER
	CLL RAR
	TAD PN
	DCA TEMP1	/HERE IS POINTER TO NM1,NM2,ETC.
	TAD TMP
	AND [77		/ISOLATE SIX BITS FOR STORAGE
	SZL
	JMP .+4		/NO MORE ROOM
	RTL
	RTL
	RTL
	TAD I TEMP1	/OR IT IN AND STORE
	DCA I TEMP1
	ISZ NMCT
	JMP GTNMLP
PERIOD,	ISZ PRDSW
	JMP EONAME
	ISZ PN
	TAD N4
	JMP GTNMX
EONAME,	TAD NMCT
	SZA CLA
	ISZ GETNAM
	JMP I GETNAM

HNDL,	4000		/ROUTINE TO RELOAD NON-SYS HANDLER FOR SAVE ROUTINE
	JMS I [SHNDLR
	0200		/READ TWO PAGES 
	1000		/INTO 1000
LDBLK,	0		/SET UP BY SAVE ROUTINE
	JMP KMONER
	JMP I HNDL

PRINTQ,	JMS PRMESG
	TEXT /?/
	0
KMER3,	JMS I [PRMESG
	TEXT /NO/
TNM1,	NM1
M240,	-240

	*325
PRINLP,	JMS PRWD
	ISZ PRMESG
	SKP
	IFNZRO .-330 <CCLTRB,ERRR>
PRMESG,	0		/ERROR MESSAGE PRINTING ROUTINE
	CLA
	TAD I PRMESG
	SZA
	JMP PRINLP
	TSF
	JMP .-1
	JMP I ERRET	/RETURN TO MONITOR
PRWD,	0
	DCA TMP
	TAD TMP
	RTR
	RTR
	RTR
	JMS PCHAR
	TAD TMP
	JMS PCHAR
	JMP I PRWD
PCHAR,	0
	AND [77
	SNA
	JMP I PCHAR
	TAD [240
	AND [77
	TAD [240
	JMS I PCH
	JMP I PCHAR
M12,	-12
M256,	-256
M301,	-301

N4,	4

	*367
SAVE12,	JMS I [SHNDLR	/RELOAD AND RETURN TO MONITOR FROM SAVE
	0610
	0
	MONTOR
	JMP KMONER
	CLA CMA
	CDF 10
	DCA I [7700
	JMP I [7605
	*400
KMNTRY,	JMP I GDEVNO	/V3
	0		/FREE LOCATION !
PCRLF,	JMS I [CRLF
	IFNZRO .-403 <BTCHER,XXXX>

KEYMON,	JMS I GLINE
	TAD [BEGLN-1	/ADDRESS REFERENCED BY INIT
	DCA LXR
	JMS I GNAME
/V3D	JMP I [PRINTQ
	XXX=[PRINTQ	/NEED LITERAL IN SAME PLACE
	NOP		/V3D ALLOW @ IN NAME
	JMS I [SRCH
	-123;	ASSIGN
	-2301;	SAVE
	-2225;	RUN
	-705;	GET
	-2200;	R
	-2324;	START
	-1704;	ODT
	-0405;	DEAS
	IFNZRO .-431 <SEECCL,ZZZ>
	-0401;	DATE
	0
	JMP I .+1
CCLSW,	PRQMRK		/MODIFIED FOR CCL TO 'GETCCL'
	IFNZRO CCLSW-435 <SEECCL,ZZ>

ASSIGN,	TAD [12
	JMS GDEVNO
	TAD [UDNAME-1
	DCA TM1
	JMS I GNAME
	JMP ASGN2+1	/NO USER DEV. DO A DEASSIGN 
	TAD NM2		/SEE IF WE HASH IT
	SNA
	JMP ASGN2	/DON'T HASH..ONLY 1 OR 2 CHARS
	TAD NM1
	RAL		/LINK BECOMES 4000 IF NECESSARY
	CLA CML RAR
	TAD NM2
ASGN2,	TAD NM1
	JMP I [ASDONE
R,	DCA I [GETSW
	TAD P6203
	JMS I [RESET
	ISZ RUNSW
	TAD [SHNDLR
	DCA HANDAD
	CLA IAC
	JMP RGETPG

GDEVNO,	KMINIT
	DCA ASNM1-1
	JMS I [MINCOR
	JMS I GNAME
	JMP I [KMER4
	TAD NM1
	DCA ASNM1
	TAD NM2
	DCA ASNM1+1
	TAD HNDLAD
	DCA  HANDAD
	CIF 10
	JMS I SYSTEM
	1
ASNM1,	0;0
HANDAD,	KMINIT
	JMP I [KMER1
	TAD ASNM1+1
	JMP I GDEVNO
GET,	TAD [SKP
RUN,	DCA I [GETSW
	TAD P6203
	JMS I [RESET
	DCA RUNSW
	CLA IAC
	JMS GDEVNO
RGETPG,	JMS RSCOMN
	JMS I [MINCOR
	TAD SENTER
	CIF 10
	JMS I SYSTEM
	2
PGNAME,	NM1
	MOVBUF		/USED AS POINTER TO FIELD 1 SR
	JMP I [KMER2 
	JMP I [RLOADR
RSCOMN,	0
	DCA SENTER
	TAD HANDAD
	DCA DEVHND
	JMS I GNAME
	JMP I [KMER4
	TAD NM4
	SNA
	TAD [2326
	DCA NM4
	JMP I RSCOMN
SAVE,	TAD [SAVE12	/CHANGE ERROR RETURN ADDRESS AS WE WILL DESTROY CORE
	DCA ERRET
	TAD I [JSBITS
	JMS I [RESET
	CIF 10		/MOVE THE LINE BUFFER TO 1600 DURING
	JMS I PGNAME+1	/A SAVE, AS HANDLER WIPES IT OUT
	TAD LXR		/LET'S MOVE THE REGISTER AROUND
	TAD [SVLNBF-BEGLN
	DCA LXR
	TAD [1001
	DCA HNDLAD
	CLA IAC
	JMS GDEVNO
	JMS RSCOMN
	JMP I [SAVE2
HNDLAD,			/REPLACED WITH 1001 BY SAVE

WRCTLB,	7001		/WRITE OVERLAY AND CCB
	JMS I [SHNDLR
	4600
	6200
	MTEMP+6
	JMP KMONER
	JMP I WRCTLB
	*573		/LOADS SYSTEM ODT OVER THE MONITOR
ODT,	JMS I PGTOUT
	JMS I [SHNDLR
	1001
	0
	ODTREC
	/LOCATION 600 IN ODT IS A HLT (ERROR RETURN)
	*600
START,	DCA TEMP1
	DCA TEMP2
	TAD I LXR	/V3
	SZA		/V3
	JMP I [STRTX	/V3
	TAD I [JFIELD
	DCA I [MSTCDF
	TAD I [JSBITS
	AND [1000
	SZA CLA
	JMP I [KMER3
	TAD I [JSBITS
	JMS I [RESET	/RESET ONLY IF NO START ADR SPECIFIED
	TAD I [JSTART
STCOMN,	DCA I [MSTADR
	TSF
	JMP .-1		/WAIT FOR PRINTER TO FINISH
	JMS I PGTOUT
	TAD I [JSBITS
	SPA CLA
	JMP I [MSTCDF
	TAD [SHNDLR
	DCA I [MREAD-1
	TAD [1000
	DCA I [MREAD+1
	DCA I [MREAD+2
	TAD [MTEMP+4
	DCA I [MREAD+3
	TAD FUDJMP
	DCA I [MSWITC
	JMP I [MREAD
MINCOR,	0
	CIF 10
	JMS I SYSTEM
	10
	CDF 10
	DCA I [OLDT9	/ZERO OUT "DIRECTORY IN CORE" KEY
	CDF 0
	TAD [200
	DCA SYSTEM
	JMP I MINCOR
RLOADR,
RUN1,	TAD I [PGNAME
	DCA FILE
	JMS I DEVHND
	0101
	CCB
FILE,	0		/READ IN THE HEADER BLOCK
	JMP KMONER	/ERROR WHILE READING HEADER BLOCK
	TAD I [CCB
	JMS I [CCBTST	/TEST FOR VALID CORE CONTROL
	TAD I [CCB+3	/V3D
	RAL		/V3D
	JMS I KRCHK	/V3D CAN'T RUN SYSTEM CUSP UNDER OS78
	TAD I [CCB+1
	DCA I [MSTCDF
	TAD I [CCB+2
	DCA I [MSTADR	/MOVE THE STARTING ADDRESS INTO UPPER CORE
	TAD I [CCB+1
	DCA I [JFIELD
	TAD I [CCB+2
	DCA I [JSTART
	TAD I [CCB+3	/SET UP THE JOB INFORMATION AREA
	JMS I [RESET	/AND CLEAR INFORMATION ABOUT "RUN" HANDLER
	TAD FUDJMP
	DCA I [MSWITC		/SET MSWITC TO INHIBIT LOADING 7400
GETSW,	SKP			/SKP FOR GET, NOP FOR RUN
	JMP RUN2
	TAD P6203
	DCA I [MSTCDF
	TAD [7600
	DCA I [MSTADR		/IF A GET, SET STARTING ADDRESS TO RETURN
				/TO MONITOR
RUN2,	TAD EXTMP
	CLL CMA RAL	/POINT TO LAST DOUBLEWORD IN CCB
	TAD TCCB4	/CCB4=CCB+4
	DCA TM1		/TM1 POINTS TO SEG. ADDRESS
	TAD I TM1	/STORE ADDRES TO READ POSSIBLE OVERLAY
	DCA I [MREAD+2
	ISZ TM1		/POINT TO SEGMENT CONTROL WORD
	TAD DEVHND	/IF THE HANDLER IS IN 7600, OR
	TAD [200	/IF THE SEGMENT DOES NOT LOAD OVER
	CLA RAL		/7000, NO OVERLAY IS NEEDED. ALSO IF
	TAD I TM1	/THE SEGMENT IS IN FIELDS 1-7.
	AND [77
RUN5A,	SZA CLA
	JMP I RUNVI	/NO PROBLEMS.. READ STUFF IN
	TAD I [MREAD+2	/SEE IF WE OVERLAY 7000
	CLL CML RAR
	TAD I TM1	/ADD IN CONTROL WORD
	TAD [300
	SPA		/IF NEGATIVE, 7000 IS NOT OVERLAYED
	JMP RUN5A
	TAD [7600	/GETS 0, 100, 200, OR 300
	SMA		/IF  POSITIVE READ 3 PAGE OVERLAY
	ISZ I [PGNAME+1	/POINT TO NEXT TO LAST RECORD
	TAD [300

	DCA RDCNT
	TAD I [PGNAME+1
	CMA		/GET RECORD TO READ OVERLAY FROM
	TAD FILE
	DCA R7000
	JMS I DEVHND	/READ OVERLAY FROM THE FILE INTO PAGES
RDCNT,	0	/BEFORE CCB
	6200		/THEN WRITE THE WHOLE MESS OUT
R7000,	0
	JMP KMER1	/NOT AVAILABLE
	JMS I [WRCTLB	/WRITE OUT THE OVERLAY+CCB
	DCA .-1		/BUT ONLY ONCE!!
	ISZ RUNSW
	DCA I [MSWITC	/ENABLE READ OF OVERLAY
	TAD RDCNT	/SEE IF THIS SEG IS EXHAUSTED
	CIA
	TAD I TM1
	SPA SNA
	ISZ EXTMP	/ARE WE DONE ALL SEGMENTS?
	SKP		/NOT YET. LOOP UNTIL DONE
	JMP I [MSWITC
RUN5,	DCA I TM1	/SAVE ALTERED CONTROL WORD
	JMP RUN2
/ASDONE,	CDF 10
/	DCA I TM1	/THIS COULD BE OPTIMIZED
/	CDF 0
/	JMP I [KEYMON

KMER1,	JMS I [PRNAME	/DEVICE NOT AVAILABLE
	JMS I [PRMESG
	TEXT	/ NOT AVAIL/
TCCB4,	7404	/CCB+4
RUNVI,	RUN6
	*1000
/MUST BE AT 1000 FOR BATCH
BEGLN,	0	/LINE BUFFER	COULD BECOME "@
	"I
	"N
	"I
	"T
KMINIT,	CDF 10		/INITIALIZATION - DESTROYED BY LINE BUFFER
	ISZ I [7700	/LOC 17700=7777 IF I/O MONITOR IS KNOWN
	JMP .+3		/TO BE IN CORE, SO SET UP
	TAD [200	/THE INITIAL POINTER FOR CALLS TO THE MONITOR
	DCA SYSTEM	/ACCORDINGLY
	CDF 0
	TAD I LXR
	DCA I X1
	ISZ TEMP2
	JMP .-3
	CDF 10
	TAD MVFROM
	DCA I PDBUF
	ISZ .-2
	ISZ PDBUF
	ISZ MVCNT
	JMP .-5
	CDF 0
	TAD I PDBUF+1	/SEE IF BATCH IS SET
	RAL		/IF YES, GO TO PAGE 0 TO CONTINUE
	SMA CLA		/IF IT ISN'T, CONTINUE NORMALLY
	JMP INTGO	/NORMAL KEYBOARD SYSTEM
	DCA I RTWTPT	/DON'T WAIT ON TTY FLAG IF BATCH IS RUNNING
	TAD I [JSBITS	/IS BOS IN PLACE?
	AND DCBF
	SNA CLA
	JMP BATCH	/NO. GO READ IT IN.
	JMP BCHGO	/YES. START IT UP.
INTGO,	TAD [200
	KRS
	TAD M203
	SNA CLA		/IS THERE A ^C IN THE READER BUFFER
	KSF		/WITH THE FLAG ON?
	JMP I ERRET	/NO - PRINT CRLF AND PERIOD
	JMP CLR		/V3D
/CCLADR,	GETCCL	/V3D DIDN'T SEEM TO BE USED
RTWTPT,	RUNTWT
DCBF,	400
/START
PMSRST,	SHNDLR&177+4200	/JMS SHNDLR
	0300
	7000
	MTEMP+6
	HLT		/CONTAINS SECOND COPY OF OS/78 BIT
	CDF CIF 0
	TCF
/END
MVCNT,	MOVBUF-MVT3-1
PDBUF,	MOVBUF
MVFROM,	NOPUNCH
	*7626
	ENPUNCH
MOVBUF,	7777	/USED IN BATCH SETUP
	TAD I MVT1	/MOVE THE LINE BUFFER FROM 1000
	DCA I MVT2	/TO 1655
	ISZ MVT1
	ISZ MVT2
	ISZ MVT3
	JMP .-5
	CIF CDF 0
	JMP I MOVBUF

MVT1,	BEGLN
MVT2,	SVLNBF
MVT3,	-111


	*1077		/V3D
INIT,	CDF 10		/V3D (INITIALIZATION)
	TAD DCBF
	DCA I ROT	/RESTORE LOC 7677 TO '400'
	CDF 0
	DCA KMINIT	/END LINE WITH 0
	TLS
	JMP I CRLF	/FAKE OUT KBM AS IF USER TYPED @INIT


CLR,	KCC
	JMP I .+1
	CTRLC
TX212,	212
	*1112
	ENPUNCH

DIGTLP,	TAD I LXR
STRTX,	TAD (-270
	CLL
	TAD [10
	DCA TMP1	/V3
	SNL
	JMP EONUM
/V3	ISZ DIGFLG
	JMS ROT
	JMS ROT
	JMS ROT
	TAD TEMP2
	TAD TMP1
	DCA TEMP2
	JMP DIGTLP
EONUM,	TAD TEMP1
	AND [7
	CLL RTL
	RAL
	TAD KM6203
	DCA I [MSTCDF
	TAD TEMP2
	JMP I .+1
	STCOMN

ROT,	7677		/V3D NEEDED FOR INIT
	TAD TEMP2
	CLL RAL
	DCA TEMP2
	TAD TEMP1
	RAL
	DCA TEMP1
	JMP I ROT
DEAS,	TAD [UDNAME-1
	DCA X1
	TAD [-17
	DCA TM1
	CDF 10
	DCA I X1
	ISZ TM1
	JMP .-2
KM6203,	CDF CIF 0
	JMP I [KEYMON

ASDONE,	CDF 10		/V3
	DCA I TM1	/V3
	JMP KM6203	/V3


CRLF,	KEYMON+1	/V3D NEEDED FOR INIT
	TAD [215
	DCA NM1
	JMS I (PRNT
	TAD TX212
	JMS I PCH
	JMP I CRLF

M203,	-203
	PAGE
/NOTE: XR=AMFLAG !

	*1200
	/TELETYPE INPUT ROUTINE
XGLINE,	KEYMON+1		/MUST BE AT 1200 FOR BATCH & CCL
	TAD [".
	JMS I PCH
	DCA RBFLAG
	TAD [BEGLN-1
CHLM1,	DCA LXR
	DCA AMFLAG	/ZERO ALTMODE FLAG
CHLOOP,	KSF
	JMP CHLOOP
	TAD [200
	KRS
	DCA NM1
	KCC
	JMS SRCH
	-225;CTRLU
	-215;CARRET
	-377;RUBOUT
	-375;ALTMOD	/THIS AREA GETS MODIFIED BY SET
	-376;ALTMOD
	-233;ALTMOD
	-212;LFEED
	-200;CHLOOP
	-217;CHLOOP	/IGNORE ^O
	-203;CTRLC	/MUST BE JUST BEFORE 0
			/MUST BE HERE FOR CCL
	0
	JMS PRNT
CINSRT,	TAD NM1
	DCA I LXR
	TAD LXR
	TAD [-BEGLN-110
	SPA CLA
	JMP CHLOOP
CARRET,	JMS I [CRLF
	TAD LXR
	TAD [1-BEGLN
	SNA CLA
	JMP XGLINE+1
	DCA I LXR
	DCA I LXR
	JMP I XGLINE
/THIS PAGE GETS MODIFIED BY SET COMMANDS (FOR REAL SCOPE RUBOUTS)
/**** BEWARE! ***

PRNT,	0
	ISZ RBFLAG
	JMP .+3
	TAD ["\
	JMS I PCH
	DCA RBFLAG
	TAD NM1
	JMS I PCH
	JMP I PRNT
CTRLC,
CTRLU,	TAD ["^
	JMS I PCH
	TAD NM1
	TAD [100
CLRLIN,	JMS I PCH
RBSPCL,	JMS I [CRLF
	JMP XGLINE+1

ALTMOD,	TAD ["$
	DCA NM1
	JMS PRNT
	ISZ AMFLAG	/NOTE ALTMODE
	JMP CARRET+1
RUBOUT,	TAD LXR
	TAD [1-BEGLN
	SNA CLA
	JMP RBSPCL
	TAD ["\		/MUST BE HERE
	ISZ RBFLAG
	JMS I PCH
	CLA CMA
	DCA RBFLAG
	TAD LXR
	DCA TEMP1
	TAD I TEMP1
	JMS I PCH
LBCKUP,	CLA CMA
	TAD LXR
	JMP CHLM1
SRCH,	0
	TAD I SRCH
	ISZ SRCH
	SNA
	JMP I SRCH
	TAD NM1
	SNA CLA
	JMP SFND
	ISZ SRCH
	JMP SRCH+1
SFND,	TAD I SRCH
	DCA TEMP1
	JMP I TEMP1
LFEED,	JMS I [CRLF
	DCA I LXR
	TAD [".
	JMS I PCH
	TAD [BEGLN-1
	DCA XR
	TAD I XR
	SNA
	JMP LBCKUP
	JMS I PCH
	JMP .-4

PRQMRK,	JMS I [PRNAME
	JMP I [PRINTQ
	IFNZRO PRQMRK-1357 <SEECCL,ZZXX>
	ZBLOCK 1	/A FREE LOCATION!

	IFNZRO .-1362 <FIXCCL,ERRRR>

GETCCL,	TAD [6003
	JMS I [RESET
	TAD [67		/CCL OVERLAY BLOCK IS BLOCK 67 ***
	DCA OV
	JMP DATE2
DATE,	TAD TMP
	SNA CLA
	JMP I [CCLSW-1	/USED TO BE JMP GETCCL
DATE2,	JMS I [SHNDLR	/READ IN DATE OVERLAY
	0201
	0400
OV,	MSOVL2
	JMP KMONER
	JMP I [600
	PAGE
	*1400
SAVE2,	TAD I LXR
	SNA		/ARE THERE ANY ARGS?
	JMP SAVE2A	/NO ... USE CCB
	JMS I [SHNDLR	/READ IN ARG OVERLAY
	0201
	CSOVLY
	MSOVLY
	JMP KMONER
	JMP I CCBTST	/GO TO IT	
SAVE2A,	JMS I [SHNDLR
	0201
	400
	MTEMP+10
	JMP KMONER
SAVE3,	TAD [603
	DCA XR
	DCA LXR		/INITIALIZE FOR GT32K I.D.
	TAD I [600
	JMS I [CCBTST
	JMS I [SHNDLR
	0101
	400
	MSOVL2
	JMP KMONER
	JMP I GETOUT
SAV2X,	JMS I PGTOUT
	TAD I [600	/UPDATE THE SEGMENT COUNT BY
	CLL RAL		/FIRST,MAKING SURE 4000 BIT IS SET
	STL RAR
	CIA
	TAD MERTST	/SUBTRACT # OF GT32K SEGS THIS ALLOW US TO BYPASS... 
	DCA EXTMP	/SAVE COUNT FOR GT32K
	TAD EXTMP	
	CLL RAL		/WE WANT TO BUMP COUNTER TWICE FOR EVERY SEG
	TAD [603	/ADD POINTER TO INITIAL SEGMENT
	DCA XR
	TAD EXTMP
	CIA
	DCA EXTMP
	JMP I RCHK
KMER4,	JMS I [PRMESG
	TEXT	/TOO FEW ARGS/


CCBTST,	SAVE1A&177+400	/EXAMINE COUNT WORD OF CCB FOR VALIDITY
			/ASCII AND BINARY FILES USUALLY FAIL THIS TEST
	CLL RAL		/INSURES 4000 BIT IS SET--128K INDICATOR
	STL RAR
	DCA EXTMP
	LXM		/INITIALIZE EXTENDED MEMORY
	TAD EXTMP
	CMA
	AND [7740
	SNA CLA
	JMP I CCBTST	/IT WAS VALID
CIERR,	TAD [7605
	DCA ERRET	/RELOAD MONITOR ON THIS ERROR
	JMS I [PRMESG	/IT WASN'T - TELL THE USER
	TEXT	/CORE IMAGE ERR/
GETOUT,	SAVE3A&177+400		/SUBROUTINE TO KICK MONITOR OUT IF NECESSARY
	TAD I [JSBITS
	RAR
	CLA
	TAD SYSTEM
	SZL SPA CLA	/IS THE SYSTEM IN CORE AND SHOULD IT BE?
	JMP I GETOUT
	CIF 10		/YES AND NO - KICK IT OUT
	JMS I SYSTEM
	11		/BYE BYE
	TAD [7700
	DCA SYSTEM
	JMP I GETOUT
KMER2,	JMS PRNAME
	JMS I [PRMESG
	TEXT / NOT FOUND/
PRNAME,	4000
	TAD NM1
	JMS I [PRWD
	TAD NM2
	JMS I [PRWD
	TAD NM3
	JMS I [PRWD
	TAD NM4
	SNA CLA
	JMP I PRNAME
	TAD [256
	JMS I [PCHAR
	TAD NM4
	JMS I [PRWD
	JMP I PRNAME


RESET,	0
	DCA I [JSBITS	/MARK AREAS FOR I/O OPTOMIZATION
	JMS I [MINCOR
	CIF 10
	JMS I SYSTEM
	13		/RESET DEVICE HANDLERS AND OUTPUT FILES
	JMP I RESET

RCHK,	XLOD&177+400
	AND I XTADR	/V3D
	AND [200	/CAN'T ALLOW BOTH OS78 BIT AND SYSTEM CUSP BIT
	SZA CLA
	JMP CIERR	/V3D CAN'T FALL INTO KMER3
			/BECAUSE HAVE TO RELOAD KBM TO RESET 'PGNAME'
	TAD EXTMP
	DCA I RR7400	/SET UP SEGMENT COUNT FOR RUN LOAD
	JMP I RCHK
RR7400,	R7400
SVXER,	JMS I [PRMESG
	TEXT	/SAVE ERR/
XTADR,	OS78
	PAGE

	*1600

RUN6,	TAD I TM1	/STORE CONTROL WORD FOR LAST SEG.
	DCA I [MREAD+1
	TAD RUNSW	/IS THIS R OR RUN?
	SNA CLA
	JMS I [WRCTLB	/RUN
	TAD I RFILE	/V3D FOR LINKER
	DCA I RCTL	/V3D SAVE BLOCK NUMBER IN 'SOFSET'
	TAD I RFILE
RUN7,	IAC
	DCA RUNFIL		/STORE STARTING BLOCK NUMBER
RUN7A,	TAD DEVHND
	DCA I [MREAD-1
	TAD DEVHND
	DCA RUNHND		/STORE DEVICE HANDLER ENTRY IN THIS PAGE
	TAD I ADR1
	DCA I ADR2
	ISZ ADCNT
	JMP .-3
	JMP I .+1
	RUN8&177+7400

ADCNT,	RUN8&177+7600
RFILE,	FILE
CHK32,	0	/PROTECTS MONITOR FROM GREATER THAN 32K FIELD 0 LOAD
	TAD I RCTL1
	AND T76A		/ISOLATE CDEB BITS FOR FUTURE USE
	DCA CDE
	TAD I RCTL1
	AND [7700		/LOAD EVERY FIELD INTO FIELD 1
	TAD [10		/WE'LL BUMP IT UP FROM THERE---LATER
	DCA I RCTL1
	JMP I CHK32
T76A,	76
RCTL1,	RCTL&177+7400
MOVUP,	0		/SUBROUTINE TO MOVE UP PROGRAM CODE
	AND T3700	/CALCULATE THE NUMBER OF LOCS
	RAL
	TAD T177
	CIA
	DCA COUNT	/STORE IT HERE
	TAD CDE		/PREPARE FOR CDF TO PROPER BANK & FIELD
	CLL RTR
	SZL

SVLNBF,
	/
/NEXT 111 LOCATIONS DESTROYED BY THE LINE BUFFER DURING A SAVE
/
	TAD TX20
	CLL RTL
	TAD T6201	/STORE IT IN EXTEND
	DCA EXTEND
	TAD I RADR1	/INITIALIZE THE INDEX REGS
	TAD SPTST
	DCA ADR1
	TAD ADR1
	DCA ADR2
	TAD [7000	/SET EXTENDED MEMORY0
	LXM
BACK,	CDF 10		/MAKE THE MOVE
	TAD I ADR1
EXTEND,	0
	DCA I ADR2
	ISZ COUNT
	JMP BACK
	CDF 0
	TAD SPTST
	DCA I HF2
	TAD I RCTL1
	JMP I MOVUP
T177,	177
T3700,	3700
T6201,	6201
CDE,	0
TX20,	20
HF2,	HF3&177+7400

COUNT,	0
RADR1,	RADR&177+7400
	PAGE

	*1710
RUN8,	ISZ R7400	/IS THIS THE LAST PARAMETER PAIR?
	JMP RUN9	/NO - KEEP LOADING
	TAD RUNFIL
	DCA I RMRD3	/MOVE THE RECORD NUMBER INTO THE FINAL READ
	TSF
RUNTWT,	JMP .-1		/WAIT FOR THE TELETYPE TO DIE DOWN (RF08 IS FAST!)
	JMP I .+1
	MREAD		/READ THE LAST SEGMENT AND START UP
RUN9,	TAD I RUNADR
	DCA RADR	/SET UP THE LOADING ADDRESS OF THE CURRENT SEGMENT
	ISZ RUNADR
	TAD I RUNADR
	DCA RCTL	/AND THE READ CONTROL WORD
	TAD RCTL
	AND TS7		/TEST FOR GREATER THAN 32K
	SNA
	DCA HF3
	SZA CLA
	JMS I CH32
	JMS I RUNHND
RCTL,	SOFSET		/V3D THESE ARE STORED INTO ONLY AFTER MOVING
RADR,	OS78		/V3D
RUNFIL,	0
	JMP RERR		/INPUT ERROR READING THE PROGRAM
	TAD RCTL
	ISZ HF3		/IF GREATER THAN 32K
	JMP .+2
	JMS I MOVUPT	/LOAD HIGHER FIELDS
	JMS ROTAT		/GET THE BLOCK LENGTH OF THIS SEGMENT
	TAD RUNFIL
	DCA RUNFIL		/UPDATE THE BLOCK NUMBER FROM IT
	ISZ RUNADR
	JMP RUN8		/BACK FOR ANOTHER ONE
HF3,	-1
CH32,	CHK32
MOVUPT,	MOVUP

RERR,	CIF 10
	JMS I RU7700
TS7,	7
	0	/TOTALLY MEANINGLESS
RUNADR,	CCB+4
R7400,	7400
RMRD3,	MREAD+3
RU7700,	7700
RUNHND,	0
	IFNZRO ROTAT-SVLNBF-111&4000 <ERROR>
	*1765	/MUST BE AT TOP OF PAGE
ROTAT,	0
	CLL RTR
	RTR
	RTR
	AND RU37
	SNA
	TAD RU37
	IAC
	CLL RAR
	JMP I ROTAT
RU37,	37
	PAGE

	/OVERLAY TO KEYBOARD MONITOR FOR "SAVE" WITH ARGUMENTS
	*2000		/GOES INTO 400
SAVE1A,	TAD [1603
	DCA X1
	DCA TM1
	CDF 10
	DCA I [OLDT9
S6203,	CIF CDF 0
	TAD (SGETOUT-RSOVL2	/POINTER TO NEW GETOUT

	DCA PGTOUT		/LIKEWISE "GETOUT"
	JMS I [SHNDLR
	0210
	1400
	MTEMP+10		/READ IN CONTROL BLOCK
	JMP KMONER
	JMS I (LXRBAK-RSOVL1		/RESET LXR TO LOOK AT FIRST CHAR
	JMS I (LXRBAK-RSOVL1
	DCA DASHFG
SNUMLP,	JMS SGTNUM
	JMP SDLOOK	/NO NUMBER - GET DELIMETER
	TAD I LXR
	TAD (-"-
	SNA CLA
	JMP SVDASH
	JMS I (LXRBAK-RSOVL1
	TAD DASHFG
	SNA CLA		/WAS THERE A LOWER LIMIT?
	JMS DASHSB	/NO - SET LOWER LIMIT TO UPPER LIMIT
	TAD TEMP1
	CIA CLL CML
	TAD OLD1
	SZA CLA	/ARE THE FIELDS THE SAME?
	JMP KMER5	/NO - ERROR
	TAD TEMP2
	AND [7600
	TAD [200
	DCA TEMP2
	TAD TEMP2
	CIA
	TAD OLD2
	SZL CLA		/IS UPPER LIMIT > LOWER LIMIT?
	JMP KMER5	/NO - ERROR
	CDF 10
	TAD OLD1
	DCA I X1
	TAD OLD2
	DCA I X1
	TAD TEMP2
	DCA I X1	/CREATE A TRIPLET(FIELD, LOW LIMIT, HIGH LIMIT)
			/IN THE TABLE IN FIELD 1
	ISZ TM1		/BUMP ENTRY COUNT
SDLOOK,	CDF 0
	TAD I LXR
	SNA
	JMP I (SVEND-RSOVL1
	TAD (-",
	SNA
	JMP SNUMLP-1
	TAD [",-";
	SNA
	JMP SSTADR
	TAD [";-"=
	SNA CLA
	JMP I (SSBITS-RSOVL1
KMER5,	JMS I [PRMESG
	TEXT	/BAD ARGS/
SVDASH,	TAD DASHFG
	SZA CLA
	JMP KMER5
	ISZ DASHFG
	JMS DASHSB
	JMP SNUMLP
SSTADR,	JMS SGTNUM
	JMP KMER5	/NULL STARTING ADR - ERROR
	TAD TEMP1	/TRANSFORM FOR CDF --"37" TO "174"-128K 
	AND [7757	/ISOLATE '17' BITS
	TAD (-10
	SMA
	TAD [-17
	TAD (10
	TAD TEMP1
	CLL RTL
	TAD S6203
	CDF 10
	DCA I (1601	/STORE AWAY STARTING FIELD
	TAD TEMP2
	DCA I (1602	/AND STARTING ADDRESS
	JMP SDLOOK
DASHSB,	0
	TAD TEMP1
	AND (37		/ISOLATE FIELD( & BANK)
	DCA OLD1
	TAD TEMP2
	AND [7600
	DCA OLD2
	JMP I DASHSB
DASHFG,	0
OLD1,	0
OLD2,	0

SGTNUM,	0	/GET A NUMBER ROUTINE
	DCA DIGFLG	/CLEAR DIGIT COLLECTED FLAG
	DCA TEMP1
	DCA TEMP2
	JMS I (STARTX-RSOVL1
	JMP .+4
	TAD (20
	SNA CLA
	JMP .-4
	JMS I (LXRBAK-RSOVL1	/SHOVE INDEX BACK
	TAD DIGFLG	/IS DIGIT PRESENT?
	SZA CLA
	ISZ SGTNUM
	JMP I SGTNUM
	PAGE
	*2200	/LOADS INTO 600
SSBITS,	JMS I (SGTNUM-RSOVL1
	JMP I (KMER5-RSOVL1
	TAD TEMP2
	CDF 10
	DCA I [1603
	JMP I (SDLOOK-RSOVL1
SVEND,	JMS I [SHNDLR
	0101
	0400
	MSOVL2		/READ IN SECOND PART OF OVERLAY
	JMP KMONER
	TAD TM1
	SNA
	JMP I (MOVECB-RSOVL2
	CIA
	CDF 10
	DCA I [1600
		/NOW SORT THE ENTRIES IN THE SEGMENT TABLE ON 
		/DECREASING FIELD AND INCREASING ADDRESS
		/WITHIN THE FIELD.
	TAD [1603
	DCA P1
	CLA IAC
	TAD I [1600
	SNA
	JMP SORTED	/RIDICULOUS TO SORT ONE ITEM
	DCA TEMP1
OUTRLP,	TAD (3
	TAD P1
	DCA P2
	TAD TEMP1
	DCA TEMP2
INERLP,	TAD P1
	DCA LXR
	TAD P2
	DCA X1
	TAD I LXR
	CIA CLL
	TAD I X1
	SNA CLA
	JMP TIE		/FIELDS ARE EQUAL - SORT ON ADDRESS IN FIELD
	SZL
	JMP SWITCH	/WRONG ORDER - SWITCH 'EM
TIENTY,	TAD P2
	TAD (3
	DCA P2		/INDEX TO NEXT ENTRY
SWNTRY,	ISZ TEMP2
	JMP INERLP
	TAD P1
	TAD (3
	DCA P1		/ELEMENT IS IN PLACE - GO TO NEXT POSITION
	ISZ TEMP1
	JMP OUTRLP
	JMP SORTED	/SORT COMPLETE - CHECK FOR CONSISTENCY
TIE,	TAD I LXR
	CIA CLL
	TAD I X1
	SZL CLA		/TEST FOR ADRESSES IN ASCENDING ORDER
	JMP TIENTY	/YES - DONT HAVE TO SWAP
SWITCH,	JMS SWSUBR
	JMS SWSUBR
	JMS SWSUBR
	CLA CLL CMA RTL
	TAD P1
	DCA P1		/RESET FIRST POINTER
	JMP SWNTRY	/AND DONT BUMP 2D POINTER, AS WE HAVE JUST BUMPED IT
SWSUBR,	0
	ISZ P1
	ISZ P2
	TAD I P1
	DCA TM1
	TAD I P2
	DCA I P1
	TAD TM1
	DCA I P2
	JMP I SWSUBR
P1,	0
P2,	0

STARTX,	0
	TAD I LXR	/ANYTHING LEFT?
	SNA
	JMP I STARTX	/NO.. TAKE EMPTY RETURN
	SKP
ADGTLP,	TAD I LXR
	TAD (-270
	CLL		/SEE IF THIS IS A DIGIT
	TAD [10
	SNL
	JMP AONUM	/NO.. GET OUT
	DCA TMP1
	ISZ DIGFLG
	JMS ROT2
	JMS ROT2
	JMS ROT2
	TAD TEMP2
	TAD TMP1
	DCA TEMP2
	JMP ADGTLP	/KEEP LOOKING
AONUM,	ISZ STARTX
	JMP I STARTX

ROT2,	0
	TAD TEMP2
	CLL RAL		/WE NEED THIS BECAUSE THE HANDLER
	DCA TEMP2	/WIPED THE FIRST COPY (MAYBE!!!)
	TAD TEMP1
	RAL
	DCA TEMP1
	JMP I ROT2
LXRBAK,	0
	CLA CMA
	TAD LXR
	DCA LXR
	JMP I LXRBAK
SORTED,	TAD I [1600
	IAC
	SNA
	JMP I (MERGED-RSOVL2
	DCA TEMP1
	TAD [1603
	DCA X1
	TAD (1606
	DCA LXR
	JMP I [MRGLP-RSOVL2
	PAGE
	*2400		/LOADS INTO 400 ON TOP OF SAVE1A
		/NOW CHECK THE SORTED FILE FOR CONSISTENCY
		/OVERLAPPING SEGMENTS ARE ERRORS,
		/ABUTTING SEGMENTS ARE TO BE CONDENSED IN
		/THE INTERESTS OF SPEED
MRGLP,	TAD I LXR
	CIA
	TAD I X1
	SZA CLA
	JMP NOCMPR	/DIFFERENT FIELDS - INCOMPARABLE
	ISZ X1
	TAD I X1
	CIA
	CLL
	TAD I LXR
	SNA CLA
	JMP BUTTNG	/UPPER LIMIT(2)=LOWER LIMIT(1) - ABUTTING SEGMENTS
	SZL CLA
	JMP NXTONE	/UPPER LIM(2)<LOWER LIM(1) - NORMAL CASE
	CDF 0		/UPPER LIM(2) > LOWER LIM(1) - ERROR
	JMS I [PRMESG
	TEXT	/BAD ARGS/
BUTTNG,	CLA CMA
	TAD X1
	DCA X1
	TAD I LXR
	DCA I X1	/SET UPPER LIM(2) = UPPER LIM(1)
	TAD X1
	TAD (-1777
	SZA CLA
	JMP .-5		/AND COMPRESS OUT THE LOWER ENTRY
	ISZ I [1600	/DECREMENT THE ENTRY COUNT (CAN'T OVERFLOW)
	JMP I  (SORTED-RSOVL1	/START OVER FROM BEGINNING

NOCMPR,	ISZ X1
	ISZ X1
	ISZ LXR
NXTONE,	ISZ LXR
	ISZ TEMP1
	JMP MRGLP	/NOW ALL THAT REMAINS IS TO TRANSFORM OUR TRIPLETS
			/INTO THE FORMAT WHICH THE RUN LOADER EXPECTS; I.E.
		/DEVICE-HANDLER ARGUMENTS
MERGED,	CDF 0		/LOAD IN MERGED OVERLAY
	JMS I [SHNDLR
	0100
	0600
	64
	JMP KMONER
	JMP I (MERGEX
MOVECB,	TAD (-1777
	DCA MERTST
	JMP MERGED
CBMOVE,	CDF 10		/FINAL CODE TO MOVE NEW CONTROL BLOCK
	TAD I LXR	/INTO PAGE 600 OF FIELD 0
	CDF 0
	DCA I X1
	ISZ TEMP1
	JMP CBMOVE
	JMP I (SAVE3		/EXIT TO SAVE PROCESSOR 
SAVE3A,	ISZ XR
	TAD I XR	/GET THE I/O CONTROL WORD OF THIS SEGMENT
	DCA ADR2	/CAUTION AUTO-INDEX TEST FOR GREATER THAN 32K
	TAD ADR2
	AND [7		/ARE THERE ANY BANK BITS?
	SZA CLA
	JMP XTAT	/NO- PROCEED AS NORMAL
	TAD SPTST	/ONLY WANT TO ISOLATE FIRST FIELD
	SNA CLA		/BELOW 32K
	JMP XTAT
	TAD CLENGT	/SET UP FIRST FIELD I.D.
	DCA LXR		/CAUTION AUTO-INDEX-SAVE BLOCK OFFSET
	TAD EXTMP	/SAVE NUMBER OF SEGS LEFT
	DCA MERTST	/... NEGATIVE OF # LEFT
	DCA SPTST	/SET I.D. "SET" FLAG
XTAT,	TAD ADR2
	JMS I PROTAT	/EXTRACT THE LENGTH FROM IT
	TAD CLENGT
	DCA CLENGT	/UPDATE THE LENGTH OF THE FILE
	ISZ EXTMP
	JMP SAVE3A		/LOOP FOR ALL SEGMENTS OF THE FILE
	TAD CLENGT	/USE THIS LENGTH WHEN ENTERING THE FILE
	CLL RTL
	RTL
	TAD SENTER
	CIF 10
	JMS I SYSTEM
	3		/ENTER
SFILE,	NM1
	0		/LENGHT UNIMPORTANT
	JMP I (SVXER	/SAVERR CODE REPEATED
	CIF CDF 10
	TAD I [DVHREC
	CDF 0
	DCA I [LDBLK
	TAD SENTER
	JMS I SYSTEM
	4		/CLOSE
	NM1		/NAME FOR "CLOSE"
CLENGT,	1		/CLOSING LENGTH
	JMP I (SVXER
	JMP I (SAV2X
XLOD,	JMS I [SHNDLR
	0201
	1200
	64
	JMP KMONER
	JMP I (SAVXX	/JMP T0 1400

SGETOUT,0		/REPLACES "GETOUT" WHICH WE'VE STORED OVER
	TAD I [JSBITS
	RAL		/ONLY PERFORMS THOSE FUNCTIONS THAT "SAVE" NEEDS
	SPA CLA
	JMP I SGETOUT
	CIF 10
	JMS I SYSTEM
	11
DECIMB,	JMP I SGETOUT	/DECIMB ONLY CALLED BY NEXT PAGE
			/PART OF NEXT PAGE'S ROUTINE:
	TAD NM2		/ALL NEW FOR V3D
	TAD NM4		/ONLY ALLOW 2 CHARS FOR MM
	SNA CLA
	ISZ DECIMB
	TAD NM1
	RTR
	RTR
	JMP I DECIMB
PROTAT,	ROTAT
	*2600		/DATE PROCESSOR - LOADS IN 400, RUNS IN 600
DATEXX,	JMS DECIM
NUM2,	DCA NUM2
	TAD NUM2
	TAD M40
	SMA CLA
	JMP BADNUM	/DAY > 31
	JMS I GNAME
L30,	30		/NOTHING FOUND WILL GIVE ERROR LATER
/	DCA NUM1	/NUM1 IS INITIALLY 0
NEWLUP,	ISZ MONPTR
	ISZ NUM1
	TAD I MONPTR
	ISZ MONPTR
	SMA
	JMP BADNUM	/SYMBOLIC MONTH NOT FOUND
	TAD NM1
	SNA CLA		/SKIP IF FIRST 2 LETTERS DON'T MATCH
	TAD NM2
	TAD I MONPTR
	SZA CLA
	JMP NEWLUP	/SECOND 2 LETTERS DON'T MATCH
/*** TEST DELIMETER HERE
	TAD NUM1
	CLL RTL
	RTL
	RAL
	TAD NUM2
	RTL
	RAL
	DCA NUM2
	DCA DDELIM	/MAKE END-OF-LINE THE DELIMITER
	JMS DECIM
	TAD (-106	/SCALE DOWN TO RANGE 1970-1999
	SPA
	JMP BADNUM	/DIDN'T MAKE THE RANGE
	DCA NUM1
	TAD NUM1
	AND L30		/ISOLATE EXTENSION DATE BITS
	CLL RTL
	RTL
	DCA TM1
	TAD I (BIPCCL
	AND L7177	/STORE THEM INTO BITS RESERVED FOR THIS PURPOSE
	TAD TM1
TSLUP,	DCA I (BIPCCL
	TAD NUM1
	AND [7
	TAD NUM2	/COMBINE WITH MONTH AND DAY
	CDF 10
	DCA I (MDATE	/STORE IN SYSTEM DATE CELL
	TSF		/7605 SETS THE DF
	JMS L7177	/TIME OUT A BIT
	JMP I [7605	/IN CASE RUNNING UNDER BATCH
L7177,	7177		/JMS IS LONGER THAN JMP
	ISZ DDELIM	/DDELIM IS 0 AT END
	JMS TSLUP	/WAIT FOR TELETYPE TO DIE DOWN (RF08)
	JMP I [7605	/RETURN TO MONITOR
DDELIM,	-"-

/WOULD LIKE TO BRANCH TO CCLSW-1 IF DATE ENDED WITH ALTMODE

CNV,	0
	AND [77
	SNA
	JMP NUL
	TAD (-60
	SPA
	JMP BADNUM
	JMP I CNV
NUL,	TAD TM1
	JMP GODE

DECIM,	0
	JMS I GNAME
M40,	-40		/NOTHING THERE (LOGIC WILL CAUSE ERROR LATER)
	TAD TMP
	TAD DDELIM	/COMPARE AGAINST DESIRED DELIMETER
	SNA CLA		/DASH OR NULL
	JMS I (DECIMB-2400+400
	JMP BADNUM	/DELIMETER BAD
	RTR
	JMS CNV
	DCA TM1
	TAD TM1
	CLL RTL
	TAD TM1
	RAL
	DCA TEMP2
	TAD NM1
	JMS CNV
	TAD TEMP2
GODE,	SZA
	JMP I DECIM
BADNUM,	CLA		/CRAP IN AC
	TAD [7605
	DCA ERRET
	JMS I [PRMESG
	TEXT	/BAD DATE/
NUM1,	0		/MONTH NUMBER (MUST BE 0 INITIALLY)
MONS,	-1201	/JAN
	-1600
	-0605	/FEB
	-0200
	-1501	/MAR
	-2200
	-0120	/APR
	-2200
	-1501	/MAY
	-3100
	-1225	/JUN
	-1600
	-1225	/JUL
	-1400
	-0125	/AUG
	-0700
	-2305	/SEP
	-2000
	-1703	/OCT
	-2400
	-1617	/NOV
	-2600
	-0405	/DEC
	-0300
MONPTR,	MONS-2600+600-1	/RELOCATES TO PAGE 600
			/MUST BE POSITIVE

	PAGE
	*3000	/MONITOR ERROR PROCESSOR - LOADS INTO 11400
DLYLPX,	AND I 0
D7600,	7600
	TAD MERRNO
	CLL RAL
	ISZ I (ZERO-1400
	ISZ I (ZERO-1400	/V3C
	ISZ I (ZERO-1400
	JMP DLYLPX	/WAIT FOR TELEPRINTER (WITHOUT CDF'S)
	SNA
	JMP USRERR
	CLL RAL
	RTL
	RTL
	TAD (6040
	DCA I (MERTYP-1400
MERCMN,	TAD (MERRXR-1400
	JMS EPRINT
	TAD I (FPUTX
	RTR
	RAR
	AND (7
	TAD (60
	JMS MERPCH
	CLA CLL CMA RAL
	TAD I (MONITO
	RAL
	DCA T1
	TAD (-4
	DCA T2
MEROLP,	TAD T1
	RTL
	RAL
	DCA T1
	TAD T1
	AND (7
	TAD (60
	JMS MERPCH
	ISZ T2
	JMP MEROLP
	TAD MERRNO
	CLL RAL
	SNA
	JMP NOEXPL	/NO EXPLANATION FOR USER ERRORS
	CLL RAR
	TAD (EXPLTBL-1401	/PRINT EXPLANATION
	DCA T1		/GET ADDRESS INTO MESSAGE TABLE
	TAD (240
	JMS MERPCH
	TAD ("(
	JMS MERPCH
	TAD I T1	/GET ADDRESS OF MESSAGE
	JMS EPRINT
	TAD (")
	JMS MERPCH
	TAD MERRNO
NOEXPL,	TAD (3773
	SPA CLA
	CLA CMA
	DCA I (7700
	DCA OLDT9
	CLA CLL CML RAR
	DCA MERRNO
	CDF 0
	TAD I (JSBITS
	AND (6777
	TAD (1000
	DCA I (JSBITS	/SET THE CURRENT JOB UNSTARTABLE
	CDF CIF 0
	JMP I D7600
USRERR,	CLA CLL
	JMS I (FGET
	TAD (4060
	DCA I (UERTYP-1400
	TAD (UERRXR-MERRXR
	JMP MERCMN
MERPCH,	0
	TLS
	TSF
	JMP .-1
	CLA
	JMP I MERPCH
ZERO,	0
EPRINT,	0
	DCA T2
EPRLUP,	TAD I T2
	RTR
	RTR
	RTR
	JMS EPR
	TAD I T2
	JMS EPR
	ISZ T2
	JMP EPRLUP

EPR,	0
	AND (77
	SNA
	JMP I EPRINT
	TAD (240
	AND (77
	TAD (240
	JMS MERPCH
	JMP I EPR
	PAGE
	*3200		/LOADS INTO 1600

MERRXR,	TEXT	\MONITOR ERROR 0 AT \
	MERTYP=MERRXR+7

UERRXR,	TEXT	\USER ERROR 0 AT \
	UERTYP=UERRXR+5

EXPLTBL,MON1-1400
	MON2-1400
	MON3-1400
	MON4-1400
	MON5-1400
	MON6-1400
	MON7-1400

MON1,	TEXT	\CLOSE ERROR\
MON2,	TEXT	\DIRECTORY I/O ERROR\
MON3,	TEXT	\DEVICE HANDLER NOT IN CORE\
MON4,	TEXT	\ILLEGAL USR CALL\
MON5,	TEXT	\I/O ERROR ON SYS:\
MON6,	TEXT	\DIRECTORY OVERFLOW\
MON7,	TEXT	\RESERVED\
		/EXECUTION TIME LOADER FOR MONITOR "CHAIN" COMMAND
	*3400	/EXECUTES IN FIELD 0 IN PAGE 7400
MCHNX,	DCA MCHREC		/STORE STARTING RECORD #
	TAD MCHREC
	DCA I (SOFSET	/V3D SAVE STARTING ADDRESS
	CIF 10
	JMS I (200
	13		/RESET ALL DEVICE ASSIGNMENTS
	0		/BUT DON'T CLEAR OUTPUT FILES
	CIF 10
	JMS I (200
	11		/KICK MONITOR OUT AND RESTORE CORE IF NECESSARY
	JMS MCHRD	/PARAMETERS PRESET TO READ CONTROL BLOCK INT0 7200
	TAD I (7200	/TEST FOR SAVE FILE!
	CMA		/TEST FOR VALID CCB
	AND (7740
	SZA CLA
	JMP CHERR
	TAD I (7201
	DCA I (MSTCDF	/TRANSFER INFORMATION FROM CONTROL BLOCK
	CLA IAC
	TAD I (7202
	DCA I (MSTADR	/TO PAGE 7600
	TAD I (7203
	TAD (1000
	DCA I (JSBITS
	TAD (7204
	DCA MCHT1
	TAD MCHFJM
	DCA I (MSWITC
	TAD (TCF
	DCA I (MSTCDF+1
MCHN1,	ISZ I (7200
	JMP MCHN2
	TAD I MCHT1
	DCA I (MREAD+2
	ISZ MCHT1
	TAD I MCHT1
	DCA I (MREAD+1
	TAD MCHREC
	DCA I (MREAD+3
	TAD (SHNDLR
	DCA I (MREAD-1
	JMP I (MREAD
MCHN2,	TAD I MCHT1
	DCA MCHADR	/SET UP COMMAND TO READ NEXT SEGMENT
	ISZ MCHT1
	TAD I MCHT1
	DCA MCHCTL
	JMS MCHRD	/READ IT
	ISZ MCHT1
	JMP MCHN1	/LOOP ON NUMBER OF SEGMENTS
MCHRD,	0
	JMS I (SHNDLR
MCHCTL,	0101		/1 RECORD INTO FIELD 0 STARTING FORWARDS
MCHADR,	7200
MCHREC,	0
	JMP CHERR	/CHAIN ERROR
	TAD MCHCTL
MCHBMP,	CLL RTR
	RTR
	RTR
	AND (37
	SNA		/V3C
	TAD (40		/0 MEANS FULL 4K READ
	IAC
	CLL RAR
	TAD MCHREC
	DCA MCHREC
	JMP I MCHRD
MCHT1,	0
MCHFJM,	MSTCDF&177+5200	/"JMP MSTCDF"

CHERR,	ISZ CHERR1
	JMP CHERR	/LET TTY DIE DOWN
	ISZ CHERR2
	JMP CHERR
CHTADC,	TAD CHARS
	SNA
	JMP I (7600	/DONE..BACK TO MONITOR
	TLS
	TSF
	JMP .-1
	CLA
	ISZ CHTADC	/NEXT LETTER
	JMP CHTADC
CHERR1,	0
CHERR2,	-6
CHARS,	"C;"H;"A;"I;"N;" ;"E;"R;"R;215;212;0
	PAGE
	*3600
	RELOC 1400
SAVXX,	TAD I SXFLE	/STORES SFILE
	DCA SWFILE
	JMS I PHNDL	/LOAD IN NON SYS HANDLER
	JMS SWRITE	/WRITE OUT CCB
	TAD MERTST	/MINUS THE # OF SEGS OF LT32K CODE
	DCA I [600
	TAD LXR		/# OF BLOCKS OF GT 32K SEGS
	SNA		/LXR IS ZERO IF ALL SEGS ARE ABOVE 32K
	JMP OVR32
	TAD I SXFLE	/LXR--- COMPENSATES FOR CCB
	DCA SWFILE
SAVE4,	TAD I XR
	DCA SADR
	CLA CLL CML RAR
	TAD I XR
	DCA SCTL
SAVE5,  TAD SADR
        RAL
        SZL SPA CLA     /DOES THIS SEGMENT START BELOW 2000?
        JMP SAVE8       /NO - NOTHING TO WORRY ABOUT
        TAD SCTL
        AND T76
        SZA CLA         /FIELD 0?
        JMP SAVE8       /NO - SAVE AS IS
SAVE6,  JMS LOADF0      /LOAD THE FIELD 0 SAVE AREA OVER THE I/O MONITOR
SAVE7,  CLA CMA
        TAD SCTL
        CLL RAL
        TAD SADR
        RAL
        SZL SPA CLA     /CHECK WHETHER UPPER LIMIT IS ABOVE 2000
        JMP SAVE7A      /IT IS - MUST MAKE 2 WRITES
        TAD SCTL        /TOTALLY CONTAINED IN 0-1777
        TAD [10		/CHANGE FIELD 0 TO FIELD 1 AND CONTINUE
        JMP SAVE8A
SAVE7A, TAD SCTL        /WRITE IN 2 PARTS -
        DCA TM1
        TAD SADR
        CIA	     /FIRST PART FROM FIELD 1, EVERYTHING BELOW 2000
        TAD [2020
        CLL CML RAR
        DCA SCTL
        JMS SWRITE
        CLA CLL CML RTR
        DCA SADR
        TAD SCTL        /SECOND PART FROM FIELD 0, EVERYTHING ABOVE 2000
        AND [3700
        CIA
        TAD TM1
	SMA		/FULL FIELD SAVE IN F0 MAKES THIS +
	TAD [4000	/COMPENSATE FOR THAT CASE
SAVE8A, DCA SCTL
SAVE8,  JMS SWRITE
	ISZ I [600
	JMP SAVE4
	STA		/LXR BECOMES ONE BECAUSE OF CCB

	TAD LXR		/NUMBER OF BLOCKS OF GT32K SEGS
	SNA CLA
	JMP I [SAVE12
OVR32,	TAD I SXFLE	/RESET FILE TO INITIAL BLOCK
	IAC		/COMPENSATE FOR CCB
	DCA SWFILE
	TAD [603	/RESET CCB POINTER
	DCA ADR1
	TAD [7000
	LXM
SAVE4B,	TAD I ADR1	/IDENTICAL TO SAVE4 CODE
	DCA SADR
	CLA CLL CML RAR
	TAD I ADR1
	DCA SCTL
	DCA ADR2	/SET UP TO MOVE GREATER THAN 32K CODE DOWN
	DCA X1		/DITTO
	DCA SXFLE	/INTIALIZE FOR COUNTER
	TAD SCTL	/SET UP CDF FOR MOVE
	AND T76		/ISOLATE BANK AND FIELD
	CLL RTR		/ADJUST MENT
	SZL
	TAD T20
	CLL RTL
	TAD FDC0
	DCA .+1
XFSP,	0		/START OF MOVE LOOP
	TAD I ADR2
	CDF 70		/PUT THEM IN FIELD SEVEN
	DCA I X1	/IT SEEMS LIKE A GOOD FIELD 
	ISZ SXFLE
	JMP .-5
FDC0,	CDF 0		/LOOP IS OFFICIALLY OVER
	TAD SCTL	/ADJUST SWRITE CONTROL WORD
	AND [7700
	TAD [70		/TO FIELD SEVEN
	DCA SCTL
	JMS SWRITE
	ISZ EXTMP	/IS THAT ALL THE SEGMENTS??
	JMP SAVE4B	/NO ---CONTINUE
	JMP I [SAVE12	/TIME TO EXIT
LOADF0,	0
	/ISZ F0OVLY	/HAS THE FIELD 0 OVERLAY BEEN LOADED BEFORE?
	/JMP I LOADF0	/EVIDENTLY
	JMS I [SHNDLR
	1010
F0OVLY,	0		/WILL BE 0 IF WE EXECUTE THIS CODE, OF COURSE
	MTEMP+4
	JMP KMONER
	JMP I LOADF0

SWRITE,	0
	JMS I DEVHND
SCTL,	4101
SADR,	600
SWFILE,	0
	JMP KMONER
	TAD SCTL
	CLL RTR
	RTR
	RTR
	AND RO37
	SNA
	TAD RO37
	IAC
	CLL RAR
	TAD SWFILE
	DCA SWFILE	/BUMP RECORD NUMBER
	JMP I SWRITE
RO37,	37
T76,	76
T20,	20
PHNDL,	HNDL
SXFLE,	SFILE&177+400
	RELOC
	PAGE

	*4000	/SYSTEM GENERATOR - WRITES STUFF OUT USING SHNDLR
	WRITE=JMS I SYSHND
	JMS SYSSWP	/SWAP SYSTEM DEVICE HANDLER INTO 7600

	WRITE;	4200;	7400;	0;	JMP BERR	/BOOTSTRAP
	TAD RBFLAG
	SZA CLA
	JMP .+6
	WRITE;	4210;	DCOUNT;	01;	JMP BERR	/DIRECTORY
	WRITE;	5001;	0000;	07;	JMP BERR	/KEYBOARD MONITOR
	WRITE;	4610;	0000;	MONTOR;	JMP BERR	/USR
	WRITE;	4111;	3400;	MEOVLY;	JMP BERR	/"ENTER" OVERLAY
	WRITE;	4701;	2000;	MSOVLY;	JMP BERR	/SAVE OVERLAY,
					/ERROR ROUTINE AND "CHAIN"
	TAD RBFLAG
	SZA CLA
	JMP .+13
	WRITE;	4101;	LDRCTL;	MFREE;	JMP BERR	/ABSLDR CONTROL BLOCK
	WRITE;	5010;	2000;MFREE+1;	JMP BERR	/ABSLDR
	JMS I (4200	/OUTPUT THE DEVICE HANDLERS
	JMP BERR
	JMS SYSSWP	/SWAP BACK PAGE 7600
	CLA CMA
	HLT
	CLA
	JMP I .+1
BERR,	7600
	JMS SYSSWP
	HLT
	JMP .-1
W6600,	6600
W7600,	7600
SYSSWP,	0
	TAD W6600
	DCA SYTM1
	TAD W7600
	DCA SYTM2
SWAPLP,	TAD I SYTM1
	DCA TMSY
	TAD I SYTM2
	DCA I SYTM1
	TAD TMSY
	DCA I SYTM2
	ISZ SYTM1
	ISZ SYTM2
	JMP SWAPLP
	JMP I SYSSWP

	/CONTROL BLOCK FOR ABSOLUTE LOADER
LDRCTL,	7777	/ONE CONTIGUOUS LOAD
	6213	/STARTING ADDRESS IN FIELD 1
	2000	/STARTING LOCATION=12000
	6003	/DOES NOT LOAD OVER EITHER MONITOR AREA
		/ALSO DOES NOT USE THESE AREAS AT COMMAND TIME - TRUE
		/ONLY FOR FIRST CALL TO COMMAND DECODER
	2000	/FIRST(AND ONLY) SEGMENT STARTS AT 2000
	1210	/IN FIELD 1 AND IS 10 PAGES LONG

	IFNZRO LDRCTL-4113 <BLDER,XQX>

SYTM1,	0
SYTM2,	0
TMSY,	0
SYSHND,	7607
	PAGE

	*4264
	RELOC 664

MERGEX,	CDF 10
	TAD MERTST
	SZA CLA
	JMP MOVEC
	TAD [1603	/LOADS INTO 600--MERGED--CODE
	DCA LXR
	TAD [1603
	DCA X1
	TAD I [1603
	AND T1777
	TAD T6000
	DCA I [1603	/INITIALIZE STATUS BITS TO NO OVERLOADS
	TAD I [1600
	DCA TEMP1
MERGLP,	TAD I LXR
	AND TX37
	CLL RTR		/TRANSFORM 'ABCDE' TO 'CDEBA0'
	RTR
	SZL		/TEST FOR 'B' BANK
	TAD [400
	CLL RAR
	SZL		/TEST FOR 'A' BANK
	TAD [100
	CLL RTR
	RTR
	RAR
	DCA TEMP2
	TAD I LXR
	AND [7400
	DCA TMP1
	TAD TMP1
	DCA I X1	/STORE ADDRESS
	TAD TMP1
	CIA
	TAD I LXR	/FORM UPPER LIM - LOWER LIM
	CLL RAR
	TAD TEMP2	/ADD IN FIELD
	DCA I X1
	TAD TMP1
	CLL RAL
	SZL SPA CLA	/IS THE LOWER LIMIT < 2000?
	JMP NXTSEG	/NO
	TAD TEMP2
	RAR
	SZA CLA		/YES- IS THE FIELD 0 OR 1?
	JMP NXTSEG	/NO
	SNL
	IAC
	CMA CML RTR
	AND I [1603	/AND OUT THE PROPER OVERLOAD BIT
	DCA I [1603
NXTSEG,	ISZ TEMP1
	JMP MERGLP
	TAD I T1605	/TEST FIRST SEGMENT FOR GREATER THAN 32K
	AND [7
	SNA CLA		/IF GREATER THAN 32K SET
	JMP MOVEC
	TAD I [1600	/THE 4000 BIT OF THE FIRST WORD OF THE CCB TO ZERO
	RAL
	CLL RAR
	DCA I [1600
	/REMOVED LXM PUT IT IN MOVE UP CODE
MOVEC,	TAD T1577
	DCA LXR
	TAD T577
	DCA X1
	TAD [7600
	DCA TEMP1
	DCA MERTST	/SET MOVE I.D. TO ZERO
	JMP I MVECB	/RETURN TIME
MVECB,	CBMOVE&177+400
T1605,	1605
T1777,	1777
T6000,	6000
T1577,	1577
T577,	577
TX37,	37
	RELOC
	PAGE

	*7400
	NOPUNCH
	*7600
	ENPUNCH
	/UPPER PAGE OF FIELD 1 - CHOCK FULL OF GOODIES
	/LIKE THOUSANDS OF TABLES AND THE MONITOR CALL LOCATION

MOFILE,	ZBLOCK 17	/OUTPUT FILE TABLE - 7600-7616 (3 ENTRIES MAX)
			/5 WORDS PER ENTRY - DEVICE # AND FILE NAME
MIFILE,	ZBLOCK 24	/INPUT FILE TABLE - 7617-7642 (10 ENTRIES MAX)
			/2 WORDS PER ENTRY - DEVICE # AND RECORD #

			/LAST WORD IN TABLE CONTAINS TERMINATION INDICATOR
			/(0 FOR CR, 1 FOR ALTMODE) AND HIGH ORDER
			/PART OF NUMERICAL ARGUMENT

MPARAM,	ZBLOCK 4	/PARAMETER TABLE - 7643-7646
			/FIRST 3 WORDS - MASK OF SWITCHES(A-Z,0-9).
			/FOURTH WORD - CONTAINS THE LOW ORDER BITS OF
			/THE NUMERICAL ARGUMENT



			/TABLE OF DEVICE HANDLERS PRESENTLY IN CORE
DVHNDL,	7607;7607;0;0;0;0;0
	0;0;0;0;0;0;0;0
MDATE,	0		/HOLDS THE CURRENT DATE- 4 BIT MONTH,
			/5 BIT DAY, 3 BIT YEAR FROM 1970
MGET,	CIF 0
	JMS SHNDLR	/INST FIELD IS 0
	1000		/READ 4 RECORDS INTO FIELD 0
	0		/LOCATIONS 0-1777
	7		/KEYBOARD MONITOR FOLLOWS DIRECTORY
PJSBTS,	JSBITS		/SERVES AS A HALT (WATCH IT!)
SCDCIF,	CDF CIF 0
	JMP I .+1
	KMNTRY		/V3D GETS CHANGED TO INIT
MCALL1,	0
	DCA MARG1	/SAVE AC AS IT MAY CONTAIN AN ARGUMENT
	RDF	/GET CALLING FIELD
	TAD SCDCIF
	DCA SMCIF
	CDF 0
	TAD I PJSBTS
	RAR
	CDF 10
	SZL CLA		/DOES JOB USE LOCS 10000-11777?
	JMP MONRD	/NO - DONT SAVE THEM
	CIF 0
	JMS SHNDLR
	5010
	0
	MTEMP
	HLT
MONRD,	CIF 0
	JMS SHNDLR
	610
	0
	MONTOR
SCOPE,	HLT		/BIT 4 IS A 1 IF CONSOLE IS A SCOPE
	JMP MSTART	/START THE MONITOR UP IN PAGE 0
MRETRN,	CIF 0
	JMS SHNDLR
	1010	/READ 10 RECS INTO FIELD 1
	0
	MTEMP	/TEMP REGION ON SYS
	HLT	/SYS HAS PROBLEMS
SMCIF,	0
	JMP I MCALL1
MARG1,	0
			/TABLE OF USER DEVICE NAMES
			/ALSO USED BY SYSTEM ODT

UDNAME,	0;0;0;0;0;0;0;0;0;0;0;0;0;0;0
DCB,	ZBLOCK 17		/DEVICE CONTROL BLOCK - SET IN "CONFIG"









	/********************************************************
	/	MAP OF SYSTEM DEVICE AS OF 2/21/73
	/********************************************************
	/            *   256 WORD RECORDS   *
	/********************************************************

	/	RECORDS    CONTENTS
	/	-------    --------

	/	 0	MONITOR BOOTSTRAP
	/	 1- 6	SYSTEM DIRECTORIES
	/	 7-12	KEYBOARD MONITOR
	/	13-15	I/O MONITOR(CALLABLE MONITOR)
	/	16-25	DEVICE HANDLER RECORDS
	/	26	MONITOR "ENTER" OVERLAY
	/	27-50	MONITOR SCRATCH AREA FOR SAVING CORE
	/	51-53	COMMAND DECODER
	/	54-55	"SAVE WITH ARGUMENTS" AND "DATE" OVERLAYS
	/	56	MONITOR ERROR ROUTINE
	/	57	"CHAIN" PROCESSOR
	/	60-63	SYSTEM ODT
	/	64	RESERVED FOR EXPANSION
	/65	CCL REMINISCENSES
	/	66	USED BY TWO-PAGE SYS HANDLER
	/	67	USED BY CCL (CCL OVERLAY)
	/	70-END	FILE STORAGE
	SHNDLR=7607	/ENTRY POINT TO SYSTEMS HANDLER

	*6600
	NOPUNCH
	*7600
	ENPUNCH

	/SYSTEM HANDLER AND FIELD 0 UPPER PAGE
	/INCLUDES BOOTSTRAP AND PART OF MONITOR CALL ROUTINE
	DVHORG=16	/DEVICE HANDLER RECORDS
	MTEMP=27
	MONTOR=13
	JMS SHNDLR
	5000		/SAVE MONITOR CORE - WRITE 5 RECORDS FROM FIELD 0
	0		/(LOCATIONS 0-1777)
	MTEMP+4
	7602		/TROUBLE WITH SYSTEM DEVICE
	CDF CIF 10
	JMP MGET	/NOW GO READ IN THE KEYBOARD MONITOR
	*6744	/INFORMATION ABOUT CURRENT JOB
	NOPUNCH
	*7744
	ENPUNCH
JFIELD,	6203	/A CDF CIF N INSTRUCTION TO START THE JOB
JSTART,	7600	/THE STARTING ADDRESS
JSBITS,	1000	/VARIOUS STATUS BITS - USED FOR OPTIMIZATION
		/BIT 4000 - JOB DID NOT LOAD INTO 00000-01777
		/BIT 2000 - JOB DID NOT LOAD INTO 10000-11777
		/BIT 1000	- JOB IS NOT RESTARTABLE
		/BIT 400 - DOESN'T DESTROY BATCH MONITOR
		/BIT 2    - JOB DOES NOT USE LOCS 00000-01777
		/BIT 1    - JOB DOES NOT USE LOCS 10000-11777
SOFSET,	0	/FOR FUTURE(AND MAYBE PRESENT) USE

	/DATA BREAK FILLERS FOR SYSTEM BOOTSTRAP
	7750
	7751
	7752
	7753
	7754
	7755
		/MONITOR PATCH TO HELP BLEEP LOADER
	0	/ADDRESS OF HANDLER FOR DEVICE USED
MREAD,	HLT
	0
	0
	0
	HLT
MSWITC,	JMP .+6	/ZEROED IF PG 7000 (HANDLER) MUST BE READ OVER
	JMS SHNDLR
	0300
	7000		/THIS AREA MODIFIED BY ODT
	MTEMP+6
OS78,	HLT		/BIT 4 IS A 1 IF OS/78 IS RUNNING
MSTCDF,	CDF CIF 0
	TCF		/EXIT WITH A CLEAR CONSCIENCE(ALSO A CLEAR FLAG)
	JMP I .+1
MSTADR,	0
SBLOCK,	0
BIPCCL,	0	/MORE STATUS BITS.
		/BIT 1: 1=> BATCH IS IN PROGRESS
		/BITS 6-8: FIELD OF BATCH MONITOR
		/HIGHEST CORE FIELD USED BY OS/8
		/OR 0 TO MEAN OS/8 MAY USE ALL OF CORE
	*0
	VERSNO		/OS/8 VERSION NUMBER
	CIF 30
	JMP .-1		/HIGROUND SUPPORT
KMONER,	CLA
	TAD [7605
	DCA ERRET
	JMS I [PRMESG
	TEXT	/?ERROR/

/THE FOLLOWING REGISTERS ARE SET TO VITAL INITIAL VALUES. TO ALTER
/THESE VALUES IS TO BRING DISASTER DOWN UPON YOUR HEAD!

LXR,	PMSRST-1
X1,	MSWITC	/THESE TWO ARE USED AT INITIALIZATION.
ADR1,	RUN8-1
ADR2,	RUN8&177+7377	/USED DURING R, AND RUN COMMANDS
XR,
AMFLAG,	0		/1 MEANS SAW ALTMODE
			/MUST NOT MOVE FOR CCL AND BATCH

	*20
RBFLAG,	0		/MUST BE AT LOCATION 20
TEMP2,	-7
SYSTEM,	7700
PCH,	PRINT
GLINE,	XGLINE
GNAME,	GETNAM
DEVHND,	7607
FUDJMP,	MSTCDF&177+5200
P6203,	6203
TMP,	PATCHLEV	/MONITOR PATCH LEVEL MUST BE AT LOC 31 FOR CCL
PGTOUT,	GETOUT
ERRET,	PCRLF		/MUST BE AT 33 FOR CCL

/THE FOLLOWING LOCS. ARE TEMPORARIES. HOWEVER, THERE IS NOW
/VITAL ONCE ONLY CODE TO HELP THE BATCH PROCESSOR. THIS CODE IS
/READ IN EVERY TIME THE KEYBOARD MONITOR IS RE-READ.

NM1,	203		/THIS MUST BE  A 203!
BATCH,			/ENTRY TO READ NEW BATCH MONITOR
NM2,	JMS I [7607	/THE BATCH INITIALIZER ALTERS  SOME VALUES
NM3,	610		/IN THIS LIST...THIS ONE**********
NM4,	0		/THIS ONE*****GETS ADDRESS OF BOS.
TEMP1,	13		/******GETS RECORD OF BOS*****
TM1,	SKP CLA		/ERROR. DON'T RUN BATCH
TMP1,	JMP BCHGO
NMCT,	DCA I KM1	/CLEAR BATCH FLAG.
PN,	JMP KMONER
PRDSW,
KM1,	7777
BCHGO,
RUNSW,	CIF CDF 0
DIGFLG,	JMP I .+1
SENTER,	KMINIT	/GETS ENTRY POINT (BOS)
KRCHK,	RCHK
EXTMP,	0
MERTST,	0
SPTST,	-1	/-1 USED IN RUN CODE
	FIELD 1
	/FIELD 1
	/OS/8 MONITOR - MONITOR ROUTINES
	/THIS MONITOR IS CALLED INTO CORE BY A JMS 7700 IN FIELD 1
	/IT REPLACES CORE FROM 200-1777
	/AND INTERPRETS THE WORDS AFTER THE JMS AS A MONITOR FUNCTION
	/MONITOR FUNCTIONS ARE ASSIGN,LOOKUP,ENTER,ETC.
	MAXCMD=13
	*200
MONITO,	0	/MONITOR SUBROUTINE
	DCA MACARG	/STORE AC ARG
	DCA USERFG	/SET FLAG TO INDICATE WE WERE CALLED DIRECTLY
	RDF	/GET CALLING FIELD
	TAD [CDF CIF 0
	DCA FGETX
MRENTR,	TAD FGETX
	DCA FPUTX	/FOR LOADING AND STORING CALLING SEQUENCE
	JMS FGET	/GET FIRST ARGUMENT[AND SET DATA FIELD 1)
	ISZ MONITO
	CLL
	TAD [-MAXCMD-1
	SZL
	JMP MERROR
	TAD JMPMAX
	DCA .+1		/BRANCH TO APPROPRIATE ROUTINE WITH LINK ON
FGET,	0		/MUST PRESERVE LINK
	TAD MONITO
	JMS FGETW
	JMP I FGET
/MONITOR COMMAND DISPATCH TABLE MUST BE JAMMED BEFORE 'FPUT'
	MERROR
	MASSIGN
	MLOOKUP
	MENTER
	MCLOSE
	MCD
	MCHAIN
	MERR
	MESCAP
	MESCPR
	MASGN
MRSETP,	MRESET
FPUT,	0		/MUST FOLLOW LAST ADDRESS IN JUMP TABLE
FPUTX,	0
	DCA I MONITO
	CDF CIF 10
JMPMAX,	JMP I FPUT
MEOERR,	ISZ MERRNO
MIOERR,	ISZ MERRNO
MERROR,	ISZ MERRNO
	ISZ MERRNO
	ISZ MERRNO
	ISZ MERRNO
MERR,	CLA
	CIF 0
	JMS I [SHNDLR
	0210
	1400
	MERRTN
	HLT
	JMP I .-3


MCD,	CLA CLL CML RAR
	JMS CDSWAP	/SWAP OUT CORE IF NECESSARY
	JMS FGET
	DCA T1
	CIF 0
	JMS I [SHNDLR
	0601
	0
	MCDREC
	JMP  MIOERR
	TAD FPUTX
	CDF CIF 0
	JMS I [200
	DCA FPUTX
	TAD FPUTX
	DCA FGETX
	JMS CDSWAP	/RESTORE THE SWAPPED CORE IF NECESSARY
	STL		/LINK MUST BE ON AT MRESET
	JMP I MRSETP	/AFTER CD, RESET DEVICE AREA
MCHAIN,	JMS FGET
	DCA T1		/BUFFER THE ARGUMENT
	CIF 0
	JMS I [SHNDLR
	0101
	7400
	MRUNRC
	JMP MIOERR
	TAD T1		/LOAD THE BUFFERED ARGUMENT
	CDF CIF 0
	JMP I .-5
MLNOTF,	CLA
	ISZ MONITO
MNEXT,	TAD USERFG
MESCAP,	CLL RAR
	TAD MONITO
	DCA I [7700
	TAD FPUTX
	DCA I [SMCIF
	CLA IAC CML
	CDF 0
	AND I [JSBITS
	CDF 10
	RAR
	SZL SPA CLA	/RESTORE CORE IF USERFG=1 AND JSW[11]=0
	JMP I [SMCIF
	JMP I [MRETRN
MESCPR,	CLL CML
	JMP MESCAP+1
FGETW,	0
	DCA FPUT
FGETX,	HLT
	TAD I FPUT
	CDF CIF 10
	JMP I FGETW
CDSWAP,	0
	TAD ME1000	/FORM READ OR WRITE OPERATION
	DCA MCDCTL
	CDF 0
	TAD I [JSBITS
	CDF 10
	RTR
	SZL CLA	/IS IT NECESSARY TO SAVE CORE?
	JMP I CDSWAP	/NO
	CIF 0
	JMS I [SHNDLR
MCDCTL,	0
	0
	MTEMP+4
	JMP MIOERR
	JMP I CDSWAP

EOVFLO,	CIF 0
	JMS I [SHNDLR
	0111
ME1000,	1000		/ENTER OVERLAY LOADS OVER ENTER (NATCH)
	MEOVLY
	JMP MIOERR
	JMP I ME1000


	*400
	/ASSIGN PROCESSOR - TRANSLATE DEVICE NAME INTO DEVICE NUMBER
	/(IF NECESSARY),GET DEVICE HANDLER INTO CORE(IF NECESSARY)
	/AND ADJUST TABLES(IF NECESSARY).  IS THIS REALLY NECESSARY?
MASGN,	CLA IAC
MASSIGN,	DCA ASFLAG
	TAD MACARG
	SZA		/IS DEVICE NUMERIC OR SYMBOLIC?
	JMP DFOUND	/NUMERIC
	JMS I [FGET	/GET HIGH ORDER 2 CHARS OF NAME
	ISZ I [MONITO
	SNA
	JMP I [MRTRN+1		/FIRST WORD OF NAME MUST BE NON-ZERO
	DCA NAME
	JMS I [FGET
	SNA		/IS NAME >2 CHARACTERS LONG?
	JMP NOHASH	/NO - DON'T HASH
	TAD NAME
	RAL
	CLL CML RAR	/FORCE SIGN BIT OF HASH NAME ON
	DCA NAME
NOHASH,	TAD [UDNAME-1	/SEARCH USER NAME TABLE FIRST
DSRCH,	DCA XR
	TAD [-17
	DCA T2
DSRCLP,	TAD I XR
	CIA
	TAD NAME
	SNA CLA
	JMP DSFND
	ISZ T2
	JMP DSRCLP
	TAD XR
	SMA CLA		/WHICH TABLE DID WE JUST SEARCH?
	JMP I [MRTRN+1	/SYSTEM TABLE - ERROR
	TAD [SDNAME-1
	JMP DSRCH	/GO SEARCH SYSTEM TABLE
DSFND,	TAD T2
	TAD [20
	JMS I [FPUT	/PUT NUMBER INTO CALLING SEQUENCE
	JMS I [FGET	/GET IT BACK IN AC, BUMPING POINTER
	ISZ I [MONITO
DFOUND,	JMS I [MCKDEV	/DETERMINE ITS VALIDITY (NON-ZERONESS)
			/AND FORM POINTERS
	SNA		/IS THE DEVICE HANDLER IN CORE?
	TAD I T2
	SNA		/DOES A HANDLER EXIST FOR THE DEVICE?
	JMP I [MLNOTF	/NO - SAME AS THE DEVICE NOT EXISTING
	CMA RAL		/GET THE COMPLEMENT OF THE HIGH ORDER BIT INTO THE LINK
	SNL CLA		/TWO PAGE HANDLER?(IF HANDLER IS IN CORE,
			/THIS TEST IS RANDOM BUT WE DON'T CARE)
	TAD [100	/YES - FORCE A TWO-PAGE READ
	TAD [100
	DCA DVHCTL
	TAD T1
	DCA T7		/SAVE T1 AS WE WILL DESTROY IT LATER
	TAD I T1
	TAD ASFLAG
	SZA CLA		/DOES HE ACTUALLY WANT US TO LOAD THE SILLY THING?
	JMP AFINIS	/NO - HE MUST HAVE TASTE.
	JMS I [FGET		/FETCH PAGE IN WHICH HANDLER IS TO BE LOADED
	RAR		/GET THE LINK, WHICH HAS BEEN UNTOUCHED SINCE WE
			/PUT THE "TWO PAGE HANDLER" FLAG INTO IT
	SNL SMA		/IF THIS HANDLER IS TWO-PAGE, IS HE ALLOWING IT TO BE?
	JMP I [MLNOTF	/NO - GIVE AN ERROR RETURN
	RAL		/YES - ROTATE BACK
	AND [7600		/MAKE IT LEGAL
	DCA DVHLOC
	JMS GETREC
	DCA DVHREC
	CIF 0
	JMS I [SHNDLR
DVHCTL,	0		/READ ONE OR TWO PAGES INTO FIELD 0
DVHLOC,	0
DVHREC,	0
	JMP I [MIOERR	/SYSTEM DEVICE ERROR
		/NOW GO THROUGH THE TABLE OF AVAILABE HANDLERS
	TAD [-17	/AND MARK OFF THOSE WHICH ARE NOW IN CORE
	DCA T4
DVHCLP,	TAD T4
	JMS I [MCKDEV	/LOW ORDER BITS OF T4 GO THROUGH 1-17
	CMA
	TAD DVHLOC
	CLL CML RAR
	TAD DVHCTL	/IF A HANDLER ENTRY POINT IS WITHIN 200 WORDS OF THE
	SMA CLA		/LOADING ADDRESS (400 FOR A TWO-PAGE HANDLER)
	DCA I T1	/MARK IT AS WIPED
	JMS GETREC
	CIA
	TAD DVHREC
	SZA CLA
	JMP NOTINC
	TAD I T2
	AND [177
	TAD DVHLOC
	DCA I T1
NOTINC,	ISZ T4
	JMP DVHCLP
AFINIS,	TAD I T7
	JMP I [MRTRN	/STORE HANDLER ADDRESS AND EXIT
GETREC,	0
	TAD I T2	/GET RECORD OF DEVICE HANDLER
	CLL RTL
	RTL
	RTL		/EXTRACT THE RECORD NUMBER
	AND [17
	TAD [DVHORG-1	/ADD THE BASE OF DEVICE HANDLER STORAGE
	JMP I GETREC

MCKDEV,	0		/MUST PRESERVE LINK
	AND [17
	SNA
	JMP I [MERROR	/DEVICE 0 IS ILLEGAL
	DCA NAME
	TAD NAME
	TAD [SDVHND-1	/FORM POINTER INTO HANDLER IMAGE TABLE
	DCA T2
	TAD NAME
	TAD [DVHNDL-1
	DCA T1
	TAD NAME
	TAD [DCB-1
	DCA T8		/FORM POINTER TO DCB ENTRY FOR DEVICE
	TAD I T1
	JMP I MCKDEV

	IFNZRO .-564	<REASSEMBLE CONFIG>
SDNAME,	ZBLOCK 17		/SYSTEM DNAME TABLE - SET UP BY "CONFIG"


	IFZERO .+200&1000	<*600>
	/LOOKUP PROCESSOR - GETS THE STARTING BLOCK OF AN INPUT FILE
	/ON A SPECIFIED DEVICE.SKIPS IF FILE WAS FOUND OR DEVICE
	/IS NOT FILE ORIENTED
MLOOKUP,CLL		/SET RDCAT MODE TO INPUT
	JMS MRDCAT
	JMP ERETRN	/NON-FILE STRUCTURED DEVICE
	JMS MDSRCH	/SEARCH THE DIRECTORY FOR THE FILE
	JMP MRTRN+1	/NOT FOUND - TAKE ERROR RETURN
LRETRN,	TAD T5
	CIA
	TAD I [DORG	/CONVERT T5 TO A RECORD NUMBER
ERETRN,	JMS I [FPUT
	ISZ I [MONITO
	TAD T6
	CIA		/STORE FILE LENGTH AS A NEGATIVE NUMBER
MRTRN,	JMS I [FPUT	/THIS CODE IS JUMPED TO BY SEVERAL ROUTINES
MRTRN2,	ISZ I [MONITO
	JMP I [MLNOTF

MRDCAT,	0
	SZA
	JMP MRDREN	/NOT THE FIRST SEGMENT - DON'T SET UP POINTERS
	DCA T5		/ZERO STARTING BLOCK NUMBER
	DCA T6		/ZERO FILE LENGTH
	TAD MACARG	/GET DEVICE NUMBER FROM AC
	JMS I [MCKDEV	/CHECK LEGALITY AND FORM POINTERS
	SNA
	JMP I [MERROR+1	/DEVICE HANDLER IS NOT IN CORE - ERROR
	DCA T9		/ADDRESS OF DEVICE HANDLER
	JMS I [FGET
	DCA T4		/STORE THE POINTER TO THE FILE NAME IN T4
	SNL
	CML RAR
	RTR		/FORM A MASK OF 2000 OR 1000 DEPENDING ON LINK
	AND I T8
	SZA CLA		/TEST FOR READ-ONLY(L=1) OR WRITE-ONLY(L=0)
	JMP MRTRN+1	/FAILED THE TEST - ERROR RETURN
	TAD I T8
	SMA CLA
	JMP I MRDCAT	/DEVICE IS NOT FILE-ORIENTED
	ISZ MRDCAT
	CLA IAC
MRDREN,	DCA MCATRC	/STORE SEGMENT NUMBER
	TAD T9		/USE LOW ORDER BITS
	AND [177	/OF DEVICE HANDLER ENTRY POINT
	CLL RTL		/AND THE REQUESTED SEGMENT NUMBER
	RAL		/TO FORM A "UNIQUE" KEY
	TAD MCATRC	/FOR THIS SEGMENT OF THIS DIRECTORY
		/(THE UNIQUENESS DEPENDS ON EACH HANDLER HAVING A DIFFERENT
		/STARTING OFFSET IN ITS PAGE)
	CIA
	TAD OLDT9	/COMPARE KEY AGAINST KEY OF CURRENT SEGMENT
	SNA		/ARE THEY THE SAME?
	JMP INLRDY	/YES - DON'T READ SEGMENT, ITS IN CORE
	CIA
	TAD OLDT9
	DCA OLDT9	/STORE THE KEY OF THE NEW IN-CORE SEGMENT
	CLA CLL CML RAR	/CHANGE WRITE TO READ
	JMS MWRCAT
INLRDY,	TAD I [DCOUNT
	CML CMA RAL
	SZL SPA
	JMP JMPME2
	CMA CML RAR	/NEW V3 DIRECTORY VERIFYER
	DCA NFILES	/FIRST WORD IN CATALOG = -# OF FILES IN CATALOG
	TAD [DPROPR-1
	DCA XR		/SET XR TO POINT TO FIRST FILE ENTRY
	JMP I MRDCAT	/RETURN TO BUMPED ADDRESS
MDSRCH,	0
FSRCLP,	TAD I XR
	SNA CLA	/EMPTY SPACES HAVE A ONE WORD ZERO DIRECTORY ENTRY
	JMP SKPMTF	/SO SKIP THE 4 WORD COMPARE ON THEM
	CLA CMA
	TAD XR
	DCA XR
	TAD [-4
	DCA T6
	TAD T4
	DCA T7
SRCWDL,	TAD T7
	JMS I [FGETW
	CIA
	TAD I XR
	SZA CLA	/COMPARE ENTRY AGAINST ARGUMENT(8 CHARACTERS)
	JMP NXTFIL
	ISZ T7
	ISZ T6
	JMP SRCWDL
	JMS BUMPXR	/SKIP GARBAGE WORDS
	TAD I XR
	SNA
	JMP SKPMTF+1	/UNCLOSED OUTPUT FILES DONT COUNT
	CIA
	DCA T6	/STORE FILE LENGTH
	ISZ MDSRCH
	JMP I MDSRCH
NXTFIL,	TAD T6
	IAC
	JMS BUMPXR	/SKIP REST OF NAME AND GARBAGE WORDS
SKPMTF,	TAD I XR	/GET LENGTH OF THIS ENTRY
	TAD T5
	DCA T5	/ADD TO BLOCK STARTING ADDRESS
	ISZ NFILES
	JMP FSRCLP
	DCA T5		/RE-INITIALIZE BLOCK NUMBER FOR NEXT SEGMENT
	TAD I [DLINK	/DIRECTORY EXHAUSTED - ANY MORE?
	SZA
	JMP MRDREN
	JMP I MDSRCH

BUMPXR,	0		/ROUTINE TO SKIP (DWASTE+AC) WORDS

	TAD I [DWASTE
	CIA		/DWASTE IS NEGATIVE AND SO IS AC
	TAD XR
	DCA XR
	JMP I BUMPXR

MWRCAT,	0
	TAD [4210
	DCA CATCTL
	CIF 0
	JMS I T9
CATCTL,	4210	/WRITE 2 RECORDS FROM FIELD 1
	1400
MCATRC,	1
JMPME2,	JMP I [MERROR+2	/CANNOT REWRITE CATALOG
	JMP I MWRCAT

	IFNZRO .-772	<REASSEMBLE CONFIG>	/USED TO BE 766
SDVHND,	ZBLOCK 17	/DEVICE HANDLER INFORMATION TABLE - SET BY CONFIG


	IFZERO 1000&. <*1000>
	/ENTER PROCESSOR FOR MONITOR
	/FIND A HOLE IN THE DIRECTORY LARGE ENOUGH TO ACCOMODATE THE FILE
	/AND STICK IT IN. MAKE A NOTE THAT WE DID SO FOR THE
	/"CLOSE" PROCESSOR.
MENTER,	DCA EPASS	/SET UP FOR PASS 1
	JMS I [MRDCAT	/READ CATALOG AND SET UP NFILES AND XR
	JMP I [ERETRN	/NON-FILE-STRUCTURED DEVICE
	JMS I [CONSOL
	DCA T2		/INTIIALIZE STARTING BLOCK NUMBER COUNTER
	TAD [DPROPR-1
	DCA XR		/RESTORE XR (CONSOLIDATOR DESTROYED IT)
	TAD MACARG
	CLL RTR
	RTR
	AND [377	/GET REQUESTED LENGTH FROM AC BITS 0-7
	CIA
	DCA T3	/T3=REQUESTED LENGTH.  IF T3=0, MEANS RETURN
		/LARGEST EMPTY SPACE ON TAPE. IF T3<>0, MEANS RETURN
		/SMALLEST BLOCK OF LENGTH =>T3.
	TAD I T8	/GET FCB ENTRY
	AND [7
	SZA CLA		/ANY ACTIVE TENTATIVE FILES ON THIS DEVICE?
	JMP I [MRTRN+1	/YES - TAKE ERROR RETURN
MELOOP,	TAD I XR
	SNA CLA
	JMP MEMPTY	/EMPTY SPACE - LOOK AT LENGTH
	MTHREE		/OCCUPIED - IGNORE
	JMS I [BUMPXR
	TAD I XR
MELEND,	TAD T2
	DCA T2	/UPDATE T2 TO STARTING BLOCK # OF NEXT ENTRY
	ISZ NFILES
	JMP MELOOP	/GO TO NEXT ENTRY

	/DIRECTORY BLOCK EXHAUSTED
	TAD EPASS
	SZA CLA		/WHAT PASS ARE WE IN?
	JMP EFINUP	/SECOND PASS - THIS IS FOR KEEPS
	TAD I [DLINK	/FIRST PASS
	SZA		/ANY MORE SEGMENTS?
	JMP I [MRDREN	/YES - CONTINUE


		/DONE - SEE IF OUR BEST IS GOOD ENOUGH.
	TAD T4
	JMS I [FGETW
	SZA CLA		/CHECK THAT FIRST WORD OF NAME IS NON-ZERO
	TAD T6
	SNA CLA		/AND THAT WE FOUND WHAT WE WANTED
	JMP I [MRTRN2	/OTHERWISE GIVE ERROR RETURN
	TAD ASFLAG	/GET NUMBER OF BEST SEGMENT
	ISZ EPASS	/AND RESTART THE ALGORITHM IN PASS 2
	JMP I [MRDREN	/(TAKES LESS SPACE THAN SAVING XR AND NAME)

	/EVERYTHING IS SET UP - PERFORM THE ACTUAL ENTRY OPERATION

EFINUP,	TAD XR
	DCA T1
	TAD [-4
	JMS I [BUMPXR
	TAD I [DWASTE
	CIA
	TAD XR		/CATALOG MUST HAVE ROOM FOR ONE MORE FILE
	TAD [-1772	/AFTER THIS FILE IS ENTERED
	SMA CLA		/WILL NEW ADDITION OVERFLOW CATALOG?
	JMP I [EOVFLO	/YUP - CALL OVERLAY TO EXTEND DIRECTORY
MELP2,	TAD I T1	/MOVE REST OF CATALOG UP
	DCA I XR	/TO CREATE SPACE FOR NEW ENTRY
	CLA CMA
	TAD T1
	DCA T1
	CLA CMA CLL RAL
	TAD XR
	DCA XR
	TAD T1
	CIA CLL CML
	TAD NAME
	SZA CLA		/HAVE WE PUSHED UP EVERYTHING?
	JMP MELP2	/NO, KEEP PUSHING
	TAD [-4
	DCA T1		/NOW MOVE THE USERS FILE NAME
	TAD NAME
	DCA XR
	TAD T4
	JMS I [FGETW	/[IN THE USERS FIELD, OF COURSE)
	DCA I XR
	ISZ T4
	ISZ T1	/INTO THE EMPTY SPACE JUST CREATED
	JMP .-5
	TAD I [MDATE	/PUT DATE OF CREATION INTO FILE NAME
	DCA I XR	/THIS WILL BE DESTROYED IF DWASTE=0
	IAC		/ADJUST XR BUMP BECAUSE OF DATE STORE
	JMS I [BUMPXR
	DCA I XR	/GIVE THE NEWLY ENTERED FILE A LENGTH OF 0
	TAD XR	/PUT A POINTER TO THE LENGTH WORD OF THE
	DCA I [DFLAG	/NEW ENTRY INTO THE DIRECTORY HEADER
	CLA CMA
	TAD I [DCOUNT
	DCA I [DCOUNT	/INCREASE THE FILE COUNT BY 1
	TAD I T8
	TAD ASFLAG
	DCA I T8	/SIGNAL AN OPEN OUTPUT FILE ON THIS DEVICE
	JMS I [MWRCAT	/WRITE THE ALTERED CATALOG BACK OUT
	JMP I [LRETRN	/STORE ARGS BACK JUST LIKE "LOOKUP"
MEMPTY,	TAD I XR
	CIA CLL
	DCA T1	/SAVE LENGTH OF CURRENT ENTRY
	TAD T3
	TAD T6
	CLA		/LINK NOW EQUALS BEST LENGTH>=DESIRED LENGTH
	TAD T3
	SNA
	CML		/IF DESIRED LENGTH=0 WE ALWAYS WANT MAXIMUM
	TAD T1
	CLA CML		/LINK IS NOW ON IF DESIRED LENGTH IS NOT IN BETWEEN
			/BEST LENGTH AND CURRENT LENGTH
	TAD T1
	CIA
	TAD T6
	SZL SNA CLA	/TAKE EITHER MIN OR MAX OF BEST AND CURRENT LENGTHS,
			/DEPENDING ON WHETHER LINK IS ON OR OFF
	JMP MNOCHG	/MIN(MAX)=BEST - NOTHING TO DO
	TAD T1
	DCA T6		/MAKE CURRENT ENTRY NEW "BEST"
	CLA CLL CMA RAL
	TAD XR
	DCA NAME	/REMEMBER CATALOG LOCATION
	TAD I [MCATRC
	DCA ASFLAG	/ALSO DIRECTORY SEGMENT NUMBER
	TAD T2
	DCA T5		/AND STARTING BLOCK NUMBER
MNOCHG,	TAD T1
	CIA
	JMP MELEND	/GO UPDATE THE BLOCK NUMBER


	/CLOSE PROCESSOR - CLOSES  AN OUTPUT FILE WHICH WAS OPENED
	/BY THE "ENTER" CALL -- ARGUMENTS ARE THE DEVICE NUMBER AND THE
	/CLOSING LENGTH OF THE FILE.  PERFORMS A DIRECTORY CLEANUP AFTER
	/CLOSING THE FILE.  IF AN ENTRY ALREADY EXISTS WITH THE NEW FILE'S
	/NAME IT IS DELETED. (CLOSE MAY BE USED AS A "DELETE" COMMAND
	/ONLY IF NO OUTPUT FILE WAS ENTERED).  AN ERROR RETURN IS 
	/GIVEN IF THE CLOSING LENGTH IS TOO BIG OR IF THERE WAS NEITHER
	/AN ACTIVE TENTATIVE FILE OR AN OLD FILE TO DELETE.

MCLOSE,	JMS I [MRDCAT	/GET THE CATALOG
	JMP CRETRN	/NON-FILE STRUCTURED DEVICE - RETURN NORMALLY
	CLA IAC		/GET THE NEXT WORD IN THE CALLING SEQUENCE
	JMS I [FGET
	DCA T1		/GET CLOSING LENGTH AND STORE IT AWAY
	JMS I [MDSRCH	/SEARCH FOR THE OLD COPY
	JMP NODLET		/NO OLD COPY
	MTHREE
	TAD I [DWASTE
	JMS SQUISH	/SQUISH OUT 3+#WASTE WORDS OF THE OLD COPY
	DCA I XR2	/AND MAKE THE OTHER TWO INTO AN EMPTY
	TAD T6		/FILE ENTRY WITH THE SAME LENGTH
	CIA
	DCA I XR2	/AS THE OLD COPY
	TAD I T8
	AND [7
	SNA		/IS THERE AN OPEN OUTPUT FILE ON THIS DEVICE
	JMP EOCLOS	/NO - FINISH UP AND GET OUT
	CIA		/GET THE SEGMENT NUMBER WE WANT
	TAD I [MCATRC
	SNA CLA
	JMP .+3
	JMS CONSOL
	JMS I [MWRCAT	/NO - WRITE OUT THE ONE WE SQUISHED
	TAD I [DFLAG	/GET LOCATION OF TENTATIVE FILE
	CIA CLL
	TAD XR2
	SZL CLA		/IS THE ENTRY TO BE CLOSED ABOVE THE ONE 
	JMP .+3		/WE JUST DELETED?
	MTHREE		/YES - MOVE THE POINTER DOWN
	TAD I [DWASTE	/TO COMPENSATE FOR THE SQUISHING
	TAD I [DFLAG	/THE POINTER WILL NOW POINT
	DCA I [DFLAG	/TO THE LENGTH WORD.
		/(THIS WAS WASTED WORK UNLESS THE CORRECT SEGMENT IS IN CORE)

NODLET,	TAD I T8
	AND [7
	SNA		/IS THERE AN OPEN OUTPUT FILE ON THIS DEVICE?
	JMP I [MRTRN+1	/WHAT DID HE CALL US FOR? - ERROR
	JMS I [MRDCAT	/YES - READ IN THE CORRECT SEGMENT
	TAD I [DFLAG
	DCA T4		/T4 POINTS TO THE LENGTH OF THE TENTATIVE ENTRY
	TAD T1
	CIA		/IF T1=0, NEW ENTRY WILL BE DELETED AUTOMATICALLY
	DCA I T4	/DURING CONSOLIDATION
	ISZ T4
	ISZ T4
	CLL CML
	TAD T1
	TAD I T4	/SUBTRACT CLOSING LENGTH FROM FREE BLOCK ADJACENT TO ENTRY
	SNL SZA
	JMP I [MERROR+3	/THIS CREEP HAS GONE AND DESTROYED HIS TAPE
	DCA I T4
EOCLOS,	JMS CONSOL	/CONSOLIDATE THE DIRECTORY
	TAD [7770
	AND I T8
	DCA I T8
	SKP
CRETRN,	TAD [7600	/DO A WRITE OF 0 PAGES. (MAGTAPE)
	JMS I [MWRCAT
	ISZ I [MONITO
	JMP I [MRTRN2
	/CONSOLIDATOR - CHECKS FOR ENTRIES OF LENGTH 0 AND DELETES THEM.
	/ALSO CHECKS FOR ADJACENT FREE AREAS AND COMBINES THEM.
CONSOL,	0
	TAD [DPROPR-1
	DCA XR
	TAD I [DCOUNT
	DCA T7		/T7 = FILE COUNT
CONLP,	TAD I XR
	SNA CLA		/EMPTY FILE?
	JMP CONMTF	/YES - GO CHECK FOR NULL AND 2 IN A ROW
	MTHREE
	JMS I [BUMPXR	/GET PAST THE GARBAGE WORDS
	TAD I XR	/GET COUNT
	SZA CLA		/WOULD THIS HAPPEN TO BE A NULL FILE?
	JMP CONLPT	/NAH, GO TO NEXT ONE
	TAD [-5		/YEAH, REMOVE IT ENTIRELY
	TAD I [DWASTE	/INCLUDING THE WASTE WORDS
SQCOMN,	JMS SQUISH
	ISZ I [DCOUNT	/BUMP DOWN FILE COUNT IN DIRECTORY
	ISZ NFILES	/AS WELL AS THE TEMPORARY ONE IN PAGE 0
	NOP		/V3 RL INSISTS
	JMP CONSOL+1	/REPEAT ENTIRE CONSOLIDATION - THIS DELETION MAY
			/HAVE BROUGHT TWO FREE ENTRIES TOGEHER
/	THE ABOVE NOP FIXES THE KILLER CLOSE BUG
CONLPT,	ISZ T7
	JMP CONLP	/MORE FILES - KEEP PLUGGING
	JMP I CONSOL	/RETURN FROM CONSOLIDATOR
CONMTF,	TAD I XR	/IS THIS FREE ENTRY NULL?
	SNA
	JMP SQTRIV	/YES - SQUASHITLIKEABUG
	DCA T2		/NO - SAVE LENGTH
	TAD XR
	DCA SQUISH		/SAVE POSITION OF LENGTH WORD
	ISZ T7		/WAS IT THE LAST FILE?
	SKP		/NO, THEN THERE IS ONE AFTER IT(GOOD THINKING!)
	JMP I CONSOL	/YES - RETURN FROM CONSOLIDATOR
	TAD I XR
	SZA CLA		/TWO EMPTIES IN A ROW?
	JMP CONLP+3	/NO - SLIP BACK INTO LOOP
	TAD I XR
	TAD T2		/YES - COMBINE LENGTHS
	DCA I SQUISH	/STORE BACK IN FIRST LENGTH WORD AND SQUISH SECOND ENTRY
SQTRIV,	CLA CMA CLL RAL
	JMP SQCOMN	/SQUISH OUT 2 WORDS


MRESET,	TAD [-17
	DCA T3
MRSETL,	TAD T3
	JMS I [MCKDEV
/LINK MUST BE ON AT THIS POINT
	TAD [200
	SZL CLA		/ZERO ALL DEVICE HANDLER SLOTS THAT AREN'T RESIDENT
	DCA I T1
	JMS I [FGET
	SZA CLA
	TAD [7
	CMA STL
	AND I T8
	DCA I T8	/DELETE THE "FILE CURRENTLY OPEN" FLAG IF ASKED
	ISZ T3
	JMP MRSETL
	JMP I [MNEXT

/SUBR TO COLLAPSE DIRECTORY AFTER A  POINT
SQUISH,	0
	TAD XR
	DCA XR1
	CLA CLL CMA RAL
	TAD XR1
	DCA XR2		/SET UP XR2 FOR CHANGING SQUISHED ENTRY
SQLOOP,	TAD I XR
	DCA I XR1	/MOVE DOWN ONE WORD
	TAD XR
	TAD [-1777
	SZA CLA	/AT END YET?
	JMP SQLOOP	/NO, KEEP GOING
	JMP I SQUISH
	*1400
	/INITIAL DIRECTORY FOR MONITOR
	/DEFINES OS/8 ABSOLUTE LOADER (ABSLDR.SV)

DCOUNT,	-2	/TWO ENTRIES
DORG,	MFREE	/FILE STORAGE STARTS AT BLOCK "MFREE"
DLINK,	0	/THIS IS THE ONLY DIRECTORY RECORD
DFLAG,	0	/THERE ARE NO OPEN OUTPUT FILES ON THIS DEVICE
DWASTE,	-1	/# OF WASTED WORDS PER ENTRY
DPROPR,	0102	/AB
	2314	/SL
	0422	/DR
	2326	/.SV
	3017	/V3D ENCODING FOR 1-JUN-77
	-6	/SIX BLOCKS LONG( 1 BLOCK = 256 WORDS)
	0	/EMPTY SPACE
	-1	/OVERLAYED BY DEVICE DEPENDENT PART WITH LENGTH

	IFNZRO .-1415 <CNFER,QQQ>


	*3400	/"ENTER" OVERLAY TO USR - RUNS IN 11000
	JMP .+3
MSEGLM,	-7	/# DIRECT. SEGS
NEWLEN,	-10
MEOVLP,	TAD I [DLINK
	SNA CLA
	JMP MELAST	/LAST SEGMENT - MUST CREATE A NEW ONE
	ISZ I [DCOUNT	/BUMP ENTRY COUNT DOWN
	JMS I [MWRCAT	/WRITE OUT THIS SEGMENT
	JMS MSKIPF	/FIND END OF SHORTENED DIRECTORY
	DCA MEFCNT	/PREPARE TO TRANSFER LAST ENTRY
	TAD (MEOVLS-1
	DCA XR1		/INTO NEXT DIRECTORY SEGMENT
	TAD I XR
	DCA I XR1
	ISZ MEFCNT	/THROUGH A BUFFER AT LOC 11200
	TAD XR
	CIA
	TAD T1		/T1 WAS SET UP BY "ENTER"
	SZA CLA
	JMP .-7
	TAD I T1	/GET LENGTH OF MOVED ENTRY
	DCA MEOCNT
	TAD I [DLINK
	JMS I [MRDCAT	/READ NEXT SEGMENT
	JMS I [CONSOL	/MAKE SURE IT IS AT ITS SMALLEST
	TAD I [DORG
	TAD MEOCNT
	DCA I [DORG	/BUMP FILE ORIGIN DOWN
	JMS MSKIPF	/FIND LAST LOC IN NEW SEGMENT
MELP3,	TAD XR
	DCA METMP1
	TAD XR
	TAD MEFCNT
	DCA METMP2	/PREPARE TO PUSH ALL ENTRIES UP
	TAD I METMP1
	DCA I METMP2	/DO THE PUSHING
	STA
	TAD XR
	DCA XR
	TAD XR
	TAD (-DWASTE
	SZA CLA		/ARE WE THROUGH?
	JMP MELP3	/NO
	TAD (MEOVLS-1
	DCA XR		/PREPARE TO MOVE THE SAVED ENTRY INTO THE
	CLA CMA		/NEW SEGMENT
	TAD I [DCOUNT
	DCA I [DCOUNT	/INCREASE ENTRY COUNT OF NEW SEGMENT
	TAD MEFCNT
	CIA
MECOMN,	DCA MEFCNT	/STORE NUMBER OF WORDS TO MOVE
	TAD [DWASTE
	DCA XR1
	TAD I XR
	DCA I XR1
	ISZ MEFCNT
	JMP .-3		/MOVE THE ENTRY IN
	JMS MSKIPF
	TAD XR
	DCA T1		/T1=LAST LOC IN SEGMENT
	TAD I [DWASTE
	CIA
	TAD XR
	TAD [-1772
	SMA CLA		/HAVE WE MADE THIS SEGMENT TOO BIG?
	JMP MEOVLP	/YES - LOOP UNTIL WE GET IT RIGHT
	JMS I [MWRCAT	/WRITE OUT NEW SEGMENT
	JMP MEOXIT	/READ IN ENTER AND CONTINUE
MWRONG,	IAC
MELAST,	TAD NEWLEN
	DCA METMP1	/LENGTH OF NEW SEGMENT
	TAD METMP1
	CIA
	TAD I [DCOUNT
	SMA		/WERE THERE "NEWLEN+1"
	JMP MWRONG	/NO - SET OUR SIGHTS LOWER
	DCA I [DCOUNT	/ADJUST LENGTH OF OLD SEGMENT
	JMS MSKIPF	/FIND BOUNDARY LOC BETWEEN SEGMENTS
	TAD I [MCATRC
	IAC
	DCA I [DLINK	/LINK THE OLD LAST SEGMENT TO 
	TAD I [DLINK	/THE NEWLY CREATED ONE
	TAD MSEGLM
	SMA CLA
	JMP I (MEOERR	/PROVIDED THAT THERE IS ROOM FOR ANOTHER
	JMS I [MWRCAT	/WRITE OUT THE NEXT-TO-LAST SEGMENT
	ISZ I [MCATRC	/BUMP RECORD NUMBER FOR NEXT WRITE
	ISZ OLDT9	/LIKEWISE BUMP DIRECTORY KEY
	TAD METMP1
	DCA I [DCOUNT
	TAD MEOCNT
	CIA
	TAD I [DORG
	DCA I [DORG	/SET UP PARAMETERS OF THE NEW SEGMENT
	DCA I [DLINK	/MARK IT AS THE NEW LAST SEGMENT
	TAD XR
	TAD [-1777	/SET UP COUNT OF WORDS TO SLIDE DOWN
	JMP MECOMN	/USE COMMON CODE TO SLIDE WORDS AND EXIT

MSKIPF,	0		/SUBR TO FIND LAST LOC USED IN A SEGMENT
			/ALSO FINDS NUMBER OF BLOCKS USED BY SEGMENT
	TAD I [DCOUNT
	DCA MNOFIL
	TAD [DWASTE
	DCA XR
	DCA MEOCNT	/INITIALIZE POINTER(XR) AND COUNT(MEOCNT)
MSKPLP,	TAD I XR
	SNA CLA
	JMP MEOMTY
	MTHREE
	TAD I [DWASTE	/BUMP POINTER TO LENGTH WORD OF FILE ENTRY
	CIA
	TAD XR
	DCA XR
MEOMTY,	TAD I XR
	TAD MEOCNT
	DCA MEOCNT
	ISZ MNOFIL
	JMP MSKPLP
	JMP I MSKIPF


MEOCNT,	0
MEFCNT,	0
METMP1,	0
METMP2,	0
MNOFIL,	0
	MEOVLS=1200	/DESTROYS PART OF "CLOSE" OP FOR BUFFER
	PAGE
	EJECT ABSLDR
	/ABSOLUTE LOADER FOR OS/8 - VERSION 4A
	*2000
	CTLBLK=3400
	BUFFER=CTLBLK
	RXM=6230	/KT8A INSTRUCTION
	LXM=6200	/KT8A INSTRUCTION
	XVALU=70	/XCODE
	XFIELD=20
	ORIGIN=21
	B1=22
	B2=23
	B3=24
	C1=25
	C2=26
	C3=27
	WD=30
	WD1=31
	WD2=32
	FILPTR=33
	PG7400=34
	LSTFLD=35
	LOADXR=11
ABSLDR,	JMS I (CTINIT
	JMS I (CTINIT
	JMP CALLCD
	JMP NOCD
NEXTCD,	JMS I (NEXFIL
CALLCD,	JMS I [200
	5	/COMMAND DECODE
	0216	/ASSUMED EXTENSION IS .BN
NOCD,	TAD [6001
	CDF 0
	DCA I [JSBITS	/SET JSBITS TO SAVE CD AREA NEXT TIME
	CDF 10
	TAD I [MPARAM+1
	AND [100
	SZA CLA		/IS /R SWITCH ON?
	JMS I (CTINIT	/YES - RE-INITIALIZE LOADER TABLES
LD7400,	7400
	TAD (MIFILE
	DCA FILPTR
	JMS I (SETADR	/GET THE STARTING ADDRESS IF IT APPEARS ON THE LINE
NEWFIL,	TAD (7001
	DCA HANDLR
	TAD I FILPTR
	AND [7760
	SZA		/LENGTH OF 256 BLOCKS IMPLIES AT LEAST 256
	TAD [17
	CLL CML RTR
	RTR
	DCA RCDCNT
	TAD I FILPTR
	ISZ FILPTR
	SNA
	JMP NEXTCD	/FILE POINTER = 0 MEANS NO MORE INPUT FILES
	JMS I [200
	1		/ASSIGN
HANDLR,	7001		/LOAD INTO 7000 IF NOT ALREADY LOADED
	JMP I (IOERR
	TAD I FILPTR
	DCA RECNO
	ISZ FILPTR
	CLA CMA
	DCA CHCNT
	DCA REOF
	TAD I [MPARAM	/TEST FOR /I
	AND (10
	SNA CLA
	JMP I (LOADER	/I IS NOT ON
	ISZ OFLG	/IS /I ALLOWED?
	JMP I (OERR	/NO!
	JMP I (SLASHO
GETCH,	0		/GET-NEXT-INPUT-CHARACTER ROUTINE
	TAD [200
	KRS
	TAD (-203
	SNA CLA
	KSF
	SKP
	JMP I (MGET
	ISZ JMPGET
	ISZ CHCNT
JMPX,	JMP JMPGET
	TAD REOF
	SZA CLA
	JMP I GETCH	/EOF REACHED BEFORE LOGICAL END - ERROR
	CIF 0
	JMS I HANDLR
	0210		/READ 2 RECORDS INTO FIELD 1
PBUFFR,	BUFFER
RECNO,	0
	JMP RERROR
	ISZ RECNO
	ISZ RCDCNT
	SKP
	ISZ REOF
	TAD (-601
	DCA CHCNT
	TAD PBUFFR
	DCA CHPTR
	TAD JMPX
	DCA JMPGET
	JMP GETCH+1
JMPGET,	JMP .
	JMP CHAR1
	JMP CHAR2
CHAR3,	TAD JMPX
	DCA JMPGET
	TAD I CHPTR
	AND LD7400
	CLL RTR
	RTR
	TAD CHTMP
	RTR
	RTR
	ISZ CHPTR
	JMP GCHCOM
CHAR2,	TAD I CHPTR
	AND LD7400
	DCA CHTMP
	ISZ CHPTR
CHAR1,	TAD I CHPTR
GCHCOM,	AND (377
	ISZ GETCH
	JMP I GETCH
RERROR,	SPA CLA
	JMP I (IOERR	/AN ACTUAL READ ERROR - AMAZING!
	ISZ REOF
	JMP RECNO+2
REOF,	0
CHCNT,	0
CHPTR,	0
CHTMP,	0
RCDCNT,	0
OFLG,	-1		/SWITCH FOR /O OPTION
	PAGE
	*2200
PUTWD,	6601		/ABSLDR VERSION NUMBER
	CMA
	AND I B2	/AND OUT THE PAGE SLOT IN THE PAGE TABLE
	DCA I B2
	TAD ORIGIN
	DCA ORGX
	TAD XVALU
	CLL RAR
	SZA CLA		/TEST FOR FIELDS 0 OR 1
	JMP PUTIT	/NEITHER - STORE AS IS
	SNL
	JMP FLD0
	TAD ORIGIN
	SPA
	TAD [-400
	SPA CLA
	JMP FLD1
	CLA CLL CML RTR
	TAD ORIGIN
	SMA CLA
	JMP .+3
	ISZ I (OVLYFG	/SET FLAG THAT LOADER IS BEING OVERLAYED
	TAD (2400	/LOADER OVERLAYS GO IN MTEMP+11 - MTEMP+14
LCOMPR,	TAD ORIGIN
	RTL
	RTL
	RAL
	AND [17
	TAD (MTEMP
RLCOMN,	DCA PGTMP
	TAD BUFREC
	CIA
	TAD PGTMP
	SNA CLA
	JMP DONTWR
	JMS WRBUF
WRIBUF,	 CLA		/MODIFIED..IF NOT /O GETS SZA CLA
	JMP DONTWR
	CIF 0
	JMS I [SHNDLR
	0210
	1400	/USE CATALOG SPACE
PGTMP,	0
	JMP I (LIOERR
DONTWR,	DCA OLDT9	/MARK THE CATALOG DESTROYED
	TAD PGTMP
	DCA BUFREC
	TAD ORIGIN
	AND [377
	TAD PTRBFR
	DCA ORGX
	CDF 10
	JMP PUTIT2
FLD1,	CLL
	TAD ORIGIN	/IGNORE LOCATIONS ABOVE 17600
	TAD [200
	SZL CLA
	JMP I PUTWD
PUTIT,	TAD XFIELD
	TAD (6201
	DCA .+1
M7,	-7
PUTIT2,	TAD C3
	DCA I ORGX
CDF10,	CDF 10
	JMP I PUTWD
FLD0,	TAD ORIGIN	/CHECK FOR STUFF IN PAGE 7000
	TAD (1000
	SNL CLA		/IF NON ZERO,OVERLAY
	JMP PUTIT
	ISZ PG7400	/SET OVERLAY FLAG
	JMP LCOMPR	/FORM RECORD NO.
WRBUF,	CALONC
	TAD BUFREC
	SNA
	JMP I WRBUF
	CIF 0
	JMS I [SHNDLR
	4210
PTRBFR,	1400
BUFREC,	0
	JMP I (LIOERR
	DCA BUFREC
	/BAD I/O ON SYSTEM DEVICE
	JMP I WRBUF
ORGX,
NEXFIL,	ERTRN
	JMS WRBUF	/WRITE WHATEVER
	TAD I [MPARAM-1
	SPA CLA
	JMP I (BUILD
	TAD I [MPARAM
	AND (40
	SZA CLA
	JMP I (BUILD
	JMP I NEXFIL

CORTB,	ZBLOCK 30	/ONCE-ONLY CODE INSERTED HERE KATER
	ZBLOCK 2	/EXTRA NEEDED BY ONCE-ONLY CODE
			/NOT USED BY CORE TABLE
	PAGE
	*2400
ITSOVR,	JMS ASSEMB		/END OF FILE
	CIA
	TAD LCKSUM
SZAIN,	SZA CLA		/TEST CHECKSUM
	JMP I (BADCKS
	TAD I [MPARAM+1		/TEST FOR S OPTION
	AND L40
	SNA CLA
	JMP I (NEWFIL		/TIME FOR ANOTHER FILE
LOADER,	DCA LCKSUM		/
	DCA I (OFLG	/CANCEL FURTHER /I'S
	TAD SZAIN
	DCA I (WRIBUF
	JMS GETFLD		/FIELD SETTING
	/DCA XFIELD
	TAD [200
	DCA ORIGIN		/ORIGIN SETTING
	JMS I (GETCH
	JMP I (NEWFIL
	SNA			/IGNORE ZEROES
	JMP .-3
	TAD [-200		/LOOKING FOR LEADER CODE
	SZA CLA
	JMP LOADER+1
LEADER,	JMS I (GETCH
	JMP I (NEWFIL
	SNA
	JMP LOADER+1
	TAD [-200
	SNA			/IS IT LEADER CODE?
	JMP LEADER
NEWWD,	SMA			/IS IT POSSIBLY AFIELD PSEUDO-OP?
	JMP FIELDW
	TAD [200		/IF NOT STORE FOR ASSEMBLING
	DCA WD1
NEWD1,	DCA I (HT
	JMS I (GETCH
	JMP I (BADINP
	DCA WD2			/STORE SECOND WORD FOR ASSEMBLING
	JMS I (GETCH
	JMP I (BADINP
	TAD [-200
	SNA			/TEST FOR TRAILER CODE
	JMP ITSOVR
	DCA WD			/STORE THIRD WORD
	JMS ASSEMB
	SNL
	JMP DATAWD
	DCA ORIGIN
	DCA I (LOADWD	/ZERO 'DATA LOADED' FLAG V3
	JMP GETNXT
DATAWD,	JMS I (LOADWD
	ISZ ORIGIN
L40,	40
GETNXT,	TAD WD1
	TAD WD2
	TAD LCKSUM
	DCA LCKSUM
	TAD WD
	JMP NEWWD
ASSEMB,	0			/ASSEMBLING WORDS...
	TAD WD1
	CLL RTL
	RTL
	RTL
	TAD WD2
	JMP I ASSEMB
FIELDW,	TAD (-32		/TESTING TO ISOLATE FIELD PSEUDO-OP
	SNA			/IS IT A CONTROL/Z?
	JMP CTLZ
	TAD (-46
	SPA			/IS IT GREATER THAN 300?
	JMP NOTXP
	DCA WD1
	TAD WD1
	AND [7
	SZA CLA
	JMP NOTXP
	TAD WD1
	AND (70
	ISZ I (HT		/I.D. DISTINGUISHES BETWEEN GETFLD & FIELDW CALL
	JMS I (XTEND		/GO SEARCH FOR GREATER THAN 32K FIELD SETTING
	/DCA XFIELD
	JMS I (GETCH
	JMP I (BADINP
	TAD [-200
	SZA
	JMP NEWWD
NOTXP,	CLA
	TAD LCKSUM
	SNA CLA
	JMP LOADER
	JMP I (BADINP
LCKSUM,	0
CTLZ,	TAD LCKSUM
	SZA CLA
	JMP I (BADINP
	JMP I (NEWFIL
GETFLD,	0			/TEST FOR SPECIFIED FIELD SETTING
	DCA C1
	DCA XVALU		/INITIALIZE XVALU
	TAD I (MPARAM+2		/COMMAND DECODER INPUT
	AND (1774
	SNA			/WAS FIELD SPECIFIED?
	JMP I GETFLD
	RTL			/IF SO, WHAT WAS IT?
	RAL
	ISZ C1
	SNL
	JMP .-3
	CLA CMA
	TAD C1			/FIELD...IS HERE
	JMS I (XTEND		/MAKE NECESSARY ADJUSTMENTS(KT8A)
	JMP I GETFLD
	PAGE
	*2600
	/BUILD CORE CONTROL BLOCK
	/FIELDS AND PAGES TO BE SAVED HAVE BEEN ISOLATED 
	/BY LOADWD.SEE CORTAB FOR MORE INFO ON TABLE.


BUILD,	TAD (CORTAB+135		/ROUTINE TO SEARCH SAVE TABLE
	DCA B1
	TAD I (CORTAB+3
	CLL CMA
	AND [7760
	SNA CLA
	CML
	TAD I (CORTAB
	CMA
	AND [7760
	SNA CLA
	IAC
	RTR
	DCA I (CTLBLK+3
	TAD (CTLBLK+3
	DCA LOADXR
	TAD [-40
	DCA C1
	TAD [70
	CLA
	TAD (37
	DCA FIELDB
	DCA I (CTLBLK
FLDLP,	TAD FIELDB
	TAD (-2
	SMA CLA		/IGNORE 07600 AND 17600 IN CCB	/V3
	CMA		/IN THE CORE MAP
	TAD [-37
	DCA C2
	DCA LOWERA
MTLOOP,	JMS I (SHFT
	SNL CLA
	JMP INUSE
	TAD LOWERA
MTRSME,	TAD [200
	DCA LOWERA
	ISZ C2
	JMP MTLOOP
	JMP FLDOVR
INUSE,	TAD LOWERA
	TAD [200
	DCA UPPERA
	ISZ C2
	SKP
	JMP ENDRGN-2
	JMS I (SHFT
	SZL CLA
	JMP ENDRGN
	TAD UPPERA
	JMP INUSE+1
	CLA CMA
	DCA C2
ENDRGN,	TAD LOWERA
	AND [7400
	DCA I LOADXR
	ISZ I (CTLBLK
	TAD LOWERA
	AND [7400
	CIA
	TAD UPPERA
	CLL RAR
	TAD XFB
	DCA I LOADXR
	TAD UPPERA
	JMP MTRSME
XFB,	0
FLDOVR,	JMS I (EXTST
	TAD I [MPARAM+1	/CLOBBER BATCH?
	AND [400
	TAD I (MPARAM+2	/AH ED, BUG IF YOU SPEC /P/1 TO LOADER
	AND (403
	TAD I (CTLBLK+3
	DCA I (CTLBLK+3
	TAD LSTFLD
	AND (37
	JMS I (BANKSW	/ADJUST FOR CDF
	TAD [CDF CIF 0
	DCA I (CTLBLK+1
	SKP
ORG200,	TAD [200
	TAD LSTADR
	SZA		/V3
	JMP NOORG	/V3 ALLOW EXPLICIT START ADDR TO OVERRIDE DEFAULT
	TAD I (LOADWD	/V3 NO EXPLICIT START ADDR
	CLA		/REPLACE BY 'SZA CLA' TO ALLOW SELF-STARTING STUFF
/*	SZA CLA		/V3 IS IT SELF STARTING BIN FORMAT?
	JMP ORG200	/V3 NO
	TAD XFIELD	/V3 YES
	TAD [CIF CDF 0	/V3
	DCA I (CTLBLK+1	/V3
	TAD I (ORIGIN	/V3
NOORG,	DCA I (CTLBLK+2
	JMP I (LGTOUT	/WRITE CONTROL BLOCK AND EXIT
FIELDB,	0
UPPERA,
SETADR,	0
	TAD I (MPARAM+3
	SNA		/IS THERE A STARTING ADDRESS SPECIFIED?
	JMP I SETADR	/NO
	DCA LSTADR
	TAD I [MPARAM-1
	DCA LSTFLD
	JMP I SETADR

LOWERA,	0
LSTADR,	0
	PAGE
	*3000
ZOFILE,	MOFILE
ZOUCNT,	-47
LGTOUT,	TAD PG7400
	SNA CLA
	JMP .+7
	CIF 0
	JMS I [SHNDLR
	0300
	7000
	MTEMP+16
	JMP I (LIOERR
	CIF 0
	JMS I [SHNDLR
	4210
	CTLBLK-200
	MTEMP+10
	JMP I (LIOERR
	TAD I (CTLBLK+2
	DCA CTL2		/MOVE THINGS INTO THIS PAGE 
	TAD I (CTLBLK+3
	DCA CTL3	/SO WE CAN REFERENCE THEM WITH DF=0
	TAD I [MPARAM
	AND (40
	SNA CLA
	JMP LNOGO
	TAD CTL3
	RAL
	SPA CLA		/ARE WE OVERLAYING THE I/O MONITOR?
	JMP LKICKM		/NO
	CDF 0
	DCA I [JSBITS	/YES - SET JSBITS TO FORCE A READ
	CDF 10
	JMS I [200
	13		/RESET I/O DEVICES AND FILES
LKICKM,	JMS I [200
	11		/KICK MONITOR OUT
	/********************************************
	/NO PAGE ZERO REFERENCES AFTER THIS POINT 
	/PAGE ZERO MAY CONTAIN USER CODE
	/********************************************
	DCA I ZOFILE		/ZERO OUT COMMAND DECODER AREA
	ISZ ZOFILE
	ISZ ZOUCNT
	JMP .-3
	TAD I (CTLBLK+1
	CDF 0
	DCA I (MSTCDF
	TAD CTL2
	DCA I (MSTADR	/SET UP STARTING ADDRESS IN FIELD 0
	JMP LMOVRD
LNOGO,	TAD CTL3	/ABOVE COMMENT DOESN'T APPLY TO NEXT 9 LINES
	SPA CLA		/ARE WE OVERLAYING THE KEYBOARD MONITOR?
	TAD (5		/NO - RETURN TO NON-SAVING ENTRY
	TAD [7600
	CDF 0
	DCA I (MSTADR
	TAD ZCDIF0
	DCA I (MSTCDF
	CLA CMA
LMOVRD,	CDF 10
	DCA I (7700	/SET 7700 TO -1 IF NO GO
	TAD I (CTLBLK+1
	CDF 0
	DCA I (JFIELD	/SET UP PARAMETERS IN FIELD 0
	TAD CTL2
	DCA I (JSTART
	TAD CTL3
	DCA I (JSBITS
LMOVLP,	TAD COMBO
	DCA I COMBPT
	ISZ LMOVLP
	ISZ COMBPT
	ISZ COMBCT
	JMP LMOVLP	/MOVE THE READ OF THE LOADER OVERLAY INTO FIELD 0
ZCDIF0,	CDF CIF 0
	TAD OVLYFG
	SZA CLA
	JMP I (MREAD	/LOADER OVERLAYED - GO READ OVERLAY
	JMP I (MSTCDF	/LOADER NOT OVERLAYED - WHY READ?
COMBPT,	MREAD-1
COMBCT,	-7
COMBO,	7607
	MREAD-1&177+4600	/JMS I .-1
	1210
	2000
	MTEMP+11	/LOCATION OF SCRATCH BLOCKS FOR LOADER OVERLAY
	HLT
	MSTCDF&177+5200	/JMP MSTCDF
CTL2,	0
CTL3,	0
OVLYFG,	0
	/LOADWD CALCULATES AN INDEX INTO CORTAB
	/IT SETS APPROPRIATE BITS FOR IDENTIFYING MEMORY AREA
	/TO BE SAVED BY CCB.SEE CORTAB FOR MORE INFO
LOADWD,	0			/ROUTINE TO IDENTIFY FIELDS AND PAGES 
	DCA C3			/TO BE SAVED.
	TAD XVALU		/FIELD VALUE-INDEX INTO CORTAB(SEE CORTAB)
	CLL RAL
	TAD XVALU
	TAD (CORTAB-1
	DCA B2
	TAD ORIGIN
	AND [7600
	CLL RTL
	RTL
	RTL
	ISZ B2
	TAD (-14
	SMA
	JMP .-3
	DCA CTL2
	CLL CML
	RAL
	ISZ CTL2
	JMP .-2
	JMS I (PUTWD
	JMP I LOADWD
	PAGE
	*3200
ERPCH,	0
	AND (77	/GET LOW ORDER 6 BITS
	SZA
	JMP NZCHAR
	JMS ERR
FILMSG,	TEXT	/, FILE 0/
NZCHAR,	TAD (240
	AND (77
	TAD (240	/CONVERT TO ASCII
	JMS LDRPCH	/PRINT
	JMP I ERPCH	/AND RETURN
LDRPCH,	0
	TLS
	TSF
	JMP .-1
	CLA
	JMP I LDRPCH
SHFT,	0
	CLA CLL CMA RTL
	DCA C3
	CLA CLL CML RTL
	TAD B1
SHFTLP,	DCA B3
	TAD I B3
	RAL
	DCA I B3
	CLA CMA CML
	TAD B3
	ISZ C3
	JMP SHFTLP
	JMP I SHFT		/NOTE: SHFT LEAVES AC NON-ZERO
ERR,	ONCE		/CAN'T USE PAGE 0 LITERALS
	CLA
	CDF 10
	TAD I (FILPTR	/ZERO CHAR GETS REPLACED BY "FILE #"
	TAD (322	/MAGIC NUMBER
	CLL CML RAR	/AC NOW CONTAINS " #"
	DCA FILMSG+3
ERRLUP,	TAD I ERR
	SNA
	JMP EOMESG	/MESSAGE MUST BE EVEN NUMBER OF CHARS LONG
	RTR
	RTR
	RTR
	JMS ERPCH
	TAD I ERR
	JMS ERPCH
	ISZ ERR
	JMP ERRLUP
EOMESG,	TAD (215	/TERMINATE MESSAGE WITH CR-LF
	JMS LDRPCH
	TAD T212
	JMS LDRPCH
ERTRN,	JMP I (ABSLDR	/RETURN TO LOADER STARTING ADDRESS
IOERR,	JMS ERR
	TEXT	%I/O ERROR%
BADINP,	JMS ERR
	TEXT	/BAD INPUT/
BADCKS,	JMS ERR
	TEXT	/ BAD CHECKSUM/
NULERR,	JMS CTINIT
T212,	212
	JMS ERR
	TEXT	/NO INPUT/
LIOERR,	JMS ERR
	TEXT	/SYSTEM I-O ERROR/
OERR,	JMS ERR
	TEXT %NO /I!%

CTINIT,	0
CALONC,	JMS I ERR	/CALL ONCE-ONLY CODE
	TAD (-140
	DCA C1
	DCA XFIELD	/INITIALIZE XFIELD
	TAD (CORTAB-1
	DCA LOADXR
	CLA CMA
	DCA I LOADXR
	ISZ C1
	JMP .-3
	DCA LSTFLD
	DCA I (LSTADR	/V3 SET INITIAL STARTING ADDRESS TO 0
	DCA I (OVLYFG
	DCA PG7400
	ISZ CTINIT
	JMP I CTINIT
	PAGE

*CTLBLK+200

/CODE FOR OVERLAY OPTION IS HERE.IF /I IS NOT
/USED IMMEDIATELY, THIS CODE WILL PROBABLY BE DESTROYED,
/AS IT IS USED FOR A BUFFER

SLASHO,	CLA CMA
	DCA I (OFLG	/RE ENABLE /I
	TAD I (HANDLR
	DCA GLONK	/ENTRY POINT TO HANDLER
	TAD I (RECNO
	DCA CCBLOK
	CIF 0
	JMS I GLONK	/READ IN CORE CONTROL BLOCK
	0110
CCBPTR,	CTLBLK
CCBLOK,	0
	JMP I (OERR	/DATA FAILURE
	TAD I CCBPTR	/NO. SEGMENTS
	CMA		/TEST FOR BAD CORE IMAGE
	AND L7740
	SZA CLA
	JMP I (BADINP	/NOT CORE IMAGE
	TAD I CCBPTR
	DCA SEGCNT
	TAD I SGSTAD	/THIS CODE IS NEW FOR V3D
/	AND [70		/GET FIELD
	CLL RTR
	RAR
	DCA I (LSTFLD
	ISZ SGSTAD
	TAD I SGSTAD
	DCA I (LSTADR
	ISZ SGSTAD
	TAD I SGSTAD	/GET JSW FROM SAVE FILE
	AND [400
	DCA TEMP	/PRESERVE /P
	TAD I [MPARAM+1
	AND (7377
	TAD TEMP
	DCA I [MPARAM+1
	TAD I SGSTAD
	AND (3		/PRESERVE LAST 2 BITS
	DCA TEMP
	TAD I (MPARAM+2
	AND [7774
	TAD TEMP
	DCA I (MPARAM+2
	ISZ SGSTAD
NEWSEG,	TAD I SGSTAD	/SEGMENT START ADDRESS
	DCA ORIGIN
	TAD I SGFDLT	/FIELD AND LENGTH
	AND L77
	DCA XFIELD
	TAD I SGFDLT
	AND [7700
	SNA		/V3C
	STL CLA RAR	/AC4000
	DCA SEGLTH
	TAD SEGLTH
TWOPG,	TAD [7600
	SMA CLA		/NO.. IS TWO PAGE SEGMENT LEFT?
	TAD [7600	/YES..-400 TO WORD COUNT
	TAD [7600	/NO.. -200 TO WORD COUNT
	DCA WDCT
	TAD SEGLTH
	TAD [7600	/BUMP DOWN LENGTH LEFT
	DCA SEGLTH

	ISZ CCBLOK	/POINT TO NEXT DATA RECORD
	TAD CCBLOK
	DCA DATRC
	DCA OLDT9	/MARK DIRECTORY DESTROYED
	CIF 0
	JMS I GLONK	/READ THE DATA RECORD IN
	0210
	1400	/INTO 11400
TEMP,
DATRC,	0
	JMP I (IOERR	/DATA FAILURE
	CLA CMA
	TAD ORIGIN
	AND [177
	TAD (1200	/SET UP INPUT POINTER
	CHARPT=10
	DCA CHARPT
LOOPI,	TAD I CHARPT
	JMS I (LOADWD	/MOST OF THE WORK
	ISZ ORIGIN
L7400,	7400		/NOP
	ISZ WDCT	/FINISHED THIS BLOCK?
	JMP LOOPI
	JMS I (WRBUF	/YES.. WRITE THE STUFF OUT
	DCA I (BUFREC	/SO THAT WRBUF DOESN'T SCREW US UP
	TAD SEGLTH	/V3C (REARRANGED)
	SMA SZA		/ALL PAGES DONE?
	JMP TWOPG	/NO, NEXT! (IF DONE, FALL INTO 'GTSEG')
	ISZ SEGCNT	/YES, ANY MORE SEGMENTS
	SKP
	JMP RENEW	/RESET CCB POINTER FOR NEXT /I
	CLA CLL CML RTL
	TAD SGSTAD
	DCA SGSTAD
	CLA CLL CML RTL
	TAD SGFDLT
	DCA SGFDLT	/POINT TO NEXT CCB ENTRIES
	JMP NEWSEG

GLONK,	0		/HANDLER ENTRY POINT HERE
WDCT,	0
SEGCNT,	0
SEGLTH,	0
CTLBLK=3400

SGFDLT,	CTLBLK+5	/FIELD AND LENGTH WORD
SGSTAD,	CTLBLK+1	/SEGMENT START ADDRESS

L7740,
RENEW,	7740		/USED TO CLEAR AC
L77,	77		/MIGHT OR MIGHT NOT SKIP
	TAD (CTLBLK+1
	DCA SGSTAD
	TAD (CTLBLK+5
	DCA SGFDLT
	JMP I (NEWFIL
	PAGE
	*4000
XTEND,	0		/CODE TO HANDLE EXTENDED MEMORY BANK MANIPULATIONS
	DCA XVALU	/STORE INFO TO BE PROCESSED
	TAD HT		/IS IT A GETFLD OR A FIELDW CALL?
	SZA CLA		/IF GETFLD CALL ALL WE WANT TO DO IS TRANSFORM 
	JMP XFLDT
XNDT,	TAD XVALU	/ TRANSFORM FROM ABCDE TO ACDEB00
	JMS BANKSW
	DCA XFIELD
	JMP I XTEND
XFLDT,	JMS I (GETCH	/FIELDW CODE TEST FOR SECOND FIELD WORD
	JMP I (BADINP
	TAD [-200
	SNA
	JMP I (NOTXP
	SMA
	JMP XTD
	TAD [200	/REPEATED NEWWD CODE
	DCA WD1		/REPEATED NEWWD CODE
	TAD XVALU	/IF NO SECOND FIELD WORD WE PROCEED AS NORMALLY
	DCA XFIELD
	TAD XVALU
	CLL RTR
	RAR
	DCA XVALU
	JMP I (NEWD1		/BY PASS NEWWD CODE -- ALREADY RAN IT
XTD,	TAD (-32		/REPITITION OF FIELDW CODE
	SNA			/IS IT CONTROL/Z?
	JMP I (CTLZ
	TAD (-46
	SPA			/IS IT ABOVE 300?
	JMP I (NOTXP
	CLL RTR
	RAR
	AND [7
	TAD WD1
	DCA XVALU
	TAD (7000
	LXM
	JMP XNDT
HT,	0
EXTST,	0		/BUILD CCB CODE TO HANDLE EXTENDED MEMORY
	TAD I (FIELDB		/PREVIOUSLY KNOWN AS FLDOVR CODE
	TAD (-1		/TRANSFORM THE BITS FROM 
	DCA I (FIELDB		/ABCDE FORM TO CDEBA FORM
	TAD I (FIELDB
	CLL RTR
	RTR
	SZL
	TAD (400
	CLL RAR
	SZL
	TAD (100
	CLL RTR
	RTR
	RAR
	DCA I (XFB
	CLA CLL CMA RTL
	TAD I (B1
	DCA I (B1
	ISZ I (C1
	JMP I (FLDLP
	TAD I (CTLBLK
	SNA
	JMP I (NULERR
	CIA
	DCA I (CTLBLK
	RXM
	SNA CLA
	JMP I EXTST
	TAD I (CTLBLK
	RAL
	CLL RAR
	DCA I (CTLBLK
	JMP I EXTST
BANKSW,	0
	CLL RTR		/ISOLATE BANK AND FIELD BITS
	RTR
	SZL		/ADJUST FOR PROPER CDF CIF
	TAD [400	/WAS THERE AN "A" BIT?
	CLL RAR
	SZL		/WAS THERE A "B" BIT?
	TAD (4000
	CLL RTR
	RTR
	RAR
	JMP I BANKSW
	PAGE

	*4200
	/CORTAB IS A TABLE FOR STORING SAVE INFO
	/FOR EACH OF THE 0-37 FIELDS, THERE ARE THREE
	/IDENTIFYING WORDS...THE BITS IN THESE WORDS
	/CORRESPOND TO PAGES IN THE RESPECTIVE FIELD
	/E.G. CORTAB+130 REFERS TO 130%3=35TH FIELD
	/--- FIRST WORD,I.E. PAGES 0-14...
	/LOADWD BUILDS THE TABLE...
	/BUILD REFERENCES IT FOR CONSTRUCTING THE CCB
CORTAB,	ZBLOCK 140
	PAGE

	*CORTB		/ONCE-ONLY CODE

ONCE,	0		/ONCE-ONLY CODE TO CHECK FOR CORRECT MONITOR
	DCA I WRBUF	/DON'T CALL AGAIN
	TAD [400
	TAD K7400
	SZA CLA
	JMP OLDMON
	TAD [7
	TAD M7
	SNA CLA
	JMP I ONCE	/THEY AGREE
OLDMON,	TAD KERR
	DCA I NEXFIL
	JMS I PERR	/THEY DON'T
	TEXT	/INCOMPATIBLE/	/MUST BE AN EVEN # OF CHARS LONG
	CIF CDF 0
	JMP I K7605
K7400,	7400
PERR,	ERR
K7605,	7605
KERR,	ERR&177+5600
	/PAGE 0 - TEMPORARIES AND LITERALS.
		/LOCATIONS 0-3 ARE RESERVED FOR POINTERS TO KEY LOCATIONS
		/IN THE MONITOR (SO THE CUSPS CAN GET AT THESE LOCATIONS)

		/LOCATIONS 4-6 ARE RESERVED FOR SYSTEM ODT FIELD 1 BREAKPOINTS

	*7
OLDT9,	0		/POINTER TO DEVICE HANDLER OF DIRECTORY IN CORE

	*15
XR1,	0
XR2,	0
XR,	0
	*20		/ENTRY TO MONITOR FROM A CALL TO 17700 -
			/CAN BE DESTROYED AFTER IT IS EXECUTED
MSTART,	TAD I T1
	DCA MACARG
	TAD I [7700
	DCA I [MONITO
	TAD I [SMCIF
	DCA I T2	/FAKE A CALL TO "MONITO"
	TAD I [MONITO
	RAL
	SNL SMA CLA
	TAD I [SMCIF
	TAD T3
	SNA CLA		/CHECK FOR A CALL FROM 10000-11777
	JMP I [MERROR	/YES - GIVE ERROR IMMEDIATELY
	JMP I T4	/NO - SLIDE INTO MONITOR CODE

	*36		/POINTERS TO INTERNAL MONITOR LOCATIONS FOR "BUILD"
	SDNAME		/SYSTEM DEVICE NAME TABLE
	SDVHND		/DEVICE HANDLER ENTRY TABLE
	*40		/LOCATIONS 20-37 RESERVED FOR CUSP SCRATCH SPACE
USERFG,	1	/MUST BE IN 40 - SEE CD LISTING
T1,	MARG1	/MUST BE AT 41
T2,	FGETX
T3,	-6213
T4,	MRENTR
T5,	0
T6,	0
T7,	0
T8,	0
T9,	0
NAME,	0
NFILES,	0
ASFLAG,	0
MACARG,	0
EPASS,	0
MERRNO,	4000
MEOXIT,	CIF 0		/RETURN FROM ENTER OVERLAY
	JMS I [SHNDLR
	0210
	1000
	MONTOR+2	/RESTORE LOCS 1000-1377 OF USR
	HLT		/HELP!
	JMP I .+1
	MENTER		/RESTART ENTER OPERATION COMPLETELY
	$


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/PAL8.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398

/2 PAL8 ASSEMBLER FOR OS/8 MONITOR	VERSION 13
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C) 1970,1971,1972,1973,1974,1975 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/1-OCT-75				MB/MB/SM/MB/RL/JR/SR

DECIMAL

VERSION=	13
SUBVERSION=	"A

OCTAL

/PAL8 IS AN 8K THREE PASS ASSEMBLER DESIGNED 
/TO BE COMPATIBLE WITH THE OS/8 SYSTEM.

/PASS 1 READS THE INPUT (SOURCE) FILE AND CONSTRUCTS
/THE SYMBOL TABLE.

/PASS 2 GENERATES THE BINARY (OBJECT) FILE, WHICH
/MAY BE LOADED WITH THE ABSOLUTE (BINARY) LOADER.

/PASS 3 GENERATES THE OCTAL SYMBOLIC ASSEMBLY
/LISTING.

/PAL8 IS COMPATIBLE IN MOST RESPECTS WITH PAL III, MACRO-8
/4K PAL-D, AND 8K PAL-D, AS WELL AS THE CROSS-ASSEMBLER PAL10.

	IFNDEF HASH<HASH=1>	/DEFINE FOR HASH SYMBOL TABLE
/SET HASH=0 TO GET OLD PAL8 WAY OF HANDLING SYMBOL TABLE

/MAINTENANCE RELEASE CHANGES:

/1.	INCLUDED JIM ROTH'S HASH TABLE MODIFICATIONS
/2.	ALLOWED /B TO WORK PROPERLY [SEQ #2 PATCH FROM AUG '74 DSN]
/3.	PUT CREFLS.TM ON SYS: NOT DSK: [PATCH SEQ #3, SEP '74 DSN]
/4.	FIXED 7TH LEVEL CHECKSUM BIT [PATCH SEQ #7, MARCH '75 DSN]
/5.	ALLOWED PAL8 TO RESTART BEFORE CD EXECUTED [DSN APR '75, SEQ #8]
/6.	FIXED /F SO IT WORKS [PATCH SEQ #9, DSN APRIL 1975]
/7.	FIXED /W SO IT DOESN'T REMEMBER TOP OF PAGE [DSN OCT '75]
/8.	FIXED BUG RE MULTIPLE NON-RES INPUT HANDLERS
/9.	CHANGED VERSION # TO V10, EDIT 1, 1975 COPYRIGHT
/10.	ADDED DOCUMENTATION ON LOCATION OF HANDLERS AND BUFFERS
/11.	CORE ALLOCATION:
/	WITHOUT /K, ALL CORE BUT 10000-11777 USED FOR SYMBOLS
/	WITH /K, USES ALL CORE (AND SWAPS USR BETWEEN PASSES)
/	UNDER BATCH, N5000-N7777 IS RESERVED FOR BATCH RESIDENT AS WELL
/12.	/7 WITH HASH FEATURES PRINTS 7 COLUMN SYMBOL TABLE
/13.	14-DEC-75 JR: FIXED TYPO IN /W CODE IN LITERAL DUMP ROUTINE

/JR	14-APR-77 ADDED STANDARD DATE FORMAT TO HEADING
/COMMAND DECODER RULES:

/*BINARY(.BN),LISTING(.LS),CREF(.LS)<SOURCE(.PA),.../OPTIONS

/OPTIONS:
/B	BYTE SHIFT	- ! IS 6 BIT SHIFT (!=^100+)
/C	CREF AFTER	- "CREFLS.TM" CREATED IF NO CREF
/D	DDT TYPE SYMBOL	- ONLY IF LISTING
/E	'LG' ERROR	- LINKS ARE ERRORS
/F	NO TEXT FILL	- NO EXTRA 0 FILL IN 'TEXT'
/G	LOAD+GO AFTER	- SAME AS /L, BUT /G PASSED TO ABSLDR
/H	NO PAGING	- ONLY IF LISTING
/J	JUST WHAT LOADS	- INHIBITS LISTING OF UNASSEMBLED CODE
/K	CHECK FOR MORE THAN 8K OF CORE (DEFAULT IS 8K)
/L	LOAD AFTER	- "PAL8BN.TM" CREATED IF NO BINARY
/N	NO LISTING	- ONLY IF LISTING
/O	NO 200 ORG	- NO AUTOMATIC 200 ORIGIN AFTER 'FIELD'
/S	NO SYMBOL TABLE	- ONLY IF LISTING
/T	CR-LF NOT FF	- ONLY IF LISTING
/W	WIPE LITERALS	- INHIBITS REMEMBERING OF LITERAL BOUNDS

/PERMANENT PATCH LOCATIONS FOR THE ABOVE SWITCHES ARE SYMBOLS
/OF THE FORM Z(SW)(PATCH) - E.G. ZT7640 IS THE LOC TO PATCH TO 7640
/TO REVERSE THE POLARITY OF THE "T" SWITCH.

/PSEUDO-OPS:
/DECIMAL	RADIX TO BASE 10
/DEVICE		2 WORD DEVICE CODE
/DTORG		TYPESETTING TAPE ORIGIN
/EJECT		SKIPS TO A NEW PAGE, AND IF ANY TEXT FOLLOWS,
/		THAT TEXT BECOMES THE NEW HEADER LINE
/ENPUNCH	ENABLE PUNCHING
/EXPUNGE	REMOVE ALL SYMBOLS
/FIELD		SET FIELD
/FILENAME	4 WORD FILE CODE
/FIXMRI		DEFINE MEMORY REFERENCE INSTRUCTION
/FIXTAB		MAKE ALL SYMBOLS PERMANENT
/IFDEF		CONDITIONAL ON DEFINITION
/IFNDEF		CONDITIONAL ON UNDEFINED
/IFNZRO		CONDITIONAL ON NON-ZERO
/IFZERO		CONDITIONAL ON ZERO
/NOPUNCH	DISABLE PUNCHING
/OCTAL		RADIX TO BASE 8
/PAGE		RE-ORIGIN TO BEGINNING OF NEXT PAGE OR PAGE N
/PAUSE		ALTERNATE END-OF-FILE
/RELOC		ASSEMBLE FOLLOWING CODE AS IF LOC = ARG OF RELOC
/TEXT		6 BIT TEXT
/XLIST		LISTING INHIBIT UNLESS THE XLIST IS
/		FOLLOWED BY AN EXPRESSION. THEN IF THE EXPRESSION
/		IS 0 START LISTING, OR NON-0 THEN INHIBIT LISTING
/ZBLOCK		RESERVE BLOCK OF ZEROS
/SYMBOL LAYOUT:

/	WORD 1	BIT 0=1	PERMANENT SYMBOL
/		BIT 1=1	"I" OR "Z"
/		BITS 3-11	CHARS 1 AND 2
/
/	WORD 2	BIT 0=1	MEMORY REFERENCE INSTRUCTION
/		BITS 2-11	CHARS 3 AND 4
/
/	WORD 3	BIT 0=1	PSEUDO-OP
/		BITS 2-11	CHARS 5 AND 6
/
/	WORD 4	BITS 0-11	OCTAL VALUE
/CHARS ARE STORED AS:
/	A TO Z ARE 01 TO 32
/	0 TO 9 ARE 33 TO 44
/
/	CHAR1^45+CHAR2

/OPERATORS:
/+		TWO'S COMPLEMENT ADD
/-		TWO'S COMPLEMENT SUBTRACT
/&		BOOLEAN AND
/!		BOOLEAN INCLUSIVE 'OR' OR BYTE SHIFT
/  (SPACE)	DELIMITER OR INCLUSIVE OR
/^		MULTIPLY (REPEATED ADDITION)
/%		DIVIDE (REPEATED SUBTRACTION)
/DEFINITIONS

ASWAP=	40		/WATCH THIS SWAP AREA!!
MDATE=	7666		/MONITOR DATE
BIPCCL=	7777		/DATE EXTENSION AND BATCH IN PROG FLG IN FIELD 0
MPARAM=	7643		/COMMAND DECODER OPTION LIST
DCB=	7760		/DEVICE CONTROL BLOCK
JSBITS=	7746		/JOB STATUS WORD
BATOUT=	7400		/BATCH LOG OUTPUT ROUTINE IN BATCH RESIDENT
LNPRPG=	70		/56 LINES PER PAGE
HEDLEN=	50		/40 CHARACTERS IN PAGE TITLE
			/(MUST BE A MULTIPLE OF 8)

AC7776=	STA CLL RAL
AC7775=	STA CLL RTL
AC4000=	STL CLA RAR
AC3777=	STA CLL RAR
AC2000=	STL CLA RTR
AC0002=	STL CLA RTL


/TABLE OF ERROR MESSAGE DEFINITIONS


IZ= "I-240^100+"Z-240	/ILLEGAL PAGE ZERO REFERENCE
CF= "C-240^100+"F-240	/CREF.SV NOT FOUND
US= "U-240^100+"S-240	/UNDEFINED SYMBOL
IP= "I-240^100+"P-240	/ILLEGAL PSEUDO-OP USAGE
SE= "S-240^100+"E-240	/SYMBOL TABLE EXCEEDED
ZE= "Z-240^100+"E-240	/PAGE ZERO EXCEEDED
PE= "P-240^100+"E-240	/CURRENT PAGE EXCEEDED
IC= "I-240^100+"C-240	/ILLEGAL CHARACTER
ID= "I-240^100+"D-240	/ILLEGAL DEFINITION
BE= "B-240^100+"E-240	/PUSH-DOWN OVERFLOW
DE= "D-240^100+"E-240	/DEVICE ERROR
DF= "D-240^100+"F-240	/DEVICE FULL
LD= "L-240^100+"D-240	/ABSLDR.SV NOT FOUND
IE= "I-240^100+"E-240	/ILLEGAL EQUATE
PH= "P-240^100+"H-240	/PHASE ERROR
II= "I-240^100+"I-240	/ILLEGAL INDIRECT
RD= "R-240^100+"D-240	/REDEFINITION
UO= "U-240^100+"O-240	/UNDEFINED ORIGIN
LG= "L-240^100+"G-240	/LINK GENERATED



/ABBREVIATIONS
/CR/LF	CARRIAGE RETURN/LINE FEED (215,212)
/F/F	FORM FEED (214)
/PAGE ZERO

*0
INT,	15
	CIF 30		/SYMBIONT CODE
	JMP .-1
PTR,	0		/V3C USED BY
KNTR,	0		/INPUT ROUTINE
OCTPR1,	0
OCTPR3,	0
FORMF6,	0

/AUTOINDEX REGISTERS
/PRESET FOR ONCE ONLY CODE

*10
PDLXR,	PDLST		/PUSH-DOWN AUTO INDEX REGISTER
TAGXR,	SWAP1-1		/TAG AUTO INDEX REGISTER
XREG1,	DSWIT1-1	/GENERAL AUTO INDEX REGISTER
XREG2,	DSWIT2-1	/GENERAL AUTO INDEX REGISTER

/NOT USED AS AUTO INDEX REGISTERS
/EXCEPT DURING ONCE ONLY CODE

LAST1,	DATE-1		/LAST DEFINED SYMBOL
LAST2,	SWAP2-1
LAST3,	IFZERO	HASH	<SYMPRT+4-1>
	IFNZRO	HASH	<SYMNWP-1>
LAST4,	IFZERO	HASH	<SYMPR9-2-1>
	IFNZRO	HASH	<SYMDDT-1>

*20
TAG1,	0		/TAG STORAGE
TAG2,	0
TAG3,	0

LITPTR,	200		/LITERAL POINTER

RADIX,	0		/7777 IF DECIMAL MODE
PUNCHX,	0		/NON-ZERO IF NO PUNCHING
XLISTX,	0		/NON-ZERO IF NO LISTING
/*NOTE* PUNCHX AND XLISTX MUST BE TOGETHER
/AND IN THIS ORDER

LOC,	200		/CURRENT LOCATION
OFFSET,	0		/LOCATION COUNTER OFFSET FROM "LOC"
OFSBUF,	0		/LOCATION COUNTER OFFSET BUFFER
STARSW,	0		/-1 IF NEXT ORIGIN SHOULD BE INHIBITED

OP,	0		/LAST OPERATOR CODE (0-6)
VALUE,	0		/EXPRESSION VALUE
VALUE2,	0		/EXPRESSION OPERAND

TXTSWT,	0		/SPACE SWITCH
TXTPTR,	LINBUF+120	/TEXT POINTER
CHAR,	0		/CURRENT CHARACTER

THISPG,	0		/OVERFLOW PAGE
EDITPG,	0		/EDITOR PAGE
TEMP,	0		/TEMPORARY REGISTERS
TEMP1,	0
TEMP2,	0
TEMP3,	0

OCHAR,	OUTPUT		/OUTPUT ROUTINE
OERROR,	OTYPEO		/PASS 1=OTYPEO; 2=OTYPEO; 3=LISOUT
PASS,	-2		/-1 IF PASS 1, 0 IF PASS 2, 1 IF PASS 3
IOMON,	200		/USER SERVICE ROUTINES
CONDSW,	0		/NUMBER OF NESTED CONDITIONALS
EXPIND,	0		/0 IF MRI OK HERE
			/NOT 0 IF MRI NOT OK HERE
CHKSUM,	0		/BINARY CHECK SUM
IZIND,	0		/"I" AND "Z" INDICATOR
			/IF I, LEFT 6 BITS ARE NON-ZERO
			/IF Z, RIGHT 6 BITS ARE NON-ZERO
THISTG,	0		/ASSIGNED NUMBER OF CURRENT TAG
HIGHTG,	SYME-SYMS%4-1	/ASSIGNED NUMBER OF LAST TAG
LINCNT,	0		/LINE COUNT
ALPHAI,	0		/UNDEFINED TAG INDICATOR
			/-1 IF UNDEFINED
GETCI,	0		/NOT=0 IF ONLY CARRIAGE RETURN ENDS LINE
			/OTHERWISE /,;, OR CARRIAGE RETURN ENDS
LSTCNT,	0		/TAB COUNTER
UNDFSW,	0		/UNDEFINED SWITCH
INCTL,	601		/CONTROL WORD - FOR OS/8 I/O
LINKSW,	0		/OFF-PAGE LINK SWITCH
			/0 IF NO LINK GENERATED, 0700 IF LINK
LININD,	0		/BACK-UP FOR LINKSW
PERROR,	PERRO1		/DUMMY ERROR ROUTINE TO SUPPRESS CERTAIN
			/MESSAGES DURING PASS 1
FLDIND,	"0		/CURRENT FIELD IN ASCII DIGIT FORM
VALUEX,	0	/XCODE
ERROR5,	0		/USED BY PACKED ASCII PRINT ROUTINE
BINSRT,	0		/BINARY OR LISTING STARTING
ERCNT,	0		/ERROR COUNTER
LINK,	0		/LINK COUNTER
	IFNZRO HASH<
TAGMAX,	0		/SET TO PRIME # EQ TO MAX # SYMS
	>
	PAGE
/STARTING ADDRESS OF PAL8 (0200)
/CHAINING ADDRESS (0201)

NAME1,	JMP I NAME3	/NAME1-NAME3 USED LATER
NAME2,	JMP I GETTA2	/TO STORE TAGS AS THEY ARE BUILT
NAME3,	BEGIN		/V3C
GETTA2,	NOCD		/BUILDING SWITCH AND OVERFLOW PROTECT


/HANDLERS FOR NOPUNCH AND ENPUNCH PSEUDO-OPS

NOPUNX,	CLA IAC		/NON-ZERO FOR NO PUNCHING
ENPUNX,	DCA PUNCHX	/ZERO FOR PUNCHING
	JMP I [LOOKEX	/--EXIT TO MAIN--


/HANDLERS FOR DECIMAL AND OCTAL PSEUDO-OPS

DECIMX,	STA		/7777 FOR DECIMAL RADIX
OCTALX,	DCA RADIX	/ZERO FOR OCTAL RADIX
	JMP I [LOOKEX	/--EXIT TO MAIN--
/GET A TAG ROUTINE
/PICKS UP A TAG AND SEARCHES FOR IT
/"THISTG" HAS NUMBER OF TAG
/"VALUE2" HAS VALUE
/AC=7777 ON RETURN IF TAG NOT FOUND, 0 IF FOUND

GETTAG,	0
	DCA NAME1	/CLEAR BUILD AREA
	DCA NAME2
	DCA NAME3
	TAD [NAME1
	DCA GETTA4	/SET POINTER FOR BUILDING
	DCA GETTA2	/ZERO SWITCH
GETTG1,	TAD CHAR	/GET THE CHARACTER
	AND [77		/MAKE IT 01-32 OR 60-71
	TAD (-32	/WAS IT A TO Z?
	SMA SZA
	TAD (-25	/NO - MAKE 60-71 INTO 33-44
	TAD (32		/YES - IT IS NOW 01-32 OR 33-44
	ISZ GETTA2	/LEFT SIDE?
	JMP GETTA3	/YES
	TAD I GETTA4	/NO - RIGHT SIDE
	DCA I GETTA4	/BUILD THE WORD
	ISZ GETTA4	/BUMP TO NEXT WORD
GETTA1,	JMS I [GETC	/GET NEXT CHARACTER
	JMS I (TSTALN	/IS IT ALPHANUMERIC?
	JMP GETTG1	/YES - KEEP BUILDING
	IFZERO HASH<
	TAD HIGHTG	/NO - GET NUMBER OF HIGHEST TAG
	CLL RAR		/DIVIDE BY 2
	DCA TEMP2	/SAVE DIFFERENCE
	DCA THISTG	/START AT TAG ZERO
	CLL CML		/LINK MUST BE ON INITIALLY
	DCA TEMP1


/GETTA4 IS POINTER TO NAME1-NAME3
/FOR DEPOSITING TAG AS IT IS BUILT

/TEMP2 IS # OF TAGS TO SKIP BETWEEN CHECKS FOR MATCH
/DURING BINARY SEARCHING
GETTG2,	SZL		/IS THISTG HIGHER THAN TAG?
	JMP GETTG3	/NO-LOWER
GETTG4,	DCA TEMP1	/CLEAR LAST TIME SWITCH
	SNL
	ISZ TEMP1	/SET LAST TIME SWITCH TO 1
	TAD TEMP2	/GET # OF TAGS TO SKIP
	SNL
	CIA
	TAD THISTG	/INCREASE OR DECREASE TAG NUMBER
	DCA THISTG
	TAD TEMP2	/GET NUMBER
	CLL RAR		/DIVIDE BY 2
	SNA		/IS RESULT 0?
	ISZ TEMP1	/YES-BUMP LAST TIME SWITCH
	SNA
	IAC		/IF RESULT WAS 1, MAKE IT 2
	DCA TEMP2	/SAVE IT FOR NEXT TIME
	JMS I [FINDTG	/GET THE TAG
	TAD [1777	/MASK
	AND TAG1	/GET WORD 1
	CLL CIA
	TAD NAME1	/DOES IT MATCH?
	SZA CLA
	JMP GETTG2	/NO - TRY NEXT TAG
	AC3777
	AND TAG2	/YES - GET WORD 2
	CLL CIA
	TAD NAME2	/DOES IT MATCH?
	SZA CLA
	JMP GETTG2	/NO - TRY NEXT TAG
	AC3777
	AND TAG3	/YES - DOES IT MATCH?
	CLL CIA
	TAD NAME3
	SZA CLA
	JMP GETTG2	/NO - TRY NEXT TAG
	JMP I GETTAG	/YES--RETURN--
GETTG3,	AC7776
	TAD TEMP1	/LAST TIME SWITCH = 2?
	SZA CLA
	JMP GETTG4	/NO-KEEP TRYING
	ISZ THISTG	/YES-QUIT SEARCHING
	DCA VALUE2
	DCA TAG1
	DCA TAG2
	DCA TAG3	/TAG NOT FOUND
	STA		/AC=7777 MEANS NOT FOUND
	JMP I GETTAG	/--RETURN--
	>
	IFNZRO HASH<
	PRIME=TAGMAX

GETTGH,/JMS I	[TLYREF	/HACK ONLY
	TAD NAME1	/HASH OUR NAME
	CLL RTL
	TAD	NAME2
	RTL
	TAD	NAME3
	RTL
	TAD	NAME1
	JMS	PROBE	/NOW PROBE THE TABLE
	TAD	NAME1	/RE HASH THE NAME FOR A STEPSIZE
	CLL RAL
	RTL
	TAD	NAME2
	CLL		/CALC MODULO PRIME INLINE
	TAD	MPRIME
	SZL
	JMP	.-3
	TAD	PRIME
	SNA
	IAC		/STEPSIZE MUST BE NON ZERO!
	DCA	CRPDEL
PRBLUP,	CLL
	TAD	THISTG	/BUMP THE POINTER RANDOMLY
	TAD	CRPDEL
	SZL		/PROTECT AGAINST WRAP AROUND
	TAD	MPRIME	/PROBABLY UNOPTIMAL SOLUTION
	JMS	PROBE
	JMP	PRBLUP

PROBE,	0
	CLL
	TAD	MPRIME
	SZL
	JMP	.-3
	TAD	PRIME
	DCA	THISTG	/THISTG MODULO PRIME
/	JMS I	[TLYPRB	/HACK ONLY
	JMS I	[FINDTG	/GO GET IT
	TAD	[1777	/MASK THE TYPE BITS OUT
	AND	TAG1	/IS THERE ONE?
	SNA
	JMP	NOTFND	/NO EXIT POINTING AT IT
	CIA		/YES, DO A COMPARE
	TAD	NAME1
	SZA CLA
	JMP I	PROBE
	AC3777
	AND	TAG2
	CIA
	TAD	NAME2
	SZA CLA
	JMP I	PROBE
	AC3777
	AND	TAG3
	CIA
	TAD	NAME3
	SZA CLA
	JMP I	PROBE	/FOUND EXIT WITH AC CLEAR
	JMP I	GETTAG
NOTFND,	STA		/NOT FOUND EXIT WITH AC SET
	JMP I	GETTAG

CRPDEL,	0
MPRIME,	0		/INITIALIZED BY ONCE ONLY CODE FOR MACHINE AT HAND
	>


GETTA3,	DCA GETTA2	/SAVE CHAR
	TAD GETTA2
	CLL RTL		/*4
	RAL		/*10
	TAD GETTA2	/*11
	RTL		/*44
	TAD GETTA2	/*45
	DCA I GETTA4	/SET LEFT SIDE
	TAD GETTA4
	TAD (-GETTA2
	SZA CLA		/IS THIS AN OVERFLOW (>6) CHAR?
	STA		/NO - SET SWITCH TO RIGHT HALF
	DCA GETTA2	/YES - LEAVE SWITCH AT LEFT HALF
	JMP GETTA1

GETTA4,	NAME1
/IGNORE SPACES ROUTINE

SPNOR,	0
	TAD CHAR	/GET THE CHARACTER
	TAD [-240	/IS IT A SPACE?
	SZA CLA
	JMP I SPNOR	/NO --RETURN--
	JMS I [GETC	/YES - GET NEXT CHARACTER
	JMP SPNOR+1	/LOOP


/HANDLER FOR PAUSE PSEUDO-OP
/END-OF-TAPE OR END-OF-FILE

PAUSEX,	AC4000
	DCA CHAR	/SET END-OF-LINE CHARACTER
	TAD [LINBUF+120	/REINITIALIZE TEXT POINTER
	DCA TXTPTR
	CLA CMA
	DCA I (INCHCT	/INDICATE EMPTY BUFFER
	ISZ I (INEOF	/SET END-OF-FILE
	JMP I [LOOKEX	/--EXIT TO MAIN--
	PAGE
/OUTPUT 2 CHARACTER ERROR CODE

ERROR1,	0
	DCA ERROR5
	TAD ERROR5
	JMS I [RTL6
	RAL
	AND [77
	TAD [240	/CONVERT SIXBIT TO ASCII
	JMS I OERROR	/OUTPUT FIRST CHAR
	TAD ERROR5
	AND [77
	TAD [240
	JMS I OERROR	/OUTPUT SECOND CHAR
	JMP I ERROR1	/--RETURN--

/HANDLER FOR FIELD PSEUDO-OP

FIELDX,JMS I [SPNOR	/IGNORE SPACES
	JMS I [DUMPS	/DUMP CURRENT PAGE LITERALS
	JMS I [DUMPZ	/DUMP PAGE ZERO LITERALS
	JMS I [EXP	/GET EXPRESSION
	TAD VALUE	/TRIM TO RIGHT 3 BITS
	AND [7
	DCA FLDIND	/STORE FOR LISTING
	TAD VALUE
	AND [30
	DCA VALUEX
	TAD PASS	/IS THIS PASS 2?
	SZA CLA
	JMP FIELDY	/NO - PREPARE TO EXIT
	JMS I [XCHANG	/XCODE
	TAD FLDIND	/YES - GET FIELD NUMBER
	CLL RTL
	RAL		/AND CHANNELS 7 AND 8
	TAD [7700
	JMS I OCHAR	/OUTPUT FIELD SETTING
FIELDY,	JMS I [CLEAN	/CLEAN UP THINGS
	TAD [200	/RESET ORIGIN TO 200
	JMP STAR1

/CHANGE LAST 2 LOCATIONS TO:
/	CLA
/	JMP STAR1+1
/FOR INDAC GROUP TO OMIT RE-ORIGIN
/HANDLER FOR PAGE PSEUDO-OP

PAGEX,	JMS I [DUMPS	/DUMP SAME PAGE LITERALS
	JMS I (XLISTZ	/ANY EXPRESSION?
	JMP PAGEY	/NO
	JMS I [EXP	/YES - GET EXPRESSION
	TAD VALUE
	JMS I [RTL6
	RAL		/GET PAGE NUMBER
	JMP STAR3-1

PAGEY,	TAD LOC		/NO ARGUMENT - FIND NEXT PAGE
	TAD [177
	AND [7600
STAR3,	DCA VALUE
	TAD VALUE	/GET START OF PAGE
STAR1,	JMS I [PUNORG	/PUNCH ORIGIN
	JMS I [FINDSP
	TAD [LITBUF	/RESET POINTERS
	DCA TEMP
	TAD I TEMP
	DCA LITPTR	/INITIALIZE LITERAL POINTER FOR NEW PAGE
	DCA LAST1
	DCA LININD
	JMP I [PUNVAL	/SEE ABOUT DUMPING SOURCE CODE

/HANDLER FOR FIXMRI PSEUDO-OP

FIXMRX,	JMS I [SPNOR	/IGNORE SPACES
	JMS I [TSTALP	/IS CHARACTER ALPHABETIC?
	JMP FIXMR1	/YES-CONTINUE
	JMS I [ICMESG	/NO - GENERATE IC MESSAGE, GET NEXT CHAR
	JMP FIXMRX+1	/KEEP LOOKING FOR ALPHABETIC CH. OR END OF LINE
FIXMR1,	JMS I [GETTAG	/PICK UP TAG
	DCA ALPHAI	/STORE UNDEFINED SWITCH
	SKP
FIXMR2,	JMS I [ICMESG
	JMS I [SPNOR	/IGNORE SPACES
	TAD CHAR	/WAS CHARACTER = ?
	TAD (-"=
	SZA CLA
	JMP FIXMR2	/NO - PRINT IC MESSAGE AND KEEP LOOKING
			/FALL INTO EQUALS PROCESSOR
/HANDLER FOR =

	AC4000		/FALL INTO HERE FROM FIXMRI
EQUAL,	JMS I [PUSHA	/PUSH FIXMRI FLAG
	JMS I [GETC	/GET NEXT CHARACTER
	TAD I [NAME1	/STORE THE SYMBOL NAME
	JMS I [PUSHA	/ON THE PUSH DOWN LIST
	TAD I (NAME2
	JMS I [PUSHA
	TAD I (NAME3
	JMS I [PUSHA
	TAD THISTG	/AND ITS PRESENT (OR FUTURE)
	JMS I [PUSHA	/POSITION IN THE SYMTAB
	TAD ALPHAI
	JMS I [PUSHA	/STORE UNDEFINED INDICATOR
	JMS I [SPNOR	/IGNORE SPACES
	JMS I [EXP	/GET EXPRESSION TO RIGHT OF =
	TAD I PDLXR
	DCA ALPHAI	/RESTORE UNDEFINED INDICATOR
	TAD I PDLXR
	DCA THISTG	/RESTORE SYMBOL TABLE POSITION
	TAD I PDLXR	/RESTORE TAG NAME
	DCA I (NAME3
	TAD I PDLXR
	DCA I (NAME2
	TAD I PDLXR
	DCA I [NAME1
	ISZ UNDFSW	/WAS ANY PART OF DEFINITION UNDEFINED?
	JMP EQUAL3	/NO
	JMS I PERROR	/YES - GENERATE IE ERROR MESSAGE
	IE
	ISZ PDLXR	/CLEAR EXTRA WORD FROM PDL
	JMP I [PUNVAL	/FORGET ABOUT DEFINING TAG
/MORE = PROCESSING

EQUAL3,	ISZ ALPHAI	/WAS TAG DEFINED BEFORE?
	JMP .+3		/YES - CHECK FOR ILLEGAL REDEFINITION
	JMS I [INSRTG	/NO - INSERT TAG INTO SYMBOL TABLE
	JMP EQUAL2	/AND BYPASS ILLEGAL REDEF CHECK
	JMS I [FINDTG	/PUT TAG IN TAG1-TAGE AND VALUE2
	TAD VALUE
	CIA
	TAD VALUE2
	SZA CLA		/WERE DEFINITIONS THE SAME?
	TAD TAG1	/NO - IS IT A PERMANENT SYMBOL?
	SMA CLA
	JMP EQUAL2	/NO - OK TO REDEFINE
	JMS I [ERROR	/YES - GENERATE RD ERROR MESSAGE FIRST
	RD
EQUAL2,	TAD VALUE	/DEFINE OR REDEFINE
	DCA VALUE2
	AC3777
	AND TAG2	/CLEAR OLD FIXMRI BIT
	TAD I PDLXR	/INSERT NEW ONE
	DCA TAG2
	JMS I [PUTTAG	/STORE TAG
	JMP I [PUNVAL	/SEE ABOUT DUMPING SOURCE CODE
	PAGE
/ROTATE AC 6 LEFT

RTL6,	0
	CLL RTL
	RTL
	RTL
	JMP I RTL6	/--RETURN--


/GET NEXT CHARACTER ROUTINE
/READS FROM THE INPUT FILES AND PASSES THE MODIFIED CHARACTERS
/TO THE PROGRAM
/IT ALSO PRINTS THE LATEST LINE IF IT HAS NOT BEEN PRINTED

GETC,	0
	ISZ TXTPTR	/POINT TO NEXT CHARACTER
GETC7,	TAD I TXTPTR	/GET NEXT CHARACTER
	SZA		/IS IT 0?
	JMP GETC8	/NO - MORE ARE IN THIS LINE
	TAD PASS	/IS THIS PASS 3?
	SPA SNA CLA
	JMP GETC1	/NO
	TAD [LINBUF	/YES
	DCA TXTPTR	/RESET POINTER TO BEGINNING
	TAD I TXTPTR	/GET 1ST CHARACTER
	SNA		/IS IT 0?
	JMP GETC1	/YES - LINE HAS BEEN PRINTED
	TAD [-215	/IS IT 215?
	SNA CLA
	JMP GETC2	/YES - DO NOT PRINT THE SPACES
	TAD [211	/NO-OUTPUT 2 TABS
	JMS I OERROR
	TAD [211
	JMS I OERROR
GETC2,	JMS LINPRT	/NOW PRINT THE LINE
GETC1,	TAD (-121
	DCA TXTSWT
	TAD (LINBUF-1
	DCA TXTPTR	/RESET POINTER
	ISZ TXTPTR
GETC6,	JMS I (INPUT	/GET NEXT CHARACTER
	JMP GETC4	/215
	DCA I TXTPTR	/STORE THE CHARACTER
	ISZ TXTSWT	/TOO MANY?
	JMP GETC6-1	/NO
	CLA CMA		/YES
	DCA TXTSWT
	JMP GETC6
GETC4,	DCA I TXTPTR	/SET END
	ISZ TXTPTR
	DCA I TXTPTR	/SET END OF LINE
	TAD [LINBUF
	DCA TXTPTR	/RESET POINTER
	CLA CMA
	DCA TXTSWT	/RESET SWITCH
	JMP GETC7	/GET THAT CHARACTER

GETC8,	TAD [-215	/IS IT A CARRIAGE RETURN?
	SNA
	JMP GETC12	/YES-END OF LINE
	TAD GETCI	/NO-
	TAD (215-"/	/IS IT A /?
	SNA		/YES-
	JMP GETC13	/"/" IS END
	TAD ("/-";	/IS IT A ;?
	SNA		/YES-
	JMP GETC12	/";" IS END
	TAD (";-211	/IS IT A TAB?
	SZA
	TAD (211-240	/OR A SPACE?
	SZA CLA
	JMP GETC9	/NO-NOT ANYTHING SPECIAL
	ISZ TXTSWT	/YES-2ND OCCURANCE?
	JMP GETC+1	/YES - IGNORE
	TAD [240
	DCA CHAR	/NO - GIVE A SPACE
	JMP I GETC	/--RETURN--

GETC16,	ISZ CONDSW	/DECREMENT CONDITIONAL COUNTER
	JMP GETC15
GETC17,	TAD [LINBUF+120
	DCA TXTPTR
GETC12,	AC4000
GETC9,	TAD I TXTPTR
	DCA CHAR	/STORE CHARACTER
	CLA CMA
	DCA TXTSWT	/SET THE SWITCH
	JMP I GETC	/--RETURN--
GETC13,	TAD CONDSW	/CURRENTLY IN CONDITIONALS?
	SNA
	JMP GETC17	/NO
	DCA CONDSW	/STORE UPDATED CONDITIONAL LEVEL
GETC15,	ISZ TXTPTR	/YES-SCAN LINE FOR < AND >
	TAD I TXTPTR
	TAD [-215	/IS CHARACTER A CARRIAGE RETURN?
	SNA
	JMP GETC17	/YES
	TAD (215-">	/NO IS IT A >?
	SNA
	JMP GETC16	/YES
	TAD (">-"<	/NO-IS IT <?
	SNA CLA
	STA		/YES - INCREMENT CONDITIONAL COUNTER
	JMP GETC13	/NO - KEEP LOOKING


/CHAR IS NEGATIVE IF LOGICAL END OF LINE:
/	CARRIAGE RETURN
/	/
/	;

/CHAR MAY BE ZERO IF PHYSICAL END OF LINE:
/	CARRIAGE RETURN
/PRINT A LINE OF SOURCE CODE

LINPRT,	0
	TAD (LINBUF-1
	DCA XREG1	/SET POINTER TO LINE
LINPR1,	TAD I XREG1	/GET CHARACTER
	SNA		/IS IT END OF LINE?
	JMP I LINPRT	/YES - END LINE
	JMS I OERROR	/NO - OUTPUT CHARACTER
	DCA I [LINBUF	/CLEAR OUT 1ST CHAR IN LINE AS "PRINTED" FLAG
	JMP LINPR1

/HANDLE PHASE ERROR
/AND ALL ERROR EXITS TO MONITOR

SYMOFL,	CLA
	TAD (SE		/SYMBOL TABLE EXCEEDED MESSAGE
MONERR,	DCA MONER1	/ERROR IS SERIOUS ENOUGH TO
PHASE,	TAD (OTYPEO	/ CAUSE IMMEDIATE RETURN TO
	DCA OERROR	/ MONITOR
	JMS I [ERROR
MONER1,	PH		/STORE ERROR TYPE HERE
	JMP I [7600	/***EXIT TO MONITOR***


/FIND CURRENT PAGE NUMBER
/EXIT WITH NUMBER IN AC

FINDSP,	0
	TAD LOC
	AND [7600
	JMS I [RTL6
	JMP I FINDSP	/--RETURN--
	PAGE
/**********************************************************
/THIS AREA IS SWAPPED OUT DURING PASS 1 AND 2
/** NO LITERALS IN THIS PAGE, AS THERE IS A PAGE OVERLAYING IT **

SWAP1=.

/PASS 3 LISTING OUTPUT

LISOUT,	0
	DCA LISOU2
	TAD XLISTX	/IS THIS COVERED BY XLIST?
	SZA CLA
	JMP I LISOUT	/YES--RETURN--
	ISZ LISCNT	/NO-WAS PREVIOUS CHARACTER A 215?
	JMP LISOU1	/NO
	ISZ LINCNT	/WAS IT END OF PAGE?
	JMP LISOU1	/NO
	ISZ THISPG	/YES-START OVERFLOW PAGE
BEGIAB,	JMS CRLF	/OUTPUT CARRIAGE RETURN/LINE FEED
HSWIT1,	JMS I [FORMFD	/0 IF /H SWITCH OPTION TO SUPRESS PAGING
	ISZ LINCNT
LISOU1,	TAD LISOU2	/IS CHARACTER A CARRIAGE RETURN?
	TAD [-215
	SNA
	JMP LISOU3	/YES - OUTPUT CR/LF
	TAD [215	/NO - RESTORE CHARACTER
	JMS I OCHAR	/OUTPUT CHARACTER
	JMP I LISOUT	/--RETURN--

LISOU3,	CLA CMA
	DCA LISCNT	/REMEMBER THE 215 FOR NEXT TIME
	JMS CRLF	/OUTPUT CARRIAGE RETURN/LINE FEED
	JMP I LISOUT	/--RETURN--

LISCNT,	-1
LISOU2,	0
/FORM FEED OUTPUT ROUTINES

FORMFD,	0
	TAD LINCNT	/GET LINE COUNTER
	TAD FORMLN
	SNA CLA		/ARE WE AT TOP OF PAGE?
	JMP I FORMFD	/YES - NO NEED FOR FORM FEED
	TAD XLISTX	/IS THIS COVERED BY XLIST?
	SZA CLA
	JMP I FORMFD	/YES--RETURN--
HSWITC,	JMP FORMF1	/0 IF /T OR TTY:; JMP FORMF3 IF /H
			/OUTPUT IF TTY:OR /T OPTION
	TAD LINCNT
	TAD [-4
	DCA LINCNT
	JMS CRLF	/OUTPUT CARRIAGE RETURN/LINE FEED
	ISZ LINCNT
	JMP CRLF1	/OUTPUT LINE FEED
			/CRLF1 WILL RETURN TO
			/JMP-1 UNTIL LINCNT HAS
			/BEEN BUMPED SUFFICIENTLY
	TAD FORMM6
	DCA LINCNT
	TAD MINUS	/OUTPUT ------
	JMS I OCHAR
	ISZ LINCNT	/* NEXT 3 LOCS CHANGED IF NO /T OR TTY:
FORMF1,	JMP .-3		/* STA
	TAD [-4		/* DCA LINCNT	/GENERATE ONE FORM FEED
	DCA LINCNT	/* STA		/TURN CR INTO FF
	JMS CRLF	/OUTPUT CR/LF OR FF/LF
	ISZ LINCNT
	JMP CRLF1	/OUTPUT LINE FEED
	TAD FORMLN
	CIA
	DCA LINCNT
FORM22,	TAD [HEADER-1	/OUTPUT HEADER
	DCA XREG2
	DCA LSTCNT
FORM30,	TAD I XREG2	/GET NEXT CHARACTER OF HEADING
	SNA		/IS IT LAST + 1
	JMP FORM20	/YES
	JMS I OCHAR	/NO-OUTPUT IT
	TAD LSTCNT
	TAD [-HEDLEN	/DONE "HEDLEN" CHARACTERS YET?
	SZA CLA
	JMP FORM30	/NO-CONTINUE
	TAD FORMHD	/YES-START SYSTEM HEADER
	JMP FORM22	/WHICH STARTS AT HEADER+HEDLEN

FORMLN,	LNPRPG
FORMHD,	HEDLEN
MINUS,	"-
/TTY: OR /T OUTPUTS FORM FEED AS
/CARRIAGE RETURN, MULTIPLE LINE FEEDS TO END OF PAGE
/------
/CARRIAGE RETURN, 5 LINE FEEDS
/HEADER
/NO OPTIONS TREATS F/F AS
/F/F, LF, CR/LF
/HEADER

/ /H OPTION TREATS F/F AS 2 CR/LF

/USER HEADER IS "HEDLEN" CHARACTERS WIDE
/ASSEMBLER HEADER ENDS WITH 0


/OUTPUT PAGE NUMBERS

FORM20,	TAD EDITPG	/OUTPUT EDITOR PAGE NUMBER
	JMS FORMF4
	TAD THISPG	/IS THERE PAGE OVERFLOW?
	SNA CLA
FORM21,	JMP FORMF3	/NO
	TAD MINUS	/YES
	JMS I OCHAR	/OUTPUT -
	TAD THISPG	/OUTPUT NUMBER OF OVERFLOW PAGE
	JMS FORMF4
			/OUTPUT IF /H OPTION
FORMF3,	JMS CRLF	/OUTPUT 2 CR/LF
	JMS CRLF
	JMP I FORMFD	/--RETURN--
/DECIMAL PRINT ROUTINE

FORMF4,	0
	DCA FORMF6	/SAVE NUMBER
	TAD FORM8F
	DCA CRLF	/POINT TO DIVISION LIST
FORM12,	DCA FORMF7	/START WITH 0
	JMP .+3
FORMF5,	DCA FORMF6
	ISZ FORMF7	/ADD 1 TO DIGIT
	TAD I CRLF	/SUBTRACT 1000, 100, OR 10
	SNA
	JMP FORM11	/0 IS END OF TABLE - NO MORE DIGITS
	TAD FORMF6
	SMA		/OVERFLOW
	JMP FORMF5	/NO-KEEP SUBTRACTING
	CLA		/YES-DIGIT DONE
	ISZ CRLF	/BUMP LIST POINTER
	TAD FORMF7	/WAS DIGIT A 0?
	SNA
	JMP FORM12	/YES
	TAD ["0		/NO-MAKE IT ASCII
	JMS I OCHAR	/OUTPUT DIGIT
	AC4000
	JMP FORM12	/4000 IN AC FORCES SIGNIFICANCE

FORM11,	TAD FORMF6	/GET LAST DIGIT (UNITS PLACE)
	TAD ["0
	JMS I OCHAR	/OUTPUT DIGIT
	JMP I FORMF4	/--RETURN--

FORMM6,	-6
FORM8F,	FORMF8
/OUTPUT CARRIAGE RETURN/LINE FEED
/ENTER WITH AC=-1 TO GENERATE F/F LF

HEDCL2,
CRLF,	0
	TAD [215
	JMS I OCHAR
CRLF1,	TAD [212	/RE-ENTRY FOR MULTIPLE LINE FEEDS
	JMS I OCHAR
	JMP I CRLF	/--RETURN--

/CLEAR PAGE HEADING BUFFER

FORMF7,
HEDCLR,	0
	TAD [-HEDLEN	/SET HEADING BUFFER
	DCA HEDCL2	/TO TABS
	TAD [HEADER-1
	DCA XREG2
	TAD [211
	DCA I XREG2
	ISZ HEDCL2
	JMP .-3
	JMP I HEDCLR	/--RETURN--
	PAGE
/SYMBOL TABLE OUTPUT (COLUMNAR)
			/*CODE TO GENERATE DDT COMPATIBLE*
			/**SYMBOL TABLE--SUBSTITUTED WITH*
			/**ONCE ONLY CODE IF NEEDED*******
	IFZERO	HASH<

SYMPRT,	0
	ISZ EDITPG			/NEW PAGE
	DCA THISPG
	JMS I [FORMFD
	TAD SMIN67	/DCA I SYMPR6-1
	DCA SYMPR7	/JMS SYMPR9+6
SYMPR8,	DCA SYMPR2	/TAD [377	//RUBOUT
	CLA CMA		/JMS I OERROR
	DCA THISTG	/CLA CMA
	TAD SYMPR2	/DCA THISTG
	CMA		/TAD [215	//CARRIAGE RETURN
	DCA SYMPR3	/JMS I OERROR
SYMPR5,	ISZ SYMPR3	/JMS SYMPPP
	JMP SYMPR4	/JMP SYMPR9-1
	TAD [-4		/JMP SYMPR6+2
	DCA SYMPR3	/HSWIT1
SYMPR6,	JMS SYMPPP	/204		//EOT
	JMP SYMPRB
SYMPR1,	TAD [1777
	AND TAG1			/OUTPUT TAG
	JMS I SDIV45
	TAD TAG2
	JMS I SDIV45
	TAD TAG3
	JMS I SDIV45
	TAD [240
	JMS I OERROR			/OUTPUT SPACE
	TAD VALUE2
	JMS OCTPRT			/OUTPUT OCTAL VALUE
	ISZ SYMPR3	/JMP SYMPR5-2
	JMP SYMPR0	/TAD SYMPR6
SYMPR9,	TAD [215	/JMS I OERROR	/CARRIAGE RETURN
	JMS I OERROR	/TAD [377	//RUBOUT
SYMPRB,	ISZ SYMPR7	/JMS I OERROR
	JMP SYMPRA	/JMS SYMPR9+6
HSWIT2,	JMS I [FORMFD	/DCA LINCNT	/0 IF NOT /H
	TAD SMIN67	/JMP I SYMPRT	//--RETURN--
	DCA SYMPR7	/0
	TAD SYMOFS	/TAD [-200
SYMPRA,	IAC		/DCA SYMPR2
	TAD SYMPR2	/TAD [200	//LEADER-TRAILER
	JMP SYMPR8	/JMS I OERROR

SYMPR4,	JMS SYMPPP	/ISZ SYMPR2
	JMP I SYMPRT	/JMP SYMPR4-2	/--RETURN--
	JMP SYMPR5	/JMP I SYMPR9+6

SDIV45,	DIV45
SMIN67,	1-LNPRPG
SYMPR0,	TAD SMIN67
	DCA SYMPPB
	JMS SYMPPP	/SKIP 67(8) SYMBOLS
	JMP SYMPR9
	ISZ SYMPPB
	JMP .-3
	JMS I [ERROR1
	JMS I [ERROR1
	JMS I [ERROR1
	JMP SYMPR1	/GO PRINT THE 67TH(8) SYMBOL

SYMPR2=	LINKSW
SYMPR3=	UNDFSW
SYMPR7=	ALPHAI
SYMPPB=	CHKSUM

SYMPPP,	0
	ISZ THISTG
SYMOFS,	245
	TAD THISTG
	CLL CIA
	TAD HIGHTG
	SNL CLA
	JMP I SYMPPP	/--RETURN--
	JMS I [FINDTG
	AC4000
	AND TAG1
	TAD TAG3
	SPA SZL CLA
	JMP SYMPPP+1
	ISZ SYMPPP
	JMP I SYMPPP	/--RETURN--
/SYMNCL,	-4	/DEFAULT IN LIU OF =N OPTION
/SYMOFS,	245	/OFFSET TO FIRST SYM ON NEXT PAGE

	>
	IFNZRO	HASH<

SYMPRT,	0
	ISZ	EDITPG
	DCA	THISPG
	JMS I	[FORMFD	/OUTPUT A HEADING
	JMS I	SYMHND	/NOW READ THE SYMBOL TABLE SORT OVERLAY
	0200		/2 PAGES
SYMSRT,	OUDEVH+400	/TO HERE
	ASWAP+1		/FROM HERE
	JMP I	SYMERR	/UGH
	JMS I	SYMSRT	/SORT THEM AND SET LINK
SYMNWP,	DCA	SYMTAG	/POINT TO SYMBOL
	SZL		/LINK OFF IF ANY SYMBOLS TO LIST
	JMP I	SYMPRT	/NONE --RETURN--
	TAD	SMIN67	/SET LINE/PAGE COUNT
	DCA	SYMLCT
SYMPAG,	TAD	HIGHTG
	CLL CIA
	TAD	SYMTAG
	SZL CLA
	JMP I	SYMPRT	/NO MORE IF AT HIGHTAG NOW
	TAD	SYMTAG
	DCA	THISTG	/PREPARE TO PRINT LEFTMOST SYMBOL
	TAD	SYMNCL	/4 PER LINE (DEFAULT)
	DCA	SYMCCT	/TO COLLUMS/LINE CNTR
	JMP	SYMGO
SYMLIN,	JMS I	[ERROR1
	JMS I	[ERROR1
	JMS I	[ERROR1
	TAD	HIGHTG
	CLL CIA
	TAD	THISTG
	SZL CLA
	JMP	SYMNXL	/SKIP TO NEXT LINE IF OFF TABLE
SYMGO,	JMS I	[FINDTG	/OK, GET IT
	TAD	TAG1
	JMS I	SDIV45
	TAD	TAG2
	JMS I	SDIV45
	TAD	TAG3
	JMS I	SDIV45
	TAD	[240
	JMS I	OERROR
	TAD	VALUE2	/PRINT VALUE NOW
	JMS	OCTPRT
SYMDDT,	TAD	SMIN67
	CLL CIA
	TAD	THISTG
	DCA	THISTG
	SZL
	JMP	SYMNXL	/SKIP IF WRAP AROUND
	ISZ	SYMCCT	/ELSE DO NEXT COLUMN
	JMP	SYMLIN
SYMNXL,	TAD	[215
	JMS I	OERROR	/CR/LF
	ISZ	SYMTAG	/POINT TO NEXT SYMBOL
	ISZ	SYMLCT
	JMP	SYMPAG
HSWIT2,	JMS I	[FORMFD
	TAD	SYMTAG
	CLL
	TAD	SYMOFS	/OFFSET TO NEXT SYMBOL
	JMP	SYMNWP	/DO THE NEXT PAGE

SDIV45,	DIV45
SMIN67,	-67
SYMERR,	SYSERR
SYMHND,	7607
SYMOFS,	245		/DEFAULT
SYMNCL,	-4
	SYMTAG=	LINKSW
	SYMLCT=	UNDFSW
	SYMCCT=	ALPHAI
	ZBLOCK	4	/WASTE SOME SPACE
	>


/END OF AREA WHICH MAY BE SWAPPED OUT
/DURING PASSES 1 AND 2
/**********************************************************************

	ENDOVL=	.
/OCTAL PRINT ROUTINE
/ENTER WITH # TO BE OUTPUT IN AC
/** DO NOT USE TEMPS BELOW THIS LOC!

OCTPRT,	0
	DCA OCTPR1
	TAD [-4
	DCA OCTPR3
OCTPR2,	TAD OCTPR1	/GET EACH DIGIT SEPARATELY
	CLL RTL
	RAL
	DCA OCTPR1
	TAD OCTPR1
	RAL
	AND [7
	TAD ["0		/MAKE IT INTO AN ASCII CHARACTER
	JMS I OERROR	/OUTPUT IT
	ISZ OCTPR3
	JMP OCTPR2
	JMP I OCTPRT	/--RETURN--

/OUTPUT ONE REGISTER

PUNONE,	0
	TAD PASS	/WHICH PASS IS THIS?
	SNA
	JMP PUNON2	/PASS 2--OUTPUT BINARY
	SPA CLA
	JMP PUNON3	/PASS 1--EXIT
	TAD VALUEX	/THE BANK BIT IS 
	CLL RTR		/ADJUSTED TO ASCII
	RAR
	TAD ["0
	JMS I OERROR	/THEN PRINTED
	TAD FLDIND	/GET FIELD NUMBER
	TAD ["0		/CONVERT TO ASCII
	JMS I OERROR	/PRINT IT
	TAD LOC		/GET LOW ORDER 4 DIGITS (LOC CTR)
	JMS OCTPRT	/PRINT IT TOO
	TAD OFFSET	/IF THIS CODE IS IN A RELOC SECTION,
	SZA CLA		/
	TAD [1200	/FLAG THE LOCATION COUNTER WITH A *
DTORG1,	JMS I [ERROR1	/OUTPUT 2 SPACES
	TAD VALUE
	JMS OCTPRT	/OUTPUT CONTENTS
	TAD I [LINBUF	/IS THERE SOURCE CODE TO DUMP?
	SNA CLA
	JMP PUNON1	/NO-OUTPUT CARRIAGE RETURN
	TAD LINKSW	/YES-DUMP LINK SWITCH (' ) OR (  )
	JMS I [ERROR1
	JMS I [LINPRT	/DUMP SOURCE CODE
	JMP PUNON3	/AND EXIT

PUNON1,	TAD LINKSW	/NO LINE - OUTPUT LINK SWITCH ANYWAY
	SZA		/IF THERE IS ONE
	JMS I [ERROR1
	TAD [215	/OUTPUT CARRIAGE RETURN
	JMS I OERROR
PUNON3,	DCA LINKSW	/CLEAR LINK SWITCH
	JMP I PUNONE	/--RETURN--

/PASS 2-OUTPUT ONE REGISTER

PUNON2,	TAD VALUE	/GET CONTENTS
	CLL
	JMS I [PUNOUT	/OUTPUT AS 2 FRAMES
	JMP PUNON3	/AND EXIT
	PAGE
/**CURRENT PAGE LITERALS ON THIS PAGE WILL BE LOST**
/***WHEN OVERLAYED BY PUSHDOWN LIST**

/ARRANGE TO OUTPUT ONE REGISTER

PUNBIN,	0
	DCA VALUE
	JMS I [FINDSP	/FIND CURRENT PAGE NUMBER
	TAD [LITBUF
	DCA TEMP2	/POINT TO NUMBER OR LITERALS
	TAD LOC
	AND [177
	DCA TEMP
	TAD I TEMP2	/IS PAGE FULL?
	CIA
	TAD TEMP
	ISZ TEMP
	SPA CLA
	JMP ONEOK	/NO-OK TO ADD ONE MORE REGISTER
	TAD TEMP	/YES-
	DCA I TEMP2
	JMS I [FINDSP	/FIND CURRENT PAGE NUMBER
	JMS I PPEZE	/GENERATE PE OR ZE ERROR
ONEOK,	JMS I [FINDSP	/FIND CURRENT PAGE NUMBER
	TAD [TPINST
	DCA TEMP2
	TAD TEMP	/IS THIS ADDRESS HIGHER THAN PREVIOUS
	CIA		/HIGH INSTRUCTION PAGE?
	TAD I TEMP2
	SMA CLA
	JMP PUNMOD	/NO
	TAD TEMP	/YES-THIS IS NEW HIGH INSTRUCTION
	DCA I TEMP2

PUNMOD,	JMS I [PUNONE	/OUTPUT THIS REGISTER
	ISZ LOC		/GET NEXT LOCATION
	TAD LOC		/IF THE "ISZ" SKIPS IT IS O.K. (A 0)
	AND [177	/IS THIS FIRST INSTRUCTION ON NEXT PAGE?
	SZA CLA
	JMP I PUNBIN	/NO--RETURN--
	JMS I [FINDSP	/YES-FIND CURRENT PAGE NUMBER
	TAD [LITBUF	/RESET POINTERS
	DCA TEMP2
	TAD I TEMP2
	DCA LITPTR
	JMP I PUNBIN	/--RETURN--

PPEZE,	PEZE
HEADER,	"S;"Y;"M;"B;"O;"L;"S
	211;211;211;211;211	/FOR /N HEADER

/************************************************************
/CODE OVERLAYED ON PASS 3
/BY USER HEADER BUFFER

/CONTINUATION OF EXPUNGE HANDLER
/ENTER ON PASS 1 ONLY

EXPUNW,	IFZERO	HASH<
	DCA TEMP1
	DCA EXPUN2	/CLEAR NEW HIGH TAG COUNTER
	TAD HIGHTG
	CMA
	DCA TEMP3	/SAVE NUMBER OF SYM TBL ENTRIES
EXPUNY,	TAD TEMP1
	DCA THISTG
	JMS I [FINDTG	/GET A SYMBOL
	TAD TAG1	/ONLY SAVE THE SYMBOL IF
	RTL
	CLA		/IT WAS A PSEUDO-OP, OR
	TAD TAG3	/THE SYMBOLS I OR Z
	SNL SMA CLA
	JMP EXPUA4	/NO-FORGET TAG
	TAD EXPUN2	/YES-RETURN TAG TO SYMBOL TABLE
	DCA THISTG
	JMS I [PUTTAG
	ISZ EXPUN2
EXPUA4,	ISZ TEMP1
	ISZ TEMP3	/DONE YET?
	JMP EXPUNY	/NO- TRY NEXT TAG
	CLA CMA		/YES
	TAD EXPUN2	/RESET HIGH TAG
	DCA HIGHTG
	JMP I [LOOKEX	/--EXIT TO MAIN--

EXPUN2,	0
	>
	IFNZRO	HASH<
	/HASH TABLE EXPUNGE - DEPENDS ON PSEUDO OPS
	/BEING HASHED FIRST. SCANS WHOLE TABLE (SLOW AS HELL!)

	DCA	THISTG	/POINT TO FIRST ENTRY
	TAD	TAGMAX	/SET THE COUNT
	CIA
	DCA	TEMP1
EXPUNL,	JMS I	[FINDTG	/GO GET ONE
	TAD	TAG1	
	RTL
	CLA
	TAD	TAG3
	SPA SZL CLA	/PSEUDO OP?
	JMP	EXPUNS	/YES, SKIP DELETION
	DCA	TAG1	/NO, WIPE IT
	DCA	TAG2
	DCA	TAG3
	JMS I	[PUTTAG	/AND PUT IT BACK
	STA
	TAD	HIGHTG
	DCA	HIGHTG	/DECREMENT SYMBOL COUNT
EXPUNS,	ISZ	THISTG	/POINT TO NEXT ENTRY
	ISZ	TEMP1	/TALLY COUNT
	JMP	EXPUNL	/GET ANOTHER
	JMP I	[LOOKEX	/DONE --RETURN--
	>

/***************************************************************
/ASSEMBLER HEADER BUFFER

	ZBLOCK	HEADER+HEDLEN-.

	" ;" ;"P;"A;"L;"8;"-
	"V;"1;VERSION-12+"0;SUBVERSION
	" 
DATE,	"N;"O;" ;"D;"A;"T;"E;" 	/GETS SET TO DD-MMM-YY IF DATE PRESENT
	" ;" ;"P;"A;"G;"E;" ;0
/PUSHDOWN LIST
/OCCUPIES NEXT 43(8) LOCATIONS
PDLND=.



/*********************************************************
/ONCE ONLY CODE FOR /D OPTION
/PUT INTO SYMLST FOR DDT COMPATIBLE SYMBOL TABLE
/OVERLAYED DURING ASSEMBLY BY PUSHDOWN LIST

DSWIT1,	IFZERO	HASH<
	RELOC SYMPRT+4

	DCA I SYMPRF
	JMS SYMPRC
	TAD [377
	JMS I OERROR
	CLA CMA
	DCA THISTG
SYMPRE,	TAD [215
	JMS I OERROR
	JMS SYMPPP
	JMP SYMPRD
	JMP SYMPR1
SYMPRF,	HSWIT1
SYM204,	204
	RELOC

	>
	IFNZRO	HASH<
	RELOC	SYMNWP
	DCA	THISTG
	DCA I	SYMHSW
	JMS	DDTLDR
	TAD	[377
	JMS I	OERROR
SYMLUP,	TAD	[215
	JMS I	OERROR
	TAD	HIGHTG	
	CLL CIA
	TAD	THISTG
	SZL CLA
	JMP	SYMXIT
	JMP	SYMGO
SYMHSW,	HSWIT1
	RELOC
	>
DSWITA=	.

/**********************************************************
	PAGE
/*************************************************************

/PAL8 TABLES - LOAD OVER INITIALIZATION CODE

PDLST=	PDLND+42	/PUSHDOWN LIST 43(8) LOCS LONG


LINBUF=	PDLST+1		/LINE BUFFER OCCUPIES 122(8) LOCATIONS

LITBUF=	LINBUF+122	/LITERAL TABLE IS 40(8) LOCATIONS (ONE PER PAGE)
			/  SHOWING LOWEST PAGE ADDRESS USED FOR LITERALS

TPINST=	LITBUF+40	/TOP INSTRUCTION TABLE IS 40(8) LOCTIONS
			/  SHOWING HIGHEST PAGE ADDRESS USED FOR INSTRUCTIONS

LITBF2=	TPINST+40-17	/LITERAL BUFFER 2 CONTAINS UP TO 160(8)
			/PAGE 0 LITERALS, SUBSCRIPTS 20-177

LITBF1=	LITBF2+200-100	/LITERAL BUFFER 1 CONTAINS UP TO 100(8)
			/CURRENT PAGE LITERALS, SUBSCRIPTS 100-177

/*************************************************************
/ONCE ONLY CODE FOR ASSEMBLER START UP
/OVERLAYED BY BUFFERS

/HANDLES SWITCH OPTIONS

BEGIN,	CIF 10
	JMS I IOMON	/CALL USER SERVICE ROUTINES
	5		/*COMMAND DECODER*
	2001		/DEFAULT INPUT EXTENSION IS .PA
NOCD,	CDF 10		/RETURN
	TAD I (7604	/IS THERE A BINARY FILE EXTENSION?
	SNA
	TAD (216	/NO - DEFAULT EXTENSION IS .BN
	DCA I (7604	/YES 
	TAD I (7611	/IS THERE A LISTING FILE EXTENSION?
	SNA
	TAD (1423	/NO - DEFAULT EXTENSION IS .LS
	DCA I (7611
	TAD I (MPARAM+1	/WAS THE /T OPTION SELECTED?
	CDF
	AND (20
ZT7640,	SNA CLA
	JMP BEGINA	/NO
BEGIAA,	DCA I (HSWITC	/YES - GENERATE CR/LF IN PLACE OF F/F
	JMP BEGIN2

BEGINA,	TAD [7605	/WAS TTY THE PASS 3 DEVICE?
	JMS I (OTYPE
	AND (770
	SNA CLA
	JMP BEGIAA	/YES - GENERATE CR/LF IN PLACE OF F/F
	DCA I (BEGIAB	/NOT /T OR TTY:

BEGIN2,	CDF 10
	TAD I (MPARAM+1	/WAS THE /S OPTION SELECTED?
	CDF
	AND (40
	SZA CLA
	DCA I (SSWITC	/YES -OMIT SYMBOL TABLE
	CDF 10
	AC2000
	AND I (MPARAM+1
	CDF
	SNA CLA		/WAS THE /N OPTION SELECTED?
	JMP BEGIN4	/NO
	TAD BEGSKP	/SET SWITCH
	DCA I (NSWITC	/YES -SYMBOL TABLE BUT NO LISTING
BEGIN4,	CDF 10
	TAD I (MPARAM	/WAS THE /H OPTION SELECTED?
	CDF
	AND (20
ZH7640,	SNA CLA
	JMP BEGINB	/NO
BEGHSW,	TAD I (FORM21	/YES -SUPPRESS LISTING PAGE FORMAT
	DCA I (HSWITC
	DCA I (HSWIT1
BEGSKP,	CLA SKP
BEGINB,	DCA I (HSWIT2
	CDF 10
	TAD I (MPARAM	/WAS THE /D OPTION SELECTED?
	CDF
	AND [400
ZD7640,	SNA CLA
	JMP BEGIN1	/NO
	TAD I XREG1	/YES -DDT COMPATIBLE SYMBOL TABLE
	DCA I LAST3	/SUBSTITUTE ALTERNATE CODE
	ISZ DSWIT3	/INTO SYMBOL TABLE OUTPUT ROUTINE
	JMP .-3
	TAD I XREG2
	DCA I LAST4
	ISZ DSWIT4
	JMP .-3

BEGIN1,	TAD I (JSBITS	/RESET JOB STATUS WORD TO
	AND (6777	/INDICATE PAL8 NOT RESTARTABLE
	TAD (1000
	DCA I (JSBITS
	CIF CDF	10
	JMS I	(FMTDAT	/CALL ROUTINE IN FIELD 1 TO SETUP DATE
	JMP I	(BEGINZ	/CONTINUE ON

DSWIT3,	DSWIT1-DSWITA
DSWIT4,	DSWIT2-DSWITB
	PAGE
/ONCE ONLY CODE CONTINUED
/ASSEMBLER INITIALIZATION PROCEDURES


BEGINZ,	TAD [7600	/WHAT DEVICE FOR BINARY OUTPUT?
	JMS I (OTYPE
	SMA CLA
	TAD (-70	/STAND-ALONE
	TAD (-10	/DIRECTORY
	DCA I (SWAPR2+LEADER	/SET AMOUNT OF LEADER TRAILER
	DCA LAST1	/NO DEFINED TAG
BEGIN5,	IFZERO	HASH<
	CDF
	TAD I BLK1	/MOVE SYMBOL TABLE TO FIELD 1
	CDF 10
	DCA I BLK2
	ISZ BLK1
	ISZ BLK2
	ISZ BLK3
	JMP BEGIN5
	>
	CDF
	DCA I [LINBUF+120	/SET BUFFER POINTERS
	DCA I (LINBUF+121
	TAD [7600	/IS PTP BINARY OUTPUT DEVICE?
	JMS I (OTYPE
	DCA BLK1
	TAD BLK1
	AND (770
	TAD (-20
	SNA CLA
	DCA I (PTPSW	/YES - SET PTP SWITCH
	TAD BLK1	/NO - IS IT A DIRECTORY DEVICE?
	SPA CLA
	JMP .+3		/NO
	TAD (TAD [77	/YES - SET DIRECTORY SWITCH
	DCA I (DIRSW
	TAD [7605	/IS PTP GETTING LISTING OUTPUT?
	JMS I (OTYPE
	AND (770
	TAD (-20
	SNA CLA
	DCA I (SWAPR2+PTPSW1	/YES - SET PASS 3 PTP SWITCH
	TAD [7605	/NO - IS DIRECTORY DEVICE GETTING
	JMS I (OTYPE	/LISTING OUTPUT?
	SPA CLA
	JMP .+3		/NO
	TAD (TAD [77	/YES - SET PASS 3 DIRECTORY SWITCH
	DCA I (SWAPR2+DIRSW1
	JMP I (BEGINF
MONLST,	TEXT	/JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/
	*.-1

/CONTINUED CHECK OF COMMAND DECODER OPTIONS

BEGINH,	CDF 10
	TAD I (MPARAM	/WAS THE /G OR /L OPTION CHOSEN?
	CDF
	AND (41
	SNA CLA
	JMP I (BEGISW	/NO
	CDF 10		/YES
	TAD I [7600
	SZA CLA		/WAS THERE A BINARY OUTPUT FILE?
	JMP YESBIN	/YES
BINLOP,	TAD PALBIN	/NO - CREATE FILE PAL8BN.TM
	DCA I PALBIX	/ON SYSTEM DEVICE
	ISZ BINLOP
	ISZ PALBIX
	ISZ BINCNT
	JMP BINLOP
	CDF
	TAD (-10	/SET AMOUNT OF LEADER TRAILER
	DCA I (SWAPR2+LEADER
/SET UP FOR LOAD OR LOAD AND GO

YESBIN,	CDF
	CIF 10
	CLA IAC
	JMS I IOMON	/CALL USER SERVICE ROUTINES
	2		/* LOOKUP PERMANENT FILE *
LOAD,	PLOAD		/FILENAME ABSLDR.SV
BINCNT,	-5		/FILE LENGTH
	JMP NOLOAD	/ABSLDR.SV NOT FOUND
	TAD LOAD	/NORMAL RETURN
	DCA I (CHAIN	/SET STARTING BLOCK NUMBER
	DCA I (LSWITC	/FOR CHAIN CALL
	JMP I (BEGISW

NOLOAD,	JMS I [ERROR	/GENERATE LD ERROR MESSAGE
	LD
	JMP I (BEGISW	/ASSEMBLE BUT DO NOT CHAIN TO LOADER

BLK1,	SYMS
BLK2,	7600+SYMS-SYME
BLK3,	SYMS-SYME

PALBIX,	7600
PALBIN,	1
	FILENAME PAL8BN.TM
	PAGE
CCC,	TAD I CC231	/FINAL PIECE OF STARTUP ONCE-ONLY CODE
	SNA
	TAD CC23
	DCA I CC231	/"HSWITC"=JMP FORMF1 IF WAS 0
BEGISW,	CDF 10
	TAD I CCJWD
	CDF 0
	AND CCJBIT
ZJ7640,	SNA CLA		/WAS /J OPTION SPECIFIED?
	DCA I CCJLOC	/NO - PRINT UNASSEMBLED CONDITIONAL CODE
	CDF 10
	TAD I CCWWD
	CDF 0
	AND CCWBIT
ZW7640,	SNA CLA		/WAS /W OPTION SPECIFIED?
	JMP D4		/V3C
D5,	TAD I CC231
	CIA
	TAD CC23
	SZA CLA		/ARE WE OUTPUTTING FF'S IN LISTING?
	JMP BEGIS3	/NO
	TAD CC24	/YES - SUBSTITUTE SOME CODE
	DCA I CC25
	TAD CC26
	DCA I CC27
	TAD CC24
	DCA I CC28
BEGIS3,	JMS I OVLL7	/CALL SYSTEM DEVICE
	4200		/WRITE 2 PAGES
	SWAP1		/FORM SWAP1
	ASWAP		/INTO TEMP AREA
	JMP I OVLL8	/ERROR?!
	TAD I LAST2	/MOVE PASS 1&2 ONLY CODE
	DCA I TAGXR	/OVER PASS3 SWAPPED OUT CODE
	ISZ CC29
	JMP	.-3
	IFNZRO	HASH<
	JMS I	CCHSH	/FINALLY HASH OUT THE TABLE
	>

	JMP I	.+1
	START2-1	/OK - NOW GO DO SOME ASSEMBLING!
D4,	DCA I CCWLOC	/NO - DON'T WIPE LITERALS AS YOU DUMP THEM
	DCA I (D3
	JMP D5		/V3C
OVLL7,	7607
OVLL8,	SYSER3

CC231,	HSWITC
CC23,	FORMF1&177+5200
CC24,	STA
CC25,	FORMF1
CC26,	DCA LINCNT
CC27,	FORMF1+1
CC28,	FORMF1+2
CC29,	SWAPB2-SWAPE2

	IFNZRO	HASH<
CCHSH,	HSHSMS
	>
CCJWD,	MPARAM
CCJBIT,	4
CCJLOC,	IFTST4
CCWWD,	MPARAM+1
CCWBIT,	2
CCWLOC,	LITHAK
PLOAD,	FILENAME ABSLDR.SV

CKBAT,	TAD I CC7777	/GET BATCH FLAG WORD
	CLL RTL
	SNL CLA		/BATCH RUNNING?
	JMP I CCOPTM	/NO, GO WITH LINK OFF
	TAD I CC7777
	AND CC0070	/GET BATCH FIELD
	TAD CCCIF0	/FORM CIF TO BATCH FIELD
	DCA OTYPB1	/MODIFY TTY OUTPUT ROUTINE TO GO TO BATCH
	TAD CCJMSB	/LOG INSTEAD
	DCA OTYPB2
	TAD OTYPTD
	DCA OTYPB3
	JMP I CCOPTM	/RETURN TO CORE DETERMINER, LINK SET

CC7777,	7777
CCOPTM,	OPTIM4
CC0070,	70
CCCIF0,	CIF 0
CCJMSB,	JMS I [BATOUT
/THIS CODE SITS AFTER THE END OF THE LITERAL TABLE

	IFNZRO	.-LITBF1-200&4000 <*LITBF1+200>

OTYPEO,	0		/TYPE A CHARACTER, CHECKING FOR ^O AND ^C
	DCA OTYPEC	/SAVE CHAR
	JMS CTCCHK	/CHECK FOR ^C - RETURN CHAR-203 IN AC
	TAD (-14
	SNA CLA		/^O?
	JMP I OTYPEO	/YES
OTYPTD,	TAD OTYPEC
OTYPB1,	TLS
OTYPB2,	TSF
OTYPB3,	JMP	.-1	/WAIT FOR TTY
	TAD	[-215
OTYPCR,	SZA CLA		/SET TO CLA DURING "ERRORS DETECTED" STUFF
	JMP I	OTYPEO
	TAD [212	/IF CHAR WAS CR, TYPE LF
	JMP OTYPEO+1
OTYPEC,	0

CTCCHK,	0		/CHECK FOR ^C
	TAD [200
	KRS		/OR IN KEYBOARD CHAR
	TAD (-203
	SNA
	KSF		/3B BUT WAS CHAR REALLY THERE?
	JMP I CTCCHK	/NO ^C - RETURN
	JMP I [7600	/RETURN TO OS/8

TTLMSG,	"E-240^100+"R-240	/ERRORS DETECTED:
	"R-240^100+"O-240
	"R-240^100+"S-240
	"D-240
	"E-240^100+"T-240
	"E-240^100+"C-240
	"T-240^100+"E-240
	"D-240^100+":-240
	0

	"L-240^100+"I-240	/LINKS GENERATED:
	"N-240^100+"K-240
	"S-240^100
	"G-240^100+"E-240
	"N-240^100+"E-240
	"R-240^100+"A-240
	"T-240^100+"E-240
	"D-240^100+":-240
	0
	PAGE
/OUTPUT A CHARACTER TO OUTPUT DEVICE
/CALLED BY JMS I OCHAR
/WITH CHARACTER IN 8-BIT ASCII IN AC

OUTPT1,	PUNCHX		/PASS 2=PUNCHX; 3=XLISTX

OUTPUT,	0
	AND [377	/MASK OUT LEFT 4 BITS
	DCA OUTPT2	/STORE
	TAD I OUTPT1	/IS THIS PASS 3 AND
	SNA
	TAD OUTINH	/IS THIS COVERED BY XLIST?
	SZA CLA
	JMP I OUTPUT	/YES--RETURN--
	TAD OUTPT2	/NO - GET CHARACTER
	AND [200
	SNA CLA
	TAD OUTPT2	/IF LESS THAN 200, THEN
	TAD CHKSUM	/ADD IT TO CHECKSUM
	DCA CHKSUM
	TAD OUTPT2	/GET CHARACTER
	TAD (-211	/IS IT A TAB?
	SNA CLA
	JMP OUTPT3	/YES - OUTPUT SPACES
	JMS OUTPUX	/NO - OUTPUT CHARACTER
	TAD OUTPT2	/IS IT LINE FEED?
	TAD (-212
	SZA CLA
	JMP I OUTPUT	/NO--RETURN--
	TAD [7773	/YES - RESET LSTCNT
	DCA LSTCNT
	JMP I OUTPUT	/--RETURN--

/OUTPUT SPACES INSTEAD OF TAB

OUTPT3,	TAD [240
	DCA OUTPT2
	JMS OUTPUX	/OUTPUT SPACE
	TAD LSTCNT	/TAB STOPS ARE EVERY 8 SPACES
	AND [7
	SZA CLA
	JMP .-4
	JMP I OUTPUT	/--RETURN--

/OUTPUT THE CHARACTER
/PACKS CHARACTERS IN STANDARD OS/8 FORMAT

OUTPUX,	0
	ISZ OUJMP	/BUMP 3-WAY SWITCH
OUJMP,	HLT		/WILL BE CHANGED - SHOULD NEVER HALT
	JMP OCHAR1	/CHARACTER #1
	JMP OCHAR2	/CHARACTER #2
OCHAR3,	TAD OUTPT2	/CHARACTER #3
	CLL RTL
	RTL
	AND [7400
	TAD I OUPOLD	/ADD 4 BITS TO WORD 1
	DCA I OUPOLD
	TAD OUTPT2
	CLL RTR
	RTR
	RAR
	AND [7400
	TAD I OUPTR	/ADD 4 BITS TO WORD 2
	DCA I OUPTR
	TAD OUJMPE
	DCA OUJMP	/RESET SWITCH
	ISZ OUPTR
	ISZ OUDWCT	/BUFFER FULL?
	JMP OUCHLV	/NO
	TAD [200	/YES
	JMS I (OUTDMP	/DUMP BUFFER
	JMS OUSETP	/RESET POINTERS
	JMP OUCHLV

OCHAR2,	TAD OUPTR	/SAVE POINTER
	DCA OUPOLD
	ISZ OUPTR
OCHAR1,	TAD OUTPT2
	DCA I OUPTR	/SET 8 BIT WORD
OUCHLV,	TAD OUTPT2
/	TAD [40
/	AND [100	/CHECK FOR PRINTABLE CHAR
/	SZA CLA		/IF IT IS,
	TAD [-240
	SMA CLA
	ISZ LSTCNT	/BUMP TAB COUNT
OUTINH,	0		/ALWAYS 0 OR 1!
	JMP I OUTPUX	/--RETURN--

OUPOLD,	0
OUPTR,	0
OUJMPE,	JMP OUJMP
OUDWCT,	0
OUTPT2,	0

OUSETP,	0
	TAD [7600	/SET OUTPUT WORD COUNT
	DCA OUDWCT	/TO 200
	TAD (OUBUF
	DCA OUPTR	/RESET POINTER
	TAD OUJMPE
	DCA OUJMP	/RESET SWITCH
	CLL		/MUST CLEAR LINK!!
	JMP I OUSETP	/--RETURN--
/HANDLER FOR DEVICE PSEUDO-OP

DEVICX,	JMS I [SPNOR	/IGNORE TRAILING SPACES
	TAD [-5
	JMP DEVIC1	/PACK 4 CHARACTERS


/HANDLER FOR FILENAME PSEUDO-OP

FILENX,	JMS I [SPNOR	/IGNORE TRAILING SPACES
	TAD (-7
	JMS FILE1	/PACK 6 CHARACTERS
	TAD CHAR
	TAD [-".	/WAS CHARACTER . ?
	SNA CLA
	JMS I [GETC	/YES-SKIP TO EXTENSION
	AC7775
DEVIC1,	JMS FILE1	/PACK 2 CHARACTERS
	JMP I [LOOKEX	/--EXIT TO MAIN--

/PACK CHARACTERS
/NEGATIVE OF # OF CHARACTERS TO BE PACKED IN AC ON ENTRY

FILE1,	0
	DCA FILE6	/SAVE # OF CHARACTERS TO PACK
	DCA I (TEXT6	/RESET PACK SWITCH
FILE4,	JMS I (TSTALN	/IS CHARACTER IN CHAR ALPHANUMERIC?
	SKP
	JMP FILE5	/NO-DONE PACKING
	ISZ FILE6	/YES-TOO MANY CHARACTERS?
	JMP FILE3	/NO-O.K.
	CLA CMA	/YES
	DCA FILE6	/RESET # OF CHARACTERS AND IGNORE
	JMP FILE2

FILE3,	TAD CHAR
	JMS I (TEXT2	/PACK A CHARACTER
FILE2,	JMS I [GETC	/GET A CHARACTER
	JMP FILE4	/TEST IT

	JMS I (TEXT2	/PACK A ZERO CHAR
FILE5,	ISZ FILE6	/ARE WE DONE?
	JMP .-2		/NO - PAD WITH ZEROES
	JMP I FILE1	/YES--RETURN--
FILE6,	0
	PAGE
/HANDLER FOR TEXT PSEUDO-OP
/SPACES ARE IGNORED TO DELIMITER
/DELIMITER IS FIRST PRINTING CHARACTER
/OTHER THAN SPACE
/NON-PRINTING CHARACTERS ARE ILLEGAL
/A PRINTING CHARACTER HAS EITHER BIT 5
/OR BIT 6 SET, BUT NOT BOTH

TEXT8,	JMS I [GETC	/GET NEXT CHARACTER
TEXTX,	CLL CLA CML RAR	/AC=4000
	DCA GETCI	/; AND / ARE NOT END OF LINE
	JMS TEXT1A	/CHECK FOR PRINTING CHARACTER
	JMP TEXT8	/NON PRINTING - IGNORE
	TAD [-240	/IGNORE SPACES UNTIL DELIMITER
	SNA		/HAS BEEN FOUND
	JMP TEXT8
	TAD [240	/RESTORE CHARACTER
	CIA
	DCA VALUE2	/STORE NEGATIVE DELIMITER
	DCA TEXT6	/SET PACKING SWITCH
TEXT3,	JMS I [GETC	/GET NEXT CHARACTER
	JMS TEXT1A	/IS IT A PRINTING CHARACTER?
	JMP TEXT9	/NO - IC
	TAD VALUE2	/YES - IS IT DELIMITER?
	SNA CLA
	JMP TEXT4	/YES - TERMINATE
	TAD CHAR	/NO - PACK AND OUTPUT
	JMS TEXT2	/PACK IT
	JMP TEXT3

TEXT4,	DCA GETCI	/RESET GETCI TO CALL ; AND / END OF LINE
	JMS I [GETC	/SKIP DELIMITER
TEXT4X,	JMS TEXT2	/OUTPUT 0 TO FILE
	JMS TEXT2
/CHANGE TEXT4X TO:
/	NOP
/FOR NO EXTRA WORD OF ZEROS
	DCA GETCI	/RESET GETCI IN CASE WE HIT CR
	JMP I [LOOKEX	/--EXIT TO MAIN--
TEXT9,	JMS I [ERROR	/GENERATE IC ERROR MESSAGE
	IC
	JMP TEXT3

/SKIP ON PRINTING CHARACTER

TEXT1A,	0
	TAD CHAR
	SPA SNA CLA	/IS CHARACTER -
	JMP TEXT4X	/YES
	TAD CHAR
	TAD [40
	AND [100
	SZA CLA		/IS THE CHAR PRINTING?
	ISZ TEXT1A	/YES - INCREMENT RETURN
	TAD CHAR	/WITH CHARACTER IN AC
	JMP I TEXT1A	/--RETURN--

/OUTPUT 2 TEXT CHARACTERS (ONE REGISTER)
/ENTER WITH CHARACTERS IN AC

TEXT2,	0
	AND [77		/GET RIGHT 6 BITS
	ISZ TEXT6	/WHICH HALF OF WORD?
	JMP TEXT5	/LEFT
	TAD TEXT7	/RIGHT--ADD IN LEFT HALF
	JMS I [PUNBIN	/OUTPUT IT
	JMP I TEXT2	/--RETURN--

TEXT5,	JMS I [RTL6	/GET LEFT HALF OF WORD
	DCA TEXT7	/SAVE IT
	CLA CMA		/SET SWITCH FOR RIGHT HALF
	DCA TEXT6
	JMP I TEXT2	/--RETURN--

TEXT6,	0
TEXT7,	0
/HANDLER FOR EXPUNGE PSEUDO-OP

EXPUNX,	TAD PASS	/IS THIS PASS 1
	SMA CLA
	JMP I [LOOKEX	/NO--EXIT TO MAIN--
	JMP I (EXPUNW	/YES-CONTINUE AT EXPUNW



/CLOSE OUTPUT FILE

OCLOSE,	0
	TAD I (OUTINH	/OUTPUT INHIBITED?
	SZA CLA
	JMP I OCLOSE	/YES--RETURN--
PTPSW,	TAD [232	/NO-0 IF PTP: - OUTPUT ^Z
	JMS I OCHAR
	JMS I OCHAR	/AND ZEROS
FILLLP,	JMS I OCHAR
DIRSW,	TAD [177	/TAD [77 IF NOT DIRECTORY
	AND I (OUDWCT	/FILL OUT BUFFER OR HALF BUFFER
	SZA CLA		/WITH ZEROS
	JMP FILLLP
	TAD I (OUDWCT	/IS THERE OUTPUT TO BE DUMPED?
	TAD [200
	SZA
	JMS OUTDMP	/YES - DUMP IT
	TAD OUFILE	/GET DEVICE NUMBER IN AC
	CIF 10
	JMS I IOMON	/CALL USER SERVICE ROUTINES
	4		/*CLOSE OUTPUT FILE*
OUCNAM,	0		/POINTER TO FILENAME TO BE DELETED
OUCCNT,	0		/LENGTH OF NEW PERMANENT FILE
	JMP SYSER3	/DE**FATAL ERROR**
	JMP I OCLOSE	/--RETURN--

OUFILE,	ZBLOCK 5
/OUTPUT DUMP
/AC CONTAINS CONTROL WORD FOR DUMP

OUTDMP,	0
	TAD [4000	/BE SURE CONTROL WORD IS
	DCA OUCTLW	/A WRITE OPERATION
	TAD OUBLK	/GET STARTING BLOCK NUMBER
	TAD OUCCNT	/ADD IN COUNT
	DCA OUREC	/SET THIS BLOCK NUMBER
	TAD OUCTLW
	TAD [100	/ROUND HALF-BLOCK, IF ANY
	CLL RTL
	RTL
	RTL
	AND [17		/GET THIS COUNT
	TAD OUCCNT
	DCA OUCCNT	/ADD TO TOTAL COUNT
	TAD OUCCNT	/IS OUTPUT DEVICE FULL?
	CLL CML
	TAD OUELEN	/CHECK AGAINST MAXIMUM LENGTH
	SNL SZA CLA
	JMP SYSER2	/DF**FATAL ERROR**
	JMS I OUHNDL	/CALL OUTPUT DEVICE HANDLER
OUCTLW,	0		/CONTROL WORD
	OUBUF		/BEGINNING OF OUTPUT BUFFER
OUREC,	0		/STARTING BLOCK NUMBER
SYSER3,	CLA SKP		/ERROR RETURN
	JMP I OUTDMP	/--RETURN--
SYSERR,	TAD (DE		/DE **FATAL ERROR**
	JMP I [MONERR

OUHNDL,	0
OUBLK,	0
OUELEN,	0

SYSER2,	TAD (DF		/GENERATE DF ERROR MESSAGE
	JMP I [MONERR	/**FATAL ERROR**
	PAGE
/MAINLINE CODE

LOOKE2,	0		/WAS THIS END OF LINE
	TAD CHAR	/ OR END OF CONDITIONAL?
	TAD [-">
	SNA
	JMP CONEND	/END OF CONDITIONAL
	TAD (">
	SMA CLA
	JMP I LOOKE2	/NOT END OF LINE--RETURN--
LOOKE1,	JMS I [GETC	/GET A CHARACTER
MAIN,	JMS I (CTCCHK	/CHECK FOR ^C
	CLA		/** CTCCHK RETURNS AC NON-ZERO!
	JMS I [SPNOR	/IGNORE SPACES
	TAD CHAR
	TAD (-"$	/WAS IT $ ?
	SNA		/YES--
	JMP I (ENDPAS	/NO-END THIS PASS
	TAD ("$-"*
	SNA CLA		/WAS IT * ?
	JMP STAR	/YES-HANDLE *
	JMS I [TSTALP	/NO-WAS IT ALPHABETIC?
	JMP ALPHA	/YES
	JMS LOOKE2	/NO
TOEXP,	JMS I [EXP	/GET REST OF EXPRESSION
	TAD LININD
	DCA LINKSW	/STORE LINK SWITCH
	TAD VALUE
	JMS I [PUNBIN	/OUTPUT THE REGISTER
LOOKEX,	JMS I [SPNOR	/IGNORE TRAILING SPACES
	JMS LOOKE2	/IS LINE ENDED?
ILCHAR,	JMS I [ERROR	/NO-GENERATE IC ERROR MESSAGE
	IC
	JMP CONEN1

CONEND,	TAD CONDSW	/ARE WE INTO CONDITIONALS?
	SNA
	JMP ILCHAR	/NO - > IS ILLEGAL
	IAC		/ONE LESS CONDITIONAL
	DCA CONDSW
CONEN1,	JMS I [GETC	/GET NEXT CHARACTER
	JMP LOOKEX	/AND TRY FOR END AGAIN
/HANDLER FOR *

STAR,	JMS I [GETC	/GET NEXT CHARACTER AFTER *
	JMS I [SPNOR	/IGNORE SPACES
	JMS I [EXP	/GET REST OF EXPRESSION
STAR0,	DCA STARSW	/ENTER HERE FROM RELOC WITH AC = -1
	ISZ UNDFSW	/WAS ANYTHING UNDEFINED?
	JMP .+3		
	JMS I [ERROR	/YES-GENERATE UO ERROR MESSAGE
	UO
	TAD VALUE	/NO
	DCA OP
	TAD LOC		/IS THIS THE SAME PAGE AS
	AND [7600	/THE PREVIOUS CODE?
	CIA
	TAD OP
	AND [7600
	SNA CLA
	JMP STAR2	/YES-PUNCH ORIGIN
	JMS I [DUMPS	/NO-DUMP LITERALS
	TAD OFSBUF	/SET OFFSET TO NEW VALUE
	DCA OFFSET	/AFTER LITERALS ARE DUMPED.
	TAD OP		/PUNCH NEW ORIGIN, SET "VALUE"
	JMP I (STAR3	/FOR LISTING, AND SET UP IN NEW PAGE

STAR2,	TAD OFSBUF	/SET OFFSET TO NEW VALUE
	DCA OFFSET	/
	TAD OP
	JMS I [PUNORG	/PUNCH ORIGIN
	DCA LAST1	/CLEAR LAST DEFINED SYMBOL
	JMP I [PUNVAL

ALPHA,	JMS I [GETTAG	/PICK UP TAG-IS IT IN TABLE?
	DCA ALPHAI	/STORE UNDEFINED TAG SWITCH
	TAD TAG3	/IS IT A PSEUDO-OP?
	SPA CLA
	JMP I VALUE2	/YES-GO TO ITS HANDLER
	TAD CHAR	/NO
	TAD (-",	/WAS IT TERMINATED BY , ?
	SNA
	JMP COMMA	/YES-DEFINE THE SYMBOL
	TAD (",-"=	/NO-WAS IT TERMINATED BY = ?
	SNA CLA
	JMP I (EQUAL	/YES-EQUATE THE SYMBOL
	AC4000		/NO
	JMP TOEXP	/TREAT AS AN EXPRESSION
/HANDLER FOR ,

COMMA,	JMS I [GETC	/GET NEXT CHARACTER
	ISZ ALPHAI	/WAS TAG DEFINED PREVIOUSLY?
	JMP COMMA2	/YES
	TAD LOC		/NO-STORE CURRENT ADDRESS FOR DEFINITION
	DCA VALUE2
	JMS I [INSRTG	/PUT TAG IN SYMBOL TABLE
COMMA1,	TAD TAG1	/STORE FOR ERROR MESSAGE OUTPUT
	DCA LAST1
	TAD TAG2
	DCA LAST2
	TAD TAG3
	DCA LAST3
	TAD VALUE2
	DCA LAST4
	JMP MAIN	/--EXIT TO MAIN--

COMMA2,	TAD LOC		/DO NEW AND OLD DEFINITIONS AGREE?
	CIA
	TAD VALUE2
	SNA CLA
	JMP COMMA1	/YES-ALLOW REDEFINITION
	JMS I [ERROR	/NO-GENERATE ID ERROR MESSAGE
	ID
	JMP MAIN	/--EXIT TO MAIN--
OPTABL,	OP0		/+
	OP1		/-
	OP6		/%
	OP2		/&
	OP5		/(SPACE)
OPEXPL,	OP5		/! - CHANGED TO OP3 IF /B ON
	OP4		/^
XCHANG,	0
	TAD VALUE
	AND [30
	SNA
	JMP .+3
	TAD [7700
	JMS I OCHAR
	JMP I XCHANG
	PAGE
/EXPRESSION PROCESSOR
/POSSIBLE RECURSIVE ENTRY
/ENTER WITH CHARACTER IN CHAR

EXP,	0
	DCA EXPIND	/SET INDICATOR (NOT 0 IF NO MRI FOUND)
	DCA LININD	/CLEAR LINK GENERATED SWITCH (' )
	DCA VALUE	/START WITH "VALUE" = 0
	DCA UNDFSW	/CLEAR UNDIFINED SWITCH
	TAD EXP
	JMS I [PUSHA	/SAVE RETURN ADDRESS
	DCA OP		/OP=0; ADD
	TAD EXPIND
	SPA CLA
	JMP I (EXPINT
	TAD CHAR	/IS CHARACTER A + ?
	TAD (-"+
	CLL RTR		/PUT THE 2 BIT IN THE LINK
	SZA CLA		/WAS CHAR 53(+) OR 55(-)?
	JMP EXP1A	/NO
	RAL		/YES - OP IS 0 OR 1, DEPENDING
EXP1,	DCA OP
	JMS I [GETC	/GET NEXT CHARACTER
	ISZ EXPIND	/MRI NO LONGER LEGAL ON THIS LINE
EXP1A,	TAD CHAR	/IS CHARACTER A . ?
	TAD [-".
	SNA
	JMP PERIOD	/YES-GO TO . HANDLER
	TAD (".-""	/NO-IS IT " ?
	SNA
	JMP QUOTE	/YES-GO TO " HANDLER
	TAD (""-"[	/NO-IS IT [ ?
	CLL
	SZA
	TAD ("[-"(	/OR (?
	SNA CLA
	JMP I (LIT	/YES - LITERAL - LINK HOLDS WHICH KIND
	JMS I [TSTALP	/NO-IS IT ALPHABETIC?
	JMP I (ALPHA1	/YES-HANDLE SYMBOL
	JMS I [TSTNUM	/NO-IS IT NUMERIC?
	JMP NUMBER	/YES-HANDLE NUMBER

EXP2,	JMS ENDCHK	/NO-CHECK FOR END
	JMP EXP1A	/NOGO - TRY AGAIN
	TAD OP
	TAD [-4		/IS OP SPACE (4)
	SNA CLA
	JMP I (EXPXIT	/YES-EXIT
	JMS I [ERROR
	IC		/GIVE IC MESSAGE ON ILLEGAL OPERATOR
	JMP I (EXPINT	/EXIT ANYWAY
/END OF EXPRESSION CHECK
/SKIP IF OK

ENDCHK,	0
	TAD CHAR
	TAD (-"]	/IS CHARACTER A ] ?
	SZA		/YES-SKIP A EXIT
	TAD ("]-")	/IS CHARACTER A ) ?
	SZA		/YES-SKIP A EXIT
	TAD (")-">	/IS CHARACTER A > ?
	SZA		/YES-SKIP AND EXIT
	TAD (">-"<	/IS CHARACTER A < ?
	SNA
	JMP ENDCH1	/YES-SKIP AND EXIT
	TAD ("<
	SPA CLA		/IS IT END-OF-LINE?
	JMP ENDCH1	/YES-SKIP AND EXIT
	JMS I [ICMESG	/NO - GENERATE IC MESSAGE AND GET NEXT CHAR
	JMP I ENDCHK	/--RETURN--

ENDCH1,	ISZ ENDCHK	/INCREMENT RETURN ADDRESS
	JMP I ENDCHK	/--RETURN--

NUMBER,	DCA TEMP
NUMBE2,	TAD RADIX	/IS THE CURRENT RADIX OCTAL?
	SNA CLA
	TAD CHAR	/YES-IS THE DIGIT GREATER THAN 7?
	TAD (-"8
	SMA CLA
	JMP NUMBE3	/YES-ILLEGAL CHARACTER
	TAD TEMP	/NO-ADD IT TO THE PREVIOUS
	CLL RAL		/ACCUMULATED VALUE
	CLL RAL
	DCA TEMP2
	TAD RADIX	/IS RADIX OCTAL?
	AND TEMP	/NO
	TAD TEMP2	/YES
	CLL RAL
	TAD CHAR
	TAD (-"0
	DCA TEMP
	JMS I [GETC	/GET NEXT CHARACTER
NUMBE4,	JMS I [TSTNUM	/IS IT NUMERIC?
	JMP NUMBE2	/YES-CONTINUE ACCUMULATING NUMBER
	TAD TEMP	/NO-STORE NUMBER
NUMBE1,	DCA VALUE2
NUMBE5,	TAD OP		/GO COMBINE IT VIA LAST OPERATION
	TAD (OPTABL
	DCA TEMP	/FIND THE OPERATOR HANDLER
	TAD I TEMP
	DCA TEMP
	JMP I TEMP	/GO TO THE HANDLER
/8 OR 9 FOUND DURING OCTAL RADIX

NUMBE3,	JMS I [ICMESG	/GENERATE IC ERROR MESSAGE AND
	JMP NUMBE4	/IGNORE CHARACTER


/HANDLER FOR .

PERIOD,	JMS I [GETC	/GET NEXT CHARACTER
	TAD LOC		/MAKE CURRENT LOCATION
	JMP NUMBE1	/INTO VALUE OF NUMBER

/HANDLER FOR "

QUOTE,	ISZ TXTPTR
	TAD I TXTPTR	/GET CHARACTER FROM TEXT BUFFER
	TAD [-215	/WAS IT CARRIAGE RETURN?
	SNA CLA
	JMP QUOTE1	/YES-IT IS IC-IGNORE "
	TAD I TXTPTR	/NO-PUT ASCII CODE INTO
	DCA VALUE2	/VALUE WORD
	JMS I [GETC	/GET NEXT CHARACTER
	JMP NUMBE5	/RETURN TO EXPRESSION PROCESSOR

/CARRIAGE RETURN FOUND IN SINGLE CHARACTER TEXT

QUOTE1,	JMS I [ERROR	/GENERATE IC ERROR MESSAGE
	IC
	CLA CMA
	DCA CHAR
	JMP I (EXPXIT
	PAGE
/COME HERE IF FIRST THING IN EXPRESSION IS ALPHA CHARACTER

ALPHA1,	JMS I [GETTAG	/PICK UP TAG
	DCA ALPHAI	/STORE UNDEFINED INDICATOR
ALPHA3,	TAD TAG3	/IS IT A PSEUDO-OP?
	SMA CLA
	JMP .+3
	JMS I [ERROR	/YES-GENERATE IP ERROR MESSAGE
	IP
	ISZ ALPHAI	/NO-WAS IT UNDEFINED?
	JMP ALPHA0
	ISZ UNDFSW	/YES-SET UNDEFINED SWITCH
	TAD PASS	/IS THIS PASS 1?
	SPA CLA
	JMP ALPHA0	/YES-SUPPRESS ERROR MAESSAGE
	JMS I [ERROR	/NO-GENERATE US ERROR MESSAGE
	US
ALPHA0,	TAD TAG2	/NO-WAS IT A MEMORY REFERENCE INSTRUCTION?
	SPA CLA
	TAD CHAR	/YES-GET TERMINATING CHARACTER
	TAD [-240	/WAS IT SPACE?
	SZA CLA
	JMP I (NUMBE5	/NOT MEMREF FOLLOWED BY SPACE
	JMS I [SPNOR	/YES-IGNORE SPACES
	TAD CHAR
	SPA CLA
	JMP I (NUMBE5
	TAD EXPIND	/IS MEMORY REFERENCE INSTRUCTION OK?
	SZA CLA
	JMP I (NUMBE5	/NO-
	DCA IZIND	/YES-CLEAR I AND Z INDICATOR
	TAD VALUE2	/STORE MRI ON PUSHDOWN LIST
	JMS I [PUSHA
ALPHA6,	TAD IZIND
	JMS I [PUSHA	/PUSH THE I AND Z INDICATOR
	JMS I [TSTALP	/WAS TERMINATING CHARACTER ALPHABETIC?
	SKP
	JMP ALPHA4	/NO-
	JMS I [GETTAG	/YES-PICK UP TAG
	DCA ALPHAI	/STORE UNDEFINED INDICATOR
	AC2000
	AND TAG1	/WAS IT AN I OR Z?
	SNA CLA
	JMP ALPHA5	/NO
	TAD VALUE2	/YES-WAS IT I?
	SNA
	IAC		/NO - SET LOW ORDER
	TAD I	PDLXR	/GET OLD IZIND FROM PDL
	DCA IZIND	/SET NEW IZIND
	JMS I [SPNOR	/IGNORE SPACES
	JMP ALPHA6

EXPINT,	TAD EXPIND
	TAD [4000
	DCA EXPIND
	JMP ALPHA3

ALPHA5,	AC4000
ALPHA4,	IAC
	JMS I [EXP	/GET REST OF EXPRESSION
	TAD I PDLXR	/RETRIEVE MRI
	DCA IZIND
	TAD I PDLXR
	DCA VALUE2
			/FALL INTO NEXT PAGE
/COMBINE ADDRESS WITH MEMORY REFERENCE INSTRUCTION

	TAD VALUE	/GET ADDRESS
	AND [7600
	SNA		/IS IT PAGE 0?
	JMP FIX4	/YES
	CIA		/NO-IS IT ON CURRENT PAGE?
	TAD LOC
	AND [7600
	SNA CLA
	JMP FIX2	/YES
	TAD VALUE	/NO-SET UP LINK
	JMS I (FINDS
	DCA VALUE
	TAD FIXMD0	/SET ' IN LISTING
	DCA LININD
	ISZ LINK	/BUMP NUMBER OF LINKS GENERATED
FIXMD0,	0700		/PROTECTION FOR ISZ
LGERR,	SKP		/JMS I PERROR IF /E SPECIFIED
	LG
	JMS ADDIND	/SET INDIRECT BIT IN INSTRUCTION
FIX2,	TAD [200	/SET CURRENT PAGE BIT
	TAD VALUE2
	DCA VALUE2
	TAD IZIND
	AND [77		/WAS Z SPECIFIED?
	SNA CLA
	JMP FIX4	/NO
	JMS I [ERROR	/YES - ILLEGAL REFERENCE
	IZ		/TO PAGE 0
FIX4,	TAD IZIND	/WAS THERE AN I?
	AND [7700
	SZA CLA
	JMS ADDIND	/YES - ADD INDIRECT BIT TO INSTRUCTION
	TAD VALUE	/GET ADDRESS
	AND [177
	TAD VALUE2	/GET OP CODE
	DCA VALUE	/STORE
POPJ,	TAD I PDLXR
	DCA TEMP	/POP A WORD OFF THE STACK
	JMP I TEMP	/JUMP THROUGH IT.
ADDIND,	0		/ROUTINE TO ADD INDIRECT BIT TO AN INSTR
	TAD VALUE2
	CMA
	AND [400
	SZA		/WAS THERE ONE ALREADY?
	JMP .+3	/NO
	JMS I [ERROR	/YES - ILLEGAL INDIRECT
	II
	TAD VALUE2
	DCA VALUE2
	JMP I ADDIND

/	ALLOWS MULTIPLE NON-RESIDENT INPUT HANDLERS TO NOT BOMB

PTCH,	0		/RUNS IN DF 10
	TAD (7647	/POINT TO DEVICE
	DCA PTR		/HANDLER RESIDENCY TABLE
	TAD [-17	/IT HAS 15 ENTRIES
	DCA KNTR	/V3C
KLOOP,	TAD I PTR	/GET HANDLER ENTRY POINT
	AND [7600	/LOOK AT PAGE IT'S ON
	TAD [-INDEVH	/IS IT ON THE PAGE WE PUT BUFFER OVER?
	SNA CLA		/WELL?
	DCA I PTR	/YES IT IS, WIPE IT FROM RESIDENCY
	ISZ PTR		/LOOK AT NEXT ENTRY
	ISZ KNTR	/ANY MORE ENTRIES?
	JMP KLOOP	/YES, MIGHT HAVE TO WIPE SEVERAL GUYS
	TAD [200	/INCREASE INPUT BUFFER SIZE
	JMP I PTCH	/V3C
	PAGE
/COMBINE CURRENT VALUE WITH PREVIOUS VALUE
/ACCORDING TO LAST OPERATOR

OP0,	TAD VALUE2	/HANDLER FOR +
	TAD VALUE	/** OP0+1 AND OP0+2 JUMPED TO **
	DCA VALUE
EXP3,	TAD CHAR	/GET LAST OPERATOR
	TAD (-"+	/WAS IT A + OR - ?
	CLL RTR
	SNA
	JMP PLSMIN	/YES - LINK=0 FOR +, 1 FOR -
	RTL
	TAD ("+-"%
	CLL RAR
	SNA		/IS THE CHAR % OR &?
	JMP DIVAND	/YES - LINK=0 FOR %, 1 FOR &
	RAL
	TAD ("%-240
	CLL RAR
	SNA		/IS THE CHAR SPACE OR !?
	JMP BLKEXP	/YES - LINK=0 FOR SPACE, 1 FOR !
	RAL
	TAD (240-"^
	SNA CLA		/IS THE CHAR ^?
	JMP MUL		/YES - LINK IRRELEVANT
	JMS I (ENDCHK	/NO-SEE IF END OF LINE FOUND
	JMP EXP3	/NO-TRY AGAIN
EXPXIT,	TAD UNDFSW	/EXIT FROM EXP
	SNA CLA		/RESTORE EXIT POINT
	JMP I (POPJ	/--EXIT VIA POPJ--
	CLA CMA
	DCA UNDFSW	/SET UNDEFINED SWITCH
	DCA VALUE	/RESULT IS 0
	JMP I (POPJ	/--EXIT VIA POPJ--
MUL,	CLL IAC		/LINK DOESN'T COUNT FOR ^
BLKEXP,	IAC		/** BLANK ASSUMED TO BE 4 ELSEWHERE **
DIVAND,	IAC
PLSMIN,	RAL
	JMP I (EXP1	/GET REST OF EXPRESSION

/HANDLER FOR &

OP2,	TAD VALUE
	AND VALUE2
	JMP OP0+2


/HANDLER FOR ^
/MULTIPLY BY REPEATED ADDITION

OP4,	TAD VALUE
	CIA
	DCA TEMP
	TAD VALUE2
	ISZ TEMP
	JMP .-2
	JMP OP0+2

OP1,	TAD VALUE2	/- OPERATOR
	CIA
	JMP I (OP0+1	/JUMP INTO ADD OPERATOR

/OPTIONAL HANDLER FOR ! AS 6 BIT LEFT SHIFT AND THEN OR:

OP3,	TAD VALUE
	JMS I [RTL6
	AND [7700	/ISOLATE 6 BITS AND FALL INTO "OR"
	DCA VALUE	/V3C

/HANDLER FOR ! AND SPACE AS INCLUSIVE OR

OP5,	TAD VALUE
	CMA
	AND VALUE2
	JMP I (OP0+1
/CHARACTER INPUT CHECK
/ENTER WITH CHARACTER IN AC

LSTCH9,	SZA		/IGNORE NULL (0)
	TAD (-177
	SZA		/IGNORE RUBOUT (377)
	TAD (177-13
	SZA		/IGNORE VERTICAL TAB (213)
	IAC
	SNA
	JMP I (INPUT+1	/IGNORE LINE FEED (212)
	TAD [12-32	/WAS IT ^Z (END-OF-FILE=232)?
	SNA
	JMP I (ENDCHR	/YES - GET NEXT FILE
	TAD (32-15	/NO - WAS IT CARRIAGE RETURN?
	SNA
	JMP LSTCHR	/YES - LAST CHARACTER OF LINE
	IAC		/NO
	SNA		/WAS IT FORM FEED (214)?
	JMP FORCHR	/YES - HANDLER FORM FEED
	ISZ I (INPUT
	TAD (14+200
	DCA LSTCH5	/STORE CHARACTER
	TAD PASS	/IS THIS PASS 3?
	SPA SNA CLA
	JMP LSTCH4	/NO -
	ISZ LSTCH6	/YES - FILLING HEADER AREA?
	JMP LSTCH3	/YES
	CLA CMA		/NO - RESET SWITCH
	DCA LSTCH6
LSTCH4,	TAD I (INPUT
	DCA TEMP
	TAD LSTCH5	/GET CHARACTER IN AC
	JMP I TEMP	/-EXIT FROM INPUT-

LSTCH3,	ISZ LSTCH7	/FILLING HEADER
	TAD LSTCH5	/STORE CHARACTER IN HEADER AREA
	DCA I LSTCH7
	JMP LSTCH4

LSTCH5,	0
LSTCH6,	-HEDLEN
LSTCH7,	HEADER-1
LSTCHR,	TAD FORMSW	/CARRIAGE RETURN WAS FOUND
	SNA CLA		/HAS THERE BEEN A FORM FEED?
	JMP LSTCH1	/NO -
	DCA FORMSW	/YES - CLEAR FORM FEED SWITCH
	ISZ EDITPG	/GO TO NEXT EDITOR PAGE
	DCA THISPG	/CLEAR OVERFLOW PAGE
	TAD PASS	/IS THIS PASS 3?
	SMA SZA CLA
	JMS I [FORMFD	/YES - GENERATE FORM FEED
LSTCH1,	TAD [215	/NO - CARRIAGE RETURN IS CHARACTER
	DCA LSTCH5
	JMP LSTCH4-2	/EXIT

FORCHR,	ISZ FORMSW	/SET FORM FEED SWITCH
	JMP I (INPUT+1	/GET ANOTHER CHARACTER

FORMSW,	1
	PAGE
/ERROR MESSAGE OUTPUT

DUMPS1,
ERROR,	0
	CLA
	ISZ ERCNT	/COUNT THE ERRORS
ERPLUS,	"+		/PROTECTION
	TAD I ERROR	/GET ERROR MESSAGE
	ISZ ERROR	/INCREMENT RETURN ADDRESS
	JMS I [ERROR1	/OUTPUT 2 CHARACTER ERROR MESSAGE
	TAD (JMP I [7600 /PUT EXIT TO MONITOR
CSWIT1,	DCA I (LSWITC	/IN SWITCH - "CLA" IF /C
	TAD PASS	/IS THIS PASS 3?
	SMA SZA CLA
	JMP ERROR4	/YES - CARRIAGE RETURN/LINE FEED
	JMS I [ERROR1	/NO - OUTPUT 2 SPACES
	TAD [1777	/IS THERE A TAG SAVED?
	AND LAST1
	SNA
	JMP ERROR3	/NO
	JMS I (DIV45	/YES - OUTPUT FIRST 2 CHARACTERS
	TAD LAST2	/OUTPUT SECOND 2 CHARACTERS
	JMS I (DIV45
	TAD LAST3
	JMS I (DIV45	/OUTPUT THIRD 2 CHARACTERS
	TAD LAST4	/IS ERROR LOCATION SAME AS LAST TAG?
	CIA
	TAD LOC
	SNA CLA
	JMP ERROR4	/YES - CARRIAGE RETURN
	TAD ERPLUS
	JMS I OERROR
	TAD LAST4
	CIA
ERROR3,	TAD LOC		/OUTPUT 4 DIGIT ADDRESS OR INCREMENT
	JMS I (OCTPRT
ERROR4,	TAD [215	/OUTPUT CARRIAGE RETURN/LINE FEED
	JMS I OERROR
	JMP I ERROR	/--RETURN--
/RESET LITERAL TABLES AND POINTERS

DUMPS5,
CLEAN,	0
	TAD (LITBUF-1
	DCA XREG1	/SET LITERAL TABLE POINTER
	TAD (TPINST-1
	DCA XREG2	/SET TOP INST. TABLE POINTER
	TAD (-40
	DCA TEMP
	TAD [200
	DCA I XREG1	/SET LITERAL TABLE ENTRIES TO 200
	DCA I XREG2	/SET TOP INST. TABLE ENTRIES TO 0
	ISZ TEMP
	JMP .-4
	DCA LAST1	/CLEAR LAST DEFINED TAG
	JMP I CLEAN	/--RETURN--

/DUMP CURRENT PAGE LITERALS

DUMPS,	0
	JMS I [FINDSP
	SNA		/IF THIS IS PAGE 0,
	JMP I DUMPS	/--RETURN--
	TAD [LITBUF
	DCA DUMPS1
	TAD LITPTR
	CIA CLL
	TAD I DUMPS1
	DCA DUMPS2	/STORE NUMBER OF LITERALS ON THIS PAGE
	SZL		/ARE THERE ANY?
	JMP D2		/V3C
	DCA STARSW	/FORCE ORIGIN PUNCH IF RELOC JUST INVOKED
	TAD LOC
	AND [7600
	TAD I DUMPS1
	JMS I [PUNORG	/OUTPUT ORIGIN
	TAD I DUMPS1
	TAD (LITBF1
DUMPS3,	DCA DUMPS5
	TAD I [LINBUF	/SAVE LINBUF
	JMS I [PUSHA
	DCA I [LINBUF
DUMPS6,	TAD I DUMPS5
	DCA VALUE
JMSPUN,	JMS I [PUNONE	/OUTPUT ONE REGISTER
	ISZ LOC
	ISZ DUMPS5
LITHAK,	ISZ I DUMPS1	/DESTROY RECORD OF CURRENT PAGE LITERALS -
			/ZEROED IF NO /W OPTION SPECIFIED
	ISZ DUMPS2
	JMP DUMPS6
	TAD I PDLXR
	DCA I [LINBUF	/RESTORE LINBUF
D2,	TAD DUMPS1	/WIPE REMEMBRANCE OF TOP OF PAGE (JR)
	TAD (40		/V3C
	DCA DUMPS5
D3,	DCA I DUMPS5
	JMP I DUMPS	/--RETURN--
/HANDLER FOR ZBLOCK PSEUDO-OP
/RESERVES AS MANY WORDS OF ZERO
/AS VALUE OF EXPRESSION

ZBLOCX,	JMS I [SPNOR	/IGNORE SPACES
	JMS I [EXP	/GET THE EXPRESSION
	TAD VALUE
	CMA		/PROTECT AGAINST ZERO CASE
	DCA TEMP3	/STORE NEGATIVE AS COUNTER
	JMP ZBLOCZ	/JUMP INTO LOOP
ZBLOCY,	JMS I [PUNBIN	/OUTPUT ONE WORD OF ZERO
	TAD PASS	/IS THIS PASS 3?
	SMA SZA CLA
	DCA I (PUNMOD	/YES - PREVENT OUTPUT
ZBLOCZ,	ISZ TEMP3	/NO - DONE YET?
	JMP ZBLOCY	/NO - CONTINUE
	TAD JMSPUN	/YES - RESTORE PUNMOD
	DCA I (PUNMOD
	JMP I [LOOKEX	/--EXIT TO MAIN--

/DUMP PAGE 0 LITERALS

DUMPS2,
DUMPZ,	0
	TAD DUMPZ	/RESET EXIT FROM DUMPS
	DCA DUMPS
	TAD [200
	CIA CLL
	TAD I [LITBUF	/STORE THE NUMBER OF LITERALS ON PAGE 0
	DCA DUMPS2
	SZL		/ARE THERE ANY?
	JMP I DUMPS	/NO - ** DUMPZ IS DESTROYED **
	TAD I [LITBUF
	JMS I [PUNORG	/OUTPUT ORIGIN
	TAD I [LITBUF	/SET VALUES FOR DUMPS
	TAD (LITBF2
	JMP DUMPS3
	PAGE
/ENTER A TAG INTO SYMBOL TABLE

	IFZERO	HASH<
INSRTG,	0
	TAD VALUE2	/SAVE VALUE 2
	JMS I [PUSHA
	ISZ HIGHTG	/COUNT IN THIS TAG
	TAD TAGMAX
	CLL CIA		/GET LIMIT OF SYMBOL STORAGE
	TAD HIGHTG	/IS THERE ROOM FOR ONE MORE?
	SZL
	JMP I (SYMOFL	/NO - SE**FATAL ERROR**
	TAD TAGMAX	/YES - IS USR IN CORE?
	TAD (-1340
	SZL CLA
	JMP GETTG5	/YES
	TAD [7700	/NO - RESET ADDRESS TO
	DCA IOMON	/USR NON-RESIDENT
	AC7776
	AND I (JSBITS	/RESET JOB STATUS WORD TO
	DCA I (JSBITS	/SAVE CORE WHEN USR CALLED
GETTG5,	TAD THISTG	/SEARCH SYMBOL TABLE
	DCA TEMP2
	TAD HIGHTG
	IAC
	DCA THISTG
GETTG8,	AC7776
	TAD THISTG
	DCA THISTG
	JMS I [FINDTG	/GET NEXT TAG FROM SYMBOL TABLE
	ISZ THISTG
	TAD THISTG
	CIA
	TAD TEMP2	/DOES NEW TAG GO WHERE PREVIOUS TAG WAS?
	SNA CLA
	JMP GETTG9	/YES-PUT IT THERE AND EXIT
	JMS I [PUTTAG	/NO-REPLACE RETRIEVED TAG WHERE PREVIOUS TAG WAS
	JMP GETTG8

/THE ABOVE CODE WILL BE OPTIMIZED AT INITIALIZATION
/IF THE ASSEMBLER IS TO BE RESTRICTED TO 8K OF CORE

GETTG9,	TAD I (NAME1	/GET CURRENT TAG
	DCA TAG1	/PUT IT IN TAG1-TAG3
	TAD I (NAME2
	DCA TAG2
	TAD I (NAME3
	DCA TAG3
	TAD I PDLXR	/RESTORE VALUE 2
	DCA VALUE2
	JMS I [PUTTAG	/PUT TAG1 - TAG3 INTO SYMBOL TABLE
	JMP I INSRTG	/--RETURN--

TAGMAX,	1740		/12K=3740, ...
	>

/	IFNZRO	HASH<	/***HACK ONLY***
/TLYREF,	0		/TALLY REFS TO SYMBOL TABLE
/	ISZ	NREFL
/	JMP I	TLYREF
/	ISZ	NREFH
/	JMP I	TLYREF
/	JMP I	TLYREF
/TLYPRB,	0		/TALLY PROBES INTO TABLE
/	JMS I	[FINDTG	/FUDGE, OUT OF ROOM
/	ISZ	NPROBL
/	JMP I	TLYPRB
/	ISZ	NPROBH
/	JMP I	TLYPRB
/	JMP I	TLYPRB
/NREFH,	0
/NREFL,	0
/NPROBH,	0
/NPROBL,	0
/	>		/***HACK ONLY***
	IFNZRO	HASH<

	/INSERT A TAG INTO THE HASH TABLE

INSRTG,	0
	ISZ	HIGHTG	/BUMP SYM NUM (SKIPS ON 0)
	TAD	HIGHTG
	STL CMA
	TAD	TAGMAX
	SNA SZL CLA	/STILL ROOM FOR AT LEAST 2 MORE?
	JMP I	(SYMOFL	/NO SE** FATAL ERROR**
	TAD I	(NAME1
	DCA	TAG1
	TAD I	(NAME2
	DCA	TAG2
	TAD I	(NAME3
	DCA	TAG3
	JMS I	[PUTTAG	/NOW ACTUALLY INSERT IT
	JMP I	INSRTG
	>
/OUTPUT 2 CHARACTER WORD
/FROM SYMBOL TABLE FORMAT
/DIVIDE BY 45(8)

DIV45,	0
	RAL
	CLL RAR		/CLEAR SIGN BIT
DIV45A,	ISZ DIV45C
	TAD (-45
	SMA
	JMP DIV45A
	TAD (45
	JMS DIV45E
	DCA DIV45B
	STA
	TAD DIV45C
	JMS DIV45E
	JMS I [RTL6
	TAD DIV45B
	JMS I [ERROR1	/OUTPUT 2 CHARACTERS
	DCA DIV45C	/CLEAR DIV45C FOR NEXT GO-ROUND
	JMP I DIV45	/--RETURN--

DIV45B,	0
DIV45C,	0		/** MUST BE 0 WHEN DIV45 IS ENTERED **

DIV45E,	0
	SNA
	JMP I DIV45E
	TAD (-33
	SMA
	TAD (20-40-33
	TAD (33+40
	JMP I DIV45E	/--RETURN--
/HANDLER FOR FIXTAB PSEUDO-OP

FIXTBX,	TAD PASS	/IS THIS PASS 1?
	SMA CLA
	JMP I [LOOKEX	/NO--EXIT TO MAIN--
	JMP I (FIXTAY	/YES--DO FIXTAB

/SET FIELD

SETFLD,	0
	CLA CLL		/SETFLD CALLED WITH AC RANDOM
	DCA SETFL1	/INITIALIZE FIELD
	IFNZRO	HASH<
	TAD	USROFS	/FUDGE FOR KEEPING USR AROUND
	>
	TAD THISTG
SETFLP,	ISZ SETFL1
	CML
	TAD (-1740	/PUT 1740 SYMBOLS IN EACH FIELD
	SNL		/IS THE DIVIDE THROUGH?
	JMP SETFLP	/NO - CONTINUE
	IFZERO	HASH<
	CLL CMA RTL	/AC CONTAINED REM-1740; THIS MAKES IT INTO
	TAD (-1		/7573-4*REM WHICH IS THE ADDRESS WE WANT
	>
	IFNZRO	HASH<
	CLL RTL		/AC GETS 0201 TO 7775
	TAD	(-202	/AC GETS 7777 TO 7573 FOR TAGXR
	>
	DCA TAGXR	/TO STICK INTO AN AUTO-XR
	TAD SETFL1
	CLL RTL
	RAL
	TAD SETFL2
	DCA SETFL1
SETFL1,	HLT
	JMP I SETFLD	/--RETURN--
	IFNZRO	HASH<
USROFS,	0		/GETS 400 IF KEEPING USR
	>
/FIND TAG
/GET TAG FROM SYMBOL TABLE
/PUT IT INTO TAG1-TAG3
/WITH ITS VALUE IN VALUE2

FINDTG,	0
	TAD THISTG
	JMS SETFLD
	TAD I TAGXR
	DCA TAG1
	TAD I TAGXR
	DCA TAG2
	TAD I TAGXR
	DCA TAG3
	TAD I TAGXR
	DCA VALUE2
SETFL2,	CDF
	JMP I FINDTG	/--RETURN--

/OPTIMIZATION MAY CHANGE SETFLD TO
/REMOVE CLA ON ENTRY
	PAGE
/BEGINNING OF PASS CODE

	JMS I (IOPEN	/SET INPUT ROUTINE TO OPEN FILE
START2,	ISZ PASS	/SET UP COUNTERS AND POINTERS
	DCA XLISTX	/CLEAR XLIST SWITCH
	DCA FLDIND	/SET FIELD TO 0
	DCA VALUEX	/SET BANK TO ZERO(128K)
	DCA CONDSW
	DCA EDITPG
	DCA LINK
	DCA RADIX
	DCA ERCNT
	DCA GETCI
	DCA PUNCHX
	DCA I [LINBUF
	TAD (PDLST
	DCA PDLXR
	JMS I [CLEAN
	TAD [200
	DCA LITPTR
	TAD [200
	JMS I [PUNORG
	JMP I (LOOKE1	/--EXIT TO MAIN--

/HANDLER FOR $

ENDPAS,	JMS I [DUMPS	/DUMP CURRENT PAGE LITERALS
	DCA OFSBUF	/CLEAR OFFSET FOR NEXT PASS
	TAD PASS	/WHAT PASS IS ENDING?
	SNA
	JMP I (ENDPA2	/PASS 2
	SPA CLA
	JMP I (START1	/PASS 1
	TAD I [LINBUF	/PASS 3
	SNA CLA		/ANYTHING TO PRINT?
	JMP ENDPA1-1	/NO
	TAD [211	/YES - TAB OVER TWICE
	JMS I OERROR
	TAD [211
	JMS I OERROR
	JMS I [LINPRT	/PRINT LINE
	JMS I [DUMPZ	/DUMP PAGE 0 LITERALS
ENDPA1,	DCA XLISTX
/OUTPUT SYMBOL TABLE
SSWITC,	JMS I (SYMPRT	/(0 IF /S)
	TAD I (FORM21
	DCA I (FORM22
	JMS I [FORMFD	/OUTPUT FORM FEED
ERMSGS,	TAD ERCNT
	JMS OUTTTL	/PRINT "ERRORS DETECTED: N"
	TAD LINK
	JMS OUTTTL	/PRINT "LINKS GENERATED: N"
FINLFF,	JMS I [FORMFD	/PRINT FINAL FF (ZEROED IF NO PASS 3)
	JMS I (OCLOSE	/AND CLOSE THE OUTPUT FILE
/CREF AND LOAD-AND-GO OPTIONS
/****FINAL EXIT TO MONITOR****
LSWITC,	JMP I [7605	/0 IF /L OR /G OR /C
	TAD (7616
	DCA XREG1
	CDF 10
CSWITC,	TAD I [7600	/"TAD I [7605" IF /C
	AND [17
	DCA I XREG1	/SET BINARY DEVICE
	TAD BINSRT

/EXIT FROM PAL8 BY CHAINING
/TO NEXT PROGRAM
/SHOULD BE ABSLDR OR CREF

	DCA I XREG1	/SET STARTING BLOCK
	DCA I XREG1	/SET 0 TERMINATOR
	CDF
	TAD I (JSBITS	/SET BIT 11 OF JOB STATUS WORD
	RAR		/SO 10000-11777 IS NOT SAVED
	CLL CML RAL
	DCA I (JSBITS
	CIF 10
	JMS I IOMON	/CALL USER SERVICE ROUTINES
	6		/*CHAIN TO NEXT PROGRAM*
CHAIN,	0		/STARTING BLOCK OF NEXT PROGRAM

OUTTTL,	0
	DCA LAST1	/SAVE NUMBER TO BE PRINTED
OUTTLL,	TAD I TTLPTR	/GET A WORD OF MESSAGE
	ISZ TTLPTR
	SNA		/END?
	JMP PRTTTL	/YES
	JMS I [ERROR1	/NO - PRINT IT
	JMP OUTTLL	/AND LOOP
PRTTTL,	TAD [240	/PRINT A SPACE
	JMS I OCHAR
	TAD LAST1
	JMS I (FORMF4	/PRINT NUMBER IN DECIMAL
	JMS I (CRLF	/PRINT CR AND 2 LF'S (1 IF PASS 3)
	JMP I OUTTTL	/AND RETURN

TTLPTR,	TTLMSG
/COME HERE TO LOAD THE PASS 3 OVERLAY AT THE END OF PASS 2

LOADOV,	JMS I (7607	/CALL SYSTEM DEVICE HANDLER
	0200		/SWAP IN CODE UNIQUE TO PASS 3
	SWAP1		/BUFFER ADDRESS
	ASWAP		/STARTING BLOCK NUMBER
	JMP I (SYSER3	/DE**FATAL ERROR**
NSWITC,	JMP START2	/(0 IF NO LIST FILE, SKP IF /N) START PASS3
	JMP ERMSG1
	JMP ENDPA1

ERMSG1,	TAD (OTYPEO	/COME HERE IF NO PASS 3 OUTPUT FILE
	DCA OCHAR
	TAD (OTYPEO
	DCA OERROR
	TAD [7600
	DCA I (OTYPCR	/INHIBIT AUTO-LF ON CARRIAGE RETURN
	DCA FINLFF	/KILL LAST FORM FEED
	JMP ERMSGS

/ADD BITS TO PUNCH ORIGIN

PUNORG,	0
	DCA LOC
	TAD PASS	/IS THIS PASS 2?
	SZA CLA
	JMP I PUNORG	/NO--RETURN--
	TAD LOC		/YES - OUTPUT ORIGIN SETTING
	TAD OFFSET	/"LOC" MAY BE FICTITIOUS - MAKE IT REAL
	CLL CML
	ISZ STARSW	/INHIBIT PUNCHING ORIGIN IF NECESSARY
	JMS I [PUNOUT
	CLA
	DCA STARSW	/RESET SWITCH
	JMP I PUNORG	/--RETURN--
	PAGE
/EVALUATE LITERAL

LIT,	STA RAL		/-2 IF PAGE 0 LITERAL, -1 IF CUR PAGE
	DCA FINDS1	/SAVE FLAG
	JMS I [GETC	/GET NEXT CHARACTER
	JMS I [SPNOR	/IGNORE SPACES
	TAD EXPIND	/STORE IMPORTANT VALUES PRIOR TO
	JMS I [PUSHA	/ENTRANCE INTO EXP
	TAD OP
	JMS I [PUSHA
	TAD VALUE
	JMS I [PUSHA
	TAD FINDS1
	JMS I [PUSHA
	JMS I [EXP	/GET EXPRESSION
	TAD VALUE	/FIND LITERAL IN TABLE
	ISZ I PDLXR	/PAGE 0?
	JMP .+3
	JMS FINDS	/NO
	SKP
	JMS FIND0	/YES
	DCA VALUE2	/STORE ADDRESS
	TAD I PDLXR
	DCA VALUE
	TAD I PDLXR	/RESTORE SAVED VALUES
	DCA OP
	TAD I PDLXR
	DCA EXPIND
	TAD CHAR	/IGNORE ) OR ]
	TAD (-")
	SZA
	TAD (")-"]
	SNA CLA
	JMS I [GETC	/GET NEXT CHARACTER
	JMP I (NUMBE5	/RETURN TO EXPRESSION PROCESSOR


PEZE,	0		/SUBR TO ISSUE PE OR ZE MESSAGE
	SNA CLA		/WHICH ONE?
	JMP .+4	/PAGE 0
	JMS I PERROR
	PE
	JMP I PEZE
	JMS I PERROR
	ZE
	JMP I PEZE
/FIND LITERAL ON CURRENT PAGE

FINDS,	0
	DCA FINDS1
	TAD LOC
	AND [7600
	SNA		/IS THIS PAGE 0?
	JMP FIND01	/YES
	DCA FINDS2	/NO - SAVE PAGE NUMBER
	TAD (LITBF1
	DCA FIND0
	TAD [7700	/ALLOW 100(8) CURRENT PAGE LITERALS
	DCA FORMF6
	TAD LITPTR	/GET PG ADDR OF 1ST LITERAL IN BUFFER
FIND02,	DCA FINDS3
	TAD FINDS2
	JMS I [RTL6
	TAD [LITBUF
	DCA TEMP
	TAD FIND0	/COMPUTE ACTUAL CORE ADDRESS OF LITERAL
	TAD I TEMP
	DCA TEMP2
	TAD FINDS3	/COMPUTE THE NUMBER OF ENTRIES
	CIA
	TAD I TEMP	/IN THE LITERAL BUFFER
	SNA
	JMP FINDS6	/NONE
	DCA FINDS3
FINDS4,	TAD I TEMP2	/GET LITERAL FROM TABLE
	CIA
	TAD FINDS1	/AND CURRENT LITERAL
	SNA CLA		/DO THEY MATCH?
	JMP FINDS5	/YES
	ISZ TEMP2	/NO - BUMP COUNTERS
	ISZ FINDS3
	JMP FINDS4	/TRY AGAIN
FINDS6,	TAD FINDS2
	JMS I [RTL6
	TAD [TPINST
	DCA FINDS3
	TAD I TEMP	/DOES THIS OVERFLOW PAGE?
	CIA
	TAD I FINDS3
	SPA CLA
	JMP FINDS7	/NO

FIND03,	TAD FINDS2	/PAGE FULL - WHICH PAGE?
	JMS PEZE	/GENERATE PE OR ZE MESSAGE
	CLA CMA
	JMP FINDS9
FINDS7,	CLA CMA
	TAD I TEMP	/IS PAGE FULL?
	AND FORMF6
	SNA CLA
	JMP FIND03	/YES - OUTPUT ERROR MESSAGE
	CLA CMA
	TAD I TEMP	/NO
	DCA I TEMP
FINDS9,	TAD I TEMP
	TAD FIND0
	DCA TEMP2
	TAD FINDS1
	DCA I TEMP2
FINDS5,	TAD FIND0	/GET ADDRESS OF LITERAL
	CIA
	TAD TEMP2
	TAD FINDS2
	JMP I FINDS	/--RETURN--


/FIND LITERAL ON PAGE 0

FIND0,	0
	DCA FINDS1
	TAD FIND0	/RESET EXIT FROM FINDS
	DCA FINDS
FIND01,	DCA FINDS2	/SET POINTERS
	TAD (LITBF2
	DCA FIND0
	TAD [7760	/ALLOW 160(8) PAGE 0 LITERALS
	DCA FORMF6
	TAD [200
	JMP FIND02

FINDS1,	0
FINDS2,	0
FINDS3,	0
	PAGE
/HANDLER FOR IFZERO PSEUDO-OP

IF0,	TAD (10		/IFTST1, SNA CLA

/HANDLER FOR IFNZERO PSEUDO-OP

IFN0,	TAD IFSZA	/IFTST1, SZA CLA
	DCA IFTST1
	JMS I [SPNOR	/IGNORE SPACES
	JMS I [EXP	/GET EXPRESSION
IFTST3,	TAD CHAR	/GET LAST CHARACTER
	TAD (-"<
	SNA CLA		/IS IT <?
	JMP IFTST2	/YES
	JMS ICMESG	/PRINT IC MESSAGE AND GET NEXT CHAR
IFTST9,	JMS I [SPNOR	/IGNORE SPACES
	JMP IFTST3	/TRY AGAIN

IFTST2,	JMS I [GETC	/GET NEXT CHARACTER
	TAD CONDSW
	CIA
	DCA CONDTM	/SET NUMBER OF NESTED CONDITIONALS
	CLA CMA		/DECREMENT NUMBER OF NESTED CONDITIONALS
	TAD CONDSW
	DCA CONDSW
	TAD VALUE
IFTST1,	HLT		/SZA CLA OR SNA CLA
	JMP I (MAIN	/--EXIT TO MAIN--
IFTST5,	TAD CONDSW	/DONE WITH ALL CONDITIONALS IN NEST?
	TAD CONDTM
	SMA CLA
	JMP I (MAIN	/YES --EXIT TO MAIN--
	TAD CHAR
	TAD (-"<	/NO - GET NEXT CHARACTER
	SNA		/IS IT <?
	JMP IFTST6	/YES - HANDLE NEXT CONDITIONAL
	TAD ("<-">	/NO - IS IT >?
IFSZA,	SZA CLA
	JMP IFTST4	/NO - FINISH THIS CONDITIONAL
	AC7776
IFTST6,	CMA
	TAD CONDSW
	DCA CONDSW
IFTST4,	DCA I [LINBUF	/INHIBIT LISTING OF UNASSEMBLED CODE -
			/ZEROED IF /J OPTION NOT SPECIFIED
	JMS I [GETC	/GET NEXT CHARACTER
	JMP IFTST5
/HANDLER FOR IFDEF PSEUDO-OP

IFD,	TAD (10		/IFTST1, SNA CLA

/HANDLER FOR IFNDEF PSEUDO-OP

IFND,	TAD IFSZA	/IFTST1, SZA CLA
	DCA IFTST1
IFTST7,	JMS I [SPNOR	/IGNORE SPACES
	JMS I [TSTALP	/IS NEXT CHARACTER ALPHABETIC
	JMP IFTST8	/YES
	JMS ICMESG	/PRINT IC MESSAGE AND GET NEXT CHAR
	JMP IFTST7	/KEEP TRYING

IFTST8,	JMS I [GETTAG	/PICK UP TAG
	DCA VALUE	/STORE UNDEFINED INDICATOR
	TAD TAG3	/WAS IT A PSEUDO-OP?
	SMA CLA
	JMP IFTST9	/NO
	JMS I [ERROR	/YES - GENERATE IP ERROR MESSAGE
	IP
	JMP IFTST9

ICMESG,	0
	JMS I	[ERROR
	IC		/IC COMES OUT ON ALL PASSES
	TAD CHAR
	SPA CLA
	JMP I [LOOKEX	/END OF LINE - GO AWAY
	JMS I [GETC	/GET NEXT CHAR
	JMP I ICMESG
CONDTM,

/PUT TAG IN SYMBOL TABLE

PUTTAG,	0
	TAD THISTG
	JMS I (SETFLD	/SET FIELD
	TAD TAG1
	DCA I TAGXR
	TAD TAG2
	DCA I TAGXR
	TAD TAG3
	DCA I TAGXR
	TAD VALUE2
	DCA I TAGXR
	CDF
	JMP I PUTTAG	/--RETURN--


/PUSHDOWN ROUTINE
/PUT NEW ENTRY ON PUSHDOWN STACK

PUSHA,	0
	DCA TEMP
	CLA CMA
	TAD PDLXR
	DCA PDLXR
	TAD PDLXR
	TAD (-PDLND
	SPA CLA		/IS LIST TOO FULL?
	JMP PUSHA1	/BE**FATAL ERROR**
	TAD TEMP	/NO - MAKE ENTRY
	DCA I PDLXR
	CLA CMA
	TAD PDLXR
	DCA PDLXR
	JMP I PUSHA	/--RETURN--

PUSHA1,	TAD (BE
	JMP I [MONERR	/PUSHDOWN OVERFLOW IS FATAL ERROR
/TEST NUMERIC ROUTINE
/CALL WITH CHARACTER TO TEST IN "CHAR"
/SKIPS IF THE CHARACTER IS NOT NUMERIC

TSTNUM,	0
	TAD CHAR	/GET THE CHARACTER
	TAD (-"9-1
	CLL
	TAD ("9-"0+1
	SNL CLA		/CHECK FOR RANGE 0-9
	ISZ TSTNUM	/OUT OF RANGE
	JMP I TSTNUM	/--RETURN--

/TEST ALPHANUMERIC ROUTINE
/CALL WITH CHARACTER IN "CHAR"
/SKIPS IF CHARACTER IS NOT ALPHANUMERIC

TSTALN,	0
	JMS I [TSTNUM	/IS IT NUMERIC
	JMP I TSTALN	/YES--RETURN--
	JMS I [TSTALP	/IS IT ALPHABETIC
	JMP I TSTALN	/YES--RETURN--
	ISZ TSTALN	/NEITHER
	JMP I TSTALN	/--RETURN--

/TEST ALPHABETIC ROUTINE
/CALL WITH CHARACTER IN "CHAR"
/SKIPS IF NOT ALPHABETIC

TSTALP,	0
	TAD CHAR
	TAD (-"Z-1
	CLL
	TAD ("Z-"A+1
	SNL CLA		/CHECK FOR RANGE A-Z
	ISZ TSTALP	/OUT OF RANGE
	JMP I TSTALP	/--RETURN--
	PAGE
/INPUT ROUTINE
/UNPACKS CHARACTERS FROM BUFFER

INPUT,	0
	ISZ INCHCT	/ARE THERE CHARACTERS LEFT IN BUFFER? 
	JMP I CHARLV	/YES - FETCH ONE
	TAD INEOF	/NO - WAS OLD FILE ENDED?
	SZA CLA
	JMP ENDCHR	/YES - START NEW FILE
INGBUF,	TAD INCTLA	/NO
	AND [7600
	JMS I [RTL6
	TAD INCTR
	SNL
	DCA INCTR
	SZL
	ISZ INEOF
	CLL CML CMA RTR	/SET CONTROL WORD
	RTR
	RTR
	TAD INCTLA
	DCA INCTLW
	JMS I INHNDL	/CALL INPUT DEVICE HANDLER
INCTLW,	0		/CONTROL WORD
INBUFP,	INBUF		/INPUT BUFFER ADDRESS
INREC,	0		/STARTING BLOCK NUMBER
	JMP INERRX	/ERROR RETURN
INBREC,	TAD INCTLA	/NORMAL RETURN
	AND [7600
	JMS I [RTL6
	TAD INREC
	DCA INREC	/RESET STARTING BLOCK NUMBER
	TAD INCTLW
	AND [7600
	CLL RAL
	TAD INCTLW
	AND [7600
	CIA
	DCA INCHCT	/SET CHARACTER COUNT
	TAD INBUFP
	DCA INPTR	/SET BUFFER POINTER
/CHARACTERS ARE FOUND IN BUFFER
/IN STANDARD OS/8 PACKING
/WORD 1: AAA A11 111 111
/WORD 2: BBB B22 222 222
/WHICH REPRESENTS 3 CHARACTERS
/CHARACTER 1: 11 111 111
/CHARACTER 2: 22 222 222
/CHARACTER 3: AA AAB BBB


ICHAR1,	TAD I INPTR	/PICK UP CHARACTER WORD 1
	JMS CHARLV	/CHECK RIGHT 8 BITS
ICHAR2,	TAD I INPTR	/PICK UP WORD 1
	ISZ INPTR	/(INCREMENT POINTER TO WORD 2)
	AND [7400	/WITH WORD 1 IN AC
	DCA INCTLW	/RETRIEVE LEFT 4 BITS AND SAVE
	TAD I INPTR	/PICK UP WORD 2
	JMS CHARLV	/CHECK RIGHT 8 BITS
ICHAR3,	TAD I INPTR	/PICK UP WORD 2
	ISZ INPTR	/(POINT TO NEXT WORD 1)
	AND [7400	/WITH WORD 2 IN AC
	CLL RTR		/RETRIEVE LEFT 4 BITS
	RTR
	TAD INCTLW	/PUT BOTH SETS OF 4 BITS TOGETHER
	RTR
	RTR
	JMS CHARLV	/CHECK CHARACTER
	JMP ICHAR1	/TRY NEXT SET OF 2 WORDS

INERRX,	ISZ INEOF
	SMA CLA		/EOF OR FATAL ERROR?
	JMP INBREC	/EOF - UNPACK THIS BUFFER
	JMP I (SYSERR	/FATAL - GENERATE DE ERROR MESSAGE

INCHCT,	-1
INEOF,	1
INPTR,	0
INCTR,	0
INCTLA,	0
INFPTR,	7617
/START NEW FILE

ENDCHR,	ISZ I (FORMSW	/^Z OR EOF SIMULATES FORM FEED
	TAD PASS	/IS THIS PASS 3?
	SPA SNA CLA
	JMP NXTFLE	/NO
	JMS I (HEDCLR	/YES - CLEAR HEADING BUFFER
	TAD [-HEDLEN
	DCA I (LSTCH6
	TAD [HEADER-1
	DCA I (LSTCH7
	DCA LSTCNT
NXTFLE,	TAD (INDEVH+1	/SET ADDRESS OF DEVICE HANDLER
	DCA INHNDL
	CDF 10
	TAD I INFPTR
	CDF
	SNA
	JMP FAKDLR	/END OF FILE - FAKE A $
	CIF 10
	JMS I IOMON	/CALL USER SERVICE ROUTINES
	1		/*FETCH HANDLER*
INHNDL,	0		/LOADING ADDRESS OF HANDLER
	HLT		/ERROR RETURN
	CDF 10		/V3C
	TAD INHNDL	/NORMAL RETURN - HANDLER IN CORE
	AND [7600
	TAD [-INDEVH	/SEE IF INPUT HANDLER IS IN 7200
	SZA CLA
	JMS I (PTCH	/IT IS - INCREASE SIZE OF BUFFER
			/AND REMOVE FROM RESIDENCY ANY HANDLERS THERE
	TAD INCTL
	DCA INCTLA	/DF=10
	TAD I INFPTR
	AND [7760
	SZA
	TAD [17
	CLL CML RTR
	RTR
	DCA INCTR
	ISZ INFPTR
	TAD I INFPTR
	DCA INREC	/RESET STARTING BLOCK NUMBER
	ISZ INFPTR
	DCA INEOF
	CDF
	JMP INGBUF
FAKDLR,	TAD (244
	JMS CHARLV	/CALL THE COROUTINE
	TAD [215	/WITH $ AND CR
	JMS CHARLV	/TO END THE ASSEMBLY.
	JMP I (PHASE	/** DIDN'T WORK - MUST BE IN CONDITIONAL - FATAL

CHARLV,	0		/CHARACTER IN AC
	AND [177	/AND OFF LEFT 5 BITS
	JMP I (LSTCH9	/RETURN TO LSTCH9
	PAGE
/HANDLER FOR DTORG PSEUDO-OP (TYPESETTING)
/PUNCHES 4 DIGIT BLOCK NUMBER IN 2 FRAMES
/FIRST FRAME HAS CHANNELS 7 AND 8 PUNCHED
/ADDED TO CHECKSUM

DTORGX,	JMS I [SPNOR	/IGNORE SPACES
	JMS I [EXP	/GET EXPRESSION
	TAD PASS	/IS THIS PASS 2?
	SNA
	JMP DTORG2	/YES
PUNVA1,	SPA SNA CLA	/NO - IS THIS PASS 3?
	JMP I [LOOKEX	/NO--EXIT TO MAIN--
	TAD LININD	/GET LINK SWITCH FROM "EXP"
	DCA LINKSW	/YES
	TAD [LOOKEX	/FIX PUNONE TO EXIT TO MAIN
	DCA I (PUNONE
	TAD [211	/OUTPUT TAB
	JMS I OERROR
	JMP I (DTORG1

DTORG2,	TAD VALUE	/PASS 2 - GET BLOCK NUMBER
	JMS I [RTL6
	RAL
	AND [77
	TAD (300	/PICK UP CHANNELS 7 AND 8
	DCA TEMP
	TAD TEMP
	TAD CHKSUM	/ADD VALUE TO CHECKSUM
	DCA CHKSUM
	TAD TEMP
	JMS I OCHAR	/OUTPUT BLOCK NUMBER - FIRST FRAME
	TAD VALUE
	AND [77
	JMS I OCHAR	/OUTPUT SECOND FRAME
	JMP I [LOOKEX	/--EXIT TO MAIN--

/HANDLER FOR %
/DIVIDE BY REPEATED SUBTRACTION

OP6,	DCA TEMP
	TAD VALUE2
	CIA
	DCA VALUE2
	TAD VALUE
OP6A,	CLL
	TAD VALUE2	/SUBTRACT DIVISOR FROM DIVIDEND
	SNL		/DONE YET?
	JMP OP6B	/YES - EXIT
	ISZ TEMP	/NO - COUNT ONE MORE SUBTRACTION
	JMP OP6A	/SUBTRACT AGAIN
OP6B,	CLA
	TAD TEMP	/RESULT IS # OF SUBTRACTIONS
	JMP I (OP0+2
/HANDLER FOR XLIST PSEUDO-OP

XLISTY,	JMS XLISTZ	/ANY EXPRESSION?
	JMP XLIST1	/NO
	JMS I [EXP	/GET EXPRESSION
	TAD VALUE	/USE THE VALUE
XLIST2,	DCA XLISTX	/SET SWITCH
	DCA I [LINBUF	/XLIST NEVER LISTS!
	JMP I [LOOKEX	/--EXIT TO MAIN--

XLIST1,	TAD XLISTX
	SNA CLA
	IAC		/FLIP IT
	JMP XLIST2

RELOCY,	JMS XLISTZ	/RELOCATE PSEUDO-OP - EXPRESSION?
	JMP RELOC1	/NO
	JMS I [EXP	/GET IT
	TAD VALUE
	CIA		/COMPUTE OFFSET OF REL LOC CTR
	TAD LOC		/FROM FAKE LOC CTR
	TAD OFFSET	/OFFSET IS CUMULATIVE!
RELOC2,	DCA OFSBUF	/SET NEW OFFSET - THIS TAKES EFFECT AFTER
	STA		/THE LITERALS (IF ANY) ARE DUMPED.
	JMP I (STAR0	/FAKE ORIGIN TO NEW LOC,
			/ACTUALLY A NO-OP BECAUSE OF OFFSET
RELOC1,	TAD OFFSET	/SET OFSBUF=0, LOC=LOC+OFFSET -
	TAD LOC		/THIS CANCELS ALL RELOCATION STUFF.
	DCA VALUE
	DCA UNDFSW	/JUST IN CASE - "STAR0" CHECKS THIS
	JMP RELOC2	/STILL MUST OUTPUT *. TO GET IN SYNCH
/HANDLER FOR EJECT PSEUDO-OP

EJECTX,	ISZ THISPG
	TAD PASS	/IS THIS PASS 3?
	SMA SZA CLA
	JMP EJECT2	/YES
EJECT1,	TAD CHAR	/NO - LOOK FOR NEXT NEGATIVE CHARACTER
	SPA CLA
	JMP I [LOOKEX	/--EXIT TO MAIN--
	JMS I [GETC	/GET NEXT CHARACTER
	JMP EJECT1

EJECT2,	JMS XLISTZ	/PASS 3 - IS THERE AN EXPRESSION?
	JMP EJECT3	/NO - EXIT
	JMS I (HEDCLR	/YES - CLEAR HEADING BUFFER
	TAD [-HEDLEN
	DCA EJECT7	/SET UP FOR 40 NEW CHARACTERS
	TAD [HEADER-1
	DCA XREG1	/SET HEADER BUFFER POINTER
	JMP EJECT4

EJECT6,	ISZ EJECT7	/FILLED 40 CHARACTERS YET?
	JMP EJECT4	/NO - KEEP FILLING
	CLA CMA		/YES - SKIP CHARACTERS TO
	DCA EJECT7	/END OF LINE
	JMP EJECT5

EJECT4,	TAD CHAR	/FILL HEADING BUFFER
	DCA I XREG1
EJECT5,	CLA CMA
	DCA TXTSWT
	JMS I [GETC	/GET NEXT CHARACTER
	TAD CHAR	/END OF LINE?
	SMA CLA
	JMP EJECT6	/NO - KEEP FILLING
EJECT3,	JMS I [FORMFD	/GENERATE FORM FEED
	JMP I [LOOKEX	/--EXIT TO MAIN--
PUNVAL,	TAD PASS	/IS THIS PASS 3?
	JMP PUNVA1	/IF SO, LIST STUFF


/SEE IF EXPRESSION FOLLOWS XLIST
/SKIP ON EXPRESSION

EJECT7,
XLISTZ,	0
	JMS I [SPNOR	/IGNORE TRAILING SPACES
	TAD CHAR
	TAD [-">	/IS THERE AN EXPRESSION?
	SNA CLA
	JMP I XLISTZ	/NO--RETURN--
	TAD CHAR
	SMA CLA
	ISZ XLISTZ	/YES - INCREMENT RETURN ADDRESS
	JMP I XLISTZ	/--RETURN--


/DUMMY ERROR ROUTINE
/TO SUPPRESS CERTAIN ERROR MESSAGES
/ON PASS 1

PERRO1,	0
	ISZ PERRO1	/SKIP ERROR MESSAGE POINTER
	JMP I PERRO1	/--RETURN--


/CONSTANTS FOR DECIMAL PRINT

	DECIMAL
FORMF8,	-1000
	-100
	-10
	0
	OCTAL
	PAGE
/*********************************************************************

INBUF=.			/INPUT BUFFER 

OUBUF=.			/OUTPUT BUFFER

OUDEVH=.+400		/OUTPUT DEVICE HANDLER

INDEVH=7200		/INPUT DEVICE HANDLER

/**********************************************************************

/	EXPLANATION OF PAL8'S BUFFER ALLOCATION ALGORITHM

/PASS1:

/	THE INPUT BUFFER STARTS AT 5600 AND ENDS AT 7200
/	THE INPUT HANDLER GOES IN 7200-7600.
/	THERE IS NO OUTPUT HANDLER.
/	HOWEVER, IF THE CURRENT INPUT HANDLER DOES NOT
/	LOAD INTO 7200, THEN THE BUFFER SIZE IS INCREASED
/	SO THAT THE INPUT BUFFER IS 5600-7600

/PASS2 AND PASS3:

/	THE OUTPUT BUFFER IS ALWAYS 1 BLOCK LONG, LOCATED
/	AT 5600-6200.
/	THE OUTPUT HANDLER RESIDES IN 6200-6600.
/	THE INPUT HANDLER RESIDES IN 7200-7600.
/	THE INPUT BUFFER NORMALLY RESIDES IN 6600-7200
/	BUT MAY GROW OVER EITHER THE INPUT HANDLER AREA OR
/	THE OUTPUT HANDLER AREA, IF EITHER OR BOTH OF THESE
/	DON'T EXIST.

/WHENEVER A BUFFER GROWS OVER A HANDLER AREA, THE MONITOR
/HANDLER RESIDENCY TABLE IS SEARCHED TO SEE IF THERE
/WERE ANY HANDLERS THERE.  IF ANY HANDLERS WERE THERE IN THE PAST,
/THEY ARE NOW MARKED AS BEING NON-RESIDENT.
/MORE ONCE ONLY CODE

OTYPE,	0
	DCA TEMP
	CDF 10
	TAD I TEMP
	AND [17		/GET DEVICE NUMBER
	TAD (DCB-1
	DCA TEMP
	TAD I TEMP	/GET DCB ENTRY
	CDF
	JMP I OTYPE	/--RETURN--

/CHECK TO SEE HOW MUCH CORE EXISTS
/AND STORE SYMBOL TABLE ACCORDINGLY

	IFZERO	HASH<
BEGINF,	CDF 10		/WAS THE /K OPTION SELECTED TO
	TAD I (MPARAM	/CHECK FOR MORE THAN 8K?
	CDF 0
	RTR
ZK7630,	SNL CLA		/YES
	JMP I (CKBAT	/NO - CHECK FOR BATCH, USE 8K ONLY
	CDF 50
	JMS FLD2	/WHAT IS HIGHEST FIELD?
	JMP FLD1-1	/5
	CDF 40
	JMS FLD2
	JMP FLD1	/4
	CDF 30
	JMS FLD2
	JMP FLD1+1	/3
	CDF 20
	JMS FLD2
	JMP FLD1+2	/2
	JMP OPTIM4	/1
	TAD [177	/IF FIELD 5, ALLOW 4095 SYMBOLS
FLD1,	TAD (1740	/OTHERWISE ALLOW 1740*(NR OF FIELDS)
	TAD (1740
	TAD (1740
OPTIM0,	TAD (1740
	DCA I (TAGMAX	/SET HIGHEST ADDRESS FOR TAGS
	JMP I (BEGING

OPTIM4,	TAD I OPTIM1	/OPTIMIZE SEARCH PATTERN
	ISZ OPTIM1	/BY SUBSTITUTING CODE IN SEARCH
	DCA I OPTIM2	/ROUTINE
	ISZ OPTIM2
	ISZ OPTIM3
	JMP OPTIM4
OPTIM8,	TAD I OPTIM5
	ISZ OPTIM5
	DCA I OPTIM6
	ISZ OPTIM6
	ISZ OPTIM7
	JMP OPTIM8
	JMP OPTIM0
	>

	IFNZRO	HASH<
	/SIZE CHECK OUR MACHINE

BEGINF,	CDF	10
	TAD I	(MPARAM
	CDF
	RTR		/K TO LINK
ZK7630,	SNL CLA		/ALTER FOR COMPLEMENT OF K
	TAD	[400	/TAD TO KEEP USR
	DCA I	(USROFS
	CDF	50
	JMS	FLD2
	ISZ	HIFLD
	CDF	40
	JMS	FLD2
	ISZ	HIFLD
	CDF	30
	JMS	FLD2
	ISZ	HIFLD
	CDF	20
	JMS	FLD2
	ISZ	HIFLD
	TAD I	(7777	/CHECK SOFT CORE SIZE
	AND	(70
	SNA
	JMP	CKSEV	/NOT THERE
	CLL RTR
	RAR
	DCA	HIFLD	/THERE, SET HIFLD WITH IT
	TAD	HIFLD	/TAKE MIN(HIFLD,5)
	TAD	(7772
	SMA CLA		/SMA TO USE HIFLD
	TAD	(5	/ELSE USE 5
	SZA
	DCA	HIFLD	/STORE 5 IF NECESSARY
CKSEV,	CDF	10
	TAD I	(MPARAM+2	/LOOK AT /7
	CDF
	AND	(4
	SNA CLA		/SNA IF THERE
	JMP I	(CKBAT	/ELSE CHECK FOR BATCH
	TAD	(-7	/SET TO PRINT 7 COLUMNS OF STAB
	DCA I	(SYMNCL
	TAD	(67^6	/SET OFFSET TO FIRST SYMBOL ON NEXT PAGE
	DCA I	(SYMOFS
	JMP I	(CKBAT	/OK, CHECK FOR BATCH NOW
OPTIM4,	SNL		/SNL IF BATCH RUNNING
	JMP I	(BEGING	/ELSE TAKE DEFAULT TABLE SIZE
	TAD	(BPRIME/SET ALTERNATE TABLE SIZE
	DCA I	(PRIMES	/INTO THE ONCE ONLY CODE
	JMP I	(BEGING	/NOW HIFLD=# OF HIGHEST USABLE FIELD
HIFLD,	1		/8K MINIMUM
	>

/SKIP IF CURRENT DATA FIELD DOES NOT EXIST
FLD2,	0
	TAD (FLD3
	DCA I FLD4
FLD3,	CLA
	TAD I FLD4
	NOP
	CDF
	TAD (-FLD3
	SZA CLA
	JMP FLD5
	TAD IOMON
	TAD [-200
	SNA CLA		/IS FIELD THERE?
	JMP I FLD2	/YES--RETURN--
	TAD [200
	DCA IOMON
FLD5,	ISZ FLD2	/NO-INCREMENT RETURN ADDRESS
	JMP I FLD2	/--RETURN--

FLD4,	IOMON
/OVERLAY CODE FOR OPTIMAL SYMBOL TABLE SEARCH
/IN 8K
	IFZERO	HASH<

OPTIM1,	OPTIMA
OPTIM2,	SETFLD+1
OPTIM3,	-7

OPTIM5,	OPTIMB
OPTIM6,	GETTG5
OPTIM7,	-21

OPTIMA,	RELOC SETFLD+1

	CLL CMA RTL
	TAD STM202
	DCA TAGXR
	CDF 10
	JMP I SETFLD
STM202,	-202
SETFL4,	4
	RELOC

OPTIMB,	RELOC GETTG5

	TAD HIGHTG
	JMS SETFLD
	TAD TAGXR
	DCA XREG1
	TAD XREG1
	TAD SETFL4
	DCA XREG2
	TAD THISTG
	JMS SETFLD
OPTIML,	TAD I XREG2
	DCA I XREG1
	TAD XREG1
	CIA
	TAD TAGXR
	SZA CLA
	JMP OPTIML
	CDF
	RELOC
	>
/OVERLAY CODE FOR DDT SYMBOL TABLE PRINT

DSWIT2,	IFZERO	HASH<
	RELOC SYMPR9-2
	JMP SYMPRE
SYMPRD,	TAD SYM204
	JMS I OERROR
	TAD [377
	JMS I OERROR
	JMS SYMPRC
	DCA LINCNT
	JMP I SYMPRT
SYMPRC,	0
	TAD [-200
	DCA SYMPR2
	TAD [200
	JMS I OERROR
	ISZ SYMPR2
	JMP .-3
	JMP I SYMPRC
	RELOC
	>
	IFNZRO	HASH<
	RELOC	SYMDDT
	ISZ	THISTG
	JMP	SYMLUP
SYMXIT,	TAD	SYM204
	JMS I	OERROR
	TAD	[377
	JMS I	OERROR
	JMS	DDTLDR
	DCA	LINCNT
	JMP I	SYMPRT
DDTLDR,	0
	TAD	[7600
	DCA	SYMCCT
	TAD	[200
	JMS I	OERROR
	ISZ	SYMCCT
	JMP	.-3
	JMP I	DDTLDR
SYM204,	204
	RELOC
	>
DSWITB=	.
	PAGE
BEGING,	CIF 10
	JMS I IOMON	/CALL THE USR
	12		/TO FIND OUT DSK:
BEGINJ,	TEXT /DSK/
	7201		/DUMMY
	HLT		/NEVER!
/V3C	TAD BEGINJ+1	/GET DEVICE NUMBER OF DSK:
/V3C	DCA CC7		/AND SET IT
	TAD BEGINJ+1
	DCA I BEGINL	/AND SET IT INTO "PALBIN"
	CDF 10
	TAD I CC1	/GET PARAMETER WORD 1
	CDF
	CLL RTL		/OPTION /B INTO LINK
	AND [400	/IS IT /F?
ZF7650,	SZA CLA
	DCA I CCX1	/YES: /F => NO 0 FILL
ZB7430,	SNL		/IS IT /B?
	JMP .+3
	TAD CCX2
	DCA I CCX3	/YES: /B => ! IS SHIFT
	CDF 10
	TAD I CC1	/GET WORD 1 AGAIN
	CDF
	AND [200	/IS IT /E?
ZE7640,	SNA CLA
	JMP .+3
	TAD CCX8
	DCA I CCX4	/YES: /E => SET 'LG' ERROR
	CDF 10
	TAD I CCX5	/GET WORD 2 THIS TIME
	CDF
	RTL
ZO7710,	SMA CLA		/IS IT /O?
	JMP .+3
	DCA I CCX6	/YES: /O => NO 200 ORG
	ISZ I CCX7
	CDF 10
	TAD I CC1	/GET WORD 1 AGAIN
	AND CC2		/IS IT /C?
	SNA CLA
	JMP I CC3	/NO: TRY FOR /L OR /G
	TAD I CC4	/CREF FILE SPECIFIED?
	SZA CLA
	JMP CC5		/YES
CC6,	TAD CC7		/NO: GIVE "CREFLS.TM"
	DCA I CC4
	ISZ CC6
	ISZ CC4
	ISZ CC8
	JMP CC6
CC5,	CDF
	CIF 10
	CLA IAC
	JMS I IOMON	/LOOKUP "CREF.SV"
	2
CC13,	CC9		/POINT TO NAME - BACK WITH START
CC8,	-5		/LENGTH GOES HERE
	JMP CC16	/NOT FOUND!
	TAD CC30
	JMS I CC31	/CHECK TYPE FILE
	SMA CLA
	JMP CC16	/NOT DIRECTORY IS ERROR
	TAD CC12
	DCA I CC121	/CSWITC=TAD I [7605
	TAD CC11
	DCA I CC111	/CSWIT1=CLA
	TAD CC10
	DCA I CC101	/CSWIT2=DCA BINSRT
	DCA I CC171	/CMOVE=0
	TAD CC13
	DCA I CC131	/CHAIN="CREF.SV"
	DCA I CC141	/LSWITC=0
	TAD CC30
	DCA I CC301	/NOPA22=7612
	DCA I CC20	/"BEGIAB"=0
	TAD CC21
	DCA I CC211	/"DIRSW1"=TAD [177
	TAD CC22
	DCA I CC221	/"PTPSW1"=TAD [232
	JMP I .+1
	CCC		/KEEP GOING (SIGH)

CC16,	JMS I [ERROR
	CF		/OPTION /C ERROR
	JMP I CC3	/TRY FOR /L OR /G
CC171,	SWAPR2+CMOVE
CC141,	LSWITC
CC131,	CHAIN
CC121,	CSWITC
CC12,	TAD I [7605
CC111,	CSWIT1
CC11,	CLA
CC101,	SWAPR2+CSWIT2
CC10,	DCA BINSRT
CC301,	SWAPR2+NOPA22
CC30,	7612
CC31,	OTYPE
CC1,	MPARAM
CC2,	1000
CC3,	BEGINH
CC4,	7612

CCX1,	TEXT4X		/V3C
CCX2,	OP3
CCX3,	OPEXPL
CCX4,	LGERR
CCX5,	MPARAM+1
CCX6,	FIELDY+1
CCX7,	FIELDY+2
CCX8,	JMS I PERROR

CC7,	1
	FILENAME CREFLS.TM
CC9,	FILENAME CREF.SV

CC20,	BEGIAB
CC21,	TAD [177
CC211,	SWAPR2+DIRSW1
CC22,	TAD [232
CC221,	SWAPR2+PTPSW1

BEGINL,	PALBIN
	PAGE
/***********************************************************************
/SYMBOL TABLE
/MOVED BY ASSEMBLER TO FIELD 1
/MUST REMAIN IN ALPHABETICAL ORDER
/***********************************************************************

SYMS,	5777			/TERMINATOR
	3777			/IMPOSSIBLE (LIMITING) SYMBOL
	5777
	0000
	IFNZRO	HASH<		/PSEUDO OPS MUST GO FIRST FOR EXPUNGE
	"I-300^45+4000+2000	/I
	0
	0
	0400

	"P-300^45+"A-300+4000	/PAUSE
	"U-300^45+"S-300
	"E-300^45+4000
	PAUSEX

	"P-300^45+"A-300+4000	/PAGE
	"G-300^45+"E-300
	4000
	PAGEX

	"T-300^45+"E-300+4000	/TEXT
	"X-300^45+"T-300
	4000
	TEXTX

	"R-300^45+"E-300+4000	/RELOC
	"L-300^45+"O-300
	"C-300^45+4000
	RELOCY

	"O-300^45+"C-300+4000	/OCTAL
	"T-300^45+"A-300
	"L-300^45+4000
	OCTALX

	"N-300^45+"O-300+4000	/NOPUNCH
	"P-300^45+"U-300
	"N-300^45+"C-300+4000
	NOPUNX


	"I-300^45+"F-300+4000	/IFZERO
	"Z-300^45+"E-300
	"R-300^45+"O-300+4000
	IF0
	"I-300^45+"F-300+4000	/IFNZRO
	"N-300^45+"Z-300
	"R-300^45+"O-300+4000
	IFN0

	"I-300^45+"F-300+4000	/IFNDEF
	"N-300^45+"D-300
	"E-300^45+"F-300+4000
	IFND

	"I-300^45+"F-300+4000	/IFDEF
	"D-300^45+"E-300
	"F-300^45+4000
	IFD

	"F-300^45+"I-300+4000	/FIXTAB
	"X-300^45+"T-300
	"A-300^45+"B-300+4000
	FIXTBX

	"F-300^45+"I-300+4000	/FIXMRI
	"X-300^45+"M-300
	"R-300^45+"I-300+4000
	FIXMRX

	"F-300^45+"I-300+4000	/FILENAME
	"L-300^45+"E-300
	"N-300^45+"A-300+4000
	FILENX

	"F-300^45+"I-300+4000	/FIELD
	"E-300^45+"L-300
	"D-300^45+4000
	FIELDX

	"E-300^45+"X-300+4000	/EXPUNGE
	"P-300^45+"U-300
	"N-300^45+"G-300+4000
	EXPUNX

	"E-300^45+"N-300+4000	/ENPUNCH
	"P-300^45+"U-300
	"N-300^45+"C-300+4000
	ENPUNX

	"E-300^45+"J-300+4000	/EJECT
	"E-300^45+"C-300
	"T-300^45+4000
	EJECTX
	"D-300^45+"T-300+4000	/DTORG
	"O-300^45+"R-300
	"G-300^45+4000
	DTORGX

	"D-300^45+"E-300+4000	/DEVICE
	"V-300^45+"I-300
	"C-300^45+"E-300+4000
	DEVICX

	"D-300^45+"E-300+4000	/DECIMAL
	"C-300^45+"I-300
	"M-300^45+"A-300+4000
	DECIMX
	>
	"Z-300^45+"B-300+4000	/ZBLOCK
	"L-300^45+"O-300
	"C-300^45+"K-300+4000
	ZBLOCX

	"Z-300^45+4000+2000	/Z
	0
	0
	0000

	"X-300^45+"L-300+4000	/XLIST
	"I-300^45+"S-300
	"T-300^45+4000
	XLISTY

	"T-300^45+"S-300+4000	/TSK
	"K-300^45
	0
	6045

	"T-300^45+"S-300+4000	/TSF
	"F-300^45
	0
	TSF

	"T-300^45+"P-300+4000	/TPC
	"C-300^45
	0
	TPC

	"T-300^45+"L-300+4000	/TLS
	"S-300^45
	0
	TLS

	"T-300^45+"F-300+4000	/TFL
	"L-300^45
	0
	6040
	IFZERO	HASH<
	"T-300^45+"E-300+4000	/TEXT
	"X-300^45+"T-300
	4000
	TEXTX
	>
	"T-300^45+"C-300+4000	/TCF
	"F-300^45
	0
	TCF

	"T-300^45+"A-300+4000	/TAD
	"D-300^45+4000
	0
	TAD 0

	"S-300^45+"Z-300+4000	/SZL
	"L-300^45
	0
	SZL

	"S-300^45+"Z-300+4000	/SZA
	"A-300^45
	0
	SZA

	"S-300^45+"W-300+4000	/SWP
	"P-300^45
	0
	7521

	"S-300^45+"T-300+4000	/STL
	"L-300^45
	0
	STL

	"S-300^45+"T-300+4000	/STA
	"A-300^45
	0
	STA

	"S-300^45+"R-300+4000	/SRQ
	"Q-300^45
	0
	6003

	"S-300^45+"P-300+4000	/SPA
	"A-300^45
	0
	SPA
	"S-300^45+"N-300+4000	/SNL
	"L-300^45
	0
	SNL

	"S-300^45+"N-300+4000	/SNA
	"A-300^45
	0
	SNA

	"S-300^45+"M-300+4000	/SMA
	"A-300^45
	0
	SMA

	"S-300^45+"K-300+4000	/SKP
	"P-300^45
	0
	SKP

	"S-300^45+"K-300+4000	/SKON
	"O-300^45+"N-300
	0
	6000

	"S-300^45+"G-300+4000	/SGT
	"T-300^45
	0
	6006

	"R-300^45+"T-300+4000	/RTR
	"R-300^45
	0
	RTR

	"R-300^45+"T-300+4000	/RTL
	"L-300^45
	0
	RTL

	"R-300^45+"T-300+4000	/RTF
	"F-300^45
	0
	6005

	"R-300^45+"S-300+4000	/RSF
	"F-300^45
	0
	RSF
	"R-300^45+"R-300+4000	/RRB
	"B-300^45
	0
	RRB

	"R-300^45+"P-300+4000	/RPE
	"E-300^45
	0
	6010

	"R-300^45+"M-300+4000	/RMF
	"F-300^45
	0
	RMF

	"R-300^45+"I-300+4000	/RIF
	"F-300^45
	0
	RIF

	"R-300^45+"I-300+4000	/RIB
	"B-300^45
	0
	RIB

	"R-300^45+"F-300+4000	/RFC
	"C-300^45
	0
	RFC
	IFZERO	HASH<
	"R-300^45+"E-300+4000	/RELOC
	"L-300^45+"O-300
	"C-300^45+4000
	RELOCY
	>
	"R-300^45+"D-300+4000	/RDF
	"F-300^45
	0
	RDF

	"R-300^45+"A-300+4000	/RAR
	"R-300^45
	0
	RAR

	"R-300^45+"A-300+4000	/RAL
	"L-300^45
	0
	RAL
	"P-300^45+"S-300+4000	/PSF
	"F-300^45
	0
	PSF

	"P-300^45+"P-300+4000	/PPC
	"C-300^45
	0
	PPC

	"P-300^45+"L-300+4000	/PLS
	"S-300^45
	0
	PLS

	"P-300^45+"C-300+4000	/PCF
	"F-300^45
	0
	PCF

	"P-300^45+"C-300+4000	/PCE
	"E-300^45
	0
	6020
	IFZERO	HASH<
	"P-300^45+"A-300+4000	/PAUSE
	"U-300^45+"S-300
	"E-300^45+4000
	PAUSEX

	"P-300^45+"A-300+4000	/PAGE
	"G-300^45+"E-300
	4000
	PAGEX
	>
	"O-300^45+"S-300+4000	/OSR
	"R-300^45
	0
	OSR

	"O-300^45+"P-300+4000	/OPR
	"R-300^45
	0
	OPR
	IFZERO	HASH<
	"O-300^45+"C-300+4000	/OCTAL
	"T-300^45+"A-300
	"L-300^45+4000
	OCTALX
	>
	IFZERO	HASH<
	"N-300^45+"O-300+4000	/NOPUNCH
	"P-300^45+"U-300
	"N-300^45+"C-300+4000
	NOPUNX
	>
	"N-300^45+"O-300+4000	/NOP
	"P-300^45
	0
	NOP

	"M-300^45+"Q-300+4000	/MQL
	"L-300^45
	0
	7421

	"M-300^45+"Q-300+4000	/MQA
	"A-300^45
	0
	7501

	"L-300^45+"A-300+4000	/LAS
	"S-300^45
	0
	LAS

	"K-300^45+"S-300+4000	/KSF
	"F-300^45
	0
	KSF

	"K-300^45+"R-300+4000	/KRS
	"S-300^45
	0
	KRS

	"K-300^45+"R-300+4000	/KRB
	"B-300^45
	0
	KRB

	"K-300^45+"I-300+4000	/KIE
	"E-300^45
	0
	6035

	"K-300^45+"C-300+4000	/KCF
	"F-300^45
	0
	6030
	"K-300^45+"C-300+4000	/KCC
	"C-300^45
	0
	KCC

	"J-300^45+"M-300+4000	/JMS
	"S-300^45+4000
	0
	JMS 0

	"J-300^45+"M-300+4000	/JMP
	"P-300^45+4000
	0
	JMP 0

	"I-300^45+"S-300+4000	/ISZ
	"Z-300^45+4000
	0
	ISZ 0

	"I-300^45+"O-300+4000	/IOT
	"T-300^45
	0
	IOT

	"I-300^45+"O-300+4000	/ION
	"N-300^45
	0
	ION

	"I-300^45+"O-300+4000	/IOF
	"F-300^45
	0
	IOF
	IFZERO	HASH<
	"I-300^45+"F-300+4000	/IFZERO
	"Z-300^45+"E-300
	"R-300^45+"O-300+4000
	IF0

	"I-300^45+"F-300+4000	/IFNZRO
	"N-300^45+"Z-300
	"R-300^45+"O-300+4000
	IFN0

	"I-300^45+"F-300+4000	/IFNDEF
	"N-300^45+"D-300
	"E-300^45+"F-300+4000
	IFND
	>
	IFZERO	HASH<
	"I-300^45+"F-300+4000	/IFDEF
	"D-300^45+"E-300
	"F-300^45+4000
	IFD
	>
	"I-300^45+"A-300+4000	/IAC
	"C-300^45
	0
	IAC
	IFZERO	HASH<
	"I-300^45+4000+2000	/I
	0
	0
	0400
	>
	"H-300^45+"L-300+4000	/HLT
	"T-300^45
	0
	HLT

	"G-300^45+"T-300+4000	/GTF
	"F-300^45
	0
	6004

	"G-300^45+"L-300+4000	/GLK
	"K-300^45
	0
	GLK
	IFZERO	HASH<
	"F-300^45+"I-300+4000	/FIXTAB
	"X-300^45+"T-300
	"A-300^45+"B-300+4000
	FIXTBX

	"F-300^45+"I-300+4000	/FIXMRI
	"X-300^45+"M-300
	"R-300^45+"I-300+4000
	FIXMRX

	"F-300^45+"I-300+4000	/FILENAME
	"L-300^45+"E-300
	"N-300^45+"A-300+4000
	FILENX

	"F-300^45+"I-300+4000	/FIELD
	"E-300^45+"L-300
	"D-300^45+4000
	FIELDX
	>
	IFZERO	HASH<
	"E-300^45+"X-300+4000	/EXPUNGE
	"P-300^45+"U-300
	"N-300^45+"G-300+4000
	EXPUNX

	"E-300^45+"N-300+4000	/ENPUNCH
	"P-300^45+"U-300
	"N-300^45+"C-300+4000
	ENPUNX

	"E-300^45+"J-300+4000	/EJECT
	"E-300^45+"C-300
	"T-300^45+4000
	EJECTX

	"D-300^45+"T-300+4000	/DTORG
	"O-300^45+"R-300
	"G-300^45+4000
	DTORGX

	"D-300^45+"E-300+4000	/DEVICE
	"V-300^45+"I-300
	"C-300^45+"E-300+4000
	DEVICX

	"D-300^45+"E-300+4000	/DECIMAL
	"C-300^45+"I-300
	"M-300^45+"A-300+4000
	DECIMX
	>
	"D-300^45+"C-300+4000	/DCA
	"A-300^45+4000
	0
	DCA 0

	"C-300^45+"M-300+4000	/CML
	"L-300^45
	0
	CML

	"C-300^45+"M-300+4000	/CMA
	"A-300^45
	0
	CMA

	"C-300^45+"L-300+4000	/CLL
	"L-300^45
	0
	CLL
	"C-300^45+"L-300+4000	/CLA
	"A-300^45
	0
	CLA

	"C-300^45+"I-300+4000	/CIF
	"F-300^45
	0
	CIF

	"C-300^45+"I-300+4000	/CIA
	"A-300^45
	0
	CIA

	"C-300^45+"D-300+4000	/CDF
	"F-300^45
	0
	CDF

	"C-300^45+"A-300+4000	/CAF
	"F-300^45
	0
	6007

	"B-300^45+"S-300+4000	/BSW
	"W-300^45
	0
	7002

	"A-300^45+"N-300+4000	/AND
	"D-300^45+4000
	0
	AND 0

	4001			/TERMINATOR
	0000			/IMPOSSIBLE (LIMITING) SYMBOL
	4000
	0000

SYME=.

/**********************************************************************
/TOP OF SYMBOL TABLE
/**********************************************************************
SWAP2=.

/**********************************************************************
/CODE UNIQUE TO PASSES 1 AND 2
/SWAPPED IN FOR PASSES 1 AND 2
/OVERLAYED DURING PASS 3	*** NO LITERALS ***

	RELOC 1000		/ASSEMBLED INTO 1000-1247

	SWAPB2=	.
	SWAPR2=	SWAP2-SWAPB2	/RELOCATION FACTOR FOR THIS CODE

OOPEN,	0
	TAD OPEN01	/OPEN BINARY AND LISTING FILES
	DCA XOUHND	/SET ADDRESS OF DEVICE HANDLER
	TAD OPEN02
	DCA XOUBLK
	TAD [-5
	DCA XOUELE	/SET NEW OUTPUT FILE LENGTH
	CDF 10
	TAD I OUFPTR
	CDF
	DCA I XOUBLK
	ISZ XOUBLK
	ISZ OUFPTR
	ISZ XOUELE	/INCREMENT OUTPUT FILE LENGTH
	JMP .-7
	TAD OPEN02
	IAC
	DCA XOUBLK	/SET POINTER TO NEW FILENAME
	TAD XOUBLK
	DCA I OPEN04
	CIF 10
	JMS I IOMON	/CALL USER SERVICE ROUTINES
	13		/*RESET SYSTEM TABLES*
	DCA I OPEN05	/DELETE UNCLOSED FILES AND
	TAD I OPEN02	/DELETE HANDLERS
	AND [17		/GET NEW DEVICE HANDLER #
	SNA		/OUTPUT INHIBIT?
	JMP ONOFIL	/YES
	CIF 10		/NO
	JMS I IOMON	/CALL USER SERVICE ROUTINE
	1		/*FETCH DEVICE HANDLER*
XOUHND,	0		/LOADING ADDRESS
	HLT		/HANDLER NOT AVAILABLE
OUENTR,	TAD I OPEN02	/NORMAL RETURN - GET OUTPUT
	CIF 10		/DEVICE NUMBER AND FILE LENGTH
	JMS I IOMON	/CALL NEW SERVICE ROUTINES
	3		/*ENTER OUTUT FILE
XOUBLK,	0		/POINTER TO FILENAME
XOUELE,	0		/FILE LENGTH
	JMP OEFAIL	/ERROR RETURN
	DCA I OPEN06	/NORMAL RETURN
	JMS I OPEN07
	TAD XOUHND
	TAD [200	/LINK IS CLEAR!!
	SNL CLA
	TAD [400
	TAD OUFDEV
	DCA I OUFINP
	TAD I OUFINP
	CLL RAR
	CIA
	TAD OU3501
	DCA INCTL
	ISZ OOPEN
	TAD XOUHND
	DCA I OPEN09
	TAD XOUBLK
	DCA I OPEN10
	TAD XOUELE
	DCA I OPEN11
	JMP I OOPEN	/--RETURN--

OEFAIL,	TAD I OPEN02
	AND [7760
	SNA CLA
	JMP I OPEN12	/DE**FATAL ERROR**
	TAD I OPEN02
	AND [17
	DCA I OPEN02
	JMP OUENTR

ONOFIL,	ISZ I OPEN05	/SET OUTPUT INHIBIT SWITCH
	JMP I OOPEN	/--RETURN--

OUFPTR,	7600

OPEN01,	OUDEVH+1
OPEN02,	OUFILE
OPEN04,	OUCNAM
OPEN05,	OUTINH
OPEN06,	OUCCNT
OPEN07,	OUSETP
OPEN09,	OUHNDL
OPEN10,	OUBLK
OPEN11,	OUELEN
OPEN12,	SYSERR
OU3501,	3501
OUFDEV,	OUDEVH
OUFINP,	INBUFP
/CONTINUATION OF FIXTAB HANDLER

FIXTAY,	IFZERO	HASH<
	TAD HIGHTG	/SET POINTERS TO TABLE
	CMA
	>
	IFNZRO	HASH<
	TAD	TAGMAX
	CIA
	>
	DCA TEMP3
	DCA THISTG
FIXTAX,	JMS I [FINDTG	/GET A TAG
	AC3777
	AND TAG1
	IFNZRO	HASH<
	SZA
	>
	TAD [4000	/SET BIT 0 OF FIRST WORD TO 1
	DCA TAG1	/RETURN IT TO TABLE
	JMS I [PUTTAG
	ISZ THISTG
	ISZ TEMP3	/DONE WITH TABLE YET?
	JMP FIXTAX	/NO
	JMP I [LOOKEX	/YES--EXIT TO MAIN-- 

/OUTPUT ONE REGISTER - BINARY
/ENTER WITH CONTENTS IN AC

PUNOUT,	0
	DCA PUNOU1
	TAD PUNOU1
	RTR
	RTR
	RTR
	AND [177
	JMS I OCHAR	/OUTPUT FIRST FRAME
	TAD PUNOU1
	AND [77
	JMS I OCHAR	/OUTPUT SECOND FRAME
	JMP I PUNOUT	/--RETURN--

PUNOU1,
IOPEN,	0		/SET UP INPUT ROUTINE
	CLA CMA		/TO OPEN FILE
	DCA I IOPEN1
	ISZ I IOPEN2
	TAD IOPEN3
	DCA I IOPEN4
	ISZ I IOPEN5
	TAD [LINBUF+120
	DCA TXTPTR
	JMP I IOPEN	/--RETURN--

IOPEN1,	INCHCT
IOPEN2,	INEOF
IOPEN3,	7617
IOPEN4,	INFPTR
IOPEN5,	FORMSW
	PAGE
/START PASS 2	*** NO LITERALS HERE EITHER ***

START1,	TAD [ERROR
	DCA PERROR	/RESET PREUDO-ERROR ROUTINE
	JMS I ST1OPN	/OPEN PASS 2 OUTPUT FILE
	JMP NOPA21	/NO PASS 2 IF PASS 3
NOPA23,	TAD I ST1OBL
	DCA BINSRT
	DCA PUNCHX	/CLEAR PUNCH INHIBIT
	JMS START3
	JMP I .+1
	START2-1

NOPA21,	CDF 10
	TAD I NOPA22	/IS THERE A PASS 3?
	CDF
	SNA CLA
	JMP NOPA23	/NO - DO PASS 2
	ISZ PASS	/SKIP PASS 2
	NOP
	JMP NOPAS2	/CONTINUE TO PASS 3

NOPA22,	7605

START3,	0		/GENERATE LEADER/TRAILER
	TAD LEADER
	DCA TXTPTR
	TAD [200
	JMS I OCHAR
	ISZ TXTPTR
	JMP .-3
	JMP I START3	/--RETURN--

LEADER,	-10
/END PASS 2

ENDPA2,	JMS I [DUMPZ	/DUMP PAGE 0 LITERALS
	DCA PUNCHX
	CLL		/V3C
	TAD CHKSUM	/OUTPUT CHECKSUM
	JMS I [PUNOUT	/PUNCH THE CHECKSUM
	JMS START3	/GENERATE LEADER/TRAILER
	JMS I EN2CLS	/CLOSE PASS 2 OUTPUT FILE
NOPAS2,	TAD EN2LSO
	DCA OERROR	/SET NEW OUTPUT TO BE LISTING
	ISZ I EN2OU1
CMOVE,	JMP CMOVA	/ZEROED IF /C
	CDF 10		/MOVE CODE FOR /C OPTION
CMOVB,	TAD I CMOV1
	DCA I CMOV2	/MOVE OUTPUT FILE STORAGE
	ISZ CMOV1
	ISZ CMOV2
	ISZ CMOV3
	JMP CMOVB	/LOOP
CMOVA,	CDF
	JMS I ST1OPN	/OPEN 3RD PASS FILE
	DCA I CMOV4	/NO 3RD PASS
	TAD I ST1OBL	/GET FILE START
CSWIT2,	CLA		/"DCA BINSRT" IF /C
	TAD PTPSW1
	DCA I EN2PTP	/RESET PAPERTAPE SWITCH
	TAD DIRSW1
	DCA I EN2DIR	/RESET DIRECTORY SWITCH
	JMS I PIOPEN
	JMP I .+1
	LOADOV		/OVERLAY THIS AREA WITH PASS3 CODE

PIOPEN,	IOPEN
DIRSW1,	TAD [177
PTPSW1,	TAD [232

CMOV1,	7605
CMOV2,	7600
CMOV3,	-12
CMOV4,	NSWITC
EN2CLS,	OCLOSE
EN2LSO,	LISOUT
EN2OU1,	OUTPT1
EN2PTP,	PTPSW
EN2DIR,	DIRSW
ST1OPN,	OOPEN
ST1OBL,	OUBLK
SWAPE2,	RELOC
	IFNZRO	ENDOVL-SWAPE2&4000 <OVLERR,__ERROR__>
	PAGE
	IFNZRO	HASH<

	/ONCE ONLY CODE TO HASH OUT THE PERMANENT SYMBOLS

HSHSMS,	0
	JMS I	(7607	/WRITE THE SYMBOL TABLE SORT OVERLAY
	4210		/2 PAGES FROM FIELD 1
	OUDEVH+400	/FROM HERE
	ASWAP+1		/TO HERE
	JMP I	(SYSERR/WONDERFUL.
	TAD I	(USROFS
	SZA CLA		/SZA IF KICKING OUT USR
	TAD	(12	/ELSE FUDGE POINTER
	TAD I	(HIFLD	/FIRST SET HASH TABLE SIZE
	TAD	PRIMES	/ACCORDING TO CORE SIZE
	DCA	PRIME
	TAD I	PRIME
	DCA	PRIME
	TAD	PRIME
	CIA
	DCA I	(MPRIME
	TAD I	(USROFS
	SZA CLA
	JMP	KPUSR	/JMP IF KEEPING USR
	CDF	10	/SERVE NOTICE WE'RE OCCUPYING FIELD 1
	AC7776
	AND I	(JSBITS
	DCA I	(JSBITS
	TAD	[7700
	DCA	IOMON	/AND POINT AT PROPER MONITOR E.P.
KPUSR,	CDF
	TAD I	(MPRIME	/HOW MANY SLOTS TO WIPE
	DCA	LAST3	/TO COUNTER
	TAD I	(USROFS
	CLL RTL
	TAD	(7777	/FUDGE THE INITIAL AUTO XR
	JMP	CLRGO	/INTO THE LOOP NOW
CLRLUP,	TAD	LAST1
	TAD	(-7577
	SZA CLA		/SZA IF NEED TO DO NEXT FIELD
	JMP	CLCDF0+1/ELSE CLEAR ANOTHER
	TAD	(10
	TAD	CLCDF0
	DCA	CLCDF0	/CDF INSTR GETS BUMPED
	STA
CLRGO,	DCA	LAST1	/XRGETS SET
CLCDF0,	CDF	10	/INITIALLY CDF 10
	DCA I	LAST1
	DCA I	LAST1
	DCA I	LAST1
	DCA I	LAST1
	ISZ	LAST3	/SKP IF NO MORE
	JMP	CLRLUP	/ELSE DO ANOTHER
	CDF		/THE TABLE IS CLEAN
	TAD	(HSHRTN
	DCA I	[GETTAG
	STA
	DCA	HIGHTG	/HIGHTG=CURRENT SYMBOL INDEX
	TAD	(SYMS+3	/USE THESE AUTO XR'S NOW
	DCA	LAST1
	TAD	LAST1
	DCA	LAST2
HSHLP,	TAD I	LAST1
	AND	[1777	/FIRST, STRIP THE TYPE BITS
	DCA I	(NAME1
	AC3777
	AND I	LAST1
	DCA I	(NAME2
	AC3777
	AND I	LAST1
	DCA I	(NAME3
	ISZ	LAST1	/SKIP THE VALUE
	JMP I	(GETTGH	/GO FIND IT'S PLACE
HSHRTN,	CLA CLL
	TAD I	LAST2
	DCA I	(NAME1
	TAD I	LAST2
	DCA I	(NAME2
	TAD I	LAST2
	DCA I	(NAME3
	TAD I	LAST2
	DCA	VALUE2
	JMS I	(INSRTG	/AND STORE IT
	TAD	LAST1
	TAD	(1-SYME+4
	SZA CLA
	JMP	HSHLP	/LOOP IF MORE TO GO
	JMP I	HSHSMS	/--RETURN--

PRIMES,	.
	1737	/1 FIELD
	3673	/2 FIELDS
	5633	/3 FIELDS
	7577	/4 FIELDS
	7775	/5 FIELDS (THE LAST MOSTELY WASTE)
	BPRIMES=.-1	/ALTERNATE TABLE SIZE FOR BATCH COMPATABILITY
	1737	/1 FIELD (MEANS NO BATCH)
	3133	/2 FIELDS
	5075	/3 FIELDS
	7035	/4 FIELDS
	7775	/5 FIELDS (SOME OF WASTE FOR BATCH)

	1335	/STILL ANOTHER ALTERNATE SET IF KEEPING USR
	3273
	5237
	7175
	7775

	0
	2535
	4465
	6437
	7775

	PAGE
	>
/**************************************************************
/PAGE 0 LITERALS
/**************************************************************
	IFNZRO	HASH<

	/SYMBOL TABLE SORT OVERLAY
	/ONLY SWAPPED IF TABLE WILL BE LISTED

	/FIRST, SOME EQUATES

	PPUTTAG=	[PUTTAG
	PFINDTG=	[FINDTG
	O1777=		[1777
	O7774=		[7774

	SXR=	XREG1
	TXR=	XREG2
	SXR2=	LAST1
	TXR2=	LAST2
	UXR=	LAST3
	DXR=	LAST4

	BEG=	LOC
	END=	OFFSET
	LO=	OFSBUF
	HI=	STARSW
	MED=	OP

	FIELD 1		/SET THE FIELD NOW
	*OUDEVH+400	/IT GOES HERE

SORTAB,	0		/FIRST LOC IN PAGE
	TAD	TAGMAX
	CIA
	DCA	TEMP	/TEMP=#CELLS TO SCAN

	/DEFLATE TABLE PRIOR TO SORTING AND LISTING IT
	/OUT WITH EMPTIES AND PERMANENTS

	DCA	HIGHTG	/TARGET POINTER
	DCA	TEMP2	/SOURCE POINTER
DEFLP,	TAD	TEMP2
	DCA	THISTG
	JMS I	PFINDTG	/GET THE NEXT STAB CELL
	TAD	TAG1
	CLL RAL
	SNA SZL CLA	/AND THERE BUT NOT FIXED?
	JMP	DEFNUL	/NO, DON'T STORE IT
	TAD	O1777	/YES,DISCARD THE TYPE BITS NOW
	AND	TAG1
	DCA	TAG1
	AC3777
	AND	TAG2
	DCA	TAG2
	AC3777
	AND	TAG3
	DCA	TAG3
	TAD	HIGHTG
	DCA	THISTG
	JMS I	PPUTTAG
	ISZ	HIGHTG
DEFNUL,	ISZ	TEMP2
	ISZ	TEMP	/TRY AGAIN
	JMP	DEFLP
	JMS I	(SORT	/NOW SORT THEM
	JMP I	SORTAB	/EXIT TO PRTSTAB
	/MOVE A SYMBOL THRU THE TABLE

SMOV,	0
	TAD	SXR2	/GET SOURCE DF+XREG
	JMS	GETFLD
	DCA	SMVCD1
	TAD	TXR
	DCA	SXR
	TAD	TXR2
	JMS	GETFLD
	DCA	SMVCD2
	TAD	O7774
	DCA	SSWT
SMVCD1,	0
	TAD I	SXR
SMVCD2,	0
	DCA I	TXR
	ISZ	SSWT
	JMP	SMVCD1
SMVCD0,	CDF
	JMP I	SMOV

	/AUXILLIARY FIELD+XREG SETTER

GETFLD,	0
	CLL
	TAD I	(USROFS	/IF KEEPING USR
	DCA	TXR	/AC=SYM NUM
	DCA	SMVCD2
	TAD	TXR
	ISZ	SMVCD2
	CML
	TAD	(-1740
	SNL
	JMP	.-4
	CLL RTL
	TAD	(-202	/SETS AS IN SETFLD...
	DCA	TXR	/TENTATIVELY SET TXR
	TAD	SMVCD2
	CLL RTL
	RAL
	TAD	SMVCD0
	JMP I	GETFLD	/EXIT WITH AC SET TO CDF INSTR
	/ROUTINE TO EXCHANGE SYMBOLS LO AND HI

SSWT,	0
	TAD	HI
	JMS	GETFLD
	DCA	SWCDF1
	TAD	SWCDF1
	DCA	SWCDF3
	TAD	TXR
	DCA	SXR
	TAD	SXR
	DCA	SXR2	/SXR'S FOR HIGH SYMBOL
	TAD	LO
	JMS	GETFLD
	DCA	SWCDF2
	TAD	TXR
	DCA	TXR2	/TXR'S FOR LOW SYMBOL
	TAD	O7774
	DCA	SMOV	/COUNTER

SWCDF1,	0
	TAD I	SXR	/GET HI SYM WORD
	DCA	GETFLD	/HOLD IT
SWCDF2,	0
	TAD I	TXR	/GET LO
	DCA	SCOM	/HOLD IT
	TAD	GETFLD
	DCA I	TXR2	/STORE  HI IN LOW
SWCDF3,	0
	TAD	SCOM	/NOW STORE LO
	DCA I	SXR2	/IN HI
	ISZ	SMOV
	JMP	SWCDF1+1
	CDF
	JMP I	SSWT
	/COMPARE SYMBOLS + SET LINK THEREBY

SCOM,	0
	DCA	THISTG	/AC=TAG #
	JMS I	(SETFLD
	TAD I	TAGXR
	CLL CIA
	TAD	TAG1
	SZA CLA
	JMP	SCOMRT
	TAD I	TAGXR
	CLL CIA
	TAD	TAG2
	SZA CLA
	JMP	SCOMRT
	TAD I	TAGXR
	CLL CIA
	TAD	TAG3
	SNA CLA
	HLT	/NEVER
SCOMRT,	CDF
	JMP I	SCOM

	PAGE








	/SORT ROUTINE HERE

SORT,	0
	DCA	BEG	/INITIALIZE PARTITION BOUNDS
	STA STL
	TAD	HIGHTG
	DCA	END	/ARE THERE ANY SYMBOLS?
	SZL
	JMP I	SORT	/NO EXIT WITH LINK SET
	TAD	(LITBF1-1+26	/OK, SET STACK NOW
	DCA	DXR
	TAD	DXR
	DCA	UXR

SLOOP,	STA
	TAD	LEVEL
	DCA	LEVEL
SLOOP2,	TAD	BEG
	STL CIA
	TAD	END
	SNA SZL
	JMP	OKCOOL	/END.LOS.BEG
	CLL RAR
	TAD	BEG
	DCA	MED	/MED=BEG+(END-BEG)/2
	TAD	MED
	DCA	THISTG
	JMS I	PFINDTG	/T=A(MED)
	TAD	BEG
	DCA	LO	/LO=BEG
	TAD	END
	DCA	HI	/HI=END
	TAD	MED
	CIA
	TAD	BEG
	SNA CLA
	JMP	JUSTWO	/BEG.EQ.MED
	TAD	LO
	DCA	SXR2
	TAD	MED
	DCA	TXR2
	JMS I	(SMOV	/A(MED)=A(LO)
BEGLP,	ISZ	LO
	TAD	LO
	CLL CIA
	TAD	HI
	SNL CLA
	JMP	DONE	/HI.LOS.LO
	TAD	LO
	JMS I	(SCOM	/T.GT.A(LO) TO LINK
	SZL CLA
	JMP	BEGLP	/T.GT.A(LO)
	JMP	ENDGO	/T.LT.A(LO)
ENDLP,	TAD	LO
	CLL CIA
	TAD	HI
	SNL CLA
	JMP	DONE	/IF HI.LO.LO
ENDGO,	TAD	HI
	JMS I	(SCOM
	SZL CLA
	JMP	SWITCH
	STA
	TAD	HI
	DCA	HI
	JMP	ENDLP
SWITCH,	JMS I	(SSWT
	STA
	TAD	HI
	DCA	HI
	JMP	BEGLP
DONE,	TAD	HI
	DCA	SXR2
	TAD	BEG
	DCA	TXR2
	JMS I	(SMOV	/A(BEG)=A(HI)
	TAD	HI
	DCA	THISTG
	JMS I	PPUTTAG	/A(HI)=T
	AC7776
	TAD	UXR
	DCA	UXR
	TAD	UXR
	DCA	DXR
	TAD	HI
	CLL CIA
	TAD	MED
	SZL CLA
	JMP	HIBIGR	/DEFER HIGH FOR LATER
	TAD	BEG
	DCA I	DXR	/DEFER LO FOR LATER
	STA
	TAD	HI
	DCA I	DXR
	TAD	HI
	IAC
	DCA	BEG
	JMP	SLOOP
HIBIGR,	TAD	HI
	IAC
	DCA I	DXR
	TAD	END
	DCA I	DXR
	STA
	TAD	LEVEL	/CLUMSY
	DCA	LEVEL
	CLL STA
	TAD	HI
	DCA	END
	SNL		/PROTECT AGAINST WRAP AROUND
	JMP	OKCOOL
	JMP	SLOOP2

JUSTWO,	TAD	HI
	JMS I	(SCOM
	SZL CLA
	JMS I	(SSWT	/SWITCH IF T.GT.A(HI)
OKCOOL,	CLA CLL		/NOW CONSIDER PREV PARTITIONS
	TAD I	UXR
	DCA	BEG
	TAD I UXR
	DCA	END
	ISZ	LEVEL
	JMP	SLOOP2	/REITERATE
	JMP I	SORT	/DONE, RETURN WITH A CLEAR LINK
LEVEL,	0
	PAGE
	>
	/ROUTINE TO STORE THE DATE OF THE FORM DD-MMM-YY
	/IN THE HEADING

	IFZERO	HASH	<
	FIELD	1
	*OUDEVH+400
	>

FMTDAT,	0
	TAD I	(MDATE	/PICK UP THE DATE WORD OF THE FORM MMM MDD DDD YYY
	CDF		/RUN WITH DF = 0
	SNA
	JMP	NODATE	/EXIT IF NO DATE
	DCA	DATWD	/ELSE STORE DATE WORD
	TAD	("0-1
	DCA I	DATPTR	/SET FIRST DIGIT OF DAY
	TAD	DATWD	/NOW GET DAY BITS
	CLL RTR
	RAR
	AND	(37
	JMS	DIV10	/DO DAY DIGITS NOW
	TAD	("-
	DCA I	DATPTR	/STORE DASH
	ISZ	DATPTR
	TAD	DATWD	/NOW GET MONTH BITS
	TAD	(7400	/REDUCE TO ORIGIN 0
	AND	(7400
	CLL RTL
	RTL
	RAL
	DCA	DIV10
	TAD	DIV10
	CLL RAR		/GENERATE 1.5*MONTH INDEX
	TAD	DIV10
	TAD	(MONLST	/INDEX MONTH LIST (SIXBIT)
	DCA	MONPTR
	TAD	(-3
	DCA	DIV10	/SET 3 TIMES THRU LOOP
	SZL
	JMP	MONGO	/IF EVEN START AT RIGHT HALF
MONLP,	TAD I	MONPTR
	CLL RTR
	RTR
	RTR
	JMS	MONPUT	/PUT LEFT CHAR
MONGO,	TAD I	MONPTR
	JMS	MONPUT	/PUT RIGHT CHAR
	ISZ	MONPTR
	JMP	MONLP	/LOOP FOR MORE
MONPUT,	0
	TAD	(40
	AND	(77
	TAD	(40	/CONVERT TO 7BIT
	DCA I	DATPTR
	ISZ	DATPTR
	ISZ	DIV10
	JMP I	MONPUT	/RETURN TO UNPACK LOOP
	TAD	("-
	DCA I	DATPTR	/PUT ANOTHER DASH
	ISZ	DATPTR
	TAD	("6
	DCA I	DATPTR	/SETUP YEAR TENS DIGIT FOR DIVIDE
	TAD I	(BIPCCL
	AND	(600	/GET YEAR EXTENSION FROM 600 BITS
	CLL RTR
	RTR
	DCA	DIV10
	TAD	DATWD	/NOW GET YEAR
	AND	(7	/ISOLATE IT
	TAD	DIV10	/ADD EXTENSION
	JMS	DIV10	/UNPACK IT
NODATE,	CIF CDF		/NOW RETURN
	JMP I	FMTDAT

DIV10,	0
	ISZ I	DATPTR
	TAD	(-12
	SMA
	JMP	.-3	/REDUCE MON 10.
	TAD	(12+"0
	ISZ	DATPTR
	DCA I	DATPTR	/STORE LOW DIGIT
	ISZ	DATPTR
	JMP I	DIV10	/--RETURN--

DATPTR,	DATE
DATWD,	0
MONPTR,	0

	PAGE

	$$$$$

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/PIP.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265

/3 PIP FOR OS/8 MONITOR
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1970,1971,1972,1973,1974,1975,1977
/BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/	4-MAY-1977	FILE: PIP.PA	OS/8 VERSION 14A
/RL/EF/ET.AL./S.R./E.S.



/ABSTRACT----
/PIP (PERIPHERAL INTERCHANGE PROGRAM) IS A GENERAL FILE
/MANIPULATION PROGRAM FOR THE OS/8 PROGRAMMING SYSTEM.
/PIP ACCOMPLISHES DATA TRANSFERS BETWEEN ANY DEVICES IN THE OS/8
/CONFIGURATION.


/VERSION 3 MODS:

/FIXED PROBLEM WITH ONE-PAGE WRITE
/IN /S OR /Z, =OPTION IS TAKEN MODULO 100 (OCTAL)
/	WITH 100, 200, ETC. MEANING USE 0 ADDITIONAL WDS.
/DATES STILL DON'T LINE UP
/'0 FREE BLOCKS'
/ALLOW FILLING UP DEVICE TO VERY LAST BLOCK
/ALLOW 7-BIT ^C
/ALTMODE ON CD LINE RETURNS TO MONITOR WHEN DONE
/NO HALT ON /L IF NO TTY HANDLER (ACTS AS NOP)
/ /V PRINTS VERSION NUMBER FIRST TIME CALLED
/ /O AFFIRMS /Y ON ZERO SYS OR ARE YOU SURE
/=NNNN ON /I OPTION SPECIFIES LENGTH TO CLOSE FILE


/MAINTENANCE RELEASE CHANGES:

/1.	FIXED LENGTH OF ALL VARIETIES OF RF08
/2.	ADDED RX01 TO INTERNAL LENGTH TABLES
/3.	CHANGED VERSION NUMBER TO V10
/4.	ADDED CHECK FOR 7-BIT CTRL/Z TO ASCII HANDLER

/E.S.	DISABLED /E,/F,/L
/E.S.	FIXED /Y OPTION PER SPR

/	DEVICE UPGRADE KIT CHANGES(V12C):
/	1.ADDED RX02 SUPPORT
/	2.ADDED /Y OPTION CHANGES TO SUPPORT NEW MONITOR

/DETAILS OF PIP:

/PIP RUNS WITH THE USR (USER SERVICE ROUTINES) ALWAYS IN CORE.
/THIS ELIMINATES SWAPPING THE MONITOR. IF ANY CHANGES ARE MADE
/TO PIP, CARE SHOULD BE TAKEN IN USING PAGE ZERO LOCATIONS, AS
/THEY MUST NOT DESTROY ANY MONITOR LOCATIONS.

/CORE USED:
/FIELD 0

/00000-02777-	OUTPUT BUFFER
/03000-06377-	INPUT BUFFER
/06400-06577-	USED FOR /Y COMMAND ONLY
/06600-07177-	INPUT HANDLER
/07200-07577-	OUTPUT HANDLER

/FIELD 1

/10000-11777-	OS/8 I/O MONITOR
/12000-16577-	EXECUTABLE CODE
/16600-17177-	HOLDS NEW DIRECTORY SEGMENT FOR /S OPTION
/17200-17577-	HOLDS OLD DIRECTORY SEGMENT IN /S OPTION


/MAJOR PIECES OF CODE AND THEIR FUNCTION (BRIEFLY).
/THIS IS A LIST OF ROUTINES AS THEY APPEAR PHYSICALLY, AND
/NOT AS THEY ARE LOGICALLY CONNECTED.

/ICHAR-		GENERAL CHARACTER INPUT ROUTINE. ASSIGNS NEW
/		DEVICE HANDLERS AS NEEDED.

/OOPEN-		ENTERS A FILE ON A SPECIFIED DEVICE.

/OUTDMP-	WRITES OUTPUT BUFFER TO OUTPUT DEVICE.

/OCLOSE-	CLOSES FILE CREATED BY OOPEN

/OCHAR-		CHARACTER OUTPUT ROUTINE. WRITES CHARACTERS
/		TO OUTPUT BUFFER, CALLING OUTDMP WHEN FULL.

/OTYPE-	USES DEVICE NUMBER IN OUTPUT AREA OF CD TO
/		INSPECT THE DEVICE CONTROL BLOCK WORD. THIS
/		GIVES A CODE FOR THE TYPE OF DEVICE.

/SLASHG-	HANDLES I/O ERRORS. IF /G IS SET, HARD I/O
/		ERRORS ARE IGNORED. IF /S AND /G ARE ON, A
/		SPECIAL RETURN IS TAKEN.

/IMAGE-		IMAGE MODE PROCESSOR FOR PIP.

/SQTRA-		MAIN SUBROUTINE OF IMAGE MODE, AND /S OPTION.

/PIP, PIP+1-	MAIN ENTRANCES TO PIP. THE CODE ON THIS PAGE
/		INSPECTS CD OPTION WORDS AND BRANCHES TO PROPER
/		ROUTINES.

/ASCII-		THE DEFAULT TRANSFER MODE IN PIP IS ASCII.

/DELETE-	DELETES FILES ON OUTPUT SIDE OF CD LIST.

/DZERO-		ZEROES DIRECTORY OF FIRST OUTPUT DEVICE.

/PIPERR-	ERROR ROUTINR FOR PIP.

/DIRPRE-	DIRECTORY PRINTING ROUTINE.

/BINARY-	BINARY MODE PROCESSOR. HANDLES ABSOLUTE AND
/		RELOCATABLE BINARY FILES.

/ERPRNT-	ERROR PRINTOUT.

/SQUISH-	FILE COMPRESSION PROCESSOR. ELIMINATES 'HOLES'
/		IN DIRECTORY OF INPUT DEVICE.

/SYSCOP-	SYSTEM COPY PROCESSOR. ALLOWS TRANSFER OF THE
/		OS/8 SYSTEM AREA.
/OPTIONS AVAILABLE IN PIP:

/A-	ASCII TRANSFER; DEFAULT MODE
/B-	BINARY MODE TANSFER
/C-	DELETE TRAILING BLANKS. (ASCII MODE)
/D-	DELETE FIRST OUTPUT FILE BEFORE PROCEEDING
/E-	LIST INPUT DIRECTORY INCLUDING EMPTY FILES
/F-	LIST INPUT DIRECTORY; ONLY FILE NAMES
/G-	IGNORE ERRORS WHILE TRANSFERING
/I-	IMAGE MODE TRANSFER
/L-	LIST INPUT DIRECTORY; EXCLUDE EMPTY FILES
/O-	OK TO PERFORM A SQUISH OR ZERO WITHOUT ASKING
/S-	COMPRESS INPUT DEVICE ONTO OUTPUT DEVICE. ELIMINATES
/	'HOLES' ON INPUT DEVICE.
/T-	PROVIDE SIMPLE TTY FORMATTING. (ASCII ONLY)
/Y-	COPY OS/8 SYSTEM AREA
/Z-	ZERO OUTPUT DEVICE DIRECTORY BEFORE PROCEEDING
/=N-	LEAVE N WORDS EXTRA PER DIRECTORY ENTR. VALID
/	ONLY WITH /S OR /Z.
/=N-	WITH /I OPTION CLOSES OUTPUT FILE WITH THIS LENGTH
/V	PRINTS VERSION # (FIRST TIME ONLY)

/COMMENTS ON THE PROGRAM:

	/SINCE PIP RUNS WITH USR IN CORE, NO PAGE ZERO LITERALS
	/CAN BE USED. THE LOCATIONS CURRENTLY USED IN
	/FIELD 1 ON PAGE ZERO ARE:

	OUTXR=10
	INXR=11
	TEMP1=12
	IHNDLR=24	/HOLDS INPUT HANDLER ADDRESS
	OHNDLR=25	/OUTPUT HANDLER ADDRESS
	SQFLAG=26	/'SQUISH INDICATOR
	OUWAST=27	/# WASTE WORDS ON OUTPUT
	OUTBLK=30
	OUDLEN=31
	SAME=32
	INBLK=33
	RECCNT=34

/CONSTANTS USED BY THE DIRECTORY PRINTOUT ROUTINE (OVERLAPPING) ARE:

	FLENGT=24
	BLOKNO=25
	DTYPE=27
	DCOUNT=30
	DLINK=31
	WASTE=32
	DDATE=33
	ECOUNT=35
	/PIP FOR OS/8 MONITOR
	/EQUIVALENCES FOR GENERAL CHARACTER I/O ROUTINES

	OUBUF=0	/MUST BE LOWER THAN INBUF
	OUCTL=5400	/OUTPUT BUFFER OF 3000 WORDS
	OUDEVH=7200	/PROVIDE ROOM FOR TWO-PAGE HANDLERS
	INBUF=3000
	INCTL=1600	/INPUT BUFFER OF 3400 WORDS
	INRECS=7
	INDEVH=6600

			/PAGE 6400 IS FREE, EXCEPT DURING /Y COMMAND

	/EQUIVALENCES NECESSARY TO INTERFACE WITH MONITOR
	DCB=7760
	MPARAM=7643	/CD PARAMETER AREA
	OLDDIR=7		/POINTER TO MONITOR VARIABLE "OLDT9"
	MTEMP=27	/MONITOR SCRATCH AREA ON "SYS" - ***VOLATILE***
	PTP=20	/INTERNAL TYPE CODE FOR PAPER TAPE PUNCH
	XR=10
	TEMP=20
	CHAR=21
	INFPTR=22
	INEOF=23

	ABUF=6601	/LINE BUFFER - 150 CHARACTERS LONG
	SQBUF1=6600	/DIRECTORY BUFFER FOR "SQUISH" OPTION
	SQBUF2=7200	/""

	FIELD 1

/TO ENABLE /E,/F,/L SET
/OS78=0

/TO DISABLE /E,/F,/L
IFNDEF OS78 <OS78=1>

	/GENERAL CHARACTER I/O ROUTINES FOR BLEEP
	/CALLED AS FOLLOWS:

	/JMS I (IOPEN		INITIALIZES THE INPUT ROUTINE

	/JMS I (ICHAR		READS A CHARACTER
	/ERROR RETURN		/AC>0 IF END OF FILE, AC<0 IF READ ERROR

	/JMS I (OOPEN		INITIALIZES THE OUTPUT ROUTINE
	/ERROR RETURN		AC>0 IF NO OUTPUT DEVICE/FILE, AC<0 IF ERROR

	/JMS I (OCHAR		OUTPUTS A CHARACTER
	/ERROR RETURN		OUTPUT ERROR OR TOO MUCH OUTPUT

	/JMS I (OCLOSE		CLOSES THE OUTPUT FILE
	/ERROR RETURN		FILE TOO LARGE TO BE CLOSED OR OUTPUT ERROR

	/JMS I (OTYPE		RETURNS DCB WORD OF OUTPUT DEVICE IN AC



	/PARAMETERS NEEDED:

	/INBUF=		ADDRESS OF INPUT BUFFER
	/INCTL=		INPUT BUFFER CONTROL WORD
	/OUBUF=		ADDRESS OF OUTPUT BUFFER
	/OUCTL=		OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE)
	/INRECS=	[INCTL/256]
	/INDEVH=	ADDRESS OF PAGE FOR INPUT HANDLER
	/OUDEVH=	ADDRESS OF PAGE FOR OUTPUT HANDLER

	/ASSUMES I/O MONITOR IS RESIDENT IN CORE.
	/CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD.
	INFLD=INCTL&70	/GET FIELD OF INPUT BUFFER
	OUFLD=OUCTL&70	/DITTO OUTPUT BUFFER

	*2000

IN7400,	7400
IOPEN,	0
	CLA CMA
	DCA INCHCT	/SET INCHCT TO FORCE A READ
	ISZ INEOF	/SET END-OF-FILE FLAG TO FORCE A NEW FILE
	TAD (7617
	DCA INFPTR	/RESET FILE POINTER
	RDF
	TAD INCDIF
	DCA .+1
INPTR,	HLT		/RESTORE CALLING FIELDS
	JMP I IOPEN

ICHAR,	0
IN7600,	7600
	RDF
	TAD INCDIF
	DCA INRTRN	/SAVE CALLING FIELDS
INCHAR,	CDF INFLD
	ISZ INJMP	/BUMP THREE-WAY UNPACK SWITCH
	ISZ INCHCT
INJMPP,	JMP INJMP
	TAD INEOF
	SNA CLA		/DID LAST READ YIELD END-OF-FILE?
	JMP INGBUF	/NO - DO ANOTHER
GETNEW,	JMS INNEWF	/OPEN A NEW INPUT FILE
	JMP EOFERR	/NO FILE TO OPEN
INGBUF,	TAD INCTR
	CLL
	TAD (INRECS
	SNL
	DCA INCTR	/RESTORE INCTR IF IT HASN'T OVERFLOWED
	SZL		/IS THIS THE LAST READ?
	ISZ INEOF	/YES - SET END-OF-FILE FLAG
			/NOT END-OF-FILE IF INPUT DEVICE
			/IS NON-FILE STRUCTURED!
	CLL CML CMA RTR	/CONSTRUCT A CONTROL WORD FOR THE READ
	RTR		/FROM THE AMOUNT OF THE OVERFLOW
	RTR		/(IF ANY) AND THE STANDARD CONTROL WORD
	TAD (INCTL+1
	DCA INCTLW
INCDIF,	CDF CIF 0
	CDF 10
	JMS I INHNDL	/CALL THE DEVICE HANDLER
INCTLW,	0
INBUFP,	INBUF
INREC,	0
	JMS I (SLASHG	/A HANDLER ERROR - SHOULD WE IGNORE?
	INERRX-.	/ADDRESS IF NOT
INBREC,	TAD INREC
	TAD (INRECS
	DCA INREC	/UPDATE THE RECORD NUMBER
	TAD INCTLW
	AND IN7600
	CLL RAL
	TAD INCTLW
	AND IN7600
	CMA
	DCA INCHCT	/COMPUTE THE NEW CHARACTER COUNT
	TAD INJMPP
	DCA INJMP	/RESET THE CHARACTER SWITCH
	TAD INBUFP
	DCA INPTR	/AND THE WORD POINTER
	JMP INCHAR	/GO BACK AND MAKE BELIEVE THIS NEVER HAPPENED
INERRX,	ISZ INEOF	/EITHER AN END-OF-FILE OR A BADDIE
	SMA CLA		/WHICH TYPE WAS IT?
	JMP INBREC	/END OF FILE - RESUME THY PROCESSING
INERR,	CLA CLL CML RAR	/BADDIE - GIVE ERROR RETURN WITH NEGATIVE AC
EOFERR,	JMP INRTRN
INJMP,	HLT		/THIS IS THE THREE - WAY CHARACTER SWITCH
	JMP ICHAR1
	JMP ICHAR2
ICHAR3,	TAD INJMPP
	DCA INJMP
	TAD I INPTR
IN200,	AND IN7400
	CLL RTR
	RTR		/COMBINE THE HIGH-ORDER FOUR BITS OF
	TAD INCTLW
	RTR		/THE TWO WORD TO FORM THE THIRD CHARACTER
	RTR
	ISZ INPTR
	JMP INCOMN
ICHAR2,	TAD I INPTR
	AND IN7400
	DCA INCTLW	/SAVE THE HIGH-ORDER BITS FOR THE THIRD CHAR
	ISZ INPTR	/BUMP THE WORD POINTER
ICHAR1,	TAD I INPTR
INCOMN,	AND (377
	TAD (-232
INCTZF,	SNA		/IS THE CHARACTER A ^Z?
	JMP GETNEW	/YES - GET A NEW FILE
	TAD (232	/RESTORE THE CHARACTER
	ISZ ICHAR	/BUMP RETURN TO NORMAL RETURN
INRTRN,	0		/RESTORE CALLING FIELDS
	JMP I ICHAR	/AND RETURN
			/IOPEN IS UNNECESSARY.
INNEWF,	-1		/ROUTINE TO OPEN NEW INPUT FILE
	INCHCT=INNEWF
	CDF 10
	TAD (INDEVH+1
	DCA INHNDL	/INITIALIZE HANDLER ADDRESS
	TAD I INFPTR	/GET NEXT CD INPUT FILE ENTRY
	SNA		/ANY MORE?
	JMP I INNEWF	/NO - OUT OF INPUT
	JMS I IN200
	1		/ASSIGN, FETCH HANDLER
INHNDL,	0
	HLT		/HUH?
	TAD I INFPTR
	AND (7760	/GET LENGTH PART OF WORD
	SZA		/LENGTH OF 0 MEANS LENGTH >=256
	TAD (17		/ADD HIGH-ORDER BITS
	CLL CML RTR
	RTR
	DCA INCTR	/STORE LENGTH OF FILE
	ISZ INFPTR
	TAD I INFPTR
	DCA INREC	/STORE STARTING RECORD NUMBER OF FILE
	ISZ INFPTR
	DCA INEOF	/ZERO END-OF-FILE FLAG
	ISZ INNEWF
	JMP I INNEWF
	INCTR=IOPEN
	PAGE
OOPEN,	0		/OPEN OUTPUT FILE
OU7600,	7600
/	RDF
/	TAD OUCDIF
/	DCA OORETN
	TAD OU7601
	DCA OUBLK
	TAD (OUDEVH+1
	DCA OUHNDL
	CDF 10
	TAD I OU7600	/GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
	AND (17		/STRIP OFF ANY LENGTH INFO
	SNA		/IS THERE AN OUTPUT DEVICE?
	JMP ONOFIL	/NO - INHIBIT OUTPUT
	JMS I (200
	1		/ASSIGN, FETCH HANDLER
OUHNDL,	0		/OUTPUT DEVICE HANDLER ENTRY
	HLT		/HUH?
OUENTR,	TAD I OU7600
	JMS I (200
	3		/ENTER OUTPUT FILE
OUBLK,	7601		/REPLACED WITH STARTING BLOCK
OUELEN,	0		/REPLACED WITH LENGTH OF HOLE
	JMP OEFAIL	/FAILED - MAYBE WE ASKED TOO MUCH
	DCA OUCCNT
	DCA I (OUTINH	/ZERO OUTPUT INHIBIT FLAG
	JMS I (OUSETP
	ISZ OOPEN
OORETN,	CDF CIF 10	/RESTORE CALLING FIELDS
	JMP I OOPEN
OEFAIL,	TAD I OU7600
	AND (7760	/GET REQUESTED LENGTH
	SNA CLA		/WAS IT AN INDEFINITE REQUEST
	JMP ONTERR	/YES - CANNOT ENTER THE FILE
	TAD I OU7600
	AND (17		/MAKE THE REQUESTED LENGTH ZERO
	DCA I OU7600
	JMP OUENTR	/TRY, TRY AGAIN
ONTERR,	CLA CLL CML RAR
	JMP OORETN	/TAKE THE ERROR RETURN WITH AC<0
ONOFIL,	ISZ I (OUTINH
	JMP OORETN	/TAKE THE ERROR RETURN WITH AC=0
OUTDMP,	0
	DCA OUCTLW	/STORE THE CONTROL WORD
	CDF 10
	TAD I (OUTINH
	SZA CLA
	JMP OUNOWR
	TAD OUCCNT
	SNA
	ISZ OUCTLW
	TAD OUBLK
	DCA OUREC	/COMPUTE THE STARTING BLOCK NUMBER OF THIS TRANSFER
	TAD OUCTLW
	CLL RTL
	RTL
	RTL
	AND (17		/COMPUTE THE NUMBER OF RECORDS
	TAD OUCCNT	/UPDATE THE NUMBER OF BLOCKS IN THE FILE
	DCA OUCCNT
	TAD OUCCNT
	CLL CML
	TAD OUELEN
	SNL SZA CLA	/DOES THE LENGTH EXCEED THE GIVEN LENGTH?
	JMP I OUTDMP	/YES - SIGNAL OUTPUT ERROR
OUCDIF,	CDF CIF 0
	CDF 10
	JMS I OUHNDL
OUCTLW,	0
	OUBUF
OUREC,	0
	JMS I (SLASHG
	.+2-.
OUNOWR,	ISZ OUTDMP	/BUMP OUTDMP TO NORMAL RETURN
	JMP I OUTDMP
OCLOSE,	0
	CDF 10
	TAD I (OUTINH
	SZA CLA		/IS OUTPUT INHIBITED?
	JMP OCISZ	/YES - CLOSE IS A NOP
	JMS I (OTYPE
	AND (770
	TAD (-PTP	/CHECK FOR PAPER TAPE PUNCH OUTPUT
	SZA CLA		/AND SKIP ^Z OUTPUT IF TRUE
	TAD (232	/OUTPUT A ^Z
	JMS I (OCHAR
	JMP OCRET
	JMS I (OCHAR
	JMP OCRET
FILLLP,	JMS I (OCHAR
	JMP OCRET
	JMS I (OTYPE	/GET TYPE OF OUTPUT DEVICE
	SPA CLA
	TAD (100	/IF ITS A DIRECTORY DEVICE FORCE A RECORD
	TAD (77		/BOUNDARY - OTHERWISE A HALF-RECORD
	AND I (OUDWCT
	SZA CLA		/UP TO THE BOUNDARY YET?
	JMP FILLLP	/NO - FILL WITH ZEROS
	TAD I (OUDWCT	/GET DOUBLEWORD COUNT LEFT
	TAD (OUCTL&3700
	SNA		/A FULL WRITE LEFT?
	JMP NODUMP	/YES - DON'T DO IT - THE ^Z IS ALREADY OUT
	TAD (4000+OUFLD	/PUT IN THE FIELD BITS AND THE WRITE BIT
	JMS OUTDMP
	JMP OCRET	/AN ERROR OCCURRED WHILE DUMPING THE BUFFER
NODUMP,	TAD I OU7600	/GET THE DEVICE NUMBER
	JMS I (200
	4		/CLOSE THE OUTPUT FILE
OU7601,	7601		/POINTER TO THE OUTPUT FILE NAME
OUCCNT,	0
	SKP		/ERROR WHILE CLOSING THE FILE - BAD!
OCISZ,	ISZ OCLOSE
OCRET,	CDF CIF 10	/RESTORE CALLING FIELDS
	JMP I OCLOSE
	PAGE
OUSETP,	0		/ROUTINE TO INITIALIZE CHARACTER POINTERS
	TAD (OUCTL&3700	/GET SIZE OF BUFFER IN DOUBLEWORDS
	CIA		/PAL10 IS DEFINITELY NOT NICE
	DCA OUDWCT
/	TAD (OUBUF
	IFNZRO OUBUF <ERROR!>	/V3
	DCA OUPTR	/INITIALIZE WORD POINTER
	TAD OUJMPE
	DCA OUJMP	/INITIALIZE THREE-WAY CHARACTER SWITCH
	JMP I OUSETP

OCHAR,	0
	AND (377
	DCA OUTEMP
	RDF
	TAD (CDF CIF 0
	DCA OUCRET
	TAD OUTINH
	SZA CLA		/IS THERE AN OUTPUT FILE?
	JMP OUCOMN	/NO - EXIT
OUCHAR,	CDF OUFLD	/SET DATA FIELD TO BUFFER'S FIELD
	ISZ OUJMP	/BUMP THE CHARACTER SWITCH
OUJMP,	HLT		/THREE WAY CHARACTER SWITCH
	JMP OCHAR1
	JMP OCHAR2
OCHAR3,	TAD OUTEMP
	CLL RTL
	RTL
	AND (7400
	TAD I OUPOLD
	DCA I OUPOLD	/UPDATE FIRST WORD OF TWO WITH HIGH
			/ORDER 4 BITS OF THIRD CHAR
	TAD OUTEMP
	CLL RTR
	RTR
	RAR
	AND (7400
	TAD I OUPTR
	DCA I OUPTR	/UPDATE SECOND WORD FROM LOW ORDER 4 BITS
	TAD OUJMPE
	DCA OUJMP	/RESET SWITCH
	ISZ OUPTR
	ISZ OUDWCT	/BUMP DOUBLEWORD COUNTER EVERY 3 CHARS
	JMP OUCOMN
	TAD (OUCTL	/LOAD CONTROL WORD FOR A FULL WRITE
	JMS I (OUTDMP	/DUMP THE BUFFER
	JMP OUCRET	/OUTPUT ERROR - GIVE ERROR RETURN
	JMS OUSETP	/RE-INITIALIZE THE POINTERS
	JMP OUCOMN
OCHAR2,	TAD OUPTR
	DCA OUPOLD	/SAVE POINTER TO FIRST WORD OF TWO
	ISZ OUPTR	/BUMP WORD POINTER TO SECOND WORD
OCHAR1,	TAD OUTEMP
	DCA I OUPTR
OUCOMN,	ISZ OCHAR
OUCRET,	HLT		/RESTORE CALLING FIELDS
	JMP I OCHAR
OUTEMP,	0
OUPOLD,	0
OUPTR,	0
OUJMPE,	JMP OUJMP
OUDWCT,	0
OUTINH,	0
OTYPE,	0
	RDF
	TAD (CDF CIF 0
	DCA OTRTN
	CDF 10
	TAD I (7600
	AND (17
	TAD (DCB-1
	DCA OUTEMP
	TAD I OUTEMP
OTRTN,	HLT
	JMP I OTYPE
CTCTST,	0
	TAD (200	/V3
	KRS
	TAD (-203
	SNA CLA		/IS THE TELETYPE BUFFER A ^C
	KSF		/WITH THE TELETYPE FLAG ON?
	JMP I CTCTST	/NO
LEAVE,	CDF CIF 0	/YES - GO TO MONITOR
	JMP I (7600	/THROUGH THE "SAVE CORE" RETURN

SLASHG,	0
	DCA CTCTST
	TAD SQFLAG
	SZA CLA		/ARE WE SQUISHING?
	JMP I (SQIOER	/YES
	TAD CTCTST
	SPA CLA		/ONLY IGNORE HARD ERRORS
	TAD I (MPARAM
	AND (40
	SZA CLA		/ "G" SWITCH
SLGRET,	JMP I SLASHG	/IGNORED!
	TAD I SLASHG
	TAD SLASHG
	DCA SLASHG	/SET UP NON-IGNORE ADDRESS
	TAD CTCTST
	JMP I SLASHG	/RETURN WITH AC RESTORED


	IFZERO OS78 <
DIR,	DCA DTYPE	/SAVE TYPE OF REQUEST
	TAD I (7600
	SZA CLA		/IS THERE AN OUTPUT FILE?
	JMP I (DIRPRE	/YES
	DCA TTYDEV+1
	JMS I (200
	12		/ASSIGN WITHOUT FETCH
TTYDEV,	5524		/COMPRESSED CODE FOR "TTY"
	0
	0
	JMP I (PIP	/V3 WHAT - NO TELETYPE!
	TAD TTYDEV+1
	DCA I (7600
	JMP I (DIRPRE
	>

	IFNZRO OS78 <
DIR,	JMS I	(PIPERR	/TYPE OUT MESSAGE
	14
DIRMSG,	TEXT	"USE DIRECT"
	>

	PAGE
	/PIP PROPER BEGINS HERE
	/**********************

	/IMAGE MODE PROCESSOR FOR PIP

IMAGE,	JMS I (FIXLEN
	JMS I (OUTOPN
	JMS IMTRA
IMCLOS,	TAD I (OUTINH
	SZA CLA		/WAS THERE AN OUTPUT FILE?
	JMP I (PIPCLR	/NO - DON'T CLOSE IT
	JMS I (OUK	/GET THE LENGTH OF THE OUTPUT FILE
	DCA IMCCNT
	TAD I IM7600
	JMS I (200
	4		/CLOSE
	7601		/FILE NAME
IMCCNT,	0
	JMP I (AOUERR
	JMP I (PIPCLR

ENDFUJ,	0		/PART OF DIRECTORY PRINTING ROUTINE
	JMS I (PRNUM
	TAD (-6
	JMS I (PRWD	/PRINT SIX WORDS
	0006		/ F
	2205		/RE
	0500		/E 
	0214		/BL
	1703		/OC
	1323		/KS
	JMS I (PCRLF
	JMS I (PCRLF	/LEAVE A SPACE BETWEEN DIRECTORIES
	ISZ INEOF	/SIMULATE "END OF FILE" FOR INPUT ROUTINE
	CLA CMA
	DCA I (INCHCT	/AS WELL AS "END OF BUFFER"
	JMP I ENDFUJ
IMHNDL,			/V3
SQTRA,	0
	TAD SQTRA
	DCA IMTRA	/FAKE A CALL TO "IMTRA"
	TAD RECCNT	/SETTING UP THE ARGS TO DO THE SQUISHING FOR US
	DCA I (INCTR
	TAD IHNDLR
	DCA IMHNDL
	TAD INBLK
	DCA IMREC
	TAD OUTBLK
	DCA I (OUCCNT
	DCA INEOF
	JMP IMRCLP

IMTRA,	0
	JMS I (IOPEN	/INITIALIZE INPUT ROUTINE
AGAIN,	TAD INEOF	/IOPEN ALWAYS SETS INEOF
	SNA CLA		/KEEP READING?
	JMP IMRCLP	/YES
			/NO, OPEN NEXT FILE
IMFILP,	JMS I (INNEWF	/SET UP PARAMS FOR NEXT FILE
	JMP I IMTRA	/NO NEXT FILE
	TAD I (INHNDL
	DCA IMHNDL	/GET DEVICE HANDLER ENTRY
	TAD I (INREC
	DCA IMREC	/AND STARTING BLOCK NUMBER
IMRCLP,	TAD I (INCTR
	CLL
	TAD (15
	SNL		/IF LINK IS ON, THERE ARE LESS THAN 16 BLOCKS LEFT
	DCA I (INCTR
	SZL
	ISZ INEOF
	CLL CML CMA RTR
	RTR
	RTR
	TAD (3201	/FORM A FULL OR PARTIAL READ CONTROL WORD
	DCA IMCTLW
	JMS I (CTCTST	/CHECK FOR ^C
	CIF 0
	JMS I IMHNDL
IMCTLW,	0
	OUBUF
IMREC,	0
	JMS I (SLASHG
	IMERRX-.
	TAD IMREC
	TAD (15
	DCA IMREC	/UPDATE BLOCK NUMBER
	CLA CLL CML RAR
	TAD IMCTLW
IMOUT,	JMS I (OUTDMP	/WRITE OUT WHAT WE JUST READ IN
	JMP I (AOUERR	/WRITE ERROR - BAD!
	JMP AGAIN	/V3
IMERRX,	ISZ INEOF	/SIGNAL EOF OR WORSE
	SPA CLA		/WHICH ONE IS IT?
	JMP IM7600
	TAD (6377	/MARCH DOWN THROUGH CORE
IMEFLP,	DCA CHAR	/LOOKING FOR THE FIRST NON-ZERO WORD
	CDF 0
	TAD I CHAR
	SZA CLA
	JMP IMNZRO
	CLA CMA CLL
	TAD CHAR
	SZL		/IF WE GO THROUGH THE BUFFER WITHOUT A NON-ZERO WORD
	JMP IMEFLP
IM7600,	7600
	JMS I (PIPERR	/SOMETHING IS WRONG (HANDLER SHOULD HAVE INSERTED
	4		/A ^Z AT LEAST)
IMNZRO,	CDF 10
	TAD CHAR
	CLL CML RAR
	AND IM7600
	TAD (200	/GET THE LENGTH OF THE USEFUL PART OF THE BUFFER
	JMP IMOUT	/AS AN OUTPUT CONTROL WORD AND GO OUTPUT IT
	PAGE
/** PIP STARTS HERE (OR HERE+1 IF CHAINED TO) **

PIPSA,	JMP PIPCD	/NORMAL ENTRY/RE-ENTRY - CALL CD
	JMP NOPCD	/ENTRY FROM CHAIN COMMAND - ASSUME CD AREA SET UP
	/PART OF ASCII PROCESSOR - CLEAN UP AT END OF LINE AND END OF FILE

LFEED,	TAD CHAR
	DCA I XR	/PUT THE LINE FEED IN THE LINE BUFFER
EOL,	DCA I XR	/MARK THE END OF USEFUL INFO
	JMS I (CTCTST
	TAD (ABUF-1
	DCA XR		/RESET BUFFER POINTER
EOLLP,	TAD I XR	/GET A CHARACTER FROM THE LINE BUFFER
PIPSNA,	SNA		/ZERO MEANS NO MORE CHARS
	JMP EOFTST
	JMS I (OCHAR	/OUTPUT THE CHARACTER
	JMP I (AOUERR
	JMP EOLLP
EOFTST,	TAD AEOFFG
	SNA CLA		/END OF INPUT ENCOUNTERED?
	JMP I (ASCIGO	/NO - GET NEXT LINE
ACLOSE,	JMS I (OCLOSE	/YES - CLOSE THE OUTPUT FILE
	JMP I (AOUERR	/ERROR ON CLOSE
PIP,	TAD I (MPARAM-1	/V3
	SMA CLA		/ALTMODE TERMINATE LAST COMMAND STRING?
	JMP PIPCD	/NO
	CDF CIF 0	/YES
	JMP I (7605	/EXIT TO OS/8 WITHOUT SAVING CORE
PIPCD,	JMS I (200	/OF COURSE THE MONITOR IS IN CORE!
	5		/COMMAND DECODE
	0		/NO ASSUMED EXTENSIONS ON INPUT
L20,			/V3
NOPCD,	JMS I (ONCE	/REPLACED BY '20' BY ONCE-ONLY CODE
	JMS I (SRSTOR	/CLEAR /S OR /Y;READ MONITOR
	DCA SQFLAG	/CLEAR /S INDICATOR
	TAD PIPSNA
	DCA I (INCTZF	/RESET INPUT SWITCH TO DETECT "^Z"'S
	TAD I (MPARAM+1
	AND (40		/"S" SWITCH
	SZA CLA
	JMP I (SQUISH	/IT WAS ON - COMPRESS THE INDICATED DEVICES
	TAD I (MPARAM+2
	RTL
	SZL CLA		/"Z" SWITCH IN THE LINK
	JMS I (DZERO	/ZERO DIRECTORY BEFORE PROCEEDING
	TAD I (MPARAM
	AND (400	/"D" SWITCH
	SZA CLA
	JMS I (DELETE	/DELETE OUTPUT FILE
	TAD I (MPARAM+2	/IS /Y ON?
	SPA CLA
	JMP I (SYSCOP	/YEP..TRANSFER SYSTEM HEAD
	TAD I (MPARAM
	AND (301	/"E","F" AND "L" SWITCHES
	SZA		/ANY ONE OF THEM ON?
	JMP I (DIR	/YES - LIST A DIRECTORY
	TAD I (MPARAM
	RTL
	AND (40		/"I" SWITCH ROTATED TWO LEFT
	SZA CLA
	JMP I (IMAGE	/IMAGE MODE TRANSFER
	TAD I (7617	/MUST PRESERVE THE LINK
	SNA CLA		/V3 IMAGE MODE ALLOWS NO INPUT FILE
	JMP PIP		/TERMINATE HERE IF NO INPUT SIDE
	SZL CLA		/"B" SWITCH IN LINK
	JMP I (BINARY	/BINARY MODE TRANSFER

	/DEFAULT MODE OF TRANSFER IS ASCII

ASCII,	TAD I (MPARAM+1
	AND L20
	DCA COPTSW
	TAD COPTSW
	JMS I (ASCI2	/TEST FOR OUTPUT DEVICE
	JMS I (OUTOPN
	JMS I (IOPEN	/OPEN THE INPUT FILES
	DCA AEOFFG	/ZERO THE END-OF-FILE FLAG
	JMS I (LEADER
	JMP I (ASCIGO

	/ENTRY ON END OF INPUT
ASCEOF,	SPA CLA		/WAS IT END OF INPUT OR AN INPUT ERROR?
PER4,	JMS I (PIPERR
	4
	ISZ AEOFFG	/SET END-OF-INPUT FLAG
	JMP EOL		/PROCESS LAST LINE (IF ANY)
AEOFFG,	0
	/SUBROUTINE TO OUTPUT RUBOUTS AFTER FORM CONTROL CHARACTERS
RUBOUT,	0		/UNLESS OUTPUT IS TO A DIRECTORY DEVICE
	DCA TEMP	/STORE COUNT
	JMS I (OTYPE	/GET TYPE OF OUTPUT DEVICE
	SPA CLA
	JMP I RUBOUT	/DIRECTORY DEVICE - DON'T BOTHER
RBTLP,	TAD CHAR
	TAD (-214
	SNA CLA		/IS THE FORM CONTROL CHAR A FORM-FEED?
	IAC		/YES - OUTPUT BLANK TAPE INSTEAD
	TAD (377
	DCA I XR	/PUT IN BUFFER
	ISZ TEMP
	JMP RBTLP		/LOOP FOR THE REQUISITE COUNT
	JMP I RUBOUT
COPTSW,	0

DEND,	SPA CLA
	JMP PER4
	JMP ACLOSE
	PAGE
	*3200
	/ASCII PROCESSOR CONTINUED

ASCIGO,	TAD (ABUF-2
	DCA XR
	DCA I XR	/PROTECT AGAINST NULL LINE WITH "T" OPTION
	DCA COLCT	/ZERO COLUMN COUNTER FOR TAB CONVERSION
ACHLP,	JMS I (ICHAR	/GET A CHARACTER
	JMP I (ASCEOF	/END OF INPUT OR WORSE
	AND (177	/MASK OUT PARITY BIT
	SZA		/IGNORE BLANK TAPE AND LEADER/TRAILER
	TAD (-177
	SNA
	JMP ACHLP	/DITTO RUBOUTS
	TAD (177-32	/V3C
	SNA
	JMP I (ASCPTCH	/7-BIT ^Z CHECK
	TAD (232	/FORCE COLUMN 8 ON
	DCA CHAR
	TAD CHAR
	TAD (-216
	CLL
	TAD ASCI5
	SNL		/IS THE CHARACTER A FORM CONTROL CHARACTER?
	JMP CINSRT	/NO
	TAD ASCJMP	/YES - GO TO APPROPRIATE ROUTINE
	DCA .+1
	HLT
ASCJMP,	JMP I .+1
	TAB
	LFEED
	VTAB
	FFEED
	CARRET
CINSRT,	7600		/GRP 2 CLA
	TAD CHAR
ADCAXR,	DCA I XR	/STORE THE CHARACTER IN THE LINE BUFFER
	ISZ COLCT	/ALWAYS BUMP THE COLUMN POINTER
TESTXR,	TAD XR
	TAD (-ABUF-226
	SPA CLA		/HAS THE BUFFER OVERFLOWED?
	JMP ACHLP	/NO - GET NEXT CHARACTER
	JMS I (PIPERR
	1
TAB,	TAD I (COPTSW
	SNA CLA		/DO WE WANT TO CONVERT?
	JMP TABRBT	/NO
TABLP,	TAD (240
	DCA I XR	/OUTPUT A SPACE
	ISZ COLCT
	TAD COLCT
	AND (7
	SZA CLA		/IS THE COLUMN COUNTER A MULTIPLE OF 8?
	JMP TABLP	/NOT YET
	JMP TESTXR	/YES - CHECK BUFFER OVERFLOW
TABRBT,	TAD CHAR
	DCA I XR
	CLA CMA
	JMS I (RUBOUT	/TWO RUBOUTS FOLLOW A TAB
	JMP TESTXR	/CHECK FOR BUFFER OVERFLOW
VTAB,	TAD I (COPTSW
	SZA CLA		/SHOULD WE CONVERT?
	JMP VTLF	/YES
	TAD CHAR
	DCA I XR
	TAD (-4
	JMS I (RUBOUT	/FOUR RUBOUTS AFTER A VERTICAL TAB
	JMP I (EOL
FFLF,	TAD (-4		/NINE LINE FEED SIMULATE A FORM FEED
VTLF,	TAD (-5		/FIVE LINE FEEDS SIMULATE A VERTICAL TAB
	DCA TEMP
	TAD (212
	DCA I XR
	ISZ TEMP
	JMP .-3
	JMP I (EOL	/FORM FEED AND VERTICAL TAB ARE LINE ENDERS
FFEED,	TAD I (COPTSW
	SZA CLA		/SHOULD WE CONVERT?
	JMP FFLF	/YES
	TAD CHAR
	DCA I XR
	TAD (-11	/NINE RUBOUTS AFTER A FORM FEED
	JMS I (RUBOUT
	JMP I (EOL
CARRET,	TAD I (MPARAM
	RTL
	SMA CLA		/"C" SWITCH MEANS DELETE TRAILING BLANKS FROM CARDS
	JMP NOTOPT	/IT WASN'T ON
TOPT,	TAD XR
	DCA TEMP
	TAD I TEMP
	TAD (-240
	SZA CLA		/WAS THE LAST CHAR ON THE LINE A SPACE?
	JMP NOTOPT	/NO
	CLA CMA
	TAD XR		/YES - BACK UP THE LINE POINTER
	DCA XR
	JMP TOPT
NOTOPT,	TAD CHAR
	DCA I XR	/STORE THE CARRIAGE RETURN IN THE BUFFER
	JMP TESTXR	/CARRIAGE RETURN IS NOT A LINE TERMINATOR
COLCT,	0

OUTOPN,	0
	JMS I (OOPEN
	SMA CLA
	JMP I OUTOPN
	JMS I (PIPERR
ASCI5,	5
	PAGE
	/SUBROUTINES CALLED BY THE REST OF PIP

K770,	770		/** DON'T MOVE THIS CONSTANT
DELETE,	0
	TAD P7600
	DCA DPFILE
	CLA CLL CMA RTL
	DCA CHAR	/MAXIMUM OF THREE OUTPUT FILES
DELOOP,	TAD (7201
	DCA DLHNDL
	TAD I DPFILE
	SNA		/DOES THIS FILE EXIST?
	JMP I DELETE	/THAT'S ALL
	JMS I C200
	1		/ASSIGN HANDLER FOR THE DELETION
DLHNDL,	0
	HLT
	TAD I DPFILE	/RELOAD DEVICE NUMBER FOR DELETE
	ISZ DPFILE	/BUMP DPFILE TO POINT TO THE FILE NAME
	JMS I C200	/DEVICE NUMBER IN AC
DP4,	4		/CLOSE - USED AS DELETE IN THIS CASE
DPFILE,	0		/POINTER TO FILE NAME
	0		/ZERO LENGTH FOR DELETE
	JMS I (PIPERR	/FILE WASN'T THERE TO BE DELETED
	3
	TAD DPFILE
	TAD DP4
	DCA DPFILE
	ISZ CHAR
	JMP DELOOP	/DELETE AS MANY FILES AS HE LISTED(UP TO 3)
	JMP I DELETE
DZERO,	0		/SUBROUTINE TO ZERO THE DIRECTORY OF THE
			/FIRST OUTPUT DEVICE
	JMS I (OTYPE
	CLL RTL
	SZL		/IS DEVICE READ-ONLY?
	JMP OZERR	/YES - ERROR
	RTR
	SMA		/FILE-STRUCTURED DEVICES WILL HAVE 4000 BIT SET
	JMP NONDIR	/NON-DIRECTORY DEVICE
	AND K770	/MASK OUT DEVICE TYPE
	CLL RTR
	RAR
	TAD (DEVLEN	/USE IT TO INDEX A TABLE OF DEVICE LENGTHS
	DCA PIPERR
	TAD (OUDEVH+1
	DCA OZHNDL
	TAD I P7600
	JMS I C200
	1		/ASSIGN DEVICE, FETCH HANDLER
OZHNDL,	0
	HLT
	TAD I PIPERR
	SNA 		/IS THE LENGTH ZERO?
	JMS I (DVREDE	/IF SO, GO "READ LENGTH"
	DCA PIPERR	/STORE LENGTH
	TAD I (MPARAM+2	/IF /Y ON, DO SYSTEM ZERO
	SPA CLA
	JMP ZRO70
	TAD OZHNDL	/BUT IF NOT, CHECK FOR SYSTEM ZERO
	TAD (-7607
	SZA CLA
	JMP ZRO70+1	/NOT SYSTEM FILES BEGIN AT 7
	JMS I (CONFRM	/ASK IF HE'S SURE
	SYSZRO		/V3
ZRO70,	TAD (61
	TAD (7
	DCA I (DFORG
	DCA I (SQFLAG	/AND CLEAR OUT SQUISHES
	TAD PIPERR
	TAD I (DFORG
	DCA I (DLENGT
	JMS I (GETEQ
	DCA I (DWASTE	/DEFINE # OF WASTE WORDS
	DCA I (MPARAM+3	/KILL = OPTION FOR FUTURE /I TRANSFERS
	CIF 0
	JMS I OZHNDL
	5410		/V3 OUTPUT 6 BLOCKS FROM FIELD 1
	DIRECT
	1		/ALL DIRECTORIES ARE IN RECORD 1
OZERR,	JMS I (PIPERR	/ERROR WHILE ZEROING DIRECTORY
	2
	DCA OLDDIR	/ZERO DIRECTORY POINTER TO FORCE A NEW READ
NONDIR,	CLA		/NON DIRECTORY RETURN
	JMP I DZERO
PIPERR,	0
P7600,	7600		/V3 CLA
	JMS I (SRSTOR	/RESET 07600!
	CDF 10		/JUST IN CASE
	TAD I PIPERR	/GET ARG
	TAD (ERRTBL
	DCA TEMP
	TAD I TEMP
	JMS I (ERPRNT
	JMP I (PIP	/RESTART PIP

LEADER,	0
	JMS I (OTYPE
C200,	AND K770	/GET THE TYPE OF THE OUTPUT DEVICE
	TAD (-PTP	/IS IT A PAPER TAPE PUNCH?
	SZA CLA
	JMP I LEADER	/NO
	TAD P7600
	DCA TEMP
	JMS I (OCHAR	/PUT OUT SOME LEADER
	JMP I (AOUERR
	ISZ TEMP
	JMP .-3
	JMP I LEADER
	PAGE
	/TABLE OF DEVICE LENGTHS FOR /Z OPTION

DEVLEN,	0;0;0;0;0;1520	/RK08 (1520= - DECIMAL 3248)
	6001;4001;2001;0001	/RF08 IN VARIOUS SIZES
			/(CHEATS A BLOCK ON LARGEST TO KEEP IT NON-ZERO)
	7601;7401;7201;7001	/DF32 IN VARIOUS SIZES
				/(CHEATS A BLOCK TO AVOID HARDWARE TROUBLE)
	6437;6437		/DECTAPE AND LINCTAPE
	ZBLOCK 1	/20 MAGTAPE
	6437		/21 TD8E
	0
	1520		/ 1/2 OF AN RK8E IS 23
	0		/24
	7022		/25 RX01 FLOPPY DISK
	17		/26 RL DEVICE 
	0
	0
	4027		/31 RL DEVICE
	0		/32 NEW RX MUST BE ZERO TO EXAMINE MEDIA
	7600		/33 VX  EXT MEM - DF32 PSEUDO DEVICE
	7400;7200	/2ND AND 3RD PLATTERS
	ZBLOCK 42	/ALL THE REST


FIXLEN,	0		/ROUTINE TO ESTIMATE OUTPUT FILE LENGTH
	TAD I (7600
	AND (7760
	SZA CLA		/DID THE USER PROVIDE AN ESTIMATE?
	JMP I FIXLEN	/YES - USE IT
	DCA CHAR
	TAD (7617
	DCA TEMP
FIXLP,	TAD I TEMP	/GET NEXT INPUT FILE
	SNA
	JMP FIXOVR	/NO MORE INPUT FILES
	AND (7760
	CIA CLL		/GET LENGTH AS A POSITIVE NUMBER
			/(LENGTH OF ZERO TURNS LINK ON)
	TAD CHAR
	DCA CHAR	/UPDATE CUMULATIVE LENGTH
	SZL CLA		/DID CUMULATIVE LENGTH OVERFLOW 256 BLOCKS?
	JMP I FIXLEN	/YES - CAN'T ESTIMATE IT
	ISZ TEMP
	ISZ TEMP
	JMP FIXLP
FIXOVR,	TAD CHAR
	TAD I (7600
	DCA I (7600	/STICK LENGTH IN OUTPUT FILE DESCRIPTOR
	JMP I FIXLEN
NOYES,	TEXT	/NO/
	TEXT	/YES/

CONFRM,	0
	TAD I (MPARAM+1
	RTL		/'O' BIT TO SIGN
	SPA CLA
	JMP GOTCON	/V3 'O' MEANS OK, ASSUME 'YES'
	TAD I CONFRM	/V3
	JMS I (ERPRNT
	KSF
	JMP .-1
	JMS I (CTCTST
	KRB		/LOOK AT HIS REPLY
	AND (177	/IGNORE PARITY TTY
	TAD (-"Y!7600	/V3
	SNA CLA		/IS IT YES?
	ISZ SQFLAG	/SET SQFLAG TO 1 (NEEDED 1 LATER)
	TAD SQFLAG	/USE SQFLAG AS INDEX FOR MESSAGE
	CLL RAL
	TAD (NOYES
	JMS I (ERPRNT
	TAD SQFLAG
	SNA CLA
	JMP I (PIP
CNFMXT,	ISZ CONFRM
	JMP I CONFRM

GOTCON,	ISZ SQFLAG	/SET SQFLAG
	JMP CNFMXT	/AND TAKE SKIP EXIT
	PAGE
	/DIRECTORY PRINTER FOR PIP
	MDATE=7666

DIRPRE,	JMS I (OUTOPN	/OPEN THE OUTPUT FILE
	TAD (ABUF
	DCA CHAR	/ABUF WILL BE A TEMPORARY ARRAY OF STARTING FILES
	TAD (7617
	DCA TEMP
	TAD I (7617
	SNA
	JMS I (DSKNUM
	DCA I (7617	/DEFAULT DIRECTORY IS DSK:
DFUJLP,	TAD I TEMP
	SNA		/ARE WE THROUGH WITH THE INPUT DEVICES?
	JMP GETDIR	/YES
	AND (17
	DCA I TEMP	/ONLY THE DEVICE NUMBER IS IMPORTANT
	TAD I TEMP
	TAD (DCB-1
	DCA PRWD
	CLA CLL CML RTL
	TAD TEMP
	DCA INFPTR	/THIS SERVES NO FUNCTION EXCEPT IMPROVING ERROR MESSAGES
	TAD I PRWD
	SMA CLA		/IS THE DEVICE A DIRECTORY DEVICE?
	JMS I (PIPERR	/NO
	6
	ISZ TEMP
	TAD I TEMP
	DCA I CHAR	/SAVE THE STARTING BLOCK NUMBER
	CLA IAC
	DCA I TEMP	/READ FROM THE DIRECTORY
	ISZ TEMP
	ISZ CHAR
	JMP DFUJLP
GETDIR,	TAD (ABUF
	DCA CHAR
	JMS PCRLF
	TAD I (MDATE
	JMS I (PDATE
	JMS PCRLF
	JMS I (IOPEN	/RESET POINTERS - WERE GONNA FAKE OUT THOSE "GENERAL"
			/ROUTINES
	JMP I (NXTDIR
PRWD,	0		/ROUTINE TO PRINT SIXBIT TEXT
	SNA		/IS COUNT ZERO?
	CMA		/MAKE IT ONE
	DCA PRCT	/STORE COUNT
PRWDLP,	TAD I PRWD
PR212,	RTR
	RTR
	RTR
	JMS PR6BIT
	TAD I PRWD
	JMS PR6BIT
	ISZ PRWD
	ISZ PRCT
	JMP PRWDLP
	JMP I PRWD
PRCT,	0
PR6BIT,	0
	AND (77
	SZA
	TAD (240	/V3
	AND (77		/V3
	TAD (240	/V3
	JMS I (OCHAR
	JMP I (AOUERR
	JMP I PR6BIT
PRNUM,	0
	DCA PRWD
	DCA TEMP
	TAD (PWRTEN
	DCA PCRLF
PRNMLP,	DCA PR6BIT
	TAD I PCRLF
	SNA
	JMP PRLAST	/V3
	CLL
	TAD PRWD
	SNL
	JMP .+4
	DCA PRWD
	ISZ PR6BIT
	JMP PRNMLP+1
	CLA
	TAD PR6BIT
	TAD TEMP
	SNA
PBLJMP,	JMP PRBLNK	/INCREMENTED BY PDATE TO KILL LEADING BLANKS
	TAD (260
	JMS PR6BIT
	CLA CLL CML RAR
	DCA TEMP
	ISZ PCRLF
	JMP PRNMLP
PRBLNK,	JMS PR6BIT
	JMP .-3
PRLAST,	TAD PRWD	/V3
	TAD (260	/V3
	JMS PR6BIT	/V3
	JMP I PRNUM	/V3
PCRLF,	0
	TAD (215
	JMS I (OCHAR
	JMP I (AOUERR
	TAD PR212
	JMS I (OCHAR
	JMP I (AOUERR
	JMP I PCRLF

PWRTEN,	-1750;-144;-12;0	/V3
	PAGE
	/MAIN DIRECTORY PRINTING LOOP

NXTDIR,	JMS I (ICHAR	/FAKE, FAKE
	JMP I (DEND
	CLA		/WE DON'T WANT THE CHARACTER
	DCA ECOUNT
	TAD (INBUF-1	/WE WANT THE BUFFER!
NEWSEG,	DCA XR
	CDF 0
	TAD I XR
	DCA DCOUNT	/NUMBER OF ENTRIES
	TAD DCOUNT
	CLL
	TAD (100
	SNL CLA
	JMS I (PIPERR
	11
	TAD I XR
	DCA BLOKNO	/FIRST BLOCK OF FILE STORAGE
	TAD I XR
	DCA DLINK	/LINK TO NEXT SEGMENT
	ISZ XR		/BUMP XR PAST FLAG WORD
	TAD I XR
	DCA WASTE
NAMELP,	CDF 0
	TAD I XR
	SNA		/WHAT TYPE OF ENTRY IS IT?
	JMP DEMPTY	/A FREE FILE
	DCA NAME1	/A PERMENANT OR TENTATIVE FILE
	TAD I XR
	DCA NAME2
	TAD I XR
	DCA NAME3
	TAD I XR
	DCA NAME4
	TAD I XR
	DCA DDATE
	TAD WASTE	/COMPENSATE FOR THE DATE INCREMENT
	CMA		/AND THE WASTE WORDS
	TAD XR
	DCA XR
	TAD I XR
	SNA		/IS IT A TENTATIVE FILE?
	JMP ADDLEN+1	/YES - TENTATIVE FILES ARE ALWAYS IGNORED
	CIA
	DCA FLENGT	/NO - STORE THE LENGTH
	CDF 10
	TAD I CHAR	/GET THE STARTING FILE FOR THIS LISTING
	CIA CLL
	TAD BLOKNO
	SNL CLA		/ARE WE THERE YET?
	JMP ADDLEN	/NO - KEEP GOING
	CLA CLL CMA RTL
	JMS I (PRWD	/PRINT THREE WORDS
NAME1,	0
NAME2,	0
NAME3,	0
	TAD NAME4
	SNA CLA		/IS THERE AN EXTENSION?
	TAD (-16	/NO - PRINT A BLANK
	TAD (56		/YES - PRINT A PERIOD
	JMS I (PR6BIT
	JMS I (PRWD
NAME4,	0		/ZERO PRINTS AS TWO MORE BLANKS
PRLNGT,	TAD DTYPE
	AND (100
	SZA CLA		/WAS THE LISTING SWITCH /F?
	JMP PRTCRL	/YES - DON'T PRINT LENGTH
	TAD FLENGT
	JMS I (PRNUM
	TAD WASTE
	SZA CLA
	TAD DDATE
	JMS I (PDATE	/PRINT THE CREATION DATE OF THE FILE
PRTCRL,	JMS I (PCRLF
ADDLEN,	TAD FLENGT
	TAD BLOKNO
	DCA BLOKNO	/UPDATE BLOCK NUMBER
	ISZ DCOUNT
	JMP NAMELP	/LOOP UNTIL ALL FILES ARE PROCESSED
	TAD DLINK
	SNA CLA		/MULTI-SEGMENT DIRECTORY?
	JMP ENDDIR	/NO - FINISH UP
	TAD XR
	AND (7400
	TAD (377	/BUMP XR TO NEXT BLOCK
	JMP NEWSEG	/PROCESS NEXT LINK
DEMPTY,	TAD I XR
	CIA
	DCA FLENGT	/STORE LENGTH OF FREE ENTRY
	CDF 10
	TAD FLENGT
	TAD ECOUNT
	DCA ECOUNT	/BUMP COUNT OF FREE BLOCKS
	TAD DTYPE
	AND (200
	SNA CLA		/IS THE /E SWITCH ON?
	JMP ADDLEN	/NO - DON'T LIST FREE FILES
	TAD (-4
	JMS I (PRWD
	TEXT	/<EMPTY>/
	JMS I (PR6BIT
	TAD FLENGT
	JMS I (PRNUM
	JMP PRTCRL
ENDDIR,	ISZ CHAR	/BUMP TEMP ARRAY TO NEXT ENTRY
	TAD ECOUNT
	JMS I (ENDFUJ
	JMP NXTDIR
	PAGE
/BINARY MODE PROCESSOR FOR PIP

BIN360,	360
BINARY,	JMS I (FIXLEN
	JMS I (OUTOPN
	JMS I (IOPEN
	JMS I (LEADER	/PUT OUT BLANK TAPE IF HS PUNCH OUTPUT
	JMS LTCODE
NEWTAP,	JMS I (ICHAR
	JMP BEOF		/END OF FILE ON INPUT
	SNA
	JMP NEWTAP	/BLANK TAPE - KEEP GOING
	TAD BN7600
	SZA CLA
	JMP NEWTAP
	JMS I (ICHAR
	JMP BEOF
	TAD BN7600
	SNA
	JMP .-4
	TAD BIN200
	DCA CHAR
	TAD CHAR
BIN200,	AND BIN360
	TAD (-240	/CHECK TYPE OF TAPE
	SNA		/IS IT RELOCATABLE?
	JMP RELBIN	/YES
	TAD (-40	/IF A FIELD SETTING, IT'S ABSOLUTE
	AND (7700
	SNA
	JMP ABSLUT
	TAD BIN200	/CHECK FOR ORIGIN ALSO
	SZA CLA
	JMP NEWTAP	/NOTHING..NEXT FRAME
ABSLUT,	CLA CMA
	JMS LTCODE
ABSBIN,	JMS RCOPY1	/COPY THIS FRAME AND READ NEXT
	TAD BN7600
BNM140,	SZA CLA		/IS IT TRAILER?
	JMP ABSBIN	/NO - KEEP GOING
BEOT,	CLA CMA		/END OF TAPE
	JMS LTCODE	/PUT OUT SHORT LEADER/TRAILER
	JMP NEWTAP	/GET NEXT TAPE
LTCODE,	0		/SUBROUTINE TO PUNCH 200 CODE
	SMA		/SHORT LEADER/TRAILER?
	JMS I (OTYPE
	SPA CLA		/DIRECTORY DEVICE?
	TAD (70	/YES
	TAD (-100
	DCA TEMP
LTLOOP,	TAD BIN200
	JMS I (OCHAR	/OUTPUT 64 OR 8 FRAMES OF L/T CODE
	JMP I (AOUERR
	ISZ TEMP
	JMP LTLOOP
	JMP I LTCODE

RELBIN,	TAD (SKP
	DCA I (INCTZF	/DISABLE CONTROL-Z CHECKING ON INPUT
	CLA CMA
	JMS LTCODE	/PUT OUT SHORT LEADER/TRAILER
RELLP,	TAD CHAR
	RTR
	RTR
	AND (17
	TAD (RELTBL
	DCA TEMP
	TAD I TEMP	/GET DATA WORD FOR THIS FRAME
	SMA SZA		/POSITIVE MEANS SPECIAL OR ERROR
	JMP RELERR
RELSNA,	SNA
	JMP RELEND	/ZERO MEANS CHECKSUM FRAME
	DCA TEMP	/NEGATIVE MEANS COUNT OF NUMBER OF SLAVE FRAMES
	JMS RCOPY1
BN7600,	7600
	ISZ TEMP
	JMP .-3	/COPY THIS FRAME AND ALL SLAVE FRAMES
	JMP RELLP	/GET NEXT CONTROL FRAME
RELEND,	JMS RCOPY1	/COPY THE FIRST FRAME OF THE CHECKSUM
	JMS I (OCHAR
	JMP I (AOUERR	/OUTPUT THE SECOND FRAME
	JMP BEOT	/END TAPE - START NEXT ONE
BEOF,	JMS LTCODE
	JMS I (OCLOSE
	JMP I (AOUERR
	JMP I (PIP
RCOPY1,	0		/ROUTINE TO ADVANCE "CHAR" TO NEXT INPUT CHARACTER
	TAD CHAR
	JMS I (OCHAR
	JMP I (AOUERR
	JMS I (ICHAR
	JMP INEFER
	DCA CHAR
	TAD CHAR
	JMP I RCOPY1
INEFER,	SMA CLA		/DETECT FATALITIES
	JMS I (PIPERR
	7
	JMS I (PIPERR		/A REAL BAD READ
	4

RELERR,	CLL RAR
	SZA CLA		/CODE OF 1 MEANS SPECIAL
	JMS I (PIPERR	/ILLEGAL RELOCATABLE INPUT
	10
	JMS RCOPY1
	CLL CML CMA RTL	/MULTIPLY NAME COUNT BY -6 (APPROXIMATELY)
	TAD CHAR
	CLL CML RAL	/(ACTUALLY THIS PRODUCES -6X-1 WHICH IS WHAT WE WANT)
	JMP RELSNA
	PAGE
ERPRNT,	0		/ERROR MESSAGE PRINTOUT ROUTINE
	DCA TEMP
ERLP,	TAD I TEMP
	RTR
	RTR
	RTR
	JMS ERPCH	/PRINT HIGH-ORDER CHARACTER
	TAD I TEMP
	JMS ERPCH	/PRINT LOW-ORDER CHARACTER
	ISZ TEMP
	JMP ERLP

ERPCH,	0
	AND (77
	SNA
	JMP ERCRLF	/0 CHARACTER TERMINATES
	JMS CHPRNT
	JMP I ERPCH
FILENR,	TAD ("#
	JMS I (TTYOUT
	TAD INFPTR	/GET PTR TO CURRENT INPUT FILE
	TAD (321	/MAGIC NUMBER
	CLL RAR
	JMP FILENR-2

CHPRNT,	0
	TAD (-37	/IS IT A _?
	SNA
	JMP FILENR	/YES..PRINT FILE NUMBER
	IAC
	SNA 		/MAYBE ^?
	JMP I (SQFILE	/YEP..PRINT FILE NAME
	SPA
	TAD (100
	TAD (236
	JMS I (TTYOUT
	JMP I CHPRNT

ERCRLF,	TAD (215
	JMS I (TTYOUT
	TAD (212
	JMS I (TTYOUT
	JMP I ERPRNT
PDATE,	0		/PRINTS THE DATE
	SNA
	JMP I PDATE	/NO DATE TO PRINT
	DCA ERPRNT
	ISZ I (PBLJMP
	JMS I (PR6BIT
	TAD ERPRNT
	CLL RTL
	RTL
	RAL
	AND (17
	JMS I (PRNUM
	TAD (57
	JMS I (PR6BIT
	TAD ERPRNT
	RTR
	RAR
	AND (37
	JMS I (PRNUM
	TAD (57
	JMS I (PR6BIT
	TAD ERPRNT
	AND (7
	TAD (106
	JMS I (PRNUM
	CLA CMA
	TAD I (PBLJMP
	DCA I (PBLJMP	/RESET PRNUM TO PRINT LEADING SPACES
	JMP I PDATE

DSKNUM,	0
	DCA DSKNAM+1
	JMS I (200
	12
DSKNAM,	5723
	0
	0
	HLT
	TAD DSKNAM+1
	JMP I DSKNUM
RELTBL,	-2;-2;2;-10;-2;-2;-2;2;0;2;-2;2;2;2;2;1

ERRTBL,	ERR0
	ERR1
	ERR2
	ERR3
	ERR4
	ERR5
	ERR6
	ERR7
	ERR8
	ERR9
	ERR10
	ERR11
	IFNZRO OS78 <DIRMSG>

	PAGE
/ERROR MESSAGE TEXT GOES HERE


ERR0,	TEXT	/NO ROOM FOR OUTPUT FILE/
ERR1,	TEXT	/LINE TOO LONG IN FILE_/
ERR3,	TEXT	/ERROR DELETING FILE/
ERR4,	TEXT	/INPUT ERROR, FILE_/
ERR5,	TEXT	/CAN'T OPEN OUTPUT FILE/
ERR6,	TEXT	/DEVICE_ NOT A DIRECTORY DEVICE/
ERR7,	TEXT	/PREMATURE END OF FILE, FILE_/
ERR8,	TEXT	/ILLEGAL BINARY INPUT, FILE_/
ERR9,	TEXT	/BAD DIRECTORY ON DEVICE_/
ERR10,	TEXT	/DIRECTORY ERROR/


TTYOUT,	0
	TLS
	TSF
	JMP .-1
	CLA
	JMP I TTYOUT
	PAGE
/SQUISH PROCESSOR

SQUISH,	JMS I (CONFRM
	SURE		/V3
SQUISX,	DCA I (OUELEN	/INITIALIZE PARAMS TO FAKE OUT "IMTRA"
	DCA I (OUBLK
	DCA I (7621	/ZERO SECOND FILE FOR "INNEWF"
	DCA I (CTCFLG
	JMS I (IOPEN
	JMS I (INNEWF
	JMP I (PIP	/NO INPUT
	TAD (OUDEVH+1
	DCA SOHND
	TAD I SQ7600
	SNA
	JMP I (PIP	/NO OUTPUTEE, NO SQUISHEE
	JMS I (200
	1
SOHND,	0
	HLT
	JMS INTEST
	JMS I (OTYPE
	CLL RTR
	RAR
	AND (77
	TAD (DEVLEN
	DCA TEMP
	TAD SOHND	/SET UP OZHNDL
	DCA I (OZHNDL	/IN CASE OF JMP TO DVREDE
	TAD I TEMP	/GET ENTRY FROM DEVICE LENGTH TABLE
	SNA		/IS THE DEVICE LENGTH ZERO ?
	JMS I (DVREDE	/IF SO, READ THE LENGTH
	DCA OUDLEN	/SAVE OUTPUT DEVICE LENGTH
	JMS I (GETEQ
	DCA OUWAST
	TAD SOHND
	DCA OHNDLR
	TAD OHNDLR
	DCA I (OUHNDL
	TAD I (INHNDL
	DCA IHNDLR
	JMS SETCTC
	JMS I (CTCFLG
	CIF 0
	JMS I IHNDLR
	1400
	0
	1
	JMP I (SQIDER+1
	CIF 0
	JMS I (7607
	5400
	0
	MTEMP		/MOVE THE INPUT DIRECTORY TO SYS:
	JMP I (SQIDER+1
	CLA IAC
	DCA I (SQBUF2+2
	DCA I (CTCFLG
	TAD SOHND	/SETUP DIRECTORY START
	JMS I (SQDTST
	JMS I (SETSAM	/IF IHNDLR=OHNDLR, SAME=1
	CLA CMA
	DCA I (SQBUF2
	DCA I (OUTSEG
	JMP I (NEWOUT

INTEST,	0		/TEST IF INPUT IS DIRECTORY
	TAD I (7617
	AND (17
	TAD (DCB-1
	DCA TEMP
	TAD I TEMP
	SMA CLA
	JMS I (PIPERR
	6
	JMP I INTEST

SETCTC,	0		/MODIFY 07600 TO RETURN TO SQCTLC
	TAD CDIF10
	CDF 0
	DCA I SQ7600
	TAD (5602	/JMP I .+1
	DCA I (7601
	TAD (SQCTLC
	DCA I (7602
CDIF10,	CIF CDF 10
	JMP I SETCTC
OUK,	0		/V3 ON IMAGE MODE TRANSFER
			/CLOSE OUT FILE WITH = OPTION
			/IF NOT TOO SMALL
	TAD I (OUCCNT
	CLL CIA
	TAD I (MPARAM+3
	SNL		/IS = OPTION LARGER?
SQ7600,	7600		/RETURN OUCCNT IF IT'S LARGER
	TAD I (OUCCNT	/RETURN LOW ORDER = OPTION IF IT'S LARGER
	JMP I OUK
	PAGE
NEWIN,	TAD (MTEMP-1
	DCA INSEG
	JMS I (CTCFLG
	CIF 0
	JMS I (7607
	0210
S7200,	SQBUF2
INSEG,	0
	JMP I (SQIDER
	DCA I (CTCFLG
	TAD I (SQBUF2+1
	DCA INBLK
	TAD (SQBUF2+4
	DCA INXR
SGETIN,	TAD I INXR
	SNA
	JMP SEMPTY
	DCA I OUTXR
	TAD OUTXR
	DCA OUSAVE
	JMS I (CYWAST	/COPY WASTE WORDS
	TAD I INXR
	DCA RECCNT
	TAD RECCNT
	SNA
	JMP SNULL
	CMA CLL		/V3
	TAD OUTBLK
	TAD OUDLEN
	SZL CLA
	JMP SNULER
	TAD RECCNT
	DCA I OUTXR
	CLA CMA
	TAD I (SQBUF1
	DCA I (SQBUF1
	TAD INBLK
	CIA
	TAD OUTBLK
	SNA CLA
	TAD SAME
	SNA CLA
MOVFIL,	JMS I (SQTRA	/MOVE THE FILE DOWN
	TAD RECCNT
	CIA
	TAD OUTBLK
	DCA OUTBLK
	TAD RECCNT
DMTX,	CIA
	TAD INBLK
	DCA INBLK
	TAD OUTXR
	CIA
	TAD OUWAST
	TAD OUWAST
	TAD (SQBUF1+365
	SMA CLA		/DO WE HAVE ROOM FOR TWO MORE ENTRIES?
	JMP NEXTIN

	/DIRECTORY SEGMENT OVERFLOW ON OUTPUT...

	ISZ I (OUTSEG
	TAD I (OUTSEG
	IAC
	DCA I (SQBUF1+2	/STORE LINK TO NEXT SEGMENT
	TAD I (SQBUF1+2
	TAD (-7
	SMA CLA
	JMP I (SQIDER-1	/TOO MANY SEGMENTS
	JMS I (OUTDIR	/OUTPUT THIS SEGMENT
NEWOUT,	TAD (SQBUF1-1
	DCA OUTXR	/INITIALIZE XR FOR NEXT OUTPUT SEGMENT
	DCA I (OUTINH	/ZAP ANY OLD OUTPUT INHIBIT FLAG
	DCA I OUTXR
	TAD OUTBLK
	DCA I OUTXR
	DCA I OUTXR
	DCA I OUTXR
	TAD OUWAST
	DCA I OUTXR
NEXTIN,	ISZ I S7200
	JMP SGETIN
	TAD I (SQBUF2+2
	SNA		/ANY MORE INPUT SEGMENTS?
	JMP I (SQOVER
	JMP NEWIN
SNULER,	TAD (NOROOM
	JMS I (ERPRNT
SNULL,	CLA CMA
	TAD OUSAVE
	DCA OUTXR
	JMP DMTX-1
SEMPTY,	TAD I INXR
	JMP DMTX
OUSAVE,	0
SURE,	TEXT	/ARE YOU SURE?/

SETSAM,	0
	TAD IHNDLR
	CIA
	TAD OHNDLR
	SNA CLA
	IAC
	DCA SAME
	JMP I SETSAM
	PAGE
SQOVER,	DCA I OUTXR
	TAD OUDLEN
	TAD OUTBLK
	SNA
	JMP CKZERO
	DCA I OUTXR
	CLA CMA
	TAD I (SQBUF1
	DCA I (SQBUF1
CKZERO,	TAD I (SQBUF1
	SZA CLA
	JMP ZEROK
	CLA CLL CML RAR
	JMS OUTDIR	/READ IN LAST DIRECTORY
	DCA I (SQBUF1+2	/ZERO OUT LINK WORD
	SKP
ZEROK,	ISZ OUTSEG
	JMS OUTDIR
ZEROKS,	JMS SRSTOR
	JMP I (PIP

	DCA I (SQBUF1+2
SQIDER,	JMS OUTDIR
	JMS SRSTOR
	JMS I (PIPERR
	12
OUTDIR,	0
	TAD (4210
	DCA .+4
	JMS CTCFLG
	CIF 0
	JMS I OHNDLR
	0
	SQBUF1
OUTSEG,	0
	JMP SQIDER+1
	DCA CTCFLG
	JMP I OUTDIR

SQIOER,	TAD (IOMSG
	JMS I (ERPRNT
	JMP I (SLGRET
SQCTLC,	KCC		/JUMPED TO BY CODE AT 07600
	JMS I (TSTSAM	/TEST IF OPERATION IS TO ITSELF 
	TAD (CTCMSG
	JMS I (ERPRNT
	TAD CTCFLG
	SZA CLA
	JMP I CTCFLG
	TAD I (MPARAM+1	/IS IT /S?
	AND (40
	SNA CLA
	JMP I (SYSCPY	/NO../Y
	JMP I (MOVFIL

SRSTOR,	0
	JMS I (7700	/MAKE SURE MONITOR IS IN CORE
	10
	DCA .-2		/AND WIPE THE CALL AWAY
	TAD (4207
	CDF 0
	DCA I (7600
	TAD (5000
	DCA I (7601
	DCA I (7602
	CDF 10
	JMP I SRSTOR

CTCFLG,	0
	JMP I CTCFLG
CTCMSG,	TEXT	/SORRY - NO INTERRUPTIONS/
IOMSG,	TEXT	/I-O ERROR IN ^ - CONTINUING/
NOROOM,	TEXT	/NO ROOM IN ^ - CONTINUING/
	PAGE
K7760,	7760
SYSCOP,	TAD K7622		/SET INFPTR IN CASE OF /Y ERROR
	DCA INFPTR	/WILL FILE #1
	JMS I (SETCTC	/KLUDGE UP 07600
SYSCPY,	TAD (INDEVH+1
	DCA YIHAND	/SET TO ASSIGN INPUT HANDLER
	TAD (OUDEVH+1
	DCA YOHAND
	TAD (2000
	DCA K2000	/THIS MAY GET CLOBBERED READING IN DIRECT.
	IAC		/V12B
	DCA OFSET
	TAD I K7617
	SNA CLA		/IS THERE AN INPUT DEVICE?
	ISZ I K7617	/MAKE INPUT =SYS
	JMS I (INTEST	/SEE IF OPERATIONS ARE TO SAME DEVICE
	TAD I K7617
	JMS I K200	/ASSIGN HANDLER
	1
YIHAND,	0
K7622,	7622	/THINLY DISGUISED HALT
	TAD I K7617
K200,	AND K7760	/CHECK INPUT FILE LENGTH
	SNA		/IF BLANK,INPUT SYSTEM HEAD
	JMP	YSOUT
	TAD (-6340	/CHECK FOR PROPER LENGTH
	SZA CLA
	JMP PER13	/ERROR..NOT SYSTEM HEAD
	TAD I (7601	/IS THERE OUTPUT DEVICE?
	SZA CLA		/IF YES..WE CAN DO IMAGE XFER
	JMP I (IMGTST
	TAD I (7620
YOUSYS,	DCA YINREC	/PICK UP STARTING RECORD
	CIF 0
	JMS I YIHAND	/READ IN FIRST INPUT RECORDS
K2000,	2000		/(0-15 IF SYSTEM HEAD,0-7 IF FILE)
	OUBUF
YINREC,	0
	JMP I (PER4	/INPUT ERROR
	TAD I (7620	/IF INPUT FROM A FILE, OPEN
	SNA CLA		/TEST LOC 605
	TAD (3000	/IF FROM HEAD, TEST 3605
	TAD (605
	DCA I (HDTST
	JMS I (TSTHED	/TEST FOR VALID SYSTEM HEAD
	TAD YINREC
	TAD OFSET	/BUMP TO NEXT RECORD
	DCA NXTRD
	TAD I (7600	/IF NO OUTPUT, FORGET IT
	SNA
	JMP PIPCLR	/RESET AND GO TO PIP
	JMS I K200
	1
YOHAND,	0
	HLT		/V3
	JMS I (FAKE
	JMS I (SETSAM
	JMS I (TSTIO	/TEST OUTPUT. SEE IF DIRECT. DEV.
	CIF 0
	JMS I YOHAND	/READ OUTPUT DIRECTORY INTO PLACE
	1400
	400
	1
	JMP I (PER4
	CDF 0
	TAD I (401	/NOW TEST FOR VALID OUTPUT DEVICE
	CDF 10
	TAD (-10	/IF LESS THAN 10, DON'T XFER
	SPA CLA
	JMS I (PIPERR
	11
	TAD (-10	/V12B
	DCA YINREC	/XFER COUNTER

	JMP	YDUMP
YLOOP,	CIF 0
	JMS I YIHAND	/READ NEXT
K3400,	1600		/V12B 7 BLOCKS
	OUBUF
NXTRD,	0
	JMP I (PER4
	TAD NXTRD
	TAD (7		/V12B
	DCA NXTRD
YDUMP,	TAD (5600	/V12B
	JMS I (OUTDMP	/WRITE BUFFER
	JMP I (AOUERR
	ISZ YINREC	/DONE YET?
	JMP YLOOP	/NOT YET..LOOP
PIPCLR,	JMS I (SRSTOR	/CLEAR OUT 07600
	JMP I (PIP
YSOUT,	TAD I	(7601	/HERE IF INPUT FROM SYSTEM HEAD
	SZA CLA		/IS THERE AN OUTPUT FILE?
	JMP I	(YTSOUT	/YES, SET UP FOR IMAGE MODE
YNOOUT,	
	TAD (7		/AND RESTART READ AT RECORD 16
	DCA OFSET
	JMP YOUSYS
OFSET,	0

PER13,	JMS I (PIPERR
	13
K7617,	7617		/V3
	PAGE
DIRECT,	-1
DFORG,	0		/FILE STORAGE
	0
	0
DWASTE,	0		/#WASTE WORDS
	0
DLENGT,	0

MOVE,	0
IMGTST,	DCA SAME	/V12B
	TAD I (YIHAND	/V12B
	DCA IHNDLR	/V12B
	JMP I (IMAGE	/V12B
	TAD (6777
MOVE1,	DCA TSTSAM
	CDF 0
	TAD I MWAST
	DCA I TSTSAM
	CMA
	TAD	MWAST
	DCA	MWAST
	CMA
	TAD	TSTSAM
	ISZ TEMP
	JMP MOVE1
	CLA
	CDF 10
	JMP I MOVE

ERR11,	TEXT	/BAD SYSTEM HEAD/

YTSOUT,	TAD I (7617	/O.K. SETUP CD AREA FOR IMAGE XFER
	TAD (7760	/FROM SYSTEM AREA OF INPUT DEVICE
	DCA I (7617
	TAD I (7617
	AND (17
	TAD (6360
	DCA I (7621
	TAD K7
	DCA I (7622
	DCA SAME	/ALLOW ^C IF TO OUTPUT FILE
	TAD I (YIHAND	/TEST FOT VALID SYSTEM
	DCA IHNDLR
	CIF 0
	JMS I IHNDLR
	0200
	3400
K7,	7
	JMP I (PER4
	JMS I (TSTHED
	JMP I (IMAGE
TSTSAM,	0
	TAD SAME	/IF /Y IS TO SAME DEVICE AS INPUT (SYS)
	SNA CLA		/^C GIVES MESSAGE AND RETRIES OPERATION
	JMP I (ZEROKS
	JMP I TSTSAM

ERR2,	TEXT	/OUTPUT ERROR/

SQFILE,	DCA MWAST
	TAD I (OUSAVE
	DCA TSTSAM	/IF ERROR DURING /S
	DCA DWASTE
	CLA CLL CMA RTL
	DCA MOVE	/-3 FOR FILE NAME
SQFIL3,	TAD I TSTSAM	/FIRST 2 CHARS. IN NAME
	CLL RTR
	RTR
	RTR
SQFIL5,	AND (77
	SZA		/IF ZERO, DON'T BOTHER
	JMS I (CHPRNT
	ISZ DWASTE	/RIGHT HALF OR NEW WORD?
	JMP SQFIL4	/RIGHT HALF
	ISZ TSTSAM
	ISZ MOVE	/EXHAUSTED ALL?
	JMP SQFIL3	/NOPE
	TAD MWAST	/DONE WITH IT YET?
	SZA CLA
	JMP I (FILENR-1	/YES
	TAD I TSTSAM	/IS THERE AN EXTENSION?
	SNA CLA
	JMP I (FILENR-1	/NO..CONTINUE ORIGINAL MSG
	TAD (256
	JMS I (TTYOUT
	ISZ MWAST	/SIGNAL END
	CLA CMA
	JMP SQFIL3-1
SQFIL4,	CLA CMA
	DCA DWASTE
	TAD I TSTSAM	/GET RIGHT HALF
	JMP SQFIL5
MWAST,	0
	DCA TEMP
	TAD I INXR
	DCA I OUTXR	/ROUTINE TO COPY WASTE WORDS
	ISZ TEMP
	JMP .-3
	JMP I MWAST
	PAGE
FAKE,	0
	TAD I (YIHAND
	DCA IHNDLR
	TAD I (YOHAND
	DCA OHNDLR
	DCA I (OUCCNT
	DCA I (OUBLK
	DCA I (OUELEN
	TAD I (YOHAND
	DCA I (OUHNDL
	JMP I FAKE

CYWAST,	0		/ROUTINE TO COPY WASTE WORDS
	CLA CLL CMA RTL	/THREE MORE FOR FILE NAME
	JMS I (MWAST	/COPY THEM
	TAD I (SQBUF2+4	/NOW ADJUST I/O WASTE WORDS
	CIA
	TAD OUWAST	/DIFF. BETWEEN OUT AND IN WORDS
	SMA		/IF <0, MORE OUT THAN IN
	JMP CGEWST	/POS. MORE IN THAN OUT (OR SAME)
	DCA TEMP1
	TAD I (SQBUF2+4
	SZA
	JMS I (MWAST	/COPY ALL INPUT WORDS
	DCA I OUTXR	/AND 0 ALL EXTRA OUTPUT WORDS
	ISZ TEMP1
	JMP .-2
	JMP I CYWAST
CGEWST,	DCA TEMP1
	TAD OUWAST	/XFER ONLY ENOUGH OUTPUT WDS.
	SZA
	JMS I (MWAST
	TAD INXR
	TAD TEMP1	/POINT INPUT TO NEXT FILE
	DCA INXR
	JMP I CYWAST

TSTHED,	0		/TESTS FOR KEYBOARD MONITOR
	CDF 0
	TAD I HDTST	/V12C
	CDF 10
	TAD (-7200
	SZA CLA
	JMP I (PER13	/IF NOT CLA, NOT VALID
	JMP I TSTHED
HDTST,	3605
TSTIO,	0		/SEE IF OUTPUT IS DIRECTORY DEVICE
	JMS I (OTYPE	/GET DCB WORD FOR OUTPUT
	SMA CLA		/IF NOT NEG., NOT DIRECT DEVICE
	JMS I (PIPERR
	5
	TAD OHNDLR	/IF OUTPUT=SYS, SET NO INTERRUPT
	TAD (171
	SNA CLA
	ISZ SAME
	JMP I TSTIO

ASCI2,	0		/SEE IF VALID ASCII OUTPUT
	DCA TSTIO
	TAD I (7600
	SNA CLA
	JMP I (PIP	/NO..BACK TO PIP
	TAD TSTIO	/SEE IF /C IS ON
	SNA CLA
	JMS I (FIXLEN	/NO..TRY TO ESTIMATE OUTPUT
	JMP I ASCI2

SQDTST,	0		/ROUTINE TO CHECK /S DIRECTORIES
	DCA NOHND	/PRESERVE POSSIBLE SYS ON OUTPUT
	TAD (7		/DEFAULT TO BLOCK 7
	DCA OUTBLK	/INITIAL GUESS
	CDF 10		/NOW TRY TO READ DIRECTORY OF OUTPUT
	JMS I (OTYPE	/IF NON-FILE, DON'T READ IT
	SMA CLA
	JMP P1A
	CIF 0		/COULD BE NON-FILE, HOWEVER.
	JMS I NOHND
	0210
	1400
P1,	1
	JMP I (SQIDER+1	/ERROR IN READ
P1A,	DCA OLDDIR	/WIPES ANY DIRECT. SEGMENT
	TAD I (1401
	TAD (-70	/IS OUTPUT A SYS DEVICE?
	SNA CLA
	JMP SYSDIR	/YES.
	TAD NOHND	/IS OUTPUT THE SYSTEM DEVICE?
	TAD (171
	SZA CLA
	JMP .+3
SYSDIR,	TAD (70
	DCA OUTBLK
	JMP I SQDTST

NOHND=FAKE

SYSZRO,	TEXT /ZERO SYS?/
AOUERR,	SMA CLA		/WAS IT A DEVICE ERROR OR ARE WE OUT OF SPACE?
	JMP BOUERR	/OUT OF SPACE
PER2,	JMS I (PIPERR
	2
BOUERR,	JMS I (PIPERR
	0

ASCPTCH,TAD (ACHLP+1	/V3C FAKE OUT ICHAR
	DCA I (ICHAR	/SIMULATE CALL TO ICHAR FROM 'ACHLP'
	JMP I (GETNEW	/V3C SIMULATE OCCURRENCE OF 8-BIT ^Z IN ICHAR
	PAGE
/THIS IS ONCE-ONLY CODE

ONCE,	0
	STA
	TAD ONCE
	DCA ONCENF
	TAD (20
	DCA I ONCENF	/RESTORE L20, DON'T ALLOW REENTRY
	TAD I (MPARAM+1
	AND (7
	SNA CLA		/IS /V SET?
	JMP I ONCE	/NO, RETURN
	TAD (VER	/YES
	JMS I (ERPRNT	/PRINT VERSION NUMBER
	JMP I ONCE	/RETURN

VER,	TEXT	\OS/8 PIP V14A\
ONCENF,	0
GETEQ,	0		/V3
	TAD I (MPARAM+3
	SNA
	IAC
	AND (77		/CONVERT 0 TO 1 AND 100 TO 0
	CIA
	JMP I GETEQ

DVREDE,	0	/READ DEVICE WITH BAD BLOCK REFERENCED
	TAD I (OZHNDL	/GET DEVICE ENTRY POINT
	DCA NEWHL
	CIF 0
	JMS I NEWHL	/DO THE READ
	0011
	0
	-111		/NEGATIVE BLOCK - RETURNS MINUS LENGTH
	CIF 10
	JMP I DVREDE	/ERROR RETURN FOR READ YIELDS DESIRED RESULTS
NEWHL,	0
	PAGE
	$


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/README.V3F. 
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

OS/8 Version 3F					27-Jul-1995



This archive directory contains the source files for the OS/8 
operating system version 3F that have been identified todate.
This is not the complete release and may have been released
as a maintenance update. The files listed below have been 
updated from the base V3D release and are useful in tracking
the development of OS/8.

	The comments in OS8.PA denote this file as version 3F, 
but this file is NOT the same as the OS/78 V2 source. OS/8 V3F
and OS/78 V2 seem to be parallel developments, since neither 
refers to the other. It is not known just when these files 
were released. The primary change to OS8 is adding access to 
memory above 32K. 

	Contained here is the last known release of RESORC,
which has been converted from the PAL to the MACREL
assembler. Also here are new handlers (not in V3D) for the 
RL disks, RX02 floppies in several flavors, and VX virtual
memory.

	The OS8V3F.EXE file is a self extracting ZIP file of 
the V3F sources included here. Simply run OS8V3F.EXE on a PC 
to extract the V3F source files.



BLOAD.PA
BOOT.PA
BPAT.PA
BUILD.PA
CCL.BI
CCL.MA
CCLAT.MA
CCLCD.MA
CCLCDX.MA
CCLCOR.MA
CCLDAT.MA
CCLDRV.MA
CCLMSG.MA
CCLPS.MA
CCLREM.MA
CCLRUN.MA
CCLSB2.MA
CCLSEM.MA
CCLSIZ.MA
CCLSUB.MA
CCLTAB.MA
CCLTBL.MA
CD.PA
FPAT.PA
FUTIL.PA
KL8E.PA
OS78.BI
OS8.PA
PAL8.PA
PIP.PA
README.V3F
RESORC.BI
RESORC.MA
RESOV0.MA
RESOV1.MA
RESOV2.MA
RESOVD.MA
RKA0.DI
RKB0.DI
RL0.PA
RL1.PA
RL2.PA
RL3.PA
RLC.PA
RLFRMT.PA
RLSY.PA
RTL.PA
RTS.PA
RX78C.PA
RXCOPY.PA
RXNS.PA
RXSY1.PA
RXSY2.PA
SAVECB.PA
TECO.PA
VXNS.PA
VXSY.PA


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/README.md. 
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

# OS/8 V3F

This directory contains source files in `PAL-8` and `MACREL` labeled as OS/8 v3F.
It appears to be a nearly complete source distribution for the OS/8 V3D
Device Extensions Kit.

See also: [our documentation on theOS/8 V3D Device Extensions][extensions-doc].

## Recent updates:

### Cleanup newlines

There were a couple places where, either in data transmission erorrs, or odd
formatting, an OS/8 newline was followed by an extra linefeed character. Because
we are going to be actively using these sources, copying them into and out of
OS/8, these files have been edited into canonical form.

Files affected:  `BUILD.PA`, `CCLTAB.MA`, `OS8.PA.`
This does subtly affect a `TECO` macro in `CCLTAB.MA`, but the change is
in a print message getting a `\r` changed to `\r\n`.  It should be totally
benign.

### Improved build batch files

`CCL.BI` and `RESORC.BI` have been modified to name different devices
for input and output files.  You still need to do the device assignments:

    ASSIGN RKA1 IN
    ASSIGN RKB1 OUT

`RESORC.BI` chained to a script, `MOVE.BI` that is supposed to move the
output from `LINK` from `DSK:` to `OUT:` but that script is not present.
So `COPY` and `DEL` commands to do that were added to the `RESORC.BI` and
`CCL.BI`.

## Utilization:

The file `actions.txt` is to be submitted to our os8-cp utility as follows:

    ../../bin/os8-cp --action-file actions.txt

This will create the rk05 image file `os8-v3f-build.rk05` with the sources in
partition A.  We expect a builder script to be written, which may live in
mkos8 will then build the components as they are validated.

## History

These sources were nearly lost.

ibiblio.org has a file, `readme.v3f` describing a self extracting archive,
`OS8V3F.EXE` that contains the sources.  But that file is not present.
However a [mirror site of Johnny Billquist's arcihve][rtk-mirror] had both readme and
the .exe.

I believe the designation, "fromnichols" means that the collection was from
Lee Nichols, a steering committee member of the 12-Bit SIG special interest group
for 12 bit computers.

The `readme.v3f` appears in this directory as `README.V3F`. We copy it into
the build RK05 image as `README.TX`.

[rtk-mirror]:http://rtk.mirrors.pdp-11.ru/ftp.update.uu.se/pdp8/pdp-8/fromnichols/
[extensions-doc]:https://tangentsoft.com/pidp8i/doc/trunk/doc/os8-v3d-device-extensions.md

<code>
## Contents of readme.v3f

OS/8 Version 3F					27-Jul-1995



This archive directory contains the source files for the OS/8 
operating system version 3F that have been identified todate.
This is not the complete release and may have been released
as a maintenance update. The files listed below have been 
updated from the base V3D release and are useful in tracking
the development of OS/8.

	The comments in `OS8.PA` denote this file as version 3F, 
but this file is NOT the same as the OS/78 V2 source. OS/8 V3F
and OS/78 V2 seem to be parallel developments, since neither 
refers to the other. It is not known just when these files 
were released. The primary change to OS8 is adding access to 
memory above 32K. 

	Contained here is the last known release of `RESORC`,
which has been converted from the `PAL` to the `MACREL`
assembler. Also here are new handlers (not in V3D) for the 
RL disks, RX02 floppies in several flavors, and VX virtual
memory.

	The `OS8V3F.EXE` file is a self extracting ZIP file of 
the V3F sources included here. Simply run `OS8V3F.EXE` on a PC 
to extract the V3F source files.



`BLOAD.PA`
`BOOT.PA`
`BPAT.PA`
`BUILD.PA`
`CCL.BI`
`CCL.MA`
`CCLAT.MA`
`CCLCD.MA`
`CCLCDX.MA`
`CCLCOR.MA`
`CCLDAT.MA`
`CCLDRV.MA`
`CCLMSG.MA`
`CCLPS.MA`
`CCLREM.MA`
`CCLRUN.MA`
`CCLSB2.MA`
`CCLSEM.MA`
`CCLSIZ.MA`
`CCLSUB.MA`
`CCLTAB.MA`
`CCLTBL.MA`
`CD.PA`
`FPAT.PA`
`FUTIL.PA`
`KL8E.PA`
`OS78.BI`
`OS8.PA`
`PAL8.PA`
`PIP.PA`
`README.V3F`
`RESORC.BI`
`RESORC.MA`
`RESOV0.MA`
`RESOV1.MA`
`RESOV2.MA`
`RESOVD.MA`
`RKA0.DI`
`RKB0.DI`
`RL0.PA`
`RL1.PA`
`RL2.PA`
`RL3.PA`
`RLC.PA`
`RLFRMT.PA`
`RLSY.PA`
`RTL.PA`
`RTS.PA`
`RX78C.PA`
`RXCOPY.PA`
`RXNS.PA`
`RXSY1.PA`
`RXSY2.PA`
`SAVECB.PA`
`TECO.PA`
`VXNS.PA`
`VXSY.PA`
</code>

### <a id="license"></a>License

Copyright © 2018 by Bill Cattey. Licensed under the terms of
[the SIMH license][sl].

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RESORC.BI. 
1
2
3
4
5
6
7
8
9
10
11
12

$JOB ASSEMBLE AND LINK RESORC.MA
.MAC OUT:RESORC<IN:RESORC.MA
.MAC OUT:RESOV0<IN:RESOV0.MA
.MAC OUT:RESOV1<IN:RESOV1.MA
.MAC OUT:RESOV2<IN:RESOV2.MA
.MAC OUT:RESOVD<IN:RESOVD.MA
.LINK OUT:RESORC,RESOV0,RESOV1,RESOV2,RESOVD/9/S=12000
.DEL OUT:RESO??.RB
.COPY OUT:RESORC.SV<DSK:RESORC.SV
.DEL DSK:RESORC.SV
$END


<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RESORC.MA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149

/15 OS/8 RESOURCES PROGRAM
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975,1977,1978 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/


/	J.M.

/SAVE INFO:

/INSTRUCTIONS FOR CREATING RESORC.SV V5A

/	.MAC RESORC
/	.MAC RESOV0
/	.MAC RESOV1
/	.MAC RESOV2
/	.MAC RESOVD
/	.LINK RESORC,RESOV0,RESOV1,RESOV2,RESOVD/9/S=12000



/CORE MAP:

/0000-1777	C.D.
/2000-2377	DEVICE NAME AND LENGTH TABLE
/2400-2777	OUTPUT BUFFER (DOESN'T OVERLAP BETA REGISTER)
/3000-3377	INPUT HANDLER
/3400-3777	OUTPUT HANDLER
/4000-7377	INPUT DIRECTORY
/4000-7577	INPUT HANDLERS (LOSE 2ND HALF OF LAST ONE)

/FIELD 1

/10000-11777	USR
/11400-11777	INPUT KBM
/12000-15577	PROGRAM
/15600-16177	INPUT BLOCK 0
/16200-17577	INPUT USR

	INPBL0=5600
	INPKBM=1400
	INPUSR=6200
	INPHND=4000

	FAST=20
	DIG=21
	EXTEN=22

	DEVNUM=23	/DEVICE NUMBER OF HANDLER
	CNT=24
	PDNT=25		/PTS TO DEVICE NAME TABLE
	TEMP=26
	PUDNT=27	/PTS TO USER DEVICE NAME TABLE
	PDHIT=30	/PTS TO DEVICE HANDLER INFO TABLE
	PDCWT=31	/PTS TO DEVICE CONTROL WORD TABLE
	PTYP=32
	LFT=33
	RT=LFT+1
	DVNO=35
	BLOC=36
	PDHRT=37	/POINTS TO DEVICE HANDLER RESIDENCY TABLE
	UN=6
	X0=10
	XR1=11

	RESVERSION="A

/FIXES SINCE FIELD TEST RELEASE:

/1.	'INPUT ERROR' MESSAGE NO LONGER GARBLED
/2.	'%NON SYSTEM DEVICE' NEVER PRINTS HANDLERS

/FIXES FOR MAINTENANCE RELEASE (V3C):

/3.	INCORPORATED  PATCH SEQ NO 1 ALLOWS DISTINGUISHING BETWEEN
/	HIGH AND LOW SPEED PTR'S AND ADDITIONAL CASSETTES
/	[DSN FEB 1975]

/4.	FIXED LENGTHS OF DF32'S AND RF08'S [SUPERSEDES PATCH SEQ #2
/	DSN APR 1975]

/5.	CHANGED VERSION NUMBER TO V3, UPDATED COPYRIGHT
/6.	ADDED DUMP, LST, AND RX-- TO INTERNAL NAME TABLES

/7.	ADDED DETAILS ABOUT DUMP AND FLOPPIES TO TABLES

/V3D CHANGES:

/8.	ADDED NAMES SLU AND LQP TO TABLES
/9.	CAN DISTINGUISH LQP KIND OF LPTR
/10.	FIXED BUG ABOUT DUMPING BUFFER FULL OF NULLS
/11.	REMOVED LITTLE-USED 'OUT', 'DEV' FROM NAME TABLES

/VERSION 5

/12.	ADDED RL01 SUPPORT
/13.	CONVERTED TO MACREL
/14.	ADDED LINKER OVERLAYS
/15.	ADDED RX02 SUPPORT
/16.	ADDED VXA0 SUPPORT
	.EXTERNAL VERSN,SIZE,BLOCK,MODE, ENTRY	/IN OV3
	.EXTERNAL DIRT,KIND,CNTSLT,ZEROSL
	.EXTERNAL TYPTBL
	.GLOBAL GETTYP,PUTNAM,PUTO,PUTSP,CRLF,DPRINT
	.GLOBAL FREEDV,OPRINT,READI,SLOTAB,PRINT
	FIELD 1

	*2000

START,	SKP
	JMP NOCD	/CHAIN ENTRY POINT
/	JMS I (7700	/WE ASSUME THE USR IS IN CORE
/	10		/DON'T HAVE TO LOCK USR IN CORE IF JSW SET RIGHT
CD,	JMS I (200
	5		/COMMAND DECODE
	2331		/DEFAULT INPUT EXTENSION = 'SY'
NOCD,	DCA CTRLO
	JMS OPENO	/OPEN OUTPUT FILE
	DCA FILENO
	TAD (7617
	DCA INPTR	/POINT TO FIRST INPUT FILE
	TAD I (7644
	AND (4		/ V OPTION?
	SZA CLA
	JMS TYPEV	/OUTPUT VERSION #
	JMS SETSW
	DCA FLAG
	TAD I (7617
	SNA CLA
	JMS SPCASE	/NO FIRST ARG MEANS USE SYS: IN SPECIAL SENSE
	JMP INL2
INLOOP,	TAD I INPTR	/GET INPUT FILE # AND LENGTH
	SNA CLA
	JMP FINI	/NO MORE INPUT
	JMS PRDASH
INL2,	TAD I INPTR
	AND (17
	DCA DVNO	/GET 4-BIT DEVICE #
	ISZ FILENO
	TAD I INPTR
	AND (7760	/GET NEGATIVE OF FILE LENGTH
	DCA FILEN
	ISZ INPTR
	TAD I INPTR	/GET STARTING BLOCK OF FILE
	DCA SBLOCK
	ISZ INPTR
	TAD DVNO
	JMS GETDCW
	SMA CLA
	JMP NOFLST	/DEVICE IS NOT FILE STRUCTURED
	JMS OPENI	/GET INPUT HANDLER
	JMS DIRECT	/ASCERTAIN DIRECTORY INFO
	JMS HNDLRS	/ASCERTAIN HANDLERS
	TAD EXTEN
	SZA CLA
	JMS I (CNTSLT
	JMS MONVER	/ASCERTAIN MONITOR VERSION #
NEXT,	JMS CRLF
	DCA FLAG
	JMP INLOOP
NOFLST,	JMS PRINT
	TEXT	/%DEV IS NOT FILE STRUCTURED/
	JMP NEXT

FINI,	JMS CLOSEO	/CLOSE OUTPUT FILE
FINIS,	TAD I (7642
	SMA CLA
	JMP CD		/COMMAND LINE ENDED WITH CR
	CIF CDF 0	/COMMAND LINE ENDED WITH ALTMODE
	JMP I (7605	/GO BACK TO MONITOR

/CURRENT PIP /Y FILES ARE 50 (DEC) = 62 (OCTAL) BLOCKS LONG

GETDCW,	0
	AND (17
	TAD (7757	/GET PTR INTO DEVICE CONTROL WORD TABLE
	DCA DCW
	TAD I DCW	/GET D.C.W.
	DCA DCW		/SAVE (WHY?)
	TAD DCW
	JMP I GETDCW

SETSW,	0
	DCA FAST
	DCA EXTEN
	CLA IAC
	AND I (7643
	SNA CLA
	JMP NOTF
	ISZ FAST
	JMP I SETSW
NOTF,	TAD I (7643
	AND (200
	SNA CLA
	JMP I SETSW
	ISZ EXTEN
	ISZ FAST
	JMP I SETSW

/FAST GT 0 IF /L OR /E SWITCH SET
/EXTEN=1 IF /E SWITCH SET AND /L NOT SET
INPTR,	0		/POINTS TO INPUT FILE LIST
FILEN,	0		/INPUT FILE LENGTH (NEG IN BITS 0-7)
DCW,	0		/INPUT DEVICE CONTROL WORD
FILENO,	0		/INPUT FILE NUMBER IN INPUT LIST
SBLOCK,	0		/STARTING BLOCK # OF INPUT FILE
FLAG,	0		/NON-ZERO MEANS SPECIAL CASE OF NO FIRST ARG

SPCASE,	0
	ISZ FLAG	/NOTE SPECIAL CASE
	CLA IAC
	DCA I (7617	/FORCE FIRST INPUT TO BE SYS:
	JMP I SPCASE
	PAGE
PRINT,	0
	TAD I PRINT
	DCA PRT
	ISZ PRINT
	TAD PRT
	JMS RTR6
	JMS PR
	JMP I PRINT
	TAD PRT
	JMS PR
	JMP I PRINT
	JMP PRINT+1
PRT,	0
RTR6,	0
TTY212,	RTR
	RTR
	RTR
	JMP I RTR6

PR,	0
	AND (77
	SNA
	JMP I PR
	TAD (240
	AND (77
	TAD (240
	JMS PUTO
	ISZ PR
	JMP I PR

TPRINT,	0		/PRINT TO TELETYPE
	CLA
	TAD I TPRINT
	DCA PRT
	ISZ TPRINT
	TAD PRT
	JMS RTR6
	JMS TPUT
	TAD PRT
	JMS TPUT
	JMP TPRINT+1

TPUT,	0
	AND (77
	SNA
	JMP PUTCR
	TAD (240
	AND (77
	TAD (240
	JMS TYPE
	JMP I TPUT

PUTCR,	JMS TCRLF
	JMP I TPRINT
TYPE,	0
	DCA TYTEM
	TAD CTRLO
	SZA CLA
	JMP I TYPE	/DON'T TYPE IF CONTROL/O FLAG SET
	KSF
	SKP
	JMS LOOKC
	TAD TYTEM
A,	JMS TYPE2
	JMP I TYPE

TYTEM,	0
CTRLO,	0		/NON-ZERO MEANS CTRLO/O WAS STRUCK

TYPE2,	0
	TLS
	TSF
	JMP .-1
	CLA
	JMP I TYPE2

LOOKC,	0
	KRB
	AND (177
	TAD (-17
	SNA		/IS IT ^O?
	JMP CTROLO	/YES
	TAD (17-3	/NO
	SZA CLA		/IS IT ^C?
	JMP I LOOKC	/NO
	CIF CDF 0	/YES
	JMP I (7605
CTROLO,	TAD ("^
	JMS TYPE2
	TAD ("O
	JMS TYPE2
	ISZ CTRLO
	TAD (215
	JMS TYPE2
	TAD TTY212
	JMP A

/*** NEEDS CTRL/S CTRL/Q SUPPORT
TYPEV,	0
	JMS PRINT
	TEXT	/RESORC V5 /
	*.-2
	RESVERSION&77+6500	/THIS OVERLAYS ABOVE VERSION NO
				/AND THE 6500 INCREASES TO 6600
				/FOR THE NEXT RELEASE
	*.+1
	JMS CRLF
	JMP I TYPEV

CRLF,	0
	TAD (215
	JMS PUTO
	TAD TTY212
	JMS PUTO
	JMP I CRLF

TCRLF,	0
	TAD (215
	JMS TYPE
	TAD TTY212
	JMS TYPE
	JMP I TCRLF

DLST,	-1750	/1000
	-144	/100
	-12	/10
	-1	/1
	0	/END
	PAGE
CLOSEO,	0		/CLOSE OUTPUT FILE
	TAD (232	/PUT ^Z IN BUFFER
	JMS PUTO
	TAD (-577	/V3D
	DCA KNT		/SEND 577 NULLS TO OUTPUT BUFFER
	JMS PUTO	/THIS GUARANTEES TO PURGE IT
	ISZ KNT
	JMP .-2
	TAD I (7600
	JMS I (200
	4		/CLOSE
L7601,	7601		/POINTER TO OUTPUT FILE NAME
OUTLEN,	0		/LENGTH OF OUTPUT FILE
	HLT		/SYSTEM ERROR, CANNOT OCCUR
	JMP I CLOSEO
OPENO,	0
	JMS OINIT
	DCA OUTLEN
	TAD (3401
	DCA OENTRY
	TAD I (7600
	SNA CLA
	JMP DEFALT
	TAD I (7600
	JMS GETDCW
	RAL
	SPA CLA
	JMP NOWR	/READ ONLY
	TAD I (7600
	JMS I (200
	1		/FETCH DEVICE HANDLER (POSSIBLY 2-PAGE)
OENTRY,	3401		/INTO PAGE 3400
	HLT		/SYSTEM ERROR CANNOT OCCUR
O2,	TAD L7601
	DCA SBLKO
	TAD I L7601
	SNA
	TAD (2205	/RE
	DCA I L7601	/DEFAULT OUTPUT NAME IS RE
	DCA OLEN
	TAD I (7604
	SNA
	TAD (1423	/LS
	DCA I (7604	/ .LS IS DEFAULT OUTPUT EXTENSION
	TAD I (7600
	JMS I (200
	3		/ENTER OUTPUT FILE
SBLKO,	7601		/POINTS TO OUTPUT FILE NAME
OLEN,	0		/COMPLEMENT OF ACTUAL OUTPUT FILE LENGTH
	JMP DEVFUL	/OUTPUT DEVICE FULL
	TAD SBLKO
	DCA OBLOCK
	TAD OLEN
	SZA
	TAD (-1
	DCA OLEN
	JMP I OPENO

KNT,	0
DEFALT,	TAD (3100	/SET TTY: AS DEFAULT OUTPUT DEVICE
	DCA DVN
	TAD (3401
	DCA OENT
	JMS I (200
	1		/FETCH HANDLER BY NAME
	2424		/TT
DVN,	3100		/DEVICE TTY:
OENT,	3401		/INTO 3400
	JMP NOTTY	/NO TTY: ON SYS:
	TAD OENT
	DCA OENTRY
	TAD DVN
	DCA I (7600
	JMP O2

OUTERR,	JMS TPRINT
	TEXT	/?OUTPUT ERROR/
	JMS CRLF
	JMP FINIS
TRY09,	0
	TAD (60
	CIA
	TAD NAM
	DCA DIG
	TAD DIG
	CLL
	TAD (-10	/TRY DIGITS 0-7
	SZL CLA
	JMP I TRY09
	TAD DIG
	TAD (60
	TAD RT
	DCA RT
	JMP GOTIT

PUTSP,	0
	TAD (40
	JMS PUTO
	JMP I PUTSP
	PAGE
PUTO,	0
	AND (377
	CDF 0
	JMP I PUTJMP
PUTJMP,	X1
X1,	DCA I PUTPT1
	TAD (X2
	DCA PUTJMP
PUTLV,	CDF 10
	JMP I PUTO	/RETURN

X2,	DCA I PUTPT2
	TAD (X3
	DCA PUTJMP
	JMP PUTLV

X3,	DCA TMP
	TAD TMP
	CLL RTL
	RTL
	AND (7400
	TAD I PUTPT1
	DCA I PUTPT1
	TAD TMP
	CLL RTR
	RTR
	RAR
	AND (7400
	TAD I PUTPT2
	DCA I PUTPT2
	ISZ PUTPT1
	ISZ PUTPT1
	ISZ PUTPT2
	ISZ PUTPT2
	TAD (X1
	DCA PUTJMP
	ISZ PUTKNT
	JMP PUTLV
	CDF 10		/BUFFER FILLED
	ISZ OLEN
	SKP
	JMP DEVFUL	/CAN'T WRITE ANYMORE
	CIF 0
	TAD OENTRY
	DCA OENTR	/GET ON SAME PAGE
	JMS I OENTR
	4200		/WRITE 1 BLOCK
	2400		/FIELD 0, LOC 2400
OBLOCK,	0		/OUTPUT BLOCK #
	JMP OUTERR
	ISZ OUTLEN
	ISZ OBLOCK	/POINT TO NEXT BLOCK
	JMS OINIT
	JMP I PUTO	/RETURN
OENTR,	0
PUTPT1,	0
PUTPT2,	0
PUTKNT,	0

TMP,	0
DIRECT,	0
	TAD SBLOCK
	SZA CLA
	JMP I DIRECT	/NO DIRECTORY INFO FOR FILES
	JMS I (DIRT
	JMP I DIRECT

SLOTAB,	ZBLOCK 10	/KEEPS TRACK OF USED SLOTS

GETTYP,	0
	CDF 0
	TAD I PTYP
	CDF 10
	JMP I GETTYP
PUTNAM,	0
	DCA PUTNMT
	TAD I PUTNMT
	JMS PUTPAK
	ISZ PUTNMT
	TAD I PUTNMT
	JMS PUTPAK
	JMP I PUTNAM
PUTNMT,	0
/THIS PRINTS A 4 CHAR NAME, ARG IN AC.

COMB,	0		/TEMP
	TAD LFT
	TAD RT
	SMA
	TAD (4000
	JMP I COMB
	PAGE
NAME,	0
	DCA NAM
	TAD FAST
	SZA CLA
	JMP TRY1
	STA
	TAD DEVNUM
	SNA CLA
	JMP TRY1
	TAD (",
	JMS PUTO
TRY1,	TAD (LIST1
	DCA NM1
LP1,	TAD I NM1
	SNA
	JMP TRY2
	DCA LFT
	ISZ NM1		/TRY A-B
	TAD (-2		/CHANGE TO -4 TO TRY A-D
	DCA TEMP
	DCA RT
LP1X,	TAD RT
	TAD (100
	DCA RT
	JMS COMB
	JMS TRY09
	ISZ TEMP
	JMP LP1X
	JMP LP1

NAM,	0		/SPECIFIED NAME
NM1,	0

TRY2,	TAD (LIST2
	DCA NM1
LP2,	TAD I NM1
	SNA
	JMP TRY3
	DCA LFT
	ISZ NM1
	TAD I NM1
	ISZ NM1
	DCA RT
	JMS COMB
	DCA TEMP
	TAD TEMP
	CIA
	TAD NAM
	SNA CLA
	JMP GOTIT
	TAD TEMP
	JMS TRY09
	JMP LP2
/TRY0 SHOULD BE SPECIAL CASE TESTS

TRY3,	TAD NAM
	JMS RTR6
	AND (37
	SNA
	JMP TRY4
	JMS SETIFA
	CLL RAR
	JMS RTR6
	DCA LFT
	TAD NAM
	AND (77
	JMS SETIFA
	TAD LFT
	DCA LFT
	DCA RT
	JMP GOTIT

SETIFA,	0
	SNA
	JMP I SETIFA
	TAD (-33
	SPA
	JMP LETR
	TAD (33-60
	CLL
	TAD (-12
	SZL
	JMP NODI
	TAD (12+60-33
LETR,	TAD (33
	JMP I SETIFA
NODI,	CLA
TRY4,	TAD NAM
	JMS NNAME
NAMLV,	JMP I NAME
CMFLG,	0

/COMB,	0
/	TAD RT
/	SZA CLA
/	STA
/	DCA CMFLG
/	TAD LFT
/	TAD RT
/	ISZ CMFLG
/	JMP I COMB
/	CLL RAL
/	STL RAR
/	JMP I COMB	/TURN ON BIT 0 OF 1 WORD NAME

LIST1,		TEXT	/DTMTLTTDCSRKRFRXVX/

PRDASH,	0
	JMS PRINT
	TEXT	/----/
	JMS CRLF
	JMS CRLF
	JMP I PRDASH
RTL6,	0
	RTL
	RTL
	RTL
	JMP I RTL6
	PAGE
DEVFUL,	JMS TPRINT
	TEXT	/?OUTPUT DEV FULL/
	JMP FINIS

NOWR,	JMS TPRINT
	TEXT	/?OUTPUT DEV IS READ-ONLY/
	JMP FINIS
NOTTY,	JMS TPRINT
	TEXT	/?TTY DOES NOT EXIST/
	JMP FINIS
OINIT,	0
	TAD (-200
	DCA PUTKNT
	TAD (2400
	DCA PUTPT1
	TAD (2401
	DCA PUTPT2
	TAD (X1
	DCA PUTJMP
	JMP I OINIT
READI,	0
	TAD I READI
	DCA ARG1
	ISZ READI
	TAD I READI
	DCA ARG2
	ISZ READI
	TAD I READI
	DCA ARG3
	ISZ READI
	CIF 0
	JMS I IENTRY
ARG1,	0
ARG2,	0
ARG3,	0
	JMP INERR
	JMP I READI	/REURN

INERR,	JMS TPRINT
	TEXT	/?INPUT ERROR/
	JMP FINIS

OPENI,	0		/FECTH INPUT HANDLER
	TAD (3001	/INTO PAGES 3000, 3200
	DCA IENTRY
	TAD DVNO
	JMS I (200
	1		/FETCH HANDLER
IENTRY,	3001
	HLT		/SYSTEM ERROR, CAN'T OCCUR
	JMP I OPENI
	PAGE
/DECIMAL PRINT
/LINK OFF MEANS PRINT LEADING SPACES
/LINK ON MEANS DON'T PRINT LEADING SPACES OR ZEROS

DPRINT,	0
	DCA DTM
	RAR
	DCA LNK
	DCA ZFLG
	TAD (DLST
	DCA PLST
DPL2,	DCA DYG
DPLUP,	TAD I PLST
	SNA
	JMP I DPRINT
	CLL
	TAD DTM
	SNL
	JMP NEGG
	ISZ DYG
	DCA DTM
	JMP DPLUP

NEGG,	CLA
	TAD DYG
	TAD ZFLG
	SNA
	JMP PRBLNK
	TAD (60
	JMS PUTO
	STL CLA RAR	/4000
	DCA ZFLG
ISZZ,	ISZ PLST
	JMP DPL2

PRBLNK,	TAD LNK
	CLL RAL
	TAD L40
	SNL
	JMS PUTO
	CLA
	JMP ISZZ
DYG,	0
PLST,	0
ZFLG,	0		/4000 MEANS PASSED LEADING ZEROES
LNK,	0
/PRINTS A 2-DIGIT OCTAL NUMBER WITH LEADING 0'S

OPRINT,	0
	DCA OTEM
	TAD OTEM
	RTR
	RAR
	JMS OPRI
	TAD OTEM
	JMS OPRI
	JMP I OPRINT

OPRI,	0
	AND (7
	TAD (260
	JMS PUTO
	JMP I OPRI

PRINT4,	0
	DCA DTM
	TAD DTM
	JMS RTR6
	JMS OPRINT
	TAD DTM
	JMS OPRINT
	JMP I PRINT4

DTM,	0

PUTPAK,	0
	DCA DTM
	TAD DTM
	JMS RTR6
	JMS PR
	JMS BLNKIT
	TAD DTM
	JMS PR
	JMS BLNKIT
	JMP I PUTPAK

BLNKIT,	0
	TAD FAST
	SZA CLA
	TAD L40
	JMS PR
L40,	40		/CAN'T HURT TO CALL PR WITH A 0
	JMP I BLNKIT
OTEM,	0
/DIR DID NOT GET IN CORE ON /F?

DEV,	DCA BLCK0
	TAD (66
	DCA BLCK66
	TAD (7
	DCA KBM
	TAD (13
	DCA USRBLK
	CDF 0
	TAD I (4001	/GET STARTING BLOCK # OF FILES
	CDF 10
	TAD (-7
	SNA CLA
	JMP NONSYS	/FILES START AT BLOCK 7 OF DEVICE
	TAD (16
/CHECK TO SEE THAT DEVICE HAS SYSTEM ON IT
	JMP RD

NONSYS,	JMS PRINT
	TEXT	/%NON SYSTEM DEVICE/
	JMP NEXT
	PAGE
MONVER,	0
	TAD FAST
	SNA CLA
	JMP I MONVER
	TAD I (1400
	TAD (-7607
	SNA
	JMP NOTV3
	TAD (7607+60
	DCA TEMPX
	TAD I (1400+31
	DCA TMPTWO
OS8,	TAD ("O
	JMS PUTO
MONV2,	JMS PRINT
	TEXT	\S/8 V\
	TAD TEMPX
	JMS PUTO
	TAD TMPTWO
	JMS PUTO
	JMS CRLF
	JMP I MONVER

TMPTWO,	0
TEMPX,	0

NOTV3,	TAD (40
	DCA TMPTWO
/CHECK FOR PS/8 AND COS
	JMP OS8
LIST2,	DEVICE LPT
	DEVICE TTY
	DEVICE PTR
	DEVICE PTP
	DEVICE CDR
	DEVICE SYS
	DEVICE DSK
	DEVICE CDP
/	DEVICE DEV
/	DEVICE OUT
/	DEVICE INP
	DEVICE BAT
	DEVICE NULL	/SHOULD BE IN NEXT TABLE
	DEVICE LST	/V3C
	DEVICE DUMP
	DEVICE SLU
	DEVICE LQP
	DEVICE RL0A
	DEVICE RL0B
	DEVICE RL0C
	DEVICE RL1A
	DEVICE RL1B
	DEVICE RL1C
	DEVICE RL2A
	DEVICE RL2B
	DEVICE RL2C
	DEVICE RL3A
	DEVICE RL3B
	DEVICE RL3C
	DEVICE VXA0
	0

/LIST3,	DEVICE NULL
/	DEVICE TEST
/	DEVICE LIST
/	DEVICE DUMP	/V3C
/	ZBLOCK 2	/PATCH SPACE
/	0

/INTERESTING NOTE: 'BAT', 'FOO2' AND 'RKC6' ALL HASH OUT TO 6601
/** WANT TO CHANGE AIW PRINTER TO SAY 'NO' ADDITIONAL INFO WORDS
/IF THERE ARE NONE.
/DTN
/DKN
GOTIT,	TAD FAST
	SZA CLA
	JMS PUTSP
	TAD (LFT
	JMS PUTNAM
	TAD FAST
	SZA CLA
	JMS PUTSP
	JMP NAMLV
BADFIL,	JMS PRINT
	TEXT	/%NOT A SYSTEM HEAD/
	JMP NEXT
	PAGE
/FORMAT OF SYSTEM HEAD FILE

/REL BLK	CONTENTS	ABS BLK ON DEV

/0	BOOTSTRAP & PAGE 0'S	0
/1-4	KEYBOARD MONITOR	7-12
/5-7	USR			13-15
/10-17	DEVICE HANDLERS		16-25
/20	ENTER			26
/21-42	SCRATCH BLOCKS		27-50
/43-45	COMMAND DECODER		51-53
/46-47	SAVE,DATE		54-55
/50	ERROR OVERLAY		56
/51	CHAIN OVERLAY		57
/52-55	ODT			60-63
/56	RESERVED FOR EXPN	64
/57	CCL SCRATCH		65
/60	12K TD8E HANDLER	66
/61	CCL OVERLAY		67
HNDLRS,	0
	TAD SBLOCK
	SNA		/IS IT A FILE?
	JMP DEV		/NO
	DCA BLCK0	/YES
	TAD BLCK0
	TAD (60
	DCA BLCK66
	TAD FILEN
	TAD (-6340
	SZA CLA
	JMP BADFIL	/FILE DOESN'T HAVE LENGTH 50 (DECIMAL)
	TAD BLCK0
	IAC
	DCA KBM
	TAD BLCK0
	TAD (5
	DCA USRBLK
	TAD BLCK0
	TAD (10
RD,	DCA HNDBLK
	JMS READI	/READ IN BLOCK 0
	210		/2 PAGES
	INPBL0
FREEDV,		/# OF FREE DEVICE NUMBERS
BLCK0,	0
	TAD I (INPBL0+212	/** DEPENDS ON TD8E HANDLER
	TAD (-3
	SZA CLA		/IS IT 12K TD8E?
	JMP NOTD8E	/NO
	JMS READI	/YES
	110		/1 PAGE
	INPBL0
BLCK66,	66
NOTD8E,	TAD I (INPBL0+200
	TAD (-4207
	SZA CLA
	JMP BADMON	/BAD MONITOR ON DEVICE
	DCA 7		/DELETE CURRENT USR DIRECTORY SEGMENT
			/SINCE KBM READS OVER IT
	JMS READI	/READ IN KEYBOARD MONITOR
	211		/ONLY FIRST 2 PAGES
	INPKBM
KBM,	7
	JMS READI	/READ IN USR
	611		/6 PAGES
	INPUSR
USRBLK,	13
	JMS READI	/READ IN ALL HANDLERS (EXCEPT 2ND PAGE OF LAST ONE)
	1700		/17 PAGES
	INPHND
HNDBLK,	16
	TAD (-17
	DCA CNT
	DCA FREEDV
	JMS ZEROSL
	DCA DEVNUM
	JMS SETPTS
	JMS HEADING
LOOP,	ISZ DEVNUM	/PT TO NEXT HANDLER
	TAD I PDNT	/LOOK AT DEVICE NAME
	SNA CLA
	JMP NOXXT
	TAD EXTEN
	SNA CLA
	JMP NONUM
	TAD DEVNUM
	JMS OPRINT
NONUM,	TAD I PDNT
	JMS NAME	/PRINT NAME
	TAD FAST
	SNA CLA
	JMP NEXXT
	JMS TIPE	/PRINT TYPE
	TAD EXTEN
	SNA CLA
	JMP PUSER
	JMS MODE	/PRINT MODE
	JMS SIZE	/PRINT SIZE
	JMS BLOCK	/PRINT BLOCK # OF LOC OF HANDLER
	STA
	DCA UN
	JMS KIND	/PRINT KIND
	JMS VERSN	/PRINT HANDLER VERSION #
	JMS ENTRY
PUSER,	TAD I PUDNT
	SNA CLA
	JMP EOL
	TAD I PUDNT
	JMS NAME	/PRINT USER NAME
EOL,	JMS CRLF
NEXXT,	ISZ PDNT
	ISZ PUDNT
	ISZ PDHIT
	ISZ PDCWT
	ISZ PDHRT
	ISZ CNT
	JMP LOOP
	JMS CRLF
	JMP I HNDLRS

NOXXT,	ISZ FREEDV
	JMP NEXXT
	PAGE
HEADING,0
	TAD FAST
	SNA CLA
	JMP I HEADING
	TAD EXTEN
	SNA CLA
	JMP REGLR
	JMS PRINT
	TEXT	/#  NAME TYPE MODE SIZ BLK KIND U V ENT USER/
	JMP HDLV
REGLR,	JMS PRINT
	TEXT	/ NAME TYPE USER/
HDLV,	JMS CRLF
	JMP I HEADING
SETPTS,	0
	TAD I (INPUSR+36
	TAD (INPUSR
	DCA PDNT
	TAD FLAG
	SZA CLA
	TAD (7741-141-INPBL0
	TAD (INPBL0+141
	DCA PUDNT
/CHANGE FOR FLAG?
	TAD I (INPUSR+37
	TAD (INPUSR
	DCA PDHIT
/FLAG?
	TAD (INPBL0+160
	DCA PDCWT
	TAD (INPBL0+47
	DCA PDHRT	/DEVICE HANDLER RESIDENCY TABLE
	JMP I SETPTS
CODE,	0		/DEVICE CODE

NNAME,	0
	DCA TIPE
	TAD ("(
	JMS PUTO
	TAD TIPE
	JMS PRINT4
	TAD (")
	JMS PUTO
	JMP I NNAME

TIPE,	0
	TAD I PDCWT
	RTR
	RAR
	AND (77
	DCA CODE
	TAD CODE
	CLL RTL
	TAD (TYPTBL
	DCA PTYP
	JMS GETTYP
	ISZ PTYP
	SNA
	JMP UNKN
	JMS PUTPAK
	JMS GETTYP
	JMS PUTPAK
	ISZ PTYP	/POINT TO SIZE
	JMP I TIPE
UNKN,	JMS PUTSP
	TAD CODE
	JMS OPRINT
	JMS PUTSP
	ISZ PTYP
	JMP I TIPE
BADMON,	JMS PRINT
	TEXT	/%BAD MONITOR/
	JMP NEXT
	PAGE
	PAGE


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RESOV0.MA. 
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

/1	OV0 FOR RESORC

	.ENTRY VERSN,SIZE,BLOCK,ENTRY,MODE
	.EXTERNAL GETTYP,DPRINT,OPRINT,PUTSP,PUTO
	.EXTERNAL SLOTAB,PRINT
	PDHRT=37
	PDCWT=31
	PTYP=32
	INPBL0=5600
	PDHIT=30
	INPHND=4000
	BLOC=36

	.RSECT OV3,LEVEL=1,OVERLAY=0
	FIELD 1

VERSN,	0
	JMS PUTSP
	TAD BLOC
	SNA CLA
	JMP SYSV	/TEMP (ENTRY PT IS IN FIELD 1 7600
	TAD I PDHIT
	AND (177
	TAD BLOC
GOVR,	DCA DTM
	JMS GETV
	CLL IAC
	TAD (-34
	SZL CLA
	JMP NOOOP
	JMS GETV
PUTVR,	SZA
	TAD (40
	TAD (40
	JMS PUTO
	JMP I VERSN

OTEM,
GETV,	0
	CDF 0
	TAD I DTM
	CDF 10
	JMP I GETV

NOOOP,	STA
	TAD DTM		/SCAN BACKWARDS FOR HANDLER VERSION # (LT 33)
	JMP GOVR

SYSV,	TAD I PDHRT
	AND (177
	TAD (INPBL0+200
	DCA DTM
	TAD I DTM
	CLL
	TAD (-34
	SNL CLA
	TAD I DTM	/PRINT BAD VERSION # AS SPACE
	JMP PUTVR
DTM,	0
SIZE,	0
	JMS GETTYP
	CIA
	CLL
	JMS DPRINT
	JMS PUTSP
	ISZ PTYP	/POINT TO KIND SUBROUTINE
	JMP I SIZE
MODE,	0
	JMS PUTSP
	TAD (-4
	DCA MKNT
	TAD I PDCWT
	RTL
	RAL
	JMS MSET
	"R
	TAD I PDCWT
	RTL
	JMS MSET
	"W
	TAD I PDCWT
	RAL
	CML
	JMS MSET
	"F
	JMS PUTSP
	ISZ MKNT
	JMP .-3
	JMP I MODE

MSET,	0
	CLA
	TAD I MSET
	DCA MCHAR
	ISZ MSET
	SZL
	JMP I MSET
	ISZ MKNT
	TAD MCHAR
	JMS PUTO
	JMP I MSET

MKNT,	0
	PAGE
ET,
BLOCK,	0
	TAD I PDHIT
	RTL
	RTL
	RTL
	AND (17
	SNA
	JMP SYS
	DCA SLTM
	STA
	TAD SLTM
	CLL RTR
	RTR
	RAR
	TAD (INPHND
	DCA BLOC
	TAD SLTM
	TAD (15
	JMS OPRINT
	TAD I PDHIT
	SMA CLA
	TAD (40-"+
	TAD ("+
	JMS PUTO	/"+" MEANS 2 PAGE HANDLER
	TAD SLTM
	TAD (SLOTAB-1
	DCA SLTM
	ISZ I SLTM
	JMP I BLOCK
SYS,	JMS PRINT
	TEXT	/SYS/
	DCA BLOC	/0 MEANS RESIDENT WITH SYS:
	JMP I BLOCK

MCHAR,
ENTRY,	0
	JMS PUTSP
	TAD BLOC
	SNA CLA
	JMP SYSENT
	TAD I PDHIT
EN2,	DCA ET
	TAD ET
	RTR
	RTR
	RTR
	AND (1
	SZA
	TAD (20
	TAD (40
	JMS PUTO
	TAD ET
	JMS OPRINT
	JMP I ENTRY

SYSENT,	TAD I PDHRT
	JMP EN2

SLTM,	0
	PAGE

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RESOV1.MA. 
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

/1
	.EXTERNAL PUTNAM,PUTSP,GETTYP,PUTO
	.ENTRY KIND
	.GLOBAL TYPTBL
	PDHRT=37
	XR1=11
	TEMP=26
	PDHIT=30
	BLOC=36
	UN=6

	.RSECT OV,LEVEL=1,OVERLAY=1
	FIELD 1

GETD77,	0
	TAD (7707
	DCA MASK
	TAD (-6704	/V3C
	JMS SRCH
	RTR
	RAR
	AND (7
	JMP I GETD77

QTTY,	TAD I PDHIT
	SMA CLA		/1 OR 2 PAGE?
	JMP I ($ASR	/1 PAGE
	JMP I ($KL8E	/2 PAGE

QRK8E,	TAD I PDHIT
	AND (7
	CLL RAR
	DCA UN
	JMP I ($RK8E

TSTUN,	0
	TAD I PDHIT
	AND (7
	DCA UN
	JMP I TSTUN


QRK8,	JMS TSTUN
	JMP I ($RK8
QTC08,
QLINC,	JMS TSTUN
	JMP I (NOKIND
/HNDGET GETS VALUE IN HANDLER FROM REL LOC IN AC

HNDGET,	0
	TAD BLOC
	DCA TEMP
	CDF 0
	TAD I TEMP
	CDF 10
	JMP I HNDGET
/SRCH SEARCHES THE HANDLER FOR THE NEGATIVE
/OF THE NON-ZERO VALUE IN THE AC.
/MASKED BY MASK.
/IF FOUND, RETURN IS MADE WITH VALUE(WITHOUT MASK) IN AC
/IF NOT FOUND, AC IS 0 UPON RETURN

SRCH,	0
	DCA LOOK4
	STA
	TAD BLOC
	DCA XR1
	TAD (-230	/V3C MUST SEARCH 2 PAGES; TROUBLE IF TA8E IS IN LAST SLOT
	DCA SRCHCNT
SRCHLP,	CDF 0
	TAD I XR1
	CDF 10
	DCA TEMP
	TAD TEMP
	AND MASK
	TAD LOOK4
	SNA CLA
	JMP SRCHGOT
	ISZ SRCHCNT
	JMP SRCHLP
	JMP I SRCH

SRCHGOT,TAD TEMP
	JMP I SRCH

SRCHCNT,-400
LOOK4,	0
/	**** NOTE:  ALL HANDLERS SHOULD BE PADDED OUT TO FILL PAGE
/		WITH ZEROES
/BUILD SHOULD WRITE ZEROES IN 2ND PAGE OF ONE PAGE HANDLER
/SPECIAL PURPOSE ROUTINES

QPTP,
QPTR,	STA
	DCA MASK
	TAD (-6021
	JMS SRCH
	SZA CLA
	JMP I ($PT8E
	JMP I ($LSPT

/FOR TYPE PTR
/	IF HANDLER CONTAINS A 6021 IT IS A PT8E
/	OTHERWISE IT IS A LSPT

QCR8E,	TAD (104
	JMS HNDGET
	TAD (-3203
	SNA
	JMP I ($C029
	TAD (3203-7735
	SNA CLA
	JMP I ($C026
	JMP I (NOKIND
/FOR TYPE CR8E
/	IF REL LOC 104 IS A 3203 IT IN 029 KIND
/	IF REL LOC 104 IS A 7735 IT IS  AN 026 KIND
/	OTHERWISE IT IS AN UNKNOWN KIND

QLPTR,	TAD I PDHIT
	SPA CLA		/1 OR 2 PAGE?
	JMP I ($LQP	/2 PG
	STA		/1 PG
	DCA MASK
	TAD (-6652	/SEARCH FOR A 6652
	JMS SRCH
	SZA CLA
	JMP I ($L645	/FOUND IT
	CLA IAC		/LOOK AT REL LOC 1
	JMS HNDGET
	TAD (-4
	SNA
	JMP I ($LV8E
	TAD (4-14
	SNA CLA
	JMP I ($LPSV
	JMP I (NOKIND

/IF HANDLER CONTAINS A 6652 IT'S AN L645
/OTHERWISE, DEPENDS ON REL LOC 1
/	IF REL LOC 1 IS A 14, IT'S A LPSV
/	IF REL LOC 1 IS A 4, IT'S A LV8E
/	OTHERWISE IT'S UNKNOWN (POSSIBLY OLD LP08 OR LS8E KIND)

MASK,	0
	PAGE
QTD8E,	JMS I (GETD77
	CIA
	TAD (10
	DCA TEMP
	TAD I ($TD8+1
	AND (7700
	TAD TEMP
	DCA I ($TD8+1
	TAD I PDHIT
	RTR
	RAR
	STA
	TAD TEMP
	CML RAL		/TIMES 2 + LINK
	DCA UN
	JMP I ($TD8

/FIGURE OUT KIND OF TD8E BY DEVICE CODE FOUND IN 67N1 INSTRUCTION
/	N	TYPE
/	7	TD8A
/	6	TD8B
/..
/	1	TD8G
/	0	TD8H

QTA8E,	JMS I (GETD77
	IAC
	DCA TEMP
	TAD I ($TA8+1
	AND (7700
	TAD TEMP
	DCA I ($TA8+1
	STA
	TAD I PDHIT
	AND (177
	SNA CLA
	CLA IAC
	DCA UN
	STA
	TAD TEMP
	CLL RAL
	TAD UN
	DCA UN
	JMP I ($TA8
/FIGURE OUT KIND OF TA8E BY DEVICE CODE FOUND IN 67N1 INSTRUCTION

/	N	KIND
/	0	TA8A
/	1	TA8B
/...
/	6	TA8G
/	7	TA8H
RLSPC,	TAD I PDHIT
	TAD (-50
	RTR
	SKP
RLSP,	TAD I PDHIT
	AND (3
	DCA UN
	JMP I (NOKIND
	PAGE
$LQP,	IAC	/23
PLAT4,	IAC	/22
PLAT3,	IAC	/21
PLAT2,	IAC	/20
PLAT1,	IAC	/17
$XTRA,	IAC	/16
$KL8E,	IAC	/15
$RK8E,	IAC	/14
$RK8,	IAC	/13
$ASR,	IAC	/12
$TA8,	IAC	/11
$TD8,	IAC	/10
$L645,	IAC	/7
$LPSV,	IAC	/6
$LV8E,	IAC	/5
$C026,	IAC	/4
$C029,	IAC	/3
$LSPT,	IAC	/2
$PT8E,	IAC	/1
NOKIND,	CLL RAL
/PRINTS NAME FROM TABLE, ENTER WITH ENTRY # IN AC
PRNAM,	TAD (TABASE
	JMS PUTNAM
	JMS UNIT
	JMP KINDRET
KIND,	0
	JMS PUTSP
	TAD BLOC
	SNA CLA
	JMP NOKIND
	JMS GETTYP
	SNA
	JMP NOKIND
	DCA TEMP
	JMP I TEMP	/BRANCH TO APPROPRIATE SUBROUTINE
KINDRET,JMP I KIND

/KIND SUBROUTINES
/ENTER WITH BLOC POINTING TO HANDLER BLOCK IN CORE

TABASE,	4040;4040	/0
	DEVICE PT8E	/1
	DEVICE KS33	/2
	DEVICE 029	/3
	DEVICE 026	/4
	DEVICE LV8E	/5
	DEVICE LPSV	/6
	DEVICE L645	/7
KTD8,	DEVICE TD8	/10
KTA8,	DEVICE TA8	/11
	DEVICE AS33	/12
	DEVICE RK01	/13
	DEVICE RK05	/14
	DEVICE KL8E	/15
	DEVICE XTRA	/16
	TEXT   / =1/	/17
	TEXT   / =2/	/20
	TEXT   / =3/	/21
	TEXT   / =4/	/22
	DEVICE LQP	/23
UNIT,	0
	JMS PUTSP
	TAD BLOC
	SNA CLA
	JMP TSTSUN
	TAD UN
	SPA
	TAD (40+1-60
ZOUN,	TAD (60
	JMS PUTO
	JMP I UNIT

TSTSUN,	TAD I PDHRT
	TAD (-7607
	SZA CLA
	CLA IAC		/ASSUME CORESIDENT HANDLERS ARE UNIT 1
	JMP ZOUN	/ELSE, NO UNIT
	PAGE
	.ASECT TYPTAB,LEVEL=0
	FIELD 0

	*2000

/	DEVICE LENGTH TABLE

/FORMAT OF THIS TABLE:

/1,2	DEVICE GENERALIZED NAME (CORR TO TYPE)
/3	NEG OF LENGTH
/4	ADDRESS OF SUBR IN FIELD 1 FOR SPECIALIZATION

TYPTBL,	DEVICE TTY ;0000;QTTY	/0
	DEVICE PTR ;0000;QPTR	/1
	DEVICE PTP ;0000;QPTP	/2
	DEVICE CR8E;0000;QCR8E	/3
	DEVICE LPTR;0000;QLPTR	/4	V3D
	DEVICE RK8  ;1520;QRK8	/5
	DEVICE RF08;6001;PLAT1	/6	V3C
	DEVICE RF08;4002;PLAT2	/7
	DEVICE RF08;2003;PLAT3	/10
	DEVICE RF08;0004;PLAT4	/11	RF'S NOW ONLY HAVE LOGICALLY 1777 BLOCKS
	DEVICE DF32;7601;PLAT1	/12
	DEVICE DF32;7402;PLAT2	/13	V3C
	DEVICE DF32;7203;PLAT3	/14
	DEVICE DF32;7004;PLAT4	/15	DF'S HAVE 177 BLOCKS
	DEVICE TC08;6437;QTC08	/16
	DEVICE LINC;6437;QLINC	/17
	DEVICE TM8E;0000;0	/20
	DEVICE TD8E;6437;QTD8E	/21
	DEVICE BAT ;0000;0	/22
	DEVICE RK8E;1520;QRK8E	/23
	DEVICE NULL;0000;0	/24
	DEVICE RX8E;7022;0	/25
	DEVICE RL01;-7761;RLSP	/26
	DEVICE TA8E;0000;QTA8E	/27
	DEVICE VR12;0000;0	/30
	DEVICE RL01;-3751;RLSPC	/31
	DEVICE RX02;6044;0	/32
	DEVICE VXA0;7200;PLAT3	/33
	ZBLOCK 4		/34
	ZBLOCK 4		/35
	DEVICE DUMP;0000;0	/36
	ZBLOCK 4		/37
	ZBLOCK TYPTBL+400-.
	PAGE


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RESOV2.MA. 
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

/1
	.EXTERNAL PRINT,FREEDV,READI,CRLF,OPRINT,DPRINT
	.EXTERNAL SLOTAB
	.ENTRY DIRT,ZEROSL,CNTSLT

	FAST=20
	EXTEN=22

	X0=10

	.MACRO .PRINT ARG
	JMS I (PRINT
	TEXT	"ARG"
	.ENDM
	.RSECT OV2,LEVEL=1,OVERLAY=2
	FIELD 1

	.NOLIST ME,MEB

DIRT,	0
	JMS I (READI
	1400		/READ 6 BLOCKS
	4000		/INTO 04000
	1		/FROM BLOCK 1
	JMS I (DVALID	/CHECK IF VALID DIRECTORY
	TAD FAST
	SNA CLA
	JMP I DIRT	/NO DIRECT IN FAST MODE
	JMS I (CRLF
	DCA USED
	DCA UNUSED
	DCA NFILES
	DCA NMTS
	DCA NSEGS
	STL CLA RAR	/4000
LUP$:	DCA DIRPTR
	ISZ NSEGS
	JMS GETDIR
	DCA NENTRY	/- NO. OF ENTRIES IN SEGMENT
	JMS GETDIR
	DCA STBLK	/STARTING BLOCK # OF FIRST FILE IN SEGMENT
	JMS GETDIR
	DCA LINK	/LINK TO NEXT SEGMENT
	JMS GETDIR
	CLA		/IGNORE FLAG WORD TO TENTATIVE FILE
	JMS GETDIR
	DCA AIW		/# OF ADDITIONAL INFO WORDS
	TAD NENTRY
	DCA DKNT
L$:	JMS GETDIR
	SNA CLA
	JMP MT$		/AN EMPTY ENTRY
	TAD AIW
	CIA
	TAD (3
	TAD DIRPTR
	DCA DIRPTR	/POINT TO FILE LENGTH
	JMS GETDIR	/GET NEG OF NUMBER OF BLOCKS IN FILE
	SNA
	JMP 2$	/A TENTATIVE FILE, IGNORE
	CIA
	TAD USED
	DCA USED
	ISZ NFILES
	JMP 2$
MT$:	JMS GETDIR
	CIA
	TAD UNUSED
	DCA UNUSED
	ISZ NMTS
2$:	ISZ DKNT	/ANY MORE ENTRIES IN THIS SEGMENT?
	JMP L$		/YES
	TAD LINK
	SNA CLA
	JMP 3$
	TAD NSEGS
	CMA
	TAD LINK	/ASSUME LINKS ARE IN ORDER
	SZA CLA
	JMP I (BADDIR
	STA		/GO TO NEXT SEGMENT
	TAD DIRPTR
	AND (7400
	TAD (400
	JMP LUP$

3$:	JMS I (PRINFO
LVDIR,	JMS I (CRLF
	JMS I (CRLF
	JMP I DIRT
DKNT,	0
USED,	0		/NO. OF BLOCKS USED
UNUSED,	0		/# OF UNUSED BLOCKS ON DEVICE
NFILES,	0		/# OF FILES
NMTS,	0		/# OF EMPTIES
NSEGS,	0		/# OF DIRECTORY SEGMENTS USED

NENTRY,	0		/- # OF ENTRIES IN SEGMENT
STBLK,	0		/STARTING BLOCK # OF FIRST FILE IN SEGMENT
LINK,	0		/LINK TO NEXT SEGMENT
AIW,	0		/# OF ADDITIOANAL INFORMATION WORDS

GETDIR,	0
	CDF 0
	TAD I DIRPTR
	CDF 10
	ISZ DIRPTR
	JMP I GETDIR

DIRPTR,	0
	PAGE
PRINFO,	0
	TAD EXTEN
	SNA CLA
	JMP 2$		/JUST # OF FREE BLOCKS UNLESS /E
	TAD I (NFILES
	SNA
	JMP 2$
	STL
	JMS I (DPRINT
	.PRINT " FILES IN "
	TAD I (USED
	STL
	JMS I (DPRINT
	.PRINT " BLOCKS"
	STA
	TAD I (NSEGS
	SNA CLA
	JMP 1$
	.PRINT " USING "
	TAD I (NSEGS
	STL
	JMS I (DPRINT
	.PRINT " SEGMENTS"
1$:	JMS I (CRLF
2$:	TAD I (UNUSED
	STL
	JMS I (DPRINT
	.PRINT " FREE BLOCKS"
	TAD EXTEN
	SNA CLA
	JMP I PRINFO
	TAD I (NMTS
	CLL RAR
	SNA CLA
	JMP 3$
	.PRINT " ("
	TAD I (NMTS
	STL
	JMS I (DPRINT
	.PRINT " EMPTIES)"
3$:	CLA IAC
	TAD I (AIW
	SZA CLA
	JMS PRAIW
	JMP I PRINFO

PRAIW,	0
	JMS I (CRLF
	TAD I (AIW
	CIA
	STL
	JMS I (DPRINT
	.PRINT " EXTRA INFO WDS"
	JMP I PRAIW
	PAGE
DVALID,	0
	STL CLA RAR	/4000
	DCA I (DIRPTR
	JMS I (GETDIR
	CLL
	TAD (200
	SNL CLA
	JMP BADDIR
	JMS I (GETDIR
	SNA
	JMP BADDIR
	TAD (-400	/REMEMBER COS
	SMA CLA
	JMP BADDIR
	JMS I (GETDIR
	CLA		/LINKS THOROUGHLY CHECKED ELSEWHERE
	JMS I (GETDIR
	SNA
	JMP OKDIR
	TAD (-1400
	CLL
	TAD (-1000
	SZL CLA
	JMP BADDIR
OKDIR,	JMS I (GETDIR
	SPA SNA CLA
	JMP I DVALID
BADDIR,	.PRINT "?BAD DIRECTORY"
	JMP I (LVDIR
SLTM,	0

SLKNT,
ZEROSL,	0
	TAD (-10
	DCA SLTM
	TAD (SLOTAB-1
	DCA X0
	DCA I X0
	ISZ SLTM
	JMP .-2
	JMP I ZEROSL

CNTSLT,	0
	TAD (-10
	DCA SLTM
	DCA SLKNT
	TAD (SLOTAB-1
	DCA X0
L$:	TAD I X0
	SNA CLA
	ISZ SLKNT
	ISZ SLTM
	JMP L$
	.PRINT "FREE DEVICE SLOTS: "
	TAD I (FREEDV
	JMS XPRINT
	.PRINT ",  FREE BLOCK SLOTS: "
	TAD SLKNT
	JMS XPRINT
	JMS I (CRLF
	JMP I CNTSLT
XPRINT,	0
	SNA
	JMP 1$
	JMS I (OPRINT
	JMP I XPRINT

1$:	.PRINT "NONE"
	JMP I XPRINT
	PAGE

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RESOVD.MA. 
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

/OVRDRV - OVERLAY DRIVER FOR RESORC
/ASSUMES EVERYTHING IS IN FIELD 1
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977,1978 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/

/OVERLAY DRIVER
/FOR LINKER PROGRAM MODULES
/V1B


/THIS SECT IS TWO LOCATIONS AND CONTAINS THE TRANSFER VECTOR TO SWAPER
/AND A FLAG THAT INDICATES WHETHER A JMP (1) OR JMS (0) WAS PERFORMED
/TO THE TRANSFER VECTOR

	.GLOBAL XFERV

/THIS IS THE MAIN DRIVER SECTION

	.SECT	SWAPER,R
	.GLOBAL	SWPTAB

	FIELD	1

SWAP,	6102			/VERSION NUMBER
	DCA	AC		/SAVE CALLING AC
	RAL
	DCA	LINK		/AND LINK
	RDF			/GET CALLING DF
	TAD	(CDF		/FORM CDF
SWAP0,	JMP	ONCE		/DO ONCE ONLY CODE - REPLACED BY DCA EXIT
	CDF	.		/CHANGE TO THIS DATA FIELD
	TAD I	SWAP		/GET OVERLAY,LEVEL,FIELD
	DCA	BINDAT		/SAVE
	ISZ	SWAP		/BUMP POINTER
	TAD I	SWAP		/GET SUBROUTINE ADDRESS
	DCA	XITLOC		/SAVE
	TAD	BINDAT		/FORM CDF TO CALLED SUBROUTINE
	AND	(7
	RAL CLL
	RTL
	TAD	(CDF
	DCA	SWAP1A		/SAVE
	TAD	SWAP1A		/FORM CIF TO CALLED SUBROUTINE
	IAC
	DCA	EXIT+1		/SAVE FOR EXIT
/LOAD OVERLAY OF CALLED SUBROUTINE

LOAD,	TAD	BINDAT
	AND	(1600		/EXTRACT LEVEL OF CALLED SUBROUTINE
	RTR CLL			/5 RIGHT
	RTR
	RAR
	DCA	PNTR		/SAVE
	TAD	PNTR
	TAD	(SWPTAB		/COMPUTE ENTRY INTO SWAP TABLE
	DCA	FLD		/POINTS TO FIELD OF OVERLAY
	TAD	PNTR		/COMPUTE ENTRY INTO CURRENT OVERLAY TABLE
	RTR CLL
	TAD	(CURTAB
	DCA	PNTR
	TAD	BINDAT		/EXTRACT DESIRED OVERLAY NUMBER
	AND	(170
	RTR CLL			/RIGHT 3
	RAR
	CIA			/NEGATE
	DCA	TEMP
	TAD	TEMP
	TAD I	PNTR		/COMPARE WITH CURRENT OVERLAY NUMBER FOR LEVEL
	SNA CLA			/SAME?
	JMP	SWAP1		/YES, NO READING NEEDED
LOAD1,	TAD	TEMP		/NO, SET TO NEW
	CIA
	DCA I	PNTR		/OVERLAY NUMBER
	TAD	FLD		/SET UP POINTERS TO
	IAC
	DCA	ADDRES		/ADDRESS
	TAD	ADDRES
	IAC
	DCA	RELBLK		/RELATIVE BLOCK NUMBER
	TAD	RELBLK
	IAC
	DCA	LENGTH		/LENGTH OF OVERLAY
	TAD	TEMP		/TEST OVERLAY NUMBER
	SNA CLA			/0?
	JMP	LOAD2		/YES, NO MULTIPLICATION NEEDED
	TAD I	LENGTH		/BLOCK NUMBER = (LENGTH OF OVERLAY)
	JMP I	.+1		/TIMES (THE NUMBER OF THE OVERLAY)
	PATCH
LOAD2,	TAD I	RELBLK		/PLUS (RELATIVE BLOCK OF LEVEL)
	TAD	STRBLK		/PLUS (STARTING BLOCK OF PROGRAM)
	DCA	REDBLK		/SAVE IN CALL LOCATION
	TAD I	ADDRES		/GET ADDRESS TO LOAD
	DCA	REDADD		/SAVE IN CALL LOCATION
	TAD I	FLD		/GET FIELD
	AND	(7		/MASK
	RTR CLL
	RAR			/POSITION
	TAD I	LENGTH		/GET LENGTH
	RTL
	RTL
	RTL
	DCA	REDCNT		/FORM CONTROL WORD
	CIF	0
	JMS I	(7607		/CALL SYSTEM HANDLER TO READ IN OVERLAY
REDCNT,	7756			/FUNCTION CONTROL WORD (POINTS TO MREAD-1 FOR "ONCE"
REDADD,	-7607			/BUFFER ADDRESS (CONTAINS SYS: ENTRY POINT FOR "ONCE"
REDBLK,	0			/STARTING BLOCK NUMBER
	HLT			/ERROR RETURN ADDRESS

SWAP1,	TAD	XFERV		/GET JMP-JMS FLAG
	SZA CLA			/SET?
	JMP	SWAP2		/YES, EXECUTE A JMP
	CLA CLL CMA RTL		/-3
	TAD	SWAP		/BACK UP TO CALLER'S PC
	DCA	SWAP
	TAD I	SWAP
SWAP1A,	0			/CDF TO CALLED SUBROUTINE
	DCA I	XITLOC		/SAVE IN CALLED SUBROUTINE
	ISZ	XITLOC		/BUMP TRANSFER ADDRESS
/**	CDF	.
	TAD	(ISZ XFERV
	DCA I	SWAP		/SET BACK UP ENTRY IN XFER VECTOR TABLE
SWAP2,	DCA	XFERV		/CLEAR FLAG
	TAD	LINK		/RESTORE LINK AND AC
	RAR CLL
	TAD	AC
EXIT,	0			/SET DF TO CALLING FIELD
	0			/SET IF TO CALLED FIELD
	JMP I	XITLOC		/GO TO CALLED SUBROUTINE

/VARIABLE LOCATIONS
/SOME OF THE FOLLOWING LOCATIONS CONTAIN
/ONCE ONLY CODE TO SET UP STARTING BLOCK
/AND CHECK THAT FILE CAME FROM SYS:
CURTAB=.			/CURRENT OVERLAY IN LEVEL TABLE (8 ENTRIES)
STRBLK=.			/ENTRY 0 IS USED TO HOLD STARTING BLOCK OF FILE
ONCE,	DCA	EXIT		/SAVE CALLING FIELD
				/ALSO ENTRY 0
	TAD	.-1		/SET UP SO WON'T BE EXECUTED AGAIN
				/ALSO ENTRY 1
	DCA	SWAP0
				/ALSO ENTRY 2
	CDF	0
				/ALSO ENTRY 3
	TAD I	FLD		/GET STARTING BLOCK FROM "SOFSET"
				/ALSO ENTRY 4
	SNA
				/ALSO ENTRY 5
	HLT			/ERROR, K.M. PATCHES NOT IN
				/ALSO ENTRY 6
	DCA	STRBLK		/SAVE
				/ALSO ENTRY 7
	TAD I	REDCNT		/CHECK FILE CAME FROM SYS:
	TAD	REDADD

BINDAT,				/CONTAINS OVERLAY,LEVEL,FIELD OF DESIRED SUBROUTINE
	SNA CLA			/FROM SYS: ?
XITLOC,				/CONTAINS LOCATION TO GO TO IN DESIRED SUBROUTINE
	JMP	SWAP0+1		/YES, OK
PNTR,				/POINTS INTO CURTAB
	HLT			/NO, ERROR
TEMP,				/TEMP STORAGE
	JMP	.-1		/DON'T ALLOW CONTINUE
FLD,				/POINTS TO FIELD WORD IN SWPTAB
	7747			/POINTER TO "SOFSET"

ADDRES=REDADD			/POINTS TO ADDRESS WORD IN SWPTAB
RELBLK=REDBLK			/POINTS TO RELATIVE BLOCK WORD IN SWPTAB
LENGTH=REDCNT			/POINTS TO LENGTH WORD IN SWPTAB

AC,	0			/SAVED AC
LINK,	0			/SAVED LINK

	PAGE

/PATCH TO FIX BLOCK POSITION CALCULATION
PATCH,	IAC		/CONVERT PAGES TO BLOCKS
	CLL RAR
	DCA	PTEMP
	TAD	PTEMP	/MULTIPLY BLOCK LENGTH
	ISZ I	PPNT	/BY OVERLAY NUMBER
	JMP	.-2
	JMP I	.+1
	LOAD2
PPNT,	TEMP
PTEMP,	0



/THIS AREA CONTAINS OVERLAY DATA FOR MAIN AND THE 7 LEVELS
/THE FORMAT OF EACH ENTRY IS:
/WORD1:	FIELD OF LEVEL
/WORD2:	ADDRESS OF LEVEL
/WORD3:	RELATIVE BLOCK OF 1ST OVERLAY IN LEVEL
/WORD4:	LENGTH OF THE LEVEL (ANY AND ALL OVERLAYS-EACH)
/	(ALL OVERLAYS IN A LEVEL ARE THE SAME LENGTH)

SWPTAB,

	*.+40

/THIS AREA CONTAINS THE TRANSFER VECTORS FOR EACH ENTRY POINT
/IN ALL THE OVERLAYS IN ALL THE LEVELS
/ITS SIZE SHOULD BE MODIFIED BY THE USER
/TO FIT THE MAXIMUM NUMBER OF TRANSFER VECTORS NEEDED
/EACH TRANSFER VECTOR OCCUPIES 4 LOCATIONS
/THE TABLE IS INITIALLY SET UP FOR 24(DEC) (30(OCT)) VECTORS
/THE MAXIMUM SIZE THIS TABLE CAN BE IS 3774 (OCT) LOCATIONS FOR
/511 (DEC) (777 (OCT)) VECTORS
/THE FORMAT OF EACH VECTOR ENTRY IS:
/WORD1:	ISZ	XFERV
/WORD2:	JMS I	XFERV+1
/WORD3:	LEVEL/OVERLAY/FIELD
/WORD4:	ADDRESS

	.FSECT TRANVC
	FIELD SWAPER

	SIZE=14		/MODIFY THIS LINE TO CHANGE THE SIZE OF THE TABLE

	*SIZE^4

XFERV,	0
	SWAPER



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RL0.PA. 
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

/RL0: RL01 DRIVE 0 NON-SYSTEM HANDLER
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/RL01 DRIVE 0 NON-SYSTEM HANDLER

	VERSION="A&77

/NOTES:
/1. PRE-OMNIBUS COMPUTERS NOT SUPPORTED.

/EDIT HISTORY:
/13-OCT-77 DAVID SPECTOR: CREATION

/INSTRUCTIONS THAT GENERATE CONSTANTS

AC0001=CLA IAC
AC0002=CLA CLL CML RTL
AC0003=CLA CLL CML IAC RAL	/*
AC0004=CLA CLL IAC RTL		/*
AC0006=CLA CLL CML IAC RTL	/*
AC0100=CLA IAC BSW		/*
AC2000=CLA CLL CML RTR
AC3777=CLA CLL CMA RAR
AC4000=CLA CLL CML RAR
AC5777=CLA CLL CMA RTR
AC6000=CLA CLL CML IAC RTR	/*
AC7775=CLA CLL CMA RTL
AC7776=CLA CLL CMA RAL

/* USE ONLY ON VT-78 AND PDP-8E,F,M,A

/ID CODE AT START OF BAD BLOCK LIST (BBL)
	ID=123

/BAD BLOCK LIST FORMAT:
/WORD	CONTENTS
/0	ID (IDENTIFICATION CODE)
/1	BAD BLOCKS FOR DEVICE A (ASCENDING ORDER)
/...	...
/20	0 (TERMINATOR FOR LIST A)
/21	BAD BLOCKS FOR DEVICE B (ASCENDING ORDER)
/...	...
/40	0 (TERMINATOR FOR LIST B)

/RL01 DEFINITIONS

RLIOT=6600
RLDC=RLIOT 0	/CLEAR DEVICE
RLSD=RLIOT 1	/SKIP IF DONE
RLMA=RLIOT 2	/LOAD MEM ADDR
RLCA=RLIOT 3	/LOAD REGISTER "A"
RLCB=RLIOT 4	/LOAD REG "B" AND EXECUTE
RLSA=RLIOT 5	/LOAD SECTOR ADDR
		/RLIOT 6 UNUSED
RLWC=RLIOT 7	/LOAD WORD COUNT
RRER=RLIOT 10	/READ ERROR REG
RRWC=RLIOT 11	/READ WORD COUNT
RRCA=RLIOT 12	/READ REG "A"
RRCB=RLIOT 13	/READ REG "B"
RRSA=RLIOT 14	/READ SECTOR ADDR
RRSI=RLIOT 15	/READ SILO BYTE
		/RLIOT 16 UNUSED
RLSE=RLIOT 17	/SKIP IF ERROR
/RLCB FUNCTION BITS:
	RLMT=0	/MAINTENANCE MODE
	RLRE=1	/RESET DRIVE ERRORS
	RLST=2	/READ STATUS REGS INTO SILO
	RLSK=3	/SEEK
	RLRH=4	/READ HEADER
	RLWR=5	/WRITE
	RLRD=6	/READ
	RLRN=7	/READ WITH NO HEADER CHECK
/BIT DEFINITIONS IN REGISTERS:
BYTE=1000	/BYTE TRANSFER MODE
/HEADER BLOCK FOR USE BY "BUILD"

	*0
	-2		/- NR DEVICES PER HANDLER

/FORMAT OF ENTRIES IN HEADER BLOCK:
/WORD	DESCRIPTION
/0	GROUP NAME (4 CHAR)
/2	DEVICE NAME (4 CHAR)
/4	DCB WORD FOR AN RL (TYPE 26) DIRECTORY DEVICE
/5	OFFSET TO ENTRY POINT, 2-PAGE INDICATOR
/6	0 (UNUSED WORD)
/7	0 TO REPRESENT NON-SYSTEM DEVICE

	DRIVE=0

DEVICE RL0;DEVICE RL0A;4260;RLA&177+4000;0;0
DEVICE RL0;DEVICE RL0B;4260;RLB&177+4000;0;0
/HANDLER CODE
	*200		/FIRST PAGE

/DATA

A17,	17
A47,	47
A175,	175
A200,	200
A377,	377
A7751,	7751
BASE,	TAD BBL+1
ABLOCK,	BLOCK-MAIN
AMA,	MA-MAIN		/RELATIVE ADDR OF MA
ASECT,	SECTOR-MAIN
ATRACK,	TRACK-MAIN
AERROR,	ERROR-MAIN

/SET UP ARGUMENTS BY CALLING 2ND PAGE SUBROUTINE
SET,	TAD OFFSET	/INITIALIZE MAPPING (BELOW)
	BSW
	CLL RTL		/(0 OR 20: DEVICE A OR B)
	TAD BASE
	DCA MAP
	TAD RLB		/ADDR OF ARGS
	JMS I GO	/SETUP (AC NON-ZERO)
/MAP NEXT BLOCK AROUND ANY BAD BLOCKS BELOW IT
MAP,	TAD		/INITIALIZED ABOVE
	SNA		/0 TERMINATES LIST
	JMP MAPPED
	STL CIA		/13-BIT NEGATE
	TAD I ABLOCK	/COMPARE WITH BLOCK
	SZL CLA
	JMP MAPPED	/BAD BLOCK IS ABOVE CURRENT BLOCK
	ISZ MAP		/TRY NEXT BAD BLOCK ALSO
NEXT,	ISZ I ABLOCK	/INCREMENT CURRENT BLOCK NUMBER,
			/EITHER DURING
			/BAD BLOCK MAPPING OR AFTER SUCCESSFUL TRANSFER
			/OF TWO SECTORS (PAGES) WITH MORE TO GO
	JMP MAP		/CONTINUE MAPPING
	JMP I AERROR	/ERROR ON BLOCK OVERFLOW
	ZBLOCK 240+DRIVE-.	/UNUSED

/ENTRY POINT FOR DEVICE B

RLB,	VERSION
	AC0004		/TRACK OFFSET WILL BE 400
	JMP START	/SKIP AROUND RLA ENTRY POINT
OFFSET,	0		/TRACK OFFSET FOR DEVICE (0 OR 400)

/ENTRY POINT FOR DEVICE A

RLA,	VERSION
A7600,	7600		/=CLA
	TAD RLA		/TRANSFER CALLING ADDR
	DCA RLB
START,	BSW		/SET OFFSET TO 0 IF DEV A, 400 IF DEV B
	DCA OFFSET
	TAD A7600	/RETURN TO KEYBOARD MONITOR
	KRS		/IF CTRL,C TYPED
	TAD A175	/-CTRL,C
	SNA CLA
	KSF
ONCE,	JMP ONLY	/THIS INSTRUCTION IS DONE ONCE ONLY. IT IS
			/THEN CHANGED TO "JMP SET" AFTER HANDLER RELOCATION
			/IS DONE AND THE BAD BLOCK LIST IS READ IN.
ACDIF,	CIF CDF 00
	JMP I A7600	/CALL KB MONITOR
/THIS LOC IS SET TO ADDR OF NEXT PAGE BY ONCE-ONLY CODE
GO,	0		/ADDR OF MAIN
/-----BOUNDARY OF BAD BLOCK LIST-----
BBL,
/ONCE-ONLY CODE, REPLACED BY BAD BLOCK LIST
/READ IN BAD BLOCK LIST (BBL)
/SAVE CALLING DATA FIELD
	RDF
	TAD OOCDF
	DCA BACK
OOCDF,	CDF 00		/SET TO CURRENT FIELD
/REPLACE ONCE-ONLY JUMP INSTRUCTION
	TAD JMPSET
	DCA ONCE
LOOP,	TAD LIST	/RELOCATE CROSS-PAGE REFERENCES;
			/SCAN "LIST" FOR RELATIVE LOCATIONS
			/OF VALUES TO BE RELOCATED
	SNA		/0 ACTS AS TERMINATOR
	JMP OUT
	TAD GO		/RELOCATE RELATIVE ADDRESS
	DCA ONLY	/"ONLY" IS NOW TEMP STORAGE
	ISZ LOOP	/NEXT VALUE
	TAD GO
	TAD I ONLY	/RELOCATE THE CONTENTS
	DCA I ONLY
	JMP LOOP	/CONTINUE UNTIL DONE

/LIST OF RELATIVE ADDRESSES OF RELATIVE VALUES

LIST,	BARG-MAIN
	ABLOCK-MAIN
	BBBL-MAIN
	AMA-MAIN
	ASECT-MAIN
	ATRACK-MAIN
	MA-MAIN
	AERROR-MAIN
	0		/TERMINATOR

	ZBLOCK	BBL+40-.	/UNUSED (IN BBL BUFFER)

/ONCE-ONLY CODE CONTINUES
OUT,	JMS I GO	/READ BAD BLOCK LIST
/-----BOUNDARY OF BAD BLOCK LIST-----
OK,	CLA		/ERROR RETURN (IGNORE)
BACK,	CDF		/RESTORE CALLING FIELD
JMPSET,	JMP SET		/SETUP FOR TRANSFER

/END OF ONCE-ONLY CODE
/SETUP ARGS FOR CALL TO 2ND PAGE SUBROUTINE
/CALCULATE TRACK AND SECTOR FROM BLOCK
MAPPED,	TAD I ABLOCK
	RTR
	RTR
	AND A377
	TAD OFFSET	/DEVICE OFFSET (0 OR 400)
	DCA I ATRACK
	TAD I ABLOCK	/CALCULATE SECTOR FROM BLOCK
	AND A17		/SECTOR CODE
	CLL RTL
	TAD A7751
	SPA
	TAD A47
	BSW
	DCA I ASECT
/TRANSFER 1ST PAGE OF BLOCK
	JMS I GO
	TAD A200	/INCREMENT MA
	TAD I AMA
	DCA I AMA
/INCREMENT SECTOR
	TAD A200
	TAD I ASECT
	DCA I ASECT
/TRANSFER 2ND PAGE OF BLOCK
	JMS I GO
	TAD A200	/INCREMENT MA
	TAD I AMA
	DCA I AMA
/CONTINUE WITH NEXT BLOCK
	JMP NEXT

/ONCE-ONLY CODE AT END OF PAGE
	ZBLOCK 377-.	/UNUSED
ONLY,	JMS GO		/EXECUTED ONCE ONLY; STORES ADDR OF
			/2ND PAGE IN LOC "GO"
	*400
/2ND PAGE OF HANDLER

/SUBROUTINE TO SETUP AND TRANSFER
/AC=0 FOR TRANSFER ELSE SETUP
MAIN,	0
	SNA
	JMP TRANS
/GET HANDLER ARGUMENTS
SETUP,	DCA BARG	/ADDR OF HANDLER ARGS
	AC2000		/SET "OLDTRK" TO INVALID TRACK
	DCA OLDTRK	/TO FORCE READING NEXT HEADER.
	TAD B7600	/SET FOR FULL PAGE TRANSFERS
	DCA WC		/(WAS SMALLER FOR BBL READ)
	TAD I BARG	/NOW GET HANDLER ARGUMENTS
			/FUNCTION WORD
/NOTE: THE FOLLOWING INSTRUCTION IS USED AS A CONSTANT
B377,	AND B4070	/CONVERT TO RLCB FORMAT
	SPA
	TAD B3777
	TAD BRLRD
	DCA FNC
	TAD I BARG	/FUNCTION WORD
	RAL		/CONVERT TO PAGE COUNT IN BITS [7600]
	AND B7600
	DCA PAGES
	ISZ BARG
	TAD I BARG	/MA
	DCA MA
	ISZ BARG
	TAD I BARG	/BLOCK
	DCA BLOCK
	ISZ BARG
/SAVE CALLING FIELD FOR RETURN
	RDF
	TAD BCDIF
	DCA BRTN
/RESET DATA FIELD AND RETURN FROM SETUP WITH AC=BLOCK
BCDIF,	CIF CDF 00
/GET DEVICE OFFSET FROM 1ST PAGE
	TAD I BBBL	/CHECK FOR BBL VALIDITY -
	TAD CHECK	/1ST LOC OF BBL CONTAINS AN
	SZA CLA		/IDENTIFICATION CODE ("ID")
	JMP ERROR	/TAKE ERROR RETURN FROM HANDLER
			/IF BBL IS INVALID.
	JMP I MAIN
/TRANSFER ONE OR MORE PAGES TO/FROM DISK
/GET INTERPAGE ARGUMENTS
/RESET RETRY COUNT FOR 2 RETRIES ON I/O ERRORS
TRANS,	AC7775		/AC=-3
	DCA ERRCNT
/CALCULATE CYLINDER AND SURFACE FROM TRACK
	TAD TRACK
	CLL RAR
	DCA CYL
	RTR
	DCA SURF
/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
	JMS TRKCMP
/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
/RESET DRIVE (FUNCTION=1)
RETRY,	RLDC		/CLEAR CONTROLLER, AC
/SEEK (FUNCTION=3) WHEN CALLED FROM BELOW
SEEK,	IAC		/AC=(1 OR 3)
	JMS IO		/RESET DRIVE OR SEEK
/READ NEXT HEADER TO FIND OUT ACTUAL CURRENT TRACK
	TAD HEADER
	JMS IO		/READ NEXT HEADER
	RRSI		/GET HEADER BYTE #1
	BSW
	AND B3
	DCA OLDTRK	/SAVE 2 LSB
	RRSI		/GET HEADER BYTE #2
	AND B377	/HARDWARE SHOULD DO THIS
	CLL RTL
	TAD OLDTRK	/ADD IN MSB
	DCA OLDTRK
/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
	JMS TRKCMP
/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
/CALCULATE DIFFERENCE WORD FOR SEEK FROM TRACK DIFFERENCE
	SPA		/IF POSITIVE, LINK WILL BE SET
	CLL CIA		/IF NEGATIVE, CLEAR LINK
	RAR		/DELETE SURFACE, INCLUDE DIRECTION
	TAD SURF	/ADD SURFACE
	RLCA		/LOAD DIFFERENCE WORD
	AC0002		/PREPARE FOR SEEK
/LOOP BACK AND PERFORM SEEK; THIS ENSURES THAT THE TRACK
/REACHED IS THE CORRECT ONE IN SPITE OF POSSIBLE RL01
/SEEK UNRELIABILITY
	JMP SEEK
/SUBROUTINE TO COMPARE REQUESTED TRACK WITH OLD (REMEMBERED)
/TRACK; IF SAME, DO TRANSFER. IF DIFFERENT, RETURN WITH AC=
/REQUESTED-OLD, AND LINK=1
TRKCMP,	0
	TAD OLDTRK	/CALCULATE DIFFERENCE
	CIA
	TAD TRACK
	STL		/LINK MUST BE SET WHEN
			/DIFFERENCE IS POSITIVE.
	SZA
	JMP I TRKCMP	/DIFFERENT; RETURN
/ON TRACK: DO TRANSFER
/LOAD ALL REGISTERS
	TAD SECTOR
	RLSA
	TAD WC
	RLWC
	TAD SURF
	TAD CYL
	RLCA
	TAD MA
	RLMA
/DO THE READ OR WRITE
	TAD FNC
	JMS IO
/COUNT REQUESTED NUMBER OF PAGES
	TAD B7600
	TAD PAGES
	SNA
	JMP DONE
	DCA PAGES
	JMP I MAIN	/RETURN FOR MORE
/SUBROUTINE TO DO THE ACTUAL I/O
IO,	0		/AC=MODE,FIELD,FUNCTION
	TAD BDRIVE
	RLCB		/DO THE OPERATION
	RLSD		/WAIT UNTIL DONE
	JMP .-1
	RLSE		/TEST FOR I/O ERROR(S)
	JMP I IO	/NONE; RETURN
/IF ERROR, RETRY TWICE
	ISZ ERRCNT	/MORE RETRIES LEFT?
	JMP RETRY	/YES
/AFTER THREE TRIES, TAKE HANDLER ERROR RETURN
/WITH AC=4000
ERROR,	AC4000
	SKP
/NORMAL RETURN FROM HANDLER
DONE,	ISZ BARG	/SKIP ERROR RETURN
BRTN,	CIF CDF 00	/RETURN TO CALLING FIELD
			/BBL READ: NOP (FIELD 0)
	JMP I BARG	/RETURN TO CALLING PROGRAM
/DATA
BLOCK,	0
TRACK,	0		/BBL READ: TRACK 0
WC,	-41		/BBL READ: -BBL LENGTH
SECTOR,	1400		/BBL READ: SECTOR 14
CYL,	0
SURF,	0
ERRCNT,	0		/COUNT OF RETRIES
OLDTRK,	2000		/FORCE INITIAL SEEK
PAGES,	200		/BBL READ: ONE PAGE
FNC,	RLRD		/BBL READ: READ FUNCTION

/RELOCATED RELATIVE ADDRESSES
BARG,	OK-MAIN		/BBL READ: RETURN FROM READ
			/ADDRESS OF HANDLER ARGUMENTS
MA,	BBL-MAIN	/BBL READ: ADDR OF BBL
BBBL,	BBL-MAIN

B3,	3
B3777,	3777
B7600,	7600
BRLRD,	RLRD
HEADER,	BYTE RLRH
BDRIVE,	DRIVE^100	/DRIVE BITS FOR RLCB
CHECK,	-ID

/THIS CONSTANT MUST BE AT END OF PAGE
	ZBLOCK 577-.
B4070,	4070
$

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RL1.PA. 
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

/RL1: RL01 DRIVE 1 NON-SYSTEM HANDLER
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/RL01 DRIVE 1 NON-SYSTEM HANDLER

	VERSION="A&77

/NOTES:
/1. PRE-OMNIBUS COMPUTERS NOT SUPPORTED.

/EDIT HISTORY:
/13-OCT-77 DAVID SPECTOR: CREATION

/INSTRUCTIONS THAT GENERATE CONSTANTS

AC0001=CLA IAC
AC0002=CLA CLL CML RTL
AC0003=CLA CLL CML IAC RAL	/*
AC0004=CLA CLL IAC RTL		/*
AC0006=CLA CLL CML IAC RTL	/*
AC0100=CLA IAC BSW		/*
AC2000=CLA CLL CML RTR
AC3777=CLA CLL CMA RAR
AC4000=CLA CLL CML RAR
AC5777=CLA CLL CMA RTR
AC6000=CLA CLL CML IAC RTR	/*
AC7775=CLA CLL CMA RTL
AC7776=CLA CLL CMA RAL

/* USE ONLY ON VT-78 AND PDP-8E,F,M,A

/ID CODE AT START OF BAD BLOCK LIST (BBL)
	ID=123

/BAD BLOCK LIST FORMAT:
/WORD	CONTENTS
/0	ID (IDENTIFICATION CODE)
/1	BAD BLOCKS FOR DEVICE A (ASCENDING ORDER)
/...	...
/20	0 (TERMINATOR FOR LIST A)
/21	BAD BLOCKS FOR DEVICE B (ASCENDING ORDER)
/...	...
/40	0 (TERMINATOR FOR LIST B)

/RL01 DEFINITIONS

RLIOT=6600
RLDC=RLIOT 0	/CLEAR DEVICE
RLSD=RLIOT 1	/SKIP IF DONE
RLMA=RLIOT 2	/LOAD MEM ADDR
RLCA=RLIOT 3	/LOAD REGISTER "A"
RLCB=RLIOT 4	/LOAD REG "B" AND EXECUTE
RLSA=RLIOT 5	/LOAD SECTOR ADDR
		/RLIOT 6 UNUSED
RLWC=RLIOT 7	/LOAD WORD COUNT
RRER=RLIOT 10	/READ ERROR REG
RRWC=RLIOT 11	/READ WORD COUNT
RRCA=RLIOT 12	/READ REG "A"
RRCB=RLIOT 13	/READ REG "B"
RRSA=RLIOT 14	/READ SECTOR ADDR
RRSI=RLIOT 15	/READ SILO BYTE
		/RLIOT 16 UNUSED
RLSE=RLIOT 17	/SKIP IF ERROR
/RLCB FUNCTION BITS:
	RLMT=0	/MAINTENANCE MODE
	RLRE=1	/RESET DRIVE ERRORS
	RLST=2	/READ STATUS REGS INTO SILO
	RLSK=3	/SEEK
	RLRH=4	/READ HEADER
	RLWR=5	/WRITE
	RLRD=6	/READ
	RLRN=7	/READ WITH NO HEADER CHECK
/BIT DEFINITIONS IN REGISTERS:
BYTE=1000	/BYTE TRANSFER MODE
/HEADER BLOCK FOR USE BY "BUILD"

	*0
	-2		/- NR DEVICES PER HANDLER

/FORMAT OF ENTRIES IN HEADER BLOCK:
/WORD	DESCRIPTION
/0	GROUP NAME (4 CHAR)
/2	DEVICE NAME (4 CHAR)
/4	DCB WORD FOR AN RL (TYPE 26) DIRECTORY DEVICE
/5	OFFSET TO ENTRY POINT, 2-PAGE INDICATOR
/6	0 (UNUSED WORD)
/7	0 TO REPRESENT NON-SYSTEM DEVICE

	DRIVE=1

DEVICE RL1;DEVICE RL1A;4260;RLA&177+4000;0;0
DEVICE RL1;DEVICE RL1B;4260;RLB&177+4000;0;0
/HANDLER CODE
	*200		/FIRST PAGE

/DATA

A17,	17
A47,	47
A175,	175
A200,	200
A377,	377
A7751,	7751
BASE,	TAD BBL+1
ABLOCK,	BLOCK-MAIN
AMA,	MA-MAIN		/RELATIVE ADDR OF MA
ASECT,	SECTOR-MAIN
ATRACK,	TRACK-MAIN
AERROR,	ERROR-MAIN

/SET UP ARGUMENTS BY CALLING 2ND PAGE SUBROUTINE
SET,	TAD OFFSET	/INITIALIZE MAPPING (BELOW)
	BSW
	CLL RTL		/(0 OR 20: DEVICE A OR B)
	TAD BASE
	DCA MAP
	TAD RLB		/ADDR OF ARGS
	JMS I GO	/SETUP (AC NON-ZERO)
/MAP NEXT BLOCK AROUND ANY BAD BLOCKS BELOW IT
MAP,	TAD		/INITIALIZED ABOVE
	SNA		/0 TERMINATES LIST
	JMP MAPPED
	STL CIA		/13-BIT NEGATE
	TAD I ABLOCK	/COMPARE WITH BLOCK
	SZL CLA
	JMP MAPPED	/BAD BLOCK IS ABOVE CURRENT BLOCK
	ISZ MAP		/TRY NEXT BAD BLOCK ALSO
NEXT,	ISZ I ABLOCK	/INCREMENT CURRENT BLOCK NUMBER,
			/EITHER DURING
			/BAD BLOCK MAPPING OR AFTER SUCCESSFUL TRANSFER
			/OF TWO SECTORS (PAGES) WITH MORE TO GO
	JMP MAP		/CONTINUE MAPPING
	JMP I AERROR	/ERROR ON BLOCK OVERFLOW
	ZBLOCK 240+DRIVE-.	/UNUSED

/ENTRY POINT FOR DEVICE B

RLB,	VERSION
	AC0004		/TRACK OFFSET WILL BE 400
	JMP START	/SKIP AROUND RLA ENTRY POINT
OFFSET,	0		/TRACK OFFSET FOR DEVICE (0 OR 400)

/ENTRY POINT FOR DEVICE A

RLA,	VERSION
A7600,	7600		/=CLA
	TAD RLA		/TRANSFER CALLING ADDR
	DCA RLB
START,	BSW		/SET OFFSET TO 0 IF DEV A, 400 IF DEV B
	DCA OFFSET
	TAD A7600	/RETURN TO KEYBOARD MONITOR
	KRS		/IF CTRL,C TYPED
	TAD A175	/-CTRL,C
	SNA CLA
	KSF
ONCE,	JMP ONLY	/THIS INSTRUCTION IS DONE ONCE ONLY. IT IS
			/THEN CHANGED TO "JMP SET" AFTER HANDLER RELOCATION
			/IS DONE AND THE BAD BLOCK LIST IS READ IN.
ACDIF,	CIF CDF 00
	JMP I A7600	/CALL KB MONITOR
/THIS LOC IS SET TO ADDR OF NEXT PAGE BY ONCE-ONLY CODE
GO,	0		/ADDR OF MAIN
/-----BOUNDARY OF BAD BLOCK LIST-----
BBL,
/ONCE-ONLY CODE, REPLACED BY BAD BLOCK LIST
/READ IN BAD BLOCK LIST (BBL)
/SAVE CALLING DATA FIELD
	RDF
	TAD OOCDF
	DCA BACK
OOCDF,	CDF 00		/SET TO CURRENT FIELD
/REPLACE ONCE-ONLY JUMP INSTRUCTION
	TAD JMPSET
	DCA ONCE
LOOP,	TAD LIST	/RELOCATE CROSS-PAGE REFERENCES;
			/SCAN "LIST" FOR RELATIVE LOCATIONS
			/OF VALUES TO BE RELOCATED
	SNA		/0 ACTS AS TERMINATOR
	JMP OUT
	TAD GO		/RELOCATE RELATIVE ADDRESS
	DCA ONLY	/"ONLY" IS NOW TEMP STORAGE
	ISZ LOOP	/NEXT VALUE
	TAD GO
	TAD I ONLY	/RELOCATE THE CONTENTS
	DCA I ONLY
	JMP LOOP	/CONTINUE UNTIL DONE

/LIST OF RELATIVE ADDRESSES OF RELATIVE VALUES

LIST,	BARG-MAIN
	ABLOCK-MAIN
	BBBL-MAIN
	AMA-MAIN
	ASECT-MAIN
	ATRACK-MAIN
	MA-MAIN
	AERROR-MAIN
	0		/TERMINATOR

	ZBLOCK	BBL+40-.	/UNUSED (IN BBL BUFFER)

/ONCE-ONLY CODE CONTINUES
OUT,	JMS I GO	/READ BAD BLOCK LIST
/-----BOUNDARY OF BAD BLOCK LIST-----
OK,	CLA		/ERROR RETURN (IGNORE)
BACK,	CDF		/RESTORE CALLING FIELD
JMPSET,	JMP SET		/SETUP FOR TRANSFER

/END OF ONCE-ONLY CODE
/SETUP ARGS FOR CALL TO 2ND PAGE SUBROUTINE
/CALCULATE TRACK AND SECTOR FROM BLOCK
MAPPED,	TAD I ABLOCK
	RTR
	RTR
	AND A377
	TAD OFFSET	/DEVICE OFFSET (0 OR 400)
	DCA I ATRACK
	TAD I ABLOCK	/CALCULATE SECTOR FROM BLOCK
	AND A17		/SECTOR CODE
	CLL RTL
	TAD A7751
	SPA
	TAD A47
	BSW
	DCA I ASECT
/TRANSFER 1ST PAGE OF BLOCK
	JMS I GO
	TAD A200	/INCREMENT MA
	TAD I AMA
	DCA I AMA
/INCREMENT SECTOR
	TAD A200
	TAD I ASECT
	DCA I ASECT
/TRANSFER 2ND PAGE OF BLOCK
	JMS I GO
	TAD A200	/INCREMENT MA
	TAD I AMA
	DCA I AMA
/CONTINUE WITH NEXT BLOCK
	JMP NEXT

/ONCE-ONLY CODE AT END OF PAGE
	ZBLOCK 377-.	/UNUSED
ONLY,	JMS GO		/EXECUTED ONCE ONLY; STORES ADDR OF
			/2ND PAGE IN LOC "GO"
	*400
/2ND PAGE OF HANDLER

/SUBROUTINE TO SETUP AND TRANSFER
/AC=0 FOR TRANSFER ELSE SETUP
MAIN,	0
	SNA
	JMP TRANS
/GET HANDLER ARGUMENTS
SETUP,	DCA BARG	/ADDR OF HANDLER ARGS
	AC2000		/SET "OLDTRK" TO INVALID TRACK
	DCA OLDTRK	/TO FORCE READING NEXT HEADER.
	TAD B7600	/SET FOR FULL PAGE TRANSFERS
	DCA WC		/(WAS SMALLER FOR BBL READ)
	TAD I BARG	/NOW GET HANDLER ARGUMENTS
			/FUNCTION WORD
/NOTE: THE FOLLOWING INSTRUCTION IS USED AS A CONSTANT
B377,	AND B4070	/CONVERT TO RLCB FORMAT
	SPA
	TAD B3777
	TAD BRLRD
	DCA FNC
	TAD I BARG	/FUNCTION WORD
	RAL		/CONVERT TO PAGE COUNT IN BITS [7600]
	AND B7600
	DCA PAGES
	ISZ BARG
	TAD I BARG	/MA
	DCA MA
	ISZ BARG
	TAD I BARG	/BLOCK
	DCA BLOCK
	ISZ BARG
/SAVE CALLING FIELD FOR RETURN
	RDF
	TAD BCDIF
	DCA BRTN
/RESET DATA FIELD AND RETURN FROM SETUP WITH AC=BLOCK
BCDIF,	CIF CDF 00
/GET DEVICE OFFSET FROM 1ST PAGE
	TAD I BBBL	/CHECK FOR BBL VALIDITY -
	TAD CHECK	/1ST LOC OF BBL CONTAINS AN
	SZA CLA		/IDENTIFICATION CODE ("ID")
	JMP ERROR	/TAKE ERROR RETURN FROM HANDLER
			/IF BBL IS INVALID.
	JMP I MAIN
/TRANSFER ONE OR MORE PAGES TO/FROM DISK
/GET INTERPAGE ARGUMENTS
/RESET RETRY COUNT FOR 2 RETRIES ON I/O ERRORS
TRANS,	AC7775		/AC=-3
	DCA ERRCNT
/CALCULATE CYLINDER AND SURFACE FROM TRACK
	TAD TRACK
	CLL RAR
	DCA CYL
	RTR
	DCA SURF
/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
	JMS TRKCMP
/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
/RESET DRIVE (FUNCTION=1)
RETRY,	RLDC		/CLEAR CONTROLLER, AC
/SEEK (FUNCTION=3) WHEN CALLED FROM BELOW
SEEK,	IAC		/AC=(1 OR 3)
	JMS IO		/RESET DRIVE OR SEEK
/READ NEXT HEADER TO FIND OUT ACTUAL CURRENT TRACK
	TAD HEADER
	JMS IO		/READ NEXT HEADER
	RRSI		/GET HEADER BYTE #1
	BSW
	AND B3
	DCA OLDTRK	/SAVE 2 LSB
	RRSI		/GET HEADER BYTE #2
	AND B377	/HARDWARE SHOULD DO THIS
	CLL RTL
	TAD OLDTRK	/ADD IN MSB
	DCA OLDTRK
/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
	JMS TRKCMP
/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
/CALCULATE DIFFERENCE WORD FOR SEEK FROM TRACK DIFFERENCE
	SPA		/IF POSITIVE, LINK WILL BE SET
	CLL CIA		/IF NEGATIVE, CLEAR LINK
	RAR		/DELETE SURFACE, INCLUDE DIRECTION
	TAD SURF	/ADD SURFACE
	RLCA		/LOAD DIFFERENCE WORD
	AC0002		/PREPARE FOR SEEK
/LOOP BACK AND PERFORM SEEK; THIS ENSURES THAT THE TRACK
/REACHED IS THE CORRECT ONE IN SPITE OF POSSIBLE RL01
/SEEK UNRELIABILITY
	JMP SEEK
/SUBROUTINE TO COMPARE REQUESTED TRACK WITH OLD (REMEMBERED)
/TRACK; IF SAME, DO TRANSFER. IF DIFFERENT, RETURN WITH AC=
/REQUESTED-OLD, AND LINK=1
TRKCMP,	0
	TAD OLDTRK	/CALCULATE DIFFERENCE
	CIA
	TAD TRACK
	STL		/LINK MUST BE SET WHEN
			/DIFFERENCE IS POSITIVE.
	SZA
	JMP I TRKCMP	/DIFFERENT; RETURN
/ON TRACK: DO TRANSFER
/LOAD ALL REGISTERS
	TAD SECTOR
	RLSA
	TAD WC
	RLWC
	TAD SURF
	TAD CYL
	RLCA
	TAD MA
	RLMA
/DO THE READ OR WRITE
	TAD FNC
	JMS IO
/COUNT REQUESTED NUMBER OF PAGES
	TAD B7600
	TAD PAGES
	SNA
	JMP DONE
	DCA PAGES
	JMP I MAIN	/RETURN FOR MORE
/SUBROUTINE TO DO THE ACTUAL I/O
IO,	0		/AC=MODE,FIELD,FUNCTION
	TAD BDRIVE
	RLCB		/DO THE OPERATION
	RLSD		/WAIT UNTIL DONE
	JMP .-1
	RLSE		/TEST FOR I/O ERROR(S)
	JMP I IO	/NONE; RETURN
/IF ERROR, RETRY TWICE
	ISZ ERRCNT	/MORE RETRIES LEFT?
	JMP RETRY	/YES
/AFTER THREE TRIES, TAKE HANDLER ERROR RETURN
/WITH AC=4000
ERROR,	AC4000
	SKP
/NORMAL RETURN FROM HANDLER
DONE,	ISZ BARG	/SKIP ERROR RETURN
BRTN,	CIF CDF 00	/RETURN TO CALLING FIELD
			/BBL READ: NOP (FIELD 0)
	JMP I BARG	/RETURN TO CALLING PROGRAM
/DATA
BLOCK,	0
TRACK,	0		/BBL READ: TRACK 0
WC,	-41		/BBL READ: -BBL LENGTH
SECTOR,	1400		/BBL READ: SECTOR 14
CYL,	0
SURF,	0
ERRCNT,	0		/COUNT OF RETRIES
OLDTRK,	2000		/FORCE INITIAL SEEK
PAGES,	200		/BBL READ: ONE PAGE
FNC,	RLRD		/BBL READ: READ FUNCTION
/RELOCATED RELATIVE ADDRESSES

BARG,	OK-MAIN		/BBL READ: RETURN FROM READ
			/ADDRESS OF HANDLER ARGUMENTS
MA,	BBL-MAIN	/BBL READ: ADDR OF BBL
BBBL,	BBL-MAIN

B3,	3
B3777,	3777
B7600,	7600
BRLRD,	RLRD
HEADER,	BYTE RLRH
BDRIVE,	DRIVE^100	/DRIVE BITS FOR RLCB
CHECK,	-ID

/THIS CONSTANT MUST BE AT END OF PAGE
	ZBLOCK 577-.
B4070,	4070
$

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RL2.PA. 
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

/RL2: RL01 DRIVE 2 NON-SYSTEM HANDLER
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/RL01 DRIVE 2 NON-SYSTEM HANDLER

	VERSION="A&77

/NOTES:
/1. PRE-OMNIBUS COMPUTERS NOT SUPPORTED.

/EDIT HISTORY:
/13-OCT-77 DAVID SPECTOR: CREATION

/INSTRUCTIONS THAT GENERATE CONSTANTS

AC0001=CLA IAC
AC0002=CLA CLL CML RTL
AC0003=CLA CLL CML IAC RAL	/*
AC0004=CLA CLL IAC RTL		/*
AC0006=CLA CLL CML IAC RTL	/*
AC0100=CLA IAC BSW		/*
AC2000=CLA CLL CML RTR
AC3777=CLA CLL CMA RAR
AC4000=CLA CLL CML RAR
AC5777=CLA CLL CMA RTR
AC6000=CLA CLL CML IAC RTR	/*
AC7775=CLA CLL CMA RTL
AC7776=CLA CLL CMA RAL

/* USE ONLY ON VT-78 AND PDP-8E,F,M,A

/ID CODE AT START OF BAD BLOCK LIST (BBL)
	ID=123

/BAD BLOCK LIST FORMAT:
/WORD	CONTENTS
/0	ID (IDENTIFICATION CODE)
/1	BAD BLOCKS FOR DEVICE A (ASCENDING ORDER)
/...	...
/20	0 (TERMINATOR FOR LIST A)
/21	BAD BLOCKS FOR DEVICE B (ASCENDING ORDER)
/...	...
/40	0 (TERMINATOR FOR LIST B)

/RL01 DEFINITIONS

RLIOT=6600
RLDC=RLIOT 0	/CLEAR DEVICE
RLSD=RLIOT 1	/SKIP IF DONE
RLMA=RLIOT 2	/LOAD MEM ADDR
RLCA=RLIOT 3	/LOAD REGISTER "A"
RLCB=RLIOT 4	/LOAD REG "B" AND EXECUTE
RLSA=RLIOT 5	/LOAD SECTOR ADDR
		/RLIOT 6 UNUSED
RLWC=RLIOT 7	/LOAD WORD COUNT
RRER=RLIOT 10	/READ ERROR REG
RRWC=RLIOT 11	/READ WORD COUNT
RRCA=RLIOT 12	/READ REG "A"
RRCB=RLIOT 13	/READ REG "B"
RRSA=RLIOT 14	/READ SECTOR ADDR
RRSI=RLIOT 15	/READ SILO BYTE
		/RLIOT 16 UNUSED
RLSE=RLIOT 17	/SKIP IF ERROR
/RLCB FUNCTION BITS:
	RLMT=0	/MAINTENANCE MODE
	RLRE=1	/RESET DRIVE ERRORS
	RLST=2	/READ STATUS REGS INTO SILO
	RLSK=3	/SEEK
	RLRH=4	/READ HEADER
	RLWR=5	/WRITE
	RLRD=6	/READ
	RLRN=7	/READ WITH NO HEADER CHECK
/BIT DEFINITIONS IN REGISTERS:
BYTE=1000	/BYTE TRANSFER MODE
/HEADER BLOCK FOR USE BY "BUILD"

	*0
	-2		/- NR DEVICES PER HANDLER

/FORMAT OF ENTRIES IN HEADER BLOCK:
/WORD	DESCRIPTION
/0	GROUP NAME (4 CHAR)
/2	DEVICE NAME (4 CHAR)
/4	DCB WORD FOR AN RL (TYPE 26) DIRECTORY DEVICE
/5	OFFSET TO ENTRY POINT, 2-PAGE INDICATOR
/6	0 (UNUSED WORD)
/7	0 TO REPRESENT NON-SYSTEM DEVICE

	DRIVE=2

DEVICE RL2;DEVICE RL2A;4260;RLA&177+4000;0;0
DEVICE RL2;DEVICE RL2B;4260;RLB&177+4000;0;0
/HANDLER CODE
	*200		/FIRST PAGE

/DATA

A17,	17
A47,	47
A175,	175
A200,	200
A377,	377
A7751,	7751
BASE,	TAD BBL+1
ABLOCK,	BLOCK-MAIN
AMA,	MA-MAIN		/RELATIVE ADDR OF MA
ASECT,	SECTOR-MAIN
ATRACK,	TRACK-MAIN
AERROR,	ERROR-MAIN

/SET UP ARGUMENTS BY CALLING 2ND PAGE SUBROUTINE
SET,	TAD OFFSET	/INITIALIZE MAPPING (BELOW)
	BSW
	CLL RTL		/(0 OR 20: DEVICE A OR B)
	TAD BASE
	DCA MAP
	TAD RLB		/ADDR OF ARGS
	JMS I GO	/SETUP (AC NON-ZERO)
/MAP NEXT BLOCK AROUND ANY BAD BLOCKS BELOW IT
MAP,	TAD		/INITIALIZED ABOVE
	SNA		/0 TERMINATES LIST
	JMP MAPPED
	STL CIA		/13-BIT NEGATE
	TAD I ABLOCK	/COMPARE WITH BLOCK
	SZL CLA
	JMP MAPPED	/BAD BLOCK IS ABOVE CURRENT BLOCK
	ISZ MAP		/TRY NEXT BAD BLOCK ALSO
NEXT,	ISZ I ABLOCK	/INCREMENT CURRENT BLOCK NUMBER,
			/EITHER DURING
			/BAD BLOCK MAPPING OR AFTER SUCCESSFUL TRANSFER
			/OF TWO SECTORS (PAGES) WITH MORE TO GO
	JMP MAP		/CONTINUE MAPPING
	JMP I AERROR	/ERROR ON BLOCK OVERFLOW
	ZBLOCK 240+DRIVE-.	/UNUSED

/ENTRY POINT FOR DEVICE B

RLB,	VERSION
	AC0004		/TRACK OFFSET WILL BE 400
	JMP START	/SKIP AROUND RLA ENTRY POINT
OFFSET,	0		/TRACK OFFSET FOR DEVICE (0 OR 400)

/ENTRY POINT FOR DEVICE A

RLA,	VERSION
A7600,	7600		/=CLA
	TAD RLA		/TRANSFER CALLING ADDR
	DCA RLB
START,	BSW		/SET OFFSET TO 0 IF DEV A, 400 IF DEV B
	DCA OFFSET
	TAD A7600	/RETURN TO KEYBOARD MONITOR
	KRS		/IF CTRL,C TYPED
	TAD A175	/-CTRL,C
	SNA CLA
	KSF
ONCE,	JMP ONLY	/THIS INSTRUCTION IS DONE ONCE ONLY. IT IS
			/THEN CHANGED TO "JMP SET" AFTER HANDLER RELOCATION
			/IS DONE AND THE BAD BLOCK LIST IS READ IN.
ACDIF,	CIF CDF 00
	JMP I A7600	/CALL KB MONITOR
/THIS LOC IS SET TO ADDR OF NEXT PAGE BY ONCE-ONLY CODE
GO,	0		/ADDR OF MAIN
/-----BOUNDARY OF BAD BLOCK LIST-----
BBL,
/ONCE-ONLY CODE, REPLACED BY BAD BLOCK LIST
/READ IN BAD BLOCK LIST (BBL)
/SAVE CALLING DATA FIELD
	RDF
	TAD OOCDF
	DCA BACK
OOCDF,	CDF 00		/SET TO CURRENT FIELD
/REPLACE ONCE-ONLY JUMP INSTRUCTION
	TAD JMPSET
	DCA ONCE
LOOP,	TAD LIST	/RELOCATE CROSS-PAGE REFERENCES;
			/SCAN "LIST" FOR RELATIVE LOCATIONS
			/OF VALUES TO BE RELOCATED
	SNA		/0 ACTS AS TERMINATOR
	JMP OUT
	TAD GO		/RELOCATE RELATIVE ADDRESS
	DCA ONLY	/"ONLY" IS NOW TEMP STORAGE
	ISZ LOOP	/NEXT VALUE
	TAD GO
	TAD I ONLY	/RELOCATE THE CONTENTS
	DCA I ONLY
	JMP LOOP	/CONTINUE UNTIL DONE

/LIST OF RELATIVE ADDRESSES OF RELATIVE VALUES

LIST,	BARG-MAIN
	ABLOCK-MAIN
	BBBL-MAIN
	AMA-MAIN
	ASECT-MAIN
	ATRACK-MAIN
	MA-MAIN
	AERROR-MAIN
	0		/TERMINATOR

	ZBLOCK	BBL+40-.	/UNUSED (IN BBL BUFFER)

/ONCE-ONLY CODE CONTINUES
OUT,	JMS I GO	/READ BAD BLOCK LIST
/-----BOUNDARY OF BAD BLOCK LIST-----
OK,	CLA		/ERROR RETURN (IGNORE)
BACK,	CDF		/RESTORE CALLING FIELD
JMPSET,	JMP SET		/SETUP FOR TRANSFER

/END OF ONCE-ONLY CODE
/SETUP ARGS FOR CALL TO 2ND PAGE SUBROUTINE
/CALCULATE TRACK AND SECTOR FROM BLOCK
MAPPED,	TAD I ABLOCK
	RTR
	RTR
	AND A377
	TAD OFFSET	/DEVICE OFFSET (0 OR 400)
	DCA I ATRACK
	TAD I ABLOCK	/CALCULATE SECTOR FROM BLOCK
	AND A17		/SECTOR CODE
	CLL RTL
	TAD A7751
	SPA
	TAD A47
	BSW
	DCA I ASECT
/TRANSFER 1ST PAGE OF BLOCK
	JMS I GO
	TAD A200	/INCREMENT MA
	TAD I AMA
	DCA I AMA
/INCREMENT SECTOR
	TAD A200
	TAD I ASECT
	DCA I ASECT
/TRANSFER 2ND PAGE OF BLOCK
	JMS I GO
	TAD A200	/INCREMENT MA
	TAD I AMA
	DCA I AMA
/CONTINUE WITH NEXT BLOCK
	JMP NEXT

/ONCE-ONLY CODE AT END OF PAGE
	ZBLOCK 377-.	/UNUSED
ONLY,	JMS GO		/EXECUTED ONCE ONLY; STORES ADDR OF
			/2ND PAGE IN LOC "GO"
	*400
/2ND PAGE OF HANDLER

/SUBROUTINE TO SETUP AND TRANSFER
/AC=0 FOR TRANSFER ELSE SETUP
MAIN,	0
	SNA
	JMP TRANS
/GET HANDLER ARGUMENTS
SETUP,	DCA BARG	/ADDR OF HANDLER ARGS
	AC2000		/SET "OLDTRK" TO INVALID TRACK
	DCA OLDTRK	/TO FORCE READING NEXT HEADER.
	TAD B7600	/SET FOR FULL PAGE TRANSFERS
	DCA WC		/(WAS SMALLER FOR BBL READ)
	TAD I BARG	/NOW GET HANDLER ARGUMENTS
			/FUNCTION WORD
/NOTE: THE FOLLOWING INSTRUCTION IS USED AS A CONSTANT
B377,	AND B4070	/CONVERT TO RLCB FORMAT
	SPA
	TAD B3777
	TAD BRLRD
	DCA FNC
	TAD I BARG	/FUNCTION WORD
	RAL		/CONVERT TO PAGE COUNT IN BITS [7600]
	AND B7600
	DCA PAGES
	ISZ BARG
	TAD I BARG	/MA
	DCA MA
	ISZ BARG
	TAD I BARG	/BLOCK
	DCA BLOCK
	ISZ BARG
/SAVE CALLING FIELD FOR RETURN
	RDF
	TAD BCDIF
	DCA BRTN
/RESET DATA FIELD AND RETURN FROM SETUP WITH AC=BLOCK
BCDIF,	CIF CDF 00
/GET DEVICE OFFSET FROM 1ST PAGE
	TAD I BBBL	/CHECK FOR BBL VALIDITY -
	TAD CHECK	/1ST LOC OF BBL CONTAINS AN
	SZA CLA		/IDENTIFICATION CODE ("ID")
	JMP ERROR	/TAKE ERROR RETURN FROM HANDLER
			/IF BBL IS INVALID.
	JMP I MAIN
/TRANSFER ONE OR MORE PAGES TO/FROM DISK
/GET INTERPAGE ARGUMENTS
/RESET RETRY COUNT FOR 2 RETRIES ON I/O ERRORS
TRANS,	AC7775		/AC=-3
	DCA ERRCNT
/CALCULATE CYLINDER AND SURFACE FROM TRACK
	TAD TRACK
	CLL RAR
	DCA CYL
	RTR
	DCA SURF
/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
	JMS TRKCMP
/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
/RESET DRIVE (FUNCTION=1)
RETRY,	RLDC		/CLEAR CONTROLLER, AC
/SEEK (FUNCTION=3) WHEN CALLED FROM BELOW
SEEK,	IAC		/AC=(1 OR 3)
	JMS IO		/RESET DRIVE OR SEEK
/READ NEXT HEADER TO FIND OUT ACTUAL CURRENT TRACK
	TAD HEADER
	JMS IO		/READ NEXT HEADER
	RRSI		/GET HEADER BYTE #1
	BSW
	AND B3
	DCA OLDTRK	/SAVE 2 LSB
	RRSI		/GET HEADER BYTE #2
	AND B377	/HARDWARE SHOULD DO THIS
	CLL RTL
	TAD OLDTRK	/ADD IN MSB
	DCA OLDTRK
/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
	JMS TRKCMP
/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
/CALCULATE DIFFERENCE WORD FOR SEEK FROM TRACK DIFFERENCE
	SPA		/IF POSITIVE, LINK WILL BE SET
	CLL CIA		/IF NEGATIVE, CLEAR LINK
	RAR		/DELETE SURFACE, INCLUDE DIRECTION
	TAD SURF	/ADD SURFACE
	RLCA		/LOAD DIFFERENCE WORD
	AC0002		/PREPARE FOR SEEK
/LOOP BACK AND PERFORM SEEK; THIS ENSURES THAT THE TRACK
/REACHED IS THE CORRECT ONE IN SPITE OF POSSIBLE RL01
/SEEK UNRELIABILITY
	JMP SEEK
/SUBROUTINE TO COMPARE REQUESTED TRACK WITH OLD (REMEMBERED)
/TRACK; IF SAME, DO TRANSFER. IF DIFFERENT, RETURN WITH AC=
/REQUESTED-OLD, AND LINK=1
TRKCMP,	0
	TAD OLDTRK	/CALCULATE DIFFERENCE
	CIA
	TAD TRACK
	STL		/LINK MUST BE SET WHEN
			/DIFFERENCE IS POSITIVE.
	SZA
	JMP I TRKCMP	/DIFFERENT; RETURN
/ON TRACK: DO TRANSFER
/LOAD ALL REGISTERS
	TAD SECTOR
	RLSA
	TAD WC
	RLWC
	TAD SURF
	TAD CYL
	RLCA
	TAD MA
	RLMA
/DO THE READ OR WRITE
	TAD FNC
	JMS IO
/COUNT REQUESTED NUMBER OF PAGES
	TAD B7600
	TAD PAGES
	SNA
	JMP DONE
	DCA PAGES
	JMP I MAIN	/RETURN FOR MORE
/SUBROUTINE TO DO THE ACTUAL I/O
IO,	0		/AC=MODE,FIELD,FUNCTION
	TAD BDRIVE
	RLCB		/DO THE OPERATION
	RLSD		/WAIT UNTIL DONE
	JMP .-1
	RLSE		/TEST FOR I/O ERROR(S)
	JMP I IO	/NONE; RETURN
/IF ERROR, RETRY TWICE
	ISZ ERRCNT	/MORE RETRIES LEFT?
	JMP RETRY	/YES
/AFTER THREE TRIES, TAKE HANDLER ERROR RETURN
/WITH AC=4000
ERROR,	AC4000
	SKP
/NORMAL RETURN FROM HANDLER
DONE,	ISZ BARG	/SKIP ERROR RETURN
BRTN,	CIF CDF 00	/RETURN TO CALLING FIELD
			/BBL READ: NOP (FIELD 0)
	JMP I BARG	/RETURN TO CALLING PROGRAM
/DATA
BLOCK,	0
TRACK,	0		/BBL READ: TRACK 0
WC,	-41		/BBL READ: -BBL LENGTH
SECTOR,	1400		/BBL READ: SECTOR 14
CYL,	0
SURF,	0
ERRCNT,	0		/COUNT OF RETRIES
OLDTRK,	2000		/FORCE INITIAL SEEK
PAGES,	200		/BBL READ: ONE PAGE
FNC,	RLRD		/BBL READ: READ FUNCTION
/RELOCATED RELATIVE ADDRESSES

BARG,	OK-MAIN		/BBL READ: RETURN FROM READ
			/ADDRESS OF HANDLER ARGUMENTS
MA,	BBL-MAIN	/BBL READ: ADDR OF BBL
BBBL,	BBL-MAIN

B3,	3
B3777,	3777
B7600,	7600
BRLRD,	RLRD
HEADER,	BYTE RLRH
BDRIVE,	DRIVE^100	/DRIVE BITS FOR RLCB
CHECK,	-ID

/THIS CONSTANT MUST BE AT END OF PAGE
	ZBLOCK 577-.
B4070,	4070
$

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RL3.PA. 
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

/RL3: RL01 DRIVE 3 NON-SYSTEM HANDLER
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/RL01 DRIVE 3 NON-SYSTEM HANDLER

	VERSION="A&77

/NOTES:
/1. PRE-OMNIBUS COMPUTERS NOT SUPPORTED.

/EDIT HISTORY:
/13-OCT-77 DAVID SPECTOR: CREATION

/INSTRUCTIONS THAT GENERATE CONSTANTS

AC0001=CLA IAC
AC0002=CLA CLL CML RTL
AC0003=CLA CLL CML IAC RAL	/*
AC0004=CLA CLL IAC RTL		/*
AC0006=CLA CLL CML IAC RTL	/*
AC0100=CLA IAC BSW		/*
AC2000=CLA CLL CML RTR
AC3777=CLA CLL CMA RAR
AC4000=CLA CLL CML RAR
AC5777=CLA CLL CMA RTR
AC6000=CLA CLL CML IAC RTR	/*
AC7775=CLA CLL CMA RTL
AC7776=CLA CLL CMA RAL

/* USE ONLY ON VT-78 AND PDP-8E,F,M,A

/ID CODE AT START OF BAD BLOCK LIST (BBL)
	ID=123

/BAD BLOCK LIST FORMAT:
/WORD	CONTENTS
/0	ID (IDENTIFICATION CODE)
/1	BAD BLOCKS FOR DEVICE A (ASCENDING ORDER)
/...	...
/20	0 (TERMINATOR FOR LIST A)
/21	BAD BLOCKS FOR DEVICE B (ASCENDING ORDER)
/...	...
/40	0 (TERMINATOR FOR LIST B)

/RL01 DEFINITIONS

RLIOT=6600
RLDC=RLIOT 0	/CLEAR DEVICE
RLSD=RLIOT 1	/SKIP IF DONE
RLMA=RLIOT 2	/LOAD MEM ADDR
RLCA=RLIOT 3	/LOAD REGISTER "A"
RLCB=RLIOT 4	/LOAD REG "B" AND EXECUTE
RLSA=RLIOT 5	/LOAD SECTOR ADDR
		/RLIOT 6 UNUSED
RLWC=RLIOT 7	/LOAD WORD COUNT
RRER=RLIOT 10	/READ ERROR REG
RRWC=RLIOT 11	/READ WORD COUNT
RRCA=RLIOT 12	/READ REG "A"
RRCB=RLIOT 13	/READ REG "B"
RRSA=RLIOT 14	/READ SECTOR ADDR
RRSI=RLIOT 15	/READ SILO BYTE
		/RLIOT 16 UNUSED
RLSE=RLIOT 17	/SKIP IF ERROR
/RLCB FUNCTION BITS:
	RLMT=0	/MAINTENANCE MODE
	RLRE=1	/RESET DRIVE ERRORS
	RLST=2	/READ STATUS REGS INTO SILO
	RLSK=3	/SEEK
	RLRH=4	/READ HEADER
	RLWR=5	/WRITE
	RLRD=6	/READ
	RLRN=7	/READ WITH NO HEADER CHECK
/BIT DEFINITIONS IN REGISTERS:
BYTE=1000	/BYTE TRANSFER MODE
/HEADER BLOCK FOR USE BY "BUILD"

	*0
	-2		/- NR DEVICES PER HANDLER

/FORMAT OF ENTRIES IN HEADER BLOCK:
/WORD	DESCRIPTION
/0	GROUP NAME (4 CHAR)
/2	DEVICE NAME (4 CHAR)
/4	DCB WORD FOR AN RL (TYPE 26) DIRECTORY DEVICE
/5	OFFSET TO ENTRY POINT, 2-PAGE INDICATOR
/6	0 (UNUSED WORD)
/7	0 TO REPRESENT NON-SYSTEM DEVICE

	DRIVE=3

DEVICE RL3;DEVICE RL3A;4260;RLA&177+4000;0;0
DEVICE RL3;DEVICE RL3B;4260;RLB&177+4000;0;0
/HANDLER CODE
	*200		/FIRST PAGE

/DATA

A17,	17
A47,	47
A175,	175
A200,	200
A377,	377
A7751,	7751
BASE,	TAD BBL+1
ABLOCK,	BLOCK-MAIN
AMA,	MA-MAIN		/RELATIVE ADDR OF MA
ASECT,	SECTOR-MAIN
ATRACK,	TRACK-MAIN
AERROR,	ERROR-MAIN

/SET UP ARGUMENTS BY CALLING 2ND PAGE SUBROUTINE
SET,	TAD OFFSET	/INITIALIZE MAPPING (BELOW)
	BSW
	CLL RTL		/(0 OR 20: DEVICE A OR B)
	TAD BASE
	DCA MAP
	TAD RLB		/ADDR OF ARGS
	JMS I GO	/SETUP (AC NON-ZERO)
/MAP NEXT BLOCK AROUND ANY BAD BLOCKS BELOW IT
MAP,	TAD		/INITIALIZED ABOVE
	SNA		/0 TERMINATES LIST
	JMP MAPPED
	STL CIA		/13-BIT NEGATE
	TAD I ABLOCK	/COMPARE WITH BLOCK
	SZL CLA
	JMP MAPPED	/BAD BLOCK IS ABOVE CURRENT BLOCK
	ISZ MAP		/TRY NEXT BAD BLOCK ALSO
NEXT,	ISZ I ABLOCK	/INCREMENT CURRENT BLOCK NUMBER,
			/EITHER DURING
			/BAD BLOCK MAPPING OR AFTER SUCCESSFUL TRANSFER
			/OF TWO SECTORS (PAGES) WITH MORE TO GO
	JMP MAP		/CONTINUE MAPPING
	JMP I AERROR	/ERROR ON BLOCK OVERFLOW
	ZBLOCK 240+DRIVE-.	/UNUSED

/ENTRY POINT FOR DEVICE B

RLB,	VERSION
	AC0004		/TRACK OFFSET WILL BE 400
	JMP START	/SKIP AROUND RLA ENTRY POINT
OFFSET,	0		/TRACK OFFSET FOR DEVICE (0 OR 400)

/ENTRY POINT FOR DEVICE A

RLA,	VERSION
A7600,	7600		/=CLA
	TAD RLA		/TRANSFER CALLING ADDR
	DCA RLB
START,	BSW		/SET OFFSET TO 0 IF DEV A, 400 IF DEV B
	DCA OFFSET
	TAD A7600	/RETURN TO KEYBOARD MONITOR
	KRS		/IF CTRL,C TYPED
	TAD A175	/-CTRL,C
	SNA CLA
	KSF
ONCE,	JMP ONLY	/THIS INSTRUCTION IS DONE ONCE ONLY. IT IS
			/THEN CHANGED TO "JMP SET" AFTER HANDLER RELOCATION
			/IS DONE AND THE BAD BLOCK LIST IS READ IN.
ACDIF,	CIF CDF 00
	JMP I A7600	/CALL KB MONITOR
/THIS LOC IS SET TO ADDR OF NEXT PAGE BY ONCE-ONLY CODE
GO,	0		/ADDR OF MAIN
/-----BOUNDARY OF BAD BLOCK LIST-----
BBL,
/ONCE-ONLY CODE, REPLACED BY BAD BLOCK LIST
/READ IN BAD BLOCK LIST (BBL)
/SAVE CALLING DATA FIELD
	RDF
	TAD OOCDF
	DCA BACK
OOCDF,	CDF 00		/SET TO CURRENT FIELD
/REPLACE ONCE-ONLY JUMP INSTRUCTION
	TAD JMPSET
	DCA ONCE
LOOP,	TAD LIST	/RELOCATE CROSS-PAGE REFERENCES;
			/SCAN "LIST" FOR RELATIVE LOCATIONS
			/OF VALUES TO BE RELOCATED
	SNA		/0 ACTS AS TERMINATOR
	JMP OUT
	TAD GO		/RELOCATE RELATIVE ADDRESS
	DCA ONLY	/"ONLY" IS NOW TEMP STORAGE
	ISZ LOOP	/NEXT VALUE
	TAD GO
	TAD I ONLY	/RELOCATE THE CONTENTS
	DCA I ONLY
	JMP LOOP	/CONTINUE UNTIL DONE

/LIST OF RELATIVE ADDRESSES OF RELATIVE VALUES

LIST,	BARG-MAIN
	ABLOCK-MAIN
	BBBL-MAIN
	AMA-MAIN
	ASECT-MAIN
	ATRACK-MAIN
	MA-MAIN
	AERROR-MAIN
	0		/TERMINATOR

	ZBLOCK	BBL+40-.	/UNUSED (IN BBL BUFFER)

/ONCE-ONLY CODE CONTINUES
OUT,	JMS I GO	/READ BAD BLOCK LIST
/-----BOUNDARY OF BAD BLOCK LIST-----
OK,	CLA		/ERROR RETURN (IGNORE)
BACK,	CDF		/RESTORE CALLING FIELD
JMPSET,	JMP SET		/SETUP FOR TRANSFER

/END OF ONCE-ONLY CODE
/SETUP ARGS FOR CALL TO 2ND PAGE SUBROUTINE
/CALCULATE TRACK AND SECTOR FROM BLOCK
MAPPED,	TAD I ABLOCK
	RTR
	RTR
	AND A377
	TAD OFFSET	/DEVICE OFFSET (0 OR 400)
	DCA I ATRACK
	TAD I ABLOCK	/CALCULATE SECTOR FROM BLOCK
	AND A17		/SECTOR CODE
	CLL RTL
	TAD A7751
	SPA
	TAD A47
	BSW
	DCA I ASECT
/TRANSFER 1ST PAGE OF BLOCK
	JMS I GO
	TAD A200	/INCREMENT MA
	TAD I AMA
	DCA I AMA
/INCREMENT SECTOR
	TAD A200
	TAD I ASECT
	DCA I ASECT
/TRANSFER 2ND PAGE OF BLOCK
	JMS I GO
	TAD A200	/INCREMENT MA
	TAD I AMA
	DCA I AMA
/CONTINUE WITH NEXT BLOCK
	JMP NEXT

/ONCE-ONLY CODE AT END OF PAGE
	ZBLOCK 377-.	/UNUSED
ONLY,	JMS GO		/EXECUTED ONCE ONLY; STORES ADDR OF
			/2ND PAGE IN LOC "GO"
	*400
/2ND PAGE OF HANDLER

/SUBROUTINE TO SETUP AND TRANSFER
/AC=0 FOR TRANSFER ELSE SETUP
MAIN,	0
	SNA
	JMP TRANS
/GET HANDLER ARGUMENTS
SETUP,	DCA BARG	/ADDR OF HANDLER ARGS
	AC2000		/SET "OLDTRK" TO INVALID TRACK
	DCA OLDTRK	/TO FORCE READING NEXT HEADER.
	TAD B7600	/SET FOR FULL PAGE TRANSFERS
	DCA WC		/(WAS SMALLER FOR BBL READ)
	TAD I BARG	/NOW GET HANDLER ARGUMENTS
			/FUNCTION WORD
/NOTE: THE FOLLOWING INSTRUCTION IS USED AS A CONSTANT
B377,	AND B4070	/CONVERT TO RLCB FORMAT
	SPA
	TAD B3777
	TAD BRLRD
	DCA FNC
	TAD I BARG	/FUNCTION WORD
	RAL		/CONVERT TO PAGE COUNT IN BITS [7600]
	AND B7600
	DCA PAGES
	ISZ BARG
	TAD I BARG	/MA
	DCA MA
	ISZ BARG
	TAD I BARG	/BLOCK
	DCA BLOCK
	ISZ BARG
/SAVE CALLING FIELD FOR RETURN
	RDF
	TAD BCDIF
	DCA BRTN
/RESET DATA FIELD AND RETURN FROM SETUP WITH AC=BLOCK
BCDIF,	CIF CDF 00
/GET DEVICE OFFSET FROM 1ST PAGE
	TAD I BBBL	/CHECK FOR BBL VALIDITY -
	TAD CHECK	/1ST LOC OF BBL CONTAINS AN
	SZA CLA		/IDENTIFICATION CODE ("ID")
	JMP ERROR	/TAKE ERROR RETURN FROM HANDLER
			/IF BBL IS INVALID.
	JMP I MAIN
/TRANSFER ONE OR MORE PAGES TO/FROM DISK
/GET INTERPAGE ARGUMENTS
/RESET RETRY COUNT FOR 2 RETRIES ON I/O ERRORS
TRANS,	AC7775		/AC=-3
	DCA ERRCNT
/CALCULATE CYLINDER AND SURFACE FROM TRACK
	TAD TRACK
	CLL RAR
	DCA CYL
	RTR
	DCA SURF
/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
	JMS TRKCMP
/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
/RESET DRIVE (FUNCTION=1)
RETRY,	RLDC		/CLEAR CONTROLLER, AC
/SEEK (FUNCTION=3) WHEN CALLED FROM BELOW
SEEK,	IAC		/AC=(1 OR 3)
	JMS IO		/RESET DRIVE OR SEEK
/READ NEXT HEADER TO FIND OUT ACTUAL CURRENT TRACK
	TAD HEADER
	JMS IO		/READ NEXT HEADER
	RRSI		/GET HEADER BYTE #1
	BSW
	AND B3
	DCA OLDTRK	/SAVE 2 LSB
	RRSI		/GET HEADER BYTE #2
	AND B377	/HARDWARE SHOULD DO THIS
	CLL RTL
	TAD OLDTRK	/ADD IN MSB
	DCA OLDTRK
/COMPARE WITH OLD (PREVIOUS) TRACK; IF SAME, DO TRANSFER
	JMS TRKCMP
/IF REQUESTED TRACK IS DIFFERENT, SEEK TO TRACK
/CALCULATE DIFFERENCE WORD FOR SEEK FROM TRACK DIFFERENCE
	SPA		/IF POSITIVE, LINK WILL BE SET
	CLL CIA		/IF NEGATIVE, CLEAR LINK
	RAR		/DELETE SURFACE, INCLUDE DIRECTION
	TAD SURF	/ADD SURFACE
	RLCA		/LOAD DIFFERENCE WORD
	AC0002		/PREPARE FOR SEEK
/LOOP BACK AND PERFORM SEEK; THIS ENSURES THAT THE TRACK
/REACHED IS THE CORRECT ONE IN SPITE OF POSSIBLE RL01
/SEEK UNRELIABILITY
	JMP SEEK
/SUBROUTINE TO COMPARE REQUESTED TRACK WITH OLD (REMEMBERED)
/TRACK; IF SAME, DO TRANSFER. IF DIFFERENT, RETURN WITH AC=
/REQUESTED-OLD, AND LINK=1
TRKCMP,	0
	TAD OLDTRK	/CALCULATE DIFFERENCE
	CIA
	TAD TRACK
	STL		/LINK MUST BE SET WHEN
			/DIFFERENCE IS POSITIVE.
	SZA
	JMP I TRKCMP	/DIFFERENT; RETURN
/ON TRACK: DO TRANSFER
/LOAD ALL REGISTERS
	TAD SECTOR
	RLSA
	TAD WC
	RLWC
	TAD SURF
	TAD CYL
	RLCA
	TAD MA
	RLMA
/DO THE READ OR WRITE
	TAD FNC
	JMS IO
/COUNT REQUESTED NUMBER OF PAGES
	TAD B7600
	TAD PAGES
	SNA
	JMP DONE
	DCA PAGES
	JMP I MAIN	/RETURN FOR MORE
/SUBROUTINE TO DO THE ACTUAL I/O
IO,	0		/AC=MODE,FIELD,FUNCTION
	TAD BDRIVE
	RLCB		/DO THE OPERATION
	RLSD		/WAIT UNTIL DONE
	JMP .-1
	RLSE		/TEST FOR I/O ERROR(S)
	JMP I IO	/NONE; RETURN
/IF ERROR, RETRY TWICE
	ISZ ERRCNT	/MORE RETRIES LEFT?
	JMP RETRY	/YES
/AFTER THREE TRIES, TAKE HANDLER ERROR RETURN
/WITH AC=4000
ERROR,	AC4000
	SKP
/NORMAL RETURN FROM HANDLER
DONE,	ISZ BARG	/SKIP ERROR RETURN
BRTN,	CIF CDF 00	/RETURN TO CALLING FIELD
			/BBL READ: NOP (FIELD 0)
	JMP I BARG	/RETURN TO CALLING PROGRAM
/DATA
BLOCK,	0
TRACK,	0		/BBL READ: TRACK 0
WC,	-41		/BBL READ: -BBL LENGTH
SECTOR,	1400		/BBL READ: SECTOR 14
CYL,	0
SURF,	0
ERRCNT,	0		/COUNT OF RETRIES
OLDTRK,	2000		/FORCE INITIAL SEEK
PAGES,	200		/BBL READ: ONE PAGE
FNC,	RLRD		/BBL READ: READ FUNCTION
/RELOCATED RELATIVE ADDRESSES

BARG,	OK-MAIN		/BBL READ: RETURN FROM READ
			/ADDRESS OF HANDLER ARGUMENTS
MA,	BBL-MAIN	/BBL READ: ADDR OF BBL
BBBL,	BBL-MAIN

B3,	3
B3777,	3777
B7600,	7600
BRLRD,	RLRD
HEADER,	BYTE RLRH
BDRIVE,	DRIVE^100	/DRIVE BITS FOR RLCB
CHECK,	-ID

/THIS CONSTANT MUST BE AT END OF PAGE
	ZBLOCK 577-.
B4070,	4070
$

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RLC.PA. 
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

/RLC: RL01 DEVICE C NON-SYSTEM HANDLER
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/RL01 DEVICE C NON-SYSTEM HANDLER

 	VERSION="A&77

/NOTES:
/1. PRE-OMNIBUS COMPUTERS NOT SUPPORTED.

/EDIT HISTORY:
/9-NOV-77 DAVID SPECTOR: CREATION

/INSTRUCTIONS THAT GENERATE CONSTANTS

AC0001=CLA IAC
AC0002=CLA CLL CML RTL
AC0003=CLA CLL CML IAC RAL	/*
AC0004=CLA CLL IAC RTL		/*
AC0006=CLA CLL CML IAC RTL	/*
AC0100=CLA IAC BSW		/*
AC2000=CLA CLL CML RTR
AC3777=CLA CLL CMA RAR
AC4000=CLA CLL CML RAR
AC5777=CLA CLL CMA RTR
AC6000=CLA CLL CML IAC RTR	/*
AC7775=CLA CLL CMA RTL
AC7776=CLA CLL CMA RAL

/* USE ONLY ON VT-78 AND PDP-8E,F,M,A

/ID CODE AT START OF BAD BLOCK LIST (BBL)
	ID=123

/BAD BLOCK LIST FORMAT:
/(TRACK 0 SECTOR 16)
/WORD	CONTENTS
/0	ID (IDENTIFICATION CODE)
/1	BAD BLOCK NUMBERS (ASCENDING ORDER)
/...	...
/20	0 (LIST TERMINATOR)
/RL01 DEFINITIONS

RLIOT=6600
RLDC=RLIOT 0	/CLEAR DEVICE
RLSD=RLIOT 1	/SKIP IF DONE
RLMA=RLIOT 2	/LOAD MEM ADDR
RLCA=RLIOT 3	/LOAD REGISTER "A"
RLCB=RLIOT 4	/LOAD REG "B" AND EXECUTE
RLSA=RLIOT 5	/LOAD SECTOR ADDR
		/RLIOT 6 UNUSED
RLWC=RLIOT 7	/LOAD WORD COUNT
RRER=RLIOT 10	/READ ERROR REG
RRWC=RLIOT 11	/READ WORD COUNT
RRCA=RLIOT 12	/READ REG "A"
RRCB=RLIOT 13	/READ REG "B"
RRSA=RLIOT 14	/READ SECTOR ADDR
RRSI=RLIOT 15	/READ SILO BYTE
		/RLIOT 16 UNUSED
RLSE=RLIOT 17	/SKIP IF ERROR
/RLCB FUNCTION BITS:
	RLMT=0	/MAINTENANCE MODE
	RLRE=1	/RESET DRIVE ERRORS
	RLST=2	/READ STATUS REGS INTO SILO
	RLSK=3	/SEEK
	RLRH=4	/READ HEADER
	RLWR=5	/WRITE
	RLRD=6	/READ
	RLRN=7	/READ WITH NO HEADER CHECK
/BIT DEFINITIONS IN REGISTERS:
BYTE=1000	/BYTE TRANSFER MODE
/HEADER BLOCK FOR USE BY "BUILD"

	*0
	-4		/- NR DEVICES PER HANDLER

/FORMAT OF ENTRIES IN HEADER BLOCK:
/WORD	DESCRIPTION
/0	GROUP NAME (4 CHAR)
/2	DEVICE NAME (4 CHAR)
/4	DCB WORD FOR AN RL01(C), DIRECTORY DEVICE
/5	OFFSET TO ENTRY POINT, 2-PAGE INDICATOR
/6	0 (UNUSED WORD)
/7	0 TO REPRESENT NON-SYSTEM DEVICE

DEVICE RLC;DEVICE RL0C;4310;RL0C&177+4000;0;0
DEVICE RLC;DEVICE RL1C;4310;RL1C&177+4000;0;0
DEVICE RLC;DEVICE RL2C;4310;RL2C&177+4000;0;0
DEVICE RLC;DEVICE RL3C;4310;RL3C&177+4000;0;0
/HANDLER CODE

	*200		/FIRST PAGE

START,	DCA DRIVE	/SAVE DRIVE NUMBER.
	TAD DRIVE	/FIND ENTRY ADDR IN
	CLL RTL		/ORDER TO TRANSFER
	TAD TADX	/CALLING ADDR TO "ARG".
	DCA .+1
	TAD
	DCA ARG
	TAD I ARG	/GET ARGUMENTS
			/FUNCTION WORD
	AND A4070	/READ-WRITE, FIELD
	SPA
	TAD A3777	/IF WRITE, -1
	TAD ARLRD	/CONVERT FUNCTION TO RL01
			/FUNCTION WORD.
	DCA FNC
	TAD I ARG	/FUNCTION WORD
	RAL
	AND A7600	/PAGES IN BITS [7600];
			/0 MEANS 40.
	DCA PAGES
	ISZ ARG
	TAD I ARG	/MA
	DCA MA
	ISZ ARG
	TAD I ARG	/BLOCK
	DCA BLOCK
	ISZ ARG
	RDF		/SAVE CALLING FIELD
	TAD ACIDF	/FOR RETURN.
	DCA RTN
ACIDF,	CIF CDF 00	/CHANGE TO CURRENT FIELD.
	TAD A7600	/RETURN TO MONITOR IF USER
	KRS		/TYPES CTRL,C.
	TAD A175
	SNA CLA
	KSF
ONCE,	JMP ONLY	/ELSE START ONCE-ONLY CODE
			/AT "ONLY". "ONCE" GETS CHANGED
			/TO "JMP BEGIN" BY ONCE-ONLY CODE.
	JMP I A7600	/CALL MONITOR UPON CTRL,C.

/CONSTANTS

ATRANS,	TRANS-MAIN
ACURTK,	CURTRK-MAIN
CHECK,	-ID
A200,	200
A4070,	4070
/ENTRY POINTS

	IFNZRO 250-.	<ENTRY POINTS START AT OFFSET OF 50>

ARG,			/ADDR OF ARG LIST
RL0C,	VERSION		/DRIVE 0 ENTRY POINT
	CLA
	JMP START
TADX,	TAD ARG		/A CONSTANT
RL1C,	VERSION		/DRIVE 1 ENTRY POINT
	AC0001
	JMP START
A175,	175
RL2C,	VERSION		/DRIVE 2 ENTRY POINT
	AC0002
	JMP START
A3777,	3777
RL3C,	VERSION		/DRIVE 3 ENTRY POINT
	AC0003
	JMP START
GO,	0		/ONCE-ONLY CODE.
			/ADDRESS OF 2ND PAGE STORED HERE.
BBL,	TAD JMPX	/NEXT 21 OCTAL LOCATIONS ARE
			/REPLACED BY THE BAD BLOCK LIST
			/WHEN IT IS READ IN
			/FROM REQUESTED DRIVE.
			/ONCE-ONLY CODE: PREVENT EXE-
			/CUTION MORE THAN ONCE.
	DCA ONCE
LOOP,	TAD LIST	/RELOCATE LOCATIONS CONTAINING
	SNA		/RELATIVE ADDRESSES TO MAKE THEM
JMPX,	JMP BEGIN	/ABSOLUTE. LOCATION LIST IS TERM-
			/INATED BY ZERO.
	TAD GO		/RELOCATE VALUE IN LIST.
	DCA ONLY	/"ONLY" IS NOW TEMP STORAGE.
	ISZ LOOP
	TAD GO		/RELOCATE ADDRESS(VALUE).
	TAD I ONLY
	DCA I ONLY
	JMP LOOP	/CONTINUE UNTIL DONE.
LIST,	ABBL-MAIN	/LIST OF RELATIVE ADDRESSES OF
			/RELOCATABLE ADDRESSES.
	ATRANS-MAIN
	ACURTK-MAIN
	BBLOCK-MAIN
	BSECT-MAIN
	BTRACK-MAIN
	BHALF-MAIN
	BDRIVE-MAIN
	BASE-MAIN
	BERROR-MAIN
	0		/TERMINATOR.
/PERFORM TRANSFER, READING IN BBL IF NECESSARY

BEGIN,	AC2000	
	DCA I ACURTK	/FORCE IGNORANCE OF CURRENT
			/TRACK IN CASE OPERATION IS
			/TO A DIFFERENT DRIVE.
			/(2000 IS AN ILLEGAL TRACK)
	TAD DRIVE	/HAS DRIVE CHANGED FROM LAST CALL?
	CIA
	TAD CURDRV
	SNA CLA
	JMP I ATRANS	/NO, DO TRANSFER.
	TAD DRIVE	/YES, REMEMBER CHANGE AND
	DCA CURDRV	/READ IN BAD BLOCK LIST.
	JMS I GO	/CALL TRANSFER SUBROUTINE
	    0		/TRACK=0
	    16		/SECTOR=16
	    -21		/WC=-LIST LENGTH
ABBL,	    BBL-MAIN	/MA="BBL"
ARLRD,	    RLRD	/FUNCTION=READ INTO FIELD 0
	TAD I ABBL	/IS BBL VALID?
	TAD CHECK	/-ID.
	SNA CLA
	JMP I ATRANS	/YES, DO TRANSFER.
ERROR,	AC4000		/HANDLER ERROR RETURN.
	SKP
DONE,	ISZ ARG		/NORMAL HANDLER RETURN.
RTN,	CIF CDF		/RETURN TO CALLING FIELD.
	JMP I ARG
/SECTOR TRANSFER SUBROUTINE

HALF,	0		/TRANSFER ONE PAGE.
	JMS I GO	/CALL TRANSFER SUBROUTINE
TRACK,	    0		/TRACK
SECTOR,	    0		/SECTOR
A7600,	    7600	/-WORD COUNT
MA,	    0		/MEMORY ADDRESS
FNC,	    0		/FUNCTION WORD
	TAD A200	/INCREMENT MEMORY ADDRESS.
	TAD MA
	DCA MA
	ISZ SECTOR	/INCREMENT SECTOR ADDRESS.
	ISZ SECTOR	/(2:1 INTERLEAVE)
	TAD A7600	/DECREMENT PAGE COUNT.
	TAD PAGES
	SNA
	JMP DONE	/TAKE NORMAL HANDLER RETURN
			/WHEN PAGE COUNT REACHES ZERO.
	DCA PAGES	/ELSE CONTINUE TRANSFER.
	JMP I HALF

/VARIABLES

DRIVE,	0
PAGES,	0
BLOCK,	0

	ZBLOCK 377-.	/UNUSED: "ONLY" MUST BE AT 377!

CURDRV,			/CURRENT DRIVE (INITIALLY INVALID
			/TO FORCE READ-IN OF BAD BLOCK LIST).
ONLY,	JMS GO		/ONCE-ONLY CODE TO PUT ADDRESS
			/OF "MAIN" INTO "GO".
			/REUSED AS CURRENT DRIVE.
	*400		/SECOND PAGE

MAIN,	0		/TRANSFER UP TO ONE PAGE.
	AC7775		/INITIALIZE FOR 3 TRIES.
	DCA ERRCNT
	TAD MAIN	/SAVE ADDRESS OF ARGS.
	DCA MAINSV
	TAD I MAIN	/CALCULATE CYLINDER AND
			/SURFACE FROM TRACK.
			/1ST ARG=TRACK.
	CLL RAR
	DCA CYL
	RTR
	DCA SURF
	JMS TRKCMP	/IF ON TRACK, DO TRANSFER.
RETRY,	TAD MAINSV	/OFF TRACK: SEEK TO TRACK.
	DCA MAIN	/RESTORE ADDRESS OF ARGS.
	RLDC		/CLEAR CONTROLLER REGISTERS.
SEEK,	IAC		/AC=CLEAR DRIVE REGISTERS
			/FUNCTION (AC=SEEK FUNCTION
			/WHEN CALLED FROM BELOW).
	JMS IO		/DO RL01 FUNCTION.
	TAD HEADER
	JMS IO		/READ NEXT HEADER FROM DISK.
	RRSI		/GET HEADER BYTE #1.
	BSW
B377,	AND B3		/THIS INSTRUCTION IS ALSO USED
			/AS A CONSTANT.
	DCA CURTRK	/BITS [3] OF CURRENT TRACK.
	RRSI		/GET HEADER BYTE #2.
	AND B377	/THIS SHOULD BE DONE BY HARDWARE!
	CLL RTL		/BITS [774] OF CURRENT TRACK.
	TAD CURTRK
	DCA CURTRK
	JMS TRKCMP	/IF ON TRACK, DO TRANSFER.
	TAD CURTRK	/OFF TRACK: CONSTRUCT DIFFERENCE
	CLL RAR		/WORD FOR SEEK.
	CIA
	TAD CYL
	SMA
	JMP AROUND
	CIA
	SKP
AROUND,	TAD B4000	/SET DIRECTION BIT IF TO HIGHER
			/CYLINDER ADDRESS.
	TAD SURF
	RLCA		/LOAD DIFFERENCE WORD.
	AC0002		/PREPARE AC FOR SEEK FUNCTION.
	JMP SEEK	/SEEK.
TRKCMP,	0		/IF ON TRACK, DO TRANSFER.
	TAD CURTRK	/COMPARE CURRENT TRACK AND
	CIA		/DESIRED TRACK.
	TAD I MAIN	/1ST ARG=TRACK.
	SZA CLA
	JMP I TRKCMP	/DIFFERENT: SEEK.
	ISZ MAIN	/ON TRACK: DO TRANSFER.
	TAD CYL
	TAD SURF
	RLCA		/LOAD DISK ADDRESS OF TRACK.
	TAD I MAIN	/2ND ARG=SECTOR.
	BSW
	RLSA		/LOAD SECTOR ADDRESS.
	ISZ MAIN
	TAD I MAIN	/3RD ARG=WORD COUNT.
	RLWC		/LOAD WORD COUNT.
	ISZ MAIN
	TAD I MAIN	/4TH ARG=MA.
	RLMA		/LOAD MA.
	ISZ MAIN
	TAD I MAIN	/5TH ARG=FUNCTION.
	JMS IO		/DO RL01 FUNCTION.
	ISZ MAIN
	JMP I MAIN	/RETURN FROM TRANSFER SUBROUTINE.
TRANS,	TAD BASE	/DO TRANSFER.
			/INITIALIZE BAD BLOCK MAPPING.
	DCA MAPPER
MAP,	TAD I MAPPER	/DO BAD BLOCK MAPPING.
			/GET BAD BLOCK IF ANY.
	SNA		/DONE? (0 TERMINATES)
	JMP MAPPED	/YES.
	STL CIA		/NO, 13-BIT NEGATE.
	TAD I BBLOCK	/SUBTRACT FROM CURRENT BLOCK.
	SZL CLA		/IS BAD BLOCK GREATER (UNSIGNED)?
	JMP MAPPED	/YES, MAPPING IS DONE.
	ISZ MAPPER	/NO, MAP AROUND THIS BAD BLOCK
			/AND TRY NEXT.
NEXT,	ISZ I BBLOCK	/WILL NEVER SKIP.
	JMP MAP		/CONTINUE MAPPING UNTIL DONE.
MAPPED,	TAD I BBLOCK	/CALCULATE SECTOR FROM BLOCK.
	AND B3
	CLL RTL
	DCA I BSECT
	TAD I BBLOCK	/TEST BLOCK FOR LEGALITY: LEGAL
	TAD B4010	/BLOCKS ARE 0-3767.
	SZL CLA
	JMP I BERROR
	TAD I BBLOCK	/CALCULATE TRACK FROM BLOCK.
	RTR
	AND B777
	IAC
	DCA I BTRACK
	JMS I BHALF	/TRANSFER 1ST HALF OF BLOCK.
	JMS I BHALF	/TRANSFER 2ND HALF OF BLOCK.
	JMP NEXT	/CONTINUE WITH NEXT BLOCK.
IO,	0		/DO RL01 FUNCTION.
	BSW
	TAD I BDRIVE
	BSW		/PUT DRIVE INTO BITS [300].
	RLCB		/DO RL01 COMMAND.
	RLSD		/WAIT UNTIL DONE.
	JMP .-1
	RLSE		/ANY ERRORS?
	JMP I IO	/NO, RETURN.
	ISZ ERRCNT	/YES, TRY AGAIN?
	JMP RETRY	/YES.
	JMP I BERROR	/TAKE ERROR RETURN WHEN 3
			/TRIES HAVE BEEN DONE.

/DATA
BBLOCK,	BLOCK-MAIN
BSECT,	SECTOR-MAIN
BTRACK,	TRACK-MAIN
BHALF,	HALF-MAIN
BDRIVE,	DRIVE-MAIN
BERROR,	ERROR-MAIN
BASE,	BBL+1-MAIN	/START OF BBL FOR MAPPING.
MAPPER,	0
MAINSV,	0		/SAVED "MAIN" VALUE.
CURTRK,	0
HEADER,	BYTE RLRH
SURF,	0
CYL,	0
ERRCNT,	0
B777,	777
B4000,	4000
B4010,	4010

	ZBLOCK 577-.	/UNUSED.

B3,	3		/THIS CONSTANT MUST BE AT
			/LAST LOC OF 2ND PAGE.

$

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RLFRMT.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226

/RLFRMT: RL01 DISK PACK FORMATTER
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/RL01 DISK PACK FORMATTING PROGRAM

VERSION=1
PATCH="A&77

/NOTE:
/THIS SOFTWARE WILL RUN ONLY ON PDP-8A,E,F,M!

/EDIT HISTORY:
/2-NOV-77 DAVID SPECTOR: CREATION

/RLFRMT WRITES OS/8 BAD BLOCK LISTS
/ON RL01 DISK PACKS

/BAD BLOCK LIST FORMATS:
/1. FACTORY-DETECTED BAD BLOCKS
/   CYLINDER 377 SURFACE 1 EVEN SECTORS 0-16
/   BYTE	CONTENTS	COMMENTS
/    0		22111000	SERIAL NUMBER:
/    1		?4443332	9876543210 (OCTAL)
/    2		77666555
/    3		?9998887
/    4		?		UNUSED
/    5		?
/    6		?
/    7		?
/   10		CYLINDER	BAD SECTOR ENTRY
/   11		???????D	DOUBLE-DENSITY EXTENSION
/   12		??SECTOR
/   13		???????S	SURFACE BIT
/   ...		...		MORE BAD SECTOR ENTRIES
/   ???		ALL 1'S		TERMINATOR ENTRY

/ NOTE: "?" REPRESENTS UNUSED ITEMS (0)
/2. OS/8 BAD BLOCK LISTS

/2A. DEVICES A AND B
/	CYLINDER 0 SURFACE 0 SECTOR 14
/WORD	CONTENTS
/ 0	IDENTIFICATION CODE (ID)
/ 1	BAD BLOCKS FOR DEVICE A IN ASCENDING ORDER
/...	...
/20	0 (TERMINATOR FOR LIST)
/21	BAD BLOCKS FOR DEVICE B IN ASCENDING ORDER
/...	...
/40	0 (TERMINATOR FOR LIST)

/2B. DEVICE C
/	CYLINDER 0 SURFACE 0 SECTOR 16
/WORD	CONTENTS
/ 0	IDENTIFICATION CODE (ID)
/ 1	BAD BLOCKS FOR DEVICE C IN ASCENDING ORDER
/...	...
/20	0 (TERMINATOR FOR LIST)
/100-177	ID CODE

/3. INTERNAL TRACK-SECTOR FORMAT:
/WORD 0: TRACK
/WORD 1: SECTOR
/TERMINATOR: NEGATIVE TRACK WORD

/4. INTERNAL OS/8 FORMAT:
/WORD 0: DEVICE (0=A, 1=B, 2=C)
/WORD 1: BLOCK NUMBER
/TERMINATOR: NEGATIVE DEVICE WORD

/	+-------------------------------+
/	!				!
/	!	      NOTE		!
/	!				!
/	!  REFER TO THE DOCUMENT "RL01	!
/	!  SUPPORT  UNDER  OS/8"   FOR	!
/	!  FURTHER INFORMATION.		!
/	!				!
/	!				!
/	+-------------------------------+
/INSTRUCTIONS THAT GENERATE CONSTANTS

AC0001=CLA IAC
AC0002=CLA CLL CML RTL
AC0003=CLA CLL CML IAC RAL	/*
AC0004=CLA CLL IAC RTL		/*
AC0006=CLA CLL CML IAC RTL	/*
AC0100=CLA IAC BSW		/*
AC2000=CLA CLL CML RTR
AC3777=CLA CLL CMA RAR
AC4000=CLA CLL CML RAR
AC5777=CLA CLL CMA RTR
AC6000=CLA CLL CML IAC RTR	/*
AC7775=CLA CLL CMA RTL
AC7776=CLA CLL CMA RAL

/* USE ONLY ON VT-78 AND PDP-8A,E,F,M


/PAGE 0 VARIABLES
	AUTO1=10
	AUTO2=11
	AUTO3=12
	AUTO4=13
	TEMP=20
	KEY=21
	INT=22		/RESERVED
	TMP1=23
	TMP2=24
	TMP3=25
	TMP4=26
	TMP5=27
	TMP6=30
	TMP7=31
	DIGIT=32	/DRIVE NUMBER
	DRIVE=DIGIT	/DRIVE VALUE
	FMT=33		/7777 IF FORMATTED DISK
	FAC=34		/7777 IF FACTORY LIST OK

/LOCATIONS WITHIN OS/8
	MON=7605	/FAST MONITOR RETURN FROM RLFRMT

/IDENTIFICATION CODE FOR BAD BLOCK LISTS
	ID=123
/BUFFERS
	FACTRY=4000	/2 PAGES: FACTORY LIST
	AANDB=FACTRY+400	/1 PAGE: OS/8 A&B LISTS
	C=AANDB+200	/1 PAGE: OS/8 C LIST
	X=C+200		/1 PAGE: "DON'T CARE" PAGE
			/(FOR READ-CHECKING)
	OLD=X		/1 PAGE: OLD OS/8 A,B,C
	NEW=X+200	/1 PAGE: NEWLY-FOUND BAD BLOCKS
/RL01 DEFINITIONS

RLIOT=6600
RLDC=RLIOT 0	/CLEAR DEVICE
RLSD=RLIOT 1	/SKIP IF DONE
RLMA=RLIOT 2	/LOAD MEM ADDR
RLCA=RLIOT 3	/LOAD REGISTER "A"
RLCB=RLIOT 4	/LOAD REG "B" AND EXECUTE
RLSA=RLIOT 5	/LOAD SECTOR ADDR
		/RLIOT 6 UNUSED
RLWC=RLIOT 7	/LOAD WORD COUNT
RRER=RLIOT 10	/READ ERROR REG
RRWC=RLIOT 11	/READ WORD COUNT
RRCA=RLIOT 12	/READ REG "A"
RRCB=RLIOT 13	/READ REG "B"
RRSA=RLIOT 14	/READ SECTOR ADDR
RRSI=RLIOT 15	/READ SILO BYTE
		/RLIOT 16 UNUSED
RLSE=RLIOT 17	/SKIP IF ERROR
/RLCB FUNCTION BITS:
	RLMT=0	/MAINTENANCE MODE
	RLRE=1	/RESET DRIVE ERRORS
	RLST=2	/READ STATUS REGS INTO SILO
	RLSK=3	/SEEK
	RLRH=4	/READ HEADER
	RLWR=5	/WRITE
	RLRD=6	/READ
	RLRN=7	/READ WITH NO HEADER CHECK
/BIT DEFINITIONS IN REGISTERS:
BYTE=1000	/BYTE TRANSFER MODE
	*200		/STARTING ADDRESS

	TAD (IDMSG)	/START HERE
	JMS TYPE	/IDENTIFY SELF
RE,	TAD (MSG)	/RESTART HERE.
	JMS TYPE	/ASK FOR DRIVE NUMBER
RE1,	JMS GETKEY	/WAIT FOR KEY
	TAD (-60)	/CONVERT TO DIGIT
	DCA DIGIT
	TAD DIGIT
	AND (7774)	/ALLOW ONLY DRIVES 0-3
	SNA CLA
	JMP FA1
BUIN,	TAD (BDMSG)	/BAD USER INPUT: ADVISE USER.
	JMS TYPE
	JMP RE
FA1,	JMS GETKEY	/WAIT FOR RETURN KEY
	TAD (-15)
	SZA CLA
	JMP BUIN
	TAD DIGIT	/GOOD USER INPUT;
	BSW		/CHANGE DIGIT TO DRIVE NR.
	DCA DIGIT
	JMS CRLF
	AC2000		/SET CURRENT TRACK TO ILLEGAL
	DCA CURTRK	/VALUE IN ORDER TO FORCE A 'READ
			/HEADER' OPERATION THE FIRST
			/TIME "RL01" IS CALLED, SO WE
			/CAN FIND OUT WHERE THE HEAD IS.
	JMS RL01	/READ OS/8 BAD BLOCK LIST
			/(BBL) FOR DEVICES A&B
	    RLRD	/FUNCTION
	    AANDB	/MA
	    0		/TRACK
	    14		/SECTOR
	    JMP FATAL	/ERROR RETURN
	JMS RL01	/NORMAL RETURN: READ OS/8
			/BBL FOR DEVICE C
	    RLRD	/FUNCTION
	    C		/MA
	    0		/TRACK
	    16		/SECTOR
	    JMP FATAL	/ERROR RETURN
	DCA RCTRK	/PERFORM READ-CHECK OF ENTIRE
			/DISK
	TAD (-1000)	/NUMBER OF TRACKS
	DCA TMP2
	TAD (NEW-1)
	DCA AUTO3	/STORAGE FOR BAD ONES FOUND
	TAD (-100)
	DCA BADCNT	/IN CASE ALL ARE "BAD"
RCNEXT,	JMS RCSUB	/READ NEXT TRACK
			/EVEN SECTORS
	CLA IAC
	JMS RCSUB	/ODD SECTORS
	ISZ RCTRK
	ISZ TMP2
	JMP RCNEXT
	STA		/TERMINATE NEW BAD LIST
	DCA I AUTO3
	STA		/READ BAD BLOCK LISTS FROM DISK
			/START WITH FACTORY-DETECTED
			/BAD BLOCK LIST
			/TRY ALL BAD BLOCK LISTS ON LAST
			/TRACK - SET "FAC" TO -1 IF LIST
			/IS READ IN OK, ELSE 0.
			/INITIALLY ASSUME OK.
	DCA FAC
	TAD (-10)	/SET FOR 8 TRIES.
	DCA TMP1
	DCA FACSEC	/EVEN SECTORS, STARTING WITH 0.
FACRD,	JMS RL01	/CALL RL01 TRANSFER SUBROUTINE
			/TO TRY READING FACTORY BAD
			/BLOCK LIST.
	    BYTE RLRD	/FUNCTION WORD
	    FACTRY	/MA
	    777		/TRACK
FACSEC,	    0		/SECTOR
	    JMP FACBAD	/ERROR RETURN
	TAD (FACCTL-1)	/NORMAL RETURN: TEST LIST JUST
			/READ FOR VALIDITY (4 ZEROS IN
			/FACTRY+4, 4 377'S IN FACTRY+374).
	DCA AUTO1
FAC1,	TAD I AUTO1	/LOC FOR VALIDITY TEST.
	SNA		/0 TERMINATES CONTROL LIST.
	JMP FACOK	/MUST BE VALID; CONTINUE.
	DCA AUTO2	/LOC FOR VALIDITY TEST.
	TAD I AUTO1	/VALUE FOR VALIDITY TEST.
	DCA TMP2
	TAD (-4)	/BYTES TO CHECK.
	DCA TMP3
FAC2,	TAD I AUTO2	/CHECK NEXT BYTE.
	AND (377)	/HARDWARE SHOULD DO THIS!
	CIA
	TAD TMP2
	SZA CLA		/VALUE CHECKS OK?
	JMP FACBAD	/NO.
	ISZ TMP3	/YES, DONE?
	JMP FAC2	/NO, CHECK NEXT BYTE.
	JMP FAC1	/YES, DO NEXT TEST IF ANY.

FACBAD,	ISZ FACSEC	/BAD LIST OR I/O ERROR: TRY
			/READING NEXT COPY OF LIST.
	ISZ FACSEC	/INCREMENT SECTOR BY 2.
	ISZ TMP1	/DONE 8 TRIES?
	JMP FACRD	/NO, TRY NEXT LIST.
	DCA FAC		/YES, DECLARE LIST BAD.
FACOK,	JMP CC1		/CONTINUE ON NEXT PAGE

	PAGE
			/CONTINUE FROM PREVIOUS PAGE
CC1,	TAD (-100)	/FIND OUT IF DISK IS ALREADY
	DCA TMP1	/FORMATTED: SET FMT=0 IF NO,
	TAD (C+77)	/FMT=7777 IF YES. LAST 100 OCTAL
	DCA AUTO1	/WORDS OF "C" LIST ARE EQUAL TO
			/ID CODE.
	STA		/ASSUME IT IS FORMATTED
	DCA FMT
PFCLP,	TAD I AUTO1	/SCAN ID CODE LIST
	TAD (-ID)
	SZA CLA
	DCA FMT		/FMT=0 IF UNFORMATTED
	ISZ TMP1	/DONE SCAN?
	JMP PFCLP	/NOT YET
	TAD FMT		/YES - TYPE SERIAL NR
	SZA CLA		/AND WHETHER DISK IS ALREADY
	TAD (FRMMSG-UNFMSG)	/FORMATTED
	TAD (UNFMSG)	/OR NOT.
	JMS TYPE
	TAD FAC		/IF FACTORY LISTS ARE BAD,
	SZA CLA		/TYPE A SPECIAL MESSAGE.
	JMP EE1
	TAD (BDFMSG)	/"FACTORY LIST DESTROYED"
	JMS TYPE
	JMP EE2		/AND SKIP AROUND FACTORY BBL
			/PROCESSING.
EE1,	TAD (SERMSG)	/IF FACTORY LISTS ARE GOOD,
			/PRINT PACK SERIAL NUMBER
	JMS TYPE
	TAD (FACTRY+3)	/ADDR OF MSB
	DCA TMP1
	JMS DPSNH	/DIGITS 9-5
	JMS DPSNH	/DIGITS 4-0
	JMS CRLF
	TAD (FACTRY+7)	/CONVERT FACTORY-DETECTED
	DCA AUTO1	/BAD BLOCK LIST FROM FACTORY
	TAD (FACTRY+7)	/FORMAT (DEC STANDARD 144) TO
	DCA AUTO2	/TRACK/SECTOR FORMAT.
	JMS CONV1
	TAD (FACTRY+7)	/CONVERT FACTORY-DETECTED BAD
	DCA AUTO1	/BLOCK LIST FROM TRACK/SECTOR
	TAD (FACTRY+7)	/FORMAT TO 2-WD OS/8 FORMAT.
	DCA AUTO2
	JMS CONV2
	TAD (FACTRY+10)	/PUT FACTORY-DETECTED BAD BLOCK
	JMS ORDER	/LIST INTO ASCENDING ORDER AND
			/DELETE ANY DUPLICATE BLOCKS
			/CAUSED BY BOTH SECTORS BEING
			/BAD.
	JMS REPORT	/TYPE BAD BLOCK LIST
	    FACMSG	/OF FACTORY-DETECTED
	    FACTRY+10	/BAD BLOCKS.
EE2,	TAD FMT		/IS DISK FORMATTED?
	SNA CLA
	JMP AA		/NO - THERE ARE NO OLD OS/8 LISTS
	TAD (OLD-1)	/YES - TRANSFER OLD OS/8 BAD
	DCA AUTO3	/BLOCK LISTS TO "OLD" LIST AND
	TAD (BBCTL-1)	/CONVERT TO 2-WD OS/8 FORMAT.
	DCA AUTO2
BBTRAN,	TAD I AUTO2	/TRANSFER NEXT LIST (A,B,C)
	SNA
	JMP AB		/DONE
	DCA AUTO1	/LIST ADDRESS
	TAD I AUTO2	/DEVICE CODE
	DCA TMP1
BBTRNA,	TAD I AUTO1	/TRANSFER NEXT ENTRY
	SNA		/(0 IS OS/8 TERMINATOR)
	JMP BBTRAN	/TRY NEXT LIST
	DCA TMP2
	TAD TMP1
	DCA I AUTO3	/STORE DEVICE CODE IN "OLD"
	TAD TMP2
	DCA I AUTO3	/STORE BLOCK IN "OLD"
	JMP BBTRNA	/TRY NEXT ENTRY
AB,	STA		/TERMINATE "OLD" LIST
	DCA I AUTO3
	TAD (OLD)	/ORDER "OLD" LIST
	JMS ORDER
	JMS REPORT	/TYPE BAD BLOCK LIST
	    OLDMSG	/OF OLD OS/8 BLOCKS
	    OLD
AA,	TAD (NEW-1)	/CONVERT NEWLY-FOUND BAD
	DCA AUTO1	/BLOCK LIST FROM TRACK/SECTOR
	TAD (NEW-1)	/FORMAT TO 2-WD OS/8 FORMAT.
	DCA AUTO2
	JMS CONV2
	TAD (NEW)	/ORDER "NEW" LIST
	JMS ORDER
	JMS REPORT	/TYPE BAD BLOCK LIST
	    NEWMSG	/OF NEWLY-FOUND
	    NEW		/BAD BLOCKS.
	TAD FMT		/FORMATTED DISK?
	SNA CLA
	JMP AA1		/NO
	TAD (NEW-1)	/YES: FIND OUT IF THERE ARE
	DCA AUTO1	/ANY NEW BAD BLOCKS NOT LISTED
			/IN THE OLD LIST
	JMP AA2		/CONTINUE ON NEXT PAGE

	PAGE
			/CONTINUE FROM PREVIOUS PAGE
AA2,	TAD (OLD-1)	/EXAMINE NEXT ENTRY IN "NEW"
	DCA AUTO2
	TAD I AUTO1
	SPA
	JMP AA1		/NO MORE ENTRIES IN "NEW"
	DCA TMP1	/DEVICE CODE
	TAD I AUTO1
	DCA TMP2	/BLOCK
	SKP
AA3,	ISZ AUTO2	/SKIP REST OF "OLD" ENTRY
AA4,	TAD I AUTO2	/SCAN "OLD" ENTRIES
			/IS THERE ANOTHER ENTRY?
	SPA
	JMP NEWFND	/NO - A NEW ENTRY WAS FOUND
			/WHICH HAD NO CORRESPONDING OLD
			/ENTRY - TYPE WARNING MESSAGE.
	CIA		/YES - DOES IT EQUAL THE NEW
	TAD TMP1	/ENTRY?
	SZA CLA
	JMP AA3		/NO, CONTINUE SCAN
	TAD I AUTO2	/TEST 2ND WORD OF ENTRY
	CIA
	TAD TMP2
	SZA CLA
	JMP AA4		/NO, CONTINUE SCAN
	JMP AA2		/YES - NEW BLOCK APPEARS IN
			/OLD LIST; TRY NEXT NEW ENTRY.

NEWFND,	CLA		/A REALLY NEW BAD BLOCK
	TAD (ADDMSG)	/HAS BEEN FOUND
	JMS TYPE
AA1,	CLA
	TAD FMT		/IS DISK UNFORMATTED AND ALSO
			/WITHOUT A VALID FACTORY BBL?
	TAD FAC
	SNA CLA
	JMP EE3		/YES TO BOTH - SKIP MERGE PRO-
			/CEDURE SO THAT "NEW" WILL CON-
			/SIST ONLY OF NEWLY-FOUND BAD
			/BLOCKS.
	TAD FMT		/IS DISK FORMATTED?
	SNA CLA
	TAD (FACTRY+7-OLD+1)	/NO: MERGE FACTORY-
			/DETECTED BAD BLOCK LIST
			/INTO NEWLY-FOUND BAD BLOCK
			/LIST
	TAD (OLD-1)	/YES: MERGE OLD OS/8 BAD
			/BLOCKS INTO NEW LIST
	DCA AUTO1
	TAD (NEW-1)
	DCA AUTO2
AB1,	TAD I AUTO2	/FIND END OF "NEW" LIST
	SPA CLA
	JMP AB2		/FOUND END
	ISZ AUTO2	/NOT YET
	JMP AB1
AB2,	STA		/FOUND END; BACKUP POINTER
	TAD AUTO2	/TO POINT TO JUST BEFORE
	DCA AUTO2	/END OF "NEW" LIST
AB4,	TAD I AUTO1	/GET NEXT INPUT ENTRY
	SPA
	JMP AB3		/NO MORE ENTRIES TO MERGE
	DCA I AUTO2	/TACK INPUT ONTO END OF
	TAD I AUTO1	/"NEW" LIST
	DCA I AUTO2
	JMP AB4		/TRANSFER NEXT ENTRY
AB3,	DCA I AUTO2	/DONE MERGE; TERMINATE "NEW"
EE3,	TAD (NEW)	/ORDER "NEW" AND DELETE
	JMS ORDER	/DUPLICATE ENTRIES IF ANY.
	JMS REPORT	/TYPE BAD BLOCK LIST
	    FINMSG	/OF OS/8 BAD BLOCKS ABOUT
	    NEW		/TO BE WRITTEN OUT.
	TAD (AANDB-1)	/NEW LIST IS NOW COMPLETE.
			/PREPARE OS/8 LISTS FOR
			/WRITING ONTO DISK.
			/ZERO EACH LIST
	JMS ZERO
	TAD (C-1)
	JMS ZERO
	TAD (ID)	/STORE ID CODES IN PROPER
	DCA AANDB	/PLACES.
	TAD (ID)
	DCA C
	TAD (C+77)
	DCA AUTO1
	TAD (-100)
	DCA TMP1
	TAD (ID)
	DCA I AUTO1
	ISZ TMP1
	JMP .-3
	TAD (NEW)	/TRANSFER NEW LIST TO PROPER
	DCA TMP3	/OS/8 LISTS PRIOR TO WRITING.
	TAD (BBCTL-1)
	DCA AUTO2
	JMP AD1A	/TRANSFER FIRST LIST (A)
AD1,	CLA		/TRANSFER NEXT LIST (B,C)
	DCA I AUTO3	/TERMINATE LAST LIST (A,B,C)
AD1A,	TAD I AUTO2
	SNA
	JMP ASK		/DONE TRANSFER
	DCA AUTO3	/OS/8 LIST ADDRESS
	TAD I AUTO2
	DCA TMP1	/DEVICE CODE
	TAD (-20)
	DCA TMP2	/COUNTER - ONLY 15 BAD BLOCKS
			/ARE ALLOWED PER DEVICE.
	SKP		/TRANSFER EACH ENTRY, THIS DEV.
AD2,	ISZ TMP3	/LOCATE TO NEXT ENTRY IN "NEW".
	TAD I TMP3	/GET DEV CODE - IS NEW ENTRY
			/SAME DEVICE AS
			/CURRENT OS/8 LIST BEING FILLED?
	SPA
	JMP AD1		/NO MORE ENTRIES IN "NEW"
	CIA		/COMPARE DEVICES
	TAD TMP1
	SZA CLA
	JMP AD1		/DIFFERENT DEVICE; TRANSFER TO
			/NEXT OS/8 LIST.
	JMP AD4		/SAME DEVICE.
			/CONTINUE ON NEXT PAGE

	PAGE
			/CONTINUE FROM PREVIOUS PAGE
AD4,	ISZ TMP3	/LOCATE TO BLOCK NR.
	TAD TMP1	/CHECK TO SEE IF BAD BLOCK IS
			/IN THE RANGE 0-66 OCTAL ON
	SZA CLA		/DEVICE A; IF SO, WARN USER NOT
	JMP AD3		/TO USE AS SYSTEM DEVICE.
	TAD I TMP3
	STL CIA		/13-BIT NEGATE
	TAD (66)	/13-BIT COMPARE
	SZL CLA		/IS BLOCK LE 66?
	JMP AD3		/NO, IT'S OK
	TAD (ZERMSG)	/YES, WARN USER
	JMS TYPE
AD3,	TAD I TMP3	/IGNORE ANY BLOCK ZERO (BLOCK
			/ZERO CANNOT BE REPRESENTED IN
			/OS/8 BAD BLOCK LISTS.)
	SNA
	JMP AD2		/IGNORE ZERO BLOCK
	DCA I AUTO3	/STORE IN OS/8 LIST A,B, OR C
			/(NON-ZERO BLOCK NR)
	ISZ TMP2	/16 BAD BLOCKS, THIS DEVICE?
	JMP AD2		/NO, TRANSFER NEXT ENTRY
	TAD (OVFMSG)	/YES, WARN USER AND QUIT
	JMP ERROR
ASK,	TAD (FMTMSG)	/WAIT FOR USER TO VERIFY
			/GOING AHEAD AND WRITING
			/OUT OS/8 BAD BLOCK LISTS.
			/"FORMAT DISK PACK?"
	JMS TYPE
	JMS GETKEY	/WAIT FOR KEY
	DCA TMP1
	JMS GETKEY	/WAIT FOR RETURN
	TAD (-15)
	SZA CLA
	JMP ASK
	JMS CRLF
	TAD TMP1
	ZZ="Y&177
	TAD (-ZZ)	/TEST FOR "Y" (YES)
	SZA CLA
	JMP RE
	RLDC		/GO-AHEAD RECEIVED: CHECK FOR WRITE-LOCK.
			/CLEAR CONTROLLER.
	TAD (BYTE RLST)
	JMS IO		/DO "GET STATUS" COMMAND.
	    JMP FATAL	/ERROR: CANNOT HAPPEN.
	RRSI		/IGNORE BYTE #1.
	RRSI		/GET BYTE #2.
	BSW		/BIT [40] IS WRITE-LOCK BIT.
	SPA CLA		/IS WRITE-LOCK ENABLED?
	JMS REMOVE	/YES: ASK USER TO DISABLE.
	JMS RL01	/NO: DO ACTUAL FORMATTING.
			/ACTUAL FORMATTING: WRITE
			/OUT ALL OS/8 BAD BLOCK
			/LISTS. CALL INTERNAL HANDLER
			/FOR EACH LIST WRITTEN.
	    RLWR	/FUNCTION=WRITE
	    AANDB	/A AND B LISTS
	    0		/TRACK=0
	    14		/SECTOR=14
	    JMP FATAL	/ERROR RETURN
	JMS RL01
	    RLWR	/FUNCTION=WRITE
	    C		/C LIST
	    0		/TRACK=0
	    16		/SECTOR=16
	    JMP FATAL	/ERROR RETURN
	TAD (DNMSG)	/TYPE "DONE"
	JMS TYPE
	JMP RE		/AND ASK FOR NEXT PACK.



/SUBROUTINE TO ASK USER TO DISABLE WRITE-LOCK
REMOVE,	0
REMOV1,	TAD (WRMSG)
	JMS TYPE
	JMS GETKEY
	TAD (-15)	/WAIT FOR RETURN.
	SZA CLA
	JMP REMOV1	/IGNORE ANY OTHER KEY.
	JMP I REMOVE
/CONVERSION SUBROUTINES

/SUBROUTINE TO CONVERT FROM FACTORY FORMAT (DEC STANDARD 144)
/TO TRACK/SECTOR FORMAT
/INPUT:	AUTO1=INPUT LIST-1
/	AUTO2=OUTPUT LIST-1
CONV1,	0
CONV1A,	TAD I AUTO1	/CYLINDER BYTE
	AND (377)	/HARDWARE SHOULD DO THIS!
	DCA TMP1
	TAD I AUTO1	/DOUBLE DENSITY BIT
	AND (377)	/HARDWARE SHOULD DO THIS!
	CLA		/IGNORE
	TAD I AUTO1	/SECTOR BYTE
	AND (377)	/HARDWARE SHOULD DO THIS!
	DCA TMP2
	TAD I AUTO1	/SURFACE BIT
	AND (377)	/HARDWARE SHOULD DO THIS!
	CLL RAR
	SZA CLA		/TEST FOR END OF LIST
	JMP CONV1B	/DONE
	TAD TMP1	/CONSTRUCT TRACK
	RAL
	DCA I AUTO2	/STORE TRACK
	TAD TMP2
	AND (77)
	DCA I AUTO2	/STORE SECTOR
	JMP CONV1
CONV1B,	STA		/TERMINATE OUTPUT LIST
	DCA I AUTO2
	JMP I CONV1

	PAGE
/SUBROUTINE TO CONVERT FROM TRACK/SECTOR FORMAT
/TO 2-WD OS/8 FORMAT
/INPUT:	AUTO1=INPUT LIST-1
/	AUTO2=OUTPUT LIST-1
CONV2,	0
CONV2C,	TAD I AUTO1
	DCA TMP1	/TRACK
	TAD I AUTO1
	DCA TMP2	/SECTOR
	TAD TMP1	/TEST FOR END OF LIST
	SPA CLA
	JMP CONV2D	/DONE
	TAD TMP2	/TEST FOR DEVICE C
	CLL RAR
	SZL
	JMP CONV2A	/MUST BE A OR B
	TAD (-10)
	SMA CLA
	JMP CONV2A	/MUST BE A OR B
	TAD TMP1	/MUST BE C; TEST FOR ILLEGAL
			/BAD BLOCKS.
	SNA CLA
	JMP CONV2C	/ILLEGAL: TRACK 0; IGNORE
	TAD (-777)
	SNA CLA
	JMP CONV2C	/ILLEGAL: TRACK 777; IGNORE
	TAD TMP2	/CONVERT DEVICE C BLOCK
	CLL RTR
	DCA TMP2	/BITS [3] SO FAR
	TAD TMP1
	AC0002
	DCA I AUTO2	/STORE DEVICE CODE FOR C
	STA
	TAD TMP1
	CLL RTL		/BITS [3774]
	TAD TMP2	/BITS [3777]
CONV2B,	DCA I AUTO2	/STORE BLOCK NUMBER
	JMP CONV2C	/CONVERT NEXT ENTRY
CONV2A,	CLA		/PROCESS DEVICES A AND B
	TAD TMP2	/CONVERT BLOCK NR
	CLL RAR
	SZL
	TAD (24)
	TAD (-10)
	CLL RAR
	DCA TMP2	/BITS [17] SO FAR
	TAD TMP1
	CLL RTL
	RTL		/LINK=DEVICE NR (A=0, B=1)
			/BITS [7760]
	TAD TMP2	/BITS [7777]
	DCA TMP1
	RAL		/GET DEVICE CODE
	DCA I AUTO2	/STORE DEVICE CODE FOR A OR B
	TAD TMP1
	JMP CONV2B	/STORE BLOCK NR

CONV2D,	STA		/TERMINATE OUTPUT LIST
	DCA I AUTO2
	JMP I CONV2

/SUBROUTINE TO ZERO A PAGE CONTAINING AN OS/8 BAD
/BLOCK LIST
/INPUT:	AC=ADDRESS OF LIST-1
ZERO,	0
	DCA AUTO1
	TAD (-200)
	DCA TMP1
	DCA I AUTO1
	ISZ TMP1
	JMP .-2
	JMP I ZERO

/SUBROUTINE TO ORDER A 2-WD OS/8 BAD BLOCK LIST AND
/DELETE DUPLICATE ENTRIES IF ANY
/INPUT:	AC=ADDRESS OF LIST
ORDER,	0
	DCA TMP1
	AC7776
	TAD TMP1
	DCA TMP2	/FOR EACH TMP2, ALL TMP3 WILL
			/BE COMPARED TO DETERMINE
			/MINIMUM VALUE
ORDERA,	AC0002		/FIND MINIMUM OF REMAINING
			/ENTRIES IN LIST
	TAD TMP2
	DCA TMP2
	TAD I TMP2
	SPA CLA
	JMP DD		/DONE; DELETE DUPLICATES
	TAD TMP2	/START WITH CURRENT ENTRY
	DCA TMP3	/AND COMPARE WITH REST
ORDERB,	AC0002		/COMPARE WITH NEXT ENTRY
	TAD TMP3
	DCA TMP3
	TAD I TMP3
	SPA CLA
	JMP ORDERA	/NO MORE REMAINING ENTRIES;
			/ORDER NEXT ENTRY
	TAD I TMP3	/COMPARE DEVICE CODES
	CIA		/12-BIT COMPARE
	TAD I TMP2
	SPA SNA
	JMP ORDERD	/COMPARE 2ND WORD
ORDERC,	CLA		/DISORDERED; INTERCHANGE ENTRIES
	TAD TMP2
	DCA TMP4
	TAD TMP3
	DCA TMP5
	JMS EXCH
	ISZ TMP4
	ISZ TMP5
	JMS EXCH
	JMP ORDERB	/CONTINUE COMPARING TO FIND
			/MINIMUM ENTRY

/RETURN FROM "ORDER"
DD2,	DCA I TMP2	/STORE TERMINATOR
	JMP I ORDER	/AND RETURN

/SUBROUTINE TO INTERCHANGE TWO ENTRIES
EXCH,	0
	TAD I TMP4
	DCA TMP6
	TAD I TMP5
	DCA I TMP4
	TAD TMP6
	DCA I TMP5
	JMP I EXCH

	PAGE
/CONTINUATION OF ORDERING SUBROUTINE
ORDERD,	SZA CLA		/COMPARE DEVICE CODES
	JMP ORDERB	/ALREADY ORDERED OK
	TAD TMP2	/PREPARE TO COMPARE 2ND WORD
	DCA AUTO2	/(BLOCK NR)
	TAD TMP3
	DCA AUTO3
	TAD I AUTO3
	STL CIA		/13-BIT NEGATE
	TAD I AUTO2	/13-BIT COMPARE
	SNL SZA
	JMP ORDERC	/DISORDERED; INTERCHANGE
	SZA CLA
	JMP ORDERB	/ALREADY ORDERED OK
	AC2000		/DEVICE CODE AND BLOCK NR
			/BOTH EQUAL: A DUPLICATE ENTRY!
			/SET EARLIER COPY TO SPECIAL
			/VALUE (2000); LATER IT WILL
			/BE DELETED FROM LIST.
	DCA I TMP2
	JMP ORDERA	/CONSIDER IT ORDERED AND
			/ORDER NEXT ENTRY.
DD,	TAD TMP1	/LIST IS NOW ORDERED. SCAN
			/LIST, COMPRESSING OUT ANY
			/"2000" VALUES (DUPLICATE
			/ENTRIES).
			/INITIAL OUTPUT IS INPUT
	DCA TMP2
DD1,	TAD I TMP1	/SCAN NEXT ENTRY
	SPA
	JMP DD2		/DONE
	TAD (-2000)	/TEST FOR DUPLICATE
	SZA CLA
	JMP DD3		/NO - COPY OVER
	ISZ TMP1	/YES - IGNORE IT
	ISZ TMP1
	JMP DD1
DD3,	TAD I TMP1	/COPY OVER INPUT TO OUTPUT
	DCA I TMP2	/TO COMPRESS LIST.
	ISZ TMP1
	ISZ TMP2
	TAD I TMP1
	DCA I TMP2
	ISZ TMP1
	ISZ TMP2
	JMP DD1		/SCAN NEXT ENTRY
/SUBROUTINE TO REPORT (TYPE) A BAD BLOCK LIST
REPORT,	0
	TAD (-4-1)	/MAX ENTRIES ON FIRST LINE
	DCA TMP2
	TAD I REPORT	/ADDR OF HEADING MESSAGE
	JMS TYPE
	TAD (BBMSG)	/"BAD BLOCKS:"
	JMS TYPE
	ISZ REPORT
	TAD I REPORT	/ADDRESS OF LIST
	DCA TMP1
	ISZ REPORT
	TAD I TMP1	/IS LIST NULL?
	SMA CLA
	JMP REP2	/NO
	TAD (NNMSG)	/YES - TYPE "NONE"
	JMS TYPE
REP3,	JMS CRLF	/DONE
	JMP I REPORT
REP2,	TAD I TMP1	/TYPE NEXT ENTRY
	SPA CLA
	JMP REP3	/NONE - DONE
	ISZ TMP2	/IS OUTPUT LINE FILLED?
	JMP REP4	/NO
	TAD (-10)	/YES, PRINT CRLF
			/MAX ENTRIES ON SUCCEEDING LINES
	DCA TMP2
	JMS CRLF
REP4,	TAD I TMP1	/VALID ENTRY: TYPE IT
	TAD ("A)	/CONVERT DEVICE CODE TO
			/DEVICE LETTER AND TYPE IT.
	JMS PRINT	/"A","B","C"
	JMS PRINTB	/SPACE
	ISZ TMP1
	TAD I TMP1	/BLOCK NR
	JMS PRINTN	/PRINT AS OCTAL NR
	JMS PRINTB	/2 SPACES
	JMS PRINTB
	ISZ TMP1	/NEXT ENTRY
	JMP REP2	/TYPE NEXT ENTRY
/SUBROUTINE TO PRINT 5 DIGITS OF SERIAL NUMBER
DPSNH,	0
	TAD I TMP1
	RAR
	JMS DPSNT	/DIGITS 9-8, 4-3
	TAD I TMP1
	RAR		/LINK=MSB OF DIGIT 7 OR 2
	STA CML		/BACKUP BYTE POINTER AND
			/CORRECT LINK FOR OVERFLOW.
	TAD TMP1
	DCA TMP1
	RTL		/LINK TO BIT [4].
	RAL
	DCA TMP2
	TAD I TMP1
	BSW
	AND (3)		/BITS [3].
	TAD TMP2	/BITS [7].
	JMS DPSND	/DIGIT 7, 2
	TAD I TMP1
	JMS DPSNT	/DIGITS 6-5, 1-0
	STA
	TAD TMP1
	DCA TMP1
	JMP I DPSNH

/SUBROUTINE TO PRINT 2 DIGITS OF SERIAL NUMBER
DPSNT,	0
	DCA TMP2
	TAD TMP2
	RTR
	RAR
	JMS DPSND	/2ND SIG. DIGIT
	TAD TMP2
	JMS DPSND	/1ST SIG. DIGIT
	JMP I DPSNT

/SUBROUTINE TO PRINT OCTAL DIGIT
DPSND,	0
	AND (7)
	TAD ("0)
	JMS PRINT
	JMP I DPSND

	PAGE
/FATAL I/O ERROR ROUTINE
FATAL,	TAD (FAMSG)
	JMP ERROR	/"FATAL I/O ERROR" AND QUIT.

/SUBROUTINE TO READ-CHECK EVEN OR ODD SECTORS
/ON ONE TRACK
RCSUB,	0
	DCA RCSECT
	TAD (-24)	/NUMBER OF SECTORS
	DCA TMP1
RCLOOP,	JMS RL01	/PERFORM READ
	RLRD
	X		/MA (DON'T CARE)
RCTRK,	0		/TRACK
RCSECT,	0		/SECTOR
	JMS RCBAD	/ERROR RETURN: ADD BLOCK
			/TO "NEW" BAD BLOCK LIST
	ISZ RCSECT	/NORMAL RETURN: INCREMENT
	ISZ RCSECT	/SECTOR
	ISZ TMP1
	JMP RCLOOP
	JMP I RCSUB	/DONE

/SAVE TRACK/SECTOR OF NEWLY-FOUND BAD BLOCK
RCBAD,	0
	TAD RCTRK
	DCA I AUTO3
	TAD RCSECT
	DCA I AUTO3
	ISZ BADCNT	/ONLY ALLOW 64
	JMP I RCBAD
	TAD (TOOMSG)	/OVER 63 BAD BLOCKS
ERROR,	JMS TYPE	/SEVERE ERROR ENTRY POINT
	TAD (ERRMSG)	/"CANNOT FORMAT DISK"
	JMS TYPE
	JMP RE		/RESTART ("DRIVE?")
BADCNT,	0
/TERMINAL SUPPORT SUBROUTINES

/FUNCTIONS:
/TYPE	TYPE A STRING WHOSE ADDR IS IN AC (UNDERLINE
/	MEANS CRLF, 00 TERMINATES).
/GETKEY	WAIT FOR A KEY, GET AND ECHO THE 7-BIT ASCII VALUE.
/PRINT	PRINT ASCII CHAR.
/PRINTN	PRINT OCTAL CONTENTS OF AC.
/CRLF	PRINT RETURN/LINE FEED COMBINATION.
/PRINTB	PRINT A BLANK CHAR.

/INTERESTING LOCATIONS:
/TEMP	TEMP STORAGE
/KEY	LAST KEY TYPED

TYPE,	0
	DCA TEMP
	CLL
TY1,	TAD I TEMP
	SNL
	BSW
	AND (77)
	SNA
	JMP I TYPE
	TAD (-37)	/TEST FOR UNDERLINE CHAR
	SZA
	JMP TY2
	JMS CRLF
	JMP TY3
TY2,	TAD (277)
	AND (277)
	TAD (240)
	JMS PRINT
TY3,	SNL CLA
	ISZ TEMP
	JMP TY1

GETKEY,	0
	KSF
	JMP .-1
	JMS LOOK
	JMS PRINT
	TAD KEY
	JMP I GETKEY

LOOK,	0
	KRB
	AND (177)
	DCA KEY
	TAD KEY
	TAD (-3)
	SNA CLA
	JMP I (7605)
	TAD KEY
	JMP I LOOK

PRINTN,	0
	DCA 0
	TAD (-4)
	DCA TEMP
PR1,	TAD 0
	RTL; RAL
	DCA 0
	TAD 0
	RAL
	AND (7)
	TAD (260)
	JMS PRINT
	ISZ TEMP
	JMP PR1
	JMP I PRINTN

PRINT,	0
	TLS
	TSF
	JMP .-1
	CLA
	KSF
	JMP I PRINT
	JMS LOOK
	CLA
	JMP I PRINT

CRLF,	0
	TAD (215)
	JMS PRINT
	TAD (212)
	JMS PRINT
	JMP I CRLF

PRINTB,	0
	TAD (240)
	JMS PRINT
	JMP I PRINTB

/LITERALS
	PAGE
/SUBROUTINE TO TRANSFER DATA TO/FROM RL01 DISK
/NOTE: ONLY ONE TRY IS ATTEMPTED!
RL01,	0
	TAD I RL01	/GET ARGUMENTS: FUNCTION
	DCA FNC
	ISZ RL01
	TAD I RL01	/MA
	DCA MA
	ISZ RL01
	TAD I RL01	/TRACK
	DCA TRACK
	ISZ RL01
	TAD I RL01	/SECTOR
	BSW		/CONVERT TO RL8A FORMAT
	DCA SECTOR
	ISZ RL01
	TAD TRACK	/CALCULATE CYLINDER AND
	CLL RAR		/SURFACE FROM TRACK
	DCA CYL
	RTR
	DCA SURF
	JMS TRKCMP	/COMPARE WITH CURRENT
			/TRACK; IF SAME, DO THE
			/TRANSFER
RETRY,	RLDC		/IF DIFFERENT, SEEK TO
			/REQUESTED TRACK
			/CLEAR CONTROLLER, AC
SEEK,	IAC		/SEEK WHEN CALLED FROM
			/BELOW, ELSE RESET DRIVE
			/REGISTERS (AC=1 TO RESET,
			/AC=3 TO SEEK)
	JMS IO		/RESET DRIVE OR SEEK
	JMP RETRY	/ERROR RETURN
	TAD (BYTE RLRH)	/NORMAL RETURN:
			/READ NEXT HEADER TO FIND
			/CURRENT TRACK
	JMS IO
	JMP RETRY	/ERROR RETURN
	RRSI		/NORMAL RETURN:
			/GET HEADER BYTE #1
	BSW
	AND (3)
	DCA CURTRK	/SAVE 2 LSB
	RRSI		/GET HEADER BYTE #2
	AND (377)	/HARDWARE SHOULD DO THIS
	CLL RTL
	TAD CURTRK	/ADD IN MSB
	DCA CURTRK
	JMS TRKCMP	/COMPARE WITH CURRENT
			/TRACK; IF SAME, DO THE
			/TRANSFER
	TAD CURTRK	/OFF TRACK: SEEK TO TRACK.
	CLL RAR		/CONSTRUCT DIFFERENCE WORD FOR SEEK.
	CIA
	TAD CYL
	SMA
	JMP AROUND
	CIA
	SKP
AROUND,	TAD (4000)	/SET DIRECTION BIT IF TO HIGHER
			/CYLINDER ADDRESS.
	TAD SURF	/ADD SURFACE BIT
	RLCA		/LOAD DIFFERENCE WORD
	AC0002		/PREPARE FOR SEEK
	JMP SEEK	/LOOP BACK AND SEEK; THIS
			/ENSURES THAT THE TRACK REACHED
			/IS THE CORRECT ONE IN SPITE
			/OF POSSIBLE RL01 SEEK
			/UNRELIABILITY
/SUBROUTINE TO COMPARE REQUESTED TRACK WITH CURRENT
/(REMEMBERED) TRACK; IF SAME, DO TRANSFER.  IF DIFFERENT,
/RETURN WITH AC=REQUESTED-CURRENT, LINK=1
TRKCMP,	0
	TAD CURTRK
	CIA
	TAD TRACK
	SZA CLA
	JMP I TRKCMP	/DIFFERENT; RETURN
	TAD SECTOR	/SAME: DO TRANSFER
			/LOAD ALL REGISTERS
	RLSA
	TAD FNC		/WC IS DOUBLED FOR BYTE MODE
	AND (BYTE)
	SZA CLA
	TAD (-200)	/2 PAGES
	TAD (-200)	/1 PAGE
	RLWC
	TAD SURF	/HARDWARE SHOULD DO THIS
	TAD CYL
	RLCA
	TAD MA
	RLMA
	TAD FNC
	JMS IO		/READ OR WRITE ONE SECTOR
	JMP I RL01	/ERROR: TAKE ERROR RETURN
	ISZ RL01	/TAKE NORMAL EXIT
	JMP I RL01
/SUBROUTINE TO DO RL01 I/O
IO,	0
	TAD DRIVE
	RLCB		/DO I/O OPERATION
WAIT,	CLA		/IN CASE NO RL01 PRESENT
	KSF		/WAIT UNTIL DONE
			/RETURN TO MONITOR IF
			/USER TYPES CTRL,C
	JMP WAIT2
	TAD (7600)
	KRS
	TAD (-7603)
	SNA CLA
	JMP I (MON)
WAIT2,	RLSD
	JMP WAIT
	RLSE
	ISZ IO		/NORMAL RETURN
	JMP I IO	/ERROR RETURN
/DATA
TRACK,	0		/REQUESTED TRACK
CURTRK,	2000		/CURRENT TRACK (INITIALLY
			/ILLEGAL TO FORCE HEADER
			/READ AND SEEK IF NECESSARY)
SECTOR,	0
CYL,	0
SURF,	0
FNC,	0
MA,	0

	PAGE
/TEXT STRINGS

IDMSG,	TEXT "RLFRMT V??_"
	*.-2
	VERSION+60^100+PATCH
	*.+2
MSG,	TEXT "_DRIVE ? "
BDMSG,	TEXT "_PLEASE SPECIFY DRIVE NUMBER (0-3) ON WHICH_"
	*.-1
	TEXT "PACK TO BE FORMATTED IS MOUNTED._"
FAMSG,	TEXT "_FATAL I/O ERROR"
SERMSG,	TEXT " DISK PACK SERIAL NUMBER "
TOOMSG,	TEXT "_OVER 63 NEWLY-FOUND BAD BLOCKS"
ERRMSG,	TEXT "_CANNOT FORMAT DISK_"
ADDMSG,	TEXT "_WARNING: AN ADDITIONAL BAD BLOCK FOUND."
	*.-1
	TEXT "_ZERO DISK BEFORE USE!_"
OVFMSG,	TEXT "_OVER 15 BAD BLOCKS ON ONE DEVICE"
ZERMSG,	TEXT "_WARNING: BAD BLOCK IN SYSTEM AREA._DO NOT USE AS SYSTEM DISK!_"
UNFMSG,	TEXT "_UNFORMATTED (NEW)"
FRMMSG,	TEXT "_OS/8 (OLD)"
BDFMSG,	TEXT " DISK._WARNING: ALL FACTORY-WRITTEN LISTS DESTROYED._"
FACMSG,	TEXT "_FACTORY-DETECTED"
OLDMSG,	TEXT "_PREVIOUS OS/8"
NEWMSG,	TEXT "_NEWLY-FOUND"
FINMSG,	TEXT "_NEW OS/8"
BBMSG,	TEXT " BAD BLOCKS: "
NNMSG,	TEXT "NONE"
FMTMSG,	TEXT "_FORMAT PACK WITH THIS NEW LIST? "
DNMSG,	TEXT "_DONE_"
WRMSG,	TEXT "_PLEASE WRITE-ENABLE DRIVE, THEN HIT 'RETURN'._"

/OTHER DATA
BBCTL,	AANDB		/OS/8 BAD BLOCK CONTROL LIST
			/LIST ADDRESS
	0		/DEVICE CODE
	AANDB+20	/LIST ADDRESS
	1		/DEVICE CODE
	C		/LIST ADDRESS
	2		/DEVICE CODE
	0		/TERMINATOR

FACCTL,	FACTRY+3	/CONTROL LIST TO CHECK VALIDITY
			/OF FACTORY-WRITTEN BBLS.
			/POINTER BEFORE 4 BYTES TO TEST.
	0		/VALUE TO TEST FOR.
	FACTRY+373	/POINTER.
	377		/VALUE.
	0		/TERMINATOR.

$

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RLSY.PA. 
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

/RLSY: RL01 SYSTEM HANDLER
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/RL01 SYSTEM HANDLER

	VERSION="A&77

/NOTES:
/1. PRE-OMNIBUS COMPUTERS NOT SUPPORTED.

/EDIT HISTORY:
/21-OCT-77 DAVID SPECTOR: CREATION

/INSTRUCTIONS THAT GENERATE CONSTANTS

AC0001=CLA IAC
AC0002=CLA CLL CML RTL
AC0003=CLA CLL CML IAC RAL	/*
AC0004=CLA CLL IAC RTL		/*
AC0006=CLA CLL CML IAC RTL	/*
AC0100=CLA IAC BSW		/*
AC2000=CLA CLL CML RTR
AC3777=CLA CLL CMA RAR
AC4000=CLA CLL CML RAR
AC5777=CLA CLL CMA RTR
AC6000=CLA CLL CML IAC RTR	/*
AC7775=CLA CLL CMA RTL
AC7776=CLA CLL CMA RAL

/* USE ONLY ON VT-78 AND PDP-8E,F,M,A

/ID CODE AT START OF BAD BLOCK LIST (BBL)
	ID=123
/RL01 DEFINITIONS

RLIOT=6600
RLDC=RLIOT 0	/CLEAR DEVICE
RLSD=RLIOT 1	/SKIP IF DONE
RLMA=RLIOT 2	/LOAD MEM ADDR
RLCA=RLIOT 3	/LOAD REGISTER "A"
RLCB=RLIOT 4	/LOAD REG "B" AND EXECUTE
RLSA=RLIOT 5	/LOAD SECTOR ADDR
		/RLIOT 6 UNUSED
RLWC=RLIOT 7	/LOAD WORD COUNT
RRER=RLIOT 10	/READ ERROR REG
RRWC=RLIOT 11	/READ WORD COUNT
RRCA=RLIOT 12	/READ REG "A"
RRCB=RLIOT 13	/READ REG "B"
RRSA=RLIOT 14	/READ SECTOR ADDR
RRSI=RLIOT 15	/READ SILO BYTE
		/RLIOT 16 UNUSED
RLSE=RLIOT 17	/SKIP IF ERROR
/RLCB FUNCTION BITS:
	RLMT=0	/MAINTENANCE MODE
	RLRE=1	/RESET DRIVE ERRORS
	RLST=2	/READ STATUS REGS INTO SILO
	RLSK=3	/SEEK
	RLRH=4	/READ HEADER
	RLWR=5	/WRITE
	RLRD=6	/READ
	RLRN=7	/READ WITH NO HEADER CHECK
/BIT DEFINITIONS IN REGISTERS:
BYTE=1000	/BYTE TRANSFER MODE
/HEADER BLOCK FOR USE BY "BUILD"

	*0
	-2		/- NR. OF ENTRY POINTS

/FORMAT OF ENTRIES IN HEADER BLOCK:
/WORD	DESCRIPTION
/1	GROUP NAME (4 CHAR)
/3	DEVICE NAME (4 CHAR)
/5	DCB WORD FOR AN RL (TYPE 26) DIRECTORY DEVICE,
/	NO MULTIPLE PLATTERS
/6	2-PAGE/SYS/CORESIDENT INDICATOR, OFFSET
/7	0 (UNUSED WORD)
/10	NUMBER OF BLOCKS IN DEVICE

DEVICE RLSY;DEVICE SYS;4260;SYS&177+6000;0;7761
DEVICE RLSY;DEVICE RL0A;4260;SYS&177+5000;0;7761
/DEVICE RLSY;DEVICE RL0B;4260;RL0B&177+5000;0;7761
/RL01 SECONDARY BOOTSTRAP

/SYSTEM MAP:
/BLOCK	CYL.	SURF.	SECTOR	CONTENTS
/0	0	0	20	SECONDARY BOOTSTRAP
/0	0	0	22	FIELD 0 RESIDENT
/66	1	1	1	FIELD 1 RESIDENT
/66	1	1	3	FIELD 2 RESIDENT

/RESIDENT MONITOR CODE OCCUPIES LAST PAGE OF FIELD
/FIELD 0 PAGE IS MONITOR CODE AND SYSTEM HANDLER
/FIELD 1 PAGE IS MONITOR TABLES
/FIELD 2 PAGE IS SYSTEM HANDLER

	BOOTA-BOOTB	/-LENGTH FOR "BUILD"

	RELOC 0		/WILL RUN AT 00000

BOOTA,			/START OF BOOTSTRAP CODE

/DATA
C16,	16
C26,	26
C300,	300
C2001,	2001
C6001,	6001
C7600,	7600
C7605,	7605
SECT,	2200		/INITIAL BLOCK 0 VALUE
SURCYL,	0		/INITIAL BLOCK 0 VALUE

	ZBLOCK 31-2-.	/LOCATE "IOSUB" (SEE BELOW)

FUNC,			/TEMPORARY STORAGE FOR RL01
			/FUNCTION WORD
IOSUB,	BOOT		/SUBROUTINE TO DO I/O; MATCHES
			/SIMILAR SUBR IN PRIMARY BOOTSTRAP
			/INITIAL VALUE WILL START SEC-
			/ONDARY BOOTSTRAP WHEN IT HAS BEEN
			/COMPLETELY READ IN.
	RLCB		/EXECUTE RL01 FUNCTION
	RLSD		/WAIT UNTIL DONE. NOTE: THIS WORD
			/AND THE NEXT ONE MUST BE IN THE
			/SAME LOCATIONS AS THEIR COUNTER-
			/PARTS IN THE PRIMARY BOOTSTRAP.
	JMP .-1
	RLSE
	JMP I IOSUB	/NO ERRORS: RETURN
	JMP .		/ERROR OCCURRED: LOOP IN PLACE AS
			/A CLEAR INDICATION THAT BOOTSTRAP
			/OPERATION FAILED.

/START OF SECONDARY BOOTSTRAP OPERATIONS
BOOT,	AC0006		/AC=READ FUNCTION
	JMS READ	/READ FIELD 0 RESIDENT
	RLDC		/CLEAR CONTROLLER REGISTERS IN
			/PREPARATION FOR SEEK
	TAD C6001	/DIFFERENCE WORD FOR CYL 1 SURF 1
	RLCA		/LOAD "A"
	AC0003		/AC=SEEK FUNCTION
	JMS IOSUB	/SEEK
	AC0100		/AC=SECTOR 1
	DCA SECT
	TAD C2001	/AC=CYL 1 SURF 1
	DCA SURCYL
	TAD C16		/AC=READ FUNCTION
	JMS READ	/READ FIELD 1 RESIDENT
	TAD C300	/AC=SECTOR 3
	DCA SECT
	TAD C26		/AC=READ FUNCTION
	JMS READ	/READ FIELD 2 RESIDENT
	CDF 00		/JUST IN CASE
	JMP I C7605	/START KEYBOARD MONITOR

/SUBROUTINE TO READ ONE SECTOR INTO ONE PAGE
READ,	0
	DCA FUNC	/SAVE FUNCTION WORD
	TAD SECT
	RLSA		/LOAD SECTOR ADDRESS
	TAD C7600
	RLWC		/LOAD WORD COUNT
	TAD SURCYL
	RLCA		/LOAD REGISTER "A"
	TAD C7600
	RLMA		/LOAD MA (ALL READS ARE INTO
			/LAST PAGE OF FIELDS)
	TAD FUNC	/RETRIEVE FUNCTION WORD
	JMS IOSUB	/DO THE READ
	JMP I READ	/NO ERROR: RETURN

BOOTB,			/END OF BOOTSTRAP CODE

	RELOC
/RL01 SYSTEM HANDLER CODE

	*200
	RELOC 7600

	ZBLOCK 7	/REQUIRED BY BUILD

/ENTRY POINT FOR SYS
SYS,	VERSION
	CLA
SWITCH,	JMP START	/CHANGED TO "JMP SET"
			/BY ONCE-ONLY CODE AT "START"
	3		/THIS IS A FLAG TO OS/8 THAT
			/THIS IS A 2-PAGE HANDLER.

/----- BAD BLOCK LIST (BBL) STARTS HERE
/      AND CONTINUES FOR 21 OCTAL LOCATIONS

BBL,

/ONCE-ONLY DATA
JMPSET,	JMP SET
COUNT,	-10
ADDR,	BARG
ABRTN,	BRTN
ACDIF,	CIF CDF 00

/ONCE-ONLY PARAMETERS FOR 2ND PAGE TO READ IN
/THE BAD BLOCK LIST (BBL) FOR DEVICE RL0A
LIST,	ARTN		/BARG: RETURN TO SELF
	1400		/SECTOR: SECTOR 14
	0		/TRACK: 0
	BBL		/MA: MA
	200		/PAGES: 1 PAGE COUNT
	RLRD		/FNC: READ FUNCTION
	-21		/WC: LENGTH OF READ
	2000		/CURTRK: FORCE HEADER READ
/ONCE-ONLY CODE TO READ IN BAD BLOCK LIST (BBL)

START,	RDF		/ONCE-ONLY CODE. DESTROYED WHEN
			/BBL IS READ IN ON TOP OF IT.
			/FIRST, SAVE CALLING FIELD OVER
			/THE READ-IN OF THE BBL.
	TAD BACK	/(INITIALLY CONTAINS A CDF)
	DCA BACK
	TAD JMPSET	/NEXT, RESET "SWITCH" TO SKIP
			/AROUND ONCE-ONLY CODE FROM
			/NOW ON.
	DCA SWITCH
	CDF 20
LOOP,	TAD LIST	/RESET ONCE-ONLY DATA IN 2ND PAGE
	DCA I ADDR	/(THIS IS REQUIRED BECAUSE "BUILD"
	ISZ LOOP	/DOESN'T ALLOW ONCE-ONLY CODE IN
	ISZ ADDR	/2ND PAGE OF 2-PAGE SYSTEM HANDLERS)
	IFNZRO .-7642	<KLUDGE:>
	CDF 20		/******** MUST BE AT LOCATION 7642
			/******** FOR FRTS.SV!
	ISZ COUNT
	JMP LOOP
	TAD ACDIF	/ANOTHER ONCE-ONLY RESET
	DCA I ABRTN
	JMS GO		/READ IN BBL
BACK,	CDF		/RESTORE CALLING FIELD

/----- ONCE-ONLY CODE ENDS HERE

/FALL THROUGH TO SET UP AND DO THE TRANSFER
/SET UP AND DO THE TRANSFER
SET,	TAD BASE	/INITIALIZE BAD BLOCK
			/MAPPING
	DCA MAP
	TAD SYS		/ADDR OF ARG LIST
	JMS GO		/CALL 2ND PAGE SETUP SUBROUTINE
			/DATA FIELD IS 2 ON RETURN
MAP,	TAD		/MAP AROUND BAD BLOCKS, IF
			/ANY.  LOOK AT NEXT BAD BLOCK.
	SNA		/IF 0, TERMINATOR
	JMP MAPPED
	STL CIA		/IF NOT, 13-BIT NEGATE
	TAD I ABLOCK	/SUBTRACT FROM CURRENT BLOCK
	SZL CLA		/SKIP IF BLOCK IS GREATER THAN
			/OR EQUAL TO BAD BLOCK
	JMP MAPPED	/ELSE NO MAPPING TO DO
	ISZ MAP
NEXT,	ISZ I ABLOCK	/INCREMENT CURRENT BLOCK,
			/EITHER DURING TRANSFER OR
			/TO MAP AROUND BAD BLOCK
	JMP MAP		/CONTINUE MAPPING UNTIL DONE
	CIF 20		/IF BLOCK EVER OVERFLOWS TO 0,
	JMP ERROR	/TAKE ERROR RETURN.

MAPPED,	TAD I ABLOCK	/CALCULATE TRACK AND SECTOR
			/FROM BLOCK
	RTR
	RTR
	AND A377
	DCA I ATRACK
	TAD I ABLOCK
	AND A17
	CLL RTL
	TAD A7751
	SPA
	TAD A47
	BSW
	DCA I ASECT
	JMS GO		/TRANSFER 1ST PAGE OF BLOCK
	TAD A200	/INCREMENT MA AND SECTOR
	TAD I AMA
	DCA I AMA
	TAD A200
	TAD I ASECT
	DCA I ASECT
	JMS GO		/TRANSFER 2ND PAGE OF BLOCK
	TAD A200	/INCREMENT MA
	TAD I AMA
	DCA I AMA
	JMP NEXT	/CONTINUE WITH NEXT BLOCK,
			/IF ANY
/SUBROUTINE TO CALL 2ND PAGE SUBR TO DO TRANSFER
GO,	0
	CIF 20
	JMS MAIN
ARTN,			/ON BBL READ, RETURN HERE
			/IF IO ERROR.
			/(ERROR WILL BE DETECTED
			/DURING 2ND PAGE VALIDITY
			/CHECK.)
	CDF 20		/DATA FIELD=2ND PAGE
	JMP I GO
/DATA
ASECT,	SECTOR
ATRACK,	TRACK
ABLOCK,	BLOCK
BASE,	TAD BBL+1	/SKIP ID CODE WORD
AMA,	MA
A17,	17
A47,	47
A200,	200
A377,	377
A7751,	7751

	ZBLOCK 7744-.	/UNUSED
/SECOND PAGE

	RELOC
	*400
	RELOC 7600

/SUBROUTINE TO SETUP OR TRANSFER
MAIN,	0
	SNA		/AC TELLS WHICH
	JMP TRANS	/NON-ZERO: TRANSFER
SETUP,	DCA BARG	/SAVE ADDRESS OF ARGUMENTS
	AC2000		/SET FOR INITIAL HEADER READ
	DCA CURTRK	/(2000 IS AN ILLEGAL TRACK)
	TAD B7600	/SET FOR FULL PAGE TRANSFERS
	DCA WC
	TAD I BARG	/GET HANDLER FUNCTION WORD
	AND B4070	/CONVERT TO RL01 FUNCTION
	SPA
	TAD B3777
	TAD BRLRD
	DCA FNC
	TAD I BARG
	RAL		/CONVERT TO PAGE COUNT
	AND B7600
	DCA PAGES
	ISZ BARG
	TAD I BARG	/GET MA
	DCA MA
	ISZ BARG
	TAD I BARG	/GET BLOCK
	DCA BLOCK
	ISZ BARG
	RDF		/SAVE CALLING FIELD
	TAD BCDIF	/FOR RETURN FROM HANDLER
	DCA BRTN
	CDF 00		/CHECK BBL FOR VALIDITY -
	TAD I BBBL	/A VALID BBL HAS AN ID
	TAD CHECK	/CODE IN ITS FIRST LOCATION
	SZA CLA
	JMP ERROR	/INVALID BBL: TAKE ERROR
			/RETURN FROM HANDLER
GOBACK,			/RETURN TO 1ST PAGE
BCDIF,	CIF CDF 00
	JMP I MAIN
/TRANSFER (READ OR WRITE)
TRANS,	AC7775		/SET FOR 3 TRIES
	DCA ERRCNT
	TAD TRACK	/CALCULATE CYLINDER AND
			/SURFACE FROM TRACK
	CLL RAR
	DCA CYL
	RTR
	DCA SURF
	JMS TRKCMP	/COMPARE TRACK WITH LAST
			/ONE TRANSFERRED; IF THE
			/SAME, DO TRANSFER.
RETRY,	RLDC		/IF DIFFERENT, OR IF RE-
			/TRYING, SEEK TO TRACK;
			/CLEAR CONTROLLER REGISTERS
			/FOR SEEK
SEEK,	IAC		/AC=1 FOR RESETTING DRIVE
			/REGISTERS (ERRORS), AC=3
			/FOR DOING SEEK
	JMS IO		/DO A RESET OR A SEEK
	TAD HEADER	/AC=READ HEADER FUNCTION
	JMS IO		/READ NEXT HEADER
	RRSI		/GET HEADER BYTE #1
	BSW		/CALCULATE TRACK
	AND B3
	DCA CURTRK
	RRSI		/GET HEADER BYTE #2
	AND B377
	CLL RTL
	TAD CURTRK
	DCA CURTRK
	JMS TRKCMP	/COMPARE CURRENT AND REQUESTED
			/TRACK; IF SAME, DO TRANSFER
	SPA		/IF DIFFERENT, SEEK: CALCULATE
	CLL CIA		/DIFFERENCE WORD
	RAR
	TAD SURF
	RLCA		/LOAD REGISTER "A"
	AC0002		/PREPARE FOR SEEK
	JMP SEEK	/LOOP BACK TO ENSURE THAT TRACK
			/REACHED IS REALLY THE DESIRED
			/TRACK, IN CASE OF RL01 SEEK
			/UNRELIABILITY.
/SUBROUTINE TO COMPARE CURRENT TRACK WITH REQUESTED
/TRACK AND DO TRANSFER IF THE SAME
TRKCMP,	0
	TAD CURTRK
	CIA
	TAD TRACK
	STL		/SET DIRECTION BIT IN
			/DIFFERENCE WORD IF DIFF-
			/ERENCE IS POSITIVE.
	SZA		/SAME?
	JMP I TRKCMP	/NO
	TAD SECTOR	/YES; LOAD DRIVE REGISTERS
	RLSA
	TAD WC
	RLWC
	TAD SURF
	TAD CYL
	RLCA
	TAD MA
	RLMA
	TAD FNC
	JMS IO		/READ OR WRITE
	TAD B7600	/COUNT PAGES TRANSFERRED
	TAD PAGES
	SNA
	JMP DONE	/NO MORE TO GO
	DCA PAGES
	JMP GOBACK	/MORE TO GO; RETURN TO
			/1ST PAGE

/SUBROUTINE TO DO RL01 I/O
IO,	0
	RLCB		/EXECUTE FUNCTION (DRIVE 0)
	RLSD		/WAIT UNTIL DONE
	JMP .-1
	RLSE		/ANY ERRORS?
	JMP I IO	/NO; RETURN
	ISZ ERRCNT	/YES; MORE RETRIES LEFT?
	JMP RETRY	/YES, RETRY IT.
ERROR,	AC4000		/NO, TAKE HANDLER ERROR
	SKP		/RETURN.
DONE,	ISZ BARG	/NORMAL HANDLER RETURN
BRTN,	CIF CDF 00	/RESTORE CALLING FIELD;
	JMP I BARG	/INITIALLY, RETURN TO 1ST PAGE
			/AFTER BBL READ-IN.
/DATA
B3,	3
B377,	377
B3777,	3777
B4070,	4070
B7600,	7600
HEADER,	BYTE RLRH
BRLRD,	RLRD
CHECK,	-ID
BBBL,	BBL
ERRCNT,	0
BLOCK,	0
SURF,	0
CYL,	0

/VARIABLES INITIALIZED TO PERFORM INITIAL BBL READ-IN
BARG,	ARTN		/INITIALLY, RETURN TO 1ST PAGE
			/AFTER BBL READ-IN.
SECTOR,	1400		/BBL: SECTOR 14 (TRACK 0)
TRACK,	0
MA,	BBL		/INITIAL BBL READ
PAGES,	200		/INITIAL BBL READ
FNC,	RLRD		/INITIAL BBL READ
WC,	-21		/INITIAL BBL READ
CURTRK,	2000		/INITIAL HEADER READ AND
			/SEEK IF REQUIRED.

	ZBLOCK 7774-.	/UNUSED

	ZBLOCK 4	/RESERVED FOR USE BY BATCH
			/IN 12K SYSTEMS.

	RELOC
$

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RTL.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753

/FORTRN 4 RTS LOADER
/
/ VERSION 5A  PT 16-MAY-77
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1974, 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
/SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
/AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/
/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMRNT COROPATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
/
/
/
/
/
/FORTRAN 4 RTS LOADER - RL
/WITH DOUBLE PRECSION - MKH
/AND RTS-8 SUPPORT - R. LARY

/LAST EDITED 5/21/74
/
/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T. 5/1/77
/ .FIXED THE D AND B FORMAT (FPP) BUG
/ .FIXED FIELD OVERFLOW BUG(NO. OF ASTERISKS PRINTED)
/

/PAGE 0 LOCATIONS FOR RTS LOADER

X0=	10
X1=	11
X2=	12
X3=	13

HADR=	20
UNIT=	21
HCWORD=	22
MXFLD=	23
HLDADR=	24
HGHFLD=	25
HGHADR=	26
RLTMP=	27
HDIFF=	30
CFLAG=	31

/DURING MOST OF THE LOAD OPERATION A SECTION OF FIELD 0 RTS
/IS MOVED UP INTO FIELD 1 AND THE VACATED AREA OF FIELD 0 IS USED
/TO RUN THE COMMAND DECODER AND TO ACCUMULATE DEVICE HANDLERS.

/*K*	THEREFORE, IF THE RTS LOADER IS TO MODIFY ANY CODE BETWEEN
/"F0HBEG" AND "F0HEND" IT MUST MODIFY IT IN FIELD 1 IN THE "F0TO" AREA.

F0HBEG=	0
F0HEND=	3000
F0HSAV=	7000	/400 WORDS WHERE DEVICE HANDLERS ARE TEMPORARILY SAVED
		/SO THAT THEY WON'T INITIALIZE THEMSELVES WRONG
/RTS LOADER TABLES

	*2000

IONTBL,	ZBLOCK	100	/INTERRUPT ENABLE TABLE - LOW BIT ONLY
HCWTBL,	ZBLOCK	14	/HANDLER CONTROL WORD - ONE PER PAGE (LOTSA WASTE)
TFTABL,	ZBLOCK	45	/TENTATIVE FILE SAVE TABLE
DVTEMP,	ZBLOCK	17	/HANDLER ENTRY TABLE SAVE AREA

	*IONTBL+5	/RK8 / RK8E
	1
	*IONTBL+16	/DTA
	1
	*IONTBL+6	/RF08 IN 4 FLAVORS
	1;1;1;1
	*IONTBL+0	/TTY
	2		/FORMS CONTROL ON TTY
	*IONTBL+4	/LPT
	2		/FORMS CONTROL ON LPT
	*IONTBL+23
	1
	*IONTBL+25
	1
	PAGE
/RTS LOADER

RTSLDR,	JMS I	(RTINIT
	JMS I	(RTINIT	/INITIALIZE WHETHER CHAINED TO OR NOT
	JMP	NOCD
LICD,	JMS I	(200
	5
	1404		/.LD DEFAULT EXTENSION
NOCD,	JMS I	(TSTSWS	/TEST /E,/P,/V AND /H SWITCHES
	TAD I	(7617
	SNA
	JMP	LICD
	AND	(17
	JMS I	(GETHAN	/GET HANDLER TO LOAD WITH
	0		/DON'T PUT IT ANYWHERE
	TAD I	(7620
	DCA	LIBLK
	JMS I	(SVHND	/COPY HANDLER TO AVOID BAD INITIALIZATION
	CIF 0
	JMS I	HLDADR
	0100
LHDR,	QLHDR
LIBLK,	0
	JMP	LDIOER
	JMS I	(RSTHND	/RESTORE VIRGIN COPY OF HANDLER
	CDF 0
	TAD	HADR
	DCA I	(OVHND
	TAD	HCWORD
	DCA I	(OVHCDW
	TAD	(QUSRLV-1
	DCA	X0
	AC7776
	TAD I	LHDR
	SZA CLA		/VERIFY LOADER IMAGE INPUT
	JMP	NOTLI	/GOOD THING WE CHECKED!
	TAD	DPFPP
	TAD I	(QDPFLG	/CHECK IF TRYING TO USE D.P. WITHOUT OPTION
	SMA CLA
	JMP	.+3
	JMS I	(RLERR	/YES - PRINT WARNING MESSAGE
	NODPMS		/BUT LET THE FOOL GO ON
/SET UP RTS TABLES FROM LOADER IMAGE

	CDF 0
	TAD	(OVLYTB-1
	DCA	X1
	TAD	(-10
	DCA	RLTMP
OVRELP,	TAD I	X0
	DCA I	X1	/MOVE USER OVERLAY INFO INTO SWAP TABLE,
	TAD I	X0
	DCA I	X1
	TAD I	X0
	TAD	LIBLK	/RELOCATING THE BLOCK NUMBERS
	DCA I	X1
	TAD I	X0
	DCA I	X1
	ISZ	RLTMP
	JMP	OVRELP
	TAD I	(QRTSWP
	AND	(7770	/TURN THE LOADER INITIAL SWAP WORD
	DCA I	(STSWAP+2
	TAD I	(QRTSWP	/INTO A DUMMY SWAP WORD AND A JUMP WORD
	AND	(7	/SO THAT WE CAN HALT BETWEEN
	TAD	(JA	/LOADING AND STARTING USERS PROGRAM.
	DCA I	(STJUMP
	TAD I	(QRTSWP+1
	DCA I	(STJUMP+1
	TAD I	(QHGHAD
	DCA	HGHFLD
	CLA IAC
	TAD	HGHFLD
	CMA
	DCA I	(FCNT
	TAD I	(QHGHAD+1
	DCA	HGHADR
	JMS I	(GETFIL	/GET USER I/O FILES IF ANY
	TAD I	(OS8DAT	/SALT AWAY OS/8 DATE WORD
	DCA I	(VDATE-F0HBEG+F0TO
	STL CLA
	6141		/TEST IF WE ARE ON A PDP-12
	0261		/ROL I 1  -  PUTS LINK IN AC11
	0002		/PDP
	DCA I	(V8OR12+1-F0HBEG+F0TO
	JMS I	(MOVE
	CDF 10
	SPSTRT-1	/MOVE SPECIAL /P START CODE TO LOC 200
	CDF 10
	200-F0HBEG+F0TO-1	/(RELOCATED 200, THAT IS)
	-3
	JMP I	(MOVCOR

DPFPP,	3777		/0 IF D.P. FPP AVAILABLE
NOTLI,	JMS I	(RLERR
	NOLI
	JMP	LICD

LDIOER,	JMS I	(RLERR
	LIOEMS
	CDF CIF 0
	JMP I	(7605
	PAGE
/FIGURE OUT CORE LIMITS AND WRITE OUT PG 17600

MOVCOR,	TAD I	(HTOP
	TAD	HDIFF	/GET BOTTOM OF HANDLER AREA
	CIA
	CLL		/LENGTH OF HANDLER AREA IN AC
	TAD	HGHADR
	SZL		/TRICKY CODE - IF (L,AC)=0, AC GETS -1
	STA		/IF (L,AC) =0XXXX, AC GETS 0
	SNA CLA		/IF (L,AC) =1XXXX, AC GETS 1
	STL STA		/THERE OUGHTA BE A SHORTER WAY -
	RAL		/I'D APPRECIATE HEARING ONE.
	TAD	HGHFLD	/USE MAGIC NUMBER TO ADJUST HGHFLD
	CIA		/BEFORE WE COMPARE IT TO TOP-OF-CORE
	TAD	MXFLD
	SPA CLA
	JMP	TOOBIG	/ALL THAT WORK FOR NOTHING!
	TAD	MXFLD
	CLL RTL
	RAL
	TAD	(CDF
	DCA	HCDF	/PREPARE TO TRANSFER THE HANDLERS
	JMS I	(MOVE	/BEFORE WE MOVE THE HANDLERS WE SHOULD WRITE
	CDF 10		/OUT PAGE 17600 AND THE RTS CLEANUP CODE
	TFTABL-1	/SINCE THE HANDLERS MAY OVERLAY THEM.
	CDF 10		/SO FIRST MOVE THE TENTATIVE FILE TABLE
	7600-1		/INTO PAGE 17600 WHERE IT'S SAFE.
	-45
	CIF 0
	JMS I	(7607
	4210
	7400
	37		/SUITABLE SCRATCH BLOCK
	JMP	SYSERR
	TAD	HDIFF
	TAD	(F0HEND	/CHANGE HDIFF FROM AN OFFSET
	DCA	HDIFF	/TO THE FIRST LOC ABOVE THE HANDLERS.
/SHUFFLE CORE AROUND AND START UP RTS

HLOOP,	STA
	TAD	HDIFF	/WE HAVE TO MOVE THE HANDLERS IN A COCKEYED
	DCA	HDIFF	/WAY SINCE WE MIGHT BE PARTIALLY SWAPPING
	CDF 0		/CORE BETWEEN FIELD 0 (THE HANDLERS) AND
	STA		/FIELD 1 (WHERE WE SAVED FIELD 0) IN 8K SYSTEMS.
	TAD	HPTR1
	DCA	HPTR1
	STA
	TAD	HPTR2
	DCA	HPTR2
	TAD I	HPTR1
HCDF,	HLT		/MOVE A HANDLER WORD FROM FIELD 0
	DCA I	HDIFF	/TO FIELD N
	CDF 10
	TAD I	HPTR2	/MEANWHILE RESTORE FIELD 0
	CDF 0
	DCA I	HPTR1	/FROM FIELD 1
	ISZ	HMCT
	JMP	HLOOP	/DO MORE THAN WE HAVE TO - IT CAN'T HURT
	CDF CIF 0
	TAD	(5606
	DCA I	(7605	/SET UP OS/8 RETURN SEQUENCE TO TRAP TO RTS
	TAD	(PDPXIT
	DCA I	(7606	/AS RANDOM RESTARTS COULD BE FATAL.
	FPICL		/RE-INITIALIZE FPP (IF ANY)
	FPCOM		/CLEAR APT POINTER FIELD BITS (IF FPP)
	CLA IAC
	6654		/LOAD PRINTER BUFFER ON ANALEX PRINTER
	SZA CLA		/IS ANALEX PRESENT?
	JMP I	(FPSTRT	/NO - START UP
	DCA I	(LPTEST	/IF ANALEX TAKE OUT LPT INTERNAL HANDLER
LP6652,	6652		/ALSO CLEAR ALL ANALEX FLAGS
	DCA I	(LPTSNA
	6662		/CLEAR BUFFER ON ANALEX
	TAD	(6651
	DCA I	(LPTERR	/REPLACE LP08 ERROR CODE BY ANALEX
	TAD	LP6652	/TO AVOID HANGING ON ANALEX POWER OFF.
	DCA I	(LPTERR+2
	JMP I	(FPSTRT

TOOBIG,	JMS I	(RLERR
	TOOMCH
OS8RTN,	CDF CIF 0
	JMP I	(7605

SYSERR,	JMS I	(RLERR
	SYSMSG
	JMP	OS8RTN

HPTR1,	F0HEND
HPTR2,	F0TO+F0HEND-F0HBEG
HMCT,	F0HBEG-F0HEND
/MOVE ROUTINE

MOVE,	0		/GENERAL MOVE SUBROUTINE
	CDF 10
	CLA
	TAD	MOVE
	DCA	X2
	TAD I	MOVE
	DCA	FRMFLD
	TAD I	X2
	DCA	X3
	TAD I	X2
	DCA	TOFLD
	TAD I	X2
	DCA	X1
	TAD I	X2
	DCA	MVC
FRMFLD,	HLT
	TAD I	X3
TOFLD,	HLT
	DCA I	X1
	ISZ	MVC
	JMP	FRMFLD
	CDF 10
	JMP I	X2
MVC,	0

HNDERR,	JMS I	(RLERR
	TOMNYH
	JMP	OS8RTN
	PAGE
/INITIALIZATION

RTINIT,	0
	ISZ	RTINIT	/SKIP RETURN
	JMS I	(BAKTST	/SEE IF WE'RE RUNNING IN BACKGROUND UNDER RTS-8
	CIF 0
	JMS I	(CORE
	DCA	MXFLD
	CLA IAC
	JMS I	(GETION	/GET ION BIT FOR SYS HANDLER
	DCA I	(HCWTBL+13	/SAVE IT
	SWAB		/SET EAE MODE TO B (IF 8/E)
	CLA IAC
EAEKIL,	SHL		/ZERO THIS LOCATION TO INHIBIT EAE
	CLA IAC		/LOW ORDER BITS 01
	TAD	(-2
	SNA CLA		/TEST FOR 8/E EAE
	JMS I	(MOVEAE	/YES - SUBSTITUTE PACKAGES
	TAD	(APT
	FPST		/START FPP ON "STARTE;FEXIT"
	JMP	NOFPP	/DIDN'T START
	JMS I	(MOVE
	CDF 10
	FPPINT-1	/THE FPP HANDLER AND D.P. I/O PKG IS IN THE
	CDF 0		/SAME LOCATIONS IN FIELD 1 AS THE
	FPPINT-1	/FPP INTERPRETER IN FIELD 0.
	-1000		/COUNT FOR DBL PREC SPACE
	FPRST		/FPP HAD BETTER BE DONE BY NOW!!
	AND	(4	/GET D.P. STATUS BIT
	SNA CLA
	JMP	NOFPP	/NO DOUBLE PRECISION
	DCA I	(DPFPP	/SET FLAG TO INDICATE D.P. AVAILABLE
	CDF 0
	TAD	(DFMT
	DCA I	(DF	/ENABLE D FORMAT
	TAD	(BFMT
	DCA I	(BF	/AND B FORMAT
	CDF 10
NOFPP,	JMS I	(MOVE
RICDF0,	CDF 0
	F0HBEG-1
	CDF 10
	F0TO-1		/MOVE LOWER F0 INTO F1 FOR SAFEKEEPING
	F0HBEG-F0HEND
	CDF 0
	TAD I	(OSJSWD	/GET OS/8 STATUS WORD
	AND	(6374	/FORCE BITS ON INDICATING NON-RESTARTABLE JOB
	TAD	(1003	/AND DESTRUCTIVE CALLS TO CD AND USR
	DCA I	(OSJSWD	/MEANWHILE FORCING "BATCH SAVED" BIT OFF
	TAD I	(7612
	TAD	(-3	/CHECK FOR IN-CORE TD8E'S
	SZA CLA
	JMP	NOTDSY
	TAD	MXFLD
	CLL RTL
	RAL
	TAD	RICDF0
	DCA	TD8EFG	/SET TD8E FLAG WHICH IS ALSO CDF
	TAD I	(7642
	AND	(70
	TAD	RICDF0	/GET THE FIELD WE'RE COMING FROM
	DCA	TD8EFL
	TAD	TD8EFG
	IAC
	JMS I	(TDSET	/REDO THE CDF'S IN F0
	JMS I	(MOVE
TD8EFL,	CDF 20
	7577
TD8EFG,	0
	7577
	-174		/SPARE BATCH PARAMETERS IN TOP FIELD
	TAD	MXFLD	/SET FLAG IN CLEANUP ROUTINE
	DCA I	(TDEXFG	/TO RESTORE TD8E HANDLER TO FIELD 2
NOTDSY,	CDF 10
	TAD	MXFLD
	TAD	(-7
	SNA		/32K?
	JMP	TAKCAR	/YES - UNIQUE PROBLEMS
	TAD	(6
	SNA CLA		/8K?
	JMP	ONLY8K	/YES - IGNORE BATCH & TD8E CRAP
	JMS I	(GBFLG	/GET BATCH FLAG
	TAD	TD8EFG
	SNA CLA		/IF NO BATCH OR TD8E'S,
ONLY8K,	TAD	(200	/USE ALL OF THE LAST FIELD.
STOHDF,	TAD	(-F0HEND-200
	DCA	HDIFF	/OTHERWISE USE ONLY UP TO 7600
	JMP I	RTINIT
TAKCAR,	JMS I	(GBFLG	/GET BATCH FLAG
	SNA CLA
	JMP	NO32KB	/NO BATCH - USE UP TO 77400 (TD8E ROM)
	TAD	(6	/BATCH - USE UP TO 67600
	DCA	MXFLD
	JMP	STOHDF
NO32KB,	TAD	TD8EFG
	SNA CLA		/IF IN-CORE TD8E'S
	TAD	(7600	/LIMIT IS 77600 ELSE 77400
	JMP	STOHDF
	PAGE
GETHAN,	0		/GET HANDLER SUBROUTINE
	AND	(17
	DCA	UNIT
	DCA	H1
	TAD	UNIT
	JMS I	(200
	12		/INQUIRE
H1,	0
	NOP		/ERROR RETURN ALWAYS SKIPPED
	TAD	H1
	SNA
	JMP	NOTLDD	/NOT IN CORE - MUST LOAD
	JMS	HCWTBA	/IN CORE
GHEXIT,	TAD I	HCWPTR	/GET CONTROL WORD FOR HANDLER PAGE
	DCA	HCWORD
	TAD	HLDADR
	DCA	HADR	/ASSUME HANDLER PERMENANTLY RESIDENT
	TAD	(-4
	AND	HCWORD
	SNA CLA		/WERE WE RASH?
	JMP	RESHAN	/NO
	TAD	HADR
	AND	(177
	TAD	(HPLACE	/YES - I APOLOGIZE
	DCA	HADR
RESHAN,	TAD I	GETHAN	/GET DSRN NUMBER
	SNA
	JMP I	GETHAN	/NO DSRN NUMBER
	CLL RTL
	RAL
	TAD I	GETHAN
	TAD	(DSRN-12
	DCA	X0	/XR POINTS TO DSRN ENTRY
	CDF 0
	TAD	HADR
	DCA I	X0	/SEE PG 0, FLD 0 FOR DSRN FORMAT
	TAD	HCWORD
	TAD	CFLAG	/THE C BIT REVERSES THE FORMS CTL BIT ON THIS FILE
	AND	(7773	/KILL ANY OVERFLOW
	DCA I	X0
	TAD	HGHFLD
	CLL RTL
	RAL
	TAD	HGHADR
	DCA I	X0	/SAVE BUFFER ADDRESS, FIELD
	TAD	HGHADR
	DCA I	X0	/INITIALIZE WORD POINTER
	TAD	HGHADR
	TAD	(400
	SNA
	ISZ	HGHFLD	/BUMP DOUBLEWORD BUFFER ADDRESS
	DCA	HGHADR
	AC7775
	DCA I	X0	/INITIALIZE CHAR CTR
	CDF 10
	JMP I	GETHAN	/RETURN
/LOAD A NON-RESIDENT HANDLER

NOTLDD,	JMS	GH
	CLA IAC
	JMS	GH	/TRY 1-PAGE AND THEN 2-PAGE ASSIGN
	HLT		/ARRRGHHHH!!!

GH,	0
	DCA	TPFLG
	TAD	HTOP
	TAD	(7600	/BUMP HANDLER CEILING DOWN
	SNA
	JMP I	(HNDERR	/CAN'T PUT HANDLER IN PAGE 0
	DCA	HTOP
	TAD	TPFLG
	TAD	HTOP
	DCA	GHADR
	TAD	UNIT
	JMS I	(200
	1		/FETCH HANDLER
GHADR,	0
	JMP I	GH	/FAILED!
	TAD	GHADR	/SAVE ACTUAL LOAD ADDRESS
	JMS	HCWTBA	/INDEX INTO HCW TABLE
	TAD	GHADR
	AND	(7600
	TAD	HDIFF
	DCA	GHADR	/SAVE RELOCATED HANDLER PAGE ADDRESS
	TAD	MXFLD	/PUT ADDR IN BITS 0-3 AND FIELD IN BITS 6-8
	CLL RTL
	RAL
	TAD	GHADR
	DCA	GHADR
	TAD	UNIT
	JMS I	(GETION	/ION BIT INTO BIT 11, FORMS CTL BIT INTO BIT 10
	TAD	GHADR
	DCA I	HCWPTR	/STORE POINTER FOR THIS PAGE
	JMP	GHEXIT
HCWTBA,	0
	DCA	HLDADR
	TAD	HLDADR
	AND	(7600
	CLL RTL
	RTL
	RTL		/GET PAGE NUMBER
	TAD	(HCWTBL-24
	DCA	HCWPTR	/SAVE POINTER INTO TABLE
	JMP I	HCWTBA

HTOP,	F0HEND
HCWPTR,	0
TPFLG,	0

SPSTRT,	RELOC	200	/   /P STARTUP CODE
	SWAB		/MAKE SURE EAE IS IN MODE B
	JMP I	.+1	/EXECUTES AT 200
	FPSTRT		/START UP IN FLAG CLEARING CODE
	RELOC
	PAGE
/ROUTINE TO ACCEPT FILE SPECIFICATIONS

GETFIL,	0
	CDF 10
	TAD I	(OS8SWS-1
	SPA CLA		/ALTMODE MEANS NO MORE SPECS
	JMP I	GETFIL
GETFCD,	JMS I	(SPMDCD	/CALL CD IN SPECIAL MODE
	TAD I	(7600
	STL CIA
	SNA		/OUTPUT FILE?
	TAD I	(7605
	SNA		/IN OR OUT FILE?
	TAD I	(OS8SWS+3	/NEITHER - HOW ABOUT INTERNAL HANDLER?
	SNA CLA
	JMP	GETFIL+1	/NONE OF THE ABOVE
	RAR		/LINK MAGICALLY TELLS DIRECTION
	DCA	DIR
	DCA	DSRNUM
	TAD I	(OS8SWS+2
	AND	(777	/SWITCHES 1-9
	SNA
	JMP	NONUM
	CLL RTL
DNUMLP,	ISZ	DSRNUM
	RAL
	SMA
	JMP	DNUMLP	/TRANSLATE SWITCH INTO NUMBER
	TAD	DIR	/** AC IS NEGATIVE **
	SPA CLA
	TAD	(5
	TAD	(7600
	DCA	FPTR	/POINT TO FILE UNIT
	TAD I	FPTR
	SNA
	JMP	INTHND	/NO FILE - GET HANDLER FROM INTERNAL LIST
	JMS I	(GETHAN	/GET HANDLER - XR10 POINTS INTO DSRN
DSRNUM,	0		/DSRN ENTRY NUMBER
	TAD	DIR
	STL RTL		/GENERATE 2 OR 3 (LOOKUP OR ENTER)
	DCA	LKPNTR
	TAD I	FPTR	/GET UNIT AND REQUESTED BLOCK COUNT (IF ENTER)
	ISZ	FPTR	/BUMP POINTER SO IT POINTS TO THE FILE NAME
	DCA	FUNIT	/SAVE UNIT NUMBER A SEC
	TAD I	FPTR	/WATCH OUT FOR NULL FILE NAMES
	SNA CLA		/AS THEY WILL FAIL ON LOOKUPS
	JMP	NONAME	/ON OUTPUT-ONLY NON-DIRECTORY DEVICES
	JMS I	(SVHND	/SAVE HANDLER
	TAD	FUNIT
	JMS I	(200
LKPNTR,	0		/LOOKUP OR ENTER
FPTR,	0		/FILE NAME
FUNIT,	0		/GETS LENGTH
	JMP	FILERR	/SOMETHING NOT KOSHER
	JMS I	(RSTHND	/RESTORE VIRGIN COPY OF HANDLER
STDSRN,	TAD	FPTR
	CDF 0
	DCA I	X0	/SAVE STARTING BLOCK
	DCA I	X0	/RELATIVE BLOCK
	TAD	FUNIT
	SNA
	IAC		/FUDGE NON-DIRECTORY DEVICES VERY LARGE
	CIA		/TURN NEGATIVE COUNT TO POSITIVE
	DCA I	X0	/LENGTH
	TAD	X0
	DCA	FPTR	/SAVE PTR TO LENGTH WORD
	CDF 10
	TAD	DIR
	SMA CLA		/TENTATIVE FILE?
	JMP	GETFIL+1
	TAD	FPTR	/YES - STORE POINTER TO LENGTH WORD OF DSRN
	DCA I	TFPTR	/IN TENTATIVE FILE TABLE ENTRY
	JMS I	(MOVE
	CDF 10
	7600-1
	CDF 10
TFPTR,	TFTABL		/SAVE FILE NAME AND UNIT IN
	-5		/TENTATIVE FILE TABLE
	TAD	TFPTR
	TAD	(6
	DCA	TFPTR	/BUMP PTR TO NEXT 6-WORD ENTRY
	JMP	GETFIL+1
NONUM,	JMS I	(RLERR
	NONMSG
	JMP	GETFCD
FILERR,	JMS I	(RLERR
	FILMSG
	JMP	GETFCD

DIR,	0

NONAME,	DCA	FPTR
	DCA	FUNIT	/ZERO BLOCK # AND LENGTH
	JMP	STDSRN	/USE ENTIRE DEVICE AS FILE

INTHND,	STA
	TAD I	(OS8SWS+3
	AND	(3	/ONLY USE LOW ORDER 2 BITS OF NUMBER
	TAD	(IHTBL
	DCA	HADR	/SAVE PTR INTO TABLE OF INTL HANDLERS
	TAD	DSRNUM
	CLL RTL
	RAL
	TAD	DSRNUM	/MULTIPLY DSRN NUMBER BY 9
	TAD	(DSRN-11	/ADD TABLE BASE
	DCA	DSRNUM
	TAD I	HADR
	CDF 0
	DCA I	DSRNUM
	ISZ	DSRNUM
	AC7776
	TAD	CFLAG	/DEPENDING ON THE C FLAG,
	CIA
	DCA I	DSRNUM	/DISABLE OR ENABLE FORMS CONTROL
	JMP	GETFIL+1
	PAGE
TSTSWS,	0		/ROUTINE TO TEST CD SWITCHES E AND H
	TAD I	(OS8SWS
	AND	(20
	CDF 0
	SNA CLA		/TEST FOR /H SWITCH
	JMP	.+3
	TAD	(HLT
	DCA I	(HLTNOP	/SET TO HALT BEFORE STARTING PROGRAM
	CDF 10
	TAD I	(OS8SWS+1
	AND	(4
	SNA CLA		/TEST FOR /V SWITCH
	JMP	.+3	/NO
	JMS I	(RLERR	/YES - PRINT VERSION NUMBER MESSAGE
	XVERMS
	TAD I	(OS8SWS
	AND	(200
	CDF 0
	SZA CLA		/TEST FOR /E SWITCH
	ISZ I	(ERRFLG	/MAKE USER ERRORS NON-FATAL
	CDF 10		/(USER ERROR = MISSING SUBROUTINE, ETC)
	TAD I	(OS8SWS+1
	AND	(400
	CDF 0
	SNA CLA		/TEST FOR /P SWITCH
	JMP	.+3	/NO, PRAISE BE!
	TAD	(SKP	/GIVE THE DUMMY WHAT HE WANTS
	DCA I	(HLTNOP
	CDF 10
	TAD I	(OS8SWS
	RTL
	SMA CLA
	AC0002
	DCA	CFLAG	/SAVE C FLAG IN PAGE0
	JMP I	TSTSWS

MOVEAE,	0
	TAD	(EFFNOR	/SUBSTITUTE A POINTER TO THE EAE NORMALIZE
	CDF 0		/ROUTINE FOR THE POINTER TO THE NON-EAE
	DCA I	(NORMX	/NORMALIZE ROUTINE
	JMS I	(MOVE
	CDF 10
	FPPKG-1		/THE EAE PKG IS IN THE SAME PAGE IN FIELD 1
	CDF 0
	FPPKG-1		/AS THE NON-EAE PKG IN FIELD 0
	-600
	JMS I	(MOVE
	CDF 0		/SUBSTITUTE FAST FIX AND FLOAT
	EFXFLT-1
	CDF 0
	EAEFIX-1
	-FXFLTC
	JMP I	MOVEAE
SPMDCD,	0		/SUBR TO DO A SPECIAL MODE COMMAND DECODE
	JMS I	(MOVE
	CDF 10
	OS8DVT-1
	CDF 10
	DVTEMP-1	/MOVE OS/8 DEVICE HANDLER TABLE
	-17		/SINCE C.D. CLEARS IT AND WE ARE USING IT
	TAD I	(HTOP	/GET LOWEST HANDLER LOADED
	RAL
	SZL SPA CLA	/DID WE LOAD ANY BELOW 02000?
	JMP	.+4	/NO
	CDF 0
	ISZ I	(OSJSWD	/YES - MAKE CD CALLS DESTRUCTIVE
	ISZ I	(OSJSWD
	CDF 10
	JMS I	(200
	5		/COMMAND DECODE
	5200		/SPECIAL MODE - WROUGHT WITH PERIL
	0		/DON'T CLEAR TENTATIVE FILES
	JMS I	(MOVE
	CDF 10
	DVTEMP-1
	CDF 10
	OS8DVT-1
	-17		/MOVE DEVICE HANDLER TABLE BACK
	JMS	TSTSWS	/CHECK FOR /E, /H, /P
	JMP I	SPMDCD

IHTBL,	PTR;PTP;LPT;TTY	/INTERNAL HANDLER TABLE
	PAGE
GETION,	0
	TAD	(OS8DCB-1
	DCA	GMADR
	TAD I	GMADR	/GET DCB WORD
	CLL RTR
	RAR
	AND	(77	/INDEX INTO TABLE
	TAD	(IONTBL	/WHICH INDICATES IF HANDLER CAN EXECUTE
	DCA	GMADR	/WITH INTERRUPTS ON
	TAD I	GMADR	/ION BIT INTO BIT 11, FORMS CONTROL INTO BIT 10
	JMP I	GETION

GBFLG,	0
	CDF 0
	TAD I	(7777	/SPECIAL FLAGS LOC
	CDF 10
	RTL
	CLA RAL
	JMP I	GBFLG

SVHND,	0		/ROUTINE TO SAVE HANDLER IN F1
	JMS	GMADR	/GET MOVE FROM ADDRESS
	JMP I	SVHND	/NO HANDLER TO MOVE
	DCA	SVMOVE
	JMS I	(MOVE
	CDF 0
SVMOVE,	0
	CDF 10
	F0HSAV-1
	-400
	JMP I	SVHND

RSTHND,	0		/ROUTINE TO RESTORE HANDLER FROM F1
	JMS	GMADR
	JMP I	RSTHND	/HANDLER IS SYS:
	DCA	RSTMOV
	JMS I	(MOVE
	CDF 10
	F0HSAV-1
	CDF 0
RSTMOV,	0
	-400
	JMP I	RSTHND

GMADR,	0
	TAD	HLDADR
	SPA		/CHECK THAT WE'RE NOT TRYING
	JMP	RESHND	/TO SAVE A RESIDENT HANDLER -
	AND	RESHND	/THAT COULD BE TRICKY
	TAD	(-1	/ECCH
	ISZ	GMADR
	JMP I	GMADR
RESHND,	7600
	JMP I	GMADR
/RTS LOADER ERROR MESSAGE ROUTINE & MESSAGES

RLERR,	0		/ERROR MESSAGES ARE IN FIELD 0
	CLA
	CDF 10
	TAD I	RLERR
	CDF 0
	DCA	RLTMP
RELP,	TAD I	RLTMP
	RTR
	RTR
	RTR
	AND	(77
	JMS	LTTY
	TAD I	RLTMP
	AND	(77
	JMS	LTTY
	ISZ	RLTMP
	JMP	RELP
EOMSG,	TAD	(7515
	JMS	LTTY
	TAD	(7512
	JMS	LTTY
	ISZ	RLERR
	CDF 10
	JMP I	RLERR	/SOME MESSAGES ARE NOT FATAL

LTTY,	0
	SNA
	JMP	EOMSG
	TAD	(240
	SMA
	AND	(77	/CONVERT SIXBIT TO EIGHTBIT
	TAD	(240
	TLS
	CLA
	TSF
	JMP	.-1
	JMP I	LTTY
/ROUTINE TO DETERMINE WHETHER WE ARE RUNNING IN THE
/BACKGROUND UNDER RTS-8, AND MODIFY THE RUN-TIME SYSTEM IF WE ARE.
/RUNS AT INITIALIZATION TIME, BEFORE LOWER FIELD 0 IS MOVED

BAKTST,	0
	FPICL		/FIRST INITIALIZE FPP (IF ANY)
	FPCOM		/INCLUDING CLEARING EXTENDED APT POINTER
	TCF		/TEST FOR RTS-8 BACKGROUND BY CLEARING THE
	TSF		/TTY FLAG AND THEN TESTING IT - IF IT IS
	JMP I	BAKTST	/STILL SET, WE ARE RUNNING UNDER SRT-8.
	CDF 0		/MODIFY LIST AND MODIFICATIONS ARE IN FIELD 0
BAKLP,	TAD I	BKRPTR	/GET POINTER TO BLOCK TO BE MODIFIED
	SNA
	JMP	BAKRTN	/ZERO - WE'RE DONE
	DCA	X0	/STORE IN AUTO-XR
	ISZ	BKRPTR
BAKWLP,	TAD I	BKRPTR	/GET NEXT WORD TO STORE
	ISZ	BKRPTR
	SNA
	JMP	BAKLP	/ZERO MEANS END OF GROUP
	DCA I	X0
	JMP	BAKWLP
BAKRTN,	CDF 10		/RESET DATA FIELD TO 10
	DCA I	(EAEKIL	/EAE USES SGT WHICH IS NOT EMULATED, SO KILL IT
	JMP I	BAKTST	/AND RETURN

BKRPTR,	BKRLST
	PAGE

F0TO=	.
/FLOATING POINT PROCESSOR HANDLER
	*FPPINT

RETURN,	JMP	FPPRTN	/MUST BE AT 0 IN PAGE

FPGO,	0		/FPP STARTUP ROUTINE - MUST BE AT 1 IN PAGE
	CDF 0
	DCA	STEFLG
	TAD	PC
	DCA	FSAVPC	/SAVE OLD PC FOR ONE LEVEL
	TAD	APT
	DCA	SAVAPT	/OF RE-ENTRANTNESS
	TAD I	FPGO
	DCA	PC
	TAD	APT
	AND	(7770
	DCA	APT	/SET UP ADDRESS IN APT
FPREST,	TAD	(400	/ENABLE FPP INTERRUPTS
	FPCOM		/LOAD AND STORE ENTIRE APT
	CLA		/NECESSARY?
	TAD	STEFLG		/0 OR 4000?(STARTF OR STARTE)
	SZA
	6567			/A MNEMONIC?
	CLA
	TAD	(APT
	IOF
	FPST		/START UP FPP
	JMP	.-1	/I HAVE NO IDEA WHY IT DIDN'T START
	CLA		/NECESSARY?
	JMS I	(HANG	/EXECUTE BACKGROUND
	FPUHNG
	FPRST		/READ FPP STATUS
	FPICL		/RESET FPP
	ION
	RTL
	SZL		/TEST TRAP BIT
	JMP	TRAP	/YUP - GO EXECUTE IT
	AND	(7400
	SZA		/ANY ERRORS?
	JMP	FPPER
	TAD	FSAVPC
	DCA	PC	/RESTORE OLD PC
	TAD	SAVAPT
	DCA	APT
	ISZ	FPGO
	JMP I	FPGO
/FLOATING POINT TRAP PROCESSOR

TRAP,	AC7775
	TAD	PC
	DCA	PC	/BACK UP PC TO BEFORE THE TRAP
	SZL
	STA
	TAD	APT	/INCLUDING THE FIELD BITS
	DCA	APT
	TAD	APT	/SET UP "FETPC" TO FETCH POSSIBLE TRAP ARGS
	JMS I	MCDF
	DCA I	(PCCDF
	JMS I	(FETPC
	DCA	T
	TAD	T	/GET TRAP WORD
	JMS I	MCDF
	IAC		/MAKE A "CDF CIF N"
	IAC
	DCA	TRPCIF
	JMS I	(FETPC
	DCA	ADR	/STORE PDP8-CODE ROUTINE ADDRESS
	TAD	T
TRPCIF,	HLT		/SET DATA AND INSTRUCTION FIELDS
	SMA CLA		/TRAP3 OR TRAP4?
	JMP I	ADR	/TRAP3 - GO TO ADR
	JMS I	ADR	/TRAP4 - CALL ADR
FPPRTN,	DCA	STEFLG
	ISZ	PC	/RESTORE PC FROM BEFORE TRAP
	SKP
	ISZ	APT	/INCLUDING FIELD
	CDF 0
	JMP	FPREST	/RESTART FPP

FPPER,	SPA
	JMP I	(FPPERR	/FPHALT - FATAL ERROR
	RTL
	ISZ	FATAL	/DIVIDE BY 0 AND OVERFLOW ARE NON-FATAL
	SZL
	JMP	FPDVER
FPOVER,	JMS I	ERR
	SKP
FPDVER,	JMS I	ERR
	TAD	.	/I ALWAYS WANTED TO INCLUDE ONE OF THESE!
	DCA	ACX
	AC2000
	DCA	ACH
	JMP	FPREST

FSAVPC,	0
SAVAPT,	0
STEFLG,	0
/RANDOM FPP CODE FOR D.P. I/O
DFSTM2,	FSTA+LONG
	DFTMP2
	FEXIT

	PAGE
/THIS IS DOUBLE PRECISION FORMATTED OUTPUT.
/ITS A LOT LIKE SINGLE PRECISION,WITHOUT ALL THE G + I STUFF
/AND, OH JOY!, NO PAGE 0 LITERALS.
DNXT,	TAD	RWFLAG		/READ OR WRITE?
	SMA CLA
	AC4000			/ITS INPUT SO LEAVE IN STARTE MODE
	JMS I	(GETLMN
	JMP	.+3
DFMT,	STA
BFMT,	DCA	EFLG
	TAD	D
	DCA	OD		/SAVE COUNT OF DIGITS AFTER DEC PT
	TAD	PFACT
	DCA	PFACTX
	DCA	SCALE
	JMS I	(SKPOUT		/DONE?
	JMP I	(DPIN		/ITS INPUT
	STA			/ITS OUTPUT
	DCA I	(FFNEG		/USE THIS LOCN AS SIGN FLAG
	TAD	EFLG
	CLL RAL
	CLL RAL
	TAD	W		/GIVE ROOM FOR EXP FIELD (IF ANY)
	CLL			/NECESSARY?
	DCA I	(OW
	TAD	ACH
	SNA
	JMP	SKPZRO		/IF AC 0,SKIP ALOT OF THIS
	SMA CLA
	JMP	DSCLUP
	JMS I	(DFNEG		/AC<0-NEGATE IT
	DCA I	(FFNEG		/ 0 <> 7777
DSCLUP,	DCA	SCALE
	TAD	ACX
	SMA SZA CLA		/AC<1.0?
	JMP	DGT1		/NO
	AC4000			/STARTE
	JMS I	(FPGO		/Y-MULT BY 10.
	FMUL10
	STA
	TAD	SCALE		/BUMP POWER OF TEN
	JMP	DSCLUP
DGT1,	JMS I	(DSCLDN		/NUMBER IS >=1.;NOW DECREASE IT TO (0,1)
	AC4000
	JMS I	(FPGO		/SAVE IT
	FSTTMP
	TAD	(22
	JMS I	(OSCALE
	AC4000
	JMS I	(FPGO
	FADTMP
	JMS I	(DSCLDN
SKPZRO,	JMS I	(DIGCNT		/NO NEED FOR ALL THE G STUFF TO BE
				/INCLUDED IN THE SINGLE PREC ROUTINE
				/MAKE NOTG ROUTINE A SUBROUTINE
	SMA			/EQUIV TO OUTNUM IN SINGLE PREC
	JMP	DASTRS
	JMS I	(OBLNKS	
	AC7775
	ISZ I	(FFNEG		/IF SIGN IS NEG,
	JMS I	(DIGIT		/PRINT A MINUS
	CLA
	TAD	ACX
	SNA			/ALIGN FAC MANTISSA INTO A
	JMS I	(DAL1		/FRACTION (.1,1)
	IAC
	SPA
	JMS I	(DACSR
	CLA
	TAD	EAC3
	DCA	AC1		/MOVE FAC DOWN SO OVERFLOW FROM
	TAD	EAC2		/MULT BY 10 IN HIGH ORDER WORD
	DCA	EAC3
	TAD	EAC1
	DCA	EAC2
	TAD	ACL
	DCA	EAC1
	TAD	ACH
	DCA	ACL
	TAD	SCALE
	SPA SNA			/ANY DIGITS TO LEFT OF DEC PT?
	JMP I	(DPRZRO		/N-PRINT A 0
/JUST AS CHEAP TO  DUPLICATE CODE
	JMS I	(DBLDIG		/Y- PRINT THEM
DRDCPT,	AC7776
	JMS I	(DIGIT		/PRINT A DEC PT
	TAD	SCALE
	SMA CLA			/NEED LEADING ZEROS?
	JMP	DNOLZR		/NO
	TAD	SCALE
	DCA	T
DLZERO,	STA CLL
	TAD	OD		/DECREASE D VALUE
	SNL
	JMP	DNOMAC		/NO MORE FIELD WIDTH AVAILABLE
	DCA	OD
	JMS I	(DIGIT		/PRINT A 0
	ISZ	T		/CONT UNTIL COUNT OR WIDTH RUNS OUT
	JMP	DLZERO
DNOLZR,	TAD	OD
	SZA
	JMS I	(DBLDIG		/PRINT REMAINING DIGITS
DNOMAC,	CLA
	TAD	EFLG
	SZA		/IF EFLG IS NOT ZERO IT IS -1,
	JMS I	(EXPFLD	/SO WE WILL PRINT A D INSTEAD OF AN E
	JMP I	(DNXT

DASTRS,	CLA
	TAD	W
	JMS I	(ASTRSK
	JMP I	(DNXT
	PAGE
DBLDIG,	0			/OUTPUT DIGITS
	CIA
	DCA	T
DBDLOP,	DCA	ACH		/0 THE HI WORD FOR OVERFLO
	TAD	AC1
	DCA	AC2		/START TO COPY THE FAC.THIS IS
	TAD	ACL	/EAC3 SHIFTED DOWN 1 WORD
	DCA	OPL
	TAD	EAC1
	DCA	L1	/ACL
	TAD	EAC2
	DCA	DACSR	/EAC1
	TAD	EAC3
	DCA	DSCLDN	/EAC2
	JMS	DAL1
	JMS	DAL1
	CLL
	TAD	AC2
	TAD	AC1
	DCA	AC1		/THIS IS FAC*5 COMING UP
	RAL
	TAD	DSCLDN
	TAD	EAC3
	DCA	EAC3
	RAL
	TAD	DACSR
	TAD	EAC2
	DCA	EAC2
	RAL
	TAD	L1
	TAD	EAC1
	DCA	EAC1
	RAL
	TAD	OPL
	TAD	ACL
	DCA	ACL
	RAL
	TAD	ACH
	DCA	ACH
	JMS	DAL1
	TAD	ACH
	JMS I	(DIGIT
	ISZ	T
	JMP	DBDLOP
	JMP I	DBLDIG
DSCLDN,	0			/USED AS A TEMP TOO
	TAD	ACX
	SPA SNA CLA
	JMP I	DSCLDN		/DONE IF FAC<1.
	AC4000
	JMS I	(FPGO
	FDIV10
	ISZ	SCALE
	0			/A FREE LOCN!
	JMP	DSCLDN+1

DPRZRO,	CLA
	JMS I	(DIGIT
	JMP I	(DRDCPT
/6 WORD FAC LEFT SHIFT
DAL1,	0
	TAD	AC1		/GET OVERFLO BIT
	CLL RAL			/SHIFT LEFT
	DCA	AC1
	TAD	EAC3		/CONTINUE WORKING WAY UP THRU MANTISSA
	RAL
	DCA	EAC3
	TAD	EAC2
	RAL
	DCA	EAC2
	TAD	EAC1
	RAL
	DCA	EAC1
	TAD	ACL
	RAL
	DCA	ACL
	TAD	ACH
	RAL
	DCA	ACH
	JMP I	DAL1

DFLTM2,	FLDA+LONG
	DFTMP2
	FEXIT
DFTMP2,	0;0;0;0;0;0
/6 WORD FAC RIGHT SHIFT. ENTER WITH COUNT-1 IN AC
/
DACSR,	0			/USED AS A TEMP BY DBDLOP
	DCA	AC0		/STORE COUNT
DLOP1,	TAD	ACH
	CLL
	SPA			/PROPOGATE SIGN
	CML
	RAR
	DCA	ACH		/SHIFT RIGHT 1,PROPOGATE SIGN
	TAD	ACL		/DO SHIFTING FOR EACH WORD OF MANTISSA
	RAR
	DCA	ACL
	TAD	EAC1
	RAR
	DCA	EAC1
	TAD	EAC2
	RAR
	DCA	EAC2
	TAD	EAC3
	RAR
	DCA	EAC3
	ISZ	ACX		/INCREMENT EXPONENT
	NOP
	ISZ	AC0		/DONE?
	JMP	DLOP1		/NOPE
	RAR			/YUP
	DCA	AC1		/SAVE 1 BIT OF OVERFLOW
	JMP I	DACSR
L1,	0
	PAGE
/THIS IS DOUBLE PRECISION INPUT (WITH FPP ONLY)
/IT IS A LOT LIKE SINGLE PRECISION INPUT, BUT USES
/ITS OWN FPP ROUTINES.
DPIN,	STA
	DCA	DDPSW		/INITIALIZE DEC. PT. SWITCH
	STA
	DCA	DINESW		/AND EXPONENT SWITCH
	TAD	W
	CMA
	DCA	FMTNUM		/CHAR COUNT
DINESM,	DCA	ACX		/CLEAR FLOATING AC
	DCA	ACH
	DCA	ACL
	DCA	EAC1
	DCA	EAC2
	DCA	EAC3
	STA
DINMIN,	DCA	DFNEG
DINLOP,	ISZ	FMTNUM
	JMP	DINGCH		/LOOP UNTIL WIDTH EXHAUSTED
DINENM,	ISZ I	(DFNEG		/IS SIGN NEGATIVE?
	JMS I	(DFNEG		/YES-NEGATE
	ISZ	DINESW		/SEEN A D YET?
	JMP	DFIXUP		/YES-THIS IS EXP,NOT NUMBER
	TAD	PFACTX		/NO D- SCALE WITH P FACTOR
DSCLIN,	TAD	OD		/GET SCALING FACTOR
	STL
	SNA
	JMP I	(DNXT		/NO SCALING NEEDED
	SMA
	CIA CLL			/AC CONTAINS MAGNITUDE,LINK CONTAINS SIGN
	DCA	OD
	RTL
	RAL
	TAD	(FDIV10
	DCA	DIGFOP
	AC4000
	JMS I	(FPGO		/MULT OR DIVIDE BY 10
DIGFOP,	0
	ISZ	OD
	JMP	DIGFOP-2	/MULT OR DIV CORRECT NUMBER OF TIMES
	JMP I	(DNXT		/GET MORE
DIND,	ISZ	DINESW		/IS THERE A 2ND D?
	JMP	DINER		/Y-A NO-NO
	ISZ	DDPSW		/FORCE DEC. PT. SWITCH ON
	TAD	OD		/USE SCALE FACTOR IF SEEN DEC. PT
	DCA	SCALE		/SAVE SCALE FACTOR
	ISZ	DFNEG
	JMS 	DFNEG		/GET SIGN OF NUMBER
	AC4000
	JMS I	(FPGO		/SAVE IT TEMPORARILY
	DFSTM2
	JMP	DINESM		/GO COLLECT EXP
DFIXUP,	JMS I	(FFIX		/IS THIS OK FOR DBL PREC???
	TAD	ACI
	CIA
	TAD	SCALE		/ADD EXP TO DEC PT SCALE FACTOR
	DCA	OD
	AC4000
	JMS I	(FPGO
	DFLTM2			/GET NUMBER BACK IN FAC
	JMP	DSCLIN
DINGCH,	JMS I	(FMTIN		/GET A CHAR
	JMS I	(CHTYPE		/CLASSIFY IT
	1234;	DDIGIT
	-56;	DIDCPT		/.
	-53;	DINLOP		/+
	-55;	DINMIN		/-
	-4;	DIND		/D
	-5;	DIND		/E - BE FORGIVING
	-40;	DINLOP		/BLANK
	-54;	DINENM		/,
	0
DINER,	JMP I	(INER

DIDCPT,	DCA	OD		/ZERO COUNT OF DIGITS AFTER DEC PT
	ISZ	DDPSW		/TEST + SET DEC PT SWITCH
	JMP	DINER		/2 DEC. PT. IS NO GOOD
	JMP	DINLOP
DDIGIT,	TAD	CHCH
	DCA I	(DGT+1		/SAVE DIGIT
	AC4000
	JMS I	(FPGO
	ACMDGT
	TAD	DDPSW
	SNA CLA
	ISZ 	OD		/BUMP DIGIT IF DEC PT SEEN
	JMP	DINLOP
DDPSW,	0
/6 WORD FLOATING NEGATE

DFNEG,	0
	TAD	EAC3
	CLL CMA IAC		/NEGATE LOW ORDER WORD OF MANTISSA
	DCA	EAC3		/STORE IT BACK
	CML RAL			/ADJUST OVERFLOW+CARRY
	TAD	EAC2		/CONTINUE WITH REST OF MANTISSA
	CMA IAC
	DCA	EAC2
	CML RAL
	TAD	EAC1
	CMA IAC
	DCA	EAC1
	CML RAL
	TAD	ACL
	CMA IAC
	DCA	ACL
	CML RAL
	TAD	ACH
	CLL CMA IAC
	DCA	ACH
	JMP I 	DFNEG
DINESW,	0
	PAGE
	*FPPKG		/EAE PKG LOADS OVER REGULAR PKG

LPBUF2,	ZBLOCK	16
	LPBUF5

AL1BMP,	0		/*K* MUST BE AT SAME LOC AS NON-EAE VERSION
	STA
	TAD	ACX
	DCA	ACX
	JMS I	(AL1
	JMP I	AL1BMP

/EAE FLOATING POINT INTERPRETER
/FOR PDP8/E WITH KE8-E EAE

/W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN

/FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE
/THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO
/A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY.
/(IN THE LOW ORDER, NATCHERLY)

DDMPY,	JMS I	(DARGET
	SKP
FFMPY,	JMS I	(ARGET
	JMS	EMDSET	/SET UP FOR MULT
	CLA	MUY	/MULTIPLY-LOW ORDER FAC STILL IN MQ
	OPH		/THIS IS PRODUCT OF LOW ORDERS
	MQL		/ZAP LOW ORDER RESULT-INSIGNIFICANT
	TAD	ACH	/GET LOW ORDER(!) OF FAC
	SWP	MUY	/TO MQ-HIGH ORD. RESLT OF LAST MPY
	OPL		/TO AC-WILL BE ADDED TO RESLT-THIS
	DST		/IS PRODUCT-LOW ORD FAC,HI ORD OP
	AC0		/STORE RESULT
	CLA
	TAD	ACL	/HIGH ORDER FAC TO MQ
	MQL
	TAD	OPX	/GET OPERAND EXPONENT
	TAD	ACX	/ADD FAC EXPONENT-GET SUM OF EXPS.
	DCA	ACX	/STORE RESULT
	MUY		/MUL. HIGH ORDER FAC BY LOW ORD OP.
	OPH		/HIGH ORDER FAC WAS IN MQ
	DAD		/ADD IN RESULT OF SECOND MULTIPLY
	AC0
	DCA	ACH	/STORE HIGH ORDER RESULT
	TAD	ACL	/GET HIGH ORDER FAC
	SWP		/SEND IT TO MQ AND LOW ORD. RESULT
	DCA	AC0	/OF ADD TO AC-STORE IT
	RAL		/ROTATE CARRY TO AC
	DCA	ACL	/STORE AWAY
	MUY		/NOW DO PRODUCT OF HIGH ORDERS
	OPL		/FAC HIGH IN MQ, OP HIGH IN OPL
	DAD		/ADD IN THE ACCUMULATED #
	ACH
/MULTIPLIES DONE - MASSAGE RESULT

	SNA		/ZERO?
	JMP	RTZRO	/YES-GO ZERO EXPONENT
	NMI		/NO-NORMALIZE (1 SHIFT AT MOST!)
	DCA	ACH	/STORE HIGH ORDER RESULT
	CLA	SCA	/GET STEP CNTR-DID WE NEED A SHIFT?
	SNA	CLA
	JMP	SNCK	/NO-JUST CHECK SIGN
	TAD	AC0	/YES - WATCH OUT FOR LOST ACCURACY!
	RAL
	DCA	AC0
	SZL		/IF HIGH ORDER BIT OF OVERFLOW WORD WAS ON,
	DPIC		/TURN MQ11 ON (IT WAS 0 FROM THE NMI)
	CLA	CMA	/MUST DECREASE EXP. BY 1
	TAD	ACX
RTZRO,	DCA	ACX	/STORE BACK
SNCK,	TAD	AC0
	SPA	CLA	/IS HIGH ORDER OF OVERFLO WD. 1?
	DPIC		/YES-ADD 1 TO LOW ORDER-STILL IN MQ
	TAD	ACH
	SMA
	JMP	EMDONE	/WE DIDN'T OVERROUND - GOODY
	LSR
	1		/BUT OVERROUNDING IS EASILY CORRECTED!
	ISZ	ACX	/    (OVERCORRECTED??)
	NOP

/COMMON CLEANUP ROUTINE FOR MULTIPLY AND DIVIDE

EMDONE,	ISZ	EMSIGN	/SHOULD SIGN BE MINUS?
	SKP		/NO
	DCM		/YES-DO IT
	SNA
	DCA	ACX	/FORCE EXPONENT 0 IF MANTISSA = 0
	DCA	ACH	/STORE IT BACK
	SWP
	DCA	ACL
	TAD	DFLG
	SMA SZA CLA
	TAD	ACX	/IF D.P. INTEGER MODE AND ACX LESS THAN 0,
	SNA		/GO TO UNNORMALIZE RESULT
	JMP I	FPNXT	/OTHERWISE BUMP RETN. AND RETN.
	CMA
	JMS I	(ACSR
	JMP I	FPNXT
EMSIGN,	0
/ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE

EMDSET,	0
	CLA CLL CMA RAL	/MAKE A MINUS TWO
	DCA	EMSIGN	/AND STORE IN EMSIGN.
	DLD		/GET HIGH ORDER MANTISSA OF OP.
	OPH
	SWP
	SMA		/NEGATIVE?
	JMP	.+3	/NO
	DCM		/YES-NEGATE IT
	ISZ	EMSIGN	/BUMP SIGN COUNTER
	SHL		/SHIFT OPRND LEFT 1 TO AVOID OVRFLO
	1
	DST		/STORE BACK-OPH CONTAINS LOW ORDER
	OPH		/	    OPL CONTAINS HIGH ORDER
	DLD
	ACH
	SWP
	SMA		/FAC LESS THAN 0?
	JMP	.+4	/NO
	DCM
	ISZ	EMSIGN
	NOP		/EMSIGN MAY BUMP TO 0
	DST		/STORE BACK - ACH CONTAINS LOW  ORDER
	ACH		/             ACL CONTAINS HIGH ORDER
	JMP I	EMDSET
	PAGE
/FLOATING DIVIDE-BY-0 ROUTINE - MUST BE AT 0 IN PAGE

DBAD,	ISZ	FATAL	/DIVIDE BY 0 NON-FATAL
	JMS I	ERR
	TAD	DBAD
	DCA	ACX	/SET AC TO A LARGE POSITIVE NUMBER
	AC2000
	JMP I	(EMDONE

/FLOATING DIVIDE

DDDIV,	JMS I	(DARGET
	SKP
FFDIV,	JMS I	(ARGET
	JMS I	(EMDSET	/GET ARG. AND SET UP SIGNS
	DVI		/DIVIDE-ACH AND ACL IN AC,MQ
	OPL		/THIS IS HI (!) ORDER DIVISOR
	DST		/QUOT TO AC0,REM TO AC1
	AC0
	SZL	CLA	/DIVIDE ERROR?
	JMP	DBAD	/YES - HANDLE IT
	TAD	OPX	/DO EXPONENT CALCULATION
	CMA	IAC	/EXP. OF FAC - EXP. OF OP
	TAD	ACX
	DCA	ACX
	DPSZ		/IS QUOT = 0?
	SKP		/NO-GO ON
	DCA	ACX	/YES-ZERO EXPONENT
DVLP,	MUY		/NO-THIS IS Q*OPL*2**-12
	OPH
	DCM		/NEGATE IT
	TAD	AC1	/SEE IF GREATER THAN REMAINDER
	SNL
	JMP	EDVOPS	/YES-ADJUST FIRST DIVIDE
	DVI		/NO-DO Q*OPL*2**-12/OPH
	OPL
	SZL	CLA	/DIV ERROR?
	JMP	DBAD	/YES
EDVLP1,	TAD	AC0	/NO-GET QUOT OF FIRST DIV.
	SMA		/NEGATIVE?
	JMP I	(EMDONE	/NO-REMEMBER-QUOT OF 2ND DIV. IN MQ
	LSR		/YES-MUST SHIFT IT RIGHT 1
	1
	ISZ	ACX	/ADJUST EXPONENT
	NOP
	SGT		/TEST SHIFTED OUT BIT
	JMP I	(EMDONE	/ZERO - NO ROUND
	DPIC		/BUMP AC FRACTION
	JMP	EDVLP1+1	/MAYBE SHIFT AGAIN
/CONTINUATION OF DIVIDE ROUTINE
/WE ARE ADJUSTING THE RESULT OF THE
/FIRST DIVIDE.

EDVOPS,	CMA	IAC
	DCA	AC1	/ADJUST REMAINDER
	TAD	OPL	/WATCH FOR OVERFLOW
	CLL CMA IAC
	TAD	AC1
	SNL
	JMP	EDVOP1	/DON'T ADJUST QUOT.
	DCA	AC1
	CMA
	TAD	AC0
	DCA	AC0	/REDUCE QUOT BY 1
EDVOP1,	CLA	CLL
	TAD	AC1	/GET REMAINDER
	SNA		/ZERO?
	CAM		/YES-ZERO EVERYTHING
	DVI		/NO
	OPL
	SZL	CLA	/DIV. OVERFLOW?
	JMP	DBAD	/YES
	DCM		/NO-ADJUST HI QUOT (MAYBE)
	JMP	EDVLP1	/GO BACK

/ROUTINE TO NORMALIZE THE FAC

EFFNOR,	0
	CDF 0
	DLD		/PICK UP MANTISSA
	ACH
	SWP		/PUT IT IN CORRECT ORDER
	NMI		/NORMALIZE IT
	SNA		/IS THE # ZERO?
	DCA	ACX	/YES-INSURE ZERO EXPONENT
	DCA	ACH	/STORE HIGH ORDER BACK
	SWP		/STORE LOW ORDER BACK
	DCA	ACL
	CLA	SCA	/STEP COUNTER TO AC
	CMA	IAC	/NEGATE IT
	TAD	ACX	/AND ADJUST EXPONENT
	DCA	ACX
	JMP I	EFFNOR	/RETURN

ADDRS,	OPH
	ACH

LPBUF5,	ZBLOCK	50
	LPBUF7
	PAGE
/"OPNEG" MUST BE AT 0 IN PAGE

OPNEG,	0		/ROUTINE TO NEGATE OPERAND
	DLD
	OPH
	SWP
	DCM
	DCA	OPH
	MQA
	DCA	OPL
	JMP I	OPNEG

/FLOATING ADD AND SUBTRACT-IN ORDER NOT TO LOSE BITS,
/WE DO NOT SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD-
/ONLY SHIFTS DONE ARE TO ALIGN EXPONENTS.

FFSUB,	JMS I	(ARGET
	JMS	OPNEG	/NEGATE OPERAND
	SKP
FFADD,	JMS I	(ARGET	/PICK UP ARGUMENTS
	TAD	OPH
	SNA CLA		/IF OPERAND IS 0,
	JMP I	FPNXT	/RESULT IS ALREADY IN AC.
	TAD	ACH
	SZA CLA		/CHECK FOR AC=0
	JMP	BOTHN0	/NO
	DLD
	OPH		/YES - ANSWER IS OPERAND
	SWP
	DCA	ACH
	JMP	FADND	/JUMP INTO CLEANUP CODE
BOTHN0,	TAD	OPX	/PICK UP EXPONENT OF OPERAND
	MQL		/SEND IT TO MQ FOR SUBTRACT
	TAD	ACX	/GET EXPONENT OF FAC
	SAM		/SUBTRACT-RESULT IN AC
	SPA		/NEGATIVE RESULT?
	CMA	IAC	/YES-MAKE IT POSITIVE
	DCA	CNT	/STORE IT AS A SHIFT COUNT
	TAD	CNT	/COUNT TOO BIG?(CAN'T BE ALIGNED)
	TAD	(-27
	SPA SNA CLA
	CMA		/NO-OK
	DCA	AC0	/YES-MAKE IT A LOAD OF LARGEST #
	DLD		/GET ADDRESSES TO SEE WHO'S SHIFTED
	ADDRS
	SGT		/WHICH EXP GREATER(GT FLG SET
			/BY SUBTR. OF EXPS.)
	SWP		/OPERAND'S-SHIFT THE FAC
	DCA	SHFBG	/STORE ADDRESS OF WHO GETS SHIFTED
	SWP		/GET ADDRESS OF OTHER (0 TO MQ)
	DCA	DADR	/THIS ONE JUST GETS ADDED
	TAD	ACX	/GET FAC EXP.INTO AC
	SGT		/WHICH EXPONENT WAS GREATER?
	DCA	OPX	/FAC'S-STORE FINAL EXP. IN OPX
	DLD		/GET THE LARGER # TO AC,MQ
DADR,	0
	SWP		/PUT IN THE RIGHT ORDER
	ISZ	AC0	/COULD EXPONENTS BE ALIGNED?
	JMP	LOD	/NO-JUST LEAVE LARGER IN AC,MQ
	DST		/YES-STORE THIS TEMPORARILY
	AC0		/(IF ONLY FAC STORAGE WAS REVERSED)
	DLD		/GET THE SMALLER #
SHFBG,	0
	SWP		/PUT IT IN RIGHT ORDER
	ASR		/DO THE ALIGNMENT SHIFT
CNT,	0
	DAD		/ADD THE LARGER #
	AC0
	DST		/STORE RESULT
	AC0
	SZL		/OVERFLOW?(L NOT = SIGN BIT)
	CMA		/NOTE-WE DIDN'T SHIFT BOTH RIGHT 1
	SMA	CLA
	JMP	NOOV	/NOPE
	CLA CLL CML RAR	/MAYBE-SEE IF 2 #S HAD SAME SIGN
	AND	ACH
	TAD	OPH
	SMA	CLA	/SIGNS ALIKE?
	JMP	OVRFLO	/YES-OVERFLOW
NOOV,	AC4000		/NO-GET HIGH ORDER RESULT BACK
	TAD	AC1	/CHECK FOR 4000 0000 MANTISSA
	DPSZ		/IT WILL BE SET TO 0 BY NMI
	JMP	.+3	/OK-RESTORE NUMBER
	AC2000		/GOT A 4000 0000-SET TO 6000 0000
	JMP	DOIT	/AND INCREMENT EXPONENT
	TAD	(4000	/RESTORE NUMBER
LOD,	NMI		/NORMALIZE (LOW ORDER STILL IN MQ)
	DCA	ACH	/STORE FINAL RESULT
	SCA		/GET SHIFT COUNTER(# OF NMI SHIFTS)
	CMA		/NEGATE IT
ADON,	IAC
FADND,	TAD	OPX	/AND ADJUST FINAL EXPONENT
	DCA	ACX
	SWP		/GET AND STORE LOW ORDER
	DCA	ACL
	JMP I	FPNXT	/RETURN
OVRFLO,	TAD	AC1	/OVERFLOW-GET HIGH ORDER RESLT BACK
	ASR		/SHIFT IT RIGHT 1
	1
DOIT,	TAD	(4000	/REVERSE SIGN BIT
	DCA	ACH	/AND STORE
	JMP	ADON	/DONE

LPBUF7,	ZBLOCK	34
	LPBUFE
	PAGE
	*7400		/RTS CLEANUP ROUTINE - SAVED WITH PG 17600

CLNUP,	DCA I	CFPTR	/ENTER HERE ON ^C OR ERROR
TDEXFG,	JMP	CTMP	/ENTER HERE ON "STOP" OR "CALL EXIT"
	TAD	TDEXFG	/TDEXFG CONTAINS TOP MEM FIELD
	CLL RTL		/IF WE ARE ON AN IN-CORE TD8E CONFIGURATION
	RAL
	TAD	(CDF
	DCA	TDGTDF
TDGTDF,	HLT
	TAD I	TDPTR	/MOVE THE TD8E ROUTINE
	CDF 20
	DCA I	TDPTR	/DOWN TO FIELD 2
	ISZ	TDPTR
	JMP	TDGTDF
	CDF 0
	TAD	(CIF 20
	JMS	TDSET	/RESET THE F0 CDF'S TO POINT TO FIELD 2
CTMP,	CDF 0
	TAD	(6213
	DCA I	(7605
	TAD	(5267
	DCA I	(7606	/RESTORE PAGE 7600
	AC7776
	AND I	(OSJSWD
	IAC
	DCA I	(OSJSWD	/MARK 10000-11777 AS USELESS
	AND I	0
	AND I	0	/DELAY A WHILE IN CASE ITS AN LA30
	AND I	0
	AND I	0
	AND I	0
	TSF
	SKP
	JMP	WTOVR
	ISZ	ZERO
	TAD I	(TOCHR	/IF TTY IS NOT IDLE,
	SZA CLA		/DELAY LONG ENOUGH TO AVOID GARBLE.
	JMP	CTMP
WTOVR,	TAD I	(7777
	CLL RAL
	SMA CLA		/IS BATCH EXECUTING?
	JMP	NOBTCH	/NO - RELAX
	TAD	(212	/TO PREVENT OVERPRINTING, POP UP A LINE
	TLS		/ON THE TELETYPE
	LLS		/AND ON THE LINE PRINTER
	TSF
	JMP	.-1	/WAIT FOR THE SLOWER ONE (I HOPE)
	CLA
NOBTCH,	CDF 10
CLOSLP,	TAD I	CFPTR
	SNA		/ANY MORE ENTRIES IN THE TENTATIVE
	JMP	GOAWAY	/FILE TABLE?
	DCA	CTMP	/YES - SAVE FILE LENGTH PTR
	CDF 0
	TAD I	CTMP
	CDF 10
	SNA
	JMP	IGNORC	/UNWRITTEN FILES AREN'T CLOSED
	DCA	FLEN
	JMS I	USR
	10		/BRING USR IN
	TAD	(200
	DCA	USR	/KEEP IT IN
	TAD	(HPLACE+1
	DCA	CHAND
	JMS I	USR
	13		/RESET DEVICE HANDLER TABLE
	0		/BUT NOT TENTATIVE FILES!
	ISZ	CFPTR
	TAD I	CFPTR	/GET UNIT NUMBER
	JMS I	USR
	1
CHAND,	0		/FETCH HANDLER
	JMP	CLSERR
	TAD I	CFPTR	/GET UNIT AGAIN
	ISZ	CFPTR	/BUMP PTR TO NAME
	JMS I	USR
C4,	4
CFPTR,	7600		/CLOSE THE FILE
FLEN,	0
	JMP	CLSERR
	SKP
IGNORC,	AC0002
	TAD	CFPTR
	TAD	C4
	DCA	CFPTR
	JMP	CLOSLP	/LOOK FOR MORE

TDSET,	0
	DCA I	(7721
	TAD I	(7721
	DCA I	(7727
	TAD I	(7721
	IAC
	DCA I	(7642
	JMP I	TDSET
GOAWAY,	CDF CIF 0
	JMP I	(7605	/RETURN TO OS/8 AQAP
CLSERR,	JMS I	USR	/"IMPOSSIBLE" ERROR - GIVE "USER ERROR 2"
	7
	2		/IT'S BETTER THAN HALTING

TDPTR,	7600
ZERO,	0
USR,	7700
	$$$-$$$-$$$


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RTS.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789

/FORTRAN IV RUNTIME SYSTEM, V5A
/
/
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1974,1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
/SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
/AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/
/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMRNT COROPATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
/
/
/
/
/
/FORTRAN 4 RUNTIME SYSTEM - R.LARY
/AND NOW WITH DOUBLE PRECISION! - MKH
/RTS-8 SUPPORT ADDED 5/20/74 - RL
/LAST EDITED 5/19/74

XVERSN=5		/UPDATE WITH EVERY RELEASE!
XPATCH="A		/PATCH LEVEL A

/NOTES TO MAINTAINERS:

/THIS PROGRAM IS DESIGNED TO SUPPORT MANY DIFFERENT HARDWARE
/CONFIGURATIONS IN A MINIMAL AMOUNT OF SPACE.  IT ACHIEVES THIS GOAL
/BY "TAILORING" ITSELF AT INITIALIZATION TIME
/BASED ON A SURVEY OF ITS HARDWARE/SOFTWARE ENVIRONMENT.  THIS MAKES
/THIS PROGRAM DIFFICULT TO MODIFY UNLESS THE MODIFYING PROGRAMMER
/KNOWS WHAT IS GOING ON.  IT IS THEREFORE SUGGESTED THAT YOU READ THIS
/LISTING THOROUGHLY AND UNDERSTAND THE MAJOR ROUTINES BEFORE
/MAKING EVEN "TRIVIAL" CHANGES.

/ALL SYMBOLS BEGINNING WITH THE LETTER "Q" ARE ENTRIES IN THE
/HEADER BLOCK OF THE LOADER-IMAGE (.LD) FILE.

/ALL SYMBOLS BEGINNING WITH THE LETTER "Y" DENOTE THE BEGINNING OF
/A BLOCK OF CODE WHICH WILL BE REPLACED BY DIFFERENT CODE IF FRTS
/IS RUNNING IN THE BACKGROUND UNDER RTS-8.  THE REPLACEMENT CODE
/CAN BE FOUND IN THE TABLE "BKRLST".

/ALL SYMBOLS BEGINNING WITH THE LETTER "V" ARE DEFINED IN THE LOADER
/SYMBOL TABLE AND CANNOT BE MOVED WITHOUT CHANGING THE LOADER. ONLY
/A VERY FEW OF THESE SYMBOLS OCCUR IN PLACES OTHER THAN
/PAGE 200 OR THE FIRST LOCATION OF OTHER PAGES.

/CODE WHICH CONTAINS THE CHARACTER SEQUENCE "*K*" IN THE COMMENT FIELD
/IS PARTICULARLY SUBTLE/OBSCURE (THE "K" IS FOR "KLUDGE").  THE REST OF THE
/COMMENT SHOULD INDICATE WHAT IS GOING ON.
/
/
/ FIXES FOR V4	J.K.	1975
/
/ .SCALE FACTOR PRINTED BY P FORMAT OPERATOR
/ .FRTS /P
/ .RK8E HANDLER TO RUN WITH INTERRUPTS ON
/ .SLASH AT END OF FORMAT STATEMENT
/
/
/	CHANGES FOR OS/78 AND OS/8 V3D BY P.T.
/	.CHANGED THE VERSION NUMBER TO 5A
/	.FIXED THE FIELD OVERFLOW PROBLEM
/	.FIXED THE "K=K+1" PROBLEM
/DEFINITIONS:

AC7775=	STA CLL RTL
AC7776=	STA CLL RAL
AC4000=	CLA STL RAR
AC3777=	STA CLL RAR
AC2000=	CLA STL RTR
AC0002=	CLA STL RTL

/DEFINITIONS OF KE-8/E INSTRUCTIONS

MQL=	7421
MQA=	7501
CAM=	CLA MQL
SWP=	MQA MQL
SWAB=	7431
SCA=	7441
MUY=	7405
DVI=	7407
NMI=	7411
SHL=	7413
ASR=	7415
LSR=	7417
ACS=	7403
SAM=	7457
DAD=	7443
DLD=	7663
DST=	7445
DPIC=	7573
DCM=	7575
DPSZ=	7451
SGT=	6006

/DEFINITIONS OF FPP IOT'S

FPINT=	6551
FPICL=	6552
FPCOM=	6553
FPHLT=	6554
FPST=	6555
FPRST=	6556
/FPP OPCODES:

FLDA=	0000
FADD=	1000
FSUB=	2000
FDIV=	3000
FMUL=	4000
FADDM=	5000
FSTA=	6000
FMULM=	7000
		LONG=	400	/TWO-WORD ADDRESSING
		BASE=	200	/BASEPAGE ADDRESSING
		IND=	600	/INDIRECT ADDRESSING

FEXIT=	0000
FNORM=	0004
STARTF=	0005
STARTD=	0006
JAC=	0007
XTA=	0030
STARTE=	0050
LDX=	0100

JA=	1030
JNE=	1040
TRAP3=	3000

/OS8 EQUIVALENCES:

OS8SWS=	7643
OSJSWD=	7746
OS8DVT=	7647
OS8DCB=	7760
OS8DAT=	7666

/VARIOUS OTHER IOT'S:

LSF=	6661
LCF=	6662
LSE=	6663
LIE=	6665
LLS=	6666
LIF=	6667
/PAGE ZERO FOR FORTRAN IV RTS

	*0		/INTERRUPT STUFF
	0
	JMP I	.+1
	INTRPT
LPGET,	LPBUFR		/LINE PRINTER RING BUFFER FETCH POINTER
TOCHR,	0		/TELETYPE STATUS WORD
KBDCHR,	0		/KEYBOARD INPUT CHARACTER
POCHR,	0		/P.T. PUNCH COMPLETION FLAG
RDRCHR,	0		/P.T. READER STATUS
FMTPXR,	0		/XR USED TO INDEX FORMAT PARENTHESIS ARRAY
INXR,	INBUFR-1	/XR USED TO GET CHARS FROM INPUT LINE
XR,	0
XR1,	0

*16
VEOFSW,	0		/USED BY "EOFCHK" TO STORE VARIABLE ADDRESS
	0		/*K* MUST BE IN AUTO - XR
T,	0		/TEMPORARY
DFLG,	0		/0 = F.P., 1 = D.P.
INST,	0		/CURRENT INSTRUCTION WORD

/IOH PAGE ZERO LOCATIONS

RWFLAG,	0		/READ/WRITE FLAG
FMTTYP,	0		/TYPE OF CONVERSION BEING DONE
EOLSW,	0		/EOL SW ON INPUT - CHAR POS ON OUTPUT
N,	0		/REPEAT FACTOR
W,	0		/FIELD WIDTH
D,	0		/NUMBER OF PLACES AFTER DECIMAL POINT

DATCDF,	0		/SUBROUTINE TO CHANGE DATA FIELD
DATAF,	0		/CONTAINS VARIOUS CDF'S
	JMP I	DATCDF	/RETURN

ERR,	ERROR		/POINTER TO ERROR ROUTINE
FATAL,	0		/FATAL ERROR FLAG - 0=FATAL
MCDF,	MAKCDF

/FPP PARAMETER TABLE LOCATIONS:

APT,	0		/VARIOUS FIELD BITS FOR FPP
PC,	DPTEST		/FPP PROGRAM COUNTER
XRBASE,	0		/FPP INDEX REGISTER ARRAY ADDRESS
BASADR,	0		/FPP BASE PAGE ADDRESS
ADR,	0		/ADDRESS TEMPORARY
ACX,	0
ACH,	0		/*** FLOATING ACCUMULATOR ***
ACL,	0
EAC1,	0
EAC2,	0		/** FOR EXTENDED PRECISION OPTION **
EAC3,	0
/FLOATING POINT PACKAGE LOCATIONS

AC0,	0
AC1,	0		/FLOATING AC OVERFLOW WORD
AC2,	0		/OPERAND OVFLOW WORD
OPX,	0
OPH,	0		/*** FLOATING OPERAND REGISTER ***
OPL,	0

/RTS I/O CONVERSION SYSTEM LOCATIONS

FMTBYT,	0		/FORMAT BYTE POINTER
IFLG,	0		/I FOEMAT FLAG
GFLG,	0		/G FORMAT FLAG
EFLG,	0		/E FORMAT FLAG - SOMETIMES ON FOR G FMT
OD,	0
SCALE,	0
PFACT,	0		/P-SCALE FACTOR
PFACTX,	0		/TEMP FOR PFACT
ACI,	0		/INTEGERIZED FAC FROM "FFIX" SUBR
CHCH,	0
FMTNUM,	0		/CONTAINS ACCUMULATED NUMERIC VALUE
CTCINH,	0		/^C INHIBIT FLAG
LOGUNT,	0		/DSRN POINTER - ONLY USED FROM ONE PAGE!
PTTY,	TTY		/POINTER TO TTY HANDLER - USED BY LDDSRN
	0		/ SO FORMS CONTROL WILL WORK ON UNIT 0
FPNXT,	ICYCLE		/USED AS INTERPRETER ADDRESS IF NO FPP

/DSRN IMAGE

HAND,	0		/HANDLER ENTRY POINT
HCODEW,	0		/HANDLER LOAD ADDR & FIELD + IOFFLG + FORMS CTL FLG
BADFLD,	0		/BUFFER ADDRESS AND FIELD
CHRPTR,	0		/ACTUALLY A WORD POINTER
CHRCTR,	0		/COUNTER - RANGES FROM -3 TO -1
STBLK,	0		/STARTING BLOCK OF FILE
RELBLK,	0		/CURRENT RELATIVE BLOCK NUMBER
TOTBLK,	0		/LENGTH OF FILE
FFLAGS,	0		/FILE FLAGS:
			/BIT 0 - "HAS BEEN WRITTEN" FLAG
			/BITS 1-2 - FORMATTED/UNFORMATTED FLAGS
			/BIT 11 - "END-FILED" FLAG

BUFFLD,	0		/ROUTINE TO SET DF TO BUFFER FIELD
BUFCDF,	HLT
	JMP I	BUFFLD

FADD1,	FADD+LONG	/FPP CODE TO ADD 1.0 TO FAC
	ONE		/AND FALL INTO STORE CODE
FGPBF,	0		/THESE THREE WORDS ARE USED
BIOPTR,	0		/TO FETCH AND STORE FLOATING POINT NUMBERS
	FEXIT		/FROM RANDOM MEMORY
	PAGE
/STARTUP CODE

FTEMP2,	ISZ	.+3	/ALSO USED AS I/O F.P. TEMPORARY
	CDF CIF 10
	JMP I	.+1
VDATE,	RTSLDR		/USED TO STORE OS/8 DATE

/RTS ENTRY POINTS - "VERSION INDEPENDENT"

VUERR,	JMP I	(USRERR	/USER ERROR
			/** LOADER MUST DEFINE #ARGER AS VARGER-1 **
VARGER,	JMS I	ERR	/LIBRARY ARGUMENT ERROR
VRENDO,	ISZ	RWFLAG	/END OF I/O LIST
VRFSV,	JMP I	GETLMN	/I/O LIST ARG ENTRY - COROUTINE WITH GETLMN
VBAK,	JMP I	(BKSPC	/"BACKSPACE" ROUTINE
VENDF,	JMP I	(ENDFL	/"END FILE" ROUTINE
VREW,	JMP I	(RWIND	/"REWIND" ROUTINE
VDEF,	JMP I	(DFINE	/"DEFINE FILE" ROUTINE
VWUO,	AC4000		/UNFORMATTED WRITE
VRUO,	JMP I	(RWUNF	/UNFORMATTED READ
VWDAO,	AC4000		/DIRECT ACCESS WRITE
VRDAO,	JMP I	(RWDACC	/DIRECT ACCESS READ
VWRITO,	AC4000		/FORMATTED (ASCII) WRITE
VREADO,	JMP I	(RWASCI	/FORMATTED (ASCII) READ
VSWAP,	JMP I	(SWAP	/OVERLAY PROCESSOR
VEXIT,	TRAP3;	CALXIT	/"STOP" ROUTINE - ENTERED IN FPP MODE
V8OR12,	0;0		/0;1 IF CPU IS A PDP-12
VBACKG,	JMP I	(NULLJB	/BACKGROUND JOB DISPATCHER
	0
	CDF CIF 0	/USED BY ROUTINE "ONQB" IN LIBRARY
	JMS I	.-2
	JMP	VBACKG

/IOH GET VARIABLE ROUTINE.
/THIS ROUTINE MAKES THE FORMATTED I/O PROCESSOR AND THE USER'S
/PROGRAM CO-ROUTINES (DEF(COROUTINE)= 2 ROUTINES EACH THINKING THE OTHER
/ IS A SUBROUTINE).  ON ENTRY FAC=INPUT NUMBER
/IF I/O IS A READ, ON RETURN FAC=OUTPUT NUMBER IF I/O IS A WRITE.

GETLMN,	0
VRETRN,	JMP I	[RETURN	/SHORT ROUTINE FOR ALL THOSE COMMENTS, NO?
/INTERRUPT DRIVEN I/O HANDLERS

LPT,	0		/RING-BUFFERED - LP08 OR LS8E
	AND	[377	/JUST IN CASE
LPTSNA,	SNA
	JMP I	(IOERR	/CANNOT BE USED FOR INPUT
YLPT,	IOF
	DCA I	LPPUT
	TAD	LPGET
	CIA
	TAD	LPPUT
	SZA CLA		/IS LPT QUIET?
	JMP	.+3	/NO
	TAD I	LPPUT
	LLS		/YES - START 'ER UP
	CLA IAC
	LIE		/ENABLE LPT INTERRUPTS
	TAD	LPPUT	/1 IN AC, REMEMBER?
	DCA	LPPUT
	TAD I	LPPUT
	SPA
	JMP	.-3	/NEGATIVE NUMBERS ARE BUFFER LINKS
	SZA CLA		/ANY ROOM LEFT IN BUFFER?
	JMS I	(HANG
	LPUHNG		/WAIT FOR LINE PRINTER
	ION		/TURN INTERRUPTS BACK ON
	JMP I	LPT	/RETURN

LPPUT,	LPBUFR

PTP,	0		/PAPER TAPE PUNCH HANDLER
YPTP,	SNA
	JMP I	(IOERR	/INPUT IS ERROR
	DCA	LPT	/SAVE CHAR
	IOF
	TAD	POCHR	/IF PUNCH IS NOT IDLE,
	SZA CLA		/WE DISMISS JOB
	JMS I	(HANG
	PPUHNG		/WAIT FOR PUNCH INTERRUPT
	TAD	LPT
	PLS		/OUTPUT CHAR
	DCA	POCHR	/SET FLAG NON-ZERO
	ION
	JMP I	PTP

/*K* THE FOLLOWING ADDRESSES GET FALLEN INTO & MUST BE SMALL

	IFNZRO	PPUHNG&7000	<__ERROR__>
	IFNZRO	TTUHNG&7000	<__ERROR__>
	IFNZRO	KBUHNG&7000	<__ERROR__>
	IFNZRO	RDUHNG&7000	<__ERROR__>
	IFNZRO	LPUHNG&7000	<__ERROR__>
/INTERRUPT-DRIVEN PTR AND TELETYPE HANDLER

PTR,	0		/CRUDE READER HANDLER
YPTR,	SZA CLA
	JMP I	(IOERR	/OUTPUT ILLEGAL TO PTR
	IOF
	RFC		/START READER
	JMS I	(HANG
	RDUHNG		/HANG UNTIL COMPLETE
	TAD	RDRCHR	/GET CHARACTER
	ION
	JMP I	PTR	/RETURN

TTY,	0		/BUFFERS 2 CHARS ON OUTPUT, 1 ON INPUT
YTTY,	IOF		/DELICATE CODE AHEAD
	SNA		/INPUT OR OUTPUT?
	JMP	KBD	/INPUT
	DCA	LPT	/OUTPUT - SAVE CHAR
	TAD	TOCHR	/GET TTY STATUS
	SMA SZA CLA	/G.T. 0 MEANS A CHAR IS BACKED UP
	JMS I	(HANG
	TTUHNG		/WAIT FOR LOG JAM TO CLEAR
	TAD	TOCHR	/NO CHAR BACKED UP - SEE IF TTY BUSY
	CLL RAL		/"BUSY" FLAG IN LINK - INTERRUPTS ARE OFF!
	CLA CML RAR	/COMPLEMENT OF BUSY IN SIGN
	TAD	LPT	/GET CHAR
	SPA		/IF TTY NOT BUSY,
	TLS		/OUTPUT CHAR
	DCA	TOCHR	/STORE POS OR NEG, BACKED UP OR BUSY
TTYRET,	ION		/TURN INTERRUPTS BACK ON
	JMP I	TTY	/AND LEAVE
KBD,	TAD	KBDCHR	/HAS A CHARACTER BEEN INPUT?
	SNA CLA
	JMS I	(HANG
	KBUHNG		/NO - RUN BACKGROUND UNTIL ONE IS
	TAD	KBDCHR	/GET CHARACTER
	DCA	LPT
	DCA	KBDCHR	/CHEAR CHARACTER BUFFER
	TAD	LPT
	JMP	TTYRET	/RETURN WITH INTERRUPTS ON

KILFPP,	FPHLT		/BRING FPP TO A SCREECHING HALT
	ISZ	.-1
	JMP	.-1	/WAIT FOR IT TO STOP
	FPICL		/CLEAN UP MESS HALT HAS MADE IN FPP
BEEORC,	SZL		/^C OR ^B?
	JMP I	(7600	/^C - HIYO SILVER, AWAY!
	KCC		/CLEAR KBD FLAG ON ^B
CTLBER,	JMS I	ERR	/*** THIS MAY BE DANGEROUS! **
	PAGE
/INTERRUPT SERVICE ROUTINES

INTRPT,	DCA	INTAC
	RAR
	DCA	INTLNK
VINT,	JMP	.+4	/** MUST BE AT 403 **
	IFNZRO	VINT-403	<___ CHANGE LOADER!!!>
	0
	CDF CIF 0	/USER INTERRUPT ROUTINE GOES HERE
	JMS I	.-2

	FPINT		/CHECK FOR FPP DONE
	JMP	LPTEST
FPUHNG,	JMP	DISMIS	/ALWAYS GOES TO RESTRT

VDISMS,	JMP	DISMIS	/FOR USE BY USERS
	JMP	DISMIS
	JMP	DISMIS

LPTEST,	LSF
	JMP	NOTLPT
LPTLCF,	LCF		/CLEAR FLAG
	TAD I	LPGET
	SNA CLA		/CHECK FOR SPURIOUS INTERRUPT
JMPDIS,	JMP	DISMIS	/GO AWAY IF SO
	DCA I	LPGET	/ZERO CHAR JUST OUTPUT
	ISZ	LPGET
	TAD I	LPGET
	SPA
	DCA	LPGET	/TAKE CARE OF BUFFER LINKS
	SNA
	TAD I	LPGET	/MAKE SURE CHAR IS IN AC
	SZA		/IS THERE A CHARACTER?
	LLS		/YES - PRINT IT
	CLA
	LSF		/CHECK FOR IMMEDIATE FLAG
LPUHNG,	JMP	DISMIS	/NO - MAYBE RESTART PROGRAM
	JMP	LPTLCF	/YES - LOOP

NOTLPT,	TSF		/CHECK TTY
	JMP	NOTTTY
	TCF		/CLEAR FLAG
	TAD	TOCHR	/GET TTY STATUS
	SMA SZA		/IF THERE IS A CHARACTER WAITING,
	TLS		/OUTPUT IT.
	SMA SZA CLA	/CHANGE "WAITING" TO "BUSY",
	STL RAR		/"BUSY" TO "IDLE".
	DCA	TOCHR
TTUHNG,	JMP	DISMIS
/KBD AND PTP INTERRUPTS

NOTTTY,	KSF
	JMP	NOTKBD
	TAD	[200
	KRS		/USE KRS TO FORCE PARITY BIT
	DCA	KBDCHR	/AND ALSO SO THAT ^C WILL STILL BE IN BUFFER IN OS/8
	TAD	KBDCHR
	TAD	(-202	/CHECK FOR ^C OR ^B
	CLL RAR
	SNA CLA
	JMP	CTCCTB	/YUP - TAKE SOME DRASTIC ACTION
	KCC		/DATA CHARACTER - CLEAR FLAG
KBUHNG,	JMP	DISMIS

CTCCTB,	TAD	CTCINH
	SNA CLA		/ARE WE IN A HANDLER?
	JMP	NOTINH	/NO
	TAD	INTLNK
	CLL RAL		/YES - RETURN WITH INTERRUPTS OFF
	TAD	INTAC	/TRUST IN GOD AND RTS
	RMF
	JMP I	0

NOTKBD,	PSF
	JMP	NOTPTP
	PCF		/P.T. PUNCH INTERRUPT - CLEAR FLAG
	DCA	POCHR	/CLEAR SOFTWARE FLAG
PPUHNG,	JMP	DISMIS

NOTPTP,	RSF
	JMP	LPTERR
	TAD	[200
	RRB		/GET RDR CHAR
	DCA	RDRCHR
RDUHNG,	JMP	DISMIS

LPTERR,	LSE		/TEST FOR LP08 ERROR FLAG
	SKP
	LIF		/DISABLE LP08 INTERRUPTS IF ERROR FLAG ON
DISMIS,	TAD	INTLNK
	CLL RAL
	TAD	INTAC	/RESTORE AC AND LINK
	RMF
	ION
	JMP I	0	/RETURN FROM THE INTERRUPT

INTAC,	0
INTLNK,	0
/BACKGROUND INITIATE/TERMINATE ROUTINE

HANG,	0		/ALWAYS CALLED WITH INTERRUPTS OFF!
	TAD I	HANG	/GET POINTER TO UNHANGING LOCATION
	DCA	UNHANG
	RDF		/GET FIELD CALLED FROM
	TAD	HCIDF0
	DCA	HNGCDF	/SAVE FOR RETURN
HCIDF0,	CDF CIF 0
	TAD	(JMP RESTRT	/CHANGE THE "JMP DISMIS" AT THAT LOC
	DCA I	UNHANG	/TO A "JMP RESTRT"
	TAD	BACKLK
	CLL RAL
	TAD	BACKAC	/SET UP BACKGROUND AC AND LINK
BAKCIF,	CIF 0
BAKCDF,	CDF 0
	ION
	JMP I	BACKPC	/INITIATE BACKGROUND

/	COME HERE WHEN THE HANG CONDITION HAS GONE AWAY

RESTRT,	TAD	JMPDIS	/RESTORE THE UNHANG LOCATION
	DCA I	UNHANG
	TAD	INTAC	/SUSPEND THE BACKGROUND
	DCA	BACKAC
	TAD	INTLNK
	DCA	BACKLK
	TAD	0
	DCA	BACKPC
	RIB
	AND	[70
	TAD	HCIDF0
	DCA	BAKCIF
	RIB
	JMS I	MCDF	/*K* OK SINCE BACKGROUND DOESN'T USE MAKCDF
	DCA	BAKCDF
	ISZ	HANG
HNGCDF,	HLT
	JMP I	HANG	/INTERRUPTS ARE OFF - RETURN

NOTINH,	TAD	JMPDIS	/IN CASE WE WERE HUNG, WE DON'T WANT
	DCA I	UNHANG	/TO GET "UNHUNG" OUT OF THE ERROR ROUTINE!
	JMP I	(KILFPP	/KILL FPP AND GO TO EXIT OR ERROR

UNHANG,	0
BACKAC,	0
BACKLK,	0
BACKPC,	VBACKG
VHANG=	HANG
	IFNZRO	VHANG-0524	<__ CHANGE LOADER!>
	PAGE
/I-O CONVERSION ROUTINES - STARTUP CODE

RWASCI,	JMS I	[RWINIT	/"READ(N,FMT)" OR "WRITE(N,FMT)"
	2000		/"FORMATTED" BIT
	JMS I	[FETPC	/GET ADDRESS OF FORMAT STMT
	DCA	FMTDF
	JMS I	[FETPC
	DCA	FMTADR
	DCA	FMTTYP
	DCA	PFACT	/CLEAR SCALE FACTOR
	JMS I	[GETLMN	/EXIT TO MAIN PROGRAM TO GET 1ST VARIABLE

	TAD	(FMTPDL-1
FMTSET,	DCA	FMTPXR	/STORE NEW FORMAT PUSHDOWN POINTER
	TAD I	FMTPXR
	DCA	FMTBYT	/GET NEW BYTE POINTER (NOTE-FMTPDL CONTAINS A 0)
/MAIN FORMAT DECODING LOOP

FMTFLP,	TAD	FMTBYT
	DCA	FMPBYT	/SAVE CURRENT BYTE PTR FOR PARENTHESES HACK
FMTDLP,	DCA	FMTNUM	/ZERO ACCUMULATED NUMBER
FMTCLP,	JMS	FMTGCH	/GET A CHARACTER
	ISZ	FMTBYT	/BUMP BYTE POINTER
	JMS I	[CHTYPE	/CLASSIFY CHAR
	1234;	FMTDIG	/DIGIT
	-42;	DBLQOT	/"
	-44;	ABORTO	/$
	-55;	FMINUS	/-
	-56;	FMTPER	/.
	-57;	SLASH	//
	-54;	COMMA	/,
	-50;	LPAREN	/(
	-51;	RPAREN	/)
	-47;	KWOTE	/'
	-40;	FMTCLP	/SPACE
	0		/ANYTHING ELSE

	TAD	FMTTYP
	SZA CLA		/CHECK THAT WE DO NOT HAVE A FIELD OUTSTANDING
	JMP I	(FMTERR	/IF WE DO - ERROR
	TAD	CHCH	/GET FIELD CHARACTER
	DCA	FMTTYP
	TAD	FMTNUM
	SNA		/IF REPEAT COUNT WAS MISSING OR ZERO
	IAC		/MAKE IT ONE
	CMA
	DCA	N	/STORE -(REPEAT COUNT +1)
	DCA	W	/CLEAR WIDTH INITIALLY
	ISZ	FMTNUM	/PRECLUDE "FORMAT ERROR" ON X,P, OR H FORMATS
	TAD	FMTTYP
	AND	[7	/IS THE CHARACTER P, X, OR H?
	SNA CLA		/IF SO, DON'T WAIT
COMMA,	JMS I	(DOFMT	/EXECUTE THE STORED FIELD SPECIFICATION
	JMP	FMTFLP	/BACK FOR MORE

FMTADR,	0		/ADDRESS OF FORMAT
FMTGCH,	0		/GET CHARACTER FROM FORMAT
	JMS	FMTGAD	/GET WORD CONTAINING CHAR AND L/R SWITCH
	CDF 0
	JMS I	(FMTGLR	/EXTRACT CHARACTER
	JMP I	FMTGCH

FMTGAD,	0		/SUBR TO GET A WORD FROM A CHARACTER OFFSET
	TAD	FMTBYT	/GET OFFSET
	CLL RAR
	CLL
	TAD	FMTADR	/COMPUTE BASE ADDR + [OFFSET/2]
	DCA	D
	RAL
	TAD	FMTDF
	JMS I	MCDF	/SET UP PROPER DATA FIELD
	DCA	.+1
	HLT
	TAD	FMTBYT
	RAR
	CLA		/LEAVE L/R SWITCH IN LINK
	TAD I	D
	JMP I	FMTGAD	/RETURN WITH WORD IN AC

FMTDF,	0		/FIELD OF 1ST CHAR OF FORMAT IN BITS 9-11

FMTDIG,	TAD	FMTNUM	/DIGIT PROCESSOR
	CLL RTL
	TAD	FMTNUM
	CLL RAL		/MULTIPLY FMTNUM BY 10
	TAD	CHCH	/ADD IN THE DIGIT
	JMP	FMTDLP	/STORE IT BACK AND CONTINUE
/PARENTHESIS AND DIGIT ROUTINES

LPAREN,	TAD	FMTPXR
	TAD	(2-FMTPDL
	SZA		/ARE WE AT PARENTHESIS LEVEL 1?
	JMP	.+3	/NO
	TAD	FMPBYT	/YES - STORE A POINTER TO THE FIRST DIGIT OF THE
	DCA I	(FMTPDL-2	/GROUP COUNT PRECEDING THIS PAREN
			/AS THE LOOP POINTER FOR LEVEL 1
	TAD	[7
	SPA CLA		/PUSHDOWN OVERFLOW?
FPOERR,	JMS I	ERR	/YES
	AC7775
	TAD	FMTPXR
	DCA	FMTPXR	/BUMP PARENTHESIS PUSHDOWN POINTER
	TAD	FMTBYT
	DCA I	FMTPXR	/SAVE BYTE POINTER
	TAD	FMTNUM
	SNA
	IAC		/NO GROUP COUNT MEANS COUNT = 1
	CIA
	DCA I	FMTPXR	/SAVE LOOP COUNT
	DCA I	(FMTPDL-1	/INITIAL GROUP COUNT IS INFINITE!
RPLOOP,	AC7776	/COME HERE ON RIGHT PAREN ALSO
	TAD	FMTPXR	/BACK UP FORMAT PDL POINTER
	JMP	FMTSET	/RESTORE FMTBYT FROM TOP OF LIST

FMPBYT,	0

RPAREN,	JMS I	(DOFMT	/EXECUTE PREVIOUS SPEC IF ANY
	TAD	FMTPXR
	TAD	(2-FMTPDL	/IS THIS THE FINAL RIGHT PAREN?
	SNA CLA
	JMS I	[ENDREC	/YES - CHECK FOR END OF FORMAT
	ISZ I	FMTPXR	/BUMP COUNT
	JMP	RPLOOP	/DIDN'T OVERFLOW - LOOP TO BYTE AFTER (
	ISZ	FMTPXR	/POP UP PARENTHESES STACK
	JMP	FMTFLP	/CONTINUE PAST RIGHT PAREN
	PAGE
/QUOTE AND HOLLERITH FORMAT PROCESSORS

KWOTE,	TAD	MINUS5	/APOSTROPHE PROCESSOR
DBLQOT,	TAD	(-42	/QUOTE PROCESSOR
	DCA	KWODEL	/SAVE TERMINATOR
	JMS	DOFMT	/PROCESS PRECEDING FIELD , IF ANY
	SKP
KWOTLP,	JMS	FMTHCV	/PROCESS ONE CHARACTER
	JMS I	[FMTGCH	/GET THE NEXT FORMAT CHAR
	TAD	KWODEL
	SZA CLA		/IS IT THE TERMINATOR?
	JMP	KWOTLP	/NO - PROCESS IT AND CONTINUE
	ISZ	FMTBYT	/BUMP OVER TERMINATOR
	JMS I	[FMTGCH
	TAD	KWODEL
	SNA CLA		/IS THIS ANOTHER TERMINATOR?
	JMP	KWOTLP	/TWO TERMINATORS PRINT AS ONE
	JMP I	(FMTFLP	/OTHERWISE GO BACK TO FORMAT LOOP

HFMT,	JMS	MORE	/MORE CHARACTERS?
	JMS	FMTHCV	/YES - PROCESS ONE
	JMP	HFMT	/AND LOOP

FMTHCV,	0		/ROUTINE COMMON TO H AND QUOTED FORMATS
	TAD	RWFLAG	/PROCESSES ONE CHAR IN OR OUT OF THE FORMAT
H7700,	SMA CLA		/IN OR OUT?
	JMP	FMTHIN	/IN
	JMS I	[FMTGCH	/OUT - GET THE CHAR
	JMS I	[FMTOUT	/PRINT IT
	JMP	FMTHCR	/RETURN
FMTHIN,	JMS I	[FMTIN	/INPUT - GET THE CHAR FROM THE INPUT LINE
	DCA	W	/SAVE IT
	JMS I	(FMTGAD
	SZL		/WHICH SIDE?
	JMP	FHRGHT	/RIGHT SIDE
	AND	[77	/LEFT - KEEP RIGHT CHAR
	DCA	MORE
	TAD	W
	CLL RTL
	RTL
	RTL
	TAD	MORE	/ADD NEW CHAR IN ON THE LEFT
	JMP	.+3
FHRGHT,	AND	H7700	/KEEP THE CHAR ON THE LEFT
	TAD	W	/ADD NEW CHAR IN ON THE RIGHT
	DCA I	D	/RESTORE ALTERED WORD
	CDF 0
FMTHCR,	ISZ	FMTBYT	/BUMP BYTE POINTER
	JMP I	FMTHCV

KWODEL,	0		/MUST BE UNIQUE!
MORE,	0		/SUBR TO BUMP REPEAT COUNT AND EXIT ON OVFLO
	ISZ	N
	JMP I	MORE
DOFRTN,	DCA	FMTTYP	/INDICATE NO SPECIFICATION COLLECTED
	JMP I	DOFMT	/RETURN FROM "DOFMT"

DOFMT,	0		/ROUTINE TO PROCESS A FORMAT SPECIFICATION
	TAD	FMTNUM	/GET THE CURRENT NUMBER
	DCA	D	/STORE IT AS DECIMAL POINT SPEC
	DCA	IFLG
	DCA	EFLG
	DCA	GFLG	/ZERO CONVERSION FLAGS
	TAD	FMTTYP
	SNA CLA		/ANY SPECIFICATION WAITING?
	JMP I	DOFMT	/NO - JUST RETURN
	TAD	W
	TAD	D	/IF THERE WAS NO W OR D SPECIFICATION,
	SNA CLA
	JMP	FMTERR	/ITS AN ERROR
	TAD	FMTTYP
	JMS I	[CHTYPE	/YES - WHICH ONE?
	-30;	XFMT	/X
	-24;	TFMT	/T
	-20;	PFMT	/P
	-14;	LFMT	/L
	-11;	IFMT	/I
	-10;	HFMT	/H
	-7;	GFMT	/G
	-6;	FFMT	/F
MINUS5,	-5;	EFMT	/E
	-4;DF,	EFMT	/D - EQUIVALENT TO E IF NO D.P. FPP
	-2;BF,	FFMT	/B - EQUIVALENT TO F IF NO D.P. FPP
	-1;	AFMT	/A
	0		/NONE OF THE ABOVE - ERROR
FMTERR,	JMS I	ERR
ENDREC,	0		/ROUTINE TO END A LINE AND MAYBE THE I/O
	JMS I	[EOLINE
	CLA IAC
	AND	RWFLAG	/LO BIT OF RWFLAG IS "I/O LIST EXHAUSTED" FLAG
	SNA CLA		/SKIP IF NO MORE ELEMENTS IN I/O LIST
	JMP I	ENDREC
	JMP I	[ENDIO	/NOW FINISH UP AND LEAVE

SLASH,	JMS	DOFMT	/EXECUTE THE FIELD SPEC IF ANY
	JMS I	[EOLINE	/TERMINATE CURRENT LINE
	JMP I	(FMTFLP

PFMT,	CLA CMA
	TAD	FMTNUM
	ISZ	MINFLG	/P FORMAT - CHECK FOR NEGATIVE SCALE
	CIA
	DCA	PFACT
	STA		/FALL INTO CODE TO CLEAR MINFLG
	DCA	MINFLG	/SET FLAG ON MINUS
	JMP	DOFRTN

FMINUS,	JMS	DOFMT	/EXECUTE PRECEDING SPEC
	DCA	MINFLG	/CLEAR MINUS FLAG
	JMP I	(FMTFLP

MINFLG,	-1

FMTPER,	TAD	FMTNUM	/PERIOD PROCESSOR
	DCA	W	/STORE WIDTH
	JMP I	(FMTFLP

ABORTO,	JMS	DOFMT	/$ - SPECIAL HACK TO ALLOW PROMPTS
	DCA	EOLSW	/FAKE BEGINNING OF LINE
	DCA I	(TTYLF	/INHIBIT LF BEFORE NEXT TTY INPUT
	JMP I	[ENDIO	/GO AWAY
	PAGE
CHTYPE,	0		/ROUTINE TO CLASSIFY CHARACTERS
	DCA	CHCH	/SAVE CHAR
	JMP	CHLOOP+1
CDIGIT,	TAD	CHCH	/CHECK FOR DIGIT
	TAD	(-72
	CLL
	TAD	[12
	SZL		/IS CHAR A DIGIT?
	JMP	JMPOUT	/YES
CHLOOP,	ISZ	CHTYPE	/SKIP OVER ADDRESS
	CLA
	TAD I	CHTYPE
	ISZ	CHTYPE
	SMA		/END OF LIST?
	JMP	JMPOTX	/MAYBE - JUMP WITH CODE IN AC
	TAD	CHCH
	SZA CLA		/DOES CHAR MATCH CHAR ON LIST?
	JMP	CHLOOP	/NO - KEEP LOOKING
JMPOUT,	DCA	CHCH	/ZERO CHAR
	TAD I	CHTYPE
	DCA	CHTYPE	/SET UP TO RETURN INDIRECTLY
JMPOTX,	SZA CLA		/IS THIS THE END?
	JMP	CDIGIT	/NO - GO CHECK FOR DIGIT
	JMP I	CHTYPE	/GO TO SPECIFIED ADDRESS


SKPOUT,	0		/ROUTINE USED BY DATA-HANDLING SPECIFICATIONS
	JMS I	[MORE	/CHECK FOR REPEAT COUNT EXHAUSTED
	TAD	RWFLAG
	CLL RAR
	SZA CLA		/IF OUTPUT,
	ISZ	SKPOUT	/SKIP RETURN
	SZL CLA		/IF END OF I/O LIST,
	JMS I	[ENDREC	/DON'T RETURN AT ALL - GO AWAY
	JMP I	SKPOUT
/A FORMAT PROCESSOR

AINPUT,	TAD	(4040
	DCA	ACH
	TAD	(4040
	DCA	ACL	/INITIALIZE LOW-ORDER WORDS TO BLANKS
AINPTL,	JMS	GADR
	SZL		/LEFT OR RIGHT?
	JMP	AINPTR	/RIGHT
	JMS I	[FMTIN
	STL RTL		/INPUT CHAR GOES IN HIGH-ORDER
	RTL		/WITH BLANK IN LOW-ORDER
	RTL
	JMP	AINPTC
AINPTR,	JMS I	[FMTIN
	TAD I	FMTGLR	/COMBINE INPUT CHAR AND OLD LEFT HALF
	TAD	[-40	/DELETE PREVIOUS RIGHT-HALF SPACE
AINPTC,	DCA I	FMTGLR	/STORE WORD
	ISZ	W
	JMP	AINPTL	/LOOP AROUND WIDTH
ANXT,	JMS I	[GETLMN	/GET NEXT ELEMENT
AFMT,	TAD	D
	CIA
	DCA	W	/SAVE FIELD WODTH AS A COUNT
	JMS I	[SKPOUT	/CHECK FOR REPEAT COUNT OVFLO AND I/O DIR
	JMP	AINPUT
AOTPUT,	JMS	GADR	/OUTPUT - GET ADDRESS OF BYTE
	TAD I	FMTGLR
	JMS	FMTGLR	/GET BYTE
	JMS I	[FMTOUT	/PRINT IT
	ISZ	W
	JMP	AOTPUT	/LOOP ON WIDTH
	JMP	ANXT

FMTGLR,	0		/SUBR TO EXTRACT A CHAR FROM A WORD
	SZL
	JMP	.+4	/RIGHT HALF
	RTR
	RTR
	RTR		/LEFT HALF - ROTATE INTO RIGHT HALF
	AND	[77
	JMP I	FMTGLR

GADR,	0		/BYTE ADDRESS ROUTINE FOR A FORMAT PROCESSOR
	TAD	D
	TAD	W	/FORM BYTE OFFSET IN THE RANGE 0 THRU D-1
	CLL RAR
	TAD	(ACX
	DCA	FMTGLR
	JMP I	GADR	/LEAVE WITH L/R FLAG IN LINK
/"STOP" ROUTINE - TERMINATES JOB

CALXIT,	TAD	EXDVNO
	CIA
	DCA	ACI	/GO THROUGH THE FORTRAN UNIT NUMBERS.
	DCA I	(ENDFLS	/*K* TURN "ENDFL" INTO A SUBROUTINE
	JMS I	(LDDSRN	/IF WE FIND A UNIT WHICH IS BEING USED
	SNA CLA		/AND HAS NOT BEEN ENDFILED,
	JMP	XITISZ	/WE WILL DUMP THE CURRENT BUFFER (IF IT
	CLA IAC		/IS A FORMATTED OUTPUT FILE) AND
	AND	FFLAGS	/END-FILE IT
	SNA CLA
	JMS I	(ENDFL
XITISZ,	ISZ	EXDVNO
	JMP	CALXIT
LPTTWT,	TAD I	LPGET	/WAIT FOR LINE PRINTER AND TELETYPE TO
	TAD	TOCHR	/GO QUIET.
	SZA CLA
	JMP	LPTTWT
	ISZ	CLNADR	/SET UP TO CLOSE OUTPUT FILES
PDPXIT,	IOF		/ENTER HERE FROM 7605
	CDF 0		/TO PROTECT CLODS WITH PDP 8/E'S
	JMS I	(7607
	0210
	7400		/READ IN CLEANUP ROUTINE
	37		/AND OS/8 PAGE 17600
	JMP	.-5	/AYEEEE!! SYSTEM DEVICE GONZO!
	CDF CIF 10
	JMP I	CLNADR	/CLOSE TENTATIVE FILES AND EXIT
CLNADR,	CLNUP
EXDVNO,	-11

ARGLD,	0		/ROUTINE TO GET VALUE OF AN ARG
	JMS I	[FETPC
	AND	[7	/THROW AWAY OPCODE (JA)
	TAD	FLDTM2
	DCA	FGPBF
	JMS I	[FETPC	/CONSTRUCT AN FPP INSTRUCTION
	DCA	BIOPTR
	JMS I	[FPGO
	FGPBF
	JMP I	ARGLD

FLDTM2,	FLDA+LONG
	FTEMP2
	FEXIT
	PAGE
/SUBROUTINE TO OPEN A UNIT FOR I/O

RWINIT,	0
	DCA	RWFLAG	/DIRECTION IN AC ON ENTRY
	AC7776
	AND I	RWINIT	/IF CALLED FROM BACKSPACE, REWIND OR ENDFILE
	SZA CLA		/UNIT NUMBER IS IN FAC
	JMS I	[ARGLD	/OTHERWISE, GET UNIT NUMBER
	JMS I	[FFIX
	TAD	ACI
	CLL CMA
	TAD	[12
	SZL CLA		/CHECK DEVICE NUMBER IN RANGE 0-9
	JMS	LDDSRN	/LOAD DSRN ENTRY INTO PAGE 0
	SNA CLA		/IS UNIT INITIALIZED?
UNTERR,	JMS I	ERR	/NO - ERROR
	TAD	RWFLAG
	SPA		/IF WE ARE WRITEING FOR THE FIRST TIME
	TAD	FFLAGS	/ON A UNIT WHICH WAS BEING READ,
	CMA RAL		/WE MUST BUMP THE RELATIVE BLOCK NUMBER DOWN
	SNL SMA CLA	/ONE BECAUSE OF A PHILOSOPHICAL DIFFERENCE
	JMS I	(RD2WR	/BETWEEN READ AND WRITE
	TAD I	RWINIT
	TAD	RWFLAG	/OR THE I/O TYPE AND
	CMA
	AND	FFLAGS	/DIRECTION BITS INTO THE FLAG WORD
	TAD I	RWINIT
	TAD	RWFLAG
	DCA	FFLAGS
	TAD	FFLAGS
	CMA RTL
	SNL SMA CLA	/IT IS ILLEGAL TO ACCESS A FILE IN
	JMP	UNTERR	/FORMATTED AND UNFORMATTED MODES
	ISZ	RWINIT
	TAD	ACI
	CLL RAL
	TAD	ACI
	TAD	(DATABL-4
	DCA	XR	/STORE POINTER INTO DIRECT-ACCESS TABLE
	JMP I	RWINIT
/REWIND AND END FILE

RWIND,	JMS	RWINIT	/GET THE DSRN ENTRY
	0		/DON'T PLAY WITH MODES
	AC2000
	TAD	FFLAGS
	SNA CLA		/IF FORMATTED OUTPUT FILE AND NOT EOF'D
	JMS	DMPBUF	/DUMP LAST BUFFER AS A FAVOR
ATLDMK,	CLA IAC
	AND	FFLAGS	/KILL ALL FLAG BITS
	DCA	FFLAGS	/EXCEPT "END-FILED" BIT
	TAD	BADFLD
	AND	[7400
	DCA	CHRPTR
	AC7775
	DCA	CHRCTR	/INITIALIZE BUFFER POINTERS
	DCA	RELBLK	/AND RELATIVE BLOCK #
	JMP I	[ENDIO	/RESTORE DSRN AND EXIT

ENDFL,	JMS	RWINIT	/*K* USED AS A SUBROUTINE BY CALXIT
	1		/GET DSRN, SET "END FILE" FLAG
	TAD	FFLAGS	/IF THE FILE IS UNFORMATTED,
	CMA RAL		/OR WAS NOT OUTPUT ONTO,
	SNL SMA CLA	/THEN ENDFILE DOES NOTHING.
	JMS	DMPBUF	/ELSE DUMP THE FINAL BUFFER
	AC3777
	AND	FFLAGS	/CLEAR WRITE BIT SO WE WILL NOT TRY
SETTOT,	DCA	FFLAGS	/ANYTHING ON A SUBSEQUENT ENDFILE
	TAD	RELBLK	/SET NEW LENGTH OF FILE IN CASE ITS TENTATIVE,
	DCA	TOTBLK	/AND SO WE WON'T READ PAST EOF.
ENDIO,	JMS	INITMV	/SET UP DSRN POINTERS
	TAD I	XR1
	DCA I	XR	/STORE BACK THE DSRN ENTRY
	ISZ	T	/FOR THIS LOGICAL UNIT
	JMP	.-3
	DCA	VEOFSW	/CLEAR EOFSW AT END OF EVERY READ
ENDFLS,	JMP I	[RETURN	/RETURN TO THE CALLING PROGRAM
	JMP I	ENDFL	/*K* OR RETURN TO CALXIT

INITMV,	0		/ROUTINE TO SET UP STUFF
ICDF0,	CDF 0
	TAD	LOGUNT
	DCA	XR
	TAD	(HAND-1
	DCA	XR1
	TAD	(-11
	DCA	T
	JMP I	INITMV
/ROUTINE TO DUMP CURRENT OUTPUT BUFFER WITH ^Z AT THE END

DMPBUF,	0
	ISZ	EOLSW	/FORCE COLUMN 1 SWITCH OFF
	TAD	(7712	/OUTPUT A LINE FEED
	JMS I	[FMTOUT
	TAD	HAND	/IF THE FILE IS BEING OUTPUT VIA
	SMA CLA		/AN OS/8 HANDLER,
	JMP	CLREOL	/WE MUST TERMINATE THE BUFFER PROPERLY.
	TAD	(32
CTZLP,	TAD	Z7700	/OUTPUT A ^Z AND FILL BUFFER WITH ZEROES.
	JMS I	[FMTOUT	/NEGATIVE NUMBERS TURN INTO CONTROL CHARS
	TAD	CHRPTR
	AND	[377
	TAD	CHRCTR	/FILL THE BUFFER UNTIL CHRPTR POINTS TO
	IAC		/A BLOCK BOUNDARY AND CHRCTR = -3
Z7700,	SMA CLA		/WE ARE THEN AT BUFFER-END
	JMP	CTZLP
CLREOL,	DCA	EOLSW	/RESET TO BEGINNING OF LINE
	JMP I	DMPBUF	/RETURN

/ROUTINE TO MOVE THE PROPER DSRN ENTRY INTO PAGE 0

LDDSRN,	0
	TAD	ACI	/ READ/WRITE INIT SINGS THIS SONG,
	CLL RTL		/ (DOO DAH, DOO DAH,)
	RAL		/ DSRN ENTRIES 9 WORDS LONG
	TAD	ACI	/ (OH, DEE DOO DAH DAY).

	SNA			/DEVICE NUMBER 0 IS SPECIAL -
	TAD	(PTTY+11-DSRN	/IT'S ALWAYS THE TELETYPE
	TAD	(DSRN-12
	DCA	LOGUNT
	JMS	INITMV	/SET UP FOR MOVE
	TAD I	XR
	DCA I	XR1	/PUT DSRN ENTRY IN PAGE 0
	ISZ	T
	JMP	.-3
	TAD	BADFLD
	AND	[70
	TAD	ICDF0
	DCA	BUFCDF	/SAVE BUFFER FIELD AS A CDF
	TAD	HAND
	JMP I	LDDSRN
	PAGE
/BACKSPACE ROUTINE - WORKS ON BINARY OR ASCII FILES

BKSPC,	JMS I	[RWINIT
	0		/GET THE DSRN ENTRY WITHOUT ALTERING MODE
	TAD	HAND
	SMA CLA
	JMP I	[UNTERR	/UNIT MUST BE BLOCK ORIENTED
	AC2000
	AND	FFLAGS
	SZA CLA		/IS FILE FORMATTED?
	JMP	BKASCI	/YES - PAIN IN NECK
	JMS	BMPBLK	/UNFORMATTED FILE - REREAD LAST BLOCK
	TAD	CHRPTR
	TAD	[377
	DCA	T
	JMS	BUFFLD	/SET DATA FIELD TO FIELD OF BUFFER
	TAD I	T	/LOOK AT LAST WORD IN BUFFER
	CIA		/REGARD IT AS THE NUMBER OF BLOCKS/RECORD
	TAD	RELBLK
	DCA	RELBLK	/RELBLK POINTS TO FIRST BLOCK OF PREV. REC
	JMP I	[ENDIO

BMPBLK,	0		/SUBR TO BUMP BLOCK # BACK AND READ
	CMA CLL		/AC MAY NOT BE 0 ON ENTRY
	TAD	RELBLK
	DCA	RELBLK	/BUMP BLOCK BACK
	SNL
	JMP I	(ATLDMK	/BACKSPACED TOO FAR - CALL IT QUITS
	DCA	CHRPTR	/ZERO CHRPTR TO FORCE A READ FROM MASSIO
	JMS I	[MASSIO	/READ A BLOCK
	JMP I	BMPBLK

/****	NULL JOB GOES HERE FOR LACK OF A BETTER PLACE ****

NULLJB,	TAD	N2525
NULLLP,	ISZ	N2525	/PUT THE FAMOUS "POLY BASIC PATTERN"
	JMP	NULLLP	/IN THE AC LIGHTS
	ISZ	NUMISZ
	JMP	NULLLP
	CML CMA RAR
	DCA	N2525
	TAD	[-4
	DCA	NUMISZ
	JMP I	(VBACKG	/GOT SOMETHING MORE USEFUL TO DO?
N2525,	2525
NUMISZ,	-4
/BACKSPACE FOR FORMATTED FILES

BKLORD,	TAD I	CHRPTR
	ISZ	CHRPTR
	NOP
	AND	[177	/GET 7 BITS
	TAD	(-15	/COMPARE WITH C.R. - SINCE WE SKIPPED
	SNA CLA		/THE FIRST ONE THIS WILL BELONG TO THE PREVIOUS
	JMP I	[ENDIO	/LINE AND WE WILL BE DONE (HAH!)
BKASCI,	JMS I	(MASBMP	/A COMPLICATED MESS - FIRST BUMP THE 
	SKP		/CHARACTER POINTER BACK TWO PLACES
	JMP	BKGTCH	/AND THEN FETCH A CHARACTER.  THIS WILL IGNORE
	TAD	BADFLD	/THE LAST CHAR READ/WRITTEN (WHICH SHOULD
	AND	[7400	/BE A CARRIAGE RETURN).
	CIA
	TAD	CHRPTR
	CLL RAR
	SZA CLA		/TEST WHETHER WE HAVE TO READ AN OLD BUFFER
	JMP	BKNORD	/NO
	TAD	CHRCTR	/SAVE POSITION IN CURRENT DOUBLEWORD
	DCA	GETCH3
	DCA	CHRPTR
	AC4000		/IF WE ARE BACKSPACING AN OUTPUT FILE,
	TAD	FFLAGS	/WE MUST SAVE THE INFORMATION IN THE
	SPA		/CURRENT BUFFER BY WRITING IT OUT.
	JMP	.+4
	DCA	FFLAGS	/ALSO CHANGE THE UNIT TO AN INPUT FILE
	AC4000		/(RWINIT TAKES CARE OF SWITCHING BACK TO OUTPUT)
	JMS I	[MASSIO
	CLA IAC		/WE DON'T WANT THE LAST BLOCK READ/WRITTEN,
	JMS	BMPBLK	/THAT'S IN CORE - WE WANT THE ONE
	TAD	GETCH3	/BEFORE THAT.
	DCA	CHRCTR
	TAD	CHRCTR
	TAD	(401
	SKP		/COMPUTE WORD POINTER FROM CHAR POINTER
BKNORD,	STA
	TAD	CHRPTR
	DCA	CHRPTR	/BUMP WD PTR BACK 1
BKGTCH,	JMS I	(MASBMP	/NOW GET A CHARACTER - THIS LOOKS A LOT
	JMP	BKLORD	/LIKE THE INPUT ROUTINE
	JMS	GETCH3
	JMP	BKLORD+1
GETCH3,	0		/COMMON CODE BETWEEN BACKSPACE AND INPUT
	TAD I	CHRPTR
	AND	[7400
	DCA	BMPBLK	/HANDY TEMPORARY
	ISZ	CHRPTR
	TAD I	CHRPTR
	AND	[7400
	CLL RTR
	RTR		/COMBINE TWO 4-BIT QUANTITIES
	TAD	BMPBLK	/INTO A CHARACTER
	CLL RTR
	RTR
	JMP I	GETCH3

DATABL,	ZBLOCK	33	/DIRECT ACCESS TABLE
	PAGE
/I,E,F,AND G FORMAT CONVERSIONS

IFMT,	TAD	D
	DCA	W	/SET WIDTH PROPERLY
	DCA	D	/FOR SCALING PURPOSES
	STA
	DCA	IFLG
	JMP	FFMT

GFMT,	STA
	DCA	GFLG	/SET G AND E FLAGS

EFMT,	STA
	DCA	EFLG	/SET E FLAG
	JMP	FFMT

IGEF,	JMS I	[GETLMN	/MAIN LOOP FOR CONVERSIONS - SKIPPED 1ST TIME
FFMT,	TAD	D
	DCA	OD	/SAVE COUNT OF POST-D.P. DIGITS
	TAD	IFLG
	SNA CLA		/APPLY THE P-SCALE FACTOR
	TAD	PFACT	/ONLY IF THE FORMAT IS NOT I
	DCA	PFACTX
	DCA	SCALE	/DON'T LOOK FOR TROUBLE
	JMS I	[SKPOUT	/CHECK IF MORE AND TEST DIRECTION
	JMP I	(IGEFIN	/INPUT
	STA
	DCA I	[FFNEG	/USE NEGATE ROUTINE HEADER AS SIGN FLAG
	TAD	EFLG
	CLL RAL
	CLL RAL		/0 IF NOT E, -4 IF E
	TAD	W	/THIS PROVIDES FOR THE EXP. FIELD (IF E FMT)
	DCA	OW	/OR THE 4 TRAILING SPACES (IF G FMT)
	TAD	ACH
	SNA
	JMP	SKPSHT	/AC IS ZERO - SKP A LOT OF SHT
	SPA CLA
	JMS I	[FFNEG	/AC<0 - NEGATE IT AND SET FLAG (CLEVER)
SCALUP,	DCA	SCALE
	TAD	ACX
	SMA SZA CLA	/AC<1.0?
	JMP	GT1	/NO
	JMS I	[FPGO	/YES - MULTIPLY BY 10.0
	FMUL10
	STA
	TAD	SCALE	/BUMP POWER OF TEN
	JMP	SCALUP
/I,G,E,F, OUTPUT CONVERSIONS - NUMBER IS NOW =>1.0

GT1,	JMS I	(SCALDN	/NOW DECREASE IT TO THE INTERVAL [0,1)
	JMS I	[FPGO	/SAVE IT AWAY
	FSTTMP
	TAD	[7
	JMS 	OSCALE
	JMS I	[FPGO	/USE IT TO ROUND THE NUMBER TO BE OUTPUT
	FADTMP
	JMS I	(SCALDN	/WE COULD HAVE ROUNDED FROM .999... TO 1.000...
SKPSHT,	TAD	GFLG	/ENTER HERE IF NUM WAS 0 - SCALE=0
	SNA CLA
	JMP	NOTG	/NOT G FORMAT
	TAD	SCALE	/G FORMAT - TEST FOR OUT OF F FORMAT RANGE
	TAD	PFACTX
	CIA CLL		/F FORMAT RANGE IS [.1,10**(D VALUE))
	TAD	OD
	SNL
	JMP	USEE	/IF OUT OF BOUNDS USE E FORMAT (FLAG IS SET)
	DCA	OD	/REDUCE D VALUE BY SCALE FACTOR
	DCA	EFLG	/TO RETAIN CORRECT # OF SIG. DIGITS
USEE,	CLA
	JMP	NOTG

/SET UP TO PRINT DIGITS


DIGCNT,	0
	TAD	PFACTX	/COMPUTE EXPONENT JUST IN CASE E FORMAT
	CIA
	TAD	SCALE
	DCA	FMTNUM
	TAD	EFLG
	SNA CLA		/NOW COMPUTE THE NUMBER OF DIGITS BEFORE THE D.P.
	TAD	SCALE	/TAKE SCALE FACTOR INTO ACCOUNT IF NOT E FORMAT
	TAD	PFACTX	/TAKE P FACTOR INTO ACCOUNT IF NOT I OR F/G
	DCA	SCALE	/STORE THE NUMBER OF DIGITS BEFORE THE D.P.
	TAD I	[FFNEG	/INCREASE NUMBER OF LEADING BLANKS BY 1
	SPA CLA		/IF THE NUMBER IS POSITIVE. THIS DEPENDS ON
	ISZ	OW	/THIS LOCATION BEING BELOW 4000.
	TAD	SCALE	/GET THE NUMBER OF PRE-D.P. DIGITS (AS NEGATIVE #)
	SPA SNA
	CLA IAC		/IF NONE, PRINT A 0 SO COUNT AS 1
	TAD	OD	/REDUCE THE WIDTH BY THIS NUMBER
	CMA
	TAD	OW	/REDUCE IT AGAIN BY THE POST-D.P. DIGIT COUNT
	CIA
	TAD	IFLG	/AND AGAIN BY 1 FOR THE D.P. (IF NOT I FORMAT)
	JMP I	DIGCNT
OW,	0
/I,G,E,F FORMAT - ROUTINE TO SCALE ROUNDING FACTOR

OSCALE,	0		/SUBR TO SCALE .5 THE CORRECT # OF TIMES
	DCA	NPLCS	/MAX IN AC ON ENTRY
	DCA	ACX
	AC2000		/FORM A FLOATING 0.5 IN ORDER
	DCA	ACH	/TO ROUND THE NUMBER BEFORE PRINTING.
	DCA	ACL
	TAD	EFLG	/FIGURE OUT HOW TO SCALE IT -
	SNA CLA		/THE THEORY IS THAT IT SHOULD BE SCALED
	TAD	SCALE	/DOWN BY THE NUMBER OF SIGNIFICANT
	DCA	T	/PRINTING DIGITS.  THIS CAN BE
	TAD	SCALE	/EXPRESSED AS:
	CIA CLL		/(P FACTOR) * (NOT (G FMT PRINTING AS F))
	TAD	OD	/ + (SCALE FACTOR) * (NOT E FMT) + (D VALUE).
	SZL CLA		/THE SCALE FACTOR IS < 0 FOR
	TAD	GFLG	/NUMBERS < .1, WHICH REDUCES
	SNA CLA		/THE # OF SIG. DIGITS VIA LEADING ZEROS.
	TAD	PFACTX	/IF THERE ARE < 0 SIG. DIGITS
	TAD	T	/IT DOESN'T MATTER WHAT WE DO
	TAD	OD	/SINCE THE NUMBER WILL PRINT AS
	SMA		/0.00000 ANYWAY.
	CMA		/IF THERE ARE >NPLCS SIG. PRINTING DIGITS
	TAD	NPLCS	/THE ROUNDING GETS MEANINGLESS SO MAKE
	SPA		/THE EXCESS DIVISIONS DIVIDES BY 2 INSTEAD
	DCA	ACX	/ OF BY 10.  THIS FUDGE WORKS QUITE WELL
	CIA		/FOR NUMBERS OF UP TO NPLCS+2
	TAD	NPLCS	/SIGNIFICANT DIGITS.
	CIA
	DCA	T
	JMP	.+3
FDIVLP,	JMS I	[FPGO	/SCALE THE .5 DOWN THE CORRECT NUMBER OF TIMES
	FDIV10
	ISZ	T
	JMP	FDIVLP
	JMP I	OSCALE
NPLCS,	0
ONE,	1;2000;0
	PAGE
/I,G,E,F OUTPUT CONVERSION - ACTUAL OUTPUT SECTION

OUTNUM,	SMA		/CHECK FOR FIELD OVERFLOW
	JMP	ASTSK1	/YES - PRINT *******
	JMS	OBLNKS	/PRINT LEADING BLANKS - AC IS NOT 0!
			/***IMPORTANT - OBLNKS CLEARS AC1 ***
	AC7775
	ISZ I	[FFNEG	/IF SIGN IS NEGATIVE,
	JMS	DIGIT	/OUTPUT A MINUS SIGN
	CLA		/OTHERWISE OUTPUT NOTHING
	TAD	ACX
	SNA		/ALIGN THE FAC MANTISSA INTO A DOUBLEWORD
	JMS I	[AL1	/FRACTION IN THE RANGE [.1,1)
	IAC		/THIS INVOLVES SHIFTING THE MANTISSA
	CMA		/RIGHT BY (-ACX-1) PLACES
	SMA		/WHERE A NEGATIVE NUMBER MEANS A LEFT SHIFT.
	JMS I	[ACSR
	CLA
	TAD	ACL	/NOW MOVE THE FAC DOWN A WORD SO THAT
	DCA	AC1	/WHEN WE MULTIPLY BY 10 THE OVERFLOW APPEARS
	TAD	ACH	/IN THE HIGH-ORDER WORD
	DCA	ACL
	TAD	SCALE
	SPA SNA		/DO WE HAVE DIGITS TO THE LEFT OF THE D.P.?
	JMP	PRZERO	/NO - PRINT A ZERO THERE
	JMS	DIGITS	/YES - PRINT THEM
PRDCPT,	TAD	IFLG
	SZA CLA
	JMP I	(IGEF	/IF I FORMAT, WE'RE DONE NOW
	AC7776
	JMS	DIGIT	/OTHERWISE PRINT DECIMAL POINT
	TAD	SCALE
	SMA CLA		/CHECK WHETHER WE NEED TO PRINT LEADING ZEROS
	JMP	NOLZRO	/NO
	TAD	SCALE
	DCA	T
LZLOOP,	STA CLL
	TAD	OD	/BUMP D VALUE DOWN BY ONE
	SNL		/IF IT GOES NEGATIVE,
	JMP	NOMOAC	/WE'VE RUN OUT OF FIELD WIDTH
	DCA	OD	
	JMS	DIGIT	/PRINT A ZERO
	ISZ	T	/UNTIL THE COUNT (OR THE WIDTH) RUNS OUT
	JMP	LZLOOP
NOLZRO,	TAD	OD
	SZA		/IF THERE ARE ANY DIGITS YET TO BE PRINTED,
	JMS	DIGITS	/PRINT THEM
/I,G,E,F OUTPUT CONVERSION - FINISH UP

NOMOAC,	CLA
	TAD	EFLG
	SNA CLA		/E FORMAT?
	JMP	CHKG	/NO - CHECK FOR G FORMAT OUTPUT AS F
	JMS 	EXPFLD
	JMP I	(IGEF
EXPFLD,	0
	TAD	(5
	JMS I	[FMTOUT	/OUTPUT "E"
	TAD	FMTNUM	/GET EXPONENT
	CLL
	SPA
	CML CIA		/SEPARATE INTO MAGNITUDE AND SIGN
	DCA	FMTNUM	/SAVE MAGNITUDE
	RTL
	TAD	(-5	/PRINT + OR -
	JMS	DIGIT
	DCA	T	/INITIALIZE QUOTIENT OF DIVISION
DVELP,	TAD	FMTNUM	/SUBTRACT 10 FROM EXPONENT
	TAD	[-12
	SPA		/DID IT GO NEGATIVE?
	JMP	PRNTXP	/YES - DONE
	DCA	FMTNUM	/NO - STORE IT BACK
	ISZ	T	/BUMP QUOTIENT
	JMP	DVELP	/LOOP
PRNTXP,	CLA
	TAD	T
	TAD	[-12
	SMA CLA
	JMP	ASTSK3
	TAD	T
	JMS	DIGIT
	TAD	FMTNUM
	JMS	DIGIT	/PRINT TWO DIGITS OF EXPONENT
	JMP I	EXPFLD

CHKG,	TAD	GFLG
	SNA		/WAS IT G FORMAT?
	JMP I	(IGEF	/NO - F OR I - DONE
	DCA	EFLG	/RE-SET EFLG SINCE WE ZEROED IT BEFORE
	TAD	(-5
	JMS	OBLNKS	/OUTPUT 4 BLANKS
	JMP I	(IGEF	/DONE WITH G FORMAT OUTPUT

PRZERO,	CLA		/COME HERE IF NO SIG. DIGITS LEFT OF D.P.
	JMS	DIGIT	/PRINT A ZERO
	JMP	PRDCPT	/CONTINUE

ASTSK3,	AC0002
	JMP	.+3
ASTSK1,	CLA		/CLEAR THE AC
	TAD	W	/GET THE FIELD WIDTH
	JMS I	[ASTRSK
	JMP I	(IGEF
/I,G,E,F OUTPUT CONVERSION - OUTPUT SUBROUTINES

OBLNKS,	0		/SUBROUTINE TO PRINT A STRING OF BLANKS
	DCA	AC1	/MUST LEAVE AC1 ZERO ON EXIT SO THAT
	JMP	.+3	/FAC LEFT SHIFT WON'T SHIFT IN GARBAGE LATER ON
	TAD	[40
	JMS I	[FMTOUT	/OUTPUT A BLANK
	ISZ	AC1
	JMP	.-3	/LOOP
	JMP I	OBLNKS	/RETURN

DIGITS,	0		/ROUTINE TO OUTPUT A STRING OF DECIMAL DIGITS
	CIA
	DCA	T
DGLOOP,	TAD	AC1
	DCA	AC2	/COPY AC INTO OPERAND FOR ADDITION LATER ON
	TAD	ACL
	DCA	OPL
	DCA	ACH	/CLEAR "OVERFLOW WORD"
	JMS I	[AL1
	JMS I	[AL1	/FAC=FAC*4
	DCA	OPH
	JMS I	[OADD
	JMS I	[AL1	/FAC=ORIGINAL FAC*10
	TAD	ACH	/GET OVERFLOW
	JMS	DIGIT	/PRINT IT
	ISZ	T	/LOOP FOR SPECIFIED NUMBER
	JMP	DGLOOP
	JMP I	DIGITS	/RETURN

DIGIT,	0		/ROUTINE TO OUTPUT A DIGIT
	TAD	[60
	JMS I	[FMTOUT	/TRIVIAL, ISN'T IT?
	JMP I	DIGIT
	PAGE
/I,G,E,F INPUT CONVERSION

IGEFIN,	STA		/OD CONTAINS SCALING IF NO D.P. IN INPUT
	DCA	DPSW	/INITIALIZE D.P. SW
	STA
	DCA	INESW	/DITTO EXPONENT SWITCH
	TAD	W
	CMA
	DCA	FMTNUM	/GET CHAR COUNT
INERSM,	DCA	ACX	/RE-ENTER HERE AFTER SEEING "E"
	DCA	ACH	/CLEAR FLOATING AC
	DCA	ACL
	STA
	JMP	INMINS	/SET SIGN PLUS

INGCH,	JMS I	[FMTIN	/GET A CHAR
	JMS I	[CHTYPE	/CLASSIFY IT
	1234;	IDIGIT	/DIGIT
	-56;	INDCPT	/.
	-53;	INLOOP	/+
	-55;	INMINS	/-
	-5;	INE	/E
	-40;	IBLDIG	/BLANK - TREAT LIKE 0 IN FORTRAN STANDARD
	-54;	INEONM	/,
	0		/OTHER - ERROR
INER,	JMS I	ERR

INDCPT,	DCA	OD	/ZERO COUNT OF DIGITS AFTER D.P.
	ISZ	DPSW	/TEST AND SET D.P. SWITCH
	JMP	INER	/WHOOPS - TWO D.P.S IN A NUMBER
	JMP	INLOOP	/KEEP GOING

IBLDIG,	TAD	EOLSW	/SINCE THE BLEEPING STANDARD DOESN'T COVER
	SZA CLA		/TELETYPE I/O, WE KEEP SOME COOL BY IGNORING
	JMP	INLOOP	/BLANKS CREATED BY EARLY LINE TERMINATION.

IDIGIT,	TAD	CHCH
	DCA	DGT+1	/SAVE THE DIGIT
	JMS I	[FPGO	/FORM 10*FAC + DIGIT IN FAC
	ACMDGT
	TAD	DPSW
	SNA CLA
	ISZ	OD	/BUMP DIGIT COUNT IF D.P. SEEN
	JMP	INLOOP
INMINS,	DCA I	[FFNEG	/SET SIGN NEGATIVE

INLOOP,	ISZ	FMTNUM
	JMP	INGCH	/LOOP UNTIL WIDTH EXHAUSTED
INEONM,	ISZ I	[FFNEG	/CHECK IF SIGN NEGATIVE
	JMS I	[FFNEG	/YES - NEGATE
	ISZ	INESW	/SEE IF "E" SEEN
	JMP	FIXUPE	/YES - WE HAVE EXPONENT, NOT NUMBER
	TAD	PFACTX	/NO "E" SEEN - SCALE USING P FACTOR

SCALIN,	TAD	OD	/GET SCALING FACTOR
	STL
	SNA
	JMP I	(IGEF	/NO SCALING NECESSARY
	SMA
	CIA CLL		/AC CONTAINS MAGNITUDE, LINK CONTAINS SIGN
	DCA	OD
	RTL
	RAL		/AC CONTAINS 0 IF DIVIDE, 4 IF MULTIPLY
	TAD	(FDIV10
	DCA	IGEFOP
	JMS I	[FPGO	/MULTIPLY OR DIVIDE BY 10.0
IGEFOP,	0
	ISZ	OD
	JMP	IGEFOP-1/MULT OR DIV APPROPRIATE NUMBER OF TIMES
	JMP I	(IGEF	/RETURN FOR MORE

INE,	ISZ	INESW	/SEE IF THIS IS THE SECOND "E"
	JMP	INER	/YES - ERROR
	ISZ	DPSW	/FORCE DP SW ON (TO INHIBIT D.P. AFTER E)
	TAD	OD	/USE SCALE FACTOR ONLY IF D.P. SEEN
	DCA	SCALE	/SAVE SCALE FACTOR
	ISZ I	[FFNEG
	JMS I	[FFNEG	/GET SIGN OF NUMBER CORRECT
	JMS I	[FPGO	/SAVE IT TEMPORARILY
	FSTTM2
	JMP	INERSM	/GO COLLECT EXPONENT

FIXUPE,	JMS I	[FFIX
	TAD	ACI	/GET EXPONENT
	CIA
	TAD	SCALE	/ADD IN EXPONENT TO D.P. SCALE FACTOR
	DCA	OD
	JMS I	[FPGO	/GET NUMBER BACK IN FAC
	FLDTM2
	JMP	SCALIN

DPSW,	0
DGT,	13;0;0;0;0;0
NOTG,	JMS I	(DIGCNT
	DCA	SCALDN
	TAD	IFLG
	SNA CLA
	JMP	NOTI
	TAD	SCALE
	TAD	(-7
	SPA CLA
NOTI,	TAD	SCALDN
	JMP I	(OUTNUM
SCALDN,	0		/SUBROUTINE TO SCALE THE FAC LESS THAN 1.0
	TAD	ACX
	SPA SNA CLA	/IS THE FAC => 1.0?
	JMP I	SCALDN	/NO - WE'RE DONE
	JMS I	[FPGO	/DIVIDE BY TEN
	FDIV10
	ISZ	SCALE	/BUMP POWER OF TEN
	0		/BACKUP FOR WIDTH
	JMP	SCALDN+1	/LOOP

ASTRSK,	0
	CIA
	DCA	T
	TAD	(52
	JMS I	[FMTOUT
	ISZ	T
	JMP	.-3
	JMP I	ASTRSK	/GET NEXT ELEMENT

INESW,	0		/"E SEEN" SWITCH ON INPUT
	PAGE
/L AND X FORMATS , T FORMAT INPUT

TFMTIN,	JMS I	[FMTIN	/FORCE INPUT BUFFER NON-EMPTY
	CLA		/BY FETCHING AND WASTING A CHARACTER
	TAD	(INBUFR
	DCA	INXR
	DCA	EOLSW	/SET TO BEGINNING OF LINE
	JMP	XFMT
XFMTIN,	JMS I	[FMTIN
H7600,	7600		/WASTE AN INPUT CHAR
XFMT,	JMS I	[MORE	/ANY MORE CHARS?
	TAD	RWFLAG	/YES - IN OR OUT?
	SMA CLA
	JMP	XFMTIN	/IN
TPPLBL,	TAD	[40	/HERE WITH AC=13 TO OVERPRINT ON T OUTPUT
	JMS I	[FMTOUT	/OUT
	JMP	XFMT

LINGCH,	JMS I	[FMTIN
	JMS I	[CHTYPE	/GET AND CLASSIFY CHARACTER
	-40;	LINLP	/BLANK
	-24;	LINTRU	/T
	-6;	LINFLS	/F
	0		/OTHER - ERROR
	JMP I	(INER

LINTRU,	TAD	(4001
LINFLS,	CLL RAR		/PUT EITHER 0.0 OR 1.0 IN THE FAC
	DCA	ACH
	DCA	ACL
	RAL
	DCA	ACX
LINLP,	ISZ	W
	JMP	LINGCH	/LOOP ON FIELD WIDTH

LNXT,	JMS I	[GETLMN	/GET NEXT ELEMENT FOR I/O
LFMT,	TAD	D
	CMA
	DCA	W	/SAVE WIDTH AS A COUNT
	JMS I	[SKPOUT	/IN OR OUT?
	JMP	LINFLS	/IN
	CLA IAC
	TAD	W
	JMS I	(OBLNKS	/OUTPUT W-1 BLANKS
	TAD	ACH
	SZA CLA
	TAD	(16
	TAD	(6	/NON-ZERO IS TRUE, ZERO FALSE
	JMS I	[FMTOUT	/OUTPUT T OR F
	JMP	LNXT	/NEXT VICTIM
/T FORMAT OUTPUT AND RANDOM SUBROUTINES

TFMT,	TAD	D
	CIA
	DCA	N	/USE N TO FAKE OUT "X" FMT ROUTINE
	TAD	RWFLAG
	SMA CLA
	JMP	TFMTIN	/INPUT
	TAD	N
	TAD	EOLSW	/COMPARE DESIRED POSITION WITH CURRENT ONE
	SPA
	JMP	TPBLNK	/AFTER - SPACE TO IT
	JMS	EOLINE	/OUTPUT CR AND ZERO EOLSW
	JMS I	[MORE	/KLUDGE FOR "T1" FORMAT
	TAD	(13	/FAKE X FORMAT INTO PRINTING
	JMP	TPPLBL	/A + AND (N-1) SPACES
TPBLNK,	DCA	N	/SAVE DIFFERENCE BETWEEN POSITIONS
	JMP	XFMT	/GO SPACE OUT

EOLINE,	0		/SUBROUTINE TO TERMINATE I/O LINE
	TAD	RWFLAG	/CAUTION - AC LO-ORDER BITS MAY NOT BE 0
	SPA CLA		/INPUT OR OUTPUT?
	JMP	EOOUTL	/OUTPUT
	JMS I	[FMTIN	/FORCE INPUT BUFFER NON-EMPTY
	CLA
	TAD	(INBUFR-1
	DCA	INXR	/SET XR TO NEGATIVE WORD AT THE
	JMP	.+3	/BEGINNING OF THE INPUT BUFFER
EOOUTL,	TAD	(7715
	JMS I	[FMTOUT	/OUTPUT A CARRIAGE RETURN
	DCA	EOLSW	/CLEAR EOLSW FOR INPUT AND OUTPUT
	JMP I	EOLINE
/ROUTINE TO MOVE A HANDLER INTO FIELD 0

GETHND,	0		/HANDLER CODE WORD IN AC ON ENTRY
	DCA	HCW	/SAVE HANDLER CODE WORD
	TAD	[7774
	AND	HCW	/KNOCK OUT ION AND FORMS CTL BITS
	CIA
	SZA		/IF HANDLER IS NOT RESIDENT,
	TAD	HKEY	/SEE IF THE HANDLER IS ALREADY
	SNA CLA		/IN THE HANDLER AREA IN FIELD 0
	JMP	HINF0	/YES
	TAD	HCW	/NO - PUT IT THERE
	AND	[70
	TAD	HCDF0
	DCA	HNDCDF	/GET CDF TO FIELD IN WHICH HANDLER RESIDES
	TAD	HCW
	AND	H7600
	TAD	(-1	/GET POINTER TO HANDLER ADDRESS
	DCA	XR1	/IN THAT FIELD
	TAD	(HPLACE-1
	DCA	XR	/ALSO TO HANDLER AREA IN FIELD 0
	TAD	[7400	/SET UP COUNT OF 7400
	DCA	HKEY	/INDEPENDENT OF HANDLER SIZE
HNDCDF,	HLT
	TAD I	XR1
HCDF0,	CDF 0
	DCA I	XR	/MOVE HANDLER INTO HANDLER AREA
	ISZ	HKEY
	JMP	HNDCDF
	TAD	[7774
	AND	HCW
	DCA	HKEY	/SET NEW KEY CODE WORD
HINF0,	CLA IAC
	AND	HCW
	SNA CLA		/INTERRUPTS ALLOWED?
YHIOF,	IOF		/NO - TOO BAD
	ISZ	CTCINH	/INHIBIT ^C DURING HANDLER CALL
	JMP I	GETHND
HKEY,	0
HCW,	0
	PAGE
/CHARACTER INPUT ROUTINE - LINE AT A TIME

FMTIN,	0
	TAD	EOLSW
	SNA		/END OF LINE ALREADY FOUND?
	TAD I	INXR	/NO - GET CHAR FROM LINE BUFFER
	SPA		/TIME TO READ A NEW LINE?
	JMP	READLN	/YES
	SNA		/END OF LINE?
	JMP	INEOL	/YES - SET INDICATOR
	AND	[77	/CONVERT TO SIXBIT
	JMP I	FMTIN	/RETURN WITH IT
INEOL,	TAD	[40
UNPKLN,	DCA	EOLSW	/SET EOL INDICATOR TO A BLANK
	JMP	FMTIN+1	/AND RETURN BLANKS FROM HERE ON IN
READLN,	DCA	EOLSW	/USE EOLSW AS A COUNT SO IT WINDS UP 0
	TAD	HAND
	TAD	(-TTY
	SNA CLA		/IS IT TELETYPE INPUT?
	STA		/YES - SET TTY FLAG
	DCA	TTYFLG
	JMS	ECHO
TTYLF,	12		/ECHO LF IF TTY INPUT
	TAD	[12	/TTYLF IS ZEROED BY ABORTO
	DCA	TTYLF

READLP,	CLA
	TAD	HAND
	SPA CLA		/CHARACTER ORIENTED DEVICE?
	JMP	MASSIN	/NO - UNPACK CHAR FROM BUFFER
	JMS I	HAND	/GET A CHARACTER
GOTCHR,	AND	[177	/STRIP OFF PARITY
	JMS I	[CHTYPE	/CLASSIFY IT
	-15;	INCRET	/CARRIAGE RETURN
	-177;	RUBOUT	/RUBOUT
	-11;	INTAB	/TAB
	-25;	CTRLU	/^U
	-32;	INEOF	/^Z
	0		/ANYTHING ELSE
	TAD	CHCH
	TAD	[-40
	SMA		/IF CHARACTER IS >37,
	JMS	INPUTC	/STORE IT AND ECHO IT IF TTY
	JMP	READLP
/CHARACTER INPUT ROUTINE - SPECIAL CHARACTER HANDLERS

INTAB,	JMS	INPUTC	/TAB - INSERT (AND ECHO) BLANKS
	TAD	INXR
	AND	[7
	SZA CLA		/UNTIL A COLUMN MULTIPLE OF 8 IS REACHED
	JMP	INTAB
	JMP	READLP

RUBOUT,	TAD	EOLSW
	CIA
	TAD I	(INBUFR	/IGNORE RUBOUTS IF LINE EMPTY
	AND	TTYFLG
	SNA CLA
	JMP	READLP	/OR IF NON-TTY INPUT
	JMS	ECHO
	134		/ECHO A BACKSLASH
IBAKUP,	STA
	TAD	INXR
	DCA	INXR	/BACK UP LINE POINTER
	STA
	TAD	EOLSW
	DCA	EOLSW	/AND CHAR COUNTER
	JMP	READLP

INEOF,	TAD	VEOFSW	/CHECK SWITCH SET BY "CHKEOF" LIBRARY ROUTINE
	SNA		/WAS HE EXPECTING AN EOF?
EOFERR,	JMS I	ERR	/NO
	JMS I	MCDF
	DCA	.+1
	HLT		/CDF TO FIELD OF INDICATOR VARIABLE
	AC2000
	DCA I	VEOFSW+1	/SET VARIABLE TO .5
	CDF 0		/FALL INTO CARRIAGE RETURN CODE

INCRET,	DCA I	INXR	/CARRIAGE RETURN - ZERO OUT REST OF LINE
	SKP
CTRLU,	STA		/SNEAKY, SNEAKY!
	TAD	(INBUFR
	DCA	INXR	/RESET XR TO FETCH LINE CHARS
	JMS	ECHO
	15		/ECHO THE C.R.
	JMP	UNPKLN	/BACK TO FETCH FIRST CHAR

INPUTC,	0		/ROUTINE TO STORE AND ECHO A CHAR
	TAD	[40
	DCA	INTMP
	JMS	ECHO
INTMP,	0		/ECHO CHAR IF TTY INPUT
	TAD	INTMP
	DCA I	INXR	/STORE CHAR IN LINE BUFFER
	ISZ	EOLSW
	JMP I	INPUTC	/RETURN IF NO OVERFLOW
	JMP	IBAKUP	/IGNORE CHAR IF OVERFLOW
ECHO,	0		/ROUTINE TO ECHO CHAR IF TTY INPUT
	TAD I	ECHO	/GET CHAR
	AND	TTYFLG
	SZA		/SHOULD WE ECHO?
	JMS I	HAND	/YES
	JMP I	ECHO	/RETURN TO CHARACTER - ITS SMALL
TTYFLG,	0

/CHARACTER INPUT ROUTINE - MASS STORAGE SECTION

MASSIN,	JMS	MASBMP	/GET BUFFER FIELD AND CHAR NUMBER
	JMP	INLORD	/CHAR 1 OR 2 - STRAIGHTFORWARD
	JMS I	(GETCH3	/USE COMMON SUBROUTINE
	JMP	MASICM	/GO TO COMMON CODE

INLORD,	JMS I	[MASSIO	/CHECK IF WE SHOULD READ IN A BUFFERLOAD
	JMS	BUFFLD	/SET FIELD OF BUFFER
	TAD I	CHRPTR
MASICM,	ISZ	CHRPTR	/GET THE CHAR (IN LOW 8 BITS) AND BUMP PTR
	NOP		/WATCH END OF FIELD FUNNYBUSINESS!
	CDF 0		/RESET DATA FIELD
	JMP	GOTCHR	/GO EXTRACT SEVEN BIT CHARACTER

MASBMP,	0
	JMS	BUFFLD	/SET TO BUFFER'S DATA FIELD
	ISZ	CHRCTR	/BUMP CHAR COUNTER
	JMP I	MASBMP	/CHAR 1 OR 2 - NO SWEAT
	AC7775
	DCA	CHRCTR	/CHAR 3 - RESET CHAR CTR
	AC7776
	TAD	CHRPTR	/BUMP BACK CHAR PTR
	DCA	CHRPTR
	ISZ	MASBMP
	JMP I	MASBMP	/SKIP RETURN
	PAGE
/CHARACTER OUTPUT ROUTINE

FMTOUT,	0
	TAD	[40	/FIRST CONVERT SIXBIT TO ASCII
	SMA		/CTL CHARS COME IN NEGATIVE
	AND	[77
	TAD	(240
	DCA	OCHAR	/SAVE ASCII CHAR (WITHOUT PARITY BIT)
	TAD	EOLSW
	SZA CLA
	JMP	NOT1ST	/FIRST CHAR IS DECODED FOR FORMS CONTROL
	AC0002		/CHECK TO SEE IF THIS UNIT
	AND	HCODEW	/SHOULD RECEIVE FORMS CONTROL
	SZA CLA
	JMP	LFPLCH	/NO - JUST PRINT A LINE FEED AND THE CHAR
	TAD	OCHAR
	JMS I	[CHTYPE	/CLASSIFY CONTROL CHAR
	-261;	OUTFFX	/1 - TOP OF FORM
	-260;	OUT2LF	/0 - DOUBLE SPACE
	-253;	NOLF	/+ - OVERPRINT
	0		/ANYTHING ELSE - SINGLE SPACE
	JMP	OUTLF

OUTFFX,	TAD	HAND
	TAD	(-TTY	/IF HANDLER IS TTY OUTPUT TWO LINE FEEDS
	SZA CLA		/INSTEAD OF A FORM FEED
	JMP	OUTFF
OUT2LF,	TAD	[12
	DCA	OCHAR	/SET 2ND CHAR TO LINE FEED
LFPLCH,	STA
	DCA	EOLSW	/SET SWITCH FOR 2ND CHAR
	TAD	OCHAR
	DCA	CHCH	/SAVE CHARACTER AWAY
OUTLF,	AC7776
OUTFF,	TAD	F214	/SUBSTITUTE THE APPROPRIATE FORM CONTROL
	DCA	OCHAR	/FOR THE CHARACTER
NOT1ST,	TAD	HAND
	SPA CLA		/CHARACTER ORIENTED DEVICE?
	JMP	MASOUT	/NO - PACK CHAR INTO BUFFER
	TAD	OCHAR
	JMS I	HAND	/OUTPUT CHAR
NOLF,	ISZ	EOLSW	/BUMP CHAR CTR
	JMP I	FMTOUT	/NO - RETURN
	TAD	CHCH	/AHA - ANOTHER CHARACTER SHOULD BE OUTPUT
	JMP	OUTFF+1	/GO TO IT
/CHARACTER OUTPUT - MASS STORAGE OUTPUT

MASOUT,	JMS I	(MASBMP	/GET BUFFER FIELD AND CHAR NUMBER
	JMP	OULORD	/CHAR 1 OR 2 - STRAIGHTFORWARD
	JMS	OSUBR	/CHAR 3 - PACK FIRST HALFBYTE
	JMS	OSUBR	/PACK SECOND HALFBYTE
	AC4000
	JMS	MASSIO	/CHECK IF WE SHOULD DUMP THE BUFFER
MASOCM,	CDF 0
	JMP	NOLF	/GO RETURN OR REENTER

OULORD,	TAD	OCHAR
	DCA I	CHRPTR	/STORE CHAR, ZAPPING HIGH-ORDER BITS
	ISZ	CHRPTR	/BUMP CHAR PTR
F214,	214		/GUARD AGAINST OVFLO
	JMP	MASOCM	/RETURN

OSUBR,	0		/ROUTINE TO PACK A HALFBYTE
	TAD	OCHAR
	CLL RTL
	RTL		/SHIFT CHAR 4 LEFT
	DCA	OCHAR
	TAD I	CHRPTR	/CLEAR OUT ANY RESIDUE
	AND	[377	/FROM HIGH-ORDER OF BUFFER WORD
	DCA I	CHRPTR	/IN CASE WE ARE WRITING AFTER A BACKSPACE.
	TAD	OCHAR
	AND	[7400	/GET 4 BITS
	TAD I	CHRPTR
	DCA I	CHRPTR	/ADD INTO HIGH-ORDER OF BUFFER WORD
	ISZ	CHRPTR	/BUMP POINTER
	200		/OVERFLOW!
	JMP I	OSUBR

MASSIO,	0		/SUBROUTINE TO READ/WRITE BUFFER IF NECESSARY
	CDF 0
	TAD	BUFCDF	/ADD BUFFER CDF TO R/W BIT IN AC
	TAD	(-6001	/TAKE AWAY CDF, LEAVE BIT 4 ON
	DCA	IOCTL	/STORE I/O CONTROL WORD
	TAD	CHRPTR
	AND	[377
	SZA CLA		/SEE IF POINTER IS AT BUFFER BOUNDARY
	JMP I	MASSIO	/YES - RETURN DOING NOTHING
	TAD	RELBLK
	TAD	STBLK	/STORE BLOCK # IN HANDLER CALL
	DCA	BLOCK
	TAD	BADFLD
	AND	[7400
	DCA	BUFFER	/STORE BUFFER ADDRESS IN HANDLER CALL
/CHARACTER OUTPUT - BUFFER I/O ROUTINE CONTINUED

	TAD	TOTBLK
	CIA CLL
	TAD	RELBLK
	SZL CLA		/CHECK FOR FILE OVERFLOW
IOVFLO,	JMS I	ERR	/YES - ERROR
	TAD	HCODEW
	JMS I	(GETHND	/GET HANDLER INTO FIELD 0
	JMS I	HAND	/CALL HANDLER
IOCTL,	0
BUFFER,	0
BLOCK,	0
	SMA CLA		/HANDLER ERROR - ABORT
	SKP		/IF NOT EOF
IOERR,	JMS I	ERR
	JMS I	(RECOVR	/CLEAR ANY FLAGS SET BY OS8 HANDLER
	ISZ	RELBLK	/BUMP RELATIVE BLOCK NUMBER
	TAD	BUFFER
	DCA	CHRPTR	/RESET CHAR PTR
	JMP I	MASSIO	/RETURN
/FPP CODE FOR I/O CONVERSION

FDIV10,	FDIV+LONG
	TEN
	FEXIT
OCHAR,	0		/*** NEEDED FOR PADDING ***
FMUL10,	FMUL+LONG	/FMUL10 MUST BE AT FDIV10+4
	TEN
	FEXIT

FWTOBL,	FSUB+LONG
	ONE
	FDIV+LONG
	FLTG85
	FEXIT
	PAGE
/UNFORMATTED (BINARY) INPUT-OUTPUT

RWUNF,	JMS I	[RWINIT	/"READ(N)" OR "WRITE(N)"
	1000		/"UNFORMATTED" BIT
	TAD	SZLCLA	/ENABLE SEQUENCE CHECKING
UNFIO,	DCA	SEQCHK	/*** SET SEQCHK TO "SZL CLA" OR "CLA"
	DCA	RECCTR	/ENTER HERE FROM DIRECT ACCESS
	TAD	HAND
	SMA CLA		/CHECK FOR MASS-STORAGE HANDLER
	JMP I	[UNTERR	/NO - ERROR
	JMS I	[GETLMN	/GET FIRST VARIABLE
	TAD	RWFLAG
	SPA CLA
RSETBP,	TAD	(125	/INITIALIZE COUNT TO -86 FOR WRITE,
	CMA		/-1 FOR READ
	DCA	CHRCTR
	TAD	BADFLD
	AND	[7400
	DCA	BIOPTR	/INITIALIZE BUFFER POINTER
	TAD	BADFLD
	AND	[70
	IAC
	CLL RTR		/AC BIT 0 NOW ON
	TAD	RWFLAG	/AC BIT 0 CONTAINS COMP. OF R/W FLAG
	CLL RAR		/AC=(.NOT.RW)*2000+BUFFER FIELD
	TAD	(FSTA+LONG	/AC=(FSTA OR FLDA) + BUFFLD
	DCA	FGPBF
	JMP	UIOVLP	/SKIP FIRST VARIABLE FETCH/STORE
BFINCR,	JMS I	[FPGO
	FGPBF		/LOAD OR STORE A BUFFER ENTRY
	ISZ	BIOPTR
	ISZ	BIOPTR	/INCREASE BUFFER POINTER
	ISZ	BIOPTR
	JMS I	[GETLMN	/GET A VARIABLE FROM THE CALLING PROGRAM
UIOVLP,	TAD	RWFLAG
	CLL RAR		/LOWORDER BIT OF RWFLAG = END LIST FLAG
	SZL CLA
	JMP	ENDUIO	/NO MORE VARIABLES - TERMINATE
	ISZ	CHRCTR	/BUMP COUNTER
	JMP	BFINCR	/ROOM IN BUFFER - MOVE VARIABLE
	JMS	UDOIO	/GET A NEW BUFFER
	JMP	RSETBP	/RESET BUFFER POINTERS AND COUNTERS

ENDUIO,	TAD	RWFLAG	/COME HERE WHEN I/O LIST EXHAUSTED
	SPA CLA		/WRITE?
	JMS	UDOIO	/YES - WRITE OUT THE LAST BUFFER
	JMP I	[ENDIO	/RESTORE DSRN ENTRY AND QUIT

RECCTR,	0
/DIRECT-ACCESS I/O

RWDACC,	JMS I	[RWINIT	/"READ(N'R)" OR "WRITE(N'R)"
	1000		/DIRECT ACCESS IS UNFORMATTED I/O
	TAD I	XR
	DCA	T	/GET BLOCKS/RECORD FACTOR FROM D.A. TABLE
	JMS I	[ARGLD	/GET RECORD NUMBER
	JMS I	[FFIX	/CONVERT TO INTEGER
	TAD	T
	TAD	ACI
	ISZ	T	/MULTIPLY RECORD NUMBER BY BLOCKS/RECORD
	JMP	.-2	/TO GET RELATIVE BLOCK NUMBER
	DCA	RELBLK
	TAD I	XR
	SNA		/THIS LOC SHOULD NOT BE ZERO!
DAERR,	JMS I	ERR
	DCA	FGPBF	/IT SHOULD BE AN FSTA + THE FIELD
	TAD I	XR	/IN WHICH THE CONTROL VARIABLE IS
	DCA	BIOPTR	/STORED. THE NEXT WORD IS THE ADDRESS
	JMS I	[FPGO	/OF THE CONTROL VARIABLE IN THAT FIELD
	FADD1		/ADD 1 TO RECORD # AND STORE IN CONTROL VAR
	TAD	DUMPIT	/*K* "DCA T" SAME AS "CLA" HERE
	JMP	UNFIO	/NOW GO DO A REGULAR BINARY READ/WRITE

UDOIO,	0
	ISZ	RECCTR	/BUMP NUMBER OF RECORDS TRANSFERRED
	TAD	BADFLD
	AND	[7400
	TAD	[377	/FORM POINTER TO LAST WORD IN BUFFER
	DCA	BIOPTR
	TAD	RECCTR
	JMS	BUFFLD
	DCA I	BIOPTR	/FOR WRITE, PUT RECORD NUMBER IN 256TH WORD
UDOIOL,	DCA	CHRPTR
	AC4000
	AND	RWFLAG
	JMS I	[MASSIO	/DO I/O (CHRPTR=0 TO FORCE I/O)
	JMS	BUFFLD
	TAD	RECCTR
	CMA STL		/FOR READ, CHECK THE INPUT
	TAD I	BIOPTR	/SEQUENCE NUMBER TO MAKE SURE IT IS
	CDF 0		/NO LARGER THAN THE ONE WE EXPECT.
SEQCHK,	SZL CLA		/*K* IF IT IS LARGER THIS IMPLIES THAT WE
	JMP I	UDOIO	/ARE STILL IN THE MIDDLE OF THE LAST
	JMP	UDOIOL	/RECORD AND SO WE READ AGAIN.
/DEFINE FILE PROCESSOR

DFINE,	JMS I	[RWINIT	/SET UP A POINTER INTO THE D.A. TABLE
	1000		/DIRECT ACCESS I/O IS UNFORMATTED
	JMS I	[ARGLD	/GET NUMBER OF RECORDS
	JMS I	[FFIX
	TAD	ACI
	CIA
DUMPIT,	DCA	T	/SAVE IT FOR MULTIPLY
	JMS I	[ARGLD	/GET THE NUMBER OF WORDS/RECORD
	JMS I	[FPGO	/CONVERT WORDS TO BLOCKS
	FWTOBL
	JMS I	[FFIX	/CONVERT TO INTEGER
	ISZ	ACI
	TAD	ACI	/MULTIPLY THE NUMBER OF BLOCKS/RECORD
	ISZ	T	/BY THE NUMBER OF RECORDS
	JMP	.-2
	DCA	RELBLK	/TO GET THE FILE LENGTH IN BLOCKS
	TAD	ACI
	CIA
	DCA I	XR	/STORE NUMBER OF BLOCKS/RECORD
	JMS I	[ARGLD	/GET POINTER TO CONTROL VARIABLE
	TAD	FGPBF
	TAD	(FSTA-FLDA	/CHANGE A LOAD TO A STORE
	DCA I	XR	/SAVE "FSTA CONTROL-VARIABLE"
	TAD	BIOPTR
	DCA I	XR
	TAD	TOTBLK
	CMA CLL
	TAD	RELBLK	/MAKE SURE WE HAVE ROOM FOR THE FILE
SZLCLA,	SZL CLA
DFERR,	JMS I	ERR	/WE DON'T
	AC7776
	AND	FFLAGS
	IAC		/FORCE "END-FILED" BIT FOR CLOSE
	JMP I	(SETTOT	/SET LENGTH AND EXIT
	PAGE
/SWAPPER AND ERROR ROUTINE

SWAP,	JMS I	[FETPC	/SWAPPER CALLING SEQUENCE:
	DCA	T	/	TRAP3 SWAP
	TAD	T	/	ADDR OVLY*4000000+LVL*100000+ENTRYADR
	AND	[7
	TAD	(JA
	DCA	STRTUP	/STORE JA TO ENTRY POINT
	JMS I	[FETPC
	DCA	STRTUP+1
	TAD	T
	AND	[70
	CLL RAR		/FORM 4*LVL
	TAD	(OVLYTB	/INDEX INTO LEVEL TABLE
	DCA	ADR
	TAD	T
	AND	[7400
	DCA	T	/T CONTAINS OVERLAY NUMBER IN BITS 0-3
	CDF 0		/WATCH D.F.!
	TAD I	ADR
	TAD	T	/SEE IF THIS OVERLAY IS IN CORE
	SNA CLA
	JMP	ITSIN	/YES - DON'T LOAD
	TAD	T
	CIA
	DCA I	ADR	/MARK THIS OVERLAY IN CORE (OPTIMIST)
	ISZ	ADR
	TAD I	ADR
	AND	[7400
	DCA	OVADR	/SAVE INITIAL OVERLAY LOAD ADDRESS
	TAD I	ADR
	AND	[70
	DCA	OVIOW	/AND FIELD
	ISZ	ADR
	TAD I	ADR	/GET STARTING BLOCK OF THIS LEVEL
	DCA	OVBLK
	ISZ	ADR
	TAD I	ADR
	DCA	OVLEN	/STORE LENGTH OF OVERLAY IN BLOCKS
OVADLP,	TAD	T	/LEVEL STARTING BLOCK +
	SNA		/(OVERLAY #) * (OVERLAY LENGTH)
	JMP	LOADOV	/= OVERLAY STARTING BLOCK
	TAD	[7400
	DCA	T
	TAD	OVBLK
	TAD	OVLEN
	DCA	OVBLK
	JMP	OVADLP
/SWAPPER - CONTINUED

LOADLP,	DCA	OVLEN	/STORE UPDATED OVERLAY LENGTH
	TAD	OVIOW	/GET LAST READ CONTROL WORD
	RAL
	AND	[7400	/CONVERT BLOCK COUNT TO WORD COUNT
	TAD	OVADR	/INCREMENT OVERLAY LOAD ADDRESS (LINK = 0)
	DCA	OVADR
	RTL
	RTL		/USE THE CARRY
	TAD	OVIOW	/TO INCREMENT THE LOAD FIELD IF NECESSARY
	AND	[70
	DCA	OVIOW	/OVIOW CONTAINS ONLY THE LOAD FIELD NOW

LOADOV,	TAD	OVADR
	CIA		/LOTSA CALCULATIONS HERE - OS/8 HANDLERS
	SNA		/CAN'T READ MORE THAN 15 BLOCKS AT A TIME
	TAD	[7400	/AND CANNOT READ OVER FIELD BOUNDARIES
	CLL RTL
	RTL		/SO WE MUST BREAK UP THE OVERLAY READ
	CMA CML RAL	/INTO SEVERAL SMALL READS OF MAXIMAL LENGTH.
	TAD	OVLEN	/THE NUMBER OF BLOCKS TO READ IS GIVEN BY:
	CMA		/MINIMUM(B,L,15)
	SMA		/WHERE B IS THE # OF BLOCKS LEFT IN THIS FIELD
	CLA		/AND L IS THE # OF BLOCKS LEFT IN THE OVERLAY
	TAD	OVLEN	/AND 15 IS THE # OF BLOCKS A HANDLER CAN READ
	DCA	T	/	ANSWER IN T
	TAD	T
	CLL RTR
	RTR
	RTR		/TURN NUMBER OF BLOCKS INTO 0S/8 BLOCK COUNT
	TAD	OVIOW
	DCA	OVIOW	/ADD FIELD BITS AND STORE AS I/O CONTROL WD
	TAD	OVHCDW	/GET OVERLAY HANDLER CODE WORD
	JMS I	(GETHND	/LOAD HANDLER INTO FIELD 0
	JMS I	OVHND
OVIOW,	0
OVADR,	0
OVBLK,	0
OVERR,	JMS I	ERR	/WHOOPS - OVERLAY READ ERROR
	JMS	RECOVR	/CLEAR ANY NASTY FLAGS LEFT BY HANDLER
	TAD	T
	TAD	OVBLK
	DCA	OVBLK	/UPDATE BLOCK NUMBER
	TAD	T
	CIA
	TAD	OVLEN	/BUMP DOWN RECORD COUNT
	SZA		/SEE IF WE ARE DONE
	JMP	LOADLP	/NO - PREPARE FOR NEXT READ
/OVERLAY IN CORE - EXECUTE IT

ITSIN,	JMS I	[FPGO	/START UP FPP
	STRTUP		/AND JA TO ENTRY POINT

TRAP5I,
TRAP6I,
TRAP7I,
FPAUSE,
FPPERR,	JMS I	ERR	/SHOULD NEVER GET HERE

STRTUP,	0;0		/JA ENTRY
OVLEN,	0
OVHND,	0		/SET BY LOADER
OVHCDW,	0		/SET BY LOADER

RECOVR,	0		/ROUTINE TO CLEAN UP ANY FLAGS
	DCA	CTCINH	/LEFT ON BY SLOPPY OS/8 HANDLERS.
YRCOVR,	NOP
	NOP
	NOP
	NOP		/RIGHT NOW I DON'T KNOW OF ANY.
	NOP
	NOP
	NOP
	NOP
	ION
	JMP I	RECOVR

FSTTMP,	FSTA+LONG
	FTEMP
	FEXIT

TEN,	4;2400;0;0;0;0	/10.0D0
FLTG85,	7;2520;0	/85.0
	PAGE
/INPUT BUFFER - CONTAINS STARTUP CODE

INBUFR,	-206		/LENGTH
	0		/INPUT LINE BUFFER - FIRST A LITTLE PADDING,

/RTS EXECUTION INITIALIZATION - IN INPUT BUFFER

FPSTRT,	6601		/CLEAR DF32 FLAG
	PCF		/HSP FLAG
	RRB		/HSR FLAG
PP7600,	7600		/CLEAR READER CHAR
	6135		/CLEAR KW12 OR DK8-EP EVENT FLAGS
	CLA
	6132		/STOP KW12 CLOCKS
	6134		/DISABLE KW12 INTERRUPTS
	6530		/CLEAR AD8-EA FLAGS
	6050		/CLEAR VC8/E FLAG
	6500		/DISABLE XY8/E INTERRUPTS
	STA
	6130		/DISABLE DK8-EP INTERRUPTS
	CLA		/LEAVE SPACE FOR ADDITIONAL CLEARS
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	NOP
	DCA	EOLSW
LDPROG,	JMS I	[FPGO	/START UP FPP OR PSEUDO-FPP
	STSWAP
HLTNOP,	NOP		/SET TO HLT IF /H SPECIFIED,
	JMP	PRTCR	/SKP IF /P SPECIFIED
	TAD	.-1
	DCA	LDPROG	/BYPASS LOADING ON STARTUP
	TAD	PCHWD	/HLT
	DCA I	(PDPXIT+1
/ROUTINE TO PUNCH RTS+PROGRAM ON FORTRAN UNIT 9 (UNCOMMENTED)

PPTR,	TAD	P11
PCKSUM,	DCA	ACI
	JMS I	(LDDSRN
	SMA CLA
	JMP I	[UNTERR
	JMP	LDRTLR
FLDLP,	DCA	PPTR
	DCA	PCKSUM
	TAD	(100
	JMS	SIXOUT
	JMS	SIXOUT
	TAD	FLD
	AND	[70
JFMOUT,	JMS I	[FMTOUT	/*K* ONLY WORKS FOR FIELD 0-3
	TAD	(100
	JMS	SIXOUT
	JMS	SIXOUT
FLD,	CDF 0
	TAD I	PPTR
	CDF 0
	JMS	PCHWD
	ISZ	PPTR
P11,	11
	ISZ	PCTR
	JMP	FLD
	TAD	PCKSUM
	JMS	PCHWD
	TAD	FLD
	TAD	(10
	DCA	FLD
LDRTLR,	TAD	PP7600
	DCA	ACH
	TAD	[200
	JMS	SIXOUT
	ISZ	ACH
	JMP	.-3
	ISZ	FCNT
	JMP	FLDLP
	TAD	(6000
	DCA	FFLAGS
	DCA I	(ENDFLS	/*K* SAME KLUDGE AS CALXIT
	JMS I	(ENDFL
	DCA I	(PDPXIT+1	/WIPE HALT SO WE CAN RETURN TO OS/8
	JMP I	(PDPXIT-1
PCHWD,	HLT
	DCA	ACH
	TAD	ACH
	RTR
	RTR
	RTR
	AND	[77
	JMS	SIXOUT
	TAD	ACH
	AND	[77
	JMS	SIXOUT
	JMP I	PCHWD

SIXOUT,	0
	DCA	T
	CLA IAC
	DCA	EOLSW
	TAD	PCKSUM
	TAD	T
	DCA	PCKSUM
	TAD	T
	TAD	(-300
	JMS I	[FMTOUT
	JMP I	SIXOUT

PCTR,	200		/DON'T PUNCH 07600!
FCNT,	0
PRTCR,	TAD	(215
	JMS I	PTTY	/PRINT CARRIAGE RETURN
	TAD	JFMOUT
	DCA I	(ERRENB	/ENABLE ERROR TRACEBACK
	JMS I	[FPGO
	STJUMP		/NOW JUMP TO THE NEWLY-LOADED CODE
STSWAP,	TRAP3		/TRAP3
	SWAP
	0
	.+1
	TRAP3
	HLTNOP
	PAGE
STJUMP,	0
	0
	ZBLOCK	INBUFR+210-.	/PAD OUT TO END OF BUFFER
/OVERLAY AND DSRN TABLES

	*.-4	/FIRST ENTRY IN OVLYTB ONLY NEEDED TO LOAD MAIN PGM

OVLYTB,	ZBLOCK	40	/OVERLAY TABLE

DSRN,	PTR;	ZBLOCK	10
	PTP;	ZBLOCK	10
	LPT;	ZBLOCK	10
	TTY;	0;0
	1234		/*K* PREVENT PROBLEM IN
	ZBLOCK	5	/RWINIT INVOLVING WRITE
			/AFTER READ ON TELETYPE
	ZBLOCK	55

	ZBLOCK	12	/FORMAT PARENTHESIS PUSHDOWN LIST
FMTPDL,	0		/GUARD WORD
	PAGE
/SOFTWARE FLOATING POINT ROUTINES WHICH ARE USED
/EVEN IF FLOATING HARDWARE IS PRESENT

/** MUST NOT DESTROY FAC! **

FFIX,	0		/ROUTINE TO FIX FAC
	STA		/ANSWER IS RETURNED IN ACI
TADACX,	TAD	ACX	/ABS(FAC) MUST BE LESS THAN 2048
	CLL		/DETERMINE IF FAC EXPONENT IS
	TAD	(-13	/BETWEEN 1 AND 14
	SNA
	JMP	FIXBIG	/14 IS A SPECIAL CASE
EAEFIX,	DCA	ACI
	SZL
	JMP	FIXDNE	/EXP GT 14 OR LT 1 - RETURN 0
	TAD	ACH
	JMP	FIXISZ
FIXLP,	CLL		/0 IN LINK
	SPA		/IS IT LESS THAN 0?
	CML		/YES-PUT A 1 IN LINK
	RAR		/SCALE RIGHT
FIXISZ,	ISZ	ACI	/DONE YET?
	JMP	FIXLP	/NO
FIXDNE,	DCA	ACI	/RETURN WITH ANSWER IN ACI
	JMP I	FFIX	/RETURN

FIXBIG,	TAD	ACL	/IF EXP IS 14 WE MUST SHIFT AC FRACTION
	RAL		/LEFT ONE PLACE TO INTEGERIZE IT.
	CLA
	TAD	ACH
	RAL
	JMP	FIXDNE	/STORE ANSWER AND RETURN

SETB,	TAD	DATAF
	DCA I	(BASCDF	/SET BASE PAGE LOCATION
	TAD	ADR
	DCA	BASADR
	JMP I	FPNXT
/
/SHIFT FAC LEFT 1 BIT
/
AL1,	0
	TAD	AC1	/GET OVERFLOW BIT
	CLL	RAL	/SHIFT LEFT
	DCA	AC1	/STORE BACK
	TAD	ACL	/GET LOW ORDER MANTISSA
	RAL		/SHIFT LEFT
	DCA	ACL	/STORE BACK
	TAD	ACH	/GET HI ORDER
	RAL
	DCA	ACH	/STORE BACK
	JMP I	AL1	/RETN.
/
/SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE)
/
ACSR,	0
	CMA		/AC CONTAINS COUNT-1
	DCA	AC0	/STORE COUNT
LOP1,	TAD	ACH	/GET HIGH ORDER MANTISSA
	CLL
	SPA		/PROPAGATE SIGN
	CML
	RAR		/SHIFT RIGHT 1, PROPAGATING SIGN
	DCA	ACH	/STORE BACK
	TAD	ACL	/GET LOW ORDER
	RAR		/SHIFT IT
	DCA	ACL	/STORE BACK
	ISZ	ACX	/INCREMENT EXPONENT
	NOP
	ISZ	AC0	/DONE?
	JMP	LOP1	/NO-LOOP
	RAR
	DCA	AC1	/SAVE 1 BIT OF OVERFLOW
	JMP I	ACSR	/YES-RETN-AC=L=0
/
/FLOATING NEGATE
/
FFNEG,	0		/(USED AS A TEM. BY OUTPUT ROUTINE)
	TAD	ACL	/GET LOW ORDER FAC
	CLL CMA IAC	/NEGATE IT
	DCA	ACL	/STORE BACK
	CML	RAL	/ADJUST OVERFLOW BIT AND
	TAD	ACH	/PROPAGATE CARRY-GET HI ORD
	CLL CMA IAC	/NEGATE IT
	DCA	ACH	/STORE BACK
	JMP I	FFNEG
OADD,	0		/ADD OPERAND TO FAC
	CLL
	TAD	AC2	/ADD OVERFLOW WORDS
	TAD	AC1
	DCA	AC1
	RAL		/ROTATE CARRY
	TAD	OPL	/ADD LOW ORDER MANTISSAS
	TAD	ACL
	DCA	ACL
	RAL
	TAD	OPH	/ADD HI ORDER MANTISSAS
	TAD	ACH
	DCA	ACH
	JMP I	OADD	/RETN.

FETPC,	0
	ISZ	PC
	JMP	PCCDF	/NO FIELD BUMP
	ISZ	APT	/BUMP FIELD FOR FPP RESTART (IN CASE FPP EXISTS)
FPC10,	10		/PROTECTION FOR ISZ
	TAD	PCCDF
	TAD	FPC10
	DCA	PCCDF
PCCDF,	HLT
	TAD I	PC
	JMP I	FETPC

EEPUT,	STL		/EXTENDED PRECISION STORE
EEGET,	DCA	ADR	/EXTENDED PRCISION FETCH
	TAD	[-6
	DCA	DATCDF
	SNL
	AC2000		/SET UP "TAD ACX" OR "DCA ACX"
	TAD	TADACX
	DCA	EEINST
EELOOP,	SNL		/LINK=1 MEANS STORE
	TAD I	ADR
EEINST,	HLT
	SZL
	DCA I	ADR
	ISZ	ADR
	SKP
	JMS I	(DFBUMP
	ISZ	EEINST
	ISZ	DATCDF
	JMP	EELOOP
	JMP I	FPNXT

FSTTM2,	FSTA+LONG
	FTEMP2
	FEXIT
/
FTEMP,	ZBLOCK	6
/
	PAGE
/RUN-TIME SYSTEM ERROR LIST

ERRLST,	VARGER;	ARGMSG
	UERR;	UMSG
	FPOERR;	FPOMSG
	FMTERR;	FMTMSG
	UNTERR;	UNTMSG
	CTLBER;	CTLBMS
	INER;	INMSG
	IOVFLO;	IOVMSG
	IOERR;	IOMSG
	DAERR;	DAMSG
	FPPERR;	FPPMSG
	OVERR;	OVMSG
	EOFERR;	INEMSG
	FPOVER;	OFLMSG
	DFERR;	DFMSG
	-1;	DV0MSG	/BY ELIMINATION
/RTS ERROR MESSAGES

ARGMSG,	TEXT	/BAD ARG/
UMSG,	TEXT	/USER ERROR/
FPOMSG,	TEXT	/PARENS TOO DEEP/
FMTMSG,	TEXT	/FORMAT ERROR/
UNTMSG,	TEXT	/UNIT ERROR/
INMSG,	TEXT	/INPUT ERROR/
OVMSG,	TEXT	/OVERLAY /
	*.-1
IOMSG,	TEXT	%I/O ERROR%
DAMSG,	TEXT	/NO DEFINE FILE/
FPPMSG,	TEXT	/FPP ERROR/
INEMSG,	TEXT	/EOF ERROR/
DV0MSG,	TEXT	/DIVIDE BY 0/
DFMSG,	TEXT	/D.F. TOO BIG/
IOVMSG,	TEXT	/FILE  /
	*.-1
OFLMSG,	TEXT	/OVERFLOW/
CTLBMS,	TEXT	/^B/

USRERR,	TAD	ERRFLG	/USER ERROR - OPTIONALLY NON-FATAL
	DCA	FATAL
UERR,	JMS I	ERR	/PRINT MESSAGE
	JMP I	[RETURN	/IF NON-FATAL, CONTINUE PROCESSING
ERRFLG,	0		/SET TO NON-ZERO IF /E SWITCH SPECIFIED

TRPPRT,	TRAP3		/CODE WHICH IS LOADED INTO PROGRAM PROLOGUES
	PRTNAM		/BY THE ERROR TRACEBACK ROUTINE
	PAGE
MAKCDF,	0		/ROUTINE TO MAKE A CDF FROM AC9-11
	RTL
	RAL
	AND	[70
	TAD	ERCDF	/STRAIGHTFORWARD ENOUGH, ISN'T IT?
	JMP I	MAKCDF

RD2WR,	0		/ROUTINE CALLED WHEN SWITCHING
	STA		/FROM READ TO WRITE. (CALLED ONLY ONCE!)
	TAD	RELBLK	/BUMP BLOCK # BACK FROM "NEXT BUFFER'S BLOCK #"
	DCA	RELBLK	/TO "THIS BUFFER'S BLOCK #".
	TAD	CHRCTR	/HOWEVER, IF WE ARE AT THE VERY END OF A
	IAC		/BUFFER, WRITE ROUTINE EXPECTS US TO
	SZA CLA		/BE AT THE BEGINNING OF THE NEXT BUFFER,
	JMS I	[MASSIO	/SO RE-READ THIS BUFFER AND SET POINTERS
	JMP I	RD2WR

/RUN-TIME-SYSTEM ERROR ROUTINE

ERROR,	0
ERCDF,	CDF 0
	CLA
	TAD	(ERRLST-2
	DCA	XR
ERRLP,	ISZ	XR	/SEARCH ERROR LIST FOR CALLING ADDRESS
	TAD I	XR	/ERROR LIST CONTAINS
	CMA
	SZA		/CALLING ADDRESSES AND
	TAD	ERROR	/CORRESPONDING MESSAGES
	SZA CLA
	JMP	ERRLP
	TAD I	XR
	DCA I	(FMTADR
	DCA I	(FMTDF
	TAD	PTTY
	DCA	HAND	/QUICK FUDGE FOR TTY OUTPUT
	DCA	HCODEW	/TO SET CARRIAGE CONTROL
	AC4000
	DCA	RWFLAG
	JMS I	[EOLINE	/TYPE CARRET AND SET EOLSW
	DCA	FMTBYT	/INITIALIZE MESSAGE PTR
ERPTLP,	JMS I	[FMTOUT	/OUTPUTS LF FIRST TIME
	JMS I	[FMTGCH	/GET CHAR USING FORMAT ROUTINES
	ISZ	FMTBYT
	SZA
	JMP	ERPTLP	/LOOP UNTIL 0 CHAR
/PRINT ROUTINE NAME AND LINE NUMBER

PRTNAM,	TAD	[40
ERRENB,	JMP I	E7605	/*K* IN CASE INITIALIZATION OR /P GET ERRORS
/		PREVIOUS LINE REPLACED WITH:
/	JMS I	[FMTOUT	/OUTPUT A BLANK(LF ON EXTRA LINES)
	JMS I	[FPGO	/START UP FPP
	GTNMPT		/GET POINTER TO NAME IN FAC
	TAD	ACH
	DCA I	(FMTDF	/SET UP FORMAT GET CHARACTER ROUTINE
	TAD	ACL	/TO GET CHARACTERS OF ROUTINE NAME
	DCA I	(FMTADR
	DCA	FMTBYT
	TAD	[-6
	DCA	ISN	/6 CHARACTER NAME
PRTNML,	JMS I	[FMTGCH
	SNA
	TAD	[40	/AVOID PRINTING RANDOM @S
	JMS I	[FMTOUT	/GET AND PRINT A CHARACTER
	ISZ	FMTBYT
	ISZ	ISN
	JMP	PRTNML
	TAD	[40
	JMS I	[FMTOUT	/SEPARATE THE NAME BY A SPACE
	TAD	[-4	/FROM THE LINE NUMBER.
	DCA	ISN
PTLNLP,	TAD	ISN+1
	CLL RTL
	RAL
	DCA	ISN+1	/PRINT LINE NUMBER IN OCTAL
	TAD	ISN+1	/BECAUSE THAT IS THE WAY IT APPEARS
	RAL		/IN THE FORTRAN PROGRAM LISTING
	AND	[7
	JMS I	(DIGIT
	ISZ	ISN
	JMP	PTLNLP

	JMS I	[EOLINE	/OUTPUT FINAL CR
	TAD	FATAL
	SNA CLA		/FATAL ERROR?
	JMP	TRCBAK	/YES - GIVE FULL TRACEBACK
	DCA	FATAL	/"NON-FATAL" FLAG MUST BE SET EACH TIME
	JMP I	ERROR
TRCBAK,	JMS I	[FPGO	/START UP FPP
	UP1LEV		/MOVE UP TO CALLING ROUTINE
			/FPP CODE DOES A "TRAP3 PRTNAM"
ISN,	0;0
/FPP CODE FOR ERROR ROUTINE

GTNMPT,	STARTD
	XTA	0	/LOAD LINE NUMBER FROM XR 0
	FSTA+LONG
	ISN		/STORE AWAY
	FLDA+BASE 10	/LOAD POINTER TO PROLOGUE
	FSUB+LONG
	THREE		/NAME IS 3 LOCATIONS BEFORE PROLOGUE
	STARTF		/FOR NON-FPP VERSION
THREE,	FEXIT;3		/*K* DEPENDS ON FACT THAT FEXIT=0

UP1LEV,	STARTD
	FLDA+BASE 11	/GET THE UPWARD POINTER
	JNE
	NOTMN		/ZERO MEANS MAIN PROGRAM
	TRAP3
E7605,	7605		/GO AWAY IF MAIN PROGRAM
NOTMN,	FSTA+BASE 0
	LDX	1
	2		/WE WILL STORE A "TRAP3 PRTNAM"
	FLDA+LONG	/IN THE FIFTH LOCATION OF THE PROLOGUE,
	TRPPRT
	FSTA+IND 0+10	/WHERE THE FIRST 4 LOCS WERE A SETX AND SETB.
	FLDA+BASE 0	/GET THE PROLOGUE ADDRESS AGAIN
	JAC		/JUMP TO IT.

ACMDGT,	FMUL+LONG
	TEN
	FSTA+LONG
	FTEMP
	FLDA+LONG
	DGT		/GET UNNORMALIZED DIGIT INTO AC
	FNORM		/NORMALIZE IT
FADTMP,	FADD+LONG
	FTEMP
	FEXIT
LPBUFR,	ZBLOCK	4
	LPBUF2
	PAGE
HPLACE,	/ZBLOCK	400	/HANDLER SWAP AREA

/VARIOUS INITIALIZATION STUFF OVERLAYING THE RTS HANDLER AREA

QLHDR,	0		/SHOULD BE A 2 FOR A LOADER IMAGE
QRTSWP,	ZBLOCK	2	/INITIAL SWAP ARGS TO LOAD USER MAIN
QHGHAD,	ZBLOCK	2	/HIGHEST ADDRESS USED
QVERNO,	0		/LOADER VERSION #
QDPFLG,	0		/"PROGRAM USES D.P." FLAG
QUSRLV,	ZBLOCK	40	/USER OVERLAY INFO

/EAE OVERLAY TO FIX AND FLOAT

EFXFLT,	RELOC	EAEFIX

FIXEAE,	CMA
	DCA	FIXSH	/SHIFT COUNT BETWEEN 0 AND 12
	SZL
	JMP	FIX0	/NOT INTEGERIZABLE
	TAD	ACH
	ASR
FIXSH,	0
FIX0,	DCA	ACI
	JMP I	FFIX

FXFLTC=	.-FIXEAE
	RELOC
/SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF
/BANKS IN AC.
/MUST RUN IN FIELD 0.

CORE,	0
	TAD	C6203
	RDF
	DCA	CORRET
CORELP,	CDF 0		/NEEDED FOR PDP-8L
	TAD I	C7777
	AND	COR70	/IF BITS 6-8 OF LOCATION 7777 ARE NOT ZERO,
	CLL RTR		/THEY SPECIFY THE LAST FIELD OF CORE
	RAR		/WHICH WE SHOULD USE.
	SZA
	JMP	CORRET	/SO RETURN THAT AMOUNT
	TAD TRYFLD	/GET FLD TO TST
	CLL RTL
	RAL
	AND	COR70	/MASK USEFUL BITS
	TAD	CORELP
	DCA	COR706	/SET UP CDF TO FLD
COR706,	0
	TAD I	CORLOC	/SAV CURRENT CONTENTS
	NOP		/HACK FOR PDP-8
	DCA	.-3
	TAD	.-2	/7000 IS A GOOD PATTERN
	DCA I	CORLOC
COR70,	70		/HACK FOR PDP-8.,NO-OP
	TAD I	CORLOC	/TRY TO READ BK 7000
CO7400,	7400		/HACK FOR PDP-8,.NO-OP
	TAD	CO7400	/GUARD AGAINST WRAP AROUND
	TAD	CORLOC+1	/TAD 1400
	SZA CLA
	JMP	.+5	/NON EXISTENT FLD EXIT
	TAD	COR706	/RESTORE CONTENS DESTROYED
	DCA I	CORLOC
	ISZ	TRYFLD /TRY NXT HIGHER FLD
	JMP	CORELP
	STA
	TAD	TRYFLD
CORRET,	0
	JMP I	CORE
CORLOC,	CO7400		/ADR TO TST IN EACH FLD
	1400		/7000+7400+1400=0
TRYFLD,	1		/CURRENT FLD TO TST
C6203,	6203
C7777,	7777

DPTEST,	STARTE		/EXECUTED BY FPP DURING INITIALIZATION
	FEXIT		/CHECK WHETHER DOUBLE PRECISION ENABLED
/TABLE OF MODIFICATIONS TO MAKE TO FRTS FOR BACKGROUND OPERATION
/UNDER RTS-8.  FORMAT OF TABLE IS: POINTER TO FIRST WORD OF BLOCK - 1
/ (0 TERMINATES) FOLLOWED BY LIST OF REPLACEMENT WORDS (0 TERMINATES).

BKRLST,	YLPT-1		/LINE PRINTER OUTPUT ROUTINE
	RELOC	YLPT
	LLS
	CLA		/DON'T DO RING-BUFFERING - JUST "OUTPUT" CHAR.
	JMS	CTCBCK	/CHECK FOR ^C OR ^B
	JMP I	LPT
FJCTCT,	JMS	CTCBCK	/COME HERE FROM INTERPRETED FPP JUMPS
	JMP I	FPNXT	/CHECK FOR ^C,^B AND RETURN TO INTERPRETER
	RELOC
	0

	YPTP-1		/PAPER-TAPE PUNCH ROUTINE
	CLA		/ALL PAPER-TAPE I/O ILLEGAL
	0
	YPTR-1		/PAPER TAPE READER ROUTINE
	CLA		/ALL PAPER-TAPE I/O ILLEGAL
	0

	YTTY-1		/TELETYPE INPUT/OUTPUT ROUTINE
	RELOC	YTTY
	SNA
	JMP	KBDRTS	/AC=0 MEANS INPUT
	TSF
	JMP	.-1	/HANG UNTIL OUTPUT BUFFER NOT FULL
	TLS
	CLA
	JMS	CTCBCK	/CHECK FOR ^C OR ^B TYPED
	JMP I	TTY
KBDRTS,	KSF
	JMP	.-1	/HANG UNTIL CHAR RECEIVED
	JMS	CTCBCK	/CHECK FOR ^C OR ^B
	KRB
	AND	KB177	/STRIP PARITY
	TAD	KB177
	IAC		/NOW FORCE PARITY BIT ON (177+1=200)
	JMP I	TTY

CTCBCK,	.		/*K* CAN'T BE 0!
	KRS		/PEEK AT NEXT CHAR IN BUFFER
	AND	KB177
	TAD	KBM2
	CLL RAR
	SNA CLA		/IS IT ^C OR ^B?
	KSF		/AND IS IT REALLY PENDING?
	JMP I	CTCBCK	/NO - JUST RETURN WITH AC=0
	JMP	BEEORC	/TERMINATE JOB - LINK HAS ^C/^B FLAG
KB177,	177
KBM2,	-2
	RELOC
	0
/CONTINUATION OF TABLE OF RTS-8 OVERLAYS TO FRTS

	YHIOF-1		/"GET OS/8 HANDLER" ROUTINE
	NOP		/ELIMINATE "IOF" INSTRUCTION
	0

	YRCOVR-1	/"RECOVER FROM OS/8 HANDLER" ROUTINE
	RELOC	YRCOVR
	JMP I	RECOVR	/SHORT-CIRCUIT PORTION OF ROUTINE WHICH DOES
	RELOC		/AN "ION"
	0

	YFJMP-1		/FPP INTERPRETER - SUCCESSFUL JUMP SECTION
	FJCTCT		/TEST FOR ^C OR ^B TYPED BEFORE
	0		/RETURNING TO THE INTERPRETER

	0		/** LIST TERMINATOR **
/ERROR MESSAGES FOR RUN-TIME LOADER - IN HANDLER BUFFER
/*K* CANNOT LOAD BELOW HPLACE+200 AS HPLACE-HPLACE+177 ARE DESTROYED BY HEADER!

	IFNZRO	.-HPLACE-200&4000	<__ERROR__>

NOLI,	TEXT	/NOT A LOADER IMAGE/
NONMSG,	TEXT	/NO NUMERIC SWITCH/
FILMSG,	TEXT	/FILE ERROR/
SYSMSG,	TEXT	/SYSTEM DEVICE ERROR/
TOOMCH,	TEXT	/MORE CORE REQUIRED/
TOMNYH,	TEXT	/TOO MANY HANDLERS/
LIOEMS,	TEXT	/CAN'T READ IT!/
NODPMS,	TEXT	/CAUTION - NO DP/
XVERMS,	TEXT	/FRTS V/
	*.-1
	XVERSN&70^7+XVERSN+4060		/VERSION NUMBER IN SIXBIT
	XPATCH&77^100+40		/PATCH LEVEL
	TEXT	/     /
	PAGE
/FPP INTERPRETER STARTUP ROUTINE

FPPINT=	.		/FOR FPP OVERLAY
RETURN,	JMP I	FPNXT	/RETURN DOES SOMETHING DIFFERENT IF FPP PRESENT

FPGO,	0
FPGCDF,	CDF 0		/NECESSARY?
	CLA
	TAD	PC
	DCA	SAVPC	/ALLOW ONE LEVEL OF RECURSIVENESS
	TAD I	(PCCDF
	DCA	SPCCDF
	STA
	TAD I	FPGO
	DCA	PC
	ISZ	FPGO
	TAD	FPGCDF	/FPGO STARTS UP THE FPP FROM FIELD 0 ONLY
	DCA I	(PCCDF
	JMP I	FPNXT

EXIT,	TAD	SAVPC
	DCA	PC
	TAD	SPCCDF
	DCA I	(PCCDF	/RESTORE OLD PC
	JMP I	FPGO	/RETURN TO PDP-8 CODE
SAVPC,	0
SPCCDF,	0

FPXTA,	TAD	[27	/XR TO AC - NORMALIZE IF FLOATING MODE
	DCA	ACX
	JMS	DATCDF
	TAD I	ADR
CLFAC,	DCA	ACL
	TAD	ACL
	SPA CLA		/SIGN-EXTEND 12-BIT WORD
	STA		/INTO FAC FRACTION
	DCA	ACH
NRMFAC,	DCA	AC1	/CLEAR OVERFLOW WORD
	TAD	DFLG
	SPA SNA CLA	/UNLESS WE ARE IN D.P.I. MODE,
	JMS I	NORMX	/NORMALIZE THE FAC
	JMP I	FPNXT
/MISCELLANEOUS JUMP CLASS INSTRUCTIONS

JSA,	TAD	ADR
	DCA	PUTM
	TAD	DATAF
	DCA	JSCDF	/SET UP LOC TO SAVE PC IN
	AC0002
	TAD	ADR
	DCA	ADR	/BUMP ADDRESS BY 2
	RTL
	RTL
	TAD	DATAF
	DCA	DATAF	/INCLUDING DATA FIELD
JSAR,	TAD I	(PCCDF	/JSA/JSR COMMON CODE
	CLL RTR
	RAR
	ISZ	PC	/BUMP PC BEFORE STORING
	SKP
	IAC		/INCLUDING FIELD BITS
	TAD	(JA-2620	/FORM "JA" INSTRUCTION
JSCDF,	HLT
	DCA I	PUTM
	ISZ	PUTM
	SKP
	JMS I	(DFBUMP	/BUMP TARGET ADDRESS
	TAD	PC
	DCA I	PUTM
	JMP I	(DOJMP	/NOW JUMP TO DESTINATION

JSR,	CLA CLL IAC
	TAD	BASADR
	DCA	PUTM
	RTL
	RTL
	TAD I	(BASCDF	/SET JSCDF&PUTM TO BASE PAGE LOC +1
	DCA	JSCDF
	JMP	JSAR

FPJAC,	TAD	ACL
	DCA	ADR
	TAD	ACH
	JMS I	MCDF
	DCA	DATAF
	JMP I	(DOJMP

SPCATX,	TAD	ACL
	SKP
FPLDX,	JMS I	[FETPC
	JMS	DATCDF
	DCA I	ADR	/SET XR TO NEXT INST WD
	JMP I	FPNXT
/MORE INDEX REGISTER & AC-TO-MEMORY INSTRUCTIONS

ADDX,	JMS I	[FETPC
	JMS	DATCDF
	TAD I	ADR	/ADD NEXT INST WD TO XR
	JMP	FPLDX+1

ATX,	TAD	DFLG	/ATX WORKS DIFFERENTLY IN D.P.I. MODE
	SMA SZA CLA
	JMP	SPCATX
	JMS I	NORMX	/FAC MAY NOT BE NORMALIZED
	JMS I	[FFIX
	TAD	ACI
	JMP	FPLDX+1

OPMEM,	DCA	AD1	/GENERAL AC-TO-MEMORY INTERPRETER
	TAD	AD1
	DCA	AD2
	RDF
	CLL RTR
	RAR
	TAD	KLUDGM	/FORM FSTA X INSTRUCTION
	DCA	PUTM
	AC2000
	AND	INST	/TURN OP 5 TO OP 1,
	SZA CLA
	TAD	[3000	/     OP 7 TO OP 4.
	TAD	[3000
	TAD	PUTM	/STICK IN FIELD BITS
	DCA	OPM
	JMS I	[FPGO
	KLUDGM
	JMP I	FPNXT

KLUDGM,	FSTA+LONG
	FTEMP		/SAVE AC
OPM,	0
AD1,	0		/PERFORM OP
PUTM,	0
AD2,	0		/STORE RESULT
	FLDA+LONG
	FTEMP		/RESTORE AC
	FEXIT

NORMX,	FFNOR		/*K* CHANGED TO EFFNOR IF EAE
	PAGE
/MAIN INTERPRETER LOOP

NEGFAC,	JMS I	[FFNEG

ICYCLE,	CLA
	JMS I	[FETPC	/GET INST
	DCA	INST
	TAD	INST
	CLL RTL
	RTL
	SMA		/SKIP IF BASEPAGE ADDRESSING
	JMP	LONGI
	AND	[7
	TAD	BASJMP
	DCA	OPJMP	/SAVE OPCODE CALL ADDRESS
	TAD	INST	/DATA FIELD IS STILL SET UP
	SZL		/SO IS LINK (WITH INSTRUCTION BIT 3)
	JMP	BPAGEI	/INDIRECT ADDRESSING
	CLL RAL
	TAD	INST	/MULTIPLY BASE OFFSET BY 3
	TAD	[200	/ELIMINATE ANY
	AND	(777	/HIGH ORDER BITS
IMFUDJ,	CLL		/CLL IAC IF D.P. INTEGER MODE
	TAD	BASADR	/ADD IN BASE PAGE ORIGIN
BASCDF,	HLT		/CDF TO BASE PAGE FIELD
	SZL
	JMS	DFBUMP	/BUMP DF IF ADDITION OVERFLOWED
OPJCLL,	CLL
OPJMP,	HLT		/JMP I EXECUTIONROUTINE

BPAGEI,	AND	[7
	DCA	ADR
	TAD	ADR
	CLL CML RAL
	TAD	ADR	/FORM 3*OFFSET+1
	TAD	BASADR
	DCA	ADR
	RTL
	RTL
	TAD	BASCDF	/FORM PROPER CDF
	DCA	ADDRLO
ADDRLO,	HLT		/EXECUTE IT
	TAD I	ADR	/GET FIELD BITS OF REAL ADDRESS
	DCA	ADDRHI	/FROM 2D WORD OF BASE PAGE LOC
	ISZ	ADR
	SKP
	JMS	DFBUMP	/WATCH FOR FIELD OVERFLOW
	TAD I	ADR	/GET LOW-ORDER ADDRESS FROM 3D WORD
	JMP	INDEX	/NOW GO DO INDEXING (IF ANY)
/COME HERE IF BIT 4 OF INSTRUCTION IS OFF

LONGI,	AND	[7
	SNL		/TEST BIT 3 OF INSTRUCTION
	JMP I	(SPECAL	/SPECIAL INSTRUCTION
	TAD	BASJMP
	DCA	OPJMP
	TAD	INST
	DCA	ADDRHI	/HIGH-ORDER ADDRESS BITS IN INST WD
	JMS I	[FETPC	/NEXT INST WORD CONTAINS LOW-ORDER ADDRESS
INDEX,	DCA	ADDRLO
	TAD	INST
	AND	[70
	SNA		/IS XR NUMBER 0?
	JMP	NOINDX	/YES - NO INDEXING
	JMS	DCDIDX	/GET XR VALUE (MAYBE INCREMENTED)
	AC7775
	TAD	DFLG	/GET -3 IF F, -2 IF D, -6 IF E MODE
	DCA	DCDIDX
	TAD	ADDRLO
XRADLP,	CLL
	TAD I	T
	SZL
	ISZ	ADDRHI
	ISZ	DCDIDX	/ADD THE XR IN THE PROPER NUMBER OF TIMES
	JMP	XRADLP
	DCA	ADDRLO
NOINDX,	TAD	ADDRHI
	JMS I	MCDF
	DCA	ADDRHI	/TURN HIGH-ORDER ADDRESS INTO A CDF
ADDRHI,	HLT		/AND EXECUTE IT
	TAD	ADDRLO
	JMP	OPJCLL	/GO EXECUTE THE INSTRUCTION

DFBUMP,	0		/BUMP DATA FIELD
	DCA	DFTMP	/SAVE AC
	RDF
	TAD	(CDF 10
	DCA	.+1
	HLT
	TAD	DFTMP	/RESTORE AC
	JMP I	DFBUMP
DFTMP,	0
DCDIDX,	0
	CLL RTR
	RAR
	TAD	XRBASE	/ADD IN BASE ADDRESS OF XR ARRAY
XRCDF,	HLT		/CDF TO XR ARRAY FIELD
	SZL
	JMS	DFBUMP	/OR MAYBE NEXT FIELD
	DCA	T	/SAVE POINTER TO XR
	TAD	INST
	AND	DCD100
	SZA CLA		/INCREMENT BIT ON?
	ISZ I	T	/YES - BUMP XR
DCD100,	100		/** PROTECTION
	JMP I	DCDIDX

BASJMP,	JMP I	JMPTB1	/JMP I JMPTB2 FOR D.P. MODE

JMPTB1,	FFGET		/ F MODE (FLOATING POINT)
	FFADD
	FFSUB
	FFDIV
	FFMPY
	OPMEM	/FADDM
	FFPUT
	OPMEM	/FMULM

	DDGET		/ D MODE ( DOUBLE PRECISION INTEGER)
	DDADD
	DDSUB
	DDDIV
	DDMPY
	OPMEM	/DADDM
	DDPUT
	OPMEM	/DMULM

	EEGET		/ E MODE ( 6 WD FLOATING POINT)
	FFADD
	FFSUB
	FFDIV
	FFMPY
	OPMEM
	EEPUT
	OPMEM
	PAGE
/MORE I CYCLE

SPECAL,	SNA
	JMP	XRINST	/OPCODE 0 HAS MANY MANSIONS
	TAD	SPECOP
	DCA	SPCJMP	/GET OPCODE JUMP ADDRESS
	JMS I	[FETPC
	DCA	ADR
	TAD	INST	/ALL OF THESE ARE TWO-WORD INSTRUCTIONS
	JMS I	MCDF	/SO FORM THE ADDRESS NOW
	DCA	DATAF
	CDF 0
	TAD	INST
SPCJMP,	HLT

XRINST,	TAD	INST
	AND	(7770
	CDF 0
	SNA CLA		/IF SUB-OPCODE IS ZERO,
	JMP	OPERAT	/DECODE SUB-SUB-OPCODE
	TAD	INST
	AND	[7
	CLL
	TAD	XRBASE
	DCA	ADR	/COMPUTE INDEX REGISTER ADDRESS
	RTL
	RTL
	TAD I	(XRCDF
	DCA	DATAF
XJCOMN,	TAD	INST
	CLL RTR
	RAR
	AND	[77	/GET OPCODE - HIGH ORDER 2 BITS ARE 0
OXCOMN,	TAD	(JMP I SP2
	DCA	.+1	/EXECUTE APPROPRIATE JUMP
	HLT

OPERAT,	TAD	INST
	CIA
	JMP	OXCOMN

SETX,	TAD	DATAF	/SET XR0 LOC
	DCA I	(XRCDF
	TAD	ADR
	DCA	XRBASE
	JMP I	FPNXT
/JUMP DECODER

JUMPS,	AND	(100	/INSTRUCTION IN AC
	CLL RTR		/20 IN AC IF NOT COND. JUMP
	SZA		/IF NOT COND. JUMP, DECODE FURTHER
	JMP	XJCOMN
	TAD	INST
	AND	[70
	CLL RTR
	RAR
	TAD	(CNDSKT
	DCA	T	/INDEX INTO CONDITIONAL SKIP TABLE
	TAD I	T
	DCA	CNDSKP
	TAD	ACH
	SZA
	JMP	CNDSKP
	TAD	ACL
	SZA CLA		/IF HIGH ORDER ZERO, AC MIGHT BE UNNORMALIZED.
	IAC		/USE LOW ORDER ON 0/NOT 0 BASIS
CNDSKP,	HLT		/TEST AC
	JMP I	FPNXT	/FAILED - DON'T JUMP

DOJMP,	STA CLL
	TAD	ADR
	DCA	PC
	SNL
	TAD	(-10
	TAD	DATAF
	CDF 0
	DCA I	(PCCDF	/ADDRESS-1 TO PC
	JMP I	.+1
YFJMP,	ICYCLE		/** CHANGED IF RUNNING UNDER RTS-8

JXN,	AND	[70	/GET XR FIELD
	JMS I	(DCDIDX	/GET XR VALUE WITH INCREMENTING
	TAD I	T
	SNA CLA		/ZERO?
	JMP I	FPNXT	/YES
	JMP	DOJMP	/JUMP ON INDEX NON-ZERO, RIGHT?

CNDSKT,	SZA CLA		/JEQ
	SPA CLA		/JGE
	SMA SZA CLA	/JLE
	SKP CLA		/JA
	SNA CLA		/JNE
	SMA CLA		/JLT
	SPA SNA CLA	/JGT
	JMP	TSTALN	/JAL

TSTALN,	CLA
	TAD	ACX
	TAD	(-27
	SPA SNA CLA
	JMP I	FPNXT
	JMP	DOJMP
/OPCODE TABLES

SPECOP,	JMP I	SPECOP	/SPECIAL OPCODE TABLE
	JUMPS
	JXN
	TRAP3I
	TRAP4I
	TRAP5I
	TRAP6I
	TRAP7I

	FPJAC
	STRTD
	STRTF
	NRMFAC
	NEGFAC
	CLFAC
	FPAUSE
SP2,	EXIT
	ALN
	ATX
	FPXTA
	ICYCLE	/NOP
	STRTE
	ICYCLE	/UNDEF OP
	ICYCLE	/"
	FPLDX
	ADDX
	SETX
	SETB
	JSA
	JSR
	PAGE
/MISCELLANEOUS OPCODE ROUTINES

TRAP3I,
TRAP4I,	AC0002
	TAD	DATAF
	DCA	.+1	/FORM CDF CIF N
	HLT		/EXECUTE IT
	TAD	INST
	SMA CLA		/TRAP4 JMS'S TO ITS TARGET ADDRESS,
	JMP I	ADR	/TRAP3 JMP'S TO IT
	JMS I	ADR
	JMP I	FPNXT

ALN,	TAD	ACX	/ALIGN SIMULATOR
	DCA	OPX	/SAVE EXPONENT IN CASE WE'RE IN D.I. MODE
	TAD	DFLG
	SMA SZA CLA
	DCA	ACX	/ZERO EXP IF D.I. MODE
	JMS	DATCDF	/SET TO XR FIELD
	TAD	INST
	AND	[7
	TAD	DFLG	/IF WE'RE IN FLOATING POINT MODE,
	SNA CLA		/AND DOING AN "ALN 0",
	TAD	[27	/ALIGN UNTIL EXPONENT = 23
	SNA
	TAD I	ADR	/OTHERWISE ALIGN UNTIL EXPONENT = XR VALUE
	CDF 0
	CIA
	TAD	ACX
	CMA		/FORM DIFFERENCE - 1
	SPA		/IF EXPONENT IS LARGER THEN DESIRED EXPONENT,
	JMP	ALNSHL	/SHIFT LEFT
	JMS I	[ACSR	/OTHERWISE SHIFT RIGHT
ALNXIT,	TAD	DFLG
	SPA SNA CLA	/IF DOUBLE INTEGER MODE,
	JMP I	FPNXT
	TAD	OPX	/ALIGNMENT LEAVES THE EXPONENT UNCHANGED
	DCA	ACX
	JMP I	FPNXT
ALNSHL,	DCA	T	/STORE SHIFT COUNT
	SKP		/SHIFT LEFT ONE LESS THAN COUNT
	JMS I	[AL1BMP
	ISZ	T
	JMP	.-2
	JMP	ALNXIT	/GO TO COMMON CODE
/ARG FETCH SUBROUTINES AND MODE CHANGE OPERATORS

DARGET,	0
	DCA	ADR
	TAD	DARGET
	DCA	ARGET
	DCA	ACX
	JMP	ARGET2	/FAKE OUT FLOATING POINT ROUTINE

ARGET,	0		/SUBROUTINE TO FETCH ARG FOR ADD, SUBT, ETC.
	DCA	ADR	/STORE ADDRESS OF OPERAND
	TAD I	ADR	/PICK UP EXPONENT
	ISZ	ADR	/MOVE POINTER TO HI MANTISSA WD
	SKP
	JMS I	(DFBUMP
ARGET2,	DCA	OPX
	TAD I	ADR	/PICK IT UP
	DCA	OPH	/STORE
	ISZ	ADR	/MOVE PTR. TO LO MANTISSA WD.
	SKP
	JMS I	(DFBUMP	/WATCH THOSE FIELD TRANSITIONS!
	TAD I	ADR	/PICK IT UP
	DCA	OPL	/STORE IT
	CDF 0
	JMP I	ARGET	/RETURN

STRTE,	TAD	DFLG	/START EXTENDED PRECISION MODE
	SPA CLA
	JMP	.+4	/CLEAR EXTENDED FAC
	DCA	EAC1	/IF NOT ALREADY IN E MODE
	DCA	EAC2
	DCA	EAC3
	AC7775
	DCA	DFLG
	JMP	DFECMN

STRTD,	CLA IAC		/START DOUBLE PRECISION INTEGER MODE
STRTF,	DCA	DFLG	/START FLOATING POINT MODE
	TAD	DFLG
DFECMN,	TAD	(CLL
	DCA I	(IMFUDJ	/SET D.P.I FUDGE TO "CLL" OR "CLL IAC"
	TAD	DFLG
	SPA
	CMA		/CHANGE -3 FOR E MODE TO +2
	CLL RTL
	RAL
	TAD	(JMPTB1&177+5600
	DCA I	(BASJMP
	JMP I	FPNXT
/DOUBLE PRECISION INTEGER OPERATORS

DDSUB,	JMS	DARGET
	JMS I	(OPNEG
	SKP
DDADD,	JMS	DARGET
	DCA	AC1	/CLEAR OVERFLOW JUSTINCASE
	JMS I	[OADD
	JMP I	FPNXT

FFGET,	DCA	ADR	/GET A FLOATING POINT NUMBER
	TAD I	ADR
	DCA	ACX	/SAVE EXPONENT
	ISZ	ADR
	JMP	.+3	/NO FIELD OVERFLOW
	JMS I	(DFBUMP	/BUMP DATA FIELD
DDGET,	DCA	ADR	/SUAVE - ENTRY POINT FOR D.P. INTEGER GET
	TAD I	ADR
	DCA	ACH
	ISZ	ADR
	SKP
	JMS I	(DFBUMP
	TAD I	ADR
	DCA	ACL
	JMP I	FPNXT

FFPUT,	DCA	ADR	/STORE A FLOATING POINT NUMBER
	TAD	ACX	/GET FAC AND STORE IT
	DCA I	ADR	/AT SPECIFIED ADDRESS
	ISZ	ADR
	JMP	.+3
	JMS I	(DFBUMP
DDPUT,	DCA	ADR	/ENTRY FOR D.P. INTEGER PUT
	TAD	ACH
	DCA I	ADR
	ISZ	ADR
	SKP
	JMS I	(DFBUMP
	TAD	ACL
	DCA I	ADR
	JMP I	FPNXT
	PAGE
FPPKG=	.		/FOR EAE OVERLAY

/23-BIT FLOATING PT INTERPRETER
/W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN

LPBUF2,	ZBLOCK	16
	LPBUF3

AL1BMP,	0		/*K* UTILITY SUBROUTINE - USED BY INTERPRETER
	STA
	TAD	ACX
	DCA	ACX
	JMS I	[AL1
	JMP I	AL1BMP

/FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES
DDMPY,	JMS I	(DARGET
	SKP
FFMPY,	JMS I	(ARGET	/GET OPERAND
	JMS	MDSET	/SET UP FOR MPY-OPX IN AC ON RETN.
	TAD	ACX	/DO EXPONENT ADDITION
	DCA	ACX	/STORE FINAL EXPONENT
	DCA	MDSET	/ZERO TEM STORAGE FOR MPY ROUTINE
	DCA	AC2
	TAD	ACH	/IS FAC=0?
	SNA	CLA
	DCA	ACX	/YES-ZERO EXPONENT
	JMS	MP24	/NO-MULTIPLY FAC BY LOW ORDER OPR.
	TAD	OPH	/NOW MULTIPLY FAC BY HI ORDER MULTIPLIER
	DCA	OPL
	JMS	MP24
	TAD	AC2	/STORE RESULT BACK IN FAC
	DCA	ACL	/LOW ORDER
	TAD	MDSET	/HIGH ORDER
	DCA	ACH
	TAD	ACH	/DO WE NEED TO NORMALIZE?
	RAL
	SMA	CLA
	JMS	AL1BMP	/YES-DO IT FAST
	TAD	AC1
	SPA CLA		/CHECK OVERFLOW WORD
	ISZ	ACL	/HIGH BIT ON - ROUND RESULT
	JMP	MDONE
	ISZ	ACH	/LOW ORDER OVERFLOWED - INCREMENT HIGH ORDER
	TAD	ACH
	SPA		/CHECK FOR OVERFLOW TO 4000 0000
	JMP I	(SHR1	/WE HANDLE A SIMILIAR CASE IN FLOATING DIVIDE
	CLA
MDONE,	DCA	AC1	/ZERO OVERFLOW WD(DO I NEED THIS???)
	ISZ	MSIGN	/SHOULD RESULT BE NEGATIVE?
	SKP		/NO
	JMS I	[FFNEG	/YES-NEGATE IT
	TAD	ACH
	SNA CLA		/A ZERO AC MEANS A ZERO EXPONENT
	DCA	ACX
	TAD	DFLG
	SMA SZA CLA	/D.P. INTEGER MODE?
	TAD	ACX	/WITH ACX LESS THAN 0?
	SNA
	JMP I	FPNXT	/NO - RETURN
	CMA
	JMS I	[ACSR	/UN-NORMALIZE RESULT
	JMP I	FPNXT	/RETURN
/MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE
/ALSO SHIFTS OPERAND ONE BIT TO THE LEFT.
/EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT
/CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND
/DATA FIELD SET PROPERLY FOR OPERAND.

MDSET,	0
	CLA CLL CMA RAL	/SET SIGN CHECK TO -2
	DCA	MSIGN
	TAD	OPH	/IS OPERAND NEGATIVE?
	SMA	CLA
	JMP	.+3	/NO
	JMS I	(OPNEG	/YES-NEGATE IT
	ISZ	MSIGN	/BUMP SIGN CHECK
	TAD	OPL	/AND SHIFT OPERAND LEFT ONE BIT
	CLL	RAL
	DCA	OPL
	TAD	OPH
	RAL
	DCA	OPH
	DCA	AC1	/CLR. OVERFLOW WORF OF FAC
	TAD	ACH	/IS FAC NEGATIVE
	SMA	CLA
	JMP	LEV	/NO-GO ON
	JMS I	[FFNEG	/YES-NEGATE IT
	ISZ	MSIGN	/BUMP SIGN CHECK
	NOP		/MAY SKIP
LEV,	TAD	OPX	/EXIT WITH OPERAND EXPONENT IN AC
	JMP I	MDSET
MSIGN,	0
/24 BIT BY 12 BIT MULTIPLY.  MULTIPLIER IS IN OPL
/MULTIPLICAND IS IN ACH AND ACL
/RESULT LEFT IN MDSET,AC2, AND AC1

MP24,	0
	TAD	(-14	/SET UP 12 BIT COUNTER
	DCA	OPX
	TAD	OPL	/IS MULTIPLIER=0?
	SZA
	JMP	MPLP1	/NO-GO ON
	DCA	AC1	/YES-INSURE RESULT=0
	JMP I	MP24	/RETURN
MPLP,	TAD	OPL	/SHIFT A BIT OUT OF LOW ORDER
MPLP1,	RAR		/OF MULTIPLIER AND INTO LINK
	DCA	OPL
	SNL		/WAS IT A 1?
	JMP	MPLP2	/NO - 0 - JUST SHIFT PARTIAL PRODUCT
	TAD	AC2	/YES-ADD MULTIPLICAND TO PARTIAL PRODUCT
	TAD	ACL	/LOW ORDER
	DCA	AC2
	CML RAL		/*K* NOTE THE "SNL" 5 WORDS BACK!
	TAD	ACH	/HI ORDER
MPLP2,	TAD	MDSET
	RAR		/NOW SHIFT PARTIAL PROD. RIGHT 1 BIT
	DCA	MDSET
	TAD	AC2
	RAR
	DCA	AC2
	TAD	AC1
	RAR		/OVERFLOW TO AC1
	DCA	AC1
	ISZ	OPX	/DONE ALL 12 MULTIPLIER BITS?
	JMP	MPLP	/NO-GO ON
	JMP I	MP24	/YES-RETURN
	PAGE
/DIVIDE-BY-ZERO ROUTINE - MUST BE AT BEGINNING OF PAGE

DBAD,	ISZ	FATAL	/DIVIDE BY 0 NON-FATAL
	JMS I	ERR	/GIVE ERROR MSG
	TAD	DBAD
	DCA	ACX	/RETURN A VERY LARGE POSITIVE NUMBER
	AC2000
	JMP	FD

/FLOATING DIVIDE - USES DIVIDE-AND-CORRECT METHOD

DDDIV,	JMS I	(DARGET
	SKP
FFDIV,	JMS I	(ARGET	/GET OPERAND
	JMS I	(MDSET	/GO SET UP FOR DIVIDE-OPX IN AC ON RETN.
	CMA	IAC	/NEGATE EXP. OF OPERAND
	TAD	ACX	/ADD EXP OF FAC
	DCA	ACX	/STORE AS FINAL EXPONENT
	TAD	OPH	/NEGATE HI ORDER OP. FOR USE
	CLL CMA IAC	/AS DIVISOR
	DCA	OPH
	JMS	DV24	/CALL DIV.--(ACH+ACL)/OPH
	TAD	ACL	/SAVE QUOT. FOR LATER
	DCA	AC1
	TAD	OPL
	SNA CLA
	JMP	DVL2	/AVOID MULTIPLYING BY 0
	TAD	(-15	/SET COUNTER FOR 12 BIT MULTIPLY
	DCA	DV24	/TO MULTIPLY QUOT. OF DIV. BY 
	JMP	DVLP1	/LOW ORDER OF OPERAND (OPL)

/DIVIDE ROUTINE - (ACH,ACL)/OPH = ACL REMAINDER REM  (AC2=0)

DV24,	0
	TAD	ACH	/CHECK THAT DIVISOR IS .GT. DIVIDEND
	TAD	OPH	/DIVISOR IN OPH (NEGATIVE)
	SZL	CLA	/IS IT?
	JMP	DBAD	/NO-DIVIDE OVERFLOW
	TAD	(-15	/YES-SET UP 12 BIT LOOP
	DCA	AC2
	JMP	DV1	/GO BEGIN DIVIDE
DV2,	TAD	ACH	/CONTINUE SHIFT OF FAC LEFT
	RAL
	DCA	ACH	/RESTORE HI ORDER
	TAD	ACH	/NOW SUBTRACT DIVISOR FROM HI ORDER
	TAD	OPH	/DIVIDEND
	SZL		/GOOD SUBTRACT?
	DCA	ACH	/YES-RESTORE HI DIVIDEND
	CLA		/NO-DON'T RESTORE--OPH.GT.ACH
DV1,	TAD	ACL	/SHIFT FAC LEFT 1 BIT-ALSO SHIFT
	RAL		/1 BIT OF QUOT. INTO LOW ORD OF ACL
	DCA	ACL
	ISZ	AC2	/DONE 12 BITS OF QUOT?
	JMP	DV2	/NO-GO ON
	JMP I	DV24	/YES-RETN W/AC2=0
/DIVIDE ROUTINE CONTINUED

MP12L,	DCA	OPL	/STORE BACK MULTIPLIET
	TAD	AC2	/GET PRODUCT SO FAR
	SNL		/WAS MULTIPLIER BIT A 1?
	JMP	.+3	/NO-JUST SHIFT THE PARTIAL PRODUCT
	CLL		/YES-CLEAR LINK AND ADD MULTIPLICAND
	TAD	ACL	/TO PARTIAL PRODUCT
	RAR		/SHIFT PARTIAL PRODUCT-THIS IS HI ORDER
	DCA	AC2	/RESULT-STORE BACK
DVLP1,	TAD	OPL	/SHIFT A BIT OUT OF MULTIPLIER
	RAR		/AND A BIT OR RESLT. INTO IT (LO ORD. PROD.)
	ISZ	DV24	/DONE ALL BITS?
	JMP	MP12L	/NO-LOOP BACK
	CLL CIA		/YES-LOW ORDER PROD. OF QUOT. X OPL IN AC
	DCA	ACL	/NEGATE AND STORE
	CML	RAL	/PROPAGATE CARRY
	TAD	AC2	/NEGATE HI ORDER PRODUCT
	STL CIA	
	TAD	ACH	/COMPARE WITH REMAINDER OF FIRST DIV.
	SZL		/WELL?
	JMP	DVOPS	/GREATER THAN REM.-ADJUST QUOT OF 1ST DIV.
	DCA	ACH	/OK - DO (REM - (Q*OPL)) / OPH
DVL3,	JMS	DV24	/DIVIDE BY OPH (HI ORDER OPERAND)
DVL1,	TAD	AC1	/GET QUOT. OF FIRST DIV.
	SMA		/IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT
	JMP	FD	/NO-ITS NORMALIZED-DONE
SHR1,	CLL
	ISZ	ACL	/ROUND AND SHIFT RIGHT ONE
	SKP
	IAC		/DOUBLE PRECISION INCREMENT
	RAR
	DCA	ACH	/STORE IN FAC
	TAD	ACL	/SHIFT LOW ORDER RIGHT
	RAR
	DCA	ACL	/STORE BACK
	ISZ	ACX	/BUMP EXPONENT
	NOP
	TAD	ACH
	JMP	DVL1+1	/IF FRACT WAS 77777777 WE MUST SHIFT AGAIN
FD,	DCA	ACH	/STORE HIGH ORDER RESULT
	JMP I	(MDONE	/GO LEAVE DIVIDE

DVL2,	DCA	ACL	/COME HERE IF LOW-ORDER QUO=0
	JMP	DVL3	/SAVE SOME TIME
/ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE
/REMAINDER OF THE FIRST DIVIDE IS LESS THAN QUOT*OPL

DVOPS,	CMA	IAC	/NEGATE AND STORE REVISED REMAINDER
	DCA	ACH	
	CLL
	TAD	OPH
	TAD	ACH	/WATCH FOR OVERFLOW
	SNL
	JMP	DVOP1	/OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV.
	DCA	ACH	/NO OVERFLOW-STORE NEW REM.
	CMA		/SUBTRACT 1 FROM QUOT OF
	TAD	AC1	/FIRST DIVIDE
	DCA	AC1
DVOP1,	CLA 	CLL
	TAD	ACH	/GET HI ORD OF REMAINDER
	SNA		/IS IT ZERO?
DVOP2,	DCA	ACL	/YES-MAKE WHOLE THING ZERO
	DCA	ACH
	JMS	DV24	/DIVIDE EXTENDED REM. BY HI DIVISOR
	TAD	ACL	/NEGATE THE RESULT
	CLL CMA IAC
	DCA	ACL
	SNL		/IF QUOT. IS NON-ZERO, SUBTRACT
	CMA		/ONE FROM HIGH ORDER QUOT.
	JMP	DVL1	/GO TO IT

LPBUF3,	ZBLOCK	12
	LPBUF4
	PAGE
/"OPNEG" MUST BE AT 0 ON PAGE

OPNEG,	0		/ROUTINE TO NEGATE OPERAND
	TAD	OPL	/GET LOW ORDER
	CLL CIA		/NEGATE AND STORE BACK
	DCA	OPL
	CML	RAL	/PROPAGATE CARRY
	TAD	OPH	/GET HI ORDER
	CLL CIA		/NEGATE AND STORE BACK
	DCA	OPH
	JMP I	OPNEG
/
/FLOATING SUBTRACT AND ADD
/
FFSUB,	JMS I	(ARGET	/PICK UO THE OP.
	JMS	OPNEG	/NEGATE OPERAND
	SKP
FFADD,	JMS I	(ARGET	/PICK UP OPERAND
	TAD	OPH	/IS OPERAND = 0
	SNA	CLA
	JMP I	FPNXT	/YES-DONE
	TAD	ACH	/NO-IS FAC=0?
	SNA	CLA
	JMP	CLROFL	/CLEAR OUT THE OVERFLOW BITS
	TAD	ACX	/NO-DO EXPONENT CALCULATION
	CLL CIA
	TAD	OPX
	SMA	SZA	/WHICH EXP. GREATER?
	JMP	FACR	/OPERANDS-SHIFT FAC
	CIA		/FAC'S-SHIFT OPERAND=DIFFRNCE+1
	TAD	(-30
	SMA		/TEST FOR INSIGNIFICANCE
	JMP	OPINSG	/YES - ANSWER IS FAC
	TAD	(30
	JMS	OPSR
	JMS I	[ACSR	/SHIFT FAC ONE PLACE RIGHT
DOADD,	TAD	OPX	/SET EXPONENT OF RESULT
	DCA	ACX
	JMS I	[OADD	/DO THE ADDITION
	JMS	FFNOR	/NORMALIZE RESULT
	JMP I	FPNXT	/RETURN
FACR,	TAD	(-30
	SMA		/TEST FOR INSIGNIFICANCE
	JMP	ACINSG	/YES - ANSWER IS OPR
	TAD	(30
	JMS  I	[ACSR	/SHIFT FAC = DIFF.+1
	JMS	OPSR	/SHIFT OPR. 1 PLACE
	JMP	DOADD	/DO ADDITION

OPINSG,	CLA
	JMP I	FPNXT
/OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 IN AC

OPSR,	0
	CMA		/- (COUNT+1) TO SHIFT COUNTER
	DCA	AC0
LOP2,	TAD	OPH	/GET SIGN BIT
	CLL		/TO LINK
	SPA
	CML		/WITH HI MANTISSA IN AC
	RAR		/SHIFT IT RIGHT, PROPAGATING SIGN
	DCA	OPH	/STORE BACK
	TAD	OPL
	RAR
	DCA	OPL	/STORE LO ORDER BACK
	ISZ	OPX	/INCREMENT EXPONENT
	NOP	
	ISZ	AC0	/DONE ALL SHIFTS?
	JMP	LOP2	/NO-LOOP
	RAR		/SAVE 1 BIT OF OVERFLOW
	DCA	AC2	/IN AC2
	JMP I	OPSR	/YES-RETN.

FFNOR,	0		/ROUTINE TO NORMALIZE THE FAC
	TAD	ACH	/GET THE HI ORDER MANTISSA
	SNA		/ZERO?
	TAD	ACL	/YES-HOW ABOUT LOW?
	SNA
	TAD	AC1	/LOW=0, IS OVRFLO BIT ON?
	SNA	CLA
	JMP	ZEXP	/#=0-ZERO EXPONENT
NORMLP,	CLA CLL CML RTR	/NOT 0-MAKE A 2000 IN AC
	TAD	ACH	/ADD HI ORDER MANTISSA
	SZA		/HI ORDER = 6000
	JMP	.+3	/NO-CHECK LEFT MOST DIGIT
	TAD	ACL	/YES-6000 OK IF LOW=0
	SZA	CLA	
	SPA	CLA	/2,3,4,5,ARE LEGAL LEFT MOST DIGS.
	JMP	FFNORR	/FOR NORMALIZED #-(+2000=4,5,6,7)
	JMS I	[AL1BMP	/SHIFT AC LEFT AND BUMP ACX DOWN
	JMP	NORMLP	/GO BACK AND SEE IF NORMALIZED
ZEXP,	DCA	ACX
FFNORR,	DCA	AC1	/DONE W/NORMALIZE - CLEAR AC1
	JMP I	FFNOR	/RETURN

ACINSG,	CLA		/COME HERE IF AC IS INSIGNIFICANT ON ADDITION
	DCA	ACH
	DCA	ACL
	JMP	DOADD-1	/FAKE AN ADD WITH OPR=0

LPBUF4,	ZBLOCK	40
	LPBUFE
CLROFL,	DCA	AC1	/CLEAR  THE FLOATING AC OVERFLOW WORD
	DCA	AC2	/CLEAR THE OPERAND OVERFLOW WORD
	JMP	DOADD	/FAC=0;   DO THE ADD
	PAGE
/PAGE 7400 UNUSED RIGHT NOW

LPBUFE,	ZBLOCK	177
	LPBUFR
	FIELD 1


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RX78C.PA. 
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

/RX NON-SYSTEM HANDLER, GENERAL CONTROLLER TYPE
/FLOPPY DISK HANDLER FOR OS/8
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1978 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/
/  THIS HANDLER IS SPECIFICALLY FOR A SECOND PAIR OF DRIVES ON A VT78!!
/
/DEFINITIONS OF RX8/E IOT'S

RXVER=	"N&77

DEVCOD=	750	/DEVICECODE

LCD=	6001+DEVCOD	/LOAD COMMAND REGISTER
XDR=	6002+DEVCOD	/TRANSFER DATA REGISTER
STR=	6003+DEVCOD	/SKIP ON TRANSFER REQUEST FLAG, CLEAR FLAG
SER=	6004+DEVCOD	/SKIP ON ERROR FLAG, CLEAR FLAG
SDN=	6005+DEVCOD	/SKIP ON DONE FLAG, CLEAR FLAG
INTR=	6006+DEVCOD	/INTERRUPT ENABLE/DISABLE
INIT=	6007+DEVCOD	/INITIALIZE CONTROLLER AND RECALIBRATE DRIVES


/NOTES ON THIS HANDLER:

/THIS HANDLER READS AND WRITES THE DISK IN "12-BIT" MODE, IN WHICH
/ONLY 6 BITS OF EVERY 8-BIT BYTE ARE USED. AN RX01 CARTRIDGE
/CONTAINS 494 OS/8 BLOCKS UNDER THIS METHOD

/TO MAXIMIZE SPEED ON THE DEVICE, THE HANDLER READS AND WRITES RX01 DATA
/ON A TRACK WITH A TWO-WAY INTERLEAVE - I.E. RECORDS 1-26 ON A TRACK
/ARE WRITTEN IN THE SEQUENCE:
/  1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26

/DOUBLE DENSITY MEDIA ARE WRITTEN IN A THREE WAY INTERLEAVE
/  1,4,7,10,13,16,19,22,25,2,5,8,11,14,17,20,23,26,3,6,9,12,15,18,21,24

/TRACK-SECTOR COMPUTATION IS DONE I/O TO/FROM THE SILO

AC4000=CLL CLA CML RAR		/SET AC TO 4000
AC7776=CLL CLA CMA RAL		/SET AC TO 7776
AC0002=CLL CLA CML RTL		/SET AC TO 0002
AC7775=CLL CLA CMA RTL		/SET AC TO 7775
/
/BUILD DATA
	*0
/
	-2		/TWO ENTRY POINTS
	DEVICE	RX0B	/DEVICE GROUP NAME
	DEVICE	RXA2	/ENTRY POINT NAME
	4320		/CODE FOR MULTI-RX
	RXA2&177+4000	/ENTRY POINT OFFSET
	0
	0
	DEVICE	RX0B	/DEVICE GROUP NAME
	DEVICE	RXA3	/ENTRY POINT NAME
	4320		/THIS WAS CHANGED FROM 4270 - ASSIGNED TO CASSETTE
	RXA3&177+4000	/ENTRY POINT OFFSET
	0
	0
	*200
/
/
/  INIT CODE
/
POINT,	HLT		/ADDR OF SECOND PAGE AT INIT TIME
UNIT,	JMS I	POINT	/GO TO SECOND PAGE TO INIT
/
/  LIST OF VECTORS TO SECOND PAGE
/
LQUO,	QUO-.		/LQUO MUST LEAD OFF LIST
LRETRY,	RETRY-.
LREC,	REC-.
LSIZE,	SIZE-.
LREMD,	REMD-.
LFN,	FN-.
LDENSW,	DENSW-.
LSELCT,	SELECT-.
LENTRY,	ENTRY-.
VCOUNT=LQUO-.		/FALLS THRU TO WHICH, HERE IS VECTOR COUNT
/
/  COME HERE FROM ZOO
/
/  PROCESS ENTRY POINT, DEVICE TYPE
/
WHICH,	CLA IAC		/SELECT SECOND PAIR IF DRIVES
	JMS I	LSELCT
	AC7775		/SET RETRY COUNTER
	DCA I	LRETRY
	TAD I	ZOO	/GET UNIT NUMBER*20+402
	DCA	UNIT	/HOLD FOR LATER
	ISZ	ZOO	/MOVE TO TYPE CODE
	TAD I	ZOO	/HAS THIS DRIVE BEED INIT'ED
L7700,	SMA CLA		/SKIP IF NO
	JMP	NORMAL	/GO TO NORMAL PATH
RSTART,	TAD	UNIT	/PICK UP UNIT BIT, DOUBLE DENSITY +2
	TAD	L10	/MAKE A READ STATUS CODE
	SDN
	JMP	.-1
	LCD
	JMP	BOUNCE	/HOP OVER ENTRY POINTS
/
/
/
	IFZERO	.&177-34&4000	<_ERROR_>
/
/  ENTRY POINTS ARE AT 33, 37
/
	*.&7600+33
/
RXA2,	0
	JMS	ZOO	/COMMON ENTRY ROUTINE
	402		/UNIT 0, 402 FOR CONVENIENCE
	-1		/MINUS SAYS STILL HAVE TO INIT IT;
/			/SINGLE=0, DOUBLE=20, QUAD=22
RXA3,	0
	JMS	ZOO
L422,	422		/20 SAYS UNIT 1, 402 FOR CONVENIENCE
DOOR,	JMP	WHICH	/INIT TIME LITERAL (MUST BE MINUS)
/			/GETS SAME TYPE CODE AS OTHER ENTRY POINT
/
/  REST OF SET UP CODE
/
BOUNCE,	SDN
	JMP	.-1
	XDR		/GET STATUS WORD
	AND	L32	/KEEP DENSITY ERROR; DOUBLE; QUAD
	TAD	L10	/SINGLE=10;SING/DOUB=40;DOUB=20;QUAD=22
	AND	L422	/SINGLE=0;SING/DOUB=0;DOUB=20;QUAD=22
	DCA I	ZOO	/PLACE TYPE CODE, THREE LOC.'S AFTER ENTRY POINT
	SER		/CLEAR ERROR FLAG
L10,	10		/MAY SKIP
	TAD	L416	/SET DONE FLAG AGAIN
	LCD
NORMAL,	TAD I	ZOO	/FETCH BACK TYPE CODE
	SZA CLA		/SKIP IF A SINGLE DENSITY
	TAD	L7700	/DOUBLE
	TAD	L7700	/SINGLE=7700, DOUBLE=7600
	DCA I	LDENSW	/PLACE FOR LOOP CONTROL
	TAD I	ZOO
	CLL RTR		/PUT QUAD BIT TO LINK
	SNA CLA		/SKIP IF DOUBLE OR QUAD
	TAD	L1734	/SINGLE
	TAD	L4110	/D&Q=4110, S=6044
	SNL		/SKIP ON QUAD, IT'S OK RIGHT NOW
	CLL CML RAR	/SINGLE AND DOUBLE DIVIDE BY 2
	DCA I	LSIZE	/S=7022, D=6044, Q=4110
	TAD I	LDENSW	/7700 IF SINGLE, 7600 IF DOUBLE
	CLL CMA RTL	/375 IF SINGLE, 775 IF DOUBLE
	AND	UNIT	/VOILA, 400*DOUBLE  +  20*UNIT
	DCA I	LFN	/PLACE INTO FUNCTION CONTROL WORD
	AC7775		/BACK UP ZOO TO FETCH CALLING ADDR
	TAD	ZOO
	DCA	T1	/HOLD TEMPORARY
	TAD I	T1	/HERE IS CALLING ADDR
CLLFLD,	HLT		/PUT CDF TO CALLING FIELD HERE
	JMS I	LENTRY	/GO TO SECOND PAGE, LEAVING POINTER TO DIVSUB
/
/  DIVSUB SUBROUTINE !!MUST!! FOLLOW IMMEDIATELY
/
/
/  DIVSUB
/
/  CALL TO SET UP TRACK, SECTOR, FROM OVERALL SECTOR #
/  ALSO, SET UNIT WITH HEAD COMMAND IF WE ARE ON TO SECOND SIDE
/
/  CALL WITH AC <0 IF IT IS REALLY AN ERROR RETRY
/  CALL WITH AC >=0 IF CALL TO DIVSUB
/
DIVSUB,	0
	CDF	0	/AND DATA FIELD MUST BE TO HERE
	SPA CLA		/SKIP IF REALLY A DIVIDE REQUEST
	JMP	RSTART	/NO, IT WAS AN ERROR RETRY!!
	DCA I	LQUO	/CLEAR DIVIDE QUOTIENT
	TAD I	ZOO	/IS IT A TWO HEADER
	RTR		/PUT QUAD BIT TO LINK
	SNL CLA		/SKIP IF YES
	JMP	SHUNT	/NO, GO DO DIVIDE
	TAD I	LREC	/WHICH RECORD ARE WE WORKING ON
	TAD	LM3670	/NUMBER OF SECTORS ON FIRST SIDE
	SZL CLA		/SKIP IF SECOND SIDED IT
	JMP	SHUNT	/NO, JUST REGULAR
	TAD I	LFN	/FORCE HEAD BIT ON
	AND	L422	/KEEP DOUBLE, UNIT, READ-WRITE
	TAD	L1000	/ADD IN SECOND SIDE
	DCA I	LFN
	TAD	LM3670	/BUT DECREASE RECORD NUMBER
SHUNT,	TAD I	LREC	/THIS FOR TRACK-SECTOR
DIVLOO,	ISZ I	LQUO	/MAIN DIIVIDIE LOOP
	TAD	LM32	/DIVIDE BY 26 TO GET TRACK
	SMA		/SKIP IF DONE
	JMP	DIVLOO
	TAD	L32	/REMAINDER 0-25
	DCA	T1	/HOLD IT IN TEMPORARY
	TAD I	ZOO	/SINGLE DENSITY
	SZA CLA		/SKIP IF YES
	TAD 	T1	/MULTIPLY BY THREE FOR DOUBLE
	TAD 	T1	/AND BY TWO FOR SINGLE
	TAD 	T1
	CLL IAC		/LINK CLEAR FOR FINAL TEST; +1 TO START AT 1 NOT 0
	TAD	LM32	/DIVIDE BY 26 TO GET SECTOR
	SMA SZA		/SKIP IF DONE
	JMP	.-2
	TAD	L32	/RESTORE POSITIVE VALUE TO BE SECTOR
	DCA I	LREMD	/WHEW, BUT WATCH IT, A FINAL CORRECTION COMING!
	RAL		/IF LINK=0 AND SINGLE: 2,4,6,8,10,12,14,16... SERIES
	TAD I	ZOO	/BUT WE HAVE 1,3,5,7,9,11,13,15... SO WE MUST INCREMENT!
	SNA CLA		/SKIP IF SOME OTHER CASE
	ISZ I	LREMD	/NOW HAVE IT 2,4,6,8,10,12,14,16...
	JMP I	DIVSUB	/OUT
/
/
L416,	416	/SOME LITERALS
L32,	32
L1000,	1000
LM32,	-32
L1734,	1734
L4110,
LM3670,	-3670
/
/
/
	*.&7600+167	/FORCE TO END OF PAGE
/  ZOO  SUBROUTINE
/
/  TO SET UP ENTRY POINT PROCESSING, AND INIT CODE
/
ZOO,	0		/ADDR OF 'HIT' ENTRY POINT +2 COMES HERE
	CLA		/FOR SAFETY
	RDF		/SAVE CALLERS FIELD SETTING
	TAD	LCDF0	/ADD IN CDF 0
	DCA	CLLFLD	/RESET WHEN GOING TO I/O SUB
LCDF0,	CDF 0		/DATA FIELD HERE FOR INDIRECTS
CLOSE,	TAD	DOOR	/CLOSE DOOR TO ONCE ONLY CODE (JMP WHICH
T1,	DCA	CLOSE	/USE ONCE-ONLY FOR TEMPORARY LOCATION
	JMS	POINT	/LEAVE ADDR OF SECOND PAGE
/
/
/  VARIABLES, ALSO INIT CODE LIVES HERE
/
/
BUF,	0		/POINTER TO CALLER'S BUFFER
RETRY,	0		/RETRY COUNT
SIZE,	0		/SIZE OF DEVICE
SYS,	0		/POINTER TO CALL
QUO,	0		/DIVIDE QUOTIENT, WHICH IS TRACK NUMBER
REC,	0		/SECTOR NUMBER OF FLOPPY
BC,	0		/CONTROL COUNT, WORDS TO TRANSFER
FN,	0		/0 FOR WRITE; 2 FOR READ; HEAD, DENSITY, UNIT
DENSW,	0		/7700 IF SINGLE DENSITY, 7600 IF DOUBLE DENSITY
ENTRY,	0		/ENTRY POINT, LEAVE ADDR OF DIVSUB HERE
/
	IFNZRO	.&177-10&4000	<_ERROR>	/ENOUGH ROOM FOR INIT?
/
	*.&7600
/
/  INIT TIME:  FILL VECTOR TABLE
/
THERE,	0		/FILLED BY JMS, POINTS TO VECTOR
ILOOP,	TAD	THERE	/POINTER IS ALSO OFFSET!
	TAD I	THERE	/MAKING VECTOR
	DCA I	THERE
	ISZ	THERE	/MOVE TO NEXT VECTOR
	ISZ	LDCMD	/CONTROL COUNT ON THIS PAGE
	JMP	ILOOP
	JMP I	THERE	/BACK TO FIRST PAGE
/
/  IO SUBROUTINE
/
/  ENTRY POINT AT END OF LAST LISTING PAGE
/
/
	*ENTRY+1	/RESUME RUNTIME CODE
/
	DCA	SYS	/POINTER TO ARG'S, EXIT
	RDF		/DATA FIELD OF USER CALL
	TAD	(CDF CIF 0	/MAKE CDF CIF TO CALLER'S FIELD
	DCA	EXFLD	/SET UP FOR CALL
	AC4000		/SET LINK=0, AC=4000
	TAD I	SYS	/CARRY READ-WRITE BIT TO LINK
	AND	L70	/KEEP FIELD FOR BUFFER
	TAD	LLCDF0	/MAKE CDF TO BUFFER FIELD
	DCA	BUFCDF	/PLACE INTO I/O LOOP
	CML RTL		/MAKE FUNCTION CODE, 0=WRITE, 2=READ
	TAD	FN	/START-UP CODE HAS SET HEAD, DENSITY, UNIT ETC.
	DCA	FN
	TAD I	SYS	/MAKE LOOP CONTROL COUNT
	RAL
	AND	L7600
	CIA		/0 FOR WHOLE FIELD
	DCA	BC	/MINUS TOTAL NUMBER OF WORDS
	ISZ	SYS	/NEXT
	TAD I	SYS	/IS BUFFER ADDRESS
	DCA	BUF
	ISZ	SYS	/NEXT
	TAD	L175	/CARRY WITH DENSW IF SINGLE DENSITY
	TAD	DENSW	/BLOCK # TO SECTOR #
	SMA CLA		/SKIP IF DOUBLE, MULTIPLY BY 2
	TAD I	SYS	/SINGLE, MULTIPLY BY FOUR
	SMA		/SKIP ON ILLEGAL NEGATIVE BLOCK #, FORCE LINK ON LATER
	TAD I	SYS
	ISZ	SYS	/MOVE POINTER TO ERROR EXIT
	CLL RAL
	DCA	REC	/SAVE SECTOR NUMBER
	SZL		/SKIP IF LEGAL BLOCK #
	JMP	ERREX	/FORCE SIZING OF DISK TO RETURN SIZE IN AC
	JMS I	ENTRY	/CALL DIVISION SUBROUTINE OTHER PAGE
	TAD	FN	/SPLIT READ AND WRITE
	RTR		/READ-WRITE BIT TO LINK
	SZL CLA		/WRITE SKIPS
	JMP	STREAD	/READ GOES TO START IN MIDDLE OF LOOP
/			/WRITE FALLS THRU TO NEXT LISTING PAGE
/WRITE FALLS THRU TO THIS LOOP
/
/  TOP OF MAIN LOOP
/
TOP,	TAD	FN	/SET SILO TO LOAD-UNLOAD
	JMS	LDCMD	/COMMAND TO CONTROLLER
	TAD	DENSW	/MAKE SILO LOOP COUNT, S=7700, D=7600
	DCA	FLPWC	/LDCMD ENTRY SAFE TEMPORARY
BUFCDF,	HLT		/CDF TO BUFFER FIELD PLACED HERE
TRLOOP,	TAD I	BUF	/IN CASE WRITE, FETCH A WORD
	STR		/SKIP IF READY TO PASS DATA
	JMP	.-1	/NO
	XDR		/TO OR FROM AC
	DCA I	BUF	/PLACE WORD FOR READ, WRITE REPLACES SAME
	ISZ	BUF	/MOVE BUFFER POINTER, (MAY SKIP)
REMD,	0		/DIVIDE REMAINDER, WHICH IS SECTOR NUMBER
	ISZ	FLPWC	/DONE YET
	JMP	TRLOOP
	TAD	DENSW	/ADDING 77 (SINGLE) 177 (DOUBLE)
	CMA		/ONCE WE CMA, THAT IS
	TAD	BC	/LOOP CONTROL TO FINISH READ
	SNA
	JMP	OKEX	/OK, DONE
	DCA	BC	/REPLACE AND KEEP GOING
/
/  MIDDLE OF MAIN LOOP
/
STREAD,	CLA CLL IAC RTL	/KNOWN TO BE A 78, SO THIS WORKS! FOR LITERAL 4
	TAD	FN	/TURNING SILO COMMAND INTO READ-WRITE COMMAND
	JMS	LDCMD	/I/O COMMAND TO CONTROLLER
	TAD	REMD	/PRECOMPUTED SECTOR #
	STR
	JMP	.-1
	XDR
L7600,	7600		/CLEAR AC, AND IS LITERAL
	TAD	QUO	/TRACK #
	STR
	JMP	.-1
	XDR		/TRACK # IS ALWAYS NON0 !!
	ISZ	REC	/MOVE TO NEXT RECORD NUMBER
	JMS I	ENTRY	/DO TRACK SECTOR FOR NEXT OPERATION
	TAD	LL16	/WAIT FOR OPERATION TO COMPLETE
	JMS	LDCMD
	ISZ	BC	/CHECK FOR WRITE EXIT
	JMP	TOP	/STILL MORE
OKEX,	ISZ	SYS	/KICK TO OK EXIT
SELBAK,	DCA	REC	/TEMPORARY TO HOLD AC
	JMS	SELECT	/AC NOW 0 TO FORCE SELECT OF FIRST PAIR
	TAD	REC	/RETURN WITH (POSSIBLE) AC VALUE
EXFLD,	HLT		/CDF CIF TO CALLER
	JMP I	SYS	/OUT
/
/
/  LDCMD  SUBROUTINE
/
/  CHECK FOR CONTROL C, LOAD A COMMAND
/
FLPWC=.                 /ENTRY POINT A TEMPORARY
LDCMD,  VCOUNT          /INIT COUNTER
        DCA     TRANS   /SAVE COMMAND
LLCDF0, CDF     0       /DATA FIELD HERE IN CASE CONTROL C TO MONITOR
TSTTT,  KSF             /SKIP IF A TTY CHARACTER HAS HAPPENED
        JMP     TSTSD   /NOPE, GO CHECK RX CONTROLLER READY
        TAD     L7600   /FORCE TOP BITS TO BE 1 TO ELIMINATE 3,203
        KRS             /AMBIGUITY ON TEST
        TAD     L175    /IS IT A CONTROL C
        SNA CLA         /SKIP IF NOT
        JMP     MONEX   /GO EXIT TO MONITOR
TSTSD,  SDN             /IS RX CONTROLLER READY
        JMP     TSTTT   /NOPE, GO CHECK TTY
        TAD     TRANS   /GET BACK COMMAND
        LCD             /TO CONTROLLER
        SER             /SKIP IF AN ERROR
        JMP I   LDCMD
        AC4000          /ERROR CODE FOR HARD ERROR
        SKP             /SKIP OVER SIZING ENTRY
ERREX,  TAD     SIZE    /PUT NEGATIVE SIZE IN AC
        ISZ     RETRY   /TRY THREE TIMES?
        JMS I   ENTRY   /NO, AC NEGATIVE SAYS RETRY NOT DIVIDE!!
        JMP     SELBAK  /SELECT BACK TO FIRST PAIR
/
MONEX,  JMS     SELECT  /AC=0, SELECT FIRST PAIR
        JMP I   L7600   /BACK
/
/
/
/  SELECT ROUTINE
/
TRANS,                  /TEMPORARY FOR LDCMD TO SAVE COMMAND
SELECT, 0
        6750            /CONTENTS OF AC11 SAYS WHICH PAIR
        SER             /CLEAR POSSIBLE ERRANT FLAGS
L70,    70              /SAFE NO-OP
        SDN
L175,   175
        STR
LL16,   16
        CLA             /PERHAPS NOT NECESSARY
        TAD     LL16    /SET DONE FLAG AGAIN
        LCD
        JMP I   SELECT
/
        PAGE
/

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RXCOPY.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444

/ RXCOPY FOR OS/8 V3D AND OS/78 V1A
/
/ THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/ SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION
/ OF THE ABOVE SOPYRIGHT NOTICE.  THIS SOFTWARE, OR ANY THEREOF,
/ MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER
/ PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/ THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE SOFTWARE
/ SHALL AT ALL TIMES REMAIN IN DEC.
/
/ THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/ NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/ EQUIPMENT CORPORATION.
/
/ DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/ SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/

/
/ VERSION V4A	M.H.	MAY 20, 1977
/		S.R.	MAY 20, 1977
/ VERSION V4B	S.R.	AUG 24, 1978
/
/ START ADDRESS 16000;  JSW 7003
/
/ THIS PROGRAM PERFORMS COPY, READ, AND COMPARE OPERATIONS ON
/ RX FLOPPY DISKS ON A TRACK BY TRACK BASIS.
/
/  THE COMMAND OPTIONS ARE:
/
/P	PAUSE BEFORE AND AFTER ACCESSING DISK
/M	MATCH WITH NO IMPLIED COPY
/N	COPY WITH NO IMPLIED MATCH
/R	READ OUTPUT DEVICE WITH NO IMPLIED MATCH OR COPY
/V	PRINT VERSION NUMBER
/C	(NOT DOCUMENTED) COPY
/S	FORMAT (ONLY) OUTPUT DEVICE TO SINGLE DENSITY
/D	FORMAT (ONLY) OUTPUT DEVICE TO DOUBLE DENSITY
/ IF NO OPTIONS ARE EXPLICITLY DECLARED, COPY AND MATCH ARE ASSUMED.
/
/  THERE ARE TWO COMMAND FORMATS:
/
/   DEV:<DEV:/OPTION   WHERE OPTIONS ARE  C, P, N, M, OR V.
/   DEV:/R     DEV:</R   <DEV:/R  THREE FORMATS FOR  R, S, D, OR V.
/ 
/
/  WARNING!!
/
/  THIS PROGRAM HAS TWO PATHOGENIC CONNECTIONS WITH THE STANDARD
/  RX HANDLERS
/
/  IT IS ASSUMED THAT THE RX SYSTEM HANDLER HAS AT LOCATION 7623
/  A WORD THAT CONTAINS THE 20 BIT IF BOOTED TO UNIT #1
/
/  IT IS ASSUMED THAT THE RX NON-SYSTEM HANDLER HAS ENTRY POINTS
/  CORRESPONDING TO UNIT NUMBERS AS FOLLOWS:
/
/		UNIT		LAST DIGIT OF ENTRY POINT
/
/		0		0
/		1		4
/		2		1
/		3		5
/
/  WHERE UNITS 2 AND 3 ARE A SECOND PAIR OF FLOPPIES ON A VT78 ONLY!
/
/

MAGIC=7623		/WORD IN RX SYSTEM HANDLER HAS 20 IF BOOTED ONTO
/			/UNIT #1 (RIGHT-HAND ONE)
OPT1=7643		/1ST COMMAND DECODER OPTION WORD
OPT2=7644		/2ND COMMAND DECODER OPTION WORD
OPT3=7645		/3RD COMMAND DECODER OPTION WORD
BUFF=2000		/INPUT BUFFER FOR TTY MSGS
TYP1=25			/DEVICE CODE FOR RX01
TYP2=32			/DEVICE CODE FOR MULTI-RX HANDLER WAS 27 (TAKEN BY TA8E)
BSIZE=6400		/BUFFER SIZE IN OCTAL WORDS
BSTART=20		/BUFFER START
BHALF=BSIZE%2		/HALF OF BSIZE
USR=200			/ENTRY POINT OF USR
NOMAT=2000		/NO MATCH OPTION MASK
COPY=1000		/COPY OPTION MASK
MATCH=4000		/MATCH OPTION MASK; NOTE SOME CODE !KNOWS! THIS IS 4000
READ=0100		/READ OPTION MASK
VERSION=0004		/VERSION OPTION MASK
PAUS=0400		/PAUSE OPTION MASK
SINGLE=40		/SINGLE DENSITY FORMAT ONLY
DOUBLE=200		/DOUBLE DENSITY FORMAT ONLY
OLDOUB=400		/ORIGINAL POSITION OF DOUBLE BIT
CHANGE=1		/IN OPTION WORD, 1 MEANS MUST FORMAT OUTPUT MEDIA
/
/  CORE LAYOUT
/
/  FIELD 0
/
/  RX BUFFER	0020-6417
/  ERROR MSGS	6420-7177
/  TTY HANDLER	7200-7577
/  SYSTEM	7600-7777
/
/  FIELD 1
/
/  RX BUFFER	0020-6417
/  INIT CODE	5000-6417
/  PROGRAM	6420-7577
/  SYSTEM	7600-7777
/
/  FIELD 2&3 (OPTIONAL)
/
/  RX BUFFER	0020-6417
/
/  EXECUTION ORDER
/
/  INIT CODE STARTS AT 6000, THEN TO 5000, 5200, 5400, 7110
/
/  MAIN LOOP IS AT 6420
/  SERVICE SUBROUINES OCCUPY MOST OF REST OF THE FIELD
/
/
/  FLOPPY IOT'S
/
SDN=6755
LCD=6751
STR=6753
XDR=6752
SER=6754
FLINIT=6757
/
AC7776=CLL CLA CMA RAL		/SET AC TO -2
AC7775=CLL CLA CMA RTL		/SET AC TO -3
AC0002=CLL CLA CML RTL		/SET AC TO 2
AC4000=CLL CLA CML RAR		/SET AC TO 4000
/
/
/  THE OPTION WORDS FROM THE COMMAND DECODER ARE COMBINED INTO ONE WORD
/  HERE CALLED 'OPTION'. THE BITS IN OPTION ARE M,N,C,P,D,R,S,0,0,V,0,0.
/  NOTE THAT ONLY THE 'D' BIT HAS BEEN REPOSITIONED.
/
/  WARNING! THE MEANING OF THE M AND C BITS ON INPUT IS DIFFERENT THAN THAT
/  WHILE THE PROGRAM IS ACTUALLY RUNNING. ON INPUT C IS COPY AND MATCH.
/  ON INPUT M IS MATCH WITHOUT COPY. WHILE THE PROGRAM IS RUNNING, M
/  IS MATCH (INDEPENDENT OF COPY), AND C IS COPY (INDEPENDENT OF MATCH).
/
/  SUMMARY OF CONFIGURATION DEPENDENT VARIABLES
/
/	ISVT78		1 IF A VT78, 0 IF NOT
/	ISBIG		1 IF GREATER THAN 12K, 0 IF NOT
/	ISDOUB		0 IF SINGLE DENSITY TRANSFER, 1 IF DOUBLE
/
/
/  SUMMARY OF DERIVED VARIABLES  (DO NOT APPEAR AS SUCH IN PROGRAM)
/
/	HLFTRK		(NOT ISBIG).AND.ISDOUB=1.AND.MATCH OPTION
/	SHORT		ISDOUB=0.IOR.HLFTRK
/	SLOW		ISVT78.AND.ISDOUB=1
/
/  I/O CONTROLL INFORMATION IS PLACED IN THE VARIABLES RIFN, ROFN
/
/	RIFN		4000  IF RX02 OR RX03 HARDWARE
/			0400  IF A DOUBLE DENSITY TRANSFER IS TAKING PLACE
/			0020  IF UNITS 1 OR 3
/			0002  ALWAYS SET, INDICATES READ FUNCTION
/			0001  IF UNITS 2 OR 3, SECOND PAIR ON VT78
/
/	ROFN		WHICH IS THE SAME WORD FOR OUTPUT, GETS BITS IN
/			THE SAME FORMAT
/
/  THE ABOVE VARIABLES RESULT IN THE SETTING OF THE FOLLOWING COUNTS
/    WHICH ARE PLACED HERE AND THERE IN CONVENIENT PAGES
/
/	COUNT1		-20 IF ISDOUB=1, -10 IF NOT
/	COUNT2		-100 IF ISDOUB=1, -40 IF NOT
/	COUNT3		-400 IF ISDOUB=1, -200 IF NOT
/	COUNT4		-2 IF DOUBLE HEADED, -1 IF NOT
/	COUNT5		-2 IF HLFTRK, -1 IF NOT; 
/	COUNT6		10 IF SHORT, 20 IF NOT
/	COUNT7		-1 IF SHORT, -2 IF NOT
/	COUNT8		3 IF SLOW, 2 IF NOT
/	COUNT9		SKP IF SLOW, IAC IF NOT
/
/
	FIELD	1
	*5000
/
/  ADDITIONAL ONCE-ONLY CODE
/
/
/
/  PRINT VERSION NUMBER EVEN IF SOME ERRORS
/
LOC3,	TAD	OPT2	/PRINT VERSION FIRST EVEN IF AN ERROR
	AND	(VERSION
	SNA CLA		/SKIP IF PRINTOUT NEEDED
	JMP	VALID	/NO, CONTINUE CHECKING
	TAD	(VERBUF	/ADDRESS OF MESSAGE IN FIELD 0
	JMS	TYPE
/
/
/
/  VARIOUS CHECKING FOR ILLEGAL SWITCHES
/
VALID,	TAD	(-COPY-OLDOUB-1  /IS SWITCH OTHER THAN COPY OR DOUBLE?
	AND	OPT1	/IN THE FIRST COMMAND DECODER OPTION WORD
	SZA CLA		/SKIP IF OK
	JMP	ERR17
	TAD	(-MATCH-NOMAT-PAUS-READ-SINGLE-VERSIO-1
	AND	OPT2	/CHECKING FOR OTHER THAN M,N,P,R,S,V
	SZA CLA
	JMP	ERR17
	TAD	OPT3	/THIS WORD SHOULD BE 0, I.E. NO SWITCHES AT ALL
	SZA CLA		/SKIP IF OK
	JMP	ERR17
	TAD	OPT1	/DOUBLE, IF PRESENT, MUST CHANGE POSITION
	AND	(OLDOUB	/CHECK IT IN OLD POSITION
	SZA CLA		/SKIP IF NOT THERE
	TAD	(DOUBLE-OLDOUB	/MOVE TO NEW POSITION
NOFORM,	TAD	OPT1	/JOIN ALL SWITCHES INTO ONE WORD
	TAD	OPT2	/COMBINING WORDS
	DCA	OPTION	/HOLD ALL TOGETHER FOR SIMPPLICITY
	TAD	(BITTAB	/LOAD UP TO TEST COMBINATIONS
	DCA	TMP5
	TAD	OPTION
	DCA	TMP6
VALLOO,	TAD	TMP6
	CLL RAL		/NEXT OPTION BIIT TO LINK
	DCA	TMP6
	TAD I	TMP5	/NEXT MASK
	SNA		/SKIP IF MORE TO DO
	JMP	CROSS	/CROSS TALK CHECKED OUT
	ISZ	TMP5	/BUMP POINTER
	AND	TMP6	/CHECK ILLEGAL POSSIBILITIES
	SNL		/SKIP ONLY IF MASTER BIT IS ON
	CLA		/GO OUT VIA JMP VALLOO
	SNA CLA		/SKIP IF MASTER AND SOME OTHER MATCH, ILLEGAL
	JMP	VALLOO
ERR17,	TAD	(MSG17-MSG6	/SWITCHES ERROR MSG
ERR6,	TAD	(MSG6-MSG5
ERR5,	TAD	(MSG5-MSG3
ERR3,	TAD	(MSG3
	JMP	PERR	/GO PRINT ERROR
/
CROSS,	TAD	(SINGLE+DOUBLE+MATCH+READ	/ANY SPECIFIED FUNCTION
	AND	OPTION
	SZA CLA		/SKIP IF NO
	JMP	CROSS1	/A FUNCTION THERE, DON'T SET C
	TAD	OPTION
	AND	(-COPY-1
	TAD	(COPY
	DCA	OPTION
CROSS1,	TAD	(SINGLE+DOUBLE+NOMAT+READ
	AND	OPTION	/SET M IF REQUIRED
	SZA CLA		/SKIP IF NECESSARY
	JMP	CROSS3	/NO
	TAD	OPTION
	RAL		/KNOW! THAT MATCH=4000
	CLL CML RAR
	DCA	OPTION
/
/  NOW OUTPUT DEVICE
/
CROSS3,	TAD	OUTDEV
	SNA
	JMP	ERR6	/DEVICE NOT THERE AT ALL!
	JMS	CHCKRX	/IS IT REALLY AN RX? RETURN UNIT NUMBER;+2 FOR READ
	DCA	ROFN	/BUILD REST OF IT IN LATER
/
/  NOW INPUT DEVICE (IF ANY)
/
CROSS2,	TAD	(READ+SINGLE+DOUBLE
	AND	OPTION	/AN INPUT DEVICE NEEDED
	SZA CLA		/SKIP IF NECESSARY
	JMP	REAFOR	/READ OR FORMAT
	TAD	INDEV
	SNA
	JMP	ERR5	/DEVICE NOT PRESENT AT ALL, ERROR
	JMS	CHCKRX	/IS IT REALLY AN RX? RETURN READ CODE +UNIT #
	DCA	RIFN
	TAD	RIFN	/CHECK IF UNIT NUMBERS THE SAME
	CIA		/WHICH IS AN ERROR
	TAD	ROFN
	SNA CLA		/SKIP IF DIFFERENT
	JMP	ERR2
	JMP	IICNT
/
REAFOR,	TAD	INDEV	/FOR READ AND FORMAT INPUT DEVICE IS ILLEGAL
	SZA CLA		/SKIP IF NOT PRESENT
	JMP	ERR2	/SPECIFICATION ERROR ON EXTRA DEVICE
	JMP	IICNT	/OK, CONTINUE INITIALIZATION
/
/
TMP5,	0		/WORK LOCATIONS
TMP6,	0
/
	PAGE
/
/
/  ESTABLISH FUNDAMENTAL CONFIGURATION VARIABLES
/
IICNT,	JMS I	(USR	/UNLOCK USR
	11
	TAD	OPTION	/IF SLASH-P, MUST GET CORRECT FLOPPY ON!
	AND	(PAUS
	SNA CLA		/SKIP IF SLASH-P
	JMP	IICNT2	/NO, JUST KEEP GOING
SYSOFF,	JMS	QUEST	/ASK REMOUNT QUESTION
	MSG12		/ADDR OF MESSAGE
	JMP	SYSOFF	/"N" ASK AGAIN
/			/"Y" CONTINUE TO INITIALIZE
IICNT2,	CDF	70	/TEST FOR A VT78
	RDF
	CDF	10	/BACK TO US
	TAD	(7750	/VT78 RETURNS 30 FROM 70 !
	SNA CLA
	IAC
	DCA	ISVT78	/
	CDF	0	/FETCH CORE SIZE WORD
	TAD I	(7777
	CDF	10	/INDIRECTS HERE
	AND	(70
	TAD	(7750	/MAKING + IF 16 OR MORE K OF CORE
	SMA CLA		/SKIP IF NOT 16K
	IAC		/16K
	DCA	ISBIG	/SAVE THAT INFO
	TAD	ROFN	/GET DEVICE STATUS TYPE FOR OUTPUT DEVICE
	JMS	DEVSTT	/RETURN CODE IN .+1, UPDATED ROFN WORD IN AC
MEDOU,	-1		/RETURN 0-3;SINGLE;SINGLE ON DOUB;DOUB;QUAD
	DCA	ROFN
	TAD	MEDOU	/DEFAULT FOR MEDIN, IF NO INPUT MEDIA AT ALL
	DCA	MEDIN
	TAD	INDEV	/IS AN INPUT DEVICE?
	SNA CLA		/SKIP IF YES
	JMP	ONLY1	/SPECIAL PROCESSING FOR ONE DEVICE CASES
	TAD	RIFN	/GETTING UNIT NUMBER
	JMS	DEVSTT	/CHECK FOR READY, RETURN TYPE CODE
MEDIN,	-1		/RETURN 0-3, SAME AS MEDOU
	DCA	RIFN	/FULL I/O SKELETON
	TAD	MEDIN	/CONVENIENCE, MAKE INPUT OUTER LEVEL INDEX
	RTL
	TAD	MEDOU	/INNER LEVEL INDEX
	TAD	(ACTAB	/TABLE FOR WHICH ACTION TO TAKE
	DCA	TMP7
	TAD I	TMP7	/AN EXTRA INDIRECT NEEDED
	DCA	TMP7
	JMP I	TMP7	/GO TO CORRECT ACTION
/
/  DEVSTT
/
/  CALL WITH 2 (READ CODE) + UNIT NUMBER IN AC: PARTIAL RIFN/ROFN WORD
/
/  IF DRIVE NOT READY, ERROR OUT DIRECTLY
/
/  RETURN WITH DEVICE TYPE IN CALL +1
/
/	0		RX01 DRIVE
/	1		RX02 DRIVE WITH RX01 FLOPPY
/	2		DOUBLE DENSITY DRIVE AND MEDIA; EITHER BOTH NOT
/			BOTH MAY BE DOUBLE SIDED, BUT THAT IS IGNORED!!
/	3		RX03 DRIVE AND RX03 FLOPPY
/
/  RETURN WITH FULL RIFN/ROFN CODE IN AC
/
DEVSTT,	0
	DCA	TMP7	/SAVE CALLING CODE
	TAD	TMP7	/BUT CHECK OUT WHICH DRIVE PAIR
	JMS	SELECT	/SELECT PAIR, IF NECESSARY; AC HAS BEEN ANDED WITH 7776
	TAD	(410	/DO DOUBLE DENSITY 12 BIT READ STATUS
	SDN		/WAITING ON DONE
	JMP	.-1
	LCD		
	SDN		/WAIT AGAIN ON DONE
	JMP	.-1
	XDR		/GET STATUS
	AND	(232	/KEEPING READY, DENSITY ERROR, DOUBLE, QUAD
	DCA	TMP8	/SAVE WHILE WE CLEAR UP DEVICE
	TAD	(416	/DUMMY READ ERROR STATUS TO SET DONE AGAIN
	LCD
	SER		/CLEAR POOSSIBLE ERROR FLAG
L7600,	7600		/IT MAY SKIP!
	TAD	TMP8	/GET BACK STATUS
	TAD	L7600	/CHECK FOR READY
	SPA
	JMP	STERR	/NOT READY, PRINT ERROR
	CLL RTR		/PUT QUAD BIT TO LINK
	SZL		/SKIP ON NOT QUAD
	CLL CML CLA CMA	/ALL BITS TO 1 !! FALLS THRU TO EXIT WITH 3
	RTR		/PUT DOUBLE BIT TO LINK
	SNL		/SKIP ON DOUBLE
	JMP	REJOIN	/JOIN WITH OTHER CASES, AC NOW 0
	CMA		/MAKING SINGLE -2, DOUBLE -1, QUAD 0
	TAD	(3	/MAKING SINGLE 1, DOUBLE 2, QUAD 3
REJOIN,	DCA I	DEVSTT	/RETURN 0-3 TYPE IN CALL+1
	TAD I	DEVSTT	/GET CODE BACK
	TAD	(FNTAB	/TURN CODE INTO FUNCTION BITS
	DCA	TMP8
	TAD I	TMP8	/4000 FOR DOUBLE DRIVE, 400 FOR DOUBLE TRANSFER
	TAD	TMP7	/ORIGINAL CALLING BITS
	ISZ	DEVSTT	/HOP OVER RETURNED ARGUMENT
	JMP I	DEVSTT	/EXIT WITH CODE IN AC
/
/
STERR,	CLA			/AC JUNK COMING IN
	TAD	(MSG18-MSG19	/PRINT MESSAGE 18
ERR19,	TAD	(MSG19-MSG15	/PRINT MESSAGE 19
ERR15,	TAD	(MSG15		/PRINT MESSAGE 15
	JMP	PERR
/
TMP7,	0
TMP8,	0

/
	PAGE
/
/  SPECIAL CODE FOR ONE DEVICE CASES; READ, SINGLE, DOUBLE
/
ONLY1,
	TAD	OPTION	/SEPARATE OUT READ
	AND	(SINGLE+DOUBLE
	SNA		/SKIP IF NOT READ (CAN ONLY BE ONE OF THREE BITS!)
	JMP	READIT	/READ CASE, FALL INTO OTHER CODE
	RAL		/WATCH OUT! GOING TO SPLICE PROPER DENSITY BIT
	JMP	TOUGH	/INTO ROFN FOR LATER FORMAT
/
/  ENTER FROM DISPATCHER, AUTO-FORMAT, AND OK
/
CISZ,	ISZ	OPTION	/SET CHANGE DENSITY BIT IN OPTION WORD
SAME,
/
/  SET UP COUNT VARIABLES
/
IICNT4,	TAD	RIFN	/PUT TRANSFER DENSITY BIT FROM INPUT INTO OUTPUT
TOUGH,	AND	(400	/KEEPING THAT BIT; FORMAT ONLY CASE JOINS HERE
	DCA	ISDOUB	/TERMPORARY USE OF LATER VARIABLE
	TAD	ROFN	/OUTPUT CONTROL
	AND	(7377	/KEEPING OTHER BITS
	TAD	ISDOUB
	DCA	ROFN	/REPLACING MODIFIED OUTPUT WORD
READIT,	AC7776		/TAKE OFF READ BIT FOR OUTPUT WRITE FUNCTION
	TAD	ROFN
	DCA	WOFN
	AC7776		/
	TAD	MEDIN	/MAKE A TEMPORARY VARIABLE ISDOUB
	SMA CLA		/SKIP IF SINGLE
	IAC
	DCA	ISDOUB	/WHICH IS 1 IF DOUBLE DENSITY MEDIA
	TAD	ISDOUB	/SIGNLE OR DOUBLE
	SZA CLA		/SKIP IF SINGLE
	TAD	(-10	/DOUBLE, MAKE -20
	TAD	(-10	/SINGLE, MAKE -10
	DCA	COUNT1
	TAD	COUNT1	/NOW MULTIPLY BY FOUR
	CLL RAL
	CLL RAL
	DCA	COUNT2
	TAD	COUNT2	/NOW AGAIN BY FOUR
	CLL RAL
	CLL RAL
	DCA	COUNT3
	AC7775
	TAD	MEDIN	/CHECK FOR QUAD SIZED
	SMA CLA		/SKIP IF NOOT
	IAC
	CMA		/MAKE A -2 IF YES, -1 IF NO
	DCA	COUNT4
	TAD	ISBIG	/MAKE VARIABLE HLFTRK
	SNA CLA		/MISSES COLLECT IN SZA CHAIN
	TAD	OPTION
	SPA CLA		/!!KNOWS!! THAT MATCH BIT IS AC0
	TAD	ISDOUB
	SZA CLA
	IAC		/HALF TRACK; SMALL MACHINE, MATCH OPTION, DOUBLE DENSITY
	CMA
	DCA	COUNT5	/-2 IF HALF-TRACK, OTHERWISE -1
	TAD	COUNT5	/FIND OUT IF ONE OR TWO FIELDS PER SWOOP
	AND	ISDOUB	/LEAVING 1 IN AC IF TWO FIELDS
	CMA		/SO MAKE ANOTHER -2,-1 COUNTER
	DCA	COUNT7
	TAD	COUNT7	/NOW MULTIPLY IT BY -10 OCTAL TO MAKE FIELD SPAN
	CIA
	CLL RAL
	RTL
	DCA	COUNT6
	TAD	ISVT78	/NOW CONSTRUCT INTERLEAVE, TWO OR THREE
	AND	ISDOUB	/THREE IF DOUBLE DENSITY ON A VT78
	TAD	(2
	DCA	COUNT8
	AC7775		/REST OF JOB, MAKE SKP OR IAC
	TAD	COUNT8
	SZA CLA		/SKIP IF IT WAS THREE INTERLEAVE
	TAD	(IAC-SKP /TWO INTERLEAVE, WANTS AN IAC
	TAD	(SKP	/THREE INTERLEAVE, WANTS A SKIP
	DCA	COUNT9
	TAD	OPTION	/INITIALIZE ROFLD
	AND	(READ	/IS IT ONLY A READ
	SNA CLA		/SKIP IF YES, CDF 0
	TAD	COUNT6	/MATCH, INIT AT CDF SPAN
	TAD	(CDF 0
	DCA	ROFLD
	TAD	OPTION	/NEED TO REFORMAT OUTPUT DRIVE?
	AND	(CHANGE+SINGLE+DOUBLE
	SNA CLA		/SKIP IF YES
	JMP	DO00	/NO, GO DO OPERATION
	JMP	REFORM	/GO TO REFORMATTER
/
/
ISVT78,	0		/1 IF A VT78, OTHERWISE 0
ISBIG,	0		/1 IF IT HAS 16K OF CORE, 0 IF LESS
ISDOUB,	0		/1 IF TRANSFER DOUBLE DENSITY
/
	FIELD	1
	*6000
/
/
/  EQUATES FOR AUTO-INCR REG'S, SO THEY SHOW UP IN CREF
/
X10=10
X11=11
X17=17
/
/ ***** BEGIN ONCE ONLY CODE *****
/
/
/ ENTER HERE AND GET USER INPUTS
/
START,	CLA!SKP			/NORMAL ENTRY (MUST CALL DECODER)
CHAIN,	JMP	NODEC		/CHAIN ENTRY
	CDF	10
	JMS I	(USR		/CALL IT
	5
	5200			/DEFAULT INPUT EXT.(SPECIAL MODE)
	0			/PRESERVE TENTATIVE FILES
/
/ LOAD CONSOLE TTY HANDLER
/
NODEC,	JMS I	(USR		/LOAD THE KL8E HANDLER
	1
	DEVICE	TTY
TTYEP,	7201
	JMP	ERRUSR		/PRINT USER ERROR
	TAD	TTYEP		/MOVE ENTRY POINT FROM THIS PAGE
	DCA	TTYENT
/
/ LOAD OUTPUT DEVICE IF SPECIFIED
/
	JMS	CTRLC		/CHECK FOR CONTROL C TYPE-IN
	TAD I	(7600		/GET OUTPUT DEV
	AND	(17
	DCA	OUTDEV
	TAD I	(7605		/GET INPUT DEVICE
	AND	(17
	DCA	INDEV
	TAD	OUTDEV		/IF NO OUTPUT DEVICE
	SZA CLA			/IS NAMED MOVE INPUT
	JMP	LOC10		/TO OUTPUT DEVICE
	TAD	INDEV		/MOVE IT!
	DCA	OUTDEV
	DCA	INDEV		/ZERO INPUT DEVICE
/
/ VALIDATE OUTPUT DEVICES AND FILES
/
LOC10,	JMS	CTRLC		/CHECK FOR CONTROL C
	TAD	(7601		/MAKE SURE THAT THERE ARE NO OUTPUT FILES
	DCA	TMP1		/OR OTHER OUTPUT DEVICES
	TAD	(-4
	DCA	TMP2
LOC1,	TAD I	TMP1		/GET DECODER ENTRY 
	SZA!CLA			/IS IT ZERO?
	JMP	ERR2		/NO -- ERROR
	ISZ	TMP1		/INCREMENT POINTER
	ISZ	TMP2		/YES -- DONE WITH OUTPUT ENTRIES?
	JMP	LOC1		/NO -- PROCEED
				/YES --
/
	JMS	CTRLC		/CHECK FOR CONTROL C
	TAD I	(7605		/WAS THERE ANY INPUT SPECIFICATION?
	SNA CLA
	JMP	LOC3A		/NO
	TAD	(7606		/YES -- MAKE SURE THAT THERE ARE NO INPUT FILES
	DCA	TMP1		/OR OTHER INPUT DEVICES
	TAD	(-5
	DCA	TMP2
LOC2,	TAD I	TMP1		/GET DECODER ENTRY
	SZA!CLA			/IS IT ZERO?
	JMP	ERR2		/NO -- ERROR
	ISZ	TMP1		/INCREMENT POINTER
	ISZ	TMP2		/YES -- DONE WITH INPUT ENTRIES?
	JMP	LOC2		/NO -- PROCEED
LOC3A,	JMP	LOC3		/YES -- CONTINUE ON NEXT PAGE
/
OUTDEV,	0			/OUTPUT DEVICE NUMBER
INDEV,	0			/INPUT DEVICE NUMBER
TMP0,	0
TMP1,	0			/TEMP STORE
TMP2,	0			/TEMP STORE
/
ERR2,	TAD	(MSG2		/ILLEGAL SPECIFICATION
PERR,	JMS	TYPE		/PRINT ERROR MESSAGE
	JMP	GOEXIT		/LEAVE
/
ERRUSR,	JMS I	(USR		/PRINT USER ERROR
	7
	2
	JMP	GOEXIT
/
/
/  CHCKRX
/
/  CALL WITH DEVICE # IN AC, RETURN IF REALLY AN RX
/  RETURN WITH UNIT NUMBER IN AC; 20 IF RIGHT HAND DRIVE (#1)
/  PLUS 1 IF A SECOND PAIR ON A VT78
/  PLUS ALWAYS HAVING A 2 ADDED IN FOR A READ FUNCTION
/
OLDRX=TYP1^10
NEWRX=TYP2^10		/TYPE CODES FOR RX HANDLERS
/
/
/
CHCKRX,	0
	DCA	TMP0	/SAVE DEVICE NUMBER
	CLA CMA
	TAD	TMP0	/CHECK IF IT IS SYS
	SZA CLA		/SKIP IF YES
	JMP	NONSYS	/NO, GO TO NON-SYS PROCESSING
CHCKSY,	CDF	0	/FETCH SKELETON WORD FROM SYS
	AC0002		/PUT IN READ BIT (BIT NOT SET IN MAGIC)
	TAD I	(MAGIC
	CDF	10
	JMP	CHCKJ	/JOIN UP TO MASK AND EXIT
NONSYS,	TAD	(7757	/TABLE BASE
	TAD	TMP0
	DCA	TMP1	/HOLD FOR INDIRECT
	TAD I	TMP1	/GET STORED CODE
	AND	(770	/KEEP TYPE BITS
	TAD	(-NEWRX	/IS IT A NEW ONE
	SZA		/SKIP IF YES, BOUNCE DOWN SZA'S
	TAD	(-OLDRX+NEWRX /SO SEE IF OLD ONE
	SZA		/SKIP IF GOT A MATCH
	JMP	ERR3	/WRONG DEVICE TYPE, ERROR OUT
	TAD	(4001	/RE-ESTABLISH LOAD ADDRESS ARGUMENT
	DCA	LOADAD
	TAD	TMP0	/TRY TO LOAD HANDLER
	JMS I	(USR
	1		/LOAD CODE
LOADAD,	4001		/GETS WRITTEN OVER
	JMP	ERR3	/ERROR OUT
	TAD	LOADAD	/OUCH!! ENTRY POINT FOR UNIT 1+3, HAS A 4 IN IT!!
/			/ENTRY POINT FOR UNIT 2+3 HAS A 1 IN IT
	AND	(5	/KEEP ONLY THE TWO RELEVANT BITS
	TAD	(16	/SHIFT 4 TO 20, PUT IN 2 FOR READ CODE
CHCKJ,	AND	(23	/KEEP 2 FOR READ CODE, 20 AND 1 FOR UNIT SPECIFIERS
	JMP I	CHCKRX	/OK, RETURN
/
	PAGE
/

/
/
	*6400
/
/  PUT TABLES HERE TO FIT
/  BITTAB
/
/  TABLE FOR DETERMINING ILLEGAL CALLING OPTIONS
/
BITTAB,	6700		/WITH M; N,C,D,R,S  ILLEGAL
	5600		/WITH N; C,D,R,S  ILLEGAL
	3400		/WITH C; D,R,S  ILLEGAL
	0001		/WITH P; ALL ARE LEGAL
	6000		/WITH D; R,S ILLEGAL
	4000		/WITH R; S ILLEGAL
	0		/LOOP STOPPER; ALL LEGAL WITH V, FALLS OUT OK
/
/  ACTAB
/
/  TABLE OF ACTION FOR 16 COMBINATIONS OF INPUT AND OUTPUT TYPES
/
ACTAB,	SAME		/IN TYPE 0, OUT TYPE 0
	SAME		/0,1
	CISZ		/0,2
	CISZ		/0,3
	SAME		/1,0
	SAME		/1,1
	CISZ		/1,2
	CISZ		/1,3
	ERR15		/2,0
	CISZ		/2,1
	SAME		/2,2
	SAME		/2,3  ?????
	ERR15		/3,0
	ERR15		/3,1
	ERR15		/3,2
	SAME		/3,3
/
/
FNTAB,	0		/FUNCTION BITS BY TYPE CODE 0-3
	4000		/SINGLE MEDIA BUT 4000 DOUBLE DRIVE
	4400		/DOUBLE ON DOUBLE
	4400		/QUAD ON QUAD, LOOP HANDLES WHICH HEAD
/
/
DO00,	TAD	(-115	/TRACK LOOP CONTROL COUNT
	DCA	TRACK
/
/ ****** END OF ONCE ONLY CODE ******
	IFNZRO	.-6420&4000	<*6420>	/FORCE BEYOND BUFFER
/
/  ##  MAIN LOOP  ##
/
DO0,	TAD	COUNT4		/SET UP HEAD CONTROLLER
	DCA	HEADER
DO1,	TAD	COUNT5		/SET UP HALF-TRACK CONTROLLER
	DCA	HFTRCK
/
/ WAS COPY SELECTED?
/
DO2,	TAD	HEADER		/PLACE HEADER INFO TO COMMAND WORD
	CMA CLL RTR
	RTR			/0 IF FIRST, 1000 IF SECOND
	TAD	(100		/ALSO NEED EIGHT-BIT BIT
	DCA	LOOPFN		/FUNCTION FOR THIS LOOP
	TAD	OPTION		/SHOULD WE COPY?
	AND	(COPY
	SNA!CLA
	JMP	DO3		/NO
	JMS	RI		/YES -- READ INPUT DEVICE INTO FIELD 0
	JMS	WO		/WRITE OUTPUT DEVICE FROM FIELD 0
/
/ WAS READ SELECTED?
/
DO3,	TAD	OPTION		/SHOULD WE READ?
	AND	(READ
	SZA CLA			/SKIP IF NOT NEEDED
	JMS	RO
/
/ WAS MATCH SELECTED?
/
DO4,	AC4000		/ADD PUTS MATCH BIT TO LINK
	TAD	OPTION
	AND	(COPY	/MATCH IN LINK, COPY IN AC
	SNL		/SKIP IF A MATCH
	JMP	DO6	/NO MATCH, READY FOR LOOP CONTROL
	SNA CLA		/HAS A COPY ALREADY BEEN DONE; IF SO DON'T READ TWICE
	JMS	RI	/READ FROM INPUT DEVICE
	JMS	RO	/READ FROM OUTPUT DEVICE
/
/ COMPARE BUFFERS
/
DO5,	JMS	COMP		/CALL ACTION TO DO COMPARE
/
/  LOOP CONTROLLERS
/
DO6,	CLA			/MAY HIT WITH JUNK IN AC
	ISZ	HFTRCK		/GO AGAIN FOR OTHER HALF TRACK?
	JMP	DO2		/YES
	ISZ	HEADER		/NEED TO GO TO OTHER HEAD?
	JMP	DO1		/OTHER HEAD, LOOP AGAIN
	ISZ	TRACK		/INCREMENT TRACK, CHECK DONE
	JMP	DO0		/NO
EXITOK,	TAD	OPTION		/DOES HE NEED TO REMOUNT SYS?
	AND	(PAUS
	SNA CLA			/SKIP IF YES
	JMP	GOEXIT		/NO, BACK TO SYSTEM
SYSON,	JMS	QUEST		/ASK HIM
	MSG11			/ADDR OF MESSAGE
	JMS	SYSON		/"N" ANSWER, ASK AGAIN
/				/"Y" ANSWER, GO EXIT
GOEXIT,	JMS	SELECT		/FORCE BACK TO FIRST PAIR
	CDF CIF 0		/FIELDS FOR EXEC
	JMP I	(7605
/
/  ##  END OF MAIN LOOP  ##
/
OPTION,	0			/OPTION BITS TOGETHER IN ONE WORD
COUNT4,	0			/-1 IF ONE HEAD, -2 IF TWO
COUNT5,	0			/-2 IF TRACK MUST BE DONE IN TWO PASSES
/				/OTHERWISE -1
HFTRCK,	0			/CONTROLS LOOP PASSES PER TRACK,FILL FROM COUNT5
HEADER,	0			/FILL FROM COUNT4, CONTROLS HEAD
LOOPFN,	0			/EIGHT-BIT MODE + WHICH HEAD TO USE
/
/ SUBROUTINE QUEST -- PRINT MSG AND ASK QUESTION
/
/			JMS	QUEST
/			ADDR OF MESSAGE
/			"N" RETURN
/			"Y" RETURN
/
QUEST,	0
Q1,	TAD I	QUEST		/GET ADDR OF MESSAGE
	JMS	TYPE		/PRINT IT
	TAD	(BUFF		/SELECT INPUT BUFFER
	JMS	RDANS		/READ ANSWER
	TAD I	(BUFF		/WHAT WAS IT?
	AND	(177
	TAD	(-116		/WAS IT A "N"
	SNA
	JMP	Q3		/GO TO "N" EXIT
	TAD	(-131+116	/WAS IT A "Y"
	SZA!CLA
	JMP	Q1		/NO -- ASK AGAIN
Q2,	ISZ	QUEST		/"Y" RETURN AT JMS+3
Q3,	ISZ	QUEST		/"N" RETURN AT JMS+2
	JMP I	QUEST
/
/ SUBROUTINE CTRLC -- CHECK FOR CONTROL C
/
CTRLC,	0
	KSF		/SKIP IF A CHARACTER HAS BEEN TYPED
	JMP I	CTRLC	/NO
	KRS
	AND	(177
	TAD	(-3
	SNA!CLA
	JMP	GOEXIT	/IS A CONTROL C, EXIT
	JMP I	CTRLC
/

/
	PAGE
/

/
/ SUBROUTINE RI -- READ FROM INPUT DEVICE
/
RI,	0			/READ FROM INPUT DEVICE
	TAD	RISEC		/SET UP OUR SECTOR
	DCA	SECTOR
	TAD	RIFN		/AND OUR FUNCTION (UNIT, READ, ETC.)
	TAD	LOOPFN		/AND LOOP CONTROLLER FUNCTION
/				/DENSITY, HEAD, AND 8BIT MODE
	DCA	FN
	TAD	RIFLD		/SET UP OUR FIELD
	JMS	BUMPER		/GO DO IT
	MSG8			/ERROR MESSAGE ADDRESS
	TAD	SECTOR		/GET OUR SECTOR BACK
	DCA	RISEC
	JMP I	RI		/BACK TO MAIN LOOP
/
RISEC,	-32			/START AT SECTOR 1 (OFFSET BY 33)
RIFLD,	CDF	0		/START AT FIELD 0
RIFN,	0			/4000 IF DOUBLE DENSITY DRIVE, 20 IF ODD # UNIT
/				/2 ALWAYS FOR READ, 1 IF SECOND PAIR ON VT78
/				/400 IF DOUBLE DENSITY TRANSFER
/
/ SUBROUTINE RO -- READ FROM OUTPUT DEVICE
/
RO,	0			/READ FROM OUTDEV
	TAD	ROSEC		/SET UP OUR SECTOR
	DCA	SECTOR
	TAD	ROFN		/SET UP OUR FUNCTION
	TAD	LOOPFN
	DCA	FN
	TAD 	ROFLD		/SET UP OUR FIELD
	JMS	BUMPER		/GO DO IT
	MSG9
	TAD	SECTOR		/GET BACK OUR SECTOR
	DCA	ROSEC
	JMP I	RO		/BACK TO MAIN
/
ROSEC,	-32			/START AT SECTOR 1
ROFLD,	CDF	0		/SET AT INIT TIME
ROFN,	0			/SET AT INIT TIME, SAME FORMAT AS RIFN

/
/ SUBROUTINE WO -- WRITE OUTPUT DEVICE
/
WO,	0			/WRITE TO OUTPUT DEVICE
	TAD	WOSEC		/SET UP OUR SECTOR
	DCA	SECTOR
	TAD	WOFN		/SET UP OUR FUNCTION
	TAD	LOOPFN
	DCA	FN
	TAD	WOFLD		/SET UP OUR FIELD
	JMS	BUMPER		/GO DO IT
	MSG10
	TAD	SECTOR		/GET BACK OUR SECTOR
	DCA	WOSEC
	JMP I	WO		/BACK TO MAIN LINE
/
WOFLD,	CDF	0		/FIELD TO START OUR WRITE
WOSEC,	-32			/OUR SECTOR, START AT 1
WOFN,	0			/SET FUNCTION AT INIT TIME
/				/SAME FORMAT AS ROFN, BUT NO READ BIT

/
/
/ SUBROUTINE COMP -- COMPARE BUFFERS
/
COMP,	0
	TAD	COMSEC		/OUR SECTOR
	DCA	SECTOR
	DCA	FN		/0 IS COMPARE FUNCTION
	TAD	COMFLD		/SET OUR FIELD
	JMS	BUMPER		/DO IT
	MSG7
	TAD	SECTOR		/SAVE OUR SECTOR
	DCA	COMSEC
	JMP I	COMP
/
COMSEC,	-32			/START AT 1
COMFLD,	CDF	0		/
/
/
/  BUMPER
/
/  ROUTINE TO HANDLER SECTORING, CORE POINTER, AND FIELDS
/
/  CALLED BY RI, RO, WO, COMP;
/  STARTING FIELD IN AC,  ERROR MSG ADDR IN CALL+1
/  BUMPER IN TURN CALLS ACTION
/
BUMPER,	0
	DCA	BUMFLD		/PLACE CDF SO SETS WHEN CALL ACTION
	JMS	CTRLC		/CHECK A CONTROL C
	TAD	FN		/NEED TO SELECT
	JMS	SELECT		/DO IF NECESSARY, AC.AND.7776
	DCA	FN		/REPLACE FUNCTION, SELECT ONCE PER BUMPER CALL
	TAD	COUNT7		/HOW MANY FIELDS TO INCREMENT THRU
	DCA	BUMCNT
B0,	TAD	(BSTART-1	/SET AUTO INCREMENT REG'S
	DCA	X10
	TAD	X10
	DCA	X11
	TAD	BUMFLD		/SET FIELD INTO ACTION
	DCA	BFIELD
BUMFLD,	0			/CDF PLACED HERE BY CALLER
	JMS	ACTION		/CALL ACTION ROUTIN
	JMS	OOPS		/ERROR, PRINTOUT SOMTHING
	TAD	SECTOR		/MOVE TO NEXT SECTOR
	TAD	COUNT8		/ADD IN INTERLEAVE
	SPA			/SKIP IF SPECIAL COMPUTING NEEDED
	JMP	B2		/NO SPECIAL NEEDED, REPLACE SECTOR
COUNT9,	0			/IAC OR SKP PLACED HERE !!
	AND	(1		/FOR 2 INTERLEAVE, SWAP 0 AND 1
	TAD	(-32		/WRAP BACK TO MINUS
B2,	DCA	SECTOR
	TAD	X10		/CHECK IF DONE WITH BUFFER
	TAD	(-BSTART-BSIZE+1 /DONE IF POINTING TO LAST LOC
	SZA CLA			/SKIP IF DONE
	JMP	BUMFLD		/NO, DO NEXT SECTOR
	TAD	(10		/INCREMENT FIELD
	TAD	BUMFLD
	DCA	BUMFLD
	ISZ	BUMCNT		/DONE WITH ALL FIELDS
	JMP	B0		/NO, DO NEXT ONE
	ISZ	BUMPER		/SKIP OVER ERROR POINTER
	JMP I	BUMPER
/
COUNT7,	0			/MINUS NUMBER OF FIELDS PER PASS
COUNT8,	0			/INTERLEAVE 2 OR 3 SET AT INIT TIME
BUMCNT,	0			/LOOP CONTROL FOR FIELDS, FILL FROM COUNT7
/
/  CONSTRUCT ERROR MESSAGE
/
OOPS,	0
	TAD I	BUMPER		/GET ADDR OF MESSAGE
	JMS	TYPE		/PRINT TYPE OF FAILURE
	JMS	ADPRNT		/PRINT (HEAD), TRACK, SECTOR
	JMP I	OOPS
/
	PAGE

/
/ SUBROUTINE TYPE -- PRINT MESSAGE
/			ON ENTRY AC HAS MESSAGE ADDRESS
/
TYPE,	0
	DCA	TYPAD		/SAVE ADDR
	CIF	0
	JMS I	TTYENT
	4100
TYPAD,	0
	0
	NOP
	JMP I	TYPE
/
/ SUBROUTINE RDANS -- READ ANSWER FROM TTY
/			ON ENTRY AC HAS BUFFER ADDR
/
RDANS,	0
	DCA	RDAD		/SAVE ADDR
	CIF	0
	JMS I	TTYENT
	0110
RDAD,	0
	0
	NOP
	JMP I	RDANS
/
TTYENT,	0			/ENTRY POINT TO TTY HANDLER
/
/
/ SUBROUTINE APRNT -- PRINT TRACK AND SECTOR
/			ENTER WITH SECTOR IN AC
/
ADPRNT,	0
	TAD	LOOPFN		/WHICH HEAD
	CLL RTL
	RAL			/HEAD BIT TO AC11
	CLA RAL			/BUT CLEARING OUT OTHER BITS
	JMS	SETIN		/PUT TO MESSAGE
	MSG13A-1
	TAD	TRACK		/TRACK KEPT IN COMPLEMENT FORM
	CMA
	JMS	SETIN
	MSG13B-1
	TAD	SECTOR		/SECTOR KEPT AS SECTOR-33
	TAD	(33
	JMS	SETIN
	MSG13C-1
	TAD	COUNT4		/IS QUAD OPERATION
	IAC			/COUNT4 COMES -2 FOR QUAD, -1 NOT
	SNA CLA			/SKIP IF YES
	TAD	(10		/NO, DON'T TALK ABOUT HEADS
	TAD	(MSG13		/ADDR FOR PRINTOUT
	JMS	TYPE
	JMP I	ADPRNT

/
/ SUBROUTINE SETIN -- ENTER NUMBER INTO A MESSAGE
/
/	ON ENTRY AC HAS NUMBER AND JMS+1 HAS POINTER TO MESSAGE
/	HOLE MINUS 1. (2 DECIMAL DIGIT NUMBERS ARE ASSUMED)
/
SETIN,	0
	DCA	SETIN1		/SAVE NUMBER
	DCA	SETCNT		/ZERO 10'S COUNTER
	TAD I	SETIN		/GET MSG ADDR
	DCA	X17		/ENTER INTO AUTOINC POINTER
	ISZ	SETIN		/BUMP RETURN ADDR
SETINB,	TAD	SETIN1		/GET NUMBER
	TAD	(-12		/SUBTRACT 10 DECIMAL
	SMA			/DONE DIVIDING?
	JMP	SETINA		/NO
	CLA			/YES
	TAD	SETCNT		/GET 10'S
	SNA			/SKIP IF A LEADING DIGIT
	TAD	(-20		/MAKE LEADING 0 A LEADING BLANK
	TAD	(260		/MAKE IT ASCII
	CDF	0		/ERROR MESSAGES IN FIELD 0!
	DCA I	X17		/STORE IN MESSAGE
	TAD	SETIN1		/GET REMAINDER
	TAD	(260		/MAKE IT ASCII
	DCA I	X17		/STORE IN MESSAGE
	CDF	10		/POINT CDF BACK HERE
	JMP I	SETIN
SETINA,	DCA	SETIN1		/SAVE RESULT
	ISZ	SETCNT		/INCREMENT 10'S COUNT
	JMP	SETINB		/CONTINUE
/
SETIN1,	0			/NUMBER STORAGE
SETCNT,	0			/10'S COUNTER
/
/  REFORMAT
/
/  BELONGING HERE ONLY FOR REASONS OF FIT
/
/
REFORM,	TAD	ROFN	/OK, WHAT OUTPUT DENSITY DO WE HAVE
	SMA CLA		/SKIP IF DRIVE IS CAPABLE OF A REFORMAT
	JMP	ERR15	/GO PRINT ILLEGAL TYPE
	TAD	ROFN	/GET FUNCTION BACK
	JMS	SELECT	/ALSO MUST CHECK WHICH PAIR; AC=AC.AND.7776
	TAD	(4006	/TURN OFF TOP BIT, MAKE 2 READ INTO 10 REFORMAT
	SDN		/CONTROLLER READY
	JMP	.-1
	LCD
	STR		/WAIT FOR READY TO TAKE CODE
	JMP	.-1
	TAD	(111	/SAFETY CODE
	XDR		/PLACE TO DRIVE
	CLA
	SDN		/WAIT FOR OVERALL DONE
	JMP	.-1	/WIGGLE AC TO SHOW LIFE ??
	AC7776		/SET AC TO STRIP WHICH PAIR BIT
	SER		/SKIP IF AN ERROR DURING FORMAT
	CLL		/CLEAR LINK TO SHOW NO ERROR
	AND	ROFN	/SET DONE FLAG
	TAD	(4014	/BY A DUMMY READ ERROR STATUS, FLIPS LINK!
	LCD
	SNL		/SKIP IF REFORMAT HAD NO ERROR
	JMP	ERR19	/ERROR DURING REFORMAT, FATAL
	TAD	OPTION	/WAS IT A REFORMAT ONLY?
	AND	(SINGLE+DOUBLE
	SNA CLA		/SKIP IF YES
	JMP	DO00	/NO, GO DO OTHER STUFF
	JMS	QUEST	/ASK IF ANOTHER FORMAT OPERATION WANTED
	MSG16
	JMP	EXITOK	/"N" RETURN
	JMP	REFORM	/"Y" RETURN
/
	PAGE
/
/
/  ACTION ROUTINE ENTRY POINT
/
/  WATCH IT! WE CALLED WITH CDF POINTING TO BUFFER
/  ALSO CDF IS PLACED IN BFIELD,
/  SO WE CAN DO NO INDIRECTS EXCEPT THRU AUTO INCR TO BUFFER !!
/
/  RETURN WITH SKIP IF OK, DIRECT RETURN WITH ERROR
/
/  RESTORES DF TO 10 ON EITHER EXIT
/
/  DO A SECTOR AT A TIME FOR A SINGLE FUNCTION
/
ACTION,	0
	AC7775		/-3 ERROR RETRY COUNT
	DCA	RETRY
	TAD	FN	/SORT FUNCTIONS
	SNA
	JMP	COMPAR	/GO DO COMPAR
	RTR		/READ/WRITE BIT TO LINK
	SZL CLA		/SKIP IF WRITE
	JMP	READLP	/GO TO READ
/
/  WRITE LOOP
/
WRITLP,	TAD	FN	/SET UP SILO OPERATION
	JMS	LDCMD
	JMP	WRIT1	/OTHER PAGE TO MOVE DATA TO SILO
WRIT2,	JMS	DOIO	/RETURN FROM OTHER PAGE TO ACCESS I/O
	JMP	REFILL	/COMMON EXIT
/
/  READ LOOP
/
READLP,	JMS	DOIO	/COME HERE TO RETRY I/O
	TAD	FN
	JMS	LDCMD
	TAD	COUNT2	/RX01, 32 PASSES THRU 4 BYTES MOVED
	DCA	RDCNT	/RX02, 64 PASSES THRU
ST5,	STR
	JMP	.-1
	XDR
	DCA I	X10
	STR
	JMP	.-1
	XDR
	DCA I	X10
	STR
	JMP	.-1
	XDR
	DCA I	X10
	STR
	JMP	.-1
	XDR
	DCA I	X10
	ISZ	RDCNT
	JMP	ST5
REFILL,	ISZ	ACTION	/OK EXIT, ALSO A LITERAL
ACTEND,	CDF	10	/DATA FIELD NORMAL AGAIN
	JMP I	ACTION
/
/  COMPAR
/
/  COMPARE THE TWO BUFFERS
/
COMPAR,	TAD	REFILL	/RESTORE ERROR FLAG TO 'OK'
	DCA	ZOT
	TAD	BFIELD	/CREATE OTHER FIELD POINTER
	TAD	COUNT6
	DCA	CFIELD
	TAD	COUNT3	/SET UP LOOP CONTROL
	DCA	COMCNT
BFIELD,	0		/CDF PLACED HERE
	TAD I	X10	/COMPARE
	CIA
CFIELD,	0		/CDF PLACED HERE
	TAD I	X11
	SZA CLA		/SKIP IF OK
	DCA	ZOT	/NOT OK, MAKE NON-SKIP RETURN!!!!
	ISZ	COMCNT	/THRU?
	JMP	BFIELD	/NO
ZOT,	0		/ISZ ACTION PLACED HERE
	JMP	ACTEND	/RESTORE FIELD, GO BACK
/
/
/  DO I/O FUNCTION FOR READ OR WRITE
/
DOIO,	0
	TAD	FN	/SILO FUNCTION, CONVERTED TO READ-WRITE
	TAD	(4	/CONVERT SILO OPERATION TO I/O OPERATION
	JMS	LDCMD
	TAD	SECTOR	/REQUESTED SECTOR TO HARDWARE
	TAD	(33	/STORED AS -32 TO -1
	STR
	JMP	.-1
	XDR
	CLA
	TAD	TRACK
	CMA		/COMPLEMENT TO PLUS NUMBER
	STR
	JMP	.-1
	XDR
	CLL CLA CMA RTL	/AC=-3 TO KILL READ-WRITE BIT
	AND	FN	/I/O SKELETON WITHOUT READ-WRITE BIT
	TAD	(16	/LOAD ERROR STATUS IS GOOD NO-OP
	JMS	LDCMD
	JMP I	DOIO
/
/  LOAD COMMAND REGISTER
/
RDCNT=.
LDCMD,	0
	DCA	CMDTMP	/SAVE THE COMMAND
	TAD	CMDTMP
	AND	(376	/DOUBLE, KEEP ONLY 8 BITS, SINGLE NEVER HAD THEM
	SDN		/SKIP ON DONE
	JMP	.-1
	LCD		/PUT THE COMMAND
	TAD	CMDTMP	/CHECKING TOP BIT FOR DOUBLE DRIVE
	SMA
	JMP	CDCK	/SINGLE, JUST GO CHECK ERROR
	RTL
	RTL
	RAL
	AND	(7	/TOP FOUR BITS NOW SENT
	STR
	JMP	.-1
	XDR
CDCK,	CLA
	SER		/SKIP ON ERROR
	JMP I	LDCMD
	ISZ	RETRY	/TRIED THREE TIMES YET
	JMP	KEEPON	/NO, KEEP ON TRYING
	TAD	FN	/DID WE ERROR OUT OF READ OR WRITE
	RTR		/READ-WRITE BIT TO LINK
	SNL CLA		/SKIP IF READ
	JMP	ACTEND	/WRITE IS ALL SET, GO TO ERROR RETURN
	TAD	COUNT3	/READ MUST ADD APPROPRIATE AMOUNT TO X10
	CIA		/SO LOOP CONTROL IN BUMPER WORKS RIGHT!
	TAD	X10	/
	DCA	X10
	JMP	ACTEND	/SET CDF BACK, AND ERROR EXIT
/
/  ENTRY TO CONTINUE AFTER ERROR
/
/
KEEPON,	TAD	FN	/RETRYING READ OR WRITE
	RTR		/R/W BIT TO LINK
	SZL CLA		/SKIP ON WRITE
	JMP	READLP	/RETRY A READ
	JMP	WRIT2	/SO GO RETRY WRITE
/
COUNT2,	0		/MINUS NUMBER OF READ PASSES PER SECTOR
COUNT3,	0		/MINUS NUMBER OF BYTES (WORDS AS WELL) PER SECTOR
COUNT6,	0		/DELTA FIELDS FOR COMPARE
TRACK,	0		/TRACK NUMBER IN COMPLEMENT FORM FOR ISZ
SECTOR,	0		/SECTOR TO DO, SET BY INTERLEAVE ROUTINE
FN,	0		/FUNCTION BITS: ALWAYS 100 FOR 8BIT MODE
/			/+4000 FOR DOUBLE DRIVE, +1 FOR SECOND PAIR
/			/NOTE, THE 1 IS STRIPPED PRIOR TO CALL TO ACTION
RETRY,	0		/RETRY COUNTER -3 TO 0
CMDTMP,
COMCNT,	0		/TEMPORARY FOR COMPARE OR I/O
/
	PAGE
/
/  PART OF ACTION ROUTINE
/
/  FILL SILO FOR WRITE
/
/  SPREAD OUT TO SPEED UP
/
/
/
WRIT1,	TAD	COUNT1	/FOR RX01, 8 TIMES THRU 16 BYTE GIVES 128
	DCA	WRTCNT	/FOR RX02, 16 TIMES THRU FOR 256
ST4,	TAD I	X10	/FETCH A BYTE
	STR		/SKIP IF READY TO TRANSFER
	JMP	.-1	/NO (SHOULDN'T HIT THIS ON VT78)
	XDR		/MOVE BYTE TO SILO
	CLA		/CLEAR THE MUMBLE AC
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	TAD I	X10
	STR
	JMP	.-1
	XDR
	CLA
	ISZ	WRTCNT	/THRU WITH SILO?
	JMP	ST4	/NO
	JMP	WRIT2	/REST OF LOOP ON OTHER PAGE
/
WRTCNT,	0		/CONTROL COUNT FOR FILL SILO LOOP
COUNT1,	0		/FILLED AT INIT TIME, WRITE PASSES PER SECTOR!
/
/
/  SELECT SUBROUTINE
/
/  CALL WITH AC11=0 TO SELECT FIRST PAIR, AC11=1 TO SELECT SECOND
/
/  RETURN AC.AND.7776
/
/  IF SELECT REQUESTED IS SAME AS LAST SELECT, NO ACTION TAKEN
/
SELECT,	0
	DCA	WRTCNT	/CONVENIENT TEMPORARY TO SAVE ARGUMENT
	TAD	WRTCNT
	TAD	LSTSEL	/IS IT SAME AS LAST TIME
	RAR		/TEST BIT TO LINK
	SNL CLA		/SKIP IF DIFFERENT
	JMP	NOSEL	/NO SELECT NEEDED
	ISZ	LSTSEL	/CHANGE TO OTHER TYPE
	NOP		/MAY INDEED SKIP
	CLA IAC
	AND	LSTSEL	/SELECT NEW TYPE
	6750		/SELECT IOT
	SER		/MUST CLEAR ERROR FLAG, MAY RANDOMLY SET
	NOP
	SDN		/SAME FOR DONE
	NOP
	STR		/AND TRANSFER
	NOP
	CLA
	TAD	(16	/DUMMY READ ERROR STATUS TO SET DONE FLAG!!
	LCD
NOSEL,	AC7776		/RETURN ARGUMENT WITH LOW BIT CLEARED
	AND	WRTCNT
	JMP I	SELECT
LSTSEL,	0		/START OFF ON FIRST PAIR
/
	PAGE

        FIELD   0
        *6420
/
/  PUT ERROR MESSAGES IN FIELD 0 RIGHT AFTER BUFFER
/
/ 
/ ERROR MESSAGES
/
VERBUF, "R; "X; "C; "O; "P; "Y; 240; "V; "4; "B; 240; 215; 212; 232
MSG2,   "I; "L; "L; "E; "G; "A; "L; 240; "S; "P; "E; "C; "I; "F; "I
        "C; "A; "T; "I; "O; "N; 215; 212; 232
MSG3,   "D; "E; "V; "I; "C; "E; 240; "I; "S; 240; "N; "O; "T; 240
        "R; "X; 215; 212; 232
MSG5,   "N; "O; 240; "I; "N; "P; "U; "T; 240; "D; "E; "V; "I; "C;
        "E; 215; 212; 232
MSG6,   "N; "O; 240; "O; "U; "T; "P; "U; "T; 240
        "D; "E; "V; "I; "C; "E; 215; 212; 232
MSG7,   "C; "O; "M; "P; "A; "R; "E; 240
        "E; "R; "R; "O; "R; 232
MSG8,   "I; "N; "P; "U; "T; 240; "D; "E; "V; "I; "C; "E; 240
        "R; "E; "A; "D; 240; "E; "R; "R; "O; "R; 232
MSG9,   "O; "U; "T; "P; "U; "T; 240; "D; "E; "V; "I; "C; "E; 240
        "R; "E; "A; "D; 240; "E; "R; "R; "O; "R; 232
MSG10,  "O; "U; "T; "P; "U; "T; 240; "D; "E; "V; "I; "C; "E; 240
        "W; "R; "I; "T; "E; 240; "E; "R; "R; "O; "R; 232
MSG11,  "I; "S; 240; "M; "O; "N; "I; "T; "O; "R; 240
        "R; "E; "M; "O; "U; "N; "T; "E; "D
        "?; 232
MSG12,  "R; "E; "A; "D; "Y; "?; 232
MSG13,  240; "H; "E; "A; "D; 
MSG13A, 0
        0
        ",
        240; "T; "R; "A; "C; "K; 240
MSG13B, 0
        0
        ",
        240; "S; "E; "C; "T; "O; "R; 240
MSG13C, 0
        0
        215; 212; 232
MSG15,  "I; "L; "L; "E; "G; "A; "L; 240; "F; "L; "O; "P; "P; "Y; 
        240; "T; "Y; "P; "E;
        215; 212; 232
MSG16,  "F; "O; "R; "M; "A; "T; 240; "A; "N; "O; "T; "H; "E; "R;
        240; "F; "L; "O; "P; "P; "Y; "?; 232
MSG17,  "I; "L; "L; "E; "G; "A; "L; 240; "S; "W; "I; "T; "C; "H;
        "(; "E; "S; "); 215; 212; 232
MSG18,  "F; "L; "O; "P; "P; "Y; 240; "N; "O; "T; 240; "R; "E; "A; "D; "Y;
        215; 212; 232
MSG19,  "E; "R; "R; "O; "R; 240; "D; "U; "R; "I; "N; "G; 240;
        "F; "O; "R; "M; "A; "T; 215; 212; 232
$

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RXNS.PA. 
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

/RX NON-SYSTEM HANDLER, GENERAL CONTROLLER TYPE
/FLOPPY DISK HANDLER FOR OS/8
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1978 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/DEFINITIONS OF RX8/E IOT'S

RXVER=	"N&77

DEVCOD=	750	/DEVICECODE

LCD=	6001+DEVCOD	/LOAD COMMAND REGISTER
XDR=	6002+DEVCOD	/TRANSFER DATA REGISTER
STR=	6003+DEVCOD	/SKIP ON TRANSFER REQUEST FLAG, CLEAR FLAG
SER=	6004+DEVCOD	/SKIP ON ERROR FLAG, CLEAR FLAG
SDN=	6005+DEVCOD	/SKIP ON DONE FLAG, CLEAR FLAG
INTR=	6006+DEVCOD	/INTERRUPT ENABLE/DISABLE
INIT=	6007+DEVCOD	/INITIALIZE CONTROLLER AND RECALIBRATE DRIVES


/NOTES ON THIS HANDLER:

/THIS HANDLER READS AND WRITES THE DISK IN "12-BIT" MODE, IN WHICH
/ONLY 6 BITS OF EVERY 8-BIT BYTE ARE USED. AN RX01 CARTRIDGE
/CONTAINS 494 OS/8 BLOCKS UNDER THIS METHOD

/TO MAXIMIZE SPEED ON THE DEVICE, THE HANDLER READS AND WRITES RX01 DATA
/ON A TRACK WITH A TWO-WAY INTERLEAVE - I.E. RECORDS 1-26 ON A TRACK
/ARE WRITTEN IN THE SEQUENCE:
/  1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26

/DOUBLE DENSITY MEDIA ARE WRITTEN IN A THREE WAY INTERLEAVE
/  1,4,7,10,13,16,19,22,25,2,5,8,11,14,17,20,23,26,3,6,9,12,15,18,21,24

/TRACK-SECTOR COMPUTATION IS DONE I/O TO/FROM THE SILO

AC4000=CLL CLA CML RAR		/SET AC TO 4000
AC7776=CLL CLA CMA RAL		/SET AC TO 7776
AC0002=CLL CLA CML RTL		/SET AC TO 0002
AC7775=CLL CLA CMA RTL		/SET AC TO 7775
/
/BUILD DATA
	*0
/
	-2		/TWO ENTRY POINTS
	DEVICE	RX02	/DEVICE GROUP NAME
	DEVICE	RXA0	/ENTRY POINT NAME
	4320		/CODE FOR MULTI-RX 	/CHANGED TO 32
	RXA0&177+4000	/ENTRY POINT OFFSET
	0
	0
	DEVICE	RX02	/DEVICE GROUP NAME
	DEVICE	RXA1	/ENTRY POINT NAME
	4320		/THIS IS CHANGED TO 32 FROM 27 AS IT WAS CASSETTE
	RXA1&177+4000	/ENTRY POINT OFFSET
	0
	0
	*200
/
/
/  INIT CODE
/
POINT,	HLT		/ADDR OF SECOND PAGE AT INIT TIME
UNIT,	JMS I	POINT	/GO TO SECOND PAGE TO INIT
/
/  LIST OF VECTORS TO SECOND PAGE
/
LQUO,	QUO-.		/LQUO MUST LEAD OFF LIST
LRETRY,	RETRY-.
LREC,	REC-.
LSIZE,	SIZE-.
LREMD,	REMD-.
LFN,	FN-.
LDENSW,	DENSW-.
LENTRY,	ENTRY-.
VCOUNT=LQUO-.		/FALLS THRU TO WHICH, HERE IS VECTOR COUNT
/
/  COME HERE FROM ZOO
/
/  PROCESS ENTRY POINT, DEVICE TYPE
/
WHICH,	AC7775		/SET RETRY COUNTER
	DCA I	LRETRY
	TAD I	ZOO	/GET UNIT NUMBER*20+402
	DCA	UNIT	/HOLD FOR LATER
	ISZ	ZOO	/MOVE TO TYPE CODE
	TAD I	ZOO	/HAS THIS DRIVE BEED INIT'ED
L7700,	SMA CLA		/SKIP IF NO
	JMP	NORMAL	/GO TO NORMAL PATH
RSTART,	TAD	UNIT	/PICK UP UNIT BIT, DOUBLE DENSITY +2
	TAD	L10	/MAKE A READ STATUS CODE
	SDN
	JMP	.-1
	LCD
	SDN
	JMP	.-1
	JMP	BOUNCE	/HOP OVER ENTRY POINT
/
/
	IFZERO	.&177-33&4000	<_ERROR_>
/
/  ENTRY POINTS ARE AT 32, 36
/
	*.&7600+32
/
RXA0,	0
	JMS	ZOO	/COMMON ENTRY ROUTINE
	402		/UNIT 0, 402 FOR CONVENIENCE
	-1		/MINUS SAYS STILL HAVE TO INIT IT;
/			/SINGLE=0, DOUBLE=20, QUAD=22
RXA1,	0
	JMS	ZOO
L422,	422		/20 SAYS UNIT 1, 402 FOR CONVENIENCE
DOOR,	JMP	WHICH	/INIT TIME LITERAL (MUST BE MINUS)
/			/GETS SAME TYPE CODE AS OTHER ENTRY POINT
/
/  REST OF SET UP CODE
/
BOUNCE,	XDR		/GET STATUS WORD
	AND	L32	/KEEP DENSITY ERROR; DOUBLE; QUAD
	TAD	L10	/SINGLE=10;SING/DOUB=40;DOUB=20;QUAD=22
	AND	L422	/SINGLE=0;SING/DOUB=0;DOUB=20;QUAD=22
	DCA I	ZOO	/PLACE TYPE CODE
	SER		/CLEAR ERROR FLAG
L10,	10		/MAY SKIP
	TAD	L416	/SET DONE FLAG AGAIN
	LCD
NORMAL,	TAD I	ZOO	/FETCH BACK TYPE CODE
	SZA CLA		/SKIP IF A SINGLE DENSITY
	TAD	L7700	/DOUBLE
	TAD	L7700	/SINGLE=7700, DOUBLE=7600
	DCA I	LDENSW	/PLACE FOR LOOP CONTROL
	TAD I	ZOO
	CLL RTR		/PUT QUAD BIT TO LINK
	SNA CLA		/SKIP IF DOUBLE OR QUAD
	TAD	L1734	/SINGLE
	TAD	L4110	/D&Q=4110, S=6044
	SNL		/SKIP ON QUAD, IT'S OK RIGHT NOW
	CLL CML RAR	/SINGLE AND DOUBLE DIVIDE BY 2
	DCA I	LSIZE	/S=7022, D=6044, Q=4110
	TAD I	LDENSW	/7700 IF SINGLE, 7600 IF DOUBLE
	CLL CMA RTL	/375 IF SINGLE, 775 IF DOUBLE
	AND	UNIT	/VOILA, 400*DOUBLE  +  20*UNIT
	DCA I	LFN	/PLACE INTO FUNCTION CONTROL WORD
	AC7775		/BACK UP ZOO TO FETCH CALLING ADDR
	TAD	ZOO
	DCA	T1	/HOLD TEMPORARY
	TAD I	T1	/HERE IS CALLING ADDR
CLLFLD,	HLT		/PUT CDF TO CALLING FIELD HERE
	JMS I	LENTRY	/GO TO SECOND PAGE, LEAVING POINTER TO DIVSUB
/
/  DIVSUB SUBROUTINE !!MUST!! FOLLOW IMMEDIATELY
/
/
/  DIVSUB
/
/  CALL TO SET UP TRACK, SECTOR, FROM OVERALL SECTOR #
/  ALSO, SET UNIT WITH HEAD COMMAND IF WE ARE ON TO SECOND SIDE
/
/  CALL WITH AC <0 IF IT IS REALLY AN ERROR RETRY
/  CALL WITH AC >=0 IF CALL TO DIVSUB
/
DIVSUB,	0
	CDF	0	/AND DATA FIELD MUST BE TO HERE
	SPA CLA		/SKIP IF REALLY A DIVIDE REQUEST
	JMP	RSTART	/NO, IT WAS AN ERROR RETRY!!
	DCA I	LQUO	/CLEAR DIVIDE QUOTIENT
	TAD I	ZOO	/IS IT A TWO HEADER
	RTR		/PUT QUAD BIT TO LINK
	SNL CLA		/SKIP IF YES
	JMP	SHUNT	/NO, GO DO DIVIDE
	TAD I	LREC	/WHICH RECORD ARE WE WORKING ON
	TAD	LM3670	/NUMBER OF SECTORS ON FIRST SIDE
	SZL CLA		/SKIP IF SECOND SIDED IT
	JMP	SHUNT	/NO, JUST REGULAR
	TAD I	LFN	/FORCE HEAD BIT ON
	AND	L422	/KEEP DOUBLE, UNIT, READ-WRITE
	TAD	L1000	/ADD IN SECOND SIDE
	DCA I	LFN
	TAD	LM3670	/BUT DECREASE RECORD NUMBER
SHUNT,	TAD I	LREC	/THIS FOR TRACK-SECTOR
DIVLOO,	ISZ I	LQUO	/MAIN DIIVIDIE LOOP
	TAD	LM32	/DIVIDE BY 26 TO GET TRACK
	SMA		/SKIP IF DONE
	JMP	DIVLOO
	TAD	L32	/REMAINDER 0-25
	DCA	T1	/HOLD IT IN TEMPORARY
	TAD I	ZOO	/SINGLE DENSITY
	SZA CLA		/SKIP IF YES
	TAD 	T1	/MULTIPLY BY THREE FOR DOUBLE
	TAD 	T1	/AND BY TWO FOR SINGLE
	TAD 	T1
	CLL IAC		/LINK CLEAR FOR FINAL TEST; +1 TO START AT 1 NOT 0
	TAD	LM32	/DIVIDE BY 26 TO GET SECTOR
	SMA SZA		/SKIP IF DONE
	JMP	.-2
	TAD	L32	/RESTORE POSITIVE VALUE TO BE SECTOR
	DCA I	LREMD	/WHEW, BUT WATCH IT, A FINAL CORRECTION COMING!
	RAL		/IF LINK=0 AND SINGLE: 2,4,6,8,10,12,14,16... SERIES
	TAD I	ZOO	/BUT WE HAVE 1,3,5,7,9,11,13,15... SO WE MUST INCREMENT!
	SNA CLA		/SKIP IF SOME OTHER CASE
	ISZ I	LREMD	/NOW HAVE IT 2,4,6,8,10,12,14,16...
	JMP I	DIVSUB	/OUT
/
/
L416,	416	/SOME LITERALS
L1000,	1000
L32,	32
LM32,	-32
L1734,	1734
L4110,
LM3670,	-3670
/
/
/
	*.&7600+167	/FORCE TO END OF PAGE
/  ZOO  SUBROUTINE
/
/  TO SET UP ENTRY POINT PROCESSING, AND INIT CODE
/
ZOO,	0		/ADDR OF 'HIT' ENTRY POINT +2 COMES HERE
	CLA		/FOR SAFETY
	RDF		/SAVE CALLERS FIELD SETTING
	TAD	LCDF0	/ADD IN CDF 0
	DCA	CLLFLD	/RESET WHEN GOING TO I/O SUB
LCDF0,	CDF 0		/DATA FIELD HERE FOR INDIRECTS
CLOSE,	TAD	DOOR	/CLOSE DOOR TO ONCE ONLY CODE (JMP WHICH
T1,	DCA	CLOSE	/USE ONCE-ONLY FOR TEMPORARY LOCATION
	JMS	POINT	/LEAVE ADDR OF SECOND PAGE
/
/
/  VARIABLES, ALSO INIT CODE LIVES HERE
/
/
BUF,	0		/POINTER TO CALLER'S BUFFER
RETRY,	0		/RETRY COUNT
SIZE,	0		/SIZE OF DEVICE
SYS,	0		/POINTER TO CALL
QUO,	0		/DIVIDE QUOTIENT, WHICH IS TRACK NUMBER
REC,	0		/SECTOR NUMBER OF FLOPPY
BC,	0		/CONTROL COUNT, WORDS TO TRANSFER
FN,	0		/0 FOR WRITE; 2 FOR READ; HEAD, DENSITY, UNIT
DENSW,	0		/7700 IF SINGLE DENSITY, 7600 IF DOUBLE DENSITY
ENTRY,	0		/ENTRY POINT, LEAVE ADDR OF DIVSUB HERE
/
	IFNZRO	.&177-10&4000	<_ERROR>	/ENOUGH ROOM FOR INIT?
/
	*.&7600
/
/  INIT TIME:  FILL VECTOR TABLE
/
THERE,	0		/FILLED BY JMS, POINTS TO VECTOR
ILOOP,	TAD	THERE	/POINTER IS ALSO OFFSET!
	TAD I	THERE	/MAKING VECTOR
	DCA I	THERE
	ISZ	THERE	/MOVE TO NEXT VECTOR
	ISZ	LDCMD	/CONTROL COUNT ON THIS PAGE
	JMP	ILOOP
	JMP I	THERE	/BACK TO FIRST PAGE
/
/  IO SUBROUTINE
/
/  ENTRY POINT AT END OF LAST LISTING PAGE
/
/
	*ENTRY+1	/RESUME RUNTIME CODE
/
	DCA	SYS	/POINTER TO ARG'S, EXIT
	RDF		/DATA FIELD OF USER CALL
	TAD	(CDF CIF 0	/MAKE CDF CIF TO CALLER'S FIELD
	DCA	EXFLD	/SET UP FOR CALL
	AC4000		/SET LINK=0, AC=4000
	TAD I	SYS	/CARRY READ-WRITE BIT TO LINK
	AND	(70	/KEEP FIELD FOR BUFFER
	TAD	LLCDF0	/MAKE CDF TO BUFFER FIELD
	DCA	BUFCDF	/PLACE INTO I/O LOOP
	CML RTL		/MAKE FUNCTION CODE, 0=WRITE, 2=READ
	TAD	FN	/START-UP CODE HAS SET HEAD, DENSITY, UNIT ETC.
	DCA	FN
	TAD I	SYS	/MAKE LOOP CONTROL COUNT
	RAL
	AND	L7600
	CIA		/0 FOR WHOLE FIELD
	DCA	BC	/MINUS TOTAL NUMBER OF WORDS
	ISZ	SYS	/NEXT
	TAD I	SYS	/IS BUFFER ADDRESS
	DCA	BUF
	ISZ	SYS	/NEXT
	TAD	(175	/CARRY WITH DENSW IF SINGLE DENSITY
	TAD	DENSW	/BLOCK # TO SECTOR #
	SMA CLA		/SKIP IF DOUBLE, MULTIPLY BY 2
	TAD I	SYS	/SINGLE, MULTIPLY BY FOUR
	SMA		/NEGATIVE BLOCK # ERROR, FORCE LINK TO BE ON
	TAD I	SYS
	ISZ	SYS	/MOVE POINTER TO ERROR EXIT
	CLL RAL
	DCA	REC	/SAVE SECTOR NUMBER
	SZL		/SKIP IF LEGAL BLOCK #
	JMP	ERREX	/FORCE DISK SIZE TO BE SET UP BEFORE EXIT!
	JMS I	ENTRY	/CALL DIVISION SUBROUTINE OTHER PAGE
	TAD	FN	/SPLIT READ AND WRITE
	RTR		/READ-WRITE BIT TO LINK
	SZL CLA		/WRITE SKIPS
	JMP	STREAD	/READ GOES TO START IN MIDDLE OF LOOP
/			/WRITE FALLS THRU TO NEXT LISTING PAGE
/WRITE FALLS THRU TO THIS LOOP
/
/  TOP OF MAIN LOOP
/
TOP,	TAD	FN	/SET SILO TO LOAD-UNLOAD
	JMS	LDCMD	/COMMAND TO CONTROLLER
	TAD	DENSW	/MAKE SILO LOOP COUNT, S=7700, D=7600
	DCA	FLPWC	/LDCMD ENTRY SAFE TEMPORARY
BUFCDF,	HLT		/CDF TO BUFFER FIELD PLACED HERE
TRLOOP,	TAD I	BUF	/IN CASE WRITE, FETCH A WORD
	STR		/SKIP IF READY TO PASS DATA
	JMP	.-1	/NO
	XDR		/TO OR FROM AC
	DCA I	BUF	/PLACE WORD FOR READ, WRITE REPLACES SAME
	ISZ	BUF	/MOVE BUFFER POINTER, (MAY SKIP)
REMD,	0		/DIVIDE REMAINDER, WHICH IS SECTOR NUMBER
	ISZ	FLPWC	/DONE YET
	JMP	TRLOOP
	TAD	DENSW	/ADDING 77 (SINGLE) 177 (DOUBLE)
	CMA		/ONCE WE CMA, THAT IS
	TAD	BC	/LOOP CONTROL TO FINISH READ
	SNA
	JMP	OKEX	/OK, DONE
	DCA	BC	/REPLACE AND KEEP GOING
/
/  MIDDLE OF MAIN LOOP
/
STREAD,	TAD	FN	/READ STARTS HERE
	TAD	(4	/TURN SILO COMMAND INTO READ-WRITE COMMAND
	JMS	LDCMD	/I/O COMMAND TO CONTROLLER
	TAD	REMD	/PRECOMPUTED SECTOR #
	STR
	JMP	.-1
	XDR
L7600,	7600		/CLEAR AC, AND IS LITERAL
	TAD	QUO	/TRACK #
	STR
	JMP	.-1
	XDR		/TRACK # IS ALWAYS NON0 !!
	ISZ	REC	/MOVE TO NEXT RECORD NUMBER
	JMS I	ENTRY	/DO TRACK SECTOR FOR NEXT OPERATION
	TAD	(16	/WAIT FOR OPERATION TO COMPLETE
	JMS	LDCMD
	ISZ	BC	/CHECK FOR WRITE EXIT
	JMP	TOP	/STILL MORE
OKEX,	ISZ	SYS	/KICK TO OK EXIT
EXFLD,	HLT		/CDF CIF TO CALLER
	JMP I	SYS	/OUT
/
/
/  LDCMD  SUBROUTINE
/
/  CHECK FOR CONTROL C, LOAD A COMMAND
/
FLPWC=.                 /ENTRY POINT A TEMPORARY
LDCMD,  VCOUNT          /INIT COUNTER
        DCA     TRANS   /SAVE COMMAND
LLCDF0, CDF     0       /DATA FIELD HERE IN CASE CONTROL C TO MONITOR
TSTTT,  KSF             /SKIP IF A TTY CHARACTER HAS HAPPENED
        JMP     TSTSD   /NOPE, GO CHECK RX CONTROLLER READY
        TAD     L7600   /FORCE TOP BITS TO BE 1 TO ELIMINATE 3,203
        KRS             /AMBIGUITY ON TEST
        TAD     (175    /IS IT A CONTROL C
        SNA CLA         /SKIP IF NOT
        JMP I   L7600   /EXIT TO MONITOR
TSTSD,  SDN             /IS RX CONTROLLER READY
        JMP     TSTTT   /NOPE, GO CHECK TTY
        TAD     TRANS   /GET BACK COMMAND
        LCD             /TO CONTROLLER
        SER             /SKIP IF AN ERROR
        JMP I   LDCMD
        AC4000          /AC CODE FOR EXIT, ALSO TO TELL DIVSUB WE'RE A RETRY!
        SKP
ERREX,  TAD     SIZE    /BLOCK TOO LARGE ENTRY, SET AC CODE
        ISZ     RETRY   /TRY THREE TIMES?
        JMS I   ENTRY   /NO, AC ZERO SAYS RETRY NOT DIVIDE!!
        JMP     EXFLD   /BACK TO CALLER
/
TRANS,  0               /TEMPORARY FOR LDCMD TO SAVE COMMAND
/
        PAGE
/

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RXSY1.PA. 
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

/RX01 (RX02) SYSTEM HANDLER
/
/  THIS HANDLER WAS DESIGNED TO WORK WITH RX01, RX02, RX03
/
/  HOWEVER, ONE SINGLE BINARY CANNOT SUCCESSFULLY BE USED IN A
/  VIRGIN BUILD FOR ALL THREE DEVICES. IT IS CURRENTLY SET UP
/  TO BUILD AN RX02.
/  TO GENERATE A BINARY TO BUILD AN RX01, CHANGE THE RXTYP
/  EQUATE TO 1. FOR AN RX03 BUILD, CHANGE RXTYP TO 3.
/
RXTYP=1			/THIS IS THE SINGLE DENSITY TWO PAGE HANDLER
/
/
/
VERSION="M&77
/
/
AC1=CLL CLA IAC
AC2=CLL CLA CML RTL
AC6=CLL CLA CML IAC RTL		/RX02'S MUST RUN ON AN OMNI-BUS !!
AC4000=CLL CLA CML RAR
AC3777=CLL CLA CMA RAR
AC7775=CLL CLA CMA RTL
/
/  DEVICE IOT SYMBOLIC EQUATES
/
LCD=6751		/LOAD COMMAND
XDR=6752		/TRANSFER DATA
STR=6753		/SKIP IF READY TO TRANSFER
SER=6754		/SKIP ON ERROR
SDN=6755		/SKIP ON DONE
/
/  HEADER BLOCK FOR BUILD
/
	*0
	-1		/ONE ENTRY
	DEVICE	RX8E
	DEVICE	SYS
	4320		/MULTI-TYPE RX HANDLER ----- CHANGED FROM 4270
	SYS&177+6000	/TWO PAGE HANDLER
	0		/UNUSED
	IFZERO	RXTYP-1	<756>	/SIZE FOR BUILD
	IFZERO	RXTYP-2	<1734>
	IFZERO	RXTYP-3	<3670>
/
	STBOOT-NDBOOT+12	/-SIZE (+12 FOR GAP)
/
/  HERE IS A LISTING OF THE PRIMARY BOOT FOR CONVENIENCE
/
	NOPUNCH
/
	*20
/
READ,	TAD	UNIT	/TRY NEXT COMBINATION OF DENSITY AND UNIT
	TAD	CON360	/ADDING IN 360
	AND	CON420	/KEEPING ONLY 420 BITS
	DCA	UNIT	/CYCLES 400,420,0,20,400,,,,,,,,
	AC6		/COMMAND TO READ DISK
	TAD	UNIT	/UNIT AND DENSITY
	LCD		/COMMAND TO CONTROLLER
	AC1		/TO SET SECTOR AND TRACK TO 1
	JMS	LOAD	/SECTOR TO CONTROLLER, LEAVES AC ALONE
	JMS	LOAD	/AND TRACK
LITRAL,	7004		/LEAVING A 2 IN AC; SERVES AS LITERAL
/
/  FOLLOWING IS PART OF WAIT LOOP, SAME SECONDARY BOOTS, OLD PRIMARY BOOT
/
START,	SDN		/HAS DONE COME UP; CODE STARTS HERE!
	JMP	LOAD+1	/NO, GO CHECK FOR READY TO TRANSFER
/
/  NOW, DONE OR ERROR
/
	SER		/SKIP ON AN ERROR, TRY ANOTHER DENSITY ETC.
	SNA		/NASTY, AC=2 FOR ABOUT TO DO SILO, 0 ON START-UP
	JMP	READ	/START-UP, GO SET UP UNIT, THEN READ TO SILO
	TAD	UNIT	/AC ALREADY 2, PUT IN UNIT, DENSITY
	LCD		/TO EMPTY THE SILO
	TAD	UNIT	/SET UP LOC 60 FOR OLD SECONDARY BOOT
	AND	CON360	/KEEPING UNLY DENSITY BIT
	TAD	LITRAL	/ADDING IN 7004, BECAUSE THAT'S WHAT SYS WANTS
	DCA	RX1SAV	/OLD SECONDARY BOOT MOVES IT TO HANDLER
CON360,	360		/LITERAL; EXECUTES IN LINE AS A NO-OP
/			/FALLS THRU TO NEXT PAGE OF LISTING
/
/
/  FOLLOWING CODE SAME AS OLD PRIMARY BOOT
/
	JMS	LOAD	/GRAB NEXT ITEM FROM SILO
	DCA	2	/TRADITION; SECONDARY BOOT STARTS LOADING AT 2 !
	ISZ	50	/INCREMENT LOAD ADDRESS
	JMP	47	/GO BACK FOR ANOTHER
/
/  SECONDARY BOOT LOADS OVER PRIMARY BOOT UNIT LOCATION 47 IS LOADED,
/  THEN CONTROL PASSES TO SECONDARY BOOT
/
LOAD,	0		/SUBROUTINE TO GIVE AND TAKE DATA FROM CONTROLLER
	STR		/IS HE READY TO TALK TO US?
	JMP	START	/NO, IS HE PERHAPS DONE WITH SILO, OR IN ERROR?
	XDR		/YES, DATA IN OR OUT;IF DATA TO CONTROLLER, AC UNCHANGED
	JMP I	LOAD	/NO MAGIC, JUST EXIT FROM SUBROUTINE
/
/  60 GOES TO OLD SECONDARY BOOT
/  61 HAS DENSITY AND UNIT THAT BOOTED SUCCESSFULLY
/
/
CON420,			/USE IT TO HOLD 420 LITERAL TO START OUT
RX1SAV,	420		/UNIT^20+7004 TO GO TO SYS HANDLER
UNIT,	20		/<DENSITY^400>+<UNIT^20> THAT BOOTED OK
/
	ENPUNCH
/
/	##  SECONDARY BOOT  ##
/
	RELOC	2	/SECTION LOADING OVER PRIMARY BOOT 2 - 47
/
STBOOT=.
/
/  ONCE-ONLY CODE AFTER FIRST SECTOR IS TRANSFERED
/
ONCE,	TAD	XR	/SINGLE=113, DOUBLE=213
	CLL RAR		/SINGLE=45, DOUBLE=105
	TAD	YR	/SETTING UP POINTER TO SECTOR, TRACK, FIELD, ADDR DATA
	DCA	YR	/DAT01-1 OR DAT02-1
	TAD I	YR	/GETTING SINGLE=774, DOUBLE=1374 (IN CASE OLD
	TAD	RX1SAV	/ADD IN 20^UNIT+7004		  PRIMARY BOOT)
	DCA	UNIT	/PUT INTO 61: <DENSITY^400>+<UNIT^20>
	JMS	NEXSEC	/DESTROY LINKAGE TO ONCE ONLY CODE!
XTRA,	0		/EXTRA TO MAKE ALL FIT
/
/
/  AUTO INCREMENT REGISTERS
/
XR,	61		/CONTINUE TO LOAD FIRST SECTOR AT 62
YR,	DAT01-45-1	/SET UP POINTER TO DATA AREA
/
/  SECTOR DONE, SET UP FOR NEXT
/
NEXSEC,	JMP	ONCE	/END OF FIRST SECTOR, DO SET-UP CODE
	CDF	0	/DATA FIELD HERE TO USE AUTO INCR REGISTERS
	TAD I	YR	/GET DATA FIELD FOR PLACEMENT OF NEXT SECTOR
	SMA		/SKIP IF MORE TO DO
	JMP	EBOOT	/END OF BOOT, 
	DCA	XFIELD	/PLACE IN LINE TO SET DATA FIELD
	AC6		/GET AC OF 6 TO SET UP FLOPPY READ
	TAD	UNIT	/DENSITY AND UNIT NUMBER
	LCD
	TAD I	YR	/SECTOR FOR NEXT READ
	JMS	LOAD	/LOAD LEAVES AC ALONE
	TAD I	YR	/TRACK-SECTOR FOR NEXT READ
	JMS	LOAD	/LOAD REMAINS FROM PRIMARY BOOT
	TAD I	YR	/ADDRESS-TRACK-1 FOR NEXT READ
/			/FALL TO HANGGG WITH AC NON0 TO SHOW READ
/
/  FOLLOWING TWO LOCATIONS MUST MATCH PRIMARY BOOT
/
HANGGG,	SDN		/SKIP IF DONE
	JMP	LOAD+1	/NO, GO CHECK FOR TRANSFER READY
/
/  SORT OUT ERROR, SILO DONE, READ DONE
/
	SER		/SKIP IF ERROR
	SKP		/IS GOOD, CHECK WHETHER READ OR SILO
	HLT		/ANY ERROR IS FATAL!!
	SNA		/SKIP IF READY TO SILO (AC HAS LOAD ADDR)
	JMP	NEXSEC	/DONE WITH SILO (AC=0) GO TO NEXT SECTOR
	DCA	XR	/USE AUTO-INCR TO LOAD CORE
	JMP	OVRFLW	/GO TO LOCATIONS NOT FITTING UNDER 47
/
/  CODE TO EMPTY THE SILO TO CORE
/
XFIELD,	CDF	0	/FIELD FOR TRANSFER PLACED HERE
	JMS	LOAD	/LOAD REMAINS FROM PRIMARY BOOT
	DCA I	XR	/PLACE NEXT WORD
	JMP	XFIELD	/WHEN THIS LOCATION IS PLACED, SECONDARY BOOT
/			/TAKES CONTROL, CONTINUE FIRST SECTOR AT 62
/
/  PRIMARY BOOT LOCATIONS 50-61 REMAIN INTACT
/
STATUS=.		/REUSE FOR TEMPORARY
/
/	##  REST OF SECONDARY BOOT  ##
/
	RELOC	62	/SECTION LOADING 62 - 213
/
/  LOCATIONS NOT FITTING WITHIN 2-47 SPACE
/
OVRFLW,	XDR		/FETCH READ STATUS FOR LATER
	DCA	STATUS	/TO FIGURE OUT IF A DOUBLE SIDED FLOPPY
	AC2		/CODE FOR SILO OPERATION
	TAD	UNIT	/UNIT AND DENSITY
	LCD		/SET TO EMPTY SILO
	JMP	XFIELD	/GO TO SILO UNLOADING LOOP
/
/
/
/  SINGLE DENSITY LOADING DATA
/
DAT01,	774		/CANCEL OUT 7004 WHEN ADDED TO 70X4
	CDF	0	/2ND SECTOR FOR SINGLE DENSITY, FIELD 0
	3		/SECTOR 3, INTERLEAVED AT 2
	1-3		/TRACK 1  (MINUS SECTOR 3)
	114-1-1		/2 THRU 47 + 62 THRU 113 FOR FIRST SECTOR
/			/-1 FOR TRACK, -1 FOR AUTO INCR
	CDF	0	/3RD SECTOR TO 7600 FIELD 0
	5
	1-5
	7600-1-1
	CDF	0	/4TH SECTOR, SECOND HALF OF PAGE
	7
	1-7
	7700-1-1
	CDF	10	/5TH SECTOR, TOP OF FIELD 1
	21		/SECTOR 21
	11-21		/OF TRACK 11
	7600-11-1	/TO 7600
	CDF	10	/6TH SECTOR, REST OF FIELD 1
	23
	11-23
	7700-11-1
	CDF	20	/7TH SECTOR, TOP OF FIELD 2
	25
	11-25
	7600-11-1
	CDF	20	/10TH SECTOR, REST OF FIELD 2
	27
	11-27
	7700-11-1
	16		/MARKER AND LITERALS TO MAKE DAT02=DAT01+40
MAGIC,	7623		/THIS WORD IN HANDLER HAS DENSITY, UNIT WORD
L7605,	7605		/STARTING ADDR FOR HANDLER
/
/  DOUBLE DENSITY LOADING DATA
/
DAT02,	1374		/MAKE 400+UNIT WHEN ADDED TO 70X4
	CDF	0	/2ND SECTOR TO 7600
	4		/INTERLEAVE OF 3
	1-4
	7600-1-1
	CDF	10
	15
	5-15
	7600-5-1
	CDF	20	/3RD SECTOR TO 7600 OF FIELD 2
	20		/SECOND HALF OF BLOCK 66 OCTAL
	5-20		/ON TRACK 5
	7600-5-1
	16		/MARKER TO STOP WHOLE THING, ALSO LITERAL 16
/
/  I/O DONE, GO TO HANDLER
/
EBOOT,	TAD	UNIT	/ENTER WITH AC=16
	LCD		/SET DONE FLAG FOR HANDLER
	TAD	STATUS	/FIND OUT IF DOUBLE SIDED DISK
	RTR		/DOUBLE SIDED BIT TO LINK
	CLA RAR		/DOUBLE SIDED BIT TO AC0
	TAD	UNIT	/REST OF CONTROL WORD
	DCA I	MAGIC	/TO 7623 OF SYSTEM HANDLER
	JMP I	L7605	/TO START UP SYSTEM
/
NDBOOT=.
/
/  CODE THAT IS LOCATION SPECIFIC HAS !! IN COMMENTS
/
/	##  CODE FOR SYSTEM HANDLER  ##
/
	RELOC
	*200
	RELOC	7600
/
/			/USE DATA BREAKS FOR TEMPORARIES
/
QUO=7750		/QUOTIENT FOR DIVIDE == TRACK
REMD=7751		/REMAINDER FOR DIVIDE == SECTOR
REC=7752		/CURRENT LOGICAL SECTOR NUMBER
RETRY=7753		/RETRIES COUNT
/
	ZBLOCK	7	/REQUIRED BY BUILD
/
/
/  ENTRY POINT
/
SYS,	VERSION
L32,	32		/FALL THRU SOME LITERALS
L1734,	1734		/WHICH MAY PUT STRAY STUFF IN AC
	3		/!!REQUIRED AT 7612!! TO SHOW OS8 TWO PAGE HANDLER
	AC7775		/SET UP RETRY COUNTER
	DCA	RETRY	/RETRIES ARE OVER ENTIRE OPERATION
	RDF		/GRAB CALLER'S FIELD
	TAD	LLCDF0	/MAKE CDF TO IT
	DCA	RESTOR	/PUT IT BACK, GOING TO I/O ROUTINE ON PAGE 2
IOTYP,	JMP	FIRST	/GO TO ONCE ONLY CODE, LATER USED AS VARIABLE
/			/HAS HEAD, DENSITY, UNIT FOR I/O REQUEST
	JMP	RSTART	/GO CALL SECOND PAGE, IOTYP FALLS THRU TO HERE
/
/  LITERALS ETC.
/
L5000,	5000		/
BOOTYP,			/!!MUST BE AT 7623!! SECONDARY BOOT PUTS AT BOOT TIME
/			/4000 IF QUAD, 400 IF DOUBLE, AND 20 IF UNIT 1
	IFZERO	RXTYP-1	<0>	/INITIAL VALUE MATCHES DEVICE TO ALLOW
	IFZERO	RXTYP-2	<400>	/BUILD ONTO VIRGIN MEDIA
	IFZERO	RXTYP-3	<4400>	/OTHERWISE, SECONDARY BOOT PUTS IN RIGHT STUFF
LDENSW,	DENSW		/LOCATION ON SECOND PAGE
L4110,
LM3670,	4110		/VALUE WITH TWO USES
LM32,	-32
LLCDF0,	CDF	0
/
/  ONCE ONLY CODE
/
FIRST,	JMP	MORE	/LEAVING ADDITIONAL ONCE-ONLY SPACE
/
/  FIX CDF TO 7642
/
	*7642		/!!CDF OR CIF MUST BE AT 7642!!
MORE,	CDF	20	/POINT TO OUR SECOND PAGE
	TAD	BOOTYP	/PICK UP BOOT WORD
SNGDBL,	CLL RAL		/MAKE A WORD MINUS IF DOUBLE (OR QUAD) BOOTED
SIZE,	RTL		/REUSE FOR CONSTANTS
	DCA	SNGDBL	/JUST FOR CONVENIENCE, THE BIT IS IN BOOTYP ANYHOW
	TAD	QL3400	/ANY LITERAL IN RANGE 3400-3757 (LINK=0 HERE)
	TAD	BOOTYP	/FIGURE OUT SIZE OF MEDIA
	SMA SNL CLA	/SKIP IF DOUBLE OR QUAD
	TAD	L1734	/SINGLE
	TAD	L4110	/S=6044, D&Q=4110
	SNL		/SKIP IF QUAD, ITS SIZE ALREADY THERE
	CLL CML RAR	/OTHER TWO CASES DIVIDE BY TWO
	DCA	SIZE	/STORE S=7022, D=6044, Q=4110
	TAD	SNGDBL	/MAKE DENSW, 7600 IF DOUBLE, 7700 IF SINGLE
	SPA CLA		/SKIP IF SINGLE
	TAD	L7700
	TAD	L7700
QL3400,	DCA I	LDENSW	/MUST LIVE ON SECOND PAGE
/
/  END OF ONCE-ONLY, (RE)START I/O OPERATION
/
RSTART,			/AC MAY HAVE JUNK COMING IN!!
	AC3777		/MAKE A WORD WITH DENSITY AND UNIT BITS ONLY
	AND	BOOTYP	/FOR CONTRUCTING LCD ARGUMENTS
	DCA	IOTYP	/ALSO SHUTS OFF PATH TO ONCE-ONLY CODE!
	TAD	SYS	/AC HAS THE CALL ADDR
RESTOR,	HLT		/SET DATA FIELD TO THAT OF CALLER
	CIF	20
	JMP	PAGE2
/
/
/  CALL WITH AC NON0 TO DO DIVIDE
/  CALL WITH AC ZERO TO DO I/O RETRY (WHOLE OPERATION)
/
DIVSUB,	0
	SNA CLA		/SKIP IF REALLY A DIVIDE REQUEST
	JMP	RSTART	/NO, IT WAS AN ERROR RETRY!!
	DCA	QUO	/CLEAR DIVIDE QUOTIENT
	TAD	BOOTYP	/IS IT A TWO HEADER
	SKP		/!!FAULTY USR CALL DOES JMS HERE (7700)
	HLT		/HALT OUT SUCH AN OCCURRENCE!!
L7700,	SMA CLA		/SKIP IF YES
	JMP	SHUNT	/NO, GO DO DIVIDE
	CLL		/TO CHECK 12 BIT SIZE
	TAD	REC	/WHICH RECORD ARE WE WORKING ON
	TAD	LM3670	/NUMBER OF SECTORS ON FIRST SIDE
	SNL CLA		/SKIP IF SECOND SIDED IT
	JMP	SHUNT	/NO, JUST REGULAR
	TAD	BOOTYP	/MAKE IO FUNCTION WORD WITH SECOND HEAD BIT
	TAD	L5000	/CONVERTS TO 20^UNIT +1400
	DCA	IOTYP
	TAD	LM3670	/BUT DECREASE RECORD NUMBER
SHUNT,	TAD	REC	/THIS FOR TRACK-SECTOR
DIVLOO,	ISZ	QUO	/MAIN DIVIDE LOOP
	TAD	LM32	/DIVIDE BY 26 TO GET TRACK
	SMA		/SKIP IF DONE
	JMP	DIVLOO
	TAD	L32	/REMAINDER 0-25
	DCA	REMD	/USE AS TEMPORARY UNTIL FINAL VALUE
	TAD	SNGDBL	/FIND OUT IF SINGLE BOOT
	SPA CLA		/SKIP IF YES
	TAD 	REMD	/MULTIPLY BY THREE FOR DOUBLE
	TAD 	REMD	/AND BY TWO FOR SINGLE
	TAD 	REMD
	CLL IAC		/LINK CLEAR FOR FINAL TEST; +1 TO START AT 1 NOT 0
	TAD	LM32	/DIVIDE BY 26 TO GET SECTOR
	SMA SZA		/SKIP IF DONE
	JMP	.-2
	TAD	L32	/RESTORE POSITIVE VALUE TO BE SECTOR
	DCA	REMD	/WHEW, BUT WATCH IT, A FINAL CORRECTION COMING!
	TAD	SNGDBL	/IF LINK=0 AND SINGLE: 2,4,6,8,10,12,14,16... SERIES
	SMA SNL CLA	/SKIP IF NOT THE SINGLE DENS. 1,3,5,7,9,,, SERIES
	ISZ	REMD	/NOW HAVE IT 2,4,6,8,10,12,14,16...
	CIF	20	/POP BACK TO OTHER PAGE
	JMP I	DIVSUB	/!!THIS IS IN LAST USABLE LOCATION, EXEC NEEDS 7744!!
/
/

/
/	##  SECOND PAGE  ##
/
	RELOC
	*400
	RELOC	7600
/
/  FETCH ARGUMENTS, ETC.
/
PAGE2,	DCA	FETCH	/ENTER WITH ARGUMENT LIST ADDR IN AC
	RDF		/SAFE HERE?
	TAD	LCDIF0	/SET UP EXIT TO CALLER
	DCA	EXFLD
	AC4000		/SET UP TO PUT R/W BIT TO LINK
	TAD I	FETCH	/FIRST ARGUMENT HAS FIELD FOR TRANSFER
	AND	L70	/KEEPING ONLY FIELD
	TAD	LCDF0	/MAKE CDF TO TRANSFER FIELD
	DCA	BUFCDF	/PLACE IN LINE FOR SILO LOOP
	CML RTL		/0=WRITE, 2=READ
	DCA	FN
	TAD I	FETCH	/MAKE CONTROL COUNT FOR TRANSFER
	RAL
	AND	L7600	/COUNT OF WORDS
	CIA		/0 FOR WHOLE FIELD
	DCA	BC
	ISZ	FETCH	/NEXT ARGUMENT
	TAD I	FETCH	/BUFFER ADDRESS
	DCA	BUF
	ISZ	FETCH	/NEXT
	TAD	L100	/CARRY WITH DENSW IF SINGLE DENSITY
	TAD	DENSW	/SET TO COMPUTE SECTOR# FOR BLOCK#
	SMA CLA		/SKIP IF DOUBLE, MULTIPLE BY 2
	TAD I	FETCH	/SINGLE, MULTIPLY BY FOUR
	TAD I	FETCH
	ISZ	FETCH	/MOVING POINTER TO ERROR EXIT
	CDF	0	/INDIRECT TO FIRST PAGE FOR CONSTANTS
	CLL RAL		/FINAL PART OF MULTIPLY
	DCA I	LREC	/SAVE SECTOR NUMBER
	TAD I	LSIZE	/TOTAL SIZE OF MEDIA
	SZL		/SKIP IF LEGAL BLOCK #
	JMP	EXFLD	/EXIT TO CALLER WITH BLOCK # IN AC
LCDIF0,	CIF CDF 0	/GO BACK TO FIRST PAGE
	JMS	DIVSUB	/SET UP TRACK AND SECTOR
	TAD	FN	/SPLIT READ AND WRITE
	SZA CLA		/WRITE SKIPS
	JMP	STREAD	/READ STARTS IN MIDDLE OF LOOP
/			/WRITE FALLS TO NEXT LISTING PAGE

/
/WRITE FALLS THRU TO THIS LOOP
/
/  TOP OF MAIN LOOP
/
TOP,	TAD	FN	/SET SILO TO LOAD-UNLOAD
	JMS	LDCMD	/COMMAND TO CONTROLLER
	TAD	DENSW	/MAKE SILO LOOP COUNT, S=7700, D=7600
	DCA	FLPWC	/LDCMD ENTRY SAFE TEMPORARY
BUFCDF,	HLT		/CDF TO BUFFER FIELD PLACED HERE
TRLOOP,	TAD I	BUF	/IN CASE WRITE, FETCH A WORD
	STR		/SKIP IF READY TO PASS DATA
	JMP	.-1	/NO
	XDR		/TO OR FROM AC
	DCA I	BUF	/PLACE WORD FOR READ, WRITE REPLACES SAME
	ISZ	BUF	/MOVE BUFFER POINTER, (MAY SKIP)
L70,	70
	ISZ	FLPWC	/DONE YET
	JMP	TRLOOP
	TAD	DENSW	/ADDING 77 (SINGLE) 177 (DOUBLE)
	CMA		/ONCE WE CMA, THAT IS
	TAD	BC	/LOOP CONTROL TO FINISH READ
	SNA
	JMP	OKEX	/OK, DONE
	DCA	BC	/REPLACE AND KEEP GOING
/
/  MIDDLE OF MAIN LOOP
/
STREAD,	TAD	FN	/READ STARTS HERE
	TAD	L4	/TURN SILO COMMAND INTO READ-WRITE COMMAND
	JMS	LDCMD	/I/O COMMAND TO CONTROLLER
	TAD I	LREMD	/PRECOMPUTED SECTOR #; LDCMD SET FIELD TO 0
	STR
	JMP	.-1
	XDR
L7600,	7600		/CLEAR AC, AND IS LITERAL
	TAD I	LQUO	/TRACK #
	STR
	JMP	.-1
	XDR		/TRACK # IS ALWAYS NON0 !!
	ISZ I	LREC	/MOVE TO NEXT RECORD NUMBER
BACKER,	CDF CIF 0	/GO BACK TO FIRST PAGE
	JMS	DIVSUB	/FOR TRACK AND SECTOR
	TAD	L16	/WAIT FOR OPERATION TO COMPLETE
	JMS	LDCMD
	ISZ	BC	/CHECK FOR WRITE EXIT
	JMP	TOP	/STILL MORE
OKEX,	ISZ	FETCH	/KICK TO OK EXIT
EXFLD,	HLT		/CDF CIF TO CALLER
	JMP I	FETCH	/OUT

/
/  LDCMD  SUBROUTINE
/
FLPWC=.			/ENTRY POINT A SAFE COUNT TEMPORARY
LDCMD,	0		/CALL TO GIVE COMMAND TO CONTROLLER
LCDF0,	CDF	0	/INDIRECTS BACK TO FIRST PAGE
	TAD I	LIOTYP	/PUT IN UNIT, DENSITY, HEAD
	SDN		/SKIP IF CONTROLLER READY
	JMP	.-1	/NO
	LCD		/COMMAND
	SER		/SKIP IF AN ERROR
	JMP I	LDCMD	/NO
	ISZ I	LRETRY	/TRIED ENOUGH TIMES ALREADY?
	JMP	BACKER	/TO DIVSUB WITH AC=0 TO RETRY !!!!!
	AC4000		/HARD ERROR, GIVE BACK MINUS RESULT
	JMP	EXFLD
/
/  VARIABLES ETC.
/
BUF,	0		/POINTER TO CALLER'S BUFFER
FETCH,	0		/POINTER TO CALL
BC,	0		/CONTROL COUNT, WORDS TO TRANSFER
FN,	0		/0 FOR WRITE, 2 FOR READ
DENSW,	0		/7700 IF SINGLE DENSITY, 7600 IF DOUBLE DENSITY
/
/  LITERALS
/
L4,	4
L16,	16
L100,	100
LIOTYP,	IOTYP		/POINTERS BACK TO FIRST PAGE
LRETRY,	RETRY
LSIZE,	SIZE
LQUO,	QUO
LREC,	REC
LREMD,	REMD


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/RXSY2.PA. 
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

/RX02 SYSTEM HANDLER
/
/  THIS HANDLER WAS DESIGNED TO WORK WITH RX01, RX02, RX03
/
/  HOWEVER, ONE SINGLE BINARY CANNOT SUCCESSFULLY BE USED IN A
/  VIRGIN BUILD FOR ALL THREE DEVICES. IT IS CURRENTLY SET UP
/  TO BUILD AN RX02.
/  TO GENERATE A BINARY TO BUILD AN RX01, CHANGE THE RXTYP
/  EQUATE TO 1. FOR AN RX03 BUILD, CHANGE RXTYP TO 3.
/
RXTYP=2		/DEFAULT, BUILD ONTO AN RX02
/
/
/
VERSION="M&77
/
/
AC1=CLL CLA IAC
AC2=CLL CLA CML RTL
AC6=CLL CLA CML IAC RTL		/RX02'S MUST RUN ON AN OMNI-BUS !!
AC4000=CLL CLA CML RAR
AC3777=CLL CLA CMA RAR
AC7775=CLL CLA CMA RTL
/
/  DEVICE IOT SYMBOLIC EQUATES
/
LCD=6751		/LOAD COMMAND
XDR=6752		/TRANSFER DATA
STR=6753		/SKIP IF READY TO TRANSFER
SER=6754		/SKIP ON ERROR
SDN=6755		/SKIP ON DONE
/
/  HEADER BLOCK FOR BUILD
/
	*0
	-1		/ONE ENTRY
	DEVICE	RX8E
	DEVICE	SYS
	4320		/MULTI-TYPE RX HANDLER
	SYS&177+6000	/TWO PAGE HANDLER
	0		/UNUSED
	IFZERO	RXTYP-1	<756>	/SIZE FOR BUILD
	IFZERO	RXTYP-2	<1734>
	IFZERO	RXTYP-3	<3670>
/
	STBOOT-NDBOOT+12	/-SIZE (+12 FOR GAP)
/
/  HERE IS A LISTING OF THE PRIMARY BOOT FOR CONVENIENCE
/
	NOPUNCH
/
	*20
/
READ,	TAD	UNIT	/TRY NEXT COMBINATION OF DENSITY AND UNIT
	TAD	CON360	/ADDING IN 360
	AND	CON420	/KEEPING ONLY 420 BITS
	DCA	UNIT	/CYCLES 400,420,0,20,400,,,,,,,,
	AC6		/COMMAND TO READ DISK
	TAD	UNIT	/UNIT AND DENSITY
	LCD		/COMMAND TO CONTROLLER
	AC1		/TO SET SECTOR AND TRACK TO 1
	JMS	LOAD	/SECTOR TO CONTROLLER, LEAVES AC ALONE
	JMS	LOAD	/AND TRACK
LITRAL,	7004		/LEAVING A 2 IN AC; SERVES AS LITERAL
/
/  FOLLOWING IS PART OF WAIT LOOP, SAME SECONDARY BOOTS, OLD PRIMARY BOOT
/
START,	SDN		/HAS DONE COME UP; CODE STARTS HERE!
	JMP	LOAD+1	/NO, GO CHECK FOR READY TO TRANSFER
/
/  NOW, DONE OR ERROR
/
	SER		/SKIP ON AN ERROR, TRY ANOTHER DENSITY ETC.
	SNA		/NASTY, AC=2 FOR ABOUT TO DO SILO, 0 ON START-UP
	JMP	READ	/START-UP, GO SET UP UNIT, THEN READ TO SILO
	TAD	UNIT	/AC ALREADY 2, PUT IN UNIT, DENSITY
	LCD		/TO EMPTY THE SILO
	TAD	UNIT	/SET UP LOC 60 FOR OLD SECONDARY BOOT
	AND	CON360	/KEEPING UNLY DENSITY BIT
	TAD	LITRAL	/ADDING IN 7004, BECAUSE THAT'S WHAT SYS WANTS
	DCA	RX1SAV	/OLD SECONDARY BOOT MOVES IT TO HANDLER
CON360,	360		/LITERAL; EXECUTES IN LINE AS A NO-OP
/			/FALLS THRU TO NEXT PAGE OF LISTING
/
/
/  FOLLOWING CODE SAME AS OLD PRIMARY BOOT
/
	JMS	LOAD	/GRAB NEXT ITEM FROM SILO
	DCA	2	/TRADITION; SECONDARY BOOT STARTS LOADING AT 2 !
	ISZ	50	/INCREMENT LOAD ADDRESS
	JMP	47	/GO BACK FOR ANOTHER
/
/  SECONDARY BOOT LOADS OVER PRIMARY BOOT UNIT LOCATION 47 IS LOADED,
/  THEN CONTROL PASSES TO SECONDARY BOOT
/
LOAD,	0		/SUBROUTINE TO GIVE AND TAKE DATA FROM CONTROLLER
	STR		/IS HE READY TO TALK TO US?
	JMP	START	/NO, IS HE PERHAPS DONE WITH SILO, OR IN ERROR?
	XDR		/YES, DATA IN OR OUT;IF DATA TO CONTROLLER, AC UNCHANGED
	JMP I	LOAD	/NO MAGIC, JUST EXIT FROM SUBROUTINE
/
/  60 GOES TO OLD SECONDARY BOOT
/  61 HAS DENSITY AND UNIT THAT BOOTED SUCCESSFULLY
/
/
CON420,			/USE IT TO HOLD 420 LITERAL TO START OUT
RX1SAV,	420		/UNIT^20+7004 TO GO TO SYS HANDLER
UNIT,	20		/<DENSITY^400>+<UNIT^20> THAT BOOTED OK
/
	ENPUNCH
/
/	##  SECONDARY BOOT  ##
/
	RELOC	2	/SECTION LOADING OVER PRIMARY BOOT 2 - 47
/
STBOOT=.
/
/  ONCE-ONLY CODE AFTER FIRST SECTOR IS TRANSFERED
/
ONCE,	TAD	XR	/SINGLE=113, DOUBLE=213
	CLL RAR		/SINGLE=45, DOUBLE=105
	TAD	YR	/SETTING UP POINTER TO SECTOR, TRACK, FIELD, ADDR DATA
	DCA	YR	/DAT01-1 OR DAT02-1
	TAD I	YR	/GETTING SINGLE=774, DOUBLE=1374 (IN CASE OLD
	TAD	RX1SAV	/ADD IN 20^UNIT+7004		  PRIMARY BOOT)
	DCA	UNIT	/PUT INTO 61: <DENSITY^400>+<UNIT^20>
	JMS	NEXSEC	/DESTROY LINKAGE TO ONCE ONLY CODE!
XTRA,	0		/EXTRA TO MAKE ALL FIT
/
/
/  AUTO INCREMENT REGISTERS
/
XR,	61		/CONTINUE TO LOAD FIRST SECTOR AT 62
YR,	DAT01-45-1	/SET UP POINTER TO DATA AREA
/
/  SECTOR DONE, SET UP FOR NEXT
/
NEXSEC,	JMP	ONCE	/END OF FIRST SECTOR, DO SET-UP CODE
	CDF	0	/DATA FIELD HERE TO USE AUTO INCR REGISTERS
	TAD I	YR	/GET DATA FIELD FOR PLACEMENT OF NEXT SECTOR
	SMA		/SKIP IF MORE TO DO
	JMP	EBOOT	/END OF BOOT, 
	DCA	XFIELD	/PLACE IN LINE TO SET DATA FIELD
	AC6		/GET AC OF 6 TO SET UP FLOPPY READ
	TAD	UNIT	/DENSITY AND UNIT NUMBER
	LCD
	TAD I	YR	/SECTOR FOR NEXT READ
	JMS	LOAD	/LOAD LEAVES AC ALONE
	TAD I	YR	/TRACK-SECTOR FOR NEXT READ
	JMS	LOAD	/LOAD REMAINS FROM PRIMARY BOOT
	TAD I	YR	/ADDRESS-TRACK-1 FOR NEXT READ
/			/FALL TO HANGGG WITH AC NON0 TO SHOW READ
/
/  FOLLOWING TWO LOCATIONS MUST MATCH PRIMARY BOOT
/
HANGGG,	SDN		/SKIP IF DONE
	JMP	LOAD+1	/NO, GO CHECK FOR TRANSFER READY
/
/  SORT OUT ERROR, SILO DONE, READ DONE
/
	SER		/SKIP IF ERROR
	SKP		/IS GOOD, CHECK WHETHER READ OR SILO
	HLT		/ANY ERROR IS FATAL!!
	SNA		/SKIP IF READY TO SILO (AC HAS LOAD ADDR)
	JMP	NEXSEC	/DONE WITH SILO (AC=0) GO TO NEXT SECTOR
	DCA	XR	/USE AUTO-INCR TO LOAD CORE
	JMP	OVRFLW	/GO TO LOCATIONS NOT FITTING UNDER 47
/
/  CODE TO EMPTY THE SILO TO CORE
/
XFIELD,	CDF	0	/FIELD FOR TRANSFER PLACED HERE
	JMS	LOAD	/LOAD REMAINS FROM PRIMARY BOOT
	DCA I	XR	/PLACE NEXT WORD
	JMP	XFIELD	/WHEN THIS LOCATION IS PLACED, SECONDARY BOOT
/			/TAKES CONTROL, CONTINUE FIRST SECTOR AT 62
/
/  PRIMARY BOOT LOCATIONS 50-61 REMAIN INTACT
/
STATUS=.		/REUSE FOR TEMPORARY
/
/	##  REST OF SECONDARY BOOT  ##
/
	RELOC	62	/SECTION LOADING 62 - 213
/
/  LOCATIONS NOT FITTING WITHIN 2-47 SPACE
/
OVRFLW,	XDR		/FETCH READ STATUS FOR LATER
	DCA	STATUS	/TO FIGURE OUT IF A DOUBLE SIDED FLOPPY
	AC2		/CODE FOR SILO OPERATION
	TAD	UNIT	/UNIT AND DENSITY
	LCD		/SET TO EMPTY SILO
	JMP	XFIELD	/GO TO SILO UNLOADING LOOP
/
/
/
/  SINGLE DENSITY LOADING DATA
/
DAT01,	774		/CANCEL OUT 7004 WHEN ADDED TO 70X4
	CDF	0	/2ND SECTOR FOR SINGLE DENSITY, FIELD 0
	3		/SECTOR 3, INTERLEAVED AT 2
	1-3		/TRACK 1  (MINUS SECTOR 3)
	114-1-1		/2 THRU 47 + 62 THRU 113 FOR FIRST SECTOR
/			/-1 FOR TRACK, -1 FOR AUTO INCR
	CDF	0	/3RD SECTOR TO 7600 FIELD 0
	5
	1-5
	7600-1-1
	CDF	0	/4TH SECTOR, SECOND HALF OF PAGE
	7
	1-7
	7700-1-1
	CDF	10	/5TH SECTOR, TOP OF FIELD 1
	21		/SECTOR 21
	11-21		/OF TRACK 11
	7600-11-1	/TO 7600
	CDF	10	/6TH SECTOR, REST OF FIELD 1
	23
	11-23
	7700-11-1
	CDF	20	/7TH SECTOR, TOP OF FIELD 2
	25
	11-25
	7600-11-1
	CDF	20	/10TH SECTOR, REST OF FIELD 2
	27
	11-27
	7700-11-1
	16		/MARKER AND LITERALS TO MAKE DAT02=DAT01+40
MAGIC,	7623		/THIS WORD IN HANDLER HAS DENSITY, UNIT WORD
L7605,	7605		/STARTING ADDR FOR HANDLER
/
/  DOUBLE DENSITY LOADING DATA
/
DAT02,	1374		/MAKE 400+UNIT WHEN ADDED TO 70X4
	CDF	0	/2ND SECTOR TO 7600
	4		/INTERLEAVE OF 3
	1-4
	7600-1-1
	CDF	10
	15
	5-15
	7600-5-1
	CDF	20	/3RD SECTOR TO 7600 OF FIELD 2
	20		/SECOND HALF OF BLOCK 66 OCTAL
	5-20		/ON TRACK 5
	7600-5-1
	16		/MARKER TO STOP WHOLE THING, ALSO LITERAL 16
/
/  I/O DONE, GO TO HANDLER
/
EBOOT,	TAD	UNIT	/ENTER WITH AC=16
	LCD		/SET DONE FLAG FOR HANDLER
	TAD	STATUS	/FIND OUT IF DOUBLE SIDED DISK
	RTR		/DOUBLE SIDED BIT TO LINK
	CLA RAR		/DOUBLE SIDED BIT TO AC0
	TAD	UNIT	/REST OF CONTROL WORD
	DCA I	MAGIC	/TO 7623 OF SYSTEM HANDLER
	JMP I	L7605	/TO START UP SYSTEM
/
NDBOOT=.
/
/  CODE THAT IS LOCATION SPECIFIC HAS !! IN COMMENTS
/
/	##  CODE FOR SYSTEM HANDLER  ##
/
	RELOC
	*200
	RELOC	7600
/
/			/USE DATA BREAKS FOR TEMPORARIES
/
QUO=7750		/QUOTIENT FOR DIVIDE == TRACK
REMD=7751		/REMAINDER FOR DIVIDE == SECTOR
REC=7752		/CURRENT LOGICAL SECTOR NUMBER
RETRY=7753		/RETRIES COUNT
/
	ZBLOCK	7	/REQUIRED BY BUILD
/
/
/  ENTRY POINT
/
SYS,	VERSION
L32,	32		/FALL THRU SOME LITERALS
L1734,	1734		/WHICH MAY PUT STRAY STUFF IN AC
	3		/!!REQUIRED AT 7612!! TO SHOW OS8 TWO PAGE HANDLER
	AC7775		/SET UP RETRY COUNTER
	DCA	RETRY	/RETRIES ARE OVER ENTIRE OPERATION
	RDF		/GRAB CALLER'S FIELD
	TAD	LLCDF0	/MAKE CDF TO IT
	DCA	RESTOR	/PUT IT BACK, GOING TO I/O ROUTINE ON PAGE 2
IOTYP,	JMP	FIRST	/GO TO ONCE ONLY CODE, LATER USED AS VARIABLE
/			/HAS HEAD, DENSITY, UNIT FOR I/O REQUEST
	JMP	RSTART	/GO CALL SECOND PAGE, IOTYP FALLS THRU TO HERE
/
/  LITERALS ETC.
/
L5000,	5000		/
BOOTYP,			/!!MUST BE AT 7623!! SECONDARY BOOT PUTS AT BOOT TIME
/			/4000 IF QUAD, 400 IF DOUBLE, AND 20 IF UNIT 1
	IFZERO	RXTYP-1	<0>	/INITIAL VALUE MATCHES DEVICE TO ALLOW
	IFZERO	RXTYP-2	<400>	/BUILD ONTO VIRGIN MEDIA
	IFZERO	RXTYP-3	<4400>	/OTHERWISE, SECONDARY BOOT PUTS IN RIGHT STUFF
LDENSW,	DENSW		/LOCATION ON SECOND PAGE
L4110,
LM3670,	4110		/VALUE WITH TWO USES
LM32,	-32
LLCDF0,	CDF	0
/
/  ONCE ONLY CODE
/
FIRST,	JMP	MORE	/LEAVING ADDITIONAL ONCE-ONLY SPACE
/
/  FIX CDF TO 7642
/
	*7642		/!!CDF OR CIF MUST BE AT 7642!!
MORE,	CDF	20	/POINT TO OUR SECOND PAGE
	TAD	BOOTYP	/PICK UP BOOT WORD
SNGDBL,	CLL RAL		/MAKE A WORD MINUS IF DOUBLE (OR QUAD) BOOTED
SIZE,	RTL		/REUSE FOR CONSTANTS
	DCA	SNGDBL	/JUST FOR CONVENIENCE, THE BIT IS IN BOOTYP ANYHOW
	TAD	QL3400	/ANY LITERAL IN RANGE 3400-3757 (LINK=0 HERE)
	TAD	BOOTYP	/FIGURE OUT SIZE OF MEDIA
	SMA SNL CLA	/SKIP IF DOUBLE OR QUAD
	TAD	L1734	/SINGLE
	TAD	L4110	/S=6044, D&Q=4110
	SNL		/SKIP IF QUAD, ITS SIZE ALREADY THERE
	CLL CML RAR	/OTHER TWO CASES DIVIDE BY TWO
	DCA	SIZE	/STORE S=7022, D=6044, Q=4110
	TAD	SNGDBL	/MAKE DENSW, 7600 IF DOUBLE, 7700 IF SINGLE
	SPA CLA		/SKIP IF SINGLE
	TAD	L7700
	TAD	L7700
QL3400,	DCA I	LDENSW	/MUST LIVE ON SECOND PAGE
/
/  END OF ONCE-ONLY, (RE)START I/O OPERATION
/
RSTART,			/AC MAY HAVE JUNK COMING IN!!
	AC3777		/MAKE A WORD WITH DENSITY AND UNIT BITS ONLY
	AND	BOOTYP	/FOR CONTRUCTING LCD ARGUMENTS
	DCA	IOTYP	/ALSO SHUTS OFF PATH TO ONCE-ONLY CODE!
	TAD	SYS	/AC HAS THE CALL ADDR
RESTOR,	HLT		/SET DATA FIELD TO THAT OF CALLER
	CIF	20
	JMP	PAGE2
/
/
/  CALL WITH AC NON0 TO DO DIVIDE
/  CALL WITH AC ZERO TO DO I/O RETRY (WHOLE OPERATION)
/
DIVSUB,	0
	SNA CLA		/SKIP IF REALLY A DIVIDE REQUEST
	JMP	RSTART	/NO, IT WAS AN ERROR RETRY!!
	DCA	QUO	/CLEAR DIVIDE QUOTIENT
	TAD	BOOTYP	/IS IT A TWO HEADER
	SKP		/!!FAULTY USR CALL DOES JMS HERE (7700)
	HLT		/HALT OUT SUCH AN OCCURRENCE!!
L7700,	SMA CLA		/SKIP IF YES
	JMP	SHUNT	/NO, GO DO DIVIDE
	CLL		/TO CHECK 12 BIT SIZE
	TAD	REC	/WHICH RECORD ARE WE WORKING ON
	TAD	LM3670	/NUMBER OF SECTORS ON FIRST SIDE
	SNL CLA		/SKIP IF SECOND SIDED IT
	JMP	SHUNT	/NO, JUST REGULAR
	TAD	BOOTYP	/MAKE IO FUNCTION WORD WITH SECOND HEAD BIT
	TAD	L5000	/CONVERTS TO 20^UNIT +1400
	DCA	IOTYP
	TAD	LM3670	/BUT DECREASE RECORD NUMBER
SHUNT,	TAD	REC	/THIS FOR TRACK-SECTOR
DIVLOO,	ISZ	QUO	/MAIN DIVIDE LOOP
	TAD	LM32	/DIVIDE BY 26 TO GET TRACK
	SMA		/SKIP IF DONE
	JMP	DIVLOO
	TAD	L32	/REMAINDER 0-25
	DCA	REMD	/USE AS TEMPORARY UNTIL FINAL VALUE
	TAD	SNGDBL	/FIND OUT IF SINGLE BOOT
	SPA CLA		/SKIP IF YES
	TAD 	REMD	/MULTIPLY BY THREE FOR DOUBLE
	TAD 	REMD	/AND BY TWO FOR SINGLE
	TAD 	REMD
	CLL IAC		/LINK CLEAR FOR FINAL TEST; +1 TO START AT 1 NOT 0
	TAD	LM32	/DIVIDE BY 26 TO GET SECTOR
	SMA SZA		/SKIP IF DONE
	JMP	.-2
	TAD	L32	/RESTORE POSITIVE VALUE TO BE SECTOR
	DCA	REMD	/WHEW, BUT WATCH IT, A FINAL CORRECTION COMING!
	TAD	SNGDBL	/IF LINK=0 AND SINGLE: 2,4,6,8,10,12,14,16... SERIES
	SMA SNL CLA	/SKIP IF NOT THE SINGLE DENS. 1,3,5,7,9,,, SERIES
	ISZ	REMD	/NOW HAVE IT 2,4,6,8,10,12,14,16...
	CIF	20	/POP BACK TO OTHER PAGE
	JMP I	DIVSUB	/!!THIS IS IN LAST USABLE LOCATION, EXEC NEEDS 7744!!
/
/

/
/	##  SECOND PAGE  ##
/
	RELOC
	*400
	RELOC	7600
/
/  FETCH ARGUMENTS, ETC.
/
PAGE2,	DCA	FETCH	/ENTER WITH ARGUMENT LIST ADDR IN AC
	RDF		/SAFE HERE?
	TAD	LCDIF0	/SET UP EXIT TO CALLER
	DCA	EXFLD
	AC4000		/SET UP TO PUT R/W BIT TO LINK
	TAD I	FETCH	/FIRST ARGUMENT HAS FIELD FOR TRANSFER
	AND	L70	/KEEPING ONLY FIELD
	TAD	LCDF0	/MAKE CDF TO TRANSFER FIELD
	DCA	BUFCDF	/PLACE IN LINE FOR SILO LOOP
	CML RTL		/0=WRITE, 2=READ
	DCA	FN
	TAD I	FETCH	/MAKE CONTROL COUNT FOR TRANSFER
	RAL
	AND	L7600	/COUNT OF WORDS
	CIA		/0 FOR WHOLE FIELD
	DCA	BC
	ISZ	FETCH	/NEXT ARGUMENT
	TAD I	FETCH	/BUFFER ADDRESS
	DCA	BUF
	ISZ	FETCH	/NEXT
	TAD	L100	/CARRY WITH DENSW IF SINGLE DENSITY
	TAD	DENSW	/SET TO COMPUTE SECTOR# FOR BLOCK#
	SMA CLA		/SKIP IF DOUBLE, MULTIPLE BY 2
	TAD I	FETCH	/SINGLE, MULTIPLY BY FOUR
	TAD I	FETCH
	ISZ	FETCH	/MOVING POINTER TO ERROR EXIT
	CDF	0	/INDIRECT TO FIRST PAGE FOR CONSTANTS
	CLL RAL		/FINAL PART OF MULTIPLY
	DCA I	LREC	/SAVE SECTOR NUMBER
	TAD I	LSIZE	/TOTAL SIZE OF MEDIA
	SZL		/SKIP IF LEGAL BLOCK #
	JMP	EXFLD	/EXIT TO CALLER WITH BLOCK # IN AC
LCDIF0,	CIF CDF 0	/GO BACK TO FIRST PAGE
	JMS	DIVSUB	/SET UP TRACK AND SECTOR
	TAD	FN	/SPLIT READ AND WRITE
	SZA CLA		/WRITE SKIPS
	JMP	STREAD	/READ STARTS IN MIDDLE OF LOOP
/			/WRITE FALLS TO NEXT LISTING PAGE

/
/WRITE FALLS THRU TO THIS LOOP
/
/  TOP OF MAIN LOOP
/
TOP,	TAD	FN	/SET SILO TO LOAD-UNLOAD
	JMS	LDCMD	/COMMAND TO CONTROLLER
	TAD	DENSW	/MAKE SILO LOOP COUNT, S=7700, D=7600
	DCA	FLPWC	/LDCMD ENTRY SAFE TEMPORARY
BUFCDF,	HLT		/CDF TO BUFFER FIELD PLACED HERE
TRLOOP,	TAD I	BUF	/IN CASE WRITE, FETCH A WORD
	STR		/SKIP IF READY TO PASS DATA
	JMP	.-1	/NO
	XDR		/TO OR FROM AC
	DCA I	BUF	/PLACE WORD FOR READ, WRITE REPLACES SAME
	ISZ	BUF	/MOVE BUFFER POINTER, (MAY SKIP)
L70,	70
	ISZ	FLPWC	/DONE YET
	JMP	TRLOOP
	TAD	DENSW	/ADDING 77 (SINGLE) 177 (DOUBLE)
	CMA		/ONCE WE CMA, THAT IS
	TAD	BC	/LOOP CONTROL TO FINISH READ
	SNA
	JMP	OKEX	/OK, DONE
	DCA	BC	/REPLACE AND KEEP GOING
/
/  MIDDLE OF MAIN LOOP
/
STREAD,	TAD	FN	/READ STARTS HERE
	TAD	L4	/TURN SILO COMMAND INTO READ-WRITE COMMAND
	JMS	LDCMD	/I/O COMMAND TO CONTROLLER
	TAD I	LREMD	/PRECOMPUTED SECTOR #; LDCMD SET FIELD TO 0
	STR
	JMP	.-1
	XDR
L7600,	7600		/CLEAR AC, AND IS LITERAL
	TAD I	LQUO	/TRACK #
	STR
	JMP	.-1
	XDR		/TRACK # IS ALWAYS NON0 !!
	ISZ I	LREC	/MOVE TO NEXT RECORD NUMBER
BACKER,	CDF CIF 0	/GO BACK TO FIRST PAGE
	JMS	DIVSUB	/FOR TRACK AND SECTOR
	TAD	L16	/WAIT FOR OPERATION TO COMPLETE
	JMS	LDCMD
	ISZ	BC	/CHECK FOR WRITE EXIT
	JMP	TOP	/STILL MORE
OKEX,	ISZ	FETCH	/KICK TO OK EXIT
EXFLD,	HLT		/CDF CIF TO CALLER
	JMP I	FETCH	/OUT

/
/  LDCMD  SUBROUTINE
/
FLPWC=.			/ENTRY POINT A SAFE COUNT TEMPORARY
LDCMD,	0		/CALL TO GIVE COMMAND TO CONTROLLER
LCDF0,	CDF	0	/INDIRECTS BACK TO FIRST PAGE
	TAD I	LIOTYP	/PUT IN UNIT, DENSITY, HEAD
	SDN		/SKIP IF CONTROLLER READY
	JMP	.-1	/NO
	LCD		/COMMAND
	SER		/SKIP IF AN ERROR
	JMP I	LDCMD	/NO
	ISZ I	LRETRY	/TRIED ENOUGH TIMES ALREADY?
	JMP	BACKER	/TO DIVSUB WITH AC=0 TO RETRY !!!!!
	AC4000		/HARD ERROR, GIVE BACK MINUS RESULT
	JMP	EXFLD
/
/  VARIABLES ETC.
/
BUF,	0		/POINTER TO CALLER'S BUFFER
FETCH,	0		/POINTER TO CALL
BC,	0		/CONTROL COUNT, WORDS TO TRANSFER
FN,	0		/0 FOR WRITE, 2 FOR READ
DENSW,	0		/7700 IF SINGLE DENSITY, 7600 IF DOUBLE DENSITY
/
/  LITERALS
/
L4,	4
L16,	16
L100,	100
LIOTYP,	IOTYP		/POINTERS BACK TO FIRST PAGE
LRETRY,	RETRY
LSIZE,	SIZE
LQUO,	QUO
LREC,	REC
LREMD,	REMD


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/SAVECB.PA. 
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

/SAVECB.PA	DEMONSTRATION PROGRAM TO INCREASE THE NUMBER OF SAVE ARGUMENTS
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
	/SAVCB.PA  INCREASES THE NUMBER OF SAVE ARGUMENTS         JULY 1978
/	MEMORY LOCATIONS UTILIZED
/	0000-1177	/PROGRAM CODE
/	1200-1377	/TTY INPUT BUFFER
/	1400-1577	/ORIGINAL CCB BUFFER
/	1600-1710	/ADJUSTED CCB BUFFER
/	1710-1777	/PROGRAM CODE


	/PAGE ZERO
	*0
REDERR,	JMS I [CRLF	/ILLEGAL INPUT ERROR
	JMS I [PRMSG
	TEXT	/INPUT?/
	JMP I ERR
	*10
LXR,	1177		/AUTO INDEX FOR INPUT STORAGE
CXR,	0		/AUTO INDEX
XR,	1377
NXR,	1577
TX,	0
	*20
SHNDLR,	7607
ERR,	7605
TEMP,	0		/INPUT NUMBER STORAGE
TMP1,	0		/INPUT NUMBER STORAGE
DIGFLG,	0		/NUMBER PRESENT FLAG
TEMP1,	0		/INPUT FIELD STORAGE
TEMP2,	0		/INPUT ADDRESS STORAGE
CMND,	0
CHARID,	0		/
DLID,	0		/DELIMITER STORAGE
FIRST1,	0		/STORAGE FOR SEGMENT FIELD INPUT
FIRST2,	0		/STORAGE FOR SEGMENT ADDRESS INPUT
CNT,	0		/SEGMENT COUNTER
FLD,	0		/USED IN CCB FIELD PRINTING
TMP,	0		/TEMPORARY STORAGE-TEXT PRINTING
TCB,	0		/PRMSG CALL I.D.
ORG,	0		/ORIGIN STORAGE
COUNT,	-110
BUMP,	-2		/USED AS TEST IN LOAD LOOP
RBFLG,	0
SEGCNT,	-4

	*200
START,	CDF 0
	CIF 10		/CALL COMMAND DECODER
	JMS I [200
	5
	2326		/SV. EXTENSION---ASSUMED INPUT
	CIF 0
	CDF 10
	TAD I [7620	/STARTING BLOCK OF FILE
	CDF 0
	DCA STFLE	/SET UP LOADING OF CCB BLOCK
LOAD,	JMS I [7607	/LOAD CCB
	0101
LOC,	1400		/INTO 1400
STFLE,	0		/STARTING BLOCK OF FILE
	JMP REDERR	/
	TAD I XR	/MOVE CCB UP TO 1600
	DCA I NXR
	ISZ COUNT	/ALL DONE?
	JMP .-3
	JMS I (VERMSG	/PRINT CCB WRITING INFO
CONT,	JMS CRLF	/INITIALIZE LINE
	JMS IDCHAR	/PRINT INPUT SIGNAL CHARACTER
REATTY,	KSF		/WAITING FOR FLAG TO DISAPPEAR
	JMP .-1
	JMS I [CTCTST	/...CTRL/C?
	TAD [203	/NO-RE-INSTATE CHARACTER
	JMS I [RBLFT	/TEST FOR LINE FEED,RUBOUT
	TAD [225
	DCA TEMP	/STORE CHARACTER
	KCC		/CLEAR KEYBOARD,AC
	TAD TEMP
	JMS I [TYPIT
	TAD TEMP
	TAD [-215	/IS IT THE END OF THE LINE?
	SNA
	JMP I [SAVE1
	TAD [-63	/IS IT THE END OF INPUT(@)?
	SNA
	JMP I [SAVE
	CLL CLA
	TAD TEMP
	DCA I LXR	/STORE AWAY CHARACTER
	TAD LXR
	TAD [-1110
	SNA CLA		/TEST FOR LINE OVERFLOW
	JMP I [BARG
	JMP REATTY


CRLF,	0		/CARRAIGE RETURN--LINE FEED ROUTINE
	CLL CLA
	TAD [215
	JMS I [TYPIT
	TAD [212
	JMS I [TYPIT
	JMP I CRLF
IDCHAR,	0		/PRINT A #, IT SIGNALS INPUT TIME
	CLA
	DCA RBFLG	/INITIALIZE RUBOUT FLAG
	DCA TEMP1	/INITIALIZE INPUT STORAGE WORD
	TAD [243
	JMS I [TYPIT
	JMP I IDCHAR
TYCCB,	JMS CRLF
	TAD [211
	JMS I [TYPIT
	TAD [1377	/ROUTINE TO TYPE OUT CCB INFO
	DCA CXR
	TAD I CXR	/ADJUST SEGMENT INFO
	CLL RAL
	STL RAR
	DCA CNT		/NUMBER OF SEGS
	JMS I [PRMSG
	TEXT /START=/
RTRN1,	TAD I CXR	/GET CIF CDF OF STARTING FIELD
	AND [174
	DCA FLD		/STORE IT
	TAD FLD
	AND [104		/ISOLATE BANK BITS
	CLL RTR		/SWITCH THEM AROUND
	RAR
	SZL
	TAD [4
	CLL RTR
	TAD [260
	JMS I [TYPIT
	TAD FLD		/TIME TO TYPE FIELDS
	AND [70
	CLL RTR
	RAR
	TAD [260
	JMS I [TYPIT
TYORG,	TAD I CXR
	JMS I [PWORD	/PROCESS ORIGIN WORD
	TAD [211	/PRINT ATAB TO SEPARATE HEADINGS
	JMS I [TYPIT
TYJSW,			/SET TYCCB CALL FLAG
	JMS I [PRMSG	/PRINT JSW HEADING
	TEXT /JSW=/
RTRN2,	TAD I CXR
	JMS I [PWORD	/PRINT JSW
	JMS CRLF
	JMS CRLF
TYSEGS,	
	JMS I [PRMSG
	TEXT /CORE SEGMENTS:/
	JMS CRLF
	JMS CRLF
	JMP I [SEGSM2	/PROCESS SEGMENTS
	*400
PRINT,	JMS PRWD
	ISZ PRMSG	/GET MORE TEXT
	SKP
PRMSG,	0		/ROUTINE TO PRINT TEXT
	CLA
	TAD I PRMSG
	SZA
	JMP PRINT
	TSF
	JMP .-1
	ISZ PRMSG	/TYCCB RETURN
	JMP I PRMSG
PRWD,	0		/ROUTINE TO ISOLATE AND PRINT TEXT CHARS
	DCA TMP		/SAVE PACKED SIX BIT CHARS
	TAD TMP
	BSW		/POSITION FIRST CHAR FOR PRINTING
	JMS PCHAR	/PRINT IT
	TAD TMP		/ISOLATE SECOND CHARACTER
	JMS PCHAR	/PRINT IT
	JMP I PRWD
PCHAR,	0	/ROUTINE FOR CONVERTING TEXT CHARS TO ASCII
	AND [77		/ISOLATE SIX BITS
	SNA 
	JMP I PCHAR
	TAD [240	/CONVERSION TO ASCII
	AND [77
	TAD [240
	JMS TYPIT	/PRINT CHARACTER
	JMP I PCHAR
TYPIT,	0		/ROUTINE TO PRINT CHARACTERS
	TLS
	TSF
	JMP .-1
	CLA
	JMS CTCTST	/TEST FOR CONTROL/C
	CLL CLA
	JMP I TYPIT
CTCTST,	0		/SEE IF USER WANTS OUT, CTRL/C...
	TAD [200
	KSF
	STA
	KRS
	TAD [-203	/IS IT A CTRL/C?
	SNA
CTLC,	JMP I ERR	/ CTRL/C MEANS GETOUT...
	JMP I CTCTST	/RETURN
RBLFT,	0
	TAD [-377	/IS IT A DELETE?

	SNA
	JMP I [DELETE
	TAD [377-212	/IS IT A LINE FEED?
	SNA

	JMP I [LFEED
	TAD [212-225
	SZA		/IS IT A CTRL/U?
	JMP I RBLFT
	TAD [225
	JMS I [TYPIT
	JMP I [NEXTLN

SSTADR,	TAD TEMP1	/ADJUST FIELD
	CLL RTR		/TRANSFORM FOR CDF--"37" TO "174"
	RTR
	BSW
	SZL
	TAD [4
	TAD [6203
	DCA I [1401	/STORE STARTING FIELD CDF CIF
	TAD TEMP2
	DCA I [1402	/STORE AWAY STARTING ADDRESS
	JMP ENDTST
SSBITS,	TAD TEMP2
	DCA I [1403	/STORE AWAY JSW
ENDTST,	TAD LXR		/TEST FOR END OF INPUT LINE
	CIA
	TAD CXR
	SMA CLA
	JMP TESTE	/TEST FOR CR/LF OR @
	JMP I [SDFLG
DASH,	TAD TEMP1	/ROUTINE TO PROCESS TRIPLET
	CIA CLL CML
	TAD FIRST1
	SZA CLA		/ARE THE FIELDS THE SAME?
	JMP I [BARG	/NO ERROR
	TAD TEMP2
	AND [7600
	TAD [200
	DCA TEMP2
	TAD TEMP2
	CIA
	TAD FIRST2
	SZL CLA		/ISI UPPER LIMIT > LOWER LIMIT?
	JMP I [BARG	/NO ERROR
	TAD [1403	/SET INDEX REGISTER
	DCA XR
	STA
	TAD I [1400		/INITIALIZE SEGMENT COUNTER
	DCA COUNT
	JMP I [FLDTST	/PROCESS SEGMENT
TESTE,	TAD TEMP	/TEST FOR WHETHER END OF LINE OR INPUT
ENTST,	TAD [-215		/WAS IT ACARRAIGE RETURN?
	SNA
	JMP I [NEXTLN		/YES PREPARE FOR NEXT LINE
	TAD [215-"@		/WAS IT EXIT TIME?
	SNA
	JMP I [WRCCB		/EXIT ROUTINE
	JMP REDERR	/ILLEGAL INPUT
PWORD,	0	/ROUTINE TO PROCESS ORIGIN OR JSW WORDS
	DCA ORG
	TAD ORG
	BSW		/PROCESS HIGHER BIT FIRST
	JMS SECT2
	TAD ORG		/NOW PROCESS LOWER BITS
	JMS SECT2
	JMP I PWORD
SECT2,	0	/ROUTINE TO PRINT DOUBLE DIGIT
	DCA TEMP1
	TAD TEMP1
	AND [70		/ISOLATE HIGHER DIGIT
	CLL RTR
	RAR
	TAD [260
	JMS I [TYPIT
	TAD TEMP1
	AND [7		/ISOLATE LOWER DIGIT
	TAD [260
	JMS I [TYPIT
	JMP I SECT2


	*600
GTNM,	DCA DIGFLG	/RESET DIGIT FLAG
	DCA TEMP1	/CLEAR FIELD STORAGE
	DCA TEMP2	/CLEAR ADDRESS STORAGE
GETNUM,	TAD I CXR	/ROUTINE TO ORGANIZE LINE INPUT
	TAD [-270	/TEST FOR NUMBER
	CLL
	TAD [10
	SNL
	JMS NOTNUM	/NO NUMBER
	DCA TMP1	/STORE NUMBER
	ISZ DIGFLG	/SET NUMBER FLAG
	JMS ROT		/ORGANIZE ARGUMENT INTO TWO WORDS 
	JMS ROT		/TEMP1 FOR THE FIELD
	JMS ROT		/TEMP2 FOR ADDRESS
	TAD TEMP2
	TAD TMP1	/TAD IN NEW DIGIT
	DCA TEMP2
	JMP GETNUM
SDFLG,	TAD CHARID	/ADD DELIMITER
	DCA DLID	/STORE IT
	TAD TEMP2	/STORE PRESENT ADDRESS AWAY
	AND [7600
	DCA FIRST2
	TAD TEMP1	/STORE FIELD ALSO
	AND [37
	DCA FIRST1
	JMP GTNM

ROT,	0		/ROUTINE TO ROTATE FIELD AND ADDRESS
	TAD TEMP2	/ADDRESS REGISTER
	CLL RAL		/MOVE POTENTIAL FIELD BIT INTO LINK
	DCA TEMP2	/NOW READY FOR NEW INPUT - TMP1
	TAD TEMP1
	RAL		/STORE FIELD BITS
	DCA TEMP1
	JMP I ROT
NOTNUM,	0
	CLL
	TAD [260	/CONVERT TO ASCII
	DCA CHARID
	TAD DIGFLG
	SNA CLA
	JMS ACORS	/IF NO DIGIT,MUST BE A COMMAND
	TAD DLID	/PROCESS INPUT NUMBER
	SNA		/ZERO INDICATES FIRST NUMBER
	JMP SDFLG	/PREPARE FOR NEXT NUMBER
	TAD [-"-	/IS IT A DASH?
	SNA
	JMP I [DASH	/PROCESS TRIPLET
	TAD ["--",	/IS IT A COMMA?
	SNA
	JMP SDFLG	/GET SECOND NUMBER
	TAD [",-";	/IS IT A SEMI-COLON?
	SNA
	JMP I [SSTADR	/PROCESS START ADDRESS
	TAD [";-"=	/IS IT AN EQUALS
	SNA CLA
	JMP I [SSBITS	/PROCESS JSW
	JMP SDFLG
ACORS,	0	/TEST FOR ADD,SUB,OR CHANGE
	TAD CHARID
	TAD [-"T	/IS IT A TYPE INST?
	SNA
	JMP I [TYCCB	/IF SO PROCESS IT
	TAD ["T-"A	/IS IT AN ADDITION?
	SNA
	JMP CEND
	TAD ["A-"S	/IS IT A DELETION?
	SZA CLA
	JMP SDFLG	/TEST FOR @ OR CR/LF
	IAC
CEND,	DCA CMND	/STORE COMMAND FLAG

	JMP GTNM
SAVE1,	JMS I [CRLF	/PROCESS END OF LINE
SAVE,	TAD [1177	
	DCA CXR		/POINT TOWARD START OF LINE
	TAD LXR		/WAS THEIR ANY INPUT?
	CIA
	TAD CXR
	SNA CLA		/IF LXR EQUALS CXR, THERE WAS NONE
	JMP I [TESTE	/TEST FOR CR/LF OR @
	DCA I LXR	/SET DELIMITER
	JMP I [GETNUM	/GET INPUT

ATEST,	CLA
	TAD CMND	/WHAT IS THE COMMAND?
	SZA CLA		/IF NOT THE ADD COMMAND...
	JMP I [BARG	/THEN ERROR RETURN
	TAD COUNT	/IS IT TO BE ADDED ON THE END?
	SZA CLA	/IF COUNT IS ZERO, YES...
	TAD [-2		/PUSH BACK INDEX TO SAVE LAST SEGMENT
	TAD XR
	DCA XR
	TAD XR		/ADDITION CODE
	AND [77		/ISOLATE WHERE WE ARE IN THE CCB
	TAD [1600	/REFERENCE SAME LOCATION IN ADD BUFFER
	DCA NXR		/STORE FOR MOVE
	TAD FIRST2	/STORE INPUT'S ORIGIN
	DCA I NXR
	JMS I [SEGADJ	/ADJUST SECOND WORD FOR CCB
	DCA I NXR
	STA
	DCA BUMP	/SET ADD INDICATOR
	JMP I [MOVE	/MOVE CCB
STEST,	STA		/DELETION PROCESSOR

	TAD CMND
	SZA CLA		/IS A DELETION?
	JMP I [BARG	/IF NOT ERROR
	TAD XR		/SET BACK POINTER FOR DELETION
	TAD [176	/ADD 200 TO REFERENCE 1600 BUFFER
	DCA NXR
	IAC		/SET DELETION PARAMETER
	DCA BUMP
	JMP I [MOVE	/MOVE CCB
	PAGE


	*1000
	/ROUTINE TO PROCESS CCB SEGMENTS FOR TYPING
SEGSM2,	TAD [-4
	DCA SEGCNT
SEGS,	TAD I CXR	/GET FIRST SEGMENT
	DCA TMP1
	TAD I CXR	/GET SECOND WORD OF SEGMENT
	DCA FLD
	JMS TFIELD
	JMS I [SECT2
	TAD TMP1	/TYPE ORIGIN OF SEGMENT
	JMS I [PWORD	/TYPE IT
	TAD [255	/TYPE HYPHEN
	JMS I [TYPIT
	JMS TFIELD	/TYPE FIELD
	JMS I [SECT2
	TAD FLD		/CALCULATE HIGHER LIMIT
	AND [3700	/ISOLATE NUMBER OF PAGES
	TAD [-100	/MINUS A PAGE TO BE REPLACED BY 
	CLL RAL
	TAD [177	/A PAGE FULL OF LOCATIONS
	TAD TMP1
	JMS I [PWORD
	ISZ CNT		/IS THAT ALL THE SEGS?
	JMP .+5		/NO ... CONTINUE
	JMS I [CRLF
	TAD [1177
	DCA LXR		/RESET INPUT POINTER
	JMP I [CONT	/
	ISZ SEGCNT	/IS THAT THE FOURTH SEGMENT?
	JMP .+4		/NO...CONTINUE
	JMS I [CRLF
	JMS I [CRLF
	JMP I [SEGSM2
	TAD [",
	JMS I [TYPIT
	TAD [240
	JMS I [TYPIT
	JMP SEGS
FLDTST,	ISZ COUNT	/IS THAT ALL THE SEGS?
	SKP CLA
	JMP I [ATEST	/IF SO PROCESS COMMAND
	TAD I XR		/SEARCH FOR FIELD ETC.	PAGE
	DCA TMP		/STORE SEGMENT ORIGIN
	TAD I XR
	DCA FLD		/STORE SEGMENT'S SECOND WORD
	JMS TFIELD	/ADJUST FIELD...
	CIA		/RETURNS WITH FIELD IN AC
	TAD TEMP1	/IS IT THE SAME FIELD AS INPUT?
	SPA 		/OR IS IT LESS THAN FIELD OF INPUT?		
	JMP FLDTST	/NEITHER...
	SZA CLA		/IF IT IS LESS THAN INPUT'S FIELD
	JMP I [ATEST	/IT SHOULD BE AN ADD
	TAD FIRST2		/TEST INPUT'S ORIGIN
	CIA		/IS IT LESS THAN OR EQUAL TO SEGMENT'S ORIGIN?
	TAD TMP
	SNA
	JMP I [STEST	/IF EQUAL TEST FOR DELETION
	SMA CLA
	JMP I [ATEST	/IF LESS TEST FOR ADDITION
	JMP FLDTST	/OTHERWISE CHECK NEXT SEGMENT
TFIELD,	0	/ROUTINE TO TRANSFORM FIELDS FOR TYPING
	TAD FLD
	AND [76
	CLL RTR
	SZL		/ISOLATE BANK BIT "A"
	TAD [40
	CLL RAR
	SZL		/ISOLATE BANK BIT "B"
	TAD [10
	JMP I TFIELD
SEGADJ,	0		/ROUTINE TO ORGANIZE CCB SEGMENT SECOND WORD
	TAD FIRST2	/CALCULATE NUMBER OF PAGES
	CIA
	TAD TEMP2	/BY DIFFERENCING THE INPUT ADDRESSES
	AND [7600
	CLL RAR		/AND HALVING INTO PAGES
	DCA FIRST2	/STORE FOR CCB LOAD

	TAD TEMP1	/ADD IN FIELD
	JMS CCBFLD	/RE-ORGANIZE IT FOR CCB
	TAD FIRST2	/COMBINE FIELD AND PAGES FOR CCB SEGMENT
	JMP I SEGADJ
CCBFLD,	0		/ROUTINE TO CHANGE FIELD INTO CCB FORM
	CLL RTR		/STARTS WITH A '37' IN AC
	RTR
	SZL		/TEST FOR B BANK BIT
	TAD [400
	CLL RAR
	SZL		/TEST FOR A BANK BIT
	TAD [100
	CLL RTR
	RTR
	RAR		/RETURN WITH A '76' IN AC
	JMP I CCBFLD
MOVE,	JMS MOVA	/MOVE TIME
	TAD BUMP	/IF YES, RESET SEGMENT NUMBER
	TAD I [1400
	DCA I [1400
REMOVE,	TAD [1403	/REPLACE ORIGINAL SEGS
	DCA NXR
	TAD [1603		/WITH UPDATED ONES
	DCA XR
	TAD I [1400
	DCA COUNT		/SET COUNT TO THE NUMBER OF SEGS
	JMS MOVA
	JMP I [ENDTST
MOVA,	0
	TAD COUNT	/WAS THE SEGMENT ADDED ON THE END?
	SNA CLA
	JMP I MOVA	/IF SO, RETURN
	TAD I XR	/MAKE THE MOVE
	DCA I NXR
	TAD I XR	/BE SURE TO GET BOTH WORDS
	DCA I NXR
	ISZ COUNT	/IS THAT ALL THE SEGMENTS?
	JMP .-5		/IF NO, CONTINUE
	JMP I MOVA
NEXTLN,	CLL CLA		/ROUTINE TO ACCEPT NEW INPUT LINE
	DCA DIGFLG	/ZERO DIGIT FLAG
	DCA DLID	/CLEAR DELIMITER STORAGE
	TAD [1177	/RESET INPUT POINTER
	DCA LXR
	JMP I [CONT	/CONTINUE INPUT CODE
	PAGE
	*1710
	/LOCATIONS 1600-1710 ARE USED AS THE CORE CONTROL BLOCK BUFFER
DELETE,			/TTY DELETION COMMAND
	CLL CLA
	TAD LXR
	TAD [-1177	/WAS THERE INPUT?
	SNA CLA
	JMP RBSPCL	/NO INPUT--PREPARE FOR SOME...
	TAD ["\		/PRINT ERASE DELIMITER
	ISZ RBFLG	/TEST TO SEE IF THIS IS THE FIRST RUBOUT
	JMS I [TYPIT	/IT IS
	CLA CMA		/SET RUBOUT FLAG
	DCA RBFLG
	CMA
	TAD LXR
	DCA TX		/PRINT ERASED CHARACTER
	TAD I TX
	JMS I [TYPIT
BACKUP,	CLA CMA
	TAD LXR
	DCA LXR
	KCC
	JMP I [REATTY
RBSPCL,	ISZ RBFLG	/HAVE ANY CHARACTERS BEEN ERASED?
	JMP I [CONT		/NO...PREPARE FOR INPUT
	TAD ["\
	JMS I [TYPIT
	DCA DIGFLG	/RESET DIGFLG
	JMP I [CONT
LFEED,	JMS I [CRLF
	TAD [243	/TYPE I.D.(#) CHARACTER
	JMS I [TYPIT
	TAD [1177
	DCA NXR
	JMP .+3
FEEDER,	TAD I NXR
	JMS I [TYPIT
	TAD LXR
	CIA
	TAD NXR
	SZA CLA
	JMP FEEDER
	KCC
	JMP I [REATTY
BARG,	JMS I [PRMSG
	TEXT /BAD ARGS/ 
	JMP I [NEXTLN
SEGNO,	0
	TAD I [1400	/ACCES NUMBER OF SEGMENTS
	CLL RAL		/ADJUST EXTENDED MEM BIT
	STL RAR
	TAD [32
	SPA CLA		/ARE THERE MORE THAN 32?
	JMP REDERR
	JMP I SEGNO
	PAGE


	*2000

VERMSG,	0
	JMS I [PRMSG
	TEXT / ATTENTION! THE NEW CCB WILL BE WRITTEN DIRECTLY ONTO /
	JMS I [CRLF
	JMS I [PRMSG
	TEXT /THE SPECIFIED INPUT FILE.(SEE SOURCE CODE)/
	JMP I VERMSG

WRCCB,	JMS I [SEGNO		/DID WE EXCEED SEGMENT LIMIT?
	JMS I [7607	/WRITE CCB
	4201
	1200		/FROM 1200
	37		/TO BLOCK '37'
	JMP REDERR
	TAD I (STFLE
	DCA WRFLE
	JMS I [7607
	4101
	1400
WRFLE,	0
	JMP REDERR
	JMP I ERR

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/TECO.PA. 
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
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222

/10 OS/8 TECO VERSION 5
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974,1975,1976,1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/BROUGHT TO YOU BY: RUSS HAMM, O.M.S.I., AND RICHARD LARY (IN THAT ORDER)
/WITH ASSISTANCE FROM MARIO DENOBILI OF THE P?S
/PATCHES INCORPORATED BY S.R. ON 5-AUGUST-75 FOR OS/8 V3C:

/1.	UPDATED VERSION # TO V4
/2.	INCORPORATED PATCHES #S 1 & 2 (V302 AND V303)
/	PREVENTS \ FROM GOING OUTSIDE OF BUFFER
/	RESETS CFLAG TO PREVENT ARGUMENT ERROR EVERY 4096 TIMES IN LOOP

/	CHANGES FOR V5: -S.R.-

/3.	ADDED OVERLAYS
/4.	EXPANDED ERROR MESSAGES
/5.	DOCUMENTED CORE LAYOUT
/6.	ADDED "T, "S, "F, "U, AND "R
/7.	FIXED EG BUG
/8.	MADE DEFAULT ITERATION COUNT TRULY INFINITE
/9.	ADDED N^T
/10.	ADDED :=
/11.	ADDED SOME SAFETY ERROR MESSAGES
/	(I)	ERROR IF Y HAS A NUMERIC ARGUMENT
/	(II)	ERROR IF TWO ARGUMENTS ARE SPECIFIED TO D
/12.	REMOVE ^R (OBSOLETE COMMAND)
/13.	REMOVE "A AND "B (AFTER AND BEFORE)
/14.	ADDED 13-BIT ARITHMETIC
/15.	MADE = AND \ GIVE SIGNED RESULTS (DECIMAL ONLY)
/16.	ALLOW 13-BIT NUMERIC Q-REGISTERS.
/	THIS IS ACCOMPLISHED BY RESERVING THE HIGH ORDER BIT
/	OF THE LENGTH WORD.  STRING PORTION OF Q-REGISTER
/	NOW RESTRICTED TO 2047 CHARACTERS.  IT GETS CHECKED BY
/	^U AND X.  BELL RINGS WITHIN 12 CHARACTERS OF FILLING
/	UP COMMAND STRING Q-REGISTER.
/17.	STORED LINK AS LOW ORDER BIT IN NLINK IN CASE WE EVER
/	WANT TO GO TO 24-BIT ARITHMETIC.
/18.	ERROR ON A,B,C
/19.	P DOESN'T CREATE FORM FEEDS
/20.	ALLOW @ MODIFIER WITH ER, EW, EB.
/21.	EK
/22.	^S FREEZE
/23.	EGTEXT$
/24.	GOT RID OF F_
/25.	F IS ILLEGAL IF NOT FOLLOWED BY S OR N
/26.	W IS NOW AN ILLEGAL COMMAND (EXCEPT ON -12)
/27.	ADDED :G
/28.	Y AND _ GIVE ERRORS IF DATA IS GOING TO BE LOST
/	(IF OUTPUT FILE IS OPEN AND BUFFER IS NOT EMPTY)
/29.	CASE FLAGGING IMPLEMENTED
/30.	"< AND "> ARE SYNONYMOUS WITH "L AND "G
/31.	^G<SPACE> AND ^G*
/32.	SCOPE RUBOUTS
/33.	== NOW PRINTS NUMBER IN OCTAL
/34.	EUFLAG AND ETFLAG IMPLEMENTED
/35.	CASE FLAGGING WORKS
/36.	IMAGE MODE (ET BIT 11) APPLIES TO T, ^A, AND N^T
/	IT DOES NOT APPLY TO :G
/37.	ERROR IF TRY TO DO AN EB TO A .BK FILE (IT DOES AN ER)
/38.	VT AND FF ARE NOW LINE TERMINATORS
/39.	BELL ECHOES AS ^G AS WELL AS RINGING BELL
/40.	^K IS AN ERROR
/41.	REMOVED ^Z COMMAND
/42.	CHANGED ^V TO EO
/43.	CHANGED ^W TO W
/44.	MEMORY RESIDENT OVERLAYS IF MORE THAN 12K
/45.	LONG FORM ERROR MESSAGES ON 1EH
/46.	ET FLAG 8'S BIT AFFECTS ECHOING OF ^T
/47.	NEGATIVE OR 0 ITERATION SKIPS
/48.	CTRL/N
/49.	CTRL/C TRAP

/KNOWN BUGS
/1.	LARGE T OR X AND ONLY 1 BLOCK LEFT IN OUT DEV
/2.	^S DOESN'T KEEP SCREEN ON
/3.	FIX BATCH INTERRACTION
/4.	MAKE VT AND FF SIMULATION INDEPENDENT OF TAB

	DECIMAL
VERSN=	5	/ VERSION NUMBER - CHANGE WITH EVERY EDIT 
	OCTAL	/ LAST EDIT  12-FEB-76  
IN=	6200		/INPUT BUFFER AT 06200
OUT=	5200		/OUTPUT BUFFER AT 05200
ZMAX=	7640		/MAX 4000[10] CHARACTERS IN TEXT BUFFER
QMAX=	3720		/MAX 2000[10] Q-REGISTER CHARS IN 8K
Q12MAX=	5600		/MAX 2944[10] Q-REGISTER CHARS IN 12K
CHNSTR=	46		/38 CHARACTER STRING PASSED ON CHAIN

TWO=	CLA CLL CML RTL
MTWO=	CLA CLL CMA RAL
MTHREE=	CLA CLL CMA RTL
AC3777=	CLL STA RAR
SCPBIT=	7726
/THINGS WE WOULD LIKE TO ADD:

/:ER
/:EB
/NV
/@^A
/FR
/-S
/::S
/^EQ
/M,NS
/[Q
/]Q
/NON-EXACT SEARCH MODE
/*N
/ERFILESPEC/S FOR SUPERTECO
/^N
/CHECK FOR $ ON NI$
/CHECK INTO SEARCHES IN ITERATIONS
/ERR MSG ON EA, EP
/NV=(1-N)TNT
/^C TRAP
/:X

/THINGS FOR -11:
/^R
/3EH
/M,ND
/ET BIT 15 SHOULD BE LOWER
/ECHO OF NULL
/*****************************************
/	TECO ERROR MESSAGES:
/*****************************************

/	TECO ERROR MESSAGES CONSIST OF A QUESTION MARK AND THREE LETTERS
/	TYPING "?" IMMEDIATELY AFTER AN ERROR MESSAGE PRINTOUT PRINTS
/	THE CURRENT COMMAND LINE UP TO THE ERROR CHARACTER.

/1	?ILL	ILLEGAL COMMAND
/2	?UTC	INCOMPLETE COMMAND (PDL NOT EMPTY AT END OF COMMAND STRING)
/3	?IQN	NON-ALPHANUMERIC Q-REGISTER NAME
/4	?PDO	PUSHDOWN OVERFLOW (MACROS & ITERATIONS NESTED TOO DEEPLY)
/5	?MEM	TEXT BUFFER OVERFLOW
/6	?STL	SEARCH STRING TOO LARGE ( >31 CHARS)
/7	?ARG	NUMBER MISSING BEFORE COMMA
/		OR TWO ARGUMENTS SPECIFIED TO D
/		OR 3 NUMERIC ARGUMENTS
/8	?IFN	ILLEGAL FILE NAME IN "ER","EW" OR "EB" COMMAND
/9	?SNI	SEMICOLON ON COMMAND LEVEL
/10	?BNI	ITERATION CLOSE (>) WITHOUT MATCHING OPEN (<)
/11	?POP	ATTEMPT TO MOVE POINTER OUTSIDE OF TEXT BUFFER
/12	?QMO	Q-REGISTER STORAGE OVERFLOW
/13	?UTM	INCOMPLETE COMMAND (PDL NOT EMPTY AT END OF MACRO)
/14	?OUT	OUTPUT FILE TOO BIG OR OUTPUT PARITY ERROR
/15	?INP	PARITY ERROR ON INPUT FILE
/16	?FER	FILE ERROR: CAN MEAN EITHER
/		A)	INPUT FILE NOT FOUND ON "ER" COMMAND
/		B)	CANNOT ENTER OUTPUT FILE ON "EW" OR "EB" COMMAND
/		C)	DEVICE SPECIFIED FOR FILE DOES NOT EXIST
/		D)	"EB" COMMAND GIVEN ON NON-FILE-STRUCTURED DEVICE
/17	?FUL	OUTPUT COMMAND WOULD HAVE OVERFLOWED OUTPUT FILE
/		[PANIC MODE]
/18	?NAY	NUMERIC ARGUMENT SPECIFIED WITH Y COMMAND
/19	?IEC	E FOLLOWED BY AN ILLEGAL CHARACTER
/20	?IQC	" FOLLOWED BY AN ILLEGAL CHARACTER
/21	?NAE	NO NUMERIC ARGUMENT TO THE LEFT OF AN =
/22	?NAU	NO NUMERIC ARGUMENT TO THE LEFT OF A U
/23	?NAQ	NO NUMERIC ARGUMENT TO THE LEFT OF A "
/24	?SRH	FAILING SEARCH AT COMMAND LEVEL
/25	?NAP	NEGATIVE OR ZERO ARGUMENT TO P
/26	?NAC	NEGATIVE ARGUMENT TO COMMA
/27	?NYI	CASE SUPPORT NOT IMPL (USE W FOR WATCH)
/28	?
/29	?NAS	NEGATIVE OR ZERO ARGUMENT WITH A SEARCH
/30	?WLO	WRITE LOCKED SYSTEM DEVICE
/31	?IFC	F FOLLOWED BY AN ILLEGAL CHARACTER
/32	?YCA	Y (OR _) COMMAND ABORTED BECAUSE DATA WOULD BE LOST
/33	?CCL	CCL NOT FOUND OR EG ARGUMENT TOO LONG
/34	?XAB	EXECUTION ABORTED BY ^C
/35	?NYI	CASE SUPPORT NOT IMPL (USE EO FOR VERSION)
/36	?NFO	ATTEMPT TO OUTPUT WITHOUT OPENING AN OUTPUT FILE
/	CORE LAYOUT AND OVERLAY STRUCTURE

/	BUFFER STRUCTURE:

/BUFFER		8K VERSION	12K VERSION

/INPUT  BUFFER	06200-07200	25600-27600
/OUTPUT BUFFER	05200-06200	05200-07200
/Q-REG STORAGE	OVER TEXT BFR	20000-25600

/	HANDLER LOCATIONS:

/HANDLER	PDP-8 VERSION	PDP-12 VERSION

/INPUT  HANDLER	7200-7600	7200-7400
/OUTPUT HANDLER	4000-4400	7400-7600
/SIZE OF HNDLR	2-PAGES		1-PAGE
/DISPLAY CODE	NONE		4000-4400

/	OVERLAY STRUCTURE

/ALL OVERLAYS ARE TWO PAGES LONG AND RESIDE IN CORE
/AT LOCATIONS 3200-3600 WHEN RUNNING.  THE I-OVERLAY
/INITIALLY RESIDES IN THESE LOCATIONS.

/OVERLAY	BLOCK	INITIAL LOCATION	CONTENTS

/  I-OVERLAY	40	3200-3600	ER,EW,EB
/  Q-OVERLAY	41	5600-6200	", O, SKPSET
/  E-OVERLAY	42	6200-6600	ERROR MESSAGE PROCESSOR
/  X-OVERLAY	43	6600-7200	EX,EC,EG,EK,EF (EA,EI,EN,EP)
/  F-OVERLAY	44	7200-7600	ED,EH,EO,ES,ET,EU (EV)

	IOVRLC=40
	QOVRLC=41
	EOVRLC=42
	XOVRLC=43
	FOVRLC=44

	IOVRLY=3200
	QOVRLY=3201
	EOVRLY=3202
	XOVRLY=3203
	FOVRLY=3204

/EACH OVERLAY IS ASSIGNED A LOCATION AT THE BEGINNING OF PAGE 3200.
/IF THIS LOCATION IS 0 (AS IT ALWAYS IS), THEN THAT OVERLAY IS NOT
/IN CORE.  IF IT IS NOT 0, THEN THIS LOCATION CONTAINS THE
/BLOCK NUMBER TO READ IN THAT OVERLAY.
/THUS EACH OVERLAY HAS POINTERS TO ALL THE OTHER OVERLAYS.
	MEMLOC=2000

/IN 16K MACHINES, FIELD 3 IS USED TO HOLD OVERLAYS

/NAME	BLOCK	MEMORY

/I	40	2000
/Q	41	2400
/E	42	3000
/X	43	3400
/F	44	4000


/INITIAL MEMORY LAYOUT

/0000-3177	TECO
/3200-3577	OVERLAY AREA (INITIALLY I-OVERLAY)
/3600-3777	TECO
/4000-4377	PDP-12 DISPLAY ROUTINE
/4400-5177	TECO
/5200-5577	INITIALIZATION CODE
/5600-6177	Q-OVERLAY CODE
/6200-6577	E-OVERLAY CODE
/6600-7177	X-OVERLAY CODE
/7200-7577	F-OVERLAY CODE

/FIELD 1:

/4400-7377	EXTENDED ERROR MESSAGES
/		MOVES TO FIELD 3
/**  TECO KLUDGES **		/7/27/73
/ONE OF THE REASONS WHY TECO GETS SO MANY OPERATIONS
/INTO SUCH A SMALL AMOUNT OF CORE IS THAT IT
/IS FULL OF *K*L*U*D*G*E*S*.  THESE SHOULD BE KEPT IN MIND WHEN
/MODIFYING THE PROGRAM.  SOME OF THEM ARE:

/	THE "SORT" ROUTINE COMPARE LIST MUST END WITH A NEGATIVE NUMBER.
/	USUALLY A FORTITUOUS JMS OR OPR INSTRUCTION IS USED

/	THE "SORT" JUMP LIST ENTRIES ARE TREATED AS JUMP ADDRESSES
/	IF THEY ARE POSITIVE AND SUBSTITUTE VALUES IF THEY ARE
/	NEGATIVE - THEREFORE ALL LOCS JUMPED TO MUST BE BELOW 4000
/	ANOTHER CONSEQUENCE IS THAT "QUOTST" CANNOT BE CALLED FROM
/	ABOVE 4000

/	THERE ARE OTHER LOCALIZED KLUDGES - THEY CAN GENERALLY
/	BE IDENTIFIED BY THE APPEARANCE OF A DOUBLE-ASTERISK IN THE
/	COMMENTS FIELD ALONG WITH A TERSE DESCRIPTIVE COMMENT



/	OS/8 EQUIVALENCES:

JSBITS=	7746	/JOB STATUS BITS - IN FIELD 0
OSHNDT=	7647	/OS/8 DEVICE HANDLER TABLE - IN FIELD 1
OSDCBT=	7760	/OS/8 DEVICE CONTROL TABLE - IN FIELD 1
CCLADR=	400	/CCL OVERLAY LOAD ADDRESS
CCLOVL=	67	/BLOCK OF CCL OVERLAY
CCLOST=	602	/CCL OVERLAY SECONDARY START ADDRESS
	*0
NAME,	ZBLOCK	4	/NAME BUILD BUFFER - MUST BE AT LOCATION 0
			/LOCS 4,5&6 ARE RESERVED SO WE CAN USE OS/8 ODT

	*10	/CONSTANTS & NON-INDIRECT TEMPS STORED IN AUTO-XRS!
QUOTE,	33	/QUOTE CHAR - SINGLE WORD SORT LIST
ERR01,
SERR,	ERR	/END OF LIST
INRSIZ,	2	/4 IF 12K MACHINE
NUMLNS,	3	/NUMBER OF LINES (+ AND -) TO DISPLAY ON VR12 SCOPE
DX,	7577	/DISPLAY XR
SXR,	QPUT12-1/XR USED BY SEARCH PROCESSOR
INXR,	ASR33-1	/XR USED TO UNPACK INPUT BUFFER
XR,	ASR35-1	/WORK XR

NMT,	0	/USED  AS NUMBER TEMP AND SEARCH FAIL FLAG
CFLG,	0	/COMMA FLAG
CLNF,	0	/COLON FLAG
TFLG,	0	/TRACE FLAG
NFLG,	0	/NUMBER FLAG
QFLG,	0	/QUOTED STRING FLAG
M,	0	/NUMBER ARGS
N,	0
NLINK,	0	/LINK AFTER ARITH OPERATIONS - TESTED BY "A AND "B
CHAR,	0	/CHARACTER BUFFER
ITRST,	0	/ITERATION FLAG
ITRCNT,	0	/ITERATION COUNT
MPDL,	0	/MACRO FLAG
SCHAR,	0	/LAST CHAR SORTED
FFFLAG,	0	/FORM FEED FLAG - 7777 IF FORM FEED SEEN ON THIS READ
REND,	0	/INPUT END-OF-FILE FLAG
SCANP,	0	/COMMAND LINE EXECUTION POINTER
OSCANP,	0	/BACKUP FOR SCANP
PDLP,	PDLBEG	/PUSH-DOWN-LIST POINTER
QCMND,	0	/COMM LINE OR MACRO POINTER
P,	0	/CURRENT PNTR TO TEXT BUFFER
ZZ,	0	/END OF TEXT BUFFER POINTER
Q,	0	/EXTRA BUFFER POINTERS
	IFNZRO .-47 <_ERROR_>
R,	0
QP,	0	/Q REGISTER POINTER
QZ,	CHNSTR	/END OF Q-REG POINTER
Z7,
CTLBEL,	7
CACR,	15	/CR
CAHT,	11	/HT
CAAM,	33	/ALT MODE
CAFF,	14	/FF: END OF PAGE
	13	/VT
CALF,	12	/LF
ERR07,
NERR,	ERR	/END OF LIST
RADIX,	DRAD	/RADIX TABLE POINTER - DRAD OR ORAD
MQ,	0
DVT1,	0
ODEV,	0	/OUTPUT DEVICE NUMBER
OUTHND,	0
INHND,	0
EBFLG,	0	/EDIT BACKUP FLAG
QNMBR,	0	/LAST Q-REG REFERENCED
QBASE,	0	/BASE OF CURRENT COMMAND LINE
QLENGT,	0	/LENGTH OF CURRENT COMMAND LINE
QPTR,	0	/POINTER TO Q-REGISTER CONTROL BLOCK
ICRCNT,	0	/INPUT DOUBLEWORD COUNTER
OCRCNT,	0	/OUTPUT "
OPTR2,	0	/OUTPUT BUFFER POINTER
INRCNT,	0	/NUMBER OF INPUT RECORDS LEFT
OCMDLN,	0	/LENGTH OF OLD COMMAND LINE
CDT,	0
KTYPE,	TYPE		/*ET SET TO PUTT IF NO CONVERSION
TEMPT,	0		/TEMP.  GET RID OF WHEN FIND ROOM ON PAGE
MEMSIZ,	0		/HIGHEST MEMORY FIELD IN BITS 9-11
LASTC,	0		/LAST CHARACTER GOTTEN OUT OF COMMAND LINE

/NFLG:	0'ED BY COMMANDS WHICH EAT ARGUMENTS OR DON'T RETURN
/	VALUES; SUCH AS C,R,J,L,^A,X,$,',>,'U,G,O AND
/	NON-COLON MODIFIED SEARCHES
/	SET TO -1 TO INDICATE THATWWE'VE SEEN A NUMBER
	/TECO PSEUDO-OPERATIONS

PUSH=	JMS I	.;	PUSHXX
POP=	JMS I	.;	POPXX	/** MUST BE ONE MORE THAN "PUSH"
PUSHJ=	JMS I	.;	PUSHJY
POPJ=	JMP I	.;	POPJXX
PUSHL=	JMS I	.;	PUSHLX
POPL=	PUSHL			/** POPL CALLED WITH POSITIVE AC

ERR=	JMS I	.;ERROR,ERRXX
SORT=	JMS I	.;	SORTB
RESORT=	JMP I	.;	SORTA2
SCAN=	JMS I	.;	SGET
LISTEN=	JMS I	.;	TYI
TYPE=	JMS I	.;	TYPCTV
OUTPUT=	JMS I	.;OUTR,	ERRXX	/** MUST BE ONE MORE THAN "TYPE"
				/PROBABLY NOT ANY MORE (19-JUN-77)
CRLF=	JMS I	.;	TYCRLF
GETQ=	JMS I	.;	GETQX
SKPSET=	JMS I	.;	SETSKP
NCHK=	ISZ	NFLG		/USED TO BE A SUBROUTINE CALL
CTCCHK=	JMS I	.;	CHKCTC
BZCHK=	JMS I	.;	CHKBZ
QCHK=	JMS I	.;	CHKQF
QSKP=	JMS I	.;	QOVER
QREF=	JMS I	.;	QREFER
QSUM=	JMS I	.;	QSUMR
QPUT=	JMS I	.;	QPUTS
QUOTST=	JMS I	.;	QTST
SETCMD=	JMS I	.;	CMDSET
GETN=	JMS I	.;	NGET
ADJQ=	JMS I	.;	QADJ
MQLDVI=	JMS I	.;	DVIMQL
UPPERC=	JMS I	.;	CUPPER
SCANUP=	JMS I	.;	SCUPPR
TSTSEP=	JMS I	.;	SCHSRT
DISPLY=	JMS I	.;	DSPLAY
NOTRCE=	JMS I	.;	SAVTRA
ENTRCE=	JMS I	.;	RESTRA
OVRLAY=	JMS I	.;	OVERLY
GETNUM=	JMS I	.;	NUMGET	/GET 13 BIT NUMBER INTO L,AC
PUTT=	JMS I	.;	TPUT
	PAGE
/ENTER HERE TO USE AN ASR33 AS THE TELETYPE

TECO,	ISZ I	SPUT	/IF CALLED BY "R" OR "RUN" - CHANGED TO TLS
TECO1,	JMP I	COMPAR	/IF CALLED VIA "CHAIN" - CHANGED TO "JMP T0A"
TBEL,	JMS	COMPAR	/HERE ON ^G - 2 ^G'S KILL ENTIRE COMMAND

T0,	CRLF
T0A,	TAD	(PDLBEG
	DCA	PDLP	/INITIALIZE PUSHDOWN LIST
T1,	TAD	PDLP
	TAD	(-PDLBEG
	SZA CLA
ERR02,	ERR		/ERROR - PUSHDOWN LIST DID NOT BALANCE
	TAD	(45
	QREF		/SET UP POINTERS TO COMMAND LINE
	TAD I	[QPNTR
	DCA	OCMDLN	/SAVE OLD COMMAND LINE LENGTH
			/** SAVE ONLY IF < 20?
	ADJQ		/REDUCE COMMAND LINE LENGTH TO 0
	CLL
	PUSHJ
		NRET	/CLEAR NUMBER AND LAST OPERATOR
	DCA	CFLG
	DCA	MPDL	/DELETE MACRO FLAG
	DCA	ITRST	/ALSO ITERATION FLAG,
	DCA	CLNF	/AND COLON FLAG
	PUSHJ		/KILL QUOTE FLAG
		ZROSPN	/KILL QUOTE AND NUMBER FLAGS AND SCAN POINTER
	KCC		/KILL ^O IF IN KEYBOARD BUFFER
	DCA I	(CHOOPS	/KILL FATAL ERROR RETURN
	TAD	[52
	SKP
ROCMND,	JMS I	(BACKUP	/BACK UP AND GET LAST CHAR
	TYPE
T2M1,	DCA	CHAR	/KILL CHAR TO PREVENT SPURIOUS DOUBLE CHARACTERS
T2,	LISTEN		/BUILD COMMAND LINE
	SORT
		COMLST
		COMTAB-COMLST
T2A,	DCA	CHAR
	JMS	SPUT	/PUT INTO C.L. BUFFER
	JMP	T2	/GO GET ANOTHER
TCTLU,	TAD	SCHAR
	TYPE		/PRINT "^U"
TCTLUP,	JMS I	(BACKUP
	TAD	[-12	/CHECK FOR LF
	SZA CLA
	JMP	TCTLUP	/LOOP UNTIL LF
	IAC
	JMP I	(TSP9

TCRLF,	TAD	CACR	/CR IN COMM LINE
	DCA	CHAR
	JMS	SPUT	/PUT INTO COMM LINE
	TAD	CALF	/THEN PUT IN A LF
	JMP	T2A	/AND GET SOME MORE
	/COMMAND EXECUTION LOOP

TALTM,	JMS	COMPAR	/2ND ALTM STARTS EXECUTION
	CRLF		/START COMM EXECUTION
CHTECO,	TAD	(45	/NUMBER OF INPUT COMMAND Q-REGISTER
	SETCMD		/SET UP THE INPUT LINE AS THE CURRENT COMMAND LINE
T6,	SCANUP
T6A,	DCA	CHAR	/SAVE COMMAND CHAR
	TAD	CHAR
	TAD	(CDSP	/ADD BASE OF DISPATCH TABLE
	DCA	T7	/LOOK UP ENTRY IN
	TAD I	T7	/COMMAND DISPATCH TABLE
	DCA	T7	/CALL RECURSIVELY
	CLL
	PUSHJ
T7,		0	/CALL TO ROUTINE
	CTCCHK		/CHECK FOR ^C - ** AC MAY NOT BE 0 HERE **
	CLA		/CTCCHK LEAVES AC NON-ZERO
	TAD	NFLG
	SPA CLA
	JMP	T6
	DCA	N	/IF WE ARE NOT ENTERING A NUMBER
	DCA	NLINK	/SET 13-BIT N TO 0
	JMP	T6	/KEEP INTERPRETING
TQMK,	TAD I	ERROR
	SNA CLA		/ERROR ROUTINE ENTRY POINT NON-ZERO?
	RESORT		/NO
	STA		/AN ERROR PRINTOUT
	DCA	QLENGT	/SET QLENGT BIG SO WE CAN ACCESS ENTIRE LINE
	NOTRCE		/TURN TRACE OFF
	SCAN
	TYPE		/PRINT OUT THE LINE WHICH CAUSED THE ERROR
	ISZ I	ERROR	/UP TO THE ERROR CHAR ITSELF
	JMP	.-3
	JMP	T0	/RE-INITIALIZE

CHUA,	POP		/^ COMMAND - POP OFF RETURN ADDRESS
	SCANUP		/GET THE NEXT CHARACTER IN UPPER CASE
	AND	[77	/MAKE IT A CONTROL CHARACTER
	JMP	T6A	/USE IT INSTEAD OF THE ^
COMPAR,	TCINIT		/LOOK FOR DOUBLED COMM LINE CHARS
	TAD	SCHAR	/MOST RECENT
	CIA
	TAD	CHAR	/PREVIOUS
	SZA CLA
	RESORT		/NOT THE SAME
	JMS	SPUT	/PUT THE CHAR INTO THE COMMAND LINE AND ECHO IT
	JMP I	COMPAR	/SAME-SPECIAL HANDLING

SPUT,	JTECO		/PUT CHAR INTO COMM LINE
	TAD	QZ
	DCA	QP
	TAD	CHAR
	QPUT		/STORE CHARACTER AWAY
	TAD I	[QPNTR
	IAC
	ADJQ		/ADJUST COMMAND LINE REGISTER LENGTH
	DCA I	ERROR	/CLEAR "ERROR JUST OCCURRED" FLAG
	TAD	CHAR
	TYPE		/TYPE THE INSERTED CHARACTER
	TAD I	[QPNTR
	TAD	CALF	/12
	SPA CLA
	JMP	EMERG	/TYPE BELL IF WITHIN 12 CHARACTERS OF 2048
	CLL
	TAD	QZ
	TAD	QLIMIT
	SNL CLA		/TYPE A BELL IF THE LINE IS
	JMP I	SPUT	/ WITHIN 12 CHARS OF OVERFLOW
EMERG,	TAD	Z7
	TYPE
	JMP I	SPUT
QLIMIT,	12-QMAX
	PAGE
	/Q REGISTER PACK AND UNPACK
	/THE Q-REGISTERS ARE STORED IN THE UPPER 4 BITS OF THE WORDS
	/WHICH HAVE THE TEXT BUFFER CHARACTERS IN THEIR LOWER 8 BITS.
	/THEREFORE EACH Q-REGISTER CHARACTER TAKES 2 WORDS.

QPUTS,	0		/STORE THROUGH POINTER "QP" AND BUMP POINTER
	CLL RTL
	RTL
	DCA	GETQX	/SAVE CHARACTER
	TAD	QP
	CLL RAL
	DCA	CHKCTC	/COMPUTE CORE POINTER = 2*QP
	CDF 10
	TAD	GETQX
	JMS	ST4BTS	/STORE HIGH ORDER 4 BITS
	ISZ	CHKCTC
	TAD	GETQX
	CLL RTL
	RTL
	JMS	ST4BTS	/STORE LOW ORDER 4 BITS
	CDF 0
	ISZ	QP	/BUMP POINTER
	JMP I	QPUTS

GETQX,	0
	CLL RAL
	DCA	CHKCTC	/COMPUTE CORE POINTER = 2*AC
	CDF 10
	TAD I	CHKCTC
	AND	[7400	/FETCH HIGH ORDER
	ISZ	CHKCTC
	DCA	QPUTS
	TAD I	CHKCTC
	AND	[7400	/FETCH LOW ORDER
	CLL RTR
	RTR
	TAD	QPUTS	/COMBINE TO FORM CHARACTER
	RTR
	RTR
	CDF 0
	JMP I	GETQX

ST4BTS,	0
	AND	[7400
	DCA	POPXX
	TAD I	CHKCTC
	AND	[377
	TAD	POPXX
	DCA I	CHKCTC	/STORE HIGH ORDER
	JMP I	ST4BTS
CHKCTC,	0		/SUBROUTINE TO CHECK FOR ^C IN KEYBOARD
	CLA OSR		/** AC MAY NOT BE 0 ON ENTRY
	DCA	QPUTS	/GET LOCATION FROM SWITCH REGISTER
	TAD I	QPUTS
	7421		/DISPLAY INDICATED LOCATION IN MQ
C7600,	7600		/JUST IN CASE THERE IS NO MQ
	KSF
	JMP I	CHKCTC	/NO CHAR IN KEYBOARD BUFFER - EXIT
	KRS
	AND	[177	/KILL PARITY BIT
	TAD	[-20	/^P OUGHT TO GO AWAY
	SZA
	TAD	CACR
	SZA		/^C?
	JMP I	CHKCTC	/NO - RESUME WITH NON-ZERO AC
ERR34,	ERR		/^C, EXECUTION ABORTED

CTLC,	TSF
	JMP	CTLC	/WAIT FOR TELETYPE TO DIE DOWN
	JMP I	C7600	/RETURN TO OS/8


POPJXX,	DCA	GETQX	/POPJ ROUTINE
	POP
POPJXY,	DCA	POPXX
	TAD	GETQX
	JMP I	POPXX
	/PUSH DOWN LIST ROUTINES

POPXX,	0		/POP ROUTINE
	CLA CMA
	TAD	PDLP
	DCA	PDLP
	TAD I	PDLP
	JMP I	POPXX

PUSHXX,	0		/PUSH ROUTINE (DOESN'T AFFECT LINK)
	DCA I	PDLP
	ISZ	PDLP	/BUMP PUSHDOWN POINTER
	TAD	PDLP	/CHECK FOR EXACTLY FULL - THIS ALLOWS THE
	TAD	(-PDLEND
	SNA CLA		/** ERROR ROUTINE TO DO A PUSHJ
ERR04,	ERR		/FULL - REPORT IT
	JMP I	PUSHXX

PUSHJY,	0		/PUSHJ ROUTINE (DOESN'T AFFECT LINK)
	DCA	GETQX
	IAC		/** LINK SHOULD BE PRESERVED ON EXIT
	TAD	PUSHJY
	PUSH
	TAD I	PUSHJY
	JMP	POPJXY

PUSHLX,	0		/PUSH AND CLEAR A LIST
	CLL
	SMA		/PUSH LIST IF AC<0, POP IT IF >=0
	CMA STL
	DCA	PUSHJY	/SET COUNTER
	RAL		/** DEPENDS ON FACT THAT POP=PUSH+1 **
	TAD	PUSHYY
	DCA	PUSHYX	/STORE EITHER A "PUSH" OR A "POP"
	POP		/SAVE RETURN POINTER
	DCA	CHKCTC
PUSHLP,	TAD I	PUSHLX
	DCA	GETQX
	TAD I	GETQX
PUSHYX,	PUSH		/PUSH OR POP
	DCA I	GETQX	/IF PUSHYX=PUSH, THIS ZEROES THE PUSHED LOCATION
	ISZ	PUSHLX
	ISZ	PUSHJY
	JMP	PUSHLP
	TAD	CHKCTC	/RESTORE RETURN POINTER
PUSHYY,	PUSH
	JMP I	PUSHLX
TPUT,	0		/TELETYPE OUTPUT
	DCA	TEMPT
TPUTX,	CTCCHK		/CHECK FOR ^C OR ^P
	TAD	(3-17	/INHIBIT PRINTING AS LONG AS THERE
	SNA		/IS A ^O IN THE KEYBOARD BUFFER.
	JMP I	TPUT
	TAD	(17-23	/CHECK FOR ^S
	SNA CLA
	JMP	TPUTX
	TSF		/WAIT FOR TELETYPE FLAG
TSFWT,	JMP	.-1	/WHILE WAITING, DISPLAY TEXT ON SCOPE
	TAD	TEMPT
	TLS
	CLA
	JMP I	TPUT
	PAGE
/POINTER MOVING COMMANDS - C,R,J,L

CHRJ,	DCA	NFLG	/COMMAND J
	GETNUM		/CAUSE NEG ARGUMENT TO GIVE A POP
	JMP	CLOQ

CHRR,	GETN		/GET LAST NUMBER, DEFAULT=(+ OR -)1
CHR1,	CML CIA		/NEGATE 13-BIT NUMBER
	SKP
CHRC,	GETN		/GET LAST NUMBER, DEFAULT=(+ OR -)1
	TAD	P	/OFFSET RELATIVE TO .
/
/	*** LINK NOT ALWAYS SET RIGHT
/
CLOQ,	BZCHK		/SEE IF IN RANGE B,Z
	DCA	P	/IN RANGE
DNN3,	CDF 0
	POPJ

CHRL,	GETN		/GET LAST NUMBER, DEFAULT=(+ OR -)1
CHRL1,	CDF 10
	SZL SNA
	JMP	LNEG
	CIA
	DCA	CDT
CHRLP,	TAD	P
	CIA
	TAD	ZZ
	SNA CLA		/IF WE ARE AT THE END OF THE BUFFER,
	JMP	DNN3	/RETURN
	JMS I	(CHLCMP	/COMPARE CHARACTER AGAINST LINE FEED
	ISZ	P
	JMP	CHRLP	/KEEP GOING UNTIL WE GET THERE OR OVERFLOW BUFFER
LNEG,	TAD	(-1
	DCA	CDT
CHRLM,	CLA CMA CLL
	TAD	P
	DCA	P	/MOVE POINTER BACKWARD 1
	SNL
	JMP I	(CHRLI	/OOPS - PAST THE BEGINNING OF THE BUFFER - RETURN
	JMS I	(CHLCMP	/COMPARE CHARACTER AGAINST LINE FEED
	JMP	CHRLM	/NOT SATISFIED YET - KEEP LOOPING

NUMGET,	0		/PUT 13-BIT NUMBER IN L,AC
	TAD	NLINK
	CLL RAR
	TAD	N
	JMP I	NUMGET
/D COMMAND AND PART OF ADJUST ROUTINE

CHRD,	ISZ	CFLG	/WAS THERE A COMMA?
	SKP		/NO
	JMP	NERR	/YES, 2 ARGS TO D
	GETN		/GET LAST NUMBER, DEFAULT=(+ OR -)1
	SNL		/SIGN BIT OF 13-BIT NUMBER IS IN LINK
	JMP	PLUSND	/+ND
	CLL CIA
	DCA	CDT	/-ND
	TAD	CDT
	PUSHJ		/DO (-)NC(+)ND
		CHR1
	TAD	CDT
	JMP	PLUSND

ADJ,	SNA		/ADJUST BUFFER + OR - N CHARS
			/TEST FOR NOTHING
	POPJ		/GO AWAY
	STL		/MOVE UP N CHARACTERS
	TAD	ZZ	/ADD TO MAX CHARACTER
	DCA	R	/NEW HIGHEST
	TAD	R	/SEE IF TOO HIGH
	TAD	(-ZMAX
	SNL SZA CLA	/TWO PLACES FOR OVERFLOW THERE
ERR05,	ERR
	TAD	ZZ
	DCA	Q
	TAD	R
	DCA	ZZ
	CDF 10
UPNL,	TAD	Q
	CIA
	TAD	P
	SNA CLA		/FINISHED?
	JMP	DNN3	/YES
	CMA
	TAD	Q
	DCA	Q
	CMA
	TAD	R
	DCA	R
	TAD I	Q	/GET A CHAR
L12K1,	AND	[377	/JMP .+5  IF 12K
	DCA	CHLTMP
	TAD I	R	/BE CAREFUL NOT TO
	AND	[7400	/DESTROY THE HIGH-
	TAD	CHLTMP	/ORDER 4 BITS
J12K1=	JMP	.
	DCA I	R	/AND PUT IT IN THE LOW PART OF THE TARGET WORD
	JMP	UPNL
/K COMMAND AND MORE OF ADJUST ROUTINE

CHRK,	JMS I	(NLINES	/CONVERT LINES TO CHARS
	DCA	CDT
	TAD	M	/SET POINTER
	DCA	P	/LOWER ARG
	TAD	CDT
PLUSND,	SNA
	POPJ		/IGNORE 0D
ADJ2,	CLL
	TAD	P	/MOVE DOWN N CHARACTERS
	SZL
	CLA CMA		/DETECT GROSS OVERFLOWS
			/** CHECK
	BZCHK
	DCA	Q	/N IN AC
	TAD	P
	DCA	R
	CDF 10
DNN1,	TAD	ZZ
	CIA
	TAD	Q
	SNA CLA		/FINISHED?
	JMP	DNN2
	TAD I	Q	/GET A CHAR
L12K2,	AND	[377	/JMP .+5  IF 12K
	DCA	CHLTMP
	TAD I	R	/BE CAREFUL NOT TO
	AND	[7400	/DESTROY THE HIGH-
	TAD	CHLTMP	/ORDER 4 BITS
J12K2=	JMP	.
	DCA I	R	/AND PUT IT IN THE LOW PART OF THE TARGET WORD
	ISZ	Q
	ISZ	R
	JMP	DNN1
DNN2,	TAD	R
	DCA	ZZ
	JMP	DNN3

CHLTMP,	0

/GO TO ADJ TO MOVE UP TEXT
/GOTO ADJ2 TO MOVE DOWN TEXT
/IN EITHER CASE, AC CONTAINS NUMBER OF CHARS TO MOVE (0-4095)

ERR27,	ERR		/^W
ERR35,	ERR		/^V
	PAGE
/SEARCH SUBROUTINE - CALLED BY N, S, AND _ COMMANDS

SEARCH,	0
	DCA	REPFLG	/AC MAY BE NON-0 TO ALLOW A REPLACE
	GETN
	SZL SNA
ERR29,	ERR		/NEG OR 0 ARG TO SEARCH
	CIA
	DCA	CSN	/GET NUMBER OF OCCURRANCES TO SEARCH FOR
	QCHK		/GET REPLACEMENT FOR ALTMODE, IF ANY
	TAD	(STABLE-1
	DCA	SXR	/INITIALIZE XR
	TAD	[-40
	DCA	CSP
SGTLP,	QUOTST		/GET A CHARACTER FROM THE SEARCH STRING
	JMP	SCHQUO	/OOPS- NO MORE
	SORT		/SEE IF ITS SPECIAL
		SCHLST
		SCHTAB-SCHLST
SSTCHR,	DCA I	SXR	/STORE THE CHAR IN THE SEARCH BUFFER
	ISZ	CSP
	JMP	SGTLP	/LOOP
ERR06,	ERR		/OOPS - SEARCH BUFFER FULL!

SCHQUO,	TAD	CSP
	TAD	[40	/A NULL SEARCH STRING MEANS USE THE
	SZA CLA		/PREV CONTENTS OF THE SEARCH BUFFER, ELSE
	DCA I	SXR	/STORE TERMINATING 0 AND BEGIN THE SEARCH
CSST,	TAD	P
	DCA	CSP
	JMP	CSF1
SCHINV,	TAD	CSNCL	/^N, INVERT SKIP SENSE
	DCA	CSWT

CSL,	TAD I	SXR	/GET A CHAR FROM THE SEARCH BUFFER
	SPA SNA
	JMP	SCCOMD	/NEGATIVE CHARS AND 0 ARE SPECIAL
	CIA
	CDF 10
	TAD I	P
	AND	[377
CSWT1,	CDF 0
CSWT,	SZA CLA
	JMP	CSF	/FAIL TO MATCH ON THIS CHARACTER
	ISZ	P
CSG,	TAD	CSZCL
	DCA	CSWT	/RESTORE SEARCH TEST
	TAD	ZZ
	CMA
	TAD	P
CSZCL,	SZA CLA		/CHECK FOR END OF BUFFER
	JMP	CSL	/NO
	DCA	P
CSZ,	DCA	NMT
	JMP I	SEARCH
/SEARCH SUBROUTINE - CONTINUED

SCCOMD,	DCA	.+1	/SPECIAL CHARACTERS ARE JUMPS OR 0
	HLT		/0 FALLS THROUGH INTO TERMINATION CODE
	ISZ	CSN	/GET NTH OCCURRENCE
	JMP	CSF	/MORE TO GO
	CMA
	JMP	CSZ	/GOT IT
CSF,	ISZ	CSP	/INDEX P
CSF1,	TAD	(STABLE-1
	DCA	SXR	/INITIALIZE AUTO - INDEX
	TAD	CSP
	DCA	P
	JMP	CSG

/SEARCH STRING MODIFIERS ^N,^Q,^S, AND ^X

SCHTAB,	JMP	SCHINV	/^N: ANYTHING BUT
	SCHCTQ		/^Q: LITERALLY
	JMP	SCHSEP	/^S: ANY SEPARATOR
	JMP	CSWT1	/^X: ANYTHING

SCHCTQ,	SCAN		/GET THE NEXT CHARACTER
	JMP	SSTCHR	/AND STORE IT IN PLACE OF THE ^Q

SCHSEP,	CDF 10		/^S, LOOK FOR SEPARATOR
	TAD I	P
	AND	[377
	TSTSEP		/SHARED SORTING ROUTINE
	SKP
	CMA		/SET AC = -1 IF NON-SEPARATOR
	JMP	CSWT1	/GO CHECK RESULTS

FN,	DCA	CNXT
	STA
	JMP	CHRN1
/S,N AND _ COMMANDS (ALSO FS AND FN)

FS,	STA		/CHANGE S TO FS
CHRS,	JMS	SEARCH	/S COMMAND - DO A SEARCH
CHKREP,	ISZ	REPFLG	/WAS THERE A REPLACE SPECIFIED?
	JMP	CHKCLN	/NO - CHECK FOR COLON
	QSKP		/COUNT UP STRING 2
	TAD	NMT
	SMA CLA
	JMP	CHKCLN	/FAILED, SET VALUE & EXIT
	TAD	CSP	/FIGURE OUT OFFSET TO FAKE OUT "I" ROUTINE
	CIA		/SO THAT WE HAVE THE RIGHT INSERTION COUNT
	TAD	P	/BUT THE SIZE OF THE HOLE WE NEED
	DCA	DVT1	/IS DECREASED BY THE LENGTH OF THE SEARCH STRING.
	TAD	CSP	/RESET
	DCA	P	/TEXT POINTER
	PUSHJ		/INSERT
		CIL2	/STRING 2
CHKCLN,	DCA	REPFLG	/CLEAR REPLACE FLAG
	TAD	NMT
	PUSHJ		/FORM NUMBER FROM "NMT"
		NNEW13	/(APPLYING OPERATOR, IF NECESSARY)
	ISZ	CLNF	/WAS THERE A COLON ON THIS SEARCH?
	SKP		/NO
	JMP I	[IREST	/YES - GO AWAY REGARDLESS OF RESULTS
	DCA	CLNF	/RESET COLON FLAG TO 0
	ISZ	N	/DID WE SUCCEED?
	JMP I	(CFSI	/NO - SIMULATE A SEMICOLON
	DCA	NFLG	/YES - HOWEVER, NO COLON MEANS NO RESULT
	JMP I	[IREST

CHBA,	CLA IAC		/_ COMMAND
CHRN,	DCA	CNXT	/N COMMAND - SET OUTPUT FLAG
CHRN1,	JMS	SEARCH	/DO A SEARCH
	TAD	REND
	CIA
	TAD	ZZ
CSNCL,	SNA CLA		/HAVE WE REACHED END-OF-FILE?
	JMP	CHKREP	/YES - STOP AND ASSIGN VALUE
	TAD	NMT
	SZA CLA		/HAVE WE SUCCEEDED?
	JMP	CHKREP	/YES - STOP AND ASSIGN VALUE
	TAD	CNXT
	JMS I	[NXTBUF	/GET NEXT BUFFER
	JMP	CSST	/KEEP SEARCHING - RETURN TO CHRN+2
CNXT,	0		/OUTPUT FLAG
CSP,	0		/TEMP P
CSN,	0
REPFLG,	0		/REPLACE FLAG (-1 MEANS REPLACE)
	PAGE
/NUMBER PROCESSORS:
/COMMANDS B,H,Z,. AND DIGITS


NMBR,	TAD	CHAR	/NUMBER FOUND IN COMMAND STRING
	TAD	[-60
NMBR2,	DCA	NMT
	CLL
	NCHK		/CHECK NUMBER FLAG
	JMP	NNEW	/NOT UP, NEW OPERAND
	TAD	DOPR
	DCA	NOPR	/USE SAME OPERATOR AS FOR THE PREVIOUS DIGITS
	TAD	NP	/MULTIPLY PREV DIGITS BY 10
	CLL RTL
NMRBAS,	TAD	NP	/REPLACED BY "NOP" FOR OCTAL
	CLL RAL		/** COULD CHECK FOR OVERFLOW IN THIS AREA
NNEW,	TAD	NMT
NCOM,	DCA	NP	/CURRENT NUMBER
/	RAL
/	DCA	NEWLNK
/	TAD	NEWLNK	/GET NEW LINK
/	CLL RAR		/INTO LINK
NCOM2,	TAD	NP

NOPR,	SKP		/DISPATCH JUMP FOR OPERATOR
	CML CIA
	TAD	NACC	/CURRENT EXPRESSION VALUE
	DCA N
	RAL
	TAD	NACCLK	/ADD IN OLD LINK
	RAR
	SKP CLA
NRET,	DCA	N
	RAL
	DCA	NLINK	/SAVE LINK FOR POSSIBLE COMPARISON TEST
	TAD	NOPR
	DCA	DOPR
	TAD	NULLOP
	DCA	NOPR	/SET OPERATOR TO NULL OP
	STA
	JMP	DCPOPJ	/SET NUMBER FLAG AND EXIT
CCPR,	STL CLA RTL	/2
	POPL
		NOPR
		NACC
		NACCLK
	GETNUM
	JMP	NCOM	/COMBINE OLD NUMBER AND PARENTHESIZED RESULT

COPR,	MTHREE
	PUSHL
		NACCLK
		NACC
		NOPR
	DCA	N
	DCA	NLINK
	JMP	CPLS	/CLEAN OUT INSIDE PARENS

CDOT,	TAD	P	/COMMAND .
/** COULD CAUSE ERROR IF NFLG SET
	JMP	NCOMCL
/NEWLNK,	0
	/COMMANDS &,#,/,*,-,+,(,)

CAMP,	MTWO				/*K* LOGICAL AND **
CNBS,	TAD	(NIOR-NDIV		/LOGICAL OR
CVIR,	TAD	(NDIV-NMPY		/DIVISION
CAST,	TAD	(NMPY&177+5200-7400	/MULTIPLICATION
CMIN,	TAD	[7400-SKP		/SUBTRACTION
CPLS,	TAD	(SKP			/ADDITION
	DCA	NOPR	/COMMON TO ALL NUMERIC OPERATORS
	TAD	N
	DCA	NACC
	TAD	NLINK
	DCA	NACCLK
	DCA	NP
DCPOPJ,	DCA	NFLG	/CLEAR NUMBER FLAG
	POPJ

NAND,	AND	NACC	/BITWISE AND OF BINARY NUMBERS
	JMP	NRET	/** KEEP THESE TWO OPNS TOGETHER
NIOR,	CMA		/BITWISE OR OF BINARY VALUES
	AND	NACC
	TAD	NP
NULLOP,	JMP	NRET

NACCLK,	0		/LINK OF EXPRESSION WITHOUT NP
NMPY,	CIA		/*** REALLY OUGHT TO IMPLEMENT 13-BIT MULTIPLY
	DCA	ND
	TAD	NACCLK
	RAR		/SET UP OLD LINK
	TAD	NACC
	ISZ	ND
	JMP	.-2
	JMP	NRET
NACC,	0		/VALUE OF EXPRESSION WITHOUT NP
NDIV,	DCA	ND
	TAD	NACC
	MQLDVI
ND,	0
	JMP	NRET
/COMMANDS ^F,^^,^Z,^V, Q AND %, ^D, ^O

CTLF,	CLA OSR SKP	/^F COMMAND - VALUE OF CONSOLE SWITCHES
CTUA,	SCAN		/^^ COMMAND - VALUE OF NEXT CHAR IN COMMAND LINE
NCOMCL,	CLL
	JMP	NCOM	/GO INTO NUMBER PROCESSOR

/CTLZ,	TAD	QZ	/COMMAND ^Z
/	JMP	NCOM	/RETURN NUMBER OF CHARACTERS IN ALL Q-REGS.
/CTLV,	TAD	(VERSN	/^V COMMAND - RETURNS THE CURRENT VERSION NUMBER
/NCOM14,	CLL
/	JMP	NCOM

CTLD,	TAD	[4	/SET RADIX DECIMAL
CTLO,	TAD	(ORAD	/SET RADIX OCTAL
	DCA	RADIX
	TAD I	RADIX
	DCA	NMRBAS	/EITHER "NOP"(8) OR "TAD NP"(10)
	POPJ

DOPR,	0		/PREVIOUS OPERATOR
NP,	0		/VALUE OF CURRENT NUMBER

SCPTAB,	BBELL
	BCR
	BCR		/TAB
	EASYRO		/ALT
	BFF
	BVT
	BLF

CTLN,	TAD	REND
	CMA
	JMP I	(NNEW13

CQSM,	TAD	TFLG
	CMA		/TRACE FLAG ALTERNATES BETWEEN 0 AND 7777
	DCA	TFLG
	POPJ
FTAB,	FN
	FS
FLST,	116		/FN
	123		/FS

CHRF,	SCANUP		/COMMAND F
	SORT
		FLST
		FTAB-FLST
ERR31,	ERR		/BAD F COMMAND

CCLN,	STA		/: COMMAND - SET VALUE FLAG
	DCA	CLNF
	POPJ		/SO NEXT SEARCH WILL HAVE A NUMERIC VALUE
	PAGE
/CURSOR RIGHT IS $C
/CURSOR UP IS $A
/ERASE LINE IS $K

BUGFLG,	0		/-1 MEANS MUST RETYPE LINE ON NEXT RUBOUT

BSP,	0
	TAD	TTY10
	PUTT		/TYPE BS, SPACE, BS
	TAD	TTY40
	PUTT
	TAD	TTY10
	PUTT
	STA
	TAD I	(COLCT	/FIX UP COLUMN COUNTER
	DCA I	(COLCT
	JMP I	BSP
SCOPY,	JMS I	(BACKUP	/BACK UP ONE CHAR IN CMD LINE
	TAD	[-40	/LOOK AT CHAR WE BACKED OVER
	SMA
	JMP	EASYRO	/IT'S EASY TO RUB THIS ONE OUT
	TAD	[40	/RESTORE CHARACTER
	SORT
		CTLBEL
		SCPTAB-CTLBEL
BBELL,	CLA
	JMS	BSP	/^X NEEDS TWO RUB OUTS
EASYRO,	CLA
	ISZ	BUGFLG	/MAYBE WE REALLY SHOULD REPRINT LINE
TTY10,	SKP		/NOT NECESSARY
	JMP	BCR	/NECESSARY (PREVIOUS VERTICAL MOTION MAY
			/HAVE SCROLLED OFF TOP OF SCREEN)
	JMS	BSP	/RUB IT OUT
SCOPGO,	DCA	BUGFLG
	JMP I	(T2M1

BCR,	JMS	BELLSP	/REPRINT LINE
	JMS I	SCAPE
	113		/ERASE LINE
	JMP	SCOPGO

BLF,	TAD	CTLBEL	/CURSOR UP 1
BFF,	TAD	(-4	/CURSOR UP 8
BVT,	TAD	(-4	/CURSOR UP 4
	DCA	BSP
	JMS I	(ESCAPE
	101		/CURSOR UP
	ISZ	BSP
	JMP	.-3
TTY40,	STA
	JMP	SCOPGO
TSTAR,	DCA	BCHAR
TSPACE,	TAD	CHAR	/LOOK AT PREVIOUS CHARACTER
	TAD	(-7
	SZA CLA		/WAS IT ^G ?
	RESORT		/NO
	STA		/YES
TSP9,	TAD I	[QPNTR	/REDUCE CMD LINE BY 1 CHAR
	ADJQ		/I.E. GET RID OF ^G
	JMS	BELLSP
	JMP I	(T2M1

BELLSP,	0
BLSP1,	CRLF		/TAD	CACR
BLSP2,	NOP		/TYPE
	TAD	MQ
	DCA	SAVMQ
	DCA	MQ
	TAD	QZ	/START FROM END OF COMMAND LINE
LFBLP,	DCA	QP	/AND SEARCH FOR LF
	STA
	TAD	MQ	/COUNT HOW MANY
	DCA	MQ
	STA
	TAD	QP
	SPA
	JMP	LFSTAR	/AT BEGIN OF CMD LINE
	GETQ
	TAD	BCHAR	/LOOK FOR LF
	SNA CLA		/IS IT LF?
	JMP	LFB	/YES
	STA		/NO
	TAD	QP	/BUMP BACK ONE MORE CHAR
	JMP	LFBLP

LFSTAR,	CLA
	TAD	[52	/PRINT ANOTHER *
	TYPE
LFB,	PUSHJ
		COLG4	/REPRINT LINE TO END OF CMD LINE
	TAD	SAVMQ	/RESTORE MQ
	DCA	MQ
BLSP3,	NOP		/JMS I	SCAPE
BLSP4,	NOP		/113
	TAD	[-12
	DCA	BCHAR	/SET UP FOR NEXT TIME
	KCC		/CLEAR OUT ^O OR ^S
	JMP I	BELLSP

SAVMQ,	0
BCHAR,	-12		/CHAR WE'RE SEARCHING BACKWARDS FOR
SCAPE,	ESCAPE
SORTB,	0		/SORT AND BRANCH ROUTINE
	DCA	SCHAR	/SAVE SORT CHAR
	STA
	TAD I	SORTB	/GET POINTER TO LIST
	ISZ	SORTB
	DCA	XR
SORTA1,	TAD I	XR	/GET ITEM IN TEST LIST
	SPA		/END MARKED BY NEG VALUE
	JMP	SORTA2	/FELL OUT BOTTOM
	CIA STL
	TAD	SCHAR
	SZA CLA		/COMPARE SORT CHAR
	JMP	SORTA1	/NOT IT.
	TAD	XR	/GOT IT. NOW MAKE INDEX
	TAD I	SORTB	/TO JUMP TABLE
	DCA	COUNT	/THIS IS TABLE POINTER
	TAD I	COUNT	/GET JUMP ADDRESS FROM TABLE
	SPA		/IF IT IS NEGATIVE,
	JMP	SORTA3	/ITS NOT A JUMP ADDRESS - ITS A VALUE
	DCA	COUNT
	CLA CLL
	JMP I	COUNT
SORTA2,	CLA CLL		/FELL OUT BOTTOM
	TAD	SCHAR	/CARRY CHARACTER BACK TO
SORTA3,	ISZ	SORTB
	JMP I	SORTB	/DO SOMETHING ELSE

CSMC,	SCANUP		/GET NEXT CHARACTER IN UPPER CASE
	AND	[77	/MAKE IT A CONTROL CHARACTER
	DCA	SCHAR
	JMP	SORTA1	/SUBSTITUTE IT FOR THE UPARROW

COUNT,	0
	PAGE
	/COMMANDS P AND T

CHRP,	JMS	POKE	/LOOK AHEAD ONE CHARACTER
	UPPERC		/BUT IN UPPERCASE
	TAD	(-127	/SEE IF IT'S "W"
	DCA	TEMPT	/SAVE KNOWLEDGE AS FLAG
	TAD	TEMPT
	SNA CLA
	SCAN		/PASS UP W
	CLA		/CLEAR W FROM AC
	TAD	CFLG
	SPA CLA		/IS THIS COMMAND  M,NP?
	JMP	CHRW	/YES - TREAT LIKE M,NPW
	GETN		/COMMAND P - GET # OF PAGES
	SZL SNA
ERR25,	ERR		/NEG OR 0 ARG TO P
	CIA
	DCA	CPCT
CPOA,	PUSHJ
		CPOC	/DO N<HPY>
	TAD	TEMPT	/IS NEXT CHARACTER W?
	SNA CLA
	JMP	NOYANK	/YES
/	TAD	REND	/IF WANT P TO CREATE FF'S
/	SZA CLA		/WHEN NO MORE INPUT FILE
	ISZ	FFFLAG	/NO, SAW FF?
	JMP	NOFF	/NO
	TAD	CAFF	/YES
	OUTPUT		/OUTPUT FF
NOFF,	DCA	ZZ	/FORCE Y COMMAND TO WORK
	PUSHJ
		CHRY	/WHOEVER THOUGHT OF THE PW COMMAND SHOULD BE SHOT
YANKY,	ISZ	CPCT
	JMP	CPOA
	POPJ
CPCT,	0

POKE,	0		/RETURN NEXT CHARACTER (BY LOOKING AHEAD)
	TAD	QLENGT
	CIA CLL
	TAD	SCANP
	SZL CLA		/MAKE SURE WE HAVEN'T RUN OFF END OF COMMAND LINE
	JMP I	POKE	/RETURN 0 IF NO CHAR
	TAD	SCANP
	TAD	QBASE
	GETQ
	JMP I	POKE	/LEAVE CHAR IN AC

NOYANK,	TAD	CAFF	/NPW OUTPUTS FFS
	OUTPUT
	JMP	YANKY
CPOC,	PUSHJ
		CHRH
CHRW,	TAD	(OUTPUT
CHRT2,	DCA	CWOUT	/W AND T COMMANDS - SAME THING, DIFFERENT DEVICES
	JMS	NLINES	/CONVERT LINES TO CHARS
CWOA,	CMA
	DCA	NLINES	/SET CHARACTER COUNT
	TAD	NLINES
	CIA
	MQLDVI		/COMPUTE HOW MANY WORDS THIS OUTPUT WILL USE
	6		/(BY TAKING 2/3 OF THE NUMBER OF CHARACTERS,
	CLL CML RTL	/ BU THAT'S SLOW SO WE TAKE 4/6 AND ROUND)
	JMS I	(FITS	/DETERMINE WHETHER THE OUTPUT WILL FIT
ERR17,	ERR		/NO - TELL THE USER
	CLA		/CLEAR CRAP FROM AC
	JMP	CWOC
CWOB,	CDF 10
	TAD I	M
	AND	[177
	CDF 0
CWOUT,	0		/TYPE, OUTPUT, OR QPUT
	ISZ	M
CWOC,	ISZ	NLINES	/DONE?
	JMP	CWOB	/NO
	POPJ

CHRT,	TAD	KTYPE
	JMP	CHRT2
/X COMMAND AND LINES-TO-CHARACTER CONVERTOR

CHRX,	QREF		/COMMAND X
	JMS	NLINES	/CONVERT LINES TO CHARS
	ADJQ		/ADJUST Q-REGISTERS AND SET UP NEW LENGTH.
	TAD	(QPUT
	DCA	CWOUT	/SET OUTPUT ROUTINE TO STORE INTO Q REG
	TAD	MQ	/LOAD THE CHARACTER COUNT
	JMP	CWOA	/GO TO TEXT OUTPUTTER

NLINES,	0		/CONVERT + OR - N LINES AROUND . TO CHARS M,N
	ISZ	CFLG	/WAS THERE A COMMA?
	SKP		/NO
	JMP	MFROMN	/YES - DON'T CONVERT LINES TO CHARS
	TAD	P
	DCA	M
	DCA	CFLG	/V3C
	PUSHJ		/CHRL DOES A "GETN"
		CHRL	/TO GET THE DEFAULT VALUES OF N
	TAD	P
	DCA	N
	TAD	M
	DCA	P
MFROMN,	DCA	NFLG	/CLEAR NFLG IN CASE COMMA FLAG WAS ON
	CLL		/M AND N ARE KNOWN TO BE 12-BITS LONG
			/AND POSITIVE
	TAD	N
	BZCHK		/IS N OK?
	CMA CLL		/YES - COMPUTE N-M
	TAD	M	/BY COMPUTING M-N-1
	CMA		/AND COMPLEMENTING IT
	SNL		/IS M>N?
	JMP I	NLINES	/NO - RETURN N-M
	TAD	M	/N-M+M=N NOW IN AC.
	DCA	CPCT	/INTERCHANGE M AND N
	TAD	M
	DCA	N
	TAD	CPCT
	DCA	M
	JMP	MFROMN
/COMMANDS ; < AND >

CFSI,	TAD	ITRST
	SNA CLA
ERR24,	ERR		/FAILING SEARCH NOT IN ITERATION
CSEM,	OVRLAY
		QOVRLY
		CSEMO
/	^A ROUTINE

CTLA,	TAD	KTYPE
CEXP,	DCA	WHERTO
	TAD	CHAR
	DCA	QUOTE	/TERMINATING CHAR SAME AS COMMAND CHAR
	DCA	NFLG	/KILL NUMBER IF PRESENT
CTLALP,	QUOTST
	JMP I	[IREST
WHERTO,	0		/TYPE OR IGNORE THE CHARACTER
	CLA
	JMP	CTLALP
	PAGE
/COMMANDS A AND Y

CHRA,	NCHK		/COMMAND A
	JMP	CHAA
	GETNUM
	TAD	P
	DCA	R
	SZL
	JMP I	(ERR11	/ERROR IF POINTER OFF PAGE
	CDF 10
	TAD	R
	CMA CLL
	TAD	ZZ	/RETURN 'POP' IF POINTER OUTSIDE RANGE [0,Z-1]
	SNL CLA		/OTHERWISE VALUE OF CHARACTER AT POINTER POSITION
	JMP I	(ERR11	/POP
	TAD I	R
	AND	[377
	CDF 0
NCOM14,	CLL
	JMP I	(NCOM
CHRY,	TAD	NFLG
	SZA CLA
ERR18,	ERR		/NUMERIC ARGUMENT TO Y
	TAD	OUTR
	CIA
	TAD	ERROR
	SZA CLA
	TAD	ZZ
YSKP,	SZA CLA		/CHANGE TO SKP CLA TO NEVER ABORT Y COMMAND
ERR32,	ERR		/Y COMMAND ABORTED
	DCA	ZZ
	DCA	P	/WIPE OUT THE BUFFER
CHAA,	TAD	(ZMAX-1
	AND	REND
	CIA CLL
	TAD	ZZ	/IF WE HAVE ALREADY SEEN THE INPUT EOF,
	SZL CLA		/OR IF WE'RE ALREADY FULL (OR NEARLY SO)
	JMP	APLF	/GET OUT
DECGET,	ISZ	ICRCNT
	JMP	I2	/NO NEED TO READ
	CLL
	TAD	INRSIZ
	TAD	INRCNT
STECO1,	SNL		/"SKP!CLA" FOR SUPERTECO
	DCA	INRCNT	/UPDATE RECORD COUNT
LFTAB,	CLL CML CMA RTR	/IF WE OVERFLOWED THE END OF THE FILE,	!
	RTR		/5 ENTRY TABLE: MUST BE - - - + +	!
	RTR		/SHORTEN THE READ BY THE CORRECT AMOUNT	!
	TAD	INCTLW	/					!
	DCA	INCTRL	/SO THAT WE WILL NOT READ TOO FAR	!
	JMS I	INHND
I3,
INCTRL,	0400
BUFIN,	IN		/6200 IF 8K, 5600 IF 12K
IBLK,	0
	SMA CLA
	SKP
	JMP	INER	/IGNORE END-OF-FILE ERRORS, WE'LL SEE THE ^Z.
	TAD	IBLK
	TAD	INRSIZ	/BUMP RECORD NUMBER BY THE MAXIMUM NUMBER
	DCA	IBLK	/(IF WE READ SHORT ITS THE LAST ONE ANYWAY)
	CLA CMA
	TAD	BUFIN
	DCA	INXR	/SET UP INPUT XR
	TAD	INPCNT
	DCA	ICRCNT
	MTHREE
	DCA	I3
I2,	NOP		/CDF 20 IF 12K
	ISZ	I3
	JMP	I1	/NORMAL CHARACTER
	MTHREE		/WEIRD CHARACTER-RESET SWITCH
	DCA	I3
	MTWO
	TAD	INXR
	DCA	INXR	/MOVE INPUT XR BACK TO BEGINNING OF DBLWORD
	TAD I	INXR
	AND	[7400
	DCA	FFFLAG	/TEMP
	TAD I	INXR
	AND	[7400
	CLL RTR
	RTR
	TAD	FFFLAG
	CLL RTR
	RTR
	SKP
I1,	TAD I	INXR
IC,	NOP		/CDF 0  IF 12K
	AND	[177	/MASK OFF GARBAGE
	/INPUT CHARACTER IN AC
	SZA
	TAD	(-177
	SNA		/IGNORE BLANK TAPE AND RUBOUTS
	JMP	DECGET
	TAD	(177-32
STECO2,	SNA		/"SKP" FOR SUPERTECO
	JMP	APFS	/IT'S A ^Z
	TAD	(16
	SNA
	JMP	APFF	/ITS A FORM FEED
	TAD	CAFF	/RESTORE CHAR
	CDF 10
	DCA	MQ	/SAVE CHAR
	TAD I	ZZ	/PROTECT HIGH-
	AND	[7400	/ORDER BITS
	TAD	MQ	/OF TARGET
	DCA I	ZZ	/STORE CHAR IN BUFFER
	TAD	MQ
	CDF 0
	ISZ	ZZ
	TAD	[-12
	SNA CLA		/IF THE CHAR IS A LINE FEED,
	TAD	(-310	/CHECK THAT THE BUFFER IS NOT NEARLY FULL
	JMP	CHAA
APFS,	DCA	REND	/SIGNAL END OF FILE
	SKP
APFF,	STA
APLF,	DCA	FFFLAG	/SET FORM FEED FLAG
	POPJ
INER,	DCA	REND	/INHIBIT FUTURE INPUTS
ERR15,	ERR

INCTLW,	401		/1021 IF 12K MACHINE
INPCNT,	6400		/5000 IF 12K MACHINE
	PAGE
/TELETYPE ROUTINES

TYPCTV,	0		/TELETYPE STUFFER
	SORT
		CTLBEL
		CTLTAB-CTLBEL
	DCA	SCHAR	/STORE (POSSIBLY TRANSLATED) CHAR
OUTCC,	TAD	SCHAR
	ISZ	COLCT	/BUMP COLUMN COUNTER
	AND	[7740
	SZA CLA		/IS THE CHAR A CONTROL CHARACTER?
	JMP	NOCON	/NO
	TAD	(136
	PUTT		/OUTPUT "^"
	ISZ	COLCT
	TAD	[100
OUTLF,	TAD	SCHAR
OUTLF1,	PUTT
	JMP I	TYPCTV
COLCT,	0

OUTCR,	DCA	COLCT	/RESET CHAR COUNT
	JMP	OUTLF
OUTVT,	TAD	[4
OUTFF,	TAD	[7770	/FORM FEED IS 8 LINE FEEDS, VERT TAB IS 4
	DCA	COLCT	/*** BUG
ASR33,	TAD	CALF	/SIMULATE FORMFEEDS AND VERT TABS WITH LINEFEEDS
	JMP	OUTCOM	/*K* 8 LOCS AT ASR33 OVERLAYED BY ASR35 CODE

OUTHT,	TAD	COLCT	/COLUMN COUNTER, MOD 8
	AND	[7
	TAD	[7770	/SIMULATE TABS WITH SPACES
	DCA	COLCT
	40		/TAKE UP SPACE SO ASR-35 ROUTINE WILL JUST FIT
	TAD	.-1	/USE SPACES FOR TABS
OUTCOM,	PUTT		/PUT ONE OUT THE
	ISZ	COLCT	/WINDOW
	JMP I	(TPUTX	/STILL MORE INSIDE
	JMP I	TYPCTV

NOCON,	TAD	SCHAR
	AND	[100
EU1,	SNA CLA		/*EU SET TO CLA IF EUFLAG < 0 (NO CASE FLAGGING)
	JMP	OUTLF	/NOT ALPHANUMERIC
EU2,	NOP		/*EU SET TO TAD [40 IF EUFLAG>0 (FLAG UPPER CASE)
	TAD	SCHAR
	AND	[40
	SNA CLA
	JMP	OUTLF
	TAD	SQUO
	PUTT
	ISZ	COLCT
	TAD	SCHAR
	AND	[137
	JMP	OUTLF1	/OUTPUT UPPER CASE VERSION

OUTBEL,	TAD	SCHAR
	PUTT
	JMP	OUTCC
	/ROUTINE TO MANIPULATE Q-REGISTER STORAGE

/*** ALLOW : TO MEAN APPEND TO Q-REGISTER
/APPLIES TO X AND ^U COMMANDS
/MAKE SURE CMD LINE AND ^S ZERO CLNF

QADJ,	0
	SPA
	JMP	ERR12	/STRING TOO LONG FOR Q-REGISTER
	DCA	MQ	/SAVE NEW LENGTH OF Q-REGISTER
	QSUM		/COMPUTE POINTER TO CURRENT Q-REGISTER
	AC3777
	AND I	QPTR
	TAD	QP
	DCA	R
	AC3777
	AND I	QPTR	/GET ITS CURRENT LENGTH
	CIA CLL
	TAD	MQ	/COMPUTE DIFFERENCE
	SNL		/ADJUST Q-REGS
	JMP	QDNN	/TO HOLD NEW STRING
	SNA		/CHECK FOR ZERO
	JMP	QADJDN	/NOTHING TO DO
	TAD	QZ	/MOVE Q-REGISTERS UP TO INSERT CHARS
	DCA	QP	/(LINK IS 1 FROM PREVIOUS SNL)
	TAD	QP
	TAD	MQMAX	/SEE IF OUT OF BOUNDS
	SNL CLA		/TWO PLACES TO TOGGLE LINK THERE
ERR12,	ERR		/GETTING TOO FULL
	TAD	QZ
	DCA	Q
	TAD	QP
	DCA	QZ
	ISZ	QP
QUPL,	TAD	Q
	CIA
SQUO,	TAD	R	/DOUBLES AS ASCII FOR '
	SNA CLA
	JMP	QADJDN
	CMA
	TAD	Q
	DCA	Q
	MTWO
	TAD	QP
	DCA	QP
	TAD	Q
	GETQ
	QPUT
	JMP	QUPL
QDNN,	TAD	R	/MOVE Q-REGS DOWN TO ABSORB CHARACTERS
	DCA	QP
QDNN1,	TAD	QZ
	CIA
	TAD	R	/-NUMBER OF CHARS TO MOVE
	SNA CLA		/DONE?
	JMP	QDNNF	/YES
	TAD	R
	GETQ
	QPUT
	ISZ	R
	JMP	QDNN1	/LOOP AGAIN
QDNNF,	TAD	QP	/SET NEW VALUE
	DCA	QZ	/OF HIGHEST CHAR
QADJDN,	STL CLA RAR	/4000
	AND I	QPTR	/SAVE HIGH ORDER PART
	TAD	MQ
	DCA I	QPTR	/SAVE NEW LENGTH OF Q-REGISTER IN Q-REG TABLE
	TAD	QCMND	/SET UP COMMAND LINE AGAIN
	SETCMD		/AS IT MAY HAVE BEEN SHUFFLED.
	QSUM		/RECOMPUTE POINTER TO BEGINNING OF NEW Q-REG
	JMP I	QADJ

MQMAX,	-QMAX

QOVER,	0		/SUBROUTINE TO SKIP TO END OF STRING
	QCHK		/GET THE QUOTE CHARACTER (IF ANY)
	TAD	SCANP
	DCA	OSCANP	/SAVE BACKUP SCAN POINTER
QOVERL,	QUOTST
	JMP I	QOVER	/FOUND AN ALTM OR EQUIVALENT - RETURN
	JMP	QOVERL	/NOT END - SKIP ANOTHER CHAR
	PAGE
	/Q-REGISTER SUBROUTINES

QSUMR,	0		/COMPUTE POINTER TO Q-REG
	SNA
	TAD	QNMBR	/NORMALLY USES QNMBR, BUT CAN BE OVERRIDDEN BY AC
	CIA
	DCA	QKNT
	DCA	QP
	TAD	(QARRAY	/BASE ADDR OF Q-REG POINTERS
	DCA	QPTR
	JMP	QSUMB
QSUML,	AC3777
	AND I	QPTR	/ADD # OF CHARS IN LOWER REG
	TAD	QP
	DCA	QP
	ISZ	QPTR	/SKIP VALUE WORD
	ISZ	QPTR	/POINT TO NEXT Q-REG
QSUMB,	ISZ	QKNT	/REACHED OUR Q-REGISTER YET?
	JMP	QSUML	/NO - ADD IN ANOTHER
	JMP I	QSUMR
QKNT,	0
SGET,	0		/SCAN COMMAND LINE OR MACRO
SGET1,	CLA		/** CALLED WITH AC NON-ZERO **
	TAD	QLENGT
	CIA CLL
	TAD	SCANP
	SZL CLA		/CHECK THAT WE ARE STILL INSIDE THE COMMAND LINE
	JMP	SGOVFL	/NO - COMMAND DONE
	TAD	SCANP	/GET CHARACTER POSITION IN LINE
	TAD	QBASE	/ADD IT TO THE ADDRESS OF THE LINE
	GETQ		/AND GET THAT CHARACTER.
	DCA	LASTC
	TAD	TFLG
	AND	LASTC	/IF THE TRACE FLAG IS ON,
	SZA
	TYPE		/PRINT THE CHAR
	TAD	LASTC
	ISZ	SCANP	/INCREMENT CHARACTER POINTER AFTER FETCH
	JMP I	SGET	/RETURN
SGOVFL,	TAD	MPDL	/"MPDL" IS THE PUSHDOWN POINTER ON ENTRY TO THIS
	SNA		/MACRO. IF IT IS 0, WE ARE NOT IN A MACRO
	JMP I	(T1	/SO RETURN TO THE USER
	TAD	PDLP	/CHECK THAT THE ENDING POINTER IS THE SAME
	IAC
	SZA CLA		/AS THE ENTRY ONE - OTHERWISE WE HAVE
ERR13,	ERR		/SCREWED UP SOMEHOW (EG WE ARE
	POP		/ IN THE MIDDLE OF A COMMAND)
	DCA	SCANP
	POP
	DCA	ITRST
	POP		/RESTORE THE PREVIOUS VALUES OF
	DCA	MPDL	/MPDL, THE SCAN POINTER AND THE COMMAND LINE
	POP		/POINTER FROM THE PUSHDOWN LIST
	SETCMD
	JMP	SGET1	/AND FETCH A CHARACTER FROM THE UPPER LEVEL.
CMDSET,	0		/SUBROUTINE TO SET UP COMMAND LINE POINTERS
	DCA	QCMND	/STORE IN COMMAND LINE NUMBER
	TAD	QCMND
	QSUM
	TAD	QP	/GET FIRST LOCATION IN COMMAND LINE
	DCA	QBASE	/AND STORE IN "QBASE"
	AC3777
	AND I	QPTR
	DCA	QLENGT	/STORE THE LINE LENGTH IN "QLENGT"
	JMP I	CMDSET	/RETURN

QREFER,	0		/SET UP POINTERS FOR Q-REG REFERENCE
	SZA
	JMP	QREFEX	/AHA - WE ALREADY HAVE THE Q-REGISTER
	SCANUP		/GET Q-REGISTER IDENTIFIER
	DCA	QNMBR
	TAD	QNMBR
	TSTSEP		/TEST FOR ALPHANUMERIC (LOWER CASE LEGAL)
ERR03,	ERR		/OOPS - BAD Q-REGISTER REFERENCE
	TAD	QNMBR
	TAD	[7700
	SPA		/NUMERIC?
	TAD	Z7	/YES - FORCE NUMBERS UP TO ABUT LETTERS
	TAD	CALF	/FORCE IDENTIFIER INTO THE RANGE 1-44 (OCTAL)
QREFEX,	DCA	QNMBR	/STORE AWAY NUMBER FOR FURTHER REFERENCE
	QSUM		/COMPUTE QP AND QPTR
	JMP I	QREFER	/RETURN

CDBQ,	OVRLAY
		QOVRLY	/READ IN Q-OVERLAY
		CDBQO

CHRO,	OVRLAY		/READ IN Q-OVERLAY
		QOVRLY
		CHROO
OVERLY,	0
	TAD I	OVERLY	/GET LOCATION TO CHECK
	ISZ	OVERLY
	DCA	TMP
	TAD I 	OVERLY
	DCA	OVERLY	/SET RETURN ADDRESS
	TAD I	TMP	/IS OUR OVERLAY IN CORE?
	SNA
	JMP I	OVERLY	/YES, BRANCH INTO IT
	DCA	TMP	/NO, SET BLOCK TO READ IN
/**	THE NEXT 5 WORDS ARE MODIFIED IF WE HAVE MORE THAN 12K
OVREAD,	JMS I	(7607	/CALL SYSTEM HANDLER
	0200		/READ 2 PAGES
	3200		/INTO 3200
TMP,	0		/FROM THIS BLOCK
	HLT		/ERROR READING OVERLAY
	JMP I	OVERLY	/GO TO NEXT SPOT

CTLTAB,	OUTBEL	/BELL
	OUTCR
POUTHT,	OUTHT
	4044		/$ WITH SIGN BIT ON
	OUTFF
	OUTVT
	OUTLF

ALTTAB,	4033
	4033		/ALTMODE WITH SIGN BIT ON

CATS,	STA		/@ COMMAND - FAKE OUT "IREST"
IREST,	DCA	QFLG	/RESET QUOTED STRING FLAG
	TAD	CAAM
	DCA	QUOTE	/RESET QUOTE CHAR TO ALTMODE
POPK,	POPJ		/RETURN

QTST,	0		/SUBROUTINE TO GET A CHAR AND TEST FOR ALTMODE
	SCAN
	SORT
		QUOTE
		QTST-QUOTE	/RETURN IF QUOTE FOUND
	ISZ	QTST
	JMP I	QTST	/SKIP-RETURN WITH AC INTACT IF NOT FOUND
	/COMMANDS ^U AND E - ALSO ERROR ROUTINE

CTLU,	OVRLAY
		FOVRLY
		CTLUO
	PAGE
ERRXX,	ERR30+1		/ENTRY POINT ALSO SERVES AS A FLAG FOR "TQMK"
	KCC		/CLEARS AC
	CDF 0		/JUST IN CASE
	TAD I ERRXX	/GRAB SIGNAL '0' NOW
	DCA ERRTMP	/BEFORE OVERLAY MIGHT DESTROY IT
	OVRLAY		/GO TO ERROR OVERLAY
		EOVRLY
		ERRYY

ERRRET,	TAD ERRTMP	/GET THE LOCATION AFTER THE CALL
	SNA CLA		/IF IT'S ZERO AND WE WERE CHAINED TO,
CHOOPS,	NOP		/ITS A FATAL ERROR - JMP CTLC
FATALJ=	JMP I	(CTLC
CTRLP,	TAD	SCANP
	CIA
	DCA	ERRXX	/SET ERRXX TO CHAR POSITION OF ERROR CHAR.
	KCC		/ZAP KEYBOARD FLAG
	JMP I	(T0	/CONTINUE AS NORMAL UNLESS USER TYPES "?"

CHRE,	SCANUP		/COMMAND E
	DCA	TYI
	TAD	TYI
	SORT
		EFLST
		EFTAB-EFLST
	CLA
	OVRLAY
		FOVRLY
		CHRED
ERRTMP,	0		/MUST BE INITIALLY 0
	/COMMANDS I AND <TAB>

CHRI,	NCHK		/I COMMAND
	JMP	CIL1
	TAD	N	/INSERT CHAR WHOSE VALUE IS N
	JMS	UPOC
/*** CHECK FOR $
	POPJ
CTLI,	DCA	QFLG	/CANNOT BE QUOTED
/	CLA CMA		/FOR TAB INSERT
/	TAD	SCANP
/	DCA	SCANP	/BACK UP SCAN POINTER BY ONE
/			/*** THIS IS A BUG
	TAD	CAHT	/TAB
	JMS	UPOC
CIL1,	QSKP		/COUNT LENGTH OF INSERTION
	DCA	DVT1	/ZERO FUDGE USED BY FS COMMAND
CIL2,	TAD	OSCANP
	TAD	QBASE
	DCA	QP	/SET UP POINTER TO INSERTION STRING
	TAD	SCANP
	CIA CLL
	TAD	OSCANP
	DCA	MQ	/STORE CHAR COUNT TO INSERT (-1)
	TAD	MQ
	TAD	DVT1	/ADD FS FUDGE
	CMA
	SNL		/DID WE INSERT MORE THAN WE DELETED?
	JMP	EXPAND	/YES - IGNORE SIGN BIT OF COUNT
	CIA
	PUSHJ
		ADJ2	/COMPRESS OUT EXCESS DELETED STUFF
	JMP	CIL4
CIL3,	TAD	QP
	GETQ		/GET A CHAR
	DCA	TYI
	JMS	STOREC	/STORE A CHARACTER
	ISZ	QP
CIL4,	ISZ	MQ
	JMP	CIL3	/OF INSERTION
	JMP I	[IREST

STOREC,	0		/STORE CHAR IN "TYI" INTO TEXT BUFFER AT P
	CDF 10
	TAD I	P
	AND	[7400
	TAD	TYI
	DCA I	P
	CDF 0
	ISZ	P
	JMP I	STOREC
/G COMMAND

CHRG,	QREF		/G COMMAND - GET Q-REGISTER NUMBER
	DCA	NFLG
	AC3777
	AND I	QPTR	/GET COUNT OF CHARS IN REGISTER
	CMA
	DCA	MQ	/SAVE AS TRANSFER COUNT
	ISZ	CLNF
	SKP
	JMP	COLG4
	DCA	CLNF
	AC3777
	AND I	QPTR
EXPAND,	PUSHJ		/COME HERE FROM INSERT LOGIC
		ADJ	/INCREASE TEXT BUFFER SIZE ( Q-REG LENGTH MAY
	JMP	CIL4	/BE NEGATIVE) AND GO TRANSFER THE CHARS

TYI,	0		/TELETYPE INPUT
TYI1,	KSF		/WAIT FOR THE KEYBOARD FLAG
KSFWT,	JMP	.-1	/WHILE WAITING, DISPLAY TEXT ON SCOPE
	CTCCHK		/CHECK FOR ^C
	KRB		/WATCH OUT - AC MAY NOT BE 0!
	AND	[177
	SNA
	JMP	TYI1	/IGNORE NULL CHARS AND LEADER
	SORT
		ALTLST
		ALTTAB-ALTLST	/LOOK FOR NON-STANDARD ALTMODES
	AND	[177	/IN CASE WE RETURNED A NEGATIVE VALUE
	JMP I	TYI

UPOC,	0		/MOVE TEXT BUFFER UP ONE CHAR
	AND	[177
	DCA	TYI
	CLA IAC
	PUSHJ
		ADJ
	JMS	STOREC	/STORE CHAR IN THE HOLE WE MADE
	JMP I	UPOC

CUPPER,	0		/FORCE CHARACTER TO UPPER CASE
	TAD	[-100
	SMA		/IF ITS >100
	AND	(37	/REDUCE IT TO BE <140
	TAD	[100
	JMP I	CUPPER	/RETURN
COLG3,	TAD	QP
	GETQ		/GET A CHAR
	TYPE
	ISZ	QP
COLG4,	ISZ	MQ
	JMP	COLG3
	POPJ
ESCAPE,	0
	TAD	CAAM	/TYPE ESCAPE
	PUTT
	TAD I	ESCAPE
	PUTT		/TYPE ARGUMENT
	JMP I	ESCAPE	/OK TO RETURN TO ARGUMENT
	PAGE
TSAVE,	TAD I	[QPNTR
	SZA CLA		/IF WE ARE NOT AT THE BEGINNING OF THE C.L.
	RESORT		/TREAT THIS LIKE ANY OTHER ^S
	MTWO		/DROP OFF THE TWO BELLS OR ALTMODES
	TAD	OCMDLN
	ADJQ		/SET COMMAND STRING LENGTH TO OLD VALUE
	TAD	L44
	QREF		/SET UP POINTERS TO Q-REG Z
	ADJQ		/KILL CONTENTS OF Q-REG Z
	TAD I	[QPNTR
	DCA I	(QPNTR-2
	DCA I	[QPNTR	/DO A QUICK SHUFFLE OF Q-REG LENGTHS
	JMP I	(TCTLU
CHRQ,	QREF		/COMMAND Q
	CLL
	JMP	CQOA

CPCS,	QREF		/COMMAND %
	GETN
CQOA,	ISZ	QPTR	/POINT TO VALUE WORD
	TAD I	QPTR	/INCREMENT VALUE BY ARGUMENT
	DCA I	QPTR
/ADD LINKS
	STA
	TAD	QPTR	/GO BACK ONE
	DCA	QPTR2	/ALSO COMPL LINK
	CML RAR
	TAD I	QPTR2
	DCA I	QPTR2
	TAD I	QPTR2
	RAL
	CLA
	TAD I	QPTR
	JMP I	(NCOM	/MAKE A NUMBER

TYCRLF,	0		/TYPE A CR AND LF
	TAD	CACR	/CR
XTYPE,	TYPE
	TAD	CALF	/LF
	TYPE
	JMP I	TYCRLF	/RETURN

QPTR2,	0

CHGT,	OVRLAY
		QOVRLY
		CHGTO
CHLT,	OVRLAY
		QOVRLY
		CHLTO
CCMA,	NCHK		/COMMAND ,
	JMP	NERR	/NUMBER FLAG NOT SET
	TAD	NLINK
	SZA CLA
ERR26,	ERR		/NEG ARGUMENT TO ,
	ISZ	CFLG
	SKP
	JMP	NERR	/3 NUMERIC ARGUMENTS
	TAD	N	/MOVE N TO M
CCMA3,	DCA	M	/ENTERED HERE BY "H" COMMAND
	DCA	N	/AND CLEAR N
	STA
	DCA	CFLG	/SET COMMA FLAG
	POPJ
/RETURNS 13-BIT RESULT IN AC,LINK

NGET,	0		/SUBROUTINE TO GET LAST NUMBER, WITH
NGET1,	NCHK		/DEFAULT VALUES OF +1 (NO NUMBER),
	JMP	NGET2	/OR -1 (JUST A MINUS SIGN)
	GETNUM
	JMP I	NGET	/DIGITS SEEN - RETURN THEM
NGET2,	CLA CLL IAC	/NO DIGITS SEEN
	PUSHJ		/MAKE BELIEVE WE SAW THE DIGIT "1"
		NCOM	/AND CREATE A NUMBER FROM IT (TAKING ANY
	JMP	NGET1	/OPERATORS INTO ACCOUNT) AND USE IT

BACKUP,	0
	TAD I	[QPNTR	/SEE IF ANYTHING TO ERASE
	SNA CLA
	JMP I	(T0	/NO, START ALL OVER
	STA
	TAD I	[QPNTR	/THEN THE CHARACTER COUNT
	ADJQ		/REDUCE THE LENGTH OF THE COMMAND REGISTER BY 1
	TAD	QZ
	GETQ		/GET THE CHARACTER WE RUBBED OUT
	JMP I	BACKUP

CHLCMP,	0		/COMPARISON SUBROUTINE
	TAD I	P	/DATA FIELD IS 10
	AND	[377
	CDF	0
	SORT
		CAFF
		LFTAB-CAFF
	SPA CLA		/LINE TERMINATORS ARE CHANGED TO NEGATIVE NOS.
	ISZ	CDT	/IS COUNT EXHAUSTED?
	JMP	CHLRET	/NO
CHRLI,	ISZ	P
L44,	44
	CDF	0
	POPJ

CHRH,	PUSHJ		/COMMAND H
		CCMA3	/SET M=0 AND COMMA FLAG ON AND FALL INTO "Z"
			/** COULD CAUSE ERROR ON B AND H IF NFLG SET
CHRZ,	TAD	ZZ	/COMMAND Z
CTLH,			/^H COMMAND - TIME OF DAY - NOT IMPLEMENTED
CHRB,	JMP I	(NCOM14	/COMMAND B

CHLRET,	CDF	10
	JMP I	CHLCMP
EFTAB,	IOV
	XOV
	XOV
	XOV
	XOV
	IOV
	IOV
	XOV
XOV,	OVRLAY
		XOVRLY
		CHREX

IOV,	OVRLAY
		IOVRLY
		CHRER
/COMMANDS = AND \ DISPATCHER TO OVERLAY

CEQL,	OVRLAY
		FOVRLY
		CEQLO
CBSL,	OVRLAY
		FOVRLY
		CBSLO

ZROSPN,	DCA	SCANP	/RESET TO BEGINNING OF ITERATION
ZRON,	DCA	NFLG	/KILL NUMBER FLAG
	JMP I	[IREST
	PAGE
/	I/O-OVERLAY

/	IOVRLY	XOVRLY	FOVRLY
/	ER	EF	EU
/	EB	EC	ES
/	EW	EX	ET
/		EG	EV
/			EH
/			EO

	*3200

IOVRLY,	0
	QOVRLC
	EOVRLC
	XOVRLC
	FOVRLC

	/SUBROUTINE TO DO LOOKUPS AND ENTERS (LINK CRITICAL ON ENTRY)

OPEN,	0		/CALLED WITH MONITOR CODE - 2 IN AC
	DCA	RSTSW	/ENTER OR LOOKUP
	SZL CLA		/IF THIS IS THE OUTPUT SIDE OF AN "EB" COMMAND,
	JMP	DEVLOD	/SKIP THE STATEMENT SCAN
	QCHK
	TAD	DSKNAM	/PACKED SIXBIT FOR 'DSK:'
	DCA	DEVC
	TAD	(72	/RESTORE :
NGOM1,	DCA	DEVLST+1
NGO,	DCA	NAME	/CLEAR NAME
	DCA	NAME+1
	DCA	NAME+2
	MTWO
	DCA	PERDSW
NAMCM1,	DCA	NAMCNT
NAMEC,	QUOTST		/GET CHAR AND TEST FOR ALTM
	JMP	DEVQOT	/ALTM - END OF NAME
	SORT		/NO - CHECK SPECIAL CHARS
		DEVLST	/([,:,., AND SPACE
		DEVTAB-DEVLST
	TSTSEP		/NO, SEE IF ALPHANUMERIC
ERR08,	ERR		/ILLEGAL CHAR
	TAD	NAMCNT
	TAD	[-10
	SMA CLA		/MORE THAN 6 CHARS?
	JMP	NAMEC	/YES, IGNORE
	TAD	NAMCNT	/NO, PACK IT
	CLL RAR
	DCA	TEMP1	/*K* NOTE ASSUMPTION NAME STARTS AT LOC 0!
	TAD	SCHAR
	UPPERC		/** "UPPERC" ALWAYS COMPLEMENTS LINK
	AND	[77
	SNL
	JMP	.+4
	CLL RTL
	RTL
	RTL
	TAD I	TEMP1
	DCA I	TEMP1
	ISZ	NAMCNT
	JMP	NAMEC

PERD,	ISZ	PERDSW	/FOUND A PERIOD
	TAD	NAME
	SNA CLA		/ERROR IF WE HAVE
	JMP	ERR08	/DOUBLE PERIODS OR NO FILE NAME
	DCA	DEVLST+1	/DEVICE NO LONGER LEGAL
	DCA	NAME+3	/ZERO EXTENSION OUT
	TAD	[6	/AND SET POINTER TO 6TH CHARACTER
	JMP	NAMCM1

COLON,	TAD	NAME+1
	SNA		/WE MUST PACK THE NAME INTO ONE WORD OURSELVES
	JMP	.+5	/BECAUSE IF "OPEN" IS CALLED FROM THE OUTPUT
	TAD	NAME	/SIDE OF AN "EB" COMMAND, WE SKIP
	SMA CLA		/THE NAME COLLECTOR.(WITH GOOD REASON -
	CLL CML RAR	/THE USR OVERLAYS THE COMMAND LINE).
	TAD	NAME+1	/SINCE THE OS/8 "ASSIGN" CALL TO THE USR
	TAD	NAME	/REPLACES THE 2ND NAME WORD WITH THE DEVICE
	DCA	DEVC	/NUMBER, ALL NAME INFO MUST BE HELD IN WORD 1.
	JMP	NGOM1	/DEVICE NAME STORED - RESET FOR FILE NAME

DEVLST,	56		/.
	72		/:
DSKNAM,	5723		/=0423+1300+4000 - SERVES AS LIST TERMINATOR
DEVQOT,	ISZ	PERDSW	/IF WE NEVER SAW A PERIOD,
	DCA	NAME+3	/WIPE OUT THE EXTENSION
	JMS I	(GETUSR	/BRING USR INTO CORE

DEVLOD,	TAD I	OPEN	/MOVE HANDLER ADDRESS
	DCA	DEVHND
	ISZ	OPEN	/AND BUMP POINTER
	TWO
	TAD	RSTSW
	DCA	CODE	/ENTER OR LOOKUP
	CIF 10		/AND RESET TABLES
	JMS I	[200
	13
RSTSW,	0		/DON'T ZAP OPEN FILES ON INPUT
	DCA	DEVNO	/ZERO SECOND NAME WORD
	CIF 10
	JMS I	[200
	1		/ASSIGN HANDLER
DEVC,	0
DEVNO,	0
DEVHND,	0
	JMP	OPNERR	/ERROR - KICK USR OUT FIRST
	DCA	STBLK
	TAD	RSTSW	/GET LOOKUP-ENTER SWITCH
	TAD	NAME	/IF NAME IS NULL AND THIS IS A LOOKUP,
	SNA CLA
	JMP	OPSUCC	/IT JUST SUCCEEDED
	TAD	DEVNO	/DEVICE #
	CIF 10
	JMS I	[200
CODE,	0		/ENTER OR LOOKUP
STBLK,	0		/FILLED WITH STARTING BLOCK
TEMP1,
FLN,	0		/FILLED WITH -LENGTH
/**** CHECK IF AC MUST = 0
	JMP 	OPNERR	/ERROR
OPSUCC,	TAD	DEVHND	/HANDLER ADDRESS IN AC
	JMP I	OPEN
PERDSW,	7777		/FLIP FLOP FOR EXTENSION
NAMCNT,	0		/CHARACTER COUNT
/*** CHECK FOR : (SEE P.26) RETURN VALUE IF FNF, ALSO IF FOUND
OPNERR,	TAD	RSTSW	/WE SHOULD ONLY KILL THE OUTPUT FILE
	SNA CLA
	JMP	.+3	/IF THIS IS AN OUTPUT ERROR
EBERR,	TAD	ERROR
	DCA	OUTR
	PUSHJ
PECDSM,	ECDISM		/DISMISS THE USR
ERR16,	ERR
	0		/*K* TELLS ERR RTN TO EXIT IF WE WERE CHAINED TO

	PAGE
CHRER,	TAD I	(TYI
	SORT
		ERLST
		ERTAB-ERLST
	ERR		/CAN'T HAPPEN

ERTAB,	EBAK		/EB
	ROPEN		/ER
	WOPEN		/EW

ERLST,	102		/EB
	122		/ER
	127		/EW

	/FILE OPEN COMMMANDS:

EBAK,	CLA CMA CLL	/"EDIT BACKUP" COMMAND WITH LINK CLEAR
	PUSHJ		/USE 'ROPEN' TO SET POINTERS
		ROPEN	/WITHOUT KICKING OUT THE USR (AC=-1 ON ENTRY)
	TAD I	(DEVNO	/DEVICE #
	TAD	(OSDCBT-1
	DCA	R
	CDF 10
	TAD I	R	/GET DEVICE CODE FROM DCB TABLE
	CDF
	SMA CLA		/NEGATIVE IF FILE-STRUCTURED
	JMP I	(EBERR	/YOU CAN'T DO THAT!
	TAD	NAME+3	/EXTENSION
	TAD	(-213
	SNA
	JMP I	(EBERR	/CAN'T EB A .BK FILE
	TAD	DOTBK	/RESTORE EXTENSION
	DCA	R	/SAVE IT
	TAD	DOTBK	/.BK EXTENSION
	DCA	NAME+3
	CIF 10
	TAD I	(DEVNO	/DEVICE #
	JMS I	[200	/DELETE THE OLD BACKUP
	4
	NAME
	0
DOTBK,	213		/WHO CARES IF IT'S NOT THERE?
	TAD	R	/OLD EXTENSION
	DCA	NAME+3
	CLA CLL CML IAC	/SET EDIT BACKUP FLAG AND DO AN "ENTER"
			/LINK MUST BE SET HERE FOR OPEN
WOPEN,	DCA	EBFLG	/LINK NORMALLY 0 WHEN GOTTEN HERE
	CLA IAC		/OPEN OUTPUT FILE
	JMS I	(OPEN	/ENTER CODE IN AC
OUHNDL,		4001	/HANDLER ADDRESS
	DCA	OUTHND	/HANDLER ENTRY
	TAD I	(DEVNO
	DCA	ODEV	/SAVE DEV #
	DCA I	(OCNT	/CLEAR BLOCK COUNT
	TAD I	(FLN
	DCA I	(OMAXLN	/MAXIMUM FILE LENGTH
	TAD	NAME
	DCA I	(OUNAM
	TAD	NAME+1
	DCA I	(OUNAM+1
	TAD	NAME+2
	DCA I	(OUNAM+2
	TAD	NAME+3
	DCA I	(OUNAM+3
	TAD	(DECPUT
	DCA	OUTR	/ENABLE CHARACTER OUTPUT ROUTINE
	TAD	(ECDISM
	DCA I	(DECPUT	/FAKE RETURN FROM CHAR I/O ROUTINE
	TAD I	(STBLK
	JMP I	(OSETP	/SET UP BLOCK NUMBER AND POINTERS
/FILE OPEN ROUTINE

ROPEN,	DCA	QPTR	/ENTERED WITH AC=-1 IF MONITOR IS TO BE KEPT
			/ENTERED WITH LINK=0
	JMS I	(OPEN	/LOOKUP CODE IN AC
INHNDL,		7201	/HANDLER ADDRESS
	DCA	INHND	/SAVE HANDLER ENTRY
	STA
	DCA	ICRCNT	/POINTER
	STA
	DCA	REND	/CLEAR END-OF-FILE FLAG
	TAD I	(STBLK
	DCA I	(IBLK	/FIRST BLOCK
	TAD I	(FLN
	DCA	INRCNT	/SET UP INPUT FILE LENGTH
	ISZ	QPTR	/SHOULD WE DISMISS THE MONITOR?
	JMP I	(ECDISM	/YES - KICK THE USR OUT AND POPJ
	JMP I	[IREST	/EXIT

DEVTAB,	PERD		/.
	COLON		/:
	PAGE
NORMAL,	TAD	ODEV	/CLOSE FILE
	CIF 10
	JMS I	[200
	4
	OUNAM
OCNT,	0		/NUMBER OF BLOCKS
	HLT
	TAD	ERROR	/RESET OUTPUT SUBROUTINE POINTER
	DCA	OUTR	/TO ERROR
ECDISM,	CIF 10		/DISMISS OS/8 USR ROUTINE
	JMS I	[200
	11		/KICK USR OUT
	JMP I	[IREST

/*** REALLY SHOULD BREAK UP INTO 2 ROUTINES

SCHSRT,	0		/SORT LETTERS AND NUMBERS
	UPPERC		/CONVERT TO UPPER CASE TO REDUCE CASES
	CLL		/THE LINK WILL ALTERNATE EACH TIME
	TAD	[-60	/WE ADD ONE OF OUR NEGATIVE CONSTANTS.
	SMA		/THE LINK AT THE END WILL TELL WHETHER
	TAD	[-12	/THE CHARACTER WAS ALPHANUMERIC
	SMA		/(I.E. BETWEEN 60-71,101-132 OR 140-172)
	TAD	M7	/OR A SEPARATOR CHARACTER.
	SMA
	TAD	(-32
	SZL CLA		/WAS IT ALPHANUMERIC?
	ISZ	SCHSRT	/YES
	JMP I	SCHSRT	/SKIP RETURN IF ALPHANUMERIC

RT,	0		/ROUTINE TO PACK THIRD CHAR INTO OUTPUT BUFFER
	CLL RTL
	RTL
	DCA	DM	/CALLED TWICE - FIRST TIME WITH CHAR IN AC,
	TAD	DM	/SECOND TIME WITH "DM" IN AC
	AND	[7400
	TAD I	OPTR2
	DCA I	OPTR2
	ISZ	OPTR2
	JMP I	RT
DVIMQL,	0		/FAKE MQL DVI
	DCA	DVT1	/STORE DIVIDEND
	DCA	MQ	/INITIALIZE QUOTIENT
DV1,	TAD I	DVIMQL	/GET DIVISOR
	CIA
	CLL		/SET UP TO TAKE IMMEDIATE EXIT ON ZERODIVIDE
	TAD	DVT1	/SUBTRACT DIVISOR FROM DIVIDEND
	SNL		/OVERFLOWED YET?
	JMP	DV7200	/YES
	DCA	DVT1	/NO - STORE IT BACK
	ISZ	MQ	/BUMP QUOTIENT
	JMP	DV1	/AND LOOP
DV7200,	CLA
	TAD	MQ
	ISZ	DVIMQL	/SKIP PAST DIVISOR
	JMP I	DVIMQL	/RETURN WITH QUOTIENT IN AC

/SEARCH STRING MODIFIERS:

SCHLST,	16	/^N - ANYTHING BUT
	21	/^Q - LITERALLY
	23	/^S - ANY SEPARATOR
	30	/^X - ANYTHING
M7,	-7
DECPUT,	0		/DEVICE INDEPENDENT I/O
	TAD	[200	/ADD ON PARITY BIT
	ISZ	O3	/3RD CHAR OF 3?
	JMP	O2	/NO
	JMS	RT	/YES, SPECIAL HANDLING
	TAD	DM	/TEMP STORAGE
	JMS	RT
SETO3,	MTHREE		/RESET SWITCH
	DCA	O3
	ISZ	OCRCNT	/END OF BUFFER?
	JMP I	DECPUT	/NO
	JMS	FITS	/CHECK FOR OUTPUT OVERFLOW
	JMP	OERR	/YUP
	DCA	OCNT	/NO - UPDATE OUTPUT COUNT
	JMS I	OUTHND	/OUTPUT THE BUFFER
OUCTRL,	4400
BUFOUT,	OUT
OBLK,	0
	JMP	OERR
	TAD	OBLK
	TAD	INRSIZ	/BUMP THE OUTPUT RECORD NUMBER BY THE MAXIMUM
OSETP,	DCA	OBLK	/SINCE ALL WRITES EXCEPT THE LAST ARE MAXIMAL
	TAD	BUFOUT	/BUFFER POINTERS
	DCA	OPTR1
	TAD	BUFOUT
	DCA	OPTR2
	TAD	OUTSIZ
	DCA	OCRCNT	/DOUBLEWORD COUNT (7377 IF 8K, 6777 IF 12K)
	JMP	SETO3	/SET BYTE COUNTER AND RETURN
OERR,	CLA
	TAD	ERROR
	DCA	OUTR	/INHIBIT FUTURE OUTPUT
ERR14,	ERR
O2,	DCA I	OPTR1	/NORMAL HANDLING
	ISZ	OPTR1	/BUMP POINTER
	JMP I	DECPUT
OPTR1,	0
OMAXLN,	0		/SIZE OF HOLE FOR OUTPUT
OUTSIZ,	7377		/6777
O3,	0
FITS,	0		/SUBROUTINE TO CHECK FOR OUTPUT OVERFLOW
	TAD	OPTR1	/** AC MAY CONTAIN FUDGE ON INPUT **
	CIA
	TAD	BUFOUT	/COMPUTE NUMBER OF WORDS IN BUFFER
	AND	[7400	/ROUND "UP" TO NEXT BUFFERLOAD
	CIA		/MAKE POSITIVE
	CLL CML RAR
	DCA	OUCTRL	/AND SAVE IT AS A BUFFER CONTROL WORD
	TAD	OUCTRL
	CLL RAL
	CLL RTL		/ISOLATE THE BLOCK COUNT OF THE CONTROL WORD
	RTL		/IN THE LOW ORDER PART OF THE AC
	RAL
	TAD	OCNT	/ADD IT TO THE CURRENT OUTPUT COUNT
	CLL CML
	TAD	OMAXLN	/SEE THAT WE DIDN'T OVERFLOW
	SNL SZA		/THE ASSIGNED OUTPUT AREA
	JMP I	FITS	/OOPS - WE DID - ERROR RETURN
	CIA
	TAD	OMAXLN	/SUBTRACT OFF THE LIMIT
	CIA		/TO ARRIVE AT THE UPDATED BLOCK COUNT
	ISZ	FITS
	JMP I	FITS	/AND SKIP RETURN
OUNAM,	ZBLOCK	4	/NAME OF OPEN OUTPUT FILE GOES HERE
	PAGE
/DISPLAY ROUTINE FOR PDP-12 SCOPE

WASTE,	0		/** MUST BE AT MULTIPLE OF 2000
XPOS,	0		/PDP-12 BETA REGISTER 1
BETA2,	0		/PDP-12 BETA REGISTER 2

DSPLAY,	0		/TEXT DISPLAY ROUTINE FOR TECO
	MTHREE		/THIS ROUTINE DEPENDS ON THE FACT THAT THE
	TAD	DSPLAY	/HIGH ORDER BITS OF THE X-COORD ARE IGNORED
	DCA	DX	/BY THE VR12 HARDWARE
	TAD I	DX	/GET THE SKIP
	DCA	DLPTST	/PUT IT IN THE LOOP
	TAD	P
	DCA	DX
	TAD	NUMLNS
	STL CIA		/LOOK BACKWARD
	PUSHJ		/FOR BEGINNING OF DISPLAY AREA
		CHRL1
D360,	STA STL		/=7360
	TAD	P
	DCA	DM
	TAD	DX
	DCA	P	/RESTORE POSITION
	TAD	NUMLNS	/NOW SCAN FORWARD
	CLL IAC
	PUSHJ		/FOR THE END OF THE DISPLAY AREA
		CHRL1
	TAD	P
	CIA
	TAD	DM
	DCA	R	/*K* THIS NUMBER MUST GO IN R -
	TAD	DX	/THE ^W COMMAND NEEDS IT THERE
	DCA	P	/RESTORE ORIGINAL P
DSETUP,	TAD	P
	CIA
	TAD	DM
	DCA	DQ	/SAVE COUNT OF CHARS TO CURSOR POSITION
	TAD	DM
	DCA	DX
	TAD	R
	DCA	DR
	TAD	D360
	DCA	YPOS
DISCR,	TAD	DISLF
SETXPS,	DCA	XPOS	/SET X POSITION/COLUMN COUNTER
	JMP	DLPTST
	/DISPLAY LOOP

DGETCH,	CDF 10
	TAD I	DX
	CDF 0		/GET THE CHARACTER FROM FIELD 1
	AND	[177	/AND OFF THE HIGH ORDER BITS
	TAD	(-33
	SNA		/CHANGE ALTMODES
	TAD	CAHT	/TO DOLLAR SIGNS
	TAD	(-5
	SMA SZA		/IF NOT A CONTXRACTER
	JMP	DLOOP	/DISPLAY IT AND KEEP GOING
	SNA
	JMP	DBLANK	/DO BLANKS FAST
	TAD	(40-15
	SNA		/CR?
	JMP	DISCR	/YES - RESET X COORD
	STL
	TAD	[4
	SNA		/TAB?
	JMP	DTABB
	SNL
	JMP	DISLF	/LINE FEED, VERTICAL TAB, OR FORM FEED
	TAD	(51	/ORDINARY CONTROL CHAR - RESTORE IT + 40
	DCA	WASTE	/SAVE CHAR
	JMS	DISCHR	/DISPLAY ^
	TAD	WASTE	/NOW DISPLAY ALTERED CHAR
DLOOP,	JMS	DISCHR

DLPTST,	HLT		/EITHER KSF OR TSF OR "ISZ R"
	SKP
	JMP I	DSPLAY	/EXIT IMMEDIATELY IF TEST SKIPS
	ISZ	DQ	/ARE WE AT THE CURRENT POINTER POSITION?
	JMP	TSTEDS	/NO
	TAD	(-5
	TAD	XPOS
	DCA	XPOS	/BACK UP X POSITION A HALF-CHARACTER
	TAD	DM20
	TAD	YPOS
	6141		/ENTER LINC MODE
DM20,	1760		/DSC I
	2000
	1760		/DISPLAY A ^
	2076
	0002		/PDP
	MTHREE		/AND MOVE X POSITION BACK TO WHERE IT WAS
	JMP	DBLANK+1
TSTEDS,	ISZ	DR	/ARE WE THROUGH?
	JMP	DGETCH	/NO
	JMP	DSETUP	/YES - START OVER
DTABB,	TAD	XPOS	/DISPLAY TAB
	CMA
	AND	Z7
	DCA	WASTE	/GET NUMBER OF COLUMNS TO GO (-1)
	TAD	WASTE
	CLL RTL
	RAL
	TAD	WASTE	/MULTIPLY BY 9
DBLANK,	TAD	CAHT	/BUMP ONE MORE COLUMN
	TAD	XPOS
	SZA		/OVERFLOW?
	JMP	SETXPS	/NO - SET XPOS AND CONTINUE
	JMP	LINOFL	/YES - GO TO THE NEXT LINE

/SUBROUTINE TO DISPLAY A CHARACTER

DISCHR,	DLPTST		/*K* DISCHR MUST CONTAIN "DLPTST" WHEN WE
	CLL RAL		/ARE EXAMINING CHARACTERS **
	TAD	(DTABLE-1
	DCA	BETA2	/STORE ADDRESS OF TABLE ENTRY FOR CHAR -1
	TAD	YPOS

	6141		/ENTER LINC MODE
	1762		/DSC I 2
	1762		/DSC I 2
	0002		/RE-ENTER PDP-8 MODE

	CLA
	ISZ	XPOS	/BUMP THE X COORDINATE/COLUMN COUNTER
	JMP I	DISCHR	/RETURN
LINOFL,	TAD	(7054	/INDENT ALL CONTINUATION LINES
	DCA	XPOS
DISLF,	RAR		/*K* RAR=7010  AC MAY HAVE A SMALL NUMBER
	TAD	YPOS	/IN IT HERE - THATS OK AS LONG AS ITS SMALL,
	TAD	[-40	/SINCE ONLY THE HIGH 8 BITS OF YPOS COUNT.
	DCA	YPOS
	JMP I	DISCHR	/*K* THIS ALWAYS RETURNS TO DLPTST **

YPOS=	NAME		/USE SOME FREE PAGE ZERO LOCATIONS
DR=	NAME+1		/FOR OUR TEMPORARIES
DQ=	NAME+2
DM=	NAME+3
	PAGE
DTABLE,	2000;2076;	7500;0000;	7000;0070;	7714;1477
	5721;4671;	6661;4333;	5166;0526;	0000;0070
	3600;0041;	4100;0036;	2050;0050;	0404;0437
	0500;0006;	0404;0404;	0001;0000;	0601;4030
	4536;3651;	2101;0177;	4523;2151;	4122;2651
	2414;0477;	5172;0651;	1506;4225;	4443;6050
	5126;2651;	5122;3651;	2200;0000;	4601;0000
	1000;4224;	1212;1212;	2442;0010;	4020;2055
	4077;5751;	4477;7744;	5177;2651;	4136;2241
	4177;3641;	4577;4145;	4477;4044;	4136;2645
	1077;7710;	7741;0041;	4142;4076;	1077;4324
	0177;0301;	3077;7730;	3077;7706;	4177;7741
	4477;3044;	4276;0376;	4477;3146;	5121;4651
	4040;4077;	0177;7701;	0176;7402;	0677;7701
	1463;6314;	0770;7007;	4543;6151;	4177;0000
	3040;0106;	0000;7741;	2000;2076;	1604;0404
STABLE,	ZBLOCK	40	/SEARCH BUFFER

CTLW,	NCHK		/^W COMMAND - IF THERE WAS A NUMBER BEFORE
	JMP	CTLW2	/THE ^W, SET THE NUMBER OF LINES TO DISPLAY
	TAD	N	/EQUAL TO THAT NUMBER.
	DCA	NUMLNS
			/DON'T WORRY ABOUT NEGATIVE N
CTLW2,	ISZ	R	/FAKE OUT! (MUST BE BEFORE CALL TO DISPLY)
	DISPLY		/IN ANY CASE, GO THROUGH ONE DISPLAY CYCLE
	POPJ		/THEN RETURN

SAVTRA,	0		/SAVE TRACE MODE
	TAD	TFLG
	DCA	TFGTMP
	DCA	TFLG
	JMP I	SAVTRA	/EXIT WITH TRACE OFF

RESTRA,	0		/RESTORE TRACE MODE
	TAD	TFGTMP
	DCA	TFLG
	JMP I	RESTRA
TFGTMP,	0

CHKQF,	0		/CHECK FOR EXPLICIT QUOTES
	ISZ	QFLG	/QUOTE FLAG SET?
	JMP	.+3	/NO
	SCAN		/GET QUOTING CHAR
	DCA	QUOTE	/PUT INTO SEARCH TABLE
	DCA	QFLG	/ZAP QUOTE FLAG
	JMP I	CHKQF	/RETURN
NXTBUF,	0
	SZA CLA
	JMP	NOWRIT	/READ-ONLY IF AC NOT 0 ON ENTRY
	PUSHJ
		CPOC	/HP
	DCA	ZZ	/FORCE Y TO WORK
	ISZ	FFFLAG	/IF WE DIDN'T SEE A FORM FEED ON INPUT
	JMP	NOWRIT	/DON'T OUTPUT ONE
	TAD	CAFF
	OUTPUT
NOWRIT,	PUSHJ
		CHRY	/READ NEW BUFFER
	CTCCHK		/CHECK FOR ^C AND ^P
	CLA		/*K* CTCCHK LEAVES AC NON-ZERO!
	JMP I	NXTBUF

GETUSR,	0		/ROUTINE TO LOCK THE USR INTO CORE
	CDF 0
	TAD	ZZ	/IF THE TEXT BUFFER IS EMPTY AND
	SNA CLA		/WE HAVE 12K, SO Q-REGS ARE IN FIELD 2,
NWRUSR,	NOP		/(CHANGED BY INIT CODE TO "TAD [4" IF 12K)
	STL RTR		/THEN WE SHOULD NOT SAVE CORE ON A USR CALL.
	DCA I	(JSBITS	/THIS STORES A 2000 OR A 2001
	CIF 10
	JMS I	[7700	/OK - NOW LOAD THE USR IN
	10
	JMP I	GETUSR
/E COMMAND MODIFIERS

EFLST,	102		/EB	I
	103		/EC	X
	106		/EF	X
	107		/EG	X
	113		/EK	X
	122		/ER	I
	127		/EW	I
	130		/EX	I

CHRU,	QREF		/COMMAND U
	NCHK
ERR22,	ERR		/U MUST BE PRECEDED BY A NUMBER
	TAD	NLINK
	CLL RTR
	DCA	NLINK
	AC3777
	AND I	QPTR
	TAD	NLINK
	DCA I	QPTR
	ISZ	QPTR
	TAD	N
	DCA I	QPTR
	POPJ

/RADIX TABLES:

ORAD,	NOP
	1000
	100
	10
DRAD,	NP&177+1200	/"TAD NP"
	1750
	144
	12
/DISPATCH TABLE FOR COMMAND INPUT

COMTAB,	TBEL		/^G
	TCRLF		/CR
RUBY,	ROCMND		/RUBOUT
	TCTLU		/^U
	TALTM		/ALTMODE
	TQMK		/?
	TSAVE		/^S
	TSTAR		/*
	TSPACE		/SPACE

EDFLAG,	0		/MUST BE KEPT TOGETHER
EHFLAG,	0
EOFLAG,	VERSN
ESFLAG,	0
ETFLAG,	0
EUFLAG,	0
/CXFLAG,	0
	PAGE
/COMMAND M
/AND Q-REGISTER STORAGE
COMLST,	7		/^G, COMMAND LINE EDIT LIST
	15		/CR, INSERT CR & LF
	177		/RUBOUT
	25		/^U - RUB OUT LINE
	33		/^[, ALT MODE
	77		/?
	23		/^S - SAVE OLD COMMAND LINE IN Q-REG Z
	52		/*
	40		/SPACE

CHRM,	QREF		/COMMAND M
	TAD	M4	/4 ITEMS PUSHED TO
	PUSHL		/SAVE CURRENT MACRO STATE
		QCMND
		MPDL
		ITRST	/SO THE "O" COMMAND WILL WORK IN MACROS
		SCANP	/ZEROED BY "PUSHL"
	TAD	PDLP	/MUST CHECK PDL AT END OF MACRO
	CIA
	DCA	MPDL
	TAD	QNMBR	/Q-REGISTER TO EXECUTE
	SETCMD		/SET COMMAND LINE TO THIS Q-REG
	POPJ		/LEAVE NUMBER FLAG ALONE AND EXIT

CHKBZ,	0		/SEE THAT B .LE. C(AC) .LE. ZZ
	SZL
	JMP	ERR11	/POP
	CIA		/ENTERED WITH LINK SET CORRECTLY
	TAD	ZZ
	SNL		/13-BIT ARITHMETIC
ERR11,	ERR		/C(AC)>ZZ
	CIA
	TAD	ZZ	/RESTORE ORIGINAL AC
	JMP I	CHKBZ

ALTLST,	175	/ALT MODE
	176	/ANOTHER ALTMODE
M4,	-4
SCUPPR,	0		/SCAN AND CONVERT TO UPPER CASE
	SCAN
	UPPERC
	JMP I	SCUPPR	/THAT'S ALL?

/Q-REGISTER STORAGE - EACH Q-REGISTER TAKES 2 WORDS.
/WD 1 CONTAINS THE LENGTH OF THE CHARACTER PART OF THE REGISTER (IF ANY)
/WD 2 CONTAINS THE VALUE  OF THE NUMERIC PART OF THE REGISTER (IF ANY)

QARRAY,	ZBLOCK	110	/36 Q-REGISTERS * 2 WORDS/REGISTER = 72 WORDS
QPNTR,	CHNSTR		/FAKE Q-REGISTER FOR INPUT LINE - LENGTH ONLY.
CTLT,	NCHK
	JMP	CTLT2	/NO ARG
	TAD	N
ET1,	TYPE		/TYPE CHAR REPRESENTED BY ARGUMENT
	POPJ
CTLT2,	LISTEN		/^T COMMAND - VALUE OF NEXT CHAR FROM TTY
ET8,	TYPE		/*ET	ECHO THE CHARACTER
	TAD	SCHAR	/GET THE CHARACTER
	JMP I	(NCOM14	/JUMP INTO NUMBER PROCESSOR

CTLE,	TAD	FFFLAG	/^E COMMAND - RETURNS FORM FEED FLAG
NNEW13,	CLL
	SPA
	STL		/EXTEND SIGN BIT TO LINK
	JMP I	(NCOM	/RETURN -1 IF F.F., 0 OTHERWISE
	PAGE
	*5000

/COMMAND DISPATCH TABLE	** ALLOW EVEN/ODD FOR NOVICE SUBSET?

CDSP,	POPK;CTLA;SERR;CTLC;CTLD;CTLE;CTLF;CTLC	/0-7
	CTLH;CTLI;POPK;SERR;POPK;POPK;CTLN;CTLO	/10-17
	  T0;SERR;SERR;SERR;CTLT;CTLU;ERR35;ERR27	/20-27
	SERR;SERR;SERR;ZRON;SERR;SERR;CTUA;SERR	/30-37
	POPK;CEXP;CDBQ;CNBS;SERR;CPCS;CAMP;ZRON	/40-47
	COPR;CCPR;CAST;CPLS;CCMA;CMIN;CDOT;CVIR	/50-57
	NMBR;NMBR;NMBR;NMBR;NMBR;NMBR;NMBR;NMBR	/60-67
	NMBR;NMBR;CCLN;CSEM;CHLT;CEQL;CHGT;CQSM	/70-77
	CATS;CHRA;CHRB;CHRC;CHRD;CHRE;CHRF;CHRG	/100-107
	CHRH;CHRI;CHRJ;CHRK;CHRL;CHRM;CHRN;CHRO	/110-117
	CHRP;CHRQ;CHRR;CHRS;CHRT;CHRU;SERR;SERR	/120-127
	CHRX;CHRY;CHRZ;SERR;CBSL;SERR;CHUA;CHBA	/130-137
	/END OF DISPATCH TABLE

PDLBEG,	ZBLOCK	11	/BEGINNING OF PUSHDOWN LIST
QPUT12,	ZBLOCK	16	/ROUTINES INSERTED LATER - USED IN
ASR35,	ZBLOCK	10	/INITIALIZATION, OVERLAYED BY PUSHDOWN LIST
PDLEND,	0		/END OF PUSHDOWN LIST
	PAGE
	*5200

/	INITIALIZATION SECTION
/	ENTER HERE AT 5200 TO MODIFY TECO TO USE A MODEL 35 TELETYPE
/	SORRY - NO CURRENT PAGE LITERALS

TECO35,	ISZ	JTECO	/IF CALLED VIA "R" OR "RUN"
	TAD I	XR	/MOVE ASR-35 PATCH (WHICH OUTPUTS TABS AND
	DCA I	INXR	/ FORM FEEDS) OVER PRINT ROUTINE
	ISZ	ASRCNT
	JMP	.-3
	TAD	YOUTHTX
	DCA I	YPOUTHT
	TAD	[TECO
	DCA I	Y7745	/CHANGE STARTING ADDRESS IN CASE WE'RE RESTARTED
			/AND FALL INTO INITIALIZATION ROUTINE

TCINIT,	TLS		/INITIALIZATION ROUTINE - INITIALIZE THE TTY
	TAD	.-1
	DCA I	[TECO
	TAD	YT0A		/"JMP T0A"
	DCA I	PTECO1	/CHANGE THE ENTRY AT 200 SO WE'RE NOT CALLED AGAIN
	CLA STL
	6141		/ENTER LINC MODE (MAYBE)
	4		/ESF - SET SMALL CHARACTERS FOR SCOPE
	0261		/ROL I 1 - ROTATE LINK INTO AC11
	0002		/BACK TO PDP-8 MODE
	SNA CLA		/AC NON-ZERO IF WE ARE A PDP-12
	JMP	NOTA12	/NO, JUST AN ORDINARY 8
	TAD	YPDP12
	JMS	CHANGE	/TRADE OFF TWO PAGE HANDLERS FOR A SCOPE
NOTA12,	TAD I Y7777
	AND COR70
	SZA
	JMP	SOFCOR
COR0,	CDF 0		/NEEDED FOR PDP-8L
	TAD CORSIZ	/GET FIELD TO TEST
	RTL
	RAL
	AND COR70	/MASK USEFUL BITS
	TAD COREX
	DCA .+1		/SET UP CDF TO FIELD
COR1,	CDF /N		/N IS FIELD TO TEST
	TAD I CORLOC	/SAVE CURRENT CONTENTS
COR2,	NOP		/HACK FOR PDP-8!
	DCA COR1
	TAD COR2	/7000 IS A "GOOD" PATTERN
	DCA I CORLOC
COR70,	70		/HACK FOR PDP-8, NOP
	TAD I CORLOC	/TRY TO READ BACK 7000
CORX,	7400		/HACK FOR PDP-8, NOP
	TAD CORX	/GUARD AGAINST WRAP-AROUND
	TAD CORV	/TAD (1400
	SZA CLA
	JMP COREX	/NON-EXISTENT FIELD EXIT
	TAD COR1	/RESTORE CONTENTS DESTROYED
	DCA I CORLOC
	ISZ CORSIZ	/TRY NEXT HIGHER FIELD
	JMP COR0

COREX,	CDF 0		/LEAVE WITH DATA FIELD 0
	STA
	TAD CORSIZ	/HIGHEST EXISTING FIELD
COR999,	DCA	MEMSIZ
	TAD	MEMSIZ
	SNA CLA
	JMP	JTECOM	/8K
	TAD	YM7	/MORE THAN 8K
	JMS I	YMOVE
	CDF	0
	QPUT12-1
	CDF	0
	QPUTS-1
	TAD	YM7
	JMS I	YMOVE
	CDF	0
	QPUT12+7-1
	CDF	0
	GETQX-1
	TAD	YTWLVEK
	JMS	CHANGE	/AND CHANGE A WHOLE MESS OF LOCATIONS
JTECOM,	JMS I	YOVINIT	/WRITE OUT OVERLAYS
	CDF	10
	TAD I	YSCPBIT
	CDF	0
	AND	[200
	SNA CLA
	JMP	JTECO
	TAD	YSCOPE
	JMS	CHANGE
JTECO,	JMP I	.+1	/INCREMENTED IF WE WERE'NT CHAINED TO
	CHINIL
PTECO1,	TECO1

CORLOC,	CORX		/ADDRESS TO TEST IN EACH FIELD
CORV,	1400		/7000+7400+1400=0
CORSIZ,	1		/CURRENT FIELD TO TEST

SOFCOR,	CLL RAR
	RTR
	JMP	COR999
/CHAINED INIT CODE - MOVE 17600 INTO Q-REGISTER SPACE

CHINIL,	CDF 10
	TAD I	DX	/GET A COMMAND LINE CHAR
	CDF 0
	QPUT
	ISZ	INICT
	JMP	CHINIL
	TAD	YFATALJ	/SET UP THE FATAL ERROR EXIT
	DCA I	YCHOOPS	/IN THE ERROR ROUTINE
	JMP I	YCHTECO
INICT,	-CHNSTR

ASRCNT,
CHANGE,	-10		/ROUTINE TO CHANGE SPECIFIC LOCATIONS
	DCA	XR	/STORE TABLE POINTER
CHANGL,	TAD I	XR	/GET LOCATION
	SNA
	JMP I	CHANGE	/END OF LIST - RETURN
	DCA	TEMPT
	TAD I	XR	/GET CONTENTS
	DCA I	TEMPT	/ZAP!
	JMP	CHANGL

/CHECK FOR OS/8 SCOPE BIT, IF ON, PATCH TECO
/ALSO SEND ESC SEQ TO TERMINAL TO SEE IF VT05 OR VT5X.


YOUTHTX,	OUTHTX
YPOUTHT,POUTHT
Y7745,	7745
Y7777,	7777
YM7,	-7
YMOVE,	MOVE
YOVINIT,OVINIT
YSCPBIT,SCPBIT
YFATALJ,FATALJ
YCHOOPS,CHOOPS
YCHTECO,CHTECO
YPDP12,	PDP12-1
YTWLVEK,TWLVEK-1
YSCOPE,	SCOPE-1
YT0A,	T0A&177+5200
/FLOW INTO NEXT PAGE
SCOPE,	RUBY;	SCOPY		/MAKE SCOPE RUBOUTS WORK
	BLSP1;	TAD CACR	/MAKE BELL SPACE WORK
	BLSP2;	TYPE		/AND MORE RUBOUTS
	BLSP3;	SCAPE&177+4600	/JMS I (ESCAPE
	BLSP4;	113		/MORE BELL SPACE
	EUFLAG;	-1		/SET EU TO -1
	EU1;	CLA
	EU2;	TAD [40
	0
/LOCATIONS TO CHANGE MUST BE CHANGED IN OVERLAY IMAGE
/BEFORE OVERLAY IS WRITTEN OUT

/LOCATIONS TO CHANGE IF WE HAVE 12K OF CORE

TWLVEK,	INRSIZ;	4	/INPUT BUFFER GROWS TO 4 BLOCKS LONG
	INCTLW;	1021	/AND LIVES IN FIELD 2
	INPCNT;	5000
	I2;	CDF 20
	IC;	CDF 0	/THIS WAS A NOP TO SPEED UP RTS-8 OPERATION
	L12K1;	J12K1	/SPEED UP TEXT MOVE ROUTINES,
	L12K2;	J12K2	/SINCE Q-REGISTERS DON'T SIT ON TOP OF TEXT.
	OUTSIZ;	6777	/OUTPUT BUFFER TAKES OVER OLD INPUT BUFFER SPACE
	BUFIN;	5600
	NWRUSR;	TAD [4	/LET USR BE CALLED WITHOUT SAVING CORE
	MQMAX;	-Q12MAX	/ALLOW MORE Q-REGISTER STORAGE
	QLIMIT;	12-Q12MAX
	0


/LOCATIONS TO CHANGE IF WE'RE RUNNING ON A PDP-12

PDP12,	KSFWT;	DISPLY	/FIX KEYBOARD AND PRINTER WAITS
	TSFWT;	DISPLY	/SO THEY DISPLAY WHILE WAITING
	CDSP+127;CTLW	/ENABLE W COMMAND
	INHNDL;	7200	/ONE PAGE INPUT HANDLER ONLY
	OUHNDL;	7400	/DITTO OUTPUT HANDLER
			/VALUE MUST BE 0 INITIALLY TO END LIST
OVINIT,	0		/WRITE OUT OVERLAYS
/IF MORE THAN 12K, MOVE OVERLAYS TO FIELD 3
	MTHREE
	TAD	MEMSIZ
	SPA CLA
	JMP	L16K	/LESS THAN 16K
	TAD	[-400
	JMS	MOVE
	CDF	0
	3200-1
	CDF 30
	MEMLOC-1
	TAD	M2000
	JMS	MOVE
	CDF	0
	5600-1
	CDF	30
	MEMLOC+400-1
	TAD	M5
	JMS	MOVE
	CDF	10
	NEWERR-1
	CDF	0
	OVREAD-1
/	TAD	(COREAD-COREND-1
	TAD	M3000
	JMS	MOVE
	CDF	10
	4400-1		/	COREAD-1
	CDF	30
	4400-1
	JMP	G16K
L16K,	JMS I	(7607
	4200
	3200		/WRITE OUT I/O-OVERLAY
	IOVRLC
	JMP	OVERR	/ERROR WRITING OVERLAY
M3000,	JMS I	(7607
	5400		/4 OVERLAYS
	5600		/WRITE OUT Q-OVERLAY AND E-OVERLAY
	QOVRLC
	JMP	OVERR	/ERROR WRITING OUT OVERLAY
G16K,	DCA I	(ERRXX
	JMP I	OVINIT	/RETURN

OVERR,	TAD	[-400	/SWAP IN ERROR OVERLAY FROM CORE AND MAKE SURE
	JMS	MOVE	/WE RETURN TO MONITOR
	CDF	0
	6200-1
	CDF	0
	3200-1
/	DCA I	(ERRTMP	/SET FATAL SWITCH
	TAD	(FATALJ
	DCA I	(CHOOPS
ERR30,	JMP I	(ERRYY	/CALL ERROR MESSAGE PROCESSOR

M2000,	-2000
M5,	-5
MOVE,	0
	DCA	MQ
	TAD I	MOVE
	DCA	MOVEL
	ISZ	MOVE
	TAD I	MOVE
	DCA	INXR
	ISZ	MOVE
	TAD I	MOVE
	DCA	MOVEC
	ISZ	MOVE
	TAD I	MOVE
	DCA	XR
	ISZ	MOVE
MOVEL,	HLT
	TAD I	INXR
MOVEC,	HLT
	DCA I	XR
	CDF	0
	ISZ	MQ
	JMP	MOVEL
	JMP I	MOVE
	/ROUTINES TO BE (POSSIBLY) SWAPPED INTO TECO

	*QPUT12
	RELOC QPUTS
QPUTS,	0		/12K Q-REGISTER PUT ROUTINE
	AND	[377
	CDF 20
	DCA I	QP
	CDF 0
	ISZ	QP
	JMP I	QPUTS

	RELOC GETQX
GETQX,	0		/12K Q-REGISTER GET ROUTINE
	DCA	CHKCTC
	CDF 20
	TAD I	CHKCTC
	CDF 0
	AND	[377
	JMP I	GETQX

	RELOC ASR33
	JMP	OUTCMX	/ FORM FEED/VERT. TAB - USE 8/4 FILLERS
OUTHTX,	TAD	COLCT	/GET COLUMN COUNTER
	RTR
	RAR
	CLA CMA RAL	/OUTPUT 2 FILLERS IF MORE THAN 4 CHARS TO TAB
	DCA	COLCT	/OTHERWISE 1 (COLCT IS A MODULO 8 COUNTER)
OUTCMX,	TAD	SCHAR	/GET CONTROL CHAR TO TYPE
	PUTT		/AND TYPE IT - WE WILL NOW FILL WITH NULLS
	RELOC
	PAGE
/	Q-OVERLAY

	*5600

	RELOC 3200

	IOVRLC
QOVRLY,	0
	EOVRLC
	XOVRLC
	FOVRLC

/O COMMAND

CHROO,	TAD	SCANP	/O COMMAND
	DCA	COOQ	/SAVE CURRENT SCAN POINTER
	DCA	NFLG
/???	DCA	QFLG	/QUOTED "O" COMMAND NOT ALLOWED
	QSKP		/CHECK THAT THERE IS REALLY A STRING HERE
			/BECAUSE WE WILL NOT USE "SCAN" TO GET CHARACTERS
			/FROM THIS STRING IN THE SEARCH LOOP.
	TAD	ITRST	/"O" ONLY SCANS FROM THE BEGINNING OF THE
	DCA	SCANP	/CURRENT ITERATION LOOP.
			/(JUMPS BACKWARD OUT OF ITERATIONS ARE VERBOTEN)
	SKPSET
CS41,		41	/SEARCH FOR !
	TAD	CS41
	DCA	QUOTE	/SET QUOTE CHAR TO !
	TAD	COOQ
	TAD	QBASE
	DCA	QP	/SET UP PTR TO ACCESS GOTO STRING
COOC,	TAD	QP
	GETQ		/GET CHAR FROM GOTO STRING
	CIA
	DCA	MQ	/SAVE IT
	QUOTST		/GET CHAR FROM LABEL
	JMP	COOB	/LABEL EXHAUSTED
	TAD	MQ
	SZA CLA		/MATCH?
	JMP	CSMQ	/NO - REJOIN SEARCH ROUTINE FOR ANOTHER !
	ISZ	QP
	JMP	COOC
COOB,	TAD	MQ
	TAD	CAAM	/IS GOTO STRING EXHAUSTED TOO?
	SZA CLA
	JMP	CSMQ+1	/NO - REJOIN ! SEARCH ROUTINE
	ENTRCE		/RE-ENABLE TRACE
	JMP I	[IREST
COOQ,	0
/ROUTINE TO SKIP COMMANDS UP TO A CHARACTER

SETSKP,	0		/SET UP TO SKIP COMMANDS
	TAD I	SETSKP
	DCA	SKPLST	/CHAR TO TRAP ON
	NOTRCE		/DISABLE TRACE MODE
CSML1,	DCA	BRACKS	/INITIALIZE BRACKET LEVEL
CSML,	SCANUP		/GET A COMMAND CHAR
	SORT
		SKPLST
		SKPTAB-SKPLST
	JMP	CSML	/NOTHING SPECIAL - KEEP GOING
CSMD,	SCAN		/CLEAR OUT MODIFIER
	JMP	CSML

CSMU,	SCAN		/SKIP ^U COMMAND
	SKP CLA		/GET RID OF Q-REG NUMBER
CSMFS,	QSKP		/FS COMMAND - SKIP FIRST STRING
CSMQ,	QSKP		/SKIP OVER A QUOTED STRING
CSMQ1,	PUSHJ
		IREST	/FIX UP QUOTE CHAR
	JMP	CSML	/KEEP GOING

CSMY,	TAD	SCHAR	/SKIP ROUTINE FOR ^A AND !
	DCA	QUOTE	/WE MUST SCAN UNTIL WE FIND
	JMP	CSMQ	/A COPY OF THE COMMAND CHARACTER.
	/SORT LIST FOR " COMMAND

CNDLST,	103		/C
	107		/G
	116		/N
	114		/L
	105		/E
	124		/T
	123		/S
	106		/F
	125		/U
	122		/R
	74		/<
	76		/>

CSME,	SCANUP		/FOUND E COMMAND
	SORT
		ESKLST		/LOOK FOR ER & EW & EG
		ESKTAB-ESKLST	/USE CSMQ TO SKIP
	JMP	CSML	/NO STRING

CSMF,	SCAN		/F COMMAND - BETTER BE FOLLOWED BY S,N, OR _
	CLA
	JMP	CSMFS	/SCAN OFF TWO STRINGS

CSMI,	ISZ	BRACKS	/INCREMENT BRACKET LEVEL
	JMP	CSML

CSMO,	STA
	TAD	BRACKS	/DECREMENT BRACKET LEVEL
	SPA
	JMS I	(POPITR	/IF WE EXIT <> POP OFF ITERATION VALUES
	JMP	CSML1

SKPRTN,	TAD	BRACKS	/WE HAVE FOUND THE DESIRED CHARACTER
	SZA CLA		/BUT IF THE BRACKET LEVEL IS NON-ZERO,
	JMP I	XSORTA1	/WE CANNOT ACCEPT IT - KEEP SORTING
	JMP I	SETSKP	/EVERYTHING IS OK - RETURN

BRACKS,	0
/SORT LIST FOR SKIPPING OVER COMMANDS

SKPLST,	0	/TRAP CHAR
	41	/!
	76	/>
	74	/<
	42	/"
	136	/^
	100	/@
	1	/^A
	11	/TAB
	25	/^U
	36	/^^
	105	/E
	106	/F
	111	/I
	116	/N
	117	/O
	123	/S
	137	/_
	121	/Q
	125	/U
	130	/X
	107	/G
	115	/M
	45	/%
/	SKIP LIST FOR E'S
ESKLST,	122		/R
	127		/W
	102		/B
	107		/G

CSMA,	STA		/LIST TERMINATOR
	JMP	CSMQ1	/FOUND @ - SET QUOTE FLAG AND CONTINUE


XSORTA1,SORTA1
	PAGE
/DISPATCH TABLE FOR SKIPPING OVER COMMANDS:

SKPTAB,	SKPRTN	/DESIRED CHARACTER - RETURN
	CSMY	/!
	CSMO	/>
	CSMI	/<
	CNDI	/"
	CSMC	/^
	CSMA	/@
	CSMY	/^A
	CSMQ	/TAB
	CSMU	/^U
	CSMD	/^^
	CSME	/E
	CSMF	/F
ESKTAB,	CSMQ	/I OR ER
	CSMQ	/N OR EW
	CSMQ	/O OR EB
	CSMQ	/S OR EG
	CSMQ	/_
	CSMD	/Q
	CSMD	/U
	CSMD	/X
	CSMD	/G
	CSMD	/M
	CSMD	/%
SEMO,	SKPSET		/PLOD THRU
		76	/LOOKING FOR >
	ENTRCE		/IT'S THE RIGHT ONE, TURN TRACE BACK ON
	JMP I ZCGSG
ZCGSG,	CGSG

CNDTAB,	TSTSEP		/LEGAL CONSTITUENT OF SYMBOL FOR ASSEMBLER
	SZL SNA CLA	/GT 0
	SNA CLA		/NE 0
	SNL CLA		/LT 0
	SZA CLA		/EQ 0
	SNL CLA		/TRUE
	SNL CLA		/SUCCESSFUL
	SZA CLA		/FALSE
	SZA CLA		/UNSUCCESSFUL
	TSTSEP		/ALPHANUMERIC
	SNL CLA		/<
	SZL SNA CLA	/>

/THIS TABLE PRESUPPOSES 1000000000000 IS ILLEGAL
	/COMMANDS " AND '

CDBQO,	NCHK		/COMMAND "
ERR23,	ERR		/NO NUMBER TO TEST
	SCANUP
	SORT
		CNDLST
		CNDTAB-CNDLST
	SMA		/CHECK THAT CHAR WAS TRANSLATED
ERR20,	ERR		/NO - NO SUCH TEST
	DCA	SKIP	/STORE TEST INSTRUCTION
	GETNUM		/PERFORM THE TEST
SKIP,	HLT		/TEST SKIPS IF TRUE
	SKP CLA
	POPJ		/CONDITION SATISFIED
	STA		/NOT SATISFIED
	DCA	SKIP	/BEGINNING SKIPPING COMMANDS
	SKPSET		/CALL SKIPPING ROUTINE
		47	/FIND A '
	ISZ	SKIP	/FOUND A '
	RESORT		/NEED ANOTHER: BACK TO CSML
	ENTRCE		/RE-ENABLE TRACE
	JMP I	[IREST	/COMMAND ' NO ACTION TO TAKE

CNDI,	SCAN		/HIT ANOTHER "
	STA		/SO SKIP MATCHING '
	TAD	SKIP
	DCA	SKIP
	RESORT		/GO BACK TO CSML
/COMMANDS ; AND >

CSEMO,	TAD	ITRST	/COMMAND ; - ALSO HERE ON FAILING NON-COLON SEARCH
	SNA CLA
ERR09,	ERR		/IF NOT IN ITERATION
CSEM2,	TAD	NLINK
	SNA CLA
	NCHK
	JMP I	(ZRON	/NO NUMBER - IGNORE IT, WE DID IT ALREADY
	JMP	SEMO	/SEARCH FOR >

CHGTO,	TAD	ITRCNT
	SNA CLA
	JMP	CGTC	/0 MEANS INFINITY
	ISZ	ITRCNT	/LOOK FOR COUNT EXHAUSTED
	JMP	CGTC	/NO, CONTINUE
CGSG,	JMS	POPITR	/POP UP OLD ITERATION PARAMETERS
	JMP I	[IREST
CGTC,	TAD	ITRST
	SNA
ERR10,	ERR		/IF NOT IN ITERATION
	JMP I	(ZROSPN	/BACK TO ROOT

POPITR,	0
	CLA IAC		/** AC NOT NECESSARILY 0 ON ENTRY
	POPL
		ITRCNT
		ITRST
	JMP I	POPITR
CHLTO,	MTWO		/COMMAND <
	PUSHL
		ITRST
		ITRCNT
	TAD	NFLG
	SNA CLA		/WAS A NUMBER SPECIFIED?
	JMP	INF	/NO, ASSUME INFINITY
	TAD	NLINK
	SNA CLA
	TAD	N
	SNA
	JMP	SEMO	/0 OR NEGATIVE MEANS SKIP ITERATION
	CIA		/MAKE NEGATIVE
INF,	DCA	ITRCNT	/SET UP TERMINATION
	TAD	SCANP	/SAVE CURRENT SCAN PNTR
	DCA	ITRST	/ALWAYS .GE. 1 IN ITERATION
	DCA	NFLG	/CLEAR NUMBER FLAG
	POPJ

/SHOULD WE TREAT 0<> SPECIAL?
	PAGE
	RELOC
/	ERROR-OVERLAY

	*6200

	RELOC 3200

	IOVRLC
	QOVRLC
EOVRLY,	0
	XOVRLC
	FOVRLC

ERRYY,	DCA	N
	TAD	(ERLIST-1
	DCA	XR
ERLOOP,	ISZ	N	/BUMP ERROR NUMBER
	TAD I	XR
	SZA		/END OF LIST?
	TAD I	(ERRXX	/NO - CHECK FOR MATCH
Z40,	SZA CLA		/FOUND WHAT WE WANTED?
	JMP	ERLOOP	/NO - KEEP LOOKING
	TAD	N
	CLL RAL		/MULTIPLY BY 2
	TAD	(ERBASE-2
	DCA	PTR
	TAD I	PTR	/GET FIRST WORD OF ERR MSG
	SPA CLA
	JMP	CTCT	/^C TRAP
ERL2,	TAD	[77
	TYPE
	TAD I	PTR
	RTR
	RTR
	RTR
	JMS I	(SIXTYP	/TYPE LEFT CHARACTER
	TAD I	PTR
	JMS I	(SIXTYP	/TYPE RIGHT CHARACTER
	ISZ	PTR
	TAD I	PTR
	RTR
	RTR
	RTR
	JMS I	(SIXTYP	/TYPE 3RD CHARACTER
	CLA IAC
	AND I	(EHFLAG
	SZA CLA
	JMP I	(ERRRET
	MTHREE
	TAD	MEMSIZ
	SPA CLA
	JMP I	(ERRRET	/NO LONG ERROR MESSAGE UNLESS 16K OOR MORE
	TAD	Z40	/TYPE EXTENDED ERROR MESSAGE
	TYPE
	TAD	Z40
	TYPE
/	TAD	Z40
/	TYPE
	TAD	N
	TAD	(XERBAS-1
	DCA	PTR	/GET PTR TO PTR TO ERROR MSG
	CDF	30
	TAD I	PTR	/GET PTR TO ERROR MESSAGE
	DCA	PTR
XLUP,	TAD I	PTR
	CDF	0
	SNA
	JMP I	(ERRRET
	SPA
	JMS	NEGCHR	/NEGATIVE CHAR IS FLAG FOR ERRONEOUS CHARACTER
	PUTT
	ISZ	PTR
	CDF	30
	JMP	XLUP

CTCT,	KRS		/CTRL/C ERROR MESSAGE
	AND	[177	/ISOLATE ^C OR ^P INTO 7-BIT
	TYPE		/READ CTRL/C FROM BUFFER
	CRLF		/ECHO IT AND CR LF
	TAD I	[QPNTR
	SZA CLA
	JMP	ERL2	/PRINT XAB ERROR MESSAGE
/	MTHREE
/	TAD	CHAR	/LOOK AT PREVIOUS CHARACTER
/	SZA CLA
/	JMP I	(ERRRET	/ONE ^C DO NOTHING
	JMP I	(CTLC	/TWO ^C'S, ABORT
NEGCHR,	0
	CLA
	TAD	LASTC
	SORT
		CACR
		ERPTAB-CACR
	SPA
	DCA	LASTC	/SAVE $ FOR ALTMODE
	CLA
	TAD	(""
	PUTT
	TAD	LASTC
	AND	[7740
	SNA CLA
	JMS	WOW	/USE CARRET FORM FOR CONTROL CHARS
	TAD	LASTC	/AC MAY BE NON-0
	PUTT
	TAD	(""
	JMP I	NEGCHR

WOW,	0
	TAD	("^
	PUTT
	TAD	[100
	JMP I	WOW

SPY,	TAD	LASTC
	TAD	(-11+CNVTAB
	DCA	WOW
	TAD	("<
	PUTT
	TAD I	WOW
	RTR
	RTR
	RTR
	JMS I	(SIXTYP
	TAD I	WOW
	JMS I	(SIXTYP
	TAD	(">
	JMP I	NEGCHR
PTR,	0

	PAGE
SIXTYP,	0
	AND	[137	/IGNORE SIGN BIT OF BYTE
	TAD	[40
	AND	[77
	TAD	[40
	PUTT
	JMP I	SIXTYP
ERLIST,	-ERR01-1	/LIST OF POINTERS TO ALL POSSIBLE
	-ERR02-1	/CALLS TO THE ERROR ROUTINE.
	-ERR03-1
	-ERR04-1
	-ERR05-1
	-ERR06-1
	-ERR07-1
	-ERR08-1
	-ERR09-1
	-ERR10-1
	-ERR11-1
	-ERR12-1
	-ERR13-1
	-ERR14-1
	-ERR15-1
	-ERR16-1
	-ERR17-1
	-ERR18-1
	-ERR19-1
	-ERR20-1
	-ERR21-1
	-ERR22-1
	-ERR23-1
	-ERR24-1
	-ERR25-1
	-ERR26-1
	-ERR27-1
ERR28,	-ERR28-1
	-ERR29-1
	-ERR30-1
	-ERR31-1
	-ERR32-1
	-ERR33-1
	-ERR34-1
	-ERR35-1
	0		/ERROR 36 - UNLABELED ERROR - NAMELY "JMS I OUTR"
			/** MUST BE LAST ERROR MESSAGE
ERBASE,	TEXT	/ILL/	/1	ILLEGAL COMMAND
	TEXT	/UTC/	/2	UNTERMINATED COMMAND
	TEXT	/IQN/	/3	ILLEGAL Q-REGISTER NAME
	TEXT	/PDO/	/4	INTERNAL PUSH DOWN OVERFLOW (RECURSION)
	TEXT	/MEM/	/5	MEMORY OVERFLOW
	TEXT	/STL/	/6	SEARCH STRING TOO LONG
	TEXT	/ARG/	/7	ARGUMENT ERROR
	TEXT	/IFN/	/8	ILLEGAL FILE NAME
	TEXT	/SNI/	/9	SEMICOLON NOT IN ITERATION
	TEXT	/BNI/	/10	CLOSE BRACKET NOT IN ITERATION
	TEXT	/POP/	/11	POINTER OFF PAGE
	TEXT	/QMO/	/12	Q-REGISTER MEMORY OVERFLOW
	TEXT	/UTM/	/13	UNTERMINATED MACRO
	TEXT	/OUT/	/14	OUTPUT ERROR
	TEXT	/INP/	/15	INPUT ERROR
	TEXT	/FER/	/16	FILE ERROR
	TEXT	/FUL/	/17	OUTPUT COMMAND WOULD HAVE OVERFLOWED
	TEXT	/NAY/	/18	NEGATIVE ARGUMENT TO Y
	TEXT	/IEC/	/19	ILLEGAL E CHARACTER
	TEXT	/IQC/	/20	ILLEGAL " CHARACTER
	TEXT	/NAE/	/21	NO ARGUMENT BEFORE =
	TEXT	/NAU/	/22	NO ARGUMENT BEFORE U
	TEXT	/NAQ/	/23	NO ARGUMENT BEFORE "
	TEXT	/SRH/	/24	FAILING SEARCH
	TEXT	/NAP/	/25.	NEGATIVE OR 0 ARGUMENT TO P
	TEXT	/NAC/	/26.	NEGATIVE ARGUMENT TO ,
	TEXT	/NYI/	/27.	^W NOT IMPLEMENTED
	TEXT	/DMY/	/28.	NOT USED
	TEXT	/NAS/	/29.	NEGATIVE OR 0 COUNT TO SEARCH
	TEXT	/WLO/	/30.	CAN'T WRITE OUT ERROR MESSAGE OVERLAY
	TEXT	/IFC/	/31.	ILLEGAL F CHARACTER
	TEXT	/YCA/	/32.	Y COMMAND ABORTED
	TEXT	/CCL/	/33.	CCL NOT FOUND OR EG TOO BIG
/	TEXT	/XAB/	/34.	EXECUTION ABORTED BY ^C
	7001;0200
	TEXT	/NYI/	/35.	^V NOT IMPLEMENTED
	TEXT	/NFO/	/36.	NO FILE FOR OUTPUT
CNVTAB,	TEXT	/HTLFVTFFCR/
	*.-1
ERPTAB,	SPY		/CR
	SPY		/HT
	4044		/$
	SPY		/FF
	SPY		/VT
	SPY		/LF
	PAGE
	RELOC
/	X-OVERLAY

	*6600

	RELOC 3200

	IOVRLC
	QOVRLC
	EOVRLC
XOVRLY,	0
	FOVRLC

CHREX,	TAD I	(TYI
	SORT
		XLIS
		XTAB-XLIS
	ERR		/CAN'T HAPPEN

XLIS,	103		/EC
	106		/EF
	107		/EG
	113		/EK
	130		/EX

	/"EX" AND "EC" COMMANDS
EXIT,	PUSHJ		/"EX" COMMAND
		EXITC	/CLOSE OUT THE FILES
	JMP I	(CTLC	/AND GO AWAY

EXITC,	TAD	OUTR	/"EC" COMMAND
	CIA		/CHECK FOR OPEN OUTPUT FILE
	TAD	ERROR
	SNA CLA
	POPJ		/NOPE, EXIT ALREADY
EXLOOP,	JMS I	[NXTBUF	/GET NEXT BUFFER
	TAD	REND
	CIA
	TAD	ZZ	/CHECK FOR END-OF-FILE AND
	SZA CLA		/TEXT BUFFER EMPTY
	JMP	EXLOOP	/NOT YET
			/ENDFILE PROCESSOR
ENDFIL,	TAD	OCRCNT
	CMA		/REDUCE THE OUTPUT DOUBLEWORD COUNT
	AND	[177	/TO REFLECT ONLY THOSE WORDS REMAINING
	CMA		/UNTIL THE NEXT BLOCK BOUNDARY
	DCA	OCRCNT
	TAD	(7200	/USED TO BE 'DV7200'
	DCA	MQ	/SET COUNTER FOR ONE BLOCK WORTH OF STUFF
	TAD	(32	/^Z END-OF-FILE
	OUTPUT
	ISZ	MQ
	JMP	.-2	/FILL AT LEAST THE CURRENT BUFFER AND OUTPUT IT
	TAD	ODEV	/MAKE SURE THE USR KNOWS THE HANDLER
	TAD	(OSHNDT-1	/*K* - POINTER INTO
	DCA	TY	/ OS/8 DEVICE RESIDENCY TABLE
	CDF 10
	TAD	OUTHND
	DCA I	TY	/MARK THE HANDLER AS IN CORE
	JMS I	(GETUSR	/LOCK THE USR INTO CORE
	TAD	EBFLG	/IS THIS AN EDIT BACKUP?
	SNA CLA
	JMP I	(NORMAL	/NO, JUST CLOSE FILE
	TAD I	(OCNT-1	/YES, LOOKUP OLD FILE TO CHANGE NAME
	DCA	TY-1
	CIF 10
	TAD	ODEV	/INPUT AND OUTPUT ARE ON SAME DEVICE
	JMS I	[200
	2
	OUNAM
TY,	0		/USELESS LENGTH--USE IT FOR TEMPORARY
	JMP I	(NORMAL	/ERROR-JUST CLOSE FILE AND DON'T TELL ANYBODY
	CDF 10		/ALL THAT WAS JUST TO GET THE DIRECTORY IN CORE
	STA		/SO WE COULD FIDDLE WITH IT
	TAD I	(17	/FORM POINTER TO DIRECTORY ENTRY
	TAD I	(1404
	DCA	TY
	TAD	(213	/CHANGE EXTENSION TO .BK
	DCA I	TY
	TAD I	Z7	/DIRECTORY BLOCK IT CAME FROM
	AND	Z7
	DCA	ACI
	CDF 0
	JMS I	OUTHND
	4210		/WRITE IT BACK OUT
	1400
ACI,	0
	JMP	.-4	/ERROR! KEEP TRYING-THIS CAN BLOW A DIRECTORY
	JMP I	(NORMAL
XTAB,	EXITC		/EC
	ENDFIL		/EF
	EXITGO		/EG
	EKILL		/EK
	EXIT		/EX
EKILL,	TAD	ERROR
	DCA	OUTR
	POPJ
	PAGE
EXITGO,	PUSHJ		/DO AN EC TO CLOSE OUT FILE
		EXITC
	QCHK		/ALLOW @
	DCA	STOCD	/MAKE REUSABLE IN CASE .START
	TAD	(7600
	DCA	CDPTR
	TAD	(-47	/47 ENTRIES IN CD TABLE
	DCA	EGCNT
EG1,	QUOTST
	JMP	EG2
	TAD	[200	/TURN ON PARITY BIT FOR OS/8
	JMS	STOCD
	JMP	EG1

STOCD,	0
	ISZ	EGCNT
	SKP
ERR33,	ERR		/EG ARG TOO BIG
	CDF	10
	DCA I	CDPTR
	CDF	0
	ISZ	CDPTR
	JMP I	STOCD

CDPTR,	7600
EGCNT,	-41

EG2,	TAD	STOCD
	SNA CLA		/ANYTHING IS ARG
	JMP	REGEG	/NO
	JMS	STOCD	/STORE 0 AT END
	JMS I	(GETUSR
	TAD	(CCLNAM
	DCA	ARG1		/JUST IN CASE PREVIOUS EG FAILED
	CLA IAC		/SYS
	CIF 10
	JMS I	[200
	2		/LOOKUP
ARG1,	CCLNAM
	0
	JMP	CCLERR
	TAD	(2001
	DCA I	(JSBITS	/KEEP USR IN CORE
	TAD	ARG1
	DCA	CHNBLK
	CIF 10
	JMS I	[200
	6		/CHAIN
CHNBLK,	0
CCLERR,	PUSHJ
		ECDISM
	JMP	ERR33

CCLNAM,	FILENAME CCL.SV
REGEG,			/EDIT AND GO - A CCL SPECIAL
	JMS I	(7607	/CALL THE OS/8 SYSTEM HANDLER
	0200		/TO READ IN THE CCL OVERLAY
	CCLADR
	CCLOVL
	JMP	ERR33	/ERROR ON SYSTEM DEVICE!
	JMP I	.+1	/GO TO THE OVERLAY
	CCLOST		/AT OUR "SPECIAL" LOCATION
	RELOC
/	F-OVERLAY

	*7200

	RELOC 3200

	IOVRLC
	QOVRLC
	EOVRLC
	XOVRLC
FOVRLY,	0

CHRED,	TAD I	(TYI
	SORT
		DLIS
		DTAB2-DLIS	/CHECK FOR LEGALITY
ERR19,	ERR		/BAD CHAR AFTER E
DTOK,	TAD I 	(TYI
	SORT
		DLIS
		DTAB-DLIS
	DCA	XXFLAG
	NCHK		/ANY ARGUMENT?
	JMP	XXNO	/NO, RETURN VALUE
	TAD	N	/YES
	DCA I	XXFLAG	/SET NEW VALUE
	TAD	XXFLAG
	TAD	(-EDFLAG+XXSUBS
	DCA	XXSUB
	TAD I	XXSUB
	DCA	XXSUB
	JMS I	XXSUB	/CALL IT
	POPJ		/RETURN
XXNO,	TAD I	XXFLAG	/GET VALUE
	JMP I	(NNEW13	/MAKE NEW 13-BIT VALUE

DLIS,	104		/ED
	110		/EH
	117		/EO
	123		/ES
	124		/ET
	125		/EU
DTAB,	EDFLAG		/MUST BE NEGATIVE
	EHFLAG		/TO CAUSE SUBSTITUTION
	EOFLAG
	ESFLAG
	ETFLAG
	EUFLAG
XXFLAG,	0		/POINTS TO FLAG IN MEMORY ABOVE 4000

DTAB2,	DTOK
	DTOK
	DTOK
	DTOK
	DTOK
	DTOK

XXSUB,	0
/	MASK;SKIP;LOC;VALUE IF SKIPS;VALUE IF NO SKIP

EUSUB,	0
	JMS	FIXUP
	7777;	SMA CLA;	EU1;	CLA;	SNA CLA
	7777;	SPA SNA CLA;	EU2;	TAD [40;NOP
	0
	JMP I	EUSUB

ETSUB,	0
	JMS	FIXUP
	1;	SNA CLA;	KTYPE;	PUTT;	TYPE
	1;	SNA CLA;	ET1;	PUTT;	TYPE
	10;	SNA CLA;	ET8;	CLA;	TYPE
	0
	JMP I	ETSUB

LOC,	0
MASK,	0

FIXUP,	0
FIXLUP,	TAD I	FIXUP
	SNA
	JMP I	FIXUP	/DONE, RETURN TO 0
	DCA	MASK	/SAVE MASK
	ISZ	FIXUP
	TAD I	FIXUP
	DCA	SKIPY	/SAVE SKIP CONDITION
	ISZ	FIXUP
	TAD I	FIXUP
	DCA	LOC	/SAVE LOC TO CHANGE
	ISZ	FIXUP
	TAD I	XXFLAG	/LOOK AT FLAG
	AND	MASK	/'AND' WITH MASK
SKIPY,	HLT
	JMP	SKPF
	TAD I	FIXUP
	DCA I	LOC
	ISZ	FIXUP
SKPT,	ISZ	FIXUP
	JMP	FIXLUP
SKPF,	ISZ	FIXUP
	TAD I	FIXUP
	DCA I	LOC
	JMP	SKPT
CTLUO,	QREF		/COMMAND ^U
	QSKP		/COUNT UP STRING
	TAD	OSCANP
	CMA
	TAD	SCANP	/LENGTH OF STRING
/
/	*** PROHIBIT STRING > 2047 CHARS
/
	ADJQ		/ADJUST Q-REGISTERS AND SET NEW LENGTH
	TAD	OSCANP	/RESET SCAN POINTER
	DCA	SCANP
	DCA	NFLG
	NOTRCE
CCUB,	QUOTST
	JMP	CTLUND
	QPUT
	JMP	CCUB
CTLUND,	ENTRCE
	JMP I	[IREST
	PAGE
/NUMERICAL OUTPUT ROUTINE

ZEROD,	0
	DCA	ZERFLG	/INITIALIZE "LEADING ZEROS" FLAG
	TAD I	ZEROD
	ISZ	ZEROD
	DCA	OUTDEV	/SAVE OUTPUT ROUTINE ADDRESS
	TAD	NLINK	/POS OR NEGATIVE?
	SNA CLA
	JMP	ZER2	/POSITIVE
	TAD	RADIX
	TAD	(-ORAD
	SNA CLA
	JMP	PUTSGN	/OCTAL
	TAD	N	/DECIMAL
	CIA
	DCA	N	/NEGATE
	SKP
PUTSGN,	TAD	["1-"-
	TAD	("-
	JMS I	OUTDEV	/OUTPUT MINUS SIGN
ZER2,	MTHREE
	DCA	ZCOUNT	/ITERATION COUNT
	TAD	RADIX
	DCA	RXR
ZDIGIT,	ISZ	RXR
	TAD I	RXR
	DCA	DIV1	/GET DIVISOR
	TAD	N
	MQLDVI		/DIVIDE BY A POWER OF THE BASE
DIV1,	0
	TAD	ZERFLG
	SNA
	JMP	LZ	/IGNORE LEADING ZEROS
	TAD	(60
	JMS I	OUTDEV
	STL RAR
	DCA	ZERFLG	/SET LEADING ZEROS FLAG
LZ,	TAD	DVT1	/GET REMAINDER
	DCA	N
	ISZ	ZCOUNT	/GO AROUND AGAIN?
	JMP	ZDIGIT	/WHY NOT?
	TAD	N
	TAD	(60
	JMS I	OUTDEV	/OUTPUT LAST DIGIT NO MATTER WHAT
	JMP I	ZEROD

OUTDEV,	0		/WHERE WE'RE SENDING THE DIGITS
ZERFLG,	0
ZCOUNT,	0
RXR,	0
/COMMANDS = AND \

/COMMANDS = AND \ - NUMERICAL OUTPUT

CEQLO,	NCHK		/COMMAND =
ERR21,	ERR		/NO NUMBER
	TAD	RADIX
	DCA	RADTMP
	JMS I	(POKE	/LOOK AHEAD ONE CHARACTER
	TAD	(-75	/CHECK FOR = SIGN
	SZA CLA
	JMP 	SETRAD	/SINGLE =
	SCAN		/DOUBLE = (PASS UP SECOND ONE)
	SKP CLA		/CLEAR AC
SETRAD,	TAD	[4
	TAD	(ORAD
	DCA	RADIX	/SET OCTAL RADIX TEMPORARILY
	JMS	ZEROD
	TPUT
	TAD	RADTMP
	DCA	RADIX	/RESTORE ORIGINAL RADIX
	ISZ	CLNF	/: SEEN?
	CRLF		/NO, END WITH CRLF
	DCA	CLNF
	POPJ

CBSLO,	NCHK		/COMMAND \
	JMP	CBSN
	JMS	ZEROD
	UPOC
	POPJ

RADTMP,	0
CBSN,	PUSHJ
		NMBR2	/INITIALIZE RESULT TO 0
	JMS	PTCH
	TAD I	P
	AND	[377	/GET CURRENT CHARACTER
	CDF 0
	TAD	(-55	/CHECK FOR MINUS SIGN
	SZA
	JMP	.+3	/NOT MINUS
	PUSHJ
		CMIN	/RECORD MINUS SIGN
	CIA
	CLL RTR
	SNA CLA		/CHECK FOR PLUS SIGN
CBSNP,	ISZ	P	/BUMP POINTER PAST SIGN
	JMS	PTCH
	TAD I	P	/GET A CHAR
	AND	[377
	CDF 0
	TAD	(-72
	CLL
	TAD	CALF
	SNL		/IS IT A DIGIT?
	POPJ		/NO
	PUSHJ
		NMBR2	/YES - ACCUMULATE IT
	JMP	CBSNP	/AND LOOP
PTCH,	0
	TAD P		/V3C
	STL CIA		/CHECK FOR END OF BUFFER
	TAD ZZ
	SZL SNA CLA
	POPJ
	CDF 10
	JMP I PTCH

XXSUBS,	EDSUB
	EHSUB
	EOSUB
	ESSUB
	ETSUB
	EUSUB
/	CXSUB

/CXSUB,
EDSUB,
EHSUB,
ESSUB,
EOSUB,	0
	JMP I	EOSUB
	PAGE
	RELOC
	FIELD 1

	*4400

XERBAS,	XER1
	XER2
	XER3
	XER4
	XER5
	XER6
	XER7
	XER8
	XER9
	XER10
	XER11
	XER12
	XER13
	XER14
	XER15
	XER16
	XER17
	XER18
	XER19
	XER20
	XER21
	XER22
	XER23
	XER24
	XER25
	XER26
	XER27
	XER28
	XER29
	XER30
	XER31
	XER32
	XER33
	XER34
	XER35
	XER36
XER1,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"o;"m;"m;"a;"n;"d;" ;4000;0
XER2,
"U;"n;"t;"e;"r;"m;"i;"n;"a;"t;"e;"d;" ;"C;"o;"m;"m;"a;"n;"d;0
XER3,
"I;"l;"l;"e;"g;"a;"l;" ;"Q;"-;"r;"e;"g;"i;"s;"t;"e;"r;" ;"N;"a;"m;"e;" ;4000;0
XER4,
"I;"n;"t;"e;"r;"n;"a;"l;" ;"P;"u;"s;"h;" ;"D;"o;"w;"n;" ;"O;"v;"e;"r
"f;"l;"o;"w;0
XER5,
"S;"t;"o;"r;"a;"g;"e;" ;"C;"a;"p;"a;"c;"i;"t;"y;" ;"E;"x;"c;"e;"e;"d;"e;"d;0
XER6,
"S;"e;"a;"r;"c;"h;" ;"S;"t;"r;"i;"n;"g;" ;"t;"o;"o;" ;"L;"o;"n;"g;0
XER7,
"I;"m;"p;"r;"o;"p;"e;"r;" ;"A;"r;"g;"u;"m;"e;"n;"t;"s;0
XER8,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
" ;"i;"n;" ;"F;"i;"l;"e;"n;"a;"m;"e;0
XER9,
";;" ;"n;"o;"t;" ;"i;"n;" ;"a;"n;" ;"I;"t;"e;"r;"a;"t;"i;"o;"n;0
XER10,
">;" ;"n;"o;"t;" ;"i;"n;" ;"a;"n;" ;"I;"t;"e;"r;"a;"t;"i;"o;"n;0
XER11,
"A;"t;"t;"e;"m;"p;"t;" ;"t;"o;" ;"M;"o;"v;"e;" ;"P;"o;"i;"n;"t;"e;"r
" ;"O;"f;"f;" ;"P;"a;"g;"e;0
XER12,
"Q;"-;"r;"e;"g;"i;"s;"t;"e;"r;" ;"M;"e;"m;"o;"r;"y;" ;"O;"v;"e;"r;"f;"l;"o;"w;0
XER13,
"U;"n;"t;"e;"r;"m;"i;"n;"a;"t;"e;"d;" ;"M;"a;"c;"r;"o;0
XER14,
"O;"u;"t;"p;"u;"t;" ;"E;"r;"r;"o;"r;0
XER15,
"I;"n;"p;"u;"t;" ;"E;"r;"r;"o;"r;0
XER16,
"F;"i;"l;"e;" ;"E;"r;"r;"o;"r;0
XER17,
"O;"u;"t;"p;"u;"t;" ;"C;"o;"m;"m;"a;"n;"d;" ;"w;"o;"u;"l;"d;" ;"h;"a;"v;"e
" ;"O;"v;"e;"r;"f;"l;"o;"w;"e;"d;0
XER18,
"N;"u;"m;"e;"r;"i;"c;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;"Y;0
XER19,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
" ;"a;"f;"t;"e;"r;" ;"E;0
XER20,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
" ;"a;"f;"t;"e;"r;" ;"";0
XER21,
"N;"o;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"b;"e;"f;"o;"r;"e;" ;"=;0
XER22,
"N;"o;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"b;"e;"f;"o;"r;"e;" ;"U;0
XER23,
"N;"o;" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"b;"e;"f;"o;"r;"e;" ;"q;"u;"o;"t;"e;0
XER24,
"S;"e;"a;"r;"c;"h;" ;"f;"a;"i;"l;"e;"d;0
XER25,
"N;"e;"g;"a;"t;"i;"v;"e;" ;"o;"r;" ;"Z;"e;"r;"o
" ;"A;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;"P;0
XER26,
"N;"e;"g;"a;"t;"i;"v;"e;" ;"a;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;",;0
XER27,
"C;"a;"s;"e;" ;"S;"u;"p;"p;"o;"r;"t;" ;"n;"o;"t
" ;"I;"m;"p;"l;"e;"m;"e;"n;"t;"e;"d;215;212;211;177;177 
"[;"u;"s;"e;" ;"W;" ;"f;"o;"r;" ;"W;"a;"t;"c;"h;" ;"C;"o;"m;"m;"a;"n;"d;"];0
/XER28,
/"N;"e;"g;"a;"t;"i;"v;"e;" ;"o;"r;" ;"Z;"e;"r;"o;" 
/"I;"t;"e;"r;"a;"t;"i;"o;"n;" ;"C;"o;"u;"n;"t;0
XER28,
0
XER29,
"N;"e;"g;"a;"t;"i;"v;"e;" ;"o;"r;" ;"Z;"e;"r;"o;" 
"A;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;" ;"S;0
XER30,
"C;"a;"n;"n;"o;"t;" ;"W;"r;"i;"t;"e;" ;"O;"u;"t;" ;"E;"r;"r;"o;"r
" ;"M;"e;"s;"s;"a;"g;"e;" ;"O;"v;"e;"r;"l;"a;"y;0
XER31,
"I;"l;"l;"e;"g;"a;"l;" ;"C;"h;"a;"r;"a;"c;"t;"e;"r;" ;4000
" ;"a;"f;"t;"e;"r;" ;"F;0
XER32,
"Y;" ;"C;"o;"m;"m;"a;"n;"d;" ;"A;"b;"o;"r;"t;"e;"d;0
XER33,
"C;"C;"L;".;"S;"V;" ;"n;"o;"t;" ;"f;"o;"u;"n;"d;" ;"o;"r;" 
"E;"G;" ;"a;"r;"g;"u;"m;"e;"n;"t;" ;"t;"o;"o;" ;"b;"i;"g;0
XER34,
"E;"x;"e;"c;"u;"t;"i;"o;"n;" ;"a;"b;"o;"r;"t;"e;"d;0
XER35,
"C;"a;"s;"e;" ;"S;"u;"p;"p;"o;"r;"t;" ;"n;"o;"t;" 
"I;"m;"p;"l;"e;"m;"e;"n;"t;"e;"d;215;212;211;177;177
"[;"u;"s;"e;" ;"E;"O;" ;"f;"o;"r
" ;"V;"e;"r;"s;"i;"o;"n;" ;"n;"u;"m;"b;"e;"r;"];0
XER36,
"N;"o;" ;"F;"i;"l;"e;" ;"f;"o;"r;" ;"O;"u;"t;"p;"u;"t;0
	PAGE
COREAD,	0
	ISZ	COREAD
	TAD I	COREAD	/GET BLOCK #
	AND	CO7
	CLL RTR
	RTR
	RAR		/MULTIPLY BY 400
	TAD	KMEM
	DCA	FLO
	TAD	M400
	DCA	FLCNT
	TAD	K3200
	DCA	FTO
FLOO,	CDF	30
	TAD I	FLO
	CDF	0
	DCA I	FTO
	ISZ	FLO
	ISZ	FTO
	ISZ	FLCNT
	JMP	FLOO
	ISZ	COREAD
	CIF CDF	0
	JMP I	COREAD

FLCNT,	0
CO7,	7
M400,	-400
K3200,	3200
KMEM,	MEMLOC
FLO,	0
FTO,	0
COREND=.
NEWERR,	RELOC OVREAD
	CIF 30	/NEW CODE TO READ OVERLAY
	JMS I .+1	/MUST BE 5 LOCS LONG
	COREAD
TMP,	0		/BLOCK #
	NOP
	RELOC
	PAGE


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/VXNS.PA. 
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

/EXTENDED MEMORY DEVICE HANDLER
/
/
/PSEUDO DEVICE SIMILAR TO DF32
/BUT IN RAM MEMORY USING FIELDS
/10 TO 17 FOR PLATTER 1
/20 TO 27 FOR PLATTER 2
/30 TO 37 FOR PLATTER 3
/
/
/	S.R.,J.R.,J.M.
/
/
/
/
/
/
/COPYRIGHT  (C)  1978 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/
/BUILD DATA
	*0
/
/1	EXTENDED MEMORY HANDLER FOR OS/8


	IFNDEF SYS <SYS=0>		/SET TO 1 TO GET SYSTEM HANDLER


	-1
	IFZERO SYS <DEVICE VXA0;DEVICE VXA0;4333;MEM&177;ZBLOCK 2>
	IFNZRO SYS <DEVICE VXA0;DEVICE SYS;4333;2007;0;200>
	VXVER="A&77

	IFNZRO SYS <

	7737	/MINUS LENGTH OF BOOT
	RELOC 0

	CLL CLA CMA	/CLEAR AC & SET TO 7777
	DCA X0
	TAD K7600
	DCA C1
	TAD K7600
	DCA C2
	TAD K7577
	DCA X1
	TAD K7577
	DCA X2
	JMP 20
X0,	0
X1,	0
X2,	0
C1,	0
C2,	0
	CDF 4
	TAD I X0
	CDF 10
	DCA I X1
	ISZ C1
	JMP 20
	CDF 4
	TAD I X0
	CDF 0
	DCA I X2
	ISZ C2
	JMP 26
	CDF CIF 0
	JMP I .+1
	7605
K7600,	7600
K7577,	7577
	RELOC
	>
        *200

        IFNZRO SYS <    RELOC 7600
                        ZBLOCK 7>

MEM,	VXVER
	CLA CLL CML RAR	/SET AC TO 4000
	TAD I MEM	/GET ARG 1 -- LINK WILL BE SET IF WRITE
	AND VX70	/MASK OFF FIELD
	TAD VCDF	/FORM A CDF N
	DCA FLD		/STORE AT INPUT
	TAD FLD
	DCA WR		/AND AT OUTPUT
	RAR		/GET WRITE BIT
	MQL		/SAVE IN MQ
	IFZERO SYS <
	TAD K7000
	6200		/SET MEM EXT BITS
	CLA CLL
	>
	TAD I MEM	/AGAIN GET ARG 1
	RAL		/MULT X 2 = PAGESX2=WORDS
	AND VX7600		/MASK OFF OTHER BITS
	CIA		/MAKE NEGATIVE
	DCA WDCNT	/STORE AT 7753
	CLL		/CLEAR LINK IF IT WAS WRITE
	ISZ MEM		/INCR POINTER
	TAD I MEM		/GET ARG 2
	DCA BUFADR	/STORE BUFFER POINTER IN 7750
	ISZ MEM		/INCR POINTER
	TAD I MEM	/GET ARG 3 -OS/8 BLOCK #
	DCA BLK		/STORE IN 7752
	TAD BLK
	AND VX17	/GET BITS 8 TO 11 TO MAKE INTO START ADDR
	BSW
	RTL
	DCA SA		/STORE START ADDR OF EXT MEM IN 7751
	TAD BLK
	RAR
	AND VX70
	TAD VCDF	/THIS GET BITS 5 TO 7 FOR EXT MEM BIT CDE
	DCA RD		/TEMP STORE UNTIL BITS A & B ARE EVALUATED
	RDF		/NOW GRAB SENDING FIELD IN AC
	TAD VXCDI	/FORM A CDI N OF SENDING FIELD
	DCA VXRET	/STORE AT RETURN ROUTINE
	ISZ MEM		/NOW RETURN POINTS TO ERROR
VXCDI,	CDF CIF 0	/PUT INTO CURRENT FIELD ALSO CONSTANT FOR CDI
	TAD BLK		/NOW WE NEED TO KNOW BITS A & B IN EXT MEM
	TAD M200	/IS OS/8 BLOCK 0-177
	SPA
	JMP DOB		/YES SO SET BIT B
	TAD M200	/IS OS/8 BLOCK 200-377
	SPA CLA
	JMP DOA		/YES SO SET BIT A
	TAD VX4		/NO SO SET BIT B
	TAD VX100	/AND BIT A
GO,	TAD RD		/PICK UP TEMP CDF
	DCA RD		/STORE IT AT INPUT
	TAD RD
	DCA FLD2	/AND AT OUTPUT
	MQA		/NOW GET WRITE BIT (IF ANY)
	SNA CLA
	JMP RD		/NO WRITE BIT SO GO TO READ ROUTINE
WR,	HLT		/WRITE ROUTINE - THIS BECOMES A CDF N
	TAD I BUFADR	/GET DATA FROM INPUT BUFFER
FLD2,	HLT		/THIS CHANGES TO CDF N (HIGH FIELDS)
	DCA I SA		/DUMP INTO EXTEND MEM
	JMS VCK		/CHECK FOR END OF ROUTINE & RESET FIELDS
	JMP WR		/NOT DONE YET SO CONTINUE
RD,	HLT		/READ ROUTINE - THIS BECOMES A CDF N (HIGH)
	TAD I SA	/GET DATA FROM EXTENDED MEM
FLD,	HLT		/CHANGES TO CDF N (LOW)

	DCA I BUFADR	/PUT INTO BUFFER IN LOWER MEMORY
	JMS VCK		/CHECK FOR END OF ROUTINE & RESET FIELDS
	JMP RD		/NOT DONE SO CONTINUE
M200,
VX7600,	7600		/K7600 & M200 & CLA ON EXIT
	ISZ MEM		/INCR POINTER TO GOOD EXIT
VXRET,	HLT		/CHANGES TO CDF CIF N OF SENDING FIELD
	JMP I MEM	/RETURN TO CALLING ROUNTINE
VCK,	0		/THIS CHECKS READ AND WRITE FOR DONE
        IFZERO SYS <JMS CTRLC>
	ISZ WDCNT	/AND FOR RESET OF FIELDS
	SKP		/NO OVERFLOW SO SKIP TO CONTINUE
	JMP VX7600	/OVERFLOW SO DONE - GO TO EXIT ROUTINE
	ISZ BUFADR	/INCR POINTER IF OVERFLOWS THEN WRAP MEMORY
VX70,	70		/CONSTANT THAT DOES A NOP HERE IF NO OVERFLOW
	ISZ SA		/INCR START ADDR IN EXT MEM

	JMP I VCK	/NO OVERFLOW SO COONTINUE
	TAD VX10	/EXTEND MEM NEEDS NEW FIELD
	TAD RD
	DCA RD		/PUT INCR FIELD AT INPUT
	TAD RD
	DCA FLD2	/AND WRITE
	JMP I VCK	/NOW GO BACK AND TRY TO FINISH 
DOB,	CLA		/CLEAR AC
	TAD VX4		/SET BIT A
	JMP GO		/GO TO ROUTINE TO UPDATE TEMP AND STORE
DOA,	TAD VX100	/SET BIT A
	JMP GO		/GO TO ROUTINE TO UPDATE TEMP AND STORE
VCDF,	CDF 0		/CONSTANT TO FORM CDF N
VX17,	17
VX10,	10
VX100,	100
VX4,	4
	IFNZRO SYS <

BUFADR=7750
SA=7751
BLK=7752
WDCNT=7753>
        IFZERO SYS <

BUFADR,	0
SA,	0
BLK,	0
WDCNT,	0
K7000,	7000
CTRLC,  0
        TAD (200
        KRS
        TAD (-203
        SNA CLA
        KSF
        JMP I CTRLC
        CIF CDF 0
	JMP I VX7600
        >


        IFNZRO SYS <
        RELOC
        >
$ $ $ $ $ $ $ $ 


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/VXSY.PA. 
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

/EXTENDED MEMORY DEVICE HANDLER
/
/
/PSEUDO DEVICE SIMILAR TO DF32
/BUT IN RAM MEMORY USING FIELDS
/10 TO 17 FOR PLATTER 1
/20 TO 27 FOR PLATTER 2
/30 TO 37 FOR PLATTER 3
/
/
/	S.R.,J.R.,J.M.
/
/
/
/
/
/
/COPYRIGHT  (C)  1978 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/
/BUILD DATA
	*0
/
/1	EXTENDED MEMORY HANDLER FOR OS/8


	SYS=1
	IFNDEF SYS <SYS=0>		/SET TO 1 TO GET SYSTEM HANDLER


	-1
	IFZERO SYS <DEVICE VXA0;DEVICE VXA0;4333;MEM&177;ZBLOCK 2>
	IFNZRO SYS <DEVICE VXA0;DEVICE SYS;4333;2007;0;200>
	VXVER="A&77

	IFNZRO SYS <

	7737	/MINUS LENGTH OF BOOT
	RELOC 0

	CLL CLA CMA	/CLEAR AC & SET TO 7777
	DCA X0
	TAD K7600
	DCA C1
	TAD K7600
	DCA C2
	TAD K7577
	DCA X1
	TAD K7577
	DCA X2
	JMP 20
X0,	0
X1,	0
X2,	0
C1,	0
C2,	0
	CDF 4
	TAD I X0
	CDF 10
	DCA I X1
	ISZ C1
	JMP 20
	CDF 4
	TAD I X0
	CDF 0
	DCA I X2
	ISZ C2
	JMP 26
	CDF CIF 0
	JMP I .+1
	7605
K7600,	7600
K7577,	7577
	RELOC
	>
        *200

        IFNZRO SYS <    RELOC 7600
                        ZBLOCK 7>

MEM,	VXVER
	CLA CLL CML RAR	/SET AC TO 4000
	TAD I MEM	/GET ARG 1 -- LINK WILL BE SET IF WRITE
	AND VX70	/MASK OFF FIELD
	TAD VCDF	/FORM A CDF N
	DCA FLD		/STORE AT INPUT
	TAD FLD
	DCA WR		/AND AT OUTPUT
	RAR		/GET WRITE BIT
	MQL		/SAVE IN MQ
	IFZERO SYS <
	TAD K7000
	6200		/SET MEM EXT BITS
	CLA CLL
	>
	TAD I MEM	/AGAIN GET ARG 1
	RAL		/MULT X 2 = PAGESX2=WORDS
	AND VX7600		/MASK OFF OTHER BITS
	CIA		/MAKE NEGATIVE
	DCA WDCNT	/STORE AT 7753
	CLL		/CLEAR LINK IF IT WAS WRITE
	ISZ MEM		/INCR POINTER
	TAD I MEM		/GET ARG 2
	DCA BUFADR	/STORE BUFFER POINTER IN 7750
	ISZ MEM		/INCR POINTER
	TAD I MEM	/GET ARG 3 -OS/8 BLOCK #
	DCA BLK		/STORE IN 7752
	TAD BLK
	AND VX17	/GET BITS 8 TO 11 TO MAKE INTO START ADDR
	BSW
	RTL
	DCA SA		/STORE START ADDR OF EXT MEM IN 7751
	TAD BLK
	RAR
	AND VX70
	TAD VCDF	/THIS GET BITS 5 TO 7 FOR EXT MEM BIT CDE
	DCA RD		/TEMP STORE UNTIL BITS A & B ARE EVALUATED
	RDF		/NOW GRAB SENDING FIELD IN AC
	TAD VXCDI	/FORM A CDI N OF SENDING FIELD
	DCA VXRET	/STORE AT RETURN ROUTINE
	ISZ MEM		/NOW RETURN POINTS TO ERROR
VXCDI,	CDF CIF 0	/PUT INTO CURRENT FIELD ALSO CONSTANT FOR CDI
	TAD BLK		/NOW WE NEED TO KNOW BITS A & B IN EXT MEM
	TAD M200	/IS OS/8 BLOCK 0-177
	SPA
	JMP DOB		/YES SO SET BIT B
	TAD M200	/IS OS/8 BLOCK 200-377
	SPA CLA
	JMP DOA		/YES SO SET BIT A
	TAD VX4		/NO SO SET BIT B
	TAD VX100	/AND BIT A
GO,	TAD RD		/PICK UP TEMP CDF
	DCA RD		/STORE IT AT INPUT
	TAD RD
	DCA FLD2	/AND AT OUTPUT
	MQA		/NOW GET WRITE BIT (IF ANY)
	SNA CLA
	JMP RD		/NO WRITE BIT SO GO TO READ ROUTINE
WR,	HLT		/WRITE ROUTINE - THIS BECOMES A CDF N
	TAD I BUFADR	/GET DATA FROM INPUT BUFFER
FLD2,	HLT		/THIS CHANGES TO CDF N (HIGH FIELDS)
	DCA I SA		/DUMP INTO EXTEND MEM
	JMS VCK		/CHECK FOR END OF ROUTINE & RESET FIELDS
	JMP WR		/NOT DONE YET SO CONTINUE
RD,	HLT		/READ ROUTINE - THIS BECOMES A CDF N (HIGH)
	TAD I SA	/GET DATA FROM EXTENDED MEM
FLD,	HLT		/CHANGES TO CDF N (LOW)

	DCA I BUFADR	/PUT INTO BUFFER IN LOWER MEMORY
	JMS VCK		/CHECK FOR END OF ROUTINE & RESET FIELDS
	JMP RD		/NOT DONE SO CONTINUE
M200,
VX7600,	7600		/K7600 & M200 & CLA ON EXIT
	ISZ MEM		/INCR POINTER TO GOOD EXIT
VXRET,	HLT		/CHANGES TO CDF CIF N OF SENDING FIELD
	JMP I MEM	/RETURN TO CALLING ROUNTINE
VCK,	0		/THIS CHECKS READ AND WRITE FOR DONE
        IFZERO SYS <JMS CTRLC>
	ISZ WDCNT	/AND FOR RESET OF FIELDS
	SKP		/NO OVERFLOW SO SKIP TO CONTINUE
	JMP VX7600	/OVERFLOW SO DONE - GO TO EXIT ROUTINE
	ISZ BUFADR	/INCR POINTER IF OVERFLOWS THEN WRAP MEMORY
VX70,	70		/CONSTANT THAT DOES A NOP HERE IF NO OVERFLOW
	ISZ SA		/INCR START ADDR IN EXT MEM

	JMP I VCK	/NO OVERFLOW SO COONTINUE
	TAD VX10	/EXTEND MEM NEEDS NEW FIELD
	TAD RD
	DCA RD		/PUT INCR FIELD AT INPUT
	TAD RD
	DCA FLD2	/AND WRITE
	JMP I VCK	/NOW GO BACK AND TRY TO FINISH 
DOB,	CLA		/CLEAR AC
	TAD VX4		/SET BIT A
	JMP GO		/GO TO ROUTINE TO UPDATE TEMP AND STORE
DOA,	TAD VX100	/SET BIT A
	JMP GO		/GO TO ROUTINE TO UPDATE TEMP AND STORE
VCDF,	CDF 0		/CONSTANT TO FORM CDF N
VX17,	17
VX10,	10
VX100,	100
VX4,	4
	IFNZRO SYS <

BUFADR=7750
SA=7751
BLK=7752
WDCNT=7753>
        IFZERO SYS <

BUFADR,	0
SA,	0
BLK,	0
WDCNT,	0
K7000,	7000
CTRLC,  0
        TAD (200
        KRS
        TAD (-203
        SNA CLA
        KSF
        JMP I CTRLC
        CIF CDF 0
	JMP I VX7600
        >


        IFNZRO SYS <
        RELOC
        >
$ $ $ $ $ $ $ $ 


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
Deleted src/os8-v3f/actions.txt. 
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

att	rk1	os8-v3f-build.rk05
a	BLOAD.PA	RKA1:
a	BOOT.PA		RKA1:
a	BPAT.PA		RKA1:
a	BUILD.PA	RKA1:
a	CCL.BI		RKA1:
a	CCL.MA		RKA1:
a	CCLAT.MA	RKA1:
a	CCLCD.MA	RKA1:
a	CCLCDX.MA	RKA1:
a	CCLCOR.MA	RKA1:
a	CCLDAT.MA	RKA1:
a	CCLDRV.MA	RKA1:
a	CCLMSG.MA	RKA1:
a	CCLPS.MA	RKA1:
a	CCLREM.MA	RKA1:
a	CCLRUN.MA	RKA1:
a	CCLSB2.MA	RKA1:
a	CCLSEM.MA	RKA1:
a	CCLSIZ.MA	RKA1:
a	CCLSUB.MA	RKA1:
a	CCLTAB.MA	RKA1:
a	CCLTBL.MA	RKA1:
a	CD.PA		RKA1:
a	FPAT.PA		RKA1:
a	FUTIL.PA	RKA1:
a	KL8E.PA		RKA1:
a	OS78.BI		RKA1:
a	OS8.PA		RKA1:
a	PAL8.PA		RKA1:
a	PIP.PA		RKA1:
a	README.V3F	RKA1:README.TX
a	RESORC.BI	RKA1:
a	RESORC.MA	RKA1:
a	RESOV0.MA	RKA1:
a	RESOV1.MA	RKA1:
a	RESOV2.MA	RKA1:
a	RESOVD.MA	RKA1:
a	RL0.PA		RKA1:
a	RL1.PA		RKA1:
a	RL2.PA		RKA1:
a	RL3.PA		RKA1:
a	RLC.PA		RKA1:
a	RLFRMT.PA	RKA1:
a	RLSY.PA		RKA1:
a	RTL.PA		RKA1:
a	RTS.PA		RKA1:
a	RX78C.PA	RKA1:
a	RXCOPY.PA	RKA1:
a	RXNS.PA		RKA1:
a	RXSY1.PA	RKA1:
a	RXSY2.PA	RKA1:
a	SAVECB.PA	RKA1:
a	TECO.PA		RKA1:
a	VXNS.PA		RKA1:
a	VXSY.PA		RKA1:


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<