-
Notifications
You must be signed in to change notification settings - Fork 0
/
bool_min.lst
1533 lines (1500 loc) · 96 KB
/
bool_min.lst
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
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 1
1 /*
2 ===============================================================================
3 = UTILITY PROGRAMME FOR THE MINIMISATION OF BOOLEAN FUNCTIONS =
4 = Written by R.C.LUCKHURST, September 1986 =
5 = for final year BSc Electrical Engineering project, Bristol Polytechnic =
6 = Amended July 2024, see https://github.com/scriptituk/bool_min =
7 ===============================================================================
8 */
9
10
11 BSc_project: PROCEDURE OPTIONS (MAIN);
12
13 %REPLACE $true BY '1'B;
14 %REPLACE $false BY '0'B;
15 %REPLACE $low BY 1;
16 %REPLACE $high BY 2;
17 %REPLACE $cost BY 3;
18 %REPLACE $status BY 4;
19 %REPLACE $redundant BY 1;
20 %REPLACE $min_cost_redundant BY 2;
21 %REPLACE $non_essential BY 3;
22 %REPLACE $min_cost_essential BY 4;
23 %REPLACE $essential BY 5;
24
25 DECLARE SYSIN FILE STREAM INPUT ENVIRONMENT(INTERACTIVE);
26 DECLARE SYSPRINT FILE STREAM OUTPUT PRINT ENVIRONMENT(INTERACTIVE);
27
28 DECLARE (BINARY, BIT, CEIL, CHARACTER, COPY, DECIMAL, INDEX,
29 LENGTH, LOG2, MIN, SUBSTR, TRANSLATE, VERIFY) BUILTIN,
30
31 (num_minterms, num_dont_cares, num_terms, num_pis, num_ne_pis, num_inepi_sums,
32 minterm (512), dont_care (512), term (1024), p_i (4,256), ne_pi (96),
33 function_order, solution_cost) FIXED BINARY,
34
35 (unique_solution, new_data,
36 epi_covers_minterm (256), pi_covers_minterm (256,256)) BIT STATIC,
37 inepi_sum (3000) BIT (96) ALIGNED,
38
39 version CHARACTER (4) STATIC INITIAL ('V1.0'),
40 continue CHARACTER (30) VARYING,
41 pi_status (5) CHARACTER(30) VARYING STATIC INITIAL
42 ('redundant','minimum-cost redundant','non-essential','minimum-cost essential','essential'),
43 results_file FILE;
44
45
46 /*
47 ###############################################################################
48 # UTILITY PROCEDURES #
49 ###############################################################################
50 */
51
52
53 /******************************************************************************
54 * PROCEDURE equivalent: Returns logical equivalence between 2 integers *
55 *******************************************************************************/
56 equivalent: PROCEDURE (x,y) RETURNS (FIXED BINARY);
57 DECLARE (x,y) FIXED BINARY;
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 2
58 RETURN (x & y | ^ x & ^ y);
59 END equivalent;
60
61
62 /******************************************************************************
63 * PROCEDURE trim: Returns integer with no leading spaces *
64 *******************************************************************************/
65 trim: PROCEDURE (value) RETURNS (CHARACTER (10) VARYING);
66 DECLARE value FIXED BINARY;
67 RETURN (SUBSTR(CHARACTER(value),VERIFY(CHARACTER(value),' ')));
68 END trim;
69
70
71 /******************************************************************************
72 * PROCEDURE sort_data: Sorts minterms and don't cares into ascending order *
73 * and deletes duplicate terms and terms out of range *
74 *******************************************************************************/
75 sort_data: PROCEDURE;
76 DECLARE (i, j, t) FIXED BINARY, (b, sorted, excess_terms, type (512)) BIT ALIGNED;
77
78 /* first make an all-term list */
79 DO t = 1 TO num_minterms;
80 term(t) = minterm(t);
81 type(t) = $true; /* ie minterm */
82 END;
83 DO t = 1 TO num_dont_cares;
84 term(num_minterms + t) = dont_care(t);
85 type(num_minterms + t) = $false; /* ie dont-care */
86 END;
87 num_terms = num_minterms + num_dont_cares;
88
89 /* then sort into ascending order */
90 excess_terms = $true;
91 DO WHILE (excess_terms);
92 excess_terms = $false; sorted = $false;
93 DO i = num_terms TO 1 BY -1 WHILE (^ (sorted | excess_terms));
94 /* erase terms which are out of range */
95 IF term(i) < 0 | term(i) > 255 THEN DO;
96 term(i) = term(num_terms);
97 type(i) = type(num_terms);
98 num_terms = num_terms - 1;
99 excess_terms = $true;
100 END;
101 sorted = $true;
102 DO j = 1 TO i - 1 WHILE (^ excess_terms);
103 IF term(j) < 0 THEN sorted = $false;
104 /* if terms not in ascending order then swap them */
105 IF term(j) > term(j + 1) THEN DO;
106 t = term(j); term(j) = term(j + 1); term(j + 1) = t;
107 b = type(j); type(j) = type(j + 1); type(j + 1) = b;
108 sorted = $false;
109 END;
110 /* erase duplicate terms and give minterm priority */
111 ELSE IF term(j) = term(j + 1) THEN DO;
112 type(j) = (type(j) | type(j + 1));
113 term(j + 1) = term(num_terms);
114 type(j + 1) = type(num_terms);
115 num_terms = num_terms - 1;
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 3
116 excess_terms = $true;
117 END;
118 END;
119 END;
120 END;
121
122 /* now extract sorted terms back into ordered minterm & dont-care arrays */
123 num_minterms = 0; num_dont_cares = 0;
124 DO t = 1 TO num_terms;
125 IF type(t) THEN DO;
126 num_minterms = num_minterms + 1;
127 minterm(num_minterms) = term(t);
128 END;
129 ELSE DO;
130 num_dont_cares = num_dont_cares + 1;
131 dont_care(num_dont_cares) = term(t);
132 END;
133 END;
134 END sort_data;
135
136
137 /*
138 ###############################################################################
139 # INPUT PROCEDURES #
140 ###############################################################################
141 */
142
143
144 /******************************************************************************
145 * PROCEDURE menu_selection: Returns menu item requested: 1 - 5 *
146 *******************************************************************************/
147 menu_selection: PROCEDURE RETURNS (FIXED BINARY);
148 DECLARE menu_item CHARACTER (30) VARYING, m FIXED BINARY;
149 DO WHILE ($true);
150 GET EDIT (menu_item) (A);
151 IF VERIFY(menu_item, '12345') = 0 THEN DO;
152 m = BINARY(menu_item);
153 IF m >= 1 & m <= 5 THEN RETURN (m);
154 END;
155 END;
156 END menu_selection;
157
158
159 /******************************************************************************
160 * PROCEDURE continue_prompt: Stops screen scrolling *
161 *******************************************************************************/
162 continue_prompt: PROCEDURE;
163 PUT SKIP(2) LIST ('Press RETURN to continue -->');
164 GET EDIT (continue) (A);
165 END continue_prompt;
166
167
168 /******************************************************************************
169 * PROCEDURE enter_data: Used to enter minterms and don't cares *
170 *******************************************************************************/
171 enter_data: PROCEDURE;
172 DECLARE action CHARACTER (30) VARYING, deleted BIT ALIGNED, (i, t) FIXED BINARY;
173
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 4
174 get_input_list: PROCEDURE;
175 DECLARE (upper, lower) FIXED BINARY,
176 input_item CHARACTER (30) VARYING,
177 illegal_entry BIT ALIGNED;
178
179 num_terms = 0;
180 illegal_entry = $false;
181 PUT EDIT ('Enter values in the range 0 to 255 seperated by commas or blanks or return
s. ',
182 'A range of values may be entered using a hyphen, e.g. 10-15. ',
183 'Type E after the last entry. ',
184 '--> ') (SKIP, A);
185 DO WHILE ($true);
186 GET EDIT (input_item) (A);
187 IF TRANSLATE(input_item, 'E', 'e') = 'E' THEN RETURN;
188 ELSE IF VERIFY(input_item, '-0123456789') = 0 & INDEX(input_item, '-') ^= 1 THEN
DO;
189 t = INDEX(input_item, '-');
190 IF t = 0 THEN DO;
191 IF num_terms <= 255 THEN DO;
192 num_terms = num_terms + 1;
193 term(num_terms) = BINARY(input_item);
194 END;
195 END;
196 ELSE IF t <= 5 & LENGTH(input_item) - t < 5 THEN DO;
197 upper = BINARY(SUBSTR(input_item,t + 1)); IF upper > 255 THEN upper =
255;
198 lower = BINARY(SUBSTR(input_item, 1,t - 1)); IF lower > 255 THEN lower
= 255;
199 IF lower > upper THEN DO; t = lower; lower = upper; upper = t; END;
200 DO t = lower TO upper WHILE (num_terms <= 255);
201 num_terms = num_terms + 1;
202 term(num_terms) = t;
203 END;
204 END;
205 END;
206 ELSE illegal_entry = $true;
207 END;
208 IF illegal_entry THEN PUT SKIP LIST ('Illegal entries have been disregarded. ');
209 END get_input_list;
210
211 DO WHILE ($true);
212 PUT SKIP(3);
213 CALL sort_data;
214 CALL print_header_message(SYSPRINT);
215 CALL print_input_data(SYSPRINT);
216 PUT SKIP(3) EDIT ('C = Clear data',
217 'AM = Add Minterms',
218 'DM = Delete Minterms',
219 'AD = Add Don''t cares',
220 'DD = Delete Don''t cares',
221 'E = End data entry',
222 'Enter C/AM/DM/AD/DD/E --> ') (6(COLUMN(24),A,SKIP),SKIP,COLUMN(24)
,A);
223 action = ' ';
224 DO WHILE (VERIFY(action,'ACDEM') ^= 0);
225 GET EDIT (action) (A);
226 action = TRANSLATE(action, 'ACDEM', 'acdem');
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 5
227 END;
228 IF action = 'E' THEN RETURN;
229 IF action = 'C' THEN DO;
230 num_minterms = 0; num_dont_cares = 0;
231 END;
232 IF action = 'AM' | action = 'DM' | action = 'AD' | action = 'DD' THEN DO;
233 CALL get_input_list;
234 IF action = 'AM' THEN DO; /* add input list to minterms */
235 DO t = 1 TO num_terms;
236 minterm(num_minterms + t) = term(t);
237 END;
238 num_minterms = num_minterms + num_terms;
239 END;
240 ELSE IF action = 'DM' THEN DO; /* make minterms contained in i/p list out of range fo
r deletion */
241 DO t = 1 TO num_terms;
242 deleted = $false;
243 DO i = 1 TO num_minterms WHILE (^ deleted);
244 IF minterm(i) = term(t) THEN DO;
245 minterm(i) = -1;
246 deleted = $true;
247 END;
248 END;
249 END;
250 END;
251 ELSE IF action = 'AD' THEN DO; /* add input list to dont-cares */
252 DO t = 1 TO num_terms;
253 dont_care(num_dont_cares + t) = term(t);
254 END;
255 num_dont_cares = num_dont_cares + num_terms;
256 END;
257 ELSE DO; /* make dont-cares contained in i/p list out of range for deletion when sort
ed */
258 DO t = 1 TO num_terms;
259 deleted = $false;
260 DO i = 1 TO num_dont_cares WHILE (^ deleted);
261 IF dont_care(i) = term(t) THEN DO;
262 dont_care(i) = -1;
263 deleted = $true;
264 END;
265 END;
266 END;
267 END;
268 IF num_terms > 0 THEN new_data = $true;
269 END;
270 END;
271 END enter_data;
272
273
274 /*
275 ###############################################################################
276 # MINIMISATION PROCEDURES #
277 ###############################################################################
278 */
279
280
281 /******************************************************************************
282 * PROCEDURE prime_implicants: Generates complete list of PIs *
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 6
283 *******************************************************************************/
284 prime_implicants: PROCEDURE;
285
286 DECLARE (i, j, term_i, term_j, i_eqv_j, vertex, p, m) FIXED BINARY,
287 (all_vertices_contained, covered) BIT ALIGNED;
288
289 /* generate the prime implicants */
290 num_pis = 0;
291 DO i = 1 TO num_terms;
292 DO j = num_terms TO i BY -1;
293 /* choose the pair (i,j) */
294 term_i = term(i); term_j = term(j);
295 /* is (i,j) a cell? */
296 IF (term_i & term_j) = term_i THEN DO;
297 /* are all the vertices of (i,j) in the function? */
298 i_eqv_j = equivalent(term_i, term_j);
299 all_vertices_contained = $true; m = i + 1;
300 DO vertex = term_i + 1 TO term_j - 1 WHILE (all_vertices_contained);
301 IF (i_eqv_j & vertex) = term_i THEN DO;
302 DO WHILE (term(m) < vertex); m = m + 1; END;
303 all_vertices_contained = (term(m) = vertex);
304 m = m + 1;
305 END;
306 END;
307 IF all_vertices_contained THEN DO;
308 /* is (i,j) covered by an entry in the p.i. table? */
309 covered = $false;
310 IF num_pis ^= 0 THEN DO p = 1 TO num_pis WHILE (^ covered);
311 IF term_j <= p_i($high,p) THEN
312 IF (p_i($low,p) & term_i) = p_i($low,p) THEN
313 covered = ((term_j & p_i($high,p)) = term_j);
314 END;
315 IF ^ covered THEN DO;
316 num_pis = num_pis + 1;
317 p_i($low,num_pis) = term_i;
318 p_i($high,num_pis) = term_j;
319 END;
320 END;
321 END;
322 END;
323 END;
324
325 END prime_implicants;
326
327
328 /******************************************************************************
329 * PROCEDURE p_i_chart: Makes a PI chart as a bit array *
330 *******************************************************************************/
331 p_i_chart: PROCEDURE;
332 DECLARE (m, p) FIXED BINARY;
333 /* generate the prime implicant chart */
334 DO m = 1 TO num_minterms;
335 DO p = 1 TO num_pis;
336 pi_covers_minterm(p,m) = ((p_i($low,p) & minterm(m)) = p_i($low, p)
337 & (minterm(m) & p_i($high,p)) = minterm(m));
338 END;
339 END;
340 END p_i_chart;
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 7
341
342
343 /******************************************************************************
344 * PROCEDURE p_i_status: Categorises PIs as essential/nonessential/redundant *
345 *******************************************************************************/
346 p_i_status: PROCEDURE;
347 DECLARE (m, p, epi, num_covers) FIXED BINARY;
348
349 /* initialise all p.i. status to redundant */
350 DO p = 1 TO num_pis; p_i($status,p) = $redundant; END;
351 /* find essential p.i.s */
352 DO m = 1 TO num_minterms;
353 num_covers = 0;
354 DO p = 1 TO num_pis;
355 IF pi_covers_minterm(p,m) THEN DO;
356 epi = p;
357 num_covers = num_covers + 1;
358 END;
359 END;
360 IF num_covers = 1 THEN p_i($status, epi) = $essential;
361 END;
362 /* find minterms covered by essential p.i.s */
363 num_covers = 0;
364 DO m = 1 TO num_minterms;
365 epi_covers_minterm(m) = $false;
366 DO p = 1 TO num_pis WHILE (^ epi_covers_minterm(m));
367 IF p_i($status,p) = $essential & pi_covers_minterm(p,m) THEN DO;
368 epi_covers_minterm(m) = $true;
369 num_covers = num_covers + 1;
370 END;
371 END;
372 END;
373 /* determine whether 1 solution or more */
374 unique_solution = (num_covers = num_minterms);
375 /* find non-essential p.i.s */
376 IF ^ unique_solution THEN DO;
377 DO m = 1 TO num_minterms;
378 IF ^ epi_covers_minterm(m) THEN DO p = 1 TO num_pis;
379 IF p_i($status,p) = $redundant & pi_covers_minterm(p,m) THEN p_i($status,p) = $n
on_essential;
380 END;
381 END;
382 /* make a table of n.e.p.i. pointers */
383 num_ne_pis = 0;
384 DO p = 1 TO num_pis;
385 IF p_i($status,p) = $non_essential THEN DO;
386 num_ne_pis = num_ne_pis + 1; ne_pi(num_ne_pis) = p;
387 END;
388 END;
389 END;
390
391 END p_i_status;
392
393
394 /******************************************************************************
395 * PROCEDURE p_i_cost: Calculates literal costs of PIs *
396 *******************************************************************************/
397 p_i_cost: PROCEDURE;
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 8
398 DECLARE (p, l, b, literals) FIXED BINARY;
399 DO p = 1 TO num_pis;
400 p_i($cost,p) = 0; b = 1;
401 literals = equivalent(p_i($low,p),p_i($high,p));
402 DO l = 1 TO function_order;
403 IF (b & literals) ^= 0 THEN p_i($cost,p) = p_i($cost,p) + 1;
404 b = b + b;
405 END;
406 END;
407 END p_i_cost;
408
409
410 /******************************************************************************
411 * PROCEDURE irredundand_nepi_sums: Performs algebraic conversion of *
412 * nonessential PI product-of-sums to *
413 * sum-of-products *
414 *******************************************************************************/
415 irredundant_nepi_sums: PROCEDURE;
416 DECLARE (m, p, c, s, num_umin_nepis) FIXED BINARY,
417 (b, umin_nepis(256)) BIT (96) ALIGNED,
418 redundant_sums BIT ALIGNED;
419
420 /* make an array of bit strings holding non-ess p.i. coverage of uncovered minterms */
421 num_umin_nepis = 0;
422 DO m = 1 TO num_minterms;
423 IF ^ epi_covers_minterm(m) THEN DO;
424 num_umin_nepis = num_umin_nepis + 1;
425 umin_nepis(num_umin_nepis) = 0;
426 b = BIT(0,95) || '1'B;
427 DO p = 1 TO num_ne_pis;
428 IF pi_covers_minterm(ne_pi(p),m) THEN
429 umin_nepis(num_umin_nepis) = umin_nepis(num_umin_nepis) | b;
430 b = SUBSTR(b, 2);
431 END;
432 END;
433 END;
434
435 /* first pass - i.n.e.p.i. sums are those covering 1st uncovered minterm */
436 num_inepi_sums = 0; b = BIT(0,95) || '1'B;
437 DO p = 1 TO num_ne_pis;
438 /* if 1st uncovered minterm is covered by this n.e.p.i. then ... */
439 IF (umin_nepis(1) & b) ^= BIT(0,96) THEN DO;
440 /* ... this sum is initially this n.e-p.i. */
441 num_inepi_sums = num_inepi_sums + 1; inepi_sum(num_inepi_sums) = b;
442 END;
443 b = SUBSTR(b, 2);
444 END;
445
446 /* continue by repeatediy combining with n.e.p.i. terms of succeeding minterms algebraically */
447 DO m = 2 TO num_umin_nepis;
448 /* initialise cover counter and n.e.p.i. pointer */
449 c = -1; b = BIT(0,95) || '1'B;
450 /* add each n.e.p.i. covering this minterm successively to each sum */
451 DO p = 1 TO num_ne_pis;
452 /* if this n.e.p.i. covers this minterm then ... */
453 IF (umin_nepis(m) & b) ^= BIT(0, 96) THEN DO;
454 /* ... increment cover counter for this minterm ... */
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 9
455 c = c + 1;
456 /* ... step through the sums for this cover ... */
457 DO s = c * num_inepi_sums + 1 TO (c + 1) * num_inepi_sums;
458 /* ... make a copy of current sums for next cover ... */
459 inepi_sum(s + num_inepi_sums) = inepi_sum(s);
460 /* ... add this cover to the sum */
461 inepi_sum(s) = inepi_sum(s) | b;
462 END;
463 END;
464 b = SUBSTR(b, 2);
465 END;
466 /* calculate the new number of sums resulting from above */
467 num_inepi_sums = (c + 1) * num_inepi_sums;
468 /* some sums may cover others so minimise by nulling redundant sums */
469 redundant_sums = $false;
470 DO s = 1 TO num_inepi_sums;
471 IF inepi_sum(s) ^= BIT(0,96) THEN DO c = 1 TO num_inepi_sums;
472 IF c ^= s & inepi_sum(c) ^= BIT(0,96) & (inepi_sum(s) & inepi_sum(c)) = inepi_sum(
s) THEN DO;
473 inepi_sum(c) = BIT(0, 96);
474 redundant_sums = $true;
475 END;
476 END;
477 END;
478 /* remove redundant sums and calculate the new number of sums Tesulting */
479 IF redundant_sums THEN CALL remove_redundant_sums;
480 END;
481
482 END irredundant_nepi_sums;
483
484
485 /******************************************************************************
486 * PROCEDURE minimum_cost_solution: Finds set of minimum literal cost *
487 * nonessential PI sums *
488 *******************************************************************************/
489 minimum_cost_solution: PROCEDURE;
490 DECLARE (s, min_cost, sum_cost(1000)) FIXED BINARY,
491 redundant_sums BIT ALIGNED;
492
493 /* make a table of irredundant n.e.p.i. literal costs */
494 DO s = 1 TO num_inepi_sums;
495 sum_cost(s) = nonessential_cost(s);
496 END;
497 /* find the minimum cost */
498 min_cost = sum_cost(1);
499 DO s = 2 TO num_inepi_sums;
500 IF sum_cost(s) < min_cost THEN min_cost = sum_cost(s);
501 END;
502 /* remove all but minimum cost sums */
503 DO s = 1 TO num_inepi_sums;
504 IF sum_cost(s) > min_cost THEN DO;
505 inepi_sum(s) = BIT(0, 96);
506 redundant_sums = $true;
507 END;
508 END;
509 IF redundant_sums THEN CALL remove_redundant_sums;
510
511 END minimum_cost_solution;
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 10
512
513
514 /******************************************************************************
515 * PROCEDURE ammend_p_i_status: Recategorises some nonessential PIs as *
516 * minimum cost essential/minimum cost redundant *
517 *******************************************************************************/
518 ammend_p_i_status: PROCEDURE;
519 DECLARE (ess_pis, red_pis, b) BIT (96) ALIGNED,
520 s FIXED BINARY;
521
522 /* find n.e.p.i.s common to each sum and those which have been removed */
523 ess_pis = inepi_sum(1);
524 red_pis = ^ ess_pis;
525 DO s = 2 TO num_inepi_sums;
526 ess_pis = ess_pis & inepi_sum(s);
527 red_pis = red_pis & ^ inepi_sum(s);
528 END;
529 /* remove common n.e.p.i.s from the sums - these are minimum-cost essential */
530 DO s = 1 TO num_inepi_sums;
531 inepi_sum(s) = inepi_sum(s) & ^ ess_pis;
532 END;
533 /* ammend p.i. status table to show minimum-cost essential/redundant p.i.s */
534 b = BIT(0,95) || '1'B;
535 DO s = 1 TO num_ne_pis;
536 IF (ess_pis & b) ^= BIT(0,96) THEN p_i($status,ne_pi(s)) = $min_cost_essential;
537 ELSE IF (red_pis & b) ^= BIT(0,96) THEN p_i($status, ne_pi(s)) = $min_cost_redundant;
538 b = SUBSTR(b,2);
539 END;
540
541 END ammend_p_i_status;
542
543
544 /******************************************************************************
545 * PROCEDURE remove_redundant_sums: Cleans up irredundant nonessential PI *
546 * sum-of-products array *
547 *******************************************************************************/
548 remove_redundant_sums: PROCEDURE;
549 DECLARE (i, j) FIXED BINARY, sum_moved BIT ALIGNED;
550
551 DO i = 1 TO num_inepi_sums;
552 IF inepi_sum(i) = BIT(0,96) THEN DO;
553 sum_moved = $false;
554 DO j = i + 1 TO num_inepi_sums WHILE (^ sum_moved);
555 IF inepi_sum(j) ^= BIT(0,96) THEN DO;
556 inepi_sum(i) = inepi_sum(j); inepi_sum(j) = BIT(0, 96);
557 sum_moved = $true;
558 END;
559 END;
560 IF ^ sum_moved THEN DO;
561 num_inepi_sums = i - 1;
562 RETURN;
563 END;
564 END;
565 END;
566
567 END remove_redundant_sums;
568
569
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 11
570 /******************************************************************************
571 * PROCEDURE essential_cost: Returns literal cost of all essential PIs *
572 *******************************************************************************/
573 essential_cost: PROCEDURE RETURNS (FIXED BINARY);
574 DECLARE (p, e_cost) FIXED BINARY;
575 e_cost = 0;
576 DO p = 1 TO num_pis;
577 IF p_i($status,p) > $non_essential THEN e_cost = e_cost + p_i($cost,p);
578 END;
579 RETURN (e_cost);
580 END essential_cost;
581
582
583 /******************************************************************************
584 * PROCEDURE nonessential_cost: Returns literal cost of all nonessential PIs *
585 * in specified sum-of-product sum *
586 *******************************************************************************/
587 nonessential_cost: PROCEDURE (s) RETURNS (FIXED BINARY);
588 DECLARE (s, p, ne_cost) FIXED BINARY,
589 b BIT (96) ALIGNED;
590 ne_cost = 0; b = BIT(0,95) || '1'B;
591 DO p = 1 TO num_ne_pis;
592 IF (inepi_sum(s) & b) ^= BIT(0,96) THEN ne_cost = ne_cost + p_i($cost,ne_pi(p));
593 b = SUBSTR(b, 2);
594 END;
595 RETURN (ne_cost);
596 END nonessential_cost;
597
598
599 /******************************************************************************
600 * PROCEDURE run_minimisation: Performs minimisation of switching function *
601 *******************************************************************************/
602 run_minimisation: PROCEDURE;
603 function_order = LOG2(term(num_terms)) + 1;
604 PUT SKIP LIST ('(finding prime implicants)');
605 CALL prime_implicants; /* generates complete set of prime implicants */
606 CALL p_i_chart; /* generates array of pi coverage of minterms */
607 CALL p_i_status; /* gives ess/noness/red status to p.i.s & e.p.i. cover status to minterms & de
cides if unique */
608 CALL p_i_cost; /* finds literal costs of p.i.s */
609 IF ^ unique_solution THEN DO;
610 PUT SKIP LIST ('(finding minimum cost solution)');
611 CALL irredundant_nepi_sums; /* generate irredundant n.e.p.i. sums to cover remaining minte
rms */
612 CALL minimum_cost_solution; /* finds lowest literal cost solutions from irredundant n.e.p.
i. sums */
613 CALL ammend_p_i_status; /* gives min-cost-ess/min-cost-red status to n.e.p.i.s */
614 END;
615 solution_cost = essential_cost();
616 IF ^ unique_solution THEN solution_cost = solution_cost + nonessential_cost(1);
617 END run_minimisation;
618
619
620 /*
621 ###############################################################################
622 # OUTPUT PROCEDURES #
623 ###############################################################################
624 */
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 12
625
626
627 /******************************************************************************
628 * PROCEDURE print_header_message: Prints title and version no to screen/file *
629 *******************************************************************************/
630 print_header_message: PROCEDURE (f);
631 DECLARE f FILE VARIABLE;
632 PUT FILE (f) EDIT ('BOOLEAN MINIMISATION ', version, COPY('=',26))
633 (COLUMN(20),A,A,SKIP,COLUMN(20),A);
634 END print_header_message;
635
636
637 /******************************************************************************
638 * PROCEDURE print_menu: Prints programme menu *
639 *******************************************************************************/
640 print_menu: PROCEDURE;
641 CALL print_header_message(SYSPRINT);
642 PUT SKIP(3) LIST (' A utility for the logical minimisation of boolean functions.');
643 PUT SKIP(4) EDIT ('Menu',
644 '----',
645 '1. Enter data',
646 '2. Minimise',
647 '3. File results',
648 '4. Information',
649 '5. Quit',
650 'Enter 1-5 --> ')
651 (COLUMN(28),A,SKIP,COLUMN(28),A,SKIP(2),5(COLUMN(24),A,SKIP),SKIP,COLUMN(24),A);
652 END print_menu;
653
654
655 /******************************************************************************
656 * PROCEDURE print_input_data: Prints minterms and don't cares to screen/file *
657 *******************************************************************************/
658 print_input_data: PROCEDURE (f);
659 DECLARE f FILE VARIABLE, t FIXED BINARY;
660 /* list the minterms */
661 PUT FILE(f) SKIP(3) LIST ('Minterms:');
662 IF num_minterms = 0 THEN PUT FILE(f) SKIP LIST ('*** none ***');
663 ELSE PUT FILE(f) SKIP EDIT ((trim(minterm(t)) DO t = 1 TO num_minterms)) (A,X(1));
664 /* list the dont-cares */
665 PUT FILE(f) SKIP(3) LIST ('Don''t cares:');
666 IF num_dont_cares = 0 THEN PUT FILE(f) SKIP LIST ('*** none ***');
667 ELSE PUT FILE(f) SKIP EDIT ((trim(dont_care(t)) DO t = 1 TO num_dont_cares)) (A, X(1));
668 END print_input_data;
669
670
671 /******************************************************************************
672 * PROCEDURE output_results: Prints minimisation results to screen/file *
673 *******************************************************************************/
674 output_results: PROCEDURE (f);
675 DECLARE f FILE VARIABLE;
676
677 /* print header message */
678 CALL print_header_message(f);
679
680 /* list minterms and dont-cares */
681 CALL print_input_data(f);
682
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 13
683 /* print the function order */
684 PUT FILE(f) SKIP(3) EDIT ('The function order is ',trim(function_order)) (A);
685
686 /* list the prime implicants and associated qualities */
687 cell: PROCEDURE (p) RETURNS (CHARACTER (10) VARYING);
688 DECLARE p FIXED BINARY;
689 RETURN (trim(p_i($low,p)) || ',' || trim(p_i($high, p)));
690 END cell;
691 literals: PROCEDURE (p) RETURNS (CHARACTER (10) VARYING);
692 DECLARE (p, l, b) FIXED BINARY, lits CHARACTER (10) VARYING;
693 lits = ''; b = 1;
694 DO l = 1 TO function_order;
695 IF (equivalent(p_i($low,p),p_i($high,p)) & b) ^= 0 THEN
696 IF (p_i($low,p) & b) ^= 0 THEN lits = '1' || lits;
697 ELSE lits = '0' || lits;
698 ELSE lits = '-' || lits;
699 b = b + b;
700 END;
701 RETURN (lits);
702 END literals;
703 BEGIN;
704 DECLARE p FIXED BINARY;
705 PUT FILE(f) SKIP(3) LIST ('Prime Implicants:');
706 PUT FILE(f) SKIP EDIT (' p.i.','cell','literals','cost','status')
707 (A,COLUMN(11),A,COLUMN(25),A,COLUMN(40),A,COLUMN(50),A);
708 DO p = 1 TO num_pis;
709 PUT FILE(f) SKIP EDIT (p,cell(p),literals(p),p_i($cost,p),pi_status(p_i($status,p)))
710 (F(4),COLUMN(11),A,COLUMN(25),A,COLUMN(40),F(3),COLUMN(50),A);
711 END;
712 END;
713
714 /* abort if no minterms */
715 IF num_minterms = 0 THEN RETURN;
716
717 /* print the prime implicant chart */
718 tick: PROCEDURE (b) RETURNS (CHARACTER);
719 DECLARE b BIT ALIGNED;
720 IF b THEN RETURN ('*');
721 RETURN (' ');
722 END tick;
723 BEGIN;
724 DECLARE (m, b, p, num_blocks, mins_per_block) FIXED BINARY;
725 PUT FILE(f) SKIP(3) LIST ('Prime Implicant Chart:');
726 num_blocks = CEIL(DECIMAL(num_minterms) / 19.0);
727 mins_per_block = CEIL(DECIMAL(num_minterms) / DECIMAL(num_blocks));
728 DO b = 1 TO num_blocks;
729 PUT FILE(f) SKIP LIST (' minterm -->');
730 PUT FILE(f) SKIP EDIT
731 (' p.i.',(minterm(m)
732 DO m = (b-1)*mins_per_block+1 TO MIN(num_minterms,b*mins_per_block))) (A,F(3),18
(F(4)));
733 DO p = 1 TO num_pis;
734 IF p_i($status,p) > $redundant THEN PUT FILE(f) SKIP EDIT
735 (p, (tick(pi_covers_minterm(p,m))
736 DO m = (b-1)*mins_per_block+1 TO MIN(num_minterms,b*mins_per_block))) (F(4)
,19(X(3),A));
737 END;
738 END;
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 14
739 END;
740
741 /* print the solution */
742 BEGIN;
743 DECLARE (p, s) FIXED BINARY, or CHARACTER (2) VARYING, all_covered BIT ALIGNED, b BIT (96)
ALIGNED;
744 IF unique_solution THEN PUT FILE(f) SKIP(3) LIST ('Unique Solution:');
745 ELSE PUT FILE(f) SKIP(3) LIST ('Minimum Cost Solution:');
746 PUT FILE(f) SKIP EDIT (' F = ') (A);
747 /* essentials first */
748 or = '';
749 DO p = 1 TO num_pis;
750 IF p_i($status,p) > $non_essential THEN DO;
751 PUT FILE(f) EDIT (or, trim(p)) (A);
752 or = '+';
753 END;
754 END;
755 /* if these do not cover all minterms then ... */
756 all_covered = $true;
757 IF ^ unique_solution THEN DO s = 1 TO num_minterms WHILE (all_covered);
758 all_covered = $false;
759 DO p = 1 TO num_pis WHILE (^ all_covered);
760 IF p_i($status,p) > $non_essential THEN
761 all_covered = pi_covers_minterm(p,s);
762 END;
763 END;
764 /* ... minimum cost nonessentials */
765 IF ^ all_covered THEN DO;
766 PUT FILE(f) EDIT (or) (A);
767 DO s = 1 TO num_inepi_sums;
768 PUT FILE(f) EDIT ('(') (A);
769 or = ''; b = BIT(0,95) || '1'B;
770 DO p = 1 TO num_ne_pis;
771 IF (inepi_sum(s) & b) ^= BIT(0,96) THEN DO;
772 PUT FILE(f) EDIT (or,trim(ne_pi(p))) (A);
773 or = '+';
774 END;
775 b = SUBSTR(b,2);
776 END;
777 PUT FILE(f) EDIT (')') (A);
778 END;
779 PUT FILE(f) SKIP LIST ('(parenthesised expressions are alternatives)');
780 END;
781 END;
782
783 /* print the literal cost of the solution */
784 PUT FILE(f) SKIP(3) EDIT ('Cost = ',trim(solution_cost),' literals') (A);
785
786 END output_results;
787
788
789 /******************************************************************************
790 * PROCEDURE print information: Prints information about the pregramme *
791 *******************************************************************************/
792 print_information: PROCEDURE;
793 PUT SKIP(2) EDIT (
794 ' This utility determines the minimal 2-level solution for a Boolean switching',
795 'function. This function must be fully specified as minterm and don''t care',
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 15
796 'arrays. The maximum number of input variables is 8. Data is entered as decimal',
797 'values in the range 0 to 255 in any order. Ranges of values may be entered by',
798 'using a hyphen. e.g. 10-15. This data is sorted by the programme. If any value',
799 'is specified as both a minterm and a don''t care term then it is assumed to be',
800 'a minterm. Values which are out of range are ignored.',
801 ' Minimisation is done by first finding the prime implicants of the function',
802 'and then reducing the PI chart. Prime implicants are found by taking pairs of',
803 'terms (minterms or don''t cares) and testing to see if they form a cell. If they',
804 'do then a search is made to determine whether all the vertices of the cell are',
805 'either minterms or don''t cares. If so the cell is tested for containment by',
806 'any PI already found. If it is not contained then this cell is a PI. PI chart',
807 'reduction is done using the algebraic method after removing essential PIs and',
808 'the minterms they cover') (SKIP,A);
809 END print_information;
810
811
812 /*
813 ###############################################################################
814 # MAIN PROGRAMME #
815 ###############################################################################
816 */
817
818
819 /* initialisation */
820 num_minterms = 0; num_dont_cares = 0; num_terms = 0;
821 new_data = $true;
822
823 /* main loop */
824 DO WHILE ($true);
825 /* get menu selection */
826 menu:
827 PUT SKIP(3);
828 CALL print_menu;
829 GO TO menu_option(menu_selection());
830
831 menu_option(1): /* enter data */
832 CALL enter_data;
833 GO TO menu;
834
835 menu_option(2): /* minimise */
836 IF num_terms < 2 THEN
837 PUT SKIP LIST ('Insufficient data - cannot minimise.');
838 ELSE DO;
839 IF new_data THEN CALL run_minimisation;
840 PUT SKIP(2);
841 CALL output_results(SYSPRINT);
842 new_data = $false;
843 CALL continue_prompt;
844 END;
845 GO TO menu;
846
847 menu_option(3): /* file results */
848 IF ^ new_data THEN DO;
849 OPEN FILE(results_file) TITLE ('bool_min.txt') LINESIZE(80) STREAM OUTPUT PRINT;
850 CALL output_results(results_file);
851 PUT PAGE FILE(results_file);
852 CLOSE FILE(results_file);
853 PUT SKIP LIST ('Results appended to file BOOL_MIN.');
Aug 14, 2024 11:57 /*
1.3.1 Source Listing Page 16
854 END;
855 ELSE PUT SKIP LIST ('No results to file.');
856 GO TO menu;
857
858 menu_option(4): /* information */
859 CALL print_information;
860 CALL continue_prompt;
861 GO TO menu;
862
863 menu_option(5): /* quit */
864 STOP;
865 END;
866
867 END BSc_project;
Aug 14, 2024 11:57 /*
1.3.1 Procedure Map Page 17
Offset Line Statement type Offset Line Statement type Offset Line Statement type
08 11 PROCEDURE BSC_PROJECT
3A 39 DCL 3A 41 DCL
3F 56 PROCEDURE EQUIVALENT
56 58 RETURN B4 59 END
C4 65 PROCEDURE TRIM
D5 67 RETURN 01DA 68 END
01EA 75 PROCEDURE SORT_DATA
0200 79 DO 024B 80 Assignment 026D 81 Assignment
0279 82 END 0284 83 DO 02CF 84 Assignment
02FA 85 Assignment 030F 86 END 031A 87 Assignment
0331 90 Assignment 0335 91 DO 034B 92 Assignment
034F 92 Assignment 0353 93 DO 03AC 95 IF
03EF 95 DO 03EF 96 Assignment 0414 97 Assignment
042E 98 Assignment 043A 99 Assignment 043E 100 END
0444 101 Assignment 0448 102 DO 049B 103 IF
04B5 103 Assignment 04B9 105 IF 04E4 105 DO
04E4 106 Assignment 04F9 106 Assignment 051C 106 Assignment
0532 107 Assignment 0541 107 Assignment 0559 107 Assignment
0569 108 Assignment 056D 109 END 056D 111 ELSE
0572 111 IF 059D 111 DO 059D 112 Assignment
05C3 113 Assignment 05E9 114 Assignment 0604 115 Assignment
0610 116 Assignment 0614 117 END 0614 118 END
0625 119 END 0636 120 END 0641 123 Assignment
064A 123 Assignment 0653 124 DO 069E 125 IF
06B0 125 DO 06B0 126 Assignment 06BC 127 Assignment
06E1 128 END 06E1 129 ELSE 06E6 129 DO
06E6 130 Assignment 06F2 131 Assignment 0717 132 END
0717 133 END 0725 134 END
0735 147 PROCEDURE MENU_SELECTION
0750 149 DO 0766 150 GET 07E4 151 IF
0831 151 DO 0831 152 Assignment 0878 153 IF
0898 153 RETURN 08AA 154 END 08AA 155 END
08B2 156 END
08C2 162 PROCEDURE CONTINUE_PROMPT
08DE 163 PUT 0957 164 GET 09DB 165 END
09EB 171 PROCEDURE ENTER_DATA
0A07 174 PROCEDURE GET_INPUT_LIST
0A22 179 Assignment 0A2E 180 Assignment 0A32 181 PUT
0B37 185 DO 0B4D 186 GET 0BCB 187 IF
0CAC 187 RETURN 0CB1 188 ELSE 0CB6 188 IF
0D2A 188 DO 0D2A 189 Assignment 0D47 190 IF
0D57 190 DO 0D57 191 IF 0D6D 191 DO
0D6D 192 Assignment 0D7C 193 Assignment 0DD9 194 END
0DD9 195 END 0DD9 196 ELSE 0DDE 196 IF
0E07 196 DO 0E07 197 Assignment 0E89 197 IF
0E99 197 Assignment 0E9F 198 Assignment 0F0D 198 IF
0F1D 198 Assignment 0F23 199 IF 0F33 199 DO
0F33 199 Assignment 0F3E 199 Assignment 0F46 199 Assignment
Aug 14, 2024 11:57 /*
1.3.1 Procedure Map Page 18
0F51 199 END 0F51 200 DO 0FAE 201 Assignment
0FBD 202 Assignment 0FDE 203 END 0FE6 204 END
0FE9 205 END 0FE9 206 ELSE 0FF1 206 Assignment
0FFE 207 END 1006 208 IF 1010 208 PUT
1081 209 END 108C 211 DO 10A2 212 PUT
10FA 213 CALL 111D 214 CALL 1168 215 CALL
11B3 216 PUT 1344 223 Assignment 1354 224 DO
13A7 225 GET 1425 226 Assignment 14F0 227 END
14FB 228 IF 1539 228 RETURN 153E 229 IF
157C 229 DO 157C 230 Assignment 1585 230 Assignment
158E 231 END 158E 232 IF 168C 232 DO
168C 233 CALL 16AE 234 IF 16EC 234 DO
16EC 235 DO 1731 236 Assignment 175C 237 END
1764 238 Assignment 1778 239 END 1778 240 ELSE
177D 240 IF 17BB 240 DO 17BB 241 DO
1800 242 Assignment 1804 243 DO 1853 244 IF
187D 244 DO 187D 245 Assignment 1890 246 Assignment
1894 247 END 1894 248 END 189C 249 END
18A7 250 END 18A7 251 ELSE 18AC 251 IF
18EA 251 DO 18EA 252 DO 192F 253 Assignment
195A 254 END 1962 255 Assignment 1976 256 END
1976 257 ELSE 197B 257 DO 197B 258 DO
19C0 259 Assignment 19C4 260 DO 1A13 261 IF