forked from moshix/mvs
-
Notifications
You must be signed in to change notification settings - Fork 0
/
a1401.txt
2985 lines (2985 loc) · 220 KB
/
a1401.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
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
//HERC01A JOB (BAL),
// '1401 EMULATOR',
// CLASS=A,
// MSGCLASS=H,
// TIME=1440,REGION=6M,
// MSGLEVEL=(1,1),
// USER=HERC01,PASSWORD=CUL8TR
//********************************************************************
//*
//* Name: SYS2.JCLLIB(PRIMASM)
//*
//* Desc: Sieve of Eratosthenes programmed in Basic Assembler Language
//* All prime numbers up to the value entered via PARM.GO
//* are computed.
//*
//********************************************************************
//A1401 EXEC ASMFCG,PARM.ASM=(OBJ,NODECK),MAC1='SYS2.MACLIB',
// REGION.GO=1228K,PARM.GO='/2000'
//**DDX DD DSN=HERC01.SIM1401,
//** VOL=SER=PUB001,
//** SPACE=(TRK,1),
//** DISP=(MOD,DELETE)
//**STEP2 EXEC PGM=IEBUPDTE,PARM=NEW,REGION=40K
//SYSPRINT DD SYSOUT=*
//**SYSUT2 DD DSN=HERC01.A1401,
//** VOL=SER=PUB001,
//** SPACE=(7200,40,RLSE),
//** DCB=(RECFM=FBS,BLKSIZE=7200,LRECL=80),
//** DISP=(NEW,CATLG)
//ASM.SYSIN DD *
* MODIFIED VERSION OF 360D-11.1.019
* R.WEAVER, IBM-ARMONK NY, JUNE/JULY 1970
SPACE
* L I M I T A T I O N S
* 1401
* SUPPORTS EXPANDED PRINT EDIT ONLY
* ONLY THE FIRST 50 CHAR OF CONSOLE MSG'S ARE PRINTED
* JCL
* TAPEN DD'S MUST BE ASSIGNED TO TAPE UNITS, DISK CANNOT BE USED
SPACE
* PARM FORMAT IS 'ABCDEFGLLLX'
* WHERE
* A-G SENSE SWITCHES, N/F
* LLL LINES TO PRINT PER PAGE
* X PGM LOAD CARD OR TAPE, C/T
SPACE
SPACE
* THE FOLLOWING COMMENT BLOCK APPLIED TO THE ORIGINAL PROGRAM.
*********************************************************************** 00000200
* * 00000300
* * 00000400
* 1 4 0 1 S I M U L A T O R F O R S Y S T E M / 3 6 0 * 00000500
* * 00000600
* * 00000700
* * 00000800
* THIS PROGRAM WILL SIMULATE A 1401 ON A SYSTEM/360. THE * 00000900
* SYSTEM/360 MUST HAVE AT LEAST 65K, STANDARD INSTURCTION SET, ONE * 00001000
* 1052, ONE 2540, AND ONE PRINTER. THE 1401 FEATURES SUPPORTED ARE * 00001100
* ADVACED PROGRAMMING, SENSE SWITCHES, TAPES, MULTIPLY, DIVIDE, * 00001200
* 16K CORE, AND ALL STANDARD INSTRUCTIONS EXCEPT SELECT STACKER. * 00001300
* OPERATOR CONTROL IS THROUGH THE 1052, USING THE FOLLOWING ENTRIES * 00001400
* * 00001500
* * 00001600
* SRS - START RESET * 00001700
* STT - START * 00001800
* LDC - LOAD FROM CARDS * 00001900
* LDT - LOAD FROM TAPE * 00002000
* SSS - SET SENSE SWITCHES * 00002100
* TAS - TAPE ASSIGNMENT * 00002200
* CLR - CLEAR ALL 1401 CORE * 00002300
* DIS - DISPLAY 1401 CORE ON THE PRINTER * 00002400
* ALT - ALTER 1401 CORE * 00002500
* WTM - WRITE TAPE MARK * 00002600
* RWD - REWIND TAPE * 00002700
* TRM - TERMINATE THE SIMULATOR * 00002800
* * 00002900
* * 00003000
* * 00003100
* 16K BYTES ARE SET ASIDE FOR SIMULATED CORE, WITH EACH BYTE HAVING * 00003200
* THE FOLOWING FORMAT. * 00003300
* 360 BIT 1401 BIT * 00003400
* 0 UNUSED * 00003500
* 1 WORD MARK * 00003600
* 2 B * 00003700
* 3 A * 00003800
* 4 8 * 00003900
* 5 4 * 00004000
* 6 2 * 00004100
* 7 1 * 00004200
* * 00004300
* * 00004400
*********************************************************************** 00004500
EJECT 00004600
MACRO
&L MSG &M,&L2
LCLC &A
&L BAL 4,WTO
&A SETC 'L'''
DC AL2(&A.&L2.-1)
&L2 DC C&M
MEND
SPACE
PRINT NOGEN 14010461
START 0 00000100
USING SETBS1,15 00004700
USING SETBS1+4096,14 00004800
USING SIMCOR,7 00004900
TITLE 'ADD' 00005000
USING A,13 00005100
A CH 9,=H'7' DETERMINE INSTRUCTION LENGTH 00005200
BE AL7 * 00005300
CH 9,=H'1' * 00005400
BE AL1 * 00005500
CH 9,=H'4' * 00005600
BNE ILEGLN * 00005700
LA 6,1(10) 4 CHARACTERS, SET A AND B EQUAL 00005800
BAL 8,CVAD43 * 00005900
LR 11,5 * 00006000
LR 12,11 * 00006100
B AL1 * 00006200
AL7 LA 6,1(10) CONVERT ADDRESSES 00006300
BAL 8,CVAD43 * 00006400
LR 11,5 * 00006500
LA 6,4(10) * 00006600
BAL 8,CVAD43 * 00006700
LR 12,5 * 00006800
AL1 MVI POS1,1 SET 1-POSITION INDICATOR 00006900
MVI AEND,0 CLEAR A-FIELD ENDED INDICATOR 00007000
LA 0,1 SET REGISTER FOR FAST SUBTRACTION 00007100
IC 4,0(10) GET OP CODE 00007200
SRDL 4,1 SAVE LOW ORDER BIT 00007300
IC 4,0(11) GET A-FIELD SIGN 00007400
SRL 4,4 * 00007500
SRDL 4,2 * 00007600
IC 4,0(12) GET B-FIELD SIGN 00007700
SRL 4,4 * 00007800
SLDL 4,3 TEST TABLE 00007900
N 4,=F'31' * 00008000
A 4,=A(TBTRCP) * 00008100
TM 0(4),X'1' * 00008200
BO AL1H COMPLEMENT ADD 00008300
* 00008400
* PERFORM TRUE ADD 00008500
* 00008600
MVI AL1C+1,X'70' SET TO KEEP SIGN 00008700
LA 1,0 CLEAR CARRY 00008800
AL1A IC 3,0(12) GET B-FIELD CHARACTER 00008900
LR 6,3 SAVE B-FIELD ZONE 00009000
N 3,=F'15' ISOLATE DIGIT 00009100
C 3,=F'11' Q/ IS DIGIT NUMERIC 00009200
BL *+8 YES 00009300
S 3,=F'8' NO, ELIMINATE 8 BIT 00009400
CH 3,=H'10' Q/ ZERO 00009500
BNE *+6 NO 00009600
SR 3,3 YES, CLEAR IT 00009700
CLI AEND,1 Q/ IS THERE STILL AN A-FIELD 00009800
BE AL1B NO 00009900
IC 4,0(11) YES, GET DIGIT 00010000
LR 5,4 * 00010100
N 4,=F'15' * 00010200
C 4,=F'11' Q/ IS DIGIT NUMERIC 00010300
BL *+8 YES 00010400
S 4,=F'8' NO, ELIMINATE 8 BIT 00010500
CH 4,=H'10' Q/ ZERO 00010600
BNE *+6 NO 00010700
SR 4,4 YES, CLEAR IT 00010800
AR 3,4 ADD A TO B 00010900
AL1B AR 3,1 ADD CARRY 00011000
LA 1,0 CLEAR CARRY 00011100
CH 3,=H'9' Q/ IS RESULT GREATER THAN 9 00011200
BNH AL1C NO, OK 00011300
SH 3,=H'10' YES, SUBTRACT 10 00011400
LA 1,1 SET CARRY 00011500
AL1C NI 0(12),X'00' STORE RESULT DIGIT 00011600
STC 3,AL1D+1 * 00011700
TM AL1D+1,X'0F' Q/ IS RESULT ZERO 00011800
BC 5,AL1D NO 00011900
OI AL1D+1,X'0A' YES, SET 8-2 BITS 00012000
AL1D OI 0(12),0 * 00012100
MVI AL1C+1,X'40' SET TO ELIMINATE ZONES 00012200
CLI AEND,1 Q/ HAS A-FIELD ALREADY ENDED 00012300
BE AL1E YES 00012400
SR 11,0 DECREMENT A-FIELD ADDRESS 00012500
TM 1(11),X'40' Q/ END OF A-FIELD 00012600
BZ AL1E NO 00012700
MVI AEND,1 YES, SET A-FIELD ENDED INDICATOR 00012800
AL1E SR 12,0 DECREMENT B-FIELD ADDRESS 00012900
TM 1(12),X'40' Q/ END OF B-FIELD 00013000
BO AL1F YES 00013100
MVI POS1,0 NO, TURN OFF 1-POSITION INDICATOR 00013200
CLI AEND,1 Q/ A-FIELD ENDED 00013300
BNE AL1A NO 00013400
SR 5,5 YES, CLEAR A-FIELD CHARACTER 00013500
B AL1A ADD NEXT POSITION 00013600
AL1F CLI POS1,1 Q/ WAS THIS A 1-POSITION FIELD 00013700
BE AL1G1 YES, DONE 00013800
N 5,=F'48' NO, ADD HIGH ORDER ZONES 00013900
N 6,=F'48' * 00014000
AR 5,6 * 00014100
SLL 1,4 ADD CARRY 00014200
AR 5,1 * 00014300
STC 5,AL1G+1 STORE NEW ZONE 00014400
NI AL1G+1,X'30' * 00014500
AL1G OI 1(12),0 * 00014600
AL1G1 LTR 1,1 Q/ WAS THERE A CARRY 00014700
BC 8,NXTOP NO 00014800
MVI OVRFLO,1 YES, SET OVERFLOW INDICATOR 00014900
B NXTOP 00015000
* 00015100
* PERFORM COMPLEMENT ADDITION 00015200
* 00015300
AL1H LA 1,1 SET CARRY 00015400
ST 12,SAVB SAVE B-FIELD UNITS ADDRESS 00015500
MVI AL1L+1,X'70' SET TO KEEP B-FIELD SIGN 00015600
IC 3,0(12) GET B-FIELD SIGN 00015700
N 3,=F'48' * 00015800
CH 3,=H'32' Q/ IS IT MINUS 00015900
BE AL1I YES 00016000
OI 0(12),X'30' NO, PUT PLUS SIGN IN STANDARD FORM 00016100
AL1I IC 2,0(12) GET B-FIELD DIGIT 00016200
N 2,=F'15' * 00016300
C 2,=F'11' Q/ IS DIGIT NUMERIC 00016400
BL *+8 YES 00016500
S 2,=F'8' NO, ELIMINATE 8 BIT 00016600
CH 2,=H'10' Q/ ZERO 00016700
BNE *+6 NO 00016800
SR 2,2 YES, CLEAR IT 00016900
LA 3,9 SET COMPLEMENT 00017000
CLI AEND,1 Q/ HAS A-FIELD PREVIOUSLY ENDED 00017100
BE AL1J YES 00017200
IC 4,0(11) NO, GET A-FIELD DIGIT 00017300
N 4,=F'15' * 00017400
C 4,=F'11' Q/ IS DIGIT NUMERIC 00017500
BL *+8 YES 00017600
S 4,=F'8' NO, ELIMINATE 8 BIT 00017700
CH 4,=H'10' Q/ ZERO 00017800
BNE *+6 NO 00017900
SR 4,4 YES, CLEAR IT 00018000
SR 3,4 COMPLEMENT A-FIELD DIGIT 00018100
AL1J AR 2,3 ADD COMPLEMENT TO B-FIELD DIGIT 00018200
AR 2,1 ADD CARRY 00018300
LA 1,0 CLEAR CARRY 00018400
CH 2,=H'9' Q/ RESULT GREATER THAN 9 00018500
BNH AL1K NO, OK 00018600
SH 2,=H'10' YES, SUBTRACT 10 00018700
LA 1,1 SET CARRY 00018800
AL1K STC 2,AL1M+1 STORE RESULT DIGIT 00018900
AL1L NI 0(12),0 * 00019000
TM AL1M+1,X'0F' Q/ IS RESULT ZERO 00019100
BC 5,AL1M NO 00019200
OI AL1M+1,X'0A' YES, SET 8-2 BITS 00019300
AL1M OI 0(12),0 * 00019400
MVI AL1L+1,X'40' SET TO ELIMINATE B-FIELD ZONES 00019500
CLI AEND,1 Q/ HAS A-FIELD ALREADY ENDED 00019600
BE AL1N YES 00019700
SR 11,0 NO, DECREMENT A-FIELD ADDRESS 00019800
TM 1(11),X'40' Q/ IS THIS THE END OF THE A-FIELD 00019900
BZ AL1N NO 00020000
MVI AEND,1 YES, SET A-FIELD ENDED INDICATOR 00020100
AL1N SR 12,0 DECREMENT B-FIELD ADDRESS 00020200
TM 1(12),X'40' Q/ IS THIS THE END OF THE B-FIELD 00020300
BO AL1O YES 00020400
MVI POS1,0 NO, CLEAR 1-POSITION INDICATOR 00020500
B AL1I 00020600
AL1O LTR 1,1 Q/ CARRY 00020700
BC 6,NXTOP YES, DONE 00020800
* 00020900
* PERFORM RECOMPLEMENT CYCLE 00021000
* 00021100
LA 1,1 SET CARRY 00021200
L 12,SAVB RESTORE B-FIELD UNITS ADDRESS 00021300
IC 2,0(12) GET B-FIELD SIGN 00021400
N 2,=F'48' * 00021500
NI 0(12),X'CF' SET SIGN TO MINUS 00021600
OI 0(12),X'20' * 00021700
CH 2,=H'32' Q/ WAS THE B-FIELD SIGN MINUS 00021800
BNE AL1P NO, LEAVE IT MINUS 00021900
OI 0(12),X'30' YES, SET IT PLUS 00022000
AL1P IC 3,0(12) GET B-FIELD DIGIT 00022100
N 3,=F'15' * 00022200
CH 3,=H'10' Q/ ZERO 00022300
BNE *+6 NO 00022400
SR 3,3 YES, CLEAR IT 00022500
LA 4,9 SET COMPLEMENT 00022600
SR 4,3 COMPLEMENT THE DIGIT 00022700
AR 4,1 ADD CARRY 00022800
LA 1,0 CLEAR CARRY 00022900
CH 4,=H'9' Q/ IS THE RESULT GREATER THAN 9 00023000
BNH AL1Q NO, OK 00023100
SH 4,=H'10' YES, SUBTRACT 10 00023200
LA 1,1 SET CARRY 00023300
AL1Q STC 4,AL1R+1 STORE RESULT 00023400
NI 0(12),X'70' * 00023500
TM AL1R+1,X'0F' Q/ IS RESULT ZERO 00023600
BC 5,AL1R NO 00023700
OI AL1R+1,X'0A' YES, SET 8-2 BITS 00023800
AL1R OI 0(12),0 * 00023900
SR 12,0 DECREMENT B-FIELD ADDRESS 00024000
TM 1(12),X'40' Q/ IS THIS THE END OF THE B-FIELD 00024100
BZ AL1P NO 00024200
B NXTOP YES 00024300
TBTRCP DC X'01000100000101000100010000010100' 00024400
DC X'00010001010000010100010000010100' 00024500
POS1 DC X'0' 00283500
SAVB DS F 00283700
TITLE 'ZERO AND ADD' 00024600
USING ZA,13 00024700
ZA CH 9,=H'1' 00024800
BE ZAL1 00024900
CH 9,=H'7' 00025000
BE ZAL7 00025100
CH 9,=H'4' 00025200
BNE ILEGLN 00025300
ZAL7 LA 6,1(10) 00025400
BAL 8,CVAD43 00025500
LR 11,5 00025600
LR 12,5 00025700
CH 9,=H'4' 00025800
BE ZAL1 00025900
LA 6,4(10) 00026000
BAL 8,CVAD43 00026100
LR 12,5 00026200
ZAL1 LR 6,12 00026300
LR 5,11 00026400
LA 0,1 00026500
IC 3,0(11) SAVE LOW CHARACTER OF A-FIELD 00026600
STC 3,TEMP1 * 00026700
ZAL1A MVN 0(1,6),0(5) MOVE NUMERIC 00026800
NI 0(6),X'4F' ELIMINATE ZONE 00026900
SR 5,0 00027000
SR 6,0 00027100
TM 1(5),X'40' Q/ END OF A-FIELD 00027200
BO ZAL1E YES 00027300
TM 1(6),X'40' NO, END OF B-FIELD 00027400
BZ ZAL1A NO, MOVE NEXT DIGIT 00027500
ZAL1C OI 0(12),X'20' SET B-FIELD SIGN MINUS 00027600
NI TEMP1,X'30' Q/ IS A-FIELD MINUS 00027700
CLI TEMP1,X'20' * 00027800
BE ZAL1D YES 00027900
OI 0(12),X'30' NO, SET B-FIELD SIGN PLUS 00028000
ZAL1D LR 11,5 SET A-ADDRESS 00028100
LR 12,6 SET B-ADDRESS 00028200
B NXTOP 00028300
ZAL1E TM 1(6),X'40' ZERO B-FIELD BEYOND RANGE OF A-FIELD 00028400
BO ZAL1C * 00028500
NI 0(6),X'40' * 00028600
OI 0(6),X'0A' 00028700
SR 6,0 00028800
B ZAL1E * 00028900
TITLE 'ZERO AND SUBTRACT' 00029000
USING ZS,13 00029100
ZS CH 9,=H'7' 00029200
BE ZS1 00029300
CH 9,=H'1' 00029400
BE ZSL4 00029500
CH 9,=H'4' 00029600
BNE ILEGLN 00029700
ZS1 LA 6,1(10) 00029800
BAL 8,CVAD43 00029900
LR 11,5 00030000
LR 12,11 00030100
CH 9,=H'4' 00030200
BE ZSL4 00030300
LA 6,4(10) 00030400
BAL 8,CVAD43 00030500
LR 12,5 00030600
ZSL4 LR 5,11 00030700
LR 6,12 00030800
LA 0,1 SET ONE IN REG 0 FOR SUBTRACTING 00030900
IC 3,0(11) SAVE LOW CHARACTER OF A-FIELD 00031000
STC 3,TEMP1 * 00031100
ZSL4A MVN 0(1,6),0(5) MOVE NUMERIC 00031200
NI 0(6),X'4F' ELIMINATE ZONE 00031300
SR 5,0 DECREMENT A-ADDRESS 00031400
TM 1(5),X'40' 00031500
BO ZSL4F 00031600
SR 6,0 DECREMENT B-ADDRESS 00031700
TM 1(6),X'40' 00031800
BZ ZSL4A 00031900
ZSL4C OI 0(12),X'20' SET B-FIELD SIGN MINUS 00032000
NI TEMP1,X'30' Q/ WAS A-FIELD MINUS 00032100
CLI TEMP1,X'20' * 00032200
BNE ZSL4D LEAVE IT MINUS IF IT WAS PLUS 00032300
OI 0(12),X'30' MAKE B-FIELD PLUS 00032400
ZSL4D LR 11,5 00032500
LR 12,6 00032600
B NXTOP 00032700
ZSL4E NI 0(6),X'40' 00032800
OI 0(6),X'0A' 00032900
ZSL4F SR 6,0 00033000
TM 1(6),X'40' 00033100
BO ZSL4C 00033200
B ZSL4E 00033300
TITLE 'BRANCH, CONDITIONAL BRANCH, AND BRANCH ON CHARACTER' 00033400
USING B,13 00033500
B CH 9,=H'4' 00033600
BE BL5BCH UNCONDITIONAL BRANCH 00033700
CH 9,=H'8' 00033800
BE BCE8 00033900
CH 9,=H'1' 00034000
BE BCE1A 00034100
CH 9,=H'5' 00034200
BH BL5BCH 00034300
BL ILEGLN 00034400
IC 3,4(10) GET D CHARACTER 00034500
N 3,=F'63' * 00034600
SLL 3,2 MULTIPLY BY 4 00034700
L 4,DCHARTBL(3) GET ADDRESS OF CONDITIONAL BRANCH RTN 00034800
BR 4 GO TO ROUTINE OF NXTOP 00034900
BL5A TM SENSEA,1 Q/ IS SENSE SWITCH A ON 00035000
BZ NXTOP NO, CANNOT BRANCH 00035100
TM CRDEOF,1 YES, IS READER EMPTY 00035200
BO BL5BCH YES, BRANCH 00035300
B NXTOP NO 00035400
BL5B CLI SENSEB,1 00035500
B BL5CKB 00035600
BL5C CLI SENSEC,1 00035700
B BL5CKB 00035800
BL5D CLI SENSED,1 00035900
B BL5CKB 00036000
BL5E CLI SENSEE,1 00036100
B BL5CKB 00036200
BL5F CLI SENSEF,1 00036300
B BL5CKB 00036400
BL5G CLI SENSEG,1 00036500
B BL5CKB 00036600
BL5K CLI TPEOF,1 00036700
MVI TPEOF,0 00036800
B BL5CKB 00036900
BL5L CLI TPERR,1 00037000
B BL5CKB 00037100
BL5S CLI CPR,0 00037200
B BL5CKB 00037300
BL5T CLI CPR,1 00037400
B BL5CKB 00037500
BL5U CLI CPR,2 00037600
B BL5CKB 00037700
BL51 CLI CPR,0 00037800
BE NXTOP 00037900
B BL5BCH 00038000
BL5Z CLI OVRFLO,1 00038100
MVI OVRFLO,0 00038200
B BL5CKB 00038300
BL52 CLI PRTP12,1 00038400
B BL5CKB 00038500
BL5RER CLI RDRERR,1 00038600
MVI RDRERR,0 00038700
B BL5CKB 00038800
BL5PER CLI PCHERR,1 00038900
MVI PCHERR,0 00039000
BL5P B NXTOP 00039100
BL53 CLI PRTERR,1 Q/ PRINT ERROR 00039200
MVI PRTERR,0 CLEAR ERROR INDICATOR 00039300
B BL5CKB CHECK CONDITION CODE 00039400
BL5CKB BNE NXTOP 00039500
BL5BCH LA 6,1(10) 00039600
B SETBCH SET CONDITIONS FOR BRANCH 00039700
BCE8 CLI 4(10),0 Q/ IS FIFTH CHARACTER A BLANK 00039800
BE BL5BCH YES, BRANCH 00039900
LA 6,4(10) NO, TREAT AS BCE 00040000
BAL 8,CVAD43 00040100
LR 12,5 00040200
LA 6,1(10) 00040300
BAL 8,CVAD43 00040400
LR 11,5 00040500
MVC DCHAR,7(10) 00040600
BCE1A MVC TEMP1(1),0(12) 00040700
NI TEMP1,X'BF' 00040800
CLC TEMP1,DCHAR COMPARE D CHARACTER TO CORE LOCATION 00040900
BNE BCE1B 00041000
LR 12,10 00041100
AR 12,9 00041200
ST 10,LSTBCH STORE LOCATION COUNTER BEFORE BRANCH 00041300
LR 10,11 00041400
LA 9,0 00041500
B NXTOP 00041600
BCE1B SH 12,=H'1' 00041700
B NXTOP 00041800
DCHARTBL DC A(BL5BCH),11A(NXTOP),A(BL52),4A(NXTOP),A(BL51,BL5S) 00041900
DC A(BL5T,BL5U),4A(NXTOP),A(BL5Z,BL53),7A(NXTOP) 00042000
DC A(BL5K,BL5L),3A(NXTOP),A(BL5P,NXTOP,BL5P,BL5PER) 00042100
DC 6A(NXTOP),A(BL5A,BL5B,BL5C,BL5D,BL5E,BL5F,BL5G) 00042200
DC 2A(NXTOP),A(BL5RER),5A(NXTOP) 00042300
TITLE 'BRANCH ON WORD MARK / ZONE' 00042400
USING BWZ,13 00042500
BWZ CH 9,=H'1' 00042600
BE BWZL1 00042700
CH 9,=H'8' 00042800
BNE ILEGLN 00042900
LA 6,1(10) 00043000
BAL 8,CVAD43 00043100
LR 11,5 00043200
LA 6,4(10) 00043300
BAL 8,CVAD43 00043400
LR 12,5 00043500
MVC DCHAR(1),7(10) 00043600
BWZL1 SH 12,=H'1' 00043700
CLI DCHAR,X'01' 00043800
BE BWZW 00043900
CLI DCHAR,X'02' 00044000
BE BWZ0 00044100
CLI DCHAR,X'32' 00044200
BE BWZBA 00044300
CLI DCHAR,X'22' 00044400
BE BWZB 00044500
CLI DCHAR,X'12' 00044600
BE BWZA 00044700
CLI DCHAR,X'03' 00044800
BE BWZW0 00044900
CLI DCHAR,X'33' 00045000
BE BWZWBA 00045100
CLI DCHAR,X'23' 00045200
BE BWZWB 00045300
CLI DCHAR,X'13' 00045400
BE BWZWA 00045500
B ILEGOP 00045600
BWZW TM 1(12),X'40' 00045700
BO BWZBCH 00045800
B NXTOP 00045900
BWZ0 TM 1(12),X'30' 00046000
BZ BWZBCH 00046100
B NXTOP 00046200
BWZBA TM 1(12),X'30' 00046300
BO BWZBCH 00046400
B NXTOP 00046500
BWZB TM 1(12),X'20' 00046600
BZ NXTOP 00046700
TM 1(12),X'10' 00046800
BO NXTOP 00046900
B BWZBCH 00047000
BWZA TM 1(12),X'20' 00047100
BO NXTOP 00047200
TM 1(12),X'10' 00047300
BO BWZBCH 00047400
B NXTOP 00047500
BWZW0 TM 1(12),X'40' 00047600
BO BWZBCH 00047700
B BWZ0 00047800
BWZWBA TM 1(12),X'40' 00047900
BO BWZBCH 00048000
B BWZBA 00048100
BWZWB TM 1(12),X'40' 00048200
BO BWZBCH 00048300
B BWZB 00048400
BWZWA TM 1(12),X'40' 00048500
BO BWZBCH 00048600
B BWZA 00048700
BWZBCH ST 10,LSTBCH STORE LOCATION COUNTER BEFORE BRANCH 00048800
LR 12,10 SET B-REG 00048900
AR 12,9 * 00049000
LR 10,11 SET LOCATION COUNTER FOR BRANCH 00049100
LA 9,0 * 00049200
B NXTOP 00049300
TITLE 'COMPARE' 00049400
USING C,13 00049500
C CH 9,=H'1' 00049600
BE CL1 00049700
CH 9,=H'4' 00049800
BE CL4 00049900
CH 9,=H'7' 00050000
BNE ILEGLN 00050100
LA 6,4(10) 00050200
BAL 8,CVAD43 00050300
LR 12,5 00050400
MVI TCPR,0 INITALIZE COMPARE RESULT TO EQUAL 14015045
* (1401 RESETS WHEN B-ADDR LOADED) 14015046
CL4 LA 6,1(10) CONVERT A-ADDR TO 360 FORMAT 00050500
BAL 8,CVAD43 * 00050600
LR 11,5 * 00050700
CH 9,=H'4' Q/ IS INSTRUCTION 4 CHARACTERS 00050800
BNE CL1 NO 00050900
LR 12,11 YES, FORS 00051000
LR 12,11 YES, FORCE B/ADDR = A/ADDR 00051100
CL1 LA 4,0 14015130
LA 0,1 00051400
C1 SR 11,0 00051500
SR 12,0 00051600
TM 1(12),X'40' 00051700
BO C2 00051800
TM 1(11),X'40' 00051900
BO C5 LONG B-FIELD 00052000
LA 4,1(4) 00052100
B C1 00052200
C2 LR 5,11 00052300
LR 6,12 00052400
LA 4,1(4) 00052500
C3 MVC TCR(1),1(6) 00052600
MVC TCR+1(1),1(5) 00052700
TR TCR(2),CPRTBL CONVERT DIGITS TO SORT SEQUENCE 00052800
CLC TCR(1),TCR+1 00052900
BH C5 00053000
BL C6 00053100
LA 5,1(5) 00053200
LA 6,1(6) 00053300
BCT 4,C3 00053400
C4 CH 9,=H'1' 00053500
BNE C4A 00053600
CLI TCPR,0 00053700
BE NXTOP 00053800
C4A MVC CPR,TCPR 00053900
B NXTOP 00054000
C5 MVI TCPR,2 SET HIGH 00054100
B C4 00054200
C6 MVI TCPR,1 SET LOW 00054300
B C4 00054400
TCPR DC X'00' 00054500
TCR DS CL2 00054600
CPRTBL DC HL1'0,55,56,57,58,59,60,61,62,63,54,20,21,22,23,24' 00054700
DC HL1'19,13,46,47,48,49,50,51,52,53,45,14,15,16,17,18' 00054800
DC HL1'12,36,37,38,39,40,41,42,43,44,35,7,8,9,10,11' 00054900
DC HL1'6,26,27,28,29,30,31,32,33,34,25,1,2,3,4,5' 00055000
DC HL1'0,55,56,57,58,59,60,61,62,63,54,20,21,22,23,24' 00055100
DC HL1'19,13,46,47,48,49,50,51,52,53,45,14,15,16,17,18' 00055200
DC HL1'12,36,37,38,39,40,41,42,43,44,35,7,8,9,10,11' 00055300
DC HL1'6,26,27,28,29,30,31,32,33,34,25,1,2,3,4,5' 00055400
TITLE 'HALT' 00055500
USING H,13 00055600
H CH 9,=H'1' 00055700
BE H1 00055800
CH 9,=H'4' 00055900
BE H1 00056000
CH 9,=H'7' 00056100
BNE ILEGLN 00056200
H1 LR 5,10 CONVERT I ADDRESS 00056300
BAL 8,H5 * 00056400
MVC I003+12(6),HLTADARA MOVE I ADDR TO OUTPUT 06140
MVC I003+21(6),=CL6' ' 06150
MVC I003+30(6),=CL6' ' 06155
CH 9,=H'7' Q/ IS THERE A B ADDRESS 00056700
BL H2 NO 00056800
LA 6,1(10) CONVERT 1401 ADDRESS 00056900
BAL 8,CVAD43 * 00057000
BAL 8,H5 * 00057100
MVC I003+21(6),HLTADARA MOVE A ADDR TO OUTPUT 06210
LA 6,4(10) CONVERT 1401 B ADDRESS 00057300
BAL 8,CVAD43 * 00057400
BAL 8,H5 * 00057500
MVC I003+30(6),HLTADARA MOVE B ARRR YO OUTPUT
MSG 'I003 HALT I , A , B ',I003
AIF ('&CONSOLE' EQ 'Y').HWTO2
H2 B TERMINAT
.HWTO2 ANOP
CH 9,=H'4' 00057900
BNE H3 00058000
LA 6,1(10) 00058100
BAL 8,CVAD43 00058200
ST 5,ADR360 00058300
H3 MVC RETURN,=A(H4) SET TO CONTINUE AFTER RESTART 00058400
B WTORTN 00058500
H4 CH 9,=H'4' Q/ BRANCH 00058600
BNE NXTOP 00058700
LR 12,10 00058800
AR 12,9 00058900
L 10,ADR360 00059000
LA 9,0 00059100
B NXTOP 00059200
H5 SR 5,7 GET 1401 ADDRESS 00059300
CVD 5,PAKT CONVERT TO DECIMAL 00059400
UNPK HLTADARA(6),PAKT+5(3) UNPACK 1401 ADDRESS 00059500
OI HLTADARA+5,X'F0' MAKE SIGN NUMERIC 00059600
LA 1,HLTADARA BLANK LEADING ZEROS 00059700
H6 CLI 0(1),C'0' * 00059800
BCR 6,8 * 00059900
MVI 0(1),X'40' * 00060000
LA 1,1(1) * 00060100
B H6 * 00060200
HLTADARA DC CL6' ' 00060300
TITLE 'CLEAR STORAGE' 00060400
USING CS,13 00060500
CS CH 9,=H'1' 00060600
BE CSL1 00060700
CH 9,=H'4' 00060800
BE CSL4 00060900
CH 9,=H'7' 00061000
BL ILEGLN 00061100
MVC HLDBCH(3),1(10) 00061200
LA 6,4(10) 00061300
B CSCOM 00061400
CSL4 LA 6,1(10) 00061500
CSCOM BAL 8,CVAD43 00061600
LR 12,5 00061700
CSL1 LR 3,12 00061800
SR 3,7 SUBTRACT SIMULATED CORE BASE LOCATION 00061900
LA 2,0 00062000
D 2,=F'100' 00062100
SR 12,2 00062200
STC 2,CSL1A+1 00062300
CSL1A XC 0(0,12),0(12) CLEAR CORE BLOCK 00062400
CR 12,7 Q/ DID B-REG GO TO 0 00062500
BNE CS2 NO 00062600
L 12,=F'15999' 00062700
AR 12,7 00062800
B CS3 * 00062900
CS2 SH 12,=H'1' SUBTRACT 1 FROM B-REG 00063000
CS3 CH 9,=H'7' Q/ IS THERE A BRANCH 00063100
BL NXTOP 00063200
LA 6,HLDBCH 00063300
B SETBCH 00063400
HLDBCH DS CL3 00063500
TITLE 'SET WORD MARK' 00063600
USING SW,13 00063700
SW CH 9,=H'6' 00063800
BNL SWL7 00063900
CH 9,=H'4' 00064000
BE SWL4 00064100
CH 9,=H'1' 00064200
BE SWL1 00064300
B ILEGLN 00064400
SWL4 LA 6,1(10) 00064500
BAL 8,CVAD43 00064600
LR 11,5 00064700
OI 0(11),X'40' 00064800
SH 11,=H'1' 00064900
LR 12,11 00065000
B NXTOP 00065100
SWL7 LA 6,1(10) 00065200
BAL 8,CVAD43 00065300
LR 11,5 00065400
LA 6,4(10) 00065500
BAL 8,CVAD43 00065600
LR 12,5 00065700
SWL1 OI 0(11),X'40' 00065800
OI 0(12),X'40' 00065900
SH 11,=H'1' 00066000
SH 12,=H'1' 00066100
CH 9,=H'7' 00066200
BNH NXTOP 00066300
LA 9,7 00066400
B NXTOP 00066500
TITLE 'CLEAR WORD MARK' 00066600
USING CW,13 00066700
CW CH 9,=H'6' 00066800
BNL CWL7 00066900
CH 9,=H'4' 00067000
BE CWL4 00067100
CH 9,=H'1' 00067200
BE CWL1 00067300
B ILEGLN 00067400
CWL4 LA 6,1(10) 00067500
BAL 8,CVAD43 00067600
LR 11,5 00067700
NI 0(11),X'BF' 00067800
SH 11,=H'1' 00067900
LR 12,11 00068000
B NXTOP 00068100
CWL7 LA 6,1(10) 00068200
BAL 8,CVAD43 00068300
LR 11,5 00068400
LA 6,4(10) 00068500
BAL 8,CVAD43 00068600
LR 12,5 00068700
CWL1 NI 0(11),X'BF' 00068800
NI 0(12),X'BF' 00068900
SH 11,=H'1' 00069000
SH 12,=H'1' 00069100
B NXTOP 00069200
TITLE 'MOVE CHARACTERS TO A WORD MARK' 00069300
USING MCW,13 00069400
MCW CH 9,=H'7' 00069500
BE MCWL7 00069600
CH 9,=H'4' 00069700
BE MCWL4 00069800
CH 9,=H'1' 00069900
BE MCWL1 00070000
CH 9,=H'8' 00070100
BE MCW8 00070200
B ILEGLN 00070300
MCWL7 LA 6,4(10) 00070400
BAL 8,CVAD43 00070500
LR 12,5 00070600
MCWL4 LA 6,1(10) 00070700
BAL 8,CVAD43 00070800
LR 11,5 00070900
MCWL1 LA 0,1 00071000
MCWL1B MVC MCWL1A+1(1),0(11) 00071100
NI MCWL1A+1,X'3F' 00071200
NI 0(12),X'40' 00071300
MCWL1A OI 0(12),0 00071400
SR 11,0 00071500
SR 12,0 00071600
TM 1(11),X'40' 00071700
BO NXTOP 00071800
TM 1(12),X'40' 00071900
BZ MCWL1B 00072000
B NXTOP 00072100
MCW8 MVC DCHAR(1),7(10) 00072200
CLI DCHAR,X'29' 00072300
BE RT 00072400
CLI DCHAR,X'16' 00072500
BE CHKCON
CLI DCHAR,X'31' 00072700
BE MBD 00072800
CLI DCHAR,X'32' 00072900
BE MBD 00073000
B ILEGOP 00073100
CHKCON CLI 2(10),X'13' CHECK FOR T IN
BE CONSOLE M%T0XXXW INST
B WT
* 00073200
* READ TAPE WITHOUT WORD MARKS 00073300
* 00073400
AIF ('&TAPE' EQ 'N').NOTRD
RT LA 6,4(10) CONVERT CORE LOCATION FOR TAPE READ 00073500
BAL 8,CVAD43 * 00073600
LR 12,5 * 00073700
BAL 8,FNDRIV GET DEVICE ADDRESS 00073800
MVI RTCCW,X'A3' SET PARITY IN MODE SET COMMAND 00073900
MVI BCDTAP,1 * 00074000
TM 2(10),X'14' * 00074100
BO RT1 * 00074200
MVI RTCCW,X'B3' * 00074300
MVI BCDTAP,0 SET BINARY 00074400
RT1 ST 3,TMDCB 00074500
MVC TPCCW,=A(RTCCW) 00074600
STM 13,15,MACREGSV SAVE MACRO REGS 00074700
LA 6,MACREGSV SAVE ADDRESS TO XR 00074800
LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00074900
EXCP TMIOB 00075000
LM 14,15,4(6) RESTORE REG 14 AND 15 00075100
WAIT 1,ECB=TMECB WAIT FOR I/O 00075200
LM 13,15,0(6) RESTORE MACRO REGISTERS 00075300
BAL 8,TPTEST 00075400
BAL 8,FNDLNG FIND LENGTH OF B-FIELD 00075500
LR 3,6 * 00075600
L 1,TAPEAREA SET SENDING ADDRESS 00075700
LH 5,SAVCSW+6 FIND NUMBER OF BYTES READ 00075800
LH 4,=H'25000' * 00075900
SR 4,5 * 00076000
CR 3,4 USE SMALLER FIELD 00076100
BNH RT3 * 00076200
LR 3,4 * 00076300
RT3 CH 3,=H'256' Q/ MORE THAN 256 BYTES 00076400
BNH RT4 NO 00076500
NC 0(256,12),WM256 YES, MOVE 256 BYTES 00076600
CLI BCDTAP,1 * 00076700
BNE RT3A * 00076800
TR 0(256,1),TR4IBC * 00076900
RT3A OC 0(256,12),0(1) * 00077000
LA 1,256(1) * 00077100
LA 12,256(12) * 00077200
SH 3,=H'256' * 00077300
B RT3 * 00077400
RT4 SH 3,=H'1' MOVE REMAINING BYTES 00077500
STC 3,RT5+1 * 00077600
STC 3,RT6+1 * 00077700
STC 3,RT7+1 * 00077800
RT5 NC 0(0,12),WM256 * 00077900
CLI BCDTAP,1 * 00078000
BNE RT7 * 00078100
RT6 TR 0(0,1),TR4IBC * 00078200
RT7 OC 0(0,12),0(1) * 00078300
AR 12,3 SET GROUP MARK AFTER DATA 00078400
NI 1(12),X'40' * 00078500
OI 1(12),X'3F' * 00078600
LA 12,2(12) SET B-ADDRESS 00078700
B NXTOP END OF TAPE READ INSTRUCTION 00078800
* 00078900
* WRITE TAPE WITHOUT WORD MARKS 00079000
* 00079100
WT LA 6,4(10) 00079200
BAL 8,CVAD43 00079300
LR 12,5 00079400
BAL 8,FNDLNG 00079500
STH 6,WTCCW2+6 STORE LENGTH IN CCW 00079600
LR 4,12 00079700
AR 12,6 SET B-ADDRESS 00079800
LA 12,1(12) * 00079900
L 3,TAPEAREA 00080000
MVI WTCCW1,X'A3' SET BCD MODE 00080100
MVI BCDTAP,1 * 00080200
CLI 2(10),X'14' Q/ IS INSTRUCTION BCD 00080300
BE WT1 YES 00080400
MVI WTCCW1,X'B3' NO, SET BINARY MODE 00080500
MVI BCDTAP,0 * 00080600
WT1 CH 6,=H'256' 00080700
BNH WT2 00080800
MVC 0(256,3),0(4) 00080900
CLI BCDTAP,1 Q/ BCD 00081000
BNE WT1A NO 00081100
TR 0(256,3),TRI4BC YES, CHANGE X'00' TO X'10' FOR TAPE 00081200
WT1A LA 3,256(3) UP REG 3 BY 256 00081300
LA 4,256(4) 00081400
SH 6,=H'256' 00081500
B WT1 00081600
WT2 STC 6,WT3+1 00081700
STC 6,WT4+1 00081800
WT3 MVC 0(0,3),0(4) 00081900
CLI BCDTAP,1 Q/ BCD 00082000
BNE WT4A NO 00082100
WT4 TR 0(0,3),TRI4BC YES, CHANGE X'00' TO X'10' FOR TAPE 00082200
WT4A BAL 8,FNDRIV GET DEVICE ADDRESS 00082300
ST 3,TMDCB 00082400
MVC TPCCW,=A(WTCCW1) 00082500
STM 13,15,MACREGSV SAVE MACRO REGS 00082600
LA 6,MACREGSV SAVE ADDRESS TO XR 00082700
LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00082800
EXCP TMIOB 00082900
LM 14,15,4(6) RESTORE REG 14 AND 15 00083000
WAIT 1,ECB=TMECB WAIT FOR I/O 00083100
LM 13,15,0(6) RESTORE MACRO REGISTERS 00083200
BAL 8,TPTEST 00083300
B NXTOP 00083400
.NOTRD ANOP
AIF ('&TAPE' EQ 'Y').RTOK
RT B ILEGOP
WT B ILEGOP
.RTOK ANOP
SPACE
AIF ('&MB' EQ 'N').NOMB
MBD LA 6,1(10) 00083500
BAL 8,CVAD43 00083600
LR 11,5 00083700
LA 6,4(10) 00083800
BAL 8,CVAD43 00083900
LR 12,5 00084000
LA 0,1 00084100
LR 6,12 00084200
SH 6,=H'100' 00084300
CLI DCHAR,X'32' 00084400
BE MBC 00084500
LR 6,11 00084600
SH 6,=H'100' 00084700
MBD1 IC 3,0(11) 00084800
STC 3,MBD2+1 00084900
NI MBD2+1,X'BF' 00085000
NI 0(12),X'40' 00085100
MBD2 OI 0(12),0 00085200
SR 12,0 00085300
IC 3,0(6) 00085400
STC 3,MBD3+1 00085500
NI MBD3+1,X'BF' 00085600
NI 0(12),X'40' 00085700
MBD3 OI 0(12),0 00085800
SR 12,0 00085900
SR 11,0 00086000
SR 6,0 00086100
TM 1(6),X'40' 00086200
BC 8,MBD1 00086300
B NXTOP 00086400
MBC IC 3,0(11) 00086500
STC 3,MBC1+1 00086600
NI MBC1+1,X'BF' 00086700
NI 0(12),X'40' 00086800
MBC1 OI 0(12),0 00086900
SR 11,0 00087000
IC 3,0(11) 00087100
STC 3,MBC2+1 00087200
NI MBC2+1,X'BF' 00087300
NI 0(6),X'40' 00087400
MBC2 OI 0(6),0 00087500
SR 12,0 00087600
SR 11,0 00087700
SR 6,0 00087800
TM 1(6),X'40' 00087900
BO NXTOP 00088000
TM 1(12),X'40' 00088100
BZ MBC 00088200
B NXTOP 00088300
.NOMB AIF ('&MB' EQ 'Y').YESMB
MBD B ILEGOP
.YESMB ANOP
SPACE
CONSOLE CH 9,=H'8'
BNE ILEGLN
LA 6,4(10)
BAL 8,CVAD43 CONVERT B ADDR
LR 12,5
TRT 0(50,5),TRGPWM 09630
BC 6,CONSOLE1
L 1,=F'49' 09650
B CLRMSG
CONSOLE1 SR 1,5
CLRMSG MVI CON,C' ' BLANK MSG AREA 09680
MVC CON+1(49),CON 09690
EX 1,MV 09600
EX 1,TRAN 09610
MSG ' ',CON 09740
B NXTOP
TRAN TR CON(0),TRIE 09800
MV MVC CON(0),0(12) 09810
TITLE 'MOVE CHARACTERS AND SUPPRESS LEADING ZEROS' 00088400
USING MCS,13 00088500
MCS CH 9,=H'1' 00088600
BE MCSL1 00088700
CH 9,=H'7' 00088800
BE MCSL7 00088900
CH 9,=H'4' 00089000
BNE ILEGLN 00089100
LA 6,1(10) 00089200
BAL 8,CVAD43 00089300
LR 11,5 00089400
LR 12,5 00089500
B MCSL1 00089600
MCSL7 LA 6,1(10) 00089700
BAL 8,CVAD43 00089800
LR 11,5 00089900
LA 6,4(10) 00090000
BAL 8,CVAD43 00090100
LR 12,5 00090200
MCSL1 LA 0,1 00090300