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

Subversion Repositories Kolibri OS

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