forked from besm6/pasauto-re
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathpasauto.pas
5385 lines (5322 loc) · 144 KB
/
pasauto.pas
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
(*=p-,t-,m-,c-,k8*)_program compil;
_label 27721;
_const spaces=' ';sp=' ';
asg='≡200'; % The character escape symbol is a la CDC 6600
c4096=4096;T=true;F=false;O='0';
branch='branch';back='back';kexit='exit';select='select';not='not';and='and';or='or';
label='label';type='type';with = 'with';downto='downto';for='for';repeat='repeat';
until='until';while='while';do='do';to='to';go='go';if='if';then='then';else='else';
goto='goto';begin='begin';in='in';kdiv='div';mod='mod';extern='extern';const='const';
var='var';functi='functi';proced='proced';nil='nil';record='record';case='case';
of='of';end='end';array='array';file='file';set='set';
(*=a0*)
icomma=',';icolon=':';ieq='=';e050='Э050';asn='СД';vm='ВМ';yta='МР';xts='СМ';
mv='МВ';utm='СА';pi='ПИ';aox='ЛС';wtc='ИК';ntr='РА';mul='АУ';div='АД';add='АС';
rsub='ОВ';xxta='СЧ';utc='ИА';sub='АВ';vtm='ПА';ita='ВИ';uj='ПБ';u1a='У1';uza='У0';avx='ИЗ';
aex='СР';vjm='ПВ';atx='ЗЧ';aax='ЛУ';z64='Z64';bp='10';bputc='10ИА';istar='*';
(*=a1*)zz='z';c127=127;i6=6400000000000006C;c100=100;
auANY=0;auINT=1;auSETINT=2;auFL=3;auSETFL=4;
_type
bitset=_set _of 0..47;
letter = 'a'..'z';
int=integer;bool=boolean;
word=_record _case int _of
0:(a:alfa);
1:(b:bitset);
3:(i:int);
6:(id:idptr);
8:(r:real)
_end;
typchain = _record
nxt:@typchain;
t1,t2:idptr
_end;
labels = _record num, line:int; lev, lab:alfa; nxt: @labels; def: bool _end;
class = (cType, cConst, cVar, cFun, cField, cCase, c6);
kind = (kSc, kRng, kPtr, kSet, kArr, kRec, kFile, kAlias);
%
% For variable size record allocation, a hack "new(ptr; up_to_field)" is used.
%
ident = _record
nm, lev:alfa;
nxt:idptr; % next in hash
bas:idptr; % std proc/func: index
% scalar: list of enums
_case cl:class _of
cType:(sz:int; % type: size in words
_case k:kind _of % type kind
kRng: (lo, hi: int); % range: bounds
kSc: (max: int; % scalar: maxval
lstoff: alfa); % offset of enum names
kArr: (rng:idptr; % array: range(s) list
eszoff:alfa); % offset of elt size constant
kFile:(pck:int) % file: packed flag
);
cVar:(vty:idptr; % variable: type
off:alfa; % offset within frame
trace:bool); % tracing requested
cConst:(ety:idptr; % enum: type
eoff:alfa; % offset in constants
nxtelt:idptr); % next contained object
cField:(fld5, fld6, fld7, fld8:idptr);
cCase:(cs5:word;
cs6:int;
cs7, cs8:word);
cFun:(fty:idptr; % proc/func: return type
desc:alfa; % offset of parameter descriptor
alist:idptr; % arg list
lbl, orignm:alfa; % autocode label, orig name
args:int; % arg count
chain, setup: idptr) % siblings; setup looks unused
_end;
idptr = @ident;
ekind = (ekCONST, ek1, ek2, ek3);
expr = _record ek:ekind; off, reg:alfa; ty:idptr; in:pInst; inv: int _end;
aumode = int;
inst = _record nxt:pInst; au:aumode; m, op, a:alfa _end;
pInst = @inst;
tkind = (tk0, tkIdent, tkWord, tkInt, tkStr, tkReal, tkChar, tkField);
extFile = _record nm:alfa; nuz, len:int; def: bool; nxt: @extFile _end;
_var
modeB:int;
rval:real;
hasFiles, hasExtFiles, modeF,
modeG, u16z, modeDe, modeCH, modeeL,
inInclude: bool;
errcnt, maxerr, nLex, lineNum, hash, ival, curWith, nWith, poolIdx,
strLen, poolStart, poolAddr, dynMem, modeK, reqAU, curAU:int;
XTA, tok, level,
two, curOff, curLab,
nilOff, basReg, defSection,
fname:alfa;
u47z: @int;
endl, seqGOST, seqITM, prev: char;
tokKind:tkind;
lookup, undefCnt, modeA:int; cv:word;
allowUndef, allowLong, modeC,
known, leftInsn, needToken, unsigned, errSeen, modeE, modeP, modeT, modeR, modeM,
modeL, silent, modeI, skipping, modeX: bool;
curId, fwdProcList, curRec,
textFile, inFile, outFile, ptrType, setType,
boolType, intType, realType, charType, alfaType,
dummyId:idptr; extCnt,
entrCnt, elapsed, savedNum:int;
stdin:_array[0..4] _of int; % saved state of stdin
modeV, modeS: bool;
g100z, noDisplay, octal, doOctal: bool;
curExtF, extFList:@extFile; extFcnt:alfa; funcHelper, gotoHelper, varHelper:bool;
rets: _array [3..8,1..6] _of alfa;
extras: _array [1..17] _of alfa;
idTable, idTabA: _array[0..127] _of idptr;
withs: _array [0..18] _of expr;
dummy:_array [1..4] _of char;
pool: _array[1..4096] _of int;
labList:@labels; tchain:@typchain; extSym, entryS:_array [0..100] _of char;
u4837z, u4838z:int;
(*=c+*)
_proced wrInt(i:int);
_(
write(i:0)
_);
_proced wrFName;
_(
_if inInclude _then _(
ГГ('*ФАЙЛ ', fname);
writeLN
_)
_);
(*=c-*)_proced fatal(i:int);(*=c+*)
_(
rewrite(output);
wrFName;
_select
i = 0: write('ВСТРЕТИЛСЯ КОНЕЦ ФАЙЛА');
i = 1: _( write('НЕ ЗАКРЫТА УСЛ СЕКЦИЯ'); ГГ(' СТР.='); wrInt(ival)_);
i = 2: _( write('ВЛОЖЕННОСТЬ !'); ГГ(' СТР.='); wrInt(lineNum)_);
i = 3: write('НЕ ЗАКРЫТ КОММЕНТАРИЙ');
i = 4: _( ГГ('ФАЙЛ ', fname); write(' НЕ НАЙДЕН') _);
i = 5: _( ГГ('В '); wrInt(lineNum); write(' СТРОКАХ ОБНАРУЖЕНО ');
wrInt(errcnt); ГГ(' ОШИБ.') _);
T: _( write('ОШ ПРЕПРОЦЕССОРА'); ГГ(' СТР.='); wrInt(lineNum) _)
_end;
writeLN;
code(ПБ76002=,);
_);
(*=c-*)_proced errMsg(a:alfa; i: int);(*=c+*)
_(
rewrite(output);
wrFName;
_case a _of
'ОШИБКА': _(
write('ТРЕБУЕТСЯ ');
_select
i = 0: write('ЗАПЯТАЯ');
i = 1: write('ПРОСТАЯ ПЕРЕМЕННАЯ');
i = 2: write('КОНСТАНТА');
T: _( _)
_end;
_);
'to': _(
_select
i = 0: write('НЕЛЬЗЯ ПРИСВАИВАТЬ ФАЙЛЫ');
i = 1: write('НЕСООТВ ТИПОВ ПРИ := ');
i _in [2..4]: _(
ГГ('МЕТКА ');
wrInt(ival);
_select
i = 2: write(' ОТСУТСТ В СПИСКЕ МЕТОК');
i = 3: _( write(' УЖЕ ОПРЕД В СТРОКЕ '); wrInt(cv.i) _);
T: write(' НЕ ОПРЕД')
_end;
_);
i = 5: write('ИД НЕ ОПРЕД');
i = 6: write('ИД НЕ ПЕРЕМЕН');
i = 7: write('ДВАЖДЫ ОПИСАН ВНЕШ ФАЙЛ');
i = 8: write('НЕПРАВ ПАРАМ ДЛЯ ВНЕШ ФАЙЛА');
i = 9: write('INРUТ∨ОUТРUТ НЕЛЬЗЯ');
i = 10: write('МЕТКИ И GОТО В ВRАNСН НЕЛЬЗЯ')
_end;
_);
'sexpr': _(
_select
i = 0: write('УНАРНЫЕ + - ТОЛЬКО ДЛЯ RЕАL ИЛИ ЦЙ');
i = 1: write('ДОЛЖНЫ БЫТЬ ТИПЫ RЕАL ИЛИ ЦЙ');
(i = 2)| (i = 3): write('ТРЕБУЮТСЯ ДРУГИЕ ТИПЫ ОПЕРАНДОВ')
_end
_)
_end
_);
(*=A0,c- code generation *)
_proced P3330;
_var i, j, ii, m:int; a: alfa;(*=c+*)
_proced varF1(a31:alfa);
_(
ГГ('F', a31);
write(':УИ15=15И1');
ГГ(a31);
write(',ЛУZ64=У');
_if (j _IN [13,15]) _then output@ := '0' _else output@ := '1';
put(output);
ГГ('O', a31);
write(',15ПА');
write(j:0);
write('=ПБМI,');
_if j = 15 _then
write('Э;ОРF:РО,ОGF:GI,ОRWF:RО,К;ОRF:16ПИ15=ПБRI,')
_else j := j+1
_);
_proced varF2(a31:alfa);
_(
ГГ('F', a31, ':12ПА', a31, '=14ПАО', a31);
write(icomma);
_if j = 25 _then
write('FW:УИ15=15И0FW(2),17СЧ=12ПБ,ЛУZ64=У0FW(4),17СЧ=14ПБ,15ПА21=ПБМI,')
_else ГГ('ПБFW=,');
j := j+1;
_);
_( (* P3330 *)
write('У;А1,К;');
_for i := 3 _to 8 _do _for j := 1 _to i-2 _do _(
a := rets[i,j];
_if a # O _then _(
ГГ(a);
write(icolon);
ii := i;
ГГ('13ПИ');
mapia(i, a);
ГГ(a);
_while ii >= j+2 _do _(
ГГ('=', a, 'СЧ2,УИ');
m := ii-1;
mapia(m, a);
ГГ(a);
ii := ii-1;
_);
ГГ('=16ПБ,')
_)
_);
_if extras[17] # O _then
% INS
write('IS:17СЧ=ИЗЧМ1,УМ11=11СД100,СРИА=17СМ-2,11СД100=17ЗЧ-2,15СР=17ЛУ,17СР=15ЗЧ,16ПБ=,');
_if modeX _then _(
ГГ('Э;Z1:');
_if extras[15] # UTC _then ГГ('Z8,') _else ГГ('Z1Z,');
write('ОРF:РО,ОGF:GI,ОRWF:RО,К;');
_) _else _(
i := 1;
_while i <= 16 _do _(
_if extras[i] # O _then _case i-1 _of
0: write('Э;СОС:ИА(1236),СОЯ:СОС(1),К;DS:14СЧ=УИ14,ВИ12=СР13,У0DS(6)=СЧСОС,14ЗЧ=ВИ12,14ЗЧ1=ВИ14,ЗЧСОС=16ПБ,СЧСОЯ=14ЗЧ,ВИ14=ЗЧСОЯ,16ПБ=,');
% Proc/func entry helpers
1,2,3,4,5,6:write('Z', i:0,':РА3=ВИ13,17ПИ13=17ПИ',i:0,',ВМ16=ВМ',(i-1):0,',13ЗЧ2=14ПБ,');
7: write('ПА:УИ15=15И0ПА(4),15СЧ=У1ПА(3),15СЧ1=ИА,УИ15=16ПБ,ЛУZ64=У0ПА(7),1ИА10=15ПА,16ПБ=,1ИА7=15ПА,16ПБ=,');
8: _( write('ВИ:УИ15=15И0ВИ(2),'); write('15СЧ2=16ПБ,ЛУZ64=16У0,СЧ13=16ПБ,') _);
% Basic routines for formal parameters-files
9: _( j := 12; varF1('РF'); varF1('GF');varF1('RWF');varF1('RF') _);
% Write routines for formal parameters-files
10: _( j := 20; varF1('WS'); varF2('WС');varF2('WА');varF2('WВ');varF2('WI');varF2('WR');varF1('WL')_);
% ROUND
11: write('АС:РА=15ПААС+2,15АС=ПБТR,Ч;0.5,К;');
12: write('ПБ:1ПИ15=16ПВRС,13СЧ1=СД117,СД37=У0Е,ПБЕF=,');
% BRANCH
13: write('ТОШ:17ЗЧ=16ПВRО,11СЧ=14ПВГГ,СЧ=17СМ-2,16ПВОWI=,16ПВРR=,1СЧLI=У076002,17СЧ=ПБВА,ЕА:ВМ15=1СМLI,17ПИ15=ВМ15,1ЗЧLI=РА3,16ПБ=,NА:ВИ15=1ИКLI,ЗЧ-1=16ПБ,FА:1ИКLI=17ПА-2,17СЧ2=1ЗЧLI,РА3=16ПБ,ВА:РА3=ВМ13,1АВLI=У1ВА1,ВА3:13СЧ1=СД117,17ЗЧ=14ПА77777,ВИ14=17ЛУ,У0ВА2=УИ14,14ИА=14ПВ,ВА2:13СЧ=УИ13,ВА6:1АВLI=У0ВА3,15ПАВА4=16ПВВА8,ВА7:1ИКLI=СЧ,У0ВА5=1ЗЧLI,ВИ13=ПБВА6,ВА5:15ПАВА9=16ПВ76005,ПБПБ=,А;ВА9:ВЫХОД
,ПО АLТ,С;3640000000000000,К;ВА8:17СЧ-1=15У0,1ИКLI=СР-2,15У0=1ИКLI,СЧ-2=15У0,16ПБ=,ВА4:ВИ13=14ПВRSR,ВА10:1ИКLI=17ПА1,17ИК-2=ПБ,ВА1:15ПАВА10=16ПВВА8,ПБВА7=,FАМ:16ПВFА=,15КЦFАМ=12ПБ,');
% Database procedures (OPEND, GETD, PUTD, etc.)
14: _( _if extras[15] = UTC _then write('Z1:РА3=СЧ5,') _else
write('ВDОШ:ЗЧ1=16ПИ15,16ПВ76005=,11ПАВDТ=ПБТОШ,А;ВDТ:ОШВD= ,К;ВD:ВИ4=11ЗЧ33,11ПИ4=15ИАВDVЕС,СЧ=4ЗЧ3,4ПБ2=,С;ВDVЕС:0,0,2512141131,26211511,221411,27231411,201411,К;Z1:РА3=СЧ6,СД66=УИ4,СД54=ЛС74014,ЗЧ2=Э0702,ИК5=СЧСЧ1,ЗЧ1=4ПИ5,ВИ4=ЗЧ5,5СА2000=ВИ5,4ЗЧ16=5СА2000,ВИ5=4ЗЧ17,5СА2000=СЧ1,5ЗЧ1=2ПАВDОШ,ВИ2=4ЗЧ11,ВИ5=,');
write('УИ1=1ПИ17,1ПИ13=15ПВRI,СЧ=1ЗЧLI,14ПИ16=ПБRО,');
_);
% Parameter count/type checking for formal parameters-routines
15: _(
write('ПВ:ВИ15=ВМ13,СД61=17ЛС,16ПБ=,ВП7:ВИ16=ВМ13,12СМ=СД117,17ЗЧ=12ИК,ПБ=,ВП6:17СЧ=УМ13,УИ16=16ПБ,ВП:17СИ11=11ПИ13,ВП1:12СЧ=У0ВП2,11СР3=У0ВП3,12СЧ=СР13,У1ВПШ=11СЧ3,СР');
ГГ(two);
write('=У0ВП4,СР13=У1ВПШ,17СА100=ВИ11,ВМ12=ВМ13,ВМ14=ВМ15,17ЗЧ=11ИА2,12ПА=12ИК,СЧ4=У1ВПШ,12СЧ=СД117,14ПВRSR=,12ИК=16ПВ,17СЧ=УМ15,УМ14=УМ13,УМ12=УИ11,17СЧ10=17СА-100,ПБВП5=,ВП4:11ИК2=СЧ,ВП5:13ЗЧ2=13СА1,12СА1=11СА2,ПБВП1=,ВП3:11СЧ2=ПБВП5,ВП2:11СЧ3=У1ВПШ,17СЧ=ПБRSR,ВПШ:17СЧ=14ПВRSR,11ПАВПТ=СЧ13,ПБТОШ=,А;ВПТ:ФПАРОШ,К;');
_)
_end; i := i+1
_);
_);
_);
_function getDate:alfa;
_var k:int;l:alfa;
_(
k:=00003777776Т;l:='3 1 ';
СОDЕ(Э050114=,2СБ4=2РБ5,СД120=2ЗЧ4,МР=СД70,2ЗЧ5=МР,2СМ5=СД140,17ЛС=2СМ4,СД60=17ЛС,);
getDate:=;
_);
_procedure printOct(v:alfa);
_(
code(=11ПА-17,qqq1:2СЧ3=СД/-3/,2ЗЧ3=МР,); output@:=;put(output);code(11КЦqqq1=)
_);
(*=c- L 2*)_procedure programme(_var a21:alfa; _var a22:idptr);
_label 26505, 26607, 26631, 27117, 27375, 27404, 27420;
_const (*=a1*)block='БЛОК';
arrow='@';dot='.';oparen='(';colon=':';semi=';';lt='<';gt='>';
star='*';slash='/';minus='-'; plus='+';eq='=';neq='#';qu='''';
comma=',';cparen=')'; obrack='[';cbrack=']';(*=a0*)
one='13';zero='12';e48=4T;
% for form1
fLD=3;fTRUNC=4;fNEG=6;fSUB=7;fZERO=8;fLDSTK=10;fLEA=11;fUVTM15=12;fVTM11=13;
fAU23=15;fORZ64=16;fIMUL=17;fTOREAL=18;fPSH=19;fMOD2=20;fADD1=21;fSUB1=22;
fCHKPARM=24;fWTC=25;fEMPTY=26;
fXTS=27;
% for form2
fLAB=0;fGOTO=1;fU1A=2;fUZA=3;fCMD=4;fBCALL=5;fVTM15=7;fBVTM15=8;fSTKOP=9;
fPUSH=10;fCALL=11;fFIXRT=12;fST11=14;fVJM14=15;fSETREG=16;fEQ=17;fMATH=19;
fMVSTK=20;fOVFL=22;fCALL1=23;
% for cmd
cLAB=0;cGOTO=1;call14=8;cLEA=11;call16=12;cCOPY=14;
_type oneinsn=_record next:@oneinsn; mode: int; ir, op, addr:alfa _end;
_var obj1, obj2, v23,v24, v25:idptr;
v26, v27, v28, v29, v2A, v2B, v2C:alfa;
v2D,v2E:int;
v2F, v2G:ekind; v2H, v2I:int;
v2J, isFunc:bool;
v2L, v2M, lhs, newConst:idptr;
v2P, v2Q:@labels; stLabs:pInst;
v2S, constOp, constVal: int;
v2V, v2W:alfa;
(*=c+*)
_function inverse(i:int):int;
_var v31:int;v32,v33:real;
_(
v31 := e48; v33 := i; v32 := 1.0;
code(PA3=3АД7,3АC5=ЦС13,); inverse:=;
_);
_procedure alfAdd(_var ret:alfa; val:int);
_var i:int;
_(
mapai(ret, i);
mapia(val+i, ret);
_);
(* L 3 *) _proced putSep; _(
_if leftInsn _then output@ := ieq _else output@ := icomma;
leftInsn := ~leftInsn;
curLab := O;
put(output);
_);
_proced putInsn(a31:alfa); _(
ГГ(a31);
putSep;
_);
(* L 3 *) _proced modBase; _(
_if modeX _then putInsn(BPUTC);
_);
(* L 3 *) _proced idxBase; _(
_if modeX _then ГГ(BP);
_);
_proced basInsn(a31:alfa); _(
idxBase;
putInsn(a31);
_);
_proced putIarg(a31, a32:alfa); _(
ГГ(a31, a32);
putSep;
_);
(* L 3 *) _proced putAlign(a31:alfa);
_(
ГГ(a31);
_if leftInsn _then write('=,')
_else _( write(icomma); leftInsn := T_);
curLab := O;
_);
(* L 3 *) _proced align;
_(
_if ~leftInsn _then _( write(icomma); leftInsn := ~leftInsn _)
_);
(* L 3 *) _proced setAUInt;
_(
_if curAU # 1 _then _( putInsn('РА7'); curAU := 1 _)
_);
(* L 3 *) _proced metka(a31:alfa);
_(
align;
ГГ(a31);
write(icolon);
setAUInt;
curLab := a31;
_);
(* L 3 *) _proced dump(K:pInst);
_const mask='070000';
_var T:alfa; N:pInst; _(
(q)_if K = _nil _then exit;
_with K@ _do _if nxt # _nil _then _(
_if (op = XTA) & ([email protected] = ATX) &
([email protected] = '17') & ([email protected] = O) _then _(
op := XTS;
_if m = O _then m := basReg;
N := nxt;
nxt := [email protected];
_) _else _if (([email protected] = WTC) | ([email protected] = UTC)) & (au # auANY) _then _(
N := nxt;
(loop) _while [email protected] # _nil _do _(
T := [email protected]@.op;
_if (T = UTC) | (T = WTC) _then N := [email protected]
_else _exit loop;
_);
[email protected] := au;
_);
dump(nxt);
_);(* 4017 *)
_case [email protected] _of
auANY:;
auINT: _if curAU # 1 _then _( putInsn('РА3'); curAU := 1 _);
auSETINT: curAU := 1;
auFL: _if curAU # 2 _then _( putInsn('РА'); curAU := 2 _);
auSETFL: curAU := 2
_end; (* 4050 *)
_if [email protected] = label _then
_if [email protected] # O _then metka([email protected]) _else _(
TNL(T);
align;
write('10ПВУРЕГ=,');
ГГ(T, ':10СА-');
putInsn(T);
_) _else _(
_if ([email protected] # O) _then ГГ([email protected]);
% There is a way to write the condition below without resorting to
% disabling type checking, by using unions and bit sets;
% it results in differences using const 0 in location 0 vs the constant pool.
_if (*=c-*)([email protected] & mask # 0) &
([email protected] & 77774T = 0) &
([email protected] & mask # mask) & (*=c+*)
([email protected] # UTM) &
([email protected] # UTC) &
([email protected] # WTC) _then _(
ГГ(UTC);
_if [email protected] # O _then putInsn([email protected]);
ГГ([email protected]);
_) _else _(
ГГ([email protected]);
_if [email protected] # O _then ГГ([email protected]);
_);
putSep;
_if ([email protected] = VJM) | ([email protected] = 'Э050') _then align;
_); (* 4141 *)
_);
(* L 3 *) _proced prErr(a31:alfa; a32:int);
_(
_if silent _then exit;
errMsg(a31, a32);
(*=a1 error messages *)
ГГ('***ОШ.', a31, '='); wrInt(a32);
ГГ(' СТР.='); wrInt(lineNum); ГГ('.NLЕХ='); wrInt(nLex);
ГГ('.ИД=', tok, '.СИМ=', prev);
writeln('.КОНТЕКСТ');
code(16ПВСТХТ=,);
errSeen := T;
errcnt := errcnt+1;
_if errcnt > maxerr _then _GOTO 27721;
_);
(* L 3 *) _proced error(a31:alfa; a32:int);
_(
silent := F;
prErr(a31, a32);
_GOTO 27721;
_);
(* L 3 *) _proced sysErr(n:int);
_(
error('SУS', n);
_);
(*=a0,c- L 3 *) _proced L4225(a31:int);
_var v31:alfa; v32:idptr; (*=c+*) _(
curLab := O;
_case a31 _of
1: _( ГГ('ПБЕ'); _if v2V # O _then ГГ('F')_);
0: _(
v32 := a22;
align;
_if level # '1' _then _(
mapai(level, a31);
extras[a31] := UTC;
_);
_if ~v2J _then write(istar);
ГГ([email protected]);
write(icolon);
MAPЯГА([email protected], v31);
_if (v31 = [email protected]) _then _(
write('10ПВУРЕГ=,10СА-');
ГГ([email protected]);
write('(1)=14ПВСН,');
_);
_if [email protected] = _NIL _then a31 := 3 _else a31 := 4;
v31 := ;
_if [email protected] > 1 _then _(
mapia(-([email protected]), v31);
mapai(level, a31);
_);
_select
[email protected] = 0: _( ГГ('14ПВZ'); putAlign(level); _);
[email protected] = 1: _( ГГ('17ЗЧ', v31, '=14ПВZ', level); write(icomma); _);
T: _(
write('ВМ13=17СА');
ГГ(v31);
write(',РА3=17ПИ13,17ПИ', a31:0, '=ВМ16,ВМ', (a31-1):0, '=13ЗЧ2,');
_)
_end;
MAPЯГА( [email protected], v31);
ГГ('`', v31, '`17СА', [email protected]);
curAU := 1;
_)
end;
putSep;
_);
(*=c- L 3 *) _proced cmd(a31:int; a32:alfa);
_label 4412, 4424, 4431;
_var v31:alfa; (*=c+*) _(
_if modeX _then _select
(a31 < 4): _if (a31 # 0) _then ГГ(BP);
(a31 = 11) | (a31 = 10) | (a31 = 8): putInsn(BPUTC)
_end;
_case a31 _of
cLAB: _(
align;
ГГ(a32);
write(icolon);
curLab := a32;
exit;
_);
cGOTO: _(
ГГ(UJ);
4412:
ГГ(a32);
_);
2: _(
ГГ('У1');
_goto 4412;
_);
3: _(
ГГ('У0');
_goto 4412;
_);
4,5,6,7,9: error(in, a31);
8: _(
ГГ('14ПВ');
4424:
putAlign(a32);
exit;
_);
10: _(
ГГ('12ПА');
_goto 4412;
_);
11: 4431: _(
ГГ('15ПА');
_goto 4412;
_);
12: _(
ГГ('16ПВ');
_goto 4424;
_);
13: _goto 4431;
cCOPY: _(
ГГ('15ПА-', a32); putSep; TNL(v31); metka(v31);
write('12ИА=15СЧ'); ГГ(a32); write(',16ИА=15ЗЧ'); ГГ(a32);
write(icomma);
_if modeX _then _( write('10ИА=15КЦ'); ГГ(v31); write(icomma); exit _)
_else _( ГГ('15КЦ', v31); _)
_)
_end;
putSep;
_);
(* L 3 *) _proced P4511(a31:int; a32, a33:alfa);
_(
_select
a31 = 5: _(
align; modBase;
ГГ('15ПА', a32); write('=ВИ15,СД'); ГГ(a33);
write('=13ЛС1,13ЗЧ1'); putSep;
_);
a31 = 6: _(
ГГ('12ПА-', a33); putSep; modBase;
ГГ('15ПА', a32); putSep; putAlign('14ПВГТ');
_);
T: ГГ('Э;', a32, icolon, a33, ',К;')
_end
_);
(*=c- L 3 *)_proced init;
_var i:int;
(*=c+*)
(* L 4 *) _proced preDecl(a41:alfa; _var a42:idptr);
_var v41:int; v42:idptr; _(
new(v42; lstoff); % predeclared objectsare made of same size 9
(*=c-*)mapai(a41 & '177', v41);(*=c+*)
v42@ := [a41, 0, idTable[v41], _NIL, 0, 1, 0];
idTable[v41] := v42; a42 := v42;
_);
(* L 4 *) _proced declConst(a41, a42:alfa);
_var v41:idptr; _(
preDecl(a41, v41);
[email protected] := cConst;
[email protected] := curId;
[email protected] := a42;
_);
(* L 4 *) _proced declStFun(name:alfa);
_var p:idptr; _(
new(p; fty);
(*=c-*)mapai(name & '177', i);(*=c+*)
p@ := [name, 0, idTable[i], , cFun, curId];
[email protected] := ptr(ival);
ival := ival+1;
idTable[i] := p;
_);
_( (* init *)
u4837z := 75B; u4838z := 313B;
i := 0;
_while i <= 127 _do _(
idTable[i] := _NIL;
idTabA[i] := _NIL;
i := i+1;
_);
modeA := 1; modeB := ; lineNum := ; level := ; modeC := ; leftInsn := ; needToken := ; modeM := ;
noDisplay := ;
modeR := ; modeP := ; modeT := ; curAU := ;
fname := spaces;
reqAU := 0; modeE := ; dynMem := ; nWith := ; lookup := ; nLex := ; extFcnt := ;
two := ; errSeen := ; silent := ; hasFiles := ; hasExtFiles := ; defSection := ; skipping := ; modeF := ; modeG := ;
modeV := ; modeS := ; funcHelper := ; gotoHelper := ; varHelper := ;
modeDe := ; modeCH := ; modeeL := ; octal := ; doOctal := ;
inInclude := ; modeL := ; unsigned := ; allowLong := ; modeX := ; basReg := ;
XTA := xxta;
endl := chr(175B);
extCnt := -1; entrCnt := ;
modeK := 100;
poolStart := ord(ref(pool[9]));
poolAddr := poolStart-9;
u47z := _NIL;
tchain := ;
curId := ;
curRec := ;
labList := ;
extFList := ;
errcnt := 0;
maxerr := 10;
nilOff := '11';
pool[9] := ord(_NIL);
pool[9+1] := 0;
pool[9+2] := 1;
poolIdx := 11;
(*=a1*) seqGOST := 'А';
MAPГA(seqGOST, seqITM);
TNL(seqITM);
i := 1;
_while i <= 17 _do _(
extras[i] := O;
i := i+1;
_);
(*=a0*)extras[15] := UTC;
i := 3;
_while i <= 8 _do _(
v2E := 1;
_while v2E <= i-2 _do _(
rets[i,v2E] := O;
v2E := v2E+1;
_);
i := i+1;
_);
(*=a1*)
preDecl('ВООLЕА', boolType);
preDecl('INТЕGЕ', intType);
preDecl('СНАR', charType);
preDecl(O, setType);
setType@ := [,,,intType,,,kSet];
preDecl('RЕАL', realType);
preDecl('00АLFА', alfaType);
preDecl('0УКNIL', ptrType);
[email protected] := kPtr;
curId := boolType;
declConst('FАLSЕ', zero);
declConst('ТRUЕ', one);
preDecl('ТЕХТ', textFile);
[email protected] := charType;
[email protected] := kFile;
[email protected] := 30;
[email protected] := 8;
preDecl('INРUТ', inFile);
[email protected] := cVar;
[email protected] := textFile;
[email protected] := '7';
preDecl('ОUТРUТ', outFile);
[email protected] := cVar;
[email protected] := textFile;
[email protected] := '10';
fwdProcList := intType;
curId := _NIL;
ival := 0;
declStFun('РUТ'); % 0
declStFun('GЕТ'); % 1
declStFun('RЕWRIТ'); % 2
declStFun('RЕSЕТ'); % 3
declStFun('NЕW'); % 4
declStFun('UNРСК'); % 5
declStFun('РСК'); % 6
declStFun('ЕХIТ'); % 7
declStFun('РRINТО'); % 8
declStFun('НАLТ'); % 9
declStFun('МАРIА'); % 10
declStFun('МАРАI'); % 11
declStFun('ТNL'); % 12
declStFun('ГГ'); % 13
declStFun('МАРГА'); % 14
declStFun('МАРЯГА'); % 15
declStFun('СОDЕ'); % 16
declStFun('SЕТUР'); % 17
declStFun('RОLLUР'); % 18
declStFun('WRIТЕ'); % 19
declStFun('WRIТЕL'); % 20
declStFun('DISРОS'); % 21
declStFun('RЕАD'); % 22
declStFun('RЕАDLN'); % 23
declStFun('ОРЕND'); % 24
declStFun('РUТD'); % 25
declStFun('GЕТD'); % 26
declStFun('DЕLD'); % 27
declStFun('МОDD'); % 28
declStFun('NЕWD'); % 29
declStFun('ВIND'); % 30
declStFun('INS'); % 31
ival := 0;
curId := realType;
declStFun('SQRТ'); % 0
declStFun('SIN'); % 1
declStFun('СОS'); % 2
declStFun('АRСТАN'); % 3
declStFun('АRСSIN'); % 4
declStFun('LN'); % 5
declStFun('ЕХР'); % 6
declStFun('АВS'); % 7
curId := intType;
declStFun('ТRUNС'); % 8
curId := boolType;
declStFun('ОDD'); % 9
curId := intType;
declStFun('ОRD'); % 10
curId := charType;
declStFun('СНR'); % 11
declStFun('SUСС'); % 12
declStFun('РRЕD'); % 13
curId := boolType;
declStFun('ЕОF'); % 14
curId := ptrType;
declStFun('RЕF'); % 15
declStFun('РТR'); % 16
curId := intType;
declStFun('SQR'); % 17
declStFun('RОUND'); % 18
declStFun('SЕL'); % 19
declStFun('САRD'); % 20
declStFun('МINЕL'); % 21
curId := boolType;
declStFun('ЕОLN'); % 22
declStFun('SНIFТ'); % 23
_);
(*=a0*)
(*=c- L 3 *) _function withSp(a31:alfa):alfa;
_var a:_array [0..12] _of char; i:int; (*=c+*)
_(
unpck(a[1], a31);
a31 := spaces;
unpck(a[7], a31);
i := 1;
_while i <= 6 _do _(
_if a[i] # chr(0) _then _(
pck(a[i], a31);
withSp := a31;
exit;
_);
i := i+1;
_)
_);
(* L 3 *) _proced orExp64(_var a31:int; _var a32:int);
_( code(=15ПА15,ВИ15=СД/4/,MP=3ИК3,ЛС=); a32 := ;
_);
(* L 3 *) _proced putConst(_var offset:alfa; force:bool);
_var i:int; _(
_if ~force _then _(
poolStart := poolStart;
code(=УИ5,);
i := 9-poolIdx;
code(=УИ4,);
cv := cv;
code(ЗЧ1=,find:СЧ1=5CP,У0done=5CA1,4КЦfind=);
_);
poolIdx := poolIdx+1;
_if poolIdx >= 4096 _then sysErr(23);
pool[poolIdx] := cv.i;
mapia(poolIdx, offset);
exit; code(done:ВИ5=);
i := ;
i := i-poolAddr;
mapia(i, offset);
_);
(* L 3 *) _proced forceName(arg:alfa);
_var dum:char; a: _array[1..12] _of char;
i:int; res:alfa; _(
unpck(a[6], arg);
i := 6;
_while a[i] = chr(0) _do i := i+1;
arg := spaces;
unpck(a[i-6], arg);
pck(a[6], res);
cv.a := res;
putConst(curOff, T);
_);
(* L 3 *) _proced putName(arg:alfa);
_var dum:char; a:_array [1..12] _of char;
i:int; res:alfa; _(
unpck(a[6], arg);
i := 6;
_while a[i] = chr(0) _do i := i+1;
arg := spaces;
unpck(a[i-6], arg);
pck(a[6], res);
cv.a := res;
putConst(curOff, F);
_);
(* L 3 *) _proced mkCheck(typ: idptr; inline:bool);
_var over, check, lo, span:alfa; _(
_if [email protected] = O _then _(
_if inline _then _(
TNL(over);
idxBase;
putIarg(UJ, over);
align;
_);
TNL(check);
metka(check);
basInsn('ЗЧ1');
[email protected] := check;
cv.i := [email protected];
putConst(lo, F);
cv.i := [email protected];
putConst(span, F);
idxBase; putIarg(SUB, lo);
putInsn('15У1');
idxBase; putIarg(RSUB, span);
putInsn('15У1');
basInsn('СЧ1');
putAlign('16ПБ');
_if (inline) _then metka(over);
_);
_);
(* L 3 *) _proced dumpNames(obj:idptr);
_var p:idptr; _(
_if [email protected] = O _then _(
p := [email protected];
forceName([email protected]);
[email protected] := curOff;
(loop) _(
p := [email protected];
_if p = _NIL _then exit;
forceName([email protected]);
_goto loop
_)
_)
_);
(*=c- L 3 *) _proced getT;
_label 6161, 6304, 6335, 6462;
_const max = 1000000000000;
_var v31:_array [0..12] _of char;
v3E, l3v15z:int;
l3v16z,
l3v17z:idptr;
l3v18z:bool;
l3v19z, l3v20z:real;
l3obj1z:alfa;
l3a21z: _array [1..20] _of char;
l3v42z, l3v43z:int;
(*=c+*)
(* L 4 *) _proced digraph(x, y:char);
_var c:char; _(
c := input@; get(input);
_if (input@ = x) _then _(
prev := y; get(input);
_) _else prev := c;
_);
(* L 4 *) _proced L5462(a41:int);
_( (*=a1*)
prErr('SСАN', a41);
_if a41 < 5 _then _(
_case a41 _of
0:;
1: ival := 1;
2, 3, 4: _(
_while input@ # qu _do get(input);
get(input);
_GOTO 6462;
_)
_end
_)
_); (*=a0*)
(* L 4 *) _proced readZone(nuz:int);
_(
nuz := 001034T+nuz; code(4Э0703=,)
_);
_proced closeFile; _var p:@int; _(
lineNum := savedNum;
p := ref(stdin);
code(=УИ11,11СЧ=ЗЧ75211,11СЧ1=ЗЧ75212,11СЧ2=ЗЧ74221,ЦC75211=17ЗЧ1,17Э0701=,11СЧ3=ЗЧ74220,11СЧ4=ЗЧ75225,ИК75225=СЧ,ЗЧ74217=СЧ74215,17ЗЧ1=CP74220,У1qne=СЧ75225,УИ15=15СЧ-1,ЛУ74330=);
input@ := ;
exit;
code(qne:СЧ74217=СД/-10/,ЗЧ74217=MP,);
input@ := ;
code(=17СЧ1,СД/1/=17ЗЧ1,CP74220=У1qne,);
_);
(* L 4 *) _proced setFile(a41, a42:int);
_var v41:int; _(
v41 := 001034T;
code(=4цс3,зч75211=4сч4,ав13=зч75212,)
_);
(* L 4 *) _proced openFile;
_var nuz, v42, v43 : int; v44: alfa;
_(
%stdin[0] : = *75211;
%stdin[1] : = *75212;
%stdin[2] : = *74221;
%stdin[3] : = *74220;
%stdin[4] : = *75225;
code(=сч75211,1зч135=сч75212,1зч136=сч74221,1зч137=сч74220,1зч140=сч75225,1зч141=);
savedNum := lineNum;
lineNum := 1;
readZone(270037C);
code(сч71776=СД/-36/,СД/36/=);
nuz := ;
readZone(nuz);
code(11ПА70001=12ПА77600,L5601:11СЧ=);
v44 :=;
_if v44 = fname _then _(
code(=11СЧ1,СД/30/=4ЗЧ4,MP=СД/30/,4ЗЧ5=);
setFile(v42+nuz, v43);
reset(input);
exit;
_);
code(11CA2=12КЦL5601,);
fatal(4);
_);
(* L 4 *) _proced escChar;
_var i:int; _(
get(input);
_if input@ > '3' _then L5462(2);
ival := ord(input@);
i := 1;
_while i <= 2 _do _(
get(input);
_if input@ > '7' _then _(
L5462(3);
exit;
_);
(*=m-*)ival := ord(input@)+ival*8;
i := i+1;
_);
input@ := chr(ival);
_);
(* L 4 *) _proced getId;
_var t:alfa; i:int; _(
t := O;
i := 1;
_while (input@ _in letter) | (ord(input@) < 10) _do _(
_if i < 7 _then _(
i := i+1;
code(4СЧ3=СД/-10/,1ЛС7=4ЗЧ3,) (* t := (t << 8) | input@ *)
_);
get(input);
_);
tok := t;
_);
(* L 4 *) _proced skipSp;
_(
_while (input@ = sp) | (input@ > asg) _do get(input);
_);
(* L 4 *) _proced skipComment;
_label 5704;
_var c:char; _(
5704:
c := input@;
_if c = chr(172B) _then fatal(3);
get(input);
_select
(c = star) & (input@ = cparen): _( get(input); exit _);
(c = oparen) & (input@ = star): _( get(input); skipComment _);
c = endl : _( lineNum := lineNum+1; nLex := 0 _)
_end;
_goto 5704
_);
(* L 4 *)_proced doComment;
_var bad:bool;
(* L 5 *) _proced intRange(_var res:int; lim:int);
_(
get(input);
res := 0;
bad := T;