21gYNYGQ

1!Parse C Code
2
3import qlib
4import clib
5import oslib
6
7import cc_decls
8import cc_support
9import cc_tables
10
11import cc_lex
12import cc_lib
13
14var ref strec ist_symptr
15
16var INT INSIDEFOR
17
18const maxtypemods=20
19var [maxnestedloops]byte looptypestack		!contains either 'L' or 'S' (loop or switch)
20var int loopindex							!current level of nested loop/switch blocks
21var [maxnestedloops]ref caserec casevaluestack		!linked list of case values for current switch
22
23var byte iscallbackfnx
24var byte constantseen=0
25var byte ingeneric=0
26
27proc readmodule=
28var int linkage,m,mbase,commaseen,wasdef
29var unit p
30var ref strec d
31var ref paramrec pm
32var int t,nitems,wasenum
33
34while lx.symbol<>eofsym do
35	nitems:=0
36	case lx.symbol
37	when kshowtypesym then
38		lex()
39		t:=readcasttype(d,0,pm)
40		skipsymbol(semisym)
41		println "Type is:",Strmode(t)
42		next
43	when kmccassertsym then
44		nitems:=1
45	when semisym then
46		serror("Extra semicolon 2")
47	esac
48	wasenum:=lx.symbol
49
50	if lx.symbol=kmccassertsym then nitems:=1 fi
51
52	mbase:=readdeclspec(stmodule,linkage)
53	commaseen:=0
54
55	docase lx.symbol
56	when namesym, mulsym, lbracksym then
57		++nitems
58
59		m:=readtype(stmodule,d,mbase,pm)
60
61		if d=nil then
62			serror("Var name expected")
63		fi
64
65		if linkage=typedef_ss then
66			if pm then
67				m:=createprocmode(m,pm)
68			fi
69			d:=createtypedef(stmodule,d,m)
70			constantseen:=0
71		elsif pm then
72readfn::
73			if lx.symbol=lcurlysym and commaseen then serror("fn def after comma") fi
74
75			d:=readfunction(d,m,linkage,pm,wasdef)
76			if wasdef then exit fi			!can't have comma-separate fn defs
77
78		elsif ttbasetype[m]=tproc then
79			pm:=ttparams[m]
80			m:=tttarget[m]
81			constantseen:=0
82			goto readfn
83
84		else
85			d:=readmodulevar(d,m,linkage)
86			constantseen:=0
87		fi
88
89		case lx.symbol
90		when commasym then			!read next item
91			commaseen:=1
92			lex()
93		else
94			skipsymbol(semisym)
95			exit
96		esac
97	when kconstantsym then
98		constantseen:=1
99		lex()
100		next 2
101	when kstructinfosym then
102		readstructinfosym()
103	else
104		case ttbasetype[mbase]
105		when tenum, tstruct, tunion then		!assume defining a [part]type only
106			skipsymbol(semisym)
107			exit
108		when tsint then				!allow for now, as it migt be an enum decl with no name
109			skipsymbol(semisym)
110			exit
111		else
112			serror_s("Decl error %s",typename(mbase))
113		esac
114	enddocase
115
116	if nitems=0 and fmodern then
117		case ttbasetype[mbase]
118		when tstruct,tunion,tenum then
119		else
120			if wasenum<>kenumsym then
121				CPL =STRMODE(MBASE)
122				serror("Empty declaration")
123			fi
124		esac
125	fi
126
127od
128end
129
130global function parsemodule(int n)int=
131var int size,t
132var ref strec owner
133var real tsecs
134
135loopindex:=iscallbackfnx:=constantseen:=ingeneric:=0
136ist_symptr:=nil
137memset(&casevaluestack,0,casevaluestack.bytes)
138
139startlex("PARSETEST",moduletable[n].fileno)
140owner:=stmodule
141currproc:=nil
142loopindex:=0
143
144lex()
145
146!while lx.symbol<>eofsym do
147!	lex()
148!od
149!RETURN 1
150
151readmodule()
152
153endlex()
154return 1
155end
156
157function readdeclspec(ref strec owner,int &linkage)int=
158!At first symbol of a declspec, or possible declspec
159!read declspec and basetype
160!return typecode for basetype, and linkage (static etc)
161!if no declspec follows (usually eof) returns 0
162
163record declrec=
164	var int32 typeno				!not set, int, float, char, struct, union, enum etc
165	var byte isconst				!0, or 1 when const used (more than 1 allowed)
166	var byte isvolatile				!0, or 1 when volatile used
167	var byte isrestrict
168	var byte linkage				!0, or static_ss etc; only one allowed
169	var byte isinline				!1 when inline used
170	var byte isshort				!1 when short used
171	var byte islong					!1 when long used (not short or long long)
172	var byte isllong				!1 when long long used (islong set to 0)
173	var byte issigned				!not set, signed
174	var byte isunsigned				!not set, unsigned
175	var byte isusertype				!1 if basetype set completely from typedef
176								!so isshort/long etc or other basetype not allowed
177!	var byte iscallback				!1 if $callback fnspec used
178end
179var declrec d
180var unit p
181var int t,mod,m,fstruct
182var ref paramrec pm
183var ref strec e
184
185memset(&d,0,d.bytes)
186fstruct:=mod:=0
187
188doswitch lx.symbol
189when ktypespecsym then
190	switch lx.subcode
191	when ts_int, ts_char, ts_float, ts_double, ts_bool, ts_void then
192		if d.typeno then
193			if fstruct then checksymbol(semisym)
194			else goto tserror
195			fi
196		fi
197		d.typeno:=typespectypes[lx.subcode]
198
199	when ts_short then
200		if d.isshort or d.islong or d.isllong then goto tserror fi
201		d.isshort:=mod:=1
202	when ts_long then
203		if d.isllong or d.isshort then goto tserror
204		elsif d.islong then
205			d.islong:=0
206			d.isllong:=1
207		else
208			d.islong:=1
209		fi
210		mod:=1
211
212	when ts_signed then
213		if d.issigned or d.isunsigned then goto tserror fi
214		d.issigned:=mod:=1
215	when ts_unsigned then
216		if d.issigned or d.isunsigned then goto tserror fi
217		d.isunsigned:=mod:=1
218	when ts_complex then
219		if d.typeno and d.typeno<>tfloat and d.typeno<>tdouble then
220			goto tserror
221		fi
222		d.typeno:=tcomplex
223	else
224
225tserror::
226		serror_s("declspec/ts %s",typespecnames[lx.subcode])
227	endswitch
228	lex()
229
230when ktypequalsym then
231	case lx.subcode
232	when const_qual then
233 d.isconst:=1
234	when volatile_qual then d.isvolatile:=1
235	when restrict_qual then d.isrestrict:=1
236	esac
237	lex()
238
239when klinkagesym then
240	if d.linkage then serror("Dual storage spec") fi
241	d.linkage:=lx.subcode
242	lex()
243
244when kfnspecsym then
245	case lx.subcode
246	when inline_fnspec then
247		d.isinline:=1
248	when callback_fnspec then
249		callbackflag:=1
250!		d.iscallback:=1
251	esac
252	lex()
253when kstructsym,kunionsym then
254	if d.typeno then serror("struct?") fi
255	d.typeno:=readstructdecl(owner)
256	d.isusertype:=1
257	fstruct:=1
258
259when kenumsym then
260	if d.typeno then serror("enum?") fi
261!	d.typeno:=readenumdecl(owner)
262	readenumdecl(owner)
263	d.typeno:=tsint			!disregard enum 'type'; just use int
264	d.isusertype:=1
265
266when namesym then			!should resolve to see if a user-type ...
267							! ... unless a basetype already seen
268	if not d.typeno and (m:=isusertype(owner)) then
269		if mod then			!unsigned etc without proper base type; assume name is not part o it
270			d.typeno:=tsint
271			exit
272		fi
273!		if mod then serror("Can't mod usertype") fi
274		d.typeno:=m
275		d.isusertype:=1
276		lex()
277	else
278		if d.typeno=0 and not mod then
279			serror_s("Implicit decls not allowed: %s",lx.symptr^.name)
280		fi
281
282		if d.typeno=0 then d.typeno:=tsint fi
283		exit
284	fi
285
286when ktypeofsym then
287	lex()
288	skipsymbol(lbracksym)
289	p:=readexpression()
290	skipsymbol(rbracksym)
291	if d.typeno or mod then serror("typeof") fi
292	d.typeno:=p^.mode
293
294
295when kmccassertsym then
296	dostaticassert()
297else
298	exit
299end doswitch
300
301t:=(d.typeno|d.typeno|tsint)
302
303if not d.isusertype then				!otherwise everything should be set up
304	case t
305	when tsint then
306		if d.isshort then
307			t:=(d.isunsigned|tushort|tsshort)
308		elsif d.islong then
309			if wintarget then
310				t:=(d.isunsigned|tuint|tsint)
311			else
312				t:=(d.isunsigned|tullong|tsllong)
313			fi
314		elsif d.isllong then
315			t:=(d.isunsigned|tullong|tsllong)
316		elsif d.isunsigned then
317			t:=tuint
318		fi
319	when tuchar then
320		if d.isshort or d.islong or d.isllong then serror("char decl?") fi
321		t:=(d.issigned|tschar|tuchar)
322	when tdouble then
323		if d.isshort or d.isllong or d.issigned or d.isunsigned then serror("dbl decl?") fi
324!long double not supported; just use double
325!		t:=tldouble
326	when tcomplex then
327		if d.isshort or d.isllong or d.issigned or d.isunsigned then serror("Complex?") fi
328
329	else
330		if mod then serror("declspec/float") fi
331	esac
332fi
333
334if d.isconst then
335	t:=createconstmode(t)
336fi
337
338linkage:=d.linkage
339return t
340end
341
342function istypestarter:int=
343!return 1 when current symbol could start a type-spec
344var ref strec d
345
346switch lx.symbol
347when ktypespecsym then
348	return 1
349when ktypequalsym then
350!	return lx.subcode=const_qual
351	return 1
352when namesym then
353	d:=resolvename((currproc|currproc|stmodule),lx.symptr,ns_general,currblockno)
354	if d then
355		lx.symptr:=d
356		return d^.nameid=typeid
357	fi
358when kstructsym,kunionsym,kenumsym then
359	return 1
360endswitch
361return 0
362
363end
364
365function readexpression:unit=
366var unit p, ulist, ulistx
367var int t
368
369case nextlx.symbol
370when  semisym,rbracksym then
371	return readterm()
372esac
373
374p:=readassignexpr()
375
376if lx.symbol=commasym then		!
377	ulist:=ulistx:=nil
378	do
379		addlistunit(&ulist,&ulistx,p)
380		exit when lx.symbol<>commasym
381		lex()
382		p:=readassignexpr()
383	od
384	p:=createunit1(j_exprlist,ulist)
385	if ulistx then
386		p^.mode:=ulistx^.mode
387	fi
388
389	return p
390fi
391return p
392end
393
394function readassignexpr:unit=
395var unit p,q,r
396var int opc,oldpmode
397
398case nextlx.symbol
399when commasym, semisym,rbracksym then
400	return readterm()
401when assignsym then
402	p:=readterm()
403	opc:=lx.symbol
404	goto gotp
405esac
406
407p:=readcondexpr()
408
409switch opc:=lx.symbol
410when assignsym, multosym, divtosym, remtosym, addtosym, subtosym,
411		shltosym, shrtosym, iandtosym, ixortosym, iortosym then
412gotp::
413	lex()
414	oldpmode:=p^.mode
415	checklvalue(p)
416	q:=readassignexpr()
417	if ttisref[p^.mode] then
418		return createassignopref(opc,p,q)
419	fi
420
421	q:=coercemode(q,oldpmode)
422	if ttconst[oldpmode] then
423		terror("Modifying read-only var")
424	fi
425
426	if q^.tag=j_convert and opc=assignsym then
427		q^.convtomem:=1
428	fi
429
430	if p^.tag=j_ptr and p^.a^.tag=j_const then
431		terror("Modifying constant?")
432	fi
433
434
435	r:=createunit2(symboltojtag[opc],p,q)
436
437	r^.mode:=oldpmode
438	return r
439endswitch
440
441return p
442end
443
444function readcondexpr:unit=
445var unit x,y,pcond
446var int s,t,u
447
448pcond:=readorlexpr()
449
450if lx.symbol=questionsym then
451	coercecond(pcond)
452
453	lex()
454	x:=readexpression()
455	skipsymbol(colonsym)
456	y:=readcondexpr()
457
458	if u:=dominantmode[s:=ttbasetype[x^.mode],t:=ttbasetype[y^.mode]] then			!were both numeric
459		x:=coercemode(x,u)
460		y:=coercemode(y,u)
461		if pcond^.tag=j_const and x^.tag=j_const and y^.tag=j_const then
462			return (pcond^.value|x|y)
463		fi
464
465	elsif s=tref and t=tref then
466		u:=x^.mode
467	elsif s=tref and t=tsint and y^.tag=j_const and y^.value=0 then
468		u:=x^.mode
469		coercemode(y,u)
470	elsif s=tsint and t=tref and x^.tag=j_const and x^.value=0 then
471		u:=y^.mode
472		coercemode(x,u)
473	elsif s=tstruct and t=tstruct then
474		u:=x^.mode
475	elsif s=t=tvoid then
476		u:=tvoid
477	else
478CPL Strmode(x^.mode),Strmode(y^.mode)
479		terror("?: incompatible types")
480	fi
481
482	pcond:=createunit3(j_ifx,pcond,x,y)
483	pcond^.mode:=u
484fi
485
486return pcond
487end
488
489function readorlexpr:unit=
490var unit x,y
491
492x:=readandlexpr()
493
494while lx.symbol=orlsym do
495	lex()
496	y:=readandlexpr()
497	coercecond(x)
498	coercecond(y)
499
500	if x^.tag=j_const and y^.tag=j_const then
501		x^.value := (x^.value or y^.value|1|0)
502		next
503	fi
504	x:=createunit2(j_orl,x,y)
505	x^.mode:=tsint
506od
507
508return x
509end
510
511function readandlexpr:unit=
512var unit x,y
513
514x:=readiorexpr()
515
516while lx.symbol=andlsym do
517	lex()
518	y:=readiorexpr()
519	coercecond(x)
520	coercecond(y)
521
522	if x^.tag=j_const and y^.tag=j_const then
523		x^.value := (x^.value and y^.value|1|0)
524		next
525	fi
526	x:=createunit2(j_andl,x,y)
527	x^.mode:=tsint
528od
529
530return x
531end
532
533function readiorexpr:unit=
534var unit x,y
535var int u
536
537x:=readixorexpr()
538
539while lx.symbol=iorsym do
540	lex()
541	y:=readixorexpr()
542
543	if u:=dominantmode[ttbasetype[x^.mode],ttbasetype[y^.mode]] then			!were both numeric
544		if u>=tfloat then terror("float|float") fi
545		x:=coercemode(x,u)
546		y:=coercemode(y,u)
547	else
548		terror("invalid | operands")
549	fi
550
551	if x^.tag=j_const and y^.tag=j_const then
552		case u
553		when tsint,tsllong,tuint,tullong then
554			x^.value ior:= y^.value
555			next
556		esac
557	fi
558	x:=createunit2(j_ior,x,y)
559	x^.mode:=u
560od
561
562return x
563end
564
565function readixorexpr:unit=
566var unit x,y
567var int u
568
569x:=readiandexpr()
570
571while lx.symbol=ixorsym do
572	lex()
573	y:=readiandexpr()
574
575	if u:=dominantmode[ttbasetype[x^.mode],ttbasetype[y^.mode]] then			!were both numeric
576		if u>=tfloat then terror("float^float") fi
577		x:=coercemode(x,u)
578		y:=coercemode(y,u)
579	else
580		terror("invalid ^ operands")
581	fi
582
583	if x^.tag=j_const and y^.tag=j_const then
584		case u
585		when tsint,tsllong then
586			x^.value ixor:= y^.value
587			next
588		esac
589	fi
590	x:=createunit2(j_ixor,x,y)
591	x^.mode:=u
592od
593
594return x
595end
596
597function readiandexpr:unit=
598var unit x,y
599var int u
600
601x:=readeqexpr()
602
603while lx.symbol=iandsym do
604	lex()
605	y:=readeqexpr()
606
607	if u:=dominantmode[ttbasetype[x^.mode],ttbasetype[y^.mode]] then			!were both numeric
608		if u>=tfloat then terror("float&float") fi
609		x:=coercemode(x,u)
610		y:=coercemode(y,u)
611	else
612cpl Strmode(x^.mode)
613cpl Strmode(y^.mode)
614		terror("invalid & operands")
615	fi
616
617	if x^.tag=j_const and y^.tag=j_const then
618		case u
619		when tsint,tsllong then
620			x^.value iand:= y^.value
621			next
622		esac
623	fi
624	x:=createunit2(j_iand,x,y)
625	x^.mode:=u
626od
627
628return x
629end
630
631function readeqexpr:unit=
632var unit x,y
633var int opc,s,t,u,ss,tt
634
635x:=readrelexpr()
636
637while (opc:=lx.symbol)=eqsym or opc=nesym do
638	lex()
639	y:=readrelexpr()
640
641	if u:=dominantmode[s:=ttbasetype[x^.mode],t:=ttbasetype[y^.mode]] then			!were both numeric
642		x:=coercemode(x,u)
643		y:=coercemode(y,u)
644	elsif s=tref and t=tref then
645		if (ss:=tttarget[x^.mode])<>(tt:=tttarget[y^.mode]) then
646			if ss<>tvoid and tt<>tvoid then
647				if not checkpointertypes(x^.mode,y^.mode,1) then	!'hard'
648!				if ttbasetype[ss]=tproc and ttbasetype[tt]=tproc then
649!				elsif ttbasetype[ss]=tstruct and ttbasetype[tt]=tstruct then
650!				else
651					terror("Comparing distinct pointers/eq")
652				fi
653			fi
654		fi
655	elsif s=tref and t=tsint then
656		if y^.tag<>j_const or y^.value<>0 then
657			terror("Can't compare pointer to int")
658		fi
659	elsif s=tsint and t=tref then
660		if x^.tag<>j_const or x^.value<>0 then
661			terror("Can't compare pointer to int2")
662		fi
663	else
664		terror("invalid == operands")
665	fi
666
667	if x^.tag=j_const and y^.tag=j_const then
668		case u
669		when tsint,tsllong,tuint,tullong,0 then			!0 when ref/ref ref/int int/ref
670			if opc=eqsym then
671				x^.value := x^.value = y^.value
672			else
673				x^.value := x^.value <> y^.value
674			fi
675			next
676		esac
677	fi
678	x:=createunit2(symboltojtag[opc],x,y)
679	x^.mode:=tsint
680od
681
682
683return x
684end
685
686function readrelexpr:unit=
687var unit x,y
688var int opc,s,t,u
689var int64 a,b,c
690var word64 aa,bb,cc
691
692x:=readshiftexpr()
693
694while (opc:=lx.symbol)=ltsym or opc=lesym or opc=gesym or opc=gtsym do
695	lex()
696	y:=readshiftexpr()
697
698	if u:=dominantmode[s:=ttbasetype[x^.mode],t:=ttbasetype[y^.mode]] then			!were both numeric
699		x:=coercemode(x,u)
700		y:=coercemode(y,u)
701	elsif s=tref and t=tref then
702!		if tttarget[x^.mode]<>tttarget[y^.mode] then
703		if not checkpointertypes(x^.mode,y^.mode,1) then		!use 'hard' mode
704			terror("Comparing distinct pointers/rel")
705		fi
706	else
707		terror("invalid rel operands")
708	fi
709
710	if x^.tag=j_const and y^.tag=j_const then
711		a:=x^.value; b:=y^.value
712		case u
713		when tsint,tsllong then
714			case opc
715			when ltsym then c:=a<b
716			when lesym then c:=a<=b
717			when gesym then c:=a>=b
718			else            c:=a>b
719			esac
720			x^.value:=c
721			next
722		when tuint,tullong then
723			aa:=x^.value; bb:=y^.value
724			case opc
725			when ltsym then cc:=aa<bb
726			when lesym then cc:=aa<=bb
727			when gesym then cc:=aa>=bb
728			else            cc:=aa>bb
729			esac
730			x^.value:=cc
731			next
732		esac
733	fi
734
735	x:=createunit2(symboltojtag[opc],x,y)
736	x^.mode:=tsint
737od
738
739return x
740end
741
742function readshiftexpr:unit=
743var unit x,y
744var int opc,u
745
746x:=readaddexpr()
747
748while (opc:=lx.symbol)=shlsym or opc=shrsym do
749	lex()
750	y:=readaddexpr()
751
752	coercebasetype(x)
753	unless (u:=ttbasetype[x^.mode])>=tfirstint and u<=tlastint then
754		terror("shift:Not an int")
755	end unless
756	y:=coercemode(y,tsint)
757!
758	if x^.tag=j_const and y^.tag=j_const then
759		case u
760		when tsint,tsllong then
761			if opc=shlsym then
762				x^.value := x^.value << y^.value
763			else
764				x^.value := x^.value >> y^.value
765			fi
766			next
767		when tuint,tullong then
768			if opc=shlsym then
769				x^.uvalue := x^.uvalue << y^.value
770			else
771				x^.uvalue := x^.uvalue >> y^.value
772			fi
773			next
774		esac
775	fi
776	x:=createunit2((opc=shlsym|j_shl|j_shr),x,y)
777	x^.mode:=u
778od
779
780return x
781end
782
783function readaddexpr:unit=
784var unit p,q
785var int opc
786
787p:=readmulexpr()
788
789while (opc:=lx.symbol)=addsym or opc=subsym do
790	lex()
791	q:=readmulexpr()
792
793	if opc=addsym then
794		p:=createaddop(p,q)
795	else
796		p:=createsubop(p,q)
797	fi
798od
799
800return p
801end
802
803function readmulexpr:unit=
804var unit p,q
805var int opc
806
807p:=readterm()
808
809while (opc:=lx.symbol)=mulsym or opc=divsym or opc=remsym do
810	lex()
811	q:=readterm()
812	case opc
813	when mulsym then
814		p:=createmulop(p,q)
815	when divsym then
816		p:=createdivop(p,q)
817	when remsym then
818		p:=createremop(p,q)
819	esac
820od
821
822return p
823end
824
825function readterm:unit=
826var unit p, q
827var int t,u,opc,shift,newlen,slength,tbase,fwide,newmode
828var ref char pbyte
829var int64 a
830var ref strec d
831var ichar ss,s
832var ref paramrec pm
833
834switch lx.symbol
835when intconstsym, realconstsym then
836	p:=createconstunit(lx.value,lx.subcode)
837	lex()
838when namesym then
839	if lx.symptr^.nameid<=macroid then
840		d:=resolvename((currproc|currproc|stmodule),lx.symptr,ns_general,currblockno)
841		if d=nil then
842			serror_s("Undefined name \"%s\"", getstname(lx.symptr))
843		fi
844	else
845		d:=lx.symptr
846	fi
847
848	d^.attribs.ax_used:=1
849	case d^.nameid
850	when enumid then
851		p:=createconstunit(d^.index,tsint)
852	when constantid then
853		p:=createconstunit(d^.code^.value,d^.mode)
854	when procid then
855		if nextlx.symbol<>lbracksym then
856			p:=createunit0(j_funcname)
857			p^.def:=d
858			p^.mode:=createrefmode(createprocmode(d^.mode,d^.paramlist))
859!			p^.mode:=createprocmode(d^.mode,d^.paramlist)
860		else
861			goto doname
862		fi
863
864	else
865doname::
866		p:=createname(d)
867		p^.mode:=t:=d^.mode
868		if ttbasetype[t]=tarray then
869!			p^.tag:=j_nameaddr
870			p^.alength:=ttlength[t]
871			p:=createaddrofop(p)
872			p^.mode:=createrefmode(tttarget[t])
873		elsif d^.nameid<>procid and d^.nameid<>constantid and ttsize[t]<4  then
874			fixmemopnd(p)
875		elsif d^.nameid=paramid then
876			if isstructunion(p^.mode) then
877				p^.lineno:=lx.lineno
878				p^.mode:=createrefmode(p^.mode)
879				p:=createptrop(p)
880				p^.mode:=d^.mode
881			fi
882		fi
883	esac
884	p^.lineno:=lx.lineno
885	lex()
886
887when stringconstsym,wstringconstsym then
888	fwide:=lx.symbol=wstringconstsym
889	s:=lx.svalue
890	slength:=lx.length
891	while nextlx.symbol=stringconstsym do		!combine consecutive strings
892		newlen:=slength+nextlx.length
893		ss:=pcm_alloc(newlen+1)
894		memcpy(ss,s,slength)
895		memcpy(ss+slength,nextlx.svalue,nextlx.length)
896		(ss+newlen)^:=0
897		s:=ss
898		slength:=newlen
899		lex()
900	od
901	p:=createstringconstunit(s,slength)
902    p^.slength:=slength
903	if fwide then p^.mode:=trefwchar fi
904	lex()
905
906when kstrincludesym then
907!when strincludedir then
908	p:=readstrinclude()
909
910when charconstsym then
911	a:=0
912	shift:=0
913	pbyte:=lx.svalue
914	to lx.length do
915		a:=a ior word64(pbyte^)<<shift
916		shift+:=8
917		++pbyte
918	od
919	p:=createconstunit(a,tsint)
920	lex()
921
922when addsym then
923	lex()
924	p:=readterm()
925
926when subsym then
927	lex()
928	p:=createnegop(readterm())
929
930when notlsym then
931	lex()
932	p:=readterm()
933	coercecond(p)
934	p:=createunit1(j_notl,p)
935	p^.mode:=tsint
936
937	if p^.a^.tag=j_notl and p^.a^.a^.tag=j_notl then
938		p^.a:=p^.a^.a^.a
939	fi
940
941when inotsym then
942	lex()
943	p:=createinotop(readterm())
944
945when iandsym then			!&
946	lex()
947!&* cancel, so detect this early to avoid more complicated code, which also
948!has a bug when following term is an array that decays to a pointer; it ends up
949!with an incorrect number of ptrs (one too many I think). The .alength trick
950!doesn't work when the array is unbounded as in (*A)[]
951!However, detecting &* doesn't cover &(*X) for example
952!I need to have .alength plus also an array indicator. Fortunately array pointers
953!and the use of &* mainly occur in my generated code
954!
955	if lx.symbol=mulsym then
956		lex()
957		p:=readterm()
958	else
959		p:=createaddrofop(readterm())
960	fi
961
962when andlsym then			!&&
963	serror("rt/&&label")
964
965when mulsym then			!*
966	lex()
967	p:=createptrop(readterm())
968
969when incrsym, decrsym then			!*
970	opc:=symboltojtag[lx.symbol]
971	lex()
972	p:=createincrop(opc,readterm())
973
974when abssym then
975	lex()
976	skipsymbol(lbracksym)
977	p:=createabsop(readexpression())
978	skipsymbol(rbracksym)
979
980when sqrtsym then
981	lex()
982	skipsymbol(lbracksym)
983	p:=createsqrtop(readexpression())
984	skipsymbol(rbracksym)
985
986when lbracksym then			!(
987	lex()
988	if istypestarter() then
989		t:=readcasttype(d,0,pm)
990		skipsymbol(rbracksym)
991		if lx.symbol=lcurlysym then
992			serror("rt/compound lit")
993		else
994			p:=docast(readterm(),t)
995		fi
996	else
997		p:=readexpression()
998		skipsymbol(rbracksym)
999	fi
1000when ksizeofsym then
1001	lex()
1002	if lx.symbol=lbracksym then		!possible type
1003		lex()
1004		if istypestarter() then
1005			t:=readcasttype(d,0,pm)
1006			skipsymbol(rbracksym)
1007			p:=createconstunit(ttsize[t],tsint)
1008		else
1009			p:=readexpression()
1010			skipsymbol(rbracksym)
1011			p:=createsizeofop(p)
1012		fi
1013	else
1014		p:=createsizeofop(readterm())
1015	fi
1016when klengthofsym then
1017	lex()
1018	if lx.symbol=lbracksym then		!possible type
1019		lex()
1020		if istypestarter() then
1021			t:=readcasttype(d,0,pm)
1022			skipsymbol(rbracksym)
1023			p:=createconstunit(ttlength[t],tsint)
1024		else
1025			p:=readexpression()
1026			skipsymbol(rbracksym)
1027			p:=createlengthofop(p)
1028		fi
1029	else
1030		p:=createlengthofop(readterm())
1031	fi
1032when kgenericsym then
1033	p:=readgeneric()
1034when kalignofsym then
1035	serror("rt/alignof")
1036when kstrtypesym then
1037	lex()
1038	skipsymbol(lbracksym)
1039	t:=readcasttype(d,0,pm)
1040	skipsymbol(rbracksym)
1041	p:=createstringconstunit(pcm_copyheapstring(Strmode(t)),-1)
1042when kcputimesym then
1043	p:=createunit0(j_cputime)
1044	p^.mode:=tsllong
1045	lex()
1046
1047else
1048	serror("Readterm?")
1049endswitch
1050
1051!look at the suffix
1052
1053doswitch lx.symbol
1054when lsqsym then
1055	lex()
1056	q:=readexpression()
1057	skipsymbol(rsqsym)
1058	p:=createindexop(p,q)
1059
1060when dotsym, idotsym then
1061	opc:=symboltojtag[lx.symbol]
1062	lex()
1063	checksymbol(namesym)
1064	d:=lx.symptr
1065	lex()
1066
1067	p:=createdotop(opc,p,d)
1068
1069when lbracksym then
1070	lex()
1071	if lx.symbol=rbracksym then			!()
1072		q:=nil
1073		lex()
1074	else
1075		q:=readexprlist(nil)
1076		skipsymbol(rbracksym)
1077	fi
1078	p:=createcall(p,q)
1079
1080when incrsym then
1081	lex()
1082	p:=createincrop(j_postincr,p)
1083
1084when decrsym then
1085	lex()
1086	p:=createincrop(j_postdecr,p)
1087else
1088	exit
1089enddoswitch
1090
1091return p
1092end
1093
1094function readexprlist(unit p)unit=
1095! read comma-separated list, and return head of list (not as j_makelist etc)
1096!p=nil:		at start of first expr (not ")")
1097!p<>nil:	p will be head of the list; comma skipped so at start of next expr
1098var unit ulist, ulistx
1099
1100ulist:=ulistx:=p
1101do
1102	p:=readassignexpr()
1103	addlistunit(&ulist,&ulistx,p)
1104	if lx.symbol<>commasym then
1105		exit
1106	fi
1107	lex()
1108od
1109return ulist
1110
1111end
1112
1113function readmodulevar(ref strec d, int m, linkage)ref strec=
1114!read var or function decl at module scope
1115var ref strec e
1116var int scope,emode
1117
1118e:=checkdupl(stmodule, d, ns_general, 0)
1119
1120if e then					!already exists
1121	if e^.nameid<>staticid then
1122		serror_ss("var: name in use %s %s",e^.name,namenames[e^.nameid])
1123	fi
1124	emode:=e^.mode
1125	if emode<>m then
1126		if not comparemode(emode,m) then
1127redef::
1128			serror_s("var: redefining %s",e^.name)
1129		fi
1130		case ttbasetype[emode]
1131		when tarray then
1132			if ttlength[emode]=0 then			!replace empty array
1133				e^.mode:=m
1134			elsif ttlength[m] and ttlength[emode]<>ttlength[m] then
1135				goto redef
1136			fi
1137		esac
1138
1139	fi
1140	d:=e
1141
1142!see how scope interacts with existing decl
1143	scope:=d^.scope
1144	if scope=local_scope and linkage=none_ss or\
1145	   scope=exported_scope and linkage=static_ss or\
1146	   scope=imported_scope and linkage=static_ss then
1147
1148!*!		serror("Linkage mismatch")
1149
1150	elsif scope=imported_scope and linkage=none_ss then
1151		scope:=exported_scope
1152	fi
1153
1154else
1155	d:=createdupldef(stmodule,d,(constantseen|constantid|staticid))
1156	d^.mode:=m
1157	case linkage
1158	when static_ss then
1159		scope:=local_scope
1160	when extern_ss then
1161		scope:=imported_scope
1162	else
1163		scope:=exported_scope
1164	esac
1165
1166fi
1167
1168if lx.symbol=assignsym then
1169	if d^.code then
1170		serror_s("Can't init twice %s",d^.name)
1171	fi
1172	if scope=imported_scope then
1173		serror_s("Can't init extern %s",d^.name)
1174	fi
1175	lex()
1176	d^.code:=readinitexpr(stmodule,d^.mode)
1177
1178	if d^.nameid=constantid then
1179		unless tfirstint<=ttbasetype[d^.mode]<=tlastreal then
1180			serror("constant only for int/float")
1181		end unless
1182		if d^.code^.tag<>j_const then
1183			serror("constant expr must be constant")
1184		fi
1185	fi
1186
1187elsif constantseen then
1188	serror("constant must be initialised")
1189fi
1190
1191d^.scope:=scope
1192
1193return d
1194end
1195
1196function readframevar(ref strec d,int m, linkage)ref strec=
1197var ref paramrec pm
1198var ref strec e
1199var int scope,id
1200
1201e:=checkdupl_inproc(currproc, d, ns_general, currblockno)
1202
1203if e then					!already exists
1204		serror_s("var: name in use %s",e^.name)
1205	d:=e
1206
1207!see how scope interacts with existing decl
1208	scope:=d^.scope
1209	if scope=local_scope and linkage=none_ss or\
1210	   scope=exported_scope and linkage=static_ss or\
1211	   scope=imported_scope and linkage=static_ss then
1212!*!		serror("Linkage2 mismatch")
1213	elsif scope=imported_scope and linkage=none_ss then
1214		scope:=exported_scope
1215	fi
1216else
1217	id:=frameid
1218	scope:=function_scope
1219	case linkage
1220	when static_ss then
1221		id:=staticid
1222	when extern_ss then
1223		scope:=imported_scope
1224		id:=staticid
1225	esac
1226	d:=createdupldef(currproc,d,id)
1227	d^.mode:=m
1228	d^.blockno:=currblockno
1229	blockcounts[currblockno]:=1
1230fi
1231
1232if lx.symbol=assignsym then
1233	if d^.code then
1234		serror_s("Can't init twice %s",d^.name)
1235	fi
1236	if scope=imported_scope then
1237		serror_s("Can't init extern %s",d^.name)
1238	fi
1239	lex()
1240	d^.code:=readinitexpr(currproc,d^.mode)
1241fi
1242
1243d^.scope:=scope
1244
1245return d
1246end
1247
1248function readtype(ref strec owner, &d, int m, ref paramrec &pm)int=
1249var [maxtypemods]int modtype
1250var [maxtypemods]ref void modvalue
1251var ref paramrec pmx
1252var int nmodifiers,i
1253nmodifiers:=0
1254
1255pm:=nil
1256
1257readnamedtype(owner,d, modtype,modvalue,nmodifiers)
1258
1259!now apply modifiers to base type:
1260for i:=nmodifiers downto 1 do
1261	case modtype[i]
1262	when 'A' then
1263		m:=createarraymode(m,int(modvalue[i]))
1264	when 'R' then
1265		m:=createrefmode(m)
1266	when 'C' then
1267		m:=createconstmode(m)
1268	when 'F' then
1269		if i=1 then				!indicate to caller that this is a normal function
1270			pm:=modvalue[1]
1271		else					!assume fu nction pointer of some sort
1272			m:=createprocmode(m,modvalue[i])
1273		fi
1274	esac
1275od
1276
1277return m
1278end
1279
1280proc readnamedtype(ref strec owner, &d,
1281			[]int &modtype, []ref void &modvalue, int &nmodifiers)=
1282var int length
1283var [maxtypemods]int fconst
1284var int nrefs
1285var unit pdim
1286
1287d:=nil
1288nrefs:=0
1289
1290if lx.symbol=kfnspecsym then
1291	lex()				!ignore $callback etc (not needed in a type decl, only a function def)
1292fi
1293
1294!accumulate pointers
1295while lx.symbol=mulsym do			!pointer/qualifier loop
1296	++nrefs
1297	fconst[nrefs]:=0
1298	lex()
1299	while lx.symbol=ktypequalsym do
1300		case lx.subcode
1301		when const_qual then
1302			fconst[nrefs]:=1
1303		when volatile_qual, restrict_qual then
1304		else
1305			serror("rnt1")
1306		esac
1307		lex()
1308	od
1309od
1310
1311case lx.symbol
1312when namesym then
1313	d:=lx.symptr
1314	lex()
1315when lbracksym then			!don't know how this would work...
1316	lex()
1317	readnamedtype(owner,d,modtype,modvalue,nmodifiers)
1318	skipsymbol(rbracksym)
1319esac
1320
1321docase lx.symbol
1322when lsqsym then			!array
1323	lex()
1324	if lx.symbol=rsqsym then
1325		length:=0
1326	else
1327		pdim:=readassignexpr()
1328
1329		if pdim^.tag=j_const then
1330			length:=pdim^.value
1331		else
1332			serror("Can't do VLAs")
1333		fi
1334		checksymbol(rsqsym)
1335	fi
1336	if length<0 then terror("Negative array dim") fi
1337	lex()
1338	modtype[++nmodifiers]:='A'
1339	modvalue[nmodifiers]:=ref void(length)
1340
1341when lbracksym then			!fn params
1342	lex()
1343	modtype[++nmodifiers]:='F'
1344	modvalue[nmodifiers]:=readparams(owner)
1345else
1346	exit
1347enddocase
1348
1349!now apply any pointers
1350while nrefs do
1351	if fconst[nrefs] then
1352		modtype[++nmodifiers]:='C'
1353	fi
1354	modtype[++nmodifiers]:='R'
1355	--nrefs
1356od
1357end
1358
1359function readconstintexpr:int=
1360var unit p
1361p:=readassignexpr()
1362case p^.tag
1363when j_const then
1364	return p^.value
1365else
1366	serror_s("readconstint %s",jtagnames[p^.tag])
1367esac
1368return 0
1369end
1370
1371function readinitexpr(ref strec owner, int m)unit=
1372var int count
1373var unit p
1374
1375p:=readinitexpr2(owner,m,1)
1376
1377return p
1378end
1379
1380function readinitexpr2(ref strec owner, int m, istop)unit=
1381var unit ulist, ulistx, p
1382var int mbase,melem,mm
1383var int dim,count
1384var ref strec d,e
1385var int braces
1386
1387mbase:=ttbasetype[m]
1388count:=0
1389
1390if lx.symbol=lcurlysym then
1391	lex()
1392	count:=0
1393	case mbase
1394	when tarray then
1395		dim:=ttlength[m]
1396		if not istop and dim=0 then terror("init/0-size array") fi
1397		melem:=tttarget[m]
1398		if ttbasetype[melem]=tuchar and lx.symbol=stringconstsym then
1399			braces:=1
1400			goto doarraystring
1401		fi
1402
1403	when tstruct,tunion then
1404		d:=ttnamedef[m]
1405		e:=d^.deflist
1406		if e=nil then
1407			terror("init/Empty struct")
1408		fi
1409		melem:=e^.mode
1410	else
1411		p:=readassignexpr()
1412		p:=coercemode(p,m)
1413		skipsymbol(rcurlysym)
1414		return p
1415	esac
1416
1417	ulist:=ulistx:=nil
1418	do
1419		p:=readinitexpr2(owner,melem,0)
1420		++count
1421
1422		case mbase		
1423		when tarray then
1424			if dim and count>dim then
1425				terror("Too many array elems")
1426			fi
1427
1428			if ttbasetype[melem]=tarray and ttbasetype[tttarget[melem]]=tuchar and p^.mode=trefchar then
1429			else
1430				p:=coercemode(p,melem)
1431			fi
1432		when tstruct then
1433
1434			mm:=e^.mode
1435
1436			if ttbasetype[mm]=tarray and ttbasetype[tttarget[mm]]=tuchar and p^.mode=trefchar then
1437			else
1438				p:=coercemode(p,mm)
1439			fi
1440
1441			e:=e^.nextdef
1442			if e=nil then
1443				if lx.symbol=commasym and nextlx.symbol<>rcurlysym then
1444					terror("Too many struct elems")
1445				fi
1446			else
1447				melem:=e^.mode
1448			fi
1449		when tunion then
1450			p:=coercemode(p,melem)
1451			ulist:=ulistx:=p
1452			goto donestruct
1453		esac
1454
1455		addlistunit(&ulist,&ulistx,p)
1456		if lx.symbol<>commasym then
1457			exit
1458		fi
1459		if nextlx.symbol=rcurlysym then		! {10,20,30,} allowed
1460			lex()
1461			exit
1462		fi
1463		lex()
1464	od
1465	if mbase=tarray and dim=0 then
1466		ttlength[m]:=count
1467		ttsize[m]:=count*ttsize[melem]
1468	fi
1469
1470donestruct::
1471	skipsymbol(rcurlysym)
1472	p:=createunit1(j_makelist,ulist)
1473	p^.count:=count
1474
1475	p^.mode:=m
1476
1477else
1478	braces:=0
1479	case mbase
1480	when tarray then
1481doarraystring::
1482		if lx.symbol<>stringconstsym and tttarget[m]<>tuchar then
1483			terror("{} initialiser expected")
1484		fi
1485
1486		p:=readassignexpr()
1487		if p^.tag=j_const then p^.strarray:=1 fi
1488		if p^.mode<>trefchar then terror("Array init") fi
1489		P^.MODE:=M
1490
1491		if (dim:=ttlength[m])=0 then
1492			ttlength[m]:=ttsize[m]:=p^.slength+1
1493		else
1494			if p^.slength>dim then
1495				terror("Init str too long")
1496			fi
1497		fi
1498		if braces then skipsymbol(rcurlysym) fi
1499		return p
1500	esac
1501	p:=readassignexpr()
1502	p:=coercemode(p,m)
1503
1504fi
1505return p
1506end
1507
1508proc pushblock=
1509var int n
1510
1511if blocklevel>=maxblockstack then
1512	serror("Too many block levels")
1513fi
1514if nextblockno>=maxblock then
1515	serror("Too many blocks")
1516fi
1517++blocklevel
1518++nextblockno
1519
1520n:=currblockno
1521
1522var int m:=blocklevel								!NEED TO ACCESS CONTAINING BLOCKS
1523												!VIA BLOCKSTACK
1524
1525while m and blockcounts[blockstack[m]]=0 do
1526	--m
1527    n:=blockstack[m]
1528od
1529
1530blockowner[nextblockno]:=n
1531
1532currblockno:=blockstack[blocklevel]:=nextblockno
1533blockcounts[currblockno]:=0
1534end
1535
1536proc popblock=
1537currblockno:=blockstack[--blocklevel]
1538end
1539
1540function readcompoundstmt(int params):unit=
1541!read {...} statements
1542!positioned at first {, exit at symbol past final }
1543var unit ulist, ulistx, p,q
1544
1545ulist:=ulistx:=nil
1546
1547lex()			!skip {
1548pushblock()
1549if params then		!assume top block of function
1550	blockcounts[1]:=1
1551fi
1552
1553while lx.symbol<>rcurlysym do
1554	p:=readstatement()
1555
1556	if p=nil then next fi				!might have been typedef etc
1557	if p^.tag=j_tempdecl then
1558		repeat
1559			q:=p^.nextunit
1560			if p^.def^.code and p^.def^.nameid<>staticid then
1561				p^.tag:=j_decl
1562				p^.nextunit:=nil
1563				addlistunit(&ulist,&ulistx,p)
1564			fi
1565			p:=q
1566		until p=nil
1567	else
1568		addlistunit(&ulist,&ulistx,p)
1569	fi
1570od
1571lex()
1572popblock()
1573return createunit3(j_block,ulist,nil,ulistx)
1574end
1575
1576function readstatement:unit=
1577var unit p,q
1578var ref strbuffer ss
1579var ref strec d
1580var int index
1581
1582switch lx.symbol
1583when kifsym then
1584	return readifstmt()
1585
1586when kforsym then
1587	return readforstmt()
1588
1589when kwhilesym then
1590	return readwhilestmt()
1591
1592when kdosym then
1593	return readdostmt()
1594
1595when kreturnsym then
1596	return readreturnstmt()
1597
1598when kswitchsym then
1599	return readswitchstmt()
1600
1601when lcurlysym then
1602	return readcompoundstmt(0)
1603
1604when kgotosym then
1605	return readgotostmt()
1606
1607when kbreaksym then
1608	if loopindex then
1609		p:=createunit0((looptypestack[loopindex]='L'|j_break|j_breaksw))
1610		lex()
1611	else
1612		serror("break outside loop/sw")
1613	fi
1614
1615when kcontinuesym then
1616	index:=loopindex
1617	while index and looptypestack[index]<>'L' do --index od
1618	if index=0 then
1619		serror("continue outside loop")
1620	fi
1621
1622	p:=createunit0(j_continue)
1623	lex()
1624
1625when kcasesym then
1626	return readcaselabel()
1627
1628when kdefaultsym then
1629	lex()
1630	skipsymbol(colonsym)
1631	return createunit1(j_defaultstmt,readstatement())
1632
1633when kshowmodesym then
1634	lex()
1635	p:=readexpression()
1636	ss:=strexpr(p)
1637	print "Mode is:",ss^.strptr,":",Strmode(p^.mode),"	on line",lx.lineno,
1638		"Size is",ttsize[p^.mode]
1639	if ttisref[p^.mode] then
1640		print " target size",ttsize[tttarget[p^.mode]]
1641	fi
1642	println
1643
1644when kmccassertsym then
1645	dostaticassert()
1646
1647when semisym then
1648	lex()	
1649	return nil
1650
1651when namesym then
1652	if nextlx.symbol=colonsym then
1653		p:=createunit1(j_labelstmt,nil)
1654		d:=resolvename(currproc,lx.symptr,ns_labels,0)
1655		if d then
1656			if d^.index then
1657				cpl lx.symptr^.name
1658				terror("Duplicate label")
1659			else
1660				d^.index:=++labelno
1661			fi
1662		else
1663			d:=createdupldef(currproc,lx.symptr,labelid)
1664			d^.mode:=tvoid
1665			d^.index:=++labelno
1666		fi
1667
1668		p^.def:=d
1669		lex()				!skip colon
1670		lex()
1671!		if lx.symbol=rcurlysym then serror("label before }") fi
1672		if lx.symbol=rcurlysym then
1673		elsif istypestarter() or lx.symbol=klinkagesym then
1674		else
1675			p^.a:=readstatement()
1676		fi
1677		return p
1678	else
1679		ist_symptr:=nil
1680		if isusertype(currproc) then
1681			goto doreaddecl
1682		fi
1683		if ist_symptr then lx.symptr:=ist_symptr fi		!make use of name resolve done by isusertype
1684		p:=readexpression()
1685	fi
1686when ktypespecsym, ktypequalsym, klinkagesym, kfnspecsym,
1687	kstructsym,kunionsym,kenumsym,ktypeofsym then
1688doreaddecl::
1689	return readlocaldecl()
1690
1691else						!assume expression
1692	p:=readexpression()
1693!	TESTEXPR(p)
1694endswitch
1695
1696skipsymbol(semisym)
1697
1698return p
1699end
1700
1701function readifstmt:unit=
1702var unit pcond,pbody,pelse
1703
1704lex()
1705pcond:=readcond()
1706coercecond(pcond)
1707
1708pbody:=readstatement()
1709
1710if pbody^.nextunit=nil and pbody^.tag=j_labelstmt then
1711	serror("conditional label1")
1712fi
1713
1714pelse:=nil
1715
1716if lx.symbol=kelsesym then
1717	lex()
1718	pelse:=readstatement()
1719	if pelse^.nextunit=nil and pelse^.tag=j_labelstmt then
1720		serror("conditional label2")
1721	fi
1722fi
1723
1724return createunit3(j_if,pcond,pbody,pelse)
1725end
1726
1727function readforstmt:unit=
1728var unit pinit, pcond, pincr, pbody, ulist,ulistx, p
1729var int linkage,hasblock,m,mbase
1730var ref paramrec pm
1731var ref strec d
1732
1733lex()
1734skipsymbol(lbracksym)
1735hasblock:=0
1736
1737if lx.symbol<>semisym then
1738
1739	if istypestarter() then
1740		hasblock:=1
1741		pushblock()
1742
1743		mbase:=readdeclspec(currproc,linkage)
1744		ulist:=ulistx:=nil
1745
1746		docase lx.symbol
1747		when namesym, mulsym, lbracksym then
1748
1749			m:=readtype(currproc,d,mbase,pm)
1750			if d=nil then
1751				serror("Var name expected")
1752			fi
1753
1754			if linkage=typedef_ss or pm then
1755				serror("Not allowed in for stmt")
1756			fi
1757INSIDEFOR:=1
1758			d:=readframevar(d,m,linkage)
1759INSIDEFOR:=0
1760
1761			if d^.code then
1762				p:=createunit0(j_decl)
1763				p^.def:=d
1764				addlistunit(&ulist,&ulistx,p)
1765			fi
1766
1767			case lx.symbol
1768			when commasym then			!read next item
1769				lex()
1770			else
1771				exit
1772			esac
1773		else
1774			serror("For decl error")
1775		enddocase
1776		pinit:=createunit3(j_block,ulist,nil,ulistx)
1777
1778	else
1779		pinit:=readexpression()
1780	fi
1781else
1782	pinit:=createunit0(j_null)
1783fi
1784skipsymbol(semisym)
1785
1786if lx.symbol<>semisym then
1787	pcond:=readexpression()
1788	coercecond(pcond)
1789else
1790	pcond:=createunit0(j_null)
1791fi
1792skipsymbol(semisym)
1793
1794if lx.symbol<>rbracksym then
1795	pincr:=readexprstmt()
1796else
1797	pincr:=nil
1798fi
1799skipsymbol(rbracksym)
1800
1801pushloop('L')
1802pbody:=readstatement()
1803poploop()
1804if hasblock then
1805	popblock()
1806fi
1807
1808pinit^.nextunit:=pcond			!the 3 for elements are linked together
1809pcond^.nextunit:=pincr
1810
1811return createunit2(j_for, pinit, pbody)
1812end
1813
1814function readwhilestmt:unit=
1815var unit pcond,pbody
1816
1817lex()
1818pcond:=readcond()
1819coercecond(pcond)
1820pushloop('L')
1821pbody:=readstatement()
1822poploop()
1823
1824return createunit2(j_while,pcond,pbody)
1825end
1826
1827function readdostmt:unit=
1828	var unit pbody,pcond
1829	lex()
1830	pushloop('L')
1831	pbody:=readstatement()
1832	poploop()
1833	skipsymbol(kwhilesym)
1834	pcond:=readcond()
1835	coercecond(pcond)
1836	skipsymbol(semisym)
1837	return createunit2(j_dowhile,pbody,pcond)
1838end
1839
1840function readreturnstmt:unit=
1841	var unit p
1842	lex()
1843	p:=nil
1844
1845	if lx.symbol<>semisym then
1846		if currproc^.mode=tvoid then
1847			terror("Can't return value in void function")
1848		fi
1849
1850		p:=readexpression()
1851		p:=coercemode(p,currproc^.mode)
1852		checksymbol(semisym)
1853	elsif currproc^.mode<>tvoid then
1854		terror("Return value needed")
1855	fi
1856	lex()
1857
1858	return createunit1(j_return,p)
1859end
1860
1861function readgotostmt:unit=
1862	var ref strec d
1863	var unit p
1864
1865	lex()
1866	checksymbol(namesym)
1867	d:=resolvename(currproc,lx.symptr,ns_labels,0)
1868	if d=nil then					!assume fwd ref
1869		d:=createdupldef(currproc,lx.symptr,labelid)
1870		d^.mode:=tvoid
1871!		d^.index:=++labelno
1872	fi
1873	p:=createunit1(j_goto,nil)
1874	p^.def:=d
1875	lex()				!skip colon
1876	skipsymbol(semisym)
1877	return p
1878end
1879
1880function readswitchstmt:unit=
1881	var unit pindex,pstmt,p
1882
1883	lex()
1884	pindex:=readcond()			!not a condition, but it doesn't matter
1885	pushloop('S')
1886	pstmt:=readstatement()			!not a condition, but it doesn't matter
1887	p:=createunit2(j_switch, pindex, pstmt)
1888	p^.nextcase:=casevaluestack[loopindex]
1889
1890	poploop()
1891	return p
1892end
1893
1894function readcaselabel:unit=
1895var unit p,q
1896var int value
1897
1898lex()					!skip case/default
1899value:=readconstintexpr()
1900skipsymbol(colonsym)
1901
1902p:=createunit1(j_casestmt,readstatement())
1903p^.index:=value
1904addcasevalue(value)
1905return p
1906end
1907
1908function readexprstmt:unit=
1909return readexpression()
1910end
1911
1912function readcond:unit=
1913!should be at '(', read conditional expr
1914var unit pcond
1915skipsymbol(lbracksym)
1916pcond:=readexpression()
1917skipsymbol(rbracksym)
1918return pcond
1919end
1920
1921function isusertype(ref strec owner)int=
1922!current symbol is a namesymbol
1923!return typeno if it resolves to a user type, otherwise 0
1924!will peek at following symbol, and returns 0 if "," or ";" follows
1925var ref strec d
1926
1927d:=resolvename(owner,lx.symptr,ns_general,currblockno)
1928if d then
1929	if d^.nameid=typeid then
1930		return d^.mode
1931	fi
1932	ist_symptr:=d
1933fi
1934return 0
1935end
1936
1937function readlocaldecl:unit=
1938!at typebase starter inside function or block
1939var int m,mbase,linkage,nitems,wasenum
1940var ref strec d
1941var unit ulist,ulistx,p
1942var ref paramrec pm
1943
1944ulist:=ulistx:=nil
1945
1946wasenum:=lx.symbol
1947mbase:=readdeclspec(currproc,linkage)
1948nitems:=0
1949
1950docase lx.symbol
1951when namesym, mulsym, lbracksym then
1952	++nitems
1953
1954	m:=readtype(currproc,d,mbase,pm)
1955	if d=nil then
1956		serror("Var name expected")
1957	fi
1958
1959	if linkage=typedef_ss then
1960		d:=createtypedef(currproc,d,m)
1961	elsif pm then
1962		serror("Nested function")
1963	else
1964		d:=readframevar(d,m,linkage)
1965		p:=createunit0(j_tempdecl)
1966		p^.def:=d
1967		addlistunit(&ulist,&ulistx,p)
1968	fi
1969	case lx.symbol
1970	when commasym then			!read next item
1971		lex()
1972	else
1973		skipsymbol(semisym)
1974		exit
1975	esac
1976else
1977	case ttbasetype[mbase]
1978	when tenum, tstruct, tunion then		!assume defining a [part]type only
1979		skipsymbol(semisym)
1980		exit
1981when tsint then
1982	skipsymbol(semisym)
1983	exit
1984
1985	else
1986		serror_s("Local decl error %s",typename(m))
1987	esac
1988enddocase
1989
1990if nitems=0 and fmodern then
1991	case ttbasetype[mbase]
1992	when tstruct,tunion,tenum then
1993	else
1994		if wasenum<>kenumsym then
1995			serror("Empty local declaration")
1996		fi
1997	esac
1998fi
1999
2000return ulist
2001end
2002
2003function createtypedef(ref strec owner, symptr, int mode)ref strec=
2004!symptr is a generic symbol for the name
2005var ref strec d
2006
2007d:=checkdupl(owner,symptr,ns_general,currblockno)
2008
2009if d then			!existing name
2010	if d^.nameid<>typeid then
2011		serror_s("Typedef name in use %s",d^.name)
2012	fi
2013
2014	if d^.mode<>mode then
2015		if not comparemode(d^.mode, mode) then
2016			serror_s("Typedef redefined or can't match types %s",d^.name)
2017		fi
2018	fi
2019	return d
2020fi
2021
2022d:=createdupldef(owner,symptr,typeid)
2023
2024d^.mode:=mode
2025tttypedef[mode]:=d
2026d^.blockno:=currblockno
2027blockcounts[currblockno]:=1
2028
2029return d
2030end
2031
2032function readparams(ref strec owner)ref paramrec=
2033var ref paramrec ulist,ulistx, pm, q
2034var int m,nparams,variadic,flags,nnames
2035var ref strec d
2036
2037ulist:=ulistx:=nil
2038variadic:=nparams:=nnames:=0
2039
2040if callbackflag then			!lex flag is out of step with parser
2041	iscallbackfnx:=1
2042	callbackflag:=0
2043fi
2044
2045while lx.symbol<>rbracksym do
2046	if lx.symbol=ellipsissym then
2047		variadic:=1
2048		lex()
2049		exit
2050	fi
2051
2052	m:=readcasttype(d,1,pm)
2053	if pm then			!was a fu nction; convert to fu nction pointer
2054		m:=createrefmode(createprocmode(m,pm))
2055	fi
2056	if ttbasetype[m]=tarray then
2057		m:=createrefmode(tttarget[m])
2058	fi
2059
2060	pm:=pcm_allocz(paramrec.bytes)
2061	pm^.def:=d
2062	pm^.mode:=m
2063	++nparams
2064	if d then
2065		++nnames
2066		q:=ulist
2067		while q do
2068			if q^.def=d then
2069				serror_ss("Param name reused %s %s",d^.name,namenames[d^.nameid])
2070			fi
2071			q:=q^.nextparam
2072		od
2073
2074	fi
2075	addlistparam(&ulist,&ulistx,pm)
2076	case lx.symbol
2077	when commasym then
2078		lex()
2079	when ellipsissym, rbracksym then
2080	else
2081		serror("bad symbol in paramlist")
2082	esac
2083od
2084
2085flags:=0
2086skipsymbol(rbracksym)
2087
2088if variadic then
2089	flags:=pm_variadic
2090elsif nparams=0 then
2091	if fmodern then
2092		terror("() Params not allowed")
2093	else
2094		flags:=pm_notset
2095	fi
2096elsif nparams=1 and m=tvoid then
2097	flags:=pm_empty
2098	nparams:=0
2099	ulist^.mode:=tnone
2100fi
2101
2102if ulist=nil then
2103	ulist:=pcm_allocz(paramrec.bytes)
2104fi
2105ulist^.nparams:=nparams
2106ulist^.flags:=flags
2107
2108return ulist
2109end
2110
2111function readcasttype(ref strec &d, int allowname=0,ref paramrec &pm)int=
2112!at first symbol of a type-spec
2113!ref paramrec pm
2114var ref strec owner
2115var int m,linkage
2116
2117owner:=(currproc|currproc|stmodule)
2118
2119linkage:=0
2120d:=nil
2121m:=readdeclspec(owner,linkage)
2122pm:=nil
2123
2124case lx.symbol
2125when namesym, mulsym, lbracksym, lsqsym then
2126	m:=readtype(owner,d, m, pm)
2127	if d and not allowname then
2128		serror_s("NAME not allowed in cast type %s",d^.name)
2129	fi
2130esac
2131
2132return m
2133end
2134
2135function readfunction(ref strec d, int m, linkage, ref paramrec pm, int &wasdef)ref strec=
2136!have read function declaration, with ";" or "{" next
2137!d is generic st entry for name
2138!m is return type
2139!pm is linked list of parameter types
2140!set up the declaration properly in symbol table, checking for duplicates etc
2141!read function body if {...} follows
2142!return wasdef=1 if {...} encountered, as looping in the caller will be affected
2143
2144var ref strec f,owner
2145var int scope
2146
2147owner:=stmodule
2148wasdef:=0
2149
2150f:=checkdupl(owner, d, ns_general, 0)
2151
2152if f then					!already exists
2153	if f^.nameid<>procid then
2154		serror_s("fn: name in use %s",d^.name)
2155	fi
2156!COMPARE PARAM LISTS...
2157!	if e^.paramlist<>pm then
2158!		serror("fn: params don't match previous")
2159!	fi
2160	d:=f
2161
2162!see how scope interacts with existing decl
2163	scope:=d^.scope
2164	if scope=local_scope and linkage=none_ss or\
2165	   scope=exported_scope and linkage=static_ss or\
2166	   scope=imported_scope and linkage=static_ss then
2167!*!		serror("Linkage3 mismatch")
2168	elsif scope=imported_scope and linkage=none_ss then
2169		scope:=exported_scope
2170	fi
2171
2172
2173else
2174	d:=createdupldef(owner,d,procid)
2175	d^.mode:=m
2176	case linkage
2177	when static_ss then
2178		scope:=local_scope
2179	when extern_ss then
2180		scope:=imported_scope
2181	else
2182		scope:=exported_scope
2183	esac
2184	if iscallbackfnx then
2185		d^.attribs.ax_callback:=1
2186		iscallbackfnx:=0
2187	fi
2188fi
2189
2190d^.paramlist:=pm
2191d^.scope:=scope
2192
2193if lx.symbol=lcurlysym then
2194	wasdef:=1
2195	if d^.code then
2196		serror_s("Can't define function twice %s",d^.name)
2197	fi
2198	if scope=imported_scope then
2199!		serror("Can't define imported function")
2200	fi
2201
2202	readfunctionbody(d)
2203	if lx.symbol=semisym then
2204		serror("; after function def")
2205	fi
2206fi
2207
2208return d
2209end
2210
2211proc readfunctionbody(ref strec f)=
2212!positioned just after '{'; return at '}' (checked by caller)
2213var ref strec e
2214var unit p
2215var ref paramrec pm
2216var int pmcount
2217
2218currproc:=f
2219nextblockno:=currblockno:=0
2220pmcount:=0
2221
2222!add named patams
2223pm:=f^.paramlist
2224if pm^.def then			!params are named
2225	to pm^.nparams do
2226		e:=createdupldef(f,pm^.def,paramid)
2227		e^.blockno:=1
2228		e^.mode:=pm^.mode
2229		pm:=pm^.nextparam
2230		pmcount:=1
2231	od
2232elsif pm^.nparams then
2233	serror("Param names missing")
2234fi
2235
2236p:=readcompoundstmt(pmcount)
2237currproc^.code:=p
2238currproc:=nil
2239end
2240
2241function createnegop(unit p)unit=
2242var unit q
2243var int t
2244
2245t:=p^.mode
2246
2247if p^.tag=j_const then
2248	case t
2249	when tsint,tsllong,tullong then
2250		p^.value:=-p^.value
2251		return p
2252	when tuint then
2253		p^.value:=(-p^.value) iand 0xFFFF'FFFF
2254		return p
2255	when tdouble then
2256		p^.xvalue:=-p^.xvalue
2257		return p
2258	esac
2259fi
2260retry::
2261if t>=tfirstnum and t<=tlastnum then
2262	coercebasetype(p)
2263	q:=createunit1(j_neg,p)
2264elsif ttconst[t] then
2265	t:=ttconsttype[t]
2266	goto retry
2267else
2268CPL Strmode(t)
2269	terror("neg bad type")
2270fi
2271
2272q^.mode:=p^.mode
2273return q
2274end
2275
2276function createabsop(unit p)unit=
2277var unit q
2278var int t
2279
2280t:=p^.mode
2281
2282if p^.tag=j_const then
2283	case t
2284	when tsint,tsllong then
2285		p^.value:=abs(p^.value)
2286		return p
2287	esac
2288fi
2289
2290if t>=tfirstint and t<=tlastint then
2291	coercebasetype(p)
2292	q:=createunit1(j_abs,p)
2293else
2294	terror("abs bad type")
2295fi
2296
2297q^.mode:=p^.mode
2298return q
2299end
2300
2301function createsqrtop(unit p)unit=
2302var unit q
2303var int t
2304
2305t:=p^.mode
2306
2307if p^.tag=j_const then
2308	case t
2309	when tfloat,tdouble then
2310		p^.value:=sqrt(p^.xvalue)
2311		return p
2312	esac
2313fi
2314
2315coercemode(p,tdouble)
2316
2317q:=createunit1(j_sqrt,p)
2318q^.mode:=tdouble
2319
2320return q
2321end
2322
2323function createinotop(unit p)unit=
2324var unit q
2325var int t
2326
2327t:=ttbasetype[p^.mode]
2328
2329if p^.tag=j_const then
2330	case t
2331	when tsint,tsllong,tuint,tullong then
2332		p^.value:=inot p^.value
2333		return p
2334	esac
2335fi
2336if t>tfirstint and t<=tlastint then
2337	coercebasetype(p)
2338	q:=createunit1(j_inot,p)
2339else
2340cpl Strmode(t)
2341	terror("! bad type")
2342fi
2343
2344q^.mode:=p^.mode
2345return q
2346end
2347
2348function createptrop(unit p)unit=
2349var unit q
2350var int t,m
2351
2352if not ttisref[t:=p^.mode] then
2353	terror("* not pointer")
2354fi
2355m:=tttarget[t]
2356
2357case p^.tag
2358when j_addrof then
2359	q:=p^.a
2360	if p^.alength then
2361		q^.mode:=tttarget[p^.mode]
2362	fi
2363	return q
2364esac
2365
2366q:=createunit1(j_ptr,p)
2367q^.mode:=m
2368q:=arraytopointer(q)
2369fixmemopnd(q)
2370
2371return q
2372end
2373
2374function createincrop(int opc,unit p)unit=
2375!opc is j_preincr/decr or j_postincr/decr
2376var unit q
2377var int t
2378
2379t:=p^.mode
2380
2381checklvalue(p)
2382unless t>=tfirstint and t<=tlastint and t<>tbool or ttisref[t] then
2383	terror("++ bad type")
2384endunless
2385q:=createunit1(opc,p)
2386q^.mode:=p^.mode
2387
2388return q
2389end
2390
2391function createlengthofop(unit p)unit=
2392var unit q
2393var int t,size
2394
2395t:=p^.mode
2396switch p^.tag
2397when j_name then
2398	size:=ttlength[p^.def^.mode]			!take account of array
2399
2400when j_const then
2401	if t=trefchar then					!const string
2402		size:=p^.slength+1
2403	else
2404		size:=ttlength[t]
2405	fi
2406
2407when j_ptr then
2408	if ttisref[t] and p^.alength then		!result of array=>ptr conversion
2409		size:=ttlength[tttarget[t]]*p^.alength
2410	else
2411		size:=ttlength[t]
2412	fi
2413when j_widenmem then
2414	return createsizeofop(p^.a)
2415
2416else
2417	size:=ttlength[t]
2418endswitch
2419
2420q:=createconstunit(size,tsint)
2421return q
2422end
2423
2424function createaddrofop(unit p)unit=
2425var ref strec d
2426var unit q
2427var int t,u,alength
2428
2429alength:=0
2430
2431restartx::
2432t:=p^.mode
2433switch p^.tag
2434when j_name then
2435	if p^.alength then
2436		t:=p^.def^.mode
2437		alength:=p^.alength
2438	fi
2439
2440when j_addrof then
2441	if p^.a^.tag=j_name and p^.a^.alength then		!sounds like ANAME => &ANAME
2442		p^.mode:=createrefmode(p^.a^.def^.mode)
2443p^.alength:=p^.a^.alength
2444		return p
2445	fi
2446!doname:
2447!	d:=p^.def
2448!	if d^.nameid=constantid then serror("&constant not allowed") fi
2449!	m:=createrefmode(d^.mode)
2450!
2451!when j_funcname then
2452!	m:=createprocmode(p^.def^.mode,p^.def^.paramlist)
2453!
2454!when j_ptr then				!should cancel out
2455!	return p^.a
2456!
2457!when j_ptroffset then
2458!	p^.tag:=j_addptr
2459!	p^.mode:=createrefmode(p^.mode)
2460!	return p
2461!
2462!when j_addptr then
2463!	if p^.alength then	!derived from array expr that converted to pointer
2464!		p^.mode:=createrefmode(createarraymode(tttarget[t],p^.alength))
2465!		return p
2466!	else
2467!		goto cad1
2468!	fi
2469!when j_convert then
2470!	if p^.a^.tag=j_name then			!assume added by readterm
2471!		p:=p^.a
2472!		goto doname
2473!	fi
2474!	goto cad1
2475when j_dot then
2476	q:=p^.a
2477	if q^.tag=j_ptr and q^.a^.tag=j_const then
2478		p:=createconstunit(p^.offset+q^.a^.value, tsint)
2479		return p
2480	fi
2481	goto cad1
2482when j_addptr then
2483	if p^.alength then
2484		p^.mode:=createrefmode(createarraymode(tttarget[p^.mode],p^.alength))
2485		return p
2486	fi
2487when j_widenmem then
2488	p:=p^.a
2489	goto restartx
2490when j_funcname then
2491	return p
2492!when j_const then
2493!	if t=trefchar then					!const string
2494!		t:=createarraymode(tuchar,p^.slength+1)
2495!	else
2496!		goto cad1
2497!	fi
2498else
2499
2500cad1::
2501	checklvalue(p)
2502endswitch
2503
2504p:=createunit1(j_addrof,p)
2505p^.mode:=createrefmode(t)
2506p^.alength:=alength
2507
2508!CPL "ADDROF",STRMODE(P^.MODE),STRMODE2(T)
2509
2510return p
2511end
2512
2513function createaddop(unit x,y)unit=
2514var unit z
2515var int s,t,u,opc,elemsize
2516
2517!s:=ttbasetype[x^.mode]
2518!t:=ttbasetype[y^.mode]
2519s:=ttbasetype[getmemmode(x)]
2520t:=ttbasetype[getmemmode(y)]
2521opc:=j_add
2522
2523if u:=dominantmode[s,t] then			!were both numeric
2524	x:=coercemode(x,u)
2525	y:=coercemode(y,u)
2526
2527elsif s=tref then
2528doaddref::
2529	u:=x^.mode
2530	elemsize:=ttsize[tttarget[u]]
2531	if x^.tag=j_const and y^.tag=j_const then
2532		x^.value +:=y^.value*elemsize
2533		return x
2534	fi
2535
2536	y:=coercemode(y,tptroffset)
2537
2538	z:=createunit2(j_addptr,x,y)
2539	z^.mode:=u
2540	z^.ptrscale:=elemsize
2541	return z
2542
2543elsif t=tref then
2544	swap(x,y)
2545	goto doaddref
2546else
2547	terror("Sub bad types")
2548fi
2549
2550if x^.tag=j_const and y^.tag=j_const then
2551	return eval_add(opc,x,y,u)
2552fi
2553z:=createunit2(opc,x,y)
2554z^.mode:=u
2555
2556return z
2557end
2558
2559function createsubop(unit x,y)unit=
2560var unit z
2561var int s,t,u,opc,elemsize
2562
2563!s:=ttbasetype[x^.mode]
2564!t:=ttbasetype[y^.mode]
2565s:=ttbasetype[getmemmode(x)]
2566t:=ttbasetype[getmemmode(y)]
2567opc:=j_sub
2568
2569if u:=dominantmode[s,t] then			!were both numeric
2570	x:=coercemode(x,u)
2571	y:=coercemode(y,u)
2572elsif s=tref then
2573	if t<>tref then
2574		u:=x^.mode
2575		elemsize:=ttsize[tttarget[u]]
2576		y:=coercemode(y,tptroffset)
2577
2578		z:=createunit2(j_subptr,x,y)
2579		z^.mode:=u
2580		z^.ptrscale:=elemsize
2581		return z
2582
2583	else							!ref-ref
2584		z:=createunit2(opc,x,y)
2585		z^.mode:=tptroffset
2586		z:=divunit(z,tttarget[x^.mode])
2587		z^.mode:=tptroffset
2588		return z
2589	fi
2590	y:=mulunit(y,tttarget[x^.mode])
2591else
2592	terror("Sub bad types")
2593fi
2594
2595if x^.tag=j_const and y^.tag=j_const then
2596	return eval_sub(opc,x,y,u)
2597fi
2598z:=createunit2(opc,x,y)
2599z^.mode:=u
2600
2601return z
2602end
2603
2604function createmulop(unit x,y)unit=
2605var unit z
2606var int s,t,u,opc
2607
2608!s:=ttbasetype[x^.mode]
2609!t:=ttbasetype[y^.mode]
2610s:=ttbasetype[getmemmode(x)]
2611t:=ttbasetype[getmemmode(y)]
2612
2613opc:=j_mul
2614if u:=dominantmode[s,t] then			!were both numeric
2615	x:=coercemode(x,u)
2616	y:=coercemode(y,u)
2617else
2618	terror("Mul bad types")
2619fi
2620
2621if x^.tag=j_const and y^.tag=j_const then
2622	return eval_mul(opc,x,y,u)
2623fi
2624z:=createunit2(opc,x,y)
2625z^.mode:=u
2626
2627return z
2628end
2629
2630function createdivop(unit x,y)unit=
2631var unit z
2632var int s,t,u,opc
2633
2634s:=ttbasetype[getmemmode(x)]
2635t:=ttbasetype[getmemmode(y)]
2636
2637opc:=j_div
2638if u:=dominantmode[s,t] then			!were both numeric
2639	x:=coercemode(x,u)
2640	y:=coercemode(y,u)
2641else
2642	terror("Div bad types")
2643fi
2644
2645if x^.tag=j_const and y^.tag=j_const then
2646	return eval_div(opc,x,y,u)
2647fi
2648z:=createunit2(opc,x,y)
2649z^.mode:=u
2650
2651return z
2652end
2653
2654function createremop(unit x,y)unit=
2655var unit z
2656var int s,t,u,opc
2657
2658s:=ttbasetype[x^.mode]
2659t:=ttbasetype[y^.mode]
2660
2661opc:=j_rem
2662if u:=dominantmode[s,t] then			!were both numeric
2663	if u=tdouble or u=tfloat then
2664!		u:=tsllong
2665		u:=tsint
2666	fi
2667	x:=coercemode(x,u)
2668	y:=coercemode(y,u)
2669else
2670	terror("Rem bad types")
2671fi
2672
2673if x^.tag=j_const and y^.tag=j_const then
2674	return eval_rem(opc,x,y,u)
2675fi
2676z:=createunit2(opc,x,y)
2677z^.mode:=u
2678
2679return z
2680end
2681
2682proc insertunit(unit p, int tag)=
2683!wrap extra unit around p, using given tag
2684var unit q
2685q:=createunit0(0)			!empty unit
2686q^:=p^
2687p^.tag:=tag
2688p^.a:=q
2689p^.b:=p^.c:=nil
2690p^.lineno:=q^.lineno
2691p^.simple:=0
2692p^.nextunit:=q^.nextunit
2693
2694q^.nextunit:=nil
2695end
2696
2697function eval_add(int opc,unit x,y,int t)unit=
2698var unit z
2699
2700case t
2701when tsint,tsllong,tuint,tullong then
2702	x^.value +:= y^.value
2703	return x
2704when tdouble then
2705	x^.xvalue +:= y^.xvalue
2706	return x
2707elsif ttbasetype[t]=tref then	!assume y is const 0 int of any sub-type
2708	x^.value +:= y^.value*ttsize[tttarget[t]]
2709	return x			!will not change x
2710esac
2711
2712z:=createunit2(opc,x,y)
2713z^.mode:=t
2714return z
2715end
2716
2717function eval_sub(int opc,unit x,y,int t)unit=
2718var unit z
2719
2720case t
2721when tsint,tsllong then
2722	x^.value -:= y^.value
2723	return x
2724when tdouble then
2725	x^.xvalue -:= y^.xvalue
2726	return x
2727elsif ttbasetype[t]=tref then
2728	if ttbasetype[y^.mode]=tref then
2729		terror("EVALSUB/REF")
2730	fi
2731	return x
2732esac
2733
2734z:=createunit2(opc,x,y)
2735z^.mode:=t
2736return z
2737end
2738
2739function eval_mul(int opc,unit x,y,int t)unit=
2740var unit z
2741
2742case t
2743when tsint,tsllong,tsshort,tschar then
2744	x^.value *:= y^.value
2745	return x
2746when tuint,tullong,tushort,tuchar then
2747!	x^.uvalue *:= y^.uvalue
2748	x^.uvalue := x^.uvalue*y^.uvalue
2749	return x
2750when tdouble then
2751	x^.xvalue *:= y^.xvalue
2752	return x
2753esac
2754
2755z:=createunit2(opc,x,y)
2756z^.mode:=t
2757return z
2758end
2759
2760function eval_div(int opc,unit x,y,int t)unit=
2761var unit z
2762
2763case t
2764when tsint,tsllong then
2765	if y^.value=0 then serror("div 0") fi
2766	x^.value := x^.value/y^.value
2767	return x
2768when tdouble then
2769!	if y^.xvalue=0 then serror("div 0.0") fi
2770	x^.xvalue /:= y^.xvalue
2771	return x
2772esac
2773
2774z:=createunit2(opc,x,y)
2775z^.mode:=t
2776return z
2777end
2778
2779function eval_rem(int opc,unit x,y,int t)unit=
2780var unit z
2781
2782case t
2783when tsint,tsllong then
2784	if y^.value=0 then serror("rem 0") fi
2785	x^.value := x^.value rem y^.value
2786	return x
2787esac
2788
2789z:=createunit2(opc,x,y)
2790z^.mode:=t
2791return z
2792end
2793
2794function eval_convert(unit p, int t,opc)int=
2795!p contains a const unit, t is a target type, opc is conv op
2796!try and convert if possible
2797!return 1 if converted
2798var int s
2799
2800if opc=soft_c then
2801dosoft::
2802	p^.mode:=t
2803	return 1
2804fi
2805
2806s:=p^.mode
2807if s=t then return 1 fi
2808
2809case s
2810when tsint,tsshort,tschar,tsllong then
2811	case t
2812	when tdouble,tfloat then
2813		p^.xvalue:=p^.value
2814		p^.mode:=t
2815		return 1
2816	when tullong,tsllong,tuint,tsint,tsshort,tschar,tuchar,tushort then
2817dotrunc::
2818		case ttsize[t]
2819		when 1 then p^.value iand:=255
2820		when 2 then p^.value iand:=65535
2821!		when 4 then p^.value iand:=0xFFFF'FFFF
2822		when 4 then p^.value :=p^.value iand 0xFFFF'FFFF
2823		esac
2824
2825		goto dosoft
2826	esac
2827	if ttisref[t] then
2828		p^.mode:=t
2829		return 1
2830	fi
2831
2832when tuint,tuchar,tushort,tullong then
2833	case t
2834	when tdouble,tfloat then
2835		if p^.value>=0 then
2836			p^.xvalue:=p^.value
2837		else
2838			p^.xvalue:=-p^.value
2839		fi
2840		p^.mode:=t
2841		return 1
2842	when tullong,tsllong,tsint,tuint,tullong,tushort,tschar,tuchar,tsshort then
2843		goto dotrunc
2844	esac
2845	if ttisref[t] then
2846		p^.mode:=t
2847		return 1
2848	fi
2849
2850when tdouble then
2851	case t
2852	when tsint then
2853		p^.value:=p^.xvalue
2854		p^.mode:=tsint
2855		return 1
2856	when tfloat then
2857		p^.mode:=tfloat
2858		return 1
2859	esac
2860elsif ttisref[p^.mode] then
2861	case t
2862	when tsint,tsllong,tuint,tullong then
2863		p^.mode:=t
2864		return 1
2865	esac
2866esac
2867
2868return 0
2869end
2870
2871proc coercecond(unit p)=
2872!p is an expression used as a condition
2873!make sure it is an int, or convert it to one
2874var int t
2875if (t:=p^.mode)=tsint then return fi
2876
2877retry::
2878case ttbasetype[t]
2879when tfloat,tdouble,tref then
2880	goto doint
2881
2882elsif t>=tfirstint and t<=tlastint then
2883doint::
2884	if p^.tag=j_const and p^.value then			!check all types as one 64-bit field
2885		p^.value:=1
2886	else
2887		insertunit(p,j_istruel)
2888	fi
2889elsif ttconst[t] then
2890	t:=ttconsttype[t]
2891	goto retry
2892else
2893
2894	serror_s("Invalid condition %s",Strmode(t))
2895esac
2896p^.mode:=tsint
2897end
2898
2899proc coercebasetype(unit p)=
2900var int t
2901
2902if (t:=p^.mode)>=tschar and t<=tsshort then
2903	p:=coercemode(p,tsint)
2904elsif t>=tbool and t<=tushort then
2905	p:=coercemode(p,tuint)
2906fi
2907end
2908
2909proc checklvalue(unit p)=
2910case p^.tag
2911when j_name then
2912	if p^.def^.nameid=constantid then
2913		serror("'constant' name can't be lvalue")
2914	fi
2915when j_ptr then
2916
2917when j_funcname then
2918
2919when j_widenmem then
2920	case p^.a^.tag
2921	when j_name,j_ptr,j_dot then
2922		p^:=p^.a^
2923	else
2924		terror("CHECKLV/WIDEN")
2925	esac
2926
2927when j_dot then
2928
2929!when j_ptroffset then
2930
2931when j_const then
2932	if not ttisref[p^.mode] then
2933		goto notlv
2934	fi
2935when j_convert then
2936	if p^.a^.tag=j_name then
2937!		p^:=p^.a^
2938		return
2939	fi
2940
2941else
2942notlv::
2943	printunit(nil,p)
2944	terror_s("Not lvalue: %s",jtagnames[p^.tag])
2945esac
2946end
2947
2948function createcall(unit p,q)unit=
2949!p is unit on left of param list, while q is the param list as the head of a unitlist
2950!do type-checking on params, and construct and return callfn unit
2951!p can be a simple name, or an expression that should be a function po inter
2952var unit r,s
2953var ref strec d
2954var ref paramrec pm
2955var int i,nparams,aparams,retmode,mproc,m
2956
2957case p^.tag
2958when j_ptr then
2959doptr::
2960	mproc:=p^.mode
2961
2962	while ttbasetype[mproc]=tref do
2963		r:=createunit1(j_ptr,p)
2964		mproc:=tttarget[mproc]
2965		r^.mode:=mproc
2966		p:=r
2967	od
2968
2969	if ttbasetype[mproc]<>tproc then
2970CPL =STRMODE(MPROC), =STRMODE(TTBASETYPE[MPROC]),=STRMODE(TPROC)
2971		serror_s("Not function pointer: %s",typename(mproc))
2972	fi
2973
2974	pm:=ttparams[mproc]
2975	retmode:=tttarget[mproc]
2976
2977when j_name,j_funcname then
2978	d:=p^.def
2979	if d^.nameid=procid then
2980		pm:=d^.paramlist
2981		retmode:=d^.mode
2982	else							!assume fnptr, but needs ptr unit
2983		r:=createunit1(j_ptr,p)
2984		r^.mode:=tttarget[d^.mode]
2985		p:=r
2986		goto doptr
2987	fi
2988when j_dot,j_callfn,j_ifx then
2989	r:=createunit1(j_ptr,p)
2990	r^.mode:=tttarget[p^.mode]
2991	p:=r
2992	goto doptr
2993
2994!when j_callfn then
2995!	r:=createunit1(j_ptr,p)
2996!	r^.mode:=tttarget[p^.mode]
2997!	p:=r
2998!	goto doptr
2999
3000else
3001CPL =JTAGNAMES[P^.TAG]
3002PRINTUNIT(NIL,P)
3003	serror("ccall?")
3004esac
3005
3006!CPL "CALL2"
3007
3008nparams:=pm^.nparams
3009aparams:=0
3010
3011s:=q
3012while s do
3013	++aparams				!number of actual params supplied
3014	s:=s^.nextunit
3015od
3016
3017!checking params is a little tricky because of variadic params
3018!but there must be at least <nparams> actual params.
3019
3020if aparams<nparams then
3021	terror("Too few args")
3022elsif aparams>nparams and pm^.flags<>pm_variadic and pm^.flags<>pm_notset then
3023!elsif aparams>nparams and pm^.flags<>pm_variadic then
3024	if pm^.flags<>pm_notset then
3025		cpl aparams,nparams
3026		terror("Too many args")
3027	elsif fmodern then
3028		terror("Can't call () param function")
3029	fi
3030fi
3031
3032s:=q
3033for i:=1 to aparams do
3034	if i<=nparams then
3035		coercemode_inplace(s,pm^.mode)
3036		pm:=pm^.nextparam
3037	else					!assume variadic param
3038		if s^.mode=tvoid then
3039			terror("Variadic param is void")
3040		fi
3041		coercebasetype(s)
3042	fi
3043	s:=s^.nextunit
3044od
3045
3046r:=createunit2(j_callfn,p,q)
3047r^.mode:=retmode
3048r^.aparams:=aparams
3049
3050!CPL "CALLX"
3051
3052return r
3053end
3054
3055function arraytopointer(unit p)unit=
3056var unit q
3057var int offset
3058var int t,elemmode,refmode
3059
3060t:=p^.mode
3061elemmode:=tttarget[t]
3062
3063if ttbasetype[t]=tarray then
3064	refmode:=createrefmode(elemmode)
3065	case p^.tag
3066	when j_ptr then
3067		p:=p^.a
3068
3069	when j_dot then						!about to access array field
3070		offset:=p^.offset
3071		p^.tag:=j_addptr
3072		p^.ptrscale:=0	!ttsize[elemmode]
3073!		p^.a^.mode:=refmode
3074		q:=createunit1(j_addrof,p^.a)
3075		q^.mode:=refmode
3076		p^.a:=q
3077		p^.b:=createconstunit(offset,tsint)
3078
3079	else
3080		CPL "ATP:"
3081		printunit(nil,p)
3082		terror("ATP?")
3083	esac
3084
3085	p^.mode:=refmode
3086	p^.alength:=ttlength[t]
3087
3088fi
3089return p
3090end
3091
3092function createindexop(unit p,q)unit=
3093!do p[q]
3094!convert to *(p+q)
3095var unit a
3096
3097a:=createaddop(p,q)
3098return createptrop(a)
3099end
3100
3101function readstructdecl(ref strec owner)int=
3102var ref strec d,e,currrecord
3103var ref strec ulist,ulistx,tagowner
3104var int funion,linkage,mbase,m
3105var int offset,recsize,maxsize,maxalignment,alignment,size
3106var ref paramrec pm
3107var ref fieldrec fieldlist,fl
3108
3109funion:=(lx.symbol=kunionsym)
3110
3111lex()				!skip 'struct' etc
3112
3113tagowner:=(currproc|currproc|stmodule)
3114
3115if lx.symbol=lcurlysym then				!anonymous struct tag
3116	d:=addnamestr(nextautotype())
3117else
3118	checksymbol(namesym)
3119	d:=lx.symptr		!should be struct tag
3120	lex()
3121
3122	if lx.symbol<>lcurlysym then			!reading incomplete enum
3123		e:=resolvename(tagowner,d,ns_tags,currblockno)
3124		if e then
3125			if e^.nameid<>structtagid then
3126				serror_s("Struct tag in use %s",e^.name)
3127			fi
3128
3129			return e^.mode
3130		fi
3131!create new incomplete tag
3132		e:=createdupldef(tagowner,d,structtagid)
3133		e^.mode:=createstructmode(e,(funion|tunion|tstruct))
3134		e^.blockno:=currblockno
3135		blockcounts[currblockno]:=1
3136		return e^.mode
3137	fi
3138fi
3139
3140!{ seen, so defining a new struct
3141
3142e:=checkdupl(tagowner,d,ns_tags,currblockno)
3143
3144if e then			!found in this linkage
3145	if e^.nameid<>structtagid then
3146		serror_s("Struct tag in use %s",e^.name)
3147	fi
3148	if e^.deflist then					!else filling in incomplete enum
3149		cpl "Prev",e^.lineno iand 1677215, sourcefilenames[e^.lineno>>24],sourcefilepaths[e^.lineno>>24]
3150		serror_s("Redefining struct %s",e^.name)
3151	fi
3152else						
3153	e:=createdupldef(tagowner,d,structtagid)
3154	e^.mode:=createstructmode(e,(funion|tunion|tstruct))
3155	e^.blockno:=currblockno
3156	blockcounts[currblockno]:=1
3157fi
3158
3159!e points to an def which has an empty {...} list
3160lex()							!skip {
3161
3162currrecord:=e
3163ulist:=ulistx:=nil
3164offset:=maxsize:=recsize:=0
3165maxalignment:=1
3166fieldlist:=nil
3167m:=-1
3168
3169while lx.symbol<>rcurlysym do
3170	mbase:=readdeclspec(currrecord,linkage)
3171
3172	docase lx.symbol
3173	when namesym, mulsym, lbracksym then
3174
3175		m:=readtype(currrecord,d,mbase,pm)
3176		if d=nil then
3177			serror("Field name expected")
3178		fi
3179
3180		if linkage=typedef_ss or pm then
3181			serror("typedef or function inside struct")
3182		fi
3183
3184		e:=checkdupl(currrecord, d, ns_fields, 0)
3185
3186		if e then					!already exists
3187			serror_s("member name in use %s",e^.name)
3188		fi
3189
3190		if linkage<>none_ss then
3191			serror("Can't use ss in struct")
3192		fi
3193
3194addanonfield::
3195		d:=createdupldef(nil,d,fieldid)
3196		d^.mode:=m
3197!name is not linked in to record as they must be in sequence
3198		addlistdef(&ulist,&ulistx,d)
3199		currrecord^.deflist:=ulist				!needed for dupl checking
3200		currrecord^.deflistx:=ulistx
3201		d^.owner:=currrecord
3202		alignment:=getalignment(m)
3203		if alignment>maxalignment then maxalignment:=alignment fi
3204
3205		d^.offset:=roundoffset(offset,alignment)
3206		size:=ttsize[m]
3207		recsize+:=d^.offset-offset
3208		offset:=d^.offset
3209
3210		addnewfield(fieldlist,d,offset)
3211
3212		if funion then
3213			maxsize:=max(maxsize,size)
3214		else
3215			offset+:=size
3216			recsize+:=size
3217		fi
3218
3219		if lx.symbol=colonsym then
3220			lex()
3221			readassignexpr()
3222		fi
3223
3224		case lx.symbol
3225		when commasym then			!read next item
3226			lex()
3227		else
3228			skipsymbol(semisym)
3229			exit
3230		esac
3231	when colonsym then				!apparently int:24 is allowed, with no member name
3232		lex()
3233		readassignexpr()
3234		skipsymbol(semisym)
3235		exit
3236	else
3237		case ttbasetype[mbase]
3238		when tstruct, tunion then		!assume defining a [part]type only
3239			d:=getautofieldname()
3240			m:=mbase
3241			goto addanonfield
3242		else
3243			if m=-1 then
3244				serror("Struct decl error")
3245			else
3246				serror_s("Struct decl error %s",typename(m))
3247			fi
3248		esac
3249	enddocase
3250od
3251
3252skipsymbol(rcurlysym)
3253
3254currrecord^.nextfield:=fieldlist
3255ttsize[currrecord^.mode]:=roundoffset((funion|maxsize|recsize),maxalignment)
3256currrecord^.attribs.ax_align:=maxalignment
3257
3258return currrecord^.mode
3259end
3260
3261function checkpointertypes(int s,t,hard)int=
3262!return 1 if pointer types s and t are compatible
3263!it is assumed that s is to be converted to t, or passed as a parameter expecting t
3264var int starget:=tttarget[s], ttarget:=tttarget[t]
3265var int sconst:=0,tconst:=0
3266
3267if ttconst[starget] then
3268	starget:=ttconsttype[starget]
3269	sconst:=1
3270fi
3271if ttconst[ttarget] then
3272	ttarget:=ttconsttype[ttarget]
3273	tconst:=1
3274fi
3275
3276if not hard and sconst and not tconst then
3277	cpl Strmode(s)
3278	cpl Strmode(t)
3279	terror("const to non-const pointer")
3280fi
3281
3282if starget=ttarget then return 1 fi
3283s:=starget
3284t:=ttarget
3285if ttbasetype[s]=tvoid or ttbasetype[t]=tvoid then
3286	return 1
3287fi
3288
3289if ttisref[s] and ttisref[t] then
3290
3291	return checkpointertypes(s,t,hard)
3292elsif ttbasetype[s]=tarray and ttbasetype[t]=tarray then
3293	if ttlength[s]<>ttlength[t] then
3294		if ttlength[s] and ttlength[t] then		!allow one dim to be 0
3295			return 0
3296		fi
3297	fi
3298	starget:=tttarget[s]
3299	ttarget:=tttarget[t]
3300	if starget=ttarget then return 1 fi
3301
3302	if ttisref[starget] and ttisref[ttarget] then
3303		return checkpointertypes(starget,ttarget,hard)
3304	fi
3305elsif ttbasetype[s]=tproc and ttbasetype[t]=tproc then
3306	return 1				!NEED PROPER MATCH HERE
3307fi
3308
3309return 0
3310end
3311
3312function comparemode(int s,t)int=
3313!types s and t don't immediately match
3314!check further to see if they are compatible
3315!For example, if they are both arrays, then usually they will have different
3316!typenumbers. Arrays should match if they have the same element type, and
3317!same length, or one length is 0
3318!return 1 for compatible types
3319
3320if s=t then return 1 fi			!for when used recursively
3321if ttbasetype[s]=tarray and ttbasetype[s]=tarray then
3322	if comparemode(tttarget[s],tttarget[t])=0 then
3323		return 0
3324	fi
3325	if ttlength[s]=0 or ttlength[t]=0 or ttlength[s]=ttlength[t] then
3326		return 1
3327	fi
3328fi
3329return 0
3330end
3331
3332function readenumdecl(ref strec owner)int=
3333var ref strec d,e
3334
3335lex()				!skip 'enum'
3336
3337if lx.symbol=lcurlysym then				!anonymous enum tag
3338	readenumnames(owner)
3339	return tenum			!return generic enum
3340fi
3341
3342checksymbol(namesym)
3343d:=lx.symptr		!should be enum tag
3344lex()
3345
3346if lx.symbol<>lcurlysym then			!reading incomplete enum
3347	e:=checkdupl(owner, d, ns_tags, currblockno)
3348
3349	if e then
3350		if e^.nameid<>enumtagid then
3351			serror_s("Enum tag in use %s",e^.name)
3352		fi
3353	fi
3354
3355!create new incomplete enum tag
3356	e:=createdupldef(owner,d,enumtagid)
3357	e^.mode:=createenummode(e)
3358	e^.blockno:=currblockno
3359	blockcounts[currblockno]:=1
3360	return e^.mode
3361fi
3362
3363!{ seen, so defining a new enum
3364e:=checkdupl(owner,d,ns_tags,currblockno)
3365
3366if e then			!found in this linkage
3367	if e^.nameid<>enumtagid then
3368		serror_s("Enum tag in use %s",e^.name)
3369	fi
3370	if e^.deflist then					!else filling in incomplete enum
3371		serror_s("Redefining enum %s",e^.name)
3372	fi
3373else						
3374	e:=createdupldef(owner,d,enumtagid)
3375	e^.mode:=createenummode(e)
3376	e^.blockno:=currblockno
3377	blockcounts[currblockno]:=1
3378fi
3379
3380!e points to an enum def which has an empty {...} list
3381!Now loop reading enum values
3382
3383readenumnames(owner)
3384
3385ttnamedef[e^.mode]:=e
3386return e^.mode
3387end
3388
3389proc readenumnames(ref strec owner)=
3390!at '{'; read set of enum names
3391var ref strec d,e
3392var ref strec ulist,ulistx
3393var int enumseq
3394
3395ulist:=ulistx:=nil
3396enumseq:=0
3397lex()
3398
3399case owner^.nameid
3400when procid,moduleid then		!fine
3401else							!probably inside a struct
3402	owner:=(currproc|currproc|stmodule)
3403esac
3404
3405while lx.symbol=namesym do
3406	d:=checkdupl(owner,lx.symptr,ns_general,currblockno)
3407	if d then
3408		serror_s("enum name reused %s",d^.name)
3409	fi
3410	d:=createdupldef(owner,lx.symptr,enumid)
3411!CPL "CREATED ENUM NAME",D^.NAME,"IN",OWNER^.NAME,NAMENAMES[OWNER^.NAMEID],CURRPROC,STMODULE
3412	lex()
3413	if lx.symbol=assignsym then
3414		lex()
3415		enumseq:=readconstintexpr()
3416	fi
3417	d^.index:=enumseq
3418	d^.blockno:=currblockno
3419	blockcounts[currblockno]:=1
3420	++enumseq	
3421	if lx.symbol=commasym then
3422		lex()
3423!		if lx.symbol=rcurlysym then			!this is allowed
3424!			serror("enum?")
3425!		fi
3426	fi
3427od
3428skipsymbol(rcurlysym)
3429end
3430
3431function createdotop(int opc, unit p,ref strec d)unit=
3432!opc is j_dot or j_idot
3433!Deal with field selection for p.d or p->d
3434var unit q,r,poffset,pb,pc
3435var ref strec e,f,prec,panon,pfield,gend
3436var int m,offset,scale
3437var ref fieldrec fl
3438
3439!CPL "CREATEDOTOP",jtagnames[opc]
3440!PRINTUNIT(NIL,P)
3441
3442!check that m is a proper pointer if needed, and a struct or union
3443m:=p^.mode
3444if opc=j_idot then			!
3445!	if ttbasetype[m]<>tref then
3446	if not ttisref[m] then
3447		serror("-> needs pointer")
3448	fi
3449	m:=tttarget[m]
3450fi
3451case ttbasetype[m]
3452when tstruct,tunion then
3453else
3454	serror(". -> not a struct")
3455esac
3456
3457!now need to resolve the field name d
3458prec:=ttnamedef[m]				!r is record def
3459
3460f:=d
3461while f:=f^.nextdupl do
3462	if f^.owner=prec then
3463		offset:=f^.offset
3464		exit
3465	fi
3466od
3467
3468!not found; look for any anon fields
3469if not f then
3470	gend:=d						!find generic field name version
3471	while gend^.prevdupl do
3472		gend:=gend^.prevdupl
3473	od
3474
3475	fl:=prec^.nextfield
3476	while fl do					!now search linear field list matching generic entries
3477		if fl^.gendef=gend then
3478			f:=fl^.def
3479			offset:=fl^.offset
3480			exit
3481		fi
3482		fl:=fl^.nextfield
3483	od
3484fi
3485
3486if not f then
3487	terror_ss("Not a field of struct %s %s",d^.name,Strmode(m))
3488fi
3489
3490
3491poffset:=createconstunit(offset,tsint)
3492
3493!will be p->field, or p.field
3494!p.field: *(p+offset)
3495
3496if opc=j_idot then				!apply offset to lhs
3497	p:=createptrop(p)
3498fi
3499
3500p:=createunit1(j_dot,p)
3501p^.offset:=offset
3502
3503p^.mode:=f^.mode
3504p:=arraytopointer(p)
3505fixmemopnd(p)
3506
3507return p
3508end
3509
3510function mulunit(unit p, int elemtype)unit=
3511!p is an int unit representing some offset i for *(A+i) or A[i]
3512!apply a scale so that is a byte offset
3513!t is the element type
3514var int elemsize
3515
3516if (elemsize:=ttsize[elemtype])<>1 then
3517	if p^.tag=j_const then
3518		p^.value:=p^.value*elemsize
3519	else
3520		p:=createunit1(j_scale,p)
3521		p^.scale:=elemsize
3522		p^.mode:=tptroffset
3523	fi
3524fi
3525return p
3526end
3527
3528function divunit(unit p, int elemtype)unit=
3529var int elemsize
3530
3531if (elemsize:=ttsize[elemtype])<>1 then
3532	if p^.tag=j_const then
3533		p^.value:=p^.value/elemsize
3534	else
3535		p:=createunit1(j_scale,p)
3536		p^.scale:=-elemsize
3537		p^.mode:=tptroffset
3538	fi
3539fi
3540return p
3541end
3542
3543function createassignopref(int opc, unit p,q)unit=
3544!opc is assignsym, addtosym etc
3545!do assign/addto when is a ref type
3546!return resulting unit
3547var int pmode,qmode,rmode,elemmode
3548var unit r
3549
3550pmode:=rmode:=p^.mode
3551elemmode:=tttarget[pmode]
3552qmode:=q^.mode
3553
3554case opc
3555when assignsym then
3556	q:=coercemode(q,pmode)
3557	r:=createunit2(j_assign,p,q)
3558
3559when addtosym then
3560	if ttisref[qmode] then		!ref+=ref
3561		serror("ptr+=ptr")
3562	fi
3563
3564	q:=coercemode(q,tptroffset)					!ref+=int
3565	r:=createunit2(j_addto,p,mulunit(q,elemmode))
3566
3567when subtosym then
3568	if ttisref[qmode] then		!ref-=ref
3569		if not comparemode(pmode,qmode) then
3570			serror("-= refs don't match")
3571		fi
3572		r:=divunit(createunit2(j_sub,p,q),elemmode)
3573		rmode:=tsint
3574	else								!ref-=int
3575		r:=createunit2(j_subto,p,mulunit(q,elemmode))
3576	fi
3577else
3578	serror("Not allowed on ptrs")
3579esac
3580
3581r^.mode:=rmode
3582return r
3583end
3584
3585proc addnewfield(ref fieldrec &flist, ref strec d, int offset)=
3586!new field d has just been created for a record
3587!add it to the linear list of fields for the record
3588var ref strec e
3589var ref fieldrec f
3590
3591if d^.name^<>'$' then			!normal field
3592	f:=pcm_allocz(f^.bytes)
3593	f^.def:=d
3594	while d^.prevdupl do			!look for generic entry
3595		d:=d^.prevdupl
3596	od
3597	f^.gendef:=d
3598	f^.offset:=offset
3599
3600	f^.nextfield:=flist
3601	flist:=f
3602
3603else
3604	e:=ttnamedef[d^.mode]^.deflist
3605	while e do
3606		addnewfield(flist,e,offset+e^.offset)
3607		e:=e^.nextdef
3608	od
3609fi
3610end
3611
3612proc pushloop(int looptype)=
3613!looptype is 'L' or 'S', ie a switch, so not really a loop
3614if loopindex>=maxnestedloops then
3615	serror("Too many nested loop or switch")
3616fi
3617++loopindex
3618looptypestack[loopindex]:=looptype
3619casevaluestack[loopindex]:=nil
3620
3621end
3622
3623proc poploop=
3624if loopindex then
3625	--loopindex
3626else
3627	serror("poploop?")
3628fi
3629end
3630
3631proc addcasevalue(int value)=
3632var ref caserec p
3633
3634var int index:=loopindex
3635while index and looptypestack[index]<>'S' do
3636	--index
3637od
3638if index=0 then serror("case not inside switch stmt") fi
3639
3640p:=pcm_alloc(caserec.bytes)
3641p^.value:=value
3642p^.nextcase:=casevaluestack[index]
3643casevaluestack[index]:=p
3644end
3645
3646function roundoffset(int offset, alignment)int=
3647var int mask
3648
3649if structpadding then
3650	if alignment=1 then return offset fi
3651	mask:=alignment-1
3652	while offset iand mask do ++offset od
3653fi
3654return offset
3655end
3656
3657proc fixmemopnd(unit p)=
3658var int t
3659
3660!when p refers to a 1- 2- byte value, adjust the type
3661if ingeneric then return fi
3662
3663case t:= ttbasetype[p^.mode]
3664when tschar,tsshort then
3665	insertunit(p,j_widenmem)
3666	p^.mode:=tsint
3667when tuchar,tushort,tbool then
3668	insertunit(p,j_widenmem)
3669	p^.mode:=tuint
3670esac
3671end
3672
3673function docast(unit p,int t,hard=1,inplace=0)unit=
3674!apply cast to unit p
3675!if no cast needed, then just return p
3676var unit q
3677var int s,opc
3678
3679s:=p^.mode
3680
3681retry::
3682
3683!if t=tvoid then return p fi
3684
3685if s=t then return p fi
3686opc:=0
3687
3688if s<16 and t<16 then
3689	opc:=conversionops[s,t]
3690
3691elsif ttisref[s] and ttisref[t] then
3692	if checkpointertypes(s,t,hard) then
3693		p^.mode:=t
3694		return p
3695	fi
3696
3697elsif ttconst[s] then
3698	s:=ttconsttype[s]
3699	goto retry
3700elsif ttconst[t] then
3701	t:=ttconsttype[t]
3702	goto retry
3703elsif ttisref[t] and (s>=tfirstint and s<=tlastint) and p^.tag=j_const and p^.value=0 then
3704	opc:=soft_c
3705fi
3706
3707if opc=0 then
3708	if not hard then
3709		cpl Strmode(s)
3710		cpl Strmode(t)
3711		terror_ss("Can't do conversion %s => %s",typename(s),typename(t))
3712	fi
3713	opc:=hard_c
3714fi
3715
3716case p^.tag
3717when j_const then		!try and convert
3718	if eval_convert(p,t,opc) then
3719		return p
3720	fi
3721when j_funcname then
3722	p^.mode:=t
3723	return p
3724when j_add then
3725	if p^.a^.tag=j_const and p^.b^.tag=j_const then
3726		p^.value:=p^.a^.value+p^.b^.value
3727		p^.mode:=t
3728		p^.tag:=j_const
3729		return p
3730	fi
3731esac
3732
3733if inplace then
3734	insertunit(p,j_convert)
3735	p^.mode:=t
3736	p^.opcode:=opc
3737	return nil
3738else
3739	q:=createunit1(j_convert,p)
3740	q^.opcode:=opc
3741	q^.mode:=t
3742fi
3743return q
3744end
3745
3746function coercemode(unit p, int t)unit=
3747var int s,opc
3748var unit q
3749
3750if p^.mode=t then return p fi
3751docast(p,t,0,1)
3752return p
3753end
3754
3755proc coercemode_inplace(unit p, int t)=
3756var int s,opc
3757var unit q
3758
3759if p^.mode=t then return fi
3760docast(p,t,0,inplace:1)
3761
3762end
3763
3764proc dostaticassert=
3765var int x
3766var [256]char str
3767	lex()
3768	skipsymbol(lbracksym);
3769	x:=readconstintexpr()
3770	skipsymbol(commasym)
3771	checksymbol(stringconstsym)
3772	if not x then
3773		memcpy(&.str,lx.svalue,lx.length)
3774		str[lx.length+1]:=0
3775		serror(&.str)
3776	fi
3777	lex()
3778	skipsymbol(rbracksym)
3779end
3780
3781function createsizeofop(unit p)unit=
3782var unit q
3783var int t,size
3784
3785t:=p^.mode
3786switch p^.tag
3787!when j_nameaddr then
3788!	size:=ttsize[p^.def^.mode]			!take account of array
3789when j_name then
3790	if p^.alength then
3791		size:=ttsize[p^.def^.mode]/p^.alength			!take account of array
3792	else
3793		size:=ttsize[p^.def^.mode]			!take account of array
3794	fi
3795when j_const then
3796	if t=trefchar then					!const string
3797		size:=p^.slength+1
3798	else
3799		size:=ttsize[t]
3800	fi
3801
3802when j_ptr then
3803	if ttisref[t] and p^.alength then		!result of array=>ptr conversion
3804		size:=ttsize[tttarget[t]]*p^.alength
3805	else
3806		size:=ttsize[t]
3807	fi
3808
3809when j_addptr then
3810	if p^.alength then	!derived from array expr that converted to pointer
3811		size:=ttsize[tttarget[t]]*p^.alength
3812	else
3813		goto cad1
3814	fi
3815
3816when j_addrof then
3817	if p^.a^.tag=j_name and p^.a^.alength then
3818		size:=ttsize[p^.a^.def^.mode]
3819	fi
3820
3821when j_widenmem then
3822	return createsizeofop(p^.a)
3823
3824else
3825cad1::
3826	size:=ttsize[t]
3827endswitch
3828
3829q:=createconstunit(size,tsint)
3830return q
3831end
3832
3833function readgeneric:unit=
3834!read generic construct; return chosen expr according to type of control expr
3835!at '_Generic'
3836	var unit pexpr,pmatch,p
3837	var ref paramrec pm
3838	var int m,t,def,oldingeneric,count
3839	var ref strec d
3840
3841	lex()
3842	checksymbol(lbracksym)
3843	lex()
3844	oldingeneric:=ingeneric
3845	ingeneric:=1
3846	pexpr:=readassignexpr()
3847	ingeneric:=oldingeneric
3848
3849	m:=pexpr^.mode
3850	pmatch:=nil
3851	def:=0
3852	count:=0
3853
3854	checksymbol(commasym)
3855
3856	repeat						!at comma
3857		lex()					!skip comma
3858		if lx.symbol=kdefaultsym then
3859			if def then serror("generic/default twice") fi
3860			def:=1
3861			if count=0 then t:=-1 else t:=-2 fi
3862!			t:=-1
3863			lex()
3864		else
3865			t:=readcasttype(d,0,pm)
3866		fi
3867		checksymbol(colonsym)
3868		lex()
3869		p:=readassignexpr()
3870
3871!		if pmatch=nil and (t=-1 or t=m) then
3872		if (t=-1 or t=m) then
3873
3874			pmatch:=p
3875			++count
3876		fi
3877	until lx.symbol<>commasym
3878
3879	checksymbol(rbracksym)
3880	lex()
3881	if not pmatch then serror("Generic: no type match") fi
3882	if count>1 then serror("Generic: multiple types match") fi
3883
3884	return pmatch
3885end
3886
3887proc readstructinfosym=
3888var ref strec d,e
3889var ref paramrec pm
3890var int m, nfields
3891var filehandle f
3892var ichar name
3893var [256]char str
3894
3895lex()
3896m:=readcasttype(d,0,pm)
3897
3898if ttbasetype[m]<>tstruct then
3899	serror("Struct type expected")
3900fi
3901d:=tttypedef[m]
3902
3903e:=d^.deflist
3904nfields:=0
3905while e do
3906	++nfields
3907	e:=e^.nextdef
3908od
3909
3910name:=d^.name
3911
3912sprintf(&.str,"$%s_info.h",name)
3913
3914f:=fopen(&.str,"w");
3915
3916fprintf(f,"memberinfo_t $%s[] = {\n",name)
3917
3918e:=ttnamedef[m]^.deflist
3919nfields:=0
3920
3921while e do
3922	fprintf(f,"    {\"%s\", %d,%d,%d,%d,%d,%d}%s\n", e^.name,
3923		e^.mode, ttbasetype[e^.mode],tttarget[e^.mode],
3924		ttsize[e^.mode],e^.offset,0,(e^.nextdef|","|""))
3925	++nfields
3926	e:=e^.nextdef
3927od
3928
3929fprintf(f,"};\n")
3930
3931fprintf(f,"enum {$%s_length = %d};\n",name,nfields);
3932
3933fclose(f)
3934end
3935
3936function getmemmode(unit p)int=
3937!return mode of p, but if p is a widening unit, see past that to
3938!the original memory mode
3939if p^.tag=j_widenmem then
3940	return p^.a^.mode
3941else
3942	return p^.mode
3943fi
3944end
3945
3946function readstrinclude:unit=
3947	var unit p
3948	var ichar text
3949
3950	lex()
3951	checksymbol(lbracksym)
3952	lex()
3953	p:=readexpression()
3954	checksymbol(rbracksym)
3955	lex()
3956	if p^.tag<>j_const or p^.mode<>trefchar then
3957		serror("String const expected")
3958	fi
3959
3960	text:=cast(readfile(p^.svalue))
3961	if not text then
3962		serror_s("Can't read strinclude file: %s",p^.svalue)
3963	fi
3964
3965	return createstringconstunit(text,strlen(text))
3966end