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

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

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/source/PARS.ob07 – Rev 9847