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

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

Subversion Repositories Kolibri OS

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