This repository was archived by the owner on Dec 23, 2025. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathcomp2.p
More file actions
4013 lines (4013 loc) · 357 KB
/
comp2.p
File metadata and controls
4013 lines (4013 loc) · 357 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
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
PASCP 2
(*$C+,T-,D-,L-*) BOOT 2
(********************************************** P 2
* * P 3
* * P 4
* PORTABLE PASCAL COMPILER * P 5
* ************************ * P 6
* * P 7
* PASCAL P4 * P 8
* * P 9
* * P 10
* AUTHORS: * P 11
* URS AMMANN * P 12
* KESAV NORI * P 13
* CHRISTIAN JACOBI * P 14
* * P 15
* ADDRESS: * P 16
* * P 17
* INSTITUT FUER INFORMATIK * P 18
* EIDG. TECHNISCHE HOCHSCHULE * P 19
* CH-8096 ZUERICH * P 20
* * P 21
* * P 22
* LAST CHANGES COMPLETED IN MAY 76 * P 23
* * P 24
* * P 25
**********************************************) P 26
PASCP 44
PASCP 45
PROGRAM PASCALCOMPILER(INPUT,OUTPUT,PRR); PASCP 46
PASCP 47
PASCP 48
PASCP 49
CONST DISPLIMIT = 20; MAXLEVEL = 10; X 1
INTSIZE = 1; INSTAL 1
INTAL = 1; INSTAL 2
REALSIZE = 2; INSTAL 3
REALAL = 1; INSTAL 4
CHARSIZE = 1; INSTAL 5
CHARAL = 1; INSTAL 6
CHARMAX = 1; INSTAL 7
BOOLSIZE = 1; INSTAL 8
BOOLAL = 1; INSTAL 9
PTRSIZE = 2; INSTAL 10
ADRAL = 1; INSTAL 11
SETSIZE = 4; INSTAL 12
SETAL = 1; INSTAL 13
STACKELSIZE = 1; INSTAL 14
STACKAL = 1; INSTAL 15
STRGLGTH = 24; INSTAL 16
SETHIGH = 63; SETLOW = 0; INSTAL 17
ORDMAXCHAR = 127; ORDMINCHAR = 0; INSTAL 18
LCAFTERMARKSTACK = 10; INSTAL 19
MAXINT = 32767; INSTAL 20
FILEAL = CHARAL; P 42
(* STACKELSIZE = MINIMUM SIZE FOR 1 STACKELEMENT P 44
= K*STACKAL P 45
STACKAL = SCM(ALL OTHER AL-CONSTANTS) P 46
CHARMAX = SCM(CHARSIZE,CHARAL) P 47
SCM = SMALLEST COMMON MULTIPLE P 48
LCAFTERMARKSTACK >= 4*PTRSIZE+MAX(X-SIZE) P 49
= K1*STACKELSIZE *) P 50
MAXSTACK = 1; P 51
PARMAL = STACKAL; P 54
PARMSIZE = STACKELSIZE; P 55
RECAL = STACKAL; P 56
FILEBUFFER = 4; PASCP 56
MAXADDR = MAXINT; X 2
PASCP 57
PASCP 58
PASCP 59
TYPE (*DESCRIBING:*) PASCP 60
(*************) PASCP 61
PASCP 62
PASCP 63
(*BASIC SYMBOLS*) PASCP 64
(***************) PASCP 65
PASCP 66
SYMBOL = (IDENT,INTCONST,REALCONST,STRINGCONST,NOTSY,MULOP,ADDOP,RELOP, PASCP 67
LPARENT,RPARENT,LBRACK,RBRACK,COMMA,SEMICOLON,PERIOD,ARROW, PASCP 68
COLON,BECOMES,LABELSY,CONSTSY,TYPESY,VARSY,FUNCSY,PROGSY, PASCP 69
PROCSY,SETSY,PACKEDSY,ARRAYSY,RECORDSY,FILESY,FORWARDSY, PASCP 70
BEGINSY,IFSY,CASESY,REPEATSY,WHILESY,FORSY,WITHSY, PASCP 71
GOTOSY,ENDSY,ELSESY,UNTILSY,OFSY,DOSY,TOSY,DOWNTOSY, PASCP 72
THENSY,OTHERSY); PASCP 73
OPERATOR = (MUL,RDIV,ANDOP,IDIV,IMOD,PLUS,MINUS,OROP,LTOP,LEOP,GEOP,GTOP, PASCP 74
NEOP,EQOP,INOP,NOOP); PASCP 75
SETOFSYS = SET OF SYMBOL; PASCP 76
CHTP = (LETTER,NUMBER,SPECIAL,ILLEGAL,CHSTRQUO,CHCOLON,CHPERIOD,CHLT, INDEP 1
CHGT,CHLPAREN,CHSPACE); INDEP 2
PASCP 77
(*CONSTANTS*) PASCP 78
(***********) PASCP 79
PASCP 80
CSTCLASS = (REEL,PSET,STRG); PASCP 81
CSP = ' CONSTANT; PASCP 82
CONSTANT = RECORD CASE CCLASS: CSTCLASS OF PASCP 83
REEL: (RVAL: PACKED ARRAY [1..STRGLGTH] OF CHAR); PASCP 84
PSET: (PVAL: SET OF SETLOW..SETHIGH); PASCP 85
STRG: (SLGTH: 0..STRGLGTH; PASCP 86
SVAL: PACKED ARRAY [1..STRGLGTH] OF CHAR) PASCP 87
END; PASCP 88
PASCP 89
VALU = RECORD CASE INTVAL: BOOLEAN OF (*INTVAL NEVER SET NORE TESTED*) PASCP 90
TRUE: (IVAL: INTEGER); PASCP 91
FALSE: (VALP: CSP) PASCP 92
END; PASCP 93
PASCP 94
(*DATA STRUCTURES*) PASCP 95
(*****************) PASCP 96
LEVRANGE = 0..MAXLEVEL; ADDRRANGE = 0..MAXADDR; PASCP 97
STRUCTFORM = (SCALAR,SUBRANGE,POINTER,POWER,ARRAYS,RECORDS,FILES, PASCP 98
TAGFLD,VARIANT); PASCP 99
DECLKIND = (STANDARD,DECLARED); PASCP 100
STP = ' STRUCTURE; CTP = ' IDENTIFIER; PASCP 101
PASCP 102
STRUCTURE = PACKED RECORD PASCP 103
MARKED: BOOLEAN; (*FOR TEST PHASE ONLY*) PASCP 104
SIZE: ADDRRANGE; PASCP 105
CASE FORM: STRUCTFORM OF PASCP 106
SCALAR: (CASE SCALKIND: DECLKIND OF PASCP 107
DECLARED: (FCONST: CTP)); PASCP 108
SUBRANGE: (RANGETYPE: STP; MIN,MAX: VALU); PASCP 109
POINTER: (ELTYPE: STP); PASCP 110
POWER: (ELSET: STP); PASCP 111
ARRAYS: (AELTYPE,INXTYPE: STP); PASCP 112
RECORDS: (FSTFLD: CTP; RECVAR: STP); PASCP 113
FILES: (FILTYPE: STP); PASCP 114
TAGFLD: (TAGFIELDP: CTP; FSTVAR: STP); PASCP 115
VARIANT: (NXTVAR,SUBVAR: STP; VARVAL: VALU) PASCP 116
END; PASCP 117
PASCP 118
(*NAMES*) PASCP 119
(*******) PASCP 120
PASCP 121
IDCLASS = (TYPES,KONST,VARS,FIELD,PROC,FUNC); PASCP 122
SETOFIDS = SET OF IDCLASS; PASCP 123
IDKIND = (ACTUAL,FORMAL); PASCP 124
ALPHA = PACKED ARRAY [1..8] OF CHAR; PASCP 125
PASCP 126
IDENTIFIER = PACKED RECORD PASCP 127
NAME: ALPHA; LLINK, RLINK: CTP; PASCP 128
IDTYPE: STP; NEXT: CTP; PASCP 129
CASE KLASS: IDCLASS OF PASCP 130
KONST: (VALUES: VALU); PASCP 131
VARS: (VKIND: IDKIND; VLEV: LEVRANGE; VADDR: ADDRRANGE); PASCP 132
FIELD: (FLDADDR: ADDRRANGE); PASCP 133
PROC, PASCP 134
FUNC: (CASE PFDECKIND: DECLKIND OF PASCP 135
STANDARD: (KEY: 1..15); PASCP 136
DECLARED: (PFLEV: LEVRANGE; PFNAME: INTEGER; PASCP 137
CASE PFKIND: IDKIND OF PASCP 138
ACTUAL: (FORWDECL, EXTERN: PASCP 139
BOOLEAN))) PASCP 140
END; PASCP 141
PASCP 142
PASCP 143
DISPRANGE = 0..DISPLIMIT; PASCP 144
WHERE = (BLCK,CREC,VREC,REC); PASCP 145
PASCP 146
(*EXPRESSIONS*) PASCP 147
(*************) PASCP 148
ATTRKIND = (CST,VARBL,EXPR); PASCP 149
VACCESS = (DRCT,INDRCT,INXD); PASCP 150
PASCP 151
ATTR = RECORD TYPTR: STP; PASCP 152
CASE KIND: ATTRKIND OF PASCP 153
CST: (CVAL: VALU); PASCP 154
VARBL: (CASE ACCESS: VACCESS OF PASCP 155
DRCT: (VLEVEL: LEVRANGE; DPLMT: ADDRRANGE); PASCP 156
INDRCT: (IDPLMT: ADDRRANGE)) PASCP 157
END; PASCP 158
PASCP 159
TESTP = ' TESTPOINTER; PASCP 160
TESTPOINTER = PACKED RECORD PASCP 161
ELT1,ELT2 : STP; PASCP 162
LASTTESTP : TESTP PASCP 163
END; PASCP 164
PASCP 165
(*LABELS*) PASCP 166
(********) PASCP 167
LBP = ' LABL; PASCP 168
LABL = RECORD NEXTLAB: LBP; DEFINED: BOOLEAN; PASCP 169
LABVAL, LABNAME: INTEGER PASCP 170
END; PASCP 171
PASCP 172
EXTFILEP = 'FILEREC; PASCP 173
FILEREC = RECORD FILENAME:ALPHA; NEXTFILE:EXTFILEP END; PASCP 174
PASCP 175
(*-------------------------------------------------------------------------*) PASCP 176
PASCP 177
PASCP 178
VAR PASCP 179
(*RETURNED BY SOURCE PROGRAM SCANNER PASCP 181
INSYMBOL: PASCP 182
**********) PASCP 183
PASCP 184
SY: SYMBOL; (*LAST SYMBOL*) PASCP 185
OP: OPERATOR; (*CLASSIFICATION OF LAST SYMBOL*) PASCP 186
VAL: VALU; (*VALUE OF LAST CONSTANT*) PASCP 187
LGTH: INTEGER; (*LENGTH OF LAST STRING CONSTANT*) PASCP 188
ID: ALPHA; (*LAST IDENTIFIER (POSSIBLY TRUNCATED)*) PASCP 189
KK: 1..8; (*NR OF CHARS IN LAST IDENTIFIER*) PASCP 190
CH: CHAR; (*LAST CHARACTER*) PASCP 191
EOL: BOOLEAN; (*END OF LINE FLAG*) PASCP 192
PASCP 193
PASCP 194
(*COUNTERS:*) PASCP 195
(***********) PASCP 196
PASCP 197
CHCNT: INTEGER; (*CHARACTER COUNTER*) P 58
LC,IC: ADDRRANGE; (*DATA LOCATION AND INSTRUCTION COUNTER*) PASCP 199
LINECOUNT: INTEGER; PASCP 200
PASCP 201
PASCP 202
(*SWITCHES:*) PASCP 203
(***********) PASCP 204
PASCP 205
DP, (*DECLARATION PART*) PASCP 206
PRTERR, (*TO ALLOW FORWARD REFERENCES IN POINTER TYPE PASCP 207
DECLARATION BY SUPPRESSING ERROR MESSAGE*) PASCP 208
LIST,PRCODE,PRTABLES: BOOLEAN; (*OUTPUT OPTIONS FOR PASCP 209
-- SOURCE PROGRAM LISTING PASCP 210
-- PRINTING SYMBOLIC CODE PASCP 211
-- DISPLAYING IDENT AND STRUCT TABLES PASCP 212
--> PROCEDURE OPTION*) PASCP 213
DEBUG: BOOLEAN; P 59
PASCP 214
PASCP 215
(*POINTERS:*) PASCP 216
(***********) PASCP 217
PARMPTR, P 60
INTPTR,REALPTR,CHARPTR, PASCP 218
BOOLPTR,NILPTR,TEXTPTR: STP; (*POINTERS TO ENTRIES OF STANDARD IDS*) PASCP 219
UTYPPTR,UCSTPTR,UVARPTR, PASCP 220
UFLDPTR,UPRCPTR,UFCTPTR, (*POINTERS TO ENTRIES FOR UNDECLARED IDS*) PASCP 221
FWPTR: CTP; (*HEAD OF CHAIN OF FORW DECL TYPE IDS*) PASCP 222
FEXTFILEP: EXTFILEP; (*HEAD OF CHAIN OF EXTERNAL FILES*) PASCP 223
GLOBTESTP: TESTP; (*LAST TESTPOINTER*) PASCP 224
PASCP 225
PASCP 226
(*BOOKKEEPING OF DECLARATION LEVELS:*) PASCP 227
(************************************) PASCP 228
PASCP 229
LEVEL: LEVRANGE; (*CURRENT STATIC LEVEL*) PASCP 230
DISX, (*LEVEL OF LAST ID SEARCHED BY SEARCHID*) PASCP 231
TOP: DISPRANGE; (*TOP OF DISPLAY*) PASCP 232
PASCP 233
DISPLAY: (*WHERE: MEANS:*) PASCP 234
ARRAY [DISPRANGE] OF PASCP 235
PACKED RECORD (*=BLCK: ID IS VARIABLE ID*) PASCP 236
FNAME: CTP; FLABEL: LBP; (*=CREC: ID IS FIELD ID IN RECORD WITH*) PASCP 237
CASE OCCUR: WHERE OF (* CONSTANT ADDRESS*) PASCP 238
CREC: (CLEV: LEVRANGE; (*=VREC: ID IS FIELD ID IN RECORD WITH*) PASCP 239
CDSPL: ADDRRANGE);(* VARIABLE ADDRESS*) PASCP 240
VREC: (VDSPL: ADDRRANGE) PASCP 241
END; (* --> PROCEDURE WITHSTATEMENT*) PASCP 242
PASCP 243
PASCP 244
(*ERROR MESSAGES:*) PASCP 245
(*****************) PASCP 246
PASCP 247
ERRINX: 0..10; (*NR OF ERRORS IN CURRENT SOURCE LINE*) PASCP 248
ERRLIST: PASCP 249
ARRAY [1..10] OF PASCP 250
PACKED RECORD POS: INTEGER; P 61
NMR: 1..400 PASCP 252
END; PASCP 253
PASCP 254
PASCP 255
PASCP 256
PASCP 257
(*EXPRESSION COMPILATION:*) PASCP 258
(*************************) PASCP 259
PASCP 260
GATTR: ATTR; (*DESCRIBES THE EXPR CURRENTLY COMPILED*) PASCP 261
PASCP 262
PASCP 263
(*STRUCTURED CONSTANTS:*) PASCP 264
(***********************) PASCP 265
PASCP 266
CONSTBEGSYS,SIMPTYPEBEGSYS,TYPEBEGSYS,BLOCKBEGSYS,SELECTSYS,FACBEGSYS, PASCP 267
STATBEGSYS,TYPEDELS: SETOFSYS; PASCP 268
CHARTP : ARRAY[CHAR] OF CHTP; P 62
RW: ARRAY [1..35(*NR. OF RES. WORDS*)] OF ALPHA; PASCP 269
FRW: ARRAY [1..9] OF 1..36(*NR. OF RES. WORDS + 1*); PASCP 270
RSY: ARRAY [1..35(*NR. OF RES. WORDS*)] OF SYMBOL; PASCP 271
SSY: ARRAY [CHAR] OF SYMBOL; J 1
ROP: ARRAY [1..35(*NR. OF RES. WORDS*)] OF OPERATOR; PASCP 273
SOP: ARRAY [CHAR] OF OPERATOR; J 2
NA: ARRAY [1..35] OF ALPHA; PASCP 275
MN: ARRAY[0..60] OF PACKED ARRAY[1..4] OF CHAR; P 63
SNA: ARRAY [1..23] OF PACKED ARRAY [1..4] OF CHAR; PASCP 277
CDX: ARRAY[0..60] OF -4..+4; P 64
PDX: ARRAY[1..23] OF -7..+7; P 65
ORDINT: ARRAY[CHAR] OF INTEGER; CH 1
CH 2
INTLABEL,MXINT10,DIGMAX: INTEGER; PASCP 279
PASCP 280
(*-------------------------------------------------------------------------*) PASCP 281
PASCP 282
PASCP 283
PROCEDURE ENDOFLINE; PASCP 284
VAR LASTPOS,FREEPOS,CURRPOS,CURRNMR,F,K: INTEGER; PASCP 285
BEGIN PASCP 286
IF ERRINX > 0 THEN (*OUTPUT ERROR MESSAGES*) PASCP 287
BEGIN WRITE(OUTPUT,# **** #:15); PASCP 288
LASTPOS := 0; FREEPOS := 1; PASCP 289
FOR K := 1 TO ERRINX DO PASCP 290
BEGIN PASCP 291
WITH ERRLIST[K] DO PASCP 292
BEGIN CURRPOS := POS; CURRNMR := NMR END; PASCP 293
IF CURRPOS = LASTPOS THEN WRITE(OUTPUT,#,#) PASCP 294
ELSE PASCP 295
BEGIN PASCP 296
WHILE FREEPOS < CURRPOS DO PASCP 297
BEGIN WRITE(OUTPUT,# #); FREEPOS := FREEPOS + 1 END; PASCP 298
WRITE(OUTPUT,#'#); PASCP 299
LASTPOS := CURRPOS PASCP 300
END; PASCP 301
IF CURRNMR < 10 THEN F := 1 PASCP 302
ELSE IF CURRNMR < 100 THEN F := 2 PASCP 303
ELSE F := 3; PASCP 304
WRITE(OUTPUT,CURRNMR:F); PASCP 305
FREEPOS := FREEPOS + F + 1 PASCP 306
END; PASCP 307
WRITELN(OUTPUT); ERRINX := 0 PASCP 308
END; PASCP 309
IF LIST AND (NOT EOF(INPUT)) THEN P 66
BEGIN LINECOUNT := LINECOUNT + 1; WRITE(OUTPUT,LINECOUNT:6,# #:2); PASCP 311
IF DP THEN WRITE(OUTPUT,LC:7) ELSE WRITE(OUTPUT,IC:7); PASCP 312
WRITE(OUTPUT,# #) PASCP 313
END; PASCP 314
CHCNT := 0 PASCP 315
END (*ENDOFLINE*) ; PASCP 316
PASCP 317
PROCEDURE ERROR(FERRNR: INTEGER); PASCP 318
BEGIN PASCP 319
IF ERRINX >= 9 THEN PASCP 320
BEGIN ERRLIST[10].NMR := 255; ERRINX := 10 END PASCP 321
ELSE PASCP 322
BEGIN ERRINX := ERRINX + 1; PASCP 323
ERRLIST[ERRINX].NMR := FERRNR PASCP 324
END; PASCP 325
ERRLIST[ERRINX].POS := CHCNT PASCP 326
END (*ERROR*) ; PASCP 327
PASCP 328
PROCEDURE INSYMBOL; PASCP 329
(*READ NEXT BASIC SYMBOL OF SOURCE PROGRAM AND RETURN ITS PASCP 330
DESCRIPTION IN THE GLOBAL VARIABLES SY, OP, ID, VAL AND LGTH*) PASCP 331
LABEL 1,2,3; PASCP 332
VAR I,K: INTEGER; PASCP 333
DIGIT: PACKED ARRAY [1..STRGLGTH] OF CHAR; PASCP 334
STRING: PACKED ARRAY [1..STRGLGTH] OF CHAR; PASCP 335
LVP: CSP;TEST: BOOLEAN; PASCP 336
PASCP 337
PROCEDURE NEXTCH; PASCP 338
BEGIN IF EOL THEN PASCP 339
BEGIN IF LIST THEN WRITELN(OUTPUT); ENDOFLINE PASCP 340
END; PASCP 341
IF NOT EOF(INPUT) THEN PASCP 342
BEGIN EOL := EOLN(INPUT); READ(INPUT,CH); PASCP 343
IF LIST THEN WRITE(OUTPUT,CH); PASCP 344
CHCNT := CHCNT + 1 PASCP 345
END PASCP 346
ELSE P 67
BEGIN WRITELN(OUTPUT,# *** EOF #,#ENCOUNTERED#); P 68
TEST := FALSE P 69
END P 70
END; PASCP 348
PASCP 349
PROCEDURE OPTIONS; PASCP 350
BEGIN PASCP 351
REPEAT NEXTCH; PASCP 352
IF CH <> #*# THEN PASCP 353
BEGIN PASCP 354
IF CH = #T# THEN PASCP 355
BEGIN NEXTCH; PRTABLES := CH = #+# END PASCP 356
ELSE PASCP 357
IF CH = #L# THEN PASCP 358
BEGIN NEXTCH; LIST := CH = #+#; PASCP 359
IF NOT LIST THEN WRITELN(OUTPUT) PASCP 360
END PASCP 361
ELSE PASCP 362
IF CH = #D# THEN P 71
BEGIN NEXTCH; DEBUG := CH = #+# END P 72
ELSE P 73
IF CH = #C# THEN PASCP 363
BEGIN NEXTCH; PRCODE := CH = #+# END; PASCP 364
NEXTCH PASCP 365
END PASCP 366
UNTIL CH <> #,# PASCP 367
END (*OPTIONS*) ; PASCP 368
PASCP 369
BEGIN (*INSYMBOL*) PASCP 370
1: PASCP 371
REPEAT WHILE (CH = # #) AND NOT EOL DO NEXTCH; PASCP 372
TEST := EOL; PASCP 373
IF TEST THEN NEXTCH PASCP 374
UNTIL NOT TEST; PASCP 375
IF CHARTP[CH] = ILLEGAL THEN P 74
BEGIN SY := OTHERSY; OP := NOOP; P 75
ERROR(399); NEXTCH P 76
END P 77
ELSE P 78
CASE CHARTP[CH] OF PASCP 376
LETTER: PASCP 379
BEGIN K := 0; PASCP 380
REPEAT PASCP 381
IF K < 8 THEN PASCP 382
BEGIN K := K + 1; ID[K] := CH END ; PASCP 383
NEXTCH PASCP 384
UNTIL CHARTP[CH] IN [SPECIAL,ILLEGAL,CHSTRQUO,CHCOLON,CHPERIOD, INDEP 10
CHLT,CHGT,CHLPAREN,CHSPACE]; INDEP 11
IF K >= KK THEN KK := K PASCP 386
ELSE PASCP 387
REPEAT ID[KK] := # #; KK := KK - 1 PASCP 388
UNTIL KK = K; PASCP 389
FOR I := FRW[K] TO FRW[K+1] - 1 DO PASCP 390
IF RW[I] = ID THEN PASCP 391
BEGIN SY := RSY[I]; OP := ROP[I]; GOTO 2 END; PASCP 392
SY := IDENT; OP := NOOP; PASCP 393
2: END; PASCP 394
NUMBER: PASCP 395
BEGIN OP := NOOP; I := 0; PASCP 396
REPEAT I := I+1; IF I<= DIGMAX THEN DIGIT[I] := CH; NEXTCH PASCP 397
UNTIL CHARTP[CH] <> NUMBER; P 80
IF (CH = #.#) OR (CH = #E#) THEN PASCP 399
BEGIN PASCP 400
K := I; PASCP 401
IF CH = #.# THEN PASCP 402
BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH; PASCP 403
NEXTCH; IF CH = #.# THEN BEGIN CH := #:#; GOTO 3 END; PASCP 404
IF CHARTP[CH] <> NUMBER THEN ERROR(201) P 81
ELSE PASCP 407
REPEAT K := K + 1; PASCP 408
IF K <= DIGMAX THEN DIGIT[K] := CH; NEXTCH PASCP 409
UNTIL CHARTP[CH] <> NUMBER P 82
END; PASCP 411
IF CH = #E# THEN PASCP 412
BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH; PASCP 413
NEXTCH; PASCP 414
IF (CH = #+#) OR (CH =#-#) THEN PASCP 415
BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH; PASCP 416
NEXTCH PASCP 417
END; PASCP 418
IF CHARTP[CH] <> NUMBER THEN ERROR(201) P 83
ELSE PASCP 421
REPEAT K := K+1; PASCP 422
IF K <= DIGMAX THEN DIGIT[K] := CH; NEXTCH PASCP 423
UNTIL CHARTP[CH] <> NUMBER P 84
END; PASCP 425
NEW(LVP,REEL); SY:= REALCONST; LVP'.CCLASS := REEL; PASCP 426
WITH LVP' DO PASCP 427
BEGIN FOR I := 1 TO STRGLGTH DO RVAL[I] := # #; PASCP 428
IF K <= DIGMAX THEN PASCP 429
FOR I := 2 TO K + 1 DO RVAL[I] := DIGIT[I-1] PASCP 430
ELSE BEGIN ERROR(203); RVAL[2] := #0#; PASCP 431
RVAL[3] := #.#; RVAL[4] := #0# PASCP 432
END PASCP 433
END; PASCP 434
VAL.VALP := LVP PASCP 435
END PASCP 436
ELSE PASCP 437
3: BEGIN PASCP 438
IF I > DIGMAX THEN BEGIN ERROR(203); VAL.IVAL := 0 END PASCP 439
ELSE PASCP 440
WITH VAL DO PASCP 441
BEGIN IVAL := 0; PASCP 442
FOR K := 1 TO I DO PASCP 443
BEGIN PASCP 444
IF IVAL <= MXINT10 THEN PASCP 445
IVAL := IVAL*10+ORDINT[DIGIT[K]] CH 3
ELSE BEGIN ERROR(203); IVAL := 0 END PASCP 447
END; PASCP 448
SY := INTCONST PASCP 449
END PASCP 450
END PASCP 451
END; PASCP 452
CHSTRQUO: PASCP 453
BEGIN LGTH := 0; SY := STRINGCONST; OP := NOOP; PASCP 454
REPEAT PASCP 455
REPEAT NEXTCH; LGTH := LGTH + 1; PASCP 456
IF LGTH <= STRGLGTH THEN STRING[LGTH] := CH PASCP 457
UNTIL (EOL) OR (CH = ####); PASCP 458
IF EOL THEN ERROR(202) ELSE NEXTCH PASCP 459
UNTIL CH <> ####; PASCP 460
LGTH := LGTH - 1; (*NOW LGTH = NR OF CHARS IN STRING*) PASCP 461
IF LGTH = 0 THEN ERROR(205) KEN 1
ELSE KEN 2
IF LGTH = 1 THEN VAL.IVAL := ORD(STRING[1]) PASCP 462
ELSE PASCP 463
BEGIN NEW(LVP,STRG); LVP'.CCLASS:=STRG; PASCP 464
IF LGTH > STRGLGTH THEN PASCP 465
BEGIN ERROR(399); LGTH := STRGLGTH END; PASCP 466
WITH LVP' DO PASCP 467
BEGIN SLGTH := LGTH; PASCP 468
FOR I := 1 TO LGTH DO SVAL[I] := STRING[I] PASCP 469
END; PASCP 470
VAL.VALP := LVP PASCP 471
END PASCP 472
END; PASCP 473
CHCOLON: PASCP 474
BEGIN OP := NOOP; NEXTCH; PASCP 475
IF CH = #=# THEN PASCP 476
BEGIN SY := BECOMES; NEXTCH END PASCP 477
ELSE SY := COLON PASCP 478
END; PASCP 479
CHPERIOD: PASCP 480
BEGIN OP := NOOP; NEXTCH; PASCP 481
IF CH = #.# THEN PASCP 482
BEGIN SY := COLON; NEXTCH END PASCP 483
ELSE SY := PERIOD PASCP 484
END; PASCP 485
CHLT: PASCP 486
BEGIN NEXTCH; SY := RELOP; PASCP 487
IF CH = #=# THEN PASCP 488
BEGIN OP := LEOP; NEXTCH END PASCP 489
ELSE PASCP 490
IF CH = #># THEN PASCP 491
BEGIN OP := NEOP; NEXTCH END PASCP 492
ELSE OP := LTOP PASCP 493
END; PASCP 494
CHGT: PASCP 495
BEGIN NEXTCH; SY := RELOP; PASCP 496
IF CH = #=# THEN PASCP 497
BEGIN OP := GEOP; NEXTCH END PASCP 498
ELSE OP := GTOP PASCP 499
END; PASCP 500
CHLPAREN: PASCP 501
BEGIN NEXTCH; PASCP 502
IF CH = #*# THEN PASCP 503
BEGIN NEXTCH; PASCP 504
IF CH = #$# THEN OPTIONS; PASCP 505
REPEAT PASCP 506
WHILE (CH <> #*#) AND NOT EOF(INPUT) DO NEXTCH; PASCP 507
NEXTCH PASCP 508
UNTIL (CH = #)#) OR EOF(INPUT); PASCP 509
NEXTCH; GOTO 1 PASCP 510
END; PASCP 511
SY := LPARENT; OP := NOOP PASCP 512
END; PASCP 513
SPECIAL: PASCP 514
BEGIN SY := SSY[CH]; OP := SOP[CH]; PASCP 517
NEXTCH PASCP 518
END; PASCP 519
CHSPACE: SY := OTHERSY P 85
END (*CASE*) PASCP 523
END (*INSYMBOL*) ; PASCP 524
PASCP 525
PROCEDURE ENTERID(FCP: CTP); PASCP 526
(*ENTER ID POINTED AT BY FCP INTO THE NAME-TABLE, PASCP 527
WHICH ON EACH DECLARATION LEVEL IS ORGANISED AS PASCP 528
AN UNBALANCED BINARY TREE*) PASCP 529
VAR NAM: ALPHA; LCP, LCP1: CTP; LLEFT: BOOLEAN; PASCP 530
BEGIN NAM := FCP'.NAME; PASCP 531
LCP := DISPLAY[TOP].FNAME; PASCP 532
IF LCP = NIL THEN PASCP 533
DISPLAY[TOP].FNAME := FCP PASCP 534
ELSE PASCP 535
BEGIN PASCP 536
REPEAT LCP1 := LCP; PASCP 537
IF LCP'.NAME = NAM THEN (*NAME CONFLICT, FOLLOW RIGHT LINK*) PASCP 538
BEGIN ERROR(101); LCP := LCP'.RLINK; LLEFT := FALSE END PASCP 539
ELSE PASCP 540
IF LCP'.NAME < NAM THEN PASCP 541
BEGIN LCP := LCP'.RLINK; LLEFT := FALSE END PASCP 542
ELSE BEGIN LCP := LCP'.LLINK; LLEFT := TRUE END PASCP 543
UNTIL LCP = NIL; PASCP 544
IF LLEFT THEN LCP1'.LLINK := FCP ELSE LCP1'.RLINK := FCP PASCP 545
END; PASCP 546
FCP'.LLINK := NIL; FCP'.RLINK := NIL PASCP 547
END (*ENTERID*) ; PASCP 548
PASCP 549
PROCEDURE SEARCHSECTION(FCP: CTP; VAR FCP1: CTP); PASCP 550
(*TO FIND RECORD FIELDS AND FORWARD DECLARED PROCEDURE ID#S PASCP 551
--> PROCEDURE PROCEDUREDECLARATION PASCP 552
--> PROCEDURE SELECTOR*) PASCP 553
LABEL 1; PASCP 554
BEGIN PASCP 555
WHILE FCP <> NIL DO PASCP 556
IF FCP'.NAME = ID THEN GOTO 1 PASCP 557
ELSE IF FCP'.NAME < ID THEN FCP := FCP'.RLINK PASCP 558
ELSE FCP := FCP'.LLINK; PASCP 559
1: FCP1 := FCP PASCP 560
END (*SEARCHSECTION*) ; PASCP 561
PASCP 562
PROCEDURE SEARCHID(FIDCLS: SETOFIDS; VAR FCP: CTP); PASCP 563
LABEL 1; PASCP 564
VAR LCP: CTP; PASCP 565
BEGIN PASCP 566
FOR DISX := TOP DOWNTO 0 DO PASCP 567
BEGIN LCP := DISPLAY[DISX].FNAME; PASCP 568
WHILE LCP <> NIL DO PASCP 569
IF LCP'.NAME = ID THEN PASCP 570
IF LCP'.KLASS IN FIDCLS THEN GOTO 1 PASCP 571
ELSE PASCP 572
BEGIN IF PRTERR THEN ERROR(103); PASCP 573
LCP := LCP'.RLINK PASCP 574
END PASCP 575
ELSE PASCP 576
IF LCP'.NAME < ID THEN PASCP 577
LCP := LCP'.RLINK PASCP 578
ELSE LCP := LCP'.LLINK PASCP 579
END; PASCP 580
(*SEARCH NOT SUCCSESSFUL; SUPPRESS ERROR MESSAGE IN CASE PASCP 581
OF FORWARD REFERENCED TYPE ID IN POINTER TYPE DEFINITION PASCP 582
--> PROCEDURE SIMPLETYPE*) PASCP 583
IF PRTERR THEN PASCP 584
BEGIN ERROR(104); PASCP 585
(*TO AVOID RETURNING NIL, REFERENCE AN ENTRY PASCP 586
FOR AN UNDECLARED ID OF APPROPRIATE CLASS PASCP 587
--> PROCEDURE ENTERUNDECL*) PASCP 588
IF TYPES IN FIDCLS THEN LCP := UTYPPTR PASCP 589
ELSE PASCP 590
IF VARS IN FIDCLS THEN LCP := UVARPTR PASCP 591
ELSE PASCP 592
IF FIELD IN FIDCLS THEN LCP := UFLDPTR PASCP 593
ELSE PASCP 594
IF KONST IN FIDCLS THEN LCP := UCSTPTR PASCP 595
ELSE PASCP 596
IF PROC IN FIDCLS THEN LCP := UPRCPTR PASCP 597
ELSE LCP := UFCTPTR; PASCP 598
END; PASCP 599
1: FCP := LCP PASCP 600
END (*SEARCHID*) ; PASCP 601
PASCP 602
PROCEDURE GETBOUNDS(FSP: STP; VAR FMIN,FMAX: INTEGER); PASCP 603
(*GET INTERNAL BOUNDS OF SUBRANGE OR SCALAR TYPE*) PASCP 604
(*ASSUME FSP<>INTPTR AND FSP<>REALPTR*) P 86
BEGIN PASCP 607
FMIN := 0; FMAX := 0; P 87
IF FSP <> NIL THEN P 88
WITH FSP' DO PASCP 608
IF FORM = SUBRANGE THEN PASCP 609
BEGIN FMIN := MIN.IVAL; FMAX := MAX.IVAL END PASCP 610
ELSE PASCP 611
IF FSP = CHARPTR THEN P 89
BEGIN FMIN := ORDMINCHAR; FMAX := ORDMAXCHAR P 90
END P 91
ELSE PASCP 614
IF FCONST <> NIL THEN P 92
FMAX := FCONST'.VALUES.IVAL P 93
END (*GETBOUNDS*) ; PASCP 619
P 94
FUNCTION ALIGNQUOT(FSP: STP): INTEGER; P 95
BEGIN P 96
ALIGNQUOT := 1; P 97
IF FSP <> NIL THEN P 98
WITH FSP' DO P 99
CASE FORM OF P 100
SCALAR: IF FSP=INTPTR THEN ALIGNQUOT := INTAL P 101
ELSE IF FSP=BOOLPTR THEN ALIGNQUOT := BOOLAL P 102
ELSE IF SCALKIND=DECLARED THEN ALIGNQUOT := INTAL P 103
ELSE IF FSP=CHARPTR THEN ALIGNQUOT := CHARAL P 104
ELSE IF FSP=REALPTR THEN ALIGNQUOT := REALAL P 105
ELSE (*PARMPTR*) ALIGNQUOT := PARMAL; P 106
SUBRANGE: ALIGNQUOT := ALIGNQUOT(RANGETYPE); P 107
POINTER: ALIGNQUOT := ADRAL; P 108
POWER: ALIGNQUOT := SETAL; P 109
FILES: ALIGNQUOT := FILEAL; P 110
ARRAYS: ALIGNQUOT := ALIGNQUOT(AELTYPE); P 111
RECORDS: ALIGNQUOT := RECAL; P 112
VARIANT,TAGFLD: ERROR(501) P 113
END P 114
END (*ALIGNQUOT*); P 115
P 116
PROCEDURE ALIGN(FSP: STP; VAR FLC: ADDRRANGE); P 117
VAR K,L: INTEGER; P 118
BEGIN P 119
K := ALIGNQUOT(FSP); P 120
L := FLC-1; P 121
FLC := L + K -(K + L) MOD K X7 1
END (*ALIGN*); P 123
PASCP 620
PROCEDURE PRINTTABLES(FB: BOOLEAN); PASCP 621
(*PRINT DATA STRUCTURE AND NAME TABLE*) PASCP 622
VAR I, LIM: DISPRANGE; PASCP 623
PASCP 624
PROCEDURE MARKER; PASCP 625
(*MARK DATA STRUCTURE ENTRIES TO AVOID MULTIPLE PRINTOUT*) PASCP 626
VAR I: INTEGER; PASCP 627
PASCP 628
PROCEDURE MARKCTP(FP: CTP); FORWARD; PASCP 629
PASCP 630
PROCEDURE MARKSTP(FP: STP); PASCP 631
(*MARK DATA STRUCTURES, PREVENT CYCLES*) PASCP 632
BEGIN PASCP 633
IF FP <> NIL THEN PASCP 634
WITH FP' DO PASCP 635
BEGIN MARKED := TRUE; PASCP 636
CASE FORM OF PASCP 637
SCALAR: ; PASCP 638
SUBRANGE: MARKSTP(RANGETYPE); PASCP 639
POINTER: (*DON#T MARK ELTYPE: CYCLE POSSIBLE; WILL BE MARKED PASCP 640
ANYWAY, IF FP = TRUE*) ; PASCP 641
POWER: MARKSTP(ELSET) ; PASCP 642
ARRAYS: BEGIN MARKSTP(AELTYPE); MARKSTP(INXTYPE) END; PASCP 643
RECORDS: BEGIN MARKCTP(FSTFLD); MARKSTP(RECVAR) END; PASCP 644
FILES: MARKSTP(FILTYPE); PASCP 645
TAGFLD: MARKSTP(FSTVAR); PASCP 646
VARIANT: BEGIN MARKSTP(NXTVAR); MARKSTP(SUBVAR) END PASCP 647
END (*CASE*) PASCP 648
END (*WITH*) PASCP 649
END (*MARKSTP*); PASCP 650
PASCP 651
PROCEDURE MARKCTP; PASCP 652
BEGIN PASCP 653
IF FP <> NIL THEN PASCP 654
WITH FP' DO PASCP 655
BEGIN MARKCTP(LLINK); MARKCTP(RLINK); PASCP 656
MARKSTP(IDTYPE) PASCP 657
END PASCP 658
END (*MARKCTP*); PASCP 659
PASCP 660
BEGIN (*MARK*) PASCP 661
FOR I := TOP DOWNTO LIM DO PASCP 662
MARKCTP(DISPLAY[I].FNAME) PASCP 663
END (*MARK*); PASCP 664
PASCP 665
PROCEDURE FOLLOWCTP(FP: CTP); FORWARD; PASCP 666
PASCP 667
PROCEDURE FOLLOWSTP(FP: STP); PASCP 668
BEGIN PASCP 669
IF FP <> NIL THEN PASCP 670
WITH FP' DO PASCP 671
IF MARKED THEN PASCP 672
BEGIN MARKED := FALSE; WRITE(OUTPUT,# #:4,ORD(FP):6,SIZE:10); PASCP 673
CASE FORM OF PASCP 674
SCALAR: BEGIN WRITE(OUTPUT,#SCALAR#:10); PASCP 675
IF SCALKIND = STANDARD THEN PASCP 676
WRITE(OUTPUT,#STANDARD#:10) PASCP 677
ELSE WRITE(OUTPUT,#DECLARED#:10,# #:4,ORD(FCONST):6); PASCP 678
WRITELN(OUTPUT) PASCP 679
END; PASCP 680
SUBRANGE:BEGIN PASCP 681
WRITE(OUTPUT,#SUBRANGE#:10,# #:4,ORD(RANGETYPE):6); PASCP 682
IF RANGETYPE <> REALPTR THEN PASCP 683
WRITE(OUTPUT,MIN.IVAL,MAX.IVAL) PASCP 684
ELSE PASCP 685
IF (MIN.VALP <> NIL) AND (MAX.VALP <> NIL) THEN PASCP 686
WRITE(OUTPUT,# #,MIN.VALP'.RVAL:9, PASCP 687
# #,MAX.VALP'.RVAL:9); PASCP 688
WRITELN(OUTPUT); FOLLOWSTP(RANGETYPE); PASCP 689
END; PASCP 690
POINTER: WRITELN(OUTPUT,#POINTER#:10,# #:4,ORD(ELTYPE):6); PASCP 691
POWER: BEGIN WRITELN(OUTPUT,#SET#:10,# #:4,ORD(ELSET):6); PASCP 692
FOLLOWSTP(ELSET) PASCP 693
END; PASCP 694
ARRAYS: BEGIN PASCP 695
WRITELN(OUTPUT,#ARRAY#:10,# #:4,ORD(AELTYPE):6,# #:4, PASCP 696
ORD(INXTYPE):6); PASCP 697
FOLLOWSTP(AELTYPE); FOLLOWSTP(INXTYPE) PASCP 698
END; PASCP 699
RECORDS: BEGIN PASCP 700
WRITELN(OUTPUT,#RECORD#:10,# #:4,ORD(FSTFLD):6,# #:4, PASCP 701
ORD(RECVAR):6); FOLLOWCTP(FSTFLD); PASCP 702
FOLLOWSTP(RECVAR) PASCP 703
END; PASCP 704
FILES: BEGIN WRITE(OUTPUT,#FILE#:10,# #:4,ORD(FILTYPE):6); PASCP 705
FOLLOWSTP(FILTYPE) PASCP 706
END; PASCP 707
TAGFLD: BEGIN WRITELN(OUTPUT,#TAGFLD#:10,# #:4,ORD(TAGFIELDP):6,PASCP 708
# #:4,ORD(FSTVAR):6); PASCP 709
FOLLOWSTP(FSTVAR) PASCP 710
END; PASCP 711
VARIANT: BEGIN WRITELN(OUTPUT,#VARIANT#:10,# #:4,ORD(NXTVAR):6, PASCP 712
# #:4,ORD(SUBVAR):6,VARVAL.IVAL); PASCP 713
FOLLOWSTP(NXTVAR); FOLLOWSTP(SUBVAR) PASCP 714
END PASCP 715
END (*CASE*) PASCP 716
END (*IF MARKED*) PASCP 717
END (*FOLLOWSTP*); PASCP 718
PASCP 719
PROCEDURE FOLLOWCTP; PASCP 720
VAR I: INTEGER; PASCP 721
BEGIN PASCP 722
IF FP <> NIL THEN PASCP 723
WITH FP' DO PASCP 724
BEGIN WRITE(OUTPUT,# #:4,ORD(FP):6,# #,NAME:9,# #:4,ORD(LLINK):6, PASCP 725
# #:4,ORD(RLINK):6,# #:4,ORD(IDTYPE):6); PASCP 726
CASE KLASS OF PASCP 727
TYPES: WRITE(OUTPUT,#TYPE#:10); PASCP 728
KONST: BEGIN WRITE(OUTPUT,#CONSTANT#:10,# #:4,ORD(NEXT):6); PASCP 729
IF IDTYPE <> NIL THEN PASCP 730
IF IDTYPE = REALPTR THEN PASCP 731
BEGIN PASCP 732
IF VALUES.VALP <> NIL THEN PASCP 733
WRITE(OUTPUT,# #,VALUES.VALP'.RVAL:9) PASCP 734
END PASCP 735
ELSE PASCP 736
IF IDTYPE'.FORM = ARRAYS THEN (*STRINGCONST*) PASCP 737
BEGIN PASCP 738
IF VALUES.VALP <> NIL THEN PASCP 739
BEGIN WRITE(OUTPUT,# #); PASCP 740
WITH VALUES.VALP' DO PASCP 741
FOR I := 1 TO SLGTH DO PASCP 742
WRITE(OUTPUT,SVAL[I]) PASCP 743
END PASCP 744
END PASCP 745
ELSE WRITE(OUTPUT,VALUES.IVAL) PASCP 746
END; PASCP 747
VARS: BEGIN WRITE(OUTPUT,#VARIABLE#:10); PASCP 748
IF VKIND = ACTUAL THEN WRITE(OUTPUT,#ACTUAL#:10) PASCP 749
ELSE WRITE(OUTPUT,#FORMAL#:10); PASCP 750
WRITE(OUTPUT,# #:4,ORD(NEXT):6,VLEV,# #:4,VADDR:6 ); PASCP 751
END; PASCP 752
FIELD: WRITE(OUTPUT,#FIELD#:10,# #:4,ORD(NEXT):6,# #:4,FLDADDR:6);PASCP 753
PROC, PASCP 754
FUNC: BEGIN PASCP 755
IF KLASS = PROC THEN WRITE(OUTPUT,#PROCEDURE#:10) PASCP 756
ELSE WRITE(OUTPUT,#FUNCTION#:10); PASCP 757
IF PFDECKIND = STANDARD THEN PASCP 758
WRITE(OUTPUT,#STANDARD#:10, PASCP 759
KEY:10) PASCP 760
ELSE PASCP 761
BEGIN WRITE(OUTPUT,#DECLARED#:10,# #:4,ORD(NEXT):6); PASCP 762
WRITE(OUTPUT,PFLEV,# #:4,PFNAME:6); PASCP 763
IF PFKIND = ACTUAL THEN PASCP 764
BEGIN WRITE(OUTPUT,#ACTUAL#:10); PASCP 765
IF FORWDECL THEN WRITE(OUTPUT,#FORWARD#:10) PASCP 766
ELSE WRITE(OUTPUT,#NOTFORWARD#:10); PASCP 767
IF EXTERN THEN WRITE(OUTPUT,#EXTERN#:10) PASCP 768
ELSE WRITE(OUTPUT,#NOT EXTERN#:10); PASCP 769
END PASCP 770
ELSE WRITE(OUTPUT,#FORMAL#:10) PASCP 771
END PASCP 772
END PASCP 773
END (*CASE*); PASCP 774
WRITELN(OUTPUT); FOLLOWCTP(LLINK); FOLLOWCTP(RLINK); PASCP 775
FOLLOWSTP(IDTYPE) PASCP 776
END (*WITH*) PASCP 777
END (*FOLLOWCTP*); PASCP 778
PASCP 779
BEGIN (*PRINTTABLES*) PASCP 780
WRITELN(OUTPUT); WRITELN(OUTPUT); WRITELN(OUTPUT); PASCP 781
IF FB THEN LIM := 0 PASCP 782
ELSE BEGIN LIM := TOP; WRITE(OUTPUT,# LOCAL#) END; PASCP 783
WRITELN(OUTPUT,# TABLES #); WRITELN(OUTPUT); PASCP 784
MARKER; PASCP 785
FOR I := TOP DOWNTO LIM DO PASCP 786
FOLLOWCTP(DISPLAY[I].FNAME); PASCP 787
WRITELN(OUTPUT); PASCP 788
IF NOT EOL THEN WRITE(OUTPUT,# #:CHCNT+16) PASCP 789
END (*PRINTTABLES*); PASCP 790
PASCP 791
PROCEDURE GENLABEL(VAR NXTLAB: INTEGER); PASCP 792
BEGIN INTLABEL := INTLABEL + 1; PASCP 793
NXTLAB := INTLABEL PASCP 794
END (*GENLABEL*); PASCP 795
PASCP 796
PROCEDURE BLOCK(FSYS: SETOFSYS; FSY: SYMBOL; FPROCP: CTP); PASCP 797
VAR LSY: SYMBOL; TEST: BOOLEAN; PASCP 798
PASCP 799
PROCEDURE SKIP(FSYS: SETOFSYS); PASCP 800
(*SKIP INPUT STRING UNTIL RELEVANT SYMBOL FOUND*) PASCP 801
BEGIN P 124
IF NOT EOF(INPUT) THEN P 125
BEGIN WHILE NOT(SY IN FSYS) AND (NOT EOF(INPUT)) DO INSYMBOL; P 126
IF NOT (SY IN FSYS) THEN INSYMBOL P 127
END P 128
END (*SKIP*) ; PASCP 803
PASCP 804
PROCEDURE CONSTANT(FSYS: SETOFSYS; VAR FSP: STP; VAR FVALU: VALU); PASCP 805
VAR LSP: STP; LCP: CTP; SIGN: (NONE,POS,NEG); PASCP 806
LVP: CSP; I: 2..STRGLGTH; PASCP 807
BEGIN LSP := NIL; FVALU.IVAL := 0; PASCP 808
IF NOT(SY IN CONSTBEGSYS) THEN PASCP 809
BEGIN ERROR(50); SKIP(FSYS+CONSTBEGSYS) END; PASCP 810
IF SY IN CONSTBEGSYS THEN PASCP 811
BEGIN PASCP 812
IF SY = STRINGCONSTSY THEN PASCP 813
BEGIN PASCP 814
IF LGTH = 1 THEN LSP := CHARPTR PASCP 815
ELSE PASCP 816
BEGIN PASCP 817
NEW(LSP,ARRAYS); PASCP 818
WITH LSP' DO PASCP 819
BEGIN AELTYPE := CHARPTR; INXTYPE := NIL; PASCP 820
SIZE := LGTH*CHARSIZE; FORM := ARRAYS PASCP 821
END PASCP 822
END; PASCP 823
FVALU := VAL; INSYMBOL PASCP 824
END PASCP 825
ELSE PASCP 826
BEGIN PASCP 827
SIGN := NONE; PASCP 828
IF (SY = ADDOP) AND (OP IN [PLUS,MINUS]) THEN PASCP 829
BEGIN IF OP = PLUS THEN SIGN := POS ELSE SIGN := NEG; PASCP 830
INSYMBOL PASCP 831
END; PASCP 832
IF SY = IDENT THEN PASCP 833
BEGIN SEARCHID([KONST],LCP); PASCP 834
WITH LCP' DO PASCP 835
BEGIN LSP := IDTYPE; FVALU := VALUES END; PASCP 836
IF SIGN <> NONE THEN PASCP 837
IF LSP = INTPTR THEN PASCP 838
BEGIN IF SIGN = NEG THEN FVALU.IVAL := -FVALU.IVAL END PASCP 839
ELSE PASCP 840
IF LSP = REALPTR THEN PASCP 841
BEGIN PASCP 842
IF SIGN = NEG THEN PASCP 843
BEGIN NEW(LVP,REEL); PASCP 844
IF FVALU.VALP'.RVAL[1] = #-# THEN PASCP 845
LVP'.RVAL[1] := #+# PASCP 846
ELSE LVP'.RVAL[1] := #-#; PASCP 847
FOR I := 2 TO STRGLGTH DO PASCP 848
LVP'.RVAL[I] := FVALU.VALP'.RVAL[I]; PASCP 849
FVALU.VALP := LVP; PASCP 850
END PASCP 851
END PASCP 852
ELSE ERROR(105); PASCP 853
INSYMBOL; PASCP 854
END PASCP 855
ELSE PASCP 856
IF SY = INTCONST THEN PASCP 857
BEGIN IF SIGN = NEG THEN VAL.IVAL := -VAL.IVAL; PASCP 858
LSP := INTPTR; FVALU := VAL; INSYMBOL PASCP 859
END PASCP 860
ELSE PASCP 861
IF SY = REALCONST THEN PASCP 862
BEGIN IF SIGN = NEG THEN VAL.VALP'.RVAL[1] := #-#; PASCP 863
LSP := REALPTR; FVALU := VAL; INSYMBOL PASCP 864
END PASCP 865
ELSE PASCP 866
BEGIN ERROR(106); SKIP(FSYS) END PASCP 867
END; PASCP 868
IF NOT (SY IN FSYS) THEN PASCP 869
BEGIN ERROR(6); SKIP(FSYS) END PASCP 870
END; PASCP 871
FSP := LSP PASCP 872
END (*CONSTANT*) ; PASCP 873
PASCP 874
FUNCTION EQUALBOUNDS(FSP1,FSP2: STP): BOOLEAN; P 129
VAR LMIN1,LMIN2,LMAX1,LMAX2: INTEGER; P 130
BEGIN P 131
IF (FSP1=NIL) OR (FSP2=NIL) THEN EQUALBOUNDS := TRUE P 132
ELSE P 133
BEGIN P 134
GETBOUNDS(FSP1,LMIN1,LMAX1); P 135
GETBOUNDS(FSP2,LMIN2,LMAX2); P 136
EQUALBOUNDS := (LMIN1=LMIN2) AND (LMAX1=LMAX2) P 137
END P 138
END (*EQUALBOUNDS*) ; P 139
P 140
FUNCTION COMPTYPES(FSP1,FSP2: STP) : BOOLEAN; PASCP 875
(*DECIDE WHETHER STRUCTURES POINTED AT BY FSP1 AND FSP2 ARE COMPATIBLE*) PASCP 876
VAR NXT1,NXT2: CTP; COMP: BOOLEAN; PASCP 877
LTESTP1,LTESTP2 : TESTP; PASCP 878
BEGIN PASCP 879
IF FSP1 = FSP2 THEN COMPTYPES := TRUE PASCP 880
ELSE PASCP 881
IF (FSP1 <> NIL) AND (FSP2 <> NIL) THEN PASCP 882
IF FSP1'.FORM = FSP2'.FORM THEN PASCP 883
CASE FSP1'.FORM OF PASCP 884
SCALAR: PASCP 885
COMPTYPES := FALSE; PASCP 886
(* IDENTICAL SCALARS DECLARED ON DIFFERENT LEVELS ARE PASCP 887
NOT RECOGNIZED TO BE COMPATIBLE*) PASCP 888
SUBRANGE: PASCP 889
COMPTYPES := COMPTYPES(FSP1'.RANGETYPE,FSP2'.RANGETYPE); PASCP 890
POINTER: PASCP 891
BEGIN PASCP 892
COMP := FALSE; LTESTP1 := GLOBTESTP; PASCP 893
LTESTP2 := GLOBTESTP; PASCP 894
WHILE LTESTP1 <> NIL DO PASCP 895
WITH LTESTP1' DO PASCP 896
BEGIN PASCP 897
IF (ELT1 = FSP1'.ELTYPE) AND PASCP 898
(ELT2 = FSP2'.ELTYPE) THEN COMP := TRUE; PASCP 899
LTESTP1 := LASTTESTP PASCP 900
END; PASCP 901
IF NOT COMP THEN PASCP 902
BEGIN NEW(LTESTP1); PASCP 903
WITH LTESTP1' DO PASCP 904
BEGIN ELT1 := FSP1'.ELTYPE; PASCP 905
ELT2 := FSP2'.ELTYPE; PASCP 906
LASTTESTP := GLOBTESTP PASCP 907
END; PASCP 908
GLOBTESTP := LTESTP1; PASCP 909
COMP := COMPTYPES(FSP1'.ELTYPE,FSP2'.ELTYPE) PASCP 910
END; PASCP 911
COMPTYPES := COMP; GLOBTESTP := LTESTP2 PASCP 912
END; PASCP 913
POWER: PASCP 914
COMPTYPES := COMPTYPES(FSP1'.ELSET,FSP2'.ELSET); PASCP 915
ARRAYS: PASCP 916
BEGIN P 141
COMP := COMPTYPES(FSP1'.AELTYPE,FSP2'.AELTYPE) P 142
AND COMPTYPES(FSP1'.INXTYPE,FSP2'.INXTYPE); P 143
COMPTYPES := COMP AND P 144
EQUALBOUNDS(FSP1'.INXTYPE,FSP2'.INXTYPE) P 145
AND (FSP1'.SIZE = FSP2'.SIZE) KEN 3
END; P 146
RECORDS: PASCP 923
BEGIN NXT1 := FSP1'.FSTFLD; NXT2 := FSP2'.FSTFLD; COMP:=TRUE; PASCP 924
WHILE (NXT1 <> NIL) AND (NXT2 <> NIL) DO PASCP 925
BEGIN COMP:=COMP AND COMPTYPES(NXT1'.IDTYPE,NXT2'.IDTYPE); PASCP 926
NXT1 := NXT1'.NEXT; NXT2 := NXT2'.NEXT PASCP 927
END; PASCP 928