WebSVN – Kolibri OS – Blame – /programs/develop/oberon07/Source/PARS.ob07

Rev	Author	Line No.	Line
7597	akron1	1	(*
		2	BSD 2-Clause License
		3
		4	Copyright (c) 2018, 2019, Anton Krotov
		5	All rights reserved.
		6	*)
		7
		8	MODULE PARS;
		9
		10	IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, CODE, CONSOLE, PATHS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS;
		11
		12
		13	CONST
		14
		15	eCONST* = 1; eTYPE* = 2; eVAR* = 3; eEXPR* = 4;
		16	eVREC* = 5; ePROC* = 6; eVPAR* = 7; ePARAM* = 8;
		17	eSTPROC* = 9; eSTFUNC* = 10; eSYSFUNC* = 11; eSYSPROC* = 12;
		18	eIMP* = 13;
		19
		20
		21	TYPE
		22
		23	PATH* = PATHS.PATH;
		24
		25	PARSER* = POINTER TO rPARSER;
		26
		27	EXPR* = RECORD
		28
		29	obj*: INTEGER;
		30	type*: PROG.TYPE_;
		31	value*: ARITH.VALUE;
		32	stproc*: INTEGER;
		33	readOnly*: BOOLEAN;
		34	ident*: PROG.IDENT
		35
		36	END;
		37
		38	STATPROC = PROCEDURE (parser: PARSER);
		39	EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR);
		40	RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN;
		41
		42	rPARSER = RECORD (C.ITEM)
		43
		44	fname*: PATH;
		45	path: PATH;
		46	lib_path: PATH;
		47	ext: PATH;
		48	modname: PATH;
		49	scanner: SCAN.SCANNER;
		50	lex*: SCAN.LEX;
		51	sym*: INTEGER;
		52	unit*: PROG.UNIT;
		53	constexp*: BOOLEAN;
		54	main*: BOOLEAN;
		55
		56	open*: PROCEDURE (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;
		57	parse*: PROCEDURE (parser: PARSER);
		58	StatSeq*: STATPROC;
		59	expression*: EXPRPROC;
		60	designator*: EXPRPROC;
		61	chkreturn: RETPROC;
		62
		63	create*: PROCEDURE (path, lib_path: PATH; StatSeq: STATPROC; expression, designator: EXPRPROC; chkreturn: RETPROC): PARSER
		64
		65	END;
		66
		67
		68	VAR
		69
		70	program*: PROG.PROGRAM;
		71
		72	parsers: C.COLLECTION;
		73
		74
		75	PROCEDURE destroy* (VAR parser: PARSER);
		76	BEGIN
		77	IF parser.scanner # NIL THEN
		78	SCAN.close(parser.scanner)
		79	END;
		80
		81	C.push(parsers, parser);
		82	parser := NIL
		83	END destroy;
		84
		85
		86	PROCEDURE error* (parser: PARSER; pos: SCAN.POSITION; errno: INTEGER);
		87	BEGIN
		88	ERRORS.errormsg(parser.fname, pos.line, pos.col, errno)
		89	END error;
		90
		91
		92	PROCEDURE check* (condition: BOOLEAN; parser: PARSER; pos: SCAN.POSITION; errno: INTEGER);
		93	BEGIN
		94	IF ~condition THEN
		95	error(parser, pos, errno)
		96	END
		97	END check;
		98
		99
		100	PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER);
		101	BEGIN
		102	IF ~condition THEN
		103	error(parser, parser.lex.pos, errno)
		104	END
		105	END check1;
		106
		107
		108	PROCEDURE getpos (parser: PARSER; VAR pos: SCAN.POSITION);
		109	BEGIN
		110	pos := parser.lex.pos
		111	END getpos;
		112
		113
		114	PROCEDURE Next* (parser: PARSER);
		115	VAR
		116	errno: INTEGER;
		117
		118	BEGIN
		119	SCAN.Next(parser.scanner, parser.lex);
		120	errno := parser.lex.error;
		121	IF errno # 0 THEN
		122	check1(FALSE, parser, errno)
		123	END;
		124	parser.sym := parser.lex.sym
		125	END Next;
		126
		127
		128	PROCEDURE NextPos* (parser: PARSER; VAR pos: SCAN.POSITION);
		129	BEGIN
		130	Next(parser);
		131	pos := parser.lex.pos
		132	END NextPos;
		133
		134
		135	PROCEDURE checklex* (parser: PARSER; sym: INTEGER);
		136	VAR
		137	err: INTEGER;
		138
		139	BEGIN
		140
		141	IF parser.sym # sym THEN
		142
		143	CASE sym OF
		144	\|SCAN.lxCOMMA: err := 65
		145	\|SCAN.lxRROUND: err := 33
		146	\|SCAN.lxPOINT: err := 26
		147	\|SCAN.lxIDENT: err := 22
		148	\|SCAN.lxRSQUARE: err := 71
		149	\|SCAN.lxRCURLY: err := 35
		150	\|SCAN.lxUNDEF: err := 34
		151	\|SCAN.lxTHEN: err := 88
		152	\|SCAN.lxEND: err := 27
		153	\|SCAN.lxDO: err := 89
		154	\|SCAN.lxUNTIL: err := 90
		155	\|SCAN.lxCOLON: err := 53
		156	\|SCAN.lxOF: err := 67
		157	\|SCAN.lxASSIGN: err := 96
		158	\|SCAN.lxTO: err := 57
		159	\|SCAN.lxLROUND: err := 64
		160	\|SCAN.lxEQ: err := 32
		161	\|SCAN.lxSEMI: err := 24
		162	\|SCAN.lxRETURN: err := 38
		163	\|SCAN.lxMODULE: err := 21
		164	\|SCAN.lxSTRING: err := 66
		165	END;
		166
		167	check1(FALSE, parser, err)
		168	END
		169	END checklex;
		170
		171
		172	PROCEDURE ExpectSym* (parser: PARSER; sym: INTEGER);
		173	BEGIN
		174	Next(parser);
		175	checklex(parser, sym)
		176	END ExpectSym;
		177
		178
		179	PROCEDURE ImportList (parser: PARSER);
		180	VAR
		181	name: SCAN.IDENT;
		182	parser2: PARSER;
		183	pos: SCAN.POSITION;
		184	alias: BOOLEAN;
		185	unit: PROG.UNIT;
		186	ident: PROG.IDENT;
		187	units: PROG.UNITS;
		188
		189	BEGIN
		190	units := program.units;
		191
		192	alias := FALSE;
		193
		194	REPEAT
		195
		196	ExpectSym(parser, SCAN.lxIDENT);
		197	name := parser.lex.ident;
		198
		199	getpos(parser, pos);
		200
		201	IF ~alias THEN
		202	ident := parser.unit.idents.add(parser.unit, name, PROG.idMODULE);
		203	check(ident # NIL, parser, pos, 30)
		204	END;
		205
		206	Next(parser);
		207
		208	IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
		209	alias := FALSE;
		210	unit := units.get(units, name);
		211
		212	IF unit # NIL THEN
		213	check(unit.closed, parser, pos, 31)
		214	ELSE
		215	parser2 := parser.create(parser.path, parser.lib_path,
		216	parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
		217
		218	IF ~parser2.open(parser2, name.s) THEN
		219	IF parser.path # parser.lib_path THEN
		220	destroy(parser2);
		221	parser2 := parser.create(parser.lib_path, parser.lib_path,
		222	parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
		223	check(parser2.open(parser2, name.s), parser, pos, 29)
		224	ELSE
		225	check(FALSE, parser, pos, 29)
		226	END
		227	END;
		228
		229	parser2.parse(parser2);
		230	unit := parser2.unit;
		231	destroy(parser2)
		232	END;
		233	IF unit = program.sysunit THEN
		234	parser.unit.sysimport := TRUE
		235	END;
		236	ident.unit := unit
		237
		238	ELSIF parser.sym = SCAN.lxASSIGN THEN
		239	alias := TRUE
		240
		241	ELSE
		242	check1(FALSE, parser, 28)
		243	END
		244
		245	UNTIL parser.sym = SCAN.lxSEMI;
		246
		247	Next(parser)
		248
		249	END ImportList;
		250
		251
		252	PROCEDURE QIdent (parser: PARSER; forward: BOOLEAN): PROG.IDENT;
		253	VAR
		254	ident: PROG.IDENT;
		255	unit: PROG.UNIT;
		256
		257	BEGIN
		258	ASSERT(parser.sym = SCAN.lxIDENT);
		259
		260	ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE);
		261
		262	IF ~forward THEN
		263	check1(ident # NIL, parser, 48)
		264	END;
		265
		266	IF (ident # NIL) & (ident.typ = PROG.idMODULE) THEN
		267	unit := ident.unit;
		268	ExpectSym(parser, SCAN.lxPOINT);
		269	ExpectSym(parser, SCAN.lxIDENT);
		270	ident := unit.idents.get(unit, parser.lex.ident, FALSE);
		271	check1((ident # NIL) & ident.export, parser, 48)
		272	END
		273
		274	RETURN ident
		275	END QIdent;
		276
		277
		278	PROCEDURE strcmp* (VAR v: ARITH.VALUE; v2: ARITH.VALUE; operator: INTEGER);
		279	VAR
		280	str: SCAN.LEXSTR;
		281	string1, string2: SCAN.IDENT;
		282	bool: BOOLEAN;
		283
		284	BEGIN
		285
		286	IF v.typ = ARITH.tCHAR THEN
		287	ASSERT(v2.typ = ARITH.tSTRING);
		288	ARITH.charToStr(v, str);
		289	string1 := SCAN.enterid(str);
		290	string2 := v2.string(SCAN.IDENT)
		291	END;
		292
		293	IF v2.typ = ARITH.tCHAR THEN
		294	ASSERT(v.typ = ARITH.tSTRING);
		295	ARITH.charToStr(v2, str);
		296	string2 := SCAN.enterid(str);
		297	string1 := v.string(SCAN.IDENT)
		298	END;
		299
		300	IF v.typ = v2.typ THEN
		301	string1 := v.string(SCAN.IDENT);
		302	string2 := v2.string(SCAN.IDENT)
		303	END;
		304
		305	CASE operator OF
		306	\|SCAN.lxEQ: bool := string1.s = string2.s
		307	\|SCAN.lxNE: bool := string1.s # string2.s
		308	\|SCAN.lxLT: bool := string1.s < string2.s
		309	\|SCAN.lxGT: bool := string1.s > string2.s
		310	\|SCAN.lxLE: bool := string1.s <= string2.s
		311	\|SCAN.lxGE: bool := string1.s >= string2.s
		312	END;
		313
		314	ARITH.setbool(v, bool)
		315
		316	END strcmp;
		317
		318
		319	PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE);
		320	VAR
		321	e: EXPR;
		322	pos: SCAN.POSITION;
		323
		324	BEGIN
		325	getpos(parser, pos);
		326	parser.constexp := TRUE;
		327	parser.expression(parser, e);
		328	parser.constexp := FALSE;
		329	check(e.obj = eCONST, parser, pos, 62);
		330	v := e.value
		331	END ConstExpression;
		332
		333
		334	PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_);
		335	VAR
		336	name: SCAN.IDENT;
		337	export: BOOLEAN;
		338	pos: SCAN.POSITION;
		339
		340	BEGIN
		341	ASSERT(parser.sym = SCAN.lxIDENT);
		342
		343	WHILE parser.sym = SCAN.lxIDENT DO
		344
		345	getpos(parser, pos);
		346
		347	name := parser.lex.ident;
		348
		349	Next(parser);
		350
		351	export := parser.sym = SCAN.lxMUL;
		352
		353	IF export THEN
		354	check1(parser.unit.scopeLvl = 0, parser, 61);
		355	Next(parser)
		356	END;
		357
		358	check(rec.fields.add(rec, name, export), parser, pos, 30);
		359
		360	IF parser.sym = SCAN.lxCOMMA THEN
		361	ExpectSym(parser, SCAN.lxIDENT)
		362	ELSE
		363	checklex(parser, SCAN.lxCOLON)
		364	END
		365
		366	END
		367
		368	END FieldList;
		369
		370
		371	PROCEDURE FormalParameters (parser: PARSER; type: PROG.TYPE_);
		372	VAR
		373	ident: PROG.IDENT;
		374
		375
		376	PROCEDURE FPSection (parser: PARSER; type: PROG.TYPE_);
		377	VAR
		378	ident: PROG.IDENT;
		379	exit: BOOLEAN;
		380	vPar: BOOLEAN;
		381	dim: INTEGER;
		382	t0, t1: PROG.TYPE_;
		383
		384	BEGIN
		385	vPar := parser.sym = SCAN.lxVAR;
		386	IF vPar THEN
		387	Next(parser)
		388	END;
		389
		390	checklex(parser, SCAN.lxIDENT);
		391	exit := FALSE;
		392
		393	WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO
		394	check1(type.params.add(type, parser.lex.ident, vPar), parser, 30);
		395	Next(parser);
		396	IF parser.sym = SCAN.lxCOMMA THEN
		397	ExpectSym(parser, SCAN.lxIDENT)
		398	ELSIF parser.sym = SCAN.lxCOLON THEN
		399	Next(parser);
		400	dim := 0;
		401	WHILE parser.sym = SCAN.lxARRAY DO
		402	INC(dim);
		403	check1(dim <= PROG.MAXARRDIM, parser, 84);
		404	ExpectSym(parser, SCAN.lxOF);
		405	Next(parser)
		406	END;
		407	checklex(parser, SCAN.lxIDENT);
		408	ident := QIdent(parser, FALSE);
		409	check1(ident.typ = PROG.idTYPE, parser, 68);
		410
		411	t0 := ident.type;
		412	t1 := t0;
		413
		414	WHILE dim > 0 DO
		415	t1 := program.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
		416	t1.base := t0;
		417	t0 := t1;
		418	DEC(dim)
		419	END;
		420
		421	type.params.set(type, t1);
		422	Next(parser);
		423	exit := TRUE
		424	ELSE
		425	checklex(parser, SCAN.lxCOLON)
		426	END
		427	END
		428
		429	END FPSection;
		430
		431
		432	BEGIN
		433	IF parser.sym = SCAN.lxLROUND THEN
		434
		435	Next(parser);
		436
		437	IF (parser.sym = SCAN.lxVAR) OR (parser.sym = SCAN.lxIDENT) THEN
		438	FPSection(parser, type);
		439	WHILE parser.sym = SCAN.lxSEMI DO
		440	Next(parser);
		441	FPSection(parser, type)
		442	END
		443	END;
		444
		445	checklex(parser, SCAN.lxRROUND);
		446	Next(parser);
		447
		448	IF parser.sym = SCAN.lxCOLON THEN
		449	ExpectSym(parser, SCAN.lxIDENT);
		450	ident := QIdent(parser, FALSE);
		451	check1(ident.typ = PROG.idTYPE, parser, 68);
		452	check1((ident.type.typ # PROG.tRECORD) & (ident.type.typ # PROG.tARRAY), parser, 69);
		453	check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113);
		454	type.base := ident.type;
		455	Next(parser)
		456	ELSE
		457	type.base := NIL
		458	END
		459
		460	END
		461	END FormalParameters;
		462
		463
		464	PROCEDURE sysflag (parser: PARSER): INTEGER;
		465	VAR
		466	res: INTEGER;
		467
		468	BEGIN
		469	IF parser.lex.s = "stdcall" THEN
		470	res := PROG.stdcall
		471	ELSIF parser.lex.s = "stdcall64" THEN
		472	res := PROG.stdcall64
		473	ELSIF parser.lex.s = "ccall" THEN
		474	res := PROG.ccall
		475	ELSIF parser.lex.s = "ccall16" THEN
		476	res := PROG.ccall16
		477	ELSIF parser.lex.s = "win64" THEN
		478	res := PROG.win64
		479	ELSIF parser.lex.s = "systemv" THEN
		480	res := PROG.systemv
		481	ELSIF parser.lex.s = "windows" THEN
		482	IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
		483	res := PROG.stdcall
		484	ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
		485	res := PROG.win64
		486	ELSE
		487	check1(FALSE, parser, 118)
		488	END
		489	ELSIF parser.lex.s = "linux" THEN
		490	IF program.target.sys = mConst.Target_iELF32 THEN
		491	res := PROG.ccall16
		492	ELSIF program.target.sys = mConst.Target_iELF64 THEN
		493	res := PROG.systemv
		494	ELSE
		495	check1(FALSE, parser, 119)
		496	END
		497	ELSIF parser.lex.s = "noalign" THEN
		498	res := PROG.noalign
		499	ELSE
		500	res := 0
		501	END
		502
		503	RETURN res
		504	END sysflag;
		505
		506
		507	PROCEDURE procflag (parser: PARSER; VAR import: CODE.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
		508	VAR
		509	call: INTEGER;
		510	dll, proc: SCAN.LEXSTR;
		511	pos: SCAN.POSITION;
		512
		513	BEGIN
		514
		515	import := NIL;
		516
		517	IF parser.sym = SCAN.lxLSQUARE THEN
		518	getpos(parser, pos);
		519	check1(parser.unit.sysimport, parser, 54);
		520	Next(parser);
		521	call := sysflag(parser);
		522	IF program.target.bit_depth = 64 THEN
		523	check1(call IN PROG.callconv64, parser, 117)
		524	ELSIF program.target.bit_depth = 32 THEN
		525	check1(call IN PROG.callconv32, parser, 63)
		526	END;
		527	Next(parser);
		528	IF parser.sym = SCAN.lxMINUS THEN
		529	Next(parser);
		530	INC(call)
		531	END;
		532	IF ~isProc THEN
		533	checklex(parser, SCAN.lxRSQUARE)
		534	END;
		535	IF parser.sym = SCAN.lxCOMMA THEN
		536	ExpectSym(parser, SCAN.lxSTRING);
		537	dll := parser.lex.s;
		538	ExpectSym(parser, SCAN.lxCOMMA);
		539	ExpectSym(parser, SCAN.lxSTRING);
		540	proc := parser.lex.s;
		541	Next(parser);
		542	import := CODE.AddImp(dll, proc)
		543	END;
		544	checklex(parser, SCAN.lxRSQUARE);
		545	Next(parser)
		546	ELSE
		547	IF program.target.bit_depth = 32 THEN
		548	call := PROG.default
		549	ELSIF program.target.bit_depth = 64 THEN
		550	call := PROG.default64
		551	END
		552	END;
		553
		554	IF import # NIL THEN
		555	check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64}), parser, pos, 70)
		556	END
		557
		558	RETURN call
		559	END procflag;
		560
		561
		562	PROCEDURE type (parser: PARSER; VAR t: PROG.TYPE_; flags: SET);
		563	CONST
		564	comma = 0;
		565	closed = 1;
		566	forward = 2;
		567
		568	VAR
		569	arrLen: ARITH.VALUE;
		570	typeSize: ARITH.VALUE;
		571	ident: PROG.IDENT;
		572	unit: PROG.UNIT;
		573	pos, pos2: SCAN.POSITION;
		574	fieldType: PROG.TYPE_;
		575	baseIdent: SCAN.IDENT;
		576	a, b: INTEGER;
		577	RecFlag: INTEGER;
		578	import: CODE.IMPORT_PROC;
		579
		580	BEGIN
		581	unit := parser.unit;
		582	t := NIL;
		583
		584	IF parser.sym = SCAN.lxIDENT THEN
		585	ident := QIdent(parser, forward IN flags);
		586
		587	IF ident # NIL THEN
		588	check1(ident.typ = PROG.idTYPE, parser, 49);
		589	t := ident.type;
		590	check1(t # NIL, parser, 50);
		591	IF closed IN flags THEN
		592	check1(t.closed, parser, 50)
		593	END
		594	END;
		595
		596	Next(parser)
		597
		598	ELSIF (parser.sym = SCAN.lxARRAY) OR ((parser.sym = SCAN.lxCOMMA) & (comma IN flags)) THEN
		599
		600	IF parser.sym = SCAN.lxARRAY THEN
		601	getpos(parser, pos2)
		602	END;
		603	NextPos(parser, pos);
		604
		605	ConstExpression(parser, arrLen);
		606
		607	check(arrLen.typ = ARITH.tINTEGER, parser, pos, 43);
		608	check(ARITH.check(arrLen), parser, pos, 39);
		609	check(ARITH.getInt(arrLen) > 0, parser, pos, 51);
		610
		611	t := program.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
		612
		613	IF parser.sym = SCAN.lxCOMMA THEN
		614	type(parser, t.base, {comma, closed})
		615	ELSIF parser.sym = SCAN.lxOF THEN
		616	Next(parser);
		617	type(parser, t.base, {closed})
		618	ELSE
		619	check1(FALSE, parser, 47)
		620	END;
		621
		622	t.align := t.base.align;
		623
		624	a := t.length;
		625	b := t.base.size;
		626	check(ARITH.mulInt(a, b), parser, pos2, 104);
		627	check(ARITH.setInt(typeSize, a), parser, pos2, 104);
		628	t.size := a;
		629
		630	t.closed := TRUE
		631
		632	ELSIF parser.sym = SCAN.lxRECORD THEN
		633	getpos(parser, pos2);
		634	Next(parser);
		635
		636	t := program.enterType(program, PROG.tRECORD, 0, 0, unit);
		637	t.align := 1;
		638
		639	IF parser.sym = SCAN.lxLSQUARE THEN
		640	check1(parser.unit.sysimport, parser, 54);
		641	Next(parser);
		642	RecFlag := sysflag(parser);
		643	IF RecFlag = PROG.noalign THEN
		644	t.noalign := TRUE
		645	ELSE
		646	check1(FALSE, parser, 110)
		647	END;
		648
		649	ExpectSym(parser, SCAN.lxRSQUARE);
		650	Next(parser)
		651	END;
		652
		653	IF parser.sym = SCAN.lxLROUND THEN
		654	check1(~t.noalign, parser, 111);
		655	ExpectSym(parser, SCAN.lxIDENT);
		656	getpos(parser, pos);
		657
		658	type(parser, t.base, {closed});
		659
		660	check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, parser, pos, 52);
		661
		662	IF t.base.typ = PROG.tPOINTER THEN
		663	t.base := t.base.base;
		664	check(t.base # NIL, parser, pos, 55)
		665	END;
		666
		667	check(~t.base.noalign, parser, pos, 112);
		668
		669	checklex(parser, SCAN.lxRROUND);
		670	Next(parser);
		671
		672	t.size := t.base.size;
		673	IF t.base.align > t.align THEN
		674	t.align := t.base.align
		675	END
		676	ELSE
		677	t.base := program.stTypes.tANYREC
		678	END;
		679
		680	WHILE parser.sym = SCAN.lxIDENT DO
		681	FieldList(parser, t);
		682
		683	ASSERT(parser.sym = SCAN.lxCOLON);
		684	Next(parser);
		685
		686	type(parser, fieldType, {closed});
		687	check(t.fields.set(t, fieldType), parser, pos2, 104);
		688
		689	IF (fieldType.align > t.align) & ~t.noalign THEN
		690	t.align := fieldType.align
		691	END;
		692
		693	IF parser.sym = SCAN.lxSEMI THEN
		694	ExpectSym(parser, SCAN.lxIDENT)
		695	ELSE
		696	checklex(parser, SCAN.lxEND)
		697	END
		698	END;
		699
		700	t.closed := TRUE;
		701
		702	CODE.AddRec(t.base.num);
		703
		704	IF ~t.noalign THEN
		705	check(MACHINE.Align(t.size, t.align), parser, pos2, 104);
		706	check(ARITH.setInt(typeSize, t.size), parser, pos2, 104)
		707	END;
		708
		709	checklex(parser, SCAN.lxEND);
		710	Next(parser)
		711
		712	ELSIF parser.sym = SCAN.lxPOINTER THEN
		713	ExpectSym(parser, SCAN.lxTO);
		714	Next(parser);
		715
		716	t := program.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit);
		717	t.align := program.target.adr;
		718
		719	getpos(parser, pos);
		720
		721	IF parser.sym = SCAN.lxIDENT THEN
		722	baseIdent := parser.lex.ident
		723	END;
		724
		725	type(parser, t.base, {forward});
		726
		727	IF t.base # NIL THEN
		728	check(t.base.typ = PROG.tRECORD, parser, pos, 58)
		729	ELSE
		730	unit.pointers.add(unit, t, baseIdent, pos)
		731	END
		732
		733	ELSIF parser.sym = SCAN.lxPROCEDURE THEN
		734	NextPos(parser, pos);
		735	t := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
		736	t.align := program.target.adr;
		737	t.call := procflag(parser, import, FALSE);
		738	FormalParameters(parser, t)
		739	ELSE
		740	check1(FALSE, parser, 49)
		741	END
		742
		743	END type;
		744
		745
		746	PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT;
		747	VAR
		748	ident: PROG.IDENT;
		749	pos: SCAN.POSITION;
		750
		751	BEGIN
		752	ASSERT(parser.sym = SCAN.lxIDENT);
		753
		754	name := parser.lex.ident;
		755	getpos(parser, pos);
		756	ident := parser.unit.idents.add(parser.unit, name, typ);
		757	check(ident # NIL, parser, pos, 30);
		758	ident.pos := pos;
		759	Next(parser);
		760
		761	IF parser.sym = SCAN.lxMUL THEN
		762	check1(ident.global, parser, 61);
		763	ident.export := TRUE;
		764	Next(parser)
		765	END
		766
		767	RETURN ident
		768	END IdentDef;
		769
		770
		771	PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN);
		772	VAR
		773	ident: PROG.IDENT;
		774	name: SCAN.IDENT;
		775	pos: SCAN.POSITION;
		776
		777	BEGIN
		778	IF const THEN
		779	ident := IdentDef(parser, PROG.idNONE, name)
		780	ELSE
		781	ident := IdentDef(parser, PROG.idTYPE, name)
		782	END;
		783
		784	checklex(parser, SCAN.lxEQ);
		785	NextPos(parser, pos);
		786
		787	IF const THEN
		788	ConstExpression(parser, ident.value);
		789	IF ident.value.typ = ARITH.tINTEGER THEN
		790	check(ARITH.check(ident.value), parser, pos, 39)
		791	ELSIF ident.value.typ = ARITH.tREAL THEN
		792	check(ARITH.check(ident.value), parser, pos, 40)
		793	END;
		794	ident.typ := PROG.idCONST;
		795	ident.type := program.getType(program, ident.value.typ)
		796	ELSE
		797	type(parser, ident.type, {})
		798	END;
		799
		800	checklex(parser, SCAN.lxSEMI);
		801	Next(parser)
		802
		803	END ConstTypeDeclaration;
		804
		805
		806	PROCEDURE VarDeclaration (parser: PARSER);
		807	VAR
		808	ident: PROG.IDENT;
		809	name: SCAN.IDENT;
		810	t: PROG.TYPE_;
		811
		812	BEGIN
		813
		814	REPEAT
		815	ident := IdentDef(parser, PROG.idVAR, name);
		816
		817	IF parser.sym = SCAN.lxCOMMA THEN
		818	ExpectSym(parser, SCAN.lxIDENT)
		819	ELSIF parser.sym = SCAN.lxCOLON THEN
		820	Next(parser);
		821	type(parser, t, {});
		822	parser.unit.setvars(parser.unit, t);
		823	checklex(parser, SCAN.lxSEMI);
		824	Next(parser)
		825	ELSE
		826	checklex(parser, SCAN.lxCOLON)
		827	END
		828
		829	UNTIL parser.sym # SCAN.lxIDENT
		830
		831	END VarDeclaration;
		832
		833
		834	PROCEDURE DeclarationSequence (parser: PARSER): BOOLEAN;
		835	VAR
		836	ptr: PROG.FRWPTR;
		837	endmod: BOOLEAN;
		838
		839
		840	PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN;
		841	VAR
		842	proc: PROG.IDENT;
		843	endname,
		844	name: SCAN.IDENT;
		845	param: LISTS.ITEM;
		846	unit: PROG.UNIT;
		847	ident: PROG.IDENT;
		848	e: EXPR;
		849	pos: SCAN.POSITION;
		850	label: INTEGER;
		851	enter: CODE.COMMAND;
		852	call: INTEGER;
		853	t: PROG.TYPE_;
		854	import: CODE.IMPORT_PROC;
		855	endmod, b: BOOLEAN;
		856	fparams: SET;
		857	variables: LISTS.LIST;
		858	int, flt: INTEGER;
		859
		860	BEGIN
		861	endmod := FALSE;
		862
		863	unit := parser.unit;
		864
		865	call := procflag(parser, import, TRUE);
		866
		867	getpos(parser, pos);
		868	checklex(parser, SCAN.lxIDENT);
		869
		870	IF import # NIL THEN
		871	proc := IdentDef(parser, PROG.idIMP, name);
		872	proc.import := import;
		873	program.procs.last(PROG.PROC).import := import
		874	ELSE
		875	proc := IdentDef(parser, PROG.idPROC, name)
		876	END;
		877
		878	check(unit.scope.open(unit, proc.proc), parser, pos, 116);
		879
		880	proc.type := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
		881	t := proc.type;
		882	t.align := program.target.adr;
		883	t.call := call;
		884
		885	FormalParameters(parser, t);
		886
		887	IF call IN {PROG.systemv, PROG._systemv} THEN
		888	check(t.params.size <= PROG.MAXSYSVPARAM, parser, pos, 120)
		889	END;
		890
		891	param := t.params.first;
		892	WHILE param # NIL DO
		893	ident := unit.idents.add(unit, param(PROG.PARAM).name, PROG.idPARAM);
		894	ASSERT(ident # NIL);
		895	ident.type := param(PROG.PARAM).type;
		896	ident.offset := param(PROG.PARAM).offset;
		897	IF param(PROG.PARAM).vPar THEN
		898	ident.typ := PROG.idVPAR
		899	END;
		900	param := param.next
		901	END;
		902
		903	checklex(parser, SCAN.lxSEMI);
		904	Next(parser);
		905
		906	IF import = NIL THEN
		907
		908	label := CODE.NewLabel();
		909	proc.proc.label := label;
		910
		911	IF parser.main & proc.export & program.dll THEN
		912	IF program.obj THEN
		913	check((proc.name.s # "lib_init") & (proc.name.s # "version"), parser, pos, 114)
		914	END;
		915	CODE.AddExp(label, proc.name.s);
		916	proc.proc.used := TRUE
		917	END;
		918
		919	b := DeclarationSequence(parser);
		920
		921	program.locsize := 0;
		922	IF call IN {PROG._win64, PROG.win64} THEN
		923	fparams := proc.type.params.getfparams(proc.type, 3, int, flt);
		924	enter := CODE.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.params.size, 4))
		925	ELSIF call IN {PROG._systemv, PROG.systemv} THEN
		926	fparams := proc.type.params.getfparams(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
		927	enter := CODE.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.params.size))
		928	ELSE
		929	enter := CODE.Enter(label, 0)
		930	END;
		931	proc.proc.enter := enter;
		932
		933	IF parser.sym = SCAN.lxBEGIN THEN
		934	Next(parser);
		935	parser.StatSeq(parser)
		936	END;
		937
		938	IF t.base # NIL THEN
		939	checklex(parser, SCAN.lxRETURN);
		940	NextPos(parser, pos);
		941	parser.expression(parser, e);
		942	check(parser.chkreturn(parser, e, t.base, pos), parser, pos, 87)
		943	END;
		944
		945	proc.proc.leave := CODE.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL),
		946	t.params.size * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
		947	enter.param2 := program.locsize;
		948	checklex(parser, SCAN.lxEND)
		949	END;
		950
		951	IF parser.sym = SCAN.lxEND THEN
		952	ExpectSym(parser, SCAN.lxIDENT);
		953	getpos(parser, pos);
		954	endname := parser.lex.ident;
		955	IF import = NIL THEN
		956	check(endname = name, parser, pos, 60);
		957	ExpectSym(parser, SCAN.lxSEMI);
		958	Next(parser)
		959	ELSE
		960	IF endname = parser.unit.name THEN
		961	ExpectSym(parser, SCAN.lxPOINT);
		962	Next(parser);
		963	endmod := TRUE
		964	ELSIF endname = name THEN
		965	ExpectSym(parser, SCAN.lxSEMI);
		966	Next(parser)
		967	ELSE
		968	check(FALSE, parser, pos, 60)
		969	END
		970	END
		971	END;
		972
		973	IF import = NIL THEN
		974	variables := LISTS.create(NIL);
		975	ELSE
		976	variables := NIL
		977	END;
		978
		979	unit.scope.close(unit, variables);
		980
		981	IF import = NIL THEN
		982	enter.variables := variables
		983	END
		984
		985	RETURN endmod
		986	END ProcDeclaration;
		987
		988
		989	BEGIN
		990	IF parser.sym = SCAN.lxCONST THEN
		991	Next(parser);
		992	WHILE parser.sym = SCAN.lxIDENT DO
		993	ConstTypeDeclaration(parser, TRUE)
		994	END
		995	END;
		996
		997	IF parser.sym = SCAN.lxTYPE THEN
		998	Next(parser);
		999	WHILE parser.sym = SCAN.lxIDENT DO
		1000	ConstTypeDeclaration(parser, FALSE)
		1001	END
		1002	END;
		1003
		1004	ptr := parser.unit.pointers.link(parser.unit);
		1005	IF ptr # NIL THEN
		1006	IF ptr.notRecord THEN
		1007	error(parser, ptr.pos, 58)
		1008	ELSE
		1009	error(parser, ptr.pos, 48)
		1010	END
		1011	END;
		1012
		1013	IF parser.sym = SCAN.lxVAR THEN
		1014	Next(parser);
		1015	IF parser.sym = SCAN.lxIDENT THEN
		1016	VarDeclaration(parser)
		1017	END
		1018	END;
		1019
		1020	endmod := FALSE;
		1021	WHILE ~endmod & (parser.sym = SCAN.lxPROCEDURE) DO
		1022	Next(parser);
		1023	endmod := ProcDeclaration(parser)
		1024	END
		1025
		1026	RETURN endmod
		1027	END DeclarationSequence;
		1028
		1029
		1030	PROCEDURE parse (parser: PARSER);
		1031	VAR
		1032	unit: PROG.UNIT;
		1033	label: INTEGER;
		1034	name: INTEGER;
		1035	endmod: BOOLEAN;
		1036
		1037	BEGIN
		1038	ASSERT(parser # NIL);
		1039	ASSERT(parser.scanner # NIL);
		1040
		1041	ExpectSym(parser, SCAN.lxMODULE);
		1042	ExpectSym(parser, SCAN.lxIDENT);
		1043
		1044	IF ~parser.main THEN
		1045	check1(parser.lex.s = parser.modname, parser, 23)
		1046	END;
		1047
		1048	unit := program.units.create(program.units, parser.lex.ident);
		1049
		1050	parser.unit := unit;
		1051
		1052	ExpectSym(parser, SCAN.lxSEMI);
		1053
		1054	Next(parser);
		1055	IF parser.sym = SCAN.lxIMPORT THEN
		1056	ImportList(parser)
		1057	END;
		1058
		1059	CONSOLE.String("compiling "); CONSOLE.String(unit.name.s);
		1060	IF parser.unit.sysimport THEN
		1061	CONSOLE.String(" (SYSTEM)")
		1062	END;
		1063	CONSOLE.Ln;
		1064
		1065	label := CODE.NewLabel();
		1066	CODE.AddJmpCmd(CODE.opJMP, label);
		1067
		1068	name := CODE.putstr(unit.name.s);
		1069
		1070	CODE.SetErrLabel;
		1071	CODE.AddCmd(CODE.opSADR, name);
		1072	CODE.AddCmd(CODE.opPARAM, 1);
		1073	CODE.AddCmd0(CODE.opERR);
		1074
		1075	endmod := DeclarationSequence(parser);
		1076
		1077	CODE.SetLabel(label);
		1078
		1079	IF ~endmod THEN
		1080
		1081	IF parser.sym = SCAN.lxBEGIN THEN
		1082	Next(parser);
		1083	parser.StatSeq(parser)
		1084	END;
		1085
		1086	checklex(parser, SCAN.lxEND);
		1087
		1088	ExpectSym(parser, SCAN.lxIDENT);
		1089	check1(parser.lex.s = unit.name.s, parser, 25);
		1090	ExpectSym(parser, SCAN.lxPOINT)
		1091
		1092	END;
		1093
		1094	unit.close(unit)
		1095
		1096	END parse;
		1097
		1098
		1099	PROCEDURE open (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;
		1100	BEGIN
		1101	ASSERT(parser # NIL);
		1102
		1103	STRINGS.append(parser.fname, modname);
		1104	STRINGS.append(parser.fname, parser.ext);
		1105	STRINGS.append(parser.modname, modname);
		1106
		1107	parser.scanner := SCAN.open(parser.fname)
		1108
		1109	RETURN parser.scanner # NIL
		1110	END open;
		1111
		1112
		1113	PROCEDURE NewParser (): PARSER;
		1114	VAR
		1115	pars: PARSER;
		1116	citem: C.ITEM;
		1117
		1118	BEGIN
		1119	citem := C.pop(parsers);
		1120	IF citem = NIL THEN
		1121	NEW(pars)
		1122	ELSE
		1123	pars := citem(PARSER)
		1124	END
		1125
		1126	RETURN pars
		1127	END NewParser;
		1128
		1129
		1130	PROCEDURE create* (path, lib_path: PATH; StatSeq: STATPROC; expression, designator: EXPRPROC; chkreturn: RETPROC): PARSER;
		1131	VAR
		1132	parser: PARSER;
		1133
		1134	BEGIN
		1135	parser := NewParser();
		1136
		1137	parser.path := path;
		1138	parser.lib_path := lib_path;
		1139	parser.ext := mConst.FILE_EXT;
		1140	parser.fname := path;
		1141	parser.modname := "";
		1142	parser.scanner := NIL;
		1143	parser.unit := NIL;
		1144	parser.constexp := FALSE;
		1145	parser.main := FALSE;
		1146
		1147	parser.open := open;
		1148	parser.parse := parse;
		1149	parser.StatSeq := StatSeq;
		1150	parser.expression := expression;
		1151	parser.designator := designator;
		1152	parser.chkreturn := chkreturn;
		1153	parser.create := create
		1154
		1155	RETURN parser
		1156	END create;
		1157
		1158
		1159	PROCEDURE init* (bit_depth, sys: INTEGER);
		1160	BEGIN
		1161	program := PROG.create(bit_depth, sys);
		1162	parsers := C.create()
		1163	END init;
		1164
		1165
		1166	END PARS.

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/PARS.ob07 – Rev 7597