Check-in [18752d1a53]
Not logged in
Overview
Comment:ParaSail_v_7_0_console_version initial entry
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 18752d1a5354d23481a74a759af2bcdc18b4dd7d
User & Date: martin_vahi on 2016-12-25 12:47:28
Other Links: manifest | tags
Context
2016-12-30 10:30
forking tools + Ada + ParaSail_v_7_0_cli check-in: 57261953a9 user: martin_vahi tags: trunk
2016-12-25 12:47
ParaSail_v_7_0_console_version initial entry check-in: 18752d1a53 user: martin_vahi tags: trunk
2016-12-09 01:33
LLVM download and compilation script bugfix check-in: e8076eeeca user: martin_vahi tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added work_in_progress/Ada_related_tools/gprbuild/gprbuild_2015.orig.tar.xz version [a3f9f005f4].

cannot compute difference between binary files

Modified work_in_progress/ParaSail_compiler_fork/COMMENTS.txt from [5517b06777] to [5b10f52787].


1
2

3
4
5
6













7
8
9
10
11
12






















Currently the content of the 


    ./ParaSail_v_7_0_console_version

is the same as the upstream zip-file is, with the 













exception that the 

    make clean

was run before check-in.





















>

<
>

|

<
>
>
>
>
>
>
>
>
>
>
>
>
>
|



|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
===========================================================================


The 

    ./forks/ParaSail_v_7_0_console_version


contains the fork release candidate source.
You may ignore the rest of this COMMENTS.txt file, 
unless You want to get to know the details of the 
contents of this folder.

---------------------------------------------------------------------------
                          Overview               
---------------------------------------------------------------------------

The content of the subfolders of  

    ./upstream_deliverables

contains unmodified upstream deliverables, with the exception that the 

    make clean

has been run before the check-in. The 

    ./forking_tools

contains scripts that copy the 

    ./upstream_deliverables/<something>

to 

    ./forks/<something>_console_version_<some suffix X1>

and they might also patch the 

    ./forks/<something>_console_version_<some suffix X1>

The patch scripts depend on Ruby, Bash, grep and 
other console tools. As of 2016 the scripts have been tested only on Linux.


===========================================================================

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/Makefile version [7f79b9b9c9].

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
# Makefile used at AdaCore to build ParaSail compiler/interpreter
# local installation ready to use
# You must run this Makefile from the top level source directory

# The OMP library is enabled from the command line as follows:
#   $ make OMP=on

# The behavior of gdb can be improved compiling without optimizations. This
# is the default; optimization can be turned on with from the command line
# using:
#   $ make DEBUG=off

ifeq ($(DEBUG),off)
  ADAFLAGS=-p -g -O2 -gnatn -gnata -gnatE -gnat95
else
  ADAFLAGS=-p -g -O0 -gnato -gnata -gnatE -gnat95
endif

# Turn off implicit rules
.SUFFIXES:

PROCS=0
RM=rm -rf

# default to not silent, can be set to true from command line
# used by pslc.csh so that users aren't confused by walls of text
SILENT=0
ifeq ($(SILENT),1)
   GPRBUILD=gprbuild -q -p
else
   GPRBUILD=gprbuild -p
endif

OBJS=
EXE=compiled_main.exe
OMPLIB=-lgomp
MATHLIB=-lm

ifeq ($(OMP),on)
  EXTRALIBS=$(OMPLIB)
else
  EXTRALIBS=
endif

# EXTRALIBS can be extended with additional libraries (if required)

COMPLIBS=$(MATHLIB)

.DELETE_ON_ERROR:

.PHONY: build all all_no_gtk local-install clean parasail parser 
.PHONY: sparkel sparkel_parser build_sparkel sparkel_doc
.PHONY: parasail_gtk build_no_gtk
.PHONY: javallel javallel_parser build_javallel
.PHONY: parython parython_gtk parython_parser build_parython build_parython_gtk
.PHONY: test_runtime
.PHONY: compiled_main compiled_main_with_interp
.PHONY: do_psltags do_atags

all: config build do_psltags do_atags doc build_sparkel build_javallel build_parython_gtk sparkel_doc test_runtime local-install

all_no_gtk: config build_no_gtk doc build_sparkel build_javallel build_parython sparkel_doc test_runtime local-install

config: semantics/psc-link_names.ads
	cd interpreter; ./config.sh $(OMP)

semantics/psc-link_names.ads : semantics/psc-link_names-common.ads
	cp semantics/psc-link_names-common.ads semantics/psc-link_names.ads

build: parser parasail check_compiled_main parasail_gtk

build_no_gtk: parser check_compiled_main parasail

build_sparkel: sparkel_parser sparkel

build_javallel: javallel_parser javallel

build_parython: parython_parser parython

build_parython_gtk: build_parython parython_gtk

do_atags : tags

tags : */*.ad?
	csh share/tools/vi_tags/do_atags.csh

do_psltags : lib/tags

lib/tags : lib/aaa.psi lib/reflection.ps? lib/llvm_printer.ps? lib/compiler.ps? lib/psvm_debugging.psl lib/parascope.ps? lib/vn_il.ps? lib/node_tree.ps?
	cd lib; ../share/tools/vi_tags/psltags aaa.psi reflection.ps? llvm_printer.ps? compiler.ps? psvm_debugging.psl parascope.ps? vn_il.ps? node_tree.ps?

doc:
	$(MAKE) -C documentation/ref_manual parasail_ref_manual.pdf

sparkel_doc:
	$(MAKE) -C documentation/sparkel_ref_manual sparkel_ref_manual.pdf

parser:
	$(MAKE) -C parser/build

sparkel_parser:
	$(MAKE) -C sparkel_parser/build

javallel_parser:
	$(MAKE) -C javallel_parser/build

parython_parser:
	$(MAKE) -C parython_parser/build

parasail: cleantestsuite
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/parasail -largs $(EXTRALIBS)

parasail_gtk: gtk_libs
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/parasail_gtk -largs $(EXTRALIBS)

sparkel: cleantestsuite
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/sparkel -largs $(EXTRALIBS)

javallel: cleantestsuite
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/javallel -largs $(EXTRALIBS)

parython: cleantestsuite
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/parython -largs $(EXTRALIBS)

parython_gtk: gtk_libs
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/parython_gtk -largs $(EXTRALIBS)

test_runtime:
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/test_runtime -largs $(EXTRALIBS)

gtk_libs:
	pkg-config gtk+-2.0 gthread-2.0 --libs > gtk_libs
	mkdir -p build/obj
	rm -f build/obj/gtk_libs
	cp gtk_libs build/obj/gtk_libs

check_compiled_main:
	$(GPRBUILD) -c -P build/compiled_main -largs $(COMPLIBS)
	$(GPRBUILD) -c $(ADAFLAGS) -P build/compiled_main_with_interp -largs $(COMPLIBS)

compiled_main:
	rm -f $(EXE)
	$(GPRBUILD) -P build/compiled_main -o $(EXE) -largs $(OBJS) $(COMPLIBS)

compiled_main_with_interp:
	rm -f $(EXE)
	$(GPRBUILD) $(ADAFLAGS) -P build/compiled_main_with_interp -o $(EXE) -largs $(OBJS) $(COMPLIBS)

local-install:
	$(RM) install/share/examples/parasail
	$(RM) install/share/doc/parasail
	$(RM) install/share/tools
	$(RM) install/bin
	$(RM) install/lib
	@mkdir -p install/bin
	@mkdir -p install/lib
	@mkdir -p install/lib/aaa
	@mkdir -p install/share
	@mkdir -p install/share/examples/parasail
	@mkdir -p install/share/doc/parasail
	@mkdir -p install/share/tools/parasail
	cp -p documentation/ref_manual/*.pdf install/share/doc/parasail
	cp -p documentation/parasail_release_notes*.txt install/share/doc/parasail
	cp -p documentation/*.pdf install/share/doc/parasail
	cp -p examples/*.ps? install/share/examples/parasail
	cp -p lib/*.ps? install/lib
	cp -p lib/aaa/*.ps?  install/lib/aaa
	cp -p bin/pslc.csh install/bin/pslc.csh
	cp -p bin/scope.csh install/bin/scope.csh
	-cp -p build/bin/parasail_main_gtk install/bin/psli
	cp -p build/bin/parasail_main install/bin/psli_no_gtk
	cp -pr share/tools/* install/share/tools/parasail
	$(RM) install/share/examples/sparkel
	$(RM) install/share/doc/sparkel
	@mkdir -p install/share/examples/sparkel
	@mkdir -p install/share/doc/sparkel
	@mkdir -p install/share/tools/sparkel
	cp -p documentation/sparkel_ref_manual/*.pdf install/share/doc/sparkel
	cp -p documentation/sparkel_release_notes*.txt install/share/doc/sparkel
	cp -p sparkel_examples/*.sk? install/share/examples/sparkel
	cp -p build/bin/sparkel_main install/bin/skli
	cp -p share/sparkel_tools/* install/share/tools/sparkel
	$(RM) install/share/examples/javallel
	$(RM) install/share/doc/javallel
	@mkdir -p install/share/examples/javallel
	@mkdir -p install/share/doc/javallel
	@mkdir -p install/share/tools/javallel
	cp -p javallel_examples/*.jl? install/share/examples/javallel
	cp -p build/bin/javallel_main install/bin/jlli
	$(RM) install/share/examples/parython
	$(RM) install/share/doc/parython
	@mkdir -p install/share/examples/parython
	@mkdir -p install/share/doc/parython
	@mkdir -p install/share/tools/parython
	-cp -p parython_examples/*.pr? install/share/examples/parython
	cp -p build/bin/parython_main install/bin/pryi
	-cp -p build/bin/parython_main_gtk install/bin/pryi_gtk
	-cp -p build/bin/test_runtime install/bin/test_runtime

cleantestsuite:
	cd testsuite/ParaSail; ../support/clean.sh
	cd testsuite/Sparkel;  ../support/clean.sh
	cd testsuite/Parython; ../support/clean.sh
	cd testsuite/Javallel; ../support/clean.sh

cleanconfig:
	-rm interpreter/psc-interpreter-locks.ads
	-rm interpreter/psc-interpreter-locks.adb

clean: cleanconfig
	-gnatclean -q -r -P build/parasail
	$(RM) install gtk_libs
	$(RM) build/bin build/obj
	$(MAKE) -C documentation/ref_manual clean
	$(MAKE) -C parser/build clean-all
	-gnatclean -q -r -P build/sparkel
	-gnatclean -q -r -P build/javallel
	-gnatclean -q -r -P build/parython
	-gnatclean -q -r -P build/test_runtime
	$(MAKE) -C documentation/sparkel_ref_manual clean
	$(MAKE) -C sparkel_parser/build clean
	$(MAKE) -C javallel_parser/build clean
	$(MAKE) -C parython_parser/build clean
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<












































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_linux/aaa.psi.o version [9afa9b23a3].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_linux/compiler.exe version [c23b6aa87e].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_linux/javallel_main version [ac33613ca2].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_linux/parasail_main version [635d83b0b7].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_linux/parython_main version [3e20627b2a].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_linux/sparkel_main version [b1a85649ac].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_mac/aaa.psi.o version [d885e3cf80].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_mac/compiler.exe version [23aabc7235].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_mac/javallel_main version [2064b900cd].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_mac/parasail_main version [ee8fbdc7a1].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_mac/parasail_main_gtk version [3ecfbd35be].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_mac/parython_main version [3fae25127b].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_mac/parython_main_gtk version [cb36f5592b].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/_mac/sparkel_main version [3720871770].

cannot compute difference between binary files

Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/COPYRIGHT version [c9cdfe89ee].

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
-- AUTHOR: John Self (UCI)
-- DESCRIPTION main subprogram of aflex, calls the major routines in order
--*************************************************************************** 
--                              aflex
--                          version 1.4a
--***************************************************************************
--
--                            Arcadia Project
--               Department of Information and Computer Science
--                        University of California
--                        Irvine, California 92717
--
--    Send requests for aflex information to alex-info@ics.uci.edu
--
--    Send bug reports for aflex to alex-bugs@ics.uci.edu
--
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
--    This program is based on the flex program written by Vern Paxson.
--
--    The following is the copyright notice from flex, from which aflex is
--    derived.
--	Copyright (c) 1989 The Regents of the University of California.
--	All rights reserved.
--
--	This code is derived from software contributed to Berkeley by
--	Vern Paxson.
--
--      The United States Government has rights in this work pursuant to
--	contract no. DE-AC03-76SF00098 between the United States Department of
--	Energy and the University of California.
--
--	Redistribution and use in source and binary forms are permitted
--	provided that the above copyright notice and this paragraph are
--	duplicated in all such forms and that any documentation,
--	advertising materials, and other materials related to such
--	distribution and use acknowledge that the software was developed
--	by the University of California, Berkeley.  The name of the
--	University may not be used to endorse or promote products derived
--	from this software without specific prior written permission.
--	THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
--	IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--	WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






















































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/GEN/aflex_parser.adb version [7fec5c6770].

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
pragma Warnings(Off);
pragma Style_Checks(Off);


package body Aflex_parser is
-- build_eof_action - build the "<<EOF>>" action for the active start
--                    conditions

use text_io, misc_defs;
procedure build_eof_action is
begin
    text_io.put( temp_action_file, "when " );
    for i in 1..actvp loop
	if ( sceof(actvsc(i)) ) then
	    text_io.put( Standard_Error,
		"multiple <<EOF>> rules for start condition ");
	    tstring.put( Standard_Error, scname(actvsc(i)));
	    main_body.aflexend(1);
	else
	    sceof(actvsc(i)) := true;
	    text_io.put( temp_action_file, "YY_END_OF_BUFFER +" );
	    tstring.put( temp_action_file,  scname(actvsc(i)) );
	    text_io.put_line( temp_action_file, " + 1 " );
	    if (i /= actvp) then
	        text_io.put_line( temp_action_file, " |" );
	    else
	        text_io.put_line( temp_action_file, " =>" );
	    end if;
        end if;
    end loop;
    misc.line_directive_out( temp_action_file );
end build_eof_action;

--  yyerror - eat up an error message from the parser
-- 
--  synopsis
--     char msg[];
--     yyerror( msg );

procedure yyerror( msg : string ) is
begin
null;
end yyerror;

use  Parse_Goto, Parse_Shift_Reduce, Text_IO, misc_defs, tstring;
procedure YYParse is

   -- Rename User Defined Packages to Internal Names.
    package yy_goto_tables         renames
      Parse_Goto;
    package yy_shift_reduce_tables renames
      Parse_Shift_Reduce;
    package yy_tokens              renames
      Parse_Tokens;

   use yy_tokens, yy_goto_tables, yy_shift_reduce_tables;

   procedure yyerrok;
   procedure yyclearin;


   package yy is

       -- the size of the value and state stacks
       stack_size : constant Natural := 300;

       -- subtype rule         is natural;
       subtype parse_state  is natural;
       -- subtype nonterminal  is integer;

       -- encryption constants
       default           : constant := -1;
       first_shift_entry : constant :=  0;
       accept_code       : constant := -1001;
       error_code        : constant := -1000;

       -- stack data used by the parser
       tos                : natural := 0;
       value_stack        : array(0..stack_size) of yy_tokens.yystype;
       state_stack        : array(0..stack_size) of parse_state;

       -- current input symbol and action the parser is on
       action             : integer;
       rule_id            : rule;
       input_symbol       : yy_tokens.token;


       -- error recovery flag
       error_flag : natural := 0;
          -- indicates  3 - (number of valid shifts after an error occurs)

       look_ahead : boolean := true;
       index      : integer;

       -- Is Debugging option on or off
        DEBUG : constant boolean := FALSE;

    end yy;


    function goto_state
      (state : yy.parse_state;
       sym   : nonterminal) return yy.parse_state;

    function parse_action
      (state : yy.parse_state;
       t     : yy_tokens.token) return integer;

    pragma inline(goto_state, parse_action);


    function goto_state(state : yy.parse_state;
                        sym   : nonterminal) return yy.parse_state is
        index : integer;
    begin
        index := goto_offset(state);
        while  integer(goto_matrix(index).nonterm) /= sym loop
            index := index + 1;
        end loop;
        return integer(goto_matrix(index).newstate);
    end goto_state;


    function parse_action(state : yy.parse_state;
                          t     : yy_tokens.token) return integer is
        index      : integer;
        tok_pos    : integer;
        default    : constant integer := -1;
    begin
        tok_pos := yy_tokens.token'pos(t);
        index   := shift_reduce_offset(state);
        while integer(shift_reduce_matrix(index).t) /= tok_pos and then
              integer(shift_reduce_matrix(index).t) /= default
        loop
            index := index + 1;
        end loop;
        return integer(shift_reduce_matrix(index).act);
    end parse_action;

-- error recovery stuff

    procedure handle_error is
      temp_action : integer;
    begin

      if yy.error_flag = 3 then -- no shift yet, clobber input.
      if yy.debug then
          text_io.put_line("Ayacc.YYParse: Error Recovery Clobbers " &
                   yy_tokens.token'image(yy.input_symbol));
      end if;
        if yy.input_symbol = yy_tokens.end_of_input then  -- don't discard,
        if yy.debug then
            text_io.put_line("Ayacc.YYParse: Can't discard END_OF_INPUT, quiting...");
        end if;
        raise yy_tokens.syntax_error;
        end if;

            yy.look_ahead := true;   -- get next token
        return;                  -- and try again...
    end if;

    if yy.error_flag = 0 then -- brand new error
        yyerror("Syntax Error");
    end if;

    yy.error_flag := 3;

    -- find state on stack where error is a valid shift --

    if yy.debug then
        text_io.put_line("Ayacc.YYParse: Looking for state with error as valid shift");
    end if;

    loop
        if yy.debug then
          text_io.put_line("Ayacc.YYParse: Examining State " &
               yy.parse_state'image(yy.state_stack(yy.tos)));
        end if;
        temp_action := parse_action(yy.state_stack(yy.tos), error);

            if temp_action >= yy.first_shift_entry then
                if yy.tos = yy.stack_size then
                    text_io.put_line(" Stack size exceeded on state_stack");
                    raise yy_Tokens.syntax_error;
                end if;
                yy.tos := yy.tos + 1;
                yy.state_stack(yy.tos) := temp_action;
                exit;
            end if;

        Decrement_Stack_Pointer :
        begin
          yy.tos := yy.tos - 1;
        exception
          when Constraint_Error =>
            yy.tos := 0;
        end Decrement_Stack_Pointer;

        if yy.tos = 0 then
          if yy.debug then
            text_io.put_line("Ayacc.YYParse: Error recovery popped entire stack, aborting...");
          end if;
          raise yy_tokens.syntax_error;
        end if;
    end loop;

    if yy.debug then
        text_io.put_line("Ayacc.YYParse: Shifted error token in state " &
              yy.parse_state'image(yy.state_stack(yy.tos)));
    end if;

    end handle_error;

   -- print debugging information for a shift operation
   procedure shift_debug(state_id: yy.parse_state; lexeme: yy_tokens.token) is
   begin
       text_io.put_line("Ayacc.YYParse: Shift "& yy.parse_state'image(state_id)&" on input symbol "&
               yy_tokens.token'image(lexeme) );
   end;

   -- print debugging information for a reduce operation
   procedure reduce_debug(rule_id: rule; state_id: yy.parse_state) is
   begin
       text_io.put_line("Ayacc.YYParse: Reduce by rule "&rule'image(rule_id)&" goto state "&
               yy.parse_state'image(state_id));
   end;

   -- make the parser believe that 3 valid shifts have occured.
   -- used for error recovery.
   procedure yyerrok is
   begin
       yy.error_flag := 0;
   end yyerrok;

   -- called to clear input symbol that caused an error.
   procedure yyclearin is
   begin
       -- yy.input_symbol := yylex;
       yy.look_ahead := true;
   end yyclearin;


begin
    -- initialize by pushing state 0 and getting the first input symbol
    yy.state_stack(yy.tos) := 0;


    loop

        yy.index := shift_reduce_offset(yy.state_stack(yy.tos));
        if integer(shift_reduce_matrix(yy.index).t) = yy.default then
            yy.action := integer(shift_reduce_matrix(yy.index).act);
        else
            if yy.look_ahead then
                yy.look_ahead   := false;

                yy.input_symbol := yylex;
            end if;
            yy.action :=
             parse_action(yy.state_stack(yy.tos), yy.input_symbol);
        end if;


        if yy.action >= yy.first_shift_entry then  -- SHIFT

            if yy.debug then
                shift_debug(yy.action, yy.input_symbol);
            end if;

            -- Enter new state
            if yy.tos = yy.stack_size then
                text_io.put_line(" Stack size exceeded on state_stack");
                raise yy_Tokens.syntax_error;
            end if;
            yy.tos := yy.tos + 1;
            yy.state_stack(yy.tos) := yy.action;
              yy.value_stack(yy.tos) := yylval;

        if yy.error_flag > 0 then  -- indicate a valid shift
            yy.error_flag := yy.error_flag - 1;
        end if;

            -- Advance lookahead
            yy.look_ahead := true;

        elsif yy.action = yy.error_code then       -- ERROR

            handle_error;

        elsif yy.action = yy.accept_code then
            if yy.debug then
                text_io.put_line("Ayacc.YYParse: Accepting Grammar...");
            end if;
            exit;

        else -- Reduce Action

            -- Convert action into a rule
            yy.rule_id  := -1 * yy.action;

            -- Execute User Action
            -- user_action(yy.rule_id);


                case yy.rule_id is

when  1 =>
--#line  44
 -- add default rule

			pat := ccl.cclinit;
			ccl.cclnegate( pat );

			def_rule := nfa.mkstate( -pat );

			nfa.finish_rule( def_rule, false, 0, 0 );

			for i in 1 .. lastsc loop
			    scset(i) := nfa.mkbranch( scset(i), def_rule );
			end loop;
			
			if ( spprdflt ) then
			    text_io.put(temp_action_file,
					"raise AFLEX_SCANNER_JAMMED;");
			else
			    text_io.put( temp_action_file, "ECHO" );

			text_io.put_line( temp_action_file, ";" );
			end if;
			

when  2 =>
--#line  69

			-- initialize for processing rules

       			-- create default DFA start condition
			sym.scinstal( tstring.vstr("INITIAL"), false );
			

when  5 =>
--#line  80
 misc.synerr( "unknown error processing section 1" );

when  7 =>
--#line  87

			 -- these productions are separate from the s1object
			 -- rule because the semantics must be done before
			 -- we parse the remainder of an s1object
			

			xcluflg := false;
			

when  8 =>
--#line  97
 xcluflg := true; 

when  9 =>
--#line  101
 sym.scinstal( nmstr, xcluflg ); 

when  10 =>
--#line  104
 sym.scinstal( nmstr, xcluflg ); 

when  11 =>
--#line  107
 misc.synerr( "bad start condition list" ); 

when  14 =>
--#line  115

			-- initialize for a parse of one rule
			trlcontxt := false;
			variable_trail_rule := false;
			varlength := false;
			trailcnt := 0;
			headcnt := 0;
			rulelen := 0;
			current_state_enum := STATE_NORMAL;
			previous_continued_action := continued_action;
			nfa.new_rule;
			

when  15 =>
--#line  130

			pat := nfa.link_machines( 
yy.value_stack(yy.tos-1), 
yy.value_stack(yy.tos) );
			nfa.finish_rule( pat, variable_trail_rule,
				     headcnt, trailcnt );

			for i in 1 .. actvp loop
			    scbol(actvsc(i)) :=
				nfa.mkbranch( scbol(actvsc(i)), pat );
			end loop;	
				
			if ( not bol_needed ) then
			    bol_needed := true;

			    if ( performance_report ) then
				text_io.put( Standard_Error,
			"'^' operator results in sub-optimal performance");
			        text_io.new_line(Standard_Error);
    	    	    	    end if;
			end if;
			

when  16 =>
--#line  152

			pat := nfa.link_machines( 
yy.value_stack(yy.tos-1), 
yy.value_stack(yy.tos) );
			nfa.finish_rule( pat, variable_trail_rule,
				     headcnt, trailcnt );

			for i in 1 .. actvp loop
			    scset(actvsc(i)) := 
				nfa.mkbranch( scset(actvsc(i)), pat );
			end loop;
		        

when  17 =>
--#line  163

			pat := nfa.link_machines( 
yy.value_stack(yy.tos-1), 
yy.value_stack(yy.tos) );
			nfa.finish_rule( pat, variable_trail_rule,
				     headcnt, trailcnt );

			-- add to all non-exclusive start conditions,
			-- including the default (0) start condition

			for i in 1 .. lastsc loop
			    if ( not scxclu(i) ) then
				scbol(i) := nfa.mkbranch( scbol(i), pat );
			    end if;	
			end loop;

			if ( not bol_needed ) then
			    bol_needed := true;

			    if ( performance_report ) then
				text_io.put( Standard_Error,
			"'^' operator results in sub-optimal performance");
			        text_io.new_line(Standard_Error);
			    end if;
			end if;
    	    	    	

when  18 =>
--#line  188

			pat := nfa.link_machines( 
yy.value_stack(yy.tos-1), 
yy.value_stack(yy.tos) );
			nfa.finish_rule( pat, variable_trail_rule,
				     headcnt, trailcnt );

			for i in 1 .. lastsc loop
			    if ( not scxclu(i) ) then
				scset(i) := nfa.mkbranch( scset(i), pat );
			    end if;
			end loop;
			

when  19 =>
--#line  201
 build_eof_action; 

when  20 =>
--#line  204

			-- this EOF applies only to the INITIAL start cond.
			actvp := 1;
			actvsc(actvp) := 1;
			build_eof_action;
			

when  21 =>
--#line  212
 misc.synerr( "unrecognized rule" ); 

when  23 =>
--#line  219

			scnum := sym.sclookup( nmstr );
			if (scnum = 0 ) then
		            text_io.put( Standard_Error,
					 "undeclared start condition ");
		            tstring.put( Standard_Error, nmstr );
			    main_body.aflexend( 1 );
			else
			  actvp := actvp + 1;
			    actvsc(actvp) := scnum;
			end if;
			

when  24 =>
--#line  233

			scnum := sym.sclookup( nmstr );
			if (scnum = 0 ) then
		            text_io.put( Standard_Error,
					"undeclared start condition ");
		            tstring.put( Standard_Error,	 nmstr );
			    main_body.aflexend ( 1 );
			else
			    actvp := 1;
			    actvsc(actvp) := scnum;
			end if;
			

when  25 =>
--#line  247
 misc.synerr( "bad start condition list" ); 

when  26 =>
--#line  251

			if trlcontxt then
			    misc.synerr( "trailing context used twice" );
			    
yyval := nfa.mkstate( SYM_EPSILON );
			else
			    trlcontxt := true;

			    if ( not varlength ) then
				headcnt := rulelen;
			    end if;

			    rulelen := rulelen + 1;
			    trailcnt := 1;

			    eps := nfa.mkstate( SYM_EPSILON );
			    
yyval := nfa.link_machines( eps,
					  nfa.mkstate( CHARACTER'POS(ASCII.LF) ) );
    	    	    	end if;
			

when  27 =>
--#line  272

		        
yyval := nfa.mkstate( SYM_EPSILON );

			if ( trlcontxt ) then
			    if ( varlength and (headcnt = 0) ) then
				-- both head and trail are variable-length
				variable_trail_rule := true;
			    else
				trailcnt := rulelen;
			    end if;
    	    	    	end if;
		        

when  28 =>
--#line  287

			varlength := true;

			
yyval := nfa.mkor( 
yy.value_stack(yy.tos-2), 
yy.value_stack(yy.tos) );
			

when  29 =>
--#line  294

			if ( transchar(lastst(
yy.value_stack(yy.tos))) /= SYM_EPSILON ) then
			    -- provide final transition \now/ so it
			    -- will be marked as a trailing context
			    -- state

			    
yy.value_stack(yy.tos) := nfa.link_machines( 
yy.value_stack(yy.tos), nfa.mkstate( SYM_EPSILON ) );
			end if;

			nfa.mark_beginning_as_normal( 
yy.value_stack(yy.tos) );
			current_state_enum := STATE_NORMAL;

			if ( previous_continued_action ) then
			    -- we need to treat this as variable trailing
			    -- context so that the backup does not happen
			    -- in the action but before the action switch
			    -- statement.  If the backup happens in the
			    -- action, then the rules "falling into" this
			    -- one's action will *also* do the backup,
			    -- erroneously.

			    	if ( (not varlength) or  headcnt /= 0 ) then
				     text_io.put( Standard_Error,
                              "alex: warning - trailing context rule at line");
                                     int_io.put(Standard_Error, linenum);
				     text_io.put( Standard_Error,
                           "made variable because of preceding '|' action" );
                                     int_io.put(Standard_Error, linenum);
    	    	    	    	end if;

			    -- mark as variable
			    varlength := true;
			    headcnt := 0;
    	    	    	end if;
			
			if ( varlength and (headcnt = 0) ) then
			    -- variable trailing context rule
			    -- mark the first part of the rule as the accepting
			    -- "head" part of a trailing context rule

			    -- by the way, we didn't do this at the beginning
			    -- of this production because back then
			    -- current_state_enum was set up for a trail
			    -- rule, and add_accept() can create a new
			    -- state ...

			    nfa.add_accept( 
yy.value_stack(yy.tos-1),
    	    	    	    	   misc.set_yy_trailing_head_mask(num_rules) );
    	    	    	end if;

			
yyval := nfa.link_machines( 
yy.value_stack(yy.tos-1), 
yy.value_stack(yy.tos) );
			

when  30 =>
--#line  348
 
yyval := 
yy.value_stack(yy.tos); 

when  31 =>
--#line  353

			-- this rule is separate from the others for "re" so
			-- that the reduction will occur before the trailing
			-- series is parsed

			if ( trlcontxt ) then
			    misc.synerr( "trailing context used twice" );
			else
			    trlcontxt := true;
			end if;    

			if ( varlength ) then
			    -- we hope the trailing context is fixed-length
			    varlength := false;
			else
			    headcnt := rulelen;
			end if;    

			rulelen := 0;

			current_state_enum := STATE_TRAILING_CONTEXT;
			
yyval := 
yy.value_stack(yy.tos-1);
			

when  32 =>
--#line  379

			-- this is where concatenation of adjacent patterns
			-- gets done

			
yyval := nfa.link_machines( 
yy.value_stack(yy.tos-1), 
yy.value_stack(yy.tos) );
			

when  33 =>
--#line  387
 
yyval := 
yy.value_stack(yy.tos); 

when  34 =>
--#line  391

			varlength := true;

			
yyval := nfa.mkclos( 
yy.value_stack(yy.tos-1) );
			

when  35 =>
--#line  398

			varlength := true;

			
yyval := nfa.mkposcl( 
yy.value_stack(yy.tos-1) );
			

when  36 =>
--#line  405

			varlength := true;

			
yyval := nfa.mkopt( 
yy.value_stack(yy.tos-1) );
			

when  37 =>
--#line  412

			varlength := true;

			if ( (
yy.value_stack(yy.tos-3) > 
yy.value_stack(yy.tos-1)) or (
yy.value_stack(yy.tos-3) < 0) ) then
			    misc.synerr( "bad iteration values" );
			    
yyval := 
yy.value_stack(yy.tos-5);
			else
			    if ( 
yy.value_stack(yy.tos-3) = 0 ) then
				
yyval := nfa.mkopt( nfa.mkrep( 
yy.value_stack(yy.tos-5), 
yy.value_stack(yy.tos-3), 
yy.value_stack(yy.tos-1) ) );
			    else
				
yyval := nfa.mkrep( 
yy.value_stack(yy.tos-5), 
yy.value_stack(yy.tos-3), 
yy.value_stack(yy.tos-1) );
			    end if;
    	    	    	end if;
			

when  38 =>
--#line  428

			varlength := true;

			if ( 
yy.value_stack(yy.tos-2) <= 0 ) then
			    misc.synerr( "iteration value must be positive" );
			    
yyval := 
yy.value_stack(yy.tos-4);
			else
			    
yyval := nfa.mkrep( 
yy.value_stack(yy.tos-4), 
yy.value_stack(yy.tos-2), INFINITY );
			end if;    
			

when  39 =>
--#line  440

			-- the singleton could be something like "(foo)",
			-- in which case we have no idea what its length
			-- is, so we punt here.

			varlength := true;

			if ( 
yy.value_stack(yy.tos-1) <= 0 ) then
			    misc.synerr( "iteration value must be positive" );
			    
yyval := 
yy.value_stack(yy.tos-3);
			else
			    
yyval := nfa.link_machines( 
yy.value_stack(yy.tos-3), nfa.copysingl( 
yy.value_stack(yy.tos-3), 
yy.value_stack(yy.tos-1) - 1 ) );
			end if;    
			

when  40 =>
--#line  456

			if ( not madeany ) then
			    -- create the '.' character class
			    anyccl := ccl.cclinit;
			    ccl.ccladd( anyccl, ASCII.LF );
			    ccl.cclnegate( anyccl );

			    if ( useecs ) then
				ecs.mkeccl(
		       ccltbl(cclmap(anyccl)..cclmap(anyccl) + ccllen(anyccl)),
					ccllen(anyccl), nextecm,
					ecgroup, CSIZE );
			    end if;
			    madeany := true;
    	    	    	end if;

			rulelen := rulelen + 1;

			
yyval := nfa.mkstate( -anyccl );
			

when  41 =>
--#line  478

			if ( not cclsorted ) then
			    -- sort characters for fast searching.  We use a
			    -- shell sort since this list could be large.

--			    misc.cshell( ccltbl + cclmap($1), ccllen($1) );
		      misc.cshell( ccltbl(cclmap(
yy.value_stack(yy.tos))..cclmap(
yy.value_stack(yy.tos)) + ccllen(
yy.value_stack(yy.tos))),
				   ccllen(
yy.value_stack(yy.tos)) );
			end if;

			if ( useecs ) then
		    ecs.mkeccl( ccltbl(cclmap(
yy.value_stack(yy.tos))..cclmap(
yy.value_stack(yy.tos)) + ccllen(
yy.value_stack(yy.tos))),
				ccllen(
yy.value_stack(yy.tos)),nextecm, ecgroup, CSIZE );
			end if;
				     
			rulelen := rulelen + 1;

			
yyval := nfa.mkstate( -
yy.value_stack(yy.tos) );
			

when  42 =>
--#line  499

			rulelen := rulelen + 1;

			
yyval := nfa.mkstate( -
yy.value_stack(yy.tos) );
			

when  43 =>
--#line  506
 
yyval := 
yy.value_stack(yy.tos-1); 

when  44 =>
--#line  509
 
yyval := 
yy.value_stack(yy.tos-1); 

when  45 =>
--#line  512

			rulelen := rulelen + 1;

			if ( 
yy.value_stack(yy.tos) = CHARACTER'POS(ASCII.NUL) ) then
			    misc.synerr( "null in rule" );
			end if;    

			if ( caseins and (
yy.value_stack(yy.tos) >= CHARACTER'POS('A')) and (
yy.value_stack(yy.tos) <= CHARACTER'POS('Z')) ) then
			    
yy.value_stack(yy.tos) := misc.clower( 
yy.value_stack(yy.tos) );
			end if;

			
yyval := nfa.mkstate( 
yy.value_stack(yy.tos) );
			

when  46 =>
--#line  528
 
yyval := 
yy.value_stack(yy.tos-1); 

when  47 =>
--#line  531

			-- *Sigh* - to be compatible Unix lex, negated ccls
			-- match newlines
			ccl.cclnegate( 
yy.value_stack(yy.tos-1) );
			
yyval := 
yy.value_stack(yy.tos-1);
			

when  48 =>
--#line  540

			if ( 
yy.value_stack(yy.tos-2) > 
yy.value_stack(yy.tos) ) then
			    misc.synerr( "negative range in character class" );
			else
			    if ( caseins ) then
				if ( (
yy.value_stack(yy.tos-2) >= CHARACTER'POS('A')) and (
yy.value_stack(yy.tos-2) <= CHARACTER'POS('Z')) ) then
				    
yy.value_stack(yy.tos-2) := misc.clower( 
yy.value_stack(yy.tos-2) );
				end if;					    
				if ( (
yy.value_stack(yy.tos) >= CHARACTER'POS('A')) and (
yy.value_stack(yy.tos) <= CHARACTER'POS('Z')) ) then
				    
yy.value_stack(yy.tos) := misc.clower( 
yy.value_stack(yy.tos) );
				end if;    
    	    	    	    end if;

			    for i in 
yy.value_stack(yy.tos-2) .. 
yy.value_stack(yy.tos) loop
			        ccl.ccladd( 
yy.value_stack(yy.tos-3), CHARACTER'VAL(i) );
    	    	    	    end loop;
			    
			    -- keep track if this ccl is staying in
			    -- alphabetical order

			    cclsorted := cclsorted and (
yy.value_stack(yy.tos-2) > lastchar);
			    lastchar := 
yy.value_stack(yy.tos);
    	    	    	end if;
			
			
yyval := 
yy.value_stack(yy.tos-3);
			

when  49 =>
--#line  568

			if ( caseins ) then
			    if ( (
yy.value_stack(yy.tos) >= CHARACTER'POS('A')) and (
yy.value_stack(yy.tos) <= CHARACTER'POS('Z')) ) then
				
yy.value_stack(yy.tos) := misc.clower( 
yy.value_stack(yy.tos) );
    	    	    	    end if;
			end if;    
			ccl.ccladd( 
yy.value_stack(yy.tos-1), CHARACTER'VAL(
yy.value_stack(yy.tos)) );
			cclsorted := cclsorted and (
yy.value_stack(yy.tos) > lastchar);
			lastchar := 
yy.value_stack(yy.tos);
			
yyval := 
yy.value_stack(yy.tos-1);
			

when  50 =>
--#line  581

			cclsorted := true;
			lastchar := 0;
			
yyval := ccl.cclinit;
			

when  51 =>
--#line  589

			if ( caseins ) then
			    if ( (
yy.value_stack(yy.tos) >= CHARACTER'POS('A')) and (
yy.value_stack(yy.tos) <= CHARACTER'POS('Z')) ) then
				
yy.value_stack(yy.tos) := misc.clower( 
yy.value_stack(yy.tos) );
			    end if;
			end if;    

			rulelen := rulelen + 1;

			
yyval := nfa.link_machines( 
yy.value_stack(yy.tos-1), nfa.mkstate( 
yy.value_stack(yy.tos) ) );
			

when  52 =>
--#line  602
 
yyval := nfa.mkstate( SYM_EPSILON ); 

                    when others => null;
                end case;


            -- Pop RHS states and goto next state
            yy.tos      := yy.tos - rule_length(yy.rule_id) + 1;
            if yy.tos > yy.stack_size then
                text_io.put_line(" Stack size exceeded on state_stack");
                raise yy_Tokens.syntax_error;
            end if;
            yy.state_stack(yy.tos) := goto_state(yy.state_stack(yy.tos-1) ,
                                 get_lhs_rule(yy.rule_id));

              yy.value_stack(yy.tos) := yyval;

            if yy.debug then
                reduce_debug(yy.rule_id,
                    goto_state(yy.state_stack(yy.tos - 1),
                               get_lhs_rule(yy.rule_id)));
            end if;

        end if;


    end loop;


end yyparse;
end Aflex_parser;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/GEN/aflex_parser.ads version [53d3f00656].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
pragma Warnings(Off);
pragma Style_Checks(Off);


with Parse_Tokens, Parse_Goto, Parse_Shift_Reduce, Text_IO, scanner;
with NFA, ccl, Aflex_misc, misc_defs, sym, ecs, aflex_scanner;
with tstring, int_io, main_body, text_io, external_file_manager;
use aflex_scanner, external_file_manager;

package Aflex_parser is
  package misc renames Aflex_misc;
  procedure build_eof_action;
  procedure yyerror(msg: string);
  procedure YYParse;
  def_rule:integer;
end Aflex_parser;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/GEN/ascan_dfa.adb version [8549210498].

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
pragma Warnings(Off);
pragma Style_Checks(Off);

with ascan_dfa; use ascan_dfa; 
package body ascan_dfa is
function YYText return string is
    i : integer;
    str_loc : integer := 1;
    buffer : string(1..1024);
    EMPTY_STRING : constant string := "";
begin
    -- find end of buffer
    i := yytext_ptr;
    while ( yy_ch_buf(i) /= ASCII.NUL ) loop
    buffer(str_loc ) := yy_ch_buf(i);
        i := i + 1;
    str_loc := str_loc + 1;
    end loop;
--    return yy_ch_buf(yytext_ptr.. i - 1);

    if (str_loc < 2) then
        return EMPTY_STRING;
    else
      return buffer(1..str_loc-1);
    end if;

end;

-- returns the length of the matched text
function YYLength return integer is
begin
    return yy_cp - yy_bp;
end YYLength;

-- done after the current pattern has been matched and before the
-- corresponding action - sets up yytext

procedure YY_DO_BEFORE_ACTION is
begin
    yytext_ptr := yy_bp;
    yy_hold_char := yy_ch_buf(yy_cp);
    yy_ch_buf(yy_cp) := ASCII.NUL;
    yy_c_buf_p := yy_cp;
end YY_DO_BEFORE_ACTION;

end ascan_dfa;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/GEN/ascan_dfa.ads version [e402fa39e1].

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
pragma Warnings(Off);
pragma Style_Checks(Off);

package ascan_dfa is
aflex_debug : boolean := false;
yytext_ptr : integer; -- points to start of yytext in buffer

-- yy_ch_buf has to be 2 characters longer than YY_BUF_SIZE because we need
-- to put in 2 end-of-buffer characters (this is explained where it is
-- done) at the end of yy_ch_buf
YY_READ_BUF_SIZE : constant integer :=  8192;
YY_BUF_SIZE : constant integer := YY_READ_BUF_SIZE * 2; -- size of input buffer
type unbounded_character_array is array(integer range <>) of character;
subtype ch_buf_type is unbounded_character_array(0..YY_BUF_SIZE + 1);
yy_ch_buf : ch_buf_type;
yy_cp, yy_bp : integer;

-- yy_hold_char holds the character lost when yytext is formed
yy_hold_char : character;
yy_c_buf_p : integer;   -- points to current character in buffer

function YYText return string;
function YYLength return integer;
procedure YY_DO_BEFORE_ACTION;
--These variables are needed between calls to YYLex.
yy_init : boolean := true; -- do we need to initialize YYLex?
yy_start : integer := 0; -- current start state number
subtype yy_state_type is integer;
yy_last_accepting_state : yy_state_type;
yy_last_accepting_cpos : integer;
end ascan_dfa;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






























































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/GEN/ascan_io.adb version [403288477c].

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

pragma Warnings(Off);
pragma Style_Checks(Off);

package body ascan_io is
-- gets input and stuffs it into 'buf'.  number of characters read, or YY_NULL,
-- is returned in 'result'.

procedure YY_INPUT(buf: out unbounded_character_array; result: out integer; max_size: in integer) is
    c : character;
    i : integer := 1;
    loc : integer := buf'first;
begin

    if (is_open(user_input_file)) then
      while ( i <= max_size ) loop
         if (end_of_line(user_input_file)) then -- Ada ate our newline, put it back on the end.
             buf(loc) := ASCII.LF;
             skip_line(user_input_file, 1);
         else
-- UCI CODES CHANGED:
--    The following codes are modified. Previous codes is commented out.
--    The purpose of doing this is to make it possible to set Temp_Line
--    in Ayacc-extension specific codes. Definitely, we can read the character
--    into the Temp_Line and then set the buf. But Temp_Line will only
--    be used in Ayacc-extension specific codes which makes this approach impossible.
           get(user_input_file, c);
           buf(loc) := c;
--         get(user_input_file, buf(loc));
         end if;

         loc := loc + 1;
         i := i + 1;
      end loop;
    else
      while ( i <= max_size ) loop
         if (end_of_line) then -- Ada ate our newline, put it back on the end.
             buf(loc) := ASCII.LF;
             skip_line(1);

         else
--    The following codes are modified. Previous codes is commented out.
--    The purpose of doing this is to make it possible to set Temp_Line
--    in Ayacc-extension specific codes. Definitely, we can read the character
--    into the Temp_Line and then set the buf. But Temp_Line will only
--    be used in Ayacc-extension specific codes which makes this approach impossible.
           get(c);
           buf(loc) := c;
--         get(buf(loc));
         end if; 

         loc := loc + 1;
         i := i + 1;
      end loop;
    end if; -- for input file being standard input

    result := i - 1; 
    exception
        when END_ERROR => result := i - 1;
    -- when we hit EOF we need to set yy_eof_has_been_seen
    yy_eof_has_been_seen := true;
end YY_INPUT;

-- yy_get_next_buffer - try to read in new buffer
--
-- returns a code representing an action
--     EOB_ACT_LAST_MATCH - 
--     EOB_ACT_RESTART_SCAN - restart the scanner
--     EOB_ACT_END_OF_FILE - end of file

function yy_get_next_buffer return eob_action_type is
    dest : integer := 0;
    source : integer := yytext_ptr - 1; -- copy prev. char, too
    number_to_move : integer;
    ret_val : eob_action_type;
    num_to_read : integer;
begin    
    if ( yy_c_buf_p > yy_n_chars + 1 ) then
        raise NULL_IN_INPUT;
    end if;

    -- try to read more data

    -- first move last chars to start of buffer
    number_to_move := yy_c_buf_p - yytext_ptr;

    for i in 0..number_to_move - 1 loop
        yy_ch_buf(dest) := yy_ch_buf(source);
    dest := dest + 1;
    source := source + 1;
    end loop;
        
    if ( yy_eof_has_been_seen ) then
    -- don't do the read, it's not guaranteed to return an EOF,
    -- just force an EOF

    yy_n_chars := 0;
    else
    num_to_read := YY_BUF_SIZE - number_to_move - 1;

    if ( num_to_read > YY_READ_BUF_SIZE ) then
        num_to_read := YY_READ_BUF_SIZE;
        end if;

    -- read in more data
    YY_INPUT( yy_ch_buf(number_to_move..yy_ch_buf'last), yy_n_chars, num_to_read );
    end if;
    if ( yy_n_chars = 0 ) then
    if ( number_to_move = 1 ) then
        ret_val := EOB_ACT_END_OF_FILE;
    else
        ret_val := EOB_ACT_LAST_MATCH;
        end if;

    yy_eof_has_been_seen := true;
    else
    ret_val := EOB_ACT_RESTART_SCAN;
    end if;
    
    yy_n_chars := yy_n_chars + number_to_move;
    yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;
    yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;

    -- yytext begins at the second character in
    -- yy_ch_buf; the first character is the one which
    -- preceded it before reading in the latest buffer;
    -- it needs to be kept around in case it's a
    -- newline, so yy_get_previous_state() will have
    -- with '^' rules active

    yytext_ptr := 1;

    return ret_val;
end yy_get_next_buffer;

procedure yyunput( c : character; yy_bp: in out integer ) is
    number_to_move : integer;
    dest : integer;
    source : integer;
    tmp_yy_cp : integer;
begin
    tmp_yy_cp := yy_c_buf_p;
    yy_ch_buf(tmp_yy_cp) := yy_hold_char; -- undo effects of setting up yytext

    if ( tmp_yy_cp < 2 ) then
    -- need to shift things up to make room
    number_to_move := yy_n_chars + 2; -- +2 for EOB chars
    dest := YY_BUF_SIZE + 2;
    source := number_to_move;

    while ( source > 0 ) loop
        dest := dest - 1;
        source := source - 1;
            yy_ch_buf(dest) := yy_ch_buf(source);
    end loop;

    tmp_yy_cp := tmp_yy_cp + dest - source;
    yy_bp := yy_bp + dest - source;
    yy_n_chars := YY_BUF_SIZE;

    if ( tmp_yy_cp < 2 ) then
        raise PUSHBACK_OVERFLOW;
    end if;
    end if;

    if ( tmp_yy_cp > yy_bp and then yy_ch_buf(tmp_yy_cp-1) = ASCII.LF ) then
    yy_ch_buf(tmp_yy_cp-2) := ASCII.LF;
    end if;

    tmp_yy_cp := tmp_yy_cp - 1;
    yy_ch_buf(tmp_yy_cp) := c;

--  Note:  this code is the text of YY_DO_BEFORE_ACTION, only
--         here we get different yy_cp and yy_bp's
    yytext_ptr := yy_bp;
    yy_hold_char := yy_ch_buf(tmp_yy_cp);
    yy_ch_buf(tmp_yy_cp) := ASCII.NUL;
    yy_c_buf_p := tmp_yy_cp;
end yyunput;

procedure unput(c : character) is
begin
     yyunput( c, yy_bp );
end unput;

function input return character is
    c : character;
    yy_cp : integer := yy_c_buf_p;
begin
    yy_ch_buf(yy_cp) := yy_hold_char;

    if ( yy_ch_buf(yy_c_buf_p) = YY_END_OF_BUFFER_CHAR ) then
    -- need more input
    yytext_ptr := yy_c_buf_p;
    yy_c_buf_p := yy_c_buf_p + 1;

    case yy_get_next_buffer is
        -- this code, unfortunately, is somewhat redundant with
        -- that above

        when EOB_ACT_END_OF_FILE =>
        if ( yywrap ) then
            yy_c_buf_p := yytext_ptr;
            return ASCII.NUL;
        end if;

        yy_ch_buf(0) := ASCII.LF;
        yy_n_chars := 1;
        yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;
        yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;
        yy_eof_has_been_seen := false;
        yy_c_buf_p := 1;
        yytext_ptr := yy_c_buf_p;
        yy_hold_char := yy_ch_buf(yy_c_buf_p);

        return ( input );
        when EOB_ACT_RESTART_SCAN =>
        yy_c_buf_p := yytext_ptr;

        when EOB_ACT_LAST_MATCH =>
        raise UNEXPECTED_LAST_MATCH;
        when others => null;
        end case;
    end if;

    c := yy_ch_buf(yy_c_buf_p);
    yy_c_buf_p := yy_c_buf_p + 1;
    yy_hold_char := yy_ch_buf(yy_c_buf_p);

    return c;
end input;

procedure output(c : character) is
begin
    if (is_open(user_output_file)) then
      text_io.put(user_output_file, c);
    else
      text_io.put(c);
    end if;
end output;

-- default yywrap function - always treat EOF as an EOF
function yywrap return boolean is
begin
    return true;
end yywrap;

procedure Open_Input(fname : in String) is
begin
    yy_init := true;
    open(user_input_file, in_file, fname);
end Open_Input;

procedure Create_Output(fname : in String := "") is
begin
    if (fname /= "") then
        create(user_output_file, out_file, fname);
    end if;
end Create_Output;

procedure Close_Input is
begin
   if (is_open(user_input_file)) then
     text_io.close(user_input_file);
   end if;
end Close_Input;

procedure Close_Output is
begin
   if (is_open(user_output_file)) then
     text_io.close(user_output_file);
   end if;
end Close_Output;


end ascan_io;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/GEN/ascan_io.ads version [557693e932].

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
pragma Warnings(Off);
pragma Style_Checks(Off);

with ascan_dfa; use ascan_dfa; 
with text_io; use text_io;

package ascan_io is
user_input_file : file_type;
user_output_file : file_type;
NULL_IN_INPUT : exception;
AFLEX_INTERNAL_ERROR : exception;
UNEXPECTED_LAST_MATCH : exception;
PUSHBACK_OVERFLOW : exception;
AFLEX_SCANNER_JAMMED : exception;
type eob_action_type is ( EOB_ACT_RESTART_SCAN,
                          EOB_ACT_END_OF_FILE,
                          EOB_ACT_LAST_MATCH );
YY_END_OF_BUFFER_CHAR :  constant character:=  ASCII.NUL;
yy_n_chars : integer;       -- number of characters read into yy_ch_buf

-- true when we've seen an EOF for the current input file
yy_eof_has_been_seen : boolean;


procedure YY_INPUT(buf: out unbounded_character_array; result: out integer; max_size: in integer);
function yy_get_next_buffer return eob_action_type;
procedure yyunput( c : character; yy_bp: in out integer );
procedure unput(c : character);
function input return character;
procedure output(c : character);
function yywrap return boolean;
procedure Open_Input(fname : in String);
procedure Close_Input;
procedure Create_Output(fname : in String := "");
procedure Close_Output;


end ascan_io;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<












































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/GEN/parse_goto.ads version [43f572ae8b].

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
pragma Warnings(Off);
pragma Style_Checks(Off);

package Parse_Goto is

    type Small_Integer is range -32_000 .. 32_000;

    type Goto_Entry is record
        Nonterm  : Small_Integer;
        Newstate : Small_Integer;
    end record;

  --pragma suppress(index_check);

    subtype Row is Integer range -1 .. Integer'Last;

    type Goto_Parse_Table is array (Row range <>) of Goto_Entry;

    Goto_Matrix : constant Goto_Parse_Table :=
       ((-1,-1)  -- Dummy Entry.
-- State  0
,(-3, 1),(-2, 2)
-- State  1
,(-4, 3)
-- State  2

-- State  3
,(-8, 10)
,(-5, 9)
-- State  4

-- State  5

-- State  6

-- State  7

-- State  8

-- State  9
,(-6, 12)
-- State  10

-- State  11

-- State  12
,(-7, 14)
-- State  13
,(-9, 15)

-- State  14
,(-18, 28),(-17, 26),(-16, 24),(-15, 25)
,(-12, 20),(-11, 18),(-10, 34)
-- State  15

-- State  16

-- State  17

-- State  18
,(-18, 28)
,(-17, 26),(-16, 24),(-15, 25),(-12, 37)

-- State  19
,(-18, 28),(-17, 26),(-16, 24),(-15, 25)
,(-12, 40)
-- State  20
,(-13, 42)
-- State  21

-- State  22

-- State  23
,(-14, 45)
-- State  24
,(-18, 28)
,(-17, 26),(-15, 48)
-- State  25
,(-18, 28),(-17, 49)

-- State  26

-- State  27

-- State  28

-- State  29

-- State  30
,(-19, 54)
-- State  31
,(-18, 28),(-17, 26),(-16, 24)
,(-15, 25),(-12, 55)
-- State  32

-- State  33
,(-20, 56)
-- State  34

-- State  35

-- State  36

-- State  37
,(-13, 60)

-- State  38
,(-18, 28),(-17, 26),(-16, 24),(-15, 25)
,(-12, 61)
-- State  39

-- State  40
,(-13, 62)
-- State  41

-- State  42

-- State  43
,(-18, 28),(-17, 26)
,(-15, 63)
-- State  44

-- State  45

-- State  46

-- State  47

-- State  48
,(-18, 28),(-17, 49)
-- State  49

-- State  50

-- State  51

-- State  52

-- State  53

-- State  54

-- State  55

-- State  56

-- State  57
,(-20, 72)

-- State  58

-- State  59

-- State  60

-- State  61
,(-13, 73)
-- State  62

-- State  63
,(-18, 28),(-17, 49)
-- State  64

-- State  65

-- State  66

-- State  67

-- State  68

-- State  69

-- State  70

-- State  71

-- State  72

-- State  73

-- State  74

-- State  75

-- State  76

-- State  77

-- State  78

-- State  79

-- State  80

-- State  81

-- State  82

);
--  The offset vector
GOTO_OFFSET : array (0.. 82) of Integer :=
( 0,
 2, 3, 3, 5, 5, 5, 5, 5, 5, 6,
 6, 6, 7, 8, 15, 15, 15, 15, 20, 25,
 26, 26, 26, 27, 30, 32, 32, 32, 32, 32,
 33, 38, 38, 39, 39, 39, 39, 40, 45, 45,
 46, 46, 46, 49, 49, 49, 49, 49, 51, 51,
 51, 51, 51, 51, 51, 51, 51, 52, 52, 52,
 52, 53, 53, 55, 55, 55, 55, 55, 55, 55,
 55, 55, 55, 55, 55, 55, 55, 55, 55, 55,
 55, 55);

subtype Rule        is Natural;
subtype Nonterminal is Integer;

   Rule_Length : array (Rule range  0 ..  52) of Natural := ( 2,
 5, 0, 5, 0, 2, 1, 1, 1,
 3, 1, 1, 4, 0, 0, 4, 3,
 3, 2, 2, 1, 1, 3, 3, 1,
 1, 1, 0, 3, 2, 1, 2, 2,
 1, 2, 2, 2, 6, 5, 4, 1,
 1, 1, 3, 3, 1, 3, 4, 4,
 2, 0, 2, 0);
   Get_LHS_Rule: array (Rule range  0 ..  52) of Nonterminal := (-1,
-2,-3,-4,-4,-4,-5,-8,-8,
-9,-9,-9,-6,-6,-7,-10,-10,
-10,-10,-10,-10,-10,-11,-14,-14,
-14,-13,-13,-12,-12,-12,-16,-15,
-15,-17,-17,-17,-17,-17,-17,-17,
-17,-17,-17,-17,-17,-18,-18,-20,
-20,-20,-19,-19);
end Parse_Goto;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/GEN/parse_shift_reduce.ads version [ee31b4596b].

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
pragma Warnings(Off);
pragma Style_Checks(Off);

package Parse_Shift_Reduce is

    type Small_Integer is range -32_000 .. 32_000;

    type Shift_Reduce_Entry is record
        T   : Small_Integer;
        Act : Small_Integer;
    end record;
    pragma Pack(Shift_Reduce_Entry);

    subtype Row is Integer range -1 .. Integer'Last;

  --pragma suppress(index_check);

    type Shift_Reduce_Array is array (Row  range <>) of Shift_Reduce_Entry;

    Shift_Reduce_Matrix : constant Shift_Reduce_Array :=
        ( (-1,-1) -- Dummy Entry

-- state  0
,(-1,-2)
-- state  1
,( 1, 4),(-1,-4)
-- state  2
,( 0,-1001)
,(-1,-1000)
-- state  3
,( 4, 6),( 5, 7),( 6, 8)
,(-1,-1000)
-- state  4
,( 11, 11),(-1,-1000)
-- state  5
,(-1,-1000)

-- state  6
,(-1,-6)
-- state  7
,(-1,-7)
-- state  8
,(-1,-8)
-- state  9
,(-1,-13)

-- state  10
,( 7, 13),(-1,-1000)
-- state  11
,(-1,-5)
-- state  12
,(-1,-14)

-- state  13
,( 1, 17),( 8, 16),(-1,-1000)
-- state  14
,( 1, 22)
,( 2, 32),( 9, 29),( 10, 21),( 12, 19)
,( 13, 23),( 24, 27),( 25, 30),( 26, 31)
,( 28, 33),(-1,-1)
-- state  15
,( 7, 36),( 11, 35)
,(-1,-1000)
-- state  16
,(-1,-10)
-- state  17
,(-1,-11)
-- state  18
,( 2, 32)
,( 9, 29),( 10, 39),( 12, 38),( 24, 27)
,( 25, 30),( 26, 31),( 28, 33),(-1,-1000)

-- state  19
,( 2, 32),( 9, 29),( 24, 27),( 25, 30)
,( 26, 31),( 28, 33),(-1,-1000)
-- state  20
,( 16, 41)
,( 17, 43),( 18, 44),(-1,-27)
-- state  21
,(-1,-20)

-- state  22
,(-1,-21)
-- state  23
,( 1, 47),( 8, 46),(-1,-1000)

-- state  24
,( 2, 32),( 9, 29),( 24, 27),( 25, 30)
,( 26, 31),( 28, 33),(-1,-1000)
-- state  25
,( 2, 32)
,( 9, 29),( 24, 27),( 25, 30),( 26, 31)
,( 28, 33),(-1,-30)
-- state  26
,( 19, 50),( 20, 51)
,( 21, 52),( 22, 53),(-1,-33)
-- state  27
,(-1,-40)

-- state  28
,(-1,-41)
-- state  29
,(-1,-42)
-- state  30
,(-1,-52)
-- state  31
,( 2, 32)
,( 9, 29),( 24, 27),( 25, 30),( 26, 31)
,( 28, 33),(-1,-1000)
-- state  32
,(-1,-45)
-- state  33
,( 12, 57)
,(-1,-50)
-- state  34
,( 11, 58),(-1,-1000)
-- state  35
,(-1,-3)

-- state  36
,( 8, 59),(-1,-1000)
-- state  37
,( 16, 41),( 17, 43)
,( 18, 44),(-1,-27)
-- state  38
,( 2, 32),( 9, 29)
,( 24, 27),( 25, 30),( 26, 31),( 28, 33)
,(-1,-1000)
-- state  39
,(-1,-19)
-- state  40
,( 16, 41),( 17, 43)
,( 18, 44),(-1,-27)
-- state  41
,(-1,-26)
-- state  42
,(-1,-18)

-- state  43
,( 2, 32),( 9, 29),( 24, 27),( 25, 30)
,( 26, 31),( 28, 33),(-1,-1000)
-- state  44
,(-1,-31)

-- state  45
,( 14, 64),( 15, 65),(-1,-1000)
-- state  46
,(-1,-24)

-- state  47
,(-1,-25)
-- state  48
,( 2, 32),( 9, 29),( 24, 27)
,( 25, 30),( 26, 31),( 28, 33),(-1,-29)

-- state  49
,( 19, 50),( 20, 51),( 21, 52),( 22, 53)
,(-1,-32)
-- state  50
,(-1,-34)
-- state  51
,(-1,-35)
-- state  52
,(-1,-36)

-- state  53
,( 3, 66),(-1,-1000)
-- state  54
,( 2, 68),( 25, 67)
,(-1,-1000)
-- state  55
,( 17, 43),( 18, 44),( 27, 69)
,(-1,-1000)
-- state  56
,( 2, 71),( 29, 70),(-1,-1000)

-- state  57
,(-1,-50)
-- state  58
,(-1,-12)
-- state  59
,(-1,-9)
-- state  60
,(-1,-16)

-- state  61
,( 16, 41),( 17, 43),( 18, 44),(-1,-27)

-- state  62
,(-1,-17)
-- state  63
,( 2, 32),( 9, 29),( 24, 27)
,( 25, 30),( 26, 31),( 28, 33),(-1,-28)

-- state  64
,(-1,-22)
-- state  65
,( 8, 74),(-1,-1000)
-- state  66
,( 15, 75)
,( 23, 76),(-1,-1000)
-- state  67
,(-1,-43)
-- state  68
,(-1,-51)

-- state  69
,(-1,-44)
-- state  70
,(-1,-46)
-- state  71
,( 30, 77),(-1,-49)

-- state  72
,( 2, 71),( 29, 78),(-1,-1000)
-- state  73
,(-1,-15)

-- state  74
,(-1,-23)
-- state  75
,( 3, 79),( 23, 80),(-1,-1000)

-- state  76
,(-1,-39)
-- state  77
,( 2, 81),(-1,-1000)
-- state  78
,(-1,-47)

-- state  79
,( 23, 82),(-1,-1000)
-- state  80
,(-1,-38)
-- state  81
,(-1,-48)

-- state  82
,(-1,-37)
);
--  The offset vector
SHIFT_REDUCE_OFFSET : array (0.. 82) of Integer :=
( 0,
 1, 3, 5, 9, 11, 12, 13, 14, 15, 16,
 18, 19, 20, 23, 34, 37, 38, 39, 48, 55,
 59, 60, 61, 64, 71, 78, 83, 84, 85, 86,
 87, 94, 95, 97, 99, 100, 102, 106, 113, 114,
 118, 119, 120, 127, 128, 131, 132, 133, 140, 145,
 146, 147, 148, 150, 153, 157, 160, 161, 162, 163,
 164, 168, 169, 176, 177, 179, 182, 183, 184, 185,
 186, 188, 191, 192, 193, 196, 197, 199, 200, 202,
 203, 204);
end Parse_Shift_Reduce;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


























































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/GEN/parse_tokens.ads version [ba1e9dd78b].

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
pragma Warnings(Off);
pragma Style_Checks(Off);

with  Text_Io;
with  Ccl;
with  Nfa;
with  Parse_Shift_Reduce;
with  Parse_Goto;
with  Misc_Defs;
use   Misc_Defs;
with  External_File_Manager;
use   External_File_Manager;
package Parse_Tokens is


  subtype YYSType is Integer;

    YYLVal, YYVal : YYSType; 
    type Token is
        (End_Of_Input, Error, Char, Number,
         Sectend, Scdecl, Xscdecl,
         Whitespace, Name, Prevccl,
         Eof_Op, Newline, '^',
         '<', '>', ',',
         '$', '|', '/',
         '*', '+', '?',
         '{', '}', '.',
         '"', '(', ')',
         '[', ']', '-' );

    Syntax_Error : exception;

end Parse_Tokens;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/GEN/scanner.adb version [4ba1bbb6ec].

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
pragma Warnings(Off);
pragma Style_Checks(Off);


package body scanner is

beglin : boolean := false;
i, bracelevel: integer;

function get_token return Token is
    toktype : Token;
    didadef, indented_code : boolean;
    cclval : integer;
    nmdefptr : vstring;
    nmdef, tmpbuf : vstring;

procedure ACTION_ECHO is
begin
    text_io.put( temp_action_file, yytext(1..YYLength) );
end ACTION_ECHO;

procedure MARK_END_OF_PROLOG is
begin
     text_io.put( temp_action_file, "%%%% end of prolog" );
     text_io.new_line( temp_action_file );
end MARK_END_OF_PROLOG;

procedure PUT_BACK_STRING(str : vstring; start : integer) is
begin
	for i in reverse start+1..tstring.len(str) loop
	    unput( CHAR(str,i) );
	end loop;
end PUT_BACK_STRING;

function check_yylex_here return boolean is
begin
	return ( (yytext'length >= 2) and then
			((yytext(1) = '#') and (yytext(2) = '#')));
end check_yylex_here;

function YYLex return Token is
subtype short is integer range -32768..32767;
    yy_act : integer;
    yy_c : short;

-- returned upon end-of-file
YY_END_TOK : constant integer := 0;
YY_END_OF_BUFFER : constant := 82;
subtype yy_state_type is integer;
yy_current_state : yy_state_type;
INITIAL : constant := 0;
SECT2 : constant := 1;
SECT2PROLOG : constant := 2;
SECT3 : constant := 3;
PICKUPDEF : constant := 4;
SC : constant := 5;
CARETISBOL : constant := 6;
NUM : constant := 7;
QUOTE : constant := 8;
FIRSTCCL : constant := 9;
CCL : constant := 10;
ACTION : constant := 11;
RECOVER : constant := 12;
BRACEERROR : constant := 13;
ACTION_STRING : constant := 14;
yy_accept : constant array(0..206) of short :=
    (   0,
        0,    0,    0,    0,    0,    0,   80,   80,    0,    0,
        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
       82,   13,    6,   12,   10,    1,   11,   13,   13,   13,
        9,   39,   31,   32,   25,   39,   38,   23,   39,   39,
       39,   31,   21,   39,   39,   24,   81,   19,   80,   80,
       15,   14,   16,   45,   81,   41,   42,   44,   46,   60,
       61,   58,   57,   59,   47,   49,   48,   47,   53,   52,
       53,   53,   55,   55,   55,   56,   66,   71,   70,   72,
       66,   72,   67,   64,   65,   81,   17,   63,   62,   73,

       75,   76,   77,    6,   12,   10,    1,   11,    0,    0,
        2,    0,    7,    4,    5,    0,    9,   31,   32,    0,
       28,    0,    0,    0,   78,   78,   27,   26,   27,    0,
       31,   21,    0,    0,   35,    0,    0,   19,   18,   80,
       80,   15,   14,   43,   44,   57,   79,   79,   50,   51,
       54,   66,    0,   69,    0,   66,   67,    0,   17,   73,
       74,    0,    7,    0,    0,    3,    0,   29,    0,   36,
        0,   78,   27,   27,   37,    0,    0,    0,   35,    0,
       30,   79,   66,   68,    0,    0,    8,    0,    0,    0,
        0,    0,    0,    0,    0,    0,    0,   22,    0,   22,

        0,   22,    4,    0,   34,    0
    ) ;

------MOD changed bounds
yy_ec : constant array(ASCII.NUL..ASCII.DEL) of short :=
    (   0,
        1,    1,    1,    1,    1,    1,    1,    1,    2,    3,
        1,    4,    1,    1,    1,    1,    1,    1,    1,    1,
        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
        1,    5,    1,    6,    7,    8,    9,    1,   10,   11,
       11,   11,   11,   12,   13,   11,   14,   15,   15,   15,
       15,   15,   15,   15,   15,   15,   15,    1,    1,   16,
        1,   17,   11,    1,   23,   22,   22,   22,   24,   25,
       22,   22,   22,   22,   22,   22,   22,   22,   26,   22,
       22,   27,   28,   29,   22,   22,   22,   30,   22,   22,
       18,   19,   20,   21,   22,    1,   23,   22,   22,   22,

       24,   25,   22,   22,   22,   22,   22,   22,   22,   22,
       26,   22,   22,   27,   28,   29,   22,   22,   22,   30,
       22,   22,   31,   32,   33,    1,    1
    ) ;

yy_meta : constant array(0..33) of short :=
    (   0,
        1,    2,    3,    2,    2,    4,    1,    1,    1,    5,
        1,    1,    6,    5,    7,    1,    1,    1,    8,    9,
        1,   10,   10,   10,   10,   10,   10,   10,   10,   10,
        5,   11,   12
    ) ;

yy_base : constant array(0..254) of short :=
    (   0,
        0,   29,   58,   89,  503,  499,  498,  305,    4,    8,
      119,  147,  286,  285,   32,   34,   65,   67,   93,   96,
      110,  113,  177,    0,  302,  301,   12,   15,   82,  121,
      303,  880,   76,  880,    0,   37,  880,  299,   11,  288,
        0,  880,   11,  880,  880,   14,  880,  284,  280,  283,
      196,  225,  880,  288,  283,  880,  292,    0,  291,  880,
        0,  133,  880,  880,  880,  880,  272,    0,  880,  880,
      880,  880,  277,  880,  880,  880,  880,  276,  880,  880,
      274,  275,  880,    0,  272,  880,    0,  880,  880,  109,
      273,  880,    0,  880,  880,  282,  880,  880,  880,    0,

      880,  880,    0,  149,  880,    0,  152,  880,  271,  280,
      880,  272,    0,  247,  880,  263,    0,   72,  880,  262,
      880,  240,   63,  119,  880,  248,    0,  880,  245,  249,
      277,  880,  248,  153,    0,  256,  253,    0,  880,  252,
      880,    0,  156,  880,    0,  239,  880,  238,  880,  880,
      880,    0,  221,  880,    0,  309,    0,  249,  880,    0,
      880,  248,    0,  227,  246,  880,  245,  880,  221,  880,
      148,  231,    0,    0,  880,  232,  229,  230,    0,  241,
      880,  226,    0,  880,  236,  234,  880,  209,  210,  197,
      231,  212,  159,  128,  108,  194,  115,  880,  108,  880,

       84,  880,  880,    4,  880,  880,  342,  354,  366,  378,
      390,  402,  414,  426,  438,  450,  462,  474,  486,  493,
      502,  508,  520,  527,  536,  547,  559,  571,  583,  595,
      607,  619,  631,  638,  648,  660,  672,  684,  695,  702,
      712,  724,  736,  748,  760,  772,  784,  795,  807,  819,
      831,  843,  855,  867
    ) ;

yy_def : constant array(0..254) of short :=
    (   0,
      207,  207,  208,  208,  209,  209,  210,  210,  211,  211,
      212,  212,  213,  213,  214,  214,  215,  215,  216,  216,
      217,  217,  206,   23,  218,  218,  213,  213,  219,  219,
      206,  206,  206,  206,  220,  221,  206,  222,  223,  206,
      224,  206,  225,  206,  206,  206,  206,  206,  226,  227,
      228,  229,  206,  206,  206,  206,  230,  231,  232,  206,
      233,  206,  206,  206,  206,  206,  206,  234,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  227,  206,  206,
      235,  236,  206,  237,  227,  206,  238,  206,  206,  239,
      238,  206,  240,  206,  206,  241,  206,  206,  206,  242,

      206,  206,  243,  206,  206,  220,  221,  206,  206,  222,
      206,  206,  244,  206,  206,  245,  224,  225,  206,  246,
      206,  206,  226,  226,  206,  206,  247,  206,  247,  206,
      229,  206,  206,  246,  248,  249,  230,  231,  206,  232,
      206,  233,  206,  206,  234,  206,  206,  206,  206,  206,
      206,  238,  239,  206,  239,  206,  240,  241,  206,  242,
      206,  250,  244,  206,  245,  206,  246,  206,  206,  206,
      226,  206,  247,  129,  206,  206,  249,  246,  248,  249,
      206,  206,  156,  206,  251,  250,  206,  206,  206,  226,
      252,  253,  254,  206,  206,  226,  252,  206,  253,  206,

      254,  206,  206,  206,  206,    0,  206,  206,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206,  206
    ) ;

yy_nxt : constant array(0..913) of short :=
    (   0,
      206,   33,   34,   33,   33,   62,   63,   62,   62,   62,
       63,   62,   62,  119,   98,  121,  121,   98,  121,  113,
      205,   35,   35,   35,   35,   35,   35,   35,   35,   35,
       36,   37,   36,   36,   71,   38,   71,   39,  114,  108,
      115,   40,  120,   72,   99,   72,   73,   99,   73,  109,
       41,   41,   41,   41,   41,   41,   41,   41,   41,   43,
       44,   43,   43,   45,   74,   46,   74,   76,   47,   76,
       77,   47,   77,   48,  119,   49,   50,  104,  105,  104,
      104,  124,  170,   78,  101,   78,  202,  102,   51,   47,
       52,   53,   52,   52,   45,   65,   46,   54,   65,   47,

      103,   55,   47,  120,   48,   80,   49,   50,   80,   56,
      200,   81,   65,   82,   81,   65,   82,  198,  154,   51,
       47,   65,   84,  101,  204,   84,  102,  155,   85,   86,
       66,   85,   86,  171,  143,   67,  143,  143,  123,  103,
       68,   68,   68,   68,   68,   68,   68,   68,   68,   65,
      104,  105,  104,  104,  108,  168,  203,  143,   66,  143,
      143,  202,  190,   67,  109,  178,  124,  170,   68,   68,
       68,   68,   68,   68,   68,   68,   68,   87,   87,   88,
       87,   87,   89,   87,   87,   87,   90,   87,   87,   91,
       92,   87,   87,   87,   87,   87,   87,   87,   93,   93,

       93,   93,   93,   93,   93,   93,   93,   94,   87,   95,
      128,  196,  124,  170,  200,  124,  170,  129,  129,  129,
      129,  129,  129,  129,  129,  129,  131,  132,  131,  131,
      154,  181,  168,  198,  195,  194,  187,  133,  184,  155,
      147,  192,  193,  181,  191,  125,  189,  168,  166,  188,
      187,  159,  182,  146,  141,  138,  134,  174,  181,  174,
      177,  176,  172,  169,  168,  166,  174,  174,  174,  174,
      174,  174,  174,  174,  174,  164,  162,  175,  131,  132,
      131,  131,  111,  116,  159,  156,  126,  150,  148,  133,
      126,  146,  144,  141,  138,  136,  135,  126,  124,  122,

      116,  111,  206,   97,   97,   69,   69,   60,  134,  183,
      183,  184,  183,  183,  185,  183,  183,  183,  185,  183,
      183,  183,  185,  183,  183,  183,  183,  183,  183,  183,
      185,  185,  185,  185,  185,  185,  185,  185,  185,  185,
      183,  185,   32,   32,   32,   32,   32,   32,   32,   32,
       32,   32,   32,   32,   42,   42,   42,   42,   42,   42,
       42,   42,   42,   42,   42,   42,   57,   57,   57,   57,
       57,   57,   57,   57,   57,   57,   57,   57,   59,   59,
       59,   59,   59,   59,   59,   59,   59,   59,   59,   59,
       61,   61,   61,   61,   61,   61,   61,   61,   61,   61,

       61,   61,   64,   64,   64,   64,   64,   64,   64,   64,
       64,   64,   64,   64,   65,   65,   65,   65,   65,   65,
       65,   65,   65,   65,   65,   65,   70,   70,   70,   70,
       70,   70,   70,   70,   70,   70,   70,   70,   75,   75,
       75,   75,   75,   75,   75,   75,   75,   75,   75,   75,
       79,   79,   79,   79,   79,   79,   79,   79,   79,   79,
       79,   79,   83,   83,   83,   83,   83,   83,   83,   83,
       83,   83,   83,   83,   96,   96,   96,   96,   96,   96,
       96,   96,   96,   96,   96,   96,  100,  100,  100,  100,
      100,  100,  100,  100,  100,  100,  100,  100,  106,  106,

       60,   58,  106,  107,  107,   58,  206,  107,  110,  110,
      110,  110,  110,  110,  110,  110,  110,  110,  110,  110,
      112,  112,  112,  112,  112,  112,  112,  112,  112,  112,
      112,  112,  117,  117,  206,  206,  117,  118,  118,  206,
      206,  206,  206,  206,  206,  206,  118,  123,  123,  206,
      123,  123,  123,  123,  123,  206,  123,  123,  123,  125,
      125,  206,  125,  125,  125,  125,  125,  125,  125,  125,
      125,  127,  127,  206,  127,  127,  127,  127,  127,  127,
      127,  127,  127,  130,  130,  130,  130,  130,  130,  130,
      130,  130,  130,  130,  130,  137,  137,  137,  137,  137,

      137,  137,  137,  137,  137,  137,  137,  139,  206,  206,
      139,  139,  139,  139,  139,  139,  139,  139,  139,  140,
      140,  140,  140,  140,  140,  140,  140,  140,  140,  140,
      140,  142,  142,  206,  142,  142,  142,  142,  142,  142,
      142,  142,  142,  145,  145,  206,  206,  145,  147,  147,
      206,  147,  147,  147,  147,  147,  147,  147,  147,  147,
      149,  149,  206,  149,  149,  149,  149,  149,  149,  149,
      149,  149,  151,  151,  206,  151,  151,  151,  151,  151,
      206,  151,  151,  151,  152,  152,  206,  206,  206,  152,
      152,  152,  152,  206,  152,  153,  153,  206,  153,  153,

      153,  153,  153,  153,  153,  153,  153,  157,  157,  206,
      206,  157,  158,  158,  158,  158,  158,  158,  158,  158,
      158,  158,  158,  158,  160,  160,  206,  206,  160,  160,
      160,  206,  160,  160,  160,  160,  161,  161,  206,  161,
      161,  161,  161,  161,  161,  161,  161,  161,  163,  163,
      206,  163,  163,  163,  163,  163,  163,  163,  163,  163,
      165,  165,  165,  165,  165,  165,  165,  165,  165,  165,
      165,  165,  167,  167,  167,  167,  167,  167,  167,  167,
      167,  167,  167,  167,  173,  173,  206,  173,  173,  173,
      173,  173,  173,  173,  173,  179,  179,  206,  179,  179,

      179,  179,  179,  179,  179,  179,  179,  180,  180,  180,
      180,  180,  180,  180,  180,  180,  180,  180,  180,  186,
      186,  186,  186,  186,  186,  186,  186,  186,  186,  186,
      186,  185,  185,  185,  185,  185,  185,  185,  185,  185,
      185,  185,  185,  197,  197,  197,  197,  197,  197,  197,
      197,  197,  197,  197,  197,  199,  199,  199,  199,  199,
      199,  199,  199,  199,  199,  199,  199,  201,  201,  201,
      201,  201,  201,  201,  201,  201,  201,  201,  201,   31,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,

      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206
    ) ;

yy_chk : constant array(0..913) of short :=
    (   0,
        0,    1,    1,    1,    1,    9,    9,    9,    9,   10,
       10,   10,   10,   43,   27,   46,   46,   28,   46,   39,
      204,    1,    1,    1,    1,    1,    1,    1,    1,    1,
        2,    2,    2,    2,   15,    2,   16,    2,   39,   36,
       39,    2,   43,   15,   27,   16,   15,   28,   16,   36,
        2,    2,    2,    2,    2,    2,    2,    2,    2,    3,
        3,    3,    3,    3,   15,    3,   16,   17,    3,   18,
       17,    3,   18,    3,  118,    3,    3,   33,   33,   33,
       33,  123,  123,   17,   29,   18,  201,   29,    3,    3,
        4,    4,    4,    4,    4,   19,    4,    4,   20,    4,

       29,    4,    4,  118,    4,   19,    4,    4,   20,    4,
      199,   19,   21,   19,   20,   22,   20,  197,   90,    4,
        4,   11,   21,   30,  195,   22,   30,   90,   21,   21,
       11,   22,   22,  124,   62,   11,   62,   62,  124,   30,
       11,   11,   11,   11,   11,   11,   11,   11,   11,   12,
      104,  104,  104,  104,  107,  134,  194,  143,   12,  143,
      143,  193,  171,   12,  107,  134,  171,  171,   12,   12,
       12,   12,   12,   12,   12,   12,   12,   23,   23,   23,
       23,   23,   23,   23,   23,   23,   23,   23,   23,   23,
       23,   23,   23,   23,   23,   23,   23,   23,   23,   23,

       23,   23,   23,   23,   23,   23,   23,   23,   23,   23,
       51,  190,  196,  196,  192,  190,  190,   51,   51,   51,
       51,   51,   51,   51,   51,   51,   52,   52,   52,   52,
      153,  177,  178,  191,  189,  188,  186,   52,  185,  153,
      182,  177,  178,  180,  176,  172,  169,  167,  165,  164,
      162,  158,  148,  146,  140,  137,   52,  129,  136,  129,
      133,  130,  126,  122,  120,  116,  129,  129,  129,  129,
      129,  129,  129,  129,  129,  114,  112,  129,  131,  131,
      131,  131,  110,  109,   96,   91,   85,   82,   81,  131,
       78,   73,   67,   59,   57,   55,   54,   50,   49,   48,

       40,   38,   31,   26,   25,   14,   13,    8,  131,  156,
      156,  156,  156,  156,  156,  156,  156,  156,  156,  156,
      156,  156,  156,  156,  156,  156,  156,  156,  156,  156,
      156,  156,  156,  156,  156,  156,  156,  156,  156,  156,
      156,  156,  207,  207,  207,  207,  207,  207,  207,  207,
      207,  207,  207,  207,  208,  208,  208,  208,  208,  208,
      208,  208,  208,  208,  208,  208,  209,  209,  209,  209,
      209,  209,  209,  209,  209,  209,  209,  209,  210,  210,
      210,  210,  210,  210,  210,  210,  210,  210,  210,  210,
      211,  211,  211,  211,  211,  211,  211,  211,  211,  211,

      211,  211,  212,  212,  212,  212,  212,  212,  212,  212,
      212,  212,  212,  212,  213,  213,  213,  213,  213,  213,
      213,  213,  213,  213,  213,  213,  214,  214,  214,  214,
      214,  214,  214,  214,  214,  214,  214,  214,  215,  215,
      215,  215,  215,  215,  215,  215,  215,  215,  215,  215,
      216,  216,  216,  216,  216,  216,  216,  216,  216,  216,
      216,  216,  217,  217,  217,  217,  217,  217,  217,  217,
      217,  217,  217,  217,  218,  218,  218,  218,  218,  218,
      218,  218,  218,  218,  218,  218,  219,  219,  219,  219,
      219,  219,  219,  219,  219,  219,  219,  219,  220,  220,

        7,    6,  220,  221,  221,    5,    0,  221,  222,  222,
      222,  222,  222,  222,  222,  222,  222,  222,  222,  222,
      223,  223,  223,  223,  223,  223,  223,  223,  223,  223,
      223,  223,  224,  224,    0,    0,  224,  225,  225,    0,
        0,    0,    0,    0,    0,    0,  225,  226,  226,    0,
      226,  226,  226,  226,  226,    0,  226,  226,  226,  227,
      227,    0,  227,  227,  227,  227,  227,  227,  227,  227,
      227,  228,  228,    0,  228,  228,  228,  228,  228,  228,
      228,  228,  228,  229,  229,  229,  229,  229,  229,  229,
      229,  229,  229,  229,  229,  230,  230,  230,  230,  230,

      230,  230,  230,  230,  230,  230,  230,  231,    0,    0,
      231,  231,  231,  231,  231,  231,  231,  231,  231,  232,
      232,  232,  232,  232,  232,  232,  232,  232,  232,  232,
      232,  233,  233,    0,  233,  233,  233,  233,  233,  233,
      233,  233,  233,  234,  234,    0,    0,  234,  235,  235,
        0,  235,  235,  235,  235,  235,  235,  235,  235,  235,
      236,  236,    0,  236,  236,  236,  236,  236,  236,  236,
      236,  236,  237,  237,    0,  237,  237,  237,  237,  237,
        0,  237,  237,  237,  238,  238,    0,    0,    0,  238,
      238,  238,  238,    0,  238,  239,  239,    0,  239,  239,

      239,  239,  239,  239,  239,  239,  239,  240,  240,    0,
        0,  240,  241,  241,  241,  241,  241,  241,  241,  241,
      241,  241,  241,  241,  242,  242,    0,    0,  242,  242,
      242,    0,  242,  242,  242,  242,  243,  243,    0,  243,
      243,  243,  243,  243,  243,  243,  243,  243,  244,  244,
        0,  244,  244,  244,  244,  244,  244,  244,  244,  244,
      245,  245,  245,  245,  245,  245,  245,  245,  245,  245,
      245,  245,  246,  246,  246,  246,  246,  246,  246,  246,
      246,  246,  246,  246,  247,  247,    0,  247,  247,  247,
      247,  247,  247,  247,  247,  248,  248,    0,  248,  248,

      248,  248,  248,  248,  248,  248,  248,  249,  249,  249,
      249,  249,  249,  249,  249,  249,  249,  249,  249,  250,
      250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
      250,  251,  251,  251,  251,  251,  251,  251,  251,  251,
      251,  251,  251,  252,  252,  252,  252,  252,  252,  252,
      252,  252,  252,  252,  252,  253,  253,  253,  253,  253,
      253,  253,  253,  253,  253,  253,  253,  254,  254,  254,
      254,  254,  254,  254,  254,  254,  254,  254,  254,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,

      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206
    ) ;


-- copy whatever the last rule matched to the standard output

procedure ECHO is
begin
   if (text_io.is_open(user_output_file)) then
     text_io.put( user_output_file, yytext );
   else
     text_io.put( yytext );
   end if;
end ECHO;

-- enter a start condition.
-- Using procedure requires a () after the ENTER, but makes everything
-- much neater.

procedure ENTER( state : integer ) is
begin
     yy_start := 1 + 2 * state;
end ENTER;

-- action number for EOF rule of a given start state
function YY_STATE_EOF(state : integer) return integer is
begin
     return YY_END_OF_BUFFER + state + 1;
end YY_STATE_EOF;

-- return all but the first 'n' matched characters back to the input stream
procedure yyless(n : integer) is
begin
        yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
        yy_cp := yy_bp + n;
        yy_c_buf_p := yy_cp;
        YY_DO_BEFORE_ACTION; -- set up yytext again
end yyless;

-- redefine this if you have something you want each time.
procedure YY_USER_ACTION is
begin
        null;
end;

-- yy_get_previous_state - get the state just before the EOB char was reached

function yy_get_previous_state return yy_state_type is
    yy_current_state : yy_state_type;
    yy_c : short;
    yy_bp : integer := yytext_ptr;
begin
    yy_current_state := yy_start;
    if ( yy_ch_buf(yy_bp-1) = ASCII.LF ) then
	yy_current_state := yy_current_state + 1;
    end if;

    for yy_cp in yytext_ptr..yy_c_buf_p - 1 loop
	yy_c := yy_ec(yy_ch_buf(yy_cp));
	if ( yy_accept(yy_current_state) /= 0 ) then
	    yy_last_accepting_state := yy_current_state;
	    yy_last_accepting_cpos := yy_cp;
	end if;
	while ( yy_chk(yy_base(yy_current_state) + yy_c) /= yy_current_state ) loop
	    yy_current_state := yy_def(yy_current_state);
	    if ( yy_current_state >= 207 ) then
		yy_c := yy_meta(yy_c);
	    end if;
	end loop;
	yy_current_state := yy_nxt(yy_base(yy_current_state) + yy_c);
    end loop;

    return yy_current_state;
end yy_get_previous_state;

procedure yyrestart( input_file : file_type ) is
begin
   open_input(text_io.name(input_file));
end yyrestart;

begin -- of YYLex
<<new_file>>
        -- this is where we enter upon encountering an end-of-file and
        -- yywrap() indicating that we should continue processing

    if ( yy_init ) then
        if ( yy_start = 0 ) then
            yy_start := 1;      -- first start state
        end if;

        -- we put in the '\n' and start reading from [1] so that an
        -- initial match-at-newline will be true.

        yy_ch_buf(0) := ASCII.LF;
        yy_n_chars := 1;

        -- we always need two end-of-buffer characters.  The first causes
        -- a transition to the end-of-buffer state.  The second causes
        -- a jam in that state.

        yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;
        yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;

        yy_eof_has_been_seen := false;

        yytext_ptr := 1;
        yy_c_buf_p := yytext_ptr;
        yy_hold_char := yy_ch_buf(yy_c_buf_p);
        yy_init := false;
    end if; -- yy_init

    loop                -- loops until end-of-file is reached


        yy_cp := yy_c_buf_p;

        -- support of yytext
        yy_ch_buf(yy_cp) := yy_hold_char;

        -- yy_bp points to the position in yy_ch_buf of the start of the
        -- current run.
	yy_bp := yy_cp;
	yy_current_state := yy_start;
	if ( yy_ch_buf(yy_bp-1) = ASCII.LF ) then
	    yy_current_state := yy_current_state + 1;
	end if;
	loop
		yy_c := yy_ec(yy_ch_buf(yy_cp));
		if ( yy_accept(yy_current_state) /= 0 ) then
		    yy_last_accepting_state := yy_current_state;
		    yy_last_accepting_cpos := yy_cp;
		end if;
		while ( yy_chk(yy_base(yy_current_state) + yy_c) /= yy_current_state ) loop
		    yy_current_state := yy_def(yy_current_state);
		    if ( yy_current_state >= 207 ) then
			yy_c := yy_meta(yy_c);
		    end if;
		end loop;
		yy_current_state := yy_nxt(yy_base(yy_current_state) + yy_c);
	    yy_cp := yy_cp + 1;
if ( yy_current_state = 206 ) then
    exit;
end if;
	end loop;
	yy_cp := yy_last_accepting_cpos;
	yy_current_state := yy_last_accepting_state;

<<next_action>>
	    yy_act := yy_accept(yy_current_state);
            YY_DO_BEFORE_ACTION;
            YY_USER_ACTION;

        if aflex_debug then  -- output acceptance info. for (-d) debug mode
            text_io.put( Standard_Error, "--accepting rule #" );
            text_io.put( Standard_Error, INTEGER'IMAGE(yy_act) );
            text_io.put_line( Standard_Error, "(""" & yytext & """)");
        end if;


<<do_action>>   -- this label is used only to access EOF actions
            case yy_act is
		when 0 => -- must backtrack
		-- undo the effects of YY_DO_BEFORE_ACTION
		yy_ch_buf(yy_cp) := yy_hold_char;
		yy_cp := yy_last_accepting_cpos;
		yy_current_state := yy_last_accepting_state;
		goto next_action;



when 1 => 
--# line 46 "ascan.l"
 indented_code := true; 

when 2 => 
--# line 47 "ascan.l"
 linenum := linenum + 1; ECHO;
				-- treat as a comment;
			

when 3 => 
--# line 50 "ascan.l"
 linenum := linenum + 1; ECHO; 

when 4 => 
--# line 51 "ascan.l"
 return ( SCDECL ); 

when 5 => 
--# line 52 "ascan.l"
 return ( XSCDECL ); 

when 6 => 
--# line 54 "ascan.l"
 return ( WHITESPACE ); 

when 7 => 
--# line 56 "ascan.l"

			sectnum := 2;
			misc.line_directive_out;
			ENTER(SECT2PROLOG);
			return ( SECTEND );
			

when 8 => 
--# line 63 "ascan.l"

			text_io.put( Standard_Error, "old-style lex command at line " );
			int_io.put( Standard_Error, linenum );
			text_io.put( Standard_Error, "ignored:" );
			text_io.new_line( Standard_Error );
			text_io.put( Standard_Error, ASCII.HT );
			text_io.put( Standard_Error, yytext(1..YYLength) );
			linenum := linenum + 1;
			

when 9 => 
--# line 73 "ascan.l"

			nmstr := vstr(yytext(1..YYLength));
			didadef := false;
			ENTER(PICKUPDEF);
			

when 10 => 
--# line 79 "ascan.l"
 nmstr := vstr(yytext(1..YYLength));
			  return NAME;
			

when 11 => 
--# line 82 "ascan.l"
 linenum := linenum + 1;
			  -- allows blank lines in section 1;
			

when 12 => 
--# line 85 "ascan.l"
 linenum := linenum + 1; return Newline; 

when 13 => 
--# line 86 "ascan.l"
 misc.synerr( "illegal character" );ENTER(RECOVER);

when 14 => 
--# line 88 "ascan.l"
 null;
			  -- separates name and definition;
			

when 15 => 
--# line 92 "ascan.l"

			nmdef := vstr(yytext(1..YYLength));

			i := tstring.len( nmdef );
			while ( i >= tstring.first ) loop
			    if ( (CHAR(nmdef,i) /= ' ') and
				 (CHAR(nmdef,i) /= ASCII.HT) ) then
				exit;
			    end if;
			    i := i - 1;
			end loop;

                        sym.ndinstal( nmstr,
				tstring.slice(nmdef, tstring.first, i) );
			didadef := true;
			

when 16 => 
--# line 109 "ascan.l"

			if ( not didadef ) then
			    misc.synerr( "incomplete name definition" );
			end if;
			ENTER(0);
			linenum := linenum + 1;
			

when 17 => 
--# line 117 "ascan.l"
 linenum := linenum + 1;
			  ENTER(0);
			  nmstr := vstr(yytext(1..YYLength));
			  return NAME;
			

when 18 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
yy_cp := yy_cp - 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 123 "ascan.l"

			linenum := linenum + 1;
			ACTION_ECHO;
			MARK_END_OF_PROLOG;
			ENTER(SECT2);
			

when 19 => 
--# line 130 "ascan.l"
 linenum := linenum + 1; ACTION_ECHO; 

when YY_END_OF_BUFFER +SECT2PROLOG + 1 
 =>
--# line 132 "ascan.l"
 MARK_END_OF_PROLOG;
			  return End_Of_Input;
			

when 21 => 
--# line 136 "ascan.l"
 linenum := linenum + 1;
			  -- allow blank lines in sect2;

			-- this rule matches indented lines which
			-- are not comments.
when 22 => 
--# line 141 "ascan.l"

			misc.synerr("indented code found outside of action");
			linenum := linenum + 1;
			

when 23 => 
--# line 146 "ascan.l"
 ENTER(SC); return ( '<' ); 

when 24 => 
--# line 147 "ascan.l"
 return ( '^' );  

when 25 => 
--# line 148 "ascan.l"
 ENTER(QUOTE); return ( '"' ); 

when 26 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
 yy_cp := yy_bp + 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 149 "ascan.l"
 ENTER(NUM); return ( '{' ); 

when 27 => 
--# line 150 "ascan.l"
 ENTER(BRACEERROR); 

when 28 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
 yy_cp := yy_bp + 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 151 "ascan.l"
 return ( '$' ); 

when 29 => 
--# line 153 "ascan.l"
 continued_action := true;
			  linenum := linenum + 1;
			  return Newline;
			

when 30 => 
--# line 158 "ascan.l"
 linenum := linenum + 1; ACTION_ECHO; 

when 31 => 
--# line 160 "ascan.l"

			-- this rule is separate from the one below because
			-- otherwise we get variable trailing context, so
			-- we can't build the scanner using -f,F

			bracelevel := 0;
			continued_action := false;
			ENTER(ACTION);
			return Newline;
			

when 32 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
yy_cp := yy_cp - 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 171 "ascan.l"

			bracelevel := 0;
			continued_action := false;
			ENTER(ACTION);
			return Newline;
			

when 33 => 
--# line 178 "ascan.l"
 linenum := linenum + 1; return Newline; 

when 34 => 
--# line 180 "ascan.l"
 return ( EOF_OP ); 

when 35 => 
--# line 182 "ascan.l"

			sectnum := 3;
			ENTER(SECT3);
			return ( End_Of_Input );
			-- to stop the parser
			

when 36 => 
--# line 189 "ascan.l"


			nmstr := vstr(yytext(1..YYLength));

			-- check to see if we've already encountered this ccl
                        cclval := sym.ccllookup( nmstr );
			if ( cclval /= 0 ) then
			    yylval := cclval;
			    cclreuse := cclreuse + 1;
			    return ( PREVCCL );
			else
			    -- we fudge a bit.  We know that this ccl will
			    -- soon be numbered as lastccl + 1 by cclinit
			    sym.cclinstal( nmstr, lastccl + 1 );

			    -- push back everything but the leading bracket
			    -- so the ccl can be rescanned

			    PUT_BACK_STRING(nmstr, 1);

			    ENTER(FIRSTCCL);
			    return ( '[' );
			end if;
			

when 37 => 
--# line 214 "ascan.l"

			nmstr := vstr(yytext(1..YYLength));
			-- chop leading and trailing brace
			tmpbuf := slice(vstr(yytext(1..YYLength)),
								2, YYLength-1);

			nmdefptr := sym.ndlookup( tmpbuf );
			if ( nmdefptr = NUL ) then
			    misc.synerr( "undefined {name}" );
			else
			    -- push back name surrounded by ()'s
			    unput(')');
			    PUT_BACK_STRING(nmdefptr, 0);
			    unput('(');
			end if;
			

when 38 => 
--# line 231 "ascan.l"
 tmpbuf := vstr(yytext(1..YYLength));
			  case tstring.CHAR(tmpbuf,1) is
				when '/' => return '/';
				when '|' => return '|';
				when '*' => return '*';
				when '+' => return '+';
				when '?' => return '?';
				when '.' => return '.';
				when '(' => return '(';
				when ')' => return ')';
				when others =>
					misc.aflexerror("error in aflex case");
			  end case;
			

when 39 => 
--# line 245 "ascan.l"
 tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			

when 40 => 
--# line 249 "ascan.l"
 linenum := linenum + 1; return Newline; 

when 41 => 
--# line 252 "ascan.l"
 return ( ',' ); 

when 42 => 
--# line 253 "ascan.l"
 ENTER(SECT2); return ( '>' ); 

when 43 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
 yy_cp := yy_bp + 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 254 "ascan.l"
 ENTER(CARETISBOL); return ( '>' ); 

when 44 => 
--# line 255 "ascan.l"
 nmstr := vstr(yytext(1..YYLength));
			  return NAME;
			

when 45 => 
--# line 258 "ascan.l"
 misc.synerr( "bad start condition name" ); 

when 46 => 
--# line 260 "ascan.l"
 ENTER(SECT2); return ( '^' ); 

when 47 => 
--# line 263 "ascan.l"
 tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			

when 48 => 
--# line 267 "ascan.l"
 ENTER(SECT2); return ( '"' ); 

when 49 => 
--# line 269 "ascan.l"

			misc.synerr( "missing quote" );
			ENTER(SECT2);
			linenum := linenum + 1;
			return ( '"' );
			

when 50 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
 yy_cp := yy_bp + 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 277 "ascan.l"
 ENTER(CCL); return ( '^' ); 

when 51 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
 yy_cp := yy_bp + 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 278 "ascan.l"
 return ( '^' ); 

when 52 => 
--# line 279 "ascan.l"
 ENTER(CCL); yylval := CHARACTER'POS('-'); return ( CHAR ); 

when 53 => 
--# line 280 "ascan.l"
 ENTER(CCL);
			  tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			

when 54 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
 yy_cp := yy_bp + 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 286 "ascan.l"
 return ( '-' ); 

when 55 => 
--# line 287 "ascan.l"
 tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			

when 56 => 
--# line 291 "ascan.l"
 ENTER(SECT2); return ( ']' ); 

when 57 => 
--# line 294 "ascan.l"

			yylval := misc.myctoi( vstr(yytext(1..YYLength)) );
			return ( NUMBER );
			

when 58 => 
--# line 299 "ascan.l"
 return ( ',' ); 

when 59 => 
--# line 300 "ascan.l"
 ENTER(SECT2); return ( '}' ); 

when 60 => 
--# line 302 "ascan.l"

			misc.synerr( "bad character inside {}'s" );
			ENTER(SECT2);
			return ( '}' );
			

when 61 => 
--# line 308 "ascan.l"

			misc.synerr( "missing }" );
			ENTER(SECT2);
			linenum := linenum + 1;
			return ( '}' );
			

when 62 => 
--# line 316 "ascan.l"
 misc.synerr( "bad name in {}'s" ); ENTER(SECT2); 

when 63 => 
--# line 317 "ascan.l"
 misc.synerr( "missing }" );
			  linenum := linenum + 1;
			  ENTER(SECT2);
			

when 64 => 
--# line 322 "ascan.l"
 bracelevel := bracelevel + 1; 

when 65 => 
--# line 323 "ascan.l"
 bracelevel := bracelevel - 1; 

when 66 => 
--# line 324 "ascan.l"
 ACTION_ECHO; 

when 67 => 
--# line 325 "ascan.l"
 ACTION_ECHO; 

when 68 => 
--# line 326 "ascan.l"
 linenum := linenum + 1; ACTION_ECHO; 

when 69 => 
--# line 327 "ascan.l"
 ACTION_ECHO;
				  -- character constant;
			

when 70 => 
--# line 331 "ascan.l"
 ACTION_ECHO; ENTER(ACTION_STRING); 

when 71 => 
--# line 333 "ascan.l"

			linenum := linenum + 1;
			ACTION_ECHO;
			if ( bracelevel = 0 ) then
			    text_io.new_line ( temp_action_file );
			    ENTER(SECT2);
	                end if;
			

when 72 => 
--# line 341 "ascan.l"
 ACTION_ECHO; 

when 73 => 
--# line 343 "ascan.l"
 ACTION_ECHO; 

when 74 => 
--# line 344 "ascan.l"
 ACTION_ECHO; 

when 75 => 
--# line 345 "ascan.l"
 linenum := linenum + 1; ACTION_ECHO; 

when 76 => 
--# line 346 "ascan.l"
 ACTION_ECHO; ENTER(ACTION); 

when 77 => 
--# line 347 "ascan.l"
 ACTION_ECHO; 

when 78 => 
--# line 350 "ascan.l"

			yylval := CHARACTER'POS(misc.myesc( vstr(yytext(1..YYLength)) ));
			return ( CHAR );
			

when 79 => 
--# line 355 "ascan.l"

			yylval := CHARACTER'POS(misc.myesc( vstr(yytext(1..YYLength)) ));
			ENTER(CCL);
			return ( CHAR );
			

when 80 => 
--# line 362 "ascan.l"
 if ( check_yylex_here ) then
				return End_Of_Input;
			  else
				ECHO;
			  end if;
			

when 81 => 
--# line 368 "ascan.l"
raise AFLEX_SCANNER_JAMMED;
when YY_END_OF_BUFFER + INITIAL + 1 |
YY_END_OF_BUFFER + SECT2 + 1 |
YY_END_OF_BUFFER + SECT3 + 1 |
YY_END_OF_BUFFER + PICKUPDEF + 1 |
YY_END_OF_BUFFER + SC + 1 |
YY_END_OF_BUFFER + CARETISBOL + 1 |
YY_END_OF_BUFFER + NUM + 1 |
YY_END_OF_BUFFER + QUOTE + 1 |
YY_END_OF_BUFFER + FIRSTCCL + 1 |
YY_END_OF_BUFFER + CCL + 1 |
YY_END_OF_BUFFER + ACTION + 1 |
YY_END_OF_BUFFER + RECOVER + 1 |
YY_END_OF_BUFFER + BRACEERROR + 1 |
YY_END_OF_BUFFER + ACTION_STRING + 1 => 
    return End_Of_Input;
                when YY_END_OF_BUFFER =>
                    -- undo the effects of YY_DO_BEFORE_ACTION
                    yy_ch_buf(yy_cp) := yy_hold_char;

                    yytext_ptr := yy_bp;

                    case yy_get_next_buffer is
                        when EOB_ACT_END_OF_FILE =>
                            begin
                            if ( yywrap ) then
                                -- note: because we've taken care in
                                -- yy_get_next_buffer() to have set up yytext,
                                -- we can now set up yy_c_buf_p so that if some
                                -- total hoser (like aflex itself) wants
                                -- to call the scanner after we return the
                                -- End_Of_Input, it'll still work - another
                                -- End_Of_Input will get returned.

                                yy_c_buf_p := yytext_ptr;

                                yy_act := YY_STATE_EOF((yy_start - 1) / 2);

                                goto do_action;
                            else
                                --  start processing a new file
                                yy_init := true;
                                goto new_file;
                            end if;
                            end;
                        when EOB_ACT_RESTART_SCAN =>
                            yy_c_buf_p := yytext_ptr;
                            yy_hold_char := yy_ch_buf(yy_c_buf_p);
                        when EOB_ACT_LAST_MATCH =>
                            yy_c_buf_p := yy_n_chars;
                            yy_current_state := yy_get_previous_state;

                            yy_cp := yy_c_buf_p;
                            yy_bp := yytext_ptr;
                            goto next_action;
                        when others => null;
                        end case; -- case yy_get_next_buffer()
                when others =>
                    text_io.put( "action # " );
                    text_io.put( INTEGER'IMAGE(yy_act) );
                    text_io.new_line;
                    raise AFLEX_INTERNAL_ERROR;
            end case; -- case (yy_act)
        end loop; -- end of loop waiting for end of file
end YYLex;
--# line 368 "ascan.l"
begin
    if (call_yylex) then
    	toktype := YYLex;
    	call_yylex := false;
    	return toktype;
    end if;

    if ( eofseen ) then
	toktype := End_Of_Input;
    else
	toktype := YYLex;
    end if;
-- this tracing code allows easy tracing of aflex runs
if (trace) then
text_io.new_line(Standard_Error);
text_io.put(Standard_Error, "toktype = :" );
text_io.put(Standard_Error, Token'image(toktype));
text_io.put_line(Standard_Error, ":" );
end if;

    if ( toktype = End_Of_Input ) then
	eofseen := true;

	if ( sectnum = 1 ) then
	    misc.synerr(  "unexpected EOF" );
	    sectnum := 2;
	    toktype := SECTEND;
	else
	    if ( sectnum = 2 ) then
	    	sectnum := 3;
	    	toktype := SECTEND;
	    end if;
    	end if;
    end if;
    
    if ( trace ) then
	if ( beglin ) then
	    int_io.put( Standard_Error, num_rules + 1 );
	    text_io.put( Standard_Error, ASCII.HT );
	    beglin := false;
    	end if;

	case toktype is
	    when '<' | '>'|'^'|'$'|'"'|'['|']'|'{'|'}'|'|'|'('|
    	    	 ')'|'-'|'/'|'?'|'.'|'*'|'+'|',' =>
		text_io.put( Standard_Error, Token'image(toktype) );

	    when NEWLINE =>
		text_io.new_line(Standard_Error);
		if ( sectnum = 2 ) then
		    beglin := true;
    	    	end if;

	    when SCDECL =>
		text_io.put( Standard_Error, "%s" );

	    when XSCDECL =>
   		text_io.put( Standard_Error, "%x" );

	    when WHITESPACE =>
       		text_io.put( Standard_Error, " " );

	    when SECTEND =>
       		text_io.put_line( Standard_Error, "%%" );	   

		-- we set beglin to be true so we'll start
		-- writing out numbers as we echo rules.  aflexscan() has
		-- already assigned sectnum

		if ( sectnum = 2 ) then
		    beglin := true;
    	    	end if;

	    when NAME =>
		text_io.put( Standard_Error, ''' );
		text_io.put( Standard_Error, YYText);
		text_io.put( Standard_Error, ''' );

	    when CHAR =>
	    	if ( (yylval < CHARACTER'POS(' ')) or
		     (yylval = CHARACTER'POS(ASCII.DEL)) ) then
		    text_io.put( Standard_Error, '\' );
		    int_io.put( Standard_Error, yylval );
    		    text_io.put( Standard_Error, '\' );
		else
		    text_io.put( Standard_Error, Token'image(toktype) );
    	    	end if;

	    when NUMBER =>
    	    	int_io.put( Standard_Error, yylval );

	    when PREVCCL =>
		text_io.put( Standard_Error, '[' );
   	    	int_io.put( Standard_Error, yylval );
		text_io.put( Standard_Error, ']' );		

    	    when End_Of_Input =>
    	    	text_io.put( Standard_Error, "End Marker" );

	    when others =>
	    	text_io.put( Standard_Error, "Something weird:" );
		text_io.put_line( Standard_Error, Token'image(toktype));
    	end case;
    end if;
	    
    return toktype;

end get_token;
end scanner;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/GEN/scanner.ads version [7b2d6855fc].

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
pragma Warnings(Off);
pragma Style_Checks(Off);

-- A lexical scanner generated by aflex
with text_io; use text_io;
with ascan_dfa; use ascan_dfa; 
with ascan_io; use ascan_io; 
--# line 1 "ascan.l"
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
-- TITLE scanner specification file
-- AUTHOR: John Self (UCI)
-- DESCRIPTION regular expressions and actions matching tokens
--             that aflex expects to find in its input.
-- NOTES input to aflex (NOT alex.)  It uses exclusive start conditions
--       and case insensitive scanner generation available only in aflex
--       (or flex if you use C.)
--       generate scanner using the command 'aflex -is ascan.l'
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/ascan.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 
--# line 44 "ascan.l"


with misc_defs, Aflex_misc, sym, parse_tokens, int_io;
with tstring, ascan_dfa, ascan_io, external_file_manager;
use misc_defs, parse_tokens, tstring;
use ascan_dfa, ascan_io, external_file_manager;

package scanner is
    package misc renames Aflex_misc;
    call_yylex : boolean := false;
    function get_token return Token;
end scanner;

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
































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/aflex.adb version [ee96920c94].

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
pragma Style_Checks(Off);

-- TITLE aflex - main program
--
-- AUTHOR: John Self (UCI)
-- DESCRIPTION main subprogram of aflex, calls the major routines in order
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/aflex.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 
--*************************************************************************** 
--                              aflex
--                          version 1.4a
--***************************************************************************
--
--                            Arcadia Project
--               Department of Information and Computer Science
--                        University of California
--                        Irvine, California 92717
--
--    Send requests for aflex information to alex-info@ics.uci.edu
--
--    Send bug reports for aflex to alex-bugs@ics.uci.edu
--
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
--    This program is based on the flex program written by Vern Paxson.
--
--    The following is the copyright notice from flex, from which aflex is
--    derived.
--	Copyright (c) 1989 The Regents of the University of California.
--	All rights reserved.
--
--	This code is derived from software contributed to Berkeley by
--	Vern Paxson.
--
--      The United States Government has rights in this work pursuant to
--	contract no. DE-AC03-76SF00098 between the United States Department of
--	Energy and the University of California.
--
--	Redistribution and use in source and binary forms are permitted
--	provided that the above copyright notice and this paragraph are
--	duplicated in all such forms and that any documentation,
--	advertising materials, and other materials related to such
--	distribution and use acknowledge that the software was developed
--	by the University of California, Berkeley.  The name of the
--	University may not be used to endorse or promote products derived
--	from this software without specific prior written permission.
--	THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
--	IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--	WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
--***************************************************************************

with Ada.Command_Line;
with MAIN_BODY, DFA, GEN, MISC_DEFS, TEXT_IO, Aflex_MISC; 
with TSTRING, TEMPLATE_MANAGER, EXTERNAL_FILE_MANAGER; use MISC_DEFS, TEXT_IO, 
  TSTRING, EXTERNAL_FILE_MANAGER; 
procedure AFLEX is
	copyright : constant string :=
    "@(#) Copyright (c) 1990 Regents of the University of California.";
    	copyright2 : constant string :=
    "All rights reserved.";
begin
  MAIN_BODY.AFLEXINIT; 

  MAIN_BODY.READIN; 

  if (SYNTAXERROR) then 
    MAIN_BODY.AFLEXEND(1); 
  end if; 

  if (PERFORMANCE_REPORT) then 
    if (INTERACTIVE) then 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, 
        "-I (interactive) entails a minor performance penalty"); 
    end if; 


  end if; 

  if (VARIABLE_TRAILING_CONTEXT_RULES) then 
    Aflex_MISC.AFLEXERROR("can't handle variable trailing context rules"); 
  end if; 

  -- convert the ndfa to a dfa
  DFA.NTOD; 

  -- generate the Ada state transition tables from the DFA
  GEN.MAKE_TABLES; 

  TEMPLATE_MANAGER.GENERATE_IO_FILE; 
  TEMPLATE_MANAGER.GENERATE_DFA_FILE; 
  MAIN_BODY.AFLEXEND(0); 
exception
  when MAIN_BODY.AFLEX_TERMINATE => 
    Ada.Command_Line.Set_Exit_Status(
      Ada.Command_Line.Exit_Status(MAIN_BODY.TERMINATION_STATUS));
end AFLEX; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/aflex_command_line_interface.adb version [f31717ea10].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE command line interface
-- AUTHOR: John Self (UCI)
-- DESCRIPTION command line interface body for use with the VERDIX VADS system.
-- NOTES this file is system dependent
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/command_line_interface.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with TSTRING; use TSTRING; 
with Ada.Command_Line; use Ada.Command_Line;

package body Aflex_COMMAND_LINE_INTERFACE is 
  procedure INITIALIZE_COMMAND_LINE is 
  begin
      for i in 1 .. Ada.Command_Line.Argument_Count
      loop
        ARGV(i):= vstr(Argument(i));
      end loop;
      ARGC := Ada.Command_Line.Argument_Count + 1;
  end INITIALIZE_COMMAND_LINE; 

end Aflex_COMMAND_LINE_INTERFACE; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<














































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/aflex_command_line_interface.ads version [9e9e48363f].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE command line interface
-- AUTHOR: John Self (UCI)
-- DESCRIPTION command line interface body for use with the VERDIX VADS system.
-- NOTES this file is system dependent
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/command_line.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with TSTRING; use TSTRING; 
package Aflex_COMMAND_LINE_INTERFACE is 
  MAX_NUMBER_ARGS : INTEGER := 32; 
  type COMMAND_VECTOR is array(0 .. MAX_NUMBER_ARGS) of VSTRING; 
  procedure INITIALIZE_COMMAND_LINE; 
  ARGV : COMMAND_VECTOR; 
  ARGC : INTEGER; 
end Aflex_COMMAND_LINE_INTERFACE; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/aflex_misc.adb version [e41fb9e3be].

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
pragma Warnings(Off);
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE  miscellaneous aflex routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION
-- NOTES contains functions used in various places throughout aflex.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/misc.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TSTRING, TEXT_IO, Aflex_MISC, MAIN_BODY; 
with INT_IO, CALENDAR, EXTERNAL_FILE_MANAGER; use Aflex_MISC, MISC_DEFS, TEXT_IO, 
  EXTERNAL_FILE_MANAGER; 

package body Aflex_MISC is 
  use TSTRING; 
  -- action_out - write the actions from the temporary file to lex.yy.c

  procedure ACTION_OUT is 
    BUF : VSTRING; 
  begin
    while (not TEXT_IO.END_OF_FILE(TEMP_ACTION_FILE)) loop
      TSTRING.GET_LINE(TEMP_ACTION_FILE, BUF); 
      if ((TSTRING.LEN(BUF) >= 2) and then ((CHAR(BUF, 1) = '%') and (CHAR(BUF, 
        2) = '%'))) then 
        exit; 
      else 
        TSTRING.PUT_LINE(BUF); 
      end if; 
    end loop; 
  end ACTION_OUT; 

  -- bubble - bubble sort an integer array in increasing order
  --
  -- description
  --   sorts the first n elements of array v and replaces them in
  --   increasing order.
  --
  -- passed
  --   v - the array to be sorted
  --   n - the number of elements of 'v' to be sorted

  procedure BUBBLE(V : in INT_PTR; 
                   N : in INTEGER) is 
    K : INTEGER; 
  begin
    for I in reverse 2 .. N loop
      for J in 1 .. I - 1 loop
        if (V(J) > V(J + 1)) then 

          -- compare
          K := V(J); 

          -- exchange
          V(J) := V(J + 1); 
          V(J + 1) := K; 
        end if; 
      end loop; 
    end loop; 
  end BUBBLE; 


  -- clower - replace upper-case letter to lower-case

  function CLOWER(C : in INTEGER) return INTEGER is 
  begin
    if (ISUPPER(CHARACTER'VAL(C))) then 
      return TOLOWER(C); 
    else 
      return C; 
    end if; 
  end CLOWER; 


  -- cshell - shell sort a character array in increasing order
  --
  -- description
  --   does a shell sort of the first n elements of array v.
  --
  -- passed
  --   v - array to be sorted
  --   n - number of elements of v to be sorted

  procedure CSHELL(V : in out CHAR_ARRAY; 
                   N : in INTEGER) is 
    GAP, J, JG  : INTEGER; 
    K           : CHARACTER; 
    LOWER_BOUND : INTEGER := V'FIRST; 
  begin
    GAP := N/2; 
    while GAP > 0 loop
      for I in GAP .. N - 1 loop
        J := I - GAP; 
        while (J >= 0) loop
          JG := J + GAP; 

          if (V(J + LOWER_BOUND) <= V(JG + LOWER_BOUND)) then 
            exit; 
          end if; 

          K := V(J + LOWER_BOUND); 
          V(J + LOWER_BOUND) := V(JG + LOWER_BOUND); 
          V(JG + LOWER_BOUND) := K; 
          J := J - GAP; 
        end loop; 
      end loop; 
      GAP := GAP/2; 
    end loop; 
  end CSHELL; 


  -- dataend - finish up a block of data declarations

  procedure DATAEND is 
  begin
    if (DATAPOS > 0) then 
      DATAFLUSH; 

      -- add terminator for initialization
      TEXT_IO.PUT_LINE("    ) ;"); 
      TEXT_IO.NEW_LINE; 

      DATALINE := 0; 
    end if; 
  end DATAEND; 


  -- dataflush - flush generated data statements

  procedure DATAFLUSH(FILE : in FILE_TYPE) is 
  begin
    TEXT_IO.NEW_LINE(FILE); 
    DATALINE := DATALINE + 1; 
    if (DATALINE >= NUMDATALINES) then 

      -- put out a blank line so that the table is grouped into
      -- large blocks that enable the user to find elements easily
      TEXT_IO.NEW_LINE(FILE); 
      DATALINE := 0; 
    end if; 

    -- reset the number of characters written on the current line
    DATAPOS := 0; 
  end DATAFLUSH; 

  procedure DATAFLUSH is 
  begin
    DATAFLUSH(CURRENT_OUTPUT); 
  end DATAFLUSH; 
  -- aflex_gettime - return current time

  function AFLEX_GETTIME return VSTRING is 
    use TSTRING, CALENDAR; 
    CURRENT_TIME                                            : TIME; 
    CURRENT_YEAR                                            : YEAR_NUMBER; 
    CURRENT_MONTH                                           : MONTH_NUMBER; 
    CURRENT_DAY                                             : DAY_NUMBER; 
    CURRENT_SECONDS                                         : DAY_DURATION; 
    MONTH_STRING, HOUR_STRING, MINUTE_STRING, SECOND_STRING : VSTRING; 
    HOUR, MINUTE, SECOND                                    : INTEGER; 
    SECONDS_PER_HOUR                                        : constant 
      DAY_DURATION := 3600.0; 
  begin
    CURRENT_TIME := CLOCK; 
    SPLIT(CURRENT_TIME, CURRENT_YEAR, CURRENT_MONTH, CURRENT_DAY, 
      CURRENT_SECONDS); 
    case CURRENT_MONTH is 
      when 1 => 
        MONTH_STRING := VSTR("Jan"); 
      when 2 => 
        MONTH_STRING := VSTR("Feb"); 
      when 3 => 
        MONTH_STRING := VSTR("Mar"); 
      when 4 => 
        MONTH_STRING := VSTR("Apr"); 
      when 5 => 
        MONTH_STRING := VSTR("May"); 
      when 6 => 
        MONTH_STRING := VSTR("Jun"); 
      when 7 => 
        MONTH_STRING := VSTR("Jul"); 
      when 8 => 
        MONTH_STRING := VSTR("Aug"); 
      when 9 => 
        MONTH_STRING := VSTR("Sep"); 
      when 10 => 
        MONTH_STRING := VSTR("Oct"); 
      when 11 => 
        MONTH_STRING := VSTR("Nov"); 
      when 12 => 
        MONTH_STRING := VSTR("Dec"); 
    end case; 

    HOUR := INTEGER(CURRENT_SECONDS)/INTEGER(SECONDS_PER_HOUR);
    MINUTE := INTEGER((CURRENT_SECONDS - (HOUR*SECONDS_PER_HOUR))/60); 
    SECOND := INTEGER(CURRENT_SECONDS - HOUR*SECONDS_PER_HOUR - MINUTE*60.0); 

    if (HOUR >= 10) then 
      HOUR_STRING := VSTR(INTEGER'IMAGE(HOUR)); 
    else 
      HOUR_STRING := VSTR("0" & INTEGER'IMAGE(HOUR)); 
    end if; 

    if (MINUTE >= 10) then 
      MINUTE_STRING := VSTR(INTEGER'IMAGE(MINUTE)(2 .. INTEGER'IMAGE(MINUTE)'
        LENGTH)); 
    else 
      MINUTE_STRING := VSTR("0" & INTEGER'IMAGE(MINUTE)(2 .. INTEGER'IMAGE(
        MINUTE)'LENGTH)); 
    end if; 

    if (SECOND >= 10) then 
      SECOND_STRING := VSTR(INTEGER'IMAGE(SECOND)(2 .. INTEGER'IMAGE(SECOND)'
        LENGTH)); 
    else 
      SECOND_STRING := VSTR("0" & INTEGER'IMAGE(SECOND)(2 .. INTEGER'IMAGE(
        SECOND)'LENGTH)); 
    end if; 

    return MONTH_STRING & VSTR(INTEGER'IMAGE(CURRENT_DAY)) & HOUR_STRING & ":"
      & MINUTE_STRING & ":" & SECOND_STRING & INTEGER'IMAGE(CURRENT_YEAR); 
  end AFLEX_GETTIME; 

  -- aflexerror - report an error message and terminate
  -- overloaded function, one for vstring, one for string.
  procedure AFLEXERROR(MSG : in VSTRING) is 
    use TEXT_IO; 
  begin
    TSTRING.PUT(STANDARD_ERROR, "aflex: " & MSG); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    MAIN_BODY.AFLEXEND(1); 
  end AFLEXERROR; 

  procedure AFLEXERROR(MSG : in STRING) is 
    use TEXT_IO; 
  begin
    TEXT_IO.PUT(STANDARD_ERROR, "aflex: " & MSG); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    MAIN_BODY.AFLEXEND(1); 
  end AFLEXERROR; 

  -- aflexfatal - report a fatal error message and terminate
  -- overloaded function, one for vstring, one for string.
  procedure AFLEXFATAL(MSG : in VSTRING) is 
    use TEXT_IO; 
  begin
    TSTRING.PUT(STANDARD_ERROR, "aflex: fatal internal error " & MSG); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    MAIN_BODY.AFLEXEND(1); 
  end AFLEXFATAL; 

  procedure AFLEXFATAL(MSG : in STRING) is 
    use TEXT_IO; 
  begin
    TEXT_IO.PUT(STANDARD_ERROR, "aflex: fatal internal error " & MSG); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    MAIN_BODY.AFLEXEND(1); 
  end AFLEXFATAL; 

  -- basename - find the basename of a file
  function BASENAME return VSTRING is 
    END_CHAR_POS : INTEGER := LEN(INFILENAME);
    START_CHAR_POS : INTEGER;
  begin
    if (END_CHAR_POS = 0) then 
      -- if reading standard input give everything this name
      return VSTR("aflex_yy"); 
    end if; 
    
    -- find out where the end of the basename is    
    while ((END_CHAR_POS >= 1) and then
           (CHAR(INFILENAME, END_CHAR_POS) /= '.')) loop
      END_CHAR_POS := END_CHAR_POS - 1; 
    end loop; 

    -- find out where the beginning of the basename is    
    START_CHAR_POS := END_CHAR_POS; -- start at the end of the basename
    while ((START_CHAR_POS > 1) and then
           (CHAR(INFILENAME, START_CHAR_POS) /= '/')) loop
    	START_CHAR_POS := START_CHAR_POS - 1; 
    end loop; 

    if (CHAR(INFILENAME, START_CHAR_POS) = '/') then
    	START_CHAR_POS := START_CHAR_POS + 1;
    end if;
    
    if (END_CHAR_POS >= 1) then 
      return SLICE(INFILENAME, START_CHAR_POS,  END_CHAR_POS - 1); 
    else 
      return INFILENAME; 
    end if; 
  end BASENAME; 

  -- line_directive_out - spit out a "# line" statement

  procedure LINE_DIRECTIVE_OUT(OUTPUT_FILE_NAME : in FILE_TYPE) is 
  begin
    if (GEN_LINE_DIRS) then 
      TEXT_IO.PUT(OUTPUT_FILE_NAME, "--# line "); 
      INT_IO.PUT(OUTPUT_FILE_NAME, LINENUM, 1); 
      TEXT_IO.PUT(OUTPUT_FILE_NAME, " """); 
      TSTRING.PUT(OUTPUT_FILE_NAME, INFILENAME); 
      TEXT_IO.PUT_LINE(OUTPUT_FILE_NAME, """"); 
    end if; 
  end LINE_DIRECTIVE_OUT; 


  procedure LINE_DIRECTIVE_OUT is 
  begin
    if (GEN_LINE_DIRS) then 
      TEXT_IO.PUT("--# line "); 
      INT_IO.PUT(LINENUM, 1); 
      TEXT_IO.PUT(" """); 
      TSTRING.PUT(INFILENAME); 
      TEXT_IO.PUT_LINE(""""); 
    end if; 
  end LINE_DIRECTIVE_OUT; 

  -- all_upper - returns true if a string is all upper-case
  function ALL_UPPER(STR : in VSTRING) return BOOLEAN is 
  begin
    for I in 1 .. LEN(STR) loop
      if (not ((CHAR(STR, I) >= 'A') and (CHAR(STR, I) <= 'Z'))) then 
        return FALSE; 
      end if; 
    end loop; 
    return TRUE; 
  end ALL_UPPER; 

  -- all_lower - returns true if a string is all lower-case
  function ALL_LOWER(STR : in VSTRING) return BOOLEAN is 
  begin
    for I in 1 .. LEN(STR) loop
      if (not ((CHAR(STR, I) >= 'a') and (CHAR(STR, I) <= 'z'))) then 
        return FALSE; 
      end if; 
    end loop; 
    return TRUE; 
  end ALL_LOWER; 

  -- mk2data - generate a data statement for a two-dimensional array
  --
  --  generates a data statement initializing the current 2-D array to "value"

  procedure MK2DATA(FILE  : in FILE_TYPE; 
                    VALUE : in INTEGER) is 
  begin

    if (DATAPOS >= NUMDATAITEMS) then 
      TEXT_IO.PUT(FILE, ','); 
      DATAFLUSH(FILE); 
    end if; 

    if (DATAPOS = 0) then 

      -- indent
      TEXT_IO.PUT(FILE, "    "); 
    else 
      TEXT_IO.PUT(FILE, ','); 
    end if; 

    DATAPOS := DATAPOS + 1; 

    INT_IO.PUT(FILE, VALUE, 5); 
  end MK2DATA; 

  procedure MK2DATA(VALUE : in INTEGER) is 
  begin
    MK2DATA(CURRENT_OUTPUT, VALUE); 
  end MK2DATA; 

  --
  --  generates a data statement initializing the current array element to
  --  "value"

  procedure MKDATA(VALUE : in INTEGER) is 
  begin
    if (DATAPOS >= NUMDATAITEMS) then 
      TEXT_IO.PUT(','); 
      DATAFLUSH; 
    end if; 

    if (DATAPOS = 0) then 

      -- indent
      TEXT_IO.PUT("    "); 
    else 
      TEXT_IO.PUT(','); 
    end if; 

    DATAPOS := DATAPOS + 1; 

    INT_IO.PUT(VALUE, 5); 
  end MKDATA; 


  -- myctoi - return the integer represented by a string of digits

  function MYCTOI(NUM_ARRAY : in VSTRING) return INTEGER is 
    TOTAL : INTEGER := 0; 
    CNT   : INTEGER := TSTRING.FIRST; 
  begin
    while (CNT <= TSTRING.LEN(NUM_ARRAY)) loop
      TOTAL := TOTAL*10; 
      TOTAL := TOTAL + CHARACTER'POS(CHAR(NUM_ARRAY, CNT)) - CHARACTER'POS('0')
        ; 
      CNT := CNT + 1; 
    end loop; 
    return TOTAL; 
  end MYCTOI; 


  -- myesc - return character corresponding to escape sequence

  function MYESC(ARR : in VSTRING) return CHARACTER is 
    use TEXT_IO; 
  begin
    case (CHAR(ARR, TSTRING.FIRST + 1)) is 
      when 'a' => 
        return ASCII.BEL; 
      when 'b' => 
        return ASCII.BS; 
      when 'f' => 
        return ASCII.FF; 
      when 'n' => 
        return ASCII.LF; 
      when 'r' => 
        return ASCII.CR; 
      when 't' => 
        return ASCII.HT; 
      when 'v' => 
        return ASCII.VT; 

      when '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' => 

        -- \<octal>
        declare
          C, ESC_CHAR : CHARACTER; 
          SPTR        : INTEGER := TSTRING.FIRST + 1; 
        begin
          ESC_CHAR := OTOI(TSTRING.SLICE(ARR, TSTRING.FIRST + 1, TSTRING.LEN(ARR
            ))); 
          if (ESC_CHAR = ASCII.NUL) then 
            Aflex_MISC.SYNERR("escape sequence for null not allowed"); 
            return ASCII.SOH; 
          end if; 

          return ESC_CHAR; 
        end; 
      when others => 
        return CHAR(ARR, TSTRING.FIRST + 1); 
    end case; 
  end MYESC; 


  -- otoi - convert an octal digit string to an integer value

  function OTOI(STR : in VSTRING) return CHARACTER is 
    TOTAL : INTEGER := 0; 
    CNT   : INTEGER := TSTRING.FIRST; 
  begin
    while (CNT <= TSTRING.LEN(STR)) loop
      TOTAL := TOTAL*8; 
      TOTAL := TOTAL + CHARACTER'POS(CHAR(STR, CNT)) - CHARACTER'POS('0'); 
      CNT := CNT + 1; 
    end loop; 
    return CHARACTER'VAL(TOTAL); 
  end OTOI; 


  -- readable_form - return the the human-readable form of a character
  --
  -- The returned string is in static storage.

  function READABLE_FORM(C : in CHARACTER) return VSTRING is 
  begin
    if ((CHARACTER'POS(C) >= 0 and CHARACTER'POS(C) < 32) or (C = ASCII.DEL))
      then 
      case C is 
        when ASCII.LF => 
          return (VSTR("\n")); 

        -- Newline
        when ASCII.HT => 
          return (VSTR("\t")); 

        -- Horizontal Tab
        when ASCII.FF => 
          return (VSTR("\f")); 

        -- Form Feed
        when ASCII.CR => 
          return (VSTR("\r")); 

        -- Carriage Return
        when ASCII.BS => 
          return (VSTR("\b")); 

        -- Backspace
        when others => 
          return VSTR("\" & INTEGER'IMAGE(CHARACTER'POS(C))); 
      end case; 
    elsif (C = ' ') then 
      return VSTR("' '"); 
    else 
      return VSTR(C); 
    end if; 
  end READABLE_FORM; 

  -- transition_struct_out - output a yy_trans_info structure
  --
  -- outputs the yy_trans_info structure with the two elements, element_v and
  -- element_n.  Formats the output with spaces and carriage returns.

  procedure TRANSITION_STRUCT_OUT(ELEMENT_V, ELEMENT_N : in INTEGER) is 
  begin
    INT_IO.PUT(ELEMENT_V, 7); 
    TEXT_IO.PUT(", "); 
    INT_IO.PUT(ELEMENT_N, 5); 
    TEXT_IO.PUT(","); 
    DATAPOS := DATAPOS + TRANS_STRUCT_PRINT_LENGTH; 

    if (DATAPOS >= 75) then 
      TEXT_IO.NEW_LINE; 

      DATALINE := DATALINE + 1; 
      if (DATALINE mod 10 = 0) then 
        TEXT_IO.NEW_LINE; 
      end if; 

      DATAPOS := 0; 
    end if; 
  end TRANSITION_STRUCT_OUT; 

  function SET_YY_TRAILING_HEAD_MASK(SRC : in INTEGER) return INTEGER is 
  begin
    if (CHECK_YY_TRAILING_HEAD_MASK(SRC) = 0) then 
      return SRC + YY_TRAILING_HEAD_MASK; 
    else 
      return SRC; 
    end if; 
  end SET_YY_TRAILING_HEAD_MASK; 

  function CHECK_YY_TRAILING_HEAD_MASK(SRC : in INTEGER) return INTEGER is 
  begin
    if (SRC >= YY_TRAILING_HEAD_MASK) then 
      return YY_TRAILING_HEAD_MASK; 
    else 
      return 0; 
    end if; 
  end CHECK_YY_TRAILING_HEAD_MASK; 

  function SET_YY_TRAILING_MASK(SRC : in INTEGER) return INTEGER is 
  begin
    if (CHECK_YY_TRAILING_MASK(SRC) = 0) then 
      return SRC + YY_TRAILING_MASK; 
    else 
      return SRC; 
    end if; 
  end SET_YY_TRAILING_MASK; 

  function CHECK_YY_TRAILING_MASK(SRC : in INTEGER) return INTEGER is 
  begin

-- this test is whether both bits are on, or whether onlyy TRAIL_MASK is set
    if ((SRC >= YY_TRAILING_HEAD_MASK + YY_TRAILING_MASK) or ((
      CHECK_YY_TRAILING_HEAD_MASK(SRC) = 0) and (SRC >= YY_TRAILING_MASK)))
      then 
      return YY_TRAILING_MASK; 
    else 
      return 0; 
    end if; 
  end CHECK_YY_TRAILING_MASK; 

  function ISLOWER(C : in CHARACTER) return BOOLEAN is 
  begin
    return (C in 'a' .. 'z'); 
  end ISLOWER; 


  function ISUPPER(C : in CHARACTER) return BOOLEAN is 
  begin
    return (C in 'A' .. 'Z'); 
  end ISUPPER; 

  function ISDIGIT(C : in CHARACTER) return BOOLEAN is 
  begin
    return (C in '0' .. '9'); 
  end ISDIGIT; 

  function TOLOWER(C : in INTEGER) return INTEGER is 
  begin
    return C - CHARACTER'POS('A') + CHARACTER'POS('a'); 
  end TOLOWER; 

  procedure SYNERR(STR : in STRING) is 
    use TEXT_IO; 
  begin
    SYNTAXERROR := TRUE; 
    TEXT_IO.PUT(STANDARD_ERROR, "Syntax error at line "); 
    INT_IO.PUT(STANDARD_ERROR, LINENUM); 
    TEXT_IO.PUT(STANDARD_ERROR, STR); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
  end SYNERR; 

end Aflex_MISC; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/aflex_misc.ads version [10ec4845c7].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE  miscellaneous aflex routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION
-- NOTES contains functions used in various places throughout aflex.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/misc.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TSTRING, TEXT_IO; 
package Aflex_MISC is 
  use MISC_DEFS; 
  use TSTRING; 
  use TEXT_IO; 
  procedure ACTION_OUT; 
  procedure BUBBLE(V : in INT_PTR; 
                   N : in INTEGER); 
  function CLOWER(C : in INTEGER) return INTEGER; 
  procedure CSHELL(V : in out CHAR_ARRAY; 
                   N : in INTEGER); 
  procedure DATAEND; 
  procedure DATAFLUSH; 
  procedure DATAFLUSH(FILE : in FILE_TYPE); 
  function AFLEX_GETTIME return VSTRING; 
  procedure AFLEXERROR(MSG : in VSTRING); 
  procedure AFLEXERROR(MSG : in STRING); 
  function ALL_UPPER(STR : in VSTRING) return BOOLEAN; 
  function ALL_LOWER(STR : in VSTRING) return BOOLEAN; 
  procedure AFLEXFATAL(MSG : in VSTRING); 
  procedure AFLEXFATAL(MSG : in STRING); 
  procedure LINE_DIRECTIVE_OUT; 
  procedure LINE_DIRECTIVE_OUT(OUTPUT_FILE_NAME : in FILE_TYPE); 
  procedure MK2DATA(VALUE : in INTEGER); 
  procedure MK2DATA(FILE  : in FILE_TYPE; 
                    VALUE : in INTEGER); 
  procedure MKDATA(VALUE : in INTEGER); 
  function MYCTOI(NUM_ARRAY : in VSTRING) return INTEGER; 
  function MYESC(ARR : in VSTRING) return CHARACTER; 
  function OTOI(STR : in VSTRING) return CHARACTER; 
  function READABLE_FORM(C : in CHARACTER) return VSTRING; 
  procedure SYNERR(STR : in STRING); 
  procedure TRANSITION_STRUCT_OUT(ELEMENT_V, ELEMENT_N : in INTEGER); 
  function SET_YY_TRAILING_HEAD_MASK(SRC : in INTEGER) return INTEGER; 
  function CHECK_YY_TRAILING_HEAD_MASK(SRC : in INTEGER) return INTEGER; 
  function SET_YY_TRAILING_MASK(SRC : in INTEGER) return INTEGER; 
  function CHECK_YY_TRAILING_MASK(SRC : in INTEGER) return INTEGER; 
  function ISLOWER(C : in CHARACTER) return BOOLEAN; 
  function ISUPPER(C : in CHARACTER) return BOOLEAN; 
  function ISDIGIT(C : in CHARACTER) return BOOLEAN; 
  function TOLOWER(C : in INTEGER) return INTEGER; 
  function BASENAME return VSTRING; 
end Aflex_MISC; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/aflex_scanner.adb version [5f2a249a21].

1
2
3
4
5
6
7
8
9
10
11
pragma Style_Checks(Off);

with PARSE_TOKENS, SCANNER; use PARSE_TOKENS, SCANNER; 

package body AFLEX_SCANNER is 
  function YYLEX return TOKEN is 
  begin
    return SCANNER.GET_TOKEN; 
  end YYLEX; 

end AFLEX_SCANNER; 
<
<
<
<
<
<
<
<
<
<
<






















Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/aflex_scanner.ads version [8360476a48].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE  scanner parser interface
-- AUTHOR: John Self (UCI)
-- DESCRIPTION causes parser to call augmented version of YYLex.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/aflex_scanner.ada,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with PARSE_TOKENS, SCANNER; use PARSE_TOKENS, SCANNER; 

package AFLEX_SCANNER is 
  function YYLEX return TOKEN; 
end AFLEX_SCANNER; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


























































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/ascan.l version [330d319426].

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
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE scanner specification file
-- AUTHOR: John Self (UCI)
-- DESCRIPTION regular expressions and actions matching tokens
--             that aflex expects to find in its input.
-- NOTES input to aflex (NOT alex.)  It uses exclusive start conditions
--       and case insensitive scanner generation available only in aflex
--       (or flex if you use C.)
--       generate scanner using the command 'aflex -is ascan.l'
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/ascan.l,v 1.1 2011/03/02 23:41:49 stt Exp stt $ 

%x SECT2 SECT2PROLOG SECT3 PICKUPDEF SC CARETISBOL NUM QUOTE
%x FIRSTCCL CCL ACTION RECOVER BRACEERROR
%x ACTION_STRING

WS		[ \t\f]+
OPTWS		[ \t\f]*
NOT_WS		[^ \t\f\n]

NAME		[a-z_][a-z_0-9-]*
NOT_NAME	[^a-z_\n]+

SCNAME		{NAME}

ESCSEQ		\\([^\n]|[0-9]{1,3})

%%

^{WS}			{ indented_code := true; }
^#.*\n			{ linenum := linenum + 1; ECHO;
				-- treat as a comment;
			}
^{OPTWS}"--".*\n	{ linenum := linenum + 1; ECHO; }
^"%s"(tart)?		{ return ( SCDECL ); }
^"%x"			{ return ( XSCDECL ); }

{WS}			{ return ( WHITESPACE ); }

^"%%".*			{
			sectnum := 2;
			misc.line_directive_out;
			ENTER(SECT2PROLOG);
			return ( SECTEND );
			}

^"%"[^%sx]" ".*\n		{
			text_io.put( Standard_Error, "old-style lex command at line " );
			int_io.put( Standard_Error, linenum );
			text_io.put( Standard_Error, "ignored:" );
			text_io.new_line( Standard_Error );
			text_io.put( Standard_Error, ASCII.HT );
			text_io.put( Standard_Error, yytext(1..YYLength) );
			linenum := linenum + 1;
			}

^{NAME}			{
			nmstr := vstr(yytext(1..YYLength));
			didadef := false;
			ENTER(PICKUPDEF);
			}

{SCNAME}		{ nmstr := vstr(yytext(1..YYLength));
			  return NAME;
			}
^{OPTWS}\n		{ linenum := linenum + 1;
			  -- allows blank lines in section 1;
			}
{OPTWS}\n			{ linenum := linenum + 1; return Newline; }
.			{ misc.synerr( "illegal character" );ENTER(RECOVER);}

<PICKUPDEF>{WS}		{ null;
			  -- separates name and definition;
			}

<PICKUPDEF>{NOT_WS}.*	{
			nmdef := vstr(yytext(1..YYLength));

			i := tstring.len( nmdef );
			while ( i >= tstring.first ) loop
			    if ( (CHAR(nmdef,i) /= ' ') and
				 (CHAR(nmdef,i) /= ASCII.HT) ) then
				exit;
			    end if;
			    i := i - 1;
			end loop;

                        sym.ndinstal( nmstr,
				tstring.slice(nmdef, tstring.first, i) );
			didadef := true;
			}

<PICKUPDEF>\n		{
			if ( not didadef ) then
			    misc.synerr( "incomplete name definition" );
			end if;
			ENTER(0);
			linenum := linenum + 1;
			}

<RECOVER>.*\n		{ linenum := linenum + 1;
			  ENTER(0);
			  nmstr := vstr(yytext(1..YYLength));
			  return NAME;
			}

<SECT2PROLOG>.*\n/{NOT_WS}	{
			linenum := linenum + 1;
			ACTION_ECHO;
			MARK_END_OF_PROLOG;
			ENTER(SECT2);
			}

<SECT2PROLOG>.*\n	{ linenum := linenum + 1; ACTION_ECHO; }

<SECT2PROLOG><<EOF>>	{ MARK_END_OF_PROLOG;
			  return End_Of_Input;
			}

<SECT2>^{OPTWS}\n	{ linenum := linenum + 1;
			  -- allow blank lines in sect2;}
			
			-- this rule matches indented lines which
			-- are not comments.
<SECT2>^{WS}{NOT_WS}"--".*\n	{
			misc.synerr("indented code found outside of action");
			linenum := linenum + 1;
			}

<SECT2>"<"		{ ENTER(SC); return ( '<' ); }
<SECT2>^"^"		{ return ( '^' ); } 
<SECT2>\"		{ ENTER(QUOTE); return ( '"' ); }
<SECT2>"{"/[0-9]		{ ENTER(NUM); return ( '{' ); }
<SECT2>"{"[^0-9\n][^}\n]*	{ ENTER(BRACEERROR); }
<SECT2>"$"/[ \t\n]	{ return ( '$' ); }

<SECT2>{WS}"|".*\n	{ continued_action := true;
			  linenum := linenum + 1;
			  return Newline;
			}

<SECT2>^{OPTWS}"--".*\n	{ linenum := linenum + 1; ACTION_ECHO; }

<SECT2>{WS}		{
			-- this rule is separate from the one below because
			-- otherwise we get variable trailing context, so
			-- we can't build the scanner using -{f,F}

			bracelevel := 0;
			continued_action := false;
			ENTER(ACTION);
			return Newline;
			}

<SECT2>{OPTWS}/\n	{
			bracelevel := 0;
			continued_action := false;
			ENTER(ACTION);
			return Newline;
			}

<SECT2>^{OPTWS}\n	{ linenum := linenum + 1; return Newline; }

<SECT2>"<<EOF>>"	{ return ( EOF_OP ); }

<SECT2>^"%%".*		{
			sectnum := 3;
			ENTER(SECT3);
			return ( End_Of_Input );
			-- to stop the parser
			}

<SECT2>"["([^\\\]\n]|{ESCSEQ})+"]"	{

			nmstr := vstr(yytext(1..YYLength));

			-- check to see if we've already encountered this ccl
                        cclval := sym.ccllookup( nmstr );
			if ( cclval /= 0 ) then
			    yylval := cclval;
			    cclreuse := cclreuse + 1;
			    return ( PREVCCL );
			else
			    -- we fudge a bit.  We know that this ccl will
			    -- soon be numbered as lastccl + 1 by cclinit
			    sym.cclinstal( nmstr, lastccl + 1 );

			    -- push back everything but the leading bracket
			    -- so the ccl can be rescanned

			    PUT_BACK_STRING(nmstr, 1);

			    ENTER(FIRSTCCL);
			    return ( '[' );
			end if;
			}

<SECT2>"{"{NAME}"}"	{
			nmstr := vstr(yytext(1..YYLength));
			-- chop leading and trailing brace
			tmpbuf := slice(vstr(yytext(1..YYLength)),
								2, YYLength-1);

			nmdefptr := sym.ndlookup( tmpbuf );
			if ( nmdefptr = NUL ) then
			    misc.synerr( "undefined {name}" );
			else
			    -- push back name surrounded by ()'s
			    unput(')');
			    PUT_BACK_STRING(nmdefptr, 0);
			    unput('(');
			end if;
			}

<SECT2>[/|*+?.()]	{ tmpbuf := vstr(yytext(1..YYLength));
			  case tstring.CHAR(tmpbuf,1) is
				when '/' => return '/';
				when '|' => return '|';
				when '*' => return '*';
				when '+' => return '+';
				when '?' => return '?';
				when '.' => return '.';
				when '(' => return '(';
				when ')' => return ')';
				when others =>
					misc.aflexerror("error in aflex case");
			  end case;
			}
<SECT2>.		{ tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			}
<SECT2>\n		{ linenum := linenum + 1; return Newline; }


<SC>","			{ return ( ',' ); }
<SC>">"			{ ENTER(SECT2); return ( '>' ); }
<SC>">"/"^"		{ ENTER(CARETISBOL); return ( '>' ); }
<SC>{SCNAME}		{ nmstr := vstr(yytext(1..YYLength));
			  return NAME;
			}
<SC>.			{ misc.synerr( "bad start condition name" ); }

<CARETISBOL>"^"		{ ENTER(SECT2); return ( '^' ); }


<QUOTE>[^"\n]		{ tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			}
<QUOTE>\"		{ ENTER(SECT2); return ( '"' ); }

<QUOTE>\n		{
			misc.synerr( "missing quote" );
			ENTER(SECT2);
			linenum := linenum + 1;
			return ( '"' );
			}


<FIRSTCCL>"^"/[^-\n]	{ ENTER(CCL); return ( '^' ); }
<FIRSTCCL>"^"/-		{ return ( '^' ); }
<FIRSTCCL>-		{ ENTER(CCL); yylval := CHARACTER'POS('-'); return ( CHAR ); }
<FIRSTCCL>.		{ ENTER(CCL);
			  tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			}

<CCL>-/[^\]\n]		{ return ( '-' ); }
<CCL>[^\]\n]		{ tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			}
<CCL>"]"		{ ENTER(SECT2); return ( ']' ); }


<NUM>[0-9]+		{
			yylval := misc.myctoi( vstr(yytext(1..YYLength)) );
			return ( NUMBER );
			}

<NUM>","			{ return ( ',' ); }
<NUM>"}"			{ ENTER(SECT2); return ( '}' ); }

<NUM>.			{
			misc.synerr( "bad character inside {}'s" );
			ENTER(SECT2);
			return ( '}' );
			}

<NUM>\n			{
			misc.synerr( "missing }" );
			ENTER(SECT2);
			linenum := linenum + 1;
			return ( '}' );
			}


<BRACEERROR>"}"		{ misc.synerr( "bad name in {}'s" ); ENTER(SECT2); }
<BRACEERROR>\n		{ misc.synerr( "missing }" );
			  linenum := linenum + 1;
			  ENTER(SECT2);
			}

<ACTION>"{"		{ bracelevel := bracelevel + 1; }
<ACTION>"}"		{ bracelevel := bracelevel - 1; }
<ACTION>[^a-z_{}"'/\n]+	{ ACTION_ECHO; }
<ACTION>{NAME}		{ ACTION_ECHO; }
<ACTION>"--".*\n	{ linenum := linenum + 1; ACTION_ECHO; }
<ACTION>"'"([^'\\\n]|\\.)*"'"	{ ACTION_ECHO;
				  -- character constant;
			}

<ACTION>\"		{ ACTION_ECHO; ENTER(ACTION_STRING); }

<ACTION>\n		{
			linenum := linenum + 1;
			ACTION_ECHO;
			if ( bracelevel = 0 ) then
			    text_io.new_line ( temp_action_file );
			    ENTER(SECT2);
	                end if;
			}
<ACTION>.		{ ACTION_ECHO; }

<ACTION_STRING>[^"\\\n]+	{ ACTION_ECHO; }
<ACTION_STRING>\\.	{ ACTION_ECHO; }
<ACTION_STRING>\n	{ linenum := linenum + 1; ACTION_ECHO; }
<ACTION_STRING>\"	{ ACTION_ECHO; ENTER(ACTION); }
<ACTION_STRING>.	{ ACTION_ECHO; }


<SECT2,QUOTE,CCL>{ESCSEQ}	{
			yylval := CHARACTER'POS(misc.myesc( vstr(yytext(1..YYLength)) ));
			return ( CHAR );
			}

<FIRSTCCL>{ESCSEQ}	{
			yylval := CHARACTER'POS(misc.myesc( vstr(yytext(1..YYLength)) ));
			ENTER(CCL);
			return ( CHAR );
			}


<SECT3>.*(\n?)		{ if ( check_yylex_here ) then
				return End_Of_Input;
			  else
				ECHO;
			  end if;
			}
%%

with misc_defs, misc, sym, parse_tokens, int_io;
with tstring, ascan_dfa, ascan_io, external_file_manager;
use misc_defs, parse_tokens, tstring;
use ascan_dfa, ascan_io, external_file_manager;

package scanner is
    call_yylex : boolean := false;
    function get_token return Token;
end scanner;

package body scanner is

beglin : boolean := false;
i, bracelevel: integer;

function get_token return Token is
    toktype : Token;
    didadef, indented_code : boolean;
    cclval : integer;
    nmdefptr : vstring;
    nmdef, tmpbuf : vstring;

procedure ACTION_ECHO is
begin
    text_io.put( temp_action_file, yytext(1..YYLength) );
end ACTION_ECHO;

procedure MARK_END_OF_PROLOG is
begin
     text_io.put( temp_action_file, "%%%% end of prolog" );
     text_io.new_line( temp_action_file );
end MARK_END_OF_PROLOG;

procedure PUT_BACK_STRING(str : vstring; start : integer) is
begin
	for i in reverse start+1..tstring.len(str) loop
	    unput( CHAR(str,i) );
	end loop;
end PUT_BACK_STRING;

function check_yylex_here return boolean is
begin
	return ( (yytext'length >= 2) and then
			((yytext(1) = '#') and (yytext(2) = '#')));
end check_yylex_here;

##
begin
    if (call_yylex) then
    	toktype := YYLex;
    	call_yylex := false;
    	return toktype;
    end if;

    if ( eofseen ) then
	toktype := End_Of_Input;
    else
	toktype := YYLex;
    end if;
-- this tracing code allows easy tracing of aflex runs
if (trace) then
text_io.new_line(Standard_Error);
text_io.put(Standard_Error, "toktype = :" );
text_io.put(Standard_Error, Token'image(toktype));
text_io.put_line(Standard_Error, ":" );
end if;

    if ( toktype = End_Of_Input ) then
	eofseen := true;

	if ( sectnum = 1 ) then
	    misc.synerr(  "unexpected EOF" );
	    sectnum := 2;
	    toktype := SECTEND;
	else
	    if ( sectnum = 2 ) then
	    	sectnum := 3;
	    	toktype := SECTEND;
	    end if;
    	end if;
    end if;
    
    if ( trace ) then
	if ( beglin ) then
	    int_io.put( Standard_Error, num_rules + 1 );
	    text_io.put( Standard_Error, ASCII.HT );
	    beglin := false;
    	end if;

	case toktype is
	    when '<' | '>'|'^'|'$'|'"'|'['|']'|'{'|'}'|'|'|'('|
    	    	 ')'|'-'|'/'|'?'|'.'|'*'|'+'|',' =>
		text_io.put( Standard_Error, Token'image(toktype) );

	    when NEWLINE =>
		text_io.new_line(Standard_Error);
		if ( sectnum = 2 ) then
		    beglin := true;
    	    	end if;

	    when SCDECL =>
		text_io.put( Standard_Error, "%s" );

	    when XSCDECL =>
   		text_io.put( Standard_Error, "%x" );

	    when WHITESPACE =>
       		text_io.put( Standard_Error, " " );

	    when SECTEND =>
       		text_io.put_line( Standard_Error, "%%" );	   

		-- we set beglin to be true so we'll start
		-- writing out numbers as we echo rules.  aflexscan() has
		-- already assigned sectnum

		if ( sectnum = 2 ) then
		    beglin := true;
    	    	end if;

	    when NAME =>
		text_io.put( Standard_Error, ''' );
		text_io.put( Standard_Error, YYText);
		text_io.put( Standard_Error, ''' );

	    when CHAR =>
	    	if ( (yylval < CHARACTER'POS(' ')) or
		     (yylval = CHARACTER'POS(ASCII.DEL)) ) then
		    text_io.put( Standard_Error, '\' );
		    int_io.put( Standard_Error, yylval );
    		    text_io.put( Standard_Error, '\' );
		else
		    text_io.put( Standard_Error, Token'image(toktype) );
    	    	end if;

	    when NUMBER =>
    	    	int_io.put( Standard_Error, yylval );

	    when PREVCCL =>
		text_io.put( Standard_Error, '[' );
   	    	int_io.put( Standard_Error, yylval );
		text_io.put( Standard_Error, ']' );		

    	    when End_Of_Input =>
    	    	text_io.put( Standard_Error, "End Marker" );

	    when others =>
	    	text_io.put( Standard_Error, "Something weird:" );
		text_io.put_line( Standard_Error, Token'image(toktype));
    	end case;
    end if;
	    
    return toktype;

end get_token;
end scanner;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/ccl.adb version [a8712f7efc].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE character classes routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION routines for character classes like [abc]
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/ccl.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TEXT_IO, Aflex_MISC, TSTRING; use MISC_DEFS, TEXT_IO; 
package body CCL is 

-- ccladd - add a single character to a ccl
  procedure CCLADD(CCLP : in INTEGER; 
                   CH   : in CHARACTER) is 
    IND, LEN, NEWPOS : INTEGER; 
  begin
    LEN := CCLLEN(CCLP); 
    IND := CCLMAP(CCLP); 

    -- check to see if the character is already in the ccl
    for I in 0 .. LEN - 1 loop
      if (CCLTBL(IND + I) = CH) then 
        return; 
      end if; 
    end loop; 

    NEWPOS := IND + LEN; 

    if (NEWPOS >= CURRENT_MAX_CCL_TBL_SIZE) then 
      CURRENT_MAX_CCL_TBL_SIZE := CURRENT_MAX_CCL_TBL_SIZE + 
        MAX_CCL_TBL_SIZE_INCREMENT; 

      NUM_REALLOCS := NUM_REALLOCS + 1; 

      REALLOCATE_CHARACTER_ARRAY(CCLTBL, CURRENT_MAX_CCL_TBL_SIZE); 
    end if; 

    CCLLEN(CCLP) := LEN + 1; 
    CCLTBL(NEWPOS) := CH; 

  end CCLADD; 

  -- cclinit - make an empty ccl

  function CCLINIT return INTEGER is 
  begin
    LASTCCL := LASTCCL + 1; 
    if (LASTCCL >= CURRENT_MAXCCLS) then 
      CURRENT_MAXCCLS := CURRENT_MAXCCLS + MAX_CCLS_INCREMENT; 

      NUM_REALLOCS := NUM_REALLOCS + 1; 

      REALLOCATE_INTEGER_ARRAY(CCLMAP, CURRENT_MAXCCLS); 
      REALLOCATE_INTEGER_ARRAY(CCLLEN, CURRENT_MAXCCLS); 
      REALLOCATE_INTEGER_ARRAY(CCLNG, CURRENT_MAXCCLS); 
    end if; 

    if (LASTCCL = 1) then 

      -- we're making the first ccl
      CCLMAP(LASTCCL) := 0; 

    else 

      -- the new pointer is just past the end of the last ccl.  Since
      -- the cclmap points to the \first/ character of a ccl, adding the
      -- length of the ccl to the cclmap pointer will produce a cursor
      -- to the first free space
      CCLMAP(LASTCCL) := CCLMAP(LASTCCL - 1) + CCLLEN(LASTCCL - 1); 
    end if; 

    CCLLEN(LASTCCL) := 0; 
    CCLNG(LASTCCL) := 0; 

    -- ccl's start out life un-negated
    return LASTCCL; 
  end CCLINIT; 

  -- cclnegate - negate a ccl

  procedure CCLNEGATE(CCLP : in INTEGER) is 
  begin
    CCLNG(CCLP) := 1; 
  end CCLNEGATE; 

  -- list_character_set - list the members of a set of characters in CCL form
  --
  -- writes to the given file a character-class representation of those
  -- characters present in the given set.  A character is present if it
  -- has a non-zero value in the set array.

  procedure LIST_CHARACTER_SET(F    : in FILE_TYPE; 
                               CSET : in C_SIZE_BOOL_ARRAY) is 
    I, START_CHAR : INTEGER; 
  begin
    TEXT_IO.PUT(F, '['); 

    I := 1; 
    while (I <= CSIZE) loop
      if (CSET(I)) then 
        START_CHAR := I; 

        TEXT_IO.PUT(F, ' '); 

        TSTRING.PUT(F, Aflex_MISC.READABLE_FORM(CHARACTER'VAL(I))); 

        I := I + 1; 
        while ((I <= CSIZE) and then (CSET(I))) loop
          I := I + 1; 
        end loop; 

        if (I - 1 > START_CHAR) then 

          -- this was a run
          TEXT_IO.PUT(F, "-"); 
          TSTRING.PUT(F, Aflex_MISC.READABLE_FORM(CHARACTER'VAL(I - 1))); 
        end if; 

        TEXT_IO.PUT(F, ' '); 
      end if; 
      I := I + 1; 
    end loop; 

    TEXT_IO.PUT(F, ']'); 
  end LIST_CHARACTER_SET; 
end CCL; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/ccl.ads version [067eeb259a].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE character classes routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION routines for character classes like [abc]
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/ccl.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TEXT_IO; use MISC_DEFS, TEXT_IO; 
package CCL is 
  procedure CCLADD(CCLP : in INTEGER; 
                   CH   : in CHARACTER); 
  function CCLINIT return INTEGER; 
  procedure CCLNEGATE(CCLP : in INTEGER); 
  procedure LIST_CHARACTER_SET(F    : in FILE_TYPE; 
                               CSET : in C_SIZE_BOOL_ARRAY); 
end CCL; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/dfa.adb version [f4fbe18813].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE DFA construction routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION converts non-deterministic finite automatons to finite ones.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/dfa.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with DFA, INT_IO, MISC_DEFS, TEXT_IO, Aflex_MISC, TBLCMP, CCL, EXTERNAL_FILE_MANAGER; 
with ECS, NFA, TSTRING, GEN, SKELETON_MANAGER; use MISC_DEFS, 
  EXTERNAL_FILE_MANAGER; 

package body DFA is 
  use TSTRING; 
  package MISC renames Aflex_MISC;
  -- check_for_backtracking - check a DFA state for backtracking
  --
  -- ds is the number of the state to check and state[) is its out-transitions,
  -- indexed by equivalence class, and state_rules[) is the set of rules
  -- associated with this state

  DID_STK_INIT : BOOLEAN := FALSE; 
  STK          : INT_PTR; 

  procedure CHECK_FOR_BACKTRACKING(DS    : in INTEGER; 
                                   STATE : in UNBOUNDED_INT_ARRAY) is 
    use MISC_DEFS; 
  begin
    if (DFAACC(DS).DFAACC_STATE = 0) then 

      -- state is non-accepting
      NUM_BACKTRACKING := NUM_BACKTRACKING + 1; 

      if (BACKTRACK_REPORT) then 
        TEXT_IO.PUT(BACKTRACK_FILE, "State #"); 
        INT_IO.PUT(BACKTRACK_FILE, DS, 1); 
        TEXT_IO.PUT(BACKTRACK_FILE, "is non-accepting -"); 
        TEXT_IO.NEW_LINE(BACKTRACK_FILE); 

        -- identify the state
        DUMP_ASSOCIATED_RULES(BACKTRACK_FILE, DS); 

        -- now identify it further using the out- and jam-transitions
        DUMP_TRANSITIONS(BACKTRACK_FILE, STATE); 
        TEXT_IO.NEW_LINE(BACKTRACK_FILE); 
      end if; 
    end if; 
  end CHECK_FOR_BACKTRACKING; 


  -- check_trailing_context - check to see if NFA state set constitutes
  --                          "dangerous" trailing context
  --
  -- NOTES
  --    Trailing context is "dangerous" if both the head and the trailing
  --  part are of variable size \and/ there's a DFA state which contains
  --  both an accepting state for the head part of the rule and NFA states
  --  which occur after the beginning of the trailing context.
  --  When such a rule is matched, it's impossible to tell if having been
  --  in the DFA state indicates the beginning of the trailing context
  --  or further-along scanning of the pattern.  In these cases, a warning
  --  message is issued.
  --
  --    nfa_states[1 .. num_states) is the list of NFA states in the DFA.
  --    accset[1 .. nacc) is the list of accepting numbers for the DFA state.

  procedure CHECK_TRAILING_CONTEXT(NFA_STATES : in INT_PTR; 
                                   NUM_STATES : in INTEGER; 
                                   ACCSET     : in INT_PTR; 
                                   NACC       : in INTEGER) is 
    NS, AR              : INTEGER; 
    STATE_VAR, TYPE_VAR : STATE_ENUM; 

    use MISC_DEFS, MISC, TEXT_IO; 
  begin
    for I in 1 .. NUM_STATES loop
      NS := NFA_STATES(I); 
      TYPE_VAR := STATE_TYPE(NS); 
      AR := ASSOC_RULE(NS); 

      if ((TYPE_VAR = STATE_NORMAL) or (RULE_TYPE(AR) /= RULE_VARIABLE)) then 
        null; 

      -- do nothing
      else 
        if (TYPE_VAR = STATE_TRAILING_CONTEXT) then 

          -- potential trouble.  Scan set of accepting numbers for
          -- the one marking the end of the "head".  We assume that
          -- this looping will be fairly cheap since it's rare that
          -- an accepting number set is large.
          for J in 1 .. NACC loop
            if (CHECK_YY_TRAILING_HEAD_MASK(ACCSET(J)) /= 0) then 
              TEXT_IO.PUT(STANDARD_ERROR, 
                "aflex: Dangerous trailing context in rule at line "); 
              INT_IO.PUT(STANDARD_ERROR, RULE_LINENUM(AR), 1); 
              TEXT_IO.NEW_LINE(STANDARD_ERROR); 
              return; 
            end if; 
          end loop; 
        end if; 
      end if; 
    end loop; 
  end CHECK_TRAILING_CONTEXT; 


  -- dump_associated_rules - list the rules associated with a DFA state
  --
  -- goes through the set of NFA states associated with the DFA and
  -- extracts the first MAX_ASSOC_RULES unique rules, sorts them,
  -- and writes a report to the given file

  procedure DUMP_ASSOCIATED_RULES(F  : in FILE_TYPE; 
                                  DS : in INTEGER) is 
    J                    : INTEGER; 
    NUM_ASSOCIATED_RULES : INTEGER := 0; 
    RULE_SET             : INT_PTR; 
    SIZE, RULE_NUM       : INTEGER; 
  begin
    RULE_SET := new UNBOUNDED_INT_ARRAY(0 .. MAX_ASSOC_RULES + 1); 
    SIZE := DFASIZ(DS); 

    for I in 1 .. SIZE loop
      RULE_NUM := RULE_LINENUM(ASSOC_RULE(DSS(DS)(I))); 

      J := 1; 
      while (J <= NUM_ASSOCIATED_RULES) loop
        if (RULE_NUM = RULE_SET(J)) then 
          exit; 
        end if; 
        J := J + 1; 
      end loop; 
      if (J > NUM_ASSOCIATED_RULES) then 

        --new rule
        if (NUM_ASSOCIATED_RULES < MAX_ASSOC_RULES) then 
          NUM_ASSOCIATED_RULES := NUM_ASSOCIATED_RULES + 1; 
          RULE_SET(NUM_ASSOCIATED_RULES) := RULE_NUM; 
        end if; 
      end if; 
    end loop; 

    MISC.BUBBLE(RULE_SET, NUM_ASSOCIATED_RULES); 

    TEXT_IO.PUT(F, " associated rules:"); 

    for I in 1 .. NUM_ASSOCIATED_RULES loop
      if (I mod 8 = 1) then 
        TEXT_IO.NEW_LINE(F); 
      end if; 

      TEXT_IO.PUT(F, ASCII.HT); 
      INT_IO.PUT(F, RULE_SET(I), 1); 
    end loop; 

    TEXT_IO.NEW_LINE(F); 
  exception
    when STORAGE_ERROR => 
      MISC.AFLEXFATAL("dynamic memory failure in dump_associated_rules()"); 
  end DUMP_ASSOCIATED_RULES; 


  -- dump_transitions - list the transitions associated with a DFA state
  --
  -- goes through the set of out-transitions and lists them in human-readable
  -- form (i.e., not as equivalence classes); also lists jam transitions
  -- (i.e., all those which are not out-transitions, plus EOF).  The dump
  -- is done to the given file.

  procedure DUMP_TRANSITIONS(F     : in FILE_TYPE; 
                             STATE : in UNBOUNDED_INT_ARRAY) is 
    EC           : INTEGER; 
    OUT_CHAR_SET : C_SIZE_BOOL_ARRAY; 
  begin
    for I in 1 .. CSIZE loop
      EC := ECGROUP(I); 

      if (EC < 0) then 
        EC :=  -EC; 
      end if; 

      OUT_CHAR_SET(I) := (STATE(EC) /= 0); 
    end loop; 

    TEXT_IO.PUT(F, " out-transitions: "); 

    CCL.LIST_CHARACTER_SET(F, OUT_CHAR_SET); 

    -- now invert the members of the set to get the jam transitions
    for I in 1 .. CSIZE loop
      OUT_CHAR_SET(I) := not OUT_CHAR_SET(I); 
    end loop; 

    TEXT_IO.NEW_LINE(F); 
    TEXT_IO.PUT(F, "jam-transitions: EOF "); 

    CCL.LIST_CHARACTER_SET(F, OUT_CHAR_SET); 

    TEXT_IO.NEW_LINE(F); 
  end DUMP_TRANSITIONS; 


  -- epsclosure - construct the epsilon closure of a set of ndfa states
  --
  -- NOTES
  --    the epsilon closure is the set of all states reachable by an arbitrary
  --  number of epsilon transitions which themselves do not have epsilon
  --  transitions going out, unioned with the set of states which have non-null
  --  accepting numbers.  t is an array of size numstates of nfa state numbers.
--  Upon return, t holds the epsilon closure and numstates is updated.  accset
  --  holds a list of the accepting numbers, and the size of accset is given
  --  by nacc.  t may be subjected to reallocation if it is not large enough
  --  to hold the epsilon closure.
  --
  --    hashval is the hash value for the dfa corresponding to the state set

  procedure EPSCLOSURE(T                  : in out INT_PTR; 
                       NS_ADDR            : in out INTEGER; 
                       ACCSET             : in out INT_PTR; 
                       NACC_ADDR, HV_ADDR : out INTEGER) is
    NS, TSP                                      : INTEGER; 
    NUMSTATES, NACC, HASHVAL, TRANSSYM, NFACCNUM : INTEGER; 
    STKEND                                       : INTEGER; 
    STKPOS                                       : INTEGER; 
    procedure MARK_STATE(STATE : in INTEGER) is 
    begin
      TRANS1(STATE) := TRANS1(STATE) - MARKER_DIFFERENCE; 
    end MARK_STATE; 
    pragma INLINE(MARK_STATE); 

    function IS_MARKED(STATE : in INTEGER) return BOOLEAN is 
    begin
      return TRANS1(STATE) < 0; 
    end IS_MARKED; 
    pragma INLINE(IS_MARKED); 

    procedure UNMARK_STATE(STATE : in INTEGER) is 
    begin
      TRANS1(STATE) := TRANS1(STATE) + MARKER_DIFFERENCE; 
    end UNMARK_STATE; 
    pragma INLINE(UNMARK_STATE); 


    procedure CHECK_ACCEPT(STATE : in INTEGER) is 
    begin
      NFACCNUM := ACCPTNUM(STATE); 
      if (NFACCNUM /= NIL) then 
        NACC := NACC + 1; 
        ACCSET(NACC) := NFACCNUM; 
      end if; 
    end CHECK_ACCEPT; 
    pragma INLINE(CHECK_ACCEPT); 

    procedure DO_REALLOCATION is 
    begin
      CURRENT_MAX_DFA_SIZE := CURRENT_MAX_DFA_SIZE + MAX_DFA_SIZE_INCREMENT; 
      NUM_REALLOCS := NUM_REALLOCS + 1; 
      REALLOCATE_INTEGER_ARRAY(T, CURRENT_MAX_DFA_SIZE); 
      REALLOCATE_INTEGER_ARRAY(STK, CURRENT_MAX_DFA_SIZE); 
    end DO_REALLOCATION; 
    pragma INLINE(DO_REALLOCATION); 


    procedure PUT_ON_STACK(STATE : in INTEGER) is 
    begin
      STKEND := STKEND + 1; 
      if (STKEND >= CURRENT_MAX_DFA_SIZE) then 
        DO_REALLOCATION; 
      end if; 
      STK(STKEND) := STATE; 
      MARK_STATE(STATE); 
    end PUT_ON_STACK; 
    pragma INLINE(PUT_ON_STACK); 

    procedure ADD_STATE(STATE : in INTEGER) is 
    begin
      NUMSTATES := NUMSTATES + 1; 
      if (NUMSTATES >= CURRENT_MAX_DFA_SIZE) then 
        DO_REALLOCATION; 
      end if; 
      T(NUMSTATES) := STATE; 
      HASHVAL := HASHVAL + STATE; 
    end ADD_STATE; 
    pragma INLINE(ADD_STATE); 

    procedure STACK_STATE(STATE : in INTEGER) is 
    begin
      PUT_ON_STACK(STATE); 
      CHECK_ACCEPT(STATE); 
      if ((NFACCNUM /= NIL) or (TRANSCHAR(STATE) /= SYM_EPSILON)) then 
        ADD_STATE(STATE); 
      end if; 
    end STACK_STATE; 
    pragma INLINE(STACK_STATE); 

  begin

    NUMSTATES := NS_ADDR; 
    if (not DID_STK_INIT) then 
      STK := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFA_SIZE); 
      DID_STK_INIT := TRUE; 
    end if; 

    NACC := 0; 
    STKEND := 0; 
    HASHVAL := 0; 

    for NSTATE in 1 .. NUMSTATES loop
      NS := T(NSTATE); 

      -- the state could be marked if we've already pushed it onto
      -- the stack
      if (not IS_MARKED(NS)) then 
        PUT_ON_STACK(NS); 
        null; 
      end if; 

      CHECK_ACCEPT(NS); 
      HASHVAL := HASHVAL + NS; 
    end loop; 


    STKPOS := 1; 
    while (STKPOS <= STKEND) loop
      NS := STK(STKPOS); 
      TRANSSYM := TRANSCHAR(NS); 

      if (TRANSSYM = SYM_EPSILON) then 
        TSP := TRANS1(NS) + MARKER_DIFFERENCE; 

        if (TSP /= NO_TRANSITION) then 
          if (not IS_MARKED(TSP)) then 
            STACK_STATE(TSP); 
          end if; 

          TSP := TRANS2(NS); 

          if (TSP /= NO_TRANSITION) then 
            if (not IS_MARKED(TSP)) then 
              STACK_STATE(TSP); 
            end if; 
          end if; 
        end if; 
      end if; 
      STKPOS := STKPOS + 1; 
    end loop; 

    -- clear out "visit" markers
    for CHK_STKPOS in 1 .. STKEND loop
      if (IS_MARKED(STK(CHK_STKPOS))) then 
        UNMARK_STATE(STK(CHK_STKPOS)); 
      else 
        MISC.AFLEXFATAL("consistency check failed in epsclosure()"); 
      end if; 
    end loop; 

    NS_ADDR := NUMSTATES; 
    HV_ADDR := HASHVAL; 
    NACC_ADDR := NACC; 

  end EPSCLOSURE; 


  -- increase_max_dfas - increase the maximum number of DFAs

  procedure INCREASE_MAX_DFAS is 
  begin
    CURRENT_MAX_DFAS := CURRENT_MAX_DFAS + MAX_DFAS_INCREMENT; 

    NUM_REALLOCS := NUM_REALLOCS + 1; 

    REALLOCATE_INTEGER_ARRAY(BASE, CURRENT_MAX_DFAS); 
    REALLOCATE_INTEGER_ARRAY(DEF, CURRENT_MAX_DFAS); 
    REALLOCATE_INTEGER_ARRAY(DFASIZ, CURRENT_MAX_DFAS); 
    REALLOCATE_INTEGER_ARRAY(ACCSIZ, CURRENT_MAX_DFAS); 
    REALLOCATE_INTEGER_ARRAY(DHASH, CURRENT_MAX_DFAS); 
    REALLOCATE_INT_PTR_ARRAY(DSS, CURRENT_MAX_DFAS); 
    REALLOCATE_DFAACC_UNION(DFAACC, CURRENT_MAX_DFAS); 
  end INCREASE_MAX_DFAS; 


  -- ntod - convert an ndfa to a dfa
  --
  --  creates the dfa corresponding to the ndfa we've constructed.  the
  --  dfa starts out in state #1.

  procedure NTOD is 

    ACCSET                                             : INT_PTR; 
    DS, NACC, NEWDS                                    : INTEGER; 
    DUPLIST, TARGFREQ, TARGSTATE, STATE                : C_SIZE_ARRAY; 
    SYMLIST                                            : C_SIZE_BOOL_ARRAY; 
    HASHVAL, NUMSTATES, DSIZE                          : INTEGER; 
    NSET, DSET                                         : INT_PTR; 
    TARGPTR, TOTALTRANS, I, J, COMSTATE, COMFREQ, TARG : INTEGER; 
    NUM_START_STATES, TODO_HEAD, TODO_NEXT             : INTEGER; 
    SNSRESULT                                          : BOOLEAN; 
    FULL_TABLE_TEMP_FILE                               : FILE_TYPE; 
    BUF                                                : VSTRING; 
    NUM_NXT_STATES                                     : INTEGER; 
    use TEXT_IO; 

    -- this is so find_table_space(...) will know where to start looking in
    -- chk/nxt for unused records for space to put in the state
  begin
    ACCSET := ALLOCATE_INTEGER_ARRAY(NUM_RULES + 1); 
    NSET := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFA_SIZE); 

    -- the "todo" queue is represented by the head, which is the DFA
    -- state currently being processed, and the "next", which is the
    -- next DFA state number available (not in use).  We depend on the
    -- fact that snstods() returns DFA's \in increasing order/, and thus
    -- need only know the bounds of the dfas to be processed.
    TODO_HEAD := 0; 
    TODO_NEXT := 0; 

    for CNT in 0 .. CSIZE loop
      DUPLIST(CNT) := NIL; 
      SYMLIST(CNT) := FALSE; 
    end loop; 

    for CNT in 0 .. NUM_RULES loop
      ACCSET(CNT) := NIL; 
    end loop; 

    if (TRACE) then 
      NFA.DUMPNFA(SCSET(1)); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      TEXT_IO.PUT(STANDARD_ERROR, "DFA Dump:"); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    end if; 

    TBLCMP.INITTBL; 

    if (FULLTBL) then 
      GEN.DO_SECT3_OUT; 

      -- output user code up to ##
      SKELETON_MANAGER.SKELOUT; 

      -- declare it "short" because it's a real long-shot that that
      -- won't be large enough
      begin -- make a temporary file to write yy_nxt array into
        CREATE(FULL_TABLE_TEMP_FILE, OUT_FILE); 
      exception
        when USE_ERROR | NAME_ERROR => 
          MISC.AFLEXFATAL("can't create temporary file"); 
      end; 

      NUM_NXT_STATES := 1; 
      TEXT_IO.PUT(FULL_TABLE_TEMP_FILE, "( "); 
      -- generate 0 entries for state #0
      for CNT in 0 .. NUMECS loop
        MISC.MK2DATA(FULL_TABLE_TEMP_FILE, 0); 
      end loop; 

      TEXT_IO.PUT(FULL_TABLE_TEMP_FILE, " )"); 
      -- force extra blank line next dataflush()
      DATALINE := NUMDATALINES; 
    end if; 

    -- create the first states

    NUM_START_STATES := LASTSC*2; 

    for CNT in 1 .. NUM_START_STATES loop
      NUMSTATES := 1; 

      -- for each start condition, make one state for the case when
      -- we're at the beginning of the line (the '%' operator) and
      -- one for the case when we're not

      if (CNT mod 2 = 1) then 
        NSET(NUMSTATES) := SCSET((CNT/2) + 1); 
      else 
        NSET(NUMSTATES) := NFA.MKBRANCH(SCBOL(CNT/2), SCSET(CNT/2)); 
      end if; 

      DFA.EPSCLOSURE(NSET, NUMSTATES, ACCSET, NACC, HASHVAL); 

      SNSTODS(NSET, NUMSTATES, ACCSET, NACC, HASHVAL, DS, SNSRESULT); 
      if (SNSRESULT) then 
        NUMAS := NUMAS + NACC; 
        TOTNST := TOTNST + NUMSTATES; 
        TODO_NEXT := TODO_NEXT + 1; 

        if (VARIABLE_TRAILING_CONTEXT_RULES and (NACC > 0)) then 
          CHECK_TRAILING_CONTEXT(NSET, NUMSTATES, ACCSET, NACC); 
        end if; 
      end if; 
    end loop; 

    SNSTODS(NSET, 0, ACCSET, 0, 0, END_OF_BUFFER_STATE, SNSRESULT); 
    if (not SNSRESULT) then 
      MISC.AFLEXFATAL("could not create unique end-of-buffer state"); 
    end if; 
    NUMAS := NUMAS + 1; 
    NUM_START_STATES := NUM_START_STATES + 1; 
    TODO_NEXT := TODO_NEXT + 1; 

    while (TODO_HEAD < TODO_NEXT) loop
      NUM_NXT_STATES := NUM_NXT_STATES + 1; 
      TARGPTR := 0; 
      TOTALTRANS := 0; 

      for STATE_CNT in 1 .. NUMECS loop
        STATE(STATE_CNT) := 0; 
      end loop; 

      TODO_HEAD := TODO_HEAD + 1; 
      DS := TODO_HEAD; 

      DSET := DSS(DS); 
      DSIZE := DFASIZ(DS); 

      if (TRACE) then 
        TEXT_IO.PUT(STANDARD_ERROR, "state # "); 
        INT_IO.PUT(STANDARD_ERROR, DS, 1); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, ":"); 
      end if; 

      SYMPARTITION(DSET, DSIZE, SYMLIST, DUPLIST); 

      for SYM in 1 .. NUMECS loop
        if (SYMLIST(SYM)) then 
          SYMLIST(SYM) := FALSE; 

          if (DUPLIST(SYM) = NIL) then 
          -- symbol has unique out-transitions
            NUMSTATES := SYMFOLLOWSET(DSET, DSIZE, SYM, NSET); 
            DFA.EPSCLOSURE(NSET, NUMSTATES, ACCSET, NACC, HASHVAL); 

            SNSTODS(NSET, NUMSTATES, ACCSET, NACC, HASHVAL, NEWDS, SNSRESULT); 
            if (SNSRESULT) then 
              TOTNST := TOTNST + NUMSTATES; 
              TODO_NEXT := TODO_NEXT + 1; 
              NUMAS := NUMAS + NACC; 

              if (VARIABLE_TRAILING_CONTEXT_RULES and (NACC > 0)) then 
                CHECK_TRAILING_CONTEXT(NSET, NUMSTATES, ACCSET, NACC); 
              end if; 
            end if; 

            STATE(SYM) := NEWDS; 

            if (TRACE) then 
              TEXT_IO.PUT(STANDARD_ERROR, ASCII.HT); 
              INT_IO.PUT(STANDARD_ERROR, SYM, 1); 
              TEXT_IO.PUT(STANDARD_ERROR, ASCII.HT); 
              INT_IO.PUT(STANDARD_ERROR, NEWDS, 1); 
              TEXT_IO.NEW_LINE(STANDARD_ERROR); 
            end if; 

            TARGPTR := TARGPTR + 1; 
            TARGFREQ(TARGPTR) := 1; 
            TARGSTATE(TARGPTR) := NEWDS; 
            NUMUNIQ := NUMUNIQ + 1; 
          else 
          -- sym's equivalence class has the same transitions
          -- as duplist(sym)'s equivalence class

            TARG := STATE(DUPLIST(SYM)); 
            STATE(SYM) := TARG; 
            if (TRACE) then 
              TEXT_IO.PUT(STANDARD_ERROR, ASCII.HT); 
              INT_IO.PUT(STANDARD_ERROR, SYM, 1); 
              TEXT_IO.PUT(STANDARD_ERROR, ASCII.HT); 
              INT_IO.PUT(STANDARD_ERROR, TARG, 1); 
              TEXT_IO.NEW_LINE(STANDARD_ERROR); 
            end if; 

            -- update frequency count for destination state

            I := 1; 

            while (TARGSTATE(I) /= TARG) loop
              I := I + 1; 
            end loop; 

            TARGFREQ(I) := TARGFREQ(I) + 1; 
            NUMDUP := NUMDUP + 1; 
          end if; 

          TOTALTRANS := TOTALTRANS + 1; 
          DUPLIST(SYM) := NIL; 
        end if; 
      end loop; 

      NUMSNPAIRS := NUMSNPAIRS + TOTALTRANS; 

      if (CASEINS and not USEECS) then 
        I := CHARACTER'POS('A'); 
        J := CHARACTER'POS('a'); 
        while (I < CHARACTER'POS('Z')) loop
          STATE(I) := STATE(J); 
          I := I + 1; 
          J := J + 1; 
        end loop; 
      end if; 

      if (DS > NUM_START_STATES) then 
        CHECK_FOR_BACKTRACKING(DS, STATE); 
      end if; 

      if (FULLTBL) then 
      -- supply array's 0-element
        TEXT_IO.PUT(FULL_TABLE_TEMP_FILE, ","); 
        MISC.DATAFLUSH(FULL_TABLE_TEMP_FILE); 
        TEXT_IO.PUT(FULL_TABLE_TEMP_FILE, "( "); 
        if (DS = END_OF_BUFFER_STATE) then 
          MISC.MK2DATA(FULL_TABLE_TEMP_FILE,  -END_OF_BUFFER_STATE); 
        else 
          MISC.MK2DATA(FULL_TABLE_TEMP_FILE, END_OF_BUFFER_STATE); 
        end if; 

        for CNT in 1 .. NUMECS loop
        -- jams are marked by negative of state number
          if ((STATE(CNT) /= 0)) then 
            MISC.MK2DATA(FULL_TABLE_TEMP_FILE, STATE(CNT)); 
          else 
            MISC.MK2DATA(FULL_TABLE_TEMP_FILE,  -DS); 
          end if; 
        end loop; 

        TEXT_IO.PUT(FULL_TABLE_TEMP_FILE, " )"); 
        -- force extra blank line next dataflush()
        DATALINE := NUMDATALINES; 
      else 
        if (DS = END_OF_BUFFER_STATE) then 
        -- special case this state to make sure it does what it's
        -- supposed to, i.e., jam on end-of-buffer
          TBLCMP.STACK1(DS, 0, 0, JAMSTATE_CONST); 
        else  -- normal, compressed state
        -- determine which destination state is the most common, and
        -- how many transitions to it there are
          COMFREQ := 0; 
          COMSTATE := 0; 

          for CNT in 1 .. TARGPTR loop
            if (TARGFREQ(CNT) > COMFREQ) then 
              COMFREQ := TARGFREQ(CNT); 
              COMSTATE := TARGSTATE(CNT); 
            end if; 
          end loop; 

          TBLCMP.BLDTBL(STATE, DS, TOTALTRANS, COMSTATE, COMFREQ); 
        end if; 
      end if; 
    end loop; 

    if (FULLTBL) then 
      TEXT_IO.PUT("yy_nxt : constant array(0.."); 
      INT_IO.PUT(NUM_NXT_STATES - 1, 1); 
      TEXT_IO.PUT_LINE(" , ASCII.NUL..Character'Last) of short :="); 
      TEXT_IO.PUT_LINE("   ("); 

      RESET(FULL_TABLE_TEMP_FILE, IN_FILE); 
      while (not END_OF_FILE(FULL_TABLE_TEMP_FILE)) loop
        TSTRING.GET_LINE(FULL_TABLE_TEMP_FILE, BUF); 
        TSTRING.PUT_LINE(BUF); 
      end loop; 
      DELETE(FULL_TABLE_TEMP_FILE); 

      MISC.DATAEND; 
    else 
      TBLCMP.CMPTMPS;  -- create compressed template entries

      -- create tables for all the states with only one out-transition
      while (ONESP > 0) loop
        TBLCMP.MK1TBL(ONESTATE(ONESP), ONESYM(ONESP), ONENEXT(ONESP), ONEDEF(
          ONESP)); 
        ONESP := ONESP - 1; 
      end loop; 

      TBLCMP.MKDEFTBL; 
    end if; 
  end NTOD; 

  -- snstods - converts a set of ndfa states into a dfa state
  --
  -- on return, the dfa state number is in newds.
  procedure SNSTODS(SNS           : in INT_PTR; 
                    NUMSTATES     : in INTEGER; 
                    ACCSET        : in INT_PTR; 
                    NACC, HASHVAL : in INTEGER; 
                    NEWDS_ADDR    : out INTEGER; 
                    RESULT        : out BOOLEAN) is 
    DIDSORT : BOOLEAN := FALSE; 
    J       : INTEGER; 
    NEWDS   : INTEGER; 
    OLDSNS  : INT_PTR; 
  begin
    for I in 1 .. LASTDFA loop
      if (HASHVAL = DHASH(I)) then 
        if (NUMSTATES = DFASIZ(I)) then 
          OLDSNS := DSS(I); 

          if (not DIDSORT) then 
          -- we sort the states in sns so we can compare it to
          -- oldsns quickly.  we use bubble because there probably
          -- aren't very many states

            MISC.BUBBLE(SNS, NUMSTATES); 
            DIDSORT := TRUE; 
          end if; 

          J := 1; 
          while (J <= NUMSTATES) loop
            if (SNS(J) /= OLDSNS(J)) then 
              exit; 
            end if; 
            J := J + 1; 
          end loop; 

          if (J > NUMSTATES) then 
            DFAEQL := DFAEQL + 1; 
            NEWDS_ADDR := I; 
            RESULT := FALSE; 
            return; 
          end if; 

          HSHCOL := HSHCOL + 1; 
        else 
          HSHSAVE := HSHSAVE + 1; 
        end if; 
      end if; 
    end loop; 
    -- make a new dfa

    LASTDFA := LASTDFA + 1; 
    if (LASTDFA >= CURRENT_MAX_DFAS) then 
      INCREASE_MAX_DFAS; 
    end if; 

    NEWDS := LASTDFA; 

    DSS(NEWDS) := new UNBOUNDED_INT_ARRAY(0 .. NUMSTATES + 1); 

    -- if we haven't already sorted the states in sns, we do so now, so that
    -- future comparisons with it can be made quickly

    if (not DIDSORT) then 
      MISC.BUBBLE(SNS, NUMSTATES); 
    end if; 

    for I in 1 .. NUMSTATES loop
      DSS(NEWDS)(I) := SNS(I); 
    end loop; 

    DFASIZ(NEWDS) := NUMSTATES; 
    DHASH(NEWDS) := HASHVAL; 

    if (NACC = 0) then 
      DFAACC(NEWDS).DFAACC_STATE := 0; 
      ACCSIZ(NEWDS) := 0; 
    else 
    -- find lowest numbered rule so the disambiguating rule will work
      J := NUM_RULES + 1; 

      for I in 1 .. NACC loop
        if (ACCSET(I) < J) then 
          J := ACCSET(I); 
        end if; 
      end loop; 

      DFAACC(NEWDS).DFAACC_STATE := J; 
    end if; 

    NEWDS_ADDR := NEWDS; 
    RESULT := TRUE; 
    return; 

  exception
    when STORAGE_ERROR => 
      MISC.AFLEXFATAL("dynamic memory failure in snstods()"); 
  end SNSTODS; 

  -- symfollowset - follow the symbol transitions one step
  function SYMFOLLOWSET(DS              : in INT_PTR; 
                        DSIZE, TRANSSYM : in INTEGER; 
                        NSET            : in INT_PTR) return INTEGER is 
    NS, TSP, SYM, LENCCL, CH, NUMSTATES, CCLLIST : INTEGER; 
  begin
    NUMSTATES := 0; 

    for I in 1 .. DSIZE loop
    -- for each nfa state ns in the state set of ds
      NS := DS(I); 
      SYM := TRANSCHAR(NS); 
      TSP := TRANS1(NS); 

      if (SYM < 0) then 
      -- it's a character class
        SYM :=  -SYM; 
        CCLLIST := CCLMAP(SYM); 
        LENCCL := CCLLEN(SYM); 

        if (CCLNG(SYM) /= 0) then 
          for J in 0 .. LENCCL - 1 loop
          -- loop through negated character class
            CH := CHARACTER'POS(CCLTBL(CCLLIST + J)); 

            if (CH > TRANSSYM) then 
              exit;  -- transsym isn't in negated ccl
            else 
              if (CH = TRANSSYM) then 
                goto BOTTOM;  -- next 2
              end if; 
            end if; 
          end loop; 

          -- didn't find transsym in ccl
          NUMSTATES := NUMSTATES + 1; 
          NSET(NUMSTATES) := TSP; 
        else 
          for J in 0 .. LENCCL - 1 loop
            CH := CHARACTER'POS(CCLTBL(CCLLIST + J)); 

            if (CH > TRANSSYM) then 
              exit; 
            else 
              if (CH = TRANSSYM) then 
                NUMSTATES := NUMSTATES + 1; 
                NSET(NUMSTATES) := TSP; 
                exit; 
              end if; 
            end if; 
          end loop; 
        end if; 
      else 
        if ((SYM >= CHARACTER'POS('A')) and (SYM <= CHARACTER'POS('Z')) and 
          CASEINS) then 
          MISC.AFLEXFATAL("consistency check failed in symfollowset"); 
        else 
          if (SYM = SYM_EPSILON) then 
            null;  -- do nothing
          else 
            if (ECGROUP(SYM) = TRANSSYM) then 
              NUMSTATES := NUMSTATES + 1; 
              NSET(NUMSTATES) := TSP; 
            end if; 
          end if; 
        end if; 
      end if; 

      <<BOTTOM>> null; 
    end loop; 
    return NUMSTATES; 
  end SYMFOLLOWSET; 

  -- sympartition - partition characters with same out-transitions
  procedure SYMPARTITION(DS        : in INT_PTR; 
                         NUMSTATES : in INTEGER; 
                         SYMLIST   : in out C_SIZE_BOOL_ARRAY; 
                         DUPLIST   : in out C_SIZE_ARRAY) is 
    TCH, J, NS, LENCCL, CCLP, ICH : INTEGER; 
    DUPFWD                        : C_SIZE_ARRAY; 

  -- partitioning is done by creating equivalence classes for those
  -- characters which have out-transitions from the given state.  Thus
  -- we are really creating equivalence classes of equivalence classes.
  begin
    for I in 1 .. NUMECS loop
    -- initialize equivalence class list
      DUPLIST(I) := I - 1; 
      DUPFWD(I) := I + 1; 
    end loop; 

    DUPLIST(1) := NIL; 
    DUPFWD(NUMECS) := NIL; 
    DUPFWD(0) := 0; 

    for I in 1 .. NUMSTATES loop
      NS := DS(I); 
      TCH := TRANSCHAR(NS); 

      if (TCH /= SYM_EPSILON) then 
        if ((TCH <  -LASTCCL) or (TCH > CSIZE)) then 
          MISC.AFLEXFATAL("bad transition character detected in sympartition()")
            ; 
        end if; 

        if (TCH > 0) then 
        -- character transition
          ECS.MKECHAR(ECGROUP(TCH), DUPFWD, DUPLIST); 
          SYMLIST(ECGROUP(TCH)) := TRUE; 
        else 
        -- character class
          TCH :=  -TCH; 

          LENCCL := CCLLEN(TCH); 
          CCLP := CCLMAP(TCH); 
          ECS.MKECCL(CCLTBL(CCLP .. CCLP + LENCCL), LENCCL, DUPFWD, DUPLIST, 
            NUMECS); 

          if (CCLNG(TCH) /= 0) then 
            J := 0; 

            for K in 0 .. LENCCL - 1 loop
              ICH := CHARACTER'POS(CCLTBL(CCLP + K)); 

              J := J + 1; 
              while (J < ICH) loop
                SYMLIST(J) := TRUE; 
                J := J + 1; 
              end loop; 
            end loop; 

            J := J + 1; 
            while (J <= NUMECS) loop
              SYMLIST(J) := TRUE; 
              J := J + 1; 
            end loop; 
          else 
            for K in 0 .. LENCCL - 1 loop
              ICH := CHARACTER'POS(CCLTBL(CCLP + K)); 
              SYMLIST(ICH) := TRUE; 
            end loop; 
          end if; 
        end if; 
      end if; 
    end loop; 
  end SYMPARTITION; 
end DFA; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/dfa.ads version [ded3b79621].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE DFA construction routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION converts non-deterministic finite automatons to finite ones.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/dfa.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS; 
with TEXT_IO; 
package DFA is 
  use MISC_DEFS, TEXT_IO; 
  procedure CHECK_FOR_BACKTRACKING(DS    : in INTEGER; 
                                   STATE : in UNBOUNDED_INT_ARRAY); 
  procedure CHECK_TRAILING_CONTEXT(NFA_STATES : in INT_PTR; 
                                   NUM_STATES : in INTEGER; 
                                   ACCSET     : in INT_PTR; 
                                   NACC       : in INTEGER); 

  procedure DUMP_ASSOCIATED_RULES(F  : in FILE_TYPE; 
                                  DS : in INTEGER); 

  procedure DUMP_TRANSITIONS(F     : in FILE_TYPE; 
                             STATE : in UNBOUNDED_INT_ARRAY); 

  procedure EPSCLOSURE(T                  : in out INT_PTR; 
                       NS_ADDR            : in out INTEGER; 
                       ACCSET             : in out INT_PTR; 
                       NACC_ADDR, HV_ADDR : out INTEGER);

  procedure INCREASE_MAX_DFAS; 

  procedure NTOD; 

  procedure SNSTODS(SNS           : in INT_PTR; 
                    NUMSTATES     : in INTEGER; 
                    ACCSET        : in INT_PTR; 
                    NACC, HASHVAL : in INTEGER; 
                    NEWDS_ADDR    : out INTEGER; 
                    RESULT        : out BOOLEAN); 

  function SYMFOLLOWSET(DS              : in INT_PTR; 
                        DSIZE, TRANSSYM : in INTEGER; 
                        NSET            : in INT_PTR) return INTEGER; 

  procedure SYMPARTITION(DS        : in INT_PTR; 
                         NUMSTATES : in INTEGER; 
                         SYMLIST   : in out C_SIZE_BOOL_ARRAY; 
                         DUPLIST   : in out C_SIZE_ARRAY); 
end DFA; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/ecs.adb version [9678803c89].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE equivalence class
-- AUTHOR: John Self (UCI)
-- DESCRIPTION finds equivalence classes so DFA will be smaller
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/ecs.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS; 
with Aflex_MISC; use MISC_DEFS; 
package body ECS is 

-- ccl2ecl - convert character classes to set of equivalence classes

  procedure CCL2ECL is 
    use MISC_DEFS; 
    ICH, NEWLEN, CCLP, CCLMEC : INTEGER; 
  begin
    for I in 1 .. LASTCCL loop

      -- we loop through each character class, and for each character
      -- in the class, add the character's equivalence class to the
      -- new "character" class we are creating.  Thus when we are all
      -- done, character classes will really consist of collections
      -- of equivalence classes
      NEWLEN := 0; 
      CCLP := CCLMAP(I); 

      for CCLS in 0 .. CCLLEN(I) - 1 loop
        ICH := CHARACTER'POS(CCLTBL(CCLP + CCLS)); 
        CCLMEC := ECGROUP(ICH); 
        if (CCLMEC > 0) then 
          CCLTBL(CCLP + NEWLEN) := CHARACTER'VAL(CCLMEC); 
          NEWLEN := NEWLEN + 1; 
        end if; 
      end loop; 

      CCLLEN(I) := NEWLEN; 
    end loop; 
  end CCL2ECL; 


  -- cre8ecs - associate equivalence class numbers with class members
  --  fwd is the forward linked-list of equivalence class members.  bck
  --  is the backward linked-list, and num is the number of class members.
  --  Returned is the number of classes.

  procedure CRE8ECS(FWD, BCK : in out C_SIZE_ARRAY; 
                    NUM      : in INTEGER; 
                    RESULT   : out INTEGER) is 
    J, NUMCL : INTEGER; 
  begin
    NUMCL := 0; 

    -- create equivalence class numbers.  From now on, abs( bck(x) )
    -- is the equivalence class number for object x.  If bck(x)
    -- is positive, then x is the representative of its equivalence
    -- class.
    for I in 1 .. NUM loop
      if (BCK(I) = NIL) then 
        NUMCL := NUMCL + 1; 
        BCK(I) := NUMCL; 
        J := FWD(I); 
        while (J /= NIL) loop
          BCK(J) :=  -NUMCL; 
          J := FWD(J); 
        end loop; 
      end if; 
    end loop; 
    RESULT := NUMCL; 
    return; 
  end CRE8ECS; 


  -- mkeccl - update equivalence classes based on character class xtions
  -- where ccls contains the elements of the character class, lenccl is the
  -- number of elements in the ccl, fwd is the forward link-list of equivalent
  -- characters, bck is the backward link-list, and llsiz size of the link-list

  procedure MKECCL(CCLS     : in out CHAR_ARRAY; 
                   LENCCL   : in INTEGER; 
                   FWD, BCK : in out UNBOUNDED_INT_ARRAY; 
                   LLSIZ    : in INTEGER) is 
    use MISC_DEFS, Aflex_MISC; 
    CCLP, OLDEC, NEWEC, CCLM, I, J : INTEGER; 
    PROC_ARRAY                     : BOOLEAN_PTR; 
  begin

    -- note that it doesn't matter whether or not the character class is
    -- negated.  The same results will be obtained in either case.
    CCLP := CCLS'FIRST; 

    -- this array tells whether or not a character class has been processed.
    PROC_ARRAY := new BOOLEAN_ARRAY(CCLS'FIRST .. CCLS'LAST); 
    for CCL_INDEX in CCLS'FIRST .. CCLS'LAST loop
      PROC_ARRAY(CCL_INDEX) := FALSE; 
    end loop; 

    while (CCLP < LENCCL + CCLS'FIRST) loop
      CCLM := CHARACTER'POS(CCLS(CCLP)); 
      OLDEC := BCK(CCLM); 
      NEWEC := CCLM; 

      J := CCLP + 1; 

      I := FWD(CCLM); 
      while ((I /= NIL) and (I <= LLSIZ)) loop

        -- look for the symbol in the character class
        while ((J < LENCCL + CCLS'FIRST) and ((CCLS(J) <= CHARACTER'VAL(I)) or 
          PROC_ARRAY(J))) loop
          if (CCLS(J) = CHARACTER'VAL(I)) then 

            -- we found an old companion of cclm in the ccl.
            -- link it into the new equivalence class and flag it as
            -- having been processed
            BCK(I) := NEWEC; 
            FWD(NEWEC) := I; 
            NEWEC := I; 
            PROC_ARRAY(J) := TRUE; 

            -- set flag so we don't reprocess

            -- get next equivalence class member
            -- continue 2
            goto NEXT_PT; 
          end if; 
          J := J + 1; 
        end loop; 

        -- symbol isn't in character class.  Put it in the old equivalence
        -- class
        BCK(I) := OLDEC; 

        if (OLDEC /= NIL) then 
          FWD(OLDEC) := I; 
        end if; 

        OLDEC := I; 
        <<NEXT_PT>> I := FWD(I); 
      end loop; 

      if ((BCK(CCLM) /= NIL) or (OLDEC /= BCK(CCLM))) then 
        BCK(CCLM) := NIL; 
        FWD(OLDEC) := NIL; 
      end if; 

      FWD(NEWEC) := NIL; 

      -- find next ccl member to process
      CCLP := CCLP + 1; 

      while ((CCLP < LENCCL + CCLS'FIRST) and PROC_ARRAY(CCLP)) loop

        -- reset "doesn't need processing" flag
        PROC_ARRAY(CCLP) := FALSE; 
        CCLP := CCLP + 1; 
      end loop; 
    end loop; 
  exception
    when STORAGE_ERROR => 
      Aflex_MISC.AFLEXFATAL("dynamic memory failure in mkeccl()"); 
  end MKECCL; 


  -- mkechar - create equivalence class for single character

  procedure MKECHAR(TCH      : in INTEGER; 
                    FWD, BCK : in out C_SIZE_ARRAY) is 
  begin

    -- if until now the character has been a proper subset of
    -- an equivalence class, break it away to create a new ec
    if (FWD(TCH) /= NIL) then 
      BCK(FWD(TCH)) := BCK(TCH); 
    end if; 

    if (BCK(TCH) /= NIL) then 
      FWD(BCK(TCH)) := FWD(TCH); 
    end if; 

    FWD(TCH) := NIL; 
    BCK(TCH) := NIL; 
  end MKECHAR; 

end ECS; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




















































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/ecs.ads version [253793f403].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE equivalence class
-- AUTHOR: John Self (UCI)
-- DESCRIPTION finds equivalence classes so DFA will be smaller
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/ecs.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS; use MISC_DEFS; 
package ECS is 
  procedure CCL2ECL; 
  procedure CRE8ECS(FWD, BCK : in out C_SIZE_ARRAY; 
                    NUM      : in INTEGER; 
                    RESULT   : out INTEGER); 
  procedure MKECCL(CCLS     : in out CHAR_ARRAY; 
                   LENCCL   : in INTEGER; 
                   FWD, BCK : in out UNBOUNDED_INT_ARRAY; 
                   LLSIZ    : in INTEGER); 
  procedure MKECHAR(TCH      : in INTEGER; 
                    FWD, BCK : in out C_SIZE_ARRAY); 
end ECS; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/external_file_manager.adb version [c922d67b60].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE external_file_manager
-- AUTHOR: John Self (UCI)
-- DESCRIPTION opens external files for other functions
-- NOTES This package opens external files, and thus may be system dependent
--       because of limitations on file names.
--       This version is for the VADS 5.5 Ada development system.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/file_manager.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TSTRING, TEXT_IO, Aflex_MISC; use MISC_DEFS, TSTRING, TEXT_IO; 

package body EXTERNAL_FILE_MANAGER is 
  package MISC renames Aflex_MISC;

-- FIX comment about compiler dependent

  subtype SUFFIX_TYPE is STRING(1 .. 3); 

  function ADA_SUFFIX return SUFFIX_TYPE is 
  begin
    return "ada"; 
  end ADA_SUFFIX; 

  procedure GET_IO_FILE(F : in out FILE_TYPE) is 
  begin
    if (LEN(INFILENAME) /= 0) then 
      CREATE(F, OUT_FILE, STR(MISC.BASENAME) & "_io." & ADA_SUFFIX); 
    else 
      CREATE(F, OUT_FILE, "aflex_yy_io." & ADA_SUFFIX); 
    end if; 
  exception
    when USE_ERROR | NAME_ERROR => 
      MISC.AFLEXFATAL("could not create IO package file"); 
  end GET_IO_FILE; 

  procedure GET_DFA_FILE(F : in out FILE_TYPE) is 
  begin
    if (LEN(INFILENAME) /= 0) then 
      CREATE(F, OUT_FILE, STR(MISC.BASENAME) & "_dfa." & ADA_SUFFIX); 
    else 
      CREATE(F, OUT_FILE, "aflex_yy_dfa." & ADA_SUFFIX); 
    end if; 
  exception
    when USE_ERROR | NAME_ERROR => 
      MISC.AFLEXFATAL("could not create DFA package file"); 
  end GET_DFA_FILE; 

  procedure GET_SCANNER_FILE(F : in out FILE_TYPE) is 
    OUTFILE_NAME : VSTRING; 
  begin
    if (LEN(INFILENAME) /= 0) then 

      -- give out infile + ada_suffix
      OUTFILE_NAME := MISC.BASENAME & "." & ADA_SUFFIX; 
    else 
      OUTFILE_NAME := VSTR("aflex_yy." & ADA_SUFFIX); 
    end if; 

    CREATE(F, OUT_FILE, STR(OUTFILE_NAME)); 
    SET_OUTPUT(F); 
  exception
    when NAME_ERROR | USE_ERROR => 
      MISC.AFLEXFATAL("can't create scanner file " & OUTFILE_NAME); 
  end GET_SCANNER_FILE; 

  procedure GET_BACKTRACK_FILE(F : in out FILE_TYPE) is 
  begin
    CREATE(F, OUT_FILE, "aflex.backtrack"); 
  exception
    when USE_ERROR | NAME_ERROR => 
      MISC.AFLEXFATAL("could not create backtrack file"); 
  end GET_BACKTRACK_FILE; 

  procedure INITIALIZE_FILES is 
  begin
    null; 

  -- doesn't need to do anything on Verdix
  end INITIALIZE_FILES; 

end EXTERNAL_FILE_MANAGER; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/external_file_manager.ads version [f4f99b74f9].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE external_file_manager
-- AUTHOR: John Self (UCI)
-- DESCRIPTION opens external files for other functions
-- NOTES This package opens external files, and thus may be system dependent
--       because of limitations on file names.
--       This version is for the VADS 5.5 Ada development system.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/file_manager.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with TEXT_IO; use TEXT_IO; 
package EXTERNAL_FILE_MANAGER is 
  procedure GET_IO_FILE(F : in out FILE_TYPE); 
  procedure GET_DFA_FILE(F : in out FILE_TYPE); 
  procedure GET_SCANNER_FILE(F : in out FILE_TYPE); 
  procedure GET_BACKTRACK_FILE(F : in out FILE_TYPE); 
  procedure INITIALIZE_FILES; 
end EXTERNAL_FILE_MANAGER; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/file_string.ads version [4213039046].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE file strings
-- AUTHOR: John Self (UCI)
-- DESCRIPTION used to store lines in the template files
-- NOTES if lines in a template exceed 128 characters we are in trouble
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/file_strings.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with VSTRINGS; 
package FILE_STRING is 
  new VSTRINGS(128); 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
























































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/gen.adb version [56093c5a44].

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
pragma Warnings(Off);
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE scanner generation
-- AUTHOR: John Self (UCI)
-- DESCRIPTION
-- NOTES does actual generation (writing) of output aflex scanners
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/gen.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TEXT_IO, Aflex_MISC, INT_IO, TSTRING, PARSE_TOKENS; 
with SCANNER, SKELETON_MANAGER, EXTERNAL_FILE_MANAGER; use MISC_DEFS, TEXT_IO, 
  TSTRING, PARSE_TOKENS, EXTERNAL_FILE_MANAGER; 

package body GEN is 
  package MISC renames Aflex_MISC;
  INDENT_LEVEL : INTEGER := 0;  -- each level is 4 spaces

  MAX_SHORT    : constant INTEGER := 32767; 
  procedure INDENT_UP is 
  begin
    INDENT_LEVEL := INDENT_LEVEL + 1; 
  end INDENT_UP; 
  procedure INDENT_DOWN is 
  begin
    INDENT_LEVEL := INDENT_LEVEL - 1; 
  end INDENT_DOWN; 

  procedure SET_INDENT(INDENT_VAL : in INTEGER) is 
  begin
    INDENT_LEVEL := INDENT_VAL; 
  end SET_INDENT; 


  -- indent to the current level

  procedure DO_INDENT is 
    I : INTEGER := INDENT_LEVEL*4; 
  begin
    while (I >= 8) loop
      TEXT_IO.PUT(ASCII.HT); 
      I := I - 8; 
    end loop; 

    while (I > 0) loop
      TEXT_IO.PUT(' '); 
      I := I - 1; 
    end loop; 
  end DO_INDENT; 

  -- generate the code to keep backtracking information

  procedure GEN_BACKTRACKING is 
  begin
    if (NUM_BACKTRACKING = 0) then 
      return; 
    end if; 

    INDENT_PUTS("if ( yy_accept(yy_current_state) /= 0 ) then"); 

    INDENT_UP; 
    INDENT_PUTS("yy_last_accepting_state := yy_current_state;"); 
    INDENT_PUTS("yy_last_accepting_cpos := yy_cp;"); 
    INDENT_DOWN; 
    INDENT_PUTS("end if;"); 
  end GEN_BACKTRACKING; 

  -- generate the code to perform the backtrack

  procedure GEN_BT_ACTION is 
  begin
    if (NUM_BACKTRACKING = 0) then 
      return; 
    end if; 

    SET_INDENT(4); 

    INDENT_PUTS("when 0 => -- must backtrack"); 
    INDENT_PUTS("-- undo the effects of YY_DO_BEFORE_ACTION"); 
    INDENT_PUTS("yy_ch_buf(yy_cp) := yy_hold_char;"); 

    if (FULLTBL) then 
      INDENT_PUTS("yy_cp := yy_last_accepting_cpos + 1;"); 
    else 

      -- backtracking info for compressed tables is taken \after/
      -- yy_cp has been incremented for the next state
      INDENT_PUTS("yy_cp := yy_last_accepting_cpos;"); 
    end if; 

    INDENT_PUTS("yy_current_state := yy_last_accepting_state;"); 
    INDENT_PUTS("goto next_action;"); 
    TEXT_IO.NEW_LINE; 

    SET_INDENT(0); 
  end GEN_BT_ACTION; 

  -- generate equivalence-class table

  procedure GENECS is 
    I       : INTEGER; 
    NUMROWS : INTEGER; 
    use TEXT_IO; 
  begin
    TEXT_IO.PUT("yy_ec : constant array(ASCII.NUL.."); 
    TEXT_IO.PUT_LINE("Character'Last) of short :="); 
    TEXT_IO.PUT_LINE("    (   0,"); 

    for CHAR_COUNT in 1 .. CSIZE loop
      if (CASEINS and ((CHAR_COUNT >= CHARACTER'POS('A')) and (CHAR_COUNT <= 
        CHARACTER'POS('Z')))) then 
        ECGROUP(CHAR_COUNT) := ECGROUP(MISC.CLOWER(CHAR_COUNT)); 
      end if; 

      ECGROUP(CHAR_COUNT) := abs(ECGROUP(CHAR_COUNT)); 
      MISC.MKDATA(ECGROUP(CHAR_COUNT)); 
    end loop; 

    MISC.DATAEND; 

    if (TRACE) then 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      TEXT_IO.PUT(STANDARD_ERROR, "Equivalence Classes:"); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      NUMROWS := (CSIZE + 1)/8; 

      for J in 1 .. NUMROWS loop
        I := J; 
        while (I <= CSIZE) loop
          TSTRING.PUT(STANDARD_ERROR, MISC.READABLE_FORM(CHARACTER'VAL(I))); 
          TEXT_IO.PUT(STANDARD_ERROR, " = "); 
          INT_IO.PUT(STANDARD_ERROR, ECGROUP(I), 1); 
          TEXT_IO.PUT(STANDARD_ERROR, "   "); 
          I := I + NUMROWS; 
        end loop; 
        TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      end loop; 
    end if; 
  end GENECS; 

  -- generate the code to find the action number

  procedure GEN_FIND_ACTION is 
  begin
    INDENT_PUTS("yy_act := yy_accept(yy_current_state);"); 
  end GEN_FIND_ACTION; 

  -- genftbl - generates full transition table

  procedure GENFTBL is 
    END_OF_BUFFER_ACTION : INTEGER := NUM_RULES + 1; 
    -- *everything* is done in terms of arrays starting at 1, so provide
    -- a null entry for the zero element of all C arrays
    use TEXT_IO; 
  begin
    TEXT_IO.PUT("yy_accept : constant array(0.."); 
    INT_IO.PUT(LASTDFA, 1); 
    TEXT_IO.PUT_LINE(") of short :="); 
    TEXT_IO.PUT_LINE("    (   0,"); 

    DFAACC(END_OF_BUFFER_STATE).DFAACC_STATE := END_OF_BUFFER_ACTION; 

    for I in 1 .. LASTDFA loop
      declare
        ANUM : INTEGER := DFAACC(I).DFAACC_STATE; 
      begin
        MISC.MKDATA(ANUM); 

        if (TRACE and (ANUM /= 0)) then 
          TEXT_IO.PUT(STANDARD_ERROR, "state # "); 
          INT_IO.PUT(STANDARD_ERROR, I, 1); 
          TEXT_IO.PUT(STANDARD_ERROR, " accepts: ["); 
          INT_IO.PUT(STANDARD_ERROR, ANUM, 1); 
          TEXT_IO.PUT(STANDARD_ERROR, "]"); 
          TEXT_IO.NEW_LINE(STANDARD_ERROR); 
        end if; 
      end; 
    end loop; 

    MISC.DATAEND; 

    if (USEECS) then 
      GENECS; 
    end if; 

  -- don't have to dump the actual full table entries - they were created
  -- on-the-fly
  end GENFTBL; 

  -- generate the code to find the next compressed-table state

  procedure GEN_NEXT_COMPRESSED_STATE is 
  begin
    if (USEECS) then 
      INDENT_PUTS("yy_c := yy_ec(yy_ch_buf(yy_cp));"); 
    else 
      INDENT_PUTS("yy_c := yy_ch_buf(yy_cp);"); 
    end if; 

    -- save the backtracking info \before/ computing the next state
    -- because we always compute one more state than needed - we
    -- always proceed until we reach a jam state
    GEN_BACKTRACKING; 

    INDENT_PUTS(
      "while ( yy_chk(yy_base(yy_current_state) + yy_c) /= yy_current_state ) loop"
      ); 
    INDENT_UP; 
    INDENT_PUTS("yy_current_state := yy_def(yy_current_state);"); 

    if (USEMECS) then 

      -- we've arrange it so that templates are never chained
      -- to one another.  This means we can afford make a
      -- very simple test to see if we need to convert to
      -- yy_c's meta-equivalence class without worrying
      -- about erroneously looking up the meta-equivalence
      -- class twice
      DO_INDENT; 

      -- lastdfa + 2 is the beginning of the templates
      TEXT_IO.PUT("if ( yy_current_state >= "); 
      INT_IO.PUT(LASTDFA + 2, 1); 
      TEXT_IO.PUT_LINE(" ) then"); 

      INDENT_UP; 
      INDENT_PUTS("yy_c := yy_meta(yy_c);"); 
      INDENT_DOWN; 
      INDENT_PUTS("end if;"); 
    end if; 

    INDENT_DOWN; 
    INDENT_PUTS("end loop;"); 

    INDENT_PUTS("yy_current_state := yy_nxt(yy_base(yy_current_state) + yy_c);")
      ; 
    INDENT_DOWN; 
  end GEN_NEXT_COMPRESSED_STATE; 

  -- generate the code to find the next match

  procedure GEN_NEXT_MATCH is 
  -- note - changes in here should be reflected in get_next_state
  begin
    if (FULLTBL) then 
      INDENT_PUTS(
        "yy_current_state := yy_nxt(yy_current_state, yy_ch_buf(yy_cp));"); 
      INDENT_PUTS("while ( yy_current_state > 0 ) loop"); 
      INDENT_UP; 
      INDENT_PUTS("yy_cp := yy_cp + 1;"); 
      INDENT_PUTS(
        "yy_current_state := yy_nxt(yy_current_state, yy_ch_buf(yy_cp));"); 
      INDENT_DOWN; 
      INDENT_PUTS("end loop;"); 

      if (NUM_BACKTRACKING > 0) then 
        GEN_BACKTRACKING; 
        TEXT_IO.NEW_LINE; 
      end if; 

      TEXT_IO.NEW_LINE; 
      INDENT_PUTS("yy_current_state := -yy_current_state;"); 
    else 

      -- compressed
      INDENT_PUTS("loop"); 

      INDENT_UP; 

      GEN_NEXT_STATE; 

      INDENT_PUTS("yy_cp := yy_cp + 1;"); 

      if (INTERACTIVE) then
        TEXT_IO.PUT("if ( yy_base(yy_current_state) = ");
        INT_IO.PUT(JAMBASE, 1);
      else
        TEXT_IO.PUT("if ( yy_current_state = "); 
        INT_IO.PUT(JAMSTATE, 1); 
      end if;
      
      TEXT_IO.PUT_LINE(" ) then"); 
      TEXT_IO.PUT_LINE("    exit;"); 
      TEXT_IO.PUT_LINE("end if;"); 

      INDENT_DOWN; 

      DO_INDENT; 

      TEXT_IO.PUT_LINE("end loop;"); 

      if (not INTERACTIVE) then
        INDENT_PUTS("yy_cp := yy_last_accepting_cpos;"); 
        INDENT_PUTS("yy_current_state := yy_last_accepting_state;"); 
      end if;
    end if; 
  end GEN_NEXT_MATCH; 

  -- generate the code to find the next state

  procedure GEN_NEXT_STATE is 
  -- note - changes in here should be reflected in get_next_match
  begin
    INDENT_UP; 
    if (FULLTBL) then 
      INDENT_PUTS("yy_current_state := yy_nxt(yy_current_state,"); 
      INDENT_PUTS("                    yy_ch_buf(yy_cp));"); 
      GEN_BACKTRACKING; 
    else 
      GEN_NEXT_COMPRESSED_STATE; 
    end if; 
  end GEN_NEXT_STATE; 

  -- generate the code to find the start state

  procedure GEN_START_STATE is 
  begin
    INDENT_PUTS("yy_current_state := yy_start;"); 

    if (BOL_NEEDED) then 
      INDENT_PUTS("if ( yy_ch_buf(yy_bp-1) = ASCII.LF ) then"); 
      INDENT_UP; 
      INDENT_PUTS("yy_current_state := yy_current_state + 1;"); 
      INDENT_DOWN; 
      INDENT_PUTS("end if;"); 
    end if; 

  end GEN_START_STATE; 

  -- gentabs - generate data statements for the transition tables

  procedure GENTABS is 
    I, J, K, NACC, TOTAL_STATES : INTEGER; 
    ACCSET, ACC_ARRAY           : INT_PTR; 
    ACCNUM                      : INTEGER; 
    END_OF_BUFFER_ACTION        : INTEGER := NUM_RULES + 1; 
    -- *everything* is done in terms of arrays starting at 1, so provide
    -- a null entry for the zero element of all C arrays

    C_LONG_DECL                 : STRING(1 .. 44) := 
      "static const long int %s[%d] =\n    {   0,\n"; 
    C_SHORT_DECL                : STRING(1 .. 45) := 
      "static const short int %s[%d] =\n    {   0,\n"; 
    C_CHAR_DECL                 : STRING(1 .. 40) := 
      "static const char %s[%d] =\n    {   0,\n"; 
  begin
    ACC_ARRAY := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFAS); 
    NUMMT := 0; 

    -- the compressed table format jams by entering the "jam state",
    -- losing information about the previous state in the process.
    -- In order to recover the previous state, we effectively need
    -- to keep backtracking information.
    NUM_BACKTRACKING := NUM_BACKTRACKING + 1; 

    DFAACC(END_OF_BUFFER_STATE).DFAACC_STATE := END_OF_BUFFER_ACTION; 

    for CNT in 1 .. LASTDFA loop
      ACC_ARRAY(CNT) := DFAACC(CNT).DFAACC_STATE; 
    end loop; 


    ACC_ARRAY(LASTDFA + 1) := 0; 

    -- add accepting number for the jam state

    -- spit out ALIST array, dumping the accepting numbers.

    -- "lastdfa + 2" is the size of ALIST; includes room for arrays
    -- beginning at 0 and for "jam" state
    K := LASTDFA + 2; 

    TEXT_IO.PUT("yy_accept : constant array(0.."); 
    INT_IO.PUT(K - 1, 1); 
    TEXT_IO.PUT_LINE(") of short :="); 
    TEXT_IO.PUT_LINE("    (   0,"); 
    for CNT in 1 .. LASTDFA loop
      MISC.MKDATA(ACC_ARRAY(CNT)); 

      if (TRACE and (ACC_ARRAY(CNT) /= 0)) then 
        TEXT_IO.PUT(STANDARD_ERROR, "state # "); 
        INT_IO.PUT(STANDARD_ERROR, CNT, 1); 
        TEXT_IO.PUT(STANDARD_ERROR, " accepts: ["); 
        INT_IO.PUT(STANDARD_ERROR, ACC_ARRAY(CNT), 1); 
        TEXT_IO.PUT(STANDARD_ERROR, ']'); 
        TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      end if; 
    end loop; 

    -- add entry for "jam" state
    MISC.MKDATA(ACC_ARRAY(LASTDFA + 1)); 

    MISC.DATAEND; 

    if (USEECS) then 
      GENECS; 
    end if; 

    if (USEMECS) then 

      -- write out meta-equivalence classes (used to index templates with)
      if (TRACE) then 
        TEXT_IO.NEW_LINE(STANDARD_ERROR); 
        TEXT_IO.NEW_LINE(STANDARD_ERROR); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "Meta-Equivalence Classes:"); 
      end if; 

      TEXT_IO.PUT("yy_meta : constant array(0.."); 
      INT_IO.PUT(NUMECS, 1); 
      TEXT_IO.PUT_LINE(") of short :="); 
      TEXT_IO.PUT_LINE("    (   0,"); 
      for CNT in 1 .. NUMECS loop
        if (TRACE) then 
          INT_IO.PUT(STANDARD_ERROR, CNT, 1); 
          TEXT_IO.PUT(STANDARD_ERROR, " = "); 
          INT_IO.PUT(STANDARD_ERROR, abs(TECBCK(CNT)), 1); 
          TEXT_IO.NEW_LINE(STANDARD_ERROR); 
        end if; 
        MISC.MKDATA(abs(TECBCK(CNT))); 
      end loop; 

      MISC.DATAEND; 
    end if; 

    TOTAL_STATES := LASTDFA + NUMTEMPS; 

    TEXT_IO.PUT("yy_base : constant array(0.."); 
    INT_IO.PUT(TOTAL_STATES, 1); 
    if (TBLEND > MAX_SHORT) then 
      TEXT_IO.PUT_LINE(") of integer :="); 
    else 
      TEXT_IO.PUT_LINE(") of short :="); 
    end if; 
    TEXT_IO.PUT_LINE("    (   0,"); 

    for CNT in 1 .. LASTDFA loop
      declare
        D : INTEGER := DEF(CNT); 
      begin
        if (BASE(CNT) = JAMSTATE_CONST) then 
          BASE(CNT) := JAMBASE; 
        end if; 

        if (D = JAMSTATE_CONST) then 
          DEF(CNT) := JAMSTATE; 
        else 
          if (D < 0) then 

            -- template reference
            TMPUSES := TMPUSES + 1; 
            DEF(CNT) := LASTDFA - D + 1; 
          end if; 
        end if; 
        MISC.MKDATA(BASE(CNT)); 
      end; 
    end loop; 

    -- generate jam state's base index
    I := LASTDFA + 1; 
    MISC.MKDATA(BASE(I)); 

    -- skip jam state
    I := I + 1; 

    for CNT in I .. TOTAL_STATES loop
      MISC.MKDATA(BASE(CNT)); 
      DEF(CNT) := JAMSTATE; 
    end loop; 

    MISC.DATAEND; 

    TEXT_IO.PUT("yy_def : constant array(0.."); 
    INT_IO.PUT(TOTAL_STATES, 1); 
    if (TBLEND > MAX_SHORT) then 
      TEXT_IO.PUT_LINE(") of integer :="); 
    else 
      TEXT_IO.PUT_LINE(") of short :="); 
    end if; 
    TEXT_IO.PUT_LINE("    (   0,"); 

    for CNT in 1 .. TOTAL_STATES loop
      MISC.MKDATA(DEF(CNT)); 
    end loop; 

    MISC.DATAEND; 
    TEXT_IO.PUT("yy_nxt : constant array(0.."); 
    INT_IO.PUT(TBLEND, 1); 
    if (LASTDFA > MAX_SHORT) then 
      TEXT_IO.PUT_LINE(") of integer :="); 
    else 
      TEXT_IO.PUT_LINE(") of short :="); 
    end if; 
    TEXT_IO.PUT_LINE("    (   0,"); 

    for CNT in 1 .. TBLEND loop
      if ((NXT(CNT) = 0) or (CHK(CNT) = 0)) then 
        NXT(CNT) := JAMSTATE; 

      -- new state is the JAM state
      end if; 
      MISC.MKDATA(NXT(CNT)); 
    end loop; 

    MISC.DATAEND; 

    TEXT_IO.PUT("yy_chk : constant array(0.."); 
    INT_IO.PUT(TBLEND, 1); 
    if (LASTDFA > MAX_SHORT) then 
      TEXT_IO.PUT_LINE(") of integer :="); 
    else 
      TEXT_IO.PUT_LINE(") of short :="); 
    end if; 
    TEXT_IO.PUT_LINE("    (   0,"); 

    for CNT in 1 .. TBLEND loop
      if (CHK(CNT) = 0) then 
        NUMMT := NUMMT + 1; 
      end if; 

      MISC.MKDATA(CHK(CNT)); 
    end loop; 

    MISC.DATAEND; 
  exception
    when STORAGE_ERROR => 
      MISC.AFLEXFATAL("dynamic memory failure in gentabs()"); 
  end GENTABS; 

  -- write out a string at the current indentation level, adding a final
  -- newline

  procedure INDENT_PUTS(STR : in STRING) is 
  begin
    DO_INDENT; 
    TEXT_IO.PUT_LINE(STR); 
  end INDENT_PUTS; 

  -- do_sect3_out - dumps section 3.

  procedure DO_SECT3_OUT is 
    GARBAGE : TOKEN; 
  begin
    SCANNER.CALL_YYLEX := TRUE; 
    GARBAGE := SCANNER.GET_TOKEN; 
  end DO_SECT3_OUT; 

  -- make_tables - generate transition tables
  --
  --
  -- Generates transition tables and finishes generating output file

  procedure MAKE_TABLES is 
    DID_EOF_RULE      : BOOLEAN := FALSE; 
    TRANS_OFFSET_TYPE : STRING(1 .. 7); 
    TOTAL_TABLE_SIZE  : INTEGER := TBLEND + NUMECS + 1; 
    BUF               : VSTRING; 
  begin
    if (not FULLTBL) then 

      -- if we used full tables this is already output
      DO_SECT3_OUT; 

      -- intent of this call is to get everything up to ##
      SKELETON_MANAGER.SKELOUT; 

    -- output YYLex code up to part about tables.
    end if; 

    TEXT_IO.PUT("YY_END_OF_BUFFER : constant := "); 
    INT_IO.PUT(NUM_RULES + 1, 1); 
    TEXT_IO.PUT_LINE(";"); 

    INDENT_PUTS("subtype yy_state_type is integer;"); 
    INDENT_PUTS("yy_current_state : yy_state_type;"); 

    -- now output the constants for the various start conditions
    RESET(DEF_FILE, IN_FILE); 

    while (not TEXT_IO.END_OF_FILE(DEF_FILE)) loop
      TSTRING.GET_LINE(DEF_FILE, BUF); 
      TSTRING.PUT_LINE(BUF); 
    end loop; 

    if (FULLTBL) then 
      GENFTBL; 
    else 
      GENTABS; 
    end if; 

    RESET(TEMP_ACTION_FILE, IN_FILE); 

    -- generate code for yy_get_previous_state
    SET_INDENT(1); 
    SKELETON_MANAGER.SKELOUT; 

    if (BOL_NEEDED) then 
      INDENT_PUTS("yy_bp : integer := yytext_ptr;"); 
    end if; 
    SKELETON_MANAGER.SKELOUT; 

    GEN_START_STATE; 
    SKELETON_MANAGER.SKELOUT; 
    GEN_NEXT_STATE; 
    SKELETON_MANAGER.SKELOUT; 

    SET_INDENT(2); 

    INDENT_PUTS("yy_bp := yy_cp;"); 

    GEN_START_STATE; 
    GEN_NEXT_MATCH; 

    SKELETON_MANAGER.SKELOUT; 

    SET_INDENT(3); 
    GEN_FIND_ACTION; 

    SET_INDENT(1); 
    SKELETON_MANAGER.SKELOUT; 

    INDENT_UP; 
    GEN_BT_ACTION; 

    MISC.ACTION_OUT; 
    MISC.ACTION_OUT; 

    -- generate cases for any missing EOF rules
    for I in 1 .. LASTSC loop
      if (not SCEOF(I)) then 
        DO_INDENT; 
        if (not DID_EOF_RULE) then 
          TEXT_IO.PUT("when "); 
        else 
          TEXT_IO.PUT_LINE("|"); 
        end if; 
        TEXT_IO.PUT("YY_END_OF_BUFFER + "); 
        TSTRING.PUT(SCNAME(I)); 
        TEXT_IO.PUT(" + 1 "); 
        DID_EOF_RULE := TRUE; 
      end if; 
    end loop; 
    if (DID_EOF_RULE) then 
      TEXT_IO.PUT_LINE("=> "); 
    end if; 

    if (DID_EOF_RULE) then 
      INDENT_UP; 
      INDENT_PUTS("return End_Of_Input;"); 
      INDENT_DOWN; 
    end if; 

    SKELETON_MANAGER.SKELOUT; 

    -- copy remainder of input to output
    MISC.LINE_DIRECTIVE_OUT; 
    DO_SECT3_OUT; 

  -- copy remainder of input, after ##, to the scanner file.
  end MAKE_TABLES; 

end GEN; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<














































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/gen.ads version [b73318fcc3].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE scanner generation
-- AUTHOR: John Self (UCI)
-- DESCRIPTION
-- NOTES does actual generation (writing) of output aflex scanners
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/gen.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS; use MISC_DEFS; 
package GEN is 
  procedure DO_INDENT; 
  procedure GEN_BACKTRACKING; 
  procedure GEN_BT_ACTION; 
  procedure GEN_FIND_ACTION; 
  procedure GEN_NEXT_COMPRESSED_STATE; 
  procedure GEN_NEXT_MATCH; 
  procedure GEN_NEXT_STATE; 
  procedure GEN_START_STATE; 
  procedure GENECS; 
  procedure GENFTBL; 
  procedure INDENT_PUTS(STR : in STRING); 
  procedure GENTABS; 
  procedure INDENT_DOWN; 
  procedure INDENT_UP; 
  procedure SET_INDENT(INDENT_VAL : in INTEGER); 
  procedure MAKE_TABLES; 
  procedure DO_SECT3_OUT; 
  pragma Inline(Indent_Up);
  pragma Inline(Indent_Down);
end GEN; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






























































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/int_io.ads version [769163605b].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE integer IO
-- AUTHOR: John Self (UCI)
-- DESCRIPTION instantiation of integer IO generic for integers
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/int_io.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with TEXT_IO; 
package INT_IO is 
  new TEXT_IO.INTEGER_IO(INTEGER); 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






















































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/main_body.adb version [4d0f7d51ae].

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
pragma Warnings(Off);
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE main body
-- AUTHOR: John Self (UCI)
-- DESCRIPTION driver routines for aflex.  Calls drivers for all
-- high level routines from other packages.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/main.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, Aflex_MISC, Aflex_COMMAND_LINE_INTERFACE, DFA, ECS, GEN, TEXT_IO, Aflex_PARSER; 
with MAIN_BODY, TSTRING, PARSE_TOKENS, SKELETON_MANAGER, EXTERNAL_FILE_MANAGER; 
with EXTERNAL_FILE_MANAGER, INT_IO; use MISC_DEFS, Aflex_COMMAND_LINE_INTERFACE, 
  TSTRING, EXTERNAL_FILE_MANAGER; 

package body MAIN_BODY is 
  package MISC renames Aflex_MISC;
  OUTFILE_CREATED    : BOOLEAN := FALSE; 
  AFLEX_VERSION      : CONSTANT STRING := "1.4a"; 
  STARTTIME, ENDTIME : VSTRING; 

  -- aflexend - terminate aflex
  --
  -- note
  --    This routine does not return.

  procedure AFLEXEND(STATUS : in INTEGER) is 
    use TEXT_IO; 
    TBLSIZ : INTEGER; 
  begin
    TERMINATION_STATUS := STATUS; 

    -- we'll return this value of the OS.
    if (IS_OPEN(SKELFILE)) then 
      CLOSE(SKELFILE); 
    end if; 

    if (IS_OPEN(TEMP_ACTION_FILE)) then 
      DELETE(TEMP_ACTION_FILE); 
    end if; 

    if (IS_OPEN(DEF_FILE)) then 
      DELETE(DEF_FILE); 
    end if; 

    if (BACKTRACK_REPORT) then 
      if (NUM_BACKTRACKING = 0) then 
        TEXT_IO.PUT_LINE(BACKTRACK_FILE, "No backtracking."); 
      else 
        if (FULLTBL) then 
          INT_IO.PUT(BACKTRACK_FILE, NUM_BACKTRACKING, 0); 
          TEXT_IO.PUT_LINE(BACKTRACK_FILE, 
            " backtracking (non-accepting) states."); 
        else 
          TEXT_IO.PUT_LINE(BACKTRACK_FILE, "Compressed tables always backtrack."
            ); 
        end if; 
      end if; 

      CLOSE(BACKTRACK_FILE); 
    end if; 

    if (PRINTSTATS) then 
      ENDTIME := MISC.AFLEX_GETTIME; 

      TEXT_IO.PUT_LINE(STANDARD_ERROR, "aflex version " & AFLEX_VERSION & 
        " usage statistics:"); 

      TSTRING.PUT_LINE(STANDARD_ERROR, "  started at " & STARTTIME & 
        ", finished at " & ENDTIME); 
      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, LASTNFA, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, '/'); 
      INT_IO.PUT(STANDARD_ERROR, CURRENT_MNS, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, "  NFA states"); 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, LASTDFA, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, '/'); 
      INT_IO.PUT(STANDARD_ERROR, CURRENT_MAX_DFAS, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, " DFA states ("); 
      INT_IO.PUT(STANDARD_ERROR, TOTNST, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, "  words)"); 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, NUM_RULES - 1, 0); 

      -- - 1 for def. rule
      TEXT_IO.PUT_LINE(STANDARD_ERROR, "  rules"); 

      if (NUM_BACKTRACKING = 0) then 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "  No backtracking"); 
      else 
        if (FULLTBL) then 
          TEXT_IO.PUT(STANDARD_ERROR, "  "); 
          INT_IO.PUT(STANDARD_ERROR, NUM_BACKTRACKING, 0); 
          TEXT_IO.PUT_LINE(STANDARD_ERROR, 
            "  backtracking (non-accepting) states"); 
        else 
          TEXT_IO.PUT_LINE(STANDARD_ERROR, " compressed tables always backtrack"
            ); 
        end if; 
      end if; 

      if (BOL_NEEDED) then 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "  Beginning-of-line patterns used"); 
      end if; 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, LASTSC, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, '/'); 
      INT_IO.PUT(STANDARD_ERROR, CURRENT_MAX_SCS, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " start conditions"); 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, NUMEPS, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, " epsilon states, "); 
      INT_IO.PUT(STANDARD_ERROR, EPS2, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, "  double epsilon states"); 

      if (LASTCCL = 0) then 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "  no character classes"); 
      else 
        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, LASTCCL, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CURRENT_MAXCCLS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, " character classes needed "); 
        INT_IO.PUT(STANDARD_ERROR, CCLMAP(LASTCCL) + CCLLEN(LASTCCL), 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CURRENT_MAX_CCL_TBL_SIZE, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, " words of storage, "); 
        INT_IO.PUT(STANDARD_ERROR, CCLREUSE, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "reused"); 
      end if; 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, NUMSNPAIRS, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " state/nextstate pairs created"); 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, NUMUNIQ, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, '/'); 
      INT_IO.PUT(STANDARD_ERROR, NUMDUP, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " unique/duplicate transitions"); 

      if (FULLTBL) then 
        TBLSIZ := LASTDFA*NUMECS; 
        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, TBLSIZ, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, " table entries"); 
      else 
        TBLSIZ := 2*(LASTDFA + NUMTEMPS) + 2*TBLEND; 

        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, LASTDFA + NUMTEMPS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CURRENT_MAX_DFAS, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, " base-def entries created"); 

        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, TBLEND, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CURRENT_MAX_XPAIRS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, " (peak "); 
        INT_IO.PUT(STANDARD_ERROR, PEAKPAIRS, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, ") nxt-chk entries created"); 

        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, NUMTEMPS*NUMMECS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CURRENT_MAX_TEMPLATE_XPAIRS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, " (peak "); 
        INT_IO.PUT(STANDARD_ERROR, NUMTEMPS*NUMECS, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, ") template nxt-chk entries created"); 

        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, NUMMT, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, " empty table entries"); 
        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, NUMPROTS, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, " protos created"); 
        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, NUMTEMPS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, " templates created, "); 
        INT_IO.PUT(STANDARD_ERROR, TMPUSES, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "uses"); 
      end if; 

      if (USEECS) then 
        TBLSIZ := TBLSIZ + CSIZE; 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, NUMECS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CSIZE, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, " equivalence classes created"); 
      end if; 

      if (USEMECS) then 
        TBLSIZ := TBLSIZ + NUMECS; 
        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, NUMMECS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CSIZE, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, " meta-equivalence classes created"); 
      end if; 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, HSHCOL, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, " ("); 
      INT_IO.PUT(STANDARD_ERROR, HSHSAVE, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " saved) hash collisions, "); 
      INT_IO.PUT(STANDARD_ERROR, DFAEQL, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " DFAs equal"); 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, NUM_REALLOCS, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " sets of reallocations needed"); 
      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, TBLSIZ, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " total table entries needed"); 
    end if; 

    if (STATUS /= 0) then 
      raise AFLEX_TERMINATE; 
    end if; 
  end AFLEXEND; 

  -- aflexinit - initialize aflex

  procedure AFLEXINIT is 
    use TEXT_IO, TSTRING; 
    SAWCMPFLAG, USE_STDOUT : BOOLEAN; 
    OUTPUT_FILE            : FILE_TYPE; 
    INPUT_FILE             : FILE_TYPE; 
    I                      : INTEGER; 
    ARG_CNT                : INTEGER; 
    FLAG_POS               : INTEGER; 
    ARG                    : VSTRING; 
    SKELNAME               : VSTRING; 
    SKELNAME_USED          : BOOLEAN := FALSE; 
  begin
    PRINTSTATS := FALSE; 
    SYNTAXERROR := FALSE; 
    TRACE := FALSE; 
    SPPRDFLT := FALSE; 
    INTERACTIVE := FALSE; 
    CASEINS := FALSE; 
    BACKTRACK_REPORT := FALSE; 
    PERFORMANCE_REPORT := FALSE; 
    DDEBUG := FALSE; 
    FULLTBL := FALSE; 
    CONTINUED_ACTION := FALSE; 
    GEN_LINE_DIRS := TRUE; 
    USEMECS := TRUE; 
    USEECS := TRUE; 

    SAWCMPFLAG := FALSE; 
    USE_STDOUT := FALSE; 

    -- read flags
    Aflex_COMMAND_LINE_INTERFACE.INITIALIZE_COMMAND_LINE; 

    -- load up argv
    EXTERNAL_FILE_MANAGER.INITIALIZE_FILES; 

    -- do external files setup

    -- loop through the list of arguments
    ARG_CNT := 1; 
    while (ARG_CNT <= ARGC - 1) loop
      if ((CHAR(ARGV(ARG_CNT), 1) /= '-') or (LEN(ARGV(ARG_CNT)) < 2)) then 
        exit; 
      end if; 

      -- loop through the flags in this argument.
      ARG := ARGV(ARG_CNT); 
      FLAG_POS := 2; 
      while (FLAG_POS <= LEN(ARG)) loop
        case CHAR(ARG, FLAG_POS) is 
          when 'b' => 
            BACKTRACK_REPORT := TRUE; 
          when 'd' => 
            DDEBUG := TRUE; 
          when 'f' => 
            USEECS := FALSE; 
            USEMECS := FALSE; 
            FULLTBL := TRUE; 
          when 'I' => 
            INTERACTIVE := TRUE; 
          when 'i' => 
            CASEINS := TRUE; 
          when 'L' => 
            GEN_LINE_DIRS := FALSE; 
          when 'p' => 
            PERFORMANCE_REPORT := TRUE; 
          when 'S' => 
            if (FLAG_POS /= 2) then 
              MISC.AFLEXERROR("-S flag must be given separately"); 
            end if; 
            SKELNAME := SLICE(ARG, FLAG_POS + 1, LEN(ARG)); 
            SKELNAME_USED := TRUE; 
            goto GET_NEXT_ARG; 
          when 's' => 
            SPPRDFLT := TRUE; 
          when 't' => 
            USE_STDOUT := TRUE; 
          when 'T' => 
            TRACE := TRUE; 
          when 'v' => 
            PRINTSTATS := TRUE; 
-- UMASS CODES :
--    Added an flag to indicate whether or not the aflex generated
--    codes will be used by Ayacc extension. Ayacc extension has
--    more power in error recovery.
          when 'E' =>
            Ayacc_Extension_Flag := TRUE;
-- END OF UMASS CODES.
          when others => 
            MISC.AFLEXERROR("unknown flag " & CHAR(ARG, FLAG_POS)); 
        end case; 
        FLAG_POS := FLAG_POS + 1; 
      end loop; 
      <<GET_NEXT_ARG>> ARG_CNT := ARG_CNT + 1; 

    -- go on to next argument from list.
    end loop; 

    if (FULLTBL and USEMECS) then 
      MISC.AFLEXERROR("full table and -cm don't make sense together"); 
    end if; 

    if (FULLTBL and INTERACTIVE) then 
      MISC.AFLEXERROR("full table and -I are (currently) incompatible"); 
    end if; 

    if (ARG_CNT < ARGC) then 
      begin
        if (ARG_CNT - ARGC > 1) then 
          MISC.AFLEXERROR("extraneous argument(s) given"); 
        end if; 

        -- Tell aflex where to read input from.
        INFILENAME := ARGV(ARG_CNT); 
        OPEN(INPUT_FILE, IN_FILE, STR(ARGV(ARG_CNT))); 
        SET_INPUT(INPUT_FILE); 
      exception
        when NAME_ERROR => 
          MISC.AFLEXFATAL("can't open " & INFILENAME); 
      end; 
    end if; 

    if (not USE_STDOUT) then 
      EXTERNAL_FILE_MANAGER.GET_SCANNER_FILE(OUTPUT_FILE); 
      OUTFILE_CREATED := TRUE; 
    end if; 

    if (BACKTRACK_REPORT) then 
      EXTERNAL_FILE_MANAGER.GET_BACKTRACK_FILE(BACKTRACK_FILE); 
    end if; 

    LASTCCL := 0; 
    LASTSC := 0; 


    --initialize the statistics
    STARTTIME := MISC.AFLEX_GETTIME; 

    begin

      -- open the skeleton file
      if (SKELNAME_USED) then 
        OPEN(SKELFILE, IN_FILE, STR(SKELNAME)); 
        SKELETON_MANAGER.SET_EXTERNAL_SKELETON; 
      end if; 
    exception
      when USE_ERROR | NAME_ERROR => 
        MISC.AFLEXFATAL("couldn't open skeleton file " & SKELNAME); 
    end; 

    -- without a third argument create make an anonymous temp file.
    begin
      CREATE(TEMP_ACTION_FILE, OUT_FILE); 
      CREATE(DEF_FILE, OUT_FILE); 
    exception
      when USE_ERROR | NAME_ERROR => 
        MISC.AFLEXFATAL("can't create temporary file"); 
    end; 

    LASTDFA := 0; 
    LASTNFA := 0; 
    NUM_RULES := 0; 
    NUMAS := 0; 
    NUMSNPAIRS := 0; 
    TMPUSES := 0; 
    NUMECS := 0; 
    NUMEPS := 0; 
    EPS2 := 0; 
    NUM_REALLOCS := 0; 
    HSHCOL := 0; 
    DFAEQL := 0; 
    TOTNST := 0; 
    NUMUNIQ := 0; 
    NUMDUP := 0; 
    HSHSAVE := 0; 
    EOFSEEN := FALSE; 
    DATAPOS := 0; 
    DATALINE := 0; 
    NUM_BACKTRACKING := 0; 
    ONESP := 0; 
    NUMPROTS := 0; 
    VARIABLE_TRAILING_CONTEXT_RULES := FALSE; 
    BOL_NEEDED := FALSE; 

    LINENUM := 1; 
    SECTNUM := 1; 
    FIRSTPROT := NIL; 

    -- used in mkprot() so that the first proto goes in slot 1
    -- of the proto queue

    LASTPROT := 1; 

    if (USEECS) then 
    -- set up doubly-linked equivalence classes
      ECGROUP(1) := NIL; 

      for CNT in 2 .. CSIZE loop
        ECGROUP(CNT) := CNT - 1; 
        NEXTECM(CNT - 1) := CNT; 
      end loop; 

      NEXTECM(CSIZE) := NIL; 
    else 
    -- put everything in its own equivalence class
      for CNT in 1 .. CSIZE loop
        ECGROUP(CNT) := CNT; 
        NEXTECM(CNT) := BAD_SUBSCRIPT;  -- to catch errors
      end loop; 
    end if; 

    SET_UP_INITIAL_ALLOCATIONS; 


  end AFLEXINIT; 

  -- readin - read in the rules section of the input file(s)
  procedure READIN is 
  begin
    SKELETON_MANAGER.SKELOUT; 
    TEXT_IO.PUT("with " & TSTRING.STR(MISC.BASENAME) & "_dfa" & "; "); 
    TEXT_IO.PUT_LINE("use " & TSTRING.STR(MISC.BASENAME) & "_dfa" & "; "); 
    TEXT_IO.PUT("with " & TSTRING.STR(MISC.BASENAME) & "_io" & "; "); 
    TEXT_IO.PUT_LINE("use " & TSTRING.STR(MISC.BASENAME) & "_io" & "; "); 
    MISC.LINE_DIRECTIVE_OUT; 

    Aflex_PARSER.YYPARSE; 

    if (USEECS) then 
      ECS.CRE8ECS(NEXTECM, ECGROUP, CSIZE, NUMECS); 
      ECS.CCL2ECL; 
    else 
      NUMECS := CSIZE; 
    end if; 
  exception
    when PARSE_TOKENS.SYNTAX_ERROR => 
      MISC.AFLEXERROR("fatal parse error at line " & INTEGER'IMAGE(LINENUM)); 
      MAIN_BODY.AFLEXEND(1); 
  end READIN; 

  -- set_up_initial_allocations - allocate memory for internal tables
  procedure SET_UP_INITIAL_ALLOCATIONS is 
  begin
    CURRENT_MNS := INITIAL_MNS; 
    FIRSTST := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    LASTST := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    FINALST := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    TRANSCHAR := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    TRANS1 := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    TRANS2 := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    ACCPTNUM := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    ASSOC_RULE := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    STATE_TYPE := ALLOCATE_STATE_ENUM_ARRAY(CURRENT_MNS); 

    CURRENT_MAX_RULES := INITIAL_MAX_RULES; 
    RULE_TYPE := ALLOCATE_RULE_ENUM_ARRAY(CURRENT_MAX_RULES); 
    RULE_LINENUM := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_RULES); 

    CURRENT_MAX_SCS := INITIAL_MAX_SCS; 
    SCSET := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_SCS); 
    SCBOL := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_SCS); 
    SCXCLU := ALLOCATE_BOOLEAN_ARRAY(CURRENT_MAX_SCS); 
    SCEOF := ALLOCATE_BOOLEAN_ARRAY(CURRENT_MAX_SCS); 
    SCNAME := ALLOCATE_VSTRING_ARRAY(CURRENT_MAX_SCS); 
    ACTVSC := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_SCS); 

    CURRENT_MAXCCLS := INITIAL_MAX_CCLS; 
    CCLMAP := ALLOCATE_INTEGER_ARRAY(CURRENT_MAXCCLS); 
    CCLLEN := ALLOCATE_INTEGER_ARRAY(CURRENT_MAXCCLS); 
    CCLNG := ALLOCATE_INTEGER_ARRAY(CURRENT_MAXCCLS); 

    CURRENT_MAX_CCL_TBL_SIZE := INITIAL_MAX_CCL_TBL_SIZE; 
    CCLTBL := ALLOCATE_CHARACTER_ARRAY(CURRENT_MAX_CCL_TBL_SIZE); 

    CURRENT_MAX_DFA_SIZE := INITIAL_MAX_DFA_SIZE; 

    CURRENT_MAX_XPAIRS := INITIAL_MAX_XPAIRS; 
    NXT := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_XPAIRS); 
    CHK := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_XPAIRS); 

    CURRENT_MAX_TEMPLATE_XPAIRS := INITIAL_MAX_TEMPLATE_XPAIRS; 
    TNXT := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_TEMPLATE_XPAIRS); 

    CURRENT_MAX_DFAS := INITIAL_MAX_DFAS; 
    BASE := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFAS); 
    DEF := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFAS); 
    DFASIZ := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFAS); 
    ACCSIZ := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFAS); 
    DHASH := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFAS); 
    DSS := ALLOCATE_INT_PTR_ARRAY(CURRENT_MAX_DFAS); 
    DFAACC := ALLOCATE_DFAACC_UNION(CURRENT_MAX_DFAS); 
  end SET_UP_INITIAL_ALLOCATIONS; 
end MAIN_BODY; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/main_body.ads version [5fdf400161].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE main body
-- AUTHOR: John Self (UCI)
-- DESCRIPTION driver routines for aflex.  Calls drivers for all
-- high level routines from other packages.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/main.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

-- aflex - tool to generate fast lexical analyzers
package MAIN_BODY is 
  procedure AFLEXEND(STATUS : in INTEGER); 
  procedure AFLEXINIT; 
  procedure READIN; 
  procedure SET_UP_INITIAL_ALLOCATIONS; 
  AFLEX_TERMINATE    : exception; 
  TERMINATION_STATUS : INTEGER; 
end MAIN_BODY; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/misc_defs.adb version [ce46e86682].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE miscellaneous definitions
-- AUTHOR: John Self (UCI)
-- DESCRIPTION contains all global variables used in aflex.
--             also some subprograms which are commonly used.
-- NOTES The real purpose of this file is to contain all miscellaneous
--       items (functions, MACROS, variables definitions) which were at the
--       top level of flex.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/misc_defs.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

package body MISC_DEFS is 

-- returns true if an nfa state has an epsilon out-transition slot
-- that can be used.  This definition is currently not used.

  function FREE_EPSILON(STATE : in INTEGER) return BOOLEAN is 
  begin
    return ((TRANSCHAR(STATE) = SYM_EPSILON) and (TRANS2(STATE) = NO_TRANSITION)
      and (FINALST(STATE) /= STATE)); 
  end FREE_EPSILON; 

  -- returns true if an nfa state has an epsilon out-transition character
  -- and both slots are free

  function SUPER_FREE_EPSILON(STATE : in INTEGER) return BOOLEAN is 
  begin
    return ((TRANSCHAR(STATE) = SYM_EPSILON) and (TRANS1(STATE) = NO_TRANSITION)
      ); 
  end SUPER_FREE_EPSILON; 

  function ALLOCATE_INTEGER_ARRAY(SIZE : in INTEGER) return INT_PTR is 
  begin
    return new UNBOUNDED_INT_ARRAY(0 .. SIZE); 
  end ALLOCATE_INTEGER_ARRAY; 

  procedure REALLOCATE_INTEGER_ARRAY(ARR  : in out INT_PTR; 
                                     SIZE : in INTEGER) is 
    NEW_ARR : INT_PTR; 
  begin
    NEW_ARR := ALLOCATE_INTEGER_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_INTEGER_ARRAY; 

  procedure REALLOCATE_STATE_ENUM_ARRAY(ARR  : in out STATE_ENUM_PTR; 
                                        SIZE : in INTEGER) is 
    NEW_ARR : STATE_ENUM_PTR; 
  begin
    NEW_ARR := ALLOCATE_STATE_ENUM_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_STATE_ENUM_ARRAY; 

  procedure REALLOCATE_RULE_ENUM_ARRAY(ARR  : in out RULE_ENUM_PTR; 
                                       SIZE : in INTEGER) is 
    NEW_ARR : RULE_ENUM_PTR; 
  begin
    NEW_ARR := ALLOCATE_RULE_ENUM_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_RULE_ENUM_ARRAY; 

  function ALLOCATE_INT_PTR_ARRAY(SIZE : in INTEGER) return INT_STAR_PTR is 
  begin
    return new UNBOUNDED_INT_STAR_ARRAY(0 .. SIZE); 
  end ALLOCATE_INT_PTR_ARRAY; 

  function ALLOCATE_RULE_ENUM_ARRAY(SIZE : in INTEGER) return RULE_ENUM_PTR is 
  begin
    return new UNBOUNDED_RULE_ENUM_ARRAY(0 .. SIZE); 
  end ALLOCATE_RULE_ENUM_ARRAY; 

  function ALLOCATE_STATE_ENUM_ARRAY(SIZE : in INTEGER) return STATE_ENUM_PTR
    is 
  begin
    return new UNBOUNDED_STATE_ENUM_ARRAY(0 .. SIZE); 
  end ALLOCATE_STATE_ENUM_ARRAY; 

  function ALLOCATE_BOOLEAN_ARRAY(SIZE : in INTEGER) return BOOLEAN_PTR is 
  begin
    return new BOOLEAN_ARRAY(0 .. SIZE); 
  end ALLOCATE_BOOLEAN_ARRAY; 

  function ALLOCATE_VSTRING_ARRAY(SIZE : in INTEGER) return VSTRING_PTR is 
  begin
    return new UNBOUNDED_VSTRING_ARRAY(0 .. SIZE); 
  end ALLOCATE_VSTRING_ARRAY; 

  function ALLOCATE_DFAACC_UNION(SIZE : in INTEGER) return DFAACC_PTR is 
  begin
    return new UNBOUNDED_DFAACC_ARRAY(0 .. SIZE); 
  end ALLOCATE_DFAACC_UNION; 

  procedure REALLOCATE_INT_PTR_ARRAY(ARR  : in out INT_STAR_PTR; 
                                     SIZE : in INTEGER) is 
    NEW_ARR : INT_STAR_PTR; 
  begin
    NEW_ARR := ALLOCATE_INT_PTR_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_INT_PTR_ARRAY; 

  procedure REALLOCATE_CHARACTER_ARRAY(ARR  : in out CHAR_PTR; 
                                       SIZE : in INTEGER) is 
    NEW_ARR : CHAR_PTR; 
  begin
    NEW_ARR := ALLOCATE_CHARACTER_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_CHARACTER_ARRAY; 

  procedure REALLOCATE_VSTRING_ARRAY(ARR  : in out VSTRING_PTR; 
                                     SIZE : in INTEGER) is 
    NEW_ARR : VSTRING_PTR; 
  begin
    NEW_ARR := ALLOCATE_VSTRING_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_VSTRING_ARRAY; 

  function ALLOCATE_CHARACTER_ARRAY(SIZE : in INTEGER) return CHAR_PTR is 
  begin
    return new CHAR_ARRAY(0 .. SIZE); 
  end ALLOCATE_CHARACTER_ARRAY; 

  procedure REALLOCATE_DFAACC_UNION(ARR  : in out DFAACC_PTR; 
                                    SIZE : in INTEGER) is 
    NEW_ARR : DFAACC_PTR; 
  begin
    NEW_ARR := ALLOCATE_DFAACC_UNION(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_DFAACC_UNION; 

  procedure REALLOCATE_BOOLEAN_ARRAY(ARR  : in out BOOLEAN_PTR; 
                                     SIZE : in INTEGER) is 
    NEW_ARR : BOOLEAN_PTR; 
  begin
    NEW_ARR := ALLOCATE_BOOLEAN_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_BOOLEAN_ARRAY; 

  function MAX(X, Y : in INTEGER) return INTEGER is 
  begin
    if (X > Y) then 
      return X; 
    else 
      return Y; 
    end if; 
  end MAX; 

  function MIN(X, Y : in INTEGER) return INTEGER is 
  begin
    if (X < Y) then 
      return X; 
    else 
      return Y; 
    end if; 
  end MIN; 

end MISC_DEFS; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/misc_defs.ads version [2d3f220b83].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE miscellaneous definitions
-- AUTHOR: John Self (UCI)
-- DESCRIPTION contains all global variables used in aflex.
--             also some subprograms which are commonly used.
-- NOTES The real purpose of this file is to contain all miscellaneous
--       items (functions, MACROS, variables definitions) which were at the
--       top level of flex.
-- $Header: /co/ua/self/arcadia/alex/ada/RCS/misc_defsS.a,v 1.8 90/01/04 13:39:
-- 33 self Exp Locker: self $ 

with TEXT_IO, TSTRING;
use TEXT_IO, TSTRING;

package MISC_DEFS is

-- UMASS CODES :
  Ayacc_Extension_Flag : Boolean := False;
  -- Indicates whether or not aflex generated codes will be
  -- used by Ayacc extension. Ayacc extension has more power
  -- in error recovery. True means that generated codes will
  -- be used by Ayacc extension.
-- END OF UMASS CODES.

  -- various definitions that were in parse.y
  PAT, SCNUM, EPS, HEADCNT, TRAILCNT, ANYCCL, LASTCHAR, ACTVP, RULELEN : INTEGER
    ;
  TRLCONTXT, XCLUFLG, CCLSORTED, VARLENGTH, VARIABLE_TRAIL_RULE : BOOLEAN;

  MADEANY : BOOLEAN := FALSE;  -- whether we've made the '.' character class 
  PREVIOUS_CONTINUED_ACTION : BOOLEAN; -- whether the previous rule's action wa
                                       -- s '|'

  -- maximum line length we'll have to deal with 
  MAXLINE : constant INTEGER := 1024;

  -- These typees are needed for the various allocators.
  type UNBOUNDED_INT_ARRAY is array ( INTEGER range <> ) of INTEGER;
  type INT_PTR is access UNBOUNDED_INT_ARRAY;
  type INT_STAR is access INTEGER;
  type UNBOUNDED_INT_STAR_ARRAY is array ( INTEGER range <> ) of INT_PTR;
  type INT_STAR_PTR is access UNBOUNDED_INT_STAR_ARRAY;
  type UNBOUNDED_VSTRING_ARRAY is array ( INTEGER range <> ) of VSTRING;
  type VSTRING_PTR is access UNBOUNDED_VSTRING_ARRAY;
  type BOOLEAN_ARRAY is array ( INTEGER range <> ) of BOOLEAN;
  type BOOLEAN_PTR is access BOOLEAN_ARRAY;
  type CHAR_ARRAY is array ( INTEGER range <> ) of CHARACTER;
  type CHAR_PTR is access CHAR_ARRAY;

  -- different types of states; values are useful as masks, as well, for
  -- routines like check_trailing_context()

  type STATE_ENUM is (STATE_NORMAL, STATE_TRAILING_CONTEXT);

  type UNBOUNDED_STATE_ENUM_ARRAY is array ( INTEGER range <> ) of STATE_ENUM;
  type STATE_ENUM_PTR is access UNBOUNDED_STATE_ENUM_ARRAY;

  -- different types of rules
  type RULE_ENUM is (RULE_NORMAL, RULE_VARIABLE);

  type UNBOUNDED_RULE_ENUM_ARRAY is array ( INTEGER range <> ) of RULE_ENUM;
  type RULE_ENUM_PTR is access UNBOUNDED_RULE_ENUM_ARRAY;

  type DFAACC_TYPE is
    record
      DFAACC_SET : INT_PTR;
      DFAACC_STATE : INTEGER;
    end record;

  type UNBOUNDED_DFAACC_ARRAY is array ( INTEGER range <> ) of DFAACC_TYPE;
  type DFAACC_PTR is access UNBOUNDED_DFAACC_ARRAY;

  -- maximum size of file name 

  FILENAMESIZE : constant INTEGER := 1024;

  function MIN (X, Y : in INTEGER) return INTEGER;
  function MAX (X, Y : in INTEGER) return INTEGER;

  -- special chk[] values marking the slots taking by end-of-buffer and action
  -- numbers

  EOB_POSITION : constant INTEGER := - 1;
  ACTION_POSITION : constant INTEGER := - 2;

  -- number of data items per line for -f output
  NUMDATAITEMS : constant INTEGER := 10;

  -- number of lines of data in -f output before inserting a blank line for
  -- readability.

  NUMDATALINES : constant INTEGER := 10;

  -- transition_struct_out() definitions
  TRANS_STRUCT_PRINT_LENGTH : constant INTEGER := 15;

  -- returns true if an nfa state has an epsilon out-transition slot
  -- that can be used.  This definition is currently not used.

  function FREE_EPSILON ( STATE : in INTEGER) return BOOLEAN;

  -- returns true if an nfa state has an epsilon out-transition character
  -- and both slots are free

  function SUPER_FREE_EPSILON (STATE : in INTEGER) return BOOLEAN;

  -- maximum number of NFA states that can comprise a DFA state.  It's real
  -- big because if there's a lot of rules, the initial state will have a
  -- huge epsilon closure.

  INITIAL_MAX_DFA_SIZE : constant INTEGER := 750;
  MAX_DFA_SIZE_INCREMENT : constant INTEGER := 750;

  -- a note on the following masks.  They are used to mark accepting numbers
  -- as being special.  As such, they implicitly limit the number of accepting
  -- numbers (i.e., rules) because if there are too many rules the rule numbers
  -- will overload the mask bits.  Fortunately, this limit is \large/ (0x2000 ==
  -- 8192) so unlikely to actually cause any problems.  A check is made in
  -- new_rule() to ensure that this limit is not reached.

  -- mask to mark a trailing context accepting number
  -- #define YY_TRAILING_MASK 0x2000
  YY_TRAILING_MASK : constant INTEGER := 16#2000#;


  -- mask to mark the accepting number of the "head" of a trailing context rule
  -- #define YY_TRAILING_HEAD_MASK 0x4000
  YY_TRAILING_HEAD_MASK : constant INTEGER := 16#4000#;

  -- maximum number of rules, as outlined in the above note
  MAX_RULE : constant INTEGER := YY_TRAILING_MASK - 1;


  -- NIL must be 0.  If not, its special meaning when making equivalence classes
  -- (it marks the representative of a given e.c.) will be unidentifiable

  NIL : constant INTEGER := 0;

  JAM : constant INTEGER := - 1; -- to mark a missing DFA transition 
  NO_TRANSITION : constant INTEGER := NIL;
  UNIQUE : constant INTEGER := - 1; -- marks a symbol as an e.c. representative
  INFINITY : constant INTEGER := - 1; -- for x{5,} constructions

  -- size of input alphabet - should be size of ASCII set
  CSIZE : constant INTEGER := 255;  -- ##stt 3/2/2011 was 127

  INITIAL_MAX_CCLS : constant INTEGER := 100; -- max number of unique character
                                              --  classes
  MAX_CCLS_INCREMENT : constant INTEGER := 100;

  -- size of table holding members of character classes
  INITIAL_MAX_CCL_TBL_SIZE : constant INTEGER := 500;
  MAX_CCL_TBL_SIZE_INCREMENT : constant INTEGER := 250;
  INITIAL_MAX_RULES : constant INTEGER := 100;
  -- default maximum number of rules
  MAX_RULES_INCREMENT : constant INTEGER := 100;

  INITIAL_MNS : constant INTEGER := 2000; -- default maximum number of nfa stat
                                          -- es
  MNS_INCREMENT : constant INTEGER := 1000; -- amount to bump above by if it's 
                                            -- not enough

  INITIAL_MAX_DFAS : constant INTEGER := 1000; -- default maximum number of dfa
                                               --  states
  MAX_DFAS_INCREMENT : constant INTEGER := 1000;

  JAMSTATE_CONST : constant INTEGER := - 32766; -- marks a reference to the sta
                                                -- te that always jams

  -- enough so that if it's subtracted from an NFA state number, the result
  -- is guaranteed to be negative

  MARKER_DIFFERENCE : constant INTEGER := 32000;
  MAXIMUM_MNS : constant INTEGER := 31999;

  -- maximum number of nxt/chk pairs for non-templates
  INITIAL_MAX_XPAIRS : constant INTEGER := 2000;
  MAX_XPAIRS_INCREMENT : constant INTEGER := 2000;

  -- maximum number of nxt/chk pairs needed for templates
  INITIAL_MAX_TEMPLATE_XPAIRS : constant INTEGER := 2500;
  MAX_TEMPLATE_XPAIRS_INCREMENT : constant INTEGER := 2500;

  SYM_EPSILON : constant INTEGER := 0; -- to mark transitions on the symbol eps
                                       -- ilon

  INITIAL_MAX_SCS : constant INTEGER := 40; -- maximum number of start conditio
                                            -- ns
  MAX_SCS_INCREMENT : constant INTEGER := 40; -- amount to bump by if it's not 
                                              -- enough

  ONE_STACK_SIZE : constant INTEGER := 500; -- stack of states with only one ou
                                            -- t-transition
  SAME_TRANS : constant INTEGER := - 1; -- transition is the same as "default" 
                                        -- entry for state

  -- the following percentages are used to tune table compression:
  --
  -- the percentage the number of out-transitions a state must be of the
  -- number of equivalence classes in order to be considered for table
  -- compaction by using protos

  PROTO_SIZE_PERCENTAGE : constant INTEGER := 15;

  -- the percentage the number of homogeneous out-transitions of a state
  -- must be of the number of total out-transitions of the state in order
  -- that the state's transition table is first compared with a potential 
  -- template of the most common out-transition instead of with the first
  --proto in the proto queue

  CHECK_COM_PERCENTAGE : constant INTEGER := 50;

  -- the percentage the number of differences between a state's transition
  -- table and the proto it was first compared with must be of the total
  -- number of out-transitions of the state in order to keep the first
  -- proto as a good match and not search any further

  FIRST_MATCH_DIFF_PERCENTAGE : constant INTEGER := 10;

  -- the percentage the number of differences between a state's transition
  -- table and the most similar proto must be of the state's total number
  -- of out-transitions to use the proto as an acceptable close match

  ACCEPTABLE_DIFF_PERCENTAGE : constant INTEGER := 50;

  -- the percentage the number of homogeneous out-transitions of a state
  -- must be of the number of total out-transitions of the state in order
  -- to consider making a template from the state

  TEMPLATE_SAME_PERCENTAGE : constant INTEGER := 60;

  -- the percentage the number of differences between a state's transition
  -- table and the most similar proto must be of the state's total number
  -- of out-transitions to create a new proto from the state

  NEW_PROTO_DIFF_PERCENTAGE : constant INTEGER := 20;

  -- the percentage the total number of out-transitions of a state must be
  -- of the number of equivalence classes in order to consider trying to
  -- fit the transition table into "holes" inside the nxt/chk table.

  INTERIOR_FIT_PERCENTAGE : constant INTEGER := 15;

  -- size of region set aside to cache the complete transition table of
  -- protos on the proto queue to enable quick comparisons

  PROT_SAVE_SIZE : constant INTEGER := 2000;

  MSP : constant INTEGER := 50; -- maximum number of saved protos (protos on th
                                -- e proto queue)

  -- maximum number of out-transitions a state can have that we'll rummage
  -- around through the interior of the internal fast table looking for a
  -- spot for it

  MAX_XTIONS_FULL_INTERIOR_FIT : constant INTEGER := 4;

  -- maximum number of rules which will be reported as being associated
  -- with a DFA state

  MAX_ASSOC_RULES : constant INTEGER := 100;

  -- number that, if used to subscript an array, has a good chance of producing
  -- an error; should be small enough to fit into a short

  BAD_SUBSCRIPT : constant INTEGER := - 32767;

  -- Declarations for global variables.

  -- variables for symbol tables:
  -- sctbl - start-condition symbol table
  -- ndtbl - name-definition symbol table
  -- ccltab - character class text symbol table

  type HASH_ENTRY;
  type HASH_LINK is access HASH_ENTRY;
  type HASH_ENTRY is
    record
      PREV, NEXT : HASH_LINK;
      NAME, STR_VAL : VSTRING;
      INT_VAL : INTEGER;
    end record;

  type HASH_TABLE is array ( INTEGER range <> ) of HASH_LINK;

  NAME_TABLE_HASH_SIZE : constant INTEGER := 101;
  START_COND_HASH_SIZE : constant INTEGER := 101;
  CCL_HASH_SIZE : constant INTEGER := 101;

  subtype NDTBL_TYPE is HASH_TABLE (0 .. NAME_TABLE_HASH_SIZE - 1);
  NDTBL : NDTBL_TYPE;
  subtype SCTBL_TYPE is HASH_TABLE (0 .. START_COND_HASH_SIZE - 1);
  SCTBL : SCTBL_TYPE;
  subtype CCLTAB_TYPE is HASH_TABLE (0 .. CCL_HASH_SIZE);
  CCLTAB : CCLTAB_TYPE;

  -- variables for flags:
  -- printstats - if true (-v), dump statistics
  -- syntaxerror - true if a syntax error has been found
  -- eofseen - true if we've seen an eof in the input file
  -- ddebug - if true (-d), make a "debug" scanner
  -- trace - if true (-T), trace processing
  -- spprdflt - if true (-s), suppress the default rule
  -- interactive - if true (-I), generate an interactive scanner
  -- caseins - if true (-i), generate a case-insensitive scanner
  -- useecs - if true (-ce flag), use equivalence classes
  -- fulltbl - if true (-cf flag), don't compress the DFA state table
  -- usemecs - if true (-cm flag), use meta-equivalence classes
  -- gen_line_dirs - if true (i.e., no -L flag), generate #line directives
  -- performance_report - if true (i.e., -p flag), generate a report relating
  --   to scanner performance
  -- backtrack_report - if true (i.e., -b flag), generate "lex.backtrack" file
  --   listing backtracking states
  -- continued_action - true if this rule's action is to "fall through" to
  --                    the next rule's action (i.e., the '|' action)

  PRINTSTATS, DDEBUG, SPPRDFLT,
  INTERACTIVE, CASEINS, USEECS, FULLTBL, USEMECS,
  GEN_LINE_DIRS, PERFORMANCE_REPORT, BACKTRACK_REPORT,
  TRACE, EOFSEEN, CONTINUED_ACTION : BOOLEAN;

  SYNTAXERROR : BOOLEAN;

  -- variables used in the aflex input routines:
  -- datapos - characters on current output line
  -- dataline - number of contiguous lines of data in current data
  --    statement.  Used to generate readable -f output
  -- skelfile - the skeleton file
  -- yyin - input file
  -- temp_action_file - temporary file to hold actions
  -- backtrack_file - file to summarize backtracking states to
  -- infilename - name of input file
  -- linenum - current input line number

  DATAPOS, DATALINE, LINENUM : INTEGER;

  SKELFILE, YYIN, TEMP_ACTION_FILE, BACKTRACK_FILE, DEF_FILE : FILE_TYPE;
  INFILENAME : VSTRING;

  -- variables for stack of states having only one out-transition:
  -- onestate - state number
  -- onesym - transition symbol
  -- onenext - target state
  -- onedef - default base entry
  -- onesp - stack pointer

  ONESTATE, ONESYM, ONENEXT, ONEDEF : array (0 .. ONE_STACK_SIZE - 1) of INTEGER
    ;
  ONESP : INTEGER;


  -- variables for nfa machine data:
  -- current_mns - current maximum on number of NFA states
  -- num_rules - number of the last accepting state; also is number of
  --             rules created so far
  -- current_max_rules - current maximum number of rules
  -- lastnfa - last nfa state number created
  -- firstst - physically the first state of a fragment
  -- lastst - last physical state of fragment
  -- finalst - last logical state of fragment
  -- transchar - transition character
  -- trans1 - transition state
  -- trans2 - 2nd transition state for epsilons
  -- accptnum - accepting number
  -- assoc_rule - rule associated with this NFA state (or 0 if none)
  -- state_type - a STATE_xxx type identifying whether the state is part
  --              of a normal rule, the leading state in a trailing context
  --              rule (i.e., the state which marks the transition from
  --              recognizing the text-to-be-matched to the beginning of
  --              the trailing context), or a subsequent state in a trailing
  --              context rule
  -- rule_type - a RULE_xxx type identifying whether this a a ho-hum
  --             normal rule or one which has variable head & trailing
  --             context
  -- rule_linenum - line number associated with rule

  CURRENT_MNS, NUM_RULES, CURRENT_MAX_RULES, LASTNFA : INTEGER;
  FIRSTST, LASTST, FINALST, TRANSCHAR, TRANS1, TRANS2 : INT_PTR;
  ACCPTNUM, ASSOC_RULE, RULE_LINENUM : INT_PTR;
  RULE_TYPE : RULE_ENUM_PTR;
  STATE_TYPE : STATE_ENUM_PTR;

  -- global holding current type of state we're making

  CURRENT_STATE_ENUM : STATE_ENUM;

  -- true if the input rules include a rule with both variable-length head
  -- and trailing context, false otherwise

  VARIABLE_TRAILING_CONTEXT_RULES : BOOLEAN;


  -- variables for protos:
  -- numtemps - number of templates created
  -- numprots - number of protos created
  -- protprev - backlink to a more-recently used proto
  -- protnext - forward link to a less-recently used proto
  -- prottbl - base/def table entry for proto
  -- protcomst - common state of proto
  -- firstprot - number of the most recently used proto
  -- lastprot - number of the least recently used proto
  -- protsave contains the entire state array for protos

  NUMTEMPS, NUMPROTS, FIRSTPROT, LASTPROT : INTEGER;
  PROTPREV, PROTNEXT, PROTTBL, PROTCOMST : array (0 .. MSP - 1) of INTEGER;
  PROTSAVE : array (0 .. PROT_SAVE_SIZE - 1) of INTEGER;


  -- variables for managing equivalence classes:
  -- numecs - number of equivalence classes
  -- nextecm - forward link of Equivalence Class members
  -- ecgroup - class number or backward link of EC members
  -- nummecs - number of meta-equivalence classes (used to compress
  --   templates)
  -- tecfwd - forward link of meta-equivalence classes members
  -- * tecbck - backward link of MEC's

  NUMECS, NUMMECS : INTEGER;
  subtype C_SIZE_ARRAY is UNBOUNDED_INT_ARRAY (0 .. CSIZE);
  type C_SIZE_BOOL_ARRAY is array (0 .. CSIZE) of BOOLEAN;
  NEXTECM, ECGROUP, TECFWD, TECBCK : C_SIZE_ARRAY;


  -- variables for start conditions:
  -- lastsc - last start condition created
  -- current_max_scs - current limit on number of start conditions
  -- scset - set of rules active in start condition
  -- scbol - set of rules active only at the beginning of line in a s.c.
  -- scxclu - true if start condition is exclusive
  -- sceof - true if start condition has EOF rule
  -- scname - start condition name
  -- actvsc - stack of active start conditions for the current rule

  LASTSC, CURRENT_MAX_SCS : INTEGER;
  SCSET, SCBOL : INT_PTR;
  SCXCLU, SCEOF : BOOLEAN_PTR;
  ACTVSC : INT_PTR;
  SCNAME : VSTRING_PTR;


  -- variables for dfa machine data:
  -- current_max_dfa_size - current maximum number of NFA states in DFA
  -- current_max_xpairs - current maximum number of non-template xtion pairs
  -- current_max_template_xpairs - current maximum number of template pairs
  -- current_max_dfas - current maximum number DFA states
  -- lastdfa - last dfa state number created
  -- nxt - state to enter upon reading character
  -- chk - check value to see if "nxt" applies
  -- tnxt - internal nxt table for templates
  -- base - offset into "nxt" for given state
  -- def - where to go if "chk" disallows "nxt" entry
  -- tblend - last "nxt/chk" table entry being used
  -- firstfree - first empty entry in "nxt/chk" table
  -- dss - nfa state set for each dfa
  -- dfasiz - size of nfa state set for each dfa
  -- dfaacc - accepting set for each dfa state (or accepting number, if
  --    -r is not given)
  -- accsiz - size of accepting set for each dfa state
  -- dhash - dfa state hash value
  -- numas - number of DFA accepting states created; note that this
  --    is not necessarily the same value as num_rules, which is the analogous
  --    value for the NFA
  -- numsnpairs - number of state/nextstate transition pairs
  -- jambase - position in base/def where the default jam table starts
  -- jamstate - state number corresponding to "jam" state
  -- end_of_buffer_state - end-of-buffer dfa state number

  CURRENT_MAX_DFA_SIZE, CURRENT_MAX_XPAIRS : INTEGER;
  CURRENT_MAX_TEMPLATE_XPAIRS, CURRENT_MAX_DFAS : INTEGER;
  LASTDFA, LASTTEMP : INTEGER;
  NXT, CHK, TNXT : INT_PTR;
  BASE, DEF , DFASIZ : INT_PTR;
  TBLEND, FIRSTFREE : INTEGER;
  DSS : INT_STAR_PTR;
  DFAACC : DFAACC_PTR;

  -- type declaration for dfaacc_type moved above

  ACCSIZ, DHASH : INT_PTR;
  END_OF_BUFFER_STATE, NUMSNPAIRS, JAMBASE, JAMSTATE, NUMAS : INTEGER;

  -- variables for ccl information:
  -- lastccl - ccl index of the last created ccl
  -- current_maxccls - current limit on the maximum number of unique ccl's
  -- cclmap - maps a ccl index to its set pointer
  -- ccllen - gives the length of a ccl
  -- cclng - true for a given ccl if the ccl is negated
  -- cclreuse - counts how many times a ccl is re-used
  -- current_max_ccl_tbl_size - current limit on number of characters needed
  --	to represent the unique ccl's
  -- ccltbl - holds the characters in each ccl - indexed by cclmap

  CURRENT_MAX_CCL_TBL_SIZE, LASTCCL, CURRENT_MAXCCLS, CCLREUSE : INTEGER;
  CCLMAP, CCLLEN, CCLNG : INT_PTR;

  CCLTBL : CHAR_PTR;


  -- variables for miscellaneous information:
  -- starttime - real-time when we started
  -- endtime - real-time when we ended
  -- nmstr - last NAME scanned by the scanner
  -- sectnum - section number currently being parsed
  -- nummt - number of empty nxt/chk table entries
  -- hshcol - number of hash collisions detected by snstods
  -- dfaeql - number of times a newly created dfa was equal to an old one
  -- numeps - number of epsilon NFA states created
  -- eps2 - number of epsilon states which have 2 out-transitions
  -- num_reallocs - number of times it was necessary to realloc() a group
  --		  of arrays
  -- tmpuses - number of DFA states that chain to templates
  -- totnst - total number of NFA states used to make DFA states
  -- peakpairs - peak number of transition pairs we had to store internally
  -- numuniq - number of unique transitions
  -- numdup - number of duplicate transitions
  -- hshsave - number of hash collisions saved by checking number of states
  -- num_backtracking - number of DFA states requiring back-tracking
  -- bol_needed - whether scanner needs beginning-of-line recognition

  NMSTR : VSTRING;
  SECTNUM, NUMMT, HSHCOL, DFAEQL, NUMEPS, EPS2, NUM_REALLOCS : INTEGER;
  TMPUSES, TOTNST, PEAKPAIRS, NUMUNIQ, NUMDUP, HSHSAVE : INTEGER;
  NUM_BACKTRACKING : INTEGER;
  BOL_NEEDED : BOOLEAN;

  function ALLOCATE_INTEGER_ARRAY (SIZE : in INTEGER) return INT_PTR;

  function ALLOCATE_INT_PTR_ARRAY (SIZE : in INTEGER) return INT_STAR_PTR;



  function ALLOCATE_VSTRING_ARRAY (SIZE : in INTEGER) return VSTRING_PTR;

  function ALLOCATE_DFAACC_UNION (SIZE : in INTEGER) return DFAACC_PTR;

  function  ALLOCATE_CHARACTER_ARRAY (SIZE : in INTEGER) return CHAR_PTR;

  function ALLOCATE_RULE_ENUM_ARRAY (SIZE : in INTEGER) return RULE_ENUM_PTR;

  function ALLOCATE_STATE_ENUM_ARRAY (SIZE : in INTEGER) return STATE_ENUM_PTR;

  function ALLOCATE_BOOLEAN_ARRAY (SIZE : in INTEGER) return BOOLEAN_PTR;

  procedure REALLOCATE_INTEGER_ARRAY (ARR : in out INT_PTR;
       SIZE : in INTEGER);

  procedure REALLOCATE_INT_PTR_ARRAY (ARR : in out INT_STAR_PTR;
       SIZE : in INTEGER);

  procedure REALLOCATE_VSTRING_ARRAY (ARR : in out VSTRING_PTR;
        SIZE : in INTEGER);

  procedure REALLOCATE_DFAACC_UNION (ARR : in out DFAACC_PTR;
      SIZE : in INTEGER);

  procedure REALLOCATE_CHARACTER_ARRAY (ARR : in out CHAR_PTR;
       SIZE : in INTEGER);

  procedure REALLOCATE_RULE_ENUM_ARRAY (ARR : in out RULE_ENUM_PTR;
       SIZE : in INTEGER);

  procedure REALLOCATE_STATE_ENUM_ARRAY (ARR : in out STATE_ENUM_PTR;
       SIZE : in INTEGER);

  procedure REALLOCATE_BOOLEAN_ARRAY (ARR : in out BOOLEAN_PTR;
       SIZE : in INTEGER);

end MISC_DEFS;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/nfa.adb version [c7f52cbd2e].

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
pragma Warnings(Off);
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE NFA construction routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION builds the NFA.
-- NOTES this file mirrors flex as closely as possible.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/nfa.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, NFA, Aflex_MISC, ECS; 
with TSTRING, INT_IO, TEXT_IO, EXTERNAL_FILE_MANAGER; use MISC_DEFS, TSTRING, 
  EXTERNAL_FILE_MANAGER; 

package body NFA is 
  package MISC renames Aflex_MISC;

-- add_accept - add an accepting state to a machine
--
-- accepting_number becomes mach's accepting number.

  procedure ADD_ACCEPT(MACH             : in out INTEGER; 
                       ACCEPTING_NUMBER : in INTEGER) is 
  -- hang the accepting number off an epsilon state.  if it is associated
  -- with a state that has a non-epsilon out-transition, then the state
  -- will accept BEFORE it makes that transition, i.e., one character
  -- too soon
    ASTATE : INTEGER; 
  begin
    if (TRANSCHAR(FINALST(MACH)) = SYM_EPSILON) then 
      ACCPTNUM(FINALST(MACH)) := ACCEPTING_NUMBER; 
    else 
      ASTATE := MKSTATE(SYM_EPSILON); 
      ACCPTNUM(ASTATE) := ACCEPTING_NUMBER; 
      MACH := LINK_MACHINES(MACH, ASTATE); 
    end if; 
  end ADD_ACCEPT; 


  -- copysingl - make a given number of copies of a singleton machine
  --
  --     newsng - a new singleton composed of num copies of singl
  --     singl  - a singleton machine
  --     num    - the number of copies of singl to be present in newsng

  function COPYSINGL(SINGL, NUM : in INTEGER) return INTEGER is 
    COPY : INTEGER; 
  begin
    COPY := MKSTATE(SYM_EPSILON); 

    for I in 1 .. NUM loop
      COPY := LINK_MACHINES(COPY, DUPMACHINE(SINGL)); 
    end loop; 

    return COPY; 
  end COPYSINGL; 


  -- dumpnfa - debugging routine to write out an nfa

  procedure DUMPNFA(STATE1 : in INTEGER) is 
    SYM, TSP1, TSP2, ANUM : INTEGER; 
    use TEXT_IO; 
  begin
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    TEXT_IO.PUT(STANDARD_ERROR, 
      "********** beginning dump of nfa with start state "); 
    INT_IO.PUT(STANDARD_ERROR, STATE1, 0); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 

    -- we probably should loop starting at firstst[state1] and going to
    -- lastst[state1], but they're not maintained properly when we "or"
    -- all of the rules together.  So we use our knowledge that the machine
    -- starts at state 1 and ends at lastnfa.
    for NS in 1 .. LASTNFA loop
      TEXT_IO.PUT(STANDARD_ERROR, "state # "); 
      INT_IO.PUT(STANDARD_ERROR, NS, 4); 
      TEXT_IO.PUT(ASCII.HT); 
      SYM := TRANSCHAR(NS); 
      TSP1 := TRANS1(NS); 
      TSP2 := TRANS2(NS); 
      ANUM := ACCPTNUM(NS); 

      INT_IO.PUT(STANDARD_ERROR, SYM, 5); 
      TEXT_IO.PUT(STANDARD_ERROR, ":    "); 
      INT_IO.PUT(STANDARD_ERROR, TSP1, 4); 
      TEXT_IO.PUT(STANDARD_ERROR, ","); 
      INT_IO.PUT(STANDARD_ERROR, TSP2, 4); 
      if (ANUM /= NIL) then 
        TEXT_IO.PUT(STANDARD_ERROR, "  ["); 
        INT_IO.PUT(STANDARD_ERROR, ANUM, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, "]"); 
      end if; 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    end loop; 

    TEXT_IO.PUT(STANDARD_ERROR, "********** end of dump"); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
  end DUMPNFA; 

  -- dupmachine - make a duplicate of a given machine
  --
  --     copy - holds duplicate of mach
  --     mach - machine to be duplicated
  --
  -- note that the copy of mach is NOT an exact duplicate; rather, all the
  -- transition states values are adjusted so that the copy is self-contained,
  -- as the original should have been.
  --
  -- also note that the original MUST be contiguous, with its low and high
  -- states accessible by the arrays firstst and lastst

  function DUPMACHINE(MACH : in INTEGER) return INTEGER is 
    INIT, STATE_OFFSET : INTEGER; 
    STATE              : INTEGER := 0; 
    LAST               : INTEGER := LASTST(MACH); 
    I                  : INTEGER; 
  begin
    I := FIRSTST(MACH); 
    while (I <= LAST) loop
      STATE := MKSTATE(TRANSCHAR(I)); 

      if (TRANS1(I) /= NO_TRANSITION) then 
        MKXTION(FINALST(STATE), TRANS1(I) + STATE - I); 

        if ((TRANSCHAR(I) = SYM_EPSILON) and (TRANS2(I) /= NO_TRANSITION)) then 
          MKXTION(FINALST(STATE), TRANS2(I) + STATE - I); 
        end if; 
      end if; 

      ACCPTNUM(STATE) := ACCPTNUM(I); 
      I := I + 1; 
    end loop; 

    if (STATE = 0) then 
      MISC.AFLEXFATAL("empty machine in dupmachine()"); 
    end if; 

    STATE_OFFSET := STATE - I + 1; 

    INIT := MACH + STATE_OFFSET; 
    FIRSTST(INIT) := FIRSTST(MACH) + STATE_OFFSET; 
    FINALST(INIT) := FINALST(MACH) + STATE_OFFSET; 
    LASTST(INIT) := LASTST(MACH) + STATE_OFFSET; 

    return INIT; 
  end DUPMACHINE; 

  -- finish_rule - finish up the processing for a rule
  --
  -- An accepting number is added to the given machine.  If variable_trail_rule
  -- is true then the rule has trailing context and both the head and trail
  -- are variable size.  Otherwise if headcnt or trailcnt is non-zero then
  -- the machine recognizes a pattern with trailing context and headcnt is
  -- the number of characters in the matched part of the pattern, or zero
  -- if the matched part has variable length.  trailcnt is the number of
  -- trailing context characters in the pattern, or zero if the trailing
  -- context has variable length.

  procedure FINISH_RULE(MACH                : in INTEGER; 
                        VARIABLE_TRAIL_RULE : in BOOLEAN; 
                        HEADCNT, TRAILCNT   : in INTEGER) is 
    P_MACH : INTEGER; 
    use TEXT_IO; 
  begin
    P_MACH := MACH; 
    ADD_ACCEPT(P_MACH, NUM_RULES); 

    -- we did this in new_rule(), but it often gets the wrong
    -- number because we do it before we start parsing the current rule
    RULE_LINENUM(NUM_RULES) := LINENUM; 

    TEXT_IO.PUT(TEMP_ACTION_FILE, "when "); 
    INT_IO.PUT(TEMP_ACTION_FILE, NUM_RULES, 1); 
    TEXT_IO.PUT_LINE(TEMP_ACTION_FILE, " => "); 

    if (VARIABLE_TRAIL_RULE) then 
      RULE_TYPE(NUM_RULES) := RULE_VARIABLE; 

      if (PERFORMANCE_REPORT) then 
        TEXT_IO.PUT(STANDARD_ERROR, "Variable trailing context rule at line "); 
        INT_IO.PUT(STANDARD_ERROR, RULE_LINENUM(NUM_RULES), 1); 
        TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      end if; 

      VARIABLE_TRAILING_CONTEXT_RULES := TRUE; 
    else 
      RULE_TYPE(NUM_RULES) := RULE_NORMAL; 

      if ((HEADCNT > 0) or (TRAILCNT > 0)) then 

        -- do trailing context magic to not match the trailing characters
        TEXT_IO.PUT_LINE(TEMP_ACTION_FILE, 
          "yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext"
          ); 

        if (HEADCNT > 0) then 
          TEXT_IO.PUT(TEMP_ACTION_FILE, " yy_cp := yy_bp + "); 
          INT_IO.PUT(TEMP_ACTION_FILE, HEADCNT, 1); 
          TEXT_IO.PUT_LINE(TEMP_ACTION_FILE, ";"); 
        else 
          TEXT_IO.PUT(TEMP_ACTION_FILE, "yy_cp := yy_cp - "); 
          INT_IO.PUT(TEMP_ACTION_FILE, TRAILCNT, 1); 
          TEXT_IO.PUT_LINE(TEMP_ACTION_FILE, ";"); 
        end if; 

        TEXT_IO.PUT_LINE(TEMP_ACTION_FILE, "yy_c_buf_p := yy_cp;"); 
        TEXT_IO.PUT_LINE(TEMP_ACTION_FILE, 
          "YY_DO_BEFORE_ACTION; -- set up yytext again"); 
      end if; 
    end if; 

    MISC.LINE_DIRECTIVE_OUT(TEMP_ACTION_FILE); 
  end FINISH_RULE; 

  -- link_machines - connect two machines together
  --
  --     new    - a machine constructed by connecting first to last
  --     first  - the machine whose successor is to be last
  --     last   - the machine whose predecessor is to be first
  --
  -- note: this routine concatenates the machine first with the machine
  --  last to produce a machine new which will pattern-match first first
  --  and then last, and will fail if either of the sub-patterns fails.
  --  FIRST is set to new by the operation.  last is unmolested.

  function LINK_MACHINES(FIRST, LAST : in INTEGER) return INTEGER is 
  begin
    if (FIRST = NIL) then 
      return LAST; 
    else 
      if (LAST = NIL) then 
        return FIRST; 
      else 
        MKXTION(FINALST(FIRST), LAST); 
        FINALST(FIRST) := FINALST(LAST); 
        LASTST(FIRST) := MAX(LASTST(FIRST), LASTST(LAST)); 
        FIRSTST(FIRST) := MIN(FIRSTST(FIRST), FIRSTST(LAST)); 
        return (FIRST); 
      end if; 
    end if; 
  end LINK_MACHINES; 


  -- mark_beginning_as_normal - mark each "beginning" state in a machine
--                            as being a "normal" (i.e., not trailing context-
  --                            associated) states
  --
  -- The "beginning" states are the epsilon closure of the first state

  procedure MARK_BEGINNING_AS_NORMAL(MACH : in INTEGER) is 
  begin
    case (STATE_TYPE(MACH)) is 
      when STATE_NORMAL => 

        -- oh, we've already visited here
        return; 

      when STATE_TRAILING_CONTEXT => 
        STATE_TYPE(MACH) := STATE_NORMAL; 

        if (TRANSCHAR(MACH) = SYM_EPSILON) then 
          if (TRANS1(MACH) /= NO_TRANSITION) then 
            MARK_BEGINNING_AS_NORMAL(TRANS1(MACH)); 
          end if; 

          if (TRANS2(MACH) /= NO_TRANSITION) then 
            MARK_BEGINNING_AS_NORMAL(TRANS2(MACH)); 
          end if; 
        end if; 
      when others => 
        MISC.AFLEXERROR("bad state type in mark_beginning_as_normal()"); 
    end case; 
  end MARK_BEGINNING_AS_NORMAL; 

  -- mkbranch - make a machine that branches to two machines
  --
  --     branch - a machine which matches either first's pattern or second's
--     first, second - machines whose patterns are to be or'ed (the | operator)
  --
  -- note that first and second are NEITHER destroyed by the operation.  Also,
  -- the resulting machine CANNOT be used with any other "mk" operation except
  -- more mkbranch's.  Compare with mkor()
  function MKBRANCH(FIRST, SECOND : in INTEGER) return INTEGER is 
    EPS : INTEGER; 
  begin
    if (FIRST = NO_TRANSITION) then 
      return SECOND; 
    else 
      if (SECOND = NO_TRANSITION) then 
        return FIRST; 
      end if; 
    end if; 

    EPS := MKSTATE(SYM_EPSILON); 

    MKXTION(EPS, FIRST); 
    MKXTION(EPS, SECOND); 

    return EPS; 
  end MKBRANCH; 


  -- mkclos - convert a machine into a closure
  --
  --     new - a new state which matches the closure of "state"

  function MKCLOS(STATE : in INTEGER) return INTEGER is 
  begin
    return NFA.MKOPT(MKPOSCL(STATE)); 
  end MKCLOS; 


  -- mkopt - make a machine optional
  --
  --     new  - a machine which optionally matches whatever mach matched
  --     mach - the machine to make optional
  --
  -- notes:
  --     1. mach must be the last machine created
  --     2. mach is destroyed by the call

  function MKOPT(MACH : in INTEGER) return INTEGER is 
    EPS    : INTEGER; 
    RESULT : INTEGER; 
  begin
    RESULT := MACH; 
    if (not SUPER_FREE_EPSILON(FINALST(RESULT))) then 
      EPS := NFA.MKSTATE(SYM_EPSILON); 
      RESULT := NFA.LINK_MACHINES(RESULT, EPS); 
    end if; 

    -- can't skimp on the following if FREE_EPSILON(mach) is true because
    -- some state interior to "mach" might point back to the beginning
    -- for a closure
    EPS := NFA.MKSTATE(SYM_EPSILON); 
    RESULT := NFA.LINK_MACHINES(EPS, RESULT); 

    NFA.MKXTION(RESULT, FINALST(RESULT)); 

    return RESULT; 
  end MKOPT; 


  -- mkor - make a machine that matches either one of two machines
  --
  --     new - a machine which matches either first's pattern or second's
--     first, second - machines whose patterns are to be or'ed (the | operator)
  --
  -- note that first and second are both destroyed by the operation
  -- the code is rather convoluted because an attempt is made to minimize
  -- the number of epsilon states needed

  function MKOR(FIRST, SECOND : in INTEGER) return INTEGER is 
    EPS, OREND : INTEGER; 
    P_FIRST    : INTEGER; 
  begin
    P_FIRST := FIRST; 
    if (P_FIRST = NIL) then 
      return SECOND; 
    else 
      if (SECOND = NIL) then 
        return P_FIRST; 
      else 

        -- see comment in mkopt() about why we can't use the first state
        -- of "first" or "second" if they satisfy "FREE_EPSILON"
        EPS := MKSTATE(SYM_EPSILON); 

        P_FIRST := LINK_MACHINES(EPS, P_FIRST); 

        MKXTION(P_FIRST, SECOND); 

        if ((SUPER_FREE_EPSILON(FINALST(P_FIRST))) and (ACCPTNUM(FINALST(P_FIRST
          )) = NIL)) then 
          OREND := FINALST(P_FIRST); 
          MKXTION(FINALST(SECOND), OREND); 
        else 
          if ((SUPER_FREE_EPSILON(FINALST(SECOND))) and (ACCPTNUM(FINALST(SECOND
            )) = NIL)) then 
            OREND := FINALST(SECOND); 
            MKXTION(FINALST(P_FIRST), OREND); 
          else 
            EPS := MKSTATE(SYM_EPSILON); 
            P_FIRST := LINK_MACHINES(P_FIRST, EPS); 
            OREND := FINALST(P_FIRST); 

            MKXTION(FINALST(SECOND), OREND); 
          end if; 
        end if; 
      end if; 
    end if; 

    FINALST(P_FIRST) := OREND; 
    return P_FIRST; 
  end MKOR; 


  -- mkposcl - convert a machine into a positive closure
  --
  --    new - a machine matching the positive closure of "state"

  function MKPOSCL(STATE : in INTEGER) return INTEGER is 
    EPS : INTEGER; 
  begin
    if (SUPER_FREE_EPSILON(FINALST(STATE))) then 
      MKXTION(FINALST(STATE), STATE); 
      return (STATE); 
    else 
      EPS := MKSTATE(SYM_EPSILON); 
      MKXTION(EPS, STATE); 
      return (LINK_MACHINES(STATE, EPS)); 
    end if; 
  end MKPOSCL; 

  -- mkrep - make a replicated machine
  --
  --    new - a machine that matches whatever "mach" matched from "lb"
  --          number of times to "ub" number of times
  --
  -- note
--   if "ub" is INFINITY then "new" matches "lb" or more occurrences of "mach"

  function MKREP(MACH, LB, UB : in INTEGER) return INTEGER is 
    BASE_MACH, TAIL, COPY : INTEGER; 
    P_MACH                : INTEGER; 
  begin
    P_MACH := MACH; 
    BASE_MACH := COPYSINGL(P_MACH, LB - 1); 

    if (UB = INFINITY) then 
      COPY := DUPMACHINE(P_MACH); 
      P_MACH := LINK_MACHINES(P_MACH, LINK_MACHINES(BASE_MACH, MKCLOS(COPY))); 
    else 
      TAIL := MKSTATE(SYM_EPSILON); 

      for I in LB .. UB - 1 loop
        COPY := DUPMACHINE(P_MACH); 
        TAIL := MKOPT(LINK_MACHINES(COPY, TAIL)); 
      end loop; 

      P_MACH := LINK_MACHINES(P_MACH, LINK_MACHINES(BASE_MACH, TAIL)); 
    end if; 

    return P_MACH; 
  end MKREP; 

  -- mkstate - create a state with a transition on a given symbol
  --
  --     state - a new state matching sym
  --     sym   - the symbol the new state is to have an out-transition on
  --
  -- note that this routine makes new states in ascending order through the
  -- state array (and increments LASTNFA accordingly).  The routine DUPMACHINE
  -- relies on machines being made in ascending order and that they are
  -- CONTIGUOUS.  Change it and you will have to rewrite DUPMACHINE (kludge
  -- that it admittedly is)

  function MKSTATE(SYM : in INTEGER) return INTEGER is 
  begin
    LASTNFA := LASTNFA + 1; 
    if (LASTNFA >= CURRENT_MNS) then 
      CURRENT_MNS := CURRENT_MNS + MNS_INCREMENT; 
      if (CURRENT_MNS >= MAXIMUM_MNS) then 
        MISC.AFLEXERROR("input rules are too complicated (>= " & INTEGER'IMAGE(
          CURRENT_MNS) & " NFA states) )"); 
      end if; 

      NUM_REALLOCS := NUM_REALLOCS + 1; 

      REALLOCATE_INTEGER_ARRAY(FIRSTST, CURRENT_MNS); 
      REALLOCATE_INTEGER_ARRAY(LASTST, CURRENT_MNS); 
      REALLOCATE_INTEGER_ARRAY(FINALST, CURRENT_MNS); 
      REALLOCATE_INTEGER_ARRAY(TRANSCHAR, CURRENT_MNS); 
      REALLOCATE_INTEGER_ARRAY(TRANS1, CURRENT_MNS); 
      REALLOCATE_INTEGER_ARRAY(TRANS2, CURRENT_MNS); 
      REALLOCATE_INTEGER_ARRAY(ACCPTNUM, CURRENT_MNS); 
      REALLOCATE_INTEGER_ARRAY(ASSOC_RULE, CURRENT_MNS); 
      REALLOCATE_STATE_ENUM_ARRAY(STATE_TYPE, CURRENT_MNS); 
    end if; 

    FIRSTST(LASTNFA) := LASTNFA; 
    FINALST(LASTNFA) := LASTNFA; 
    LASTST(LASTNFA) := LASTNFA; 
    TRANSCHAR(LASTNFA) := SYM; 
    TRANS1(LASTNFA) := NO_TRANSITION; 
    TRANS2(LASTNFA) := NO_TRANSITION; 
    ACCPTNUM(LASTNFA) := NIL; 
    ASSOC_RULE(LASTNFA) := NUM_RULES; 
    STATE_TYPE(LASTNFA) := CURRENT_STATE_ENUM; 

    -- fix up equivalence classes base on this transition.  Note that any
    -- character which has its own transition gets its own equivalence class.
    -- Thus only characters which are only in character classes have a chance
    -- at being in the same equivalence class.  E.g. "a|b" puts 'a' and 'b'
    -- into two different equivalence classes.  "[ab]" puts them in the same
    -- equivalence class (barring other differences elsewhere in the input).
    if (SYM < 0) then 

      -- we don't have to update the equivalence classes since that was
      -- already done when the ccl was created for the first time
      null; 
    else 
      if (SYM = SYM_EPSILON) then 
        NUMEPS := NUMEPS + 1; 
      else 
        if (USEECS) then 
          ECS.MKECHAR(SYM, NEXTECM, ECGROUP); 
        end if; 
      end if; 
    end if; 

    return LASTNFA; 
  end MKSTATE; 

  -- mkxtion - make a transition from one state to another
  --
  --     statefrom - the state from which the transition is to be made
  --     stateto   - the state to which the transition is to be made

  procedure MKXTION(STATEFROM, STATETO : in INTEGER) is 
  begin
    if (TRANS1(STATEFROM) = NO_TRANSITION) then 
      TRANS1(STATEFROM) := STATETO; 
    else 
      if ((TRANSCHAR(STATEFROM) /= SYM_EPSILON) or (TRANS2(STATEFROM) /= 
        NO_TRANSITION)) then 
        MISC.AFLEXFATAL("found too many transitions in mkxtion()"); 
      else 

        -- second out-transition for an epsilon state
        EPS2 := EPS2 + 1; 
        TRANS2(STATEFROM) := STATETO; 
      end if; 
    end if; 
  end MKXTION; 

  -- new_rule - initialize for a new rule
  --
  -- the global num_rules is incremented and the any corresponding dynamic
  -- arrays (such as rule_type()) are grown as needed.

  procedure NEW_RULE is 
  begin
    NUM_RULES := NUM_RULES + 1; 
    if (NUM_RULES >= CURRENT_MAX_RULES) then 
      NUM_REALLOCS := NUM_REALLOCS + 1; 
      CURRENT_MAX_RULES := CURRENT_MAX_RULES + MAX_RULES_INCREMENT; 
      REALLOCATE_RULE_ENUM_ARRAY(RULE_TYPE, CURRENT_MAX_RULES); 
      REALLOCATE_INTEGER_ARRAY(RULE_LINENUM, CURRENT_MAX_RULES); 
    end if; 

    if (NUM_RULES > MAX_RULE) then 
      MISC.AFLEXERROR("too many rules  (> " & INTEGER'IMAGE(MAX_RULE) & ")!"); 
    end if; 

    RULE_LINENUM(NUM_RULES) := LINENUM; 
  end NEW_RULE; 

end NFA; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/nfa.ads version [710e8e77f0].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE NFA construction routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION builds the NFA.
-- NOTES this file mirrors flex as closely as possible.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/nfa.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

package NFA is 
  procedure ADD_ACCEPT(MACH             : in out INTEGER; 
                       ACCEPTING_NUMBER : in INTEGER); 
  function COPYSINGL(SINGL, NUM : in INTEGER) return INTEGER; 
  procedure DUMPNFA(STATE1 : in INTEGER); 
  function DUPMACHINE(MACH : in INTEGER) return INTEGER; 
  procedure FINISH_RULE(MACH                : in INTEGER; 
                        VARIABLE_TRAIL_RULE : in BOOLEAN; 
                        HEADCNT, TRAILCNT   : in INTEGER); 
  function LINK_MACHINES(FIRST, LAST : in INTEGER) return INTEGER; 
  procedure MARK_BEGINNING_AS_NORMAL(MACH : in INTEGER); 
  function MKBRANCH(FIRST, SECOND : in INTEGER) return INTEGER; 
  function MKCLOS(STATE : in INTEGER) return INTEGER; 
  function MKOPT(MACH : in INTEGER) return INTEGER; 
  function MKOR(FIRST, SECOND : in INTEGER) return INTEGER; 
  function MKPOSCL(STATE : in INTEGER) return INTEGER; 
  function MKREP(MACH, LB, UB : in INTEGER) return INTEGER; 
  function MKSTATE(SYM : in INTEGER) return INTEGER; 
  procedure MKXTION(STATEFROM, STATETO : in INTEGER); 
  procedure NEW_RULE; 
end NFA; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/parse.y version [9c1692c66b].

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
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE parser for aflex
-- AUTHOR: John Self (UCI)
-- DESCRIPTION lalr(1) grammar for input to AYACC.
-- NOTES
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/parse.y,v 1.1 2011/03/02 23:41:49 stt Exp stt $ 

%token CHAR NUMBER SECTEND SCDECL XSCDECL WHITESPACE NAME PREVCCL EOF_OP
%token NEWLINE

%with TEXT_IO
%with ccl
%with NFA
%with Parse_Shift_Reduce
%with Parse_Goto
%with misc_defs
%use misc_defs
%with external_file_manager
%use external_file_manager

{
  subtype YYSType is Integer;
}

%%
goal            :  initlex sect1 sect1end sect2 initforrule
			{ -- add default rule

			pat := ccl.cclinit;
			ccl.cclnegate( pat );

			def_rule := nfa.mkstate( -pat );

			nfa.finish_rule( def_rule, false, 0, 0 );

			for i in 1 .. lastsc loop
			    scset(i) := nfa.mkbranch( scset(i), def_rule );
			end loop;
			
			if ( spprdflt ) then
			    text_io.put(temp_action_file,
					"raise AFLEX_SCANNER_JAMMED;");
			else
			    text_io.put( temp_action_file, "ECHO" );

			text_io.put_line( temp_action_file, ";" );
			end if;
			}
		;

initlex         :
			{
			-- initialize for processing rules

       			-- create default DFA start condition
			sym.scinstal( tstring.vstr("INITIAL"), false );
			}
		;
			
sect1		:  sect1 startconddecl WHITESPACE namelist1 NEWLINE
		|
		|  error NEWLINE
			{ misc.synerr( "unknown error processing section 1" );}
		;

sect1end	:  SECTEND
		;

startconddecl   :  SCDECL
			{
			 -- these productions are separate from the s1object
			 -- rule because the semantics must be done before
			 -- we parse the remainder of an s1object
			

			xcluflg := false;
			}
		
		|  XSCDECL
			{ xcluflg := true; }
		;

namelist1	:  namelist1 WHITESPACE NAME
			{ sym.scinstal( nmstr, xcluflg ); }

		|  NAME
			{ sym.scinstal( nmstr, xcluflg ); }

		|  error
                        { misc.synerr( "bad start condition list" ); }
		;

sect2           :  sect2 initforrule aflexrule NEWLINE
		|
		;

initforrule     :
			{
			-- initialize for a parse of one rule
			trlcontxt := false;
			variable_trail_rule := false;
			varlength := false;
			trailcnt := 0;
			headcnt := 0;
			rulelen := 0;
			current_state_enum := STATE_NORMAL;
			previous_continued_action := continued_action;
			nfa.new_rule;
			}
		;

aflexrule        :  scon '^' re eol 
                        {
			pat := nfa.link_machines( $3, $4 );
			nfa.finish_rule( pat, variable_trail_rule,
				     headcnt, trailcnt );

			for i in 1 .. actvp loop
			    scbol(actvsc(i)) :=
				nfa.mkbranch( scbol(actvsc(i)), pat );
			end loop;	
				
			if ( not bol_needed ) then
			    bol_needed := true;

			    if ( performance_report ) then
				text_io.put( Standard_Error,
			"'^' operator results in sub-optimal performance");
			        text_io.new_line(Standard_Error);
    	    	    	    end if;
			end if;
			}

		|  scon re eol 
                        {
			pat := nfa.link_machines( $2, $3 );
			nfa.finish_rule( pat, variable_trail_rule,
				     headcnt, trailcnt );

			for i in 1 .. actvp loop
			    scset(actvsc(i)) := 
				nfa.mkbranch( scset(actvsc(i)), pat );
			end loop;
		        }
                |  '^' re eol 
			{
			pat := nfa.link_machines( $2, $3 );
			nfa.finish_rule( pat, variable_trail_rule,
				     headcnt, trailcnt );

			-- add to all non-exclusive start conditions,
			-- including the default (0) start condition

			for i in 1 .. lastsc loop
			    if ( not scxclu(i) ) then
				scbol(i) := nfa.mkbranch( scbol(i), pat );
			    end if;	
			end loop;

			if ( not bol_needed ) then
			    bol_needed := true;

			    if ( performance_report ) then
				text_io.put( Standard_Error,
			"'^' operator results in sub-optimal performance");
			        text_io.new_line(Standard_Error);
			    end if;
			end if;
    	    	    	}
                |  re eol 
			{
			pat := nfa.link_machines( $1, $2 );
			nfa.finish_rule( pat, variable_trail_rule,
				     headcnt, trailcnt );

			for i in 1 .. lastsc loop
			    if ( not scxclu(i) ) then
				scset(i) := nfa.mkbranch( scset(i), pat );
			    end if;
			end loop;
			}

                |  scon EOF_OP
			{ build_eof_action; }

                |  EOF_OP
			{
			-- this EOF applies only to the INITIAL start cond.
			actvp := 1;
			actvsc(actvp) := 1;
			build_eof_action;
			}

                |  error
			{ misc.synerr( "unrecognized rule" ); }
		;

scon            :  '<' namelist2 '>'
		;

namelist2       :  namelist2 ',' NAME
                        {
			scnum := sym.sclookup( nmstr );
			if (scnum = 0 ) then
		            text_io.put( Standard_Error,
					 "undeclared start condition ");
		            tstring.put( Standard_Error, nmstr );
			    main_body.aflexend( 1 );
			else
			  actvp := actvp + 1;
			    actvsc(actvp) := scnum;
			end if;
			}

		|  NAME
			{
			scnum := sym.sclookup( nmstr );
			if (scnum = 0 ) then
		            text_io.put( Standard_Error,
					"undeclared start condition ");
		            tstring.put( Standard_Error,	 nmstr );
			    main_body.aflexend ( 1 );
			else
			    actvp := 1;
			    actvsc(actvp) := scnum;
			end if;
			}

		|  error
			{ misc.synerr( "bad start condition list" ); }
		;

eol             :  '$'
                        {
			if trlcontxt then
			    misc.synerr( "trailing context used twice" );
			    $$ := nfa.mkstate( SYM_EPSILON );
			else
			    trlcontxt := true;

			    if ( not varlength ) then
				headcnt := rulelen;
			    end if;

			    rulelen := rulelen + 1;
			    trailcnt := 1;

			    eps := nfa.mkstate( SYM_EPSILON );
			    $$ := nfa.link_machines( eps,
					  nfa.mkstate( CHARACTER'POS(ASCII.LF) ) );
    	    	    	end if;
			}

		|
		        {
		        $$ := nfa.mkstate( SYM_EPSILON );

			if ( trlcontxt ) then
			    if ( varlength and (headcnt = 0) ) then
				-- both head and trail are variable-length
				variable_trail_rule := true;
			    else
				trailcnt := rulelen;
			    end if;
    	    	    	end if;
		        }
		;

re              :  re '|' series
                        {
			varlength := true;

			$$ := nfa.mkor( $1, $3 );
			}

		|  re2 series
			{
			if ( transchar(lastst($2)) /= SYM_EPSILON ) then
			    -- provide final transition \now/ so it
			    -- will be marked as a trailing context
			    -- state

			    $2 := nfa.link_machines( $2, nfa.mkstate( SYM_EPSILON ) );
			end if;

			nfa.mark_beginning_as_normal( $2 );
			current_state_enum := STATE_NORMAL;

			if ( previous_continued_action ) then
			    -- we need to treat this as variable trailing
			    -- context so that the backup does not happen
			    -- in the action but before the action switch
			    -- statement.  If the backup happens in the
			    -- action, then the rules "falling into" this
			    -- one's action will *also* do the backup,
			    -- erroneously.

			    	if ( (not varlength) or  headcnt /= 0 ) then
				     text_io.put( Standard_Error,
                              "alex: warning - trailing context rule at line");
                                     int_io.put(Standard_Error, linenum);
				     text_io.put( Standard_Error,
                           "made variable because of preceding '|' action" );
                                     int_io.put(Standard_Error, linenum);
    	    	    	    	end if;

			    -- mark as variable
			    varlength := true;
			    headcnt := 0;
    	    	    	end if;
			
			if ( varlength and (headcnt = 0) ) then
			    -- variable trailing context rule
			    -- mark the first part of the rule as the accepting
			    -- "head" part of a trailing context rule

			    -- by the way, we didn't do this at the beginning
			    -- of this production because back then
			    -- current_state_enum was set up for a trail
			    -- rule, and add_accept() can create a new
			    -- state ...

			    nfa.add_accept( $1,
    	    	    	    	   misc.set_yy_trailing_head_mask(num_rules) );
    	    	    	end if;

			$$ := nfa.link_machines( $1, $2 );
			}

		|  series
			{ $$ := $1; }
		;


re2		:  re '/'
			{
			-- this rule is separate from the others for "re" so
			-- that the reduction will occur before the trailing
			-- series is parsed

			if ( trlcontxt ) then
			    misc.synerr( "trailing context used twice" );
			else
			    trlcontxt := true;
			end if;    

			if ( varlength ) then
			    -- we hope the trailing context is fixed-length
			    varlength := false;
			else
			    headcnt := rulelen;
			end if;    

			rulelen := 0;

			current_state_enum := STATE_TRAILING_CONTEXT;
			$$ := $1;
			}
		;

series          :  series singleton
                        {
			-- this is where concatenation of adjacent patterns
			-- gets done

			$$ := nfa.link_machines( $1, $2 );
			}

		|  singleton
			{ $$ := $1; }
		;

singleton       :  singleton '*'
                        {
			varlength := true;

			$$ := nfa.mkclos( $1 );
			}
			
		|  singleton '+'
			{
			varlength := true;

			$$ := nfa.mkposcl( $1 );
			}

		|  singleton '?'
			{
			varlength := true;

			$$ := nfa.mkopt( $1 );
			}

		|  singleton '{' NUMBER ',' NUMBER '}'
			{
			varlength := true;

			if ( ($3 > $5) or ($3 < 0) ) then
			    misc.synerr( "bad iteration values" );
			    $$ := $1;
			else
			    if ( $3 = 0 ) then
				$$ := nfa.mkopt( nfa.mkrep( $1, $3, $5 ) );
			    else
				$$ := nfa.mkrep( $1, $3, $5 );
			    end if;
    	    	    	end if;
			}
				
		|  singleton '{' NUMBER ',' '}'
			{
			varlength := true;

			if ( $3 <= 0 ) then
			    misc.synerr( "iteration value must be positive" );
			    $$ := $1;
			else
			    $$ := nfa.mkrep( $1, $3, INFINITY );
			end if;    
			}

		|  singleton '{' NUMBER '}'
			{
			-- the singleton could be something like "(foo)",
			-- in which case we have no idea what its length
			-- is, so we punt here.

			varlength := true;

			if ( $3 <= 0 ) then
			    misc.synerr( "iteration value must be positive" );
			    $$ := $1;
			else
			    $$ := nfa.link_machines( $1, nfa.copysingl( $1, $3 - 1 ) );
			end if;    
			}

		|  '.'
			{
			if ( not madeany ) then
			    -- create the '.' character class
			    anyccl := ccl.cclinit;
			    ccl.ccladd( anyccl, ASCII.LF );
			    ccl.cclnegate( anyccl );

			    if ( useecs ) then
				ecs.mkeccl(
		       ccltbl(cclmap(anyccl)..cclmap(anyccl) + ccllen(anyccl)),
					ccllen(anyccl), nextecm,
					ecgroup, CSIZE );
			    end if;
			    madeany := true;
    	    	    	end if;

			rulelen := rulelen + 1;

			$$ := nfa.mkstate( -anyccl );
			}

		|  fullccl
			{
			if ( not cclsorted ) then
			    -- sort characters for fast searching.  We use a
			    -- shell sort since this list could be large.

--			    misc.cshell( ccltbl + cclmap($1), ccllen($1) );
		      misc.cshell( ccltbl(cclmap($1)..cclmap($1) + ccllen($1)),
				   ccllen($1) );
			end if;

			if ( useecs ) then
		    ecs.mkeccl( ccltbl(cclmap($1)..cclmap($1) + ccllen($1)),
				ccllen($1),nextecm, ecgroup, CSIZE );
			end if;
				     
			rulelen := rulelen + 1;

			$$ := nfa.mkstate( -$1 );
			}

		|  PREVCCL
			{
			rulelen := rulelen + 1;

			$$ := nfa.mkstate( -$1 );
			}

		|  '"' string '"'
			{ $$ := $2; }

		|  '(' re ')'
			{ $$ := $2; }

		|  CHAR
			{
			rulelen := rulelen + 1;

			if ( $1 = CHARACTER'POS(ASCII.NUL) ) then
			    misc.synerr( "null in rule" );
			end if;    

			if ( caseins and ($1 >= CHARACTER'POS('A')) and ($1 <= CHARACTER'POS('Z')) ) then
			    $1 := misc.clower( $1 );
			end if;

			$$ := nfa.mkstate( $1 );
			}
		;

fullccl		:  '[' ccl ']'
			{ $$ := $2; }

		|  '[' '^' ccl ']'
			{
			-- *Sigh* - to be compatible Unix lex, negated ccls
			-- match newlines
			ccl.cclnegate( $3 );
			$$ := $3;
			}
		;

ccl             :  ccl CHAR '-' CHAR
                        {
			if ( $2 > $4 ) then
			    misc.synerr( "negative range in character class" );
			else
			    if ( caseins ) then
				if ( ($2 >= CHARACTER'POS('A')) and ($2 <= CHARACTER'POS('Z')) ) then
				    $2 := misc.clower( $2 );
				end if;					    
				if ( ($4 >= CHARACTER'POS('A')) and ($4 <= CHARACTER'POS('Z')) ) then
				    $4 := misc.clower( $4 );
				end if;    
    	    	    	    end if;

			    for i in $2 .. $4 loop
			        ccl.ccladd( $1, CHARACTER'VAL(i) );
    	    	    	    end loop;
			    
			    -- keep track if this ccl is staying in
			    -- alphabetical order

			    cclsorted := cclsorted and ($2 > lastchar);
			    lastchar := $4;
    	    	    	end if;
			
			$$ := $1;
			}

		|  ccl CHAR
		        {
			if ( caseins ) then
			    if ( ($2 >= CHARACTER'POS('A')) and ($2 <= CHARACTER'POS('Z')) ) then
				$2 := misc.clower( $2 );
    	    	    	    end if;
			end if;    
			ccl.ccladd( $1, CHARACTER'VAL($2) );
			cclsorted := cclsorted and ($2 > lastchar);
			lastchar := $2;
			$$ := $1;
			}

		|
			{
			cclsorted := true;
			lastchar := 0;
			$$ := ccl.cclinit;
			}
		;

string		:  string CHAR
                        {
			if ( caseins ) then
			    if ( ($2 >= CHARACTER'POS('A')) and ($2 <= CHARACTER'POS('Z')) ) then
				$2 := misc.clower( $2 );
			    end if;
			end if;    

			rulelen := rulelen + 1;

			$$ := nfa.link_machines( $1, nfa.mkstate( $2 ) );
			}

		|
			{ $$ := nfa.mkstate( SYM_EPSILON ); }
		;

%%

with Parse_Tokens, Parse_Goto, Parse_Shift_Reduce, Text_IO, scanner;
with NFA, ccl, misc, misc_defs, sym, ecs, aflex_scanner;
with tstring, int_io, main_body, text_io, external_file_manager;
use aflex_scanner, external_file_manager;

package parser is
  procedure build_eof_action;
  procedure yyerror(msg: string);
  procedure YYParse;
  def_rule:integer;
end parser;

package body parser is
-- build_eof_action - build the "<<EOF>>" action for the active start
--                    conditions

use text_io, misc_defs;
procedure build_eof_action is
begin
    text_io.put( temp_action_file, "when " );
    for i in 1..actvp loop
	if ( sceof(actvsc(i)) ) then
	    text_io.put( Standard_Error,
		"multiple <<EOF>> rules for start condition ");
	    tstring.put( Standard_Error, scname(actvsc(i)));
	    main_body.aflexend(1);
	else
	    sceof(actvsc(i)) := true;
	    text_io.put( temp_action_file, "YY_END_OF_BUFFER +" );
	    tstring.put( temp_action_file,  scname(actvsc(i)) );
	    text_io.put_line( temp_action_file, " + 1 " );
	    if (i /= actvp) then
	        text_io.put_line( temp_action_file, " |" );
	    else
	        text_io.put_line( temp_action_file, " =>" );
	    end if;
        end if;
    end loop;
    misc.line_directive_out( temp_action_file );
end build_eof_action;

--  yyerror - eat up an error message from the parser
-- 
--  synopsis
--     char msg[];
--     yyerror( msg );

procedure yyerror( msg : string ) is
begin
null;
end yyerror;

use  Parse_Goto, Parse_Shift_Reduce, Text_IO, misc_defs, tstring;
##
end parser;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/skeleton_manager.adb version [9032e54add].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE skeleton manager
-- AUTHOR: John Self (UCI)
-- DESCRIPTION outputs skeleton sections when called by gen.
-- NOTES allows use of internal or external skeleton
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/skeleton_manager.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TEXT_IO, FILE_STRING;
package body SKELETON_MANAGER is 
  use FILE_STRING; -- to save having to type FILE_STRING 177 times
  USE_EXTERNAL_SKELETON : BOOLEAN := FALSE; 
                                          -- are we using an external skelfile?
  CURRENT_LINE          : INTEGER := 1; 
  type FILE_ARRAY is array(POSITIVE range <>) of FILE_STRING.VSTRING; 
  SKEL_TEMPLATE : constant FILE_ARRAY := (
  -- START OF SKELETON
  -- START OF S1
VSTR("pragma Style_Checks (Off);"),
VSTR("-- A lexical scanner generated by aflex"),
VSTR("with text_io; use text_io;"),
VSTR("%% user's code up to the double pound goes right here"),
-- BEGIN S2
VSTR("function YYLex return Token is"),
VSTR("subtype short is integer range -32768..32767;"),
VSTR("    yy_act : integer;"),
VSTR("    yy_c : short;"),
VSTR(""),
VSTR("-- returned upon end-of-file"),
VSTR("YY_END_TOK : constant integer := 0;"),
VSTR("%% tables get generated here."),
-- BEGIN S3
VSTR(""),
VSTR("-- copy whatever the last rule matched to the standard output"),
VSTR(""),
VSTR("procedure ECHO is"),
VSTR("begin"),
VSTR("   if (text_io.is_open(user_output_file)) then"),
VSTR("     text_io.put( user_output_file, yytext );"),
VSTR("   else"),
VSTR("     text_io.put( yytext );"),
VSTR("   end if;"),
VSTR("end ECHO;"),
VSTR(""),
VSTR("-- enter a start condition."),
VSTR("-- Using procedure requires a () after the ENTER, but makes everything"),
VSTR("-- much neater."),
VSTR(""),
VSTR("procedure ENTER( state : integer ) is"),
VSTR("begin"),
VSTR("     yy_start := 1 + 2 * state;"),
VSTR("end ENTER;"),
VSTR(""),
VSTR("-- action number for EOF rule of a given start state"),
VSTR("function YY_STATE_EOF(state : integer) return integer is"),
VSTR("begin"),
VSTR("     return YY_END_OF_BUFFER + state + 1;"),
VSTR("end YY_STATE_EOF;"),
VSTR(""),
VSTR("-- return all but the first 'n' matched characters back to the input stream"),
VSTR("procedure yyless(n : integer) is"),
VSTR("begin"),
VSTR("        yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext"),
VSTR("        yy_cp := yy_bp + n;"),
VSTR("        yy_c_buf_p := yy_cp;"),
VSTR("        YY_DO_BEFORE_ACTION; -- set up yytext again"),
VSTR("end yyless;"),
VSTR(""),
VSTR("-- redefine this if you have something you want each time."),
VSTR("procedure YY_USER_ACTION is"),
VSTR("begin"),
VSTR("        null;"),
VSTR("end;"),
VSTR(""),
VSTR("-- yy_get_previous_state - get the state just before the EOB char was reached"),
VSTR(""),
VSTR("function yy_get_previous_state return yy_state_type is"),
VSTR("    yy_current_state : yy_state_type;"),
VSTR("    yy_c : short;"),
VSTR("%% a local declaration of yy_bp goes here if bol_needed"),
VSTR("begin"),
VSTR("%% code to get the start state into yy_current_state goes here"), 
-- BEGIN S3A
VSTR(""),
VSTR("    for yy_cp in yytext_ptr..yy_c_buf_p - 1 loop"),
VSTR("%% code to find the next state goes here"),
-- BEGIN S4
VSTR("    end loop;"),
VSTR(""),
VSTR("    return yy_current_state;"),
VSTR("end yy_get_previous_state;"),
VSTR(""),
VSTR("procedure yyrestart( input_file : file_type ) is"),
VSTR("begin"),
VSTR("   open_input(text_io.name(input_file));"),
VSTR("end yyrestart;"),
VSTR(""),
VSTR("begin -- of YYLex"),
VSTR("<<new_file>>"),
VSTR("        -- this is where we enter upon encountering an end-of-file and"),
VSTR("        -- yywrap() indicating that we should continue processing"),
VSTR(""),
VSTR("    if ( yy_init ) then"),
VSTR("        if ( yy_start = 0 ) then"),
VSTR("            yy_start := 1;      -- first start state"),
VSTR("        end if;"),
VSTR(""),
VSTR("        -- we put in the '\n' and start reading from [1] so that an"),
VSTR("        -- initial match-at-newline will be true."),
VSTR(""),
VSTR("        yy_ch_buf(0) := ASCII.LF;"),
VSTR("        yy_n_chars := 1;"),
VSTR(""),
VSTR("        -- we always need two end-of-buffer characters.  The first causes"),
VSTR("        -- a transition to the end-of-buffer state.  The second causes"),
VSTR("        -- a jam in that state."),
VSTR(""),
VSTR("        yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;"),
VSTR("        yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;"),
VSTR(""),
VSTR("        yy_eof_has_been_seen := false;"),
VSTR(""),
VSTR("        yytext_ptr := 1;"),
VSTR("        yy_c_buf_p := yytext_ptr;"),
VSTR("        yy_hold_char := yy_ch_buf(yy_c_buf_p);"),
VSTR("        yy_init := false;"),
VSTR("-- UMASS CODES :"),
VSTR("--   Initialization"),
VSTR("        tok_begin_line := 1;"),
VSTR("        tok_end_line := 1;"),
VSTR("        tok_begin_col := 0;"),
VSTR("        tok_end_col := 0;"),
VSTR("        token_at_end_of_line := false;"),
VSTR("        line_number_of_saved_tok_line1 := 0;"),
VSTR("        line_number_of_saved_tok_line2 := 0;"),
VSTR("-- END OF UMASS CODES."),
VSTR("    end if; -- yy_init"),
VSTR(""),
VSTR("    loop                -- loops until end-of-file is reached"),
VSTR(""),
VSTR("-- UMASS CODES :"),
VSTR("--    if last matched token is end_of_line, we must"),
VSTR("--    update the token_end_line and reset tok_end_col."),
VSTR("    if Token_At_End_Of_Line then"),
VSTR("      Tok_End_Line := Tok_End_Line + 1;"),
VSTR("      Tok_End_Col := 0;"),
VSTR("      Token_At_End_Of_Line := False;"),
VSTR("    end if;"),
VSTR("-- END OF UMASS CODES."),
VSTR(""),
VSTR("        yy_cp := yy_c_buf_p;"),
VSTR(""),
VSTR("        -- support of yytext"),
VSTR("        yy_ch_buf(yy_cp) := yy_hold_char;"),
VSTR(""),
VSTR("        -- yy_bp points to the position in yy_ch_buf of the start of the"),
VSTR("        -- current run."),
VSTR("%%"),
-- BEGIN S5
VSTR(""),
VSTR("<<next_action>>"),
VSTR("%% call to gen_find_action goes here"),
-- BEGIN S6
VSTR("            YY_DO_BEFORE_ACTION;"),
VSTR("            YY_USER_ACTION;"),
VSTR(""),
VSTR("        if aflex_debug then  -- output acceptance info. for (-d) debug mode"),
VSTR("            text_io.put( Standard_Error, ""--accepting rule #"" );"),
VSTR("            text_io.put( Standard_Error, INTEGER'IMAGE(yy_act) );"),
VSTR("            text_io.put_line( Standard_Error, ""("""""" & yytext & """""")"");"),
VSTR("        end if;"),
VSTR(""),
VSTR("-- UMASS CODES :"),
VSTR("--   Update tok_begin_line, tok_end_line, tok_begin_col and tok_end_col"),
VSTR("--   after matching the token."),
VSTR("        if yy_act /= YY_END_OF_BUFFER and then yy_act /= 0 then"),
VSTR("-- Token are matched only when yy_act is not yy_end_of_buffer or 0."),
VSTR("          Tok_Begin_Line := Tok_End_Line;"),
VSTR("          Tok_Begin_Col := Tok_End_Col + 1;"),
VSTR("          Tok_End_Col := Tok_Begin_Col + yy_cp - yy_bp - 1;"),
VSTR("          if yy_ch_buf ( yy_bp ) = ASCII.LF then"),
VSTR("            Token_At_End_Of_Line := True;"),
VSTR("          end if;"),
VSTR("        end if;"),
VSTR("-- END OF UMASS CODES."),
VSTR(""),
VSTR("<<do_action>>   -- this label is used only to access EOF actions"),
VSTR("            case yy_act is"), VSTR("%% actions go here"),
-- BEGIN S7
VSTR("                when YY_END_OF_BUFFER =>"),
VSTR("                    -- undo the effects of YY_DO_BEFORE_ACTION"),
VSTR("                    yy_ch_buf(yy_cp) := yy_hold_char;"),
VSTR(""),
VSTR("                    yytext_ptr := yy_bp;"), VSTR(""),
VSTR("                    case yy_get_next_buffer is"),
VSTR("                        when EOB_ACT_END_OF_FILE =>"),
VSTR("                            begin"),
VSTR("                            if ( yywrap ) then"),
VSTR("                                -- note: because we've taken care in"),
VSTR("                                -- yy_get_next_buffer() to have set up yytext,"),
VSTR("                                -- we can now set up yy_c_buf_p so that if some"),
VSTR("                                -- total hoser (like aflex itself) wants"),
VSTR("                                -- to call the scanner after we return the"),
VSTR("                                -- End_Of_Input, it'll still work - another"),
VSTR("                                -- End_Of_Input will get returned."),
VSTR(""),
VSTR("                                yy_c_buf_p := yytext_ptr;"),
VSTR(""),
VSTR("                                yy_act := YY_STATE_EOF((yy_start - 1) / 2);"),
VSTR(""),
VSTR("                                goto do_action;"),
VSTR("                            else"),
VSTR("                                --  start processing a new file"),
VSTR("                                yy_init := true;"),
VSTR("                                goto new_file;"),
VSTR("                            end if;"),
VSTR("                            end;"),
VSTR("                        when EOB_ACT_RESTART_SCAN =>"),
VSTR("                            yy_c_buf_p := yytext_ptr;"),
VSTR("                            yy_hold_char := yy_ch_buf(yy_c_buf_p);"),
VSTR("                        when EOB_ACT_LAST_MATCH =>"),
VSTR("                            yy_c_buf_p := yy_n_chars;"),
VSTR("                            yy_current_state := yy_get_previous_state;"),
VSTR(""),
VSTR("                            yy_cp := yy_c_buf_p;"),
VSTR("                            yy_bp := yytext_ptr;"),
VSTR("                            goto next_action;"),
VSTR("                        when others => null;"),
VSTR("                        end case; -- case yy_get_next_buffer()"),
VSTR("                when others =>"),
VSTR("                    text_io.put( ""action # "" );"),
VSTR("                    text_io.put( INTEGER'IMAGE(yy_act) );"),
VSTR("                    text_io.new_line;"),
VSTR("                    raise AFLEX_INTERNAL_ERROR;"),
VSTR("            end case; -- case (yy_act)"),
VSTR("        end loop; -- end of loop waiting for end of file"),
VSTR("end YYLex;"),
VSTR("%%"),
VSTR("ERROR tried to output beyond end of skeleton file")
-- END OF SKELETON
); 

  -- set_external_skeleton
  --
  -- DESCRIPTION
  -- sets flag so we know to use an external skelfile

  procedure SET_EXTERNAL_SKELETON is 
  begin
    USE_EXTERNAL_SKELETON := TRUE; 
  end SET_EXTERNAL_SKELETON; 

  procedure GET_INTERNAL(BUFFER : in out FILE_STRING.VSTRING) is 
  begin
    BUFFER := SKEL_TEMPLATE(CURRENT_LINE); 
    CURRENT_LINE := CURRENT_LINE + 1; 
  end GET_INTERNAL; 

  procedure GET_EXTERNAL(BUFFER : in out FILE_STRING.VSTRING) is 
  begin
    FILE_STRING.GET_LINE(MISC_DEFS.SKELFILE, BUFFER); 
  end GET_EXTERNAL; 

  -- end_of_skeleton
  --
  -- DESCRIPTION
  -- returns true if there are no more lines left to output in the skeleton

  function END_OF_SKELETON return BOOLEAN is 
  begin
    if (USE_EXTERNAL_SKELETON) then 

      -- we're using an external skelfile
      return TEXT_IO.END_OF_FILE(MISC_DEFS.SKELFILE); 
    else 

      -- internal skeleton
      return CURRENT_LINE > SKEL_TEMPLATE'LAST; 
    end if; 
  end END_OF_SKELETON; 

  procedure GET_FILE_LINE(BUFFER : in out FILE_STRING.VSTRING) is 
  begin
    if (USE_EXTERNAL_SKELETON) then 
      GET_EXTERNAL(BUFFER); 
    else 
      GET_INTERNAL(BUFFER); 
    end if; 
  end GET_FILE_LINE; 

  -- skelout - write out one section of the skeleton file
  --
  -- DESCRIPTION
  --    Either outputs internal skeleton, or from a file with "%%" dividers
  --    if a skeleton file is specified by the user.
  --    Copies from skelfile to stdout until a line beginning with "%%" or
  --    EOF is found.

  procedure SKELOUT is 
    BUF      : FILE_STRING.VSTRING; 
    LINE_LEN : INTEGER; 
-- UMASS CODES :
    Umass_Codes : Boolean := False;
    -- Indicates whether or not current line of the template
    -- is the Umass codes.
-- END OF UMASS CODES.
  begin
    while (not END_OF_SKELETON) loop
      GET_FILE_LINE(BUF); 
      if ((FILE_STRING.LEN(BUF) >= 2)
          and then ((FILE_STRING.CHAR(BUF, 1) = '%')
                     and (FILE_STRING.CHAR(BUF, 2) = '%'))) then 
        exit; 
      else 
-- UMASS CODES :
--   In the template, the codes between "-- UMASS CODES : " and
--   "-- END OF UMASS CODES." are specific to be used by Ayacc
--   extension. Ayacc extension has more power in error recovery.
--   So we generate those codes only when Ayacc_Extension_Flag is True.
        if FILE_STRING.STR(BUF) = "-- UMASS CODES :" then
          Umass_Codes := True;
        end if;

        if not Umass_Codes or else
           MISC_DEFS.Ayacc_Extension_Flag then 
          FILE_STRING.PUT_LINE(BUF); 
        end if;

        if FILE_STRING.STR(BUF) = "-- END OF UMASS CODES." then
          Umass_Codes := False;
        end if;
-- END OF UMASS CODES.

-- UCI CODES commented out :
--   The following line is commented out because it is done in Umass codes.
--      FILE_STRING.PUT_LINE(BUF);

      end if; 
    end loop; 
  end SKELOUT; 

end SKELETON_MANAGER; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<














































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/skeleton_manager.ads version [5cbfa23b8c].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE skeleton manager
-- AUTHOR: John Self (UCI)
-- DESCRIPTION outputs skeleton sections when called by gen.
-- NOTES allows use of internal or external skeleton
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/skeleton_manager.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with TSTRING; use TSTRING; 
package SKELETON_MANAGER is 
  procedure SKELOUT; 
  procedure SET_EXTERNAL_SKELETON; 
end SKELETON_MANAGER; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/sym.adb version [347e2a4c49].

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
pragma Warnings(Off);
pragma Style_Checks(Off);

-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE symbol table routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION implements only a simple symbol table using open hashing
-- NOTES could be faster, but it isn't used much
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/sym.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, Aflex_MISC, NFA, TEXT_IO, INT_IO, TSTRING; 

package body SYM is 
  package MISC renames Aflex_MISC;
  use MISC_DEFS; 
  use TSTRING; 

  -- addsym - add symbol and definitions to symbol table
  --
  -- true is returned if the symbol already exists, and the change not made.

  procedure ADDSYM(SYM, STR_DEF : in VSTRING; 
                   INT_DEF      : in INTEGER; 
                   TABLE        : in out HASH_TABLE; 
                   TABLE_SIZE   : in INTEGER; 
                   RESULT       : out BOOLEAN) is 
    HASH_VAL             : INTEGER := HASHFUNCT(SYM, TABLE_SIZE); 
    SYM_ENTRY            : HASH_LINK := TABLE(HASH_VAL); 
    NEW_ENTRY, SUCCESSOR : HASH_LINK; 
  begin
    while (SYM_ENTRY /= null) loop
      if (SYM = SYM_ENTRY.NAME) then 

        -- entry already exists
        RESULT := TRUE; 
        return; 
      end if; 

      SYM_ENTRY := SYM_ENTRY.NEXT; 
    end loop; 

    -- create new entry
    NEW_ENTRY := new HASH_ENTRY; 

    SUCCESSOR := TABLE(HASH_VAL); 
    if ((SUCCESSOR /= null)) then 
      NEW_ENTRY.NEXT := SUCCESSOR; 
      SUCCESSOR.PREV := NEW_ENTRY; 
    else 
      NEW_ENTRY.NEXT := null; 
    end if; 

    NEW_ENTRY.PREV := null; 
    NEW_ENTRY.NAME := SYM; 
    NEW_ENTRY.STR_VAL := STR_DEF; 
    NEW_ENTRY.INT_VAL := INT_DEF; 

    TABLE(HASH_VAL) := NEW_ENTRY; 

    RESULT := FALSE; 
    return; 

  exception
    when STORAGE_ERROR => 
      MISC.AFLEXFATAL("symbol table memory allocation failed"); 
  end ADDSYM; 


  -- cclinstal - save the text of a character class

  procedure CCLINSTAL(CCLTXT : in VSTRING; 
                      CCLNUM : in INTEGER) is 
  -- we don't bother checking the return status because we are not called
  -- unless the symbol is new
    DUMMY : BOOLEAN; 
  begin
    ADDSYM(CCLTXT, NUL, CCLNUM, CCLTAB, CCL_HASH_SIZE, DUMMY); 
  end CCLINSTAL; 


  -- ccllookup - lookup the number associated with character class text

  function CCLLOOKUP(CCLTXT : in VSTRING) return INTEGER is 
  begin
    return FINDSYM(CCLTXT, CCLTAB, CCL_HASH_SIZE).INT_VAL; 
  end CCLLOOKUP; 

  -- findsym - find symbol in symbol table

  function FINDSYM(SYMBOL     : in VSTRING; 
                   TABLE      : in HASH_TABLE; 
                   TABLE_SIZE : in INTEGER) return HASH_LINK is 
    SYM_ENTRY   : HASH_LINK := TABLE(HASHFUNCT(SYMBOL, TABLE_SIZE)); 
    EMPTY_ENTRY : HASH_LINK; 
  begin
    while (SYM_ENTRY /= null) loop
      if (SYMBOL = SYM_ENTRY.NAME) then 
        return SYM_ENTRY; 
      end if; 
      SYM_ENTRY := SYM_ENTRY.NEXT; 
    end loop; 
    EMPTY_ENTRY := new HASH_ENTRY; 
    EMPTY_ENTRY.all := (null, null, NUL, NUL, 0); 

    return EMPTY_ENTRY; 
  exception
    when STORAGE_ERROR => 
      MISC.AFLEXFATAL("dynamic memory failure in findsym()"); 
      return EMPTY_ENTRY; 
  end FINDSYM; 

  -- hashfunct - compute the hash value for "str" and hash size "hash_size"

  function HASHFUNCT(STR       : in VSTRING; 
                     HASH_SIZE : in INTEGER) return INTEGER is 
    HASHVAL, LOCSTR : INTEGER; 
  begin
    HASHVAL := 0; 
    LOCSTR := TSTRING.FIRST; 

    while (LOCSTR <= TSTRING.LEN(STR)) loop
      HASHVAL := ((HASHVAL*2) + CHARACTER'POS(CHAR(STR, LOCSTR))) mod HASH_SIZE
        ; 
      LOCSTR := LOCSTR + 1; 
    end loop; 

    return HASHVAL; 
  end HASHFUNCT; 


  --ndinstal - install a name definition

  procedure NDINSTAL(ND, DEF : in VSTRING) is 
    RESULT : BOOLEAN; 
  begin
    ADDSYM(ND, DEF, 0, NDTBL, NAME_TABLE_HASH_SIZE, RESULT); 
    if (RESULT) then 
      MISC.SYNERR("name defined twice"); 
    end if; 
  end NDINSTAL; 

  -- ndlookup - lookup a name definition

  function NDLOOKUP(ND : in VSTRING) return VSTRING is 
  begin
    return FINDSYM(ND, NDTBL, NAME_TABLE_HASH_SIZE).STR_VAL; 
  end NDLOOKUP; 

  -- scinstal - make a start condition
  --
  -- NOTE
  --    the start condition is Exclusive if xcluflg is true

  procedure SCINSTAL(STR     : in VSTRING; 
                     XCLUFLG : in BOOLEAN) is 
  -- bit of a hack.  We know how the default start-condition is
  -- declared, and don't put out a define for it, because it
  -- would come out as "#define 0 1"

  -- actually, this is no longer the case.  The default start-condition
  -- is now called "INITIAL".  But we keep the following for the sake
  -- of future robustness.
    RESULT : BOOLEAN; 
  begin
    if (STR /= VSTR("0")) then 
      TSTRING.PUT(DEF_FILE, STR); 
      TEXT_IO.PUT(DEF_FILE, " : constant := "); 
      INT_IO.PUT(DEF_FILE, LASTSC, 1); 
      TEXT_IO.PUT_LINE(DEF_FILE, ";"); 
    end if; 

    LASTSC := LASTSC + 1; 
    if (LASTSC >= CURRENT_MAX_SCS) then 
      CURRENT_MAX_SCS := CURRENT_MAX_SCS + MAX_SCS_INCREMENT; 

      NUM_REALLOCS := NUM_REALLOCS + 1; 

      REALLOCATE_INTEGER_ARRAY(SCSET, CURRENT_MAX_SCS); 
      REALLOCATE_INTEGER_ARRAY(SCBOL, CURRENT_MAX_SCS); 
      REALLOCATE_BOOLEAN_ARRAY(SCXCLU, CURRENT_MAX_SCS); 
      REALLOCATE_BOOLEAN_ARRAY(SCEOF, CURRENT_MAX_SCS); 
      REALLOCATE_VSTRING_ARRAY(SCNAME, CURRENT_MAX_SCS); 
      REALLOCATE_INTEGER_ARRAY(ACTVSC, CURRENT_MAX_SCS); 
    end if; 

    SCNAME(LASTSC) := STR; 

    ADDSYM(SCNAME(LASTSC), NUL, LASTSC, SCTBL, START_COND_HASH_SIZE, RESULT); 
    if (RESULT) then 
      MISC.AFLEXERROR("start condition " & STR & " declared twice"); 
    end if; 

    SCSET(LASTSC) := NFA.MKSTATE(SYM_EPSILON); 
    SCBOL(LASTSC) := NFA.MKSTATE(SYM_EPSILON); 
    SCXCLU(LASTSC) := XCLUFLG; 
    SCEOF(LASTSC) := FALSE; 
  end SCINSTAL; 


  -- sclookup - lookup the number associated with a start condition

  function SCLOOKUP(STR : in VSTRING) return INTEGER is 
  begin
    return FINDSYM(STR, SCTBL, START_COND_HASH_SIZE).INT_VAL; 
  end SCLOOKUP; 

end SYM; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/sym.ads version [702c0f29db].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE symbol table routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION implements only a simple symbol table using open hashing
-- NOTES could be faster, but it isn't used much
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/sym.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with TSTRING; 
with MISC_DEFS; 
package SYM is 

  use TSTRING; 
  use MISC_DEFS; 

  procedure ADDSYM(SYM, STR_DEF : in VSTRING; 
                   INT_DEF      : in INTEGER; 
                   TABLE        : in out HASH_TABLE; 
                   TABLE_SIZE   : in INTEGER; 
                   RESULT       : out BOOLEAN); 
  -- result indicates success
  procedure CCLINSTAL(CCLTXT : in VSTRING; 
                      CCLNUM : in INTEGER); 
  function CCLLOOKUP(CCLTXT : in VSTRING) return INTEGER; 
  function FINDSYM(SYMBOL     : in VSTRING; 
                   TABLE      : in HASH_TABLE; 
                   TABLE_SIZE : in INTEGER) return HASH_LINK; 

  function HASHFUNCT(STR       : in VSTRING; 
                     HASH_SIZE : in INTEGER) return INTEGER; 
  procedure NDINSTAL(ND, DEF : in VSTRING); 
  function NDLOOKUP(ND : in VSTRING) return VSTRING; 
  procedure SCINSTAL(STR     : in VSTRING; 
                     XCLUFLG : in BOOLEAN); 
  function SCLOOKUP(STR : in VSTRING) return INTEGER; 
end SYM; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/tblcmp.adb version [976a0af4a5].

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
pragma Warnings(Off);
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE table compression routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION used for compressed tables only
-- NOTES somewhat complicated but works fast and generates efficient scanners
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/tblcmp.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with DFA, ECS, MISC_DEFS; use MISC_DEFS; 
package body TBLCMP is 

-- bldtbl - build table entries for dfa state
--
-- synopsis
--   int state[numecs], statenum, totaltrans, comstate, comfreq;
--   bldtbl( state, statenum, totaltrans, comstate, comfreq );
--
-- State is the statenum'th dfa state.  It is indexed by equivalence class and
-- gives the number of the state to enter for a given equivalence class.
-- totaltrans is the total number of transitions out of the state.  Comstate
-- is that state which is the destination of the most transitions out of State.
-- Comfreq is how many transitions there are out of State to Comstate.
--
-- A note on terminology:
--    "protos" are transition tables which have a high probability of
-- either being redundant (a state processed later will have an identical
-- transition table) or nearly redundant (a state processed later will have
-- many of the same out-transitions).  A "most recently used" queue of
-- protos is kept around with the hope that most states will find a proto
-- which is similar enough to be usable, and therefore compacting the
-- output tables.
--    "templates" are a special type of proto.  If a transition table is
-- homogeneous or nearly homogeneous (all transitions go to the same
-- destination) then the odds are good that future states will also go
-- to the same destination state on basically the same character set.
-- These homogeneous states are so common when dealing with large rule
-- sets that they merit special attention.  If the transition table were
-- simply made into a proto, then (typically) each subsequent, similar
-- state will differ from the proto for two out-transitions.  One of these
-- out-transitions will be that character on which the proto does not go
-- to the common destination, and one will be that character on which the
-- state does not go to the common destination.  Templates, on the other
-- hand, go to the common state on EVERY transition character, and therefore
-- cost only one difference.

  procedure BLDTBL(STATE                                   : in 
                     UNBOUNDED_INT_ARRAY; 
                   STATENUM, TOTALTRANS, COMSTATE, COMFREQ : in INTEGER) is 
    EXTPTR : INTEGER; 
    subtype CARRAY is UNBOUNDED_INT_ARRAY(0 .. CSIZE + 1); 
    EXTRCT                 : array(0 .. 1) of CARRAY; 
    MINDIFF, MINPROT, I, D : INTEGER; 
    CHECKCOM               : BOOLEAN; 
    LOCAL_COMSTATE         : INTEGER; 
  begin

    -- If extptr is 0 then the first array of extrct holds the result of the
    -- "best difference" to date, which is those transitions which occur in
    -- "state" but not in the proto which, to date, has the fewest differences
    -- between itself and "state".  If extptr is 1 then the second array of
    -- extrct hold the best difference.  The two arrays are toggled
    -- between so that the best difference to date can be kept around and
    -- also a difference just created by checking against a candidate "best"
    -- proto.
    LOCAL_COMSTATE := COMSTATE; 
    EXTPTR := 0; 

    -- if the state has too few out-transitions, don't bother trying to
    -- compact its tables
    if ((TOTALTRANS*100) < (NUMECS*PROTO_SIZE_PERCENTAGE)) then 
      MKENTRY(STATE, NUMECS, STATENUM, JAMSTATE_CONST, TOTALTRANS); 
    else 

      -- checkcom is true if we should only check "state" against
      -- protos which have the same "comstate" value
      CHECKCOM := COMFREQ*100 > TOTALTRANS*CHECK_COM_PERCENTAGE; 

      MINPROT := FIRSTPROT; 
      MINDIFF := TOTALTRANS; 

      if (CHECKCOM) then 

        -- find first proto which has the same "comstate"
        I := FIRSTPROT; 
        while (I /= NIL) loop
          if (PROTCOMST(I) = LOCAL_COMSTATE) then 
            MINPROT := I; 
            TBLDIFF(STATE, MINPROT, EXTRCT(EXTPTR), MINDIFF); 
            exit; 
          end if; 
          I := PROTNEXT(I); 
        end loop; 
      else 

        -- since we've decided that the most common destination out
        -- of "state" does not occur with a high enough frequency,
        -- we set the "comstate" to zero, assuring that if this state
        -- is entered into the proto list, it will not be considered
        -- a template.
        LOCAL_COMSTATE := 0; 

        if (FIRSTPROT /= NIL) then 
          MINPROT := FIRSTPROT; 
          TBLDIFF(STATE, MINPROT, EXTRCT(EXTPTR), MINDIFF); 
        end if; 
      end if; 

      -- we now have the first interesting proto in "minprot".  If
      -- it matches within the tolerances set for the first proto,
      -- we don't want to bother scanning the rest of the proto list
      -- to see if we have any other reasonable matches.
      if (MINDIFF*100 > TOTALTRANS*FIRST_MATCH_DIFF_PERCENTAGE) then 

        -- not a good enough match.  Scan the rest of the protos 
        I := MINPROT; 
        while (I /= NIL) loop
          TBLDIFF(STATE, I, EXTRCT(1 - EXTPTR), D); 
          if (D < MINDIFF) then 
            EXTPTR := 1 - EXTPTR; 
            MINDIFF := D; 
            MINPROT := I; 
          end if; 
          I := PROTNEXT(I); 
        end loop; 
      end if; 

      -- check if the proto we've decided on as our best bet is close
      -- enough to the state we want to match to be usable
      if (MINDIFF*100 > TOTALTRANS*ACCEPTABLE_DIFF_PERCENTAGE) then 

        -- no good.  If the state is homogeneous enough, we make a
        -- template out of it.  Otherwise, we make a proto.
        if (COMFREQ*100 >= TOTALTRANS*TEMPLATE_SAME_PERCENTAGE) then 
          MKTEMPLATE(STATE, STATENUM, LOCAL_COMSTATE); 
        else 
          MKPROT(STATE, STATENUM, LOCAL_COMSTATE); 
          MKENTRY(STATE, NUMECS, STATENUM, JAMSTATE_CONST, TOTALTRANS); 
        end if; 
      else 

        -- use the proto
        MKENTRY(EXTRCT(EXTPTR), NUMECS, STATENUM, PROTTBL(MINPROT), MINDIFF); 

        -- if this state was sufficiently different from the proto
        -- we built it from, make it, too, a proto
        if (MINDIFF*100 >= TOTALTRANS*NEW_PROTO_DIFF_PERCENTAGE) then 
          MKPROT(STATE, STATENUM, LOCAL_COMSTATE); 
        end if; 

        -- since mkprot added a new proto to the proto queue, it's possible
        -- that "minprot" is no longer on the proto queue (if it happened
        -- to have been the last entry, it would have been bumped off).
        -- If it's not there, then the new proto took its physical place
        -- (though logically the new proto is at the beginning of the
        -- queue), so in that case the following call will do nothing.
        MV2FRONT(MINPROT); 
      end if; 
    end if; 
  end BLDTBL; 

  -- cmptmps - compress template table entries
  --
  --  template tables are compressed by using the 'template equivalence
  --  classes', which are collections of transition character equivalence
--  classes which always appear together in templates - really meta-equivalence
  --  classes.  until this point, the tables for templates have been stored
  --  up at the top end of the nxt array; they will now be compressed and have
  --  table entries made for them.

  procedure CMPTMPS is 
    TMPSTORAGE        : C_SIZE_ARRAY; 
    TOTALTRANS, TRANS : INTEGER; 
  begin
    PEAKPAIRS := NUMTEMPS*NUMECS + TBLEND; 

    if (USEMECS) then 

      -- create equivalence classes base on data gathered on template
      -- transitions
      ECS.CRE8ECS(TECFWD, TECBCK, NUMECS, NUMMECS); 
    else 
      NUMMECS := NUMECS; 
    end if; 

    if (LASTDFA + NUMTEMPS + 1 >= CURRENT_MAX_DFAS) then 
      DFA.INCREASE_MAX_DFAS; 
    end if; 

    -- loop through each template
    for I in 1 .. NUMTEMPS loop
      TOTALTRANS := 0; 

      -- number of non-jam transitions out of this template
      for J in 1 .. NUMECS loop
        TRANS := TNXT(NUMECS*I + J); 

        if (USEMECS) then 

          -- the absolute value of tecbck is the meta-equivalence class
          -- of a given equivalence class, as set up by cre8ecs
          if (TECBCK(J) > 0) then 
            TMPSTORAGE(TECBCK(J)) := TRANS; 

            if (TRANS > 0) then 
              TOTALTRANS := TOTALTRANS + 1; 
            end if; 
          end if; 
        else 
          TMPSTORAGE(J) := TRANS; 

          if (TRANS > 0) then 
            TOTALTRANS := TOTALTRANS + 1; 
          end if; 
        end if; 
      end loop; 

      -- it is assumed (in a rather subtle way) in the skeleton that
      -- if we're using meta-equivalence classes, the def[] entry for
      -- all templates is the jam template, i.e., templates never default
      -- to other non-jam table entries (e.g., another template)

      -- leave room for the jam-state after the last real state
      MKENTRY(TMPSTORAGE, NUMMECS, LASTDFA + I + 1, JAMSTATE_CONST, TOTALTRANS)
        ; 
    end loop; 
  end CMPTMPS; 

  -- expand_nxt_chk - expand the next check arrays

  procedure EXPAND_NXT_CHK is 
    OLD_MAX : INTEGER := CURRENT_MAX_XPAIRS; 
  begin
    CURRENT_MAX_XPAIRS := CURRENT_MAX_XPAIRS + MAX_XPAIRS_INCREMENT; 

    NUM_REALLOCS := NUM_REALLOCS + 1; 

    REALLOCATE_INTEGER_ARRAY(NXT, CURRENT_MAX_XPAIRS); 
    REALLOCATE_INTEGER_ARRAY(CHK, CURRENT_MAX_XPAIRS); 

    for I in OLD_MAX .. CURRENT_MAX_XPAIRS loop
      CHK(I) := 0; 
    end loop; 
  end EXPAND_NXT_CHK; 

  -- find_table_space - finds a space in the table for a state to be placed
  --
  -- State is the state to be added to the full speed transition table.
  -- Numtrans is the number of out-transitions for the state.
  --
-- find_table_space() returns the position of the start of the first block (in
  -- chk) able to accommodate the state
  --
-- In determining if a state will or will not fit, find_table_space() must take
  -- into account the fact that an end-of-buffer state will be added at [0],
  -- and an action number will be added in [-1].

  function FIND_TABLE_SPACE(STATE    : in UNBOUNDED_INT_ARRAY; 
                            NUMTRANS : in INTEGER) return INTEGER is 
  -- firstfree is the position of the first possible occurrence of two
  -- consecutive unused records in the chk and nxt arrays

    I                                              : INTEGER; 
    STATE_PTR, CHK_PTR, PTR_TO_LAST_ENTRY_IN_STATE : INT_PTR; 
    CNT, SCNT                                      : INTEGER; 
    -- if there are too many out-transitions, put the state at the end of
    -- nxt and chk
  begin
    if (NUMTRANS > MAX_XTIONS_FULL_INTERIOR_FIT) then 

      -- if table is empty, return the first available spot in chk/nxt,
      -- which should be 1
      if (TBLEND < 2) then 
        return (1); 
      end if; 

      I := TBLEND - NUMECS; 

    -- start searching for table space near the
    -- end of chk/nxt arrays
    else 
      I := FIRSTFREE; 

    -- start searching for table space from the
    -- beginning (skipping only the elements
    -- which will definitely not hold the new
    -- state)
    end if; 

    loop

      -- loops until a space is found
      if (I + NUMECS > CURRENT_MAX_XPAIRS) then 
        EXPAND_NXT_CHK; 
      end if; 

      -- loops until space for end-of-buffer and action number are found
      loop
        if (CHK(I - 1) = 0) then 

          -- check for action number space
          if (CHK(I) = 0) then 

            -- check for end-of-buffer space
            exit; 
          else 
            I := I + 2; 

          -- since i != 0, there is no use checking to
          -- see if (++i) - 1 == 0, because that's the
          -- same as i == 0, so we skip a space
          end if; 
        else 
          I := I + 1; 
        end if; 

        if (I + NUMECS > CURRENT_MAX_XPAIRS) then 
          EXPAND_NXT_CHK; 
        end if; 
      end loop; 

      -- if we started search from the beginning, store the new firstfree for
      -- the next call of find_table_space()
      if (NUMTRANS <= MAX_XTIONS_FULL_INTERIOR_FIT) then 
        FIRSTFREE := I + 1; 
      end if; 

      -- check to see if all elements in chk (and therefore nxt) that are
      -- needed for the new state have not yet been taken
      CNT := I + 1; 
      SCNT := 1; 
      while (CNT /= I + NUMECS + 1) loop
        if ((STATE(SCNT) /= 0) and (CHK(CNT) /= 0)) then 
          exit; 
        end if; 
        SCNT := SCNT + 1; 
        CNT := CNT + 1; 
      end loop; 

      if (CNT = I + NUMECS + 1) then 
        return I; 
      else 
        I := I + 1; 
      end if; 
    end loop; 
  end FIND_TABLE_SPACE; 

  -- inittbl - initialize transition tables
  --
-- Initializes "firstfree" to be one beyond the end of the table.  Initializes
  -- all "chk" entries to be zero.  Note that templates are built in their
  -- own tbase/tdef tables.  They are shifted down to be contiguous
  -- with the non-template entries during table generation.

  procedure INITTBL is 
  begin
    for I in 0 .. CURRENT_MAX_XPAIRS loop
      CHK(I) := 0; 
    end loop; 

    TBLEND := 0; 
    FIRSTFREE := TBLEND + 1; 
    NUMTEMPS := 0; 

    if (USEMECS) then 

      -- set up doubly-linked meta-equivalence classes
      -- these are sets of equivalence classes which all have identical
      -- transitions out of TEMPLATES
      TECBCK(1) := NIL; 

      for I in 2 .. NUMECS loop
        TECBCK(I) := I - 1; 
        TECFWD(I - 1) := I; 
      end loop; 

      TECFWD(NUMECS) := NIL; 
    end if; 
  end INITTBL; 

  -- mkdeftbl - make the default, "jam" table entries

  procedure MKDEFTBL is 
  begin
    JAMSTATE := LASTDFA + 1; 

    TBLEND := TBLEND + 1; 

    -- room for transition on end-of-buffer character
    if (TBLEND + NUMECS > CURRENT_MAX_XPAIRS) then 
      EXPAND_NXT_CHK; 
    end if; 

    -- add in default end-of-buffer transition
    NXT(TBLEND) := END_OF_BUFFER_STATE; 
    CHK(TBLEND) := JAMSTATE; 

    for I in 1 .. NUMECS loop
      NXT(TBLEND + I) := 0; 
      CHK(TBLEND + I) := JAMSTATE; 
    end loop; 

    JAMBASE := TBLEND; 

    BASE(JAMSTATE) := JAMBASE; 
    DEF(JAMSTATE) := 0; 

    TBLEND := TBLEND + NUMECS; 
    NUMTEMPS := NUMTEMPS + 1; 
  end MKDEFTBL; 

  -- mkentry - create base/def and nxt/chk entries for transition array
  --
  -- "state" is a transition array "numchars" characters in size, "statenum"
  -- is the offset to be used into the base/def tables, and "deflink" is the
  -- entry to put in the "def" table entry.  If "deflink" is equal to
  -- "JAMSTATE", then no attempt will be made to fit zero entries of "state"
  -- (i.e., jam entries) into the table.  It is assumed that by linking to
  -- "JAMSTATE" they will be taken care of.  In any case, entries in "state"
  -- marking transitions to "SAME_TRANS" are treated as though they will be
  -- taken care of by whereever "deflink" points.  "totaltrans" is the total
-- number of transitions out of the state.  If it is below a certain threshold,
  -- the tables are searched for an interior spot that will accommodate the
  -- state array.

  procedure MKENTRY(STATE                                   : in 
                      UNBOUNDED_INT_ARRAY; 
                    NUMCHARS, STATENUM, DEFLINK, TOTALTRANS : in INTEGER) is 
    I, MINEC, MAXEC, BASEADDR, TBLBASE, TBLLAST : INTEGER; 
  begin
    if (TOTALTRANS = 0) then 

      -- there are no out-transitions
      if (DEFLINK = JAMSTATE_CONST) then 
        BASE(STATENUM) := JAMSTATE_CONST; 
      else 
        BASE(STATENUM) := 0; 
      end if; 

      DEF(STATENUM) := DEFLINK; 
      return; 
    end if; 

    MINEC := 1; 
    while (MINEC <= NUMCHARS) loop
      if (STATE(MINEC) /= SAME_TRANS) then 
        if ((STATE(MINEC) /= 0) or (DEFLINK /= JAMSTATE_CONST)) then 
          exit; 
        end if; 
      end if; 
      MINEC := MINEC + 1; 
    end loop; 

    if (TOTALTRANS = 1) then 

      -- there's only one out-transition.  Save it for later to fill
      -- in holes in the tables.
      STACK1(STATENUM, MINEC, STATE(MINEC), DEFLINK); 
      return; 
    end if; 

    MAXEC := NUMCHARS; 
    while (MAXEC >= 1) loop
      if (STATE(MAXEC) /= SAME_TRANS) then 
        if ((STATE(MAXEC) /= 0) or (DEFLINK /= JAMSTATE_CONST)) then 
          exit; 
        end if; 
      end if; 
      MAXEC := MAXEC - 1; 
    end loop; 

    -- Whether we try to fit the state table in the middle of the table
    -- entries we have already generated, or if we just take the state
    -- table at the end of the nxt/chk tables, we must make sure that we
    -- have a valid base address (i.e., non-negative).  Note that not only are
    -- negative base addresses dangerous at run-time (because indexing the
    -- next array with one and a low-valued character might generate an
    -- array-out-of-bounds error message), but at compile-time negative
    -- base addresses denote TEMPLATES.

    -- find the first transition of state that we need to worry about.
    if (TOTALTRANS*100 <= NUMCHARS*INTERIOR_FIT_PERCENTAGE) then 

      -- attempt to squeeze it into the middle of the tabls
      BASEADDR := FIRSTFREE; 

      while (BASEADDR < MINEC) loop

        -- using baseaddr would result in a negative base address below
        -- find the next free slot
        BASEADDR := BASEADDR + 1; 
        while (CHK(BASEADDR) /= 0) loop
          BASEADDR := BASEADDR + 1; 
        end loop; 
      end loop; 

      if (BASEADDR + MAXEC - MINEC >= CURRENT_MAX_XPAIRS) then 
        EXPAND_NXT_CHK; 
      end if; 

      I := MINEC; 
      while (I <= MAXEC) loop
        if (STATE(I) /= SAME_TRANS) then 
          if ((STATE(I) /= 0) or (DEFLINK /= JAMSTATE_CONST)) then 
            if (CHK(BASEADDR + I - MINEC) /= 0) then 

              -- baseaddr unsuitable - find another
              BASEADDR := BASEADDR + 1; 
              while ((BASEADDR < CURRENT_MAX_XPAIRS) and (CHK(BASEADDR) /= 0))
                loop
                BASEADDR := BASEADDR + 1; 
              end loop; 

              if (BASEADDR + MAXEC - MINEC >= CURRENT_MAX_XPAIRS) then 
                EXPAND_NXT_CHK; 
              end if; 

              -- reset the loop counter so we'll start all
              -- over again next time it's incremented
              I := MINEC - 1; 
            end if; 
          end if; 
        end if; 
        I := I + 1; 
      end loop; 
    else 

      -- ensure that the base address we eventually generate is
      -- non-negative
      BASEADDR := MAX(TBLEND + 1, MINEC); 
    end if; 

    TBLBASE := BASEADDR - MINEC; 
    TBLLAST := TBLBASE + MAXEC; 

    if (TBLLAST >= CURRENT_MAX_XPAIRS) then 
      EXPAND_NXT_CHK; 
    end if; 

    BASE(STATENUM) := TBLBASE; 
    DEF(STATENUM) := DEFLINK; 

    for J in MINEC .. MAXEC loop
      if (STATE(J) /= SAME_TRANS) then 
        if ((STATE(J) /= 0) or (DEFLINK /= JAMSTATE_CONST)) then 
          NXT(TBLBASE + J) := STATE(J); 
          CHK(TBLBASE + J) := STATENUM; 
        end if; 
      end if; 
    end loop; 

    if (BASEADDR = FIRSTFREE) then 

      -- find next free slot in tables
      FIRSTFREE := FIRSTFREE + 1; 
      while (CHK(FIRSTFREE) /= 0) loop
        FIRSTFREE := FIRSTFREE + 1; 
      end loop; 
    end if; 

    TBLEND := MAX(TBLEND, TBLLAST); 
  end MKENTRY; 

  -- mk1tbl - create table entries for a state (or state fragment) which
  --            has only one out-transition

  procedure MK1TBL(STATE, SYM, ONENXT, ONEDEF : in INTEGER) is 
  begin
    if (FIRSTFREE < SYM) then 
      FIRSTFREE := SYM; 
    end if; 

    while (CHK(FIRSTFREE) /= 0) loop
      FIRSTFREE := FIRSTFREE + 1; 
      if (FIRSTFREE >= CURRENT_MAX_XPAIRS) then 
        EXPAND_NXT_CHK; 
      end if; 
    end loop; 

    BASE(STATE) := FIRSTFREE - SYM; 
    DEF(STATE) := ONEDEF; 
    CHK(FIRSTFREE) := STATE; 
    NXT(FIRSTFREE) := ONENXT; 

    if (FIRSTFREE > TBLEND) then 
      TBLEND := FIRSTFREE; 
      FIRSTFREE := FIRSTFREE + 1; 

      if (FIRSTFREE >= CURRENT_MAX_XPAIRS) then 
        EXPAND_NXT_CHK; 
      end if; 
    end if; 
  end MK1TBL; 

  -- mkprot - create new proto entry

  procedure MKPROT(STATE              : in UNBOUNDED_INT_ARRAY; 
                   STATENUM, COMSTATE : in INTEGER) is 
    SLOT, TBLBASE : INTEGER; 
  begin
    NUMPROTS := NUMPROTS + 1; 
    if ((NUMPROTS >= MSP) or (NUMECS*NUMPROTS >= PROT_SAVE_SIZE)) then 

      -- gotta make room for the new proto by dropping last entry in
      -- the queue
      SLOT := LASTPROT; 
      LASTPROT := PROTPREV(LASTPROT); 
      PROTNEXT(LASTPROT) := NIL; 
    else 
      SLOT := NUMPROTS; 
    end if; 

    PROTNEXT(SLOT) := FIRSTPROT; 

    if (FIRSTPROT /= NIL) then 
      PROTPREV(FIRSTPROT) := SLOT; 
    end if; 

    FIRSTPROT := SLOT; 
    PROTTBL(SLOT) := STATENUM; 
    PROTCOMST(SLOT) := COMSTATE; 

    -- copy state into save area so it can be compared with rapidly
    TBLBASE := NUMECS*(SLOT - 1); 

    for I in 1 .. NUMECS loop
      PROTSAVE(TBLBASE + I) := STATE(I + STATE'FIRST); 
    end loop; 
  end MKPROT; 

-- mktemplate - create a template entry based on a state, and connect the state
  --              to it

  procedure MKTEMPLATE(STATE              : in UNBOUNDED_INT_ARRAY; 
                       STATENUM, COMSTATE : in INTEGER) is 
    NUMDIFF, TMPBASE : INTEGER; 
    TMP              : C_SIZE_ARRAY; 
    subtype TARRAY is CHAR_ARRAY(0 .. CSIZE); 
    TRANSSET : TARRAY; 
    TSPTR    : INTEGER; 
  begin
    NUMTEMPS := NUMTEMPS + 1; 

    TSPTR := 0; 

    -- calculate where we will temporarily store the transition table
    -- of the template in the tnxt[] array.  The final transition table
    -- gets created by cmptmps()
    TMPBASE := NUMTEMPS*NUMECS; 

    if (TMPBASE + NUMECS >= CURRENT_MAX_TEMPLATE_XPAIRS) then 
      CURRENT_MAX_TEMPLATE_XPAIRS := CURRENT_MAX_TEMPLATE_XPAIRS + 
        MAX_TEMPLATE_XPAIRS_INCREMENT; 

      NUM_REALLOCS := NUM_REALLOCS + 1; 

      REALLOCATE_INTEGER_ARRAY(TNXT, CURRENT_MAX_TEMPLATE_XPAIRS); 
    end if; 

    for I in 1 .. NUMECS loop
      if (STATE(I) = 0) then 
        TNXT(TMPBASE + I) := 0; 
      else 
        TRANSSET(TSPTR) := CHARACTER'VAL(I); 
        TSPTR := TSPTR + 1; 
        TNXT(TMPBASE + I) := COMSTATE; 
      end if; 
    end loop; 

    if (USEMECS) then 
      ECS.MKECCL(TRANSSET, TSPTR, TECFWD, TECBCK, NUMECS); 
    end if; 

    MKPROT(TNXT(TMPBASE .. CURRENT_MAX_TEMPLATE_XPAIRS),  -NUMTEMPS, COMSTATE); 

    -- we rely on the fact that mkprot adds things to the beginning
    -- of the proto queue
    TBLDIFF(STATE, FIRSTPROT, TMP, NUMDIFF); 
    MKENTRY(TMP, NUMECS, STATENUM,  -NUMTEMPS, NUMDIFF); 
  end MKTEMPLATE; 

  -- mv2front - move proto queue element to front of queue

  procedure MV2FRONT(QELM : in INTEGER) is 
  begin
    if (FIRSTPROT /= QELM) then 
      if (QELM = LASTPROT) then 
        LASTPROT := PROTPREV(LASTPROT); 
      end if; 

      PROTNEXT(PROTPREV(QELM)) := PROTNEXT(QELM); 

      if (PROTNEXT(QELM) /= NIL) then 
        PROTPREV(PROTNEXT(QELM)) := PROTPREV(QELM); 
      end if; 

      PROTPREV(QELM) := NIL; 
      PROTNEXT(QELM) := FIRSTPROT; 
      PROTPREV(FIRSTPROT) := QELM; 
      FIRSTPROT := QELM; 
    end if; 
  end MV2FRONT; 

  -- place_state - place a state into full speed transition table
  --
  -- State is the statenum'th state.  It is indexed by equivalence class and
  -- gives the number of the state to enter for a given equivalence class.
  -- Transnum is the number of out-transitions for the state.

  procedure PLACE_STATE(STATE              : in UNBOUNDED_INT_ARRAY; 
                        STATENUM, TRANSNUM : in INTEGER) is 
    I        : INTEGER; 
    POSITION : INTEGER := FIND_TABLE_SPACE(STATE, TRANSNUM); 
  begin

    -- base is the table of start positions
    BASE(STATENUM) := POSITION; 

    -- put in action number marker; this non-zero number makes sure that
    -- find_table_space() knows that this position in chk/nxt is taken
    -- and should not be used for another accepting number in another state
    CHK(POSITION - 1) := 1; 

    -- put in end-of-buffer marker; this is for the same purposes as above
    CHK(POSITION) := 1; 

    -- place the state into chk and nxt
    I := 1; 
    while (I <= NUMECS) loop
      if (STATE(I) /= 0) then 
        CHK(POSITION + I) := I; 
        NXT(POSITION + I) := STATE(I); 
      end if; 
      I := I + 1; 
    end loop; 

    if (POSITION + NUMECS > TBLEND) then 
      TBLEND := POSITION + NUMECS; 
    end if; 
  end PLACE_STATE; 

  -- stack1 - save states with only one out-transition to be processed later
  --
  -- if there's room for another state one the "one-transition" stack, the
  -- state is pushed onto it, to be processed later by mk1tbl.  If there's
  -- no room, we process the sucker right now.

  procedure STACK1(STATENUM, SYM, NEXTSTATE, DEFLINK : in INTEGER) is 
  begin
    if (ONESP >= ONE_STACK_SIZE - 1) then 
      MK1TBL(STATENUM, SYM, NEXTSTATE, DEFLINK); 
    else 
      ONESP := ONESP + 1; 
      ONESTATE(ONESP) := STATENUM; 
      ONESYM(ONESP) := SYM; 
      ONENEXT(ONESP) := NEXTSTATE; 
      ONEDEF(ONESP) := DEFLINK; 
    end if; 
  end STACK1; 

  -- tbldiff - compute differences between two state tables
  --
  -- "state" is the state array which is to be extracted from the pr'th
  -- proto.  "pr" is both the number of the proto we are extracting from
  -- and an index into the save area where we can find the proto's complete
  -- state table.  Each entry in "state" which differs from the corresponding
  -- entry of "pr" will appear in "ext".
  -- Entries which are the same in both "state" and "pr" will be marked
  -- as transitions to "SAME_TRANS" in "ext".  The total number of differences
  -- between "state" and "pr" is returned as function value.  Note that this
  -- number is "numecs" minus the number of "SAME_TRANS" entries in "ext".

  procedure TBLDIFF(STATE  : in UNBOUNDED_INT_ARRAY; 
                    PR     : in INTEGER; 
                    EXT    : out UNBOUNDED_INT_ARRAY; 
                    RESULT : out INTEGER) is 
    SP      : INTEGER := 0; 
    EP      : INTEGER := 0; 
    NUMDIFF : INTEGER := 0; 
    PROTP   : INTEGER; 
  begin
    PROTP := NUMECS*(PR - 1); 

    for I in reverse 1 .. NUMECS loop
      PROTP := PROTP + 1; 
      SP := SP + 1; 
      if (PROTSAVE(PROTP) = STATE(SP)) then 
        EP := EP + 1; 
        EXT(EP) := SAME_TRANS; 
      else 
        EP := EP + 1; 
        EXT(EP) := STATE(SP); 
        NUMDIFF := NUMDIFF + 1; 
      end if; 
    end loop; 

    RESULT := NUMDIFF; 
    return; 
  end TBLDIFF; 

end TBLCMP; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/tblcmp.ads version [edd3cd2ce7].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE table compression routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION used for compressed tables only
-- NOTES somewhat complicated but works fast and generates efficient scanners
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/tblcmp.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS; use MISC_DEFS; 

package TBLCMP is 

-- bldtbl - build table entries for dfa state

  procedure BLDTBL(STATE                                   : in 
                     UNBOUNDED_INT_ARRAY; 
                   STATENUM, TOTALTRANS, COMSTATE, COMFREQ : in INTEGER); 

  procedure CMPTMPS; 

  -- expand_nxt_chk - expand the next check arrays

  procedure EXPAND_NXT_CHK; 

  -- find_table_space - finds a space in the table for a state to be placed

  function FIND_TABLE_SPACE(STATE    : in UNBOUNDED_INT_ARRAY; 
                            NUMTRANS : in INTEGER) return INTEGER; 

  -- inittbl - initialize transition tables

  procedure INITTBL; 

  -- mkdeftbl - make the default, "jam" table entries

  procedure MKDEFTBL; 

  -- mkentry - create base/def and nxt/chk entries for transition array

  procedure MKENTRY(STATE                                   : in 
                      UNBOUNDED_INT_ARRAY; 
                    NUMCHARS, STATENUM, DEFLINK, TOTALTRANS : in INTEGER); 

  -- mk1tbl - create table entries for a state (or state fragment) which
  --            has only one out-transition

  procedure MK1TBL(STATE, SYM, ONENXT, ONEDEF : in INTEGER); 

  -- mkprot - create new proto entry

  procedure MKPROT(STATE              : in UNBOUNDED_INT_ARRAY; 
                   STATENUM, COMSTATE : in INTEGER); 

-- mktemplate - create a template entry based on a state, and connect the state
  --              to it

  procedure MKTEMPLATE(STATE              : in UNBOUNDED_INT_ARRAY; 
                       STATENUM, COMSTATE : in INTEGER); 

  -- mv2front - move proto queue element to front of queue

  procedure MV2FRONT(QELM : in INTEGER); 

  -- place_state - place a state into full speed transition table

  procedure PLACE_STATE(STATE              : in UNBOUNDED_INT_ARRAY; 
                        STATENUM, TRANSNUM : in INTEGER); 

  -- stack1 - save states with only one out-transition to be processed later

  procedure STACK1(STATENUM, SYM, NEXTSTATE, DEFLINK : in INTEGER); 

  -- tbldiff - compute differences between two state tables

  procedure TBLDIFF(STATE  : in UNBOUNDED_INT_ARRAY; 
                    PR     : in INTEGER; 
                    EXT    : out UNBOUNDED_INT_ARRAY; 
                    RESULT : out INTEGER); 

end TBLCMP; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/template_manager.adb version [c75c00d577].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE template manager
-- AUTHOR: John Self (UCI)
-- DESCRIPTION supports output of internalized templates for the IO and DFA
--             packages.
-- NOTES This package is quite a memory hog, and is really only useful on
--       virtual memory systems.  It could use an external file to store the
--       templates like the skeleton manager.  This would save memory at the
--       cost of a slight reduction in speed and the necessity of keeping
--       copies of the template files in a known place.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/template_manager.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $

with FILE_STRING, MISC_DEFS, TEXT_IO, EXTERNAL_FILE_MANAGER, Aflex_MISC, TSTRING; use
  FILE_STRING, MISC_DEFS, TEXT_IO;
package body TEMPLATE_MANAGER is
  package MISC renames Aflex_MISC;

  type FILE_ARRAY is array(POSITIVE range <>) of VSTRING;

  DFA_TEMPLATE     : constant FILE_ARRAY := (
  --DFA TEMPLATE START
VSTR("yytext_ptr : integer; -- points to start of yytext in buffer"),
VSTR(""),
VSTR("-- yy_ch_buf has to be 2 characters longer than YY_BUF_SIZE because we need"),
VSTR("-- to put in 2 end-of-buffer characters (this is explained where it is"),
VSTR("-- done) at the end of yy_ch_buf"),
VSTR("YY_READ_BUF_SIZE : constant integer :=  8192;"),
VSTR("YY_BUF_SIZE : constant integer := YY_READ_BUF_SIZE * 2; -- size of input buffer"),
VSTR("type unbounded_character_array is array(integer range <>) of character;"),
VSTR("subtype ch_buf_type is unbounded_character_array(0..YY_BUF_SIZE + 1);"),
VSTR("yy_ch_buf : ch_buf_type;"), VSTR("yy_cp, yy_bp : integer;"),
VSTR(""),
VSTR("-- yy_hold_char holds the character lost when yytext is formed"),
VSTR("yy_hold_char : character;"),
VSTR("yy_c_buf_p : integer;   -- points to current character in buffer"),
VSTR(""),
VSTR("function YYText return string;"),
VSTR("function YYLength return integer;"),
VSTR("procedure YY_DO_BEFORE_ACTION;"),
VSTR("--These variables are needed between calls to YYLex."),
VSTR("yy_init : boolean := true; -- do we need to initialize YYLex?"),
VSTR("yy_start : integer := 0; -- current start state number"),
VSTR("subtype yy_state_type is integer;"),
VSTR("yy_last_accepting_state : yy_state_type;"),
VSTR("yy_last_accepting_cpos : integer;"),
VSTR("%%"),
VSTR("function YYText return string is"),
VSTR("    i : integer;"),
VSTR("    str_loc : integer := 1;"),
VSTR("    buffer : string(1..YY_READ_BUF_SIZE);"),
VSTR("    EMPTY_STRING : constant string := """";"),
VSTR("begin"),
VSTR("    -- find end of buffer"),
VSTR("    i := yytext_ptr;"),
VSTR("    while ( yy_ch_buf(i) /= ASCII.NUL ) loop"),
VSTR("    buffer(str_loc ) := yy_ch_buf(i);"),
VSTR("        i := i + 1;"),
VSTR("    str_loc := str_loc + 1;"),
VSTR("    end loop;"),
VSTR("--    return yy_ch_buf(yytext_ptr.. i - 1);"),
VSTR(""),
VSTR("    if (str_loc < 2) then"),
VSTR("        return EMPTY_STRING;"),
VSTR("    else"),
VSTR("      return buffer(1..str_loc-1);"),
VSTR("    end if;"),
VSTR(""),
VSTR("end;"),
VSTR(""),
VSTR("-- returns the length of the matched text"),
VSTR("function YYLength return integer is"),
VSTR("begin"), VSTR("    return yy_cp - yy_bp;"),
VSTR("end YYLength;"),
VSTR(""),
VSTR("-- done after the current pattern has been matched and before the"),
VSTR("-- corresponding action - sets up yytext"),
VSTR(""),
VSTR("procedure YY_DO_BEFORE_ACTION is"),
VSTR("begin"),
VSTR("    yytext_ptr := yy_bp;"),
VSTR("    yy_hold_char := yy_ch_buf(yy_cp);"),
VSTR("    yy_ch_buf(yy_cp) := ASCII.NUL;"),
VSTR("    yy_c_buf_p := yy_cp;"),
VSTR("end YY_DO_BEFORE_ACTION;"),
VSTR("")
--DFA TEMPLATE END
);

  DFA_CURRENT_LINE : INTEGER := 1;

  IO_TEMPLATE      : constant FILE_ARRAY := (
  --IO TEMPLATE START
VSTR("with text_io; use text_io;"),
VSTR(""),
VSTR("%%"),
VSTR("user_input_file : file_type;"),
VSTR("user_output_file : file_type;"),
VSTR("NULL_IN_INPUT : exception;"),
VSTR("AFLEX_INTERNAL_ERROR : exception;"),
VSTR("UNEXPECTED_LAST_MATCH : exception;"),
VSTR("PUSHBACK_OVERFLOW : exception;"),
VSTR("AFLEX_SCANNER_JAMMED : exception;"),
VSTR("type eob_action_type is ( EOB_ACT_RESTART_SCAN,"),
VSTR("                          EOB_ACT_END_OF_FILE,"),
VSTR("                          EOB_ACT_LAST_MATCH );"),
VSTR("YY_END_OF_BUFFER_CHAR :  constant character:=  ASCII.NUL;"),
VSTR("yy_n_chars : integer;       -- number of characters read into yy_ch_buf"),
VSTR(""),
VSTR("-- true when we've seen an EOF for the current input file"),
VSTR("yy_eof_has_been_seen : boolean;"), VSTR(""),
VSTR("-- UMASS CODES :" ),
VSTR("--   In order to support YY_Get_Token_Line, we need"),
VSTR("--   a variable to hold current line."),
VSTR("type String_Ptr is access string;"),
VSTR("Saved_Tok_Line1 : String_Ptr := Null;"),
VSTR("Line_Number_Of_Saved_Tok_Line1 : integer := 0;"),
VSTR("Saved_Tok_Line2 : String_Ptr := Null;"),
VSTR("Line_Number_Of_Saved_Tok_Line2 : integer := 0;"),
VSTR("-- Aflex will try to get next buffer before it processs the"),
VSTR("-- last token. Since now Aflex has been changed to accept"),
VSTR("-- one line by one line, the last token in the buffer is"),
VSTR("-- always end_of_line ( or end_of_buffer ). So before the"),
VSTR("-- end_of_line is processed, next line will be retrieved"),
VSTR("-- into the buffer. So we need to maintain two lines,"),
VSTR("-- which line will be returned in Get_Token_Line is"),
VSTR("-- determined according to the line number. It is the same"),
VSTR("-- reason that we can not reinitialize tok_end_col to 0 in"),
VSTR("-- Yy_Input, but we must do it in yylex after we process the"),
VSTR("-- end_of_line."),
VSTR("Tok_Begin_Line : integer := 1;"),
VSTR("Tok_End_Line : integer := 1;"),
VSTR("Tok_End_Col : integer := 0;"),
VSTR("Tok_Begin_Col : integer := 0;"),
VSTR("Token_At_End_Of_Line : Boolean := False;"),
VSTR("-- Indicates whether or not last matched token is end_of_line."),
VSTR("-- END OF UMASS CODES."),
VSTR(""),
VSTR("procedure YY_INPUT_default(buf: out unbounded_character_array; result: out integer; max_size: in integer);"),
VSTR("type YY_INPUT_Ptr is access procedure (buf: out unbounded_character_array; result: out integer; max_size: in integer);"),
VSTR("YY_INPUT : YY_INPUT_Ptr := YY_INPUT_default'Access; -- May be overridden"),
VSTR("function yy_get_next_buffer return eob_action_type;"),
VSTR("procedure yyunput( c : character; yy_bp: in out integer );"),
VSTR("procedure unput(c : character);"),
VSTR("function input return character;"),
VSTR("procedure output(c : character);"),
VSTR("function yywrap return boolean;"),
VSTR("procedure Open_Input(fname : in String);"),
VSTR("procedure Close_Input;"),
VSTR("procedure Create_Output(fname : in String := """");"),
VSTR("procedure Close_Output;"),
VSTR(""),
VSTR("-- UMASS CODES :"),
VSTR("procedure Yy_Get_Token_Line ( Yy_Line_String : out String;"),
VSTR("                              Yy_Line_Length : out Natural );"),
VSTR("-- Returnes the entire line in the input, on which the currently"),
VSTR("-- matched token resides."),
VSTR(""),
VSTR("function Yy_Line_Number return Natural;"),
VSTR("-- Returns the line number of the currently matched token."),
VSTR("-- In case a token spans lines, then the line number of the first line"),
VSTR("-- is returned."),
VSTR(""),
VSTR("function Yy_Begin_Column return Natural;"),
VSTR("function Yy_End_Column return Natural;"),
VSTR("-- Returns the beginning and ending column positions of the"),
VSTR("-- currently mathched token. If the token spans lines then the"),
VSTR("-- begin column number is the column number on the first line"),
VSTR("-- and the end columne number is the column number on the last line."),
VSTR(""),
VSTR("-- END OF UMASS CODES."),
VSTR(""),
VSTR("%%"),
VSTR("-- gets input and stuffs it into 'buf'.  number of characters read, or YY_NULL,"),
VSTR("-- is returned in 'result'."),
VSTR(""),
VSTR("procedure YY_INPUT_default(buf: out unbounded_character_array; result: out integer; max_size: in integer) is"),
VSTR("    c : character;"),
VSTR("    i : integer := 1;"),
VSTR("    loc : integer := buf'first;"),
VSTR("-- UMASS CODES :"),
VSTR("--    Since buf is an out parameter which is not readable"),
VSTR("--    and saved lines is a string pointer which space must"),
VSTR("--    be allocated after we know the size, we maintain"),
VSTR("--    an extra buffer to collect the input line and"),
VSTR("--    save it into the saved line 2."),
VSTR("   Temp_Line : String ( 1 .. YY_BUF_SIZE + 2 );"),
VSTR("-- END OF UMASS CODES."),
VSTR("begin"),
VSTR("-- UMASS CODES :"),
VSTR("    buf := ( others => ASCII.NUL );"),
VSTR("-- Move the saved lines forward."),
VSTR("    Saved_Tok_Line1 := Saved_Tok_Line2;"),
VSTR("    Line_Number_Of_Saved_Tok_Line1 := Line_Number_Of_Saved_Tok_Line2;"),
VSTR("-- END OF UMASS CODES."),
VSTR(""),
VSTR("    if (is_open(user_input_file)) then"),
VSTR("      while ( i <= max_size ) loop"),
VSTR("         if (end_of_line(user_input_file)) then -- Ada ate our newline, put it back on the end."),
VSTR("             buf(loc) := ASCII.LF;"),
VSTR("             skip_line(user_input_file, 1);"),
VSTR("-- UMASS CODES :"),
VSTR("--   We try to get one line by one line. So we return"),
VSTR("--   here because we saw the end_of_line."),
VSTR("             result := i;"),
VSTR("             Temp_Line(i) := ASCII.LF;"),
VSTR("             Saved_Tok_Line2 := new String ( 1 .. i );"),
VSTR("             Saved_Tok_Line2 ( 1 .. i ) := Temp_Line ( 1 .. i );"),
VSTR("             Line_Number_Of_Saved_Tok_Line2 := Line_Number_Of_Saved_Tok_Line1 + 1;"),
VSTR("             return;"),
VSTR("-- END OF UMASS CODES."),
VSTR("         else"),
VSTR("-- UCI CODES CHANGED:"),
VSTR("--    The following codes are modified. Previous codes is commented out."),
VSTR("--    The purpose of doing this is to make it possible to set Temp_Line"),
VSTR("--    in Ayacc-extension specific codes. Definitely, we can read the character"),
VSTR("--    into the Temp_Line and then set the buf. But Temp_Line will only"),
VSTR("--    be used in Ayacc-extension specific codes which makes this approach impossible."),
VSTR("           get(user_input_file, c);"),
VSTR("           buf(loc) := c;"),
VSTR("--         get(user_input_file, buf(loc));"),
VSTR("-- UMASS CODES :"),
VSTR("           Temp_Line(i) := c;"),
VSTR("-- END OF UMASS CODES."),
VSTR("         end if;"),
VSTR(""),
VSTR("         loc := loc + 1;"),
VSTR("         i := i + 1;"),
VSTR("      end loop;"),
VSTR("    else"),
VSTR("      while ( i <= max_size ) loop"),
VSTR("         if (end_of_line) then -- Ada ate our newline, put it back on the end."),
VSTR("             buf(loc) := ASCII.LF;"),
VSTR("             skip_line(1);"),
VSTR("-- UMASS CODES :"),
VSTR("--   We try to get one line by one line. So we return"),
VSTR("--   here because we saw the end_of_line."),
VSTR("             result := i;"),
VSTR("             Temp_Line(i) := ASCII.LF;"),
VSTR("             Saved_Tok_Line2 := new String ( 1 .. i );"),
VSTR("             Saved_Tok_Line2 ( 1 .. i ) := Temp_Line ( 1 .. i );"),
VSTR("             Line_Number_Of_Saved_Tok_Line2 := Line_Number_Of_Saved_Tok_Line1 + 1;"),
VSTR("             return;"),
VSTR("-- END OF UMASS CODES."),
VSTR("%%"),
VSTR(""),
VSTR("         else"),
VSTR("--    The following codes are modified. Previous codes is commented out."),
VSTR("--    The purpose of doing this is to make it possible to set Temp_Line"),
VSTR("--    in Ayacc-extension specific codes. Definitely, we can read the character"),
VSTR("--    into the Temp_Line and then set the buf. But Temp_Line will only"),
VSTR("--    be used in Ayacc-extension specific codes which makes this approach impossible."),
VSTR("           get(c);"),
VSTR("           buf(loc) := c;"),
VSTR("--         get(buf(loc));"),
VSTR("-- UMASS CODES :"),
VSTR("           Temp_Line(i) := c;"),
VSTR("-- END OF UMASS CODES."),
VSTR("         end if; "),
VSTR(""),
VSTR("         loc := loc + 1;"),
VSTR("         i := i + 1;"),
VSTR("      end loop;"),
VSTR("    end if; -- for input file being standard input"),
VSTR(""),
VSTR("    result := i - 1; "),
VSTR("-- UMASS CODES :"),
VSTR("--   Since we get one line by one line, if we"),
VSTR("--   reach here, it means that current line have"),
VSTR("--   more that max_size characters. So it is"),
VSTR("--   impossible to hold the whole line. We"),
VSTR("--   report the warning message and continue."),
VSTR("    buf(loc - 1) := Ascii.LF;"),
VSTR("    if (is_open(user_input_file)) then"),
VSTR("      skip_line(user_input_file, 1);"),
VSTR("    else"),
VSTR("      skip_line(1);"),
VSTR("    end if;"),
VSTR("    Temp_Line(i-1) := ASCII.LF;"),
VSTR("    Saved_Tok_Line2 := new String ( 1 .. i - 1);"),
VSTR("    Saved_Tok_Line2 ( 1 .. i - 1 ) := Temp_Line ( 1 .. i - 1 );"),
VSTR("    Line_Number_Of_Saved_Tok_Line2 := Line_Number_Of_Saved_Tok_Line1 + 1;"),
VSTR("    Put_Line ( ""Input line """),
VSTR("               & Integer'Image ( Line_Number_Of_Saved_Tok_Line2 )"),
VSTR("               & ""has more than """),
VSTR("               & Integer'Image ( max_size )"),
VSTR("               & "" characters, ... truncated."" );"),
VSTR("-- END OF UMASS CODES."),
VSTR("    exception"),
VSTR("        when END_ERROR => result := i - 1;"),
VSTR("    -- when we hit EOF we need to set yy_eof_has_been_seen"),
VSTR("    yy_eof_has_been_seen := true;"),
VSTR("-- UMASS CODES :"),
VSTR("--   Processing incomplete line."),
VSTR("        if i /= 1 then"),
VSTR("          -- Current line is not empty but do not have end_of_line."),
VSTR("          -- So current line is incomplete line. But we still need"),
VSTR("          -- to save it."),
VSTR("          Saved_Tok_Line2 := new String ( 1 .. i - 1 );"),
VSTR("          Saved_Tok_Line2 ( 1 .. i - 1 ) := Temp_Line ( 1 .. i - 1 );"),
VSTR("          Line_Number_Of_Saved_Tok_Line2 := Line_Number_Of_Saved_Tok_Line1 + 1;"),
VSTR("        end if;"),
VSTR("-- END OF UMASS CODES."),
VSTR("end YY_INPUT_default;"),
VSTR(""),
VSTR("-- yy_get_next_buffer - try to read in new buffer"),
VSTR("--"),
VSTR("-- returns a code representing an action"),
VSTR("--     EOB_ACT_LAST_MATCH - "),
VSTR("--     EOB_ACT_RESTART_SCAN - restart the scanner"),
VSTR("--     EOB_ACT_END_OF_FILE - end of file"),
VSTR(""),
VSTR("function yy_get_next_buffer return eob_action_type is"),
VSTR("    dest : integer := 0;"),
VSTR("    source : integer := yytext_ptr - 1; -- copy prev. char, too"),
VSTR("    number_to_move : integer;"),
VSTR("    ret_val : eob_action_type;"),
VSTR("    num_to_read : integer;"),
VSTR("begin    "),
VSTR("    if ( yy_c_buf_p > yy_n_chars + 1 ) then"),
VSTR("        raise NULL_IN_INPUT;"),
VSTR("    end if;"),
VSTR(""),
VSTR("    -- try to read more data"),
VSTR(""),
VSTR("    -- first move last chars to start of buffer"),
VSTR("    number_to_move := yy_c_buf_p - yytext_ptr;"),
VSTR(""),
VSTR("    for i in 0..number_to_move - 1 loop"),
VSTR("        yy_ch_buf(dest) := yy_ch_buf(source);"),
VSTR("    dest := dest + 1;"),
VSTR("    source := source + 1;"),
VSTR("    end loop;"),
VSTR("        "),
VSTR("    if ( yy_eof_has_been_seen ) then"),
VSTR("    -- don't do the read, it's not guaranteed to return an EOF,"),
VSTR("    -- just force an EOF"),
VSTR(""),
VSTR("    yy_n_chars := 0;"),
VSTR("    else"),
VSTR("    num_to_read := YY_BUF_SIZE - number_to_move - 1;"),
VSTR(""),
VSTR("    if ( num_to_read > YY_READ_BUF_SIZE ) then"),
VSTR("        num_to_read := YY_READ_BUF_SIZE;"),
VSTR("        end if;"),
VSTR(""),
VSTR("    -- read in more data"),
VSTR("    YY_INPUT( yy_ch_buf(number_to_move..yy_ch_buf'last), yy_n_chars, num_to_read );"),
VSTR("    end if;"),
VSTR("    if ( yy_n_chars = 0 ) then"),
VSTR("    if ( number_to_move = 1 ) then"),
VSTR("        ret_val := EOB_ACT_END_OF_FILE;"),
VSTR("    else"),
VSTR("        ret_val := EOB_ACT_LAST_MATCH;"),
VSTR("        end if;"),
VSTR(""),
VSTR("    yy_eof_has_been_seen := true;"),
VSTR("    else"),
VSTR("    ret_val := EOB_ACT_RESTART_SCAN;"),
VSTR("    end if;"),
VSTR("    "),
VSTR("    yy_n_chars := yy_n_chars + number_to_move;"),
VSTR("    yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;"),
VSTR("    yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;"),
VSTR(""),
VSTR("    -- yytext begins at the second character in"),
VSTR("    -- yy_ch_buf; the first character is the one which"),
VSTR("    -- preceded it before reading in the latest buffer;"),
VSTR("    -- it needs to be kept around in case it's a"),
VSTR("    -- newline, so yy_get_previous_state() will have"),
VSTR("    -- with '^' rules active"),
VSTR(""),
VSTR("    yytext_ptr := 1;"),
VSTR(""),
VSTR("    return ret_val;"),
VSTR("end yy_get_next_buffer;"),
VSTR(""),
VSTR("procedure yyunput( c : character; yy_bp: in out integer ) is"),
VSTR("    number_to_move : integer;"),
VSTR("    dest : integer;"),
VSTR("    source : integer;"),
VSTR("    tmp_yy_cp : integer;"),
VSTR("begin"),
VSTR("    tmp_yy_cp := yy_c_buf_p;"),
VSTR("    yy_ch_buf(tmp_yy_cp) := yy_hold_char; -- undo effects of setting up yytext"),
VSTR(""),
VSTR("    if ( tmp_yy_cp < 2 ) then"),
VSTR("    -- need to shift things up to make room"),
VSTR("    number_to_move := yy_n_chars + 2; -- +2 for EOB chars"),
VSTR("    dest := YY_BUF_SIZE + 2;"),
VSTR("    source := number_to_move;"),
VSTR(""),
VSTR("    while ( source > 0 ) loop"),
VSTR("        dest := dest - 1;"),
VSTR("        source := source - 1;"),
VSTR("            yy_ch_buf(dest) := yy_ch_buf(source);"),
VSTR("    end loop;"),
VSTR(""),
VSTR("    tmp_yy_cp := tmp_yy_cp + dest - source;"),
VSTR("    yy_bp := yy_bp + dest - source;"),
VSTR("    yy_n_chars := YY_BUF_SIZE;"),
VSTR(""),
VSTR("    if ( tmp_yy_cp < 2 ) then"),
VSTR("        raise PUSHBACK_OVERFLOW;"),
VSTR("    end if;"),
VSTR("    end if;"),
VSTR(""),
VSTR("    if ( tmp_yy_cp > yy_bp and then yy_ch_buf(tmp_yy_cp-1) = ASCII.LF ) then"),
VSTR("    yy_ch_buf(tmp_yy_cp-2) := ASCII.LF;"),
VSTR("    end if;"),
VSTR(""),
VSTR("    tmp_yy_cp := tmp_yy_cp - 1;"),
VSTR("    yy_ch_buf(tmp_yy_cp) := c;"),
VSTR(""),
VSTR("--  Note:  this code is the text of YY_DO_BEFORE_ACTION, only"),
VSTR("--         here we get different yy_cp and yy_bp's"),
VSTR("    yytext_ptr := yy_bp;"),
VSTR("    yy_hold_char := yy_ch_buf(tmp_yy_cp);"),
VSTR("    yy_ch_buf(tmp_yy_cp) := ASCII.NUL;"),
VSTR("    yy_c_buf_p := tmp_yy_cp;"),
VSTR("end yyunput;"),
VSTR(""),
VSTR("procedure unput(c : character) is"),
VSTR("begin"),
VSTR("     yyunput( c, yy_bp );"),
VSTR("end unput;"),
VSTR(""),
VSTR("function input return character is"),
VSTR("    c : character;"),
VSTR("    yy_cp : integer := yy_c_buf_p;"),
VSTR("begin"),
VSTR("    yy_ch_buf(yy_cp) := yy_hold_char;"),
VSTR(""),
VSTR("    if ( yy_ch_buf(yy_c_buf_p) = YY_END_OF_BUFFER_CHAR ) then"),
VSTR("    -- need more input"),
VSTR("    yytext_ptr := yy_c_buf_p;"),
VSTR("    yy_c_buf_p := yy_c_buf_p + 1;"),
VSTR(""),
VSTR("    case yy_get_next_buffer is"),
VSTR("        -- this code, unfortunately, is somewhat redundant with"),
VSTR("        -- that above"),
VSTR(""),
VSTR("        when EOB_ACT_END_OF_FILE =>"),
VSTR("        if ( yywrap ) then"),
VSTR("            yy_c_buf_p := yytext_ptr;"),
VSTR("            return ASCII.NUL;"),
VSTR("        end if;"),
VSTR(""),
VSTR("        yy_ch_buf(0) := ASCII.LF;"),
VSTR("        yy_n_chars := 1;"),
VSTR("        yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;"),
VSTR("        yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;"),
VSTR("        yy_eof_has_been_seen := false;"),
VSTR("        yy_c_buf_p := 1;"),
VSTR("        yytext_ptr := yy_c_buf_p;"),
VSTR("        yy_hold_char := yy_ch_buf(yy_c_buf_p);"),
VSTR(""),
VSTR("        return ( input );"),
VSTR("        when EOB_ACT_RESTART_SCAN =>"),
VSTR("        yy_c_buf_p := yytext_ptr;"),
VSTR(""),
VSTR("        when EOB_ACT_LAST_MATCH =>"),
VSTR("        raise UNEXPECTED_LAST_MATCH;"),
VSTR("        when others => null;"),
VSTR("        end case;"),
VSTR("    end if;"),
VSTR(""),
VSTR("    c := yy_ch_buf(yy_c_buf_p);"),
VSTR("    yy_c_buf_p := yy_c_buf_p + 1;"),
VSTR("    yy_hold_char := yy_ch_buf(yy_c_buf_p);"),
VSTR(""),
VSTR("    return c;"),
VSTR("end input;"),
VSTR(""),
VSTR("procedure output(c : character) is"),
VSTR("begin"),
VSTR("    if (is_open(user_output_file)) then"),
VSTR("      text_io.put(user_output_file, c);"),
VSTR("    else"),
VSTR("      text_io.put(c);"),
VSTR("    end if;"),
VSTR("end output;"),
VSTR(""),
VSTR("-- default yywrap function - always treat EOF as an EOF"),
VSTR("function yywrap return boolean is"),
VSTR("begin"),
VSTR("    return true;"),
VSTR("end yywrap;"),
VSTR(""),
VSTR("procedure Open_Input(fname : in String) is"),
VSTR("begin"),
VSTR("    yy_init := true;"),
VSTR("    open(user_input_file, in_file, fname);"),
VSTR("end Open_Input;"),
VSTR(""),
VSTR("procedure Create_Output(fname : in String := """") is"),
VSTR("begin"),
VSTR("    if (fname /= """") then"),
VSTR("        create(user_output_file, out_file, fname);"),
VSTR("    end if;"),
VSTR("end Create_Output;"),
VSTR(""),
VSTR("procedure Close_Input is"),
VSTR("begin"),
VSTR("   if (is_open(user_input_file)) then"),
VSTR("     text_io.close(user_input_file);"),
VSTR("   end if;"),
VSTR("end Close_Input;"),
VSTR(""),
VSTR("procedure Close_Output is"),
VSTR("begin"),
VSTR("   if (is_open(user_output_file)) then"),
VSTR("     text_io.close(user_output_file);"),
VSTR("   end if;"),
VSTR("end Close_Output;"),
VSTR(""),
VSTR("-- UMASS CODES :"),
VSTR("procedure Yy_Get_Token_Line ( Yy_Line_String : out String;"),
VSTR("                              Yy_Line_Length : out Natural ) is"),
VSTR("begin"),
VSTR("  -- Currently processing line is either in saved token line1 or"),
VSTR("  -- in saved token line2."),
VSTR("  if Yy_Line_Number = Line_Number_Of_Saved_Tok_Line1 then"),
VSTR("    Yy_Line_Length := Saved_Tok_Line1.all'length;"),
VSTR("    Yy_Line_String ( Yy_Line_String'First .. ( Yy_Line_String'First + Saved_Tok_Line1.all'length - 1 ))"),
VSTR("      := Saved_Tok_Line1 ( 1 .. Saved_Tok_Line1.all'length );"),
VSTR("  else"),
VSTR("    Yy_Line_Length := Saved_Tok_Line2.all'length;"),
VSTR("    Yy_Line_String ( Yy_Line_String'First .. ( Yy_Line_String'First + Saved_Tok_Line2.all'length - 1 ))"),
VSTR("      := Saved_Tok_Line2 ( 1 .. Saved_Tok_Line2.all'length );"),
VSTR("  end if;"),
VSTR("end Yy_Get_Token_Line;"),
VSTR(""),
VSTR("function Yy_Line_Number return Natural is"),
VSTR("begin"),
VSTR("   return Tok_Begin_Line;"),
VSTR("end Yy_Line_Number;"),
VSTR(""),
VSTR("function Yy_Begin_Column return Natural is"),
VSTR("begin"),
VSTR("   return Tok_Begin_Col;"),
VSTR("end Yy_Begin_Column;"),
VSTR(""),
VSTR("function Yy_End_Column return Natural is"),
VSTR("begin"),
VSTR("   return Tok_End_Col;"),
VSTR("end Yy_End_Column;"),
VSTR(""),
VSTR("-- END OF UMASS CODES."),
VSTR("")
--IO TEMPLATE END
);

  IO_CURRENT_LINE  : INTEGER := 1;

  procedure TEMPLATE_OUT(OUTFILE          : in FILE_TYPE;
                         CURRENT_TEMPLATE : in FILE_ARRAY;
                         LINE_NUMBER      : in out INTEGER) is
    BUF : VSTRING;
-- UMASS CODES :
    Umass_Codes : Boolean := False;
    -- Indicates whether or not current line of the template
    -- is the Umass codes.
-- END OF UMASS CODES.
  begin
    while (not (LINE_NUMBER > CURRENT_TEMPLATE'LAST)) loop
      BUF := CURRENT_TEMPLATE(LINE_NUMBER);
      LINE_NUMBER := LINE_NUMBER + 1;
      if ((FILE_STRING.LEN(BUF) >= 2) and then ((CHAR(BUF, 1) = '%') and (CHAR(
        BUF, 2) = '%'))) then
        exit;
      else
-- UMASS CODES :
--   In the template, the codes between "-- UMASS CODES : " and
--   "-- END OF UMASS CODES." are specific to be used by Ayacc-extension.
--   Ayacc-extension has more power in error recovery. So we
--   generate those codes only when Ayacc_Extension_Flag is True.
        if FILE_STRING.STR(BUF) = "-- UMASS CODES :" then
          Umass_Codes := True;
        end if;

        if not Umass_Codes or else
           Ayacc_Extension_Flag then
          FILE_STRING.PUT_LINE(OUTFILE,BUF);
        end if;

        if FILE_STRING.STR(BUF) = "-- END OF UMASS CODES." then
          Umass_Codes := False;
        end if;
-- END OF UMASS CODES.

-- UCI CODES commented out :
--   The following line is commented out because it is done in Umass codes.
--      FILE_STRING.PUT_LINE(OUTFILE,BUF);

      end if;
    end loop;
  end TEMPLATE_OUT;

  procedure GENERATE_DFA_FILE is
    DFA_OUT_FILE : FILE_TYPE;
  begin
    EXTERNAL_FILE_MANAGER.GET_DFA_FILE(DFA_OUT_FILE);
    TEXT_IO.PUT_LINE(DFA_OUT_FILE, "pragma Style_Checks (Off);");
    TEXT_IO.PUT_LINE(DFA_OUT_FILE, "package " & TSTRING.STR(MISC.BASENAME) &
      "_dfa" & " is");

    if (DDEBUG) then

      -- make a scanner that output acceptance information
      TEXT_IO.PUT_LINE(DFA_OUT_FILE, "aflex_debug : boolean := true;");
    else
      TEXT_IO.PUT_LINE(DFA_OUT_FILE, "aflex_debug : boolean := false;");
    end if;
    TEMPLATE_OUT(DFA_OUT_FILE, DFA_TEMPLATE, DFA_CURRENT_LINE);
    TEXT_IO.PUT_LINE(DFA_OUT_FILE, "end " & TSTRING.STR(MISC.BASENAME) & "_dfa;"
      );
    TEXT_IO.PUT_LINE(DFA_OUT_FILE, "pragma Style_Checks (Off);");
    TEXT_IO.NEW_LINE(DFA_OUT_FILE);
    TEXT_IO.PUT(DFA_OUT_FILE, "with " & TSTRING.STR(MISC.BASENAME) & "_dfa" &
      "; ");
    TEXT_IO.PUT_LINE(DFA_OUT_FILE, "use " & TSTRING.STR(MISC.BASENAME) & "_dfa"
      & "; ");
    TEXT_IO.PUT_LINE(DFA_OUT_FILE, "package body " & TSTRING.STR(MISC.BASENAME)
      & "_dfa" & " is");
    TEMPLATE_OUT(DFA_OUT_FILE, DFA_TEMPLATE, DFA_CURRENT_LINE);
    TEXT_IO.PUT_LINE(DFA_OUT_FILE, "end " & TSTRING.STR(MISC.BASENAME) & "_dfa;"
      );
  end GENERATE_DFA_FILE;

  procedure GENERATE_IO_FILE is
    IO_OUT_FILE : FILE_TYPE;
  begin
    EXTERNAL_FILE_MANAGER.GET_IO_FILE(IO_OUT_FILE);
    TEXT_IO.PUT_LINE(IO_OUT_FILE, "pragma Style_Checks (Off);");
    TEXT_IO.PUT(IO_OUT_FILE, "with " & TSTRING.STR(MISC.BASENAME) & "_dfa" &
      "; ");
    TEXT_IO.PUT_LINE(IO_OUT_FILE, "use " & TSTRING.STR(MISC.BASENAME) & "_dfa"
      & "; ");
    TEMPLATE_OUT(IO_OUT_FILE, IO_TEMPLATE, IO_CURRENT_LINE);
    TEXT_IO.PUT_LINE(IO_OUT_FILE, "package " & TSTRING.STR(MISC.BASENAME) &
      "_io" & " is");
    TEMPLATE_OUT(IO_OUT_FILE, IO_TEMPLATE, IO_CURRENT_LINE);
    TEXT_IO.PUT_LINE(IO_OUT_FILE, "end " & TSTRING.STR(MISC.BASENAME) & "_io;")
      ;
    TEXT_IO.PUT_LINE(IO_OUT_FILE, "pragma Style_Checks (Off);");
    TEXT_IO.NEW_LINE(IO_OUT_FILE);
    TEXT_IO.PUT_LINE(IO_OUT_FILE, "package body " & TSTRING.STR(MISC.BASENAME)
      & "_io" & " is");
    TEMPLATE_OUT(IO_OUT_FILE, IO_TEMPLATE, IO_CURRENT_LINE);
    -- If we're generating a scanner for interactive mode we need to generate
    -- a YY_INPUT that stops at the end of each line
    if INTERACTIVE then
        TEXT_IO.PUT_LINE(IO_OUT_FILE,
            "            i := i + 1; -- update counter, miss end of loop");
        TEXT_IO.PUT_LINE(IO_OUT_FILE,
            "            exit; -- in interactive mode return at end of line.");
    end if;
    TEMPLATE_OUT(IO_OUT_FILE, IO_TEMPLATE, IO_CURRENT_LINE);
    TEXT_IO.PUT_LINE(IO_OUT_FILE, "end " & TSTRING.STR(MISC.BASENAME) & "_io;")
      ;
  end GENERATE_IO_FILE;

end TEMPLATE_MANAGER;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/template_manager.ads version [2775a45566].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE template manager
-- AUTHOR: John Self (UCI)
-- DESCRIPTION supports output of internalized templates for the IO and DFA
--             packages.
-- NOTES This package is quite a memory hog, and is really only useful on
--       virtual memory systems.  It could use an external file to store the
--       templates like the skeleton manager.  This would save memory at the
--       cost of a slight reduction in speed and the necessity of keeping
--       copies of the template files in a known place.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/template_manager.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

package TEMPLATE_MANAGER is 
  procedure GENERATE_DFA_FILE; 
  procedure GENERATE_IO_FILE; 
end TEMPLATE_MANAGER; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/tstring.ads version [ce25d72f1e].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE variable length strings
-- AUTHOR: John Self (UCI)
-- DESCRIPTION these strings are used for many functions
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/tstrings.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with VSTRINGS; 
package TSTRING is 
  new VSTRINGS(1024);  -- This is MAXLINE in misc_defs
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






















































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/vstrings.adb version [e41acd2793].

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
pragma Warnings(Off);
pragma Style_Checks(Off);

-- UNIT: generic package body of VSTRINGS
--
-- FILES: vstring_body.a in publiclib
--        related file is vstring_spec.a in publiclib
--
-- PURPOSE:  An implementation of the abstract data type "variable-length
--           string."
--
-- DESCRIPTION:  This package provides a private type VSTRING.  VSTRING objects
--               are "strings" that have a length between zero and LAST, where
--               LAST is the generic parameter supplied in the package
--               instantiation.
--
--               In addition to the type VSTRING, a subtype and two constants
--               are declared.  The subtype STRINDEX is an index to a VSTRING,
--               The STRINDEX constant FIRST is an index to the first character
--               of the string, and the VSTRING constant NUL is a VSTRING of
--               length zero.  NUL is the default initial value of a VSTRING.
--
--               The following sets of functions, procedures, and operators
--               are provided as operations on the type VSTRING:
--
--               ATTRIBUTE FUNCTIONS:  LEN, MAX, STR, CHAR
--                 The attribute functions return the characteristics of
--                 a VSTRING.
--
--               COMPARISON OPERATORS: "=", "/=", "<", ">", "<=", ">="
--                 The comparison operators are the same as for the predefined
--                 type STRING.
--
--               INPUT/OUTPUT PROCEDURES: GET, GET_LINE, PUT, PUT_LINE
--                                        
--                 The input/output procedures are similar to those for the
--                 predefined type STRING, with the following exceptions:
--
--                   - GET has an optional parameter LENGTH, which indicates
--                     the number of characters to get (default is LAST).
--
--                   - GET_LINE does not have a parameter to return the length
--                     of the string (the LEN function should be used instead).
--
--               EXTRACTION FUNCTIONS: SLICE, SUBSTR, DELETE
--                 The SLICE function returns the slice of a VSTRING between
--                 two indices (equivalent to STR(X)(A .. B)).
--
--                 SUBSTR returns a substring of a VSTRING taken from a given
--                 index and extending a given length.
--
--                 The DELETE function returns the VSTRING which results from
--                 removing the slice between two indices.
--
--               EDITING FUNCTIONS: INSERT, APPEND, REPLACE
--                 The editing functions return the VSTRING which results from
--                 inserting, appending, or replacing at a given index with a
--                 VSTRING, STRING, or CHARACTER.  The index must be in the
--                 current range of the VSTRING; i.e., zero cannot be used.
--
--               CONCATENATION OPERATOR:  "&"
--                 The concatenation operator is the same as for the type
--                 STRING.  It should be used instead of APPEND when the
--                 APPEND would always be after the last character.
--
--               POSITION FUNCTIONS: INDEX, RINDEX
--                 The position functions return an index to the Nth occurrence
--                 of a VSTRING, STRING, or CHARACTER from the front or back
--                 of a VSTRING.  Zero is returned if the search is not
--                 successful.
--
--               CONVERSION FUNCTIONS AND OPERATOR: VSTR, CONVERT, "+"
--                 VSTR converts a STRING or a CHARACTER to a VSTRING.
--
--                 CONVERT is a generic function which can be instantiated to
--                 convert from any given variable-length string to another,
--                 provided the FROM type has a function equivelent to STR
--                 defined for it, and that the TO type has a function equiv-
--                 elent to VSTR defined for it.  This provides a means for
--                 converting between VSTRINGs declared in separate instant-
--                 iations of VSTRINGS.  When instantiating CONVERT for 
--                 VSTRINGs, the STR and VSTR functions are implicitly defined,
--                 provided that they have been made visible (by a use clause).
--
--                 Note:  CONVERT is NOT implicitly associated with the type 
--                 VSTRING declared in this package (since it would not be a
--                 derivable function (see RM 3.4(11))).
--
--                 Caution:  CONVERT cannot be instantiated directly with the
--                 names VSTR and STR, since the name of the subprogram being
--                 declared would hide the generic parameters with the same
--                 names (see RM 8.3(16)).  CONVERT can be instantiated with
--                 the operator "+", and any instantiation of CONVERT can
--                 subsequently be renamed VSTR or STR.
--
--                 Example:  Given two VSTRINGS instantiations X and Y:
--                   function "+" is new X.CONVERT(X.VSTRING, Y.VSTRING);
--                   function "+" is new X.CONVERT(Y.VSTRING, X.VSTRING);
--
--                   (Y.CONVERT could have been used in place of X.CONVERT)
--
--                   function VSTR(A : X.VSTRING) return Y.VSTRING renames "+";
--                   function VSTR(A : Y.VSTRING) return X.VSTRING renames "+";
--
--                 "+" is equivelent to VSTR.  It is supplied as a short-hand
--                 notation for the function.  The "+" operator cannot immed-
--                 iately follow the "&" operator; use ... & (+ ...) instead.
pragma PAGE;
 
--  DISCUSSION:
--
--	This package implements the type "variable-length string" (vstring)
--	using generics.  The alternative approaches are to use a discriminant 
--	record in which the discriminant controls the length of a STRING inside
--	the record, or a record containing an access type which points to a
--      string, which can be deallocated and reallocated when necessary.
--
--	Advantages of this package:
--	  * The other approaches force the vstring to be a limited private 
--          type.  Thus, their vstrings cannot appear on the left side of
--          the assignment operator; ie., their vstrings cannot be given
--          initial values or values by direct assignment.  This package
--          uses a private type; therefore, these things can be done.
--         
--	  * The other approach stores the vstring in a string whose length
--	    is determined dynamically.  This package uses a fixed length 
--          string.  This difference might be reflected in faster and more
--          consistent execution times (this has NOT been verified).
--
--	Disadvantages of this package:
--	  * Different instantiations must be used to declare vstrings with
--	    different maximum lengths (this may be desirable, since
--	    CONSTRAINT_ERROR will be raised if the maximum is exceeded).
--
--	  * A second declaration is required to give the type declared by
--	    the instantiation a name other than "VSTRING."
--
--	  * The storage required for a vstring is determined by the generic
--	    parameter LAST and not the actual length of its contents.  Thus,
--          each object is allocated the maximum amount of storage, regardless
--          of its actual size.
--
--  MISCELLANEOUS:
--     Constraint checking is done explicitly in the code; thus, it cannot
--     be suppressed.  On the other hand, constraint checking is not lost
--     if pragma suppress is supplied to the compilation (-S option) 
--     (The robustness of the explicit constraint checking has NOT been 
--     determined).
--
--     Compiling with the optimizer (-O option) may significantly reduce
--     the size (and possibly execution time) of the resulting executable.
--
--     Compiling an instantiation of VSTRINGS is roughly equivelent to
--     recompiling VSTRINGS.  Since this takes a significant amount of time,
--     and the instantiation does not depend on any other library units,
--     it is STRONGLY recommended that the instantiation be compiled
--     separately, and thus done only ONCE.
--
--  USAGE: with VSTRINGS;
--         package package_name is new VSTRINGS(maximum_length);
-- .......................................................................... --
pragma PAGE;
 
package body VSTRINGS is

  -- local declarations

  FILL_CHAR : constant CHARACTER := ASCII.NUL;

  procedure FORMAT(THE_STRING : in out VSTRING; OLDLEN : in STRINDEX := LAST) is
    -- fill the string with FILL_CHAR to null out old values

    begin -- FORMAT (Local Procedure)
      THE_STRING.VALUE(THE_STRING.LEN + 1 .. OLDLEN) := 
                                        (others => FILL_CHAR);
    end FORMAT;


  -- bodies of visible operations

  function LEN(FROM : VSTRING) return STRINDEX is

    begin -- LEN
      return(FROM.LEN);
    end LEN;


  function MAX(FROM : VSTRING) return STRINDEX is
    begin -- MAX
      return(LAST);
    end MAX;


  function STR(FROM : VSTRING) return STRING is
    begin -- STR
      return(FROM.VALUE(FIRST .. FROM.LEN));
    end STR;


  function CHAR(FROM : VSTRING; POSITION : STRINDEX := FIRST)
                 return CHARACTER is

    begin -- CHAR
      if POSITION not in FIRST .. FROM.LEN
        then raise CONSTRAINT_ERROR;
       end if;
      return(FROM.VALUE(POSITION));
    end CHAR;


  function "<" (LEFT: VSTRING; RIGHT: VSTRING) return BOOLEAN is
    begin -- "<"
      return(LEFT.VALUE < RIGHT.VALUE);
    end "<";


  function ">" (LEFT: VSTRING; RIGHT: VSTRING) return BOOLEAN is
    begin -- ">"
      return(LEFT.VALUE > RIGHT.VALUE);
    end ">";


  function "<=" (LEFT: VSTRING; RIGHT: VSTRING) return BOOLEAN is
    begin -- "<="
      return(LEFT.VALUE <= RIGHT.VALUE);
    end "<=";


  function ">=" (LEFT: VSTRING; RIGHT: VSTRING) return BOOLEAN is
    begin -- ">="
      return(LEFT.VALUE >= RIGHT.VALUE);
    end ">=";


  procedure PUT(FILE : in FILE_TYPE; ITEM : in VSTRING) is
    begin -- PUT
      PUT(FILE, ITEM.VALUE(FIRST .. ITEM.LEN));
    end PUT;

  procedure Put(ITEM : in VSTRING) is
    begin -- PUT
      PUT(ITEM.VALUE(FIRST .. ITEM.LEN));
    end PUT;


  procedure PUT_LINE(FILE : in FILE_TYPE; ITEM : in VSTRING) is
    begin -- PUT_LINE
      PUT_LINE(FILE, ITEM.VALUE(FIRST .. ITEM.LEN));
    end PUT_LINE;

  procedure PUT_LINE(ITEM : in VSTRING) is
    begin -- PUT_LINE
      PUT_LINE(ITEM.VALUE(FIRST .. ITEM.LEN));
    end PUT_LINE;


  procedure GET(FILE : in FILE_TYPE; ITEM : out VSTRING;
                LENGTH : in STRINDEX := LAST) is
    begin -- GET
      if LENGTH not in FIRST .. LAST
        then raise CONSTRAINT_ERROR;
       end if;

      ITEM := NUL;
      for INDEX in FIRST .. LENGTH loop
        GET(FILE, ITEM.VALUE(INDEX));
        ITEM.LEN := INDEX;
       end loop;
    end GET;

  procedure GET(ITEM : out VSTRING; LENGTH : in STRINDEX := LAST) is
    begin -- GET
      if LENGTH not in FIRST .. LAST
        then raise CONSTRAINT_ERROR;
       end if;

      ITEM := NUL;
      for INDEX in FIRST .. LENGTH loop
        GET(ITEM.VALUE(INDEX));
        ITEM.LEN := INDEX;
       end loop;
    end GET;


  procedure GET_LINE(FILE : in FILE_TYPE; ITEM : in out VSTRING) is

    OLDLEN : constant STRINDEX := ITEM.LEN;

    begin -- GET_LINE
      GET_LINE(FILE, ITEM.VALUE, ITEM.LEN);
      FORMAT(ITEM, OLDLEN);
    end GET_LINE;
       
  procedure GET_LINE(ITEM : in out VSTRING) is

    OLDLEN : constant STRINDEX := ITEM.LEN;

    begin -- GET_LINE
      GET_LINE(ITEM.VALUE, ITEM.LEN);
      FORMAT(ITEM, OLDLEN);
    end GET_LINE;


  function SLICE(FROM : VSTRING; FRONT, BACK : STRINDEX) return VSTRING is

    begin -- SLICE
      if ((FRONT not in FIRST .. FROM.LEN) or else 
         (BACK not in FIRST .. FROM.LEN)) and then FRONT <= BACK
        then raise CONSTRAINT_ERROR;
       end if;

      return(Vstr(FROM.VALUE(FRONT .. BACK)));
    end SLICE;


  function SUBSTR(FROM : VSTRING; START, LENGTH : STRINDEX) return VSTRING is

    begin -- SUBSTR
      if (START not in FIRST .. FROM.LEN) or else
         ((START + LENGTH - 1 not in FIRST .. FROM.LEN)
          and then (LENGTH > 0))
        then raise CONSTRAINT_ERROR;
       end if;

      return(Vstr(FROM.VALUE(START .. START + LENGTH -1)));
    end SUBSTR;


  function DELETE(FROM : VSTRING; FRONT, BACK : STRINDEX) return VSTRING is

    TEMP : VSTRING := FROM;

    begin -- DELETE
      if ((FRONT not in FIRST .. FROM.LEN) or else
         (BACK not in FIRST .. FROM.LEN)) and then FRONT <= BACK
        then raise CONSTRAINT_ERROR;
       end if;

      if FRONT > BACK then return(FROM); end if;
      TEMP.LEN := FROM.LEN - (BACK - FRONT) - 1;

      TEMP.VALUE(FRONT .. TEMP.LEN) := FROM.VALUE(BACK + 1 .. FROM.LEN);
      FORMAT(TEMP, FROM.LEN);
      return(TEMP);
    end DELETE;


  function INSERT(TARGET: VSTRING; ITEM: VSTRING;
                  POSITION : STRINDEX := FIRST) return VSTRING is

    TEMP : VSTRING;

    begin -- INSERT
      if POSITION not in FIRST .. TARGET.LEN
        then raise CONSTRAINT_ERROR;
       end if;

      if TARGET.LEN + ITEM.LEN > LAST
        then raise CONSTRAINT_ERROR;
        else TEMP.LEN := TARGET.LEN + ITEM.LEN;
       end if;

      TEMP.VALUE(FIRST .. POSITION - 1) := TARGET.VALUE(FIRST .. POSITION - 1);
      TEMP.VALUE(POSITION .. (POSITION + ITEM.LEN - 1)) :=
        ITEM.VALUE(FIRST .. ITEM.LEN);
      TEMP.VALUE((POSITION + ITEM.LEN) .. TEMP.LEN) :=
        TARGET.VALUE(POSITION .. TARGET.LEN);

      return(TEMP);
    end INSERT;

  function INSERT(TARGET: VSTRING; ITEM: STRING;
                  POSITION : STRINDEX := FIRST) return VSTRING is
    begin -- INSERT
      return INSERT(TARGET, VSTR(ITEM), POSITION);
    end INSERT;
  
  function INSERT(TARGET: VSTRING; ITEM: CHARACTER;
                  POSITION : STRINDEX := FIRST) return VSTRING is
    begin -- INSERT
      return INSERT(TARGET, VSTR(ITEM), POSITION);
    end INSERT;


  function APPEND(TARGET: VSTRING; ITEM: VSTRING; POSITION : STRINDEX)
                  return VSTRING is

    TEMP : VSTRING;
    POS : STRINDEX := POSITION;

    begin -- APPEND
      if POSITION not in FIRST .. TARGET.LEN
        then raise CONSTRAINT_ERROR;
       end if;

      if TARGET.LEN + ITEM.LEN > LAST
        then raise CONSTRAINT_ERROR;
        else TEMP.LEN := TARGET.LEN + ITEM.LEN;
       end if;

      TEMP.VALUE(FIRST .. POS) := TARGET.VALUE(FIRST .. POS);
      TEMP.VALUE(POS + 1 .. (POS + ITEM.LEN)) := ITEM.VALUE(FIRST .. ITEM.LEN);
      TEMP.VALUE((POS + ITEM.LEN + 1) .. TEMP.LEN) :=
        TARGET.VALUE(POS + 1 .. TARGET.LEN);

      return(TEMP);
    end APPEND;

  function APPEND(TARGET: VSTRING; ITEM: STRING; POSITION : STRINDEX)
                  return VSTRING is
    begin -- APPEND
      return APPEND(TARGET, VSTR(ITEM), POSITION);
    end APPEND;

  function APPEND(TARGET: VSTRING; ITEM: CHARACTER; POSITION : STRINDEX)
                  return VSTRING is
    begin -- APPEND
      return APPEND(TARGET, VSTR(ITEM), POSITION);
    end APPEND;


  function APPEND(TARGET: VSTRING; ITEM: VSTRING) return VSTRING is
    begin -- APPEND
      return(APPEND(TARGET, ITEM, TARGET.LEN));
    end APPEND;

  function APPEND(TARGET: VSTRING; ITEM: STRING) return VSTRING is
    begin -- APPEND
      return(APPEND(TARGET, VSTR(ITEM), TARGET.LEN));
    end APPEND;

  function APPEND(TARGET: VSTRING; ITEM: CHARACTER) return VSTRING is
    begin -- APPEND
      return(APPEND(TARGET, VSTR(ITEM), TARGET.LEN));
    end APPEND;


  function REPLACE(TARGET: VSTRING; ITEM: VSTRING;
                   POSITION : STRINDEX := FIRST) return VSTRING is

    TEMP : VSTRING;

    begin -- REPLACE
      if POSITION not in FIRST .. TARGET.LEN
        then raise CONSTRAINT_ERROR;
       end if;

      if POSITION + ITEM.LEN - 1 <= TARGET.LEN
        then TEMP.LEN := TARGET.LEN;
        elsif POSITION + ITEM.LEN - 1 > LAST
          then raise CONSTRAINT_ERROR;
          else TEMP.LEN := POSITION + ITEM.LEN - 1;
       end if;

      TEMP.VALUE(FIRST .. POSITION - 1) := TARGET.VALUE(FIRST .. POSITION - 1);
      TEMP.VALUE(POSITION .. (POSITION + ITEM.LEN - 1)) := 
        ITEM.VALUE(FIRST .. ITEM.LEN);
      TEMP.VALUE((POSITION + ITEM.LEN) .. TEMP.LEN) :=
        TARGET.VALUE((POSITION + ITEM.LEN) .. TARGET.LEN);

      return(TEMP);
    end REPLACE;

  function REPLACE(TARGET: VSTRING; ITEM: STRING;
                   POSITION : STRINDEX := FIRST) return VSTRING is
    begin -- REPLACE
      return REPLACE(TARGET, VSTR(ITEM), POSITION);
    end REPLACE;

  function REPLACE(TARGET: VSTRING; ITEM: CHARACTER;
                   POSITION : STRINDEX := FIRST) return VSTRING is
    begin -- REPLACE
      return REPLACE(TARGET, VSTR(ITEM), POSITION);
    end REPLACE;


  function "&"(LEFT:VSTRING; RIGHT : VSTRING) return VSTRING is

    TEMP : VSTRING;

    begin -- "&"
      if LEFT.LEN + RIGHT.LEN > LAST
        then raise CONSTRAINT_ERROR;
        else TEMP.LEN := LEFT.LEN + RIGHT.LEN;
       end if;

      TEMP.VALUE(FIRST .. TEMP.LEN) := LEFT.VALUE(FIRST .. LEFT.LEN) &
        RIGHT.VALUE(FIRST .. RIGHT.LEN);
      return(TEMP);
    end "&";

  function "&"(LEFT:VSTRING; RIGHT : STRING) return VSTRING is
    begin -- "&"
      return LEFT & VSTR(RIGHT);
    end "&";

  function "&"(LEFT:VSTRING; RIGHT : CHARACTER) return VSTRING is
    begin -- "&"
      return LEFT & VSTR(RIGHT);
    end "&";

  function "&"(LEFT : STRING; RIGHT : VSTRING) return VSTRING is
    begin -- "&"
      return VSTR(LEFT) & RIGHT;
    end "&";

  function "&"(LEFT : CHARACTER; RIGHT : VSTRING) return VSTRING is
    begin -- "&"
      return VSTR(LEFT) & RIGHT;
    end "&";


  Function INDEX(WHOLE : VSTRING; PART : VSTRING; OCCURRENCE : NATURAL := 1)
                 return STRINDEX is

    NOT_FOUND : constant NATURAL := 0;
    INDEX : NATURAL := FIRST;
    COUNT : NATURAL := 0;

    begin -- INDEX
      if PART = NUL then return(NOT_FOUND); -- by definition
        end if;

      while INDEX + PART.LEN - 1 <= WHOLE.LEN and then COUNT < OCCURRENCE loop
        if WHOLE.VALUE(INDEX .. PART.LEN + INDEX - 1) =
           PART.VALUE(1 .. PART.LEN)
          then COUNT := COUNT + 1;
         end if;
        INDEX := INDEX + 1;
       end loop;

      if COUNT = OCCURRENCE
        then return(INDEX - 1);
        else return(NOT_FOUND);
       end if;
    end INDEX;

  Function INDEX(WHOLE : VSTRING; PART : STRING; OCCURRENCE : NATURAL := 1)
                 return STRINDEX is

    begin -- Index
      return(Index(WHOLE, VSTR(PART), OCCURRENCE));
    end INDEX;


  Function INDEX(WHOLE : VSTRING; PART : CHARACTER; OCCURRENCE : NATURAL := 1)
                 return STRINDEX is

    begin -- Index
      return(Index(WHOLE, VSTR(PART), OCCURRENCE));
    end INDEX;


  function RINDEX(WHOLE: VSTRING; PART:VSTRING; OCCURRENCE:NATURAL := 1) 
                 return STRINDEX is

    NOT_FOUND : constant NATURAL := 0;
    INDEX : INTEGER := WHOLE.LEN - (PART.LEN -1);
    COUNT : NATURAL := 0;

    begin -- RINDEX
      if PART = NUL then return(NOT_FOUND); -- by definition
        end if;

      while INDEX >= FIRST and then COUNT < OCCURRENCE loop
        if WHOLE.VALUE(INDEX .. PART.LEN + INDEX - 1) =
           PART.VALUE(1 .. PART.LEN)
          then COUNT := COUNT + 1;
         end if;
        INDEX := INDEX - 1;
       end loop;

      if COUNT = OCCURRENCE
        then
          if COUNT > 0
            then return(INDEX + 1);
            else return(NOT_FOUND);
           end if;
        else return(NOT_FOUND);
       end if;
    end RINDEX;

  Function RINDEX(WHOLE : VSTRING; PART : STRING; OCCURRENCE : NATURAL := 1)
                 return STRINDEX is

    begin -- Rindex
      return(RINDEX(WHOLE, VSTR(PART), OCCURRENCE));
    end RINDEX;


  Function RINDEX(WHOLE : VSTRING; PART : CHARACTER; OCCURRENCE : NATURAL := 1)
                 return STRINDEX is

    begin -- Rindex
      return(RINDEX(WHOLE, VSTR(PART), OCCURRENCE));
    end RINDEX;


  function VSTR(FROM : CHARACTER) return VSTRING is
    
    TEMP : VSTRING;

    begin -- VSTR
      if LAST < 1
        then raise CONSTRAINT_ERROR;
        else TEMP.LEN := 1;
       end if;

      TEMP.VALUE(FIRST) := FROM;
      return(TEMP);
    end VSTR;


  function VSTR(FROM : STRING) return VSTRING is

    TEMP : VSTRING;

    begin -- VSTR
      if FROM'LENGTH > LAST
        then raise CONSTRAINT_ERROR;
        else TEMP.LEN := FROM'LENGTH;
       end if;

      TEMP.VALUE(FIRST .. FROM'LENGTH) := FROM;
      return(TEMP);
    end VSTR;

  Function "+" (FROM : STRING) return VSTRING is
    begin -- "+"
      return(VSTR(FROM));
    end "+";

  Function "+" (FROM : CHARACTER) return VSTRING is
    begin
     return(VSTR(FROM));
    end "+";


  function CONVERT(X : FROM) return TO is

    begin -- CONVERT
      return(VSTR(STR(X)));
    end CONVERT;   
end VSTRINGS;
-- .......................................................................... --
--
-- DISTRIBUTION AND COPYRIGHT:
--                                                           
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           
-- DISCLAIMER:
--                                                           
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/aflex/vstrings.ads version [010096e157].

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
pragma Style_Checks(Off);
-- UNIT: generic package spec of VSTRINGS
--
-- FILES: vstring_spec.a in publiclib
--        related file is vstring_body.a in publiclib
--
-- PURPOSE:  An implementation of the abstract data type "variable-length
--           string."
--
-- DESCRIPTION:  This package provides a private type VSTRING.  VSTRING objects
--               are "strings" that have a length between zero and LAST, where
--               LAST is the generic parameter supplied in the package
--               instantiation.
--
--               In addition to the type VSTRING, a subtype and two constants
--               are declared.  The subtype STRINDEX is an index to a VSTRING,
--               The STRINDEX constant FIRST is an index to the first character
--               of the string, and the VSTRING constant NUL is a VSTRING of
--               length zero.  NUL is the default initial value of a VSTRING.
--
--               The following sets of functions, procedures, and operators
--               are provided as operations on the type VSTRING:
--
--               ATTRIBUTE FUNCTIONS:  LEN, MAX, STR, CHAR
--                 The attribute functions return the characteristics of
--                 a VSTRING.
--
--               COMPARISON OPERATORS: "=", "/=", "<", ">", "<=", ">="
--                 The comparison operators are the same as for the predefined
--                 type STRING.
--
--               INPUT/OUTPUT PROCEDURES: GET, GET_LINE, PUT, PUT_LINE
--                                        
--                 The input/output procedures are similar to those for the
--                 predefined type STRING, with the following exceptions:
--
--                   - GET has an optional parameter LENGTH, which indicates
--                     the number of characters to get (default is LAST).
--
--                   - GET_LINE does not have a parameter to return the length
--                     of the string (the LEN function should be used instead).
--
--               EXTRACTION FUNCTIONS: SLICE, SUBSTR, DELETE
--                 The SLICE function returns the slice of a VSTRING between
--                 two indices (equivalent to STR(X)(A .. B)).
--
--                 SUBSTR returns a substring of a VSTRING taken from a given
--                 index and extending a given length.
--
--                 The DELETE function returns the VSTRING which results from
--                 removing the slice between two indices.
--
--               EDITING FUNCTIONS: INSERT, APPEND, REPLACE
--                 The editing functions return the VSTRING which results from
--                 inserting, appending, or replacing at a given index with a
--                 VSTRING, STRING, or CHARACTER.  The index must be in the
--                 current range of the VSTRING; i.e., zero cannot be used.
--
--               CONCATENATION OPERATOR:  "&"
--                 The concatenation operator is the same as for the type
--                 STRING.  It should be used instead of APPEND when the
--                 APPEND would always be after the last character.
--
--               POSITION FUNCTIONS: INDEX, RINDEX
--                 The position functions return an index to the Nth occurrence
--                 of a VSTRING, STRING, or CHARACTER from the front or back
--                 of a VSTRING.  Zero is returned if the search is not
--                 successful.
--
--               CONVERSION FUNCTIONS AND OPERATOR: VSTR, CONVERT, "+"
--                 VSTR converts a STRING or a CHARACTER to a VSTRING.
--
--                 CONVERT is a generic function which can be instantiated to
--                 convert from any given variable-length string to another,
--                 provided the FROM type has a function equivelent to STR
--                 defined for it, and that the TO type has a function equiv-
--                 elent to VSTR defined for it.  This provides a means for
--                 converting between VSTRINGs declared in separate instant-
--                 iations of VSTRINGS.  When instantiating CONVERT for 
--                 VSTRINGs, the STR and VSTR functions are implicitly defined,
--                 provided that they have been made visible (by a use clause).
--
--                 Note:  CONVERT is NOT implicitly associated with the type 
--                 VSTRING declared in this package (since it would not be a
--                 derivable function (see RM 3.4(11))).
--
--                 Caution:  CONVERT cannot be instantiated directly with the
--                 names VSTR and STR, since the name of the subprogram being
--                 declared would hide the generic parameters with the same
--                 names (see RM 8.3(16)).  CONVERT can be instantiated with
--                 the operator "+", and any instantiation of CONVERT can
--                 subsequently be renamed VSTR or STR.
--
--                 Example:  Given two VSTRINGS instantiations X and Y:
--                   function "+" is new X.CONVERT(X.VSTRING, Y.VSTRING);
--                   function "+" is new X.CONVERT(Y.VSTRING, X.VSTRING);
--
--                   (Y.CONVERT could have been used in place of X.CONVERT)
--
--                   function VSTR(A : X.VSTRING) return Y.VSTRING renames "+";
--                   function VSTR(A : Y.VSTRING) return X.VSTRING renames "+";
--
--                 "+" is equivelent to VSTR.  It is supplied as a short-hand
--                 notation for the function.  The "+" operator cannot immed-
--                 iately follow the "&" operator; use ... & (+ ...) instead.
pragma PAGE;
 
--  DISCUSSION:
--
--	This package implements the type "variable-length string" (vstring)
--	using generics.  The alternative approaches are to use a discriminant 
--	record in which the discriminant controls the length of a STRING inside
--	the record, or a record containing an access type which points to a
--      string, which can be deallocated and reallocated when necessary.
--
--	Advantages of this package:
--	  * The other approaches force the vstring to be a limited private 
--          type.  Thus, their vstrings cannot appear on the left side of
--          the assignment operator; ie., their vstrings cannot be given
--          initial values or values by direct assignment.  This package
--          uses a private type; therefore, these things can be done.
--         
--	  * The other approach stores the vstring in a string whose length
--	    is determined dynamically.  This package uses a fixed length 
--          string.  This difference might be reflected in faster and more
--          consistent execution times (this has NOT been verified).
--
--	Disadvantages of this package:
--	  * Different instantiations must be used to declare vstrings with
--	    different maximum lengths (this may be desirable, since
--	    CONSTRAINT_ERROR will be raised if the maximum is exceeded).
--
--	  * A second declaration is required to give the type declared by
--	    the instantiation a name other than "VSTRING."
--
--	  * The storage required for a vstring is determined by the generic
--	    parameter LAST and not the actual length of its contents.  Thus,
--          each object is allocated the maximum amount of storage, regardless
--          of its actual size.
--
--  MISCELLANEOUS:
--     Constraint checking is done explicitly in the code; thus, it cannot
--     be suppressed.  On the other hand, constraint checking is not lost
--     if pragma suppress is supplied to the compilation (-S option) 
--     (The robustness of the explicit constraint checking has NOT been 
--     determined).
--
--     Compiling with the optimizer (-O option) may significantly reduce
--     the size (and possibly execution time) of the resulting executable.
--
--     Compiling an instantiation of VSTRINGS is roughly equivelent to
--     recompiling VSTRINGS.  Since this takes a significant amount of time,
--     and the instantiation does not depend on any other library units,
--     it is STRONGLY recommended that the instantiation be compiled
--     separately, and thus done only ONCE.
--
--  USAGE: with VSTRINGS;
--         package package_name is new VSTRINGS(maximum_length);
-- .......................................................................... --
pragma PAGE;
 
with TEXT_IO; use TEXT_IO;
generic
  LAST : NATURAL;
package VSTRINGS is

  subtype STRINDEX is NATURAL;
  FIRST : constant STRINDEX := STRINDEX'FIRST + 1;
  type VSTRING is private;
  NUL : constant VSTRING;

-- Attributes of a VSTRING

  function LEN(FROM : VSTRING) return STRINDEX;
  function MAX(FROM : VSTRING) return STRINDEX;
  function STR(FROM : VSTRING) return STRING;
  function CHAR(FROM: VSTRING; POSITION : STRINDEX := FIRST)
                return CHARACTER;

-- Comparisons

  function "<" (LEFT: VSTRING; RIGHT: VSTRING) return BOOLEAN;
  function ">" (LEFT: VSTRING; RIGHT: VSTRING) return BOOLEAN;
  function "<=" (LEFT: VSTRING; RIGHT: VSTRING) return BOOLEAN;
  function ">=" (LEFT: VSTRING; RIGHT: VSTRING) return BOOLEAN;
  -- "=" and "/=" are predefined

-- Input/Output

  procedure PUT(FILE : in FILE_TYPE; ITEM : in VSTRING);
  procedure PUT(ITEM : in VSTRING);

  procedure PUT_LINE(FILE : in FILE_TYPE; ITEM : in VSTRING);
  procedure PUT_LINE(ITEM : in VSTRING);

  procedure GET(FILE : in FILE_TYPE; ITEM : out VSTRING;
                LENGTH : in STRINDEX := LAST);
  procedure GET(ITEM : out VSTRING; LENGTH : in STRINDEX := LAST);

  procedure GET_LINE(FILE : in FILE_TYPE; ITEM : in out VSTRING);
  procedure GET_LINE(ITEM : in out VSTRING);

-- Extraction

  function SLICE(FROM: VSTRING; FRONT, BACK : STRINDEX) return VSTRING;
  function SUBSTR(FROM: VSTRING; START, LENGTH: STRINDEX) return VSTRING;
  function DELETE(FROM: VSTRING; FRONT, BACK : STRINDEX) return VSTRING;

-- Editing

  function INSERT(TARGET: VSTRING; ITEM: VSTRING;
                  POSITION: STRINDEX := FIRST) return VSTRING;
  function INSERT(TARGET: VSTRING; ITEM: STRING;
                  POSITION: STRINDEX := FIRST) return VSTRING;
  function INSERT(TARGET: VSTRING; ITEM: CHARACTER;
                  POSITION: STRINDEX := FIRST) return VSTRING;

  function APPEND(TARGET: VSTRING; ITEM: VSTRING; POSITION: STRINDEX)
                  return VSTRING;
  function APPEND(TARGET: VSTRING; ITEM: STRING; POSITION: STRINDEX)
                  return VSTRING;
  function APPEND(TARGET: VSTRING; ITEM: CHARACTER; POSITION: STRINDEX)
                  return VSTRING;

  function APPEND(TARGET: VSTRING; ITEM: VSTRING) return VSTRING;
  function APPEND(TARGET: VSTRING; ITEM: STRING) return VSTRING;
  function APPEND(TARGET: VSTRING; ITEM: CHARACTER) return VSTRING;

  function REPLACE(TARGET: VSTRING; ITEM: VSTRING;
                   POSITION: STRINDEX := FIRST) return VSTRING;
  function REPLACE(TARGET: VSTRING; ITEM: STRING;
                   POSITION: STRINDEX := FIRST) return VSTRING;
  function REPLACE(TARGET: VSTRING; ITEM: CHARACTER;
                   POSITION: STRINDEX := FIRST) return VSTRING;

-- Concatenation

  function "&" (LEFT: VSTRING; RIGHT : VSTRING) return VSTRING;
  function "&" (LEFT: VSTRING; RIGHT : STRING) return VSTRING;
  function "&" (LEFT: VSTRING; RIGHT : CHARACTER) return VSTRING;
  function "&" (LEFT: STRING; RIGHT : VSTRING) return VSTRING;
  function "&" (LEFT: CHARACTER; RIGHT : VSTRING) return VSTRING;

-- Determine the position of a substring

  function INDEX(WHOLE: VSTRING; PART: VSTRING; OCCURRENCE : NATURAL := 1)
                 return STRINDEX;
  function INDEX(WHOLE : VSTRING; PART : STRING; OCCURRENCE : NATURAL := 1)
                 return STRINDEX;
  function INDEX(WHOLE : VSTRING; PART : CHARACTER; OCCURRENCE : NATURAL := 1)
                 return STRINDEX;


  function RINDEX(WHOLE: VSTRING; PART: VSTRING; OCCURRENCE : NATURAL := 1)
                 return STRINDEX;
  function RINDEX(WHOLE : VSTRING; PART : STRING; OCCURRENCE : NATURAL := 1)
                 return STRINDEX;
  function RINDEX(WHOLE : VSTRING; PART : CHARACTER; OCCURRENCE : NATURAL := 1)
                 return STRINDEX;

-- Conversion from other associated types

  function VSTR(FROM : STRING) return VSTRING;
  function VSTR(FROM : CHARACTER) return VSTRING;
  function "+" (FROM : STRING) return VSTRING;
  function "+" (FROM : CHARACTER) return VSTRING;

  generic
    type FROM is private;
    type TO is private;
    with function STR(X : FROM) return STRING is <>;
    with function VSTR(Y : STRING) return TO is <>;
   function CONVERT(X : FROM) return TO;

pragma PAGE;
 
  private
    type VSTRING is
      record 
        LEN : STRINDEX := STRINDEX'FIRST;
        VALUE : STRING(FIRST .. LAST) := (others => ASCII.NUL);
      end record;
 
    NUL : constant VSTRING := (STRINDEX'FIRST, (others => ASCII.NUL));
end VSTRINGS;
--
-- .......................................................................... --
--
-- DISTRIBUTION AND COPYRIGHT:
--                                                           
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           
-- DISCLAIMER:
--                                                           
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
















































































































































































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/ayacc/COPYRIGHT version [c128b5b4bd].

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
--************************************************************************ 
--                              ayacc
--                           version 1.1
--
--***********************************************************************
--
--                            Arcadia Project
--               Department of Information and Computer Science
--                        University of California
--                        Irvine, California 92717
--
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
--    The primary authors of ayacc were David Taback and Deepak Tolani.
--    Enhancements were made by Ronald J. Schmalz.
--    Further enhancements were made by Yidong Chen.
--
--    Send requests for ayacc information to ayacc-info@ics.uci.edu
--    Send bug reports for ayacc to ayacc-bugs@ics.uci.edu
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/ayacc/actions_file.adb version [608d01ce4a].

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
pragma Style_Checks(Off);
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/actions_file.adb,v 1.1 2011/03/02 22:15:02 stt Exp stt $ 
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/actions_file.adb,v 1.1 2011/03/02 22:15:02 stt Exp stt $ 

-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
--    The primary authors of ayacc were David Taback and Deepak Tolani.
--    Enhancements were made by Ronald J. Schmalz.
--
--    Send requests for ayacc information to ayacc-info@ics.uci.edu
--    Send bug reports for ayacc to ayacc-bugs@ics.uci.edu
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- Module       : actions_file_body.ada
-- Component of : ayacc
-- Version      : 1.2
-- Date         : 11/21/86  12:28:04
-- SCCS File    : disk21~/rschm/hasee/sccs/ayacc/sccs/sxactions_file_body.ada

-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/actions_file.adb,v 1.1 2011/03/02 22:15:02 stt Exp stt $ 
-- $Log: actions_file.adb,v $
-- Revision 1.1  2011/03/02 22:15:02  stt
-- Initial revision
--
-- Revision 1.2  1993/05/31  22:36:35  self
-- added exception handler when opening files
--
-- Revision 1.1  1993/05/31  22:13:57  self
-- Initial revision
--
--Revision 1.1  88/08/08  14:54:53  arcadia
--Initial revision
--
--Revision 1.1  88/08/08  12:04:56  arcadia
--Initial revision

--Revision 0.1  86/04/01  15:29:59  ada
-- This version fixes some minor bugs with empty grammars 
-- and $$ expansion. It also uses vads5.1b enhancements 
-- such as pragma inline. 
-- 

with Ayacc_File_Names;
use  Ayacc_File_Names;
package body Actions_File is

  SCCS_ID : constant String := "@(#) actions_file_body.ada, Version 1.2";


    
    -- The maximum length of the text that an action can expand into. 
    Maximum_Action_Length : constant Count  := 1000; 

    The_File : File_Type; 

    procedure Open(Mode: in File_Mode) is
    begin
	if Mode = Read_File then 
           Open(The_File, In_File, Get_Actions_File_Name);
        else 
           Create(The_File, Out_File, Get_Actions_File_Name); 
--RJS           Set_Line_Length(The_File, To => Maximum_Action_Length);  
        end if; 
	exception
           when Name_Error | Use_Error =>
               Put_Line("Ayacc: Error Opening """ & Get_Actions_File_Name & """.");
               raise;
    end Open;

    procedure Close is
    begin
       Close(The_File);
    end Close;

    procedure Delete is 
    begin 
        Delete(The_File); 
    end Delete; 

    procedure Read_Line(S: out String; Last: out Natural) is 
    begin
        Get_Line(The_File, S, Last);  
    end; 

    procedure Write(S: in String) is 
    begin 
        Put(The_File, S);    
    end; 

    procedure Write(C: in Character) is 
    begin 
        Put(The_File, C);    
    end; 

    procedure Writeln is 
    begin 
    	New_Line(The_File); 
    end; 
	

    function Is_End_of_File return Boolean is
    begin
	return End_of_File(The_File);
    end Is_End_of_File;

    procedure Initialize is 
    begin  
       Open(Write_File); 
    end Initialize; 

    procedure Finish is 
    begin 
       Close;          
    end Finish; 

end Actions_File;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/ayacc/actions_file.ads version [11cff1f2aa].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
--    The primary authors of ayacc were David Taback and Deepak Tolani.
--    Enhancements were made by Ronald J. Schmalz.
--
--    Send requests for ayacc information to ayacc-info@ics.uci.edu
--    Send bug reports for ayacc to ayacc-bugs@ics.uci.edu
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- Module       : actions_file.ada
-- Component of : ayacc
-- Version      : 1.2
-- Date         : 11/21/86  12:27:44
-- SCCS File    : disk21~/rschm/hasee/sccs/ayacc/sccs/sxactions_file.ada

-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/actions_file.ads,v 1.1 2011/03/02 22:15:02 stt Exp stt $ 
-- $Log: actions_file.ads,v $
-- Revision 1.1  2011/03/02 22:15:02  stt
-- Initial revision
--
-- Revision 0.1  86/04/01  15:03:51  ada
--  This version fixes some minor bugs with empty grammars 
--  and $$ expansion. It also uses vads5.1b enhancements 
--  such as pragma inline. 
-- 
-- 
-- Revision 0.0  86/02/19  18:35:43  ada
-- 
-- These files comprise the initial version of Ayacc
-- designed and implemented by David Taback and Deepak Tolani.
-- Ayacc has been compiled and tested under the Verdix Ada compiler
-- version 4.06 on a vax 11/750 running Unix 4.2BSD.
--  



with Text_IO; use  Text_IO;

package Actions_File is

   
	
    --								--
    --  Standard file access routines for the file containing   -- 
    --  the procedure user_action which associates rules to the --
    --  user executable code. 					--
    -- 								--  


    type File_Mode is (Read_File, Write_File); 

    procedure Open(Mode: in File_Mode);
    procedure Write(C: in Character); 
    procedure Write(S: in String); 
    procedure Writeln; 
    procedure Read_Line(S: out String; Last: out Natural);
    procedure Close;
    procedure Delete;

    --  Initializes and finishes the decalarations for the      --
    --  procedure user_action.                                  -- 

    procedure Initialize; 
    procedure Finish; 

    function Is_End_of_File return Boolean;

end Actions_File;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/ayacc/ayacc-initialize-get_arguments.adb version [fbcd1769ef].

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

pragma Style_Checks(Off);
with Command_Line_Interface; use Command_Line_Interface; 
with String_Pkg;             use String_Pkg;
--VAX with Vms_Lib; 

separate (Ayacc.Initialize)
procedure Get_Arguments (File           : out String_Type;
                         C_Lex          : out Switch; 
                         Debug          : out Switch;
                         Summary        : out Switch;
                         Verbose        : out Switch;
-- UMASS CODES :
                         Error_Recovery : out Switch;
-- END OF UMASS CODES.
			 Extension      : out String_Type) is 

  C_Lex_Argument   : String_Type;
  Debug_Argument   : String_Type;
  Summary_Argument : String_Type;
  Verbose_Argument : String_Type;
-- UMASS CODES :
  Error_Recovery_Argument : String_Type;
-- END OF UMASS CODES.

  Positional     : Natural := 0; 

  -- Number of positional parameters
  Total          : Natural := 0; 

  -- Total number of parameters
  Max_Parameters : constant := 7;

  Incorrect_Call : exception; 

----  function Convert_Switch is new
----    Convert (Parameter_Type => Switch,
----             Type_Name      => "Switch");

  function Convert_Switch (P: in String) return Switch is
  begin
	return Switch'Value ( P );
    exception
    when Constraint_Error =>
      ----CLI_Error ("Invalid Parameter, """ &
         ----        Value (Mixed (Parameter_Text)) &
            ----     """ is not a legal value for type " &
               ----  Value (Mixed (Type_Name)) & '.');
      raise Invalid_Parameter;
  end Convert_Switch;


  procedure Put_Help_Message is
  begin
    New_Line;
    Put_Line ("  -- Ayacc: An Ada Parser Generator.");
    New_Line; 
    Put_Line ("  type Switch is (On, Off);");
    New_Line;
    Put_Line ("  procedure Ayacc (File           : in String;"); 
    Put_Line ("                   C_Lex          : in Switch := Off;");
    Put_Line ("                   Debug          : in Switch := Off;");
    Put_Line ("                   Summary        : in Switch := On;");
    Put_Line ("                   Verbose        : in Switch := Off;"); 
-- UMASS CODES :
    Put_Line ("                   Error_Recovery : in Switch := Off;");
-- END OF UMASS CODES.
    Put_Line ("                   Extension      : in String := "".adb"");"); 
    New_Line; 
    Put_Line ("  -- File       Specifies the Ayacc Input Source File."); 
    Put_Line ("  -- C_Lex      Specifies the Generation of a 'C' Lex Interface.");
    Put_Line ("  -- Debug      Specifies the Production of Debugging Output"); 
    Put_Line ("  --              By the Generated Parser.");
    Put_Line ("  -- Summary    Specifies the Printing of Statistics About the");
    Put_Line ("  --              Generated Parser.");
    Put_Line ("  -- Verbose    Specifies the Production of a Human Readable");
    Put_Line ("  --              Report of States in the Generated Parser.");
-- UMASS CODES :
    Put_Line ("  -- Error_Recovery  Specifies the Generation of extension of");
    Put_Line ("  --                   error recovery.");
-- END OF UMASS CODES.
    Put_Line ("  -- Extension  Specifies the file extension to be used for");
    Put_Line ("                  generated Ada files.");
    New_Line;
  end Put_Help_Message; 

begin

--VAX   Vms_Lib.Set_Error; 
  Command_Line_Interface.Initialize (Tool_Name => "Ayacc"); 

  Positional := Positional_Arg_Count; 
  Total := Named_Arg_Count + Positional; 

  if Total = 0 then
    raise Incorrect_Call;
  elsif Total > Max_Parameters then 
    Put_Line ("Ayacc: Too many parameters."); 
    raise Incorrect_Call; 
  end if; 

  -- Get named values
  File             := Named_Arg_Value ("File",      "");
  C_Lex_Argument   := Named_Arg_Value ("C_Lex",     "Off");
  Debug_Argument   := Named_Arg_Value ("Debug",     "Off");
  Summary_Argument := Named_Arg_Value ("Summary",   "On");
  Verbose_Argument := Named_Arg_Value ("Verbose",   "Off");
-- UMASS CODES :
  Error_Recovery_Argument := Named_Arg_Value ("Error_Recovery",   "Off");
-- END OF UMASS CODES.
  Extension        := Named_Arg_Value ("Extension", ".adb");

  -- Get any positional associations
  if Positional >= 1 then 
    File := Positional_Arg_Value (1); 
    if Positional >= 2 then 
      C_Lex_Argument := Positional_Arg_Value (2);
      if Positional >= 3 then
        Debug_Argument := Positional_Arg_Value (3);
        if Positional >= 4 then
          Summary_Argument := Positional_Arg_Value (4);
          if Positional >= 5 then
            Verbose_Argument := Positional_Arg_Value (5);
-- UMASS CODES :
            if Positional >= 6 then
              Error_Recovery_Argument := Positional_Arg_Value (5);
-- END OF UMASS CODES.
              if Positional = Max_Parameters then
                Extension := Positional_Arg_Value (Max_Parameters); 
	      end if;
-- UMASS CODES :
            end if;
-- END OF UMASS CODES.
          end if;
        end if;
      end if;
    end if; 
  end if; 

  Command_Line_Interface.Finalize; 

  C_Lex   := Convert_Switch (Value (C_Lex_Argument));
  Debug   := Convert_Switch (Value (Debug_Argument));
  Summary := Convert_Switch (Value (Summary_Argument));
  Verbose := Convert_Switch (Value (Verbose_Argument));
-- UMASS CODES :
  Error_Recovery := Convert_Switch (Value (Error_Recovery_Argument));
-- END OF UMASS CODES.

exception

  when Incorrect_Call          | Invalid_Parameter         |
       Invalid_Parameter_Order | Missing_Positional_Arg    |
       Unreferenced_Named_Arg  | Invalid_Named_Association |
       Unbalanced_Parentheses  => 

    Put_Help_Message ; 
    raise Invalid_Command_Line ; 

end Get_Arguments; 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/ayacc/ayacc-initialize.adb version [7d7a4c2668].

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
pragma Style_Checks(Off);
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/ayacc-initialize.adb,v 1.1 2011/03/02 22:15:02 stt Exp stt $ 
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
--    The primary authors of ayacc were David Taback and Deepak Tolani.
--    Enhancements were made by Ronald J. Schmalz.
--
--    Send requests for ayacc information to ayacc-info@ics.uci.edu
--    Send bug reports for ayacc to ayacc-bugs@ics.uci.edu
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- Module       : ayacc_separates.ada
-- Component of : ayacc
-- Version      : 1.2
-- Date         : 11/21/86  12:28:51
-- SCCS File    : disk21~/rschm/hasee/sccs/ayacc/sccs/sxayacc_separates.ada

-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/ayacc-initialize.adb,v 1.1 2011/03/02 22:15:02 stt Exp stt $ 
-- $Log: ayacc-initialize.adb,v $
-- Revision 1.1  2011/03/02 22:15:02  stt
-- Initial revision
--
--Revision 1.1  88/08/08  12:07:39  arcadia
--Initial revision
--
-- Revision 0.0  86/02/19  18:36:14  ada
-- 
-- These files comprise the initial version of Ayacc
-- designed and implemented by David Taback and Deepak Tolani.
-- Ayacc has been compiled and tested under the Verdix Ada compiler
-- version 4.06 on a vax 11/750 running Unix 4.2BSD.
--  
-- Revision 0.1  88/03/16  
-- Additional argument added to allow user to specify file extension
-- to be used for generated Ada files.  -- kn


with String_Pkg;  use String_Pkg;

separate (Ayacc)
procedure Initialize is
  use Ayacc_File_Names, Options;

  Input_File, Extension, Options : String_Type := Create ("");

  type Switch is ( On , Off );

  C_Lex_Flag,
  Debug_Flag,
  Summary_Flag,
-- UMASS CODES :
  Error_Recovery_Flag,
-- END OF UMASS CODES.
  Verbose_Flag : Switch;

  Invalid_Command_Line : exception;

  procedure Get_Arguments (File           : out String_Type;
                           C_Lex          : out Switch; 
                           Debug          : out Switch;
                           Summary        : out Switch;
                           Verbose        : out Switch;
-- UMASS CODES : 
			   Error_Recovery : out Switch;
-- END OF UMASS CODES.
			   Extension      : out String_Type) is separate;
  
begin

  Get_Arguments (Input_File,
                 C_Lex_Flag,
                 Debug_Flag,
                 Summary_Flag,
                 Verbose_Flag,
-- UMASS CODES :
                 Error_Recovery_Flag,
-- END OF UMASS CODES.
		 Extension);

  New_Line;
  Put_Line ("  Ayacc (File           => """ & Value (Input_File) & """,");
  Put_Line ("         C_Lex          => " & 
                        Value (Mixed (Switch'Image(C_Lex_Flag))) & ',');
  Put_Line ("         Debug          => " & 
                        Value (Mixed (Switch'Image(Debug_Flag))) & ',');
  Put_Line ("         Summary        => " & 
                        Value (Mixed (Switch'Image(Summary_Flag))) & ',');
  Put_Line ("         Verbose        => " & 
                        Value (Mixed (Switch'Image(Verbose_Flag))) & ",");
-- UMASS CODES :
  Put_Line ("         Error_Recovery => " &
                        Value (Mixed (Switch'Image(Error_Recovery_Flag))) & ",");
-- END OF UMASS CODES.
  Put_Line ("         Extension      => """ & Value (Extension) & """);");
  New_Line;

  if C_Lex_Flag = On then
    Options := Options & Create ("i");
  end if;

  if Debug_Flag = On then
    Options := Options & Create ("d");
  end if;

  if Summary_Flag = On then
    Options := Options & Create ("s");
  end if;

  if Verbose_Flag = On then
    Options := Options & Create ("v");
  end if;

-- UMASS CODES :
  if Error_Recovery_Flag = On then
    Options := Options & Create ("e");
  end if;
-- END OF UMASS CODES.

  Set_File_Names (Value (Input_File), Value(Extension));
  Set_Options    (Value (Options));

exception
  when Invalid_Command_Line =>
    raise Illegal_Argument_List;
end Initialize;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/ayacc/ayacc-print_statistics.adb version [59a7384885].

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
pragma Style_Checks(Off);
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/ayacc-print_statistics.adb,v 1.1 2011/03/02 22:15:02 stt Exp stt $ 
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
--    The primary authors of ayacc were David Taback and Deepak Tolani.
--    Enhancements were made by Ronald J. Schmalz.
--
--    Send requests for ayacc information to ayacc-info@ics.uci.edu
--    Send bug reports for ayacc to ayacc-bugs@ics.uci.edu
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- Module       : ayacc_separates.ada
-- Component of : ayacc
-- Version      : 1.2
-- Date         : 11/21/86  12:28:51
-- SCCS File    : disk21~/rschm/hasee/sccs/ayacc/sccs/sxayacc_separates.ada

-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/ayacc-print_statistics.adb,v 1.1 2011/03/02 22:15:02 stt Exp stt $ 
-- $Log: ayacc-print_statistics.adb,v $
-- Revision 1.1  2011/03/02 22:15:02  stt
-- Initial revision
--
--Revision 1.1  88/08/08  12:07:39  arcadia
--Initial revision
--
-- Revision 0.0  86/02/19  18:36:14  ada
-- 
-- These files comprise the initial version of Ayacc
-- designed and implemented by David Taback and Deepak Tolani.
-- Ayacc has been compiled and tested under the Verdix Ada compiler
-- version 4.06 on a vax 11/750 running Unix 4.2BSD.
--  

separate (Ayacc)
procedure Print_Statistics is
    use Text_IO, Parse_Table, Rule_Table, Symbol_Table;
begin

    if Options.Summary then

	Put_Line(Rule'Image(Last_Rule - First_Rule + 1) & " Productions");

	Put_Line(Grammar_Symbol'Image
	  (Last_Symbol(Nonterminal) - First_Symbol(Nonterminal) + 1) &
	   " Nonterminals");

	Put_Line(Grammar_Symbol'Image
	  (Last_Symbol(Terminal) - First_Symbol(Terminal) + 1) &
	   " Terminals");

	Put_Line(Integer'Image(Number_of_States) & " States");

	Put_Line (Integer'Image(Shift_Reduce_Conflicts) &
		  " Shift/Reduce conflicts");

	Put_Line (Integer'Image(Reduce_Reduce_Conflicts) &
		  " Reduce/Reduce conflicts");

    else

	if Shift_Reduce_Conflicts /= 0 then
	    Put_Line (Integer'Image(Shift_Reduce_Conflicts) &
		      " Shift/Reduce Conflicts");
	end if;
	if Reduce_Reduce_Conflicts /= 0 then
	    Put_Line (Integer'Image(Reduce_Reduce_Conflicts) &
		      " Reduce/Reduce Conflicts");
	end if;

    end if;

end Print_Statistics;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/ayacc/ayacc.adb version [04fd21a94a].

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
pragma Style_Checks(Off);
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/ayacc.adb,v 1.1 2011/03/02 22:15:02 stt Exp stt $ 
--************************************************************************ 
--                              ayacc
--                           version 1.1
--
--***********************************************************************
--
--                            Arcadia Project
--               Department of Information and Computer Science
--                        University of California
--                        Irvine, California 92717
--
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
--    The primary authors of ayacc were David Taback and Deepak Tolani.
--    Enhancements were made by Ronald J. Schmalz.
--    Further enhancements were made by Yidong Chen.
--
--    Send requests for ayacc information to ayacc-info@ics.uci.edu
--    Send bug reports for ayacc to ayacc-bugs@ics.uci.edu
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- Module       : ayacc.ada
-- Component of : ayacc
-- Version      : 1.2
-- Date         : 11/21/86  12:28:24
-- SCCS File    : disk21~/rschm/hasee/sccs/ayacc/sccs/sxayacc.ada

-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/ayacc.adb,v 1.1 2011/03/02 22:15:02 stt Exp stt $ 
-- $Log: ayacc.adb,v $
-- Revision 1.1  2011/03/02 22:15:02  stt
-- Initial revision
--
--Revision 1.1  88/08/08  12:07:07  arcadia
--Initial revision
--
-- Revision 0.1  86/04/01  15:04:07  ada
--  This version fixes some minor bugs with empty grammars 
--  and $$ expansion. It also uses vads5.1b enhancements 
--  such as pragma inline. 
-- 
-- 
-- Revision 0.0  86/02/19  19:00:49  ada
-- 
-- These files comprise the initial version of Ayacc
-- designed and implemented by David Taback and Deepak Tolani.
-- Ayacc has been compiled and tested under the Verdix Ada compiler
-- version 4.06 on a vax 11/750 running Unix 4.2BSD.
--  

with Source_File,
     Ayacc_File_Names,
     Options,
     Parser,
     Tokens_File,
     Output_File,
     Parse_Table,
     Text_IO,
--     u_env,	  -- For getting the command line arguments

     Symbol_Table, -- Used for statistics only
     Rule_Table;   -- Used for statistics only

-- UMASS CODES :
with Error_Report_File;
-- END OF UMASS CODES.

procedure Ayacc is

    Rcs_ID : constant String := "$Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/ayacc.adb,v 1.1 2011/03/02 22:15:02 stt Exp stt $";

    copyright : constant string :=
    "@(#) Copyright (c) 1990 Regents of the University of California.";
    copyright2 : constant string :=
    "All rights reserved.";
    Illegal_Argument_List : exception;

    use Text_IO;
    procedure Initialize       is separate;
    procedure Print_Statistics is separate;

begin

    Initialize;

    Source_File.Open;
    Tokens_File.Open;

    Parser.Parse_Declarations;
    Parser.Parse_Rules;
    Parse_Table.Make_Parse_Table;
    Output_File.Make_Output_File;
    Tokens_File.Complete_Tokens_Package;

-- UMASS CODES :
--  Generate the error report file if the codes
--  of error recovery extension should be generated.
    if Options.Error_Recovery_Extension then
      Error_Report_File.Write_File;
    end if;
-- END OF UMASS CODES.

    Source_File.Close;
    Tokens_File.Close;

    if Options.Interface_to_C then
	Tokens_File.Make_C_Lex_Package;
    end if;

    Print_Statistics;

exception


    when Ayacc_File_Names.Illegal_File_Name =>
	Put_Line("Ayacc: Illegal Filename.");

    when Options.Illegal_Option | Illegal_Argument_List =>
        null;

    when Parser.Syntax_Error =>   -- Error has already been reported.
	Source_File.Close;

    when Text_IO.Name_Error | Text_IO.Use_Error =>
        null;  -- Error has already been reported.

    when others =>
        Put_Line ("Ayacc: Internal Error, Please Submit an LCR.");
end Ayacc;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/ayacc/ayacc_file_names.adb version [48401a28e4].

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
pragma Style_Checks(Off);
with STR_Pack;
use  STR_Pack;

with String_Pkg;
package body Ayacc_File_Names is

  SCCS_ID : constant String := "@(#) file_names.ada, Version 1.2";



  Rcs_ID : constant String := "$Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/ayacc_file_names.adb,v 1.1 2011/03/02 22:15:02 stt Exp stt $";

    Max_Name_Length : constant := 50;

    Source_File_Name       : STR(Max_Name_Length);
    Out_File_Name          : STR(Max_Name_Length);
    Verbose_File_Name      : STR(Max_Name_Length);
    Template_File_Name     : STR(Max_Name_Length);
    Actions_File_Name      : STR(Max_Name_Length);
    Shift_Reduce_File_Name : STR(Max_Name_Length);
    Goto_File_Name         : STR(Max_Name_Length);
    Tokens_File_Name       : STR(Max_Name_Length);
-- UMASS CODES :
    Error_Report_File_Name : STR(Max_Name_Length);
    Listing_File_Name      : STR(Max_Name_Length);
-- END OF UMASS CODES.
    C_Lex_File_Name        : STR(Max_Name_Length);
    Include_File_Name      : STR(Max_Name_Length);
 

--RJS ==========================================

  function End_of_Unit_Name (Name : in String) return Natural is
    Dot_Position : Natural := Name'Last;
  begin
    while Dot_Position >= Name'First and then
          Name (Dot_Position) /= '.'
    loop
      Dot_Position := Dot_Position - 1;
    end loop;
    return Dot_Position - 1;
  end End_of_Unit_Name;


  function Get_Unit_Name (Filename : in String) return String is

  -- modified to check for valid Ada identifiers. 11/28/88 kn

    Filename_Without_Extension : constant String :=
      Filename (Filename'First .. End_of_Unit_Name (Filename));

    End_of_Directory : Natural := Filename_Without_Extension'Last + 1;


    function Is_Alphabetic (Ch : in Character) return Boolean is
    begin
      return Ch in 'A' .. 'Z' or else
             Ch in 'a' .. 'z';
    end Is_Alphabetic;

    function Is_AlphaNum_or_Underscore (Ch : in Character) return Boolean is
    begin
      return Is_Alphabetic(Ch) or else
             Ch in '0' .. '9'  or else
             Ch = '_';
    end Is_AlphaNum_or_Underscore;

  use String_Pkg;

  begin
    -- find end of directory
    for Pos in reverse Filename_Without_Extension'FIRST..
		       Filename_Without_Extension'LAST loop
      exit when Filename_Without_Extension(Pos) = '/';
      End_Of_Directory := Pos;
    end loop;

    if End_Of_Directory <= Filename_Without_Extension'LAST and then
       Is_Alphabetic (Filename_Without_Extension (End_of_Directory)) then

       Check_Remaining_Characters :
       for i in End_Of_Directory + 1 .. Filename_Without_Extension'LAST 
       loop
	 if not Is_AlphaNum_or_Underscore (Filename_Without_Extension(i)) then
	   return "";
	 end if;
       end loop Check_Remaining_Characters;

       return Value (Mixed (Filename_Without_Extension (End_of_Directory ..
                            Filename_Without_Extension'Last)));
    else
      return "";
    end if;

  end Get_Unit_Name;


  function C_Lex_Unit_Name return String is
    Filename : constant String := Value_of (Upper_Case (C_Lex_File_Name));
  begin
    return Get_Unit_Name (Filename);
  end C_Lex_Unit_Name;


  function Goto_Tables_Unit_Name return String is
    Filename : constant String := Value_of (Upper_Case (Goto_File_Name));
  begin
    return Get_Unit_Name (Filename);
  end Goto_Tables_Unit_Name;


  function Shift_Reduce_Tables_Unit_Name return String is
    Filename : constant String := Value_of (Upper_Case (Shift_Reduce_File_Name));
  begin
    return Get_Unit_Name (Filename);
  end Shift_Reduce_Tables_Unit_Name;


  function Tokens_Unit_Name return String is
    Filename : constant String := Value_of (Upper_Case (Tokens_File_Name));
  begin
    return Get_Unit_Name (Filename);
  end Tokens_Unit_Name;

-- UMASS CODES :
  function Error_Report_Unit_Name return String is
    Filename : constant String := Value_of (Upper_Case (Error_Report_File_Name));
  begin
    return Get_Unit_Name (Filename);
  end Error_Report_Unit_Name;
-- END OF UMASS CODES.

--RJS ==========================================


    function  Get_Source_File_Name return String is
    begin
	return Value_of(Source_File_Name);
    end;

    function  Get_Out_File_Name return String is
    begin
	return Value_of(Out_File_Name);
    end;

    function  Get_Verbose_File_Name return String is
    begin
	return Value_of(Verbose_File_Name);
    end;

    function  Get_Template_File_Name return String is
    begin
	return Value_of(Template_File_Name);
    end;

    function  Get_Actions_File_Name return String is
    begin
	return Value_of(Actions_File_Name);
    end;

    function  Get_Shift_Reduce_File_Name return String is
    begin
	return Value_of(Shift_Reduce_File_Name);
    end;

    function  Get_Goto_File_Name return String is
    begin
	return Value_of(Goto_File_Name);
    end;

    function  Get_Tokens_File_Name return String is
    begin
	return Value_of(Tokens_File_Name);
    end;

-- UMASS CODES :
    function  Get_Error_Report_File_Name return String is
    begin
	return Value_of(Error_Report_File_Name);
    end;

    function  Get_Listing_File_Name return String is
    begin
	return Value_of(Listing_File_Name);
    end;
-- END OF UMASS CODES.

    function Get_C_Lex_File_Name return String is
    begin
	return Value_of(C_Lex_File_Name);
    end;

    function Get_Include_File_Name return String is
    begin
	return Value_of(Include_File_Name);
    end;



    procedure Set_File_Names(Input_File, Extension: in String) is
	Base: STR(Max_Name_Length);
    begin

	if Input_File'Length < 3 or else
	   (Input_File(Input_File'Last) /= 'y' and then
	    Input_File(Input_File'Last) /= 'Y') or else
	   Input_File(Input_File'Last - 1) /= '.'
	then
	    raise Illegal_File_Name;
	end if;

	Assign(Input_File(Input_File'First..Input_File'Last-2), To => Base);

	Assign(Input_File, To => Source_File_Name);

	Assign(Base, To => Out_File_Name);
	Append(Extension, To => Out_File_Name);

	Assign(Base,       To => Verbose_File_Name);
        Append(".verbose", To => Verbose_File_Name); 

	Assign(Base,        To => Tokens_File_Name);
        Append("_tokens.ads", To => Tokens_File_Name); 

-- UMASS CODES :
	Assign(Base,        To => Error_Report_File_Name);
        Append("_error_report" & Extension, To => Error_Report_File_Name); 

	Assign(Base,        To => Listing_File_Name);
        Append(".lis", To => Listing_File_Name); 
-- END OF UMASS CODES.

	Assign("yyparse.template", To => Template_File_Name);

	Assign(Base,    To => Actions_File_Name);
	Append(".accs", To => Actions_File_Name);

	Assign(Base,              To => Shift_Reduce_File_Name);
	Append("_shift_reduce.ads", To => Shift_Reduce_File_Name);

	Assign(Base,      To => Goto_File_Name);
	Append("_goto.ads", To => Goto_File_Name);

	Assign(Base,       To => C_Lex_File_Name);
	Append("_c_lex" & Extension, To => C_Lex_File_Name);

	Assign(Base, To => Include_File_Name);
	Append(".h", To => Include_File_Name);

    end Set_File_Names;

end Ayacc_File_Names;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


























































































































































































































































































































































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/ayacc/ayacc_file_names.ads version [c033e945a0].

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
pragma Style_Checks(Off);
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/ayacc_file_names.ads,v 1.1 2011/03/02 22:15:02 stt Exp stt $ 

-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
--    The primary authors of ayacc were David Taback and Deepak Tolani.
--    Enhancements were made by Ronald J. Schmalz.
--
--    Send requests for ayacc information to ayacc-info@ics.uci.edu
--    Send bug reports for ayacc to ayacc-bugs@ics.uci.edu
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- Module       : file_names.ada
-- Component of : ayacc
-- Version      : 1.2
-- Date         : 11/21/86  12:29:16
-- SCCS File    : disk21~/rschm/hasee/sccs/ayacc/sccs/sxfile_names.ada

-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/ayacc/RCS/ayacc_file_names.ads,v 1.1 2011/03/02 22:15:02 stt Exp stt $ 
-- $Log: ayacc_file_names.ads,v $
-- Revision 1.1  2011/03/02 22:15:02  stt
-- Initial revision
--
--Revision 1.2  88/11/28  13:38:59  arcadia
--Modified Get_Unit_Name function to accept legal Ada identifiers.
--
--Revision 1.1  88/08/08  12:11:56  arcadia
--Initial revision
--

-- Revision 0,2  88/03/16  
-- Set file names modified to include a file extension parameter.

-- Revision 0.1  86/04/01  15:04:19  ada
--  This version fixes some minor bugs with empty grammars 
--  and $$ expansion. It also uses vads5.1b enhancements 
--  such as pragma inline. 
-- 
-- 
-- Revision 0.0  86/02/19  18:36:22  ada
-- 
-- These files comprise the initial version of Ayacc
-- designed and implemented by David Taback and Deepak Tolani.
-- Ayacc has been compiled and tested under the Verdix Ada compiler
-- version 4.06 on a vax 11/750 running Unix 4.2BSD.
--  

    -- The collection of all file names used by Ayacc -- 

package Ayacc_File_Names is

    procedure Set_File_Names(Input_File, Extension: in String);
    -- Sets the initial value of the file names
    -- according to the INPUT_FILE.

    function  Get_Source_File_Name        return String;
    function  Get_Out_File_Name           return String;
    function  Get_Verbose_File_Name       return String;
    function  Get_Template_File_Name      return String;
    function  Get_Actions_File_Name       return String;
    function  Get_Shift_Reduce_File_Name  return String;
    function  Get_Goto_File_Name          return String;
    function  Get_Tokens_File_Name        return String;
-- UMASS CODES :
    function  Get_Error_Report_File_Name  return String;
    function  Get_Listing_File_Name       return String;
-- END OF UMASS CODES.
    function  Get_C_Lex_File_Name	  return String;
    function  Get_Include_File_Name	  return String;


--RJS ==========================================

  function C_Lex_Unit_Name               return String;
  function Goto_Tables_Unit_Name         return String;
  function Shift_Reduce_Tables_Unit_Name return String;
  function Tokens_Unit_Name              return String;
-- UMASS CODES :
  function Error_Report_Unit_Name        return String;
-- END OF UMASS CODES.
--RJS ==========================================


    Illegal_File_Name: exception;
    -- Raised if the file name does not end with ".y"

end Ayacc_File_Names;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






































































































































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/ayacc/command_line_interface-read_command_line.adb version [c9dfc4ff19].

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
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
--    The primary authors of ayacc were David Taback and Deepak Tolani.
--    Enhancements were made by Ronald J. Schmalz.
--
--    Send requests for ayacc information to ayacc-info@ics.uci.edu
--    Send bug reports for ayacc to ayacc-bugs@ics.uci.edu
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

--|
--| Notes: This routine contains the machine specific details of how
--|        Ayacc obtains the command line arguments from the host Operating
--|        System.  This version assumes GNAT.
--|
--|        The only requirement on this subunit is that it place the string
--|        of characters typed by the user on the command line into the
--|        parameter "Command_Args".
--|

with Ada.Command_Line; use Ada.Command_Line;
with Ada.Strings.Bounded; use Ada.Strings.Bounded;
separate (Command_Line_Interface)
procedure Read_Command_Line (Command_Args : out Command_Line_Type) is
  package cli_strings is new Generic_Bounded_Length(Maximum_Command_Length);
  use cli_strings;

  tmp_command_args : Bounded_String;
begin
  tmp_command_args := To_Bounded_String("");
  for i in 1 .. Ada.Command_Line.Argument_Count
  loop
    tmp_command_args := append(tmp_command_args, Argument(i));
    if ( i < Ada.Command_Line.Argument_Count) then
      tmp_command_args := append(tmp_command_args, " ");
    end if;
  end loop;
  Command_Args(1..length(tmp_command_args)) := To_String(tmp_command_args);
  command_args(length(tmp_command_args) + 1 .. Maximum_Command_Length) :=
      (others => ' ');
end Read_Command_Line;
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































































Deleted work_in_progress/ParaSail_compiler_fork/ParaSail_v_7_0_console_version/aflex_ayacc/ayacc/command_line_interface.adb version [c7b209c54a].

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